LRLLS3 ;SLC/RWF - MORE LOAD/WORK LIST CODE ;2/5/91 14:41 ;
;;5.2;LAB SERVICE;;Sep 27, 1994
SHOW D ^LRWU4 Q:LRAN<1
S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRACC=^(.2),DFN=$P(^LR(LRDFN,0),U,3),LRDPF=$P(^(0),U,2) D PT^LRX
W !,LRACC," ",PNM," ",SSN
F T=0:0 S T=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,T)) Q:T<1 S X=^(T,0) W !?5,$P(^LAB(60,+X,0),U),?20," "
G SHOW
SH2 W !?5,$P(^LAB(60,+X,0),U)
S X=$P(X,U,3) W " ",$P(^LRO(68.2,+$P(X,";"),0),U)," TRAY:",$P(X,";",2)," CUP:",$P(X,";",3)
Q
CLEAR ;unload any test that has not been verified, from LRLL3
F T=0:0 S T=$O(^LRO(68.2,LRINST,1,T)) Q:T<1 D CL1
S ^LRO(68.2,LRINST,2)="^1^1^^" K T,C,X,Y,Z Q
CL1 F C=0:0 S C=$O(^LRO(68.2,LRINST,1,T,1,C)) Q:C<1 D CL2
I $O(^LRO(68.2,LRINST,1,T,1,0))="" K ^LRO(68.2,LRINST,1,T)
Q
CL2 S X=+^LRO(68.2,LRINST,1,T,1,C,0),Y=$P(^(0),U,2),Z=$P(^(0),U,3)
S I=0 F S I=$O(^LRO(68.2,LRINST,1,T,1,C,1,I)) Q:I<1 I $D(^LRO(68,X,1,Y,1,Z,4,I,0)),'$P(^(0),U,5) S $P(^LRO(68,X,1,Y,1,Z,4,I,0),U,3)=""
K ^LRO(68.2,LRINST,1,T,1,C) Q
Q
EN ;
NWSEQNM ;SET A NEW STARTING SEQUENCE NUMBER
S DIC=68.2,DIC(0)="AEQ",DIC("S")="I '$P(^(0),U,3)" D ^DIC K DIC G END:Y<1 S LRLL=+Y
NEWNUM W !,"Enter the ""new starting"" sequence number: " R X:DTIME G END:X=""!(X["^") S J=+X
W !,"Do you really want to wipe out data from ",J," on up" S %=2 D YN^DICN G NEWNUM:%'=1
L +^LAH(LRLL) F I=J-1:0 S I=$O(^LAH(LRLL,1,I)) Q:I<1 D ZAP^LRVR3
S ^LAH(LRLL)=J L -^LAH(LRLL)
END K A,DIC,I,J,LRLL,X,Y,Z
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRLLS3 1480 printed Nov 22, 2024@17:26:30 Page 2
LRLLS3 ;SLC/RWF - MORE LOAD/WORK LIST CODE ;2/5/91 14:41 ;
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
SHOW DO ^LRWU4
if LRAN<1
QUIT
+1 SET LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0)
SET LRACC=^(.2)
SET DFN=$PIECE(^LR(LRDFN,0),U,3)
SET LRDPF=$PIECE(^(0),U,2)
DO PT^LRX
+2 WRITE !,LRACC," ",PNM," ",SSN
+3 FOR T=0:0
SET T=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,T))
if T<1
QUIT
SET X=^(T,0)
WRITE !?5,$PIECE(^LAB(60,+X,0),U),?20," "
+4 GOTO SHOW
SH2 WRITE !?5,$PIECE(^LAB(60,+X,0),U)
+1 SET X=$PIECE(X,U,3)
WRITE " ",$PIECE(^LRO(68.2,+$PIECE(X,";"),0),U)," TRAY:",$PIECE(X,";",2)," CUP:",$PIECE(X,";",3)
+2 QUIT
CLEAR ;unload any test that has not been verified, from LRLL3
+1 FOR T=0:0
SET T=$ORDER(^LRO(68.2,LRINST,1,T))
if T<1
QUIT
DO CL1
+2 SET ^LRO(68.2,LRINST,2)="^1^1^^"
KILL T,C,X,Y,Z
QUIT
CL1 FOR C=0:0
SET C=$ORDER(^LRO(68.2,LRINST,1,T,1,C))
if C<1
QUIT
DO CL2
+1 IF $ORDER(^LRO(68.2,LRINST,1,T,1,0))=""
KILL ^LRO(68.2,LRINST,1,T)
+2 QUIT
CL2 SET X=+^LRO(68.2,LRINST,1,T,1,C,0)
SET Y=$PIECE(^(0),U,2)
SET Z=$PIECE(^(0),U,3)
+1 SET I=0
FOR
SET I=$ORDER(^LRO(68.2,LRINST,1,T,1,C,1,I))
if I<1
QUIT
IF $DATA(^LRO(68,X,1,Y,1,Z,4,I,0))
IF '$PIECE(^(0),U,5)
SET $PIECE(^LRO(68,X,1,Y,1,Z,4,I,0),U,3)=""
+2 KILL ^LRO(68.2,LRINST,1,T,1,C)
QUIT
+3 QUIT
EN ;
NWSEQNM ;SET A NEW STARTING SEQUENCE NUMBER
+1 SET DIC=68.2
SET DIC(0)="AEQ"
SET DIC("S")="I '$P(^(0),U,3)"
DO ^DIC
KILL DIC
if Y<1
GOTO END
SET LRLL=+Y
NEWNUM WRITE !,"Enter the ""new starting"" sequence number: "
READ X:DTIME
if X=""!(X["^")
GOTO END
SET J=+X
+1 WRITE !,"Do you really want to wipe out data from ",J," on up"
SET %=2
DO YN^DICN
if %'=1
GOTO NEWNUM
+2 LOCK +^LAH(LRLL)
FOR I=J-1:0
SET I=$ORDER(^LAH(LRLL,1,I))
if I<1
QUIT
DO ZAP^LRVR3
+3 SET ^LAH(LRLL)=J
LOCK -^LAH(LRLL)
END KILL A,DIC,I,J,LRLL,X,Y,Z
+1 QUIT
