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

LREPI4.m

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