/* ADMPRINT REQUEST QUEUE EDIT/LIST PROGRAM */ 00010000 /*(CHECK): 00020000 (STRG,STRZ,SUBRG):*/ 00030000 AMDEDIT: PROC(PARM) OPTIONS(MAIN) ; 00040000 /* */ 00050000 /* WRITTEN BY : SAM J. BASS */ 00060000 /* OCCIDENTAL SYSTEMS INC. */ 00070000 /* 5 GREENWAY PLAZA EAST */ 00080000 /* HOUSTON, TEXAS 77046 */ 00090000 /* (713) 840-2178 */ 00100000 /* */ 00110000 /* DISCLAMER: THIS PROGRAM HAS BEEN FULLY */ 00120000 /* TESTED AT OSI, BUT I CLAIM NO */ 00130000 /* INTEGRITY OF THE ADMPRINT */ 00140000 /* REQUEST QUEUE AFTER EDITING */ 00150000 /* IT WITH THIS PROGRAM. */ 00160000 /* */ 00170000 /* NOTE 1: EVEN THOUGH A ENQ/DEQ HAS BEEN */ 00180000 /* USED IN EDIT MODE, IT MODE */ 00190000 /* THE QAB-0 FREE PQE POINTER CAN */ 00200000 /* BE 0,0 IF YOU INITIALIZE OR */ 00210000 /* RESET A PRINTER WHEN ADMPRINT */ 00220000 /* BACKGROUND PROCESSOR IS USING THE */ 00230000 /* PRINTER AND IS WAITING ON THE */ 00240000 /* ENQ TO PUT THE PQE BACK ON THE */ 00250000 /* FREE CHAIN. */ 00260000 /* */ 00270000 /* NOTE 2: TO BE SURE THAT NOTE 1 NEVER */ 00280000 /* OCCURS: */ 00290000 /* 1. STOP THE ADMPRINT BACKGROUND */ 00300000 /* PROCESSOR. */ 00310000 /* 2. ALLOC THE ADMPRINT REQUEST */ 00320000 /* QUEUE DSN EXCLUSIVE TO YOUR */ 00330000 /* SESSION. */ 00340000 /* */ 00350000 /* */ 00360000 1/* FILES : ADMPRINT ADMPRINT.REQUEST.QUEUE */ 00370000 /* SYSIN INPUT FOR COMMANDS */ 00380000 /* SYSPRINT OUTPUT LISTINGS */ 00390000 /* */ 00400000 /* EXTERNAL : ENQ/DEQ ENQ/DEQ PROGRAM TO ENQ/DEQ */ 00410000 /* ON ADMPRINT.REQUEST.QUEUE */ 00420000 /* ONLY IN EDIT MODE */ 00430000 /* */ 00440000 /* ERASE 3270 FULLSCREEN CLEAR */ 00450000 /* ERASE IS FETCHED */ 00460000 /* IS NO PROGRAM AVAILABLE THEN */ 00470000 /* LINK/ALIAS IEFBR14 AS ERASE */ 00480000 /* */ 00490000 /* PARM: = 'EDIT' IF EDITING FUNCTIONS ARE */ 00500000 /* TO BE INVOLKED. */ 00510000 /* */ 00520000 /* PARM:^= 'EDIT' ONLY LISTING FUNCTIONS CAN */ 00530000 /* BE INVOLKED. */ 00540000 /* */ 00550000 1/* COMMANDS */ 00560000 /* */ 00570000 /* SYNTAX: CMD PTR-NAME */ 00580000 /* */ 00590000 /* COL(1) - CMD = 3 CHAR. COMMAND */ 00600000 /* OPTIONAL COL(4) - PTR-NAME = PRINTER NAME / * */ 00610000 /* * MEANS USE LAST USED PRINTER */ 00620000 /* NAME */ 00630000 /* USED ON COMMANDS(DIS,CHG,RES,ADD) */ 00640000 /* */ 00650000 /* */ 00660000 /* CMD(LIST): PTR DISPLAY ALL PRINTER NAMES */ 00670000 /* DIS DISPLAY INFO FOR A PRINTER */ 00680000 /* ALL DISPLAY INTO FOR ALL PRINTERS */ 00690000 /* QAB DISPLAY QAB-0 INFO */ 00700000 /* PQE DISPLAY PQE ; WILL ASK FOR */ 00710000 /* REL-BLOCK, REL-OFFSET */ 00720000 /* RUN RUN A QUE CHAIN ;WILL ASK FOR */ 00730000 /* REL-BLOCK, REL-OFFSET, AND #RUN */ 00740000 /* HELP HELP COMMAND */ 00750000 /* */ 00760000 /* CMD(EDIT): CHG CHANGE CHAR. OF A PRINTER */ 00770000 /* RES RESET A PRINTER; WILL PUT ALL */ 00780000 /* PQE BACK ON FREE CHAIN */ 00790000 /* INT RESETS ALL PRINTERS AND */ 00800000 /* RECHAINS ALL PQE*S */ 00810000 /* ADD ADD A NEW PRINTER IN QAB RECORD */ 00820000 /* AND INPUT CHARACTERISTICS. */ 00830000 /* QABPTRNM(N) < ' ' MUST */ 00840000 /* BE FOUND TO ADD A PRINTER */ 00850000 /* QAB DISPLAY AND CHANGE QAB-0 INFO */ 00860000 /* */ 00870000 /* NOTE: ALL LIST COMMANDS ARE AVAILABLE UNDER EDIT */ 00880000 /* */ 00890000 /* DECLARES TAKEN FROM THE PLS LISTINGS FOR ADMPRINT */ 00900000 /* */ 00910000 1DECLARE /* */ 00920000 1 PQE /*CHARACTER(80)*/ /* PRINTER QUEUE ELEMENT: */ 00930000 /* */ 00940000 BASED(PQE@), /* */ 00950000 2 PQENEXTA /*CHARACTER(4)*/ /* QUEUE-ADDRESS OF NEXT PQE IN */ 00960000 , /* THE QUEUE(0 IF END OF QUEUE): */ 00970000 3 PQENEXTB FIXED BIN(15), /* RELATIVE BLOCK ADDRESS. */ 00980000 3 PQENEXTO FIXED BIN(15), /* OFFSET WITHIN BLOCK. */ 00990000 2 PQEID /*CHARACTER(60)*/ /* PQE OWNERSHIP: */ 01000000 , /* NON-HEX 00'S: PRINT REQUEST.*/ 01010000 /* HEX 00'S: FREE PQE. */ 01020000 3 PQEDSN CHARACTER(44) /* PRINT REQUEST DSN. */ 01030000 , /* */ 01040000 3 PQEMEMBR CHARACTER(8) /* PDS MEMBER NAME, IF ANY (HEX */ 01050000 , /* ZEROS IF NOT PDS). */ 01060000 3 PQEPASSW /*CHARACTER(8)*/ /* PASSWORD, IF ANY (HEX ZEROS */ 01070000 , /* IF NOT PASSWORD PROTECTED). */ 01080000 4 PQEREQ# FIXED BIN(15), /* REQUEST NO. FOR INTERIM DATA */ 01090000 4 PQE$01 CHARACTER(6), /* SETS. */ 01100000 2 PQEDTTIM /*CHARACTER(8)*/ /* "TIME" MACRO DATE AND TIME: */ 01110000 , /* */ 01120000 3 PQEDATE FIXED BIN(31), /* JULIAN REQUEST DATE(DECIMAL). */ 01130000 3 PQETIME FIXED BIN(31), /* TIME OF REQUEST (DECIMAL). */ 01140000 2 PQETSOID CHARACTER(7), /* REQUESTING TSO USER'S ID. */ 01150000 2 PQEFLAGS /*BIT(8)*/, /* PQE FLAGS: */ 01160000 3 PQE$02 BIT(6), /* RESERVED (PQEFRSVD). */ 01170000 3 PQEDSTYP BIT(1), /* PRINT DATA SET TYPE: */ 01180000 /* 0: INTERIM. */ 01190000 /* 1: USER. */ 01200000 3 PQEDSDSP BIT(1); /* PRINT DATA SET DISPOSITION */ 01210000 /* UPON SUCCESSFUL PRINT */ 01220000 /* COMPLETION: 0: DELETE. */ 01230000 /* 1: KEEP. */ 01240000 1DECLARE /* */ 01250000 1 QAB BASED(QAB@) /* QUEUE ANCHOR BLOCK. */ 01260000 , /* */ 01270000 2 QABFLAGS /*BIT(8)*/, /* QUEUE CONTROL FLAGS. */ 01280000 3 QABLAST BIT(1), /* 1 = LAST QAB. */ 01290000 3 QAB$01 BIT(7), /* RESERVED (QABFRSVD). */ 01300000 2 QABTIME /*F*/ BIT(8), /* BACKGROUND PROBE TIME */ 01310000 /* INTERVAL IN DECASECONDS */ 01320000 /* (QABTIME OF 1 = 10 SECONDS). */ 01330000 2 QABFFEAD /*CHARACTER(4)*/ /* 1ST FREE ELEM. QUEUE-ADDRESS: */ 01340000 , /* */ 01350000 3 QABFFERB FIXED BIN(15), /* RELATIVE BLOCK ADDRESS. */ 01360000 3 QABFFEOF FIXED BIN(15), /* OFFSET WITHIN BLOCK. */ 01370000 2 QABNREQ# FIXED BIN(15) /* NEXT REQUEST NUMBER TO BE */ 01380000 , /* ASSIGNED. */ 01390000 2 QABPTRQL(103) /* PRINTER REQUEST QUEUE ANCHORS:*/ 01400000 , /* */ 01410000 3 QABPTRQA /*CHARACTER(24)*/ /* ANCHOR FORMAT: */ 01420000 , /* */ 01430000 4 QABPTRNM CHARACTER(8) /* PRINTER NAME AS DEFINED IN THE*/ 01440000 , /* VTAM RESOURCE DEF. TABLE. */ 01450000 4 QABORQEA /*CHARACTER(4)*/ /* OLDEST REQUEST PQE QUEUE-ADDR */ 01460000 , /* FOR GIVEN PRINTER (0 IF NONE):*/ 01470000 5 QABORQEB FIXED BIN(15), /* RELATIVE BLOCK ADDRESS. */ 01480000 5 QABORQEO FIXED BIN(15), /* OFFSET WITHIN BLOCK. */ 01490000 4 QABLRQEA /*CHARACTER(4)*/ /* LATEST REQUEST PQE QUEUE-ADDR */ 01500000 , /* FOR GIVEN PRINTER (0 IF NONE):*/ 01510000 5 QABLRQEB FIXED BIN(15), /* RELATIVE BLOCK ADDRESS. */ 01520000 5 QABLRQEO FIXED BIN(15), /* OFFSET WITHIN BLOCK. */ 01530000 4 QABPBFSZ FIXED BIN(15) , /* PRINTER HARDWARE BUFFER SIZE */ 01540000 /* (FOR 328X PRINTER). */ 01550000 /* 5 QAB$02 BIT(8), */ /* FOR 3790 BATCH LU: */ 01560000 /* 5 QABPGRP# BIT(8), */ /* "PRINT GROUP NUMBER". */ 01570000 4 QABPWIDE /*F*/ BIT(8), /* MAX./DEFAULT PAGE WIDTH SPEC. */ 01580000 4 QABPLEN /*F*/ BIT(8), /* DEFAULT # LINES TO FIT ON PGE.*/ 01590000 4 QABTMARG /*F*/ BIT(8), /* DEFAULT # LINES FOR TOP MARG. */ 01600000 4 QABBMARG /*F*/ BIT(8), /* DEFAULT # LINES FOR BOT. MARG.*/ 01610000 4 QABHPP /*F*/ BIT(8), /* NO. HARDWARE PRT. POS./LINE. */ 01620000 4 QABTYPE /*F*/ BIT(8); /* PRINTER TYPE: */ 01630000 /* 1: 3284 PRINTER, */ 01640000 /* 3286 PRINTER, OR */ 01650000 /* 3288 PRINTER, NO VFC USE. */ 01660000 /* 2: 3288 PRINTER WITH VFC USE. */ 01670000 /* 3: 3790 BATCH FUNCTION LINE */ 01680000 /* PRINTER. */ 01690000 1 DCL ADMPRINT FILE RECORD KEYED 01700000 ENV(REGIONAL(1)); 01710000 DCL SYSPRINT FILE STREAM PRINT; 01720000 DCL SYSIN FILE STREAM INPUT; 01730000 01740000 /* CALL ENQ(MAJOR,MINOR, LMINOR,ETYPE,RC) */ 01750000 01760000 DCL ENQ EXT OPTIONS(ASM INTER) 01770000 ENTRY(CHAR(8),CHAR(255), 01780000 FIXED BIN(31), 01790000 FIXED BIN(31),FIXED BIN(31) ); 01800000 01810000 /* CALL DEQ(MAJOR,MINOR, LMINOR,RC) */ 01820000 01830000 DCL DEQ EXT OPTIONS(ASM INTER) 01840000 ENTRY(CHAR(8),CHAR(255), 01850000 FIXED BIN(31), 01860000 FIXED BIN(31)); 01870000 DCL MAJOR CHAR(8) INIT('ADMPRNTQ'); 01880000 DCL MINOR CHAR(255) INIT(' '); 01890000 DCL LMINOR FIXED BIN(31) INIT(0); 01900000 DCL ETYPE FIXED BIN(31) INIT(1); 01910000 DCL RC FIXED BIN(31) INIT(0); 01920000 01930000 DCL VMINOR CHAR(255) VAR INIT( 01940000 'IN PROCESS OF BEING UPDATED.'); 01950000 DCL (ADDR,SUBSTR,UNSPEC, BOOL,LOW, 01960000 LENGTH,REPEAT,MOD,DIM,ONKEY) 01970000 BUILTIN; 01980000 DCL LISTOPT(8) CHAR(3) INIT( 01990000 'ALL' ,'DIS' ,'HEL' ,'PQE' ,'PTR' , 02000000 'QAB' ,'QUE' ,'RUN' ); 02010000 DCL LISTPRC(8) INT ENTRY VARIABLE INIT( 02020000 $ALL , $DIS , $HEL , $PQE , $PTR , 02030000 $QAB , $QUE , $RUN ); 02040000 DCL EDITOPT(5) CHAR(3) INIT( 02050000 'ADD','CHG','INT','QAB','RES'); 02060000 DCL EDITPRC(5) INT ENTRY VARIABLE INIT( 02070000 $ADD ,$CHG ,$INT ,$QAB ,$RES ); 02080000 DCL ERASE EXT ENTRY; 02090000 1 DCL EOF1 BIT(1) INIT('0'B); 02100000 DCL #UPDATE BIT(1) INIT('0'B); 02110000 DCL #EDIT BIT(1) INIT('0'B); 02120000 DCL #ENQ BIT(1) INIT('0'B); 02130000 DCL TRUE BIT(1) INIT('1'B); 02140000 DCL (PQE@,QAB@,PTR@) PTR; 02150000 DCL PARM CHAR(100) VAR; 02160000 DCL ANS CHAR(1) INIT(' '); 02170000 DCL OPTION CHAR(3) INIT(' '); 02180000 DCL CARDIN CHAR(80) INIT(' '); 02190000 DCL BUF2480(20) CHAR(2480) INIT(' '); 02200000 DCL BUFFER(20*31) CHAR(80) DEF(BUF2480) POS(1); 02210000 DCL BLANK8 CHAR(8) INIT(' '); 02220000 DCL (IQAB,IBUF,MACREC) FIXED BIN(15) INIT(0); 02230000 DCL (MAXQAB) FIXED BIN(15) INIT(103); 02240000 DCL IPQE FIXED BIN(15) INIT(0); 02250000 DCL I FIXED BIN(15) INIT(0); 02260000 DCL (PBFSZ) FIXED BIN(15) INIT(0); 02270000 DCL (ORQEB,ORQEO) FIXED BIN(15) INIT(0); 02280000 DCL (LRQEB,LRQEO) FIXED BIN(15) INIT(0); 02290000 DCL (PWIDE,PLEN,TMARG,BMARG,HPP,TYPE) 02300000 FIXED BIN(15) INIT(0); 02310000 DCL (TIME,FFERB,FFEOF,NREQ#) 02320000 FIXED BIN(15) INIT(0); 02330000 DCL (PNAME,PTRNM,PNAMM) CHAR(8) INIT(' '); 02340000 DCL (PRINTER) CHAR(8) INIT(' '); 02350000 DCL NOPTR COND; 02360000 02370000 1 ON COND(NOPTR) 02380000 BEGIN; 02390000 GO TO GETCARD; 02400000 END; 02410000 02420000 ON ENDFILE(ADMPRINT) 02430000 BEGIN; 02440000 EOF1 = TRUE; 02450000 END; 02460000 02470000 ON ENDFILE(SYSIN) 02480000 BEGIN; 02490000 GO TO $END; 02500000 END; 02510000 02520000 ON ERROR 02530000 BEGIN; 02540000 GO TO $END; 02550000 END; 02560000 02570000 ON KEY(ADMPRINT) 02580000 BEGIN; 02590000 PUT EDIT(' NUMBER OF RECORDS = '||ONKEY) 02600000 (COL(1),A); 02610000 MAXREC = IBUF-1; 02620000 EOF1 = TRUE; 02630000 END; 02640000 02650000 OPEN FILE(SYSPRINT) LINESIZE(80), 02660000 FILE(SYSIN); 02670000 OPEN FILE(ADMPRINT) DIRECT UPDATE; 02680000 02690000 IF PARM = 'EDIT' THEN 02700000 #EDIT = TRUE; 02710000 ELSE 02720000 #EDIT = ^TRUE; 02730000 #ENQ = ^TRUE; 02740000 #UPDATE = ^TRUE; 02750000 EOF1 = ^TRUE; 02760000 IBUF = 0; 02770000 MAXREC = 9999; 02780000 02790000 FETCH ERASE; 02800000 CALL ERASE; 02810000 PUT EDIT('>>> *** ADMPRINT EDIT/LIST PROGRAM *** <<<') 02820000 (COL(1),A); 02830000 PUT EDIT('>>> *** VERSION 2.0/SJB O. S. I. *** <<<') 02840000 (COL(1),A); 02850000 CALL READALL; 02860000 02870000 GETCARD: PUT EDIT(' ENTER OPTION:') (COL(1),A); 02880000 CARDIN = ' '; 02890000 GET EDIT(CARDIN) (COL(1),A(40)); 02900000 CALL UPCASE(ADDR(CARDIN),40); 02910000 GET STRING(CARDIN) EDIT(OPTION) (A(3)); 02920000 IF SUBSTR(CARDIN,1,1) < 'A' THEN 02930000 GO TO GETCARD; 02940000 IF OPTION = 'END' THEN 02950000 GO TO $END; 02960000 #UPDATE = ^TRUE; 02970000 /* IF EDIT THEN CHECK EDIT CMDS */ 02980000 IF #EDIT THEN 02990000 DO I = 1 TO DIM(EDITOPT,1); 03000000 IF OPTION = EDITOPT(I) THEN 03010000 DO; 03020000 #UPDATE = TRUE; 03030000 CALL READALL; 03040000 CALL EDITPRC(I); 03050000 CALL REWRITE; 03060000 GO TO GETCARD; 03070000 END; 03080000 ELSE; 03090000 END; 03100000 ELSE; /* SEE IF IT IS A LIST CMD */ 03110000 DO I = 1 TO DIM(LISTOPT,1); 03120000 IF OPTION = LISTOPT(I) THEN 03130000 DO; 03140000 #UPDATE = ^TRUE; 03150000 CALL READALL; 03160000 CALL LISTPRC(I); 03170000 GO TO GETCARD; 03180000 END; 03190000 ELSE; 03200000 END; 03210000 OPTERR: PUT EDIT(' ILLEGAL OPTION / REENTER:') (COL(1),A); 03220000 GO TO GETCARD; 03230000 03240000 1$ADD: PROC REORDER; 03250000 PNAMM = SUBSTR(CARDIN,5,8); 03260000 CALL PTRGETN ; 03270000 DO IQAB = 1 TO MAXQAB; 03280000 IF QABPTRNM(IQAB) < BLANK8 THEN 03290000 DO; 03300000 PTRNM = PNAME; 03310000 ORQEB,ORQEO,LRQEB,LRQEO = 0; 03320000 PBFSZ = 1024; 03330000 PWIDE = 132; 03340000 PLEN = 66; 03350000 TMARG = 2; 03360000 BMARG = 2; 03370000 HPP = PWIDE; 03380000 TYPE = 6; 03390000 CALL QVARPUT ; 03400000 CALL ERASE; 03410000 CALL PTRDIS ; 03420000 CALL PTRCHG ; 03430000 RETURN; 03440000 END; 03450000 END; 03460000 PUT EDIT(' *** NO PRINTER SLOTS LEFT ***') 03470000 (COL(1),A); 03480000 END $ADD; 03490000 03500000 1$ALL: PROC REORDER; 03510000 CALL ERASE; 03520000 CALL $QAB ; 03530000 DO IQAB = 1 TO MAXQAB; 03540000 IF QABPTRNM(IQAB) < BLANK8 THEN LEAVE; 03550000 SUBSTR(CARDIN,5,8) = QABPTRNM(IQAB); 03560000 PUT EDIT(REPEAT('-',60)) (COL(1),A); 03570000 CALL PTRDIS ; 03580000 END; 03590000 END $ALL; 03600000 03610000 1$CHG: PROC REORDER; 03620000 CALL PTRGETN ; 03630000 CALL PTRFIND ; 03640000 CALL ERASE; 03650000 CALL PTRDIS ; 03660000 CALL PTRCHG ; 03670000 END $CHG; 03680000 03690000 1$DIS: PROC REORDER; 03700000 CALL PTRGETN ; 03710000 CALL PTRFIND ; 03720000 CALL ERASE; 03730000 CALL PTRDIS ; 03740000 END $DIS; 03750000 03760000 1$HEL: PROC REORDER; 03770000 CALL ERASE; 03780000 PUT EDIT(' THE FOLLOWING COMMANDS ARE AVAILABLE: ', 03790000 ' *** LIST COMMANDS ***', 03800000 'ALL DISPLAY INFO. ON ALL PRINTERS', 03810000 'DIS PRINTER/* DISPLAY INFO. ON A PRINTER', 03820000 'QUE DISPLAY INFO. ON PRINTERS WITH QUEUES', 03830000 'PTR DISPLAY THE LIST OF PRINTERS AVAILABLE', 03840000 'HELP HELP FOR COMMANDS', 03850000 'END TO END THE PROGRAM') 03860000 (COL(1),A); 03870000 IF #EDIT THEN 03880000 PUT EDIT( 03890000 ' *** EDIT COMMANDS ***', 03900000 'PQE DISPLAY A PQE', 03910000 'QAB DISPLAY A QAB', 03920000 'RUN RUN A PQE CHAIN', 03930000 'ADD PRINTER/* ADD A PRINTER', 03940000 'CHG PRINTER/* CHANGE A PRINTER CHARACTERISTICS', 03950000 'RES PRINTER/* TO RESET A PRINTER TO NO DSN*S TO PRINT', 03960000 'INT INITIALIZE ALL PRINTERS TO NO DSN*S') 03970000 (COL(1),A); 03980000 END $HEL; 03990000 04000000 1$INT: PROC REORDER; 04010000 DCL IPQE FIXED BIN(15) INIT(0); 04020000 DCL LPQE FIXED BIN(15) INIT(0); 04030000 DCL (I,J) FIXED BIN(15) INIT(0); 04040000 04050000 CALL ERASE; 04060000 04070000 IF #ENQ THEN 04080000 PUT EDIT(' *** ENQ FINISHED ***') 04090000 (COL(1),A); 04100000 IF ^YESNO(' DO YOU WANT TO INIT ALL PRINTERS') THEN 04110000 RETURN; 04120000 04130000 $INT1: 04140000 /* PUT EDIT(' HOW MANY PQE RECORDS DO YOU WANT 1-9 :') 04150000 (COL(1),A); 04160000 GET EDIT(ANS) (COL(1),A(1)); 04170000 IF ANS >= '1' & ANS <= '9' THEN 04180000 GET STRING(ANS) EDIT(I) (F(1)); 04190000 ELSE 04200000 GOTO $INT1; 04210000 IBUF = I+1; 04220000 */ DO IQAB = 1 TO MAXQAB; 04230000 IF QABPTRNM(IQAB) < BLANK8 THEN LEAVE; 04240000 PUT EDIT(' RESETING PRINTER = ',QABPTRNM(IQAB)) 04250000 (COL(1),A,A); 04260000 /* SET PRINTER OLDEST PQE @ = 0 */ 04270000 QABORQEB(IQAB),QABORQEO(IQAB) = 0; 04280000 /* SET PRINTER LATEST PQE @ = 0 */ 04290000 QABLRQEB(IQAB),QABLRQEO(IQAB) = 0; 04300000 END; 04310000 I = 1; /* BLOCK # */ 04320000 J = 0; /* OFFSET */ 04330000 DO WHILE(I <= IBUF-1); 04340000 CALL PQEGET(I,J,IPQE); 04350000 CALL PQEZERO(IPQE); 04360000 PQE@ = ADDR(BUFFER(IPQE)) ; 04370000 J = J+80; 04380000 IF J >= 31*80 THEN 04390000 DO; 04400000 PUT EDIT(' RESET DONE FOR PQE RECORD # ',I) 04410000 (COL(1),A,F(2)); 04420000 J = 0; 04430000 I = I+1; 04440000 END; 04450000 ELSE; 04460000 PQENEXTB = I; 04470000 PQENEXTO = J; 04480000 END; 04490000 04500000 PQENEXTB = 0; /* SET LAST = 0 */ 04510000 PQENEXTO = 0; /* SET LAST = 0 */ 04520000 04530000 QABFFERB = 1; 04540000 QABFFEOF = 0; 04550000 QABNREQ# = 0; 04560000 04570000 END $INT; 04580000 04590000 1$PQE : PROC REORDER; 04600000 DCL (IBLK,IOFF,IPQE) FIXED BIN(15) INIT(0); 04610000 ON ERROR 04620000 BEGIN; 04630000 GO TO $PQE1; 04640000 END; 04650000 04660000 $PQE1: PUT EDIT(' ENTER PQE ADDR IN "RELBLK,OFFSET"') 04670000 (COL(1),A); 04680000 PUT EDIT(' 0,0 TO END') 04690000 (A); 04700000 GET LIST(IBLK,IOFF); 04710000 IF IBLK = 0 THEN RETURN; 04720000 CALL PQEGET(IBLK,IOFF,IPQE); 04730000 PUT SKIP DATA(IPQE); 04740000 PQE@ = ADDR(BUFFER(IPQE)); 04750000 PUT SKIP DATA(PQE); 04760000 GO TO $PQE1; 04770000 END $PQE; 04780000 04790000 1$PTR: PROC REORDER; 04800000 CALL ERASE; 04810000 PUT EDIT(( ' PTR(',IQAB,')=',QABPTRNM(IQAB) 04820000 DO IQAB = 1 TO MAXQAB 04830000 WHILE(QABPTRNM(IQAB) > BLANK8) )) 04840000 (COL(1),(4)(A,F(3),A,A)); 04850000 END $PTR; 04860000 04870000 1$QAB : PROC REORDER; 04880000 04890000 CALL QAB0GET; 04900000 04910000 PUT SKIP DATA(TIME,FFERB); 04920000 PUT SKIP DATA(FFEOF,NREQ#); 04930000 04940000 IF OPTION ^= 'QAB' THEN RETURN; 04950000 IF #UPDATE = ^TRUE THEN 04960000 RETURN; 04970000 IF ^YESNO(' DO YOU WISH TO CHANGE ANY VALUES') THEN 04980000 RETURN; 04990000 PUT EDIT(' ENTER CHANGES FOR:') 05000000 (COL(1),A); 05010000 PUT EDIT(' TIME,FFERB,FFEOF,NREQ#') 05020000 (COL(1),A); 05030000 05040000 TIME,FFERB,FFEOF,NREQ#=-1; 05050000 GET SKIP DATA(TIME,FFERB ,FFEOF,NREQ#); 05060000 05070000 CALL QAB0PUT; 05080000 05090000 CALL QAB0GET; 05100000 05110000 PUT SKIP DATA(TIME,FFERB); 05120000 PUT SKIP DATA(FFEOF,NREQ#); 05130000 05140000 END $QAB; 05150000 05160000 1$QUE: PROC REORDER; 05170000 CALL ERASE; 05180000 PUT EDIT('*** THESE PRINTERS HAVE QUEUED DATASETS ***') 05190000 (COL(1),A); 05200000 $QUE2: DO IQAB = 1 TO MAXQAB; 05210000 CALL QVARGET ; 05220000 IF QABPTRNM(IQAB) < BLANK8 THEN LEAVE $QUE2; 05230000 IF ^(ORQEB = 0 & 05240000 ORQEO = 0 & 05250000 LRQEB = 0 & 05260000 LRQEO = 0 ) THEN 05270000 DO; 05280000 SUBSTR(CARDIN,5,8) = QABPTRNM(IQAB); 05290000 PUT EDIT(REPEAT('-',60)) (COL(1),A); 05300000 CALL PTRDIS ; 05310000 END; 05320000 ELSE; 05330000 END; 05340000 END $QUE; 05350000 05360000 1$RES: PROC REORDER; 05370000 DCL IPQE FIXED BIN(15) INIT(0); 05380000 DCL LPQE FIXED BIN(15) INIT(0); 05390000 DCL I FIXED BIN(15) INIT(0); 05400000 CALL ERASE; 05410000 CALL PTRGETN ; 05420000 CALL PTRFIND ; 05430000 CALL PTRDIS ; 05440000 IF ^YESNO(' IS THIS THE CORRECT PRINTER TO RESET') THEN 05450000 RETURN; 05460000 05470000 CALL PQEGET(ORQEB,ORQEO,IPQE); 05480000 IF IPQE = 0 THEN RETURN; /*THEN NOTHING CHAINED */ 05490000 05500000 DO UNTIL(IPQE = 0); 05510000 PQE@ = ADDR(BUFFER(IPQE)); 05520000 LPQE = IPQE; 05530000 CALL PQEZERO(IPQE); 05540000 CALL PQEGET(PQENEXTB,PQENEXTO,IPQE); 05550000 END; 05560000 05570000 /* RECHAIN THIS PRINTERS PQE IN FRONT OF QAB ANCHOR */ 05580000 05590000 IPQE = LPQE; 05600000 PQE@ = ADDR(BUFFER(IPQE)); 05610000 05620000 /*PUT FREE QUE ON END OF PQE CHAIN */ 05630000 05640000 PQENEXTB = QABFFERB; 05650000 PQENEXTO = QABFFEOF; 05660000 05670000 /*PUT START OF PQE CHAIN AS FIRST FREE ELEMENT*/ 05680000 05690000 QABFFERB = QABORQEB(IQAB); 05700000 QABFFEOF = QABORQEO(IQAB); 05710000 05720000 /* SET PRINTER QAB QUEUE -ADDR = 0 */ 05730000 05740000 QABORQEB(IQAB)= 0; 05750000 QABORQEO(IQAB) = 0; 05760000 QABLRQEB(IQAB) = 0; 05770000 QABLRQEO(IQAB) = 0; 05780000 05790000 CALL ERASE; 05800000 CALL PTRDIS ; 05810000 END $RES; 05820000 05830000 05840000 1$RUN : PROC REORDER; 05850000 DCL (IBLK,IOFF) FIXED BIN(15) INIT(0); 05860000 DCL IPQE FIXED BIN(15) INIT(0); 05870000 DCL (IRUN,I) FIXED BIN(15) INIT(0); 05880000 05890000 ON ERROR 05900000 BEGIN; 05910000 GO TO $RUN1; 05920000 END; 05930000 05940000 $RUN1: PUT EDIT(' ENTER PQE ADDR IN "RELBLK,OFFSET"') 05950000 (COL(1),A); 05960000 GET LIST(IBLK,IOFF); 05970000 IF IBLK = 0 THEN RETURN; 05980000 PUT EDIT(' ENTER NUMBER OF PQE*S TO RUN"') 05990000 (COL(1),A); 06000000 GET LIST(IRUN); 06010000 CALL PQEGET(IBLK,IOFF,IPQE); 06020000 DO I = 1 TO IRUN WHILE(IPQE ^=0); 06030000 PUT EDIT(' -------------------------------------') 06040000 (COL(1),A); 06050000 PUT SKIP DATA(IPQE); 06060000 PQE@ = ADDR(BUFFER(IPQE)); 06070000 PUT SKIP DATA(PQE); 06080000 IBLK = PQENEXTB; 06090000 IOFF = PQENEXTO; 06100000 CALL PQEGET(IBLK,IOFF,IPQE); 06110000 IF IPQE = 0 THEN LEAVE ; 06120000 END; 06130000 PUT EDIT(' *** END OF CHAIN ***') 06140000 (COL(1),A); 06150000 END $RUN; 06160000 06170000 1 /*--- START OF UTILITY ROUTINES ---*/ 06180000 06190000 1BIT8GET: PROC(BIT8,BIN15) REORDER; 06200000 DCL BIT8 BIT(8); 06210000 DCL BIN15 FIXED BIN(15); 06220000 DCL BINPTR PTR; 06230000 DCL 1 BIT8P UNALIGNED BASED(BINPTR), 06240000 2 RES BIT(8), 06250000 2 RES2 BIT(8); 06260000 BINPTR = ADDR(BIN15); 06270000 BIT8 = RES2; 06280000 END BIT8GET; 06290000 06300000 1CVARGET: PROC REORDER; 06310000 ON ERROR 06320000 BEGIN; 06330000 PUT EDIT(' ERROR ON INPUT, REENTER') (COL(1),A); 06340000 GO TO CVAR1; 06350000 END; 06360000 CVAR1: PBFSZ = -1; 06370000 PWIDE,PLEN,TMARG,BMARG,HPP,TYPE = -1; 06380000 ORQEO,ORQEB,LRQEO,LRQEB = -1; 06390000 PUT EDIT(' ENTER NEW VALUES FOR ONE OR MORE OF THE ', 06400000 ' FOLLOWING. SYNTAX:VAR = VALUE,...;') 06410000 (COL(1),A,A); 06420000 PUT EDIT(' PBFSZ,PWIDE,PLEN,TMARG,BMARG,HPP,TYPE,TIME') 06430000 (COL(1),A); 06440000 PUT EDIT(' AND PTRNM, SYNTAX: PTRNM = ''PRINTNAM'' ') 06450000 (COL(1),A); 06460000 PUT EDIT(' ENTER A ";" TO END INPUT') 06470000 (COL(1),A); 06480000 GET SKIP DATA( 06490000 PBFSZ,PWIDE,PLEN,TMARG,BMARG, 06500000 HPP,TYPE,PTRNM); 06510000 CALL UPCASE(ADDR(PTRNM),8); 06520000 CALL QVARPUT ; 06530000 END CVARGET; 06540000 06550000 1PQEGET: PROC(IBLK,IOFF,IPQE) REORDER; 06560000 DCL IPQE FIXED BIN(15); 06570000 DCL (IBLK,IOFF) FIXED BIN(15); 06580000 IF IBLK = 0 & IOFF = 0 THEN 06590000 DO; 06600000 IPQE = 0; 06610000 RETURN; 06620000 END; 06630000 IPQE = (IBLK-0)*31 + IOFF/80+1; 06640000 IF IPQE > IBUF*31 | IPQE < 32 THEN 06650000 DO; 06660000 PUT EDIT(' *** IPQE OUT OF RANGE *** ',IPQE) 06670000 (COL(1),A,F(8)); 06680000 PUT SKIP DATA(IBLK,IOFF,IBUF,IPQE); 06690000 IPQE = 0; 06700000 RETURN; 06710000 END; 06720000 PQE@ = ADDR(BUFFER(IPQE)); 06730000 END PQEGET; 06740000 06750000 1PQEZERO: PROC(IPQE) REORDER; 06760000 DCL IPQE FIXED BIN(15); 06770000 DCL PTR@ PTR; 06780000 DCL ZPQE CHAR(76) BASED(PTR@); 06790000 PQE@ = ADDR(BUFFER(IPQE)); 06800000 PTR@ = ADDR(PQEID); 06810000 ZPQE = LOW(76); 06820000 END PQEZERO; 06830000 06840000 PTRCHG: PROC REORDER; 06850000 PTRCHG1: CALL CVARGET ; 06860000 CALL ERASE; 06870000 CALL PTRDIS ; 06880000 IF YESNO(' ANY OTHER CHANGES') THEN 06890000 GO TO PTRCHG1; 06900000 END PTRCHG; 06910000 06920000 1PTRDIS : PROC REORDER; 06930000 CALL QVARGET ; 06940000 IF #ENQ THEN 06950000 PUT EDIT(' *** ENQ FINISHED ***') 06960000 (COL(1),A); 06970000 PUT EDIT(' VALUES FOR PRINTER(',PTRNM,') ARE ') 06980000 (COL(1),A,A,A); 06990000 PUT SKIP DATA(ORQEB,ORQEO); 07000000 PUT SKIP DATA(LRQEB,LRQEO); 07010000 PUT SKIP DATA(PBFSZ,PWIDE,PLEN); 07020000 PUT SKIP DATA(TMARG,BMARG); 07030000 PUT SKIP DATA(HPP,TYPE); 07040000 CALL PTRDSN ; 07050000 END PTRDIS; 07060000 07070000 1PTRDSN : PROC REORDER; 07080000 DCL (IJ,IPQE) FIXED BIN(15) INIT(0); 07090000 CALL QVARGET ; 07100000 CALL PQEGET(ORQEB,ORQEO,IPQE); 07110000 IF IPQE = 0 THEN 07120000 DO; 07130000 PUT EDIT(' *** NO DATASETS QUEUED ***') 07140000 (COL(1),A); 07150000 RETURN; 07160000 END; 07170000 IJ = 1; 07180000 07190000 PTRDSN1: 07200000 PQE@ = ADDR(BUFFER(IPQE)); 07210000 IF PQEDSTYP = '1'B THEN 07220000 PUT EDIT(' DIRECT ') (COL(1),A(8)); 07230000 ELSE 07240000 PUT EDIT(' #',PQEREQ#,' ') (COL(1),A(2),F(5),A); 07250000 07260000 PUT EDIT(PQETSOID,' - ',PQEDSN) 07270000 (A,A,A); 07280000 07290000 IF PQEMEMBR > BLANK8 THEN 07300000 PUT EDIT('(',PQEMEMBR, ')') (A,A,A); 07310000 07311001 DCL PJULDAT FIXED DEC(7); 07312001 DCL PTIME FIXED DEC(7); 07313001 UNSPEC(PJULDAT) = UNSPEC(PQEDATE); 07314001 UNSPEC(PTIME) = 07315001 '0000'B||SUBSTR(UNSPEC(PQETIME),1,24)||'1111'B; 07316001 PUT EDIT(' QUEUED ON',PJULDAT,PTIME) 07317001 (COL(1),A,P'ZZ99.999',P'Z99.99.99'); 07318001 07320000 CALL PQEGET(PQENEXTB,PQENEXTO,IPQE); 07330000 IF IPQE = 0 THEN RETURN; 07340000 IJ = IJ+1; 07350000 IF IJ > 60 THEN 07360000 DO; 07370000 PUT EDIT('*** PQE CHAIN ERROR ***') 07380000 (COL(1),A); 07390000 RETURN; 07400000 END; 07410000 GO TO PTRDSN1; 07420000 END PTRDSN; 07430000 07440000 1PTRFIND: PROC REORDER; 07450000 PTRFND1: 07460000 DO IQAB = 1 TO MAXQAB; 07470000 IF QABPTRNM(IQAB) = PNAME THEN 07480000 RETURN; 07490000 ELSE; 07500000 END; 07510000 SUBSTR(CARDIN,5,8) = BLANK8; 07520000 CALL $PTR; 07530000 PUT EDIT(' PRINTER(',PNAME,') NOT FOUND,', 07540000 'ENTER ONE OF THE ABOVE') 07550000 (COL(1),A,A,A,A); 07560000 CALL PTRGETN ; 07570000 IF PNAME = 'END' THEN SIGNAL COND(NOPTR); 07580000 GO TO PTRFND1; 07590000 END PTRFIND; 07600000 07610000 1PTRGETN: PROC REORDER; 07620000 PNAMM = SUBSTR(CARDIN,5,8); 07630000 IF PNAMM = BLANK8 THEN 07640000 DO; 07650000 PTRID: PUT EDIT(' ENTER PRINTER ID:') (COL(1),A); 07660000 GET EDIT(PNAME) (COL(1),A(8)); 07670000 CALL UPCASE(ADDR(PNAME),8); 07680000 IF SUBSTR(PNAME,1,1) < 'A' THEN 07690000 GOTO PTRID; 07700000 PNAMM = BLANK8; 07710000 END; 07720000 IF SUBSTR(PNAMM,1,1) ^= '*' & 07730000 PNAMM ^= BLANK8 THEN 07740000 PNAME = PNAMM; 07750000 PNAMM = BLANK8; 07760000 END PTRGETN; 07770000 07780000 1QAB0GET: PROC REORDER; 07790000 TIME = '00000000'B||UNSPEC(QABTIME); 07800000 FFERB = QABFFERB; 07810000 FFEOF = QABFFEOF; 07820000 NREQ# = QABNREQ#; 07830000 END QAB0GET; 07840000 07850000 QAB0PUT: PROC REORDER; 07860000 IF TIME > -1 THEN CALL BIT8GET(QABTIME,TIME); 07870000 IF FFERB > -1 THEN QABFFERB = FFERB; 07880000 IF FFEOF > -1 THEN QABFFEOF = FFEOF; 07890000 IF NREQ# > -1 THEN QABNREQ# = NREQ#; 07900000 END QAB0PUT; 07910000 07920000 1QVARGET: PROC REORDER; 07930000 ORQEB = QABORQEB(IQAB); 07940000 ORQEO = QABORQEO(IQAB); 07950000 LRQEB = QABLRQEB(IQAB); 07960000 LRQEO = QABLRQEO(IQAB); 07970000 PBFSZ = QABPBFSZ(IQAB); 07980000 PWIDE = '00000000'B||UNSPEC(QABPWIDE(IQAB)); 07990000 PLEN = '00000000'B||UNSPEC(QABPLEN(IQAB)) ; 08000000 TMARG = '00000000'B||UNSPEC(QABTMARG(IQAB)); 08010000 BMARG = '00000000'B||UNSPEC(QABBMARG(IQAB)); 08020000 HPP = '00000000'B||UNSPEC(QABHPP(IQAB)) ; 08030000 TYPE = '00000000'B||UNSPEC(QABTYPE(IQAB)) ; 08040000 PTRNM = QABPTRNM(IQAB); 08050000 END QVARGET; 08060000 08070000 1QVARPUT: PROC REORDER; 08080000 IF PWIDE > 132 THEN PWIDE = 132; 08090000 IF HPP > 132 THEN HPP = 132; 08100000 IF HPP = -1 THEN HPP = PWIDE; 08110000 IF PWIDE = -1 THEN PWIDE = HPP; 08120000 08130000 IF ORQEB > -1 THEN QABORQEB(IQAB) = ORQEB; 08140000 IF ORQEO > -1 THEN QABORQEO(IQAB) = ORQEO; 08150000 IF LRQEB > -1 THEN QABLRQEB(IQAB) = LRQEB; 08160000 IF LRQEO > -1 THEN QABLRQEO(IQAB) = LRQEO; 08170000 IF PBFSZ > -1 THEN QABPBFSZ(IQAB) = PBFSZ; 08180000 IF PWIDE > -1 THEN CALL BIT8GET(QABPWIDE(IQAB),PWIDE); 08190000 IF PLEN > -1 THEN CALL BIT8GET(QABPLEN(IQAB),PLEN); 08200000 IF TMARG > -1 THEN CALL BIT8GET(QABTMARG(IQAB),TMARG); 08210000 IF BMARG > -1 THEN CALL BIT8GET(QABBMARG(IQAB),BMARG); 08220000 IF HPP > -1 THEN CALL BIT8GET(QABHPP(IQAB),HPP); 08230000 IF TYPE > -1 THEN CALL BIT8GET(QABTYPE(IQAB),TYPE); 08240000 IF OPTION = 'CHG' | OPTION = 'ADD' THEN 08250000 IF PTRNM > BLANK8 THEN QABPTRNM(IQAB) = PTRNM; 08260000 SUBSTR(CARDIN,5,8) = QABPTRNM(IQAB); 08270000 END QVARPUT; 08280000 08290000 1READALL: PROC REORDER; 08300000 08310000 DCL IKEY PIC'9'; 08320000 IF ^#ENQ THEN /* IS ENQ ACTIVE */ 08330000 IF #UPDATE THEN /* NO, THEN IS IT UPDATE */ 08340000 DO; /* YES */ 08350000 MINOR = VMINOR; 08360000 LMINOR = LENGTH(VMINOR); 08370000 ETYPE = 1; /* EXCL */ 08380000 CALL ENQ(MAJOR,MINOR ,LMINOR,ETYPE,RC); 08390000 #ENQ = TRUE; /* SET ENQ ACTIVE */ 08400000 END; 08410000 ELSE; 08420000 ELSE; 08430000 IBUF = 0; 08440000 EOF1 = ^TRUE; 08450000 READ1: DO UNTIL(EOF1); 08460000 IBUF = IBUF+1; 08470000 IKEY = IBUF-1; 08480000 IF IBUF > MAXREC THEN 08490000 DO; 08500000 IBUF = IBUF-1; 08510000 LEAVE READ1; 08520000 END; 08530000 READ FILE(ADMPRINT) INTO(BUF2480(IBUF)) KEY(IKEY); 08540000 END; 08550000 QAB@ = ADDR(BUF2480(1)); 08560000 END READALL; 08570000 08580000 1REWRITE: PROC REORDER; 08590000 DCL I FIXED BIN(31) INIT(0); 08600000 DCL IKEY PIC'9'; 08610000 08620000 IF ^#UPDATE | ^#EDIT | ^#ENQ THEN 08630000 DO; 08640000 PUT EDIT('*** YOU CANNOT CHANGE VALUES IN LIST MODE ***') 08650000 (COL(1),A); 08660000 PUT SKIP DATA(#UPDATE,#EDIT,#ENQ); 08670000 RETURN; 08680000 END; 08690000 08700000 DO I = 1 TO IBUF; 08710000 IKEY = I-1; 08720000 WRITE FILE(ADMPRINT) FROM(BUF2480(I)) KEYFROM(IKEY); 08730000 END; 08740000 08750000 IF #ENQ THEN 08760000 DO; 08770000 CALL DEQ(MAJOR,MINOR,LMINOR,RC); 08780000 PUT EDIT(' *** DEQ FINISHED ***') 08790000 (COL(1),A); 08800000 #ENQ = ^TRUE; /* SET NO ENQ ACTIVE */ 08810000 END; 08820000 08830000 END REWRITE; 08840000 08850000 1UPCASE: PROC(RESPTR,J) REORDER; 08860000 DCL RESPTR PTR; 08870000 DCL REST(1024) CHAR(1) BASED(RESPTR); 08880000 DCL I FIXED BIN(31,0) INIT(0); 08890000 DCL J FIXED BIN(31,0); 08900000 DO I = 1 TO J; 08910000 IF UNSPEC(REST(I)) > '10000000'B 08920000 & UNSPEC(REST(I)) < '10111010'B THEN 08930000 UNSPEC(REST(I)) = BOOL(UNSPEC(REST(I)),'01000000'B,'0111'); 08940000 END; 08950000 08960000 END UPCASE; 08970000 08980000 1YESNO: PROC(MSG) REORDER RETURNS(BIT(1)); 08990000 DCL MSG CHAR(70) VAR; 09000000 YESNO1: PUT EDIT(MSG,' Y/N:') (COL(1),A,A); 09010000 GET EDIT(ANS) (COL(1),A(1)); 09020000 CALL UPCASE(ADDR(ANS),1); 09030000 IF ANS = 'Y' THEN 09040000 RETURN(TRUE); 09050000 IF ANS = 'N' THEN 09060000 RETURN(^TRUE); 09070000 GOTO YESNO1; 09080000 END YESNO; 09090000 09100000 1$END: 09110000 CLOSE FILE(SYSPRINT),FILE(SYSIN); 09120000 CLOSE FILE(ADMPRINT); 09130000 09140000 END AMDEDIT; 09150000