LRBLW.m

LRBLW ;AVAMC/REG - STUFF WORKLOAD IN 65 ;11/5/93  10:38

 ;;5.2;LAB SERVICE;**247**;Sep 27, 1994

 ;Per VHA Directive 97-033 this routine should not be modified.  Medical Device # BK970021

 Q:'LRCAPA!('LRT)  I '$D(LRCAPA(2))!('$D(LRCAPA(3))) D S

 S:'$D(^LRD(65,LRX,99,0)) ^(0)="^65.3PA^^" I '$D(^(LRT,0)) S ^(0)=LRT,X=^LRD(65,LRX,99,0),^(0)=$P(X,"^",1,2)_"^"_LRT_"^"_($P(X,"^",4)+1)

 S:'$D(^LRD(65,LRX,99,LRT,1,0)) ^(0)="^65.31DA^^" I '$D(^LRD(65,LRX,99,LRT,1,LRK,0)) S ^(0)=LRK_U_DUZ_U_DUZ(2)_U_LRCAPA(2)_U_LRCAPA(3),X=^LRD(65,LRX,99,LRT,1,0),^(0)=$P(X,U,1,2)_U_LRK_U_($P(X,U,4)+1)

 F C=0:0 S C=$O(LRT(C)) Q:'C  D STF

 S ^LRD(65,"AA",LRX,LRT,LRK)=$P(^LRD(65,LRX,0),"^") I '$D(^LRD(65,LRX,99,LRT,1,LRK,1,0)) K ^LRD(65,LRX,99,LRT,1,LRK) S X=^LRD(65,LRX,99,LRT,1,0),X(1)=$O(^(0)),^(0)=$P(X,"^",1,2)_"^"_X(1)_"^"_($P(X,"^",4)-1)

 Q

STF I $D(^LRD(65,LRX,99,LRT,1,LRK,1,C,0)) S X=$P(^(0),"^",2) S:'X X=1 S X=X+1,$P(^(0),"^",2,3)=X_"^"_0 Q

 S:'$D(^LRD(65,LRX,99,LRT,1,LRK,1,0)) ^(0)="^65.311PA^^" S X=^(0),^(0)=$P(X,"^",1,2)_"^"_C_"^"_($P(X,"^",4)+1),^(C,0)=C_"^"_1 Q

 ;

RS S LRT=LRW("S") F A=0:0 S A=$O(LRW("S",A)) Q:'A  S LRT(A)=""

 D DT^LRBLU,LRBLW K LRT Q

 ;

S S X=$G(^LAB(69.9,1,8.1,DUZ(2),0)),LRCAPA(2)=$P(X,"^",2),LRCAPA(3)=$P(X,"^",3) Q

 ;

EN ;from LRBLDX,LRBLDT

 W !,"Same date/time work completed for all entries " S %=2 D YN^LRU S:%=1 LRK("LRK")=1 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRBLW   1372     printed  Apr 09, 2024@21:14:21                                                                                                                                                                                                       Page 2

LRBLW     ;AVAMC/REG - STUFF WORKLOAD IN 65 ;11/5/93  10:38

 +1       ;;5.2;LAB SERVICE;**247**;Sep 27, 1994

 +2       ;Per VHA Directive 97-033 this routine should not be modified.  Medical Device # BK970021

 +3        if 'LRCAPA!('LRT)

               QUIT 

           IF '$DATA(LRCAPA(2))!('$DATA(LRCAPA(3)))

               DO S

 +4        if '$DATA(^LRD(65,LRX,99,0))

               SET ^(0)="^65.3PA^^"

           IF '$DATA(^(LRT,0))

               SET ^(0)=LRT

               SET X=^LRD(65,LRX,99,0)

               SET ^(0)=$PIECE(X,"^",1,2)_"^"_LRT_"^"_($PIECE(X,"^",4)+1)

 +5        if '$DATA(^LRD(65,LRX,99,LRT,1,0))

               SET ^(0)="^65.31DA^^"

           IF '$DATA(^LRD(65,LRX,99,LRT,1,LRK,0))

               SET ^(0)=LRK_U_DUZ_U_DUZ(2)_U_LRCAPA(2)_U_LRCAPA(3)

               SET X=^LRD(65,LRX,99,LRT,1,0)

               SET ^(0)=$PIECE(X,U,1,2)_U_LRK_U_($PIECE(X,U,4)+1)

 +6        FOR C=0:0

               SET C=$ORDER(LRT(C))

               if 'C

                   QUIT 

               DO STF

 +7        SET ^LRD(65,"AA",LRX,LRT,LRK)=$PIECE(^LRD(65,LRX,0),"^")

           IF '$DATA(^LRD(65,LRX,99,LRT,1,LRK,1,0))

               KILL ^LRD(65,LRX,99,LRT,1,LRK)

               SET X=^LRD(65,LRX,99,LRT,1,0)

               SET X(1)=$ORDER(^(0))

               SET ^(0)=$PIECE(X,"^",1,2)_"^"_X(1)_"^"_($PIECE(X,"^",4)-1)

 +8        QUIT 

STF        IF $DATA(^LRD(65,LRX,99,LRT,1,LRK,1,C,0))

               SET X=$PIECE(^(0),"^",2)

               if 'X

                   SET X=1

               SET X=X+1

               SET $PIECE(^(0),"^",2,3)=X_"^"_0

               QUIT 

 +1        if '$DATA(^LRD(65,LRX,99,LRT,1,LRK,1,0))

               SET ^(0)="^65.311PA^^"

           SET X=^(0)

           SET ^(0)=$PIECE(X,"^",1,2)_"^"_C_"^"_($PIECE(X,"^",4)+1)

           SET ^(C,0)=C_"^"_1

           QUIT 

 +2       ;

RS         SET LRT=LRW("S")

           FOR A=0:0

               SET A=$ORDER(LRW("S",A))

               if 'A

                   QUIT 

               SET LRT(A)=""

 +1        DO DT^LRBLU

           DO LRBLW

           KILL LRT

           QUIT 

 +2       ;

S          SET X=$GET(^LAB(69.9,1,8.1,DUZ(2),0))

           SET LRCAPA(2)=$PIECE(X,"^",2)

           SET LRCAPA(3)=$PIECE(X,"^",3)

           QUIT 

 +1       ;

EN        ;from LRBLDX,LRBLDT

 +1        WRITE !,"Same date/time work completed for all entries "

           SET %=2

           DO YN^LRU

           if %=1

               SET LRK("LRK")=1

           QUIT