source: FOIAVistA/trunk/r/WOMENS_HEALTH-WV/WV16PST.m@ 913

Last change on this file since 913 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1WV16PST ;HIOFO/FT-WV*1*16 POST INSTALLATION ROUTINE ;6/29/04 11:04
2 ;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
3 ;
4 ; This routine uses the following IAs:
5 ; #1157 - ^XPDMENU (supported)
6 ; #2916 - ^DDMOD (supported)
7 ; #10063 - ^%ZTLOAD (supported)
8 ; #10141 - ^XPDUTL (supported)
9 ;
10EN ; Start the post-installation
11 D EN1,EN2,EN3,EN4
12 Q
13EN1 ; Add/edit FILE 790.31 entries
14 N WVERR,WVFDA,WVIEN
15 I $O(^WV(790.31,"B","No Evidence of Malignancy",0))'>0 D ;exists?
16 .S WVFDA(790.31,"+1,",.01)="No Evidence of Malignancy"
17 .S WVFDA(790.31,"+1,",.02)=90
18 .S WVFDA(790.31,"+1,",.03)=$O(^WV(790.2,"B","MAMMOGRAM DX BILAT",0))
19 .S WVFDA(790.31,"+1,",.04)=$O(^WV(790.2,"B","MAMMOGRAM DX UNILAT",0))
20 .S WVFDA(790.31,"+1,",.05)=$O(^WV(790.2,"B","MAMMOGRAM SCREENING",0))
21 .S WVFDA(790.31,"+1,",.06)=$O(^WV(790.2,"B","PAP SMEAR",0))
22 .S WVFDA(790.31,"+1,",.07)=$O(^WV(790.2,"B","BREAST ULTRASOUND",0))
23 .S WVFDA(790.31,"+1,",.2)=0
24 .S WVFDA(790.31,"+1,",.21)=0
25 .S WVIEN=""
26 .D UPDATE^DIE("","WVFDA","WVIEN")
27 .Q
28 K WVDFA,WVIEN
29 I $O(^WV(790.31,"B","Abnormal",0))'>0 D ;exists?
30 .S WVFDA(790.31,"+1,",.01)="Abnormal"
31 .S WVFDA(790.31,"+1,",.02)=90
32 .S WVFDA(790.31,"+1,",.03)=$O(^WV(790.2,"B","MAMMOGRAM DX BILAT",0))
33 .S WVFDA(790.31,"+1,",.04)=$O(^WV(790.2,"B","MAMMOGRAM DX UNILAT",0))
34 .S WVFDA(790.31,"+1,",.05)=$O(^WV(790.2,"B","MAMMOGRAM SCREENING",0))
35 .S WVFDA(790.31,"+1,",.06)=$O(^WV(790.2,"B","PAP SMEAR",0))
36 .S WVFDA(790.31,"+1,",.07)=$O(^WV(790.2,"B","BREAST ULTRASOUND",0))
37 .S WVFDA(790.31,"+1,",.2)=0
38 .S WVFDA(790.31,"+1,",.21)=1
39 .S WVIEN=""
40 .D UPDATE^DIE("","WVFDA","WVIEN")
41 .Q
42 ; Add 'BREAST ULTRASOUND' as an associated procedure to 'Unsatisfactory
43 ; for Dx'.
44 K WVFDA,WVIEN
45 S WVIEN=$O(^WV(790.31,"B","Unsatisfactory for Dx",0))
46 I WVIEN D
47 .S WVFDA(790.31,WVIEN_",",.14)=$O(^WV(790.2,"B","BREAST ULTRASOUND",0))
48 .D FILE^DIE("","WVFDA","WVERR")
49 .Q
50 Q
51EN2 ; Option/menu changes
52 ; Add WV PAP SMEAR SNOMED CODES to WV MENU-FILE MAINTENANCE menu.
53 N WVFLAG,WVMENU,WVOPTION,WVORDER,WVSYN
54 S WVMENU="WV MENU-FILE MAINTENANCE"
55 S WVOPTION="WV PAP SMEAR SNOMED CODES",WVSYN="PAP",WVORDER=13
56 S WVFLAG=$$ADD^XPDMENU(WVMENU,WVOPTION,WVSYN,WVORDER)
57 Q
58EN3 ; Create and populate AC index on FILE 790.1
59 ; task job
60 N WVMESAGE,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
61 S ZTRTN="Q4^WV16PST",ZTDESC="WV*1*16 INSTALLATION"
62 S ZTIO="",ZTDTH=$H
63 D ^%ZTLOAD
64 S WVMESAGE="Will build new 'AC' x-ref on FILE 790.1 in background job #"_$G(ZTSK)
65 D MES^XPDUTL(WVMESAGE)
66 Q
67Q4 ; Adding AC Index for WV PROCEDURE file (#790.1)
68 I $D(ZTQUEUED) S ZTREQ="@"
69 N MSG,RESULT,XREF
70 S XREF("FILE")=790.1
71 S XREF("ROOT FILE")=790.1
72 S XREF("TYPE")="REGULAR"
73 S XREF("SHORT DESCR")="Patient and Date of Procedure"
74 S XREF("DESCR",1)="This index consists of patient DFN and date of procedure."
75 S XREF("DESCR",2)="ex: ^WV(790.1,'AC',DFN,Date of Procedure,DA)"
76 S XREF("USE")="SORTING ONLY"
77 S XREF("EXECUTION")="R"
78 S XREF("ACTIVITY")="IR"
79 S XREF("VAL",1)=.02
80 S XREF("VAL",1,"SUBSCRIPT")=1
81 S XREF("VAL",2)=.12
82 S XREF("VAL",2,"SUBSCRIPT")=2
83 S XREF("NAME")="AC"
84 D CREIXN^DDMOD(.XREF,"S",.RESULT,"","MSG")
85 Q
86EN4 ; Add new purposes of notification to FILE 790.404
87 N WVFDA,WVIEN,WVLETTER,WVLOOP,WVLOOP1,WVNAME,WVNODE
88 D LETTER
89 F WVLOOP=1:1 S WVNODE=$T(EN6A+WVLOOP) Q:$P(WVNODE,";",3)="" D
90 .S WVNAME=$P(WVNODE,";",3)
91 .Q:WVNAME=""
92 .Q:$D(^WV(790.404,"B",WVNAME)) ;already exists
93 .K WVFDA
94 .S WVFDA(790.404,"+1,",.01)=WVNAME
95 .S WVFDA(790.404,"+1,",.04)=1 ;active: 1=yes
96 .S WVFDA(790.404,"+1,",.02)=$P(WVNODE,";",4) ;priority code
97 .S WVFDA(790.404,"+1,",.06)=$P(WVNODE,";",5) ;result/reminder type
98 .S WVFDA(790.404,"+1,",.05)=$P(WVNODE,";",6) ;br or cx type
99 .I $P(WVNODE,";",7)]"" D
100 ..S WVFDA(790.404,"+1,",.07)=$$BRTXIEN^WVRPCPR1($P(WVNODE,";",7)) ;br tx need
101 ..Q
102 .I $P(WVNODE,";",8)]"" D
103 ..S WVFDA(790.404,"+1,",.08)=$P(WVNODE,";",8) ;br tx due date
104 ..Q
105 .I $P(WVNODE,";",9)]"" D
106 ..S WVFDA(790.404,"+1,",.09)=$$CXTXIEN^WVRPCPR1($P(WVNODE,";",9)) ;cx tx need
107 ..Q
108 .I $P(WVNODE,";",10)]"" D
109 ..S WVFDA(790.404,"+1,",.1)=$P(WVNODE,";",10) ;cx tx due date
110 ..Q
111 .K WVIEN
112 .D UPDATE^DIE("","WVFDA","WVIEN")
113 .Q:+$G(WVLETTER(0))'>0 ;copy generic letter text for new purpose
114 .S WVLOOP1=0
115 .S ^WV(790.404,WVIEN(1),1,0)="^^"_WVLETTER(0)_U_WVLETTER(0)_U_DT
116 .F WVLOOP1=1:1:WVLETTER(0) D
117 ..S ^WV(790.404,WVIEN(1),1,WVLOOP1,0)=WVLETTER(WVLOOP1)
118 ..Q
119 .Q
120 Q
121 ;;(3)name;(4)priority;(5)result/reminder;(6)br/cx;(7)br tx need;(8)br tx due date;(9)cx tx need;(10)cx tx due date
122EN6A ;New purposes of notification
123 ;;CPRS UPDATE PAP TX NEED 4M;2;0;CX;;;Repeat PAP;4M
124 ;;CPRS UPDATE PAP TX NEED 6M;2;0;CX;;;Repeat PAP;6M
125 ;;CPRS UPDATE PAP TX NEED 3Y;3;0;CX;;;Routine PAP;3Y
126 ;;CPRS UPDATE PAP TX NEED 2Y;3;0;CX;;;Routine PAP;2Y
127 ;;CPRS UPDATE PAP TX NEED 1Y;3;0;CX;;;Routine PAP;1Y
128 ;;CPRS UPDATE MAM TX NEED 1Y;3;0;BR;Mammogram, Screening;1Y;;
129 ;;CPRS UPDATE MAM TX NEED 2Y;3;0;BR;Mammogram, Screening;2Y;;
130 ;;CPRS UPDATE MAM TX NEED 6M;2;0;BR;Mammogram, Repeat;6M;;
131 ;;CPRS UPDATE MAM TX NEED 4M;2;0;BR;Mammogram, Repeat;4M;;
132 ;;MAM result NEM, next MAM 1Y;3;1;BR;Mammogram, Screening;1Y;;
133 ;;MAM result NEM, next MAM 2Y;3;1;BR;Mammogram, Screening;2Y;;
134 ;;MAM result NEM, next MAM 4M;2;1;BR;Mammogram, Repeat;4M;;
135 ;;MAM result NEM, next MAM 6M;2;1;BR;Mammogram, Repeat;6M;;
136 ;;MAM result abnormal, F/U MAM 4M;2;1;BR;Mammogram, Followup;4M;;
137 ;;MAM result abnormal, F/U MAM 6M;2;1;BR;Mammogram, Followup;6M;;
138 ;;PAP result NEM, next PAP 1Y;3;1;CX;;;Routine PAP;1Y
139 ;;PAP result NEM, next PAP 2Y;3;1;CX;;;Routine PAP;2Y
140 ;;PAP result NEM, next PAP 3Y;3;1;CX;;;Routine PAP;3Y
141 ;;PAP result NEM, next PAP 4M;2;1;CX;;;Repeat PAP;4M
142 ;;PAP result NEM, next PAP 6M;2;1;CX;;;Repeat PAP;6M
143 ;;PAP result abnormal, F/U PAP 4M;2;1;CX;;;Follow-up PAP;4M
144 ;;PAP result abnormal, F/U PAP 6M;2;1;CX;;;Follow-up PAP;6M
145 ;;MAM unsatisfactory, need repeat;2;1;BR;Mammogram, Repeat;0D;;
146 ;;Pap unsatisfactory, need repeat;2;1;CX;;;Repeat PAP;0D
147 ;;PAP result NEM, further screening not required;3;1;CX;;;;
148 ;;MAM result NEM, further screening not required;3;1;BR;;;;
149 ;;;
150 Q
151LETTER ; Copy generic letter text into local array
152 N WVCOUNT,WVLOOP,WVNODE
153 K WVLETTER
154 S (WVCOUNT,WVLOOP)=0
155 F WVLOOP=1:1 S WVNODE=$T(LTRTEXT+WVLOOP) Q:$P(WVNODE,";",3)="" D
156 .S WVCOUNT=WVCOUNT+1
157 .S WVLETTER(WVCOUNT)=$P(WVNODE,";",3)
158 .Q
159 S WVLETTER(0)=WVCOUNT
160 Q
161LTRTEXT ;;Generic letter text
162 ;;|NOWRAP|;
163 ;; ;
164 ;;|CENTER("Women's Health Clinic")|;
165 ;; ;
166 ;;|CENTER("Your Street")|;
167 ;; ;
168 ;;|CENTER("Your City, ST Zip Code")|;
169 ;; ;
170 ;; ;
171 ;; |TODAY|;
172 ;; ;
173 ;; ;
174 ;; |$E(SSN#,6,9)|;
175 ;; |$P(NAME,",",2)| |$P(NAME,",")|;
176 ;; |COMPLETE ADDRESS|;
177 ;; ;
178 ;; ;
179 ;; ;
180 ;; ;
181 ;; ;
182 ;;- - - -;
183 ;; ;
184 ;; Dear Ms. |$P(NAME,",",1)|,;
185 ;; ;
186 ;; This is the body of the letter and should be edited to say what;
187 ;; you want for this Purpose of Notification.;
188 ;; ;
189 ;; ;
190 ;; Sincerely,;
191 ;; ;
192 ;; ;
193 ;; ;
194 ;; Your Name;
195 ;; Women's Health Program;
196 ;; phone: nnn-nnnn;
197 ;; ;
198 ;; ;
199 ;; printed: |NOW|;
200 ;;;
Note: See TracBrowser for help on using the repository browser.