[1791] | 1 | KIDS Distribution saved on Mar 08, 2017@13:41:25
|
---|
| 2 | Patch 3 to WorldVistA GUI Registration 03/08/2017
|
---|
| 3 | **KIDS**:VWREG_03082017*2.04T3*2^
|
---|
| 4 |
|
---|
| 5 | **INSTALL NAME**
|
---|
| 6 | VWREG_03082017*2.04T3*2
|
---|
| 7 | "BLD",8570,0)
|
---|
| 8 | VWREG_03082017*2.04T3*2^^0^3170308^n
|
---|
| 9 | "BLD",8570,1,0)
|
---|
| 10 | ^^6^6^3170308^^^^
|
---|
| 11 | "BLD",8570,1,1,0)
|
---|
| 12 | 3 Repairs found in Alpha Testing:
|
---|
| 13 | "BLD",8570,1,2,0)
|
---|
| 14 | Removing a testing stub that prevented filing of patient data
|
---|
| 15 | "BLD",8570,1,3,0)
|
---|
| 16 | in VWREGITS
|
---|
| 17 | "BLD",8570,1,4,0)
|
---|
| 18 | Adding a field 540001.1 HEALTH RECORD NUMBER to the PATIENT
|
---|
| 19 | "BLD",8570,1,5,0)
|
---|
| 20 | file (#2)
|
---|
| 21 | "BLD",8570,1,6,0)
|
---|
| 22 | Removed field 540001.1 from VW PT REGISTRATION template
|
---|
| 23 | "BLD",8570,4,0)
|
---|
| 24 | ^9.64PA^2^1
|
---|
| 25 | "BLD",8570,4,2,0)
|
---|
| 26 | 2
|
---|
| 27 | "BLD",8570,4,2,2,0)
|
---|
| 28 | ^9.641^2^1
|
---|
| 29 | "BLD",8570,4,2,2,2,0)
|
---|
| 30 | PATIENT (File-top level)
|
---|
| 31 | "BLD",8570,4,2,2,2,1,0)
|
---|
| 32 | ^9.6411^540001.1^1
|
---|
| 33 | "BLD",8570,4,2,2,2,1,540001.1,0)
|
---|
| 34 | HEALTH RECORD NUMBER
|
---|
| 35 | "BLD",8570,4,2,222)
|
---|
| 36 | y^n^p^^^^n^^n
|
---|
| 37 | "BLD",8570,4,2,224)
|
---|
| 38 |
|
---|
| 39 | "BLD",8570,4,"APDD",2,2)
|
---|
| 40 |
|
---|
| 41 | "BLD",8570,4,"APDD",2,2,540001.1)
|
---|
| 42 |
|
---|
| 43 | "BLD",8570,4,"B",2,2)
|
---|
| 44 |
|
---|
| 45 | "BLD",8570,6.3)
|
---|
| 46 | 2
|
---|
| 47 | "BLD",8570,"KRN",0)
|
---|
| 48 | ^9.67PA^779.2^20
|
---|
| 49 | "BLD",8570,"KRN",.4,0)
|
---|
| 50 | .4
|
---|
| 51 | "BLD",8570,"KRN",.401,0)
|
---|
| 52 | .401
|
---|
| 53 | "BLD",8570,"KRN",.402,0)
|
---|
| 54 | .402
|
---|
| 55 | "BLD",8570,"KRN",.402,"NM",0)
|
---|
| 56 | ^9.68A^1^1
|
---|
| 57 | "BLD",8570,"KRN",.402,"NM",1,0)
|
---|
| 58 | VW PT REGISTRATION FILE #2^2^0
|
---|
| 59 | "BLD",8570,"KRN",.402,"NM","B","VW PT REGISTRATION FILE #2",1)
|
---|
| 60 |
|
---|
| 61 | "BLD",8570,"KRN",.403,0)
|
---|
| 62 | .403
|
---|
| 63 | "BLD",8570,"KRN",.5,0)
|
---|
| 64 | .5
|
---|
| 65 | "BLD",8570,"KRN",.84,0)
|
---|
| 66 | .84
|
---|
| 67 | "BLD",8570,"KRN",3.6,0)
|
---|
| 68 | 3.6
|
---|
| 69 | "BLD",8570,"KRN",3.8,0)
|
---|
| 70 | 3.8
|
---|
| 71 | "BLD",8570,"KRN",9.2,0)
|
---|
| 72 | 9.2
|
---|
| 73 | "BLD",8570,"KRN",9.8,0)
|
---|
| 74 | 9.8
|
---|
| 75 | "BLD",8570,"KRN",9.8,"NM",0)
|
---|
| 76 | ^9.68A^2^2
|
---|
| 77 | "BLD",8570,"KRN",9.8,"NM",1,0)
|
---|
| 78 | VWREGIT^^0^B34467909
|
---|
| 79 | "BLD",8570,"KRN",9.8,"NM",2,0)
|
---|
| 80 | VWREGITS^^0^B15352111
|
---|
| 81 | "BLD",8570,"KRN",9.8,"NM","B","VWREGIT",1)
|
---|
| 82 |
|
---|
| 83 | "BLD",8570,"KRN",9.8,"NM","B","VWREGITS",2)
|
---|
| 84 |
|
---|
| 85 | "BLD",8570,"KRN",19,0)
|
---|
| 86 | 19
|
---|
| 87 | "BLD",8570,"KRN",19.1,0)
|
---|
| 88 | 19.1
|
---|
| 89 | "BLD",8570,"KRN",101,0)
|
---|
| 90 | 101
|
---|
| 91 | "BLD",8570,"KRN",409.61,0)
|
---|
| 92 | 409.61
|
---|
| 93 | "BLD",8570,"KRN",771,0)
|
---|
| 94 | 771
|
---|
| 95 | "BLD",8570,"KRN",779.2,0)
|
---|
| 96 | 779.2
|
---|
| 97 | "BLD",8570,"KRN",870,0)
|
---|
| 98 | 870
|
---|
| 99 | "BLD",8570,"KRN",8989.51,0)
|
---|
| 100 | 8989.51
|
---|
| 101 | "BLD",8570,"KRN",8989.52,0)
|
---|
| 102 | 8989.52
|
---|
| 103 | "BLD",8570,"KRN",8994,0)
|
---|
| 104 | 8994
|
---|
| 105 | "BLD",8570,"KRN","B",.4,.4)
|
---|
| 106 |
|
---|
| 107 | "BLD",8570,"KRN","B",.401,.401)
|
---|
| 108 |
|
---|
| 109 | "BLD",8570,"KRN","B",.402,.402)
|
---|
| 110 |
|
---|
| 111 | "BLD",8570,"KRN","B",.403,.403)
|
---|
| 112 |
|
---|
| 113 | "BLD",8570,"KRN","B",.5,.5)
|
---|
| 114 |
|
---|
| 115 | "BLD",8570,"KRN","B",.84,.84)
|
---|
| 116 |
|
---|
| 117 | "BLD",8570,"KRN","B",3.6,3.6)
|
---|
| 118 |
|
---|
| 119 | "BLD",8570,"KRN","B",3.8,3.8)
|
---|
| 120 |
|
---|
| 121 | "BLD",8570,"KRN","B",9.2,9.2)
|
---|
| 122 |
|
---|
| 123 | "BLD",8570,"KRN","B",9.8,9.8)
|
---|
| 124 |
|
---|
| 125 | "BLD",8570,"KRN","B",19,19)
|
---|
| 126 |
|
---|
| 127 | "BLD",8570,"KRN","B",19.1,19.1)
|
---|
| 128 |
|
---|
| 129 | "BLD",8570,"KRN","B",101,101)
|
---|
| 130 |
|
---|
| 131 | "BLD",8570,"KRN","B",409.61,409.61)
|
---|
| 132 |
|
---|
| 133 | "BLD",8570,"KRN","B",771,771)
|
---|
| 134 |
|
---|
| 135 | "BLD",8570,"KRN","B",779.2,779.2)
|
---|
| 136 |
|
---|
| 137 | "BLD",8570,"KRN","B",870,870)
|
---|
| 138 |
|
---|
| 139 | "BLD",8570,"KRN","B",8989.51,8989.51)
|
---|
| 140 |
|
---|
| 141 | "BLD",8570,"KRN","B",8989.52,8989.52)
|
---|
| 142 |
|
---|
| 143 | "BLD",8570,"KRN","B",8994,8994)
|
---|
| 144 |
|
---|
| 145 | "BLD",8570,"QDEF")
|
---|
| 146 | ^^^^NO^^^^NO^^NO
|
---|
| 147 | "BLD",8570,"QUES",0)
|
---|
| 148 | ^9.62^^
|
---|
| 149 | "BLD",8570,"REQB",0)
|
---|
| 150 | ^9.611^^
|
---|
| 151 | "FIA",2)
|
---|
| 152 | PATIENT
|
---|
| 153 | "FIA",2,0)
|
---|
| 154 | ^DPT(
|
---|
| 155 | "FIA",2,0,0)
|
---|
| 156 | 2I
|
---|
| 157 | "FIA",2,0,1)
|
---|
| 158 | y^n^p^^^^n^^n
|
---|
| 159 | "FIA",2,0,10)
|
---|
| 160 |
|
---|
| 161 | "FIA",2,0,11)
|
---|
| 162 |
|
---|
| 163 | "FIA",2,0,"RLRO")
|
---|
| 164 |
|
---|
| 165 | "FIA",2,2)
|
---|
| 166 | 1
|
---|
| 167 | "FIA",2,2,540001.1)
|
---|
| 168 |
|
---|
| 169 | "KRN",.402,1773,-1)
|
---|
| 170 | 0^1
|
---|
| 171 | "KRN",.402,1773,0)
|
---|
| 172 | VW PT REGISTRATION^3170308.0946^^2^^^3170308
|
---|
| 173 | "KRN",.402,1773,"%D",0)
|
---|
| 174 | ^^1^1^3160416^
|
---|
| 175 | "KRN",.402,1773,"%D",1,0)
|
---|
| 176 | Created via registration client
|
---|
| 177 | "KRN",.402,1773,"DIAB",5,0,2,0)
|
---|
| 178 | .363;"ID NUMBER"
|
---|
| 179 | "KRN",.402,1773,"DR",1,2)
|
---|
| 180 | .01;.02;.03;.05;.363ID NUMBER~;27.02;.111;.112;.1112;.114;.115;.117;.131;.132;.134;.133;.331;.339;.3121;.091;3;250043.1;
|
---|
| 181 | "KRN",.402,1773,"DR",2,2.001)
|
---|
| 182 | .01;1;
|
---|
| 183 | "KRN",.402,1773,"DR",2,2.312)
|
---|
| 184 | .01;
|
---|
| 185 | "KRN",.402,1773,"DR",3,2.011)
|
---|
| 186 | .01;1;
|
---|
| 187 | "MBREQ")
|
---|
| 188 | 0
|
---|
| 189 | "ORD",7,.402)
|
---|
| 190 | .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,"",%)
|
---|
| 191 | "ORD",7,.402,0)
|
---|
| 192 | INPUT TEMPLATE
|
---|
| 193 | "QUES","XPF1",0)
|
---|
| 194 | Y
|
---|
| 195 | "QUES","XPF1","??")
|
---|
| 196 | ^D REP^XPDH
|
---|
| 197 | "QUES","XPF1","A")
|
---|
| 198 | Shall I write over your |FLAG| File
|
---|
| 199 | "QUES","XPF1","B")
|
---|
| 200 | YES
|
---|
| 201 | "QUES","XPF1","M")
|
---|
| 202 | D XPF1^XPDIQ
|
---|
| 203 | "QUES","XPF2",0)
|
---|
| 204 | Y
|
---|
| 205 | "QUES","XPF2","??")
|
---|
| 206 | ^D DTA^XPDH
|
---|
| 207 | "QUES","XPF2","A")
|
---|
| 208 | Want my data |FLAG| yours
|
---|
| 209 | "QUES","XPF2","B")
|
---|
| 210 | YES
|
---|
| 211 | "QUES","XPF2","M")
|
---|
| 212 | D XPF2^XPDIQ
|
---|
| 213 | "QUES","XPI1",0)
|
---|
| 214 | YO
|
---|
| 215 | "QUES","XPI1","??")
|
---|
| 216 | ^D INHIBIT^XPDH
|
---|
| 217 | "QUES","XPI1","A")
|
---|
| 218 | Want KIDS to INHIBIT LOGONs during the install
|
---|
| 219 | "QUES","XPI1","B")
|
---|
| 220 | NO
|
---|
| 221 | "QUES","XPI1","M")
|
---|
| 222 | D XPI1^XPDIQ
|
---|
| 223 | "QUES","XPM1",0)
|
---|
| 224 | PO^VA(200,:EM
|
---|
| 225 | "QUES","XPM1","??")
|
---|
| 226 | ^D MG^XPDH
|
---|
| 227 | "QUES","XPM1","A")
|
---|
| 228 | Enter the Coordinator for Mail Group '|FLAG|'
|
---|
| 229 | "QUES","XPM1","B")
|
---|
| 230 |
|
---|
| 231 | "QUES","XPM1","M")
|
---|
| 232 | D XPM1^XPDIQ
|
---|
| 233 | "QUES","XPO1",0)
|
---|
| 234 | Y
|
---|
| 235 | "QUES","XPO1","??")
|
---|
| 236 | ^D MENU^XPDH
|
---|
| 237 | "QUES","XPO1","A")
|
---|
| 238 | Want KIDS to Rebuild Menu Trees Upon Completion of Install
|
---|
| 239 | "QUES","XPO1","B")
|
---|
| 240 | NO
|
---|
| 241 | "QUES","XPO1","M")
|
---|
| 242 | D XPO1^XPDIQ
|
---|
| 243 | "QUES","XPZ1",0)
|
---|
| 244 | Y
|
---|
| 245 | "QUES","XPZ1","??")
|
---|
| 246 | ^D OPT^XPDH
|
---|
| 247 | "QUES","XPZ1","A")
|
---|
| 248 | Want to DISABLE Scheduled Options, Menu Options, and Protocols
|
---|
| 249 | "QUES","XPZ1","B")
|
---|
| 250 | NO
|
---|
| 251 | "QUES","XPZ1","M")
|
---|
| 252 | D XPZ1^XPDIQ
|
---|
| 253 | "QUES","XPZ2",0)
|
---|
| 254 | Y
|
---|
| 255 | "QUES","XPZ2","??")
|
---|
| 256 | ^D RTN^XPDH
|
---|
| 257 | "QUES","XPZ2","A")
|
---|
| 258 | Want to MOVE routines to other CPUs
|
---|
| 259 | "QUES","XPZ2","B")
|
---|
| 260 | NO
|
---|
| 261 | "QUES","XPZ2","M")
|
---|
| 262 | D XPZ2^XPDIQ
|
---|
| 263 | "RTN")
|
---|
| 264 | 2
|
---|
| 265 | "RTN","VWREGIT")
|
---|
| 266 | 0^1^B34467909
|
---|
| 267 | "RTN","VWREGIT",1,0)
|
---|
| 268 | VWREGIT ;Portland,OR/Jim Bell, et al Patient Registration Utility August 2015
|
---|
| 269 | "RTN","VWREGIT",2,0)
|
---|
| 270 | ;;2.0;B/FProductions,LLC,WORLD VISTA;**LOCAL**;;Build 2
|
---|
| 271 | "RTN","VWREGIT",3,0)
|
---|
| 272 | ;*******************************************************************
|
---|
| 273 | "RTN","VWREGIT",4,0)
|
---|
| 274 | ;* VW Registration is designed for patient specific fields as *
|
---|
| 275 | "RTN","VWREGIT",5,0)
|
---|
| 276 | ;* defined in Fileman Input Templates or ad hoc field selection. *
|
---|
| 277 | "RTN","VWREGIT",6,0)
|
---|
| 278 | ;* Copyright Martius/MMXV ad infinitum (GNU License: See GPLv3.txt)*
|
---|
| 279 | "RTN","VWREGIT",7,0)
|
---|
| 280 | ;*******************************************************************
|
---|
| 281 | "RTN","VWREGIT",8,0)
|
---|
| 282 | ;;NO FALL THROUGH - JEB
|
---|
| 283 | "RTN","VWREGIT",9,0)
|
---|
| 284 | Q
|
---|
| 285 | "RTN","VWREGIT",10,0)
|
---|
| 286 | ;
|
---|
| 287 | "RTN","VWREGIT",11,0)
|
---|
| 288 | TFM(XF) ;TemplateField Management
|
---|
| 289 | "RTN","VWREGIT",12,0)
|
---|
| 290 | ;***********************************************
|
---|
| 291 | "RTN","VWREGIT",13,0)
|
---|
| 292 | ;* Check primary field entries for "parentage" *
|
---|
| 293 | "RTN","VWREGIT",14,0)
|
---|
| 294 | ;* Add an "*" to gain all sub-fields of the *
|
---|
| 295 | "RTN","VWREGIT",15,0)
|
---|
| 296 | ;* parent *
|
---|
| 297 | "RTN","VWREGIT",16,0)
|
---|
| 298 | ;* REMEMBER: All fields pertain to file 2 only *
|
---|
| 299 | "RTN","VWREGIT",17,0)
|
---|
| 300 | ;***********************************************
|
---|
| 301 | "RTN","VWREGIT",18,0)
|
---|
| 302 | N I,N,FIELD
|
---|
| 303 | "RTN","VWREGIT",19,0)
|
---|
| 304 | K FARRAY
|
---|
| 305 | "RTN","VWREGIT",20,0)
|
---|
| 306 | I '$L(XF),'$G(TNUM) Q ""
|
---|
| 307 | "RTN","VWREGIT",21,0)
|
---|
| 308 | I '$L(XF),+$G(TNUM) S XF=^DIE(TNUM,"DR",1,2)
|
---|
| 309 | "RTN","VWREGIT",22,0)
|
---|
| 310 | F I=1:1:$L(XF,";") S:$L($P(XF,";",I)) FARRAY(I)=+$P(XF,";",I)
|
---|
| 311 | "RTN","VWREGIT",23,0)
|
---|
| 312 | S N=0 F I=1:1 S N=$O(FARRAY(N)) Q:'+N D
|
---|
| 313 | "RTN","VWREGIT",24,0)
|
---|
| 314 | . S FIELD=FARRAY(N)
|
---|
| 315 | "RTN","VWREGIT",25,0)
|
---|
| 316 | . I +$P(^DD(2,FIELD,0),"^",2) S FIELD=FIELD_"*",FMARRAY(FIELD)=$P(^(0),"^",4) K FARRAY(N)
|
---|
| 317 | "RTN","VWREGIT",26,0)
|
---|
| 318 | S XF="",N=0 F S N=$O(FARRAY(N)) Q:'+N S XF=XF_FARRAY(N)_";"
|
---|
| 319 | "RTN","VWREGIT",27,0)
|
---|
| 320 | Q XF
|
---|
| 321 | "RTN","VWREGIT",28,0)
|
---|
| 322 | ;
|
---|
| 323 | "RTN","VWREGIT",29,0)
|
---|
| 324 | CHECK() ;
|
---|
| 325 | "RTN","VWREGIT",30,0)
|
---|
| 326 | Q ""
|
---|
| 327 | "RTN","VWREGIT",31,0)
|
---|
| 328 | ;
|
---|
| 329 | "RTN","VWREGIT",32,0)
|
---|
| 330 | INR() Q $O(RESULT(" "),-1)+1
|
---|
| 331 | "RTN","VWREGIT",33,0)
|
---|
| 332 | ;
|
---|
| 333 | "RTN","VWREGIT",34,0)
|
---|
| 334 | EN(RESULT) ;Template name and ID labels
|
---|
| 335 | "RTN","VWREGIT",35,0)
|
---|
| 336 | ;Get the input template list
|
---|
| 337 | "RTN","VWREGIT",36,0)
|
---|
| 338 | ;housekeeping
|
---|
| 339 | "RTN","VWREGIT",37,0)
|
---|
| 340 | S DTIME=99999
|
---|
| 341 | "RTN","VWREGIT",38,0)
|
---|
| 342 | ;ZSY "chmod 777 "_$ZD_"regparam/*.txt" ;Moved to post-install
|
---|
| 343 | "RTN","VWREGIT",39,0)
|
---|
| 344 | ;end housekeeping
|
---|
| 345 | "RTN","VWREGIT",40,0)
|
---|
| 346 | ;
|
---|
| 347 | "RTN","VWREGIT",41,0)
|
---|
| 348 | K AR,RESULT
|
---|
| 349 | "RTN","VWREGIT",42,0)
|
---|
| 350 | N N,HD,FILE,LOC,P4,P5,%ZISHF,%ZISHO,DEFST,XTMP,X
|
---|
| 351 | "RTN","VWREGIT",43,0)
|
---|
| 352 | S RESULT(0)=1
|
---|
| 353 | "RTN","VWREGIT",44,0)
|
---|
| 354 | S DEFST="";
|
---|
| 355 | "RTN","VWREGIT",45,0)
|
---|
| 356 | ;S DEFTMP=$O(^DIE("B","FAU_EDU",0)) ;For Florida College only
|
---|
| 357 | "RTN","VWREGIT",46,0)
|
---|
| 358 | S RESULT(0)=$$CONTROL^VWREGITU()
|
---|
| 359 | "RTN","VWREGIT",47,0)
|
---|
| 360 | S RESULT(1)="-1^No templates found"
|
---|
| 361 | "RTN","VWREGIT",48,0)
|
---|
| 362 | S DEFST=$$GET^XPAR("ALL","VW REG DEFAULT STATE")
|
---|
| 363 | "RTN","VWREGIT",49,0)
|
---|
| 364 | S DEFTMP=$$GET^XPAR("ALL","VW REG RDNPT")
|
---|
| 365 | "RTN","VWREGIT",50,0)
|
---|
| 366 | S HD=$$GET^XPAR("ALL","VW GUI REG TEMPLATE DIRECTORY")
|
---|
| 367 | "RTN","VWREGIT",51,0)
|
---|
| 368 | I '$L(HD) K RESULT D Q
|
---|
| 369 | "RTN","VWREGIT",52,0)
|
---|
| 370 | . S RESULT($$INR)="-1^NO HOME DIRECTORY - refer to IT support, if necessary."
|
---|
| 371 | "RTN","VWREGIT",53,0)
|
---|
| 372 | . S RESULT($$INR)="No home directory has been supplied which indicates"
|
---|
| 373 | "RTN","VWREGIT",54,0)
|
---|
| 374 | . S RESULT($$INR)="the VWREG installation is incomplete. See the Help manual"
|
---|
| 375 | "RTN","VWREGIT",55,0)
|
---|
| 376 | . S RESULT($$INR)="for installation and Enter/Editing parameter values."
|
---|
| 377 | "RTN","VWREGIT",56,0)
|
---|
| 378 | . S RESULT($$INR)="Thank you,"
|
---|
| 379 | "RTN","VWREGIT",57,0)
|
---|
| 380 | . S RESULT($$INR)=" The Management."
|
---|
| 381 | "RTN","VWREGIT",58,0)
|
---|
| 382 | S FILE="regit.txt"
|
---|
| 383 | "RTN","VWREGIT",59,0)
|
---|
| 384 | S P4=1
|
---|
| 385 | "RTN","VWREGIT",60,0)
|
---|
| 386 | S P5=""
|
---|
| 387 | "RTN","VWREGIT",61,0)
|
---|
| 388 | S X=$$FTG^%ZISH(HD,FILE,$NA(AR(1)),P4,P5)
|
---|
| 389 | "RTN","VWREGIT",62,0)
|
---|
| 390 | D:+RESULT(0)
|
---|
| 391 | "RTN","VWREGIT",63,0)
|
---|
| 392 | . S $P(RESULT(0),"^",2)=$G(HD)
|
---|
| 393 | "RTN","VWREGIT",64,0)
|
---|
| 394 | . S $P(RESULT(0),"^",3)=$S(DEFST:$P(^DIC(5,DEFST,0),"^")_"("_DEFST_")",1:"")
|
---|
| 395 | "RTN","VWREGIT",65,0)
|
---|
| 396 | . S $P(RESULT(0),"^",4)=$S(+DEFTMP:$P(^DIE(DEFTMP,0),"^")_"("_DEFTMP_")",1:DEFTMP)
|
---|
| 397 | "RTN","VWREGIT",66,0)
|
---|
| 398 | . S $P(RESULT(0),"^",5)=DUZ
|
---|
| 399 | "RTN","VWREGIT",67,0)
|
---|
| 400 | I $O(AR(0)) S RESULT(1)="[TEMPLATES]"
|
---|
| 401 | "RTN","VWREGIT",68,0)
|
---|
| 402 | S N=0 F S N=$O(AR(N)) Q:'+N D
|
---|
| 403 | "RTN","VWREGIT",69,0)
|
---|
| 404 | . Q:$E(AR(N))="*"
|
---|
| 405 | "RTN","VWREGIT",70,0)
|
---|
| 406 | . Q:'+$P(AR(N),"(",2)
|
---|
| 407 | "RTN","VWREGIT",71,0)
|
---|
| 408 | . Q:$P($G(^DIE(+$P(AR(N),"(",2),0)),"^",4)'=2 ;must be pat file
|
---|
| 409 | "RTN","VWREGIT",72,0)
|
---|
| 410 | . S RESULT($$INR)=AR(N)
|
---|
| 411 | "RTN","VWREGIT",73,0)
|
---|
| 412 | S RESULT($$INR)="[ID]"
|
---|
| 413 | "RTN","VWREGIT",74,0)
|
---|
| 414 | ;S N=0 F S N=$O(^DIZ(64850003,N)) Q:'+N S RESULT($$INR)=$P(^(N,0),"^",2)_"("_$P(^(0),"^")_")"
|
---|
| 415 | "RTN","VWREGIT",75,0)
|
---|
| 416 | ;S N=0 F S N=$O(RESULT(N)) Q:'+N K:RESULT(N)="" RESULT(N)
|
---|
| 417 | "RTN","VWREGIT",76,0)
|
---|
| 418 | I '$O(RESULT(0)) S RESULT(1)="-1^No PATIENT FILE templates found"
|
---|
| 419 | "RTN","VWREGIT",77,0)
|
---|
| 420 | K AR
|
---|
| 421 | "RTN","VWREGIT",78,0)
|
---|
| 422 | Q
|
---|
| 423 | "RTN","VWREGIT",79,0)
|
---|
| 424 | ;
|
---|
| 425 | "RTN","VWREGIT",80,0)
|
---|
| 426 | NPT(RESULT,TNAME) ;
|
---|
| 427 | "RTN","VWREGIT",81,0)
|
---|
| 428 | ; *************************************************
|
---|
| 429 | "RTN","VWREGIT",82,0)
|
---|
| 430 | ; * Incoming: DFN^TEMPLATE NAME(IEN) *
|
---|
| 431 | "RTN","VWREGIT",83,0)
|
---|
| 432 | ; * Process : Get template fields plus any help *
|
---|
| 433 | "RTN","VWREGIT",84,0)
|
---|
| 434 | ; * If +TNAME (a DFN), get DFN data for *
|
---|
| 435 | "RTN","VWREGIT",85,0)
|
---|
| 436 | ; * the template fields (Put data in *
|
---|
| 437 | "RTN","VWREGIT",86,0)
|
---|
| 438 | ; * $P(RESULT(N),"^",3)) *
|
---|
| 439 | "RTN","VWREGIT",87,0)
|
---|
| 440 | ; * Return : RESULT(N), etc *
|
---|
| 441 | "RTN","VWREGIT",88,0)
|
---|
| 442 | ; *************************************************
|
---|
| 443 | "RTN","VWREGIT",89,0)
|
---|
| 444 | ;W " ;Intentional bust for debugging
|
---|
| 445 | "RTN","VWREGIT",90,0)
|
---|
| 446 | N N,TNUM,FIELDS,F,FNAME,FVALUE,FHELP,FPSC,FNUM
|
---|
| 447 | "RTN","VWREGIT",91,0)
|
---|
| 448 | S TNUM=+$P(TNAME,"(",2),DFN=+TNAME
|
---|
| 449 | "RTN","VWREGIT",92,0)
|
---|
| 450 | I 'TNUM S RESULT(0)="0^new patient Template not found" Q
|
---|
| 451 | "RTN","VWREGIT",93,0)
|
---|
| 452 | S TNAME=$P($P(TNAME,"^",2),"(")
|
---|
| 453 | "RTN","VWREGIT",94,0)
|
---|
| 454 | S TNAME=$TR(TNAME,"$&*","") ;Clean out TMENU chars
|
---|
| 455 | "RTN","VWREGIT",95,0)
|
---|
| 456 | I TNAME="GENERIC INS. FRM [WorldVistA]" G GIF
|
---|
| 457 | "RTN","VWREGIT",96,0)
|
---|
| 458 | S FIELDS=$G(^DIE(TNUM,"DR",1,2))
|
---|
| 459 | "RTN","VWREGIT",97,0)
|
---|
| 460 | I '$L(FIELDS) Q
|
---|
| 461 | "RTN","VWREGIT",98,0)
|
---|
| 462 | K RESULT S (FNUM,FCAP)=""
|
---|
| 463 | "RTN","VWREGIT",99,0)
|
---|
| 464 | F I=1:1:$L(FIELDS,";")-1 D
|
---|
| 465 | "RTN","VWREGIT",100,0)
|
---|
| 466 | . S F=$P(FIELDS,";",I)
|
---|
| 467 | "RTN","VWREGIT",101,0)
|
---|
| 468 | . Q:'$D(^DD(2,F)) ;Not existing in this patient file
|
---|
| 469 | "RTN","VWREGIT",102,0)
|
---|
| 470 | . I F["~" S FNUM=+F,FNAME=$P($P(F,"~"),FNUM,2),F=FNUM K FNUM
|
---|
| 471 | "RTN","VWREGIT",103,0)
|
---|
| 472 | . S FNAME=$S($L($G(FNAME)):FNAME,$L($G(^DD(2,F,.1))):$P(^(.1),"^"),1:$P(^DD(2,F,0),"^"))
|
---|
| 473 | "RTN","VWREGIT",104,0)
|
---|
| 474 | . S FVALUE="" ;Patient Data
|
---|
| 475 | "RTN","VWREGIT",105,0)
|
---|
| 476 | . S FHELP=$G(^DD(2,F,3))
|
---|
| 477 | "RTN","VWREGIT",106,0)
|
---|
| 478 | . I F'=27.02,'$L(FHELP) S N=0 F S N=$O(^DD(2,F,21,N)) Q:'+N S FHELP=FHELP_^(N,0)
|
---|
| 479 | "RTN","VWREGIT",107,0)
|
---|
| 480 | . S FHELP=$TR(FHELP,"'","`")
|
---|
| 481 | "RTN","VWREGIT",108,0)
|
---|
| 482 | . S FPSC=$P(^DD(2,F,0),"^",3)
|
---|
| 483 | "RTN","VWREGIT",109,0)
|
---|
| 484 | . S SUBDIC=+$P(^DD(2,F,0),"^",2)
|
---|
| 485 | "RTN","VWREGIT",110,0)
|
---|
| 486 | . S RESULT($$INR)=FNAME_"^"_F_"^"_FVALUE_"^"_FHELP_"^"_FPSC_$S(SUBDIC:"^1",1:"^0")
|
---|
| 487 | "RTN","VWREGIT",111,0)
|
---|
| 488 | . S (FNAME,FVALUE,FHELP,FPSC)=""
|
---|
| 489 | "RTN","VWREGIT",112,0)
|
---|
| 490 | G NPTX:'DFN
|
---|
| 491 | "RTN","VWREGIT",113,0)
|
---|
| 492 | I DFN D GETS^DIQ(2,DFN_",","**","EN","AR") ;,RESULT(0)=$$DFNID^VWREGITU
|
---|
| 493 | "RTN","VWREGIT",114,0)
|
---|
| 494 | K FIELD S N=0 F S N=$O(RESULT(N)) Q:'+N S FIELD($P(RESULT(N),"^",2))=""
|
---|
| 495 | "RTN","VWREGIT",115,0)
|
---|
| 496 | S X="AR" F S X=$Q(@X) Q:X="" D
|
---|
| 497 | "RTN","VWREGIT",116,0)
|
---|
| 498 | . S FILE=+$P(X,"(",2)
|
---|
| 499 | "RTN","VWREGIT",117,0)
|
---|
| 500 | . S FIELD=+$P(X,",",$L(X,",")-1)
|
---|
| 501 | "RTN","VWREGIT",118,0)
|
---|
| 502 | . I $D(FIELD(FIELD)) S FIELD(FIELD)=@X
|
---|
| 503 | "RTN","VWREGIT",119,0)
|
---|
| 504 | S N=0 F S N=$O(FIELD(N)) Q:'+N D
|
---|
| 505 | "RTN","VWREGIT",120,0)
|
---|
| 506 | . S N2=0 F S N2=$O(RESULT(N2)) Q:'+N2 I $P(RESULT(N2),"^",2)=N S $P(RESULT(N2),"^",3)=FIELD(N)
|
---|
| 507 | "RTN","VWREGIT",121,0)
|
---|
| 508 | . S RESULT(0)=$$DFNID^VWREGITU()
|
---|
| 509 | "RTN","VWREGIT",122,0)
|
---|
| 510 | NPTX K FIELD,AR,FCAP,FILE,SUBDIC,N,N2,DFN
|
---|
| 511 | "RTN","VWREGIT",123,0)
|
---|
| 512 | Q
|
---|
| 513 | "RTN","VWREGIT",124,0)
|
---|
| 514 | ;
|
---|
| 515 | "RTN","VWREGIT",125,0)
|
---|
| 516 | PF(RESULT,XPF) ;Pointer file - get the stuff
|
---|
| 517 | "RTN","VWREGIT",126,0)
|
---|
| 518 | K RESULT,AR
|
---|
| 519 | "RTN","VWREGIT",127,0)
|
---|
| 520 | N X,N
|
---|
| 521 | "RTN","VWREGIT",128,0)
|
---|
| 522 | I '$L(XPF) S RESULT(0)="???" Q
|
---|
| 523 | "RTN","VWREGIT",129,0)
|
---|
| 524 | S XPF="^"_XPF
|
---|
| 525 | "RTN","VWREGIT",130,0)
|
---|
| 526 | I +$P(XPF,"(",2)=.85 G NAUTPF ;Naughty file!
|
---|
| 527 | "RTN","VWREGIT",131,0)
|
---|
| 528 | S N=0 F S N=$O(@(XPF_N_")")) Q:'+N S X=$P(^(N,0),"^"),AR(X,N)=X_"("_N_")"
|
---|
| 529 | "RTN","VWREGIT",132,0)
|
---|
| 530 | S X="AR" F S X=$Q(@X) Q:X="" S RESULT($$INR)=@X
|
---|
| 531 | "RTN","VWREGIT",133,0)
|
---|
| 532 | K AR
|
---|
| 533 | "RTN","VWREGIT",134,0)
|
---|
| 534 | Q
|
---|
| 535 | "RTN","VWREGIT",135,0)
|
---|
| 536 | ;
|
---|
| 537 | "RTN","VWREGIT",136,0)
|
---|
| 538 | NAUTPF ;The "NAUGHTY" pointer file - has a numeric .01 - Bad file !!!
|
---|
| 539 | "RTN","VWREGIT",137,0)
|
---|
| 540 | S N=0 F S N=$O(@(XPF_N_")")) Q:'+N S X=$P(^(N,0),"^") D
|
---|
| 541 | "RTN","VWREGIT",138,0)
|
---|
| 542 | . S LANG=$P(^(0),"^",2)
|
---|
| 543 | "RTN","VWREGIT",139,0)
|
---|
| 544 | . S AR(LANG,N)=LANG_"("_N_")"
|
---|
| 545 | "RTN","VWREGIT",140,0)
|
---|
| 546 | S X="AR" F S X=$Q(@X) Q:X="" S RESULT($$INR)=@X
|
---|
| 547 | "RTN","VWREGIT",141,0)
|
---|
| 548 | Q
|
---|
| 549 | "RTN","VWREGIT",142,0)
|
---|
| 550 | GIF ;Generic Insurance form
|
---|
| 551 | "RTN","VWREGIT",143,0)
|
---|
| 552 | K RESULT
|
---|
| 553 | "RTN","VWREGIT",144,0)
|
---|
| 554 | S RESULT($$INR)="Insurance Company^2.312;.01^^^DIC(36,^0"
|
---|
| 555 | "RTN","VWREGIT",145,0)
|
---|
| 556 | S RESULT($$INR)="Group Plan^2.312;.18^^^IBA(355.3,^0"
|
---|
| 557 | "RTN","VWREGIT",146,0)
|
---|
| 558 | S RESULT($$INR)="Policy No.^2.312;1^^^^0"
|
---|
| 559 | "RTN","VWREGIT",147,0)
|
---|
| 560 | ;S RESULT($$INR)="Type of Plan^^^^^0"
|
---|
| 561 | "RTN","VWREGIT",148,0)
|
---|
| 562 | S RESULT($$INR)="Coverage^355.33;40.09^^^IBE(355.1,^0"
|
---|
| 563 | "RTN","VWREGIT",149,0)
|
---|
| 564 | S RESULT($$INR)="Effective Date^2.312;8^^^^0"
|
---|
| 565 | "RTN","VWREGIT",150,0)
|
---|
| 566 | S RESULT($$INR)="Expiration Date^.3121;^^^^0"
|
---|
| 567 | "RTN","VWREGIT",151,0)
|
---|
| 568 | S RESULT($$INR)="Guarantor^^^^^0"
|
---|
| 569 | "RTN","VWREGIT",152,0)
|
---|
| 570 | S RESULT($$INR)="Signature on File^^^^0:NO;1:YES^0"
|
---|
| 571 | "RTN","VWREGIT",153,0)
|
---|
| 572 | S RESULT($$INR)="Employer^2.312;2.015^^^^0"
|
---|
| 573 | "RTN","VWREGIT",154,0)
|
---|
| 574 | S RESULT($$INR)="Billing Address^2.312;2.02^^^^0"
|
---|
| 575 | "RTN","VWREGIT",155,0)
|
---|
| 576 | S RESULT($$INR)="Billing Address(cont)^2.312;2.03^^^^0"
|
---|
| 577 | "RTN","VWREGIT",156,0)
|
---|
| 578 | S RESULT($$INR)="Postal Code^2.312;2.07^^^^0"
|
---|
| 579 | "RTN","VWREGIT",157,0)
|
---|
| 580 | S RESULT($$INR)="City^2.312;2.05^^^^0"
|
---|
| 581 | "RTN","VWREGIT",158,0)
|
---|
| 582 | S RESULT($$INR)="County/Region/Area^^^^^0"
|
---|
| 583 | "RTN","VWREGIT",159,0)
|
---|
| 584 | S RESULT($$INR)="State/Province/Region^2.312;2.06^^^DIC(5,^0"
|
---|
| 585 | "RTN","VWREGIT",160,0)
|
---|
| 586 | Q
|
---|
| 587 | "RTN","VWREGIT",161,0)
|
---|
| 588 | ;
|
---|
| 589 | "RTN","VWREGIT",162,0)
|
---|
| 590 |
|
---|
| 591 | "RTN","VWREGITS")
|
---|
| 592 | 0^2^B15352111
|
---|
| 593 | "RTN","VWREGITS",1,0)
|
---|
| 594 | VWREGITS ;Portland,OR/jeb et al Save utility for VWREG* routines 11/2015
|
---|
| 595 | "RTN","VWREGITS",2,0)
|
---|
| 596 | ;V.2;;**LOCAL**;;;Build 2
|
---|
| 597 | "RTN","VWREGITS",3,0)
|
---|
| 598 | ;c2014 ad infiniti, BellFelder Productions (BF Productions) & WorldVistA
|
---|
| 599 | "RTN","VWREGITS",4,0)
|
---|
| 600 | ;License: See License.txt that with install
|
---|
| 601 | "RTN","VWREGITS",5,0)
|
---|
| 602 | ;No fall thru - jeb
|
---|
| 603 | "RTN","VWREGITS",6,0)
|
---|
| 604 | Q
|
---|
| 605 | "RTN","VWREGITS",7,0)
|
---|
| 606 | ;
|
---|
| 607 | "RTN","VWREGITS",8,0)
|
---|
| 608 | ;* *****************************************************************
|
---|
| 609 | "RTN","VWREGITS",9,0)
|
---|
| 610 | ;* Data coming in may be for a new case or existing case *
|
---|
| 611 | "RTN","VWREGITS",10,0)
|
---|
| 612 | ;* Incoming: Array LDATA= *
|
---|
| 613 | "RTN","VWREGITS",11,0)
|
---|
| 614 | ;* LDATA(1)=Field^Field number^value^[optional]DFN *
|
---|
| 615 | "RTN","VWREGITS",12,0)
|
---|
| 616 | ;* LDATA(N...)=Field^Field number^value *
|
---|
| 617 | "RTN","VWREGITS",13,0)
|
---|
| 618 | ;* Exception for Multiples: *
|
---|
| 619 | "RTN","VWREGITS",14,0)
|
---|
| 620 | ;* LDATA(N)=Field(SUBDD;Field number):value(IEN)^...etc for every*
|
---|
| 621 | "RTN","VWREGITS",15,0)
|
---|
| 622 | ;* field that is a dependent of the parent *
|
---|
| 623 | "RTN","VWREGITS",16,0)
|
---|
| 624 | ;* Process: *
|
---|
| 625 | "RTN","VWREGITS",17,0)
|
---|
| 626 | ;* 1. call is at Label SAVE *
|
---|
| 627 | "RTN","VWREGITS",18,0)
|
---|
| 628 | ;* 2. Some housekeeping that this programmer needs to do proper *
|
---|
| 629 | "RTN","VWREGITS",19,0)
|
---|
| 630 | ;* string evaluations. *
|
---|
| 631 | "RTN","VWREGITS",20,0)
|
---|
| 632 | ;* 3. Filing of a new case with FILE^DICN. *
|
---|
| 633 | "RTN","VWREGITS",21,0)
|
---|
| 634 | ;* 4. Remaining major fields are filed with DIE *
|
---|
| 635 | "RTN","VWREGITS",22,0)
|
---|
| 636 | ;* 5. Multiples are filed with UPDATE^DIE *
|
---|
| 637 | "RTN","VWREGITS",23,0)
|
---|
| 638 | ;* 6. Existing entries will contain only edited data and will *
|
---|
| 639 | "RTN","VWREGITS",24,0)
|
---|
| 640 | ;* address those fields as in 4 & 5. *
|
---|
| 641 | "RTN","VWREGITS",25,0)
|
---|
| 642 | ;* Bon Appettit, et al. *
|
---|
| 643 | "RTN","VWREGITS",26,0)
|
---|
| 644 | ;*******************************************************************
|
---|
| 645 | "RTN","VWREGITS",27,0)
|
---|
| 646 | SAVE(RESULT,LDATA) ;
|
---|
| 647 | "RTN","VWREGITS",28,0)
|
---|
| 648 | K RESULT,^DIZ("DS",$J)
|
---|
| 649 | "RTN","VWREGITS",29,0)
|
---|
| 650 | M ^DIZ("DS",$J)=LDATA
|
---|
| 651 | "RTN","VWREGITS",30,0)
|
---|
| 652 | ;Q ;Testing
|
---|
| 653 | "RTN","VWREGITS",31,0)
|
---|
| 654 | N DFN,DIC,DA,DR,VAR,FIELD,N,N1,X,Y,DIE,DIK
|
---|
| 655 | "RTN","VWREGITS",32,0)
|
---|
| 656 | I $D(LDATA)<10 S RESULT(0)="-1: No data sent for filing. Please contact your IT dept." Q
|
---|
| 657 | "RTN","VWREGITS",33,0)
|
---|
| 658 | ;UPcase everyTHING
|
---|
| 659 | "RTN","VWREGITS",34,0)
|
---|
| 660 | S XDAT="LDATA" F S XDAT=$Q(@XDAT) Q:XDAT="" S @XDAT=$$UP^XLFSTR(@XDAT)
|
---|
| 661 | "RTN","VWREGITS",35,0)
|
---|
| 662 | ;
|
---|
| 663 | "RTN","VWREGITS",36,0)
|
---|
| 664 | ;Incoming housekeeping
|
---|
| 665 | "RTN","VWREGITS",37,0)
|
---|
| 666 | S X="LDATA" F I=1:1 S X=$Q(@X) Q:X="" I @X[":",@X[";" S ^DIZ("DS",$J,I)=@X K @X
|
---|
| 667 | "RTN","VWREGITS",38,0)
|
---|
| 668 | I +$P(@$Q(LDATA),"^",4)!(+$P(@$Q(LDATA),"(",2)) G EXP ;DFN sent by client
|
---|
| 669 | "RTN","VWREGITS",39,0)
|
---|
| 670 | S N=0 F S N=$O(LDATA(N)) Q:'+N I +$P($G(^DD(2,+$P(LDATA(N),"^",2),0)),"^",2) K LDATA(N)
|
---|
| 671 | "RTN","VWREGITS",40,0)
|
---|
| 672 | S DFN=$$FIND1^DIC(2,"","M",$P(LDATA(1),"^",3),"","","ERR")
|
---|
| 673 | "RTN","VWREGITS",41,0)
|
---|
| 674 | G EXP:DFN ;Found patient/client
|
---|
| 675 | "RTN","VWREGITS",42,0)
|
---|
| 676 | ;End housekeeping;
|
---|
| 677 | "RTN","VWREGITS",43,0)
|
---|
| 678 | ;
|
---|
| 679 | "RTN","VWREGITS",44,0)
|
---|
| 680 | S X=$P(LDATA(1),"^",3) D
|
---|
| 681 | "RTN","VWREGITS",45,0)
|
---|
| 682 | . S DIC="^DPT(",DIC(0)="LZ" K D0 D FILE^DICN S (DA,DFN)=+Y
|
---|
| 683 | "RTN","VWREGITS",46,0)
|
---|
| 684 | . S DIC="^AUPNPAT(",DIC(0)="LZ",X=DFN,DINUM=X,DIC(0)="L" D FILE^DICN
|
---|
| 685 | "RTN","VWREGITS",47,0)
|
---|
| 686 | . S DIE=DIC,DR=.03_"////^S X=DT" D ^DIE
|
---|
| 687 | "RTN","VWREGITS",48,0)
|
---|
| 688 | . S DR=.11_"////^S X=DUZ" D ^DIE
|
---|
| 689 | "RTN","VWREGITS",49,0)
|
---|
| 690 | LDPT L +^DPT(DFN):1 G LDPT:'$T
|
---|
| 691 | "RTN","VWREGITS",50,0)
|
---|
| 692 | S N=1 F S N=$O(LDATA(N)) Q:'+N D
|
---|
| 693 | "RTN","VWREGITS",51,0)
|
---|
| 694 | . Q:$P(LDATA(N),"^",2)[";"
|
---|
| 695 | "RTN","VWREGITS",52,0)
|
---|
| 696 | . Q:'+$P(LDATA(N),"^",2) ;Marker of some kind
|
---|
| 697 | "RTN","VWREGITS",53,0)
|
---|
| 698 | . S FIELD=$P(LDATA(N),"^",2)
|
---|
| 699 | "RTN","VWREGITS",54,0)
|
---|
| 700 | . S VAR=$P(LDATA(N),"^",3)
|
---|
| 701 | "RTN","VWREGITS",55,0)
|
---|
| 702 | . I FIELD=.03 D
|
---|
| 703 | "RTN","VWREGITS",56,0)
|
---|
| 704 | .. S VAR=$$DC(VAR)
|
---|
| 705 | "RTN","VWREGITS",57,0)
|
---|
| 706 | .. S VARTIME=$P(VAR,".",2),VAR=$P(VAR,".")
|
---|
| 707 | "RTN","VWREGITS",58,0)
|
---|
| 708 | .. I $L(VARTIME) D
|
---|
| 709 | "RTN","VWREGITS",59,0)
|
---|
| 710 | ... N FDA
|
---|
| 711 | "RTN","VWREGITS",60,0)
|
---|
| 712 | ... S FDA(2,DFN_",",540000.1)=VARTIME
|
---|
| 713 | "RTN","VWREGITS",61,0)
|
---|
| 714 | ... D FILE^DIE("E","FDA")
|
---|
| 715 | "RTN","VWREGITS",62,0)
|
---|
| 716 | ... D CLEAN^DILF
|
---|
| 717 | "RTN","VWREGITS",63,0)
|
---|
| 718 | . S:VAR["(" VAR=$S($L(VAR,"(")>2:+$P(VAR,"(",$L(VAR,"(")),1:+$P(VAR,"(",2))
|
---|
| 719 | "RTN","VWREGITS",64,0)
|
---|
| 720 | . S DIE="^DPT(",DR=FIELD_"///"_$S(+VAR:"/",1:"")_"^S X=VAR" D ^DIE
|
---|
| 721 | "RTN","VWREGITS",65,0)
|
---|
| 722 | L -^DPT(DFN)
|
---|
| 723 | "RTN","VWREGITS",66,0)
|
---|
| 724 | D M ;File any multiple fields
|
---|
| 725 | "RTN","VWREGITS",67,0)
|
---|
| 726 | S RESULT(0)="Filed..."
|
---|
| 727 | "RTN","VWREGITS",68,0)
|
---|
| 728 | K ^DIZ("DS",$J)
|
---|
| 729 | "RTN","VWREGITS",69,0)
|
---|
| 730 | Q
|
---|
| 731 | "RTN","VWREGITS",70,0)
|
---|
| 732 | ;
|
---|
| 733 | "RTN","VWREGITS",71,0)
|
---|
| 734 | EXP ;Existing Patient
|
---|
| 735 | "RTN","VWREGITS",72,0)
|
---|
| 736 | K X,FNAME,FFLD,FVALUE,AR,DIC,DA,DR,DIE,AR
|
---|
| 737 | "RTN","VWREGITS",73,0)
|
---|
| 738 | S X="LDATA" F S X=$Q(@X) Q:X="" I @X[":" S AR($O(AR(" "),-1)+1)=@X K @X
|
---|
| 739 | "RTN","VWREGITS",74,0)
|
---|
| 740 | S N=0 F S N=$O(LDATA(N)) Q:'+N S X=LDATA(N) D
|
---|
| 741 | "RTN","VWREGITS",75,0)
|
---|
| 742 | . S FNAME=$P(X,"^")
|
---|
| 743 | "RTN","VWREGITS",76,0)
|
---|
| 744 | . S FFLD=$P(X,"^",2)
|
---|
| 745 | "RTN","VWREGITS",77,0)
|
---|
| 746 | . S FVALUE=$S($P(X,"^",3)["(":+$P(X,"(",2),1:$P(X,"^",3))
|
---|
| 747 | "RTN","VWREGITS",78,0)
|
---|
| 748 | . S DFN=$P(X,"^",4)
|
---|
| 749 | "RTN","VWREGITS",79,0)
|
---|
| 750 | . S DIE="^DPT(",DA=DFN,DR=FFLD_"///^S X=FVALUE" D ^DIE
|
---|
| 751 | "RTN","VWREGITS",80,0)
|
---|
| 752 | D M
|
---|
| 753 | "RTN","VWREGITS",81,0)
|
---|
| 754 | S RESULT($I(RESULT))="Filed..."
|
---|
| 755 | "RTN","VWREGITS",82,0)
|
---|
| 756 | K X,FNAME,FFL,FVALUE,DFN,AR,DIE,DA,DR,DIC
|
---|
| 757 | "RTN","VWREGITS",83,0)
|
---|
| 758 | Q
|
---|
| 759 | "RTN","VWREGITS",84,0)
|
---|
| 760 | ;
|
---|
| 761 | "RTN","VWREGITS",85,0)
|
---|
| 762 | M ;File any multiples values; DFN should be defined above
|
---|
| 763 | "RTN","VWREGITS",86,0)
|
---|
| 764 | Q:'$D(^DIZ("DS",$J))
|
---|
| 765 | "RTN","VWREGITS",87,0)
|
---|
| 766 | M MULTS=^DIZ("DS",$J)
|
---|
| 767 | "RTN","VWREGITS",88,0)
|
---|
| 768 | K MAR S N=0 F S N=$O(MULTS(N)) Q:'+N D
|
---|
| 769 | "RTN","VWREGITS",89,0)
|
---|
| 770 | . F J=1:1:$L(MULTS(N),"^")-1 S MAR(J)=$P(MULTS(N),"^",J)
|
---|
| 771 | "RTN","VWREGITS",90,0)
|
---|
| 772 | . S MX=$O(MAR(0))
|
---|
| 773 | "RTN","VWREGITS",91,0)
|
---|
| 774 | . S MXFILE=+$P(MAR(MX),"(",2)
|
---|
| 775 | "RTN","VWREGITS",92,0)
|
---|
| 776 | . S MXFLD=+$P(MAR(MX),";",2)
|
---|
| 777 | "RTN","VWREGITS",93,0)
|
---|
| 778 | . S MXVAL=$P($P(MAR(MX),":",2),"(")
|
---|
| 779 | "RTN","VWREGITS",94,0)
|
---|
| 780 | . I MXFLD=.01 S MXDATA(MXFILE,"?+1,"_DFN_",",MXFLD)=MXVAL K IEN D UPDATE^DIE("E","MXDATA","IEN","ERROR") Q:$G(DIERR) D
|
---|
| 781 | "RTN","VWREGITS",95,0)
|
---|
| 782 | .. S RECORD=$G(IEN(1)),INC=$G(IEN(1,0))
|
---|
| 783 | "RTN","VWREGITS",96,0)
|
---|
| 784 | .. S J=MX F S J=$O(MAR(J)) Q:'+J D
|
---|
| 785 | "RTN","VWREGITS",97,0)
|
---|
| 786 | ... s MXFILE=+$P(MAR(J),"(",2)
|
---|
| 787 | "RTN","VWREGITS",98,0)
|
---|
| 788 | ... S MXFLD=+$P(MAR(J),";",2)
|
---|
| 789 | "RTN","VWREGITS",99,0)
|
---|
| 790 | ... S MXVAL=$P(MAR(J),":",2),MXVAL=$S(MXVAL["(":$P(MXVAL,"("),1:MXVAL)
|
---|
| 791 | "RTN","VWREGITS",100,0)
|
---|
| 792 | ... S MXDATA(MXFILE,$S(MXFLD=.01:INC,1:"")_"1,"_RECORD_","_DFN_",",MXFLD)=MXVAL
|
---|
| 793 | "RTN","VWREGITS",101,0)
|
---|
| 794 | ... K IEN,ERROR D UPDATE^DIE("E","MXDATA","IEN","ERROR")
|
---|
| 795 | "RTN","VWREGITS",102,0)
|
---|
| 796 | Q
|
---|
| 797 | "RTN","VWREGITS",103,0)
|
---|
| 798 | ;
|
---|
| 799 | "RTN","VWREGITS",104,0)
|
---|
| 800 | DC(XDATE) ;Convert DOB to internal
|
---|
| 801 | "RTN","VWREGITS",105,0)
|
---|
| 802 | N %DT,X
|
---|
| 803 | "RTN","VWREGITS",106,0)
|
---|
| 804 | S X=XDATE,%DT="T" D ^%DT
|
---|
| 805 | "RTN","VWREGITS",107,0)
|
---|
| 806 | Q Y
|
---|
| 807 | "RTN","VWREGITS",108,0)
|
---|
| 808 | ;
|
---|
| 809 | "RTN","VWREGITS",109,0)
|
---|
| 810 | INSUR ;Insurance/Billing
|
---|
| 811 | "RTN","VWREGITS",110,0)
|
---|
| 812 | Q
|
---|
| 813 | "RTN","VWREGITS",111,0)
|
---|
| 814 | ;
|
---|
| 815 | "RTN","VWREGITS",112,0)
|
---|
| 816 | K S DA=$P(^DPT(0),"^",3),DIK="^DPT(" D ^DIK
|
---|
| 817 | "RTN","VWREGITS",113,0)
|
---|
| 818 | S DIK="^AUPNPAT(" D ^DIK
|
---|
| 819 | "RTN","VWREGITS",114,0)
|
---|
| 820 | Q
|
---|
| 821 | "RTN","VWREGITS",115,0)
|
---|
| 822 | ;
|
---|
| 823 | "VER")
|
---|
| 824 | 8.0^22.2
|
---|
| 825 | "^DD",2,2,540001.1,0)
|
---|
| 826 | HEALTH RECORD NUMBER^F^^648HRN;1^K:$L(X)>30!($L(X)<1) X
|
---|
| 827 | "^DD",2,2,540001.1,3)
|
---|
| 828 | Enter patient/client's health record number (HRN), up to 30 characters
|
---|
| 829 | "^DD",2,2,540001.1,"DT")
|
---|
| 830 | 3160309
|
---|
| 831 | **END**
|
---|
| 832 | **END**
|
---|