| [613] | 1 | LRBLPBR ;AVAMC/REG - BB TESTS REPORT ;3/28/94  11:59 ; | 
|---|
|  | 2 | ;;5.2;LAB SERVICE;**247**;Sep 27, 1994 | 
|---|
|  | 3 | ;Per VHA Directive 97-033 this routine should not be modified.  Medical Device # BK970021 | 
|---|
|  | 4 | GETP D:'$D(LRAA) A | 
|---|
|  | 5 | G:'$D(LRAA) END | 
|---|
|  | 6 | W ! K DIC D ^LRDPA G:LRDFN<1 END | 
|---|
|  | 7 | I '$D(^LR(LRDFN,"BB")) W $C(7),!?3,"No blood bank data for ",LRP G GETP | 
|---|
|  | 8 | I '$D(^LRO(69.2,LRAA,3,LRDFN,0)) D | 
|---|
|  | 9 | . S ^LRO(69.2,LRAA,3,LRDFN,0)=LRDFN_"^"_LRLLOC,^LRO(69.2,LRAA,3,"C",LRLLOC,LRDFN)="" | 
|---|
|  | 10 | . L +^LRO(69.2,LRAA,3):5 I '$T G GETP | 
|---|
|  | 11 | . S X=^LRO(69.2,LRAA,3,0),^(0)=$P(X,"^",1,2)_"^"_LRDFN_"^"_($P(X,"^",4)+1) | 
|---|
|  | 12 | . L -^LRO(69.2,LRAA,3) | 
|---|
|  | 13 | G GETP | 
|---|
|  | 14 | ; | 
|---|
|  | 15 | CH D A G:'$D(LRAA) END | 
|---|
|  | 16 | D L G:'G END | 
|---|
|  | 17 | S LRAPX=1 D C | 
|---|
|  | 18 | W !!,"Save reports for reprinting " S %=2 D YN^LRU G:%<1 END S:%=1 LRSAV=1 | 
|---|
|  | 19 | DEV W !!,"Print  component  requests  " S %=2 D YN^LRU Q:%<1  S:%=1 LRN(2)=1 | 
|---|
|  | 20 | W ! S ZTRTN="QUE^LRBLPBR" D BEG^LRUTL G:POP!($D(ZTSK)) END | 
|---|
|  | 21 | ; | 
|---|
|  | 22 | QUE U IO K ^TMP("LRBL",$J) | 
|---|
|  | 23 | D L^LRU,S^LRU | 
|---|
|  | 24 | F X=2.91,8,10.3,11.3 D FIELD^DID(63.01,X,"","LABEL","LRN") S LRN(X)=LRN("LABEL") K LRN("LABEL") | 
|---|
|  | 25 | I $D(LR("S")) D SET G LST | 
|---|
|  | 26 | S LRLLOC=0 F A=0:0 S LRLLOC=$O(^LRO(69.2,LRAA,3,"C",LRLLOC)) Q:LRLLOC=""  F LRDFN=0:0 S LRDFN=$O(^LRO(69.2,LRAA,3,"C",LRLLOC,LRDFN)) Q:'LRDFN  D SET | 
|---|
|  | 27 | LST S G=0 | 
|---|
|  | 28 | F  S G=$O(^TMP("LRBL",$J,G)) Q:G=""!(LR("Q"))  S N=0 F  S N=$O(^TMP("LRBL",$J,G,N)) Q:N=""!(LR("Q"))  S LRDFN=0 F  S LRDFN=$O(^TMP("LRBL",$J,G,N,LRDFN)) Q:'LRDFN!(LR("Q"))  S LR=^(LRDFN) D ^LRBLPBR1 | 
|---|
|  | 29 | I '$D(LRSAV) K ^LRO(69.2,LRAA,3) S ^LRO(69.2,LRAA,3,0)="^69.29A^^" | 
|---|
|  | 30 | W:IOST'?1"C".E @IOF K ^TMP("LRBL",$J) D END^LRUTL,END Q | 
|---|
|  | 31 | ; | 
|---|
|  | 32 | SET S W=^LR(LRDFN,0),Y=$P(W,"^",3),(LRDPF,P)=$P(W,"^",2),X=^DIC(P,0,"GL"),X=@(X_Y_",0)"),Z=+$G(^(.104)),Z(1)="^"_$P($G(^DD(P,.104,0)),"^",3),SSN=$P(X,"^",9) | 
|---|
|  | 33 | D SSN^LRU | 
|---|
|  | 34 | I Z,$D(@(Z(1)_Z_",0)")) S LRMD=$P(^(0),"^") | 
|---|
|  | 35 | I 'Z S Z=$S($D(^LR(LRDFN,.2)):+^(.2),1:"") I Z,$D(^VA(200,Z,0)) S LRMD=$P(^(0),"^") | 
|---|
|  | 36 | I 'Z S LRMD="UNKNOWN" | 
|---|
|  | 37 | S ^TMP("LRBL",$J,LRLLOC,$P(X,"^"),LRDFN)=$P(X,"^",3)_"^"_SSN_"^"_$P(W,"^",5)_"^"_$P(W,"^",6)_"^"_LRMD Q | 
|---|
|  | 38 | ; | 
|---|
|  | 39 | SGL D:'$D(LRAA) A | 
|---|
|  | 40 | G:'$D(LRAA) END | 
|---|
|  | 41 | K DIC S LRDPAF=1 W ! D ^LRDPA G:LRDFN<1 END | 
|---|
|  | 42 | I '$D(^LR(LRDFN,"BB")) W $C(7),!?3,"No blood bank data for ",LRP G SGL | 
|---|
|  | 43 | S:LRLLOC="" LRLLOC="???" | 
|---|
|  | 44 | S (LRSAV,LR("S"))=1 G DEV | 
|---|
|  | 45 | ; | 
|---|
|  | 46 | DEL D A G:Y=-1 END | 
|---|
|  | 47 | D L G:'G END | 
|---|
|  | 48 | D C W $C(7),!!,"OK TO DELETE THE ",LRAA(1)," TEST REPORT QUEUE LIST" | 
|---|
|  | 49 | S %=2 D YN^LRU I %=1 K ^LRO(69.2,LRAA,3) S ^LRO(69.2,LRAA,3,0)="^69.29A^0^0" W $C(7),!,"LIST DELETED !" D END Q | 
|---|
|  | 50 | W !!,"FINE, LET'S FORGET IT",! Q | 
|---|
|  | 51 | C S X=$P(^LRO(69.2,LRAA,3,0),U,4) | 
|---|
|  | 52 | W !?30,"(",X," patient",$S(X>1:"s",1:""),")" Q | 
|---|
|  | 53 | ; | 
|---|
|  | 54 | L S G=$O(^LRO(69.2,LRAA,3,0)) I 'G W $C(7),!!,"NO BLOOD BANK PATIENTS ON THE TEST REPORT QUEUE",!! Q | 
|---|
|  | 55 | Q | 
|---|
|  | 56 | ; | 
|---|
|  | 57 | A D END S X="BLOOD BANK" D ^LRUTL Q | 
|---|
|  | 58 | ; | 
|---|
|  | 59 | END D V^LRU Q | 
|---|