Changes in ccr/trunk/p/CCRDPT.m [14:26]
- File:
-
- 1 edited
-
ccr/trunk/p/CCRDPT.m (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/CCRDPT.m
r14 r26 4 4 ; NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and 5 5 ; DESTROY to clean-up. 6 7 ; The first line of every routine tests if the global exists. 8 9 ; CCRDPT 83 lines CCRCCD/SMH - Routines to Extract Patient Data for 10 ; INIT 9 lines Copy DFN global to a local variable 11 ; DESTROY 6 lines Kill local variable 12 ; FAMILY 6 lines Family Name 13 ; GIVEN 6 lines Given Name 14 ; MIDDLE 6 lines Middle Name 15 ; SUFFIX 6 lines Suffix Name 16 ; DISPNAME 5 lines Display Name 17 ; DOB 6 lines Date of Birth 18 ; GENDER 4 lines Get Gender 19 ; SSN 4 lines Get SSN for ID 20 ; ADDRTYPE 4 lines Get Home Address 21 ; ADDR1 4 lines Get Home Address line 1 22 ; ADDR2 5 lines Get Home Address line 2 23 ; CITY 4 lines Get City for Home Address 24 ; STATE 11 lines Get State for Home Address 25 ; ZIP 4 lines Get Zip code for Home Address 26 ; COUNTY 4 lines Get County for our Address 27 ; COUNTRY 4 lines Get Country for our Address 28 ; RESTEL 4 lines Residential Telephone 29 ; WORKTEL 4 lines Work Telephone 30 ; EMAIL 4 lines Email Adddress 31 ; CELLTEL 4 lines Cell Phone 32 ; NOK1FAM 6 lines Next of Kin 1 (NOK1) Family Name 33 ; NOK1GIV 6 lines NOK1 Given Name 34 ; NOK1MID 6 lines NOK1 Middle Name 35 ; NOK1SUF 6 lines NOK1 Suffi Name 36 ; NOK1DISP 5 lines NOK1 Display Name 37 ; NOK1REL 4 lines NOK1 Relationship to the patient 38 ; NOK1ADD1 4 lines NOK1 Address 1 39 ; NOK1ADD2 5 lines NOK1 Address 2 40 ; NOK1CITY 4 lines NOK1 City 41 ; NOK1STAT 5 lines NOK1 State 42 ; NOK1ZIP 4 lines NOK1 Zip Code 43 ; NOK1HTEL; 4 lines NOK1 Home Telephone 44 ; NOK1WTEL; 4 lines NOK1 Work Telephone 45 ; NOK1SAME; 4 lines Is NOK1's Address the same the patient? 46 ; NOK2FAM 6 lines NOK2 Family Name 47 ; NOK2GIV 6 lines NOK2 Given Name 48 ; NOK2MID 6 lines NOK2 Middle Name 49 ; NOK2SUF 5 lines NOK2 Suffi Name 50 ; NOK2DISP 5 lines NOK2 Display Name 51 ; NOK2REL 4 lines NOK2 Relationship to the patient 52 ; NOK2ADD1 4 lines NOK2 Address 1 53 ; NOK2ADD2 5 lines NOK2 Address 2 54 ; NOK2CITY 4 lines NOK2 City 55 ; NOK2STAT 5 lines NOK2 State 56 ; NOK2ZIP 4 lines NOK2 Zip Code 57 ; NOK2HTEL; 4 lines NOK2 Home Telephone 58 ; NOK2WTEL; 4 lines NOK2 Work Telephone 59 ; NOK2SAME; 4 lines Is NOK2's Address the same the patient? 60 ; EMERFAM 6 lines Emergency Contact (EMER) Family Name 61 ; EMERGIV 6 lines EMER Given Name 62 ; EMERMID 6 lines EMER Middle Name 63 ; EMERSUF 5 lines EMER Suffi Name 64 ; EMERDISP 5 lines EMER Display Name 65 ; EMERREL 4 lines EMER Relationship to the patient 66 ; EMERADD1 4 lines EMER Address 1 67 ; EMERADD2 5 lines EMER Address 2 68 ; EMERCITY 4 lines EMER City 69 ; EMERSTAT 5 lines EMER State 70 ; EMERZIP 4 lines EMER Zip Code 71 ; EMERHTEL; 4 lines EMER Home Telephone 72 ; EMERWTEL; 4 lines EMER Work Telephone 73 ; EMERSAME; 4 lines Is EMER's Address the same the NOK? 6 74 7 75 W "No Entry at top!" Q … … 99 167 FAMILY() ; Family Name; PUBLIC; Extrinsic 100 168 ; PREREQ: PT Defined 169 Q:$G(PT(0))="" "" 101 170 N NAME S NAME=$P(PT(0),"^",1) 102 171 D NAMECOMP^XLFNAME(.NAME) … … 105 174 GIVEN() ; Given Name; PUBLIC; Extrinsic 106 175 ; PREREQ: PT Defined 176 Q:$G(PT(0))="" "" 107 177 N NAME S NAME=$P(PT(0),"^",1) 108 178 D NAMECOMP^XLFNAME(.NAME) … … 111 181 MIDDLE() ; Middle Name; PUBLIC; Extrinsic 112 182 ; PREREQ: PT Defined 183 Q:$G(PT(0))="" "" 113 184 N NAME S NAME=$P(PT(0),"^",1) 114 185 D NAMECOMP^XLFNAME(.NAME) … … 117 188 SUFFIX() ; Suffi Name; PUBLIC; Extrinsic 118 189 ; PREREQ: PT Defined 190 Q:$G(PT(0))="" "" 119 191 N NAME S NAME=$P(PT(0),"^",1) 120 192 D NAMECOMP^XLFNAME(.NAME) … … 123 195 DISPNAME() ; Display Name; PUBLIC; Extrinsic 124 196 ; PREREQ: PT Defined 197 Q:$G(PT(0))="" "" 125 198 N NAME S NAME=$P(PT(0),"^",1) 126 199 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") … … 128 201 DOB() ; Date of Birth; PUBLIC; Extrinsic 129 202 ; PREREQ: PT Defined 203 Q:$G(PT(0))="" "" 130 204 N DOB S DOB=$P(PT(0),"^",3) 131 205 ; Date in FM Date Format. Convert to UTC/ISO 8601. … … 134 208 GENDER() ; Get Gender; PUBLIC; Extrinsic 135 209 ; PREREQ: PT Defined 210 Q:$G(PT(0))="" "" 136 211 Q $P(PT(0),"^",2) 137 212 ; 138 213 SSN() ; Get SSN for ID; PUBLIC; Extrinsic 139 214 ; PREREQ: PT Defined 215 Q:$G(PT(0))="" "" 140 216 Q $P(PT(0),"^",9) 141 217 ; 142 ADDRTYPE( ADDR) ; Get Home Address; PUBLIC; Extrinsic218 ADDRTYPE() ; Get Home Address; PUBLIC; Extrinsic 143 219 ; Vista only stores a home address for the patient. 220 Q:$G(PT(0))="" "" 144 221 Q "Home" 145 222 ; 146 223 ADDR1() ; Get Home Address line 1; PUBLIC; Extrinsic 147 224 ; PREREQ: PT Defined 225 Q:$G(PT(.11))="" "" 148 226 Q $P(PT(.11),"^",1) 149 227 ; … … 151 229 ; PREREQ: PT Defined 152 230 ; Vista has Lines 2,3; CCR has only line 1,2; so compromise 231 Q:$G(PT(.11))="" "" 232 ; If the thrid address is empty, just return the 2nd. 233 ; If the 2nd is empty, we don't lose, b/c it will return "" 234 ; This is so that we won't produce a comma if there is no 3rd addr. 235 Q:$P(PT(.11),"^",3)="" $P(PT(.11),"^",2) 153 236 Q $P(PT(.11),"^",2)_", "_$P(PT(.11),"^",3) 154 237 ; 155 238 CITY() ; Get City for Home Address; PUBLIC; Extrinsic 156 239 ; PREREQ: PT Defined 240 Q:$G(PT(.11))="" "" 157 241 Q $P(PT(.11),"^",4) 158 242 ; 159 243 STATE() ; Get State for Home Address; PUBLIC; Extrinsic 160 244 ; PREREQ: PT Defined 245 Q:$G(PT(.11))="" "" 161 246 ; State is stored as a pointer 162 N STATENUM =$P(PT(.11)"^",5)247 N STATENUM S STATENUM=$P(PT(.11),"^",5) 163 248 ; 164 249 ; State File Global is below … … 166 251 ; ==>[3F] ^ (#5) CAPITAL [4F] ^ (#2.1) AAC RECOGNIZED [5S] ^ (#2.2) 167 252 ; ==>US STATE OR POSSESSION [6S] ^ 253 Q:STATENUM="" "" ; To prevent global undefined below if no state 168 254 Q $P(^DIC(5,STATENUM,0),"^",1) 169 255 ; 170 ZIP() ; Get Zip code for Home Address 171 ; PREREQ: PT Defined 256 ZIP() ; Get Zip code for Home Address; PUBLIC; Extrinsic 257 ; PREREQ: PT Defined 258 Q:$G(PT(.11))="" "" 172 259 Q $P(PT(.11),"^",6) 173 260 ; 174 COUNTY() ; Get County for our Address 175 ; PREREQ: PT Defined 261 COUNTY() ; Get County for our Address; PUBLIC; Extrinsic 262 ; PREREQ: PT Defined 263 Q:$G(PT(.11))="" "" 176 264 Q $P(PT(.11),"^",7) 177 265 ; 266 COUNTRY() ; Get Country for our Address; PUBLIC; Extrinsic 267 ; Unfortunately, I can't find where that is stored, so the inevitable... 268 Q:$G(PT(.11))="" "" 269 Q "USA" 270 ; 271 RESTEL() ; Residential Telephone; PUBLIC; Extrinsic 272 ; PREREQ: PT Defined 273 Q:$G(PT(.13))="" "" 274 Q $P(PT(.13),"^",1) 275 ; 276 WORKTEL() ; Work Telephone; PUBLIC; Extrinsic 277 ; PREREQ: PT Defined 278 Q:$G(PT(.13))="" "" 279 Q $P(PT(.13),"^",2) 280 ; 281 EMAIL() ; Email Adddress; PUBLIC; Extrinsic 282 ; PREREQ: PT Defined 283 Q:$G(PT(.13))="" "" 284 Q $P(PT(.13),"^",3) 285 ; 286 CELLTEL() ; Cell Phone; PUBLIC; Extrinsic 287 ; PREREQ: PT Defined 288 Q:$G(PT(.13))="" "" 289 Q $P(PT(.13),"^",4) 290 ; 291 NOK1FAM() ; Next of Kin 1 (NOK1) Family Name; PUBLIC; Extrinsic 292 ; PREREQ: PT Defined 293 Q:$G(PT(.21))="" "" 294 N NAME S NAME=$P(PT(.21),"^",1) 295 D NAMECOMP^XLFNAME(.NAME) 296 Q NAME("FAMILY") 297 ; 298 NOK1GIV() ; NOK1 Given Name; PUBLIC; Extrinsic 299 ; PREREQ: PT Defined 300 Q:$G(PT(.21))="" "" 301 N NAME S NAME=$P(PT(.21),"^",1) 302 D NAMECOMP^XLFNAME(.NAME) 303 Q NAME("GIVEN") 304 ; 305 NOK1MID() ; NOK1 Middle Name; PUBLIC; Extrinsic 306 ; PREREQ: PT Defined 307 Q:$G(PT(.21))="" "" 308 N NAME S NAME=$P(PT(.21),"^",1) 309 D NAMECOMP^XLFNAME(.NAME) 310 Q NAME("MIDDLE") 311 ; 312 NOK1SUF() ; NOK1 Suffi Name; PUBLIC; Extrinsic 313 ; PREREQ: PT Defined 314 Q:$G(PT(.21))="" "" 315 N NAME S NAME=$P(PT(.21),"^",1) 316 D NAMECOMP^XLFNAME(.NAME) 317 Q NAME("SUFFIX") 318 ; 319 NOK1DISP() ; NOK1 Display Name; PUBLIC; Extrinsic 320 ; PREREQ: PT Defined 321 Q:$G(PT(.21))="" "" 322 N NAME S NAME=$P(PT(.21),"^",1) 323 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") 324 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma 325 NOK1REL() ; NOK1 Relationship to the patient; PUBLIC; Extrinsic 326 ; PREREQ: PT Defined 327 Q:$G(PT(.21))="" "" 328 Q $P(PT(.21),"^",2) 329 ; 330 NOK1ADD1() ; NOK1 Address 1; PUBLIC; Extrinsic 331 ; PREREQ: PT Defined 332 Q:$G(PT(.21))="" "" 333 Q $P(PT(.21),"^",3) 334 ; 335 NOK1ADD2() ; NOK1 Address 2; PUBLIC; Extrinsic 336 ; PREREQ: PT Defined 337 ; As before, CCR only allows two fileds for the address, so we have to compromise 338 Q:$G(PT(.21))="" "" 339 ; If the thrid address is empty, just return the 2nd. 340 ; If the 2nd is empty, we don't lose, b/c it will return "" 341 ; This is so that we won't produce a comma if there is no 3rd addr. 342 Q:$P(PT(.21),"^",5)="" $P(PT(.21),"^",4) 343 Q $P(PT(.21),"^",4)_", "_$P(PT(.21),"^",5) 344 ; 345 NOK1CITY() ; NOK1 City; PUBLIC; Extrinsic 346 ; PREREQ: PT Defined 347 Q:$G(PT(.21))="" "" 348 Q $P(PT(.21),"^",6) 349 ; 350 NOK1STAT() ; NOK1 State; PUBLIC; Extrinsic 351 ; PREREQ: PT Defined 352 Q:$G(PT(.21))="" "" 353 N STATENUM S STATENUM=$P(PT(.21),"^",7) 354 Q:STATENUM="" "" 355 Q $P(^DIC(5,STATENUM,0),"^",1) 356 ; 357 NOK1ZIP() ; NOK1 Zip Code; PUBLIC; Extrinsic 358 ; PREREQ: PT Defined 359 Q:$G(PT(.21))="" "" 360 Q $P(PT(.21),"^",8) 361 ; 362 NOK1HTEL() ; NOK1 Home Telephone; PUBLIC; Extrinsic 363 ; PREREQ: PT Defined 364 Q:$G(PT(.21))="" "" 365 Q $P(PT(.21),"^",9) 366 ; 367 NOK1WTEL() ; NOK1 Work Telephone; PUBLIC; Extrinsic 368 ; PREREQ: PT Defined 369 Q:$G(PT(.21))="" "" 370 Q $P(PT(.21),"^",11) 371 ; 372 NOK1SAME() ; Is NOK1's Address the same the patient?; PUBLIC; Extrinsic 373 ; PREREQ: PT Defined 374 Q:$G(PT(.21))="" "" 375 Q $P(PT(.21),"^",10) 376 ; 377 NOK2FAM() ; NOK2 Family Name; PUBLIC; Extrinsic 378 ; PREREQ: PT Defined 379 Q:$G(PT(.211))="" "" 380 N NAME S NAME=$P(PT(.211),"^",1) 381 D NAMECOMP^XLFNAME(.NAME) 382 Q NAME("FAMILY") 383 ; 384 NOK2GIV() ; NOK2 Given Name; PUBLIC; Extrinsic ; PREREQ: PT Defined 385 Q:$G(PT(.211))="" "" 386 N NAME S NAME=$P(PT(.211),"^",1) 387 D NAMECOMP^XLFNAME(.NAME) 388 Q NAME("GIVEN") 389 ; 390 NOK2MID() ; NOK2 Middle Name; PUBLIC; Extrinsic 391 ; PREREQ: PT Defined 392 Q:$G(PT(.211))="" "" 393 N NAME S NAME=$P(PT(.211),"^",1) 394 D NAMECOMP^XLFNAME(.NAME) 395 Q NAME("MIDDLE") 396 ; 397 NOK2SUF() ; NOK2 Suffi Name; PUBLIC; Extrinsic 398 ; PREREQ: PT Defined 399 Q:$G(PT(.211))="" "" 400 N NAME S NAME=$P(PT(.211),"^",1) 401 D NAMECOMP^XLFNAME(.NAME) 402 Q NAME("SUFFIX") 403 NOK2DISP() ; NOK2 Display Name; PUBLIC; Extrinsic 404 ; PREREQ: PT Defined 405 Q:$G(PT(.211))="" "" 406 N NAME S NAME=$P(PT(.211),"^",1) 407 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") 408 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma 409 NOK2REL() ; NOK2 Relationship to the patient; PUBLIC; Extrinsic 410 ; PREREQ: PT Defined 411 Q:$G(PT(.211))="" "" 412 Q $P(PT(.211),"^",2) 413 ; 414 NOK2ADD1() ; NOK2 Address 1; PUBLIC; Extrinsic 415 ; PREREQ: PT Defined 416 Q:$G(PT(.211))="" "" 417 Q $P(PT(.211),"^",3) 418 ; 419 NOK2ADD2() ; NOK2 Address 2; PUBLIC; Extrinsic 420 ; PREREQ: PT Defined 421 ; As before, CCR only allows two fileds for the address, so we have to compromise 422 Q:$G(PT(.211))="" "" 423 ; If the thrid address is empty, just return the 2nd. 424 ; If the 2nd is empty, we don't lose, b/c it will return "" 425 ; This is so that we won't produce a comma if there is no 3rd addr. 426 Q:$P(PT(.211),"^",5)="" $P(PT(.211),"^",4) 427 Q $P(PT(.211),"^",4)_", "_$P(PT(.211),"^",5) 428 ; 429 NOK2CITY() ; NOK2 City; PUBLIC; Extrinsic 430 ; PREREQ: PT Defined 431 Q:$G(PT(.211))="" "" 432 Q $P(PT(.211),"^",6) 433 ; 434 NOK2STAT() ; NOK2 State; PUBLIC; Extrinsic 435 ; PREREQ: PT Defined 436 Q:$G(PT(.211))="" "" 437 N STATENUM S STATENUM=$P(PT(.211),"^",7) 438 Q:STATENUM="" "" ; To prevent global undefined below if no state 439 Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above 440 ; 441 NOK2ZIP() ; NOK2 Zip Code; PUBLIC; Extrinsic 442 ; PREREQ: PT Defined 443 Q:$G(PT(.211))="" "" 444 Q $P(PT(.211),"^",8) 445 ; 446 NOK2HTEL() ; NOK2 Home Telephone; PUBLIC; Extrinsic 447 ; PREREQ: PT Defined 448 Q:$G(PT(.211))="" "" 449 Q $P(PT(.211),"^",9) 450 ; 451 NOK2WTEL() ; NOK2 Work Telephone; PUBLIC; Extrinsic 452 ; PREREQ: PT Defined 453 Q:$G(PT(.211))="" "" 454 Q $P(PT(.211),"^",11) 455 ; 456 NOK2SAME() ; Is NOK2's Address the same the patient?; PUBLIC; Extrinsic 457 ; PREREQ: PT Defined 458 Q:$G(PT(.211))="" "" 459 Q $P(PT(.211),"^",10) 460 ; 461 EMERFAM() ; Emergency Contact (EMER) Family Name; PUBLIC; Extrinsic 462 ; PREREQ: PT Defined 463 Q:$G(PT(.33))="" "" 464 N NAME S NAME=$P(PT(.33),"^",1) 465 D NAMECOMP^XLFNAME(.NAME) 466 Q NAME("FAMILY") 467 ; 468 EMERGIV() ; EMER Given Name; PUBLIC; Extrinsic 469 ; PREREQ: PT Defined 470 Q:$G(PT(.33))="" "" 471 N NAME S NAME=$P(PT(.33),"^",1) 472 D NAMECOMP^XLFNAME(.NAME) 473 Q NAME("GIVEN") 474 ; 475 EMERMID() ; EMER Middle Name; PUBLIC; Extrinsic 476 ; PREREQ: PT Defined 477 Q:$G(PT(.33))="" "" 478 N NAME S NAME=$P(PT(.33),"^",1) 479 D NAMECOMP^XLFNAME(.NAME) 480 Q NAME("MIDDLE") 481 ; 482 EMERSUF() ; EMER Suffi Name; PUBLIC; Extrinsic 483 ; PREREQ: PT Defined 484 Q:$G(PT(.33))="" "" 485 N NAME S NAME=$P(PT(.33),"^",1) 486 D NAMECOMP^XLFNAME(.NAME) 487 Q NAME("SUFFIX") 488 EMERDISP() ; EMER Display Name; PUBLIC; Extrinsic 489 ; PREREQ: PT Defined 490 Q:$G(PT(.33))="" "" 491 N NAME S NAME=$P(PT(.33),"^",1) 492 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") 493 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma 494 EMERREL() ; EMER Relationship to the patient; PUBLIC; Extrinsic 495 ; PREREQ: PT Defined 496 Q:$G(PT(.33))="" "" 497 Q $P(PT(.33),"^",2) 498 ; 499 EMERADD1() ; EMER Address 1; PUBLIC; Extrinsic 500 ; PREREQ: PT Defined 501 Q:$G(PT(.33))="" "" 502 Q $P(PT(.33),"^",3) 503 ; 504 EMERADD2() ; EMER Address 2; PUBLIC; Extrinsic 505 ; PREREQ: PT Defined 506 ; As before, CCR only allows two fileds for the address, so we have to compromise 507 Q:$G(PT(.33))="" "" 508 ; If the thrid address is empty, just return the 2nd. 509 ; If the 2nd is empty, we don't lose, b/c it will return "" 510 ; This is so that we won't produce a comma if there is no 3rd addr. 511 Q:$P(PT(.33),"^",5)="" $P(PT(.33),"^",4) 512 Q $P(PT(.33),"^",4)_", "_$P(PT(.33),"^",5) 513 ; 514 EMERCITY() ; EMER City; PUBLIC; Extrinsic 515 ; PREREQ: PT Defined 516 Q:$G(PT(.33))="" "" 517 Q $P(PT(.33),"^",6) 518 ; 519 EMERSTAT() ; EMER State; PUBLIC; Extrinsic 520 ; PREREQ: PT Defined 521 Q:$G(PT(.33))="" "" 522 N STATENUM S STATENUM=$P(PT(.33),"^",7) 523 Q:STATENUM="" "" ; To prevent global undefined below if no state 524 Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above 525 ; 526 EMERZIP() ; EMER Zip Code; PUBLIC; Extrinsic 527 ; PREREQ: PT Defined 528 Q:$G(PT(.33))="" "" 529 Q $P(PT(.33),"^",8) 530 ; 531 EMERHTEL() ; EMER Home Telephone; PUBLIC; Extrinsic 532 ; PREREQ: PT Defined 533 Q:$G(PT(.33))="" "" 534 Q $P(PT(.33),"^",9) 535 ; 536 EMERWTEL() ; EMER Work Telephone; PUBLIC; Extrinsic 537 ; PREREQ: PT Defined 538 Q:$G(PT(.33))="" "" 539 Q $P(PT(.33),"^",11) 540 ; 541 EMERSAME() ; Is EMER's Address the same the NOK?; PUBLIC; Extrinsic 542 ; PREREQ: PT Defined 543 Q:$G(PT(.33))="" "" 544 Q $P(PT(.33),"^",10) 545 ;
Note:
See TracChangeset
for help on using the changeset viewer.
