*COPY ACCTON 00001000 **************************************************************** 00002000 * 00003000 * COPY FILE PROVIDED FOR INSTALLATION USE 00004000 * 00005000 **************************************************************** 00006000 USING RDEVBLOK,R8 00007000 L R8,VMTERM GET RDEVBLOK ADDRESS 00008000 LTR R8,R8 IS THERE ONE ?? 00009000 BZ ACOEXIT NO, RETURN 00010000 CLI RDEVTYPC,CLASTERM TERMINAL? @VA04377 00010060 BNE LOCGRAF NO, CONTINUE @VA04377 00010120 CLI RDEVTYPE,TYPBSC BSC? @VA04377 00010180 BNE LOCGRAF NO, CONTINUE @VA04377 00010240 LH R9,VMTRMID GET RESOURCE ID OF USER @VA04377 00010300 N R9,F4095 CLEAR LINE CODE PORTION @VA04377 00010360 MH R9,=AL2(NICSIZE*8) COMPUTE NICBLOK LIST INDEX @VA04377 00010420 AL R9,RDEVNICL INDEX TO ACTUAL NICBLOK @VA04377 00010480 USING NICBLOK,R9 @VA04377 00010540 TM NICTYPE,NICOPRDR OPERATOR ID CARD? @VA04377 00010600 DROP R9 @VA04377 00010660 BO DISPMSG YES, PUT OUT MSG @VA04377 00010720 B ACOEXIT NO,RETURN @VA04377 00010780 LOCGRAF EQU * @VA04377 00010840 CLI RDEVTYPC,CLASGRAF IS IT A GRAF DEVICE ?? 00011000 BNE ACOEXIT NO, RETURN 00012000 CLI RDEVTYPE,TYP3277 IS IT A 3270 ?? 00013000 BNE ACOEXIT NO, RETURN 00014000 TM RDEVFTR,FTROPRDR DOES IT HAVE A READER ?? 00015000 BZ ACOEXIT NO, RETURN 00016000 DISPMSG EQU * @VA04377 00016500 LA R0,ACOACCL ACCES MSG SIZE 00017000 LA R1,ACOACCM ACCESS MESSAGE 00018000 CALL DMKQCNWT,PARM=NORET+ALARM 00019000 LA R0,18 GET BUFFER FOR DATA 00020000 CALL DMKFREE GET A BUFFER 00021000 XC 0(18*8,R1),0(R1) CLEAR BUFFER 00022000 CALL DMKQCNRD,PARM=INHIBIT NO EDIT, NO DISPLAY 00023000 LTR R2,R2 IS IT ZERO ?? 00024000 BNZ ACORETN NO, EXIT WITH ERROR 00025000 LTR R0,R0 ANY DATA ENTERED ?? 00026000 BP ACOCHK CHECK DATA ENTERED 00027000 LA R2,4 SET RETURN CODE 4 00028000 ACORETN ST R2,SAVER2 SET RETURN CODE 00029000 LA R0,18 SIZE 00030000 CALL DMKFRET RELEASE BUFFER 00031000 ACOEXIT EXIT RETURN TO CALLER 00032000 SPACE 00033000 ACOCHK SR R2,R2 ZERO RETURN 00034000 * FURTHER CHECKING CAN BE ADDED HERE TO VERIFY DATA 00035000 B ACORETN RETURN TO CALLER 00036000 SPACE 00037000 ACOACCM DC C'INSERT ID CARD:' 00038000 ACOACCL EQU *-ACOACCM 00039000 USING VDEVBLOK,R8 00040000