30 lines
2.2 KiB
Mathematica
30 lines
2.2 KiB
Mathematica
LRMISEZ1 ;AVAMC/REG/SLC/BA - MICROBIOLOGY INFECTION CONTROL DATA ;4/17/91 14:29 ;
|
|
;;5.2;LAB SERVICE;;Sep 27, 1994
|
|
DQ ;dequeued from LRMISEZ
|
|
U IO K ^TMP($J),Z S:$D(ZTQUEUED) ZTREQ="@" S (LRAO,O)=0
|
|
F I=0:0 S LRAO=$O(^LAB(62.06,"AO",LRAO)) Q:LRAO<.001 S J=$O(^LAB(62.06,"AO",LRAO,0)) I J>0,$D(^LAB(62.06,J,0)),$L($P(^(0),U,5)) S O=O+1,B(O)=J_U_$P(^(0),U,5) S LRBN=$P(^(0),U,2) I LRBN,$D(LRAP(LRBN)) S $P(B(O),U,3)=LRAP(LRBN)
|
|
S B=0 F I=0:0 S B=$O(B(B)) Q:B="" S LRZ=$P(B(B),U),LRZ(LRZ)=B
|
|
F I=0:0 S LRAD=$O(^LRO(68,LRAA,1,LRAD)) Q:LRAD=""!(LRAD>LRYRL) D AC
|
|
D ^LRMISEZ2 W !
|
|
Q
|
|
AC S LRTK=LRSTAR-.00001 F I=0:0 S LRTK=$O(^LRO(68,LRAA,1,LRAD,1,"AD",LRTK)) Q:LRTK=""!(LRTK>LAST) D AC1
|
|
Q
|
|
AC1 S LRAC=0 F I=0:0 S LRAC=$O(^LRO(68,LRAA,1,LRAD,1,"AD",LRTK,LRAC)) Q:LRAC="" I $D(^LRO(68,LRAA,1,LRAD,1,LRAC,0)) S LRND=^(0) I $D(^(3)) S LRIDT=9999999-^(3) D SET
|
|
Q
|
|
SET S LRDFN=+LRND Q:'$D(^LR(LRDFN,"MI",LRIDT,3,0))
|
|
S LRDAT=+^LR(LRDFN,"MI",LRIDT,0)
|
|
I LRLOS S LROK=1 D LOS Q:'LROK
|
|
I LRSIT(1)="S" S LRSIT=$S($L($P(^LR(LRDFN,"MI",LRIDT,0),U,5)):$P(^(0),U,5),1:"Unknown") I LRSIT S LRSIT=$S($D(^LAB(61,LRSIT,0)):$E($P(^(0),U),1,8)_U_LRSIT_U,1:"Unknown")
|
|
I LRSIT(1)'="S" S LRSIT=$S($L($P(^LR(LRDFN,"MI",LRIDT,0),U,11)):$P(^(0),U,11),1:"Unknown") I LRSIT S LRSIT=$S($D(^LAB(62,LRSIT,0)):$E($P(^(0),U),1,8)_U_LRSIT_U,1:"Unknown")
|
|
S LRDOC=$S($L($P(^LR(LRDFN,"MI",LRIDT,0),U,7)):$P(^(0),U,7),1:"Unknown") I LRDOC S X=LRDOC D DOC^LRX S ^TMP($J,"XDOC",+X)=LRDOC,LRDOC=$E(LRDOC,1,15)_U_+X
|
|
Q:'$D(^LR(LRDFN,"MI",LRIDT,1)) Q:'+^(1)
|
|
S LRPF=^DIC($P(^LR(LRDFN,0),U,2),0,"GL"),LRDPF=+$P(@(LRPF_"0)"),U,2),DFN=$P(^LR(LRDFN,0),U,3),LRPPT=@(LRPF_DFN_",0)")
|
|
S LRNAME=$E($P(LRPPT,U),1,15)_U_LRDFN,SSN=$P(LRPPT,U,9),^TMP($J,"XPAT",LRDFN)=$P(LRPPT,U)
|
|
S LROR=0,LRMY=$E(LRTK,1,5),LRLLOC=$E($P(LRND,U,7),1,7) S:'$L(LRLLOC) LRLLOC="UNKNOWN" S:LRLLOC["DIED" LRLLOC="EXPIRED"
|
|
D ^LRMISEZB
|
|
Q
|
|
LOS S DFN=$S($P(^LR(LRDFN,0),"^",2)=2:$P(^(0),"^",3),1:"") Q:'DFN S X=$O(^DGPM("APID",DFN,0)) I X S X=$O(^DGPM("APID",DFN,X,0)) I X,$D(^DGPM(X,0)),$P(^(0),"^",14) S X=$P(^(0),"^",14) S X=$S($D(^DGPM(X,0)):^(0),1:"") ;MAS
|
|
S:'X LROK=0 Q:'X S LRADMD=+X I $P(X,"^",17) S LRDCHD=$P(X,"^",17) S LRDCHD=$S($D(^DGPM(LRDCHD,0)):$P(^(0),U,1),1:"") I LRDCHD<LRDAT S LROK=0 Q ;MAS
|
|
S X1=LRDAT,X2=LRADMD D ^%DTC I X<LRLOS S LROK=0
|
|
Q
|