Seq # *Modification Id* Act
----------------------------+
04385 M00S04385.sslabel +++| ERRCODE = S"PK$PT$VIOL"; # "PK,PT OPTION VIOLATED" #
04386 M00S04386.sslabel +++| LBERR(ERRCODE);
04387 M00S04387.sslabel +++| ERRFLAG = 1;
04388 M00S04388.sslabel +++| RETURN;
04389 M00S04389.sslabel +++| END
04390 M00S04390.sslabel +++|
04391 M00S04391.sslabel +++|#
04392 M00S04392.sslabel +++|* CHECK FOR A LEGAL VALUE FOR *PT*.
04393 M00S04393.sslabel +++|#
04394 M00S04394.sslabel +++|
04395 M00S04395.sslabel +++| IF LBARG$PT[0] NQ "P" ##
04396 M00S04396.sslabel +++| AND LBARG$PT[0] NQ "D" ##
04397 M00S04397.sslabel +++| AND LBARG$PT[0] NQ "F" ##
04398 M00S04398.sslabel +++| AND LBARG$PT[0] NQ "R"
04399 M00S04399.sslabel +++| THEN
04400 M00S04400.sslabel +++| BEGIN
04401 M00S04401.sslabel +++| ERRCODE = S"PK$PT$VIOL"; # "PK,PT OPTION VIOLATED" #
04402 M00S04402.sslabel +++| LBERR(ERRCODE);
04403 M00S04403.sslabel +++| ERRFLAG = 1;
04404 M00S04404.sslabel +++| RETURN;
04405 M00S04405.sslabel +++| END
04406 M00S04406.sslabel +++|
04407 M00S04407.sslabel +++|#
04408 M00S04408.sslabel +++|* CHECK IF *CN* IS SPECIFIED CORRECTLY.
04409 M00S04409.sslabel +++|#
04410 M00S04410.sslabel +++|
04411 M00S04411.sslabel +++| IF LBARG$C[0] NQ 0 ##
04412 M00S04412.sslabel +++| AND (LBARG$OP[0] EQ "AS" OR LBARG$OP[0] EQ "RS" OR LBARG$OP[0]
04413 M00S04413.sslabel +++| EQ "AB" ##
04414 M00S04414.sslabel +++| OR LBARG$OP[0] EQ "RB")
04415 M00S04415.sslabel +++| THEN
04416 M00S04416.sslabel +++| BEGIN
04417 M00S04417.sslabel +++| ERRCODE = S"CSN$VIOL"; # "VSN OPTION VIOLATED" #
04418 M00S04418.sslabel +++| LBERR(ERRCODE);
04419 M00S04419.sslabel +++| ERRFLAG = 1;
04420 M00S04420.sslabel +++| RETURN;
04421 M00S04421.sslabel +++| END
04422 M00S04422.sslabel +++|
04423 M00S04423.sslabel +++|#
04424 M00S04424.sslabel +++|* CHECK IF *CM* PARAMETER IS SPECIFIED CORRECTLY.
04425 M00S04425.sslabel +++|#
04426 M00S04426.sslabel +++|
04427 M00S04427.sslabel +++| IF (LBARG$CM[0] NQ IBMCART ##
04428 M00S04428.sslabel +++| AND LBARG$C[0] NQ 0) ##
04429 M00S04429.sslabel +++| OR LBARG$CM[0] NQ IBMCART
04430 M00S04430.sslabel +++| THEN
04431 M00S04431.sslabel +++| BEGIN
04432 M00S04432.sslabel +++| ERRCODE = S"CSN$VIOL"; # *CSN* OPTION VIOLATED #
04433 M00S04433.sslabel +++| LBERR(ERRCODE);
04434 M00S04434.sslabel +++| ERRFLAG = 1;
04435 M00S04435.sslabel +++| RETURN;
04436 M00S04436.sslabel +++| END
04437 M00S04437.sslabel +++|
04438 M00S04438.sslabel +++|#
04439 M00S04439.sslabel +++|* CHECK *N* OR *PK* IS SPECIFIED WHEN
04440 M00S04440.sslabel +++|* *V* IS SPECIFIED.
04441 M00S04441.sslabel +++|#
04442 M00S04442.sslabel +++|
04443 M00S04443.sslabel +++| IF LBARG$C[0] NQ 0 ##
04444 M00S04444.sslabel +++| AND (LBARG$N[0] NQ 1 ##
04445 M00S04445.sslabel +++| OR LBARG$PK[0] NQ 0)
04446 M00S04446.sslabel +++| THEN
04447 M00S04447.sslabel +++| BEGIN
04448 M00S04448.sslabel +++| ERRCODE = S"CSN$VIOL"; # "VSN OPTION VIOLATED" #
04449 M00S04449.sslabel +++| LBERR(ERRCODE);
04450 M00S04450.sslabel +++| ERRFLAG = 1;
04451 M00S04451.sslabel +++| RETURN;
04452 M00S04452.sslabel +++| END
04453 M00S04453.sslabel +++|
04454 M00S04454.sslabel +++|#
04455 M00S04455.sslabel +++|* CHECK IF *PT* IS SPECIFIED TO BE *P*
04456 M00S04456.sslabel +++|* WHEN *V* IS SPECIFIED FOR *AM*.
04457 M00S04457.sslabel +++|#
04458 M00S04458.sslabel +++|
04459 M00S04459.sslabel +++| IF LBARG$C[0] NQ 0 ##
04460 M00S04460.sslabel +++| AND LBARG$OP[0] EQ "AM" ##
04461 M00S04461.sslabel +++| AND LBARG$PT[0] EQ "P"
04462 M00S04462.sslabel +++| THEN
04463 M00S04463.sslabel +++| BEGIN
04464 M00S04464.sslabel +++| ERRCODE = S"PK$PT$VIOL"; # "PK,PT OPTION VIOLATED" #
04465 M00S04465.sslabel +++| LBERR(ERRCODE);
04466 M00S04466.sslabel +++| ERRFLAG = 1;
04467 M00S04467.sslabel +++| RETURN;
04468 M00S04468.sslabel +++| END
04469 M00S04469.sslabel +++|
04470 M00S04470.sslabel +++|#
04471 M00S04471.sslabel +++|* CHECK IF *PK* AND *PT* ARE SPECIFIED
04472 M00S04472.sslabel +++|* CORRECTLY FOR *AM*.
04473 M00S04473.sslabel +++|#
04474 M00S04474.sslabel +++|
04475 M00S04475.sslabel +++| IF LBARG$OP[0] EQ "AM" ##
04476 M00S04476.sslabel +++| AND LBARG$CC[0] EQ -1 AND ((LBARG$PK[0] NQ 0 ##
04477 M00S04477.sslabel +++| AND LBARG$PK[0] NQ "D" ##
04478 M00S04478.sslabel +++| AND LBARG$PK[0] NQ "P") ##
04479 M00S04479.sslabel +++| OR (LBARG$PT[0] NQ "P" ##
04480 M00S04480.sslabel +++| AND LBARG$PT[0] NQ "F"))
04481 M00S04481.sslabel +++| THEN
04482 M00S04482.sslabel +++| BEGIN
04483 M00S04483.sslabel +++| ERRCODE = S"PK$PT$VIOL"; # "PK,PT OPTION VIOLATED" #
04484 M00S04484.sslabel +++| LBERR(ERRCODE);
04485 M00S04485.sslabel +++| ERRFLAG = 1;
04486 M00S04486.sslabel +++| RETURN;
04487 M00S04487.sslabel +++| END
04488 M00S04488.sslabel +++|
04489 M00S04489.sslabel +++|#
04490 M00S04490.sslabel +++|* CHECK IF *PK* AND *PT* ARE SPECIFIED
04491 M00S04491.sslabel +++|* CORRECTLY FOR *RM*.
04492 M00S04492.sslabel +++|#
04493 M00S04493.sslabel +++|
04494 M00S04494.sslabel +++| IF LBARG$OP[0] EQ "RM" ##
04495 M00S04495.sslabel +++| AND ((LBARG$PK[0] NQ 0 ##
04496 M00S04496.sslabel +++| AND LBARG$PK[0] NQ "P" ##
04497 M00S04497.sslabel +++| AND LBARG$PK[0] NQ "F") ##
04498 M00S04498.sslabel +++| OR (LBARG$PT[0] NQ "D" ##
04499 M00S04499.sslabel +++| AND LBARG$PT[0] NQ "P"))
04500 M00S04500.sslabel +++| THEN
04501 M00S04501.sslabel +++| BEGIN
04502 M00S04502.sslabel +++| ERRCODE = S"PK$PT$VIOL"; # "PK,PT OPTION VIOLATED" #
04503 M00S04503.sslabel +++| LBERR(ERRCODE);
04504 M00S04504.sslabel +++| ERRFLAG = 1;
04505 M00S04505.sslabel +++| RETURN;
04506 M00S04506.sslabel +++| END
04507 M00S04507.sslabel +++|
04508 M00S04508.sslabel +++|#
04509 M00S04509.sslabel +++|* CHECK IF *PK* IS SPECIFIED CORRECTLY
04510 M00S04510.sslabel +++|* FOR *RB*.
04511 M00S04511.sslabel +++|#
04512 M00S04512.sslabel +++|
04513 M00S04513.sslabel +++| IF LBARG$OP[0] EQ "RB" ##
04514 M00S04514.sslabel +++| AND (LBARG$PK[0] NQ "P" ##
04515 M00S04515.sslabel +++| AND LBARG$PK[0] NQ "F" ##
04516 M00S04516.sslabel +++| AND LBARG$PK[0] NQ "R")
04517 M00S04517.sslabel +++| THEN
04518 M00S04518.sslabel +++| BEGIN
04519 M00S04519.sslabel +++| ERRCODE = S"PK$PT$VIOL"; # "PK,PT OPTION VIOLATED" #
04520 M00S04520.sslabel +++| LBERR(ERRCODE);
04521 M00S04521.sslabel +++| ERRFLAG = 1;
04522 M00S04522.sslabel +++| RETURN;
04523 M00S04523.sslabel +++| END
04524 M00S04524.sslabel +++|
04525 M00S04525.sslabel +++|#
04526 M00S04526.sslabel +++|* CHECK IF *PK* AND *PT* ARE BOTH SPECIFIED
04527 M00S04527.sslabel +++|* TO BE *P* FOR *AM* OR *RM*.
04528 M00S04528.sslabel +++|#
04529 M00S04529.sslabel +++|
04530 M00S04530.sslabel +++| IF (LBARG$PK[0] EQ "P" ##
04531 M00S04531.sslabel +++| AND LBARG$PT[0] EQ "P") ##
04532 M00S04532.sslabel +++| AND LBARG$CC[0] EQ -1 ##
04533 M00S04533.sslabel +++| AND (LBARG$OP[0] EQ "AM" ##
04534 M00S04534.sslabel +++| OR LBARG$OP[0] EQ "RM")
04535 M00S04535.sslabel +++| THEN
04536 M00S04536.sslabel +++| BEGIN
04537 M00S04537.sslabel +++| ERRCODE = S"PK$PT$VIOL"; # "PK,PT OPTION VIOLATED" #
04538 M00S04538.sslabel +++| LBERR(ERRCODE);
04539 M00S04539.sslabel +++| ERRFLAG = 1;
04540 M00S04540.sslabel +++| RETURN;
04541 M00S04541.sslabel +++| END
04542 M00S04542.sslabel +++|
04543 M00S04543.sslabel +++|#
04544 M00S04544.sslabel +++|* CHECK IF *PT* IS SPECIFIED CORRECTLY FOR *AB*.
04545 M00S04545.sslabel +++|#
04546 M00S04546.sslabel +++|
04547 M00S04547.sslabel +++| IF LBARG$OP[0] EQ "AB" ##
04548 M00S04548.sslabel +++| AND ((LBARG$PT[0] EQ "D") ##
04549 M00S04549.sslabel +++| OR (LBARG$N[0] NQ 1 ##
04550 M00S04550.sslabel +++| AND LBARG$PT[0] EQ "R"))
04551 M00S04551.sslabel +++| THEN
04552 M00S04552.sslabel +++| BEGIN
04553 M00S04553.sslabel +++| ERRCODE = S"PK$PT$VIOL"; # "PK,PT OPTION VIOLATED" #
04554 M00S04554.sslabel +++| LBERR(ERRCODE);
04555 M00S04555.sslabel +++| ERRFLAG = 1;
04556 M00S04556.sslabel +++| RETURN;
04557 M00S04557.sslabel +++| END
04558 M00S04558.sslabel +++|
04559 M00S04559.sslabel +++|#
04560 M00S04560.sslabel +++|* CHECK IF *YI*, *ZI* OPTION IS SELECTED FOR *AB*.
04561 M00S04561.sslabel +++|#
04562 M00S04562.sslabel +++|
04563 M00S04563.sslabel +++| IF LBARG$OP[0] EQ "AB" ##
04564 M00S04564.sslabel +++| AND LBARG$PT[0] EQ "R" ##
04565 M00S04565.sslabel +++| AND LBARG$YI[0] EQ -1 ##
04566 M00S04566.sslabel +++| AND LBARG$ZI[0] EQ -1
04567 M00S04567.sslabel +++| THEN
04568 M00S04568.sslabel +++| BEGIN
04569 M00S04569.sslabel +++| ERRCODE = S"YZ$VIOL"; # "Y,Z OPTION VIOLATED" #
04570 M00S04570.sslabel +++| LBERR(ERRCODE);
04571 M00S04571.sslabel +++| ERRFLAG = 1;
04572 M00S04572.sslabel +++| RETURN;
04573 M00S04573.sslabel +++| END
04574 M00S04574.sslabel +++|
04575 M00S04575.sslabel +++|#
04576 M00S04576.sslabel +++|* CHECK IF *YI*, *ZI* OPTION IS IMPROPERLY USED FOR *AM*.
04577 M00S04577.sslabel +++|#
04578 M00S04578.sslabel +++|
04579 M00S04579.sslabel +++| IF LBARG$OP[0] EQ "AM" ##
04580 M00S04580.sslabel +++| AND (LBARG$YI[0] NQ -1 ##
04581 M00S04581.sslabel +++| OR LBARG$ZI[0] NQ -1) ##
04582 M00S04582.sslabel +++| AND LBARG$CC[0] EQ -1
04583 M00S04583.sslabel +++| THEN
04584 M00S04584.sslabel +++| BEGIN
04585 M00S04585.sslabel +++| ERRCODE = S"YZ$VIOL"; # "Y,Z OPTION VIOLATED" #
04586 M00S04586.sslabel +++| LBERR(ERRCODE);
04587 M00S04587.sslabel +++| ERRFLAG = 1;
04588 M00S04588.sslabel +++| RETURN;
04589 M00S04589.sslabel +++| END
04590 M00S04590.sslabel +++|
04591 M00S04591.sslabel +++|
04592 M00S04592.sslabel +++|#
04593 M00S04593.sslabel +++|* CHECK IF *LOST OPTION* IS SPECIFIED CORRECTLY.
04594 M00S04594.sslabel +++|#
04595 M00S04595.sslabel +++|
04596 M00S04596.sslabel +++| IF LBARG$LT[0] NQ 0 ##
04597 M00S04597.sslabel +++| AND (LBARG$OP[0] NQ "RM" ##
04598 M00S04598.sslabel +++| OR LBARG$C[0] EQ 0) ##
04599 M00S04599.sslabel +++| THEN
04600 M00S04600.sslabel +++| BEGIN
04601 M00S04601.sslabel +++| ERRCODE = S"LT$VIOL"; # "LT OPTION VIOLATED" #
04602 M00S04602.sslabel +++| LBERR(ERRCODE);
04603 M00S04603.sslabel +++| ERRFLAG = 1;
04604 M00S04604.sslabel +++| RETURN;
04605 M00S04605.sslabel +++| END
04606 M00S04606.sslabel +++|
04607 M00S04607.sslabel +++|#
04608 M00S04608.sslabel +++|* CHECK IF GROUP NUMBER IS LEGAL.
04609 M00S04609.sslabel +++|#
04610 M00S04610.sslabel +++|
04611 M00S04611.sslabel +++| IF ((LBARG$GR[0] GQ 0) ##
04612 M00S04612.sslabel +++| AND ((LBARG$OP[0] EQ "AS") ##
04613 M00S04613.sslabel +++| OR (LBARG$OP[0] EQ "AB") ##
04614 M00S04614.sslabel +++| OR (LBARG$OP[0] EQ "RS") ##
04615 M00S04615.sslabel +++| OR (LBARG$OP[0] EQ "RB") ##
04616 M00S04616.sslabel +++| OR (LBARG$OP[0] EQ "FX") ##
04617 M00S04617.sslabel +++| OR (LBARG$OP[0] EQ "RC") ##
04618 M00S04618.sslabel +++| OR (LBARG$OP[0] EQ "IB")))
04619 M00S04619.sslabel +++| THEN # INCORRECT USE OF GROUP #
04620 M00S04620.sslabel +++| BEGIN
04621 M00S04621.sslabel +++| ERRCODE = S"GR$INCORR";
04622 M00S04622.sslabel +++| LBERR(ERRCODE);
04623 M00S04623.sslabel +++| ERRFLAG = 1;
04624 M00S04624.sslabel +++| RETURN;
04625 M00S04625.sslabel +++| END
04626 M00S04626.sslabel +++|
04627 M00S04627.sslabel +++| IF LBARG$GR[0] GR 20
04628 M00S04628.sslabel +++| OR LBARG$GR[0] EQ 0
04629 M00S04629.sslabel +++| THEN # GROUP OUT OF RANGE #
04630 M00S04630.sslabel +++| BEGIN
04631 M00S04631.sslabel +++| ERRCODE = S"GR$RANGE";
04632 M00S04632.sslabel +++| LBERR(ERRCODE);
04633 M00S04633.sslabel +++| ERRFLAG = 1;
04634 M00S04634.sslabel +++| RETURN;
04635 M00S04635.sslabel +++| END
04636 M00S04636.sslabel +++|
04637 M00S04637.sslabel +++|
04638 M00S04638.sslabel +++|#
04639 M00S04639.sslabel +++|* CHECK IF *PT* IS *P* AND *OP* IS *AM* WITH *GR* SPECIFIED.
04640 M00S04640.sslabel +++|#
04641 M00S04641.sslabel +++|
04642 M00S04642.sslabel +++| IF LBARG$GR[0] GQ 0 AND LBARG$OP[0] EQ "AM" AND LBARG$PT[0] EQ "P
04643 M00S04643.sslabel +++| "
04644 M00S04644.sslabel +++| THEN
04645 M00S04645.sslabel +++| BEGIN
04646 M00S04646.sslabel +++| ERRCODE = S"GR$INCORR";
04647 M00S04647.sslabel +++| LBERR(ERRCODE);
04648 M00S04648.sslabel +++| ERRFLAG = 1;
04649 M00S04649.sslabel +++| RETURN;
04650 M00S04650.sslabel +++| END
04651 M00S04651.sslabel +++|
04652 M00S04652.sslabel +++|
04653 M00S04653.sslabel +++|#
04654 M00S04654.sslabel +++|* CHECK IF *CN* IS SPECIFIED FOR *IB* AND *FX*.
04655 M00S04655.sslabel +++|#
04656 M00S04656.sslabel +++|
04657 M00S04657.sslabel +++| IF (LBARG$OP[0] EQ "IB" ##
04658 M00S04658.sslabel +++| OR LBARG$OP[0] EQ "FX") ##
04659 M00S04659.sslabel +++| AND LBARG$C[0] EQ 0
04660 M00S04660.sslabel +++| THEN
04661 M00S04661.sslabel +++| BEGIN
04662 M00S04662.sslabel +++| ERRCODE = S"CSN$VIOL"; # VSN OPTION VIOLATED #
04663 M00S04663.sslabel +++| LBERR(ERRCODE);
04664 M00S04664.sslabel +++| ERRFLAG = 1;
04665 M00S04665.sslabel +++| RETURN;
04666 M00S04666.sslabel +++| END
04667 M00S04667.sslabel +++|
04668 M00S04668.sslabel +++|#
04669 M00S04669.sslabel +++|* CHECK IF *ON* OR *OF* IS SPECIFIED
04670 M00S04670.sslabel +++|* FOR ANY DIRECTIVE OTHER THAN *IB* OR *FC*.
04671 M00S04671.sslabel +++|#
04672 M00S04672.sslabel +++|
04673 M00S04673.sslabel +++| IF (LBARG$OP[0] NQ "IB" AND LBARG$OP[0] NQ "FC") ##
04674 M00S04674.sslabel +++| AND(LBARG$ON[0] NQ 0 OR LBARG$OF[0] NQ 0)
04675 M00S04675.sslabel +++| THEN
04676 M00S04676.sslabel +++| BEGIN
04677 M00S04677.sslabel +++| ERRCODE = S"ON$OF$VIOL"; # "ON,OFF NOT SPECIFIED CORRECTLY"
04678 M00S04678.sslabel +++| #
04679 M00S04679.sslabel +++| LBERR(ERRCODE);
04680 M00S04680.sslabel +++| ERRFLAG = 1;
04681 M00S04681.sslabel +++| RETURN;
04682 M00S04682.sslabel +++| END
04683 M00S04683.sslabel +++|
04684 M00S04684.sslabel +++|#
04685 M00S04685.sslabel +++|* CHECK IF *ON* OR *OF* ARE SPECIFIED
04686 M00S04686.sslabel +++|* CORRECTLY FOR *IB* OR *FC*:
04687 M00S04687.sslabel +++|#
04688 M00S04688.sslabel +++|
04689 M00S04689.sslabel +++| IF (LBARG$OP[0] EQ "IB" OR LBARG$OP[0] EQ "FC") ##
04690 M00S04690.sslabel +++| AND ((LBARG$ON[0] EQ 0 ##
04691 M00S04691.sslabel +++| AND LBARG$OF[0] EQ 0) ##
04692 M00S04692.sslabel +++| OR (LBARG$ON[0] NQ 0 ##
04693 M00S04693.sslabel +++| AND LBARG$OF[0] NQ 0))
04694 M00S04694.sslabel +++| THEN
04695 M00S04695.sslabel +++| BEGIN
04696 M00S04696.sslabel +++| ERRCODE = S"ON$OF$VIOL"; # "ON,OFF NOT SPECIFIED CORRECTLY"
04697 M00S04697.sslabel +++| #
04698 M00S04698.sslabel +++| LBERR(ERRCODE);
04699 M00S04699.sslabel +++| ERRFLAG = 1;
04700 M00S04700.sslabel +++| RETURN;
04701 M00S04701.sslabel +++| END
04702 M00S04702.sslabel +++|
04703 M00S04703.sslabel +++|#
04704 M00S04704.sslabel +++|* CHECK FOR A LEGAL VALUE FOR *CS*.
04705 M00S04705.sslabel +++|#
04706 M00S04706.sslabel +++|
04707 M00S04707.sslabel +++| IF LBARG$SM[0] GR "H" ##
04708 M00S04708.sslabel +++| OR LBARG$SM[0] LS "A" ##
04709 M00S04709.sslabel +++| OR LBARG$ZSM[0] NQ 0
04710 M00S04710.sslabel +++| THEN
04711 M00S04711.sslabel +++| BEGIN
04712 M00S04712.sslabel +++| ERRCODE = S"ILL$SM"; # "ILLEGAL *SM* NUMBER" #
04713 M00S04713.sslabel +++| LBERR(ERRCODE);
04714 M00S04714.sslabel +++| ERRFLAG = 1;
04715 M00S04715.sslabel +++| RETURN;
04716 M00S04716.sslabel +++| END
04717 M00S04717.sslabel +++|
04718 M00S04718.sslabel +++|#
04719 M00S04719.sslabel +++|* CHECK THE VALUE OF YS AND ZS.
04720 M00S04720.sslabel +++|#
04721 M00S04721.sslabel +++|
04722 M00S04722.sslabel +++| IF LBARG$YI[0] GR MAX$Y ##
04723 M00S04723.sslabel +++| OR LBARG$YF[0] GR MAX$Y ##
04724 M00S04724.sslabel +++| OR LBARG$ZI[0] GR MAX$Z ##
04725 M00S04725.sslabel +++| OR LBARG$ZI[0] EQ Z$NO$CUBE ##
04726 M00S04726.sslabel +++| OR LBARG$ZF[0] GR MAX$Z ##
04727 M00S04727.sslabel +++| OR LBARG$ZF[0] EQ Z$NO$CUBE
04728 M00S04728.sslabel +++| THEN
04729 M00S04729.sslabel +++| BEGIN
04730 M00S04730.sslabel +++| ERRCODE = S"YZ$VIOL"; # "Y,Z OPTION VIOLATED" #
04731 M00S04731.sslabel +++| LBERR(ERRCODE);
04732 M00S04732.sslabel +++| ERRFLAG = 1;
04733 M00S04733.sslabel +++| RETURN;
04734 M00S04734.sslabel +++| END
04735 M00S04735.sslabel +++|
04736 M00S04736.sslabel +++|#
04737 M00S04737.sslabel +++|* CHECK IF *YI*, *ZI*, *YF* AND *ZF* ARE SPECIFIED
04738 M00S04738.sslabel +++|* CORRECTLY.
04739 M00S04739.sslabel +++|#
04740 M00S04740.sslabel +++|
04741 M00S04741.sslabel +++| IF (LBARG$YI[0] EQ -1 ##
04742 M00S04742.sslabel +++| AND LBARG$YF[0] GR 0) ##
04743 M00S04743.sslabel +++| OR (LBARG$ZI[0] EQ -1 ##
04744 M00S04744.sslabel +++| AND LBARG$ZF[0] GR 0)
04745 M00S04745.sslabel +++| THEN
04746 M00S04746.sslabel +++| BEGIN
04747 M00S04747.sslabel +++| ERRCODE = S"YZ$VIOL"; # "Y,Z OPTION VIOLATED" #
04748 M00S04748.sslabel +++| LBERR(ERRCODE);
04749 M00S04749.sslabel +++| ERRFLAG = 1;
04750 M00S04750.sslabel +++| RETURN;
04751 M00S04751.sslabel +++| END
04752 M00S04752.sslabel +++|
04753 M00S04753.sslabel +++|#
04754 M00S04754.sslabel +++|* CHECK IF *N* IS SPECIFIED ALONG WITH
04755 M00S04755.sslabel +++|* *YI* OR *ZI*.
04756 M00S04756.sslabel +++|#
04757 M00S04757.sslabel +++|
04758 M00S04758.sslabel +++| IF (LBARG$YI[0] GQ 0 OR LBARG$ZI[0] GQ 0) AND LBARG$N[0] GR 1
04759 M00S04759.sslabel +++| THEN
04760 M00S04760.sslabel +++| BEGIN
04761 M00S04761.sslabel +++| ERRCODE = S"YZ$VIOL"; # "Y,Z OPTION VIOLATED" #
04762 M00S04762.sslabel +++| LBERR(ERRCODE);
04763 M00S04763.sslabel +++| ERRFLAG = 1;
04764 M00S04764.sslabel +++| RETURN;
04765 M00S04765.sslabel +++| END
04766 M00S04766.sslabel +++|
04767 M00S04767.sslabel +++|#
04768 M00S04768.sslabel +++|* CHECK IF *YF* AND *ZF* ARE NOT
04769 M00S04769.sslabel +++|* SPECIFIED TOGETHER.
04770 M00S04770.sslabel +++|#
04771 M00S04771.sslabel +++|
04772 M00S04772.sslabel +++| IF (LBARG$YF[0] GQ 0 ##
04773 M00S04773.sslabel +++| AND LBARG$ZF[0] EQ -1) ##
04774 M00S04774.sslabel +++| OR (LBARG$YF[0] EQ -1 AND LBARG$ZF[0] GQ 0)
04775 M00S04775.sslabel +++| THEN
04776 M00S04776.sslabel +++| BEGIN
04777 M00S04777.sslabel +++| ERRCODE = S"YZ$VIOL"; # "Y,Z OPTION VIOLATED" #
04778 M00S04778.sslabel +++| LBERR(ERRCODE);
04779 M00S04779.sslabel +++| ERRFLAG = 1;
04780 M00S04780.sslabel +++| RETURN;
04781 M00S04781.sslabel +++| END
04782 M00S04782.sslabel +++|
04783 M00S04783.sslabel +++|#
04784 M00S04784.sslabel +++|* CHECK IF *YF* IS GREATER THAN OR EQUAL
04785 M00S04785.sslabel +++|* TO *YI* WHEN BOTH ARE SPECIFIED.
04786 M00S04786.sslabel +++|#
04787 M00S04787.sslabel +++|
04788 M00S04788.sslabel +++| IF ((LBARG$YI[0] NQ -1) ##
04789 M00S04789.sslabel +++| AND (LBARG$YF[0] NQ -1)) ##
04790 M00S04790.sslabel +++| AND (LBARG$YF[0] LS LBARG$YI[0])
04791 M00S04791.sslabel +++| THEN
04792 M00S04792.sslabel +++| BEGIN
04793 M00S04793.sslabel +++| ERRCODE = S"YZ$VIOL"; # "Y,Z OPTION VIOLATED" #
04794 M00S04794.sslabel +++| LBERR(ERRCODE);
04795 M00S04795.sslabel +++| ERRFLAG = 1;
04796 M00S04796.sslabel +++| RETURN;
04797 M00S04797.sslabel +++| END
04798 M00S04798.sslabel +++|
04799 M00S04799.sslabel +++|#
04800 M00S04800.sslabel +++|* CHECK IF *ZF* IS GREATER THAN OR EQUAL
04801 M00S04801.sslabel +++|* TO *ZI* WHEN BOTH ARE SPECIFIED.
04802 M00S04802.sslabel +++|#
04803 M00S04803.sslabel +++|
04804 M00S04804.sslabel +++| IF ((LBARG$ZI[0] NQ -1) ##
04805 M00S04805.sslabel +++| AND (LBARG$ZF[0] NQ -1) ) ##
04806 M00S04806.sslabel +++| AND (LBARG$ZF[0] LS LBARG$ZI[0])
04807 M00S04807.sslabel +++| THEN
04808 M00S04808.sslabel +++| BEGIN
04809 M00S04809.sslabel +++| ERRCODE = S"YZ$VIOL"; # "Y,Z OPTION VIOLATED" #
04810 M00S04810.sslabel +++| LBERR(ERRCODE);
04811 M00S04811.sslabel +++| ERRFLAG = 1;
04812 M00S04812.sslabel +++| RETURN;
04813 M00S04813.sslabel +++| END
04814 M00S04814.sslabel +++|
04815 M00S04815.sslabel +++|
04816 M00S04816.sslabel +++|#
04817 M00S04817.sslabel +++|* CHECK IF *YI* AND *ZI* SPECIFY NON-EXISTANT CUBES WHILE
04818 M00S04818.sslabel +++|* *YF* AND *ZF* ARE NOT SPECIFIED.
04819 M00S04819.sslabel +++|#
04820 M00S04820.sslabel +++|
04821 M00S04821.sslabel +++| IF (LBARG$YF[0] EQ -1 AND LBARG$ZF[0] EQ -1)
04822 M00S04822.sslabel +++| AND LBARG$CC[0] EQ -1
04823 M00S04823.sslabel +++| THEN # SINGLE CUBE SPECIFIED #
04824 M00S04824.sslabel +++| BEGIN
04825 M00S04825.sslabel +++| IF (LBARG$ZI[0] EQ Z$NO$CUBE) ##
04826 M00S04826.sslabel +++| OR ((LBARG$ZI[0] EQ 0) ##
04827 M00S04827.sslabel +++| AND ((LBARG$YI[0] EQ 0) ##
04828 M00S04828.sslabel +++| OR (LBARG$YI[0] EQ 11) ##
04829 M00S04829.sslabel +++| OR (LBARG$YI[0] EQ 12) ##
04830 M00S04830.sslabel +++| OR (LBARG$YI[0] EQ 13) ##
04831 M00S04831.sslabel +++| OR (LBARG$YI[0] EQ 14) ##
| Line S04832 Modification History |
M01 (Removed by) | msea013 |
Seq # *Modification Id* Act
----------------------------+
04832 M01S04832.msea013 ---| OR (LBARG$YI[0] EQ 15) ##
04833 M01S04833.msea013 ---| OR (LBARG$YI[0] EQ 21))) ##
| Line S00001 Modification History |
M01 (Added by) | msea013 |
Seq # *Modification Id* Act
----------------------------+
04834 M01S00001.msea013 +++| OR (LBARG$YI[0] EQ 15))) ##
04835 M00S04834.sslabel +++| OR ((LBARG$ZI[0] EQ 1) ##
04836 M00S04835.sslabel +++| AND ((LBARG$YI[0] EQ 11) ##
04837 M00S04836.sslabel +++| OR (LBARG$YI[0] EQ 12) ##
04838 M00S04837.sslabel +++| OR (LBARG$YI[0] EQ 13) ##
04839 M00S04838.sslabel +++| OR (LBARG$YI[0] EQ 14) ##
| Line S04839 Modification History |
M01 (Removed by) | msea013 |
Seq # *Modification Id* Act
----------------------------+
04840 M01S04839.msea013 ---| OR (LBARG$YI[0] EQ 15) ##
04841 M01S04840.msea013 ---| OR (LBARG$YI[0] EQ 0))) ##
| Line S00002 Modification History |
M01 (Added by) | msea013 |
Seq # *Modification Id* Act
----------------------------+
04842 M01S00002.msea013 +++| OR (LBARG$YI[0] EQ 15))) ##
04843 M00S04841.sslabel +++| OR ((LBARG$ZI[0] EQ 15) ##
04844 M00S04842.sslabel +++| AND ((LBARG$YI[0] EQ 0) ##
04845 M00S04843.sslabel +++| OR (LBARG$YI[0] EQ 11) ##
04846 M00S04844.sslabel +++| OR (LBARG$YI[0] EQ 21))) ##
| Line S04845 Modification History |
M01 (Removed by) | msea013 |
Seq # *Modification Id* Act
----------------------------+
04847 M01S04845.msea013 ---| OR ((LBARG$ZI[0] EQ 14) ##
04848 M01S04846.msea013 ---| AND ((LBARG$YI[0] EQ 0) ##
04849 M01S04847.msea013 ---| OR ( LBARG$YI[0] EQ 21))) ##
04850 M00S04848.sslabel +++| THEN # IGNORE NON-EXISTANT CUBE #
04851 M00S04849.sslabel +++| BEGIN
04852 M00S04850.sslabel +++| ERRCODE = S"YZ$VIOL"; # "Y,Z OPTION VIOLATED" #
04853 M00S04851.sslabel +++| LBERR(ERRCODE);
04854 M00S04852.sslabel +++| ERRFLAG =1;
04855 M00S04853.sslabel +++| RETURN;
04856 M00S04854.sslabel +++| END
04857 M00S04855.sslabel +++|
04858 M00S04856.sslabel +++| END
04859 M00S04857.sslabel +++|
04860 M00S04858.sslabel +++|
04861 M00S04859.sslabel +++|#
04862 M00S04860.sslabel +++|* CHECK FOR A LEGAL VALUE FOR *SB*.
04863 M00S04861.sslabel +++|#
04864 M00S04862.sslabel +++|
04865 M00S04863.sslabel +++| IF LBARG$SB[0] LS 0 OR LBARG$SB[0] GR 7
04866 M00S04864.sslabel +++| THEN
04867 M00S04865.sslabel +++| BEGIN
04868 M00S04866.sslabel +++| ERRCODE = S"ILL$SB"; # "ILLEGAL SUBFAMILY" #
04869 M00S04867.sslabel +++| LBERR(ERRCODE);
04870 M00S04868.sslabel +++| ERRFLAG = 1;
04871 M00S04869.sslabel +++| END
04872 M00S04870.sslabel +++|
04873 M00S04871.sslabel +++|#
04874 M00S04872.sslabel +++|* CHECK FOR LEGAL VALUE OF *CC*.
04875 M00S04873.sslabel +++|#
04876 M00S04874.sslabel +++|
04877 M00S04875.sslabel +++| IF (LBARG$CC[0] NQ -1 AND LBARG$OP NQ "AM") OR (LBARG$CC[0] NQ 0
04878 M00S04876.sslabel +++| AND LBARG$CC[0] NQ 15 AND LBARG$CC[0] NQ -1)
04879 M00S04877.sslabel +++| THEN
04880 M00S04878.sslabel +++| BEGIN
04881 M00S04879.sslabel +++| ERRCODE = S"ILL$DIRCTV";
04882 M00S04880.sslabel +++| LBERR(ERRCODE);
04883 M00S04881.sslabel +++| ERRFLAG = 1;
04884 M00S04882.sslabel +++| RETURN;
04885 M00S04883.sslabel +++| END
04886 M00S04884.sslabel +++|
04887 M00S04885.sslabel +++|#
04888 M00S04886.sslabel +++|* CHECK FOR LEGAL *B* VALUE.
04889 M00S04887.sslabel +++|#
04890 M00S04888.sslabel +++|
04891 M00S04889.sslabel +++| IF (LBARG$B[0] LS 0) OR (LBARG$B[0] GR 1931) ##
04892 M00S04890.sslabel +++| OR ((LBARG$B[0] NQ 600) ##
04893 M00S04891.sslabel +++| AND (LBARG$OP[0] NQ "AM"))
04894 M00S04892.sslabel +++| THEN # *B* INCORRECT #
04895 M00S04893.sslabel +++| BEGIN
04896 M00S04894.sslabel +++| ERRCODE = S"B$INCORR";
04897 M00S04895.sslabel +++| LBERR(ERRCODE);
04898 M00S04896.sslabel +++| ERRFLAG = 1;
04899 M00S04897.sslabel +++| RETURN;
04900 M00S04898.sslabel +++| END
04901 M00S04899.sslabel +++|
04902 M00S04900.sslabel +++|
04903 M00S04901.sslabel +++| RETURN; # RETURN ERRFLAG = NO ERROR #
04904 M00S04902.sslabel +++|
04905 M00S04903.sslabel +++| END # LBOPT #
04906 M00S04904.sslabel +++|
04907 M00S04905.sslabel +++| TERM
04908 M00S04906.sslabel +++|PROC LBRESP((RESP$CODE),(CALLTYP));
04909 M00S04907.sslabel +++|# TITLE LBRESP - ACTS UPON RESPONSE CODES FROM EXEC. #
04910 M00S04908.sslabel +++|
04911 M00S04909.sslabel +++| BEGIN # LBRESP #
04912 M00S04910.sslabel +++|
04913 M00S04911.sslabel +++|#
04914 M00S04912.sslabel +++|** LBRESP - ACTS UPON RESPONSE CODES FROM EXEC.
04915 M00S04913.sslabel +++|*
04916 M00S04914.sslabel +++|* THIS PROC CHECKS THE RESPONSE CODE RETURNED BY EXEC
04917 M00S04915.sslabel +++|* AND CALLS *LBERR* WITH THE APPROPRIATE ERROR CODE IF
04918 M00S04916.sslabel +++|* ANY ERROR OCCURRED.
04919 M00S04917.sslabel +++|*
04920 M00S04918.sslabel +++|* PROC LBRESP((RESP$CODE),(CALLTYP))
04921 M00S04919.sslabel +++|*
04922 M00S04920.sslabel +++|* ENTRY RESP$CODE, CODE RETURNED BY EXEC IN RESPONSE
04923 M00S04921.sslabel +++|* TO A UCP REQUEST, OR BY A CATALOG/MAP
04924 M00S04922.sslabel +++|* ACCESS ROUTINE.
04925 M00S04923.sslabel +++|* CALLTYP, TYPE OF CALL.
04926 M00S04924.sslabel +++|* 0 - CATALOG/MAP ACCESS.
04927 M00S04925.sslabel +++|* 3 - TYPE 3 UCP REQUEST.
04928 M00S04926.sslabel +++|* 4 - TYPE 4 UCP REQUEST.
04929 M00S04927.sslabel +++|*
04930 M00S04928.sslabel +++|* EXIT PROC *LBERR* CALLED OR RETURN DIRECTLY TO CALLING PROC.
04931 M00S04929.sslabel +++|*
04932 M00S04930.sslabel +++|* MESSAGES SSLABEL ABNORMAL, LBRESP.
04933 M00S04931.sslabel +++|*
04934 M00S04932.sslabel +++|* NOTES PROC *LBRESP* CHECKS THE VALUE OF *RESP$CODE* AND CALLS
04935 M00S04933.sslabel +++|* *LBERR* WITH THE APPROPRIATE ERROR CODE IF ANY ERRORS
04936 M00S04934.sslabel +++|* ARE INDICATED.
04937 M00S04935.sslabel +++|#
04938 M00S04936.sslabel +++|
04939 M00S04937.sslabel +++| ITEM RESP$CODE U; # RESPONSE CODE FROM EXEC #
04940 M00S04938.sslabel +++| ITEM CALLTYP U; # TYPE OF CALL MADE #
04941 M00S04939.sslabel +++|
04942 M00S04940.sslabel +++|#
04943 M00S04941.sslabel +++|**** PROC LBRESP - XREF LIST BEGIN.
04944 M00S04942.sslabel +++|#
04945 M00S04943.sslabel +++|
04946 M00S04944.sslabel +++| XREF
04947 M00S04945.sslabel +++| BEGIN
04948 M00S04946.sslabel +++| PROC LBERR; # *SSLABEL* ERROR PROCESSOR #
04949 M00S04947.sslabel +++| PROC MESSAGE; # DISPLAYS MESSAGES #
04950 M00S04948.sslabel +++| PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT
04951 M00S04949.sslabel +++| OR RETURN #
04952 M00S04950.sslabel +++| END
04953 M00S04951.sslabel +++|
04954 M00S04952.sslabel +++|#
04955 M00S04953.sslabel +++|**** PROC LBRESP - XREF LIST END.
04956 M00S04954.sslabel +++|#
04957 M00S04955.sslabel +++|
04958 M00S04956.sslabel +++| DEF PROCNAME #"LBRESP."#; # PROC NAME #
04959 M00S04957.sslabel +++|
04960 M00S04958.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS #
04961 M00S04959.sslabel +++|*CALL COMBFAS
04962 M00S04960.sslabel +++|*CALL COMBCMS
04963 M00S04961.sslabel +++|*CALL COMBCPR
04964 M00S04962.sslabel +++|*CALL COMTERR
04965 M00S04963.sslabel +++|*CALL COMTLAB
04966 M00S04964.sslabel +++|
04967 M00S04965.sslabel +++|#
04968 M00S04966.sslabel +++|* STATUS SWITCH FOR THE RESPONSE CODES
04969 M00S04967.sslabel +++|* RETURNED BY EXEC IN RESPONSE TO TYPE 3
04970 M00S04968.sslabel +++|* CALLSS REQUEST.
04971 M00S04969.sslabel +++|#
04972 M00S04970.sslabel +++|
04973 M00S04971.sslabel +++| SWITCH RESP$ACT3:RESPTYP3 # ACTION ON RESPONSE TO TYPE 3
04974 M00S04972.sslabel +++| REQUEST #
04975 M00S04973.sslabel +++| OK3$ACT:OK3, # REQUEST PROCESSED #
04976 M00S04974.sslabel +++| INTLCK$ACT:C$M$INTLCK, # CATALOG/MAP INTERLOCKED #
04977 M00S04975.sslabel +++| NOPEN$ACT:C$M$NOPEN, # CATALOG/MAP NOT OPEN #
04978 M00S04976.sslabel +++| SUBEX$ACT:SUB$CAT$EX, # SUB CATALOG ALREADY EXISTS #
04979 M00S04977.sslabel +++| NOSUB$ACT:NO$SUB$CAT, # NO SUCH SUBCATALOG #
04980 M00S04978.sslabel +++| PFPROB$ACT: PF$PROB; # PERMANENT FILE PROBLEM #
04981 M00S04979.sslabel +++|
04982 M00S04980.sslabel +++|#
04983 M00S04981.sslabel +++|* STATUS SWITCH FOR THE RESPONSE RETURNED BY
04984 M00S04982.sslabel +++|* EXEC TO A TYPE 4 CALLSS REQUEST. ONLY THE
04985 M00S04983.sslabel +++|* APPLICABLE RESPONSE CODES ARE LISTED HERE.
04986 M00S04984.sslabel +++|#
04987 M00S04985.sslabel +++|
04988 M00S04986.sslabel +++| SWITCH RESP$ACT4:RESPTYP4 # ACTION ON RESPONSE TO TYPE 4
04989 M00S04987.sslabel +++| REQUEST #
04990 M00S04988.sslabel +++| OK4$ACT:OK4, # REQUEST PROCESSED #
04991 M00S04989.sslabel +++| CLBERR$ACT:CART$LB$ERR, # CARTRIDGE LABEL ERROR #
04992 M00S04990.sslabel +++| CUSERR$ACT:CSN$IN$USE, # CARTRIDGE IN USE #
04993 M00S04991.sslabel +++| SMOFF$ACT:SMA$OFF, # STORAGE MODULE OFF #
04994 M00S04992.sslabel +++| CEMERR$ACT:CELL$EMP,
04995 M00S04993.sslabel +++| CFLERR$ACT:CELL$FULL,
04996 M00S04994.sslabel +++| UNKERR$ACT:UNK$CART, # UNKNOWN LABEL ERROR #
04997 M00S04995.sslabel +++| URDERR$ACT:UN$RD$ERR, # UNRECOVERABLE READ ERROR #
04998 M00S04996.sslabel +++| UWTERR$ACT:UN$WRT$ERR, # UNRECOVERABLE WRITE ERROR #
04999 M00S04997.sslabel +++| MHDERR$ACT:M86$HDW$PR; # M86 HARDWARE PROBLEM #
05000 M00S04998.sslabel +++|
05001 M00S04999.sslabel +++| CONTROL EJECT;
05002 M00S05000.sslabel +++|
05003 M00S05001.sslabel +++|#
05004 M00S05002.sslabel +++|* DO PROCESSING APPROPRIATE TO TYPE OF RESPONSE CODE.
05005 M00S05003.sslabel +++|#
05006 M00S05004.sslabel +++|
05007 M00S05005.sslabel +++| IF CALLTYP EQ TYP"TYP3"
05008 M00S05006.sslabel +++| THEN # TYPE 3 UCP REQUEST #
05009 M00S05007.sslabel +++| BEGIN
05010 M00S05008.sslabel +++| GOTO RESP$ACT3[RESP$CODE];
05011 M00S05009.sslabel +++| END
05012 M00S05010.sslabel +++|
05013 M00S05011.sslabel +++| IF CALLTYP EQ TYP"TYP4"
05014 M00S05012.sslabel +++| THEN # TYPE 4 UCP REQUEST #
05015 M00S05013.sslabel +++| BEGIN
05016 M00S05014.sslabel +++| GOTO RESP$ACT4[RESP$CODE];
05017 M00S05015.sslabel +++| END
05018 M00S05016.sslabel +++|
05019 M00S05017.sslabel +++| IF CALLTYP NQ 0
05020 M00S05018.sslabel +++| THEN # ILLEGAL CALL TYPE #
05021 M00S05019.sslabel +++| BEGIN
05022 M00S05020.sslabel +++| LBMSG$PROC[0] = PROCNAME;
05023 M00S05021.sslabel +++| MESSAGE(LBMSG[0],SYSUDF1);
05024 M00S05022.sslabel +++| RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
05025 M00S05023.sslabel +++| END
05026 M00S05024.sslabel +++|
05027 M00S05025.sslabel +++|#
05028 M00S05026.sslabel +++|* ERROR PROCESSING FOR CATALOG/MAP ACCESS.
05029 M00S05027.sslabel +++|#
05030 M00S05028.sslabel +++|
05031 M00S05029.sslabel +++| IF RESP$CODE EQ CMASTAT"INTLK"
05032 M00S05030.sslabel +++| THEN # CATALOG/MAP INTERLOCKED #
05033 M00S05031.sslabel +++| BEGIN
05034 M00S05032.sslabel +++| ERRCODE = S"CAT$MAP$LK";
05035 M00S05033.sslabel +++| LBERR(ERRCODE);
05036 M00S05034.sslabel +++| RETURN;
05037 M00S05035.sslabel +++| END
05038 M00S05036.sslabel +++|
05039 M00S05037.sslabel +++| IF RESP$CODE EQ CMASTAT"ATTERR"
05040 M00S05038.sslabel +++| THEN # PROCESS ATTACH ERROR #
05041 M00S05039.sslabel +++| BEGIN
05042 M00S05040.sslabel +++| ERRCODE = S"PF$PROB";
05043 M00S05041.sslabel +++| LBERR(ERRCODE);
05044 M00S05042.sslabel +++| RETURN;
05045 M00S05043.sslabel +++| END
05046 M00S05044.sslabel +++|
05047 M00S05045.sslabel +++| IF RESP$CODE EQ CMASTAT"NOSUBCAT"
05048 M00S05046.sslabel +++| THEN # NO SUCH SUBCATALOG #
05049 M00S05047.sslabel +++| BEGIN
05050 M00S05048.sslabel +++| ERRCODE = S"NO$CAT$MAP";
05051 M00S05049.sslabel +++| LBERR(ERRCODE);
05052 M00S05050.sslabel +++| RETURN;
05053 M00S05051.sslabel +++| END
05054 M00S05052.sslabel +++|
05055 M00S05053.sslabel +++| IF RESP$CODE NQ CMASTAT"NOERR" AND RESP$CODE NQ CMASTAT"FOPEN"
05056 M00S05054.sslabel +++| THEN # ERROR OTHER THAN *CATALOG
05057 M00S05055.sslabel +++| ALREADY OPEN* #
05058 M00S05056.sslabel +++| BEGIN
05059 M00S05057.sslabel +++| LBMSG$PROC[0] = PROCNAME;
05060 M00S05058.sslabel +++| MESSAGE(LBMSG[0],SYSUDF1);
05061 M00S05059.sslabel +++| RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
05062 M00S05060.sslabel +++| END
05063 M00S05061.sslabel +++|
05064 M00S05062.sslabel +++|#
05065 M00S05063.sslabel +++|* ERROR PROCESSING FOR TYPE 3 REQUESTS TO EXEC.
05066 M00S05064.sslabel +++|#
05067 M00S05065.sslabel +++|
05068 M00S05066.sslabel +++|OK3$ACT: # NO ERROR #
05069 M00S05067.sslabel +++| RETURN;
05070 M00S05068.sslabel +++|
05071 M00S05069.sslabel +++|INTLCK$ACT: # CATALOG/MAP INTERLOCKED #
05072 M00S05070.sslabel +++| ERRCODE = S"CAT$MAP$LK";
05073 M00S05071.sslabel +++| LBERR(ERRCODE);
05074 M00S05072.sslabel +++| RETURN;
05075 M00S05073.sslabel +++|
05076 M00S05074.sslabel +++|NOPEN$ACT: # CATALOG/MAP NOT OPEN #
05077 M00S05075.sslabel +++| ERRCODE = S"NOT$OPEN";
05078 M00S05076.sslabel +++| LBERR(ERRCODE);
05079 M00S05077.sslabel +++| RETURN;
05080 M00S05078.sslabel +++|
05081 M00S05079.sslabel +++|SUBEX$ACT: # SUB CATALOG ALREADY EXISTS #
05082 M00S05080.sslabel +++| ERRCODE = S"SM$DEFND";
05083 M00S05081.sslabel +++| LBERR(ERRCODE);
05084 M00S05082.sslabel +++| RETURN;
05085 M00S05083.sslabel +++|
05086 M00S05084.sslabel +++|NOSUB$ACT: # NO SUCH SUBCATALOG #
05087 M00S05085.sslabel +++| ERRCODE = S"NO$CAT$MAP";
05088 M00S05086.sslabel +++| LBERR(ERRCODE);
05089 M00S05087.sslabel +++| RETURN;
05090 M00S05088.sslabel +++|
05091 M00S05089.sslabel +++|PFPROB$ACT: # PERMANENT FILE PROBLEM #
05092 M00S05090.sslabel +++| ERRCODE = S"PF$PROB";
05093 M00S05091.sslabel +++| LBERR(ERRCODE);
05094 M00S05092.sslabel +++| RETURN;
05095 M00S05093.sslabel +++|
05096 M00S05094.sslabel +++|#
05097 M00S05095.sslabel +++|* ERROR PROCESSING FOR TYPE 4 REQUESTS TO EXEC.
05098 M00S05096.sslabel +++|#
05099 M00S05097.sslabel +++|
05100 M00S05098.sslabel +++|OK4$ACT: # NO ERRORS #
05101 M00S05099.sslabel +++| RETURN;
05102 M00S05100.sslabel +++|
05103 M00S05101.sslabel +++|CLBERR$ACT: # CARTRIDGE LABEL ERROR #
05104 M00S05102.sslabel +++|
05105 M00S05103.sslabel +++| ERRCODE = S"LAB$ERR";
05106 M00S05104.sslabel +++| LBERR(ERRCODE);
05107 M00S05105.sslabel +++| RETURN;
05108 M00S05106.sslabel +++|
05109 M00S05107.sslabel +++|
05110 M00S05108.sslabel +++|CUSERR$ACT:
05111 M00S05109.sslabel +++|
05112 M00S05110.sslabel +++| ERRCODE = S"CAR$IN$USE";
05113 M00S05111.sslabel +++| LBERR(ERRCODE);
05114 M00S05112.sslabel +++| RETURN;
05115 M00S05113.sslabel +++|
05116 M00S05114.sslabel +++|
05117 M00S05115.sslabel +++|CEMERR$ACT: # CARTRIDGE NOT FOUND #
05118 M00S05116.sslabel +++|
05119 M00S05117.sslabel +++| ERRCODE = S"CR$NOTFND";
05120 M00S05118.sslabel +++| LBERR(ERRCODE);
05121 M00S05119.sslabel +++| RETURN;
05122 M00S05120.sslabel +++|
05123 M00S05121.sslabel +++|CFLERR$ACT: # CELL IS FULL #
05124 M00S05122.sslabel +++|
05125 M00S05123.sslabel +++| ERRCODE = S"CELL$FULL";
05126 M00S05124.sslabel +++| LBERR(ERRCODE);
05127 M00S05125.sslabel +++| RETURN;
05128 M00S05126.sslabel +++|
05129 M00S05127.sslabel +++|
05130 M00S05128.sslabel +++|UNKERR$ACT: # UNKNOWN LABEL ERROR #
05131 M00S05129.sslabel +++|
05132 M00S05130.sslabel +++| ERRCODE = S"LAB$ERR";
05133 M00S05131.sslabel +++| LBERR(ERRCODE);
05134 M00S05132.sslabel +++| RETURN;
05135 M00S05133.sslabel +++|
05136 M00S05134.sslabel +++|
05137 M00S05135.sslabel +++|URDERR$ACT: # UNRECOVERABLE READ ERROR #
05138 M00S05136.sslabel +++| ERRCODE = S"UNRECV$RD";
05139 M00S05137.sslabel +++| LBERR(ERRCODE);
05140 M00S05138.sslabel +++| RETURN;
05141 M00S05139.sslabel +++|
05142 M00S05140.sslabel +++|UWTERR$ACT: # UNRECOVERABLE WRITE ERROR #
05143 M00S05141.sslabel +++| ERRCODE = S"UNRECV$WRT";
05144 M00S05142.sslabel +++| LBERR(ERRCODE);
05145 M00S05143.sslabel +++| RETURN;
05146 M00S05144.sslabel +++|
05147 M00S05145.sslabel +++|MHDERR$ACT: # MSF HARDWARE PROBLEM #
05148 M00S05146.sslabel +++| ERRCODE = S"M86$HARDWR";
05149 M00S05147.sslabel +++| LBERR(ERRCODE);
05150 M00S05148.sslabel +++| RETURN;
05151 M00S05149.sslabel +++|SMOFF$ACT:
05152 M00S05150.sslabel +++|
05153 M00S05151.sslabel +++| ERRCODE = S"SM$OFF";
05154 M00S05152.sslabel +++| LBERR(ERRCODE);
05155 M00S05153.sslabel +++| RETURN;
05156 M00S05154.sslabel +++|
05157 M00S05155.sslabel +++|
05158 M00S05156.sslabel +++| END # LBRESP #
05159 M00S05157.sslabel +++|
05160 M00S05158.sslabel +++| TERM
05161 M00S05159.sslabel +++|PROC LBRMCSU;
05162 M00S05160.sslabel +++|# TITLE LBRMCSU - REMOVE A *SM* FROM A FAMILY CATALOG. #
05163 M00S05161.sslabel +++|
05164 M00S05162.sslabel +++| BEGIN # LBRMCSU #
05165 M00S05163.sslabel +++|
05166 M00S05164.sslabel +++|#
05167 M00S05165.sslabel +++|** LBRMCSU - REMOVE A *SM* FROM A FAMILY CATALOG.
05168 M00S05166.sslabel +++|*
05169 M00S05167.sslabel +++|* THIS PROC UPDATES THE CATALOG FOR A FAMILY TO REMOVE
05170 M00S05168.sslabel +++|* ASSIGNMENT OF A PARTICULAR CSU.
05171 M00S05169.sslabel +++|*
05172 M00S05170.sslabel +++|* PROC LBRMCSU.
05173 M00S05171.sslabel +++|*
05174 M00S05172.sslabel +++|* ENTRY CRACKED AND SYNTAX CHECKED DIRECTIVE
05175 M00S05173.sslabel +++|* PARAMETERS SET UP IN COMMON AREA DEFINED
05176 M00S05174.sslabel +++|* IN *COMTLBP*.
05177 M00S05175.sslabel +++|*
05178 M00S05176.sslabel +++|* EXIT *SM* REMOVED FROM FAMILY OR ERROR CONDITION.
05179 M00S05177.sslabel +++|*
05180 M00S05178.sslabel +++|* NOTES PROC *LBRMCSU* SEARCHES THE SMMAP FOR THE *SM*
05181 M00S05179.sslabel +++|* SPECIFIED TO VERIFY THAT NO CUBES ARE ASSIGNED
05182 M00S05180.sslabel +++|* TO THE FAMILY. A REQUEST IS THEN SENT TO EXEC
05183 M00S05181.sslabel +++|* TO UPDATE THE CATALOG TO REFLECT THE REMOVAL OF
05184 M00S05182.sslabel +++|* THE *SM*.
05185 M00S05183.sslabel +++|#
05186 M00S05184.sslabel +++|
05187 M00S05185.sslabel +++|#
05188 M00S05186.sslabel +++|**** PROC LBRMCSU - XREF LIST BEGIN.
05189 M00S05187.sslabel +++|#
05190 M00S05188.sslabel +++|
05191 M00S05189.sslabel +++| XREF
05192 M00S05190.sslabel +++| BEGIN
05193 M00S05191.sslabel +++| PROC CALL3; # ISSUES TYPE 3 CALLSS TO EXEC #
05194 M00S05192.sslabel +++| PROC LBERR; # *SSLABEL* ERROR PROCESSOR #
05195 M00S05193.sslabel +++| PROC LBRESP; # PROCESSES RESPONSE FROM EXEC #
05196 M00S05194.sslabel +++| PROC SERCSU; # SEARCHES THE SMMAP #
05197 M00S05195.sslabel +++| END
05198 M00S05196.sslabel +++|
05199 M00S05197.sslabel +++|#
05200 M00S05198.sslabel +++|**** PROC LBRMCSU - XREF LIST END.
05201 M00S05199.sslabel +++|#
05202 M00S05200.sslabel +++|
05203 M00S05201.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS #
05204 M00S05202.sslabel +++|*CALL COMBFAS
05205 M00S05203.sslabel +++|*CALL COMBCPR
05206 M00S05204.sslabel +++|*CALL COMTERR
05207 M00S05205.sslabel +++|*CALL COMTLAB
05208 M00S05206.sslabel +++|*CALL COMTLBP
05209 M00S05207.sslabel +++|
05210 M00S05208.sslabel +++| ITEM FLAG I; # ERROR FLAG #
05211 M00S05209.sslabel +++| ITEM REQCODE U; # REQUEST CODE #
05212 M00S05210.sslabel +++| ITEM RESP$CODE U; # RESPONSE CODE FROM EXEC #
05213 M00S05211.sslabel +++| ITEM SERTYPE S:SERCH$TYPE; # SMMAP SEARCH TYPE #
05214 M00S05212.sslabel +++|
05215 M00S05213.sslabel +++|
05216 M00S05214.sslabel +++| ARRAY PK$CSU$ENT [0:0] P(4); # *PICK* SMMAP ENTRY #
05217 M00S05215.sslabel +++| BEGIN
05218 M00S05216.sslabel +++| ITEM PK$MAPENT C(00,00,30); # THREE WORD MAP ENTRY #
05219 M00S05217.sslabel +++| ITEM PK$Y U(03,00,30); # Y COORDINATE #
05220 M00S05218.sslabel +++| ITEM PK$Z U(03,30,30); # Z COORDINATE #
05221 M00S05219.sslabel +++| END
05222 M00S05220.sslabel +++|
05223 M00S05221.sslabel +++|
05224 M00S05222.sslabel +++| CONTROL EJECT;
05225 M00S05223.sslabel +++|
05226 M00S05224.sslabel +++|#
05227 M00S05225.sslabel +++|* SEARCH SMMAP FOR CUBES ASSIGNED TO FAMILY AND UPDATE CATALOG.
05228 M00S05226.sslabel +++|#
05229 M00S05227.sslabel +++|
05230 M00S05228.sslabel +++| SERTYPE = S"ASGN$FAM";
05231 M00S05229.sslabel +++| SERCSU(SERTYPE,0,0,0,0,LBARG$FM[0],LBARG$SB[0], PK$CSU$ENT[0],
05232 M00S05230.sslabel +++| FLAG);
05233 M00S05231.sslabel +++|
05234 M00S05232.sslabel +++| IF FLAG EQ OK
05235 M00S05233.sslabel +++| THEN # ENTRY FOUND #
05236 M00S05234.sslabel +++| BEGIN
05237 M00S05235.sslabel +++| ERRCODE = S"CB$ASGN$SB";
05238 M00S05236.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING #
05239 M00S05237.sslabel +++| RETURN;
05240 M00S05238.sslabel +++| END
05241 M00S05239.sslabel +++|
05242 M00S05240.sslabel +++| REQCODE = REQTYP3"RMV$CSU";
05243 M00S05241.sslabel +++| CALL3(REQCODE,0,0,0,RESP$CODE); # REMOVE *SM* FROM FAMILY #
05244 M00S05242.sslabel +++| IF RESP$CODE NQ RESPTYP3"OK3"
05245 M00S05243.sslabel +++| THEN # PROCESS THE RESPONSE #
05246 M00S05244.sslabel +++| BEGIN
05247 M00S05245.sslabel +++| LBRESP(RESP$CODE,TYP"TYP3");
05248 M00S05246.sslabel +++| END
05249 M00S05247.sslabel +++|
05250 M00S05248.sslabel +++| RETURN;
05251 M00S05249.sslabel +++|
05252 M00S05250.sslabel +++| END # LBRMCSU #
05253 M00S05251.sslabel +++|
05254 M00S05252.sslabel +++| TERM
05255 M00S05253.sslabel +++|PROC LBRMCUB;
05256 M00S05254.sslabel +++|# TITLE LBRMCUB - REMOVES CUBES FROM FAMILY/POOL/RESERVED AREA. #
05257 M00S05255.sslabel +++|
05258 M00S05256.sslabel +++| BEGIN # LBRMCUB #
05259 M00S05257.sslabel +++|
05260 M00S05258.sslabel +++|#
05261 M00S05259.sslabel +++|** LBRMCUB - REMOVES CUBES FROM FAMILY/POOL/RESERVED AREA.
05262 M00S05260.sslabel +++|*
05263 M00S05261.sslabel +++|* THIS PROC REMOVES ASSIGNED CUBES FROM A FAMILY, POOL,
05264 M00S05262.sslabel +++|* OR RESERVED AREA OF THE CSU.
05265 M00S05263.sslabel +++|*
05266 M00S05264.sslabel +++|* PROC LBRMCUB.
05267 M00S05265.sslabel +++|*
05268 M00S05266.sslabel +++|* ENTRY CRACKED AND SYNTAX CHECKED DIRECTIVE
05269 M00S05267.sslabel +++|* PARAMETERS SET UP IN COMMON AREA DEFINED
05270 M00S05268.sslabel +++|* IN *COMTLBP*.
05271 M00S05269.sslabel +++|*
05272 M00S05270.sslabel +++|* EXIT SPECIFIED NUMBER OR LOCATIONS OF CUBES HAVE
05273 M00S05271.sslabel +++|* BEEN REMOVED, OR ERROR CONDITION.
05274 M00S05272.sslabel +++|*
05275 M00S05273.sslabel +++|* NOTES PROC *LBRMCUB* REMOVES CUBES FROM A FAMILY,
05276 M00S05274.sslabel +++|* POOL, OR RESERVED AREA BY CHANGING THEIR STATUS
05277 M00S05275.sslabel +++|* FROM *ASSIGNED* TO *UNASSIGNED*. IF THE *N*
05278 M00S05276.sslabel +++|* OPTION IS USED THE SMMAP IS SEARCHED FOR EMPTY
05279 M00S05277.sslabel +++|* CUBES WITH THE APPROPRIATE ASSIGNMENT. IF THE
05280 M00S05278.sslabel +++|* LOCATION OPTION IS USED, THE SMMAP IS CHECKED
05281 M00S05279.sslabel +++|* TO ENSURE THAT THE SPECIFIC CUBES ARE EMPTY AND
05282 M00S05280.sslabel +++|* ASSIGNED AS EXPECTED. A REQUEST IS THEN SENT
05283 M00S05281.sslabel +++|* TO EXEC TO REMOVE THE CUBES FROM ASSIGNMENT.
05284 M00S05282.sslabel +++|#
05285 M00S05283.sslabel +++|
05286 M00S05284.sslabel +++|#
05287 M00S05285.sslabel +++|**** PROC LBRMCUB - XREF LIST BEGIN.
05288 M00S05286.sslabel +++|#
05289 M00S05287.sslabel +++|
05290 M00S05288.sslabel +++| XREF
05291 M00S05289.sslabel +++| BEGIN
05292 M00S05290.sslabel +++| PROC CALL3; # ISSUES TYPE 3 CALLSS TO EXEC #
05293 M00S05291.sslabel +++| PROC LBERR; # *SSLABEL* ERROR PROCESSOR #
05294 M00S05292.sslabel +++| PROC LBRESP; # RESPONSE CODE PROCESSOR #
05295 M00S05293.sslabel +++| PROC MFLUSH; # FLUSHES MAP BUFFER #
05296 M00S05294.sslabel +++| PROC SERCSU; # SEARCHES THE SMMAP #
05297 M00S05295.sslabel +++| PROC SETCORD; # SETS UP Y AND Z COORDINATES #
05298 M00S05296.sslabel +++| END
05299 M00S05297.sslabel +++|
05300 M00S05298.sslabel +++|#
05301 M00S05299.sslabel +++|**** PROC LBRMCUB - XREF LIST END.
05302 M00S05300.sslabel +++|#
05303 M00S05301.sslabel +++|
05304 M00S05302.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS #
05305 M00S05303.sslabel +++|*CALL COMBFAS
05306 M00S05304.sslabel +++|*CALL COMBCPR
05307 M00S05305.sslabel +++|*CALL COMBMAP
05308 M00S05306.sslabel +++|*CALL COMTERR
05309 M00S05307.sslabel +++|*CALL COMTLAB
05310 M00S05308.sslabel +++|*CALL COMTLBP
05311 M00S05309.sslabel +++|
05312 M00S05310.sslabel +++| ITEM FLAG I; # ERROR FLAG #
05313 M00S05311.sslabel +++| ITEM I I; # LOOP VARIABLE #
05314 M00S05312.sslabel +++| ITEM LOC$OPTION B; # TRUE IF *LOC* OPTION FALSE IF
05315 M00S05313.sslabel +++| *N* OPTION #
05316 M00S05314.sslabel +++| ITEM REQCODE U; # RESPONSE CODE FROM EXEC #
05317 M00S05315.sslabel +++| ITEM RESP$CODE U; # RESPONSE CODE FROM EXEC #
05318 M00S05316.sslabel +++| ITEM SERTYPE S:SERCH$TYPE; # TYPE OF SEARCH THROUGH SMMAP #
05319 M00S05317.sslabel +++| ITEM SP$CODE U; # CODE FOR CUBE/CARTRIDGE
05320 M00S05318.sslabel +++| ASSIGNMENT #
05321 M00S05319.sslabel +++| ITEM SP$FAM C(7); # SPECIFIED FAMILY NAME #
05322 M00S05320.sslabel +++| ITEM SP$SUB U; # SPECIFIED SUB FAMILY #
05323 M00S05321.sslabel +++| ITEM SP$VSN C(8); # SPECIFIED CARTRIDGE *CSND* #
05324 M00S05322.sslabel +++| ITEM SP$Y U; # Y COORDINATE #
05325 M00S05323.sslabel +++| ITEM SP$Z U; # Z COORDINATE #
05326 M00S05324.sslabel +++|
05327 M00S05325.sslabel +++|
05328 M00S05326.sslabel +++| ARRAY PK$CSU$ENT [0:0] P(4); # *PICK* SMMAP ENTRY #
05329 M00S05327.sslabel +++| BEGIN
05330 M00S05328.sslabel +++| ITEM PK$MAPENT C(00,00,30); # THREE WORD MAP ENTRY #
05331 M00S05329.sslabel +++| ITEM PK$Y U(03,00,30); # Y COORDINATE #
05332 M00S05330.sslabel +++| ITEM PK$Z U(03,30,30); # Z COORDINATE #
05333 M00S05331.sslabel +++| END
05334 M00S05332.sslabel +++|
05335 M00S05333.sslabel +++|
05336 M00S05334.sslabel +++| CONTROL EJECT;
05337 M00S05335.sslabel +++|
05338 M00S05336.sslabel +++|#
05339 M00S05337.sslabel +++|* CHECK FOR *N* OPTION OR *LOC* OPTION.
05340 M00S05338.sslabel +++|#
05341 M00S05339.sslabel +++|
05342 M00S05340.sslabel +++| LOC$OPTION = FALSE;
05343 M00S05341.sslabel +++| IF LBARG$YI[0] NQ -1 OR LBARG$ZI[0] NQ -1
05344 M00S05342.sslabel +++| THEN # *LOC* OPTION SPECIFIED #
05345 M00S05343.sslabel +++| BEGIN
05346 M00S05344.sslabel +++| SETCORD; # BUILD Y,Z MATRIX #
05347 M00S05345.sslabel +++| LOC$OPTION = TRUE;
05348 M00S05346.sslabel +++| END
05349 M00S05347.sslabel +++|
05350 M00S05348.sslabel +++|#
05351 M00S05349.sslabel +++|* PROCESS EACH OF THE *N* CUBES SPECIFIED.
05352 M00S05350.sslabel +++|#
05353 M00S05351.sslabel +++|
05354 M00S05352.sslabel +++| SP$VSN = " ";
05355 M00S05353.sslabel +++| SP$FAM = " ";
05356 M00S05354.sslabel +++| SP$SUB = 0;
05357 M00S05355.sslabel +++| FASTFOR I = 1 STEP 1 UNTIL LBARG$N[0]
05358 M00S05356.sslabel +++| DO
05359 M00S05357.sslabel +++| BEGIN # PROCESS *N* CUBES #
05360 M00S05358.sslabel +++| IF NOT LOC$OPTION
05361 M00S05359.sslabel +++| THEN
05362 M00S05360.sslabel +++| BEGIN # *N* OPTION #
05363 M00S05361.sslabel +++| SERTYPE = S"ASSIGN"; # SEARCH FOR ASSIGNED CUBE #
05364 M00S05362.sslabel +++| IF LBARG$PK[0] EQ "F"
05365 M00S05363.sslabel +++| THEN # REMOVE CUBE FROM FAMILY #
05366 M00S05364.sslabel +++| BEGIN
05367 M00S05365.sslabel +++| SP$CODE = CUBSTAT"SUBFAM";
05368 M00S05366.sslabel +++| SP$FAM = LBARG$FM[0];
05369 M00S05367.sslabel +++| SP$SUB = LBARG$SB[0];
05370 M00S05368.sslabel +++| END
05371 M00S05369.sslabel +++|
05372 M00S05370.sslabel +++| IF LBARG$PK[0] EQ "P"
05373 M00S05371.sslabel +++| THEN # REMOVE CUBE FROM POOL #
05374 M00S05372.sslabel +++| BEGIN
05375 M00S05373.sslabel +++| SP$CODE = CUBSTAT"SCRPOOL";
05376 M00S05374.sslabel +++| END
05377 M00S05375.sslabel +++|
05378 M00S05376.sslabel +++| IF LBARG$PK[0] EQ "R"
05379 M00S05377.sslabel +++| THEN # REMOVE FROM RESERVED AREA #
05380 M00S05378.sslabel +++| BEGIN
05381 M00S05379.sslabel +++| SP$CODE = CUBSTAT"ALTCSU";
05382 M00S05380.sslabel +++| END
05383 M00S05381.sslabel +++|
05384 M00S05382.sslabel +++| END # *N* OPTION #
05385 M00S05383.sslabel +++|
05386 M00S05384.sslabel +++| ELSE
05387 M00S05385.sslabel +++| BEGIN # *LOC* OPTION #
05388 M00S05386.sslabel +++| SERTYPE = S"LOC"; # LOOK FOR SPECIFIC LOCATION #
05389 M00S05387.sslabel +++| SP$Y = Y$COORD[I];
05390 M00S05388.sslabel +++| SP$Z = Z$COORD[I];
05391 M00S05389.sslabel +++| END # *LOC* OPTION #
05392 M00S05390.sslabel +++|
05393 M00S05391.sslabel +++|#
05394 M00S05392.sslabel +++|* SEARCH THE SMMAP FOR THE SPECIFIED ENTRY.
05395 M00S05393.sslabel +++|#
05396 M00S05394.sslabel +++|
05397 M00S05395.sslabel +++| SERCSU(SERTYPE,SP$Y,SP$Z,SP$CODE,SP$VSN,SP$FAM,SP$SUB,
05398 M00S05396.sslabel +++| PK$CSU$ENT[0],FLAG);
05399 M00S05397.sslabel +++| IF FLAG NQ OK
05400 M00S05398.sslabel +++| THEN # NO EMPTY CUBES #
05401 M00S05399.sslabel +++| BEGIN
05402 M00S05400.sslabel +++| NUMDONE = I - 1;
05403 M00S05401.sslabel +++| ERRCODE = S"NO$EMPCB";
05404 M00S05402.sslabel +++| LBERR(ERRCODE);
05405 M00S05403.sslabel +++| RETURN;
05406 M00S05404.sslabel +++| END
05407 M00S05405.sslabel +++|
05408 M00S05406.sslabel +++|#
05409 M00S05407.sslabel +++|* CHECK CUBE ASSIGNMENT.
05410 M00S05408.sslabel +++|#
05411 M00S05409.sslabel +++|
05412 M00S05410.sslabel +++| P<SMUMAP> = LOC(PK$CSU$ENT[0]);
05413 M00S05411.sslabel +++| IF CM$CSND[0] NQ " "
05414 M00S05412.sslabel +++| THEN # CUBE NOT EMPTY #
05415 M00S05413.sslabel +++| BEGIN
05416 M00S05414.sslabel +++| NUMDONE = I - 1;
05417 M00S05415.sslabel +++| ERRCODE = S"CB$NOT$EMP";
05418 M00S05416.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING #
05419 M00S05417.sslabel +++| RETURN;
05420 M00S05418.sslabel +++| END
05421 M00S05419.sslabel +++|
05422 M00S05420.sslabel +++| IF LBARG$PK[0] EQ "F" ##
05423 M00S05421.sslabel +++| AND CM$CODE[0] EQ CUBSTAT"SUBFAM" ##
05424 M00S05422.sslabel +++| AND CM$FMLYNM[0] EQ LBARG$FM[0] ##
05425 M00S05423.sslabel +++| AND CM$SUB[0] EQ LBARG$SB[0]
05426 M00S05424.sslabel +++| THEN # REMOVE CUBE FROM FAMILY #
05427 M00S05425.sslabel +++| BEGIN
05428 M00S05426.sslabel +++| REQCODE = REQTYP3"RMV$CUBE";
05429 M00S05427.sslabel +++| END
05430 M00S05428.sslabel +++|
05431 M00S05429.sslabel +++| ELSE
05432 M00S05430.sslabel +++| BEGIN # REMOVE FROM POOL/RESERVED AREA #
05433 M00S05431.sslabel +++| IF (LBARG$PK[0] EQ "P" AND CM$CODE[0] EQ CUBSTAT"SCRPOOL")
05434 M00S05432.sslabel +++| OR (LBARG$PK[0] EQ "R" AND CM$CODE[0] EQ CUBSTAT"ALTCSU")
| Line S00003 Modification History |
M01 (Added by) | msea013 |
Seq # *Modification Id* Act
----------------------------+
05435 M01S00003.msea013 +++| OR (LBARG$PK[0] EQ "R" AND CM$CODE[0] EQ CUBSTAT"SYSUSE")
05436 M00S05433.sslabel +++| THEN
05437 M00S05434.sslabel +++| BEGIN
05438 M00S05435.sslabel +++| REQCODE = REQTYP3"UPD$MAP"; # UPDATE SMMAP ENTRY #
05439 M00S05436.sslabel +++| CM$CODE[0] = CUBSTAT"UNASGN";
05440 M00S05437.sslabel +++| CM$FLAG1[0] = FALSE; # CLEAR ERROR FLAG IN MAP ENTRY #
05441 M00S05438.sslabel +++| END
05442 M00S05439.sslabel +++|
05443 M00S05440.sslabel +++| ELSE # PROCESS ERROR CONDITION #
05444 M00S05441.sslabel +++| BEGIN
05445 M00S05442.sslabel +++| NUMDONE = I - 1;
05446 M00S05443.sslabel +++| ERRCODE = S"UNX$CB$ASN";
05447 M00S05444.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING #
05448 M00S05445.sslabel +++| RETURN;
05449 M00S05446.sslabel +++| END
05450 M00S05447.sslabel +++|
05451 M00S05448.sslabel +++| END # REMOVE FROM POOL/RESERVED AREA #
05452 M00S05449.sslabel +++|
05453 M00S05450.sslabel +++|#
05454 M00S05451.sslabel +++|* ISSUE TYPE 3 CALLSS REQUEST AND DO ERROR PROCESSING IF AN
05455 M00S05452.sslabel +++|* ERROR STATUS IS RETURNED BY EXEC.
05456 M00S05453.sslabel +++|#
05457 M00S05454.sslabel +++|
05458 M00S05455.sslabel +++| CALL3(REQCODE,PK$CSU$ENT[0],0,0,RESP$CODE);
05459 M00S05456.sslabel +++| IF RESP$CODE NQ RESPTYP3"OK3"
05460 M00S05457.sslabel +++| THEN # PROCESS THE RESPONSE #
05461 M00S05458.sslabel +++| BEGIN
05462 M00S05459.sslabel +++| LBRESP(RESP$CODE,TYP"TYP3");
05463 M00S05460.sslabel +++| RETURN;
05464 M00S05461.sslabel +++| END
05465 M00S05462.sslabel +++|
05466 M00S05463.sslabel +++| MFLUSH;
05467 M00S05464.sslabel +++| END # PROCESS *N* CUBES #
05468 M00S05465.sslabel +++|
05469 M00S05466.sslabel +++| RETURN;
05470 M00S05467.sslabel +++|
05471 M00S05468.sslabel +++| END # LBRMCUB #
05472 M00S05469.sslabel +++|
05473 M00S05470.sslabel +++| TERM
05474 M00S05471.sslabel +++|PROC LBRMMSC;
05475 M00S05472.sslabel +++|# TITLE LBRMMSC - REMOVES CARTRIDGES FROM A FAMILY OR POOL. #
05476 M00S05473.sslabel +++|
05477 M00S05474.sslabel +++| BEGIN # LBRMMSC #
05478 M00S05475.sslabel +++|
05479 M00S05476.sslabel +++|#
05480 M00S05477.sslabel +++|** LBRMMSC - REMOVES CARTRIDGES FROM A FAMILY OR POOL.
05481 M00S05478.sslabel +++|*
05482 M00S05479.sslabel +++|* THIS PROC LOCATES AND REMOVES EMPTY CARTRIDGES.
05483 M00S05480.sslabel +++|*
05484 M00S05481.sslabel +++|* PROC LBRMMSC.
05485 M00S05482.sslabel +++|*
05486 M00S05483.sslabel +++|* ENTRY CRACKED AND SYNTAX CHECKED DIRECTIVE
05487 M00S05484.sslabel +++|* PARAMETERS SET UP IN COMMON AREA DEFINED
05488 M00S05485.sslabel +++|* IN *COMTLBP*.
05489 M00S05486.sslabel +++|* (LB$BUFP) = FWA OF A BUFFER 1101B WORDS LONG.
05490 M00S05487.sslabel +++|*
05491 M00S05488.sslabel +++|* EXIT CARTRIDGES REMOVED OR ERROR CONDITION.
05492 M00S05489.sslabel +++|*
05493 M00S05490.sslabel +++|* MESSAGES FAMILY NOT FOUND.
05494 M00S05491.sslabel +++|* CARTRIDGE NOT EMPTY, VSN.
05495 M00S05492.sslabel +++|*
05496 M00S05493.sslabel +++|* NOTES PROC *LBRMMSC* OPENS THE CATALOG AND SEARCHES IT
05497 M00S05494.sslabel +++|* FOR CARTRIDGES FREE IF NO CSN
05498 M00S05495.sslabel +++|* IS SPECIFIED. IF CSN IS SPECIFIED THE SMMAP IS
05499 M00S05496.sslabel +++|* SEARCHED FOR A MATCHING CSN. IF THE *LOST* OPTION
05500 M00S05497.sslabel +++|* IS SPECIFIED, THE CARTRIDGE IS REMOVED FROM THE
05501 M00S05498.sslabel +++|* FAMILY AFTER VERIFYING THAT IT IS MISSING AND
05502 M00S05499.sslabel +++|* ASSIGNED TO THE FAMILY. THE CARTRIDGE IS LOADED
05503 M00S05500.sslabel +++|* AND ITS LABEL IS CHECKED. A NEW SCRATCH LABEL IS
05504 M00S05501.sslabel +++|* WRITTEN AND THE CARTRIDGE IS UNLOADED TO THE POOL
05505 M00S05502.sslabel +++|* OR OUTPUT DRAWER, AS SPECIFIED BY *PT*.
05506 M00S05503.sslabel +++|#
05507 M00S05504.sslabel +++|
05508 M00S05505.sslabel +++|#
05509 M00S05506.sslabel +++|**** PROC LBRMMSC - XREF LIST BEGIN.
05510 M00S05507.sslabel +++|#
05511 M00S05508.sslabel +++|
05512 M00S05509.sslabel +++| XREF
05513 M00S05510.sslabel +++| BEGIN
05514 M00S05511.sslabel +++| PROC CALL3; # ISSUES TYPE 3 EXEC CALLSS #
05515 M00S05512.sslabel +++| PROC CALL4; # ISSUES TYPE 4 EXEC CALLSS #
05516 M00S05513.sslabel +++| PROC CCLOSE; # CLOSE SFMCAT #
05517 M00S05514.sslabel +++| PROC CGETFCT; # GETS AN FCT ENTRY #
05518 M00S05515.sslabel +++| PROC COPEN; # OPENS THE CATALOG #
05519 M00S05516.sslabel +++| PROC DLABFLD; # DISPLAY CARTRIDGE LABEL FIELDS #
05520 M00S05517.sslabel +++| PROC GENLAB; # GENERATES A NEW LABEL #
05521 M00S05518.sslabel +++| PROC LBERR; # *SSLABEL* ERROR PROCESSOR #
05522 M00S05519.sslabel +++| PROC LBRESP; # RESPONSE CODE PROCESSOR #
05523 M00S05520.sslabel +++| PROC LOFPROC; # LIST OF FILES PROCESSOR #
05524 M00S05521.sslabel +++| PROC MCLOSE; # CLOSE SMMAP #
05525 M00S05522.sslabel +++| PROC MESSAGE; # DISPLAYS MESSAGE #
05526 M00S05523.sslabel +++| PROC MFLUSH; # FLUSH MAP BUFFER #
05527 M00S05524.sslabel +++| PROC MOPEN; # OPEN SMMAP #
05528 M00S05525.sslabel +++| PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT
05529 M00S05526.sslabel +++| OR RETURN #
05530 M00S05527.sslabel +++| PROC SERAST; # SEARCH FOR EMPTY CARTRIDGES #
05531 M00S05528.sslabel +++| PROC SERCSU; # SEARCHES THE SMMAP #
05532 M00S05529.sslabel +++| PROC SETPFP; # SET FAMILY AND USER INDEX #
05533 M00S05530.sslabel +++| FUNC XCOD; # INTEGER TO DISPLAY CONVERSION #
05534 M00S05531.sslabel +++| END
05535 M00S05532.sslabel +++|
05536 M00S05533.sslabel +++|#
05537 M00S05534.sslabel +++|**** PROC LBRMMSC - XREF LIST END.
05538 M00S05535.sslabel +++|#
05539 M00S05536.sslabel +++|
05540 M00S05537.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS #
05541 M00S05538.sslabel +++|*CALL COMBFAS
05542 M00S05539.sslabel +++|*CALL COMBCMS
05543 M00S05540.sslabel +++|*CALL,COMBCMD
05544 M00S05541.sslabel +++|*CALL COMBCPR
05545 M00S05542.sslabel +++|*CALL COMBLBL
05546 M00S05543.sslabel +++|*CALL COMBMAP
05547 M00S05544.sslabel +++|*CALL COMBMCT
05548 M00S05545.sslabel +++|*CALL COMBPFP
05549 M00S05546.sslabel +++|*CALL COMSPFM
05550 M00S05547.sslabel +++|*CALL COMTERR
05551 M00S05548.sslabel +++|*CALL COMTLAB
05552 M00S05549.sslabel +++|*CALL COMTLBP
05553 M00S05550.sslabel +++|
05554 M00S05551.sslabel +++| ITEM CART$CSN C(20); # CARTRIDGE SERIAL NUMBER #
05555 M00S05552.sslabel +++| ITEM ERR$CNT I; # ERROR COUNT #
05556 M00S05553.sslabel +++| ITEM FCTORD U; # EMPTY CARTRIDGE FCT ORDINAL #
05557 M00S05554.sslabel +++| ITEM FLAG I; # ERROR FLAG #
05558 M00S05555.sslabel +++| ITEM HR$ERR I; # HARD READ ERRORS #
05559 M00S05556.sslabel +++| ITEM I I; # LOOP VARIABLE #
05560 M00S05557.sslabel +++| ITEM LD$CNT I; # LOAD COUNT #
05561 M00S05558.sslabel +++| ITEM LD$ERR I; # LOAD ERRORS #
05562 M00S05559.sslabel +++| ITEM PS$CNT I; # PASS COUNT #
05563 M00S05560.sslabel +++| ITEM REQCODE I; # REQUEST CODE #
05564 M00S05561.sslabel +++| ITEM RESP$CODE I; # RESPONSE CODE #
05565 M00S05562.sslabel +++| ITEM SERTYPE S:SERCH$TYPE; # SEARCH TYPE #
05566 M00S05563.sslabel +++| ITEM SGROUP I; # SAVE GROUP PARAMETER #
05567 M00S05564.sslabel +++| ITEM SLOT I; # DRAWER NUMBER #
05568 M00S05565.sslabel +++| ITEM SP$CODE I; # SPECIFIED CODE #
05569 M00S05566.sslabel +++| ITEM SP$Y I; # SPECIFIED Y #
05570 M00S05567.sslabel +++| ITEM SP$Z I; # SPECIFIED Z #
05571 M00S05568.sslabel +++| ITEM SR$ERR I; # SOFT READ ERRORS #
05572 M00S05569.sslabel +++| ITEM STR$RD I; # STRIPES READ #
05573 M00S05570.sslabel +++| ITEM STR$WR I; # STRIPES WRITTEN #
05574 M00S05571.sslabel +++| ITEM STR$DM I; # STRIPES DEMARKED #
05575 M00S05572.sslabel +++| ITEM SW$ERR I; # SOFT WRITE ERRORS #
05576 M00S05573.sslabel +++|
05577 M00S05574.sslabel +++| ARRAY CMAP$NM [0:0] P(1); # BUILD SMMAP NAME #
05578 M00S05575.sslabel +++| BEGIN
05579 M00S05576.sslabel +++| ITEM CMAP$NAME C(00,00,07); # SMMAP FILE NAME #
05580 M00S05577.sslabel +++| ITEM CMAP$IN C(00,00,05); # FIRST 5 CHARACTERS #
05581 M00S05578.sslabel +++| ITEM CMAP$ID C(00,30,01); # SM-ID #
05582 M00S05579.sslabel +++| ITEM CMAP$Z C(00,36,24) = [0]; # ZERO FILL #
05583 M00S05580.sslabel +++| END
05584 M00S05581.sslabel +++|
05585 M00S05582.sslabel +++| ARRAY MSFCATNM [0:0] P(1); # CATALOG NAME #
05586 M00S05583.sslabel +++| BEGIN
05587 M00S05584.sslabel +++| ITEM MSFCAT$NM C(00,00,06); # FIRST 6 CHARACTERS #
05588 M00S05585.sslabel +++| ITEM MSFCAT$LST C(00,36,01); # LAST CHARACTER #
05589 M00S05586.sslabel +++| END
05590 M00S05587.sslabel +++|
05591 M00S05588.sslabel +++| ARRAY PK$CSU$ENT [0:0] P(4); # *PICK* SMMAP ENTRY #
05592 M00S05589.sslabel +++| BEGIN
05593 M00S05590.sslabel +++| ITEM PK$MAPENT C(00,00,30); # THREE WORD SMMAP ENTRY #
05594 M00S05591.sslabel +++| ITEM PK$Y U(03,00,30); # Y COORDINATE #
05595 M00S05592.sslabel +++| ITEM PK$Z U(03,30,30); # Z COORDINATE #
05596 M00S05593.sslabel +++| END
05597 M00S05594.sslabel +++|
05598 M00S05595.sslabel +++|
05599 M00S05596.sslabel +++| ARRAY PT$CSU$ENT [0:0] P(5); # *PUT* SMMAP ENTRY #
05600 M00S05597.sslabel +++| BEGIN
05601 M00S05598.sslabel +++| ITEM PT$MAPENT C(00,00,30); # THREE WORD MAP ENTRY #
05602 M00S05599.sslabel +++| ITEM PT$Y U(03,00,30); # Y COORDINATE #
05603 M00S05600.sslabel +++| ITEM PT$Z U(03,30,30); # Z COORDINATE #
05604 M00S05601.sslabel +++| ITEM PT$GR U(04,00,07); # GROUP #
05605 M00S05602.sslabel +++| ITEM PT$GRT U(04,07,04); # GROUP ORDINAL #
05606 M00S05603.sslabel +++| END
05607 M00S05604.sslabel +++|
05608 M00S05605.sslabel +++|
05609 M00S05606.sslabel +++| CONTROL EJECT;
05610 M00S05607.sslabel +++|
05611 M00S05608.sslabel +++|#
05612 M00S05609.sslabel +++|* INITIALIZE POINTERS AND MISCELLANEOUS ITEMS.
05613 M00S05610.sslabel +++|#
05614 M00S05611.sslabel +++|
05615 M00S05612.sslabel +++| PFP$WRD0[0] = 0;
05616 M00S05613.sslabel +++| PFP$FG1[0] = TRUE;
05617 M00S05614.sslabel +++| PFP$FG4[0] = TRUE;
05618 M00S05615.sslabel +++| P<FCT> = LB$BUFP;
05619 M00S05616.sslabel +++| P<SMUMAP> = LOC(PK$CSU$ENT[0]);
05620 M00S05617.sslabel +++| SGROUP = LBARG$GR[0];
05621 M00S05618.sslabel +++|
05622 M00S05619.sslabel +++|#
05623 M00S05620.sslabel +++|* REMOVE EACH OF *N* CARTRIDGES FROM THE FAMILY OR POOL.
05624 M00S05621.sslabel +++|#
05625 M00S05622.sslabel +++|
05626 M00S05623.sslabel +++| SLOWFOR I = 1 STEP 1 UNTIL LBARG$N[0]
05627 M00S05624.sslabel +++| DO
05628 M00S05625.sslabel +++| BEGIN # REMOVE CARTRIDGE #
05629 M00S05626.sslabel +++| LBARG$GR[0] = SGROUP;
05630 M00S05627.sslabel +++|
05631 M00S05628.sslabel +++|#
05632 M00S05629.sslabel +++|* PROCESSING FOR *CSN NOT SPECIFIED*.
05633 M00S05630.sslabel +++|#
05634 M00S05631.sslabel +++|
05635 M00S05632.sslabel +++| P<SMUMAP> = LOC(PT$CSU$ENT[0]);
05636 M00S05633.sslabel +++| IF LBARG$C[0] EQ 0
05637 M00S05634.sslabel +++| THEN
05638 M00S05635.sslabel +++| BEGIN # CSN NOT SPECIFIED #
05639 M00S05636.sslabel +++|
05640 M00S05637.sslabel +++| IF LBARG$PK[0] EQ "F"
05641 M00S05638.sslabel +++| THEN
05642 M00S05639.sslabel +++| BEGIN # SELECT CARTRIDGE FROM FAMILY #
05643 M00S05640.sslabel +++|
05644 M00S05641.sslabel +++|#
05645 M00S05642.sslabel +++|* OPEN CATALOG AND CHECK ERROR STATUS.
05646 M00S05643.sslabel +++|#
05647 M00S05644.sslabel +++|
05648 M00S05645.sslabel +++| PFP$FAM[0] = LBARG$FM[0];
05649 M00S05646.sslabel +++| PFP$UI[0] = DEF$UI + LBARG$SB[0];
05650 M00S05647.sslabel +++| SETPFP(PFP);
05651 M00S05648.sslabel +++| IF PFP$STAT[0] NQ 0
05652 M00S05649.sslabel +++| THEN # FAMILY NOT FOUND #
05653 M00S05650.sslabel +++| BEGIN
05654 M00S05651.sslabel +++| LBMSG$LN[0] = " FAMILY NOT FOUND.";
05655 M00S05652.sslabel +++| MESSAGE(LBMSG[0],SYSUDF1);
05656 M00S05653.sslabel +++| RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
05657 M00S05654.sslabel +++| END
05658 M00S05655.sslabel +++|
05659 M00S05656.sslabel +++| MSFCAT$NM[0] = SFMCAT; # SET UP CATALOG NAME #
05660 M00S05657.sslabel +++| MSFCAT$LST[0] = XCOD(LBARG$SB[0]);
05661 M00S05658.sslabel +++| COPEN(LBARG$FM[0],LBARG$SB[0],MSFCATNM[0],"RM",TRUE,FLAG);
05662 M00S05659.sslabel +++| IF FLAG EQ CMASTAT"NOERR"
05663 M00S05660.sslabel +++| THEN
05664 M00S05661.sslabel +++| BEGIN
05665 M00S05662.sslabel +++| LOFPROC(OCT$LFN[1]); # ADD LFN TO LIST OF FILES #
05666 M00S05663.sslabel +++| END
05667 M00S05664.sslabel +++|
05668 M00S05665.sslabel +++| IF FLAG NQ CMASTAT"NOERR" AND FLAG NQ CMASTAT"FOPEN"
05669 M00S05666.sslabel +++| THEN # ERROR CONDITION OTHER THAN
05670 M00S05667.sslabel +++| *CATALOG ALREADY OPEN* #
05671 M00S05668.sslabel +++| BEGIN
05672 M00S05669.sslabel +++| LBRESP(FLAG,0);
05673 M00S05670.sslabel +++| RETURN;
05674 M00S05671.sslabel +++| END
05675 M00S05672.sslabel +++|
05676 M00S05673.sslabel +++|
05677 M00S05674.sslabel +++|#
05678 M00S05675.sslabel +++|* SEARCH *AST* FOR EMPTY CARTRIDGE.
05679 M00S05676.sslabel +++|#
05680 M00S05677.sslabel +++|
05681 M00S05678.sslabel +++| SERAST(FCTORD,FLAG);
05682 M00S05679.sslabel +++| IF FLAG NQ OK
05683 M00S05680.sslabel +++| THEN # NO EMPTY CARTRIDGE FOUND #
05684 M00S05681.sslabel +++| BEGIN
05685 M00S05682.sslabel +++| NUMDONE = I - 1;
05686 M00S05683.sslabel +++| ERRCODE = S"NO$EMP$CR";
05687 M00S05684.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING #
05688 M00S05685.sslabel +++| RETURN;
05689 M00S05686.sslabel +++| END
05690 M00S05687.sslabel +++|
05691 M00S05688.sslabel +++|#
05692 M00S05689.sslabel +++|* GET FCT ENTRY OF EMPTY CARTRIDGE AND SET LOAD, PASS,
05693 M00S05690.sslabel +++|* AND ERROR COUNTS FOR NEW LABEL.
05694 M00S05691.sslabel +++|#
05695 M00S05692.sslabel +++|
05696 M00S05693.sslabel +++| CGETFCT(LBARG$FM[0],LBARG$SB[0],LBARG$SMID[0],FCTORD,
05697 M00S05694.sslabel +++| LB$BUFP,0,FLAG);
05698 M00S05695.sslabel +++| IF FLAG NQ OK
05699 M00S05696.sslabel +++| THEN # PROCESS ERROR STATUS #
05700 M00S05697.sslabel +++| BEGIN
05701 M00S05698.sslabel +++| LBRESP(FLAG,0);
05702 M00S05699.sslabel +++| RETURN;
05703 M00S05700.sslabel +++| END
05704 M00S05701.sslabel +++|
05705 M00S05702.sslabel +++| LD$CNT = FCT$CRLD[0];
05706 M00S05703.sslabel +++| HR$ERR = FCT$HRDE[0];
05707 M00S05704.sslabel +++| SW$ERR = FCT$SWRE[0];
05708 M00S05705.sslabel +++| SR$ERR = FCT$SRDE[0];
05709 M00S05706.sslabel +++| STR$RD = FCT$STRD[0];
05710 M00S05707.sslabel +++| STR$WR = FCT$STWR[0];
05711 M00S05708.sslabel +++| STR$DM = FCT$STDM[0];
05712 M00S05709.sslabel +++|
05713 M00S05710.sslabel +++|#
05714 M00S05711.sslabel +++|* GET SMMAP ENTRY.
05715 M00S05712.sslabel +++|#
05716 M00S05713.sslabel +++|
05717 M00S05714.sslabel +++| SERTYPE = S"LOC";
05718 M00S05715.sslabel +++| SERCSU(SERTYPE,FCT$Y[0],FCT$Z[0],0,0,0,0, PK$CSU$ENT[0],
05719 M00S05716.sslabel +++| FLAG);
05720 M00S05717.sslabel +++| CCLOSE(LBARG$FM[0],LBARG$SB[0],0,FLAG);
05721 M00S05718.sslabel +++| END # SELECT CARTRIDGE FROM FAMILY #
05722 M00S05719.sslabel +++|
05723 M00S05720.sslabel +++| IF LBARG$PK[0] EQ "P"
05724 M00S05721.sslabel +++| THEN
05725 M00S05722.sslabel +++| BEGIN # SELECT CARTRIDGE FROM POOL #
05726 M00S05723.sslabel +++| SERTYPE = S"CART$POOL";
05727 M00S05724.sslabel +++| SERCSU(SERTYPE,0,0,0,0,0,0,PK$CSU$ENT[0],FLAG);
05728 M00S05725.sslabel +++| IF FLAG NQ OK
05729 M00S05726.sslabel +++| THEN # POOL EMPTY #
05730 M00S05727.sslabel +++| BEGIN
05731 M00S05728.sslabel +++| NUMDONE = I - 1;
05732 M00S05729.sslabel +++| ERRCODE = S"NO$CR$PL";
05733 M00S05730.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING #
05734 M00S05731.sslabel +++| RETURN;
05735 M00S05732.sslabel +++| END
05736 M00S05733.sslabel +++|
05737 M00S05734.sslabel +++| CMAP$ID[0] = LBARG$SM[0];
05738 M00S05735.sslabel +++| CMAP$IN[0] = SMMAP;
05739 M00S05736.sslabel +++| END # SELECT CARTRIDGE FROM POOL #
05740 M00S05737.sslabel +++|
05741 M00S05738.sslabel +++| END # VSN NOT SPECIFIED #
05742 M00S05739.sslabel +++|
05743 M00S05740.sslabel +++|#
05744 M00S05741.sslabel +++|* PROCESSING FOR *VSN SPECIFIED*.
05745 M00S05742.sslabel +++|#
05746 M00S05743.sslabel +++|
05747 M00S05744.sslabel +++| IF LBARG$C[0] NQ 0
05748 M00S05745.sslabel +++| THEN
05749 M00S05746.sslabel +++| BEGIN # VSN SPECIFIED #
05750 M00S05747.sslabel +++| SERTYPE = S"CSN$MATCH"; # SEARCH FOR VSN #
05751 M00S05748.sslabel +++| SERCSU(SERTYPE,0,0,0,LBARG$C[0],0,0,PK$CSU$ENT[0],FLAG);
05752 M00S05749.sslabel +++| IF FLAG NQ 0
05753 M00S05750.sslabel +++| THEN # VSN NOT FOUND #
05754 M00S05751.sslabel +++| BEGIN
05755 M00S05752.sslabel +++| ERRCODE = S"CSN$NOTFND";
05756 M00S05753.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING #
05757 M00S05754.sslabel +++| RETURN;
05758 M00S05755.sslabel +++| END
05759 M00S05756.sslabel +++|
05760 M00S05757.sslabel +++|#
05761 M00S05758.sslabel +++|* OPEN CATALOG AND CHECK ERROR STATUS.
05762 M00S05759.sslabel +++|#
05763 M00S05760.sslabel +++|
05764 M00S05761.sslabel +++| IF CM$CODE[0] EQ CUBSTAT"SUBFAM"
05765 M00S05762.sslabel +++| THEN
05766 M00S05763.sslabel +++| BEGIN # OPEN CATALOG #
05767 M00S05764.sslabel +++| PFP$FAM[0] = CM$FMLYNM[0];
05768 M00S05765.sslabel +++| PFP$UI[0] = DEF$UI + CM$SUB[0];
05769 M00S05766.sslabel +++| SETPFP(PFP);
05770 M00S05767.sslabel +++| IF PFP$STAT[0] NQ 0
05771 M00S05768.sslabel +++| THEN # FAMILY NOT FOUND #
05772 M00S05769.sslabel +++| BEGIN
05773 M00S05770.sslabel +++| LBMSG$LN[0] = " FAMILY NOT FOUND.";
05774 M00S05771.sslabel +++| MESSAGE(LBMSG[0],SYSUDF1);
05775 M00S05772.sslabel +++| RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
05776 M00S05773.sslabel +++| END
05777 M00S05774.sslabel +++|
05778 M00S05775.sslabel +++| MSFCAT$NM[0] = SFMCAT; # SET UP CATALOG NAME #
05779 M00S05776.sslabel +++| MSFCAT$LST[0] = XCOD(CM$SUB[0]);
05780 M00S05777.sslabel +++| COPEN(CM$FMLYNM[0],CM$SUB[0],MSFCATNM[0],"RM",TRUE,FLAG);
05781 M00S05778.sslabel +++| IF FLAG EQ CMASTAT"NOERR"
05782 M00S05779.sslabel +++| THEN
05783 M00S05780.sslabel +++| BEGIN
05784 M00S05781.sslabel +++| LOFPROC(OCT$LFN[1]); # ADD LFN TO LIST OF FILES #
05785 M00S05782.sslabel +++| END
05786 M00S05783.sslabel +++|
05787 M00S05784.sslabel +++| IF FLAG NQ CMASTAT"NOERR" AND FLAG NQ CMASTAT"FOPEN"
05788 M00S05785.sslabel +++| THEN # ERROR CONDITION OTHER THAN
05789 M00S05786.sslabel +++| *CATALOG ALREADY OPEN* #
05790 M00S05787.sslabel +++| BEGIN
05791 M00S05788.sslabel +++| LBRESP(FLAG,0);
05792 M00S05789.sslabel +++| RETURN;
05793 M00S05790.sslabel +++| END
05794 M00S05791.sslabel +++|
05795 M00S05792.sslabel +++| END # OPEN CATALOG #
05796 M00S05793.sslabel +++|
05797 M00S05794.sslabel +++| END # VSN SPECIFIED #
05798 M00S05795.sslabel +++|
05799 M00S05796.sslabel +++|#
05800 M00S05797.sslabel +++|* *LOST* OPTION PROCESSING.
05801 M00S05798.sslabel +++|#
05802 M00S05799.sslabel +++|
05803 M00S05800.sslabel +++| IF LBARG$LT[0] NQ 0
05804 M00S05801.sslabel +++| THEN
05805 M00S05802.sslabel +++| BEGIN # *LOST* OPTION SPECIFIED #
05806 M00S05803.sslabel +++| IF CM$CODE[0] NQ CUBSTAT"SUBFAM"
05807 M00S05804.sslabel +++| THEN # NOT A FAMILY CARTRIDGE #
05808 M00S05805.sslabel +++| BEGIN
05809 M00S05806.sslabel +++| ERRCODE = S"UNX$CR$ASN";
05810 M00S05807.sslabel +++| LBERR(ERRCODE);
05811 M00S05808.sslabel +++| RETURN;
05812 M00S05809.sslabel +++| END
05813 M00S05810.sslabel +++|
05814 M00S05811.sslabel +++|#
05815 M00S05812.sslabel +++|* GET FCT ENTRY FOR SPECIFIED CARTRIDGE.
05816 M00S05813.sslabel +++|#
05817 M00S05814.sslabel +++|
05818 M00S05815.sslabel +++| CGETFCT(CM$FMLYNM[0],CM$SUB[0],LBARG$SMID[0],CM$FCTORD[0],
05819 M00S05816.sslabel +++| LB$BUFP,0,FLAG);
05820 M00S05817.sslabel +++| IF FLAG NQ OK
05821 M00S05818.sslabel +++| THEN # PROCESS ERROR STATUS #
05822 M00S05819.sslabel +++| BEGIN
05823 M00S05820.sslabel +++| LBRESP(FLAG,0);
05824 M00S05821.sslabel +++| RETURN;
05825 M00S05822.sslabel +++| END
05826 M00S05823.sslabel +++|
05827 M00S05824.sslabel +++| IF NOT FCT$LCF[0]
05828 M00S05825.sslabel +++| THEN # FCT *LOST* FLAG NOT SET #
05829 M00S05826.sslabel +++| BEGIN
05830 M00S05827.sslabel +++| ERRCODE = S"LOST$NSET";
05831 M00S05828.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING #
05832 M00S05829.sslabel +++| RETURN;
05833 M00S05830.sslabel +++| END
05834 M00S05831.sslabel +++|
05835 M00S05832.sslabel +++| REQCODE = REQTYP4"LOAD$CART";
05836 M00S05833.sslabel +++| CALL4(REQCODE,DRD$NUM,CART$CSN,PK$Y[0],PK$Z[0],RESP$CODE);
05837 M00S05834.sslabel +++| IF RESP$CODE EQ RESPTYP4"CELL$EMP"
05838 M00S05835.sslabel +++| THEN
05839 M00S05836.sslabel +++| BEGIN # REMOVE LOST CARTRIDGE FROM FAMILY #
05840 M00S05837.sslabel +++| REQCODE = REQTYP3"RMV$CART";
05841 M00S05838.sslabel +++| CALL3(REQCODE,PK$CSU$ENT,0,0,RESP$CODE);
05842 M00S05839.sslabel +++| IF RESP$CODE EQ RESPTYP3"MSC$NEMPTY"
05843 M00S05840.sslabel +++| THEN
05844 M00S05841.sslabel +++| BEGIN
05845 M00S05842.sslabel +++| LBMSG$LINE[0] = " CARTRIDGE NOT EMPTY, .";
05846 M00S05843.sslabel +++| LBMSG$CSN[0] = CM$CSND[0];
05847 M00S05844.sslabel +++| MESSAGE(LBMSG$BUF[0],SYSUDF1);
05848 M00S05845.sslabel +++| TEST I;
05849 M00S05846.sslabel +++| END
05850 M00S05847.sslabel +++|
05851 M00S05848.sslabel +++| IF RESP$CODE NQ RESPTYP3"OK3"
05852 M00S05849.sslabel +++| THEN
05853 M00S05850.sslabel +++| BEGIN
05854 M00S05851.sslabel +++| LBRESP(RESP$CODE,TYP"TYP3");
05855 M00S05852.sslabel +++| END
05856 M00S05853.sslabel +++|
05857 M00S05854.sslabel +++| RETURN;
05858 M00S05855.sslabel +++| END # REMOVE LOST CARTRIDGE FROM FAMILY #
05859 M00S05856.sslabel +++|
05860 M00S05857.sslabel +++| ELSE
05861 M00S05858.sslabel +++| BEGIN # PROCESS ERROR STATUS #
05862 M00S05859.sslabel +++| IF RESP$CODE EQ RESPTYP4"OK4"
05863 M00S05860.sslabel +++| THEN
05864 M00S05861.sslabel +++| BEGIN
05865 M00S05862.sslabel +++| REQCODE = REQTYP4"UNLD$CART";
05866 M00S05863.sslabel +++| CALL4(REQCODE,0,0,PK$Y[0],PK$Z[0],RESP$CODE);
05867 M00S05864.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4"
05868 M00S05865.sslabel +++| THEN
05869 M00S05866.sslabel +++| BEGIN
05870 M00S05867.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4");
05871 M00S05868.sslabel +++| RETURN;
05872 M00S05869.sslabel +++| END
05873 M00S05870.sslabel +++|
05874 M00S05871.sslabel +++| ERRCODE = S"LOST$SET";
05875 M00S05872.sslabel +++| LBERR(ERRCODE);
05876 M00S05873.sslabel +++| RETURN;
05877 M00S05874.sslabel +++| END
05878 M00S05875.sslabel +++|
05879 M00S05876.sslabel +++| ELSE # PROCESS DETAIL STATUS #
05880 M00S05877.sslabel +++| BEGIN
05881 M00S05878.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4");
05882 M00S05879.sslabel +++| RETURN;
05883 M00S05880.sslabel +++| END
05884 M00S05881.sslabel +++|
05885 M00S05882.sslabel +++| END # PROCESS ERROR STATUS #
05886 M00S05883.sslabel +++|
05887 M00S05884.sslabel +++| END # *LOST* OPTION SPECIFIED #
05888 M00S05885.sslabel +++|
05889 M00S05886.sslabel +++|#
05890 M00S05887.sslabel +++|* CHECK CARTRIDGE ASSIGNMENT AND *PT* OPTION.
05891 M00S05888.sslabel +++|#
05892 M00S05889.sslabel +++|
05893 M00S05890.sslabel +++| IF CM$CODE[0] EQ CUBSTAT"SCRPOOL" AND LBARG$PT[0] EQ "P"
05894 M00S05891.sslabel +++| THEN # IGNORE THE CARTRIDGE #
05895 M00S05892.sslabel +++| BEGIN
05896 M00S05893.sslabel +++| TEST I;
05897 M00S05894.sslabel +++| END
05898 M00S05895.sslabel +++|
05899 M00S05896.sslabel +++|#
05900 M00S05897.sslabel +++|* FIND EMPTY OUTPUT DRAWER OR CUBE IN POOL.
05901 M00S05898.sslabel +++|#
05902 M00S05899.sslabel +++|
05903 M00S05900.sslabel +++| IF LBARG$PT[0] EQ "D"
05904 M00S05901.sslabel +++| THEN
05905 M00S05902.sslabel +++| BEGIN # FIND EMPTY OUTPUT DRAWER #
05906 M00S05903.sslabel +++| P<SMUMAP> = LOC(PT$CSU$ENT[0]);
05907 M00S05904.sslabel +++| PT$Y[0] = 12;
05908 M00S05905.sslabel +++| PT$Z[0] = 0;
05909 M00S05906.sslabel +++| CM$FCTORD[0] = 0;
05910 M00S05907.sslabel +++| CM$FMLYNM[0] = "";
05911 M00S05908.sslabel +++| END # FIND EMPTY OUTPUT DRAWER #
05912 M00S05909.sslabel +++|
05913 M00S05910.sslabel +++| ELSE
05914 M00S05911.sslabel +++| BEGIN # FIND EMPTY CUBE IN POOL #
05915 M00S05912.sslabel +++| SERTYPE = S"ASSIGN";
05916 M00S05913.sslabel +++| SP$CODE = CUBSTAT"SCRPOOL";
05917 M00S05914.sslabel +++| SERCSU(SERTYPE,0,0,SP$CODE,"","",0,PT$CSU$ENT[0],FLAG);
05918 M00S05915.sslabel +++| IF FLAG NQ 0
05919 M00S05916.sslabel +++| THEN # NO EMPTY CUBES IN FAMILY/POOL #
05920 M00S05917.sslabel +++| BEGIN
05921 M00S05918.sslabel +++| NUMDONE = I - 1;
05922 M00S05919.sslabel +++| ERRCODE = S"NO$EMPCBFP";
05923 M00S05920.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING #
05924 M00S05921.sslabel +++| RETURN;
05925 M00S05922.sslabel +++| END
05926 M00S05923.sslabel +++|
05927 M00S05924.sslabel +++| END # FIND EMPTY CUBE IN POOL #
05928 M00S05925.sslabel +++|
05929 M00S05926.sslabel +++|#
05930 M00S05927.sslabel +++|* GET CARTRIDGE AND CHECK ITS LABEL.
05931 M00S05928.sslabel +++|#
05932 M00S05929.sslabel +++|
05933 M00S05930.sslabel +++| REQCODE = REQTYP4"LOAD$CART";
05934 M00S05931.sslabel +++| CALL4(REQCODE,DRD$NUM,CART$CSN,PK$Y[0],PK$Z[0],RESP$CODE);
05935 M00S05932.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" ##
05936 M00S05933.sslabel +++| THEN
05937 M00S05934.sslabel +++| BEGIN # LOAD FAILS #
05938 M00S05935.sslabel +++| IF RESP$CODE EQ RESPTYP4"CELL$EMP"
05939 M00S05936.sslabel +++| THEN
05940 M00S05937.sslabel +++| BEGIN # SET UP ERROR FLAGS #
05941 M00S05938.sslabel +++| P<SMUMAP> = LOC(PK$CSU$ENT[0]);
05942 M00S05939.sslabel +++| IF CM$CODE[0] EQ CUBSTAT"SCRPOOL"
05943 M00S05940.sslabel +++| THEN # SET ERROR FLAG IN SMMAP ENTRY #
05944 M00S05941.sslabel +++| BEGIN
05945 M00S05942.sslabel +++| CM$FLAG1[0] = TRUE;
05946 M00S05943.sslabel +++| CALL3(REQTYP3"UPD$MAP",PK$CSU$ENT[0],0,0,FLAG);
05947 M00S05944.sslabel +++| END
05948 M00S05945.sslabel +++|
05949 M00S05946.sslabel +++| ELSE # SET LOST FLAG IN CATALOG ENTRY #
05950 M00S05947.sslabel +++| BEGIN
05951 M00S05948.sslabel +++| CALL3(REQTYP3"UPD$CAT",PK$CSU$ENT[0],UCF"LOST",1,FLAG);
05952 M00S05949.sslabel +++| END
05953 M00S05950.sslabel +++|
05954 M00S05951.sslabel +++| NUMDONE = I - 1;
05955 M00S05952.sslabel +++| ERRCODE = S"CR$NOTFND"; # CARTRIDGE NOT FOUND #
05956 M00S05953.sslabel +++| LBERR(ERRCODE);
05957 M00S05954.sslabel +++| IF FLAG NQ RESPTYP3"OK3"
05958 M00S05955.sslabel +++| THEN
05959 M00S05956.sslabel +++| BEGIN
05960 M00S05957.sslabel +++| LBRESP(FLAG,TYP"TYP3");
05961 M00S05958.sslabel +++| RETURN;
05962 M00S05959.sslabel +++| END
05963 M00S05960.sslabel +++|
05964 M00S05961.sslabel +++| RETURN;
05965 M00S05962.sslabel +++| END # SET UP ERROR FLAGS #
05966 M00S05963.sslabel +++|
05967 M00S05964.sslabel +++| ELSE # PROCESS RESPONSE CODE #
05968 M00S05965.sslabel +++| BEGIN
05969 M00S05966.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4");
05970 M00S05967.sslabel +++| IF RESP$CODE EQ RESPTYP4"CART$LB$ERR" ##
05971 M00S05968.sslabel +++| OR RESP$CODE EQ RESPTYP4"UNK$CART"
05972 M00S05969.sslabel +++| THEN # UNLOAD CARTRIDGE TO EXIT TRAY #
05973 M00S05970.sslabel +++| BEGIN
05974 M00S05971.sslabel +++| CALL4(REQTYP4"UNLD$CART",0,0,SM$EXIT$TY,SM$TY$Z, ##
05975 M00S05972.sslabel +++| RESP$CODE);
05976 M00S05973.sslabel +++| END
05977 M00S05974.sslabel +++|
05978 M00S05975.sslabel +++| RETURN;
05979 M00S05976.sslabel +++| END
05980 M00S05977.sslabel +++|
05981 M00S05978.sslabel +++| END # LOAD FAILS #
05982 M00S05979.sslabel +++|
05983 M00S05980.sslabel +++|
05984 M00S05981.sslabel +++| P<SMUMAP> = LOC(PK$CSU$ENT[0]);
05985 M00S05982.sslabel +++| P<LABEL$CART> = OLDLABP;
05986 M00S05983.sslabel +++|
05987 M00S05984.sslabel +++|#
05988 M00S05985.sslabel +++|* VERIFY VSN, Y, Z IN THE LABEL.
05989 M00S05986.sslabel +++|#
05990 M00S05987.sslabel +++|
05991 M00S05988.sslabel +++| IF LAB$CSND[0] NQ CM$CSND[0] ##
05992 M00S05989.sslabel +++| AND(LAB$Y[0] NQ PK$Y[0] OR LAB$Z[0] NQ PK$Z[0])
05993 M00S05990.sslabel +++| THEN
05994 M00S05991.sslabel +++| BEGIN # TEST Y,Z #
05995 M00S05992.sslabel +++| REQCODE = REQTYP4"UNLD$CART";
05996 M00S05993.sslabel +++| CALL4(REQCODE,0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE);
05997 M00S05994.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4"
05998 M00S05995.sslabel +++| THEN
05999 M00S05996.sslabel +++| BEGIN
06000 M00S05997.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4");
06001 M00S05998.sslabel +++| RETURN;
06002 M00S05999.sslabel +++| END
06003 M00S06000.sslabel +++|
06004 M00S06001.sslabel +++| ERRCODE = S"M86$HARDWR"; # MSF HARDWARE PROBLEM #
06005 M00S06002.sslabel +++| LBERR(ERRCODE);
06006 M00S06003.sslabel +++| RETURN;
06007 M00S06004.sslabel +++| END # TEST Y,Z #
06008 M00S06005.sslabel +++|
06009 M00S06006.sslabel +++| IF CM$CODE[0] EQ CUBSTAT"SCRPOOL"
06010 M00S06007.sslabel +++| THEN # CARTRIDGE FROM POOL #
06011 M00S06008.sslabel +++| BEGIN
06012 M00S06009.sslabel +++| LD$CNT = LAB$CRLD[0]; # USE OLD LOAD/PASS/ERROR COUNTS #
06013 M00S06010.sslabel +++| LD$ERR = LAB$LDER[0];
06014 M00S06011.sslabel +++| SR$ERR = LAB$SRDE[0];
06015 M00S06012.sslabel +++| SW$ERR = LAB$SWRE1[0];
06016 M00S06013.sslabel +++| B<28,4>SW$ERR = LAB$SWRE[0];
06017 M00S06014.sslabel +++| HR$ERR = LAB$HRDE[0];
06018 M00S06015.sslabel +++| STR$RD = LAB$STRD[0];
06019 M00S06016.sslabel +++| STR$WR = LAB$STWR1[0];
06020 M00S06017.sslabel +++| B<36,24>STR$WR = LAB$STWR[0];
06021 M00S06018.sslabel +++| STR$DM = LAB$STDM[0];
06022 M00S06019.sslabel +++| END
06023 M00S06020.sslabel +++|
06024 M00S06021.sslabel +++|#
06025 M00S06022.sslabel +++|* CHECK IF CSU, Y, Z, FAMILY, AND SUBFAMILY DO NOT
06026 M00S06023.sslabel +++|* AGREE IN OLDLABEL AND SMMAP ENTRY.
06027 M00S06024.sslabel +++|#
06028 M00S06025.sslabel +++|
06029 M00S06026.sslabel +++| IF LAB$SMID[0] NQ LBARG$SMID[0]
06030 M00S06027.sslabel +++| OR LAB$Y[0] NQ PK$Y[0]
06031 M00S06028.sslabel +++| OR LAB$Z[0] NQ PK$Z[0]
06032 M00S06029.sslabel +++| OR LAB$FMLY[0] NQ CM$FMLYNM[0]
06033 M00S06030.sslabel +++| OR LAB$SF[0] NQ CM$SUB[0]
06034 M00S06031.sslabel +++| THEN
06035 M00S06032.sslabel +++| BEGIN # SET UP ERROR FLAGS #
06036 M00S06033.sslabel +++| IF CM$CODE[0] EQ CUBSTAT"SCRPOOL"
06037 M00S06034.sslabel +++| THEN # SET ERROR FLAG IN SMMAP ENTRY #
06038 M00S06035.sslabel +++| BEGIN
06039 M00S06036.sslabel +++| CM$FLAG1[0] = TRUE;
06040 M00S06037.sslabel +++| CALL3(REQTYP3"UPD$MAP",PK$CSU$ENT[0],0,0,FLAG);
06041 M00S06038.sslabel +++| END
06042 M00S06039.sslabel +++|
06043 M00S06040.sslabel +++| ELSE # SET LOST FLAG IN CATALOG ENTRY #
06044 M00S06041.sslabel +++| BEGIN
06045 M00S06042.sslabel +++| CALL3(REQTYP3"UPD$CAT",PK$CSU$ENT[0],UCF"LOST",1,FLAG);
06046 M00S06043.sslabel +++| END
06047 M00S06044.sslabel +++|
06048 M00S06045.sslabel +++| IF FLAG NQ RESPTYP3"OK3"
06049 M00S06046.sslabel +++| THEN
06050 M00S06047.sslabel +++| BEGIN
06051 M00S06048.sslabel +++| LBRESP(FLAG,TYP"TYP3");
06052 M00S06049.sslabel +++| REQCODE = REQTYP4"UNLD$CART";
06053 M00S06050.sslabel +++| CALL4(REQCODE,0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE);
06054 M00S06051.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4"
06055 M00S06052.sslabel +++| THEN
06056 M00S06053.sslabel +++| BEGIN
06057 M00S06054.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4");
06058 M00S06055.sslabel +++| RETURN;
06059 M00S06056.sslabel +++| END
06060 M00S06057.sslabel +++|
06061 M00S06058.sslabel +++| RETURN;
06062 M00S06059.sslabel +++| END
06063 M00S06060.sslabel +++|
06064 M00S06061.sslabel +++| DLABFLD;
06065 M00S06062.sslabel +++| REQCODE = REQTYP4"UNLD$CART";
06066 M00S06063.sslabel +++| CALL4(REQCODE,0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE);
06067 M00S06064.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4"
06068 M00S06065.sslabel +++| THEN
06069 M00S06066.sslabel +++| BEGIN
06070 M00S06067.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4");
06071 M00S06068.sslabel +++| RETURN;
06072 M00S06069.sslabel +++| END
06073 M00S06070.sslabel +++|
06074 M00S06071.sslabel +++| ERRCODE = S"UNXP$CYZFS";
06075 M00S06072.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING #
06076 M00S06073.sslabel +++| RETURN;
06077 M00S06074.sslabel +++| END # SET UP ERROR FLAGS #
06078 M00S06075.sslabel +++|
06079 M00S06076.sslabel +++|#
06080 M00S06077.sslabel +++|* GENERATE LABEL AND UPDATE SMUMAP.
06081 M00S06078.sslabel +++|#
06082 M00S06079.sslabel +++|
06083 M00S06080.sslabel +++| GENLAB(LABTYPE"SCR$LAB",PT$CSU$ENT[0],LD$CNT,LD$ERR, ##
06084 M00S06081.sslabel +++| SR$ERR,SW$ERR,HR$ERR,STR$RD,STR$WR,STR$DM);
06085 M00S06082.sslabel +++| P<LABEL$CART> = NEWLABP;
06086 M00S06083.sslabel +++| IF B<0,8>LAB$CSN[0] NQ X"C9" ##
06087 M00S06084.sslabel +++| OR B<8,8>LAB$CSN[0] NQ X"C2" OR B<16,8>LAB$CSN[0] NQ X"D4"
06088 M00S06085.sslabel +++| THEN # CARTRIDGE IS NOT IBM #
06089 M00S06086.sslabel +++| BEGIN
06090 M00S06087.sslabel +++| LAB$CCOD[0] = OTHCART;
06091 M00S06088.sslabel +++| END
06092 M00S06089.sslabel +++|
06093 M00S06090.sslabel +++| ELSE
06094 M00S06091.sslabel +++| BEGIN
06095 M00S06092.sslabel +++| LAB$CCOD[0] = IBMCART;
06096 M00S06093.sslabel +++| END
06097 M00S06094.sslabel +++|
06098 M00S06095.sslabel +++| LAB$CRLD[0] = LAB$CRLD[0] + 1; # UPDATE LOAD/PASS COUNTS #
06099 M00S06096.sslabel +++| IF LBARG$PT[0] EQ "D"
06100 M00S06097.sslabel +++| THEN # CLEAR CSU, Y, Z FIELDS #
06101 M00S06098.sslabel +++| BEGIN
06102 M00S06099.sslabel +++| LAB$SMID[0] = 0;
06103 M00S06100.sslabel +++| LAB$Y[0] = 12; # SET TO CAS EXIT #
06104 M00S06101.sslabel +++| LAB$Z[0] = 0;
06105 M00S06102.sslabel +++| END
06106 M00S06103.sslabel +++|
06107 M00S06104.sslabel +++| P<SMUMAP>= LOC(PK$CSU$ENT[0]);
06108 M00S06105.sslabel +++| IF CM$CODE[0] EQ CUBSTAT"SUBFAM"
06109 M00S06106.sslabel +++| THEN # ASSIGNED TO FAMILY #
06110 M00S06107.sslabel +++| BEGIN
06111 M00S06108.sslabel +++| REQCODE = REQTYP3"RMV$CART";
06112 M00S06109.sslabel +++| END
06113 M00S06110.sslabel +++|
06114 M00S06111.sslabel +++| ELSE # ASSIGNED TO POOL #
06115 M00S06112.sslabel +++| BEGIN
06116 M00S06113.sslabel +++| REQCODE = REQTYP3"UPD$MAP";
06117 M00S06114.sslabel +++| CM$CSND[0] = " "; # REMOVE VSN FROM SMMAP ENTRY #
06118 M00S06115.sslabel +++| CM$CCOD[0] = " ";
06119 M00S06116.sslabel +++| CM$FLAG1[0] = FALSE; # CLEAR ERROR FLAG IN MAP ENTRY #
06120 M00S06117.sslabel +++| END
06121 M00S06118.sslabel +++|
06122 M00S06119.sslabel +++| CALL3(REQCODE,PK$CSU$ENT[0],0,0,RESP$CODE);
06123 M00S06120.sslabel +++| IF RESP$CODE NQ RESPTYP3"OK3"
06124 M00S06121.sslabel +++| THEN # FAMILY/POOL REMOVAL FAILS #
06125 M00S06122.sslabel +++| BEGIN # PROCESS ERROR RESPONSE #
06126 M00S06123.sslabel +++| IF RESP$CODE NQ RESPTYP3"MSC$NEMPTY"
06127 M00S06124.sslabel +++| THEN
06128 M00S06125.sslabel +++| BEGIN
06129 M00S06126.sslabel +++| LBRESP(RESP$CODE,TYP"TYP3");
06130 M00S06127.sslabel +++| REQCODE = REQTYP4"UNLD$CART";
06131 M00S06128.sslabel +++| CALL4(REQCODE,0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE);
06132 M00S06129.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4"
06133 M00S06130.sslabel +++| THEN
06134 M00S06131.sslabel +++| BEGIN
06135 M00S06132.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4");
06136 M00S06133.sslabel +++| RETURN;
06137 M00S06134.sslabel +++| END
06138 M00S06135.sslabel +++|
06139 M00S06136.sslabel +++| RETURN;
06140 M00S06137.sslabel +++| END
06141 M00S06138.sslabel +++|
06142 M00S06139.sslabel +++| ELSE
06143 M00S06140.sslabel +++| BEGIN # PROCESS CARTRIDGE NOT EMPTY #
06144 M00S06141.sslabel +++|
06145 M00S06142.sslabel +++|
06146 M00S06143.sslabel +++|#
06147 M00S06144.sslabel +++|* UNLOAD CARTRIDGE BACK AT ORIGINAL LOCATION.
06148 M00S06145.sslabel +++|#
06149 M00S06146.sslabel +++|
06150 M00S06147.sslabel +++| CALL4(REQTYP4"UNLD$CART",DRD$NUM,CART$CSN,PK$Y[0], ##
06151 M00S06148.sslabel +++| PK$Z[0],RESP$CODE);
06152 M00S06149.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4"
06153 M00S06150.sslabel +++| THEN
06154 M00S06151.sslabel +++| BEGIN
06155 M00S06152.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4");
06156 M00S06153.sslabel +++| RETURN;
06157 M00S06154.sslabel +++| END
06158 M00S06155.sslabel +++|
06159 M00S06156.sslabel +++| ERRCODE = S"CR$NTEMPT";
06160 M00S06157.sslabel +++| LBERR(ERRCODE);
06161 M00S06158.sslabel +++| END # PROCESS CARTRIDGE NOT EMPTY #
06162 M00S06159.sslabel +++|
06163 M00S06160.sslabel +++| END # PROCESS ERROR RESPONSE #
06164 M00S06161.sslabel +++|
06165 M00S06162.sslabel +++|#
06166 M00S06163.sslabel +++|* WRITE NEW LABEL AND PUT CARTRIDGE IN NEW LOCATION.
06167 M00S06164.sslabel +++|#
06168 M00S06165.sslabel +++|
06169 M00S06166.sslabel +++| REQCODE = REQTYP4"WRT$LAB";
06170 M00S06167.sslabel +++| CALL4(REQCODE,DRD$NUM,CART$CSN,PT$Y,PT$Z,RESP$CODE);
06171 M00S06168.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4"
06172 M00S06169.sslabel +++| THEN # *WRITE* FAILS #
06173 M00S06170.sslabel +++| BEGIN
06174 M00S06171.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4");
06175 M00S06172.sslabel +++| RETURN;
06176 M00S06173.sslabel +++| END
06177 M00S06174.sslabel +++|
06178 M00S06175.sslabel +++| IF LBARG$PT[0] EQ "P"
06179 M00S06176.sslabel +++| THEN
06180 M00S06177.sslabel +++| BEGIN # ADD CARTRIDGE TO POOL #
06181 M00S06178.sslabel +++| REQCODE = REQTYP3"UPD$MAP";
06182 M00S06179.sslabel +++| P<SMUMAP> = LOC(PT$CSU$ENT[0]);
06183 M00S06180.sslabel +++| CM$CSND[0] = LAB$CSND[0];
06184 M00S06181.sslabel +++| CM$CCOD[0] = LAB$CCOD[0];
06185 M00S06182.sslabel +++|
06186 M00S06183.sslabel +++|#
06187 M00S06184.sslabel +++|* ADD CARTRIDGE TO POOL.
06188 M00S06185.sslabel +++|#
06189 M00S06186.sslabel +++|
06190 M00S06187.sslabel +++| CALL3(REQCODE,PT$CSU$ENT[0],0,0,RESP$CODE);
06191 M00S06188.sslabel +++| IF RESP$CODE NQ RESPTYP3"OK3"
06192 M00S06189.sslabel +++| THEN # MAP UPDATE FAILS #
06193 M00S06190.sslabel +++| BEGIN
06194 M00S06191.sslabel +++| LBRESP(RESP$CODE,TYP"TYP3");
06195 M00S06192.sslabel +++| RETURN;
06196 M00S06193.sslabel +++| END
06197 M00S06194.sslabel +++|
06198 M00S06195.sslabel +++| END # ADD CARTRIDGE TO POOL #
06199 M00S06196.sslabel +++|
06200 M00S06197.sslabel +++| MFLUSH; # FLUSH MAP BUFFER #
06201 M00S06198.sslabel +++| END
06202 M00S06199.sslabel +++|
06203 M00S06200.sslabel +++|
06204 M00S06201.sslabel +++| RETURN;
06205 M00S06202.sslabel +++|
06206 M00S06203.sslabel +++| END # LBRMMSC #
06207 M00S06204.sslabel +++|
06208 M00S06205.sslabel +++| TERM
06209 M00S06206.sslabel +++|PROC LBRSMSC;
06210 M00S06207.sslabel +++|# TITLE LBRSMSC - RESTORES A CARTRIDGE TO THE CSU. #
06211 M00S06208.sslabel +++|
06212 M00S06209.sslabel +++| BEGIN # LBRSMSC #
06213 M00S06210.sslabel +++|
06214 M00S06211.sslabel +++|#
06215 M00S06212.sslabel +++|** LBRSMSC - RESTORES A CARTRIDGE TO THE CSU.
06216 M00S06213.sslabel +++|*
06217 M00S06214.sslabel +++|* THIS PROC GETS A CARTRIDGE FROM THE INPUT DRAWER AND RETURNS
06218 M00S06215.sslabel +++|* IT TO ITS ASSIGNED LOCATION.
06219 M00S06216.sslabel +++|*
06220 M00S06217.sslabel +++|* PROC LBRSMSC.
06221 M00S06218.sslabel +++|*
06222 M00S06219.sslabel +++|* ENTRY CRACKED AND SYNTAX CHECKED DIRECTIVE
06223 M00S06220.sslabel +++|* PARAMETERS SET UP IN COMMON AREA DEFINED
06224 M00S06221.sslabel +++|* IN *COMTLBP*.
06225 M00S06222.sslabel +++|*
06226 M00S06223.sslabel +++|* EXIT CARTRIDGE RESTORED OR ERROR CONDITION.
06227 M00S06224.sslabel +++|*
06228 M00S06225.sslabel +++|* NOTES PROC *LBRSMSC* CHECKS THAT THERE IS A CARTRIDGE IN
06229 M00S06226.sslabel +++|* AN INPUT DRAWER AS SPECIFIED, AND CALLS EXEC TO
06230 M00S06227.sslabel +++|* BRING THE CARTRIDGE TO A DRIVE AND READ ITS LABEL.
06231 M00S06228.sslabel +++|* IF THE LABEL HAS THE CORRECT *SM* NUMBER, AND IF
06232 M00S06229.sslabel +++|* A SMMAP ENTRY IS FOUND WITH MATCHING VSN, FAMILY,
06233 M00S06230.sslabel +++|* SUBFAMILY, AND COORDINATES, THEN EXEC IS CALLED TO
06234 M00S06231.sslabel +++|* REPLACE THE CARTRIDGE AND UPDATE THE CATALOG.
06235 M00S06232.sslabel +++|#
06236 M00S06233.sslabel +++|
06237 M00S06234.sslabel +++|#
06238 M00S06235.sslabel +++|**** PROC LBRSMSC - XREF LIST BEGIN.
06239 M00S06236.sslabel +++|#
06240 M00S06237.sslabel +++|
06241 M00S06238.sslabel +++| XREF
06242 M00S06239.sslabel +++| BEGIN
06243 M00S06240.sslabel +++| PROC CALL3; # ISSUES TYPE 3 CALLSS TO EXEC #
06244 M00S06241.sslabel +++| PROC CALL4; # ISSUES TYPE 4 CALLSS TO EXEC #
06245 M00S06242.sslabel +++| PROC DLABFLD; # DISPLAY CARTRIDGE LABEL FIELDS #
06246 M00S06243.sslabel +++| PROC LBERR; # *SSLABEL* ERROR PROCESSOR #
06247 M00S06244.sslabel +++| PROC LBRESP; # RESPONSE CODE PROCESSOR #
06248 M00S06245.sslabel +++| PROC SERCSU; # SEARCHES SMMAP #
06249 M00S06246.sslabel +++| END
06250 M00S06247.sslabel +++|
06251 M00S06248.sslabel +++|#
06252 M00S06249.sslabel +++|**** PROC LBRSMSC - XREF LIST END.
06253 M00S06250.sslabel +++|#
06254 M00S06251.sslabel +++|
06255 M00S06252.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS #
06256 M00S06253.sslabel +++|*CALL COMBFAS
06257 M00S06254.sslabel +++|*CALL COMBCPR
06258 M00S06255.sslabel +++|*CALL COMBLBL
06259 M00S06256.sslabel +++|*CALL COMBMAP
06260 M00S06257.sslabel +++|*CALL COMTERR
06261 M00S06258.sslabel +++|*CALL COMTLAB
06262 M00S06259.sslabel +++|*CALL COMTLBP
06263 M00S06260.sslabel +++| ITEM CART$CSN C(20); # CARTRIDGE SERIAL NUMBER #
06264 M00S06261.sslabel +++| ITEM CATFLD U; # CATALOG FIELD #
06265 M00S06262.sslabel +++| ITEM CATVALUE I; # CATALOG VALUE #
06266 M00S06263.sslabel +++| ITEM FLAG I; # ERROR FLAG #
06267 M00S06264.sslabel +++| ITEM I I; # INDUCTION VARIABLE #
06268 M00S06265.sslabel +++| ITEM REQCODE I; # REQUEST CODE #
06269 M00S06266.sslabel +++| ITEM RESP$CODE I; # RESPONSE CODE #
06270 M00S06267.sslabel +++| ITEM SERTYPE S:SERCH$TYPE; # SEARCH TYPE #
06271 M00S06268.sslabel +++| ITEM SLOT I; # DRAWER NUMBER #
06272 M00S06269.sslabel +++| ITEM SP$VSN C(8); # SPECIFIED *CSN* #
06273 M00S06270.sslabel +++| ITEM SP$Y I; # SPECIFIED Y #
06274 M00S06271.sslabel +++| ITEM SP$Z I; # SPECIFIED Z #
06275 M00S06272.sslabel +++|
06276 M00S06273.sslabel +++|
06277 M00S06274.sslabel +++| ARRAY PT$CSU$ENT [0:0] P(5); # *PUT* SMMAP ENTRY #
06278 M00S06275.sslabel +++| BEGIN
06279 M00S06276.sslabel +++| ITEM PT$MAPENT C(00,00,30); # THREE WORD MAP ENTRY #
06280 M00S06277.sslabel +++| ITEM PT$Y U(03,00,30); # Y COORDINATE #
06281 M00S06278.sslabel +++| ITEM PT$Z U(03,30,30); # Z COORDINATE #
06282 M00S06279.sslabel +++| ITEM PT$GR U(04,00,07); # GROUP #
06283 M00S06280.sslabel +++| ITEM PT$GRT U(04,07,04); # GROUP ORDINAL #
06284 M00S06281.sslabel +++| END
06285 M00S06282.sslabel +++|
06286 M00S06283.sslabel +++| BASED
06287 M00S06284.sslabel +++| ARRAY TEMP$LAB [0:0] P(1);
06288 M00S06285.sslabel +++| BEGIN
06289 M00S06286.sslabel +++| ITEM TEMP$LABW U(00,00,60);
06290 M00S06287.sslabel +++| END
06291 M00S06288.sslabel +++|
06292 M00S06289.sslabel +++|
06293 M00S06290.sslabel +++| CONTROL EJECT;
06294 M00S06291.sslabel +++|
06295 M00S06292.sslabel +++|#
06296 M00S06293.sslabel +++|* FIND CARTRIDGE IN SPECIFIED INPUT DRAWER AND LOAD IT.
06297 M00S06294.sslabel +++|#
06298 M00S06295.sslabel +++|
06299 M00S06296.sslabel +++| REQCODE = REQTYP4"LOAD$CART";
06300 M00S06297.sslabel +++| PT$Y[0] = 14;
06301 M00S06298.sslabel +++| PT$Z[0] = 0;
06302 M00S06299.sslabel +++| CALL4(REQCODE,DRD$NUM,CART$CSN,PT$Y[0],PT$Z[0],RESP$CODE);
06303 M00S06300.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4" ##
06304 M00S06301.sslabel +++| THEN # LOAD FAILS #
06305 M00S06302.sslabel +++| BEGIN
06306 M00S06303.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4");
06307 M00S06304.sslabel +++| RETURN;
06308 M00S06305.sslabel +++| END
06309 M00S06306.sslabel +++|
06310 M00S06307.sslabel +++| DRD$NUM = CPR$DRD[0]; # SET UP TRANSPORT ID #
06311 M00S06308.sslabel +++|
06312 M00S06309.sslabel +++| P<LABEL$CART> = OLDLABP;
06313 M00S06310.sslabel +++|
06314 M00S06311.sslabel +++|#
06315 M00S06312.sslabel +++|* COMPARE THE CSU-ID, FAMILY AND THE SUBFAMILY IN THE LABEL
06316 M00S06313.sslabel +++|* AGAINST THE USER SPECIFIED VALUES.
06317 M00S06314.sslabel +++|#
06318 M00S06315.sslabel +++|
06319 M00S06316.sslabel +++| IF LAB$SMID[0] NQ LBARG$SM[0]
06320 M00S06317.sslabel +++| THEN
06321 M00S06318.sslabel +++| BEGIN
06322 M00S06319.sslabel +++| DLABFLD; # DISPLAY LABEL FIELDS #
06323 M00S06320.sslabel +++| REQCODE = REQTYP4"UNLD$CART";
06324 M00S06321.sslabel +++| CALL4(REQCODE,0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE);
06325 M00S06322.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4"
06326 M00S06323.sslabel +++| THEN
06327 M00S06324.sslabel +++| BEGIN
06328 M00S06325.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4");
06329 M00S06326.sslabel +++| RETURN;
06330 M00S06327.sslabel +++| END
06331 M00S06328.sslabel +++|
06332 M00S06329.sslabel +++| ERRCODE = S"UNXP$CYZFS";
06333 M00S06330.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING #
06334 M00S06331.sslabel +++| RETURN;
06335 M00S06332.sslabel +++| END
06336 M00S06333.sslabel +++|
06337 M00S06334.sslabel +++| SERTYPE = S"CSN$MATCH";
06338 M00S06335.sslabel +++| SP$VSN = LAB$CSND[0]; # SEARCH SMMAP FOR VSN MATCH #
06339 M00S06336.sslabel +++| SERCSU(SERTYPE,0,0,0,SP$VSN,0,0,PT$CSU$ENT[0],FLAG);
06340 M00S06337.sslabel +++| IF FLAG NQ OK
06341 M00S06338.sslabel +++| THEN # VSN NOT FOUND #
06342 M00S06339.sslabel +++| BEGIN
06343 M00S06340.sslabel +++| DLABFLD; # DISPLAY LABEL FIELDS #
06344 M00S06341.sslabel +++| REQCODE = REQTYP4"UNLD$CART";
06345 M00S06342.sslabel +++| CALL4(REQCODE,0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE);
06346 M00S06343.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4"
06347 M00S06344.sslabel +++| THEN
06348 M00S06345.sslabel +++| BEGIN
06349 M00S06346.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4");
06350 M00S06347.sslabel +++| RETURN;
06351 M00S06348.sslabel +++| END
06352 M00S06349.sslabel +++|
06353 M00S06350.sslabel +++| ERRCODE = S"CSN$NOTFND";
06354 M00S06351.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING #
06355 M00S06352.sslabel +++| RETURN;
06356 M00S06353.sslabel +++| END
06357 M00S06354.sslabel +++|
06358 M00S06355.sslabel +++| P<SMUMAP> = LOC(PT$CSU$ENT[0]);
06359 M00S06356.sslabel +++|
06360 M00S06357.sslabel +++|#
06361 M00S06358.sslabel +++|* CHECK TO SEE IF LABEL AND MAP ENTRY DIFFER ON
06362 M00S06359.sslabel +++|* Y, Z, FAMILY, OR SUBFAMILY.
06363 M00S06360.sslabel +++|#
06364 M00S06361.sslabel +++|
06365 M00S06362.sslabel +++| IF LAB$Y[0] NQ PT$Y[0] ##
06366 M00S06363.sslabel +++| OR LAB$Z[0] NQ PT$Z[0] ##
06367 M00S06364.sslabel +++| OR LAB$FMLY[0] NQ CM$FMLYNM[0] ##
06368 M00S06365.sslabel +++| OR LAB$SF[0] NQ CM$SUB[0]
06369 M00S06366.sslabel +++| THEN
06370 M00S06367.sslabel +++| BEGIN
06371 M00S06368.sslabel +++| REQCODE = REQTYP4"UNLD$CART";
06372 M00S06369.sslabel +++| CALL4(REQCODE,0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE);
06373 M00S06370.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4"
06374 M00S06371.sslabel +++| THEN
06375 M00S06372.sslabel +++| BEGIN
06376 M00S06373.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4");
06377 M00S06374.sslabel +++| RETURN;
06378 M00S06375.sslabel +++| END
06379 M00S06376.sslabel +++|
06380 M00S06377.sslabel +++| DLABFLD; # DISPLAY LABEL FIELDS #
06381 M00S06378.sslabel +++| ERRCODE = S"UNXP$CYZFS";
06382 M00S06379.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING #
06383 M00S06380.sslabel +++| RETURN;
06384 M00S06381.sslabel +++| END
06385 M00S06382.sslabel +++|
06386 M00S06383.sslabel +++|#
06387 M00S06384.sslabel +++|* CLEAR *LOST* FLAG IN THE CATALOG IF THE CARTRIDGE IS TO BE
06388 M00S06385.sslabel +++|* RESTORED TO THE FAMILY OR CLEAR SMMAP ERROR FLAG IF THE
06389 M00S06386.sslabel +++|* CARTRIDGE IS TO BE RESTORED TO THE POOL AND RETURN THE
06390 M00S06387.sslabel +++|* CARTRIDGE TO ITS ASSIGNED LOCATION.
06391 M00S06388.sslabel +++|#
06392 M00S06389.sslabel +++|
06393 M00S06390.sslabel +++|
06394 M00S06391.sslabel +++| IF CM$CODE[0] EQ CUBSTAT"SUBFAM"
06395 M00S06392.sslabel +++| THEN
06396 M00S06393.sslabel +++| BEGIN # CLEAR *LOST* FLAG #
06397 M00S06394.sslabel +++| REQCODE = REQTYP3"UPD$CAT";
06398 M00S06395.sslabel +++| CATFLD = UCF"LOST";
06399 M00S06396.sslabel +++| CATVALUE = 0; # CLEAR *LOST* FLAG IN CATALOG #
06400 M00S06397.sslabel +++| CALL3(REQCODE,PT$CSU$ENT[0],CATFLD,CATVALUE,RESP$CODE);
06401 M00S06398.sslabel +++| END # CLEAR *LOST* FLAG #
06402 M00S06399.sslabel +++|
06403 M00S06400.sslabel +++| ELSE
06404 M00S06401.sslabel +++| BEGIN # CLEAR SMMAP ERROR FLAG #
06405 M00S06402.sslabel +++| P<SMUMAP> = LOC(PT$CSU$ENT[0]);
06406 M00S06403.sslabel +++| CM$FLAG1[0] = FALSE;
06407 M00S06404.sslabel +++| REQCODE = REQTYP3"UPD$MAP";
06408 M00S06405.sslabel +++| CALL3(REQCODE,PT$CSU$ENT[0],0,0,FLAG);
06409 M00S06406.sslabel +++| END # CLEAR SMMAP ERROR FLAG #
06410 M00S06407.sslabel +++|
06411 M00S06408.sslabel +++| IF RESP$CODE NQ RESPTYP3"OK3"
06412 M00S06409.sslabel +++| THEN # UPDATE CATALOG/MAP FAILED #
06413 M00S06410.sslabel +++| BEGIN
06414 M00S06411.sslabel +++| REQCODE = REQTYP4"UNLD$CART";
06415 M00S06412.sslabel +++| CALL4(REQCODE,0,0,SM$EXIT$TY,SM$TY$Z,RESP$CODE);
06416 M00S06413.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4"
06417 M00S06414.sslabel +++| THEN
06418 M00S06415.sslabel +++| BEGIN
06419 M00S06416.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4");
06420 M00S06417.sslabel +++| RETURN;
06421 M00S06418.sslabel +++| END
06422 M00S06419.sslabel +++|
06423 M00S06420.sslabel +++| DLABFLD; # DISPLAY LABEL FIELDS #
06424 M00S06421.sslabel +++| LBRESP(RESP$CODE,TYP"TYP3");
06425 M00S06422.sslabel +++| RETURN;
06426 M00S06423.sslabel +++| END
06427 M00S06424.sslabel +++|
06428 M00S06425.sslabel +++|#
06429 M00S06426.sslabel +++|* PUT CARTRIDGE IN ASSIGNED LOCATION.
06430 M00S06427.sslabel +++|#
06431 M00S06428.sslabel +++|
06432 M00S06429.sslabel +++| P<LABEL$CART> = OLDLABP;
06433 M00S06430.sslabel +++| P<TEMP$LAB> = NEWLABP;
06434 M00S06431.sslabel +++| SLOWFOR I = 0 STEP 1 UNTIL LABLEN-1
06435 M00S06432.sslabel +++| DO # MOVE LABEL TO NEW BUFFER #
06436 M00S06433.sslabel +++| BEGIN
06437 M00S06434.sslabel +++| TEMP$LABW[I] = LAB$W1[I];
06438 M00S06435.sslabel +++| END
06439 M00S06436.sslabel +++|
06440 M00S06437.sslabel +++| REQCODE = REQTYP4"UNLD$CART";
06441 M00S06438.sslabel +++| CALL4(REQCODE,DRD$NUM,CART$CSN,PT$Y[0],PT$Z[0],RESP$CODE);
06442 M00S06439.sslabel +++| IF RESP$CODE NQ RESPTYP4"OK4"
06443 M00S06440.sslabel +++| THEN # PUT FAILS #
06444 M00S06441.sslabel +++| BEGIN
06445 M00S06442.sslabel +++| DLABFLD; # DISPLAY LABEL FIELDS #
06446 M00S06443.sslabel +++| LBRESP(RESP$CODE,TYP"TYP4");
06447 M00S06444.sslabel +++| END
06448 M00S06445.sslabel +++|
06449 M00S06446.sslabel +++| RETURN;
06450 M00S06447.sslabel +++|
06451 M00S06448.sslabel +++| END # LBRSMSC #
06452 M00S06449.sslabel +++|
06453 M00S06450.sslabel +++| TERM
06454 M00S06451.sslabel +++|PROC LBSTCLR;
06455 M00S06452.sslabel +++|# TITLE LBSTCLR - STORES A *CE* CARTRIDGE IN 0,0 OR 0,15. #
06456 M00S06453.sslabel +++|
06457 M00S06454.sslabel +++| BEGIN # LBSTCLR #
06458 M00S06455.sslabel +++|
06459 M00S06456.sslabel +++|#
06460 M00S06457.sslabel +++|** LBSTCLR - STORES A *CE* CARTRIDGE IN 0,0 OR 0,15.
06461 M00S06458.sslabel +++|*
06462 M00S06459.sslabel +++|* THIS PROC STORES A SPECIAL CARTRIDGE IN ONE OF TWO SPECIFIC
06463 M00S06460.sslabel +++|* LOCATIONS.
06464 M00S06461.sslabel +++|*
06465 M00S06462.sslabel +++|* PROC LBSTCLR.
06466 M00S06463.sslabel +++|*
06467 M00S06464.sslabel +++|* ENTRY (LBARG$CC) = IF EQUAL TO 0, STORE CARTRIDGE FROM
06468 M00S06465.sslabel +++|* DRAWER TO LOCATION 0,0.
06469 M00S06466.sslabel +++|* IF EQUAL TO 15, STORE INTO 0,15.
06470 M00S06467.sslabel +++|*
06471 M00S06468.sslabel +++|* EXIT CARTRIDGE IN LOCATION SPECIFIED.
06472 M00S06469.sslabel +++|*
06473 M00S06470.sslabel +++|#
06474 M00S06471.sslabel +++|
06475 M00S06472.sslabel +++| DEF LISTCON #0#; # DO NOT DEF LIST COMDECKS #
06476 M00S06473.sslabel +++|
06477 M00S06474.sslabel +++|#
06478 M00S06475.sslabel +++|**** PROC LBSTCLR - XREF LIST BEGIN.
06479 M00S06476.sslabel +++|#
06480 M00S06477.sslabel +++|
06481 M00S06478.sslabel +++| XREF
06482 M00S06479.sslabel +++| BEGIN
06483 M00S06480.sslabel +++| PROC CALL4; # MAKE TYPE 4 REQUESTS #
06484 M00S06481.sslabel +++| PROC CKLAB; # CHECK LABEL #
06485 M00S06482.sslabel +++| PROC GENLAB; # GENERATE CARTRIDGE LABEL #
06486 M00S06483.sslabel +++| PROC LBERR; # PROCESS ERROR RESPONSE #
06487 M00S06484.sslabel +++| PROC LBRESP; # PROCESS ERROR FROM EXEC #
06488 M00S06485.sslabel +++| PROC SERCSU; # SEARCH SMMAP #
06489 M00S06486.sslabel +++| END
06490 M00S06487.sslabel +++|
06491 M00S06488.sslabel +++|#
06492 M00S06489.sslabel +++|**** PROC LBSTCLR - XREF LIST END.
06493 M00S06490.sslabel +++|#
06494 M00S06491.sslabel +++|
06495 M00S06492.sslabel +++|*CALL COMBFAS
06496 M00S06493.sslabel +++|*CALL COMBCMD
06497 M00S06494.sslabel +++|*CALL COMBCPR
06498 M00S06495.sslabel +++|*CALL COMBLBL
06499 M00S06496.sslabel +++|*CALL COMBMAP
06500 M00S06497.sslabel +++|*CALL COMTERR
06501 M00S06498.sslabel +++|*CALL COMTLAB
06502 M00S06499.sslabel +++|*CALL COMTLBP
06503 M00S06500.sslabel +++|
06504 M00S06501.sslabel +++| ITEM FLAG U; # RESPONSE FLAG #
06505 M00S06502.sslabel +++| ITEM Y U; # Y COORDINATE #
06506 M00S06503.sslabel +++| ITEM Z U; # Z COORDINATE #
06507 M00S06504.sslabel +++| ITEM SERTYPE S:SERCH$TYPE; # TYPE OF SERACH #
06508 M00S06505.sslabel +++|
06509 M00S06506.sslabel +++| ARRAY PT$CSU$ENT [0:0] P(4); # *PUT* SMMAP ENTRY #
06510 M00S06507.sslabel +++| BEGIN
06511 M00S06508.sslabel +++| ITEM PT$MAPENT C(00,00,30); # THREE WORD MAP ENTRY #
06512 M00S06509.sslabel +++| ITEM PT$Y U(03,00,30); # Y COORDINATE #
06513 M00S06510.sslabel +++| ITEM PT$Z U(03,30,30); # Z COORDINATE #
06514 M00S06511.sslabel +++| END
06515 M00S06512.sslabel +++|
06516 M00S06513.sslabel +++| CONTROL EJECT;
06517 M00S06514.sslabel +++|
06518 M00S06515.sslabel +++|#
06519 M00S06516.sslabel +++|* LOAD CARTRIDGE FROM INPUT DRAWER AND READ LABEL.
06520 M00S06517.sslabel +++|#
06521 M00S06518.sslabel +++|
06522 M00S06519.sslabel +++| Y = SM$ENT$TY;
06523 M00S06520.sslabel +++| Z = SM$TY$Z;
06524 M00S06521.sslabel +++| CALL4(REQTYP4"LOAD$CART",0,0,Y,Z,FLAG);
06525 M00S06522.sslabel +++| IF FLAG NQ RESPTYP4"OK4" ##
06526 M00S06523.sslabel +++| AND FLAG NQ RESPTYP4"UNK$CART" ##
06527 M00S06524.sslabel +++| AND FLAG NQ RESPTYP4"CART$LB$ERR"
06528 M00S06525.sslabel +++| THEN
06529 M00S06526.sslabel +++| BEGIN
06530 M00S06527.sslabel +++| CALL4(REQTYP4"UNLD$CART",0,0,SM$EXIT$TY,Z,FLAG);
06531 M00S06528.sslabel +++| IF FLAG NQ RESPTYP4"OK4"
06532 M00S06529.sslabel +++| THEN
06533 M00S06530.sslabel +++| BEGIN
06534 M00S06531.sslabel +++| LBRESP(FLAG,TYP"TYP4");
06535 M00S06532.sslabel +++| END
06536 M00S06533.sslabel +++|
06537 M00S06534.sslabel +++| ERRCODE = S"M86$HARDWR";
06538 M00S06535.sslabel +++| LBERR(ERRCODE);
06539 M00S06536.sslabel +++| RETURN;
06540 M00S06537.sslabel +++| END
06541 M00S06538.sslabel +++|
06542 M00S06539.sslabel +++|#
06543 M00S06540.sslabel +++|* SERACH SMMAP FOR DUPLICATE *CSN*.
06544 M00S06541.sslabel +++|#
06545 M00S06542.sslabel +++|
06546 M00S06543.sslabel +++| SERTYPE = S"CSN$MATCH";
06547 M00S06544.sslabel +++| SERCSU(SERTYPE,0,0,0,LAB$CSND[0],0,0,PT$CSU$ENT[0],FLAG);
06548 M00S06545.sslabel +++| IF FLAG EQ 0
06549 M00S06546.sslabel +++| THEN # *CSN* IN MAP #
06550 M00S06547.sslabel +++| BEGIN
06551 M00S06548.sslabel +++| CALL4(REQTYP4"UNLD$CART",0,0,SM$EXIT$TY,SM$TY$Z,FLAG);
06552 M00S06549.sslabel +++| IF FLAG NQ RESPTYP4"OK4"
06553 M00S06550.sslabel +++| THEN
06554 M00S06551.sslabel +++| BEGIN
06555 M00S06552.sslabel +++| LBRESP(FLAG,TYP"TYP4");
06556 M00S06553.sslabel +++| RETURN;
06557 M00S06554.sslabel +++| END
06558 M00S06555.sslabel +++|
06559 M00S06556.sslabel +++| ERRCODE = S"DUPL$CSN";
06560 M00S06557.sslabel +++| LBERR(ERRCODE);
06561 M00S06558.sslabel +++| RETURN;
06562 M00S06559.sslabel +++| END
06563 M00S06560.sslabel +++|
06564 M00S06561.sslabel +++|
06565 M00S06562.sslabel +++|#
06566 M00S06563.sslabel +++|* PUT CARTRIDGE BACK TO DRAWER IF LABEL IS FROM FAMILY OR POOL.
06567 M00S06564.sslabel +++|#
06568 M00S06565.sslabel +++|
06569 M00S06566.sslabel +++| P<LABEL$CART> = OLDLABP;
06570 M00S06567.sslabel +++| CKLAB(FLAG);
06571 M00S06568.sslabel +++| IF FLAG EQ LABTYPE"FAM$LAB" ##
06572 M00S06569.sslabel +++| THEN
06573 M00S06570.sslabel +++| BEGIN
06574 M00S06571.sslabel +++| ERRCODE = S"GOOD$LAB";
06575 M00S06572.sslabel +++| LBERR(ERRCODE);
06576 M00S06573.sslabel +++| RETURN;
06577 M00S06574.sslabel +++| END
06578 M00S06575.sslabel +++|
06579 M00S06576.sslabel +++|
06580 M00S06577.sslabel +++|#
06581 M00S06578.sslabel +++|* GENERATE NEW LABEL.
06582 M00S06579.sslabel +++|#
06583 M00S06580.sslabel +++|
06584 M00S06581.sslabel +++| P<SMUMAP> = LOC(PT$CSU$ENT[0]);
06585 M00S06582.sslabel +++| PT$Y[0] = 0;
06586 M00S06583.sslabel +++| PT$Z[0] = LBARG$CC[0];
06587 M00S06584.sslabel +++| CM$SUB[0] = 0;
06588 M00S06585.sslabel +++| CM$FMLYNM[0] = " ";
06589 M00S06586.sslabel +++| GENLAB(LABTYPE"SCR$LAB",PT$CSU$ENT[0],0,0,0,0,0,0);
06590 M00S06587.sslabel +++| LAB$CLF[0] = 2;
06591 M00S06588.sslabel +++| LAB$RCORD[0] = 6652;
06592 M00S06589.sslabel +++|
06593 M00S06590.sslabel +++|#
06594 M00S06591.sslabel +++|* STORE CARTRIDGE.
06595 M00S06592.sslabel +++|#
06596 M00S06593.sslabel +++|
06597 M00S06594.sslabel +++| CALL4(REQTYP4"WRT$LAB",0,0,PT$Y[0],PT$Z[0],FLAG);
06598 M00S06595.sslabel +++| IF FLAG NQ RESPTYP4"OK4"
06599 M00S06596.sslabel +++| THEN
06600 M00S06597.sslabel +++| BEGIN
06601 M00S06598.sslabel +++| LBRESP(FLAG,TYP"TYP4");
06602 M00S06599.sslabel +++| RETURN;
06603 M00S06600.sslabel +++| END
06604 M00S06601.sslabel +++|
06605 M00S06602.sslabel +++|
06606 M00S06603.sslabel +++| END
06607 M00S06604.sslabel +++|
06608 M00S06605.sslabel +++| TERM
06609 M00S06606.sslabel +++|PROC SERAST(FCTORD,FLAG);
06610 M00S06607.sslabel +++|# TITLE SERAST - SEARCHES THE AST FOR AN EMPTY CARTRIDGE. #
06611 M00S06608.sslabel +++|
06612 M00S06609.sslabel +++| BEGIN # SERAST #
06613 M00S06610.sslabel +++|
06614 M00S06611.sslabel +++|#
06615 M00S06612.sslabel +++|** SERAST - SEARCHES THE AST FOR AN EMPTY CARTRIDGE.
06616 M00S06613.sslabel +++|*
06617 M00S06614.sslabel +++|* THIS PROC READS THE *AST* AND IFNDS THE FIRST EMPTY
06618 M00S06615.sslabel +++|* CARTRIDGE IN A SPECIFIED GROUP.
06619 M00S06616.sslabel +++|*
06620 M00S06617.sslabel +++|* PROC SERAST(FCTORD,FLAG)
06621 M00S06618.sslabel +++|*
06622 M00S06619.sslabel +++|* ENTRY (LB$BUFP) = FWA OF A BUFFER 1101B WORDS LONG.
06623 M00S06620.sslabel +++|* (GROUP) = IF GROUP = 0 THEN THE GROUP PARAMETER
06624 M00S06621.sslabel +++|* IS IGNORED. OTHERWISE, SELECT FROM THE
06625 M00S06622.sslabel +++|* SPECIFIED GROUP.
06626 M00S06623.sslabel +++|*
06627 M00S06624.sslabel +++|* EXIT (FCTORD) = FCT ORDINAL OF EMPTY CARTRIDGE, IF ANY.
06628 M00S06625.sslabel +++|* FREE, IF ANY.
06629 M00S06626.sslabel +++|* (FLAG) = ITEM INDICATING RESULT OF SEARCH.
06630 M00S06627.sslabel +++|* 0, EMPTY CARTRIDGE FOUND.
06631 M00S06628.sslabel +++|* 1, NO EMPTY CARTRIDGES.
06632 M00S06629.sslabel +++|*
06633 M00S06630.sslabel +++|* NOTES PROC *SERAST* READS THE *AST* FOR THE SPECIFIED
06634 M00S06631.sslabel +++|* SUBFAMILY AND GROUP. THE *AST* IS SEARCHED