What files are there? (Code)

What files are there? (Code)

This Content Component encountered an error
 
VTOC
// IFF ?1?/ FILELIB NAME-?1?,LIBL-YES
CATALOG ALL,F1
// FILELIB NAME-QS36F,LIBL-YES
*********
This will print a Volume Table of Contents (VTOC) for the specified library ( ?1? ).
(Ex: "VTOC  WRKLIB") 

...but often didn't want to wait for a printed list, and knew the first few characters of the filename we were seeking, so composed a procedure called FILE.

 FILE
WRKOBJ OBJ(QS36F/?1R?)  OBJTYPE(*FILE)
(Ex:  "FILE RD*")  
This displays all the files with that name or partial name in QS36F library.
*********
 ...then we had a need to track certain files with the either characters "RD" or "RI" in the first two positions of the file name, and we needed further information that was not necessarily on the VTOC. This resulted in a hybrid approach, named RIRDSEL 

First, create a file in QTEMP library that includes a line for each qualifying filename.

 
A CL program; RIRDCL
PGM
	MONMSG	MSGID(CPF2123)
	DSPOBJD	OBJ(QS36F/RI*) OBJTYPE(*FILE) OUTPUT(*OUTFILE) +
			      OUTFILE(QTEMP/RIRDFILE)
	MONMSG	MSGID(CPF2123)
	DSPOBJD	OBJ(QS36F/RD*) OBJTYPE(*FILE) OUTPUT(*OUTFILE) +
			      OUTFILE(QTEMP/RIRDFILE) OUTMBR(*FIRST *ADD)
ENDPGM
************************************************ 

Then, an RPG program (RIRD) and screen display format (RIRDFM) to allow selection from the RIRDFILE list. Filename will be moved into pos 91-98 of the local data area for use in subsequent program(s). Program RIRD, as shown only accepts 16 lines of display data (16 files in work area). If there are likely more than that, recompile the program with INFDS and use roll-up/roll-down keys.

 

RIRDFM
SAA1          124            YY                                                                      CEG
DSCODE     3  1  2Y   Y                  Y                   Y                 CAA1
DHEAD1   70  1  7Y
DHEAD2   70  2  7Y                                                   Y
D             70  3  2Y                                                         Y    C ?MARK "X" NEXT TX
DO THE 
 
   YOU WANT TO SELECT.
DX1            1  5  2Y    Y                                                   Y
DX2...         1  6  2Y    Y                                                   Y...
...
DX16          1 20  2Y    Y                                                   Y
DDL1        70  5  5Y
DDL2...     70  5  5Y...
...
DDL16      70 20 5Y
DSNAME     8 22 5Y      Y                                         Y
DFOOT1    70 24 6Y                                            Y
D***********************************************


Program RIRD:
*********** Beginning of data ************************************* 
H                                                                			    RIRD
F* SELECT A "RIRDnn" FILE FROM LIST...PUT NAME IN LDA(91-98)   * 
F***************************************************************** 
F*IRDFILEIF  F     539            DISK   (Rec.len. for v4r4...v5r1 is 588)
FRIRDFILEIF  F     588            DISK                             
FRIRDFM  IF  F    1864            WORKSTN                          
F                                              KFMTS  RIRDFM      
F*
E                    X           16   1                              
E                    DL         16 70                              
E*
IRIRDFM     NS  02   1 CA   2 CA                                      
I* format-AA1                                                      
I                                        1    3  SCODE               
I                                        4  19  X                   
I                                      20  27  SNAME              
IRIRDFM     CP  99                                        
I*                                                                 
IRIRDFILENS  01                                                    
I                                       24   31  RINAME              
I                                       59   88  RIDESC              
I                                     112 1170RIDATE              
I                                     124 133  RIOWNR              
I*                                                                 
I            DS                                                    
I                                         1  70  LINE                
I                                         1    8  RINAME              
I                                       12  170RIDATE              
I                                       23  32  RIOWNR              
I                                       33  62  RIDESC              
I          UDS                                                    
I                                       91  98  LFILN               
I                                     131 131 LSF                 
I                                     501 502 LWKS                
I                                     503 512 LUSER               
I*****
C*     on first record, get 16 lines of data, dsply SCRAA1         
C      99   1        DO      16          B       20                    
C           B          CHAIN RIRDFILE              98                 
C        N98         MOVE LINE        DL,B                          
C        N98         END  1                                   ...DO*16 (B) 
C      99              EXCPTSCRAA1                                  
C*
C*     on input of dsply screen, use the SNAME given,               
C*                 or else, find the first one that's "X"-d     
C   02   SNAME   IFNE  *BLANK                                  
C                       MOVE SNAME    LFILN            Put name in LDA*              
C                       SETON                     LR            *Local Data Area     
C                       ELSE                                         
C            1         DO      16           B                             
C           X,B       COMP *BLANK               69                 
C   69                MOVELDL,B        LFILN            Put name in LDA*             
C   69                SETON                     LR                 
C N69                END                                      ...Do*16 (B) 
C N69                EXCPTSCRAA1                                  
C                       END                                      (02) If, Else 
C   KG                SETON                     LR
C   LR                 EXCPT RELAA1                                  
C          ENDDET TAG
C* ***********************************************                                                                                  
 
ORIRDFM E       SCRAA1                                  
O                                     K8 'AA1     '                 
O*                   HEAD1      70                            
O*                   HEAD2    140                            
O                                      24 '   RIRD  - INCOMING SHIPM' 
O                                      48 'ENTS - IMPORTED / DOMEST' 
O                                      72 'IC WITH "ZERO LIST"     ' 
O                                      96 ' '                        
O                                    120 ' '                        
O                                    140 ' '                        
O                     X             156                            
O                     DL          1276                            
O                     SNAME   1284                            
ORIRDFM ER     RELAA1                                  
O*  Release workstation.  LDA has filename in pos 91-98. 

********************* 
 

Now, positions 91-98 contain the filename that was either keyed-in or selected from the list. We can proceed to the next program and use the selected file, as well as print the file name into the heading or body or margin of any printed or displayed report.

So finally, how about a procedure to make it all work together? Here's a S36 Procedure that shows available incoming shipment files, then runs program POR19, to display all items from any selected shipment:

  
MENUPU19
**Display all RI/RD files, select one file & put the name in LDA(91-98)
CALL WRKLIB/RIRDCL
// LOAD RIRD
** DSPFMT: RIRDFM
// FILELIB NAME-QTEMP,LIBL-YES
// FILE NAME-RIRDFILE,DISP-SHR
// RUN
// FILELIB NAME-QS36F,LIBL-YES
// EVALUATE P1='?L'91,8'?'
// * '?1?'
** Browse thru inbound shipment & display or print report
// IF ?L'91,8'?/  * 'ENTER THE SHIPMENT#...'
// IF ?L'91,8'?/  LOCAL OFFSET-91,DATA-'?1R?
// EVALUATE P1='?L'91,8'?'
// IFF DATAF1-?1?  * 'FILE NOT FOUND - CANCELLING PROCEDURE'
// IFF DATAF1-?1?  PAUSE
// IFF DATAF1-?1? GOTO ENDPROC
// IFF DATAF1-INBX?WS? BLDINDEX INBX?WS?,101,9,?1?,,DUPKEY,,19,7
// LOAD POR19
// FILE NAME-POINBDX1,LABEL-INBX?WS?,DISP-SHR
// RUN
DLTF INBX?WS?
// TAG  ENDPROC
// LOCAL OFFSET-91,BLANK-8
** ** CMD-15 goes to sales menu#13...   else: end
// IF ?'495,2'?=15  RESET SALES13/METRIC 

Dig deeper on iSeries programming commands

0 comments

Oldest 

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

-ADS BY GOOGLE

SearchEnterpriseLinux

SearchDataCenter

Close