PUNCH ' SETCODE AC(1) ' * Token Creation routine. Must be authorized to System Level Name/Token Pair * Reads input tokens from DDname TOKIN. * * New name/token pairs are echoed via WTO to the console * * Author: Lionel B. Dyck * Kaiser Permanente Information Technology * 25 N. Via Monte Ave * Walnut Creek, Ca 94598 * e-mail: lionel.b.dyck@kp.org * TOKCREAT CSECT TOKCREAT AMODE 31 TOKCREAT RMODE 24 BAKR R14,R0 LR R12,R15 USING TOKCREAT,R12 LOAD EP=IEANTDL ST R0,IEANTDL LOAD EP=IEANTCR ST R0,IEANTCR OPEN TOKIN GETTOKEN GET TOKIN LR R5,R1 CLI 0(R5),C'*' BE GETTOKEN MVC NAME,0(R5) MVC TOKEN,19(R5) MVC WTONAME,NAME MVC WTOTOKEN,TOKEN MODESET KEY=ZERO,MODE=SUP L R15,IEANTDL CALL (15),(LEVEL,NAME,RETCODE) L R3,RETCODE C R3,=F'04' BNH CREATE L R8,RETCODE LR R9,R15 ABEND 1 CREATE DS 0H L R15,IEANTCR CALL (15),(LEVEL,NAME,TOKEN,PERSOPT,RETCODE) MODESET KEY=NZERO,MODE=PROB CLC RETCODE,=F'0' BNE ABEND2 LA R1,WTOA SVC 35 B GETTOKEN ABEND2 DS 0H L R8,RETCODE LR R9,R15 ABEND 2 EXIT DS 0H CLOSE (TOKIN) DELETE EP=IEANTCR DELETE EP=IEANDTL SR R15,R15 PR EJECT YREGS , EJECT IEANTASM LTORG IEANTDL DS F IEANTCR DS F LEVEL DC A(IEANT_SYSTEM_LEVEL) NAME DS CL16 TOKEN DS CL16 PERSOPT DC A(IEANT_PERSIST) RETCODE DS F ORG , DS 0F WTOA DC AL2(WTOAE-WTOA),AL2(0) WTOMSG DC C'TOKEN CREATION: ' WTONAME DS CL16 DC C'VALUE: ' WTOTOKEN DS CL16 WTOAE EQU * DS 0F TOKIN DCB DSORG=PS,RECFM=FB,LRECL=80, X MACRF=GL,DDNAME=TOKIN, X EODAD=EXIT END ,