source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRBLPBR.m@ 767

Last change on this file since 767 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1LRBLPBR ;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
4GETP 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 ;
15CH 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
19DEV 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 ;
22QUE 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
27LST 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 ;
32SET 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 ;
39SGL 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 ;
46DEL 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
51C S X=$P(^LRO(69.2,LRAA,3,0),U,4)
52 W !?30,"(",X," patient",$S(X>1:"s",1:""),")" Q
53 ;
54L 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 ;
57A D END S X="BLOOD BANK" D ^LRUTL Q
58 ;
59END D V^LRU Q
Note: See TracBrowser for help on using the repository browser.