PRO TITLE 'DMMPRO (IPCS) VM/370 - RELEASE 6' 00001000
*************************************************************** 00002000
* 00003000
* MODULE NAME: 00004000
* 00005000
* PROB 00006000
* 00007000
* FUNCTION: 00008000
* 00009000
* TO CREATE A PROBLEM REPORT THROUGH USER PROMPTING 00010000
* 00011000
* ATTRIBUTES: 00012000
* 00013000
* NON-REUSABLE 00014000
* NON-REENTRANT 00015000
* 00016000
* ENTRY POINTS: 00017000
* 00018000
* DMMPRO 00019000
* 00020000
* ENTRY CONDITIONS: 00021000
* 00022000
* FROM CMS WHEN PROB COMMAND ISSUED 00023000
* 00024000
* EXIT CONDITIONS: 00025000
* 00026000
* RETURN CODE IN R15 0 NORMAL COMPLETION 00027000
* 4 USER TYPED :HX (HALT EXECUTION) 00028000
* 8 UNRECOVERABLE ERROR OCCURRED 00029000
* 00030000
* CALLS TO OTHER ROUTINES: 00031000
* 00032000
* DMMWRT TO WRITE THE PROBLEM REPORT ON DISK 00033000
* DMMSEA TO LOOK FOR A DUPLICATE OF THIS PROBLEM 00034000
* 00035000
* EXTERNAL REFERENCES: 00036000
* 00037000
* NONE 00038000
* 00039000
* TABLES/WORKAREAS: 00040000
* 00041000
* LOGTBL EACH PROMPT HAS STATUS SAVED HERE FOR REPROMPTING 00042000
* SUPPAREA 5 80 BYTE RCDS FOR SUPPLEMENTARY DATA INFO 00043000
* INTAREA AREA TO STORE INTERNAL DATA FOR OTHER ROUTINES 00044000
* TEXTAREA 20 80 BYTE RECORDS FOR TEXTUAL PROBLEM DESCRIPTION 00045000
* NUCON (CMS LOW CORE DSECT) FOR CURRENT TIME AND DATE 00046000
* 00047000
* REGISTER USAGE: 00048000
* 00049000
* R13 POINTER TO SAVEAREA 00050000
* R12 BASE REG 1 00051000
* R11 BASE REG 2 00052000
* R10 BASE REG 3 00053000
* R9 ADDRESS OF EXECUTING PROMPT. SAVED FOR REPROMPTING 00054000
* R8 INTERNAL LINK REGISTER 00055000
* R7 POINTER TO PROMPTING MESSAGE 00056000
* R6 USUALLY BCT REGISTER USED BY PROMPTING CODE 00057000
* R5 WRTERM RETURN ADDRESS, USUALLY POINTS TO RDTERM 00058000
* R4,R3,R2 WORK REGISTERS 00059000
* R1 POINTER TO START OF DATA ENTERED BY USER 00060000
* R0 LENGTH OF DATA ENTERED BY USER 00061000
* R14,R15,R1 USED AS SHORT TERM WORK REGS WHEN NEEDED 00062000
* 00063000
* NOTES: 00064000
* 00065000
* ALL MESSAGES ISSUED ARE CODED USING A SPECIAL MSGP MACRO. 00066000
* MSGP MACRO PROTOTYPE IS AS FOLLOWS: 00067000
* &NAME MSGP MSG=,MIN=,MAX=,TYPE=,MORE=NO,KEY= 00068000
* MSG MESSAGE TEXT TO APPEAR AT TERMINAL 00069000
* MIN MINIMUM NUMBER OF CHARACTERS ALLOWED ON INPUT 00070000
* MAX MAXIMUM NUMBER OF CHARACTERS ALLOWED ON INPUT 00071000
* TYPE TYPE OF ALLOWED INPUT (HEX,CHAR, OR NUMERIC) 00072000
* MORE WHETHER MORE LINES FOLLOW IN THIS PROMPT BEFORE READ 00073000
* KEY KEYWORD TO BE ASSOCIATED WITH USER RESPONSE 00074000
* 00075000
* 00076000
* OPERATION: 00077000
* 00078000
* I. OLD PROBLEM 00079000
* II. NEW PROBLEM 00080000
* III. WRTERM OPERATION (INTERNAL SUBROUTINE) 00081000
* IV. RDTERM OPERATION (INTERNAL SUBROUTINE) 00082000
* V. KYINSERT OPERATION (INTERNAL SUBROUTINE) 00083000
* 00084000
* THE USER IS FIRST ASKED IF THIS IS AN ADDITIONAL REPORT 00085000
* CONCERNING AN ALREADY EXISTING PROBLEM. 00086000
* 00087000
* I. ADDITIONAL REPORT (OLD PROBLEM) 00088000
* 00089000
* 1. THE USER IS PROMPTED FOR THE PROBLEM NUMBER OF THE OLD 00090000
* PROBLEM. 00091000
* A. THE NUMBER IS TRANSLATED INTO THE FORM 'PRBNNNNN' WHERE 00092000
* NNNNN IS THE RIGHT JUSTIFIED PROBLEM NUMBER WITH LEADING 00093000
* ZEROES. 00094000
* B. THE EXISTANCE OF THE PROBLEM REPORT CORRESPONDING TO THAT 00095000
* PROBLEM NUMBER (PRBNNNNN REPORT A1) IS VERIFIED. 00096000
* C. IF THE REPORT DOES NOT EXIST THE USER IS NOTIFIED AND 00097000
* PROMPTED AGAIN FOR A PROBLEM NUMBER. 00098000
* 00099000
* 2. THE USER IS PROMPTED FOR THE NAMES AND DESCRIPTIONS OF 00100000
* FILES CONTAINING DATA HE HAS COLLECTED TO AID IN DIAGNOSIS 00101000
* OF THE PROBLEM. UP TO 5 OF THESE FILES MAY BE SPECIFIED. 00102000
* 00103000
* 3. THE USER IS PROMPTED FOR A FREE FORM (TEXT) DESCRIPTION 00104000
* OF ANY FURTHER INFORMATION HE HAS CONCERNING THE PROBLEM. 00105000
* 00106000
* 4. THE INFORMATION COLLECTED IS ADDED TO THE END OF THE 00107000
* ORIGINAL PROBLEM REPORT (PRBNNNNN REPORT A1) PRECEDED BY A 00108000
* RECORD OF THE FORM: 00109000
* *** ADDED *** MM/DD/YY HH:MM 00110000
* 00111000
* 5. RETURN TO CALLER 00112000
* 00113000
* 00114000
* 00115000
* II. NEW PROBLEM REPORT 00116000
* 00117000
* 1. THE FILE 'SUMMARY RECORD A1' IS READ TO OBTAIN THE NEXT 00118000
* SEQUENTIAL PROBLEM NUMBER. THIS NUMBER WILL BE ASSOCIATED 00119000
* WITH THIS REPORT. 00120000
* 00121000
* 2. MAINLINE PROMPTING 00122000
* A. ALL PROMPTS THROUGH LABEL 'GETFAIL' ARE EXECUTED FOR 00123000
* EACH REPORT. 00124000
* B. WHEN THE USER HAS SELECTED THE TYPE OF FAILURE AT LABEL 00125000
* 'GETFAIL' THAT PARTICULAR SUBROUTINE IS ENTERED. 00126000
* C. WHEN THE ABOVE SUBROUTINE HAS FINISHED 'TEXTENTR' IS 00127000
* BRANCHED TO AND THE TEXTUAL DESCRIPTION OF THE PROBLEM 00128000
* IS REQUESTED. 00129000
* 00130000
* 3. THE AMOUNT OF DATA COLLECTED IN THE KEYWORD, SUPPORTING 00131000
* AND TEXT AREAS IS CALCULATED AND SAVED. 00132000
* 00133000
* 4. THE USER IS TOLD THE NUMBER ASSIGNED TO THIS PROBLEM 00134000
* AND THE NUMBER INCREMENTED AND WRITTEN BACK OUT TO DISK. 00135000
* 00136000
* 5. A PARM LIST CONTAINING POINTERS TO ALL DATA COLLECTED IS 00137000
* LOADED IN R1 AND DMMWRT IS CALLED TO WRITE THE PROBLEM 00138000
* REPORT ON DISK AND TO ADD THE PROBLEM TO THE SYMPTOM 00139000
* SUMMARY. 00140000
* 00141000
* 6. USING THE SAME PARM LIST AS DMMWRT, DMMSEA IS CALLED TO 00142000
* FIND ANY PREVIOUSLY REPORTED PROBLEMS WHOSE KEYWORD DATA 00143000
* MATCHES THAT OF THE NEW PROBLEM. 00144000
* 00145000
* 7. RETURN TO CALLER 00146000
* 00147000
* 00148000
* 00149000
* III. WRTERM (COMMON TERMINAL WRITE ROUTINE) 00150000
* 1. IF THIS IS A PROMPT MESSAGE REGS 5,6, AND 7 ARE SAVED IN 00151000
* THE LOG TABLE FOR POSSIBLE REPROMPT USE. 00152000
* 00153000
* 2. THE 80 BYTE OUTPUT BUFFER IS CLEARED 00154000
* 00155000
* 3. IF 'ENTSW' IS NOT SET THE LINE NUMBER FOR REPROMPT IS 00156000
* MOVED TO THE FRONT OF THE OUTPUT BUFFER. 00157000
* SWITCH 'ENTSW' IS SET TO ALLOW ONLY THE FIRST LINE OF A 00158000
* MULTI-LINE PROMPT TO EXHIBIT A REPROMPT NUMBER. 00159000
* 00160000
* 4. THE PROMPT MESSAGE LENGTH IS FOUND AND THE MSG TEXT 00161000
* IS MOVED TO THE OUTPUT AREA AND WRITTEN TO THE TERMINAL. 00162000
* 00163000
* 5. THE 'MSGSTOP' FIELD IN THE PROMPT IS TESTED AND IF THERE 00164000
* IS ANOTHER LINE OF PROMPTING MESSAGE RETURN TO 2. IF NOT 00165000
* EXIT ON R9. 00166000
* 00167000
* IV. RDTERM (COMMON TERMINAL READ ROUTINE) 00168000
* 00169000
* 1. A READ IS ISSUED TO THE TERMINAL 00170000
* 00171000
* 2. IF NO INPUT RETURN TO CALLER 00172000
* 00173000
* 3. REMOVE LEADING BLANKS AND CHECK FOR ':HX' (HALT EXEC) 00174000
* ':L' (USER REQUESTING A REPROMPT). IF :HX GO TO HXEXIT. 00175000
* IF :L-- GO TO 5 BELOW. IF NULL EFFECTIVE INPUT RETURN. 00176000
* 00177000
* 4. REMOVE TRAILING BLANKS AND CHECK FOR DATA TYPE AND LNGTH 00178000
* RESTRICTIONS AS SPECIFIED IN THE MSGP MACRO. 00179000
* A. IF FIELD MSGMIN IS NON-ZERO CHECK FOR IMBEDDED BLANKS 00180000
* AND DON'T ACCEPT THE INPUT IF ANY ARE FOUND. IF NO BLANKS 00181000
* ARE FOUND CHECK THE LENGTH OF ENTERED DATA AGAINST THE 00182000
* VALUE IN MSGMIN AND DON'T ACCEPT THE INPUT IF LESS THAN 00183000
* MSGMIN AND FORCE A REPROMPT. IF OK GO TO B. 00184000
* B. IF FIELD MSGMAX IS NON ZERO CHECK THE LENGTH OF INPUT 00185000
* AGAINST MSGMAX AND IF THE LENGTH IS GREATER INFORM THE 00186000
* USER AND REPROMPT HIM. IF OK GO TO C. 00187000
* C. CHECK FOR DATA TYPE RESTRICTIONS (NUM OR HEX) AND IF SO 00188000
* CHECK THE DATA FOR VIOLATIONS. IF INVALID DATA INFORM THE 00189000
* USER AND FORCE A REPROMPT. IF OK RETURN. 00190000
* 5. USER REQUESTED REPROMPT. CHECK TO SEE IF REPROMPTING IS 00191000
* ALREADY IN EFFECT, AND IF SO INFORM THE USER IT IS ILLEGAL 00192000
* AND RETURN TO THE ORIGINAL PROMPT BEFORE THE PREVIOUS 00193000
* REQUEST FOR REPROMPTING. 00194000
* A. SAVE THE CURRENT STATUS (REGS 5-9) 00195000
* B. SEARCH THE LOG TABLE LIFO FOR A MATCHING REPROMPT LINE 00196000
* NUMBER. 00197000
* C. IF NOT FOUND INFORM THE USER AND RESTORE THE STATUS AND 00198000
* DISPLAY THE ORIGINAL PROMPT. 00199000
* D. IF FOUND SET REGS R5-R7 AND BRANCH TO THE REQUESTED 00200000
* PROMPT ROUTINE VIA R5. 00201000
* E. IT IS THE PROMPT ROUTINE'S ROLE TO CAUSE THE PREVIOUS 00202000
* PROMPT'S STATUS TO BE RESTORED IF THE REPROMPT WAS NOT 00203000
* OF A DECISION NATURE. IF A DECISION WAS TO BE MADE 00204000
* ON THE DATA ENTERED THE ROUTINE WILL RESET THE REPROMPT 00205000
* SWITCH AND CONTINUE FROM THAT POINT IN THE PROMPTING 00206000
* LOGIC. 00207000
* 00208000
* 00209000
* 00210000
* V. KYINSERT (INTERNAL SUBROUTINE TO PUT KEYWORDS AND 00211000
* ASSOCIATED DATA IN AN OUTPUT AREA) 00212000
***** THE DATA WILL BE IN VARIABLE BLOCKED FORMAT 00213000
* 00214000
* |TT00|LL00|..DATA1..|LL00|..DATA2..|...... 00215000
* 4 4 LL-4 4 LL-4 00216000
* 00217000
* WHERE TT IS THE TOTAL LENGTH OF THE BLOCK 00218000
* INCLUDING LENGTH FIELDS, AND EACH LL IS 00219000
* THE LENGTH OF THAT LOGICAL RCD INCLUDING 00220000
* ITS LENGTH FIELD. 00221000
* 00222000
* 00223000
* 1. THE DATA LENGTH IS TESTED AND IF ZERO RETURN TO CALLER 00224000
* 00225000
* 2. THE KEYWORD IS EXTRACTED FROM THE MSGP EXPANSION AND 00226000
* THE OUTPUT KEY AREA IS CHECKED TO SEE IF THE KEYWORD HAS 00227000
* ALREADY BEEN STORED THERE (REPROMPTING MAY CAUSE THIS TO 00228000
* HAPPEN, FOR EXAMPLE). 00229000
* 00230000
* 3. IF THE KEYWORD ALREADY EXISTS IN THE OUTPUT THE LEN OF 00231000
* NEW DATA IS COMPARED TO THE LENGTH OF THE OLD. IF THEY ARE 00232000
* THE SAME GO TO 4. 00233000
* A. IF THE NEW DATA LENGTH IS GREATER ROOM MUST BE MADE FOR 00234000
* IT BY MOVING ANY SUBSEQUENT DATA OUTWARD. GO TO 4. 00235000
* B. IF THE NEW DATA LENGTH IS LESS ANY SUBSEQUENT DATA MUST 00236000
* BE MOVED INWARD. 00237000
* 00238000
* 4. THE KEYWORD AND DATA (PREFIXED BY THE VARIABLE LNGTH 00239000
* RECORD DESCRIPTOR) ARE STORED IN THE OUTPUT AREA. 00240000
* RETURN TO CALLER. 00241000
* 00242000
* ERROR MESSAGES: 00243000
* 00244000
* DMMPRO100S ERROR 'NNN' READING FILE 'FNAME FTYPE FM' 00245000
* DMMPRO200S ERROR 'NNN' WRITING FILE 'FNAME FTYPE FM' 00246000
* 00247000
*************************************************************** 00248000
EJECT 00249000
DMMPRO CSECT @VA04250 00250000
USING DMMPRO,R15 TEMPORARY ADDRESSABILITY @VA04250 00251000
B START GO AROUND EYECATCHER @VA04250 00252000
DS 0D @VA04250 00253000
MODNAME DC C'DMMPRO ' EYECATCHER @VA04250 00254000
RELLEV DC C'REL4LEV0' RELEASE AND LEVEL @V4075A1 00255000
START STM R14,R12,12(R13) SAVE CALLER'S REGS @VA04250 00256000
LR R12,R15 SET OUR BASE @VA04250 00257000
DROP R15 @VA04250 00258000
USING DMMPRO,R12 @VA04250 00259000
USING INTSECT,R2 AREA FOR DATE,TIME,CPU, ETC. @VA04250 00260000
USING MSGCNTRL,R7 DSECT DESCRIBING MSGP DATA FORMAT@VA04250 00261000
USING NUCON,R0 CMS LOW CORE DSECT @VA04250 00262000
LR R11,R12 SET UP SECOND BASE @VA04250 00263000
LA R11,TWOK(R11) @VA04250 00264000
LA R11,TWOK(R11) @VA04250 00265000
USING DMMPRO+FOURK,R11 SECOND BASE @VA04250 00266000
LA R10,TWOK(R11) SET UP THIRD BASE @VA04250 00267000
LA R10,TWOK(R10) @VA04250 00268000
USING DMMPRO+EIGHTK,R10 THIRD BASE @VA04250 00269000
ST R13,SAVEBACK SAVE CALLER'S SAVE AREA @VA04250 00270000
LA R13,SAVEAREA POINT TO OUR OWN SAVE AREA @VA04250 00271000
*************************************************************** 00272000
* DETERMINE WHETHER THIS ACTIVITY IS TO REPORT A NEW PROBLEM OR 00273000
* PERTAINS TO AN ALREADY EXISTING PROBLEM. 00274000
*************************************************************** 00275000
EXIST BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00276000
* -------------------------- 00277000
LA R7,MSGEXIST 'THIS PERTAIN TO AN EXISTING PROB@VA04250 00278000
* -------------------------- 00279000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00280000
MVI ENTSW,ENTON REPROMPT NOT TO BE ALLOWED HERE @VA04250 00281000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00282000
CLI 0(R1),YES YES? @VA04250 00283000
BE OLDPROB OLD PROBLEM @VA04250 00284000
CLI 0(R1),NO NO? @VA04250 00285000
BNE EXIST NOT A VALID INPUT, GO REPROMPT @VA04250 00286000
MVI DBYTE,NORMAL RESET REPROMPTING IF IT IS ACTIVE@VA04250 00287000
*************************************************************** 00288000
* GET A PROBLEM NUMBER. WE'LL REWRITE IT AT END. 00289000
*************************************************************** 00290000
RPNUM LA R7,SUMMFILE POINT TO FN FT FM OF PROB NUMBER @VA04250 00291000
FSREAD (R7),RECNO=1,ERROR=SUMERRR,BSIZE=80, @VA04250X00292000
BUFFER=PNUMIN @VA04250 00293000
FSCLOSE (R7) @VA04250 00294000
PNRETRY MVC XXXXX(PLENGTH),PNUMIN SAVE REPORT PROBLEM NUMBER@VA04250 00295000
RPNUM2 L R2,INTPT POINT TO INTERNAL DATA AREA @VA04250 00296000
MVC INTPNUM(PLENGTH),XXXXX SAVE PROBLEM NUMBER @VA04250 00297000
LA R7,PRBXXXXX POINT FN FT FM OF REPORT @VA04250 00298000
FSSTATE (R7) DOES THE REPORT ALREADY EXIST? @VA04250 00299000
LTR R15,R15 CHECK RETURN CODE @VA04250 00300000
BNZ MAINLINE CONTINUE IF REPORT DOES NOT EXIST@VA04250 00301000
MVI PNSWITCH,PNSWON INDICATE LOOKING FOR OPEN NUMBER@VA04250 00302000
B PNUPDATE GO UPDATE PROBLEM NUMBER @VA04250 00303000
*************************************************************** 00304000
* MAINLINE PROMPTING ROUTINE 00305000
*************************************************************** 00306000
MAINLINE CLI OLDSW,OLDON PROCESSING AN OLD PROBLEM? @VA04250 00307000
BE GETSDATA YES, GO GET SUPPORTING DATA FIRST@VA04250 00308000
NEWPROB BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00309000
* -------------------------- 00310000
LA R7,MSGPCPU 'PROBLEM OCCUR ON THIS CPU?' @VA04250 00311000
* -------------------------- 00312000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00313000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00314000
MVI DBYTE,NORMAL THIS IS A DECISION, DON'T REPRMPT@VA04250 00315000
CLI 0(R1),NO NOT THIS CPU @VA04250 00316000
BE GETCPU GO PROMPT FOR IT @VA04250 00317000
CLI 0(R1),YES YES? @VA04250 00318000
BNE NEWPROB NO, GO FORCE VALID INPUT @VA04250 00319000
*************************************************************** 00320000
* USING STIDP INSTRUCTION GET CPU TYPE AND SERIAL 00321000
*************************************************************** 00322000
STIDP WKDWD GET THIS CPU TYPE AND SERIAL. @VA04250 00323000
L R2,INTPT POINT TO INTERNAL DATA AREA @VA04250 00324000
L R3,WKDWD2 GET TYPE OF CPU. @VA04250 00325000
SRL R3,12 POSITION IT @VA04250 00326000
ST R3,WKDWD2 SET UP FOR UNPACK @VA04250 00327000
OI WKDWDEND,PACKMASK ALL SET NOW @VA04250 00328000
UNPK INTCPUT(THREE),WKDWD+SIX(TWO) GET READABLE TYPE @VA04250 00329000
MVI WKDWD2,PACKMASK PREPARE SERIAL FOR UNPACK @VA04250 00330000
UNPK WKDWD(SEVEN),WKDWD+DISP1(DISP4) GET SERIAL @VA04250 00331000
MVI WKDWD,CHARZERO SIX DIGITS OF SERIAL SO PREFIX @VA04250 00332000
MVC INTSER,WKDWD MOVE SER OUT @VA04250 00333000
B GETSDATA CONTINUE INTERNAL DATA @VA04250 00334000
*************************************************************** 00335000
* PROMPT FOR CPU TYPE AND SERIAL 00336000
*************************************************************** 00337000
GETCPU BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00338000
* -------------------------- 00339000
LA R7,MSGCPU 'ENTER CPU TYPE' @VA04250 00340000
* -------------------------- 00341000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00342000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00343000
LTR R0,R0 ANYTHING ENTERED @VA04250 00344000
BZ GETCPU NO, FORCE HIM TO ENTER @VA04250 00345000
L R2,INTPT ADDRESSABILITY FOR INTMNT AREA @VA04250 00346000
MVC INTCPUT,0(R1) MOVE CPU TYPE TO OUTPUT @VA04250 00347000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00348000
BE RESTORE YES, GO RESTORE @VA04250 00349000
GETSER BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00350000
* -------------------------------- 00351000
LA R7,MSGSER 'ENTER CPU SERIAL' @VA04250 00352000
* -------------------------------- 00353000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00354000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00355000
LTR R0,R0 ANYTHING ENTERED? @VA04250 00356000
BZ GETSER FORCE ENTRY @VA04250 00357000
L R2,INTPT ADDRESSABILITY FOR INTSECT @VA04250 00358000
MVC INTSER,0(R1) MOVE IT TO OUTPUT (INTSECT) @VA04250 00359000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00360000
BE RESTORE YES, GO RESTORE @VA04250 00361000
*************************************************************** 00362000
* GET SUPPLEMENTARY FILES AND DESCRIPTIONS 00363000
*************************************************************** 00364000
GETSDATA BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00365000
SR R2,R2 ZERO WORK @VA04250 00366000
L R3,SUPPLNTH POINT TO CUMMULATIVE OUT LENGTH @VA04250 00367000
STH R2,0(R3) CLEAR IT IN CASE OF REPROMPT @VA04250 00368000
L R2,SUPPPT POINT TO SUPPORTING DATA AREA @VA04250 00369000
LA R3,FIVECARD CLEAR 5 'CARDS' @VA04250 00370000
MVI 0(R2),BLANK BLANK TO FIRST BYTE @VA04250 00371000
GETSCLR MVC DISP1(CARDLEN,R2),0(R2) CLEAR ALL OF 'CARD' @VA04250 00372000
LA R2,CARDLEN(R2) POINT TO NEXT AREA TO BE CLEARED @VA04250 00373000
BCT R3,GETSCLR CLEAR ALL 5 @VA04250 00374000
MVC SUPPCURR,SUPPPT RESET CURR PTR IF REPROMPT @VA04250 00375000
MVC SUPPBACK,SUPPPT RESET TEMP PTR IF REPROMPT @VA04250 00376000
* ---------------------------- 00377000
LA R7,MSGSDATA 'ENTER LOCATION OF SUPPORT DATA' @VA04250 00378000
* ---------------------------- 00379000
LA R9,GETS1 DON'T DO READ YET @VA04250 00380000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00381000
GETS1 BALR R5,0 RETURN ADDRESS FOR REPROMPT @VA04250 00382000
* ---------------------------- 00383000
LA R7,MSGSDAT2 'ENTER FN FT FM + DESCRIP OR NULL@VA04250 00384000
* ---------------------------- 00385000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00386000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00387000
CLI DBYTE,REPROMPT IN REPROMPTING? @VA04250 00388000
BNE SUPPD2 NO @VA04250 00389000
MVC SUPPCURR,SUPPBACK RESET CURRENT PTR TO PREVIOUS @VA04250 00390000
L R2,SUPPCURR POINT TO RECORD @VA04250 00391000
MVI 0(R2),BLANK PREP TO CLEAR LAST ENTERED DATA @VA04250 00392000
MVC DISP1(CARDLEN-DISP1,R2),0(R2) CLEAR IT @VA04250 00393000
SUPPD2 LTR R0,R0 ANYTHING ENTERED? @VA04250 00394000
BNZ SUPPD3 YES @VA04250 00395000
SUPPD4 L R2,SUPPLNTH POINT TO HALFWD LENGTH FIELD @VA04250 00396000
L R3,SUPPPT POINT TO SUPPORTING DATA AREA @VA04250 00397000
L R4,SUPPCURR POINT TO CURRENT POSITION @VA04250 00398000
SR R4,R3 GET LENGTH @VA04250 00399000
STH R4,0(R2) STORE IT FOR LATER @VA04250 00400000
B DBYTECHK GO CHECK IF IN REPROMPT @VA04250 00401000
SUPPD3 LR R2,R0 SAVE LENGTH @VA04250 00402000
L R3,SUPPCURR GET CURRENT SUPP POINTER @VA04250 00403000
BCTR R2,0 FOR EXECUTE @VA04250 00404000
EX R2,SUPPMVC MOVE USER ENTERED DATA TO OUTPUT @VA04250 00405000
MVC SUPPBACK,SUPPCURR SAVE PTR TO THIS FOR REPROMPT @VA04250 00406000
LA R3,CARDLEN(R3) POINT TO NEXT 'CARD' OF OUTPUT @VA04250 00407000
ST R3,SUPPCURR SAVE NEXT AVAIL SLOT FOR OUTPUT @VA04250 00408000
CLI DBYTE,REPROMPT IN REPROMPTING? @VA04250 00409000
BE SUPPD4 YES, GO RESTORE TO PREV PROMPT @VA04250 00410000
L R2,SUPPEND POINT TO END OF SUPP DATA AREA @VA04250 00411000
CR R3,R2 AT END YET? @VA04250 00412000
BL GETS1 NO, ALLOW 5 CARDS OF SUPP DATA @VA04250 00413000
B SUPPD4 GO CLEAN UP @VA04250 00414000
SUPPMVC MVC 0(0,R3),0(R1) SUBJECT OF EXECUTE @VA04250 00415000
DBYTECHK CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00416000
BE RESTORE YES, GO RESTORE @VA04250 00417000
CLI OLDSW,OLDON PROCESSING AN OLD PROBLEM? @VA04250 00418000
BE TEXTENTR YES, GO GET TEXT NEXT @VA04250 00419000
*************************************************************** 00420000
* GET SEVERITY TO BE ASSIGNED TO THIS PROBLEM 00421000
*************************************************************** 00422000
GETSEV BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00423000
* ---------------------------- 00424000
LA R7,MSGSEV 'ENTER SEVERITY CODE (1 TO 4)' @VA04250 00425000
* ---------------------------- 00426000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00427000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00428000
L R2,INTPT ADDRESSABILITY FOR INTSECT @VA04250 00429000
LTR R0,R0 ANYTHING ENTERED? @VA04250 00430000
BZ SVDFLT NO, GO USE DEFAULT @VA04250 00431000
CLI 0(R1),FOUR CHECK GT 4 SEVERITY @VA04250 00432000
BH GETSEV THAT'S NO GOOD @VA04250 00433000
CLI 0(R1),ONE CHECK EBCDIC LESS THAN 1 @VA04250 00434000
BL GETSEV THAT'S NO GOOD EITHER @VA04250 00435000
MVC INTSEV,0(R1) STORE IT IN INTERNAL AREA @VA04250 00436000
B SVDB GO CHECK IF REPROMPTING @VA04250 00437000
SVDFLT MVI INTSEV,SEVDFLT DEFAULT SEVERITY OF BLANK @VA04250 00438000
SVDB CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00439000
BE RESTORE YES, GO RESTORE @VA04250 00440000
*************************************************************** 00441000
* ASK WHETHER A BYPASS IS REQUIRED FOR THIS PROBLEM 00442000
*************************************************************** 00443000
GETBYPAS BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00444000
* ---------------------------- 00445000
LA R7,MSGBYPAS 'IS BYPASS REQUESTED? @VA04250 00446000
* ---------------------------- 00447000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00448000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00449000
L R2,INTPT ADDRESSABILITY FOR INTSECT @VA04250 00450000
LTR R0,R0 ANYTHING ENTERED? @VA04250 00451000
BZ BYDFLT NO, USE DEFAULT @VA04250 00452000
CLI 0(R1),NO N? (NO?) @VA04250 00453000
BE BYMVC OR @VA04250 00454000
CLI 0(R1),YES Y? (YES?) @VA04250 00455000
BNE GETBYPAS ONLY ARE VALID. @VA04250 00456000
BYMVC MVC INTBYPS,0(R1) MOVE WHAT WAS ENTERED TO INTSECT @VA04250 00457000
B BYDB GO CHECK IF REPROMPTING @VA04250 00458000
BYDFLT MVI INTBYPS,NO DEFAULT OF NO @VA04250 00459000
BYDB CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00460000
BE RESTORE YES, GO RESTORE @VA04250 00461000
*************************************************************** 00462000
* GET COMPONENT ID (EG 5749DMS00) 00463000
*************************************************************** 00464000
GETCID BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00465000
* ---------------------------- 00466000
LA R7,MSGCID 'ENTER COMPONENT ID' @VA04250 00467000
* ---------------------------- 00468000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00469000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00470000
BAL R8,KYINSERT PUT CID IN KEYWORDED AREA @VA04250 00471000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00472000
BE RESTORE YES, GO RESTORE @VA04250 00473000
*************************************************************** 00474000
* GET PLC LEVEL OF SYSTEM 00475000
*************************************************************** 00476000
GETPLC BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00477000
* ---------------------------- 00478000
LA R7,MSGPLC 'ENTER PLC LEVEL' @VA04250 00479000
* ---------------------------- 00480000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00481000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00482000
LTR R0,R0 ANYTHING ENTERED? @VA04250 00483000
BZ PLCDBYT NO @VA04250 00484000
LA R2,PLCCNT THREE CHAR PLC LEVEL @VA04250 00485000
CR R2,R0 THREE CHARS ENTERED? @VA04250 00486000
BE PLC3 YES @VA04250 00487000
BCTR R1,0 CHECK FOR TWO THEN @VA04250 00488000
MVI 0(R1),CHARZERO PUT IN LEADING ZERO @VA04250 00489000
BCTR R2,0 SUBTRACT 1 FROM R2 @VA04250 00490000
CR R2,R0 IS IT INDEED 2? @VA04250 00491000
BE PLC1 THAT'S NICE @VA04250 00492000
BCTR R1,0 ONE MORE BYTE IN FRONT OF DATA @VA04250 00493000
MVI 0(R1),CHARZERO INSERT ANOTHER LEADING ZERO @VA04250 00494000
PLC1 LA R0,PLCCNT THE RESULT IS THREE CHARS ALWAYS @VA04250 00495000
PLC3 BAL R8,KYINSERT PUT PLC IN KEYWORDED AREA @VA04250 00496000
L R2,INTPT POINT TO INTERNAL DATA AREA @VA04250 00497000
MVC INTPLC,0(R1) SAVE PLC LEVEL OF SYSTEM @VA04250 00498000
PLCDBYT CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00499000
BE RESTORE YES, GO RESTORE @VA04250 00500000
*************************************************************** 00501000
* GET SCP LEVEL (RELEASE LEVEL) OF SYSTEM 00502000
*************************************************************** 00503000
GETSCPLV BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00504000
* ---------------------------- 00505000
LA R7,MSGSCP 'ENTER SCP LEVEL' @VA04250 00506000
* ---------------------------- 00507000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00508000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00509000
LTR R0,R0 ANYTHING ENTERED? @VA04250 00510000
BZ SCPDBYT NO @VA04250 00511000
LA R2,SCPCNT THREE CHARS OF SCP LEVEL DESIRED @VA04250 00512000
CR R0,R2 DID HE ENTER 3 CHARACTERS? @VA04250 00513000
BE SCP3 SURE NUFF @VA04250 00514000
MVI TWO(R1),CHARZERO TRAILING ZERO @VA04250 00515000
BCTR R2,0 SUBTRACT ONE FROM R2 @VA04250 00516000
CR R0,R2 DID HE ENTER 2 CHARACTERS? @VA04250 00517000
BE SCP1 YES @VA04250 00518000
MVI DISP1(R1),CHARZERO ANOTHER TRAILING ZERO @VA04250 00519000
SCP1 LA R0,SCPCNT THE RESULT IS ALWAYS THREE CHARS @VA04250 00520000
SCP3 BAL R8,KYINSERT GO PUT RESULT IN KEYWORDED AREA @VA04250 00521000
SCPDBYT CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00522000
BE RESTORE YES, GO RESTORE @VA04250 00523000
*************************************************************** 00524000
* GET DATE FAILURE OCCURRED 00525000
*************************************************************** 00526000
GETDATE BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00527000
* ---------------------------- 00528000
LA R7,MSGDATE 'ENTER DATE OF FAILURE' @VA04250 00529000
* ---------------------------- 00530000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00531000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00532000
LTR R0,R0 ANYTHING ENTERED? @VA04250 00533000
BZ DATDBYT NO @VA04250 00534000
CLI TWO(R1),SLASH FORCE USER TO ENTER MM/DD/YY @VA04250 00535000
BE GETDATE1 HE DID GOOD SO FAR @VA04250 00536000
B GETDERR TELL HIM THE ERROR OF HIS WAYS @VA04250 00537000
GETDATE1 CLI FIVE(R1),SLASH FORMAT SHOULD BE MM/DD/YY @VA04250 00538000
BE GETDATE2 AND A MERRY OLD SOUL WAS HE @VA04250 00539000
GETDERR MVI ENTSW,ENTON INHIBIT REPROMPT NUMBER @VA04250 00540000
* ---------------------------- 00541000
LA R7,MSGERR7 'ENTER EXACTLY AS SHOWN' @VA04250 00542000
* ---------------------------- 00543000
BAL R9,WRTERM GO TELL USER @VA04250 00544000
B GETDATE GO BACK AND ASK AGAIN @VA04250 00545000
GETDATE2 L R2,INTPT ADDRESSABILITY FOR INTSECT @VA04250 00546000
MVC INTED,0(R1) MOVE DATA TO OUTPUT (INTSECT) @VA04250 00547000
DATDBYT CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00548000
BE RESTORE YES, GO RESTORE @VA04250 00549000
*************************************************************** 00550000
* GET MAJOR DESCRIPTION OF FAILURE 00551000
*************************************************************** 00552000
GETFAIL BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00553000
* ---------------------------- 00554000
LA R7,MSGFAIL 'SELECT KEYWORD... MSG ABEND ETC'@VA04250 00555000
* ---------------------------- 00556000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00557000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00558000
LTR R0,R0 ANYTHING ENTERED? @VA04250 00559000
BZ GETFAIL USER MUST SELECT SOMETHING @VA04250 00560000
CLI DBYTE,REPROMPT IN REPROMPT? @VA04250 00561000
BNE GETFAIL1 NO @VA04250 00562000
L R2,KYCURRPT GET CURRENT POINTER IN KEY OUTPUT@VA04250 00563000
L R3,KYREST GET VALUE FROM BEFORE @VA04250 00564000
CR R2,R3 SAME? @VA04250 00565000
BE GETFAIL1 YES, NO OUTPUT YET @VA04250 00566000
SR R2,R3 GET DIFFERENCE @VA04250 00567000
BCTR R2,0 SET FOR EXECUTE @VA04250 00568000
EX R2,KYRESET RESET OUTPUT DATA @VA04250 00569000
ST R3,KYCURRPT RESTORE OLD POINTER @VA04250 00570000
GETFAIL1 MVC KYREST,KYCURRPT SAVE LOCATION IN KEY OUT AREA @VA04250 00571000
MVI DBYTE,NORMAL CONTINUE FROM HERE IF REPROMPT @VA04250 00572000
CLC 0(CKLN2,R1),ABEND ABE? (ABEND) @VA04250 00573000
BE ABERTN YES @VA04250 00574000
CLC 0(CKLN2,R1),LOOP LOO? (LOOP) @VA04250 00575000
BE LOORTN YES @VA04250 00576000
CLC 0(CKLN1,R1),MSG MSG? (MESSAGE) @VA04250 00577000
BE MSGRTN YES @VA04250 00578000
CLC 0(CKLN2,R1),INCORR INC? (INCORROUT) @VA04250 00579000
BE INCRTN YES @VA04250 00580000
CLC 0(CKLN2,R1),WAIT WAI? (WAIT) @VA04250 00581000
BE WAIRTN YES @VA04250 00582000
CLC 0(CKLN2,R1),INFORM INF? (INFORMATION) @VA04250 00583000
BE INFRTN YES @VA04250 00584000
CLC 0(CKLN2,R1),DOCUM DOC? (DOCUMENTATION) @VA04250 00585000
BE DOCRTN YES @VA04250 00586000
CLC 0(CKLN2,R1),PERFORM PER? (PERFORMANCE) @VA04250 00587000
BE PERRTN YES @VA04250 00588000
B GETFAIL INVALID INPUT, GO ASK AGAIN @VA04250 00589000
INTMVC MVC 0(0,R4),0(R1) @VA04250 00590000
KYRESET XC 0(0,R3),0(R3) EXECUTED TO CLEAR INVAL KEYS @VA04250 00591000
************************************************************* 00592000
EJECT 00593000
************************************************************* 00594000
* ABEND TYPE REPORT 00595000
************************************************************* 00596000
ABERTN BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00597000
LA R0,L'ABEND LENGTH OF 'ABEND' @VA04250 00598000
LA R1,ABEND POINTER TO CONSTANT OF 'ABEND' @VA04250 00599000
BAL R8,KYINSERT GO PUT 'ABEND' IN VMFAILURE KYWD @VA04250 00600000
* ---------------------------- 00601000
LA R7,MSGENV 'ENTER OPERATING ENVIRONMENT' @VA04250 00602000
* ---------------------------- 00603000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00604000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00605000
BAL R8,KYINSERT PUT ENTERED DATA IN KEY AREA @VA04250 00606000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00607000
BE RESTORE YES, GO RESTORE @VA04250 00608000
ABEABCOD BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00609000
* ---------------------------- 00610000
LA R7,MSGABCOD 'ENTER ABEND CODE. EG 0CX' @VA04250 00611000
* ---------------------------- 00612000
ABEPRMT LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00613000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00614000
LTR R0,R0 DID USER ENTER ANYTHING? @VA04250 00615000
BZ ABEPRMT NO, FORCE ENTRY OF SOMETHING @VA04250 00616000
S R1,=F'5' WE'LL PREFIX THIS WITH 'ABEND' @VA04250 00617000
MVC 0(L'ABEND,R1),ABEND MOVE IN DATA OF 'ABEND' @VA04250 00618000
A R0,=F'5' INCREASE DATA COUNT BY L'ABEND @VA04250 00619000
BAL R8,KYINSERT GO PUT IN KEY AREA @VA04250 00620000
ABEDB1 CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00621000
BE RESTORE YES, GO RESTORE @VA04250 00622000
ABEFMOD BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00623000
* ---------------------------- 00624000
LA R7,MSGFMOD 'ENTER FAILING MODULE IF KNOWN' @VA04250 00625000
* ---------------------------- 00626000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00627000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00628000
BAL R8,KYINSERT GO PUT DATA IN KEY AREA @VA04250 00629000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00630000
BE RESTORE YES, GO RESTORE @VA04250 00631000
ABEDISP BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00632000
* ---------------------------- 00633000
LA R7,MSGDSP 'ENTER DISPLAC WITHIN FAIL MOD' @VA04250 00634000
* ---------------------------- 00635000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00636000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00637000
BAL R8,KYINSERT GO PUT DATA IN KEY AREA @VA04250 00638000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00639000
BE RESTORE YES, GO RESTORE @VA04250 00640000
ABECALL BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00641000
* ---------------------------- 00642000
LA R7,MSGCALL 'ENTER CALLING MODULE IF KNOWN' @VA04250 00643000
* ---------------------------- 00644000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00645000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00646000
BAL R8,KYINSERT GO PUT DATA IN KEY AREA @VA04250 00647000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00648000
BE RESTORE YES, GO RESTORE @VA04250 00649000
ABECMS BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00650000
* ---------------------------- 00651000
LA R7,MSGCMD 'ENTER COMMAND WHICH CAUSED FAIL'@VA04250 00652000
* ---------------------------- 00653000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00654000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00655000
BAL R8,DASHIN INSERT DASHES @VA04250 00656000
BAL R8,KYINSERT GO PUT DATA IN KEY AREA @VA04250 00657000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00658000
BE RESTORE YES, GO RESTORE @VA04250 00659000
B TEXTENTR GO GET TEXT OF PROBLEM @VA04250 00660000
************************************************************* 00661000
EJECT 00662000
************************************************************* 00663000
* MSG KEYWORD PROCESSING 00664000
************************************************************* 00665000
MSGRTN BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00666000
LA R0,L'MSG LENGTH OF DATA @VA04250 00667000
LA R1,MSG POINT TO DATA @VA04250 00668000
BAL R8,KYINSERT PUT VMFAILURE IN OUTPUT @VA04250 00669000
* ---------------------------- 00670000
LA R7,MSGMSG 'ENTER MESSAGE NUMBER' @VA04250 00671000
* ---------------------------- 00672000
MESPRMT LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00673000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00674000
LTR R0,R0 ANYTHING ENTERED? @VA04250 00675000
BZ MESPRMT NO, FORCE ENTRY OF MESSAGE @VA04250 00676000
S R1,=F'2' WE'LL PREFIX THIS WITH 'MS' (MSG)@VA04250 00677000
MVC 0(L'MSG,R1),MSG MOVE IN DATA OF 'MS' @VA04250 00678000
A R0,=F'2' INCREASE DATA COUNT BY L'MSG @VA04250 00679000
BAL R8,KYINSERT GO PUT IN KEY AREA @VA04250 00680000
MESDB1 CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00681000
BE RESTORE YES, GO RESTORE @VA04250 00682000
MESENV BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00683000
* ---------------------------- 00684000
LA R7,MSGENV 'ENTER OPERATING ENVIRONMENT' @VA04250 00685000
* ---------------------------- 00686000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00687000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00688000
BAL R8,KYINSERT GO PUT IN KEY AREA @VA04250 00689000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00690000
BE RESTORE YES, GO RESTORE @VA04250 00691000
MESRCODE BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00692000
* ---------------------------- 00693000
LA R7,MSGRCODE 'ENTER RETURN CODE IF APPLICABLE'@VA04250 00694000
* ---------------------------- 00695000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00696000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00697000
BAL R8,KYINSERT GO PUT IN KEY AREA @VA04250 00698000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00699000
BE RESTORE YES, GO RESTORE @VA04250 00700000
MESPREV BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00701000
* ---------------------------- 00702000
LA R7,MSGPREV 'ENTER PREVIOUS MESSAGE NUMBER' @VA04250 00703000
* ---------------------------- 00704000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00705000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00706000
BAL R8,KYINSERT GO PUT DATA IN KEY AREA @VA04250 00707000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00708000
BE RESTORE YES, GO RESTORE @VA04250 00709000
MESCMD BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00710000
* ---------------------------- 00711000
LA R7,MSGCMD 'ENTER CMD WHICH CAUSED FAILURE' @VA04250 00712000
* ---------------------------- 00713000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00714000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00715000
BAL R8,DASHIN INSERT DASHES @VA04250 00716000
BAL R8,KYINSERT GO PUT DATA IN KEY AREA @VA04250 00717000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00718000
BE RESTORE YES, GO RESTORE @VA04250 00719000
B TEXTENTR GO ASK USER FOR TEXTUAL INFO @VA04250 00720000
************************************************************* 00721000
EJECT 00722000
************************************************************* 00723000
* DOCUMENTATION TYPE REPORT 00724000
************************************************************* 00725000
DOCRTN BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00726000
LA R0,L'DOCUM LENGTH OF DATA @VA04250 00727000
LA R1,DOCUM POINTER TO DATA @VA04250 00728000
BAL R8,KYINSERT PUT VMFAILURE=DOCUMENTATION @VA04250 00729000
* ---------------------------- 00730000
LA R7,MSGDOC 'ENTER PUB PLC OR PTF FICHE' @VA04250 00731000
* ---------------------------- 00732000
DOCPRMT LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00733000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00734000
LTR R0,R0 ANYTHING ENTERED? @VA04250 00735000
BZ DOCPRMT NO, FORCE A CHOICE @VA04250 00736000
BAL R8,KYINSERT PUT IN KEY AREA @VA04250 00737000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00738000
BE RESTORE YES, GO RESTORE @VA04250 00739000
DOCPUB BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00740000
* ---------------------------- 00741000
LA R7,MSGPUB 'ENTER PUBLICATION NUMBER' @VA04250 00742000
* ---------------------------- 00743000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00744000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00745000
BAL R8,KYINSERT GO PUT DATA IN KEY AREA @VA04250 00746000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00747000
BE RESTORE YES, GO RESTORE @VA04250 00748000
DOCPAGE BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00749000
* ---------------------------- 00750000
LA R7,MSGPAGE 'ENTER PAGE NUMBER' @VA04250 00751000
* ---------------------------- 00752000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00753000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00754000
BAL R8,KYINSERT GO PUT KEY AND DATA IN KEY AREA @VA04250 00755000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00756000
BE RESTORE YES, GO RESTORE @VA04250 00757000
B TEXTENTR GO ASK USER FOR TEXTUAL INFO @VA04250 00758000
************************************************************* 00759000
EJECT 00760000
************************************************************* 00761000
* INCORRECT OUTPUT TYPE REPORT 00762000
************************************************************* 00763000
INCRTN BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00764000
LA R0,L'INCORR LENGTH OF DATA @VA04250 00765000
LA R1,INCORR POINTER TO DATA @VA04250 00766000
BAL R8,KYINSERT VMFAILURE=INCORROUT IN KEY AREA @VA04250 00767000
* ---------------------------- 00768000
LA R7,MSGENV 'ENTER OPERATING ENVIRONMENT' @VA04250 00769000
* ---------------------------- 00770000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00771000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00772000
BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00773000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00774000
BE RESTORE YES, GO RESTORE @VA04250 00775000
INCINC BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00776000
* ---------------------------- 00777000
LA R7,MSGINC 'SELECT DUP,MISSING,FUNCT,ETC.' @VA04250 00778000
* ---------------------------- 00779000
INCPRMT LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00780000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00781000
LTR R0,R0 ANYTHING ENTERED? @VA04250 00782000
BZ INCINC NO, FORCE A CHOICE @VA04250 00783000
LA R2,INCSPELL POINT TO ALLOWED INPUT VALUES @VA04250 00784000
INCLOOP CLC 0(INCLEN,R2),0(R1) VALID INPUT FOUND? @VA04250 00785000
BE INCKYIN YES @VA04250 00786000
LA R2,INCLEN(R2) POINT TO NEXT ALLOWED INPUT VALUE@VA04250 00787000
CLI 0(R2),INCEND ANY MORE VALID ENTRIES? @VA04250 00788000
BE INCINC NO, GO PROMPT AGAIN @VA04250 00789000
B INCLOOP CONTINUE CHECKING @VA04250 00790000
INCKYIN BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00791000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00792000
BE RESTORE YES, GO RESTORE @VA04250 00793000
INCCMD BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00794000
* ---------------------------- 00795000
LA R7,MSGCMD 'ENTER COMMAND WHICH CAUSED FAIL'@VA04250 00796000
* ---------------------------- 00797000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00798000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00799000
BAL R8,DASHIN INSERT DASHES @VA04250 00800000
BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00801000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00802000
BE RESTORE YES, GO RESTORE @VA04250 00803000
INCDEV BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00804000
* ---------------------------- 00805000
LA R7,MSGDEV 'ENTER DEVICE TYPE IF APPLIC' @VA04250 00806000
* ---------------------------- 00807000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00808000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00809000
BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00810000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00811000
BE RESTORE YES, GO RESTORE @VA04250 00812000
B TEXTENTR GO ASK USER FOR TEXTUAL INFO @VA04250 00813000
************************************************************* 00814000
EJECT 00815000
************************************************************* 00816000
* INFORMATION TYPE REPORT 00817000
************************************************************* 00818000
INFRTN BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00819000
LA R0,L'INFORM LENGTH OF DATA @VA04250 00820000
LA R1,INFORM POINTER TO DATA @VA04250 00821000
BAL R8,KYINSERT VMFAILURE=INFORMATION TO KEY AREA@VA04250 00822000
B TEXTENTR GO ASK USER FOR TEXTUAL INFO @VA04250 00823000
************************************************************* 00824000
EJECT 00825000
************************************************************* 00826000
* LOOP TYPE REPORT 00827000
************************************************************* 00828000
LOORTN BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00829000
LA R0,L'LOOP LENGTH OF DATA @VA04250 00830000
LA R1,LOOP POINTER TO DATA @VA04250 00831000
BAL R8,KYINSERT VMFAILURE=LOOP TO KEY AREA @VA04250 00832000
* ---------------------------- 00833000
LA R7,MSGENV 'ENTER OPERATING ENVIRONMENT' @VA04250 00834000
* ---------------------------- 00835000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00836000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00837000
BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00838000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00839000
BE RESTORE YES, GO RESTORE @VA04250 00840000
LOOSTATE BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00841000
* ---------------------------- 00842000
LA R7,MSGSTATE 'ENTER DISABLED OR ENABLED' @VA04250 00843000
* ---------------------------- 00844000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00845000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00846000
CLC STATE1,0(R1) ENABLED? @VA04250 00847000
BE LOOKY YES, O.K. @VA04250 00848000
CLC STATE2,0(R1) DISABLED? @VA04250 00849000
BNE LOOSTATE NO, GO FORCE VALID RESPONSE @VA04250 00850000
LOOKY BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00851000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00852000
BE RESTORE YES, GO RESTORE @VA04250 00853000
LOOMODS BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00854000
* ---------------------------- 00855000
LA R7,MSGLMOD 'ENTER KNOWN MODULES WITHIN LOOP'@VA04250 00856000
* ---------------------------- 00857000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00858000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00859000
BAL R8,DASHIN INSERT DASHES BETWEEN ENTRIES @VA04250 00860000
BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00861000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00862000
BE RESTORE YES, GO RESTORE @VA04250 00863000
L R6,TEXTCURR ADDR OF WHERE LOOP ADDRS WILL GO @VA04250 00864000
LOOADDRS BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00865000
* ---------------------------- 00866000
LA R7,MSGLADDR 'ENTER LOOP ADDRESSES' @VA04250 00867000
* ---------------------------- 00868000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00869000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00870000
BAL R8,DASHIN INSERT DASHES BETWEEN ENTRIES @VA04250 00871000
LTR R0,R0 ANYTHING ENTERED? @VA04250 00872000
BZ LOOBYT NO @VA04250 00873000
LR R2,R6 POINTER TO WHERE OUTPUT IS TO GO @VA04250 00874000
MVC 0(FIFTEEN,R2),=C'LOOP ADDRESSES=' @VA04250 00875000
LR R3,R0 GET LENGTH OF DATA @VA04250 00876000
BCTR R3,0 SET FOR EXECUTE @VA04250 00877000
EX R3,LOOMVC DO DATA MOVE @VA04250 00878000
LA R2,CARDLEN(R2) 80 BYTE RECORDS IN TEXT AREA @VA04250 00879000
ST R2,TEXTCURR SAVE NEW CURRENT POINTER @VA04250 00880000
B LOOBYT CONTINUE @VA04250 00881000
LOOMVC MVC FIFTEEN(0,R2),0(R1) SUBJECT OF EXECUTE @VA04250 00882000
LOOBYT CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00883000
BE RESTORE YES, GO RESTORE @VA04250 00884000
L R6,TEXTCURR POINT TO NEXT OUTPUT RECORD @VA04250 00885000
LOOCPSW BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00886000
* ---------------------------- 00887000
LA R7,MSGCPSW 'ENTER CURRENT PSW' @VA04250 00888000
* ---------------------------- 00889000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00890000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00891000
LR R2,R6 POINT TO TEXT AREA @VA04250 00892000
LTR R0,R0 ANYTHING ENTERED? @VA04250 00893000
BZ LOODBYT NO @VA04250 00894000
MVC 0(CPSWLN,R2),=C'CURRENT PSW=' @VA04250 00895000
MVC CPSWLN(PSWL,R2),0(R1) MOVE PSW TO TEXT AREA @VA04250 00896000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00897000
BE RESTORE YES, GO RESTORE @VA04250 00898000
LA R2,CARDLEN(R2) INCREMENT CURRENT TEXT POINTER @VA04250 00899000
ST R2,TEXTCURR SAVE FOR NEXT USER @VA04250 00900000
LOODBYT CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00901000
BE RESTORE YES, GO RESTORE @VA04250 00902000
LOOCMD BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00903000
* ---------------------------- 00904000
LA R7,MSGCMD 'ENTER COMMAND WHICH CAUSED FAIL'@VA04250 00905000
* ---------------------------- 00906000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00907000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00908000
BAL R8,DASHIN INSERT DASHES @VA04250 00909000
BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00910000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00911000
BE RESTORE YES, GO RESTORE @VA04250 00912000
B TEXTENTR @VA04250 00913000
************************************************************* 00914000
EJECT 00915000
************************************************************* 00916000
* PERFORMANCE TYPE REPORT 00917000
************************************************************* 00918000
PERRTN BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00919000
LA R0,L'PERFORM LENGTH OF DATA @VA04250 00920000
LA R1,PERFORM POINTER TO DATA @VA04250 00921000
BAL R8,KYINSERT GO PUT KYWD VMFAILURE IN OUTPUT @VA04250 00922000
* ---------------------------- 00923000
LA R7,MSGENV 'ENTER OPERATING ENVIRONMENT' @VA04250 00924000
* ---------------------------- 00925000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00926000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00927000
BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00928000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00929000
BE RESTORE YES, GO RESTORE @VA04250 00930000
PERPERF BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00931000
* ---------------------------- 00932000
LA R7,MSGPERF 'ENTER NATURE OF DEGRADATION' @VA04250 00933000
* ---------------------------- 00934000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00935000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00936000
BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00937000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00938000
BE RESTORE YES, GO RESTORE @VA04250 00939000
B TEXTENTR GO PROMPT FOR TEXT DESCRIPTION @VA04250 00940000
************************************************************* 00941000
EJECT 00942000
************************************************************* 00943000
* WAIT TYPE REPORT 00944000
************************************************************* 00945000
WAIRTN BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00946000
LA R0,L'WAIT LENGTH OF DATA @VA04250 00947000
LA R1,WAIT POINTER TO DATA @VA04250 00948000
BAL R8,KYINSERT VMFAILURE=WAIT TO KEY AREA @VA04250 00949000
* ---------------------------- 00950000
LA R7,MSGENV 'ENTER OPERATING ENVIRONMENT' @VA04250 00951000
* ---------------------------- 00952000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00953000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00954000
BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00955000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00956000
BE RESTORE YES, GO RESTORE @VA04250 00957000
L R6,TEXTCURR POINTER TO NEXT OUTPUT RECORD @VA04250 00958000
WAICPSW BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00959000
* ---------------------------- 00960000
LA R7,MSGCPSW 'ENTER CURRENT PSW' @VA04250 00961000
* ---------------------------- 00962000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00963000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00964000
LTR R0,R0 ANYTHING ENTERED? @VA04250 00965000
BZ WAIDBYT NO @VA04250 00966000
LR R2,R6 TEST AREA POINTER FOR THIS @VA04250 00967000
MVC 0(CPSWLN,R2),=C'CURRENT PSW=' @VA04250 00968000
MVC CPSWLN(SIXTEEN,R2),0(R1) MOVE DATA TO TEXT AREA @VA04250 00969000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00970000
BE RESTORE YES, GO RESTORE @VA04250 00971000
LA R2,CARDLEN(R2) INCREMENT CURRENT TEXT POINTER @VA04250 00972000
ST R2,TEXTCURR SAVE FOR NEXT USER @VA04250 00973000
WAIDBYT CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00974000
BE RESTORE YES, GO RESTORE @VA04250 00975000
WAICMD BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00976000
* ---------------------------- 00977000
LA R7,MSGCMD 'ENTER COMMAND WHICH CAUSED FAIL'@VA04250 00978000
* ---------------------------- 00979000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00980000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00981000
BAL R8,DASHIN INSERT DASHES @VA04250 00982000
BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00983000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00984000
BE RESTORE YES, GO RESTORE @VA04250 00985000
B TEXTENTR GO ASK USER FOR TEXTUAL INFO @VA04250 00986000
************************************************************* 00987000
EJECT 00988000
*************************************************************** 00989000
* READ TEXT PORTION OF REPORT 00990000
*************************************************************** 00991000
TEXTENTR LA R6,MAXLINES ALLOW 20 LINES OF INPUT @VA04250 00992000
MVI TEXTSW,TEXTSWON INDICATE USER ENTERING TEXT @VA04839 00992100
CLC TEXTPT,TEXTCURR ANYBODY BEEN HERE ALREADY @VA04250 00993000
BE TEXTNOD NO @VA04250 00994000
BCTR R6,0 SOMEBODY USED ONE ALREADY @VA04250 00995000
MVC TEXTLAST,TEXTCURR RESET IN CASE OF REPROMPT @VA04250 00996000
MVC TEXTBACK,TEXTCURR RESET IN CASE OF REPROMPT @VA04250 00997000
TEXTNOD BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00998000
MVI TEXTSW,TEXTSWON TURN ON TEXT SWITCH IF REPROMP @VA04839 00998100
MVC TEXTLAST,TEXTBACK RESTORE IN CASE OF REPROMPT @VA04250 00999000
MVC TEXTCURR,TEXTBACK RESTORE IN CASE OF REPROMPT @VA04250 01000000
MVI DBYTE,NORMAL RESET REPROMPT IF ACTIVE @VA04250 01001000
* ---------------------------- 01002000
LA R7,MSGTEXT 'ENTER TEXT OR NULL' @VA04250 01003000
* ---------------------------- 01004000
BAL R9,WRTERM GO ISSUE MESSAGE TO USER @VA04250 01005000
TEXTWR BALR R5,0 SAVE THIS ADDRESS FOR REPROMPT @VA04250 01006000
MVI TEXTSW,TEXTSWON TURN ON TEXT SWITCH IF REPROMP @VA04839 01006100
* ---------------------------- 01007000
LA R7,MSGTEXT1 'ENTER' @VA04250 01008000
* ---------------------------- 01009000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 01010000
BAL R8,WRTERM GO WRITE MESSAGE AND READ REPLY @VA04250 01011000
CLI DBYTE,REPROMPT REPROMPTING? @VA04250 01012000
BNE TEXTDO NOT IN REPROMPT @VA04250 01013000
L R2,TEXTLAST WE'LL GET THE LAST RECORD AGAIN @VA04250 01014000
MVI 0(R2),BLANK CLEAR LAST TEXT ENTRY @VA04250 01015000
MVC DISP1(CARDLEN-DISP1,R2),0(R2) ALL 80 BYTES OF IT@VA04250 01016000
ST R2,TEXTCURR CLEAR LAST ENTERED LINE @VA04250 01017000
MVI DBYTE,NORMAL CLEAR REPROMPT INDICATOR @VA04250 01018000
TEXTDO LTR R0,R0 USER ENTER NULL? @VA04250 01019000
BZ TEXTDONE YES @VA04250 01020000
LR R2,R0 GET LENGTH OF DATA @VA04250 01021000
BCTR R2,0 FOR EXECUTE @VA04250 01022000
L R3,TEXTCURR OUTPUT AREA @VA04250 01023000
ST R3,TEXTLAST PRESERVE THIS POINT @VA04250 01024000
MVI 0(R3),BLANK CLEAR @VA04250 01025000
MVC DISP1(CARDLEN-DISP1,R3),0(R3) OUTPUT RECORD @VA04250 01026000
EX R2,TXTMVC DO MOVE @VA04250 01027000
LA R3,CARDLEN(R3) OUTPUT POINTER UPDATE @VA04250 01028000
ST R3,TEXTCURR SAVE IT @VA04250 01029000
BCT R6,TEXTWR ALLOW 20 LINES TOTAL OF INPUT HER@VA04250 01030000
TEXTDONE CLI OLDSW,OLDON PROCESSING AN OLD PROBLEM? @VA04250 01031000
BE OLDADD YES, GO ADD TO EXISTING REPORT @VA04250 01032000
L R2,KYAREAPT START OF KEY OUTPUT AREA @VA04250 01033000
L R3,KYCURRPT GET NEXT AVAILABLE AREA @VA04250 01034000
SR R3,R2 GET TOTAL KEY AREA OUTPUT @VA04250 01035000
L R4,KYOUTLN GET POINTER TO HALFWORD LENGTH @VA04250 01036000
LA R3,DISP4(R3) INCLUDE RECORD DESCRIPTOR LENGTH @VA04250 01037000
STH R3,0(R4) SAVE IT @VA04250 01038000
L R2,TEXTPT POINTER TO TEXT OUTPUT AREA @VA04250 01039000
L R3,TEXTCURR POINT TO NEXT AVAILABLE LINE @VA04250 01040000
SR R3,R2 GET TEXT OUTPUT LENGTH @VA04250 01041000
L R4,TXTOUTLN POINT TO LENGTH FIELD @VA04250 01042000
STH R3,0(R4) SAVE IT @VA04250 01043000
CLI OLDSW,OLDON PROCESSING AN OLD PROBLEM? @VA04250 01044000
BE OLDADD YES @VA04250 01045000
B RPTOK CONTINUE @VA04250 01046000
TXTMVC MVC 0(0,R3),0(R1) SUBJECT OF EXECUTE @VA04250 01047000
*************************************************************** 01048000
* TELL USER THE PROBLEM NUMBER, UPDATE IT, AND REWRITE IT. 01049000
*************************************************************** 01050000
RPTOK MVC MSGPRB,XXXXX MOVE PROBLEM NUMBER TO PARM LIST @VA04250 01051000
* ---------------------------- 01052000
LA R7,MSGTELL 'THIS REPORT ASSIGNED NUMBER NN @VA04250 01053000
* ---------------------------- 01054000
LA R6,LMSGTELL LENGTH OF MESSAGE @VA04250 01055000
WRTERM (R7),(R6) TELL USER @VA04250 01056000
PNUPDATE PACK ADDSUM(THREE),XXXXX(PLENGTH) PACK CURRENT NUMBER@VA04250 01057000
AP ADDSUM(THREE),AONE ADD ONE @VA04250 01058000
UNPK XXXXX(PLENGTH),ADDSUM(THREE) UNPACK BACK @VA04250 01059000
OI PRBXXXXX+SEVEN,UNPKMASK PRETTY IT UP @VA04250 01060000
MVI PNUMIN,BLANK CLEAR THE INPUT OF ANY TRASH @VA04250 01061000
MVC PNUMIN+1(CARDLEN-1),PNUMIN @VA04250 01062000
* ALL THE REMAINDER OF RECORD IS CLEARED 01063000
MVC PNUMIN(PLENGTH),XXXXX MOVE NEW NUMBER TO OUTPUT @VA04250 01064000
CLI PNSWITCH,PNSWON LOOKING FOR OPEN NUMBER? @VA04250 01065000
BNE REWRTPN NO @VA04250 01066000
MVI PNSWITCH,PNSWOFF RESET SWITCH @VA04250 01067000
B PNRETRY GO SEE IF THIS IS ALRIGHT @VA04250 01068000
REWRTPN LA R7,SUMMFILE POINT TO FILENAME FT FM @VA04250 01069000
FSWRITE (R7),RECNO=1,ERROR=SUMERRW,BUFFER=PNUMIN, @VA04250X01070000
BSIZE=80 @VA04250 01071000
FSCLOSE (R7) @VA04250 01072000
*************************************************************** 01073000
* CALL WRITEREC TO WRITE THE PROBLEM REPORT ON DISK AND ADD TO 01074000
* THE SYMPTOM SUMMARY FILE. 01075000
*************************************************************** 01076000
LA R1,WRTPARM PARMS PASSED TO WRITEREC @VA04250 01077000
L R15,VWRTREC GET ADDRESS OF WRITEREC @VA04250 01078000
BALR R14,R15 GO WRITE THE RECORD @VA04250 01079000
B WRETTBL(R15) RETURN CODES OF 0,4, OR 8 LEGAL @VA04250 01080000
WRETTBL B WRTRECOK GOOD RETURN @VA04250 01081000
B WRTRECOK NOT VALID FOR WRITEREC @VA04250 01082000
B RETCOD8 BAD RETURN @VA04250 01083000
WRTRECOK LA R1,WRTPARM PARM LIST POINTER SAME AS DMMWRT @VA04250 01084000
************************************************************** 01085000
* CALL SEARCH TO FIND POSSIBLE DUPS 01086000
************************************************************** 01087000
SRCHRTN L R15,VSRCH POINT TO SEARCH ROUTINE @VA04250 01088000
BALR R14,R15 GO TO SEARCH ROUTINE @VA04250 01089000
B SRCHRTRN(R15) RETURN CODE IN R15 OF 0,4, OR 8 @VA04250 01090000
SRCHRTRN B NORMEXIT NODUPS FOUND @VA04250 01091000
B NORMEXIT FOUND SOME DUPS @VA04250 01092000
B RETCOD8 BAD ERROR @VA04250 01093000
EJECT 01094000
*************************************************************** 01095000
* REPLACE IMBEDDED BLANKS WITH DASHES 01096000
*************************************************************** 01097000
DASHIN LR R14,R0 GET LENGTH OF DATA @VA04250 01098000
LR R15,R1 GET POINTER TO DATA @VA04250 01099000
LTR R14,R14 ZERO LENGTH? @VA04250 01100000
BZ DASHEXIT YES, GET OUT @VA04250 01101000
AR R15,R14 POINT TO END OF ENTERED DATA @VA04250 01102000
BCTR R15,0 POINT TO LAST BYTE OF DATA @VA04250 01103000
DASHLP CLI 0(R15),BLANK IS THIS BLANK? @VA04250 01104000
BNE DASHCONT NO @VA04250 01105000
MVI 0(R15),DASH REPLACE BLANK WITH DASH @VA04250 01106000
DASHCONT BCTR R15,0 NEXT BYTE BACK @VA04250 01107000
BCT R14,DASHLP DO THIS TILL END @VA04250 01108000
DASHEXIT BR R8 RETURN TO CALLER @VA04250 01109000
*************************************************************** 01110000
* RESTORE CONDITIONS AS THEY WERE BEFORE REPROMPTING 01111000
*************************************************************** 01112000
RESTORE MVI DBYTE,NORMAL RESET REPROMPT INDICATOR @VA04250 01113000
LM R5,R9,RD59 RESTORE PRE-REPROMPT STATUS @VA04250 01114000
BR R5 GO REISSUE ORIGINAL PROMPT @VA04250 01115000
EJECT 01116000
*************************************************************** 01117000
* THIS ACTIVITY IS ASSOCIATED WITH AN ALREADY REPORTED PROBLEM 01118000
*************************************************************** 01119000
OLDPROB MVI DBYTE,NORMAL CLEAR REPROMPT INDICATOR @VA04250 01120000
OLDPROBC EQU * @VA04250 01121000
BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 01122000
* ---------------------------- 01123000
LA R7,MSGPNUM 'ENTER PROBLEM NUMBER' @VA04250 01124000
* ---------------------------- 01125000
LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 01126000
BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 01127000
LTR R0,R0 ANYTHING ENTERED? @VA04250 01128000
BZ OLDPROBC NO, FORCE ENTRY OF SOMETHING @VA04250 01129000
LR R2,R0 GET COUNT OF DATA ENTERED @VA04250 01130000
LR R3,R1 DATA POINTER @VA04250 01131000
LA R3,5 5 INTO R3 @VA04250 01132000
SR R3,R2 GET DIFERENCE FROM USER DATA COUN@VA04250 01133000
BCTR R2,0 SET USER ENTERED COUNT FOR EX @VA04250 01134000
LA R3,XXXXX(R3) POINT TO WHERE DATA SHOULD GO @VA04250 01135000
EX R2,PNMVC MOVE DIGITS TO FILE NAME @VA04250 01136000
LA R3,PRBXXXXX POINT TO FNAME FTYPE FM @VA04250 01137000
FSSTATE (R3) IS THERE A REPORT OUT THERE? @VA04250 01138000
MVI DBYTE,NORMAL CLEAR POSSIBLE REPROMPT @VA04250 01139000
LTR R15,R15 FILE EXIST? @VA04250 01140000
BNZ STATERR ERROR GO CHECK WHY @VA04250 01141000
*************************************************************** 01142000
* A PROBLEM REPORT IS KNOWN TO EXIST AT THIS POINT 01143000
*************************************************************** 01144000
MVI OLDSW,OLDON INDICATE PROCESSING AN OLD PROB @VA04250 01145000
B MAINLINE GO TO MAINLINE PROMPTS @VA04250 01146000
* PROCESSING IS DONE FOR OLD PROBLEM NOW, LET'S OUTPUT THE DATA 01147000
OLDADD L R2,SUPPCURR GET POINTER TO CURRENT SUPP DATA @VA04250 01148000
L R4,SUPPPT POINT TO START OF SUPP DATA AREA @VA04250 01149000
SR R2,R4 GET DIFFERANCE @VA04250 01150000
MVI OUTPUT,BLANK CLEAR OUTPUT @VA04250 01151000
MVC OUTPUT+DISP1(L'OUTPUT-DISP1),OUTPUT @VA04250 01152000
LA R7,PRBXXXXX POINT TO FILE NAME FT FM @VA04250 01153000
MVC ADDREC(THIRTEEN),=C'*** ADDED ***' @VA04250 01154000
MVC ADDDATE(FIVE),CURRDATE TODAY'S DATE @VA04250 01155000
MVC ADDTIME(L'CURRTIME),CURRTIME AND TIME @VA04250 01156000
LA R6,CARDLEN BUFFER SIZE FOR FSWRITE @VA04250 01157000
LA R3,OUTPUT POINT TO OUTPUT RECORD @VA04250 01158000
LA R4,DISP1 WRITE ONE RECORD ONLY @VA04250 01159000
BAL R8,FSWRITE GO TO COMMON WRITE @VA04250 01160000
LR R6,R2 SAVE LENGTH FOR FSWRITE @VA04250 01161000
LTR R3,R2 SET UP FOR DIVIDE @VA04250 01162000
BZ TXTCHK NO SUPP DATA, GO HANDLE TEXT @VA04250 01163000
SR R2,R2 CLEAR EVEN REG FOR DIVIDE @VA04250 01164000
D R2,=F'80' FIND OUT NUMBER OF RECORDS @VA04250 01165000
LR R4,R3 NUMBER OF RECORDS TO WRITE @VA04250 01166000
L R3,SUPPPT POINT TO OUTPUT FOR FSWRITE @VA04250 01167000
BAL R8,FSWRITE GO TO COMMON FSWRITE ROUTINE @VA04250 01168000
TXTCHK L R2,TEXTCURR CURRENT POINTER IN TEXT AREA @VA04250 01169000
L R4,TEXTPT START OF TEXT AREA @VA04250 01170000
SR R2,R4 GET AMOUNT OF DATA @VA04250 01171000
BZ SUMMUP NO TEXT INFO ENTERED BY USER @VA04250 01172000
LR R3,R2 SET FOR DIVIDE @VA04250 01173000
LR R6,R3 SAVE LENGTH OF DATA FOR FSWRITE @VA04250 01174000
SR R2,R2 CLEAR EVEN REG FOR DIVIDE @VA04250 01175000
D R2,=F'80' GET NUMBER OF RECORDS @VA04250 01176000
LR R4,R3 SAVE IT FOR FSWRITE @VA04250 01177000
L R3,TEXTPT POINT OT OUTPUT AREA @VA04250 01178000
BAL R8,FSWRITE GO DO FSWRITE @VA04250 01179000
*************************************************************** 01180000
* TELL USER WE HAVE APPENDED THE NEW INFO ON PROBLEM REPORT 01181000
*************************************************************** 01182000
SUMMUP FSCLOSE (R7) CLOSE THE OUTPUT REPORT FILE @VA04250 01183000
* ---------------------------- 01184000
LA R7,MSGDONE 'PROBLEM REPORT APPENDED' @VA04250 01185000
* ---------------------------- 01186000
MVC MSGKYWD+DISP1(L'PRBXXXXX),PRBXXXXX PROB NUMBER @VA04250 01187000
MVI ENTSW,ENTON DON'T ALLOW PROMPT NUM TO PRINT @VA04250 01188000
BAL R9,WRTERM ISSUE 'ALL DONE' MESSAGE @VA04250 01189000
B NORMEXIT WE ARE INDEED DONE @VA04250 01190000
EJECT 01191000
*************************************************************** 01192000
* WE HAD AN ERROR FINDING THE PROBLEM REPORT 01193000
*************************************************************** 01194000
STATERR ST R15,WKWD STORE RETURN CODE @VA04250 01195000
CLI WKWD+THREE,FNOTFND SIMPLE FILE NOT FOUND? @VA04250 01196000
BNE STERR2 NO, GO PUT OUT ERROR MESSAGE @VA04250 01197000
* ---------------------------- 01198000
LA R7,MSGNOPRB REQSTD PROB REPORT DOESN'T EXIST @VA04250 01199000
* ---------------------------- 01200000
SR R2,R2 CLEAR WORK FOR INSERT CHAR INSTR @VA04250 01201000
IC R2,MSGLKYWD GET LENGTH OF KEYWORD AREA @VA04250 01202000
LA R3,MSGLKYWD+TWO(R2) POINT TO MESSAGE DATA @VA04250 01203000
MVC 0(L'PRBXXXXX,R3),PRBXXXXX MOVE PROB NUM TO MSG @VA04250 01204000
MVI ENTSW,ENTON DON'T PRINT REPROMPT LINE NUMBER @VA04250 01205000
BAL R9,WRTERM GO ISSUE THE MESSAGE TO USER @VA04250 01206000
MVC XXXXX(PLENGTH),FOFO RESET PROB NUMB TO 00000 @VA04250 01207000
B EXIST GIVE USER ANOTHER CHANCE @VA04250 01208000
STERR2 CVD R15,WKDWD CONVERT RETURN CODE TO DECIMAL @VA04250 01209000
UNPK STMSG1,WKDWD+SIX(TWO) UNPK INTO MSG OUTPUT AREA @VA04250 01210000
OI STMSG1+TWO,UNPKMASK MAKE IT PRINTABLE @VA04250 01211000
MVC STMSG3(EIGHT),PRBXXXXX MOVE PROB NUMBER TO MSG @VA04250 01212000
LA R2,STMSGL LENGTH OF MESSAGE @VA04250 01213000
WRTERM STMSG,(R2) GO TELL USER @VA04250 01214000
B RETCOD8 TAKE RETURN CODE 8 EXIT @VA04250 01215000
STMSG DC C'DMMPRO300S ERROR ''' @VA04250 01216000
STMSG1 DC C' ' @VA04250 01217000
STMSG2 DC C''' ON FSSTATE ''' @VA04250 01218000
STMSG3 DC C' REPORT A1''' @VA04250 01219000
STMSGL EQU *-STMSG @VA04250 01220000
PNMVC MVC 0(0,R3),0(R1) @VA04250 01221000
EJECT 01222000
*************************************************************** 01223000
* ROUTINE TO DO FSWRITE AND CHECK RETURN CODE 01224000
* R8 RETURN REGISTER 01225000
* R7 FILENAME 01226000
* R6 BSIZE 01227000
* R3 BUFFER POINTER 01228000
* R4 NUMBER OF RECORDS TO BE WRITTEN 01229000
* R1-R3 WORK REGISTERS 01230000
* 01231000
* ISSUES APPROPRIATE ERROR MESSAGE DMM200PROS 01232000
*************************************************************** 01233000
FSWRITE FSWRITE (R7),BSIZE=(R6),BUFFER=(R3),NOREC=(R4) @VA04250 01234000
LTR R15,R15 ERROR? @VA04250 01235000
BZ 0(R8) NO,RETURN @VA04250 01236000
SUMERRW CVD R15,WKDWD CONVERT RETURN CODE TO DECIMAL @VA04250 01237000
UNPK ERRMSG1,WKDWD+SIX(TWO) UNPACK INOT ERROR MSG @VA04250 01238000
OI ERRMSG1+TWO,UNPKMASK MAKE IT PRINTABLE @VA04250 01239000
MVC ERRMSG2,0(R7) MOVE IN FILE NAME @VA04250 01240000
MVC ERRMSG3,EIGHT(R7) MOVE IN FILE TYPE @VA04250 01241000
MVC ERRMSG4,SIXTEEN(R7) MOVE IN FILE MODE @VA04250 01242000
LA R2,ERRMSG DMM200PROS @VA04250 01243000
LA R3,ERRMSGL GET LENGTH @VA04250 01244000
WRTERM (R2),(R3) @VA04250 01245000
B RETCOD8 TAKE ERROR EXIT @VA04250 01246000
ERRMSG DC C'DMMPRO200S ERROR ''' @VA04250 01247000
ERRMSG1 DC C' ' NNN RETURN CODE ON FSWRITE @VA04250 01248000
DC C''' WRITING FILE ''' @VA04250 01249000
ERRMSG2 DS CL8 FILE NAME @VA04250 01250000
DC C' ' @VA04250 01251000
ERRMSG3 DS CL8 FILE TYPE @VA04250 01252000
DC C' ' @VA04250 01253000
ERRMSG4 DS CL2 FILE MODE @VA04250 01254000
DC C'''' @VA04250 01255000
ERRMSGL EQU *-ERRMSG @VA04250 01256000
EJECT 01257000
*************************************************************** 01258000
* ROUTINE TO PLACE KEYWORDS AND VALUES IN OUTPUT BUFFER 01259000
* ENTRY: R7 POINTS TO MESSAGE 01260000
* R1 POINTS TO DATA TO BE JOINED WITH KEYWORD 01261000
* R0 CONTAINS LENGTH OF DATA 01262000
* 01263000
* CHECK KYWD FOR VMFAILURE OR VMENVIR AND IF SO STORE THE DATA 01264000
* IN THE INTERNAL DATA AREA (ADDRESSED VIA INTSECT) 01265000
* 01266000
* CHECK TO SEE IF THE KEYWD HAS ALREADY BEEN BUT IN THE OUTPUT. 01267000
* THIS CAN OCCUR IN THE CASE OF A REPROMPT OR IN THE CASE OF 01268000
* A VMFAILURE WHICH CAUSES THE INITIAL BASE FAILURE TO BE 01269000
* PUT HERE FIRST. 01270000
* 01271000
* IF THE KEYWD DOES NOT EXIST YET ADD IT TO THE OUTPUT KEYAREA 01272000
* 01273000
* IF THE KYWD ALREADY EXISTS WE ALLOW FOR THE NEW DATA BEING 01274000
* A DIFFERENT LENGTH FROM THE OLD. THE KEYDATA FOLLOWING THE 01275000
* KEYWORD IN QUESTION IS ADJUSTED INWARD OR OUTWARD AS REQUIRED 01276000
* PRIOR TO THE NEW DATA BEING STORED IN THE OUTPUT. 01277000
*************************************************************** 01278000
KYINSERT CLI MSGLKYWD,NOKYWD ANY KEYWORD PRESENT? @VA04250 01279000
BE KYRETURN NO @VA04250 01280000
SR R3,R3 PREPARE FOR IC INSTRUCTION @VA04250 01281000
IC R3,MSGLKYWD GET LENGTH OF KEYWORD + '=' @VA04250 01282000
BCTR R3,0 FOR EXECUTE @VA04250 01283000
LA R4,MSGKYWD POINT TO KEYWORD @VA04250 01284000
LTR R0,R0 ANYTHING ENTERED? @VA04429 01284300
BZ KYNOTCID NO, DON'T PUT IN INTSECT @VA04429 01284600
L R2,INTPT ADDRESSABILITY FOR INTSECT @VA04250 01285000
CLC =C'VMFAILURE',0(R4) MAJOR VMFAILURE KEYWORD? @VA04250 01286000
BNE KYMX2 CERTAIN VALUES WE TRY TO SAVE FOR@VA04250 01287000
MVC INTX1,0(R1) LATER TO BE PUT IN THE @VA04250 01288000
KYMX2 CLC =C'VMENVIR',0(R4) SYMPTOM SUMMARY CNTRL RECORD. @VA04250 01289000
BNE KYNOTCID NOT ONE WE WANT TO SAVE @VA04250 01290000
MVC INTX2,0(R1) SAVE IT IN INTERNAL DATA AREA @VA04250 01291000
KYNOTCID L R2,KYAREAPT BEGINNING OF OUTPUT AREA @VA04250 01292000
KYNXT LH R6,0(R2) GET LENGTH OF ENTRY @VA04250 01293000
LTR R6,R6 ZERO? @VA04250 01294000
BZ KYNOTFND YES, KEY NOT PRESENT IN OUTPUT @VA04250 01295000
LA R14,DISP4(R2) POINT TO KEY @VA04250 01296000
EX R3,KYCMPR KEY MATCH WHAT'S ALREADY THERE? @VA04250 01297000
BE KYFOUND YES @VA04250 01298000
LA R2,0(R2,R6) POINT TO NEXT ENTRY. @VA04250 01299000
B KYNXT AND WHERE WE STOP NOBODY KNOWS. @VA04250 01300000
KYNOTFND LTR R0,R0 NULL INPUT? @VA04250 01301000
BZ KYRETURN YES @VA04250 01302000
IC R3,MSGLKYWD GET LENGTH OF KEYWORD + '=' @VA04250 01303000
AR R3,R0 TOTAL KEY PLUS DATA @VA04250 01304000
LA R3,DISP4(R3) ADD ON COUNT WORD LENGTH @VA04250 01305000
STH R3,0(R2) DO IT TO OUTPUT @VA04250 01306000
LA R6,0(R2,R3) NEXT AVAIL SPOT @VA04250 01307000
ST R6,KYCURRPT SAVE IT @VA04250 01308000
KYLEQ LA R2,DISP4(R2) PAST LENGTH FIELDS @VA04250 01309000
SR R3,R3 DON'T TAKE ANY CHANCES @VA04250 01310000
IC R3,MSGLKYWD GET LENGTH OF KEYWORD @VA04250 01311000
BCTR R3,0 WE'RE USING AN EXECUTE SO--- @VA04250 01312000
EX R3,KYMVC MOVE KEYWORD TO OUTPUT AREA @VA04250 01313000
LA R2,DISP1(R2,R3) WHERE ACTUAL DATA GOES @VA04250 01314000
LR R3,R0 DATA LENGTH @VA04250 01315000
BCTR R3,0 EXECUTE NEEDS THIS @VA04250 01316000
EX R3,KYDATMVC MOVE DATA AFTER KEYWORD @VA04250 01317000
B KYRETURN WE'RE DONE HERE FOR NOW @VA04250 01318000
KYCMPR CLC 0(0,R4),0(R14) NEW KEYWORD MATCH THE OLD? @VA04250 01319000
KYMVC MVC 0(0,R2),MSGKYWD MOVE KEYWORD TO OUTPUT AREA @VA04250 01320000
KYDATMVC MVC 0(0,R2),0(R1) MOVE DATA AFTER KEY @VA04250 01321000
KYFOUND IC R3,MSGLKYWD GET LENGTH OF THE NEW KEYWORD @VA04250 01322000
S R6,=F'4' SUBTRACT LENGTH OF LENGTH FIELD @VA04250 01323000
AR R3,R0 TOTAL LENGTH OF ENTRY @VA04250 01324000
CR R3,R6 NEW TOTAL AGAINST OLD TOTAL @VA04250 01325000
BE KYLEQ DON'T HAVE TO MONKEY AROUND @VA04250 01326000
BH KYMVEOUT MUST ADJUST OUTWARD @VA04250 01327000
KYMVEIN SR R6,R3 DIFFERENCE BETWEEN OLD AND NEW @VA04250 01328000
L R14,KYCURRPT POINT TO NEXT AVAILABLE AREA @VA04250 01329000
SR R14,R6 NEW END POINTER @VA04250 01330000
LTR R0,R0 NULL RESPONSE ENTERED BY USER? @VA04838 01330150
BNZ KYMVEI2 NO, JUST CHANGE DATA LENGTH @VA04838 01330300
LA R6,4(R3,R6) GET LENGTH OF DATA+KEY+LEN FIELD @VA04838 01330450
SR R14,R3 BACK UP TO DELETE THIS ENTRY @VA04838 01330600
S R14,=F'4' INCLUDE LENGTH FIELD LENGTH @VA04838 01330750
KYMVEI2 EQU * CALCULATE MOVE BOUNDRIES @VA04838 01330900
ST R14,KYCURRPT SAVE NEW CALCULATED POINTER @VA04250 01331000
AR R14,R6 OLD END POINTER AGAIN @VA04250 01332000
LA R15,DISP4(R3) ADD IN COUNT FIELD LENGTH @VA04250 01333000
STH R15,0(R2) NEW LENGTH TO OUTPUT @VA04250 01334000
LA R3,DISP4(R2,R3) END OF NEW ENTRY @VA04250 01335000
LTR R0,R0 USER DELETING A RESPONSE? @VA04838 01335200
BNZ KYMVII2 NO, CONTINUE NORMALLY @VA04838 01335400
LR R3,R2 POINT TO START OF KEY FOR ENTRY @VA04838 01335600
KYMVII2 EQU * USER CHANGING LENGTH OF INPUT @VA04838 01335800
LA R4,0(R3,R6) END OF OLD ENTRY @VA04250 01336000
SR R14,R4 TOTAL TO BE MOVED @VA04250 01337000
LTR R14,R14 LAST ENTRY AFTER ALL? @VA04250 01338000
BZ KYCLREND YES @VA04250 01339000
KYMVIN MVC 0(DISP1,R3),0(R4) ONE BYTE AT A TIME @VA04250 01340000
LA R3,DISP1(R3) INCREMENT NEW POINTER @VA04250 01341000
LA R4,DISP1(R4) INCREMENT OLD POINTER @VA04250 01342000
BCT R14,KYMVIN DO THIS FOR A WHILE @VA04250 01343000
KYCLREND L R14,KYCURRPT POINT TO NEXT AVAILABLE AREA @VA04250 01344000
KYCLEAR MVI 0(R14),HEXZERO CLEAR LEFT OVER TRASH @VA04250 01345000
LA R14,DISP1(R14) NEXT BYTE @VA04250 01346000
BCT R6,KYCLEAR CLEAR TRASH LEFT OVER AT END @VA04250 01347000
LTR R0,R0 USER CANCELLING ENTRY? @VA04838 01347330
BZ KYRETURN YES, RETURN TO PROMPTING @VA04838 01347660
B KYLEQ BACK TO MOVE IN KEY AND DATA @VA04250 01348000
KYMVEOUT LA R15,LFLDLEN(R3) ADD LENGTH FIELD LENGTH TO PTR @VA04250 01349000
STH R15,0(R2) NEW LENGTH IN FRONT OF DATA @VA04250 01350000
SR R3,R6 DIFFERENCE IN LENGTH OF OLD @VA04250 01351000
L R14,KYCURRPT POINT TO NEXT AVAILABLE AREA @VA04250 01352000
AR R14,R3 NEW END POINTER @VA04250 01353000
ST R14,KYCURRPT SAVE IT FOR NEXT USER @VA04250 01354000
LA R4,DISP4(R6,R2) OLD END FOR THIS ENTRY @VA04250 01355000
LR R6,R14 SAVE TOTAL END @VA04250 01356000
SR R14,R3 OLD END @VA04250 01357000
LR R3,R14 OLD END @VA04250 01358000
SR R3,R4 TOTAL TO BE MOVED @VA04250 01359000
LTR R3,R3 NULL RESULT? @VA04250 01360000
BZ KYLEQ LAST ENTRY AFTER ALL THIS @VA04250 01361000
BCTR R6,0 ONE BYTE PAST WHERE WE WANT @VA04250 01362000
BCTR R14,0 DITTO @VA04250 01363000
KYMVOUT MVC 0(DISP1,R6),0(R14) ONE BYTE AT A TIME @VA04250 01364000
BCTR R6,0 DECREMENT OLD POINTER @VA04250 01365000
BCTR R14,0 DECREMENT NEW POINTER @VA04250 01366000
BCT R3,KYMVOUT MOVE IT ALL @VA04250 01367000
B KYLEQ NOW GO PUT IN NEW DATA @VA04250 01368000
KYRETURN BR R8 BACK TO CALLER @VA04250 01369000
EJECT 01370000
*************************************************************** 01371000
* ROUTINE TO WRITE MESSAGES TO THE TERMINAL 01372000
* WORK R2,R3,R4,R14 01373000
* RETURN R9 01374000
* CALLER R5 01375000
* MSG R7 01376000
* MSGOUT R6 WHERE USER INPUT WILL BE PUT 01377000
*************************************************************** 01378000
WRTERM SR R14,R14 CLEAR WORK REG @VA04250 01379000
LR R3,R14 CLEAR ANOTHER @VA04250 01380000
L R2,LOGPTR ACTIVITY TRACE POINTER @VA04250 01381000
CLI 0(R2),FENCE NO MORE ENTRIES? @VA04250 01382000
BE WRNOLOG GUESS NOT, DON'T RECORD THIS @VA04250 01383000
CLI ENTSW,ENTON INFORMATION MESSAGE ONLY? @VA04250 01384000
BE WRNOLOG YES @VA04250 01385000
ST R5,0(R2) ADDRESS TO REEXECUTE THE CALLER @VA04250 01386000
ST R7,DISP4(R2) MESSAGE POINTER WE'RE RECORDING @VA04250 01387000
ST R6,EIGHT(R2) SPECIAL CALLER USAGE @VA04250 01388000
LA R2,TRSIZE(R2) NEXT ENTRY IN TRACE TABLE @VA04250 01389000
ST R2,LOGPTR SAVE IT @VA04250 01390000
WRNOLOG LA R2,OUTPUT POINT TO OUTPUT AREA @VA04250 01391000
MVI OUTPUT,BLANK @VA04250 01392000
MVC OUTPUT+DISP1(L'OUTPUT-DISP1),OUTPUT CLEAR OUTPUT@VA04250 01393000
SR R3,R3 CLEAR WORK @VA04250 01394000
MVC OUTPUT(L'MSGPRMPT),=C'******' IF NO REPROMPT NUM@VA04250 01395000
CLI ENTSW,ENTON PUT OUT LINE NUMBER 1SR TIME ONLY@VA04250 01396000
BE WRMSGOUT WE'VE ALREADY PUT OUT LINE NUMBER@VA04250 01397000
MVC OUTPUT(MSGRLEN),MSGPRMPT PUT REPROMPT IN OUTPUT @VA04250 01398000
MVI ENTSW,ENTON ONLY ONCE @VA04250 01399000
WRMSGOUT LA R2,OUTPUT+SEVEN THIS IS WHERE MESSAGE GOES @VA04250 01400000
LA R4,MSGLKYWD POINT TO KEYWORD LENGTH @VA04250 01401000
IC R3,0(R4) GET THIS LENGTH @VA04250 01402000
LA R4,DISP1(R3,R4) POINT TO MSG LENGTH @VA04250 01403000
IC R3,0(R4) GET LENGTH OF MESSAGE @VA04250 01404000
LA R14,SEVEN(R3) LENGTH OF TOTAL MESSAGE @VA04250 01405000
LA R4,DISP1(R4) POINT TO MESSAGE PROPER @VA04250 01406000
LTR R3,R3 COULD BE ZERO I SUPPOSE @VA04250 01407000
BZ WRITE IT IS ZERO @VA04250 01408000
BCTR R3,0 FOR EXECUTE @VA04250 01409000
EX R3,WRMVCOUT MOVE MESSAGE TO OUTPUT @VA04250 01410000
LR R3,R14 GET TOTAL LENGTH IN SAFE REGISTER@VA04250 01411000
WRITE WRTERM OUTPUT,(R3) WRITE ON TERMINAL @VA04250 01412000
CLI MSGSTOP,MSGLAST LAST MSG IN PROMPT? @VA04250 01413000
BE WREXIT YES, BRANCH @VA04250 01414000
IC R3,MSGENT GET LENGTH OF TOTAL MESSAGE @VA04250 01415000
AR R7,R3 POINT TO NEXT MESSAGE @VA04250 01416000
B WRNOLOG GO UNTIL LAST MESSAGE IS FOUND @VA04250 01417000
WREXIT MVI ENTSW,ENTOFF RESET SWITCH @VA04250 01418000
BR R9 RETURN ON 9 @VA04250 01419000
WRMVCOUT MVC 0(0,R2),0(R4) MOVE TO OUTPUT AREA @VA04250 01420000
EJECT 01421000
*************************************************************** 01422000
* ROUTINE TO READ FROM TERMINAL AND DO INITIAL LOOKING AT INPUT 01423000
* REPROMPTING IS ALSO CONTROLLED FROM HERE 01424000
* R9 USED TO LINK TO WRTERM (SAVED FIRST IF USED) 01425000
* R5 USED BY REPROMPT TO GET TO ROUTINE TO DO REPROMPT 01426000
* R8 RETURN ADDRESS OF CALLING ROUTINE 01427000
* R7 MESSAGE POINTER 01428000
* R6 POINTER TO WHERE CALLER IS GOING TO PUT USER INPUT 01429000
* R2,R3,R4,R14 WORK REGS 01430000
* R1 RDTERM RETURNS ADDRESS OF INPUT TO CALLER HERE 01431000
* R0 LENGTH OF INPUT RETURNED TO CALLER IN THIS REG 01432000
*************************************************************** 01433000
RDTERM RDTERM INPUT READ FROM TERMINAL @VA04250 01434000
LTR R0,R0 ANYTHING ENTERED? @VA04250 01435000
BZ RDNULLIN NO RETURN TO CALLER @VA04250 01436000
LR R2,R0 GET LENGTH OF INPUT @VA04250 01437000
LA R1,INPUT POINT TO INPUT AREA @VA04250 01438000
CLI TEXTSW,TEXTSWON IS USER ENTERING TEXT @VA04839 01438100
BE RDGOTNB YES, SKIP BLANK SUPPRESSION @VA04839 01438200
RDCKBLNK CLI 0(R1),BLANK BLANK? @VA04250 01439000
BNE RDGOTNB NO, GOT SOMETHING @VA04250 01440000
LA R1,DISP1(R1) POINT TO NEXT INPUT BYTE @VA04250 01441000
BCT R2,RDCKBLNK CHECK NEXT BYTE FOR NON BLANK @VA04250 01442000
B RDNULLIN NOTHING BUT BLANKS ENTERED @VA04250 01443000
RDGOTNB LR R0,R2 NEW COUNT @VA04250 01444000
CLC =C':HX',0(R1) USER WANT TO GIVE UP? @VA04250 01445000
BE HXEXIT YES @VA04250 01446000
CLC =C'HX',0(R1) ANOTHER WAY THE USER MAY SAY STOP@VA04250 01447000
BE HXEXIT YES, THE USER WANTS TO QUIT @VA04250 01448000
CLC =C':L',0(R1) REPROMPT REQUEST? @VA04250 01449000
BNE RDNORMAL NO, GO DO SYNTAX CHECKING @VA04250 01450000
CLI DBYTE,REPROMPT ALREADY REPROMPTING? @VA04250 01451000
BNE RDREPRMP NO, GO DO REPROMPT @VA04250 01452000
* ---------------------------- 01453000
LA R7,MSGERR1 REPROMPT WITHIN REPROMT NOT ALLOW@VA04250 01454000
* ---------------------------- 01455000
MVI ENTSW,ENTON DON'T LET WRTERM PUT OUT PROMPT #@VA04250 01456000
BAL R9,WRTERM GO TELL THE USER @VA04250 01457000
MVI DBYTE,NORMAL CLEAR REPROMPT INDICATOR @VA04250 01458000
LM R5,R9,RD59 RESTORE STATUS BEFORE REPROMPT @VA04250 01459000
B WRTERM TRY ORIGINAL MESSAGE AGAIN @VA04250 01460000
RDREPRMP STM R5,R9,RD59 SAVE CURRENT STATUS @VA04250 01461000
XC TEXTSW,TEXTSW TURN OF TEXT ENTRY SWITCH @VA04839 01461100
LA R2,LOGTBL POINT TO OUR ACTIVITY TRACE @VA04250 01462000
L R3,LOGPTR POINT TO END OF OUR ACTIVITY @VA04250 01463000
SH R3,=H'12' BACK UP TO LAST VALID ENTRY @VA04250 01464000
RDPLOOK L R7,DISP4(R3) POINT TO MESSAGE @VA04250 01465000
CLC 0(MSGRLEN,R1),MSGPRMPT LINE NUMBERS COMPARE? @VA04250 01466000
BE RDFOUND YES, LETS REPROMPT @VA04250 01467000
SH R3,=H'12' NEXT LOG ENTRY @VA04250 01468000
CR R2,R3 END OF ACTIVITY @VA04250 01469000
BH RDNOTFND COULDN'T FIND IT @VA04250 01470000
B RDPLOOK LOOK AT THIS ONE @VA04250 01471000
* ---------------------------- 01472000
RDNOTFND LA R7,MSGERR2 REPROMPT REQUEST NOT FOUND @VA04250 01473000
* ---------------------------- 01474000
MVI ENTSW,ENTON DON'T LET WRTERM PUT OUT PROMPT #@VA04250 01475000
BAL R9,WRTERM TELL USER @VA04250 01476000
LM R5,R9,RD59 RESTORE PREVIOUS STATUS @VA04250 01477000
BR R5 GO BACK TO CALLER TO REISSUE MSG @VA04250 01478000
RDFOUND MVI DBYTE,REPROMPT INDICATE REPROMPT IN PROGRESS @VA04250 01479000
L R6,EIGHT(R3) POINTER WHERE USER PUT OUTPUT @VA04250 01480000
L R5,0(R3) WHERE THE PROMPT CAME FROM @VA04250 01481000
BR R5 GO LET HIM DO IT FOR US @VA04250 01482000
RDNORMAL LA R2,CARDLEN MOST WE WILL ALLOW IS 80 BYTES IN@VA04250 01483000
CR R0,R2 MORE THAN 80 ENTERED? @VA04250 01484000
BNH RDNORM2 NO @VA04250 01485000
LR R0,R2 SET LENGTH READ TO 80 @VA04250 01486000
RDNORM2 LR R2,R1 GET INPUT POINTER @VA04250 01487000
AR R2,R0 POINT TO END @VA04250 01488000
RDLOOP5 BCTR R2,0 POINT TO LAST BYTE @VA04250 01489000
CLI 0(R2),BLANK BLANK? @VA04250 01490000
BNE RDNORMZZ NO, CONTINUE WITH OTHER CHECKS @VA04250 01491000
BCTR R0,0 GO UNTIL WE FIND SOMETHING @VA04250 01492000
LTR R0,R0 OR UNTIL WE RUN OUT OF AMMO @VA04250 01493000
BZ RDNULLIN USER PLAYING WITH SPACE BAR @VA04250 01494000
B RDLOOP5 CONTINUE LOOKING @VA04250 01495000
RDNORMZZ SR R3,R3 CLEAR WORK @VA04250 01496000
CLI MSGMIN,MSGNOMIN MINIMUM RESTRICTION? @VA04250 01497000
BE RDMXCMPR NO, GO SEE IF MAX RESTRICTION @VA04250 01498000
* INSURE NO IMBEDDED BLANKS WHEN MINIMUM RESTRICTION IN EFFECT 01499000
RDTOKEN LR R2,R1 GET INPUT POINTER @VA04250 01500000
RDTLOOP LA R3,1(R3) KEEP TRACK OF HOW MUCH WE HAVE @VA04250 01501000
CLI DISP1(R2),BLANK AT END? @VA04250 01502000
BE RDGOTTOK YES WE HAVE ONE 'TOKEN' @VA04250 01503000
LA R2,DISP1(R2) LOOK AT NEXT BYTE OF INPUT @VA04250 01504000
B RDTLOOP CONTINUE LOOKING @VA04250 01505000
RDGOTTOK CR R0,R3 DID USER IMBED A BLANK? @VA04250 01506000
BE RDGOTTK2 NO @VA04250 01507000
* ---------------------------- 01508000
LA R7,MSGERRI 'IMBEDDED BLANKS NOT ALLOWED' @VA04250 01509000
* ---------------------------- 01510000
MVI ENTSW,ENTON DON'T LET WRTERM PRINT PROMPT NUM@VA04250 01511000
BAL R9,WRTERM PRINT ERROR MESSAGE @VA04250 01512000
BR R5 REPROMPT USER @VA04250 01513000
RDGOTTK2 SR R3,R3 IC INSTRUCTION COMING UP @VA04250 01514000
B RDMIN GO DO MINIMUM CHECKING @VA04250 01515000
RDMXCMPR CLI MSGMAX,MSGNOMAX MAXIMUM CHECKING TO DO? @VA04250 01516000
BNE RDMAX YES, GO CHECK @VA04250 01517000
RDTYCMPR CLI MSGTYPE,MSGFREE FREE FORM INPUT ALLOWED? @VA04250 01518000
BNE RDTYPE NO, GO DO ANALYSIS @VA04250 01519000
RDRETURN BR R8 CALLER LINK REG @VA04250 01520000
RDMIN IC R3,MSGMIN GET MINIMUM ALLOWED @VA04250 01521000
CR R0,R3 CHECK AGAINST AMOUNT ENTERED @VA04250 01522000
BL RDMINBAD INPUT LESS THAN ALLOWED @VA04250 01523000
B RDMXCMPR BACK TO FURTHER CHECKING @VA04250 01524000
RDMAX IC R3,MSGMAX GET MAX ALLOWED @VA04250 01525000
CR R0,R3 CHECK AGAINST AMOUNT ENTERED @VA04250 01526000
BH RDMAXBAD TOO MUCH ENTERED @VA04250 01527000
B RDTYCMPR BACK FOR FURTHER CHECKING @VA04250 01528000
RDTYPE CLI MSGTYPE,MSGNUM NUMERIC DATA EXPECTED? @VA04250 01529000
BE RDNUM YES @VA04250 01530000
CLI MSGTYPE,MSGHEX HEX INPUT EXPECTED? @VA04250 01531000
BE RDHEX YES @VA04250 01532000
B RDRETURN WE'VE DONE ALL WE CAN HERE @VA04250 01533000
RDNUM LR R2,R1 POINT TO INPUT DATA @VA04250 01534000
LR R3,R0 GET LENGTH OF INPUT @VA04250 01535000
RDNUM1 TM 0(R2),NUMERIC NUMERIC? @VA04250 01536000
BO RDUP YES @VA04250 01537000
CLI 0(R2),BLANK BLANK? @VA04250 01538000
BE RDUP YES, ACCEPT IT @VA04250 01539000
* ---------------------------- 01540000
LA R7,MSGERR5 'NUMERIC INPUT EXPECTED, NON-NUM'@VA04250 01541000
* ---------------------------- 01542000
MVI ENTSW,ENTON DON'T ALLOW REPROMPT @VA04250 01543000
BAL R9,WRTERM GO TELL USER OF INVALID DATA @VA04250 01544000
BR R5 ISSUE ORIGINAL PROMPT AGAIN @VA04250 01545000
RDUP LA R2,DISP1(R2) NEXT INPUT BYTE @VA04250 01546000
BCT R3,RDNUM1 CHECK ALL INPUT @VA04250 01547000
B RDRETURN GO TO EXIT @VA04250 01548000
RDHEX LR R2,R1 INPUT POINT @VA04250 01549000
LR R3,R0 LENGTH @VA04250 01550000
RDHEX1 TM 0(R2),NUMERIC 0 THROUGH 9? @VA04250 01551000
BO RDHUP YES @VA04250 01552000
CLI 0(R2),ALPHAA CHECK A - F NOW. @VA04250 01553000
BL RDBCHK NOT A - F @VA04250 01554000
CLI 0(R2),ALPHAF GT F? @VA04250 01555000
BH RDERR6 YES, NOT A - F @VA04250 01556000
B RDHUP CONTINUE CHECKING @VA04250 01557000
RDBCHK CLI 0(R2),BLANK BLANKS ARE CONCEIVABLE @VA04250 01558000
BNE RDERR6 BUT NOTHING ELSE @VA04250 01559000
RDHUP LA R2,DISP1(R2) NEXT INPUT BYTE @VA04250 01560000
BCT R3,RDHEX1 CHECK ALL INPUT @VA04250 01561000
B RDRETURN WE'RE DONE HERE @VA04250 01562000
* ---------------------------- 01563000
RDERR6 LA R7,MSGERR6 'HEX INPUT EXPECTED. NON-HEX FND'@VA04250 01564000
* ---------------------------- 01565000
MVI ENTSW,ENTON INHIBIT REPROMT LINE NUMBER @VA04250 01566000
BAL R9,WRTERM GO TELL USER @VA04250 01567000
BR R5 GO BACK AND ISSUE PROMPT AGAIN @VA04250 01568000
* ---------------------------- 01569000
RDMINBAD LA R7,MSGERR3 NOT ENOUGH INPUT --REENTER-- @VA04250 01570000
* ---------------------------- 01571000
MVI ENTSW,ENTON DON'T LET WRTERM PUT OUT PROMPT #@VA04250 01572000
BAL R9,WRTERM TELL USER @VA04250 01573000
BR R5 LET CALLER HANDLE REISSUING MESSA@VA04250 01574000
* ---------------------------- 01575000
RDMAXBAD LA R7,MSGERR4 'TOO MUCH INPUT --REENTER--' @VA04250 01576000
* ---------------------------- 01577000
MVI ENTSW,ENTON DON'T LET WRTERM PUT OUT PROMPT #@VA04250 01578000
BAL R9,WRTERM GO TELL USER @VA04250 01579000
BR R5 LET CALLER REISSUE ORIGINAL PROMP@VA04250 01580000
RDNULLIN SR R0,R0 INSURE ZERO INPUT PASSED TO CALLE@VA04250 01581000
BR R8 RETURN TO CALLER @VA04250 01582000
EJECT 01583000
*************************************************************** 01584000
* EXIT ROUTINES 01585000
*************************************************************** 01586000
NORMEXIT L R13,SAVEBACK RESTORE CALLER'S SAVERAREA PTR @VA04250 01587000
LM R14,R12,12(R13) RESTORE CALLER'S REGISTERS @VA04250 01588000
SR R15,R15 RETURN CODE OF 0 @VA04250 01589000
BR R14 RETURN TO CALLER @VA04250 01590000
RETCOD8 L R13,SAVEBACK RESTORE CALLER'S SAVEAREA PTR @VA04250 01591000
LM R14,R12,12(R13) RESTORE CALLER'S REGISTERS @VA04250 01592000
LA R15,8 RETURN CODE OF 8 @VA04250 01593000
BR R14 RETURN TO CALLER @VA04250 01594000
HXEXIT L R13,SAVEBACK RESTORE CALLER'S SAVEAREA PTR @VA04250 01595000
LM R14,R12,12(R13) RESTORE CALLER'S REGISTERS @VA04250 01596000
LA R15,4 RETURN CODE OF 4 @VA04250 01597000
BR R14 BACK TO CALLER @VA04250 01598000
SUMERRR C R15,=F'1' FILE NOT FOUND? @VA04250 01599000
BNE SUMERRR2 NO @VA04250 01600000
MVC XXXXX(PLENGTH),=C'00001' SET PROB NUMBER TO 1 @VA04250 01601000
B RPNUM2 CONTINUE @VA04250 01602000
SUMERRR2 CVD R15,WKDWD CONVERT RETURN CODE TO DECIMAL @VA04250 01603000
UNPK MSGSUME2,WKDWD+FIVE(THREE) @VA04250 01604000
OI MSGSUME2+TWO,UNPKMASK MAKE THE RCODE PRINTABLE @VA04250 01605000
LA R3,MSGSUMEL LENGTH OF MESSAGE @VA04250 01606000
WRTERM MSGSUMER,(R3) TELL USER OF READ ERROR @VA04250 01607000
B RETCOD8 GO TO RETURN CODE 8 EXIT @VA04250 01608000
MSGSUMER DC C'DMMPRO100S ERROR ''' @VA04250 01609000
MSGSUME2 DC C' ' RETURN CODE @VA04250 01610000
MSGSUME3 DC C''' READING FILE ''SUMMARY RECORD A1''' @VA04250 01611000
MSGSUMEL EQU *-MSGSUMER LENGTH OF ERROR MESSAGE @VA04250 01612000
EJECT 01613000
************************************************************** 01614000
* CONSTANTS SAVEAREAS AND EQUATES 01615000
************************************************************** 01616000
DS 0F @VA04250 01617000
SAVEAREA EQU * THIS PROGRAM'S SAVE AREA @VA04250 01618000
SAVEUSR DS F USER WORD @VA04250 01619000
SAVEFWD DS F FORWARD POINTER @VA04250 01620000
SAVEBACK DS F BACKWARD POINTER @VA04250 01621000
SAVER14 DS F SAVE AREA FOR CALLER'S R14 @VA04250 01622000
SAVER15 DS F SAVE AREA FOR CALLER'S R15 @VA04250 01623000
SAVER0 DS F SAVE AREA FOR CALLER'S R0 @VA04250 01624000
SAVER1 DS F SAVE AREA FOR CALLER'S R1 @VA04250 01625000
SAVER2 DS F SAVE AREA FOR CALLER'S R2 @VA04250 01626000
SAVER3 DS F SAVE AREA FOR CALLER'S R3 @VA04250 01627000
SAVER4 DS F SAVE AREA FOR CALLER'S R4 @VA04250 01628000
SAVER5 DS F SAVE AREA FOR CALLER'S R5 @VA04250 01629000
SAVER6 DS F SAVE AREA FOR CALLER'S R6 @VA04250 01630000
SAVER7 DS F SAVE AREA FOR CALLER'S R7 @VA04250 01631000
SAVER8 DS F SAVE AREA FOR CALLER'S R8 @VA04250 01632000
SAVER9 DS F SAVE AREA FOR CALLER'S R9 @VA04250 01633000
SAVER10 DS F SAVE AREA FOR CALLER'S R10 @VA04250 01634000
SAVER11 DS F SAVE AREA FOR CALLER'S R11 @VA04250 01635000
SAVER12 DS F SAVE AREA FOR CALLER'S R12 @VA04250 01636000
R1SAVE DS F SAVE AREA FOR R1 @VA04250 01637000
RD59 DS 5F SAVE AREA FOR R5 THROUGH R9 @VA04250 01638000
R23 DS 2F SAVE AREA FOR R2 AND R3 @VA04250 01639000
WKWD DS F ONE WORD OF WORK AREA @VA04250 01640000
WKDWD DS D DOUBLE WORD OF WORK AREA @VA04250 01641000
PNUMIN EQU * READ AREA FOR NEW PROBLEM NUMBER @VA04250 01642000
OUTPUT DS CL80 OUTPUT AREA FOR MESSAGES @VA04250 01643000
ADDREC EQU OUTPUT OUTPUT AREA FOR ADDED DATA @VA04250 01644000
ADDDATE EQU OUTPUT+34 OUTPUT AREA FOR ADDED DATE @VA04250 01645000
ADDTIME EQU OUTPUT+25 OUTPUT AREA FOR ADDED TIME @VA04250 01646000
INPUT DS CL160 INPUT AREA FOR USER RESPONSES @VA04250 01647000
TEXTSW DC C' ' 01647100
TEXTSWON EQU X'FF' 01647200
SPACE 1 01648000
************** SWITCH INDICATING WHETHER OR NOT 01649000
OLDSW DC X'00' WE ARE PROCESSING AN OLD PROBLEM @VA04250 01650000
OLDON EQU X'01' PROCESSING DATA FOR AN OLD PROB @VA04250 01651000
OLDOFF EQU X'00' NEW PROBLEM @VA04250 01652000
SPACE 1 01653000
************** SWITCH INDICATING WHETHER OR NOT 01654000
DBYTE DC X'00' REPROMPTING IS IN PROGRESS @VA04250 01655000
REPROMPT EQU X'01' REPROMPTING IS IN PROGRESS @VA04250 01656000
NORMAL EQU X'00' REPROMPTING NOT IN PROGRESS @VA04250 01657000
************** 01658000
PNSWITCH DC X'00' LOOKING FOR PROBLEM NUMBER SW @VA04250 01659000
PNSWON EQU X'01' WE ARE LOOKING @VA04250 01660000
PNSWOFF EQU X'00' NOT LOOKING @VA04250 01661000
************** 01662000
FOFO DC C'00000' X'F0F0F0F0F0' MASK @VA04250 01663000
ADDSUM DS FL3'0' AREA USED FOR ARITHMATIC @VA04250 01664000
SPACE 1 01665000
************** FIRST TIME SWITCH FOR WRTERM. 01666000
ENTSW DC X'00' NUMBER WILL BE DISPLAYED. @VA04250 01667000
ENTON EQU X'01' PROMPT NUMBER ALREADY DISPLAYED @VA04250 01668000
ENTOFF EQU X'00' PROMPT NUMBER NOT YET DISPLAYED @VA04250 01669000
************** 01670000
AONE DC X'1C' PACKED 1 TO ADD TO PROBLEM NUMBER@VA04250 01671000
************** 01672000
PRBXXXXX DC C'PRB00000' FILE NAME OF PROBLEM REPORT @VA04250 01673000
XXXXX EQU PRBXXXXX+3 NUMERIC PORTION OF FILENAME @VA04250 01674000
PLENGTH EQU 5 LENGTH OF NUMERIC PORTION @VA04250 01675000
************** 01676000
PRBFTFN DC C'REPORT A1' PROBLEM RERORT FILETYPE AND MODE @VA04250 01677000
SUMMFILE DC C'SUMMARY RECORD A1' NEXT PROB NUMBER FILE @VA04250 01678000
VSRCH DC V(DMMSEA) POINTER TO SEARCH ROUTINE @VA04250 01679000
VWRTREC DC V(DMMWRT) POINTER TO WRITEREC ROUTINE @VA04250 01680000
KYREST DC A(KYAREA) SAVE FOR CURRENT KEY POINTER @VA04250 01681000
LOGPTR DC A(LOGTBL) POINTER TO REPROMPT LOG TABLE @VA04250 01682000
LOGCURR DC A(LOGTBL) CURRENT LOCATION IN LOG TABLE @VA04250 01683000
*************************************************************** 01684000
* FOLLOWING VALUES INSURE CORRECT SPELLING OF MAJOR SYMPTOMS 01685000
*************************************************************** 01686000
ABEND DC C'ABEND' @VA04250 01687000
DC 16C' ' INSURE NO TRASH IF EXTRA DATA @VA04250 01688000
MSG DC C'MS' @VA04250 01689000
DC 16C' ' INSURE NO TRASH IF EXTRA @VA04250 01690000
WAIT DC C'WAIT' @VA04250 01691000
DC 9C' ' @VA04250 01692000
LOOP DC C'LOOP' @VA04250 01693000
DC 9C' ' @VA04250 01694000
INCORR DC C'INCORROUT' @VA04250 01695000
DC 3C' ' @VA04250 01696000
PERFORM DC C'PERFM' @VA04250 01697000
DC 7C' ' @VA04250 01698000
INFORM DC C'INFORMATION' @VA04250 01699000
DC 1C' ' @VA04250 01700000
DOCUM DC C'DOC' @VA04250 01701000
DC 10C' ' @VA04250 01702000
INCSPELL DC CL10'DUPLICATE' @VA04250 01703000
DC CL10'MISSING' @VA04250 01704000
DC CL10'OVERLAID' @VA04250 01705000
DC CL10'GARBLED' @VA04250 01706000
DC CL10'FORMAT' @VA04250 01707000
DC CL10'FUNCTION' @VA04250 01708000
DC CL10'SEQUENCE' @VA04250 01709000
DC X'FF' MARKS END OF INCORROUT CHECKING @VA04250 01710000
INCEND EQU X'FF' END OF INCORROUT COMPARE DATA @VA04250 01711000
INCLEN EQU 10 LENGTH OF EACH ENTRY ABOVE @VA04250 01712000
STATE1 DC C'ENA' ENABLED STATE VALIDITY CHECK @VA04250 01713000
STATE2 DC C'DIS' DISABLED STATE VALIDITY CHECK @VA04250 01714000
*************************************************************** 01715000
* MESSAGE TO TELL USER PROBLEM NUMBER 01716000
*************************************************************** 01717000
MSGTELL DC C'THIS PROBLEM HAS BEEN ASSIGNED NUMBER ' @VA04250 01718000
MSGPRB DS CL5 PROBLEM NUMBER WILL GO HERE @VA04250 01719000
LMSGTELL EQU *-MSGTELL LENGTH OF MSGTELL MESSAGE @VA04250 01720000
EJECT 01721000
*************************************************************** 01722000
* ALL MESSAGES ISSUED ARE CODED USING A SPECIAL MSGP MACRO. 01723000
* MSGP MACRO PROTOTYPE IS AS FOLLOWS: 01724000
* &NAME MSGP MSG=,MIN=,MAX=,TYPE=,MORE=NO,KEY= 01725000
* MSG MESSAGE TEXT TO APPEAR AT TERMINAL 01726000
* MIN MINIMUM NUMBER OF CHARACTERS ALLOWED ON INPUT 01727000
* MAX MAXIMUM NUMBER OF CHARACTERS ALLOWED ON INPUT 01728000
* TYPE TYPE OF ALLOWED INPUT (HEX,CHAR, OR NUMERIC) 01729000
* MORE WHETHER MORE LINES FOLLOW IN THIS PROMPT BEFORE READ 01730000
* KEY KEYWORD TO BE ASSOCIATED WITH USER RESPONSE 01731000
*************************************************************** 01732000
MSGAREA EQU * @VA04250 01733000
MSGEXIST MSGP MSG='DOES THIS PERTAIN TO AN EXISTING PROBLEM REPORT? (YX01734000
OR N)',MIN=1,MAX=3 @VA04250 01735000
MSGPCPU MSGP MSG='DOES PROBLEM PERTAIN TO THIS CPU? (Y OR N)', C01736000
KEY=VMCPU,MAX=3,MIN=1 @VA04250 01737000
MSGCPU MSGP MAX=3,TYPE=NUM,MSG='ENTER CPU TYPE. (NNN)', @VA04250X01738000
MIN=3 @VA04250 01739000
MSGSER MSGP TYPE=NUM,MSG='ENTER CPU SERIAL. (NNNNN)',MIN=5,MAX=5 01740000
MSGSDATA MSGP MSG='ENTER LOCATION OF SUPPORTING DATA.' @VA04250 01741000
MSGSDAT2 MSGP MSG='ENTER FN FT FM PLUS DESCRIPTION OR NULL WHEN DONE' 01742000
MSGSEV MSGP TYPE=NUM,MAX=1,MSG='ENTER SEVERITY. 1-4 (N)' @VA04250 01743000
MSGBYPAS MSGP MSG='IS BYPASS FOR PROBLEM REQUESTED? (Y OR N)', X01744100
MAX=3,MIN=1 @VA05440 01744200
MSGCID MSGP KEY=VMCOMPID,MAX=10,MSG='ENTER COMPONENT ID IF KNOWN, EGX01745000
5749DMK00 (MAX 10 CHAR)',MIN=1 @VA04250 01746000
MSGPLC MSGP MAX=3,TYPE=NUM,KEY=VMPLC,MSG='ENTER PLC LEVEL. (1-3 CHARC01747000
-OMIT LEADING ZEROS)',MIN=1 @VA05440 01748100
MSGSCP MSGP MAX=3,TYPE=NUM,KEY=VMSCPLV,MSG='ENTER SCP LEVEL. (1-3 CHA01749000
AR-OMIT LEADING ZEROS)',MIN=1 @VA05440 01750100
MSGDATE MSGP MSG='ENTER DATE OF FAILURE. (MM/DD/YY)',MIN=8, @V4M0224X01751100
MAX=8 @VA04250 01752000
MSGFAIL MSGP MORE=YES,MSG='SELECT ONE OF THE FOLLOWING KEYWORDS' 01753000
MSGFAIL2 MSGP MORE=YES,MSG='MSG ABEND' @VA04250 01754000
MSGFAIL3 MSGP MORE=YES,MSG='DOC PERFORMANCE (PER)' @VA04250 01755000
MSGFAIL4 MSGP MORE=YES,MSG='LOOP INCORROUT (INC)' @VA04250 01756000
MSGFAIL5 MSGP MSG='WAIT INFORMATION (INF)',KEY=VMFAILURE, @VA04250X01757000
MIN=3 @VA04250 01758000
MSGENV MSGP MSG='ENTER OPERATING ENVIRONMENT. CP,CMS,RSCS,VS1,VS2,DOX01759000
S,ETC. (20 CHAR MAX)',KEY=VMENVIR,MAX=20,MIN=1 @VA04250 01760000
MSGABCOD MSGP MSG='ENTER ABEND CODE. EG 0CX',KEY=VMFAILURE,MAX=10,MIN=X01761000
1 @VA04250 01762000
MSGFMOD MSGP MSG='ENTER FAILING MODULE IF KNOWN. EG DMKPAG (8 CHAR MAC01763000
X)',MAX=8,KEY=VMMODULE,MIN=1 @VA04250 01764000
MSGDSP MSGP MSG='ENTER DISPLACEMENT WITHIN FAILING MODULE. (4 CHAR EX01765000
XACTLY)',KEY=VMDISP,TYPE=HEX,MAX=4,MIN=4 @VA04250 01766000
MSGCALL MSGP MSG='ENTER CALLING MODULE IF KNOWN (8 CHAR MAX)',MAX=8,KX01767000
EY=VMCALLER,MIN=1 @VA04250 01768000
MSGCMD MSGP MSG='ENTER COMMAND WHICH CAUSED FAILURE IF APPLICABLE',KX01769000
EY=VMCMD,MAX=79 @VA04250 01770000
MSGDOC MSGP MSG='SELECT ONE OF THE FOLLOWING:',MORE=YES @VA04250 01771000
MSGDOC2 MSGP MSG='PUB PLC OR PTF FICHE',KEY=VMDOC, @VA04250X01772000
MAX=5,MIN=3 @VA04250 01773000
MSGPUB MSGP MSG='ENTER PUBLICATION NUMBER. EG GC20/1820',KEY=VMDOCNOX01774000
,MAX=20,MIN=5 @VA04250 01775000
MSGPAGE MSGP MSG='ENTER PAGE NUMBER IN ERROR',MAX=6,MIN=1, @VA04250X01776000
KEY=VMPAGE @VA04250 01777000
MSGDEV MSGP MSG='ENTER DEVICE TYPE IF APPLICABLE',KEY=VMDEVTYPE 01778000
MSGINC MSGP MSG='SELECT BEST DESCRIPTION FROM FOLLOWING',MORE=YES 01779000
MSGINC2 MSGP MSG='DUPLICATE,MISSING,OVERLAID,GARBLED,FORMAT,FUNCTION,X01780000
SEQUENCE',KEY=VMDATA,MAX=10,MIN=6 @VA04250 01781000
MSGSTATE MSGP MSG='ENTER WHETHER DISABLED OR ENABLED. (DIS OR ENA)',MIN01782000
N=3,KEY=VMSTATE @VA04250 01783000
MSGLMOD MSGP MSG='ENTER KNOWN MODULES WITHIN LOOP. EG MOD1,MOD2,MOD3'X01784000
,KEY=VMMODULE,MAX=79 @VA04250 01785000
MSGLADDR MSGP MSG='ENTER UP TO 10 LOOP ADDRESSES. ADDR1,ADDR2,ADDR3..'X01786000
,KEY=VMADDR,MAX=79 @VA04250 01787000
MSGCPSW MSGP MSG='ENTER CURRENT PSW. (XXXXXXXXXXXXXXXX) (16 CHAR EXACX01788000
TLY)',TYPE=HEX,MAX=16,MIN=16 @VA04250 01789000
MSGMSG MSGP MSG='ENTER COMPLETE MESSAGE NUMBER. EG DMKAAANNNA',KEY=VX01790000
MFAILURE,MAX=20,MIN=1 @VA04250 01791000
MSGRCODE MSGP MSG='ENTER RETURN CODE IF APPLICABLE',KEY=VMRC,MAX=8,MINX01792000
=1 @VA04250 01793000
MSGPREV MSGP MSG='ENTER PREVIOUS MESSAGE IF APPLICABLE',KEY=VMPREVMSGX01794000
,MAX=20,MIN=1 @VA04250 01795000
MSGPERF MSGP MSG='ENTER NATURE OF DEGRADATION. EG TOTAL,TP,I/O,VIRTMAC01796000
CH',KEY=VMDEGRADE,MAX=20 @VA04250 01797000
MSGPNUM MSGP MSG='ENTER PROBLEM NUMBER. (1-5 DIGITS)',TYPE=NUM,MIN=1,X01798000
MAX=5 @VA04250 01799000
MSGNOPRB MSGP MSG='PRBXXXXX REPORT A1 DOES NOT EXIST.' @VA04250 01800000
MSGTEXT MSGP MSG='ENTER TEXT DESCRIPTION OF PROBLEM OR NULL LINE' 01801000
MSGTEXT1 MSGP MSG='ENTER TEXT (MAX 80 CHAR/LINE)' @VA04250 01802000
MSGDONE MSGP MSG='PRBNNNNN REPORT A1 APPENDED' @VA04250 01803000
MSGERR1 MSGP MSG='REPROMPT WITHIN REPROMPT NOT ALLOWED' @VA04250 01804000
MSGERR2 MSGP MSG='REQUESTED REPROMPT LINE NOT FOUND' @VA04250 01805000
MSGERR3 MSGP MSG='MINIMUM INPUT NOT ENTERED --REENTER--' @VA04250 01806000
MSGERR4 MSGP MSG='MAXIMUM ALLOWED INPUT EXCEEDED --REENTER--' 01807000
MSGERR5 MSGP MSG='NUMERIC INPUT EXPECTED. NON-NUMERIC FOUND. --REENTEC01808000
R--' @VA04250 01809000
MSGERR6 MSGP MSG='HEX INPUT EXPECTED. NON-HEX FOUND. --REENTER--' 01810000
MSGERR7 MSGP MSG='PLEASE REENTER IN THE EXACT FORMAT SHOWN BETWEEN THX01811000
E PARENTHESES' @VA04250 01812000
MSGERRI MSGP MSG='IMBEDDED BLANKS NOT ALLOWED IN THIS REPLY' @VA04250 01813000
EJECT 01814000
*************************************************************** 01815000
* ADCONS POINTING TO DATA AREAS CUT DOWN ON BASE REGISTERS 01816000
*************************************************************** 01817000
DS 0F @VA04250 01818000
WRTPARM EQU * PARMS PASSED TO WRITEREC @VA04250 01819000
INTPT DC A(INTAREA) POINTER TO INTSECT AREA @VA04250 01820000
KYOUTLN DC A(KYAREALN) POINTER TO LENGTH OF KY DATA @VA04250 01821000
TXTOUTLN DC A(TEXTLN2) POINTER TO TEXT LENGTH @VA04250 01822000
SUPPLNTH DC A(SUPPLN2) PTR TO SUPPLEMENTARY DATA LENGTH @VA04250 01823000
* END OF PARMS USED BY WRITEREC 01824000
SUPPCURR DC A(SUPPDATA) CURRENT PTR TO SUPPLEMENTARY DATA@VA04250 01825000
SUPPPT DC A(SUPPDATA) START OF SUPPLEMENTARY DATA @VA04250 01826000
SUPPBACK DC A(SUPPDATA) POINTER USED IN REPROMPT @VA04250 01827000
SUPPEND DC A(SUPPEND1) POINTER TO END OF SUPP DATA AREA @VA04250 01828000
TEXTPT DC A(TEXTAREA) POINTER TO TEXT I/O AREA @VA04250 01829000
TEXTCURR DC A(TEXTAREA) CURRENT PTR WITHIN TEXT I/O AREA @VA04250 01830000
TEXTEND DC A(TEXTEND1) POINTER TO END OF TEXT AREA @VA04250 01831000
TEXTLAST DC A(TEXTAREA) TO CONTROL REPROMPTS FOR TEXT @VA04250 01832000
TEXTBACK DC A(TEXTAREA) TO CONTROL REPROMPTS FOR TEXT @VA04250 01833000
TEXTLNTH DC A(TEXTLN2) POINTER TO LENGTH OF ENTERED TEXT@VA04250 01834000
KYAREAPT DC A(KYAREA) POINTER TO KEY AREA @VA04250 01835000
KYCURRPT DC A(KYAREA) CURRENT POINTER INTO KEYAREA @VA04250 01836000
PATCH DC 80F'0' PATCH AREA @VA04250 01837000
LTORG @VA04250 01838000
EJECT 01839000
*************************************************************** 01840000
* DATA AREAS. ALL ARE ADDRESSED VIA ADCONS ABOVE 01841000
*************************************************************** 01842000
* TRACE TABLE 01843000
LOGTBL DC 300F'0' TABLE USED TO LOG PROMPTS @VA04250 01844000
ENDMARK DC X'FF' END OF LOGTABLE INDICATOR @VA04250 01845000
DS 0F @VA04250 01846000
INTAREA DC 160C' ' AREA TO CONTAIN INTERNAL DATA @VA04830 01847500
KYAREALN DC X'00000000' LENGTH OF DATA IN KEYAREA @VA04250 01848000
KYAREA DC 400X'00' AREA TO CONTAIN KYWDS AND VALUES @VA04250 01849000
SUPPLN2 DC X'0000' LENGTH OF SUPPLEMENTARY DATA @VA04250 01850000
SUPPDATA DC 400C' ' AREA TO CONTAIN SUPLEMENTARY DATA@VA04250 01851000
SUPPEND1 EQU * END OF SUPLEMENTARY DATA @VA04250 01852000
DC C' ' FOR EASE OF CLEARING SUPPDATA @VA04250 01853000
TEXTLN2 DC X'0000' LENGTH OF ENTERED TEXT INFO @VA04250 01854000
TEXTAREA DC 1600C' ' TEXT DESCRIPTION OF PROBLEM @VA04250 01855000
TEXTEND1 EQU * END OF TEXT AREA @VA04250 01856000
*************************************************************** 01857000
* GENERAL EQUATES 01858000
*************************************************************** 01859000
PACKMASK EQU X'0F' USED TO MAKE A PACKED VALUE PLUS @VA04250 01860000
UNPKMASK EQU X'F0' USED TO MAKE UNPKD VALUES PRINT @VA04250 01861000
BLANK EQU C' ' BLANK @VA04250 01862000
FNOTFND EQU X'1C' FILE NOT FOUND @VA04250 01863000
NOKYWD EQU X'00' NO KEYWORD IN MESSAGE @VA04250 01864000
HEXZERO EQU X'00' VALUE OF HEX 0 @VA04250 01865000
FENCE EQU X'FF' END OF FIELD INDICATOR @VA04250 01866000
NUMERIC EQU X'F0' NUMERIC MASK @VA04250 01867000
ALPHAA EQU C'A' CHARACTER A @VA04250 01868000
ALPHAF EQU C'F' CHARACTER F @VA04250 01869000
YES EQU C'Y' USED TO TEST FOR YES @VA04250 01870000
NO EQU C'N' USED TO TEST FOR NO @VA04250 01871000
CHARZERO EQU C'0' CHARACTER ZERO @VA04250 01872000
FOUR EQU C'4' 4 FOR SEVERITY LIMIT CHECKING @VA04250 01873000
SEVDFLT EQU C' ' SEVERITY DEFAULT OF BLANK @VA04250 01874000
ONE EQU C'1' 1 FOR SEVERITY LIMIT CHECKING @VA04250 01875000
SLASH EQU C'/' SLASH FOR DATE FORMAT CHECKING @VA04250 01876000
DASH EQU C'-' DASH FOR INSERTING IN OUTPUT @VA04250 01877000
DISP1 EQU 1 INCR OR DECR 1 @VA04250 01878000
TWO EQU 2 FOR MVC LENGTHS ETC. @VA04250 01879000
CKLN1 EQU 2 COMPARE LENGTH FOR ABEND TYPE @VA04250 01880000
THREE EQU 3 FOR MVC LENGTHS ETC. @VA04250 01881000
CKLN2 EQU 3 COMPARE LENGTH FOR ABEND TYPE @VA04250 01882000
PLCCNT EQU 3 SIZE OF PLC INFO @VA04250 01883000
SCPCNT EQU 3 SIZE OF SCP INFO @VA04250 01884000
DISP4 EQU 4 4 FOR MVC LENGTHS ETC. @VA04250 01885000
WKDWD2 EQU WKDWD+4 SECOND WORD OF WORD DOUBLE WD @VA04250 01886000
FIVE EQU 5 FOR MVC LENGTHS ETC. @VA04250 01887000
FIVECARD EQU 5 NUMBER OF CARDS OF SUPP DATA @VA04250 01888000
SIX EQU 6 FOR MVC LENGTHS ETC. @VA04250 01889000
SEVEN EQU 7 FOR MVC LENGTHS ETC. @VA04250 01890000
WKDWDEND EQU WKDWD+7 LAST BYTE OF WORK DOUBLE WORD @VA04250 01891000
EIGHT EQU 8 FOR MVC LENGTHS ETC. @VA04250 01892000
CPSWLN EQU 12 LENGTH OF 'CURRENT PSW =' @VA04250 01893000
TRSIZE EQU 12 TRACE TABLE ENTRY SIZE @VA04250 01894000
THIRTEEN EQU 13 LENGTH OF ***ADDED*** LITERAL @VA04250 01895000
FIFTEEN EQU 15 TO PUT LOOP ADDRESSED IN OUTPUT @VA04250 01896000
SIXTEEN EQU 16 FOR MVC LENGTH ETC. @VA04250 01897000
MAXLINES EQU 20 MAX TEXT INPUT ALLOWED @VA04250 01898000
CARDLEN EQU 80 SIZE OF CARD OF DATA @VA04250 01899000
TWOK EQU 2048 FOR SETTING UP BASE REGS @VA04250 01900000
FOURK EQU 4096 FOR SETTING UP BASE REGS @VA04250 01901000
EIGHTK EQU 8192 FOR SETTING UP BASE REGS @VA04250 01902000
PSWL EQU 16 LENGTH OF A PSW @VA04250 01903000
LFLDLEN EQU 4 LENGTH OF LENGTH FIELD (VAR RCD) @VA04250 01904000
*************************************************************** 01905000
* EXTERNAL DSECTS AND REGISTER EQUATES 01906000
*************************************************************** 01907000
COPY MSGCNTRL @VA04250 01908000
COPY INTSECT @VA04250 01909000
COPY SYMSECT @VA04250 01910000
REGEQU @VA04250 01911000
NUCON @VA04250 01912000
END 01913000