Changeset 26 for ccr/trunk


Ignore:
Timestamp:
Jun 30, 2008, 12:50:31 AM (16 years ago)
Author:
Sam Habiel
Message:

Updated the patient demographics extraction routine (CCRDPT), fixing bugs and improving documentation. Most bugs consisted of undefined errors; thus $Get was added to everything.

Run the unit tester by "D CCRDPTT".

Location:
ccr/trunk/p
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • ccr/trunk/p/CCRDPT.m

    r23 r26  
    44        ;       NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and
    55        ;       DESTROY to clean-up.
     6
     7        ;       The first line of every routine tests if the global exists.
    68       
    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?
     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?
    7274
    7375        W "No Entry at top!" Q
     
    165167FAMILY() ; Family Name; PUBLIC; Extrinsic
    166168        ; PREREQ: PT Defined
     169        Q:$G(PT(0))="" ""
    167170        N NAME S NAME=$P(PT(0),"^",1)
    168171        D NAMECOMP^XLFNAME(.NAME)
     
    171174GIVEN() ; Given Name; PUBLIC; Extrinsic
    172175        ; PREREQ: PT Defined
     176        Q:$G(PT(0))="" ""
    173177        N NAME S NAME=$P(PT(0),"^",1)
    174178        D NAMECOMP^XLFNAME(.NAME)
     
    177181MIDDLE() ; Middle Name; PUBLIC; Extrinsic
    178182        ; PREREQ: PT Defined
     183        Q:$G(PT(0))="" ""
    179184        N NAME S NAME=$P(PT(0),"^",1)
    180185        D NAMECOMP^XLFNAME(.NAME)
     
    183188SUFFIX() ; Suffi Name; PUBLIC; Extrinsic
    184189        ; PREREQ: PT Defined
     190        Q:$G(PT(0))="" ""
    185191        N NAME S NAME=$P(PT(0),"^",1)
    186192        D NAMECOMP^XLFNAME(.NAME)
     
    189195DISPNAME() ; Display Name; PUBLIC; Extrinsic
    190196        ; PREREQ: PT Defined
     197        Q:$G(PT(0))="" ""
    191198        N NAME S NAME=$P(PT(0),"^",1)
    192199        Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
     
    194201DOB() ; Date of Birth; PUBLIC; Extrinsic
    195202        ; PREREQ: PT Defined
     203        Q:$G(PT(0))="" ""
    196204        N DOB S DOB=$P(PT(0),"^",3)
    197205        ; Date in FM Date Format. Convert to UTC/ISO 8601.
     
    200208GENDER() ; Get Gender; PUBLIC; Extrinsic
    201209        ; PREREQ: PT Defined
     210        Q:$G(PT(0))="" ""
    202211        Q $P(PT(0),"^",2)
    203212        ;
    204213SSN() ; Get SSN for ID; PUBLIC; Extrinsic
    205214        ; PREREQ: PT Defined
     215        Q:$G(PT(0))="" ""
    206216        Q $P(PT(0),"^",9)
    207217        ;
    208218ADDRTYPE() ; Get Home Address; PUBLIC; Extrinsic
    209219        ; Vista only stores a home address for the patient.
     220        Q:$G(PT(0))="" ""
    210221        Q "Home"
    211222        ;
    212223ADDR1() ; Get Home Address line 1; PUBLIC; Extrinsic
    213224        ; PREREQ: PT Defined
     225        Q:$G(PT(.11))="" ""
    214226        Q $P(PT(.11),"^",1)
    215227        ;
     
    217229        ; PREREQ: PT Defined
    218230        ; 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)
    219236        Q $P(PT(.11),"^",2)_", "_$P(PT(.11),"^",3)
    220237        ;
    221238CITY() ; Get City for Home Address; PUBLIC; Extrinsic
    222239        ; PREREQ: PT Defined
     240        Q:$G(PT(.11))="" ""
    223241        Q $P(PT(.11),"^",4)
    224242        ;
    225243STATE() ; Get State for Home Address; PUBLIC; Extrinsic
    226244        ; PREREQ: PT Defined
     245        Q:$G(PT(.11))="" ""
    227246        ; State is stored as a pointer
    228247        N STATENUM S STATENUM=$P(PT(.11),"^",5)
     
    232251    ; ==>[3F] ^ (#5) CAPITAL [4F] ^ (#2.1) AAC RECOGNIZED [5S] ^ (#2.2)
    233252    ; ==>US STATE OR POSSESSION [6S] ^
     253        Q:STATENUM="" ""  ; To prevent global undefined below if no state
    234254        Q $P(^DIC(5,STATENUM,0),"^",1)
    235255        ;
    236256ZIP() ; Get Zip code for Home Address; PUBLIC; Extrinsic
    237257        ; PREREQ: PT Defined
     258        Q:$G(PT(.11))="" ""
    238259        Q $P(PT(.11),"^",6)
    239260        ;
    240261COUNTY() ; Get County for our Address; PUBLIC; Extrinsic
    241262        ; PREREQ: PT Defined
     263        Q:$G(PT(.11))="" ""
    242264        Q $P(PT(.11),"^",7)
    243265        ;
    244266COUNTRY() ; Get Country for our Address; PUBLIC; Extrinsic
    245267        ; Unfortunately, I can't find where that is stored, so the inevitable...
     268        Q:$G(PT(.11))="" ""
    246269        Q "USA"
    247270        ;
    248271RESTEL() ; Residential Telephone; PUBLIC; Extrinsic
    249272        ; PREREQ: PT Defined
     273        Q:$G(PT(.13))="" ""
    250274        Q $P(PT(.13),"^",1)
    251275        ;
    252276WORKTEL() ; Work Telephone; PUBLIC; Extrinsic
    253277        ; PREREQ: PT Defined
     278        Q:$G(PT(.13))="" ""
    254279        Q $P(PT(.13),"^",2)
    255280        ;
    256281EMAIL() ; Email Adddress; PUBLIC; Extrinsic
    257282        ; PREREQ: PT Defined
     283        Q:$G(PT(.13))="" ""
    258284        Q $P(PT(.13),"^",3)
    259285        ;
    260286CELLTEL() ; Cell Phone; PUBLIC; Extrinsic
    261287        ; PREREQ: PT Defined
     288        Q:$G(PT(.13))="" ""
    262289        Q $P(PT(.13),"^",4)
    263290        ;
    264291NOK1FAM() ; Next of Kin 1 (NOK1) Family Name; PUBLIC; Extrinsic
    265292        ; PREREQ: PT Defined
     293        Q:$G(PT(.21))="" ""
    266294        N NAME S NAME=$P(PT(.21),"^",1)
    267295        D NAMECOMP^XLFNAME(.NAME)
     
    270298NOK1GIV() ; NOK1 Given Name; PUBLIC; Extrinsic
    271299        ; PREREQ: PT Defined
     300        Q:$G(PT(.21))="" ""
    272301        N NAME S NAME=$P(PT(.21),"^",1)
    273302        D NAMECOMP^XLFNAME(.NAME)
     
    276305NOK1MID() ; NOK1 Middle Name; PUBLIC; Extrinsic
    277306        ; PREREQ: PT Defined
     307        Q:$G(PT(.21))="" ""
    278308        N NAME S NAME=$P(PT(.21),"^",1)
    279309        D NAMECOMP^XLFNAME(.NAME)
     
    282312NOK1SUF() ; NOK1 Suffi Name; PUBLIC; Extrinsic
    283313        ; PREREQ: PT Defined
     314        Q:$G(PT(.21))="" ""
    284315        N NAME S NAME=$P(PT(.21),"^",1)
    285316        D NAMECOMP^XLFNAME(.NAME)
     
    288319NOK1DISP() ; NOK1 Display Name; PUBLIC; Extrinsic
    289320        ; PREREQ: PT Defined
     321        Q:$G(PT(.21))="" ""
    290322        N NAME S NAME=$P(PT(.21),"^",1)
    291323        Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
     
    293325NOK1REL() ; NOK1 Relationship to the patient; PUBLIC; Extrinsic
    294326        ; PREREQ: PT Defined
     327        Q:$G(PT(.21))="" ""
    295328        Q $P(PT(.21),"^",2)
    296329        ;
    297330NOK1ADD1() ; NOK1 Address 1; PUBLIC; Extrinsic
    298331        ; PREREQ: PT Defined
     332        Q:$G(PT(.21))="" ""
    299333        Q $P(PT(.21),"^",3)
    300334        ;
     
    302336        ; PREREQ: PT Defined
    303337        ; 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)
    304343        Q $P(PT(.21),"^",4)_", "_$P(PT(.21),"^",5)
    305344        ;
    306345NOK1CITY() ; NOK1 City; PUBLIC; Extrinsic
    307346        ; PREREQ: PT Defined
     347        Q:$G(PT(.21))="" ""
    308348        Q $P(PT(.21),"^",6)
    309349        ;
    310350NOK1STAT() ; NOK1 State; PUBLIC; Extrinsic
    311351        ; PREREQ: PT Defined
     352        Q:$G(PT(.21))="" ""
    312353        N STATENUM S STATENUM=$P(PT(.21),"^",7)
     354        Q:STATENUM="" ""
    313355        Q $P(^DIC(5,STATENUM,0),"^",1)
    314356        ;
    315357NOK1ZIP() ; NOK1 Zip Code; PUBLIC; Extrinsic
    316358        ; PREREQ: PT Defined
     359        Q:$G(PT(.21))="" ""
    317360        Q $P(PT(.21),"^",8)
    318361        ;
    319362NOK1HTEL() ; NOK1 Home Telephone; PUBLIC; Extrinsic
    320363        ; PREREQ: PT Defined
     364        Q:$G(PT(.21))="" ""
    321365        Q $P(PT(.21),"^",9)
    322366        ;
    323367NOK1WTEL() ; NOK1 Work Telephone; PUBLIC; Extrinsic
    324368        ; PREREQ: PT Defined
     369        Q:$G(PT(.21))="" ""
    325370        Q $P(PT(.21),"^",11)
    326371        ;
    327372NOK1SAME() ; Is NOK1's Address the same the patient?; PUBLIC; Extrinsic
    328373        ; PREREQ: PT Defined
     374        Q:$G(PT(.21))="" ""
    329375        Q $P(PT(.21),"^",10)
    330376        ;
    331377NOK2FAM() ; NOK2 Family Name; PUBLIC; Extrinsic
    332378        ; PREREQ: PT Defined
     379        Q:$G(PT(.211))="" ""
    333380        N NAME S NAME=$P(PT(.211),"^",1)
    334381        D NAMECOMP^XLFNAME(.NAME)
    335382        Q NAME("FAMILY")
    336383        ;
    337 NOK2GIV() ; NOK2 Given Name; PUBLIC; Extrinsic
    338         ; PREREQ: PT Defined
     384NOK2GIV() ; NOK2 Given Name; PUBLIC; Extrinsic ; PREREQ: PT Defined
     385        Q:$G(PT(.211))="" ""
    339386        N NAME S NAME=$P(PT(.211),"^",1)
    340387        D NAMECOMP^XLFNAME(.NAME)
     
    343390NOK2MID() ; NOK2 Middle Name; PUBLIC; Extrinsic
    344391        ; PREREQ: PT Defined
     392        Q:$G(PT(.211))="" ""
    345393        N NAME S NAME=$P(PT(.211),"^",1)
    346394        D NAMECOMP^XLFNAME(.NAME)
     
    349397NOK2SUF() ; NOK2 Suffi Name; PUBLIC; Extrinsic
    350398        ; PREREQ: PT Defined
     399        Q:$G(PT(.211))="" ""
    351400        N NAME S NAME=$P(PT(.211),"^",1)
    352401        D NAMECOMP^XLFNAME(.NAME)
     
    354403NOK2DISP() ; NOK2 Display Name; PUBLIC; Extrinsic
    355404        ; PREREQ: PT Defined
     405        Q:$G(PT(.211))="" ""
    356406        N NAME S NAME=$P(PT(.211),"^",1)
    357407        Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
     
    359409NOK2REL() ; NOK2 Relationship to the patient; PUBLIC; Extrinsic
    360410        ; PREREQ: PT Defined
     411        Q:$G(PT(.211))="" ""
    361412        Q $P(PT(.211),"^",2)
    362413        ;
    363414NOK2ADD1() ; NOK2 Address 1; PUBLIC; Extrinsic
    364415        ; PREREQ: PT Defined
     416        Q:$G(PT(.211))="" ""
    365417        Q $P(PT(.211),"^",3)
    366418        ;
     
    368420        ; PREREQ: PT Defined
    369421        ; 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)
    370427        Q $P(PT(.211),"^",4)_", "_$P(PT(.211),"^",5)
    371428        ;
    372429NOK2CITY() ; NOK2 City; PUBLIC; Extrinsic
    373430        ; PREREQ: PT Defined
     431        Q:$G(PT(.211))="" ""
    374432        Q $P(PT(.211),"^",6)
    375433        ;
    376434NOK2STAT() ; NOK2 State; PUBLIC; Extrinsic
    377435        ; PREREQ: PT Defined
     436        Q:$G(PT(.211))="" ""
    378437        N STATENUM S STATENUM=$P(PT(.211),"^",7)
     438        Q:STATENUM="" ""  ; To prevent global undefined below if no state
    379439        Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
    380440        ;
    381441NOK2ZIP() ; NOK2 Zip Code; PUBLIC; Extrinsic
    382442        ; PREREQ: PT Defined
     443        Q:$G(PT(.211))="" ""
    383444        Q $P(PT(.211),"^",8)
    384445        ;
    385446NOK2HTEL() ; NOK2 Home Telephone; PUBLIC; Extrinsic
    386447        ; PREREQ: PT Defined
     448        Q:$G(PT(.211))="" ""
    387449        Q $P(PT(.211),"^",9)
    388450        ;
    389451NOK2WTEL() ; NOK2 Work Telephone; PUBLIC; Extrinsic
    390452        ; PREREQ: PT Defined
     453        Q:$G(PT(.211))="" ""
    391454        Q $P(PT(.211),"^",11)
    392455        ;
    393456NOK2SAME() ; Is NOK2's Address the same the patient?; PUBLIC; Extrinsic
    394457        ; PREREQ: PT Defined
     458        Q:$G(PT(.211))="" ""
    395459        Q $P(PT(.211),"^",10)
    396460        ;
    397461EMERFAM() ; Emergency Contact (EMER) Family Name; PUBLIC; Extrinsic
    398462        ; PREREQ: PT Defined
     463        Q:$G(PT(.33))="" ""
    399464        N NAME S NAME=$P(PT(.33),"^",1)
    400465        D NAMECOMP^XLFNAME(.NAME)
     
    403468EMERGIV() ; EMER Given Name; PUBLIC; Extrinsic
    404469        ; PREREQ: PT Defined
     470        Q:$G(PT(.33))="" ""
    405471        N NAME S NAME=$P(PT(.33),"^",1)
    406472        D NAMECOMP^XLFNAME(.NAME)
     
    409475EMERMID() ; EMER Middle Name; PUBLIC; Extrinsic
    410476        ; PREREQ: PT Defined
     477        Q:$G(PT(.33))="" ""
    411478        N NAME S NAME=$P(PT(.33),"^",1)
    412479        D NAMECOMP^XLFNAME(.NAME)
     
    415482EMERSUF() ; EMER Suffi Name; PUBLIC; Extrinsic
    416483        ; PREREQ: PT Defined
     484        Q:$G(PT(.33))="" ""
    417485        N NAME S NAME=$P(PT(.33),"^",1)
    418486        D NAMECOMP^XLFNAME(.NAME)
     
    420488EMERDISP() ; EMER Display Name; PUBLIC; Extrinsic
    421489        ; PREREQ: PT Defined
     490        Q:$G(PT(.33))="" ""
    422491        N NAME S NAME=$P(PT(.33),"^",1)
    423492        Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
     
    425494EMERREL() ; EMER Relationship to the patient; PUBLIC; Extrinsic
    426495        ; PREREQ: PT Defined
     496        Q:$G(PT(.33))="" ""
    427497        Q $P(PT(.33),"^",2)
    428498        ;
    429499EMERADD1() ; EMER Address 1; PUBLIC; Extrinsic
    430500        ; PREREQ: PT Defined
     501        Q:$G(PT(.33))="" ""
    431502        Q $P(PT(.33),"^",3)
    432503        ;
     
    434505        ; PREREQ: PT Defined
    435506        ; 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)
    436512        Q $P(PT(.33),"^",4)_", "_$P(PT(.33),"^",5)
    437513        ;
    438514EMERCITY() ; EMER City; PUBLIC; Extrinsic
    439515        ; PREREQ: PT Defined
     516        Q:$G(PT(.33))="" ""
    440517        Q $P(PT(.33),"^",6)
    441518        ;
    442519EMERSTAT() ; EMER State; PUBLIC; Extrinsic
    443520        ; PREREQ: PT Defined
     521        Q:$G(PT(.33))="" ""
    444522        N STATENUM S STATENUM=$P(PT(.33),"^",7)
     523        Q:STATENUM="" ""  ; To prevent global undefined below if no state
    445524        Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
    446525        ;
    447526EMERZIP() ; EMER Zip Code; PUBLIC; Extrinsic
    448527        ; PREREQ: PT Defined
     528        Q:$G(PT(.33))="" ""
    449529        Q $P(PT(.33),"^",8)
    450530        ;
    451531EMERHTEL() ; EMER Home Telephone; PUBLIC; Extrinsic
    452532        ; PREREQ: PT Defined
     533        Q:$G(PT(.33))="" ""
    453534        Q $P(PT(.33),"^",9)
    454535        ;
    455536EMERWTEL() ; EMER Work Telephone; PUBLIC; Extrinsic
    456537        ; PREREQ: PT Defined
     538        Q:$G(PT(.33))="" ""
    457539        Q $P(PT(.33),"^",11)
    458540        ;
    459541EMERSAME() ; Is EMER's Address the same the NOK?; PUBLIC; Extrinsic
    460542        ; PREREQ: PT Defined
     543        Q:$G(PT(.33))="" ""
    461544        Q $P(PT(.33),"^",10)
    462545        ;
  • ccr/trunk/p/CCRDPTT.m

    r23 r26  
    1313       
    1414        ; Load Routine Entry points; We get a sweeeeeet array
    15         N OUT
    1615        D ANALYZE^ARJTXRD("CCRDPT",.OUT) ; Analyze a routine in the directory
    17         ZWR OUT(,0)
    18        
    1916        N X,Y
    2017        ; Select Patient
     
    2421        D INIT^CCRDPT($P(Y,"^"))
    2522        ZWR PT
    26         N I S I=160 F  S I=$O(OUT(I)) Q:I=""  D
     23        N I S I=165 F  S I=$O(OUT(I)) Q:I=""  D
    2724        . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
    2825        . W "valued at "
Note: See TracChangeset for help on using the changeset viewer.