SMPAPI CSECT SMPAPI AMODE 31 STM 14,12,12(13) Save registers LR 12,15 Set up base reg USING SMPAPI,12 ST 13,SAVE+4 Link save areas LA 14,SAVE ST 14,8(13) LR 13,14 LA 0,BUFSIZE SET BUFFER SIZE GETMAIN R,LV=(0) AND GET IT LR 9,1 GET BUFFER POINTER USING BUFDSECT,9 * * END OF STANDARD LINKAGE * OPEN (SYSPRINT,OUTPUT) TM SYSPRINT+DCBOFLGS-IHADCB,DCBOFOPN *** Open OK? BNO CLEANUP OPEN (SYSIN,INPUT) LA 8,=CL40'BAD OPEN FOR SYSIN' TM SYSIN+DCBOFLGS-IHADCB,DCBOFOPN ** Open OK? BNO ERRMSG XC QUERY_PARMS,QUERY_PARMS ** CLEAR PARM AREA * * SET UP PARAMETERS FOR QUERY * GET SYSIN,CARD1 LA 8,CARD1 CLC =C'CSI=',CARD1 BNE ERRMSG LA 3,CARD1+4 START LOCATION LA 4,CARD1+49 MAXIMUM LENGTH+1 LA 0,C' ' LOOK FOR TRAILING BLANK REDO1 SRST 4,3 DO SEARCH BC 1,REDO1 BC 2,ERRMSG NOT FOUND SR 4,3 GET LENGTH ST 3,PCSI ST 4,CSILEN GET SYSIN,CARD2 LA 8,CARD2 CLC =C'ZONE=',0(8) ZONE? BNE DO2 TRY ENTRY LA 3,5(,8) START LOCATION LA 4,14(,8) MAXIMUM LENGTH+1 LA 0,C' ' LOOK FOR TRAILING BLANK REDO2 SRST 4,3 DO SEARCH BC 1,REDO2 BC 2,DO2 NOT FOUND SR 4,3 GET LENGTH ST 3,PZONE ST 4,ZONELEN GET SYSIN,CARD3 LA 8,CARD3 DO2 CLC =C'ENTRY=',0(8) ENTRY? BNE DO3 TRY SUBENTRY LA 3,6(,8) START LOCATION LA 4,71(,8) MAXIMUM LENGTH+1 LA 0,C' ' LOOK FOR TRAILING BLANK REDO3 SRST 4,3 DO SEARCH BC 1,REDO3 BC 2,DO3 NOT FOUND SR 4,3 GET LENGTH ST 3,PENTRY ST 4,ENTRYLEN GET SYSIN,CARD4 LA 8,CARD4 DO3 CLC =C'SUBENTRY=',0(8) SUBENTRY? BE DO3A OK .. PROCESS SUBENTRY MVC CARD5(80),0(8) COPY TO TARGET LOCATION LA 5,CARD5 SET UP POINTER B DO4 TRY FILTER DO3A LA 3,9(,8) START LOCATION LA 4,69(,8) MAXIMUM LENGTH+1 LA 0,C' ' LOOK FOR TRAILING BLANK REDO4 SRST 4,3 DO SEARCH BC 1,REDO4 BC 2,DO4 NOT FOUND SR 4,3 GET LENGTH ST 3,PSUBENTRY ST 4,SUBENTRYLEN LA 6,5 LOOP COUNTER LA 5,CARD5 LR 4,5 READFILT GET SYSIN,(5) LR 8,5 COPY IN CASE OF ERROR DO4 CLC =C'FILTER=',0(5) FILTER? BNE ERRMSG NO - COMPLAIN MVC 0(61,5),7(5) SHIFT LEFT - OVERLAPPING MOVE LR 3,5 START LOCATION LA 4,60(,5) MAXIMUM LENGTH+1 LA 0,C';' LOOK FOR TRAILING SEMI-COLON REDO5 SRST 4,3 DO SEARCH BC 1,REDO5 BC 2,LOADAPI NOT FOUND MVI 0(4),C' ' BLANK IT OUT LA 5,1(,4) POINT TO END OF BUFFER BCT 6,READFILT EOFILT LA 3,CARD5 SR 4,3 GET LENGTH ST 3,PFILTER ST 4,FILTERLEN * * NOW LOAD THE API * LOADAPI LA 2,APIPGM LOAD EPLOC=(2),LOADPT=PGMADR * * NOW DO THE QUERY * L 15,PGMADR CALL (15),(QUERYCMD,QUERY_PARMS@,CMDOUT,APILANG,XRC,CC,MSG@) * * * SEE WHAT WAS RETURNED * L 3,XRC LTR 3,3 BNZ ERRPRINT * * ESTABLISH ADDRESSABILITY * L 3,CMDOUT USING ENTRY_LIST,3 L 4,ENTRIES USING CSIENTRY,4 * * PRINT ENTRIES * PRTENT LTR 4,4 BZ CLEANUP MVI BUFFER,C' ' MVC BUFFER+1(119),BUFFER ** BLANK OUT BUFFER MVC BUFFER(8),ENTRYNAME MVC BUFFER+10(7),ZONENAME LA 2,ANSICHAR PUT SYSPRINT,(2) L 5,SUBENTRIES USING SUBENTRY,5 B PRTSUB MOREENT L 4,CSINEXT B PRTENT * * PRINT SUBENTRIES * PRTSUB LTR 5,5 BZ MOREENT MVI BUFFER,C' ' MVC BUFFER+1(119),BUFFER ** BLANK OUT BUFFER MVC BUFFER+2(11),SUBTYPE PUT SYSPRINT,(2) L 6,SUBENTDATA USING ITEM_LIST,6 DOSUB L 7,DATA USING RETDATA,7 DODATA CLC =C'VER ',SUBTYPE BE DOVER LTR 7,7 BNZ DOPRT MORESUB L 5,SUBNEXT B PRTSUB DOPRT BAL 11,PRTDATA L 6,ITMNEXT LTR 6,6 BZ MORESUB L 7,DATA B DODATA * * PRINT DATA * PRTDATA L 8,DATALEN CHECKLEN C 8,OUTRECLN BNH SETLEN L 8,OUTRECLN SETLEN LA 15,1 SLR 8,15 MVI BUFFER,C' ' MVC BUFFER+1(119),BUFFER ** BLANK OUT BUFFER EX 8,@MOVDATA LA 2,ANSICHAR PUT SYSPRINT,(2) L 8,DATALEN C 8,OUTRECLN BNHR 11 S 8,OUTRECLN ST 8,DATALEN A 7,OUTRECLN B CHECKLEN * * PRINT VER STUFF * DOVER LR 10,6 USING VER,10 VERNRTN MVI BUFFER,C' ' MVC BUFFER+1(119),BUFFER ** BLANK OUT BUFFER MVC BUFFER+4(L'VERNUM),VERNUM LA 2,ANSICHAR PUT SYSPRINT,(2) VERSNXT L 5,VERDATA LTR 5,5 BZ MOREVER MVI BUFFER,C' ' MVC BUFFER+1(119),BUFFER ** BLANK OUT BUFFER MVC BUFFER+4(11),SUBTYPE PUT SYSPRINT,(2) L 6,SUBENTDATA L 7,DATA VERDRTN LTR 7,7 BNZ VERPRT MOREVER L 10,VERNEXT LTR 10,10 BNZ VERNRTN B MOREENT VERPRT BAL 11,PRTDATA L 6,ITMNEXT LTR 6,6 BZ MOREVER L 7,DATA B VERDRTN DROP 10 * * PRINT ERROR MESSAGES * ERRPRINT L 6,MSG@ L 7,DATA L 8,DATALEN CHKMSGLN C 8,OUTRECLN BNH SETMSGLN L 8,OUTRECLN SETMSGLN LA 15,1 SLR 8,15 MVI BUFFER,C' ' MVC BUFFER+1(119),BUFFER ** BLANK OUT BUFFER EX 8,@MOVDATA LA 2,ANSICHAR PUT SYSPRINT,(2) L 8,DATALEN C 8,OUTRECLN BNH CLEANUP S 8,OUTRECLN ST 8,DATALEN A 4,OUTRECLN B CHKMSGLN * ISSUE ERROR MSGS HERE ERRMSG MVI BUFFER,C' ' MVC BUFFER+1(119),BUFFER ** BLANK OUT BUFFER MVC BUFFER+1(4),=C'****' MVC BUFFER+5(40),0(8) LA 2,ANSICHAR PUT SYSPRINT,(2) * * * NOW FREE THE STORAGE OBTAINED DURING THE QUERY * CLEANUP L 15,PGMADR LTR 15,15 BZ TRYIN CALL (15),(FREECMD,0,CMDOUT,APILANG,RC,CC,MSG@) TRYIN TM SYSIN+DCBOFLGS-IHADCB,DCBOFOPN ** OPEN OK? BNO TRYOUT CLOSE SYSIN TRYOUT TM SYSPRINT+DCBOFLGS-IHADCB,DCBOFOPN ** OPEN OK? BNO GETOUT CLOSE SYSPRINT * * NOW DELETE GIMAPI * GETOUT LA 0,BUFSIZE SET BUFFER SIZE FREEMAIN R,A=(9),LV=(0) FREE MY DYNAMIC AREA DELETE EPLOC=APIPGM * * EXIT * EXIT L 15,XRC ** RETURN CODE FROM QUERY L 13,4(,13) L 14,12(,13) LM 00,12,20(13) BR 14 * * @MOVDATA MVC BUFFER+6(0),RETDATA SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,MACRF=PM,LRECL=121,RECFM=FBA SYSIN DCB DDNAME=SYSIN,DSORG=PS,MACRF=GM,EODAD=EOFILT APIPGM DC CL8'GIMAPI ' QUERYCMD DC CL8'QUERY ' FREECMD DC CL8'FREE ' APILANG DC CL3'ENU' DS 0F QUERY_PARMS@ DC AL4(QUERY_PARMS) PGMADR DC AL4(0) CMDOUT DC AL4(0) MSG@ DC AL4(0) OUTRECLN DC F'114' RC DC F'0' XRC DC F'99' CC DC F'0' SAVE DC 18F'0' CARD1 DS CL80 CARD2 DS CL80 CARD3 DS CL80 CARD4 DS CL80 CARD5 DS CL400 GIMMASM RETDATA DSECT CL0 BUFDSECT DSECT ANSICHAR DC CL1' ' BUFFER DS CL120 BUFSIZE EQU *-ANSICHAR DCBD DSORG=PS,DEVD=DA END SMPAPI