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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLREPI4 1420 printed Apr 09, 2024@21:12:44 Page 2
LREPI4 ;DALOI/SED-EMERGING PATHOGENS INPATIENT UPDATE ;5/1/98
+1 ;;5.2;LAB SERVICE;**132,175,260**;Sep 27, 1994
+2 ; Reference to ^DD supported by IA #999
+3 ; Reference to ^DGPT supported by IA #418
CHECK ;CHECKS TO SEE IF PRIOR TO INPATIENT DISCHARGE
+1 if VAIN(10)=""
QUIT
+2 if $PIECE($GET(^DGPT(VAIN(10),0)),U,6)=3
QUIT
+3 if LRRTYPE
QUIT
SET ;SETS THE PTF RECORD FOR THE ENCOUNTER ONLY FOR AUTO RUNS
+1 if $DATA(^LAB(69.5,LRPATH,7,"B",VAIN(10)))
QUIT
+2 KILL DD
+3 SET DIC="^LAB(69.5,"_LRPATH_",7,"
SET DIC(0)="L"
SET X=VAIN(10)
SET DLAYGO=69.5
+4 SET DIC("P")=$PIECE(^DD(69.5,14,0),U,2)
SET DA(1)=LRPATH
+5 DO FILE^DICN
+6 KILL DD,DO,DIC,DA,DLAYGO,X,Y
+7 QUIT
SEARCH ;LOOKS AT THE ENTRIES TO DETERMINE DISCHARGES
+1 SET LRPATH=0
FOR
SET LRPATH=$ORDER(^TMP($JOB,"LREPI",LRPATH))
if LRPATH'>0
QUIT
Begin DoDot:1
+2 SET LRPTF=0
FOR
SET LRPTF=$ORDER(^LAB(69.5,LRPATH,7,"B",LRPTF))
if +LRPTF'>0
QUIT
Begin DoDot:2
+3 ;Added $G to cure undef problems
if $PIECE($GET(^DGPT(LRPTF,0)),U,6)'=3
QUIT
+4 SET DA=0
FOR DA=$ORDER(^LAB(69.5,LRPATH,7,"B",LRPTF,DA))
if +DA'>0
QUIT
Begin DoDot:3
+5 if $PIECE(^LAB(69.5,LRPATH,7,DA,0),U,2)'=""&($EXTRACT($PIECE(^LAB(69.5,LRPATH,7,DA,0),U,2),1,5)'=$EXTRACT(LRRPS,1,5))
QUIT
+6 SET LRPROT=$PIECE(^LAB(69.5,LRPATH,0),U,7)
+7 SET LRPAT=$PIECE(^DGPT(LRPTF,0),U,1)
SET LRENCDT=$PIECE(^DGPT(LRPTF,0),U,2)
+8 if LRENCDT>LRRPE
QUIT
+9 SET ^TMP($JOB,LRPROT,LRPAT,LRENCDT)="I"_U_LRPTF_U_"UPDT"
+10 ;NOW DATE THE ENTRY(S) THAT WERE UPDATED FOR AUTO RUN ONLY
+11 if LRRTYPE
QUIT
+12 if $PIECE(^LAB(69.5,LRPATH,7,DA,0),U,2)=""
SET $PIECE(^LAB(69.5,LRPATH,7,DA,0),U,2)=LRRPS
End DoDot:3
End DoDot:2
End DoDot:1
+13 KILL LRPATH,LRPTF,DA,LRPROT,LRPAT,LRENCDT
+14 QUIT
+15 ;
