&LABL    PROC  &P,1,&BLKSIZE=,&BKSZ=,&IOAREA1=,&IOA1=,&IOA2=,&IOAREA2=,1P$D00010
               &EOFADDR=,&EOFA=,&SEEKADR=,&SKAD=,&AFTER=,&AFTR=,       2P$D00020
               &OPTION=,&ERROR=,&IDLOC=,&IORG=,&IOREG=,&KEYLEN=,&KLEN=,3P$D00030
               &LBAD=,&LABADDR=,&RECFORM=,&RCFM=,&READID=,&RDID=,      4P$D00040
               &READKEY=,&RDKY=,&RECSIZE=,&RCSZ=,&REL=,&RELATIV=,      5P$D00050
               &SAVAREA=,&SRCM=,&SRCHM=,&TYPEFLE=,&TYPF=,&UPDATE=,     6P$D00060
               &UPDT=,&VARBLD=,&VBLD=,&VERIFY=,&VRFY=,&WRITEID=,&WRID=,7P$D00070
               &WRITEKY=,&WRKY=,&WORKA=,&WORK=,&PCA1=,&PCA2=,          8P$D00080
               &PCA3=,&PCA4=,&PCA5=,&PCA6=,&PCA7=,&KARG=,&KEYARG=,     XP$D00090
               &LACE=,&UOS=0,&SIZE=1,&SUBFILE=,&TRLBL=,                XP$D00100
               &COMROUT=,&CONTROL=,&DSKXTNT=,&DTAREX=,&ERRIO=,&CNTRL=, XP$D00110
               &ADRTEST=,&ERRBYTE=,&TYPE=,                             XP$D00120
               &DEV=,&DEVA=,&DVNO=,&CRDT=,&FLID=,&VOLN=,&XPDT=,        XP$D00130
               &ALT=,&EOVA=,&TABL=,&EXTEN=,&WAIT=,&DEVICE=,            XP$D00140
               &ERROPT=,&ERRO=,&LOCK=YES,&WRITEKEY=,&SEPASMB=           P$D00150
DTFSD3   NAME  1                                                        P$D00160
DTFSD    NAME  1                                                        P$D00170
DTFDA3   NAME  2                                                        P$D00180
DTFDA    NAME  2                                                        P$D00190
DTFRA    NAME  2                                                        P$D00200
DTFNI3   NAME  3                                                        P$D00210
DTFNI    NAME  3                                                        P$D00220
DPCA     NAME  4                                                        P$D00230
DPCA3    NAME  4                                                        P$D00240
         LCL   &IRG,&UPD,&VER,&WRK,&AFT,&WID,&WKY,&RID,&RKY,&IDL,&RL    P$D00250
         LCL   &SRC,&KLE,&SKA,&LAB,&IA1,&IA2,&BKS,&TYP,&KEY,&EOF        P$D00260
         LCL   &RSZ,&RCF,&VBL,&FG,&FC,&REGS                             P$D00270
         LCL   &FB,&N1,&N2,&N3,&N4,&N5                                  P$D00280
         DO    0                                                        P$D00290
*        &AFT  &AFTR/&AFTER SPECIFIED: FORMAT WRITE                     P$D00300
*        &BKS-BKSZ/BLKSIZE SPECIFICATION                                P$D00310
*        &DEV-DEVICE SPECIFICATION                                      P$D00320
*        &EOF-EOFA/EOFADDR                                              P$D00330
*        &ERR  ERROR ROUTINE: RERRO/&ERROR                              P$D00340
*        &IA1-IOA1/IOAREA1                                              P$D00350
*        &IOA-IOA2/IOAREA2                                              P$D00360
*        &IDL  NEXT RECORD ADDRESS: &IORG/&IDLOC                        P$D00370
*        &KLE  KEY LENGTH: &KLEN/&KEYLEN                                P$D00380
*        &KEY  KEY FIELD ADDRESS: &KARG/&KEYARG                         P$D00390
*        &LAB-LBAD/LABADDR                                              P$D00400
*        &RCF-RCFM/RECFORM                                              P$D00410
*        &RID  READ BY ID: &RDID/&READID                                P$D00420
*        &RKY  READ BY KEY: &RDKY/&READKEY                              P$D00430
*        &RL   RELATIVE ADDRESSING: &REL/&RELATIVE                      P$D00440
*        &RSZ-RCSZ/RECSIZE                                              P$D00450
*        &SRC  MULTI TRACK SEARCH: &SRCM/&SRCHM                         P$D00460
*        &SKA  SEEK ADDRESS: &SKAD/&SEEKADR                             P$D00470
*        &TYP-TYPF/TYPEFLE                                              P$D00480
*        &UPD-UPDT/UPDATE                                               P$D00490
*        &VBL-VBLD/VARBLD                                               P$D00500
*        &VER-VRFY/VERIFY                                               P$D00510
*        &WID  WRITE BY IP: &WRID/&WRITEID                              P$D00520
*        &WKY  WRITE BY KEY: &WRKY/&WRITEKEY                            P$D00530
*        &WRK-WORK/WORKA                                                P$D00540
         ENDO                                                           P$D00550
         LCL   &ERO                                                     P$D00560
         DO    (&P(0)=2=0)**(&P(0)=4=0)                                 P$D00570
&ERO     SET   '&ERRO'                                                  P$D00580
         DO    '&ERROPT'=''=0                                           P$D00590
&ERO     SET   '&ERROPT'                                                P$D00600
         ENDO                                                           P$D00610
         DO    ('&ERRO'=''=0)**('&ERROPT'=''=0)                         P$D00620
         PNOTE '*','ERRO AND ERROPT BOTH SPECIFIED, ERROPT USED'        P$D00630
         ENDO                                                           P$D00640
         DO    ('&ERO'=''=0)**('&ERO'='SKIP'=0)**('&ERO'='IGNORE'=0)    P$D00650
         PNOTE '*','ERROPT INCORRECTLY SPECIFIED, IGNORED'              P$D00660
&ERO     SET   ''                                                       P$D00670
         ENDO                                                           P$D00680
         ENDO                                                           P$D00690
         DO    ('&BLKSIZE'=''=0)**('&BKSZ'=''=0)                        P$D00700
         PNOTE '*','BLKSIZE AND BKSZ SPECIFIED, BLKSIZE USED'           P$D00710
         ENDO                                                           P$D00720
         DO    ('&EOFADDR'=''=0)**('&EOFA'=''=0)                        P$D00730
         PNOTE '*','EOFADDR AND EOFA SPECIFIED, EOFADDR USED'           P$D00740
         ENDO                                                           P$D00750
         DO    ('&IOAREA1'=''=0)**('&IOA1'=''=0)                        P$D00760
         PNOTE '*','IOAREA1 AND IA1 SPECIFIED, IOAREA1 USED'            P$D00770
         ENDO                                                           P$D00780
         DO    ('&IOAREA2'=''=0)**('&IOA2'=''=0)                        P$D00790
         PNOTE '*','IOAREA2 AND IOA2 SPECIFIED, IOAREA2 USED'           P$D00800
         ENDO                                                           P$D00810
         DO    &P(0)=4=0                                                P$D00820
         DO    ('&LABADDR'=''=0)**('&LBAD'=''=0)                        P$D00830
         PNOTE '*','LABADDR AND LBAD SPECIFIED, LABADDR USED'           P$D00840
         ENDO                                                           P$D00850
         ENDO                                                           P$D00860
         DO    ('&RECSIZE'=''=0)**('&RCSZ'=''=0)                        P$D00870
         PNOTE '*','RECSIZE AND RCSZ SPECIFIED, RECSIZE USED'           P$D00880
         ENDO                                                           P$D00890
         DO    ('&RECFORM'=''=0)**('&RCFM'=''=0)                        P$D00900
         PNOTE '*','RECFORM AND RCFM SPECIFIED, RECFORM USED'           P$D00910
         ENDO                                                           P$D00920
         DO    &P(0)=4=0                                                P$D00930
         DO    ('&TYPEFLE'=''=0)**('&TYPF'=''=0)                        P$D00940
         PNOTE '*','TYPEFLE AND TYPF SPECIFIED, TYPEFLE USED'           P$D00950
         ENDO                                                           P$D00960
         DO    ('&UPDATE'=''=0)**('&UPDT'=''=0)                         P$D00970
         PNOTE '*','UPDATE AND UPDT SPECIFIED, UPDATE USED'             P$D00980
         ENDO                                                           P$D00990
         ENDO                                                           P$D01000
         DO    ('&VARBLD'=''=0)**('&VBLD'=''=0)                         P$D01010
         PNOTE '*','VARBLD AND VBLD SPECIFIED, VARBLD USED'             P$D01020
         ENDO                                                           P$D01030
         DO    &P(0)=4=0                                                P$D01040
         DO    ('&VERIFY'=''=0)**('&VRFY'=''=0)                         P$D01050
         PNOTE '*','VERIFY AND VRFY SPECIFIED, VERIFY USED'             P$D01060
         ENDO                                                           P$D01070
         DO    ('&WORKA'=''=0)**('&WORK'=''=0)                          P$D01080
         PNOTE '*','WORKA AND WORK SPECIFIED, WORKA USED'               P$D01090
         ENDO                                                           P$D01100
         ENDO                                                           P$D01110
         DO    ('&IORG'=''=0)**('&IDLOC'=''=0)                          P$D01120
         PNOTE '*','IORG AND IDLOC SPECIFIED, IDLOC USED'               P$D01130
         ENDO                                                           P$D01140
         DO    ('&KARG'=''=0)**('&KEYARG'=''=0)                         P$D01150
         PNOTE '*','KARG AND KEYARG SPECIFIED, KEYARG USED'             P$D01160
         ENDO                                                           P$D01170
         DO    ('&KLEN'=''=0)**('&KEYLEN'=''=0)                         P$D01180
         PNOTE '*','KLEN AND KEYLEN SPECFIED, KEYLEN USED'              P$D01190
         ENDO                                                           P$D01200
         DO    &P(0)=4=0                                                P$D01210
         DO    ('&REL'=''=0)**('&RELATIV'=''=0)                         P$D01220
         PNOTE '*','REL AND RELATIV SPECIFIED, RELATIV USED'            P$D01230
         ENDO                                                           P$D01240
         DO    ('&RDID'=''=0)**('&READID'=''=0)                         P$D01250
         PNOTE '*','RDID AND READID SPECIFIED, READID USED'             P$D01260
         ENDO                                                           P$D01270
         DO    ('&RDKY'=''=0)**('&READKEY'=''=0)                        P$D01280
         PNOTE '*','RDKY AND READKY SPECIFIED, READKEY USED'            P$D01290
         ENDO                                                           P$D01300
         DO    ('&WRKY'=''=0)**('&WRITEKY'=''=0)                        P$D01310
         PNOTE '*','WRKY AND WRITEKY BOTH SPECIFIED, WRITEKY USED'      P$D01320
         ENDO                                                           P$D01330
         DO    ('&WRID'=''=0)**('&WRITEID'=''=0)                        P$D01340
         PNOTE '*','WRID AND WRITEID SPECIFIED, WRITEID USED'           P$D01350
         ENDO                                                           P$D01360
         DO    ('&AFTR'=''=0)**('&AFTER'=''=0)                          P$D01370
         PNOTE '*','AFTR AND AFTER SPECIFIED, AFTER USED'               P$D01380
         ENDO                                                           P$D01390
         DO    ('&SRCM'=''=0)**('&SRCHM'=''=0)                          P$D01400
         PNOTE '*','SRCM AND SRCHM SPECIFIED, SRCHM USED'               P$D01410
         ENDO                                                           P$D01420
         DO    ('&SKAD'=''=0)**('&SEEKADR'=''=0)                        P$D01430
         PNOTE '*','SKAD AND SEEKADR SPECIFIED, SEEKADR USED'           P$D01440
         ENDO                                                           P$D01450
         ENDO                                                           P$D01460
         DO    (&P(0)=1)**('&IORG'=''=0)                                P$D01470
&IRG     SET   &IORG(1)                                                 P$D01480
         ENDO                                                           P$D01490
         DO    '&IOREG'=''=0                                            P$D01500
&IRG     SET   &IOREG(1)                                                P$D01510
         ENDO                                                           P$D01520
         DO    &P(0)=4=0                                                P$D01530
&UPD     SET   '&UPDT'                                                  P$D01540
         DO    '&UPDATE'=''=0                                           P$D01550
&UPD     SET   '&UPDATE'                                                P$D01560
         ENDO                                                           P$D01570
         DO    ('&UPD'=''=0)**('&UPD'='YES'=0)                          P$D01580
         PNOTE '*','UPDATE INCORRECTLY SPECIFIED, YES ASSUMED'          P$D01590
         ENDO                                                           P$D01600
&VER     SET   '&VRFY'                                                  P$D01610
         DO    '&VERIFY'=''=0                                           P$D01620
&VER     SET   '&VERIFY'                                                P$D01630
         ENDO                                                           P$D01640
         DO    ('&TRLBL'=''=0)**('&TRLBL'='YES'=0)                      P$D01650
         PNOTE '*','TRLBL INCORRECTLY SPECIFIED, YES ASSUMED'           P$D01660
         ENDO                                                           P$D01670
         DO    ('&VER'=''=0)**('&VER'='YES'=0)                          P$D01680
         PNOTE '*','VERIFY INCORRECTLY SPECIFIED, NO ASSUMED'           P$D01690
&VER     SET   'NO'                                                     P$D01700
         ENDO                                                           P$D01710
         ENDO                                                           P$D01720
&WRK     SET   '&WORK'                                                  P$D01730
         DO    '&WORKA'=''=0                                            P$D01740
&WRK     SET   '&WORKA'                                                 P$D01750
         ENDO                                                           P$D01760
         DO    ('&WRK'=''=0)**('&WRK'='YES'=0)                          P$D01770
         PNOTE '*','WORKA INCORRECTLY SPECIFIED, YES ASSUMED'           P$D01780
         ENDO                                                           P$D01790
         DO    ('&WRK'=''=0)**('&IRG'=''=0)                             P$D01800
         PNOTE '*','WORKA AND IOREG SPECIFIED, IOREG IGNORED'           P$D01810
&IRG     SET   ''                                                       P$D01820
         ENDO                                                           P$D01830
         DO    &P(0)=4=0                                                P$D01840
&AFT     SET   '&AFTR'                                                  P$D01850
         DO    '&AFTER'=''=0                                            P$D01860
&AFT     SET   '&AFTER'                                                 P$D01870
         ENDO                                                           P$D01880
         DO    ('&AFT'='YES'=0)**('&AFT'=''=0)                          P$D01890
         PNOTE '*','AFTER INCORRECTLY SPECIFIED, YES ASSUMED'           P$D01900
         ENDO                                                           P$D01910
&WID     SET   '&WRID'                                                  P$D01920
         DO    '&WRITEID'=''=0                                          P$D01930
&WID     SET   '&WRITEID'                                               P$D01940
         ENDO                                                           P$D01950
         DO    ('&WID'='YES'=0)**('&WID'=''=0)                          P$D01960
         PNOTE '*','WRITE ID INCORRECTLY SPECIFIED, YES ASSUMED'        P$D01970
         ENDO                                                           P$D01980
&WKY     SET   '&WRKY'                                                  P$D01990
         DO    '&WRITEKY'=''=0                                          P$D02000
&WKY     SET   '&WRITEKY'                                               P$D02010
         ENDO                                                           P$D02020
         DO    '&WRITEKEY'=''=0                                         P$D02030
&WKY     SET   '&WRITEKEY'                                              P$D02040
         ENDO                                                           P$D02050
         DO    ('&WKY'='YES'=0)**('&WKY'=''=0)                          P$D02060
         PNOTE '*','WRITE KEY INCORRECTLY SPECIFIED, YES ASSUMED'       P$D02070
         ENDO                                                           P$D02080
&RID     SET   '&RDID'                                                  P$D02090
         DO    '&READID'=''=0                                           P$D02100
&RID     SET   '&READID'                                                P$D02110
         ENDO                                                           P$D02120
         DO    ('&RID'='YES'=0)**('&RID'=''=0)                          P$D02130
         PNOTE '*','READ ID INCORRECTLY SPECIFIED, YES ASSUMED'         P$D02140
         ENDO                                                           P$D02150
&RKY     SET   '&RDKY'                                                  P$D02160
         DO    '&READKEY'=''=0                                          P$D02170
&RKY     SET   '&READKEY'                                               P$D02180
         ENDO                                                           P$D02190
         DO    ('&RKY'='YES'=0)**('&RKY'=''=0)                          P$D02200
         PNOTE '*','READ KEY INCORRECTLY SPECIFIED, YES ASSUMED'        P$D02210
         ENDO                                                           P$D02220
&IDL     SET   '&IORG'                                                  P$D02230
         DO    '&IDLOC'=''=0                                            P$D02240
&IDL     SET   '&IDLOC'                                                 P$D02250
         ENDO                                                           P$D02260
&RL      SET   '&REL'                                                   P$D02270
         DO    '&RELATIV'=''=0                                          P$D02280
&RL      SET   '&RELATIV'                                               P$D02290
         ENDO                                                           P$D02300
         DO    '&RL'=''=0                                               P$D02310
         DO    ('&RL'='R')++('&RL'='T')                                 P$D02320
         GOTO  .D7                                                      P$D02330
         ENDO                                                           P$D02340
         PNOTE '*','REL ADDRESSING INCORRECTLY SPECIFIED, T ASSUMED'    P$D02350
&RL      SET   'T'                                                      P$D02360
.D7      LABEL                                                          P$D02370
         ENDO                                                           P$D02380
&SRC     SET   '&SRCM'                                                  P$D02390
         DO    '&SRCHM'=''=0                                            P$D02400
&SRC     SET   '&SRCHM'                                                 P$D02410
         ENDO                                                           P$D02420
         DO    ('&SRC'='YES'=0)**('&SRC'=''=0)                          P$D02430
         PNOTE '*','SCRHM INCORRECTLY SPECIFIED, YES ASSUMED'           P$D02440
         ENDO                                                           P$D02450
         ENDO                                                           P$D02460
&KLE     SET   0                                                        P$D02470
         DO    '&KLEN'=''=0                                             P$D02480
&KLE     SET   '&KLEN'                                                  P$D02490
         ENDO                                                           P$D02500
         DO    ('&KEYLEN'=''=0)                                         P$D02510
&KLE     SET   '&KEYLEN'                                                P$D02520
         ENDO                                                           P$D02530
         DO    ('&LACE'=''=0)**(&KLE=0=0)                               P$D02540
         PNOTE '*','INTERLACE NOT SUPPORTED FOR KEYED DATA, IGNORED'    P$D02550
         ENDO                                                           P$D02560
         DO    &P(0)=4=0                                                P$D02570
&SKA     SET   '&SKAD'                                                  P$D02580
         DO    '&SEEKADR'=''=0                                          P$D02590
&SKA     SET   '&SEEKADR'                                               P$D02600
         ENDO                                                           P$D02610
&LAB     SET   '&LBAD'                                                  P$D02620
         DO    '&LABADDR'=''=0                                          P$D02630
&LAB     SET   '&LABADDR'                                               P$D02640
         ENDO                                                           P$D02650
         ENDO                                                           P$D02660
&IA1     SET   '&IOA1'                                                  P$D02670
         DO    '&IOAREA1'=''=0                                          P$D02680
&IA1     SET   '&IOAREA1'                                               P$D02690
         ENDO                                                           P$D02700
&IA2     SET   '&IOA2'                                                  P$D02710
         DO    '&IOAREA2'=''=0                                          P$D02720
&IA2     SET   '&IOAREA2'                                               P$D02730
         ENDO                                                           P$D02740
         DO    ('&IA2'=''=0)**('&WRK'='')**('&IRG'='')                  P$D02750
         PNOTE '*','WORKA OR IOREG SHOULD BE SPEC. WHEN IOAREA2 SPEC.'  P$D02760
         ENDO                                                           P$D02770
&BKS     SET   0                                                        P$D02780
         DO    '&BKSZ'=''=0                                             P$D02790
&BKS     SET   '&BKSZ'                                                  P$D02800
         ENDO                                                           P$D02810
         DO    '&BLKSIZE'=''=0                                          P$D02820
&BKS     SET   '&BLKSIZE'                                               P$D02830
         ENDO                                                           P$D02840
         DO    &P(0)=4=0                                                P$D02850
&TYP     SET   '&TYPF'                                                  P$D02860
         DO    '&TYPE'=''=0                                             P$D02870
&TYP     SET   '&TYPE'                                                  P$D02880
         ENDO                                                           P$D02890
         DO    '&TYPEFLE'=''=0                                          P$D02900
&TYP     SET   '&TYPEFLE'                                               P$D02910
         ENDO                                                           P$D02920
         DO    '&TYP'=''                                                P$D02930
         PNOTE '*','FILE TYPE NOT SPECIFIED, INPUT ASSUMED'             P$D02940
&TYP     SET   'INPUT'                                                  P$D02950
         ENDO                                                           P$D02960
         DO    ('&TYP'='INPUT'=0)**('&TYP'='OUTPUT'=0)**('&TYP'='INOUT'1P$D02970
               =0)                                                      P$D02980
         PNOTE '*','FILE TYPE INCORRECTLY SPECIFIED, INPUT ASSUMED'     P$D02990
&TYP     SET   'INPUT'                                                  P$D03000
         ENDO                                                           P$D03010
         ENDO                                                           P$D03020
&KEY     SET   '&KARG'                                                  P$D03030
         DO    '&KEYARG'=''=0                                           P$D03040
&KEY     SET   '&KEYARG'                                                P$D03050
         ENDO                                                           P$D03060
         DO    ('&KEY'='')**(('&WKY'=''=0)++('&RKY'=''=0))              P$D03070
         PNOTE 'P','WRITEKEY OR READKEY SPECIFIED, BUT NOT KEYARG'      P$D03080
         ENDO                                                           P$D03090
         DO    ('&KEY'=''=0)**(&KLE=0)                                  P$D03100
         PNOTE 'P','KEYARG SPECIFIED BUT KEYLEN NOT SPECIFIED'          P$D03110
         ENDO                                                           P$D03120
&EOF     SET   '&EOFA'                                                  P$D03130
         DO    '&EOFADDR'=''=0                                          P$D03140
&EOF     SET   '&EOFADDR'                                               P$D03150
         ENDO                                                           P$D03160
&RSZ     SET   0                                                        P$D03170
         DO    '&RCSZ'=''=0                                             P$D03180
&RSZ     SET   '&RCSZ'                                                  P$D03190
         ENDO                                                           P$D03200
         DO    '&RECSIZE'=''=0                                          P$D03210
&RSZ     SET   '&RECSIZE'                                               P$D03220
         ENDO                                                           P$D03230
&RCF     SET   '&RCFM'                                                  P$D03240
         DO    '&RECFORM'=''=0                                          P$D03250
&RCF     SET   '&RECFORM'                                               P$D03260
         ENDO                                                           P$D03270
         DO    '&RCF'=''                                                P$D03280
         PNOTE '*','RECORD FORMAT NOT SPECIFIED, FIXUNB ASSUMED'        P$D03290
&RCF     SET   'FIXUNB'                                                 P$D03300
         ENDO                                                           P$D03310
         DO    ('&WRK'='')**('&IRG'='')**('&RCF'(4,3)='BLK')            P$D03320
         PNOTE '*','WORKA OR IOREG NOT SPECIFIED FOR BLOCKED FILE'      P$D03330
         ENDO                                                           P$D03340
         DO    '&VBLD'=''=0                                             P$D03350
&VBL     SET   &VBLD(1)                                                 P$D03360
         ENDO                                                           P$D03370
         DO    '&VARBLD'=''=0                                           P$D03380
&VBL     SET   &VARBLD(1)                                               P$D03390
         ENDO                                                           P$D03400
         DO    &P(0)=4=0                                                P$D03410
&FB      SET   16*('&LAB'=''=0)+8*(('&KLE'='')++(&KLE=0))               P$D03420
&FB      SET   &FB+4*('&VER'='YES')                                     P$D03430
&FB      SET   &FB+2048*(('&KLE'=''=0)**(&KLE=0=0))                     P$D03440
         DO    (&P(0)=2)++(&P(0)=3)                                     P$D03450
&FB      SET   &FB+4096*('&AFT'=''=0)                                   P$D03460
&FB      SET   &FB+1024*('&SRC'=''=0)+512*('&RL'='R')+256*('&RL'='T')   P$D03470
&N1      SET   'D'                                                      P$D03480
&N2      SET   1                                                        P$D03490
&N3      SET   1                                                        P$D03500
&N4      SET   1                                                        P$D03510
&N5      SET   64                                                       P$D03520
         ENDO                                                           P$D03530
         DO    (&P(0)=3)++(&P(0)=1)                                     P$D03540
&N1      SET   'N'                                                      P$D03550
&N5      SET   96                                                       P$D03560
&FB      SET   &FB+64*('&TYP'='OUTPUT')+32*('&TYP'='INPUT')             P$D03570
&FB      SET   &FB+96*('&TYP'='INOUT')                                  P$D03580
&FB      SET   &FB+2*(('&TYP'='INPUT')**('&UPD'=''=0))                  P$D03590
&FB      SET   &FB+('&WRK'=''=0)                                        P$D03600
&N2      SET   ('&TYP'='OUTPUT')++('&TYP'='INOUT')                      P$D03610
&N3      SET   (('&TYP'='INPUT')++('&TYP'='INOUT'))**('&UPD'=''=0)      P$D03620
&N4      SET   ('&TYP'='INPUT')++('&TYP'='INOUT')                       P$D03630
         DO    &P(0)=1                                                  P$D03640
&N1      SET   'S'                                                      P$D03650
&N5      SET   32                                                       P$D03660
         ENDO                                                           P$D03670
         ENDO                                                           P$D03680
         ENDO                                                           P$D03690
         CNOP  0,8                                                      P$D03700
         DO    ('&LABL'='')++('&LABL'>'Z999999')                        P$D03710
         PNOTE 'P','FILENAME UNDEFINED OR GREATER THAN 7 CHARACTERS'    P$D03720
         ENDO                                                           P$D03730
         ENTRY &LABL                                                    P$D03740
         DO    '&SEPASMB'='NO'=0                                        P$D03742
         ENTRY &LABL.B                                                  P$D03750
         ENTRY &LABL.D                                                  P$D03760
         ENDO                                                           P$D03762
         DO    &P(0)=4=0                                                P$D03770
         DO    '&SEPASMB'='NO'=0                                        P$D03772
         ENTRY &LABL.A                                                  P$D03780
         ENTRY &LABL.C                                                  P$D03790
         ENTRY &LABL.E                                                  P$D03800
         ENDO                                                           P$D03802
&LABL    DC    XL4'00008048'            CCB                    DC$CCB   P$D03810
         DC    2F'0'                                                    P$D03820
         DC    A(*+48)                                                  P$D03830
         DC    3F'0'                                                    P$D03840
         DC    CL7'&LABL'               FILENAME            DC$NME      P$D03850
         DC    C' '                                                     P$D03860
&FG      SET   0                                                        P$D03870
         DO    '&SRC'=''=0                                              P$D03880
&FG      SET   &FG+64                                                   P$D03890
         ENDO                                                           P$D03900
         DO    (&P(0)=1)                                                P$D03910
&FG      SET   &FG+2                                                    P$D03920
         ENDO                                                           P$D03930
&FG      SET   &FG+8*('&LOCK'='YES')                                    P$D03940
         DC    Y(&FG)                   MODULE FLAGS           DC$MFLG  P$D03950
         DC    XL8'00'                  PUBS VOLS 1-4          DC$PUB   P$D03960
         DC    YL1(&N5)                 DTF TYPE CODE          DC$DTF   P$D03970
         DC    YL2(&FB)                 DTF REQUIREMENTS                P$D03980
         DC    XL1'0'                   FUNCTION CODE          DC$REQS  P$D03990
         DC    Y(0)                     ERROR FLAGS            DC$ERFLG P$D04000
         EXTRN DD$&N1.&N2.&N3.&N4                                       P$D04010
         DC    A(DD$&N1.&N2.&N3.&N4)    IOCS MODULE ADDRESS    DC$IOCS  P$D04020
&LABL.E  DC    YL1(0)                   ERROR CODE             DC$ERCD  P$D04030
         DC    AL3(0)                                          DC$ERIOC P$D04040
         DC    YL1(0)                   BCW (16-BYTES)         DC$OPCD  P$D04050
         DC    AL3(0)                   I/O BUFFER ADDRESS     DC$IOB   P$D04060
         DC    H'0'                     BCW BLOCK SIZE         DC$BKS   P$D04070
         DC    XL1'0'                                                   P$D04080
         DC    XL1'0'                   SECTORS/BLOCK          DC$SPB   P$D04090
         DC    H'0'                                                     P$D04100
         DC    YL1(0)                   HEAD                   DC$HEAD  P$D04110
         DC    XL1'0'                                                   P$D04120
         DC    H'0'                     CYLINDER               DC$CYL   P$D04130
         DC    YL1(0)                   RECORD NUMBER          DC$R     P$D04140
         DC    XL1'0'                                                   P$D04150
         DC    A(0)                     EXTENT TABLE ADDRESS   DC$EXT   P$D04160
         DO    &P(0)=3                                                  P$D04170
&FG      SET   0+('&PCA1'=''=0)+('&PCA2'=''=0)+('&PCA3'=''=0)           P$D04180
&FG      SET   &FG+('&PCA4'=''=0)+('&PCA5'=''=0)+('&PCA6'=''=0)         P$D04190
&FG      SET   &FG+('&PCA7'=''=0)                                       P$D04200
         DO    &FG=0                                                    P$D04210
&FG      SET   1                                                        P$D04220
         ENDO                                                           P$D04230
         ENDO                                                           P$D04240
         DO    &P(0)=3=0                                                P$D04250
&FG      SET   1                                                        P$D04260
         ENDO                                                           P$D04270
         DC    XL1'&FG'            PCA COUNT                   DC$PCACT P$D04280
&FB      SET   ''                                                       P$D04290
         DC    XL1'0'                   FLAGS                  DC$TFLG  P$D04300
         DC    H'0'                     RELATIVE EXTENT COUNT  DC$REXCT P$D04310
         DC    A(0)                     TRACKS/CYLINDER        DC$TPC   P$D04320
         DC    H'0'                     FILE LOW HEAD          DC$LOHD  P$D04330
         DC    H'0'                     FILE HIGH HEAD         DC$HIHD  P$D04340
         DO    &P(0)=3=0                                                P$D04350
         DC    XL1'1'                                          DC$PCA1  P$D04360
         DC    AL3(&LABL.A)                                             P$D04370
         DC    6F'0'                                                    P$D04380
         GOTO  .L601                                                    P$D04390
         ENDO                                                           P$D04400
         DO    '&PCA1'=''=0                                             P$D04410
&FB      SET   '&PCA1'                                                  P$D04420
         DC    XL1'1'                                          DC$PCA1  P$D04430
         DC    AL3(&LABL.A)                                             P$D04440
         ENDO                                                           P$D04450
         DO    '&PCA2'=''=0                                             P$D04460
         DO    '&SEPASMB'='NO'=0                                        P$D04462
         EXTRN &PCA2                                                    P$D04470
         ENDO                                                           P$D04472
         DC    XL1'2'                                          DC$PCA2  P$D04480
         DC    AL3(&PCA2)                                               P$D04490
         DO    '&FB'=''                                                 P$D04500
&FB      SET   '&PCA2'                                                  P$D04510
         ENDO                                                           P$D04520
         ENDO                                                           P$D04530
         DO    '&PCA3'=''=0                                             P$D04540
         DO    '&SEPASMB'='NO'=0                                        P$D04542
         EXTRN &PCA3                                                    P$D04550
         ENDO                                                           P$D04552
         DC    XL1'3'                                          DC$PCA3  P$D04560
         DC    AL3(&PCA3)                                               P$D04570
         DO    '&FB'=''                                                 P$D04580
&FB      SET   '&PCA3'                                                  P$D04590
         ENDO                                                           P$D04600
         ENDO                                                           P$D04610
         DO    '&PCA4'=''=0                                             P$D04620
         DO    '&SEPASMB'='NO'=0                                        P$D04622
         EXTRN &PCA4                                                    P$D04630
         ENDO                                                           P$D04632
         DC    XL1'4'                                          DC$PCA4  P$D04640
         DC    AL3(&PCA4)                                               P$D04650
         DO    '&FB'=''                                                 P$D04660
&FB      SET   '&PCA4'                                                  P$D04670
         ENDO                                                           P$D04680
         ENDO                                                           P$D04690
         DO    '&PCA5'=''=0                                             P$D04700
         DO    '&SEPASMB'='NO'=0                                        P$D04702
         EXTRN &PCA5                                                    P$D04710
         ENDO                                                           P$D04712
         DC    XL1'5'                                          DC$PCA5  P$D04720
         DC    AL3(&PCA5)                                               P$D04730
         DO    '&FB'=''                                                 P$D04740
&FB      SET   '&PCA5'                                                  P$D04750
         ENDO                                                           P$D04760
         ENDO                                                           P$D04770
         DO    '&PCA6'=''=0                                             P$D04780
         DO    '&SEPASMB'='NO'=0                                        P$D04782
         EXTRN &PCA6                                                    P$D04790
         ENDO                                                           P$D04792
         DC    XL1'6'                                          DC$PCA6  P$D04800
         DC    AL3(&PCA6)                                               P$D04810
         DO    '&FB'=''                                                 P$D04820
&FB      SET   '&PCA6'                                                  P$D04830
         ENDO                                                           P$D04840
         ENDO                                                           P$D04850
         DO    '&PCA7'=''=0                                             P$D04860
         DO    '&SEPASMB'='NO'=0                                        P$D04862
         EXTRN &PCA7                                                    P$D04870
         ENDO                                                           P$D04872
         DC    XL1'7'                                          DC$PCA7  P$D04880
         DC    AL3(&PCA7)                                               P$D04890
         DO    '&FB'=''                                                 P$D04900
&FB      SET   '&PCA7'                                                  P$D04910
         ENDO                                                           P$D04920
         ENDO                                                           P$D04930
         DO     '&FB'=''                                                P$D04940
         DC     XL1'1'                                         DC$PCA1  P$D04950
         DC     AL3(&LABL.A)                                            P$D04960
         ENDO                                                           P$D04970
         DO    &FG<7                                                    P$D04980
&FG      SET   7-&FG                                                    P$D04990
         DC    (&FG)F'0'                                                P$D05000
         ENDO                                                           P$D05010
.L601    LABEL                                                          P$D05020
&FG      SET   0+16*('&SRC'=''=0)+2*('&LAB'=''=0)+('&TRLBL'=''=0)       P$D05030
&FG      SET   &FG+8*('&ERO'='SKIP')+4*('&ERO'='IGNORE')                P$D05040
         DC    YL1(&FG)                 FLAG 1                 DC$FG1   P$D05050
&FG      SET   0+128*('&IDL'=''=0)+64*('&AFT'='YES')+2*('&RL'='R')+('&RXP$D05060
               L'='T')                                                  P$D05070
         DC    YL1(&FG)                 FLAG 2                 DC$FG2   P$D05080
&FG      SET   0+128*(('&TYP'='OUTPUT')++('&TYP'='INOUT'))              P$D05090
&FG      SET   &FG+64*(('&TYP'='INPUT')**('&UPD'=''))                   P$D05100
&FG      SET   &FG+32*(('&TYP'='INPUT')**('&UPD'=''=0))                 P$D05110
&FG      SET   &FG+16*('&OPTION'='YES')                                 P$D05120
         DC    YL1(&FG)                 FLAG 3                 DC$FG3   P$D05130
         DC    XL1'00'                                         DC$FCS   P$D05140
         DC    A(&LABL.A)               CURRENT PCA ADDRESS    DC$PADDR P$D05150
         DC    A(0)                                            DC$RELOC P$D05160
         DO    '&SAVAREA'=''=0                                          P$D05170
         DO    '&SEPASMB'='NO'=0                                        P$D05172
         EXTRN &SAVAREA                                                 P$D05180
         ENDO                                                           P$D05182
         DC    A(&SAVAREA)              SAVE AREA           DC$SAV      P$D05190
         DC    A(0)                                         DC$SAVR     P$D05200
         GOTO  .L9                                                      P$D05210
         ENDO                                                           P$D05220
         DC    X'F0000000'              (NOT SPECIFIED)         DC$SAV  P$D05230
         DC    A(0)                                             DC$SAVR P$D05240
.L9      LABEL                                                          P$D05250
         DO    '&ERROR'=''                                              P$D05260
         PNOTE 'P','ERROR EXIT NOT SPEC, ERRORS RETURNED IN-LINE'       P$D05270
         DC    A(0)                     (NOT SPECIFIED)     DC$ERR      P$D05280
         ENDO                                                           P$D05290
         DO    '&ERROR'=''=0                                            P$D05300
         DO    '&SEPASMB'='NO'=0                                        P$D05302
         EXTRN &ERROR                                                   P$D05310
         ENDO                                                           P$D05312
         DC    A(&ERROR)                ERROR ADDRESS       DC$ERR      P$D05320
         ENDO                                                           P$D05330
&LABL.C  DC    A(0)                     ERROR FLAGS            DC$ERRF  P$D05340
         DO    '&LAB'=''=0                                              P$D05350
         DO    '&SEPASMB'='NO'=0                                        P$D05352
         EXTRN &LAB                                                     P$D05360
         ENDO                                                           P$D05362
         DC    A(&LAB)                  LABADDR ADDRESS     DC$LBL      P$D05370
         GOTO  .L11                                                     P$D05380
         ENDO                                                           P$D05390
         DC    A(0)                     (NOT SPECIFIED)     DC$LBL      P$D05400
.L11     LABEL                                                          P$D05410
         DO    &P(0)=1                                                  P$D05420
         DC    A(0)                     (NOT SPECIFIED)        DD$SKAD  P$D05430
         DC    A(0)                     (NOT SPECIFIED)        DD$IDLOC P$D05440
         GOTO  .D13                                                     P$D05450
         ENDO                                                           P$D05460
         DO    '&SKA'=''=0                                              P$D05470
         DO    '&SEPASMB'='NO'=0                                        P$D05472
         EXTRN &SKA                                                     P$D05480
         ENDO                                                           P$D05482
         DC    A(&SKA)                  SEEK ADDRESS        DD$SKA      P$D05490
         GOTO  .D90                                                     P$D05500
         ENDO                                                           P$D05510
         PNOTE 'P','SEEK ADDRESS NOT SPECIFIED'                         P$D05520
         DC    A(0)                     (NOT SPECIFIED)     DD$SKA      P$D05530
.D90     LABEL                                                          P$D05540
         DO    '&IDL'=''=0                                              P$D05550
         DO    '&SEPASMB'='NO'=0                                        P$D05552
         EXTRN &IDL                                                     P$D05560
         ENDO                                                           P$D05562
         DC    A(&IDL)                  IDLOC               DD$IDL      P$D05570
         GOTO  .D13                                                     P$D05580
         ENDO                                                           P$D05590
         DC    A(0)                     (NOT SPECIFIED)     DD$IDL      P$D05600
.D13     LABEL                                                          P$D05610
&LABL.A  EQU   *                                                        P$D05620
         DO    '&FB'=''=0                                               P$D05630
         DO    '&SEPASMB'='NO'=0                                        P$D05632
         ENTRY &FB                                                      P$D05640
         ENDO                                                           P$D05642
         ENDO                                                           P$D05650
&FB      DC    A(1)                     BLOCK ADDRESS          DC$PCAID P$D05660
         ENDO                                                           P$D05670
         DO    &P(0)=4                                                  P$D05680
&LABL    DC    A(1)                     BLOCK ADDRESS          DC$PCAID P$D05690
         ENDO                                                           P$D05700
         DC    A(0)                     MAX BLOCK ADDRESS      DC$PMBA  P$D05710
         DC    A(0)                     BLOCKS/TRACK           DC$BPT   P$D05720
         DC    XL1'01'                  PARTITION ID           DC$PID   P$D05730
         DC    AL3(1)                   EOD ID                 DC$EODID P$D05740
         DO    '&IA1'=''                                                P$D05750
         PNOTE 'P','IO AREA 1 REQUIRED FOR ALL FILES'                   P$D05760
         DC    A(0)                     (NOT SPECIFIED)     DC$A1       P$D05770
         GOTO  .L6                                                      P$D05780
         ENDO                                                           P$D05790
         DO    '&SEPASMB'='NO'=0                                        P$D05792
         EXTRN &IA1                                                     P$D05800
         ENDO                                                           P$D05802
         DC    XL1'1'                   IOAREA1 ADDRESS        DC$A1    P$D05810
         DC    AL3(&IA1)                                                P$D05820
.L6      LABEL                                                          P$D05830
         DO    '&BKS'=''                                                P$D05840
         PNOTE '*','BLKSIZE NOT SPECIFIED, 256 ASSUMED'                 P$D05850
&BKS     SET   256                                                      P$D05860
         ENDO                                                           P$D05870
         DO    &P(0)=4=0                                                P$D05880
         DO    ('&TYP'='OUTPUT'=0)**('&LAB'=''=0)**(&BKS>79=0)          P$D05890
         PNOTE '*','CAUTION--IOAREA1 MUST BE MIN 80 BYTES FOR LABELS'   P$D05900
         ENDO                                                           P$D05910
         ENDO                                                           P$D05920
         DC    Y(&BKS)                  BLOCK SIZE          DC$BKS      P$D05930
         DC    XL1'00'                                                  P$D05940
         DC    XL1'00'                  SECTORS/BLOCK          DC$SPB   P$D05950
         DO    &KLE=0=0                                                 P$D05960
         DO    &P(0)=1                                                  P$D05970
&KLE     SET   0                                                        P$D05980
         ENDO                                                           P$D05990
         DO    (&KLE<3)++(&KLE>255)                                     P$D06000
         PNOTE '*','KEY LENGTH INCORRECTLY SPECIFIED, 0 ASSUMED'        P$D06010
&KLE     SET   0                                                        P$D06020
         ENDO                                                           P$D06030
         DC    Y(&KLE)                  KEY LENGTH          DC$KLE      P$D06040
         GOTO  .D150                                                    P$D06050
         ENDO                                                           P$D06060
         DO    '&LACE'=''                                               P$D06070
         DC    Y(0)                                            DC$LACE  P$D06080
         GOTO  .D150                                                    P$D06090
         ENDO                                                           P$D06100
         DC    Y(&LACE)                                        DC$LACE  P$D06110
.D150    LABEL                                                          P$D06120
         DO    (&P(0)=3)++(&P(0)=4)                                     P$D06130
&FB      SET   '&UOS'                                                   P$D06140
         DO    &UOS>100                                                 P$D06150
         PNOTE '*','UOS INCORRECTLY SPECIFIED, 0 ASSUMED'               P$D06160
&FB      SET   0                                                        P$D06170
         ENDO                                                           P$D06180
         ENDO                                                           P$D06190
         DO    (&P(0)=1)++(&P(0)=2)                                     P$D06200
&FB      SET   100                                                      P$D06210
         ENDO                                                           P$D06220
         DC    Y(&FB)                                          DC$UOS   P$D06230
         DO    (&P(0)=3)++(&P(0)=4)                                     P$D06240
&N1      SET   '&SIZE'                                                  P$D06250
         DO    (&SIZE=0)++(&SIZE>100)                                   P$D06260
         PNOTE 'P','SIZE INCORRECTLY SPECIFIED, 1 PERCENT ASSUMED'      P$D06270
&N1      SET   1                                                        P$D06280
         ENDO                                                           P$D06290
         ENDO                                                           P$D06300
         DO    (&P(0)=1)++(&P(0)=2)                                     P$D06310
&N1      SET   100                                                      P$D06320
         ENDO                                                           P$D06330
         DC    Y(&N1)                                          DC$LADJ  P$D06340
         DC    Y(0)                                                     P$D06350
&FG      SET   8                                                        P$D06360
         DO    (&P(0)=1)++(&P(0)=2)                                     P$D06361
         DO    ((&P(0)=2)**('&AFT'=''=0))++((&P(0)=2=0)**('&TYP'='INPUTXP$D06370
               '=0)**('&LACE'=''))                                      P$D06380
&FG      SET   &FG+128                                                  P$D06390
         ENDO                                                           P$D06400
         ENDO                                                           P$D06401
&FG      SET   &FG+4*(((&P(0)=3)++(&P(0)=4))**(&UOS=0))                 P$D06410
&FG      SET   &FG+64*(('&LACE'=''=0)**(&KLE=0))                        P$D06420
         DO    &P(0)=2=0                                                P$D06430
&FG      SET   &FG+32                                                   P$D06440
         ENDO                                                           P$D06450
&FG      SET   &FG+16*('&VER'='YES')                                    P$D06460
&FG      SET   &FG+2*(&KLE=0=0)                                         P$D06470
         DC    YL1(&FG)                 PARTITION FLAG         DC$PFG1  P$D06480
         DO    '&EOF'=''                                                P$D06490
         DO    ((&P(0)=1)++(&P(0)=3))**(('&TYP'='INPUT')++('&TYP'='INOU1P$D06500
               T'))                                                     P$D06510
         PNOTE 'P','EOFADDR REQUIRED BUT NOT SPECIFIED'                 P$D06520
         ENDO                                                           P$D06530
         DC    AL3(0)                   (NOT SPECIFIED)        DC$EOD   P$D06540
         GOTO  .L5                                                      P$D06550
         ENDO                                                           P$D06560
         DO    '&SEPASMB'='NO'=0                                        P$D06562
         EXTRN &EOF                                                     P$D06570
         ENDO                                                           P$D06572
         DC    AL3(&EOF)                EOF/EOD ADDRESS        DC$EOD   P$D06580
.L5      LABEL                                                          P$D06590
         DO    '&KEY'=''=0                                              P$D06600
         DO    '&SEPASMB'='NO'=0                                        P$D06602
         EXTRN &KEY                                                     P$D06610
         ENDO                                                           P$D06612
         DC    A(&KEY)                  KEY FIELD ADDRESS      DD$KYL   P$D06620
         GOTO  .D12                                                     P$D06630
         ENDO                                                           P$D06640
         DC    A(0)                                            DD$KYL   P$D06650
.D12     LABEL                                                          P$D06660
&REGS    SET   &BKS-&KLE                                                P$D06670
&FG      SET   1                                                        P$D06680
         DO    '&RCF'='FIXUNB'                                          P$D06690
         GOTO  .L7                                                      P$D06700
         ENDO                                                           P$D06710
         DO    '&RCF'='FIXBLK'                                          P$D06720
         DO    (&RSZ>&REGS)++(&REGS=(&REGS/&RSZ)*&RSZ=0)                P$D06730
         PNOTE '*','BLKSIZE LESS THAN OR NOT MULTIPLE OF RECSIZE'       P$D06740
&RSZ     SET   &REGS                                                    P$D06750
         ENDO                                                           P$D06760
&FG      SET   &REGS/&RSZ                                               P$D06770
&REGS    SET   &RSZ                                                     P$D06780
         ENDO                                                           P$D06790
.L7      LABEL                                                          P$D06800
         DC    Y(&REGS)                 RECSIZE             DC$REC      P$D06810
         DC    Y(0)                     BLOCK OFFSET                    P$D06820
&FC      SET   0+(128*('&WRK'='YES')+64*('&IA2'=''=0)+16*('&IRG'=''=0)+1P$D06830
               8*('&VBL'=''=0))                                         P$D06840
         DO    (&P(0)=3)++(&P(0)=4)                                     P$D06850
&FC      SET   &FC+32*('&SUBFILE'='YES')                                P$D06860
         ENDO                                                           P$D06870
         DC    YL1(&FC)                 FLAG 4                 DC$FG4   P$D06880
         DC    XL1'00'                  FLAG 5                 DC$FG5   P$D06890
         DO    '&RCF'='FIXBLK'                                          P$D06900
&REGS    SET   X'1000'                                                  P$D06910
&VBL     SET   ''                                                       P$D06920
         GOTO  .L4                                                      P$D06930
         ENDO                                                           P$D06940
         DO    '&RCF'='VARBLK'                                          P$D06950
&REGS    SET   X'0800'                                                  P$D06960
         GOTO  .L4                                                      P$D06970
         ENDO                                                           P$D06980
         DO    '&RCF'='FIXUNB'                                          P$D06990
&REGS    SET   X'0400'                                                  P$D07000
&VBL     SET   ''                                                       P$D07010
         GOTO  .L4                                                      P$D07020
         ENDO                                                           P$D07030
         DO    '&RCF'='VARUNB'                                          P$D07040
&REGS    SET   X'0200'                                                  P$D07050
         GOTO  .L4                                                      P$D07060
         ENDO                                                           P$D07070
         PNOTE '*','RECORD FORMAT INCORRECTLY SPECIFIED,FIXUNB ASSUMED' P$D07080
&REGS    SET   X'0400'                                                  P$D07090
.L4      LABEL                                                          P$D07100
         DC    Y(&REGS)                 RECORD FORMAT          DC$RFM   P$D07110
         DC    A(0)                     RESERVED               DC$TAB   P$D07120
         DO    '&IA2'=''                                                P$D07130
         DC    XL1'1'                   (NOT SPECIFIED)        DC$A2    P$D07140
         DC    AL3(&IA1)                                                P$D07150
         ENDO                                                           P$D07160
         DO    '&IA2'=''=0                                              P$D07170
         DO    '&SEPASMB'='NO'=0                                        P$D07172
         EXTRN &IA2                                                     P$D07180
         ENDO                                                           P$D07182
         DC    XL1'1'                   IOAREA2 ADDRESS        DC$A2    P$D07190
         DC    AL3(&IA2)                                                P$D07200
         ENDO                                                           P$D07210
         DC    Y(0)                     CURRENT DISPLACEMENT   DS$CUR   P$D07220
         DC    Y(0)                     SIZE OF LAST RECORD    DS$LST   P$D07230
         DO    '&IRG'=''                                                P$D07240
&REGS    SET   0                                                        P$D07250
         GOTO  .L8                                                      P$D07260
         ENDO                                                           P$D07270
         DO    (&IRG<2)++(&IRG>12)                                      P$D07280
         DO    (&IRG=13)**('&SAVAREA'=''=0)                             P$D07290
&REGS    SET   4096                                                     P$D07300
         GOTO  .L8                                                      P$D07310
         ENDO                                                           P$D07320
         PNOTE '*','IOREG INCORRECTLY SPECIFIED, IGNORED'               P$D07330
&REGS    SET   0                                                        P$D07340
         GOTO  .L8                                                      P$D07350
         ENDO                                                           P$D07360
&REGS    SET   20+4*&IRG                                                P$D07370
.L8      LABEL                                                          P$D07380
         DC    Y(&REGS)                 IOREG REGISTER         DS$IRG   P$D07390
         DO    '&VBL'=''                                                P$D07400
&REGS    SET   0                                                        P$D07410
         GOTO  .L3                                                      P$D07420
         ENDO                                                           P$D07430
         DO    (&VBL>12)++(&VBL<2)                                      P$D07440
         DO    (&VBL=13)**('&SAVAREA'=''=0)                             P$D07450
&REGS    SET   4096                                                     P$D07460
         GOTO  .L3                                                      P$D07470
         ENDO                                                           P$D07480
         PNOTE '*','INVALID REGISTER SPECIFIED FOR VARBLD, IGNORED'     P$D07490
&REGS    SET   0                                                        P$D07500
         GOTO  .L3                                                      P$D07510
         ENDO                                                           P$D07520
&REGS    SET   20+4*(&VBL)                                              P$D07530
.L3      LABEL                                                          P$D07540
         DC    Y(&REGS)                 VARBLD REGISTER     DC$VBL      P$D07550
         DC    A(&FG)                   RECORDS/BLK                     P$D07560
         DC    A(0)                     REC/BLK FOR LAST BLK   DC$LRPB  P$D07570
         DC    A(1)                                            DD$HIEOD P$D07580
&LABL.B  DC    A(0)                     NOTE RELATIVE BLK      DC$BBB   P$D07590
&LABL.D  DC    Y(0)                     NOTE DISPLACEMENT      DS$NOTED P$D07600
         END                                                            P$D07610
