1 | WVDIAG ;HCIOFO/FT,JR IHS/ANMC/MWR - PRINTOUT OF WV DIAGNOSIS FILE; ;8/10/98 14:56
|
---|
2 | ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
|
---|
3 | ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
---|
4 | ;; CALLED BY OPTION: "WV PRINT RES/DIAG FILE" TO PRINT THE
|
---|
5 | ;; RESULTS/DIAGNOSIS TABLE FILE.
|
---|
6 | ;
|
---|
7 | D SETUP
|
---|
8 | D TITLE^WVUTL5("LISTING OF RESULTS/DIAGNOSIS FILE")
|
---|
9 | D DEVICE I WVPOP D EXIT Q
|
---|
10 | D SORT
|
---|
11 | D DISPLAY
|
---|
12 | ;
|
---|
13 | EXIT ;EP
|
---|
14 | D KILLALL^WVUTL8
|
---|
15 | Q
|
---|
16 | ;
|
---|
17 | SETUP ;EP
|
---|
18 | D SETVARS^WVUTL5 S WVPOP=0
|
---|
19 | S WVLINE=$$REPEAT^XLFSTR("-",80)
|
---|
20 | Q
|
---|
21 | ;
|
---|
22 | DEVICE ;EP
|
---|
23 | ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
|
---|
24 | S ZTRTN="DEQUEUE^WVDIAG"
|
---|
25 | F WVSV="WVLINE","WVTITLE" D
|
---|
26 | .I $D(WVSV) S ZTSAVE(WVSV)=""
|
---|
27 | D ZIS^WVUTL2(.WVPOP,1)
|
---|
28 | Q
|
---|
29 | ;
|
---|
30 | SORT ;EP
|
---|
31 | ;---> SORT BY RESULT/DIAGNOSIS. STORED IN ^TMP("WV",$J,1
|
---|
32 | N N,X,Y K ^TMP("WV",$J)
|
---|
33 | S N=0
|
---|
34 | F S N=$O(^WV(790.31,"B",N)) Q:N="" D
|
---|
35 | .S M=$O(^WV(790.31,"B",N,0))
|
---|
36 | .S Y=^WV(790.31,M,0),WVDIAG=N
|
---|
37 | .F I=3:1:19 I $P(Y,U,I) D
|
---|
38 | ..S WVPN=$E($P(^WV(790.2,$P(Y,U,I),0),U),1,30)
|
---|
39 | ..S X=$P(Y,U,21),WVNORM=$S(X=0:"NORMAL",X=2:"NO RES",1:"ABNORM")
|
---|
40 | ..S WVPRIO=$P(Y,U,2)
|
---|
41 | ..S X=WVDIAG_U_WVPRIO_U_WVNORM_U_WVPN
|
---|
42 | ..S ^TMP("WV",$J,1,WVDIAG,WVPN,1)=X
|
---|
43 | .I $P(Y,U,20) D
|
---|
44 | ..S X=$P(Y,U,21),WVNORM=$S(X=0:"NORMAL",X=2:"NO RES",1:"ABNORM")
|
---|
45 | ..S WVPRIO=$P(Y,U,2),WVPN="ALL PROCEDURES"
|
---|
46 | ..S X=WVDIAG_U_WVPRIO_U_WVNORM_U_WVPN
|
---|
47 | ..S ^TMP("WV",$J,1,WVDIAG,WVPN,1)=X
|
---|
48 | ;
|
---|
49 | ;---> SORT BY PROCEDURE TYPE. STORED IN ^TMP("WV",$J,2
|
---|
50 | S N=0
|
---|
51 | F S N=$O(^WV(790.31,"P",N)) Q:N="" D
|
---|
52 | .S M=0
|
---|
53 | .F S M=$O(^WV(790.31,"P",N,M)) Q:M="" D
|
---|
54 | ..S Y=^WV(790.31,M,0)
|
---|
55 | ..S WVPN=$P(^WV(790.2,N,0),U),WVDIAG=$P(Y,U)
|
---|
56 | ..S X=$P(Y,U,21),WVNORM=$S(X=0:"NORMAL",X=2:"NO RES",1:"ABNORM")
|
---|
57 | ..S WVPRIO=$P(Y,U,2)
|
---|
58 | ..S X=WVPN_U_WVDIAG_U_WVPRIO_U_WVNORM
|
---|
59 | ..S ^TMP("WV",$J,2,WVPN,WVPRIO,WVDIAG)=X
|
---|
60 | ;
|
---|
61 | ;---> ASSOCIATED WITH ALL PROCEDURES
|
---|
62 | S N=0
|
---|
63 | F S N=$O(^WV(790.31,N)) Q:'N D
|
---|
64 | .S Y=^WV(790.31,N,0)
|
---|
65 | .Q:'$P(Y,U,20)
|
---|
66 | .S WVDIAG=$P(Y,U),WVPRIO=$P(Y,U,2)
|
---|
67 | .S X=$P(Y,U,21),WVNORM=$S(X=0:"NORMAL",X=2:"NO RES",1:"ABNORM")
|
---|
68 | .S M=0
|
---|
69 | .F S M=$O(^WV(790.2,M)) Q:'M D
|
---|
70 | ..S WVPN=$P(^WV(790.2,M,0),U)
|
---|
71 | ..Q:$P(^WV(790.2,M,0),U,12)
|
---|
72 | ..S X=WVPN_U_WVDIAG_U_WVPRIO_U_WVNORM
|
---|
73 | ..S ^TMP("WV",$J,2,WVPN,WVPRIO,WVDIAG)=X
|
---|
74 | ;
|
---|
75 | ;---> SORT BY PRIORITY. STORED IN ^TMP("WV",$J,3
|
---|
76 | S N=0
|
---|
77 | F S N=$O(^WV(790.31,"B",N)) Q:N="" D
|
---|
78 | .S M=$O(^WV(790.31,"B",N,0))
|
---|
79 | .S Y=^WV(790.31,M,0),WVDIAG=N,WVPRIO=$P(Y,U,2)
|
---|
80 | .S X=$P(Y,U,21),WVNORM=$S(X=0:"NORMAL",X=2:"NO RES",1:"ABNORM")
|
---|
81 | .S X=WVDIAG_U_WVPRIO_U_WVNORM
|
---|
82 | .S ^TMP("WV",$J,3,WVPRIO,WVDIAG,1)=X
|
---|
83 | ;
|
---|
84 | ;---> COPY TO TMP IN A SINGLE SUBSCRIPT.
|
---|
85 | F WVS=1,2,3 S WVSS=WVS_WVS D COPYGBL
|
---|
86 | Q
|
---|
87 | ;
|
---|
88 | DISPLAY ;EP
|
---|
89 | U IO
|
---|
90 | S WVTITLE1="* WOMEN'S HEALTH: LISTING OF RESULTS/DIAGNOSIS FILE *"
|
---|
91 | D CENTERT^WVUTL5(.WVTITLE1)
|
---|
92 | S WVCRT=$S($E(IOST)="C":1,1:0),(WVPAGE,WVPOP)=0
|
---|
93 | F WVI=22,33,11 D @("DISPLY"_WVI) Q:WVPOP
|
---|
94 | D ^%ZISC
|
---|
95 | Q
|
---|
96 | ;
|
---|
97 | DISPLY11 ;EP
|
---|
98 | ;---> LIST BY RESULT/DIAGNOSIS
|
---|
99 | ;Q
|
---|
100 | S WVTITLE2=" * BY DIAGNOSIS *" D CENTERT^WVUTL5(.WVTITLE2)
|
---|
101 | S WVSUB="W !?3,""RESULT/DIAGNOSIS"",?31,""PRIORITY"",?42,""NORMAL"","
|
---|
102 | S WVSUB=WVSUB_"?50,""ASSOCIATED PROCEDURES"""
|
---|
103 | N Z S (WVPOP,N,Z)=0
|
---|
104 | W:WVCRT @IOF D HEADER
|
---|
105 | F S N=$O(^TMP("WV",$J,WVI,N)) Q:'N!(WVPOP) D
|
---|
106 | .I $Y+8>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D HEADER
|
---|
107 | .S Y=^TMP("WV",$J,WVI,N) W !
|
---|
108 | .I $P(Y,U)'=Z W !?3,$P(Y,U),?37,$J($P(Y,U,2),2),?42,$P(Y,U,3)
|
---|
109 | .W ?50,$P(Y,U,4)
|
---|
110 | .S Z=$P(Y,U)
|
---|
111 | I WVCRT&('WVPOP) W !! D DIRZ^WVUTL3
|
---|
112 | Q
|
---|
113 | ;
|
---|
114 | DISPLY22 ;EP
|
---|
115 | ;---> LIST BY RESULT/DIAGNOSIS
|
---|
116 | S WVTITLE2=" * BY PROCEDURE *" D CENTERT^WVUTL5(.WVTITLE2)
|
---|
117 | S WVSUB="W !?3,""PROCEDURE"",?35,""RESULT/DIAGNOSIS"""
|
---|
118 | S WVSUB=WVSUB_",?62,""PRIORITY"",?72,""NORMAL"""
|
---|
119 | N Z S (WVPOP,N,Z)=0
|
---|
120 | W:WVCRT @IOF D HEADER
|
---|
121 | F S N=$O(^TMP("WV",$J,WVI,N)) Q:'N!(WVPOP) D
|
---|
122 | .I $Y+6>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D HEADER
|
---|
123 | .S Y=^TMP("WV",$J,WVI,N) W !
|
---|
124 | .I $P(Y,U)'=Z W !?3,$P(Y,U)
|
---|
125 | .W ?35,$P(Y,U,2),?68,$J($P(Y,U,3),2),?72,$P(Y,U,4)
|
---|
126 | .S Z=$P(Y,U)
|
---|
127 | I WVCRT&('WVPOP) W !! D DIRZ^WVUTL3
|
---|
128 | Q
|
---|
129 | ;
|
---|
130 | DISPLY33 ;EP
|
---|
131 | ;---> LIST BY RESULT/DIAGNOSIS
|
---|
132 | S WVTITLE2=" * BY PRIORITY *" D CENTERT^WVUTL5(.WVTITLE2)
|
---|
133 | S WVSUB="W !?3,""RESULT/DIAGNOSIS"",?32,""PRIORITY"",?44,""NORMAL"""
|
---|
134 | N Z S (WVPOP,N,Z)=0
|
---|
135 | W:WVCRT @IOF D HEADER
|
---|
136 | F S N=$O(^TMP("WV",$J,WVI,N)) Q:'N!(WVPOP) D
|
---|
137 | .I $Y+6>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D HEADER
|
---|
138 | .S Y=^TMP("WV",$J,WVI,N)
|
---|
139 | .W !?3,$P(Y,U),?37,$J($P(Y,U,2),2),?44,$P(Y,U,3)
|
---|
140 | .S Z=$P(Y,U)
|
---|
141 | I WVCRT&('WVPOP) W !! D DIRZ^WVUTL3
|
---|
142 | Q
|
---|
143 | ;
|
---|
144 | ;
|
---|
145 | HEADER ;EP
|
---|
146 | W:WVPAGE @IOF S WVPAGE=WVPAGE+1,Z=0
|
---|
147 | W WVTITLE1,?70,"PAGE ",WVPAGE,!,WVTITLE2
|
---|
148 | W !,$$RUNDT^WVUTL1A("C")
|
---|
149 | W !,WVLINE X WVSUB W !,WVLINE
|
---|
150 | Q
|
---|
151 | ;
|
---|
152 | COPYGBL ;EP
|
---|
153 | ;---> COPY ^TMP("WV",$J,WVS TO ^TMP("WV",$J,WVSS TO MAKE IT FLAT.
|
---|
154 | N I,M,N,P,Q
|
---|
155 | S N=0,I=0
|
---|
156 | F S N=$O(^TMP("WV",$J,WVS,N)) Q:N="" D
|
---|
157 | .S M=0
|
---|
158 | .F S M=$O(^TMP("WV",$J,WVS,N,M)) Q:M="" D
|
---|
159 | ..S P=0
|
---|
160 | ..F S P=$O(^TMP("WV",$J,WVS,N,M,P)) Q:P="" D
|
---|
161 | ...S I=I+1,^TMP("WV",$J,WVSS,I)=^TMP("WV",$J,WVS,N,M,P)
|
---|
162 | Q
|
---|
163 | ;
|
---|
164 | DEQUEUE ;EP
|
---|
165 | ;---> CALLED BY TASKMAN
|
---|
166 | D SETVARS^WVUTL5,SORT,DISPLAY,EXIT
|
---|
167 | Q
|
---|