LRMISEZ2 ;AVAMC/REG/SLC/BA - MICRO INFECTION CTRL SURVEY ; 10/1/87 17:12 ;
;;5.2;LAB SERVICE;**201**;Sep 27, 1994
;from LRMISEZ1
TYPE I LRM("L")'="N" S LRPG=0,S="LOC" D HDR,M W @IOF
I LRM("O")'="N" D ^LRMISEZ3 W @IOF
I LRM("D")'="N" S LRPG=0,S="DOC" D HDR,M W @IOF
I LRM("P")'="N" S LRPG=0,S="PAT" D HDR,M W @IOF
Q
M S M=0 F I=0:0 S M=$O(^TMP($J,S,M)) Q:M="" S LRAD=$E(M,1,3)_"0000",Y=M_"00" D D^LRU S LRMY=Y D LLOC
Q
LLOC S LRLLOC=0 F I=0:0 S LRLLOC=$O(^TMP($J,S,M,LRLLOC)) Q:LRLLOC="" D:$Y>61 HDR D NLOC W !!,$E($P(LRNLOC,U),1,25) W:S'="PAT" ! S LRPAT=0,X=43 D:S'="PAT" LIN D NAME
Q
NLOC I S="LOC" S LRNLOC=LRLLOC Q
S LRNLOC=$P(LRLLOC,U,2) I S="PAT" S LRNLOC=^TMP($J,"XPAT",LRNLOC) Q
I S="DOC" S LRNLOC=$S(LRNLOC="":"Unknown",1:^TMP($J,"XDOC",LRNLOC))
Q
NAME S LRNAME=0 F I=0:0 S LRNAME=$O(^TMP($J,S,M,LRLLOC,LRNAME)) Q:LRNAME="" D:$Y>61 HDR,LD D SIT
Q
SIT S LRSIT=0 F I=0:0 S LRSIT=$O(^TMP($J,S,M,LRLLOC,LRNAME,LRSIT)) Q:LRSIT="" D:$Y>61 HDR,LD D AC
Q
AC S (LRAC,LRSUM)=0 F I=0:0 S LRAC=$O(^TMP($J,S,M,LRLLOC,LRNAME,LRSIT,LRAC)) Q:LRAC="" D:$Y>61 HDR,LD D OR
Q
OR S LROR=0 F I=0:0 S LROR=$O(^TMP($J,S,M,LRLLOC,LRNAME,LRSIT,LRAC,LROR)) Q:LROR="" D:$Y>61 HDR,LD D BG
Q
BG S LRBG=0 F I=0:0 S LRBG=$O(^TMP($J,S,M,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBG)) Q:LRBG="" S:S="LOC" ^TMP($J,"SE",LRBG,M,LRLLOC,LRSIT,LRAC,LROR,LRNAME)=$P(^(LRBG),U,1,4) S LRBUG=$P(^LAB(61.2,+$E(LRBG,4,25),0),U) D:$Y>61 HDR,LD D FX
Q
FX S X=^TMP($J,S,M,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBG),SSN=$P(X,U,2),LRQUANT=$P(X,U,3),X=+X,LRDAT=$$Y2K^LRX(X)_" ",LRPNM=$P(LRNAME,U)
I 'LRPAT,S="PAT" W ?25,$E(SSN,1,3),"-",$E(SSN,4,5),"-",$E(SSN,6,9),! S LRPAT=1,X=43 D LIN
I $Y>61 D HDR,LD W !,$E(LRBUG,1,13),?13,$E($P(LRSIT,U),1,7)
W:S'="PAT" !,$E(LRPNM,1,10),?11,SSN,?21,LRDAT,$E($P(LRSIT,U),1,7)," Quantity: ",LRQUANT
W:S="PAT" !,LRDAT,$E($P(LRSIT,U),1,7)," Quantity: ",LRQUANT
S LRSUM=LRSUM+1 W !?2,$E(LRBUG,1,32),?34,$J(LRSUM,3),")",?37,$J(LRAC,5),?43
S LRLIN="",$P(LRLIN,"| ",O+1)="|"
S LRYA=0 F I=0:0 S LRYA=$O(^TMP($J,S,M,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBG,LRYA)) Q:LRYA="" D NOD S:S="LOC" ^TMP($J,"SE",LRBG,M,LRLLOC,LRSIT,LRAC,LROR,LRNAME,LRYA)=^(LRYA)
W LRLIN,!
Q
NOD Q:'$D(LRZ(LRYA)) S $P(LRLIN,"|",LRZ(LRYA)+1)=^TMP($J,S,M,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBG,LRYA)
Q
HDR S LRPG=LRPG+1,%DT="T",X="N" D ^%DT,D^LRU W @IOF,!,Y,?21,"INFECTION CONTROL SURVEY REPORT BY ",$S(S="LOC":"LOCATION",S="DOC":"PROVIDER",1:"PATIENT"),?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 "|",!,$S(S="LOC":"Location",S="DOC":"Provider",1:"Patient") W:S="PAT" ?25,"SSN" W ?43 F I=0:0 S I=$O(B(I)) Q:I="" W "|",$E($P(B(I),U,2),2)
W:S'="PAT" "|",!,?2,"Patient",?11,"SSN",?21,"Date",?30,$S(LRSIT(1)="S":"Spec",1:"Sample"),?43
W:S="PAT" "|",!,?2,"Date",?11,"Spec",?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 !!,$E($P(LRNLOC,U),1,14),?15,LRMY,":" S X=$X W ! D LIN
Q
LIN F A1=1:1:X W "-"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMISEZ2 3303 printed Apr 09, 2024@21:15:10 Page 2
LRMISEZ2 ;AVAMC/REG/SLC/BA - MICRO INFECTION CTRL SURVEY ; 10/1/87 17:12 ;
+1 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
+2 ;from LRMISEZ1
TYPE IF LRM("L")'="N"
SET LRPG=0
SET S="LOC"
DO HDR
DO M
WRITE @IOF
+1 IF LRM("O")'="N"
DO ^LRMISEZ3
WRITE @IOF
+2 IF LRM("D")'="N"
SET LRPG=0
SET S="DOC"
DO HDR
DO M
WRITE @IOF
+3 IF LRM("P")'="N"
SET LRPG=0
SET S="PAT"
DO HDR
DO M
WRITE @IOF
+4 QUIT
M SET M=0
FOR I=0:0
SET M=$ORDER(^TMP($JOB,S,M))
if M=""
QUIT
SET LRAD=$EXTRACT(M,1,3)_"0000"
SET Y=M_"00"
DO D^LRU
SET LRMY=Y
DO LLOC
+1 QUIT
LLOC SET LRLLOC=0
FOR I=0:0
SET LRLLOC=$ORDER(^TMP($JOB,S,M,LRLLOC))
if LRLLOC=""
QUIT
if $Y>61
DO HDR
DO NLOC
WRITE !!,$EXTRACT($PIECE(LRNLOC,U),1,25)
if S'="PAT"
WRITE !
SET LRPAT=0
SET X=43
if S'="PAT"
DO LIN
DO NAME
+1 QUIT
NLOC IF S="LOC"
SET LRNLOC=LRLLOC
QUIT
+1 SET LRNLOC=$PIECE(LRLLOC,U,2)
IF S="PAT"
SET LRNLOC=^TMP($JOB,"XPAT",LRNLOC)
QUIT
+2 IF S="DOC"
SET LRNLOC=$SELECT(LRNLOC="":"Unknown",1:^TMP($JOB,"XDOC",LRNLOC))
+3 QUIT
NAME SET LRNAME=0
FOR I=0:0
SET LRNAME=$ORDER(^TMP($JOB,S,M,LRLLOC,LRNAME))
if LRNAME=""
QUIT
if $Y>61
DO HDR
DO LD
DO SIT
+1 QUIT
SIT SET LRSIT=0
FOR I=0:0
SET LRSIT=$ORDER(^TMP($JOB,S,M,LRLLOC,LRNAME,LRSIT))
if LRSIT=""
QUIT
if $Y>61
DO HDR
DO LD
DO AC
+1 QUIT
AC SET (LRAC,LRSUM)=0
FOR I=0:0
SET LRAC=$ORDER(^TMP($JOB,S,M,LRLLOC,LRNAME,LRSIT,LRAC))
if LRAC=""
QUIT
if $Y>61
DO HDR
DO LD
DO OR
+1 QUIT
OR SET LROR=0
FOR I=0:0
SET LROR=$ORDER(^TMP($JOB,S,M,LRLLOC,LRNAME,LRSIT,LRAC,LROR))
if LROR=""
QUIT
if $Y>61
DO HDR
DO LD
DO BG
+1 QUIT
BG SET LRBG=0
FOR I=0:0
SET LRBG=$ORDER(^TMP($JOB,S,M,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBG))
if LRBG=""
QUIT
if S="LOC"
SET ^TMP($JOB,"SE",LRBG,M,LRLLOC,LRSIT,LRAC,LROR,LRNAME)=$PIECE(^(LRBG),U,1,4)
SET LRBUG=$PIECE(^LAB(61.2,+$EXTRACT(LRBG,4,25),0),U)
if $Y>61
DO HDR
DO LD
DO FX
+1 QUIT
FX SET X=^TMP($JOB,S,M,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBG)
SET SSN=$PIECE(X,U,2)
SET LRQUANT=$PIECE(X,U,3)
SET X=+X
SET LRDAT=$$Y2K^LRX(X)_" "
SET LRPNM=$PIECE(LRNAME,U)
+1 IF 'LRPAT
IF S="PAT"
WRITE ?25,$EXTRACT(SSN,1,3),"-",$EXTRACT(SSN,4,5),"-",$EXTRACT(SSN,6,9),!
SET LRPAT=1
SET X=43
DO LIN
+2 IF $Y>61
DO HDR
DO LD
WRITE !,$EXTRACT(LRBUG,1,13),?13,$EXTRACT($PIECE(LRSIT,U),1,7)
+3 if S'="PAT"
WRITE !,$EXTRACT(LRPNM,1,10),?11,SSN,?21,LRDAT,$EXTRACT($PIECE(LRSIT,U),1,7)," Quantity: ",LRQUANT
+4 if S="PAT"
WRITE !,LRDAT,$EXTRACT($PIECE(LRSIT,U),1,7)," Quantity: ",LRQUANT
+5 SET LRSUM=LRSUM+1
WRITE !?2,$EXTRACT(LRBUG,1,32),?34,$JUSTIFY(LRSUM,3),")",?37,$JUSTIFY(LRAC,5),?43
+6 SET LRLIN=""
SET $PIECE(LRLIN,"| ",O+1)="|"
+7 SET LRYA=0
FOR I=0:0
SET LRYA=$ORDER(^TMP($JOB,S,M,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBG,LRYA))
if LRYA=""
QUIT
DO NOD
if S="LOC"
SET ^TMP($JOB,"SE",LRBG,M,LRLLOC,LRSIT,LRAC,LROR,LRNAME,LRYA)=^(LRYA)
+8 WRITE LRLIN,!
+9 QUIT
NOD if '$DATA(LRZ(LRYA))
QUIT
SET $PIECE(LRLIN,"|",LRZ(LRYA)+1)=^TMP($JOB,S,M,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBG,LRYA)
+1 QUIT
HDR SET LRPG=LRPG+1
SET %DT="T"
SET X="N"
DO ^%DT
DO D^LRU
WRITE @IOF,!,Y,?21,"INFECTION CONTROL SURVEY REPORT BY ",$SELECT(S="LOC":"LOCATION",S="DOC":"PROVIDER",1:"PATIENT"),?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 "|",!,$SELECT(S="LOC":"Location",S="DOC":"Provider",1:"Patient")
if S="PAT"
WRITE ?25,"SSN"
WRITE ?43
FOR I=0:0
SET I=$ORDER(B(I))
if I=""
QUIT
WRITE "|",$EXTRACT($PIECE(B(I),U,2),2)
+4 if S'="PAT"
WRITE "|",!,?2,"Patient",?11,"SSN",?21,"Date",?30,$SELECT(LRSIT(1)="S":"Spec",1:"Sample"),?43
+5 if S="PAT"
WRITE "|",!,?2,"Date",?11,"Spec",?43
+6 FOR I=0:0
SET I=$ORDER(B(I))
if I=""
QUIT
WRITE "|",$EXTRACT($PIECE(B(I),U,2),3)
+7 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:" ")
+8 WRITE "|",!
FOR A1=1:1:IOM-1
WRITE "-"
+9 QUIT
LD WRITE !!,$EXTRACT($PIECE(LRNLOC,U),1,14),?15,LRMY,":"
SET X=$X
WRITE !
DO LIN
+1 QUIT
LIN FOR A1=1:1:X
WRITE "-"
+1 QUIT
