source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LREPI4.m@ 802

LREPI4 ;DALOI/SED-EMERGING PATHOGENS INPATIENT UPDATE ;5/1/98
 ;;5.2;LAB SERVICE;**132,175,260**;Sep 27, 1994
 ; Reference to ^DD supported by IA #999
 ; Reference to ^DGPT supported by IA #418
CHECK ;CHECKS TO SEE IF PRIOR TO INPATIENT DISCHARGE
 Q:VAIN(10)=""
 Q:$P($G(^DGPT(VAIN(10),0)),U,6)=3
 Q:LRRTYPE
SET ;SETS THE PTF RECORD FOR THE ENCOUNTER ONLY FOR AUTO RUNS
 Q:$D(^LAB(69.5,LRPATH,7,"B",VAIN(10)))
 K DD
 S DIC="^LAB(69.5,"_LRPATH_",7,",DIC(0)="L",X=VAIN(10),DLAYGO=69.5
 S DIC("P")=$P(^DD(69.5,14,0),U,2),DA(1)=LRPATH
 D FILE^DICN
 K DD,DO,DIC,DA,DLAYGO,X,Y
 Q
SEARCH ;LOOKS AT THE ENTRIES TO DETERMINE DISCHARGES
 S LRPATH=0 F  S LRPATH=$O(^TMP($J,"LREPI",LRPATH)) Q:LRPATH'>0  D
 .S LRPTF=0 F  S LRPTF=$O(^LAB(69.5,LRPATH,7,"B",LRPTF)) Q:+LRPTF'>0  D
 ..Q:$P($G(^DGPT(LRPTF,0)),U,6)'=3  ;Added $G to cure undef problems
 ..S DA=0 F DA=$O(^LAB(69.5,LRPATH,7,"B",LRPTF,DA)) Q:+DA'>0  D
 ...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))
 ...S LRPROT=$P(^LAB(69.5,LRPATH,0),U,7)
 ...S LRPAT=$P(^DGPT(LRPTF,0),U,1),LRENCDT=$P(^DGPT(LRPTF,0),U,2)
 ...Q:LRENCDT>LRRPE
 ...S ^TMP($J,LRPROT,LRPAT,LRENCDT)="I"_U_LRPTF_U_"UPDT"
 ...;NOW DATE THE ENTRY(S) THAT WERE UPDATED FOR AUTO RUN ONLY
 ...Q:LRRTYPE
 ...S:$P(^LAB(69.5,LRPATH,7,DA,0),U,2)="" $P(^LAB(69.5,LRPATH,7,DA,0),U,2)=LRRPS
 K LRPATH,LRPTF,DA,LRPROT,LRPAT,LRENCDT
 Q
 ;