- LRMISEZ3 ; IHS/DIR/FJE - MICRO INF CTRL SURVEY CONT'D 10/1/87 17:15 ;
- ;;5.2;LR;**1013**;JUL 15, 2002
- ;
- ;;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
- LRMISEZ3 ; IHS/DIR/FJE - MICRO INF CTRL SURVEY CONT'D 10/1/87 17:15 ;
- +1 ;;5.2;LR;**1013**;JUL 15, 2002
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +4 ;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
