/* RQUEDIT - A DSPRINT/ADMPRINT REQUEST QUEUE EDIT/LIST PROGRAM */ 00010000 RQUEDIT: PROC(PARM) REORDER OPTIONS(MAIN) ; 00020000 1/* */ 00030000 /* */ 00040000 /* THIS PROGRAM WILL EDIT BOTH THE DSPRINT AND THE */ 00050000 /* ADMPRINT REQUEST QUEUE. BOTH THE DSPRINT AND THE */ 00060000 /* ADMPRINT DDNAME SHOULD BE PRESENT IF YOU WISH */ 00070000 /* TO EDIT/LIST BOTH QUEUE FILES. RQUEDIT WILL PROMPT */ 00080000 /* YOU TO DETERMINE WHICH ONE YOU WISH TO EDIT/LIST. */ 00090000 /* YOU AND CHANGE QUEUE FILES BY ENTERING THE "RQU" */ 00100000 /* COMMAND. */ 00110000 /* */ 00120000 /* TO BE ABLE TO DO EDIT COMMANDS, A PARM OF "EDIT" MUST */ 00130000 /* BE PASSED TO THIS PROGRAM, OTHERWISE YOU CAN ONLY DO */ 00140000 /* LIST COMMANDS. */ 00150000 /* */ 00160000 /* WRITTEN BY : SAM J. BASS */ 00170000 /* OCCIDENTAL SYSTEMS INC. */ 00180000 /* 5 GREENWAY PLAZA EAST */ 00190000 /* HOUSTON, TEXAS 77046 */ 00200000 /* (713) 840-2178 */ 00210000 /* */ 00220000 /* DISCLAMER: THIS PROGRAM HAS BEEN FULLY */ 00230000 /* TESTED AT OSI, BUT I CLAIM NO */ 00240000 /* INTEGRITY OF THE */ 00250000 /* REQUEST QUEUE AFTER EDITING */ 00260000 /* IT WITH THIS PROGRAM. */ 00270000 /* */ 00280000 /* NOTE 1: EVEN THOUGH A ENQ/DEQ HAS BEEN */ 00290000 /* USED IN EDIT MODE, */ 00300000 /* THE QAB-0 FREE PQE POINTER CAN */ 00310000 /* BE 0,0 IF YOU INITIALIZE OR */ 00320000 /* RESET A PRINTER WHEN THE */ 00330000 /* BACKGROUND PROCESSOR IS USING THE */ 00340000 /* PRINTER . */ 00350000 /* */ 00360000 /* NOTE 2: TO BE SURE THAT NOTE 1 NEVER */ 00370000 /* OCCURS: */ 00380000 /* 1. STOP THE BACKGROUND */ 00390000 /* PROCESSOR. */ 00400000 /* 2. ALLOC THE REQUEST QUEUE */ 00410000 /* DSN EXCLUSIVE TO YOUR */ 00420000 /* SESSION. */ 00430000 /* 3. OR APPLY THE FOLLOWING FIX TO */ 00440000 /* CPF5798#. */ 00450000 /* */ 00460000 /* CLC QABORQEA-16(4,@15),HEXZEROS */ 00470000 /* IS THIS POINTER ZERO OSI-SJB 01488100 */ 00480000 /* BE QABOIS0 */ 00490000 /* YES, DO NOT PUT IN QAB-0 OSI-SJB 01488200 */ 00500000 /* CLC QABORQEA-16(4,@01),HEXZEROS */ 00510000 /* IS THIS POINTER ZERO OSI-SJB 01503100 */ 00520000 /* BZ QABOIS0 */ 00530000 /* YES, DO NOT PUT IN QAB-0 OSI-SJB 01503200 */ 00540000 /* */ 00550000 /* */ 00560000 /* */ 00570000 1/* DEPENDENCIES */ 00580000 /* */ 00590000 /* DDNAMES: DSPRINT/ADMPRINT THE REQUEST QUEUE DATASET */ 00600000 /* ADMTEST/ADMBKUP ALTERNATE REQUEST QUEUE DATASETS */ 00610031 /* SYSIN INPUT FOR COMMANDS */ 00620000 /* SYSPRINT OUTPUT LISTINGS */ 00630000 /* */ 00640000 /* */ 00650000 /* EXTERNAL : ENQ/DEQ ENQ/DEQ PROGRAM TO ENQ/DEQ */ 00660000 /* ON THE REQUEST QUEUE */ 00670000 /* ONLY IN EDIT MODE */ 00680000 /* */ 00690000 /* ERASE 3270 FULLSCREEN CLEAR */ 00700000 /* ERASE IS FETCHED */ 00710000 /* IS NO PROGRAM AVAILABLE THEN */ 00720000 /* LINK/ALIAS IEFBR14 AS ERASE */ 00730000 /* */ 00740000 /* */ 00750000 -/* UPDATE LOG */ 00760028 /* */ 00770028 /* MARK GOTO - 3/23/84 */ 00780028 /* MODIFY THE HANDLING OF THE MAJOR/MINOR ENQUEUE NAMES FOR */ 00790030 /* THE GDDM R2-R3 CONVERION PERIOD (SINCE GDDM R3 NOW USES */ 00800031 /* THE QUEUE DATA SET NAME AS THE ENQUEUE MINOR NAME, THE */ 00810031 /* DEFAULT MAJOR ENQUEUE NAME, "ADMPRNTQ", MAY BE USED BY */ 00820031 /* ALL TEST OR BACK-UP VERSIONS OF THE GDDM PRINT UTILITY). */ 00830031 /* */ 00840028 /* QUENAME(3) = 'ADMTEST' (ALTERNATE "TEST" QUEUE NAME) */ 00850031 /* QUENAME(4) = 'ADMBKUP' (ALTERNATE "BACK-UP" QUEUE NAME) */ 00860031 /* MAJOR(3) = 'ADMPRNTQ' (MAJOR ENQUEUE NAME FOR GDDM R3) */ 00870031 /* MAJOR(4) = 'ADMPRNTQ' (MAJOR ENQUEUE NAME FOR GDDM R2) */ 00880031 /* MINOR(1) = 'IN PROCESS OF BEING UPDATED.' */ 00890031 /* MINOR(2) = 'IN PROCESS OF BEING UPDATED ' */ 00900031 /* MINOR(3) = 'IN PROCESS OF BEING UPDATED ' */ 00910031 /* MINOR(4) = 'IN PROCESS OF BEING UPDATED ' */ 00920031 /* */ 00930030 /* DELETE "VMINOR" CONSTANT AND USE "RNAME" / "LRNAME" AS */ 00940030 /* INTERMEDIATE VARIABLES (IN PLACE OF "MINOR" AND "LMINOR") */ 00950030 /* FOR INVOKING ENQ/DEQ SUBROUTINES. */ 00960030 /* */ 00970030 1/* COMMANDS */ 00980030 /* */ 00990030 /* SYNTAX: CMD PTR-NAME */ 01000000 /* */ 01010000 /* COL(1) - CMD = 3 CHAR. COMMAND */ 01020000 /* OPTIONAL COL(4) - PTR-NAME = PRINTER NAME / * */ 01030000 /* * MEANS USE LAST USED PRINTER */ 01040000 /* NAME */ 01050000 /* USED ON COMMANDS(DIS,CHG,RES,ADD) */ 01060000 /* */ 01070000 /* */ 01080000 /* CMD(LIST): PTR DISPLAY ALL PRINTER NAMES */ 01090000 /* DIS DISPLAY INFO FOR A PRINTER */ 01100000 /* ALL DISPLAY INTO FOR ALL PRINTERS */ 01110000 /* QAB DISPLAY QAB-0 INFO */ 01120000 /* PQE DISPLAY PQE , WILL ASK FOR */ 01130022 /* REL-BLOCK, REL-OFFSET */ 01140000 /* RUN RUN A QUE CHAIN ,WILL ASK FOR */ 01150022 /* REL-BLOCK, REL-OFFSET, AND #RUN */ 01160000 /* HELP HELP COMMAND */ 01170000 /* */ 01180000 /* CMD(EDIT): CHG CHANGE CHAR. OF A PRINTER */ 01190000 /* RES RESET A PRINTER, WILL PUT ALL */ 01200022 /* PQE BACK ON FREE CHAIN */ 01210000 /* INT RESETS ALL PRINTERS AND */ 01220000 /* RECHAINS ALL PQE*S */ 01230000 /* EXP EXPANDS THE NUMBER OF PRINTER */ 01240011 /* RECORDS */ 01250011 /* ADD ADD A NEW PRINTER IN QAB RECORD */ 01260000 /* AND INPUT CHARACTERISTICS. */ 01270000 /* QABPTRNM(N) < ' ' MUST */ 01280000 /* BE FOUND TO ADD A PRINTER */ 01290000 /* QAB DISPLAY AND CHANGE QAB-0 INFO */ 01300000 /* REB REBUILD FREE PQE CHAIN */ 01301032 /* */ 01310000 /* NOTE: ALL LIST COMMANDS ARE AVAILABLE UNDER EDIT */ 01320000 1/* */ 01330000 /* DECLARES TAKEN FROM THE PLS LISTINGS FOR DSPRINT */ 01340000 /* */ 01350000 -DECLARE /* */ 01360000 1 PQE /*CHARACTER(80)*/ /* PRINTER QUEUE ELEMENT: */ 01370000 /* */ 01380000 BASED(PQE@), /* */ 01390000 2 PQENEXTA /*CHARACTER(4)*/ /* QUEUE-ADDRESS OF NEXT PQE IN */ 01400000 , /* THE QUEUE(0 IF END OF QUEUE): */ 01410000 3 PQENEXTB FIXED BIN(15), /* RELATIVE BLOCK ADDRESS. */ 01420019 3 PQENEXTO FIXED BIN(15), /* OFFSET WITHIN BLOCK. */ 01430019 2 PQEID /*CHARACTER(60)*/ /* PQE OWNERSHIP: */ 01440000 , /* NON-HEX 00'S: PRINT REQUEST.*/ 01450000 /* HEX 00'S: FREE PQE. */ 01460000 3 PQEDSN CHARACTER(44) /* PRINT REQUEST DSN. */ 01470000 , /* */ 01480000 3 PQEMEMBR CHARACTER(8) /* PDS MEMBER NAME, IF ANY (HEX */ 01490000 , /* ZEROS IF NOT PDS). */ 01500000 3 PQEPASSW /*CHARACTER(8)*/ /* PASSWORD, IF ANY (HEX ZEROS */ 01510000 , /* IF NOT PASSWORD PROTECTED). */ 01520000 4 PQEREQ# FIXED BIN(15), /* REQUEST NO. FOR INTERIM DATA */ 01530019 4 PQE$01 CHARACTER(6), /* SETS. */ 01540000 2 PQEDTTIM /*CHARACTER(8)*/ /* "TIME" MACRO DATE AND TIME: */ 01550000 , /* */ 01560000 3 PQEDATE FIXED BIN(31), /* JULIAN REQUEST DATE(DECIMAL). */ 01570000 3 PQETIME FIXED BIN(31), /* TIME OF REQUEST (DECIMAL). */ 01580000 2 PQETSOID CHARACTER(7), /* REQUESTING TSO USER'S ID. */ 01590000 2 PQEFLAGS /*BIT(8)*/, /* PQE FLAGS: */ 01600000 3 PQE$02 BIT(6), /* RESERVED (PQEFRSVD). */ 01610000 3 PQEDSTYP BIT(1), /* PRINT DATA SET TYPE: */ 01620000 /* 0: INTERIM. */ 01630000 /* 1: USER. */ 01640000 3 PQEDSDSP BIT(1); /* PRINT DATA SET DISPOSITION */ 01650000 /* UPON SUCCESSFUL PRINT */ 01660000 /* COMPLETION: 0: DELETE. */ 01670000 /* 1: KEEP. */ 01680000 1DECLARE /* */ 01690000 1 QAB(2) BASED(QAB@) /* QUEUE ANCHOR BLOCK. */ 01700000 , /* */ 01710000 2 QABFLAGS /*BIT(8)*/, /* QUEUE CONTROL FLAGS. */ 01720000 3 QABLAST BIT(1), /* 1 = LAST QAB. */ 01730000 3 QAB$01 BIT(7), /* RESERVED (QABFRSVD). */ 01740000 2 QABTIME /*F*/ BIT(8), /* BACKGROUND PROBE TIME */ 01750000 /* INTERVAL IN DECASECONDS */ 01760000 /* (QABTIME OF 1 = 10 SECONDS). */ 01770000 2 QABFFEAD /*CHARACTER(4)*/ /* 1ST FREE ELEM. QUEUE-ADDRESS: */ 01780000 , /* */ 01790000 3 QABFFERB FIXED BIN(15), /* RELATIVE BLOCK ADDRESS. */ 01800019 3 QABFFEOF FIXED BIN(15), /* OFFSET WITHIN BLOCK. */ 01810019 2 QABNREQ# FIXED BIN(15) /* NEXT REQUEST NUMBER TO BE */ 01820019 , /* ASSIGNED. */ 01830000 2 QABPTRQL(103) /* PRINTER REQUEST QUEUE ANCHORS:*/ 01840000 , /* */ 01850000 3 QABPTRQA /*CHARACTER(24)*/ /* ANCHOR FORMAT: */ 01860000 , /* */ 01870000 4 QABPTRNM CHARACTER(8) /* PRINTER NAME AS DEFINED IN THE*/ 01880000 , /* VTAM RESOURCE DEF. TABLE. */ 01890000 4 QABORQEA /*CHARACTER(4)*/ /* OLDEST REQUEST PQE QUEUE-ADDR */ 01900000 , /* FOR GIVEN PRINTER (0 IF NONE):*/ 01910000 5 QABORQEB FIXED BIN(15), /* RELATIVE BLOCK ADDRESS. */ 01920019 5 QABORQEO FIXED BIN(15), /* OFFSET WITHIN BLOCK. */ 01930019 4 QABLRQEA /*CHARACTER(4)*/ /* LATEST REQUEST PQE QUEUE-ADDR */ 01940000 , /* FOR GIVEN PRINTER (0 IF NONE):*/ 01950000 5 QABLRQEB FIXED BIN(15), /* RELATIVE BLOCK ADDRESS. */ 01960019 5 QABLRQEO FIXED BIN(15), /* OFFSET WITHIN BLOCK. */ 01970019 4 QABPBFSZ FIXED BIN(15) , /* PRINTER HARDWARE BUFFER SIZE */ 01980019 /* (FOR 328X PRINTER). */ 01990000 /* 5 QAB$02 BIT(8), */ /* FOR 3790 BATCH LU: */ 02000000 /* 5 QABPGRP# BIT(8), */ /* "PRINT GROUP NUMBER". */ 02010000 4 QABPWIDE /*F*/ BIT(8), /* MAX./DEFAULT PAGE WIDTH SPEC. */ 02020000 4 QABPLEN /*F*/ BIT(8), /* DEFAULT # LINES TO FIT ON PGE.*/ 02030000 4 QABTMARG /*F*/ BIT(8), /* DEFAULT # LINES FOR TOP MARG. */ 02040000 4 QABBMARG /*F*/ BIT(8), /* DEFAULT # LINES FOR BOT. MARG.*/ 02050000 4 QABHPP /*F*/ BIT(8), /* NO. HARDWARE PRT. POS./LINE. */ 02060000 4 QABTYPE /*F*/ BIT(8); /* PRINTER TYPE: */ 02070000 /* 1: 3284 PRINTER, */ 02080000 /* 3286 PRINTER, OR */ 02090000 /* 3288 PRINTER, NO VFC USE. */ 02100000 /* 2: 3288 PRINTER WITH VFC USE. */ 02110000 /* 3: 3790 BATCH FUNCTION LINE */ 02120000 /* PRINTER. */ 02130000 /* 6: 3287 PRINTER, SCS FEATURE */ 02140000 1 DCL QUEFILE FILE RECORD KEYED 02150000 ENV(REGIONAL(1)); 02160000 02170000 DCL DDNAME CHAR(8) 02180000 INIT('RQUEDIT'); 02190000 02200000 DCL QUENAME(4) CHAR(8) 02210031 INIT('DSPRINT', 02220000 'ADMPRINT', 02230000 'ADMTEST', 02240031 'ADMBKUP'); 02250031 02260000 DCL MAJOR(4) CHAR(8) 02270031 INIT('DSPRINTQ', 02280000 'ADMPRNTQ', 02290000 'ADMPRNTQ', 02300031 'ADMPRNTQ'); 02310029 02320000 DCL MINOR(4) CHAR(255) VAR INIT( 02330031 'IN PROCESS OF BEING UPDATED.', 02340030 'IN PROCESS OF BEING UPDATED ', 02350030 'IN PROCESS OF BEING UPDATED ', 02360031 'IN PROCESS OF BEING UPDATED '); 02370030 02380000 DCL SYSPRINT FILE STREAM PRINT; 02390000 DCL SYSIN FILE STREAM INPUT; 02400000 02410000 /* CALL ENQ(MAJOR(IDD),RNAME,LRNAME,ETYPE,RC) */ 02420030 02430000 DCL ENQ EXT OPTIONS(ASM INTER) 02440000 ENTRY(CHAR(8),CHAR(255), 02450000 FIXED BIN(31), 02460000 FIXED BIN(31),FIXED BIN(31) ); 02470000 02480000 /* CALL DEQ(MAJOR(IDD),RNAME,LRNAME,RC) */ 02490030 02500000 DCL DEQ EXT OPTIONS(ASM INTER) 02510000 ENTRY(CHAR(8),CHAR(255), 02520000 FIXED BIN(31), 02530000 FIXED BIN(31)); 02540000 02550000 DCL RNAME CHAR(255) INIT(' '); 02560030 DCL LRNAME FIXED BIN(31) INIT(0); 02570030 02580000 DCL ETYPE FIXED BIN(31) INIT(1); 02590000 DCL RC FIXED BIN(31) INIT(0); 02600000 02610000 DCL (ADDR,SUBSTR,UNSPEC, BOOL,LOW, 02620000 LENGTH,REPEAT,MOD,DIM,ONKEY,INDEX,ONCODE) 02630000 BUILTIN; 02640000 DCL LISTOPT(11) CHAR(3) INIT( 02650000 'ALL' ,'DIS' ,'HEL' ,'PQE' ,'PTR' , 02660000 'QAB' ,'QUE' ,'RUN' ,'WHO' ,'RQU' ,'DMP'); 02670000 DCL LISTPRC(11) INT ENTRY VARIABLE INIT( 02680000 $ALL , $DIS , $HEL , $PQE , $PTR , 02690000 $QAB , $QUE , $RUN ,$WHO , $RQU ,$DMP); 02700000 DCL EDITOPT(7) CHAR(3) INIT( 02710024 'ADD','CHG','INT','QAB','REB','RES','EXP'); 02720022 DCL EDITPRC(7) INT ENTRY VARIABLE INIT( 02730024 $ADD ,$CHG ,$INT ,$QAB ,$REB ,$RES ,$EXP); 02740022 DCL ERASE EXT ENTRY; 02750000 DCL COMTIME EXT ENTRY RETURNS(CHAR(18)); 02760000 1 DCL EOF1 BIT(1) INIT('0'B); 02770000 DCL #UPDATE BIT(1) INIT('0'B); 02780000 DCL #EDIT BIT(1) INIT('0'B); 02790000 DCL #ENQ BIT(1) INIT('0'B); 02800000 DCL #OPEN BIT(1) INIT('0'B); 02810000 DCL #MASK BIT(1) INIT('0'B); 02820000 DCL TRUE BIT(1) INIT('1'B); 02830000 DCL (PQE@,QAB@,PTR@) PTR; 02840000 DCL PARM CHAR(100) VAR; 02850000 DCL ANS CHAR(1) INIT(' '); 02860000 DCL OPTION CHAR(3) INIT(' '); 02870000 DCL CARDIN CHAR(80) INIT(' '); 02880000 DCL OLDCARD CHAR(80) INIT(' '); 02890000 DCL LINEOUT CHAR(80) VAR INIT(' '); 02900000 DCL BUF2480(10) CHAR(2480) INIT(' '); 02910000 DCL BUFFER(10*31) CHAR(80) DEF(BUF2480) POS(1); 02920000 DCL BLANK8 CHAR(8) INIT(' '); 02930000 DCL (IQAB_REC,IQAB_OFF) FIXED BIN(31) INIT(0); 02940019 DCL (NBUF) FIXED BIN(31) INIT(0); 02950019 DCL (MAXQAB_OFF) FIXED BIN(31) INIT(103); 02960019 DCL (MAXQAB_REC) FIXED BIN(31) INIT(9999); 02970019 DCL (MAXREC) FIXED BIN(31) INIT(9999); 02980019 DCL (MAXPQE) FIXED BIN(31) INIT(0); 02990022 DCL (ISTART,NSTART) FIXED BIN(31) INIT(1); 03000019 DCL (IDD) FIXED BIN(31) INIT(1); 03010019 DCL (IKEY) FIXED BIN(31) INIT(0); 03020022 DCL (IPQE,LPQE) FIXED BIN(31) INIT(0); 03030022 DCL I FIXED BIN(31) INIT(0); 03040019 DCL IPREF FIXED BIN(31) INIT(0); 03050019 DCL (IBLK,IOFF) FIXED BIN(15) INIT(0); 03060025 DCL (PBFSZ) FIXED BIN(15) INIT(0); 03070019 DCL (ORQEB,ORQEO) FIXED BIN(15) INIT(0); 03080019 DCL (LRQEB,LRQEO) FIXED BIN(15) INIT(0); 03090019 DCL (PWIDE,PLEN,TMARG,BMARG,HPP,TYPE) 03100000 FIXED BIN(15) INIT(0); 03110019 DCL (TIME,FFERB,FFEOF,NREQ#) 03120000 FIXED BIN(15) INIT(0); 03130019 DCL (PNAME,PTRNM,PNAMM) CHAR(8) INIT(' '); 03140000 DCL (PRINTER) CHAR(8) INIT(' '); 03150000 DCL NOPTR COND; 03160000 03170000 1 ON COND(NOPTR) 03180000 BEGIN; 03190000 GO TO GETCARD; 03200000 END; 03210000 03220000 ON UNDF(QUEFILE) 03230000 BEGIN; 03240000 PUT EDIT('*** ONCODE = ',ONCODE) (COL(1),A,A); 03250000 PUT EDIT('*** ',DDNAME,' DD NOT PRESENT ***') 03260000 (COL(1),A,A,A); 03270000 CALL $RQU; 03280000 END; 03290000 03300000 ON ENDFILE(QUEFILE) 03310000 BEGIN; 03320000 EOF1 = TRUE; 03330000 END; 03340000 03350000 ON ENDFILE(SYSIN) 03360000 BEGIN; 03370000 GO TO $END; 03380000 END; 03390000 03400000 ON KEY(QUEFILE) 03410000 BEGIN; 03420000 PUT EDIT(' NUMBER OF RECORDS = '||ONKEY) 03430000 (COL(1),A); 03440000 IF MAXREC > 99 THEN 03450016 MAXREC = NBUF - 1; 03460016 EOF1 = TRUE; 03470000 END; 03480000 03490000 ON ERROR 03500000 BEGIN; 03510000 PUT EDIT('*** ONCODE = ',ONCODE) (COL(1),A,A); 03520000 GO TO GETCARD; 03530000 END; 03540000 03550000 OPEN FILE(SYSPRINT) LINESIZE(80), 03560000 FILE(SYSIN); 03570000 FETCH ERASE; 03580000 03590000 #OPEN = ^TRUE; 03600000 CALL $RQU; 03610000 03620000 GETCARD: PUT EDIT(' ENTER OPTION:') (COL(1),A); 03630000 GETCRD: CARDIN = ' '; 03640004 GET EDIT(CARDIN) (COL(1),A(40)); 03650000 CALL UPCASE(ADDR(CARDIN),80); 03660000 IF CARDIN = ' ' THEN 03670000 CARDIN = OLDCARD; 03680000 GET STRING(CARDIN) EDIT(OPTION) (A(3)); 03690000 IF SUBSTR(CARDIN,1,1) < 'A' THEN 03700000 GO TO GETCARD; 03710000 OLDCARD = CARDIN; 03720000 IF OPTION = 'END' THEN 03730000 GO TO $END; 03740000 #UPDATE = ^TRUE; 03750000 #MASK = ^TRUE; 03760000 /* IF EDIT THEN CHECK EDIT CMDS */ 03770000 IF #EDIT THEN 03780000 DO I = 1 TO DIM(EDITOPT,1); 03790000 IF OPTION = EDITOPT(I) THEN 03800000 DO; 03810000 #UPDATE = TRUE; 03820000 CALL READALL; 03830000 CALL EDITPRC(I); 03840000 CALL REWRITE; 03850000 GO TO GETCARD; 03860000 END; 03870000 ELSE; 03880000 END; 03890000 ELSE; /* SEE IF IT IS A LIST CMD */ 03900000 DO I = 1 TO DIM(LISTOPT,1); 03910000 IF OPTION = LISTOPT(I) THEN 03920000 DO; 03930000 #UPDATE = ^TRUE; 03940000 CALL READALL; 03950000 CALL LISTPRC(I); 03960000 GO TO GETCARD; 03970000 END; 03980000 ELSE; 03990000 END; 04000000 OPTERR: PUT EDIT(' ILLEGAL OPTION / REENTER:') (COL(1),A); 04010000 GO TO GETCRD; 04020004 04030000 1$ADD: PROC REORDER; 04040000 PNAMM = SUBSTR(CARDIN,5,8); 04050000 CALL PTRGETN ; 04060000 DO IQAB_REC = 1 TO MAXQAB_REC; 04070019 DO IQAB_OFF = 1 TO MAXQAB_OFF; 04080019 IF QAB(IQAB_REC).QABPTRNM(IQAB_OFF) < BLANK8 THEN 04090019 DO; 04100000 PTRNM = PNAME; 04110000 ORQEB,ORQEO,LRQEB,LRQEO = 0; 04120000 PBFSZ = 1024; 04130000 PWIDE = 132; 04140000 PLEN = 66; 04150000 TMARG = 2; 04160000 BMARG = 2; 04170000 HPP = PWIDE; 04180000 TYPE = 6; 04190000 CALL QVARPUT(IQAB_REC,IQAB_OFF); 04200019 CALL ERASE; 04210000 CALL PTRDIS(IQAB_REC,IQAB_OFF); 04220019 CALL PTRCHG(IQAB_REC,IQAB_OFF); 04230019 RETURN; 04240000 END; 04250000 ELSE; 04260000 END; 04270000 END; 04280000 PUT EDIT(' *** NO PRINTER SLOTS LEFT ***') 04290000 (COL(1),A); 04300000 END $ADD; 04310000 04320000 1$ALL: PROC REORDER; 04330000 CALL ERASE; 04340000 CALL $QAB ; 04350000 DO IQAB_REC = 1 TO MAXQAB_REC; 04360019 DO IQAB_OFF = 1 TO MAXQAB_OFF; 04370019 IF QAB(IQAB_REC).QABPTRNM(IQAB_OFF) < BLANK8 THEN 04380019 LEAVE; 04390019 SUBSTR(CARDIN,5,8) = QAB(IQAB_REC).QABPTRNM(IQAB_OFF); 04400019 PUT EDIT(REPEAT('-',60)) (COL(1),A); 04410000 CALL PTRDIS(IQAB_REC,IQAB_OFF); 04420019 END; 04430000 END; 04440000 END $ALL; 04450000 04460000 1$CHG: PROC REORDER; 04470000 CALL PTRGETN ; 04480000 $CHG1: 04490000 CALL PTRFIND(IQAB_REC,IQAB_OFF); 04500019 IF IQAB_OFF <= MAXQAB_OFF THEN 04510019 DO; 04520000 IF #MASK = ^TRUE THEN 04530000 CALL ERASE; 04540000 CALL PTRDIS(IQAB_REC,IQAB_OFF); 04550019 CALL PTRCHG(IQAB_REC,IQAB_OFF); 04560019 END; 04570000 IF #MASK = TRUE THEN 04580000 GO TO $CHG1; 04590000 END $CHG; 04600000 04610000 1$DIS: PROC REORDER; 04620000 CALL PTRGETN ; 04630000 $DIS1: 04640000 CALL PTRFIND(IQAB_REC,IQAB_OFF); 04650019 IF IQAB_OFF <= MAXQAB_OFF THEN 04660019 DO; 04670000 IF #MASK = ^TRUE THEN 04680000 CALL ERASE; 04690000 CALL PTRDIS(IQAB_REC,IQAB_OFF); 04700019 END; 04710000 IF #MASK = TRUE THEN 04720000 GO TO $DIS1; 04730000 END $DIS; 04740000 04750000 1$DMP: PROC REORDER; 04760000 PUT SKIP DATA; 04770000 END $DMP; 04780000 04790017 1$EXP: PROC REORDER; 04800017 DCL IPQE FIXED BIN(31) INIT(0); 04810019 DCL LPQE FIXED BIN(31) INIT(0); 04820019 DCL BIT8 BIT(8) BASED(@BIT8) ; 04830017 DCL @BIT8 PTR; 04840017 DCL (NEWREC,J) FIXED BIN(31) INIT(0); 04850019 04860017 CALL ERASE; 04870017 04880017 IF #ENQ THEN 04890017 PUT EDIT(' *** ENQ FINISHED ***') 04900017 (COL(1),A); 04910017 $EXP1: 04920017 PUT EDIT(' THIS COMMAND ALSO INITIALIZES ALL ' || 04930017 'PRINTERS (DELETES ALL QUEUED DATASETS)') 04940017 (COL(1),A); 04950017 IF ^YESNO(' DO YOU WANT TO CONTINUE, ANSWER ') THEN 04960017 RETURN; 04970017 PUT EDIT(' HOW MANY PRINTER RECORDS '|| 04980017 'DO YOU WANT TO ADD 1-9 :') 04990017 (COL(1),A); 05000017 GET EDIT(ANS) (COL(1),A(1)); 05010017 IF ANS >= '1' & ANS <= '9' THEN 05020017 DO; 05030017 GET STRING(ANS) EDIT(NEWREC) (F(1)); 05040017 IF NEWREC+MAXREC > 9 THEN 05050017 GOTO $EXP1; 05060017 END; 05070017 ELSE 05080017 GOTO $EXP1; 05090017 05100017 @BIT8 = ADDR(BUF2480(MAXQAB_REC)); 05110019 BIT8 = '00000000'B; 05120017 05130017 DO J = MAXQAB_REC+1 TO MAXQAB_REC + NEWREC; 05140019 BUF2480(J) = LOW(2480); 05150017 END; 05160017 05170017 MAXQAB_REC = MAXQAB_REC + NEWREC; 05180019 MAXREC = MAXREC + NEWREC; 05190017 @BIT8 = ADDR(BUF2480(MAXQAB_REC)); 05200019 BIT8 = '10000000'B; 05210017 05220017 CALL QABRESET(1,MAXQAB_REC); 05230019 CALL QAB0RES; 05240017 CALL PQERESET; 05250017 05260017 CLOSE FILE(QUEFILE); 05270017 OPEN FILE(QUEFILE) TITLE(DDNAME) SEQL OUTPUT; 05280017 DO NBUF = 1 TO MAXREC; 05290017 IKEY = NBUF - 1; 05300017 WRITE FILE(QUEFILE) FROM(BUF2480(NBUF)) KEYFROM(IKEY); 05310017 END; 05320017 CLOSE FILE(QUEFILE); 05330017 OPEN FILE(QUEFILE) TITLE(DDNAME) DIRECT UPDATE; 05340017 05350017 END $EXP; 05360017 05370000 1$HEL: PROC REORDER; 05380000 CALL ERASE; 05390000 PUT EDIT(' THE FOLLOWING COMMANDS ARE AVAILABLE: ', 05400000 ' *** LIST COMMANDS ***', 05410000 'ALL DISPLAY INFO. ON ALL PRINTERS', 05420000 'DIS PRINTER/* DISPLAY INFO. ON A PRINTER', 05430000 'HELP HELP FOR COMMANDS', 05440000 'QUE DISPLAY INFO. ON PRINTERS WITH QUEUES', 05450000 'PTR DISPLAY THE LIST OF PRINTERS AVAILABLE', 05460000 'RQU CHANGE REQUEST QUEUE ', 05470026 'WHO DISPLAY THE PROGRAMS LOGO', 05480000 'END TO END THE PROGRAM') 05490000 (COL(1),A); 05500000 IF #EDIT THEN 05510000 PUT EDIT( 05520000 ' *** EDIT COMMANDS ***', 05530000 'ADD PRINTER/* ADD A PRINTER', 05540026 'CHG PRINTER/* CHANGE A PRINTER CHARACTERISTICS', 05550026 'EXP EXPAND TO ADD A PRINTER RECORD', 05560026 'INT INITIALIZE ALL PRINTERS TO NO DSN*S', 05570026 'PQE DISPLAY A PQE', 05580000 'QAB DISPLAY A QAB', 05590000 'REB REBUILD FREE PRINTER QUEUE CHAIN (PQE)', 05600026 'RES PRINTER/* TO RESET A PRINTER TO NO DSN*S TO PRINT', 05610026 'RUN RUN A PQE CHAIN') 05620027 (COL(1),A); 05630027 END $HEL; 05640000 05650000 1$INT: PROC REORDER; 05660000 05670000 CALL ERASE; 05680000 05690000 IF #ENQ THEN 05700000 PUT EDIT(' *** ENQ FINISHED ***') 05710000 (COL(1),A); 05720000 IF ^YESNO(' DO YOU WANT TO INIT ALL PRINTERS') THEN 05730000 RETURN; 05740000 05750000 $INT1: 05760000 05770000 /* NOW RESET THE PRINTER RECORDS */ 05780000 05790000 CALL QABRESET(1,MAXQAB_REC); 05800019 CALL QAB0RES; 05810017 05820000 /* NOW RESET THE PQE RECORDS */ 05830000 05840000 MAXPQE = MAXREC - MAXQAB_REC; 05850019 CALL PQERESET; 05860000 END $INT; 05870000 05880011 1$PQE : PROC REORDER; 05890000 DCL (IBLK,IOFF) FIXED BIN(15) INIT(0); 05900025 DCL IPQE FIXED BIN(31) INIT(0); 05910025 ON ERROR 05920000 BEGIN; 05930000 GO TO $PQE1; 05940000 END; 05950000 05960000 $PQE1: PUT EDIT(' ENTER PQE ADDR IN "RELBLK,OFFSET"') 05970000 (COL(1),A); 05980000 PUT EDIT(' 0,0 TO END') 05990000 (A); 06000000 GET LIST(IBLK,IOFF); 06010000 IF IBLK = 0 THEN RETURN; 06020000 CALL PQEGET(IBLK,IOFF,IPQE); 06030000 PUT SKIP DATA(IPQE); 06040000 PQE@ = ADDR(BUFFER(IPQE)); 06050000 PUT SKIP DATA(PQE); 06060000 GO TO $PQE1; 06070000 END $PQE; 06080000 06090000 1$PTR: PROC REORDER; 06100000 CALL ERASE; 06110000 IQAB_REC,IQAB_OFF = 1; 06120019 PUT EDIT((( ' PTR(',IQAB_REC,',',IQAB_OFF,')=', 06130019 QAB(IQAB_REC).QABPTRNM(IQAB_OFF) 06140019 DO IQAB_OFF = 1 TO MAXQAB_OFF 06150019 WHILE(QAB(IQAB_REC).QABPTRNM(IQAB_OFF) > 06160019 BLANK8) ) 06170019 DO IQAB_REC = 1 TO MAXQAB_REC) ) 06180019 (COL(1),(3)(A,F(3),A,F(3),A,A)); 06190000 END $PTR; 06200000 06210000 1$QAB : PROC REORDER; 06220000 06230000 CALL QAB0GET; 06240000 06250000 PUT SKIP DATA(TIME,NREQ#); 06260000 PUT SKIP DATA(FFERB,FFEOF); 06270000 06280000 IF OPTION ^= 'QAB' THEN RETURN; 06290000 IF #UPDATE = ^TRUE THEN 06300000 RETURN; 06310000 IF ^YESNO(' DO YOU WISH TO CHANGE ANY VALUES') THEN 06320000 RETURN; 06330000 PUT EDIT(' ENTER CHANGES FOR:') 06340000 (COL(1),A); 06350000 PUT EDIT(' TIME,NREQ#,FFERB,FFEOF') 06360000 (COL(1),A); 06370000 06380000 TIME,FFERB,FFEOF,NREQ#=-1; 06390000 GET SKIP DATA(TIME,NREQ#,FFERB,FFEOF); 06400000 06410000 CALL QAB0PUT; 06420000 06430000 CALL QAB0GET; 06440000 06450000 PUT SKIP DATA(TIME,NREQ#); 06460000 PUT SKIP DATA(FFERB,FFEOF); 06470000 06480000 END $QAB; 06490000 06500000 1$QUE: PROC REORDER; 06510000 CALL ERASE; 06520000 PUT EDIT('*** THESE PRINTERS HAVE QUEUED DATASETS ***') 06530000 (COL(1),A); 06540000 $QUE2: 06550000 DO IQAB_REC = 1 TO MAXQAB_REC; 06560019 DO IQAB_OFF = 1 TO MAXQAB_OFF; 06570019 CALL QVARGET(IQAB_REC,IQAB_OFF); 06580019 IF QAB(IQAB_REC).QABPTRNM(IQAB_OFF) < BLANK8 THEN 06590019 LEAVE $QUE2; 06600019 IF ^(ORQEB = 0 & 06610000 ORQEO = 0 & 06620000 LRQEB = 0 & 06630000 LRQEO = 0 ) THEN 06640000 DO; 06650000 SUBSTR(CARDIN,5,8) = QAB(IQAB_REC).QABPTRNM(IQAB_OFF);06660019 PUT EDIT(REPEAT('-',60)) (COL(1),A); 06670000 CALL PTRDIS(IQAB_REC,IQAB_OFF); 06680019 END; 06690000 ELSE; 06700000 END; 06710000 END; 06720000 END $QUE; 06730000 06740023 1$REB: PROC REORDER; 06750018 DCL (IBLK,IOFF) FIXED BIN(15) INIT(0); 06760025 06770018 CALL ERASE; 06780018 06790018 IF #ENQ THEN 06800018 PUT EDIT(' *** ENQ FINISHED ***') 06810018 (COL(1),A); 06820018 06830018 $REB1: 06840018 06850023 /* SET QAB0 TO 0,0 */ 06860023 06870023 QAB(0001).QABFFERB = 0; 06880023 QAB(0001).QABFFEOF = 0; 06890023 06900023 DO IBLK = MAXREC-1 TO MAXQAB_REC BY -1; 06910025 DO IOFF = 2400 TO 0 BY -80; 06920025 CALL PQEGET(IBLK,IOFF,IPQE); 06930023 IF PQEDSN <= ' ' THEN 06940023 DO; 06950023 06960023 CALL PQEZERO(IPQE) ; 06970023 06980023 /* RECHAIN THIS PQE IN FRONT OF QAB ANCHOR */ 06990023 07000023 PQE@ = ADDR(BUFFER(IPQE)); 07010023 07020023 /*PUT FREE QUE ON END OF PQE CHAIN */ 07030023 07040023 PQENEXTB = QAB(0001).QABFFERB; 07050023 PQENEXTO = QAB(0001).QABFFEOF; 07060023 07070023 /*PUT START OF PQE CHAIN AS FIRST FREE ELEMENT*/ 07080023 07090023 QAB(0001).QABFFERB = IBLK; 07100023 QAB(0001).QABFFEOF = IOFF; 07110023 PUT EDIT(' PQE (',IBLK,',',IOFF, 07120024 ') ADDED TO FREE QUEUE') 07130025 (COL(1),A,F(2),A,F(4),A); 07140025 END; 07150023 ELSE; 07160023 END; 07170023 END; 07180023 07190023 END $REB; 07200018 07210000 1$RES: PROC REORDER; 07220000 DCL IPQE FIXED BIN(31) INIT(0); 07230019 DCL LPQE FIXED BIN(31) INIT(0); 07240019 DCL I FIXED BIN(31) INIT(0); 07250019 CALL ERASE; 07260000 CALL PTRGETN ; 07270000 CALL PTRFIND(IQAB_REC,IQAB_OFF); 07280019 CALL PTRDIS(IQAB_REC,IQAB_OFF); 07290019 IF ^YESNO(' IS THIS THE CORRECT PRINTER TO RESET') THEN 07300000 RETURN; 07310000 07320000 CALL PQEGET(ORQEB,ORQEO,IPQE); 07330000 IF IPQE = 0 THEN RETURN; /*THEN NOTHING CHAINED */ 07340000 07350000 DO UNTIL(IPQE = 0); 07360000 PQE@ = ADDR(BUFFER(IPQE)); 07370000 LPQE = IPQE; 07380000 CALL PQEZERO(IPQE); 07390000 CALL PQEGET(PQENEXTB,PQENEXTO,IPQE); 07400000 END; 07410000 07420000 /* RECHAIN THIS PRINTERS PQE IN FRONT OF QAB ANCHOR */ 07430000 07440000 CALL PQERECHN(IQAB_REC,IQAB_OFF,LPQE); 07450021 07460000 CALL ERASE; 07470000 CALL PTRDIS(IQAB_REC,IQAB_OFF); 07480019 END $RES; 07490000 07500000 $RQU: PROC REORDER; 07510000 07520000 ON UNDF(QUEFILE) 07530000 BEGIN; 07540000 CALL ERASE; 07550000 PUT EDIT('*** ONCODE = ',ONCODE) (COL(1),A,A); 07560000 PUT EDIT('*** ',DDNAME,' DD NOT PRESENT ***') 07570000 (COL(1),A,A,A); 07580000 GOTO $RQU1; 07590000 END; 07600000 07610000 CALL ERASE; 07620000 $RQU1: 07630000 DDNAME = 'RQUEDIT '; 07640000 CALL $WHO; 07650000 PUT EDIT(' AVAILABLE QUEUE FILES ARE:',QUENAME) 07660000 (COL(1),A,(10)(X(1),A)); 07670000 $RQU2: 07680000 PUT EDIT(' ENTER SELECTION:') 07690000 (COL(1),A); 07700000 GET EDIT(DDNAME) 07710000 (COL(1),A(8)); 07720000 CALL UPCASE(ADDR(DDNAME),8); 07730000 IF SUBSTR(DDNAME,1,1) < 'A' THEN 07740000 GO TO $RQU2; 07750000 07760000 DO IDD = 1 TO DIM(QUENAME,1); 07770000 IF DDNAME = QUENAME(IDD) THEN 07780000 DO; 07790000 IF #OPEN THEN 07800000 DO; 07810000 CLOSE FILE(QUEFILE); 07820000 #OPEN = ^TRUE; 07830000 END; 07840000 ELSE; 07850000 OPEN FILE(QUEFILE) TITLE(DDNAME) DIRECT UPDATE; 07860000 CALL ERASE; 07870000 CALL $WHO; 07880000 CALL INIT1; 07890000 #OPEN = TRUE; 07900000 RETURN; 07910000 END; 07920000 ELSE; 07930000 END; 07940000 CALL ERASE; 07950000 PUT EDIT(DDNAME,' IS NOT A VALID QUEUE NAME') 07960000 (COL(1),A(8),A); 07970000 GOTO $RQU1; 07980000 07990000 END $RQU; 08000000 08010000 1$RUN : PROC REORDER; 08020000 DCL (IBLK,IOFF) FIXED BIN(15) INIT(0); 08030025 DCL IPQE FIXED BIN(31) INIT(0); 08040019 DCL (IRUN,I) FIXED BIN(31) INIT(0); 08050019 08060000 ON ERROR 08070000 BEGIN; 08080000 GO TO $RUN1; 08090000 END; 08100000 08110000 $RUN1: PUT EDIT(' ENTER PQE ADDR IN "RELBLK,OFFSET"') 08120000 (COL(1),A); 08130000 GET LIST(IBLK,IOFF); 08140000 IF IBLK = 0 THEN RETURN; 08150000 PUT EDIT(' ENTER NUMBER OF PQE*S TO RUN"') 08160000 (COL(1),A); 08170000 GET LIST(IRUN); 08180000 CALL PQEGET(IBLK,IOFF,IPQE); 08190000 DO I = 1 TO IRUN WHILE(IPQE ^=0); 08200000 PUT EDIT(' -------------------------------------') 08210000 (COL(1),A); 08220000 PUT SKIP DATA(IBLK,IOFF,IPQE); 08230000 PQE@ = ADDR(BUFFER(IPQE)); 08240000 PUT SKIP DATA(PQE); 08250000 IBLK = PQENEXTB; 08260000 IOFF = PQENEXTO; 08270000 CALL PQEGET(IBLK,IOFF,IPQE); 08280000 IF IPQE = 0 THEN LEAVE ; 08290000 END; 08300000 IF IPQE = 0 THEN 08310000 PUT EDIT(' *** END OF PQE CHAIN ***') 08320000 (COL(1),A); 08330000 ELSE 08340000 PUT EDIT(' *** END OF RUN CHAIN ***') 08350000 (COL(1),A); 08360000 END $RUN; 08370000 08380000 1$WHO: PROC REORDER; 08390000 IF OPTION = 'WHO' THEN 08400000 CALL ERASE; 08410000 PUT EDIT( 08420000 '>>> *** ',DDNAME,' EDIT/LIST PROGRAM *** <<<') 08430000 (COL(1),A,A,A); 08440000 PUT EDIT( 08450000 '>>> *** VERSION 3.0/SJB O. S. I. *** <<<') 08460000 (COL(1),A); 08470000 PUT EDIT( 08480000 '>>> *** COMPILED ',COMTIME(),' *** <<<') 08490000 (COL(1),A,A(18),A); 08500000 PUT EDIT( 08510000 '>>> *** SYSTEM ID ',SMFID(),' *** <<<') 08520000 (COL(1),A,A,A); 08530000 08540000 END $WHO; 08550000 08560000 1 /*--- START OF UTILITY ROUTINES ---*/ 08570000 08580000 BIT8GET: PROC(BIT8,BIN15) REORDER; 08590000 DCL BIT8 BIT(8); 08600000 DCL BIN15 FIXED BIN(15); 08610020 DCL BINPTR PTR; 08620000 DCL 1 BIT8P UNALIGNED BASED(BINPTR), 08630000 2 RES BIT(8), 08640000 2 RES2 BIT(8); 08650000 BINPTR = ADDR(BIN15); 08660000 BIT8 = RES2; 08670000 END BIT8GET; 08680000 08690000 1CVARGET: PROC(IQAB_REC,IQAB_OFF) REORDER; 08700019 DCL (IQAB_REC,IQAB_OFF) FIXED BIN(31); 08710019 ON ERROR 08720000 BEGIN; 08730000 PUT EDIT(' ERROR ON INPUT, REENTER') (COL(1),A); 08740000 GO TO CVAR1; 08750000 END; 08760000 CVAR1: PBFSZ = -1; 08770000 PWIDE,PLEN,TMARG,BMARG,HPP,TYPE = -1; 08780000 ORQEO,ORQEB,LRQEO,LRQEB = -1; 08790000 PUT EDIT(' ENTER NEW VALUES FOR ONE OR MORE OF THE ', 08800000 ' FOLLOWING. SYNTAX:VAR = VALUE,...;') 08810000 (COL(1),A,A); 08820000 PUT EDIT(' PBFSZ,PWIDE,PLEN,TMARG,BMARG,HPP,TYPE,TIME') 08830000 (COL(1),A); 08840000 PUT EDIT(' AND PTRNM, SYNTAX: PTRNM = ''PRINTNAM'' ') 08850000 (COL(1),A); 08860000 PUT EDIT(' ENTER A ";" TO END INPUT') 08870000 (COL(1),A); 08880000 GET SKIP DATA( 08890000 PBFSZ,PWIDE,PLEN,TMARG,BMARG, 08900000 HPP,TYPE,PTRNM); 08910000 CALL UPCASE(ADDR(PTRNM),8); 08920000 CALL QVARPUT(IQAB_REC,IQAB_OFF); 08930019 END CVARGET; 08940000 08950000 1INIT1: PROC REORDER; 08960000 IF PARM = 'EDIT' THEN 08970000 #EDIT = TRUE; 08980000 ELSE 08990000 #EDIT = ^TRUE; 09000000 #ENQ = ^TRUE; 09010000 #UPDATE = ^TRUE; 09020000 EOF1 = ^TRUE; 09030000 NBUF = 0; 09040000 MAXREC = 9999; 09050000 09060000 CALL READALL; 09070000 09080000 OLDCARD = ' '; 09090000 09100000 END INIT1; 09110000 09120000 09130000 1PQEGET: PROC(IBLK,IOFF,IPQE) REORDER; 09140000 DCL (IBLK,IOFF) FIXED BIN(15); 09150025 DCL IPQE FIXED BIN(31); 09160024 IF IBLK = 0 & IOFF = 0 THEN 09170000 DO; 09180000 IPQE = 0; 09190000 RETURN; 09200000 END; 09210000 IPQE = ((IBLK-0)*31) + IOFF/80+1; 09220000 IF IPQE > MAXREC*31 | IPQE < 31*MAXQAB_REC+1 THEN 09230019 DO; 09240000 PUT EDIT(' *** IPQE OUT OF RANGE *** ',IPQE) 09250000 (COL(1),A,F(8)); 09260000 PUT SKIP DATA(IBLK,IOFF,MAXREC,IPQE,MAXQAB_REC); 09270019 IPQE = 0; 09280000 RETURN; 09290000 END; 09300000 PQE@ = ADDR(BUFFER(IPQE)); 09310000 END PQEGET; 09320000 09330023 1PQERECHN:PROC(IQAB_REC,IQAB_OFF,IPQE); 09340023 DCL (IQAB_REC,IQAB_OFF) FIXED BIN(31); 09350023 DCL (IPQE) FIXED BIN(31); 09360023 09370023 /* RECHAIN THIS PRINTERS PQE IN FRONT OF QAB ANCHOR */ 09380023 09390023 PQE@ = ADDR(BUFFER(IPQE)); 09400023 09410023 /*PUT FREE QUE ON END OF PQE CHAIN */ 09420023 09430023 PQENEXTB = QAB(0001).QABFFERB; 09440023 PQENEXTO = QAB(0001).QABFFEOF; 09450023 09460023 /*PUT START OF PQE CHAIN AS FIRST FREE ELEMENT*/ 09470023 09480023 QAB(0001).QABFFERB = QAB(IQAB_REC).QABORQEB(IQAB_OFF); 09490023 QAB(0001).QABFFEOF = QAB(IQAB_REC).QABORQEO(IQAB_OFF); 09500023 09510023 /* SET PRINTER QAB QUEUE -ADDR = 0 */ 09520023 09530023 QAB(IQAB_REC).QABORQEB(IQAB_OFF)= 0; 09540023 QAB(IQAB_REC).QABORQEO(IQAB_OFF) = 0; 09550023 QAB(IQAB_REC).QABLRQEB(IQAB_OFF) = 0; 09560023 QAB(IQAB_REC).QABLRQEO(IQAB_OFF) = 0; 09570023 09580023 END PQERECHN; 09590023 09600000 1PQERESET:PROC REORDER; 09610021 DCL (IBLK,IOFF) FIXED BIN(15) INIT(0); 09620025 DCL IPQE FIXED BIN(31) INIT(0); 09630019 DCL LPQE FIXED BIN(31) INIT(0); 09640019 IBLK = MAXQAB_REC; /* BLOCK # RELATIVE TO ZERO */ 09650024 IOFF = 0; /* OFFSET */ 09660024 DO WHILE(IBLK <= MAXREC-1); /* IBLK IS RELATIVE TO ZERO */ 09670024 CALL PQEGET(IBLK,IOFF,IPQE); 09680024 CALL PQEZERO(IPQE); 09690000 PQE@ = ADDR(BUFFER(IPQE)) ; 09700000 IOFF = IOFF+80; 09710024 IF IOFF >= 31*80 THEN /* 31*80 IS # OF PQE'S IN A RECORD */09720024 DO; 09730000 PUT EDIT(' RESET DONE FOR PQE RECORD # ',IBLK) 09740024 (COL(1),A,F(2)); 09750000 IOFF = 0; 09760024 IBLK = IBLK+1; 09770024 END; 09780000 ELSE; 09790000 PQENEXTB = IBLK; 09800024 PQENEXTO = IOFF; 09810024 END; 09820000 09830000 PQENEXTB = 0; /* SET LAST = 0 */ 09840000 PQENEXTO = 0; /* SET LAST = 0 */ 09850000 09860000 END PQERESET; 09870000 09880023 1PQEZERO: PROC(IPQE) REORDER; 09890023 DCL IPQE FIXED BIN(31); 09900023 DCL PTR@ PTR; 09910023 DCL ZPQE CHAR(76) BASED(PTR@); 09920023 PQE@ = ADDR(BUFFER(IPQE)); 09930023 PTR@ = ADDR(PQEID); 09940023 ZPQE = LOW(76); 09950023 END PQEZERO; 09960023 09970000 -PTRCHG: PROC(IQAB_REC,IQAB_OFF) REORDER; 09980019 DCL (IQAB_REC,IQAB_OFF) FIXED BIN(31); 09990019 PTRCHG1: CALL CVARGET(IQAB_REC,IQAB_OFF); 10000019 CALL ERASE; 10010000 CALL PTRDIS(IQAB_REC,IQAB_OFF); 10020019 IF YESNO(' ANY OTHER CHANGES') THEN 10030000 GO TO PTRCHG1; 10040000 END PTRCHG; 10050000 10060000 1PTRDIS : PROC(IQAB_REC,IQAB_OFF) REORDER; 10070019 DCL (IQAB_REC,IQAB_OFF) FIXED BIN(31); 10080019 CALL QVARGET(IQAB_REC,IQAB_OFF); 10090019 IF #ENQ THEN 10100000 PUT EDIT(' *** ENQ FINISHED ***') 10110000 (COL(1),A); 10120000 PUT EDIT(' VALUES FOR PRINTER(',PTRNM,') #(', 10130019 IQAB_REC,',',IQAB_OFF,') ARE ') 10140019 (COL(1),A,A,A,F(3),A,F(3),A); 10150000 PUT SKIP DATA(ORQEB,ORQEO); 10160000 PUT SKIP DATA(LRQEB,LRQEO); 10170000 PUT SKIP DATA(PBFSZ,PWIDE,PLEN); 10180000 PUT SKIP DATA(TMARG,BMARG); 10190000 PUT SKIP DATA(HPP,TYPE); 10200000 CALL PTRDSN(IQAB_REC,IQAB_OFF); 10210019 END PTRDIS; 10220000 10230000 1PTRDSN : PROC(IQAB_REC,IQAB_OFF) REORDER; 10240019 DCL (IQAB_REC,IQAB_OFF) FIXED BIN(31); 10250019 DCL (I,IJ,IPQE) FIXED BIN(31) INIT(0); 10260019 CALL QVARGET(IQAB_REC,IQAB_OFF); 10270019 CALL PQEGET(ORQEB,ORQEO,IPQE); 10280000 IF IPQE = 0 THEN 10290000 DO; 10300000 PUT EDIT(' *** NO DATASETS QUEUED ***') 10310000 (COL(1),A); 10320000 RETURN; 10330000 END; 10340000 IJ = 1; 10350000 10360000 PTRDSN1: 10370000 PQE@ = ADDR(BUFFER(IPQE)); 10380000 IF PQEDSTYP = '1'B THEN 10390000 PUT STRING(LINEOUT) 10400000 EDIT('DIRECT ') 10410000 (A(8)); 10420000 ELSE 10430000 PUT STRING(LINEOUT) 10440000 EDIT('#',PQEREQ#,' ') 10450000 (A(1),F(5),A(1)); 10460000 10470000 I = INDEX(PQEDSN,' ')-1; 10480000 IF I < 1 THEN 10490000 I = 1; 10500000 LINEOUT = LINEOUT || 10510000 PQETSOID||' - '||SUBSTR(PQEDSN,1,I); 10520000 10530000 IF PQEMEMBR > BLANK8 THEN 10540000 LINEOUT = LINEOUT || 10550000 '('||PQEMEMBR||')'; 10560000 PUT EDIT(LINEOUT) 10570000 (COL(1),A); 10580000 10590000 DCL PJULDAT FIXED DEC(7); 10600000 DCL PTIME FIXED DEC(7); 10610000 UNSPEC(PJULDAT) = UNSPEC(PQEDATE); 10620000 UNSPEC(PTIME) = 10630000 '0000'B||SUBSTR(UNSPEC(PQETIME),1,24)||'1111'B; 10640000 PUT EDIT(' QUEUED ON',PJULDAT,PTIME) 10650000 (COL(1),A,P'ZZ99.999',P'Z99.99.99'); 10660000 10670000 CALL PQEGET(PQENEXTB,PQENEXTO,IPQE); 10680000 IF IPQE = 0 THEN RETURN; 10690000 IJ = IJ+1; 10700000 IF IJ > 60 THEN 10710000 DO; 10720000 PUT EDIT('*** PQE CHAIN ERROR ***') 10730000 (COL(1),A); 10740000 RETURN; 10750000 END; 10760000 GO TO PTRDSN1; 10770000 END PTRDSN; 10780000 10790000 1PTRFIND: PROC(IQAB_REC,IQAB_OFF) REORDER; 10800019 DCL (IQAB_REC,IQAB_OFF) FIXED BIN(31); 10810019 PTRFND1: 10820000 IF #MASK = TRUE THEN 10830000 DO; 10840000 IF ISTART >= 103 THEN 10850000 DO; 10860000 NSTART = IQAB_REC + 1; 10870019 ISTART = 1; 10880000 END; 10890000 ELSE 10900000 DO; 10910000 ISTART = IQAB_OFF + 1; 10920019 NSTART = IQAB_REC; 10930019 END; 10940000 END; 10950000 ELSE 10960000 DO; 10970000 NSTART = 1; 10980000 ISTART = 1; 10990000 END; 11000000 IPREF = INDEX(PNAME,'*')-1; 11010000 IF IPREF <= 0 THEN 11020000 IPREF = 8; 11030000 ELSE 11040000 #MASK = TRUE; 11050000 DO IQAB_REC = NSTART TO MAXQAB_REC; 11060019 DO IQAB_OFF = ISTART TO MAXQAB_OFF; 11070019 IF SUBSTR(QAB(IQAB_REC).QABPTRNM(IQAB_OFF),1,IPREF) = 11080019 SUBSTR(PNAME,1,IPREF) THEN 11090000 RETURN; 11100000 ELSE; 11110000 END; 11120000 ISTART = 1; 11130000 END; 11140000 IQAB_OFF=9999; 11150019 IQAB_REC=9999; 11160019 IF IPREF < 8 THEN 11170000 DO; 11180000 PUT EDIT(' END OF GENERIC NAMES FOR ',PNAME) 11190000 (COL(1),A,A); 11200000 #MASK = ^TRUE; 11210000 RETURN; 11220000 END; 11230000 SUBSTR(CARDIN,5,8) = BLANK8; 11240000 CALL $PTR; 11250000 PUT EDIT(' PRINTER(',PNAME,') NOT FOUND,', 11260000 'ENTER ONE OF THE ABOVE') 11270000 (COL(1),A,A,A,A); 11280000 CALL PTRGETN ; 11290000 IF PNAME = 'END' THEN SIGNAL COND(NOPTR); 11300000 GO TO PTRFND1; 11310000 END PTRFIND; 11320000 11330000 1PTRGETN: PROC REORDER; 11340000 PNAMM = SUBSTR(CARDIN,5,8); 11350000 IF PNAMM = BLANK8 THEN 11360000 DO; 11370000 PTRID: PUT EDIT(' ENTER PRINTER ID:') (COL(1),A); 11380000 GET EDIT(PNAME) (COL(1),A(8)); 11390000 CALL UPCASE(ADDR(PNAME),8); 11400000 IF SUBSTR(PNAME,1,1) < 'A' THEN 11410000 GOTO PTRID; 11420000 PNAMM = BLANK8; 11430000 END; 11440000 IF SUBSTR(PNAMM,1,1) ^= '*' & 11450000 PNAMM ^= BLANK8 THEN 11460000 PNAME = PNAMM; 11470000 PNAMM = BLANK8; 11480000 END PTRGETN; 11490000 11500000 1QAB0GET: PROC REORDER; 11510000 TIME = '00000000'B||UNSPEC(QAB(0001).QABTIME); 11520000 FFERB = QAB(0001).QABFFERB; 11530000 FFEOF = QAB(0001).QABFFEOF; 11540000 NREQ# = QAB(0001).QABNREQ#; 11550000 END QAB0GET; 11560000 11570000 QAB0PUT: PROC REORDER; 11580000 IF TIME > -1 THEN CALL BIT8GET(QAB(0001).QABTIME,TIME); 11590000 IF FFERB > -1 THEN QAB(0001).QABFFERB = FFERB; 11600000 IF FFEOF > -1 THEN QAB(0001).QABFFEOF = FFEOF; 11610000 IF NREQ# > -1 THEN QAB(0001).QABNREQ# = NREQ#; 11620000 END QAB0PUT; 11630000 11640017 QAB0RES: PROC REORDER; 11650017 11660017 QAB(0001).QABFFERB = MAXQAB_REC; 11670019 QAB(0001).QABFFEOF = 0; 11680017 QAB(0001).QABNREQ# = 1; 11690017 11700017 END QAB0RES; 11710017 11720017 QABRESET:PROC(IQABBEG,IQABEND) REORDER; 11730000 DCL (IQABBEG,IQABEND) FIXED BIN(31); 11740019 11750000 DO IQAB_REC = IQABBEG TO IQABEND; 11760019 DO IQAB_OFF = 1 TO MAXQAB_OFF; 11770019 IF QAB(IQAB_REC).QABPTRNM(IQAB_OFF) > BLANK8 THEN 11780019 PUT EDIT('RESETING PRINTER #(', 11790019 IQAB_REC,',',IQAB_OFF,') = ', 11800019 QAB(IQAB_REC).QABPTRNM(IQAB_OFF)) 11810019 (COL(1),A,F(3),A,F(3),A,A); 11820000 /* SET PRINTER OLDEST PQE @ = 0 */ 11830000 QAB(IQAB_REC).QABORQEB(IQAB_OFF), 11840019 QAB(IQAB_REC).QABORQEO(IQAB_OFF) = 0; 11850019 /* SET PRINTER LATEST PQE @ = 0 */ 11860000 QAB(IQAB_REC).QABLRQEB(IQAB_OFF), 11870019 QAB(IQAB_REC).QABLRQEO(IQAB_OFF) = 0; 11880019 END; 11890000 END; 11900003 END QABRESET; 11910000 11920000 1QVARGET: PROC(IQAB_REC,IQAB_OFF) REORDER; 11930019 DCL (IQAB_OFF,IQAB_REC) FIXED BIN(31); 11940019 ORQEB = QAB(IQAB_REC).QABORQEB(IQAB_OFF); 11950019 ORQEO = QAB(IQAB_REC).QABORQEO(IQAB_OFF); 11960019 LRQEB = QAB(IQAB_REC).QABLRQEB(IQAB_OFF); 11970019 LRQEO = QAB(IQAB_REC).QABLRQEO(IQAB_OFF); 11980019 PBFSZ = QAB(IQAB_REC).QABPBFSZ(IQAB_OFF); 11990019 PWIDE = '00000000'B|| 12000019 UNSPEC(QAB(IQAB_REC).QABPWIDE(IQAB_OFF)); 12010019 PLEN = '00000000'B|| 12020019 UNSPEC(QAB(IQAB_REC).QABPLEN(IQAB_OFF)) ; 12030019 TMARG = '00000000'B|| 12040019 UNSPEC(QAB(IQAB_REC).QABTMARG(IQAB_OFF)); 12050019 BMARG = '00000000'B|| 12060019 UNSPEC(QAB(IQAB_REC).QABBMARG(IQAB_OFF)); 12070019 HPP = '00000000'B|| 12080019 UNSPEC(QAB(IQAB_REC).QABHPP(IQAB_OFF)) ; 12090019 TYPE = '00000000'B|| 12100019 UNSPEC(QAB(IQAB_REC).QABTYPE(IQAB_OFF)) ; 12110019 PTRNM = QAB(IQAB_REC).QABPTRNM(IQAB_OFF); 12120019 END QVARGET; 12130000 12140000 1QVARPUT: PROC(IQAB_REC,IQAB_OFF) REORDER; 12150019 DCL (IQAB_OFF,IQAB_REC) FIXED BIN(31); 12160019 IF PWIDE > 132 THEN PWIDE = 132; 12170000 IF HPP > 132 THEN HPP = 132; 12180000 IF HPP = -1 THEN HPP = PWIDE; 12190000 IF PWIDE = -1 THEN PWIDE = HPP; 12200000 12210000 IF ORQEB > -1 THEN 12220019 QAB(IQAB_REC).QABORQEB(IQAB_OFF) = ORQEB; 12230019 IF ORQEO > -1 THEN 12240019 QAB(IQAB_REC).QABORQEO(IQAB_OFF) = ORQEO; 12250019 IF LRQEB > -1 THEN 12260019 QAB(IQAB_REC).QABLRQEB(IQAB_OFF) = LRQEB; 12270019 IF LRQEO > -1 THEN 12280019 QAB(IQAB_REC).QABLRQEO(IQAB_OFF) = LRQEO; 12290019 IF PBFSZ > -1 THEN 12300019 QAB(IQAB_REC).QABPBFSZ(IQAB_OFF) = PBFSZ; 12310019 IF PWIDE > -1 THEN 12320000 CALL BIT8GET(QAB(IQAB_REC).QABPWIDE(IQAB_OFF),PWIDE); 12330019 IF PLEN > -1 THEN 12340000 CALL BIT8GET(QAB(IQAB_REC).QABPLEN(IQAB_OFF),PLEN); 12350019 IF TMARG > -1 THEN 12360000 CALL BIT8GET(QAB(IQAB_REC).QABTMARG(IQAB_OFF),TMARG); 12370019 IF BMARG > -1 THEN 12380000 CALL BIT8GET(QAB(IQAB_REC).QABBMARG(IQAB_OFF),BMARG); 12390019 IF HPP > -1 THEN 12400000 CALL BIT8GET(QAB(IQAB_REC).QABHPP(IQAB_OFF),HPP); 12410019 IF TYPE > -1 THEN 12420000 CALL BIT8GET(QAB(IQAB_REC).QABTYPE(IQAB_OFF),TYPE); 12430019 IF OPTION = 'CHG' | OPTION = 'ADD' THEN 12440000 IF PTRNM > BLANK8 THEN 12450019 QAB(IQAB_REC).QABPTRNM(IQAB_OFF) = PTRNM; 12460019 SUBSTR(CARDIN,5,8) = QAB(IQAB_REC).QABPTRNM(IQAB_OFF); 12470019 END QVARPUT; 12480000 12490000 1READALL: PROC REORDER; 12500000 12510000 DCL IKEY PIC'9'; 12520000 DCL ($LASTQAB,$READALL) BIT(1); 12530012 IF ^#ENQ THEN /* IS ENQ ACTIVE */ 12540000 IF #UPDATE THEN /* NO, THEN IS IT UPDATE */ 12550000 DO; /* YES */ 12560000 RNAME = MINOR(IDD); 12570030 LRNAME = LENGTH(MINOR(IDD)); 12580030 ETYPE = 1; /* EXCL */ 12590000 CALL ENQ(MAJOR(IDD),RNAME,LRNAME,ETYPE,RC); 12600030 #ENQ = TRUE; /* SET ENQ ACTIVE */ 12610000 END; 12620000 ELSE; 12630000 ELSE; 12640000 EOF1 = ^TRUE; 12650000 $LASTQAB = ^TRUE; 12660008 $READALL = ^TRUE; 12670012 NBUF = 0; 12680008 MAXQAB_REC = 0; 12690019 READ1: DO UNTIL(EOF1); 12700000 NBUF = NBUF+1; 12710000 IKEY = NBUF-1; 12720000 12730012 IF NBUF > MAXREC THEN 12740014 LEAVE READ1; 12750014 12760008 READ FILE(QUEFILE) INTO(BUF2480(NBUF)) KEY(IKEY); 12770000 IF EOF1 = TRUE THEN 12780010 GO TO READEOF; 12790010 IF $LASTQAB ^= TRUE THEN 12800010 IF UNSPEC(SUBSTR(BUF2480(NBUF),1,1))='10000000'B THEN 12810010 DO; 12820010 MAXQAB_REC = NBUF; 12830019 $LASTQAB = TRUE; 12840010 END; 12850010 ELSE; 12860010 ELSE; 12870010 12880010 END; 12890000 READEOF: 12900010 QAB@ = ADDR(BUF2480(1)); 12910000 END READALL; 12920000 12930000 1REWRITE: PROC REORDER; 12940000 DCL I FIXED BIN(31) INIT(0); 12950000 DCL IKEY PIC'9'; 12960000 12970000 IF ^#UPDATE | ^#EDIT | ^#ENQ THEN 12980000 DO; 12990000 PUT EDIT('*** YOU CANNOT CHANGE VALUES IN LIST MODE ***') 13000000 (COL(1),A); 13010000 PUT SKIP DATA(#UPDATE,#EDIT,#ENQ); 13020000 RETURN; 13030000 END; 13040000 13050000 DO NBUF = 1 TO MAXREC; 13060016 IKEY = NBUF-1; 13070016 WRITE FILE(QUEFILE) FROM(BUF2480(NBUF)) KEYFROM(IKEY); 13080016 END; 13090000 13100000 IF #ENQ THEN 13110000 DO; 13120000 CALL DEQ(MAJOR(IDD),RNAME,LRNAME,RC); 13130030 PUT EDIT(' *** DEQ FINISHED ***') 13140000 (COL(1),A); 13150000 #ENQ = ^TRUE; /* SET NO ENQ ACTIVE */ 13160000 END; 13170000 13180000 END REWRITE; 13190000 13200000 (NOCHECK): 13210000 1UPCASE: PROC(RESPTR,J) REORDER; 13220000 DCL RESPTR PTR; 13230000 DCL REST(1024) CHAR(1) BASED(RESPTR); 13240000 DCL I FIXED BIN(31,0) INIT(0); 13250000 DCL J FIXED BIN(31,0); 13260000 DO I = 1 TO J; 13270000 UNSPEC(REST(I)) = BOOL(UNSPEC(REST(I)),'01000000'B,'0111'); 13280000 END; 13290000 13300000 END UPCASE; 13310000 13320000 1YESNO: PROC(MSG) REORDER RETURNS(BIT(1)); 13330000 DCL MSG CHAR(70) VAR; 13340000 ANS = ' '; 13350000 DO UNTIL (ANS = 'N' | ANS = 'Y'); 13360000 PUT EDIT(MSG,' Y/N:') (COL(1),A,A); 13370000 GET EDIT(ANS) (COL(1),A(1)); 13380000 CALL UPCASE(ADDR(ANS),1); 13390000 END; 13400000 IF ANS = 'Y' THEN 13410000 RETURN(TRUE); 13420000 IF ANS = 'N' THEN 13430000 RETURN(^TRUE); 13440000 END YESNO; 13450000 13460000 1SMFID: PROC REORDER RETURNS(CHAR(4)); 13470000 DCL AA CHAR(4); 13480000 DCL ADDR BUILTIN; 13490000 DCL ADDRBIN FIXED BIN(31) INIT(0); 13500000 DCL ADDRPTR PTR INIT(ADDR(ADDRBIN)); 13510000 DCL ADDRESS PTR BASED(ADDRPTR); 13520000 DCL (LOCPTR,CVTPTR,SMCPTR) 13530000 PTR; 13540000 DCL LOCBIN FIXED BIN(31) BASED(LOCPTR); 13550000 DCL 1 CVT BASED(CVTPTR), 13560000 2 CVTFILL CHAR(196), 13570000 2 SMCBIN FIXED BIN(31); 13580000 13590000 DCL 1 SMF BASED(SMCPTR), 13600000 2 SMFFILL CHAR(16), 13610000 2 SMFIDS CHAR(4); 13620000 ADDRBIN = 16; 13630000 LOCPTR = ADDRESS; 13640000 ADDRBIN = LOCBIN; 13650000 CVTPTR = ADDRESS; 13660000 ADDRBIN = SMCBIN; 13670000 SMCPTR = ADDRESS; 13680000 RETURN (SMFIDS); 13690000 13700000 END SMFID; 13710000 13720000 1$END: 13730000 CLOSE FILE(SYSPRINT),FILE(SYSIN); 13740000 CLOSE FILE(QUEFILE); 13750000 13760000 END RQUEDIT; 13770000 13780000 *PROCESS MACRO,F(I),MI('|'),NIS; 13790000 COMTIME: PROC RETURNS(CHAR(18)) REORDER; 13800000 %DCL COMPILETIME BUILTIN; 13810000 %DCL Q CHARACTER; 13820000 %Q = ''''||COMPILETIME||''''; 13830000 RETURN(Q); 13840000 END COMTIME; 13850000