[1788] | 1 | KIDS Distribution saved on Mar 02, 2017@12:25:03
|
---|
| 2 | Update to VWREGIT.m
|
---|
| 3 | **KIDS**:VWREG_PATCH*1.0T3*0^
|
---|
| 4 |
|
---|
| 5 | **INSTALL NAME**
|
---|
| 6 | VWREG_PATCH*1.0T3*0
|
---|
| 7 | "BLD",8568,0)
|
---|
| 8 | VWREG_PATCH*1.0T3*0^^^3170302^n
|
---|
| 9 | "BLD",8568,1,0)
|
---|
| 10 | ^^1^1^3170302^
|
---|
| 11 | "BLD",8568,1,1,0)
|
---|
| 12 | Update to VWREGIT.m to clear an <UNDEF> found during testing
|
---|
| 13 | "BLD",8568,4,0)
|
---|
| 14 | ^9.64PA^^
|
---|
| 15 | "BLD",8568,6.3)
|
---|
| 16 | 2
|
---|
| 17 | "BLD",8568,"KRN",0)
|
---|
| 18 | ^9.67PA^779.2^20
|
---|
| 19 | "BLD",8568,"KRN",.4,0)
|
---|
| 20 | .4
|
---|
| 21 | "BLD",8568,"KRN",.401,0)
|
---|
| 22 | .401
|
---|
| 23 | "BLD",8568,"KRN",.402,0)
|
---|
| 24 | .402
|
---|
| 25 | "BLD",8568,"KRN",.403,0)
|
---|
| 26 | .403
|
---|
| 27 | "BLD",8568,"KRN",.5,0)
|
---|
| 28 | .5
|
---|
| 29 | "BLD",8568,"KRN",.84,0)
|
---|
| 30 | .84
|
---|
| 31 | "BLD",8568,"KRN",3.6,0)
|
---|
| 32 | 3.6
|
---|
| 33 | "BLD",8568,"KRN",3.8,0)
|
---|
| 34 | 3.8
|
---|
| 35 | "BLD",8568,"KRN",9.2,0)
|
---|
| 36 | 9.2
|
---|
| 37 | "BLD",8568,"KRN",9.8,0)
|
---|
| 38 | 9.8
|
---|
| 39 | "BLD",8568,"KRN",9.8,"NM",0)
|
---|
| 40 | ^9.68A^1^1
|
---|
| 41 | "BLD",8568,"KRN",9.8,"NM",1,0)
|
---|
| 42 | VWREGIT^^0^B34639192
|
---|
| 43 | "BLD",8568,"KRN",9.8,"NM","B","VWREGIT",1)
|
---|
| 44 |
|
---|
| 45 | "BLD",8568,"KRN",19,0)
|
---|
| 46 | 19
|
---|
| 47 | "BLD",8568,"KRN",19.1,0)
|
---|
| 48 | 19.1
|
---|
| 49 | "BLD",8568,"KRN",101,0)
|
---|
| 50 | 101
|
---|
| 51 | "BLD",8568,"KRN",409.61,0)
|
---|
| 52 | 409.61
|
---|
| 53 | "BLD",8568,"KRN",771,0)
|
---|
| 54 | 771
|
---|
| 55 | "BLD",8568,"KRN",779.2,0)
|
---|
| 56 | 779.2
|
---|
| 57 | "BLD",8568,"KRN",870,0)
|
---|
| 58 | 870
|
---|
| 59 | "BLD",8568,"KRN",8989.51,0)
|
---|
| 60 | 8989.51
|
---|
| 61 | "BLD",8568,"KRN",8989.52,0)
|
---|
| 62 | 8989.52
|
---|
| 63 | "BLD",8568,"KRN",8994,0)
|
---|
| 64 | 8994
|
---|
| 65 | "BLD",8568,"KRN","B",.4,.4)
|
---|
| 66 |
|
---|
| 67 | "BLD",8568,"KRN","B",.401,.401)
|
---|
| 68 |
|
---|
| 69 | "BLD",8568,"KRN","B",.402,.402)
|
---|
| 70 |
|
---|
| 71 | "BLD",8568,"KRN","B",.403,.403)
|
---|
| 72 |
|
---|
| 73 | "BLD",8568,"KRN","B",.5,.5)
|
---|
| 74 |
|
---|
| 75 | "BLD",8568,"KRN","B",.84,.84)
|
---|
| 76 |
|
---|
| 77 | "BLD",8568,"KRN","B",3.6,3.6)
|
---|
| 78 |
|
---|
| 79 | "BLD",8568,"KRN","B",3.8,3.8)
|
---|
| 80 |
|
---|
| 81 | "BLD",8568,"KRN","B",9.2,9.2)
|
---|
| 82 |
|
---|
| 83 | "BLD",8568,"KRN","B",9.8,9.8)
|
---|
| 84 |
|
---|
| 85 | "BLD",8568,"KRN","B",19,19)
|
---|
| 86 |
|
---|
| 87 | "BLD",8568,"KRN","B",19.1,19.1)
|
---|
| 88 |
|
---|
| 89 | "BLD",8568,"KRN","B",101,101)
|
---|
| 90 |
|
---|
| 91 | "BLD",8568,"KRN","B",409.61,409.61)
|
---|
| 92 |
|
---|
| 93 | "BLD",8568,"KRN","B",771,771)
|
---|
| 94 |
|
---|
| 95 | "BLD",8568,"KRN","B",779.2,779.2)
|
---|
| 96 |
|
---|
| 97 | "BLD",8568,"KRN","B",870,870)
|
---|
| 98 |
|
---|
| 99 | "BLD",8568,"KRN","B",8989.51,8989.51)
|
---|
| 100 |
|
---|
| 101 | "BLD",8568,"KRN","B",8989.52,8989.52)
|
---|
| 102 |
|
---|
| 103 | "BLD",8568,"KRN","B",8994,8994)
|
---|
| 104 |
|
---|
| 105 | "BLD",8568,"QDEF")
|
---|
| 106 | ^^^^NO^^^^NO^^NO
|
---|
| 107 | "BLD",8568,"QUES",0)
|
---|
| 108 | ^9.62^^
|
---|
| 109 | "BLD",8568,"REQB",0)
|
---|
| 110 | ^9.611^^
|
---|
| 111 | "MBREQ")
|
---|
| 112 | 0
|
---|
| 113 | "QUES","XPF1",0)
|
---|
| 114 | Y
|
---|
| 115 | "QUES","XPF1","??")
|
---|
| 116 | ^D REP^XPDH
|
---|
| 117 | "QUES","XPF1","A")
|
---|
| 118 | Shall I write over your |FLAG| File
|
---|
| 119 | "QUES","XPF1","B")
|
---|
| 120 | YES
|
---|
| 121 | "QUES","XPF1","M")
|
---|
| 122 | D XPF1^XPDIQ
|
---|
| 123 | "QUES","XPF2",0)
|
---|
| 124 | Y
|
---|
| 125 | "QUES","XPF2","??")
|
---|
| 126 | ^D DTA^XPDH
|
---|
| 127 | "QUES","XPF2","A")
|
---|
| 128 | Want my data |FLAG| yours
|
---|
| 129 | "QUES","XPF2","B")
|
---|
| 130 | YES
|
---|
| 131 | "QUES","XPF2","M")
|
---|
| 132 | D XPF2^XPDIQ
|
---|
| 133 | "QUES","XPI1",0)
|
---|
| 134 | YO
|
---|
| 135 | "QUES","XPI1","??")
|
---|
| 136 | ^D INHIBIT^XPDH
|
---|
| 137 | "QUES","XPI1","A")
|
---|
| 138 | Want KIDS to INHIBIT LOGONs during the install
|
---|
| 139 | "QUES","XPI1","B")
|
---|
| 140 | NO
|
---|
| 141 | "QUES","XPI1","M")
|
---|
| 142 | D XPI1^XPDIQ
|
---|
| 143 | "QUES","XPM1",0)
|
---|
| 144 | PO^VA(200,:EM
|
---|
| 145 | "QUES","XPM1","??")
|
---|
| 146 | ^D MG^XPDH
|
---|
| 147 | "QUES","XPM1","A")
|
---|
| 148 | Enter the Coordinator for Mail Group '|FLAG|'
|
---|
| 149 | "QUES","XPM1","B")
|
---|
| 150 |
|
---|
| 151 | "QUES","XPM1","M")
|
---|
| 152 | D XPM1^XPDIQ
|
---|
| 153 | "QUES","XPO1",0)
|
---|
| 154 | Y
|
---|
| 155 | "QUES","XPO1","??")
|
---|
| 156 | ^D MENU^XPDH
|
---|
| 157 | "QUES","XPO1","A")
|
---|
| 158 | Want KIDS to Rebuild Menu Trees Upon Completion of Install
|
---|
| 159 | "QUES","XPO1","B")
|
---|
| 160 | NO
|
---|
| 161 | "QUES","XPO1","M")
|
---|
| 162 | D XPO1^XPDIQ
|
---|
| 163 | "QUES","XPZ1",0)
|
---|
| 164 | Y
|
---|
| 165 | "QUES","XPZ1","??")
|
---|
| 166 | ^D OPT^XPDH
|
---|
| 167 | "QUES","XPZ1","A")
|
---|
| 168 | Want to DISABLE Scheduled Options, Menu Options, and Protocols
|
---|
| 169 | "QUES","XPZ1","B")
|
---|
| 170 | NO
|
---|
| 171 | "QUES","XPZ1","M")
|
---|
| 172 | D XPZ1^XPDIQ
|
---|
| 173 | "QUES","XPZ2",0)
|
---|
| 174 | Y
|
---|
| 175 | "QUES","XPZ2","??")
|
---|
| 176 | ^D RTN^XPDH
|
---|
| 177 | "QUES","XPZ2","A")
|
---|
| 178 | Want to MOVE routines to other CPUs
|
---|
| 179 | "QUES","XPZ2","B")
|
---|
| 180 | NO
|
---|
| 181 | "QUES","XPZ2","M")
|
---|
| 182 | D XPZ2^XPDIQ
|
---|
| 183 | "RTN")
|
---|
| 184 | 1
|
---|
| 185 | "RTN","VWREGIT")
|
---|
| 186 | 0^1^B34639192
|
---|
| 187 | "RTN","VWREGIT",1,0)
|
---|
| 188 | VWREGIT ;Portland,OR/Jim Bell, et al Patient Registration Utility August 2015
|
---|
| 189 | "RTN","VWREGIT",2,0)
|
---|
| 190 | ;;2.0;B/FProductions,LLC,WORLD VISTA;**LOCAL**;;Build 2
|
---|
| 191 | "RTN","VWREGIT",3,0)
|
---|
| 192 | ;*******************************************************************
|
---|
| 193 | "RTN","VWREGIT",4,0)
|
---|
| 194 | ;* VW Registration is designed for patient specific fields as *
|
---|
| 195 | "RTN","VWREGIT",5,0)
|
---|
| 196 | ;* defined in Fileman Input Templates or ad hoc field selection. *
|
---|
| 197 | "RTN","VWREGIT",6,0)
|
---|
| 198 | ;* Copyright Martius/MMXV ad infinitum (GNU License: See GPLv3.txt)*
|
---|
| 199 | "RTN","VWREGIT",7,0)
|
---|
| 200 | ;*******************************************************************
|
---|
| 201 | "RTN","VWREGIT",8,0)
|
---|
| 202 | ;;NO FALL THROUGH - JEB
|
---|
| 203 | "RTN","VWREGIT",9,0)
|
---|
| 204 | Q
|
---|
| 205 | "RTN","VWREGIT",10,0)
|
---|
| 206 | ;
|
---|
| 207 | "RTN","VWREGIT",11,0)
|
---|
| 208 | TFM(XF) ;TemplateField Management
|
---|
| 209 | "RTN","VWREGIT",12,0)
|
---|
| 210 | ;***********************************************
|
---|
| 211 | "RTN","VWREGIT",13,0)
|
---|
| 212 | ;* Check primary field entries for "parentage" *
|
---|
| 213 | "RTN","VWREGIT",14,0)
|
---|
| 214 | ;* Add an "*" to gain all sub-fields of the *
|
---|
| 215 | "RTN","VWREGIT",15,0)
|
---|
| 216 | ;* parent *
|
---|
| 217 | "RTN","VWREGIT",16,0)
|
---|
| 218 | ;* REMEMBER: All fields pertain to file 2 only *
|
---|
| 219 | "RTN","VWREGIT",17,0)
|
---|
| 220 | ;***********************************************
|
---|
| 221 | "RTN","VWREGIT",18,0)
|
---|
| 222 | N I,N,FIELD
|
---|
| 223 | "RTN","VWREGIT",19,0)
|
---|
| 224 | K FARRAY
|
---|
| 225 | "RTN","VWREGIT",20,0)
|
---|
| 226 | I '$L(XF),'$G(TNUM) Q ""
|
---|
| 227 | "RTN","VWREGIT",21,0)
|
---|
| 228 | I '$L(XF),+$G(TNUM) S XF=^DIE(TNUM,"DR",1,2)
|
---|
| 229 | "RTN","VWREGIT",22,0)
|
---|
| 230 | F I=1:1:$L(XF,";") S:$L($P(XF,";",I)) FARRAY(I)=+$P(XF,";",I)
|
---|
| 231 | "RTN","VWREGIT",23,0)
|
---|
| 232 | S N=0 F I=1:1 S N=$O(FARRAY(N)) Q:'+N D
|
---|
| 233 | "RTN","VWREGIT",24,0)
|
---|
| 234 | . S FIELD=FARRAY(N)
|
---|
| 235 | "RTN","VWREGIT",25,0)
|
---|
| 236 | . I +$P(^DD(2,FIELD,0),"^",2) S FIELD=FIELD_"*",FMARRAY(FIELD)=$P(^(0),"^",4) K FARRAY(N)
|
---|
| 237 | "RTN","VWREGIT",26,0)
|
---|
| 238 | S XF="",N=0 F S N=$O(FARRAY(N)) Q:'+N S XF=XF_FARRAY(N)_";"
|
---|
| 239 | "RTN","VWREGIT",27,0)
|
---|
| 240 | Q XF
|
---|
| 241 | "RTN","VWREGIT",28,0)
|
---|
| 242 | ;
|
---|
| 243 | "RTN","VWREGIT",29,0)
|
---|
| 244 | CHECK() ;
|
---|
| 245 | "RTN","VWREGIT",30,0)
|
---|
| 246 | Q ""
|
---|
| 247 | "RTN","VWREGIT",31,0)
|
---|
| 248 | ;
|
---|
| 249 | "RTN","VWREGIT",32,0)
|
---|
| 250 | INR() Q $O(RESULT(" "),-1)+1
|
---|
| 251 | "RTN","VWREGIT",33,0)
|
---|
| 252 | ;
|
---|
| 253 | "RTN","VWREGIT",34,0)
|
---|
| 254 | EN(RESULT) ;Template name and ID labels
|
---|
| 255 | "RTN","VWREGIT",35,0)
|
---|
| 256 | ;Get the input template list
|
---|
| 257 | "RTN","VWREGIT",36,0)
|
---|
| 258 | ;housekeeping
|
---|
| 259 | "RTN","VWREGIT",37,0)
|
---|
| 260 | S DTIME=99999
|
---|
| 261 | "RTN","VWREGIT",38,0)
|
---|
| 262 | ZSY "chmod 777 "_$ZD_"regparam/*.txt"
|
---|
| 263 | "RTN","VWREGIT",39,0)
|
---|
| 264 | ;end housekeeping
|
---|
| 265 | "RTN","VWREGIT",40,0)
|
---|
| 266 | ;
|
---|
| 267 | "RTN","VWREGIT",41,0)
|
---|
| 268 | K AR,RESULT
|
---|
| 269 | "RTN","VWREGIT",42,0)
|
---|
| 270 | N N,HD,FILE,LOC,P4,P5,%ZISHF,%ZISHO,DEFST,XTMP,X
|
---|
| 271 | "RTN","VWREGIT",43,0)
|
---|
| 272 | S RESULT(0)=1
|
---|
| 273 | "RTN","VWREGIT",44,0)
|
---|
| 274 | S DEFST="";
|
---|
| 275 | "RTN","VWREGIT",45,0)
|
---|
| 276 | ;S DEFTMP=$O(^DIE("B","FAU_EDU",0)) ;For Florida College only
|
---|
| 277 | "RTN","VWREGIT",46,0)
|
---|
| 278 | S RESULT(0)=$$CONTROL^VWREGITU()
|
---|
| 279 | "RTN","VWREGIT",47,0)
|
---|
| 280 | S RESULT(1)="-1^No templates found"
|
---|
| 281 | "RTN","VWREGIT",48,0)
|
---|
| 282 | S DEFST=$$GET^XPAR("ALL","VW REG DEFAULT STATE")
|
---|
| 283 | "RTN","VWREGIT",49,0)
|
---|
| 284 | S DEFTMP=$$GET^XPAR("ALL","VW REG RDNPT")
|
---|
| 285 | "RTN","VWREGIT",50,0)
|
---|
| 286 | S HD=$$GET^XPAR("ALL","VW GUI REG TEMPLATE DIRECTORY")
|
---|
| 287 | "RTN","VWREGIT",51,0)
|
---|
| 288 | I '$L(HD) K RESULT D Q
|
---|
| 289 | "RTN","VWREGIT",52,0)
|
---|
| 290 | . S RESULT($$INR)="-1^NO HOME DIRECTORY - refer to IT support, if necessary."
|
---|
| 291 | "RTN","VWREGIT",53,0)
|
---|
| 292 | . S RESULT($$INR)="No home directory has been supplied which indicates"
|
---|
| 293 | "RTN","VWREGIT",54,0)
|
---|
| 294 | . S RESULT($$INR)="the VWREG installation is incomplete. See the Help manual"
|
---|
| 295 | "RTN","VWREGIT",55,0)
|
---|
| 296 | . S RESULT($$INR)="for installation and Enter/Editing parameter values."
|
---|
| 297 | "RTN","VWREGIT",56,0)
|
---|
| 298 | . S RESULT($$INR)="Thank you,"
|
---|
| 299 | "RTN","VWREGIT",57,0)
|
---|
| 300 | . S RESULT($$INR)=" The Management."
|
---|
| 301 | "RTN","VWREGIT",58,0)
|
---|
| 302 | S FILE="regit.txt"
|
---|
| 303 | "RTN","VWREGIT",59,0)
|
---|
| 304 | S P4=1
|
---|
| 305 | "RTN","VWREGIT",60,0)
|
---|
| 306 | S P5=""
|
---|
| 307 | "RTN","VWREGIT",61,0)
|
---|
| 308 | S X=$$FTG^%ZISH(HD,FILE,$NA(AR(1)),P4,P5)
|
---|
| 309 | "RTN","VWREGIT",62,0)
|
---|
| 310 | D:+RESULT(0)
|
---|
| 311 | "RTN","VWREGIT",63,0)
|
---|
| 312 | . S $P(RESULT(0),"^",2)=$G(HD)
|
---|
| 313 | "RTN","VWREGIT",64,0)
|
---|
| 314 | . S $P(RESULT(0),"^",3)=$S(DEFST:$P(^DIC(5,DEFST,0),"^")_"("_DEFST_")",1:"")
|
---|
| 315 | "RTN","VWREGIT",65,0)
|
---|
| 316 | . S $P(RESULT(0),"^",4)=$S(+DEFTMP:$P(^DIE(DEFTMP,0),"^")_"("_DEFTMP_")",1:DEFTMP)
|
---|
| 317 | "RTN","VWREGIT",66,0)
|
---|
| 318 | . S $P(RESULT(0),"^",5)=DUZ
|
---|
| 319 | "RTN","VWREGIT",67,0)
|
---|
| 320 | I $O(AR(0)) S RESULT(1)="[TEMPLATES]"
|
---|
| 321 | "RTN","VWREGIT",68,0)
|
---|
| 322 | S N=0 F S N=$O(AR(N)) Q:'+N D
|
---|
| 323 | "RTN","VWREGIT",69,0)
|
---|
| 324 | . Q:$E(AR(N))="*"
|
---|
| 325 | "RTN","VWREGIT",70,0)
|
---|
| 326 | . Q:'+$P(AR(N),"(",2)
|
---|
| 327 | "RTN","VWREGIT",71,0)
|
---|
| 328 | . Q:$P($G(^DIE(+$P(AR(N),"(",2),0)),"^",4)'=2 ;must be pat file
|
---|
| 329 | "RTN","VWREGIT",72,0)
|
---|
| 330 | . S RESULT($$INR)=AR(N)
|
---|
| 331 | "RTN","VWREGIT",73,0)
|
---|
| 332 | S RESULT($$INR)="[ID]"
|
---|
| 333 | "RTN","VWREGIT",74,0)
|
---|
| 334 | ;S N=0 F S N=$O(^DIZ(64850003,N)) Q:'+N S RESULT($$INR)=$P(^(N,0),"^",2)_"("_$P(^(0),"^")_")"
|
---|
| 335 | "RTN","VWREGIT",75,0)
|
---|
| 336 | ;S N=0 F S N=$O(RESULT(N)) Q:'+N K:RESULT(N)="" RESULT(N)
|
---|
| 337 | "RTN","VWREGIT",76,0)
|
---|
| 338 | I '$O(RESULT(0)) S RESULT(1)="-1^No PATIENT FILE templates found"
|
---|
| 339 | "RTN","VWREGIT",77,0)
|
---|
| 340 | K AR
|
---|
| 341 | "RTN","VWREGIT",78,0)
|
---|
| 342 | Q
|
---|
| 343 | "RTN","VWREGIT",79,0)
|
---|
| 344 | ;
|
---|
| 345 | "RTN","VWREGIT",80,0)
|
---|
| 346 | NPT(RESULT,TNAME) ;
|
---|
| 347 | "RTN","VWREGIT",81,0)
|
---|
| 348 | ; *************************************************
|
---|
| 349 | "RTN","VWREGIT",82,0)
|
---|
| 350 | ; * Incoming: DFN^TEMPLATE NAME(IEN) *
|
---|
| 351 | "RTN","VWREGIT",83,0)
|
---|
| 352 | ; * Process : Get template fields plus any help *
|
---|
| 353 | "RTN","VWREGIT",84,0)
|
---|
| 354 | ; * If +TNAME (a DFN), get DFN data for *
|
---|
| 355 | "RTN","VWREGIT",85,0)
|
---|
| 356 | ; * the template fields (Put data in *
|
---|
| 357 | "RTN","VWREGIT",86,0)
|
---|
| 358 | ; * $P(RESULT(N),"^",3)) *
|
---|
| 359 | "RTN","VWREGIT",87,0)
|
---|
| 360 | ; * Return : RESULT(N), etc *
|
---|
| 361 | "RTN","VWREGIT",88,0)
|
---|
| 362 | ; *************************************************
|
---|
| 363 | "RTN","VWREGIT",89,0)
|
---|
| 364 | ;W " ;Intentional bust for debugging
|
---|
| 365 | "RTN","VWREGIT",90,0)
|
---|
| 366 | N N,TNUM,FIELDS,F,FNAME,FVALUE,FHELP,FPSC,FNUM
|
---|
| 367 | "RTN","VWREGIT",91,0)
|
---|
| 368 | S TNUM=+$P(TNAME,"(",2),DFN=+TNAME
|
---|
| 369 | "RTN","VWREGIT",92,0)
|
---|
| 370 | I 'TNUM S RESULT(0)="0^new patient Template not found" Q
|
---|
| 371 | "RTN","VWREGIT",93,0)
|
---|
| 372 | S TNAME=$P($P(TNAME,"^",2),"(")
|
---|
| 373 | "RTN","VWREGIT",94,0)
|
---|
| 374 | S TNAME=$TR(TNAME,"$&*","") ;Clean out TMENU chars
|
---|
| 375 | "RTN","VWREGIT",95,0)
|
---|
| 376 | I TNAME="GENERIC INS. FRM [WorldVistA]" G GIF
|
---|
| 377 | "RTN","VWREGIT",96,0)
|
---|
| 378 | S FIELDS=$G(^DIE(TNUM,"DR",1,2))
|
---|
| 379 | "RTN","VWREGIT",97,0)
|
---|
| 380 | I '$L(FIELDS) Q
|
---|
| 381 | "RTN","VWREGIT",98,0)
|
---|
| 382 | K RESULT S (FNUM,FCAP)=""
|
---|
| 383 | "RTN","VWREGIT",99,0)
|
---|
| 384 | F I=1:1:$L(FIELDS,";")-1 D
|
---|
| 385 | "RTN","VWREGIT",100,0)
|
---|
| 386 | . S F=$P(FIELDS,";",I)
|
---|
| 387 | "RTN","VWREGIT",101,0)
|
---|
| 388 | . Q:'$D(^DD(2,F)) ;Not existing in this patient file
|
---|
| 389 | "RTN","VWREGIT",102,0)
|
---|
| 390 | . I F["~" S FNUM=+F,FNAME=$P($P(F,"~"),FNUM,2),F=FNUM K FNUM
|
---|
| 391 | "RTN","VWREGIT",103,0)
|
---|
| 392 | . S FNAME=$S($L($G(FNAME)):FNAME,$L($G(^DD(2,F,.1))):$P(^(.1),"^"),1:$P(^DD(2,F,0),"^"))
|
---|
| 393 | "RTN","VWREGIT",104,0)
|
---|
| 394 | . S FVALUE="" ;Patient Data
|
---|
| 395 | "RTN","VWREGIT",105,0)
|
---|
| 396 | . S FHELP=$G(^DD(2,F,3))
|
---|
| 397 | "RTN","VWREGIT",106,0)
|
---|
| 398 | . 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)
|
---|
| 399 | "RTN","VWREGIT",107,0)
|
---|
| 400 | . S FHELP=$TR(FHELP,"'","`")
|
---|
| 401 | "RTN","VWREGIT",108,0)
|
---|
| 402 | . S FPSC=$P(^DD(2,F,0),"^",3)
|
---|
| 403 | "RTN","VWREGIT",109,0)
|
---|
| 404 | . S SUBDIC=+$P(^DD(2,F,0),"^",2)
|
---|
| 405 | "RTN","VWREGIT",110,0)
|
---|
| 406 | . S RESULT($$INR)=FNAME_"^"_F_"^"_FVALUE_"^"_FHELP_"^"_FPSC_$S(SUBDIC:"^1",1:"^0")
|
---|
| 407 | "RTN","VWREGIT",111,0)
|
---|
| 408 | . S (FNAME,FVALUE,FHELP,FPSC)=""
|
---|
| 409 | "RTN","VWREGIT",112,0)
|
---|
| 410 | G NPTX:'DFN
|
---|
| 411 | "RTN","VWREGIT",113,0)
|
---|
| 412 | I DFN D GETS^DIQ(2,DFN_",","**","EN","AR") ;,RESULT(0)=$$DFNID^VWREGITU
|
---|
| 413 | "RTN","VWREGIT",114,0)
|
---|
| 414 | K FIELD S N=0 F S N=$O(RESULT(N)) Q:'+N S FIELD($P(RESULT(N),"^",2))=""
|
---|
| 415 | "RTN","VWREGIT",115,0)
|
---|
| 416 | S X="AR" F S X=$Q(@X) Q:X="" D
|
---|
| 417 | "RTN","VWREGIT",116,0)
|
---|
| 418 | . S FILE=+$P(X,"(",2)
|
---|
| 419 | "RTN","VWREGIT",117,0)
|
---|
| 420 | . S FIELD=+$P(X,",",$L(X,",")-1)
|
---|
| 421 | "RTN","VWREGIT",118,0)
|
---|
| 422 | . I $D(FIELD(FIELD)) S FIELD(FIELD)=@X
|
---|
| 423 | "RTN","VWREGIT",119,0)
|
---|
| 424 | S N=0 F S N=$O(FIELD(N)) Q:'+N D
|
---|
| 425 | "RTN","VWREGIT",120,0)
|
---|
| 426 | . S N2=0 F S N2=$O(RESULT(N2)) Q:'+N2 I $P(RESULT(N2),"^",2)=N S $P(RESULT(N2),"^",3)=FIELD(N)
|
---|
| 427 | "RTN","VWREGIT",121,0)
|
---|
| 428 | . S RESULT(0)=$$DFNID^VWREGITU()
|
---|
| 429 | "RTN","VWREGIT",122,0)
|
---|
| 430 | NPTX K FIELD,AR,FCAP,FILE,SUBDIC,N,N2,DFN
|
---|
| 431 | "RTN","VWREGIT",123,0)
|
---|
| 432 | Q
|
---|
| 433 | "RTN","VWREGIT",124,0)
|
---|
| 434 | ;
|
---|
| 435 | "RTN","VWREGIT",125,0)
|
---|
| 436 | PF(RESULT,XPF) ;Pointer file - get the stuff
|
---|
| 437 | "RTN","VWREGIT",126,0)
|
---|
| 438 | K RESULT,AR
|
---|
| 439 | "RTN","VWREGIT",127,0)
|
---|
| 440 | N X,N
|
---|
| 441 | "RTN","VWREGIT",128,0)
|
---|
| 442 | I '$L(XPF) S RESULT(0)="???" Q
|
---|
| 443 | "RTN","VWREGIT",129,0)
|
---|
| 444 | S XPF="^"_XPF
|
---|
| 445 | "RTN","VWREGIT",130,0)
|
---|
| 446 | I +$P(XPF,"(",2)=.85 G NAUTPF ;Naughty file!
|
---|
| 447 | "RTN","VWREGIT",131,0)
|
---|
| 448 | S N=0 F S N=$O(@(XPF_N_")")) Q:'+N S X=$P(^(N,0),"^"),AR(X,N)=X_"("_N_")"
|
---|
| 449 | "RTN","VWREGIT",132,0)
|
---|
| 450 | S X="AR" F S X=$Q(@X) Q:X="" S RESULT($$INR)=@X
|
---|
| 451 | "RTN","VWREGIT",133,0)
|
---|
| 452 | K AR
|
---|
| 453 | "RTN","VWREGIT",134,0)
|
---|
| 454 | Q
|
---|
| 455 | "RTN","VWREGIT",135,0)
|
---|
| 456 | ;
|
---|
| 457 | "RTN","VWREGIT",136,0)
|
---|
| 458 | NAUTPF ;The "NAUGHTY" pointer file - has a numeric .01 - Bad file !!!
|
---|
| 459 | "RTN","VWREGIT",137,0)
|
---|
| 460 | S N=0 F S N=$O(@(XPF_N_")")) Q:'+N S X=$P(^(N,0),"^") D
|
---|
| 461 | "RTN","VWREGIT",138,0)
|
---|
| 462 | . S LANG=$P(^(0),"^",2)
|
---|
| 463 | "RTN","VWREGIT",139,0)
|
---|
| 464 | . S AR(LANG,N)=LANG_"("_N_")"
|
---|
| 465 | "RTN","VWREGIT",140,0)
|
---|
| 466 | S X="AR" F S X=$Q(@X) Q:X="" S RESULT($$INR)=@X
|
---|
| 467 | "RTN","VWREGIT",141,0)
|
---|
| 468 | Q
|
---|
| 469 | "RTN","VWREGIT",142,0)
|
---|
| 470 | GIF ;Generic Insurance form
|
---|
| 471 | "RTN","VWREGIT",143,0)
|
---|
| 472 | K RESULT
|
---|
| 473 | "RTN","VWREGIT",144,0)
|
---|
| 474 | S RESULT($$INR)="Insurance Company^2.312;.01^^^DIC(36,^0"
|
---|
| 475 | "RTN","VWREGIT",145,0)
|
---|
| 476 | S RESULT($$INR)="Group Plan^2.312;.18^^^IBA(355.3,^0"
|
---|
| 477 | "RTN","VWREGIT",146,0)
|
---|
| 478 | S RESULT($$INR)="Policy No.^2.312;1^^^^0"
|
---|
| 479 | "RTN","VWREGIT",147,0)
|
---|
| 480 | ;S RESULT($$INR)="Type of Plan^^^^^0"
|
---|
| 481 | "RTN","VWREGIT",148,0)
|
---|
| 482 | S RESULT($$INR)="Coverage^355.33;40.09^^^IBE(355.1,^0"
|
---|
| 483 | "RTN","VWREGIT",149,0)
|
---|
| 484 | S RESULT($$INR)="Effective Date^2.312;8^^^^0"
|
---|
| 485 | "RTN","VWREGIT",150,0)
|
---|
| 486 | S RESULT($$INR)="Expiration Date^.3121;^^^^0"
|
---|
| 487 | "RTN","VWREGIT",151,0)
|
---|
| 488 | S RESULT($$INR)="Guarantor^^^^^0"
|
---|
| 489 | "RTN","VWREGIT",152,0)
|
---|
| 490 | S RESULT($$INR)="Signature on File^^^^0:NO;1:YES^0"
|
---|
| 491 | "RTN","VWREGIT",153,0)
|
---|
| 492 | S RESULT($$INR)="Employer^2.312;2.015^^^^0"
|
---|
| 493 | "RTN","VWREGIT",154,0)
|
---|
| 494 | S RESULT($$INR)="Billing Address^2.312;2.02^^^^0"
|
---|
| 495 | "RTN","VWREGIT",155,0)
|
---|
| 496 | S RESULT($$INR)="Billing Address(cont)^2.312;2.03^^^^0"
|
---|
| 497 | "RTN","VWREGIT",156,0)
|
---|
| 498 | S RESULT($$INR)="Postal Code^2.312;2.07^^^^0"
|
---|
| 499 | "RTN","VWREGIT",157,0)
|
---|
| 500 | S RESULT($$INR)="City^2.312;2.05^^^^0"
|
---|
| 501 | "RTN","VWREGIT",158,0)
|
---|
| 502 | S RESULT($$INR)="County/Region/Area^^^^^0"
|
---|
| 503 | "RTN","VWREGIT",159,0)
|
---|
| 504 | S RESULT($$INR)="State/Province/Region^2.312;2.06^^^DIC(5,^0"
|
---|
| 505 | "RTN","VWREGIT",160,0)
|
---|
| 506 | Q
|
---|
| 507 | "RTN","VWREGIT",161,0)
|
---|
| 508 | ;
|
---|
| 509 | "RTN","VWREGIT",162,0)
|
---|
| 510 |
|
---|
| 511 | "VER")
|
---|
| 512 | 8.0^22.2
|
---|
| 513 | **END**
|
---|
| 514 | **END**
|
---|