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

LRMISEZ1.m

Go to the documentation of this file.
LRMISEZ1 ; IHS/DIR/FJE - MICROBIOLOGY INFECTION CONTROL DATA 4/17/91 14:29 ;
 ;;5.2;LR;**1013,1024**;May 02, 2008
 ;
 ;;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)")
 D PT^LRX  ;IHS/ANMC/CLS 08/18/96
 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"
 S LROR=0,LRMY=$E(LRTK,1,5),LRLLOC=$E($P(LRND,U,7),1,7) S:'$L(LRLLOC) LRLLOC="" S:LRLLOC["DIED" LRLLOC="EXPIRED"  ;IHS/ANMC/CLS 08/18/96
 ; ----- BEGIN IHS/OIT/MKK MODIFICATION -- LR*5.2*1024
 I $G(LRLLOC)="" S LRLLOC="UNKNOWN"
 ; ----- END IHS/OIT/MKK MODIFICATION -- LR*5.2*1024
 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