LRLLS3.m

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