&FNAME   PROC  &PR,1,                                                  XP$D00010
               &ASCII=,                                                XP$D00020
               &BKSZ=,&BLKSIZE=,                                       XP$D00030
               &CNTL=,&CNTRL=,&CONTROL=,                               XP$D00040
               &CODE=,                                                 XP$D00050
               &CTLCHR=,                                               XP$D00060
               &ERROR=,                                                XP$D00070
               &IOA1=,&IOAREA1=,                                       XP$D00080
               &IOA2=,&IOAREA2=,                                       XP$D00090
               &IORG=,&IOREG=,                                         XP$D00100
               &OPTION=,                                               XP$D00110
               &PRAD=,                                                 XP$D00120
               &PROV=,&PRTOV=,&PRINTOV=,                               XP$D00130
               &RCFM=,&RECFORM=,                                       XP$D00140
               &RCSZ=,&RECSIZE=,                                       XP$D00150
               &SAVAREA=,                                              XP$D00160
               &UCS=,                                                  XP$D00170
               &VFB=,                                                  XP$D00180
               &WORK=,&WORKA=,                                         XP$D00190
               &AUE=,&CH1=,&CH2=,&CH3=,&CH4=,&CH5=,&CH6=,&CH7=,&CHNL=,&XP$D00200
               CRDT=,&DEVA=,                                           XP$D00210
               &DEVADDR=,&DEVICE=,&FLID=,&FONT=,&GENO=,&HDR=,&LINE=,&MOXP$D00220
               DNAME=,                                                 XP$D00230
               &OTBL=,&PBUF=,&RPNO=,&SEPASMB=,&STLIST=,&SWAP=,&TYPEFLE=XP$D00240
               ,&VOLN=,&XPDT=,                                         XP$D00250
               &ERROPT=,&OPENXIT=,&RDONLY=                              P$D00260
DTFPR3   NAME  0              OS/3 DTFPR  J.BILL  02/01/74              P$D00270
DTFPR    NAME  0                                                        P$D00280
DTFDP    NAME  1                                                        P$D00290
*        DTFPR     76/7/26                                              P$D00300
         PNOTE *,'I/O AREAS MUST BE ALIGNED SO THAT THE FIRST'          P$D00310
         PNOTE *,'BYTE OF DATA TO BE PRINTED FALLS ON A'                P$D00320
         PNOTE *,'HALFWORD BOUNDARY.'                                   P$D00330
         GBL   &DM$C1                                                   P$D00340
         LCL   &SBKSD                                                   P$D00350
         LCL   &SBKSL                                                   P$D00360
         LCL   &SBKSU                                                   P$D00370
         LCL   &SPRAD                                                   P$D00380
         LCL   &SPROV                                                   P$D00390
         LCL   &SRCFM                                                   P$D00400
         LCL   &SRFM                                                    P$D00410
         LCL   &SRCSZ                                                   P$D00420
         LCL   &SREC                                                    P$D00430
         LCL   &SFAC                                                    P$D00440
         LCL   &SFG1                                                    P$D00450
         LCL   &SFG2                                                    P$D00460
         LCL   &SFG3                                                    P$D00470
         LCL   &SFG4                                                    P$D00480
         LCL   &SFG5                                                    P$D00490
         LCL   &SBKS                                                    P$D00500
         LCL   &SCNT                                                    P$D00510
         LCL   &SIOA1                                                   P$D00520
         LCL   &SIOA2                                                   P$D00530
         LCL   &SIORG                                                   P$D00540
         LCL   &SIOR                                                    P$D00550
         LCL   &SRLA                                                    P$D00560
         LCL   &SWORK                                                   P$D00570
         CNOP  0,8                      DOUBLE WORD BOUNDARY ALIGNMENT  P$D00580
&SBKSU   SET   160                      BLOCK SIZE UPPER LIMIT          P$D00590
&SBKSL   SET   2                        BLOCK SIZE LOWER LIMIT          P$D00600
&SBKSD   SET   120                      BLOCK SIZE DEFAULT VALUE        P$D00610
&SPRAD   SET   9                                                        P$D00620
&SFG1    SET   0                                                        P$D00630
&SFG2    SET   0                                                        P$D00640
&SFG3    SET   0                                                        P$D00650
&SFG4    SET   0                                                        P$D00660
&SFG5    SET   0                                                        P$D00670
&SRLA    SET   0                                                        P$D00680
&SRFM    SET   0                                                        P$D00690
&SFAC    SET   0                                                        P$D00700
&FNAME   EQU   *                                                        P$D00710
         ENTRY &FNAME                                                   P$D00720
         DC    7F'0'                                                    P$D00730
         DO    ('&FNAME'='')++('&FNAME'>'Z999999')                      P$D00740
         PNOTE 'P','FILENAME NOT SPECIFIED OR MORE THAN 7 CHARACTERS.'  P$D00750
         GOTO  .A1                                                      P$D00760
         ENDO                                                           P$D00770
         DM$FNC &FNAME                                                  P$D00780
         DO    &DM$C1                                                   P$D00790
         PNOTE 'P','FIRST CHARACTER OF FILENAME IS NOT ALPHABETIC.'     P$D00800
         ENDO                                                           P$D00810
.A1      LABEL                                                          P$D00820
         DC    CL7'&FNAME'              DC$NME                          P$D00830
         DC    CL1' '                                                   P$D00840
         DC    H'0'                     DP$MFLG                         P$D00850
         DC    H'0'                     DP$PUB                          P$D00860
&SBKS    SET   '0&BLKSIZE&BKSZ'                                         P$D00870
&SCNT    SET   '&CONTROL&CNTRL&CNTL'                                    P$D00880
&SIOA1   SET   '&IOAREA1&IOA1'                                          P$D00890
&SIOA2   SET   '&IOAREA2&IOA2'                                          P$D00900
&SIORG   SET   '&IOREG&IORG'                                            P$D00910
&SIOR    SET   '&IOREG(1)&IORG(1)'                                      P$D00920
&SRCFM   SET   '&RECFORM&RCFM'                                          P$D00930
&SRCSZ   SET   '&RECSIZE&RCSZ'                                          P$D00940
&SREC    SET   '&RECSIZE(1)&RCSZ(1)'                                    P$D00950
&SPROV   SET   '&PRINTOV&PRTOV&PROV'                                    P$D00960
&SWORK   SET   '&WORKA&WORK'                                            P$D00970
         DO    '&CTLCHR'=''=0                                           P$D00980
&SFAC    SET   &SFAC+2                  SET CTLCHR FACILITY CODE BIT    P$D00990
&SBKSL   SET   &SBKSL+1                                                 P$D01000
&SBKSU   SET   &SBKSU+1                                                 P$D01010
&SRLA    SET   &SRLA+1                                                  P$D01020
&SBKSD   SET   &SBKSD+1                                                 P$D01030
         DO    '&CTLCHR'='DI'                                           P$D01040
&SFG3    SET   &SFG3+4                                                  P$D01050
         GOTO  .L1                                                      P$D01060
         ENDO                                                           P$D01070
         PNOTE 'P','CTLCHR SPECIFICATION MISSPELLED. MUST BE DI. SPECIFIP$D01080
               ICATION IGNORED.'                                        P$D01090
.L1      LABEL                                                          P$D01100
         DO    '&SCNT'=''=0                                             P$D01110
         PNOTE 'P','CONTROL AND CTLCHR SPECIFIED. CONTROL IGNORED.'     P$D01120
         ENDO                                                           P$D01130
         DO    '&PRAD'=''=0                                             P$D01140
         PNOTE *,'CTLCHR AND PRAD SPECIFIED. PRAD IGNORED.'             P$D01150
         ENDO                                                           P$D01160
         GOTO  .L2                                                      P$D01170
         ENDO                                                           P$D01180
         DO    '&PRAD'=''                                               P$D01190
         PNOTE *,'PRAD NOT SPECIFIED. STANDARD LINE ADVANCE SET TO 1.'  P$D01200
         GOTO  .L2                                                      P$D01210
         ENDO                                                           P$D01220
         DO    ('&PRAD'<'1')++('&PRAD'>'15')                            P$D01230
         PNOTE *,'PRAD LESS THAN 1 OR GREATER THAN 15. SET TO 1.'       P$D01240
         GOTO  .L2                                                      P$D01250
         ENDO                                                           P$D01260
&SPRAD   SET   (&PRAD*8)+1                                              P$D01270
.L2      LABEL                                                          P$D01280
         DO    ('&SCNT'=''=0)**('&CTLCHR'='')                           P$D01290
         DO    '&SCNT'='YES'=0                                          P$D01300
         PNOTE *,'CONTROL SPECIFICATION MISSPELLED. ACCEPTED AS CONTROLXP$D01310
               =YES.'                                                   P$D01320
         ENDO                                                           P$D01330
&SFAC    SET   &SFAC+1                  SET CONTROL FACILITY CODE BIT   P$D01340
&SFG2    SET   &SFG2+128                                                P$D01350
         ENDO                                                           P$D01360
         DO    '&SRCFM'=''                                              P$D01370
         PNOTE *,'RECORD FORMAT KEYWORD NOT SPECIFIED. SET TO FIXUNB.'  P$D01380
&SRCFM   SET   'FIXUNB'                                                 P$D01390
         ENDO                                                           P$D01400
         DO    '&SRCFM'='FIXUNB'=0                                      P$D01410
         DO    '&SRCFM'='VARUNB'                                        P$D01420
&SRFM    SET   &SRFM+2                                                  P$D01430
&SRLA    SET   &SRLA+4                                                  P$D01440
         GOTO  .L3                                                      P$D01450
         ENDO                                                           P$D01460
         DO    '&SRCFM'='UNDEF'                                         P$D01470
&SRFM    SET   &SRFM+1                                                  P$D01480
         GOTO  .L3                                                      P$D01490
         ENDO                                                           P$D01500
         PNOTE 'P','RECORD FORMAT MISSPELLED. SET TO FIXUNB.'           P$D01510
&SRCFM   SET   'FIXUNB'                                                 P$D01520
         ENDO                                                           P$D01530
&SRFM    SET   &SRFM+4                                                  P$D01540
.L3      LABEL                                                          P$D01550
         DO    '&SPROV'=''=0                                            P$D01560
&SFAC    SET   &SFAC+4                  SET PRINTOV FACILITY CODE BIT   P$D01570
         DO    ('&PRINTOV'='SKIP')++('&PROV'='YES')++('&PRTOV'='YES')   P$D01580
&SFG5    SET   &SFG5+64                                                 P$D01590
         GOTO  .L4                                                      P$D01600
         ENDO                                                           P$D01610
         DO    '&SPROV'='YES'                                           P$D01620
&SFG5    SET   &SFG5+128                                                P$D01630
         GOTO  .L4                                                      P$D01640
         ENDO                                                           P$D01650
         DM$FNC &SPROV                                                  P$D01660
         DO    &DM$C1                                                   P$D01670
         PNOTE 'P','FIRST CHARACTER OF PRINTER OVERFLOW ROUTINE LABEL IXP$D01680
               IS NOT ALPHABETIC.'                                      P$D01690
         GOTO  .L4                                                      P$D01700
         ENDO                                                           P$D01710
&SFG5    SET   &SFG5+32                                                 P$D01720
         DC    A(&SPROV)                DP$POV                          P$D01730
         DO    '&SEPASMB'='NO'=0                                        P$D01740
         EXTRN &SPROV                                                   P$D01750
         ENDO                                                           P$D01760
         GOTO  .L5                                                      P$D01770
         ENDO                                                           P$D01780
.L4      LABEL                                                          P$D01790
         DC    A(0)                     DP$POV                          P$D01800
.L5      LABEL                                                          P$D01810
         DC    H'&SRLA'                 DP$RLA                          P$D01820
         DC    XL2'04F0'                DP$DTF                          P$D01830
         DC    CL1'&SFAC'                                               P$D01840
         DC    XL1'00'                  DP$REQS                         P$D01850
&FNAME.C   EQU  *                       ERROR FLAG LABEL                P$D01860
         DO    '&SEPASMB'='NO'=0                                        P$D01870
         ENTRY &FNAME.C                                                 P$D01880
         ENDO                                                           P$D01890
         DC    H'0'                     DP$EFG                          P$D01900
         DC    A(DP$COM&SFAC)           DP$IOCS                         P$D01910
         EXTRN DP$COM&SFAC                                              P$D01920
&FNAME.E  EQU  *,1                      ERROR MESSAGE CODE              P$D01930
         DO    '&SEPASMB'='NO'=0                                        P$D01940
         ENTRY &FNAME.E                                                 P$D01950
         ENDO                                                           P$D01960
         DO    '&ERROR'=''                                              P$D01970
         PNOTE *,'NO ERROR ROUTINE. ERRORS RETURN INLINE.'              P$D01980
         DC    A(0)                     DP$ERR                          P$D01990
         GOTO  .L6                                                      P$D02000
         ENDO                                                           P$D02010
         DM$FNC &ERROR                                                  P$D02020
         DO    &DM$C1                                                   P$D02030
         PNOTE 'P','FIRST CHARACTER OF ERROR SPECIFICATION IS NOT ALPHAXP$D02040
               BETIC.'                                                  P$D02050
         PNOTE *,'ERRORS RETURN INLINE.'                                P$D02060
         DC    A(0)                     DP$ERR                          P$D02070
         GOTO  .L6                                                      P$D02080
         ENDO                                                           P$D02090
         DC    A(&ERROR)                DP$ERR                          P$D02100
         DO    '&SEPASMB'='NO'=0                                        P$D02110
         EXTRN &ERROR                                                   P$D02120
         ENDO                                                           P$D02130
&SFG3    SET   &SFG3+128                                                P$D02140
.L6      LABEL                                                          P$D02150
         DO    ('&CODE'=''=0)++('&OTBL'=''=0)                           P$D02160
         PNOTE *,'CODE OR OTBL KEYWORD NOT ACCEPTED. USE JOB CONTROL'   P$D02170
         PNOTE *,'TO LOAD THE LOAD CODE BUFFER.'                        P$D02180
         ENDO                                                           P$D02190
         DC    HL1'0'                   DP$CW1C                         P$D02200
         DO    '&SIOA1'=''                                              P$D02210
         PNOTE 'P','IOAREA1 NOT SPECIFIED.'                             P$D02220
         GOTO  .A2                                                      P$D02230
         ENDO                                                           P$D02240
         DM$FNC &SIOA1                                                  P$D02250
         DO    &DM$C1                                                   P$D02260
         PNOTE 'P','FIRST CHARACTER OF THE I/O AREA 1 SPECIFICATION IS XP$D02270
               NOT ALPHABETIC.'                                         P$D02280
.A2      LABEL                                                          P$D02290
         DC    AL3(0)                   DP$CW1D                         P$D02300
         GOTO  .L7                                                      P$D02310
         ENDO                                                           P$D02320
         DC    AL3(&SIOA1)              DP$CW1D                         P$D02330
         DO    '&SEPASMB'='NO'=0                                        P$D02340
         EXTRN &SIOA1                                                   P$D02350
         ENDO                                                           P$D02360
.L7      LABEL                                                          P$D02370
         DC    H'0'                     DP$CW1F                         P$D02380
         DC    H'0'                     DP$CW1B                         P$D02390
         DO    '&SIOA2'=''=0                                            P$D02400
         DM$FNC &SIOA2                                                  P$D02410
         DO    &DM$C1                                                   P$D02420
         PNOTE 'P','FIRST CHARACTER OF THE I/O AREA 2 SPECIFICATION'    P$D02430
         PNOTE *,'IS NOT ALPHABETIC.'                                   P$D02440
         GOTO  .L8                                                      P$D02450
         ENDO                                                           P$D02460
&SFG1    SET   &SFG1+8                                                  P$D02470
         ENDO                                                           P$D02480
.L8      LABEL                                                          P$D02490
         DO    '&SRCFM'='UNDEF'                                         P$D02500
         DO    '&SRCSZ'=''                                              P$D02510
         PNOTE 'P','RECORD SIZE REGISTER NOT SPECIFIED FOR UNDEFINED REXP$D02520
               CORDS.'                                                  P$D02530
         GOTO  .L9                                                      P$D02540
         ENDO                                                           P$D02550
         DO    '&SRCSZ'(1,1)='('=0                                      P$D02560
         PNOTE 'P','RECORD SIZE REGISTER SPECIFICATION IS NOT'          P$D02570
         PNOTE *,'ENCLOSED IN PARENTHESIS.'                             P$D02580
         PNOTE *,'RECORD SIZE REGISTER SPECIFICATION NOT ACCEPTED.'     P$D02590
         GOTO  .L9                                                      P$D02600
         ENDO                                                           P$D02610
         DO    (&SREC<2)++(&SREC>13)                                    P$D02620
         PNOTE 'P','RECORD SIZE REGISTER IS NOT 2 THROUGH 13.'          P$D02630
         PNOTE *,'RECORD SIZE REGISTER SPECIFICATION NOT ACCEPTED.'     P$D02640
         GOTO  .L9                                                      P$D02650
         ENDO                                                           P$D02660
         DO    (&SREC=13)**('&SAVAREA'='')                              P$D02670
         PNOTE 'P','SAVAREA KEYWORD NOT SPECIFIED FOR RECORD SIZE REGISXP$D02680
               TER=13.'                                                 P$D02690
         PNOTE *,'RECORD SIZE REGISTER SPECIFICATION NOT ACCEPTED.'     P$D02700
.L9      LABEL                                                          P$D02710
&SRCFM   SET   'FIXUNB'                                                 P$D02720
&SRFM    SET   X'04'                                                    P$D02730
         PNOTE *,'RECORDS WILL BE TREATED AS FIXED-UNBLOCKED DUE TO PREXP$D02740
               VIOUS ERROR.'                                            P$D02750
         GOTO  .L9A                                                     P$D02760
         ENDO                                                           P$D02770
&SFG4    SET   &SFG4+64                                                 P$D02780
         GOTO  .L10                                                     P$D02790
         ENDO                                                           P$D02800
         DO    '&SRCSZ'=''=0                                            P$D02810
         PNOTE *,'RECORD SIZE REGISTER NOT NEEDED. SPECIFICATION IGNOREDP$D02820
               D.'                                                      P$D02830
         ENDO                                                           P$D02840
.L9A     LABEL                                                          P$D02850
&SREC    SET   0                                                        P$D02860
         DC    HL1'0'                   DP$REC                          P$D02870
         GOTO  .L10A                                                    P$D02880
.L10     LABEL                                                          P$D02890
         DC    YL1(&SREC*4+20)          DP$REC                          P$D02900
.L10A    LABEL                                                          P$D02910
         DO    ('&SIORG'=''=0)**('&SWORK'=''=0)                         P$D02920
         PNOTE 'P','I/O REGISTER AND WORK AREA SPECIFIED. WORK AREA IGNXP$D02930
               ORED.'                                                   P$D02940
         GOTO  .L11                                                     P$D02950
         ENDO                                                           P$D02960
         DO    '&SWORK'=''=0                                            P$D02970
         DO    '&SWORK'='YES'=0                                         P$D02980
         PNOTE *,'WORK AREA SPECIFICATION MISSPELLED. ACCEPTED AS WORKAXP$D02990
               =YES.'                                                   P$D03000
         ENDO                                                           P$D03010
&SFG1    SET   &SFG1+16                                                 P$D03020
         GOTO  .L12                                                     P$D03030
         ENDO                                                           P$D03040
.L11     LABEL                                                          P$D03050
         DO    '&SIORG'=''=0                                            P$D03060
         DO    '&SIORG'(1,1)='('=0                                      P$D03070
         PNOTE 'P','I/O REGISTER SPECIFICATION IS NOT ENCLOSED'         P$D03080
         PNOTE *,'IN PARENTHESIS.'                                      P$D03090
         PNOTE *,'I/O REGISTER SPECIFICATION NOT ACCEPTED.'             P$D03100
         GOTO  .L12                                                     P$D03110
         ENDO                                                           P$D03120
         DO    (&SIOR<2)++(&SIOR>13)                                    P$D03130
         PNOTE 'P','I/O REGISTER IS NOT 2 THROUGH 13.'                  P$D03140
         PNOTE *,'I/O REGISTER SPECIFICATION NOT ACCEPTED.'             P$D03150
         GOTO  .L12                                                     P$D03160
         ENDO                                                           P$D03170
         DO    (&SIOR=13)**('&SAVAREA'='')                              P$D03180
         PNOTE 'P','SAVAREA KEYWORD NOT SPECIFIED FOR I/O REGISTER=13.' P$D03190
         PNOTE *,'I/O REGISTER SPECIFICATION NOT ACCEPTED.'             P$D03200
         GOTO  .L12                                                     P$D03210
         ENDO                                                           P$D03220
&SFG4    SET   &SFG4+8                                                  P$D03230
         GOTO  .L13                                                     P$D03240
         ENDO                                                           P$D03250
         DO    '&SIOA2'=''=0                                            P$D03260
         PNOTE 'P','I/O REGISTER NOT SPECIFIED.'                        P$D03270
         ENDO                                                           P$D03280
.L12     LABEL                                                          P$D03290
&SIOR    SET   0                                                        P$D03300
         DC    YL1(0)                   DP$IRG                          P$D03310
         GOTO  .L13A                                                    P$D03320
.L13     LABEL                                                          P$D03330
         DC    YL1(&SIOR*4+20)          DP$IRG                          P$D03340
.L13A    LABEL                                                          P$D03350
         DO    '&UCS'=''=0                                              P$D03360
         DO    '&UCS'='ON'                                              P$D03370
         GOTO  .L14                                                     P$D03380
         ENDO                                                           P$D03390
         DO    '&UCS'='OFF'=0                                           P$D03400
         PNOTE *,'UCS SPECIFICATION MISSPELLED. MUST BE UCS=ON OR OFF. XP$D03410
               SET TO OFF.'                                             P$D03420
         ENDO                                                           P$D03430
         ENDO                                                           P$D03440
&SFG1    SET   &SFG1+4                                                  P$D03450
.L14     LABEL                                                          P$D03460
         DO    '&VFB'=''=0                                              P$D03470
         PNOTE *,'VFB KEYWORD NOT ACCEPTED. USE JOB CONTROL'            P$D03480
         PNOTE *,'TO LOAD VERTICAL FORMAT BUFFER.'                      P$D03490
         ENDO                                                           P$D03500
         DO    '&OPTION'=''=0                                           P$D03510
         DO    '&OPTION'='YES'=0                                        P$D03520
         PNOTE *,'OPTION SPECIFICATION MISSPELLED. ACCEPTED AS OPTION=YXP$D03530
               ES.'                                                     P$D03540
         ENDO                                                           P$D03550
&SFG4    SET   &SFG4+32                                                 P$D03560
         ENDO                                                           P$D03570
         DO    '&SAVAREA'=''=0                                          P$D03580
&SFG3    SET   &SFG3+64                                                 P$D03590
         ENDO                                                           P$D03600
         DC    YL1(&SFG1)               DP$FG1                          P$D03610
         DC    YL1(&SFG2)               DP$FG2                          P$D03620
         DC    YL1(&SFG3)               DP$FG3                          P$D03630
         DC    YL1(&SFG4)               DP$FG4                          P$D03640
         DC    YL1(&SFG5)               DP$FG5                          P$D03650
         DC    YL1(&SRFM)               DP$RFM                          P$D03660
         DO    ('&SRCFM'='FIXUNB')++('&SRCFM'='UNDEF')                  P$D03670
         DO    (&SBKS<&SBKSL)++(&SBKS>&SBKSU)                           P$D03680
         DC    H'&SBKSD'                DP$BKS                          P$D03690
         DO    '&CTLCHR'=''=0                                           P$D03700
         PNOTE *,'BLOCK SIZE SPECIFICATION CHECK. SET TO 121.'          P$D03710
         GOTO  .L16                                                     P$D03720
         ENDO                                                           P$D03730
         PNOTE *,'BLOCK SIZE SPECIFICATION CHECK. SET TO 120.'          P$D03740
         GOTO  .L16                                                     P$D03750
         ENDO                                                           P$D03760
         DC    H'&SBKS'                 DP$BKS                          P$D03770
         GOTO  .L16                                                     P$D03780
         ENDO                                                           P$D03790
         DO    (&SBKS<&SBKSL+8)++(&SBKS>&SBKSU+8)                       P$D03800
         DC    Y(&SBKSD+8)              DP$BKS                          P$D03810
         DO    '&CTLCHR'=''=0                                           P$D03820
         PNOTE *,'BLOCK SIZE SPECIFICATION CHECK. SET TO 129.'          P$D03830
         GOTO  .L16                                                     P$D03840
         ENDO                                                           P$D03850
         PNOTE *,'BLOCK SIZE SPECIFICATION CHECK. SET TO 128.'          P$D03860
         GOTO  .L16                                                     P$D03870
         ENDO                                                           P$D03880
         DC    H'&SBKS'                 DP$BKS                          P$D03890
.L16     LABEL                                                          P$D03900
         DC    YL1(0)                   DP$CCS                          P$D03910
         DC    YL1(&SPRAD)              DP$PRA                          P$D03920
         DO    &SFG1**8                                                 P$D03930
         DC    A(&SIOA2)                DP$BAS                          P$D03940
         DO    '&SEPASMB'='NO'=0                                        P$D03950
         EXTRN &SIOA2                                                   P$D03960
         ENDO                                                           P$D03970
         GOTO  .L17                                                     P$D03980
         ENDO                                                           P$D03990
         DC    A(0)                     DP$BAS                          P$D04000
.L17     LABEL                                                          P$D04010
         DO    '&SAVAREA'=''=0                                          P$D04020
         DM$FNC &SAVAREA                                                P$D04030
         DO    &DM$C1                                                   P$D04040
         PNOTE 'P','FIRST CHARACTER OF SAVAREA SPECIFICATION IS NOT ALPXP$D04050
               HABETIC.'                                                P$D04060
         DC    A(0)                     DP$SAV                          P$D04070
         DC    A(0)                     DP$SAVR                         P$D04080
         GOTO  .L18                                                     P$D04090
         ENDO                                                           P$D04100
         DC    A(&SAVAREA)              DP$SAV                          P$D04110
         DO    '&SEPASMB'='NO'=0                                        P$D04120
         EXTRN &SAVAREA                                                 P$D04130
         ENDO                                                           P$D04140
         DC    A(0)                     DP$SAVR                         P$D04150
         ENDO                                                           P$D04160
.L18     LABEL                                                          P$D04170
         END                                                            P$D04180
