[1593] | 1 | KIDS Distribution saved on Nov 07, 2012@17:05:19
|
---|
| 2 | FINAL MU STAGE 1 REG BUILD
|
---|
| 3 | **KIDS**:VW MU REG 2.0^
|
---|
| 4 |
|
---|
| 5 | **INSTALL NAME**
|
---|
| 6 | VW MU REG 2.0
|
---|
| 7 | "BLD",7943,0)
|
---|
| 8 | VW MU REG 2.0^^0^3121107^n
|
---|
| 9 | "BLD",7943,1,0)
|
---|
| 10 | ^^10^10^3121107^
|
---|
| 11 | "BLD",7943,1,1,0)
|
---|
| 12 | Created by Sam Habiel. Created on October 4th 2012.
|
---|
| 13 | "BLD",7943,1,2,0)
|
---|
| 14 |
|
---|
| 15 | "BLD",7943,1,3,0)
|
---|
| 16 | License: GPL v2.
|
---|
| 17 | "BLD",7943,1,4,0)
|
---|
| 18 |
|
---|
| 19 | "BLD",7943,1,5,0)
|
---|
| 20 | Description:
|
---|
| 21 | "BLD",7943,1,6,0)
|
---|
| 22 | Adds all MU Registration Fields to WV and changes the registration
|
---|
| 23 | "BLD",7943,1,7,0)
|
---|
| 24 | routines to use them.
|
---|
| 25 | "BLD",7943,1,8,0)
|
---|
| 26 |
|
---|
| 27 | "BLD",7943,1,9,0)
|
---|
| 28 | Full documentation can be found here:
|
---|
| 29 | "BLD",7943,1,10,0)
|
---|
| 30 | http://www.vistapedia.com/index.php/MU_Stage_1_Registration_Enhancements
|
---|
| 31 | "BLD",7943,4,0)
|
---|
| 32 | ^9.64PA^200^2
|
---|
| 33 | "BLD",7943,4,2,0)
|
---|
| 34 | 2
|
---|
| 35 | "BLD",7943,4,2,2,0)
|
---|
| 36 | ^9.641^2.0256001^2
|
---|
| 37 | "BLD",7943,4,2,2,2,0)
|
---|
| 38 | PATIENT (File-top level)
|
---|
| 39 | "BLD",7943,4,2,2,2,1,0)
|
---|
| 40 | ^9.6411^.351^3
|
---|
| 41 | "BLD",7943,4,2,2,2,1,.351,0)
|
---|
| 42 | DATE OF DEATH
|
---|
| 43 | "BLD",7943,4,2,2,2,1,250043.1,0)
|
---|
| 44 | PRELIMINARY CAUSE OF DEATH
|
---|
| 45 | "BLD",7943,4,2,2,2,1,256000,0)
|
---|
| 46 | LANGUAGE PREFERENCE
|
---|
| 47 | "BLD",7943,4,2,2,2.0256001,0)
|
---|
| 48 | LANGUAGE SKILLS (sub-file)
|
---|
| 49 | "BLD",7943,4,2,2,2.0256001,1,0)
|
---|
| 50 | ^9.6411^^0
|
---|
| 51 | "BLD",7943,4,2,222)
|
---|
| 52 | y^n^p^^^^n^^n
|
---|
| 53 | "BLD",7943,4,2,224)
|
---|
| 54 |
|
---|
| 55 | "BLD",7943,4,200,0)
|
---|
| 56 | 200
|
---|
| 57 | "BLD",7943,4,200,2,0)
|
---|
| 58 | ^9.641^200.0256001^2
|
---|
| 59 | "BLD",7943,4,200,2,200,0)
|
---|
| 60 | NEW PERSON (File-top level)
|
---|
| 61 | "BLD",7943,4,200,2,200,1,0)
|
---|
| 62 | ^9.6411^256000^1
|
---|
| 63 | "BLD",7943,4,200,2,200,1,256000,0)
|
---|
| 64 | PREFERRED LANGUAGE
|
---|
| 65 | "BLD",7943,4,200,2,200.0256001,0)
|
---|
| 66 | LANGUAGE SKILLS (sub-file)
|
---|
| 67 | "BLD",7943,4,200,2,200.0256001,1,0)
|
---|
| 68 | ^9.6411^^
|
---|
| 69 | "BLD",7943,4,200,222)
|
---|
| 70 | y^n^p^^^^n^^n
|
---|
| 71 | "BLD",7943,4,200,224)
|
---|
| 72 |
|
---|
| 73 | "BLD",7943,4,"APDD",2,2)
|
---|
| 74 |
|
---|
| 75 | "BLD",7943,4,"APDD",2,2,.351)
|
---|
| 76 |
|
---|
| 77 | "BLD",7943,4,"APDD",2,2,250043.1)
|
---|
| 78 |
|
---|
| 79 | "BLD",7943,4,"APDD",2,2,256000)
|
---|
| 80 |
|
---|
| 81 | "BLD",7943,4,"APDD",2,2.0256001)
|
---|
| 82 |
|
---|
| 83 | "BLD",7943,4,"APDD",200,200)
|
---|
| 84 |
|
---|
| 85 | "BLD",7943,4,"APDD",200,200,256000)
|
---|
| 86 |
|
---|
| 87 | "BLD",7943,4,"APDD",200,200.0256001)
|
---|
| 88 |
|
---|
| 89 | "BLD",7943,4,"B",2,2)
|
---|
| 90 |
|
---|
| 91 | "BLD",7943,4,"B",200,200)
|
---|
| 92 |
|
---|
| 93 | "BLD",7943,6.3)
|
---|
| 94 | 18
|
---|
| 95 | "BLD",7943,"INIT")
|
---|
| 96 | POST^VWREGPI
|
---|
| 97 | "BLD",7943,"KRN",0)
|
---|
| 98 | ^9.67PA^779.2^20
|
---|
| 99 | "BLD",7943,"KRN",.4,0)
|
---|
| 100 | .4
|
---|
| 101 | "BLD",7943,"KRN",.401,0)
|
---|
| 102 | .401
|
---|
| 103 | "BLD",7943,"KRN",.402,0)
|
---|
| 104 | .402
|
---|
| 105 | "BLD",7943,"KRN",.402,"NM",0)
|
---|
| 106 | ^9.68A^2^2
|
---|
| 107 | "BLD",7943,"KRN",.402,"NM",1,0)
|
---|
| 108 | VW LOCAL REGISTRATION TEMPLATE FILE #2^2^0
|
---|
| 109 | "BLD",7943,"KRN",.402,"NM",2,0)
|
---|
| 110 | VW PRELIMINARY CAUSE OF DEATH FILE #2^2^0
|
---|
| 111 | "BLD",7943,"KRN",.402,"NM","B","VW LOCAL REGISTRATION TEMPLATE FILE #2",1)
|
---|
| 112 |
|
---|
| 113 | "BLD",7943,"KRN",.402,"NM","B","VW PRELIMINARY CAUSE OF DEATH FILE #2",2)
|
---|
| 114 |
|
---|
| 115 | "BLD",7943,"KRN",.403,0)
|
---|
| 116 | .403
|
---|
| 117 | "BLD",7943,"KRN",.5,0)
|
---|
| 118 | .5
|
---|
| 119 | "BLD",7943,"KRN",.84,0)
|
---|
| 120 | .84
|
---|
| 121 | "BLD",7943,"KRN",3.6,0)
|
---|
| 122 | 3.6
|
---|
| 123 | "BLD",7943,"KRN",3.8,0)
|
---|
| 124 | 3.8
|
---|
| 125 | "BLD",7943,"KRN",9.2,0)
|
---|
| 126 | 9.2
|
---|
| 127 | "BLD",7943,"KRN",9.8,0)
|
---|
| 128 | 9.8
|
---|
| 129 | "BLD",7943,"KRN",9.8,"NM",0)
|
---|
| 130 | ^9.68A^8^8
|
---|
| 131 | "BLD",7943,"KRN",9.8,"NM",1,0)
|
---|
| 132 | DGREG^^0^B78971450
|
---|
| 133 | "BLD",7943,"KRN",9.8,"NM",2,0)
|
---|
| 134 | DG10^^0^B27855507
|
---|
| 135 | "BLD",7943,"KRN",9.8,"NM",3,0)
|
---|
| 136 | VWUTIL^^0^B42164756
|
---|
| 137 | "BLD",7943,"KRN",9.8,"NM",4,0)
|
---|
| 138 | ORCXPND1^^0^B74010927
|
---|
| 139 | "BLD",7943,"KRN",9.8,"NM",5,0)
|
---|
| 140 | DGRPD^^0^B87299590
|
---|
| 141 | "BLD",7943,"KRN",9.8,"NM",6,0)
|
---|
| 142 | DGDEATH^^0^B43242813
|
---|
| 143 | "BLD",7943,"KRN",9.8,"NM",7,0)
|
---|
| 144 | DGPMV^^0^B19120801
|
---|
| 145 | "BLD",7943,"KRN",9.8,"NM",8,0)
|
---|
| 146 | DGRP2^^0^B19865142
|
---|
| 147 | "BLD",7943,"KRN",9.8,"NM","B","DG10",2)
|
---|
| 148 |
|
---|
| 149 | "BLD",7943,"KRN",9.8,"NM","B","DGDEATH",6)
|
---|
| 150 |
|
---|
| 151 | "BLD",7943,"KRN",9.8,"NM","B","DGPMV",7)
|
---|
| 152 |
|
---|
| 153 | "BLD",7943,"KRN",9.8,"NM","B","DGREG",1)
|
---|
| 154 |
|
---|
| 155 | "BLD",7943,"KRN",9.8,"NM","B","DGRP2",8)
|
---|
| 156 |
|
---|
| 157 | "BLD",7943,"KRN",9.8,"NM","B","DGRPD",5)
|
---|
| 158 |
|
---|
| 159 | "BLD",7943,"KRN",9.8,"NM","B","ORCXPND1",4)
|
---|
| 160 |
|
---|
| 161 | "BLD",7943,"KRN",9.8,"NM","B","VWUTIL",3)
|
---|
| 162 |
|
---|
| 163 | "BLD",7943,"KRN",19,0)
|
---|
| 164 | 19
|
---|
| 165 | "BLD",7943,"KRN",19,"NM",0)
|
---|
| 166 | ^9.68A^2^2
|
---|
| 167 | "BLD",7943,"KRN",19,"NM",1,0)
|
---|
| 168 | VW ENTER PRELIM CAUSE OF DEATH^^0
|
---|
| 169 | "BLD",7943,"KRN",19,"NM",2,0)
|
---|
| 170 | DG BED CONTROL^^2
|
---|
| 171 | "BLD",7943,"KRN",19,"NM","B","DG BED CONTROL",2)
|
---|
| 172 |
|
---|
| 173 | "BLD",7943,"KRN",19,"NM","B","VW ENTER PRELIM CAUSE OF DEATH",1)
|
---|
| 174 |
|
---|
| 175 | "BLD",7943,"KRN",19.1,0)
|
---|
| 176 | 19.1
|
---|
| 177 | "BLD",7943,"KRN",101,0)
|
---|
| 178 | 101
|
---|
| 179 | "BLD",7943,"KRN",409.61,0)
|
---|
| 180 | 409.61
|
---|
| 181 | "BLD",7943,"KRN",771,0)
|
---|
| 182 | 771
|
---|
| 183 | "BLD",7943,"KRN",779.2,0)
|
---|
| 184 | 779.2
|
---|
| 185 | "BLD",7943,"KRN",870,0)
|
---|
| 186 | 870
|
---|
| 187 | "BLD",7943,"KRN",8989.51,0)
|
---|
| 188 | 8989.51
|
---|
| 189 | "BLD",7943,"KRN",8989.52,0)
|
---|
| 190 | 8989.52
|
---|
| 191 | "BLD",7943,"KRN",8994,0)
|
---|
| 192 | 8994
|
---|
| 193 | "BLD",7943,"KRN","B",.4,.4)
|
---|
| 194 |
|
---|
| 195 | "BLD",7943,"KRN","B",.401,.401)
|
---|
| 196 |
|
---|
| 197 | "BLD",7943,"KRN","B",.402,.402)
|
---|
| 198 |
|
---|
| 199 | "BLD",7943,"KRN","B",.403,.403)
|
---|
| 200 |
|
---|
| 201 | "BLD",7943,"KRN","B",.5,.5)
|
---|
| 202 |
|
---|
| 203 | "BLD",7943,"KRN","B",.84,.84)
|
---|
| 204 |
|
---|
| 205 | "BLD",7943,"KRN","B",3.6,3.6)
|
---|
| 206 |
|
---|
| 207 | "BLD",7943,"KRN","B",3.8,3.8)
|
---|
| 208 |
|
---|
| 209 | "BLD",7943,"KRN","B",9.2,9.2)
|
---|
| 210 |
|
---|
| 211 | "BLD",7943,"KRN","B",9.8,9.8)
|
---|
| 212 |
|
---|
| 213 | "BLD",7943,"KRN","B",19,19)
|
---|
| 214 |
|
---|
| 215 | "BLD",7943,"KRN","B",19.1,19.1)
|
---|
| 216 |
|
---|
| 217 | "BLD",7943,"KRN","B",101,101)
|
---|
| 218 |
|
---|
| 219 | "BLD",7943,"KRN","B",409.61,409.61)
|
---|
| 220 |
|
---|
| 221 | "BLD",7943,"KRN","B",771,771)
|
---|
| 222 |
|
---|
| 223 | "BLD",7943,"KRN","B",779.2,779.2)
|
---|
| 224 |
|
---|
| 225 | "BLD",7943,"KRN","B",870,870)
|
---|
| 226 |
|
---|
| 227 | "BLD",7943,"KRN","B",8989.51,8989.51)
|
---|
| 228 |
|
---|
| 229 | "BLD",7943,"KRN","B",8989.52,8989.52)
|
---|
| 230 |
|
---|
| 231 | "BLD",7943,"KRN","B",8994,8994)
|
---|
| 232 |
|
---|
| 233 | "BLD",7943,"PRET")
|
---|
| 234 |
|
---|
| 235 | "BLD",7943,"QUES",0)
|
---|
| 236 | ^9.62^^
|
---|
| 237 | "FIA",2)
|
---|
| 238 | PATIENT
|
---|
| 239 | "FIA",2,0)
|
---|
| 240 | ^DPT(
|
---|
| 241 | "FIA",2,0,0)
|
---|
| 242 | 2I
|
---|
| 243 | "FIA",2,0,1)
|
---|
| 244 | y^n^p^^^^n^^n
|
---|
| 245 | "FIA",2,0,10)
|
---|
| 246 |
|
---|
| 247 | "FIA",2,0,11)
|
---|
| 248 |
|
---|
| 249 | "FIA",2,0,"RLRO")
|
---|
| 250 |
|
---|
| 251 | "FIA",2,2)
|
---|
| 252 | 1
|
---|
| 253 | "FIA",2,2,.351)
|
---|
| 254 |
|
---|
| 255 | "FIA",2,2,250043.1)
|
---|
| 256 |
|
---|
| 257 | "FIA",2,2,256000)
|
---|
| 258 |
|
---|
| 259 | "FIA",2,2,256001)
|
---|
| 260 |
|
---|
| 261 | "FIA",2,2.0256001)
|
---|
| 262 | 0
|
---|
| 263 | "FIA",2,2.250043)
|
---|
| 264 | 0
|
---|
| 265 | "FIA",200)
|
---|
| 266 | NEW PERSON
|
---|
| 267 | "FIA",200,0)
|
---|
| 268 | ^VA(200,
|
---|
| 269 | "FIA",200,0,0)
|
---|
| 270 | 200Is
|
---|
| 271 | "FIA",200,0,1)
|
---|
| 272 | y^n^p^^^^n^^n
|
---|
| 273 | "FIA",200,0,10)
|
---|
| 274 |
|
---|
| 275 | "FIA",200,0,11)
|
---|
| 276 |
|
---|
| 277 | "FIA",200,0,"RLRO")
|
---|
| 278 |
|
---|
| 279 | "FIA",200,200)
|
---|
| 280 | 1
|
---|
| 281 | "FIA",200,200,256000)
|
---|
| 282 |
|
---|
| 283 | "FIA",200,200,256001)
|
---|
| 284 |
|
---|
| 285 | "FIA",200,200.0256001)
|
---|
| 286 | 0
|
---|
| 287 | "INIT")
|
---|
| 288 | POST^VWREGPI
|
---|
| 289 | "IX",2,2,"ADGFM351",0)
|
---|
| 290 | 2^ADGFM351^This x-ref calls the DG FIELD MONITOR event point.^MU^^F^I^I^2^^^^^A
|
---|
| 291 | "IX",2,2,"ADGFM351",.1,0)
|
---|
| 292 | ^^5^5^3020624
|
---|
| 293 | "IX",2,2,"ADGFM351",.1,1,0)
|
---|
| 294 | This cross reference activates the DG FIELD MONITOR event point.
|
---|
| 295 | "IX",2,2,"ADGFM351",.1,2,0)
|
---|
| 296 | Applications that wish to monitor edit activity related to this field may
|
---|
| 297 | "IX",2,2,"ADGFM351",.1,3,0)
|
---|
| 298 | subscribe to that event point and take action as indicated by the changes
|
---|
| 299 | "IX",2,2,"ADGFM351",.1,4,0)
|
---|
| 300 | that occur. Refer to the DG FIELD MONITOR protocol for a description of
|
---|
| 301 | "IX",2,2,"ADGFM351",.1,5,0)
|
---|
| 302 | the information available at the time of the event.
|
---|
| 303 | "IX",2,2,"ADGFM351",1)
|
---|
| 304 | D FC^DGFCPROT(.DA,2,.351,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
|
---|
| 305 | "IX",2,2,"ADGFM351",2)
|
---|
| 306 | D FC^DGFCPROT(.DA,2,.351,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
|
---|
| 307 | "IX",2,2,"ADGFM351",11.1,0)
|
---|
| 308 | ^.114IA^1^1
|
---|
| 309 | "IX",2,2,"ADGFM351",11.1,1,0)
|
---|
| 310 | 1^F^2^.351^^^F
|
---|
| 311 | "IX",2,2,"ADGFMD351",0)
|
---|
| 312 | 2^ADGFMD351^This x-ref calls the DG FIELD MONITOR event point.^MU^^F^I^I^2^^^^^A
|
---|
| 313 | "IX",2,2,"ADGFMD351",.1,0)
|
---|
| 314 | ^^5^5^3020820
|
---|
| 315 | "IX",2,2,"ADGFMD351",.1,1,0)
|
---|
| 316 | This cross reference activates the DG FIELD MONITOR event point.
|
---|
| 317 | "IX",2,2,"ADGFMD351",.1,2,0)
|
---|
| 318 | Applications that wish to monitor edit activity related to this field may
|
---|
| 319 | "IX",2,2,"ADGFMD351",.1,3,0)
|
---|
| 320 | subscribe to that event point and take action as indicated by the changes
|
---|
| 321 | "IX",2,2,"ADGFMD351",.1,4,0)
|
---|
| 322 | that occur. Refer to the DG FIELD MONITOR protocol for a description of
|
---|
| 323 | "IX",2,2,"ADGFMD351",.1,5,0)
|
---|
| 324 | the information available at the time of the event.
|
---|
| 325 | "IX",2,2,"ADGFMD351",1)
|
---|
| 326 | D FC^DGFCPROT(.DA,2,.351,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
|
---|
| 327 | "IX",2,2,"ADGFMD351",2)
|
---|
| 328 | D FC^DGFCPROT(.DA,2,.351,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
|
---|
| 329 | "IX",2,2,"ADGFMD351",11.1,0)
|
---|
| 330 | ^.114IA^1^1
|
---|
| 331 | "IX",2,2,"ADGFMD351",11.1,1,0)
|
---|
| 332 | 1^F^2^.351^^^F
|
---|
| 333 | "KRN",.402,1733,-1)
|
---|
| 334 | 0^1
|
---|
| 335 | "KRN",.402,1733,0)
|
---|
| 336 | VW LOCAL REGISTRATION TEMPLATE^3121105.0927^@^2^^@^3121107
|
---|
| 337 | "KRN",.402,1733,"DIAB",1,1,2.019906,0)
|
---|
| 338 | ALL
|
---|
| 339 | "KRN",.402,1733,"DR",1,2)
|
---|
| 340 | W !,"Please Answer these questions";256000;19906;
|
---|
| 341 | "KRN",.402,1733,"DR",2,2.019906)
|
---|
| 342 | .01
|
---|
| 343 | "KRN",.402,1749,-1)
|
---|
| 344 | 0^2
|
---|
| 345 | "KRN",.402,1749,0)
|
---|
| 346 | VW PRELIMINARY CAUSE OF DEATH^3121106.1458^^2^^^3121107
|
---|
| 347 | "KRN",.402,1749,"DR",1,2)
|
---|
| 348 | I '+$G(^DPT(D0,.35)) W !,"Date of Death not entered. Quitting.",! S Y="@999";250043.1;@999;
|
---|
| 349 | "KRN",19,1893,-1)
|
---|
| 350 | 2^2
|
---|
| 351 | "KRN",19,1893,0)
|
---|
| 352 | DG BED CONTROL^Bed Control Menu^^M^.5^^^^^^^47^y
|
---|
| 353 | "KRN",19,1893,10,0)
|
---|
| 354 | ^19.01IP^18^17
|
---|
| 355 | "KRN",19,1893,10,18,0)
|
---|
| 356 | 11084
|
---|
| 357 | "KRN",19,1893,10,18,"^")
|
---|
| 358 | VW ENTER PRELIM CAUSE OF DEATH
|
---|
| 359 | "KRN",19,1893,"U")
|
---|
| 360 | BED CONTROL MENU
|
---|
| 361 | "KRN",19,11084,-1)
|
---|
| 362 | 0^1
|
---|
| 363 | "KRN",19,11084,0)
|
---|
| 364 | VW ENTER PRELIM CAUSE OF DEATH^Enter preliminary cause of death for a patient^^E^^^^^^^^
|
---|
| 365 | "KRN",19,11084,1,0)
|
---|
| 366 | ^^6^6^3121106^
|
---|
| 367 | "KRN",19,11084,1,1,0)
|
---|
| 368 | This option allows you to enter/edit a preliminary cause of death for a
|
---|
| 369 | "KRN",19,11084,1,2,0)
|
---|
| 370 | patient. This is especially useful if the patient was discharged to DEATH
|
---|
| 371 | "KRN",19,11084,1,3,0)
|
---|
| 372 | and the death date was filled automatically.
|
---|
| 373 | "KRN",19,11084,1,4,0)
|
---|
| 374 |
|
---|
| 375 | "KRN",19,11084,1,5,0)
|
---|
| 376 | 'Death Entry' will allow you to enter the preliminary cause of death for
|
---|
| 377 | "KRN",19,11084,1,6,0)
|
---|
| 378 | a patient as well.
|
---|
| 379 | "KRN",19,11084,30)
|
---|
| 380 | DPT(
|
---|
| 381 | "KRN",19,11084,31)
|
---|
| 382 | AEMQ
|
---|
| 383 | "KRN",19,11084,50)
|
---|
| 384 | DPT(
|
---|
| 385 | "KRN",19,11084,51)
|
---|
| 386 | [VW PRELIMINARY CAUSE OF DEATH]
|
---|
| 387 | "KRN",19,11084,"U")
|
---|
| 388 | ENTER PRELIMINARY CAUSE OF DEA
|
---|
| 389 | "MBREQ")
|
---|
| 390 | 0
|
---|
| 391 | "ORD",7,.402)
|
---|
| 392 | .402;7;;;EDEOUT^DIFROMSO(.402,DA,"",XPDA);FPRE^DIFROMSI(.402,"",XPDA);EPRE^DIFROMSI(.402,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.402,DA,"",XPDA);DEL^DIFROMSK(.402,"",%)
|
---|
| 393 | "ORD",7,.402,0)
|
---|
| 394 | INPUT TEMPLATE
|
---|
| 395 | "ORD",18,19)
|
---|
| 396 | 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA
|
---|
| 397 | "ORD",18,19,0)
|
---|
| 398 | OPTION
|
---|
| 399 | "QUES","XPF1",0)
|
---|
| 400 | Y
|
---|
| 401 | "QUES","XPF1","??")
|
---|
| 402 | ^D REP^XPDH
|
---|
| 403 | "QUES","XPF1","A")
|
---|
| 404 | Shall I write over your |FLAG| File
|
---|
| 405 | "QUES","XPF1","B")
|
---|
| 406 | YES
|
---|
| 407 | "QUES","XPF1","M")
|
---|
| 408 | D XPF1^XPDIQ
|
---|
| 409 | "QUES","XPF2",0)
|
---|
| 410 | Y
|
---|
| 411 | "QUES","XPF2","??")
|
---|
| 412 | ^D DTA^XPDH
|
---|
| 413 | "QUES","XPF2","A")
|
---|
| 414 | Want my data |FLAG| yours
|
---|
| 415 | "QUES","XPF2","B")
|
---|
| 416 | YES
|
---|
| 417 | "QUES","XPF2","M")
|
---|
| 418 | D XPF2^XPDIQ
|
---|
| 419 | "QUES","XPI1",0)
|
---|
| 420 | YO
|
---|
| 421 | "QUES","XPI1","??")
|
---|
| 422 | ^D INHIBIT^XPDH
|
---|
| 423 | "QUES","XPI1","A")
|
---|
| 424 | Want KIDS to INHIBIT LOGONs during the install
|
---|
| 425 | "QUES","XPI1","B")
|
---|
| 426 | NO
|
---|
| 427 | "QUES","XPI1","M")
|
---|
| 428 | D XPI1^XPDIQ
|
---|
| 429 | "QUES","XPM1",0)
|
---|
| 430 | PO^VA(200,:EM
|
---|
| 431 | "QUES","XPM1","??")
|
---|
| 432 | ^D MG^XPDH
|
---|
| 433 | "QUES","XPM1","A")
|
---|
| 434 | Enter the Coordinator for Mail Group '|FLAG|'
|
---|
| 435 | "QUES","XPM1","B")
|
---|
| 436 |
|
---|
| 437 | "QUES","XPM1","M")
|
---|
| 438 | D XPM1^XPDIQ
|
---|
| 439 | "QUES","XPO1",0)
|
---|
| 440 | Y
|
---|
| 441 | "QUES","XPO1","??")
|
---|
| 442 | ^D MENU^XPDH
|
---|
| 443 | "QUES","XPO1","A")
|
---|
| 444 | Want KIDS to Rebuild Menu Trees Upon Completion of Install
|
---|
| 445 | "QUES","XPO1","B")
|
---|
| 446 | NO
|
---|
| 447 | "QUES","XPO1","M")
|
---|
| 448 | D XPO1^XPDIQ
|
---|
| 449 | "QUES","XPZ1",0)
|
---|
| 450 | Y
|
---|
| 451 | "QUES","XPZ1","??")
|
---|
| 452 | ^D OPT^XPDH
|
---|
| 453 | "QUES","XPZ1","A")
|
---|
| 454 | Want to DISABLE Scheduled Options, Menu Options, and Protocols
|
---|
| 455 | "QUES","XPZ1","B")
|
---|
| 456 | NO
|
---|
| 457 | "QUES","XPZ1","M")
|
---|
| 458 | D XPZ1^XPDIQ
|
---|
| 459 | "QUES","XPZ2",0)
|
---|
| 460 | Y
|
---|
| 461 | "QUES","XPZ2","??")
|
---|
| 462 | ^D RTN^XPDH
|
---|
| 463 | "QUES","XPZ2","A")
|
---|
| 464 | Want to MOVE routines to other CPUs
|
---|
| 465 | "QUES","XPZ2","B")
|
---|
| 466 | NO
|
---|
| 467 | "QUES","XPZ2","M")
|
---|
| 468 | D XPZ2^XPDIQ
|
---|
| 469 | "RTN")
|
---|
| 470 | 9
|
---|
| 471 | "RTN","DG10")
|
---|
| 472 | 0^2^B27855507
|
---|
| 473 | "RTN","DG10",1,0)
|
---|
| 474 | DG10 ;ALB/MRL,DAK,AEG,PHH-LOAD/EDIT PATIENT DATA ; 11/5/12 12:58pm
|
---|
| 475 | "RTN","DG10",2,0)
|
---|
| 476 | ;;5.3;Registration;**32,109,139,149,182,326,513,425,574,642,658,634**;Aug 13, 1993;Build 18
|
---|
| 477 | "RTN","DG10",3,0)
|
---|
| 478 | ; Modified from FOIA VISTA,
|
---|
| 479 | "RTN","DG10",4,0)
|
---|
| 480 | ; Copyright (C) 2007 WorldVistA
|
---|
| 481 | "RTN","DG10",5,0)
|
---|
| 482 | ;
|
---|
| 483 | "RTN","DG10",6,0)
|
---|
| 484 | ; This program is free software; you can redistribute it and/or modify
|
---|
| 485 | "RTN","DG10",7,0)
|
---|
| 486 | ; it under the terms of the GNU General Public License as published by
|
---|
| 487 | "RTN","DG10",8,0)
|
---|
| 488 | ; the Free Software Foundation; either version 2 of the License, or
|
---|
| 489 | "RTN","DG10",9,0)
|
---|
| 490 | ; (at your option) any later version.
|
---|
| 491 | "RTN","DG10",10,0)
|
---|
| 492 | ;
|
---|
| 493 | "RTN","DG10",11,0)
|
---|
| 494 | ; This program is distributed in the hope that it will be useful,
|
---|
| 495 | "RTN","DG10",12,0)
|
---|
| 496 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
---|
| 497 | "RTN","DG10",13,0)
|
---|
| 498 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
---|
| 499 | "RTN","DG10",14,0)
|
---|
| 500 | ; GNU General Public License for more details.
|
---|
| 501 | "RTN","DG10",15,0)
|
---|
| 502 | ;
|
---|
| 503 | "RTN","DG10",16,0)
|
---|
| 504 | ; You should have received a copy of the GNU General Public License
|
---|
| 505 | "RTN","DG10",17,0)
|
---|
| 506 | ; along with this program; if not, write to the Free Software
|
---|
| 507 | "RTN","DG10",18,0)
|
---|
| 508 | ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
|
---|
| 509 | "RTN","DG10",19,0)
|
---|
| 510 | START ;
|
---|
| 511 | "RTN","DG10",20,0)
|
---|
| 512 | D LO^DGUTL
|
---|
| 513 | "RTN","DG10",21,0)
|
---|
| 514 | I $G(DGPRFLG)=1,$G(DGPLOC)=1 D G Q:$G(DGRPOUT),A1
|
---|
| 515 | "RTN","DG10",22,0)
|
---|
| 516 | .; D EN^DGRPD,REG^IVMCQ($G(DFN))
|
---|
| 517 | "RTN","DG10",23,0)
|
---|
| 518 | . D EN^DGRPD
|
---|
| 519 | "RTN","DG10",24,0)
|
---|
| 520 | . Q:$G(DGRPOUT)
|
---|
| 521 | "RTN","DG10",25,0)
|
---|
| 522 | . ;
|
---|
| 523 | "RTN","DG10",26,0)
|
---|
| 524 | . ; ** start of VOE change 1 of 3: DAOU/WCJ,VA/CJS,WV/TOAD 1/5/2006 **
|
---|
| 525 | "RTN","DG10",27,0)
|
---|
| 526 | . ;
|
---|
| 527 | "RTN","DG10",28,0)
|
---|
| 528 | . ; HEC query call only wanted/needed for VA agency code
|
---|
| 529 | "RTN","DG10",29,0)
|
---|
| 530 | . ;
|
---|
| 531 | "RTN","DG10",30,0)
|
---|
| 532 | . I $G(DUZ("AG"))="V" D REG^IVMCQ($G(DFN))
|
---|
| 533 | "RTN","DG10",31,0)
|
---|
| 534 | . ;
|
---|
| 535 | "RTN","DG10",32,0)
|
---|
| 536 | . ; ** end of VOE change 1 **
|
---|
| 537 | "RTN","DG10",33,0)
|
---|
| 538 | . ;
|
---|
| 539 | "RTN","DG10",34,0)
|
---|
| 540 | . D HINQ
|
---|
| 541 | "RTN","DG10",35,0)
|
---|
| 542 | ;
|
---|
| 543 | "RTN","DG10",36,0)
|
---|
| 544 | A W !! K VET,DIE,DIC,CARD S DIC=2,DLAYGO=2,DIC(0)="ALEQM" K DIC("S") D ^DIC G Q:Y<0 S (DFN,DA)=+Y,DGNEW=$P(Y,"^",3) K DLAYGO
|
---|
| 545 | "RTN","DG10",37,0)
|
---|
| 546 | ;
|
---|
| 547 | "RTN","DG10",38,0)
|
---|
| 548 | D REGMU^VWUTIL ; Changes for Meaningful Use
|
---|
| 549 | "RTN","DG10",39,0)
|
---|
| 550 | ;
|
---|
| 551 | "RTN","DG10",40,0)
|
---|
| 552 | N Y D PAUSE I DGNEW D NEW^DGRP S DA=DFN,VET=$S($D(^DPT(DFN,"VET")):^("VET")'="Y",1:0)
|
---|
| 553 | "RTN","DG10",41,0)
|
---|
| 554 | ;
|
---|
| 555 | "RTN","DG10",42,0)
|
---|
| 556 | ;MPI QUERY
|
---|
| 557 | "RTN","DG10",43,0)
|
---|
| 558 | ;check to see if CIRN PD/MPI is installed
|
---|
| 559 | "RTN","DG10",44,0)
|
---|
| 560 | N X S X="MPIFAPI" X ^%ZOSF("TEST") G:'$T SKIP
|
---|
| 561 | "RTN","DG10",45,0)
|
---|
| 562 | K MPIFRTN
|
---|
| 563 | "RTN","DG10",46,0)
|
---|
| 564 | ;
|
---|
| 565 | "RTN","DG10",47,0)
|
---|
| 566 | ; ** start of VOE change 2 of 3: DAOU/WCJ,VA/CJS,WV/TOAD 1/5/2006 **
|
---|
| 567 | "RTN","DG10",48,0)
|
---|
| 568 | ;
|
---|
| 569 | "RTN","DG10",49,0)
|
---|
| 570 | ; MPI query call only wanted/needed for VA agency code
|
---|
| 571 | "RTN","DG10",50,0)
|
---|
| 572 | ;
|
---|
| 573 | "RTN","DG10",51,0)
|
---|
| 574 | I $G(DUZ("AG"))="V"!$$GET^XPAR("SYS","DG MPI") D MPIQ^MPIFAPI(DFN)
|
---|
| 575 | "RTN","DG10",52,0)
|
---|
| 576 | ;
|
---|
| 577 | "RTN","DG10",53,0)
|
---|
| 578 | ; ** end of VOE change 2 **
|
---|
| 579 | "RTN","DG10",54,0)
|
---|
| 580 | ;
|
---|
| 581 | "RTN","DG10",55,0)
|
---|
| 582 | K MPIFRTN
|
---|
| 583 | "RTN","DG10",56,0)
|
---|
| 584 | ;
|
---|
| 585 | "RTN","DG10",57,0)
|
---|
| 586 | I +$G(DGNEW) D
|
---|
| 587 | "RTN","DG10",58,0)
|
---|
| 588 | . ; query CMOR for Patient Record Flag Assignments if NEW patient and
|
---|
| 589 | "RTN","DG10",59,0)
|
---|
| 590 | . ; display results
|
---|
| 591 | "RTN","DG10",60,0)
|
---|
| 592 | . I $$PRFQRY^DGPFAPI(DFN) D DISPPRF^DGPFAPI(DFN)
|
---|
| 593 | "RTN","DG10",61,0)
|
---|
| 594 | ;
|
---|
| 595 | "RTN","DG10",62,0)
|
---|
| 596 | SKIP ;
|
---|
| 597 | "RTN","DG10",63,0)
|
---|
| 598 | S DGELVER=0 D EN^DGRPD I $D(DGRPOUT) K DGRPOUT G A
|
---|
| 599 | "RTN","DG10",64,0)
|
---|
| 600 | ;
|
---|
| 601 | "RTN","DG10",65,0)
|
---|
| 602 | ; ** start of VOE change 3 of 3: DAOU/WCJ,VA/CJS,WV/TOAD 1/5/2006 **
|
---|
| 603 | "RTN","DG10",66,0)
|
---|
| 604 | ;
|
---|
| 605 | "RTN","DG10",67,0)
|
---|
| 606 | ; these query calls only wanted/needed for VA agency code
|
---|
| 607 | "RTN","DG10",68,0)
|
---|
| 608 | ;
|
---|
| 609 | "RTN","DG10",69,0)
|
---|
| 610 | I $G(DUZ("AG"))="V" D HINQ,REG^IVMCQ($G(DFN))
|
---|
| 611 | "RTN","DG10",70,0)
|
---|
| 612 | G A1
|
---|
| 613 | "RTN","DG10",71,0)
|
---|
| 614 | ;
|
---|
| 615 | "RTN","DG10",72,0)
|
---|
| 616 | ; ** end of VOE change 3 **
|
---|
| 617 | "RTN","DG10",73,0)
|
---|
| 618 | ;
|
---|
| 619 | "RTN","DG10",74,0)
|
---|
| 620 | ;
|
---|
| 621 | "RTN","DG10",75,0)
|
---|
| 622 | HINQ ;
|
---|
| 623 | "RTN","DG10",76,0)
|
---|
| 624 | S Y=$S($D(^DG(43,1,0)):^(0),1:0) I $P(Y,U,27) S X="DVBHQZ4" X ^%ZOSF("TEST") I $T D
|
---|
| 625 | "RTN","DG10",77,0)
|
---|
| 626 | .N DGROUT
|
---|
| 627 | "RTN","DG10",78,0)
|
---|
| 628 | .S DGROUT=X
|
---|
| 629 | "RTN","DG10",79,0)
|
---|
| 630 | .I $G(DFN) D
|
---|
| 631 | "RTN","DG10",80,0)
|
---|
| 632 | ..N X,Y,DGRP
|
---|
| 633 | "RTN","DG10",81,0)
|
---|
| 634 | ..F X=.3,.32 S DGRP(X)=$G(^DPT(DFN,X))
|
---|
| 635 | "RTN","DG10",82,0)
|
---|
| 636 | ..W !," Money Verified: " S Y=$P(DGRP(.3),"^",6) X:Y]"" ^DD("DD") W $S(Y]"":Y,1:"NOT VERIFIED")
|
---|
| 637 | "RTN","DG10",83,0)
|
---|
| 638 | ..W ?40," Service Verified: " S Y=$P(DGRP(.32),"^",2) X:Y]"" ^DD("DD") W $S(Y]"":Y,1:"NOT VERIFIED")
|
---|
| 639 | "RTN","DG10",84,0)
|
---|
| 640 | .D @("EN^"_DGROUT) K Y Q ;from dgdem0
|
---|
| 641 | "RTN","DG10",85,0)
|
---|
| 642 | Q
|
---|
| 643 | "RTN","DG10",86,0)
|
---|
| 644 | ;
|
---|
| 645 | "RTN","DG10",87,0)
|
---|
| 646 | ; SDIEMM is used as a flag by AMBCARE Incomplete Encounter Management
|
---|
| 647 | "RTN","DG10",88,0)
|
---|
| 648 | ; to bypass the embossing routines when calling load/edit from IEMM
|
---|
| 649 | "RTN","DG10",89,0)
|
---|
| 650 | ;
|
---|
| 651 | "RTN","DG10",90,0)
|
---|
| 652 | A1 D G H:'%,CK:%'=1 S DGRPV=0 D EN1^DGRP,MT(DFN),CP G Q:$G(DGPRFLG)=1 G Q:$G(SDIEMM) G Q:'$D(DA),EMBOS
|
---|
| 653 | "RTN","DG10",91,0)
|
---|
| 654 | .W !,"Do you want to ",$S(DGNEW:"enter",1:"edit")," Patient Data"
|
---|
| 655 | "RTN","DG10",92,0)
|
---|
| 656 | .S %=1 D YN^DICN
|
---|
| 657 | "RTN","DG10",93,0)
|
---|
| 658 | .I +$G(DGNEW) Q
|
---|
| 659 | "RTN","DG10",94,0)
|
---|
| 660 | .I $$ADD^DGADDUTL($G(DFN)) ;
|
---|
| 661 | "RTN","DG10",95,0)
|
---|
| 662 | ;
|
---|
| 663 | "RTN","DG10",96,0)
|
---|
| 664 | H W !?5,"Enter 'YES' to enter/edit registration data or 'NO' to continue without",!?5,"editing."
|
---|
| 665 | "RTN","DG10",97,0)
|
---|
| 666 | G A1
|
---|
| 667 | "RTN","DG10",98,0)
|
---|
| 668 | ;
|
---|
| 669 | "RTN","DG10",99,0)
|
---|
| 670 | CK S DGEDCN=1 D ^DGRPC,MT(DFN),CP
|
---|
| 671 | "RTN","DG10",100,0)
|
---|
| 672 | G Q:$G(DGPRFLG)=1 G Q:$G(SDIEMM)
|
---|
| 673 | "RTN","DG10",101,0)
|
---|
| 674 | I $G(DGER)[55 K DIR S DIR(0)="Y",DIR("A")="Do you wish to return to Screen #9 to enter missing Income Data? " D ^DIR K DIR
|
---|
| 675 | "RTN","DG10",102,0)
|
---|
| 676 | ;G:Y ^DGRP9
|
---|
| 677 | "RTN","DG10",103,0)
|
---|
| 678 | ;
|
---|
| 679 | "RTN","DG10",104,0)
|
---|
| 680 | EMBOS ;W ! D EMBOS^DGQEMA G A
|
---|
| 681 | "RTN","DG10",105,0)
|
---|
| 682 | G A
|
---|
| 683 | "RTN","DG10",106,0)
|
---|
| 684 | ;
|
---|
| 685 | "RTN","DG10",107,0)
|
---|
| 686 | ;
|
---|
| 687 | "RTN","DG10",108,0)
|
---|
| 688 | Q K X,Y,Z,DIC,DGELVER,DGNEW,DGRPV,VET Q
|
---|
| 689 | "RTN","DG10",109,0)
|
---|
| 690 | ;
|
---|
| 691 | "RTN","DG10",110,0)
|
---|
| 692 | MT(DFN) ; Check if user requires a means test. Ask user if they want to proceedif
|
---|
| 693 | "RTN","DG10",111,0)
|
---|
| 694 | ; one is required
|
---|
| 695 | "RTN","DG10",112,0)
|
---|
| 696 | I '$D(SDIEMM) DO
|
---|
| 697 | "RTN","DG10",113,0)
|
---|
| 698 | .N DGREQF,DIV
|
---|
| 699 | "RTN","DG10",114,0)
|
---|
| 700 | .D EN^DGMTR
|
---|
| 701 | "RTN","DG10",115,0)
|
---|
| 702 | .I DGREQF D EDT^DGMTU(DFN,DT):$P($$MTS^DGMTU(DFN),U,2)="R"
|
---|
| 703 | "RTN","DG10",116,0)
|
---|
| 704 | .Q
|
---|
| 705 | "RTN","DG10",117,0)
|
---|
| 706 | I $D(SDIEMM) DO
|
---|
| 707 | "RTN","DG10",118,0)
|
---|
| 708 | .N DGMTI
|
---|
| 709 | "RTN","DG10",119,0)
|
---|
| 710 | .S DGMTI=$$LST^DGMTU(DFN,SCINF("ENCOUNTER"),1)
|
---|
| 711 | "RTN","DG10",120,0)
|
---|
| 712 | .I $P(DGMTI,U,4)="R" D I 1
|
---|
| 713 | "RTN","DG10",121,0)
|
---|
| 714 | ..S DGMT0=$G(^DGMT(408.31,+DGMTI,0)),DGMTDT=$P(DGMT0,"^")
|
---|
| 715 | "RTN","DG10",122,0)
|
---|
| 716 | ..I '$$OKTOCONT(DGMTDT) Q
|
---|
| 717 | "RTN","DG10",123,0)
|
---|
| 718 | ..S DGMTI=+DGMTI,DGMTYPT=1,DGMTACT="COM",DGMTROU="COM^DGMTEO" D EN^DGMTSC
|
---|
| 719 | "RTN","DG10",124,0)
|
---|
| 720 | .E D WARNING
|
---|
| 721 | "RTN","DG10",125,0)
|
---|
| 722 | .Q
|
---|
| 723 | "RTN","DG10",126,0)
|
---|
| 724 | Q
|
---|
| 725 | "RTN","DG10",127,0)
|
---|
| 726 | ;
|
---|
| 727 | "RTN","DG10",128,0)
|
---|
| 728 | WARNING ;
|
---|
| 729 | "RTN","DG10",129,0)
|
---|
| 730 | ;prints a warning to the screen about means test
|
---|
| 731 | "RTN","DG10",130,0)
|
---|
| 732 | ;
|
---|
| 733 | "RTN","DG10",131,0)
|
---|
| 734 | W !!,"A means test for this encounter date was not found and may be required!"
|
---|
| 735 | "RTN","DG10",132,0)
|
---|
| 736 | W !,"Further investigation will be needed."
|
---|
| 737 | "RTN","DG10",133,0)
|
---|
| 738 | W !
|
---|
| 739 | "RTN","DG10",134,0)
|
---|
| 740 | D PAUSE
|
---|
| 741 | "RTN","DG10",135,0)
|
---|
| 742 | Q
|
---|
| 743 | "RTN","DG10",136,0)
|
---|
| 744 | ;
|
---|
| 745 | "RTN","DG10",137,0)
|
---|
| 746 | PAUSE ;
|
---|
| 747 | "RTN","DG10",138,0)
|
---|
| 748 | N DIR
|
---|
| 749 | "RTN","DG10",139,0)
|
---|
| 750 | S DIR(0)="FAO",DIR("A")="Press ENTER to continue " D ^DIR
|
---|
| 751 | "RTN","DG10",140,0)
|
---|
| 752 | Q
|
---|
| 753 | "RTN","DG10",141,0)
|
---|
| 754 | ;
|
---|
| 755 | "RTN","DG10",142,0)
|
---|
| 756 | OKTOCONT(Y) ;
|
---|
| 757 | "RTN","DG10",143,0)
|
---|
| 758 | ;
|
---|
| 759 | "RTN","DG10",144,0)
|
---|
| 760 | N DIR
|
---|
| 761 | "RTN","DG10",145,0)
|
---|
| 762 | W !!,"Patient Requires a means Test"
|
---|
| 763 | "RTN","DG10",146,0)
|
---|
| 764 | X ^DD("DD")
|
---|
| 765 | "RTN","DG10",147,0)
|
---|
| 766 | W !,"Primary Means Test Required from '",Y,"'",!
|
---|
| 767 | "RTN","DG10",148,0)
|
---|
| 768 | ;
|
---|
| 769 | "RTN","DG10",149,0)
|
---|
| 770 | I $D(SDIEMM),'$D(^XUSEC("SCENI MEANS TEST EDIT",DUZ)) DO G OKQ
|
---|
| 771 | "RTN","DG10",150,0)
|
---|
| 772 | .W !,$C(7),"You do not have the appropriate IEMM Security Key. Contact your supervisor.",!
|
---|
| 773 | "RTN","DG10",151,0)
|
---|
| 774 | .D PAUSE
|
---|
| 775 | "RTN","DG10",152,0)
|
---|
| 776 | .S Y=0
|
---|
| 777 | "RTN","DG10",153,0)
|
---|
| 778 | ;
|
---|
| 779 | "RTN","DG10",154,0)
|
---|
| 780 | S DIR("A")="Do you wish to proceed with the means test at this time"
|
---|
| 781 | "RTN","DG10",155,0)
|
---|
| 782 | S DIR("B")="YES"
|
---|
| 783 | "RTN","DG10",156,0)
|
---|
| 784 | S DIR(0)="Y"
|
---|
| 785 | "RTN","DG10",157,0)
|
---|
| 786 | D ^DIR
|
---|
| 787 | "RTN","DG10",158,0)
|
---|
| 788 | OKQ Q $S(Y=1:1,1:0)
|
---|
| 789 | "RTN","DG10",159,0)
|
---|
| 790 | ;
|
---|
| 791 | "RTN","DG10",160,0)
|
---|
| 792 | CP ;If not (autoexempt or MTested) & no CP test this year then
|
---|
| 793 | "RTN","DG10",161,0)
|
---|
| 794 | ;prompt for add/edit cp test
|
---|
| 795 | "RTN","DG10",162,0)
|
---|
| 796 | N DIV,DGIB,DGIBDT,DGX,X,DIRUT,DTOUT
|
---|
| 797 | "RTN","DG10",163,0)
|
---|
| 798 | G:'$P($G(^DG(43,1,0)),U,41) QTCP ;USE CP FLAG
|
---|
| 799 | "RTN","DG10",164,0)
|
---|
| 800 | S DGIBDT=$S($D(DFN1):9999999-DFN1,1:DT)
|
---|
| 801 | "RTN","DG10",165,0)
|
---|
| 802 | D EN^DGMTCOR
|
---|
| 803 | "RTN","DG10",166,0)
|
---|
| 804 | I +$G(DGNOCOPF) S DGMTCOR=0
|
---|
| 805 | "RTN","DG10",167,0)
|
---|
| 806 | I DGMTCOR D THRESH^DGMTCOU1(DGIBDT) D EDT^DGMTCOU(DFN,DT)
|
---|
| 807 | "RTN","DG10",168,0)
|
---|
| 808 | K DGNOCOPF
|
---|
| 809 | "RTN","DG10",169,0)
|
---|
| 810 | QTCP Q
|
---|
| 811 | "RTN","DGDEATH")
|
---|
| 812 | 0^6^B43242813
|
---|
| 813 | "RTN","DGDEATH",1,0)
|
---|
| 814 | DGDEATH ;ALB/MRL/PJR-PROCESS DECEASED PATIENTS ; 11/7/12 11:49am
|
---|
| 815 | "RTN","DGDEATH",2,0)
|
---|
| 816 | ;;5.3;Registration;**45,84,101,149,392,545,595,568,563,725,772,VW1**;Aug 13, 1993;Build 18
|
---|
| 817 | "RTN","DGDEATH",3,0)
|
---|
| 818 | ;
|
---|
| 819 | "RTN","DGDEATH",4,0)
|
---|
| 820 | ; Change History
|
---|
| 821 | "RTN","DGDEATH",5,0)
|
---|
| 822 | ; VW1 3121105: GET+7: added preliminary cause of death field to input template.
|
---|
| 823 | "RTN","DGDEATH",6,0)
|
---|
| 824 | ;
|
---|
| 825 | "RTN","DGDEATH",7,0)
|
---|
| 826 | GET N DGMTI,DATA
|
---|
| 827 | "RTN","DGDEATH",8,0)
|
---|
| 828 | S DGDTHEN="" W !! S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC G Q:Y'>0 S (DA,DFN)=+Y
|
---|
| 829 | "RTN","DGDEATH",9,0)
|
---|
| 830 | S DGDOLD=$G(^DPT(DFN,.35))
|
---|
| 831 | "RTN","DGDEATH",10,0)
|
---|
| 832 | I $D(^DPT(DFN,.1)) W !?3,"Patient is currently in-house. Discharge him with a discharge type of DEATH." G GET
|
---|
| 833 | "RTN","DGDEATH",11,0)
|
---|
| 834 | I $S($D(^DPT(DFN,.35)):^(.35),1:"") F DGY=0:0 S DGY=$O(^DGPM("ATID1",DFN,DGY)) Q:'DGY S DGDA=$O(^(DGY,0)) I $D(^DGPM(+DGDA,0)),$P(^(0),"^",17)]"" S DGXX=$P(^(0),"^",17),DGXX=^DGPM(DGXX,0) I "^12^38^"[("^"_$P(DGXX,"^",18)_"^") G DIS
|
---|
| 835 | "RTN","DGDEATH",12,0)
|
---|
| 836 | D NOW^%DTC S DGNOW=%
|
---|
| 837 | "RTN","DGDEATH",13,0)
|
---|
| 838 | S ^TMP("DEATH",$J)=1
|
---|
| 839 | "RTN","DGDEATH",14,0)
|
---|
| 840 | ; BEGIN WV CHANGE VEN/SMH: Add preliminary cause of death
|
---|
| 841 | "RTN","DGDEATH",15,0)
|
---|
| 842 | ; K A W ! S DIE=DIC,DR=".351" D ^DIE ; before
|
---|
| 843 | "RTN","DGDEATH",16,0)
|
---|
| 844 | K A W ! S DIE=DIC,DR=".351;S:(X=""""!(X=""@"")) Y=""@999"";250043.1;@999" D ^DIE ; after
|
---|
| 845 | "RTN","DGDEATH",17,0)
|
---|
| 846 | ; END WV CHANGE VEN/SMH
|
---|
| 847 | "RTN","DGDEATH",18,0)
|
---|
| 848 | I '$D(^DPT(DFN,.35)) K ^TMP("DEATH",$J) G GET
|
---|
| 849 | "RTN","DGDEATH",19,0)
|
---|
| 850 | S DGDNEW=^DPT(DFN,.35)
|
---|
| 851 | "RTN","DGDEATH",20,0)
|
---|
| 852 | I $P(DGDNEW,"^",1)="",$P(DGDNEW,"^",2)'="" S DR=".352////@" D ^DIE
|
---|
| 853 | "RTN","DGDEATH",21,0)
|
---|
| 854 | I $P(DGDNEW,"^",1)="" K ^TMP("DEATH",$J) G GET
|
---|
| 855 | "RTN","DGDEATH",22,0)
|
---|
| 856 | SN I $P(DGDNEW,"^",1)'="" S DR=".353" D ^DIE I $P($G(^DPT(DFN,.35)),"^",3)']"" D SNDISP G SN
|
---|
| 857 | "RTN","DGDEATH",23,0)
|
---|
| 858 | I DGDOLD'=DGDNEW D DISCHRGE
|
---|
| 859 | "RTN","DGDEATH",24,0)
|
---|
| 860 | I $P(DGDOLD,"^",1)'=$P(DGDNEW,"^",1) D XFR
|
---|
| 861 | "RTN","DGDEATH",25,0)
|
---|
| 862 | K ^TMP("DEATH",$J) G GET
|
---|
| 863 | "RTN","DGDEATH",26,0)
|
---|
| 864 | ;
|
---|
| 865 | "RTN","DGDEATH",27,0)
|
---|
| 866 | DIS W !,"Patient has a discharge type of Death",!,"Edit the discharge",!
|
---|
| 867 | "RTN","DGDEATH",28,0)
|
---|
| 868 | Q K A,DA,DFN,DGDA,DIC,DIE,DR,DGXX,DGY,DGDTHEN,DGDOLD,DGDNEW,DGDONOT Q
|
---|
| 869 | "RTN","DGDEATH",29,0)
|
---|
| 870 | XFR ; called from set x-ref of field .351 of file 2
|
---|
| 871 | "RTN","DGDEATH",30,0)
|
---|
| 872 | N DGPCMM,DGFAPT,DGFAPTI,DGFAPT1
|
---|
| 873 | "RTN","DGDEATH",31,0)
|
---|
| 874 | Q:'$D(DFN)
|
---|
| 875 | "RTN","DGDEATH",32,0)
|
---|
| 876 | K DGTEXT D ^DGPATV S DGDEATH=$$GET1^DIQ(2,DFN,.351,"I"),XMSUB="PATIENT HAS EXPIRED",DGCT=0
|
---|
| 877 | "RTN","DGDEATH",33,0)
|
---|
| 878 | D DEMOG
|
---|
| 879 | "RTN","DGDEATH",34,0)
|
---|
| 880 | S DGT=X-.0001,(Y,DGDDT)=X,DG1="" D:DGT]"" ^DGPMSTAT
|
---|
| 881 | "RTN","DGDEATH",35,0)
|
---|
| 882 | S Y=$$FMTE^XLFDT(Y),Y=$S(Y]"":Y,1:"UNKNOWN")
|
---|
| 883 | "RTN","DGDEATH",36,0)
|
---|
| 884 | S DGDONOT=0 D APTT3
|
---|
| 885 | "RTN","DGDEATH",37,0)
|
---|
| 886 | D LINE("")
|
---|
| 887 | "RTN","DGDEATH",38,0)
|
---|
| 888 | D LINE(" Date/Time of Death: "_DEATHVAL_$S(DGDONOT:"",'DG1:"",$D(DGDTHEN):"",1:" (While an inpatient)"))
|
---|
| 889 | "RTN","DGDEATH",39,0)
|
---|
| 890 | D LINE("")
|
---|
| 891 | "RTN","DGDEATH",40,0)
|
---|
| 892 | I '$D(ADM),DG1,$D(^DGPM(+DGA1,0)) S ADM=+^DGPM($P(^(0),"^",14),0)
|
---|
| 893 | "RTN","DGDEATH",41,0)
|
---|
| 894 | S Y=$$FMTE^XLFDT($S($D(ADM):ADM,1:""))
|
---|
| 895 | "RTN","DGDEATH",42,0)
|
---|
| 896 | D LINE($S($D(DGDTHEN):"",DG1:" Admission Date/Time: "_Y_$S((DGDDT-ADM)<1:" (Within 24 hours of hospitalization)",1:""),1:""))
|
---|
| 897 | "RTN","DGDEATH",43,0)
|
---|
| 898 | D LINE("")
|
---|
| 899 | "RTN","DGDEATH",44,0)
|
---|
| 900 | S DGX=$P($G(^DGPM(+$G(DGA1),0)),"^",6),DGX=$P($G(^DIC(42,+DGX,0)),U,1)
|
---|
| 901 | "RTN","DGDEATH",45,0)
|
---|
| 902 | D LINE($S($D(DGDTHEN):"",('DG1):"",$D(DGA1):" Admitted To: "_$S(DGX]"":DGX,1:"UNKNOWN"),1:"")) K DGX
|
---|
| 903 | "RTN","DGDEATH",46,0)
|
---|
| 904 | D LINE("")
|
---|
| 905 | "RTN","DGDEATH",47,0)
|
---|
| 906 | I DG1&'$D(DGDTHEN) D
|
---|
| 907 | "RTN","DGDEATH",48,0)
|
---|
| 908 | . D LINE($S($D(DGXFR0):" Last Transfer: "_$S($D(^DIC(42,+$P(DGXFR0,"^",6),0)):$P(^(0),"^"),1:"UNKNOWN"),1:""))
|
---|
| 909 | "RTN","DGDEATH",49,0)
|
---|
| 910 | . D LINE("")
|
---|
| 911 | "RTN","DGDEATH",50,0)
|
---|
| 912 | F N DGARRAY,SDCNT S DGFAPT=DGDEATH,DGFAPTI=""
|
---|
| 913 | "RTN","DGDEATH",51,0)
|
---|
| 914 | S DGARRAY("FLDS")=3,DGARRAY(4)=DFN,DGARRAY("SORT")="P",DGARRAY(1)=DT,DGARRAY(3)="I;R"
|
---|
| 915 | "RTN","DGDEATH",52,0)
|
---|
| 916 | S SDCNT=$$SDAPI^SDAMA301(.DGARRAY)
|
---|
| 917 | "RTN","DGDEATH",53,0)
|
---|
| 918 | ;
|
---|
| 919 | "RTN","DGDEATH",54,0)
|
---|
| 920 | I SDCNT>0 F S DGFAPT=$O(^TMP($J,"SDAMA301",DFN,DGFAPT)) Q:'DGFAPT S DGFAPT1=$G(^TMP($J,"SDAMA301",DFN,DGFAPT)) Q:DGFAPT1']"" D Q:DGFAPTI
|
---|
| 921 | "RTN","DGDEATH",55,0)
|
---|
| 922 | .I $P($P(DGFAPT1,U,3),";")'["C" D LINE("NOTE: Patient has future appointments scheduled!!") S DGFAPTI=1
|
---|
| 923 | "RTN","DGDEATH",56,0)
|
---|
| 924 | S DGSCHAD=0 D SA I DGSCHAD D LINE("NOTE: Patient had scheduled admissions which have been cancelled!!")
|
---|
| 925 | "RTN","DGDEATH",57,0)
|
---|
| 926 | I 'DGVETS D LINE("Patient is a NON-VETERAN."_$S($D(^DIC(21,+$P($G(^DPT(DFN,.32)),"^",3),0)):" ["_$P(^(0),"^",1)_"]",1:""))
|
---|
| 927 | "RTN","DGDEATH",58,0)
|
---|
| 928 | S DGPCMM=$$PCMMXMY^SCAPMC25(1,DFN,,,0) ;creates xmy array
|
---|
| 929 | "RTN","DGDEATH",59,0)
|
---|
| 930 | S DGCT=$$PCMAIL^SCMCMM(DFN,"DGTEXT",DT)
|
---|
| 931 | "RTN","DGDEATH",60,0)
|
---|
| 932 | Q1 S DGB=1 D ^DGBUL S X=DGDEATH
|
---|
| 933 | "RTN","DGDEATH",61,0)
|
---|
| 934 | K DGDEATH,DGSCHAD,DGI,Y,DGDDT,^TMP($J,"SDAMA301") D KILL^DGPATV K ADM,DG1,DGA1,DGCT,DGT,DGXX,DGY,Z Q
|
---|
| 935 | "RTN","DGDEATH",62,0)
|
---|
| 936 | SA F DGI=0:0 S DGI=$O(^DGS(41.1,"B",DFN,DGI)) Q:'DGI I $D(^DGS(41.1,DGI,0)),($P(^(0),"^",13)']""),($P(^(0),"^",17)']"") S $P(^(0),"^",13)=DGDEATH,$P(^(0),"^",14)=+DUZ,$P(^(0),"^",15)=1,$P(^(0),"^",16)=2,DGSCHAD=1
|
---|
| 937 | "RTN","DGDEATH",63,0)
|
---|
| 938 | Q
|
---|
| 939 | "RTN","DGDEATH",64,0)
|
---|
| 940 | ;
|
---|
| 941 | "RTN","DGDEATH",65,0)
|
---|
| 942 | DEL ; delete death bulletin
|
---|
| 943 | "RTN","DGDEATH",66,0)
|
---|
| 944 | N DGPCMM,DELBY,DELTM,DTHINFO
|
---|
| 945 | "RTN","DGDEATH",67,0)
|
---|
| 946 | S DFN=+$G(DA) I '$D(^DPT(DFN,0)) Q ; no patient node
|
---|
| 947 | "RTN","DGDEATH",68,0)
|
---|
| 948 | I +$G(^DPT(DFN,.35)) Q ; not deletion
|
---|
| 949 | "RTN","DGDEATH",69,0)
|
---|
| 950 | S DGDEATH=X,XMSUB="Patient Death has been Deleted",DGCT=0
|
---|
| 951 | "RTN","DGDEATH",70,0)
|
---|
| 952 | D ^DGPATV
|
---|
| 953 | "RTN","DGDEATH",71,0)
|
---|
| 954 | D LINE("The date of death for the following patient has been deleted.")
|
---|
| 955 | "RTN","DGDEATH",72,0)
|
---|
| 956 | D LINE("")
|
---|
| 957 | "RTN","DGDEATH",73,0)
|
---|
| 958 | D DEMOG
|
---|
| 959 | "RTN","DGDEATH",74,0)
|
---|
| 960 | D LINE("")
|
---|
| 961 | "RTN","DGDEATH",75,0)
|
---|
| 962 | S DGPCMM=$$PCMMXMY^SCAPMC25(1,DFN,,,0) ;creates xmy array
|
---|
| 963 | "RTN","DGDEATH",76,0)
|
---|
| 964 | S DGCT=$$PCMAIL^SCMCMM(DFN,"DGTEXT",DT)
|
---|
| 965 | "RTN","DGDEATH",77,0)
|
---|
| 966 | S DGB=1 D ^DGBUL S X=DGDEATH
|
---|
| 967 | "RTN","DGDEATH",78,0)
|
---|
| 968 | K DGCT,DGDEATH D KILL^DGPATV
|
---|
| 969 | "RTN","DGDEATH",79,0)
|
---|
| 970 | Q
|
---|
| 971 | "RTN","DGDEATH",80,0)
|
---|
| 972 | ;
|
---|
| 973 | "RTN","DGDEATH",81,0)
|
---|
| 974 | DEMOG ; list main demographics
|
---|
| 975 | "RTN","DGDEATH",82,0)
|
---|
| 976 | D LINE(" NAME: "_DGNAME)
|
---|
| 977 | "RTN","DGDEATH",83,0)
|
---|
| 978 | D LINE(" SSN: "_$P(SSN,"^",2))
|
---|
| 979 | "RTN","DGDEATH",84,0)
|
---|
| 980 | D LINE(" DOB: "_$P(DOB,"^",2))
|
---|
| 981 | "RTN","DGDEATH",85,0)
|
---|
| 982 | I DGVETS D
|
---|
| 983 | "RTN","DGDEATH",86,0)
|
---|
| 984 | . N DGX
|
---|
| 985 | "RTN","DGDEATH",87,0)
|
---|
| 986 | . S DGX=$G(^DPT(DFN,.31))
|
---|
| 987 | "RTN","DGDEATH",88,0)
|
---|
| 988 | . S DGLOCATN=$$FIND1^DIC(4,"","MX","`"_+$P(DGX,U,4)),DGLOCATN=$S(+DGLOCATN>0:$P($$NS^XUAF4(DGLOCATN),U),1:"NOT LISTED")
|
---|
| 989 | "RTN","DGDEATH",89,0)
|
---|
| 990 | . D LINE(" CLAIM FOLDER LOCATION: "_$S($D(DGLOCATN):DGLOCATN,1:"NOT LISTED"))
|
---|
| 991 | "RTN","DGDEATH",90,0)
|
---|
| 992 | . D LINE(" CLAIM NUMBER: "_$S($P(DGX,"^",3)]"":$P(DGX,"^",3),1:"NOT LISTED"))
|
---|
| 993 | "RTN","DGDEATH",91,0)
|
---|
| 994 | D LINE(" COORDINATING MASTER OF RECORD: "_DGCMOR)
|
---|
| 995 | "RTN","DGDEATH",92,0)
|
---|
| 996 | D GETS^DIQ(2,DFN_",",".351;.353;.354;.355","E","DTHINFO")
|
---|
| 997 | "RTN","DGDEATH",93,0)
|
---|
| 998 | S DEATHVAL=$G(DTHINFO(2,DFN_",",.351,"E"))
|
---|
| 999 | "RTN","DGDEATH",94,0)
|
---|
| 1000 | S DEATHVAL=$$FMTE^XLFDT(DEATHVAL),DEATHVAL=$S(DEATHVAL]"":DEATHVAL,1:"UNKNOWN")
|
---|
| 1001 | "RTN","DGDEATH",95,0)
|
---|
| 1002 | S SOURCE=$G(DTHINFO(2,DFN_",",.353,"E"))
|
---|
| 1003 | "RTN","DGDEATH",96,0)
|
---|
| 1004 | S DELTM=$G(DTHINFO(2,DFN_",",.354,"E"))
|
---|
| 1005 | "RTN","DGDEATH",97,0)
|
---|
| 1006 | S DELBY=$G(DTHINFO(2,DFN_",",.355,"E"))
|
---|
| 1007 | "RTN","DGDEATH",98,0)
|
---|
| 1008 | D LINE("")
|
---|
| 1009 | "RTN","DGDEATH",99,0)
|
---|
| 1010 | D LINE(" LAST EDITED BY: "_DELBY)
|
---|
| 1011 | "RTN","DGDEATH",100,0)
|
---|
| 1012 | D LINE(" DATE/TIME LAST MODIFIED: "_DELTM)
|
---|
| 1013 | "RTN","DGDEATH",101,0)
|
---|
| 1014 | D LINE(" SOURCE OF NOTIFICATION: "_$S(SOURCE="":"UNDEFINED",1:SOURCE))
|
---|
| 1015 | "RTN","DGDEATH",102,0)
|
---|
| 1016 | ;K DEATHVAL,SOURCE,DELTM,DELBY
|
---|
| 1017 | "RTN","DGDEATH",103,0)
|
---|
| 1018 | Q
|
---|
| 1019 | "RTN","DGDEATH",104,0)
|
---|
| 1020 | ;
|
---|
| 1021 | "RTN","DGDEATH",105,0)
|
---|
| 1022 | LINE(X) ; add line contained in X to array
|
---|
| 1023 | "RTN","DGDEATH",106,0)
|
---|
| 1024 | S DGCT=DGCT+1
|
---|
| 1025 | "RTN","DGDEATH",107,0)
|
---|
| 1026 | S DGTEXT(DGCT,0)=X
|
---|
| 1027 | "RTN","DGDEATH",108,0)
|
---|
| 1028 | Q
|
---|
| 1029 | "RTN","DGDEATH",109,0)
|
---|
| 1030 | DSBULL ;
|
---|
| 1031 | "RTN","DGDEATH",110,0)
|
---|
| 1032 | ;
|
---|
| 1033 | "RTN","DGDEATH",111,0)
|
---|
| 1034 | I $G(IVMDODUP)=1 Q
|
---|
| 1035 | "RTN","DGDEATH",112,0)
|
---|
| 1036 | S DFN=DA
|
---|
| 1037 | "RTN","DGDEATH",113,0)
|
---|
| 1038 | I $D(DGPMDA) D Q
|
---|
| 1039 | "RTN","DGDEATH",114,0)
|
---|
| 1040 | .S DISTYPE=$P($G(^DGPM(DGPMDA,0)),"^",18)
|
---|
| 1041 | "RTN","DGDEATH",115,0)
|
---|
| 1042 | .I $G(^DG(405.2,DISTYPE,0))["DEATH" D
|
---|
| 1043 | "RTN","DGDEATH",116,0)
|
---|
| 1044 | ..S FDA(2,DFN_",",.353)=1 D FILE^DIE(,"FDA","BWFERR")
|
---|
| 1045 | "RTN","DGDEATH",117,0)
|
---|
| 1046 | ..D DISCHRGE,XFR
|
---|
| 1047 | "RTN","DGDEATH",118,0)
|
---|
| 1048 | I $D(^TMP("DEATH",$J)) Q
|
---|
| 1049 | "RTN","DGDEATH",119,0)
|
---|
| 1050 | D DISCHRGE,XFR
|
---|
| 1051 | "RTN","DGDEATH",120,0)
|
---|
| 1052 | Q
|
---|
| 1053 | "RTN","DGDEATH",121,0)
|
---|
| 1054 | DKBULL ;
|
---|
| 1055 | "RTN","DGDEATH",122,0)
|
---|
| 1056 | S DFN=DA
|
---|
| 1057 | "RTN","DGDEATH",123,0)
|
---|
| 1058 | S FDA(2,DFN_",",.353)="@"
|
---|
| 1059 | "RTN","DGDEATH",124,0)
|
---|
| 1060 | I $D(^TMP("DEATH",$J)) S FDA(2,DFN_",",.355)=DUZ
|
---|
| 1061 | "RTN","DGDEATH",125,0)
|
---|
| 1062 | D FILE^DIE(,"FDA",)
|
---|
| 1063 | "RTN","DGDEATH",126,0)
|
---|
| 1064 | D DEL
|
---|
| 1065 | "RTN","DGDEATH",127,0)
|
---|
| 1066 | Q
|
---|
| 1067 | "RTN","DGDEATH",128,0)
|
---|
| 1068 | DISCHRGE ;
|
---|
| 1069 | "RTN","DGDEATH",129,0)
|
---|
| 1070 | ; If the patient is being discharged, determine values needed for
|
---|
| 1071 | "RTN","DGDEATH",130,0)
|
---|
| 1072 | ; Source of Notification and Date/Time last entered.
|
---|
| 1073 | "RTN","DGDEATH",131,0)
|
---|
| 1074 | ;
|
---|
| 1075 | "RTN","DGDEATH",132,0)
|
---|
| 1076 | I '$D(DGNOW) S DGNOW=$$HTFM^XLFDT($H)
|
---|
| 1077 | "RTN","DGDEATH",133,0)
|
---|
| 1078 | I $G(DGDAUTO)'=1 S FDA(2,DFN_",",.354)=DGNOW
|
---|
| 1079 | "RTN","DGDEATH",134,0)
|
---|
| 1080 | S FDA(2,DFN_",",.355)=DUZ
|
---|
| 1081 | "RTN","DGDEATH",135,0)
|
---|
| 1082 | D FILE^DIE(,"FDA",)
|
---|
| 1083 | "RTN","DGDEATH",136,0)
|
---|
| 1084 | Q
|
---|
| 1085 | "RTN","DGDEATH",137,0)
|
---|
| 1086 | APTT3 ;Check to exclude "While an Inpatient" from DOD Bulletin
|
---|
| 1087 | "RTN","DGDEATH",138,0)
|
---|
| 1088 | ; Input: DFN Output: DGDONOT
|
---|
| 1089 | "RTN","DGDEATH",139,0)
|
---|
| 1090 | N DATE,XIEN,TYPE,XDOD,YES
|
---|
| 1091 | "RTN","DGDEATH",140,0)
|
---|
| 1092 | S DGDONOT=0
|
---|
| 1093 | "RTN","DGDEATH",141,0)
|
---|
| 1094 | S XDOD=$P($G(^DPT(DFN,.35)),"^",1) I 'XDOD Q
|
---|
| 1095 | "RTN","DGDEATH",142,0)
|
---|
| 1096 | S XDOD=$P(XDOD,".",1),YES=0,TYPE=""
|
---|
| 1097 | "RTN","DGDEATH",143,0)
|
---|
| 1098 | I '$D(^DGPM("APTT3",DFN)) Q
|
---|
| 1099 | "RTN","DGDEATH",144,0)
|
---|
| 1100 | S DATE=$O(^DGPM("APTT3",DFN,XDOD)) I 'DATE Q
|
---|
| 1101 | "RTN","DGDEATH",145,0)
|
---|
| 1102 | I $P(DATE,".",1)=XDOD S YES=1
|
---|
| 1103 | "RTN","DGDEATH",146,0)
|
---|
| 1104 | I ($P(DATE,".",1)-1)=XDOD S YES=1
|
---|
| 1105 | "RTN","DGDEATH",147,0)
|
---|
| 1106 | S XIEN=$O(^DGPM("APTT3",DFN,DATE,"")) I 'XIEN Q
|
---|
| 1107 | "RTN","DGDEATH",148,0)
|
---|
| 1108 | S TYPE=$P($G(^DGPM(XIEN,0)),"^",4)
|
---|
| 1109 | "RTN","DGDEATH",149,0)
|
---|
| 1110 | I YES,'((TYPE=27)!(TYPE=32)) S DGDONOT=1
|
---|
| 1111 | "RTN","DGDEATH",150,0)
|
---|
| 1112 | Q
|
---|
| 1113 | "RTN","DGDEATH",151,0)
|
---|
| 1114 | SNDISP ; Source of Notification display choices
|
---|
| 1115 | "RTN","DGDEATH",152,0)
|
---|
| 1116 | N DIR,DTOUT,DUOUT,DIRUT,DIROUT,DGLIST,DGLNAME,I,X,Y
|
---|
| 1117 | "RTN","DGDEATH",153,0)
|
---|
| 1118 | S DGLIST=$P($G(^DD(2,.353,0)),"^",3)
|
---|
| 1119 | "RTN","DGDEATH",154,0)
|
---|
| 1120 | S Y=6
|
---|
| 1121 | "RTN","DGDEATH",155,0)
|
---|
| 1122 | S DIR("?",1)=" "
|
---|
| 1123 | "RTN","DGDEATH",156,0)
|
---|
| 1124 | S DIR("?",2)=" This is a required response. Please select from the following:"
|
---|
| 1125 | "RTN","DGDEATH",157,0)
|
---|
| 1126 | S DIR("?",3)=" Entering '^' will take you back to the Source of Notification prompt"
|
---|
| 1127 | "RTN","DGDEATH",158,0)
|
---|
| 1128 | S DIR("?",4)=" "
|
---|
| 1129 | "RTN","DGDEATH",159,0)
|
---|
| 1130 | S DIR("?",5)=" "
|
---|
| 1131 | "RTN","DGDEATH",160,0)
|
---|
| 1132 | F X=1:1 S DGLNAME=$P(DGLIST,";",X) Q:DGLNAME']"" S DIR("?",Y)=" "_$P(DGLNAME,":",1)_" "_$P(DGLNAME,":",2) S Y=Y+1
|
---|
| 1133 | "RTN","DGDEATH",161,0)
|
---|
| 1134 | S DIR("?",Y)=" "
|
---|
| 1135 | "RTN","DGDEATH",162,0)
|
---|
| 1136 | F I=1:1 Q:'$D(DIR("?",I)) W !,DIR("?",I)
|
---|
| 1137 | "RTN","DGDEATH",163,0)
|
---|
| 1138 | Q
|
---|
| 1139 | "RTN","DGPMV")
|
---|
| 1140 | 0^7^B19120801
|
---|
| 1141 | "RTN","DGPMV",1,0)
|
---|
| 1142 | DGPMV ;ALB/MRL/MIR - PATIENT MOVEMENT DRIVER; 10 MAR 89 ; 11/5/12 1:00pm
|
---|
| 1143 | "RTN","DGPMV",2,0)
|
---|
| 1144 | ;;5.3;Registration;**60,200,268,VW1**;Aug 13, 1993;Build 18
|
---|
| 1145 | "RTN","DGPMV",3,0)
|
---|
| 1146 | ;
|
---|
| 1147 | "RTN","DGPMV",4,0)
|
---|
| 1148 | ;OPTION VALUE OF DGPMT
|
---|
| 1149 | "RTN","DGPMV",5,0)
|
---|
| 1150 | ;------ --------------
|
---|
| 1151 | "RTN","DGPMV",6,0)
|
---|
| 1152 | ;admit 1
|
---|
| 1153 | "RTN","DGPMV",7,0)
|
---|
| 1154 | ;transfer 2
|
---|
| 1155 | "RTN","DGPMV",8,0)
|
---|
| 1156 | ;discharge 3
|
---|
| 1157 | "RTN","DGPMV",9,0)
|
---|
| 1158 | ;check-in 4
|
---|
| 1159 | "RTN","DGPMV",10,0)
|
---|
| 1160 | ;check-out 5
|
---|
| 1161 | "RTN","DGPMV",11,0)
|
---|
| 1162 | ;t.s. transfer 6
|
---|
| 1163 | "RTN","DGPMV",12,0)
|
---|
| 1164 | ;
|
---|
| 1165 | "RTN","DGPMV",13,0)
|
---|
| 1166 | ; Change History:
|
---|
| 1167 | "RTN","DGPMV",14,0)
|
---|
| 1168 | ; 3121105: *VW1* Added meaningful use questions in reg+1
|
---|
| 1169 | "RTN","DGPMV",15,0)
|
---|
| 1170 | PAT K ORACTION,ORMENU
|
---|
| 1171 | "RTN","DGPMV",16,0)
|
---|
| 1172 | D LO^DGUTL I '$D(IOF) S IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS K IOP
|
---|
| 1173 | "RTN","DGPMV",17,0)
|
---|
| 1174 | PAT1 W ! I DGPMT=5 S DGPMN=0 D SPCLU^DGPMV0 G OREN:'DGER,Q
|
---|
| 1175 | "RTN","DGPMV",18,0)
|
---|
| 1176 | S DIC="^DPT(",DIC(0)="AEQMZ",DIC("A")=$S('$D(DGPMPC):$P("Admit^Transfer^Discharge^Check-in^Check-out^Specialty Change for","^",DGPMT),1:"Provider Change for")_" PATIENT: "
|
---|
| 1177 | "RTN","DGPMV",19,0)
|
---|
| 1178 | S:DGPMT=1 DIC(0)=DIC(0)_"L",DLAYGO=2 S:"^1^4^"'[("^"_DGPMT_"^") DIC("S")="I $D(^DGPM($S(DGPMT'=5:""APTT1"",1:""APTT4""),+Y))" D ^DIC K DIC,DLAYGO G Q:Y'>0 S DFN=+Y,DGPMN=$P(Y,"^",3)
|
---|
| 1179 | "RTN","DGPMV",20,0)
|
---|
| 1180 | OREN S DGUSEOR=$$USINGOR()
|
---|
| 1181 | "RTN","DGPMV",21,0)
|
---|
| 1182 | I DGUSEOR Q:'$D(ORVP) S DFN=+ORVP,DGPMN="",Y(0)=$G(^DPT(DFN,0))
|
---|
| 1183 | "RTN","DGPMV",22,0)
|
---|
| 1184 | I $$LODGER(DFN)&(DGPMT=1) D Q
|
---|
| 1185 | "RTN","DGPMV",23,0)
|
---|
| 1186 | .W !,*7,"Patient is a lodger...you can not add an admission!"
|
---|
| 1187 | "RTN","DGPMV",24,0)
|
---|
| 1188 | .W !," Press RETURN to continue"
|
---|
| 1189 | "RTN","DGPMV",25,0)
|
---|
| 1190 | .R XTEMP:30
|
---|
| 1191 | "RTN","DGPMV",26,0)
|
---|
| 1192 | .D DISPOQ K DGPMDER
|
---|
| 1193 | "RTN","DGPMV",27,0)
|
---|
| 1194 | MOVE ;
|
---|
| 1195 | "RTN","DGPMV",28,0)
|
---|
| 1196 | S XQORQUIT=1,DGPME=0 D UC
|
---|
| 1197 | "RTN","DGPMV",29,0)
|
---|
| 1198 | G CHK:"^1^4^"[("^"_DGPMT_"^") I '$D(^DGPM("APTT"_$S(DGPMT'=5:1,1:4),DFN)) W !!,"'",$P(Y(0),"^",1),"' HAS NEVER BEEN ",$S(DGPMT'=5:"ADMITTED",1:"CHECK-IN")," TO THE DHCP ADMISSIONS MODULE" G PAT1:'DGUSEOR,Q
|
---|
| 1199 | "RTN","DGPMV",30,0)
|
---|
| 1200 | CHK D:DGPMN REG I 'DGPME,$D(^DPT(DFN,.35)),+^(.35) S Y=+^(.35) D DIED
|
---|
| 1201 | "RTN","DGPMV",31,0)
|
---|
| 1202 | D NEW^DGPMVODS I $S('DGODSON:0,'$D(^DPT(DFN,.32)):1,'$D(^DIC(21,+$P(^(.32),"^",3),0)):1,1:0) S DGPME=1
|
---|
| 1203 | "RTN","DGPMV",32,0)
|
---|
| 1204 | D:'DGPME ^DGPMV1 G PAT1:'DGUSEOR,Q
|
---|
| 1205 | "RTN","DGPMV",33,0)
|
---|
| 1206 | ;
|
---|
| 1207 | "RTN","DGPMV",34,0)
|
---|
| 1208 | REG ;new patient
|
---|
| 1209 | "RTN","DGPMV",35,0)
|
---|
| 1210 | ; WV Change by VEN/SMH *VW1*
|
---|
| 1211 | "RTN","DGPMV",36,0)
|
---|
| 1212 | D REGMU^VWUTIL ; Extra questions for Meaningful Use
|
---|
| 1213 | "RTN","DGPMV",37,0)
|
---|
| 1214 | ; End WV Change *VW1*
|
---|
| 1215 | "RTN","DGPMV",38,0)
|
---|
| 1216 | D NEW^DGRP
|
---|
| 1217 | "RTN","DGPMV",39,0)
|
---|
| 1218 | W !!,"NEW PATIENT! WANT TO LOAD 10-10 DATA NOW" S %=1 D YN^DICN I %=1 D ENED^DGRP S:'$D(^DPT(DFN,0)) DGPME=1 Q
|
---|
| 1219 | "RTN","DGPMV",40,0)
|
---|
| 1220 | Q:%>0 I % S DGPME=1 Q
|
---|
| 1221 | "RTN","DGPMV",41,0)
|
---|
| 1222 | W !?4,"Answer YES if you want to load 10/10 data at this time otherwise answer NO.",*7 G REG
|
---|
| 1223 | "RTN","DGPMV",42,0)
|
---|
| 1224 | ;
|
---|
| 1225 | "RTN","DGPMV",43,0)
|
---|
| 1226 | DIED X ^DD("DD") W !!,"PATIENT EXPIRED '",Y,"'...WANT TO CONTINUE" S %=2 D YN^DICN Q:%=1 I % S DGPME=1 Q
|
---|
| 1227 | "RTN","DGPMV",44,0)
|
---|
| 1228 | W !?4,*7,"Answer YES if you want to continue this process even though the patient",!?4,"has expired otherwise answer NO!" G DIED
|
---|
| 1229 | "RTN","DGPMV",45,0)
|
---|
| 1230 | ;
|
---|
| 1231 | "RTN","DGPMV",46,0)
|
---|
| 1232 | Q K %,DFN,DGER,DGPM5X,DGODS,DGODSON,DGPMUC,DGPME,DGPMN,DGPMT,DGPMPC,DIC,X,Y,^UTILITY("VAIP",$J) D KVAR^VADPT
|
---|
| 1233 | "RTN","DGPMV",47,0)
|
---|
| 1234 | I '$G(DGUSEOR) K XQORQUIT
|
---|
| 1235 | "RTN","DGPMV",48,0)
|
---|
| 1236 | K DGUSEOR
|
---|
| 1237 | "RTN","DGPMV",49,0)
|
---|
| 1238 | Q
|
---|
| 1239 | "RTN","DGPMV",50,0)
|
---|
| 1240 | ;
|
---|
| 1241 | "RTN","DGPMV",51,0)
|
---|
| 1242 | UC ; -- set type of mvt literal
|
---|
| 1243 | "RTN","DGPMV",52,0)
|
---|
| 1244 | S DGPMUC=$P("ADMISSION^TRANSFER^DISCHARGE^LODGER CHECK-IN^CHECK-OUT LODGER^SPECIALTY TRANSFER^ROOM-BED CHANGE","^",DGPMT)
|
---|
| 1245 | "RTN","DGPMV",53,0)
|
---|
| 1246 | I DGPMT=6,$D(DGPMPC) S DGPMUC="PROVIDER CHANGE"
|
---|
| 1247 | "RTN","DGPMV",54,0)
|
---|
| 1248 | Q
|
---|
| 1249 | "RTN","DGPMV",55,0)
|
---|
| 1250 | ;
|
---|
| 1251 | "RTN","DGPMV",56,0)
|
---|
| 1252 | CA ; -- bypass interactive process and allows editing of past admission
|
---|
| 1253 | "RTN","DGPMV",57,0)
|
---|
| 1254 | ; mvts
|
---|
| 1255 | "RTN","DGPMV",58,0)
|
---|
| 1256 | ;
|
---|
| 1257 | "RTN","DGPMV",59,0)
|
---|
| 1258 | ; input: DFN
|
---|
| 1259 | "RTN","DGPMV",60,0)
|
---|
| 1260 | ; DGPMT - mvt transaction type
|
---|
| 1261 | "RTN","DGPMV",61,0)
|
---|
| 1262 | ; DGPMCA - coresp. adm
|
---|
| 1263 | "RTN","DGPMV",62,0)
|
---|
| 1264 | ;
|
---|
| 1265 | "RTN","DGPMV",63,0)
|
---|
| 1266 | ; output: Y - the mvt entry added/edited
|
---|
| 1267 | "RTN","DGPMV",64,0)
|
---|
| 1268 | ;
|
---|
| 1269 | "RTN","DGPMV",65,0)
|
---|
| 1270 | D UC
|
---|
| 1271 | "RTN","DGPMV",66,0)
|
---|
| 1272 | K VAIP S VAIP("E")=DGPMCA N DGPMCA D INP^DGPMV10
|
---|
| 1273 | "RTN","DGPMV",67,0)
|
---|
| 1274 | S DGPMBYP="" D C^DGPMV1
|
---|
| 1275 | "RTN","DGPMV",68,0)
|
---|
| 1276 | S Y=DGPMBYP K DGPMUC,DGPMBYP
|
---|
| 1277 | "RTN","DGPMV",69,0)
|
---|
| 1278 | Q
|
---|
| 1279 | "RTN","DGPMV",70,0)
|
---|
| 1280 | DISPO ;called from admission disposition types
|
---|
| 1281 | "RTN","DGPMV",71,0)
|
---|
| 1282 | ;input DGPMSVC=SVC OF WARD REQUIRED (FROM DISPOSITION TYPE FILE)
|
---|
| 1283 | "RTN","DGPMV",72,0)
|
---|
| 1284 | ; DFN=patient file IFN (this variable is NOT killed on exit)
|
---|
| 1285 | "RTN","DGPMV",73,0)
|
---|
| 1286 | ;output DGPMDER=disposition error?? - FOR FUTURE USE
|
---|
| 1287 | "RTN","DGPMV",74,0)
|
---|
| 1288 | ;
|
---|
| 1289 | "RTN","DGPMV",75,0)
|
---|
| 1290 | S DGPMT=1,(DGPML,DGPMMD)="" K DGPMDER,VAIP S VAIP("D")="L" D UC^DGPMV,INP^DGPMV10,NOW^%DTC
|
---|
| 1291 | "RTN","DGPMV",76,0)
|
---|
| 1292 | I DGPMVI(1)&('DGPMDCD!(DGPMDCD>%)) W !,"Patient is already an inpatient...editing the admission is not allowed." D DISPOQ K DGPMDER Q
|
---|
| 1293 | "RTN","DGPMV",77,0)
|
---|
| 1294 | I $$LODGER(DFN) W !,*7,"Patient is a lodger...you can not add an admission!" D DISPOQ K DGPMDER Q
|
---|
| 1295 | "RTN","DGPMV",78,0)
|
---|
| 1296 | ;next line should be involked in future release to error if wrong service
|
---|
| 1297 | "RTN","DGPMV",79,0)
|
---|
| 1298 | ;I DGPMVI(1)&('DGPMDCD!(DGPMDCD>%)) S DGPMDER=$S(DGPMSVC="H"&("^NH^D^"'[("^"_DGPMSV_"^")):0,DGPMSVC=DGPMSV:0,1:1) W:DGPMDER=1 "Current inpatient, but not to proper service" Q
|
---|
| 1299 | "RTN","DGPMV",80,0)
|
---|
| 1300 | D NEW^DGPMVODS I $S('DGODSON:0,'$D(^DPT(DFN,.32)):1,'$D(^DIC(21,+$P(^(.32),"^",3),0)):1,1:0) S DGPME=1
|
---|
| 1301 | "RTN","DGPMV",81,0)
|
---|
| 1302 | S DEF="NOW",DGPM1X=0 D SEL^DGPMV2 I '$D(DGPMDER) S DGPMDER=1
|
---|
| 1303 | "RTN","DGPMV",82,0)
|
---|
| 1304 | DISPOQ D Q^DGPMV1 K DGODS,DGODSON,DGPMT,DGPMSV,DGPMSVC,DGPMUC,DGPMN,^UTILITY("VAIP",$J) Q
|
---|
| 1305 | "RTN","DGPMV",83,0)
|
---|
| 1306 | ;
|
---|
| 1307 | "RTN","DGPMV",84,0)
|
---|
| 1308 | USINGOR() ; return a 1 if OE/RR option is being used or 0 otherwise
|
---|
| 1309 | "RTN","DGPMV",85,0)
|
---|
| 1310 | N RETURN,X
|
---|
| 1311 | "RTN","DGPMV",86,0)
|
---|
| 1312 | S RETURN=0,X=+$$VERSION^XPDUTL("OR")
|
---|
| 1313 | "RTN","DGPMV",87,0)
|
---|
| 1314 | I X<3,$D(ORACTION) S RETURN=1
|
---|
| 1315 | "RTN","DGPMV",88,0)
|
---|
| 1316 | I X'<3,$D(ORMENU) S RETURN=1
|
---|
| 1317 | "RTN","DGPMV",89,0)
|
---|
| 1318 | Q RETURN
|
---|
| 1319 | "RTN","DGPMV",90,0)
|
---|
| 1320 | LODGER(DFN) ; Determine lodger status
|
---|
| 1321 | "RTN","DGPMV",91,0)
|
---|
| 1322 | ; Input: DFN=patient IEN
|
---|
| 1323 | "RTN","DGPMV",92,0)
|
---|
| 1324 | ; Output: '1' if currently a lodger, '0' otherwise
|
---|
| 1325 | "RTN","DGPMV",93,0)
|
---|
| 1326 | N DGPMDCD,DGPMVI,I,X
|
---|
| 1327 | "RTN","DGPMV",94,0)
|
---|
| 1328 | D LODGER^DGPMV10
|
---|
| 1329 | "RTN","DGPMV",95,0)
|
---|
| 1330 | Q DGPMVI(2)=4
|
---|
| 1331 | "RTN","DGREG")
|
---|
| 1332 | 0^1^B78971450
|
---|
| 1333 | "RTN","DGREG",1,0)
|
---|
| 1334 | DGREG ;ALB/JDS,MRL/PJR/PHH-REGISTER PATIENT ; 11/5/12 1:00pm
|
---|
| 1335 | "RTN","DGREG",2,0)
|
---|
| 1336 | ;;5.3;Registration;**1,32,108,147,149,182,245,250,513,425,533,574,563,624,658,634**;Aug 13, 1993;Build 18
|
---|
| 1337 | "RTN","DGREG",3,0)
|
---|
| 1338 | ; Modified from FOIA VISTA,
|
---|
| 1339 | "RTN","DGREG",4,0)
|
---|
| 1340 | ; Copyright (C) 2007 WorldVistA
|
---|
| 1341 | "RTN","DGREG",5,0)
|
---|
| 1342 | ;
|
---|
| 1343 | "RTN","DGREG",6,0)
|
---|
| 1344 | ; This program is free software; you can redistribute it and/or modify
|
---|
| 1345 | "RTN","DGREG",7,0)
|
---|
| 1346 | ; it under the terms of the GNU General Public License as published by
|
---|
| 1347 | "RTN","DGREG",8,0)
|
---|
| 1348 | ; the Free Software Foundation; either version 2 of the License, or
|
---|
| 1349 | "RTN","DGREG",9,0)
|
---|
| 1350 | ; (at your option) any later version.
|
---|
| 1351 | "RTN","DGREG",10,0)
|
---|
| 1352 | ;
|
---|
| 1353 | "RTN","DGREG",11,0)
|
---|
| 1354 | START ;
|
---|
| 1355 | "RTN","DGREG",12,0)
|
---|
| 1356 | EN D LO^DGUTL S DGCLPR=""
|
---|
| 1357 | "RTN","DGREG",13,0)
|
---|
| 1358 | N DGDIV
|
---|
| 1359 | "RTN","DGREG",14,0)
|
---|
| 1360 | S DGDIV=$$PRIM^VASITE
|
---|
| 1361 | "RTN","DGREG",15,0)
|
---|
| 1362 | S:DGDIV %ZIS("B")=$P($G(^DG(40.8,+DGDIV,"DEV")),U,1)
|
---|
| 1363 | "RTN","DGREG",16,0)
|
---|
| 1364 | I $P(^DG(43,1,0),U,39) S %ZIS="NQ",%ZIS("A")="Select 1010 printer: " D ^%ZIS Q:POP S (DGIO(10),DGIO("PRF"),DGIO("RT"),DGIO("HS"))=ION,DGASKDEV="" I $E(IOST,1,2)'["P-" W !,$C(7),"Not a printer" G DGREG
|
---|
| 1365 | "RTN","DGREG",17,0)
|
---|
| 1366 | K %ZIS("B")
|
---|
| 1367 | "RTN","DGREG",18,0)
|
---|
| 1368 | I '$D(DGIO),$P(^DG(43,1,0),U,30) S %ZIS="N",IOP="HOME" D ^%ZIS I $D(IOS),IOS,$D(^%ZIS(1,+IOS,99)),$D(^%ZIS(1,+^(99),0)) S Y=$P(^(0),U,1) W !,"Using closest printer ",Y,! F I=10,"PRF","RT","HS" S DGIO(I)=Y
|
---|
| 1369 | "RTN","DGREG",19,0)
|
---|
| 1370 | A D ENDREG($G(DFN))
|
---|
| 1371 | "RTN","DGREG",20,0)
|
---|
| 1372 | ;
|
---|
| 1373 | "RTN","DGREG",21,0)
|
---|
| 1374 | ; ** VOE change 1 of 4: DAOU/WCJ 2/1/2005,VA/CJS,WV/TOAD 1/5/2006 **
|
---|
| 1375 | "RTN","DGREG",22,0)
|
---|
| 1376 | ;
|
---|
| 1377 | "RTN","DGREG",23,0)
|
---|
| 1378 | ; if not VA agency code, add DIC("DR") to default some identifiers and
|
---|
| 1379 | "RTN","DGREG",24,0)
|
---|
| 1380 | ; skip others also, improve readability
|
---|
| 1381 | "RTN","DGREG",25,0)
|
---|
| 1382 | ;
|
---|
| 1383 | "RTN","DGREG",26,0)
|
---|
| 1384 | ; before change:
|
---|
| 1385 | "RTN","DGREG",27,0)
|
---|
| 1386 | ; W !! S DIC=2,DIC(0)="ALEQM",DLAYGO=2 K DIC("S"),DIC("B") D ^DIC K DLAYGO G Q1:Y<0 S (DFN,DA)=+Y,DGNEW=$P(Y,"^",3) N Y D PAUSE^DG10 D BEGINREG(DFN) I DGNEW D NEW^DGRP
|
---|
| 1387 | "RTN","DGREG",28,0)
|
---|
| 1388 | ;
|
---|
| 1389 | "RTN","DGREG",29,0)
|
---|
| 1390 | ; after change:
|
---|
| 1391 | "RTN","DGREG",30,0)
|
---|
| 1392 | W !!
|
---|
| 1393 | "RTN","DGREG",31,0)
|
---|
| 1394 | N Y,DGREGY S DGREGY=1 D I DGREGY<0 G Q1
|
---|
| 1395 | "RTN","DGREG",32,0)
|
---|
| 1396 | . N DIC S DIC=2 ; Patient file
|
---|
| 1397 | "RTN","DGREG",33,0)
|
---|
| 1398 | . S DIC(0)="ALEQM" ; ask, laygo, echo, question, and multi-index
|
---|
| 1399 | "RTN","DGREG",34,0)
|
---|
| 1400 | . N DLAYGO S DLAYGO=2 ; override file access by user: allow laygo
|
---|
| 1401 | "RTN","DGREG",35,0)
|
---|
| 1402 | . I $G(DUZ("AG"))'="V" D ;adjust identifiers asked for VOE
|
---|
| 1403 | "RTN","DGREG",36,0)
|
---|
| 1404 | . . S DIC("DR")=".02;.03;994;.301///N;391///VISTA OFFICE EHR;1901///N;.09"
|
---|
| 1405 | "RTN","DGREG",37,0)
|
---|
| 1406 | . ;
|
---|
| 1407 | "RTN","DGREG",38,0)
|
---|
| 1408 | . D ^DIC ; Select Patient
|
---|
| 1409 | "RTN","DGREG",39,0)
|
---|
| 1410 | . ;
|
---|
| 1411 | "RTN","DGREG",40,0)
|
---|
| 1412 | . I Y<0 S DGREGY=-1 Q
|
---|
| 1413 | "RTN","DGREG",41,0)
|
---|
| 1414 | . K DIC("DR")
|
---|
| 1415 | "RTN","DGREG",42,0)
|
---|
| 1416 | . S (DFN,DA)=+Y
|
---|
| 1417 | "RTN","DGREG",43,0)
|
---|
| 1418 | . S DGNEW=$P(Y,"^",3) ; new patient?
|
---|
| 1419 | "RTN","DGREG",44,0)
|
---|
| 1420 | . N Y D PAUSE^DG10 ; prompt user before continuing
|
---|
| 1421 | "RTN","DGREG",45,0)
|
---|
| 1422 | . D BEGINREG(DFN) ; lock patient record
|
---|
| 1423 | "RTN","DGREG",46,0)
|
---|
| 1424 | ;
|
---|
| 1425 | "RTN","DGREG",47,0)
|
---|
| 1426 | ; ** end of VOE change 1 **
|
---|
| 1427 | "RTN","DGREG",48,0)
|
---|
| 1428 | ;
|
---|
| 1429 | "RTN","DGREG",49,0)
|
---|
| 1430 | ;; ask to continue if patient died - DG*5.3*563 - pjr 10/12/04
|
---|
| 1431 | "RTN","DGREG",50,0)
|
---|
| 1432 | S DOD="" I $G(DFN) S DOD=$P($G(^DPT(DFN,.35)),"^",1)
|
---|
| 1433 | "RTN","DGREG",51,0)
|
---|
| 1434 | I DOD S Y=DOD,DGPME=0 D DIED^DGPMV I DGPME K DFN,DGRPOUT G A
|
---|
| 1435 | "RTN","DGREG",52,0)
|
---|
| 1436 | ;
|
---|
| 1437 | "RTN","DGREG",53,0)
|
---|
| 1438 | D CIRN
|
---|
| 1439 | "RTN","DGREG",54,0)
|
---|
| 1440 | ;
|
---|
| 1441 | "RTN","DGREG",55,0)
|
---|
| 1442 | ; ** VOE change 2 of 4: DAOU/WCJ 2/1/2005,VA/CJS,WV/TOAD 1/5/2006 **
|
---|
| 1443 | "RTN","DGREG",56,0)
|
---|
| 1444 | ;
|
---|
| 1445 | "RTN","DGREG",57,0)
|
---|
| 1446 | I $G(DGNEW) D NEW^DGRP ; execute new patient DR string
|
---|
| 1447 | "RTN","DGREG",58,0)
|
---|
| 1448 | ;
|
---|
| 1449 | "RTN","DGREG",59,0)
|
---|
| 1450 | ; send CMOR query and display results only if VA agency code
|
---|
| 1451 | "RTN","DGREG",60,0)
|
---|
| 1452 | ;
|
---|
| 1453 | "RTN","DGREG",61,0)
|
---|
| 1454 | ; before change:
|
---|
| 1455 | "RTN","DGREG",62,0)
|
---|
| 1456 | ; I +$G(DGNEW) D
|
---|
| 1457 | "RTN","DGREG",63,0)
|
---|
| 1458 | ;
|
---|
| 1459 | "RTN","DGREG",64,0)
|
---|
| 1460 | ; after change:
|
---|
| 1461 | "RTN","DGREG",65,0)
|
---|
| 1462 | I $G(DGNEW),$G(DUZ("AG"))="V" D
|
---|
| 1463 | "RTN","DGREG",66,0)
|
---|
| 1464 | . ;
|
---|
| 1465 | "RTN","DGREG",67,0)
|
---|
| 1466 | . ; end of change
|
---|
| 1467 | "RTN","DGREG",68,0)
|
---|
| 1468 | . ;
|
---|
| 1469 | "RTN","DGREG",69,0)
|
---|
| 1470 | . ; query CMOR for Patient Record Flag Assignments if NEW patient and
|
---|
| 1471 | "RTN","DGREG",70,0)
|
---|
| 1472 | . ; display results.
|
---|
| 1473 | "RTN","DGREG",71,0)
|
---|
| 1474 | . I $$PRFQRY^DGPFAPI(DFN) D DISPPRF^DGPFAPI(DFN)
|
---|
| 1475 | "RTN","DGREG",72,0)
|
---|
| 1476 | ;
|
---|
| 1477 | "RTN","DGREG",73,0)
|
---|
| 1478 | ; before change:
|
---|
| 1479 | "RTN","DGREG",74,0)
|
---|
| 1480 | ; D ROMQRY
|
---|
| 1481 | "RTN","DGREG",75,0)
|
---|
| 1482 | ;
|
---|
| 1483 | "RTN","DGREG",76,0)
|
---|
| 1484 | ; after change:
|
---|
| 1485 | "RTN","DGREG",77,0)
|
---|
| 1486 | I $G(DUZ("AG"))="V" D ROMQRY
|
---|
| 1487 | "RTN","DGREG",78,0)
|
---|
| 1488 | ;
|
---|
| 1489 | "RTN","DGREG",79,0)
|
---|
| 1490 | ; ** end of VOE change 2 **
|
---|
| 1491 | "RTN","DGREG",80,0)
|
---|
| 1492 | ;
|
---|
| 1493 | "RTN","DGREG",81,0)
|
---|
| 1494 | D REGMU^VWUTIL ; Changes for Meaningful Use
|
---|
| 1495 | "RTN","DGREG",82,0)
|
---|
| 1496 | ;
|
---|
| 1497 | "RTN","DGREG",83,0)
|
---|
| 1498 | S (DGFC,CURR)=0
|
---|
| 1499 | "RTN","DGREG",84,0)
|
---|
| 1500 | D:'$G(DGNEW) WARN S DA=DFN,DGFC="^1",VET=$S($D(^DPT(DFN,"VET")):^("VET")'="Y",1:0)
|
---|
| 1501 | "RTN","DGREG",85,0)
|
---|
| 1502 | S %ZIS="N",IOP="HOME" D ^%ZIS S DGELVER=0 D EN^DGRPD I $D(DGRPOUT) D ENDREG($G(DFN)) D HL7A08^VAFCDD01 K DFN,DGRPOUT G A
|
---|
| 1503 | "RTN","DGREG",86,0)
|
---|
| 1504 | D HINQ^DG10
|
---|
| 1505 | "RTN","DGREG",87,0)
|
---|
| 1506 | I $D(^DIC(195.4,1,"UP")) I ^("UP") D ADM^RTQ3
|
---|
| 1507 | "RTN","DGREG",88,0)
|
---|
| 1508 | ;
|
---|
| 1509 | "RTN","DGREG",89,0)
|
---|
| 1510 | ; ** VOE change 3 of 4: DAOU/WCJ 2/1/2005,VA/CJS,WV/TOAD 1/5/2006 **
|
---|
| 1511 | "RTN","DGREG",90,0)
|
---|
| 1512 | ;
|
---|
| 1513 | "RTN","DGREG",91,0)
|
---|
| 1514 | ; send financial query only for VA agency code
|
---|
| 1515 | "RTN","DGREG",92,0)
|
---|
| 1516 | ;
|
---|
| 1517 | "RTN","DGREG",93,0)
|
---|
| 1518 | ; before change:
|
---|
| 1519 | "RTN","DGREG",94,0)
|
---|
| 1520 | ; D REG^IVMCQ($G(DFN)) ; send financial query
|
---|
| 1521 | "RTN","DGREG",95,0)
|
---|
| 1522 | ;
|
---|
| 1523 | "RTN","DGREG",96,0)
|
---|
| 1524 | ; after change:
|
---|
| 1525 | "RTN","DGREG",97,0)
|
---|
| 1526 | I $G(DUZ("AG"))="V" D REG^IVMCQ($G(DFN)) ; send financial query
|
---|
| 1527 | "RTN","DGREG",98,0)
|
---|
| 1528 | ;
|
---|
| 1529 | "RTN","DGREG",99,0)
|
---|
| 1530 | ; ** end of VOE change 3 **
|
---|
| 1531 | "RTN","DGREG",100,0)
|
---|
| 1532 | ;
|
---|
| 1533 | "RTN","DGREG",101,0)
|
---|
| 1534 | G A1
|
---|
| 1535 | "RTN","DGREG",102,0)
|
---|
| 1536 | ;
|
---|
| 1537 | "RTN","DGREG",103,0)
|
---|
| 1538 | RT I $D(^DIC(195.4,1,"UP")) I ^("UP") S $P(DGFC,U,1)=DIV D ADM^RTQ3
|
---|
| 1539 | "RTN","DGREG",104,0)
|
---|
| 1540 | Q
|
---|
| 1541 | "RTN","DGREG",105,0)
|
---|
| 1542 | ;
|
---|
| 1543 | "RTN","DGREG",106,0)
|
---|
| 1544 | A1 W !,"Do you want to ",$S(DGNEW:"enter",1:"edit")," Patient Data" S %=1 D YN^DICN D G H:'%,CK:%'=1 S DGRPV=0 D EN1^DGRP G Q:'$D(DA)
|
---|
| 1545 | "RTN","DGREG",107,0)
|
---|
| 1546 | .I +$G(DGNEW) Q
|
---|
| 1547 | "RTN","DGREG",108,0)
|
---|
| 1548 | .I $$ADD^DGADDUTL($G(DFN)) ;
|
---|
| 1549 | "RTN","DGREG",109,0)
|
---|
| 1550 | G CH
|
---|
| 1551 | "RTN","DGREG",110,0)
|
---|
| 1552 | PR W !!,"Is the patient currently being followed in a clinic for the same condition" S %=0 D YN^DICN G Q:%=-1
|
---|
| 1553 | "RTN","DGREG",111,0)
|
---|
| 1554 | I '% W !?4,$C(7),"Enter 'Y' if the patient is being followed in clinic for condition for which",!?6,"registered, 'N' if not." G PR
|
---|
| 1555 | "RTN","DGREG",112,0)
|
---|
| 1556 | S CURR=% G SEEN
|
---|
| 1557 | "RTN","DGREG",113,0)
|
---|
| 1558 | ;
|
---|
| 1559 | "RTN","DGREG",114,0)
|
---|
| 1560 | CK S DGEDCN=1 D ^DGRPC
|
---|
| 1561 | "RTN","DGREG",115,0)
|
---|
| 1562 | CH S X=$S('$D(^DPT(DFN,.36)):1,$P(^(.36),"^",1)']"":1,1:0),X1=$S('$D(^DPT(DFN,.32)):1,$P(^(.32),"^",3)']"":1,1:0) I 'X,'X1 G CH1
|
---|
| 1563 | "RTN","DGREG",116,0)
|
---|
| 1564 | CH1 S DA=DFN G PR:'$D(^DPT("ADA",1,DA)) W !!,"There is still an open disposition--register aborted.",$C(7),$C(7) G Q
|
---|
| 1565 | "RTN","DGREG",117,0)
|
---|
| 1566 | SEEN W !!,"Is the patient to be examined in the medical center today" S %=1 D YN^DICN S SEEN=% G:%<0 Q I %'>0 W !!,"Enter 'Y' if the patient is to be examined today, 'N' if not.",$C(7) G SEEN
|
---|
| 1567 | "RTN","DGREG",118,0)
|
---|
| 1568 | ABIL D ^DGREGG
|
---|
| 1569 | "RTN","DGREG",119,0)
|
---|
| 1570 | ENR ; next line appears to be dead code. left commented just to test. mli 4/28/94
|
---|
| 1571 | "RTN","DGREG",120,0)
|
---|
| 1572 | ;S DE=0 F I=0:0 S I=$O(^DPT(DA,"DE",I)) Q:'I I $P(^(I,0),"^",3)'?7N Q D PR:'DE S L=+$P($S($D(^SC(L,0)):^(0),1:""),"^",1)
|
---|
| 1573 | "RTN","DGREG",121,0)
|
---|
| 1574 | REG S (DIE,DIC)="^DPT("_DFN_",""DIS"",",%DT="PTEX",%DT("A")="Registration login date/time: NOW// "
|
---|
| 1575 | "RTN","DGREG",122,0)
|
---|
| 1576 | W !,%DT("A") R ANS:DTIME S:'$T ANS="^" S:ANS="" ANS="N" S X=ANS G Q:ANS="^" S DA(1)=DFN D CHK^DIE(2.101,.01,"E",X,.RESULT) G REG:RESULT="^"!('$D(RESULT)),PR3:'(RESULT#1) S Y=RESULT
|
---|
| 1577 | "RTN","DGREG",123,0)
|
---|
| 1578 | I (RESULT'="^") W " ("_RESULT(0)_")"
|
---|
| 1579 | "RTN","DGREG",124,0)
|
---|
| 1580 | S DINUM=9999999-RESULT
|
---|
| 1581 | "RTN","DGREG",125,0)
|
---|
| 1582 | S (DFN1,Y1)=DINUM,APD=Y I $D(^DPT(DFN,"DIS",Y1)) W !!,"You must enter a date that does not exist.",$C(7),$C(7) G REG
|
---|
| 1583 | "RTN","DGREG",126,0)
|
---|
| 1584 | G:$D(^DPT("ADA",1,DA)) CH1 L @(DIE_DINUM_")"):2 G:'$T MSG S:'($D(^DPT(DA(1),"DIS",0))#2) ^(0)="^2.101D^^" S DIC(0)="L",X=+Y D ^DIC
|
---|
| 1585 | "RTN","DGREG",127,0)
|
---|
| 1586 | ;
|
---|
| 1587 | "RTN","DGREG",128,0)
|
---|
| 1588 | ;SAVE OFF DATE/TIME OF REGISTRATION FOR HL7 V2.3 MESSAGING, IN VAFCDDT
|
---|
| 1589 | "RTN","DGREG",129,0)
|
---|
| 1590 | S VAFCDDT=X
|
---|
| 1591 | "RTN","DGREG",130,0)
|
---|
| 1592 | ;
|
---|
| 1593 | "RTN","DGREG",131,0)
|
---|
| 1594 | S DA=DFN1,DIE("NO^")="",DA(1)=DFN,DP=2.101,DR="1///"_$S(SEEN=2:2,CURR=1:1,1:0)_";Q;2"_$S(CURR=1:"///3",1:"")_";2.1;3//"_$S($P(^DG(43,1,"GL"),"^",2):"",1:"/")_$S($D(^DG(40.8,+$P(^DG(43,1,"GL"),"^",3),0)):$P(^(0),"^",1),1:"")_";4////"_DUZ
|
---|
| 1595 | "RTN","DGREG",132,0)
|
---|
| 1596 | ;
|
---|
| 1597 | "RTN","DGREG",133,0)
|
---|
| 1598 | ; ** VOE change 4 of 4: DAOU/JLG 2/7/2005,VA/CJS,WV/TOAD 1/5/2006 **
|
---|
| 1599 | "RTN","DGREG",134,0)
|
---|
| 1600 | ;
|
---|
| 1601 | "RTN","DGREG",135,0)
|
---|
| 1602 | ; for VOE or IHS agency codes, add the following:
|
---|
| 1603 | "RTN","DGREG",136,0)
|
---|
| 1604 | ; force TYPE OF CARE with ALL OTHER
|
---|
| 1605 | "RTN","DGREG",137,0)
|
---|
| 1606 | ;
|
---|
| 1607 | "RTN","DGREG",138,0)
|
---|
| 1608 | I $G(DUZ("AG"))="E"!($G(DUZ("AG"))="I") D
|
---|
| 1609 | "RTN","DGREG",139,0)
|
---|
| 1610 | . S DR="1///"_$S(SEEN=2:2,CURR=1:1,1:0)_";Q;2"_$S(CURR=1:"///3",1:"")_";2.1///5;3//"_$S($P(^DG(43,1,"GL"),"^",2):"",1:"/")_$S($D(^DG(40.8,+$P(^DG(43,1,"GL"),"^",3),0)):$P(^(0),"^",1),1:"")_";4////"_DUZ
|
---|
| 1611 | "RTN","DGREG",140,0)
|
---|
| 1612 | ;
|
---|
| 1613 | "RTN","DGREG",141,0)
|
---|
| 1614 | ; ** end of VOE change 4 **
|
---|
| 1615 | "RTN","DGREG",142,0)
|
---|
| 1616 | ;
|
---|
| 1617 | "RTN","DGREG",143,0)
|
---|
| 1618 | D EL K DIC("A") N DGNDLOCK S DGNDLOCK=DIE_DFN1_")" L +@DGNDLOCK:2 G:'$T MSG D ^DIE L -@DGNDLOCK
|
---|
| 1619 | "RTN","DGREG",144,0)
|
---|
| 1620 | I $D(DTOUT) D G Q
|
---|
| 1621 | "RTN","DGREG",145,0)
|
---|
| 1622 | .K DTOUT
|
---|
| 1623 | "RTN","DGREG",146,0)
|
---|
| 1624 | .N DA,DIK
|
---|
| 1625 | "RTN","DGREG",147,0)
|
---|
| 1626 | .S DA(1)=DFN,DA=DFN1,DIK="^DPT("_DFN_",""DIS"","
|
---|
| 1627 | "RTN","DGREG",148,0)
|
---|
| 1628 | .D ^DIK
|
---|
| 1629 | "RTN","DGREG",149,0)
|
---|
| 1630 | .W !!?5,"User Time-out. Required registration data could be missing."
|
---|
| 1631 | "RTN","DGREG",150,0)
|
---|
| 1632 | .W !,?5,"This registration has been deleted."
|
---|
| 1633 | "RTN","DGREG",151,0)
|
---|
| 1634 | ; check whether facility applying to (division) is inactive
|
---|
| 1635 | "RTN","DGREG",152,0)
|
---|
| 1636 | I '$$DIVCHK^DGREGFAC(DFN,DFN1) G CONT
|
---|
| 1637 | "RTN","DGREG",153,0)
|
---|
| 1638 | ASKDIV W !!?5,"The facility chosen either has no pointer to an Institution"
|
---|
| 1639 | "RTN","DGREG",154,0)
|
---|
| 1640 | W !?5,"file record or the Institution file record is inactive."
|
---|
| 1641 | "RTN","DGREG",155,0)
|
---|
| 1642 | W !?5,"Please choose another division."
|
---|
| 1643 | "RTN","DGREG",156,0)
|
---|
| 1644 | S DA=DFN1,DIE("NO^")="",DA(1)=DFN,DP=2.101,DR="3" D ^DIE
|
---|
| 1645 | "RTN","DGREG",157,0)
|
---|
| 1646 | I $$DIVCHK^DGREGFAC(DFN,DFN1) G ASKDIV
|
---|
| 1647 | "RTN","DGREG",158,0)
|
---|
| 1648 | CONT ; continue
|
---|
| 1649 | "RTN","DGREG",159,0)
|
---|
| 1650 | S DGXXXD=1 D EL^DGREGE I $P(^DPT(DFN,"DIS",DFN1,0),"^",3)=4 S DA=DFN,DIE="^DPT(",DR=".368;.369" D ^DIE S DIE="^DPT("_DFN_",""DIS"",",DA(1)=DFN,DA=DFN1
|
---|
| 1651 | "RTN","DGREG",160,0)
|
---|
| 1652 | S DA=DFN,DR="[DGREG]",DIE="^DPT(" D ^DIE K DIE("NO^")
|
---|
| 1653 | "RTN","DGREG",161,0)
|
---|
| 1654 | I $D(^DPT(DFN,"DIS",DFN1,2)),$P(^(2),"^",1)="Y" S DIE="^DPT(",DR="[DG EMPLOYER]",DA=DFN D ^DIE
|
---|
| 1655 | "RTN","DGREG",162,0)
|
---|
| 1656 | G ^DGREG0
|
---|
| 1657 | "RTN","DGREG",163,0)
|
---|
| 1658 | PR2 W !!,"You can only enter new registrations through this option.",$C(7),$C(7) G REG
|
---|
| 1659 | "RTN","DGREG",164,0)
|
---|
| 1660 | PR3 W !!,"Time is required to register the patient.",!!,$C(7),$C(7) G REG
|
---|
| 1661 | "RTN","DGREG",165,0)
|
---|
| 1662 | H W !?5,"Enter 'YES' to enter/edit registration data or 'NO' to continue." G A1
|
---|
| 1663 | "RTN","DGREG",166,0)
|
---|
| 1664 | Q K DG,DQ G Q1^DGREG0
|
---|
| 1665 | "RTN","DGREG",167,0)
|
---|
| 1666 | Q1 K DGIO,DGASKDEV,DGFC,DGCLRP,CURR,DGELVER,DGNEW Q
|
---|
| 1667 | "RTN","DGREG",168,0)
|
---|
| 1668 | EL S DR=DR_";13//" I $D(^DPT(DFN,.36)),$D(^DIC(8,+^(.36),0)) S DR=DR_$P(^(0),"^",1) Q
|
---|
| 1669 | "RTN","DGREG",169,0)
|
---|
| 1670 | S DR=DR_"HUMANITARIAN EMERGENCY" Q
|
---|
| 1671 | "RTN","DGREG",170,0)
|
---|
| 1672 | FEE S DGRPFEE=1 D DGREG K DGRPFEE G Q1
|
---|
| 1673 | "RTN","DGREG",171,0)
|
---|
| 1674 | ;
|
---|
| 1675 | "RTN","DGREG",172,0)
|
---|
| 1676 | WARN I $S('$D(^DPT(DFN,.1)):0,$P(^(.1),"^",1)']"":0,1:1) W !,$C(7),"***PATIENT IS CURRENTLY AN INPATIENT***",! H 2
|
---|
| 1677 | "RTN","DGREG",173,0)
|
---|
| 1678 | I $S('$D(^DPT(DFN,.107)):0,$P(^(.107),"^",1)']"":0,1:1) W !,$C(7),"***PATIENT IS CURRENTLY A LODGER***",! H 2
|
---|
| 1679 | "RTN","DGREG",174,0)
|
---|
| 1680 | Q
|
---|
| 1681 | "RTN","DGREG",175,0)
|
---|
| 1682 | MSG W !,"Another user is editing, try later ..." G Q
|
---|
| 1683 | "RTN","DGREG",176,0)
|
---|
| 1684 | ;
|
---|
| 1685 | "RTN","DGREG",177,0)
|
---|
| 1686 | BEGINREG(DFN) ;
|
---|
| 1687 | "RTN","DGREG",178,0)
|
---|
| 1688 | ;Description: This is called at the beginning of the registration process.
|
---|
| 1689 | "RTN","DGREG",179,0)
|
---|
| 1690 | ;Concurrent processes can check the lock to determine if the patient is
|
---|
| 1691 | "RTN","DGREG",180,0)
|
---|
| 1692 | ;currently being registered.
|
---|
| 1693 | "RTN","DGREG",181,0)
|
---|
| 1694 | ;
|
---|
| 1695 | "RTN","DGREG",182,0)
|
---|
| 1696 | Q:'$G(DFN) 0
|
---|
| 1697 | "RTN","DGREG",183,0)
|
---|
| 1698 | I $$QRY^DGENQRY(DFN) W !!,"Enrollment/Eligibility Query sent ...",!!
|
---|
| 1699 | "RTN","DGREG",184,0)
|
---|
| 1700 | L +^TMP(DFN,"REGISTRATION IN PROGRESS"):1
|
---|
| 1701 | "RTN","DGREG",185,0)
|
---|
| 1702 | I $$LOCK^DGENPTA1(DFN) ;try to lock the patient record
|
---|
| 1703 | "RTN","DGREG",186,0)
|
---|
| 1704 | Q
|
---|
| 1705 | "RTN","DGREG",187,0)
|
---|
| 1706 | ;
|
---|
| 1707 | "RTN","DGREG",188,0)
|
---|
| 1708 | ENDREG(DFN) ;
|
---|
| 1709 | "RTN","DGREG",189,0)
|
---|
| 1710 | ;Description: releases the lock obtained by calling BEGINREG.
|
---|
| 1711 | "RTN","DGREG",190,0)
|
---|
| 1712 | ;
|
---|
| 1713 | "RTN","DGREG",191,0)
|
---|
| 1714 | Q:'$G(DFN)
|
---|
| 1715 | "RTN","DGREG",192,0)
|
---|
| 1716 | L -^TMP(DFN,"REGISTRATION IN PROGRESS")
|
---|
| 1717 | "RTN","DGREG",193,0)
|
---|
| 1718 | D UNLOCK^DGENPTA1(DFN)
|
---|
| 1719 | "RTN","DGREG",194,0)
|
---|
| 1720 | Q
|
---|
| 1721 | "RTN","DGREG",195,0)
|
---|
| 1722 | ;
|
---|
| 1723 | "RTN","DGREG",196,0)
|
---|
| 1724 | IFREG(DFN) ;
|
---|
| 1725 | "RTN","DGREG",197,0)
|
---|
| 1726 | ;Description: tests whether the lock set by BEGINREG is set
|
---|
| 1727 | "RTN","DGREG",198,0)
|
---|
| 1728 | ;
|
---|
| 1729 | "RTN","DGREG",199,0)
|
---|
| 1730 | ;Input: DFN
|
---|
| 1731 | "RTN","DGREG",200,0)
|
---|
| 1732 | ;Output:
|
---|
| 1733 | "RTN","DGREG",201,0)
|
---|
| 1734 | ; Function Value = 1 if lock is set, 0 otherwise
|
---|
| 1735 | "RTN","DGREG",202,0)
|
---|
| 1736 | ;
|
---|
| 1737 | "RTN","DGREG",203,0)
|
---|
| 1738 | N RETURN
|
---|
| 1739 | "RTN","DGREG",204,0)
|
---|
| 1740 | Q:'$G(DFN) 0
|
---|
| 1741 | "RTN","DGREG",205,0)
|
---|
| 1742 | L +^TMP(DFN,"REGISTRATION IN PROGRESS"):1
|
---|
| 1743 | "RTN","DGREG",206,0)
|
---|
| 1744 | S RETURN='$T
|
---|
| 1745 | "RTN","DGREG",207,0)
|
---|
| 1746 | L -^TMP(DFN,"REGISTRATION IN PROGRESS")
|
---|
| 1747 | "RTN","DGREG",208,0)
|
---|
| 1748 | Q RETURN
|
---|
| 1749 | "RTN","DGREG",209,0)
|
---|
| 1750 | Q
|
---|
| 1751 | "RTN","DGREG",210,0)
|
---|
| 1752 | CIRN ;MPI QUERY
|
---|
| 1753 | "RTN","DGREG",211,0)
|
---|
| 1754 | ;check to see if CIRN PD/MPI is installed
|
---|
| 1755 | "RTN","DGREG",212,0)
|
---|
| 1756 | N X S X="MPIFAPI" X ^%ZOSF("TEST") Q:'$T
|
---|
| 1757 | "RTN","DGREG",213,0)
|
---|
| 1758 | K MPIFRTN
|
---|
| 1759 | "RTN","DGREG",214,0)
|
---|
| 1760 | D MPIQ^MPIFAPI(DFN)
|
---|
| 1761 | "RTN","DGREG",215,0)
|
---|
| 1762 | K MPIFRTN
|
---|
| 1763 | "RTN","DGREG",216,0)
|
---|
| 1764 | Q
|
---|
| 1765 | "RTN","DGREG",217,0)
|
---|
| 1766 | ROMQRY ;
|
---|
| 1767 | "RTN","DGREG",218,0)
|
---|
| 1768 | I +$G(DGNEW) D
|
---|
| 1769 | "RTN","DGREG",219,0)
|
---|
| 1770 | . ; query LST for Patient Demographic Information if NEW patient and
|
---|
| 1771 | "RTN","DGREG",220,0)
|
---|
| 1772 | . ; file into patient's record.
|
---|
| 1773 | "RTN","DGREG",221,0)
|
---|
| 1774 | . N A
|
---|
| 1775 | "RTN","DGREG",222,0)
|
---|
| 1776 | . I $$ROMQRY^DGROAPI(DFN) D
|
---|
| 1777 | "RTN","DGREG",223,0)
|
---|
| 1778 | . . ;display busy message to interactive users
|
---|
| 1779 | "RTN","DGREG",224,0)
|
---|
| 1780 | . .S DGMSG(1)="Data retrieval from LST site has been completed successfully"
|
---|
| 1781 | "RTN","DGREG",225,0)
|
---|
| 1782 | . .S DGMSG(2)="Thank you for your patience."
|
---|
| 1783 | "RTN","DGREG",226,0)
|
---|
| 1784 | . .D EN^DDIOL(.DGMSG) R A:5
|
---|
| 1785 | "RTN","DGREG",227,0)
|
---|
| 1786 | . E D
|
---|
| 1787 | "RTN","DGREG",228,0)
|
---|
| 1788 | . . ;display busy message to interactive users
|
---|
| 1789 | "RTN","DGREG",229,0)
|
---|
| 1790 | . .S DGMSG(1)="Data retrieval from LST site has not been successful."
|
---|
| 1791 | "RTN","DGREG",230,0)
|
---|
| 1792 | . .S DGMSG(2)="Please continue the Registration Process."
|
---|
| 1793 | "RTN","DGREG",231,0)
|
---|
| 1794 | . .D EN^DDIOL(.DGMSG) R A:5
|
---|
| 1795 | "RTN","DGREG",232,0)
|
---|
| 1796 | . ;
|
---|
| 1797 | "RTN","DGREG",233,0)
|
---|
| 1798 | Q
|
---|
| 1799 | "RTN","DGRP2")
|
---|
| 1800 | 0^8^B19865142
|
---|
| 1801 | "RTN","DGRP2",1,0)
|
---|
| 1802 | DGRP2 ;ALB/MRL,BRM - REGISTRATION SCREEN 2/CONTACT INFORMATION ; 11/7/12 12:41pm
|
---|
| 1803 | "RTN","DGRP2",2,0)
|
---|
| 1804 | ;;5.3;Registration;**415,545,638,677,760,634,VW1**;Aug 13, 1993;Build 18
|
---|
| 1805 | "RTN","DGRP2",3,0)
|
---|
| 1806 | ; Modified from FOIA VISTA,
|
---|
| 1807 | "RTN","DGRP2",4,0)
|
---|
| 1808 | ; Copyright (C) 2007 WorldVistA
|
---|
| 1809 | "RTN","DGRP2",5,0)
|
---|
| 1810 | ;
|
---|
| 1811 | "RTN","DGRP2",6,0)
|
---|
| 1812 | ; This program is free software; you can redistribute it and/or modify
|
---|
| 1813 | "RTN","DGRP2",7,0)
|
---|
| 1814 | ; it under the terms of the GNU General Public License as published by
|
---|
| 1815 | "RTN","DGRP2",8,0)
|
---|
| 1816 | ; the Free Software Foundation; either version 2 of the License, or
|
---|
| 1817 | "RTN","DGRP2",9,0)
|
---|
| 1818 | ; (at your option) any later version.
|
---|
| 1819 | "RTN","DGRP2",10,0)
|
---|
| 1820 | ;
|
---|
| 1821 | "RTN","DGRP2",11,0)
|
---|
| 1822 | ; This program is distributed in the hope that it will be useful,
|
---|
| 1823 | "RTN","DGRP2",12,0)
|
---|
| 1824 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
---|
| 1825 | "RTN","DGRP2",13,0)
|
---|
| 1826 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
---|
| 1827 | "RTN","DGRP2",14,0)
|
---|
| 1828 | ; GNU General Public License for more details.
|
---|
| 1829 | "RTN","DGRP2",15,0)
|
---|
| 1830 | ;
|
---|
| 1831 | "RTN","DGRP2",16,0)
|
---|
| 1832 | ; You should have received a copy of the GNU General Public License
|
---|
| 1833 | "RTN","DGRP2",17,0)
|
---|
| 1834 | ; along with this program; if not, write to the Free Software
|
---|
| 1835 | "RTN","DGRP2",18,0)
|
---|
| 1836 | ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
|
---|
| 1837 | "RTN","DGRP2",19,0)
|
---|
| 1838 | S DGRPS=2 D H^DGRPU F I=0,.24,57,1010.15 S DGRP(I)=$S($D(^DPT(DFN,I)):^(I),1:"")
|
---|
| 1839 | "RTN","DGRP2",20,0)
|
---|
| 1840 | S DGRPX=DGRP(0)
|
---|
| 1841 | "RTN","DGRP2",21,0)
|
---|
| 1842 | S (Z,DGRPW)=1 D WW^DGRPV W " Marital: " S Z=$S($D(^DIC(11,+$P(DGRPX,"^",5),0)):$E($P(^(0),"^",1),1,28),1:DGRPU),Z1=30 D WW1^DGRPV
|
---|
| 1843 | "RTN","DGRP2",22,0)
|
---|
| 1844 | ;S (Z,DGRPW)=1 D WW^DGRPV W " Sex: " S X=$P(DGRP(0),"^",2),Z=$S(X="M":"MALE",X="F":"FEMALE",1:DGRPU),Z1=31 D WW1^DGRPV
|
---|
| 1845 | "RTN","DGRP2",23,0)
|
---|
| 1846 | S DGD=$$DISP^DG1010P0(DGRP(0),11,0,1),DGNOCITY=DGUNK,DGD1=$$POINT^DG1010P0(DGRP(0),12,5,1,0,1)
|
---|
| 1847 | "RTN","DGRP2",24,0)
|
---|
| 1848 | W ?41,"POB: ",$E($S((DGNOCITY&DGUNK):"UNANSWERED",1:DGD_$S(($L(DGD)):", ",1:"")_DGD1),1,29)
|
---|
| 1849 | "RTN","DGRP2",25,0)
|
---|
| 1850 | ;S DGRPX=DGRP(0)
|
---|
| 1851 | "RTN","DGRP2",26,0)
|
---|
| 1852 | W !?4,"Religion: ",$S($D(^DIC(13,+$P(DGRPX,"^",8),0)):$P(^(0),"^",1),1:DGRPU),?41,"Father: ",$S($P(DGRP(.24),"^",1)]"":$E($P(DGRP(.24),"^",1),1,29),1:DGRPU)
|
---|
| 1853 | "RTN","DGRP2",27,0)
|
---|
| 1854 | S X=$P(DGRP(57),"^",4),X=$S(X']"":DGRPU,X="X":"NOT APPLICABLE",X=1:"PARA,",X=2:"QUAD,",X=3:"PARA,NON",1:"QUAD,NON"),X=$S("QP"[$E(X):X_"TRAUMATIC",1:X) W !?9,"SCI: ",X
|
---|
| 1855 | "RTN","DGRP2",28,0)
|
---|
| 1856 | W ?41,"Mother: ",$S($P(DGRP(.24),"^",2)]"":$E($P(DGRP(.24),"^",2),1,29),1:DGRPU)
|
---|
| 1857 | "RTN","DGRP2",29,0)
|
---|
| 1858 | W !,?35,"Mom's Maiden: ",$S($P(DGRP(.24),"^",3)]"":$E($P(DGRP(.24),"^",3),1,29),1:DGRPU)
|
---|
| 1859 | "RTN","DGRP2",30,0)
|
---|
| 1860 | W ! S Z=2 D WW^DGRPV W " Previous Care Date Location of Previous Care",!?4,"------------------ -------------------------" S DGRPX=DGRP(1010.15) I $P(DGRPX,"^",5)'="Y" S X="NONE INDICATED" W !?4,X,?28,X
|
---|
| 1861 | "RTN","DGRP2",31,0)
|
---|
| 1862 | E F I=1:1:4 S I1=$P(DGRPX,"^",I) X "I I#2 S Y=I1 X:Y]"""" ^DD(""DD"") W !?4,$S(Y]"""":Y,1:DGRPU)" I '(I#2) W ?28,$S($D(^DIC(4,+I1,0)):$P(^(0),"^",1),1:DGRPU)
|
---|
| 1863 | "RTN","DGRP2",32,0)
|
---|
| 1864 | ;
|
---|
| 1865 | "RTN","DGRP2",33,0)
|
---|
| 1866 | ; ** start of VOE change: DAOU,VA/CJS,WV/TOAD 1/5/2006 ** ;p634
|
---|
| 1867 | "RTN","DGRP2",34,0)
|
---|
| 1868 | ;
|
---|
| 1869 | "RTN","DGRP2",35,0)
|
---|
| 1870 | ; New VOE Patient fields
|
---|
| 1871 | "RTN","DGRP2",36,0)
|
---|
| 1872 | ;
|
---|
| 1873 | "RTN","DGRP2",37,0)
|
---|
| 1874 | ; insert 7 lines:
|
---|
| 1875 | "RTN","DGRP2",38,0)
|
---|
| 1876 | ;
|
---|
| 1877 | "RTN","DGRP2",39,0)
|
---|
| 1878 | I $G(DUZ("AG"))="E" D
|
---|
| 1879 | "RTN","DGRP2",40,0)
|
---|
| 1880 | . W !?4,"Veteran: ",$$GET1^DIQ(2,DFN,19902)
|
---|
| 1881 | "RTN","DGRP2",41,0)
|
---|
| 1882 | . W !,"Interpreter Language: "
|
---|
| 1883 | "RTN","DGRP2",42,0)
|
---|
| 1884 | . N IL S IL=""
|
---|
| 1885 | "RTN","DGRP2",43,0)
|
---|
| 1886 | . N I F I=1:1 S IL=$O(^DPT(DFN,19901,"B",IL)) Q:IL="" D
|
---|
| 1887 | "RTN","DGRP2",44,0)
|
---|
| 1888 | . . I I'=1 W ","
|
---|
| 1889 | "RTN","DGRP2",45,0)
|
---|
| 1890 | . . W $$GET1^DIQ(.85,IL,.01) ; modified by VEN/SMH 3121107 *VW1
|
---|
| 1891 | "RTN","DGRP2",46,0)
|
---|
| 1892 | ;
|
---|
| 1893 | "RTN","DGRP2",47,0)
|
---|
| 1894 | ; next three groups of lines have been conditionalized to only display
|
---|
| 1895 | "RTN","DGRP2",48,0)
|
---|
| 1896 | ; for VA agency code; also, refactored for clarity
|
---|
| 1897 | "RTN","DGRP2",49,0)
|
---|
| 1898 | ;
|
---|
| 1899 | "RTN","DGRP2",50,0)
|
---|
| 1900 | I $G(DUZ("AG"))="V" D
|
---|
| 1901 | "RTN","DGRP2",51,0)
|
---|
| 1902 | . W ! S Z=2 D WW^DGRPV
|
---|
| 1903 | "RTN","DGRP2",52,0)
|
---|
| 1904 | . W " Previous Care Date Location of Previous Care"
|
---|
| 1905 | "RTN","DGRP2",53,0)
|
---|
| 1906 | . W !?4,"------------------ -------------------------"
|
---|
| 1907 | "RTN","DGRP2",54,0)
|
---|
| 1908 | . S DGRPX=DGRP(1010.15)
|
---|
| 1909 | "RTN","DGRP2",55,0)
|
---|
| 1910 | . ;
|
---|
| 1911 | "RTN","DGRP2",56,0)
|
---|
| 1912 | . I $P(DGRPX,"^",5)'="Y" D
|
---|
| 1913 | "RTN","DGRP2",57,0)
|
---|
| 1914 | . . S X="NONE INDICATED"
|
---|
| 1915 | "RTN","DGRP2",58,0)
|
---|
| 1916 | . . W !?4,X,?28,X
|
---|
| 1917 | "RTN","DGRP2",59,0)
|
---|
| 1918 | . ;
|
---|
| 1919 | "RTN","DGRP2",60,0)
|
---|
| 1920 | . E F I=1:1:4 D
|
---|
| 1921 | "RTN","DGRP2",61,0)
|
---|
| 1922 | . . S I1=$P(DGRPX,"^",I)
|
---|
| 1923 | "RTN","DGRP2",62,0)
|
---|
| 1924 | . . X "I I#2 S Y=I1 X:Y]"""" ^DD(""DD"") W !?4,$S(Y]"""":Y,1:DGRPU)"
|
---|
| 1925 | "RTN","DGRP2",63,0)
|
---|
| 1926 | . . I '(I#2) W ?28,$S($D(^DIC(4,+I1,0)):$P(^(0),"^",1),1:DGRPU)
|
---|
| 1927 | "RTN","DGRP2",64,0)
|
---|
| 1928 | ;
|
---|
| 1929 | "RTN","DGRP2",65,0)
|
---|
| 1930 | ; ** end of VOE change **; p634
|
---|
| 1931 | "RTN","DGRP2",66,0)
|
---|
| 1932 | ;
|
---|
| 1933 | "RTN","DGRP2",67,0)
|
---|
| 1934 | W ! S Z=3 D WW^DGRPV W " Ethnicity: " D
|
---|
| 1935 | "RTN","DGRP2",68,0)
|
---|
| 1936 | .I '$O(^DPT(DFN,.06,0)) W "UNANSWERED" Q
|
---|
| 1937 | "RTN","DGRP2",69,0)
|
---|
| 1938 | .N NODE,NUM,ETHNIC
|
---|
| 1939 | "RTN","DGRP2",70,0)
|
---|
| 1940 | .S I=0
|
---|
| 1941 | "RTN","DGRP2",71,0)
|
---|
| 1942 | .F NUM=0:1 S I=+$O(^DPT(DFN,.06,I)) Q:'I D
|
---|
| 1943 | "RTN","DGRP2",72,0)
|
---|
| 1944 | ..S NODE=$G(^DPT(DFN,.06,I,0))
|
---|
| 1945 | "RTN","DGRP2",73,0)
|
---|
| 1946 | ..S X=$P($G(^DIC(10.2,+NODE,0)),"^",1)
|
---|
| 1947 | "RTN","DGRP2",74,0)
|
---|
| 1948 | ..S ETHNIC=$S(X="":"?????",1:X)
|
---|
| 1949 | "RTN","DGRP2",75,0)
|
---|
| 1950 | ..S X=$P($G(^DIC(10.3,+$P(NODE,"^",2),0)),"^",2)
|
---|
| 1951 | "RTN","DGRP2",76,0)
|
---|
| 1952 | ..S ETHNIC=ETHNIC_" ("_$S(X="":"?",1:X)_")"
|
---|
| 1953 | "RTN","DGRP2",77,0)
|
---|
| 1954 | ..I NUM S ETHNIC=", "_ETHNIC
|
---|
| 1955 | "RTN","DGRP2",78,0)
|
---|
| 1956 | ..I ($X+$L(ETHNIC))>IOM D W !?15
|
---|
| 1957 | "RTN","DGRP2",79,0)
|
---|
| 1958 | ...F S X=$P(ETHNIC," ",1)_" " Q:($X+$L(X))>IOM W X S ETHNIC=$P(ETHNIC," ",2,999)
|
---|
| 1959 | "RTN","DGRP2",80,0)
|
---|
| 1960 | ..W ETHNIC
|
---|
| 1961 | "RTN","DGRP2",81,0)
|
---|
| 1962 | W !?9,"Race: " D
|
---|
| 1963 | "RTN","DGRP2",82,0)
|
---|
| 1964 | .I '$O(^DPT(DFN,.02,0)) W "UNANSWERED" Q
|
---|
| 1965 | "RTN","DGRP2",83,0)
|
---|
| 1966 | .N NODE,NUM,RACE
|
---|
| 1967 | "RTN","DGRP2",84,0)
|
---|
| 1968 | .S I=0
|
---|
| 1969 | "RTN","DGRP2",85,0)
|
---|
| 1970 | .F NUM=0:1 S I=+$O(^DPT(DFN,.02,I)) Q:'I D
|
---|
| 1971 | "RTN","DGRP2",86,0)
|
---|
| 1972 | ..S NODE=$G(^DPT(DFN,.02,I,0))
|
---|
| 1973 | "RTN","DGRP2",87,0)
|
---|
| 1974 | ..S X=$P($G(^DIC(10,+NODE,0)),"^",1)
|
---|
| 1975 | "RTN","DGRP2",88,0)
|
---|
| 1976 | ..S RACE=$S(X="":"?????",1:X)
|
---|
| 1977 | "RTN","DGRP2",89,0)
|
---|
| 1978 | ..S X=$P($G(^DIC(10.3,+$P(NODE,"^",2),0)),"^",2)
|
---|
| 1979 | "RTN","DGRP2",90,0)
|
---|
| 1980 | ..S RACE=RACE_" ("_$S(X="":"?",1:X)_")"
|
---|
| 1981 | "RTN","DGRP2",91,0)
|
---|
| 1982 | ..I NUM S RACE=", "_RACE
|
---|
| 1983 | "RTN","DGRP2",92,0)
|
---|
| 1984 | ..I ($X+$L(RACE))>IOM D W !?15
|
---|
| 1985 | "RTN","DGRP2",93,0)
|
---|
| 1986 | ...F S X=$P(RACE," ",1)_" " Q:($X+$L(X))>IOM W X S RACE=$P(RACE," ",2,999)
|
---|
| 1987 | "RTN","DGRP2",94,0)
|
---|
| 1988 | ..W RACE
|
---|
| 1989 | "RTN","DGRP2",95,0)
|
---|
| 1990 | D GETS^DIQ(2,DFN_",",".351;.353;.354;.355","E","PDTHINFO")
|
---|
| 1991 | "RTN","DGRP2",96,0)
|
---|
| 1992 | W !!
|
---|
| 1993 | "RTN","DGRP2",97,0)
|
---|
| 1994 | W "<4> Date of Death Information"
|
---|
| 1995 | "RTN","DGRP2",98,0)
|
---|
| 1996 | W !,?5,"Date of Death: ",$G(PDTHINFO(2,DFN_",",.351,"E"))
|
---|
| 1997 | "RTN","DGRP2",99,0)
|
---|
| 1998 | W ?41,"Source of Notification: ",$G(PDTHINFO(2,DFN_",",.353,"E"))
|
---|
| 1999 | "RTN","DGRP2",100,0)
|
---|
| 2000 | W !,?5,"Updated Date/Time: ",$G(PDTHINFO(2,DFN_",",.354,"E"))
|
---|
| 2001 | "RTN","DGRP2",101,0)
|
---|
| 2002 | W ?41,"Last Edited By: ",$G(PDTHINFO(2,DFN_",",.355,"E")),!
|
---|
| 2003 | "RTN","DGRP2",102,0)
|
---|
| 2004 | K PDTHINFO
|
---|
| 2005 | "RTN","DGRP2",103,0)
|
---|
| 2006 | ;
|
---|
| 2007 | "RTN","DGRP2",104,0)
|
---|
| 2008 | ;Emergency Response Indicator
|
---|
| 2009 | "RTN","DGRP2",105,0)
|
---|
| 2010 | N DGEMRES S DGEMRES=$P($G(^DPT(DFN,.18)),"^")
|
---|
| 2011 | "RTN","DGRP2",106,0)
|
---|
| 2012 | S Z=5 D WW^DGRPV W " Emergency Response: "_$$EXTERNAL^DILFD(2,.181,,DGEMRES)
|
---|
| 2013 | "RTN","DGRP2",107,0)
|
---|
| 2014 | G ^DGRPP
|
---|
| 2015 | "RTN","DGRPD")
|
---|
| 2016 | 0^5^B87299590
|
---|
| 2017 | "RTN","DGRPD",1,0)
|
---|
| 2018 | DGRPD ;ALB/MRL/MLR/JAN/LBD/EG/BRM/JRC/BAJ-PATIENT INQUIRY (NEW) ; 11/5/12 1:01pm
|
---|
| 2019 | "RTN","DGRPD",2,0)
|
---|
| 2020 | ;;5.3;Registration;**109,124,121,57,161,149,286,358,436,445,489,498,506,513,518,550,545,568,585,677,703,688,634,VW1**;Aug 13, 1993;Build 18;WorldVistA 30-June-08
|
---|
| 2021 | "RTN","DGRPD",3,0)
|
---|
| 2022 | ;
|
---|
| 2023 | "RTN","DGRPD",4,0)
|
---|
| 2024 | ;Modified from FOIA VISTA,
|
---|
| 2025 | "RTN","DGRPD",5,0)
|
---|
| 2026 | ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
---|
| 2027 | "RTN","DGRPD",6,0)
|
---|
| 2028 | ;General Public License See attached copy of the License.
|
---|
| 2029 | "RTN","DGRPD",7,0)
|
---|
| 2030 | ;
|
---|
| 2031 | "RTN","DGRPD",8,0)
|
---|
| 2032 | ;This program is free software; you can redistribute it and/or modify
|
---|
| 2033 | "RTN","DGRPD",9,0)
|
---|
| 2034 | ;it under the terms of the GNU General Public License as published by
|
---|
| 2035 | "RTN","DGRPD",10,0)
|
---|
| 2036 | ;the Free Software Foundation; either version 2 of the License, or
|
---|
| 2037 | "RTN","DGRPD",11,0)
|
---|
| 2038 | ;(at your option) any later version.
|
---|
| 2039 | "RTN","DGRPD",12,0)
|
---|
| 2040 | ;
|
---|
| 2041 | "RTN","DGRPD",13,0)
|
---|
| 2042 | ;This program is distributed in the hope that it will be useful,
|
---|
| 2043 | "RTN","DGRPD",14,0)
|
---|
| 2044 | ;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
---|
| 2045 | "RTN","DGRPD",15,0)
|
---|
| 2046 | ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
---|
| 2047 | "RTN","DGRPD",16,0)
|
---|
| 2048 | ;GNU General Public License for more details.
|
---|
| 2049 | "RTN","DGRPD",17,0)
|
---|
| 2050 | ;
|
---|
| 2051 | "RTN","DGRPD",18,0)
|
---|
| 2052 | ;You should have received a copy of the GNU General Public License along
|
---|
| 2053 | "RTN","DGRPD",19,0)
|
---|
| 2054 | ;with this program; if not, write to the Free Software Foundation, Inc.,
|
---|
| 2055 | "RTN","DGRPD",20,0)
|
---|
| 2056 | ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
---|
| 2057 | "RTN","DGRPD",21,0)
|
---|
| 2058 | ;
|
---|
| 2059 | "RTN","DGRPD",22,0)
|
---|
| 2060 | ; *286* Newing variables X,Y in OKLINE subroutine
|
---|
| 2061 | "RTN","DGRPD",23,0)
|
---|
| 2062 | ; *358* If a patient is on a domiciliary ward, don't display MEANS
|
---|
| 2063 | "RTN","DGRPD",24,0)
|
---|
| 2064 | ; TEST required/Medication Copayment Exemption messages
|
---|
| 2065 | "RTN","DGRPD",25,0)
|
---|
| 2066 | ; *436* If an inpatient is not on a domiciliary ward, don't display
|
---|
| 2067 | "RTN","DGRPD",26,0)
|
---|
| 2068 | ; Medication Copayment Exemption message
|
---|
| 2069 | "RTN","DGRPD",27,0)
|
---|
| 2070 | ; *545* Add death information near the remarks field
|
---|
| 2071 | "RTN","DGRPD",28,0)
|
---|
| 2072 | ; *677* Added Emergency Response
|
---|
| 2073 | "RTN","DGRPD",29,0)
|
---|
| 2074 | ; *688* Modified to display Country and Foreign Address
|
---|
| 2075 | "RTN","DGRPD",30,0)
|
---|
| 2076 | ; *634* WV - Print the HRN in the CMOR line.
|
---|
| 2077 | "RTN","DGRPD",31,0)
|
---|
| 2078 | ; *VW1* VEN/SMH - Add display of Preliminary cause of death
|
---|
| 2079 | "RTN","DGRPD",32,0)
|
---|
| 2080 | SEL K DFN,DGRPOUT W ! S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC G Q:Y'>0 S DFN=+Y N Y W ! S DIR(0)="E" D ^DIR G SEL:$D(DTOUT)!($D(DUOUT)) D EN G SEL
|
---|
| 2081 | "RTN","DGRPD",33,0)
|
---|
| 2082 | EN ;call to display patient inquiry - input DFN
|
---|
| 2083 | "RTN","DGRPD",34,0)
|
---|
| 2084 | ;MPI/PD CHANGE
|
---|
| 2085 | "RTN","DGRPD",35,0)
|
---|
| 2086 | S DGCMOR="UNSPECIFIED",DGMPI=$G(^DPT(+DFN,"MPI"))
|
---|
| 2087 | "RTN","DGRPD",36,0)
|
---|
| 2088 | S DGLOCATN=$$FIND1^DIC(4,"","MX","`"_+$P(DGMPI,U,3)),DGLOCATN=$S(+DGLOCATN>0:$P($$NS^XUAF4(DGLOCATN),U),1:"NOT LISTED")
|
---|
| 2089 | "RTN","DGRPD",37,0)
|
---|
| 2090 | I $D(DGMPI),$D(DGLOCATN) S DGCMOR=$P(DGLOCATN,"^")
|
---|
| 2091 | "RTN","DGRPD",38,0)
|
---|
| 2092 | ;END MPI/PD CHANGE
|
---|
| 2093 | "RTN","DGRPD",39,0)
|
---|
| 2094 | K DGRPOUT,DGHOW S DGABBRV=$S($D(^DG(43,1,0)):+$P(^(0),"^",38),1:0),DGRPU="UNSPECIFIED" D DEM^VADPT,HDR^DGRPD1 F I=0,.11,.13,.121,.122,.31,.32,.36,.361,.141,.3 S DGRP(I)=$S($D(^DPT(DFN,I)):^(I),1:"")
|
---|
| 2095 | "RTN","DGRPD",40,0)
|
---|
| 2096 | S DGAD=.11,(DGA1,DGA2)=1 D A^DGRPU S DGTMPAD=0 I $P(DGRP(.121),"^",9)="Y" S DGTMPAD=$S('$P(DGRP(.121),"^",8):1,$P(DGRP(.121),"^",8)'<DT:1,1:0) I DGTMPAD S DGAD=.121,DGA1=1,DGA2=2 D A^DGRPU
|
---|
| 2097 | "RTN","DGRPD",41,0)
|
---|
| 2098 | W ?1,"Address: ",$S($D(DGA(1)):DGA(1),1:"NONE ON FILE"),?40,"Temporary: ",$S($D(DGA(2)):DGA(2),1:"NO TEMPORARY ADDRESS")
|
---|
| 2099 | "RTN","DGRPD",42,0)
|
---|
| 2100 | S I=2 F I1=0:0 S I=$O(DGA(I)) Q:I="" W:(I#2)!($X>50) !?9 W:'(I#2) ?48 W DGA(I)
|
---|
| 2101 | "RTN","DGRPD",43,0)
|
---|
| 2102 | S DGCC=+$P(DGRP(.11),U,7),DGST=+$P(DGRP(.11),U,5),DGCC=$S($D(^DIC(5,DGST,1,DGCC,0)):$E($P(^(0),U,1),1,20)_$S($P(^(0),U,3)]"":" ("_$P(^(0),U,3)_")",1:""),1:DGRPU)
|
---|
| 2103 | "RTN","DGRPD",44,0)
|
---|
| 2104 | N DGCNTRY,DGFORGN S DGCNTRY=$P(DGRP(.11),"^",10),DGFORGN=$$FORIEN^DGADDUTL(DGCNTRY) I 'DGFORGN W !?2,"County: ",DGCC
|
---|
| 2105 | "RTN","DGRPD",45,0)
|
---|
| 2106 | S X="NOT APPLICABLE" I DGTMPAD S Y=$P(DGRP(.121),U,7) X:Y]"" ^DD("DD") S X=$S(Y]"":Y,1:DGRPU)_"-",Y=$P(DGRP(.121),U,8) X:Y]"" ^DD("DD") S X=X_$S(Y]"":Y,1:DGRPU)
|
---|
| 2107 | "RTN","DGRPD",46,0)
|
---|
| 2108 | N DGSKIP S DGSKIP=$S(DGFORGN:"!,?42,""From/To: """,1:"?42,""From/To: """) ;WorldVistA Change ;04/03/2010
|
---|
| 2109 | "RTN","DGRPD",47,0)
|
---|
| 2110 | W @DGSKIP,X,!?3,"Phone: ",$S($P(DGRP(.13),U,1)]"":$P(DGRP(.13),U,1),1:DGRPU),?44,"Phone: ",$S('DGTMPAD:X,$P(DGRP(.121),U,10)]"":$P(DGRP(.121),U,10),1:DGRPU) K DGTMPADW
|
---|
| 2111 | "RTN","DGRPD",48,0)
|
---|
| 2112 | W !?2,"Office: ",$S($P(DGRP(.13),U,2)]"":$P(DGRP(.13),U,2),1:DGRPU)
|
---|
| 2113 | "RTN","DGRPD",49,0)
|
---|
| 2114 | W !?4,"Cell: ",$S($P(DGRP(.13),U,4)]"":$P(DGRP(.13),U,4),1:DGRPU)
|
---|
| 2115 | "RTN","DGRPD",50,0)
|
---|
| 2116 | W !?2,"E-mail: ",$S($P(DGRP(.13),U,3)]"":$P(DGRP(.13),U,3),1:DGRPU)
|
---|
| 2117 | "RTN","DGRPD",51,0)
|
---|
| 2118 | W !,"Bad Addr: ",$$EXTERNAL^DILFD(2,.121,"",$$BADADR^DGUTL3(+DFN))
|
---|
| 2119 | "RTN","DGRPD",52,0)
|
---|
| 2120 | D CA
|
---|
| 2121 | "RTN","DGRPD",53,0)
|
---|
| 2122 | N DGEMER S DGEMER=$$EXTERNAL^DILFD(2,.181,"",$P($G(^DPT(DFN,.18)),"^"))
|
---|
| 2123 | "RTN","DGRPD",54,0)
|
---|
| 2124 | W:DGEMER]"" !?32,"Emergency Response: ",DGEMER
|
---|
| 2125 | "RTN","DGRPD",55,0)
|
---|
| 2126 | I 'DGABBRV W !!?4,"POS: ",$S($D(^DIC(21,+$P(DGRP(.32),"^",3),0)):$P(^(0),"^",1),1:DGRPU),?42,"Claim #: ",$S($P(DGRP(.31),"^",3)]"":$P(DGRP(.31),"^",3),1:"UNSPECIFIED")
|
---|
| 2127 | "RTN","DGRPD",56,0)
|
---|
| 2128 | I 'DGABBRV W !?2,"Relig: ",$S($D(^DIC(13,+$P(DGRP(0),"^",8),0)):$P(^(0),"^",1),1:DGRPU),?46,"Sex: ",$S($P(VADM(5),"^",2)]"":$P(VADM(5),"^",2),1:"UNSPECIFIED")
|
---|
| 2129 | "RTN","DGRPD",57,0)
|
---|
| 2130 | I 'DGABBRV W ! D
|
---|
| 2131 | "RTN","DGRPD",58,0)
|
---|
| 2132 | .N RACE,ETHNIC,PTR,VAL,X,DIWL,DIWR,DIWF
|
---|
| 2133 | "RTN","DGRPD",59,0)
|
---|
| 2134 | .K ^UTILITY($J,"W")
|
---|
| 2135 | "RTN","DGRPD",60,0)
|
---|
| 2136 | .S PTR=0 F S PTR=+$O(^DPT(DFN,.02,PTR)) Q:'PTR D
|
---|
| 2137 | "RTN","DGRPD",61,0)
|
---|
| 2138 | ..S VAL=+$G(^DPT(DFN,.02,PTR,0))
|
---|
| 2139 | "RTN","DGRPD",62,0)
|
---|
| 2140 | ..Q:$$INACTIVE^DGUTL4(VAL,1)
|
---|
| 2141 | "RTN","DGRPD",63,0)
|
---|
| 2142 | ..S VAL=$$PTR2TEXT^DGUTL4(VAL,1) S:+$O(^DPT(DFN,.02,PTR)) VAL=VAL_", "
|
---|
| 2143 | "RTN","DGRPD",64,0)
|
---|
| 2144 | ..S X=VAL,DIWL=0,DIWR=30,DIWF="" D ^DIWP
|
---|
| 2145 | "RTN","DGRPD",65,0)
|
---|
| 2146 | .M RACE=^UTILITY($J,"W",0) S:$G(RACE(1,0))="" RACE(1,0)="UNANSWERED"
|
---|
| 2147 | "RTN","DGRPD",66,0)
|
---|
| 2148 | .K ^UTILITY($J,"W")
|
---|
| 2149 | "RTN","DGRPD",67,0)
|
---|
| 2150 | .S PTR=0 F S PTR=+$O(^DPT(DFN,.06,PTR)) Q:'PTR D
|
---|
| 2151 | "RTN","DGRPD",68,0)
|
---|
| 2152 | ..S VAL=+$G(^DPT(DFN,.06,PTR,0))
|
---|
| 2153 | "RTN","DGRPD",69,0)
|
---|
| 2154 | ..Q:$$INACTIVE^DGUTL4(VAL,2)
|
---|
| 2155 | "RTN","DGRPD",70,0)
|
---|
| 2156 | ..S VAL=$$PTR2TEXT^DGUTL4(VAL,2) S:+$O(^DPT(DFN,.06,PTR)) VAL=VAL_", "
|
---|
| 2157 | "RTN","DGRPD",71,0)
|
---|
| 2158 | ..S X=VAL,DIWL=0,DIWR=30,DIWF="" D ^DIWP
|
---|
| 2159 | "RTN","DGRPD",72,0)
|
---|
| 2160 | .M ETHNIC=^UTILITY($J,"W",0) S:$G(ETHNIC(1,0))="" ETHNIC(1,0)="UNANSWERED"
|
---|
| 2161 | "RTN","DGRPD",73,0)
|
---|
| 2162 | .K ^UTILITY($J,"W")
|
---|
| 2163 | "RTN","DGRPD",74,0)
|
---|
| 2164 | .W ?3,"Race: ",RACE(1,0),?40,"Ethnicity: ",ETHNIC(1,0)
|
---|
| 2165 | "RTN","DGRPD",75,0)
|
---|
| 2166 | .F X=2:1 Q:'$D(RACE(X,0))&'$D(ETHNIC(X,0)) W !,?9,$G(RACE(X,0)),?51,$G(ETHNIC(X,0))
|
---|
| 2167 | "RTN","DGRPD",76,0)
|
---|
| 2168 | I '$$OKLINE^DGRPD1(16) G Q
|
---|
| 2169 | "RTN","DGRPD",77,0)
|
---|
| 2170 | ;display cv status #4156
|
---|
| 2171 | "RTN","DGRPD",78,0)
|
---|
| 2172 | ;Begin WorldVistA Change ;DG*5.3*634
|
---|
| 2173 | "RTN","DGRPD",79,0)
|
---|
| 2174 | I DUZ("AG")="V" D
|
---|
| 2175 | "RTN","DGRPD",80,0)
|
---|
| 2176 | . N DGCV S DGCV=$$CVEDT^DGCV(+DFN)
|
---|
| 2177 | "RTN","DGRPD",81,0)
|
---|
| 2178 | . W !!,?2,"Combat Vet Status: "_$S($P(DGCV,U,3)=1:"ELIGIBLE",$P(DGCV,U,3)="":"NOT ELIGIBLE",1:"EXPIRED") I DGCV>0 W ?45,"End Date: "_$$FMTE^XLFDT($P(DGCV,U,2),"5DZ")
|
---|
| 2179 | "RTN","DGRPD",82,0)
|
---|
| 2180 | ;End WorldVistA Change
|
---|
| 2181 | "RTN","DGRPD",83,0)
|
---|
| 2182 | ;display primary eligibility
|
---|
| 2183 | "RTN","DGRPD",84,0)
|
---|
| 2184 | S X1=DGRP(.36),X=$P(DGRP(.361),"^",1) W !,"Primary Eligibility: ",$S($D(^DIC(8,+X1,0)):$P(^(0),"^",1)_" ("_$S(X="V":"VERIFIED",X="P":"PENDING VERIFICATION",X="R":"PENDING REVERIFICATION",1:"NOT VERIFIED")_")",1:DGRPU)
|
---|
| 2185 | "RTN","DGRPD",85,0)
|
---|
| 2186 | W !,"Other Eligibilities: " F I=0:0 S I=$O(^DIC(8,I)) Q:'I I $D(^DIC(8,I,0)),I'=+X1 S X=$P(^(0),"^",1)_", " I $D(^DPT("AEL",DFN,I)) W:$X+$L(X)>79 !?21 W X
|
---|
| 2187 | "RTN","DGRPD",86,0)
|
---|
| 2188 | I '$$OKLINE^DGRPD1(16) G Q
|
---|
| 2189 | "RTN","DGRPD",87,0)
|
---|
| 2190 | ;employability status
|
---|
| 2191 | "RTN","DGRPD",88,0)
|
---|
| 2192 | W !?6,"Unemployable: ",$S($P(DGRP(.3),U,5)="Y":"YES",1:"NO")
|
---|
| 2193 | "RTN","DGRPD",89,0)
|
---|
| 2194 | ;display the catastrophic disability review date if there is one
|
---|
| 2195 | "RTN","DGRPD",90,0)
|
---|
| 2196 | D CATDIS^DGRPD1
|
---|
| 2197 | "RTN","DGRPD",91,0)
|
---|
| 2198 | I $G(DGPRFLG)=1 G Q:'$$OKLINE^DGRPD1(19) D
|
---|
| 2199 | "RTN","DGRPD",92,0)
|
---|
| 2200 | . N DGPDT,DGPTM
|
---|
| 2201 | "RTN","DGRPD",93,0)
|
---|
| 2202 | . W !,$$REPEAT^XLFSTR("-",78)
|
---|
| 2203 | "RTN","DGRPD",94,0)
|
---|
| 2204 | . S DGPDT="",DGPDT=$O(^DGS(41.41,"ADC",DFN,DGPDT),-1)
|
---|
| 2205 | "RTN","DGRPD",95,0)
|
---|
| 2206 | . W !,"[PRE-REGISTER DATE:] "_$S(DGPDT]"":$$FMTE^XLFDT(DGPDT,"1D"),1:"NONE ON FILE")
|
---|
| 2207 | "RTN","DGRPD",96,0)
|
---|
| 2208 | . S DGPTM=$$PCTEAM^DGSDUTL(DFN)
|
---|
| 2209 | "RTN","DGRPD",97,0)
|
---|
| 2210 | . I $P(DGPTM,U,2)]"" W !,"[PRIMARY CARE TEAM:] "_$P(DGPTM,U,2)
|
---|
| 2211 | "RTN","DGRPD",98,0)
|
---|
| 2212 | . W !,$$REPEAT^XLFSTR("-",78)
|
---|
| 2213 | "RTN","DGRPD",99,0)
|
---|
| 2214 | ; Check if patient is an inpatient and on a DOM ward
|
---|
| 2215 | "RTN","DGRPD",100,0)
|
---|
| 2216 | ; If inpatient is on a DOM ward, don't display MT or CP messages
|
---|
| 2217 | "RTN","DGRPD",101,0)
|
---|
| 2218 | ; If inpatient is NOT on a DOM ward, don't display CP message
|
---|
| 2219 | "RTN","DGRPD",102,0)
|
---|
| 2220 | N DGDOM,DGDOM1,VAHOW,VAROOT,VAINDT,VAIP,VAERR
|
---|
| 2221 | "RTN","DGRPD",103,0)
|
---|
| 2222 | G Q:'$$OKLINE^DGRPD1(14)
|
---|
| 2223 | "RTN","DGRPD",104,0)
|
---|
| 2224 | D DOM^DGMTR
|
---|
| 2225 | "RTN","DGRPD",105,0)
|
---|
| 2226 | I '$G(DGDOM) D
|
---|
| 2227 | "RTN","DGRPD",106,0)
|
---|
| 2228 | .D DIS^DGMTU(DFN)
|
---|
| 2229 | "RTN","DGRPD",107,0)
|
---|
| 2230 | .D IN5^VADPT
|
---|
| 2231 | "RTN","DGRPD",108,0)
|
---|
| 2232 | .I $G(VAIP(1))="" D DISP^IBARXEU(DFN,DT,3,1)
|
---|
| 2233 | "RTN","DGRPD",109,0)
|
---|
| 2234 | ;I 'DGABBRV,$E(IOST,1,2)="C-" F I=$Y:1:20 W !
|
---|
| 2235 | "RTN","DGRPD",110,0)
|
---|
| 2236 | D DIS^EASECU(DFN) ;Added for LTC III (DG*5.3*518)
|
---|
| 2237 | "RTN","DGRPD",111,0)
|
---|
| 2238 | S VAIP("L")=""
|
---|
| 2239 | "RTN","DGRPD",112,0)
|
---|
| 2240 | I $$OKLINE^DGRPD1(14) D INP
|
---|
| 2241 | "RTN","DGRPD",113,0)
|
---|
| 2242 | I '$G(DGRPOUT),($$OKLINE^DGRPD1(17)) D SA
|
---|
| 2243 | "RTN","DGRPD",114,0)
|
---|
| 2244 | ;MPI/PD CHANGE
|
---|
| 2245 | "RTN","DGRPD",115,0)
|
---|
| 2246 | Q D KVA^VADPT K %DT,D0,D1,DGA,DGA1,DGA2,DGABBRV,DGAD,DGCC,DGCMOR,DGDOM,DGLOCATN,DGMPI,DGRP,DGRPU,DGS,DGST,DGXFR0,DIC,DIR,DTOUT,DUOUT,DIRUT,DIROUT,I,I1,L,LDM,POP,SDCT,VA,X,X1,Y Q
|
---|
| 2247 | "RTN","DGRPD",116,0)
|
---|
| 2248 | CA ;Confidential Address
|
---|
| 2249 | "RTN","DGRPD",117,0)
|
---|
| 2250 | W !!?1,"Confidential Address: ",?44,"Confidential Address Categories:"
|
---|
| 2251 | "RTN","DGRPD",118,0)
|
---|
| 2252 | N DGCABEG,DGCAEND,DGA,DGARRAY,DGERROR
|
---|
| 2253 | "RTN","DGRPD",119,0)
|
---|
| 2254 | S DGCABEG=$P(DGRP(.141),U,7),DGCAEND=$P(DGRP(.141),U,8)
|
---|
| 2255 | "RTN","DGRPD",120,0)
|
---|
| 2256 | I 'DGCABEG!(DGCABEG>DT)!(DGCAEND&(DGCAEND<DT)) D Q
|
---|
| 2257 | "RTN","DGRPD",121,0)
|
---|
| 2258 | .W !?9,"NO CONFIDENTIAL ADDRESS"
|
---|
| 2259 | "RTN","DGRPD",122,0)
|
---|
| 2260 | .W !?1,"From/To: NOT APPLICABLE"
|
---|
| 2261 | "RTN","DGRPD",123,0)
|
---|
| 2262 | S DGAD=.141,(DGA1,DGA2)=1
|
---|
| 2263 | "RTN","DGRPD",124,0)
|
---|
| 2264 | D AL^DGRPU(30)
|
---|
| 2265 | "RTN","DGRPD",125,0)
|
---|
| 2266 | D GETS^DIQ(2,DFN,".141*,","E","DGARRAY","DGERROR")
|
---|
| 2267 | "RTN","DGRPD",126,0)
|
---|
| 2268 | ;Format Confidential Address categories
|
---|
| 2269 | "RTN","DGRPD",127,0)
|
---|
| 2270 | N DGIEN,DGCAST
|
---|
| 2271 | "RTN","DGRPD",128,0)
|
---|
| 2272 | S DGIEN=0
|
---|
| 2273 | "RTN","DGRPD",129,0)
|
---|
| 2274 | S DGA2=2
|
---|
| 2275 | "RTN","DGRPD",130,0)
|
---|
| 2276 | F S DGIEN=$O(DGARRAY(2.141,DGIEN)) Q:'DGIEN D
|
---|
| 2277 | "RTN","DGRPD",131,0)
|
---|
| 2278 | .S DGA(DGA2)=DGARRAY(2.141,DGIEN,.01,"E")
|
---|
| 2279 | "RTN","DGRPD",132,0)
|
---|
| 2280 | .S DGCAST=DGARRAY(2.141,DGIEN,1,"E")
|
---|
| 2281 | "RTN","DGRPD",133,0)
|
---|
| 2282 | .S DGA(DGA2)=DGA(DGA2)_"("_$S(DGCAST="YES":"Active",1:"Inactive")_")"
|
---|
| 2283 | "RTN","DGRPD",134,0)
|
---|
| 2284 | .S DGA2=DGA2+2
|
---|
| 2285 | "RTN","DGRPD",135,0)
|
---|
| 2286 | S I=0 F I1=0:0 S I=$O(DGA(I)) Q:I="" W:(I#2)!($X>43) !?9 W:'(I#2) ?44 W DGA(I)
|
---|
| 2287 | "RTN","DGRPD",136,0)
|
---|
| 2288 | W !?1,"From/To: ",$$FMTE^XLFDT(DGCABEG)_"-"_$S(DGCAEND'="":$$FMTE^XLFDT(DGCAEND),1:"UNANSWERED")
|
---|
| 2289 | "RTN","DGRPD",137,0)
|
---|
| 2290 | Q
|
---|
| 2291 | "RTN","DGRPD",138,0)
|
---|
| 2292 | INP S VAIP("D")="L" D INP^DGPMV10
|
---|
| 2293 | "RTN","DGRPD",139,0)
|
---|
| 2294 | S DGPMT=0
|
---|
| 2295 | "RTN","DGRPD",140,0)
|
---|
| 2296 | D CS^DGPMV10 K DGPMT,DGPMIFN K:'$D(DGSWITCH) DGPMVI,DGPMDCD Q
|
---|
| 2297 | "RTN","DGRPD",141,0)
|
---|
| 2298 | SA F I=0:0 S I=$O(^DGS(41.1,"B",DFN,I)) G CL:'I S X=^DGS(41.1,I,0) I $P(X,"^",2)>(DT-1),$P(X,"^",13)']"",'$P(X,"^",17) S L=$P(X,"^",2) D:$$OKLINE^DGRPD1(17) SAA Q:$G(DGRPOUT)
|
---|
| 2299 | "RTN","DGRPD",142,0)
|
---|
| 2300 | Q
|
---|
| 2301 | "RTN","DGRPD",143,0)
|
---|
| 2302 | SAA ;Scheduled Admit Data
|
---|
| 2303 | "RTN","DGRPD",144,0)
|
---|
| 2304 | W !!?14,"Scheduled Admit"
|
---|
| 2305 | "RTN","DGRPD",145,0)
|
---|
| 2306 | W:$D(^DIC(42,+$P(X,U,8),0)) " on ward "_$P(^(0),U)
|
---|
| 2307 | "RTN","DGRPD",146,0)
|
---|
| 2308 | W:$D(^DIC(45.7,+$P(X,U,9),0)) " for treating specialty "_$P(^(0),U)
|
---|
| 2309 | "RTN","DGRPD",147,0)
|
---|
| 2310 | W " on "_$$FMTE^XLFDT(L,"5DZ")
|
---|
| 2311 | "RTN","DGRPD",148,0)
|
---|
| 2312 | Q ;SAA
|
---|
| 2313 | "RTN","DGRPD",149,0)
|
---|
| 2314 | ;
|
---|
| 2315 | "RTN","DGRPD",150,0)
|
---|
| 2316 | CL G FA:$O(^DPT(DFN,"DE",0))="" S SDCT=0 F I=0:0 S I=$O(^DPT(DFN,"DE",I)) Q:'I I $D(^(I,0)),$P(^(0),"^",2)'="I",$O(^(0)) S SDCT=SDCT+1 W:SDCT=1 !!,"Currently enrolled in " W:$X>50 !?22 W $S($D(^SC(+^(0),0)):$P(^(0),"^",1)_", ",1:"")
|
---|
| 2317 | "RTN","DGRPD",151,0)
|
---|
| 2318 | ;
|
---|
| 2319 | "RTN","DGRPD",152,0)
|
---|
| 2320 | FA G:'$$OKLINE^DGRPD1(20) RMK
|
---|
| 2321 | "RTN","DGRPD",153,0)
|
---|
| 2322 | ;
|
---|
| 2323 | "RTN","DGRPD",154,0)
|
---|
| 2324 | N DGARRAY,SDCNT
|
---|
| 2325 | "RTN","DGRPD",155,0)
|
---|
| 2326 | S DGARRAY("FLDS")="1;2;3;18",DGARRAY(4)=DFN,DGARRAY(1)=DT,DGARRAY("SORT")="P"
|
---|
| 2327 | "RTN","DGRPD",156,0)
|
---|
| 2328 | S SDCNT=$$SDAPI^SDAMA301(.DGARRAY),CT=0 W !!,"Future Appointments: "
|
---|
| 2329 | "RTN","DGRPD",157,0)
|
---|
| 2330 | ;if there is lower subscripts hanging from the 101 node,
|
---|
| 2331 | "RTN","DGRPD",158,0)
|
---|
| 2332 | ;then it is a valid appointment, otherwise it is
|
---|
| 2333 | "RTN","DGRPD",159,0)
|
---|
| 2334 | ;an error eg 01/20/2005
|
---|
| 2335 | "RTN","DGRPD",160,0)
|
---|
| 2336 | I $D(^TMP($J,"SDAMA301",101))=1 W "Appointment Database is Unavailable" G RMK
|
---|
| 2337 | "RTN","DGRPD",161,0)
|
---|
| 2338 | I $O(^TMP($J,"SDAMA301",DFN,DT))'>0 W "NONE" G RMK
|
---|
| 2339 | "RTN","DGRPD",162,0)
|
---|
| 2340 | ;
|
---|
| 2341 | "RTN","DGRPD",163,0)
|
---|
| 2342 | W ?22,"Date",?33,"Time",?39,"Clinic",!?22 F I=22:1:75 W "="
|
---|
| 2343 | "RTN","DGRPD",164,0)
|
---|
| 2344 | F FA=DT:0 S FA=$O(^TMP($J,"SDAMA301",DFN,FA)) G RMK:'FA D Q:CT>5
|
---|
| 2345 | "RTN","DGRPD",165,0)
|
---|
| 2346 | .N STAT S STAT=$P($P(^TMP($J,"SDAMA301",DFN,FA),U,3),";")
|
---|
| 2347 | "RTN","DGRPD",166,0)
|
---|
| 2348 | .S C=+$P(^TMP($J,"SDAMA301",DFN,FA),U,2) I STAT'["C" D
|
---|
| 2349 | "RTN","DGRPD",167,0)
|
---|
| 2350 | ..D COV
|
---|
| 2351 | "RTN","DGRPD",168,0)
|
---|
| 2352 | ..N DGAPPT S DGAPPT=$$FMTE^XLFDT($E(FA,1,12),"5Z")
|
---|
| 2353 | "RTN","DGRPD",169,0)
|
---|
| 2354 | ..W !?22,$P(DGAPPT,"@"),?33,$P(DGAPPT,"@",2)
|
---|
| 2355 | "RTN","DGRPD",170,0)
|
---|
| 2356 | ..W ?39,$P($P(^TMP($J,"SDAMA301",DFN,FA),U,2),";",2)," ",COV
|
---|
| 2357 | "RTN","DGRPD",171,0)
|
---|
| 2358 | ..Q
|
---|
| 2359 | "RTN","DGRPD",172,0)
|
---|
| 2360 | I $O(^TMP($J,"SDAMA301",DFN,FA))>0 W !,"See Scheduling options for additional appointments."
|
---|
| 2361 | "RTN","DGRPD",173,0)
|
---|
| 2362 | RMK I '$G(DGRPOUT),($$OKLINE^DGRPD1(21)) W !!,"Remarks: ",$P(^DPT(DFN,0),"^",10)
|
---|
| 2363 | "RTN","DGRPD",174,0)
|
---|
| 2364 | D GETS^DIQ(2,DFN_",",".351;.353;.354;.355","E","PDTHINFO")
|
---|
| 2365 | "RTN","DGRPD",175,0)
|
---|
| 2366 | ;Begin WorldVistA change ;11-4-2012 SMH; *VW1*
|
---|
| 2367 | "RTN","DGRPD",176,0)
|
---|
| 2368 | N VWOK,VWDEATH ; Results of GETS1, Preliminary cause of death
|
---|
| 2369 | "RTN","DGRPD",177,0)
|
---|
| 2370 | S VWOK=$$GET1^DIQ(2,DFN_",",250043.1,"","VWDEATH")
|
---|
| 2371 | "RTN","DGRPD",178,0)
|
---|
| 2372 | ;End WorldVistA change
|
---|
| 2373 | "RTN","DGRPD",179,0)
|
---|
| 2374 | W !!
|
---|
| 2375 | "RTN","DGRPD",180,0)
|
---|
| 2376 | W "Date of Death Information"
|
---|
| 2377 | "RTN","DGRPD",181,0)
|
---|
| 2378 | W !,?5,"Date of Death: ",$G(PDTHINFO(2,DFN_",",.351,"E"))
|
---|
| 2379 | "RTN","DGRPD",182,0)
|
---|
| 2380 | W !,?5,"Source of Notification: ",$G(PDTHINFO(2,DFN_",",.353,"E"))
|
---|
| 2381 | "RTN","DGRPD",183,0)
|
---|
| 2382 | W !,?5,"Updated Date/Time: ",$G(PDTHINFO(2,DFN_",",.354,"E"))
|
---|
| 2383 | "RTN","DGRPD",184,0)
|
---|
| 2384 | W !,?5,"Last Edited By: ",$G(PDTHINFO(2,DFN_",",.355,"E")),!
|
---|
| 2385 | "RTN","DGRPD",185,0)
|
---|
| 2386 | ;Begin WorldVistA Change ;11-4-2012 SMH; *VW1*
|
---|
| 2387 | "RTN","DGRPD",186,0)
|
---|
| 2388 | W ?5,"Preliminary Cause of Death: ",!
|
---|
| 2389 | "RTN","DGRPD",187,0)
|
---|
| 2390 | I $O(VWDEATH(0)) D ; if we have data in the WP field
|
---|
| 2391 | "RTN","DGRPD",188,0)
|
---|
| 2392 | . N X,DIWL,DIWR,DIWF ; stuff value, LM, RM, Format control
|
---|
| 2393 | "RTN","DGRPD",189,0)
|
---|
| 2394 | . S DIWL=1,DIWR=$G(IOM,80) ; LM=1 ; RM=IOM or 80
|
---|
| 2395 | "RTN","DGRPD",190,0)
|
---|
| 2396 | . S DIWF="I7" ; Print text at the 7th column
|
---|
| 2397 | "RTN","DGRPD",191,0)
|
---|
| 2398 | . K ^UTILITY($J,"W") ; Kill scratch global for this
|
---|
| 2399 | "RTN","DGRPD",192,0)
|
---|
| 2400 | . N I S I=0 F S I=$O(VWDEATH(I)) Q:'I S X=VWDEATH(I) D ^DIWP
|
---|
| 2401 | "RTN","DGRPD",193,0)
|
---|
| 2402 | . D ^DIWW
|
---|
| 2403 | "RTN","DGRPD",194,0)
|
---|
| 2404 | . K ^UTILITY($J,"W") ; Kill scratch global again
|
---|
| 2405 | "RTN","DGRPD",195,0)
|
---|
| 2406 | ;End WorldVistA Change
|
---|
| 2407 | "RTN","DGRPD",196,0)
|
---|
| 2408 | I $$OKLINE^DGRPD1(14) D EC^DGRPD1
|
---|
| 2409 | "RTN","DGRPD",197,0)
|
---|
| 2410 | K DGARRAY,SDCNT,^TMP($J,"SDAMA301"),ADM,L,TRN,DIS,SSN,FA,C,COV,NOW,CT,DGD,DGD1,I ;Y killed after dghinqky
|
---|
| 2411 | "RTN","DGRPD",198,0)
|
---|
| 2412 | Q
|
---|
| 2413 | "RTN","DGRPD",199,0)
|
---|
| 2414 | COV S COV=$S(+$P(^TMP($J,"SDAMA301",DFN,FA),U,18)=7:" (Collateral) ",1:"")
|
---|
| 2415 | "RTN","DGRPD",200,0)
|
---|
| 2416 | S COV=COV_$S(STAT["NT":" * NO ACTION TAKEN *",STAT["N":" * NO-SHOW *",1:""),CT=CT+1 Q
|
---|
| 2417 | "RTN","DGRPD",201,0)
|
---|
| 2418 | Q
|
---|
| 2419 | "RTN","DGRPD",202,0)
|
---|
| 2420 | ;
|
---|
| 2421 | "RTN","DGRPD",203,0)
|
---|
| 2422 | OREN S XQORQUIT=1 Q:'$D(ORVP) S DFN=+ORVP D EN R !!,"Press RETURN to CONTINUE: ",X:DTIME
|
---|
| 2423 | "RTN","DGRPD",204,0)
|
---|
| 2424 | Q
|
---|
| 2425 | "RTN","DGRPD",205,0)
|
---|
| 2426 | ;Begin WorldVista Change ;DG*5.3*634
|
---|
| 2427 | "RTN","DGRPD",206,0)
|
---|
| 2428 | HDR I '$D(IOF) S IOP="HOME" D ^%ZIS K IOP
|
---|
| 2429 | "RTN","DGRPD",207,0)
|
---|
| 2430 | ;MPI/PD CHANGE
|
---|
| 2431 | "RTN","DGRPD",208,0)
|
---|
| 2432 | W @IOF,!,$P(VADM(1),"^",1),?32,$P(VADM(2),"^",2),?50,$$HRNV(DFN),?65,$P(VADM(3),"^",2) S X="",$P(X,"=",78)="" W !,X,!?15,"COORDINATING MASTER OF RECORD: ",DGCMOR,! Q
|
---|
| 2433 | "RTN","DGRPD",209,0)
|
---|
| 2434 | ;END MPI/PD CHANGE
|
---|
| 2435 | "RTN","DGRPD",210,0)
|
---|
| 2436 | HRNV(DFN) ;
|
---|
| 2437 | "RTN","DGRPD",211,0)
|
---|
| 2438 | N IRET
|
---|
| 2439 | "RTN","DGRPD",212,0)
|
---|
| 2440 | S IRET=$$HRN^DGLBPID(DFN)
|
---|
| 2441 | "RTN","DGRPD",213,0)
|
---|
| 2442 | I IRET="#" Q ""
|
---|
| 2443 | "RTN","DGRPD",214,0)
|
---|
| 2444 | S IRET="HRN "_IRET
|
---|
| 2445 | "RTN","DGRPD",215,0)
|
---|
| 2446 | Q IRET
|
---|
| 2447 | "RTN","DGRPD",216,0)
|
---|
| 2448 | ;End WorldVistA Change
|
---|
| 2449 | "RTN","ORCXPND1")
|
---|
| 2450 | 0^4^B74010927
|
---|
| 2451 | "RTN","ORCXPND1",1,0)
|
---|
| 2452 | ORCXPND1 ; SLC/MKB - Expanded Display cont ;6:25 PM 20 Jun 2011 ; 11/5/12 1:02pm
|
---|
| 2453 | "RTN","ORCXPND1",2,0)
|
---|
| 2454 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**26,67,75,89,92,94,148,159,188,172,215,243**;Dec 17, 1997;Build 18
|
---|
| 2455 | "RTN","ORCXPND1",3,0)
|
---|
| 2456 | ;
|
---|
| 2457 | "RTN","ORCXPND1",4,0)
|
---|
| 2458 | ; External References
|
---|
| 2459 | "RTN","ORCXPND1",5,0)
|
---|
| 2460 | ; DBIA 2387 ^LAB(60
|
---|
| 2461 | "RTN","ORCXPND1",6,0)
|
---|
| 2462 | ; DBIA 3420 ^DPT( file #2
|
---|
| 2463 | "RTN","ORCXPND1",7,0)
|
---|
| 2464 | ; DBIA 10035 ^DPT( file #2
|
---|
| 2465 | "RTN","ORCXPND1",8,0)
|
---|
| 2466 | ; DBIA 10037 EN^DGRPD
|
---|
| 2467 | "RTN","ORCXPND1",9,0)
|
---|
| 2468 | ; DBIA 700 DIS^DGRPDB
|
---|
| 2469 | "RTN","ORCXPND1",10,0)
|
---|
| 2470 | ; DBIA 2926 RT^GMRCGUIA
|
---|
| 2471 | "RTN","ORCXPND1",11,0)
|
---|
| 2472 | ; DBIA 2925 DT^GMRCSLM2 ^TMP("GMRCR"
|
---|
| 2473 | "RTN","ORCXPND1",12,0)
|
---|
| 2474 | ; DBIA 2503 RR^LR7OR1 ^TMP("LRRR"
|
---|
| 2475 | "RTN","ORCXPND1",13,0)
|
---|
| 2476 | ; DBIA 2951 EN1^LR7OSBR ^TMP("LRC"
|
---|
| 2477 | "RTN","ORCXPND1",14,0)
|
---|
| 2478 | ; DBIA 2952 EN^LR7OSMZ0
|
---|
| 2479 | "RTN","ORCXPND1",15,0)
|
---|
| 2480 | ; DBIA 2400 OEL^PSOORRL ^TMP("PS"
|
---|
| 2481 | "RTN","ORCXPND1",16,0)
|
---|
| 2482 | ; DBIA 2877 EN3^RAO7PC3
|
---|
| 2483 | "RTN","ORCXPND1",17,0)
|
---|
| 2484 | ; DBIA 2877 EN30^RAO7PC3
|
---|
| 2485 | "RTN","ORCXPND1",18,0)
|
---|
| 2486 | ; DBIA 1252 $$OUTPTPR^SDUTL3
|
---|
| 2487 | "RTN","ORCXPND1",19,0)
|
---|
| 2488 | ; DBIA 1252 $$OUTPTTM^SDUTL3
|
---|
| 2489 | "RTN","ORCXPND1",20,0)
|
---|
| 2490 | ; DBIA 2832 RPC^TIUSRV
|
---|
| 2491 | "RTN","ORCXPND1",21,0)
|
---|
| 2492 | ; DBIA 10061 DEM^VADPT
|
---|
| 2493 | "RTN","ORCXPND1",22,0)
|
---|
| 2494 | ; DBIA 10061 KVAR^VADPT
|
---|
| 2495 | "RTN","ORCXPND1",23,0)
|
---|
| 2496 | ; DBIA 10061 OAD^VADPT
|
---|
| 2497 | "RTN","ORCXPND1",24,0)
|
---|
| 2498 | ; DBIA 10103 $$FMTE^XLFDT
|
---|
| 2499 | "RTN","ORCXPND1",25,0)
|
---|
| 2500 | ; DBIA 4408 DISP^DGIBDSP
|
---|
| 2501 | "RTN","ORCXPND1",26,0)
|
---|
| 2502 | ;
|
---|
| 2503 | "RTN","ORCXPND1",27,0)
|
---|
| 2504 | COVER ; -- Cover Sheet
|
---|
| 2505 | "RTN","ORCXPND1",28,0)
|
---|
| 2506 | N PKG S PKG=$P($G(^TMP("OR",$J,ORTAB,"IDX",NUM)),U,4)
|
---|
| 2507 | "RTN","ORCXPND1",29,0)
|
---|
| 2508 | D ALLERGY^ORCXPND2:PKG="GMRA",NOTES:PKG="TIU"
|
---|
| 2509 | "RTN","ORCXPND1",30,0)
|
---|
| 2510 | Q
|
---|
| 2511 | "RTN","ORCXPND1",31,0)
|
---|
| 2512 | NOTES ; -- Progress Notes
|
---|
| 2513 | "RTN","ORCXPND1",32,0)
|
---|
| 2514 | N I,ORY,DATE,AUTHOR,PTLOC,SUBJ K ^TMP("TIUAUDIT",$J)
|
---|
| 2515 | "RTN","ORCXPND1",33,0)
|
---|
| 2516 | D RPC^TIUSRV(.ORY,ID)
|
---|
| 2517 | "RTN","ORCXPND1",34,0)
|
---|
| 2518 | S I=0 F S I=$O(@ORY@(I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$G(@ORY@(I,0))
|
---|
| 2519 | "RTN","ORCXPND1",35,0)
|
---|
| 2520 | K @ORY
|
---|
| 2521 | "RTN","ORCXPND1",36,0)
|
---|
| 2522 | Q
|
---|
| 2523 | "RTN","ORCXPND1",37,0)
|
---|
| 2524 | PROBLEMS ; -- Problem List
|
---|
| 2525 | "RTN","ORCXPND1",38,0)
|
---|
| 2526 | D PL^ORCXPND4
|
---|
| 2527 | "RTN","ORCXPND1",39,0)
|
---|
| 2528 | Q
|
---|
| 2529 | "RTN","ORCXPND1",40,0)
|
---|
| 2530 | MEDS ; -- Pharmacy
|
---|
| 2531 | "RTN","ORCXPND1",41,0)
|
---|
| 2532 | ;N NODE,ORIFN
|
---|
| 2533 | "RTN","ORCXPND1",42,0)
|
---|
| 2534 | K ^TMP("PS",$J)
|
---|
| 2535 | "RTN","ORCXPND1",43,0)
|
---|
| 2536 | D OEL^PSOORRL(+ORVP,ID) ;S NODE=$G(^TMP("PS",$J,0)),ORIFN=+$P(NODE,U,11)
|
---|
| 2537 | "RTN","ORCXPND1",44,0)
|
---|
| 2538 | S ID=+$P($G(^TMP("PS",$J,0)),U,11) D ORDERS ;DBIA 2400
|
---|
| 2539 | "RTN","ORCXPND1",45,0)
|
---|
| 2540 | ;D @($S($P($G(^OR(100,ORIFN,0)),U,11)=$O(^ORD(100.98,"B","IV RX",0)):"IV",1:"DRUG")_"^ORCXPND2")
|
---|
| 2541 | "RTN","ORCXPND1",46,0)
|
---|
| 2542 | K ^TMP("PS",$J)
|
---|
| 2543 | "RTN","ORCXPND1",47,0)
|
---|
| 2544 | Q
|
---|
| 2545 | "RTN","ORCXPND1",48,0)
|
---|
| 2546 | LABS ; -- Laboratory [RESULTS ONLY for ID=OE order #]
|
---|
| 2547 | "RTN","ORCXPND1",49,0)
|
---|
| 2548 | N ORIFN,X,SUB,TEST,NAME,SS,IDE,IVDT,TST,CCNT,ORCY,IG,TCNT
|
---|
| 2549 | "RTN","ORCXPND1",50,0)
|
---|
| 2550 | K ^TMP("LRRR",$J) ;DBIA 2503
|
---|
| 2551 | "RTN","ORCXPND1",51,0)
|
---|
| 2552 | I (ID?2.5U1" "2N1" "1.N1"-"7N1"."1.4N)!(ID?2.5U1" "2N1" "1.N1"-"7N) D AP^ORCXPND3 Q ;ID=Accession #-Date/time specimen taken
|
---|
| 2553 | "RTN","ORCXPND1",52,0)
|
---|
| 2554 | S ORIFN=+ID,IDE=$G(^OR(100,+ID,4)) Q:'$L(IDE) ; OE# -> Lab#
|
---|
| 2555 | "RTN","ORCXPND1",53,0)
|
---|
| 2556 | I +IDE D RR^LR7OR1(+ORVP,IDE) I '$D(^TMP("LRRR",$J,+ORVP)) S $P(IDE,";",1,3)=";;" ;Order possibly purged, reset to lookup on file 63
|
---|
| 2557 | "RTN","ORCXPND1",54,0)
|
---|
| 2558 | I '+IDE,$P(IDE,";",5) D RR^LR7OR1(+ORVP,,9999999-$P(IDE,";",5),9999999-$P(IDE,";",5),$P(IDE,";",4))
|
---|
| 2559 | "RTN","ORCXPND1",55,0)
|
---|
| 2560 | K ORCY D TEXT^ORQ12(.ORCY,ORIFN,80)
|
---|
| 2561 | "RTN","ORCXPND1",56,0)
|
---|
| 2562 | S IG=0 F S IG=$O(ORCY(IG)) Q:IG<1 S X=ORCY(IG) D ITEM^ORCXPND(X)
|
---|
| 2563 | "RTN","ORCXPND1",57,0)
|
---|
| 2564 | D BLANK^ORCXPND I '$D(^TMP("LRRR",$J,+ORVP)) S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="No data available." Q
|
---|
| 2565 | "RTN","ORCXPND1",58,0)
|
---|
| 2566 | M TEST=^TMP("LRRR",$J,+ORVP) S CCNT=0,SS=""
|
---|
| 2567 | "RTN","ORCXPND1",59,0)
|
---|
| 2568 | F S SS=$O(TEST(SS)) Q:SS="" S IVDT=0 F S IVDT=$O(TEST(SS,IVDT)) Q:'IVDT D
|
---|
| 2569 | "RTN","ORCXPND1",60,0)
|
---|
| 2570 | . I SS="BB" D
|
---|
| 2571 | "RTN","ORCXPND1",61,0)
|
---|
| 2572 | .. I $$GET^XPAR("DIV^SYS^PKG","OR VBECS ON",1,"Q"),$L($T(EN^ORWLR1)),$L($T(CPRS^VBECA3B)) D Q ;Transition to VBEC's interface
|
---|
| 2573 | "RTN","ORCXPND1",62,0)
|
---|
| 2574 | ... K ^TMP("ORLRC",$J)
|
---|
| 2575 | "RTN","ORCXPND1",63,0)
|
---|
| 2576 | ... D EN^ORWLR1(DFN)
|
---|
| 2577 | "RTN","ORCXPND1",64,0)
|
---|
| 2578 | ... I '$O(^TMP("ORLRC",$J,0)) S ^TMP("ORLRC",$J,1,0)="",^TMP("ORLRC",$J,2,0)="No Blood Bank report available..."
|
---|
| 2579 | "RTN","ORCXPND1",65,0)
|
---|
| 2580 | ... N I S I=0 F S I=$O(^TMP("ORLRC",$J,I)) Q:I<1 S X=^(I,0),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X
|
---|
| 2581 | "RTN","ORCXPND1",66,0)
|
---|
| 2582 | ... K ^TMP("ORLRC",$J)
|
---|
| 2583 | "RTN","ORCXPND1",67,0)
|
---|
| 2584 | .. K ^TMP("LRC",$J) D EN1^LR7OSBR(+ORVP) Q:'$D(^TMP("LRC",$J)) D Q ;DBIA 2951
|
---|
| 2585 | "RTN","ORCXPND1",68,0)
|
---|
| 2586 | ... N I S I=0 F S I=$O(^TMP("LRC",$J,I)) Q:I<1 S X=^(I,0),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X
|
---|
| 2587 | "RTN","ORCXPND1",69,0)
|
---|
| 2588 | ... K ^TMP("LRC",$J)
|
---|
| 2589 | "RTN","ORCXPND1",70,0)
|
---|
| 2590 | . I SS="MI" K ^TMP("LRC",$J) D EN^LR7OSMZ0(+ORVP) Q:'$D(^TMP("LRC",$J)) D Q
|
---|
| 2591 | "RTN","ORCXPND1",71,0)
|
---|
| 2592 | .. N I S I=0 F S I=$O(^TMP("LRC",$J,I)) Q:I<1 S X=^(I,0),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X
|
---|
| 2593 | "RTN","ORCXPND1",72,0)
|
---|
| 2594 | .. K ^TMP("LRC",$J)
|
---|
| 2595 | "RTN","ORCXPND1",73,0)
|
---|
| 2596 | . I SS="CH" D Q
|
---|
| 2597 | "RTN","ORCXPND1",74,0)
|
---|
| 2598 | .. S (TCNT,TST)=0 F S TST=$O(TEST(SS,IVDT,TST)) Q:TST="" S CCNT=0,TCNT=TCNT+1 D
|
---|
| 2599 | "RTN","ORCXPND1",75,0)
|
---|
| 2600 | ... I TCNT=1 D
|
---|
| 2601 | "RTN","ORCXPND1",76,0)
|
---|
| 2602 | .... S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" Collection time: "_$$FMTE^XLFDT(9999999-IVDT,1)
|
---|
| 2603 | "RTN","ORCXPND1",77,0)
|
---|
| 2604 | .... S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$$S(1,CCNT," ")_$$S(3,CCNT,"Test Name")_$$S(29,CCNT,"Result")_$$S(39,CCNT,"Units")_$$S(55,CCNT,"Range") D:$D(IOUON) SETVIDEO^ORCXPND(LCNT,1,70,IOUON,IOUOFF)
|
---|
| 2605 | "RTN","ORCXPND1",78,0)
|
---|
| 2606 | ... I TST S X=TEST(SS,IVDT,TST),CCNT=0 I +X D
|
---|
| 2607 | "RTN","ORCXPND1",79,0)
|
---|
| 2608 | .... S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$$S(1,CCNT,$P(^LAB(60,+X,0),U))_$$S(26,CCNT,$J($P(X,U,2),7))_$$S(34,CCNT,$S($L($P(X,U,3)):$P(X,U,3),1:""))_$$S(39,CCNT,$P(X,U,4))_$$S(45,CCNT,$J($P(X,U,5),15))
|
---|
| 2609 | "RTN","ORCXPND1",80,0)
|
---|
| 2610 | .... I $L($P(X,U,3)),$D(IOINHI) D SETVIDEO^ORCXPND(LCNT,26,8,IOINHI,IOINORM)
|
---|
| 2611 | "RTN","ORCXPND1",81,0)
|
---|
| 2612 | .... I $P(X,U,3)["*",$D(IOBON),$D(IOINHI) D SETVIDEO^ORCXPND(LCNT,26,8,IOBON_IOINHI,IOBOFF_IOINORM)
|
---|
| 2613 | "RTN","ORCXPND1",82,0)
|
---|
| 2614 | ... I TST="N" S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" Comments: " D
|
---|
| 2615 | "RTN","ORCXPND1",83,0)
|
---|
| 2616 | .... N CMT S CMT=0 F S CMT=$O(TEST(SS,IVDT,"N",CMT)) Q:'CMT S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" "_TEST(SS,IVDT,"N",CMT)
|
---|
| 2617 | "RTN","ORCXPND1",84,0)
|
---|
| 2618 | K ^TMP("LRRR",$J)
|
---|
| 2619 | "RTN","ORCXPND1",85,0)
|
---|
| 2620 | Q
|
---|
| 2621 | "RTN","ORCXPND1",86,0)
|
---|
| 2622 | ;
|
---|
| 2623 | "RTN","ORCXPND1",87,0)
|
---|
| 2624 | DELAY ; -- Delayed Orders
|
---|
| 2625 | "RTN","ORCXPND1",88,0)
|
---|
| 2626 | NEW ; -- New Orders
|
---|
| 2627 | "RTN","ORCXPND1",89,0)
|
---|
| 2628 | ORDERS ; -- Orders
|
---|
| 2629 | "RTN","ORCXPND1",90,0)
|
---|
| 2630 | I '$G(ORESULTS) D ORDERS^ORCXPND2 Q
|
---|
| 2631 | "RTN","ORCXPND1",91,0)
|
---|
| 2632 | ; -- Results Display (Add more packages as available)
|
---|
| 2633 | "RTN","ORCXPND1",92,0)
|
---|
| 2634 | N PKG,TAB,ORIFN
|
---|
| 2635 | "RTN","ORCXPND1",93,0)
|
---|
| 2636 | S PKG=+$P($G(^OR(100,+ID,0)),"^",14),PKG=$$NMSP^ORCD(PKG)
|
---|
| 2637 | "RTN","ORCXPND1",94,0)
|
---|
| 2638 | S TAB=$S(PKG="LR":"LABS",PKG="GMRC":"CONSULTS",PKG="RA":"XRAYS",1:"")
|
---|
| 2639 | "RTN","ORCXPND1",95,0)
|
---|
| 2640 | I '$L(TAB)!(ID'>0) D Q ; no display available
|
---|
| 2641 | "RTN","ORCXPND1",96,0)
|
---|
| 2642 | . N ORY,I D TEXT^ORQ12(.ORY,+ID,80)
|
---|
| 2643 | "RTN","ORCXPND1",97,0)
|
---|
| 2644 | . S I=0 F S I=$O(ORY(I)) Q:I'>0 D ITEM^ORCXPND(ORY(I))
|
---|
| 2645 | "RTN","ORCXPND1",98,0)
|
---|
| 2646 | . D BLANK^ORCXPND
|
---|
| 2647 | "RTN","ORCXPND1",99,0)
|
---|
| 2648 | . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="There are no results to report."
|
---|
| 2649 | "RTN","ORCXPND1",100,0)
|
---|
| 2650 | I $O(^OR(100,+ID,2,0)) S ORIFN=+ID,ID=0 F S ID=$O(^OR(100,ORIFN,2,ID)) Q:ID<1 I $D(^OR(100,ID,0)) D @TAB
|
---|
| 2651 | "RTN","ORCXPND1",101,0)
|
---|
| 2652 | I '$O(^OR(100,+ID,2,0)) D @TAB
|
---|
| 2653 | "RTN","ORCXPND1",102,0)
|
---|
| 2654 | Q
|
---|
| 2655 | "RTN","ORCXPND1",103,0)
|
---|
| 2656 | REPORTS ; -- Patient Profiles
|
---|
| 2657 | "RTN","ORCXPND1",104,0)
|
---|
| 2658 | D EN^ORCXPNDR ; Reports
|
---|
| 2659 | "RTN","ORCXPND1",105,0)
|
---|
| 2660 | Q
|
---|
| 2661 | "RTN","ORCXPND1",106,0)
|
---|
| 2662 | CONSULTS ; -- Consults
|
---|
| 2663 | "RTN","ORCXPND1",107,0)
|
---|
| 2664 | N I,X,SUB,ORTX ;,VALMAR
|
---|
| 2665 | "RTN","ORCXPND1",108,0)
|
---|
| 2666 | I $G(ORTAB)="CONSULTS" S X=$P($G(^TMP("OR",$J,ORTAB,"IDX",NUM)),U,4)
|
---|
| 2667 | "RTN","ORCXPND1",109,0)
|
---|
| 2668 | E D TEXT^ORQ12(.ORTX,+ID) S X=ORTX(1),ID=+$G(^OR(100,+ID,4)) ; OE->GMRC order#
|
---|
| 2669 | "RTN","ORCXPND1",110,0)
|
---|
| 2670 | D ITEM^ORCXPND(X),BLANK^ORCXPND
|
---|
| 2671 | "RTN","ORCXPND1",111,0)
|
---|
| 2672 | I ID'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="No data available." Q
|
---|
| 2673 | "RTN","ORCXPND1",112,0)
|
---|
| 2674 | I '$G(ORESULTS) D ;DT action
|
---|
| 2675 | "RTN","ORCXPND1",113,0)
|
---|
| 2676 | . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Consult No.: "_ID
|
---|
| 2677 | "RTN","ORCXPND1",114,0)
|
---|
| 2678 | . N GMRCOER S GMRCOER=2 D DT^GMRCSLM2(ID) S SUB="DT" ;DBIA 2925
|
---|
| 2679 | "RTN","ORCXPND1",115,0)
|
---|
| 2680 | I $G(ORESULTS) D RT^GMRCGUIA(ID,"^TMP(""GMRCR"",$J,""RT"")") S SUB="RT"
|
---|
| 2681 | "RTN","ORCXPND1",116,0)
|
---|
| 2682 | S I=0 F S I=$O(^TMP("GMRCR",$J,SUB,I)) Q:I'>0 S X=$G(^(I,0)),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X ;DBIA 2925
|
---|
| 2683 | "RTN","ORCXPND1",117,0)
|
---|
| 2684 | K ^TMP("GMRCR",$J)
|
---|
| 2685 | "RTN","ORCXPND1",118,0)
|
---|
| 2686 | Q
|
---|
| 2687 | "RTN","ORCXPND1",119,0)
|
---|
| 2688 | XRAYS ; -- Radiology
|
---|
| 2689 | "RTN","ORCXPND1",120,0)
|
---|
| 2690 | I '$G(ORESULTS) S ID=+ORVP_U_$TR(ID,"-","^") D EN3^RAO7PC3(ID)
|
---|
| 2691 | "RTN","ORCXPND1",121,0)
|
---|
| 2692 | I $G(ORESULTS) S ID=+$G(^OR(100,+ID,4)) D EN30^RAO7PC3(ID)
|
---|
| 2693 | "RTN","ORCXPND1",122,0)
|
---|
| 2694 | N CASE,PROC,PSET S PSET=$D(^TMP($J,"RAE3",+ORVP,"PRINT_SET"))
|
---|
| 2695 | "RTN","ORCXPND1",123,0)
|
---|
| 2696 | S CASE=0 F S CASE=$O(^TMP($J,"RAE3",+ORVP,CASE)) Q:CASE'>0 D
|
---|
| 2697 | "RTN","ORCXPND1",124,0)
|
---|
| 2698 | . I PSET S PROC=$O(^TMP($J,"RAE3",+ORVP,CASE,"")) D ITEM^ORCXPND(PROC) Q
|
---|
| 2699 | "RTN","ORCXPND1",125,0)
|
---|
| 2700 | . S PROC="" F S PROC=$O(^TMP($J,"RAE3",+ORVP,CASE,PROC)) Q:PROC="" D ITEM^ORCXPND(PROC),BLANK^ORCXPND,XRPT,BLANK^ORCXPND
|
---|
| 2701 | "RTN","ORCXPND1",126,0)
|
---|
| 2702 | I PSET S CASE=$O(^TMP($J,"RAE3",+ORVP,0)),PROC=$O(^(CASE,"")) D BLANK^ORCXPND,XRPT,BLANK^ORCXPND ;printset=list all procs, then one report
|
---|
| 2703 | "RTN","ORCXPND1",127,0)
|
---|
| 2704 | K ^TMP($J,"RAE3",+ORVP),^UTILITY($J,"W")
|
---|
| 2705 | "RTN","ORCXPND1",128,0)
|
---|
| 2706 | S VALM("RM")=81
|
---|
| 2707 | "RTN","ORCXPND1",129,0)
|
---|
| 2708 | Q
|
---|
| 2709 | "RTN","ORCXPND1",130,0)
|
---|
| 2710 | ;
|
---|
| 2711 | "RTN","ORCXPND1",131,0)
|
---|
| 2712 | XRPT ; -- Body of Report for CASE, PROC
|
---|
| 2713 | "RTN","ORCXPND1",132,0)
|
---|
| 2714 | N ORD,X,I
|
---|
| 2715 | "RTN","ORCXPND1",133,0)
|
---|
| 2716 | S ORD=$S($L($G(^TMP($J,"RAE3",+ORVP,"ORD"))):^("ORD"),$L($G(^("ORD",CASE))):^(CASE),1:"") I $L(ORD),ORD'=PROC S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Proc Ord: "_ORD
|
---|
| 2717 | "RTN","ORCXPND1",134,0)
|
---|
| 2718 | S I=1 F S I=$O(^TMP($J,"RAE3",+ORVP,CASE,PROC,I)) Q:I'>0 S X=^(I),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X ;Skip pt ID on line 1
|
---|
| 2719 | "RTN","ORCXPND1",135,0)
|
---|
| 2720 | Q
|
---|
| 2721 | "RTN","ORCXPND1",136,0)
|
---|
| 2722 | ;
|
---|
| 2723 | "RTN","ORCXPND1",137,0)
|
---|
| 2724 | SUMMRIES ; -- Discharge Summaries
|
---|
| 2725 | "RTN","ORCXPND1",138,0)
|
---|
| 2726 | N I,ORY,DATE,AUTHOR,PTLOC,SUBJ K ^TMP("TIUAUDIT",$J)
|
---|
| 2727 | "RTN","ORCXPND1",139,0)
|
---|
| 2728 | D RPC^TIUSRV(.ORY,ID)
|
---|
| 2729 | "RTN","ORCXPND1",140,0)
|
---|
| 2730 | S I=0 F S I=$O(@ORY@(I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$G(@ORY@(I,0))
|
---|
| 2731 | "RTN","ORCXPND1",141,0)
|
---|
| 2732 | K @ORY
|
---|
| 2733 | "RTN","ORCXPND1",142,0)
|
---|
| 2734 | Q
|
---|
| 2735 | "RTN","ORCXPND1",143,0)
|
---|
| 2736 | PTINQ ; Print Patient Inquiry in List Manager
|
---|
| 2737 | "RTN","ORCXPND1",144,0)
|
---|
| 2738 | N DFN,ORI,X
|
---|
| 2739 | "RTN","ORCXPND1",145,0)
|
---|
| 2740 | S DFN=+ORVP
|
---|
| 2741 | "RTN","ORCXPND1",146,0)
|
---|
| 2742 | D DGINQ(DFN)
|
---|
| 2743 | "RTN","ORCXPND1",147,0)
|
---|
| 2744 | S ORI=4,LCNT=0
|
---|
| 2745 | "RTN","ORCXPND1",148,0)
|
---|
| 2746 | F S ORI=$O(^TMP("ORDATA",$J,1,ORI)) Q:'ORI S X=^(ORI) D
|
---|
| 2747 | "RTN","ORCXPND1",149,0)
|
---|
| 2748 | . S LCNT=LCNT+1
|
---|
| 2749 | "RTN","ORCXPND1",150,0)
|
---|
| 2750 | . S ^TMP("ORXPND",$J,LCNT,0)=X
|
---|
| 2751 | "RTN","ORCXPND1",151,0)
|
---|
| 2752 | K ^TMP("ORDATA",$J,1)
|
---|
| 2753 | "RTN","ORCXPND1",152,0)
|
---|
| 2754 | Q
|
---|
| 2755 | "RTN","ORCXPND1",153,0)
|
---|
| 2756 | ;
|
---|
| 2757 | "RTN","ORCXPND1",154,0)
|
---|
| 2758 | DGINQ(DFN) ; Patient Inquiry
|
---|
| 2759 | "RTN","ORCXPND1",155,0)
|
---|
| 2760 | D START^ORWRP(80,"DGINQB^ORCXPND1(DFN)")
|
---|
| 2761 | "RTN","ORCXPND1",156,0)
|
---|
| 2762 | Q
|
---|
| 2763 | "RTN","ORCXPND1",157,0)
|
---|
| 2764 | DGINQB(DFN) ; Build Patient Inquiry
|
---|
| 2765 | "RTN","ORCXPND1",158,0)
|
---|
| 2766 | N CONTACT,ORDOC,ORTEAM,ORVP,XQORNOD,ORSSTRT,ORSSTOPT,VAOA
|
---|
| 2767 | "RTN","ORCXPND1",159,0)
|
---|
| 2768 | S ORVP=DFN_";DPT(",XQORNOD=1
|
---|
| 2769 | "RTN","ORCXPND1",160,0)
|
---|
| 2770 | D EN^DGRPD ; MAS Patient Inquiry
|
---|
| 2771 | "RTN","ORCXPND1",161,0)
|
---|
| 2772 | ;
|
---|
| 2773 | "RTN","ORCXPND1",162,0)
|
---|
| 2774 | S ORDOC=$$OUTPTPR^SDUTL3(DFN)
|
---|
| 2775 | "RTN","ORCXPND1",163,0)
|
---|
| 2776 | S ORTEAM=$$OUTPTTM^SDUTL3(DFN)
|
---|
| 2777 | "RTN","ORCXPND1",164,0)
|
---|
| 2778 | I ORDOC!ORTEAM D
|
---|
| 2779 | "RTN","ORCXPND1",165,0)
|
---|
| 2780 | . W !!,"Primary Care Information:"
|
---|
| 2781 | "RTN","ORCXPND1",166,0)
|
---|
| 2782 | . I ORDOC W !,"Primary Practitioner: ",$P(ORDOC,"^",2)
|
---|
| 2783 | "RTN","ORCXPND1",167,0)
|
---|
| 2784 | . I ORTEAM W !,"Primary Care Team: ",$P(ORTEAM,"^",2)
|
---|
| 2785 | "RTN","ORCXPND1",168,0)
|
---|
| 2786 | W !!,"Health Insurance Information:"
|
---|
| 2787 | "RTN","ORCXPND1",169,0)
|
---|
| 2788 | D DISP^DGIBDSP ;DBIA #4408
|
---|
| 2789 | "RTN","ORCXPND1",170,0)
|
---|
| 2790 | W !!,"Service Connection/Rated Disabilities:"
|
---|
| 2791 | "RTN","ORCXPND1",171,0)
|
---|
| 2792 | D DIS^DGRPDB
|
---|
| 2793 | "RTN","ORCXPND1",172,0)
|
---|
| 2794 | F CONTACT="N","S" D
|
---|
| 2795 | "RTN","ORCXPND1",173,0)
|
---|
| 2796 | .S VAOA("A")=$S(CONTACT="N":"",1:3)
|
---|
| 2797 | "RTN","ORCXPND1",174,0)
|
---|
| 2798 | .D OAD^VADPT ; Get NOK Information
|
---|
| 2799 | "RTN","ORCXPND1",175,0)
|
---|
| 2800 | .I VAOA(9)]"" D
|
---|
| 2801 | "RTN","ORCXPND1",176,0)
|
---|
| 2802 | .. W !!,$S(CONTACT="N":"Next of Kin Information:",1:"Secondary Next of Kin Information:")
|
---|
| 2803 | "RTN","ORCXPND1",177,0)
|
---|
| 2804 | .. W !,"Name: ",VAOA(9) ; NOK Name
|
---|
| 2805 | "RTN","ORCXPND1",178,0)
|
---|
| 2806 | .. I VAOA(10)]"" W " (",VAOA(10),")" ; Relationship
|
---|
| 2807 | "RTN","ORCXPND1",179,0)
|
---|
| 2808 | .. I VAOA(1)]"" W !?7,VAOA(1) ; Address Line 1
|
---|
| 2809 | "RTN","ORCXPND1",180,0)
|
---|
| 2810 | .. I VAOA(2)]"" W !?7,VAOA(2) ; Line 2
|
---|
| 2811 | "RTN","ORCXPND1",181,0)
|
---|
| 2812 | .. I VAOA(3)]"" W !?7,VAOA(3) ; Line 3
|
---|
| 2813 | "RTN","ORCXPND1",182,0)
|
---|
| 2814 | .. I VAOA(4)]"" D
|
---|
| 2815 | "RTN","ORCXPND1",183,0)
|
---|
| 2816 | .. . W !?7,VAOA(4) ; City
|
---|
| 2817 | "RTN","ORCXPND1",184,0)
|
---|
| 2818 | .. . I VAOA(5)]"" W ", "_$P(VAOA(5),"^",2) ; State
|
---|
| 2819 | "RTN","ORCXPND1",185,0)
|
---|
| 2820 | .. . W " ",$P(VAOA(11),"^",2) ; Zip+4
|
---|
| 2821 | "RTN","ORCXPND1",186,0)
|
---|
| 2822 | .. I VAOA(8)]"" W !!?7,"Phone number: ",VAOA(8) ; Phone
|
---|
| 2823 | "RTN","ORCXPND1",187,0)
|
---|
| 2824 | .. I CONTACT="N",$P($G(^DPT(DFN,.21)),U,11)]"" W !?7,"Work phone number: ",$P(^DPT(DFN,.21),U,11)
|
---|
| 2825 | "RTN","ORCXPND1",188,0)
|
---|
| 2826 | .. I CONTACT="S",$P($G(^DPT(DFN,.211)),U,11)]"" W !?7,"Work phone number: ",$P(^DPT(DFN,.211),U,11)
|
---|
| 2827 | "RTN","ORCXPND1",189,0)
|
---|
| 2828 | D ;Meaningful Use change
|
---|
| 2829 | "RTN","ORCXPND1",190,0)
|
---|
| 2830 | . W !?7,"Language Preference: ",$$GET1^DIQ(2,DFN_",",256000)
|
---|
| 2831 | "RTN","ORCXPND1",191,0)
|
---|
| 2832 | . I $D(DIERR) D CLEAN^DILF
|
---|
| 2833 | "RTN","ORCXPND1",192,0)
|
---|
| 2834 | . Q
|
---|
| 2835 | "RTN","ORCXPND1",193,0)
|
---|
| 2836 | D KVAR^VADPT
|
---|
| 2837 | "RTN","ORCXPND1",194,0)
|
---|
| 2838 | Q
|
---|
| 2839 | "RTN","ORCXPND1",195,0)
|
---|
| 2840 | TRIM(X) ; Trim Spaces
|
---|
| 2841 | "RTN","ORCXPND1",196,0)
|
---|
| 2842 | S X=$G(X) F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
|
---|
| 2843 | "RTN","ORCXPND1",197,0)
|
---|
| 2844 | F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
|
---|
| 2845 | "RTN","ORCXPND1",198,0)
|
---|
| 2846 | Q X
|
---|
| 2847 | "RTN","ORCXPND1",199,0)
|
---|
| 2848 | S(X,Y,Z) ; Pad Over
|
---|
| 2849 | "RTN","ORCXPND1",200,0)
|
---|
| 2850 | ; X=Column #
|
---|
| 2851 | "RTN","ORCXPND1",201,0)
|
---|
| 2852 | ; Y=Current Length
|
---|
| 2853 | "RTN","ORCXPND1",202,0)
|
---|
| 2854 | ; Z=Text
|
---|
| 2855 | "RTN","ORCXPND1",203,0)
|
---|
| 2856 | ; SP=Text Sent
|
---|
| 2857 | "RTN","ORCXPND1",204,0)
|
---|
| 2858 | ; CCNT=Line Position After Input Text
|
---|
| 2859 | "RTN","ORCXPND1",205,0)
|
---|
| 2860 | I '$D(Z) Q ""
|
---|
| 2861 | "RTN","ORCXPND1",206,0)
|
---|
| 2862 | N SP S SP=Z I X,Y,X>Y S SP=$E(" ",1,X-Y)_Z
|
---|
| 2863 | "RTN","ORCXPND1",207,0)
|
---|
| 2864 | S CCNT=$$INC(CCNT,SP)
|
---|
| 2865 | "RTN","ORCXPND1",208,0)
|
---|
| 2866 | Q SP
|
---|
| 2867 | "RTN","ORCXPND1",209,0)
|
---|
| 2868 | INC(X,Y) ; Character Position Count
|
---|
| 2869 | "RTN","ORCXPND1",210,0)
|
---|
| 2870 | ; X=Current Count
|
---|
| 2871 | "RTN","ORCXPND1",211,0)
|
---|
| 2872 | ; Y=Text
|
---|
| 2873 | "RTN","ORCXPND1",212,0)
|
---|
| 2874 | N INC S INC=X+$L(Y)
|
---|
| 2875 | "RTN","ORCXPND1",213,0)
|
---|
| 2876 | Q INC
|
---|
| 2877 | "RTN","VWREGPI")
|
---|
| 2878 | 0^^B187053
|
---|
| 2879 | "RTN","VWREGPI",1,0)
|
---|
| 2880 | VWREGPI ; VEN/SMH - VW MU REG 2.0 Post-install ; 11/5/12 12:51pm
|
---|
| 2881 | "RTN","VWREGPI",2,0)
|
---|
| 2882 | ;;2.0;VW MU REG;;Nov 05, 2012;Build 18
|
---|
| 2883 | "RTN","VWREGPI",3,0)
|
---|
| 2884 | ; Enter VW Local Registration Template into Site Parameters
|
---|
| 2885 | "RTN","VWREGPI",4,0)
|
---|
| 2886 | ; PEPs: POST
|
---|
| 2887 | "RTN","VWREGPI",5,0)
|
---|
| 2888 | ;
|
---|
| 2889 | "RTN","VWREGPI",6,0)
|
---|
| 2890 | POST ; Post install hook
|
---|
| 2891 | "RTN","VWREGPI",7,0)
|
---|
| 2892 | N DIE,DA,DR
|
---|
| 2893 | "RTN","VWREGPI",8,0)
|
---|
| 2894 | S DIE="^DG(43,",DA=1,DR="70///VW LOCAL REGISTRATION TEMPLATE"
|
---|
| 2895 | "RTN","VWREGPI",9,0)
|
---|
| 2896 | D ^DIE
|
---|
| 2897 | "RTN","VWREGPI",10,0)
|
---|
| 2898 | QUIT
|
---|
| 2899 | "RTN","VWUTIL")
|
---|
| 2900 | 0^3^B42164756
|
---|
| 2901 | "RTN","VWUTIL",1,0)
|
---|
| 2902 | VWUTIL ;WVEHR/Maury Pepper/Skip Ormsby- World VistA Utilities;11:37 AM 13 Apr 2011;;;; 11/5/12 1:21pm
|
---|
| 2903 | "RTN","VWUTIL",2,0)
|
---|
| 2904 | ;;1.0;WORLD VISTA;250001,250002;;Build 18
|
---|
| 2905 | "RTN","VWUTIL",3,0)
|
---|
| 2906 | ;
|
---|
| 2907 | "RTN","VWUTIL",4,0)
|
---|
| 2908 | ;Modified from FOIA VISTA,
|
---|
| 2909 | "RTN","VWUTIL",5,0)
|
---|
| 2910 | ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
---|
| 2911 | "RTN","VWUTIL",6,0)
|
---|
| 2912 | ;General Public License See attached copy of the License.
|
---|
| 2913 | "RTN","VWUTIL",7,0)
|
---|
| 2914 | ;
|
---|
| 2915 | "RTN","VWUTIL",8,0)
|
---|
| 2916 | ;This program is free software; you can redistribute it and/or modify
|
---|
| 2917 | "RTN","VWUTIL",9,0)
|
---|
| 2918 | ;it under the terms of the GNU General Public License as published by
|
---|
| 2919 | "RTN","VWUTIL",10,0)
|
---|
| 2920 | ;the Free Software Foundation; either version 2 of the License, or
|
---|
| 2921 | "RTN","VWUTIL",11,0)
|
---|
| 2922 | ;(at your option) any later version.
|
---|
| 2923 | "RTN","VWUTIL",12,0)
|
---|
| 2924 | ;
|
---|
| 2925 | "RTN","VWUTIL",13,0)
|
---|
| 2926 | ;This program is distributed in the hope that it will be useful,
|
---|
| 2927 | "RTN","VWUTIL",14,0)
|
---|
| 2928 | ;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
---|
| 2929 | "RTN","VWUTIL",15,0)
|
---|
| 2930 | ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
---|
| 2931 | "RTN","VWUTIL",16,0)
|
---|
| 2932 | ;GNU General Public License for more details.
|
---|
| 2933 | "RTN","VWUTIL",17,0)
|
---|
| 2934 | ;
|
---|
| 2935 | "RTN","VWUTIL",18,0)
|
---|
| 2936 | ;You should have received a copy of the GNU General Public License along
|
---|
| 2937 | "RTN","VWUTIL",19,0)
|
---|
| 2938 | ;with this program; if not, write to the Free Software Foundation, Inc.,
|
---|
| 2939 | "RTN","VWUTIL",20,0)
|
---|
| 2940 | ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
---|
| 2941 | "RTN","VWUTIL",21,0)
|
---|
| 2942 | ;
|
---|
| 2943 | "RTN","VWUTIL",22,0)
|
---|
| 2944 | Q
|
---|
| 2945 | "RTN","VWUTIL",23,0)
|
---|
| 2946 | ;*WVEHR - 250001*
|
---|
| 2947 | "RTN","VWUTIL",24,0)
|
---|
| 2948 | Q(V,D) ; Function to return $QUERY for variable V and direction D.
|
---|
| 2949 | "RTN","VWUTIL",25,0)
|
---|
| 2950 | ; Replacement for Reverse $Q Function
|
---|
| 2951 | "RTN","VWUTIL",26,0)
|
---|
| 2952 | ; 1/8/08 MLP
|
---|
| 2953 | "RTN","VWUTIL",27,0)
|
---|
| 2954 | ;This function can be called for $Query -- either forward or reverse.
|
---|
| 2955 | "RTN","VWUTIL",28,0)
|
---|
| 2956 | ;In place of $Q(V,D), use $$Q^ZDQ($NA(V),D)
|
---|
| 2957 | "RTN","VWUTIL",29,0)
|
---|
| 2958 | ;Note: the 2nd argument is optional.
|
---|
| 2959 | "RTN","VWUTIL",30,0)
|
---|
| 2960 | ;
|
---|
| 2961 | "RTN","VWUTIL",31,0)
|
---|
| 2962 | S D=+$G(D,1)
|
---|
| 2963 | "RTN","VWUTIL",32,0)
|
---|
| 2964 | Q:D=1 $Q(@V) ;Forward $Q
|
---|
| 2965 | "RTN","VWUTIL",33,0)
|
---|
| 2966 | IF D'=-1 Q ;Will cause error due to no argument.
|
---|
| 2967 | "RTN","VWUTIL",34,0)
|
---|
| 2968 | N S
|
---|
| 2969 | "RTN","VWUTIL",35,0)
|
---|
| 2970 | TOP IF $QL(V)=0 Q "" ;done if unsubscripted
|
---|
| 2971 | "RTN","VWUTIL",36,0)
|
---|
| 2972 | BKU S S=$O(@V,-1) ;backup to previous node on current level
|
---|
| 2973 | "RTN","VWUTIL",37,0)
|
---|
| 2974 | S V=$NA(@V,$QL(V)-1) ;remove last subscript
|
---|
| 2975 | "RTN","VWUTIL",38,0)
|
---|
| 2976 | IF S="" G DAT ;go chk for data if backed up all the way
|
---|
| 2977 | "RTN","VWUTIL",39,0)
|
---|
| 2978 | S V=$NA(@V@(S)) ;add the subscript found when backing up.
|
---|
| 2979 | "RTN","VWUTIL",40,0)
|
---|
| 2980 | IF $D(@V)>9 S V=$NA(@V@("")) G BKU ;if downpointer, descend and repeat
|
---|
| 2981 | "RTN","VWUTIL",41,0)
|
---|
| 2982 | DAT IF $D(@V)#2=1 Q V ;if a data node, return with current name
|
---|
| 2983 | "RTN","VWUTIL",42,0)
|
---|
| 2984 | G TOP
|
---|
| 2985 | "RTN","VWUTIL",43,0)
|
---|
| 2986 | ;
|
---|
| 2987 | "RTN","VWUTIL",44,0)
|
---|
| 2988 | ;*WVEHR 250002*
|
---|
| 2989 | "RTN","VWUTIL",45,0)
|
---|
| 2990 | DD2 ;Weston/SO Make certain Required Fields in Patient File NOT required
|
---|
| 2991 | "RTN","VWUTIL",46,0)
|
---|
| 2992 | ;06/30/2008
|
---|
| 2993 | "RTN","VWUTIL",47,0)
|
---|
| 2994 | ;Fields:
|
---|
| 2995 | "RTN","VWUTIL",48,0)
|
---|
| 2996 | ;SOCIAL SECURITY NUMBER(#.09)
|
---|
| 2997 | "RTN","VWUTIL",49,0)
|
---|
| 2998 | ;SERVICE CONNECTED?(#.301)
|
---|
| 2999 | "RTN","VWUTIL",50,0)
|
---|
| 3000 | ;TYPE(#391)
|
---|
| 3001 | "RTN","VWUTIL",51,0)
|
---|
| 3002 | ;VETERAN (Y/N)?(#1901)
|
---|
| 3003 | "RTN","VWUTIL",52,0)
|
---|
| 3004 | ;
|
---|
| 3005 | "RTN","VWUTIL",53,0)
|
---|
| 3006 | D DT^DICRW ;Make sure FM variables are set up
|
---|
| 3007 | "RTN","VWUTIL",54,0)
|
---|
| 3008 | F I="SOCIAL SECURITY NUMBER","SERVICE CONNECTED?","TYPE","VETERAN (Y/N)?" D
|
---|
| 3009 | "RTN","VWUTIL",55,0)
|
---|
| 3010 | .N FIELD S FIELD=+$O(^DD(2,"B",I,0)) Q:'FIELD ;Get field number
|
---|
| 3011 | "RTN","VWUTIL",56,0)
|
---|
| 3012 | .N X S X=$P(^DD(2,FIELD,0),U,2) ;Get field properties
|
---|
| 3013 | "RTN","VWUTIL",57,0)
|
---|
| 3014 | .S X=$TR(X,"R","") ;Remove the 'R'equired flag
|
---|
| 3015 | "RTN","VWUTIL",58,0)
|
---|
| 3016 | .S $P(^DD(2,FIELD,0),U,2)=X ;Re-Set field properties
|
---|
| 3017 | "RTN","VWUTIL",59,0)
|
---|
| 3018 | .K ^DD(2,"RQ",FIELD) ;Kill off the ReQuired Xref
|
---|
| 3019 | "RTN","VWUTIL",60,0)
|
---|
| 3020 | .S ^DD(2,FIELD,"DT")=DT ;Set the date Last Edited
|
---|
| 3021 | "RTN","VWUTIL",61,0)
|
---|
| 3022 | .;
|
---|
| 3023 | "RTN","VWUTIL",62,0)
|
---|
| 3024 | .;Re-Compile any Input Templates
|
---|
| 3025 | "RTN","VWUTIL",63,0)
|
---|
| 3026 | .D
|
---|
| 3027 | "RTN","VWUTIL",64,0)
|
---|
| 3028 | ..N IEN S IEN=0
|
---|
| 3029 | "RTN","VWUTIL",65,0)
|
---|
| 3030 | ..F S IEN=$O(^DIE("AF",2,FIELD,IEN)) Q:'IEN D
|
---|
| 3031 | "RTN","VWUTIL",66,0)
|
---|
| 3032 | ...N X,Y,DMAX
|
---|
| 3033 | "RTN","VWUTIL",67,0)
|
---|
| 3034 | ...I '$D(^DIE(IEN,"ROU")) Q ;Not compiled
|
---|
| 3035 | "RTN","VWUTIL",68,0)
|
---|
| 3036 | ...S X=^DIE(IEN,"ROU")
|
---|
| 3037 | "RTN","VWUTIL",69,0)
|
---|
| 3038 | ...I X="" Q ;No routine specified
|
---|
| 3039 | "RTN","VWUTIL",70,0)
|
---|
| 3040 | ...S X=$P(X,U,2),Y=IEN,DMAX=$$ROUSIZE^DILF
|
---|
| 3041 | "RTN","VWUTIL",71,0)
|
---|
| 3042 | ...D EN^DIEZ
|
---|
| 3043 | "RTN","VWUTIL",72,0)
|
---|
| 3044 | ...Q
|
---|
| 3045 | "RTN","VWUTIL",73,0)
|
---|
| 3046 | ..Q
|
---|
| 3047 | "RTN","VWUTIL",74,0)
|
---|
| 3048 | .;
|
---|
| 3049 | "RTN","VWUTIL",75,0)
|
---|
| 3050 | .;Re-Compile any Print Templates
|
---|
| 3051 | "RTN","VWUTIL",76,0)
|
---|
| 3052 | .D
|
---|
| 3053 | "RTN","VWUTIL",77,0)
|
---|
| 3054 | ..N IEN S IEN=0
|
---|
| 3055 | "RTN","VWUTIL",78,0)
|
---|
| 3056 | ..F S IEN=$O(^DIPT("AF",2,FIELD,IEN)) Q:'IEN D
|
---|
| 3057 | "RTN","VWUTIL",79,0)
|
---|
| 3058 | ...N X,Y,DMAX
|
---|
| 3059 | "RTN","VWUTIL",80,0)
|
---|
| 3060 | ...I '$D(^DIPT(IEN,"ROU")) Q ;Not compiled
|
---|
| 3061 | "RTN","VWUTIL",81,0)
|
---|
| 3062 | ...S X=^DIPT(IEN,"ROU")
|
---|
| 3063 | "RTN","VWUTIL",82,0)
|
---|
| 3064 | ...I X="" Q ;No routine specified
|
---|
| 3065 | "RTN","VWUTIL",83,0)
|
---|
| 3066 | ...S X=$P(X,U,2),Y=IEN,DMAX=$$ROUSIZE^DILF
|
---|
| 3067 | "RTN","VWUTIL",84,0)
|
---|
| 3068 | ...D EN^DIPZ
|
---|
| 3069 | "RTN","VWUTIL",85,0)
|
---|
| 3070 | ..Q
|
---|
| 3071 | "RTN","VWUTIL",86,0)
|
---|
| 3072 | .Q
|
---|
| 3073 | "RTN","VWUTIL",87,0)
|
---|
| 3074 | Q
|
---|
| 3075 | "RTN","VWUTIL",88,0)
|
---|
| 3076 | ;
|
---|
| 3077 | "RTN","VWUTIL",89,0)
|
---|
| 3078 | PMI ;Remove PMI values from file #50.68
|
---|
| 3079 | "RTN","VWUTIL",90,0)
|
---|
| 3080 | N %I
|
---|
| 3081 | "RTN","VWUTIL",91,0)
|
---|
| 3082 | S %I=0 F S %I=$O(^PSNDF(50.68,%I)) Q:%I'>0 S $P(^PSNDF(50.68,%I,1),"^",5,7)="^^"
|
---|
| 3083 | "RTN","VWUTIL",92,0)
|
---|
| 3084 | Q
|
---|
| 3085 | "RTN","VWUTIL",93,0)
|
---|
| 3086 | ;
|
---|
| 3087 | "RTN","VWUTIL",94,0)
|
---|
| 3088 | POSTM ;Multi-build clean up
|
---|
| 3089 | "RTN","VWUTIL",95,0)
|
---|
| 3090 | D DD2
|
---|
| 3091 | "RTN","VWUTIL",96,0)
|
---|
| 3092 | D PMI
|
---|
| 3093 | "RTN","VWUTIL",97,0)
|
---|
| 3094 | Q
|
---|
| 3095 | "RTN","VWUTIL",98,0)
|
---|
| 3096 | AMA1 ;Display the AMA Copyright for 1 second
|
---|
| 3097 | "RTN","VWUTIL",99,0)
|
---|
| 3098 | N VW S VW=0,VW=+$O(^ICPT(VW))
|
---|
| 3099 | "RTN","VWUTIL",100,0)
|
---|
| 3100 | I 'VW Q ;No CPT Codes
|
---|
| 3101 | "RTN","VWUTIL",101,0)
|
---|
| 3102 | N X W !,"CPT copyright AMA ",$E($$FMTE^XLFDT($$FMADD^XLFDT(DT,-365),7),1,4)," American Medical Association. All rights reserved."
|
---|
| 3103 | "RTN","VWUTIL",102,0)
|
---|
| 3104 | R X#1:1
|
---|
| 3105 | "RTN","VWUTIL",103,0)
|
---|
| 3106 | Q
|
---|
| 3107 | "RTN","VWUTIL",104,0)
|
---|
| 3108 | AMA10 ;Display the AMA Copyright for 10 seconds
|
---|
| 3109 | "RTN","VWUTIL",105,0)
|
---|
| 3110 | N VW S VW=0,VW=+$O(^ICPT(VW))
|
---|
| 3111 | "RTN","VWUTIL",106,0)
|
---|
| 3112 | I 'VW Q ;No CPT Codes
|
---|
| 3113 | "RTN","VWUTIL",107,0)
|
---|
| 3114 | N X W !,"CPT copyright AMA ",$E($$FMTE^XLFDT($$FMADD^XLFDT(DT,-365),7),1,4)," American Medical Association. All rights reserved."
|
---|
| 3115 | "RTN","VWUTIL",108,0)
|
---|
| 3116 | W !," Press any key to continue."
|
---|
| 3117 | "RTN","VWUTIL",109,0)
|
---|
| 3118 | R X#1:10
|
---|
| 3119 | "RTN","VWUTIL",110,0)
|
---|
| 3120 | Q
|
---|
| 3121 | "RTN","VWUTIL",111,0)
|
---|
| 3122 | ;
|
---|
| 3123 | "RTN","VWUTIL",112,0)
|
---|
| 3124 | DGRP1 ;Called from VW^DGRP1
|
---|
| 3125 | "RTN","VWUTIL",113,0)
|
---|
| 3126 | N DGLABEL S DGLABEL="^ Given^Middle^Prefix^Suffix^Degree" ; labels
|
---|
| 3127 | "RTN","VWUTIL",114,0)
|
---|
| 3128 | N DGCOMP S DGCOMP=+$G(^DPT(DFN,"NAME"))_"," ; Name Components fd (1.01)
|
---|
| 3129 | "RTN","VWUTIL",115,0)
|
---|
| 3130 | I DGCOMP D GETS^DIQ(20,DGCOMP,"1:6",,"DGCOMP") ; Name Components file
|
---|
| 3131 | "RTN","VWUTIL",116,0)
|
---|
| 3132 | ; loads Family (Last) Name (1), Given (First) Name (2),
|
---|
| 3133 | "RTN","VWUTIL",117,0)
|
---|
| 3134 | ; Middle Name (3), Prefix (4), Suffix (5), and Degree (6)
|
---|
| 3135 | "RTN","VWUTIL",118,0)
|
---|
| 3136 | ; field groups 1 & 2 part 3: load aliases
|
---|
| 3137 | "RTN","VWUTIL",119,0)
|
---|
| 3138 | N DGCOUNT S DGCOUNT=0 ; how many aliases do we find
|
---|
| 3139 | "RTN","VWUTIL",120,0)
|
---|
| 3140 | N DGALIAS S DGALIAS=0 ; IEN of Alias subfile (1/2.01) of Patient fl (2)
|
---|
| 3141 | "RTN","VWUTIL",121,0)
|
---|
| 3142 | ; and array of aliases found
|
---|
| 3143 | "RTN","VWUTIL",122,0)
|
---|
| 3144 | S DGALIAS=0 F D Q:'DGALIAS
|
---|
| 3145 | "RTN","VWUTIL",123,0)
|
---|
| 3146 | . ;
|
---|
| 3147 | "RTN","VWUTIL",124,0)
|
---|
| 3148 | . S DGALIAS=$O(^DPT(DFN,.01,DGALIAS))
|
---|
| 3149 | "RTN","VWUTIL",125,0)
|
---|
| 3150 | . Q:'DGALIAS ; out of alias subrecords
|
---|
| 3151 | "RTN","VWUTIL",126,0)
|
---|
| 3152 | . N DGNODE S DGNODE=$G(^DPT(DFN,.01,DGALIAS,0)) ; 0-node of subrecord
|
---|
| 3153 | "RTN","VWUTIL",127,0)
|
---|
| 3154 | . Q:'$L(DGNODE) ; bad node
|
---|
| 3155 | "RTN","VWUTIL",128,0)
|
---|
| 3156 | . ;
|
---|
| 3157 | "RTN","VWUTIL",129,0)
|
---|
| 3158 | . S DGCOUNT=DGCOUNT+1 ; another valid alias
|
---|
| 3159 | "RTN","VWUTIL",130,0)
|
---|
| 3160 | . I DGCOUNT=6 S DGALIAS=0 Q ; can't show > 5, need to know if 6 or >
|
---|
| 3161 | "RTN","VWUTIL",131,0)
|
---|
| 3162 | . ;
|
---|
| 3163 | "RTN","VWUTIL",132,0)
|
---|
| 3164 | . S DGALIAS(DGCOUNT)=$P(DGNODE,U) ; Alias fld (.01)
|
---|
| 3165 | "RTN","VWUTIL",133,0)
|
---|
| 3166 | . ;
|
---|
| 3167 | "RTN","VWUTIL",134,0)
|
---|
| 3168 | . N DGSSN S DGSSN=$P(DGNODE,U,2) ; Alias SSN fld (1)
|
---|
| 3169 | "RTN","VWUTIL",135,0)
|
---|
| 3170 | . I $L(DGSSN) D
|
---|
| 3171 | "RTN","VWUTIL",136,0)
|
---|
| 3172 | . . S DGSSN=" "_$E(DGSSN,1,3)_"-"_$E(DGSSN,4,5)_"-"_$E(DGSSN,6,10)
|
---|
| 3173 | "RTN","VWUTIL",137,0)
|
---|
| 3174 | . . ; incl leading space to separate from alias name
|
---|
| 3175 | "RTN","VWUTIL",138,0)
|
---|
| 3176 | . . ; incl 10 chars to allow for P of pseudo-SSNs
|
---|
| 3177 | "RTN","VWUTIL",139,0)
|
---|
| 3178 | . . S $E(DGALIAS(DGCOUNT),20)=DGSSN ; truncate alias name & append SSN
|
---|
| 3179 | "RTN","VWUTIL",140,0)
|
---|
| 3180 | . ;
|
---|
| 3181 | "RTN","VWUTIL",141,0)
|
---|
| 3182 | . S DGALIAS(DGCOUNT)=$E(DGALIAS(DGCOUNT),1,32) ; truncate alias
|
---|
| 3183 | "RTN","VWUTIL",142,0)
|
---|
| 3184 | ;
|
---|
| 3185 | "RTN","VWUTIL",143,0)
|
---|
| 3186 | I DGCOUNT=0 S DGALIAS(1)="< No alias entries on file >"
|
---|
| 3187 | "RTN","VWUTIL",144,0)
|
---|
| 3188 | I DGCOUNT=6 S DGALIAS(5)="< More alias entries on file >"
|
---|
| 3189 | "RTN","VWUTIL",145,0)
|
---|
| 3190 | K DGCOUNT
|
---|
| 3191 | "RTN","VWUTIL",146,0)
|
---|
| 3192 | ;
|
---|
| 3193 | "RTN","VWUTIL",147,0)
|
---|
| 3194 | ; field groups 1 & 2 part 4: show 1st name component, and IDs HRN & Sex
|
---|
| 3195 | "RTN","VWUTIL",148,0)
|
---|
| 3196 | W !?5,"Family: "
|
---|
| 3197 | "RTN","VWUTIL",149,0)
|
---|
| 3198 | W $E($G(DGCOMP(20,DGCOMP,1)),1,27)
|
---|
| 3199 | "RTN","VWUTIL",150,0)
|
---|
| 3200 | ;
|
---|
| 3201 | "RTN","VWUTIL",151,0)
|
---|
| 3202 | I "EI"[$G(DUZ("AG")),$G(DUZ(2)) D
|
---|
| 3203 | "RTN","VWUTIL",152,0)
|
---|
| 3204 | . N DGNODE S DGNODE=$G(^AUPNPAT(DFN,41,DUZ(2),0)) ; get 0-node for the
|
---|
| 3205 | "RTN","VWUTIL",153,0)
|
---|
| 3206 | . ; current Facility from the Health Record No. multiple field
|
---|
| 3207 | "RTN","VWUTIL",154,0)
|
---|
| 3208 | . ; (4101/9000001.41) for DFN in the IHS Patient file (9000001)
|
---|
| 3209 | "RTN","VWUTIL",155,0)
|
---|
| 3210 | . N DGHRN S DGHRN=$P(DGNODE,U,2) ; Health Record No. (.02)
|
---|
| 3211 | "RTN","VWUTIL",156,0)
|
---|
| 3212 | . W ?42," HRN: ",DGHRN
|
---|
| 3213 | "RTN","VWUTIL",157,0)
|
---|
| 3214 | ;
|
---|
| 3215 | "RTN","VWUTIL",158,0)
|
---|
| 3216 | D
|
---|
| 3217 | "RTN","VWUTIL",159,0)
|
---|
| 3218 | . N DGSEX S DGSEX=$P(DGRP(0),U,2) ; Sex fld (.02) of Patient file (2)
|
---|
| 3219 | "RTN","VWUTIL",160,0)
|
---|
| 3220 | . W ?61,"Sex: ",$S(DGSEX="M":"MALE",DGSEX="F":"FEMALE",1:"UNANSWERED")
|
---|
| 3221 | "RTN","VWUTIL",161,0)
|
---|
| 3222 | ;
|
---|
| 3223 | "RTN","VWUTIL",162,0)
|
---|
| 3224 | ; field groups 1 & 2 part 5: show remaining name components and aliases
|
---|
| 3225 | "RTN","VWUTIL",163,0)
|
---|
| 3226 | N DGCOUNT F DGCOUNT=2:1:6 D
|
---|
| 3227 | "RTN","VWUTIL",164,0)
|
---|
| 3228 | . W !?5,$P(DGLABEL,U,DGCOUNT),": "
|
---|
| 3229 | "RTN","VWUTIL",165,0)
|
---|
| 3230 | . N DGNAME S DGNAME=$G(DGCOMP(20,DGCOMP,DGCOUNT)) ; next name component
|
---|
| 3231 | "RTN","VWUTIL",166,0)
|
---|
| 3232 | . W $E(DGNAME,1,$S(DGCOUNT=2:23,1:27)) ; 1st line leaves room for "[2]"
|
---|
| 3233 | "RTN","VWUTIL",167,0)
|
---|
| 3234 | . I DGCOUNT=2 D ; header for aliases
|
---|
| 3235 | "RTN","VWUTIL",168,0)
|
---|
| 3236 | . . W ?37 N DGRPW,Z S DGRPW=0,Z=2 D WW^DGRPV ; write [2], suppress LF
|
---|
| 3237 | "RTN","VWUTIL",169,0)
|
---|
| 3238 | . . W " Alias: "
|
---|
| 3239 | "RTN","VWUTIL",170,0)
|
---|
| 3240 | . W ?47,$G(DGALIAS(DGCOUNT-1)) ; show next alias
|
---|
| 3241 | "RTN","VWUTIL",171,0)
|
---|
| 3242 | . Q
|
---|
| 3243 | "RTN","VWUTIL",172,0)
|
---|
| 3244 | Q
|
---|
| 3245 | "RTN","VWUTIL",173,0)
|
---|
| 3246 | ;
|
---|
| 3247 | "RTN","VWUTIL",174,0)
|
---|
| 3248 | REGMU ; Changes to Patient Registration for MU
|
---|
| 3249 | "RTN","VWUTIL",175,0)
|
---|
| 3250 | N X S X=+$O(^DIE("B","VW LOCAL REGISTRATION TEMPLATE",0)) Q:'X
|
---|
| 3251 | "RTN","VWUTIL",176,0)
|
---|
| 3252 | N DA,DIE,DR,DIC,DIQ
|
---|
| 3253 | "RTN","VWUTIL",177,0)
|
---|
| 3254 | S DA=DFN,DIE="^DPT(",DR="[VW LOCAL REGISTRATION TEMPLATE]"
|
---|
| 3255 | "RTN","VWUTIL",178,0)
|
---|
| 3256 | D ^DIE
|
---|
| 3257 | "RTN","VWUTIL",179,0)
|
---|
| 3258 | Q
|
---|
| 3259 | "UP",2,2.0256001,-1)
|
---|
| 3260 | 2^256001
|
---|
| 3261 | "UP",2,2.0256001,0)
|
---|
| 3262 | 2.0256001
|
---|
| 3263 | "UP",2,2.250043,-1)
|
---|
| 3264 | 2^250043
|
---|
| 3265 | "UP",2,2.250043,0)
|
---|
| 3266 | 2.250043
|
---|
| 3267 | "UP",200,200.0256001,-1)
|
---|
| 3268 | 200^256001
|
---|
| 3269 | "UP",200,200.0256001,0)
|
---|
| 3270 | 200.0256001
|
---|
| 3271 | "VER")
|
---|
| 3272 | 8.0^22.0
|
---|
| 3273 | "^DD",2,2,.351,0)
|
---|
| 3274 | DATE OF DEATH^DXa^^.35;1^S %DT="EPT" D ^%DT S X=Y K:Y<1 X I $D(X) D H^DGUTL K:X>DGTIME X K DGTIME,DGDATE I $D(X),X<$P(^DPT(DA,0),"^",3) K X
|
---|
| 3275 | "^DD",2,2,.351,1,0)
|
---|
| 3276 | ^.1
|
---|
| 3277 | "^DD",2,2,.351,1,1,0)
|
---|
| 3278 | ^^TRIGGER^2^.091
|
---|
| 3279 | "^DD",2,2,.351,1,1,1)
|
---|
| 3280 | K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,0)):^(0),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y X ^DD(2,.351,1,1,1.1) X ^DD(2,.351,1,1,1.4)
|
---|
| 3281 | "^DD",2,2,.351,1,1,1,9.2)
|
---|
| 3282 | S X=DIU_"[PATIENT DIED ON ",Y(1)=X S X=DIV,Y(2)=X S X=4,Y(3)=X S X=5,X=$E(Y(2),Y(3),X) S Y=X,X=Y(1),X=X_Y_"/",Y(4)=X S X=DIV,Y(5)=X S X=6,Y(6)=X S X=7
|
---|
| 3283 | "^DD",2,2,.351,1,1,1.1)
|
---|
| 3284 | S X=DIV X ^DD(2,.351,1,1,49.2) S X=$E(Y(5),Y(6),X) S Y=X,X=Y(4),X=X_Y_"/",Y(7)=X S X=DIV,Y(8)=X S X=2,Y(9)=X S X=3,X=$E(Y(8),Y(9),X) S Y=X,X=Y(7),X=X_Y_"]"
|
---|
| 3285 | "^DD",2,2,.351,1,1,1.4)
|
---|
| 3286 | S DIH=$S($D(^DPT(DIV(0),0)):^(0),1:""),DIV=X S $P(^(0),U,10)=DIV,DIH=2,DIG=.091 D ^DICR:$N(^DD(DIH,DIG,1,0))>0
|
---|
| 3287 | "^DD",2,2,.351,1,1,2)
|
---|
| 3288 | K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,0)):^(0),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y X ^DD(2,.351,1,1,2.1) X ^DD(2,.351,1,1,2.4)
|
---|
| 3289 | "^DD",2,2,.351,1,1,2.1)
|
---|
| 3290 | S X=DIV X ^DD(2,.351,1,1,59.2) S Y(8)=X S X=2,X=$P(Y(7),Y(8),X) S Y=X,X=Y(3),X=X_Y
|
---|
| 3291 | "^DD",2,2,.351,1,1,2.4)
|
---|
| 3292 | S DIH=$S($D(^DPT(DIV(0),0)):^(0),1:""),DIV=X S $P(^(0),U,10)=DIV,DIH=2,DIG=.091 D ^DICR:$N(^DD(DIH,DIG,1,0))>0
|
---|
| 3293 | "^DD",2,2,.351,1,1,49.2)
|
---|
| 3294 | S X=DIU_"[PATIENT DIED ON ",Y(1)=X S X=DIV,Y(2)=X S X=4,Y(3)=X S X=5,X=$E(Y(2),Y(3),X) S Y=X,X=Y(1),X=X_Y_"/",Y(4)=X S X=DIV,Y(5)=X S X=6,Y(6)=X S X=7
|
---|
| 3295 | "^DD",2,2,.351,1,1,59.2)
|
---|
| 3296 | S X=DIU,Y(1)=X S X="[PATIENT DIED",Y(2)=X S X=1,X=$P(Y(1),Y(2),X),Y(3)=X,Y(4)=X S X=DIU,Y(5)=X S X="PATIENT DIED",Y(6)=X S X=2,X=$P(Y(5),Y(6),X),Y(7)=X S X="]"
|
---|
| 3297 | "^DD",2,2,.351,1,1,"%D",0)
|
---|
| 3298 | ^^3^3^2930723^^
|
---|
| 3299 | "^DD",2,2,.351,1,1,"%D",1,0)
|
---|
| 3300 | This appends into the REMARKS field a notation regarding the DATE OF
|
---|
| 3301 | "^DD",2,2,.351,1,1,"%D",2,0)
|
---|
| 3302 | DEATH. If DATE OF DEATH is deleted, the notation will be stripped out
|
---|
| 3303 | "^DD",2,2,.351,1,1,"%D",3,0)
|
---|
| 3304 | of the REMARKS field.
|
---|
| 3305 | "^DD",2,2,.351,1,1,"CREATE VALUE")
|
---|
| 3306 | REMARKS_"[PATIENT DIED ON "_$E(DATE OF DEATH,4,5)_"/"_$E(DATE OF DEATH,6,7)_"/"_$E(DATE OF DEATH,2,3)_"]"
|
---|
| 3307 | "^DD",2,2,.351,1,1,"DELETE VALUE")
|
---|
| 3308 | $P(REMARKS,"[PATIENT DIED",1)_$P($P(REMARKS,"PATIENT DIED",2),"]",2)
|
---|
| 3309 | "^DD",2,2,.351,1,1,"DT")
|
---|
| 3310 | 2930601
|
---|
| 3311 | "^DD",2,2,.351,1,1,"FIELD")
|
---|
| 3312 | REMARKS
|
---|
| 3313 | "^DD",2,2,.351,1,2,0)
|
---|
| 3314 | ^^TRIGGER^2^.352
|
---|
| 3315 | "^DD",2,2,.351,1,2,1)
|
---|
| 3316 | K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.35)):^(.35),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y X ^DD(2,.351,1,2,1.1) X ^DD(2,.351,1,2,1.4)
|
---|
| 3317 | "^DD",2,2,.351,1,2,1.1)
|
---|
| 3318 | S X=DIV S X=$S(($D(DUZ)#2):DUZ,1:"")
|
---|
| 3319 | "^DD",2,2,.351,1,2,1.4)
|
---|
| 3320 | S DIH=$S($D(^DPT(DIV(0),.35)):^(.35),1:""),DIV=X S %=$P(DIH,U,3,999),DIU=$P(DIH,U,2),^(.35)=$P(DIH,U,1,1)_U_DIV_$S(%]"":U_%,1:""),DIH=2,DIG=.352 D ^DICR:$N(^DD(DIH,DIG,1,0))>0
|
---|
| 3321 | "^DD",2,2,.351,1,2,2)
|
---|
| 3322 | Q
|
---|
| 3323 | "^DD",2,2,.351,1,2,"CREATE VALUE")
|
---|
| 3324 | S X=$S(($D(DUZ)#2):DUZ,1:"")
|
---|
| 3325 | "^DD",2,2,.351,1,2,"DELETE VALUE")
|
---|
| 3326 | NO EFFECT
|
---|
| 3327 | "^DD",2,2,.351,1,2,"FIELD")
|
---|
| 3328 | DEATH ENTERED BY
|
---|
| 3329 | "^DD",2,2,.351,1,3,0)
|
---|
| 3330 | 2^ADGDBUL^MUMPS
|
---|
| 3331 | "^DD",2,2,.351,1,3,1)
|
---|
| 3332 | D DSBULL^DGDEATH
|
---|
| 3333 | "^DD",2,2,.351,1,3,2)
|
---|
| 3334 | D DKBULL^DGDEATH
|
---|
| 3335 | "^DD",2,2,.351,1,3,"DT")
|
---|
| 3336 | 3031008
|
---|
| 3337 | "^DD",2,2,.351,1,4,0)
|
---|
| 3338 | 2^AEXP1
|
---|
| 3339 | "^DD",2,2,.351,1,4,1)
|
---|
| 3340 | S ^DPT("AEXP1",$E(X,1,30),DA)=""
|
---|
| 3341 | "^DD",2,2,.351,1,4,2)
|
---|
| 3342 | K ^DPT("AEXP1",$E(X,1,30),DA)
|
---|
| 3343 | "^DD",2,2,.351,1,5,0)
|
---|
| 3344 | 2^AOERR^MUMPS
|
---|
| 3345 | "^DD",2,2,.351,1,5,1)
|
---|
| 3346 | D DEATH^DGOERNOT
|
---|
| 3347 | "^DD",2,2,.351,1,5,2)
|
---|
| 3348 | Q
|
---|
| 3349 | "^DD",2,2,.351,1,5,"%D",0)
|
---|
| 3350 | ^^3^3^2910716^^^^
|
---|
| 3351 | "^DD",2,2,.351,1,5,"%D",1,0)
|
---|
| 3352 | This cross-reference is used in conjunction with ORDER ENTRY/RESULTS
|
---|
| 3353 | "^DD",2,2,.351,1,5,"%D",2,0)
|
---|
| 3354 | REPORTING v2.09 or higher to send MAS OE/RR NOTIFICATIONS of
|
---|
| 3355 | "^DD",2,2,.351,1,5,"%D",3,0)
|
---|
| 3356 | DEATH to users who are on an OE/RR LIST for a patient.
|
---|
| 3357 | "^DD",2,2,.351,1,5,"DT")
|
---|
| 3358 | 2910715
|
---|
| 3359 | "^DD",2,2,.351,1,6,0)
|
---|
| 3360 | 2^APSJD^MUMPS
|
---|
| 3361 | "^DD",2,2,.351,1,6,1)
|
---|
| 3362 | S XX=X,X="PSJADT" X ^%ZOSF("TEST") S X=XX K XX I D END^PSJADT
|
---|
| 3363 | "^DD",2,2,.351,1,6,2)
|
---|
| 3364 | Q
|
---|
| 3365 | "^DD",2,2,.351,1,6,3)
|
---|
| 3366 | Cancels Inpatient Medication orders.
|
---|
| 3367 | "^DD",2,2,.351,1,6,"%D",0)
|
---|
| 3368 | ^^3^3^2930608^^^
|
---|
| 3369 | "^DD",2,2,.351,1,6,"%D",1,0)
|
---|
| 3370 | This is used by the Inpatient Medications package to cancel a patient's
|
---|
| 3371 | "^DD",2,2,.351,1,6,"%D",2,0)
|
---|
| 3372 | IV and Unit Dose orders whenever a date of death is entered for the
|
---|
| 3373 | "^DD",2,2,.351,1,6,"%D",3,0)
|
---|
| 3374 | patient.
|
---|
| 3375 | "^DD",2,2,.351,1,6,"DT")
|
---|
| 3376 | 2930608
|
---|
| 3377 | "^DD",2,2,.351,1,7,0)
|
---|
| 3378 | 2^ARCDTH^MUMPS
|
---|
| 3379 | "^DD",2,2,.351,1,7,1)
|
---|
| 3380 | S RCX=X,X="RCAMDTH" X ^%ZOSF("TEST") S X=RCX K RCX I D SET^RCAMDTH
|
---|
| 3381 | "^DD",2,2,.351,1,7,2)
|
---|
| 3382 | S RCX=X,X="RCAMDTH" X ^%ZOSF("TEST") S X=RCX K RCX I D ERR^RCAMDTH
|
---|
| 3383 | "^DD",2,2,.351,1,7,3)
|
---|
| 3384 | ACCOUNTS RECEIVABLE DEATH NOTIFICATION
|
---|
| 3385 | "^DD",2,2,.351,1,7,"%D",0)
|
---|
| 3386 | ^^3^3^2930722^^^^
|
---|
| 3387 | "^DD",2,2,.351,1,7,"%D",1,0)
|
---|
| 3388 | This cross-reference is used to notify the Accounts Receivable package (v4 or
|
---|
| 3389 | "^DD",2,2,.351,1,7,"%D",2,0)
|
---|
| 3390 | higher) of a patient's death so that the patient's account may be reviewed for
|
---|
| 3391 | "^DD",2,2,.351,1,7,"%D",3,0)
|
---|
| 3392 | appropriate action.
|
---|
| 3393 | "^DD",2,2,.351,1,7,"DT")
|
---|
| 3394 | 2930609
|
---|
| 3395 | "^DD",2,2,.351,1,8,0)
|
---|
| 3396 | 2^ADEP^MUMPS
|
---|
| 3397 | "^DD",2,2,.351,1,8,1)
|
---|
| 3398 | D SET^DGDEPINA
|
---|
| 3399 | "^DD",2,2,.351,1,8,2)
|
---|
| 3400 | D KILL^DGDEPINA
|
---|
| 3401 | "^DD",2,2,.351,1,8,"%D",0)
|
---|
| 3402 | ^^1^1^2941114^
|
---|
| 3403 | "^DD",2,2,.351,1,8,"%D",1,0)
|
---|
| 3404 | This is used to updated the effective dates in file 408.12.
|
---|
| 3405 | "^DD",2,2,.351,1,8,"DT")
|
---|
| 3406 | 2941114
|
---|
| 3407 | "^DD",2,2,.351,1,9,0)
|
---|
| 3408 | 2^AENR351^MUMPS
|
---|
| 3409 | "^DD",2,2,.351,1,9,1)
|
---|
| 3410 | D AUTOUPD^DGENA2(DA)
|
---|
| 3411 | "^DD",2,2,.351,1,9,2)
|
---|
| 3412 | D AUTOUPD^DGENA2(DA)
|
---|
| 3413 | "^DD",2,2,.351,1,9,3)
|
---|
| 3414 | DO NOT DELETE
|
---|
| 3415 | "^DD",2,2,.351,1,9,"%D",0)
|
---|
| 3416 | ^^1^1^2970630^^^^
|
---|
| 3417 | "^DD",2,2,.351,1,9,"%D",1,0)
|
---|
| 3418 | Used to update the patient's enrollment.
|
---|
| 3419 | "^DD",2,2,.351,1,9,"DT")
|
---|
| 3420 | 2970630
|
---|
| 3421 | "^DD",2,2,.351,1,10,0)
|
---|
| 3422 | 2^DG714^MUMPS
|
---|
| 3423 | "^DD",2,2,.351,1,10,1)
|
---|
| 3424 | D START^DGMTDELS(DA)
|
---|
| 3425 | "^DD",2,2,.351,1,10,2)
|
---|
| 3426 | Q
|
---|
| 3427 | "^DD",2,2,.351,1,10,3)
|
---|
| 3428 | Deletes last REQUIRED means test
|
---|
| 3429 | "^DD",2,2,.351,1,10,"DT")
|
---|
| 3430 | 3060814
|
---|
| 3431 | "^DD",2,2,.351,1,52,0)
|
---|
| 3432 | 2^APSOD^MUMPS
|
---|
| 3433 | "^DD",2,2,.351,1,52,1)
|
---|
| 3434 | I $$VERSION^XPDUTL("PSO")>6 D APSOD^PSOCAN3(DA)
|
---|
| 3435 | "^DD",2,2,.351,1,52,2)
|
---|
| 3436 | I $$VERSION^XPDUTL("PSO")>6 D APSOD^PSOAUTOC(DA)
|
---|
| 3437 | "^DD",2,2,.351,1,52,3)
|
---|
| 3438 | Discontinues Outpatient Medications.
|
---|
| 3439 | "^DD",2,2,.351,1,52,"%D",0)
|
---|
| 3440 | ^^3^3^2961122^^^^
|
---|
| 3441 | "^DD",2,2,.351,1,52,"%D",1,0)
|
---|
| 3442 | This xref is used to discontinue all active outpatient medications whenever
|
---|
| 3443 | "^DD",2,2,.351,1,52,"%D",2,0)
|
---|
| 3444 | a date of death is entered for the patient. This xref is used with v7 of
|
---|
| 3445 | "^DD",2,2,.351,1,52,"%D",3,0)
|
---|
| 3446 | Outpatient Pharmacy (DBIA #1624).
|
---|
| 3447 | "^DD",2,2,.351,1,52,"%D",4,0)
|
---|
| 3448 | Kill logic updated with DG*5.3*455. Mail message sent to pharmacy when date
|
---|
| 3449 | "^DD",2,2,.351,1,52,"%D",5,0)
|
---|
| 3450 | of death is deleted to holders of PSORPH key.
|
---|
| 3451 | "^DD",2,2,.351,1,52,"DT")
|
---|
| 3452 | 3020926
|
---|
| 3453 | "^DD",2,2,.351,1,250,0)
|
---|
| 3454 | 2^AVWDOD^MUMPS
|
---|
| 3455 | "^DD",2,2,.351,1,250,1)
|
---|
| 3456 | Q
|
---|
| 3457 | "^DD",2,2,.351,1,250,2)
|
---|
| 3458 | D WP^DIE(2,DA_",",250043.1,"","@")
|
---|
| 3459 | "^DD",2,2,.351,1,250,3)
|
---|
| 3460 | Deletes Preliminary Cause of Death
|
---|
| 3461 | "^DD",2,2,.351,1,250,"%D",0)
|
---|
| 3462 | ^^1^1^3121107^
|
---|
| 3463 | "^DD",2,2,.351,1,250,"%D",1,0)
|
---|
| 3464 | Deletes preliminary cause of death if the date of death is deleted.
|
---|
| 3465 | "^DD",2,2,.351,1,250,"DT")
|
---|
| 3466 | 3121107
|
---|
| 3467 | "^DD",2,2,.351,1,301,0)
|
---|
| 3468 | 2^IVM351^MUMPS
|
---|
| 3469 | "^DD",2,2,.351,1,301,1)
|
---|
| 3470 | S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
|
---|
| 3471 | "^DD",2,2,.351,1,301,2)
|
---|
| 3472 | S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
|
---|
| 3473 | "^DD",2,2,.351,1,301,"%D",0)
|
---|
| 3474 | ^^5^5^2930605^
|
---|
| 3475 | "^DD",2,2,.351,1,301,"%D",1,0)
|
---|
| 3476 | This cross-reference will check the IVM PATIENT file to see if a change
|
---|
| 3477 | "^DD",2,2,.351,1,301,"%D",2,0)
|
---|
| 3478 | to this field will require transmission to the IVM Center. If it does,
|
---|
| 3479 | "^DD",2,2,.351,1,301,"%D",3,0)
|
---|
| 3480 | the IVM PATIENT file entry's TRANSMISSION STATUS will be set to 0 and
|
---|
| 3481 | "^DD",2,2,.351,1,301,"%D",4,0)
|
---|
| 3482 | the nightly background job will transmit the updated information.
|
---|
| 3483 | "^DD",2,2,.351,1,301,"DT")
|
---|
| 3484 | 2930605
|
---|
| 3485 | "^DD",2,2,.351,1,991,0)
|
---|
| 3486 | 2^AVAFC351^MUMPS
|
---|
| 3487 | "^DD",2,2,.351,1,991,1)
|
---|
| 3488 | I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".351;" D AVAFC^VAFCDD01(DA)
|
---|
| 3489 | "^DD",2,2,.351,1,991,2)
|
---|
| 3490 | I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".351;" D AVAFC^VAFCDD01(DA)
|
---|
| 3491 | "^DD",2,2,.351,1,991,"%D",0)
|
---|
| 3492 | ^^15^15^2990204^^
|
---|
| 3493 | "^DD",2,2,.351,1,991,"%D",1,0)
|
---|
| 3494 | This cross reference is used to remember that changes were made to the
|
---|
| 3495 | "^DD",2,2,.351,1,991,"%D",2,0)
|
---|
| 3496 | PATIENT file (#2) outside of the Registration process. Execution of this
|
---|
| 3497 | "^DD",2,2,.351,1,991,"%D",3,0)
|
---|
| 3498 | cross reference will create an entry in the ADT/HL7 PIVOT file (#391.71)
|
---|
| 3499 | "^DD",2,2,.351,1,991,"%D",4,0)
|
---|
| 3500 | and mark it as requiring transmission of an HL7 ADT-A08 message.
|
---|
| 3501 | "^DD",2,2,.351,1,991,"%D",5,0)
|
---|
| 3502 |
|
---|
| 3503 | "^DD",2,2,.351,1,991,"%D",6,0)
|
---|
| 3504 | The local variable VAFCFLG will be set to 1 if the cross reference is
|
---|
| 3505 | "^DD",2,2,.351,1,991,"%D",7,0)
|
---|
| 3506 | not executed because the change is being made from within the Registration
|
---|
| 3507 | "^DD",2,2,.351,1,991,"%D",8,0)
|
---|
| 3508 | process.
|
---|
| 3509 | "^DD",2,2,.351,1,991,"%D",9,0)
|
---|
| 3510 |
|
---|
| 3511 | "^DD",2,2,.351,1,991,"%D",10,0)
|
---|
| 3512 | Execution of this cross reference can be prevented by setting the local
|
---|
| 3513 | "^DD",2,2,.351,1,991,"%D",11,0)
|
---|
| 3514 | variable VAFCA08 equal to 1.
|
---|
| 3515 | "^DD",2,2,.351,1,991,"%D",12,0)
|
---|
| 3516 |
|
---|
| 3517 | "^DD",2,2,.351,1,991,"%D",13,0)
|
---|
| 3518 | The local variable VAFCF is used to identify the field edited.
|
---|
| 3519 | "^DD",2,2,.351,1,991,"%D",14,0)
|
---|
| 3520 | This data is stored in the FIELD(S) EDITED (#2.1) field in the
|
---|
| 3521 | "^DD",2,2,.351,1,991,"%D",15,0)
|
---|
| 3522 | ADT/HL7 PIVOT file (#391.71).
|
---|
| 3523 | "^DD",2,2,.351,1,991,"DT")
|
---|
| 3524 | 2990204
|
---|
| 3525 | "^DD",2,2,.351,1,992,0)
|
---|
| 3526 | 2^ADGRU351^MUMPS
|
---|
| 3527 | "^DD",2,2,.351,1,992,1)
|
---|
| 3528 | D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
|
---|
| 3529 | "^DD",2,2,.351,1,992,2)
|
---|
| 3530 | D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
|
---|
| 3531 | "^DD",2,2,.351,1,992,"%D",0)
|
---|
| 3532 | ^^9^9^2990920^
|
---|
| 3533 | "^DD",2,2,.351,1,992,"%D",1,0)
|
---|
| 3534 | This cross reference is used to remember that changes were made to a
|
---|
| 3535 | "^DD",2,2,.351,1,992,"%D",2,0)
|
---|
| 3536 | monitored data field in the PATIENT File (#2) required for a vendor
|
---|
| 3537 | "^DD",2,2,.351,1,992,"%D",3,0)
|
---|
| 3538 | RAI/MDS COTS system. Execution of this cross reference will create
|
---|
| 3539 | "^DD",2,2,.351,1,992,"%D",4,0)
|
---|
| 3540 | an entry in the ADT/HL7 PIVOT file (#391.71) and mark it as requiring
|
---|
| 3541 | "^DD",2,2,.351,1,992,"%D",5,0)
|
---|
| 3542 | transmission of an HL7 demographic A08 update message to the COTS
|
---|
| 3543 | "^DD",2,2,.351,1,992,"%D",6,0)
|
---|
| 3544 | interface.
|
---|
| 3545 | "^DD",2,2,.351,1,992,"%D",7,0)
|
---|
| 3546 |
|
---|
| 3547 | "^DD",2,2,.351,1,992,"%D",8,0)
|
---|
| 3548 | The local variable DGRUGA08 will be set to 1 if the cross reference is
|
---|
| 3549 | "^DD",2,2,.351,1,992,"%D",9,0)
|
---|
| 3550 | not to be executed as part of a re-indexing.
|
---|
| 3551 | "^DD",2,2,.351,1,992,"DT")
|
---|
| 3552 | 2990920
|
---|
| 3553 | "^DD",2,2,.351,3)
|
---|
| 3554 | Enter the date this patient died. Date must not be before date of birth.
|
---|
| 3555 | "^DD",2,2,.351,5,1,0)
|
---|
| 3556 | 405^.01^3
|
---|
| 3557 | "^DD",2,2,.351,5,2,0)
|
---|
| 3558 | 405^.18^2
|
---|
| 3559 | "^DD",2,2,.351,21,0)
|
---|
| 3560 | ^^1^1^2861022^
|
---|
| 3561 | "^DD",2,2,.351,21,1,0)
|
---|
| 3562 | Enter the date of this patient's expiration.
|
---|
| 3563 | "^DD",2,2,.351,"AUDIT")
|
---|
| 3564 | y
|
---|
| 3565 | "^DD",2,2,.351,"DT")
|
---|
| 3566 | 3121107
|
---|
| 3567 | "^DD",2,2,250043.1,0)
|
---|
| 3568 | PRELIMINARY CAUSE OF DEATH^2.250043^^250043;0
|
---|
| 3569 | "^DD",2,2,256000,0)
|
---|
| 3570 | LANGUAGE PREFERENCE^P.85'^DI(.85,^256000;1^Q
|
---|
| 3571 | "^DD",2,2,256000,21,0)
|
---|
| 3572 | ^^1^1^3110524^
|
---|
| 3573 | "^DD",2,2,256000,21,1,0)
|
---|
| 3574 | This field is to define the language preference of the patient.
|
---|
| 3575 | "^DD",2,2,256000,"DT")
|
---|
| 3576 | 3121105
|
---|
| 3577 | "^DD",2,2,256001,0)
|
---|
| 3578 | LANGUAGE SKILLS^2.0256001P^^256001;0
|
---|
| 3579 | "^DD",2,2,256001,21,0)
|
---|
| 3580 | ^^3^3^3110524^
|
---|
| 3581 | "^DD",2,2,256001,21,1,0)
|
---|
| 3582 | The languages listed here are associated with a series of qualifiers for
|
---|
| 3583 | "^DD",2,2,256001,21,2,0)
|
---|
| 3584 | UNDERSTANDING, SPEAKING, READING, and/or WRITTEN skill levels of each langua
|
---|
| 3585 | "^DD",2,2,256001,21,3,0)
|
---|
| 3586 | language specified for this patient.
|
---|
| 3587 | "^DD",2,2.0256001,0)
|
---|
| 3588 | LANGUAGE SKILLS SUB-FIELD^^4^5
|
---|
| 3589 | "^DD",2,2.0256001,0,"DT")
|
---|
| 3590 | 3121105
|
---|
| 3591 | "^DD",2,2.0256001,0,"IX","B",2.0256001,.01)
|
---|
| 3592 |
|
---|
| 3593 | "^DD",2,2.0256001,0,"NM","LANGUAGE SKILLS")
|
---|
| 3594 |
|
---|
| 3595 | "^DD",2,2.0256001,0,"UP")
|
---|
| 3596 | 2
|
---|
| 3597 | "^DD",2,2.0256001,.01,0)
|
---|
| 3598 | LANGUAGE SKILLS^MP.85'^DI(.85,^0;1^Q
|
---|
| 3599 | "^DD",2,2.0256001,.01,1,0)
|
---|
| 3600 | ^.1
|
---|
| 3601 | "^DD",2,2.0256001,.01,1,1,0)
|
---|
| 3602 | 2.0256001^B
|
---|
| 3603 | "^DD",2,2.0256001,.01,1,1,1)
|
---|
| 3604 | S ^DPT(DA(1),256001,"B",$E(X,1,30),DA)=""
|
---|
| 3605 | "^DD",2,2.0256001,.01,1,1,2)
|
---|
| 3606 | K ^DPT(DA(1),256001,"B",$E(X,1,30),DA)
|
---|
| 3607 | "^DD",2,2.0256001,.01,21,0)
|
---|
| 3608 | ^^3^3^3110524^
|
---|
| 3609 | "^DD",2,2.0256001,.01,21,1,0)
|
---|
| 3610 | This multiple is to help catalog the language skills of the patient.
|
---|
| 3611 | "^DD",2,2.0256001,.01,21,2,0)
|
---|
| 3612 | It may be the case that a patient may be called upon to communicate
|
---|
| 3613 | "^DD",2,2.0256001,.01,21,3,0)
|
---|
| 3614 | with other patients that the staff is unable to communicate with otherwise.
|
---|
| 3615 | "^DD",2,2.0256001,.01,"DT")
|
---|
| 3616 | 3121105
|
---|
| 3617 | "^DD",2,2.0256001,1,0)
|
---|
| 3618 | UNDERSTANDING SKILL LEVEL^S^P:poor to none;I:intermediate;N:native skills;M:mastery of the Language;^0;2^Q
|
---|
| 3619 | "^DD",2,2.0256001,1,"DT")
|
---|
| 3620 | 3110524
|
---|
| 3621 | "^DD",2,2.0256001,2,0)
|
---|
| 3622 | SPEAKING SKILL LEVEL^S^P:poor to none;I:intermediate;N:native skills;M:mastery of the Language;^0;3^Q
|
---|
| 3623 | "^DD",2,2.0256001,2,3)
|
---|
| 3624 |
|
---|
| 3625 | "^DD",2,2.0256001,2,"DT")
|
---|
| 3626 | 3110524
|
---|
| 3627 | "^DD",2,2.0256001,3,0)
|
---|
| 3628 | READING SKILL LEVEL^S^P:poor to none;I:intermediate;N:native skills;M:mastery of the Language;^0;4^Q
|
---|
| 3629 | "^DD",2,2.0256001,3,3)
|
---|
| 3630 |
|
---|
| 3631 | "^DD",2,2.0256001,3,"DT")
|
---|
| 3632 | 3110524
|
---|
| 3633 | "^DD",2,2.0256001,4,0)
|
---|
| 3634 | WRITTEN SKILL LEVEL^S^P:poor to none;I:intermediate;N:native skills;M:mastery of the Language;^0;5^Q
|
---|
| 3635 | "^DD",2,2.0256001,4,3)
|
---|
| 3636 |
|
---|
| 3637 | "^DD",2,2.0256001,4,"DT")
|
---|
| 3638 | 3110524
|
---|
| 3639 | "^DD",2,2.250043,0)
|
---|
| 3640 | PRELIMINARY CAUSE OF DEATH SUB-FIELD^^.01^1
|
---|
| 3641 | "^DD",2,2.250043,0,"DT")
|
---|
| 3642 | 3110617
|
---|
| 3643 | "^DD",2,2.250043,0,"NM","PRELIMINARY CAUSE OF DEATH")
|
---|
| 3644 |
|
---|
| 3645 | "^DD",2,2.250043,0,"UP")
|
---|
| 3646 | 2
|
---|
| 3647 | "^DD",2,2.250043,.01,0)
|
---|
| 3648 | PRELIMINARY CAUSE OF DEATH^Wx^^0;1^Q
|
---|
| 3649 | "^DD",2,2.250043,.01,"DT")
|
---|
| 3650 | 3110617
|
---|
| 3651 | "^DD",200,200,256000,0)
|
---|
| 3652 | PREFERRED LANGUAGE^P.85'^DI(.85,^256000;1^Q
|
---|
| 3653 | "^DD",200,200,256000,21,0)
|
---|
| 3654 | ^.001^5^5^3110524^^
|
---|
| 3655 | "^DD",200,200,256000,21,1,0)
|
---|
| 3656 | This is a means of providing an alternative to the system default language.
|
---|
| 3657 | "^DD",200,200,256000,21,2,0)
|
---|
| 3658 | If it is not defined, the value used will be the system default (found on
|
---|
| 3659 | "^DD",200,200,256000,21,3,0)
|
---|
| 3660 | the KERNEL SYSTEM PARAMETER File). This field, when expressed for this user
|
---|
| 3661 | "^DD",200,200,256000,21,4,0)
|
---|
| 3662 | user will default to the KERNEL SYSTEM PARAMETER value, if it is missing or
|
---|
| 3663 | "^DD",200,200,256000,21,5,0)
|
---|
| 3664 | NULL.
|
---|
| 3665 | "^DD",200,200,256000,"DT")
|
---|
| 3666 | 3110524
|
---|
| 3667 | "^DD",200,200,256001,0)
|
---|
| 3668 | LANGUAGE SKILLS^200.0256001P^^256001;0
|
---|
| 3669 | "^DD",200,200,256001,21,0)
|
---|
| 3670 | ^^2^2^3110524^
|
---|
| 3671 | "^DD",200,200,256001,21,1,0)
|
---|
| 3672 | This is the pointer to the LANGUAGE File for the list of languages
|
---|
| 3673 | "^DD",200,200,256001,21,2,0)
|
---|
| 3674 | a person may be able to understand, read, speak, and/or write.
|
---|
| 3675 | "^DD",200,200,256001,23,0)
|
---|
| 3676 | ^^1^1^3110524^
|
---|
| 3677 | "^DD",200,200,256001,23,1,0)
|
---|
| 3678 | This field will be followed by 4 separate fields of sets of codes.
|
---|
| 3679 | "^DD",200,200.0256001,0)
|
---|
| 3680 | LANGUAGE SKILLS SUB-FIELD^^4^5
|
---|
| 3681 | "^DD",200,200.0256001,0,"DT")
|
---|
| 3682 | 3110524
|
---|
| 3683 | "^DD",200,200.0256001,0,"IX","B",200.0256001,.01)
|
---|
| 3684 |
|
---|
| 3685 | "^DD",200,200.0256001,0,"NM","LANGUAGE SKILLS")
|
---|
| 3686 |
|
---|
| 3687 | "^DD",200,200.0256001,0,"UP")
|
---|
| 3688 | 200
|
---|
| 3689 | "^DD",200,200.0256001,.01,0)
|
---|
| 3690 | LANGUAGE SKILLS^MP.85'^DI(.85,^0;1^Q
|
---|
| 3691 | "^DD",200,200.0256001,.01,1,0)
|
---|
| 3692 | ^.1
|
---|
| 3693 | "^DD",200,200.0256001,.01,1,1,0)
|
---|
| 3694 | 200.0256001^B
|
---|
| 3695 | "^DD",200,200.0256001,.01,1,1,1)
|
---|
| 3696 | S ^VA(200,DA(1),256001,"B",$E(X,1,30),DA)=""
|
---|
| 3697 | "^DD",200,200.0256001,.01,1,1,2)
|
---|
| 3698 | K ^VA(200,DA(1),256001,"B",$E(X,1,30),DA)
|
---|
| 3699 | "^DD",200,200.0256001,.01,21,0)
|
---|
| 3700 | ^^4^4^3110524^
|
---|
| 3701 | "^DD",200,200.0256001,.01,21,1,0)
|
---|
| 3702 | This is the location where the linguistic skills of the staff can be
|
---|
| 3703 | "^DD",200,200.0256001,.01,21,2,0)
|
---|
| 3704 | stored for comparision. The strength of the language skills of the
|
---|
| 3705 | "^DD",200,200.0256001,.01,21,3,0)
|
---|
| 3706 | individual are split up into understanding, speak, and/or written
|
---|
| 3707 | "^DD",200,200.0256001,.01,21,4,0)
|
---|
| 3708 | proficiencies for a variety of languages.
|
---|
| 3709 | "^DD",200,200.0256001,.01,"DT")
|
---|
| 3710 | 3110524
|
---|
| 3711 | "^DD",200,200.0256001,1,0)
|
---|
| 3712 | UNDERSTAND^S^P:poor to none;I:intermediate;N:native;M:mastery of the language;^0;2^Q
|
---|
| 3713 | "^DD",200,200.0256001,1,"DT")
|
---|
| 3714 | 3110524
|
---|
| 3715 | "^DD",200,200.0256001,2,0)
|
---|
| 3716 | SPEAKING SKILL LEVEL^S^P:poor to none;I:intermediate;N:native;M:mastery of the language;^0;3^Q
|
---|
| 3717 | "^DD",200,200.0256001,2,3)
|
---|
| 3718 |
|
---|
| 3719 | "^DD",200,200.0256001,2,"DT")
|
---|
| 3720 | 3110524
|
---|
| 3721 | "^DD",200,200.0256001,3,0)
|
---|
| 3722 | READING SKILL LEVEL^S^P:poor to none;I:intermediate;N:native;M:mastery of the language;^0;4^Q
|
---|
| 3723 | "^DD",200,200.0256001,3,3)
|
---|
| 3724 |
|
---|
| 3725 | "^DD",200,200.0256001,3,"DT")
|
---|
| 3726 | 3110524
|
---|
| 3727 | "^DD",200,200.0256001,4,0)
|
---|
| 3728 | WRITTEN SKILL LEVEL^S^P:poor to none;I:intermediate;N:native;M:mastery of the language;^0;5^Q
|
---|
| 3729 | "^DD",200,200.0256001,4,3)
|
---|
| 3730 |
|
---|
| 3731 | "^DD",200,200.0256001,4,"DT")
|
---|
| 3732 | 3110524
|
---|
| 3733 | **END**
|
---|
| 3734 | **END**
|
---|