Changeset 23
- Timestamp:
- Jun 26, 2008, 11:23:21 PM (16 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 1 added
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/CCRDPT.m
r21 r23 4 4 ; NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and 5 5 ; DESTROY to clean-up. 6 7 ; CCRDPT 83 lines CCRCCD/SMH - Routines to Extract Patient Data for 8 ; INIT 9 lines Copy DFN global to a local variable 9 ; DESTROY 6 lines Kill local variable 10 ; FAMILY 6 lines Family Name 11 ; GIVEN 6 lines Given Name 12 ; MIDDLE 6 lines Middle Name 13 ; SUFFIX 6 lines Suffi Name 14 ; DISPNAME 5 lines Display Name 15 ; DOB 6 lines Date of Birth 16 ; GENDER 4 lines Get Gender 17 ; SSN 4 lines Get SSN for ID 18 ; ADDRTYPE 4 lines Get Home Address 19 ; ADDR1 4 lines Get Home Address line 1 20 ; ADDR2 5 lines Get Home Address line 2 21 ; CITY 4 lines Get City for Home Address 22 ; STATE 11 lines Get State for Home Address 23 ; ZIP 4 lines Get Zip code for Home Address 24 ; COUNTY 4 lines Get County for our Address 25 ; COUNTRY 4 lines Get Country for our Address 26 ; RESTEL 4 lines Residential Telephone 27 ; WORKTEL 4 lines Work Telephone 28 ; EMAIL 4 lines Email Adddress 29 ; CELLTEL 4 lines Cell Phone 30 ; NOK1FAM 6 lines Next of Kin 1 (NOK1) Family Name 31 ; NOK1GIV 6 lines NOK1 Given Name 32 ; NOK1MID 6 lines NOK1 Middle Name 33 ; NOK1SUF 6 lines NOK1 Suffi Name 34 ; NOK1DISP 5 lines NOK1 Display Name 35 ; NOK1REL 4 lines NOK1 Relationship to the patient 36 ; NOK1ADD1 4 lines NOK1 Address 1 37 ; NOK1ADD2 5 lines NOK1 Address 2 38 ; NOK1CITY 4 lines NOK1 City 39 ; NOK1STAT 5 lines NOK1 State 40 ; NOK1ZIP 4 lines NOK1 Zip Code 41 ; NOK1HTEL; 4 lines NOK1 Home Telephone 42 ; NOK1WTEL; 4 lines NOK1 Work Telephone 43 ; NOK1SAME; 4 lines Is NOK1's Address the same the patient? 44 ; NOK2FAM 6 lines NOK2 Family Name 45 ; NOK2GIV 6 lines NOK2 Given Name 46 ; NOK2MID 6 lines NOK2 Middle Name 47 ; NOK2SUF 5 lines NOK2 Suffi Name 48 ; NOK2DISP 5 lines NOK2 Display Name 49 ; NOK2REL 4 lines NOK2 Relationship to the patient 50 ; NOK2ADD1 4 lines NOK2 Address 1 51 ; NOK2ADD2 5 lines NOK2 Address 2 52 ; NOK2CITY 4 lines NOK2 City 53 ; NOK2STAT 5 lines NOK2 State 54 ; NOK2ZIP 4 lines NOK2 Zip Code 55 ; NOK2HTEL; 4 lines NOK2 Home Telephone 56 ; NOK2WTEL; 4 lines NOK2 Work Telephone 57 ; NOK2SAME; 4 lines Is NOK2's Address the same the patient? 58 ; EMERFAM 6 lines Emergency Contact (EMER) Family Name 59 ; EMERGIV 6 lines EMER Given Name 60 ; EMERMID 6 lines EMER Middle Name 61 ; EMERSUF 5 lines EMER Suffi Name 62 ; EMERDISP 5 lines EMER Display Name 63 ; EMERREL 4 lines EMER Relationship to the patient 64 ; EMERADD1 4 lines EMER Address 1 65 ; EMERADD2 5 lines EMER Address 2 66 ; EMERCITY 4 lines EMER City 67 ; EMERSTAT 5 lines EMER State 68 ; EMERZIP 4 lines EMER Zip Code 69 ; EMERHTEL; 4 lines EMER Home Telephone 70 ; EMERWTEL; 4 lines EMER Work Telephone 71 ; EMERSAME; 4 lines Is EMER's Address the same the NOK? 6 72 7 73 W "No Entry at top!" Q … … 140 206 Q $P(PT(0),"^",9) 141 207 ; 142 ADDRTYPE( ADDR) ; Get Home Address; PUBLIC; Extrinsic208 ADDRTYPE() ; Get Home Address; PUBLIC; Extrinsic 143 209 ; Vista only stores a home address for the patient. 144 210 Q "Home" … … 225 291 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") 226 292 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma 293 NOK1REL() ; NOK1 Relationship to the patient; PUBLIC; Extrinsic 294 ; PREREQ: PT Defined 295 Q $P(PT(.21),"^",2) 296 ; 297 NOK1ADD1() ; NOK1 Address 1; PUBLIC; Extrinsic 298 ; PREREQ: PT Defined 299 Q $P(PT(.21),"^",3) 300 ; 301 NOK1ADD2() ; NOK1 Address 2; PUBLIC; Extrinsic 302 ; PREREQ: PT Defined 303 ; As before, CCR only allows two fileds for the address, so we have to compromise 304 Q $P(PT(.21),"^",4)_", "_$P(PT(.21),"^",5) 305 ; 306 NOK1CITY() ; NOK1 City; PUBLIC; Extrinsic 307 ; PREREQ: PT Defined 308 Q $P(PT(.21),"^",6) 309 ; 310 NOK1STAT() ; NOK1 State; PUBLIC; Extrinsic 311 ; PREREQ: PT Defined 312 N STATENUM S STATENUM=$P(PT(.21),"^",7) 313 Q $P(^DIC(5,STATENUM,0),"^",1) 314 ; 315 NOK1ZIP() ; NOK1 Zip Code; PUBLIC; Extrinsic 316 ; PREREQ: PT Defined 317 Q $P(PT(.21),"^",8) 318 ; 319 NOK1HTEL() ; NOK1 Home Telephone; PUBLIC; Extrinsic 320 ; PREREQ: PT Defined 321 Q $P(PT(.21),"^",9) 322 ; 323 NOK1WTEL() ; NOK1 Work Telephone; PUBLIC; Extrinsic 324 ; PREREQ: PT Defined 325 Q $P(PT(.21),"^",11) 326 ; 327 NOK1SAME() ; Is NOK1's Address the same the patient?; PUBLIC; Extrinsic 328 ; PREREQ: PT Defined 329 Q $P(PT(.21),"^",10) 330 ; 227 331 NOK2FAM() ; NOK2 Family Name; PUBLIC; Extrinsic 228 332 ; PREREQ: PT Defined … … 248 352 D NAMECOMP^XLFNAME(.NAME) 249 353 Q NAME("SUFFIX") 250 ;251 354 NOK2DISP() ; NOK2 Display Name; PUBLIC; Extrinsic 252 355 ; PREREQ: PT Defined … … 254 357 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") 255 358 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma 256 359 NOK2REL() ; NOK2 Relationship to the patient; PUBLIC; Extrinsic 360 ; PREREQ: PT Defined 361 Q $P(PT(.211),"^",2) 362 ; 363 NOK2ADD1() ; NOK2 Address 1; PUBLIC; Extrinsic 364 ; PREREQ: PT Defined 365 Q $P(PT(.211),"^",3) 366 ; 367 NOK2ADD2() ; NOK2 Address 2; PUBLIC; Extrinsic 368 ; PREREQ: PT Defined 369 ; As before, CCR only allows two fileds for the address, so we have to compromise 370 Q $P(PT(.211),"^",4)_", "_$P(PT(.211),"^",5) 371 ; 372 NOK2CITY() ; NOK2 City; PUBLIC; Extrinsic 373 ; PREREQ: PT Defined 374 Q $P(PT(.211),"^",6) 375 ; 376 NOK2STAT() ; NOK2 State; PUBLIC; Extrinsic 377 ; PREREQ: PT Defined 378 N STATENUM S STATENUM=$P(PT(.211),"^",7) 379 Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above 380 ; 381 NOK2ZIP() ; NOK2 Zip Code; PUBLIC; Extrinsic 382 ; PREREQ: PT Defined 383 Q $P(PT(.211),"^",8) 384 ; 385 NOK2HTEL() ; NOK2 Home Telephone; PUBLIC; Extrinsic 386 ; PREREQ: PT Defined 387 Q $P(PT(.211),"^",9) 388 ; 389 NOK2WTEL() ; NOK2 Work Telephone; PUBLIC; Extrinsic 390 ; PREREQ: PT Defined 391 Q $P(PT(.211),"^",11) 392 ; 393 NOK2SAME() ; Is NOK2's Address the same the patient?; PUBLIC; Extrinsic 394 ; PREREQ: PT Defined 395 Q $P(PT(.211),"^",10) 396 ; 397 EMERFAM() ; Emergency Contact (EMER) Family Name; PUBLIC; Extrinsic 398 ; PREREQ: PT Defined 399 N NAME S NAME=$P(PT(.33),"^",1) 400 D NAMECOMP^XLFNAME(.NAME) 401 Q NAME("FAMILY") 402 ; 403 EMERGIV() ; EMER Given Name; PUBLIC; Extrinsic 404 ; PREREQ: PT Defined 405 N NAME S NAME=$P(PT(.33),"^",1) 406 D NAMECOMP^XLFNAME(.NAME) 407 Q NAME("GIVEN") 408 ; 409 EMERMID() ; EMER Middle Name; PUBLIC; Extrinsic 410 ; PREREQ: PT Defined 411 N NAME S NAME=$P(PT(.33),"^",1) 412 D NAMECOMP^XLFNAME(.NAME) 413 Q NAME("MIDDLE") 414 ; 415 EMERSUF() ; EMER Suffi Name; PUBLIC; Extrinsic 416 ; PREREQ: PT Defined 417 N NAME S NAME=$P(PT(.33),"^",1) 418 D NAMECOMP^XLFNAME(.NAME) 419 Q NAME("SUFFIX") 420 EMERDISP() ; EMER Display Name; PUBLIC; Extrinsic 421 ; PREREQ: PT Defined 422 N NAME S NAME=$P(PT(.33),"^",1) 423 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") 424 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma 425 EMERREL() ; EMER Relationship to the patient; PUBLIC; Extrinsic 426 ; PREREQ: PT Defined 427 Q $P(PT(.33),"^",2) 428 ; 429 EMERADD1() ; EMER Address 1; PUBLIC; Extrinsic 430 ; PREREQ: PT Defined 431 Q $P(PT(.33),"^",3) 432 ; 433 EMERADD2() ; EMER Address 2; PUBLIC; Extrinsic 434 ; PREREQ: PT Defined 435 ; As before, CCR only allows two fileds for the address, so we have to compromise 436 Q $P(PT(.33),"^",4)_", "_$P(PT(.33),"^",5) 437 ; 438 EMERCITY() ; EMER City; PUBLIC; Extrinsic 439 ; PREREQ: PT Defined 440 Q $P(PT(.33),"^",6) 441 ; 442 EMERSTAT() ; EMER State; PUBLIC; Extrinsic 443 ; PREREQ: PT Defined 444 N STATENUM S STATENUM=$P(PT(.33),"^",7) 445 Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above 446 ; 447 EMERZIP() ; EMER Zip Code; PUBLIC; Extrinsic 448 ; PREREQ: PT Defined 449 Q $P(PT(.33),"^",8) 450 ; 451 EMERHTEL() ; EMER Home Telephone; PUBLIC; Extrinsic 452 ; PREREQ: PT Defined 453 Q $P(PT(.33),"^",9) 454 ; 455 EMERWTEL() ; EMER Work Telephone; PUBLIC; Extrinsic 456 ; PREREQ: PT Defined 457 Q $P(PT(.33),"^",11) 458 ; 459 EMERSAME() ; Is EMER's Address the same the NOK?; PUBLIC; Extrinsic 460 ; PREREQ: PT Defined 461 Q $P(PT(.33),"^",10) 462 ;
Note:
See TracChangeset
for help on using the changeset viewer.
