LRMISEZ3 ;AVAMC/REG/SLC/BA - MICRO INF CTRL SURVEY CONT'D ; 10/1/87 17:15 ;
;;5.2;LAB SERVICE;;Sep 27, 1994
;from LRMISEZ2
A I LRM("L")'="A"!(LRM("O")'="A") S S="ORG" D ^LRMISEZ4
S LRPG=0 D HDR1 I LRM("O")="S" S LRBG=0 F I=0:0 S LRBG=$O(^TMP($J,"SE",LRBG)) Q:LRBG="" I LRM("O","S")=+$E(LRBG,4,25) S LRBUG=$P(^LAB(61.2,+$E(LRBG,4,25),0),U) D M
I LRM("O")'="S" S LRBG=0 F I=0:0 S LRBG=$O(^TMP($J,"SE",LRBG)) Q:LRBG="" S LRBUG=$P(^LAB(61.2,+$E(LRBG,4,25),0),U) D M
Q
M S M=0 F I=0:0 S M=$O(^TMP($J,"SE",LRBG,M)),LRSUM=1 Q:M="" S LRAD=$E(M,1,3)_"0000",Y=M_"00" D D^LRU S LRMY=Y D:$Y>61 HDR1 W !!,LRBUG,?34," ",LRMY S X=43 W ! D LIN,LLOC
Q
LLOC S LRLLOC=0 F I=0:0 S LRLLOC=$O(^TMP($J,"SE",LRBG,M,LRLLOC)) Q:LRLLOC="" D:$Y>61 HDR1,LD W !,LRLLOC D SIT
Q
SIT S LRSIT=0 F I=0:0 S LRSIT=$O(^TMP($J,"SE",LRBG,M,LRLLOC,LRSIT)) Q:LRSIT="" D:$Y>61 HDR1,LD,LC W !,?5,$S(LRSIT="Unknown":"Unknown",LRSIT(1)="S":$P(^LAB(61,$P(LRSIT,U,2),0),U),1:$P(^LAB(62,$P(LRSIT,U,2),0),U)) D AC
Q
AC S LRAC=0 F I=0:0 S LRAC=$O(^TMP($J,"SE",LRBG,M,LRLLOC,LRSIT,LRAC)) Q:LRAC="" D:$Y>61 HDR1,LD,LC,SITE D OR S LRSUM=LRSUM+1
Q
OR S LROR=0 F I=0:0 S LROR=$O(^TMP($J,"SE",LRBG,M,LRLLOC,LRSIT,LRAC,LROR)) Q:LROR="" S LRNAME=$O(^(LROR,0)),LRDAT=^(LRNAME) D:$Y>61 HDR1,LD,LC,SITE W !,?11,$J(LRSUM,4),")" D LIST
Q
LIST W ?17,$J(LRAC,5),?23,$E($P(LRNAME,U),1,13),?38 S Y=+LRDAT,Y=+$E(Y,4,5)_"/"_+$E(Y,6,7) W Y,?43
S LRLIN="",$P(LRLIN,"| ",O+1)="|"
S LRYA=0 F I=0:0 S LRYA=$O(^TMP($J,"SE",LRBG,M,LRLLOC,LRSIT,LRAC,LROR,LRNAME,LRYA)) Q:LRYA="" D NOD
W LRLIN,!
Q
NOD Q:'$D(LRZ(LRYA)) S $P(LRLIN,"|",LRZ(LRYA)+1)=^TMP($J,"SE",LRBG,M,LRLLOC,LRSIT,LRAC,LROR,LRNAME,LRYA)
Q
HDR1 S LRPG=LRPG+1,%DT="T",X="N" D ^%DT,D^LRU W @IOF,!,Y,?21,"INFECTION CONTROL SURVEY REPORT BY ORGANISM",?70,"PAGE ",$J(LRPG,5)
I LRLOS W !,?2,"** Reports only those specimens collected > ",LRLOS,$S(LRLOS>1:" days",1:" day")," from admission date **"
W !,LRAAN,?6,"From: ",LRST," To: ",LRLST,?43 F I=0:0 S I=$O(B(I)) Q:I="" W "|",$E($P(B(I),U,2),1)
W "|",!,"Organism",?32,"Month/Year",?43 F I=0:0 S I=$O(B(I)) Q:I="" W "|",$E($P(B(I),U,2),2)
W "|",!,"Loc",?5,$S(LRSIT(1)="S":"Spec",1:"Sample"),?12,"Num",?17,"AC#",?23,"Patient",?38,"Date",?43 F I=0:0 S I=$O(B(I)) Q:I="" W "|",$E($P(B(I),U,2),3)
I $D(LRAP) W "|",!,?10,"** ANTIBIOTIC PATTERN **",?43 F I=0:0 S I=$O(B(I)) Q:I="" W "|",$S($L($P(B(I),U,3)):$P(B(I),U,3),1:" ")
W "|",! F A1=1:1:IOM-1 W "-"
Q
LD W !!,LRBUG,?34," ",LRMY S X=43 W ! D LIN
Q
LIN F A1=1:1:X W "-"
Q
LC W !,LRLLOC
Q
SITE W !,?5,$S(LRSIT="Unknown":"Unknown",LRSIT(1)="S":$P(^LAB(61,$P(LRSIT,U,2),0),U),1:$P(^LAB(62,$P(LRSIT,U,2),0),U))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMISEZ3 2669 printed Dec 13, 2024@02:17:21 Page 2
LRMISEZ3 ;AVAMC/REG/SLC/BA - MICRO INF CTRL SURVEY CONT'D ; 10/1/87 17:15 ;
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
+2 ;from LRMISEZ2
A IF LRM("L")'="A"!(LRM("O")'="A")
SET S="ORG"
DO ^LRMISEZ4
+1 SET LRPG=0
DO HDR1
IF LRM("O")="S"
SET LRBG=0
FOR I=0:0
SET LRBG=$ORDER(^TMP($JOB,"SE",LRBG))
if LRBG=""
QUIT
IF LRM("O","S")=+$EXTRACT(LRBG,4,25)
SET LRBUG=$PIECE(^LAB(61.2,+$EXTRACT(LRBG,4,25),0),U)
DO M
+2 IF LRM("O")'="S"
SET LRBG=0
FOR I=0:0
SET LRBG=$ORDER(^TMP($JOB,"SE",LRBG))
if LRBG=""
QUIT
SET LRBUG=$PIECE(^LAB(61.2,+$EXTRACT(LRBG,4,25),0),U)
DO M
+3 QUIT
M SET M=0
FOR I=0:0
SET M=$ORDER(^TMP($JOB,"SE",LRBG,M))
SET LRSUM=1
if M=""
QUIT
SET LRAD=$EXTRACT(M,1,3)_"0000"
SET Y=M_"00"
DO D^LRU
SET LRMY=Y
if $Y>61
DO HDR1
WRITE !!,LRBUG,?34," ",LRMY
SET X=43
WRITE !
DO LIN
DO LLOC
+1 QUIT
LLOC SET LRLLOC=0
FOR I=0:0
SET LRLLOC=$ORDER(^TMP($JOB,"SE",LRBG,M,LRLLOC))
if LRLLOC=""
QUIT
if $Y>61
DO HDR1
DO LD
WRITE !,LRLLOC
DO SIT
+1 QUIT
SIT SET LRSIT=0
FOR I=0:0
SET LRSIT=$ORDER(^TMP($JOB,"SE",LRBG,M,LRLLOC,LRSIT))
if LRSIT=""
QUIT
if $Y>61
DO HDR1
DO LD
DO LC
WRITE !,?5,$SELECT(LRSIT="Unknown":"Unknown",LRSIT(1)="S":$PIECE(^LAB(61,$PIECE(LRSIT,U,2),0),U),1:$PIECE(^LAB(62,$PIECE(LRSIT,U,2),0),U))
DO AC
+1 QUIT
AC SET LRAC=0
FOR I=0:0
SET LRAC=$ORDER(^TMP($JOB,"SE",LRBG,M,LRLLOC,LRSIT,LRAC))
if LRAC=""
QUIT
if $Y>61
DO HDR1
DO LD
DO LC
DO SITE
DO OR
SET LRSUM=LRSUM+1
+1 QUIT
OR SET LROR=0
FOR I=0:0
SET LROR=$ORDER(^TMP($JOB,"SE",LRBG,M,LRLLOC,LRSIT,LRAC,LROR))
if LROR=""
QUIT
SET LRNAME=$ORDER(^(LROR,0))
SET LRDAT=^(LRNAME)
if $Y>61
DO HDR1
DO LD
DO LC
DO SITE
WRITE !,?11,$JUSTIFY(LRSUM,4),")"
DO LIST
+1 QUIT
LIST WRITE ?17,$JUSTIFY(LRAC,5),?23,$EXTRACT($PIECE(LRNAME,U),1,13),?38
SET Y=+LRDAT
SET Y=+$EXTRACT(Y,4,5)_"/"_+$EXTRACT(Y,6,7)
WRITE Y,?43
+1 SET LRLIN=""
SET $PIECE(LRLIN,"| ",O+1)="|"
+2 SET LRYA=0
FOR I=0:0
SET LRYA=$ORDER(^TMP($JOB,"SE",LRBG,M,LRLLOC,LRSIT,LRAC,LROR,LRNAME,LRYA))
if LRYA=""
QUIT
DO NOD
+3 WRITE LRLIN,!
+4 QUIT
NOD if '$DATA(LRZ(LRYA))
QUIT
SET $PIECE(LRLIN,"|",LRZ(LRYA)+1)=^TMP($JOB,"SE",LRBG,M,LRLLOC,LRSIT,LRAC,LROR,LRNAME,LRYA)
+1 QUIT
HDR1 SET LRPG=LRPG+1
SET %DT="T"
SET X="N"
DO ^%DT
DO D^LRU
WRITE @IOF,!,Y,?21,"INFECTION CONTROL SURVEY REPORT BY ORGANISM",?70,"PAGE ",$JUSTIFY(LRPG,5)
+1 IF LRLOS
WRITE !,?2,"** Reports only those specimens collected > ",LRLOS,$SELECT(LRLOS>1:" days",1:" day")," from admission date **"
+2 WRITE !,LRAAN,?6,"From: ",LRST," To: ",LRLST,?43
FOR I=0:0
SET I=$ORDER(B(I))
if I=""
QUIT
WRITE "|",$EXTRACT($PIECE(B(I),U,2),1)
+3 WRITE "|",!,"Organism",?32,"Month/Year",?43
FOR I=0:0
SET I=$ORDER(B(I))
if I=""
QUIT
WRITE "|",$EXTRACT($PIECE(B(I),U,2),2)
+4 WRITE "|",!,"Loc",?5,$SELECT(LRSIT(1)="S":"Spec",1:"Sample"),?12,"Num",?17,"AC#",?23,"Patient",?38,"Date",?43
FOR I=0:0
SET I=$ORDER(B(I))
if I=""
QUIT
WRITE "|",$EXTRACT($PIECE(B(I),U,2),3)
+5 IF $DATA(LRAP)
WRITE "|",!,?10,"** ANTIBIOTIC PATTERN **",?43
FOR I=0:0
SET I=$ORDER(B(I))
if I=""
QUIT
WRITE "|",$SELECT($LENGTH($PIECE(B(I),U,3)):$PIECE(B(I),U,3),1:" ")
+6 WRITE "|",!
FOR A1=1:1:IOM-1
WRITE "-"
+7 QUIT
LD WRITE !!,LRBUG,?34," ",LRMY
SET X=43
WRITE !
DO LIN
+1 QUIT
LIN FOR A1=1:1:X
WRITE "-"
+1 QUIT
LC WRITE !,LRLLOC
+1 QUIT
SITE WRITE !,?5,$SELECT(LRSIT="Unknown":"Unknown",LRSIT(1)="S":$PIECE(^LAB(61,$PIECE(LRSIT,U,2),0),U),1:$PIECE(^LAB(62,$PIECE(LRSIT,U,2),0),U))
+1 QUIT
