- LRBLPEW ; IHS/DIR/FJE - BB WORKLOAD 13:09 ; [ 3/9/94 ]
- ;;5.2;LR;;NOV 01, 1997
- ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- S:LRLLOC="" LRLLOC="UNKNOWN" I '$D(^LRO(69.2,LRAA,3,LRDFN,0)) S ^(0)=LRDFN_"^"_LRLLOC,^LRO(69.2,LRAA,3,"C",LRLLOC,LRDFN)="",X=^LRO(69.2,LRAA,3,0),^(0)=$P(X,"^",1,2)_"^"_LRDFN_"^"_($P(X,"^",4)+1)
- S LRY=^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,0),LRV=$P(LRY,"^",5) I LRV,$O(^(0)),'LRW K ^LRO(68,LRAA,1,LRAD,1,"AD",$P(LRV,"."),LRAN),^LRO(68,LRAA,1,LRAD,1,"AC",LRV,LRAN) Q
- D DT^LRBLU S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,0)=$P(LRY,"^")_"^"_$P(LRY,"^",2)_"^"_$P(LRY,"^",3)_"^"_DUZ_"^"_LRK_"^"_LR(1)_" "_LR(2),$P(^LR(LRDFN,LRSS,LRI,0),"^",3)=LRK,^LRO(68,"AA",LRAA_"|"_LRAD_"|"_LRAN_"|"_LRT)=""
- S ^LRO(68,LRAA,1,LRAD,1,"AD",$P(LRK,"."),LRAN)="",^LRO(68,LRAA,1,LRAD,1,"AC",LRK,LRAN)=""
- S Y=^LRO(68,LRAA,1,LRAD,1,LRAN,0),Y(4)=$P(Y,"^",4),Y(5)=$P(Y,"^",5) I Y(4),Y(5),$D(^LRO(69,Y(4),1,Y(5),3)) S $P(^(3),"^",2)=LRK
- S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0)) ^(0)="^68.14P^^" S LRF=^(0),(C,LRG)=0
- F A=0:0 S A=$O(^LAB(60,LRT,9,A)) Q:'A I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,A,0)) S ^(0)=A_"^1^0^^^"_LRK_"^"_DUZ_"^"_DUZ(2)_"^"_LRAA_"^"_LRAA_"^"_LRAA,LRG=LRG+1,C=A
- I LRG S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0)=$P(LRF,"^",1,2)_"^"_C_"^"_($P(LRF,"^",4)+LRG)
- I 'LRW(2.1),$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,LRW(0,86250),0)) K ^(0) S X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0),X(1)=$O(^(0)),^(0)=$P(X,"^",1,2)_"^"_X(1)_"^"_($P(X,"^",4)-1)
- D:LRW(2.4)!(LRW(2.6)) CMB D:DR="[LRBLPAG]" PH Q:'LRW
- CAP K ^TMP($J) W !!,"Enter Antibody Identification Workload" S LR(62.07)=$P(LRT(LRT),U,3) I '$O(^LAB(62.07,LR(62.07),9,0)) W $C(7),!!,"No WKLD CODES to select for ",$P(^LAB(62.07,LR(62.07),0),U)," in EXECUTE CODE file." Q
- F LRA=0:0 S DIC="^LAB(62.07,LR(62.07),9,",DIC(0)="AEQM" D ^DIC K DIC Q:Y<1 D C S ^TMP($J,+Y)=X
- I '$D(^TMP($J)) W $C(7),!,"No WKLD CODES selected." Q
- W !!,"Count WKLD CODES Selected: " F A=0:0 S A=$O(^TMP($J,A)) Q:'A S B=^(A),X=^LAM(A,0) S:'B B=1 W !,$J(B,2),?6,$P(X,U,2),?16,$P(X,U)
- W !,"WKLD CODES selected OK " S %=1 D YN^LRU Q:%<1 I %'=1 W !!,$C(7),"No WKLD codes selected. Try again." G CAP
- S LRG=0 F A=0:0 S A=$O(^TMP($J,A)) Q:'A S B=^(A) I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,A,0)) S ^(0)=A_"^"_B_"^0^^^"_LRK_"^"_DUZ_"^"_DUZ(2)_"^"_LRAA_"^"_LRAA_"^"_LRAA,LRG=LRG+1,C=A
- I LRG S X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0),^(0)=$P(X,"^",1,2)_"^"_C_"^"_($P(X,"^",4)+LRG)
- Q
- CMB I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,LRW(0,86250),0)) S ^(0)=LRW(0,86250)_"^^0^^^"_LRK_"^"_DUZ_"^"_DUZ(2)_"^"_LRAA_"^"_LRAA_"^"_LRAA,X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0),^(0)=$P(X,"^",1,2)_"^"_LRW(0,86250)_"^"_($P(X,"^",4)+1)
- S X=1 S:LRW(2.4) X=X+1 S:LRW(2.6) X=X+1 S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,LRW(0,86250),0),"^",2)=X Q
- ;
- C R !," Enter WKLD CODE COUNT if more than one: ",X:DTIME Q:X=""!(X[U) I +X'=X!(X<2)!(X>20) W $C(7),!,"Enter a number from 2 to 20" G C
- Q
- PH F A=1.1,1.2,1.3,1.4 F B=0:0 S B=$O(^LR(LRDFN,"BB",LRI,A,B)) Q:'B F C=0:0 S C=$O(^LAB(61.3,B,9,C)) Q:'C D STF
- Q
- STF I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,C,0)) S X=^(0),$P(X,"^",2)=$S($P(X,"^",3):1,1:$P(X,"^",2)+1),$P(X,"^",3)=0,^(0)=X Q
- S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0)) ^(0)="^68.14P^^" S X=^(0),^(0)=$P(X,"^",1,2)_"^"_C_"^"_($P(X,"^",4)+1),^(C,0)=C Q
- LRBLPEW ; IHS/DIR/FJE - BB WORKLOAD 13:09 ; [ 3/9/94 ]
- +1 ;;5.2;LR;;NOV 01, 1997
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +4 IF LRLLOC=""
- SET LRLLOC="UNKNOWN"
- IF '$DATA(^LRO(69.2,LRAA,3,LRDFN,0))
- SET ^(0)=LRDFN_"^"_LRLLOC
- SET ^LRO(69.2,LRAA,3,"C",LRLLOC,LRDFN)=""
- SET X=^LRO(69.2,LRAA,3,0)
- SET ^(0)=$PIECE(X,"^",1,2)_"^"_LRDFN_"^"_($PIECE(X,"^",4)+1)
- +5 SET LRY=^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,0)
- SET LRV=$PIECE(LRY,"^",5)
- IF LRV
- IF $ORDER(^(0))
- IF 'LRW
- KILL ^LRO(68,LRAA,1,LRAD,1,"AD",$PIECE(LRV,"."),LRAN),^LRO(68,LRAA,1,LRAD,1,"AC",LRV,LRAN)
- QUIT
- +6 DO DT^LRBLU
- SET ^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,0)=$PIECE(LRY,"^")_"^"_$PIECE(LRY,"^",2)_"^"_$PIECE(LRY,"^",3)_"^"_DUZ_"^"_LRK_"^"_LR(1)_" "_LR(2)
- SET $PIECE(^LR(LRDFN,LRSS,LRI,0),"^",3)=LRK
- SET ^LRO(68,"AA",LRAA_"|"_LRAD_"|"_LRAN_"|"_LRT)=""
- +7 SET ^LRO(68,LRAA,1,LRAD,1,"AD",$PIECE(LRK,"."),LRAN)=""
- SET ^LRO(68,LRAA,1,LRAD,1,"AC",LRK,LRAN)=""
- +8 SET Y=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
- SET Y(4)=$PIECE(Y,"^",4)
- SET Y(5)=$PIECE(Y,"^",5)
- IF Y(4)
- IF Y(5)
- IF $DATA(^LRO(69,Y(4),1,Y(5),3))
- SET $PIECE(^(3),"^",2)=LRK
- +9 IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0))
- SET ^(0)="^68.14P^^"
- SET LRF=^(0)
- SET (C,LRG)=0
- +10 FOR A=0:0
- SET A=$ORDER(^LAB(60,LRT,9,A))
- IF 'A
- QUIT
- IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,A,0))
- SET ^(0)=A_"^1^0^^^"_LRK_"^"_DUZ_"^"_DUZ(2)_"^"_LRAA_"^"_LRAA_"^"_LRAA
- SET LRG=LRG+1
- SET C=A
- +11 IF LRG
- SET ^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0)=$PIECE(LRF,"^",1,2)_"^"_C_"^"_($PIECE(LRF,"^",4)+LRG)
- +12 IF 'LRW(2.1)
- IF $DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,LRW(0,86250),0))
- KILL ^(0)
- SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0)
- SET X(1)=$ORDER(^(0))
- SET ^(0)=$PIECE(X,"^",1,2)_"^"_X(1)_"^"_($PIECE(X,"^",4)-1)
- +13 IF LRW(2.4)!(LRW(2.6))
- DO CMB
- IF DR="[LRBLPAG]"
- DO PH
- IF 'LRW
- QUIT
- CAP KILL ^TMP($JOB)
- WRITE !!,"Enter Antibody Identification Workload"
- SET LR(62.07)=$PIECE(LRT(LRT),U,3)
- IF '$ORDER(^LAB(62.07,LR(62.07),9,0))
- WRITE $CHAR(7),!!,"No WKLD CODES to select for ",$PIECE(^LAB(62.07,LR(62.07),0),U)," in EXECUTE CODE file."
- QUIT
- +1 FOR LRA=0:0
- SET DIC="^LAB(62.07,LR(62.07),9,"
- SET DIC(0)="AEQM"
- DO ^DIC
- KILL DIC
- IF Y<1
- QUIT
- DO C
- SET ^TMP($JOB,+Y)=X
- +2 IF '$DATA(^TMP($JOB))
- WRITE $CHAR(7),!,"No WKLD CODES selected."
- QUIT
- +3 WRITE !!,"Count WKLD CODES Selected: "
- FOR A=0:0
- SET A=$ORDER(^TMP($JOB,A))
- IF 'A
- QUIT
- SET B=^(A)
- SET X=^LAM(A,0)
- IF 'B
- SET B=1
- WRITE !,$JUSTIFY(B,2),?6,$PIECE(X,U,2),?16,$PIECE(X,U)
- +4 WRITE !,"WKLD CODES selected OK "
- SET %=1
- DO YN^LRU
- IF %<1
- QUIT
- IF %'=1
- WRITE !!,$CHAR(7),"No WKLD codes selected. Try again."
- GOTO CAP
- +5 SET LRG=0
- FOR A=0:0
- SET A=$ORDER(^TMP($JOB,A))
- IF 'A
- QUIT
- SET B=^(A)
- IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,A,0))
- SET ^(0)=A_"^"_B_"^0^^^"_LRK_"^"_DUZ_"^"_DUZ(2)_"^"_LRAA_"^"_LRAA_"^"_LRAA
- SET LRG=LRG+1
- SET C=A
- +6 IF LRG
- SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0)
- SET ^(0)=$PIECE(X,"^",1,2)_"^"_C_"^"_($PIECE(X,"^",4)+LRG)
- +7 QUIT
- CMB IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,LRW(0,86250),0))
- SET ^(0)=LRW(0,86250)_"^^0^^^"_LRK_"^"_DUZ_"^"_DUZ(2)_"^"_LRAA_"^"_LRAA_"^"_LRAA
- SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0)
- SET ^(0)=$PIECE(X,"^",1,2)_"^"_LRW(0,86250)_"^"_($PIECE(X,"^",4)+1)
- +1 SET X=1
- IF LRW(2.4)
- SET X=X+1
- IF LRW(2.6)
- SET X=X+1
- SET $PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,LRW(0,86250),0),"^",2)=X
- QUIT
- +2 ;
- C READ !," Enter WKLD CODE COUNT if more than one: ",X:DTIME
- IF X=""!(X[U)
- QUIT
- IF +X'=X!(X<2)!(X>20)
- WRITE $CHAR(7),!,"Enter a number from 2 to 20"
- GOTO C
- +1 QUIT
- PH FOR A=1.1,1.2,1.3,1.4
- FOR B=0:0
- SET B=$ORDER(^LR(LRDFN,"BB",LRI,A,B))
- IF 'B
- QUIT
- FOR C=0:0
- SET C=$ORDER(^LAB(61.3,B,9,C))
- IF 'C
- QUIT
- DO STF
- +1 QUIT
- STF IF $DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,C,0))
- SET X=^(0)
- SET $PIECE(X,"^",2)=$SELECT($PIECE(X,"^",3):1,1:$PIECE(X,"^",2)+1)
- SET $PIECE(X,"^",3)=0
- SET ^(0)=X
- QUIT
- +1 IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0))
- SET ^(0)="^68.14P^^"
- SET X=^(0)
- SET ^(0)=$PIECE(X,"^",1,2)_"^"_C_"^"_($PIECE(X,"^",4)+1)
- SET ^(C,0)=C
- QUIT
