× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



?    F*                                                                  *
?    F********************************************************************
?    F*                                                                  *
?    F*                                                                  *
?    F*                    HANOVER WIRE CLOTH                            *
?    F*                                                                  *
?    F********************************************************************
?    F*      DO NOT COPY OR DISTRIBUTE WITH OUT PERMISSION               *
?    F********************************************************************
?    F*                                                                  *
?    F*      PROGRAM: RCD003RG                                           *
?    F*      PURPOSE: PROGRAM TO PROCESS DSPRCDFMT                       *
?    F*       AUTHOR: MARK WALTER                                        *
?    F*         DATE: 01/15/96                                           *
?    F*                                                                  *
?    F********************************************************************
?    F*               *** MODIFICATION LOG ***                           *
?    F*  NAME/CO.                DATE    DESCRIPTION                     *
?    F*  --------------------  --------  ------------------------------- *
?    F*                                                                  *
?    F********************************************************************
     FRCD003PR  O    E             PRINTER USROPN

     FRCD003DF  CF   E             WORKSTN USROPN

     F                                     SFILE(DSPDTL:SRN)

     D LN              S              1    DIM(9)

     D KY              S             10    DIM(120)

     D SQ              S              1    DIM(120)

     D FN              S             10    DIM(2000)

     D TYP             S              1    DIM(14) CTDATA PERRCD(1)

     D DSC             S              7    DIM(14) ALT(TYP)

     D RCVVAR          DS          7736

     D  NBRKYS                37     38B 0

     D  OFFSET                53     56B 0

     D                 DS

     D  USRSPC                 1     20    INZ('RCD003US  QTEMP     ')

     D  STRPOS                21     24B 0

     D  STRLEN                25     28B 0

     D  RCVLEN                29     32B 0

     D ERRCOD          DS

     D  BYTPRV                 1      4B 0 INZ(96)

     D  BYTAVA                 5      8B 0

     D  ERRID                  9     15

     D  ERRDTA                17     96

     D GENDS           DS

     D  SIZHDR                65     68B 0

     D  OFFHDR               117    120B 0

     D  OFFLST               125    128B 0

     D  NUMLST               133    136B 0

     D  SIZENT               137    140B 0

     D HEADER          DS

     D  HDFILE                 1     10

     D  HDLIB                 11     20

     D  HDTYPE                21     30

     D  HDRFMT                31     40

     D  RCDLEN                41     44B 0

     D LIST            DS

     D  DTFLD                  1     10

     D  DTATYP                11     11

     D  FLDLEN                21     24B 0

     D  DIGITS                25     28B 0

     D  DECPOS                29     32B 0

     D  DTTEXT                33     74

     D  VARLEN               268    268

?    C*
?    C* GET THE PARAMETERS
?    C*
     C     *ENTRY        PLIST

     C                   PARM                    FILE             20

     C                   PARM                    RCDFMT           10

     C                   PARM                    OUTPUT            6

     C                   PARM                    TEXT             50

     C                   PARM                    MSGID             7

     C                   PARM                    MSGDTA           80

?    C*
     C                   CLEAR                   FN

?    C*
?    C* OPEN THE OUTPUT FILES
?    C*
?    C     OUTPUT        IFEQ      '*PRINT'

     C                   OPEN      RCD003PR

?    C                   ELSE

     C                   OPEN      RCD003DF

?    C                   ENDIF

?    C*
?    C* CALL AN API TO RETRIEVE THE FILE DESCRIPTION DATA
?    C*
     C                   CALL      'QDBRTVFD'

     C                   PARM                    RCVVAR

     C                   PARM      7736          RCVLEN

     C                   PARM                    RTNFIL           20

     C                   PARM      'FILD0300'    FMTNAM            8

     C                   PARM                    FILE

     C                   PARM                    RCDFMT

     C                   PARM      '1'           OVRRID            1

     C                   PARM      '*LCL'        SYSTEM           10

     C                   PARM      '*INT'        FMTTYP           10

     C                   PARM                    ERRCOD

?    C*
?    C     BYTAVA        IFEQ      0

     C     OFFSET        ADD       11            X                 4 0

?    C                   DO        NBRKYS

     C                   ADD       1             Y                 4 0

     C     10            SUBST     RCVVAR:X      KY(Y)

     C                   ADD       18            X

     C     1             SUBST     RCVVAR:X      SQ(Y)

     C                   ADD       46            X

?    C                   ENDDO

?    C                   ENDIF

?    C*
?    C* CALL AN API TO RETRIEVE THE FILE FIELD DESCRIPTIONS
?    C*
     C                   CALL      'QUSLFLD'

     C                   PARM                    USRSPC

     C                   PARM      'FLDL0100'    OUTFMT            8

     C                   PARM                    FILE

     C                   PARM                    RCDFMT

     C                   PARM      '1'           OVRRID

     C                   PARM                    ERRCOD

?    C*
?    C     BYTAVA        IFGT      0

     C                   MOVEL     ERRID         MSGID

     C                   MOVEL     ERRDTA        MSGDTA

?    C                   ELSE

     C                   Z-ADD     1             STRPOS

     C                   Z-ADD     140           STRLEN

?    C                   ENDIF

?    C*
?    C* RETRIEVE THE USER SPACE ALLOCATED IN THE CALLING CL
?    C*
     C                   CALL      'QUSRTVUS'

     C                   PARM                    USRSPC

     C                   PARM                    STRPOS

     C                   PARM                    STRLEN

     C                   PARM                    GENDS

?    C*
     C     OFFHDR        ADD       1             STRPOS

     C                   Z-ADD     SIZHDR        STRLEN

?    C*
?    C* RETRIEVE THE USER SPACE ALLOCATED IN THE CALLING CL
?    C*
     C                   CALL      'QUSRTVUS'

     C                   PARM                    USRSPC

     C                   PARM                    STRPOS

     C                   PARM                    STRLEN

     C                   PARM                    HEADER

?    C*
     C                   Z-ADD     NUMLST        HDFLDS

     C                   Z-ADD     RCDLEN        HDRLEN

     C                   MOVEL     TEXT          HDTEXT

?    C*
?    C* WRITE THE PRINT HEADING
?    C*
?    C     OUTPUT        IFEQ      '*PRINT'

     C                   WRITE     PRTHDR

     C                   Z-ADD     9             LINCNT

?    C                   ENDIF

?    C*
?    C*
?    C*
     C     OFFLST        ADD       1             STRPOS

     C                   Z-ADD     SIZENT        STRLEN

?    C*
?    C                   DO        NUMLST

?    C*
?    C* RETRIEVE THE USER SPACE
?    C*
     C                   CALL      'QUSRTVUS'

     C                   PARM                    USRSPC

     C                   PARM                    STRPOS

     C                   PARM                    STRLEN

     C                   PARM                    LIST

?    C*
     C                   MOVE      *BLANKS       DTYPE

     C                   Z-ADD     1             X

     C     DTATYP        LOOKUP    TYP(X)
99
?    C     *IN99         IFEQ      *ON

     C                   MOVEL     DSC(X)        DTYPE

?    C                   ENDIF

?    C*
     C                   Z-ADD     *ZEROS        DTKEY

     C                   MOVE      *BLANKS       DTSEQ

     C                   Z-ADD     1             X

     C     DTFLD         LOOKUP    KY(X)
99
?    C     *IN99         IFEQ      *ON

     C                   Z-ADD     X             DTKEY

     C                   TESTB     '0'           SQ(X)
99
?    C     *IN99         IFEQ      *ON

     C                   MOVE      'D'           DTSEQ

?    C                   ENDIF

?    C                   ENDIF

?    C*
     C                   MOVEA     *BLANKS       LN

?    C     DIGITS        IFNE      0

     C                   MOVE      DIGITS        SIZE              5

     C                   MOVEA     SIZE          LN(1)

     C                   MOVE      ','           LN(6)

     C                   MOVE      DECPOS        DEC               2

?    C     DECPOS        IFLT      10

     C                   MOVE      DEC           LN(7)

?    C                   ELSE

     C                   MOVEA     DEC           LN(7)

?    C                   ENDIF

?    C                   ELSE

?    C     VARLEN        IFEQ      '1'

     C                   SUB       2             FLDLEN

     C                   MOVE      'V'           LN(9)

?    C                   ENDIF

     C                   MOVE      FLDLEN        SIZE

     C                   MOVEA     SIZE          LN(1)

?    C                   ENDIF

     C                   Z-ADD     1             X

?    C     LN(X)         DOWEQ     '0'

?    C     X             ANDLT     9

     C                   MOVE      *BLANKS       LN(X)

     C                   ADD       1             X

?    C                   ENDDO

     C                   MOVEA     LN            DTSIZE

?    C*
?    C* ROUTINE TO PRINT THE OUTPUT
?    C*
?    C     OUTPUT        IFEQ      '*PRINT'

?    C*
     C                   ADD       1             LINCNT            2 0

?    C     LINCNT        IFEQ      59

     C                   WRITE     PRTHDR

     C                   Z-ADD     9             LINCNT

?    C                   ENDIF

?    C*
     C                   WRITE     PRTDTL

?    C                   ELSE

     C                   ADD       1             SRN               4 0

     C                   MOVEL     DTFLD         FN(SRN)

     C                   WRITE     DSPDTL

?    C                   ENDIF

?    C*
     C                   ADD       SIZENT        STRPOS

?    C                   ENDDO

?    C*
?    C     OUTPUT        IFEQ      '*PRINT'

     C                   WRITE     PRTFTR

?    C                   ELSE

?    C*
     C                   Z-ADD     1             SFLRRN

     C                   Z-ADD     SRN           MAXRRN            4 0

?    C*
?    C* ROUTINE TO WRITE THE SCREEN OUTPUT
?    C*
?    C     *IN03         DOUEQ     *ON

     C     *IN12         OREQ      *ON

?    C*
?    C* N31N16             CLEARSCFIND
?     *
     C                   WRITE     DSPFTR

     C                   EXFMT     DSPHDR

?    C*
     C                   SETOFF                                       3135

?    C*                    EXSR @CLRRI
?    C*
?    C* CHECK COMMAND KEYS
?    C*
?    C                   SELECT

?    C*
?    C* EXIT
?    C*
?    C*    *IN03         WHENEQ    *OFF
?    C*    *IN12         ANDEQ     *OFF
?    C*    *IN16         ANDEQ     *OFF
?    C*    *IN17         ANDEQ     *OFF
?    C*    *IN18         ANDEQ     *OFF
?    C*    *IN19         ANDEQ     *OFF
?    C*                  MOVE      *ON           *IN03
?    C                   WHEN      *in03

     C                   LEAVE

?    C*
?    C* FIND RECORD
?    C*
?    C     *IN16         WHENEQ    *ON

?    C                   IF        scfind <> *blanks

?    C                   EXSR      @FIND

?    C                   ELSE

     C                   ITER

?    C                   ENDIF

?    C*
?    C* GO TO TOP
?    C*
?    C     *IN17         WHENEQ    *ON

     C                   Z-ADD     1             SFLRRN

?    C*
?    C* GO TO BOTTOM
?    C*
?    C     *IN18         WHENEQ    *ON

     C                   Z-ADD     MAXRRN        SFLRRN

?    C*
?    C* PRINT
?    C*
?    C     *IN19         WHENEQ    *ON

?    C                   EXSR      @PRINT

     C                   Z-ADD     1             SFLRRN

?     *
     C                   OTHER

?    C                   IF        scfind = *blanks

     C                   EVAL      *inlr = *on

     C                   RETURN

?    C                   ELSE

?    C                   EXSR      @find

?    C                   ENDIF

?    C                   ENDSL

?     *
?    C*
?    C                   ENDDO

?    C*
?    C                   ENDIF

?    C*
     C                   MOVE      *ON           *INLR

?    C*
?    C* PRINT RECORD FORMAT LISTING FROM SCREEN
?    C*
?    C     @PRINT        BEGSR

     C                   OPEN      RCD003PR

     C                   WRITE     PRTHDR

?    C*
     C                   Z-ADD     1             RRNKEY            4 0

     C                   Z-ADD     9             LINCNT

?    C*
?    C     *IN45         DOWEQ     *OFF

     C     RRNKEY        CHAIN     DSPDTL                             45

?    C     *IN45         IFEQ      *OFF

?    C*
     C                   WRITE     PRTDTL

?    C*
     C                   ADD       1             LINCNT

?    C*
?    C     LINCNT        IFEQ      59

     C                   WRITE     PRTHDR

     C                   Z-ADD     9             LINCNT

?    C                   ENDIF

?    C*
     C                   ADD       1             RRNKEY

?    C*
?    C                   ENDIF

?    C                   ENDDO

?    C*
     C                   WRITE     PRTFTR

?    C*
     C                   CLOSE     RCD003PR

?    C                   ENDSR

?    C*
?    C* FIND FIELD SUBROUTINE
?    C*
?    C     @FIND         BEGSR

?    C                   EXSR      @CLRRI

     C                   MOVEA     '000'         *IN(32)

?    C     *IN39         IFEQ      *ON

     C                   Z-ADD     1             X                 4 0

?    C                   ELSE

     C                   ADD       1             X

?    C                   ENDIF

?    C*
     C     ' ':1         SCAN      SCFIND:1      RMNDR             2 0

     C     RMNDR         SUB       1             S                 2 0

?    C*
?    C     X             DO        MAXRRN        Y                 4 0

     C     SCFIND:S      SCAN      FN(Y):1                              34
32
     C   32

     COR 34              LEAVE

?    C                   ENDDO

?    C*
     C                   Z-ADD     Y             X

?    C*
?    C     *IN32         IFEQ      *ON

     C                   Z-ADD     X             SFLRRN

     C     X             CHAIN     DSPDTL                             33

     C  N33              UPDATE    DSPDTL

     C                   Z-ADD     X             RRNKEY            4 0

?    C                   ELSE

     C                   MOVE      *ON           *IN31

?    C                   ENDIF

?    C*
?    C                   ENDSR

?    C*
?    C* CLEAR THE REVERSE IMAGE ATTRIBUTE FROM FOUND FIELDS
?    C*
?    C     @CLRRI        BEGSR

?    C     RRNKEY        IFNE      *ZERO

     C     RRNKEY        CHAIN     DSPDTL                             36

     C  N36              MOVE      *OFF          *IN32

     C  N36              UPDATE    DSPDTL

?    C                   ENDIF

?    C                   ENDSR

**
PPacked
SZoned
BBinary
FFloat
AChar
LDate
TTime
ZTMStmp
HHex
JDBCS-J
EDBCS-E
ODBCS-O
GDBCS-G


Thanks,

Mark

Mark D. Walter
Senior Programmer/Analyst
CCX, Inc.
mwalter@xxxxxxxxxx
http://www.ccxinc.com


                                                                                
                                                                      
                    "Art Tostaine, Jr."                                         
                                                                      
                    <artjr@xxxxxxxxxxx>          To:     "'Midrange Systems 
Technical Discussion'" <midrange-l@xxxxxxxxxxxx>                          
                    Sent by:                     cc:                            
                                                                      
                    midrange-l-bounces@xx        Subject:     RE: DSPRCDFMT 
from News/400?                                                            
                    drange.com                                                  
                                                                      
                                                                                
                                                                      
                                                                                
                                                                      
                    08/12/2003 02:36 PM                                         
                                                                      
                    Please respond to                                           
                                                                      
                    Midrange Systems                                            
                                                                      
                    Technical Discussion                                        
                                                                      
                                                                                
                                                                      
                                                                                
                                                                      




Care to post the source?    We error out here on second to last line,
"receiver value to small to hold result"

****************************************************************
**Load the Field Description Subfile                           *
****************************************************************
C     $LOAD1        BEGSR
**
C                   eval      HeaderPtr = (%addr(Data(OffSetHdr +
C                   eval      WSFILE = FileName
C                   eval      WSLIB = LibName
C                   eval      WSDESC = RecTxtD
C                   eval      WSRCDF = RcdFmtName
C                   eval      WSTYPE = FileType
C                   eval      *IN88 = (FileType <> 'PF')
C                   eval      SpaceStart = 513
C                   do        NumLstEnt
C                   EXSR      $RTVUSAPI
C                   EXSR      $DESC1
C                   eval      WFFLDT = DataType
C                   eval      WFSTART = OutBuffPos
C                   eval      WFDESC2 = FldTextD

Art Tostaine, Jr.
CCA, Inc.
Jackson, NJ 08527


-----Original Message-----
From: midrange-l-bounces@xxxxxxxxxxxx
[mailto:midrange-l-bounces@xxxxxxxxxxxx] On Behalf Of
MWalter@xxxxxxxxxxxxxxx
Sent: Tuesday, August 12, 2003 2:20 PM
To: Midrange Systems Technical Discussion
Subject: Re: DSPRCDFMT from News/400?


We use it fine with V5R2.

Thanks,

Mark

Mark D. Walter
Senior Programmer/Analyst
CCX, Inc.
mwalter@xxxxxxxxxx
http://www.ccxinc.com




                    "Art Tostaine, Jr."

                    <artjr@xxxxxxxxxxx>          To:     "'Midrange
Systems Technical Discussion'" <midrange-l@xxxxxxxxxxxx>

                    Sent by:                     cc:

                    midrange-l-bounces@xx        Subject:     DSPRCDFMT
from News/400?

                    drange.com





                    08/12/2003 02:07 PM

                    Please respond to

                    Midrange Systems

                    Technical Discussion









This was utility that displayed the record format of a database file.
We've been using a version of this forever.

It stopped working with V5R2.  Does anyone know if the fix was published
anywhere?

WRKDBF does the job with F14, but it doesn't search, etc.

Art Tostaine, Jr.
CCA, Inc.
Jackson, NJ 08527


_______________________________________________
This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing
list
To post a message email: MIDRANGE-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/midrange-l
or email: MIDRANGE-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/midrange-l.




_______________________________________________
This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing
list
To post a message email: MIDRANGE-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/midrange-l
or email: MIDRANGE-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/midrange-l.

_______________________________________________
This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing list
To post a message email: MIDRANGE-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/midrange-l
or email: MIDRANGE-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/midrange-l.






As an Amazon Associate we earn from qualifying purchases.

This thread ...

Follow-Ups:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.