home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Hall of Fame
/
HallofFameCDROM.cdr
/
3x400
/
dspsrcdr.lzh
/
DSPSRCDR.RPG
< prev
next >
Wrap
Text File
|
1988-08-08
|
9KB
|
212 lines
/TITLE Display source member directory. CMD(DSPSRCDIR)
F****************************************************************
F* (C) - Copyright 1988 by Shaw-Barton, Inc., Coshocton, OH 43812
F*
F* TITLE: DSPSRCDIR2 (RPG)
F* AUTHOR: Joseph L. Bolen
F* DATE WRITTEN: August 1988
F*
F* DESCRIPTION: Reformats data from DSPFD TYPE(*MBRLIST).
F* CALLED BY: DSPSRCDIR1 (CLP)
F* CALLS: None
F*
F****************************************************************
F* F I L E S P E F I C A T I O N S *
F****************************************************************
F*
FQAFDMBRLIF E DISK
FDSPSRCDRO E 69 PRINTER
F*
E****************************************************************
E* E -- S P E F I C A T I O N S *
E****************************************************************
E*
E FL 21 01
E CHK 10 01
E TST 10 01
E*
I****************************************************************
I* D A T A S T R U C T U R E S *
I****************************************************************
I*
I DS
I 1 60YYMMDD
I 1 20YY
I 3 80MMDDYY
I 7 80MDYY
INUMDS DS
I 1 21 NUM
I 1 70X
I 8 140Y
I 15 210I
I*
ITOTDS DS
I 1 39 TOT
I 1 150TOTRCD
I 16 300TOTBYT
I 31 390TOTMBR
I*
IGTDS DS
I 1 39 GTOT
I 1 150GTRCD
I 16 300GTBYT
I 31 390GTMBR
I*
C****************************************************************
C* C A L C -- S P E F I C A T I O N S *
C****************************************************************
C*
C *IN30 IFEQ '0'
C EXSR HSKP
C MOVE '1' *IN30
C END
C*
C*-----> MAINLINE
C*
C READ QAFDMBRL LR
C *INLR DOWEQOFF
C MOVEA*BLANKS FL
C MOVEAMLFILE FL,1
C Z-ADD1 X
C *BLANK LOKUPFL,X 51 FIRST BLANK
C MOVE '.' FL,X
C ADD 1 X
C MOVEAMLLIB FL,X QUALIFY LIBRARY
C MOVEAFL FILIB
C*
C *IN31 IFEQ ON
C MLFILE ORNE PRVFIL
C*
C *IN31 CASEQOFF BREAK1
C END
C MOVE OFF *IN31 FIRST PAGE
C WRITEHEADER
C MOVE MLFILE PRVFIL
C*
C END
C*
C *IN20 IFEQ ON TYPE TEST
C MLSEU CABNESEUCHK POP
C END
C*
C MOVE *BLANKS MBR
C MOVELMLNAME MBR
C*
C *IN21 IFEQ ON MBR TEST
C MOVE OFF *IN22
C EXSR TEST
C *IN22 CABEQOFF POP NO MATCH
C END
C*
C EXSR MOVIT
C WRITEDETAIL1
C POP TAG
C*
C READ QAFDMBRL LR
C END
C*
C EXSR BREAK1
C WRITETRL2
C ENDPGM TAG
C MOVE ON *INLR
C*
C*****************************************************************
C* S U B R O U T I N E S E C T I O N *
C*****************************************************************
C*-----> HSKP <-----
C*
CSR HSKP BEGSR
C*
C *ENTRY PLIST
C PARM SEUCHK 4
C PARM MBRCHK 10
C*
C *LIKE DEFN MLFILE PRVFIL
C*
C MOVE *ZEROS NUM ZAP FIELDS
C MOVE *ZEROS TOT ZAP FIELDS
C MOVE *ZEROS GTOT ZAP FIELDS
C MOVE '1' ON 1
C MOVE '0' OFF 1
C MOVE ON *IN31 FIRST PAGE
C*
C SEUCHK IFNE 'ALL '
C SEUCHK ANDNE*BLANKS
C MOVE ON *IN20 SEU TYPE CHECK
C END CK
C*
C MBRCHK IFNE *BLANKS
C MOVE ON *IN21 MBR NAME CHECK
C MOVEA*BLANKS CHK
C MOVEAMBRCHK CHK,1
C*-----> CHECK FOR LENGTH OF MEMBER NAME.
C Z-ADD1 I
C *BLANK LOKUPCHK,I 52
C *IN52 IFEQ ON
C SUB 1 I
C END
C*-----> CHECK FOR '*' - GENERIC SEARCH
C Z-ADD1 Y
C '*' LOKUPCHK,Y 52
C *IN52 IFEQ ON
C SUB 1 Y
C Y IFLT 1
C MOVE OFF *IN21
C END
C ELSE
C Z-ADDI Y
C END
C*
C END
C*
CSR ENDSR
C*
C*-----> TEST <-----
C*
CSR TEST BEGSR
C*
C *IN52 IFEQ OFF
C MBR CABNEMBRCHK ENDTST
C ELSE
C MOVEA*BLANKS TST
C MOVEAMBR TST,1
C DO Y I
C TST,I CABNECHK,I ENDTST
C END
C END
C MOVE ON *IN22
C ENDTST TAG
C*
CSR ENDSR
C*
C*-----> BREAK1 <-----
C*
CSR BREAK1 BEGSR
C*
C WRITETRL1
C ADD TOTRCD GTRCD
C ADD TOTBYT GTBYT
C ADD TOTMBR GTMBR
C MOVE *ZEROS TOT
C*
CSR ENDSR
C*
C*-----> MOVIT <-----
C*
CSR MOVIT BEGSR
C*
C MOVE MLCDAT YYMMDD
C MOVE YY MDYY
C MOVE MMDDYY CRTDAT
C MOVE MLCHGD YYMMDD
C MOVE YY MDYY
C MOVE MMDDYY CHGDAT
C MOVE MLCHGT CHGTIM
C MOVELMLMTXT TEXT
C ADD MLNRCD TOTRCD
C ADD MLSIZE TOTBYT
C ADD 1 TOTMBR
C*
CSR ENDSR
C*