TITLE 'ICBVUT01 UTILITY MODULE JUNE 10, 1976 *00001000 ' 00002000 ICBVUT01 CSECT , 0001 00003000 @MAINENT DS 0H 0001 00004000 USING *,@15 0001 00005000 B @PROLOG 0001 00006000 DC AL2(@EP00001-@MAINENT) 00007000 DC AL1(16) 0001 00008000 DC C'ICBVUT01 77.062' 0001 00009000 ICBVUDBR DS 0H 0001 00010000 USING *,@15 0001 00011000 B @PROLOG 0001 00012000 DC AL2(@EP03087-ICBVUDBR) 00013000 ENTRY ICBVUDBR 00014000 ICBVUEXT DS 0H 0001 00015000 USING *,@15 0001 00016000 B @PROLOG 0001 00017000 DC AL2(@EP03233-ICBVUEXT) 00018000 ENTRY ICBVUEXT 00019000 ICBVUEXP DS 0H 0001 00020000 USING *,@15 0001 00021000 B @PROLOG 0001 00022000 DC AL2(@EP03489-ICBVUEXP) 00023000 ENTRY ICBVUEXP 00024000 DROP @15 00025000 @PROLOG STM @14,@12,12(@13) 0001 00026000 BALR @12,0 0001 00027000 @PSTART LA @11,4095(,@12) 0001 00028000 LA @10,4095(,@11) 0001 00029000 LA @09,4095(,@10) 0001 00030000 LA @08,4095(,@09) 0001 00031000 LA @03,4095(,@08) 0001 00032000 USING @PSTART,@12 0001 00033000 USING @PSTART+4095,@11 0001 00034000 USING @PSTART+8190,@10 0001 00035000 USING @PSTART+12285,@09 0001 00036000 USING @PSTART+16380,@08 0001 00037000 USING @PSTART+20475,@03 0001 00038000 ST @13,@SA00001+4 0001 00039000 LA @14,@SA00001 0001 00040000 ST @14,8(,@13) 0001 00041000 LR @13,@14 0001 00042000 AH @15,4(,@15) 0001 00043000 BR @15 0001 00044000 @EP00001 DS 0H 0002 00045000 * RPLVPTR=REG1; /* ADDR TO REQUEST BLK @Y30LB26*/ 00046000 ST REG1,RPLVPTR 0159 00047000 * RESPECIFY 0160 00048000 * REG1 UNRSTD; /* FREE REG1 @Y30LB26*/ 00049000 * RVRPTR=ADDR(RPLVUTIL); /* ADDR TO OP CD @Y30LB26*/ 00050000 L @05,RPLVPTR 0161 00051000 LA @02,RPLVUTIL(,@05) 0161 00052000 ST @02,RVRPTR 0161 00053000 * 0162 00054000 * /*****************************************************************/ 00055000 * /* */ 00056000 * /* SET UP ADDRESSABILITY TO MSVC CONTROL BLK @Y30LB26*/ 00057000 * /* AND CHECK TO SEE IF MSVC IS DISABLED @Y30LB26*/ 00058000 * /* */ 00059000 * /*****************************************************************/ 00060000 * 0162 00061000 * VVIPTR=RPLVVICB; /* ADDR TO VVICB @Y30LB26*/ 00062000 L VVIPTR,RPLVVICB(,@05) 0162 00063000 * IF VVIFLG0=ON /* INVENTORY DISAB ? @Y30LB26*/ 00064000 * THEN /* @Y30LB26*/ 00065000 TM VVIFLG0(VVIPTR),B'10000000' 0163 00066000 BNO @RF00163 0163 00067000 * DO; /* @Y30LB26*/ 00068000 * RPLVRETC=FOUR; /* SET BAD RET CODE @Y30LB26*/ 00069000 MVC RPLVRETC(2,@05),@CB00749 0165 00070000 * RPLRCODE=VVICDISA; /* INDIC MSVC DISABLED @Y30LB26*/ 00071000 MVC RPLRCODE(2,@05),@CB00785 0166 00072000 * RETURN; /* @Y30LB26*/ 00073000 @EL00001 L @13,4(,@13) 0167 00074000 @EF00001 DS 0H 0167 00075000 @ER00001 LM @14,@12,12(@13) 0167 00076000 BR @14 0167 00077000 * END; /* @Y30LB26*/ 00078000 * 0169 00079000 * /*****************************************************************/ 00080000 * /* */ 00081000 * /* CHECK TO SEE IF JOURNAL IS DISABLED @Y30LB26*/ 00082000 * /* */ 00083000 * /*****************************************************************/ 00084000 * 0169 00085000 * IF VVIFLG2=ON&RPLJRCVY=OFF /* JOURNAL DISABLED ? @Y30LB26*/ 00086000 * THEN /* @Y30LB26*/ 00087000 @RF00163 TM VVIFLG2(VVIPTR),B'00100000' 0169 00088000 BNO @RF00169 0169 00089000 L @05,RPLVPTR 0169 00090000 TM RPLJRCVY(@05),B'00000010' 0169 00091000 BNZ @RF00169 0169 00092000 * DO; /* @Y30LB26*/ 00093000 * 0170 00094000 * /*************************************************************/ 00095000 * /* */ 00096000 * /* CHECK TO SEE IF READ ONLY ACCESS IS DESIRED @Y30LB26*/ 00097000 * /* */ 00098000 * /*************************************************************/ 00099000 * 0171 00100000 * IF RVROPCD^=READREC /* READ ONLY OPER ? @Y30LB26*/ 00101000 * THEN /* @Y30LB26*/ 00102000 * 0171 00103000 L @02,RVRPTR 0171 00104000 CLI RVROPCD(@02),X'87' 0171 00105000 BE @RF00171 0171 00106000 * /***********************************************************/ 00107000 * /* */ 00108000 * /* IF NOT READ ONLY, HAULT PROCESSING AND @Y30LB26*/ 00109000 * /* SEND REASON CODE @Y30LB26*/ 00110000 * /* */ 00111000 * /***********************************************************/ 00112000 * 0172 00113000 * DO; /* @Y30LB26*/ 00114000 * RPLVRETC=FOUR; /* SET BAD RET CODE @Y30LB26*/ 00115000 MVC RPLVRETC(2,@05),@CB00749 0173 00116000 * RPLRCODE=JRNLDISA; /* JOURNAL DISABLED @Y30LB26*/ 00117000 MVC RPLRCODE(2,@05),@CB00787 0174 00118000 * RETURN; /* @Y30LB26*/ 00119000 B @EL00001 0175 00120000 * END; /* @Y30LB26*/ 00121000 * END; /* @Y30LB26*/ 00122000 @RF00171 DS 0H 0178 00123000 * 0178 00124000 * /*****************************************************************/ 00125000 * /* */ 00126000 * /* INITILIZE BIT SETTINGS BEFORE ENTRY @Y30LB26*/ 00127000 * /* */ 00128000 * /*****************************************************************/ 00129000 * 0178 00130000 * INTERFLG=BIT8ZERO; /* CLEAR INTER FLGS @Y30LB26*/ 00131000 @RF00169 MVI INTERFLG,X'00' 0178 00132000 * PASSFLAG=BITZERO; /* CLEAR EXTER ENT FLGS @Y30LB26*/ 00133000 * 0179 00134000 MVC PASSFLAG(2),@CB00747 0179 00135000 * /*****************************************************************/ 00136000 * /* */ 00137000 * /* INITILIZE KEY IDS THAT COULD HAVE BEEN ALTERED @Y30LB26*/ 00138000 * /* IN A PREVIOUS EXECUTION OF THE PROGRAM @Y30LB26*/ 00139000 * /* */ 00140000 * /*****************************************************************/ 00141000 * 0180 00142000 * VBLKKY=BLANK; /* CLEAR KEY @Y30LB26*/ 00143000 MVI VBLKKY,C' ' 0180 00144000 * VIDKY=FIXZERO; /* INIT ID FIELD @Y30LB26*/ 00145000 MVI VIDKY,X'00' 0181 00146000 * GBLKKY=BLANK; /* CLEAR GRP KEY @Y30LB26*/ 00147000 MVI GBLKKY,C' ' 0182 00148000 * GIDKY=FIXZERO; /* INIT GRP ID FIELD @Y30LB26*/ 00149000 MVI GIDKY,X'00' 0183 00150000 * DBLKKY=BLANK; /* CLEAR DUP KEY @Y30LB26*/ 00151000 MVI DBLKKY,C' ' 0184 00152000 * DIDKY=FIXZERO; /* INIT DUP ID FIELD @Y30LB26*/ 00153000 MVI DIDKY,X'00' 0185 00154000 * 0186 00155000 * /*****************************************************************/ 00156000 * /* */ 00157000 * /* TEST FOR REMOVE VOLUME RECORD OPERATION CODE @Y30LB26*/ 00158000 * /* */ 00159000 * /*****************************************************************/ 00160000 * 0186 00161000 * IF RVROPCD=REMOVOL /* TEST OP CODE @Y30LB26*/ 00162000 * THEN /* @Y30LB26*/ 00163000 L @02,RVRPTR 0186 00164000 CLI RVROPCD(@02),X'81' 0186 00165000 BNE @RF00186 0186 00166000 * 0187 00167000 * /***************************************************************/ 00168000 * /* */ 00169000 * /* CALL ROUTINE AND RETURN TO ICBVCR00 @Y30LB26*/ 00170000 * /* */ 00171000 * /***************************************************************/ 00172000 * 0187 00173000 * DO; /* @Y30LB26*/ 00174000 * CALL REMOVEVR; /* REMOVE VOLUME REC @Y30LB26*/ 00175000 * 0188 00176000 BAL @14,REMOVEVR 0188 00177000 * /*************************************************************/ 00178000 * /* */ 00179000 * /* CHECK RETURN CODE AND IF BAD SEE IF JOURNALED @VS32198*/ 00180000 * /* BEFORE. IF SO INDICATE THIS FACT. @VS32198*/ 00181000 * /* */ 00182000 * /*************************************************************/ 00183000 * 0189 00184000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @VS32198*/ 00185000 L @02,RPLVPTR 0189 00186000 CLC RPLVRETC(2,@02),@CB00747 0189 00187000 BE @RF00189 0189 00188000 * DO; /* @VS32198*/ 00189000 * IF JRNLEDSW=ON THEN /* JOURNALED BEFORE ? @VS32198*/ 00190000 TM JRNLEDSW,B'00000001' 0191 00191000 BNO @RF00191 0191 00192000 * RPLVJRNL=ON; /* INDIC JRNLED @VS32198*/ 00193000 OI RPLVJRNL(@02),B'00000001' 0192 00194000 * END; /* @VS32198*/ 00195000 * RETURN; /* RETURN TO CALLER @Y30LB26*/ 00196000 B @EL00001 0194 00197000 * END; /* @Y30LB26*/ 00198000 * 0196 00199000 * /*****************************************************************/ 00200000 * /* */ 00201000 * /* TEST FOR CREATE GROUP RECORD OPERATION CODE @Y30LB26*/ 00202000 * /* */ 00203000 * /*****************************************************************/ 00204000 * 0196 00205000 * IF RVROPCD=CREGRP /* TEST OP CODE @Y30LB26*/ 00206000 * THEN /* @Y30LB26*/ 00207000 @RF00186 L @02,RVRPTR 0196 00208000 CLI RVROPCD(@02),X'82' 0196 00209000 BNE @RF00196 0196 00210000 * 0197 00211000 * /***************************************************************/ 00212000 * /* */ 00213000 * /* CALL ROUTINE AND RETURN TO ICBVCR00 @Y30LB26*/ 00214000 * /* */ 00215000 * /***************************************************************/ 00216000 * 0197 00217000 * DO; /* @Y30LB26*/ 00218000 * CALL CREATEG; /* GO CREATE GROUP @Y30LB26*/ 00219000 * 0198 00220000 BAL @14,CREATEG 0198 00221000 * /*************************************************************/ 00222000 * /* */ 00223000 * /* CHECK RETURN CODE AND IF BAD SEE IF JOURNALED @VS32198*/ 00224000 * /* BEFORE. IF SO INDICATE THIS FACT. @VS32198*/ 00225000 * /* */ 00226000 * /*************************************************************/ 00227000 * 0199 00228000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @VS32198*/ 00229000 L @02,RPLVPTR 0199 00230000 CLC RPLVRETC(2,@02),@CB00747 0199 00231000 BE @RF00199 0199 00232000 * DO; /* @VS32198*/ 00233000 * IF JRNLEDSW=ON THEN /* JOURNALED BEFORE ? @VS32198*/ 00234000 TM JRNLEDSW,B'00000001' 0201 00235000 BNO @RF00201 0201 00236000 * RPLVJRNL=ON; /* INDIC JRNLED @VS32198*/ 00237000 OI RPLVJRNL(@02),B'00000001' 0202 00238000 * END; /* @VS32198*/ 00239000 * RETURN; /* RETURN TO ICBVCR00 #Y30LB26*/ 00240000 B @EL00001 0204 00241000 * END; /* @Y30LB26*/ 00242000 * 0206 00243000 * /*****************************************************************/ 00244000 * /* */ 00245000 * /* TEST FOR MODIFY GROUP RECORD OPERATION CODE @Y30LB26*/ 00246000 * /* */ 00247000 * /*****************************************************************/ 00248000 * 0206 00249000 * IF RVROPCD=MODGRP /* TEST OP CODE @Y30LB26*/ 00250000 * THEN /* @Y30LB26*/ 00251000 @RF00196 L @02,RVRPTR 0206 00252000 CLI RVROPCD(@02),X'83' 0206 00253000 BNE @RF00206 0206 00254000 * 0207 00255000 * /***************************************************************/ 00256000 * /* */ 00257000 * /* CALL ROUTINE AND RETURN TO ICBVCR00 @Y30LB26*/ 00258000 * /* */ 00259000 * /***************************************************************/ 00260000 * 0207 00261000 * DO; /* @Y30LB26*/ 00262000 * CALL MODIFYG; /* GO MODIFY GP REC @Y30LB26*/ 00263000 * 0208 00264000 BAL @14,MODIFYG 0208 00265000 * /*************************************************************/ 00266000 * /* */ 00267000 * /* CHECK RETURN CODE AND IF BAD SEE IF JOURNALED @VS32198*/ 00268000 * /* BEFORE. IF SO INDICATE THIS FACT. @VS32198*/ 00269000 * /* */ 00270000 * /*************************************************************/ 00271000 * 0209 00272000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @VS32198*/ 00273000 L @02,RPLVPTR 0209 00274000 CLC RPLVRETC(2,@02),@CB00747 0209 00275000 BE @RF00209 0209 00276000 * DO; /* @VS32198*/ 00277000 * IF JRNLEDSW=ON THEN /* JOURNALED BEFORE ? @VS32198*/ 00278000 TM JRNLEDSW,B'00000001' 0211 00279000 BNO @RF00211 0211 00280000 * RPLVJRNL=ON; /* INDIC JRNLED @VS32198*/ 00281000 OI RPLVJRNL(@02),B'00000001' 0212 00282000 * END; /* @VS32198*/ 00283000 * RETURN; /* #Y30LB26*/ 00284000 B @EL00001 0214 00285000 * END; /* @Y30LB26*/ 00286000 * 0216 00287000 * /*****************************************************************/ 00288000 * /* */ 00289000 * /* TEST FOR SCRATCH GROUP OPERATION CODE @Y30LB26*/ 00290000 * /* */ 00291000 * /*****************************************************************/ 00292000 * 0216 00293000 * IF RVROPCD=SCRGRP /* TEST OP CODE @Y30LB26*/ 00294000 * THEN /* @Y30LB26*/ 00295000 @RF00206 L @02,RVRPTR 0216 00296000 CLI RVROPCD(@02),X'84' 0216 00297000 BNE @RF00216 0216 00298000 * 0217 00299000 * /***************************************************************/ 00300000 * /* */ 00301000 * /* SCRATCH RECORD AND RETURN TO ICBVCR00 @Y30LB26*/ 00302000 * /* */ 00303000 * /***************************************************************/ 00304000 * 0217 00305000 * DO; /* @Y30LB26*/ 00306000 * CALL SCRATCHG; /* GO SCRATCH GROUP @Y30LB26*/ 00307000 * 0218 00308000 BAL @14,SCRATCHG 0218 00309000 * /*************************************************************/ 00310000 * /* */ 00311000 * /* CHECK RETURN CODE AND IF BAD SEE IF JOURNALED @VS32198*/ 00312000 * /* BEFORE. IF SO INDICATE THIS FACT. @VS32198*/ 00313000 * /* */ 00314000 * /*************************************************************/ 00315000 * 0219 00316000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @VS32198*/ 00317000 L @02,RPLVPTR 0219 00318000 CLC RPLVRETC(2,@02),@CB00747 0219 00319000 BE @RF00219 0219 00320000 * DO; /* @VS32198*/ 00321000 * IF JRNLEDSW=ON THEN /* JOURNALED BEFORE ? @VS32198*/ 00322000 TM JRNLEDSW,B'00000001' 0221 00323000 BNO @RF00221 0221 00324000 * RPLVJRNL=ON; /* INDIC JRNLED @VS32198*/ 00325000 OI RPLVJRNL(@02),B'00000001' 0222 00326000 * END; /* @VS32198*/ 00327000 * RETURN; /* #Y30LB26*/ 00328000 B @EL00001 0224 00329000 * END; /* @Y30LB26*/ 00330000 * 0226 00331000 * /*****************************************************************/ 00332000 * /* */ 00333000 * /* TEST FOR MODIFY BASE VOLUME OP CODE @Y30LB26*/ 00334000 * /* */ 00335000 * /*****************************************************************/ 00336000 * 0226 00337000 * IF RVROPCD=MODVOL /* TEST OP CODE @Y30LB26*/ 00338000 * THEN /* @Y30LB26*/ 00339000 @RF00216 L @02,RVRPTR 0226 00340000 CLI RVROPCD(@02),X'85' 0226 00341000 BNE @RF00226 0226 00342000 * 0227 00343000 * /***************************************************************/ 00344000 * /* */ 00345000 * /* MODIFY VOLUME RECORD AND RETURN TO ICBVCR00 @Y30LB26*/ 00346000 * /* */ 00347000 * /***************************************************************/ 00348000 * 0227 00349000 * DO; /* @Y30LB26*/ 00350000 * CALL MODIFYV; /* GO MODIFY VOL REC @Y30LB26*/ 00351000 * 0228 00352000 BAL @14,MODIFYV 0228 00353000 * /*************************************************************/ 00354000 * /* */ 00355000 * /* CHECK RETURN CODE AND IF BAD SEE IF JOURNALED @VS32198*/ 00356000 * /* BEFORE. IF SO INDICATE THIS FACT. @VS32198*/ 00357000 * /* */ 00358000 * /*************************************************************/ 00359000 * 0229 00360000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @VS32198*/ 00361000 L @02,RPLVPTR 0229 00362000 CLC RPLVRETC(2,@02),@CB00747 0229 00363000 BE @RF00229 0229 00364000 * DO; /* @VS32198*/ 00365000 * IF JRNLEDSW=ON THEN /* JOURNALED BEFORE ? @VS32198*/ 00366000 TM JRNLEDSW,B'00000001' 0231 00367000 BNO @RF00231 0231 00368000 * RPLVJRNL=ON; /* INDIC JRNLED @VS32198*/ 00369000 OI RPLVJRNL(@02),B'00000001' 0232 00370000 * END; /* @VS32198*/ 00371000 * RETURN; /* #Y30LB26*/ 00372000 B @EL00001 0234 00373000 * END; /* @Y30LB26*/ 00374000 * 0236 00375000 * /*****************************************************************/ 00376000 * /* */ 00377000 * /* TEST FOR READ INVENTORY RECORDS OP CODE @Y30LB26*/ 00378000 * /* */ 00379000 * /*****************************************************************/ 00380000 * 0236 00381000 * IF RVROPCD=READREC /* TEST OP CODE @Y30LB26*/ 00382000 * THEN /* @Y30LB26*/ 00383000 @RF00226 L @02,RVRPTR 0236 00384000 CLI RVROPCD(@02),X'87' 0236 00385000 BNE @RF00236 0236 00386000 * 0237 00387000 * /***************************************************************/ 00388000 * /* */ 00389000 * /* READ RECORD AND RETURN TO ICBVCR00 @Y30LB26*/ 00390000 * /* */ 00391000 * /***************************************************************/ 00392000 * 0237 00393000 * DO; /* @Y30LB26*/ 00394000 * CALL READVVI; /* GO READ RECORD @Y30LB26*/ 00395000 BAL @14,READVVI 0238 00396000 * RETURN; /* @Y30LB26*/ 00397000 B @EL00001 0239 00398000 * END; /* @Y30LB26*/ 00399000 * 0241 00400000 * /*****************************************************************/ 00401000 * /* */ 00402000 * /* NO VALID OPERATION CODE WAS FOUND. SET ERROR @Y30LB26*/ 00403000 * /* REASON AND RETURN CODES. @Y30LB26*/ 00404000 * /* */ 00405000 * /*****************************************************************/ 00406000 * 0241 00407000 * RPLRCODE=BADOPCD; /* INVALID OPERATION @Y30LB26*/ 00408000 @RF00236 L @02,RPLVPTR 0241 00409000 MVC RPLRCODE(2,@02),@CB00793 0241 00410000 * RPLVRETC=FOUR; /* SET BAD RET CODE @Y30LB26*/ 00411000 MVC RPLVRETC(2,@02),@CB00749 0242 00412000 * RETURN; /* RETURN TO ICBVCR00 @Y30LB26*/ 00413000 B @EL00001 0243 00414000 * 0244 00415000 */* START OF SPECIFICATIONS **** @Y30LB26 00416000 * 0244 00417000 * PROCEDURE NAME - CREATEG @Y30LB26 00418000 * 0244 00419000 * FUNCTION - TO PLACE A GROUP RECORD IN THE USERCAT.MSVI DATA SET. 00420000 * ANOTHER GROUP RECORD MUST NOT EXIST WITH THE SAME GROUP NAME. 0244 00421000 * THERE MUST NOT BE ANY ILLEGAL CHARACTERS IN THE GROUP NAME. THIS 00422000 * IS CHECKED. 0244 00423000 * THIS PROGRAM PUTS IN THE PRIMARY AND SECONDARY SPACE DEFAULTS, 00424000 * THE NUMBER OF CONCURRENT USERS, AND RESERVED SPACE IN CYLINDERS. 00425000 * ALSO IT OPTIONALLY PUTS IN OWNER, THRESHOLD, RETENTION PERIOD, 00426000 * DESCRIPTION AND ADDRESS, PLUS ANY MOUNT ATTRIBUTES. THE RPLV IS 00427000 * JOURNALED AFTER THE FIRST SUCCESSFUL UPDATE OF INVENTORY 0244 00428000 * DATA SET. @G24LB37 00429000 * 0244 00430000 * 0244 00431000 * INPUTS - REGISTER 1 CONTAINS THE ADDRESS OF THE RPLV. IT 0244 00432000 * HAS ALL THE INFORMATION REQUIRED TO CREATE A GROUP 0244 00433000 * RECORD. @Y30LB26 00434000 * 0244 00435000 * '020A'X GROUP ALREADY EXISTS. @Y30LB26 00436000 * '0225'X GROUP NAME IS INVALID. @Y30LB26 00437000 * PLUS ANY RETURN CODES FROM I/O PROCESSOR AND JOURNALING PROGRAM. 00438000 * @Y30LB26 00439000 **** END OF SPECIFICATIONS ** */ 00440000 * 0244 00441000 *CREATEG: 0244 00442000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 00443000 CREATEG ST @14,@SA00002 0244 00444000 * DCL 0245 00445000 * TWOBLK CHAR(2) CONSTANT(' ');/* TEST CONSTANT #Y30LB26*/ 00446000 * 0246 00447000 * /*****************************************************************/ 00448000 * /* */ 00449000 * /* ADDRESS OF REQUEST BLOCK @Y30LB26*/ 00450000 * /* */ 00451000 * /*****************************************************************/ 00452000 * 0246 00453000 * MGPPTR=ADDR(RPLVUTIL); /* PTR TO REQUEST BLK @Y30LB26*/ 00454000 L MGPPTR,RPLVPTR 0246 00455000 LA MGPPTR,RPLVUTIL(,MGPPTR) 0246 00456000 * STORGRP=STORGRP&&STORGRP; /* ZERO GROUP REC BUFF @Y30LB26*/ 00457000 * 0247 00458000 XC STORGRP(224),STORGRP 0247 00459000 * /*****************************************************************/ 00460000 * /* */ 00461000 * /* GO CHECK FOR VALID CHARACTERS IN GROUP NAME @Y30LB26*/ 00462000 * /* */ 00463000 * /*****************************************************************/ 00464000 * 0248 00465000 * CALL VALGPNAM; /* CK FOR VALID GP NM @Y30LB26*/ 00466000 * 0248 00467000 BAL @14,VALGPNAM 0248 00468000 * /*****************************************************************/ 00469000 * /* */ 00470000 * /* CHECK RETURN CODE FROM GROUP NAME ROUTINE @Y30LB26*/ 00471000 * /* */ 00472000 * /*****************************************************************/ 00473000 * 0249 00474000 * IF RPLVRETC^=RCZERO /* CK FOR GOOD RET CD @Y30LB26*/ 00475000 * THEN 0249 00476000 L @07,RPLVPTR 0249 00477000 CLC RPLVRETC(2,@07),@CB00747 0249 00478000 BNE @RT00249 0249 00479000 * RETURN; /* INVAL GRP, RETURN @Y30LB26*/ 00480000 * 0251 00481000 * /*****************************************************************/ 00482000 * /* */ 00483000 * /* CALL RESERVE INVENTORY DATA SET. @Y30LB26*/ 00484000 * /* */ 00485000 * /*****************************************************************/ 00486000 * 0251 00487000 * CALL RESERINV; /* GO RESERVE INVEN @Y30LB26*/ 00488000 BAL @14,RESERINV 0251 00489000 * 0252 00490000 * /*****************************************************************/ 00491000 * /* */ 00492000 * /* INITILIZE FIELDS IN GROUP VOLUME RECORD @Y30LB26*/ 00493000 * /* */ 00494000 * /*****************************************************************/ 00495000 * 0252 00496000 * GROUPPTR=ADDR(STORGRP); /* ADDR TO REC BUFFER @Y30LB26*/ 00497000 LA @07,STORGRP 0252 00498000 ST @07,GROUPPTR 0252 00499000 * GROUPKY=MGPGROUP; /* NAME GRP BE CREATED @Y30LB26*/ 00500000 MVC GROUPKY(8),MGPGROUP(MGPPTR) 0253 00501000 * GRONAME=GKEY; /* PUT KEY GROUP REC @Y30LB26*/ 00502000 MVC GRONAME(13,@07),GKEY 0254 00503000 * GROGVR=ON; /* INDICATE GROUP REC @Y30LB26*/ 00504000 OI GROGVR(@07),B'10000000' 0255 00505000 * GROPSPD=MGPRI; /* PRI SPACE DEFAULT @Y30LB26*/ 00506000 LH @02,MGPRI(,MGPPTR) 0256 00507000 STH @02,GROPSPD(,@07) 0256 00508000 * GROSSPD=MGPSEC; /* SEC SPACE DEFAULT @Y30LB26*/ 00509000 LH @02,MGPSEC(,MGPPTR) 0257 00510000 STH @02,GROSSPD(,@07) 0257 00511000 * 0258 00512000 * /*****************************************************************/ 00513000 * /* */ 00514000 * /* OWNER SPECIFIED, FILL IN OWNER FIELD @Y30LB26*/ 00515000 * /* */ 00516000 * /*****************************************************************/ 00517000 * 0258 00518000 * IF MGPFLOWN=ON /* CK OWNER SPECIFIED @Y30LB26*/ 00519000 * THEN 0258 00520000 TM MGPFLOWN(MGPPTR),B'00010000' 0258 00521000 BNO @RF00258 0258 00522000 * GROOWNER=MGPOWNER; /* SET OWNER @Y30LB26*/ 00523000 MVC GROOWNER(10,@07),MGPOWNER(MGPPTR) 0259 00524000 * ELSE /* @Y30LB26*/ 00525000 * GROOWNER=BLANK; /* BLANK OWNER @Y30LB26*/ 00526000 B @RC00258 0260 00527000 @RF00258 L @07,GROUPPTR 0260 00528000 MVI GROOWNER+1(@07),C' ' 0260 00529000 MVC GROOWNER+2(8,@07),GROOWNER+1(@07) 0260 00530000 MVI GROOWNER(@07),C' ' 0260 00531000 * 0261 00532000 * /*****************************************************************/ 00533000 * /* */ 00534000 * /* IF THRESHOLD PERCENT SPECIFIED, FILL IN @Y30LB26*/ 00535000 * /* */ 00536000 * /*****************************************************************/ 00537000 * 0261 00538000 * IF MGPFLTHO=ON /* THRESH PCENT SPEC ? @Y30LB26*/ 00539000 * THEN 0261 00540000 @RC00258 TM MGPFLTHO(MGPPTR),B'00000010' 0261 00541000 BNO @RF00261 0261 00542000 * GROPCENT=MGPTHOLD; /* SET PERCENT @Y30LB26*/ 00543000 L @07,GROUPPTR 0262 00544000 MVC GROPCENT(1,@07),MGPTHOLD(MGPPTR) 0262 00545000 * 0263 00546000 * /*****************************************************************/ 00547000 * /* */ 00548000 * /* CHECK RETENTION PERIOD SPECIFIED @Y30LB26*/ 00549000 * /* */ 00550000 * /*****************************************************************/ 00551000 * 0263 00552000 * IF MGPFLRET=ON /* RETENTION SPEC ? @Y30LB26*/ 00553000 * THEN /* @Y30LB26*/ 00554000 * 0263 00555000 @RF00261 TM MGPFLRET(MGPPTR),B'00000001' 0263 00556000 BNO @RF00263 0263 00557000 * /***************************************************************/ 00558000 * /* */ 00559000 * /* INDICATE SPECIFIED AND FILLIN PERIOD @Y30LB26*/ 00560000 * /* */ 00561000 * /***************************************************************/ 00562000 * 0264 00563000 * DO; /* @Y30LB26*/ 00564000 * GRORETN=ON; /* INDICATE RETN SPEC @Y30LB26*/ 00565000 L @07,GROUPPTR 0265 00566000 OI GRORETN(@07),B'00000100' 0265 00567000 * GRORETPD=MGPRETPD; /* PUT IN RET PERIOD @Y30LB26*/ 00568000 LH @02,MGPRETPD(,MGPPTR) 0266 00569000 ST @02,GRORETPD(,@07) 0266 00570000 * END; /* @Y30LB26*/ 00571000 * 0268 00572000 * /*****************************************************************/ 00573000 * /* */ 00574000 * /* CHECK CONCURRENT USERS SPECIFIED, IF SO FILL IN @G24LB37*/ 00575000 * /* */ 00576000 * /*****************************************************************/ 00577000 * 0268 00578000 * IF MGPFLCON=ON /* CONCUR USERS SPEC ? @G24LB37*/ 00579000 * THEN 0268 00580000 @RF00263 TM MGPFLCON(MGPPTR),B'00000001' 0268 00581000 BNO @RF00268 0268 00582000 * GROCONUS=MGPCONUS; /* SET CONCUR USERS @G24LB37*/ 00583000 L @07,GROUPPTR 0269 00584000 MVC GROCONUS(1,@07),MGPCONUS(MGPPTR) 0269 00585000 * 0270 00586000 * /*****************************************************************/ 00587000 * /* */ 00588000 * /* CHECK RESERVED SPACE SPECIFIED, IF SO FILL IN @G24LB37*/ 00589000 * /* */ 00590000 * /*****************************************************************/ 00591000 * 0270 00592000 * IF MGPFLRES=ON /* RESERVED SP SPEC ? @G24LB37*/ 00593000 * THEN 0270 00594000 @RF00268 TM MGPFLRES(MGPPTR),B'10000000' 0270 00595000 BNO @RF00270 0270 00596000 * GRORESSP=MGPRESSP; /* SET RESERVED SPACE @G24LB37*/ 00597000 L @07,GROUPPTR 0271 00598000 MVC GRORESSP(1,@07),MGPRESSP(MGPPTR) 0271 00599000 * 0272 00600000 * /*****************************************************************/ 00601000 * /* */ 00602000 * /* DESCRIPTION SPECIFIED - FILL IN @Y30LB26*/ 00603000 * /* */ 00604000 * /*****************************************************************/ 00605000 * 0272 00606000 * IF MGPFLDES=ON /* DESCRIPTION SPEC ? @Y30LB26*/ 00607000 * THEN 0272 00608000 @RF00270 TM MGPFLDES(MGPPTR),B'10000000' 0272 00609000 BNO @RF00272 0272 00610000 * GRODESCR=MGPDESCR; /* PUT VALUE @Y30LB26*/ 00611000 L @07,GROUPPTR 0273 00612000 MVC GRODESCR(30,@07),MGPDESCR(MGPPTR) 0273 00613000 * ELSE /* @Y30LB26*/ 00614000 * GRODESCR=BLANK; /* BLANK DESCRIPTION @Y30LB26*/ 00615000 B @RC00272 0274 00616000 @RF00272 L @07,GROUPPTR 0274 00617000 MVI GRODESCR+1(@07),C' ' 0274 00618000 MVC GRODESCR+2(28,@07),GRODESCR+1(@07) 0274 00619000 MVI GRODESCR(@07),C' ' 0274 00620000 * 0275 00621000 * /*****************************************************************/ 00622000 * /* */ 00623000 * /* ADDRESS SPECIFIED - FILL IN @Y30LB26*/ 00624000 * /* */ 00625000 * /*****************************************************************/ 00626000 * 0275 00627000 * IF MGPFLADD=ON /* ADDRESS SPEC ? @Y30LB26*/ 00628000 * THEN 0275 00629000 @RC00272 TM MGPFLADD(MGPPTR),B'01000000' 0275 00630000 BNO @RF00275 0275 00631000 * GROADDR=MGPADDR; /* PUT VALUE @Y30LB26*/ 00632000 L @07,GROUPPTR 0276 00633000 MVC GROADDR(30,@07),MGPADDR(MGPPTR) 0276 00634000 * ELSE /* @Y30LB26*/ 00635000 * GROADDR=BLANK; /* BLANK ADDRESS @Y30LB26*/ 00636000 B @RC00275 0277 00637000 @RF00275 L @07,GROUPPTR 0277 00638000 MVI GROADDR+1(@07),C' ' 0277 00639000 MVC GROADDR+2(28,@07),GROADDR+1(@07) 0277 00640000 MVI GROADDR(@07),C' ' 0277 00641000 * 0278 00642000 * /*****************************************************************/ 00643000 * /* */ 00644000 * /* SET RELEASE ATTRIBUTE @Y30LB26*/ 00645000 * /* */ 00646000 * /*****************************************************************/ 00647000 * 0278 00648000 * IF MGPRLSE=ON /* RELEASE ATTRIBUTE @Y30LB26*/ 00649000 * THEN 0278 00650000 @RC00275 TM MGPRLSE(MGPPTR),B'10000000' 0278 00651000 BNO @RF00278 0278 00652000 * GRORLSE=ON; /* @Y30LB26*/ 00653000 L @07,GROUPPTR 0279 00654000 OI GRORLSE(@07),B'00001000' 0279 00655000 * 0280 00656000 * /*****************************************************************/ 00657000 * /* */ 00658000 * /* SET BIND OPTION @Y30LB26*/ 00659000 * /* */ 00660000 * /*****************************************************************/ 00661000 * 0280 00662000 * IF MGPBIND=ON /* BIND OPTION @Y30LB26*/ 00663000 * THEN 0280 00664000 @RF00278 TM MGPBIND(MGPPTR),B'00100000' 0280 00665000 BNO @RF00280 0280 00666000 * GROBIND=ON; /* @Y30LB26*/ 00667000 L @07,GROUPPTR 0281 00668000 OI GROBIND(@07),B'10000000' 0281 00669000 * 0282 00670000 * /*****************************************************************/ 00671000 * /* */ 00672000 * /* SET EXCLUSIVE USE FLAG @Y30LB26*/ 00673000 * /* */ 00674000 * /*****************************************************************/ 00675000 * 0282 00676000 * IF MGPEXCL=ON /* EXCLUSIVE USE ? @Y30LB26*/ 00677000 * THEN 0282 00678000 @RF00280 TM MGPEXCL(MGPPTR),B'00001000' 0282 00679000 BNO @RF00282 0282 00680000 * GROEXCL=ON; /* @Y30LB26*/ 00681000 L @07,GROUPPTR 0283 00682000 OI GROEXCL(@07),B'01000000' 0283 00683000 * 0284 00684000 * /*****************************************************************/ 00685000 * /* */ 00686000 * /* SET READ ONLY FLAG @Y30LB26*/ 00687000 * /* */ 00688000 * /*****************************************************************/ 00689000 * 0284 00690000 * IF MGPRONLY=ON /* READ ONLY ? @Y30LB26*/ 00691000 * THEN 0284 00692000 @RF00282 TM MGPRONLY(MGPPTR),B'00000010' 0284 00693000 BNO @RF00284 0284 00694000 * GRORONLY=ON; /* @Y30LB26*/ 00695000 L @07,GROUPPTR 0285 00696000 OI GRORONLY(@07),B'00010000' 0285 00697000 * 0286 00698000 * /*****************************************************************/ 00699000 * /* */ 00700000 * /* SET DASD ERASE FLAG @Y30LB26*/ 00701000 * /* */ 00702000 * /*****************************************************************/ 00703000 * 0286 00704000 * IF MGPDERAS=ON /* DASD ERASE ? @Y30LB26*/ 00705000 * THEN 0286 00706000 @RF00284 TM MGPDERAS(MGPPTR),B'10000000' 0286 00707000 BNO @RF00286 0286 00708000 * GRODAERA=ON; /* @Y30LB26*/ 00709000 L @02,GROUPPTR 0287 00710000 OI GRODAERA(@02),B'00100000' 0287 00711000 * 0288 00712000 * /*****************************************************************/ 00713000 * /* */ 00714000 * /* INITILIZE REMAINING FIELDS IN GROUP RECORD @Y30LB26*/ 00715000 * /* */ 00716000 * /*****************************************************************/ 00717000 * 0288 00718000 * GROERRTS=BLANK; /* BLANK ERROR TIME STP @Y30LB26*/ 00719000 @RF00286 L @02,GROUPPTR 0288 00720000 MVI GROERRTS+1(@02),C' ' 0288 00721000 MVC GROERRTS+2(6,@02),GROERRTS+1(@02) 0288 00722000 MVI GROERRTS(@02),C' ' 0288 00723000 * GROFSN=BLANK; /* FIRST VOL REC @Y30LB26*/ 00724000 MVI GROFSN+1(@02),C' ' 0289 00725000 MVC GROFSN+2(4,@02),GROFSN+1(@02) 0289 00726000 MVI GROFSN(@02),C' ' 0289 00727000 * GROLSN=BLANK; /* LAST VOL SER @Y30LB26*/ 00728000 MVI GROLSN+1(@02),C' ' 0290 00729000 MVC GROLSN+2(4,@02),GROLSN+1(@02) 0290 00730000 MVI GROLSN(@02),C' ' 0290 00731000 * 0291 00732000 * /*****************************************************************/ 00733000 * /* */ 00734000 * /* SET UP AND WRITE GROUP RECORD @Y30LB26*/ 00735000 * /* */ 00736000 * /*****************************************************************/ 00737000 * 0291 00738000 * RPLVBUF=GROUPPTR; /* ADDR RECORD TO PUT @Y30LB26*/ 00739000 L @15,RPLVPTR 0291 00740000 ST @02,RPLVBUF(,@15) 0291 00741000 * RPLVRLN=LENGTH(GROUP); /* LENGTH RECORD @Y30LB26*/ 00742000 MVC RPLVRLN(4,@15),@CF01146 0292 00743000 * RPLVBLN=LENGTH(STORGRP); /* LENGTH BUFFER @Y30LB26*/ 00744000 MVC RPLVBLN(4,@15),@CF01147 0293 00745000 * RPLVTYP=RPLVPUT; /* PUT GROUP RECORD @Y30LB26*/ 00746000 MVI RPLVTYP(@15),X'01' 0294 00747000 * RESPECIFY 0295 00748000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 00749000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 00750000 LR REG1,@15 0296 00751000 * CALL ICBVIO00; /* WRITE RECORD @Y30LB26*/ 00752000 L @15,@CV00671 0297 00753000 BALR @14,@15 0297 00754000 * RESPECIFY 0298 00755000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 00756000 * 0298 00757000 * /*****************************************************************/ 00758000 * /* */ 00759000 * /* CHECK RETURN CODE FROM I/O PROCESSOR @Y30LB26*/ 00760000 * /* */ 00761000 * /*****************************************************************/ 00762000 * 0299 00763000 * IF RPLVRETC^=RCZERO /* CK RETURN CODE @Y30LB26*/ 00764000 * THEN /* @Y30LB26*/ 00765000 L @02,RPLVPTR 0299 00766000 CLC RPLVRETC(2,@02),@CB00747 0299 00767000 BE @RF00299 0299 00768000 * DO; /* @Y30LB26*/ 00769000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 00770000 BAL @14,ERREXIT 0301 00771000 * RETURN; /* @Y30LB26*/ 00772000 @EL00002 DS 0H 0302 00773000 @EF00002 DS 0H 0302 00774000 @ER00002 L @14,@SA00002 0302 00775000 BR @14 0302 00776000 * END; /* @Y30LB26*/ 00777000 * 0304 00778000 * /*****************************************************************/ 00779000 * /* */ 00780000 * /* SINCE WRITE OF GROUP RECORD SUCCESSFUL, @Y30LB26*/ 00781000 * /* GO JOURNAL REQUEST BLOCK @Y30LB26*/ 00782000 * /* */ 00783000 * /*****************************************************************/ 00784000 * 0304 00785000 * CALL JOURNAL; /* JOURNAL REQUEST BLK @Y30LB26*/ 00786000 @RF00299 BAL @14,JOURNAL 0304 00787000 * RETURN; /* @Y30LB26*/ 00788000 B @EL00002 0305 00789000 * END CREATEG; /* @Y30LB26*/ 00790000 B @EL00002 0306 00791000 * 0307 00792000 * /*****************************************************************/ 00793000 * /* */ 00794000 * /* THIS ROUTINE CHECKS TO SEE IF ALL CHARACTERS IN @Y30LB26*/ 00795000 * /* THE GROUP NAME ARE VALID @Y30LB26*/ 00796000 * /* */ 00797000 * /*****************************************************************/ 00798000 * 0307 00799000 *VALGPNAM: 0307 00800000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 00801000 * 0307 00802000 VALGPNAM ST @14,@SA00003 0307 00803000 * /*****************************************************************/ 00804000 * /* */ 00805000 * /* TRANSLATE & TEST VVGRP TABLE @Y30LB26*/ 00806000 * /* */ 00807000 * /*****************************************************************/ 00808000 * 0308 00809000 * DCL 0308 00810000 * 1 TEST1 CHAR(256), /* @Y30LB26*/ 00811000 * 2 TESTINIT(256) CHAR(1) INIT((64)'01'X,'00'X,/* @Y30LB26*/ 00812000 * (26)'01'X,'00'X,(31)'01'X,(2)'00'X,/* @Y30LB26*/ 00813000 * (68)'01'X,(9)'00'X,(7)'01'X,(9)'00'X,(8)'01'X,/* 0308 00814000 * @Y30LB26*/ 00815000 * (8)'00'X,(6)'01'X,(10)'00'X,(6)'01'X);/* @Y30LB26*/ 00816000 * 0309 00817000 * /*****************************************************************/ 00818000 * /* */ 00819000 * /* CHECK TO SEE IF FIRST CHAR ID BLANK OR IF THERE ARE @Y30LB26*/ 00820000 * /* ANY IMBEDDED BLANKS @Y30LB26*/ 00821000 * /* */ 00822000 * /*****************************************************************/ 00823000 * 0309 00824000 * DO I=1 TO 8; /* @Y30LB26*/ 00825000 LA @07,1 0309 00826000 STC @07,I 0309 00827000 @DL00309 DS 0H 0310 00828000 * IF MGPGROUP(I)=BLANK THEN /* TEST FOR BLANK @Y30LB26*/ 00829000 ALR @07,MGPPTR 0310 00830000 CLI MGPGROUP-1(@07),C' ' 0310 00831000 BNE @RF00310 0310 00832000 * DO; /* @Y30LB26*/ 00833000 * 0311 00834000 * /***********************************************************/ 00835000 * /* */ 00836000 * /* FIRST CHARACTER CAN NOT BE BLANK @Y30LB26*/ 00837000 * /* */ 00838000 * /***********************************************************/ 00839000 * 0312 00840000 * IF I=ONE THEN /* FIRST CHAR BLK ERROR @Y30LB26*/ 00841000 CLI I,1 0312 00842000 BNE @RF00312 0312 00843000 * DO; /* @Y30LB26*/ 00844000 * RPLVRETC=FOUR; /* SET BAD RET CODE @Y30LB26*/ 00845000 L @07,RPLVPTR 0314 00846000 MVC RPLVRETC(2,@07),@CB00749 0314 00847000 * RPLRCODE=INVALGP; /* INVALID GRP NAME @Y30LB26*/ 00848000 MVC RPLRCODE(2,@07),@CB00823 0315 00849000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 00850000 BAL @14,ERREXIT 0316 00851000 * RETURN; /* @Y30LB26*/ 00852000 @EL00003 DS 0H 0317 00853000 @EF00003 DS 0H 0317 00854000 @ER00003 L @14,@SA00003 0317 00855000 BR @14 0317 00856000 * END; /* @Y30LB26*/ 00857000 * 0318 00858000 * /***********************************************************/ 00859000 * /* */ 00860000 * /* IF NOT THE LAST CHARACTER IN GROUP NAME, @Y30LB26*/ 00861000 * /* CHECK FOR IMBEDDED BLANKS @Y30LB26*/ 00862000 * /* */ 00863000 * /***********************************************************/ 00864000 * 0319 00865000 * IF I<8 THEN /* INSURE NOT LAST CHAR @Y30LB26*/ 00866000 @RF00312 CLI I,8 0319 00867000 BNL @RF00319 0319 00868000 * DO; /* @Y30LB26*/ 00869000 * IF MGPGROUP(I+1:8)^=BLANK8(I+1:8) THEN/* @Y30LB26*/ 00870000 SLR @07,@07 0321 00871000 IC @07,I 0321 00872000 LA @02,7 0321 00873000 SLR @02,@07 0321 00874000 ST @07,@TF00001 0321 00875000 ALR @07,MGPPTR 0321 00876000 L @01,@TF00001 0321 00877000 LA @15,BLANK8(@01) 0321 00878000 EX @02,@SC01176 0321 00879000 BE @RF00321 0321 00880000 * DO; /* @Y30LB26*/ 00881000 * RPLVRETC=FOUR; /* BAD RETURN CODE @Y30LB26*/ 00882000 L @07,RPLVPTR 0323 00883000 MVC RPLVRETC(2,@07),@CB00749 0323 00884000 * RPLRCODE=INVALGP; /* INVAL GRP NAME @Y30LB26*/ 00885000 MVC RPLRCODE(2,@07),@CB00823 0324 00886000 * CALL ERREXIT; /* RLSE INVENTORY @Y30LB26*/ 00887000 BAL @14,ERREXIT 0325 00888000 * RETURN; /* @Y30LB26*/ 00889000 B @EL00003 0326 00890000 * END; /* @Y30LB26*/ 00891000 * END; /* @Y30LB26*/ 00892000 @RF00321 DS 0H 0329 00893000 * END; /* @Y30LB26*/ 00894000 @RF00319 DS 0H 0330 00895000 * END; /* @Y30LB26*/ 00896000 @RF00310 LA @07,1 0330 00897000 SLR @02,@02 0330 00898000 IC @02,I 0330 00899000 ALR @07,@02 0330 00900000 STC @07,I 0330 00901000 C @07,@CF00036 0330 00902000 BNH @DL00309 0330 00903000 * RESPECIFY 0331 00904000 * REG2 RSTD; /* RESTRICT REG 15 @Y30LB26*/ 00905000 * 0331 00906000 * /*****************************************************************/ 00907000 * /* */ 00908000 * /* ZERO REG 2 FOR TRT INSTRUCTION @Y30LB26*/ 00909000 * /* */ 00910000 * /*****************************************************************/ 00911000 * 0332 00912000 * REG2=ZERO; /* ZERO REG 2 @Y30LB26*/ 00913000 * 0332 00914000 SLR REG2,REG2 0332 00915000 * /*****************************************************************/ 00916000 * /* */ 00917000 * /* CHECK FOR INVALID SPECIAL CHARACTERS IN GROUP NAME @Y30LB26*/ 00918000 * /* */ 00919000 * /*****************************************************************/ 00920000 * 0333 00921000 * TRT(MGPGROUP,TEST1); /* TEST FOR SPEC CHAR @Y30LB26*/ 00922000 TRT MGPGROUP(8,MGPPTR),TEST1 0333 00923000 * IF REG2^=ZERO THEN /* @Y30LB26*/ 00924000 * 0334 00925000 LTR REG2,REG2 0334 00926000 BZ @RF00334 0334 00927000 * /***************************************************************/ 00928000 * /* */ 00929000 * /* IF INVALID CHARACTERS, SET REASON CODE AND RETURN @Y30LB26*/ 00930000 * /* */ 00931000 * /***************************************************************/ 00932000 * 0335 00933000 * DO; /* @Y30LB26*/ 00934000 * RPLVRETC=FOUR; /* BAD RET CODE @Y30LB26*/ 00935000 L @07,RPLVPTR 0336 00936000 MVC RPLVRETC(2,@07),@CB00749 0336 00937000 * RPLRCODE=INVALGP; /* INVALID GROUP NAME @Y30LB26*/ 00938000 MVC RPLRCODE(2,@07),@CB00823 0337 00939000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 00940000 BAL @14,ERREXIT 0338 00941000 * RETURN; /* @Y30LB26*/ 00942000 B @EL00003 0339 00943000 * END; /* @Y30LB26*/ 00944000 * ELSE /* @Y30LB26*/ 00945000 * 0341 00946000 * /***************************************************************/ 00947000 * /* */ 00948000 * /* OTHERWISE SET GOOD REASON CODE AND RETURN @Y30LB26*/ 00949000 * /* */ 00950000 * /***************************************************************/ 00951000 * 0341 00952000 * DO; /* @Y30LB26*/ 00953000 @RF00334 DS 0H 0342 00954000 * RPLVRETC=RCZERO; /* GOOD RET CODE @Y30LB26*/ 00955000 L @07,RPLVPTR 0342 00956000 MVC RPLVRETC(2,@07),@CB00747 0342 00957000 * RPLRCODE=RCZERO; /* ALL GOOD CHARACTERS @Y30LB26*/ 00958000 MVC RPLRCODE(2,@07),@CB00747 0343 00959000 * RETURN; /* @Y30LB26*/ 00960000 B @EL00003 0344 00961000 * END; /* @Y30LB26*/ 00962000 * RESPECIFY 0346 00963000 * REG2 UNRSTD; /* FREE REG 15 @Y30LB26*/ 00964000 * END VALGPNAM; /* END CREATE GRP ROUTIN @Y30LB26*/ 00965000 * 0348 00966000 */* START OF SPECIFICATIONS **** 0348 00967000 * 0348 00968000 * PROCEDURE NAME - MODIFYG @Y30LB26 00969000 * 0348 00970000 * FUNCTION - THIS PROGRAM MODIFIES AN EXISTING GROUP RECORD. 0348 00971000 * IT CAN CHANGE BOTH PRIMARY AND SECONDARY DEFAULT SPACE, 0348 00972000 * CHANGE THE GROUP OWNER, UPDATE DESCRIPTION AND ADDRESS 0348 00973000 * FIELD. THIS PROCEDURE WILL, ALSO, MODIFY THE EXISTING 0348 00974000 * NUMBER OF CONCURRENT ALLOCATIONS AND/OR THE AMOUNT OF 0348 00975000 * RESERVED SPACE FOR A VOLUME WITHIN A GROUP, IF SPECIFIED. 0348 00976000 * WHEN THE NUMBER OF CONCURRENT USERS IS CHANGED FROM 0348 00977000 * ZERO TO A NONZERO VALUE FOR A GROUP OTHER THAN SYSGROUP, 0348 00978000 * MODIFYG CONSIDERS THIS A CONVERSION FOR THAT GROUP FROM 0348 00979000 * EARLIER VERSION OF MSS SUPPORT TO MSS RELEASE 3. IF THE 0348 00980000 * GROUP THRESHOLD IS CHANGED, MODIFYG WILL RECALCULATE 0348 00981000 * THE GROUP SPACE THRESHOLD BY MULTIPLING THE NUMBER OF 0348 00982000 * GENERAL USE VOLUMES IN THE GROUP BY 404 AND THEN MULTIPLING 0348 00983000 * THIS BY THE GROUP THRESHOLD PERCENT. ALSO IF NULLIFY RETENTION 00984000 * IS SPECIFIED, THE PROGRAM GOES THRU ALL THE BASE VOLUME RECORDS, 00985000 * AND FOR THE GENERAL USE VOLUMES THE EXPIRATION DATE IS NULLIFIED. 00986000 * THE MSS MOUNT ATTRIBUTES CAN BE CHANGED. THE NULLIFY 0348 00987000 * OPERATIONS OVER-RIDE ANY PARAMETER SPECIFICATION. 0348 00988000 * THE PROGRAM NULLIFIES THE FIELDS SPECIFIED BY THE 0348 00989000 * REQUEST BLOCK. THE RPLV IS JOURNALED AFTER THE GROUP RECORD IS 00990000 * SUCCESSFULLY WRITTEN. @G24LB37 00991000 * 0348 00992000 * FOR GROUP CONVERSION TO MSS RELEASE 3, MODIFYG READS 0348 00993000 * ALL OF THE GROUP EXTENSION RECORDS FOR THAT GROUP, 0348 00994000 * AND FOR EACH VOLUME SHOWN IN A GROUP EXTENSION RECORD, 0348 00995000 * MOVES THE FREE SPACE FROM THE BASE VOLUME RECORD INTO 0348 00996000 * THE GVSNE, AND TURNS OFF THE HOST NON-SHARE AND INVALID 0348 00997000 * RUNNING COUNT FIELDS, UNLESS THE BASE VOLUME RECORD 0348 00998000 * INDICATED THAT THE VOLUME IS MOUNTED TO SOME HOST OR 0348 00999000 * THAT ITS SPACE IS DOWN LEVEL. @G24LB04 01000000 * 0348 01001000 * INPUTS - REGISTER 1 CONTAINS THE ADDRESS OF THE RPLV. THIS HAS 01002000 * ALL THE INFORMATION NEEDED TO MODIFY THE GROUP RECORD. @Y30LB26 01003000 * 0348 01004000 * OUTPUTS - REASON CODE AND RETURN CODE IN RPLV. @Y30LB26 01005000 * 0348 01006000 * '021B'X I/O ERROR OCCURED BUT RPLV WAS JOURNALED. @Y30LB26 01007000 * ALSO ANY RETURN CODE PUT OUT BY THE I/O PROCESSOR OR THE 0348 01008000 * JOURNALING PROGRAM. @Y30LB26 01009000 **** END OF SPECIFICATIONS ** */ 01010000 * 0348 01011000 *MODIFYG: 0348 01012000 * PROC OPTIONS(SAVEAREA); /* #Y30LB26*/ 01013000 MODIFYG STM @14,@12,12(@13) 0348 01014000 ST @13,@SA00004+4 0348 01015000 LA @14,@SA00004 0348 01016000 ST @14,8(,@13) 0348 01017000 LR @13,@14 0348 01018000 * 0349 01019000 * /*****************************************************************/ 01020000 * /* */ 01021000 * /* CONSTANTS USED IN ARITHMETIC CALCULATIONS #Y30LB26*/ 01022000 * /* */ 01023000 * /*****************************************************************/ 01024000 * 0349 01025000 * DCL 0349 01026000 * CYLS FIXED(15) CONSTANT(404); /* CALC THRS CYLS @Y30LB26*/ 01027000 * DCL 0350 01028000 * HUNDRED FIXED(15) CONSTANT(100);/* DIVISOR @Y30LB26*/ 01029000 * 0351 01030000 * /*****************************************************************/ 01031000 * /* */ 01032000 * /* SET UP ADDRESSABILITY TO REQUEST BLOCK @G24LB04*/ 01033000 * /* */ 01034000 * /*****************************************************************/ 01035000 * 0351 01036000 * MGPPTR=ADDR(RPLVUTIL); /* PTR TO REQUEST BLK @Y30LB26*/ 01037000 L MGPPTR,RPLVPTR 0351 01038000 LA MGPPTR,RPLVUTIL(,MGPPTR) 0351 01039000 * 0352 01040000 * /*****************************************************************/ 01041000 * /* */ 01042000 * /* RESERVE INVENTORY @Y30LB26*/ 01043000 * /* */ 01044000 * /*****************************************************************/ 01045000 * 0352 01046000 * CALL RESERINV; /* GO RESERVE INVENTY @Y30LB26*/ 01047000 BAL @14,RESERINV 0352 01048000 * 0353 01049000 * /*****************************************************************/ 01050000 * /* */ 01051000 * /* READ GROUP RECORD @Y30LB26*/ 01052000 * /* */ 01053000 * /*****************************************************************/ 01054000 * 0353 01055000 * GROUPKY=MGPGROUP; /* PUT GROUP NM IN KEY @Y30LB26*/ 01056000 MVC GROUPKY(8),MGPGROUP(MGPPTR) 0353 01057000 * RPLVKEY=ADDR(GKEY); /* SET VSAM RB TO REC @Y30LB26*/ 01058000 L @07,RPLVPTR 0354 01059000 LA @02,GKEY 0354 01060000 ST @02,RPLVKEY(,@07) 0354 01061000 * RPLVBUF=ADDR(STORGRP); /* ADDR OF BUFFER @Y30LB26*/ 01062000 LA @02,STORGRP 0355 01063000 ST @02,RPLVBUF(,@07) 0355 01064000 * RPLVBLN=LENGTH(STORGRP); /* LENGTH BUFFER @Y30LB26*/ 01065000 MVC RPLVBLN(4,@07),@CF01147 0356 01066000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 01067000 OI RPLVDIR(@07),B'01000000' 0357 01068000 * RPLVTYP=RPLVREAD; /* READ @Y30LB26*/ 01069000 MVI RPLVTYP(@07),X'00' 0358 01070000 * RPLVUPD=ON; /* READ FOR UPDATE @Y30LB26*/ 01071000 OI RPLVUPD(@07),B'00000010' 0359 01072000 * RESPECIFY 0360 01073000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 01074000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 01075000 LR REG1,@07 0361 01076000 * CALL ICBVIO00; /* READ DIRECT FOR REC @Y30LB26*/ 01077000 L @15,@CV00671 0362 01078000 BALR @14,@15 0362 01079000 * RESPECIFY 0363 01080000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 01081000 * 0363 01082000 * /*****************************************************************/ 01083000 * /* */ 01084000 * /* CHECK FOR BAD RETURN CODE @Y30LB26*/ 01085000 * /* */ 01086000 * /*****************************************************************/ 01087000 * 0364 01088000 * IF RPLVRETC^=RCZERO /* CK RETURN @Y30LB26*/ 01089000 * THEN /* @Y30LB26*/ 01090000 * 0364 01091000 L @07,RPLVPTR 0364 01092000 CLC RPLVRETC(2,@07),@CB00747 0364 01093000 BE @RF00364 0364 01094000 * /***************************************************************/ 01095000 * /* */ 01096000 * /* IF BAD, SAVE CODES AND RETURN @Y30LB26*/ 01097000 * /* */ 01098000 * /***************************************************************/ 01099000 * 0365 01100000 * DO; /* @Y30LB26*/ 01101000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 01102000 BAL @14,ERREXIT 0366 01103000 * RETURN; /* @Y30LB26*/ 01104000 @EL00004 L @13,4(,@13) 0367 01105000 @EF00004 DS 0H 0367 01106000 @ER00004 LM @14,@12,12(@13) 0367 01107000 BR @14 0367 01108000 * END; /* @Y30LB26*/ 01109000 * 0369 01110000 * /*****************************************************************/ 01111000 * /* */ 01112000 * /* SET PTR TO IT @Y30LB26*/ 01113000 * /* */ 01114000 * /*****************************************************************/ 01115000 * 0369 01116000 * GROUPPTR=ADDR(STORGRP); /* ADDR WORKING COPY @Y30LB26*/ 01117000 @RF00364 LA @07,STORGRP 0369 01118000 ST @07,GROUPPTR 0369 01119000 * REL3CONF=OFF; /* NOT CONVERTING TO @G24LB04 01120000 * R3 AS YET @G24LB04*/ 01121000 * 0370 01122000 NI REL3CONF,B'11111101' 0370 01123000 * /*****************************************************************/ 01124000 * /* */ 01125000 * /* IF CONCURRENT USERS SPECIFIED, FILL IN AND @G24LB04*/ 01126000 * /* CHECK FOR CONVERSION TO MSS RELEASE 3 @G24LB04*/ 01127000 * /* */ 01128000 * /*****************************************************************/ 01129000 * 0371 01130000 * IF MGPFLCON=ON /* @G24LB04*/ 01131000 * THEN /* CONCURRENT USERS IS @G24LB04 01132000 * SPECIFIED @G24LB04*/ 01133000 TM MGPFLCON(MGPPTR),B'00000001' 0371 01134000 BNO @RF00371 0371 01135000 * DO; /* @G24LB04*/ 01136000 * IF GROCONUS=FIXZERO&GROVVGRP^=SYSGROUP/* @G24LB04*/ 01137000 * &MGPCONUS^=BIT8ZERO /* PREVIOUS VALUE ZERO? @G24LB04*/ 01138000 * THEN /* MUST CONVERT TO MSS @G24LB04 01139000 * RELEASE 3 @G24LB04*/ 01140000 CLI GROCONUS(@07),0 0373 01141000 BNE @RF00373 0373 01142000 CLC GROVVGRP(8,@07),SYSGROUP 0373 01143000 BE @RF00373 0373 01144000 CLI MGPCONUS(MGPPTR),0 0373 01145000 BE @RF00373 0373 01146000 * REL3CONF=ON; /* FLAG TO DO LATER @G24LB04*/ 01147000 OI REL3CONF,B'00000010' 0374 01148000 * GROCONUS=MGPCONUS; /* NEW CONCUR USER DEF @G24LB37*/ 01149000 @RF00373 L @07,GROUPPTR 0375 01150000 MVC GROCONUS(1,@07),MGPCONUS(MGPPTR) 0375 01151000 * END; /* @G24LB04*/ 01152000 * 0377 01153000 * /*****************************************************************/ 01154000 * /* */ 01155000 * /* IF OWNER SPECIFIED, MODIFY FIELD #Y30LB26*/ 01156000 * /* */ 01157000 * /*****************************************************************/ 01158000 * 0377 01159000 * IF MGPFLOWN=ON /* CK OWNER SPEC ? #Y30LB26*/ 01160000 * THEN 0377 01161000 @RF00371 TM MGPFLOWN(MGPPTR),B'00010000' 0377 01162000 BNO @RF00377 0377 01163000 * GROOWNER=MGPOWNER; /* MOVE IN NEW OWNER @Y30LB26*/ 01164000 L @07,GROUPPTR 0378 01165000 MVC GROOWNER(10,@07),MGPOWNER(MGPPTR) 0378 01166000 * 0379 01167000 * /*****************************************************************/ 01168000 * /* */ 01169000 * /* IF PRIMARY SPACE CHANGED, CHANGE IT @Y30LB26*/ 01170000 * /* */ 01171000 * /*****************************************************************/ 01172000 * 0379 01173000 * IF MGPFLPRI=ON /* CK PRIMARY SP SPEC @Y30LB26*/ 01174000 * THEN 0379 01175000 @RF00377 TM MGPFLPRI(MGPPTR),B'00001000' 0379 01176000 BNO @RF00379 0379 01177000 * GROPSPD=MGPRI; /* NEW PRI SPACE DEF @Y30LB26*/ 01178000 LH @07,MGPRI(,MGPPTR) 0380 01179000 L @02,GROUPPTR 0380 01180000 STH @07,GROPSPD(,@02) 0380 01181000 * 0381 01182000 * /*****************************************************************/ 01183000 * /* */ 01184000 * /* IF RESERVED SPACE CHANGED, CHANGE IT @G24LB37*/ 01185000 * /* */ 01186000 * /*****************************************************************/ 01187000 * 0381 01188000 * IF MGPFLRES=ON /* RESERVED SPACE @G24LB04 01189000 * SPECIFIED ? @G24LB04*/ 01190000 * THEN /* @G24LB04*/ 01191000 @RF00379 TM MGPFLRES(MGPPTR),B'10000000' 0381 01192000 BNO @RF00381 0381 01193000 * GRORESSP=MGPRESSP; /* PERCENT RESERVED @G24LB37*/ 01194000 L @07,GROUPPTR 0382 01195000 MVC GRORESSP(1,@07),MGPRESSP(MGPPTR) 0382 01196000 * ELSE 0383 01197000 * IF REL3CONF=ON THEN /* CONV TO R3 LEVEL? @G24LB04*/ 01198000 B @RC00381 0383 01199000 @RF00381 TM REL3CONF,B'00000010' 0383 01200000 BNO @RF00383 0383 01201000 * GRORESSP=DEFRESSP; /* PROVIDE DEFAULT @G24LB04*/ 01202000 L @07,GROUPPTR 0384 01203000 MVI GRORESSP(@07),X'28' 0384 01204000 * 0385 01205000 * /*****************************************************************/ 01206000 * /* */ 01207000 * /* UPDATE SECONDARY SPACE DEFAULT IF REQUIRED #Y30LB26*/ 01208000 * /* */ 01209000 * /*****************************************************************/ 01210000 * 0385 01211000 * IF MGPFLSEC=ON /* CK SEC SPACE SPEC @Y30LB26*/ 01212000 * THEN 0385 01213000 @RF00383 DS 0H 0385 01214000 @RC00381 TM MGPFLSEC(MGPPTR),B'00000100' 0385 01215000 BNO @RF00385 0385 01216000 * GROSSPD=MGPSEC; /* NEW SEC SPACE @Y30LB26*/ 01217000 LH @07,MGPSEC(,MGPPTR) 0386 01218000 L @02,GROUPPTR 0386 01219000 STH @07,GROSSPD(,@02) 0386 01220000 * 0387 01221000 * /*****************************************************************/ 01222000 * /* */ 01223000 * /* CHECK THRESHOLD PERCENT SPECIFIED @Y30LB26*/ 01224000 * /* */ 01225000 * /*****************************************************************/ 01226000 * 0387 01227000 * IF MGPFLTHO=ON /* THRESHOLD SPEC @Y30LB26*/ 01228000 * THEN /* @Y30LB26*/ 01229000 * 0387 01230000 @RF00385 TM MGPFLTHO(MGPPTR),B'00000010' 0387 01231000 BNO @RF00387 0387 01232000 * /***************************************************************/ 01233000 * /* */ 01234000 * /* IF SPECIFIED, UPDATE AND CALCULATE THRESHOLD @Y30LB26*/ 01235000 * /* SPACE @Y30LB26*/ 01236000 * /* */ 01237000 * /***************************************************************/ 01238000 * 0388 01239000 * DO; /* @Y30LB26*/ 01240000 * GROPCENT=MGPTHOLD; /* NEW PRECENT @Y30LB26*/ 01241000 L @07,GROUPPTR 0389 01242000 SLR @02,@02 0389 01243000 IC @02,MGPTHOLD(,MGPPTR) 0389 01244000 STC @02,GROPCENT(,@07) 0389 01245000 * GROSTRSH=(GRONGEN*CYLS*GROPCENT)/HUNDRED;/* @Y30LB26*/ 01246000 LH @01,GRONGEN(,@07) 0390 01247000 MH @01,@CH00890 0390 01248000 MR @00,@02 0390 01249000 D @00,@CF00892 0390 01250000 ST @01,GROSTRSH(,@07) 0390 01251000 * END; /* @Y30LB26*/ 01252000 * 0392 01253000 * /*****************************************************************/ 01254000 * /* */ 01255000 * /* CHECK IF RETENTION PERIOD SPECIFIED @Y30LB26*/ 01256000 * /* */ 01257000 * /*****************************************************************/ 01258000 * 0392 01259000 * IF MGPFLRET=ON /* CK RETENTION PRD @Y30LB26*/ 01260000 * THEN /* @Y30LB26*/ 01261000 * 0392 01262000 @RF00387 TM MGPFLRET(MGPPTR),B'00000001' 0392 01263000 BNO @RF00392 0392 01264000 * /***************************************************************/ 01265000 * /* */ 01266000 * /* INDICATE RETN CHECKING AND UPDATE FIELD @Y30LB26*/ 01267000 * /* */ 01268000 * /***************************************************************/ 01269000 * 0393 01270000 * DO; /* @Y30LB26*/ 01271000 * GRORETN=ON; /* INDICATE RETEN SPEC @Y30LB26*/ 01272000 L @07,GROUPPTR 0394 01273000 OI GRORETN(@07),B'00000100' 0394 01274000 * GRORETPD=MGPRETPD; /* NEW RETEN PERIOD @Y30LB26*/ 01275000 LH @02,MGPRETPD(,MGPPTR) 0395 01276000 ST @02,GRORETPD(,@07) 0395 01277000 * END; /* @Y30LB26*/ 01278000 * 0397 01279000 * /*****************************************************************/ 01280000 * /* */ 01281000 * /* IF DESCRIPTION UPDATED, FILL IN UPDATE @Y30LB26*/ 01282000 * /* */ 01283000 * /*****************************************************************/ 01284000 * 0397 01285000 * IF MGPFLDES=ON /* DESCRIPTION SPEC ? @Y30LB26*/ 01286000 * THEN 0397 01287000 @RF00392 TM MGPFLDES(MGPPTR),B'10000000' 0397 01288000 BNO @RF00397 0397 01289000 * GRODESCR=MGPDESCR; /* UPDATE DESCRIPTION @Y30LB26*/ 01290000 L @07,GROUPPTR 0398 01291000 MVC GRODESCR(30,@07),MGPDESCR(MGPPTR) 0398 01292000 * 0399 01293000 * /*****************************************************************/ 01294000 * /* */ 01295000 * /* NEW ADDRESS IF NEEDED @Y30LB26*/ 01296000 * /* */ 01297000 * /*****************************************************************/ 01298000 * 0399 01299000 * IF MGPFLADD=ON /* NEW ADDR SPEC ? @Y30LB26*/ 01300000 * THEN 0399 01301000 @RF00397 TM MGPFLADD(MGPPTR),B'01000000' 0399 01302000 BNO @RF00399 0399 01303000 * GROADDR=MGPADDR; /* UPDATE ADDRESS @Y30LB26*/ 01304000 L @07,GROUPPTR 0400 01305000 MVC GROADDR(30,@07),MGPADDR(MGPPTR) 0400 01306000 * 0401 01307000 * /*****************************************************************/ 01308000 * /* */ 01309000 * /* SET RELEASE FLAG ON @Y30LB26*/ 01310000 * /* */ 01311000 * /*****************************************************************/ 01312000 * 0401 01313000 * IF MGPRLSE=ON /* RELEASE SPEC ? @Y30LB26*/ 01314000 * THEN 0401 01315000 @RF00399 TM MGPRLSE(MGPPTR),B'10000000' 0401 01316000 BNO @RF00401 0401 01317000 * GRORLSE=ON; /* SET TO RELEASE @Y30LB26*/ 01318000 L @07,GROUPPTR 0402 01319000 OI GRORLSE(@07),B'00001000' 0402 01320000 * 0403 01321000 * /*****************************************************************/ 01322000 * /* */ 01323000 * /* SET RELEASE FLAG OFF @Y30LB26*/ 01324000 * /* */ 01325000 * /*****************************************************************/ 01326000 * 0403 01327000 * IF MGPNRLSE=ON /* NO RELEASE SPEC ? @Y30LB26*/ 01328000 * THEN 0403 01329000 @RF00401 TM MGPNRLSE(MGPPTR),B'01000000' 0403 01330000 BNO @RF00403 0403 01331000 * GRORLSE=OFF; /* SET FOR NO RELEASE @Y30LB26*/ 01332000 L @07,GROUPPTR 0404 01333000 NI GRORLSE(@07),B'11110111' 0404 01334000 * 0405 01335000 * /*****************************************************************/ 01336000 * /* */ 01337000 * /* SET BIND FLAG ON @Y30LB26*/ 01338000 * /* */ 01339000 * /*****************************************************************/ 01340000 * 0405 01341000 * IF MGPBIND=ON /* BIND SPEC ? @Y30LB26*/ 01342000 * THEN 0405 01343000 @RF00403 TM MGPBIND(MGPPTR),B'00100000' 0405 01344000 BNO @RF00405 0405 01345000 * GROBIND=ON; /* BIND IT @Y30LB26*/ 01346000 L @07,GROUPPTR 0406 01347000 OI GROBIND(@07),B'10000000' 0406 01348000 * 0407 01349000 * /*****************************************************************/ 01350000 * /* */ 01351000 * /* SET BIND FLAG OFF @Y30LB26*/ 01352000 * /* */ 01353000 * /*****************************************************************/ 01354000 * 0407 01355000 * IF MGPNBIND=ON /* NO BIND ? @Y30LB26*/ 01356000 * THEN 0407 01357000 @RF00405 TM MGPNBIND(MGPPTR),B'00010000' 0407 01358000 BNO @RF00407 0407 01359000 * GROBIND=OFF; /* NO BIND IT @Y30LB26*/ 01360000 L @07,GROUPPTR 0408 01361000 NI GROBIND(@07),B'01111111' 0408 01362000 * 0409 01363000 * /*****************************************************************/ 01364000 * /* */ 01365000 * /* SET EXCLUSIVE USE FLAG ON @Y30LB26*/ 01366000 * /* */ 01367000 * /*****************************************************************/ 01368000 * 0409 01369000 * IF MGPEXCL=ON /* EXCLUSIVE ? @Y30LB26*/ 01370000 * THEN 0409 01371000 @RF00407 TM MGPEXCL(MGPPTR),B'00001000' 0409 01372000 BNO @RF00409 0409 01373000 * GROEXCL=ON; /* SET EXCLUSIVE USE @Y30LB26*/ 01374000 L @07,GROUPPTR 0410 01375000 OI GROEXCL(@07),B'01000000' 0410 01376000 * 0411 01377000 * /*****************************************************************/ 01378000 * /* */ 01379000 * /* SET EXCLUSIVE USE FLAG OFF @Y30LB26*/ 01380000 * /* */ 01381000 * /*****************************************************************/ 01382000 * 0411 01383000 * IF MGPSHARE=ON /* SHARE IT @Y30LB26*/ 01384000 * THEN 0411 01385000 @RF00409 TM MGPSHARE(MGPPTR),B'00000100' 0411 01386000 BNO @RF00411 0411 01387000 * GROEXCL=OFF; /* SHARED @Y30LB26*/ 01388000 L @07,GROUPPTR 0412 01389000 NI GROEXCL(@07),B'10111111' 0412 01390000 * 0413 01391000 * /*****************************************************************/ 01392000 * /* */ 01393000 * /* SET READ ONLY FLAG ON @Y30LB26*/ 01394000 * /* */ 01395000 * /*****************************************************************/ 01396000 * 0413 01397000 * IF MGPRONLY=ON /* READ ONLY ? @Y30LB26*/ 01398000 * THEN 0413 01399000 @RF00411 TM MGPRONLY(MGPPTR),B'00000010' 0413 01400000 BNO @RF00413 0413 01401000 * GRORONLY=ON; /* IT IS READ ONLY @Y30LB26*/ 01402000 L @07,GROUPPTR 0414 01403000 OI GRORONLY(@07),B'00010000' 0414 01404000 * 0415 01405000 * /*****************************************************************/ 01406000 * /* */ 01407000 * /* SET READ ONLY FLAG OFF @Y30LB26*/ 01408000 * /* */ 01409000 * /*****************************************************************/ 01410000 * 0415 01411000 * IF MGPRW=ON /* READ - WRITE ? @Y30LB26*/ 01412000 * THEN 0415 01413000 @RF00413 TM MGPRW(MGPPTR),B'00000001' 0415 01414000 BNO @RF00415 0415 01415000 * GRORONLY=OFF; /* READ - WRITE BOTH @Y30LB26*/ 01416000 L @07,GROUPPTR 0416 01417000 NI GRORONLY(@07),B'11101111' 0416 01418000 * 0417 01419000 * /*****************************************************************/ 01420000 * /* */ 01421000 * /* SET DASD ERASE FLAG ON @Y30LB26*/ 01422000 * /* */ 01423000 * /*****************************************************************/ 01424000 * 0417 01425000 * IF MGPDERAS=ON /* DASD ERASE ? @Y30LB26*/ 01426000 * THEN 0417 01427000 @RF00415 TM MGPDERAS(MGPPTR),B'10000000' 0417 01428000 BNO @RF00417 0417 01429000 * GRODAERA=ON; /* ERASE IT @Y30LB26*/ 01430000 L @07,GROUPPTR 0418 01431000 OI GRODAERA(@07),B'00100000' 0418 01432000 * 0419 01433000 * /*****************************************************************/ 01434000 * /* */ 01435000 * /* SET DASD ERASE FLAG OFF @Y30LB26*/ 01436000 * /* */ 01437000 * /*****************************************************************/ 01438000 * 0419 01439000 * IF MGPNDERA=ON /* NO DASD ERASE ? @Y30LB26*/ 01440000 * THEN 0419 01441000 @RF00417 TM MGPNDERA(MGPPTR),B'01000000' 0419 01442000 BNO @RF00419 0419 01443000 * GRODAERA=OFF; /* DO NOT ERASE @Y30LB26*/ 01444000 L @07,GROUPPTR 0420 01445000 NI GRODAERA(@07),B'11011111' 0420 01446000 * 0421 01447000 * /*****************************************************************/ 01448000 * /* */ 01449000 * /* CHECK IF NULLIFY THRESHOLD FLAG IS ON @Y30LB26*/ 01450000 * /* */ 01451000 * /*****************************************************************/ 01452000 * 0421 01453000 * IF MGPNTHLD=ON /* NULLIFY THRESHOLD ? @Y30LB26*/ 01454000 * THEN /* @Y30LB26*/ 01455000 * 0421 01456000 @RF00419 TM MGPNTHLD(MGPPTR),B'00100000' 0421 01457000 BNO @RF00421 0421 01458000 * /***************************************************************/ 01459000 * /* */ 01460000 * /* IF ON, ZERO PERCENT AND THRESHOLD CYLINDERS @Y30LB26*/ 01461000 * /* */ 01462000 * /***************************************************************/ 01463000 * 0422 01464000 * DO; /* @Y30LB26*/ 01465000 * GROPCENT=ZERO; /* NULLIFY PERCENT ? @Y30LB26*/ 01466000 L @07,GROUPPTR 0423 01467000 MVI GROPCENT(@07),X'00' 0423 01468000 * GROSTRSH=ZERO; /* ZERO THRESHOLD CYL @Y30LB26*/ 01469000 SLR @02,@02 0424 01470000 ST @02,GROSTRSH(,@07) 0424 01471000 * END; /* @Y30LB26*/ 01472000 * 0426 01473000 * /*****************************************************************/ 01474000 * /* */ 01475000 * /* NULLIFY OWNER FIELD IF ASKED FOR @Y30LB26*/ 01476000 * /* */ 01477000 * /*****************************************************************/ 01478000 * 0426 01479000 * IF MGPNOWNR=ON /* NULLIFY OWNER ? @Y30LB26*/ 01480000 * THEN 0426 01481000 @RF00421 TM MGPNOWNR(MGPPTR),B'00010000' 0426 01482000 BNO @RF00426 0426 01483000 * GROOWNER=BLANK; /* NULLIFY OWNER @Y30LB26*/ 01484000 L @07,GROUPPTR 0427 01485000 MVI GROOWNER+1(@07),C' ' 0427 01486000 MVC GROOWNER+2(8,@07),GROOWNER+1(@07) 0427 01487000 MVI GROOWNER(@07),C' ' 0427 01488000 * 0428 01489000 * /*****************************************************************/ 01490000 * /* */ 01491000 * /* CHECK IF NULLIFICATION RETENTION PERIOD REQUIRED @Y30LB26*/ 01492000 * /* */ 01493000 * /*****************************************************************/ 01494000 * 0428 01495000 * IF MGPNRETP=ON /* NULLIFY RET PRD ? @Y30LB26*/ 01496000 * THEN /* @Y30LB26*/ 01497000 * 0428 01498000 @RF00426 TM MGPNRETP(MGPPTR),B'00001000' 0428 01499000 BNO @RF00428 0428 01500000 * /***************************************************************/ 01501000 * /* */ 01502000 * /* SET RET PERIOD CHECK FLAG OFF, ZERO RET PER @Y30LB26*/ 01503000 * /* */ 01504000 * /***************************************************************/ 01505000 * 0429 01506000 * DO; /* @Y30LB26*/ 01507000 * GRORETN=OFF; /* SET RET PERIOD FLG @Y30LB26*/ 01508000 L @07,GROUPPTR 0430 01509000 NI GRORETN(@07),B'11111011' 0430 01510000 * GRORETPD=ZERO; /* ZERO OUT RET @Y30LB26*/ 01511000 SLR @02,@02 0431 01512000 ST @02,GRORETPD(,@07) 0431 01513000 * END; /* @Y30LB26*/ 01514000 * 0433 01515000 * /*****************************************************************/ 01516000 * /* */ 01517000 * /* BLANK DESCRIPTION IF NECESSARY @Y30LB26*/ 01518000 * /* */ 01519000 * /*****************************************************************/ 01520000 * 0433 01521000 * IF MGPNDESC=ON /* NULLIFY DESCR ? @Y30LB26*/ 01522000 * THEN 0433 01523000 @RF00428 TM MGPNDESC(MGPPTR),B'00000100' 0433 01524000 BNO @RF00433 0433 01525000 * GRODESCR=BLANK; /* BLANK OUT DESCR @Y30LB26*/ 01526000 L @07,GROUPPTR 0434 01527000 MVI GRODESCR+1(@07),C' ' 0434 01528000 MVC GRODESCR+2(28,@07),GRODESCR+1(@07) 0434 01529000 MVI GRODESCR(@07),C' ' 0434 01530000 * 0435 01531000 * /*****************************************************************/ 01532000 * /* */ 01533000 * /* BLANK ADDRESS @Y30LB26*/ 01534000 * /* */ 01535000 * /*****************************************************************/ 01536000 * 0435 01537000 * IF MGPNADDR=ON /* NULLIFY ADDRESS ? @Y30LB26*/ 01538000 * THEN 0435 01539000 @RF00433 TM MGPNADDR(MGPPTR),B'00000010' 0435 01540000 BNO @RF00435 0435 01541000 * GROADDR=BLANK; /* BLANK ADDRESS @Y30LB26*/ 01542000 L @07,GROUPPTR 0436 01543000 MVI GROADDR+1(@07),C' ' 0436 01544000 MVC GROADDR+2(28,@07),GROADDR+1(@07) 0436 01545000 MVI GROADDR(@07),C' ' 0436 01546000 * 0437 01547000 * /*****************************************************************/ 01548000 * /* */ 01549000 * /* WRITE GROUP RECORD JUST MODIFIED @Y30LB26*/ 01550000 * /* */ 01551000 * /*****************************************************************/ 01552000 * 0437 01553000 * RPLVTYP=RPLVPUT; /* PUT GROUP REC @Y30LB26*/ 01554000 @RF00435 L @07,RPLVPTR 0437 01555000 MVI RPLVTYP(@07),X'01' 0437 01556000 * RESPECIFY 0438 01557000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 01558000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 01559000 LR REG1,@07 0439 01560000 * CALL ICBVIO00; /* WRITE RECORD @Y30LB26*/ 01561000 L @15,@CV00671 0440 01562000 BALR @14,@15 0440 01563000 * RESPECIFY 0441 01564000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 01565000 * 0441 01566000 * /*****************************************************************/ 01567000 * /* */ 01568000 * /* CHECK RETURN CODE FROM I/O PROCESSOR @Y30LB26*/ 01569000 * /* */ 01570000 * /*****************************************************************/ 01571000 * 0442 01572000 * IF RPLVRETC^=RCZERO /* CK RETURN CODE @Y30LB26*/ 01573000 * THEN /* @Y30LB26*/ 01574000 * 0442 01575000 L @07,RPLVPTR 0442 01576000 CLC RPLVRETC(2,@07),@CB00747 0442 01577000 BE @RF00442 0442 01578000 * /***************************************************************/ 01579000 * /* */ 01580000 * /* IF BAD, SAVE CODES AND RETURN @Y30LB26*/ 01581000 * /* */ 01582000 * /***************************************************************/ 01583000 * 0443 01584000 * DO; /* @Y30LB26*/ 01585000 * CALL ERREXIT; /* SAVE RETURN CODES @Y30LB26*/ 01586000 BAL @14,ERREXIT 0444 01587000 * RETURN; /* RETURN TO CALLER @Y30LB26*/ 01588000 B @EL00004 0445 01589000 * END; /* @Y30LB26*/ 01590000 * 0447 01591000 * /*****************************************************************/ 01592000 * /* */ 01593000 * /* GO JOURNAL RPLV SINCE MODIFIED GROUP REC WRITTEN @Y30LB26*/ 01594000 * /* */ 01595000 * /*****************************************************************/ 01596000 * 0447 01597000 * CALL JOURNAL; /* JOURNAL RPLV @Y30LB26*/ 01598000 @RF00442 BAL @14,JOURNAL 0447 01599000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @Y30LB26*/ 01600000 L @07,RPLVPTR 0448 01601000 CLC RPLVRETC(2,@07),@CB00747 0448 01602000 BNE @RT00448 0448 01603000 * RETURN; /* @Y30LB26*/ 01604000 * 0450 01605000 * /*****************************************************************/ 01606000 * /* */ 01607000 * /* CHECK TO SEE IF EXPIRATION DATE WAS NULLIFIED. @Y30LB26*/ 01608000 * /* IF SO, GO CLEAR EXPIRATION OUT OF ALL BASE RECS @Y30LB26*/ 01609000 * /* IN THAT GROUP........ @Y30LB26*/ 01610000 * /* */ 01611000 * /*****************************************************************/ 01612000 * 0450 01613000 * IF MGPNRETP=ON THEN /* NULLIFY RETENTION ? @Y30LB26*/ 01614000 TM MGPNRETP(MGPPTR),B'00001000' 0450 01615000 BNO @RF00450 0450 01616000 * DO; /* @Y30LB26*/ 01617000 * CALL NULBASRT; /* GO NULL BASES @Y30LB26*/ 01618000 BAL @14,NULBASRT 0452 01619000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @Y30LB26*/ 01620000 L @02,RPLVPTR 0453 01621000 CLC RPLVRETC(2,@02),@CB00747 0453 01622000 BNE @RT00453 0453 01623000 * RETURN; /* @Y30LB26*/ 01624000 * END; /* @Y30LB26*/ 01625000 * 0456 01626000 */* NEED TO CONVERT GROUP TO MSS RELEASE THREE ? @G24LB04*/ 01627000 * 0456 01628000 * IF REL3CONF=ON /* @G24LB04*/ 01629000 * THEN 0456 01630000 @RF00450 TM REL3CONF,B'00000010' 0456 01631000 BNO @RF00456 0456 01632000 * DO; /* YES @G24LB04*/ 01633000 * CALL REL3CONV; /* EFFECTS CHANGES @G24LB04*/ 01634000 BAL @14,REL3CONV 0458 01635000 * REL3CONF=OFF; /* TURN OFF SWITCH @G24LB04*/ 01636000 NI REL3CONF,B'11111101' 0459 01637000 * END; /* @G24LB04*/ 01638000 * RETURN; /* RETURN TO CALLER @Y30LB26*/ 01639000 B @EL00004 0461 01640000 * END MODIFYG; /* @Y30LB26*/ 01641000 B @EL00004 0462 01642000 * 0463 01643000 * /*****************************************************************/ 01644000 * /* */ 01645000 * /* ROUTINE CHECKS TO SEE IF THERE ARE ANY VOLUMES @Y30LB26*/ 01646000 * /* THAT NEED TO HAVE THEIR EXPIRATION DATES NULLIFIED @Y30LB26*/ 01647000 * /* ANY ACTIVE OR INACTIVE GENERAL TYPE VOLUMES WILL @Y30LB26*/ 01648000 * /* HAVE THEIR EXPIRATION DATES NULLIFIED @Y30LB26*/ 01649000 * /* */ 01650000 * /*****************************************************************/ 01651000 * 0463 01652000 *NULBASRT: 0463 01653000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 01654000 * 0463 01655000 NULBASRT ST @14,@SA00005 0463 01656000 * /*****************************************************************/ 01657000 * /* */ 01658000 * /* SEE IF ANY VOLUMES IN GROUP @Y301B26*/ 01659000 * /* */ 01660000 * /*****************************************************************/ 01661000 * 0464 01662000 * IF GRONGEN=ZERO&GRONINAC=ZERO THEN/* @Y30LB26*/ 01663000 SLR @02,@02 0464 01664000 L @15,GROUPPTR 0464 01665000 CH @02,GRONGEN(,@15) 0464 01666000 BNE @RF00464 0464 01667000 CH @02,GRONINAC(,@15) 0464 01668000 BE @RT00464 0464 01669000 * RETURN; /* @Y30LB26*/ 01670000 * VOLKY=GROFSN; /* VOL NAME OF FIRST @Y301B26*/ 01671000 * 0466 01672000 @RF00464 L @02,GROUPPTR 0466 01673000 MVC VOLKY(6),GROFSN(@02) 0466 01674000 * /*****************************************************************/ 01675000 * /* */ 01676000 * /* START LOOPING THRU BASE RECORDS IN THIS GROUP @Y30LB26*/ 01677000 * /* */ 01678000 * /*****************************************************************/ 01679000 * 0467 01680000 * DO WHILE I=I; /* LOOP THRU BASE RECS @Y30LB26*/ 01681000 B @DE00467 0467 01682000 @DL00467 DS 0H 0468 01683000 * RPLVKEY=ADDR(VKEY); /* ADDR OF KEY @Y30LB26*/ 01684000 L @02,RPLVPTR 0468 01685000 LA @15,VKEY 0468 01686000 ST @15,RPLVKEY(,@02) 0468 01687000 * RPLVBUF=ADDR(STORBASE); /* ADDR BUFFER @Y30LB26*/ 01688000 LA @15,STORBASE 0469 01689000 ST @15,RPLVBUF(,@02) 0469 01690000 * RPLVBLN=LENGTH(STORBASE); /* LENGTH OF BUFFER @Y30LB26*/ 01691000 MVC RPLVBLN(4,@02),@CF01147 0470 01692000 * RPLVKGE=OFF; /* SET KEY GTR OR EQU OFF 0471 01693000 * @ZA14732*/ 01694000 * RPLVDIR=ON; /* READ DIRECT @Y301B26*/ 01695000 OI RPLVDIR(@02),B'01000000' 0472 01696000 NI RPLVKGE(@02),B'11111011' 0472 01697000 * RPLVTYP=RPLVREAD; /* READ REC @Y301B26*/ 01698000 MVI RPLVTYP(@02),X'00' 0473 01699000 * RPLVUPD=ON; /* FOR UPDATE @Y301B26*/ 01700000 OI RPLVUPD(@02),B'00000010' 0474 01701000 * RESPECIFY 0475 01702000 * REG1 RSTD; /* RESTRICT @Y301B26*/ 01703000 * REG1=RPLVPTR; /* ADDR RPLV @Y301B26*/ 01704000 LR REG1,@02 0476 01705000 * CALL ICBVIO00; /* READ BASE @Y301B26*/ 01706000 L @15,@CV00671 0477 01707000 BALR @14,@15 0477 01708000 * RESPECIFY 0478 01709000 * REG1 UNRSTD; /* FREE REG1 @Y301B26*/ 01710000 * 0478 01711000 * /***************************************************************/ 01712000 * /* */ 01713000 * /* CHECK RETURN CODE FROM I/O PROCESSOR @Y30LB26*/ 01714000 * /* */ 01715000 * /***************************************************************/ 01716000 * 0479 01717000 * IF RPLVRETC^=RCZERO THEN /* CHECK RETURN @Y301B26*/ 01718000 L @02,RPLVPTR 0479 01719000 CLC RPLVRETC(2,@02),@CB00747 0479 01720000 BE @RF00479 0479 01721000 * DO; /* @Y301B26*/ 01722000 * CALL ERREXIT; /* RELEASE INVENTORY @Y301B26*/ 01723000 BAL @14,ERREXIT 0481 01724000 * RETURN; /* @Y301B26*/ 01725000 @EL00005 DS 0H 0482 01726000 @EF00005 DS 0H 0482 01727000 @ER00005 L @14,@SA00005 0482 01728000 BR @14 0482 01729000 * END; /* @Y301B26*/ 01730000 * BASEVPTR=ADDR(STORBASE); /* ADDR OF BASE REC @Y301B26*/ 01731000 * 0484 01732000 @RF00479 LA @02,STORBASE 0484 01733000 ST @02,BASEVPTR 0484 01734000 * /***************************************************************/ 01735000 * /* */ 01736000 * /* IF BASE VOL IS GENERAL USE, NULLIFY THE @Y30LB26*/ 01737000 * /* EXPIRATION DATE AND WRITE RECORD @Y30LB26*/ 01738000 * /* */ 01739000 * /***************************************************************/ 01740000 * 0485 01741000 * IF BASGENUS=ON THEN /* GENERAL USE? @Y301B26*/ 01742000 TM BASGENUS(@02),B'00010000' 0485 01743000 BNO @RF00485 0485 01744000 * DO; /* @Y301B26*/ 01745000 * BASEXPDT=NULEXPDT; /* NULLIFY EXPIRATION @Y301B26*/ 01746000 MVC BASEXPDT(4,@02),NULEXPDT 0487 01747000 * RPLVTYP=RPLVPUT; /* INDICATION @Y301B26*/ 01748000 L @02,RPLVPTR 0488 01749000 MVI RPLVTYP(@02),X'01' 0488 01750000 * RESPECIFY 0489 01751000 * REG1 RSTD; /* RESTRICT @Y301B26*/ 01752000 * REG1=RPLVPTR; /* ADDR OF PRLV @Y301B26*/ 01753000 LR REG1,@02 0490 01754000 * CALL ICBVIO00; /* WRITE BASE REC @Y301B26*/ 01755000 L @15,@CV00671 0491 01756000 BALR @14,@15 0491 01757000 * RESPECIFY 0492 01758000 * REG1 UNRSTD; /* FREE REG 1 @Y301B26*/ 01759000 * 0492 01760000 * /***********************************************************/ 01761000 * /* */ 01762000 * /* CHECK RETURN FROM WRITING RECORD @Y30LB26*/ 01763000 * /* */ 01764000 * /***********************************************************/ 01765000 * 0493 01766000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @Y301B26*/ 01767000 L @02,RPLVPTR 0493 01768000 CLC RPLVRETC(2,@02),@CB00747 0493 01769000 BE @RF00493 0493 01770000 * DO; /* @Y301B26*/ 01771000 * CALL ERREXIT; /* RELEASE INVENTORY @Y301B26*/ 01772000 BAL @14,ERREXIT 0495 01773000 * RETURN; /* @Y301B26*/ 01774000 B @EL00005 0496 01775000 * END; /* @Y301B26*/ 01776000 * 0497 01777000 * /***********************************************************/ 01778000 * /* */ 01779000 * /* CALL SLOT ROUTINE TO CLEAR EXPIRATION @Y30LB26*/ 01780000 * /* DATES OUT OF EXTENSION SLOTS @Y30LB26*/ 01781000 * /* */ 01782000 * /***********************************************************/ 01783000 * 0498 01784000 * SLOTEXP=ON; /* INDICATE EXP ONLY @Y30LB26*/ 01785000 @RF00493 OI SLOTEXP,B'10000000' 0498 01786000 * CALL VUEXT; /* GO SLOT IT @Y30LB26*/ 01787000 BAL @14,VUEXT 0499 01788000 * END; /* @ZA14732*/ 01789000 * 0500 01790000 * /***************************************************************/ 01791000 * /* */ 01792000 * /* CHECK TO SEE IF LAST BASE RECORD IN CHAIN #Y30LB26*/ 01793000 * /* */ 01794000 * /***************************************************************/ 01795000 * 0501 01796000 * IF BASLAST=ON THEN /* LAST BASE IN CHAIN? #Y301B26*/ 01797000 @RF00485 L @02,BASEVPTR 0501 01798000 TM BASLAST(@02),B'00001000' 0501 01799000 BNO @RF00501 0501 01800000 * DO; /* #Y301B26*/ 01801000 * RPLVRETC=RCZERO; /* GOOD RETURN #Y301B26*/ 01802000 L @02,RPLVPTR 0503 01803000 MVC RPLVRETC(2,@02),@CB00747 0503 01804000 * RPLRCODE=RCZERO; /* GOOD REASON #Y301B26*/ 01805000 MVC RPLRCODE(2,@02),@CB00747 0504 01806000 * RETURN; /* #Y301B26*/ 01807000 B @EL00005 0505 01808000 * END; /* #Y301B26*/ 01809000 * VOLKY=BASNEXTV; /* VOLID OF NEXT BASE #Y301B26*/ 01810000 @RF00501 L @02,BASEVPTR 0507 01811000 MVC VOLKY(6),BASNEXTV(@02) 0507 01812000 * END; /* @Y301B26*/ 01813000 @DE00467 CLC I(1),I 0508 01814000 BE @DL00467 0508 01815000 * END NULBASRT; /* @Y301B26*/ 01816000 B @EL00005 0509 01817000 *REL3CONV: 0510 01818000 * PROC OPTIONS(SAVE(REG14)); /* @G24LB04*/ 01819000 REL3CONV ST @14,@SA00006 0510 01820000 */*CONVERSION TO MSS RELEASE THREE FROM @G24LB04*/ 01821000 */*PRIOR MSS SUPPORT @G24LB04*/ 01822000 */* THIS PROCEDURE GOES THROUGH ALL OF THE GROUP EXTENSION @G24LB04*/ 01823000 */* RECORDS FOR THE GROUP BEING PROCESSED, AND UPDATES THEM. @G24LB04*/ 01824000 */* FOR EACH VOLUME WHICH IS EITHER MOUNTED TO NO PROCESSOR @G24LB04*/ 01825000 */* AND WHICH DOES NOT CURRENTLY HAVE DOWN LEVEL SPACE, @G24LB04*/ 01826000 */* (1) THE PRESENT FREE SPACE VALUE FROM THE BASE VOLUME @G24LB04*/ 01827000 */* RECORD IS INSERTED INTO THE GROUP EXTENSION RECORD SLOT @G24LB04*/ 01828000 */* FOR THAT VOLUME. (2) THE FLAG SHOWING WHETHER THE @G24LB04*/ 01829000 */* RUNNING COUNT OF FREE SPACE IS VALID OR NOT IS SET TO @G24LB04*/ 01830000 */* SHOW VALID. FOR VOLUMES WHICH HAVE DOWN LEVEL SPACE, @G24LB04*/ 01831000 */* OR ARE MOUNTED TO ANY PROCESSOR, THE FLAG SHOWING @G24LB04*/ 01832000 */* RUNNING COUNT OF FREE SPACE IS SET TO SHOW INVALID. @G24LB04*/ 01833000 */* EACH GROUP EXTENSION RECORD IS WRITTEN AFTER IT HAS @G24LB04*/ 01834000 */* BEEN UPDATED. @G24LB04*/ 01835000 * 0511 01836000 * IF GRONGEN=ZERO /* ANY VOLUMES IN GROUP? @G24LB04*/ 01837000 * THEN 0511 01838000 L @02,GROUPPTR 0511 01839000 LH @15,GRONGEN(,@02) 0511 01840000 LTR @15,@15 0511 01841000 BZ @RT00511 0511 01842000 * RETURN; /* NOTHING TO DO @G24LB04*/ 01843000 * GVSNEPTR=ADDR(STORGPEX); /* ADDRESS BUFFER @G24LB04*/ 01844000 LA GVSNEPTR,STORGPEX 0513 01845000 * GROUPKY=GROVVGRP; /* GROUP ID @G24LB04*/ 01846000 L @15,GROUPPTR 0514 01847000 MVC GROUPKY(8),GROVVGRP(@15) 0514 01848000 * GIDKY=FIXZERO; /* ZERO KEY @G24LB04*/ 01849000 MVI GIDKY,X'00' 0515 01850000 * DO UNTIL GVSEX=OFF; /* LOOP THRU GVSNES @G24LB04*/ 01851000 @DL00516 DS 0H 0517 01852000 * GIDKY=GIDKY+FIXONE; /* BEYOND FIRST GROUP @G24LB04 01853000 * RECORD @G24LB04*/ 01854000 LA @15,1 0517 01855000 SLR @14,@14 0517 01856000 IC @14,GIDKY 0517 01857000 ALR @15,@14 0517 01858000 STC @15,GIDKY 0517 01859000 * RPLVKEY=ADDR(GKEY); /* KEY @G24LB04*/ 01860000 L @15,RPLVPTR 0518 01861000 LA @14,GKEY 0518 01862000 ST @14,RPLVKEY(,@15) 0518 01863000 * RPLVBUF=ADDR(STORGPEX); /* WHERE TO PUT GVSNE @G24LB04*/ 01864000 LA @14,STORGPEX 0519 01865000 ST @14,RPLVBUF(,@15) 0519 01866000 * RPLVLOC=OFF; /* NOT LOCATE MODE @G24LB04*/ 01867000 NI RPLVLOC(@15),B'01111111' 0520 01868000 * RPLVBLN=LENGTH(STORGPEX); /* BUFFER LENGTH @G24LB04*/ 01869000 MVC RPLVBLN(4,@15),@CF01148 0521 01870000 * RPLVDIR=ON; /* READ DIRECT @G24LB04*/ 01871000 OI RPLVDIR(@15),B'01000000' 0522 01872000 * RPLVTYP=RPLVREAD; /* READ RECORD @G24LB04*/ 01873000 MVI RPLVTYP(@15),X'00' 0523 01874000 * RPLVKGE=ON; /* READ > OR = @G24LB04 01875000 * (THIS GOES TO NEXT) @G24LB04*/ 01876000 OI RPLVKGE(@15),B'00000100' 0524 01877000 * RPLVUPD=ON; /* FOR UPDATE @G24LB04*/ 01878000 OI RPLVUPD(@15),B'00000010' 0525 01879000 * RESPECIFY 0526 01880000 * REG1 RSTD; /* @G24LB04*/ 01881000 * REG1=RPLVPTR; /* @G24LB04*/ 01882000 LR REG1,@15 0527 01883000 * CALL ICBVIO00; /* READ EXTENSION RECORD @G24LB04*/ 01884000 L @15,@CV00671 0528 01885000 BALR @14,@15 0528 01886000 * RESPECIFY 0529 01887000 * REG1 UNRSTD; /* @G24LB04*/ 01888000 * IF RPLVRETC^=RCZERO /* @G24LB04*/ 01889000 * THEN 0530 01890000 L @01,RPLVPTR 0530 01891000 CLC RPLVRETC(2,@01),@CB00747 0530 01892000 BE @RF00530 0530 01893000 * DO; /* @G24LB04*/ 01894000 * CALL ERREXIT; /* @G24LB04*/ 01895000 BAL @14,ERREXIT 0532 01896000 * RETURN; /* @G24LB04*/ 01897000 @EL00006 DS 0H 0533 01898000 @EF00006 DS 0H 0533 01899000 @ER00006 L @14,@SA00006 0533 01900000 BR @14 0533 01901000 * END; /* @G24LB04*/ 01902000 * DO IS=1 TO GVSESIND-1; /* PROCESS ALL SLOTS @G24LB04 01903000 * IN THIS GROUP @G24LB04 01904000 * EXTENSION RECORD @G24LB04*/ 01905000 * 0535 01906000 @RF00530 LA IS,1 0535 01907000 B @DE00535 0535 01908000 @DL00535 DS 0H 0536 01909000 * /*************************************************************/ 01910000 * /* */ 01911000 * /* READ BASE VOLUME RECORD FOR THIS VOLSER @G24LB04*/ 01912000 * /* */ 01913000 * /*************************************************************/ 01914000 * 0536 01915000 * VOLKY=GVSVOLID(IS); /* VOLSER TO KEY @G24LB04*/ 01916000 LR @05,IS 0536 01917000 MH @05,@CH01149 0536 01918000 ALR @05,GVSNEPTR 0536 01919000 MVC VOLKY(6),GVSVOLID-20(@05) 0536 01920000 * RPLVKEY=ADDR(VKEY); /* @G24LB04*/ 01921000 L @05,RPLVPTR 0537 01922000 LA @15,VKEY 0537 01923000 ST @15,RPLVKEY(,@05) 0537 01924000 * RPLVLOC=ON; /* LOCATE MODE @G24LB04*/ 01925000 * RPLVDIR=ON; /* DIRECT @G24LB04*/ 01926000 OI RPLVLOC(@05),B'11000000' 0539 01927000 * RPLVUPD=OFF; /* NOT UPDATING @G24LB04*/ 01928000 NI RPLVUPD(@05),B'11111101' 0540 01929000 * RPLVTYP=RPLVREAD; /* SPECIFY READ @G24LB04*/ 01930000 MVI RPLVTYP(@05),X'00' 0541 01931000 * RPLVKGE=OFF; /* RESET @G24LB04*/ 01932000 NI RPLVKGE(@05),B'11111011' 0542 01933000 * RFY 0543 01934000 * REG1 RSTD; /* @G24LB04*/ 01935000 * REG1=RPLVPTR; /* @G24LB04*/ 01936000 LR REG1,@05 0544 01937000 * CALL ICBVIO00; /* READ BASE VOLUME RECORD 0545 01938000 * @G24LB04*/ 01939000 L @15,@CV00671 0545 01940000 BALR @14,@15 0545 01941000 * RFY 0546 01942000 * REG1 UNRSTD; /* @G24LB04*/ 01943000 * IF RPLVRETC^=ZERO THEN /* ERROR IN I/O? @G24LB04*/ 01944000 L @05,RPLVPTR 0547 01945000 LH @05,RPLVRETC(,@05) 0547 01946000 N @05,@CF01186 0547 01947000 LTR @05,@05 0547 01948000 BZ @RF00547 0547 01949000 * DO; /* @G24LB04*/ 01950000 * CALL ERREXIT; /* @G24LB04*/ 01951000 BAL @14,ERREXIT 0549 01952000 * RETURN; /* @G24LB04*/ 01953000 B @EL00006 0550 01954000 * END; /* @G24LB04*/ 01955000 * BASEVPTR=RPLVBUF; /* @G24LB04*/ 01956000 @RF00547 L @05,RPLVPTR 0552 01957000 L @05,RPLVBUF(,@05) 0552 01958000 ST @05,BASEVPTR 0552 01959000 * IF BASCPUID=BITZERO /* VOL NOT MTD TO ANY CPU? 0553 01960000 * @G24LB04*/ 01961000 * &BASDLSF=OFF /* SPACE NOT DOWN LEVEL? @G24LB04*/ 01962000 * THEN 0553 01963000 CLC BASCPUID(2,@05),@CB00747 0553 01964000 BNE @RF00553 0553 01965000 TM BASDLSF(@05),B'10000000' 0553 01966000 BNZ @RF00553 0553 01967000 * DO; /* @G24LB04*/ 01968000 * GVSMTDSP(IS)=BASFRESP; /* UPDATE FREE SPACE @G24LB04*/ 01969000 LR @15,IS 0555 01970000 MH @15,@CH01149 0555 01971000 LH @05,BASFRESP(,@05) 0555 01972000 N @05,@CF01186 0555 01973000 STH @05,GVSMTDSP-20(@15,GVSNEPTR) 0555 01974000 * GVSRCFSI(IS)=OFF; /* RUNNING COUNT IS OK @G24LB04*/ 01975000 * GVSMTNSH(IS)=OFF; /* VOL NOT MTD NON-SHR @G24LB04*/ 01976000 ALR @15,GVSNEPTR 0557 01977000 NI GVSRCFSI-20(@15),B'00111111' 0557 01978000 * END; /* @G24LB04*/ 01979000 * ELSE 0559 01980000 * GVSRCFSI(IS)=ON; /* RUNNING COUNT INVALID @G24LB04*/ 01981000 B @RC00553 0559 01982000 @RF00553 LR @05,IS 0559 01983000 MH @05,@CH01149 0559 01984000 ALR @05,GVSNEPTR 0559 01985000 OI GVSRCFSI-20(@05),B'10000000' 0559 01986000 * END; /* PROCESSING FOR EACH @G24LB04 01987000 * SLOT @G24LB04*/ 01988000 * 0560 01989000 @RC00553 AL IS,@CF00041 0560 01990000 @DE00535 LH @05,GVSESIND(,GVSNEPTR) 0560 01991000 BCTR @05,0 0560 01992000 CR IS,@05 0560 01993000 BNH @DL00535 0560 01994000 * /***************************************************************/ 01995000 * /* */ 01996000 * /* MUST READ GVSNE RECORD ONCE MORE INTO A DUMMY @G24LB04*/ 01997000 * /* BUFFER BEFORE WRITING IT BECAUSE OTHER RECORDS @G24LB04*/ 01998000 * /* HAVE BEEN READ SINCE THIS ONE. @G24LB04*/ 01999000 * /* */ 02000000 * /***************************************************************/ 02001000 * 0561 02002000 * RPLVKEY=ADDR(GVSNAME); /* KEY @G24LB04*/ 02003000 L @15,RPLVPTR 0561 02004000 ST GVSNEPTR,RPLVKEY(,@15) 0561 02005000 * RPLVBUF=ADDR(DUMGVSNE); /* NOT REFERENCED-DUMMY @G24LB04*/ 02006000 LA @14,DUMGVSNE 0562 02007000 ST @14,RPLVBUF(,@15) 0562 02008000 * RPLVLOC=OFF; /* NOT LOCATE MODE @G24LB04*/ 02009000 NI RPLVLOC(@15),B'01111111' 0563 02010000 * RPLVBLN=LENGTH(DUMGVSNE); /* @G24LB04*/ 02011000 MVC RPLVBLN(4,@15),@CF01148 0564 02012000 * RPLVDIR=ON; /* READ DIRECT @G24LB04*/ 02013000 OI RPLVDIR(@15),B'01000000' 0565 02014000 * RPLVTYP=RPLVREAD; /* READ @G24LB04*/ 02015000 MVI RPLVTYP(@15),X'00' 0566 02016000 * RPLVKGE=OFF; /* USE THIS KEY @G24LB04*/ 02017000 NI RPLVKGE(@15),B'11111011' 0567 02018000 * RPLVUPD=ON; /* READ FOR UPDATE @G24LB04*/ 02019000 OI RPLVUPD(@15),B'00000010' 0568 02020000 * RFY 0569 02021000 * REG1 RSTD; /* @G24LB04*/ 02022000 * REG1=RPLVPTR; /* @G24LB04*/ 02023000 LR REG1,@15 0570 02024000 * CALL ICBVIO00; /* READ GVSNE @G24LB04*/ 02025000 L @15,@CV00671 0571 02026000 BALR @14,@15 0571 02027000 * RFY 0572 02028000 * REG1 UNRSTD; /* @G24LB04*/ 02029000 * IF RPLVRETC^=ZERO THEN /* ERROR? @G24LB04*/ 02030000 L @01,RPLVPTR 0573 02031000 LH @15,RPLVRETC(,@01) 0573 02032000 N @15,@CF01186 0573 02033000 LTR @15,@15 0573 02034000 BZ @RF00573 0573 02035000 * DO; /* @G24LB04*/ 02036000 * CALL ERREXIT; /* @G24LB04*/ 02037000 BAL @14,ERREXIT 0575 02038000 * RETURN; /* @G24LB04*/ 02039000 B @EL00006 0576 02040000 * END; /* @G24LB04*/ 02041000 * 0577 02042000 * /***************************************************************/ 02043000 * /* */ 02044000 * /* WRITE THE UPDATED GROUP EXTENSION RECORD @G24LB04*/ 02045000 * /* */ 02046000 * /***************************************************************/ 02047000 * 0578 02048000 * RPLVBUF=ADDR(STORGPEX); /* WHERE RECORD IS @G24LB04*/ 02049000 @RF00573 L @15,RPLVPTR 0578 02050000 LA @14,STORGPEX 0578 02051000 ST @14,RPLVBUF(,@15) 0578 02052000 * RPLVTYP=RPLVPUT; /* WRITE @G24LB04*/ 02053000 MVI RPLVTYP(@15),X'01' 0579 02054000 * RFY 0580 02055000 * REG1 RSTD; /* @G24LB04*/ 02056000 * REG1=RPLVPTR; /* @G24LB04*/ 02057000 LR REG1,@15 0581 02058000 * CALL ICBVIO00; /* @G24LB04*/ 02059000 L @15,@CV00671 0582 02060000 BALR @14,@15 0582 02061000 * RFY 0583 02062000 * REG1 UNRSTD; /* @G24LB04*/ 02063000 * IF RPLVRETC^=RCZERO THEN /* ERROR IN I/O @G24LB04*/ 02064000 L @01,RPLVPTR 0584 02065000 CLC RPLVRETC(2,@01),@CB00747 0584 02066000 BE @RF00584 0584 02067000 * DO; /* @G24LB04*/ 02068000 * CALL ERREXIT; /* @G24LB04*/ 02069000 BAL @14,ERREXIT 0586 02070000 * RETURN; /* @G24LB04*/ 02071000 B @EL00006 0587 02072000 * END; /* @G24LB04*/ 02073000 * END; /* END LOOP THROUGH GVSNES 0589 02074000 * @G24LB04*/ 02075000 @RF00584 DS 0H 0589 02076000 @DE00516 TM GVSEX(GVSNEPTR),B'10000000' 0589 02077000 BNZ @DL00516 0589 02078000 * END REL3CONV; /* @G24LB04*/ 02079000 B @EL00006 0590 02080000 * 0591 02081000 */* START OF SPECIFICATIONS **** 0591 02082000 * 0591 02083000 * PROCEDURE NAME - SCRATCHG @Y30LB26 02084000 * 0591 02085000 * FUNCTION - TO SCRATCH A GROUP RECORD FROM USERCAT.MSVI DATA SET. 02086000 * BEFORE DOING THIS, THE NUMBER OF GENERAL USE VOLUMES IN THE GROUP, 02087000 * THE NUMBER OF RESTRICTED USE VOLUMES AND THE NUMBER OF INACTIVE 02088000 * VOLUMES MUST ALL BE ZERO. THE PROGRAM WILL NOT ALLOW SYSGROUP TO 02089000 * BE SCRATCHED. THE RPLV IS JOURNALED AFTER THE GROUP RECORD IS 02090000 * SUCCESSFULLY DELETED FROM THE MSVC INVENTORY DATA SET. @Y30LB26 02091000 * 0591 02092000 * INPUTS - REGISTER 1 CONTAINS THE ADDRESS OF THE RPLV WHICH 0591 02093000 * CONTAINS THE REQUEST BLOCK. @Y30LB26 02094000 * 0591 02095000 * OUTPUTS - REASON CODE AND RETURN CODE IN RPLV. @Y30LB26 02096000 * 0591 02097000 * '021C'X TRIED TO SCRATCH A GROUP THAT STILL HAS @Y30LB26 02098000 * VOLUMES ASSIGNED TO IT. @Y30LB26 02099000 * '0226'X CAN NOT SCRATCH SYSGROUP. @Y30LB26 02100000 * PLUS ANY REASON CODES FROM THE I/O PROCESSOR OR THE @Y30LB26 02101000 * JOURNAL PROGRAM. @Y30LB26 02102000 **** END OF SPECIFICATIONS ** */ 02103000 * 0591 02104000 *SCRATCHG: 0591 02105000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 02106000 SCRATCHG ST @14,@SA00007 0591 02107000 * 0592 02108000 * /*****************************************************************/ 02109000 * /* */ 02110000 * /* SET UP ADDRESS TO REQUEST BLOCK #Y30LB26*/ 02111000 * /* */ 02112000 * /*****************************************************************/ 02113000 * 0592 02114000 * SGPPTR=ADDR(RPLVUTIL); /* ADDR REQUEST BLK #Y30LB26*/ 02115000 * 0592 02116000 L @02,RPLVPTR 0592 02117000 LA SGPPTR,RPLVUTIL(,@02) 0592 02118000 * /*****************************************************************/ 02119000 * /* */ 02120000 * /* BE SURE THAT NOT TRYING TO ERASE THE SYSGROUP #Y30LB26*/ 02121000 * /* GROUP, BECAUSE THIS IS NOT ALLOWED. #Y30LB26*/ 02122000 * /* */ 02123000 * /*****************************************************************/ 02124000 * 0593 02125000 * IF SGPGROUP=SYSGROUP THEN /* SYSGROUP ? #Y30LB26*/ 02126000 CLC SGPGROUP(8,SGPPTR),SYSGROUP 0593 02127000 BNE @RF00593 0593 02128000 * DO; /* #Y30LB26*/ 02129000 * RPLVRETC=FOUR; /* BAD RET CODE #Y30LB26*/ 02130000 MVC RPLVRETC(2,@02),@CB00749 0595 02131000 * RPLRCODE=NOSYSGRP; /* INDICATE PROBLEM #Y30LB26*/ 02132000 MVC RPLRCODE(2,@02),@CB00829 0596 02133000 * RETURN; /* #Y30LB26*/ 02134000 @EL00007 DS 0H 0597 02135000 @EF00007 DS 0H 0597 02136000 @ER00007 L @14,@SA00007 0597 02137000 BR @14 0597 02138000 * END; /* #Y30LB26*/ 02139000 * 0598 02140000 * /*****************************************************************/ 02141000 * /* */ 02142000 * /* RESERVE INVENTORY DATA SET #Y30LB26*/ 02143000 * /* */ 02144000 * /*****************************************************************/ 02145000 * 0599 02146000 * CALL RESERINV; /* RESER INVEN #Y30LB26*/ 02147000 @RF00593 BAL @14,RESERINV 0599 02148000 * 0600 02149000 * /*****************************************************************/ 02150000 * /* */ 02151000 * /* READ GROUP RECORD @Y30LB26*/ 02152000 * /* */ 02153000 * /*****************************************************************/ 02154000 * 0600 02155000 * GROUPKY=SGPGROUP; /* GRP NAME IN KEY @Y30LB26*/ 02156000 MVC GROUPKY(8),SGPGROUP(SGPPTR) 0600 02157000 * RPLVKEY=ADDR(GKEY); /* ADDR KEY IN VSAM @Y30LB26*/ 02158000 L @02,RPLVPTR 0601 02159000 LA @15,GKEY 0601 02160000 ST @15,RPLVKEY(,@02) 0601 02161000 * RPLVBUF=ADDR(STORGRP); /* BUFFER ADDRESS @Y30LB26*/ 02162000 LA @15,STORGRP 0602 02163000 ST @15,RPLVBUF(,@02) 0602 02164000 * RPLVBLN=LENGTH(STORGRP); /* LENGTH OF BUFFER @Y30LB26*/ 02165000 MVC RPLVBLN(4,@02),@CF01147 0603 02166000 * RPLVDIR=ON; /* DIRECT READ @Y30LB26*/ 02167000 OI RPLVDIR(@02),B'01000000' 0604 02168000 * RPLVTYP=RPLVREAD; /* READ REC @Y30LB26*/ 02169000 MVI RPLVTYP(@02),X'00' 0605 02170000 * RPLVUPD=ON; /* READ FOR UPDATE @Y30LB26*/ 02171000 OI RPLVUPD(@02),B'00000010' 0606 02172000 * RESPECIFY 0607 02173000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 02174000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 02175000 LR REG1,@02 0608 02176000 * CALL ICBVIO00; /* READ GRP REC @Y30LB26*/ 02177000 L @15,@CV00671 0609 02178000 BALR @14,@15 0609 02179000 * RESPECIFY 0610 02180000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 02181000 * 0611 02182000 * /*****************************************************************/ 02183000 * /* */ 02184000 * /* CHECK RETURN CODES FROM I/O PROCESSOR @Y30LB26*/ 02185000 * /* */ 02186000 * /*****************************************************************/ 02187000 * 0611 02188000 * IF RPLVRETC^=RCZERO /* CK RET CODE @Y30LB26*/ 02189000 * THEN /* @Y30LB26*/ 02190000 * 0611 02191000 L @02,RPLVPTR 0611 02192000 CLC RPLVRETC(2,@02),@CB00747 0611 02193000 BE @RF00611 0611 02194000 * /***************************************************************/ 02195000 * /* */ 02196000 * /* IF BAD, SAVE CODES AND RETURN TO CALLER @Y30LB26*/ 02197000 * /* */ 02198000 * /***************************************************************/ 02199000 * 0612 02200000 * DO; /* @Y30LB26*/ 02201000 * CALL ERREXIT; /* SAVE REASON CODES @Y30LB26*/ 02202000 BAL @14,ERREXIT 0613 02203000 * RETURN; /* @Y30LB26*/ 02204000 B @EL00007 0614 02205000 * END; /* @Y30LB26*/ 02206000 * GROUPPTR=ADDR(STORGRP); /* ADDR GRP REC @Y30LB26*/ 02207000 @RF00611 LA @02,STORGRP 0616 02208000 ST @02,GROUPPTR 0616 02209000 * 0617 02210000 * /*****************************************************************/ 02211000 * /* */ 02212000 * /* CHECK TO SEE IF ANY VOLUMES IN GROUP AT ALL @Y30LB26*/ 02213000 * /* */ 02214000 * /*****************************************************************/ 02215000 * 0617 02216000 * IF GRONGEN^=ZERO|GRONRSTD^=ZERO|GRONINAC^=ZERO/* @Y30LB26*/ 02217000 * THEN /* @Y30LB26*/ 02218000 * 0617 02219000 SLR @15,@15 0617 02220000 CH @15,GRONGEN(,@02) 0617 02221000 BNE @RT00617 0617 02222000 CH @15,GRONRSTD(,@02) 0617 02223000 BNE @RT00617 0617 02224000 CH @15,GRONINAC(,@02) 0617 02225000 BE @RF00617 0617 02226000 @RT00617 DS 0H 0618 02227000 * /***************************************************************/ 02228000 * /* */ 02229000 * /* IF NOT EMPTY, SET REASON, RETURN CODES, RETN @Y30LB26*/ 02230000 * /* */ 02231000 * /***************************************************************/ 02232000 * 0618 02233000 * DO; /* @Y30LB26*/ 02234000 * RPLVRETC=FOUR; /* SET BAD RET CODE @Y30LB26*/ 02235000 L @02,RPLVPTR 0619 02236000 MVC RPLVRETC(2,@02),@CB00749 0619 02237000 * RPLRCODE=NOEMPTY; /* SET REASON CODE @Y30LB26*/ 02238000 MVC RPLRCODE(2,@02),@CB00805 0620 02239000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 02240000 BAL @14,ERREXIT 0621 02241000 * RETURN; /* @Y30LB26*/ 02242000 B @EL00007 0622 02243000 * END; /* @Y30LB26*/ 02244000 * 0624 02245000 * /*****************************************************************/ 02246000 * /* */ 02247000 * /* DELETE GROUP RECORD @Y30LB26*/ 02248000 * /* */ 02249000 * /*****************************************************************/ 02250000 * 0624 02251000 * RPLVTYP=RPLVDEL; /* DELETE GRP REC @Y30LB26*/ 02252000 @RF00617 L @02,RPLVPTR 0624 02253000 MVI RPLVTYP(@02),X'05' 0624 02254000 * RESPECIFY 0625 02255000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 02256000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 02257000 LR REG1,@02 0626 02258000 * CALL ICBVIO00; /* DELETE GROUP REC @Y30LB26*/ 02259000 L @15,@CV00671 0627 02260000 BALR @14,@15 0627 02261000 * RESPECIFY 0628 02262000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 02263000 * 0628 02264000 * /*****************************************************************/ 02265000 * /* */ 02266000 * /* IF UNSUCCESSFUL, SAVE CODES AND RETURN TO CALLER @Y30LB26*/ 02267000 * /* */ 02268000 * /*****************************************************************/ 02269000 * 0629 02270000 * IF RPLVRETC^=RCZERO /* CK RETURN CODE @Y30LB26*/ 02271000 * THEN /* @Y30LB26*/ 02272000 L @02,RPLVPTR 0629 02273000 CLC RPLVRETC(2,@02),@CB00747 0629 02274000 BE @RF00629 0629 02275000 * DO; /* @Y30LB26*/ 02276000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 02277000 BAL @14,ERREXIT 0631 02278000 * RETURN; /* RETURN TO CALLER @Y30LB26*/ 02279000 B @EL00007 0632 02280000 * END; /* @Y30LB26*/ 02281000 * 0633 02282000 * /*****************************************************************/ 02283000 * /* */ 02284000 * /* GO JOURNAL RPLV SINCE GROUP REC WRITTEN @Y30LB26*/ 02285000 * /* */ 02286000 * /*****************************************************************/ 02287000 * 0634 02288000 * CALL JOURNAL; /* JOURNAL RPLV @Y30LB26*/ 02289000 @RF00629 BAL @14,JOURNAL 0634 02290000 * RETURN; /* @Y30LB26*/ 02291000 B @EL00007 0635 02292000 * END SCRATCHG; /* END SCRATCHG INT @Y30LB26*/ 02293000 * 0637 02294000 */* START OF SPECIFICATIONS **** 0637 02295000 * 0637 02296000 * PROCEDURE NAME - REMOVEVR @Y30LB26 02297000 * 0637 02298000 * FUNCTION - TO REMOVE VOLUME RECORD FROM THE USERCAT.MSVI DATA SET. 02299000 * THIS PROGRAM WILL REMOVE EITHER A COPY OR A BASE VOLUME RECORD. A 02300000 * BASE VOLUME RECORD IS NOT REMOVED IF THERE ARE ANY COPIES OF THE 02301000 * VOLUME. ALSO A VOLUME RECORD IS NOT REMOVED IF EITHER CARTRIDGE 02302000 * IS IN THE MSF. THIS IS DETERMINED ONCE BY THE UTILITY 0637 02303000 * BEFORE THE PROGRAM IS CALLED AND THEN IS CHECKED 0637 02304000 * AGAIN IN THE LIB ID FIELD OF THE VOLUME RECORD BY 0637 02305000 * THIS PROGRAM. THE CARTRIDGE INDEX RECORDS ARE SCRATCHED 0637 02306000 * IF THEY EXIST AND BELONG TO THE RIGHT VOLUME. IF THE CARTRIDGES 02307000 * HAVE SINCE BEEN ASSIGNED TO ANOTHER VOLUME, THE CARTRIDGE 0637 02308000 * INDEX RECORDS ARE NOT SCRATCHED AND NO ERROR 0637 02309000 * CONDITION WILL OCCUR. THE NEXT FUNCTION PREFORMED 0637 02310000 * IS REMOVAL OF THE VOLUME RECORD. IF THE VOLUME RECORD WAS A BASE 02311000 * VOLUME RECORD A CHECK IS MADE TO SEE IF THERE IS A DUPLICATE 0637 02312000 * VOLUME RECORD. IF ANY EXIST, THE OLDEST DUPLICATE BECOMES THE NEW 02313000 * BASE VOLUME RECORD WITH THE SAME KEY AS THE DELETED BASE VOLUME 02314000 * RECORD. THE RPLV IS JOURNALED AFTER THE FIRST SUCCESSFUL UPDATE 02315000 * OF THE MSS VOLUME INVENTORY. @Y30LB26 02316000 * 0637 02317000 * INPUT - REGISTER 1 HAS THE ADDRESS OF THE RPLV. THE RPLV 0637 02318000 * CONTAINS ALL INFORMATION NEEDED TO REMOVE THE PROPER RECORD FROM 02319000 * USERCAT.MSVI DATA SET. @Y30LB26 02320000 * 0637 02321000 * OUTPUT - REASON CODE AND CONDITION CODE RETURNED IN THE RPLV. 02322000 * @Y30LB26 02323000 * 0637 02324000 * '0219'X COPY OR BASE WAS NOT SPECIFIED. @Y30LB26 02325000 * '0216'X TRYING TO REMOVE BASE RECORD THAT HAS COPIES. @Y30LB26 02326000 * '021A'X CARTRIDGES ARE IN LIBRARY @Y30LB26 02327000 * '021B'X I/O ERROR OCCURED BUT RPLV WAS JOURNALED. @Y30LB26 02328000 * PLUS ANY RETURNS FROM THE I/O PROCESSOR OR THE @Y30LB26 02329000 * JOURNAL PROGRAM. @Y30LB26 02330000 **** END OF SPECIFICATIONS ** */ 02331000 * 0637 02332000 *REMOVEVR: 0637 02333000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 02334000 REMOVEVR ST @14,@SA00008 0637 02335000 * DUPFNDFL=OFF; /* INIT DUP FND FLAG @Y30LB26*/ 02336000 * BACKUPFL=OFF; /* INIT BACKUP FLAG @Y30LB26*/ 02337000 NI DUPFNDFL,B'11001111' 0639 02338000 * 0640 02339000 * /*****************************************************************/ 02340000 * /* */ 02341000 * /* RESERVE INVENTORY DATA SET @Y30LB26*/ 02342000 * /* */ 02343000 * /*****************************************************************/ 02344000 * 0640 02345000 * CALL RESERINV; /* RESERVE INVENTORY @Y30LB26*/ 02346000 * 0640 02347000 BAL @14,RESERINV 0640 02348000 * /*****************************************************************/ 02349000 * /* */ 02350000 * /* SET UP ADDRESS TO REQUEST BLK @Y30LB26*/ 02351000 * /* */ 02352000 * /*****************************************************************/ 02353000 * 0641 02354000 * RVRPTR=ADDR(RPLVUTIL); /* ADDR REQUEST BLK @Y30LB26*/ 02355000 L @02,RPLVPTR 0641 02356000 LA @02,RPLVUTIL(,@02) 0641 02357000 ST @02,RVRPTR 0641 02358000 * VOLKY=RVRVOLID; /* VOL NAME BE REMOVED @Y30LB26*/ 02359000 * 0642 02360000 MVC VOLKY(6),RVRVOLID(@02) 0642 02361000 * /*****************************************************************/ 02362000 * /* */ 02363000 * /* CHECK IF BASE VOLUME IS TO BE REMOVED @Y30LB26*/ 02364000 * /* */ 02365000 * /*****************************************************************/ 02366000 * 0643 02367000 * IF RVRBASEV=ON /* REMOVE BASE ? @Y30LB26*/ 02368000 * THEN /* @Y30LB26*/ 02369000 * 0643 02370000 TM RVRBASEV(@02),B'10000000' 0643 02371000 BNO @RF00643 0643 02372000 * /***************************************************************/ 02373000 * /* */ 02374000 * /* CALL SUBROUTINE TO REMOVE BASE VOL RECORD @Y30LB26*/ 02375000 * /* */ 02376000 * /***************************************************************/ 02377000 * 0644 02378000 * DO; /* @Y30LB26*/ 02379000 * CALL REMOVBAS; /* GO REMOVE BASE VOL @Y30LB26*/ 02380000 BAL @14,REMOVBAS 0645 02381000 * RETURN; /* @Y30LB26*/ 02382000 @EL00008 DS 0H 0646 02383000 @EF00008 DS 0H 0646 02384000 @ER00008 L @14,@SA00008 0646 02385000 BR @14 0646 02386000 * END; /* @Y30LB26*/ 02387000 * 0648 02388000 * /*****************************************************************/ 02389000 * /* */ 02390000 * /* CHECK IF COPY VOLUME IS TO BE REMOVED @Y30LB26*/ 02391000 * /* */ 02392000 * /*****************************************************************/ 02393000 * 0648 02394000 * IF RVRCOPYV=ON /* REMOVE COPY VOL ? @Y30LB26*/ 02395000 * THEN /* @Y30LB26*/ 02396000 * 0648 02397000 @RF00643 L @02,RVRPTR 0648 02398000 TM RVRCOPYV(@02),B'01000000' 0648 02399000 BNO @RF00648 0648 02400000 * /***************************************************************/ 02401000 * /* */ 02402000 * /* CALL SUBROUTINE TO REMOVE COPY VOL RECORD @Y30LB26*/ 02403000 * /* */ 02404000 * /***************************************************************/ 02405000 * 0649 02406000 * DO; /* @Y30LB26*/ 02407000 * CALL REMOVCPY; /* GO REMOVE COPY REC @Y30LB26*/ 02408000 BAL @14,REMOVCPY 0650 02409000 * RETURN; /* RETURN TO CALLER @Y30LB26*/ 02410000 B @EL00008 0651 02411000 * END; /* @Y30LB26*/ 02412000 * ELSE /* @Y30LB26*/ 02413000 * 0653 02414000 * /***************************************************************/ 02415000 * /* */ 02416000 * /* IF NOT ONE OF THESE TWO AN ERROR EXISTS @Y30LB26*/ 02417000 * /* SET REASON AND RETURN CODES AND RETURN. @Y30LB26*/ 02418000 * /* */ 02419000 * /***************************************************************/ 02420000 * 0653 02421000 * DO; /* @Y30LB26*/ 02422000 @RF00648 DS 0H 0654 02423000 * RPLVRETC=FOUR; /* SET BAD RETURN CODE @Y30LB26*/ 02424000 L @02,RPLVPTR 0654 02425000 MVC RPLVRETC(2,@02),@CB00749 0654 02426000 * RPLRCODE=REQBLKER; /* TYPE REC NOT SPEC @Y30LB26*/ 02427000 MVC RPLRCODE(2,@02),@CB00797 0655 02428000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 02429000 BAL @14,ERREXIT 0656 02430000 * RETURN; /* RETURN TO MAIN PROC @Y30LB26*/ 02431000 B @EL00008 0657 02432000 * END; /* @Y30LB26*/ 02433000 * END REMOVEVR; /* @Y30LB26*/ 02434000 * 0660 02435000 * /*****************************************************************/ 02436000 * /* */ 02437000 * /* SUBROUTINE WHICH REMOVES A BASE VOLUME RECORD @Y30LB26*/ 02438000 * /* AND UPDATES ANY GROUP AND CARTRIDGE RECORDS @Y30LB26*/ 02439000 * /* */ 02440000 * /*****************************************************************/ 02441000 * 0660 02442000 *REMOVBAS: 0660 02443000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 02444000 * 0660 02445000 REMOVBAS ST @14,@SA00009 0660 02446000 * /*****************************************************************/ 02447000 * /* */ 02448000 * /* READ BASE VOLUME RECORD @Y30LB26*/ 02449000 * /* */ 02450000 * /*****************************************************************/ 02451000 * 0661 02452000 * RPLVKEY=ADDR(VKEY); /* GET ADDR OF KEY @Y30LB26*/ 02453000 L @02,RPLVPTR 0661 02454000 LA @15,VKEY 0661 02455000 ST @15,RPLVKEY(,@02) 0661 02456000 * RPLVBUF=ADDR(STORBASE); /* ADDR OF BUFFER @Y30LB26*/ 02457000 LA @15,STORBASE 0662 02458000 ST @15,RPLVBUF(,@02) 0662 02459000 * RPLVBLN=LENGTH(STORBASE); /* LENGTH BUFFER @Y30LB26*/ 02460000 MVC RPLVBLN(4,@02),@CF01147 0663 02461000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 02462000 OI RPLVDIR(@02),B'01000000' 0664 02463000 * RPLVTYP=RPLVREAD; /* READ REC @Y30LB26*/ 02464000 MVI RPLVTYP(@02),X'00' 0665 02465000 * RESPECIFY 0666 02466000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 02467000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 02468000 LR REG1,@02 0667 02469000 * CALL ICBVIO00; /* READ BASE VOL REC @Y30LB26*/ 02470000 L @15,@CV00671 0668 02471000 BALR @14,@15 0668 02472000 * RESPECIFY 0669 02473000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 02474000 * 0669 02475000 * /*****************************************************************/ 02476000 * /* */ 02477000 * /* IF BAD RETURN CODE, SAVE REASON CODES AND RETURN @Y30LB26*/ 02478000 * /* */ 02479000 * /*****************************************************************/ 02480000 * 0670 02481000 * IF RPLVRETC^=RCZERO /* CK RETURN CODE @Y30LB26*/ 02482000 * THEN /* @Y30LB26*/ 02483000 L @02,RPLVPTR 0670 02484000 CLC RPLVRETC(2,@02),@CB00747 0670 02485000 BE @RF00670 0670 02486000 * DO; /* @Y30LB26*/ 02487000 * CALL ERREXIT; /* SAVE RETURN CODES @Y30LB26*/ 02488000 BAL @14,ERREXIT 0672 02489000 * RETURN; /* @Y30LB26*/ 02490000 @EL00009 DS 0H 0673 02491000 @EF00009 DS 0H 0673 02492000 @ER00009 L @14,@SA00009 0673 02493000 BR @14 0673 02494000 * END; /* @Y30LB26*/ 02495000 * BASEVPTR=ADDR(STORBASE); /* GET ADDR BASE REC @Y30LB26*/ 02496000 @RF00670 LA @02,STORBASE 0675 02497000 ST @02,BASEVPTR 0675 02498000 * 0676 02499000 * /*****************************************************************/ 02500000 * /* */ 02501000 * /* CHECK TO SEE IF BASE VOL HAS COPIES @Y30LB26*/ 02502000 * /* AND NOT A PLACE HOLDER @ZDR2053*/ 02503000 * /* */ 02504000 * /*****************************************************************/ 02505000 * 0676 02506000 * IF BASNCOPY^=ZERO&BASHOLD=OFF /* BASE HAVE COPIES & @ZDR2053*/ 02507000 * THEN /* NOT A PLACE HOLDER @ZDR2053*/ 02508000 * 0676 02509000 CLI BASNCOPY(@02),0 0676 02510000 BE @RF00676 0676 02511000 TM BASHOLD(@02),B'10000000' 0676 02512000 BNZ @RF00676 0676 02513000 * /***************************************************************/ 02514000 * /* */ 02515000 * /* IF COPIES EXIST, SET REASON CODE AND RETURN @Y30LB26*/ 02516000 * /* */ 02517000 * /***************************************************************/ 02518000 * 0677 02519000 * DO; /* @Y30LB26*/ 02520000 * RPLVRETC=FOUR; /* SET BAD RETURN CODE @Y30LB26*/ 02521000 L @02,RPLVPTR 0678 02522000 MVC RPLVRETC(2,@02),@CB00749 0678 02523000 * RPLRCODE=BASCPYER; /* INDICATE COPIES @Y30LB26*/ 02524000 MVC RPLRCODE(2,@02),@CB00795 0679 02525000 * CALL ERREXIT; /* SAVE RETURN CODES @Y30LB26*/ 02526000 BAL @14,ERREXIT 0680 02527000 * RETURN; /* @Y30LB26*/ 02528000 B @EL00009 0681 02529000 * END; /* @Y30LB26*/ 02530000 * ELSE /* @Y30LB26*/ 02531000 * 0683 02532000 * /***************************************************************/ 02533000 * /* */ 02534000 * /* GO REMOVE BASE VOLUME RECORD @Y30LB26*/ 02535000 * /* */ 02536000 * /***************************************************************/ 02537000 * 0683 02538000 * DO; /* @Y30LB26*/ 02539000 @RF00676 DS 0H 0684 02540000 * CALL DELEVOL; /* GO DELE VOL REC @Y30LB26*/ 02541000 BAL @14,DELEVOL 0684 02542000 * 0685 02543000 * /*************************************************************/ 02544000 * /* */ 02545000 * /* IF BAD RETURN CODE, INVENTORY IS ALREADY @Y30LB26*/ 02546000 * /* RELEASED, SO JUST RETURN. @Y30LB26*/ 02547000 * /* */ 02548000 * /*************************************************************/ 02549000 * 0685 02550000 * IF RPLVRETC^=RCZERO /* RECORD DELETED OK ? @Y30LB26*/ 02551000 * THEN 0685 02552000 L @02,RPLVPTR 0685 02553000 CLC RPLVRETC(2,@02),@CB00747 0685 02554000 BNE @RT00685 0685 02555000 * RETURN; /* @Y30LB26*/ 02556000 * END; /* @Y30LB26*/ 02557000 * 0688 02558000 * /*****************************************************************/ 02559000 * /* */ 02560000 * /* READ FOR A DUPLICATE OF VOLUME JUST ERASED @Y30LB26*/ 02561000 * /* */ 02562000 * /*****************************************************************/ 02563000 * 0688 02564000 * DVOLKY=RVRVOLID; /* REMOVED VOL NAME @Y30LB26*/ 02565000 L @01,RVRPTR 0688 02566000 MVC DVOLKY(6),RVRVOLID(@01) 0688 02567000 * RPLVKEY=ADDR(DKEY); /* GET ADDR OF KEY @Y30LB26*/ 02568000 LA @15,DKEY 0689 02569000 ST @15,RPLVKEY(,@02) 0689 02570000 * RPLVBUF=ADDR(STORDUP); /* ADDR OF BUFFER @Y30LB26*/ 02571000 LA @15,STORDUP 0690 02572000 ST @15,RPLVBUF(,@02) 0690 02573000 * RPLVBLN=LENGTH(STORDUP); /* LENGTH OF BUFFER @Y30LB26*/ 02574000 MVC RPLVBLN(4,@02),@CF01147 0691 02575000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 02576000 OI RPLVDIR(@02),B'01000000' 0692 02577000 * RPLVTYP=RPLVREAD; /* READ RECORD @Y30LB26*/ 02578000 MVI RPLVTYP(@02),X'00' 0693 02579000 * RPLVKGE=ON; /* READ FOR > OR = @Y30LB26*/ 02580000 OI RPLVKGE(@02),B'00000100' 0694 02581000 * RPLVUPD=ON; /* READ FOR UPDATE @Y30LB26*/ 02582000 OI RPLVUPD(@02),B'00000010' 0695 02583000 * RESPECIFY 0696 02584000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 02585000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 02586000 LR REG1,@02 0697 02587000 * CALL ICBVIO00; /* READ FOR DUP REC @Y30LB26*/ 02588000 L @15,@CV00671 0698 02589000 BALR @14,@15 0698 02590000 * RESPECIFY 0699 02591000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 02592000 * 0699 02593000 * /*****************************************************************/ 02594000 * /* */ 02595000 * /* CK FOR BAD RETURN CODE @Y30LB26*/ 02596000 * /* */ 02597000 * /*****************************************************************/ 02598000 * 0700 02599000 * IF RPLVRETC^=RCZERO /* CHECK RET CODE @Y30LB26*/ 02600000 * THEN /* @Y30LB26*/ 02601000 L @02,RPLVPTR 0700 02602000 CLC RPLVRETC(2,@02),@CB00747 0700 02603000 BE @RF00700 0700 02604000 * DO; /* @Y30LB26*/ 02605000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 02606000 BAL @14,ERREXIT 0702 02607000 * RETURN; /* @Y30LB26*/ 02608000 B @EL00009 0703 02609000 * END; /* @Y30LB26*/ 02610000 * DUPVPTR=ADDR(STORDUP); /* PTR TO DUP REC @Y30LB26*/ 02611000 * 0705 02612000 @RF00700 LA @02,STORDUP 0705 02613000 ST @02,DUPVPTR 0705 02614000 * /*****************************************************************/ 02615000 * /* */ 02616000 * /* CHECK THAT IT IS A DUP AND FOR CORRECT VOL @Y30LB26*/ 02617000 * /* */ 02618000 * /*****************************************************************/ 02619000 * 0706 02620000 * IF DUPD=DKY&DUPSERNO=RVRVOLID /* CK DUP, CORRECT VOL @Y30LB26*/ 02621000 * THEN /* @Y30LB26*/ 02622000 CLC DUPD(5,@02),DKY 0706 02623000 BNE @RF00706 0706 02624000 L @01,RVRPTR 0706 02625000 CLC DUPSERNO(6,@02),RVRVOLID(@01) 0706 02626000 BNE @RF00706 0706 02627000 * DO; /* @Y30LB26*/ 02628000 * 0707 02629000 * /*************************************************************/ 02630000 * /* */ 02631000 * /* IF DUP FOUND, CHECK IF OLD BASE WAS GROUPED @Y30LB26*/ 02632000 * /* OR NOT A PLACE HOLDER @ZDR2053*/ 02633000 * /* */ 02634000 * /*************************************************************/ 02635000 * 0708 02636000 * DUPFNDFL=ON; /* DUPLICATE FOUND @Y30LB26*/ 02637000 OI DUPFNDFL,B'00010000' 0708 02638000 * IF BASGRPV=OFF&BASHOLD=OFF THEN/* NOT GROUPED @ZDR2053 02639000 * OR A PLACE HOLDER @ZDR2053*/ 02640000 L @02,BASEVPTR 0709 02641000 TM BASGRPV(@02),B'00100000' 0709 02642000 BNZ @RF00709 0709 02643000 TM BASHOLD(@02),B'10000000' 0709 02644000 BNZ @RF00709 0709 02645000 * DO; /* @Y30LB26*/ 02646000 * 0710 02647000 * /*********************************************************/ 02648000 * /* */ 02649000 * /* IF OLD RECORD NON-GROUPED, SET FLAG SO IT @Y30LB26*/ 02650000 * /* WONT BE CHAINED INTO NON-GROUPED AGAIN @Y30LB26*/ 02651000 * /* */ 02652000 * /*********************************************************/ 02653000 * 0711 02654000 * DUPBCHI=OFF; /* DONT CHAIN IN NON-GRP @Y30LB26*/ 02655000 * 0711 02656000 NI DUPBCHI,B'01111111' 0711 02657000 * /*********************************************************/ 02658000 * /* */ 02659000 * /* SET INFORMATION NEEDED TO MAKE NEW @Y30LB26*/ 02660000 * /* BASE RECORD FIT IN NON-GROUPED WITHOUT @Y30LB26*/ 02661000 * /* ACTUALLY BEING CHAIN IN @Y30LB26*/ 02662000 * /* */ 02663000 * /*********************************************************/ 02664000 * 0712 02665000 * SAVEPREV=BASPREV; /* SAVE PREV CHAIN @Y30LB26*/ 02666000 MVC SAVEPREV(6),BASPREV(@02) 0712 02667000 * SAVENEXT=BASNEXTV; /* SAVE NEXT CHAIN @Y30LB26*/ 02668000 MVC SAVENEXT(6),BASNEXTV(@02) 0713 02669000 * IF BASFIRST=ON THEN /* 1ST IN CHAIN @Y30LB26*/ 02670000 TM BASFIRST(@02),B'00010000' 0714 02671000 BNO @RF00714 0714 02672000 * FCHNDBR=ON; /* INDICATE FIRST @Y30LB26*/ 02673000 OI FCHNDBR,B'01000000' 0715 02674000 * IF BASLAST=ON THEN /* LAST IN CHAIN @Y30LB26*/ 02675000 @RF00714 L @02,BASEVPTR 0716 02676000 TM BASLAST(@02),B'00001000' 0716 02677000 BNO @RF00716 0716 02678000 * LCHNDBR=ON; /* INDICATE LAST @Y30LB26*/ 02679000 OI LCHNDBR,B'00100000' 0717 02680000 * END; /* @Y30LB26*/ 02681000 * 0718 02682000 * /*************************************************************/ 02683000 * /* */ 02684000 * /* IF WAS GROUPED BEFORE, SET FLAG SO IT @Y30LB26*/ 02685000 * /* WILL BE CHAINED INTO NON-GROUPED @Y30LB26*/ 02686000 * /* */ 02687000 * /*************************************************************/ 02688000 * 0719 02689000 * ELSE /* @Y30LB26*/ 02690000 * DUPBCHI=ON; /* CHIAN IN NON-GRP @Y30LB26*/ 02691000 B @RC00709 0719 02692000 @RF00709 OI DUPBCHI,B'10000000' 0719 02693000 * END; /* @Y30LB26*/ 02694000 @RC00709 DS 0H 0721 02695000 * 0721 02696000 * /*****************************************************************/ 02697000 * /* */ 02698000 * /* CHECK FOR A PLACE HOLDER @ZDR2053*/ 02699000 * /* */ 02700000 * /*****************************************************************/ 02701000 * 0721 02702000 * IF BASHOLD=OFF THEN 0721 02703000 @RF00706 L @02,BASEVPTR 0721 02704000 TM BASHOLD(@02),B'10000000' 0721 02705000 BNZ @RF00721 0721 02706000 * DO; /* @ZDR2053*/ 02707000 * 0722 02708000 * /*************************************************************/ 02709000 * /* */ 02710000 * /* IF GROUPED RECORD GO PROCESS BASE OUT OF GROUP @Y30LB26*/ 02711000 * /* */ 02712000 * /*************************************************************/ 02713000 * 0723 02714000 * IF BASGRPV=ON THEN /* THIS GROUPED RECORD @Y30LB26*/ 02715000 TM BASGRPV(@02),B'00100000' 0723 02716000 BNO @RF00723 0723 02717000 * DO; /* @Y30LB26*/ 02718000 * CALL PROCGRP; /* GO UPDATE GRP REC @Y30LB26*/ 02719000 * 0725 02720000 BAL @14,PROCGRP 0725 02721000 * /*********************************************************/ 02722000 * /* */ 02723000 * /* CHECK RETURN FROM PROCGRP ROUTINE @Y30LB26*/ 02724000 * /* */ 02725000 * /*********************************************************/ 02726000 * 0726 02727000 * IF RPLRCODE^=RCZERO THEN/* CK RETURN @Y30LB26*/ 02728000 L @02,RPLVPTR 0726 02729000 CLC RPLRCODE(2,@02),@CB00747 0726 02730000 BNE @RT00726 0726 02731000 * RETURN; /* @Y30LB26*/ 02732000 * END; /* @Y30LB26*/ 02733000 * ELSE /* @Y30LB26*/ 02734000 * DO; /* @Y30LB26*/ 02735000 * 0729 02736000 B @RC00723 0729 02737000 @RF00723 DS 0H 0730 02738000 * /*********************************************************/ 02739000 * /* */ 02740000 * /* IF DUP NOT FOUND, CHAIN OUT OF NON-GROUPED @Y30LB26*/ 02741000 * /* */ 02742000 * /*********************************************************/ 02743000 * 0730 02744000 * IF DUPFNDFL=OFF /* SEE IF DUP FOUND @Y30LB26*/ 02745000 * THEN /* @Y30LB26*/ 02746000 TM DUPFNDFL,B'00010000' 0730 02747000 BNZ @RF00730 0730 02748000 * DO; /* @Y30LB26*/ 02749000 * CHICHOGP=OFF; /* INDICATE NON-GRPED @Y30LB26*/ 02750000 NI CHICHOGP,B'11101111' 0732 02751000 * CALL ICBVUCHO(0,BASEVPTR,/* @Y30LB26*/ 02752000 * RPLVPTR,PASSFLAG);/* CHAIN OUT NON-GRP @Y30LB26*/ 02753000 L @15,@CV00675 0733 02754000 LA @01,@AL00733 0733 02755000 BALR @14,@15 0733 02756000 * IF RPLVRETC^=RCZERO /* CK RET CODE @Y30LB26*/ 02757000 * THEN /* @Y30LB26*/ 02758000 L @02,RPLVPTR 0734 02759000 CLC RPLVRETC(2,@02),@CB00747 0734 02760000 BE @RF00734 0734 02761000 * DO; /* @Y30LB26*/ 02762000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 02763000 BAL @14,ERREXIT 0736 02764000 * RETURN; /* @Y30LB26*/ 02765000 B @EL00009 0737 02766000 * END; /* @Y30LB26*/ 02767000 * END; /* @Y30LB26*/ 02768000 @RF00734 DS 0H 0740 02769000 * END; /* @Y30LB26*/ 02770000 @RF00730 DS 0H 0741 02771000 * END; /* @ZDR2053*/ 02772000 @RC00723 DS 0H 0742 02773000 * 0742 02774000 * /*****************************************************************/ 02775000 * /* */ 02776000 * /* IF DUPLICATE FOUND, CONVERT IT TO BASE @Y30LB26*/ 02777000 * /* */ 02778000 * /*****************************************************************/ 02779000 * 0742 02780000 * IF DUPFNDFL=ON THEN /* DUP REC FOUND @Y30LB26*/ 02781000 @RF00721 TM DUPFNDFL,B'00010000' 0742 02782000 BNO @RF00742 0742 02783000 * DO; /* @Y30LB26*/ 02784000 * CALL VUDBR; /* DUP TO BASE ROUTN @Y30LB26*/ 02785000 * 0744 02786000 BAL @14,VUDBR 0744 02787000 * /*************************************************************/ 02788000 * /* */ 02789000 * /* CK RETURN CODE @Y30LB26*/ 02790000 * /* */ 02791000 * /*************************************************************/ 02792000 * 0745 02793000 * IF RPLVRETC^=RCZERO THEN /* CK RET CODE @Y30LB26*/ 02794000 L @02,RPLVPTR 0745 02795000 CLC RPLVRETC(2,@02),@CB00747 0745 02796000 BE @RF00745 0745 02797000 * DO; /* @Y30LB26*/ 02798000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 02799000 BAL @14,ERREXIT 0747 02800000 * RETURN; /* @Y30LB26*/ 02801000 B @EL00009 0748 02802000 * END; /* @Y30LB26*/ 02803000 * 0749 02804000 * /*************************************************************/ 02805000 * /* */ 02806000 * /* SEE IF CHAINING INTO NON-GROUP CHAIN IS @Y30LB26*/ 02807000 * /* NECESSARY @Y30LB26*/ 02808000 * /* */ 02809000 * /*************************************************************/ 02810000 * 0750 02811000 * IF DUPBCHI=ON THEN /* CHAIN IN NEW BASE @Y30LB26*/ 02812000 @RF00745 TM DUPBCHI,B'10000000' 0750 02813000 BNO @RF00750 0750 02814000 * DO; /* @Y30LB26*/ 02815000 * CHICHOGP=OFF; /* INDICATE NON-GROUPED @Y30LB26*/ 02816000 NI CHICHOGP,B'11101111' 0752 02817000 * CALL ICBVUCHI(0,BASEVPTR,RPLVPTR,/* @Y30LB26*/ 02818000 * PASSFLAG); /* @Y30LB26*/ 02819000 L @15,@CV00674 0753 02820000 LA @01,@AL00753 0753 02821000 BALR @14,@15 0753 02822000 * IF RPLVRETC^=RCZERO THEN/* @Y30LB26*/ 02823000 L @02,RPLVPTR 0754 02824000 CLC RPLVRETC(2,@02),@CB00747 0754 02825000 BE @RF00754 0754 02826000 * DO; /* @Y30LB26*/ 02827000 * CALL ERREXIT; /* #Y30LB26*/ 02828000 BAL @14,ERREXIT 0756 02829000 * RETURN; /* #Y30LB26*/ 02830000 B @EL00009 0757 02831000 * END; /* #Y30LB26*/ 02832000 * END; /* #Y30LB26*/ 02833000 * 0759 02834000 @RF00754 DS 0H 0760 02835000 * /*************************************************************/ 02836000 * /* */ 02837000 * /* WRITE CREATED BASE VOLUME RECORD #Y30LB26*/ 02838000 * /* */ 02839000 * /*************************************************************/ 02840000 * 0760 02841000 * RPLVBUF=ADDR(BASEREC); /* BUFFER ADDRESS #Y30LB26*/ 02842000 @RF00750 L @02,RPLVPTR 0760 02843000 LA @15,BASEREC 0760 02844000 ST @15,RPLVBUF(,@02) 0760 02845000 * RPLVRLN=LENGTH(BASEV); /* LENGTH RECORD #Y30LB26*/ 02846000 LA @15,224 0761 02847000 ST @15,RPLVRLN(,@02) 0761 02848000 * RPLVBLN=LENGTH(BASEV); /* LENGTH BUFFER @Y30LB26*/ 02849000 ST @15,RPLVBLN(,@02) 0762 02850000 * RPLVLOC=OFF; /* NO LOCATE @Y30LB26*/ 02851000 NI RPLVLOC(@02),B'01111111' 0763 02852000 * RPLVTYP=RPLVPUT; /* WRITE RECORD @Y30LB26*/ 02853000 MVI RPLVTYP(@02),X'01' 0764 02854000 * RPLVUPD=OFF; /* NO UPDATE @Y30LB26*/ 02855000 NI RPLVUPD(@02),B'11111101' 0765 02856000 * RESPECIFY 0766 02857000 * REG1 RSTD; /* RESTRICT @Y30LB26*/ 02858000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 02859000 LR REG1,@02 0767 02860000 * CALL ICBVIO00; /* WRITE BASE VOL REC @Y30LB26*/ 02861000 L @15,@CV00671 0768 02862000 BALR @14,@15 0768 02863000 * RESPECIFY 0769 02864000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 02865000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @Y30LB26*/ 02866000 L @02,RPLVPTR 0770 02867000 CLC RPLVRETC(2,@02),@CB00747 0770 02868000 BE @RF00770 0770 02869000 * DO; /* @Y30LB26*/ 02870000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 02871000 BAL @14,ERREXIT 0772 02872000 * RETURN; /* @Y30LB26*/ 02873000 B @EL00009 0773 02874000 * END; /* @Y30LB26*/ 02875000 * END; /* @Y30LB26*/ 02876000 * RETURN; /* @Y30LB26*/ 02877000 B @EL00009 0776 02878000 * END REMOVBAS; /* END BASE ROUTINE @Y30LB26*/ 02879000 B @EL00009 0777 02880000 * 0778 02881000 * /*****************************************************************/ 02882000 * /* */ 02883000 * /* THIS ROUTINE REMOVES THE VOLUME RECORD(BASE OR COPY) @Y30LB26*/ 02884000 * /* AND TAKES CARE OF THE INDEX RECORDS @Y30LB26*/ 02885000 * /* */ 02886000 * /*****************************************************************/ 02887000 * 0778 02888000 *DELEVOL: 0778 02889000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 02890000 DELEVOL ST @14,@SA00010 0778 02891000 * 0779 02892000 * /*****************************************************************/ 02893000 * /* */ 02894000 * /* CALL ROUTINE TO SEE IF CARTRIDGE INDEX RECORDS ARE @Y30LB26*/ 02895000 * /* IN LIBRARY AND IF THEY ARE AND BELONG TO @Y30LB26*/ 02896000 * /* THE RIGHT VOLUME, ERASE THEM...... @Y30LB26*/ 02897000 * /* NOT DONE FOR PLACE HOLDERS BECAUSE THEY HAVE NO @ZDR2053*/ 02898000 * /* CARTRIDGE INDEX RECORDS @ZDR2053*/ 02899000 * /* */ 02900000 * /*****************************************************************/ 02901000 * 0779 02902000 * IF RVRBASEV=ON THEN 0779 02903000 L @02,RVRPTR 0779 02904000 TM RVRBASEV(@02),B'10000000' 0779 02905000 BNO @RF00779 0779 02906000 * BCDVPTR=BASEVPTR; /* BASE RECORD @ZA16139*/ 02907000 L BCDVPTR,BASEVPTR 0780 02908000 * ELSE /* @ZA16139*/ 02909000 * BCDVPTR=COPYVPTR; /* COPY RECORD @ZA16139*/ 02910000 B @RC00779 0781 02911000 @RF00779 L BCDVPTR,COPYVPTR 0781 02912000 * IF BCDHOLD=ON THEN /* @ZA16139*/ 02913000 @RC00779 TM BCDHOLD(BCDVPTR),B'10000000' 0782 02914000 BO @RT00782 0782 02915000 * ; /* @ZDR2053*/ 02916000 * ELSE 0784 02917000 * DO; /* @ZDR2053*/ 02918000 * CALL CHKCART; /* SEE IF CART IN LIB @Y30LB26*/ 02919000 BAL @14,CHKCART 0785 02920000 * IF RPLVRETC^=RCZERO THEN /* CHK CART OK @Y30LB26*/ 02921000 L @02,RPLVPTR 0786 02922000 CLC RPLVRETC(2,@02),@CB00747 0786 02923000 BNE @RT00786 0786 02924000 * RETURN; /* @Y30LB26*/ 02925000 * END; /* @ZDR2053*/ 02926000 * 0789 02927000 * /*****************************************************************/ 02928000 * /* */ 02929000 * /* READ BASE OR COPY RECORD TO BE DELETED @Y30LB26*/ 02930000 * /* FOR UPDATE SO IT CAN BE DELETED @Y30LB26*/ 02931000 * /* */ 02932000 * /*****************************************************************/ 02933000 * 0789 02934000 * RPLVKEY=ADDR(VKEY); /* ADDR KEY FOR VOL @Y30LB26*/ 02935000 @RT00782 L @02,RPLVPTR 0789 02936000 LA @15,VKEY 0789 02937000 ST @15,RPLVKEY(,@02) 0789 02938000 * RPLVBUF=ADDR(STORBASE); /* BUFFER ADDR @Y30LB26*/ 02939000 LA @15,STORBASE 0790 02940000 ST @15,RPLVBUF(,@02) 0790 02941000 * RPLVBLN=LENGTH(STORBASE); /* BUFFER LENGTH @Y30LB26*/ 02942000 MVC RPLVBLN(4,@02),@CF01147 0791 02943000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 02944000 OI RPLVDIR(@02),B'01000000' 0792 02945000 * RPLVTYP=RPLVREAD; /* READ RECORD @Y30LB26*/ 02946000 MVI RPLVTYP(@02),X'00' 0793 02947000 * RPLVUPD=ON; /* FOR UPDATE @Y30LB26*/ 02948000 OI RPLVUPD(@02),B'00000010' 0794 02949000 * RESPECIFY 0795 02950000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 02951000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 02952000 LR REG1,@02 0796 02953000 * CALL ICBVIO00; /* READ VOL FOR UPDATE @Y30LB26*/ 02954000 L @15,@CV00671 0797 02955000 BALR @14,@15 0797 02956000 * RESPECIFY 0798 02957000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 02958000 * 0798 02959000 * /*****************************************************************/ 02960000 * /* */ 02961000 * /* CHECK RETURN FROM READING VOL RECORD @Y30LB26*/ 02962000 * /* */ 02963000 * /*****************************************************************/ 02964000 * 0799 02965000 * IF RPLVRETC^=RCZERO /* CK RET CODES @Y30LB26*/ 02966000 * THEN /* @Y30LB26*/ 02967000 L @02,RPLVPTR 0799 02968000 CLC RPLVRETC(2,@02),@CB00747 0799 02969000 BE @RF00799 0799 02970000 * DO; /* @Y30LB26*/ 02971000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 02972000 BAL @14,ERREXIT 0801 02973000 * RETURN; /* @Y30LB26*/ 02974000 @EL00010 DS 0H 0802 02975000 @EF00010 DS 0H 0802 02976000 @ER00010 L @14,@SA00010 0802 02977000 BR @14 0802 02978000 * END; /* @Y30LB26*/ 02979000 * 0804 02980000 * /*****************************************************************/ 02981000 * /* */ 02982000 * /* DELETE VOL RECORD (BASE OR COPY RECORD) @Y30LB26*/ 02983000 * /* */ 02984000 * /*****************************************************************/ 02985000 * 0804 02986000 * RPLVTYP=RPLVDEL; /* DELETE RECORD @Y30LB26*/ 02987000 @RF00799 L @02,RPLVPTR 0804 02988000 MVI RPLVTYP(@02),X'05' 0804 02989000 * RESPECIFY 0805 02990000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 02991000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 02992000 LR REG1,@02 0806 02993000 * CALL ICBVIO00; /* DELETE VOL REC @Y30LB26*/ 02994000 L @15,@CV00671 0807 02995000 BALR @14,@15 0807 02996000 * RESPECIFY 0808 02997000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 02998000 * IF RPLVRETC^=RCZERO /* DELETED OK ? @Y30LB26*/ 02999000 * THEN /* @Y30LB26*/ 03000000 L @02,RPLVPTR 0809 03001000 CLC RPLVRETC(2,@02),@CB00747 0809 03002000 BE @RF00809 0809 03003000 * DO; /* @Y30LB26*/ 03004000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 03005000 BAL @14,ERREXIT 0811 03006000 * RETURN; /* @Y30LB26*/ 03007000 B @EL00010 0812 03008000 * END; /* @Y30LB26*/ 03009000 * ELSE /* @Y30LB26*/ 03010000 * DO; /* @Y30LB26*/ 03011000 @RF00809 DS 0H 0815 03012000 * IF JRNLEDSW=OFF THEN /* NOT JOURNALED? @Y30LB26*/ 03013000 TM JRNLEDSW,B'00000001' 0815 03014000 BNZ @RF00815 0815 03015000 * DO; /* @Y30LB26*/ 03016000 * CALL JOURNAL; /* JOURNAL RPLV @Y30LB26*/ 03017000 BAL @14,JOURNAL 0817 03018000 * IF RPLVRETC^=RCZERO THEN/* CK RETURN @Y30LB26*/ 03019000 L @02,RPLVPTR 0818 03020000 CLC RPLVRETC(2,@02),@CB00747 0818 03021000 BNE @RT00818 0818 03022000 * RETURN; /* @Y30LB26*/ 03023000 * END; /* @Y30LB26*/ 03024000 * END; /* @Y30LB26*/ 03025000 * RETURN; /* @Y30LB26*/ 03026000 B @EL00010 0822 03027000 * END DELEVOL; /* END DELETE VOL RTN @Y30LB26*/ 03028000 B @EL00010 0823 03029000 * 0824 03030000 * /*****************************************************************/ 03031000 * /* */ 03032000 * /* ROUTINE REMOVES BASE VOLUME RECORD FROM GROUP CHAIN @Y30LB26*/ 03033000 * /* AND UPDATES APPROPRIATE FIELDS IN THE GROUP RECORD @Y30LB26*/ 03034000 * /* */ 03035000 * /*****************************************************************/ 03036000 * 0824 03037000 *PROCGRP: 0824 03038000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 03039000 PROCGRP ST @14,@SA00011 0824 03040000 * 0825 03041000 * /*****************************************************************/ 03042000 * /* */ 03043000 * /* READ GROUP RECORD @Y30LB26*/ 03044000 * /* */ 03045000 * /*****************************************************************/ 03046000 * 0825 03047000 * GROUPKY=BASGROUP; /* GET GROUP IN KEY @Y30LB26*/ 03048000 L @02,BASEVPTR 0825 03049000 MVC GROUPKY(8),BASGROUP(@02) 0825 03050000 * RPLVKEY=ADDR(GKEY); /* ADDR OF KEY @Y30LB26*/ 03051000 L @02,RPLVPTR 0826 03052000 LA @15,GKEY 0826 03053000 ST @15,RPLVKEY(,@02) 0826 03054000 * RPLVBUF=ADDR(STORGRP); /* ADDR OF BUFFER @Y30LB26*/ 03055000 LA @15,STORGRP 0827 03056000 ST @15,RPLVBUF(,@02) 0827 03057000 * RPLVBLN=LENGTH(STORGRP); /* LENGTH OF BUFFER @Y30LB26*/ 03058000 MVC RPLVBLN(4,@02),@CF01147 0828 03059000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 03060000 OI RPLVDIR(@02),B'01000000' 0829 03061000 * RPLVTYP=RPLVREAD; /* READ REC @Y30LB26*/ 03062000 MVI RPLVTYP(@02),X'00' 0830 03063000 * RPLVUPD=ON; /* FOR UPDATE @Y30LB26*/ 03064000 OI RPLVUPD(@02),B'00000010' 0831 03065000 * RPLVKGE=OFF; /* NOT FOR > OR = @Y30LB26*/ 03066000 NI RPLVKGE(@02),B'11111011' 0832 03067000 * RESPECIFY 0833 03068000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 03069000 * REG1=RPLVPTR; /* GET ADDR OF RPLV @Y30LB26*/ 03070000 LR REG1,@02 0834 03071000 * CALL ICBVIO00; /* READ GROUP REC @Y30LB26*/ 03072000 L @15,@CV00671 0835 03073000 BALR @14,@15 0835 03074000 * RESPECIFY 0836 03075000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 03076000 * 0836 03077000 * /*****************************************************************/ 03078000 * /* */ 03079000 * /* CHECK RETURN CODE FROM I/O PROCESSOR @Y30LB26*/ 03080000 * /* */ 03081000 * /*****************************************************************/ 03082000 * 0837 03083000 * IF RPLVRETC^=RCZERO /* GET RECORD ? @Y30LB26*/ 03084000 * THEN /* @Y30LB26*/ 03085000 L @02,RPLVPTR 0837 03086000 CLC RPLVRETC(2,@02),@CB00747 0837 03087000 BE @RF00837 0837 03088000 * DO; /* @Y30LB26*/ 03089000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 03090000 BAL @14,ERREXIT 0839 03091000 * RETURN; /* @Y30LB26*/ 03092000 @EL00011 DS 0H 0840 03093000 @EF00011 DS 0H 0840 03094000 @ER00011 L @14,@SA00011 0840 03095000 BR @14 0840 03096000 * END; /* @Y30LB26*/ 03097000 * 0842 03098000 * /*****************************************************************/ 03099000 * /* */ 03100000 * /* SET UP ADDRESSABILITY TO GROUP RECORD @Y30LB26*/ 03101000 * /* */ 03102000 * /*****************************************************************/ 03103000 * 0842 03104000 * GROUPPTR=ADDR(STORGRP); /* PTR TO GROUP REC @Y30LB26*/ 03105000 @RF00837 LA @02,STORGRP 0842 03106000 ST @02,GROUPPTR 0842 03107000 * 0843 03108000 * /*****************************************************************/ 03109000 * /* */ 03110000 * /* UPDATE GROUP INACTIVE VOLUMES COUNT @Y30LB26*/ 03111000 * /* */ 03112000 * /*****************************************************************/ 03113000 * 0843 03114000 * GRONINAC=GRONINAC-ONE; /* ONE LESS INACT VOL @Y30LB26*/ 03115000 LH @15,GRONINAC(,@02) 0843 03116000 BCTR @15,0 0843 03117000 STH @15,GRONINAC(,@02) 0843 03118000 * 0844 03119000 * /*****************************************************************/ 03120000 * /* */ 03121000 * /* GO CHAIN VOLUME OUT OF GROUP @Y30LB26*/ 03122000 * /* */ 03123000 * /*****************************************************************/ 03124000 * 0844 03125000 * CHICHOGP=ON; /* INDICATE GROUPED @Y30LB26*/ 03126000 OI CHICHOGP,B'00010000' 0844 03127000 * CALL ICBVUCHO(GROUPPTR,BASEVPTR,RPLVPTR,PASSFLAG);/* @Y30LB26*/ 03128000 L @15,@CV00675 0845 03129000 LA @01,@AL00845 0845 03130000 BALR @14,@15 0845 03131000 * IF RPLVRETC^=RCZERO /* CHAINED OK ? @Y30LB26*/ 03132000 * THEN /* @Y30LB26*/ 03133000 L @02,RPLVPTR 0846 03134000 CLC RPLVRETC(2,@02),@CB00747 0846 03135000 BE @RF00846 0846 03136000 * DO; /* @Y30LB26*/ 03137000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 03138000 BAL @14,ERREXIT 0848 03139000 * RETURN; /* @Y30LB26*/ 03140000 B @EL00011 0849 03141000 * END; /* @Y30LB26*/ 03142000 * 0851 03143000 * /*****************************************************************/ 03144000 * /* */ 03145000 * /* READ GROUP RECORD TO DUMMY FOR UPDATE @Y30LB26*/ 03146000 * /* */ 03147000 * /*****************************************************************/ 03148000 * 0851 03149000 * RPLVKEY=ADDR(GKEY); /* ADDR OF KEY @Y30LB26*/ 03150000 @RF00846 L @02,RPLVPTR 0851 03151000 LA @15,GKEY 0851 03152000 ST @15,RPLVKEY(,@02) 0851 03153000 * RPLVBUF=ADDR(DUMMYREC); /* ADDR OF BUFFER @Y30LB26*/ 03154000 LA @15,DUMMYREC 0852 03155000 ST @15,RPLVBUF(,@02) 0852 03156000 * RPLVBLN=LENGTH(STORGRP); /* LENGTH OF BUFFER @Y30LB26*/ 03157000 MVC RPLVBLN(4,@02),@CF01147 0853 03158000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 03159000 OI RPLVDIR(@02),B'01000000' 0854 03160000 * RPLVTYP=RPLVREAD; /* READ REC @Y30LB26*/ 03161000 MVI RPLVTYP(@02),X'00' 0855 03162000 * RPLVUPD=ON; /* FOR UPDATE @Y30LB26*/ 03163000 OI RPLVUPD(@02),B'00000010' 0856 03164000 * RPLVKGE=OFF; /* NOT FOR > OR = @Y30LB26*/ 03165000 NI RPLVKGE(@02),B'11111011' 0857 03166000 * RESPECIFY 0858 03167000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 03168000 * REG1=RPLVPTR; /* GET ADDR OF RPLV @Y30LB26*/ 03169000 LR REG1,@02 0859 03170000 * CALL ICBVIO00; /* READ GROUP REC @Y30LB26*/ 03171000 L @15,@CV00671 0860 03172000 BALR @14,@15 0860 03173000 * RESPECIFY 0861 03174000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 03175000 * 0861 03176000 * /*****************************************************************/ 03177000 * /* */ 03178000 * /* CHECK RETURN CODE FROM I/O PROCESSOR @Y30LB26*/ 03179000 * /* */ 03180000 * /*****************************************************************/ 03181000 * 0862 03182000 * IF RPLVRETC^=RCZERO /* GET RECORD ? @Y30LB26*/ 03183000 * THEN /* @Y30LB26*/ 03184000 L @02,RPLVPTR 0862 03185000 CLC RPLVRETC(2,@02),@CB00747 0862 03186000 BE @RF00862 0862 03187000 * DO; /* @Y30LB26*/ 03188000 * CALL ERREXIT; /* SAVE RET CODES #Y30LB26*/ 03189000 BAL @14,ERREXIT 0864 03190000 * RETURN; /* #Y30LB26*/ 03191000 B @EL00011 0865 03192000 * END; /* @Y30LB26*/ 03193000 * 0866 03194000 * /*****************************************************************/ 03195000 * /* */ 03196000 * /* PUT OUT UPDATED GROUP RECORD @Y30LB26*/ 03197000 * /* */ 03198000 * /*****************************************************************/ 03199000 * 0867 03200000 * RPLVBUF=ADDR(STORGRP); /* BUFFER ADDR @Y30LB26*/ 03201000 @RF00862 L @02,RPLVPTR 0867 03202000 LA @15,STORGRP 0867 03203000 ST @15,RPLVBUF(,@02) 0867 03204000 * RPLVTYP=RPLVPUT; /* PUT GROUP REC @Y30LB26*/ 03205000 MVI RPLVTYP(@02),X'01' 0868 03206000 * RESPECIFY 0869 03207000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 03208000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 03209000 LR REG1,@02 0870 03210000 * CALL ICBVIO00; /* WRITE GROUP REC @Y30LB26*/ 03211000 L @15,@CV00671 0871 03212000 BALR @14,@15 0871 03213000 * RESPECIFY 0872 03214000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 03215000 * 0872 03216000 * /*****************************************************************/ 03217000 * /* */ 03218000 * /* CHECK OUT RETURN CODE @VS32198*/ 03219000 * /* */ 03220000 * /*****************************************************************/ 03221000 * 0873 03222000 * IF RPLVRETC^=RCZERO /* CK RET CODE @Y30LB26*/ 03223000 * THEN /* @Y30LB26*/ 03224000 L @02,RPLVPTR 0873 03225000 CLC RPLVRETC(2,@02),@CB00747 0873 03226000 BE @RF00873 0873 03227000 * DO; /* @Y30LB26*/ 03228000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 03229000 BAL @14,ERREXIT 0875 03230000 * RETURN; /* @Y30LB26*/ 03231000 B @EL00011 0876 03232000 * END; /* @Y30LB26*/ 03233000 * RETURN; /* @Y30LB26*/ 03234000 B @EL00011 0878 03235000 * END PROCGRP; /* END PROCESS GROUP @Y30LB26*/ 03236000 B @EL00011 0879 03237000 * 0880 03238000 * /*****************************************************************/ 03239000 * /* */ 03240000 * /* THIS ROUTINE IS CALLED IF A COPY RECORD IS @Y30LB26*/ 03241000 * /* TO BE REMOVED FROM THE INVENTORY @Y30LB26*/ 03242000 * /* */ 03243000 * /*****************************************************************/ 03244000 * 0880 03245000 *REMOVCPY: 0880 03246000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 03247000 * 0880 03248000 REMOVCPY ST @14,@SA00012 0880 03249000 * /*****************************************************************/ 03250000 * /* */ 03251000 * /* READ COPY RECORD @Y30LB26*/ 03252000 * /* */ 03253000 * /*****************************************************************/ 03254000 * 0881 03255000 * VIDKY=RVRCPYID; /* COPY ID TO KEY @Y30LB26*/ 03256000 L @02,RVRPTR 0881 03257000 MVC VIDKY(1),RVRCPYID(@02) 0881 03258000 * RPLVKEY=ADDR(VKEY); /* KEY ADDR TO VSAM @Y30LB26*/ 03259000 L @02,RPLVPTR 0882 03260000 LA @15,VKEY 0882 03261000 ST @15,RPLVKEY(,@02) 0882 03262000 * RPLVBUF=ADDR(STORCPY); /* ADDR BUFFER @Y30LB26*/ 03263000 LA @15,STORCPY 0883 03264000 ST @15,RPLVBUF(,@02) 0883 03265000 * RPLVBLN=LENGTH(STORCPY); /* LENGTH BUFFER @Y30LB26*/ 03266000 MVC RPLVBLN(4,@02),@CF01147 0884 03267000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 03268000 OI RPLVDIR(@02),B'01000000' 0885 03269000 * RPLVTYP=RPLVREAD; /* READ RECORD @Y30LB26*/ 03270000 MVI RPLVTYP(@02),X'00' 0886 03271000 * RPLVUPD=ON; /* READ FOR UPDATE @Y30LB26*/ 03272000 OI RPLVUPD(@02),B'00000010' 0887 03273000 * RESPECIFY 0888 03274000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 03275000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 03276000 LR REG1,@02 0889 03277000 * CALL ICBVIO00; /* READ COPY RECORD @Y30LB26*/ 03278000 L @15,@CV00671 0890 03279000 BALR @14,@15 0890 03280000 * RESPECIFY 0891 03281000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 03282000 * 0891 03283000 * /*****************************************************************/ 03284000 * /* */ 03285000 * /* CHECK RETURN CODE @Y30LB26*/ 03286000 * /* */ 03287000 * /*****************************************************************/ 03288000 * 0892 03289000 * IF RPLVRETC^=RCZERO /* CK RET CODE @Y30LB26*/ 03290000 * THEN /* @Y30LB26*/ 03291000 L @02,RPLVPTR 0892 03292000 CLC RPLVRETC(2,@02),@CB00747 0892 03293000 BE @RF00892 0892 03294000 * DO; /* @Y30LB26*/ 03295000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 03296000 BAL @14,ERREXIT 0894 03297000 * RETURN; /* @Y30LB26*/ 03298000 @EL00012 DS 0H 0895 03299000 @EF00012 DS 0H 0895 03300000 @ER00012 L @14,@SA00012 0895 03301000 BR @14 0895 03302000 * END; /* @Y30LB26*/ 03303000 * 0897 03304000 * /*****************************************************************/ 03305000 * /* */ 03306000 * /* SET ADDRESSABILITY @ZA16139*/ 03307000 * /* */ 03308000 * /*****************************************************************/ 03309000 * 0897 03310000 * COPYVPTR=ADDR(STORCPY); /* ADDR TO COPY REC @ZA16139*/ 03311000 @RF00892 LA @02,STORCPY 0897 03312000 ST @02,COPYVPTR 0897 03313000 * 0898 03314000 * /*****************************************************************/ 03315000 * /* */ 03316000 * /* CHECK FOR A PLACE HOLDER @ZDR2053*/ 03317000 * /* */ 03318000 * /*****************************************************************/ 03319000 * 0898 03320000 * IF COPHOLD=ON THEN 0898 03321000 TM COPHOLD(@02),B'10000000' 0898 03322000 BNO @RF00898 0898 03323000 * DO; /* @ZDR2053*/ 03324000 * CALL DELEVOL; /* DELETE BASE VOL @ZDR2053*/ 03325000 BAL @14,DELEVOL 0900 03326000 * RETURN; /* @ZDR2053*/ 03327000 B @EL00012 0901 03328000 * END; /* @ZDR2053*/ 03329000 * 0903 03330000 * /*****************************************************************/ 03331000 * /* */ 03332000 * /* CHECK IF BACKUP COPY @ZA16139*/ 03333000 * /* */ 03334000 * /*****************************************************************/ 03335000 * 0903 03336000 * IF COPBKUP=ON /* THIS A BACKUP COPY @Y30LB26*/ 03337000 * THEN 0903 03338000 @RF00898 L @02,COPYVPTR 0903 03339000 TM COPBKUP(@02),B'00001000' 0903 03340000 BNO @RF00903 0903 03341000 * BACKUPFL=ON; /* INDICA BACKUP COPY @Y30LB26*/ 03342000 * 0904 03343000 OI BACKUPFL,B'00100000' 0904 03344000 * /*****************************************************************/ 03345000 * /* */ 03346000 * /* SAVE KEY TO COPY TO CK IF LAST COPY IN BASE REC @Y30LB26*/ 03347000 * /* */ 03348000 * /*****************************************************************/ 03349000 * 0905 03350000 * SAVEKEY=VKEY; /* SAVE COPY VOL KEY @Y30LB26*/ 03351000 @RF00903 MVC SAVEKEY(13),VKEY 0905 03352000 * 0906 03353000 * /*****************************************************************/ 03354000 * /* */ 03355000 * /* GO DELETE COPY VOL RECORD @Y30LB26*/ 03356000 * /* */ 03357000 * /*****************************************************************/ 03358000 * 0906 03359000 * CALL DELEVOL; /* GO DELETE VOL REC @Y30LB26*/ 03360000 * 0906 03361000 BAL @14,DELEVOL 0906 03362000 * /*****************************************************************/ 03363000 * /* */ 03364000 * /* JOURNALING AND REASON CODE TAKEN CARE OF, @Y30LB26*/ 03365000 * /* SO IF BAD RETURN CODE JUST RETURN @Y30LB26*/ 03366000 * /* */ 03367000 * /*****************************************************************/ 03368000 * 0907 03369000 * IF RPLVRETC^=RCZERO /* CK RET CODE @Y30LB26*/ 03370000 * THEN 0907 03371000 L @02,RPLVPTR 0907 03372000 CLC RPLVRETC(2,@02),@CB00747 0907 03373000 BNE @RT00907 0907 03374000 * RETURN; /* RETURN TO CALLER @Y30LB26*/ 03375000 * 0909 03376000 * /*****************************************************************/ 03377000 * /* */ 03378000 * /* READ BASE VOLUME RECORD TO UPDATE FIELDS @Y30LB26*/ 03379000 * /* */ 03380000 * /*****************************************************************/ 03381000 * 0909 03382000 * VIDKY=FIXZERO; /* ZERO VOL ID IN KEY @Y30LB26*/ 03383000 MVI VIDKY,X'00' 0909 03384000 * RPLVKEY=ADDR(VKEY); /* GET ADDR OF KEY @Y30LB26*/ 03385000 LA @15,VKEY 0910 03386000 ST @15,RPLVKEY(,@02) 0910 03387000 * RPLVBUF=ADDR(STORBASE); /* ADDR OF BUFFER @Y30LB26*/ 03388000 LA @15,STORBASE 0911 03389000 ST @15,RPLVBUF(,@02) 0911 03390000 * RPLVBLN=LENGTH(STORBASE); /* LENGTH BUFFER @Y30LB26*/ 03391000 MVC RPLVBLN(4,@02),@CF01147 0912 03392000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 03393000 OI RPLVDIR(@02),B'01000000' 0913 03394000 * RPLVTYP=RPLVREAD; /* READ @Y30LB26*/ 03395000 MVI RPLVTYP(@02),X'00' 0914 03396000 * RPLVKGE=OFF; /* NO > OR = READ @Y30LB26*/ 03397000 NI RPLVKGE(@02),B'11111011' 0915 03398000 * RPLVUPD=ON; /* READ FOR UPDATE @Y30LB26*/ 03399000 OI RPLVUPD(@02),B'00000010' 0916 03400000 * RESPECIFY 0917 03401000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 03402000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 03403000 LR REG1,@02 0918 03404000 * CALL ICBVIO00; /* READ BASE VOL REC @Y30LB26*/ 03405000 L @15,@CV00671 0919 03406000 BALR @14,@15 0919 03407000 * RESPECIFY 0920 03408000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 03409000 * 0920 03410000 * /*****************************************************************/ 03411000 * /* */ 03412000 * /* CHECK RETURN CODE FROM I/O PROCESSOR @Y30LB26*/ 03413000 * /* */ 03414000 * /*****************************************************************/ 03415000 * 0921 03416000 * IF RPLVRETC^=RCZERO /* CK RET CODE @Y30LB26*/ 03417000 * THEN /* @Y30LB26*/ 03418000 L @02,RPLVPTR 0921 03419000 CLC RPLVRETC(2,@02),@CB00747 0921 03420000 BE @RF00921 0921 03421000 * DO; /* @Y30LB26*/ 03422000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 03423000 BAL @14,ERREXIT 0923 03424000 * RETURN; /* @Y30LB26*/ 03425000 B @EL00012 0924 03426000 * END; /* @Y30LB26*/ 03427000 * 0926 03428000 * /*****************************************************************/ 03429000 * /* */ 03430000 * /* SET UP ADDRESSING AND UPDATE BASE VOL RECORD @Y30LB26*/ 03431000 * /* */ 03432000 * /*****************************************************************/ 03433000 * 0926 03434000 * BASEVPTR=ADDR(STORBASE); /* ADDR BASE REC @Y30LB26*/ 03435000 @RF00921 LA @02,STORBASE 0926 03436000 ST @02,BASEVPTR 0926 03437000 * BASNCOPY=BASNCOPY-ONE; /* DECREASE COPIES ONE @Y30LB26*/ 03438000 SLR @15,@15 0927 03439000 IC @15,BASNCOPY(,@02) 0927 03440000 BCTR @15,0 0927 03441000 STC @15,BASNCOPY(,@02) 0927 03442000 * IF BASNCOPY=FIXZERO THEN /* NO COPIES ZERO FLD @Y30LB26*/ 03443000 CLI BASNCOPY(@02),0 0928 03444000 BNE @RF00928 0928 03445000 * BASKLCPY=BLANK; /* BLANK COPY ID @Y30LB26*/ 03446000 MVI BASKLCPY+1(@02),C' ' 0929 03447000 MVC BASKLCPY+2(11,@02),BASKLCPY+1(@02) 0929 03448000 MVI BASKLCPY(@02),C' ' 0929 03449000 * IF BACKUPFL=ON /* BACKUP COPY ? @Y30LB26*/ 03450000 * THEN 0930 03451000 @RF00928 TM BACKUPFL,B'00100000' 0930 03452000 BNO @RF00930 0930 03453000 * BASNBKUP=BASNBKUP-ONE; /* DECRE BACKUPS ONE @Y30LB26*/ 03454000 * 0931 03455000 L @02,BASEVPTR 0931 03456000 SLR @15,@15 0931 03457000 IC @15,BASNBKUP(,@02) 0931 03458000 BCTR @15,0 0931 03459000 STC @15,BASNBKUP(,@02) 0931 03460000 * /*****************************************************************/ 03461000 * /* */ 03462000 * /* CHECK TO SEE IF COPY DELETED WAS LATEST COPY @Y30LB26*/ 03463000 * /* AND THAT THERE IS STILL A COPY FOR VOLUME @Y30LB26*/ 03464000 * /* */ 03465000 * /*****************************************************************/ 03466000 * 0932 03467000 * IF BASKLCPY=SAVEKEY& /* CPY DELETED LATEST? @Y30LB26*/ 03468000 * BASNCOPY^=FIXZERO THEN /* ANY COPIES AT ALL ? @Y30LB26*/ 03469000 @RF00930 L @02,BASEVPTR 0932 03470000 CLC BASKLCPY(13,@02),SAVEKEY 0932 03471000 BNE @RF00932 0932 03472000 CLI BASNCOPY(@02),0 0932 03473000 BE @RF00932 0932 03474000 * DO; /* @Y30LB26*/ 03475000 * CALL FINDLCPY; /* FIND LATEST COPY @Y30LB26*/ 03476000 BAL @14,FINDLCPY 0934 03477000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @Y30LB26*/ 03478000 L @02,RPLVPTR 0935 03479000 CLC RPLVRETC(2,@02),@CB00747 0935 03480000 BNE @RT00935 0935 03481000 * RETURN; /* @Y30LB26*/ 03482000 * 0936 03483000 * /*************************************************************/ 03484000 * /* */ 03485000 * /* RESET I/O PROCESSOR TO WRITE BASE RECORD @Y30LB26*/ 03486000 * /* */ 03487000 * /*************************************************************/ 03488000 * 0937 03489000 * VOLKY=RVRVOLID; /* RESET TO CORR VOLUME @Y30LB26*/ 03490000 L @01,RVRPTR 0937 03491000 MVC VOLKY(6),RVRVOLID(@01) 0937 03492000 * VIDKY=FIXZERO; /* ZERO VOL ID IN KEY @Y30LB26*/ 03493000 MVI VIDKY,X'00' 0938 03494000 * RPLVKEY=ADDR(VKEY); /* GET ADDR OF KEY @Y30LB26*/ 03495000 LA @15,VKEY 0939 03496000 ST @15,RPLVKEY(,@02) 0939 03497000 * RPLVBUF=ADDR(DUMMYREC); /* ADDR OF BUFFER @Y30LB26*/ 03498000 LA @15,DUMMYREC 0940 03499000 ST @15,RPLVBUF(,@02) 0940 03500000 * RPLVBLN=LENGTH(STORBASE); /* LENGTH BUFFER @Y30LB26*/ 03501000 MVC RPLVBLN(4,@02),@CF01147 0941 03502000 * RPLVLOC=OFF; /* NOT LOCATE MODE @Y30LB26*/ 03503000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 03504000 * RPLVNEXT=OFF; /* DO NOT READ NEXT @Y30LB26*/ 03505000 OI RPLVDIR(@02),B'01000000' 0944 03506000 NI RPLVLOC(@02),B'01011111' 0944 03507000 * RPLVTYP=RPLVREAD; /* READ @Y30LB26*/ 03508000 MVI RPLVTYP(@02),X'00' 0945 03509000 * RPLVKGE=OFF; /* NO > OR = READ @Y30LB26*/ 03510000 NI RPLVKGE(@02),B'11111011' 0946 03511000 * RPLVUPD=ON; /* READ FOR UPDATE @Y30LB26*/ 03512000 OI RPLVUPD(@02),B'00000010' 0947 03513000 * RESPECIFY 0948 03514000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 03515000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 03516000 LR REG1,@02 0949 03517000 * CALL ICBVIO00; /* READ BASE VOL REC @Y30LB26*/ 03518000 L @15,@CV00671 0950 03519000 BALR @14,@15 0950 03520000 * RESPECIFY 0951 03521000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 03522000 * 0951 03523000 * /*************************************************************/ 03524000 * /* */ 03525000 * /* CHECK RETURN CODE FROM I/O PROCESSOR @Y30LB26*/ 03526000 * /* */ 03527000 * /*************************************************************/ 03528000 * 0952 03529000 * IF RPLVRETC^=RCZERO /* CK RET CODE @Y30LB26*/ 03530000 * THEN /* @Y30LB26*/ 03531000 L @02,RPLVPTR 0952 03532000 CLC RPLVRETC(2,@02),@CB00747 0952 03533000 BE @RF00952 0952 03534000 * DO; /* @Y30LB26*/ 03535000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 03536000 BAL @14,ERREXIT 0954 03537000 * RETURN; /* @Y30LB26*/ 03538000 B @EL00012 0955 03539000 * END; /* @Y30LB26*/ 03540000 * END; /* @Y30LB26*/ 03541000 @RF00952 DS 0H 0958 03542000 * 0958 03543000 * /*****************************************************************/ 03544000 * /* */ 03545000 * /* WRITE UPDATED BASE VOLUME RECORD @Y30LB26*/ 03546000 * /* */ 03547000 * /*****************************************************************/ 03548000 * 0958 03549000 * RPLVBUF=BASEVPTR; /* ADDR REC TO WRITE @Y30LB26*/ 03550000 @RF00932 L @02,RPLVPTR 0958 03551000 L @15,BASEVPTR 0958 03552000 ST @15,RPLVBUF(,@02) 0958 03553000 * RPLVTYP=RPLVPUT; /* PUT BASE RECORD @Y30LB26*/ 03554000 MVI RPLVTYP(@02),X'01' 0959 03555000 * RESPECIFY 0960 03556000 * REG1 RSTD; /* REST REG 1 @Y30LB26*/ 03557000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 03558000 LR REG1,@02 0961 03559000 * CALL ICBVIO00; /* WRITE BASE REC @Y30LB26*/ 03560000 L @15,@CV00671 0962 03561000 BALR @14,@15 0962 03562000 * RESPECIFY 0963 03563000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 03564000 * IF RPLVRETC^=RCZERO /* CK RET CODE @Y30LB26*/ 03565000 * THEN /* @Y30LB26*/ 03566000 L @02,RPLVPTR 0964 03567000 CLC RPLVRETC(2,@02),@CB00747 0964 03568000 BE @RF00964 0964 03569000 * DO; /* @Y30LB26*/ 03570000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 03571000 BAL @14,ERREXIT 0966 03572000 * RETURN; /* @Y30LB26*/ 03573000 B @EL00012 0967 03574000 * END; /* @Y30LB26*/ 03575000 * ELSE /* @Y30LB26*/ 03576000 * IF JRNLEDSW=OFF THEN /* SEE IF JOURNALED @Y30LB26*/ 03577000 @RF00964 TM JRNLEDSW,B'00000001' 0969 03578000 BNZ @RF00969 0969 03579000 * CALL JOURNAL; /* JOURNAL RPLV @Y30LB26*/ 03580000 BAL @14,JOURNAL 0970 03581000 * RETURN; /* @Y30LB26*/ 03582000 B @EL00012 0971 03583000 * END REMOVCPY; /* END REMOVCPY PROC @Y30LB26*/ 03584000 B @EL00012 0972 03585000 * 0973 03586000 * /*****************************************************************/ 03587000 * /* */ 03588000 * /* PROCEDURE LOCATES THE LATEST COPY OF A BASE VOLUME @Y30LB26*/ 03589000 * /* RECORD WHEN THE PREVIOUS LATEST COPY HAS BEEN DELETED @Y30LB26*/ 03590000 * /* */ 03591000 * /*****************************************************************/ 03592000 * 0973 03593000 *FINDLCPY: 0973 03594000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 03595000 FINDLCPY ST @14,@SA00013 0973 03596000 * VIDKY=FIXONE; /* PUT ID TO ONE @Y30LB26*/ 03597000 MVI VIDKY,X'01' 0974 03598000 * LOOPSW=OFF; /* INITILIZE LOOP SW @Y30LB26*/ 03599000 * 0975 03600000 NI LOOPSW,B'01111111' 0975 03601000 * /*****************************************************************/ 03602000 * /* */ 03603000 * /* START LOOPING THRU COPIES UNTIL RUN OUT #Y30LB26*/ 03604000 * /* */ 03605000 * /*****************************************************************/ 03606000 * 0976 03607000 * DO WHILE I=I; /* OUTSIDE LOOP #Y30LB26*/ 03608000 B @DE00976 0976 03609000 @DL00976 DS 0H 0977 03610000 * RPLVKEY=ADDR(VKEY); /* ADDR OF KEY #Y30LB26*/ 03611000 L @02,RPLVPTR 0977 03612000 LA @15,VKEY 0977 03613000 ST @15,RPLVKEY(,@02) 0977 03614000 * RPLVLOC=ON; /* LOCATE MODE #Y30LB26*/ 03615000 * RPLVDIR=ON; /* DIRECT READ #Y30LB26*/ 03616000 OI RPLVLOC(@02),B'11000000' 0979 03617000 * RPLVTYP=RPLVREAD; /* READ RECORD #Y30LB26*/ 03618000 MVI RPLVTYP(@02),X'00' 0980 03619000 * RPLVUPD=OFF; /* NOT FOR UPDATE #Y30LB26*/ 03620000 NI RPLVUPD(@02),B'11111101' 0981 03621000 * RPLVKGE=ON; /* READ > OR = #Y30LB26*/ 03622000 OI RPLVKGE(@02),B'00000100' 0982 03623000 * RESPECIFY 0983 03624000 * REG1 RSTD; /* RESTRICI REG 1 #Y30LB26*/ 03625000 * REG1=RPLVPTR; /* ADDR OF RPLV #Y30LB26*/ 03626000 LR REG1,@02 0984 03627000 * CALL ICBVIO00; /* READ COPY RECORD #Y30LB26*/ 03628000 L @15,@CV00671 0985 03629000 BALR @14,@15 0985 03630000 * RESPECIFY 0986 03631000 * REG1 UNRSTD; /* FREE REG 1 #Y30LB26*/ 03632000 * 0986 03633000 * /***************************************************************/ 03634000 * /* */ 03635000 * /* CHECK RETURN CODE FROM I/O PROCESSOR #Y30LB26*/ 03636000 * /* */ 03637000 * /***************************************************************/ 03638000 * 0987 03639000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @Y30LB26*/ 03640000 L @02,RPLVPTR 0987 03641000 CLC RPLVRETC(2,@02),@CB00747 0987 03642000 BE @RF00987 0987 03643000 * DO; /* #Y30LB26*/ 03644000 * IF RPLRCODE=NORECRC THEN /* RECORD NOT FOUND ? @Y30LB26*/ 03645000 CLC RPLRCODE(2,@02),@CB00789 0989 03646000 BNE @RF00989 0989 03647000 * DO; /* @Y30LB26*/ 03648000 * IF LOOPSW=ON THEN /* FOUND COPY REC ? @Y30LB26*/ 03649000 TM LOOPSW,B'10000000' 0991 03650000 BNO @RF00991 0991 03651000 * DO; /* @Y30LB26*/ 03652000 * BASKLCPY=SAVEKEY; /* LATEST COPY IN BASE @Y30LB26*/ 03653000 L @01,BASEVPTR 0993 03654000 MVC BASKLCPY(13,@01),SAVEKEY 0993 03655000 * RPLVRETC=RCZERO; /* GOOD RETURN @Y30LB26*/ 03656000 MVC RPLVRETC(2,@02),@CB00747 0994 03657000 * RPLRCODE=RCZERO; /* GOOD REASON @Y30LB26*/ 03658000 MVC RPLRCODE(2,@02),@CB00747 0995 03659000 * RETURN; /* @Y30LB26*/ 03660000 @EL00013 DS 0H 0996 03661000 @EF00013 DS 0H 0996 03662000 @ER00013 L @14,@SA00013 0996 03663000 BR @14 0996 03664000 * END; /* @Y30LB26*/ 03665000 * ELSE /* @Y30LB26*/ 03666000 * DO; /* @Y30LB26*/ 03667000 @RF00991 DS 0H 0999 03668000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 03669000 BAL @14,ERREXIT 0999 03670000 * RETURN; /* @Y30LB26*/ 03671000 B @EL00013 1000 03672000 * END; /* @Y30LB26*/ 03673000 * END; /* @Y30LB26*/ 03674000 * ELSE /* @Y30LB26*/ 03675000 * DO; /* @Y30LB26*/ 03676000 @RF00989 DS 0H 1004 03677000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 03678000 BAL @14,ERREXIT 1004 03679000 * RETURN; /* @Y30LB26*/ 03680000 B @EL00013 1005 03681000 * END; /* @Y30LB26*/ 03682000 * END; /* #Y30LB26*/ 03683000 * COPYVPTR=RPLVBUF; /* ADDR RECORD READ #Y30LB26*/ 03684000 * 1008 03685000 @RF00987 L @02,RPLVPTR 1008 03686000 L @02,RPLVBUF(,@02) 1008 03687000 ST @02,COPYVPTR 1008 03688000 * /***************************************************************/ 03689000 * /* */ 03690000 * /* CHECK TO BE SURE IT IS STILL A CORRECT VOLUME REC #Y30LB26*/ 03691000 * /* */ 03692000 * /***************************************************************/ 03693000 * 1009 03694000 * IF COPV=VKY&COPSERNO=VOLKY THEN/* STILL GOOD ? #Y30LB26*/ 03695000 CLC COPV(5,@02),VKY 1009 03696000 BNE @RF01009 1009 03697000 CLC COPSERNO(6,@02),VOLKY 1009 03698000 BNE @RF01009 1009 03699000 * DO; /* #Y30LB26*/ 03700000 * SAVEKEY=COPNAME; /* SAVE CURRENT VOL KEY #Y30LB26*/ 03701000 MVC SAVEKEY(13),COPNAME(@02) 1011 03702000 * VKEY=COPNAME; /* BUILD KEY READ AGAIN #Y30LB26*/ 03703000 MVC VKEY(13),COPNAME(@02) 1012 03704000 * VIDKY=VIDKY+FIXONE; /* ADD ONE TO GET NEXT #Y30LB26*/ 03705000 LA @02,1 1013 03706000 SLR @15,@15 1013 03707000 IC @15,VIDKY 1013 03708000 ALR @02,@15 1013 03709000 STC @02,VIDKY 1013 03710000 * LOOPSW=ON; /* INDICATE FOUND 1 COPY #Y30LB26*/ 03711000 OI LOOPSW,B'10000000' 1014 03712000 * END; /* #Y30LB26*/ 03713000 * ELSE /* #Y30LB26*/ 03714000 * DO; /* #Y30LB26*/ 03715000 B @RC01009 1016 03716000 @RF01009 DS 0H 1017 03717000 * IF LOOPSW=ON THEN /* SEE IF A COPY FOUND #Y30LB26*/ 03718000 TM LOOPSW,B'10000000' 1017 03719000 BNO @RF01017 1017 03720000 * DO; /* #Y30LB26*/ 03721000 * BASKLCPY=SAVEKEY; /* GET OLD KEY #Y30LB26*/ 03722000 L @02,BASEVPTR 1019 03723000 MVC BASKLCPY(13,@02),SAVEKEY 1019 03724000 * RETURN; /* #Y30LB26*/ 03725000 B @EL00013 1020 03726000 * END; /* #Y30LB26*/ 03727000 * ELSE /* #Y30LB26*/ 03728000 * DO; /* #Y30LB26*/ 03729000 @RF01017 DS 0H 1023 03730000 * RPLVRETC=FOUR; /* BAD RET CODE #Y30LB26*/ 03731000 L @02,RPLVPTR 1023 03732000 MVC RPLVRETC(2,@02),@CB00749 1023 03733000 * RPLRCODE=NORECRC; /* NO COPIES FOUND @Y30LB26*/ 03734000 MVC RPLRCODE(2,@02),@CB00789 1024 03735000 * CALL ERREXIT; /* SAVE RET CODES #Y30LB26*/ 03736000 BAL @14,ERREXIT 1025 03737000 * RETURN; /* #Y30LB26*/ 03738000 B @EL00013 1026 03739000 * END; /* #Y30LB26*/ 03740000 * END; /* #Y30LB26*/ 03741000 * END; /* #Y30LB26*/ 03742000 @RC01009 DS 0H 1029 03743000 @DE00976 CLC I(1),I 1029 03744000 BE @DL00976 1029 03745000 * END FINDLCPY; /* #Y30LB26*/ 03746000 B @EL00013 1030 03747000 * 1031 03748000 * /*****************************************************************/ 03749000 * /* */ 03750000 * /* ROUTINE CHECKS IF CARTRIDGE INDEX RECORDS ARE #Y30LB26*/ 03751000 * /* STILL IN THE LIBRARY #Y30LB26*/ 03752000 * /* AND IF THEY BELONG TO THE RIGHT VOLUME, IT #Y30LB26*/ 03753000 * /* DELETES THE INDEX RECORDS #Y30LB26*/ 03754000 * /* */ 03755000 * /*****************************************************************/ 03756000 * 1031 03757000 *CHKCART: 1031 03758000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 03759000 * 1031 03760000 CHKCART ST @14,@SA00014 1031 03761000 * /*****************************************************************/ 03762000 * /* */ 03763000 * /* SET UP ADDRESSING TO BASE OR COPY RECORD #Y30LB26*/ 03764000 * /* */ 03765000 * /*****************************************************************/ 03766000 * 1032 03767000 * IF RVRBASEV=ON /* BASE OR COPY #Y30LB26*/ 03768000 * THEN 1032 03769000 L @02,RVRPTR 1032 03770000 TM RVRBASEV(@02),B'10000000' 1032 03771000 BNO @RF01032 1032 03772000 * BCDVPTR=BASEVPTR; /* COMMON ADDR TO BASE #Y30LB26*/ 03773000 L BCDVPTR,BASEVPTR 1033 03774000 * ELSE 1034 03775000 * BCDVPTR=COPYVPTR; /* COMMON ADDR TO COPY #Y30LB26*/ 03776000 B @RC01032 1034 03777000 @RF01032 L BCDVPTR,COPYVPTR 1034 03778000 * 1035 03779000 * /*****************************************************************/ 03780000 * /* */ 03781000 * /* CHECK TO SEE IF CARTRIDGES ARE IN LIBRARY #Y30LB26*/ 03782000 * /* */ 03783000 * /*****************************************************************/ 03784000 * 1035 03785000 * IF BCDLIB1^=LIBTEST|BCDLIB2^=LIBTEST/* IN LIB @Y30LB26*/ 03786000 * THEN /* @Y30LB26*/ 03787000 * 1035 03788000 @RC01032 CLC BCDLIB1(1,BCDVPTR),LIBTEST 1035 03789000 BNE @RT01035 1035 03790000 CLC BCDLIB2(1,BCDVPTR),LIBTEST 1035 03791000 BE @RF01035 1035 03792000 @RT01035 DS 0H 1036 03793000 * /***************************************************************/ 03794000 * /* */ 03795000 * /* IF THEY ARE, SET REASON CODE AND RETURN @Y30LB26*/ 03796000 * /* */ 03797000 * /***************************************************************/ 03798000 * 1036 03799000 * DO; /* @Y30LB26*/ 03800000 * RPLVRETC=FOUR; /* SET BAD RET CODE @Y30LB26*/ 03801000 L @02,RPLVPTR 1037 03802000 MVC RPLVRETC(2,@02),@CB00749 1037 03803000 * RPLRCODE=INLIB; /* REASON CODE @Y30LB26*/ 03804000 MVC RPLRCODE(2,@02),@CB00799 1038 03805000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 03806000 BAL @14,ERREXIT 1039 03807000 * RETURN; /* @Y30LB26*/ 03808000 @EL00014 DS 0H 1040 03809000 @EF00014 DS 0H 1040 03810000 @ER00014 L @14,@SA00014 1040 03811000 BR @14 1040 03812000 * END; /* @Y30LB26*/ 03813000 * 1042 03814000 * /*****************************************************************/ 03815000 * /* */ 03816000 * /* READ FIRST CARTRIDGE INDEX RECORD @Y30LB26*/ 03817000 * /* */ 03818000 * /*****************************************************************/ 03819000 * 1042 03820000 * CARTKY=BCDCSN1; /* CART SERIAL TO KEY @Y30LB26*/ 03821000 @RF01035 MVC CARTKY(12),BCDCSN1(BCDVPTR) 1042 03822000 * RPLVKEY=ADDR(IKEY); /* ADDR OF KEY TO VSAM @Y30LB26*/ 03823000 L @04,RPLVPTR 1043 03824000 LA @02,IKEY 1043 03825000 ST @02,RPLVKEY(,@04) 1043 03826000 * RPLVBUF=ADDR(STORINDX); /* ADDR OF BUFFER @Y30LB26*/ 03827000 LA @02,STORINDX 1044 03828000 ST @02,RPLVBUF(,@04) 1044 03829000 * RPLVBLN=LENGTH(STORINDX); /* LENGTH BUFFER @Y30LB26*/ 03830000 MVC RPLVBLN(4,@04),@CF01147 1045 03831000 * RPLVDIR=ON; /* DIRECT READ @Y30LB26*/ 03832000 OI RPLVDIR(@04),B'01000000' 1046 03833000 * RPLVTYP=RPLVREAD; /* READ CART INDX @Y30LB26*/ 03834000 MVI RPLVTYP(@04),X'00' 1047 03835000 * RPLVUPD=ON; /* READ FOR UPDATE @Y30LB26*/ 03836000 OI RPLVUPD(@04),B'00000010' 1048 03837000 * RESPECIFY 1049 03838000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 03839000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 03840000 LR REG1,@04 1050 03841000 * CALL ICBVIO00; /* READ CART INDEX REC @Y30LB26*/ 03842000 L @15,@CV00671 1051 03843000 BALR @14,@15 1051 03844000 * RESPECIFY 1052 03845000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 03846000 * 1052 03847000 * /*****************************************************************/ 03848000 * /* */ 03849000 * /* CHECK TO SEE IF CART INDEX REC RETURNED SUCCESS @Y30LB26*/ 03850000 * /* */ 03851000 * /*****************************************************************/ 03852000 * 1053 03853000 * IF RPLVRETC=RCZERO /* CK RET CODE @Y30LB26*/ 03854000 * THEN /* @Y30LB26*/ 03855000 L @04,RPLVPTR 1053 03856000 CLC RPLVRETC(2,@04),@CB00747 1053 03857000 BNE @RF01053 1053 03858000 * DO; /* @Y30LB26*/ 03859000 * INDEXPTR=ADDR(STORINDX); /* ADDR OF INDEX REC @Y30LB26*/ 03860000 LA INDEXPTR,STORINDX 1055 03861000 * IF INDRECKY=VKEY /* CK BELONGS RIT VOL @Y30LB26*/ 03862000 * THEN /* @Y30LB26*/ 03863000 * 1056 03864000 CLC INDRECKY(13,INDEXPTR),VKEY 1056 03865000 BNE @RF01056 1056 03866000 * /***********************************************************/ 03867000 * /* */ 03868000 * /* CARTRIDGE BELONGS TO CORRECT VOL, @Y30LB26*/ 03869000 * /* SO DELETE CART INDEX RECORD @Y30LB26*/ 03870000 * /* */ 03871000 * /***********************************************************/ 03872000 * 1057 03873000 * DO; /* @Y30LB26*/ 03874000 * RPLVTYP=RPLVDEL; /* DELETE CART INDX @Y30LB26*/ 03875000 MVI RPLVTYP(@04),X'05' 1058 03876000 * RESPECIFY 1059 03877000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 03878000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 03879000 LR REG1,@04 1060 03880000 * CALL ICBVIO00; /* DELETE INDEX REC @Y30LB26*/ 03881000 L @15,@CV00671 1061 03882000 BALR @14,@15 1061 03883000 * RESPECIFY 1062 03884000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 03885000 * 1062 03886000 * /*********************************************************/ 03887000 * /* */ 03888000 * /* SEE IF CART RECORD DELETED SUCCESSFULLY @Y30LB26*/ 03889000 * /* */ 03890000 * /*********************************************************/ 03891000 * 1063 03892000 * IF RPLVRETC^=RCZERO /* CK RET CODE @Y30LB26*/ 03893000 * THEN /* @Y30LB26*/ 03894000 L @04,RPLVPTR 1063 03895000 CLC RPLVRETC(2,@04),@CB00747 1063 03896000 BE @RF01063 1063 03897000 * DO; /* @Y30LB26*/ 03898000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 03899000 BAL @14,ERREXIT 1065 03900000 * RETURN; /* @Y30LB26*/ 03901000 B @EL00014 1066 03902000 * END; /* @Y30LB26*/ 03903000 * ELSE /* @Y30LB26*/ 03904000 * IF JRNLEDSW=OFF THEN /* NOT JOURNLED ? @Y30LB26*/ 03905000 @RF01063 TM JRNLEDSW,B'00000001' 1068 03906000 BNZ @RF01068 1068 03907000 * DO; /* @Y30LB26*/ 03908000 * CALL JOURNAL; /* JOURNAL RPLV @Y30LB26*/ 03909000 BAL @14,JOURNAL 1070 03910000 * IF RPLVRETC^=RCZERO THEN/* CK RETURN @Y30LB26*/ 03911000 L @04,RPLVPTR 1071 03912000 CLC RPLVRETC(2,@04),@CB00747 1071 03913000 BNE @RT01071 1071 03914000 * RETURN; /* @Y30LB26*/ 03915000 * END; /* @Y30LB26*/ 03916000 * END; /* @Y30LB26*/ 03917000 * END; /* @Y30LB26*/ 03918000 * ELSE /* @Y30LB26*/ 03919000 * 1076 03920000 * /***************************************************************/ 03921000 * /* */ 03922000 * /* SEE IF ERROR OTHER THAN RECORD NOT FOUND @Y30LB26*/ 03923000 * /* */ 03924000 * /***************************************************************/ 03925000 * 1076 03926000 * IF RPLRCODE^=NORECRC /* CK IF REC FOUND @Y30LB26*/ 03927000 * THEN /* @Y30LB26*/ 03928000 B @RC01053 1076 03929000 @RF01053 L @04,RPLVPTR 1076 03930000 CLC RPLRCODE(2,@04),@CB00789 1076 03931000 BE @RF01076 1076 03932000 * DO; /* @Y30LB26*/ 03933000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 03934000 BAL @14,ERREXIT 1078 03935000 * RETURN; /* RETURN TO CALLER @Y30LB26*/ 03936000 B @EL00014 1079 03937000 * END; /* @Y30LB26*/ 03938000 * 1081 03939000 * /*****************************************************************/ 03940000 * /* */ 03941000 * /* START SAME THING WITH SECOND CART INDEX RECORD @Y30LB26*/ 03942000 * /* */ 03943000 * /*****************************************************************/ 03944000 * 1081 03945000 * CARTKY=BCDCSN2; /* INDEX KEY @Y30LB26*/ 03946000 @RF01076 DS 0H 1081 03947000 @RC01053 MVC CARTKY(12),BCDCSN2(BCDVPTR) 1081 03948000 * RPLVKEY=ADDR(IKEY); /* ADDR KEY TO VSAM @Y30LB26*/ 03949000 L @02,RPLVPTR 1082 03950000 LA @15,IKEY 1082 03951000 ST @15,RPLVKEY(,@02) 1082 03952000 * RPLVBUF=ADDR(STORINDX); /* ADDR BUFFER @Y30LB26*/ 03953000 LA @15,STORINDX 1083 03954000 ST @15,RPLVBUF(,@02) 1083 03955000 * RPLVBLN=LENGTH(STORINDX); /* LENGTH BUFFER @Y30LB26*/ 03956000 MVC RPLVBLN(4,@02),@CF01147 1084 03957000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 03958000 OI RPLVDIR(@02),B'01000000' 1085 03959000 * RPLVTYP=RPLVREAD; /* READ RECORD @Y30LB26*/ 03960000 MVI RPLVTYP(@02),X'00' 1086 03961000 * RPLVUPD=ON; /* READ FOR UPDATE @Y30LB26*/ 03962000 OI RPLVUPD(@02),B'00000010' 1087 03963000 * RESPECIFY 1088 03964000 * REG1 RSTD; /* REST REG 1 @Y30LB26*/ 03965000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 03966000 LR REG1,@02 1089 03967000 * CALL ICBVIO00; /* READ SECOND CART @Y30LB26*/ 03968000 L @15,@CV00671 1090 03969000 BALR @14,@15 1090 03970000 * RESPECIFY 1091 03971000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 03972000 * 1091 03973000 * /*****************************************************************/ 03974000 * /* */ 03975000 * /* CHECK TO SEE IF RECORD RETURNED SUCCESSFULLY @Y30LB26*/ 03976000 * /* */ 03977000 * /*****************************************************************/ 03978000 * 1092 03979000 * IF RPLVRETC=RCZERO /* TEST RET CODE @Y30LB26*/ 03980000 * THEN /* @Y30LB26*/ 03981000 * 1092 03982000 L @02,RPLVPTR 1092 03983000 CLC RPLVRETC(2,@02),@CB00747 1092 03984000 BNE @RF01092 1092 03985000 * /***************************************************************/ 03986000 * /* */ 03987000 * /* SET ADDRESSING AND CK TO SEE IF CORRECT OWNER @Y30LB26*/ 03988000 * /* */ 03989000 * /***************************************************************/ 03990000 * 1093 03991000 * DO; /* @Y30LB26*/ 03992000 * INDEXPTR=ADDR(STORINDX); /* ADDR REC JUST READ @Y30LB26*/ 03993000 LA INDEXPTR,STORINDX 1094 03994000 * IF INDRECKY=VKEY /* TEST IF RIT OWNER @Y30LB26*/ 03995000 * THEN /* @Y30LB26*/ 03996000 * 1095 03997000 CLC INDRECKY(13,INDEXPTR),VKEY 1095 03998000 BNE @RF01095 1095 03999000 * /***********************************************************/ 04000000 * /* */ 04001000 * /* IF BELONGS TO THE CORRECT VOLUME DELETE @Y30LB26*/ 04002000 * /* CARTRIDGE INDEX RECORD @Y30LB26*/ 04003000 * /* */ 04004000 * /***********************************************************/ 04005000 * 1096 04006000 * DO; /* @Y30LB26*/ 04007000 * RPLVTYP=RPLVDEL; /* DELETE CART INDEX @Y30LB26*/ 04008000 MVI RPLVTYP(@02),X'05' 1097 04009000 * RESPECIFY 1098 04010000 * REG1 RSTD; /* REST REG 1 @Y30LB26*/ 04011000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 04012000 LR REG1,@02 1099 04013000 * CALL ICBVIO00; /* DELETE INDEX REC @Y30LB26*/ 04014000 L @15,@CV00671 1100 04015000 BALR @14,@15 1100 04016000 * RESPECIFY 1101 04017000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 04018000 * 1101 04019000 * /*********************************************************/ 04020000 * /* */ 04021000 * /* CK TO SEE IF SUCCESSFULLY DELETED @Y30LB26*/ 04022000 * /* */ 04023000 * /*********************************************************/ 04024000 * 1102 04025000 * IF RPLVRETC^=RCZERO /* CK RET CODE @Y30LB26*/ 04026000 * THEN /* @Y30LB26*/ 04027000 L @02,RPLVPTR 1102 04028000 CLC RPLVRETC(2,@02),@CB00747 1102 04029000 BE @RF01102 1102 04030000 * DO; /* @Y30LB26*/ 04031000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 04032000 BAL @14,ERREXIT 1104 04033000 * RETURN; /* @Y30LB26*/ 04034000 B @EL00014 1105 04035000 * END; /* @Y30LB26*/ 04036000 * ELSE /* @Y30LB26*/ 04037000 * 1107 04038000 * /*******************************************************/ 04039000 * /* */ 04040000 * /* IF NOT JOURNLED BEFORE, JOURNAL IT @Y30LB26*/ 04041000 * /* */ 04042000 * /*******************************************************/ 04043000 * 1107 04044000 * DO; /* @Y30LB26*/ 04045000 @RF01102 DS 0H 1108 04046000 * IF JRNLEDSW=OFF THEN/* NOT JOURNLED ? @Y30LB26*/ 04047000 TM JRNLEDSW,B'00000001' 1108 04048000 BNZ @RF01108 1108 04049000 * DO; /* @Y30LB26*/ 04050000 * CALL JOURNAL; /* JOURNAL RPLV @Y30LB26*/ 04051000 BAL @14,JOURNAL 1110 04052000 * IF RPLVRETC^=RCZERO THEN/* CK RETURN @Y30LB26*/ 04053000 L @02,RPLVPTR 1111 04054000 CLC RPLVRETC(2,@02),@CB00747 1111 04055000 BNE @RT01111 1111 04056000 * RETURN; /* @Y30LB26*/ 04057000 * END; /* @Y30LB26*/ 04058000 * END; /* @Y30LB26*/ 04059000 @RF01108 DS 0H 1115 04060000 * END; /* @Y30LB26*/ 04061000 * END; /* @Y30LB26*/ 04062000 * ELSE /* @Y30LB26*/ 04063000 * 1117 04064000 * /***************************************************************/ 04065000 * /* */ 04066000 * /* CK TO SEE IF RETURN CODE OTHER THAN @Y30LB26*/ 04067000 * /* RECORD NOT FOUND @Y30LB26*/ 04068000 * /* */ 04069000 * /***************************************************************/ 04070000 * 1117 04071000 * IF RPLRCODE^=NORECRC /* CK IF NO REC FOUND @Y30LB26*/ 04072000 * THEN /* @Y30LB26*/ 04073000 B @RC01092 1117 04074000 @RF01092 L @02,RPLVPTR 1117 04075000 CLC RPLRCODE(2,@02),@CB00789 1117 04076000 BE @RF01117 1117 04077000 * DO; /* @Y30LB26*/ 04078000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 04079000 BAL @14,ERREXIT 1119 04080000 * RETURN; /* @Y30LB26*/ 04081000 B @EL00014 1120 04082000 * END; /* @Y30LB26*/ 04083000 * 1122 04084000 * /*****************************************************************/ 04085000 * /* */ 04086000 * /* EVERY THING IS ALRIGHT SO SET GOOD RETURN CODES @Y30LB26*/ 04087000 * /* */ 04088000 * /*****************************************************************/ 04089000 * 1122 04090000 * RPLVRETC=RCZERO; /* GOOD RET CODE @Y30LB26*/ 04091000 @RF01117 DS 0H 1122 04092000 @RC01092 L @02,RPLVPTR 1122 04093000 MVC RPLVRETC(2,@02),@CB00747 1122 04094000 * RPLRCODE=RCZERO; /* ZERO REASON CODE @Y30LB26*/ 04095000 MVC RPLRCODE(2,@02),@CB00747 1123 04096000 * RETURN; /* @Y30LB26*/ 04097000 B @EL00014 1124 04098000 * END CHKCART; /* CHKCART INNER PROC @Y30LB26*/ 04099000 B @EL00014 1125 04100000 * 1126 04101000 */* START OF SPECIFICATIONS **** 1126 04102000 * 1126 04103000 * PROCEDURE NAME - READVVI @Y30LB26 04104000 * 1126 04105000 * FUNCTION - RETRIEVE RECORDS FROM THE USERCAT.MSVI DATA SET. THIS 04106000 * PROGRAM READS AND RETURNS CERTAIN MSVC RECORDS. IT DOES NOT 1126 04107000 * UPDATE ANY MSVC RECORDS. IT WILL READ DIRECT, READ NEXT OR READ 04108000 * CHAIN FOR BASE VOLUME RECORDS. IT WILL ALSO READ THE FIRST BASE 04109000 * VOLUME RECORD IN THE INVENTORY DATA SET AND THE FIRST BASE VOLUME 04110000 * RECORD IN THE NON-GROUPED BASE CHAIN. WHEN READING NEXT OR READING 04111000 * A CHAIN IT WILL CONTINUE TO READ UNTIL A RECORD IS FOUND THAT 1126 04112000 * MEETS ALL THE TEST PARAMETERS, IF ANY WERE SPECIFIED. WHEN A 1126 04113000 * RECORD IS FOUND THAT MEETS ALL THE TEST REQUIREMENTS, IT RETURNS 04114000 * TO THE CALLING PROGRAM WITH THE RECORD. THE TESTS MADE FOR 1126 04115000 * THE BASE VOLUME RECORD INCLUDE EXPIRATION DATE, GENERAL OR 1126 04116000 * RESTRICTED USE, ACTIVE OR INACTIVE. FOR GROUP RECORDS, READ 1126 04117000 * DIRECT AND READ NEXT IS VALID. IT WILL ALSO READ THE FIRST GROUP 04118000 * RECORD IN THE DATA SET. THE ONLY CHECK PREFORMED IS THE 1126 04119000 * GROUP THRESHOLD TEST. WHEN READING NEXT, IT WILL CONTINUE READING 04120000 * GROUP RECORDS UNTIL IT FINDS A RECORD WITH A GROUP THRESHOLD 1126 04121000 * GREATER THAN OR EQUAL TO THE GROUP FREE SPACE. IT THEN RETURNS 04122000 * TO THE CALLING PROGRAM WITH THE RECORD. IF ALL GROUP RECORDS 1126 04123000 * ARE READ AND NONE WERE FOUND MEETING THE TEST REQUIREMENTS, 1126 04124000 * A REASON AND CONDITION CODE IS RETURNED TO THE CALLING PROGRAM. 04125000 * IF READING COPY RECORDS, A DATE AND SEQUENCE CHECK CAN BE 1126 04126000 * SPECIFIED WHEN READING DIRECT. A REQUEST CAN BE HANDLED FOR THE 04127000 * LATEST BACKUP COPY, OLDEST BACKUP COPY OR LATEST COPY. WHEN 1126 04128000 * READING NEXT, A COPY ID MUST BE PROVIDED. 1126 04129000 * WHEN READING DUPLICATE VOLUME RECORDS, A READ DIRECT WILL GET THE 04130000 * FIRST DUPLICATE VOLUME RECORD WITH THE GIVEN VOLID. WHEN 1126 04131000 * READING NEXT, IF NO VOLID IS GIVEN, THE DUPLICATE ID IS IGNORED 04132000 * AND THE FIRST DUPLICATE VOLUME RECORD IS RETURNED. IF A VOLID IS 04133000 * SPECIFIED ON A READ NEXT, A DUPLICATE ID MUST BE GIVEN. THE 1126 04134000 * PROGRAM WILL RETURN THE DUPLICATE RECORD WITH THE NEXT HIGHER ID 04135000 * FROM THE GIVEN ID. THE PROGRAM WILL 1126 04136000 * CONTINUE READING DUPLICATE RECORDS UNTIL IT RUNS OUT UNLESS A BIT 04137000 * IS SET IN THE REQUEST BLOCK TELLING THAT ONLY THE DUPLICATE 1126 04138000 * RECORDS OF THE SPECIFIED VOLUME ARE TO BE RETURNED. 1126 04139000 * 1126 04140000 * WHEN READING A CARTRIDGE INDEX RECORD, THE CARTRIDGE RECORD IS 04141000 * READ AND THEN THE VOLUME RECORD OF THE VOLUME THAT OWNS THE 1126 04142000 * CARTRIDGE IS READ AND RETURNED TO THE CALLER. IF THE CARTRIDGE 04143000 * RECORD DOES NOT EXIST, A CONDITION AND REASON CODE IS RETURNED. 04144000 * IF THE VOLUME RECORD DOES NOT EXIST, A CONDITION AND REASON CODE 04145000 * IS RETURNED. ALSO FOR THIS ERROR CASE, THE CARTRIDGE INDEX RECORD 04146000 * IS RETURNED IN THE SAME MANNER THAT THE VOLUME RECORD WOULD 1126 04147000 * NORMALLY BE RETURNED. @Z40LB66 04148000 * 1126 04149000 * WHEN READING AN UNKNOWN RECORD, A CARTRIDGE SERIAL NUMBER MUST 04150000 * BE SPECIFIED IN ORDER TO READ THE CARTRIDGE INDEX RECORD. IF 1126 04151000 * THE CARTRIDGE RECORD DOES NOT EXIST, A CONDITION AND REASON 1126 04152000 * CODE IS RETURNED TO THE USER. IF A VOLUME ID IS SPECIFIED, 1126 04153000 * A CHECK IS MADE TO SEE IF IT MATCHES THE ONE IN THE 1126 04154000 * CARTRIDGE INDEX RECORD. IF THEY DO MATCH, THE BASE, COPY OR 1126 04155000 * DUPLICATE VOLUME RECORD THAT OWNS THE CARTRIDGE IS READ AND 1126 04156000 * RETURNED TO THE CALLING PROGRAM. IF THE VOLUME ID DOES NOT 1126 04157000 * MATCH, A REASON AND CONDITION CODE ARE RETURNED. IF THE VOLUME 04158000 * RECORD DOES NOT EXIST, THE CARTRIDGE RECORD AND A REASON AND 1126 04159000 * CONDITION CODE ARE RETURNED. @Z40LB66 04160000 * 1126 04161000 * TO READ A CPU ID RECORD, ONLY THE RVVCPURC FLAG NEEDS TO BE 1126 04162000 * SPECIFIED. @Z40LB66 04163000 * 1126 04164000 * TO READ ONLY A COPY VOLUME PLACE HOLDER RECORD RVVCPLHD 1126 04165000 * MUST BE SPECIFIED. IT IS NOT VALID WITH LATEST OR OLDEST 1126 04166000 * BACKUP OR WITH LATEST COPY. TO READ ONLY A BASE VOLUME PLACE 1126 04167000 * HOLDER RECORD RVVBPLHD MUST BE SPECIFIED. IT IS NOT 1126 04168000 * VALID WITH READ CHAIN. WITH RVVCPLHD OR RVVBPLHD EITHER 1126 04169000 * RVVRDR OR RVVRDNR MUST BE SPECIFIED. RVVALL IS NOT VALID WITH 1126 04170000 * READ CHAIN. IF RVVALL IS SPECIFIED WITH RVVCPYRC, THEN ALL COPY 04171000 * VOLUME RECORDS INCLUDING COPY PLACE HOLDERS WILL BE RETURNED. 1126 04172000 * ALSO, IF RVVALL IS SPECIFIED WITH RVVBVRCD, THEN ALL BASE 1126 04173000 * VOLUME AND BASE PLACE HOLDER RECORDS WILL BE RETURNED. @ZDR2053 04174000 * 1126 04175000 * INPUTS - REGISTER 1 CONTAINS THE ADDRESS OF THE RPLV. THIS HAS 04176000 * THE REQUEST BLOCK CONTAINING THE PARAMETERS NEEDED TO READ MSVI 04177000 * RECORDS. @Y30LB26 04178000 * 1126 04179000 * OUTPUTS - REASON AND RETURN CODES, PLUS THE RETURNED 1126 04180000 * RECORD, IF ONE WAS FOUND. THE RPLV CONTAINS THE RECORD 1126 04181000 * ADDRESS, PLUS THE RETURN AND REASON CODES. @Y30LB26 04182000 * 1126 04183000 * '021E'X VALID TYPE OF READ WAS NOT SPECIFIED @Y30LB26 04184000 * '0220'X READ UNKNOWN WITH NO CSN SPECIFIED @Y30LB26 04185000 * '0222'X TYPE RECORD TO READ NOT SPECIFIED @Y30LB26 04186000 * '0223'X RECORD(S) FOUND DID NOT MEET TESTS @Y30LB26 04187000 * '0208'X REQUESTED RECORD COULD NOT BE FOUND @Y30LB26 04188000 * '0224'X BREAK IN BASE VOLUME CHAIN (GRPED - NON-GRPED) @Y30LB26 04189000 * '0229'X TYPE OF COPY NOT SPECIFIED @Y30LB26 04190000 * '021F'X READ NEXT FOR DUP WITH NO DUP ID SPECIFIED @Y30LB26 04191000 * '021D'X VOLID IN THE CARTRIDGE INDEX RECORD DID NOT @Y30LB26 04192000 * MATCH THE SPECIFIED VOLID @Y30LB26 04193000 * '022A'X UNABLE TO GET BUFFER SPACE TO RETURN RECORD @Y30LB26 04194000 * '0221'X READ NEXT COPY WITH NO COPY ID SPECIFIED @Y30LB26 04195000 * '0230'X USER PROVIDED BUFFER AREA TOO SHORT FOR @Y30LB26 04196000 * RECORD BEING RETURNED. @Y30LB26 04197000 * '023C'X VOLUME RECORD DOES NOT EXIST FOR CARTRIDGE @Z40LB66 04198000 * PLUS ANY REASON CODES FROM THE I/O PROCESSOR @Y30LB26 04199000 **** END OF SPECIFICATIONS ** */ 04200000 * 1126 04201000 *READVVI: /* #Y30LB26*/ 04202000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 04203000 * 1126 04204000 READVVI ST @14,@SA00015 1126 04205000 * /*****************************************************************/ 04206000 * /* */ 04207000 * /* SET UP ADDRESSING TO REQUEST BLOCK #Y30LB26*/ 04208000 * /* */ 04209000 * /*****************************************************************/ 04210000 * 1127 04211000 * RVVIPTR=ADDR(RPLVUTIL); /* ADDR OF REQUEST BLK #Y30LB26*/ 04212000 * 1127 04213000 L RVVIPTR,RPLVPTR 1127 04214000 LA RVVIPTR,RPLVUTIL(,RVVIPTR) 1127 04215000 * /*****************************************************************/ 04216000 * /* */ 04217000 * /* INITILIZE LOOP INDICATOR #Y30LB26*/ 04218000 * /* */ 04219000 * /*****************************************************************/ 04220000 * 1128 04221000 * LOOPSW=OFF; /* INIT LOOP SW #Y30LB26*/ 04222000 * 1128 04223000 NI LOOPSW,B'01111111' 1128 04224000 * /*****************************************************************/ 04225000 * /* */ 04226000 * /* CHECK IF TYPE READ IS FOR BASE #Y30LB26*/ 04227000 * /* OR A PLACE HOLDER @ZDR2053*/ 04228000 * /* */ 04229000 * /*****************************************************************/ 04230000 * 1129 04231000 * IF RVVBVRCD=ON THEN /* READ BASE? #Y30LB26*/ 04232000 TM RVVBVRCD(RVVIPTR),B'10000000' 1129 04233000 BNO @RF01129 1129 04234000 * DO; /* @Y30LB26*/ 04235000 * 1130 04236000 * /*************************************************************/ 04237000 * /* */ 04238000 * /* DETERMINE TYPE OF READ TO DO ON BASE REC @Y30LB26*/ 04239000 * /* */ 04240000 * /*************************************************************/ 04241000 * 1131 04242000 * IF RVVRDR=ON THEN /* READ DIRECT? @Y30LB26*/ 04243000 TM RVVRDR(RVVIPTR),B'10000000' 1131 04244000 BNO @RF01131 1131 04245000 * DO; /* @Y30LB26*/ 04246000 * CALL BASEDIR; /* READ BASE DIRECT @Y30LB26*/ 04247000 BAL @14,BASEDIR 1133 04248000 * RETURN; /* @Y30LB26*/ 04249000 @EL00015 DS 0H 1134 04250000 @EF00015 DS 0H 1134 04251000 @ER00015 L @14,@SA00015 1134 04252000 BR @14 1134 04253000 * END; /* @Y30LB26*/ 04254000 * 1135 04255000 * /*************************************************************/ 04256000 * /* */ 04257000 * /* READ NEXT @Y30LB26*/ 04258000 * /* */ 04259000 * /*************************************************************/ 04260000 * 1136 04261000 * IF RVVRDNR=ON THEN /* READ NEXT? @Y30LB26*/ 04262000 @RF01131 TM RVVRDNR(RVVIPTR),B'01000000' 1136 04263000 BNO @RF01136 1136 04264000 * DO; /* @Y30LB26*/ 04265000 * CALL BASENREC; /* READ BASE NEXT @Y30LB26*/ 04266000 BAL @14,BASENREC 1138 04267000 * RETURN; /* @Y30LB26*/ 04268000 B @EL00015 1139 04269000 * END; /* @Y30LB26*/ 04270000 * 1140 04271000 * /*************************************************************/ 04272000 * /* */ 04273000 * /* READ CHAIN @Y30LB26*/ 04274000 * /* */ 04275000 * /*************************************************************/ 04276000 * 1141 04277000 * IF RVVRDCH=ON&RVVBPLHD=OFF&RVVALL=OFF THEN/* @ZDR2053 04278000 * BASE CHAIN? @ZDR2053*/ 04279000 @RF01136 TM RVVRDCH(RVVIPTR),B'00100000' 1141 04280000 BNO @RF01141 1141 04281000 TM RVVBPLHD(RVVIPTR),B'00000001' 1141 04282000 BNZ @RF01141 1141 04283000 TM RVVALL(RVVIPTR),B'00000001' 1141 04284000 BNZ @RF01141 1141 04285000 * DO; /* @Y30LB26*/ 04286000 * CALL BASECHN; /* READ CHAIN @Y30LB26*/ 04287000 BAL @14,BASECHN 1143 04288000 * RETURN; /* @Y30LB26*/ 04289000 B @EL00015 1144 04290000 * END; /* @Y30LB26*/ 04291000 * 1146 04292000 * /*************************************************************/ 04293000 * /* */ 04294000 * /* IF NOT READ DIRECT, NEXT OR CHAIN, SET ERROR CODE @Y30LB26*/ 04295000 * /* */ 04296000 * /*************************************************************/ 04297000 * 1146 04298000 * RPLVRETC=FOUR; /* SET BAD RC @Y30LB26*/ 04299000 @RF01141 L @02,RPLVPTR 1146 04300000 MVC RPLVRETC(2,@02),@CB00749 1146 04301000 * RPLRCODE=NOTYPRD; /* TYPE READ NOT SPEC @Y30LB26*/ 04302000 MVC RPLRCODE(2,@02),@CB00809 1147 04303000 * RETURN; /* @Y30LB26*/ 04304000 B @EL00015 1148 04305000 * END; /* @Y30LB26*/ 04306000 * 1149 04307000 * /*****************************************************************/ 04308000 * /* */ 04309000 * /* CHECK IF READ IS FOR GROUP RECORD @Y30LB26*/ 04310000 * /* */ 04311000 * /*****************************************************************/ 04312000 * 1150 04313000 * IF RVVGRPRC=ON THEN /* READ GROUP? @Y30LB26*/ 04314000 @RF01129 TM RVVGRPRC(RVVIPTR),B'01000000' 1150 04315000 BNO @RF01150 1150 04316000 * DO; /* @Y30LB26*/ 04317000 * 1151 04318000 * /*************************************************************/ 04319000 * /* */ 04320000 * /* READ DIRECT GROUP RECORD @Y30LB26*/ 04321000 * /* */ 04322000 * /*************************************************************/ 04323000 * 1152 04324000 * IF RVVRDR=ON THEN /* READ DIRECT? @Y30LB26*/ 04325000 TM RVVRDR(RVVIPTR),B'10000000' 1152 04326000 BNO @RF01152 1152 04327000 * DO; /* @Y30LB26*/ 04328000 * CALL GRPDIR; /* READ GROUP DIRECT @Y30LB26*/ 04329000 BAL @14,GRPDIR 1154 04330000 * RETURN; /* @Y30LB26*/ 04331000 B @EL00015 1155 04332000 * END; /* @Y30LB26*/ 04333000 * 1156 04334000 * /*************************************************************/ 04335000 * /* */ 04336000 * /* READ NEXT GROUP RECORD @Y30LB26*/ 04337000 * /* */ 04338000 * /*************************************************************/ 04339000 * 1157 04340000 * IF RVVRDNR=ON THEN /* READ NEXT? @Y30LB26*/ 04341000 @RF01152 TM RVVRDNR(RVVIPTR),B'01000000' 1157 04342000 BNO @RF01157 1157 04343000 * DO; /* @Y30LB26*/ 04344000 * CALL GRPNREC; /* READ GROUP NEXT @Y30LB26*/ 04345000 BAL @14,GRPNREC 1159 04346000 * RETURN; /* @Y30LB26*/ 04347000 B @EL00015 1160 04348000 * END; /* @Y30LB26*/ 04349000 * RPLVRETC=FOUR; /* BAD RC @Y30LB26*/ 04350000 @RF01157 L @02,RPLVPTR 1162 04351000 MVC RPLVRETC(2,@02),@CB00749 1162 04352000 * RPLRCODE=NOTYPRD; /* TYPE READ NOT SPEC @Y30LB26*/ 04353000 MVC RPLRCODE(2,@02),@CB00809 1163 04354000 * RETURN; /* @Y30LB26*/ 04355000 B @EL00015 1164 04356000 * END; /* @Y30LB26*/ 04357000 * 1166 04358000 * /*****************************************************************/ 04359000 * /* */ 04360000 * /* READ COPY RECORD OR COPY PLACE HOLDER RECORD @ZDR2053*/ 04361000 * /* */ 04362000 * /*****************************************************************/ 04363000 * 1166 04364000 * IF RVVCPYRC=ON THEN /* READ COPY? @Y30LB26*/ 04365000 @RF01150 TM RVVCPYRC(RVVIPTR),B'00100000' 1166 04366000 BNO @RF01166 1166 04367000 * DO; /* @Y30LB26*/ 04368000 * 1167 04369000 * /*************************************************************/ 04370000 * /* */ 04371000 * /* READCOPY RECORD DIRECT @Y30LB26*/ 04372000 * /* */ 04373000 * /*************************************************************/ 04374000 * 1168 04375000 * IF RVVRDR=ON THEN /* READ DIRECT? @Y30LB26*/ 04376000 TM RVVRDR(RVVIPTR),B'10000000' 1168 04377000 BNO @RF01168 1168 04378000 * DO; /* @Y30LB26*/ 04379000 * CALL COPYDIR; /* READ COPY DIRECT @Y30LB26*/ 04380000 BAL @14,COPYDIR 1170 04381000 * RETURN; /* @Y30LB26*/ 04382000 B @EL00015 1171 04383000 * END; /* @Y30LB26*/ 04384000 * 1172 04385000 * /*************************************************************/ 04386000 * /* */ 04387000 * /* READ NEXT COPY RECORD @Y30LB26*/ 04388000 * /* */ 04389000 * /*************************************************************/ 04390000 * 1173 04391000 * IF RVVRDNR=ON THEN /* READ NEXT COPY ? @Y30LB26*/ 04392000 @RF01168 TM RVVRDNR(RVVIPTR),B'01000000' 1173 04393000 BNO @RF01173 1173 04394000 * DO; /* @Y30LB26*/ 04395000 * CALL COPYNREC; /* READ NEXT COPY @Y30LB26*/ 04396000 BAL @14,COPYNREC 1175 04397000 * RETURN; /* @Y30LB26*/ 04398000 B @EL00015 1176 04399000 * END; /* @Y30LB26*/ 04400000 * 1177 04401000 * /*************************************************************/ 04402000 * /* */ 04403000 * /* MUST BE A READ DIRECT OR READ NEXT @Y30LB26*/ 04404000 * /* */ 04405000 * /*************************************************************/ 04406000 * 1178 04407000 * RPLVRETC=FOUR; /* BAD RETURN CODE @Y30LB26*/ 04408000 @RF01173 L @02,RPLVPTR 1178 04409000 MVC RPLVRETC(2,@02),@CB00749 1178 04410000 * RPLRCODE=NOTYPRD; /* NO READ OR NEXT @Y30LB26*/ 04411000 MVC RPLRCODE(2,@02),@CB00809 1179 04412000 * RETURN; /* @Y30LB26*/ 04413000 B @EL00015 1180 04414000 * END; /* @Y30LB26*/ 04415000 * 1182 04416000 * /*****************************************************************/ 04417000 * /* */ 04418000 * /* READ DUPLICATE RECORD @Y30LB26*/ 04419000 * /* */ 04420000 * /*****************************************************************/ 04421000 * 1182 04422000 * IF RVVDUPRC=ON THEN /* READ DUPLICATE? @Y30LB26*/ 04423000 @RF01166 TM RVVDUPRC(RVVIPTR),B'00010000' 1182 04424000 BNO @RF01182 1182 04425000 * DO; /* @Y30LB26*/ 04426000 * 1183 04427000 * /*************************************************************/ 04428000 * /* */ 04429000 * /* READ DIRECT DUP RECORD @Y30LB26*/ 04430000 * /* */ 04431000 * /*************************************************************/ 04432000 * 1184 04433000 * IF RVVRDR=ON THEN /* READ DIRECT? @Y30LB26*/ 04434000 TM RVVRDR(RVVIPTR),B'10000000' 1184 04435000 BNO @RF01184 1184 04436000 * DO; /* @Y30LB26*/ 04437000 * CALL DUPDIR; /* READ DUP DIRECT @Y30LB26*/ 04438000 BAL @14,DUPDIR 1186 04439000 * RETURN; /* @Y30LB26*/ 04440000 B @EL00015 1187 04441000 * END; /* @Y30LB26*/ 04442000 * 1188 04443000 * /*************************************************************/ 04444000 * /* */ 04445000 * /* REAR NEXT DUP RECORD @Y30LB26*/ 04446000 * /* */ 04447000 * /*************************************************************/ 04448000 * 1189 04449000 * IF RVVRDNR=ON THEN /* READ NEXT? @Y30LB26*/ 04450000 @RF01184 TM RVVRDNR(RVVIPTR),B'01000000' 1189 04451000 BNO @RF01189 1189 04452000 * DO; /* @Y30LB26*/ 04453000 * CALL DUPNREC; /* READ DUP NEXT @Y30LB26*/ 04454000 BAL @14,DUPNREC 1191 04455000 * RETURN; /* @Y30LB26*/ 04456000 B @EL00015 1192 04457000 * END; /* @Y30LB26*/ 04458000 * 1193 04459000 * /*************************************************************/ 04460000 * /* */ 04461000 * /* MUST BE READ DIRECT OR READ NEXT @Y30LB26*/ 04462000 * /* */ 04463000 * /*************************************************************/ 04464000 * 1194 04465000 * RPLVRETC=FOUR; /* BAD RC @Y30LB26*/ 04466000 @RF01189 L @02,RPLVPTR 1194 04467000 MVC RPLVRETC(2,@02),@CB00749 1194 04468000 * RPLRCODE=NOTYPRD; /* TYPE READ NOT SPEC @Y30LB26*/ 04469000 MVC RPLRCODE(2,@02),@CB00809 1195 04470000 * RETURN; /* @Y30LB26*/ 04471000 B @EL00015 1196 04472000 * END; /* @Y30LB26*/ 04473000 * 1198 04474000 * /*****************************************************************/ 04475000 * /* */ 04476000 * /* CHECK IF READ IS FOR CARTRIDGE INDEX RECORD @Z40LB66*/ 04477000 * /* */ 04478000 * /*****************************************************************/ 04479000 * 1198 04480000 * IF RVVCIRCD=ON THEN 1198 04481000 @RF01182 TM RVVCIRCD(RVVIPTR),B'00000100' 1198 04482000 BNO @RF01198 1198 04483000 * DO; /* @Z40LB66*/ 04484000 * 1199 04485000 * /*************************************************************/ 04486000 * /* */ 04487000 * /* CHECK FOR READ NEXT @Z40LB66*/ 04488000 * /* */ 04489000 * /*************************************************************/ 04490000 * 1200 04491000 * IF RVVRDNR=ON THEN 1200 04492000 TM RVVRDNR(RVVIPTR),B'01000000' 1200 04493000 BNO @RF01200 1200 04494000 * DO; /* @Z40LB66*/ 04495000 * CALL CARTNREC; /* @Z40LB66*/ 04496000 BAL @14,CARTNREC 1202 04497000 * RETURN; /* @Z40LB66*/ 04498000 B @EL00015 1203 04499000 * END; /* @Z40LB66*/ 04500000 * 1204 04501000 * /*************************************************************/ 04502000 * /* */ 04503000 * /* CHECK FOR READ DIRECT @Z40LB66*/ 04504000 * /* */ 04505000 * /*************************************************************/ 04506000 * 1205 04507000 * IF RVVRDR=ON THEN 1205 04508000 @RF01200 TM RVVRDR(RVVIPTR),B'10000000' 1205 04509000 BNO @RF01205 1205 04510000 * DO; /* @Z40LB66*/ 04511000 * CALL CARTDIR; /* @Z40LB66*/ 04512000 BAL @14,CARTDIR 1207 04513000 * RETURN; /* @Z40LB66*/ 04514000 B @EL00015 1208 04515000 * END; /* @Z40LB66*/ 04516000 * 1209 04517000 * /*************************************************************/ 04518000 * /* */ 04519000 * /* MUST BE READ DIRECT OR READ NEXT @Z40LB66*/ 04520000 * /* */ 04521000 * /*************************************************************/ 04522000 * 1210 04523000 * RPLVRETC=FOUR; /* BAD RC @Z40LB66*/ 04524000 @RF01205 L @02,RPLVPTR 1210 04525000 MVC RPLVRETC(2,@02),@CB00749 1210 04526000 * RPLRCODE=NOTYPRD; /* TYPE READ NOT SPEC @Z40LB66*/ 04527000 MVC RPLRCODE(2,@02),@CB00809 1211 04528000 * RETURN; /* @Z40LB66*/ 04529000 B @EL00015 1212 04530000 * END; /* @Z40LB66*/ 04531000 * 1214 04532000 * /*****************************************************************/ 04533000 * /* */ 04534000 * /* READ UNKNOWN RECORD @Y30LB26*/ 04535000 * /* */ 04536000 * /*****************************************************************/ 04537000 * 1214 04538000 * IF RVVRUNKN=ON THEN /* READ UNKNOWN? @Y30LB26*/ 04539000 @RF01198 TM RVVRUNKN(RVVIPTR),B'00001000' 1214 04540000 BNO @RF01214 1214 04541000 * DO; /* @Y30LB26*/ 04542000 * 1215 04543000 * /*************************************************************/ 04544000 * /* */ 04545000 * /* CHECK TO SEE IF CART SERIAL SPEC @Y30LB26*/ 04546000 * /* */ 04547000 * /*************************************************************/ 04548000 * 1216 04549000 * IF RVVSCSN=OFF THEN /* CARTRIDGE SPECIFIED? @Y30LB26*/ 04550000 TM RVVSCSN(RVVIPTR),B'00001000' 1216 04551000 BNZ @RF01216 1216 04552000 * DO; /* @Y30LB26*/ 04553000 * RPLRCODE=NOCART; /* NO CARTRIDGE GIVEN @Y30LB26*/ 04554000 L @02,RPLVPTR 1218 04555000 MVC RPLRCODE(2,@02),@CB00813 1218 04556000 * RPLVRETC=FOUR; /* BAD RC @Y30LB26*/ 04557000 MVC RPLVRETC(2,@02),@CB00749 1219 04558000 * RETURN; /* @Y30LB26*/ 04559000 B @EL00015 1220 04560000 * END; /* @Y30LB26*/ 04561000 * ELSE /* @Y30LB26*/ 04562000 * 1222 04563000 * /***********************************************************/ 04564000 * /* */ 04565000 * /* IF SERIAL SPEC, GO READ CART AND VOL RECS @Y30LB26*/ 04566000 * /* */ 04567000 * /***********************************************************/ 04568000 * 1222 04569000 * DO; /* @Y30LB26*/ 04570000 @RF01216 DS 0H 1223 04571000 * CALL CARTDIR; /* READ CARTRIDGE @Z40LB66*/ 04572000 BAL @14,CARTDIR 1223 04573000 * RETURN; /* @Y30LB26*/ 04574000 B @EL00015 1224 04575000 * END; /* @Y30LB26*/ 04576000 * END; /* @Y30LB26*/ 04577000 * IF RVVCPURC=ON THEN /* READ CPU ID RECORD ? @Z40LB66*/ 04578000 @RF01214 TM RVVCPURC(RVVIPTR),B'00000010' 1227 04579000 BNO @RF01227 1227 04580000 * DO; /* @Z40LB66*/ 04581000 * CALL READCPU; /* @Z40LB66*/ 04582000 BAL @14,READCPU 1229 04583000 * RETURN; /* @Z40LB66*/ 04584000 B @EL00015 1230 04585000 * END; /* @Z40LB66*/ 04586000 * ELSE /* @Y30LB26*/ 04587000 * 1232 04588000 * /***************************************************************/ 04589000 * /* */ 04590000 * /* TYPE OF RECORD TO READ NOT SPECIFIED @Y30LB26*/ 04591000 * /* */ 04592000 * /***************************************************************/ 04593000 * 1232 04594000 * DO; /* @Y30LB26*/ 04595000 @RF01227 DS 0H 1233 04596000 * RPLVRETC=FOUR; /* BAD RC @Y30LB26*/ 04597000 L @02,RPLVPTR 1233 04598000 MVC RPLVRETC(2,@02),@CB00749 1233 04599000 * RPLRCODE=NORECTYP; /* REC TYPE NOT GIVEN @Y30LB26*/ 04600000 MVC RPLRCODE(2,@02),@CB00817 1234 04601000 * RETURN; /* @Y30LB26*/ 04602000 B @EL00015 1235 04603000 * END; /* @Y30LB26*/ 04604000 * END READVVI; /* @Y30LB26*/ 04605000 * 1238 04606000 * /*****************************************************************/ 04607000 * /* */ 04608000 * /* THIS ROUTINE READS A CPU ID RECORD @Z40LB66*/ 04609000 * /* */ 04610000 * /*****************************************************************/ 04611000 * 1238 04612000 *READCPU: /* @Z40LB66*/ 04613000 * PROC OPTIONS(SAVE(REG14)); /* @Z40LB66*/ 04614000 * 1238 04615000 READCPU ST @14,@SA00016 1238 04616000 * /*****************************************************************/ 04617000 * /* */ 04618000 * /* GO RESERVE INVENTORY DATA SET SHARED @Z40LB66*/ 04619000 * /* */ 04620000 * /*****************************************************************/ 04621000 * 1239 04622000 * CALL RESSHARE; /* RESERVE INVENTORY SHR @Z40LB66*/ 04623000 * 1239 04624000 BAL @14,RESSHARE 1239 04625000 * /*****************************************************************/ 04626000 * /* */ 04627000 * /* SET UP TO READ THE CPU ID RECORD @Z40LB66*/ 04628000 * /* */ 04629000 * /*****************************************************************/ 04630000 * 1240 04631000 * RPLVKEY=ADDR(CKEY); /* ADDR OF KEY @Z40LB66*/ 04632000 L @04,RPLVPTR 1240 04633000 LA @02,CKEY 1240 04634000 ST @02,RPLVKEY(,@04) 1240 04635000 * RPLVLOC=ON; /* LOCATE MODE @Z40LB66*/ 04636000 * RPLVDIR=ON; /* READ DIRECT @Z40LB66*/ 04637000 OI RPLVLOC(@04),B'11000000' 1242 04638000 * RPLVTYP=RPLVREAD; /* READ RECORD @Z40LB66*/ 04639000 MVI RPLVTYP(@04),X'00' 1243 04640000 * RESPECIFY 1244 04641000 * REG1 RESTRICTED; /* RESTRICT REG1 @Z40LB66*/ 04642000 * REG1=RPLVPTR; /* ADDR OF RPLV @Z40LB66*/ 04643000 LR REG1,@04 1245 04644000 * CALL ICBVIO00; /* READ CPUID RECORD @Z40LB66*/ 04645000 L @15,@CV00671 1246 04646000 BALR @14,@15 1246 04647000 * RESPECIFY 1247 04648000 * REG1 UNRESTRICTED; /* UNRESTRICT REG1 @Z40LB66*/ 04649000 * 1247 04650000 * /*****************************************************************/ 04651000 * /* */ 04652000 * /* CHECK RETURN CODE FROM I/O PROCESSOR @Z40LB66*/ 04653000 * /* */ 04654000 * /*****************************************************************/ 04655000 * 1248 04656000 * IF RPLVRETC^=RCZERO THEN /* CHECK RC @Z40LB66*/ 04657000 L @04,RPLVPTR 1248 04658000 CLC RPLVRETC(2,@04),@CB00747 1248 04659000 BE @RF01248 1248 04660000 * DO; /* @Z40LB66*/ 04661000 * CALL ERREXIT; /* SAVE REASON CODES @Z40LB66*/ 04662000 BAL @14,ERREXIT 1250 04663000 * RETURN; /* @Z40LB66*/ 04664000 @EL00016 DS 0H 1251 04665000 @EF00016 DS 0H 1251 04666000 @ER00016 L @14,@SA00016 1251 04667000 BR @14 1251 04668000 * END; /* @Z40LB66*/ 04669000 * 1252 04670000 * /*****************************************************************/ 04671000 * /* */ 04672000 * /* GET CORE IN SUBPOOL TO MOVE RECORD INTO @Z40LB66*/ 04673000 * /* */ 04674000 * /*****************************************************************/ 04675000 * 1253 04676000 * CALL GETBUF; /* GET BUFFER FOR REC @Z40LB66*/ 04677000 @RF01248 BAL @14,GETBUF 1253 04678000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @Z40LB66*/ 04679000 L @04,RPLVPTR 1254 04680000 CLC RPLVRETC(2,@04),@CB00747 1254 04681000 BNE @RT01254 1254 04682000 * RETURN; /* @Z40LB66*/ 04683000 * CPUIDPTR=RPLVBUF; /* SET BASE TO RECORD @Z40LB66*/ 04684000 L @02,RPLVPTR 1256 04685000 L CPUIDPTR,RPLVBUF(,@02) 1256 04686000 * BUFFER=CPUID; /* MOVE REC TO BUF @Z40LB66*/ 04687000 L @01,RVVAREA(,RVVIPTR) 1257 04688000 MVI BUFFER+151(@01),C' ' 1257 04689000 MVC BUFFER+152(104,@01),BUFFER+151(@01) 1257 04690000 MVC BUFFER(151,@01),CPUID(CPUIDPTR) 1257 04691000 * RPLRCODE=RCZERO; /* GOOD REASON CODE @Z40LB66*/ 04692000 MVC RPLRCODE(2,@02),@CB00747 1258 04693000 * RPLVRETC=RCZERO; /* GOOD RC @Z40LB66*/ 04694000 MVC RPLVRETC(2,@02),@CB00747 1259 04695000 * RETURN; /* @Z40LB66*/ 04696000 B @EL00016 1260 04697000 * END READCPU; /* @Z40LB66*/ 04698000 B @EL00016 1261 04699000 * 1262 04700000 * /*****************************************************************/ 04701000 * /* */ 04702000 * /* THIS ROUTINE READS A BASE VOLUME RECORD DIRECTLY @Y30LB26*/ 04703000 * /* FROM KEY PASSED IN REQUEST BLOCK @Y30LB26*/ 04704000 * /* */ 04705000 * /*****************************************************************/ 04706000 * 1262 04707000 *BASEDIR: /* @Y30LB26*/ 04708000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 04709000 * 1262 04710000 BASEDIR ST @14,@SA00017 1262 04711000 * /*****************************************************************/ 04712000 * /* */ 04713000 * /* GO RESERVE INVENTORY DATA SET SHARED @Y30LB26*/ 04714000 * /* */ 04715000 * /*****************************************************************/ 04716000 * 1263 04717000 * CALL RESSHARE; /* RESERVE INVENTORY SHR @Y30LB26*/ 04718000 * 1263 04719000 BAL @14,RESSHARE 1263 04720000 * /*****************************************************************/ 04721000 * /* */ 04722000 * /* SET UP TO READ BASE VOLUME RECORD @Y30LB26*/ 04723000 * /* */ 04724000 * /*****************************************************************/ 04725000 * 1264 04726000 * VOLKY=RVVOLUME; /* VOL TO BE READ @Y30LB26*/ 04727000 MVC VOLKY(6),RVVOLUME(RVVIPTR) 1264 04728000 * RPLVKEY=ADDR(VKEY); /* ADDR OF KEY @Y30LB26*/ 04729000 L @04,RPLVPTR 1265 04730000 LA @02,VKEY 1265 04731000 ST @02,RPLVKEY(,@04) 1265 04732000 * RPLVLOC=ON; /* LOCATE MODE @Y30LB26*/ 04733000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 04734000 OI RPLVLOC(@04),B'11000000' 1267 04735000 * RPLVTYP=RPLVREAD; /* READ RECORD @Y30LB26*/ 04736000 MVI RPLVTYP(@04),X'00' 1268 04737000 * RESPECIFY 1269 04738000 * REG1 RESTRICTED; /* RESTRICT REG1 @Y30LB26*/ 04739000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 04740000 LR REG1,@04 1270 04741000 * CALL ICBVIO00; /* READ BASE RECORD @Y30LB26*/ 04742000 L @15,@CV00671 1271 04743000 BALR @14,@15 1271 04744000 * RESPECIFY 1272 04745000 * REG1 UNRESTRICTED; /* UNRESTRICT REG1 @Y30LB26*/ 04746000 * 1272 04747000 * /*****************************************************************/ 04748000 * /* */ 04749000 * /* CHECK RETURN CODE FROM I/O PROCESSOR @Y30LB26*/ 04750000 * /* */ 04751000 * /*****************************************************************/ 04752000 * 1273 04753000 * IF RPLVRETC^=RCZERO THEN /* CHECK RC @Y30LB26*/ 04754000 L @04,RPLVPTR 1273 04755000 CLC RPLVRETC(2,@04),@CB00747 1273 04756000 BE @RF01273 1273 04757000 * DO; /* @Y30LB26*/ 04758000 * CALL ERREXIT; /* SAVE REASON CODES @Y30LB26*/ 04759000 BAL @14,ERREXIT 1275 04760000 * RETURN; /* @Y30LB26*/ 04761000 @EL00017 DS 0H 1276 04762000 @EF00017 DS 0H 1276 04763000 @ER00017 L @14,@SA00017 1276 04764000 BR @14 1276 04765000 * END; /* @Y30LB26*/ 04766000 * 1277 04767000 * /*****************************************************************/ 04768000 * /* */ 04769000 * /* SET UP ADDRESSING TO BASE VOL REC @Y30LB26*/ 04770000 * /* AND MAKE ANY TEST CALLED FOR ON RECORD @Y30LB26*/ 04771000 * /* */ 04772000 * /*****************************************************************/ 04773000 * 1278 04774000 * BASEVPTR=RPLVBUF; /* MAPPING ON RECORD @Y30LB26*/ 04775000 @RF01273 L @04,RPLVPTR 1278 04776000 L @04,RPLVBUF(,@04) 1278 04777000 ST @04,BASEVPTR 1278 04778000 * CALL TEST; /* TEST RECORD @Y30LB26*/ 04779000 BAL @14,TEST 1279 04780000 * IF RPLVRETC^=RCZERO THEN /* CHECK RC @Y30LB26*/ 04781000 L @04,RPLVPTR 1280 04782000 CLC RPLVRETC(2,@04),@CB00747 1280 04783000 BE @RF01280 1280 04784000 * DO; /* @Y30LB26*/ 04785000 * CALL ERREXIT; /* SAVE CODES @Y30LB26*/ 04786000 BAL @14,ERREXIT 1282 04787000 * RETURN; /* @Y30LB26*/ 04788000 B @EL00017 1283 04789000 * END; /* @Y30LB26*/ 04790000 * 1284 04791000 * /*****************************************************************/ 04792000 * /* */ 04793000 * /* GET CORE IN SUBPOOL TO MOVE RECORD INTO @Y30LB26*/ 04794000 * /* */ 04795000 * /*****************************************************************/ 04796000 * 1285 04797000 * CALL GETBUF; /* GET BUFFER FOR REC @Y30LB26*/ 04798000 @RF01280 BAL @14,GETBUF 1285 04799000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @Y30LB26*/ 04800000 L @04,RPLVPTR 1286 04801000 CLC RPLVRETC(2,@04),@CB00747 1286 04802000 BNE @RT01286 1286 04803000 * RETURN; /* @Y30LB26*/ 04804000 * BUFFER=BASEV; /* MOVE REC TO BUF @Y30LB26*/ 04805000 L @02,RVVAREA(,RVVIPTR) 1288 04806000 MVI BUFFER+224(@02),C' ' 1288 04807000 MVC BUFFER+225(31,@02),BUFFER+224(@02) 1288 04808000 L @01,BASEVPTR 1288 04809000 MVC BUFFER(224,@02),BASEV(@01) 1288 04810000 * RPLRCODE=RCZERO; /* GOOD REASON CODE @Y30LB26*/ 04811000 MVC RPLRCODE(2,@04),@CB00747 1289 04812000 * RPLVRETC=RCZERO; /* GOOD RC @Y30LB26*/ 04813000 MVC RPLVRETC(2,@04),@CB00747 1290 04814000 * RETURN; /* @Y30LB26*/ 04815000 B @EL00017 1291 04816000 * END BASEDIR; /* @Y30LB26*/ 04817000 B @EL00017 1292 04818000 * 1293 04819000 * /*****************************************************************/ 04820000 * /* */ 04821000 * /* SUBROUTINE READS NEXT BASE VOLUME RECORD @Y30LB26*/ 04822000 * /* */ 04823000 * /*****************************************************************/ 04824000 * 1293 04825000 *BASENREC: /* @Y30LB26*/ 04826000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 04827000 * 1293 04828000 BASENREC ST @14,@SA00018 1293 04829000 * /*****************************************************************/ 04830000 * /* */ 04831000 * /* GO RESERVE INVENTORY DATA SET SHARED @Y30LB26*/ 04832000 * /* */ 04833000 * /*****************************************************************/ 04834000 * 1294 04835000 * CALL RESSHARE; /* RESERVE INVENTORY SHR @Y30LB26*/ 04836000 * 1294 04837000 BAL @14,RESSHARE 1294 04838000 * /*****************************************************************/ 04839000 * /* */ 04840000 * /* DETERMINE IF READING FOR FIRST BASE VOLUME @Y30LB26*/ 04841000 * /* RECORD. IF SO SET VOL TO ZERO AND PROCESS @Y30LB26*/ 04842000 * /* LIKE A REGULAR READ NEXT @Y30LB26*/ 04843000 * /* */ 04844000 * /*****************************************************************/ 04845000 * 1295 04846000 * IF RVVSVOL=OFF THEN /* VOLUME NAME SPECIF @Y30LB26*/ 04847000 TM RVVSVOL(RVVIPTR),B'00000001' 1295 04848000 BNZ @RF01295 1295 04849000 * VOLKY=ZEROCHAR; /* SET VOL KEY ZERO @Y30LB26*/ 04850000 MVC VOLKY(6),ZEROCHAR 1296 04851000 * ELSE /* @Y30LB26*/ 04852000 * VOLKY=RVVOLUME; /* VOL TO READ @Y30LB26*/ 04853000 * 1297 04854000 B @RC01295 1297 04855000 @RF01295 MVC VOLKY(6),RVVOLUME(RVVIPTR) 1297 04856000 * /*****************************************************************/ 04857000 * /* */ 04858000 * /* START OUTSIDE READ NEXT LOOP @Y30LB26*/ 04859000 * /* */ 04860000 * /*****************************************************************/ 04861000 * 1298 04862000 * DO WHILE I=I; /* BIG LOOP @Y30LB26*/ 04863000 * 1298 04864000 @RC01295 B @DE01298 1298 04865000 @DL01298 DS 0H 1299 04866000 * /***************************************************************/ 04867000 * /* */ 04868000 * /* SET KEY TO SKIP AROUND COPIES AND READ NEXT BASE @Y30LB26*/ 04869000 * /* */ 04870000 * /***************************************************************/ 04871000 * 1299 04872000 * ARITHBAS=VKEY(12:13); /* MOVE EXIST KEY ID @Y30LB26*/ 04873000 MVC ARITHBAS(2),VKEY+11 1299 04874000 * BASEID=BASEID+256; /* GET TO NEXT BASE @Y30LB26*/ 04875000 LA @04,256 1300 04876000 LH @02,BASEID 1300 04877000 N @02,@CF01186 1300 04878000 ALR @04,@02 1300 04879000 STH @04,BASEID 1300 04880000 * VKEY(12:13)=ARITHBAS; /* RESULT BACK TO KEY @Y30LB26*/ 04881000 MVC VKEY+11(2),ARITHBAS 1301 04882000 * RPLVKEY=ADDR(VKEY); /* ADDR OF KEY @Y30LB26*/ 04883000 L @04,RPLVPTR 1302 04884000 LA @02,VKEY 1302 04885000 ST @02,RPLVKEY(,@04) 1302 04886000 * RPLVLOC=ON; /* LOCATE MODE @Y30LB26*/ 04887000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 04888000 OI RPLVLOC(@04),B'11000000' 1304 04889000 * RPLVTYP=RPLVREAD; /* READ RECORD @Y30LB26*/ 04890000 MVI RPLVTYP(@04),X'00' 1305 04891000 * RPLVKGE=ON; /* READ >= @Y30LB26*/ 04892000 OI RPLVKGE(@04),B'00000100' 1306 04893000 * RESPECIFY 1307 04894000 * REG1 RSTD; /* RESTRICT REG1 @Y30LB26*/ 04895000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 04896000 LR REG1,@04 1308 04897000 * CALL ICBVIO00; /* READ NEXT BASE @Y30LB26*/ 04898000 L @15,@CV00671 1309 04899000 BALR @14,@15 1309 04900000 * RESPECIFY 1310 04901000 * REG1 UNRSTD; /* UNRESTRICT REG1 @Y30LB26*/ 04902000 * 1310 04903000 * /***************************************************************/ 04904000 * /* */ 04905000 * /* CHECK RETURN CODE @Y30LB26*/ 04906000 * /* */ 04907000 * /***************************************************************/ 04908000 * 1311 04909000 * IF RPLVRETC^=RCZERO THEN /* CHECK RC @Y30LB26*/ 04910000 L @04,RPLVPTR 1311 04911000 CLC RPLVRETC(2,@04),@CB00747 1311 04912000 BE @RF01311 1311 04913000 * DO; /* @Y30LB26*/ 04914000 * 1312 04915000 * /***********************************************************/ 04916000 * /* */ 04917000 * /* IF RECORDS READ BEFORE, THEN CHECK TYPE @Y30LB26*/ 04918000 * /* OF RETURN FROM I/O PROCESSOR @Y30LB26*/ 04919000 * /* */ 04920000 * /***********************************************************/ 04921000 * 1313 04922000 * IF LOOPSW=ON THEN /* SEE READ RECS BEFORE @Y30LB26*/ 04923000 TM LOOPSW,B'10000000' 1313 04924000 BNO @RF01313 1313 04925000 * DO; /* @Y30LB26*/ 04926000 * 1314 04927000 * /*******************************************************/ 04928000 * /* */ 04929000 * /* IF RECORDS READ AND AT END OF DATA SET, @Y30LB26*/ 04930000 * /* THEN SET RETURN CODE TO TEST NOT MET @Y30LB26*/ 04931000 * /* */ 04932000 * /*******************************************************/ 04933000 * 1315 04934000 * IF RPLRCODE=NORECRC THEN/* END OF DATA ? @Y30LB26*/ 04935000 CLC RPLRCODE(2,@04),@CB00789 1315 04936000 BNE @RF01315 1315 04937000 * DO; /* @Y30LB26*/ 04938000 * RPLRCODE=TNOTMET; /* INDIC TEST MADE @Y30LB26*/ 04939000 MVC RPLRCODE(2,@04),@CB00819 1317 04940000 * RPLVRETC=FOUR; /* INSURE RC FOUR @Y30LB26*/ 04941000 MVC RPLVRETC(2,@04),@CB00749 1318 04942000 * CALL ERREXIT; /* SAVE RET CODE @Y30LB26*/ 04943000 BAL @14,ERREXIT 1319 04944000 * RETURN; /* @Y30LB26*/ 04945000 @EL00018 DS 0H 1320 04946000 @EF00018 DS 0H 1320 04947000 @ER00018 L @14,@SA00018 1320 04948000 BR @14 1320 04949000 * END; /* @Y30LB26*/ 04950000 * 1321 04951000 * /*******************************************************/ 04952000 * /* */ 04953000 * /* IF SOME OTHER RETURN CODE, THEN JUST @Y30LB26*/ 04954000 * /* RETURN WITH IT @Y30LB26*/ 04955000 * /* */ 04956000 * /*******************************************************/ 04957000 * 1322 04958000 * ELSE /* #Y30LB26*/ 04959000 * DO; /* #Y30LB26*/ 04960000 @RF01315 DS 0H 1323 04961000 * CALL ERREXIT; /* SAVE RET CODES #Y30LB26*/ 04962000 BAL @14,ERREXIT 1323 04963000 * RETURN; /* #Y30LB26*/ 04964000 B @EL00018 1324 04965000 * END; /* #Y30LB26*/ 04966000 * END; /* #Y30LB26*/ 04967000 * 1326 04968000 * /***********************************************************/ 04969000 * /* */ 04970000 * /* IF NO RECORDS WERE READ THEN JUST RETURN @Y30LB26*/ 04971000 * /* WITH ORIGINAL RETURN CODES FROM I/O PROC @Y30LB26*/ 04972000 * /* */ 04973000 * /***********************************************************/ 04974000 * 1327 04975000 * ELSE /* #Y30LB26*/ 04976000 * DO; /* #Y30LB26*/ 04977000 @RF01313 DS 0H 1328 04978000 * CALL ERREXIT; /* #Y30LB26*/ 04979000 BAL @14,ERREXIT 1328 04980000 * RETURN; /* #Y30LB26*/ 04981000 B @EL00018 1329 04982000 * END; /* #Y30LB26*/ 04983000 * END; /* #Y30LB26*/ 04984000 * 1331 04985000 * /***************************************************************/ 04986000 * /* */ 04987000 * /* CHECK TO SEE IF STILL A BASE VOLUME RECORD #Y30LB26*/ 04988000 * /* */ 04989000 * /***************************************************************/ 04990000 * 1332 04991000 * BASEVPTR=RPLVBUF; /* ADDR REC JUST READ #Y30LB26*/ 04992000 @RF01311 L @04,RPLVPTR 1332 04993000 L @04,RPLVBUF(,@04) 1332 04994000 ST @04,BASEVPTR 1332 04995000 * IF BASEVKEY=VKY& /* #Y30LB26*/ 04996000 * BASZERO=FIXZERO THEN /* BASE VOL? @Y30LB26*/ 04997000 CLC BASEVKEY(5,@04),VKY 1333 04998000 BNE @RF01333 1333 04999000 CLI BASZERO(@04),0 1333 05000000 BNE @RF01333 1333 05001000 * DO; /* @Y30LB26*/ 05002000 * 1334 05003000 * /***********************************************************/ 05004000 * /* */ 05005000 * /* GO TEST RECORD SINCE IT IS A BASE VOLUME REC @Y30LB26*/ 05006000 * /* */ 05007000 * /***********************************************************/ 05008000 * 1335 05009000 * CALL TEST; /* TEST BASE REC @Y30LB26*/ 05010000 BAL @14,TEST 1335 05011000 * IF RPLVRETC=RCZERO THEN /* TEST MET? @Y30LB26*/ 05012000 L @04,RPLVPTR 1336 05013000 CLC RPLVRETC(2,@04),@CB00747 1336 05014000 BNE @RF01336 1336 05015000 * DO; /* @Y30LB26*/ 05016000 * 1337 05017000 * /*******************************************************/ 05018000 * /* */ 05019000 * /* IF PASSED TEST, GET BUFFER AND MOVE IN REC @Y30LB26*/ 05020000 * /* */ 05021000 * /*******************************************************/ 05022000 * 1338 05023000 * CALL GETBUF; /* GET SUBPOOL BUFFER @Y30LB26*/ 05024000 BAL @14,GETBUF 1338 05025000 * IF RPLVRETC^=RCZERO THEN/* CK RETURN @Y30LB26*/ 05026000 L @04,RPLVPTR 1339 05027000 CLC RPLVRETC(2,@04),@CB00747 1339 05028000 BNE @RT01339 1339 05029000 * RETURN; /* @Y30LB26*/ 05030000 * BUFFER=BASEV; /* MOVE REC TO BUFFER @Y30LB26*/ 05031000 L @02,RVVAREA(,RVVIPTR) 1341 05032000 MVI BUFFER+224(@02),C' ' 1341 05033000 MVC BUFFER+225(31,@02),BUFFER+224(@02) 1341 05034000 L @01,BASEVPTR 1341 05035000 MVC BUFFER(224,@02),BASEV(@01) 1341 05036000 * RPLVRETC=RCZERO; /* GOOD RC @Y30LB26*/ 05037000 MVC RPLVRETC(2,@04),@CB00747 1342 05038000 * RPLRCODE=RCZERO; /* GOOD REASON CODE @Y30LB26*/ 05039000 MVC RPLRCODE(2,@04),@CB00747 1343 05040000 * RETURN; /* @Y30LB26*/ 05041000 B @EL00018 1344 05042000 * END; /* @Y30LB26*/ 05043000 * ELSE /* @Y30LB26*/ 05044000 * 1346 05045000 * /*********************************************************/ 05046000 * /* */ 05047000 * /* RESET KEY TO VOL JUST READ SO WHEN ADD @Y30LB26*/ 05048000 * /* 256 TO KEY IT IS SET TO READ NEXT BASE VOLUME @Y30LB26*/ 05049000 * /* ALSO INDICATE LOOPING HAS OCCURED @Y30LB26*/ 05050000 * /* */ 05051000 * /*********************************************************/ 05052000 * 1346 05053000 * DO; /* @Y30LB26*/ 05054000 @RF01336 DS 0H 1347 05055000 * VKEY=BASNAME; /* SET TO ADD 256 @Y30LB26*/ 05056000 L @04,BASEVPTR 1347 05057000 MVC VKEY(13),BASNAME(@04) 1347 05058000 * LOOPSW=ON; /* INDICATE LOOPING @Y30LB26*/ 05059000 OI LOOPSW,B'10000000' 1348 05060000 * END; /* @Y30LB26*/ 05061000 * END; /* @Y30LB26*/ 05062000 * ELSE /* @Y30LB26*/ 05063000 * DO; /* @Y30LB26*/ 05064000 * 1351 05065000 B @RC01333 1351 05066000 @RF01333 DS 0H 1352 05067000 * /***********************************************************/ 05068000 * /* */ 05069000 * /* IF THIS IS A COPY VOLUME OR COPY PLACE @ZA13504*/ 05070000 * /* HOLDER, THEN GET NEXT BASE VOLUME RECORD @ZA13504*/ 05071000 * /* FROM INVENTORY. @ZA13504*/ 05072000 * /* */ 05073000 * /***********************************************************/ 05074000 * 1352 05075000 * IF BASEVKEY=VKY THEN /* IS THIS A BASE RECORD @ZA13504*/ 05076000 L @04,BASEVPTR 1352 05077000 CLC BASEVKEY(5,@04),VKY 1352 05078000 BNE @RF01352 1352 05079000 * DO; /* YES @ZA13504*/ 05080000 * VKEY=BASNAME; /* SET TO AD 256 TO KEY @ZA13504*/ 05081000 MVC VKEY(13),BASNAME(@04) 1354 05082000 * VIDKY=FIXZERO; /* ZERO KEY @ZA13504*/ 05083000 MVI VIDKY,X'00' 1355 05084000 * END; /* @ZA13504*/ 05085000 * ELSE /* NO, NOT BASE RECORD @ZA13504*/ 05086000 * DO; /* @ZA13504*/ 05087000 * 1357 05088000 B @RC01352 1357 05089000 @RF01352 DS 0H 1358 05090000 * /*******************************************************/ 05091000 * /* */ 05092000 * /* IF LOOPING HAS OCCURED, SET RETURN CODE @Y30LB26*/ 05093000 * /* INDICATING TEST NOT MET RATHER THAN @Y30LB26*/ 05094000 * /* RECORD NOT FOUND @Y30LB26*/ 05095000 * /* */ 05096000 * /*******************************************************/ 05097000 * 1358 05098000 * IF LOOPSW=ON THEN /* CHECK FOR LOOPING @Y30LB26*/ 05099000 TM LOOPSW,B'10000000' 1358 05100000 BNO @RF01358 1358 05101000 * DO; /* @Y30LB26*/ 05102000 * RPLVRETC=FOUR; /* BAD RC @Y30LB26*/ 05103000 L @02,RPLVPTR 1360 05104000 MVC RPLVRETC(2,@02),@CB00749 1360 05105000 * RPLRCODE=TNOTMET; /* TEST NOT MET @Y30LB26*/ 05106000 MVC RPLRCODE(2,@02),@CB00819 1361 05107000 * CALL ERREXIT; /* FREE INVENTORY @Y30LB26*/ 05108000 BAL @14,ERREXIT 1362 05109000 * RETURN; /* @Y30LB26*/ 05110000 B @EL00018 1363 05111000 * END; /* @Y30LB26*/ 05112000 * ELSE /* @Y30LB26*/ 05113000 * 1365 05114000 * /*****************************************************/ 05115000 * /* */ 05116000 * /* IF LOOPING HAS NOT OCCURED,SET RETURN CODE */ 05117000 * /* @Y30LB26*/ 05118000 * /* TO INDICATE RECORD WAS NOT FOUND @Y30LB26*/ 05119000 * /* */ 05120000 * /*****************************************************/ 05121000 * 1365 05122000 * DO; /* @Y30LB26*/ 05123000 @RF01358 DS 0H 1366 05124000 * RPLVRETC=FOUR; /* BAD RC @Y30LB26*/ 05125000 L @02,RPLVPTR 1366 05126000 MVC RPLVRETC(2,@02),@CB00749 1366 05127000 * RPLRCODE=NORECRC; /* RECORD NOT FOUND @Y30LB26*/ 05128000 MVC RPLRCODE(2,@02),@CB00789 1367 05129000 * CALL ERREXIT; /* FREE INVENTORY @Y30LB26*/ 05130000 BAL @14,ERREXIT 1368 05131000 * RETURN; /* @Y30LB26*/ 05132000 B @EL00018 1369 05133000 * END; /* @Y30LB26*/ 05134000 * END; /* @Y30LB26*/ 05135000 * END; /* @XA15558*/ 05136000 @RC01352 DS 0H 1373 05137000 * END; /* @Y30LB26*/ 05138000 @RC01333 DS 0H 1373 05139000 @DE01298 CLC I(1),I 1373 05140000 BE @DL01298 1373 05141000 * END BASENREC; /* @Y30LB26*/ 05142000 B @EL00018 1374 05143000 * 1375 05144000 * /*****************************************************************/ 05145000 * /* */ 05146000 * /* THIS SUBROUTINE READS BASE VOLUME RECORDS IN @Y30LB26*/ 05147000 * /* A GIVEN GROUP @Y30LB26*/ 05148000 * /* */ 05149000 * /*****************************************************************/ 05150000 * 1375 05151000 *BASECHN: /* @Y30LB26*/ 05152000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 05153000 * 1375 05154000 BASECHN ST @14,@SA00019 1375 05155000 * /*****************************************************************/ 05156000 * /* */ 05157000 * /* GO RESERVE INVENTORY DATA SET SHARED @Y30LB26*/ 05158000 * /* */ 05159000 * /*****************************************************************/ 05160000 * 1376 05161000 * CALL RESSHARE; /* RESERVE INVENTORY SHR @Y30LB26*/ 05162000 * 1376 05163000 BAL @14,RESSHARE 1376 05164000 * /*****************************************************************/ 05165000 * /* */ 05166000 * /* IF VOL NOT SPECIFIED, THEN WANT FIRST @Y30LB26*/ 05167000 * /* NON-GROUPED BASE VOLUME RECORD, SO @Y30LB26*/ 05168000 * /* CALL SUBROUTINE TO GET IT @Y30LB26*/ 05169000 * /* */ 05170000 * /*****************************************************************/ 05171000 * 1377 05172000 * IF RVVSVOL=OFF THEN /* VOL NOT SPECIFIED ? @Y30LB26*/ 05173000 TM RVVSVOL(RVVIPTR),B'00000001' 1377 05174000 BNZ @RF01377 1377 05175000 * DO; /* @Y30LB26*/ 05176000 * CALL FSTNGBAS; /* GO GET FIRST NON-GRP @Y30LB26*/ 05177000 BAL @14,FSTNGBAS 1379 05178000 * IF RPLVRETC=RCZERO THEN /* GOOD RETURN @Y30LB26*/ 05179000 L @04,RPLVPTR 1380 05180000 CLC RPLVRETC(2,@04),@CB00747 1380 05181000 BE @RT01380 1380 05182000 * RETURN; /* @Y30LB26*/ 05183000 * ELSE /* @Y30LB26*/ 05184000 * IF RPLRCODE^=TNOTMET THEN /* CK FOR TEST NOT MET @Y30LB26*/ 05185000 CLC RPLRCODE(2,@04),@CB00819 1382 05186000 BNE @RT01382 1382 05187000 * RETURN; /* @Y30LB26*/ 05188000 * ELSE /* OTHER REASON @ZM31062*/ 05189000 * DO; /* @ZM31062*/ 05190000 * IF BASLAST=ON THEN /* LAST VOLUME @ZM31062*/ 05191000 L @04,BASEVPTR 1385 05192000 TM BASLAST(@04),B'00001000' 1385 05193000 BNO @RF01385 1385 05194000 * DO; /* @ZM31062*/ 05195000 * CALL ERREXIT; /* SAVE REASON CODES @ZM31062*/ 05196000 BAL @14,ERREXIT 1387 05197000 * RETURN; /* RETURN TO CALLER @ZM31062*/ 05198000 @EL00019 DS 0H 1388 05199000 @EF00019 DS 0H 1388 05200000 @ER00019 L @14,@SA00019 1388 05201000 BR @14 1388 05202000 * END; /* @ZM31062*/ 05203000 * ELSE /* @ZM31062*/ 05204000 * VOLKY=BASNEXTV; /* SET PTR FOR NEXT VOL @ZM31062*/ 05205000 @RF01385 L @04,BASEVPTR 1390 05206000 MVC VOLKY(6),BASNEXTV(@04) 1390 05207000 * END; /* @ZM31062*/ 05208000 * END; /* @Y30LB26*/ 05209000 * 1392 05210000 * /*****************************************************************/ 05211000 * /* */ 05212000 * /* PUT VOLUME NAME IN KEY AND START READ CHAIN LOOP @Y30LB26*/ 05213000 * /* SINCE VOLUMN NAME WAS SPECIFIED IN REQUEST BLOCK @Y30LB26*/ 05214000 * /* */ 05215000 * /*****************************************************************/ 05216000 * 1393 05217000 * ELSE /* @Y30LB26*/ 05218000 * VOLKY=RVVOLUME; /* VOL NAME TO READ @Y30LB26*/ 05219000 * 1393 05220000 B @RC01377 1393 05221000 @RF01377 MVC VOLKY(6),RVVOLUME(RVVIPTR) 1393 05222000 * /*****************************************************************/ 05223000 * /* */ 05224000 * /* START GOING THRU EITHER GROUPED OR NON-GROUPED @Y30LB26*/ 05225000 * /* CHAIN @Y30LB26*/ 05226000 * /* */ 05227000 * /*****************************************************************/ 05228000 * 1394 05229000 * DO WHILE I=I; /* BIG LOOP @Y30LB26*/ 05230000 @RC01377 B @DE01394 1394 05231000 @DL01394 DS 0H 1395 05232000 * RPLVKEY=ADDR(VKEY); /* ADDR OF KEY @Y30LB26*/ 05233000 L @04,RPLVPTR 1395 05234000 LA @02,VKEY 1395 05235000 ST @02,RPLVKEY(,@04) 1395 05236000 * RPLVLOC=ON; /* LOCATE MODE @Y30LB26*/ 05237000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 05238000 OI RPLVLOC(@04),B'11000000' 1397 05239000 * RPLVTYP=RPLVREAD; /* READ RECORD @Y30LB26*/ 05240000 MVI RPLVTYP(@04),X'00' 1398 05241000 * RESPECIFY 1399 05242000 * REG1 RSTD; /* RESTRICT REG1 @Y30LB26*/ 05243000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 05244000 LR REG1,@04 1400 05245000 * CALL ICBVIO00; /* READ BASE REC @Y30LB26*/ 05246000 L @15,@CV00671 1401 05247000 BALR @14,@15 1401 05248000 * RESPECIFY 1402 05249000 * REG1 UNRSTD; /* UNRESTRICT REG1 @Y30LB26*/ 05250000 * 1402 05251000 * /***************************************************************/ 05252000 * /* */ 05253000 * /* CHECK ON RETURN CODE @Y30LB26*/ 05254000 * /* */ 05255000 * /***************************************************************/ 05256000 * 1403 05257000 * IF RPLVRETC^=RCZERO THEN /* CHECK RC @Y30LB26*/ 05258000 L @04,RPLVPTR 1403 05259000 CLC RPLVRETC(2,@04),@CB00747 1403 05260000 BE @RF01403 1403 05261000 * DO; /* @Y30LB26*/ 05262000 * CALL ERREXIT; /* SAVE REASON CODE @Y30LB26*/ 05263000 BAL @14,ERREXIT 1405 05264000 * RETURN; /* @Y30LB26*/ 05265000 B @EL00019 1406 05266000 * END; /* @Y30LB26*/ 05267000 * 1407 05268000 * /***************************************************************/ 05269000 * /* */ 05270000 * /* GET ADDRESS OF BASE RECORD, CHECK IF GROUPED CHAIN @Y30LB26*/ 05271000 * /* */ 05272000 * /***************************************************************/ 05273000 * 1408 05274000 * BASEVPTR=RPLVBUF; /* ADDR OF RECORD @Y30LB26*/ 05275000 @RF01403 L @04,RPLVPTR 1408 05276000 L @02,RPLVBUF(,@04) 1408 05277000 ST @02,BASEVPTR 1408 05278000 * IF RVVGPVOL=ON THEN /* GROUPED VOL CHAIN? @Y30LB26*/ 05279000 TM RVVGPVOL(RVVIPTR),B'10000000' 1409 05280000 BNO @RF01409 1409 05281000 * DO; /* @Y30LB26*/ 05282000 * 1410 05283000 * /***********************************************************/ 05284000 * /* */ 05285000 * /* CHECK TO SEE IF GROUP MATCHES ONE GIVEN @Y30LB26*/ 05286000 * /* IN REQUEST BLOCK @Y30LB26*/ 05287000 * /* */ 05288000 * /***********************************************************/ 05289000 * 1411 05290000 * IF BASGROUP^=RVVGROUP THEN/* GROUPS MATCH? @Y30LB26*/ 05291000 CLC BASGROUP(8,@02),RVVGROUP(RVVIPTR) 1411 05292000 BE @RF01411 1411 05293000 * DO; /* @Y30LB26*/ 05294000 * RPLVRETC=FOUR; /* BAD RC @Y30LB26*/ 05295000 MVC RPLVRETC(2,@04),@CB00749 1413 05296000 * RPLRCODE=BADCHAIN; /* BREAK IN CHAIN @Y30LB26*/ 05297000 MVC RPLRCODE(2,@04),@CB00821 1414 05298000 * CALL ERREXIT; /* SAVE REASON CODES @Y30LB26*/ 05299000 BAL @14,ERREXIT 1415 05300000 * RETURN; /* @Y30LB26*/ 05301000 B @EL00019 1416 05302000 * END; /* @Y30LB26*/ 05303000 * END; /* @Y30LB26*/ 05304000 * ELSE /* @Y30LB26*/ 05305000 * 1419 05306000 * /*************************************************************/ 05307000 * /* */ 05308000 * /* CHECK IF NON-GROUPED VOLUME @Y30LB26*/ 05309000 * /* */ 05310000 * /*************************************************************/ 05311000 * 1419 05312000 * IF RVVNGVOL=ON THEN /* NONGROUPED VOLUME? @Y30LB26*/ 05313000 B @RC01409 1419 05314000 @RF01409 TM RVVNGVOL(RVVIPTR),B'01000000' 1419 05315000 BNO @RF01419 1419 05316000 * DO; /* @Y30LB26*/ 05317000 * 1420 05318000 * /*********************************************************/ 05319000 * /* */ 05320000 * /* BE SURE BASE RECORD INDICATES NON-GROUPED @Y30LB26*/ 05321000 * /* */ 05322000 * /*********************************************************/ 05323000 * 1421 05324000 * IF BASGROUP^=BLANK8 THEN/* CHECK NONGROUPED @Y30LB26*/ 05325000 L @04,BASEVPTR 1421 05326000 CLC BASGROUP(8,@04),BLANK8 1421 05327000 BE @RF01421 1421 05328000 * DO; /* @Y30LB26*/ 05329000 * RPLVRETC=FOUR; /* BAD RC @Y30LB26*/ 05330000 L @02,RPLVPTR 1423 05331000 MVC RPLVRETC(2,@02),@CB00749 1423 05332000 * RPLRCODE=BADCHAIN; /* BROKEN CHAIN @Y30LB26*/ 05333000 MVC RPLRCODE(2,@02),@CB00821 1424 05334000 * CALL ERREXIT; /* SAVE REASON CODES @Y30LB26*/ 05335000 BAL @14,ERREXIT 1425 05336000 * RETURN; /* @Y30LB26*/ 05337000 B @EL00019 1426 05338000 * END; /* @Y30LB26*/ 05339000 * END; /* @Y30LB26*/ 05340000 * 1428 05341000 @RF01421 DS 0H 1429 05342000 * /***************************************************************/ 05343000 * /* */ 05344000 * /* GO MAKE ANY TEST REQUIRED ON BASE RECORD @Y30LB26*/ 05345000 * /* */ 05346000 * /***************************************************************/ 05347000 * 1429 05348000 * CALL TEST; /* TEST RECORD @Y30LB26*/ 05349000 @RF01419 DS 0H 1429 05350000 @RC01409 BAL @14,TEST 1429 05351000 * IF RPLVRETC^=RCZERO THEN /* CHECK RC @Y30LB26*/ 05352000 L @04,RPLVPTR 1430 05353000 CLC RPLVRETC(2,@04),@CB00747 1430 05354000 BE @RF01430 1430 05355000 * DO; /* @Y30LB26*/ 05356000 * 1431 05357000 * /***********************************************************/ 05358000 * /* */ 05359000 * /* IF TEST NOT MET, INDICATE ATTEMPT MADE @Y30LB26*/ 05360000 * /* */ 05361000 * /***********************************************************/ 05362000 * 1432 05363000 * LOOPSW=ON; /* INDICATE LOOPING @Y30LB26*/ 05364000 * 1432 05365000 OI LOOPSW,B'10000000' 1432 05366000 * /***********************************************************/ 05367000 * /* */ 05368000 * /* IF AT END OF CHAIN, SET REASON CODE FOR @Y30LB26*/ 05369000 * /* TEST NOT MET AND RETURN @Y30LB26*/ 05370000 * /* */ 05371000 * /***********************************************************/ 05372000 * 1433 05373000 * IF BASLAST=ON THEN /* LAST IN CHAIN? @Y30LB26*/ 05374000 L @02,BASEVPTR 1433 05375000 TM BASLAST(@02),B'00001000' 1433 05376000 BNO @RF01433 1433 05377000 * DO; /* @Y30LB26*/ 05378000 * RPLRCODE=TNOTMET; /* TEST NOT MET @Y30LB26*/ 05379000 MVC RPLRCODE(2,@04),@CB00819 1435 05380000 * RPLVRETC=FOUR; /* BAD RC @Y30LB26*/ 05381000 MVC RPLVRETC(2,@04),@CB00749 1436 05382000 * CALL ERREXIT; /* SAVE REASON CODES @Y30LB26*/ 05383000 BAL @14,ERREXIT 1437 05384000 * RETURN; /* @Y30LB26*/ 05385000 B @EL00019 1438 05386000 * END; /* @Y30LB26*/ 05387000 * ELSE /* @Y30LB26*/ 05388000 * 1440 05389000 * /*********************************************************/ 05390000 * /* */ 05391000 * /* END OF CHAIN NOT REACHED, SO SET KEY @Y30LB26*/ 05392000 * /* TO GET NEXT BASE VOL REC @Y30LB26*/ 05393000 * /* */ 05394000 * /*********************************************************/ 05395000 * 1440 05396000 * VOLKY=BASNEXTV; /* SET READ NEXT IN CHN @Y30LB26*/ 05397000 @RF01433 L @04,BASEVPTR 1440 05398000 MVC VOLKY(6),BASNEXTV(@04) 1440 05399000 * END; /* @Y30LB26*/ 05400000 * ELSE /* @Y30LB26*/ 05401000 * 1442 05402000 * /*************************************************************/ 05403000 * /* */ 05404000 * /* IF TEST MET, GET BUFFER AND RETURN RECORD @Y30LB26*/ 05405000 * /* */ 05406000 * /*************************************************************/ 05407000 * 1442 05408000 * DO; /* @Y30LB26*/ 05409000 B @RC01430 1442 05410000 @RF01430 DS 0H 1443 05411000 * CALL GETBUF; /* GET CORE @Y30LB26*/ 05412000 BAL @14,GETBUF 1443 05413000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @Y30LB26*/ 05414000 L @04,RPLVPTR 1444 05415000 CLC RPLVRETC(2,@04),@CB00747 1444 05416000 BNE @RT01444 1444 05417000 * RETURN; /* @Y30LB26*/ 05418000 * BUFFER=BASEV; /* MOVE IN GOOD REC @Y30LB26*/ 05419000 L @02,RVVAREA(,RVVIPTR) 1446 05420000 MVI BUFFER+224(@02),C' ' 1446 05421000 MVC BUFFER+225(31,@02),BUFFER+224(@02) 1446 05422000 L @01,BASEVPTR 1446 05423000 MVC BUFFER(224,@02),BASEV(@01) 1446 05424000 * RPLVRETC=RCZERO; /* GOOD RC @Y30LB26*/ 05425000 MVC RPLVRETC(2,@04),@CB00747 1447 05426000 * RPLRCODE=RCZERO; /* GOOD REASON CODE @Y30LB26*/ 05427000 MVC RPLRCODE(2,@04),@CB00747 1448 05428000 * RETURN; /* @Y30LB26*/ 05429000 B @EL00019 1449 05430000 * END; /* @Y30LB26*/ 05431000 * END; /* @Y30LB26*/ 05432000 @RC01430 DS 0H 1451 05433000 @DE01394 CLC I(1),I 1451 05434000 BE @DL01394 1451 05435000 * END BASECHN; /* @Y30LB26*/ 05436000 B @EL00019 1452 05437000 * 1453 05438000 * /*****************************************************************/ 05439000 * /* */ 05440000 * /* ROUTINE GETS THE FIRST BASE VOLUME RECORD IN @Y30LB26*/ 05441000 * /* THE NON-GROUPED CATAGORY @Y30LB26*/ 05442000 * /* */ 05443000 * /*****************************************************************/ 05444000 * 1453 05445000 *FSTNGBAS: 1453 05446000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 05447000 * 1453 05448000 FSTNGBAS ST @14,@SA00020 1453 05449000 * /*****************************************************************/ 05450000 * /* */ 05451000 * /* SET UP TO READ THE NON-GROUPED VOL HEADER REC @Y30LB26*/ 05452000 * /* */ 05453000 * /*****************************************************************/ 05454000 * 1454 05455000 * RPLVKEY=ADDR(NGHEADER); /* ADDR NON HEADER KEY @Y30LB26*/ 05456000 L @04,RPLVPTR 1454 05457000 LA @02,NGHEADER 1454 05458000 ST @02,RPLVKEY(,@04) 1454 05459000 * RPLVLOC=ON; /* LOCATE ONLY @Y30LB26*/ 05460000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 05461000 OI RPLVLOC(@04),B'11000000' 1456 05462000 * RPLVTYP=RPLVREAD; /* READ RECORD @Y30LB26*/ 05463000 MVI RPLVTYP(@04),X'00' 1457 05464000 * RPLVUPD=OFF; /* READ ONLY ACCESS @Y30LB26*/ 05465000 NI RPLVUPD(@04),B'11111101' 1458 05466000 * RESPECIFY 1459 05467000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 05468000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 05469000 LR REG1,@04 1460 05470000 * CALL ICBVIO00; /* READ NON-GRP HEAD @Y30LB26*/ 05471000 L @15,@CV00671 1461 05472000 BALR @14,@15 1461 05473000 * RESPECIFY 1462 05474000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 05475000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN CODE @Y30LB26*/ 05476000 L @04,RPLVPTR 1463 05477000 CLC RPLVRETC(2,@04),@CB00747 1463 05478000 BE @RF01463 1463 05479000 * DO; /* @Y30LB26*/ 05480000 * CALL ERREXIT; /* RELEASE INVEN @Y30LB26*/ 05481000 BAL @14,ERREXIT 1465 05482000 * RETURN; /* @Y30LB26*/ 05483000 @EL00020 DS 0H 1466 05484000 @EF00020 DS 0H 1466 05485000 @ER00020 L @14,@SA00020 1466 05486000 BR @14 1466 05487000 * END; /* @Y30LB26*/ 05488000 * 1467 05489000 * /*****************************************************************/ 05490000 * /* */ 05491000 * /* GET ADDRESSING TO RECORD JUST READ @Y30LB26*/ 05492000 * /* */ 05493000 * /*****************************************************************/ 05494000 * 1468 05495000 * NGVRPTR=RPLVBUF; /* ADDR RECORD @Y30LB26*/ 05496000 * 1468 05497000 @RF01463 L @02,RPLVPTR 1468 05498000 L NGVRPTR,RPLVBUF(,@02) 1468 05499000 * /*****************************************************************/ 05500000 * /* */ 05501000 * /* BE SURE THERE IS AT LEAST ONE NON-GROUPED BASE @Y30LB26*/ 05502000 * /* */ 05503000 * /*****************************************************************/ 05504000 * 1469 05505000 * IF NGVNOVOL=ZERO THEN /* ANY VOLUMES ? @Y30LB26*/ 05506000 LH @15,NGVNOVOL(,NGVRPTR) 1469 05507000 LTR @15,@15 1469 05508000 BNZ @RF01469 1469 05509000 * DO; /* @Y30LB26*/ 05510000 * RPLVRETC=FOUR; /* BAD RET CODE @Y30LB26*/ 05511000 MVC RPLVRETC(2,@02),@CB00749 1471 05512000 * RPLRCODE=NORECRC; /* RECORD NOT FOUND @Y30LB26*/ 05513000 MVC RPLRCODE(2,@02),@CB00789 1472 05514000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 05515000 BAL @14,ERREXIT 1473 05516000 * RETURN; /* @Y30LB26*/ 05517000 B @EL00020 1474 05518000 * END; /* @Y30LB26*/ 05519000 * VOLKY=NGVFVOL; /* VOL NAME TO KEY @Y30LB26*/ 05520000 * 1476 05521000 @RF01469 MVC VOLKY(6),NGVFVOL(NGVRPTR) 1476 05522000 * /*****************************************************************/ 05523000 * /* */ 05524000 * /* SET UP TO READ THE FIRST NON-GROUPED BASE VOLUME @Y30LB26*/ 05525000 * /* */ 05526000 * /*****************************************************************/ 05527000 * 1477 05528000 * RPLVKEY=ADDR(VKEY); /* ADDR KEY @Y30LB26*/ 05529000 L @04,RPLVPTR 1477 05530000 LA @02,VKEY 1477 05531000 ST @02,RPLVKEY(,@04) 1477 05532000 * RPLVLOC=ON; /* NOT LOCATE @Y30LB26*/ 05533000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 05534000 OI RPLVLOC(@04),B'11000000' 1479 05535000 * RPLVTYP=RPLVREAD; /* READ BASE VOLUME @Y30LB26*/ 05536000 MVI RPLVTYP(@04),X'00' 1480 05537000 * RPLVUPD=OFF; /* NOT FOR UPDATE @Y30LB26*/ 05538000 NI RPLVUPD(@04),B'11111101' 1481 05539000 * RESPECIFY 1482 05540000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 05541000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 05542000 LR REG1,@04 1483 05543000 * CALL ICBVIO00; /* READ BASE VOL REC @Y30LB26*/ 05544000 L @15,@CV00671 1484 05545000 BALR @14,@15 1484 05546000 * RESPECIFY 1485 05547000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 05548000 * 1485 05549000 * /*****************************************************************/ 05550000 * /* */ 05551000 * /* CHECK ON RETURN FROM I/O @Y30LB26*/ 05552000 * /* */ 05553000 * /*****************************************************************/ 05554000 * 1486 05555000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN CODE @Y30LB26*/ 05556000 L @04,RPLVPTR 1486 05557000 CLC RPLVRETC(2,@04),@CB00747 1486 05558000 BE @RF01486 1486 05559000 * DO; /* @Y30LB26*/ 05560000 * CALL ERREXIT; /* RELEASE INVEN @Y30LB26*/ 05561000 BAL @14,ERREXIT 1488 05562000 * RETURN; /* @Y30LB26*/ 05563000 B @EL00020 1489 05564000 * END; /* @Y30LB26*/ 05565000 * 1490 05566000 * /*****************************************************************/ 05567000 * /* */ 05568000 * /* GET ADDR OF BASE RECORD AND CALL TEST TO SEE IF @Y30LB26*/ 05569000 * /* RECORD CAN MEET TESTS. IF IT CAN RETURN IT @Y30LB26*/ 05570000 * /* */ 05571000 * /*****************************************************************/ 05572000 * 1491 05573000 * BASEVPTR=RPLVBUF; /* ADDR REC JUST READ @Y30LB26*/ 05574000 @RF01486 L @04,RPLVPTR 1491 05575000 L @04,RPLVBUF(,@04) 1491 05576000 ST @04,BASEVPTR 1491 05577000 * CALL TEST; /* SEE IF BASE REC MEETS @Y30LB26*/ 05578000 BAL @14,TEST 1492 05579000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @Y30LB26*/ 05580000 * 1493 05581000 L @04,RPLVPTR 1493 05582000 CLC RPLVRETC(2,@04),@CB00747 1493 05583000 BNE @RT01493 1493 05584000 * /***************************************************************/ 05585000 * /* */ 05586000 * /* IF RECORD DID NOT MEET TEST, @Y30LB26*/ 05587000 * /* RETURN TO BASE CHAIN PROCEDURE WHICH WILL CONTINUE @Y30LB26*/ 05588000 * /* UNTIL A RECORD IS FOUND THAT MEETS TEST @Y30LB26*/ 05589000 * /* */ 05590000 * /***************************************************************/ 05591000 * 1494 05592000 * RETURN; /* RETURN TO CALLER @ZM31062*/ 05593000 * ELSE /* #Y30LB26*/ 05594000 * 1495 05595000 * /***************************************************************/ 05596000 * /* */ 05597000 * /* IF TEST MET, GET BUFFER AND RETURN RECORD #Y30LB26*/ 05598000 * /* */ 05599000 * /***************************************************************/ 05600000 * 1495 05601000 * DO; /* @Y30LB26*/ 05602000 * CALL GETBUF; /* GET CORE #Y30LB26*/ 05603000 BAL @14,GETBUF 1496 05604000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN CODE #Y30LB26*/ 05605000 L @04,RPLVPTR 1497 05606000 CLC RPLVRETC(2,@04),@CB00747 1497 05607000 BNE @RT01497 1497 05608000 * RETURN; /* RETURN TO CALLER #Y30LB26*/ 05609000 * BUFFER=BASEV; /* MOVE IN GOOD REC #Y30LB26*/ 05610000 L @02,RVVAREA(,RVVIPTR) 1499 05611000 MVI BUFFER+224(@02),C' ' 1499 05612000 MVC BUFFER+225(31,@02),BUFFER+224(@02) 1499 05613000 L @01,BASEVPTR 1499 05614000 MVC BUFFER(224,@02),BASEV(@01) 1499 05615000 * RPLVRETC=RCZERO; /* GOOD RC #Y30LB26*/ 05616000 MVC RPLVRETC(2,@04),@CB00747 1500 05617000 * RPLRCODE=RCZERO; /* GOOD REASON CODE #Y30LB26*/ 05618000 MVC RPLRCODE(2,@04),@CB00747 1501 05619000 * END; /* #Y30LB26*/ 05620000 * RETURN; /* #Y30LB26*/ 05621000 B @EL00020 1503 05622000 * END FSTNGBAS; /* #Y30LB26*/ 05623000 B @EL00020 1504 05624000 * 1505 05625000 * /*****************************************************************/ 05626000 * /* */ 05627000 * /* ROUTINE READS DIRECT FOR GROUP RECORD #Y30LB26*/ 05628000 * /* */ 05629000 * /*****************************************************************/ 05630000 * 1505 05631000 *GRPDIR: /* #Y30LB26*/ 05632000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 05633000 * 1505 05634000 GRPDIR ST @14,@SA00021 1505 05635000 * /*****************************************************************/ 05636000 * /* */ 05637000 * /* GO RESERVE INVENTORY DATA SET SHARED #Y30LB26*/ 05638000 * /* */ 05639000 * /*****************************************************************/ 05640000 * 1506 05641000 * CALL RESSHARE; /* RESERVE INVENTORY SHR #Y30LB26*/ 05642000 * 1506 05643000 BAL @14,RESSHARE 1506 05644000 * /*****************************************************************/ 05645000 * /* */ 05646000 * /* SET UP TO READ DIRECT GROUP RECORD #Y30LB26*/ 05647000 * /* */ 05648000 * /*****************************************************************/ 05649000 * 1507 05650000 * GROUPKY=RVVGROUP; /* GROUP NAME #Y30LB26*/ 05651000 MVC GROUPKY(8),RVVGROUP(RVVIPTR) 1507 05652000 * RPLVKEY=ADDR(GKEY); /* ADDR KEY #Y30LB26*/ 05653000 L @04,RPLVPTR 1508 05654000 LA @02,GKEY 1508 05655000 ST @02,RPLVKEY(,@04) 1508 05656000 * RPLVLOC=ON; /* LOCATE MODE #Y30LB26*/ 05657000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 05658000 OI RPLVLOC(@04),B'11000000' 1510 05659000 * RPLVTYP=RPLVREAD; /* DO A READ @Y30LB26*/ 05660000 MVI RPLVTYP(@04),X'00' 1511 05661000 * RESPECIFY 1512 05662000 * REG1 RSTD; /* RESTRICT REG1 @Y30LB26*/ 05663000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 05664000 LR REG1,@04 1513 05665000 * CALL ICBVIO00; /* READ GROUP RECORD @Y30LB26*/ 05666000 L @15,@CV00671 1514 05667000 BALR @14,@15 1514 05668000 * RESPECIFY 1515 05669000 * REG1 UNRSTD; /* UNRESTRICT REG1 @Y30LB26*/ 05670000 * 1515 05671000 * /*****************************************************************/ 05672000 * /* */ 05673000 * /* CHECK REASON CODE @Y30LB26*/ 05674000 * /* */ 05675000 * /*****************************************************************/ 05676000 * 1516 05677000 * IF RPLVRETC^=RCZERO THEN /* CHECK RC @Y30LB26*/ 05678000 L @04,RPLVPTR 1516 05679000 CLC RPLVRETC(2,@04),@CB00747 1516 05680000 BE @RF01516 1516 05681000 * DO; /* @Y30LB26*/ 05682000 * CALL ERREXIT; /* SAVE REASPM CPDES @Y30LB26*/ 05683000 BAL @14,ERREXIT 1518 05684000 * RETURN; /* @Y30LB26*/ 05685000 @EL00021 DS 0H 1519 05686000 @EF00021 DS 0H 1519 05687000 @ER00021 L @14,@SA00021 1519 05688000 BR @14 1519 05689000 * END; /* @Y30LB26*/ 05690000 * 1520 05691000 * /*****************************************************************/ 05692000 * /* */ 05693000 * /* IF NO ERROR, SET UP ADDRESSING @Y30LB26*/ 05694000 * /* */ 05695000 * /*****************************************************************/ 05696000 * 1521 05697000 * GROUPPTR=RPLVBUF; /* ADDR RECORD READ @Y30LB26*/ 05698000 * 1521 05699000 @RF01516 L @04,RPLVPTR 1521 05700000 L @04,RPLVBUF(,@04) 1521 05701000 ST @04,GROUPPTR 1521 05702000 * /*****************************************************************/ 05703000 * /* */ 05704000 * /* IF THRESHOLD CHECKING IS REQUIRED, DO IT @Y30LB26*/ 05705000 * /* */ 05706000 * /*****************************************************************/ 05707000 * 1522 05708000 * IF RVVTHOLD=ON THEN /* THRESHOLD CHECKING? @Y30LB26*/ 05709000 TM RVVTHOLD(RVVIPTR),B'01000000' 1522 05710000 BNO @RF01522 1522 05711000 * DO; /* @Y30LB26*/ 05712000 * 1523 05713000 * /*************************************************************/ 05714000 * /* */ 05715000 * /* IF THRESHOLD HAS BEEN PASSED, GET BUFFER @Y30LB26*/ 05716000 * /* AND RETURN RECORD @Y30LB26*/ 05717000 * /* */ 05718000 * /*************************************************************/ 05719000 * 1524 05720000 * IF GROFRESP<=GROSTRSH THEN /* PAST THRESHOLD? @Y30LB26*/ 05721000 L @02,GROFRESP(,@04) 1524 05722000 C @02,GROSTRSH(,@04) 1524 05723000 BH @RF01524 1524 05724000 * DO; /* @Y30LB26*/ 05725000 * CALL GETBUF; /* GET CORE @Y30LB26*/ 05726000 BAL @14,GETBUF 1526 05727000 * IF RPLVRETC^=RCZERO THEN/* CK RETURN @Y30LB26*/ 05728000 L @04,RPLVPTR 1527 05729000 CLC RPLVRETC(2,@04),@CB00747 1527 05730000 BNE @RT01527 1527 05731000 * RETURN; /* @Y30LB26*/ 05732000 * BUFFER=GROUP; /* MOVE IN RECORD @Y30LB26*/ 05733000 L @02,RVVAREA(,RVVIPTR) 1529 05734000 MVI BUFFER+164(@02),C' ' 1529 05735000 MVC BUFFER+165(91,@02),BUFFER+164(@02) 1529 05736000 L @01,GROUPPTR 1529 05737000 MVC BUFFER(164,@02),GROUP(@01) 1529 05738000 * RPLVRETC=RCZERO; /* GOOD RC @Y30LB26*/ 05739000 MVC RPLVRETC(2,@04),@CB00747 1530 05740000 * RPLRCODE=RCZERO; /* GOOD REASON CODE @Y30LB26*/ 05741000 MVC RPLRCODE(2,@04),@CB00747 1531 05742000 * RETURN; /* @Y30LB26*/ 05743000 B @EL00021 1532 05744000 * END; /* @Y30LB26*/ 05745000 * ELSE /* @Y30LB26*/ 05746000 * 1534 05747000 * /***********************************************************/ 05748000 * /* */ 05749000 * /* TEST NOT MET SO GIVE BAD RET CODE AND RETURN @Y30LB26*/ 05750000 * /* */ 05751000 * /***********************************************************/ 05752000 * 1534 05753000 * DO; /* @Y30LB26*/ 05754000 @RF01524 DS 0H 1535 05755000 * RPLVRETC=FOUR; /* BAD RC @Y30LB26*/ 05756000 L @02,RPLVPTR 1535 05757000 MVC RPLVRETC(2,@02),@CB00749 1535 05758000 * RPLRCODE=TNOTMET; /* TEST NOT MET @Y30LB26*/ 05759000 MVC RPLRCODE(2,@02),@CB00819 1536 05760000 * CALL ERREXIT; /* SAVE REASON CODES @Y30LB26*/ 05761000 BAL @14,ERREXIT 1537 05762000 * RETURN; /* @Y30LB26*/ 05763000 B @EL00021 1538 05764000 * END; /* @Y30LB26*/ 05765000 * END; /* @Y30LB26*/ 05766000 * 1540 05767000 * /*****************************************************************/ 05768000 * /* */ 05769000 * /* TEST WAS NOT MADE, SO JUST RETURN RECORD @Y30LB26*/ 05770000 * /* */ 05771000 * /*****************************************************************/ 05772000 * 1541 05773000 * CALL GETBUF; /* GET CORE @Y30LB26*/ 05774000 @RF01522 BAL @14,GETBUF 1541 05775000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @Y30LB26*/ 05776000 L @04,RPLVPTR 1542 05777000 CLC RPLVRETC(2,@04),@CB00747 1542 05778000 BNE @RT01542 1542 05779000 * RETURN; /* @Y30LB26*/ 05780000 * BUFFER=GROUP; /* MOVE IN RECORD @Y30LB26*/ 05781000 L @02,RVVAREA(,RVVIPTR) 1544 05782000 MVI BUFFER+164(@02),C' ' 1544 05783000 MVC BUFFER+165(91,@02),BUFFER+164(@02) 1544 05784000 L @01,GROUPPTR 1544 05785000 MVC BUFFER(164,@02),GROUP(@01) 1544 05786000 * RPLVRETC=RCZERO; /* GOOD RC @Y30LB26*/ 05787000 MVC RPLVRETC(2,@04),@CB00747 1545 05788000 * RPLRCODE=RCZERO; /* GOOD REASON CODE @Y30LB26*/ 05789000 MVC RPLRCODE(2,@04),@CB00747 1546 05790000 * RETURN; /* @Y30LB26*/ 05791000 B @EL00021 1547 05792000 * END GRPDIR; /* @Y30LB26*/ 05793000 B @EL00021 1548 05794000 * 1549 05795000 * /*****************************************************************/ 05796000 * /* */ 05797000 * /* PROCEDURE READS NEXT FOR GROUP RECORD @Y30LB26*/ 05798000 * /* */ 05799000 * /*****************************************************************/ 05800000 * 1549 05801000 *GRPNREC: /* @Y30LB26*/ 05802000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 05803000 * 1549 05804000 GRPNREC ST @14,@SA00022 1549 05805000 * /*****************************************************************/ 05806000 * /* */ 05807000 * /* GO RESERVE INVENTORY DATA SET SHARED @Y30LB26*/ 05808000 * /* */ 05809000 * /*****************************************************************/ 05810000 * 1550 05811000 * CALL RESSHARE; /* RESERVE INVENTORY SHR @Y30LB26*/ 05812000 * 1550 05813000 BAL @14,RESSHARE 1550 05814000 * /*****************************************************************/ 05815000 * /* */ 05816000 * /* CHECK ON STATUS OF GROUP NAME. IF GIVEN USE IT @Y30LB26*/ 05817000 * /* OTHERWISE, READ FIRST GROUP RECORD @Y30LB26*/ 05818000 * /* */ 05819000 * /*****************************************************************/ 05820000 * 1551 05821000 * IF RVVSGRP=OFF THEN /* WAS GROUP NAME SPEC @Y30LB26*/ 05822000 TM RVVSGRP(RVVIPTR),B'10000000' 1551 05823000 BNZ @RF01551 1551 05824000 * GROUPKY=ZEROCHAR; /* SET READ FIRST GROUP @Y30LB26*/ 05825000 MVC GROUPKY(8),ZEROCHAR 1552 05826000 * ELSE /* @Y30LB26*/ 05827000 * GROUPKY=RVVGROUP; /* GROUP NAME @Y30LB26*/ 05828000 B @RC01551 1553 05829000 @RF01551 MVC GROUPKY(8),RVVGROUP(RVVIPTR) 1553 05830000 * DO WHILE I=I; /* BIG LOOP @Y30LB26*/ 05831000 * 1554 05832000 @RC01551 B @DE01554 1554 05833000 @DL01554 DS 0H 1555 05834000 * /***************************************************************/ 05835000 * /* */ 05836000 * /* SET UP TO READ NEXT GROUP RECORD @Y30LB26*/ 05837000 * /* */ 05838000 * /***************************************************************/ 05839000 * 1555 05840000 * ARITHGRP=GKEY(12:13); /* MOVE EXISTING ID @Y30LB26*/ 05841000 MVC ARITHGRP(2),GKEY+11 1555 05842000 * GRPID=GRPID+256; /* ADD TO GET NEXT GRP @Y30LB26*/ 05843000 LA @04,256 1556 05844000 LH @02,GRPID 1556 05845000 N @02,@CF01186 1556 05846000 ALR @04,@02 1556 05847000 STH @04,GRPID 1556 05848000 * GKEY(12:13)=ARITHGRP; /* PUT NEW VALUE BACK @Y30LB26*/ 05849000 MVC GKEY+11(2),ARITHGRP 1557 05850000 * RPLVKEY=ADDR(GKEY); /* ADDR OF KEY @Y30LB26*/ 05851000 L @04,RPLVPTR 1558 05852000 LA @02,GKEY 1558 05853000 ST @02,RPLVKEY(,@04) 1558 05854000 * RPLVLOC=ON; /* LOCATE MODE @Y30LB26*/ 05855000 * RPLVDIR=ON; /* DIRECT READ @Y30LB26*/ 05856000 OI RPLVLOC(@04),B'11000000' 1560 05857000 * RPLVTYP=RPLVREAD; /* READ RECORD @Y30LB26*/ 05858000 MVI RPLVTYP(@04),X'00' 1561 05859000 * RPLVKGE=ON; /* READ >= @Y30LB26*/ 05860000 OI RPLVKGE(@04),B'00000100' 1562 05861000 * RESPECIFY 1563 05862000 * REG1 RSTD; /* RESTRICT REG1 @Y30LB26*/ 05863000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 05864000 LR REG1,@04 1564 05865000 * CALL ICBVIO00; /* READ NEXT GROUP @Y30LB26*/ 05866000 L @15,@CV00671 1565 05867000 BALR @14,@15 1565 05868000 * RESPECIFY 1566 05869000 * REG1 UNRSTD; /* UNRESTRICT REG1 @Y30LB26*/ 05870000 * 1566 05871000 * /***************************************************************/ 05872000 * /* */ 05873000 * /* CHECK RETURN CODE FROM I/O PROCESSOR @Y30LB26*/ 05874000 * /* */ 05875000 * /***************************************************************/ 05876000 * 1567 05877000 * IF RPLVRETC^=RCZERO THEN /* CHECK RC @Y30LB26*/ 05878000 L @04,RPLVPTR 1567 05879000 CLC RPLVRETC(2,@04),@CB00747 1567 05880000 BE @RF01567 1567 05881000 * DO; /* @Y30LB26*/ 05882000 * CALL ERREXIT; /* SAVE REASON CODES @Y30LB26*/ 05883000 BAL @14,ERREXIT 1569 05884000 * RETURN; /* @Y30LB26*/ 05885000 @EL00022 DS 0H 1570 05886000 @EF00022 DS 0H 1570 05887000 @ER00022 L @14,@SA00022 1570 05888000 BR @14 1570 05889000 * END; /* @Y30LB26*/ 05890000 * 1571 05891000 * /***************************************************************/ 05892000 * /* */ 05893000 * /* IF NO ERROR OCCURED, SET ADDRESSING TO RECORD @Y30LB26*/ 05894000 * /* */ 05895000 * /***************************************************************/ 05896000 * 1572 05897000 * GROUPPTR=RPLVBUF; /* ADDR RECORD READ @Y30LB26*/ 05898000 * 1572 05899000 @RF01567 L @04,RPLVPTR 1572 05900000 L @04,RPLVBUF(,@04) 1572 05901000 ST @04,GROUPPTR 1572 05902000 * /***************************************************************/ 05903000 * /* */ 05904000 * /* TEST TO SEE IF STILL A GROUP RECORD @Y30LB26*/ 05905000 * /* */ 05906000 * /***************************************************************/ 05907000 * 1573 05908000 * IF GROG=GKY& /* @Y30LB26*/ 05909000 * GROZERO=FIXZERO THEN /* TEST IS GROUP REC @Y30LB26*/ 05910000 * 1573 05911000 CLC GROG(3,@04),GKY 1573 05912000 BNE @RF01573 1573 05913000 CLI GROZERO(@04),0 1573 05914000 BNE @RF01573 1573 05915000 * /*************************************************************/ 05916000 * /* */ 05917000 * /* IF THRESHOLD CHECKING CALLED FOR, DO IT @Y30LB26*/ 05918000 * /* */ 05919000 * /*************************************************************/ 05920000 * 1574 05921000 * DO; /* @Y30LB26*/ 05922000 * IF RVVTHOLD=ON THEN /* THRESHOLD CHECK? @Y30LB26*/ 05923000 TM RVVTHOLD(RVVIPTR),B'01000000' 1575 05924000 BNO @RF01575 1575 05925000 * DO; /* @Y30LB26*/ 05926000 * IF GROFRESP<=GROSTRSH THEN/* PAST THRESHOLD? @Y30LB26*/ 05927000 * 1577 05928000 L @02,GROFRESP(,@04) 1577 05929000 C @02,GROSTRSH(,@04) 1577 05930000 BH @RF01577 1577 05931000 * /*****************************************************/ 05932000 * /* */ 05933000 * /* IF GROUP PAST THRESHOLD, GET BUFFER @Y30LB26*/ 05934000 * /* AND RETURN RECORD @Y30LB26*/ 05935000 * /* */ 05936000 * /*****************************************************/ 05937000 * 1578 05938000 * DO; /* @Y30LB26*/ 05939000 * CALL GETBUF; /* GET BUFFER @Y30LB26*/ 05940000 BAL @14,GETBUF 1579 05941000 * IF RPLVRETC^=RCZERO THEN/* CK RETURN @Y30LB26*/ 05942000 L @04,RPLVPTR 1580 05943000 CLC RPLVRETC(2,@04),@CB00747 1580 05944000 BNE @RT01580 1580 05945000 * RETURN; /* @Y30LB26*/ 05946000 * BUFFER=GROUP; /* MOVE IN RECORD @Y30LB26*/ 05947000 L @02,RVVAREA(,RVVIPTR) 1582 05948000 MVI BUFFER+164(@02),C' ' 1582 05949000 MVC BUFFER+165(91,@02),BUFFER+164(@02) 1582 05950000 L @01,GROUPPTR 1582 05951000 MVC BUFFER(164,@02),GROUP(@01) 1582 05952000 * RPLVRETC=RCZERO; /* GOOD RC @Y30LB26*/ 05953000 MVC RPLVRETC(2,@04),@CB00747 1583 05954000 * RPLRCODE=RCZERO; /* GOOD REASON CODE @Y30LB26*/ 05955000 MVC RPLRCODE(2,@04),@CB00747 1584 05956000 * RETURN; /* @Y30LB26*/ 05957000 B @EL00022 1585 05958000 * END; /* @Y30LB26*/ 05959000 * ELSE /* @Y30LB26*/ 05960000 * DO; /* @Y30LB26*/ 05961000 @RF01577 DS 0H 1588 05962000 * LOOPSW=ON; /* INDICATE LOOPING @Y30LB26*/ 05963000 OI LOOPSW,B'10000000' 1588 05964000 * GKEY=GRONAME; /* SET KEY TO ADD 256 @Y30LB26*/ 05965000 L @04,GROUPPTR 1589 05966000 MVC GKEY(13),GRONAME(@04) 1589 05967000 * END; /* @Y30LB26*/ 05968000 * END; /* @Y30LB26*/ 05969000 * ELSE /* @Y30LB26*/ 05970000 * 1592 05971000 * /*********************************************************/ 05972000 * /* */ 05973000 * /* NO THRESHOLD CHECKING, SO JUST @Y30LB26*/ 05974000 * /* RETURN GROUP RECORD @Y30LB26*/ 05975000 * /* */ 05976000 * /*********************************************************/ 05977000 * 1592 05978000 * DO; /* @Y30LB26*/ 05979000 B @RC01575 1592 05980000 @RF01575 DS 0H 1593 05981000 * CALL GETBUF; /* GET BUFFER @Y30LB26*/ 05982000 BAL @14,GETBUF 1593 05983000 * IF RPLVRETC^=RCZERO THEN/* CK RETURN @Y30LB26*/ 05984000 L @04,RPLVPTR 1594 05985000 CLC RPLVRETC(2,@04),@CB00747 1594 05986000 BNE @RT01594 1594 05987000 * RETURN; /* @Y30LB26*/ 05988000 * BUFFER=GROUP; /* MOVE IN RECORD @Y30LB26*/ 05989000 L @02,RVVAREA(,RVVIPTR) 1596 05990000 MVI BUFFER+164(@02),C' ' 1596 05991000 MVC BUFFER+165(91,@02),BUFFER+164(@02) 1596 05992000 L @01,GROUPPTR 1596 05993000 MVC BUFFER(164,@02),GROUP(@01) 1596 05994000 * RPLVRETC=RCZERO; /* GOOD RETN CODE @Y30LB26*/ 05995000 MVC RPLVRETC(2,@04),@CB00747 1597 05996000 * RPLRCODE=RCZERO; /* GOOD REASON CODE @Y30LB26*/ 05997000 MVC RPLRCODE(2,@04),@CB00747 1598 05998000 * RETURN; /* @Y30LB26*/ 05999000 B @EL00022 1599 06000000 * END; /* @Y30LB26*/ 06001000 * END; /* @Y30LB26*/ 06002000 * ELSE /* @Y30LB26*/ 06003000 * 1602 06004000 * /*************************************************************/ 06005000 * /* */ 06006000 * /* NO LONGER A GROUP RECORD, SO CHECK TO SEE @Y30LB26*/ 06007000 * /* IF LOOPING HAS OCCURED @Y30LB26*/ 06008000 * /* */ 06009000 * /*************************************************************/ 06010000 * 1602 06011000 * DO; /* @Y30LB26*/ 06012000 B @RC01573 1602 06013000 @RF01573 DS 0H 1603 06014000 * IF LOOPSW=ON THEN /* CHECK LOOP CONTROL @Y30LB26*/ 06015000 * 1603 06016000 TM LOOPSW,B'10000000' 1603 06017000 BNO @RF01603 1603 06018000 * /*********************************************************/ 06019000 * /* */ 06020000 * /* IF LOOPING OCCURED, SET REASON CODE @Y30LB26*/ 06021000 * /* TO INDICATE TEST NOT MET @Y30LB26*/ 06022000 * /* */ 06023000 * /*********************************************************/ 06024000 * 1604 06025000 * DO; /* @Y30LB26*/ 06026000 * RPLRCODE=TNOTMET; /* TEST NOT MEET @Y30LB26*/ 06027000 L @02,RPLVPTR 1605 06028000 MVC RPLRCODE(2,@02),@CB00819 1605 06029000 * RPLVRETC=FOUR; /* BAD RETURN CODE @Y30LB26*/ 06030000 MVC RPLVRETC(2,@02),@CB00749 1606 06031000 * CALL ERREXIT; /* SAVE REASON CODES @Y30LB26*/ 06032000 BAL @14,ERREXIT 1607 06033000 * RETURN; /* @Y30LB26*/ 06034000 B @EL00022 1608 06035000 * END; /* @Y30LB26*/ 06036000 * ELSE /* @Y30LB26*/ 06037000 * 1610 06038000 * /*********************************************************/ 06039000 * /* */ 06040000 * /* NO LOOPING OCCURED, SO SET REASON CODE @Y30LB26*/ 06041000 * /* INDICATING RECORD WAS NOT FOUND @Y30LB26*/ 06042000 * /* */ 06043000 * /*********************************************************/ 06044000 * 1610 06045000 * DO; /* @Y30LB26*/ 06046000 @RF01603 DS 0H 1611 06047000 * RPLVRETC=FOUR; /* BAD RETURN CODE @Y30LB26*/ 06048000 L @02,RPLVPTR 1611 06049000 MVC RPLVRETC(2,@02),@CB00749 1611 06050000 * RPLRCODE=NORECRC; /* BAD REASON CODE @Y30LB26*/ 06051000 MVC RPLRCODE(2,@02),@CB00789 1612 06052000 * CALL ERREXIT; /* SAVE REASON CODES @Y30LB26*/ 06053000 BAL @14,ERREXIT 1613 06054000 * RETURN; /* @Y30LB26*/ 06055000 B @EL00022 1614 06056000 * END; /* @Y30LB26*/ 06057000 * END; /* @Y30LB26*/ 06058000 * END; /* @Y30LB26*/ 06059000 @RC01573 DS 0H 1617 06060000 @DE01554 CLC I(1),I 1617 06061000 BE @DL01554 1617 06062000 * END GRPNREC; /* @Y30LB26*/ 06063000 B @EL00022 1618 06064000 * 1619 06065000 * /*****************************************************************/ 06066000 * /* */ 06067000 * /* THIS PROCEDURE DETERMINES THE TYPE OF RECORD ASKED @Y30LB26*/ 06068000 * /* FOR ON A REQUEST TO READ A COPY DIRECT. THE TYPES @Y30LB26*/ 06069000 * /* OF RECORDS ASKED FOR ARE BY DATE AND SEQUENCE NUMBER @Y30LB26*/ 06070000 * /* LATEST COPY, LATEST BACKUP, OLDEST BACKUP @Y30LB26*/ 06071000 * /* */ 06072000 * /*****************************************************************/ 06073000 * 1619 06074000 *COPYDIR: 1619 06075000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 06076000 * 1619 06077000 COPYDIR ST @14,@SA00023 1619 06078000 * /*****************************************************************/ 06079000 * /* */ 06080000 * /* IF DATE WAS SPECIFIED, GO FIND COPY WITH THAT DATE @Y30LB26*/ 06081000 * /* */ 06082000 * /*****************************************************************/ 06083000 * 1620 06084000 * IF RVVSDTE=ON THEN /* DATE SPEC? @Y30LB26*/ 06085000 TM RVVSDTE(RVVIPTR),B'00100000' 1620 06086000 BNO @RF01620 1620 06087000 * DO; /* @Y30LB26*/ 06088000 * CALL CPYDATE; /* GET CPY REC DATE @Y30LB26*/ 06089000 BAL @14,CPYDATE 1622 06090000 * RETURN; /* @Y30LB26*/ 06091000 @EL00023 DS 0H 1623 06092000 @EF00023 DS 0H 1623 06093000 @ER00023 L @14,@SA00023 1623 06094000 BR @14 1623 06095000 * END; /* @Y30LB26*/ 06096000 * 1624 06097000 * /*****************************************************************/ 06098000 * /* */ 06099000 * /* CHECK IF LATEST OR OLDEST BACKUP ARE WANTED @Y30LB26*/ 06100000 * /* */ 06101000 * /*****************************************************************/ 06102000 * 1625 06103000 * IF(RVVLBKUP=ON|RVVOBKUP=ON)&(RVVCPLHD=OFF&RVVALL=OFF)/* @ZDR2053*/ 06104000 * THEN /* WANT BACKUPS? @ZDR2053*/ 06105000 @RF01620 TM RVVLBKUP(RVVIPTR),B'11000000' 1625 06106000 BZ @RF01625 1625 06107000 TM RVVCPLHD(RVVIPTR),B'00010000' 1625 06108000 BNZ @RF01625 1625 06109000 TM RVVALL(RVVIPTR),B'00000001' 1625 06110000 BNZ @RF01625 1625 06111000 * DO; /* @Y30LB26*/ 06112000 * CALL BACKUP; /* GET BACKUP @Y30LB26*/ 06113000 BAL @14,BACKUP 1627 06114000 * RETURN; /* @Y30LB26*/ 06115000 B @EL00023 1628 06116000 * END; /* @Y30LB26*/ 06117000 * 1629 06118000 * /*****************************************************************/ 06119000 * /* */ 06120000 * /* IF LATEST COPY IS ASKED FOR, GO LOOK FOR IT @Y30LB26*/ 06121000 * /* */ 06122000 * /*****************************************************************/ 06123000 * 1630 06124000 * IF RVVLCOPY=ON&(RVVCPLHD=OFF&RVVALL=OFF)/* WANT COPY? @ZDR2053*/ 06125000 * THEN /* @ZDR2053*/ 06126000 @RF01625 TM RVVLCOPY(RVVIPTR),B'00100000' 1630 06127000 BNO @RF01630 1630 06128000 TM RVVCPLHD(RVVIPTR),B'00010000' 1630 06129000 BNZ @RF01630 1630 06130000 TM RVVALL(RVVIPTR),B'00000001' 1630 06131000 BNZ @RF01630 1630 06132000 * DO; /* @Y30LB26*/ 06133000 * CALL LATECPY; /* GET LATEST COPY @Y30LB26*/ 06134000 BAL @14,LATECPY 1632 06135000 * RETURN; /* @Y30LB26*/ 06136000 B @EL00023 1633 06137000 * END; /* @Y30LB26*/ 06138000 * ELSE /* @Y30LB26*/ 06139000 * 1635 06140000 * /***************************************************************/ 06141000 * /* */ 06142000 * /* IF NONE OF THESE, THEN NOT ENOUGH INFO GIVEN @Y30LB26*/ 06143000 * /* */ 06144000 * /***************************************************************/ 06145000 * 1635 06146000 * DO; /* @Y30LB26*/ 06147000 @RF01630 DS 0H 1636 06148000 * RPLRCODE=NOCPYTYP; /* COPY NOT SPECIFIED @Y30LB26*/ 06149000 L @02,RPLVPTR 1636 06150000 MVC RPLRCODE(2,@02),@CB00801 1636 06151000 * RPLVRETC=FOUR; /* BAD RET CODE @Y30LB26*/ 06152000 MVC RPLVRETC(2,@02),@CB00749 1637 06153000 * CALL ERREXIT; /* SAVE RETURN CODES @Y30LB26*/ 06154000 BAL @14,ERREXIT 1638 06155000 * RETURN; /* @Y30LB26*/ 06156000 B @EL00023 1639 06157000 * END; /* @Y30LB26*/ 06158000 * END COPYDIR; /* @Y30LB26*/ 06159000 * 1642 06160000 * /*****************************************************************/ 06161000 * /* */ 06162000 * /* THIS PROCEDURE LOCATES A COPY RECORD WITH THE @Y30LB26*/ 06163000 * /* SPECIFIED DATE AND ALSO A SPECIFIED SEQUENCE @Y30LB26*/ 06164000 * /* NUMBER IF ONE WAS GIVEN @Y30LB26*/ 06165000 * /* */ 06166000 * /*****************************************************************/ 06167000 * 1642 06168000 *CPYDATE: 1642 06169000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 06170000 CPYDATE ST @14,@SA00024 1642 06171000 * COUNT=ZERO; /* INIT COUNTER @Y30LB26*/ 06172000 SLR COUNT,COUNT 1643 06173000 * VOLKY=RVVOLUME; /* VOL NAME @Y30LB26*/ 06174000 * 1644 06175000 MVC VOLKY(6),RVVOLUME(RVVIPTR) 1644 06176000 * /*****************************************************************/ 06177000 * /* */ 06178000 * /* GO RESERVE INVENTORY SHARED @Y30LB26*/ 06179000 * /* */ 06180000 * /*****************************************************************/ 06181000 * 1645 06182000 * CALL RESSHARE; /* @Y30LB26*/ 06183000 * 1645 06184000 BAL @14,RESSHARE 1645 06185000 * /*****************************************************************/ 06186000 * /* */ 06187000 * /* START LOOP LOOKING FOR SPECIFIED DATE AND SEQUENCE @Y30LB26*/ 06188000 * /* */ 06189000 * /*****************************************************************/ 06190000 * 1646 06191000 * DO WHILE I=I; /* @Y30LB26*/ 06192000 B @DE01646 1646 06193000 @DL01646 DS 0H 1647 06194000 * VIDKY=VIDKY+FIXONE; /* INCREMENT COUNT @Y30LB26*/ 06195000 LA @07,1 1647 06196000 SLR @04,@04 1647 06197000 IC @04,VIDKY 1647 06198000 ALR @07,@04 1647 06199000 STC @07,VIDKY 1647 06200000 * RPLVKEY=ADDR(VKEY); /* ADDR KEY @Y30LB26*/ 06201000 L @07,RPLVPTR 1648 06202000 LA @04,VKEY 1648 06203000 ST @04,RPLVKEY(,@07) 1648 06204000 * RPLVLOC=ON; /* LOCATE MODE @Y30LB26*/ 06205000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 06206000 OI RPLVLOC(@07),B'11000000' 1650 06207000 * RPLVTYP=RPLVREAD; /* READ RECORD @Y30LB26*/ 06208000 MVI RPLVTYP(@07),X'00' 1651 06209000 * RPLVKGE=ON; /* READ >OR= @Y30LB26*/ 06210000 OI RPLVKGE(@07),B'00000100' 1652 06211000 * RESPECIFY 1653 06212000 * REG1 RSTD; /* RESTRICT @Y30LB26*/ 06213000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 06214000 LR REG1,@07 1654 06215000 * CALL ICBVIO00; /* READ @Y30LB26*/ 06216000 L @15,@CV00671 1655 06217000 BALR @14,@15 1655 06218000 * RESPECIFY 1656 06219000 * REG1 UNRSTD; /* FREE REG1 @Y30LB26*/ 06220000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN CODE @Y30LB26*/ 06221000 L @07,RPLVPTR 1657 06222000 CLC RPLVRETC(2,@07),@CB00747 1657 06223000 BE @RF01657 1657 06224000 * DO; /* @Y30LB26*/ 06225000 * CALL ERREXIT; /* SAVE RETURN CODES @Y30LB26*/ 06226000 BAL @14,ERREXIT 1659 06227000 * RETURN; /* @Y30LB26*/ 06228000 @EL00024 DS 0H 1660 06229000 @EF00024 DS 0H 1660 06230000 @ER00024 L @14,@SA00024 1660 06231000 BR @14 1660 06232000 * END; /* @Y30LB26*/ 06233000 * COPYVPTR=RPLVBUF; /* ADDR REC READ @Y30LB26*/ 06234000 * 1662 06235000 @RF01657 L @07,RPLVPTR 1662 06236000 L @07,RPLVBUF(,@07) 1662 06237000 ST @07,COPYVPTR 1662 06238000 * /***************************************************************/ 06239000 * /* */ 06240000 * /* CHECK TO SEE IF THIS IS A COPY RECORD & CORRECT ONE @Y30LB26*/ 06241000 * /* */ 06242000 * /***************************************************************/ 06243000 * 1663 06244000 * IF COPV=VKY&COPSERNO=VOLKY THEN/* A COPY RECORD @Y30LB26*/ 06245000 CLC COPV(5,@07),VKY 1663 06246000 BNE @RF01663 1663 06247000 CLC COPSERNO(6,@07),VOLKY 1663 06248000 BNE @RF01663 1663 06249000 * DO; /* @Y30LB26*/ 06250000 * 1664 06251000 * /***********************************************************/ 06252000 * /* */ 06253000 * /* IS THIS THE SPECIFIED DATE THE COPY WAS MADE @Y30LB26*/ 06254000 * /* */ 06255000 * /***********************************************************/ 06256000 * 1665 06257000 * IF COPDATE=RVVCDATE THEN /* RITE DATE ? @ZDR2053*/ 06258000 CLC COPDATE(4,@07),RVVCDATE(RVVIPTR) 1665 06259000 BNE @RF01665 1665 06260000 * DO; /* @Y30LB26*/ 06261000 * COUNT=COUNT+ONE; /* ADD ONE SEQ CNT @Y30LB26*/ 06262000 * 1667 06263000 AL COUNT,@CF00041 1667 06264000 * /*******************************************************/ 06265000 * /* */ 06266000 * /* CHECK TO SEE IF SEQUENCE WAS GIVEN @Y30LB26*/ 06267000 * /* */ 06268000 * /*******************************************************/ 06269000 * 1668 06270000 * IF RVVSSEQ=ON THEN /* CHECK SEQUENCE @Y30LB26*/ 06271000 TM RVVSSEQ(RVVIPTR),B'00010000' 1668 06272000 BNO @RF01668 1668 06273000 * DO; /* @Y30LB26*/ 06274000 * 1669 06275000 * /***************************************************/ 06276000 * /* */ 06277000 * /* IF SEQUENCE CHECKING, CHECK COUNT @Y30LB26*/ 06278000 * /* */ 06279000 * /***************************************************/ 06280000 * 1670 06281000 * IF COUNT=RVVRDSEQ THEN/* CK COUNT @Y30LB26*/ 06282000 SLR @04,@04 1670 06283000 IC @04,RVVRDSEQ(,RVVIPTR) 1670 06284000 CR COUNT,@04 1670 06285000 BNE @RF01670 1670 06286000 * DO; /* @ZDR2053*/ 06287000 * 1671 06288000 * /***********************************************/ 06289000 * /* */ 06290000 * /* CHECK FOR CORRECT RECORD @ZDR2053*/ 06291000 * /* */ 06292000 * /***********************************************/ 06293000 * 1672 06294000 * IF RVVALL=ON|(COPHOLD=ON&RVVCPLHD=ON)|/* 1672 06295000 * @ZDR2053*/ 06296000 * (RVVCPLHD=OFF&COPHOLD=OFF)/* @ZDR2053*/ 06297000 * THEN /* @ZDR2053*/ 06298000 * 1672 06299000 TM RVVALL(RVVIPTR),B'00000001' 1672 06300000 BO @RT01672 1672 06301000 TM COPHOLD(@07),B'10000000' 1672 06302000 BNO @GL00023 1672 06303000 TM RVVCPLHD(RVVIPTR),B'00010000' 1672 06304000 BO @RT01672 1672 06305000 @GL00023 TM RVVCPLHD(RVVIPTR),B'00010000' 1672 06306000 BNZ @RF01672 1672 06307000 L @07,COPYVPTR 1672 06308000 TM COPHOLD(@07),B'10000000' 1672 06309000 BNZ @RF01672 1672 06310000 @RT01672 DS 0H 1673 06311000 * /*********************************************/ 06312000 * /* */ 06313000 * /* IF PROPER DATE, SEQUENCE, AND RECORD */ 06314000 * /* @ZDR2053*/ 06315000 * /* BUFFER AND RETURN RECORD @Y30LB26*/ 06316000 * /* */ 06317000 * /*********************************************/ 06318000 * 1673 06319000 * DO; /* @Y30LB26*/ 06320000 * CALL GETBUF;/* GET SPACE @Y30LB26*/ 06321000 BAL @14,GETBUF 1674 06322000 * IF RPLVRETC^=RCZERO THEN/* CK RETURN 1675 06323000 * @Y30LB26*/ 06324000 L @04,RPLVPTR 1675 06325000 CLC RPLVRETC(2,@04),@CB00747 1675 06326000 BNE @RT01675 1675 06327000 * RETURN; /* @Y30LB26*/ 06328000 * BUFFER=COPYV;/* REC TO BUFF @Y30LB26*/ 06329000 L @02,RVVAREA(,RVVIPTR) 1677 06330000 MVI BUFFER+164(@02),C' ' 1677 06331000 MVC BUFFER+165(91,@02),BUFFER+164(@02) 1677 06332000 L @01,COPYVPTR 1677 06333000 MVC BUFFER(164,@02),COPYV(@01) 1677 06334000 * RPLVRETC=RCZERO;/* GOOD RET CODE @Y30LB26*/ 06335000 MVC RPLVRETC(2,@04),@CB00747 1678 06336000 * RPLRCODE=RCZERO;/* GOOD REASON CODE 1679 06337000 * @Y30LB26*/ 06338000 MVC RPLRCODE(2,@04),@CB00747 1679 06339000 * RETURN; /* @Y30LB26*/ 06340000 B @EL00024 1680 06341000 * END; /* @Y30LB26*/ 06342000 * ELSE /* @Y30LB26*/ 06343000 * 1682 06344000 * /*********************************************/ 06345000 * /* */ 06346000 * /* SEQUENCE WAS SPECIFIED BUT NOT FOUND */ 06347000 * /* @Y30LB26*/ 06348000 * /* SO SET UP TO LOOP AND TRY AGAIN @Y30LB26*/ 06349000 * /* */ 06350000 * /*********************************************/ 06351000 * 1682 06352000 * VKEY=COPNAME;/* LAST KEY READ @Y30LB26*/ 06353000 @RF01672 L @07,COPYVPTR 1682 06354000 MVC VKEY(13),COPNAME(@07) 1682 06355000 * END; /* @Y30LB26*/ 06356000 * ELSE 1684 06357000 * VKEY=COPNAME; /* LAST KEY READ @ZDR2053*/ 06358000 B @RC01670 1684 06359000 @RF01670 L @07,COPYVPTR 1684 06360000 MVC VKEY(13),COPNAME(@07) 1684 06361000 * END; /* @ZDR2053*/ 06362000 * ELSE /* @Y30LB26*/ 06363000 * 1686 06364000 * /*****************************************************/ 06365000 * /* */ 06366000 * /* CHECK FOR CORRECT RECORD @ZDR2053*/ 06367000 * /* */ 06368000 * /*****************************************************/ 06369000 * 1686 06370000 * IF RVVALL=ON|(COPHOLD=ON&RVVCPLHD=ON)|/* @ZDR2053*/ 06371000 * (RVVCPLHD=OFF&COPHOLD=OFF)/* @ZDR2053*/ 06372000 * THEN /* @ZDR2053*/ 06373000 * 1686 06374000 B @RC01668 1686 06375000 @RF01668 TM RVVALL(RVVIPTR),B'00000001' 1686 06376000 BO @RT01686 1686 06377000 L @07,COPYVPTR 1686 06378000 TM COPHOLD(@07),B'10000000' 1686 06379000 BNO @GL00027 1686 06380000 TM RVVCPLHD(RVVIPTR),B'00010000' 1686 06381000 BO @RT01686 1686 06382000 @GL00027 TM RVVCPLHD(RVVIPTR),B'00010000' 1686 06383000 BNZ @RF01686 1686 06384000 L @07,COPYVPTR 1686 06385000 TM COPHOLD(@07),B'10000000' 1686 06386000 BNZ @RF01686 1686 06387000 @RT01686 DS 0H 1687 06388000 * /***************************************************/ 06389000 * /* */ 06390000 * /* SEQUENCE CHECKING WAS NOT ASKED FOR AND @ZDR2053*/ 06391000 * /* CORRECT DATE WAS LOCATED, SO RETURN RECORD */ 06392000 * /* @Y30LB26*/ 06393000 * /* */ 06394000 * /***************************************************/ 06395000 * 1687 06396000 * DO; /* @Y30LB26*/ 06397000 * CALL GETBUF; /* GET CORE @Y30LB26*/ 06398000 BAL @14,GETBUF 1688 06399000 * IF RPLVRETC^=RCZERO THEN/* CK RETURN @Y30LB26*/ 06400000 L @04,RPLVPTR 1689 06401000 CLC RPLVRETC(2,@04),@CB00747 1689 06402000 BNE @RT01689 1689 06403000 * RETURN; /* @Y30LB26*/ 06404000 * BUFFER=COPYV; /* REC TO BUFFER @Y30LB26*/ 06405000 L @02,RVVAREA(,RVVIPTR) 1691 06406000 MVI BUFFER+164(@02),C' ' 1691 06407000 MVC BUFFER+165(91,@02),BUFFER+164(@02) 1691 06408000 L @01,COPYVPTR 1691 06409000 MVC BUFFER(164,@02),COPYV(@01) 1691 06410000 * RPLRCODE=RCZERO;/* GOOD RET CODE @Y30LB26*/ 06411000 MVC RPLRCODE(2,@04),@CB00747 1692 06412000 * RPLVRETC=RCZERO;/* GOOD REASON CODE @Y30LB26*/ 06413000 MVC RPLVRETC(2,@04),@CB00747 1693 06414000 * RETURN; /* @Y30LB26*/ 06415000 B @EL00024 1694 06416000 * END; /* @Y30LB26*/ 06417000 * ELSE 1696 06418000 * VKEY=COPNAME; /* LAST KEY READ @ZDR2053*/ 06419000 @RF01686 L @07,COPYVPTR 1696 06420000 MVC VKEY(13),COPNAME(@07) 1696 06421000 * END; /* @Y30LB26*/ 06422000 * ELSE /* @Y30LB26*/ 06423000 * 1698 06424000 * /*********************************************************/ 06425000 * /* */ 06426000 * /* HAVE NOT FOUND THE RIGHT DATE YET, SO @Y30LB26*/ 06427000 * /* SET UP TO LOOP AROUND AND TRY AGAIN @Y30LB26*/ 06428000 * /* */ 06429000 * /*********************************************************/ 06430000 * 1698 06431000 * VKEY=COPNAME; /* KEY LAST READ @Y30LB26*/ 06432000 B @RC01665 1698 06433000 @RF01665 L @07,COPYVPTR 1698 06434000 MVC VKEY(13),COPNAME(@07) 1698 06435000 * END; /* @Y30LB26*/ 06436000 * ELSE /* @Y30LB26*/ 06437000 * 1700 06438000 * /*************************************************************/ 06439000 * /* */ 06440000 * /* IS NO LONGER A COPY RECORD, SO SET RECORD NOT @Y30LB26*/ 06441000 * /* FOUND REASON CODE AND RETURN @Y30LB26*/ 06442000 * /* */ 06443000 * /*************************************************************/ 06444000 * 1700 06445000 * DO; /* @Y30LB26*/ 06446000 B @RC01663 1700 06447000 @RF01663 DS 0H 1701 06448000 * RPLVRETC=FOUR; /* BAD RETURN CODE @Y30LB26*/ 06449000 L @02,RPLVPTR 1701 06450000 MVC RPLVRETC(2,@02),@CB00749 1701 06451000 * RPLRCODE=NORECRC; /* RECORD NOT FOUND @Y30LB26*/ 06452000 MVC RPLRCODE(2,@02),@CB00789 1702 06453000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 06454000 BAL @14,ERREXIT 1703 06455000 * RETURN; /* @Y30LB26*/ 06456000 B @EL00024 1704 06457000 * END; /* @Y30LB26*/ 06458000 * END; /* @Y30LB26*/ 06459000 @RC01663 DS 0H 1706 06460000 @DE01646 CLC I(1),I 1706 06461000 BE @DL01646 1706 06462000 * END CPYDATE; /* @Y30LB26*/ 06463000 B @EL00024 1707 06464000 * 1708 06465000 * /*****************************************************************/ 06466000 * /* */ 06467000 * /* ROUTINE DETERMINES IF LATEST OR OLDEST BACKUP @Y30LB26*/ 06468000 * /* WERE CALLED FOR @Y30LB26*/ 06469000 * /* */ 06470000 * /*****************************************************************/ 06471000 * 1708 06472000 *BACKUP: 1708 06473000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 06474000 BACKUP ST @14,@SA00025 1708 06475000 * VOLKY=RVVOLUME; /* BUILD KEY @Y30LB26*/ 06476000 * 1709 06477000 MVC VOLKY(6),RVVOLUME(RVVIPTR) 1709 06478000 * /*****************************************************************/ 06479000 * /* */ 06480000 * /* IF LATEST BACKUP WAS ASKED FOR, GO GET IT @Y30LB26*/ 06481000 * /* */ 06482000 * /*****************************************************************/ 06483000 * 1710 06484000 * IF RVVLBKUP=ON THEN /* LAST BACKUP? @Y30LB26*/ 06485000 TM RVVLBKUP(RVVIPTR),B'10000000' 1710 06486000 BNO @RF01710 1710 06487000 * DO; /* @Y30LB26*/ 06488000 * CALL LATEBKUP; /* GET LATEST BACKUP @Y30LB26*/ 06489000 BAL @14,LATEBKUP 1712 06490000 * RETURN; /* @Y30LB26*/ 06491000 @EL00025 DS 0H 1713 06492000 @EF00025 DS 0H 1713 06493000 @ER00025 L @14,@SA00025 1713 06494000 BR @14 1713 06495000 * END; /* @Y30LB26*/ 06496000 * ELSE /* @Y30LB26*/ 06497000 * 1715 06498000 * /***************************************************************/ 06499000 * /* */ 06500000 * /* OLDEST BACKUP WAS ASKED FOR, SO GO GET IT @Y30LB26*/ 06501000 * /* */ 06502000 * /***************************************************************/ 06503000 * 1715 06504000 * DO; /* @Y30LB26*/ 06505000 @RF01710 DS 0H 1716 06506000 * CALL OLDBKUP; /* GET LATEST BACKUP @Y30LB26*/ 06507000 BAL @14,OLDBKUP 1716 06508000 * RETURN; /* @Y30LB26*/ 06509000 B @EL00025 1717 06510000 * END; /* @Y30LB26*/ 06511000 * END BACKUP; /* @Y30LB26*/ 06512000 * 1720 06513000 * /*****************************************************************/ 06514000 * /* */ 06515000 * /* ROUTINE RETRIEVES LATEST BACKUP COPY @Y30LB26*/ 06516000 * /* */ 06517000 * /*****************************************************************/ 06518000 * 1720 06519000 *LATEBKUP: 1720 06520000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 06521000 * 1720 06522000 LATEBKUP ST @14,@SA00026 1720 06523000 * /*****************************************************************/ 06524000 * /* */ 06525000 * /* GO RESERVE INVENTORY DATA SET SHARED @Y30LB26*/ 06526000 * /* */ 06527000 * /*****************************************************************/ 06528000 * 1721 06529000 * CALL RESSHARE; /* @Y30LB26*/ 06530000 * 1721 06531000 BAL @14,RESSHARE 1721 06532000 * /*****************************************************************/ 06533000 * /* */ 06534000 * /* START LOOPING THRU LOOKING FOR LATEST BACKUP @Y30LB26*/ 06535000 * /* */ 06536000 * /*****************************************************************/ 06537000 * 1722 06538000 * DO WHILE I=I; /* LOOP @Y30LB26*/ 06539000 B @DE01722 1722 06540000 @DL01722 DS 0H 1723 06541000 * VIDKY=VIDKY+FIXONE; /* UP KEY @Y30LB26*/ 06542000 LA @04,1 1723 06543000 SLR @02,@02 1723 06544000 IC @02,VIDKY 1723 06545000 ALR @04,@02 1723 06546000 STC @04,VIDKY 1723 06547000 * RPLVKEY=ADDR(VKEY); /* ADDR OF KEY @Y30LB26*/ 06548000 L @04,RPLVPTR 1724 06549000 LA @02,VKEY 1724 06550000 ST @02,RPLVKEY(,@04) 1724 06551000 * RPLVLOC=ON; /* LOCATION MODE @Y30LB26*/ 06552000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 06553000 OI RPLVLOC(@04),B'11000000' 1726 06554000 * RPLVTYP=RPLVREAD; /* READ RECORD @Y30LB26*/ 06555000 MVI RPLVTYP(@04),X'00' 1727 06556000 * RPLVKGE=ON; /* READ > OR = @Y30LB26*/ 06557000 OI RPLVKGE(@04),B'00000100' 1728 06558000 * RESPECIFY 1729 06559000 * REG1 RSTD; /* RESTRICT REG1 @Y30LB26*/ 06560000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 06561000 LR REG1,@04 1730 06562000 * CALL ICBVIO00; /* READ COPY @Y30LB26*/ 06563000 L @15,@CV00671 1731 06564000 BALR @14,@15 1731 06565000 * RESPECIFY 1732 06566000 * REG1 UNRSTD; /* FILE REG1 @Y30LB26*/ 06567000 * 1732 06568000 * /***************************************************************/ 06569000 * /* */ 06570000 * /* CHECK RETURN FROM I/O PROCESSOR @Y30LB26*/ 06571000 * /* */ 06572000 * /***************************************************************/ 06573000 * 1733 06574000 * IF RPLVRETC^=RCZERO THEN /* CHECK RETURN CODE @Y30LB26*/ 06575000 L @04,RPLVPTR 1733 06576000 CLC RPLVRETC(2,@04),@CB00747 1733 06577000 BE @RF01733 1733 06578000 * DO; /* @Y30LB26*/ 06579000 * 1734 06580000 * /***********************************************************/ 06581000 * /* */ 06582000 * /* IF RECORD NOT FOUND, SEE IF ALREADY FOUND @Y30LB26*/ 06583000 * /* GOOD BACKUP COPY @Y30LB26*/ 06584000 * /* */ 06585000 * /***********************************************************/ 06586000 * 1735 06587000 * IF RPLRCODE=NORECRC THEN /* RECORD NOT FND @Y30LB26*/ 06588000 CLC RPLRCODE(2,@04),@CB00789 1735 06589000 BNE @RF01735 1735 06590000 * DO; /* @Y30LB26*/ 06591000 * IF BKUPFND=ON THEN /* FND GOOD REC YET ? @Y30LB26*/ 06592000 * 1737 06593000 TM BKUPFND,B'01000000' 1737 06594000 BNO @RF01737 1737 06595000 * /*****************************************************/ 06596000 * /* */ 06597000 * /* IF A GOOD ONE FOUND, READ IT @Y30LB26*/ 06598000 * /* */ 06599000 * /*****************************************************/ 06600000 * 1738 06601000 * DO; /* @Y30LB26*/ 06602000 * VKEY=SAVEKEY; /* GET OLD KEY @Y30LB26*/ 06603000 MVC VKEY(13),SAVEKEY 1739 06604000 * RPLVKEY=ADDR(VKEY);/* ADDR KEY @Y30LB26*/ 06605000 LA @02,VKEY 1740 06606000 ST @02,RPLVKEY(,@04) 1740 06607000 * RPLVLOC=ON; /* LOCATION MODE @Y30LB26*/ 06608000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 06609000 OI RPLVLOC(@04),B'11000000' 1742 06610000 * RPLVTYP=RPLVREAD; /* READ RECORD @Y30LB26*/ 06611000 MVI RPLVTYP(@04),X'00' 1743 06612000 * RPLVKGE=OFF; /* READ > OR = @Y30LB26*/ 06613000 NI RPLVKGE(@04),B'11111011' 1744 06614000 * RESPECIFY 1745 06615000 * REG1 RSTD; /* RESTRICT REG1 @Y30LB26*/ 06616000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 06617000 LR REG1,@04 1746 06618000 * CALL ICBVIO00; /* READ BACKUP @Y30LB26*/ 06619000 L @15,@CV00671 1747 06620000 BALR @14,@15 1747 06621000 * RESPECIFY 1748 06622000 * REG1 UNRSTD; /* FREE REG1 @Y30LB26*/ 06623000 * 1748 06624000 * /***************************************************/ 06625000 * /* */ 06626000 * /* CHECK RETURN CODE FROM I/O PROCESSOR @Y30LB26*/ 06627000 * /* */ 06628000 * /***************************************************/ 06629000 * 1749 06630000 * IF RPLVRETC^=RCZERO THEN/* CK RETURN CODE @Y30LB26*/ 06631000 L @04,RPLVPTR 1749 06632000 CLC RPLVRETC(2,@04),@CB00747 1749 06633000 BE @RF01749 1749 06634000 * DO; /* @Y30LB26*/ 06635000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 06636000 BAL @14,ERREXIT 1751 06637000 * RETURN; /* @Y30LB26*/ 06638000 @EL00026 DS 0H 1752 06639000 @EF00026 DS 0H 1752 06640000 @ER00026 L @14,@SA00026 1752 06641000 BR @14 1752 06642000 * END; /* @Y30LB26*/ 06643000 * 1753 06644000 * /***************************************************/ 06645000 * /* */ 06646000 * /* SET ADDRESS TO RECORD AND GET BUFFER @Y30LB26*/ 06647000 * /* SPACE AND RETURN RECORD @Y30LB26*/ 06648000 * /* */ 06649000 * /***************************************************/ 06650000 * 1754 06651000 * COPYVPTR=RPLVBUF; /* ADDR OF RECORD @Y30LB26*/ 06652000 @RF01749 L @04,RPLVPTR 1754 06653000 L @04,RPLVBUF(,@04) 1754 06654000 ST @04,COPYVPTR 1754 06655000 * CALL GETBUF; /* GET BUFFER SPACE @Y30LB26*/ 06656000 BAL @14,GETBUF 1755 06657000 * IF RPLVRETC^=RCZERO THEN/* CK RETURN @Y30LB26*/ 06658000 L @04,RPLVPTR 1756 06659000 CLC RPLVRETC(2,@04),@CB00747 1756 06660000 BNE @RT01756 1756 06661000 * RETURN; /* @Y30LB26*/ 06662000 * BUFFER=COPYV; /* MOVE IN RECORD @Y30LB26*/ 06663000 L @02,RVVAREA(,RVVIPTR) 1758 06664000 MVI BUFFER+164(@02),C' ' 1758 06665000 MVC BUFFER+165(91,@02),BUFFER+164(@02) 1758 06666000 L @01,COPYVPTR 1758 06667000 MVC BUFFER(164,@02),COPYV(@01) 1758 06668000 * RPLVRETC=RCZERO; /* GOOD RET CODE @Y30LB26*/ 06669000 MVC RPLVRETC(2,@04),@CB00747 1759 06670000 * RPLRCODE=RCZERO; /* GOOD REASON CODE @Y30LB26*/ 06671000 MVC RPLRCODE(2,@04),@CB00747 1760 06672000 * RETURN; /* @Y30LB26*/ 06673000 B @EL00026 1761 06674000 * END; /* @Y30LB26*/ 06675000 * 1762 06676000 * /*******************************************************/ 06677000 * /* */ 06678000 * /* IF GOOD RECORD NOT FOUND, GO AHEAD AND @Y30LB26*/ 06679000 * /* RETURN NO RECORD RETURN CODE @Y30LB26*/ 06680000 * /* */ 06681000 * /*******************************************************/ 06682000 * 1763 06683000 * ELSE /* @Y30LB26*/ 06684000 * DO; /* @Y30LB26*/ 06685000 @RF01737 DS 0H 1764 06686000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 06687000 BAL @14,ERREXIT 1764 06688000 * RETURN; /* @Y30LB26*/ 06689000 B @EL00026 1765 06690000 * END; /* @Y30LB26*/ 06691000 * END; /* @Y30LB26*/ 06692000 * 1767 06693000 * /***********************************************************/ 06694000 * /* */ 06695000 * /* IF RETURN FROM I/O IS NOT NO RECORD FOUND @Y30LB26*/ 06696000 * /* THEN GO AHEAD AND RETURN REASON CODE @Y30LB26*/ 06697000 * /* */ 06698000 * /***********************************************************/ 06699000 * 1768 06700000 * ELSE /* @Y30LB26*/ 06701000 * DO; /* @Y30LB26*/ 06702000 @RF01735 DS 0H 1769 06703000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 06704000 BAL @14,ERREXIT 1769 06705000 * RETURN; /* @Y30LB26*/ 06706000 B @EL00026 1770 06707000 * END; /* @Y30LB26*/ 06708000 * END; /* #Y30LB26*/ 06709000 * COPYVPTR=RPLVBUF; /* ADDR RECORD #Y30LB26*/ 06710000 * 1773 06711000 @RF01733 L @04,RPLVPTR 1773 06712000 L @04,RPLVBUF(,@04) 1773 06713000 ST @04,COPYVPTR 1773 06714000 * /***************************************************************/ 06715000 * /* */ 06716000 * /* CHECK TO SEE IF IT IS STILL A COPY RECORD #Y30LB26*/ 06717000 * /* */ 06718000 * /***************************************************************/ 06719000 * 1774 06720000 * IF COPV=VKY&COPSERNO=VOLKY THEN/* STILL COPY REC #Y30LB26*/ 06721000 CLC COPV(5,@04),VKY 1774 06722000 BNE @RF01774 1774 06723000 CLC COPSERNO(6,@04),VOLKY 1774 06724000 BNE @RF01774 1774 06725000 * DO; /* @Y30LB26*/ 06726000 * 1775 06727000 * /***********************************************************/ 06728000 * /* */ 06729000 * /* CHECK TO SEE IF IT IS A BACKUP COPY @Y30LB26*/ 06730000 * /* */ 06731000 * /***********************************************************/ 06732000 * 1776 06733000 * IF COPBKUP=ON&COPHOLD=OFF THEN/* BACKUP FOUND @Y30LB26*/ 06734000 * 1776 06735000 TM COPBKUP(@04),B'00001000' 1776 06736000 BNO @RF01776 1776 06737000 TM COPHOLD(@04),B'10000000' 1776 06738000 BNZ @RF01776 1776 06739000 * /*********************************************************/ 06740000 * /* */ 06741000 * /* IF BACKUP, SAVE KEY AND INDICATE A BACKUP FOUND */ 06742000 * /* @Y30LB26*/ 06743000 * /* AND SET KEY TO GO BACK AND TRY FOR A LATER @Y30LB26*/ 06744000 * /* BACKUP COPY @Y30LB26*/ 06745000 * /* */ 06746000 * /*********************************************************/ 06747000 * 1777 06748000 * DO; /* @Y30LB26*/ 06749000 * SAVEKEY=COPNAME; /* @Y30LB26*/ 06750000 MVC SAVEKEY(13),COPNAME(@04) 1778 06751000 * BKUPFND=ON; /* BACKUP FOUND @Y30LB26*/ 06752000 OI BKUPFND,B'01000000' 1779 06753000 * VKEY=COPNAME; /* LATEST KEY @Y30LB26*/ 06754000 MVC VKEY(13),COPNAME(@04) 1780 06755000 * END; /* @Y30LB26*/ 06756000 * 1781 06757000 * /***********************************************************/ 06758000 * /* */ 06759000 * /* THIS WAS NOT A BACKUP, SO SET KEY TO GO @Y30LB26*/ 06760000 * /* BACK AND TRY AGAIN @Y30LB26*/ 06761000 * /* */ 06762000 * /***********************************************************/ 06763000 * 1782 06764000 * ELSE /* @Y30LB26*/ 06765000 * VKEY=COPNAME; /* UPDATE KEY @Y30LB26*/ 06766000 B @RC01776 1782 06767000 @RF01776 L @04,COPYVPTR 1782 06768000 MVC VKEY(13),COPNAME(@04) 1782 06769000 * END; /* @Y30LB26*/ 06770000 * 1783 06771000 * /***************************************************************/ 06772000 * /* */ 06773000 * /* IT IS NO LONGER A COPY RECORD, SO IF A BACKUP @Y30LB26*/ 06774000 * /* WAS FOUND, GO BACK AND READ IT AND RETURN RECORD @Y30LB26*/ 06775000 * /* */ 06776000 * /***************************************************************/ 06777000 * 1784 06778000 * ELSE /* @Y30LB26*/ 06779000 * DO; /* @Y30LB26*/ 06780000 B @RC01774 1784 06781000 @RF01774 DS 0H 1785 06782000 * IF BKUPFND=ON THEN /* BACKUP FOUND @Y30LB26*/ 06783000 TM BKUPFND,B'01000000' 1785 06784000 BNO @RF01785 1785 06785000 * DO; /* @Y30LB26*/ 06786000 * VKEY=SAVEKEY; /* GET OLD KEY @Y30LB26*/ 06787000 MVC VKEY(13),SAVEKEY 1787 06788000 * RPLVKEY=ADDR(VKEY); /* ADDR KEY @Y30LB26*/ 06789000 L @04,RPLVPTR 1788 06790000 LA @02,VKEY 1788 06791000 ST @02,RPLVKEY(,@04) 1788 06792000 * RPLVLOC=ON; /* LOCATION MODE @Y30LB26*/ 06793000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 06794000 OI RPLVLOC(@04),B'11000000' 1790 06795000 * RPLVTYP=RPLVREAD; /* READ RECORD @Y30LB26*/ 06796000 MVI RPLVTYP(@04),X'00' 1791 06797000 * RPLVKGE=OFF; /* READ > OR = @Y30LB26*/ 06798000 NI RPLVKGE(@04),B'11111011' 1792 06799000 * RESPECIFY 1793 06800000 * REG1 RSTD; /* RESTRICT REG1 @Y30LB26*/ 06801000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 06802000 LR REG1,@04 1794 06803000 * CALL ICBVIO00; /* READ BACKUP @Y30LB26*/ 06804000 L @15,@CV00671 1795 06805000 BALR @14,@15 1795 06806000 * RESPECIFY 1796 06807000 * REG1 UNRSTD; /* FREE REG1 @Y30LB26*/ 06808000 * 1796 06809000 * /*******************************************************/ 06810000 * /* */ 06811000 * /* CHECK RETURN CODE FROM I/O PROCESSOR @Y30LB26*/ 06812000 * /* */ 06813000 * /*******************************************************/ 06814000 * 1797 06815000 * IF RPLVRETC^=RCZERO THEN/* CK RETURN CODE @Y30LB26*/ 06816000 L @04,RPLVPTR 1797 06817000 CLC RPLVRETC(2,@04),@CB00747 1797 06818000 BE @RF01797 1797 06819000 * DO; /* @Y30LB26*/ 06820000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 06821000 BAL @14,ERREXIT 1799 06822000 * RETURN; /* @Y30LB26*/ 06823000 B @EL00026 1800 06824000 * END; /* @Y30LB26*/ 06825000 * 1801 06826000 * /*******************************************************/ 06827000 * /* */ 06828000 * /* SET ADDRESS TO RECORD AND GET BUFFER SPACE @Y30LB26*/ 06829000 * /* AND RETURN RECORD @Y30LB26*/ 06830000 * /* */ 06831000 * /*******************************************************/ 06832000 * 1802 06833000 * COPYVPTR=RPLVBUF; /* ADDR OF RECORD @Y30LB26*/ 06834000 @RF01797 L @04,RPLVPTR 1802 06835000 L @04,RPLVBUF(,@04) 1802 06836000 ST @04,COPYVPTR 1802 06837000 * CALL GETBUF; /* GET BUFFER SPACE @Y30LB26*/ 06838000 BAL @14,GETBUF 1803 06839000 * IF RPLVRETC^=RCZERO THEN/* CK RETURN @Y30LB26*/ 06840000 L @04,RPLVPTR 1804 06841000 CLC RPLVRETC(2,@04),@CB00747 1804 06842000 BNE @RT01804 1804 06843000 * RETURN; /* @Y30LB26*/ 06844000 * BUFFER=COPYV; /* MOVE IN RECORD @Y30LB26*/ 06845000 L @02,RVVAREA(,RVVIPTR) 1806 06846000 MVI BUFFER+164(@02),C' ' 1806 06847000 MVC BUFFER+165(91,@02),BUFFER+164(@02) 1806 06848000 L @01,COPYVPTR 1806 06849000 MVC BUFFER(164,@02),COPYV(@01) 1806 06850000 * RPLVRETC=RCZERO; /* GOOD RET CODE @Y30LB26*/ 06851000 MVC RPLVRETC(2,@04),@CB00747 1807 06852000 * RPLRCODE=RCZERO; /* GOOD REASON CODE @Y30LB26*/ 06853000 MVC RPLRCODE(2,@04),@CB00747 1808 06854000 * RETURN; /* @Y30LB26*/ 06855000 B @EL00026 1809 06856000 * END; /* @Y30LB26*/ 06857000 * 1810 06858000 * /***********************************************************/ 06859000 * /* */ 06860000 * /* NO BACKUP RECORD WAS FOUND, SO SET REASON @Y30LB26*/ 06861000 * /* CODE AND RETURN @Y30LB26*/ 06862000 * /* */ 06863000 * /***********************************************************/ 06864000 * 1811 06865000 * ELSE /* @Y30LB26*/ 06866000 * DO; /* @Y30LB26*/ 06867000 @RF01785 DS 0H 1812 06868000 * RPLVRETC=FOUR; /* BAD RET CODE @Y30LB26*/ 06869000 L @02,RPLVPTR 1812 06870000 MVC RPLVRETC(2,@02),@CB00749 1812 06871000 * RPLRCODE=NORECRC; /* RECORD NOT FOUND @Y30LB26*/ 06872000 MVC RPLRCODE(2,@02),@CB00789 1813 06873000 * CALL ERREXIT; /* SAVE RETURN CODES @Y30LB26*/ 06874000 BAL @14,ERREXIT 1814 06875000 * RETURN; /* @Y30LB26*/ 06876000 B @EL00026 1815 06877000 * END; /* @Y30LB26*/ 06878000 * END; /* @Y30LB26*/ 06879000 * END; /* @Y30LB26*/ 06880000 @RC01774 DS 0H 1818 06881000 @DE01722 CLC I(1),I 1818 06882000 BE @DL01722 1818 06883000 * END LATEBKUP; /* @Y30LB26*/ 06884000 B @EL00026 1819 06885000 * 1820 06886000 * /*****************************************************************/ 06887000 * /* */ 06888000 * /* THIS ROUTINE RETURNS THE OLDEST BACKUP COPY IF @Y30LB26*/ 06889000 * /* ONE EXISTS @Y30LB26*/ 06890000 * /* */ 06891000 * /*****************************************************************/ 06892000 * 1820 06893000 *OLDBKUP: 1820 06894000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 06895000 * 1820 06896000 OLDBKUP ST @14,@SA00027 1820 06897000 * /*****************************************************************/ 06898000 * /* */ 06899000 * /* RESERVE INVENTORY SHARED @Y30LB26*/ 06900000 * /* */ 06901000 * /*****************************************************************/ 06902000 * 1821 06903000 * CALL RESSHARE; /* @Y30LB26*/ 06904000 * 1821 06905000 BAL @14,RESSHARE 1821 06906000 * /*****************************************************************/ 06907000 * /* */ 06908000 * /* START LOOP LOOKING FOR OLDEST BACKUP @Y30LB26*/ 06909000 * /* */ 06910000 * /*****************************************************************/ 06911000 * 1822 06912000 * DO WHILE I=I; /* LOOP @Y30LB26*/ 06913000 B @DE01822 1822 06914000 @DL01822 DS 0H 1823 06915000 * VIDKY=VIDKY+FIXONE; /* UPDATE COUNTER @Y30LB26*/ 06916000 LA @04,1 1823 06917000 SLR @02,@02 1823 06918000 IC @02,VIDKY 1823 06919000 ALR @04,@02 1823 06920000 STC @04,VIDKY 1823 06921000 * RPLVKEY=ADDR(VKEY); /* ADDR KEY @Y30LB26*/ 06922000 L @04,RPLVPTR 1824 06923000 LA @02,VKEY 1824 06924000 ST @02,RPLVKEY(,@04) 1824 06925000 * RPLVLOC=ON; /* LOCATION MODE @Y30LB26*/ 06926000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 06927000 OI RPLVLOC(@04),B'11000000' 1826 06928000 * RPLVTYP=RPLVREAD; /* READ RECORD @Y30LB26*/ 06929000 MVI RPLVTYP(@04),X'00' 1827 06930000 * RPLVKGE=ON; /* FOR > OR = @Y30LB26*/ 06931000 OI RPLVKGE(@04),B'00000100' 1828 06932000 * RESPECIFY 1829 06933000 * REG1 RSTD; /* RESTRICT REG1 @Y30LB26*/ 06934000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 06935000 LR REG1,@04 1830 06936000 * CALL ICBVIO00; /* READ COPY RECORD @Y30LB26*/ 06937000 L @15,@CV00671 1831 06938000 BALR @14,@15 1831 06939000 * RESPECIFY 1832 06940000 * REG1 UNRSTD; /* FREE REG1 @Y30LB26*/ 06941000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN CODE @Y30LB26*/ 06942000 L @04,RPLVPTR 1833 06943000 CLC RPLVRETC(2,@04),@CB00747 1833 06944000 BE @RF01833 1833 06945000 * DO; /* @Y30LB26*/ 06946000 * CALL ERREXIT; /* SAVE RETURN CODES @Y30LB26*/ 06947000 BAL @14,ERREXIT 1835 06948000 * RETURN; /* @Y30LB26*/ 06949000 @EL00027 DS 0H 1836 06950000 @EF00027 DS 0H 1836 06951000 @ER00027 L @14,@SA00027 1836 06952000 BR @14 1836 06953000 * END; /* @Y30LB26*/ 06954000 * 1837 06955000 * /***************************************************************/ 06956000 * /* */ 06957000 * /* SET UP ADDRESSING TO RECORD JUST READ AND @Y30LB26*/ 06958000 * /* SEE IF IT IS STILL A COPY RECORD @Y30LB26*/ 06959000 * /* */ 06960000 * /***************************************************************/ 06961000 * 1838 06962000 * COPYVPTR=RPLVBUF; /* ADDR RECORD @Y30LB26*/ 06963000 @RF01833 L @04,RPLVPTR 1838 06964000 L @04,RPLVBUF(,@04) 1838 06965000 ST @04,COPYVPTR 1838 06966000 * IF COPV=VKY&COPSERNO=VOLKY THEN/* STILL COPY REC? @Y30LB26*/ 06967000 CLC COPV(5,@04),VKY 1839 06968000 BNE @RF01839 1839 06969000 CLC COPSERNO(6,@04),VOLKY 1839 06970000 BNE @RF01839 1839 06971000 * DO; /* @Y30LB26*/ 06972000 * 1840 06973000 * /***********************************************************/ 06974000 * /* */ 06975000 * /* IF IT IS A COPY AND A BACKUP, GET BUFFER @Y30LB26*/ 06976000 * /* AND RETURN RECORD @Y30LB26*/ 06977000 * /* */ 06978000 * /***********************************************************/ 06979000 * 1841 06980000 * IF COPBKUP=ON&COPHOLD=OFF THEN/* BACKUP COPY @Y30LB26*/ 06981000 TM COPBKUP(@04),B'00001000' 1841 06982000 BNO @RF01841 1841 06983000 TM COPHOLD(@04),B'10000000' 1841 06984000 BNZ @RF01841 1841 06985000 * DO; /* @Y30LB26*/ 06986000 * CALL GETBUF; /* GET CORE @Y30LB26*/ 06987000 BAL @14,GETBUF 1843 06988000 * IF RPLVRETC^=RCZERO THEN/* CK RETURN @Y30LB26*/ 06989000 L @04,RPLVPTR 1844 06990000 CLC RPLVRETC(2,@04),@CB00747 1844 06991000 BNE @RT01844 1844 06992000 * RETURN; /* @Y30LB26*/ 06993000 * BUFFER=COPYV; /* MOVE IN RECORD @Y30LB26*/ 06994000 L @02,RVVAREA(,RVVIPTR) 1846 06995000 MVI BUFFER+164(@02),C' ' 1846 06996000 MVC BUFFER+165(91,@02),BUFFER+164(@02) 1846 06997000 L @01,COPYVPTR 1846 06998000 MVC BUFFER(164,@02),COPYV(@01) 1846 06999000 * RPLRCODE=RCZERO; /* GOOD REASON CODE @Y30LB26*/ 07000000 MVC RPLRCODE(2,@04),@CB00747 1847 07001000 * RPLVRETC=RCZERO; /* GOOD RETURN CODE @Y30LB26*/ 07002000 MVC RPLVRETC(2,@04),@CB00747 1848 07003000 * RETURN; /* @Y30LB26*/ 07004000 B @EL00027 1849 07005000 * END; /* @Y30LB26*/ 07006000 * 1850 07007000 * /***********************************************************/ 07008000 * /* */ 07009000 * /* THIS IS NOT A BACKUP, SO SET UP KEY AND GO @Y30LB26*/ 07010000 * /* AND TRY ANOTHER COPY RECORD @Y30LB26*/ 07011000 * /* */ 07012000 * /***********************************************************/ 07013000 * 1851 07014000 * ELSE /* @Y30LB26*/ 07015000 * VKEY=COPNAME; /* READY NEXT READ @Y30LB26*/ 07016000 @RF01841 L @04,COPYVPTR 1851 07017000 MVC VKEY(13),COPNAME(@04) 1851 07018000 * END; /* @Y30LB26*/ 07019000 * 1852 07020000 * /***************************************************************/ 07021000 * /* */ 07022000 * /* NO LONGER COPY RECORDS AND A BACKUP WAS NOT FOUND, @Y30LB26*/ 07023000 * /* SO SET REASON CODE INDICATING RECORD WAS NOT @Y30LB26*/ 07024000 * /* FOUND AND RETURN @Y30LB26*/ 07025000 * /* */ 07026000 * /***************************************************************/ 07027000 * 1853 07028000 * ELSE /* @Y30LB26*/ 07029000 * DO; /* @Y30LB26*/ 07030000 B @RC01839 1853 07031000 @RF01839 DS 0H 1854 07032000 * RPLRCODE=NORECRC; /* NO DUPLICATE @Y30LB26*/ 07033000 L @02,RPLVPTR 1854 07034000 MVC RPLRCODE(2,@02),@CB00789 1854 07035000 * RPLVRETC=FOUR; /* BAD RETURN CODE @Y30LB26*/ 07036000 MVC RPLVRETC(2,@02),@CB00749 1855 07037000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 07038000 BAL @14,ERREXIT 1856 07039000 * RETURN; /* @Y30LB26*/ 07040000 B @EL00027 1857 07041000 * END; /* @Y30LB26*/ 07042000 * END; /* @Y30LB26*/ 07043000 @RC01839 DS 0H 1859 07044000 @DE01822 CLC I(1),I 1859 07045000 BE @DL01822 1859 07046000 * END OLDBKUP; /* @Y30LB26*/ 07047000 B @EL00027 1860 07048000 * 1861 07049000 * /*****************************************************************/ 07050000 * /* */ 07051000 * /* ROUTINE READS AND RETURNS THE LATEST COPY @Y30LB26*/ 07052000 * /* */ 07053000 * /*****************************************************************/ 07054000 * 1861 07055000 *LATECPY: 1861 07056000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 07057000 * 1861 07058000 LATECPY ST @14,@SA00028 1861 07059000 * /*****************************************************************/ 07060000 * /* */ 07061000 * /* RESERVE INVENTORY SHARED @Y30LB26*/ 07062000 * /* */ 07063000 * /*****************************************************************/ 07064000 * 1862 07065000 * CALL RESSHARE; /* @Y30LB26*/ 07066000 * 1862 07067000 BAL @14,RESSHARE 1862 07068000 * /*****************************************************************/ 07069000 * /* */ 07070000 * /* READ BASE VOLUME RECORD TO GET KEY TO LATEST @Y30LB26*/ 07071000 * /* COPY OF VOLUME @Y30LB26*/ 07072000 * /* */ 07073000 * /*****************************************************************/ 07074000 * 1863 07075000 * VOLKY=RVVOLUME; /* BUILD KEY @Y30LB26*/ 07076000 MVC VOLKY(6),RVVOLUME(RVVIPTR) 1863 07077000 * RPLVKEY=ADDR(VKEY); /* ADDR KEY @Y30LB26*/ 07078000 L @04,RPLVPTR 1864 07079000 LA @02,VKEY 1864 07080000 ST @02,RPLVKEY(,@04) 1864 07081000 * RPLVLOC=ON; /* LOCATE MODE @Y30LB26*/ 07082000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 07083000 OI RPLVLOC(@04),B'11000000' 1866 07084000 * RPLVTYP=RPLVREAD; /* READ RECORD @Y30LB26*/ 07085000 MVI RPLVTYP(@04),X'00' 1867 07086000 * RESPECIFY 1868 07087000 * REG1 RSTD; /* RESTRICT REG1 @Y30LB26*/ 07088000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 07089000 LR REG1,@04 1869 07090000 * CALL ICBVIO00; /* READ BASE REC @Y30LB26*/ 07091000 L @15,@CV00671 1870 07092000 BALR @14,@15 1870 07093000 * RESPECIFY 1871 07094000 * REG1 UNRSTD; /* FREE REG1 @Y30LB26*/ 07095000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN CODE @Y30LB26*/ 07096000 L @04,RPLVPTR 1872 07097000 CLC RPLVRETC(2,@04),@CB00747 1872 07098000 BE @RF01872 1872 07099000 * DO; /* @Y30LB26*/ 07100000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 07101000 BAL @14,ERREXIT 1874 07102000 * RETURN; /* @Y30LB26*/ 07103000 @EL00028 DS 0H 1875 07104000 @EF00028 DS 0H 1875 07105000 @ER00028 L @14,@SA00028 1875 07106000 BR @14 1875 07107000 * END; /* @Y30LB26*/ 07108000 * 1876 07109000 * /*****************************************************************/ 07110000 * /* */ 07111000 * /* SET UP ADDRESSING TO RECORD AND GET LATEST COPY KEY @Y30LB26*/ 07112000 * /* */ 07113000 * /*****************************************************************/ 07114000 * 1877 07115000 * BASEVPTR=RPLVBUF; /* ADD REC JUST READ @Y30LB26*/ 07116000 * 1877 07117000 @RF01872 L @04,RPLVPTR 1877 07118000 L @02,RPLVBUF(,@04) 1877 07119000 ST @02,BASEVPTR 1877 07120000 * /*****************************************************************/ 07121000 * /* */ 07122000 * /* CHECK TO SEE IF THERE REALLY IS A COPY THERE @Y30LB26*/ 07123000 * /* */ 07124000 * /*****************************************************************/ 07125000 * 1878 07126000 * IF BASNCOPY=ZERO THEN /* NO COPIES ? @Y30LB26*/ 07127000 CLI BASNCOPY(@02),0 1878 07128000 BNE @RF01878 1878 07129000 * DO; /* @Y30LB26*/ 07130000 * RPLVRETC=FOUR; /* BAD RETURN CODE @Y30LB26*/ 07131000 MVC RPLVRETC(2,@04),@CB00749 1880 07132000 * RPLRCODE=NORECRC; /* RECORD DOES NOT EXIST @Y30LB26*/ 07133000 MVC RPLRCODE(2,@04),@CB00789 1881 07134000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 07135000 BAL @14,ERREXIT 1882 07136000 * RETURN; /* RETURN TO CALLER @Y30LB26*/ 07137000 B @EL00028 1883 07138000 * END; /* @Y30LB26*/ 07139000 * ELSE /* @Y30LB26*/ 07140000 * VKEY=BASKLCPY; /* GET KEY LATEST CPY @Y30LB26*/ 07141000 @RF01878 L @04,BASEVPTR 1885 07142000 MVC VKEY(13),BASKLCPY(@04) 1885 07143000 * RPLVKEY=ADDR(VKEY); /* ADDR KEY #Y30LB26*/ 07144000 L @04,RPLVPTR 1886 07145000 LA @02,VKEY 1886 07146000 ST @02,RPLVKEY(,@04) 1886 07147000 * RESPECIFY 1887 07148000 * REG1 RSTD; /* RESTRICT REG1 @Y30LB26*/ 07149000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 07150000 LR REG1,@04 1888 07151000 * CALL ICBVIO00; /* READ LATEST COPY @Y30LB26*/ 07152000 L @15,@CV00671 1889 07153000 BALR @14,@15 1889 07154000 * RESPECIFY 1890 07155000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 07156000 * 1890 07157000 * /*****************************************************************/ 07158000 * /* */ 07159000 * /* CHECK RETURN CODE FROM I/O PROCESSOR @Y30LB26*/ 07160000 * /* */ 07161000 * /*****************************************************************/ 07162000 * 1891 07163000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN CODE @Y30LB26*/ 07164000 L @04,RPLVPTR 1891 07165000 CLC RPLVRETC(2,@04),@CB00747 1891 07166000 BE @RF01891 1891 07167000 * DO; /* @Y30LB26*/ 07168000 * CALL ERREXIT; /* SAVE RETURN CODE @Y30LB26*/ 07169000 BAL @14,ERREXIT 1893 07170000 * RETURN; /* @Y30LB26*/ 07171000 B @EL00028 1894 07172000 * END; /* @Y30LB26*/ 07173000 * 1895 07174000 * /*****************************************************************/ 07175000 * /* */ 07176000 * /* SET UP ADDRESSING TO RECORD AND GET BUFFER @Y30LB26*/ 07177000 * /* PUT RECORD IN BUFFER AND RETURN @Y30LB26*/ 07178000 * /* */ 07179000 * /*****************************************************************/ 07180000 * 1896 07181000 * COPYVPTR=RPLVBUF; /* ADDR RECORD READ @Y30LB26*/ 07182000 @RF01891 L @04,RPLVPTR 1896 07183000 L @04,RPLVBUF(,@04) 1896 07184000 ST @04,COPYVPTR 1896 07185000 * CALL GETBUF; /* GET CORE @Y30LB26*/ 07186000 BAL @14,GETBUF 1897 07187000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @Y30LB26*/ 07188000 L @04,RPLVPTR 1898 07189000 CLC RPLVRETC(2,@04),@CB00747 1898 07190000 BNE @RT01898 1898 07191000 * RETURN; /* @Y30LB26*/ 07192000 * BUFFER=COPYV; /* MOVE IN RECORD @Y30LB26*/ 07193000 L @02,RVVAREA(,RVVIPTR) 1900 07194000 MVI BUFFER+164(@02),C' ' 1900 07195000 MVC BUFFER+165(91,@02),BUFFER+164(@02) 1900 07196000 L @01,COPYVPTR 1900 07197000 MVC BUFFER(164,@02),COPYV(@01) 1900 07198000 * RPLVRETC=RCZERO; /* GOOD RETURN @Y30LB26*/ 07199000 MVC RPLVRETC(2,@04),@CB00747 1901 07200000 * RPLRCODE=RCZERO; /* GOOD REASON CODE @Y30LB26*/ 07201000 MVC RPLRCODE(2,@04),@CB00747 1902 07202000 * RETURN; /* @Y30LB26*/ 07203000 B @EL00028 1903 07204000 * END LATECPY; /* @Y30LB26*/ 07205000 B @EL00028 1904 07206000 * 1905 07207000 * /*****************************************************************/ 07208000 * /* */ 07209000 * /* THIS ROUTINE READS NEXT FOR A COPY RECORD @Y30LB26*/ 07210000 * /* A COPYID MUST BE SPECIFIED FOR THIS OPTION @Y30LB26*/ 07211000 * /* */ 07212000 * /*****************************************************************/ 07213000 * 1905 07214000 *COPYNREC: 1905 07215000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 07216000 * 1905 07217000 COPYNREC ST @14,@SA00029 1905 07218000 * /*****************************************************************/ 07219000 * /* */ 07220000 * /* INSURE THAT COPYID WAS GIVEN @Y30LB26*/ 07221000 * /* IF NOT GIVEN, SET BAD REASON CODE AND RETURN @Y30LB26*/ 07222000 * /* */ 07223000 * /*****************************************************************/ 07224000 * 1906 07225000 * IF RVVSCPY=OFF THEN /* COPYID SPECIFIED @Y30LB26*/ 07226000 TM RVVSCPY(RVVIPTR),B'00000100' 1906 07227000 BNZ @RF01906 1906 07228000 * DO; /* @Y30LB26*/ 07229000 * RPLVRETC=FOUR; /* BAD RET CODE @Y30LB26*/ 07230000 L @02,RPLVPTR 1908 07231000 MVC RPLVRETC(2,@02),@CB00749 1908 07232000 * RPLRCODE=NOCPYID; /* MUST SPEC COPY ID @Y30LB26*/ 07233000 MVC RPLRCODE(2,@02),@CB00815 1909 07234000 * RETURN; /* @Y30LB26*/ 07235000 @EL00029 DS 0H 1910 07236000 @EF00029 DS 0H 1910 07237000 @ER00029 L @14,@SA00029 1910 07238000 BR @14 1910 07239000 * END; /* @Y30LB26*/ 07240000 * 1911 07241000 * /*****************************************************************/ 07242000 * /* */ 07243000 * /* RESERVE INVENTORY DATA SET SHARED @Y30LB26*/ 07244000 * /* */ 07245000 * /*****************************************************************/ 07246000 * 1912 07247000 * CALL RESSHARE; /* @Y30LB26*/ 07248000 * 1912 07249000 @RF01906 BAL @14,RESSHARE 1912 07250000 * /*****************************************************************/ 07251000 * /* */ 07252000 * /* PUT IN COPYID AND VOLUME NAME IN KEY TO READ @Y30LB26*/ 07253000 * /* GREATER THAN OR EQUAL @Y30LB26*/ 07254000 * /* */ 07255000 * /*****************************************************************/ 07256000 * 1913 07257000 * VIDKY=RVVCPYID; /* ID TO KEY @Y30LB26*/ 07258000 MVC VIDKY(1),RVVCPYID(RVVIPTR) 1913 07259000 * VOLKY=RVVOLUME; /* VOLUME NAME @Y30LB26*/ 07260000 * 1914 07261000 MVC VOLKY(6),RVVOLUME(RVVIPTR) 1914 07262000 * /*****************************************************************/ 07263000 * /* */ 07264000 * /* LOOP TO FIND THE CORRECT COPY VOLUME RECORD @ZDR2053*/ 07265000 * /* */ 07266000 * /*****************************************************************/ 07267000 * 1915 07268000 * DO WHILE I=I; /* @ZDR2053*/ 07269000 B @DE01915 1915 07270000 @DL01915 DS 0H 1916 07271000 * VIDKY=VIDKY+FIXONE; /* INCREM ID FIELD @Y30LB26*/ 07272000 LA @04,1 1916 07273000 SLR @02,@02 1916 07274000 IC @02,VIDKY 1916 07275000 ALR @04,@02 1916 07276000 STC @04,VIDKY 1916 07277000 * RPLVKEY=ADDR(VKEY); /* ADDR OF KEY @Y30LB26*/ 07278000 L @04,RPLVPTR 1917 07279000 LA @02,VKEY 1917 07280000 ST @02,RPLVKEY(,@04) 1917 07281000 * RPLVLOC=ON; /* LOCATE MODE @Y30LB26*/ 07282000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 07283000 OI RPLVLOC(@04),B'11000000' 1919 07284000 * RPLVTYP=RPLVREAD; /* READ RECORD @Y30LB26*/ 07285000 MVI RPLVTYP(@04),X'00' 1920 07286000 * RPLVKGE=ON; /* FOR > OR = @Y30LB26*/ 07287000 OI RPLVKGE(@04),B'00000100' 1921 07288000 * RESPECIFY 1922 07289000 * REG1 RSTD; /* RESTRICT REG1 @Y30LB26*/ 07290000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 07291000 LR REG1,@04 1923 07292000 * CALL ICBVIO00; /* READ COPY @Y30LB26*/ 07293000 L @15,@CV00671 1924 07294000 BALR @14,@15 1924 07295000 * RESPECIFY 1925 07296000 * REG1 UNRSTD; /* FREE REG1 @Y30LB26*/ 07297000 * 1925 07298000 * /***************************************************************/ 07299000 * /* */ 07300000 * /* CHECK RETURN CODE FROM I/O PROCESSOR @Y30LB26*/ 07301000 * /* */ 07302000 * /***************************************************************/ 07303000 * 1926 07304000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN CODE @Y30LB26*/ 07305000 L @04,RPLVPTR 1926 07306000 CLC RPLVRETC(2,@04),@CB00747 1926 07307000 BE @RF01926 1926 07308000 * DO; /* @Y30LB26*/ 07309000 * CALL ERREXIT; /* SAVE REASON CODE @Y30LB26*/ 07310000 BAL @14,ERREXIT 1928 07311000 * RETURN; /* @Y30LB26*/ 07312000 B @EL00029 1929 07313000 * END; /* @Y30LB26*/ 07314000 * 1930 07315000 * /***************************************************************/ 07316000 * /* */ 07317000 * /* GET ADDRESS OF RECORD JUST READ AND CHECK TO SEE IF @Y30LB26*/ 07318000 * /* IT IS STILL A COPY RECORD OF CORRECT VOLUME @Y30LB26*/ 07319000 * /* */ 07320000 * /***************************************************************/ 07321000 * 1931 07322000 * COPYVPTR=RPLVBUF; /* ADDR RECORD @Y30LB26*/ 07323000 @RF01926 L @04,RPLVPTR 1931 07324000 L @04,RPLVBUF(,@04) 1931 07325000 ST @04,COPYVPTR 1931 07326000 * IF COPV=VKY&COPSERNO=VOLKY THEN/* STILL @ZDR2053*/ 07327000 CLC COPV(5,@04),VKY 1932 07328000 BNE @RF01932 1932 07329000 CLC COPSERNO(6,@04),VOLKY 1932 07330000 BNE @RF01932 1932 07331000 * DO; /* @ZDR2053*/ 07332000 * 1933 07333000 * /***********************************************************/ 07334000 * /* */ 07335000 * /* CHECK FOR THE CORRECT RECORD @ZDR2053*/ 07336000 * /* */ 07337000 * /***********************************************************/ 07338000 * 1934 07339000 * IF RVVALL=ON|(COPHOLD=ON&RVVCPLHD=ON)|/* @ZDR2053*/ 07340000 * (RVVCPLHD=OFF&COPHOLD=OFF) THEN/* @ZDR2053*/ 07341000 * 1934 07342000 TM RVVALL(RVVIPTR),B'00000001' 1934 07343000 BO @RT01934 1934 07344000 TM COPHOLD(@04),B'10000000' 1934 07345000 BNO @GL00036 1934 07346000 TM RVVCPLHD(RVVIPTR),B'00010000' 1934 07347000 BO @RT01934 1934 07348000 @GL00036 TM RVVCPLHD(RVVIPTR),B'00010000' 1934 07349000 BNZ @RF01934 1934 07350000 L @04,COPYVPTR 1934 07351000 TM COPHOLD(@04),B'10000000' 1934 07352000 BNZ @RF01934 1934 07353000 @RT01934 DS 0H 1935 07354000 * /*********************************************************/ 07355000 * /* */ 07356000 * /* IF STILL THE CORRECT COPY, GET BUFFER SPACE @Y30LB26*/ 07357000 * /* RETURN RECORD @Y30LB26*/ 07358000 * /* */ 07359000 * /*********************************************************/ 07360000 * 1935 07361000 * DO; /* @Y30LB26*/ 07362000 * CALL GETBUF; /* GET SPACE @Y30LB26*/ 07363000 BAL @14,GETBUF 1936 07364000 * IF RPLVRETC^=RCZERO THEN/* CK RETURN @Y30LB26*/ 07365000 L @04,RPLVPTR 1937 07366000 CLC RPLVRETC(2,@04),@CB00747 1937 07367000 BNE @RT01937 1937 07368000 * RETURN; /* @Y30LB26*/ 07369000 * BUFFER=COPYV; /* MOVE IN RECORD @Y30LB26*/ 07370000 L @02,RVVAREA(,RVVIPTR) 1939 07371000 MVI BUFFER+164(@02),C' ' 1939 07372000 MVC BUFFER+165(91,@02),BUFFER+164(@02) 1939 07373000 L @01,COPYVPTR 1939 07374000 MVC BUFFER(164,@02),COPYV(@01) 1939 07375000 * RPLVRETC=RCZERO; /* GOOD RET CODE @Y30LB26*/ 07376000 MVC RPLVRETC(2,@04),@CB00747 1940 07377000 * RPLRCODE=RCZERO; /* GOOD REASON CODE @Y30LB26*/ 07378000 MVC RPLRCODE(2,@04),@CB00747 1941 07379000 * RETURN; /* @Y30LB26*/ 07380000 B @EL00029 1942 07381000 * END; /* @Y30LB26*/ 07382000 * ELSE /* @Y30LB26*/ 07383000 * 1944 07384000 * /*********************************************************/ 07385000 * /* */ 07386000 * /* SET UP TO READ THE NEXT COPY VOLUME RECORD @ZDR2053*/ 07387000 * /* */ 07388000 * /*********************************************************/ 07389000 * 1944 07390000 * VKEY=COPNAME; /* @ZDR2053*/ 07391000 @RF01934 L @04,COPYVPTR 1944 07392000 MVC VKEY(13),COPNAME(@04) 1944 07393000 * END; /* @ZDR2053*/ 07394000 * 1945 07395000 * /***************************************************************/ 07396000 * /* */ 07397000 * /* BAD RETURN CODE AND INDICATE NO RECORD FOUND @Y30LB26*/ 07398000 * /* */ 07399000 * /***************************************************************/ 07400000 * 1946 07401000 * ELSE 1946 07402000 * DO; /* @Y30LB26*/ 07403000 B @RC01932 1946 07404000 @RF01932 DS 0H 1947 07405000 * RPLVRETC=FOUR; /* BAD RETURN @Y30LB26*/ 07406000 L @02,RPLVPTR 1947 07407000 MVC RPLVRETC(2,@02),@CB00749 1947 07408000 * RPLRCODE=NORECRC; /* NO NEXT COPY @Y30LB26*/ 07409000 MVC RPLRCODE(2,@02),@CB00789 1948 07410000 * CALL ERREXIT; /* SAVE REASON CODE @Y30LB26*/ 07411000 BAL @14,ERREXIT 1949 07412000 * RETURN; /* @Y30LB26*/ 07413000 B @EL00029 1950 07414000 * END; /* @Y30LB26*/ 07415000 * END; /* @ZDR2053*/ 07416000 @RC01932 DS 0H 1952 07417000 @DE01915 CLC I(1),I 1952 07418000 BE @DL01915 1952 07419000 * END COPYNREC; /* @Y30LB26*/ 07420000 B @EL00029 1953 07421000 * 1954 07422000 * /*****************************************************************/ 07423000 * /* */ 07424000 * /* ROUTINE READS FOR A DUPLICATE VOLUME RECORD. IF @Y30LB26*/ 07425000 * /* THE FIRST DUP RECORD IS DESIRED, A READ NEXT @Y30LB26*/ 07426000 * /* MUST BE SPECIFIED INSTEAD OF A READ DIRECT @Y30LB26*/ 07427000 * /* */ 07428000 * /*****************************************************************/ 07429000 * 1954 07430000 *DUPDIR: 1954 07431000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 07432000 * 1954 07433000 DUPDIR ST @14,@SA00030 1954 07434000 * /*****************************************************************/ 07435000 * /* */ 07436000 * /* RESERVE INVENTORY DATA SET SHARED @Y30LB26*/ 07437000 * /* */ 07438000 * /*****************************************************************/ 07439000 * 1955 07440000 * CALL RESSHARE; /* @Y30LB26*/ 07441000 * 1955 07442000 BAL @14,RESSHARE 1955 07443000 * /*****************************************************************/ 07444000 * /* */ 07445000 * /* SET KEY ID TO ONE AND READ FOR GREATER @Y30LB26*/ 07446000 * /* THAN OR EQUAL @Y30LB26*/ 07447000 * /* */ 07448000 * /*****************************************************************/ 07449000 * 1956 07450000 * DVOLKY=RVVOLUME; /* GET VOLUME @Y30LB26*/ 07451000 MVC DVOLKY(6),RVVOLUME(RVVIPTR) 1956 07452000 * DIDKY=FIXONE; /* SET ID TO FIRST REG @Y30LB26*/ 07453000 MVI DIDKY,X'01' 1957 07454000 * RPLVKEY=ADDR(DKEY); /* ADDR LEU @Y30LB26*/ 07455000 L @04,RPLVPTR 1958 07456000 LA @02,DKEY 1958 07457000 ST @02,RPLVKEY(,@04) 1958 07458000 * RPLVLOC=ON; /* LOCATION MODE @Y30LB26*/ 07459000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 07460000 OI RPLVLOC(@04),B'11000000' 1960 07461000 * RPLVTYP=RPLVREAD; /* READ RECORD @Y30LB26*/ 07462000 MVI RPLVTYP(@04),X'00' 1961 07463000 * RPLVKGE=ON; /* READ > OR = @Y30LB26*/ 07464000 OI RPLVKGE(@04),B'00000100' 1962 07465000 * RESPECIFY 1963 07466000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 07467000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 07468000 LR REG1,@04 1964 07469000 * CALL ICBVIO00; /* READ FOR DUP @Y30LB26*/ 07470000 L @15,@CV00671 1965 07471000 BALR @14,@15 1965 07472000 * RESPECIFY 1966 07473000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 07474000 * 1966 07475000 * /*****************************************************************/ 07476000 * /* */ 07477000 * /* CHECK FOR BAD RETURN CODE FROM I/O PROCESSOR @Y30LB26*/ 07478000 * /* */ 07479000 * /*****************************************************************/ 07480000 * 1967 07481000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN CODE @Y30LB26*/ 07482000 L @04,RPLVPTR 1967 07483000 CLC RPLVRETC(2,@04),@CB00747 1967 07484000 BE @RF01967 1967 07485000 * DO; /* @Y30LB26*/ 07486000 * CALL ERREXIT; /* SAVE RETURN CODES @Y30LB26*/ 07487000 BAL @14,ERREXIT 1969 07488000 * RETURN; /* @Y30LB26*/ 07489000 @EL00030 DS 0H 1970 07490000 @EF00030 DS 0H 1970 07491000 @ER00030 L @14,@SA00030 1970 07492000 BR @14 1970 07493000 * END; /* @Y30LB26*/ 07494000 * 1971 07495000 * /*****************************************************************/ 07496000 * /* */ 07497000 * /* SET UP ADDRESSING TO DUP RECORD JUST READ @Y30LB26*/ 07498000 * /* */ 07499000 * /*****************************************************************/ 07500000 * 1972 07501000 * DUPVPTR=RPLVBUF; /* ADDR RECORD @Y30LB26*/ 07502000 * 1972 07503000 @RF01967 L @04,RPLVPTR 1972 07504000 L @04,RPLVBUF(,@04) 1972 07505000 ST @04,DUPVPTR 1972 07506000 * /*****************************************************************/ 07507000 * /* */ 07508000 * /* IF IT IS THE CORRECT DUPLICATE RECORD, GET A BUFFER @Y30LB26*/ 07509000 * /* AND RETURN RECORD @Y30LB26*/ 07510000 * /* */ 07511000 * /*****************************************************************/ 07512000 * 1973 07513000 * IF DUPD=DKY&DUPSERNO=DVOLKY THEN/* @Y30LB26*/ 07514000 CLC DUPD(5,@04),DKY 1973 07515000 BNE @RF01973 1973 07516000 CLC DUPSERNO(6,@04),DVOLKY 1973 07517000 BNE @RF01973 1973 07518000 * DO; /* @Y30LB26*/ 07519000 * CALL GETBUF; /* GET SPACE @Y30LB26*/ 07520000 BAL @14,GETBUF 1975 07521000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @Y30LB26*/ 07522000 L @04,RPLVPTR 1976 07523000 CLC RPLVRETC(2,@04),@CB00747 1976 07524000 BNE @RT01976 1976 07525000 * RETURN; /* RETURN TO CALLER @Y30LB26*/ 07526000 * BUFFER=DUPV; /* MOVE IN REC @Y30LB26*/ 07527000 L @02,RVVAREA(,RVVIPTR) 1978 07528000 MVI BUFFER+65(@02),C' ' 1978 07529000 MVC BUFFER+66(190,@02),BUFFER+65(@02) 1978 07530000 L @01,DUPVPTR 1978 07531000 MVC BUFFER(65,@02),DUPV(@01) 1978 07532000 * RPLVRETC=RCZERO; /* GOOD RETURN CODE @Y30LB26*/ 07533000 MVC RPLVRETC(2,@04),@CB00747 1979 07534000 * RPLRCODE=RCZERO; /* GOOD REASON CODE @Y30LB26*/ 07535000 MVC RPLRCODE(2,@04),@CB00747 1980 07536000 * RETURN; /* @Y30LB26*/ 07537000 B @EL00030 1981 07538000 * END; /* @Y30LB26*/ 07539000 * ELSE /* @Y30LB26*/ 07540000 * 1983 07541000 * /***************************************************************/ 07542000 * /* */ 07543000 * /* IF NO LONGER A DUP RECORD OF THE CORRECT VOLUME @Y30LB26*/ 07544000 * /* SET BAD RETURN CODE AND INDICATE RECORD NOT FOUND @Y30LB26*/ 07545000 * /* */ 07546000 * /***************************************************************/ 07547000 * 1983 07548000 * DO; /* @Y30LB26*/ 07549000 @RF01973 DS 0H 1984 07550000 * RPLVRETC=FOUR; /* BAD RC @Y30LB26*/ 07551000 L @02,RPLVPTR 1984 07552000 MVC RPLVRETC(2,@02),@CB00749 1984 07553000 * RPLRCODE=NORECRC; /* RECORD NOT FOUND @Y30LB26*/ 07554000 MVC RPLRCODE(2,@02),@CB00789 1985 07555000 * CALL ERREXIT; /* @Y30LB26*/ 07556000 BAL @14,ERREXIT 1986 07557000 * RETURN; /* @Y30LB26*/ 07558000 B @EL00030 1987 07559000 * END; /* @Y30LB26*/ 07560000 * END DUPDIR; /* @Y30LB26*/ 07561000 B @EL00030 1989 07562000 * 1990 07563000 * /*****************************************************************/ 07564000 * /* */ 07565000 * /* ROUTINE READ NEXT FOR DUPLICATE VOL RECORD @Y30LB26*/ 07566000 * /* IF NO VOLID IS GIVEN, IT WILL READ THE FIRST @Y30LB26*/ 07567000 * /* DUPLICATE RECORD IN THE DATA SET @Y30LB26*/ 07568000 * /* */ 07569000 * /*****************************************************************/ 07570000 * 1990 07571000 *DUPNREC: 1990 07572000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 07573000 * 1990 07574000 DUPNREC ST @14,@SA00031 1990 07575000 * /*****************************************************************/ 07576000 * /* */ 07577000 * /* RESERVE INVENTORY SHARED @Y30LB26*/ 07578000 * /* */ 07579000 * /*****************************************************************/ 07580000 * 1991 07581000 * CALL RESSHARE; /* @Y30LB26*/ 07582000 BAL @14,RESSHARE 1991 07583000 * IF RVVSVOL=OFF THEN /* VOLID SPECIFIED @Y30LB26*/ 07584000 TM RVVSVOL(RVVIPTR),B'00000001' 1992 07585000 BNZ @RF01992 1992 07586000 * DO; /* @Y30LB26*/ 07587000 * DVOLKY=ZEROCHAR; /* ZERO VOLID @Y30LB26*/ 07588000 MVC DVOLKY(6),ZEROCHAR 1994 07589000 * DIDKY=DIDKY+FIXONE; /* SET ID FIELD @Y30LB26*/ 07590000 LA @04,1 1995 07591000 SLR @02,@02 1995 07592000 IC @02,DIDKY 1995 07593000 ALR @04,@02 1995 07594000 STC @04,DIDKY 1995 07595000 * END; /* @Y30LB26*/ 07596000 * ELSE /* @Y30LB26*/ 07597000 * DO; /* @Y30LB26*/ 07598000 B @RC01992 1997 07599000 @RF01992 DS 0H 1998 07600000 * IF RVVSDUP=OFF THEN /* DUP ID NOT SPEC @Y30LB26*/ 07601000 TM RVVSDUP(RVVIPTR),B'00000010' 1998 07602000 BNZ @RF01998 1998 07603000 * DO; /* @Y30LB26*/ 07604000 * RPLVRETC=FOUR; /* BAD RETURN CODE @Y30LB26*/ 07605000 L @02,RPLVPTR 2000 07606000 MVC RPLVRETC(2,@02),@CB00749 2000 07607000 * RPLRCODE=NODUPID; /* DUP ID NOT GIVEN @Y30LB26*/ 07608000 MVC RPLRCODE(2,@02),@CB00811 2001 07609000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 07610000 BAL @14,ERREXIT 2002 07611000 * RETURN; /* @Y30LB26*/ 07612000 @EL00031 DS 0H 2003 07613000 @EF00031 DS 0H 2003 07614000 @ER00031 L @14,@SA00031 2003 07615000 BR @14 2003 07616000 * END; /* @Y30LB26*/ 07617000 * DVOLKY=RVVOLUME; /* GET VOLID @Y30LB26*/ 07618000 @RF01998 MVC DVOLKY(6),RVVOLUME(RVVIPTR) 2005 07619000 * DIDKY=RVVDUPID; /* GET FIRST ID @Y30LB26*/ 07620000 SLR @04,@04 2006 07621000 IC @04,RVVDUPID(,RVVIPTR) 2006 07622000 STC @04,DIDKY 2006 07623000 * DIDKY=DIDKY+FIXONE; /* GET TO NEXT @Y30LB26*/ 07624000 AL @04,@CF00041 2007 07625000 STC @04,DIDKY 2007 07626000 * END; /* @Y30LB26*/ 07627000 * RPLVKEY=ADDR(DKEY); /* ADDR KEY @Y30LB26*/ 07628000 @RC01992 L @04,RPLVPTR 2009 07629000 LA @02,DKEY 2009 07630000 ST @02,RPLVKEY(,@04) 2009 07631000 * RPLVLOC=ON; /* LOCATE MODE @Y30LB26*/ 07632000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 07633000 OI RPLVLOC(@04),B'11000000' 2011 07634000 * RPLVTYP=RPLVREAD; /* READ RECORD @Y30LB26*/ 07635000 MVI RPLVTYP(@04),X'00' 2012 07636000 * RPLVKGE=ON; /* READ > OR = @Y30LB26*/ 07637000 OI RPLVKGE(@04),B'00000100' 2013 07638000 * RESPECIFY 2014 07639000 * REG1 RSTD; /* RESTRICT REG1 @Y30LB26*/ 07640000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 07641000 LR REG1,@04 2015 07642000 * CALL ICBVIO00; /* READ DUP RECORD @Y30LB26*/ 07643000 L @15,@CV00671 2016 07644000 BALR @14,@15 2016 07645000 * RESPECIFY 2017 07646000 * REG1 UNRSTD; /* FREE REG1 @Y30LB26*/ 07647000 * 2017 07648000 * /*****************************************************************/ 07649000 * /* */ 07650000 * /* CHECK RETURN CODE FROM I/O PROCESSOR @Y30LB26*/ 07651000 * /* */ 07652000 * /*****************************************************************/ 07653000 * 2018 07654000 * IF RPLVRETC^=RCZERO THEN /* @Y30LB26*/ 07655000 L @04,RPLVPTR 2018 07656000 CLC RPLVRETC(2,@04),@CB00747 2018 07657000 BE @RF02018 2018 07658000 * DO; /* @Y30LB26*/ 07659000 * CALL ERREXIT; /* @Y30LB26*/ 07660000 BAL @14,ERREXIT 2020 07661000 * RETURN; /* @Y30LB26*/ 07662000 B @EL00031 2021 07663000 * END; /* @Y30LB26*/ 07664000 * 2022 07665000 * /*****************************************************************/ 07666000 * /* */ 07667000 * /* SET UP ADDRESSING TO RECORD JUST READ @Y30LB26*/ 07668000 * /* */ 07669000 * /*****************************************************************/ 07670000 * 2023 07671000 * DUPVPTR=RPLVBUF; /* ADDR RECORD @Y30LB26*/ 07672000 * 2023 07673000 @RF02018 L @04,RPLVPTR 2023 07674000 L @04,RPLVBUF(,@04) 2023 07675000 ST @04,DUPVPTR 2023 07676000 * /*****************************************************************/ 07677000 * /* */ 07678000 * /* SEE IF ONLY RECORD OF SPECIFIED VOLID IS @Y30LB26*/ 07679000 * /* TO BE RETURNED @Y30LB26*/ 07680000 * /* */ 07681000 * /*****************************************************************/ 07682000 * 2024 07683000 * IF RVVDVOL=ON THEN /* READ ONLY SPEC VOL @Y30LB26*/ 07684000 TM RVVDVOL(RVVIPTR),B'00000010' 2024 07685000 BNO @RF02024 2024 07686000 * DO; /* @Y30LB26*/ 07687000 * 2025 07688000 * /*************************************************************/ 07689000 * /* */ 07690000 * /* CHECK TO SEE IF STILL DUP AND OF CORRECT VOLUME @Y30LB26*/ 07691000 * /* */ 07692000 * /*************************************************************/ 07693000 * 2026 07694000 * IF DUPD=DKY&DUPSERNO=DVOLKY THEN/* DUP RECORD @Y30LB26*/ 07695000 CLC DUPD(5,@04),DKY 2026 07696000 BNE @RF02026 2026 07697000 CLC DUPSERNO(6,@04),DVOLKY 2026 07698000 BNE @RF02026 2026 07699000 * DO; /* @Y30LB26*/ 07700000 * 2027 07701000 * /*********************************************************/ 07702000 * /* */ 07703000 * /* IF RECORD MEETS TEST, GET BUFFER @Y30LB26*/ 07704000 * /* AND RETURN RECORD @Y30LB26*/ 07705000 * /* */ 07706000 * /*********************************************************/ 07707000 * 2028 07708000 * CALL GETBUF; /* GET CORE @Y30LB26*/ 07709000 BAL @14,GETBUF 2028 07710000 * IF RPLVRETC^=RCZERO THEN/* CK RETURN @Y30LB26*/ 07711000 L @04,RPLVPTR 2029 07712000 CLC RPLVRETC(2,@04),@CB00747 2029 07713000 BNE @RT02029 2029 07714000 * RETURN; /* @Y30LB26*/ 07715000 * BUFFER=DUPV; /* MOVE IN RECORD @Y30LB26*/ 07716000 L @02,RVVAREA(,RVVIPTR) 2031 07717000 MVI BUFFER+65(@02),C' ' 2031 07718000 MVC BUFFER+66(190,@02),BUFFER+65(@02) 2031 07719000 L @01,DUPVPTR 2031 07720000 MVC BUFFER(65,@02),DUPV(@01) 2031 07721000 * RPLVRETC=RCZERO; /* GOOD RETURN CODE @Y30LB26*/ 07722000 MVC RPLVRETC(2,@04),@CB00747 2032 07723000 * RPLRCODE=RCZERO; /* GOOD REASON CODE @Y30LB26*/ 07724000 MVC RPLRCODE(2,@04),@CB00747 2033 07725000 * RETURN; /* @Y30LB26*/ 07726000 B @EL00031 2034 07727000 * END; /* @Y30LB26*/ 07728000 * ELSE /* @Y30LB26*/ 07729000 * 2036 07730000 * /***********************************************************/ 07731000 * /* */ 07732000 * /* IF NOT CORRECT RECORD, SET BAD RETURN CODE @Y30LB26*/ 07733000 * /* AND INDICATE RECORD NOT FOUND @Y30LB26*/ 07734000 * /* */ 07735000 * /***********************************************************/ 07736000 * 2036 07737000 * DO; /* @Y30LB26*/ 07738000 @RF02026 DS 0H 2037 07739000 * RPLVRETC=FOUR; /* BAD RC @Y30LB26*/ 07740000 L @02,RPLVPTR 2037 07741000 MVC RPLVRETC(2,@02),@CB00749 2037 07742000 * RPLRCODE=NORECRC; /* RECORD NOT FOUND @Y30LB26*/ 07743000 MVC RPLRCODE(2,@02),@CB00789 2038 07744000 * CALL ERREXIT; /* SAVE RETURN CODE @Y30LB26*/ 07745000 BAL @14,ERREXIT 2039 07746000 * RETURN; /* @Y30LB26*/ 07747000 B @EL00031 2040 07748000 * END; /* @Y30LB26*/ 07749000 * END; /* @Y30LB26*/ 07750000 * ELSE /* @Y30LB26*/ 07751000 * 2043 07752000 * /***************************************************************/ 07753000 * /* */ 07754000 * /* IF NOT READING FOR A SPECIFIC VOLUME @Y30LB26*/ 07755000 * /* JUST CHECK TO SEE IF IT IS A DUPLICATE @Y30LB26*/ 07756000 * /* RECORD AND IF IT IS, GET BUFFER SPACE @Y30LB26*/ 07757000 * /* AND RETURN RECORD @Y30LB26*/ 07758000 * /* */ 07759000 * /***************************************************************/ 07760000 * 2043 07761000 * DO; /* @Y30LB26*/ 07762000 @RF02024 DS 0H 2044 07763000 * IF DUPD=DKY THEN /* IS DUP REC @Y30LB26*/ 07764000 L @04,DUPVPTR 2044 07765000 CLC DUPD(5,@04),DKY 2044 07766000 BNE @RF02044 2044 07767000 * DO; /* @Y30LB26*/ 07768000 * CALL GETBUF; /* GET CORE @Y30LB26*/ 07769000 BAL @14,GETBUF 2046 07770000 * IF RPLVRETC^=RCZERO THEN/* CK RETURN @Y30LB26*/ 07771000 L @04,RPLVPTR 2047 07772000 CLC RPLVRETC(2,@04),@CB00747 2047 07773000 BNE @RT02047 2047 07774000 * RETURN; /* @Y30LB26*/ 07775000 * BUFFER=DUPV; /* MOVE IN RECORD @Y30LB26*/ 07776000 L @02,RVVAREA(,RVVIPTR) 2049 07777000 MVI BUFFER+65(@02),C' ' 2049 07778000 MVC BUFFER+66(190,@02),BUFFER+65(@02) 2049 07779000 L @01,DUPVPTR 2049 07780000 MVC BUFFER(65,@02),DUPV(@01) 2049 07781000 * RPLVRETC=RCZERO; /* GOOD RETURN CODE @Y30LB26*/ 07782000 MVC RPLVRETC(2,@04),@CB00747 2050 07783000 * RPLRCODE=RCZERO; /* GOOD REASON CODE @Y30LB26*/ 07784000 MVC RPLRCODE(2,@04),@CB00747 2051 07785000 * RETURN; /* @Y30LB26*/ 07786000 B @EL00031 2052 07787000 * END; /* @Y30LB26*/ 07788000 * ELSE /* @Y30LB26*/ 07789000 * 2054 07790000 * /***********************************************************/ 07791000 * /* */ 07792000 * /* IF IT IS NOT EVEN A DUPLICATE RECORD @Y30LB26*/ 07793000 * /* SET BAD RETURN CODE AND INDICATE RECORD @Y30LB26*/ 07794000 * /* NOT FOUND @Y30LB26*/ 07795000 * /* */ 07796000 * /***********************************************************/ 07797000 * 2054 07798000 * DO; /* @Y30LB26*/ 07799000 @RF02044 DS 0H 2055 07800000 * RPLVRETC=FOUR; /* BAD RC @Y30LB26*/ 07801000 L @02,RPLVPTR 2055 07802000 MVC RPLVRETC(2,@02),@CB00749 2055 07803000 * RPLRCODE=NORECRC; /* RECORD NOT FOUND @Y30LB26*/ 07804000 MVC RPLRCODE(2,@02),@CB00789 2056 07805000 * CALL ERREXIT; /* SAVE RETURN CODE @Y30LB26*/ 07806000 BAL @14,ERREXIT 2057 07807000 * RETURN; /* @Y30LB26*/ 07808000 B @EL00031 2058 07809000 * END; /* @Y30LB26*/ 07810000 * END; /* @Y30LB26*/ 07811000 * END DUPNREC; /* @Y30LB26*/ 07812000 B @EL00031 2061 07813000 * 2062 07814000 * /*****************************************************************/ 07815000 * /* */ 07816000 * /* ROUTINE READS A CARTRIDGE INDEX RECORD AND @Y30LB26*/ 07817000 * /* THEN READS THE VOLUME RECORD ASSOCIATED WITH @Y30LB26*/ 07818000 * /* IT THEN MAKES A CHECK TO SEE IF THE VOLUME RECORD @Y30LB26*/ 07819000 * /* ALSO INDICATES IT BELONGS TO THAT CARTRIDGE IF THAT @Y30LB26*/ 07820000 * /* CHECK IS ASKED FOR @Y30LB26*/ 07821000 * /* */ 07822000 * /*****************************************************************/ 07823000 * 2062 07824000 *CARTDIR: 2062 07825000 * PROC OPTIONS(SAVE(REG14)); /* @Z40LB66*/ 07826000 * 2062 07827000 CARTDIR ST @14,@SA00032 2062 07828000 * /*****************************************************************/ 07829000 * /* */ 07830000 * /* RESERVE INVENTORY DATA SET SHARED @Y30LB26*/ 07831000 * /* */ 07832000 * /*****************************************************************/ 07833000 * 2063 07834000 * CALL RESSHARE; /* @Y30LB26*/ 07835000 * 2063 07836000 BAL @14,RESSHARE 2063 07837000 * /*****************************************************************/ 07838000 * /* */ 07839000 * /* SET UP KEY AND READ DIRECT FOR INDEX RECORD @Y30LB26*/ 07840000 * /* */ 07841000 * /*****************************************************************/ 07842000 * 2064 07843000 * CARTKY=RVVRDCSN; /* GET CART INDEX @Y30LB26*/ 07844000 MVC CARTKY(12),RVVRDCSN(RVVIPTR) 2064 07845000 * RPLVKEY=ADDR(IKEY); /* ADDR KEY @Y30LB26*/ 07846000 L @04,RPLVPTR 2065 07847000 LA @02,IKEY 2065 07848000 ST @02,RPLVKEY(,@04) 2065 07849000 * RPLVLOC=ON; /* LOCATE MODE @Y30LB26*/ 07850000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 07851000 OI RPLVLOC(@04),B'11000000' 2067 07852000 * RPLVTYP=RPLVREAD; /* READ RECORD @Y30LB26*/ 07853000 MVI RPLVTYP(@04),X'00' 2068 07854000 * RESPECIFY 2069 07855000 * REG1 RSTD; /* RESTRICT REG1 @Y30LB26*/ 07856000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 07857000 LR REG1,@04 2070 07858000 * CALL ICBVIO00; /* READ CART INDEX REC @Y30LB26*/ 07859000 L @15,@CV00671 2071 07860000 BALR @14,@15 2071 07861000 * RESPECIFY 2072 07862000 * REG1 UNRSTD; /* FREE REG1 @Y30LB26*/ 07863000 * IF RPLVRETC^=RCZERO THEN /* CK REASON CODE @Y30LB26*/ 07864000 L @04,RPLVPTR 2073 07865000 CLC RPLVRETC(2,@04),@CB00747 2073 07866000 BE @RF02073 2073 07867000 * DO; /* @Y30LB26*/ 07868000 * CALL ERREXIT; /* SAVE REASON CODES @Y30LB26*/ 07869000 BAL @14,ERREXIT 2075 07870000 * RETURN; /* @Y30LB26*/ 07871000 @EL00032 DS 0H 2076 07872000 @EF00032 DS 0H 2076 07873000 @ER00032 L @14,@SA00032 2076 07874000 BR @14 2076 07875000 * END; /* @Y30LB26*/ 07876000 * 2077 07877000 * /*****************************************************************/ 07878000 * /* */ 07879000 * /* SAVE CONTENTS OF RECORD JUST READ AND SEE IF @Z40LB66*/ 07880000 * /* A VOLID WAS SPECIFIED @Y30LB26*/ 07881000 * /* */ 07882000 * /*****************************************************************/ 07883000 * 2078 07884000 * INDEXPTR=RPLVBUF; /* ADDR RECORD @Z40LB66*/ 07885000 @RF02073 L @04,RPLVPTR 2078 07886000 L INDEXPTR,RPLVBUF(,@04) 2078 07887000 * STORINDX=INDEX; /* SAVE RECORD @Z40LB66*/ 07888000 MVI STORINDX+36,C' ' 2079 07889000 MVC STORINDX+37(187),STORINDX+36 2079 07890000 MVC STORINDX(36),INDEX(INDEXPTR) 2079 07891000 * INDEXPTR=ADDR(STORINDX); /* RESET BASE @Z40LB66*/ 07892000 LA INDEXPTR,STORINDX 2080 07893000 * IF RVVSVOL=ON THEN /* VOLUME SPECIFIED @Y30LB26*/ 07894000 * 2081 07895000 TM RVVSVOL(RVVIPTR),B'00000001' 2081 07896000 BNO @RF02081 2081 07897000 * /***************************************************************/ 07898000 * /* */ 07899000 * /* COMPARE VOLID FROM INDEX RECORD WITH THE @Z40LB66*/ 07900000 * /* VOLID GIVEN IN REQUEST BLOCK @Z40LB66*/ 07901000 * /* */ 07902000 * /***************************************************************/ 07903000 * 2082 07904000 * DO; /* @Y30LB26*/ 07905000 * IF INDVSRNO=RVVOLUME THEN /* VOLUME MATCH @Z40LB66*/ 07906000 * 2083 07907000 CLC INDVSRNO(6,INDEXPTR),RVVOLUME(RVVIPTR) 2083 07908000 BNE @RF02083 2083 07909000 * /***********************************************************/ 07910000 * /* */ 07911000 * /* IF EVERYTHING MATCHES, GO READ AND RETURN REC @Y30LB26*/ 07912000 * /* */ 07913000 * /***********************************************************/ 07914000 * 2084 07915000 * DO; /* @Y30LB26*/ 07916000 * CALL READVOL; /* READ VOLUME RECORD @Y30LB26*/ 07917000 BAL @14,READVOL 2085 07918000 * RETURN; /* @Y30LB26*/ 07919000 B @EL00032 2086 07920000 * END; /* @Y30LB26*/ 07921000 * ELSE /* @Y30LB26*/ 07922000 * 2088 07923000 * /***********************************************************/ 07924000 * /* */ 07925000 * /* IF CHECK CALLED FOR BUT NO MATCH THEN SET BAD @Y30LB26*/ 07926000 * /* RET CODE AND INDICATE RECORD NOT FOUND @Y30LB26*/ 07927000 * /* */ 07928000 * /***********************************************************/ 07929000 * 2088 07930000 * DO; /* @Y30LB26*/ 07931000 @RF02083 DS 0H 2089 07932000 * RPLVRETC=FOUR; /* @Y30LB26*/ 07933000 L @02,RPLVPTR 2089 07934000 MVC RPLVRETC(2,@02),@CB00749 2089 07935000 * RPLRCODE=NOMATCH; /* @Y30LB26*/ 07936000 MVC RPLRCODE(2,@02),@CB00807 2090 07937000 * CALL ERREXIT; /* @Y30LB26*/ 07938000 BAL @14,ERREXIT 2091 07939000 * RETURN; /* @Y30LB26*/ 07940000 B @EL00032 2092 07941000 * END; /* @Y30LB26*/ 07942000 * END; /* @Y30LB26*/ 07943000 * ELSE /* @Y30LB26*/ 07944000 * 2095 07945000 * /***************************************************************/ 07946000 * /* */ 07947000 * /* IF NO TEST CALLED FOR JUST GO READ @Y30LB26*/ 07948000 * /* RECORD AND RETURN IT @Y30LB26*/ 07949000 * /* */ 07950000 * /***************************************************************/ 07951000 * 2095 07952000 * DO; /* @Y30LB26*/ 07953000 @RF02081 DS 0H 2096 07954000 * CALL READVOL; /* READ VOLUME @Y30LB26*/ 07955000 BAL @14,READVOL 2096 07956000 * RETURN; /* @Y30LB26*/ 07957000 B @EL00032 2097 07958000 * END; /* @Y30LB26*/ 07959000 * END CARTDIR; /* @Z40LB66*/ 07960000 * 2100 07961000 * /*****************************************************************/ 07962000 * /* */ 07963000 * /* THIS ROUTINE READS THE NEXT CARTRIDGE @Z40LB66*/ 07964000 * /* INDEX RECORD AND ITS ASSOCIATED VOLUME RECORD @Z40LB66*/ 07965000 * /* */ 07966000 * /*****************************************************************/ 07967000 * 2100 07968000 *CARTNREC: 2100 07969000 * PROC OPTIONS(SAVE(REG14)); /* @Z40LB66*/ 07970000 * 2100 07971000 CARTNREC ST @14,@SA00033 2100 07972000 * /*****************************************************************/ 07973000 * /* */ 07974000 * /* GO RESERVE INVENTORY DATA SET SHARED @Z40LB66*/ 07975000 * /* */ 07976000 * /*****************************************************************/ 07977000 * 2101 07978000 * CALL RESSHARE; /* @Z40LB66*/ 07979000 * 2101 07980000 BAL @14,RESSHARE 2101 07981000 * /*****************************************************************/ 07982000 * /* */ 07983000 * /* DETERMINE IF READING FOR FIRST CARTRIDGE INDEX @Z40LB66*/ 07984000 * /* RECORD. IF SO, SET CSN TO ZERO AND PROCESS LIKE @Z40LB66*/ 07985000 * /* A REGULAR READ NEXT @Z40LB66*/ 07986000 * /* */ 07987000 * /*****************************************************************/ 07988000 * 2102 07989000 * IF RVVSCSN=OFF THEN /* CSN SPECIFIED ? @Z40LB66*/ 07990000 TM RVVSCSN(RVVIPTR),B'00001000' 2102 07991000 BNZ @RF02102 2102 07992000 * CARTKY=ZEROCHAR; /* @Z40LB66*/ 07993000 MVC CARTKY(12),ZEROCHAR 2103 07994000 * ELSE /* @Z40LB66*/ 07995000 * DO; /* @Z40LB66*/ 07996000 * 2104 07997000 B @RC02102 2104 07998000 @RF02102 DS 0H 2105 07999000 * /*************************************************************/ 08000000 * /* */ 08001000 * /* INCREMENT THE KEY BY ONE TO OBTAIN THE @Z40LB66*/ 08002000 * /* NEXT HIGHER KEY @Z40LB66*/ 08003000 * /* */ 08004000 * /*************************************************************/ 08005000 * 2105 08006000 * CARTKY=RVVRDCSN; /* CSN TO READ BEYOND @Z40LB66*/ 08007000 MVC CARTKY(12),RVVRDCSN(RVVIPTR) 2105 08008000 * ARITHCTG=CARTKY(12); /* GET LAST DIGIT @Z40LB66*/ 08009000 MVC ARITHCTG(1),CARTKY+11 2106 08010000 * CARTID=CARTID+1; /* INCREMENT IT @Z40LB66*/ 08011000 LA @04,1 2107 08012000 SLR @02,@02 2107 08013000 IC @02,CARTID 2107 08014000 ALR @04,@02 2107 08015000 STC @04,CARTID 2107 08016000 * CARTKY(12)=ARITHCTG; /* RESTORE TO KEY @Z40LB66*/ 08017000 MVC CARTKY+11(1),ARITHCTG 2108 08018000 * END; /* @Z40LB66*/ 08019000 * 2109 08020000 * /*****************************************************************/ 08021000 * /* */ 08022000 * /* SET UP TO READ CARTRIDGE RECORD @Z40LB66*/ 08023000 * /* */ 08024000 * /*****************************************************************/ 08025000 * 2110 08026000 * RPLVKEY=ADDR(IKEY); /* ADDR OF KEY @Z40LB66*/ 08027000 @RC02102 L @04,RPLVPTR 2110 08028000 LA @02,IKEY 2110 08029000 ST @02,RPLVKEY(,@04) 2110 08030000 * RPLVLOC=ON; /* LOCATE MODE @Z40LB66*/ 08031000 * RPLVDIR=ON; /* READ DIRECT @Z40LB66*/ 08032000 OI RPLVLOC(@04),B'11000000' 2112 08033000 * RPLVTYP=RPLVREAD; /* READ RECORD @Z40LB66*/ 08034000 MVI RPLVTYP(@04),X'00' 2113 08035000 * RPLVKGE=ON; /* READ >= @Z40LB66*/ 08036000 OI RPLVKGE(@04),B'00000100' 2114 08037000 * RESPECIFY 2115 08038000 * REG1 RSTD; /* @Z40LB66*/ 08039000 * REG1=RPLVPTR; /* ADDR RPLV @Z40LB66*/ 08040000 LR REG1,@04 2116 08041000 * CALL ICBVIO00; /* READ NEXT CARTRIDGE @Z40LB66*/ 08042000 L @15,@CV00671 2117 08043000 BALR @14,@15 2117 08044000 * RESPECIFY 2118 08045000 * REG1 UNRSTD; /* @Z40LB66*/ 08046000 * IF RPLVRETC^=RCZERO THEN /* CHECK RETURN CODE @Z40LB66*/ 08047000 L @04,RPLVPTR 2119 08048000 CLC RPLVRETC(2,@04),@CB00747 2119 08049000 BE @RF02119 2119 08050000 * DO; /* @Z40LB66*/ 08051000 * CALL ERREXIT; /* SAVE RETURN CODES @Z40LB66*/ 08052000 BAL @14,ERREXIT 2121 08053000 * RETURN; /* @Z40LB66*/ 08054000 @EL00033 DS 0H 2122 08055000 @EF00033 DS 0H 2122 08056000 @ER00033 L @14,@SA00033 2122 08057000 BR @14 2122 08058000 * END; /* @Z40LB66*/ 08059000 * 2123 08060000 * /*****************************************************************/ 08061000 * /* */ 08062000 * /* IF THIS IS NOT A CARTRIDGE RECORD, RETURN RECORD @Z40LB66*/ 08063000 * /* NOT FOUND INDICATION @Z40LB66*/ 08064000 * /* */ 08065000 * /*****************************************************************/ 08066000 * 2124 08067000 * INDEXPTR=RPLVBUF; /* ADDR RECORD @Z40LB66*/ 08068000 @RF02119 L @04,RPLVPTR 2124 08069000 L INDEXPTR,RPLVBUF(,@04) 2124 08070000 * IF INDI^=IKY THEN /* TEST FOR CART REC @Z40LB66*/ 08071000 CLC INDI(1,INDEXPTR),IKY 2125 08072000 BE @RF02125 2125 08073000 * DO; /* @Z40LB66*/ 08074000 * RPLVRETC=FOUR; /* SET RETURN CODE @Z40LB66*/ 08075000 MVC RPLVRETC(2,@04),@CB00749 2127 08076000 * RPLRCODE=NORECRC; /* RECORD NOT FOUND @Z40LB66*/ 08077000 MVC RPLRCODE(2,@04),@CB00789 2128 08078000 * CALL ERREXIT; /* SAVE RETURN CODES @Z40LB66*/ 08079000 BAL @14,ERREXIT 2129 08080000 * RETURN; /* @Z40LB66*/ 08081000 B @EL00033 2130 08082000 * END; /* @Z40LB66*/ 08083000 * 2131 08084000 * /*****************************************************************/ 08085000 * /* */ 08086000 * /* SAVE THE CONTENTS OF THE INDEX RECORD AND GO READ @Z40LB66*/ 08087000 * /* THE ASSOCIATED VOLUME RECORD AND RETURN IT @Z40LB66*/ 08088000 * /* */ 08089000 * /*****************************************************************/ 08090000 * 2132 08091000 * STORINDX=INDEX; /* SAVE RECORD @Z40LB66*/ 08092000 @RF02125 MVI STORINDX+36,C' ' 2132 08093000 MVC STORINDX+37(187),STORINDX+36 2132 08094000 MVC STORINDX(36),INDEX(INDEXPTR) 2132 08095000 * INDEXPTR=ADDR(STORINDX); /* RESET BASE @Z40LB66*/ 08096000 LA INDEXPTR,STORINDX 2133 08097000 * RPLVKGE=OFF; /* RESET FLAG @Z40LB66*/ 08098000 L @06,RPLVPTR 2134 08099000 NI RPLVKGE(@06),B'11111011' 2134 08100000 * CALL READVOL; /* READ VOLUME RECORD @Z40LB66*/ 08101000 BAL @14,READVOL 2135 08102000 * RETURN; /* @Z40LB66*/ 08103000 B @EL00033 2136 08104000 * END CARTNREC; /* @Z40LB66*/ 08105000 * 2138 08106000 * /*****************************************************************/ 08107000 * /* */ 08108000 * /* THIS ROUTINE READS A VOLUME RECORD AND GETS @Y30LB26*/ 08109000 * /* BUFFER SPACE FOR IT. THEN RETURNS THE RECORD @Y30LB26*/ 08110000 * /* */ 08111000 * /*****************************************************************/ 08112000 * 2138 08113000 *READVOL: 2138 08114000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 08115000 * 2138 08116000 READVOL ST @14,@SA00034 2138 08117000 * /*****************************************************************/ 08118000 * /* */ 08119000 * /* SET UP TO READ WHATEVER RECORD KEY WAS IN THE @Y30LB26*/ 08120000 * /* CARTRIDGE INDEX RECORD @Y30LB26*/ 08121000 * /* */ 08122000 * /*****************************************************************/ 08123000 * 2139 08124000 * RPLVKEY=ADDR(INDRECKY); /* ADDR OF VOLUME KEY @Z40LB66*/ 08125000 L @06,RPLVPTR 2139 08126000 LA @04,INDRECKY(,INDEXPTR) 2139 08127000 ST @04,RPLVKEY(,@06) 2139 08128000 * RPLVLOC=ON; /* LOCATE MODE @Y30LB26*/ 08129000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 08130000 OI RPLVLOC(@06),B'11000000' 2141 08131000 * RPLVTYP=RPLVREAD; /* READ RECORD @Y30LB26*/ 08132000 MVI RPLVTYP(@06),X'00' 2142 08133000 * RESPECIFY 2143 08134000 * REG1 RSTD; /* RESTRICT REG1 @Y30LB26*/ 08135000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 08136000 LR REG1,@06 2144 08137000 * CALL ICBVIO00; /* READ VOL RECORD @Y30LB26*/ 08138000 L @15,@CV00671 2145 08139000 BALR @14,@15 2145 08140000 * RESPECIFY 2146 08141000 * REG1 UNRSTD; /* FREE REG1 @Y30LB26*/ 08142000 * 2146 08143000 * /*****************************************************************/ 08144000 * /* */ 08145000 * /* CHECK TO SEE IF BAD RETURN CODE FROM I/O PROCESSOR @Y30LB26*/ 08146000 * /* */ 08147000 * /*****************************************************************/ 08148000 * 2147 08149000 * IF RPLVRETC^=RCZERO THEN /* CHECK RETURN CODE @Y30LB26*/ 08150000 L @06,RPLVPTR 2147 08151000 CLC RPLVRETC(2,@06),@CB00747 2147 08152000 BE @RF02147 2147 08153000 * DO; /* @Y30LB26*/ 08154000 * RPLVRETC=ZERO; /* RESET RETURN CODE @Z40LB66*/ 08155000 SLR @04,@04 2149 08156000 STH @04,RPLVRETC(,@06) 2149 08157000 * CALL GETBUF; /* GET BUFFER TO RETURN @Z40LB66 08158000 * CARTRIDGE RECORD @Z40LB66*/ 08159000 BAL @14,GETBUF 2150 08160000 * IF RPLVRETC^=RCZERO THEN /* IF NOT SUCCESSFUL, @Z40LB66*/ 08161000 L @06,RPLVPTR 2151 08162000 CLC RPLVRETC(2,@06),@CB00747 2151 08163000 BNE @RT02151 2151 08164000 * RETURN; /* QUIT @Z40LB66*/ 08165000 * BUFFER=INDEX; /* MOVE CART. RECORD @Z40LB66*/ 08166000 L @04,RVVAREA(,RVVIPTR) 2153 08167000 MVI BUFFER+36(@04),C' ' 2153 08168000 MVC BUFFER+37(219,@04),BUFFER+36(@04) 2153 08169000 MVC BUFFER(36,@04),INDEX(INDEXPTR) 2153 08170000 * RPLVRETC=FOUR; /* SET BAD RETURN CODE @Z40LB66*/ 08171000 MVC RPLVRETC(2,@06),@CB00749 2154 08172000 * RPLRCODE=NOCTGVOL; /* NO VOL FOR CART. @Z40LB66*/ 08173000 MVC RPLRCODE(2,@06),@CB00841 2155 08174000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 08175000 BAL @14,ERREXIT 2156 08176000 * RETURN; /* @Y30LB26*/ 08177000 @EL00034 DS 0H 2157 08178000 @EF00034 DS 0H 2157 08179000 @ER00034 L @14,@SA00034 2157 08180000 BR @14 2157 08181000 * END; /* @Y30LB26*/ 08182000 * 2158 08183000 * /*****************************************************************/ 08184000 * /* */ 08185000 * /* SET UP ADDRESS TO RECORD JUST READ AND GET BUFFER @Y30LB26*/ 08186000 * /* SPACE TO RETURN RECORD @Y30LB26*/ 08187000 * /* */ 08188000 * /*****************************************************************/ 08189000 * 2159 08190000 * BASEVPTR=RPLVBUF; /* ADDR RECORD @Y30LB26*/ 08191000 @RF02147 L @04,RPLVPTR 2159 08192000 L @04,RPLVBUF(,@04) 2159 08193000 ST @04,BASEVPTR 2159 08194000 * CALL GETBUF; /* GET CORE @Y30LB26*/ 08195000 BAL @14,GETBUF 2160 08196000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @Y30LB26*/ 08197000 L @04,RPLVPTR 2161 08198000 CLC RPLVRETC(2,@04),@CB00747 2161 08199000 BNE @RT02161 2161 08200000 * RETURN; /* @Y30LB26*/ 08201000 * BUFFER=BASEV; /* MOVE REC TO BUFFER @Y30LB26*/ 08202000 L @02,RVVAREA(,RVVIPTR) 2163 08203000 MVI BUFFER+224(@02),C' ' 2163 08204000 MVC BUFFER+225(31,@02),BUFFER+224(@02) 2163 08205000 L @01,BASEVPTR 2163 08206000 MVC BUFFER(224,@02),BASEV(@01) 2163 08207000 * RPLVRETC=RCZERO; /* GOOD RETURN CODE @Y30LB26*/ 08208000 MVC RPLVRETC(2,@04),@CB00747 2164 08209000 * RPLRCODE=RCZERO; /* GOOD REASON CODE @Y30LB26*/ 08210000 MVC RPLRCODE(2,@04),@CB00747 2165 08211000 * RETURN; /* @Y30LB26*/ 08212000 B @EL00034 2166 08213000 * END READVOL; /* @Y30LB26*/ 08214000 B @EL00034 2167 08215000 * 2168 08216000 * /*****************************************************************/ 08217000 * /* */ 08218000 * /* ROUTINE RESERVES THE MSVC DATA SET SHARED FOR READING @Y30LB26*/ 08219000 * /* */ 08220000 * /*****************************************************************/ 08221000 * 2168 08222000 *RESSHARE: 2168 08223000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 08224000 RESSHARE ST @14,@SA00035 2168 08225000 * RESPECIFY 2169 08226000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 08227000 * RESPECIFY 2170 08228000 * REG0 RSTD; /* RESTRICT @Y30LB26*/ 08229000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 08230000 L REG1,RPLVPTR 2171 08231000 * REG0=RESSHINV; /* INDICATE RES SHARE @Y30LB26*/ 08232000 LA REG0,2 2172 08233000 * CALL ICBVRR00; /* RESERVE IT @Y30LB26*/ 08234000 L @15,@CV00673 2173 08235000 BALR @14,@15 2173 08236000 * RESPECIFY 2174 08237000 * REG0 UNRSTD; /* FREE REG 0 @Y30LB26*/ 08238000 * RESPECIFY 2175 08239000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 08240000 * RETURN; /* @Y30LB26*/ 08241000 @EL00035 DS 0H 2176 08242000 @EF00035 DS 0H 2176 08243000 @ER00035 L @14,@SA00035 2176 08244000 BR @14 2176 08245000 * END RESSHARE; /* END PROCEDURE @Y30LB26*/ 08246000 * 2178 08247000 * /*****************************************************************/ 08248000 * /* */ 08249000 * /* ROUTINE GET BUFFER SPACE FROM SUB-POOL 241 @Y30LB26*/ 08250000 * /* SO THAT THE MSVC RECORD CAN BE RETURNED @Y30LB26*/ 08251000 * /* */ 08252000 * /*****************************************************************/ 08253000 * 2178 08254000 *GETBUF: 2178 08255000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 08256000 GETBUF ST @14,@SA00036 2178 08257000 * RVVARLN=256; /* LENGTH OF BUFFER @Y30LB26*/ 08258000 * 2179 08259000 MVC RVVARLN(2,RVVIPTR),@CH00688 2179 08260000 * /*****************************************************************/ 08261000 * /* */ 08262000 * /* SEE IF USER PROVIDED BUFFER IS LONG ENOUGH @Y30LB26*/ 08263000 * /* */ 08264000 * /*****************************************************************/ 08265000 * 2180 08266000 * IF RVVBUFLN OR = @Y30LB26*/ 10247000 NI RPLVKGE(@02),B'11111011' 2693 10248000 * RPLVUPD=ON; /* FOR UPDATE @Y30LB26*/ 10249000 OI RPLVUPD(@02),B'00000010' 2694 10250000 * RESPECIFY 2695 10251000 * REG1 RSTD; /* RESTRICT @Y30LB26*/ 10252000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 10253000 LR REG1,@02 2696 10254000 * CALL ICBVIO00; /* READ GROUP UPDATE @Y30LB26*/ 10255000 * 2697 10256000 L @15,@CV00671 2697 10257000 BALR @14,@15 2697 10258000 * /*****************************************************************/ 10259000 * /* */ 10260000 * /* CHECK RETURN FROM DUMMY READ @Y30LB26*/ 10261000 * /* */ 10262000 * /*****************************************************************/ 10263000 * 2698 10264000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN CODE @Y30LB26*/ 10265000 L @02,RPLVPTR 2698 10266000 CLC RPLVRETC(2,@02),@CB00747 2698 10267000 BE @RF02698 2698 10268000 * DO; /* @Y30LB26*/ 10269000 * CALL ERREXIT; /* SAVE RETURN CODES @Y30LB26*/ 10270000 BAL @14,ERREXIT 2700 10271000 * RETURN; /* @Y30LB26*/ 10272000 B @EL00041 2701 10273000 * END; /* @Y30LB26*/ 10274000 * 2702 10275000 * /*****************************************************************/ 10276000 * /* */ 10277000 * /* WRITE GROUP RECORD THAT IS ALL FIXED UP NOW @Y30LB26*/ 10278000 * /* */ 10279000 * /*****************************************************************/ 10280000 * 2703 10281000 * RPLVBUF=ADDR(STORGRP); /* ADDR READ GROUP REC @Y30LB26*/ 10282000 @RF02698 L @02,RPLVPTR 2703 10283000 LA @00,STORGRP 2703 10284000 ST @00,RPLVBUF(,@02) 2703 10285000 * RPLVTYP=RPLVPUT; /* WRITE IT @Y30LB26*/ 10286000 MVI RPLVTYP(@02),X'01' 2704 10287000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 10288000 LR REG1,@02 2705 10289000 * CALL ICBVIO00; /* WRITE GROUP REC @Y30LB26*/ 10290000 L @15,@CV00671 2706 10291000 BALR @14,@15 2706 10292000 * RESPECIFY 2707 10293000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 10294000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @Y30LB26*/ 10295000 L @02,RPLVPTR 2708 10296000 CLC RPLVRETC(2,@02),@CB00747 2708 10297000 BE @RF02708 2708 10298000 * DO; /* @Y30LB26*/ 10299000 * CALL ERREXIT; /* SAVE RETURN CODES @Y30LB26*/ 10300000 BAL @14,ERREXIT 2710 10301000 * RETURN; /* @Y30LB26*/ 10302000 B @EL00041 2711 10303000 * END; /* @Y30LB26*/ 10304000 * 2712 10305000 * /*****************************************************************/ 10306000 * /* */ 10307000 * /* CHECK TO SEE IF RPLV HAS ALREADY BEEN JOURNALED. @Y30LB26*/ 10308000 * /* IF IT HAS NOT, THEN GO JOURNAL IT @Y30LB26*/ 10309000 * /* */ 10310000 * /*****************************************************************/ 10311000 * 2713 10312000 * IF JRNLEDSW=OFF THEN /* JOURNALED BEFORE @Y30LB26*/ 10313000 @RF02708 TM JRNLEDSW,B'00000001' 2713 10314000 BNZ @RF02713 2713 10315000 * CALL JOURNAL; /* JOURNAL IT @Y30LB26*/ 10316000 BAL @14,JOURNAL 2714 10317000 * RETURN; /* @Y30LB26*/ 10318000 B @EL00041 2715 10319000 * END GROUPIN; /* @Y30LB26*/ 10320000 B @EL00041 2716 10321000 * 2717 10322000 * /*****************************************************************/ 10323000 * /* */ 10324000 * /* THIS ROUTINE TAKES A BASE VOLUME RECORD OUT OF @Y30LB26*/ 10325000 * /* THE NON-GROUPED CHAIN @Y30LB26*/ 10326000 * /* */ 10327000 * /*****************************************************************/ 10328000 * 2717 10329000 *NGRPOUT: 2717 10330000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 10331000 NGRPOUT ST @14,@SA00042 2717 10332000 * CHICHOGP=OFF; /* INDICATE NON-GRPED @Y30LB26*/ 10333000 * 2718 10334000 NI CHICHOGP,B'11101111' 2718 10335000 * /*****************************************************************/ 10336000 * /* */ 10337000 * /* GO CHAIN VOLUME OUT OF NON-GROUPED CHAIN @Y30LB26*/ 10338000 * /* AND CHECK RETURN CODE @Y30LB26*/ 10339000 * /* */ 10340000 * /*****************************************************************/ 10341000 * 2719 10342000 * CALL ICBVUCHO(0,BASEVPTR,RPLVPTR,PASSFLAG);/* CHN OUT @Y30LB26*/ 10343000 L @15,@CV00675 2719 10344000 LA @01,@AL02719 2719 10345000 BALR @14,@15 2719 10346000 * IF RPLVRETC^=RCZERO THEN /* RETURN CODE @Y30LB26*/ 10347000 L @02,RPLVPTR 2720 10348000 CLC RPLVRETC(2,@02),@CB00747 2720 10349000 BE @RF02720 2720 10350000 * DO; /* @Y30LB26*/ 10351000 * CALL ERREXIT; /* SAVE RETURN CODE @Y30LB26*/ 10352000 BAL @14,ERREXIT 2722 10353000 * RETURN; /* @Y30LB26*/ 10354000 @EL00042 DS 0H 2723 10355000 @EF00042 DS 0H 2723 10356000 @ER00042 L @14,@SA00042 2723 10357000 BR @14 2723 10358000 * END; /* @Y30LB26*/ 10359000 * RETURN; /* @Y30LB26*/ 10360000 B @EL00042 2725 10361000 * END NGRPOUT; /* @Y30LB26*/ 10362000 B @EL00042 2726 10363000 * 2727 10364000 * /*****************************************************************/ 10365000 * /* */ 10366000 * /* THIS ROUTINE PUTS A BASE VOLUME RECORD INTO @Y30LB26*/ 10367000 * /* THE NON-GROUPED CHAIN @Y30LB26*/ 10368000 * /* */ 10369000 * /*****************************************************************/ 10370000 * 2727 10371000 *NGROUPIN: 2727 10372000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 10373000 NGROUPIN ST @14,@SA00043 2727 10374000 * CHICHOGP=OFF; /* INDICATE NON-GRPED @Y30LB26*/ 10375000 * 2728 10376000 NI CHICHOGP,B'11101111' 2728 10377000 * /*****************************************************************/ 10378000 * /* */ 10379000 * /* GO CHAIN VOLUME INTO NON-GROUPED @Y30LB26*/ 10380000 * /* AND CHECK RETURN CODE @Y30LB26*/ 10381000 * /* */ 10382000 * /*****************************************************************/ 10383000 * 2729 10384000 * CALL ICBVUCHI(0,BASEVPTR,RPLVPTR,PASSFLAG);/* @Y30LB26*/ 10385000 L @15,@CV00674 2729 10386000 LA @01,@AL02729 2729 10387000 BALR @14,@15 2729 10388000 * IF RPLVRETC^=RCZERO THEN /* @Y30LB26*/ 10389000 L @02,RPLVPTR 2730 10390000 CLC RPLVRETC(2,@02),@CB00747 2730 10391000 BE @RF02730 2730 10392000 * DO; /* @Y30LB26*/ 10393000 * CALL ERREXIT; /* @Y30LB26*/ 10394000 BAL @14,ERREXIT 2732 10395000 * RETURN; /* @Y30LB26*/ 10396000 @EL00043 DS 0H 2733 10397000 @EF00043 DS 0H 2733 10398000 @ER00043 L @14,@SA00043 2733 10399000 BR @14 2733 10400000 * END; /* @Y30LB26*/ 10401000 * 2734 10402000 * /*****************************************************************/ 10403000 * /* */ 10404000 * /* UPDATE FIELDS IN THE BASE VOLUME RECORD THAT @Y30LB26*/ 10405000 * /* NEED TO BE UPDATED WHEN GOING NON-GROUPED CATAGORY @Y30LB26*/ 10406000 * /* */ 10407000 * /*****************************************************************/ 10408000 * 2735 10409000 * BASGRPV=OFF; /* CLEAR GROUP FLAG @Y30LB26*/ 10410000 @RF02730 DS 0H 2736 10411000 * BASGENUS=OFF; /* CLEAR GENERAL USED @Y30LB26*/ 10412000 * BASRSTD=OFF; /* CLEAR RESTRICTED @Y30LB26*/ 10413000 L @02,BASEVPTR 2737 10414000 NI BASGRPV(@02),B'11000111' 2737 10415000 * BASEXPDT=NULEXPDT; /* CLEAR EXPIRATION @Y30LB26*/ 10416000 MVC BASEXPDT(4,@02),NULEXPDT 2738 10417000 * BASGROUP=BLANK; /* BLANK GROUP NAME @Y30LB26*/ 10418000 MVI BASGROUP+1(@02),C' ' 2739 10419000 MVC BASGROUP+2(6,@02),BASGROUP+1(@02) 2739 10420000 MVI BASGROUP(@02),C' ' 2739 10421000 * RETURN; /* @Y30LB26*/ 10422000 B @EL00043 2740 10423000 * END NGROUPIN; /* @Y30LB26*/ 10424000 * 2742 10425000 * /*****************************************************************/ 10426000 * /* */ 10427000 * /* THIS ROUTINE IS CALLED WHEN A GROUPED VOLUME IS @Y30LB26*/ 10428000 * /* CURRENTLY GENERAL USE, BUT IS GOING RESTRICTED @Y30LB26*/ 10429000 * /* IN THE SAME GROUP @Y30LB26*/ 10430000 * /* */ 10431000 * /*****************************************************************/ 10432000 * 2742 10433000 *RESTRICT: /* @Y30LB26*/ 10434000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 10435000 * 2742 10436000 RESTRICT ST @14,@SA00044 2742 10437000 * /*****************************************************************/ 10438000 * /* */ 10439000 * /* GET GROUP NAME AND SET UP TO READ GROUP RECORD @Y30LB26*/ 10440000 * /* */ 10441000 * /*****************************************************************/ 10442000 * 2743 10443000 * GROUPKY=BASGROUP; /* GROUP NAME @Y30LB26*/ 10444000 L @02,BASEVPTR 2743 10445000 MVC GROUPKY(8),BASGROUP(@02) 2743 10446000 * RPLVKEY=ADDR(GKEY); /* ADDR KEY @Y30LB26*/ 10447000 L @02,RPLVPTR 2744 10448000 LA @15,GKEY 2744 10449000 ST @15,RPLVKEY(,@02) 2744 10450000 * RPLVBUF=ADDR(STORGRP); /* ADDR BUFFER @Y30LB26*/ 10451000 LA @15,STORGRP 2745 10452000 ST @15,RPLVBUF(,@02) 2745 10453000 * RPLVBLN=LENGTH(STORGRP); /* LENGTH OF BUFFER @Y30LB26*/ 10454000 MVC RPLVBLN(4,@02),@CF01147 2746 10455000 * RPLVLOC=OFF; /* NO LOCATE MODE @Y30LB26*/ 10456000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 10457000 OI RPLVDIR(@02),B'01000000' 2748 10458000 NI RPLVLOC(@02),B'01111111' 2748 10459000 * RPLVTYP=RPLVREAD; /* READ @Y30LB26*/ 10460000 MVI RPLVTYP(@02),X'00' 2749 10461000 * RPLVUPD=ON; /* FOR UPDATE @Y30LB26*/ 10462000 OI RPLVUPD(@02),B'00000010' 2750 10463000 * RESPECIFY 2751 10464000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 10465000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 10466000 LR REG1,@02 2752 10467000 * CALL ICBVIO00; /* READ GROUP RECORD @Y30LB26*/ 10468000 L @15,@CV00671 2753 10469000 BALR @14,@15 2753 10470000 * RESPECIFY 2754 10471000 * REG1 UNRSTD; /* UNRESTRICT REG1 @Y30LB26*/ 10472000 * IF RPLVRETC^=RCZERO THEN /* CHECK RETURN? @Y30LB26*/ 10473000 L @02,RPLVPTR 2755 10474000 CLC RPLVRETC(2,@02),@CB00747 2755 10475000 BE @RF02755 2755 10476000 * DO; /* @Y30LB26*/ 10477000 * CALL ERREXIT; /* FREE INVENTORY @Y30LB26*/ 10478000 BAL @14,ERREXIT 2757 10479000 * RETURN; /* @Y30LB26*/ 10480000 @EL00044 DS 0H 2758 10481000 @EF00044 DS 0H 2758 10482000 @ER00044 L @14,@SA00044 2758 10483000 BR @14 2758 10484000 * END; /* @Y30LB26*/ 10485000 * 2759 10486000 * /*****************************************************************/ 10487000 * /* */ 10488000 * /* UPDATE FIELDS IN THE GROUP RECORD THAT CHANGE @Y30LB26*/ 10489000 * /* WHEN ONE OF ITS VOLUMES GOES FROM GENERAL TO @Y30LB26*/ 10490000 * /* RESTRICTED @Y30LB26*/ 10491000 * /* */ 10492000 * /*****************************************************************/ 10493000 * 2760 10494000 * GROUPPTR=ADDR(STORGRP); /* ADDR TO GROUP REC @Y30LB26*/ 10495000 @RF02755 LA @02,STORGRP 2760 10496000 ST @02,GROUPPTR 2760 10497000 * GRONGEN=GRONGEN-ONE; /* 1 LESS GENERAL USE @Y30LB26*/ 10498000 LH @15,GRONGEN(,@02) 2761 10499000 BCTR @15,0 2761 10500000 STH @15,GRONGEN(,@02) 2761 10501000 * GRONRSTD=GRONRSTD+ONE; /* ONE MORE RESTRICTED @Y30LB26*/ 10502000 LA @15,1 2762 10503000 AH @15,GRONRSTD(,@02) 2762 10504000 STH @15,GRONRSTD(,@02) 2762 10505000 * ADDGRP=OFF; /* INDICATE TAKING OUT @Y30LB26*/ 10506000 * 2763 10507000 NI ADDGRP,B'11110111' 2763 10508000 * /*****************************************************************/ 10509000 * /* */ 10510000 * /* GO TAKE SOME SPACE OUT OF GROUPS GENERAL VOLUME @Y30LB26*/ 10511000 * /* TOTALS SINCE IT IS GOING RESTRICTED @Y30LB26*/ 10512000 * /* */ 10513000 * /*****************************************************************/ 10514000 * 2764 10515000 * CALL ICBVUPGH(GROUPPTR,BASEVPTR,PASSFLAG);/* @Y30LB26*/ 10516000 L @15,@CV00676 2764 10517000 LA @01,@AL02764 2764 10518000 BALR @14,@15 2764 10519000 * IF RPLVRETC^=RCZERO THEN /* CHECK RETURN @Y30LB26*/ 10520000 L @02,RPLVPTR 2765 10521000 CLC RPLVRETC(2,@02),@CB00747 2765 10522000 BE @RF02765 2765 10523000 * DO; /* @Y30LB26*/ 10524000 * CALL ERREXIT; /* FREE INVENTORY @Y30LB26*/ 10525000 BAL @14,ERREXIT 2767 10526000 * RETURN; /* @Y30LB26*/ 10527000 B @EL00044 2768 10528000 * END; /* @Y30LB26*/ 10529000 * 2769 10530000 * /*****************************************************************/ 10531000 * /* */ 10532000 * /* UPDATE FIELDS IN THE BASE VOLUME RECORD THAT @Y30LB26*/ 10533000 * /* CHANGE WHEN GOING FRON GENERAL TO RESTRICTED @Y30LB26*/ 10534000 * /* */ 10535000 * /*****************************************************************/ 10536000 * 2770 10537000 * BASGENUS=OFF; /* NOT GENERAL USE @Y30LB26*/ 10538000 @RF02765 DS 0H 2771 10539000 * BASRSTD=ON; /* RESTRICTED USE @Y30LB26*/ 10540000 L @02,BASEVPTR 2771 10541000 OI BASRSTD(@02),B'00001000' 2771 10542000 NI BASGENUS(@02),B'11101111' 2771 10543000 * BASEXPDT=NULEXPDT; /* CLEAR EXPIRATION @Y30LB26*/ 10544000 * 2772 10545000 MVC BASEXPDT(4,@02),NULEXPDT 2772 10546000 * /*****************************************************************/ 10547000 * /* */ 10548000 * /* WRITE THE GROUP RECORD JUST PREVIOUSLY READ @Y30LB26*/ 10549000 * /* */ 10550000 * /*****************************************************************/ 10551000 * 2773 10552000 * RPLVTYP=RPLVPUT; /* PUT GROUP REC @Y30LB26*/ 10553000 L @02,RPLVPTR 2773 10554000 MVI RPLVTYP(@02),X'01' 2773 10555000 * RESPECIFY 2774 10556000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 10557000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 10558000 LR REG1,@02 2775 10559000 * CALL ICBVIO00; /* READ GROUP RECORD @Y30LB26*/ 10560000 L @15,@CV00671 2776 10561000 BALR @14,@15 2776 10562000 * RESPECIFY 2777 10563000 * REG1 UNRSTD; /* UNRESTRICT REG1 @Y30LB26*/ 10564000 * IF RPLVRETC^=RCZERO THEN /* CHECK RETURN? @Y30LB26*/ 10565000 L @02,RPLVPTR 2778 10566000 CLC RPLVRETC(2,@02),@CB00747 2778 10567000 BE @RF02778 2778 10568000 * DO; /* @Y30LB26*/ 10569000 * CALL ERREXIT; /* FREE INVENTORY @Y30LB26*/ 10570000 BAL @14,ERREXIT 2780 10571000 * RETURN; /* @Y30LB26*/ 10572000 B @EL00044 2781 10573000 * END; /* @Y30LB26*/ 10574000 * 2782 10575000 * /*****************************************************************/ 10576000 * /* */ 10577000 * /* IF THE RPLV HAS NEVER BEEN JOURNALED BEFORE, DO IT @Y30LB26*/ 10578000 * /* */ 10579000 * /*****************************************************************/ 10580000 * 2783 10581000 * IF JRNLEDSW=OFF THEN /* JOURNALED? @Y30LB26*/ 10582000 @RF02778 TM JRNLEDSW,B'00000001' 2783 10583000 BNZ @RF02783 2783 10584000 * CALL JOURNAL; /* JOURNAL IT @Y30LB26*/ 10585000 * 2784 10586000 BAL @14,JOURNAL 2784 10587000 * /*****************************************************************/ 10588000 * /* */ 10589000 * /* REMOVE SLOT FROM THE GROUP EXTENSION RECORD @Y30LB26*/ 10590000 * /* */ 10591000 * /*****************************************************************/ 10592000 * 2785 10593000 * ADDSLEXT=OFF; /* INDICATE REMOVING @Y30LB26*/ 10594000 @RF02783 NI ADDSLEXT,B'11111101' 2785 10595000 * SLOTEXP=OFF; /* NOT EXPIR CALL @Y30LB26*/ 10596000 NI SLOTEXP,B'01111111' 2786 10597000 * CALL VUEXT; /* GO REMOVE SLOT @Y30LB26*/ 10598000 * 2787 10599000 BAL @14,VUEXT 2787 10600000 * /*****************************************************************/ 10601000 * /* */ 10602000 * /* CHECK RETURN CODE @Y30LB26*/ 10603000 * /* */ 10604000 * /*****************************************************************/ 10605000 * 2788 10606000 * IF RPLVRETC^=RCZERO THEN /* CHECK RETURN? @Y30LB26*/ 10607000 L @02,RPLVPTR 2788 10608000 CLC RPLVRETC(2,@02),@CB00747 2788 10609000 BE @RF02788 2788 10610000 * DO; /* @Y30LB26*/ 10611000 * CALL ERREXIT; /* FREE INVENTORY @Y30LB26*/ 10612000 BAL @14,ERREXIT 2790 10613000 * RETURN; /* @Y30LB26*/ 10614000 B @EL00044 2791 10615000 * END; /* @Y30LB26*/ 10616000 * RETURN; /* @Y30LB26*/ 10617000 B @EL00044 2793 10618000 * END RESTRICT; /* @Y30LB26*/ 10619000 B @EL00044 2794 10620000 * 2795 10621000 * /*****************************************************************/ 10622000 * /* */ 10623000 * /* THIS ROUTINE IS CALLED WHEN A BASE VOLUME RECORD @Y30LB26*/ 10624000 * /* IS GOING FROM RESTRICTED TO GENERAL USE IN THE @Y30LB26*/ 10625000 * /* SAME GROUP @Y30LB26*/ 10626000 * /* */ 10627000 * /*****************************************************************/ 10628000 * 2795 10629000 *GENERAL: /* @Y30LB26*/ 10630000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 10631000 * 2795 10632000 GENERAL ST @14,@SA00045 2795 10633000 * /*****************************************************************/ 10634000 * /* */ 10635000 * /* GET GROUP NAME FROM BASE RECORD AND SET UP TO @Y30LB26*/ 10636000 * /* READ THE GROUP RECORD @Y30LB26*/ 10637000 * /* */ 10638000 * /*****************************************************************/ 10639000 * 2796 10640000 * GROUPKY=BASGROUP; /* GET NEW GROUP NAME @Y30LB26*/ 10641000 L @02,BASEVPTR 2796 10642000 MVC GROUPKY(8),BASGROUP(@02) 2796 10643000 * RPLVKEY=ADDR(GKEY); /* ADDR GROUP KEY @Y30LB26*/ 10644000 L @02,RPLVPTR 2797 10645000 LA @15,GKEY 2797 10646000 ST @15,RPLVKEY(,@02) 2797 10647000 * RPLVBUF=ADDR(STORGRP); /* BUFFER ADDRESS @Y30LB26*/ 10648000 LA @15,STORGRP 2798 10649000 ST @15,RPLVBUF(,@02) 2798 10650000 * RPLVBLN=LENGTH(STORGRP); /* LENGTH OF BUFFER @Y30LB26*/ 10651000 MVC RPLVBLN(4,@02),@CF01147 2799 10652000 * RPLVLOC=OFF; /* NO LOCATE MODE @Y30LB26*/ 10653000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 10654000 OI RPLVDIR(@02),B'01000000' 2801 10655000 NI RPLVLOC(@02),B'01111111' 2801 10656000 * RPLVTYP=RPLVREAD; /* READ @Y30LB26*/ 10657000 MVI RPLVTYP(@02),X'00' 2802 10658000 * RPLVUPD=ON; /* FOR UPDATE @Y30LB26*/ 10659000 OI RPLVUPD(@02),B'00000010' 2803 10660000 * RESPECIFY 2804 10661000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 10662000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 10663000 LR REG1,@02 2805 10664000 * CALL ICBVIO00; /* READ GROUP RECORD @Y30LB26*/ 10665000 L @15,@CV00671 2806 10666000 BALR @14,@15 2806 10667000 * RESPECIFY 2807 10668000 * REG1 UNRSTD; /* UNRESTRICT REG1 @Y30LB26*/ 10669000 * IF RPLVRETC^=RCZERO THEN /* CHECK RETURN? @Y30LB26*/ 10670000 L @02,RPLVPTR 2808 10671000 CLC RPLVRETC(2,@02),@CB00747 2808 10672000 BE @RF02808 2808 10673000 * DO; /* @Y30LB26*/ 10674000 * CALL ERREXIT; /* FREE INVENTORY @Y30LB26*/ 10675000 BAL @14,ERREXIT 2810 10676000 * RETURN; /* @Y30LB26*/ 10677000 @EL00045 DS 0H 2811 10678000 @EF00045 DS 0H 2811 10679000 @ER00045 L @14,@SA00045 2811 10680000 BR @14 2811 10681000 * END; /* @Y30LB26*/ 10682000 * 2812 10683000 * /*****************************************************************/ 10684000 * /* */ 10685000 * /* GET ADDRESS OF GROUP RECORD, UPDATE REQUIRED FIELDS @Y30LB26*/ 10686000 * /* */ 10687000 * /*****************************************************************/ 10688000 * 2813 10689000 * GROUPPTR=ADDR(STORGRP); /* ADDRESSING TO GRP REC @Y30LB26*/ 10690000 * 2813 10691000 @RF02808 LA @02,STORGRP 2813 10692000 ST @02,GROUPPTR 2813 10693000 * /*****************************************************************/ 10694000 * /* */ 10695000 * /* CHECK MOUNTING ATTRIBUTES @Y30LB26*/ 10696000 * /* */ 10697000 * /*****************************************************************/ 10698000 * 2814 10699000 * IF BASBIND=OFF&GROBIND=OFF| /* BINDS MATCH? @Y30LB26*/ 10700000 * BASBIND=ON&GROBIND=ON THEN /* BINDS MATCH? @Y30LB26*/ 10701000 L @01,BASEVPTR 2814 10702000 TM BASBIND(@01),B'00000010' 2814 10703000 BNZ @GL00060 2814 10704000 TM GROBIND(@02),B'10000000' 2814 10705000 BZ @RT02814 2814 10706000 @GL00060 L @02,BASEVPTR 2814 10707000 TM BASBIND(@02),B'00000010' 2814 10708000 BNO @RF02814 2814 10709000 L @02,GROUPPTR 2814 10710000 TM GROBIND(@02),B'10000000' 2814 10711000 BNO @RF02814 2814 10712000 @RT02814 DS 0H 2815 10713000 * DO; /* @Y30LB26*/ 10714000 * IF BASEXCL=OFF&GROEXCL=OFF| /* EXCL MATC @Y30LB26*/ 10715000 * BASEXCL=ON&GROEXCL=ON THEN/* EXCL MAT @Y30LB26*/ 10716000 L @02,BASEVPTR 2816 10717000 TM BASEXCL(@02),B'00000001' 2816 10718000 BNZ @GL00063 2816 10719000 L @02,GROUPPTR 2816 10720000 TM GROEXCL(@02),B'01000000' 2816 10721000 BZ @RT02816 2816 10722000 @GL00063 L @02,BASEVPTR 2816 10723000 TM BASEXCL(@02),B'00000001' 2816 10724000 BNO @RF02816 2816 10725000 L @02,GROUPPTR 2816 10726000 TM GROEXCL(@02),B'01000000' 2816 10727000 BNO @RF02816 2816 10728000 @RT02816 DS 0H 2817 10729000 * DO; /* @Y30LB26*/ 10730000 * IF BASDAERA=OFF&GRODAERA=OFF|/* ERA @Y30LB26*/ 10731000 * BASDAERA=ON&GRODAERA=ON THEN/* ERA @Y30LB26*/ 10732000 L @02,BASEVPTR 2818 10733000 TM BASDAERA(@02),B'10000000' 2818 10734000 BNZ @GL00066 2818 10735000 L @02,GROUPPTR 2818 10736000 TM GRODAERA(@02),B'00100000' 2818 10737000 BZ @RT02818 2818 10738000 @GL00066 L @02,BASEVPTR 2818 10739000 TM BASDAERA(@02),B'10000000' 2818 10740000 BNO @RF02818 2818 10741000 L @02,GROUPPTR 2818 10742000 TM GRODAERA(@02),B'00100000' 2818 10743000 BNO @RF02818 2818 10744000 @RT02818 DS 0H 2819 10745000 * DO; /* @Y30LB26*/ 10746000 * IF BASRONLY=OFF&GRORONLY=OFF|/* @Y30LB26*/ 10747000 * BASRONLY=ON&GRORONLY=ON/* @Y30LB26*/ 10748000 * THEN 2820 10749000 L @02,BASEVPTR 2820 10750000 TM BASRONLY(@02),B'01000000' 2820 10751000 BNZ @GL00069 2820 10752000 L @02,GROUPPTR 2820 10753000 TM GRORONLY(@02),B'00010000' 2820 10754000 BZ @RT02820 2820 10755000 @GL00069 L @02,BASEVPTR 2820 10756000 TM BASRONLY(@02),B'01000000' 2820 10757000 BNO @RF02820 2820 10758000 L @02,GROUPPTR 2820 10759000 TM GRORONLY(@02),B'00010000' 2820 10760000 BNO @RF02820 2820 10761000 @RT02820 DS 0H 2821 10762000 * I=I; /* DUMMY INST @Y30LB26*/ 10763000 SLR @02,@02 2821 10764000 IC @02,I 2821 10765000 STC @02,I 2821 10766000 * ELSE /* @Y30LB26*/ 10767000 * DO; /* @Y30LB26*/ 10768000 B @RC02820 2822 10769000 @RF02820 DS 0H 2823 10770000 * RPLVRETC=FOUR; /* BAD RC @Y30LB26*/ 10771000 L @02,RPLVPTR 2823 10772000 MVC RPLVRETC(2,@02),@CB00749 2823 10773000 * RPLRCODE=INCOMSS1;/* INCOM @Y30LB26*/ 10774000 MVC RPLRCODE(2,@02),@CB00827 2824 10775000 * CALL ERREXIT; /* SAVE STUFF @Y30LB26*/ 10776000 BAL @14,ERREXIT 2825 10777000 * RETURN; /* @Y30LB26*/ 10778000 B @EL00045 2826 10779000 * END; /* @Y30LB26*/ 10780000 * END; /* @Y30LB26*/ 10781000 * ELSE /* @Y30LB26*/ 10782000 * DO; /* @Y30LB26*/ 10783000 B @RC02818 2829 10784000 @RF02818 DS 0H 2830 10785000 * RPLVRETC=FOUR; /* BAD RC @Y30LB26*/ 10786000 L @02,RPLVPTR 2830 10787000 MVC RPLVRETC(2,@02),@CB00749 2830 10788000 * RPLRCODE=INCOMSS1; /* INCOM SS @Y30LB26*/ 10789000 MVC RPLRCODE(2,@02),@CB00827 2831 10790000 * CALL ERREXIT; /* SAVE @Y30LB26*/ 10791000 BAL @14,ERREXIT 2832 10792000 * RETURN; /* @Y30LB26*/ 10793000 B @EL00045 2833 10794000 * END; /* @Y30LB26*/ 10795000 * END; /* @Y30LB26*/ 10796000 * ELSE /* @Y30LB26*/ 10797000 * DO; /* @Y30LB26*/ 10798000 B @RC02816 2836 10799000 @RF02816 DS 0H 2837 10800000 * RPLVRETC=FOUR; /* BAD RC @Y30LB26*/ 10801000 L @02,RPLVPTR 2837 10802000 MVC RPLVRETC(2,@02),@CB00749 2837 10803000 * RPLRCODE=INCOMSS1; /* INCOM @Y30LB26*/ 10804000 MVC RPLRCODE(2,@02),@CB00827 2838 10805000 * CALL ERREXIT; /* SAVE RET @Y30LB26*/ 10806000 BAL @14,ERREXIT 2839 10807000 * RETURN; /* @Y30LB26*/ 10808000 B @EL00045 2840 10809000 * END; /* @Y30LB26*/ 10810000 * END; /* @Y30LB26*/ 10811000 * ELSE /* @Y30LB26*/ 10812000 * 2843 10813000 * /***************************************************************/ 10814000 * /* */ 10815000 * /* IF ATTRIBUTES DONT MATCH, EXIT ERROR @Y30LB26*/ 10816000 * /* */ 10817000 * /***************************************************************/ 10818000 * 2843 10819000 * DO; /* @Y30LB26*/ 10820000 B @RC02814 2843 10821000 @RF02814 DS 0H 2844 10822000 * RPLVRETC=FOUR; /* SET BAD RC @Y30LB26*/ 10823000 L @02,RPLVPTR 2844 10824000 MVC RPLVRETC(2,@02),@CB00749 2844 10825000 * RPLRCODE=INCOMSS1; /* INCOMPAT SS1 ATT @Y30LB26*/ 10826000 MVC RPLRCODE(2,@02),@CB00827 2845 10827000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 10828000 BAL @14,ERREXIT 2846 10829000 * RETURN; /* @Y30LB26*/ 10830000 B @EL00045 2847 10831000 * END; /* @Y30LB26*/ 10832000 * GRONGEN=GRONGEN+ONE; /* ONE MORE GENERAL USE #Y30LB26*/ 10833000 @RC02814 L @02,GROUPPTR 2849 10834000 LA @15,1 2849 10835000 AH @15,GRONGEN(,@02) 2849 10836000 STH @15,GRONGEN(,@02) 2849 10837000 * GRONRSTD=GRONRSTD-ONE; /* ONE LESS RESTRICTED #Y30LB26*/ 10838000 * 2850 10839000 LH @15,GRONRSTD(,@02) 2850 10840000 BCTR @15,0 2850 10841000 STH @15,GRONRSTD(,@02) 2850 10842000 * /*****************************************************************/ 10843000 * /* */ 10844000 * /* GO ADD SOME SPACE TO THE GROUP FIELDS SINCE IT IS #Y30LB26*/ 10845000 * /* GETTING A GENERAL TYPE VOLUME #Y30LB26*/ 10846000 * /* */ 10847000 * /*****************************************************************/ 10848000 * 2851 10849000 * ADDGRP=ON; /* INDICATE ADDING GEN @Y30LB26*/ 10850000 OI ADDGRP,B'00001000' 2851 10851000 * CALL ICBVUPGH(GROUPPTR,BASEVPTR,PASSFLAG);/* @Y30LB26*/ 10852000 L @15,@CV00676 2852 10853000 LA @01,@AL02852 2852 10854000 BALR @14,@15 2852 10855000 * IF RPLVRETC^=RCZERO THEN /* CHECK RETURN @Y30LB26*/ 10856000 L @02,RPLVPTR 2853 10857000 CLC RPLVRETC(2,@02),@CB00747 2853 10858000 BE @RF02853 2853 10859000 * DO; /* @Y30LB26*/ 10860000 * CALL ERREXIT; /* FREE INVENTORY @Y30LB26*/ 10861000 BAL @14,ERREXIT 2855 10862000 * RETURN; /* @Y30LB26*/ 10863000 B @EL00045 2856 10864000 * END; /* @Y30LB26*/ 10865000 * 2858 10866000 * /*****************************************************************/ 10867000 * /* */ 10868000 * /* CHANGE INDICATORS IN BASE VOLUME TO GENERAL USE @Y30LB26*/ 10869000 * /* */ 10870000 * /*****************************************************************/ 10871000 * 2858 10872000 * BASGENUS=ON; /* GENERAL USE @Y30LB26*/ 10873000 @RF02853 DS 0H 2859 10874000 * BASRSTD=OFF; /* NOT RESTRICTED USE @Y30LB26*/ 10875000 * 2859 10876000 L @02,BASEVPTR 2859 10877000 OI BASGENUS(@02),B'00010000' 2859 10878000 NI BASRSTD(@02),B'11110111' 2859 10879000 * /*****************************************************************/ 10880000 * /* */ 10881000 * /* WRITE GROUP RECORD @Y30LB26*/ 10882000 * /* */ 10883000 * /*****************************************************************/ 10884000 * 2860 10885000 * RPLVTYP=RPLVPUT; /* PUT GROUP REC @Y30LB26*/ 10886000 L @02,RPLVPTR 2860 10887000 MVI RPLVTYP(@02),X'01' 2860 10888000 * RESPECIFY 2861 10889000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 10890000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 10891000 LR REG1,@02 2862 10892000 * CALL ICBVIO00; /* READ GROUP RECORD @Y30LB26*/ 10893000 L @15,@CV00671 2863 10894000 BALR @14,@15 2863 10895000 * RESPECIFY 2864 10896000 * REG1 UNRSTD; /* UNRESTRICT REG1 @Y30LB26*/ 10897000 * IF RPLVRETC^=RCZERO THEN /* CHECK RETURN? @Y30LB26*/ 10898000 L @02,RPLVPTR 2865 10899000 CLC RPLVRETC(2,@02),@CB00747 2865 10900000 BE @RF02865 2865 10901000 * DO; /* @Y30LB26*/ 10902000 * CALL ERREXIT; /* FREE INVENTORY @Y30LB26*/ 10903000 BAL @14,ERREXIT 2867 10904000 * RETURN; /* @Y30LB26*/ 10905000 B @EL00045 2868 10906000 * END; /* @Y30LB26*/ 10907000 * 2869 10908000 * /*****************************************************************/ 10909000 * /* */ 10910000 * /* IF RPLV HAS NOT BEEN JOURNALED BEFORE, JOURNAL IT @Y30LB26*/ 10911000 * /* */ 10912000 * /*****************************************************************/ 10913000 * 2870 10914000 * IF JRNLEDSW=OFF THEN /* JOURNALED? @Y30LB26*/ 10915000 @RF02865 TM JRNLEDSW,B'00000001' 2870 10916000 BNZ @RF02870 2870 10917000 * CALL JOURNAL; /* JOURNAL IT @Y30LB26*/ 10918000 * 2871 10919000 BAL @14,JOURNAL 2871 10920000 * /*****************************************************************/ 10921000 * /* */ 10922000 * /* ADD SLOT TO THE GROUP EXTENSION RECORD @Y30LB26*/ 10923000 * /* */ 10924000 * /*****************************************************************/ 10925000 * 2872 10926000 * ADDSLEXT=ON; /* INDICATE ADDING @Y30LB26*/ 10927000 @RF02870 OI ADDSLEXT,B'00000010' 2872 10928000 * SLOTEXP=OFF; /* NOT EXPIR CALL @Y30LB26*/ 10929000 NI SLOTEXP,B'01111111' 2873 10930000 * CALL VUEXT; /* GO ADD SLOT @Y30LB26*/ 10931000 * 2874 10932000 BAL @14,VUEXT 2874 10933000 * /*****************************************************************/ 10934000 * /* */ 10935000 * /* CHECK RETURN CODE @Y30LB26*/ 10936000 * /* */ 10937000 * /*****************************************************************/ 10938000 * 2875 10939000 * IF RPLVRETC^=RCZERO THEN /* CHECK RETURN? @Y30LB26*/ 10940000 L @02,RPLVPTR 2875 10941000 CLC RPLVRETC(2,@02),@CB00747 2875 10942000 BE @RF02875 2875 10943000 * DO; /* @Y30LB26*/ 10944000 * CALL ERREXIT; /* FREE INVENTORY @Y30LB26*/ 10945000 BAL @14,ERREXIT 2877 10946000 * RETURN; /* @Y30LB26*/ 10947000 B @EL00045 2878 10948000 * END; /* @Y30LB26*/ 10949000 * RETURN; /* #Y30LB26*/ 10950000 B @EL00045 2880 10951000 * END GENERAL; /* @Y30LB26*/ 10952000 B @EL00045 2881 10953000 * 2882 10954000 * /*****************************************************************/ 10955000 * /* */ 10956000 * /* THIS ROUTINE READS THE GROUP RECORD IF EITHER @Y30LB26*/ 10957000 * /* TO OR FOR EXPIRATION DATES WERE SPECIFIED AND @Y30LB26*/ 10958000 * /* IF THERE IS NO EXPIRATION CHECKING FOR THE GROUP @Y30LB26*/ 10959000 * /* IT RETURNS WITH AN REASON CODE @Y30LB26*/ 10960000 * /* */ 10961000 * /*****************************************************************/ 10962000 * 2882 10963000 *EXPCK: 2882 10964000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 10965000 * 2882 10966000 EXPCK ST @14,@SA00046 2882 10967000 * /*****************************************************************/ 10968000 * /* */ 10969000 * /* BE SURE THAT TO OR FOR WERE SPECIFIED @Y30LB26*/ 10970000 * /* */ 10971000 * /*****************************************************************/ 10972000 * 2883 10973000 * IF MVRFLFOR=ON|MVRFLTO=ON THEN /* CK TO AND FOR @Y30LB26*/ 10974000 L @02,MVRPTR 2883 10975000 TM MVRFLFOR(@02),B'10001000' 2883 10976000 BZ @RF02883 2883 10977000 * DO; /* @Y30LB26*/ 10978000 * 2884 10979000 * /*************************************************************/ 10980000 * /* */ 10981000 * /* SEE IF BASE RECORD IS GOING GROUPED GENERAL OR @Y30LB26*/ 10982000 * /* STAYING GROUPED GENERAL USE @Y30LB26*/ 10983000 * /* */ 10984000 * /*************************************************************/ 10985000 * 2885 10986000 * IF((MVRFLGRO=ON|BASGRPV=ON)&MVRGEN=ON)|/* GO GEN GRP ? 2885 10987000 * @Y30LB26*/ 10988000 * (BASGENUS=ON&MVRNGRP=OFF&MVRRSTD=OFF) THEN/* STAY GEN 2885 10989000 * @Y30LB26*/ 10990000 * 2885 10991000 TM MVRFLGRO(@02),B'01000000' 2885 10992000 BO @GL00073 2885 10993000 L @02,BASEVPTR 2885 10994000 TM BASGRPV(@02),B'00100000' 2885 10995000 BNO @GL00072 2885 10996000 @GL00073 L @02,MVRPTR 2885 10997000 TM MVRGEN(@02),B'10000000' 2885 10998000 BO @RT02885 2885 10999000 @GL00072 L @02,BASEVPTR 2885 11000000 TM BASGENUS(@02),B'00010000' 2885 11001000 BNO @RF02885 2885 11002000 L @02,MVRPTR 2885 11003000 TM MVRNGRP(@02),B'01100000' 2885 11004000 BNZ @RF02885 2885 11005000 @RT02885 DS 0H 2886 11006000 * /***********************************************************/ 11007000 * /* */ 11008000 * /* GET GROUP NAME FROM CORRECT SORCE @Y30LB26*/ 11009000 * /* */ 11010000 * /***********************************************************/ 11011000 * 2886 11012000 * DO; /* @Y30LB26*/ 11013000 * IF MVRFLGRO=ON THEN /* GROUP SPECIFIED ? @Y30LB26*/ 11014000 L @02,MVRPTR 2887 11015000 TM MVRFLGRO(@02),B'01000000' 2887 11016000 BNO @RF02887 2887 11017000 * GROUPKY=MVRGROUP; /* GROUP FROM REQ BLK @Y30LB26*/ 11018000 MVC GROUPKY(8),MVRGROUP(@02) 2888 11019000 * ELSE /* @Y30LB26*/ 11020000 * GROUPKY=BASGROUP; /* GROUP FROM BASE REC @Y30LB26*/ 11021000 * 2889 11022000 B @RC02887 2889 11023000 @RF02887 L @02,BASEVPTR 2889 11024000 MVC GROUPKY(8),BASGROUP(@02) 2889 11025000 * /*********************************************************/ 11026000 * /* */ 11027000 * /* SET UP REMAINING PARAMETERS AND READ GROUP RECORD */ 11028000 * /* @Y30LB26*/ 11029000 * /* TO SEE IF IT HAS RETENTION SPECIFIED FOR GROUP */ 11030000 * /* @Y30LB26*/ 11031000 * /* */ 11032000 * /*********************************************************/ 11033000 * 2890 11034000 * RPLVKEY=ADDR(GKEY); /* ADDR OF KEY @Y30LB26*/ 11035000 @RC02887 L @02,RPLVPTR 2890 11036000 LA @15,GKEY 2890 11037000 ST @15,RPLVKEY(,@02) 2890 11038000 * RPLVLOC=ON; /* LOCATE MODE @Y30LB26*/ 11039000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 11040000 OI RPLVLOC(@02),B'11000000' 2892 11041000 * RPLVTYP=RPLVREAD; /* READ REC @Y30LB26*/ 11042000 MVI RPLVTYP(@02),X'00' 2893 11043000 * RPLVUPD=OFF; /* NOT FOR UPDATE @Y30LB26*/ 11044000 NI RPLVUPD(@02),B'11111101' 2894 11045000 * RESPECIFY 2895 11046000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 11047000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 11048000 LR REG1,@02 2896 11049000 * CALL ICBVIO00; /* READ GROUP RECORD @Y30LB26*/ 11050000 L @15,@CV00671 2897 11051000 BALR @14,@15 2897 11052000 * RPLVLOC=OFF; /* RESET LOCATE FLAG @Y30LB26*/ 11053000 L @02,RPLVPTR 2898 11054000 NI RPLVLOC(@02),B'01111111' 2898 11055000 * RESPECIFY 2899 11056000 * REG1 UNRSTD; /* UNRESTRICT REG1 @Y30LB26*/ 11057000 * IF RPLVRETC^=RCZERO THEN/* CHECK RETURN? @Y30LB26*/ 11058000 CLC RPLVRETC(2,@02),@CB00747 2900 11059000 BE @RF02900 2900 11060000 * DO; /* @Y30LB26*/ 11061000 * CALL ERREXIT; /* FREE INVENTORY @Y30LB26*/ 11062000 BAL @14,ERREXIT 2902 11063000 * RETURN; /* @Y30LB26*/ 11064000 @EL00046 DS 0H 2903 11065000 @EF00046 DS 0H 2903 11066000 @ER00046 L @14,@SA00046 2903 11067000 BR @14 2903 11068000 * END; /* @Y30LB26*/ 11069000 * 2904 11070000 * /*********************************************************/ 11071000 * /* */ 11072000 * /* GET ADDRESS OF GROUP RECORD AND CHECK IF RETENTION */ 11073000 * /* @Y30LB26*/ 11074000 * /* CHECKING IN EFFECT @Y30LB26*/ 11075000 * /* */ 11076000 * /*********************************************************/ 11077000 * 2905 11078000 * GROUPPTR=RPLVBUF; /* ADDRESSING TO BUFFER @Y30LB26*/ 11079000 @RF02900 L @02,RPLVPTR 2905 11080000 L @15,RPLVBUF(,@02) 2905 11081000 ST @15,GROUPPTR 2905 11082000 * IF GRORETN=OFF THEN /* NO RET DATE? @Y30LB26*/ 11083000 * 2906 11084000 TM GRORETN(@15),B'00000100' 2906 11085000 BNZ @RF02906 2906 11086000 * /*******************************************************/ 11087000 * /* */ 11088000 * /* IF RETENTION CHECKING NOT IN EFFECT, THEN FOULED UP */ 11089000 * /* @Y30LB26*/ 11090000 * /* */ 11091000 * /*******************************************************/ 11092000 * 2907 11093000 * DO; /* @Y30LB26*/ 11094000 * RPLVRETC=FOUR; /* SET BAD RETURN @Y30LB26*/ 11095000 MVC RPLVRETC(2,@02),@CB00749 2908 11096000 * RPLRCODE=NOEXPICK; /* NO GROUP EXPIRATION @Y30LB26*/ 11097000 MVC RPLRCODE(2,@02),@CB00825 2909 11098000 * CALL ERREXIT; /* FREE INVENTORY @Y30LB26*/ 11099000 BAL @14,ERREXIT 2910 11100000 * RETURN; /* @Y30LB26*/ 11101000 B @EL00046 2911 11102000 * END; /* @Y30LB26*/ 11103000 * END; /* @Y30LB26*/ 11104000 * 2913 11105000 * /*************************************************************/ 11106000 * /* */ 11107000 * /* IF BASE VOLUME IS NOT BECOMMING A GROUPED GENERAL @Y30LB26*/ 11108000 * /* USE, OR STAYING A GROUPED GENERAL USE, THEN TO @Y30LB26*/ 11109000 * /* OR FOR SHOULD NOT HAVE BEEN SPECIFIED @Y30LB26*/ 11110000 * /* */ 11111000 * /*************************************************************/ 11112000 * 2914 11113000 * ELSE /* @Y30LB26*/ 11114000 * DO; /* @Y30LB26*/ 11115000 B @RC02885 2914 11116000 @RF02885 DS 0H 2915 11117000 * RPLVRETC=FOUR; /* SET BAD RET CODE @Y30LB26*/ 11118000 L @02,RPLVPTR 2915 11119000 MVC RPLVRETC(2,@02),@CB00749 2915 11120000 * RPLRCODE=NOEXPICK; /* NO EXPIRATION CK @Y30LB26*/ 11121000 MVC RPLRCODE(2,@02),@CB00825 2916 11122000 * CALL ERREXIT; /* SAVE RET CODES @Y30LB26*/ 11123000 BAL @14,ERREXIT 2917 11124000 * RETURN; /* @Y30LB26*/ 11125000 B @EL00046 2918 11126000 * END; /* @Y30LB26*/ 11127000 * END; /* @Y30LB26*/ 11128000 * END EXPCK; /* @Y30LB26*/ 11129000 B @EL00046 2921 11130000 * 2922 11131000 * /*****************************************************************/ 11132000 * /* */ 11133000 * /* ROUTINE UPDATES THE REMAINING FIELDS IN THE BASE @Y30LB26*/ 11134000 * /* VOLUME RECORD THAT HAVE NOTHING TO DO WITH THE GROUP @Y30LB26*/ 11135000 * /* */ 11136000 * /*****************************************************************/ 11137000 * 2922 11138000 *COMMON: /* @Y30LB26*/ 11139000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 11140000 * 2922 11141000 COMMON ST @14,@SA00047 2922 11142000 * /*****************************************************************/ 11143000 * /* */ 11144000 * /* IF GENERAL USE VOLUME THEN HANDLE EXPIRATION #Y30LB26*/ 11145000 * /* CHANGES IF CALLED FOR #Y30LB26*/ 11146000 * /* */ 11147000 * /*****************************************************************/ 11148000 * 2923 11149000 * IF BASGRPV=ON&BASGENUS=ON& /* GENERAL USE VOL? @Y30LB26*/ 11150000 * (MVRNEXPD=ON|MVRFLFOR=ON|MVRFLTO=ON) THEN/* CHNGN EXP 2923 11151000 * @Y30LB26*/ 11152000 L @02,BASEVPTR 2923 11153000 TM BASGRPV(@02),B'00110000' 2923 11154000 BNO @RF02923 2923 11155000 L @02,MVRPTR 2923 11156000 TM MVRNEXPD(@02),B'00000100' 2923 11157000 BO @RT02923 2923 11158000 TM MVRFLFOR(@02),B'10001000' 2923 11159000 BZ @RF02923 2923 11160000 @RT02923 DS 0H 2924 11161000 * DO; /* @Y30LB26*/ 11162000 * 2924 11163000 * /*************************************************************/ 11164000 * /* */ 11165000 * /* READ GROUP RECORD FOR SLOT ROUTINE WHICH @Y30LB26*/ 11166000 * /* NEEDS GROUP RECORD @Y30LB26*/ 11167000 * /* */ 11168000 * /*************************************************************/ 11169000 * 2925 11170000 * GROUPKY=BASGROUP; /* GET GROUP NAME @Y30LB26*/ 11171000 L @02,BASEVPTR 2925 11172000 MVC GROUPKY(8),BASGROUP(@02) 2925 11173000 * RPLVKEY=ADDR(GKEY); /* ADDR GROUP KEY @Y30LB26*/ 11174000 L @02,RPLVPTR 2926 11175000 LA @15,GKEY 2926 11176000 ST @15,RPLVKEY(,@02) 2926 11177000 * RPLVLOC=OFF; /* LOCATE MODE @ZA13484*/ 11178000 NI RPLVLOC(@02),B'01111111' 2927 11179000 * RPLVBLN=LENGTH(STORGRP); /* SET LENGTH @ZA13484*/ 11180000 MVC RPLVBLN(4,@02),@CF01147 2928 11181000 * RPLVBUF=ADDR(STORGRP); /* SET BUF ADDR @ZA13484*/ 11182000 LA @15,STORGRP 2929 11183000 ST @15,RPLVBUF(,@02) 2929 11184000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 11185000 OI RPLVDIR(@02),B'01000000' 2930 11186000 * RPLVTYP=RPLVREAD; /* READ GROUP REC @Y30LB26*/ 11187000 MVI RPLVTYP(@02),X'00' 2931 11188000 * RPLVUPD=OFF; /* NO UPDATE @Y30LB26*/ 11189000 NI RPLVUPD(@02),B'11111101' 2932 11190000 * RESPECIFY 2933 11191000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 11192000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 11193000 LR REG1,@02 2934 11194000 * CALL ICBVIO00; /* READ GROUP RECORD @Y30LB26*/ 11195000 L @15,@CV00671 2935 11196000 BALR @14,@15 2935 11197000 * RESPECIFY 2936 11198000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 11199000 * 2936 11200000 * /*************************************************************/ 11201000 * /* */ 11202000 * /* CHECK RETURN CODE @Y30LB26*/ 11203000 * /* */ 11204000 * /*************************************************************/ 11205000 * 2937 11206000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @Y30LB26*/ 11207000 L @02,RPLVPTR 2937 11208000 CLC RPLVRETC(2,@02),@CB00747 2937 11209000 BE @RF02937 2937 11210000 * DO; /* @Y30LB26*/ 11211000 * CALL ERREXIT; /* SAVE RETURN CODES @Y30LB26*/ 11212000 BAL @14,ERREXIT 2939 11213000 * RETURN; /* @Y30LB26*/ 11214000 @EL00047 DS 0H 2940 11215000 @EF00047 DS 0H 2940 11216000 @ER00047 L @14,@SA00047 2940 11217000 BR @14 2940 11218000 * END; /* @Y30LB26*/ 11219000 * 2941 11220000 * /*************************************************************/ 11221000 * /* */ 11222000 * /* SET ADDR TO GROUP RECORD JUST READ @Y30LB26*/ 11223000 * /* */ 11224000 * /*************************************************************/ 11225000 * 2942 11226000 * GROUPPTR=ADDR(STORGRP); /* ADDR GRP REC @ZA13484*/ 11227000 * 2942 11228000 @RF02937 LA @02,STORGRP 2942 11229000 ST @02,GROUPPTR 2942 11230000 * /*************************************************************/ 11231000 * /* */ 11232000 * /* NULLIFY EXPIRATION DATE BASE RECORD #Y30LB26*/ 11233000 * /* CALL ROUTINE TO UPDATE SLOT IN EXTENSION RECORD @ZA00687*/ 11234000 * /* TO MATCH RETENTION DATE IN BASE VOLUME RECORD @ZA00687*/ 11235000 * /* IF REQUEST TO MODIFY GROUP NAME OR TO GENERAL-USE @ZA00687*/ 11236000 * /* MODIFY RETENTION DATE, DO NOT DELETE AND RE-ADD. @ZA00687*/ 11237000 * /* ALREADY IN LAST GEOUP EXTENSION SLOT. IF MODIFV @ZA00687*/ 11238000 * /* FOR RETENTION DATE. REMOVE FROM CURRENT SLOT AND @ZA00687*/ 11239000 * /* ADD IN LAST EXTENSION SLOT @ZA00687*/ 11240000 * /* */ 11241000 * /*************************************************************/ 11242000 * 2943 11243000 * IF MVRNEXPD=ON THEN /* NULL EXPIRATION DATE? @ZA00687*/ 11244000 L @02,MVRPTR 2943 11245000 TM MVRNEXPD(@02),B'00000100' 2943 11246000 BNO @RF02943 2943 11247000 * DO; /* @XM40000*/ 11248000 * BASEXPDT=NULEXPDT; /* NULLIFY EXPIRATION @ZA00687*/ 11249000 L @01,BASEVPTR 2945 11250000 MVC BASEXPDT(4,@01),NULEXPDT 2945 11251000 * IF MVRFLGRO=ON|MVRGEN=ON THEN 2946 11252000 TM MVRFLGRO(@02),B'01000000' 2946 11253000 BO @RT02946 2946 11254000 TM MVRGEN(@02),B'10000000' 2946 11255000 BO @RT02946 2946 11256000 * ; /* @ZA00687*/ 11257000 * ELSE 2948 11258000 * DO; /* @ZA00687*/ 11259000 * SLOTEXP=OFF; /* INDICATE DELETE @ZA00687*/ 11260000 NI SLOTEXP,B'01111111' 2949 11261000 * ADDSLEXT=OFF; /* INDICATE DELETE @ZA00687*/ 11262000 NI ADDSLEXT,B'11111101' 2950 11263000 * CALL VUEXT; /* GO UPDATE SLOT @ZA00687*/ 11264000 BAL @14,VUEXT 2951 11265000 * IF RPLVRETC^=RCZERO THEN/* CK RETURN @ZA00687*/ 11266000 L @02,RPLVPTR 2952 11267000 CLC RPLVRETC(2,@02),@CB00747 2952 11268000 BE @RF02952 2952 11269000 * DO; /* @ZA00687*/ 11270000 * CALL ERREXIT; /* SAVE RET CODES @ZA00687*/ 11271000 BAL @14,ERREXIT 2954 11272000 * RETURN; /* @ZA00687*/ 11273000 B @EL00047 2955 11274000 * END; /* @ZA00687*/ 11275000 * ADDSLEXT=ON; /* INDICATE ADD @ZA00687*/ 11276000 @RF02952 OI ADDSLEXT,B'00000010' 2957 11277000 * CALL VUEXT; /* GO UPDATE SLOT @ZA00687*/ 11278000 BAL @14,VUEXT 2958 11279000 * IF RPLVRETC^=RCZERO THEN/* CK RETURN @ZA00687*/ 11280000 L @02,RPLVPTR 2959 11281000 CLC RPLVRETC(2,@02),@CB00747 2959 11282000 BE @RF02959 2959 11283000 * DO; /* @ZA00687*/ 11284000 * CALL ERREXIT; /* SAVE RET CODES @ZA00687*/ 11285000 BAL @14,ERREXIT 2961 11286000 * RETURN; /* @ZA00687*/ 11287000 B @EL00047 2962 11288000 * END; /* @ZA00687*/ 11289000 * END; /* @ZA00687*/ 11290000 * END; /* @XM40000*/ 11291000 * ELSE /* #Y30LB26*/ 11292000 * 2966 11293000 * /***********************************************************/ 11294000 * /* */ 11295000 * /* OTHERWISE CHECK IF TO OR FOR SPECIFIED #Y30LB26*/ 11296000 * /* */ 11297000 * /***********************************************************/ 11298000 * 2966 11299000 * DO; /* #Y30LB26*/ 11300000 * 2966 11301000 B @RC02943 2966 11302000 @RF02943 DS 0H 2967 11303000 * /*********************************************************/ 11304000 * /* */ 11305000 * /* IF FOR SPECIFIED, GO CALCULATE EXPIRATION #Y30LB26*/ 11306000 * /* DATE AND PUT IT IN BASE RECORD #Y30LB26*/ 11307000 * /* */ 11308000 * /*********************************************************/ 11309000 * 2967 11310000 * IF MVRFLFOR=ON THEN /* FOR SPECIFIED? #Y30LB26*/ 11311000 L @02,MVRPTR 2967 11312000 TM MVRFLFOR(@02),B'10000000' 2967 11313000 BNO @RF02967 2967 11314000 * DO; /* @Y30LB26*/ 11315000 * FOREXP=MVRFOR; /* SET FOR EXP DATE @Y30LB26*/ 11316000 LH FOREXP,MVRFOR(,@02) 2969 11317000 * CALL VUEXP; /* @Y30LB26*/ 11318000 BAL @14,VUEXP 2970 11319000 * BASEXPDT=RETDATE; /* RET IN BASE REC @Y30LB26*/ 11320000 L @02,BASEVPTR 2971 11321000 MVC BASEXPDT(4,@02),RETDATE 2971 11322000 * END; /* @Y30LB26*/ 11323000 * 2972 11324000 * /*********************************************************/ 11325000 * /* */ 11326000 * /* IF TO WAS SPECIFIED, IF IT EXCEEDS MAXIMUM, @Y30LB26*/ 11327000 * /* PUT IN MAXIMUM DATE, OTHERWISE PUT IN TO DATE @Y30LB26*/ 11328000 * /* */ 11329000 * /*********************************************************/ 11330000 * 2973 11331000 * IF MVRFLTO=ON THEN /* TO SPECIFIED? @Y30LB26*/ 11332000 @RF02967 L @02,MVRPTR 2973 11333000 TM MVRFLTO(@02),B'00001000' 2973 11334000 BNO @RF02973 2973 11335000 * DO; /* @Y30LB26*/ 11336000 * IF MVRTO>MAXDATE THEN/* CHECK DATE? @Y30LB26*/ 11337000 CLC MVRTO(4,@02),MAXDATE 2975 11338000 BNH @RF02975 2975 11339000 * BASEXPDT=MAXDATE; /* SET TO MAX DATE @Y30LB26*/ 11340000 L @02,BASEVPTR 2976 11341000 MVC BASEXPDT(4,@02),MAXDATE 2976 11342000 * ELSE /* @Y30LB26*/ 11343000 * BASEXPDT=MVRTO; /* SET TO GIVEN DATE @Y30LB26*/ 11344000 B @RC02975 2977 11345000 @RF02975 L @02,BASEVPTR 2977 11346000 L @01,MVRPTR 2977 11347000 MVC BASEXPDT(4,@02),MVRTO(@01) 2977 11348000 * END; /* @Y30LB26*/ 11349000 @RC02975 DS 0H 2979 11350000 * END; /* @Y30LB26*/ 11351000 * 2979 11352000 @RF02973 DS 0H 2980 11353000 * /*************************************************************/ 11354000 * /* */ 11355000 * /* CALL ROUTINE TO UPDATE SLOT IN EXTENSION RECORD @Y30LB26*/ 11356000 * /* TO MATCH RETENTION DATE IN BASE VOLUME RECORD @Y30LB26*/ 11357000 * /* */ 11358000 * /*************************************************************/ 11359000 * 2980 11360000 * SLOTEXP=ON; /* INDICATE ONLY EXP @ZA00687*/ 11361000 @RC02943 OI SLOTEXP,B'10000000' 2980 11362000 * CALL VUEXT; /* GO UPDATE SLOT @ZA00687*/ 11363000 BAL @14,VUEXT 2981 11364000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @ZA00687*/ 11365000 L @02,RPLVPTR 2982 11366000 CLC RPLVRETC(2,@02),@CB00747 2982 11367000 BE @RF02982 2982 11368000 * DO; /* @ZA00687*/ 11369000 * CALL ERREXIT; /* SAVE RET CODES @ZA00687*/ 11370000 BAL @14,ERREXIT 2984 11371000 * RETURN; /* @ZA00687*/ 11372000 B @EL00047 2985 11373000 * END; /* @ZA00687*/ 11374000 * END; /* #Y30LB26*/ 11375000 * 2987 11376000 @RF02982 DS 0H 2988 11377000 * /*****************************************************************/ 11378000 * /* */ 11379000 * /* IF NULLIFY DESCRIPTION CALLED FOR, NULLIFY IT #Y30LB26*/ 11380000 * /* */ 11381000 * /*****************************************************************/ 11382000 * 2988 11383000 * IF MVRNDESC=ON THEN /* NULLIFY DEXCRIPTION? #Y30LB26*/ 11384000 @RF02923 L @02,MVRPTR 2988 11385000 TM MVRNDESC(@02),B'00001000' 2988 11386000 BNO @RF02988 2988 11387000 * BASDESCR=BLANK; /* NULLIFT DESCRIP #Y30LB26*/ 11388000 L @02,BASEVPTR 2989 11389000 MVI BASDESCR+1(@02),C' ' 2989 11390000 MVC BASDESCR+2(28,@02),BASDESCR+1(@02) 2989 11391000 MVI BASDESCR(@02),C' ' 2989 11392000 * ELSE /* #Y30LB26*/ 11393000 * 2990 11394000 * /***************************************************************/ 11395000 * /* */ 11396000 * /* OTHERWISE SEE IF NEW DESCRIPTION CALLED FOR #Y30LB26*/ 11397000 * /* */ 11398000 * /***************************************************************/ 11399000 * 2990 11400000 * IF MVRFLDES=ON THEN /* DESCR SPEC? #Y30LB26*/ 11401000 B @RC02988 2990 11402000 @RF02988 L @02,MVRPTR 2990 11403000 TM MVRFLDES(@02),B'00010000' 2990 11404000 BNO @RF02990 2990 11405000 * BASDESCR=MVRDES; /* MODIFY DESCRIPTION @Y30LB26*/ 11406000 * 2991 11407000 L @01,BASEVPTR 2991 11408000 MVC BASDESCR(30,@01),MVRDES(@02) 2991 11409000 * /*****************************************************************/ 11410000 * /* */ 11411000 * /* IF NEW BACKUP NUMBER SPECIFIED, PUT IT IN @Y30LB26*/ 11412000 * /* */ 11413000 * /*****************************************************************/ 11414000 * 2992 11415000 * IF MVRFLBK=ON THEN /* BACKUP SPEC? @Y30LB26*/ 11416000 @RF02990 DS 0H 2992 11417000 @RC02988 L @02,MVRPTR 2992 11418000 TM MVRFLBK(@02),B'00000010' 2992 11419000 BNO @RF02992 2992 11420000 * BASBKLMT=MVRBKUPN; /* SET MAX BACKUPS @Y30LB26*/ 11421000 * 2993 11422000 L @01,BASEVPTR 2993 11423000 MVC BASBKLMT(1,@01),MVRBKUPN(@02) 2993 11424000 * /*****************************************************************/ 11425000 * /* */ 11426000 * /* SET MISMATCH FLAG @Y30LB26*/ 11427000 * /* */ 11428000 * /*****************************************************************/ 11429000 * 2994 11430000 * IF MVRSLMIS=ON THEN /* MISMATCH SPECS @Y30LB26*/ 11431000 @RF02992 L @02,MVRPTR 2994 11432000 TM MVRSLMIS(@02),B'00000010' 2994 11433000 BNO @RF02994 2994 11434000 * BASVSMIS=ON; /* SET MISMATCH FLAG @Y30LB26*/ 11435000 L @02,BASEVPTR 2995 11436000 OI BASVSMIS(@02),B'00100000' 2995 11437000 * ELSE /* @Y30LB26*/ 11438000 * 2996 11439000 * /***************************************************************/ 11440000 * /* */ 11441000 * /* OTHERWISE MIGHT CLEAR MISMATCH FLAG @Y30LB26*/ 11442000 * /* */ 11443000 * /***************************************************************/ 11444000 * 2996 11445000 * IF MVRCLMIS=ON THEN /* CLEAR MISMATCH? @Y30LB26*/ 11446000 B @RC02994 2996 11447000 @RF02994 L @02,MVRPTR 2996 11448000 TM MVRCLMIS(@02),B'00000001' 2996 11449000 BNO @RF02996 2996 11450000 * BASVSMIS=OFF; /* CLEAR MISMATCH FLAG @Y30LB26*/ 11451000 * 2997 11452000 L @02,BASEVPTR 2997 11453000 NI BASVSMIS(@02),B'11011111' 2997 11454000 * /*****************************************************************/ 11455000 * /* */ 11456000 * /* SET NEW VALUE IN RECOVERY VOLUME LABEL AREA @Y30LB26*/ 11457000 * /* OF BASE VOLUME RECORD @Y30LB26*/ 11458000 * /* */ 11459000 * /*****************************************************************/ 11460000 * 2998 11461000 * IF MVRFLLAB=ON THEN /* MVRLABEL SPECIFIED ? @Y30LB26*/ 11462000 @RF02996 DS 0H 2998 11463000 @RC02994 L @02,MVRPTR 2998 11464000 TM MVRFLLAB(@02),B'00000001' 2998 11465000 BNO @RF02998 2998 11466000 * BASRECOV=MVRLABEL; /* SET NEW LABEL @Y30LB26*/ 11467000 * 2999 11468000 L @01,BASEVPTR 2999 11469000 MVC BASRECOV(6,@01),MVRLABEL(@02) 2999 11470000 * /*****************************************************************/ 11471000 * /* */ 11472000 * /* CLEAR INCOMPLETE VOLUME CREATION FLAG @Y30LB26*/ 11473000 * /* */ 11474000 * /*****************************************************************/ 11475000 * 3000 11476000 * IF MVRCIVCF=ON THEN /* CLEAR INCOMPLETE? @Y30LB26*/ 11477000 @RF02998 L @02,MVRPTR 3000 11478000 TM MVRCIVCF(@02),B'10000000' 3000 11479000 BNO @RF03000 3000 11480000 * BASIVCRE=OFF; /* CLEAR INCOM VOL FLAG @Y30LB26*/ 11481000 * 3001 11482000 L @02,BASEVPTR 3001 11483000 NI BASIVCRE(@02),B'01111111' 3001 11484000 * /*****************************************************************/ 11485000 * /* */ 11486000 * /* CLEAR COPY VOLUME FLAG @Y30LB26*/ 11487000 * /* */ 11488000 * /*****************************************************************/ 11489000 * 3002 11490000 * IF MVRCICPY=ON THEN /* CLEAR COPY FLAG? @Y30LB26*/ 11491000 @RF03000 L @02,MVRPTR 3002 11492000 TM MVRCICPY(@02),B'01000000' 3002 11493000 BNO @RF03002 3002 11494000 * BASIVCPY=OFF; /* CLEAR COPY FLAG @Y30LB26*/ 11495000 * 3003 11496000 L @02,BASEVPTR 3003 11497000 NI BASIVCPY(@02),B'10111111' 3003 11498000 * /*****************************************************************/ 11499000 * /* */ 11500000 * /* READ BASE VOLUME RECORD FOR UPDATE SO IT @Y30LB26*/ 11501000 * /* CAN BE WRITTEN @Y30LB26*/ 11502000 * /* */ 11503000 * /*****************************************************************/ 11504000 * 3004 11505000 * RPLVKEY=ADDR(VKEY); /* ADDR OF KEY @Y30LB26*/ 11506000 @RF03002 L @02,RPLVPTR 3004 11507000 LA @15,VKEY 3004 11508000 ST @15,RPLVKEY(,@02) 3004 11509000 * RPLVBUF=ADDR(DUMMYREC); /* DUMMY FILL SPACE @Y30LB26*/ 11510000 LA @15,DUMMYREC 3005 11511000 ST @15,RPLVBUF(,@02) 3005 11512000 * RPLVBLN=LENGTH(BASEV); /* LENGTH OF BUFFER @Y30LB26*/ 11513000 MVC RPLVBLN(4,@02),@CF01147 3006 11514000 * RPLVLOC=OFF; /* NO LOCATE MODE @Y30LB26*/ 11515000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 11516000 OI RPLVDIR(@02),B'01000000' 3008 11517000 NI RPLVLOC(@02),B'01111111' 3008 11518000 * RPLVTYP=RPLVREAD; /* READ REC @Y30LB26*/ 11519000 MVI RPLVTYP(@02),X'00' 3009 11520000 * RPLVUPD=ON; /* FOR UPDATE @Y30LB26*/ 11521000 OI RPLVUPD(@02),B'00000010' 3010 11522000 * RESPECIFY 3011 11523000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 11524000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 11525000 LR REG1,@02 3012 11526000 * CALL ICBVIO00; /* READ BASE FOR UPDATE @Y30LB26*/ 11527000 L @15,@CV00671 3013 11528000 BALR @14,@15 3013 11529000 * RESPECIFY 3014 11530000 * REG1 UNRSTD; /* UNRESTRICT REG1 @Y30LB26*/ 11531000 * IF RPLVRETC^=RCZERO THEN /* CHECK RETURN? @Y30LB26*/ 11532000 L @02,RPLVPTR 3015 11533000 CLC RPLVRETC(2,@02),@CB00747 3015 11534000 BE @RF03015 3015 11535000 * DO; /* @Y30LB26*/ 11536000 * CALL ERREXIT; /* FREE INVENTORY @Y30LB26*/ 11537000 BAL @14,ERREXIT 3017 11538000 * RETURN; /* @Y30LB26*/ 11539000 B @EL00047 3018 11540000 * END; /* @Y30LB26*/ 11541000 * 3019 11542000 * /*****************************************************************/ 11543000 * /* */ 11544000 * /* GET ADDRESS OF UPDATED BASE RECORD AND WRITE IT @Y30LB26*/ 11545000 * /* */ 11546000 * /*****************************************************************/ 11547000 * 3020 11548000 * RPLVBUF=ADDR(STORBASE); /* ADDR UPDATED REC @Y30LB26*/ 11549000 @RF03015 L @02,RPLVPTR 3020 11550000 LA @15,STORBASE 3020 11551000 ST @15,RPLVBUF(,@02) 3020 11552000 * RPLVTYP=RPLVPUT; /* PUT OUT RECORD @Y30LB26*/ 11553000 MVI RPLVTYP(@02),X'01' 3021 11554000 * RESPECIFY 3022 11555000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 11556000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 11557000 LR REG1,@02 3023 11558000 * CALL ICBVIO00; /* WRITE BASE RECORD @Y30LB26*/ 11559000 L @15,@CV00671 3024 11560000 BALR @14,@15 3024 11561000 * RESPECIFY 3025 11562000 * REG1 UNRSTD; /* UNRESTRICT REG1 @Y30LB26*/ 11563000 * IF RPLVRETC^=RCZERO THEN /* CHECK RETURN? @Y30LB26*/ 11564000 L @02,RPLVPTR 3026 11565000 CLC RPLVRETC(2,@02),@CB00747 3026 11566000 BE @RF03026 3026 11567000 * DO; /* @Y30LB26*/ 11568000 * CALL ERREXIT; /* FREE INVENTORY @Y30LB26*/ 11569000 BAL @14,ERREXIT 3028 11570000 * RETURN; /* @Y30LB26*/ 11571000 B @EL00047 3029 11572000 * END; /* @Y30LB26*/ 11573000 * 3030 11574000 * /*****************************************************************/ 11575000 * /* */ 11576000 * /* IF NEVER JOURNALED BEFORE, JOURNAL THE RPLV @Y30LB26*/ 11577000 * /* */ 11578000 * /*****************************************************************/ 11579000 * 3031 11580000 * IF JRNLEDSW=OFF THEN /* JOURNALED BEFORE? @Y30LB26*/ 11581000 @RF03026 TM JRNLEDSW,B'00000001' 3031 11582000 BNZ @RF03031 3031 11583000 * CALL JOURNAL; /* JOURNAL RPLV @Y30LB26*/ 11584000 BAL @14,JOURNAL 3032 11585000 * RETURN; /* @Y30LB26*/ 11586000 B @EL00047 3033 11587000 * END COMMON; /* @Y30LB26*/ 11588000 B @EL00047 3034 11589000 * 3035 11590000 * /*****************************************************************/ 11591000 * /* */ 11592000 * /* THIS ROUTINE JOURNALS THE RPLV AND IS CALLED @Y30LB26*/ 11593000 * /* AFTER THE FIRST SUCCESSFUL UPDATE OF THE INVENTORY @Y30LB26*/ 11594000 * /* DATA SET. IT SETS THE JRNLEDSW ON SO THAT IT WILL @Y30LB26*/ 11595000 * /* NOT BE CALLED AGAIN BY THE SAME FUNCTION @Y30LB26*/ 11596000 * /* */ 11597000 * /*****************************************************************/ 11598000 * 3035 11599000 *JOURNAL: 3035 11600000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 11601000 * 3035 11602000 JOURNAL ST @14,@SA00048 3035 11603000 * /*****************************************************************/ 11604000 * /* */ 11605000 * /* RESERVE THE JOURNAL DATA SET @Y30LB26*/ 11606000 * /* */ 11607000 * /*****************************************************************/ 11608000 * 3036 11609000 * RESPECIFY 3036 11610000 * REG1 RSTD; /* RESTRICT REG1 @Y30LB26*/ 11611000 * RESPECIFY 3037 11612000 * REG0 RSTD; /* RESTRICT REG0 @Y30LB26*/ 11613000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 11614000 L REG1,RPLVPTR 3038 11615000 * REG0=RESEXVJL; /* INDICATE JOURNAL @Y30LB26*/ 11616000 LA REG0,17 3039 11617000 * CALL ICBVRR00; /* RESERVE JOURNAL @Y30LB26*/ 11618000 L @15,@CV00673 3040 11619000 BALR @14,@15 3040 11620000 * RESPECIFY 3041 11621000 * REG0 UNRSTD; /* FREE REG0 @Y30LB26*/ 11622000 * RESPECIFY 3042 11623000 * REG1 UNRSTD; /* FREE REG1 @Y30LB26*/ 11624000 * EXITVJL=ON; /* INDI JOURNAL RESERVED @Y30LB26*/ 11625000 * 3043 11626000 OI EXITVJL,B'00000100' 3043 11627000 * /*****************************************************************/ 11628000 * /* */ 11629000 * /* CALL ROUTINE TO JOURNAL THE RPLV @Y30LB26*/ 11630000 * /* */ 11631000 * /*****************************************************************/ 11632000 * 3044 11633000 * RESPECIFY 3044 11634000 * REG1 RSTD; /* RESTRICT @Y30LB26*/ 11635000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 11636000 L REG1,RPLVPTR 3045 11637000 * CALL ICBVJL00; /* JOURNAL REQUEST BLK @Y30LB26*/ 11638000 L @15,@CV00672 3046 11639000 BALR @14,@15 3046 11640000 * RESPECIFY 3047 11641000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 11642000 * 3047 11643000 * /*****************************************************************/ 11644000 * /* */ 11645000 * /* MAKE IT APPEAR THAT JOURNALING WAS SUCCESSFUL @Y30LB26*/ 11646000 * /* EVEN IF IT WAS NOT @Y30LB26*/ 11647000 * /* SET SWITCH INDICATING IT HAS BEEN JOURNALED @Y30LB26*/ 11648000 * /* */ 11649000 * /*****************************************************************/ 11650000 * 3048 11651000 * RPLVRETC=RCZERO; /* ZERO RETURN @Y30LB26*/ 11652000 L @07,RPLVPTR 3048 11653000 MVC RPLVRETC(2,@07),@CB00747 3048 11654000 * RPLRCODE=RCZERO; /* ZERO REASON CODE @Y30LB26*/ 11655000 MVC RPLRCODE(2,@07),@CB00747 3049 11656000 * JRNLEDSW=ON; /* INDICATE JOURNALED @Y30LB26*/ 11657000 * 3050 11658000 OI JRNLEDSW,B'00000001' 3050 11659000 * /*****************************************************************/ 11660000 * /* */ 11661000 * /* CALL ROUTINE TO RELEASE JOURNAL DATA SET @Y30LB26*/ 11662000 * /* */ 11663000 * /*****************************************************************/ 11664000 * 3051 11665000 * RESPECIFY 3051 11666000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 11667000 * RESPECIFY 3052 11668000 * REG0 RSTD; /* RESTRICT REG 0 @Y30LB26*/ 11669000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 11670000 LR REG1,@07 3053 11671000 * REG0=DEQJRNL; /* INDICATE FREE JOURNAL @Y30LB26*/ 11672000 LA REG0,16 3054 11673000 * CALL ICBVRR00; /* FREE IT @Y30LB26*/ 11674000 L @15,@CV00673 3055 11675000 BALR @14,@15 3055 11676000 * RESPECIFY 3056 11677000 * REG0 UNRSTD; /* FREE REG 0 @Y30LB26*/ 11678000 * RESPECIFY 3057 11679000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 11680000 * EXITVJL=OFF; /* INDI JOURNAL FREED @Y30LB26*/ 11681000 NI EXITVJL,B'11111011' 3058 11682000 * RETURN; /* @Y30LB26*/ 11683000 @EL00048 DS 0H 3059 11684000 @EF00048 DS 0H 3059 11685000 @ER00048 L @14,@SA00048 3059 11686000 BR @14 3059 11687000 * END JOURNAL; /* @Y30LB26*/ 11688000 * 3061 11689000 * /*****************************************************************/ 11690000 * /* */ 11691000 * /* ROUTINE RESERVES THE INVENTORY DATA SET FOR @Y30LB26*/ 11692000 * /* EXCLUSIVE USE @Y30LB26*/ 11693000 * /* */ 11694000 * /*****************************************************************/ 11695000 * 3061 11696000 *RESERINV: 3061 11697000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 11698000 RESERINV ST @14,@SA00049 3061 11699000 * RESPECIFY 3062 11700000 * (REG0, 3062 11701000 * REG1) RSTD; /* RESTRICT REGS @Y30LB26*/ 11702000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 11703000 L REG1,RPLVPTR 3063 11704000 * REG0=RESEXINV; /* @Y30LB26*/ 11705000 LA REG0,1 3064 11706000 * CALL ICBVRR00; /* @Y30LB26*/ 11707000 L @15,@CV00673 3065 11708000 BALR @14,@15 3065 11709000 * RESPECIFY 3066 11710000 * (REG0, 3066 11711000 * REG1) UNRSTD; /* FREE REGS @Y30LB26*/ 11712000 * EXITVVIC=ON; /* @Y30LB26*/ 11713000 OI EXITVVIC,B'00001000' 3067 11714000 * RETURN; /* @Y30LB26*/ 11715000 @EL00049 DS 0H 3068 11716000 @EF00049 DS 0H 3068 11717000 @ER00049 L @14,@SA00049 3068 11718000 BR @14 3068 11719000 * END RESERINV; /* @Y30LB26*/ 11720000 * 3070 11721000 * /*****************************************************************/ 11722000 * /* */ 11723000 * /* ROUTINE ENTERED WHEN AN ERROR OCCURES. FREES JOURNAL @VS32198*/ 11724000 * /* IF JOURNAL IS RESERVED AND SAVES REASON AND RETURN @VS32198*/ 11725000 * /* CODES BEFORE RELEASE AND THEN RESTORES THEM. @VS32198*/ 11726000 * /* */ 11727000 * /*****************************************************************/ 11728000 * 3070 11729000 *ERREXIT: 3070 11730000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 11731000 * 3070 11732000 ERREXIT ST @14,@SA00050 3070 11733000 * /*****************************************************************/ 11734000 * /* */ 11735000 * /* SAVE CODES @Y30LB26*/ 11736000 * /* */ 11737000 * /*****************************************************************/ 11738000 * 3071 11739000 * REACODE=RPLRCODE; /* SAVE REASON CODE @Y30LB26*/ 11740000 L @04,RPLVPTR 3071 11741000 MVC REACODE(2),RPLRCODE(@04) 3071 11742000 * RETCODE=RPLVRETC; /* SAVE RETURN CODE @Y30LB26*/ 11743000 * 3072 11744000 MVC RETCODE(2),RPLVRETC(@04) 3072 11745000 * /*****************************************************************/ 11746000 * /* */ 11747000 * /* SEE IF JOURNAL DATA SET IS RESERVED @Y30LB26*/ 11748000 * /* */ 11749000 * /*****************************************************************/ 11750000 * 3073 11751000 * IF EXITVJL=ON THEN /* THEN JOR NOT RELEASED @Y30LB26*/ 11752000 * 3073 11753000 TM EXITVJL,B'00000100' 3073 11754000 BNO @RF03073 3073 11755000 * /***************************************************************/ 11756000 * /* */ 11757000 * /* FREE JOURNAL DATA SET @Y30LB26*/ 11758000 * /* */ 11759000 * /***************************************************************/ 11760000 * 3074 11761000 * DO; /* RELEASE IT @Y30LB26*/ 11762000 * RESPECIFY 3075 11763000 * REG1 RSTD; /* RESTRICT @Y30LB26*/ 11764000 * RESPECIFY 3076 11765000 * REG0 RSTD; /* RESTRICT @Y30LB26*/ 11766000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 11767000 LR REG1,@04 3077 11768000 * REG0=DEQJRNL; /* SET REG0 TO FREE JRNL @Y30LB26*/ 11769000 LA REG0,16 3078 11770000 * CALL ICBVRR00; /* CALL RESERVE RELEASE @Y30LB26*/ 11771000 L @15,@CV00673 3079 11772000 BALR @14,@15 3079 11773000 * RESPECIFY 3080 11774000 * REG0 UNRSTD; /* FREE @Y30LB26*/ 11775000 * RESPECIFY 3081 11776000 * REG1 UNRSTD; /* FREE @Y30LB26*/ 11777000 * 3081 11778000 * /*************************************************************/ 11779000 * /* */ 11780000 * /* RESTORE REASON AND RETURN VALUES @Y30LB26*/ 11781000 * /* */ 11782000 * /*************************************************************/ 11783000 * 3082 11784000 * RPLRCODE=REACODE; /* AND RETURN CODES @Y30LB26*/ 11785000 L @04,RPLVPTR 3082 11786000 MVC RPLRCODE(2,@04),REACODE 3082 11787000 * RPLVRETC=RETCODE; /* OTHERWISE RETURN @Y30LB26*/ 11788000 MVC RPLVRETC(2,@04),RETCODE 3083 11789000 * END; /* @Y30LB26*/ 11790000 * RETURN; /* RETURN TO CALLER @Y30LB26*/ 11791000 @EL00050 DS 0H 3085 11792000 @EF00050 DS 0H 3085 11793000 @ER00050 L @14,@SA00050 3085 11794000 BR @14 3085 11795000 * END ERREXIT; /* @Y30LB26*/ 11796000 B @EL00050 3086 11797000 * 3087 11798000 */* START OF SPECIFICATIONS **** 3087 11799000 * 3087 11800000 * PROCEDURE NAME - ICBVUDBR @Y30LB26 11801000 * 3087 11802000 * FUNCTION - TAKES THE DUPLICATE VOLUME RECORD AND MAKES IT INTO A 11803000 * NEW BASE VOLUME RECORD. IT USES THE CSN'S AND LIBID'S 3087 11804000 * FROM THE DUPLICATE VOLUME RECORD TO FILL IN CORRESPONDING 3087 11805000 * FIELDS OF THE NEW BASE VOLUME RECORD. IT ALSO READS THE CARTRIDGE 11806000 * INDEX RECORDS AND UPDATES THE KEY OF THE VOLUME THE CARTRIDGE 3087 11807000 * BELONGS TO. IF THE ORIGINAL BASE VOLUME RECORD WAS GROUPED, THE 11808000 * EXTERNAL PROCEDURE ICBVUCHI MUST BE CALLED AFTER THIS ROUTINE 3087 11809000 * RETURNS CONTROL TO THE CALLER, TO CHAIN THE NEW BASE 3087 11810000 * VOLUME RECORD INTO THE NON-GROUPED CHAIN. THIS CHAIN-IN ROUTINE 11811000 * ALSO INCREASES THE VOLUME COUNT BY ONE IN THE NON-GROUPED VOLUME 11812000 * HEADER RECORD. IF THE 3087 11813000 * ORIGINAL BASE VOLUME RECORD WAS NON-GROUPED, THE ROUTINE KEEPS 11814000 * THE PREVIOUS AND NEXT BASE VOLUME ID AND ALSO IF THE VOLUME WAS 11815000 * FIRST OR LAST IN THE CHAIN, AND SETS THESE FIELDS AND BITS UP IN 11816000 * THE NEW BASE VOLUME RECORD. THIS IS TO KEEP FROM HAVING TO CHAIN 11817000 * THE OLD VOLUME OUT OF THE NON-GROUPED CHAIN AND THEN CHAINING THE 11818000 * NEW VOLUME BACK IN. THE ROUTINE THEN DELETES THE DUPLICATE VOLUME 11819000 * RECORD, WRITES THE NEW BASE VOLUME RECORD AND THE CARTRIDGE 3087 11820000 * INDEX RECORDS. @Y30LB26 11821000 * 3087 11822000 * INPUT - A PARAMETER LIST CONTAINING THE ADDRESS OF THE DUPLICATE 11823000 * RECORD, THE ADDRESS OF THE RPLV, FLAG BYTES, AND OPTIONALLY THE 11824000 * VOLID OF PREVIOUS RECORD, AND THE VOLID OF THE NEXT RECORD. 3087 11825000 * THE FLAG BYTE TELLS IF THE VOLID OF THE PREVIOUS AND 3087 11826000 * AND THE VOLID OF THE NEXT RECORD IS SPECIFIED, AND IF THE 3087 11827000 * OLD BASE WAS FIRST OR LAST IN CHAIN. @Y30LB26 11828000 * 3087 11829000 * OUTPUT - ADDRESS OF CREATED BASE VOL REC RETURNED @Y30LB26 11830000 * IN PARM FIELD. @Y30LB26 11831000 * REASON AND CONDITION CODES RETURNED IN RPLV. @Y30LB26 11832000 * THE ONLY REASON CODES RETURNED BY THIS PROCEDURE WILL @Y30LB26 11833000 * BE THE I/O PROCESSOR AND THE JOURNAL REASON CODES. @Y30LB26 11834000 **** END OF SPECIFICATIONS ** */ 11835000 * 3087 11836000 *ICBVUDBR: 3087 11837000 * ENTRY(DUPVDBR,BASEVDBR,RPLVDBR,FLAGDBR,/* @Y30LB26*/ 11838000 * SPREVDBR,SNEXTDBR); /* @Y30LB26*/ 11839000 @EP03087 MVC @PC00001(24),0(@01) 3087 11840000 * DCL 3088 11841000 * DUPVDBR PTR(31); /* PTR TO DUP REC #Y30LB26*/ 11842000 * DCL 3089 11843000 * BASEVDBR PTR(31); /* RETURNED PTR BASE REC @Y30LB26*/ 11844000 * DCL 3090 11845000 * RPLVDBR PTR(31); /* PTR TO RPLV #Y30LB26*/ 11846000 * DCL 3091 11847000 * FLAGDBR BIT(16); /* INDICATOR FLAGS @Y30LB26*/ 11848000 * DCL 3092 11849000 * SPREVDBR CHAR(6); /* SAVE PREV VOLID #Y30LB26*/ 11850000 * DCL 3093 11851000 * SNEXTDBR CHAR(6); /* SAVE NEXT VOLID #Y30LB26*/ 11852000 * 3094 11853000 * /*****************************************************************/ 11854000 * /* */ 11855000 * /* SET UP VALUES IN PROGRAM AS THEY WERE PASSED #Y30LB26*/ 11856000 * /* */ 11857000 * /*****************************************************************/ 11858000 * 3094 11859000 * DUPVPTR=DUPVDBR; /* SET EQUAL TO PASSED #Y30LB26*/ 11860000 L @02,@PC00001 3094 11861000 L @02,DUPVDBR(,@02) 3094 11862000 ST @02,DUPVPTR 3094 11863000 * RPLVPTR=RPLVDBR; /* ADDR OF RPLV #Y30LB26*/ 11864000 L @02,@PC00001+8 3095 11865000 L @02,RPLVDBR(,@02) 3095 11866000 ST @02,RPLVPTR 3095 11867000 * PASSFLAG=FLAGDBR; /* INDICATOR FLAGS #Y30LB26*/ 11868000 L @02,@PC00001+12 3096 11869000 MVC PASSFLAG(2),FLAGDBR(@02) 3096 11870000 * SAVEPREV=SPREVDBR; /* SET PREV VOLID #Y30LB26*/ 11871000 L @02,@PC00001+16 3097 11872000 MVC SAVEPREV(6),SPREVDBR(@02) 3097 11873000 * SAVENEXT=SNEXTDBR; /* SET NEXT VOLID #Y30LB26*/ 11874000 L @02,@PC00001+20 3098 11875000 MVC SAVENEXT(6),SNEXTDBR(@02) 3098 11876000 * CALL VUDBR; /* CALL INTERNAL PROC @Y30LB26*/ 11877000 BAL @14,VUDBR 3099 11878000 * BASEVDBR=BASEVPTR; /* GET ADDR OF BASE REC @Y30LB26*/ 11879000 L @02,@PC00001+4 3100 11880000 L @15,BASEVPTR 3100 11881000 ST @15,BASEVDBR(,@02) 3100 11882000 * RETURN; /* @Y30LB26*/ 11883000 B @EL00001 3101 11884000 * 3102 11885000 * /*****************************************************************/ 11886000 * /* */ 11887000 * /* PROCEDURE VUDBR IS CODED SO THAT CODE CONTAINED IN @Y30LB26*/ 11888000 * /* ENTRY ICBVUDBR CAN BE USED BY BOTH THIS MODULE AND BY @Y30LB26*/ 11889000 * /* OTHER MODULES @Y30LB26*/ 11890000 * /* */ 11891000 * /*****************************************************************/ 11892000 * 3102 11893000 *VUDBR: 3102 11894000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 11895000 VUDBR ST @14,@SA00051 3102 11896000 * BASEREC=BASEREC&&BASEREC; /* ZERO BASE BUFFER @Y30LB26*/ 11897000 XC BASEREC(224),BASEREC 3103 11898000 * BASEVPTR=ADDR(BASEREC); /* ADDRESSING TO BASE #Y30LB26*/ 11899000 LA @02,BASEREC 3104 11900000 ST @02,BASEVPTR 3104 11901000 * VOLKY=DUPSERNO; /* MOVE VOLID TO KEY #Y30LB26*/ 11902000 L @15,DUPVPTR 3105 11903000 MVC VOLKY(6),DUPSERNO(@15) 3105 11904000 * VBLKKY=BLANK; /* BLANK PART OF KEY @Y30LB26*/ 11905000 MVI VBLKKY,C' ' 3106 11906000 * VIDKY=FIXZERO; /* MAKE SURE ID ZERO #Y30LB26*/ 11907000 MVI VIDKY,X'00' 3107 11908000 * BASNAME=VKEY; /* MOVE KEY TO RECORD #Y30LB26*/ 11909000 MVC BASNAME(13,@02),VKEY 3108 11910000 * BASBASVR=ON; /* INDICATE BASE VOL #Y301B26*/ 11911000 OI BASBASVR(@02),B'00100000' 3109 11912000 * BASINAC=ON; /* INACTIVE @Y301B26*/ 11913000 OI BASINAC(@02),B'00000100' 3110 11914000 * BASCSN1=DUPCSN1; /* GET FIRST CARTRIDGE @Y30LB26*/ 11915000 MVC BASCSN1(12,@02),DUPCSN1(@15) 3111 11916000 * BASLIB1=DUPLIB1; /* LIB ID FIRST CSN @Y30LB26*/ 11917000 MVC BASLIB1(1,@02),DUPLIB1(@15) 3112 11918000 * BASCSN2=DUPCSN2; /* GET SECOND CARTRIDGE @Y30LB26*/ 11919000 MVC BASCSN2(12,@02),DUPCSN2(@15) 3113 11920000 * BASLIB2=DUPLIB2; /* LIB ID SECOND CSN @Y30LB26*/ 11921000 MVC BASLIB2(1,@02),DUPLIB2(@15) 3114 11922000 * BASBKLMT=ONE; /* SET BACKUP LIMIT @Y30LB26*/ 11923000 MVI BASBKLMT(@02),X'01' 3115 11924000 * BASFRESP=FIXF; /* ZERO FREE SPACE @Y30LB26*/ 11925000 L @14,FIXF 3116 11926000 STH @14,BASFRESP(,@02) 3116 11927000 * BASLEXT=FIXF; /* ZERO LARGEST EXTENT @Y30LB26*/ 11928000 STH @14,BASLEXT(,@02) 3117 11929000 * BASFREXT=FIXF; /* ZERO FREE EXTENTS @Y30LB26*/ 11930000 ST @14,BASFREXT(,@02) 3118 11931000 * BASDLSF=ON; /* INDIC SPACE DOWN LVEL @Y30LB26*/ 11932000 OI BASDLSF(@02),B'10000000' 3119 11933000 * BASPREV=BLANK; /* PREVIOUS VOL ID @Y30LB26*/ 11934000 MVI BASPREV+1(@02),C' ' 3120 11935000 MVC BASPREV+2(4,@02),BASPREV+1(@02) 3120 11936000 MVI BASPREV(@02),C' ' 3120 11937000 * BASNEXTV=BLANK; /* NEXT VOL ID @Y30LB26*/ 11938000 MVI BASNEXTV+1(@02),C' ' 3121 11939000 MVC BASNEXTV+2(4,@02),BASNEXTV+1(@02) 3121 11940000 MVI BASNEXTV(@02),C' ' 3121 11941000 * BASKLCPY=BLANK; /* KEY LATEST COPY @Y30LB26*/ 11942000 MVI BASKLCPY+1(@02),C' ' 3122 11943000 MVC BASKLCPY+2(11,@02),BASKLCPY+1(@02) 3122 11944000 MVI BASKLCPY(@02),C' ' 3122 11945000 * BASEXPDT=NULEXPDT; /* NULLIFY EXPIRATION @Y30LB26*/ 11946000 MVC BASEXPDT(4,@02),NULEXPDT 3123 11947000 * BASDTREM=BLANK; /* DATE VOL REMOVED @Y30LB26*/ 11948000 MVI BASDTREM+1(@02),C' ' 3124 11949000 MVC BASDTREM+2(2,@02),BASDTREM+1(@02) 3124 11950000 MVI BASDTREM(@02),C' ' 3124 11951000 * BASDESCR=BLANK; /* DESCRIPTION @Y30LB26*/ 11952000 MVI BASDESCR+1(@02),C' ' 3125 11953000 MVC BASDESCR+2(28,@02),BASDESCR+1(@02) 3125 11954000 MVI BASDESCR(@02),C' ' 3125 11955000 * BASOWNER=BLANK; /* OWNER @Y30LB26*/ 11956000 MVI BASOWNER+1(@02),C' ' 3126 11957000 MVC BASOWNER+2(8,@02),BASOWNER+1(@02) 3126 11958000 MVI BASOWNER(@02),C' ' 3126 11959000 * BASDEST=BLANK; /* DESTINATION AFTER EJT @Y30LB26*/ 11960000 MVI BASDEST+1(@02),C' ' 3127 11961000 MVC BASDEST+2(28,@02),BASDEST+1(@02) 3127 11962000 MVI BASDEST(@02),C' ' 3127 11963000 * BASRECOV=BLANK; /* RECOVERY SER NO @Y30LB26*/ 11964000 MVI BASRECOV+1(@02),C' ' 3128 11965000 MVC BASRECOV+2(4,@02),BASRECOV+1(@02) 3128 11966000 MVI BASRECOV(@02),C' ' 3128 11967000 * BASGROUP=BLANK; /* GROUP NAME @Y30LB26*/ 11968000 MVI BASGROUP+1(@02),C' ' 3129 11969000 MVC BASGROUP+2(6,@02),BASGROUP+1(@02) 3129 11970000 MVI BASGROUP(@02),C' ' 3129 11971000 * 3130 11972000 * /*****************************************************************/ 11973000 * /* */ 11974000 * /* GET AND UPDATE THE CARTRIDGE INDEX RECORDS ASSIGNED #Y30LB26*/ 11975000 * /* TO THE DUPLICATE RECORD #Y30LB26*/ 11976000 * /* */ 11977000 * /*****************************************************************/ 11978000 * 3130 11979000 * CARTKY=DUPCSN1; /* GET CART SERIAL NO #Y30LB26*/ 11980000 MVC CARTKY(12),DUPCSN1(@15) 3130 11981000 * RPLVKEY=ADDR(IKEY); /* ADDR OF KEY #Y30LB26*/ 11982000 L @02,RPLVPTR 3131 11983000 LA @15,IKEY 3131 11984000 ST @15,RPLVKEY(,@02) 3131 11985000 * RPLVBUF=ADDR(STORINDX); /* BUFFER ADDR #Y30LB26*/ 11986000 LA @15,STORINDX 3132 11987000 ST @15,RPLVBUF(,@02) 3132 11988000 * RPLVBLN=LENGTH(STORINDX); /* LENGTH BUFFER #Y30LB26*/ 11989000 MVC RPLVBLN(4,@02),@CF01147 3133 11990000 * RPLVLOC=OFF; /* NO LOCATE #Y30LB26*/ 11991000 * RPLVDIR=ON; /* READ DIRECT #Y30LB26*/ 11992000 OI RPLVDIR(@02),B'01000000' 3135 11993000 NI RPLVLOC(@02),B'01111111' 3135 11994000 * RPLVTYP=RPLVREAD; /* READ RECORD #Y30LB26*/ 11995000 MVI RPLVTYP(@02),X'00' 3136 11996000 * RPLVKGE=OFF; /* NOT > OR = #Y30LB26*/ 11997000 NI RPLVKGE(@02),B'11111011' 3137 11998000 * RPLVUPD=ON; /* FOR UPDATE #Y30LB26*/ 11999000 OI RPLVUPD(@02),B'00000010' 3138 12000000 * RESPECIFY 3139 12001000 * REG1 RSTD; /* RESTRICT #Y30LB26*/ 12002000 * REG1=RPLVPTR; /* ADDR OF RPLV #Y30LB26*/ 12003000 LR REG1,@02 3140 12004000 * CALL ICBVIO00; /* READ FIRST CART #Y30LB26*/ 12005000 L @15,@CV00671 3141 12006000 BALR @14,@15 3141 12007000 * RESPECIFY 3142 12008000 * REG1 UNRSTD; /* FREE #Y30LB26*/ 12009000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN #Y30LB26*/ 12010000 L @02,RPLVPTR 3143 12011000 CLC RPLVRETC(2,@02),@CB00747 3143 12012000 BE @RF03143 3143 12013000 * DO; /* #Y30LB26*/ 12014000 * CALL ERREXIT; /* SAVE RET #Y30LB26*/ 12015000 BAL @14,ERREXIT 3145 12016000 * RETURN; /* #Y30LB26*/ 12017000 @EL00051 DS 0H 3146 12018000 @EF00051 DS 0H 3146 12019000 @ER00051 L @14,@SA00051 3146 12020000 BR @14 3146 12021000 * END; /* #Y30LB26*/ 12022000 * 3147 12023000 * /*****************************************************************/ 12024000 * /* */ 12025000 * /* SET UP ADDRESSABILITY TO INDEX RECORD #Y30LB26*/ 12026000 * /* */ 12027000 * /*****************************************************************/ 12028000 * 3148 12029000 * INDEXPTR=ADDR(STORINDX); /* #Y30LB26*/ 12030000 @RF03143 LA INDEXPTR,STORINDX 3148 12031000 * INDRECKY=BASNAME; /* PUT NEW OWNER IN #Y30LB26*/ 12032000 * 3149 12033000 L @06,BASEVPTR 3149 12034000 MVC INDRECKY(13,INDEXPTR),BASNAME(@06) 3149 12035000 * /*****************************************************************/ 12036000 * /* */ 12037000 * /* WRITE UPDATED INDEX RECORD #Y30LB26*/ 12038000 * /* */ 12039000 * /*****************************************************************/ 12040000 * 3150 12041000 * RPLVTYP=RPLVPUT; /* INDICATE PUT #Y30LB26*/ 12042000 L @02,RPLVPTR 3150 12043000 MVI RPLVTYP(@02),X'01' 3150 12044000 * RESPECIFY 3151 12045000 * REG1 RSTD; /* RESTRICT REG 1 #Y30LB26*/ 12046000 * REG1=RPLVPTR; /* ADDR OF RPLV #Y30LB26*/ 12047000 LR REG1,@02 3152 12048000 * CALL ICBVIO00; /* WRITE INDEX REC #Y30LB26*/ 12049000 L @15,@CV00671 3153 12050000 BALR @14,@15 3153 12051000 * RESPECIFY 3154 12052000 * REG1 UNRSTD; /* FREE #Y30LB26*/ 12053000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN #Y30LB26*/ 12054000 L @02,RPLVPTR 3155 12055000 CLC RPLVRETC(2,@02),@CB00747 3155 12056000 BE @RF03155 3155 12057000 * DO; /* #Y30LB26*/ 12058000 * CALL ERREXIT; /* SAVE RET CODES #Y30LB26*/ 12059000 BAL @14,ERREXIT 3157 12060000 * RETURN; /* #Y30LB26*/ 12061000 B @EL00051 3158 12062000 * END; /* #Y30LB26*/ 12063000 * 3159 12064000 * /*****************************************************************/ 12065000 * /* */ 12066000 * /* IF NOT JOURNALED BEFORE THEN GO JOURNAL THE RPLV #Y30LB26*/ 12067000 * /* */ 12068000 * /*****************************************************************/ 12069000 * 3160 12070000 * IF JRNLEDSW=OFF THEN /* JOURNALED BEFORE ? #Y30LB26*/ 12071000 @RF03155 TM JRNLEDSW,B'00000001' 3160 12072000 BNZ @RF03160 3160 12073000 * DO; /* #Y30LB26*/ 12074000 * CALL JOURNAL; /* JOURNAL RPLV #Y30LB26*/ 12075000 BAL @14,JOURNAL 3162 12076000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN #Y30LB26*/ 12077000 L @02,RPLVPTR 3163 12078000 CLC RPLVRETC(2,@02),@CB00747 3163 12079000 BNE @RT03163 3163 12080000 * RETURN; /* #Y30LB26*/ 12081000 * END; /* #Y30LB26*/ 12082000 * 3165 12083000 * /*****************************************************************/ 12084000 * /* */ 12085000 * /* DO THE SAME THING WITH THE SECOND CARTRIDGE #Y30LB26*/ 12086000 * /* */ 12087000 * /*****************************************************************/ 12088000 * 3166 12089000 * CARTKY=DUPCSN2; /* GET CART SERIAL NO #Y30LB26*/ 12090000 @RF03160 L @02,DUPVPTR 3166 12091000 MVC CARTKY(12),DUPCSN2(@02) 3166 12092000 * RPLVKEY=ADDR(IKEY); /* ADDR OF KEY #Y30LB26*/ 12093000 L @02,RPLVPTR 3167 12094000 LA @15,IKEY 3167 12095000 ST @15,RPLVKEY(,@02) 3167 12096000 * RPLVBUF=ADDR(STORINDX); /* BUFFER ADDR #Y30LB26*/ 12097000 LA @15,STORINDX 3168 12098000 ST @15,RPLVBUF(,@02) 3168 12099000 * RPLVBLN=LENGTH(STORINDX); /* LENGTH BUFFER #Y30LB26*/ 12100000 MVC RPLVBLN(4,@02),@CF01147 3169 12101000 * RPLVDIR=ON; /* READ DIRECT #Y30LB26*/ 12102000 OI RPLVDIR(@02),B'01000000' 3170 12103000 * RPLVTYP=RPLVREAD; /* READ RECORD #Y30LB26*/ 12104000 MVI RPLVTYP(@02),X'00' 3171 12105000 * RPLVUPD=ON; /* FOR UPDATE #Y30LB26*/ 12106000 OI RPLVUPD(@02),B'00000010' 3172 12107000 * RESPECIFY 3173 12108000 * REG1 RSTD; /* RESTRICT #Y30LB26*/ 12109000 * REG1=RPLVPTR; /* ADDR OF RPLV #Y30LB26*/ 12110000 LR REG1,@02 3174 12111000 * CALL ICBVIO00; /* READ FIRST CART #Y30LB26*/ 12112000 L @15,@CV00671 3175 12113000 BALR @14,@15 3175 12114000 * RESPECIFY 3176 12115000 * REG1 UNRSTD; /* FREE #Y30LB26*/ 12116000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN #Y30LB26*/ 12117000 L @02,RPLVPTR 3177 12118000 CLC RPLVRETC(2,@02),@CB00747 3177 12119000 BE @RF03177 3177 12120000 * DO; /* #Y30LB26*/ 12121000 * CALL ERREXIT; /* SAVE RET #Y30LB26*/ 12122000 BAL @14,ERREXIT 3179 12123000 * RETURN; /* #Y30LB26*/ 12124000 B @EL00051 3180 12125000 * END; /* #Y30LB26*/ 12126000 * 3181 12127000 * /*****************************************************************/ 12128000 * /* */ 12129000 * /* SET UP ADDRESSABILITY TO INDEX RECORD @Y30LB26*/ 12130000 * /* */ 12131000 * /*****************************************************************/ 12132000 * 3182 12133000 * INDEXPTR=ADDR(STORINDX); /* @Y30LB26*/ 12134000 @RF03177 LA INDEXPTR,STORINDX 3182 12135000 * INDRECKY=BASNAME; /* PUT NEW OWNER IN @Y30LB26*/ 12136000 * 3183 12137000 L @06,BASEVPTR 3183 12138000 MVC INDRECKY(13,INDEXPTR),BASNAME(@06) 3183 12139000 * /*****************************************************************/ 12140000 * /* */ 12141000 * /* WRITE UPDATED INDEX RECORD @Y30LB26*/ 12142000 * /* */ 12143000 * /*****************************************************************/ 12144000 * 3184 12145000 * RPLVTYP=RPLVPUT; /* INDICATE PUT @Y30LB26*/ 12146000 L @02,RPLVPTR 3184 12147000 MVI RPLVTYP(@02),X'01' 3184 12148000 * RESPECIFY 3185 12149000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 12150000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 12151000 LR REG1,@02 3186 12152000 * CALL ICBVIO00; /* WRITE INDEX REC @Y30LB26*/ 12153000 L @15,@CV00671 3187 12154000 BALR @14,@15 3187 12155000 * RESPECIFY 3188 12156000 * REG1 UNRSTD; /* FREE @Y30LB26*/ 12157000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN #Y30LB26*/ 12158000 L @02,RPLVPTR 3189 12159000 CLC RPLVRETC(2,@02),@CB00747 3189 12160000 BE @RF03189 3189 12161000 * DO; /* #Y30LB26*/ 12162000 * CALL ERREXIT; /* SAVE RET CODES #Y30LB26*/ 12163000 BAL @14,ERREXIT 3191 12164000 * RETURN; /* #Y30LB26*/ 12165000 B @EL00051 3192 12166000 * END; /* #Y30LB26*/ 12167000 * 3193 12168000 * /*****************************************************************/ 12169000 * /* */ 12170000 * /* SCRATCH THE DUPLICATE RECORD THAT WAS CONVERTED INTO #Y30LB26*/ 12171000 * /* A BASE. #Y30LB26*/ 12172000 * /* */ 12173000 * /*****************************************************************/ 12174000 * 3194 12175000 * DKEY=DUPNAME; /* DUP KEY #Y30LB26*/ 12176000 @RF03189 L @02,DUPVPTR 3194 12177000 MVC DKEY(13),DUPNAME(@02) 3194 12178000 * RPLVKEY=ADDR(DKEY); /* ADDR OF KEY #Y30LB26*/ 12179000 L @02,RPLVPTR 3195 12180000 LA @15,DKEY 3195 12181000 ST @15,RPLVKEY(,@02) 3195 12182000 * RPLVBUF=ADDR(DUMMYREC); /* DUMMY BUFFER #Y30LB26*/ 12183000 LA @15,DUMMYREC 3196 12184000 ST @15,RPLVBUF(,@02) 3196 12185000 * RPLVBLN=LENGTH(DUMMYREC); /* LENGTH BUFFER #Y30LB26*/ 12186000 MVC RPLVBLN(4,@02),@CF01147 3197 12187000 * RPLVDIR=ON; /* READ DIRECT #Y30LB26*/ 12188000 OI RPLVDIR(@02),B'01000000' 3198 12189000 * RPLVTYP=RPLVREAD; /* DO A READ #Y30LB26*/ 12190000 MVI RPLVTYP(@02),X'00' 3199 12191000 * RPLVUPD=ON; /* READ FOR UPDATE #Y30LB26*/ 12192000 OI RPLVUPD(@02),B'00000010' 3200 12193000 * RESPECIFY 3201 12194000 * REG1 RSTD; /* RESTRICT #Y30LB26*/ 12195000 * REG1=RPLVPTR; /* ADDR OF RPLV #Y30LB26*/ 12196000 LR REG1,@02 3202 12197000 * CALL ICBVIO00; /* READ DUP RECORD #Y30LB26*/ 12198000 L @15,@CV00671 3203 12199000 BALR @14,@15 3203 12200000 * RESPECIFY 3204 12201000 * REG1 UNRSTD; /* FREE #Y30LB26*/ 12202000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN #Y30LB26*/ 12203000 L @02,RPLVPTR 3205 12204000 CLC RPLVRETC(2,@02),@CB00747 3205 12205000 BE @RF03205 3205 12206000 * DO; /* @Y30LB26*/ 12207000 * CALL ERREXIT; /* SAVE RET @Y30LB26*/ 12208000 BAL @14,ERREXIT 3207 12209000 * RETURN; /* @Y30LB26*/ 12210000 B @EL00051 3208 12211000 * END; /* @Y30LB26*/ 12212000 * 3209 12213000 * /*****************************************************************/ 12214000 * /* */ 12215000 * /* NOW DELETE DUP RECORD @Y30LB26*/ 12216000 * /* */ 12217000 * /*****************************************************************/ 12218000 * 3210 12219000 * RPLVTYP=RPLVDEL; /* INDICATE DELETE @Y30LB26*/ 12220000 @RF03205 L @02,RPLVPTR 3210 12221000 MVI RPLVTYP(@02),X'05' 3210 12222000 * RESPECIFY 3211 12223000 * REG1 RSTD; /* RESTRICT @Y30LB26*/ 12224000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 12225000 LR REG1,@02 3212 12226000 * CALL ICBVIO00; /* DELETE DUP RECORD @Y30LB26*/ 12227000 L @15,@CV00671 3213 12228000 BALR @14,@15 3213 12229000 * RESPECIFY 3214 12230000 * REG1 UNRSTD; /* FREE @Y30LB26*/ 12231000 * IF RPLVRETC^=RCZERO THEN /* CK RETURN @Y30LB26*/ 12232000 L @02,RPLVPTR 3215 12233000 CLC RPLVRETC(2,@02),@CB00747 3215 12234000 BE @RF03215 3215 12235000 * DO; /* @Y30LB26*/ 12236000 * CALL ERREXIT; /* SAVE RET #Y30LB26*/ 12237000 BAL @14,ERREXIT 3217 12238000 * RETURN; /* #Y30LB26*/ 12239000 B @EL00051 3218 12240000 * END; /* #Y30LB26*/ 12241000 * 3219 12242000 * /*****************************************************************/ 12243000 * /* */ 12244000 * /* IF NOT CHAINING INTO NON-GROUPED, SET REQUIRED @Y30LB26*/ 12245000 * /* VALUES IN BASE VOL RECORD @Y30LB26*/ 12246000 * /* */ 12247000 * /*****************************************************************/ 12248000 * 3220 12249000 * IF DUPBCHI=OFF THEN /* ALREADY NON-GROUPED @Y30LB26*/ 12250000 @RF03215 TM DUPBCHI,B'10000000' 3220 12251000 BNZ @RF03220 3220 12252000 * DO; /* @Y30LB26*/ 12253000 * 3221 12254000 * /*************************************************************/ 12255000 * /* */ 12256000 * /* CHECK AND SET FIRST AND LAST BITS ON @Y30LB26*/ 12257000 * /* IN NEW BASE VOL RECORD IF REQUIRED @Y30LB26*/ 12258000 * /* */ 12259000 * /*************************************************************/ 12260000 * 3222 12261000 * IF FCHNDBR=ON THEN /* WAS OLD BASE 1ST? @Y30LB26*/ 12262000 TM FCHNDBR,B'01000000' 3222 12263000 BNO @RF03222 3222 12264000 * BASFIRST=ON; /* INDICATE IT IS 1ST @Y30LB26*/ 12265000 L @02,BASEVPTR 3223 12266000 OI BASFIRST(@02),B'00010000' 3223 12267000 * IF LCHNDBR=ON THEN /* LAST IN CHAIN ? @Y30LB26*/ 12268000 @RF03222 TM LCHNDBR,B'00100000' 3224 12269000 BNO @RF03224 3224 12270000 * BASLAST=ON; /* INDICATE LAST @Y30LB26*/ 12271000 * 3225 12272000 L @02,BASEVPTR 3225 12273000 OI BASLAST(@02),B'00001000' 3225 12274000 * /*************************************************************/ 12275000 * /* */ 12276000 * /* SET FORWARD AND BACKWARD CHAIN POINTERS @Y30LB26*/ 12277000 * /* */ 12278000 * /*************************************************************/ 12279000 * 3226 12280000 * BASPREV=SAVEPREV; /* PUT IN PREV VOL @Y30LB26*/ 12281000 @RF03224 L @02,BASEVPTR 3226 12282000 MVC BASPREV(6,@02),SAVEPREV 3226 12283000 * BASNEXTV=SAVENEXT; /* PUT IN NEXT VOL @Y30LB26*/ 12284000 MVC BASNEXTV(6,@02),SAVENEXT 3227 12285000 * END; /* @Y30LB26*/ 12286000 * 3228 12287000 * /*****************************************************************/ 12288000 * /* */ 12289000 * /* SET GOOD RETURN CODES @Y30LB26*/ 12290000 * /* */ 12291000 * /*****************************************************************/ 12292000 * 3229 12293000 * RPLVRETC=RCZERO; /* @Y30LB26*/ 12294000 @RF03220 L @02,RPLVPTR 3229 12295000 MVC RPLVRETC(2,@02),@CB00747 3229 12296000 * RPLRCODE=RCZERO; /* @Y30LB26*/ 12297000 MVC RPLRCODE(2,@02),@CB00747 3230 12298000 * RETURN; /* @Y301B26*/ 12299000 B @EL00051 3231 12300000 * END VUDBR; /* @Y30LB26*/ 12301000 B @EL00051 3232 12302000 * 3233 12303000 */* START OF SPECIFICATIONS **** 3233 12304000 * 3233 12305000 * PROCEDURE NAME - ICBVUEXT @Y30LB26 12306000 * 3233 12307000 * FUNCTION - READS A GROUPED VOLUME SERIAL NUMBER EXTENSION RECORD 12308000 * AND EITHER ADDS OR DELETES A SLOT FOR A GIVEN BASE VOLUME RECORD. 12309000 * IT WILL ALSO UPDATE THE RETENTION PERIOD IN AN EXISTING SLOT. 3233 12310000 * WHEN ADDING A SLOT, THE NEW SLOT ALWAYS GOES AT THE END OF THE 12311000 * FIRST EXTENSION RECORD THAT IS NOT FULL. 3233 12312000 * IT TAKES INFORMATION FROM THE 3233 12313000 * BASE VOLUME RECORD AND PUTS IT IN THE SLOT OF THE EXTENSION 3233 12314000 * RECORD. IF NO SLOT IS AVAILABLE, IT LOOKS FOR THE NEXT EXTENSION 12315000 * RECORD. IF ONE DOES NOT EXIST, IT CREATES THE NEXT ONE. WHEN 12316000 * DELETING A SLOT, ALL SLOTS ARE READ UNTIL ONE MATCHING THE 3233 12317000 * VOLUME CONCERNED IS FOUND. THE REMAINING SLOTS ARE THEN SHIFTED 12318000 * ONE POSITION OVERLAYING THE DELETED SLOT. THEN THE SLOT COUNT IN 12319000 * THE HEADER SECTION OF THE GROUP EXTENSION RECORD IS DECREASED BY 12320000 * ONE. WHEN THE SLOT COUNT IN THE EXTENSION RECORD IS ZERO, THE 12321000 * EXTENSION RECORD IS SCRATCHED AND IF IT WAS THE LAST 3233 12322000 * EXTENSION RECORD FOR THAT PARTICULAR GROUP, THE PREVIOUS EXTENSION 12323000 * RECORD IS UPDATED TO SHOW THAT IT IS THE LAST EXTENSION RECORD FOR 12324000 * THAT GROUP. THE RECORD IS THEN EITHER WRITTEN TO OR DELETED FROM 12325000 * THE MSVC DATA SET, DEPENDING ON THE SITUATION. IF THERE ARE NO 12326000 * GENERAL USE VOLUMES IN THE GROUP, THERE WILL BE NO GROUP EXTENSION 12327000 * RECORDS. @Y30LB26 12328000 * 3233 12329000 * WHEN CREATING A SLOT, IF THE VOLUME IS EITHER (1) MARKED 3233 12330000 * MOUNTED TO ANY HOST OR IF (2) THE DOWN LEVEL SPACE FLAG IS 3233 12331000 * ON, THE RUNNING COUNT FREE SPACE INVALID FLAG IS TURNED ON. 3233 12332000 * IF THE VOLUME IS NEITHER (1) OR (2) AS ABOVE, THE TOTAL 3233 12333000 * FREE SPACE FROM THE BASE VOLUME RECORD IS PUT INTO THE 3233 12334000 * RUNNING COUNT FIELD OF THE GROUP EXTENSION RECORD, AND 3233 12335000 * THE RUNNING COUNT FREE SPACE INVALID FLAG IS LEFT OFF. 3233 12336000 * @G24LB04 12337000 * INPUTS - A PARAMETER LIST CONTAINING THE ADDRESS OF THE GROUP 12338000 * RECORD, THE ADDRESS OF THE BASE RECORD, THE ADDRESS OF THE RPLV 12339000 * AND FLAG BYTES TELLING IF A SLOT IS TO BE INSERTED OR DELETED, 12340000 * OR IF ONLY THE EXPIRATION DATE IS TO BE CHANGED. @Y30LB26 12341000 * 3233 12342000 * OUTPUT - REASON AND CONDITION CODES RETURNED IN RPLV. THE 3233 12343000 * REASON CODES RETURNED ARE: @Y30LB26 12344000 * 3233 12345000 * '021B'X ERROR OCCURED BUT RPLV WAS JOURNALED. @Y30LB26 12346000 * '0202'X SLOT TO BE DELETED COULD NOT BE FOUND. @Y30LB26 12347000 * PLUS I/O PROCESSOR AND THE JOURNAL REASON CODES. @Y30LB26 12348000 **** END OF SPECIFICATIONS ** */ 12349000 * 3233 12350000 *ICBVUEXT: 3233 12351000 * ENTRY(GRPEXT,BASEXT,RPLVEXT,FLAGEXT);/* #Y30LB26*/ 12352000 @EP03233 MVC @PC00001+24(16),0(@01) 3233 12353000 * DCL 3234 12354000 * GRPEXT PTR(31); /* POINTER TO GROUP REC #Y30LB26*/ 12355000 * DCL 3235 12356000 * BASEXT PTR(31); /* POINTER TO BASE REC #Y30LB26*/ 12357000 * DCL 3236 12358000 * RPLVEXT PTR(31); /* POINTER TO RPLV #Y30LB26*/ 12359000 * DCL 3237 12360000 * FLAGEXT BIT(16); /* FLAG BYTE @Y30LB26*/ 12361000 * 3238 12362000 * /*****************************************************************/ 12363000 * /* */ 12364000 * /* SET UP PARAMETERS PASSED TO THIS ROUTINE @Y30LB26*/ 12365000 * /* */ 12366000 * /*****************************************************************/ 12367000 * 3238 12368000 * GROUPPTR=GRPEXT; /* SET GROUP ADDRESS @Y30LB26*/ 12369000 L @02,@PC00001+24 3238 12370000 L @02,GRPEXT(,@02) 3238 12371000 ST @02,GROUPPTR 3238 12372000 * BASEVPTR=BASEXT; /* ADDRESS BASE REC @Y30LB26*/ 12373000 L @02,@PC00001+28 3239 12374000 L @02,BASEXT(,@02) 3239 12375000 ST @02,BASEVPTR 3239 12376000 * RPLVPTR=RPLVEXT; /* ADDR OF RPLV @Y30LB26*/ 12377000 L @02,@PC00001+32 3240 12378000 L @02,RPLVEXT(,@02) 3240 12379000 ST @02,RPLVPTR 3240 12380000 * PASSFLAG=FLAGEXT; /* FLAG BYTE @Y30LB26*/ 12381000 * 3241 12382000 L @02,@PC00001+36 3241 12383000 MVC PASSFLAG(2),FLAGEXT(@02) 3241 12384000 * /*****************************************************************/ 12385000 * /* */ 12386000 * /* CALL INTERNAL PROCEDURE TO GET EXTENSION RECORD @Y30LB26*/ 12387000 * /* PROCESSED @Y30LB26*/ 12388000 * /* */ 12389000 * /*****************************************************************/ 12390000 * 3242 12391000 * CALL VUEXT; /* CALL INTERNAL PROC @Y30LB26*/ 12392000 BAL @14,VUEXT 3242 12393000 * RETURN; /* @Y30LB26*/ 12394000 B @EL00001 3243 12395000 * 3244 12396000 * /*****************************************************************/ 12397000 * /* */ 12398000 * /* PROCEDURE VUEXT IS CODED SO THAT CODE CONTAINED IN @Y30LB26*/ 12399000 * /* ENTRY ICBVUEXT CAN BE USED BY BOTH THIS MODULE AND BY @Y30LB26*/ 12400000 * /* OTHER MODULES @Y30LB26*/ 12401000 * /* */ 12402000 * /*****************************************************************/ 12403000 * 3244 12404000 *VUEXT: 3244 12405000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 12406000 VUEXT ST @14,@SA00052 3244 12407000 * DCL 3245 12408000 * TWO FIXED(8) CONSTANT(2); /* TWO @Y30LB26*/ 12409000 * GBLKKY=BLANK; /* SET KEY ID @Y30LB26*/ 12410000 MVI GBLKKY,C' ' 3246 12411000 * GIDKY=FIXZERO; /* INIT KEY ID @Y30LB26*/ 12412000 MVI GIDKY,X'00' 3247 12413000 * LOOPSW=OFF; /* OFF BEFORE BEGIN LOOP @Y30LB26*/ 12414000 * 3248 12415000 NI LOOPSW,B'01111111' 3248 12416000 * /*****************************************************************/ 12417000 * /* */ 12418000 * /* SEE IF ADDING, DELETING SLOT OR UPDATING EXPIRATION @Y30LB26*/ 12419000 * /* DATE. IF DELETING SLOT OR CHANGING EXPIRATION DATE, @Y30LB26*/ 12420000 * /* GO TO SEPERATE SUBROUTINE @Y30LB26*/ 12421000 * /* */ 12422000 * /*****************************************************************/ 12423000 * 3249 12424000 * IF ADDSLEXT=OFF|SLOTEXP=ON THEN /* DELETE SLOT? @Y30LB26*/ 12425000 TM ADDSLEXT,B'00000010' 3249 12426000 BZ @RT03249 3249 12427000 TM SLOTEXP,B'10000000' 3249 12428000 BNO @RF03249 3249 12429000 @RT03249 DS 0H 3250 12430000 * DO; /* @Y30LB26*/ 12431000 * CALL DELETESL; /* GO DELETE SLOT @Y30LB26*/ 12432000 BAL @14,DELETESL 3251 12433000 * GIDKY=FIXZERO; /* RESET KEY PROPERLY @Y30LB26*/ 12434000 MVI GIDKY,X'00' 3252 12435000 * RETURN; /* @Y30LB26*/ 12436000 @EL00052 DS 0H 3253 12437000 @EF00052 DS 0H 3253 12438000 @ER00052 L @14,@SA00052 3253 12439000 BR @14 3253 12440000 * END; /* @Y30LB26*/ 12441000 * 3254 12442000 * /*****************************************************************/ 12443000 * /* */ 12444000 * /* BUILD KEY TO READ EXTENSION RECORD @Y30LB26*/ 12445000 * /* */ 12446000 * /*****************************************************************/ 12447000 * 3255 12448000 * GROUPKY=GROVVGRP; /* GROUP @Y30LB26*/ 12449000 @RF03249 L @02,GROUPPTR 3255 12450000 MVC GROUPKY(8),GROVVGRP(@02) 3255 12451000 * GIDKY=GIDKY+FIXONE; /* ADD TO KEY @Y30LB26*/ 12452000 * 3256 12453000 LA @02,1 3256 12454000 SLR @15,@15 3256 12455000 IC @15,GIDKY 3256 12456000 ALR @02,@15 3256 12457000 STC @02,GIDKY 3256 12458000 * /*****************************************************************/ 12459000 * /* */ 12460000 * /* READ FOR GREATER OR EQUAL TO GET FIRST EXTENSION @Y30LB26*/ 12461000 * /* KEEP LOOPING UNTIL AN EXTENSION RECORD IS FOUND @Y30LB26*/ 12462000 * /* THAT IS NOT FULL, OR UNTIL ALL EXTENSION RECORDS @Y30LB26*/ 12463000 * /* ARE READ @Y30LB26*/ 12464000 * /* */ 12465000 * /*****************************************************************/ 12466000 * 3257 12467000 * DO WHILE I=I; /* FIND EXTEN NOT FULL @Y30LB26*/ 12468000 B @DE03257 3257 12469000 @DL03257 DS 0H 3258 12470000 * RPLVKEY=ADDR(GKEY); /* ADDR GROUP EXT KEY @Y30LB26*/ 12471000 L @02,RPLVPTR 3258 12472000 LA @15,GKEY 3258 12473000 ST @15,RPLVKEY(,@02) 3258 12474000 * RPLVBUF=ADDR(STORGPEX); /* ADDR GROUP EXT BUF @Y30LB26*/ 12475000 LA @15,STORGPEX 3259 12476000 ST @15,RPLVBUF(,@02) 3259 12477000 * RPLVBLN=LENGTH(STORGPEX); /* LENGTH OF BUFFER @Y30LB26*/ 12478000 MVC RPLVBLN(4,@02),@CF01148 3260 12479000 * RPLVLOC=OFF; /* NOT LOCATE @Y30LB26*/ 12480000 * RPLVDIR=ON; /* READ DIRECT @Y30LB26*/ 12481000 OI RPLVDIR(@02),B'01000000' 3262 12482000 NI RPLVLOC(@02),B'01111111' 3262 12483000 * RPLVTYP=RPLVREAD; /* READ RECORD @Y30LB26*/ 12484000 MVI RPLVTYP(@02),X'00' 3263 12485000 * RPLVKGE=ON; /* READ GRTR THAN OR = @Y30LB26*/ 12486000 OI RPLVKGE(@02),B'00000100' 3264 12487000 * RPLVUPD=ON; /* FOR UPDATE @Y30LB26*/ 12488000 OI RPLVUPD(@02),B'00000010' 3265 12489000 * RESPECIFY 3266 12490000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 12491000 * REG1=RPLVPTR; /* ADDR OF RPLV @Y30LB26*/ 12492000 LR REG1,@02 3267 12493000 * CALL ICBVIO00; /* READ EXTENSION RECORD @Y30LB26*/ 12494000 L @15,@CV00671 3268 12495000 BALR @14,@15 3268 12496000 * RESPECIFY 3269 12497000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 12498000 * IF RPLVRETC^=RCZERO&RPLRCODE^=NORECRC THEN/* CK RET @Y30LB26*/ 12499000 L @02,RPLVPTR 3270 12500000 CLC RPLVRETC(2,@02),@CB00747 3270 12501000 BE @RF03270 3270 12502000 CLC RPLRCODE(2,@02),@CB00789 3270 12503000 BNE @RT03270 3270 12504000 * RETURN; /* @VS32198*/ 12505000 * GVSNEPTR=ADDR(STORGPEX); /* ADDRESSING TO RECORD @Y30LB26*/ 12506000 * 3272 12507000 @RF03270 LA GVSNEPTR,STORGPEX 3272 12508000 * /***************************************************************/ 12509000 * /* */ 12510000 * /* IF NOT PROPER GROUP THEN MUST BE NO EXTENSION RECORDS */ 12511000 * /* @Y30LB26*/ 12512000 * /* */ 12513000 * /***************************************************************/ 12514000 * 3273 12515000 * IF GVSVVGRP^=GROUPKY|RPLRCODE=NORECRC THEN/* RT EXT ? @Y30LB26*/ 12516000 * 3273 12517000 CLC GVSVVGRP(8,GVSNEPTR),GROUPKY 3273 12518000 BNE @RT03273 3273 12519000 L @01,RPLVPTR 3273 12520000 CLC RPLRCODE(2,@01),@CB00789 3273 12521000 BNE @RF03273 3273 12522000 @RT03273 DS 0H 3274 12523000 * /*************************************************************/ 12524000 * /* */ 12525000 * /* SHOULD BE NO EXTENSION RECORDS SO GO @Y30LB26*/ 12526000 * /* CREATE A NEW ONE @Y30LB26*/ 12527000 * /* */ 12528000 * /*************************************************************/ 12529000 * 3274 12530000 * DO; /* @Y30LB26*/ 12531000 * IF LOOPSW=ON THEN /* FOUND RECORD BEFORE @Y30LB26*/ 12532000 TM LOOPSW,B'10000000' 3275 12533000 BNO @RF03275 3275 12534000 * DO; /* @Y30LB26*/ 12535000 * GKEY=GVSNAME; /* LATEST KEY @Y30LB26*/ 12536000 MVC GKEY(13),GVSNAME(GVSNEPTR) 3277 12537000 * GIDKY=GIDKY+FIXONE; /* ADD ONE @Y30LB26*/ 12538000 LA @02,1 3278 12539000 SLR @15,@15 3278 12540000 IC @15,GIDKY 3278 12541000 ALR @02,@15 3278 12542000 STC @02,GIDKY 3278 12543000 * END; /* @Y30LB26*/ 12544000 * ELSE /* @Y30LB26*/ 12545000 * GIDKY=FIXONE; /* SET FOR NEXT @Y30LB26*/ 12546000 B @RC03275 3280 12547000 @RF03275 MVI GIDKY,X'01' 3280 12548000 * CALL NEWREC; /* GO DO NEW REC @Y30LB26*/ 12549000 @RC03275 BAL @14,NEWREC 3281 12550000 * GIDKY=FIXZERO; /* RESET KEY CORRECT ID @Y30LB26*/ 12551000 MVI GIDKY,X'00' 3282 12552000 * RETURN; /* @Y30LB26*/ 12553000 B @EL00052 3283 12554000 * END; /* @Y30LB26*/ 12555000 * ELSE /* @Y30LB26*/ 12556000 * 3285 12557000 * /*************************************************************/ 12558000 * /* */ 12559000 * /* CHECK TO SEE IF THERE ARE SLOTS LEFT IN RECORD @Y30LB26*/ 12560000 * /* */ 12561000 * /*************************************************************/ 12562000 * 3285 12563000 * DO; /* @Y30LB26*/ 12564000 @RF03273 DS 0H 3286 12565000 * LOOPSW=ON; /* INDICATE REC FOUND @Y30LB26*/ 12566000 OI LOOPSW,B'10000000' 3286 12567000 * IF GVSESIND>=GVSNSLOT+ONE THEN/* RECORD FULL? @Y30LB26*/ 12568000 * 3287 12569000 LH @15,GVSESIND(,GVSNEPTR) 3287 12570000 C @15,@CF01150 3287 12571000 BL @RF03287 3287 12572000 * /*********************************************************/ 12573000 * /* */ 12574000 * /* IF THERE ARE NO SLOTS LEFT IN RECORD, @Y30LB26*/ 12575000 * /* SEE IF THIS RECORD IS THE LAST ONE. IF @Y30LB26*/ 12576000 * /* IT IS, INDICATE THAT ITS NOT AND GO CREATE @Y30LB26*/ 12577000 * /* ANOTHER EXTENSION RECORD @Y30LB26*/ 12578000 * /* */ 12579000 * /*********************************************************/ 12580000 * 3288 12581000 * DO; /* @Y30LB26*/ 12582000 * IF GVSEX=OFF THEN /* LAST EXTENSION? @Y30LB26*/ 12583000 TM GVSEX(GVSNEPTR),B'10000000' 3289 12584000 BNZ @RF03289 3289 12585000 * DO; /* @Y30LB26*/ 12586000 * GVSEX=ON; /* INDICATE NOT LAST @Y30LB26*/ 12587000 * 3291 12588000 OI GVSEX(GVSNEPTR),B'10000000' 3291 12589000 * /***************************************************/ 12590000 * /* */ 12591000 * /* WRITE EXTENSION RECORD THAT WAS LAST @Y30LB26*/ 12592000 * /* */ 12593000 * /***************************************************/ 12594000 * 3292 12595000 * RPLVTYP=RPLVPUT; /* PUT FULL EXTEN @Y30LB26*/ 12596000 L @15,RPLVPTR 3292 12597000 MVI RPLVTYP(@15),X'01' 3292 12598000 * RESPECIFY 3293 12599000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 12600000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 12601000 LR REG1,@15 3294 12602000 * CALL ICBVIO00; /* WRITE UPDATED EXT REC @Y30LB26*/ 12603000 L @15,@CV00671 3295 12604000 BALR @14,@15 3295 12605000 * RESPECIFY 3296 12606000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 12607000 * IF RPLVRETC^=RCZERO THEN/* CHK RETURN @Y30LB26*/ 12608000 L @01,RPLVPTR 3297 12609000 CLC RPLVRETC(2,@01),@CB00747 3297 12610000 BNE @RT03297 3297 12611000 * RETURN; /* @Y30LB26*/ 12612000 * 3298 12613000 * /***************************************************/ 12614000 * /* */ 12615000 * /* IF NOT JOURNALED BEFORE, JOURNAL IT NOW @Y30LB26*/ 12616000 * /* */ 12617000 * /***************************************************/ 12618000 * 3299 12619000 * IF JRNLEDSW=OFF THEN/* JOURNALED BEFORE? @Y30LB26*/ 12620000 TM JRNLEDSW,B'00000001' 3299 12621000 BNZ @RF03299 3299 12622000 * DO; /* @Y30LB26*/ 12623000 * CALL JOURNAL; /* JOURNAL RPLV @Y30LB26*/ 12624000 BAL @14,JOURNAL 3301 12625000 * IF RPLVRETC^=RCZERO THEN/* @Y30LB26*/ 12626000 L @01,RPLVPTR 3302 12627000 CLC RPLVRETC(2,@01),@CB00747 3302 12628000 BNE @RT03302 3302 12629000 * RETURN; /* @Y30LB26*/ 12630000 * END; /* @Y30LB26*/ 12631000 * 3304 12632000 * /***************************************************/ 12633000 * /* */ 12634000 * /* SET UP KEY TO GO BUILD NEW EXTENSION @Y30LB26*/ 12635000 * /* RECORD @Y30LB26*/ 12636000 * /* */ 12637000 * /***************************************************/ 12638000 * 3305 12639000 * GKEY=GVSNAME; /* GROUP NAME TO KEY @Y30LB26*/ 12640000 @RF03299 MVC GKEY(13),GVSNAME(GVSNEPTR) 3305 12641000 * GIDKY=GIDKY+FIXONE;/* ADD GET NEXT REC @Y30LB26*/ 12642000 LA @02,1 3306 12643000 SLR @15,@15 3306 12644000 IC @15,GIDKY 3306 12645000 ALR @02,@15 3306 12646000 STC @02,GIDKY 3306 12647000 * CALL NEWREC; /* GO BUILD NEW RECORD @Y30LB26*/ 12648000 BAL @14,NEWREC 3307 12649000 * GIDKY=FIXZERO; /* RESET KEY CORRECT ID @Y30LB26*/ 12650000 MVI GIDKY,X'00' 3308 12651000 * RETURN; /* @Y30LB26*/ 12652000 B @EL00052 3309 12653000 * END; /* @Y30LB26*/ 12654000 * 3310 12655000 * /*******************************************************/ 12656000 * /* */ 12657000 * /* EXTENSION RECORD WAS FULL, BUT IT WAS @Y30LB26*/ 12658000 * /* NOT THE LAST ONE, SO SET UP KEY TO READ @Y30LB26*/ 12659000 * /* NEXT EXTENSION AND LOOP BACK @Y30LB26*/ 12660000 * /* */ 12661000 * /*******************************************************/ 12662000 * 3311 12663000 * ELSE /* NOT LAST EXTENISON @Y30LB26*/ 12664000 * DO; /* @Y30LB26*/ 12665000 @RF03289 DS 0H 3312 12666000 * GKEY=GVSNAME; /* SET UP KEY FOR NEXT @Y30LB26*/ 12667000 MVC GKEY(13),GVSNAME(GVSNEPTR) 3312 12668000 * GIDKY=GIDKY+FIXONE;/* AND LOOP BACK @Y30LB26*/ 12669000 LA @02,1 3313 12670000 SLR @15,@15 3313 12671000 IC @15,GIDKY 3313 12672000 ALR @02,@15 3313 12673000 STC @02,GIDKY 3313 12674000 * END; /* @Y30LB26*/ 12675000 * END; /* @Y30LB26*/ 12676000 * 3315 12677000 * /***********************************************************/ 12678000 * /* */ 12679000 * /* SINCE EXTENSION RECORD IS NOT FULL, GO @Y30LB26*/ 12680000 * /* BUILD A NEW SLOT IN THIS EXTENSION @Y30LB26*/ 12681000 * /* */ 12682000 * /***********************************************************/ 12683000 * 3316 12684000 * ELSE /* RECORD NOT FULL @Y30LB26*/ 12685000 * DO; /* SO PUT IN NEW SLOT @Y30LB26*/ 12686000 B @RC03287 3316 12687000 @RF03287 DS 0H 3317 12688000 * CALL NEWSLOT; /* GO MAKE A NEW SLOT @Y30LB26*/ 12689000 * 3317 12690000 BAL @14,NEWSLOT 3317 12691000 * /*******************************************************/ 12692000 * /* */ 12693000 * /* WRITE UPDATED EXTENSION RECORD @Y30LB26*/ 12694000 * /* */ 12695000 * /*******************************************************/ 12696000 * 3318 12697000 * RPLVTYP=RPLVPUT; /* PUT EXTENSION REC @Y30LB26*/ 12698000 L @02,RPLVPTR 3318 12699000 MVI RPLVTYP(@02),X'01' 3318 12700000 * RESPECIFY 3319 12701000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 12702000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 12703000 LR REG1,@02 3320 12704000 * CALL ICBVIO00; /* WRITE EXTENSION REC @Y30LB26*/ 12705000 L @15,@CV00671 3321 12706000 BALR @14,@15 3321 12707000 * RESPECIFY 3322 12708000 * REG1 UNRSTD; /* FREE REG 1 @Y30LB26*/ 12709000 * IF RPLVRETC^=RCZERO THEN/* @Y30LB26*/ 12710000 L @02,RPLVPTR 3323 12711000 CLC RPLVRETC(2,@02),@CB00747 3323 12712000 BNE @RT03323 3323 12713000 * RETURN; /* @Y30LB26*/ 12714000 * 3324 12715000 * /*******************************************************/ 12716000 * /* */ 12717000 * /* IF RPLV NEVER JOURNALED BEFORE, JOURNAL IT @Y30LB26*/ 12718000 * /* */ 12719000 * /*******************************************************/ 12720000 * 3325 12721000 * IF JRNLEDSW=OFF THEN /* JOURNALED BEFORE @Y30LB26*/ 12722000 TM JRNLEDSW,B'00000001' 3325 12723000 BNZ @RF03325 3325 12724000 * DO; /* @Y30LB26*/ 12725000 * CALL JOURNAL; /* JOURNALED RPLV @Y30LB26*/ 12726000 BAL @14,JOURNAL 3327 12727000 * IF RPLVRETC^=RCZERO THEN/* @Y30LB26*/ 12728000 L @02,RPLVPTR 3328 12729000 CLC RPLVRETC(2,@02),@CB00747 3328 12730000 BNE @RT03328 3328 12731000 * RETURN; /* @Y30LB26*/ 12732000 * END; /* @Y30LB26*/ 12733000 * 3330 12734000 * /*******************************************************/ 12735000 * /* */ 12736000 * /* RECORD WAS UPDATED OR CREATED SUCCESSFULLY @Y30LB26*/ 12737000 * /* */ 12738000 * /*******************************************************/ 12739000 * 3331 12740000 * RPLVRETC=RCZERO; /* GOOD RC @Y30LB26*/ 12741000 @RF03325 L @02,RPLVPTR 3331 12742000 MVC RPLVRETC(2,@02),@CB00747 3331 12743000 * RPLRCODE=RCZERO; /* GOOD REASON @Y30LB26*/ 12744000 MVC RPLRCODE(2,@02),@CB00747 3332 12745000 * GIDKY=FIXZERO; /* REST TO CORRECT ID @Y30LB26*/ 12746000 MVI GIDKY,X'00' 3333 12747000 * RETURN; /* @Y30LB26*/ 12748000 B @EL00052 3334 12749000 * END; /* @Y30LB26*/ 12750000 * END; /* @Y30LB26*/ 12751000 @RC03287 DS 0H 3337 12752000 * END; /* END WHILE LOOP @Y30LB26*/ 12753000 @DE03257 CLC I(1),I 3337 12754000 BE @DL03257 3337 12755000 * END VUEXT; /* @Y30LB26*/ 12756000 B @EL00052 3338 12757000 * 3339 12758000 * /*****************************************************************/ 12759000 * /* */ 12760000 * /* THIS ROUTINE IS CALLED WHEN THERE ARE NO EXTENSION @Y30LB26*/ 12761000 * /* RECORDS FOR A PARTICULAR GROUP OR ALL THE EXISTING @Y30LB26*/ 12762000 * /* EXTENSION RECORDS ARE FULL. IT CREATES NEW EXTENSION @Y30LB26*/ 12763000 * /* */ 12764000 * /*****************************************************************/ 12765000 * 3339 12766000 *NEWREC: 3339 12767000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 12768000 * 3339 12769000 NEWREC ST @14,@SA00053 3339 12770000 * /*****************************************************************/ 12771000 * /* */ 12772000 * /* BUILD ENOUGH OF THE EXTENSION RECORD TO CALL THE @Y30LB26*/ 12773000 * /* NEW SLOT ROUTINE TO FILL IN SLOT @Y30LB26*/ 12774000 * /* */ 12775000 * /*****************************************************************/ 12776000 * 3340 12777000 * GVSNEPTR=ADDR(STORGPEX); /* ADDR EXTEN BUFFER @Y30LB26*/ 12778000 LA GVSNEPTR,STORGPEX 3340 12779000 * GVSHDR=GVSHDR&&GVSHDR; /* ZERO HEADER SECTION @Y30LB26*/ 12780000 XC GVSHDR(28,GVSNEPTR),GVSHDR(GVSNEPTR) 3341 12781000 * GVSNAME=GKEY; /* FILL IN KEY SECTION @Y30LB26*/ 12782000 MVC GVSNAME(13,GVSNEPTR),GKEY 3342 12783000 * GVSGVSEX=ON; /* INDICATE EXT REC @Y30LB26*/ 12784000 OI GVSGVSEX(GVSNEPTR),B'01000000' 3343 12785000 * GVSESIND=ONE; /* FIRST SLOT AVAILABLE @Y30LB26*/ 12786000 * 3344 12787000 MVC GVSESIND(2,GVSNEPTR),@CH00041 3344 12788000 * /*****************************************************************/ 12789000 * /* */ 12790000 * /* GO BUILD NEW SLOT FOR NEW EXTENSION RECORD @Y30LB26*/ 12791000 * /* */ 12792000 * /*****************************************************************/ 12793000 * 3345 12794000 * CALL NEWSLOT; /* GO BUILD NEW SLOT @Y30LB26*/ 12795000 * 3345 12796000 BAL @14,NEWSLOT 3345 12797000 * /*****************************************************************/ 12798000 * /* */ 12799000 * /* WRITE NEW EXTENSION RECORD @Y30LB26*/ 12800000 * /* */ 12801000 * /*****************************************************************/ 12802000 * 3346 12803000 * RPLVBUF=ADDR(STORGPEX); /* ADDR OF BUFFER @Y30LB26*/ 12804000 L @02,RPLVPTR 3346 12805000 LA @15,STORGPEX 3346 12806000 ST @15,RPLVBUF(,@02) 3346 12807000 * RPLVRLN=LENGTH(GVSNE); /* RECORD LENGTH @Y30LB26*/ 12808000 LA @15,988 3347 12809000 ST @15,RPLVRLN(,@02) 3347 12810000 * RPLVBLN=LENGTH(STORGPEX); /* LENGTH BUFFER @Y30LB26*/ 12811000 ST @15,RPLVBLN(,@02) 3348 12812000 * RPLVLOC=OFF; /* NO LOCATE @Y30LB26*/ 12813000 NI RPLVLOC(@02),B'01111111' 3349 12814000 * RPLVTYP=RPLVPUT; /* PUT NEW EXT RECORD @Y30LB26*/ 12815000 MVI RPLVTYP(@02),X'01' 3350 12816000 * RPLVUPD=OFF; /* NOT UPDATE @Y30LB26*/ 12817000 NI RPLVUPD(@02),B'11111101' 3351 12818000 * RESPECIFY 3352 12819000 * REG1 RSTD; /* RESTRICT REG 1 @Y301B26*/ 12820000 * REG1=RPLVPTR; /* ADDR RPLV @Y301B26*/ 12821000 LR REG1,@02 3353 12822000 * CALL ICBVIO00; /* WRITE EXT RECORD @Y301B26*/ 12823000 L @15,@CV00671 3354 12824000 BALR @14,@15 3354 12825000 * RESPECIFY 3355 12826000 * REG1 UNRSTD; /* FREE REG1 @Y301B26*/ 12827000 * IF RPLVRETC^=RCZERO THEN /* @Y30LB26*/ 12828000 L @02,RPLVPTR 3356 12829000 CLC RPLVRETC(2,@02),@CB00747 3356 12830000 BNE @RT03356 3356 12831000 * RETURN; /* @Y30LB26*/ 12832000 * 3357 12833000 * /*****************************************************************/ 12834000 * /* */ 12835000 * /* IF NEVER JOURNALED BEFORE, JOURNAL IT @Y30LB26*/ 12836000 * /* */ 12837000 * /*****************************************************************/ 12838000 * 3358 12839000 * IF JRNLEDSW=OFF THEN /* JOURNALED BEFORE? @Y301B26*/ 12840000 TM JRNLEDSW,B'00000001' 3358 12841000 BNZ @RF03358 3358 12842000 * CALL JOURNAL; /* JOURNAL RPLV @Y30LB26*/ 12843000 BAL @14,JOURNAL 3359 12844000 * RETURN; /* @Y301B26*/ 12845000 @EL00053 DS 0H 3360 12846000 @EF00053 DS 0H 3360 12847000 @ER00053 L @14,@SA00053 3360 12848000 BR @14 3360 12849000 * END NEWREC; /* @Y301B26*/ 12850000 B @EL00053 3361 12851000 * 3362 12852000 * /*****************************************************************/ 12853000 * /* */ 12854000 * /* THIS ROUTINE IS CALLED TO BUILD A NEW SLOT IN @Y30LB26*/ 12855000 * /* AN EXISTING EXTENSION RECORD. IT TAKES INFORMATION @Y30LB26*/ 12856000 * /* FROM THE BASE VOLUME RECORD TO FILL IN THE SLOT @Y30LB26*/ 12857000 * /* */ 12858000 * /*****************************************************************/ 12859000 * 3362 12860000 *NEWSLOT: 3362 12861000 * PROC(NOSAVE); /* @Y301B26*/ 12862000 NEWSLOT STM @14,@12,12(@13) 3362 12863000 MVC @PC00054(4),0(@01) 3362 12864000 * GVSSLOTS(GVSESIND)= /* ZERO ENTIRE SLOT @Y30LB26*/ 12865000 * GVSSLOTS(GVSESIND)&&GVSSLOTS(GVSESIND);/* @Y30LB26*/ 12866000 LH @15,GVSESIND(,GVSNEPTR) 3363 12867000 MH @15,@CH01149 3363 12868000 ST @15,@TF00001 3363 12869000 ALR @15,GVSNEPTR 3363 12870000 XC GVSSLOTS-20(20,@15),GVSSLOTS-20(@15) 3363 12871000 * GVSVOLID(GVSESIND)=BASSERNO; /* VOLUME SERIAL NO. @Y301B26*/ 12872000 LR @01,GVSNEPTR 3364 12873000 AL @01,@TF00001 3364 12874000 L @15,BASEVPTR 3364 12875000 MVC GVSVOLID-20(6,@01),BASSERNO(@15) 3364 12876000 * GVSCPUBM(GVSESIND)=BASCPUID; /* PUT IN CPU ASSOC MAP @Y30LB26*/ 12877000 LR @01,GVSNEPTR 3365 12878000 AL @01,@TF00001 3365 12879000 MVC GVSCPUBM-20(2,@01),BASCPUID(@15) 3365 12880000 * GVSFRESP(GVSESIND)=BASFRESP; /* FREE CYLINDERS @Y301B26*/ 12881000 LH @14,BASFRESP(,@15) 3366 12882000 N @14,@CF01186 3366 12883000 L @01,@TF00001 3366 12884000 STH @14,GVSFRESP-20(@01,GVSNEPTR) 3366 12885000 * GVSLEXT(GVSESIND)=BASLEXT; /* LARGEST FREE EXTENT @Y301B26*/ 12886000 LH @14,BASLEXT(,@15) 3367 12887000 N @14,@CF01186 3367 12888000 L @01,@TF00001 3367 12889000 STH @14,GVSLEXT-20(@01,GVSNEPTR) 3367 12890000 * GVSEXPDT(GVSESIND)=BASEXPDT; /* EXPIRATION DATE @Y301B26*/ 12891000 LR @01,GVSNEPTR 3368 12892000 AL @01,@TF00001 3368 12893000 MVC GVSEXPDT-20(4,@01),BASEXPDT(@15) 3368 12894000 * IF BASCPUID^=BITZERO|BASDLSF=ON /* IS VOL NOT MOUNTED OR @G24LB04 12895000 * DOWN LEVEL FREE SPACE? 3369 12896000 * @G24LB04*/ 12897000 * THEN 3369 12898000 CLC BASCPUID(2,@15),@CB00747 3369 12899000 BNE @RT03369 3369 12900000 TM BASDLSF(@15),B'10000000' 3369 12901000 BNO @RF03369 3369 12902000 @RT03369 DS 0H 3370 12903000 * GVSRCFSI(GVSESIND)=ON; /* TURN ON RUNNING COUNT @G24LB04 12904000 * FREE SPACE INVALID @G24LB04*/ 12905000 LH @15,GVSESIND(,GVSNEPTR) 3370 12906000 MH @15,@CH01149 3370 12907000 ALR @15,GVSNEPTR 3370 12908000 OI GVSRCFSI-20(@15),B'10000000' 3370 12909000 * ELSE /* @G24LB04*/ 12910000 * GVSMTDSP(GVSESIND)=BASFRESP; /* PUT IN TOTAL FREE @G24LB04 12911000 * SPACE @G24LB04*/ 12912000 B @RC03369 3371 12913000 @RF03369 LH @15,GVSESIND(,GVSNEPTR) 3371 12914000 MH @15,@CH01149 3371 12915000 L @01,BASEVPTR 3371 12916000 LH @14,BASFRESP(,@01) 3371 12917000 N @14,@CF01186 3371 12918000 STH @14,GVSMTDSP-20(@15,GVSNEPTR) 3371 12919000 * GVSESIND=GVSESIND+ONE; /* ADD FOR NEXT SLOT #Y301B26*/ 12920000 @RC03369 LA @15,1 3372 12921000 AH @15,GVSESIND(,GVSNEPTR) 3372 12922000 STH @15,GVSESIND(,GVSNEPTR) 3372 12923000 * RETURN; /* #Y301B26*/ 12924000 @EL00054 DS 0H 3373 12925000 @EF00054 DS 0H 3373 12926000 @ER00054 LM @14,@12,12(@13) 3373 12927000 BR @14 3373 12928000 * END NEWSLOT; /* @Y301B26*/ 12929000 * 3375 12930000 * /*****************************************************************/ 12931000 * /* */ 12932000 * /* THIS ROUTINE IS CALLED TO REMOVE A SLOT FROM A @Y30LB26*/ 12933000 * /* GROUP EXTENSION RECORD. IT WILL ALSO UPDATE THE @Y30LB26*/ 12934000 * /* EXPIRATION DATE IN AN EXISTING SLOT. @Y30LB26*/ 12935000 * /* IF THE SLOT REMOVED IS THE @Y30LB26*/ 12936000 * /* LAST SLOT IN RECORD, THE RECORD IS DELETED. @Y30LB26*/ 12937000 * /* IF DELETED RECORD WAS THE LAST EXTENSION RECORD @Y30LB26*/ 12938000 * /* AND THERE WAS A PREVIOUS EXTENSION, THE PREVIOUS @Y30LB26*/ 12939000 * /* ONE IS READ AND A FLAG INDICATING IT IS THE LAST @Y30LB26*/ 12940000 * /* IS TURNED ON. @Y30LB26*/ 12941000 * /* */ 12942000 * /*****************************************************************/ 12943000 * 3375 12944000 *DELETESL: 3375 12945000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 12946000 * 3375 12947000 DELETESL ST @14,@SA00055 3375 12948000 * /*****************************************************************/ 12949000 * /* */ 12950000 * /* SET GROUP NAME IN KEY AND INIT LOOP SWITCH @Y30LB26*/ 12951000 * /* */ 12952000 * /*****************************************************************/ 12953000 * 3376 12954000 * GROUPKY=GROVVGRP; /* GROUP NAME @Y301B26*/ 12955000 L @02,GROUPPTR 3376 12956000 MVC GROUPKY(8),GROVVGRP(@02) 3376 12957000 * LOOPSW=OFF; /* INIT LOOP SWITCH @Y301B26*/ 12958000 * 3377 12959000 NI LOOPSW,B'01111111' 3377 12960000 * /*****************************************************************/ 12961000 * /* */ 12962000 * /* LOOP USED TO GO THRU EXTENSION RECORDS UNTIL RIGHT @Y30LB26*/ 12963000 * /* SLOT IS LOCATED @Y30LB26*/ 12964000 * /* */ 12965000 * /*****************************************************************/ 12966000 * 3378 12967000 * DO WHILE I=I; /* OUTSIDE WHILE @Y301B26*/ 12968000 B @DE03378 3378 12969000 @DL03378 DS 0H 3379 12970000 * GIDKY=GIDKY+FIXONE; /* GET PAST GROUP @Y301B26*/ 12971000 LA @02,1 3379 12972000 SLR @15,@15 3379 12973000 IC @15,GIDKY 3379 12974000 ALR @02,@15 3379 12975000 STC @02,GIDKY 3379 12976000 * RPLVKEY=ADDR(GKEY); /* ADDR KEY @Y301B26*/ 12977000 L @02,RPLVPTR 3380 12978000 LA @15,GKEY 3380 12979000 ST @15,RPLVKEY(,@02) 3380 12980000 * RPLVBUF=ADDR(STORGPEX); /* ADDR BUFFER @Y301B26*/ 12981000 LA @15,STORGPEX 3381 12982000 ST @15,RPLVBUF(,@02) 3381 12983000 * RPLVBLN=LENGTH(STORGPEX); /* LENGTH OF BUFFER @Y301B26*/ 12984000 MVC RPLVBLN(4,@02),@CF01148 3382 12985000 * RPLVLOC=OFF; /* NO LOCATE @Y301B26*/ 12986000 * RPLVDIR=ON; /* READ DIRECT @Y301B26*/ 12987000 OI RPLVDIR(@02),B'01000000' 3384 12988000 NI RPLVLOC(@02),B'01111111' 3384 12989000 * RPLVTYP=RPLVREAD; /* READ EXT REC @Y301B26*/ 12990000 MVI RPLVTYP(@02),X'00' 3385 12991000 * RPLVKGE=ON; /* READ GT OR = @Y301B26*/ 12992000 OI RPLVKGE(@02),B'00000100' 3386 12993000 * RPLVUPD=ON; /* FOR UPDATE @Y301B26*/ 12994000 OI RPLVUPD(@02),B'00000010' 3387 12995000 * RESPECIFY 3388 12996000 * REG1 RSTD; /* RESTRICT REG1 @Y301B26*/ 12997000 * REG1=RPLVPTR; /* ADDR RPLV @Y301B26*/ 12998000 LR REG1,@02 3389 12999000 * CALL ICBVIO00; /* READ EXTENSION REC @Y301B26*/ 13000000 L @15,@CV00671 3390 13001000 BALR @14,@15 3390 13002000 * RESPECIFY 3391 13003000 * REG1 UNRSTD; /* FREE REG 1 @Y301B26*/ 13004000 * IF RPLVRETC^=RCZERO THEN /* CH RETURN @Y301B26*/ 13005000 L @02,RPLVPTR 3392 13006000 CLC RPLVRETC(2,@02),@CB00747 3392 13007000 BNE @RT03392 3392 13008000 * RETURN; /* @Y301B26*/ 13009000 * 3393 13010000 * /***************************************************************/ 13011000 * /* */ 13012000 * /* GET ADDRESS OF RECORD JUST READ AND CHECK TO SEE @Y30LB26*/ 13013000 * /* IF IT IS AN EXTENSION RECORD FOR THE CORRECT GROUP @Y30LB26*/ 13014000 * /* */ 13015000 * /***************************************************************/ 13016000 * 3394 13017000 * GVSNEPTR=ADDR(STORGPEX); /* ADDR OF RECORD READ @Y301B26*/ 13018000 LA GVSNEPTR,STORGPEX 3394 13019000 * IF GVSVVGRP^=GROUPKY|GVSGVSEX=OFF THEN/* STILL RT EXT @Y30LB26*/ 13020000 * 3395 13021000 CLC GVSVVGRP(8,GVSNEPTR),GROUPKY 3395 13022000 BNE @RT03395 3395 13023000 TM GVSGVSEX(GVSNEPTR),B'01000000' 3395 13024000 BNZ @RF03395 3395 13025000 @RT03395 DS 0H 3396 13026000 * /*************************************************************/ 13027000 * /* */ 13028000 * /* SINCE THERE ARE NO MORE EXTENSIONS FOR THIS @Y30LB26*/ 13029000 * /* GROUP, SET REASON CODE INDICATING THAT SLOT @Y30LB26*/ 13030000 * /* WAS NOT FOUND @Y30LB26*/ 13031000 * /* */ 13032000 * /*************************************************************/ 13033000 * 3396 13034000 * DO; /* @Y301B26*/ 13035000 * RPLVRETC=FOUR; /* BAD RETURN @Y301B26*/ 13036000 L @02,RPLVPTR 3397 13037000 MVC RPLVRETC(2,@02),@CB00749 3397 13038000 * RPLRCODE=NOSLTFND; /* NO SLOT FOUND @Y30LB26*/ 13039000 MVC RPLRCODE(2,@02),@CB00835 3398 13040000 * RETURN; /* @Y301B26*/ 13041000 @EL00055 DS 0H 3399 13042000 @EF00055 DS 0H 3399 13043000 @ER00055 L @14,@SA00055 3399 13044000 BR @14 3399 13045000 * END; /* @Y301B26*/ 13046000 * 3400 13047000 * /***************************************************************/ 13048000 * /* */ 13049000 * /* LOOK FOR SLOT IN EXTENSION RECORD @Y30LB26*/ 13050000 * /* */ 13051000 * /***************************************************************/ 13052000 * 3401 13053000 * DO J=1 TO GVSESIND-1; /* INSIDE WHILE @Y30LB26*/ 13054000 @RF03395 LA @15,1 3401 13055000 B @DE03401 3401 13056000 @DL03401 DS 0H 3402 13057000 * IF GVSVOLID(J)=BASSERNO THEN/* RIGHT SLOT? @Y301B26*/ 13058000 MH @15,@CH01149 3402 13059000 L @14,BASEVPTR 3402 13060000 ST @15,@TF00001 3402 13061000 ALR @15,GVSNEPTR 3402 13062000 CLC GVSVOLID-20(6,@15),BASSERNO(@14) 3402 13063000 BNE @RF03402 3402 13064000 * DO; /* @Y301B26*/ 13065000 * 3403 13066000 * /*********************************************************/ 13067000 * /* */ 13068000 * /* CHECK TO SEE IF UPDATING THE RETENTION PERIOD @Y30LB26*/ 13069000 * /* IS ALL THAT IS REQUIRED @Y30LB26*/ 13070000 * /* */ 13071000 * /*********************************************************/ 13072000 * 3404 13073000 * IF SLOTEXP=ON THEN /* RETENTION ? @Y30LB26*/ 13074000 TM SLOTEXP,B'10000000' 3404 13075000 BNO @RF03404 3404 13076000 * DO; /* @Y30LB26*/ 13077000 * GVSEXPDT(J)=BASEXPDT;/* UPDATE RET @Y30LB26*/ 13078000 * 3406 13079000 LR @01,GVSNEPTR 3406 13080000 AL @01,@TF00001 3406 13081000 MVC GVSEXPDT-20(4,@01),BASEXPDT(@14) 3406 13082000 * /*****************************************************/ 13083000 * /* */ 13084000 * /* WRITE UPDATED EXTENSION RECORD @Y30LB26*/ 13085000 * /* */ 13086000 * /*****************************************************/ 13087000 * 3407 13088000 * RPLVTYP=RPLVPUT; /* WRITE RECORD @Y30LB26*/ 13089000 L @02,RPLVPTR 3407 13090000 MVI RPLVTYP(@02),X'01' 3407 13091000 * RESPECIFY 3408 13092000 * REG1 RSTD; /* RESTRICT REG 1 @Y30LB26*/ 13093000 * REG1=RPLVPTR; /* ADDR RPLV @Y30LB26*/ 13094000 LR REG1,@02 3409 13095000 * CALL ICBVIO00; /* WRITE EXTENSION REC @Y30LB26*/ 13096000 L @15,@CV00671 3410 13097000 BALR @14,@15 3410 13098000 * RESPECIFY 3411 13099000 * REG1 UNRSTD; /* FREE @Y30LB26*/ 13100000 * IF RPLVRETC^=RCZERO THEN/* CHECK RETURN @Y30LB26*/ 13101000 L @02,RPLVPTR 3412 13102000 CLC RPLVRETC(2,@02),@CB00747 3412 13103000 BNE @RT03412 3412 13104000 * RETURN; /* @Y30LB26*/ 13105000 * 3413 13106000 * /*****************************************************/ 13107000 * /* */ 13108000 * /* IF RPLV HAS NOT BEEN JOURNALED YET, @Y30LB26*/ 13109000 * /* JOURNAL IT @Y30LB26*/ 13110000 * /* */ 13111000 * /*****************************************************/ 13112000 * 3414 13113000 * IF JRNLEDSW=OFF THEN/* IF NOT JOURNALED @Y30LB26*/ 13114000 TM JRNLEDSW,B'00000001' 3414 13115000 BNZ @RF03414 3414 13116000 * CALL JOURNAL; /* JOURNAL THE RPLV @Y30LB26*/ 13117000 BAL @14,JOURNAL 3415 13118000 * RETURN; /* @Y30LB26*/ 13119000 B @EL00055 3416 13120000 * END; /* @Y30LB26*/ 13121000 * 3417 13122000 * /*********************************************************/ 13123000 * /* */ 13124000 * /* SINCE FOUND SLOT, SEE IF IT IS THE ONLY @Y30LB26*/ 13125000 * /* SLOT IN THAT EXTENSION RECORD @Y30LB26*/ 13126000 * /* */ 13127000 * /*********************************************************/ 13128000 * 3418 13129000 * IF GVSESIND>TWO THEN /* @Y30LB26*/ 13130000 * 3418 13131000 @RF03404 LH @15,GVSESIND(,GVSNEPTR) 3418 13132000 C @15,@CF00058 3418 13133000 BNH @RF03418 3418 13134000 * /*******************************************************/ 13135000 * /* */ 13136000 * /* IF MORE THAN ONE SLOT IN RECORD, SHIFT @Y30LB26*/ 13137000 * /* LEFT OVER DELETED SLOT @Y30LB26*/ 13138000 * /* */ 13139000 * /*******************************************************/ 13140000 * 3419 13141000 * DO; /* @Y301B26*/ 13142000 * RESPECIFY 3420 13143000 * (REG4, 3420 13144000 * REG5, 3420 13145000 * REG6, 3420 13146000 * REG7) RSTD; /* RSTR @Y30LB26*/ 13147000 * REG4=ADDR(GVSVOLID(J));/* ADDR SLOT REMOVED @Y301B26*/ 13148000 LA @14,20 3421 13149000 SLR @01,@01 3421 13150000 IC @01,J 3421 13151000 MR @00,@14 3421 13152000 LA REG4,GVSVOLID-20(@01,GVSNEPTR) 3421 13153000 * REG6=ADDR(GVSVOLID(J+1));/* ADDR NEXT SLOT @Y301B26*/ 13154000 LA @01,GVSVOLID(@01,GVSNEPTR) 3422 13155000 LR REG6,@01 3422 13156000 * REG5=ADDR(GVSVOLID(GVSESIND))-/* @Y30LB26*/ 13157000 * ADDR(GVSVOLID(J+1));/* GET LENGTH FOR MOVE 3423 13158000 * @Y30LB26*/ 13159000 MR @14,@14 3423 13160000 LA REG5,GVSVOLID-20(@15,GVSNEPTR) 3423 13161000 SLR REG5,@01 3423 13162000 * REG7=REG5; /* LENGTH OF MOVE @Y301B26*/ 13163000 LR REG7,REG5 3424 13164000 * GEN(MVCL REG4,REG6);/* SHIFT ONE SLOT TO LEFT 3425 13165000 * @Y301B26*/ 13166000 MVCL REG4,REG6 13167000 * RESPECIFY 3426 13168000 * (REG4, 3426 13169000 * REG5, 3426 13170000 * REG6, 3426 13171000 * REG7) UNRSTD; /* FREE @Y30LB26*/ 13172000 * 3426 13173000 * /*****************************************************/ 13174000 * /* */ 13175000 * /* INDICATE ONE MORE SLOT IS AVAILABLE @Y30LB26*/ 13176000 * /* IN RECORD @Y30LB26*/ 13177000 * /* */ 13178000 * /*****************************************************/ 13179000 * 3427 13180000 * GVSESIND=GVSESIND-ONE;/* DECREASE SLOT COUNT @Y301B26*/ 13181000 * 3427 13182000 LH @15,GVSESIND(,GVSNEPTR) 3427 13183000 BCTR @15,0 3427 13184000 STH @15,GVSESIND(,GVSNEPTR) 3427 13185000 * /*****************************************************/ 13186000 * /* */ 13187000 * /* WRITE UPDATED EXTENSION RECORD @Y30LB26*/ 13188000 * /* */ 13189000 * /*****************************************************/ 13190000 * 3428 13191000 * RPLVTYP=RPLVPUT; /* WRITE RECORD @Y301B26*/ 13192000 L @02,RPLVPTR 3428 13193000 MVI RPLVTYP(@02),X'01' 3428 13194000 * RESPECIFY 3429 13195000 * REG1 RSTD; /* RESTRICT REG 1 @Y301B26*/ 13196000 * REG1=RPLVPTR; /* ADDR RPLV @Y301B26*/ 13197000 LR REG1,@02 3430 13198000 * CALL ICBVIO00; /* WRITE EXTENSION REC @Y301B26*/ 13199000 L @15,@CV00671 3431 13200000 BALR @14,@15 3431 13201000 * RESPECIFY 3432 13202000 * REG1 UNRSTD; /* FREE @Y301B26*/ 13203000 * IF RPLVRETC^=RCZERO THEN/* CHECK RETURN @Y301B26*/ 13204000 L @02,RPLVPTR 3433 13205000 CLC RPLVRETC(2,@02),@CB00747 3433 13206000 BNE @RT03433 3433 13207000 * RETURN; /* @Y301B26*/ 13208000 * 3434 13209000 * /*****************************************************/ 13210000 * /* */ 13211000 * /* IF RPLV HAS NOT BEEN JOURNALED YET, @Y30LB26*/ 13212000 * /* JOURNAL IT @Y30LB26*/ 13213000 * /* */ 13214000 * /*****************************************************/ 13215000 * 3435 13216000 * IF JRNLEDSW=OFF THEN/* IF NOT JOURNALED @Y301B26*/ 13217000 TM JRNLEDSW,B'00000001' 3435 13218000 BNZ @RF03435 3435 13219000 * CALL JOURNAL; /* JOURNAL THE RPLV @Y30LB26*/ 13220000 BAL @14,JOURNAL 3436 13221000 * RETURN; /* @Y30LB26*/ 13222000 B @EL00055 3437 13223000 * END; /* @Y301B26*/ 13224000 * 3438 13225000 * /*********************************************************/ 13226000 * /* */ 13227000 * /* SINCE THE EXTENSION RECORD HAS ONLY ONE @Y30LB26*/ 13228000 * /* SLOT IN IT AND IT IS TO BE REMOVED, JUST @Y30LB26*/ 13229000 * /* DELETE ENTIRE RECORD @Y30LB26*/ 13230000 * /* */ 13231000 * /*********************************************************/ 13232000 * 3439 13233000 * ELSE /* LAST SLOT IN RECORD @Y301B26*/ 13234000 * DO; /* SO DELETE IT @Y301B26*/ 13235000 @RF03418 DS 0H 3440 13236000 * RPLVTYP=RPLVDEL; /* INDICATE DELETE @Y301B26*/ 13237000 L @15,RPLVPTR 3440 13238000 MVI RPLVTYP(@15),X'05' 3440 13239000 * RESPECIFY 3441 13240000 * REG1 RSTD; /* RESTRICT REG 1 @Y301B26*/ 13241000 * REG1=RPLVPTR; /* ADDR RPLV @Y301B26*/ 13242000 LR REG1,@15 3442 13243000 * CALL ICBVIO00; /* DELETE EXTENSION @Y301B26*/ 13244000 L @15,@CV00671 3443 13245000 BALR @14,@15 3443 13246000 * RESPECIFY 3444 13247000 * REG1 UNRSTD; /* FREE REG 1 @Y301B26*/ 13248000 * IF RPLVRETC^=RCZERO THEN/* @Y30LB26*/ 13249000 L @01,RPLVPTR 3445 13250000 CLC RPLVRETC(2,@01),@CB00747 3445 13251000 BNE @RT03445 3445 13252000 * RETURN; /* @Y301B26*/ 13253000 * 3446 13254000 * /*****************************************************/ 13255000 * /* */ 13256000 * /* IF NOT PREVIOUSLY JOURNALED, JOURNAL @Y30LB26*/ 13257000 * /* THE RPLV @Y30LB26*/ 13258000 * /* */ 13259000 * /*****************************************************/ 13260000 * 3447 13261000 * IF JRNLEDSW=OFF THEN/* IF NOT JOURNALED @Y301B26*/ 13262000 TM JRNLEDSW,B'00000001' 3447 13263000 BNZ @RF03447 3447 13264000 * DO; /* @Y301B26*/ 13265000 * CALL JOURNAL; /* JOURNAL RPLV @Y301B26*/ 13266000 BAL @14,JOURNAL 3449 13267000 * IF RPLVRETC^=RCZERO THEN/* @Y30LB26*/ 13268000 L @01,RPLVPTR 3450 13269000 CLC RPLVRETC(2,@01),@CB00747 3450 13270000 BNE @RT03450 3450 13271000 * RETURN; /* @Y301B26*/ 13272000 * END; /* @Y301B26*/ 13273000 * 3452 13274000 * /*****************************************************/ 13275000 * /* */ 13276000 * /* CHECK TO SEE IF DELETED RECORD WAS @Y30LB26*/ 13277000 * /* THE LAST EXTENSION RECORD. IF IT WAS @Y30LB26*/ 13278000 * /* READ THE PREVIOUS EXTENSION RECORD @Y30LB26*/ 13279000 * /* */ 13280000 * /*****************************************************/ 13281000 * 3453 13282000 * IF GVSEX=OFF&LOOPSW=ON THEN/* LAST EXT REC @Y301B26*/ 13283000 @RF03447 TM GVSEX(GVSNEPTR),B'10000000' 3453 13284000 BNZ @RF03453 3453 13285000 TM LOOPSW,B'10000000' 3453 13286000 BNO @RF03453 3453 13287000 * DO; /* WITH PREV EXTENSIONS @Y301B26*/ 13288000 * RPLVKEY=ADDR(SAVEKEY);/* GET KEY PREV EXT 3455 13289000 * @Y301B26*/ 13290000 L @02,RPLVPTR 3455 13291000 LA @15,SAVEKEY 3455 13292000 ST @15,RPLVKEY(,@02) 3455 13293000 * RPLVBUF=ADDR(STORGPEX);/* ADDR OF BUFFER @Y301B26*/ 13294000 LA @15,STORGPEX 3456 13295000 ST @15,RPLVBUF(,@02) 3456 13296000 * RPLVBLN=LENGTH(STORGPEX);/* LENGTH BUFFER 3457 13297000 * @Y301B26*/ 13298000 MVC RPLVBLN(4,@02),@CF01148 3457 13299000 * RPLVLOC=OFF; /* @Y301B26*/ 13300000 * RPLVDIR=ON; /* READ DIRECT @Y301B26*/ 13301000 OI RPLVDIR(@02),B'01000000' 3459 13302000 NI RPLVLOC(@02),B'01111111' 3459 13303000 * RPLVTYP=RPLVREAD;/* READ REC @Y301B26*/ 13304000 MVI RPLVTYP(@02),X'00' 3460 13305000 * RPLVKGE=OFF; /* NO GT OR = @Y301B26*/ 13306000 NI RPLVKGE(@02),B'11111011' 3461 13307000 * RPLVUPD=ON; /* FOR UPDATE @Y301B26*/ 13308000 OI RPLVUPD(@02),B'00000010' 3462 13309000 * RESPECIFY 3463 13310000 * REG1 RSTD; /* RESTRICT @Y301B26*/ 13311000 * REG1=RPLVPTR; /* ADDR RPLV @Y301B26*/ 13312000 LR REG1,@02 3464 13313000 * CALL ICBVIO00; /* READ PREVIOUS EXTEN @Y301B26*/ 13314000 L @15,@CV00671 3465 13315000 BALR @14,@15 3465 13316000 * RESPECIFY 3466 13317000 * REG1 UNRSTD; /* FREE REG 1 @Y301B26*/ 13318000 * IF RPLVRETC^=RCZERO THEN/* @Y30LB26*/ 13319000 L @02,RPLVPTR 3467 13320000 CLC RPLVRETC(2,@02),@CB00747 3467 13321000 BNE @RT03467 3467 13322000 * RETURN; /* @Y301B26*/ 13323000 * GVSNEPTR=ADDR(STORGPEX);/* ADDR REC READ @Y30LB26*/ 13324000 * 3469 13325000 LA GVSNEPTR,STORGPEX 3469 13326000 * /*************************************************/ 13327000 * /* */ 13328000 * /* SET FLAG INDICATING THAT THIS IS NOW @Y30LB26*/ 13329000 * /* THE LAST EXTENSION RECORD @Y30LB26*/ 13330000 * /* */ 13331000 * /*************************************************/ 13332000 * 3470 13333000 * GVSEX=OFF; /* INDICATE LAST EXT REC @Y301B26*/ 13334000 * 3470 13335000 NI GVSEX(GVSNEPTR),B'01111111' 3470 13336000 * /*************************************************/ 13337000 * /* */ 13338000 * /* WRITE EXTENSION RECORD @Y30LB26*/ 13339000 * /* */ 13340000 * /*************************************************/ 13341000 * 3471 13342000 * RPLVTYP=RPLVPUT;/* PUT RECORD @Y301B26*/ 13343000 L @02,RPLVPTR 3471 13344000 MVI RPLVTYP(@02),X'01' 3471 13345000 * RESPECIFY 3472 13346000 * REG1 RSTD; /* RESTRICT @Y301B26*/ 13347000 * REG1=RPLVPTR; /* @Y30LB26*/ 13348000 LR REG1,@02 3473 13349000 * CALL ICBVIO00; /* WRITE EXTENSION REC @Y30LB26*/ 13350000 L @15,@CV00671 3474 13351000 BALR @14,@15 3474 13352000 * RESPECIFY 3475 13353000 * REG1 UNRSTD; /* @Y30LB26*/ 13354000 * IF RPLVRETC^=RCZERO THEN/* @Y30LB26*/ 13355000 L @02,RPLVPTR 3476 13356000 CLC RPLVRETC(2,@02),@CB00747 3476 13357000 BNE @RT03476 3476 13358000 * RETURN; /* @Y301B26*/ 13359000 * END; /* @Y301B26*/ 13360000 * RETURN; /* @Y30LB26*/ 13361000 B @EL00055 3479 13362000 * END; /* @Y301B26*/ 13363000 * END; /* @Y301B26*/ 13364000 * END; /* END INSIDE WHILE @Y301B26*/ 13365000 * 3482 13366000 @RF03402 LA @15,1 3482 13367000 SLR @14,@14 3482 13368000 IC @14,J 3482 13369000 ALR @15,@14 3482 13370000 @DE03401 STC @15,J 3482 13371000 LH @14,GVSESIND(,GVSNEPTR) 3482 13372000 BCTR @14,0 3482 13373000 CR @15,@14 3482 13374000 BNH @DL03401 3482 13375000 * /***************************************************************/ 13376000 * /* */ 13377000 * /* INDICATE AT LEAST ONE EXTENSION RECORD WAS FOUND @Y30LB26*/ 13378000 * /* SO THAT IF THE LAST ONE IS DELETED, A PREVIOUS @Y30LB26*/ 13379000 * /* READ CAN BE DONE @Y30LB26*/ 13380000 * /* */ 13381000 * /***************************************************************/ 13382000 * 3483 13383000 * LOOPSW=ON; /* INDIC FND AT LEAST 1 @Y30LB26*/ 13384000 OI LOOPSW,B'10000000' 3483 13385000 * SAVEKEY=GVSNAME; /* SAVE OLD KEY @Y301B26*/ 13386000 MVC SAVEKEY(13),GVSNAME(GVSNEPTR) 3484 13387000 * GKEY=GVSNAME; /* SET UP KEY FOR NEXT @Y30LB26*/ 13388000 MVC GKEY(13),GVSNAME(GVSNEPTR) 3485 13389000 * END; /* OUTSIDE WHILE LOOP @Y30LB26*/ 13390000 @DE03378 CLC I(1),I 3486 13391000 BE @DL03378 3486 13392000 * RETURN; /* @Y301B26*/ 13393000 B @EL00055 3487 13394000 * END DELETESL; /* @Y301B26*/ 13395000 B @EL00055 3488 13396000 * 3489 13397000 */* START OF SPECIFICATIONS **** 3489 13398000 * 3489 13399000 * PROCEDURE NAME - ICBVUEXP @Y30LB26 13400000 * 3489 13401000 * FUNCTION - THE ROUTINE USES A FORMULA THAT DOES TAKE INTO ACCOUNT 13402000 * LEAP YEAR WHEN CALCULATING THE JULIAN DATE. 3489 13403000 * IF A FOR DAYS OF 9999 IS PASSED TO THE ROUTINE, IT WILL 3489 13404000 * RETURN AN EXPIRATION DATE OF 99365. ALSO IF THE DAYS PASSED 3489 13405000 * CALCULATES OUT TO A VALUE OVER 99365, THEN 99365 IS RETURNED. 3489 13406000 * @Y30LB26 13407000 * 3489 13408000 * INPUT - A PARAMETER LIST WHICH CONTAINS THE NUMBER OF DAYS AHEAD 13409000 * TO MAKE THE EXPIRATION DATE AND A SPACE FOR THE EXPIRATION DATE 13410000 * TO BE RETURNED IN. @Y30LB26 13411000 * 3489 13412000 * OUTPUT - EXPIRATION DATE RETURNED IN THE PARAMETER LIST. 3489 13413000 * THERE ARE NO REASON OR RETURN CODES FROM THIS PROGRAM. @Y30LB26 13414000 * 3489 13415000 **** END OF SPECIFICATIONS ** */ 13416000 * 3489 13417000 *ICBVUEXP: 3489 13418000 * ENTRY(FOR,EXPDATE); /* @Y30LB26*/ 13419000 @EP03489 MVC @PC00001+40(8),0(@01) 3489 13420000 * DCL 3490 13421000 * FOR FIXED(15); /* NO DAYS TO EXPIRATION @Y30LB26*/ 13422000 * DCL 3491 13423000 * EXPDATE CHAR(4); /* RTNTN DATE PACKED DEC @Y30LB26*/ 13424000 * 3491 13425000 * /*****************************************************************/ 13426000 * /* */ 13427000 * /* SET UP VALUE IN PROGRAM AS IT WAS PASSED @Y30LB26*/ 13428000 * /* */ 13429000 * /*****************************************************************/ 13430000 * 3492 13431000 * FOREXP=FOR; /* DAYS TO EXPIRATION @Y30LB26*/ 13432000 * 3492 13433000 L @02,@PC00001+40 3492 13434000 LH FOREXP,FOR(,@02) 3492 13435000 * /*****************************************************************/ 13436000 * /* */ 13437000 * /* CALL INTERNAL PROCEDURE AND SET VALUE TO BE PASSED @Y30LB26*/ 13438000 * /* */ 13439000 * /*****************************************************************/ 13440000 * 3493 13441000 * CALL VUEXP; /* CALL INTER PROC @Y30LB26*/ 13442000 BAL @14,VUEXP 3493 13443000 * EXPDATE=RETDATE; /* EXPIRATION DATE @Y30LB26*/ 13444000 L @02,@PC00001+44 3494 13445000 MVC EXPDATE(4,@02),RETDATE 3494 13446000 * RETURN; /* @Y30LB26*/ 13447000 B @EL00001 3495 13448000 * 3496 13449000 * /*****************************************************************/ 13450000 * /* */ 13451000 * /* PROCEDURE VUEXP IS CODED SO THAT CODE CONTAINED @Y30LB26*/ 13452000 * /* IN ENTRY ICBVUEXP CAN BE USED BY BOTH THIS MODULE @Y30LB26*/ 13453000 * /* AND BY OTHER MODULES @Y30LB26*/ 13454000 * /* */ 13455000 * /*****************************************************************/ 13456000 * 3496 13457000 *VUEXP: 3496 13458000 * PROC OPTIONS(SAVE(REG14)); /* @ZDR2053*/ 13459000 VUEXP ST @14,@SA00056 3496 13460000 * DCL 3497 13461000 * NRMYR FIXED(15) CONSTANT(365);/* NO DAYS YEAR @Y30LB26*/ 13462000 * DCL 3498 13463000 * LEAPYR FIXED(15) CONSTANT(366);/* NO DAYS LEAP YEAR @G24LB26*/ 13464000 * DCL 3499 13465000 * THOU FIXED(31) INIT(1000); /* 1000 @Y30LB26*/ 13466000 * DCL 3500 13467000 * DBLWORD CHAR(8) BDY(DWORD); /* TWO WORDS @Y30LB26*/ 13468000 * DCL 3501 13469000 * 1 DATE, 3501 13470000 * 2 DAY FIXED(15), /* NO DAYS @ZA13484*/ 13471000 * 2 YEAR FIXED(15); /* YEAR @ZA13484*/ 13472000 * RESPECIFY 3502 13473000 * (REG0, 3502 13474000 * REG1) RSTD; /* RESTRICT @Y30LB26*/ 13475000 * MAXDATE='0099365C'X; /* SET MAX DATE @Y30LB26*/ 13476000 * 3503 13477000 MVC MAXDATE(4),@CB00765 3503 13478000 * /*****************************************************************/ 13479000 * /* */ 13480000 * /* CHECK FOR RECOVERY REQUEST AND IF SO USE THE @ZA13484*/ 13481000 * /* DATE THE RPLV WAS CREATED. @ZA13484*/ 13482000 * /* */ 13483000 * /*****************************************************************/ 13484000 * 3504 13485000 * IF RPLJRCVY=ON&RPLVDATE^=NULLDATE THEN/* RECOVERY? @ZA13484*/ 13486000 L @07,RPLVPTR 3504 13487000 TM RPLJRCVY(@07),B'00000010' 3504 13488000 BNO @RF03504 3504 13489000 CLC RPLVDATE(4,@07),NULLDATE 3504 13490000 BE @RF03504 3504 13491000 * DATE=RPLVDATE; /* RPLV DATE @ZA13484*/ 13492000 MVC DATE(4),RPLVDATE(@07) 3505 13493000 * ELSE 3506 13494000 * DO; /* @ZA13484*/ 13495000 * 3506 13496000 B @RC03504 3506 13497000 @RF03504 DS 0H 3507 13498000 * /*************************************************************/ 13499000 * /* */ 13500000 * /* GET THE CURRENT DATE BY ISSUING THE TIME MACRO @Y30LB26*/ 13501000 * /* THEN CONVERT IT TO BINARY AND SEPERATE THE DAYS @Y30LB26*/ 13502000 * /* AND YEARS @Y30LB26*/ 13503000 * /* */ 13504000 * /*************************************************************/ 13505000 * 3507 13506000 * GENERATE; 3507 13507000 * /*@Y30LB26*/ 13508000 TIME DEC GET CURRENT DATE @Y30LB26 13509000 SR REG0,REG0 CLEAR REG0 @Y30LB26 13510000 ST REG0,DBLWORD CLEAR 1ST HALF DBL @Y30LB26 13511000 ST REG1,DBLWORD+4 DATE TO SECOND HALF @Y30LB26 13512000 CVB REG1,DBLWORD CONVERT TO BINARY @Y30LB26 13513000 D REG0,THOU SEPERATE DAY & YEAR @Y30LB26 13514000 STH REG0,DAY GET DAYS @Y30LB26 13515000 STH REG1,YEAR GET YEAR @Y30LB26 13516000 * END; /* @ZA13484*/ 13517000 * 3508 13518000 * /*****************************************************************/ 13519000 * /* */ 13520000 * /* ADD THE FOR DAYS TO THE CURRENT DAYS @Y30LB26*/ 13521000 * /* */ 13522000 * /*****************************************************************/ 13523000 * 3509 13524000 * DAY=DAY+FOREXP; /* ADD FOR DAYS @Y30LB26*/ 13525000 @RC03504 LR @07,FOREXP 3509 13526000 AH @07,DAY 3509 13527000 STH @07,DAY 3509 13528000 * I=ZERO; /* INIT LOOP SWITCH @Y30LB26*/ 13529000 MVI I,X'00' 3510 13530000 * DO WHILE I=ZERO; /* OUTSIDE LOOP @Y30LB26*/ 13531000 * 3511 13532000 B @DE03511 3511 13533000 @DL03511 DS 0H 3512 13534000 * /***************************************************************/ 13535000 * /* */ 13536000 * /* DIVIDE BY FOUR AND CHECK THE REMAINDER TO SEE IF @Y30LB26*/ 13537000 * /* IT IS A LEAP YEAR @Y30LB26*/ 13538000 * /* */ 13539000 * /***************************************************************/ 13540000 * 3512 13541000 * IF YEAR//4=ZERO THEN /* LEAP YEAR? @Y30LB26*/ 13542000 LH @04,YEAR 3512 13543000 LR @06,@04 3512 13544000 SRDA @06,32 3512 13545000 D @06,@CF00045 3512 13546000 LTR @06,@06 3512 13547000 BNZ @RF03512 3512 13548000 * DO; /* @Y30LB26*/ 13549000 * 3513 13550000 * /***********************************************************/ 13551000 * /* */ 13552000 * /* IF LEAP YEAR, SEE IF MORE THAN 366 DAYS @G24LB26*/ 13553000 * /* */ 13554000 * /***********************************************************/ 13555000 * 3514 13556000 * IF DAY>LEAPYR THEN /* ENOUGH MAKE A YR? @ZA13056*/ 13557000 * 3514 13558000 LH @02,DAY 3514 13559000 LA @15,366 3514 13560000 CR @02,@15 3514 13561000 BNH @RF03514 3514 13562000 * /*********************************************************/ 13563000 * /* */ 13564000 * /* SUBTRACT 366 FROM DAYS AND ADD ONE YEAR, @G24LB26*/ 13565000 * /* GO BACK TO START OF LOOP @Y30LB26*/ 13566000 * /* */ 13567000 * /*********************************************************/ 13568000 * 3515 13569000 * DO; /* @Y30LB26*/ 13570000 * DAY=DAY-LEAPYR; /* SUBTRACT 366 @G24LB26*/ 13571000 SLR @02,@15 3516 13572000 STH @02,DAY 3516 13573000 * YEAR=YEAR+1; /* ADD YEAR @Y30LB26*/ 13574000 AL @04,@CF00041 3517 13575000 STH @04,YEAR 3517 13576000 * END; /* @Y30LB26*/ 13577000 * 3518 13578000 * /***********************************************************/ 13579000 * /* */ 13580000 * /* OTHERWISE DROP OUT OF LOOP @Y30LB26*/ 13581000 * /* */ 13582000 * /***********************************************************/ 13583000 * 3519 13584000 * ELSE /* @Y30LB26*/ 13585000 * I=1; /* GET OUT LOOP @Y30LB26*/ 13586000 B @RC03514 3519 13587000 @RF03514 MVI I,X'01' 3519 13588000 * END; /* @Y30LB26*/ 13589000 * 3520 13590000 * /***************************************************************/ 13591000 * /* */ 13592000 * /* IF IT IS NOT A LEAP YEAR, SEE IF THERE ARE 365 DAYS @Y30LB26*/ 13593000 * /* */ 13594000 * /***************************************************************/ 13595000 * 3521 13596000 * ELSE /* @Y30LB26*/ 13597000 * IF DAY>NRMYR THEN /* ENOUGH FOR YEAR @ZA13056*/ 13598000 * 3521 13599000 B @RC03512 3521 13600000 @RF03512 LH @04,DAY 3521 13601000 LA @02,365 3521 13602000 CR @04,@02 3521 13603000 BNH @RF03521 3521 13604000 * /***********************************************************/ 13605000 * /* */ 13606000 * /* IF MORE THAN 365, SUBTRACT 365, ADD ONE @Y30LB26*/ 13607000 * /* YEAR AND GO BACK TO START OF LOOP @Y30LB26*/ 13608000 * /* */ 13609000 * /***********************************************************/ 13610000 * 3522 13611000 * DO; /* @Y30LB26*/ 13612000 * DAY=DAY-NRMYR; /* SUBTRACT 365 @Y30LB26*/ 13613000 SLR @04,@02 3523 13614000 STH @04,DAY 3523 13615000 * YEAR=YEAR+1; /* ADD TO YEAR @Y30LB26*/ 13616000 LA @04,1 3524 13617000 AH @04,YEAR 3524 13618000 STH @04,YEAR 3524 13619000 * END; /* @Y30LB26*/ 13620000 * 3525 13621000 * /***************************************************************/ 13622000 * /* */ 13623000 * /* IF NOT 365 DAYS, DROP OUT OF LOOP @Y30LB26*/ 13624000 * /* */ 13625000 * /***************************************************************/ 13626000 * 3526 13627000 * ELSE /* @Y30LB26*/ 13628000 * I=1; /* GET OUT OF LOOP @Y30LB26*/ 13629000 B @RC03521 3526 13630000 @RF03521 MVI I,X'01' 3526 13631000 * END; /* END WHILE LOOP @Y30LB26*/ 13632000 * 3527 13633000 @RC03521 DS 0H 3527 13634000 @RC03512 DS 0H 3527 13635000 @DE03511 CLI I,0 3527 13636000 BE @DL03511 3527 13637000 * /*****************************************************************/ 13638000 * /* */ 13639000 * /* MULT YEARS BY 1000 AND ADD DAYS TO GET YEARS AND @Y30LB26*/ 13640000 * /* DAYS BACK TOGATHER AGAIN. THEN CONVERT TO DECIMAL @Y30LB26*/ 13641000 * /* */ 13642000 * /*****************************************************************/ 13643000 * 3528 13644000 * REG1=YEAR*THOU; /* MULT @Y30LB26*/ 13645000 L REG1,THOU 3528 13646000 MH REG1,YEAR 3528 13647000 * REG1=REG1+DAY; /* GET WHOLE DATE @Y30LB26*/ 13648000 AH REG1,DAY 3529 13649000 * GEN(CVD REG1,DBLWORD); /* CONVERT TO DEC @Y30LB26*/ 13650000 * 3530 13651000 CVD REG1,DBLWORD 13652000 * /*****************************************************************/ 13653000 * /* */ 13654000 * /* MOVE NEW DATE INTO RETURN PARAMETER @Y30LB26*/ 13655000 * /* */ 13656000 * /*****************************************************************/ 13657000 * 3531 13658000 * RETDATE=DBLWORD(5:8); /* GET DATE @Y30LB26*/ 13659000 MVC RETDATE(4),DBLWORD+4 3531 13660000 * RESPECIFY 3532 13661000 * (REG0, 3532 13662000 * REG1) UNRSTD; /* FREE REGS @Y30LB26*/ 13663000 * 3532 13664000 * /*****************************************************************/ 13665000 * /* */ 13666000 * /* IF CALCULATED DATE IS OVER THE MAX ALLOWED DATE, @Y30LB26*/ 13667000 * /* THEN PUT IN THE MAXIMUM DATE @Y30LB26*/ 13668000 * /* */ 13669000 * /*****************************************************************/ 13670000 * 3533 13671000 * IF RETDATE>MAXDATE THEN /* SEE IF TOO BIG @Y30LB26*/ 13672000 CLC RETDATE(4),MAXDATE 3533 13673000 BNH @RF03533 3533 13674000 * RETDATE=MAXDATE; /* SET MAX DATE @Y30LB26*/ 13675000 MVC RETDATE(4),MAXDATE 3534 13676000 * RETURN; /* @Y30LB26*/ 13677000 @EL00056 DS 0H 3535 13678000 @EF00056 DS 0H 3535 13679000 @ER00056 L @14,@SA00056 3535 13680000 BR @14 3535 13681000 * END VUEXP; /* @Y30LB26*/ 13682000 B @EL00056 3536 13683000 * END ICBVUT01 /* @Y30LB26*/ 13684000 * 3537 13685000 */* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. */ 13686000 */*%INCLUDE SYSLIB (IEZRPLV ) */ 13687000 */*%INCLUDE SYSLIB (IEZVVICB) */ 13688000 */*%INCLUDE SYSLIB (IEZNGVR ) */ 13689000 */*%INCLUDE SYSLIB (IEZBCDV ) */ 13690000 */*%INCLUDE SYSLIB (IEZGROUP) */ 13691000 */*%INCLUDE SYSLIB (IEZGVSNE) */ 13692000 */*%INCLUDE SYSLIB (IEZBASEV) */ 13693000 */*%INCLUDE SYSLIB (IEZCOPYV) */ 13694000 */*%INCLUDE SYSLIB (IEZDUPV ) */ 13695000 */*%INCLUDE SYSLIB (IEZINDEX) */ 13696000 */*%INCLUDE SYSLIB (IEZCPUID) */ 13697000 */*%INCLUDE SYSLIB (IEZRVR ) */ 13698000 */*%INCLUDE SYSLIB (IEZMGP ) */ 13699000 */*%INCLUDE SYSLIB (IEZSGP ) */ 13700000 */*%INCLUDE SYSLIB (IEZRVVI ) */ 13701000 */*%INCLUDE SYSLIB (IEZMVR ) */ 13702000 * 3537 13703000 * ; 3537 13704000 B @EL00001 3537 13705000 @DATA DS 0H 13706000 @CH01149 DC H'20' 13707000 @CH00688 DC H'256' 13708000 @CH00890 DC H'404' 13709000 @SC01176 CLC MGPGROUP(0,@07),0(@15) 13710000 DS 0F 13711000 @AL00733 EQU * LIST WITH 4 ARGUMENT(S) 13712000 @AL00753 EQU * LIST WITH 4 ARGUMENT(S) 13713000 @AL02719 EQU * LIST WITH 4 ARGUMENT(S) 13714000 @AL02729 DC A(@CF00039) LIST WITH 4 ARGUMENT(S) 13715000 DC A(BASEVPTR) 13716000 DC A(RPLVPTR) 13717000 DC A(PASSFLAG) 13718000 @AL00845 EQU * LIST WITH 4 ARGUMENT(S) 13719000 @AL02585 EQU * LIST WITH 4 ARGUMENT(S) 13720000 @AL02681 DC A(GROUPPTR) LIST WITH 4 ARGUMENT(S) 13721000 DC A(BASEVPTR) 13722000 DC A(RPLVPTR) 13723000 DC A(PASSFLAG) 13724000 @AL02577 EQU * LIST WITH 3 ARGUMENT(S) 13725000 @AL02665 EQU * LIST WITH 3 ARGUMENT(S) 13726000 @AL02764 EQU * LIST WITH 3 ARGUMENT(S) 13727000 @AL02852 DC A(GROUPPTR) LIST WITH 3 ARGUMENT(S) 13728000 DC A(BASEVPTR) 13729000 DC A(PASSFLAG) 13730000 DS 0F 13731000 @SA00001 DS 18F 13732000 @PC00001 DS 12F 13733000 @SA00008 DS 1F 13734000 @SA00002 DS 1F 13735000 @SA00004 DS 18F 13736000 @SA00007 DS 1F 13737000 @SA00038 DS 1F 13738000 @SA00015 DS 1F 13739000 @SA00003 DS 1F 13740000 @SA00005 DS 1F 13741000 @SA00006 DS 1F 13742000 @SA00052 DS 1F 13743000 @SA00009 DS 1F 13744000 @SA00012 DS 1F 13745000 @SA00010 DS 1F 13746000 @SA00011 DS 1F 13747000 @SA00051 DS 1F 13748000 @SA00014 DS 1F 13749000 @SA00013 DS 1F 13750000 @SA00017 DS 1F 13751000 @SA00018 DS 1F 13752000 @SA00019 DS 1F 13753000 @SA00021 DS 1F 13754000 @SA00022 DS 1F 13755000 @SA00023 DS 1F 13756000 @SA00029 DS 1F 13757000 @SA00030 DS 1F 13758000 @SA00031 DS 1F 13759000 @SA00033 DS 1F 13760000 @SA00032 DS 1F 13761000 @SA00016 DS 1F 13762000 @SA00036 DS 1F 13763000 @SA00037 DS 1F 13764000 @SA00020 DS 1F 13765000 @SA00024 DS 1F 13766000 @SA00025 DS 1F 13767000 @SA00028 DS 1F 13768000 @SA00026 DS 1F 13769000 @SA00027 DS 1F 13770000 @SA00034 DS 1F 13771000 @SA00056 DS 1F 13772000 @SA00039 DS 1F 13773000 @SA00046 DS 1F 13774000 @SA00040 DS 1F 13775000 @SA00042 DS 1F 13776000 @SA00041 DS 1F 13777000 @SA00047 DS 1F 13778000 @SA00043 DS 1F 13779000 @SA00045 DS 1F 13780000 @SA00044 DS 1F 13781000 @SA00055 DS 1F 13782000 @SA00053 DS 1F 13783000 @PC00054 DS 1F 13784000 @SA00035 DS 0F 13785000 @SA00048 DS 0F 13786000 @SA00050 DS 0F 13787000 @SA00049 DS 0F 13788000 DS 1F 13789000 @TF00001 DS F 13790000 DS 0F 13791000 @CF00039 DC F'0' 13792000 @CF00041 DC F'1' 13793000 @CH00041 EQU @CF00041+2 13794000 @CF00058 DC F'2' 13795000 @CF00045 DC F'4' 13796000 @CF00036 DC F'8' 13797000 @CF01150 DC F'49' 13798000 @CF00892 DC F'100' 13799000 @CF01146 DC F'164' 13800000 @CF01147 DC F'224' 13801000 @CF01148 DC F'988' 13802000 @CF01186 DC XL4'0000FFFF' 13803000 @CV00671 DC V(ICBVIO00) 13804000 @CV00672 DC V(ICBVJL00) 13805000 @CV00673 DC V(ICBVRR00) 13806000 @CV00674 DC V(ICBVUCHI) 13807000 @CV00675 DC V(ICBVUCHO) 13808000 @CV00676 DC V(ICBVUPGH) 13809000 DS 0D 13810000 RPLVPTR DS A 13811000 GROUPPTR DS A 13812000 BASEVPTR DS A 13813000 COPYVPTR DS A 13814000 DUPVPTR DS A 13815000 RVRPTR DS A 13816000 MVRPTR DS A 13817000 FIXF DC XL4'FFFFFFFF' 13818000 THOU DC F'1000' 13819000 RVRLEN DC AL2(24) 13820000 MGPLEN DC AL2(104) 13821000 SGPLEN DC AL2(20) 13822000 RVVLEN DC AL2(68) 13823000 MVRLEN DC AL2(88) 13824000 LIBTEST DC XL1'FF' 13825000 I DS FL1 13826000 J DS FL1 13827000 @CB00765 DC X'0099365C' 13828000 @CB00747 DC X'0000' 13829000 @CB00749 DC X'0004' 13830000 @CB00785 DC X'0213' 13831000 @CB00787 DC X'0214' 13832000 @CB00789 DC X'0208' 13833000 @CB00793 DC X'0217' 13834000 @CB00795 DC X'0218' 13835000 @CB00797 DC X'0219' 13836000 @CB00799 DC X'021A' 13837000 @CB00801 DC X'0229' 13838000 @CB00803 DC X'0201' 13839000 @CB00805 DC X'021C' 13840000 @CB00807 DC X'021D' 13841000 @CB00809 DC X'021E' 13842000 @CB00811 DC X'021F' 13843000 @CB00813 DC X'0220' 13844000 @CB00815 DC X'0221' 13845000 @CB00817 DC X'0222' 13846000 @CB00819 DC X'0223' 13847000 @CB00821 DC X'0224' 13848000 @CB00823 DC X'0225' 13849000 @CB00825 DC X'0227' 13850000 @CB00827 DC X'0228' 13851000 @CB00829 DC X'0226' 13852000 @CB00831 DC X'022A' 13853000 @CB00833 DC X'0230' 13854000 @CB00835 DC X'0202' 13855000 @CB00839 DC X'0205' 13856000 @CB00841 DC X'023C' 13857000 REACODE DS CL2 13858000 RETCODE DS CL2 13859000 STORBASE DS CL224 13860000 STORGRP DS CL224 13861000 STORDUP DS CL224 13862000 STORINDX DS CL224 13863000 STORCPY DS CL224 13864000 DUMMYREC DS CL224 13865000 DUMGVSNE DS CL988 13866000 BASEREC DS CL224 13867000 STORGPEX DS CL988 13868000 SAVEKEY DS CL13 13869000 GKEY DS CL13 13870000 ORG GKEY 13871000 GKY DC CL3'G ' 13872000 GROUPKY DS CL8 13873000 GBLKKY DC CL1' ' 13874000 GIDKY DC XL1'00' 13875000 ORG GKEY+13 13876000 VKEY DS CL13 13877000 ORG VKEY 13878000 VKY DC CL5'V ' 13879000 VOLKY DS CL6 13880000 VBLKKY DC CL1' ' 13881000 VIDKY DC XL1'00' 13882000 ORG VKEY+13 13883000 DKEY DS CL13 13884000 ORG DKEY 13885000 DKY DC CL5'D ' 13886000 DVOLKY DS CL6 13887000 DBLKKY DC CL1' ' 13888000 DIDKY DC XL1'00' 13889000 ORG DKEY+13 13890000 IKEY DS CL13 13891000 ORG IKEY 13892000 IKY DC CL1'I' 13893000 CARTKY DS CL12 13894000 ORG IKEY+13 13895000 NGHEADER DC CL13'N HEADER ' 13896000 CKEY DC CL13'C CPU ID ' 13897000 PASSFLAG DS BL2 13898000 ORG PASSFLAG 13899000 DUPBCHI DS BL1 13900000 FCHNDBR EQU PASSFLAG+0 13901000 LCHNDBR EQU PASSFLAG+0 13902000 CHICHOGP EQU PASSFLAG+0 13903000 ADDGRP EQU PASSFLAG+0 13904000 RESV EQU PASSFLAG+0 13905000 ADDSLEXT EQU PASSFLAG+0 13906000 JRNLEDSW EQU PASSFLAG+0 13907000 SLOTEXP DS BL1 13908000 ORG PASSFLAG+2 13909000 INTERFLG DS BL1 13910000 ORG INTERFLG 13911000 LOOPSW DS BL1 13912000 BKUPFND EQU INTERFLG+0 13913000 BACKUPFL EQU INTERFLG+0 13914000 DUPFNDFL EQU INTERFLG+0 13915000 EXITVVIC EQU INTERFLG+0 13916000 EXITVJL EQU INTERFLG+0 13917000 REL3CONF EQU INTERFLG+0 13918000 ORG INTERFLG+1 13919000 SAVEPREV DS CL6 13920000 SAVENEXT DS CL6 13921000 RETDATE DS CL4 13922000 NULEXPDT DC X'FFFFFFFF' 13923000 NULLDATE DC X'00000000' 13924000 MAXDATE DC X'0099365C' 13925000 BLANK8 DC CL8' ' 13926000 ZEROCHAR DC X'000000000000000000000000' 13927000 SYSGROUP DC CL8'SYSGROUP' 13928000 DS CL1 13929000 ARITHBAS DS CL2 13930000 ORG ARITHBAS 13931000 BASEID DS FL2 13932000 ORG ARITHBAS+2 13933000 ARITHGRP DS CL2 13934000 ORG ARITHGRP 13935000 GRPID DS FL2 13936000 ORG ARITHGRP+2 13937000 ARITHCTG DS CL1 13938000 ORG ARITHCTG 13939000 CARTID DS FL1 13940000 ORG ARITHCTG+1 13941000 UT1PATCH DS CL200 13942000 ORG UT1PATCH 13943000 @NM00051 DC 200X'00' 13944000 ORG UT1PATCH+200 13945000 TEST1 DS CL256 13946000 ORG TEST1 13947000 TESTINIT DC 64X'01' 13948000 DC X'00' 13949000 DC 26X'01' 13950000 DC X'00' 13951000 DC 31X'01' 13952000 DC 2X'00' 13953000 DC 68X'01' 13954000 DC 9X'00' 13955000 DC 7X'01' 13956000 DC 9X'00' 13957000 DC 8X'01' 13958000 DC 8X'00' 13959000 DC 6X'01' 13960000 DC 10X'00' 13961000 DC 6X'01' 13962000 ORG TEST1+256 13963000 EXPIR DS CL4 13964000 DS CL5 13965000 DBLWORD DS CL8 13966000 DATE DS CL4 13967000 ORG DATE 13968000 DAY DS FL2 13969000 YEAR DS FL2 13970000 ORG DATE+4 13971000 @00 EQU 00 EQUATES FOR REGISTERS 0-15 13972000 @01 EQU 01 13973000 @02 EQU 02 13974000 @03 EQU 03 13975000 @04 EQU 04 13976000 @05 EQU 05 13977000 @06 EQU 06 13978000 @07 EQU 07 13979000 @08 EQU 08 13980000 @09 EQU 09 13981000 @10 EQU 10 13982000 @11 EQU 11 13983000 @12 EQU 12 13984000 @13 EQU 13 13985000 @14 EQU 14 13986000 @15 EQU 15 13987000 IS EQU @04 13988000 COUNT EQU @06 13989000 FOREXP EQU @06 13990000 RVVIPTR EQU @05 13991000 SGPPTR EQU @05 13992000 MGPPTR EQU @06 13993000 CPUIDPTR EQU @04 13994000 INDEXPTR EQU @07 13995000 GVSNEPTR EQU @02 13996000 BCDVPTR EQU @05 13997000 NGVRPTR EQU @04 13998000 VVIPTR EQU @04 13999000 REG0 EQU @00 14000000 REG1 EQU @01 14001000 REG2 EQU @02 14002000 REG4 EQU @04 14003000 REG5 EQU @05 14004000 REG6 EQU @06 14005000 REG7 EQU @07 14006000 REG14 EQU @14 14007000 REG15 EQU @15 14008000 RPLV EQU 0 14009000 RPLTCBPR EQU RPLV+8 14010000 RPLVVICB EQU RPLV+12 14011000 RPLFLAGA EQU RPLV+28 14012000 RPLJRCVY EQU RPLFLAGA 14013000 RPLVJRNL EQU RPLFLAGA 14014000 RPLRCODE EQU RPLV+32 14015000 RPLVRETC EQU RPLV+34 14016000 RPLVDATE EQU RPLV+38 14017000 RPLVSAM EQU RPLV+56 14018000 RPLVTYP EQU RPLVSAM+2 14019000 RPLVBUF EQU RPLVSAM+32 14020000 RPLVKEY EQU RPLVSAM+36 14021000 RPLVOPT EQU RPLVSAM+40 14022000 RPLVLOC EQU RPLVOPT 14023000 RPLVDIR EQU RPLVOPT 14024000 RPLVNEXT EQU RPLVOPT 14025000 RPLVKGE EQU RPLVOPT 14026000 RPLVUPD EQU RPLVOPT+1 14027000 RPLVRLN EQU RPLVSAM+48 14028000 RPLVBLN EQU RPLVSAM+52 14029000 RPLVUTIL EQU RPLV+132 14030000 VVICB EQU 0 14031000 VVIFLGA EQU VVICB+15 14032000 VVIFLG0 EQU VVIFLGA 14033000 VVIFLG2 EQU VVIFLGA 14034000 NGVR EQU 0 14035000 NGVRTYPE EQU NGVR+13 14036000 NGVFVOL EQU NGVR+17 14037000 NGVNOVOL EQU NGVR+30 14038000 BCDV EQU 0 14039000 BCDNAME EQU BCDV 14040000 BCDPREFX EQU BCDNAME 14041000 BCDID EQU BCDNAME+11 14042000 BCDFLAGA EQU BCDV+14 14043000 BCDTYPE EQU BCDFLAGA 14044000 BCDFLAGB EQU BCDFLAGA+2 14045000 BCDRCVYF EQU BCDV+20 14046000 BCDSATIA EQU BCDRCVYF 14047000 BCDMISCF EQU BCDRCVYF+2 14048000 BCDHOLD EQU BCDMISCF 14049000 BCDCSN1 EQU BCDV+24 14050000 BCDLIB1 EQU BCDV+36 14051000 BCDLID1 EQU BCDLIB1 14052000 BCDCSN2 EQU BCDV+37 14053000 BCDLIB2 EQU BCDV+49 14054000 BCDLID2 EQU BCDLIB2 14055000 GROUP EQU 0 14056000 GRONAME EQU GROUP 14057000 GROG EQU GRONAME 14058000 GROVVGRP EQU GRONAME+3 14059000 GROID EQU GRONAME+11 14060000 GROZERO EQU GROID+1 14061000 GROFLAGA EQU GROUP+13 14062000 GROTYPE EQU GROFLAGA 14063000 GROGVR EQU GROTYPE 14064000 GROBIND EQU GROFLAGA+2 14065000 GROEXCL EQU GROFLAGA+2 14066000 GRODAERA EQU GROFLAGA+2 14067000 GRORONLY EQU GROFLAGA+2 14068000 GRORLSE EQU GROFLAGA+2 14069000 GRORETN EQU GROFLAGA+2 14070000 GROFSN EQU GROUP+17 14071000 GROLSN EQU GROUP+23 14072000 GROPCENT EQU GROUP+29 14073000 GRONGEN EQU GROUP+30 14074000 GRONRSTD EQU GROUP+32 14075000 GRONINAC EQU GROUP+34 14076000 GROPSPD EQU GROUP+36 14077000 GROSSPD EQU GROUP+38 14078000 GROSTRSH EQU GROUP+40 14079000 GROFRESP EQU GROUP+44 14080000 GRORETPD EQU GROUP+52 14081000 GROERRTS EQU GROUP+56 14082000 GRODESCR EQU GROUP+64 14083000 GROCONUS EQU GROUP+94 14084000 GRORESSP EQU GROUP+95 14085000 GROOWNER EQU GROUP+96 14086000 GROADDR EQU GROUP+106 14087000 GVSNE EQU 0 14088000 GVSHDR EQU GVSNE 14089000 GVSNAME EQU GVSHDR 14090000 GVSVVGRP EQU GVSNAME+3 14091000 GVSID EQU GVSNAME+11 14092000 GVSFLAGA EQU GVSHDR+13 14093000 GVSTYPE EQU GVSFLAGA 14094000 GVSGVSEX EQU GVSTYPE 14095000 GVSEX EQU GVSFLAGA+2 14096000 GVSESIND EQU GVSHDR+18 14097000 GVSSLOTS EQU GVSNE+28 14098000 GVSVOLID EQU GVSSLOTS 14099000 GVSVOLFL EQU GVSSLOTS+6 14100000 GVSCPUBM EQU GVSVOLFL 14101000 GVSRCFSI EQU GVSVOLFL+2 14102000 GVSMTNSH EQU GVSVOLFL+2 14103000 GVSFRESP EQU GVSSLOTS+10 14104000 GVSLEXT EQU GVSSLOTS+12 14105000 GVSEXPDT EQU GVSSLOTS+14 14106000 GVSMTDSP EQU GVSSLOTS+18 14107000 BASEV EQU 0 14108000 BASNAME EQU BASEV 14109000 BASEVKEY EQU BASNAME 14110000 BASSERNO EQU BASNAME+5 14111000 BASID EQU BASNAME+11 14112000 BASZERO EQU BASID+1 14113000 BASFLAGA EQU BASEV+14 14114000 BASTYPE EQU BASFLAGA 14115000 BASBASVR EQU BASTYPE 14116000 BASDLSF EQU BASFLAGA+2 14117000 BASGRPV EQU BASFLAGA+2 14118000 BASGENUS EQU BASFLAGA+2 14119000 BASRSTD EQU BASFLAGA+2 14120000 BASINAC EQU BASFLAGA+2 14121000 BASBIND EQU BASFLAGA+2 14122000 BASEXCL EQU BASFLAGA+2 14123000 BASDAERA EQU BASFLAGA+3 14124000 BASRONLY EQU BASFLAGA+3 14125000 BASFIRST EQU BASFLAGA+3 14126000 BASLAST EQU BASFLAGA+3 14127000 BASCPUID EQU BASEV+18 14128000 BASRCVYF EQU BASEV+20 14129000 BASSATIA EQU BASRCVYF 14130000 BASIVCRE EQU BASSATIA 14131000 BASIVCPY EQU BASSATIA 14132000 BASVSMIS EQU BASSATIA 14133000 BASMISCF EQU BASRCVYF+2 14134000 BASHOLD EQU BASMISCF 14135000 BASCSN1 EQU BASEV+24 14136000 BASLIB1 EQU BASEV+36 14137000 BASLID1 EQU BASLIB1 14138000 BASCSN2 EQU BASEV+37 14139000 BASLIB2 EQU BASEV+49 14140000 BASLID2 EQU BASLIB2 14141000 BASPREV EQU BASEV+50 14142000 BASNEXTV EQU BASEV+56 14143000 BASNCOPY EQU BASEV+62 14144000 BASNBKUP EQU BASEV+63 14145000 BASBKLMT EQU BASEV+64 14146000 BASFRESP EQU BASEV+68 14147000 BASLEXT EQU BASEV+70 14148000 BASFREXT EQU BASEV+72 14149000 BASKLCPY EQU BASEV+76 14150000 BASCOPID EQU BASKLCPY+11 14151000 BASEXPDT EQU BASEV+96 14152000 BASDTREM EQU BASEV+100 14153000 BASDESCR EQU BASEV+104 14154000 BASOWNER EQU BASEV+134 14155000 BASDEST EQU BASEV+144 14156000 BASRECOV EQU BASEV+174 14157000 BASGROUP EQU BASEV+180 14158000 COPYV EQU 0 14159000 COPNAME EQU COPYV 14160000 COPV EQU COPNAME 14161000 COPSERNO EQU COPNAME+5 14162000 COPID EQU COPNAME+11 14163000 COPFLAGA EQU COPYV+14 14164000 COPTYPE EQU COPFLAGA 14165000 COPBKUP EQU COPFLAGA+2 14166000 COPRCVYF EQU COPYV+20 14167000 COPSATIA EQU COPRCVYF 14168000 COPIVCPY EQU COPSATIA 14169000 COPMISCF EQU COPRCVYF+2 14170000 COPHOLD EQU COPMISCF 14171000 COPLIB1 EQU COPYV+36 14172000 COPLID1 EQU COPLIB1 14173000 COPLIB2 EQU COPYV+49 14174000 COPLID2 EQU COPLIB2 14175000 COPDATE EQU COPYV+50 14176000 DUPV EQU 0 14177000 DUPNAME EQU DUPV 14178000 DUPD EQU DUPNAME 14179000 DUPSERNO EQU DUPNAME+5 14180000 DUPID EQU DUPNAME+11 14181000 DUPFLAGA EQU DUPV+14 14182000 DUPTYPE EQU DUPFLAGA 14183000 DUPRCVYF EQU DUPV+20 14184000 DUPCSN1 EQU DUPV+24 14185000 DUPLIB1 EQU DUPV+36 14186000 DUPLID1 EQU DUPLIB1 14187000 DUPCSN2 EQU DUPV+37 14188000 DUPLIB2 EQU DUPV+49 14189000 DUPLID2 EQU DUPLIB2 14190000 INDEX EQU 0 14191000 INDNAME EQU INDEX 14192000 INDI EQU INDNAME 14193000 INDTYPE EQU INDEX+13 14194000 INDRECKY EQU INDEX+15 14195000 INDPREFX EQU INDRECKY 14196000 INDVSRNO EQU INDRECKY+5 14197000 INDRECID EQU INDRECKY+11 14198000 INDEXREC EQU INDRECID+1 14199000 CPUID EQU 0 14200000 CPUTYPE EQU CPUID+18 14201000 CPUMAP EQU CPUID+20 14202000 RVR EQU 0 14203000 RVRCODE EQU RVR+4 14204000 RVROPCD EQU RVRCODE 14205000 RVRVOLID EQU RVR+8 14206000 RVRCPYID EQU RVR+15 14207000 RVRFLAGA EQU RVR+16 14208000 RVRBASEV EQU RVRFLAGA 14209000 RVRCOPYV EQU RVRFLAGA 14210000 MGP EQU 0 14211000 MGPCODE EQU MGP+4 14212000 MGPGROUP EQU MGP+8 14213000 MGPOWNER EQU MGP+16 14214000 MGPRI EQU MGP+26 14215000 MGPSEC EQU MGP+28 14216000 MGPRETPD EQU MGP+30 14217000 MGPTHOLD EQU MGP+32 14218000 MGPCONUS EQU MGP+33 14219000 MGPRESSP EQU MGP+34 14220000 MGPDESCR EQU MGP+36 14221000 MGPADDR EQU MGP+66 14222000 MGPFLAGA EQU MGP+96 14223000 MGPRLSE EQU MGPFLAGA 14224000 MGPNRLSE EQU MGPFLAGA 14225000 MGPBIND EQU MGPFLAGA 14226000 MGPNBIND EQU MGPFLAGA 14227000 MGPEXCL EQU MGPFLAGA 14228000 MGPSHARE EQU MGPFLAGA 14229000 MGPRONLY EQU MGPFLAGA 14230000 MGPRW EQU MGPFLAGA 14231000 MGPDERAS EQU MGPFLAGA+1 14232000 MGPNDERA EQU MGPFLAGA+1 14233000 MGPFLOWN EQU MGPFLAGA+1 14234000 MGPFLPRI EQU MGPFLAGA+1 14235000 MGPFLSEC EQU MGPFLAGA+1 14236000 MGPFLTHO EQU MGPFLAGA+1 14237000 MGPFLRET EQU MGPFLAGA+1 14238000 MGPFLDES EQU MGPFLAGA+2 14239000 MGPFLADD EQU MGPFLAGA+2 14240000 MGPNTHLD EQU MGPFLAGA+2 14241000 MGPNOWNR EQU MGPFLAGA+2 14242000 MGPNRETP EQU MGPFLAGA+2 14243000 MGPNDESC EQU MGPFLAGA+2 14244000 MGPNADDR EQU MGPFLAGA+2 14245000 MGPFLCON EQU MGPFLAGA+2 14246000 MGPFLRES EQU MGPFLAGA+3 14247000 SGP EQU 0 14248000 SGPCODE EQU SGP+4 14249000 SGPGROUP EQU SGP+8 14250000 RVVI EQU 0 14251000 RVVOPCOD EQU RVVI+4 14252000 RVVOLUME EQU RVVI+8 14253000 RVVGROUP EQU RVVI+14 14254000 RVVARLN EQU RVVI+22 14255000 RVVAREA EQU RVVI+24 14256000 RVVBUFLN EQU RVVI+30 14257000 RVVEXPIR EQU RVVI+36 14258000 RVVCDATE EQU RVVI+38 14259000 RVVRDSEQ EQU RVVI+43 14260000 RVVRDCSN EQU RVVI+44 14261000 RVVCPYID EQU RVVI+56 14262000 RVVDUPID EQU RVVI+57 14263000 RVVFLAGA EQU RVVI+58 14264000 RVVRMODE EQU RVVFLAGA 14265000 RVVRDR EQU RVVRMODE 14266000 RVVRDNR EQU RVVRMODE 14267000 RVVRDCH EQU RVVRMODE 14268000 RVVCHAIN EQU RVVFLAGA+1 14269000 RVVGPVOL EQU RVVCHAIN 14270000 RVVNGVOL EQU RVVCHAIN 14271000 RVVRDRCD EQU RVVFLAGA+2 14272000 RVVBVRCD EQU RVVRDRCD 14273000 RVVGRPRC EQU RVVRDRCD 14274000 RVVCPYRC EQU RVVRDRCD 14275000 RVVDUPRC EQU RVVRDRCD 14276000 RVVRUNKN EQU RVVRDRCD 14277000 RVVCIRCD EQU RVVRDRCD 14278000 RVVCPURC EQU RVVRDRCD 14279000 RVVALL EQU RVVRDRCD 14280000 RVVRTEST EQU RVVFLAGA+3 14281000 RVVEXPDT EQU RVVRTEST 14282000 RVVTHOLD EQU RVVRTEST 14283000 RVVGSVOL EQU RVVRTEST 14284000 RVVRSTD EQU RVVRTEST 14285000 RVVINACT EQU RVVRTEST 14286000 RVVACTV EQU RVVRTEST 14287000 RVVDVOL EQU RVVRTEST 14288000 RVVBPLHD EQU RVVRTEST 14289000 RVVCPYTP EQU RVVFLAGA+4 14290000 RVVLBKUP EQU RVVCPYTP 14291000 RVVOBKUP EQU RVVCPYTP 14292000 RVVLCOPY EQU RVVCPYTP 14293000 RVVCPLHD EQU RVVCPYTP 14294000 RVVSPEC EQU RVVFLAGA+5 14295000 RVVSGRP EQU RVVSPEC 14296000 RVVSDTE EQU RVVSPEC 14297000 RVVSSEQ EQU RVVSPEC 14298000 RVVSCSN EQU RVVSPEC 14299000 RVVSCPY EQU RVVSPEC 14300000 RVVSDUP EQU RVVSPEC 14301000 RVVSVOL EQU RVVSPEC 14302000 MVR EQU 0 14303000 MVRCODE EQU MVR+4 14304000 MVRFLAGA EQU MVR+8 14305000 MVRFLFOR EQU MVRFLAGA 14306000 MVRFLGRO EQU MVRFLAGA 14307000 MVRFLDES EQU MVRFLAGA 14308000 MVRFLTO EQU MVRFLAGA 14309000 MVRFLCSN EQU MVRFLAGA 14310000 MVRFLBK EQU MVRFLAGA 14311000 MVRFLLAB EQU MVRFLAGA 14312000 MVRGEN EQU MVRFLAGA+1 14313000 MVRRSTD EQU MVRFLAGA+1 14314000 MVRNGRP EQU MVRFLAGA+1 14315000 MVRBKUP EQU MVRFLAGA+1 14316000 MVRNDESC EQU MVRFLAGA+1 14317000 MVRNEXPD EQU MVRFLAGA+1 14318000 MVRSLMIS EQU MVRFLAGA+1 14319000 MVRCLMIS EQU MVRFLAGA+1 14320000 MVRCIVCF EQU MVRFLAGA+2 14321000 MVRCICPY EQU MVRFLAGA+2 14322000 MVRBVOL EQU MVR+12 14323000 MVRFOR EQU MVR+18 14324000 MVRGROUP EQU MVR+20 14325000 MVRDES EQU MVR+28 14326000 MVRTO EQU MVR+58 14327000 MVRCSN EQU MVR+62 14328000 MVRBKUPN EQU MVR+74 14329000 MVRLABEL EQU MVR+76 14330000 BUFFER EQU 0 14331000 DUPVDBR EQU 0 14332000 BASEVDBR EQU 0 14333000 RPLVDBR EQU 0 14334000 FLAGDBR EQU 0 14335000 SPREVDBR EQU 0 14336000 SNEXTDBR EQU 0 14337000 GRPEXT EQU 0 14338000 BASEXT EQU 0 14339000 RPLVEXT EQU 0 14340000 FLAGEXT EQU 0 14341000 NOSAVE EQU 0 14342000 FOR EQU 0 14343000 EXPDATE EQU 0 14344000 AGO .@UNREFD START UNREFERENCED COMPONENTS 14345000 @NM00050 EQU MVR+82 14346000 MVRBLNK1 EQU MVR+75 14347000 @NM00049 EQU MVRFLAGA+2 14348000 MVRFLBAS EQU MVRFLAGA 14349000 @NM00048 EQU MVRCODE+1 14350000 MVROPCD EQU MVRCODE 14351000 MVRLNGTH EQU MVR 14352000 @NM00047 EQU RVVI+64 14353000 RVVSEXP EQU RVVSPEC 14354000 @NM00046 EQU RVVCPYTP 14355000 @NM00045 EQU RVVCHAIN 14356000 @NM00044 EQU RVVRMODE 14357000 RVVBLNK1 EQU RVVI+42 14358000 RVVRTBUF EQU RVVI+32 14359000 @NM00043 EQU RVVI+28 14360000 @NM00042 EQU RVVOPCOD+1 14361000 RVVCODE EQU RVVOPCOD 14362000 RVVLNGTH EQU RVVI 14363000 @NM00041 EQU SGP+16 14364000 @NM00040 EQU SGPCODE+1 14365000 SGPOPCD EQU SGPCODE 14366000 SGPLNGTH EQU SGP 14367000 @NM00039 EQU MGP+100 14368000 @NM00038 EQU MGPFLAGA+3 14369000 MGPFLGRO EQU MGPFLAGA+1 14370000 @NM00037 EQU MGP+35 14371000 @NM00036 EQU MGPCODE+1 14372000 MGPOPCD EQU MGPCODE 14373000 MGPLNGTH EQU MGP 14374000 @NM00035 EQU RVR+20 14375000 @NM00034 EQU RVRFLAGA 14376000 RVRBLNK1 EQU RVR+14 14377000 @NM00033 EQU RVRCODE+1 14378000 RVRLNGTH EQU RVR 14379000 @NM00032 EQU CPUID+150 14380000 CPUPURGE EQU CPUID+148 14381000 CPUMASK EQU CPUMAP+6 14382000 @NM00031 EQU CPUMAP+5 14383000 CPUIDREC EQU CPUMAP 14384000 CPURES2 EQU CPUTYPE 14385000 CPUASSOC EQU CPUTYPE 14386000 CPURES1 EQU CPUTYPE 14387000 CPUDNEXT EQU CPUID+16 14388000 CPUINEXT EQU CPUID+14 14389000 @NM00030 EQU CPUID+13 14390000 CPUNAME EQU CPUID 14391000 @NM00029 EQU INDEX+28 14392000 INDBLNK2 EQU INDRECID 14393000 INDBLNK1 EQU INDPREFX+1 14394000 INDALPHA EQU INDPREFX 14395000 INDRES2 EQU INDTYPE 14396000 INDINDEX EQU INDTYPE 14397000 INDRES1 EQU INDTYPE 14398000 INDSERNO EQU INDNAME+1 14399000 @NM00028 EQU DUPV+50 14400000 DUP2BIT2 EQU DUPLID2 14401000 DUP2BIT1 EQU DUPLID2 14402000 DUPRES4 EQU DUPLIB2 14403000 DUP1BIT2 EQU DUPLID1 14404000 DUP1BIT1 EQU DUPLID1 14405000 DUPRES3 EQU DUPLIB1 14406000 DUPMISCF EQU DUPRCVYF+2 14407000 DUPSATIA EQU DUPRCVYF 14408000 @NM00027 EQU DUPV+18 14409000 @NM00026 EQU DUPFLAGA+2 14410000 DUPRES2 EQU DUPTYPE 14411000 DUPDUPLR EQU DUPTYPE 14412000 DUPRES1 EQU DUPTYPE 14413000 DUPRES5 EQU DUPV+13 14414000 DUPNO EQU DUPID+1 14415000 DUPBLANK EQU DUPID 14416000 @NM00025 EQU COPYV+136 14417000 COPFREXT EQU COPYV+132 14418000 COPLEXT EQU COPYV+130 14419000 COPFRESP EQU COPYV+128 14420000 COPOWNER EQU COPYV+118 14421000 COPDEST EQU COPYV+88 14422000 COPDESCR EQU COPYV+58 14423000 COPDTREM EQU COPYV+54 14424000 COP2BIT2 EQU COPLID2 14425000 COP2BIT1 EQU COPLID2 14426000 COPRES5 EQU COPLIB2 14427000 COPCSN2 EQU COPYV+37 14428000 COP1BIT2 EQU COPLID1 14429000 COP1BIT1 EQU COPLID1 14430000 COPRES4 EQU COPLIB1 14431000 COPCSN1 EQU COPYV+24 14432000 @NM00024 EQU COPMISCF 14433000 COPRES3 EQU COPSATIA 14434000 COPVSMIS EQU COPSATIA 14435000 COPIVCRE EQU COPSATIA 14436000 @NM00023 EQU COPYV+18 14437000 @NM00022 EQU COPFLAGA+3 14438000 COPDLSPF EQU COPFLAGA+3 14439000 COPRONLY EQU COPFLAGA+3 14440000 COPDAERA EQU COPFLAGA+2 14441000 COPEXCL EQU COPFLAGA+2 14442000 COPBIND EQU COPFLAGA+2 14443000 COPRSTD EQU COPFLAGA+2 14444000 COPGENUS EQU COPFLAGA+2 14445000 COPVSAM EQU COPFLAGA+2 14446000 COPGROUP EQU COPFLAGA+2 14447000 COPRES2 EQU COPTYPE 14448000 COPCOPYV EQU COPTYPE 14449000 COPRES1 EQU COPTYPE 14450000 COPRES6 EQU COPYV+13 14451000 COPNO EQU COPID+1 14452000 COPBLANK EQU COPID 14453000 @NM00021 EQU BASEV+192 14454000 BASXPDT2 EQU BASEV+188 14455000 BASDLMTD EQU BASEV+92 14456000 BASRES6 EQU BASEV+89 14457000 BASCOPNO EQU BASCOPID+1 14458000 BASCOPBK EQU BASCOPID 14459000 BASCOPSN EQU BASKLCPY+5 14460000 BASCOPV EQU BASKLCPY 14461000 @NM00020 EQU BASEV+65 14462000 BAS2BIT2 EQU BASLID2 14463000 BAS2BIT1 EQU BASLID2 14464000 BASRES5 EQU BASLIB2 14465000 BAS1BIT2 EQU BASLID1 14466000 BAS1BIT1 EQU BASLID1 14467000 BASRES4 EQU BASLIB1 14468000 BASRES3 EQU BASMISCF 14469000 BASRES8 EQU BASSATIA 14470000 @NM00019 EQU BASFLAGA+3 14471000 BASREASS EQU BASFLAGA+3 14472000 BASNOCPY EQU BASFLAGA+2 14473000 BASRES2 EQU BASTYPE 14474000 BASRES1 EQU BASTYPE 14475000 BASRES7 EQU BASEV+13 14476000 BASBLANK EQU BASID 14477000 @NM00018 EQU GVSVOLFL+2 14478000 @NM00017 EQU GVSHDR+20 14479000 @NM00016 EQU GVSHDR+17 14480000 @NM00015 EQU GVSFLAGA+2 14481000 @NM00014 EQU GVSTYPE 14482000 @NM00013 EQU GVSTYPE 14483000 GVSNO EQU GVSID+1 14484000 GVSRES1 EQU GVSID 14485000 GVSG EQU GVSNAME 14486000 @NM00012 EQU GROUP+136 14487000 GROERRTM EQU GROERRTS+4 14488000 GROERRDT EQU GROERRTS 14489000 GROFREXT EQU GROUP+48 14490000 @NM00011 EQU GROFLAGA+2 14491000 GROMSG1 EQU GROFLAGA+2 14492000 GRORES1 EQU GROTYPE 14493000 GROBLANK EQU GROID 14494000 BCD2BIT2 EQU BCDLID2 14495000 BCD2BIT1 EQU BCDLID2 14496000 BCDRES8 EQU BCDLIB2 14497000 BCD1BIT2 EQU BCDLID1 14498000 BCD1BIT1 EQU BCDLID1 14499000 BCDRE10 EQU BCDLIB1 14500000 BCDRES7A EQU BCDMISCF 14501000 BCDRES7 EQU BCDSATIA 14502000 BCDVSMIS EQU BCDSATIA 14503000 BCDIVCPY EQU BCDSATIA 14504000 BCDIVCRE EQU BCDSATIA 14505000 BCDCPUID EQU BCDV+18 14506000 BCDRES5 EQU BCDFLAGB+1 14507000 BCDREASS EQU BCDFLAGB+1 14508000 BCDRES4 EQU BCDFLAGB 14509000 BCDRES3 EQU BCDTYPE 14510000 BCDDUP EQU BCDTYPE 14511000 BCDRES2 EQU BCDTYPE 14512000 BCDCOPY EQU BCDTYPE 14513000 BCDBASE EQU BCDTYPE 14514000 BCDRES1 EQU BCDTYPE 14515000 BCDRES9 EQU BCDV+13 14516000 BCDINDEX EQU BCDID+1 14517000 BCDBLNK2 EQU BCDID 14518000 BCDSERNO EQU BCDNAME+5 14519000 BCDBLNK1 EQU BCDPREFX+1 14520000 BCDALPHA EQU BCDPREFX 14521000 @NM00010 EQU NGVR+32 14522000 @NM00009 EQU NGVR+29 14523000 NGVLVOL EQU NGVR+23 14524000 @NM00008 EQU NGVR+15 14525000 NGVRES2 EQU NGVRTYPE+1 14526000 NGVHDR EQU NGVRTYPE 14527000 NGVRES1 EQU NGVRTYPE 14528000 NGVNAME EQU NGVR 14529000 VVIUNUSD EQU VVICB+116 14530000 VVINUSDC EQU VVICB+112 14531000 VVITPFCH EQU VVICB+108 14532000 VVIDVMEL EQU VVICB+104 14533000 VVIVBSTF EQU VVICB+100 14534000 VVISSOBA EQU VVICB+96 14535000 VVIVSCRA EQU VVICB+92 14536000 VVISTPTB EQU VVICB+88 14537000 VVIDVMTA EQU VVICB+84 14538000 VVIJUCB EQU VVICB+80 14539000 VVIIUCB EQU VVICB+76 14540000 VVIRES6 EQU VVICB+72 14541000 VVIRES5 EQU VVICB+68 14542000 VVIRES4 EQU VVICB+64 14543000 VVIUCB EQU VVICB+60 14544000 VVIVJL EQU VVICB+56 14545000 VVIVRR EQU VVICB+52 14546000 VVIQLSPL EQU VVICB+48 14547000 VVIQRPL2 EQU VVICB+44 14548000 VVIQRPL1 EQU VVICB+40 14549000 VVIRES3 EQU VVICB+36 14550000 VVIVQMP EQU VVICB+32 14551000 VVIECB1 EQU VVICB+28 14552000 VVICATAD EQU VVICB+24 14553000 VVIDCBAD EQU VVICB+20 14554000 VVIACBAD EQU VVICB+16 14555000 VVIFLG7 EQU VVIFLGA 14556000 VVIFLG6 EQU VVIFLGA 14557000 VVIFLG5 EQU VVIFLGA 14558000 VVIFLG4 EQU VVIFLGA 14559000 VVIFLG3 EQU VVIFLGA 14560000 VVIFLG1 EQU VVIFLGA 14561000 VVIALCON EQU VVICB+14 14562000 VVICPUID EQU VVICB+12 14563000 VVIUCAT EQU VVICB+4 14564000 VVICID EQU VVICB 14565000 @NM00007 EQU RPLVSAM+44 14566000 @NM00006 EQU RPLVOPT 14567000 @NM00005 EQU RPLVOPT 14568000 @NM00004 EQU RPLVSAM+28 14569000 RPLVACB EQU RPLVSAM+24 14570000 @NM00003 EQU RPLVSAM+3 14571000 @NM00002 EQU RPLVSAM 14572000 @NM00001 EQU RPLV+42 14573000 RPLRMSCC EQU RPLV+36 14574000 RPLVTLEN EQU RPLV+30 14575000 RPLVRES1 EQU RPLFLAGA+1 14576000 RPLVVOP EQU RPLFLAGA 14577000 RPLVVIN EQU RPLFLAGA 14578000 RPLVCOMP EQU RPLFLAGA 14579000 RPLVPROG EQU RPLFLAGA 14580000 RPLVPOST EQU RPLFLAGA 14581000 RPLFTIME EQU RPLFLAGA 14582000 RPLVRSV3 EQU RPLV+24 14583000 RPLVRSV2 EQU RPLV+20 14584000 RPLVRSV1 EQU RPLV+16 14585000 RPLASCBP EQU RPLTCBPR 14586000 RPLVECB EQU RPLV+4 14587000 RPLVQPTR EQU RPLV 14588000 .@UNREFD ANOP END UNREFERENCED COMPONENTS 14589000 @RF00189 EQU @EL00001 14590000 @RF00191 EQU @EL00001 14591000 @RF00199 EQU @EL00001 14592000 @RF00201 EQU @EL00001 14593000 @RF00209 EQU @EL00001 14594000 @RF00211 EQU @EL00001 14595000 @RF00219 EQU @EL00001 14596000 @RF00221 EQU @EL00001 14597000 @RF00229 EQU @EL00001 14598000 @RF00231 EQU @EL00001 14599000 @RT00249 EQU @EL00002 14600000 @RT00448 EQU @EL00004 14601000 @RT00453 EQU @EL00004 14602000 @RF00456 EQU @EL00004 14603000 @RT00464 EQU @EL00005 14604000 @RT00511 EQU @EL00006 14605000 @RT00685 EQU @EL00009 14606000 @RF00716 EQU @RC00709 14607000 @RT00726 EQU @EL00009 14608000 @RF00742 EQU @EL00009 14609000 @RF00770 EQU @EL00009 14610000 @RT00786 EQU @EL00010 14611000 @RT00818 EQU @EL00010 14612000 @RF00815 EQU @EL00010 14613000 @RF00873 EQU @EL00011 14614000 @RT00907 EQU @EL00012 14615000 @RT00935 EQU @EL00012 14616000 @RF00969 EQU @EL00012 14617000 @RT01071 EQU @EL00014 14618000 @RF01056 EQU @RC01053 14619000 @RF01068 EQU @RC01053 14620000 @RT01111 EQU @EL00014 14621000 @RF01095 EQU @RC01092 14622000 @RT01254 EQU @EL00016 14623000 @RT01286 EQU @EL00017 14624000 @RT01339 EQU @EL00018 14625000 @RT01380 EQU @EL00019 14626000 @RT01382 EQU @EL00019 14627000 @RF01411 EQU @RC01409 14628000 @RT01444 EQU @EL00019 14629000 @RT01493 EQU @EL00020 14630000 @RT01497 EQU @EL00020 14631000 @RT01527 EQU @EL00021 14632000 @RT01542 EQU @EL00021 14633000 @RT01580 EQU @EL00022 14634000 @RT01594 EQU @EL00022 14635000 @RC01575 EQU @RC01573 14636000 @RT01675 EQU @EL00024 14637000 @RT01689 EQU @EL00024 14638000 @RC01665 EQU @RC01663 14639000 @RT01756 EQU @EL00026 14640000 @RC01776 EQU @RC01774 14641000 @RT01804 EQU @EL00026 14642000 @RT01844 EQU @EL00027 14643000 @RT01898 EQU @EL00028 14644000 @RT01937 EQU @EL00029 14645000 @RT01976 EQU @EL00030 14646000 @RT02029 EQU @EL00031 14647000 @RT02047 EQU @EL00031 14648000 @RT02151 EQU @EL00034 14649000 @RT02161 EQU @EL00034 14650000 @RF02190 EQU @EL00036 14651000 @RC02203 EQU @EL00037 14652000 @RF02234 EQU @RC02232 14653000 @RT02318 EQU @EL00038 14654000 @RC02343 EQU @RC02341 14655000 @RT02380 EQU @EL00038 14656000 @RT02385 EQU @EL00038 14657000 @RT02389 EQU @EL00038 14658000 @RT02398 EQU @EL00038 14659000 @RT02401 EQU @EL00038 14660000 @RT02413 EQU @EL00038 14661000 @RT02424 EQU @EL00038 14662000 @RF02504 EQU @EL00039 14663000 @RF02533 EQU @EL00039 14664000 @RF02536 EQU @EL00039 14665000 @RF02631 EQU @EL00040 14666000 @RF02713 EQU @EL00041 14667000 @RF02720 EQU @EL00042 14668000 @RF02788 EQU @EL00044 14669000 @RC02816 EQU @RC02814 14670000 @RF02875 EQU @EL00045 14671000 @RF02883 EQU @EL00046 14672000 @RC02885 EQU @EL00046 14673000 @RT02946 EQU @RC02943 14674000 @RF02959 EQU @RC02943 14675000 @RF03031 EQU @EL00047 14676000 @RF03073 EQU @EL00050 14677000 @RT03163 EQU @EL00051 14678000 @RT03270 EQU @EL00052 14679000 @RT03297 EQU @EL00052 14680000 @RT03302 EQU @EL00052 14681000 @RT03323 EQU @EL00052 14682000 @RT03328 EQU @EL00052 14683000 @RT03356 EQU @EL00053 14684000 @RF03358 EQU @EL00053 14685000 @RT03392 EQU @EL00055 14686000 @RT03412 EQU @EL00055 14687000 @RF03414 EQU @EL00055 14688000 @RT03433 EQU @EL00055 14689000 @RF03435 EQU @EL00055 14690000 @RT03445 EQU @EL00055 14691000 @RT03450 EQU @EL00055 14692000 @RT03467 EQU @EL00055 14693000 @RT03476 EQU @EL00055 14694000 @RF03453 EQU @EL00055 14695000 @RC03514 EQU @RC03512 14696000 @RF03533 EQU @EL00056 14697000 @RC01668 EQU @RC01665 14698000 @RC02345 EQU @RC02343 14699000 @RC02818 EQU @RC02816 14700000 @RF02906 EQU @RC02885 14701000 @RC01670 EQU @RC01668 14702000 @RC02347 EQU @RC02345 14703000 @RC02820 EQU @RC02818 14704000 @ENDDATA EQU * 14705000 END ICBVUT01,(C'PLS0930',0603,77062) 14706000