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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMISEZ1 2318 printed Nov 22, 2024@17:27:23 Page 2
LRMISEZ1 ;AVAMC/REG/SLC/BA - MICROBIOLOGY INFECTION CONTROL DATA ;4/17/91 14:29 ;
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
DQ ;dequeued from LRMISEZ
+1 USE IO
KILL ^TMP($JOB),Z
if $DATA(ZTQUEUED)
SET ZTREQ="@"
SET (LRAO,O)=0
+2 FOR I=0:0
SET LRAO=$ORDER(^LAB(62.06,"AO",LRAO))
if LRAO<.001
QUIT
SET J=$ORDER(^LAB(62.06,"AO",LRAO,0))
IF J>0
IF $DATA(^LAB(62.06,J,0))
IF $LENGTH($PIECE(^(0),U,5))
SET O=O+1
SET B(O)=J_U_$PIECE(^(0),U,5)
SET LRBN=$PIECE(^(0),U,2)
IF LRBN
IF $DATA(LRAP(LRBN))
SET $PIECE(B(O),U,3)=LRAP(LRBN)
+3 SET B=0
FOR I=0:0
SET B=$ORDER(B(B))
if B=""
QUIT
SET LRZ=$PIECE(B(B),U)
SET LRZ(LRZ)=B
+4 FOR I=0:0
SET LRAD=$ORDER(^LRO(68,LRAA,1,LRAD))
if LRAD=""!(LRAD>LRYRL)
QUIT
DO AC
+5 DO ^LRMISEZ2
WRITE !
+6 QUIT
AC SET LRTK=LRSTAR-.00001
FOR I=0:0
SET LRTK=$ORDER(^LRO(68,LRAA,1,LRAD,1,"AD",LRTK))
if LRTK=""!(LRTK>LAST)
QUIT
DO AC1
+1 QUIT
AC1 SET LRAC=0
FOR I=0:0
SET LRAC=$ORDER(^LRO(68,LRAA,1,LRAD,1,"AD",LRTK,LRAC))
if LRAC=""
QUIT
IF $DATA(^LRO(68,LRAA,1,LRAD,1,LRAC,0))
SET LRND=^(0)
IF $DATA(^(3))
SET LRIDT=9999999-^(3)
DO SET
+1 QUIT
SET SET LRDFN=+LRND
if '$DATA(^LR(LRDFN,"MI",LRIDT,3,0))
QUIT
+1 SET LRDAT=+^LR(LRDFN,"MI",LRIDT,0)
+2 IF LRLOS
SET LROK=1
DO LOS
if 'LROK
QUIT
+3 IF LRSIT(1)="S"
SET LRSIT=$SELECT($LENGTH($PIECE(^LR(LRDFN,"MI",LRIDT,0),U,5)):$PIECE(^(0),U,5),1:"Unknown")
IF LRSIT
SET LRSIT=$SELECT($DATA(^LAB(61,LRSIT,0)):$EXTRACT($PIECE(^(0),U),1,8)_U_LRSIT_U,1:"Unknown")
+4 IF LRSIT(1)'="S"
SET LRSIT=$SELECT($LENGTH($PIECE(^LR(LRDFN,"MI",LRIDT,0),U,11)):$PIECE(^(0),U,11),1:"Unknown")
IF LRSIT
SET LRSIT=$SELECT($DATA(^LAB(62,LRSIT,0)):$EXTRACT($PIECE(^(0),U),1,8)_U_LRSIT_U,1:"Unknown")
+5 SET LRDOC=$SELECT($LENGTH($PIECE(^LR(LRDFN,"MI",LRIDT,0),U,7)):$PIECE(^(0),U,7),1:"Unknown")
IF LRDOC
SET X=LRDOC
DO DOC^LRX
SET ^TMP($JOB,"XDOC",+X)=LRDOC
SET LRDOC=$EXTRACT(LRDOC,1,15)_U_+X
+6 if '$DATA(^LR(LRDFN,"MI",LRIDT,1))
QUIT
if '+^(1)
QUIT
+7 SET LRPF=^DIC($PIECE(^LR(LRDFN,0),U,2),0,"GL")
SET LRDPF=+$PIECE(@(LRPF_"0)"),U,2)
SET DFN=$PIECE(^LR(LRDFN,0),U,3)
SET LRPPT=@(LRPF_DFN_",0)")
+8 SET LRNAME=$EXTRACT($PIECE(LRPPT,U),1,15)_U_LRDFN
SET SSN=$PIECE(LRPPT,U,9)
SET ^TMP($JOB,"XPAT",LRDFN)=$PIECE(LRPPT,U)
+9 SET LROR=0
SET LRMY=$EXTRACT(LRTK,1,5)
SET LRLLOC=$EXTRACT($PIECE(LRND,U,7),1,7)
if '$LENGTH(LRLLOC)
SET LRLLOC="UNKNOWN"
if LRLLOC["DIED"
SET LRLLOC="EXPIRED"
+10 DO ^LRMISEZB
+11 QUIT
LOS ;MAS
SET DFN=$SELECT($PIECE(^LR(LRDFN,0),"^",2)=2:$PIECE(^(0),"^",3),1:"")
if 'DFN
QUIT
SET X=$ORDER(^DGPM("APID",DFN,0))
IF X
SET X=$ORDER(^DGPM("APID",DFN,X,0))
IF X
IF $DATA(^DGPM(X,0))
IF $PIECE(^(0),"^",14)
SET X=$PIECE(^(0),"^",14)
SET X=$SELECT($DATA(^DGPM(X,0)):^(0),1:"")
+1 ;MAS
if 'X
SET LROK=0
if 'X
QUIT
SET LRADMD=+X
IF $PIECE(X,"^",17)
SET LRDCHD=$PIECE(X,"^",17)
SET LRDCHD=$SELECT($DATA(^DGPM(LRDCHD,0)):$PIECE(^(0),U,1),1:"")
IF LRDCHD<LRDAT
SET LROK=0
QUIT
+2 SET X1=LRDAT
SET X2=LRADMD
DO ^%DTC
IF X<LRLOS
SET LROK=0
+3 QUIT
