MACRO 00050000 ISTCBRPL &AM=,&MF=,&CALLER=, @ZA34940C00100000 &ACB=,&AREA=,&AREALEN=,&ARG=,&ECB=, *** RPL KEYWORDS ***C00150000 &FDBK=,&MSGAREA=,&MSGLEN=,&NXTRPL=,&OPTCD=,&KEYLEN=, C00200000 &RBA=,&RECLEN=,&IO=,&RPLLEN=,&AAREA=,&AAREALN=, X03004C00250000 &ARECLEN=,&EXIT=,&NIB=, X04SVHSC00300000 &BRANCH=,&USER=,&RTNCD=,&FDBK2=,&SENSE=, X03004C00350000 &REQ=,&DATAFLG=, X03004C00400000 &TRANSID=,&AIXPC=,&FTNCD=,&AIXFLAG=, X04SVHSC00450000 &CHNGDIR=,&STYPE=,&RTYPE=,&CHAIN=,&POST=, X3004BSC00500000 &RESPOND=,&CONTROL=,&OBSQAC=,&IBSQAC=, X3004BSC00550000 &OBSQVAL=,&IBSQVAL=,&SEQNO=,&SSENSEO=, X3004BSC00600000 &SSENSEI=,&USENSEO=,&USENSEI=, @Z40BHUCC00650000 &BRACKET=,&SSENSMO=,&SSENSMI=, C00700000 &SIGDATA=,&CODESEL=, @Z40BHUCC00750000 &CRYPT= @G40AKSL 00800000 .* 00850000 .* CHANGE LEVEL = 0 @ZA34940 00900000 .* DATE OF LAST CHANGE = 5 OCT 78 ( 78*278 ) @ZA34940 00950000 .* @ZA34940 01000000 .* FUNCTION THIS MACRO ACTS AS A CONTROLLER FOR GENCB, MODCB, AND 01050000 .* TESTCB FOR PROCESSING AN RPL. 01100000 .* IT IS CALLED BY IDACB2 TO BUILD VARIOUS ARRAYS TO BE 01150000 .* USED BY THAT MACRO TO BUILD A PARAMETER LIST OF ARGUMENT 01200000 .* CONTROL ENTRIES THAT WILL BE PASSED TO THE CONTROL 01250000 .* BLOCK MANIPULATION MODULE AT EXECUTE TIME. 01300000 .* FOR NON-BIT KEYWORDS, THIS MACRO CALLS ISTCB3 @ZA34940 01350000 .* WHICH SETS VALUES INTO ALL THE ARRAYS THAT @ZA34940 01400000 .* ARE REQUIRED. @ZA34940 01450000 .* 01500000 .* FOR BIT KEYWORDS, ISTCB3 IS CALLED, BUT THIS @ZA34940 01550000 .* MACRO SETS THE VALUE IN THE &IDAVALC ARRAY. @ZA34940 01600000 .* IT ALSO VALIDITY CHECKS BIT OPTIONS AND IF MUTUALLY 01650000 .* EXCLUSIVE OPTIONS ARE SPECIFIED, AN ERROR MESSAGE IS 01700000 .* ISSUED. THE ONE EXCEPTION IS OPTCD. 01750000 .* ISTCBOPT IS ISSUED TO PROCESS OPTCD. @ZA34940 01800000 .* 01850000 .* IT IS ALSO CALLED BY THE RPL DECLARATIVE MACRO TO 01900000 .* PROCESS THE BIT KEYWORDS OPTCD, BRANCH, POST, RESPOND, 01950000 .* CHAIN, CONTROL, CHNGDIR, BRACKET, SSENSEO, RTYPE, 02000000 .* STYPE, IBSQAC, AND OBSQAC. 02050000 .* WHEN CALLED BY RPL, DIFFERENT GLOBALS ARE SET THAN 02100000 .* THOSE USED BY THE CBMM. THESE GLOBALS ARE SET IN SUCH 02150000 .* A MANNER TO ALLOW THE DECLARATIVE MACRO TO GENERATE 02200000 .* A 'DC' USING THE GLOBALS DIRECTLY. 02250000 .* THEREFORE THE BITS SET IN THESE GLOBALS MUST BE 02300000 .* IDENTICAL TO THE WAY THEY WILL APPEAR WHEN THE 02350000 .* CONTROL BLOCK IS GENERATED. 02400000 .* @ZA34940 02450000 .* CHANGE ACTIVITY @ZA34940 02500000 .* CBMM SPLIT SUPPORT @ZA34940 02550000 .* @ZA34940 02600000 .* GLOBALS 02650000 GBLB &IDACB01 ERROR INDICATOR 02700000 GBLA &IDAENO NUMBER OF ELEMENTS 02750000 GBLC &IDAVALC(50) ELEMENT CHARACTER VALUE ARRAY 02800000 .* THE FOLLOWING GLOBALS ARE SET WHEN CALLED BY THE RPL 02850000 .* DECLARATIVE MACRO TO SET BIT STRING KEYWORDS 02900000 GBLC &IDABRCH BRANCH CODE X04SVHS 02950000 GBLC &IDASNSO SSENSEO CODES X04SVHS 03000000 GBLC &IDARH3 CHNGDIR/BRACKET CODES X04SVHS 03050000 GBLC &IDASRTY STYPE/RTYPE CODES X04SVHS 03100000 GBLC &IDACHN CHAIN CODES X04SVHS 03150000 GBLC &IDAPORE POST/RESPOND CODES X04SVHS 03200000 GBLC &IDACRYP ENCRIPTION FEATURE @G40AKSL 03250000 GBLC &IDACON1,&IDACON2,&IDACON3 CONTROL CODES X04SVHS 03300000 GBLC &IDAOBQC OBSQAC CODES X04SVHS 03350000 GBLC &IDAIBQC IBSQAC CODES X04SVHS 03400000 .* LOCALS 03450000 LCLA &I,&A WORK VARIABLES X04SVHS 03500000 LCLB &VSAM,&VTAM AM CODES 03550000 LCLB &PRIME,&AIXRBA AIXFLAG CODES X04SVHS 03600000 LCLB &NCMD,&CMD,&NREQ,&CREQ CHNGDIR CODES X3004BS 03650000 LCLB &SREQ,&SRESP STYPE CODES X3004BS 03700000 LCLB &NRESP,&RRESP,&RDFSYN,&NDFSYN RTYPE CODES X3004BS 03750000 LCLB &NDFASY,&RDFASY RTYPE CODES @Z40BHUC 03800000 LCLB &ONLY,&FIRST,&MIDDLE,&LAST CHAIN CODES X3004BS 03850000 LCLB &PRESP,&SCHED POST CODES X3004BS 03900000 LCLB &NEX,&EX,&FME,&NFME,&NRRN,&RRN RESPOND CODES X3004BS 03950000 LCLB &QRESP,&NQRESP RESPOND CODES @G40AKSL 04000000 LCLB &DATA,&CANCEL,&QC,&QEC,&CHASE CONTROL CODES X3004BS 04050000 LCLB &RELQ,&CSDT,&CLEAR,&STSN CONTROL CODES X03004HS 04100000 LCLB &SHUTD,&RQR,&SHUTC CONTROL CODES @ZA07554 04150000 LCLB &BID,&LUS,&SIGNAL,&RTR,&RSHUTD CONTROL CODES X03004HS 04200000 LCLB &SBI,&BIS,&BIND,&UNBIND CONTROL CODES @G40AKCM 04250000 LCLB &STDRD,&ALT CODESEL CODE @Z40BHUC 04300000 LCLB &SET,&TESTSET,&RESET,&IGNORE OBSQAC CODES X3004BS 04350000 LCLB &TESTPOS,&TESTNEG,&INVALID OBSQAC CODES X3004BS 04400000 LCLB &ISET,&ITESTSE,&IRESET,&IIGNORE IBSQAC CODES X3004BS 04450000 LCLB &ITESTPO,&ITESTNE,&IINVALI IBSQAC CODES X3004BS 04500000 LCLB &OCPM,&OSTATE,&OFI,&ORR SSENSEO CODES X03004HS 04550000 LCLB &IPATH,&ICPM,&ISTATE,&IFI,&IRR SSENSEI CODES X03004HS 04600000 LCLB &BB,&NBB,&EB,&NEB BRACKET CODES X03004HS 04650000 LCLB &NO,&YES SWITCHC CODES X3004BS 04700000 LCLB &UNSOL,&EOB,&EOM,&EOT,&LOGOFF DATAFLG CODES X03004 04750000 LCLB &LG,&SOH DATAFLG CODES X03004 04800000 LCLB &BRYES,&BRNO BRANCH CODES X04SVHS 04850000 LCLB &COMPLET IO CODE X04SVHS 04900000 LCLB &CRYES,&CRNO ENCRIPTION CODES @G40AKSL 04950000 LCLC &Z16,&Z8 UNUSED PORTION OF BITSTRING 05000000 .* 05050000 &Z16 SETC '0000000000000000' INITIALIZE CONSTANT X04SVHS 05100000 &Z8 SETC '00000000' INITIALIZE CONSTANT @Z40BHUC 05150000 .* SCAN RPL KEYWORDS ************************************************** 05200000 .* ACB 05250000 ISTCB3 ARG=&ACB,ARGNAME=ACB,KWTC=X'2B',MF=&MF @ZA34940 05300000 .********************************************************************** 05350000 .* AREA 05400000 ISTCB3 ARG=&AREA,ARGNAME=AREA,KWTC=X'2C',MF=&MF @ZA34940 05450000 .********************************************************************** 05500000 .* AREALEN 05550000 ISTCB3 ARG=&AREALEN,ARGNAME=AREALEN,KWTC=X'2D',MF=&MF @ZA34940 05600000 .********************************************************************** 05650000 .* ARG 05700000 ISTCB3 ARG=&ARG,ARGNAME=ARG,KWTC=X'2E',MF=&MF @ZA34940 05750000 .********************************************************************** 05800000 .* ECB 05850000 ISTCB3 ARG=&ECB,ARGNAME=ECB,KWTC=X'2F',MF=&MF @ZA34940 05900000 .********************************************************************** 05950000 .* KEYLEN 06000000 ISTCB3 ARG=&KEYLEN,ARGNAME=KEYLEN,KWTC=X'30',MF=&MF @ZA34940 06050000 .********************************************************************** 06100000 .* MSGAREA 06150000 ISTCB3 ARG=&MSGAREA,ARGNAME=MSGAREA,KWTC=X'31',MF=&MF @ZA34940 06200000 .********************************************************************** 06250000 .* MSGLEN 06300000 ISTCB3 ARG=&MSGLEN,ARGNAME=MSGLEN,KWTC=X'32',MF=&MF @ZA34940 06350000 .********************************************************************** 06400000 .* NXTRPL 06450000 ISTCB3 ARG=&NXTRPL,ARGNAME=NXTRPL,KWTC=X'33',MF=&MF @ZA34940 06500000 .********************************************************************** 06550000 .* OPTCD 06600000 ISTCBOPT OPTCD=&OPTCD,AM=&AM,MF=&MF,CALLER=&CALLER @ZA34940 06650000 .* OPTCD IS PROCESSED BY THE INNER MACRO ISTCBOPT @ZA34940 06700000 .********************************************************************** 06750000 .* CHNGDIR 06800000 .R000100 AIF ('&CHNGDIR' EQ '').R000600 *** CHNGDIR *** X3004BS 06850000 ISTCB3 ARG=&CHNGDIR,KWTC=X'65',BIT=YES,CHKAM=VTAM, @ZA34940*06900000 AM=&AM @ZA34940 06950000 .* X04SVHS 07000000 &I SETA 0 CLEAR INDEX VARIABLE X3004BS 07050000 &A SETA 0 ZERO ERROR COUNTER X04SVHS 07100000 .R000200 ANOP X3004BS 07150000 &I SETA &I+1 BUMP INDEX INTO LIST X04SVHS 07200000 AIF (&I GT N'&CHNGDIR).R000300 CHECK FOR END OF LIST X04SVHS 07250000 &NCMD SETB ('&CHNGDIR(&I)' EQ 'NCMD' OR &NCMD) X3004BS 07300000 &CMD SETB ('&CHNGDIR(&I)' EQ 'CMD' OR &CMD) X3004BS 07350000 &NREQ SETB ('&CHNGDIR(&I)' EQ 'NREQ' OR &NREQ) X3004BS 07400000 &CREQ SETB ('&CHNGDIR(&I)' EQ 'REQ' OR &CREQ) X3004BS 07450000 AIF (&NCMD+&CMD+&NREQ+&CREQ+&A EQ &I).R000200 X04SVHS 07500000 .* CHK FOR NEW BIT SET 07550000 ISTERMAC 5,CHNGDIR,&CHNGDIR(&I) @ZA34940 07600000 &IDACB01 SETB 1 SET ERROR SWITCH X3004BS 07650000 &A SETA &A+1 BUMP ERROR COUNTER X04SVHS 07700000 AGO .R000200 CHECK NEXT OPTION X04SVHS 07750000 .* CHECK FOR MUTUALLY EXCLUSIVE OPTIONS 07800000 .R000300 AIF (NOT(&NCMD AND &CMD)).R000400 X3004BS 07850000 ISTERMAC 8,CHNGDIR,NCMD,CMD @ZA34940 07900000 &IDACB01 SETB 1 SET ERROR SWITCH X04SVHS 07950000 .R000400 AIF (NOT(&NREQ AND &CREQ)).R000500 X3004BS 08000000 ISTERMAC 8,CHNGDIR,NREQ,REQ @ZA34940 08050000 &IDACB01 SETB 1 SET ERROR SWITCH X04SVHS 08100000 .R000500 ANOP X3004BS 08150000 AIF ('&CALLER' EQ 'RPL').R000600 X04SVHS 08200000 .* IF CALLED BY RPL, VALUE SET IN RPLRH3 UNDER CODESEL CODE 08250000 &IDAVALC(&IDAENO) SETC '&NCMD&CMD&NREQ&CREQ.000000000000&Z16' X3004BS 08300000 .********************************************************************** 08350000 .R000600 ANOP X03004HS 08400000 .* BRACKET 08450000 AIF ('&BRACKET' EQ '').R001010 X03004HS 08500000 ISTCB3 ARG=&BRACKET,KWTC=X'85',CHKAM=VTAM,AM=&AM, @ZA34940*08550000 BIT=YES @ZA34940 08600000 &I SETA 0 INITIALIZE INDEX VALUE X03004HS 08650000 &A SETA 0 ZERO ERROR COUNTER X04SVHS 08700000 .R000700 ANOP X03004HS 08750000 &I SETA &I+1 BUMP INDEX INTO LIST X04SVHS 08800000 AIF (&I GT N'&BRACKET).R000800 X03004HS 08850000 .* DETERMINE IF ALL SUBPARMS HAVE BEEN CHECKED X03004HS 08900000 &BB SETB ('&BRACKET(&I)' EQ 'BB' OR &BB) X03004HS 08950000 &NBB SETB ('&BRACKET(&I)' EQ 'NBB' OR &NBB) X03004HS 09000000 &EB SETB ('&BRACKET(&I)' EQ 'EB' OR &EB) X03004HS 09050000 &NEB SETB ('&BRACKET(&I)' EQ 'NEB' OR &NEB) X03004HS 09100000 AIF (&BB+&NBB+&EB+&NEB+&A EQ &I).R000700 X04SVHS 09150000 .* CHK FOR NEW BIT SET 09200000 ISTERMAC 5,BRACKET,&BRACKET(&I) @ZA34940 09250000 &IDACB01 SETB 1 SET ERROR SWITCH X04SVHS 09300000 &A SETA &A+1 BUMP ERROR COUNTER X04SVHS 09350000 AGO .R000700 CHK NEXT SUBPARM X03004HS 09400000 .R000800 ANOP X03004HS 09450000 AIF (NOT(&BB AND &NBB)).R000900 CHK MUTUALLY X03004HS 09500000 .* EXCLUSIVE KEYWORDS X03004HS 09550000 ISTERMAC 8,BRACKET,BB,NBB @ZA34940 09600000 &IDACB01 SETB 1 SET ERROR SWITCH X04SVHS 09650000 .R000900 ANOP X03004HS 09700000 AIF (NOT(&EB AND &NEB)).R001000 CHK MUTUALLY X03004HS 09750000 .* EXCLUSIVE KEYWORDS X03004HS 09800000 ISTERMAC 8,BRACKET,EB,NEB @ZA34940 09850000 &IDACB01 SETB 1 SET ERROR SWITCH X04SVHS 09900000 .R001000 ANOP X03004HS 09950000 AIF ('&CALLER' EQ 'RPL').R001010 X04SVHS 10000000 .* IF CALLED BY RPL, VALUE SET IN RPLRH3 UNDER CODESEL CODE 10050000 &IDAVALC(&IDAENO) SETC '&BB&NBB&EB&NEB.000000000000&Z16' X03004HS 10100000 .* X04SVHS 10150000 .********************************************************************** 10200000 .* CODESEL @Z40BHUC 10250000 .R001010 AIF ('&CODESEL' EQ '').R001070 *** CODESEL *** @Z40BHUC 10300000 ISTCB3 ARG=&CODESEL,KWTC=X'91',CHKAM=VTAM,AM=&AM, @ZA34940*10350000 BIT=YES @ZA34940 10400000 &STDRD SETB ('&CODESEL' EQ 'STANDARD' OR '&CODESEL' EQ '(STANDARD)') 10450000 &ALT SETB ('&CODESEL' EQ 'ALT' OR '&CODESEL' EQ '(ALT)') @Z40BHUC 10500000 AIF (&STDRD+&ALT EQ 1).R001020 CHECK VALID OPTION @Z40BHUC 10550000 ISTERMAC 5,CODESEL,&CODESEL @ZA34940 10600000 &IDACB01 SETB 1 @Z40BHUC 10650000 .R001020 AIF (N'&CODESEL EQ 1).R001050 ONE OPTION ALLOWED @Z40BHUC 10700000 ISTERMAC 22,CODESEL @ZA34940 10750000 &IDACB01 SETB 1 @Z40BHUC 10800000 .R001050 AIF ('&CALLER' EQ 'RPL').R001070 @Z40BHUC 10850000 .* IF CALLED BY RPL, BYPASS SETTING CBM GLOBAL @Z40BHUC 10900000 &IDAVALC(&IDAENO) SETC '&STDRD&ALT.000000&Z8&Z16' @Z40BHUC 10950000 AGO .R001100 @Z40BHUC 11000000 .R001070 ANOP @Z40BHUC 11050000 .* ISTCBRPL HAS BEEN CALLED BY THE RPL DECLARATIVE MACRO @ZA34940 11100000 .* OR CODESEL IS NULL @Z40BHUC 11150000 &IDARH3 SETC '&BB&EB&CMD&CREQ&ALT.000' SET BRACKET/CHNGDIR/CODESEL 11200000 .********************************************************************** 11250000 .* STYPE 11300000 .R001100 AIF ('&STYPE' EQ '').R001500 *** STYPE *** X3004BS 11350000 ISTCB3 ARG=&STYPE,KWTC=X'66',CHKAM=VTAM,AM=&AM, @ZA34940*11400000 BIT=YES @ZA34940 11450000 &I SETA 0 X3004BS 11500000 &A SETA 0 ZERO ERROR COUNTER X04SVHS 11550000 .R001200 ANOP X3004BS 11600000 &I SETA &I+1 BUMP INDEX INTO LIST X04SVHS 11650000 AIF (&I GT N'&STYPE).R001300 CHECK FOR END OF LIST X04SVHS 11700000 &SREQ SETB ('&STYPE(&I)' EQ 'REQ' OR &SREQ) X3004BS 11750000 &SRESP SETB ('&STYPE(&I)' EQ 'RESP' OR &SRESP) X3004BS 11800000 AIF (&SREQ+&SRESP+&A EQ &I).R001200 X04SVHS 11850000 .* CHK FOR NEW BIT SET 11900000 ISTERMAC 5,STYPE,&STYPE(&I) @ZA34940 11950000 &IDACB01 SETB 1 SET ERROR SWITCH X3004BS 12000000 &A SETA &A+1 BUMP ERROR COUNTER X04SVHS 12050000 AGO .R001200 X3004BS 12100000 .* CHECK FOR MUTUALLY EXCLUSIVE OPTIONS 12150000 .R001300 AIF (NOT(&SREQ AND &SRESP)).R001400 X3004BS 12200000 ISTERMAC 8,STYPE,REQ,RESP @ZA34940 12250000 &IDACB01 SETB 1 SET ERROR SWITCH X3004BS 12300000 .R001400 ANOP X3004BS 12350000 AIF ('&CALLER' EQ 'RPL').R001500 X04SVHS 12400000 .* IF CALLED BY RPL, BYPASS SETTING CBM GLOBAL 12450000 &IDAVALC(&IDAENO) SETC '&SREQ&SRESP.00000000000000&Z16' X3004BS 12500000 .********************************************************************** 12550000 .* RTYPE 12600000 .R001500 AIF ('&RTYPE' EQ '').R002150 *** RTYPE *** X3004BS 12650000 ISTCB3 ARG=&RTYPE,KWTC=X'67',CHKAM=VTAM,AM=&AM, @ZA34940*12700000 BIT=YES @ZA34940 12750000 &I SETA 0 ZERO INDEX X3004BS 12800000 &A SETA 0 ZERO ERROR COUNTER X04SVHS 12850000 .R001600 ANOP X3004BS 12900000 &I SETA &I+1 BUMP INDEX INTO LIST X04SVHS 12950000 AIF (&I GT N'&RTYPE).R001700 CHECK FOR END OF LIST X04SVHS 13000000 &NRESP SETB ('&RTYPE(&I)' EQ 'NRESP' OR &NRESP) X3004BS 13050000 &RRESP SETB ('&RTYPE(&I)' EQ 'RESP' OR &RRESP) X3004BS 13100000 &RDFSYN SETB ('&RTYPE(&I)' EQ 'DFSYN' OR &RDFSYN) X3004BS 13150000 &NDFSYN SETB ('&RTYPE(&I)' EQ 'NDFSYN' OR &NDFSYN) X3004BS 13200000 &NDFASY SETB ('&RTYPE(&I)' EQ 'NDFASY' OR &NDFASY) X3004BS 13250000 &RDFASY SETB ('&RTYPE(&I)' EQ 'DFASY' OR &RDFASY) X3004BS 13300000 AIF (&NRESP+&RRESP+&RDFSYN+&NDFSYN+&NDFASY+&RDFASY+&A EQ &I)*13350000 .R001600 @Z40BHUC 13400000 .* CHK FOR NEW BIT SET 13450000 ISTERMAC 5,RTYPE,&RTYPE(&I) @ZA34940 13500000 &IDACB01 SETB 1 SET ERROR SWITCH X3004BS 13550000 &A SETA &A+1 BUMP ERROR COUNTER X04SVHS 13600000 AGO .R001600 X3004BS 13650000 .* CHECK FOR MUTUALLY EXCLUSIVE OPTIONS 13700000 .R001700 AIF (NOT(&NRESP AND &RRESP)).R001800 X3004BS 13750000 ISTERMAC 8,RTYPE,NRESP,RESP @ZA34940 13800000 &IDACB01 SETB 1 SET ERROR SWITCH X3004BS 13850000 .R001800 AIF (NOT(&NDFSYN AND &RDFSYN)).R001900 X3004BS 13900000 ISTERMAC 8,RTYPE,NDFSYN,DFSYN @ZA34940 13950000 &IDACB01 SETB 1 SET ERROR SWITCH X3004BS 14000000 .R001900 AIF (NOT(&NDFASY AND &RDFASY)).R002100 @Z40BHUC 14050000 ISTERMAC 8,RTYPE,NDFASY,DFASY @ZA34940 14100000 &IDACB01 SETB 1 SET ERROR SWITCH X3004BS 14150000 .R002100 ANOP X3004BS 14200000 AIF ('&CALLER' EQ 'RPL').R002150 X04SVHS 14250000 .* IF CALLED BY RPL BYPASS SETTING CBM GLOBAL 14300000 &IDAVALC(&IDAENO) SETC '&NRESP&RRESP&RDFSYN&NDFSYN&NDFASY&RDFASY.000000*14350000 0000&Z16' 14400000 AGO .R002200 X04SVHS 14450000 .R002150 ANOP X04SVHS 14500000 &IDASRTY SETC '&SRESP.000&RRESP&NDFSYN&RDFASY.0' @Z40BHUC 14550000 .* SET STYPE/RTYPE CODES FOR RPL X04SVHS 14600000 .********************************************************************** 14650000 .* CHAIN 14700000 .R002200 AIF ('&CHAIN' EQ '').R002450 *** CHAIN *** X3004BS 14750000 ISTCB3 ARG=&CHAIN,KWTC=X'68',CHKAM=VTAM,AM=&AM, @ZA34940*14800000 BIT=YES @ZA34940 14850000 &ONLY SETB ('&CHAIN' EQ 'ONLY' OR '&CHAIN' EQ '(ONLY)') X04SVHS 14900000 &FIRST SETB ('&CHAIN' EQ 'FIRST' OR '&CHAIN' EQ '(FIRST)') X04SVHS 14950000 &MIDDLE SETB ('&CHAIN' EQ 'MIDDLE' OR '&CHAIN' EQ '(MIDDLE)') X04SVHS 15000000 &LAST SETB ('&CHAIN' EQ 'LAST' OR '&CHAIN' EQ '(LAST)') X04SVHS 15050000 AIF (&ONLY+&FIRST+&MIDDLE+&LAST EQ 1).R002300 X04SVHS 15100000 .* CHK FOR NEW BIT SET 15150000 ISTERMAC 5,CHAIN,&CHAIN @ZA34940 15200000 &IDACB01 SETB 1 X3004BS 15250000 .R002300 ANOP X04SVHS 15300000 AIF (N'&CHAIN EQ 1).R002400 ONLY ONE OPTION MAY BE SPECIFIED 15350000 ISTERMAC 22,CHAIN @ZA34940 15400000 &IDACB01 SETB 1 SET ERROR SWITCH X04SVHS 15450000 .R002400 ANOP X3004BS 15500000 AIF ('&CALLER' EQ 'RPL').R002450 X04SVHS 15550000 .* IF CALLED BY RPL BYPASS SETTING CBM GLOBAL 15600000 &IDAVALC(&IDAENO) SETC '&FIRST&MIDDLE&LAST&ONLY.000000000000&Z16' 15650000 .* X04SVHS 15700000 AGO .R002500 X04SVHS 15750000 .R002450 ANOP X04SVHS 15800000 .* AT THIS POINT CHAIN IS EITHER UNSPECIFIED, OR @ZA34940 15850000 .* ISTCBRPL WAS CALLED BY THE RPL DECLARATIVE MACRO @ZA34940 15900000 AIF ('&CHAIN' NE '').R002475 IF CHAIN IS SPEC, X04SVHS 15950000 .* THEN CALLER IS RPL AND DECLARATIVE GLOBAL MUST BE SET 16000000 AIF ('&CALLER' NE 'RPL').R002500 ICALLER IS RPL, X04SVHS 16050000 .* THEN DEFAULT VALUE MUST BE SET 16100000 &ONLY SETB 1 SET DEFAULT VALUE X04SVHS 16150000 .R002475 ANOP X04SVHS 16200000 &IDACHN SETC '&FIRST&MIDDLE&LAST&ONLY.0000' X04SVHS 16250000 .* SET CHAIN CODES X04SVHS 16300000 .********************************************************************** 16350000 .* POST 16400000 .R002500 AIF ('&POST' EQ '').R002900 *** POST *** X3004BS 16450000 ISTCB3 ARG=&POST,KWTC=X'69',CHKAM=VTAM,AM=&AM,BIT=YES @ZA34940 16500000 &I SETA 0 X3004BS 16550000 &A SETA 0 ZERO ERROR COUNTER X04SVHS 16600000 .R002600 ANOP X3004BS 16650000 &I SETA &I+1 BUMP INDEX INTO LIST X04SVHS 16700000 AIF (&I GT N'&POST).R002700 CHECK FOR END OF LIST X04SVHS 16750000 &PRESP SETB ('&POST(&I)' EQ 'RESP' OR &PRESP) X3004BS 16800000 &SCHED SETB ('&POST(&I)' EQ 'SCHED' OR &SCHED) X3004BS 16850000 AIF (&PRESP+&SCHED+&A EQ &I).R002600 X04SVHS 16900000 .* CHK FOR NEW BIT SET 16950000 ISTERMAC 5,POST,&POST(&I) @ZA34940 17000000 &IDACB01 SETB 1 SET ERROR SWITCH X3004BS 17050000 &A SETA &A+1 BUMP ERROR COUNTER X04SVHS 17100000 AGO .R002600 X3004BS 17150000 .* CHECK FOR MUTUALLY EXCLUSIVE KEYWORDS 17200000 .R002700 AIF (NOT(&PRESP AND &SCHED)).R002800 X3004BS 17250000 ISTERMAC 8,POST,RESP,SCHED @ZA34940 17300000 &IDACB01 SETB 1 SET ERROR SWITCH X3004BS 17350000 .R002800 ANOP X3004BS 17400000 AIF ('&CALLER' EQ 'RPL').R002900 X04SVHS 17450000 .* IF CALLED BY RPL BYPASS SETTING CBM GLOBAL 17500000 &IDAVALC(&IDAENO) SETC '&PRESP&SCHED.00000000000000&Z16' X3004BS 17550000 .********************************************************************** 17600000 .* RESPOND 17650000 .R002900 AIF ('&RESPOND' EQ '').R003450 *** RESPOND *** X3004BS 17700000 ISTCB3 ARG=&RESPOND,KWTC=X'6A',CHKAM=VTAM,AM=&AM, @ZA34940*17750000 BIT=YES @ZA34940 17800000 .* X04SVHS 17850000 &I SETA 0 X3004BS 17900000 &A SETA 0 ZERO ERROR COUNTER X04SVHS 17950000 .R003000 ANOP X3004BS 18000000 &I SETA &I+1 BUMP INDEX INTO ARRAYS X04SVHS 18050000 AIF (&I GT N'&RESPOND).R003100 CHECK FOR END OF LIST X04SVHS 18100000 &NEX SETB ('&RESPOND(&I)' EQ 'NEX' OR &NEX) X3004BS 18150000 &EX SETB ('&RESPOND(&I)' EQ 'EX' OR &EX) X3004BS 18200000 &FME SETB ('&RESPOND(&I)' EQ 'FME' OR &FME) X3004BS 18250000 &NFME SETB ('&RESPOND(&I)' EQ 'NFME' OR &NFME) X3004BS 18300000 &NRRN SETB ('&RESPOND(&I)' EQ 'NRRN' OR &NRRN) X3004BS 18350000 &RRN SETB ('&RESPOND(&I)' EQ 'RRN' OR &RRN) X3004BS 18400000 &QRESP SETB ('&RESPOND(&I)' EQ 'QRESP' OR &QRESP) @G40AKSL 18450000 &NQRESP SETB ('&RESPOND(&I)' EQ 'NQRESP' OR &NQRESP) @G40AKSL 18500000 AIF (&NEX+&EX+&FME+&NFME+&NRRN+&RRN+&A+&QRESP+&NQRESP EQ &I)*18550000 .R003000 @G40AKSL 18600000 .* CHECK FOR VALID OPTION 18650000 ISTERMAC 5,RESPOND,&RESPOND(&I) @ZA34940 18700000 &IDACB01 SETB 1 SET ERROR SWITCH X3004BS 18750000 &A SETA &A+1 BUMP ERROR COUNTER X04SVHS 18800000 AGO .R003000 X3004BS 18850000 .* CHECK FOR MUTUALLY EXCLUSIVE KEYWORDS 18900000 .R003100 AIF (NOT(&NEX AND &EX)).R003200 X3004BS 18950000 ISTERMAC 8,RESPOND,NEX,EX @ZA34940 19000000 &IDACB01 SETB 1 SET ERROR SWITCH X04SVHS 19050000 .R003200 AIF (NOT(&FME AND &NFME)).R003300 X3004BS 19100000 ISTERMAC 8,RESPOND,FME,NFME @ZA34940 19150000 &IDACB01 SETB 1 SET ERROR SWITCH X04SVHS 19200000 .R003300 AIF (NOT(&NRRN AND &RRN)).R003400 X3004BS 19250000 ISTERMAC 8,RESPOND,NRRN,RRN @ZA34940 19300000 &IDACB01 SETB 1 SET ERROR SWITCH X04SVHS 19350000 .R003400 ANOP X3004BS 19400000 AIF ('&CALLER' EQ 'RPL').R003450 X04SVHS 19450000 .* IF CALLED BY RPL BYPASS SETTING CBM GLOBAL 19500000 &IDAVALC(&IDAENO) SETC '&NEX&EX&FME&NFME&NRRN&RRN&QRESP&NQRESP.00000000*19550000 &Z16' @G40AKSL 19600000 AGO .R003500 X04SVHS 19650000 .R003450 ANOP X04SVHS 19700000 &IDAPORE SETC '&SCHED.000&QRESP&EX&NFME&RRN' SET POST/RESPOND @G40AKCM 19750000 .********************************************************************** 19800000 .* CONTROL 19850000 .R003500 AIF ('&CONTROL' EQ '').R003750 X04SVHS 19900000 AIF ('&AM' NE 'VTAM').AMERR 19950000 ISTCB3 ARG=&CONTROL,KWTC=X'6B',BIT=YES @ZA34940 20000000 .* X04SVHS 20050000 &DATA SETB ('&CONTROL' EQ 'DATA' OR '&CONTROL' EQ '(DATA)') X04SVHS 20100000 &CANCEL SETB ('&CONTROL' EQ 'CANCEL' OR '&CONTROL' EQ '(CANCEL)') 20150000 .* X04SVHS 20200000 &QC SETB ('&CONTROL' EQ 'QC' OR '&CONTROL' EQ '(QC)') X04SVHS 20250000 &QEC SETB ('&CONTROL' EQ 'QEC' OR '&CONTROL' EQ '(QEC)') X04SVHS 20300000 &CHASE SETB ('&CONTROL' EQ 'CHASE' OR '&CONTROL' EQ '(CHASE)') 20350000 .* X04SVHS 20400000 &RELQ SETB ('&CONTROL' EQ 'RELQ' OR '&CONTROL' EQ '(RELQ)') X04SVHS 20450000 &CSDT SETB ('&CONTROL' EQ 'SDT' OR '&CONTROL' EQ '(SDT)') X04SVHS 20500000 &CLEAR SETB ('&CONTROL' EQ 'CLEAR' OR '&CONTROL' EQ '(CLEAR)') 20550000 .* X04SVHS 20600000 &STSN SETB ('&CONTROL' EQ 'STSN' OR '&CONTROL' EQ '(STSN)') X04SVHS 20650000 &SHUTD SETB ('&CONTROL' EQ 'SHUTD' OR '&CONTROL' EQ '(SHUTD)') 20700000 .* X04SVHS 20750000 &RQR SETB ('&CONTROL' EQ 'RQR' OR '&CONTROL' EQ '(RQR)') X04SVHS 20800000 &BID SETB ('&CONTROL' EQ 'BID' OR '&CONTROL' EQ '(BID)') X04SVHS 20850000 &LUS SETB ('&CONTROL' EQ 'LUS' OR '&CONTROL' EQ '(LUS)') X04SVHS 20900000 &RTR SETB ('&CONTROL' EQ 'RTR' OR '&CONTROL' EQ '(RTR)') X04SVHS 20950000 &SIGNAL SETB ('&CONTROL' EQ 'SIGNAL' OR '&CONTROL' EQ '(SIGNAL)') 21000000 .* X04SVHS 21050000 &RSHUTD SETB ('&CONTROL' EQ 'RSHUTD' OR '&CONTROL' EQ '(RSHUTD)') 21100000 .* X04SVHS 21150000 &SHUTC SETB ('&CONTROL' EQ 'SHUTC' OR '&CONTROL' EQ '(SHUTC)') 21200000 .* CHECK IF VALID OPTION WAS SPECIFIED @ZA07554 21250000 &BIND SETB ('&CONTROL' EQ 'BIND' OR '&CONTROL' EQ '(BIND)') 21300000 .* @G40AKCM 21350000 &UNBIND SETB ('&CONTROL' EQ 'UNBIND' OR '&CONTROL' EQ '(UNBIND)') 21400000 .* CHECK IF VALID OPTION WAS SPECIFIED @G40AKCM 21450000 &SBI SETB ('&CONTROL' EQ 'SBI' OR '&CONTROL' EQ '(SBI)') 21500000 .* @G40AKCM 21550000 &BIS SETB ('&CONTROL' EQ 'BIS' OR '&CONTROL' EQ '(BIS)') 21600000 .* CHECK IF VALID OPTION WAS SPECIFIED @G40AKCM 21650000 AIF (&DATA+&CANCEL+&QC+&QEC+&CHASE+&RELQ+&CSDT+&CLEAR+&STSN+*21700000 &SHUTD+&RQR+&BID+&LUS+&RTR+&SIGNAL+&RSHUTD+&SHUTC+&BIND+*21750000 &UNBIND+&SBI+&BIS EQ 1).R003600 @G40AKCM 21800000 ISTERMAC 5,CONTROL,&CONTROL @ZA34940 21850000 &IDACB01 SETB 1 SET ERROR SWITCH X3004BS 21900000 .R003600 ANOP 21950000 AIF (N'&CONTROL EQ 1).R003700 ONLY ONE OPTION IS ALLOWED 22000000 ISTERMAC 22,CONTROL @ZA34940 22050000 &IDACB01 SETB 1 SET ERROR SWITCH X04SVHS 22100000 .R003700 ANOP X3004BS 22150000 AIF ('&CALLER' EQ 'RPL').R003750 X04SVHS 22200000 .* IF CALLED BY RPL BYPASS SETTING CBM GLOBAL 22250000 &IDAVALC(&IDAENO) SETC '&DATA&CANCEL&QC&QEC&CHASE&RELQ&BID&RTR&LUS&SIGN*22300000 AL&CSDT&CLEAR&STSN&SHUTD&RQR&RSHUTD&SHUTC&BIND&UNBIND&SB*22350000 I&BIS.000&Z8' @G40AKCM 22400000 AGO .R003900 22450000 .R003750 ANOP 22500000 .* AT THIS POINT EITHER CONTROL IS NOT SPECIFIED, OR @ZA34940 22550000 .* ISTCBRPL HAS BEEN CALLED BY THE RPL DECLARATIVE MACRO @ZA34940 22600000 AIF ('&CONTROL' NE '').R003775 IF CONTROL IS SPEC, X04SVHS 22650000 .* THEN CALLER IS RPL, AND DECLARATIVE GLOBALS MUST BE SET 22700000 AIF ('&CALLER' NE 'RPL').R003900 IF CONTROL IS NULL X04SVHS 22750000 .* AND CALLER IS RPL, THEN VTAM DEFAULT VALUE MUST BE SET 22800000 &DATA SETB 1 SET VTAM DEFAULT X04SVHS 22850000 .R003775 ANOP 22900000 &IDACON1 SETC '&DATA&CANCEL&QC&QEC&CHASE&RELQ.00' X04SVHS 22950000 &IDACON2 SETC '&BID&RTR&LUS&SIGNAL&BIND&UNBIND&SBI&BIS' @G40AKCM 23000000 &IDACON3 SETC '&CSDT&CLEAR&STSN&SHUTD&SHUTC&RQR.00' @G40AKCM 23050000 AGO .R003900 23100000 .AMERR MNOTE 8,'CONTROL IS INVALID UNLESS AM IS SPECIFIED' 23150000 &IDACB01 SETB 1 23200000 .********************************************************************** 23250000 .* OBSQAC 23300000 .R003900 AIF ('&OBSQAC' EQ '').R004050 *** OBSQAC *** 23350000 ISTCB3 ARG=&OBSQAC,KWTC=X'6C',CHKAM=VTAM,AM=&AM, @ZA34940*23400000 BIT=YES @ZA34940 23450000 .* X04SVHS 23500000 &SET SETB ('&OBSQAC' EQ 'SET' OR '&OBSQAC' EQ '(SET)') X04SVHS 23550000 &TESTSET SETB ('&OBSQAC' EQ 'TESTSET' OR '&OBSQAC' EQ '(TESTSET)') 23600000 .* X04SVHS 23650000 &RESET SETB ('&OBSQAC' EQ 'RESET' OR '&OBSQAC' EQ '(RESET)') X04SVHS 23700000 &IGNORE SETB ('&OBSQAC' EQ 'IGNORE' OR '&OBSQAC' EQ '(IGNORE)') 23750000 .* X04SVHS 23800000 &TESTPOS SETB ('&OBSQAC' EQ 'TESTPOS' OR '&OBSQAC' EQ '(TESTPOS)') 23850000 .* X04SVHS 23900000 &TESTNEG SETB ('&OBSQAC' EQ 'TESTNEG' OR '&OBSQAC' EQ '(TESTNEG)') 23950000 .* X04SVHS 24000000 &INVALID SETB ('&OBSQAC' EQ 'INVALID' OR '&OBSQAC' EQ '(INVALID)') 24050000 .* X04SVHS 24100000 AIF (&SET+&TESTSET+&RESET+&IGNORE+&TESTPOS+&TESTNEG+&INVALID*24150000 EQ 1).R003950 24200000 .* CHECK FOR VALID OPTION 24250000 ISTERMAC 5,OBSQAC,&OBSQAC(&I) @ZA34940 24300000 &IDACB01 SETB 1 SET ERROR SWITCH X3004BS 24350000 .R003950 AIF (N'&OBSQAC EQ 1).R004000 ONE OPTION IS ALLOWED 24400000 ISTERMAC 22,OBSQAC @ZA34940 24450000 &IDACB01 SETB 1 SET ERROR SWITCH X04SVHS 24500000 .R004000 ANOP X3004BS 24550000 AIF ('&CALLER' EQ 'RPL').R004050 X04SVHS 24600000 .* IF CALLED BY RPL BYPASS SETTING CBM GLOBAL 24650000 &IDAVALC(&IDAENO) SETC '&SET&TESTSET&RESET&IGNORE&TESTPOS&TESTNEG&INVAL*24700000 ID.000000000&Z16' 24750000 AGO .R004100 X04SVHS 24800000 .R004050 ANOP X04SVHS 24850000 .* AT THIS POINT, EITHER OBSQAC IS NOT SPECIFIED, OR @ZA34940 24900000 .* ISTCBRPL HAS BEEN CALLED BY THE RPL DECLARATIVE MACRO @ZA34940 24950000 AIF ('&OBSQAC' NE '').R004075 I FOBSQAC IS SPEC, X04SVHS 25000000 .* THEN CALLER I SRPL, AND DECLARATIVE GLOBALS MUST BE SET 25050000 AIF ('&CALLER' NE 'RPL').R004100 X04SVHS 25100000 .* IF OBSQAC IS NULL, AND CALLER IS RPL, THEN DEFAULT 25150000 .* VALUE MUST BE SET 25200000 &SET SETB 1 SET DEFAULT VALUE X04SVHS 25250000 .R004075 ANOP X04SVHS 25300000 &IDAOBQC SETC '&SET&TESTSET&RESET&IGNORE&TESTPOS&TESTNEG&INVALID.0' 25350000 .* SET OBSQAC CODES X04SVHS 25400000 .********************************************************************** 25450000 .* IBSQAC 25500000 .R004100 AIF ('&IBSQAC' EQ '').R004350 *** IBSQAC *** X3004BS 25550000 ISTCB3 ARG=&IBSQAC,KWTC=X'6D',CHKAM=VTAM,AM=&AM, @ZA34940*25600000 BIT=YES @ZA34940 25650000 .* X04SVHS 25700000 &ISET SETB ('&IBSQAC' EQ 'SET' OR '&IBSQAC' EQ '(SET)') X04SVHS 25750000 &ITESTSE SETB ('&IBSQAC' EQ 'TESTSET' OR '&IBSQAC' EQ '(TESTSET)') 25800000 .* X04SVHS 25850000 &IRESET SETB ('&IBSQAC' EQ 'RESET' OR '&IBSQAC' EQ '(RESET)') X04SVHS 25900000 &IIGNORE SETB ('&IBSQAC' EQ 'IGNORE' OR '&IBSQAC' EQ '(IGNORE)') 25950000 .* X04SVHS 26000000 &ITESTPO SETB ('&IBSQAC' EQ 'TESTPOS' OR '&IBSQAC' EQ '(TESTPOS)') 26050000 .* X04SVHS 26100000 &ITESTNE SETB ('&IBSQAC' EQ 'TESTNEG' OR '&IBSQAC' EQ '(TESTNEG)') 26150000 .* X04SVHS 26200000 &IINVALI SETB ('&IBSQAC' EQ 'INVALID' OR '&IBSQAC' EQ '(INVALID)') 26250000 .* X04SVHS 26300000 AIF (&ISET+&ITESTSE+&IRESET+&IIGNORE+&ITESTPO+&ITESTNE+&IINV*26350000 ALI EQ 1).R004200 X04SVHS 26400000 .* CHECK FOR VALID OPTION 26450000 ISTERMAC 5,IBSQAC,&IBSQAC @ZA34940 26500000 &IDACB01 SETB 1 SET ERROR SWITCH X3004BS 26550000 .R004200 AIF (N'&IBSQAC EQ 1).R004300 ONLY ONE OPTION IS ALLOWED 26600000 ISTERMAC 22,IBSQAC @ZA34940 26650000 &IDACB01 SETB 1 SET ERROR SWITCH X3004BS 26700000 .R004300 ANOP X3004BS 26750000 AIF ('&CALLER' EQ 'RPL').R004350 X04SVHS 26800000 .* IF CALLED BY RPL BYPASS SETTING CBM GLOBAL 26850000 &IDAVALC(&IDAENO) SETC '&ISET&ITESTSE&IRESET&IIGNORE&ITESTPO&ITESTNE&II*26900000 NVALI.000000000&Z16' X04SVHS 26950000 AGO .R004400 X04SVHS 27000000 .R004350 ANOP X04SVHS 27050000 .* AT THIS POINT EITHER IBSQAC IS NOT SPECIFIED, OR @ZA34940 27100000 .* ISTCBRPL HAS BEEN CALLED BY THE RPL DECLARATIVE MACRO @ZA34940 27150000 AIF ('&IBSQAC' NE '').R004375 IF IBSQAC IS SPEC, X04SVHS 27200000 .* THEN CALLER IS RPL AND DECLARATIVE GLOBALS MUST BE SET 27250000 AIF ('&CALLER' NE 'RPL').R004400 IF CALLER IS RPL, X04SVHS 27300000 .* THEN DEFAULT VALUE MUST BE SET X04SVHS 27350000 &ISET SETB 1 SET DEFAULT VALUE X04SVHS 27400000 .R004375 ANOP X04SVHS 27450000 &IDAIBQC SETC '&ISET&ITESTSE&IRESET&IIGNORE&ITESTPO&ITESTNE&IINVALI.0' 27500000 .* SET IBSQAC CODES X04SVHS 27550000 .********************************************************************** 27600000 .* SSENSEO 27650000 .R004400 AIF ('&SSENSEO' EQ '').R004700 *** SSENSEO *** X3004BS 27700000 ISTCB3 ARG=&SSENSEO,KWTC=X'71',CHKAM=VTAM,AM=&AM, @ZA34940*27750000 BIT=YES @ZA34940 27800000 .* X04SVHS 27850000 &OCPM SETB ('&SSENSEO' EQ 'CPM' OR '&SSENSEO' EQ '(CPM)') X04SVHS 27900000 &OSTATE SETB ('&SSENSEO' EQ 'STATE' OR '&SSENSEO' EQ '(STATE)') 27950000 .* X04SVHS 28000000 &OFI SETB ('&SSENSEO' EQ 'FI' OR '&SSENSEO' EQ '(FI)') X04SVHS 28050000 &ORR SETB ('&SSENSEO' EQ 'RR' OR '&SSENSEO' EQ '(RR)') X04SVHS 28100000 AIF (&OCPM+&OSTATE+&OFI+&ORR EQ 1).R004500 X04SVHS 28150000 .* TEST FOR VALID OPTION SPEC 28200000 ISTERMAC 5,SSENSEO,&SSENSEO @ZA34940 28250000 &IDACB01 SETB 1 SET ERROR SWITCH X3004BS 28300000 .R004500 ANOP X03004HS 28350000 AIF (N'&SSENSEO EQ 1).R004600 X04SVHS 28400000 ISTERMAC 22,SSENSEO ONLY ONE OPTION ALLOWED @ZA34940 28450000 &IDACB01 SETB 1 SET ERROR SWITCH X03004HS 28500000 .R004600 ANOP X03004HS 28550000 AIF ('&CALLER' EQ 'RPL').R004650 X04SVHS 28600000 .* IF CALLED BY RPL BYPASS SETTING CBM GLOBAL 28650000 &IDAVALC(&IDAENO) SETC '&OCPM&OSTATE&OFI&ORR.000000000000&Z16' X03004HS 28700000 AGO .R004700 X04SVHS 28750000 .R004650 ANOP X04SVHS 28800000 &IDASNSO SETC '0&OCPM&OSTATE&OFI&ORR.000' X04SVHS 28850000 .* SET SSENSEO CODES X04SVHS 28900000 AGO .R005250 WHEN CALLED BY RPL, PROCESS 28950000 .* BRANCH KEYWORD X04SVHS 29000000 .********************************************************************** 29050000 .* SSENSEI 29100000 .R004700 AIF ('&SSENSEI' EQ '').R005000 *** SSENSEI *** X3004BS 29150000 ISTCB3 ARG=&SSENSEI,KWTC=X'72',CHKAM=VTAM,AM=&AM, @ZA34940*29200000 BIT=YES @ZA34940 29250000 .* X04SVHS 29300000 &IPATH SETB ('&SSENSEI' EQ 'PATH' OR '&SSENSEI' EQ '(PATH)') X04SVHS 29350000 &ICPM SETB ('&SSENSEI' EQ 'CPM' OR '&SSENSEI' EQ '(CPM)') X04SVHS 29400000 &ISTATE SETB ('&SSENSEI' EQ 'STATE' OR '&SSENSEI' EQ '(STATE)') 29450000 .* X04SVHS 29500000 &IFI SETB ('&SSENSEI' EQ 'FI' OR '&SSENSEI' EQ '(FI)') X04SVHS 29550000 &IRR SETB ('&SSENSEI' EQ 'RR' OR '&SSENSEI' EQ '(RR)') X04SVHS 29600000 AIF (&IPATH+&ICPM+&ISTATE+&IFI+&IRR EQ 1).R004800 29650000 .* TEST FOR VALID OPTION SPEC 29700000 ISTERMAC 5,SSENSEI,&SSENSEI @ZA34940 29750000 &IDACB01 SETB 1 SET ERROR SWITCH X3004BS 29800000 .R004800 ANOP X03004HS 29850000 AIF (N'&SSENSEI EQ 1).R004900 ONLY ONE OPTION IS ALLOWED 29900000 ISTERMAC 22,SSENSEI @ZA34940 29950000 &IDACB01 SETB 1 SET ERROR SWITCH X03004HS 30000000 .R004900 ANOP X04SVHS 30050000 &IDAVALC(&IDAENO) SETC '&IPATH&ICPM&ISTATE&IFI&IRR.00000000000&Z16' 30100000 .R005000 ANOP @Z40BHUC 30150000 .********************************************************************** 30200000 .* SSENSMO 30250000 ISTCB3 ARG=&SSENSMO,ARGNAME=SSENSMO,KWTC=X'86', @ZA34940*30300000 MF=&MF,CHKAM=VTAM,AM=&AM @ZA34940 30350000 .********************************************************************** 30400000 .* SSENSMI 30450000 ISTCB3 ARG=&SSENSMI,ARGNAME=SSENSMI,KWTC=X'87', @ZA34940*30500000 MF=&MF,CHKAM=VTAM,AM=&AM @ZA34940 30550000 .********************************************************************** 30600000 .* SIGDATA 30650000 ISTCB3 ARG=&SIGDATA,ARGNAME=SIGDATA,KWTC=X'88', @ZA34940*30700000 MF=&MF,CHKAM=VTAM,AM=&AM @ZA34940 30750000 .********************************************************************** 30800000 .* OBSQVAL 30850000 ISTCB3 ARG=&OBSQVAL,ARGNAME=OBSQVAL,KWTC=X'6E', @ZA34940*30900000 MF=&MF,CHKAM=VTAM,AM=&AM @ZA34940 30950000 .********************************************************************** 31000000 .* IBSQVAL 31050000 ISTCB3 ARG=&IBSQVAL,ARGNAME=IBSQVAL,KWTC=X'6F', @ZA34940*31100000 MF=&MF,CHKAM=VTAM,AM=&AM @ZA34940 31150000 .********************************************************************** 31200000 .* SEQNO 31250000 ISTCB3 ARG=&SEQNO,ARGNAME=SEQNO,KWTC=X'70',MF=&MF, @ZA34940*31300000 CHKAM=VTAM,AM=&AM X04SVHS 31350000 .********************************************************************** 31400000 .* USENSEO 31450000 ISTCB3 ARG=&USENSEO,ARGNAME=USENSEO,KWTC=X'73', @ZA34940*31500000 MF=&MF,CHKAM=VTAM,AM=&AM @ZA34940 31550000 .********************************************************************** 31600000 .* USENSEI 31650000 ISTCB3 ARG=&USENSEI,ARGNAME=USENSEI,KWTC=X'74', @ZA34940*31700000 MF=&MF,CHKAM=VTAM,AM=&AM @ZA34940 31750000 .********************************************************************** 31800000 .* RECLEN 31850000 ISTCB3 ARG=&RECLEN,ARGNAME=RECLEN,KWTC=X'35',MF=&MF @ZA34940 31900000 .********************************************************************** 31950000 .* AAREA 32000000 ISTCB3 ARG=&AAREA,ARGNAME=AAREA,KWTC=X'57',MF=&MF, @ZA34940*32050000 CHKAM=VTAM,AM=&AM X04SVHS 32100000 .********************************************************************** 32150000 .* AAREALN 32200000 ISTCB3 ARG=&AAREALN,ARGNAME=AAREALN,KWTC=X'49', @ZA34940*32250000 MF=&MF,CHKAM=VTAM,AM=&AM @ZA34940 32300000 .********************************************************************** 32350000 .* ARECLEN 32400000 ISTCB3 ARG=&ARECLEN,ARGNAME=ARECLEN,KWTC=X'4A', @ZA34940*32450000 MF=&MF,CHKAM=VTAM,AM=&AM @ZA34940 32500000 .********************************************************************** 32550000 .* EXIT 32600000 ISTCB3 ARG=&EXIT,ARGNAME=EXIT,KWTC=X'4B',MF=&MF, @ZA34940*32650000 CHKAM=VTAM,AM=&AM @ZA34940 32700000 .********************************************************************** 32750000 .* NIB 32800000 ISTCB3 ARG=&NIB,ARGNAME=NIB,KWTC=X'4F',MF=&MF, @ZA34940*32850000 CHKAM=VTAM,AM=&AM @ZA34940 32900000 .********************************************************************** 32950000 .* BRANCH 33000000 .R005250 ANOP X04SVHS 33050000 AIF ('&BRANCH' EQ '').R005400 *** BRANCH *** X03004 33100000 ISTCB3 ARG=&BRANCH,KWTC=X'58',CHKAM=VTAM,AM=&AM, @ZA34940*33150000 BIT=YES @ZA34940 33200000 .* X04SVHS 33250000 &BRYES SETB ('&BRANCH' EQ 'YES') 33300000 &BRNO SETB ('&BRANCH' EQ 'NO') 33350000 AIF (&BRYES OR &BRNO).R005300 TEST FOR VALID OPTION X04SVHS 33400000 ISTERMAC 3,BRANCH,&BRANCH @ZA34940 33450000 &IDACB01 SETB 1 SET ERROR SWITCH X04SVHS 33500000 .R005300 ANOP 33550000 AIF ('&CALLER' EQ 'RPL').R005350 X04SVHS 33600000 .* IF CALLED BY RPL BYPASS SETTING CBM GLOBAL 33650000 &IDAVALC(&IDAENO) SETC '&BRYES&BRNO.00000000000000&Z16' X03004 33700000 AGO .R005400 @G40AKSL 33750000 .R005350 ANOP X04SVHS 33800000 &IDABRCH SETC '&BRYES' SET BRANCH CODE X04SVHS 33850000 .********************************************************************** 33900000 .* CRYPT @G40AKSL 33950000 .R005400 ANOP @G40AKSL 34000000 AIF ('&CRYPT' EQ '').R005440 ***CRYPT*** @G40AKSL 34050000 ISTCB3 ARG=&CRYPT,KWTC=X'95',AM=&AM,CHKAM=VTAM, @ZA34940*34100000 BIT=YES @ZA34940 34150000 &CRYES SETB ('&CRYPT' EQ 'YES') @G40AKSL 34200000 &CRNO SETB ('&CRYPT' EQ 'NO') @G40AKSL 34250000 AIF (&CRYES OR &CRNO).R005425 TEST FOR VALID OPTION 34300000 ISTERMAC 3,CRYPT,&CRYPT @ZA34940 34350000 &IDACB01 SETB 1 @G40AKSL 34400000 .R005425 ANOP @G40AKSL 34450000 AIF ('&CALLER' EQ 'RPL').R005430 @G40AKSL 34500000 .* IF CALLED BY RPL BYPASS SETTING CBM GLOBAL @G40AKSL 34550000 &IDAVALC(&IDAENO) SETC '&CRYES&CRNO.00000000000000&Z16' @G40AKSL 34600000 AGO .R005440 @G40AKSL 34650000 .R005430 ANOP @G40AKSL 34700000 &IDACRYP SETC '&CRYES' SET CRYPT CODE @G40AKSL 34750000 .********************************************************************** 34800000 .R005440 AIF ('&CALLER' NE 'RPL').R005450 X04SVHS 34850000 .* IF CALLER IS RPL, ALL KEYWORDS HAVE BEEN PROCESSED 34900000 MEXIT X04SVHS 34950000 .* 35000000 .* TEST FOR INCOMPATIBLE VTAM KEYWORDS X03004 35050000 .R005450 AIF ('&ARG' EQ '' OR '&NIB' EQ '').R005500 X03004 35100000 ISTERMAC 19,ARG,NIB @ZA34940 35150000 &IDACB01 SETB 1 X03004 35200000 .R005500 AIF ('&ECB' EQ '' OR '&EXIT' EQ '').R006100 X03004 35250000 ISTERMAC 19,ECB,EXIT @ZA34940 35300000 &IDACB01 SETB 1 X03004 35350000 .R006100 AIF ('&RBA' EQ '' OR '&SEQNO' EQ '').R006200 X3004BS 35400000 ISTERMAC 19,RBA,SEQNO @ZA34940 35450000 &IDACB01 SETB 1 X3004BS 35500000 .R006200 AIF ('&KEYLEN' EQ '' OR '&CHNGDIR' EQ '').R006300 X3004BS 35550000 ISTERMAC 19,KEYLEN,CHNGDIR @ZA34940 35600000 &IDACB01 SETB 1 X3004BS 35650000 .R006300 AIF ('&KEYLEN' EQ '' OR '&STYPE' EQ '').R006400 X3004BS 35700000 ISTERMAC 19,KEYLEN,STYPE @ZA34940 35750000 &IDACB01 SETB 1 X3004BS 35800000 .R006400 AIF ('&KEYLEN' EQ '' OR '&RTYPE' EQ '').R006450 X04SVHS 35850000 ISTERMAC 19,KEYLEN,RTYPE @ZA34940 35900000 &IDACB01 SETB 1 X3004BS 35950000 .R006450 AIF ('&KEYLEN' EQ '' OR '&BRACKET' EQ '').R006500 X04SVHS 36000000 ISTERMAC 19,KEYLEN,BRACKET @ZA34940 36050000 &IDACB01 SETB 1 SET ERROR SWITCH X04SVHS 36100000 .R006500 ANOP X04SVHS 36150000 .********************************************************************** 36200000 .* TRANSID 36250000 ISTCB3 ARG=&TRANSID,ARGNAME=TRANSID,KWTC=X'5F',MF=&MF @ZA34940 36300000 .********************************************************************** 36350000 .* AM 36400000 AIF ('&AM' EQ '' OR '&CALLER' NE 'GEN').R006700 X04SVHS 36450000 .* ARGUMENT CONTROL ENTRY IS ONLY BUILT FOR GENCB FOR AM 36500000 &VSAM SETB ('&AM' EQ 'VSAM') CHK FOR AM=VSAM X04SVHS 36550000 &VTAM SETB ('&AM' EQ 'VTAM') CHK FOR AM=VTAM X04SVHS 36600000 AIF (&VSAM OR &VTAM).R006600 36650000 .* IF NOT VSAM OR VTAM, ERROR 36700000 ISTERMAC 5,AM,&AM @ZA34940 36750000 &IDACB01 SETB 1 SET ERROR SWITCH X04SVHS 36800000 .R006600 ANOP X04SVHS 36850000 ISTCB3 ARG=&AM,KWTC=X'40',BIT=YES @ZA34940 36900000 &IDAVALC(&IDAENO) SETC '&VSAM&VTAM.00000000000000&Z16' 36950000 .********************************************************************** 37000000 .R006700 ANOP X04SVHS 37050000 AIF ('&CALLER' EQ 'GEN' OR '&CALLER' EQ 'MOD').R007500 37100000 .* X04SVHS 37150000 .* THE FOLLOWING KEYWORDS ARE VALID ONLY FOR TESTCB 37200000 .* 37250000 .********************************************************************** 37300000 .* IO 37350000 AIF ('&IO' EQ '').R006900 *** IO *** 37400000 ISTCB3 ARG=&IO,ARGNAME=IO,KWTC=X'36',MF=&MF, @ZA34940*37450000 INDRECT=YES,BIT=YES @ZA34940 37500000 AIF ('&IO(1)' EQ '*').R006900 37550000 .* IF INDIRECT ADDRESS WAS SPECIFIED, THE VALUE ARRAY(&IDAVALC) 37600000 .* WAS SET IN ISTCB3 @ZA34940 37650000 &COMPLET SETB ('&IO' EQ 'COMPLETE') X04SVHS 37700000 AIF (&COMPLET).R006800 CHK FOR CORRECT OPTION X04SVHS 37750000 ISTERMAC 3,IO,&IO @ZA34940 37800000 &IDACB01 SETB 1 SET ERROR SWITCH 37850000 .R006800 ANOP 37900000 &IDAVALC(&IDAENO) SETC '&COMPLET.000000000000000&Z16' X04SVHS 37950000 .********************************************************************** 38000000 .R006900 ANOP 38050000 .* FDBK 38100000 ISTCB3 ARG=&FDBK,ARGNAME=FDBK,KWTC=X'38',MF=&MF @ZA34940 38150000 .********************************************************************** 38200000 .* RBA 38250000 ISTCB3 ARG=&RBA,ARGNAME=RBA,KWTC=X'39',MF=&MF @ZA34940 38300000 .********************************************************************** 38350000 .* AIXPC 38400000 ISTCB3 ARG=&AIXPC,ARGNAME=AIXPC,KWTC=X'3A',MF=&MF @ZA34940 38450000 .********************************************************************** 38500000 AIF ('&AIXFLAG' EQ '').R007100 ** AIXFLAG *** X04SVHS 38550000 &PRIME SETB ('&AIXFLAG' EQ 'AIXPKP') @XM07772 38600000 AIF (&PRIME).R007000 @XM07772 38650000 .* CHK FOR VALID OPTION SPEC 38700000 ISTERMAC 5,AIXFLAG,&AIXFLAG @ZA34940 38750000 &IDACB01 SETB 1 SET ERROR SWITCH X04SVHS 38800000 .R007000 ANOP X04SVHS 38850000 ISTCB3 ARG=&AIXFLAG,KWTC=X'3B',BIT=YES @ZA34940 38900000 &IDAVALC(&IDAENO) SETC '&PRIME.000000000000000&Z16' @XM07772 38950000 .********************************************************************** 39000000 .R007100 ANOP X04SVHS 39050000 .* USER 39100000 ISTCB3 ARG=&USER,ARGNAME=USER,KWTC=X'4E',MF=&MF, @ZA34940*39150000 CHKAM=VTAM,AM=&AM X04SVHS 39200000 .********************************************************************** 39250000 .* RTNCD 39300000 ISTCB3 ARG=&RTNCD,ARGNAME=RTNCD,KWTC=X'5E',MF=&MF @ZA34940 39350000 .********************************************************************** 39400000 .* FDBK2 39450000 ISTCB3 ARG=&FDBK2,ARGNAME=FDBK2,KWTC=X'60',MF=&MF @ZA34940 39500000 .********************************************************************** 39550000 .* SENSE 39600000 ISTCB3 ARG=&SENSE,ARGNAME=SENSE,KWTC=X'61',MF=&MF, @ZA34940*39650000 CHKAM=VTAM,AM=&AM X04SVHS 39700000 .********************************************************************** 39750000 .* REQ 39800000 ISTCB3 ARG=&REQ,ARGNAME=REQ,KWTC=X'62',MF=&MF @ZA34940 39850000 .********************************************************************** 39900000 .* DATAFLG 39950000 AIF ('&DATAFLG' EQ '').R007400 *** DATAFLG *** X04SVHS 40000000 ISTCB3 ARG=&DATAFLG,KWTC=X'5D',CHKAM=VTAM,AM=&AM, @ZA34940*40050000 BIT=YES @ZA34940 40100000 .* X04SVHS 40150000 &I SETA 0 X03004 40200000 &A SETA 0 ZERO ERROR COUNTER X04SVHS 40250000 .R007200 ANOP X03004 40300000 &I SETA &I+1 BUMP INDEX INTO LIST X03004 40350000 AIF (&I GT N'&DATAFLG).R007300 CHECK FOR END OF LIST X03004 40400000 &UNSOL SETB ('&DATAFLG(&I)' EQ 'UNSOL' OR &UNSOL) X03004 40450000 &EOB SETB ('&DATAFLG(&I)' EQ 'EOB' OR &EOB) X03004 40500000 &EOM SETB ('&DATAFLG(&I)' EQ 'EOM' OR &EOM) X03004 40550000 &EOT SETB ('&DATAFLG(&I)' EQ 'EOT' OR &EOT) X03004 40600000 &LOGOFF SETB ('&DATAFLG(&I)' EQ 'LOGOFF' OR &LOGOFF) X03004 40650000 &LG SETB ('&DATAFLG(&I)' EQ 'LG' OR &LG) X03004 40700000 &SOH SETB ('&DATAFLG(&I)' EQ 'SOH' OR &SOH) X03004 40750000 AIF (&UNSOL+&EOB+&EOM+&EOT+&LOGOFF+&LG+&SOH+&A EQ &I).R00720*40800000 0 X04SVHS 40850000 TEST FOR VALID OPTION SPEC 40900000 ISTERMAC 5,DATAFLG,&DATAFLG(&I) @ZA34940 40950000 &IDACB01 SETB 1 SET ERROR SWITCH X03004 41000000 &A SETA &A+1 BUMP ERROR COUNTER X04SVHS 41050000 AGO .R007200 X03004 41100000 .R007300 ANOP X03004 41150000 &IDAVALC(&IDAENO) SETC '&UNSOL&EOB&EOM&EOT&LOGOFF&LG&SOH.000000000&Z16' 41200000 .* X04SVHS 41250000 .********************************************************************** 41300000 .R007400 ANOP X04SVHS 41350000 .* FTNCD 41400000 ISTCB3 ARG=&FTNCD,ARGNAME=FTNCD,KWTC=X'63',MF=&MF @ZA34940 41450000 .********************************************************************** 41500000 .R007500 ANOP 41550000 MEND 41600000