source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LREPI4.m@ 1006

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

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1LREPI4 ;DALOI/SED-EMERGING PATHOGENS INPATIENT UPDATE ;5/1/98
2 ;;5.2;LAB SERVICE;**132,175,260**;Sep 27, 1994
3 ; Reference to ^DD supported by IA #999
4 ; Reference to ^DGPT supported by IA #418
5CHECK ;CHECKS TO SEE IF PRIOR TO INPATIENT DISCHARGE
6 Q:VAIN(10)=""
7 Q:$P($G(^DGPT(VAIN(10),0)),U,6)=3
8 Q:LRRTYPE
9SET ;SETS THE PTF RECORD FOR THE ENCOUNTER ONLY FOR AUTO RUNS
10 Q:$D(^LAB(69.5,LRPATH,7,"B",VAIN(10)))
11 K DD
12 S DIC="^LAB(69.5,"_LRPATH_",7,",DIC(0)="L",X=VAIN(10),DLAYGO=69.5
13 S DIC("P")=$P(^DD(69.5,14,0),U,2),DA(1)=LRPATH
14 D FILE^DICN
15 K DD,DO,DIC,DA,DLAYGO,X,Y
16 Q
17SEARCH ;LOOKS AT THE ENTRIES TO DETERMINE DISCHARGES
18 S LRPATH=0 F S LRPATH=$O(^TMP($J,"LREPI",LRPATH)) Q:LRPATH'>0 D
19 .S LRPTF=0 F S LRPTF=$O(^LAB(69.5,LRPATH,7,"B",LRPTF)) Q:+LRPTF'>0 D
20 ..Q:$P($G(^DGPT(LRPTF,0)),U,6)'=3 ;Added $G to cure undef problems
21 ..S DA=0 F DA=$O(^LAB(69.5,LRPATH,7,"B",LRPTF,DA)) Q:+DA'>0 D
22 ...Q:$P(^LAB(69.5,LRPATH,7,DA,0),U,2)'=""&($E($P(^LAB(69.5,LRPATH,7,DA,0),U,2),1,5)'=$E(LRRPS,1,5))
23 ...S LRPROT=$P(^LAB(69.5,LRPATH,0),U,7)
24 ...S LRPAT=$P(^DGPT(LRPTF,0),U,1),LRENCDT=$P(^DGPT(LRPTF,0),U,2)
25 ...Q:LRENCDT>LRRPE
26 ...S ^TMP($J,LRPROT,LRPAT,LRENCDT)="I"_U_LRPTF_U_"UPDT"
27 ...;NOW DATE THE ENTRY(S) THAT WERE UPDATED FOR AUTO RUN ONLY
28 ...Q:LRRTYPE
29 ...S:$P(^LAB(69.5,LRPATH,7,DA,0),U,2)="" $P(^LAB(69.5,LRPATH,7,DA,0),U,2)=LRRPS
30 K LRPATH,LRPTF,DA,LRPROT,LRPAT,LRENCDT
31 Q
32 ;
Note: See TracBrowser for help on using the repository browser.