source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRMISEZ2.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.2 KB
RevLine 
[613]1LRMISEZ2 ;AVAMC/REG/SLC/BA - MICRO INFECTION CTRL SURVEY ; 10/1/87 17:12 ;
2 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
3 ;from LRMISEZ1
4TYPE I LRM("L")'="N" S LRPG=0,S="LOC" D HDR,M W @IOF
5 I LRM("O")'="N" D ^LRMISEZ3 W @IOF
6 I LRM("D")'="N" S LRPG=0,S="DOC" D HDR,M W @IOF
7 I LRM("P")'="N" S LRPG=0,S="PAT" D HDR,M W @IOF
8 Q
9M 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
10 Q
11LLOC 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
12 Q
13NLOC I S="LOC" S LRNLOC=LRLLOC Q
14 S LRNLOC=$P(LRLLOC,U,2) I S="PAT" S LRNLOC=^TMP($J,"XPAT",LRNLOC) Q
15 I S="DOC" S LRNLOC=$S(LRNLOC="":"Unknown",1:^TMP($J,"XDOC",LRNLOC))
16 Q
17NAME 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
18 Q
19SIT 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
20 Q
21AC 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
22 Q
23OR 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
24 Q
25BG 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
26 Q
27FX 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)
28 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
29 I $Y>61 D HDR,LD W !,$E(LRBUG,1,13),?13,$E($P(LRSIT,U),1,7)
30 W:S'="PAT" !,$E(LRPNM,1,10),?11,SSN,?21,LRDAT,$E($P(LRSIT,U),1,7)," Quantity: ",LRQUANT
31 W:S="PAT" !,LRDAT,$E($P(LRSIT,U),1,7)," Quantity: ",LRQUANT
32 S LRSUM=LRSUM+1 W !?2,$E(LRBUG,1,32),?34,$J(LRSUM,3),")",?37,$J(LRAC,5),?43
33 S LRLIN="",$P(LRLIN,"| ",O+1)="|"
34 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)
35 W LRLIN,!
36 Q
37NOD Q:'$D(LRZ(LRYA)) S $P(LRLIN,"|",LRZ(LRYA)+1)=^TMP($J,S,M,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBG,LRYA)
38 Q
39HDR 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)
40 I LRLOS W !,?2,"** Reports only those specimens collected > ",LRLOS,$S(LRLOS>1:" days",1:" day")," from admission date **"
41 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)
42 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)
43 W:S'="PAT" "|",!,?2,"Patient",?11,"SSN",?21,"Date",?30,$S(LRSIT(1)="S":"Spec",1:"Sample"),?43
44 W:S="PAT" "|",!,?2,"Date",?11,"Spec",?43
45 F I=0:0 S I=$O(B(I)) Q:I="" W "|",$E($P(B(I),U,2),3)
46 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:" ")
47 W "|",! F A1=1:1:IOM-1 W "-"
48 Q
49LD W !!,$E($P(LRNLOC,U),1,14),?15,LRMY,":" S X=$X W ! D LIN
50 Q
51LIN F A1=1:1:X W "-"
52 Q
Note: See TracBrowser for help on using the repository browser.