33 lines
1.4 KiB
Mathematica
33 lines
1.4 KiB
Mathematica
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
|
|
;
|