Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRBLPEW

LRBLPEW.m

Go to the documentation of this file.
LRBLPEW ;AVAMC/REG - BB WORKLOAD ;3/9/94  13:09
 ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
 ;Per VHA Directive 97-033 this routine should not be modified.  Medical Device # BK970021
 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_"^",$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