- 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 Mar 13, 2025@21:21:49 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
