source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SD08STOP.m@ 1379

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

initial load of FOIAVistA 6/30/08 version
File size: 8.3 KB
Line 
1SD08STOP ;ALB/RLC- Stop Code/DSS Identifier Update 6/18/07
2 ;;5.3;Scheduling;**518**;AUG 13, 1993;Build 2
3 ;
4 ;** This patch is used as a Post-Init in a KIDS build to modify the
5 ;** the CLINIC STOP file [^DIC(40.7,] for FY08 updates.
6 ;
7EN ;** Add/inactivate/change/reactivate DSS IDs (stop codes)
8 ;** The following code executes if file modifications exist
9 ;
10 N SDVAR
11 D:$P($T(NEW+1),";;",2)'="QUIT" ADD
12 D:$P($T(OLD+1),";;",2)'="QUIT" INACT
13 D:$P($T(CHNG+1),";;",2)'="QUIT" CHANGE
14 D:$P($T(CDR+1),";;",2)'="QUIT" CDRNUM
15 D:$P($T(ACT+1),";;",2)'="QUIT" REACT
16 D:$P($T(REST+1),";;",2)'="QUIT" RESTR
17 Q
18 ;
19 ;
20ADD ;** Add DSS IDs
21 ;
22 ; SDXX is in format:
23 ; STOP CODE NAME^AMIS #^RESTRICTION TYPE^REST. DATE^CDR #
24 ;
25 N SDX,SDXX
26 S SDVAR=1
27 D MES^XPDUTL("")
28 D BMES^XPDUTL(">>> Adding new Clinic Stops (DSS IDs) to CLINIC STOP File (#40.7)...")
29 ;
30 ;** NOTE: The following line is for DSS IDs that are not yet active
31 D BMES^XPDUTL(" [NOTE: These Stop Codes CANNOT be used UNTIL 10/1/05]")
32 S DIC(0)="L",DLAYGO=40.7,DIC="^DIC(40.7,"
33 F SDX=1:1 K DD,DO,DA S SDXX=$P($T(NEW+SDX),";;",2) Q:SDXX="QUIT" DO
34 .S DIC("DR")="1////"_$P(SDXX,"^",2)_$S('+$P(SDXX,U,5):"",1:";4////"_$P(SDXX,"^",5))
35 .S DIC("DR")=DIC("DR")_";5////"_$P(SDXX,"^",3)_";6///"_$P(SDXX,"^",4)
36 .S X=$P(SDXX,"^",1)
37 .I '$D(^DIC(40.7,"C",$P(SDXX,"^",2))) D FILE^DICN,MESS Q
38 .I $D(^DIC(40.7,"C",$P(SDXX,"^",2))) D EDIT(SDXX),MESSEX
39 K DIC,DLAYGO,X
40 Q
41 ;
42EDIT(SDXX) ;- Edit fields w/new values if stop code record already exists
43 ;
44 Q:$G(SDXX)=""
45 N DA,DIE,DLAYGO,DR
46 S DA=+$O(^DIC(40.7,"C",+$P(SDXX,"^",2),0))
47 Q:'DA
48 S DIE="^DIC(40.7,",DR=".01////"_$P(SDXX,"^")_";1////"_$P(SDXX,"^",2)_";2////@"_$S('+$P(SDXX,U,5):"",1:";4////"_$P(SDXX,"^",5))_";5////"_$P(SDXX,"^",3)_";6///"_$P(SDXX,"^",4)
49 D ^DIE
50 Q
51INACT ;** Inactivate DSS IDs
52 ;
53 ; SDXX is in format:
54 ; AMIS #^^INACTIVATION DATE (in FileMan format)
55 ;
56 N SDX,SDDA,SDXX,SDINDT,SDEXDT
57 S SDVAR=1
58 D MES^XPDUTL("")
59 D BMES^XPDUTL(">>> Inactivating Clinic Stops (DSS IDs) in CLINIC STOP File (#40.7)...")
60 D BMES^XPDUTL(" [NOTE: These Stop Codes CANNOT be used AFTER the indicated inactivation date]")
61 F SDX=1:1 K DD,DO,DA S SDXX=$P($T(OLD+SDX),";;",2) Q:SDXX="QUIT" DO
62 . I +$P(SDXX,"^",3) D
63 .. S X=$P(SDXX,"^",3)
64 .. ;
65 .. ;- Validate date passed in
66 .. S %DT="FTX"
67 .. D ^%DT
68 .. Q:Y<0
69 .. S SDINDT=Y
70 .. D DD^%DT
71 .. S SDEXDT=Y
72 .. S SDDA=+$O(^DIC(40.7,"C",+SDXX,0))
73 .. I $D(^DIC(40.7,SDDA,0)) D
74 ... S DA=SDDA,DR="2////^S X=SDINDT",DIE="^DIC(40.7,"
75 ... D ^DIE,MESI(SDEXDT)
76 K %,%H,%I,DR,DA,DIC,DIE,DLAYGO,X,%DT,Y
77 Q
78 ;
79CHANGE ;** Change DSS ID names
80 ;
81 ; SDXX is in format:
82 ; STOP CODE NAME^AMIS #^^NEW STOP CODE NAME
83 ;
84 N SDX,SDXX,SDDA
85 S SDVAR=1
86 D MES^XPDUTL("")
87 D BMES^XPDUTL(">>> Changing Clinic Stop (DSS ID) names in CLINIC STOP File (#40.7)...")
88 F SDX=1:1 K DD,DO,DA S SDXX=$P($T(CHNG+SDX),";;",2) Q:SDXX="QUIT" DO
89 .S SDDA=+$O(^DIC(40.7,"C",$P(SDXX,U,2),0))
90 .I $D(^DIC(40.7,SDDA,0)) DO
91 ..S DA=SDDA,DR=".01///"_$P(SDXX,U,4),DIE="^DIC(40.7,"
92 ..D ^DIE,MESC
93 K DIE,DR,DA
94 Q
95 ;
96CDRNUM ;** Change CDR numbers
97 ;
98 ; SDXX is in format:
99 ; STOP CODE NAME (AMIS #) ^ AMIS # ^ OLD CDR # ^ NEW CDR #
100 ;
101 N SDX,SDXX,SDDA
102 S SDVAR=2
103 D MES^XPDUTL("")
104 D BMES^XPDUTL(">>> Changing CDR numbers in CLINIC STOP File (#40.7)...")
105 F SDX=1:1 K DD,DO,DA S SDXX=$P($T(CDR+SDX),";;",2) Q:SDXX="QUIT" DO
106 .S SDDA=+$O(^DIC(40.7,"C",$P(SDXX,U,2),0))
107 .I $D(^DIC(40.7,SDDA,0)) DO
108 ..S DA=SDDA,DR="4///"_$P(SDXX,U,4),DIE="^DIC(40.7,"
109 ..D ^DIE,MESN
110 K DIE,DR,DA,X
111 Q
112 ;
113REACT ;** Reactivate DSS IDs
114 ;
115 ; SDXX is in format:
116 ; AMIS #^
117 ;
118 N SDX,SDDA,SDXX
119 ;S SDDA=+$O(^DIC(40.7,"C",510,0)) I $P($G(^DIC(40.7,SDDA,0)),"^",3)="" Q
120 S SDVAR=1
121 D MES^XPDUTL("")
122 D BMES^XPDUTL(">>> Reactivating Clinic Stops (DSS IDs) in CLINIC STOP File (#40.7)...")
123 F SDX=1:1 K DD,DO,DA S SDXX=$P($T(ACT+SDX),";;",2) Q:SDXX="QUIT" DO
124 .S SDDA=+$O(^DIC(40.7,"C",+SDXX,0))
125 .I $P($G(^DIC(40.7,SDDA,0)),"^",3)'="" DO
126 ..S DA=SDDA,DR="2///@",DIE="^DIC(40.7,"
127 ..D ^DIE,MESA
128 K DR,DA,DIE
129 Q
130 ;
131RESTR ;** Change Restriction Data
132 ;
133 ; SDXX is in format:
134 ; STOP CODE NAME^STOP CODE NUMBER^RESTRICTION TYPE^RESTRICTION DATE
135 ;
136 N SDX,SDXX,SDDA
137 S SDVAR=3
138 D MES^XPDUTL("")
139 D BMES^XPDUTL(">>> Changing Restriction Data in CLINIC STOP File (#40.7)...")
140 F SDX=1:1 K DD,DO,DA S SDXX=$P($T(REST+SDX),";;",2) Q:SDXX="QUIT" D
141 .S SDDA=+$O(^DIC(40.7,"C",$P(SDXX,U,2),0))
142 .I $D(^DIC(40.7,SDDA,0)) D
143 ..I $P(SDXX,U,2)=571 S DA=SDDA,DR="5////"_$P(SDXX,U,3)_";6///@",DIE="^DIC(40.7," D ^DIE,MESR Q
144 ..S DA=SDDA,DR="5////"_$P(SDXX,U,3)_";6///"_$P(SDXX,U,4),DIE="^DIC(40.7,"
145 ..D ^DIE,MESR
146 K DIE,DR,DA,X
147 Q
148 ;
149MESS ;** Add message
150 N ECXADMSG
151 I +$G(SDVAR) D HDR(SDVAR)
152 D MES^XPDUTL(" ")
153 S ECXADMSG="Added: "_$P(SDXX,"^",2)_" "_$P(SDXX,"^")
154 I $P(SDXX,"^",5)'="" S ECXADMSG=ECXADMSG_" [CDR#: "_$P(SDXX,"^",5)_"]"
155 D MES^XPDUTL(ECXADMSG)
156 I $P(SDXX,"^",3)'="" S ECXADMSG=" Restricted Type: "_$P(SDXX,"^",3)_" Restricted Date: "_$P(SDXX,"^",4)
157 D MES^XPDUTL(ECXADMSG)
158 K SDVAR
159 Q
160 ;
161MESSEX ;** Display message if stop code already exists
162 N ECXADMSG
163 I +$G(SDVAR) D HDR(SDVAR)
164 D MES^XPDUTL(" ")
165 S ECXADMSG=" "_$P(SDXX,"^",2)_" "_$P(SDXX,"^")_" already exists."
166 D MES^XPDUTL(ECXADMSG)
167 K SDVAR
168 Q
169 ;
170MESI(SDEXDT) ;** Inactivate message
171 ;
172 ; Parameter:
173 ; SDEXDT - Date inactivation affective (External Format)
174 ;
175 N SDINMSG
176 I +$G(SDVAR) D HDR(SDVAR)
177 I $G(SDEXDT)="" S SDEXDT="UNKNOWN"
178 D MES^XPDUTL(" ")
179 S SDINMSG="Inactivated: "_+SDXX_" "_$P($G(^DIC(40.7,SDDA,0)),"^")_" as of "_SDEXDT
180 D MES^XPDUTL(SDINMSG)
181 K SDVAR
182 Q
183 ;
184MESA ;** Reactivate message
185 ;
186 N SDACMSG
187 I +$G(SDVAR) D HDR(SDVAR)
188 D MES^XPDUTL(" ")
189 S SDACMSG="Reactivated: "_+SDXX_" "_$P($G(^DIC(40.7,SDDA,0)),"^")
190 D MES^XPDUTL(SDACMSG)
191 K SDVAR
192 Q
193 ;
194MESC ;** Change message
195 N SDCMSG,SDCMSG1
196 I +$G(SDVAR) D HDR(SDVAR)
197 D MES^XPDUTL(" ")
198 S SDCMSG="Changed: "_$P(SDXX,U,2)_" "_$P(SDXX,U)
199 S SDCMSG1=" to: "_$P(SDXX,U,2)_" "_$P(SDXX,U,4)
200 D MES^XPDUTL(SDCMSG)
201 D MES^XPDUTL(SDCMSG1)
202 K SDVAR
203 Q
204 ;
205MESN ;** Change number
206 N SDNMSG,SDNMSG1
207 I +$G(SDVAR) D HDR(SDVAR)
208 D MES^XPDUTL(" ")
209 S SDNMSG=" Changed: "_$P(SDXX,U,2)_" "_$P(SDXX,U)
210 S SDNMSG1=" : "_$P(SDXX,U,3)_" Date: "_$P(SDXX,U,5)
211 D MES^XPDUTL(SDNMSG)
212 D MES^XPDUTL(SDNMSG1)
213 K SDVAR
214 Q
215MESR ;** Restricting Stop Code
216 N SDNMSG,SDNMSG1
217 I +$G(SDVAR) D HDR(SDVAR)
218 D MES^XPDUTL(" ")
219 S SDNMSG="Changed: "_$P(SDXX,U,2)_" "_$P(SDXX,U)_" "_$P(SDXX,U,5)_" "_$P(SDXX,U,6)
220 S SDNMSG1=" to: "_$P(SDXX,U,3)_" "_$P(SDXX,U,4)
221 D MES^XPDUTL(SDNMSG)
222 D MES^XPDUTL(SDNMSG1)
223 K SDVAR
224 Q
225 ;
226HDR(SDVAR) ;- Header
227 Q:'$G(SDVAR)
228 N SDHDR
229 S SDHDR=$P($T(@("HDR"_SDVAR)),";;",2)
230 D BMES^XPDUTL(SDHDR)
231 Q
232 ;
233 ;
234HDR1 ;; Stop Code Name
235 ;
236HDR2 ;; CDR Stop Code Name
237 ;
238HDR3 ;; Stop Code Name Rest. Type Date
239 ;
240NEW ;DSS IDs to add- ex ;;STOP CODE NAME^NUMBER^RESTRICTION TYPE^RESTRICTION DATE^CDR
241 ;;CARE/CASE MANAGER^184^S^10/1/2007
242 ;;HEPATOLOGY CLINIC^337^E^
243 ;;SLEEP MEDICINE^349^E^
244 ;;NON-OR ANESTHESIA PROCEDURES^434^P^10/1/2007
245 ;;MH INTEGRATED CARE^534^E^
246 ;;INCARCERATED VETERANS RE-ENTRY^591^E^
247 ;;QUIT
248 ;
249OLD ;DSS IDs to be inactivated- ex. ;;AMIS NUMBER^^INACTIVE DATE
250 ;;122^PUBLIC HEALTH NURSING^10/1/2007
251 ;;578^PSYCHOGERIATRIC DAY PROGRAM^10/1/2007
252 ;;589^NON-ACTIVE DUTY SEXUAL TRAUMA^10/1/2007
253 ;;730^RRTP - GENERAL CARE^10/1/2007
254 ;;731^PRRTP - GENERAL CARE^10/1/2007
255 ;;QUIT
256 ;
257CHNG ;DSS ID name changes- example ;;STOP CODE NAME^NUMBER^^NEW NAME
258 ;;PSYCHIATRY-MD INDIVIDUAL^509^^PSYCHIATRY - INDIVIDUAL
259 ;;INTENSIVE SUBSTANCE ABUSE TRMT^547^^INTENSIVE SUB ABUSE TRMT GRP
260 ;;MENTAL HLT INT CASE MGT(MHICM)^552^^MHICM - INDIVIDUAL
261 ;;PSYCHIATRY - MD GROUP^557^^PSYCHIATRY - GROUP
262 ;;MH PRIMARY CARE TEAM - GROUP^563^^MH PRIMARY CARE - GROUP
263 ;;MHICM GRP MTLHLTH INTSV CS MGT^567^^MHICM - GROUP
264 ;;PSYCHOGERIATRIC CLINIC - GROUP^577^^PSYCHOGERIATRIC - GROUP
265 ;;HOME/COMMUN HEALTHCARE ASSESS^680^^HCBC ASSESSMENT
266 ;;QUIT
267 ;
268CDR ;CDR account change- ex. ;;STOP CODE NAME^NUMBER^CDR # (old)^CDR# (new)
269 ;;QUIT
270 ;
271ACT ;DSS IDs to be reactivated- example ;;NUMBER^
272 ;;QUIT
273 ;
274REST ;Change restriction - ;;STOP CODE NAME^NUMBER^REST TYPE^RES DATE^OLD
275 ;;RVOEC INDIVIDUAL^571^E^^P
276 ;;PSYCHOGERIATRIC - INDIVIDUAL^576^P^10/1/2007^E
277 ;;PSYCHOGERIATRIC - GROUP^577^P^10/1/2007^E
278 ;;QUIT
Note: See TracBrowser for help on using the repository browser.