- LRLLS3 ; IHS/DIR/FJE - MORE LOAD/WORK LIST CODE 2/5/91 14:41 ;
- ;;5.2;LR;;NOV 01, 1997
- ;
- ;;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
- W !,LRACC," ",PNM," ",HRCN ;IHS/ANMC/CLS 08/18/96
- 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
- LRLLS3 ; IHS/DIR/FJE - MORE LOAD/WORK LIST CODE 2/5/91 14:41 ;
- +1 ;;5.2;LR;;NOV 01, 1997
- +2 ;
- +3 ;;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 ;W !,LRACC," ",PNM," ",SSN
- +3 ;IHS/ANMC/CLS 08/18/96
- WRITE !,LRACC," ",PNM," ",HRCN
- +4 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," "
- +5 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
