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