Changeset 508 for ccr/trunk/p/C0CDPT.m


Ignore:
Timestamp:
May 21, 2009, 1:12:11 PM (15 years ago)
Author:
George Lilly
Message:

formatting for Version 1

File:
1 edited

Legend:

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

    r415 r508  
    1 C0CDPT ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
    2  ;;0.2;CCRCCD;;Jun 15, 2008;
     1C0CDPT  ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
     2 ;;1.0;C0C;;May 19, 2009;
    33 ;
    44 ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
     
    8787 ; You can obtain field numbers using the data dictionary
    8888 ;
    89 FAMILY(DFN) ; Family Name
    90  N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
    91  D NAMECOMP^XLFNAME(.NAME)
    92  Q NAME("FAMILY")
    93 GIVEN(DFN) ; Given Name
    94  N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
    95  D NAMECOMP^XLFNAME(.NAME)
    96  Q NAME("GIVEN")
    97 MIDDLE(DFN) ; Middle Name
    98  N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
    99  D NAMECOMP^XLFNAME(.NAME)
    100  Q NAME("MIDDLE")
    101 SUFFIX(DFN) ; Suffi Name
    102  N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
    103  D NAMECOMP^XLFNAME(.NAME)
    104  Q NAME("SUFFIX")
    105 DISPNAME(DFN) ; Display Name
    106  N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
    107  ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
    108  Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
    109 DOB(DFN) ; Date of Birth
     89FAMILY(DFN)     ; Family Name
     90 N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
     91 D NAMECOMP^XLFNAME(.NAME)
     92 Q NAME("FAMILY")
     93GIVEN(DFN)      ; Given Name
     94 N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
     95 D NAMECOMP^XLFNAME(.NAME)
     96 Q NAME("GIVEN")
     97MIDDLE(DFN)     ; Middle Name
     98 N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
     99 D NAMECOMP^XLFNAME(.NAME)
     100 Q NAME("MIDDLE")
     101SUFFIX(DFN)     ; Suffi Name
     102 N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
     103 D NAMECOMP^XLFNAME(.NAME)
     104 Q NAME("SUFFIX")
     105DISPNAME(DFN)   ; Display Name
     106 N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
     107 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
     108 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
     109DOB(DFN)        ; Date of Birth
    110110 N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I")
    111111 ; Date in FM Date Format. Convert to UTC/ISO 8601.
    112112 Q $$FMDTOUTC^C0CUTIL(DOB,"D")
    113 GENDER(DFN) ; Gender/Sex
     113GENDER(DFN)     ; Gender/Sex
    114114 Q $$GET1^DIQ(2,DFN,.02) ;
    115 SSN(DFN) ; SSN
     115SSN(DFN)        ; SSN
    116116 Q $$GET1^DIQ(2,DFN,.09)
    117 ADDRTYPE(DFN) ; Address Type
     117ADDRTYPE(DFN)   ; Address Type
    118118 ; Vista only stores a home address for the patient.
    119119 Q "Home"
    120 ADDR1(DFN) ; Get Home Address line 1
     120ADDR1(DFN)      ; Get Home Address line 1
    121121 Q $$GET1^DIQ(2,DFN,.111)
    122 ADDR2(DFN) ; Get Home Address line 2
     122ADDR2(DFN)      ; Get Home Address line 2
    123123 ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
    124124 N ADDLN2,ADDLN3
     
    126126 Q:ADDLN3="" ADDLN2
    127127 Q ADDLN2_", "_ADDLN3
    128 CITY(DFN) ; Get City for Home Address
     128CITY(DFN)       ; Get City for Home Address
    129129 Q $$GET1^DIQ(2,DFN,.114)
    130 STATE(DFN) ; Get State for Home Address
     130STATE(DFN)      ; Get State for Home Address
    131131 Q $$GET1^DIQ(2,DFN,.115)
    132 ZIP(DFN) ; Get Zip code for Home Address
     132ZIP(DFN)        ; Get Zip code for Home Address
    133133 Q $$GET1^DIQ(2,DFN,.116)
    134 COUNTY(DFN) ; Get County for our Address
     134COUNTY(DFN)     ; Get County for our Address
    135135 Q $$GET1^DIQ(2,DFN,.117)
    136 COUNTRY(DFN) ; Get Country for our Address
     136COUNTRY(DFN)    ; Get Country for our Address
    137137 ; Unfortunately, it's not stored anywhere in Vista, so the inevitable...
    138138 Q "USA"
    139 RESTEL(DFN) ; Residential Telephone
     139RESTEL(DFN)     ; Residential Telephone
    140140 Q $$GET1^DIQ(2,DFN,.131)
    141 WORKTEL(DFN) ; Work Telephone
     141WORKTEL(DFN)    ; Work Telephone
    142142 Q $$GET1^DIQ(2,DFN,.132)
    143 EMAIL(DFN) ; Email Adddress
     143EMAIL(DFN)      ; Email Adddress
    144144 Q $$GET1^DIQ(2,DFN,.133)
    145 CELLTEL(DFN) ; Cell Phone
     145CELLTEL(DFN)    ; Cell Phone
    146146 Q $$GET1^DIQ(2,DFN,.134)
    147 NOK1FAM(DFN) ; Next of Kin 1 (NOK1) Family Name
    148  N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
    149  D NAMECOMP^XLFNAME(.NAME)
    150  Q NAME("FAMILY")
    151 NOK1GIV(DFN) ; NOK1 Given Name
    152  N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
    153  D NAMECOMP^XLFNAME(.NAME)
    154  Q NAME("GIVEN")
    155 NOK1MID(DFN) ; NOK1 Middle Name
    156  N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
    157  D NAMECOMP^XLFNAME(.NAME)
    158  Q NAME("MIDDLE")
    159 NOK1SUF(DFN) ; NOK1 Suffi Name
    160  N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
    161  D NAMECOMP^XLFNAME(.NAME)
    162  Q NAME("SUFFIX")
    163 NOK1DISP(DFN) ; NOK1 Display Name
    164  N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
    165  ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
    166  Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
    167 NOK1REL(DFN) ; NOK1 Relationship to the patient
     147NOK1FAM(DFN)    ; Next of Kin 1 (NOK1) Family Name
     148 N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
     149 D NAMECOMP^XLFNAME(.NAME)
     150 Q NAME("FAMILY")
     151NOK1GIV(DFN)    ; NOK1 Given Name
     152 N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
     153 D NAMECOMP^XLFNAME(.NAME)
     154 Q NAME("GIVEN")
     155NOK1MID(DFN)    ; NOK1 Middle Name
     156 N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
     157 D NAMECOMP^XLFNAME(.NAME)
     158 Q NAME("MIDDLE")
     159NOK1SUF(DFN)    ; NOK1 Suffi Name
     160 N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
     161 D NAMECOMP^XLFNAME(.NAME)
     162 Q NAME("SUFFIX")
     163NOK1DISP(DFN)   ; NOK1 Display Name
     164 N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
     165 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
     166 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
     167NOK1REL(DFN)    ; NOK1 Relationship to the patient
    168168 Q $$GET1^DIQ(2,DFN,.212)
    169 NOK1ADD1(DFN) ; NOK1 Address 1
     169NOK1ADD1(DFN)   ; NOK1 Address 1
    170170 Q $$GET1^DIQ(2,DFN,.213)
    171 NOK1ADD2(DFN) ; NOK1 Address 2
     171NOK1ADD2(DFN)   ; NOK1 Address 2
    172172 N ADDLN2,ADDLN3
    173173 S ADDLN2=$$GET1^DIQ(2,DFN,.214),ADDLN3=$$GET1^DIQ(2,DFN,.215)
    174174 Q:ADDLN3="" ADDLN2
    175175 Q ADDLN2_", "_ADDLN3
    176 NOK1CITY(DFN) ; NOK1 City
     176NOK1CITY(DFN)   ; NOK1 City
    177177 Q $$GET1^DIQ(2,DFN,.216)
    178 NOK1STAT(DFN) ; NOK1 State
     178NOK1STAT(DFN)   ; NOK1 State
    179179 Q $$GET1^DIQ(2,DFN,.217)
    180 NOK1ZIP(DFN) ; NOK1 Zip Code
     180NOK1ZIP(DFN)    ; NOK1 Zip Code
    181181 Q $$GET1^DIQ(2,DFN,.218)
    182 NOK1HTEL(DFN) ; NOK1 Home Telephone
     182NOK1HTEL(DFN)   ; NOK1 Home Telephone
    183183 Q $$GET1^DIQ(2,DFN,.219)
    184 NOK1WTEL(DFN) ; NOK1 Work Telephone
     184NOK1WTEL(DFN)   ; NOK1 Work Telephone
    185185 Q $$GET1^DIQ(2,DFN,.21011)
    186 NOK1SAME(DFN) ; Is NOK1's Address the same the patient?
     186NOK1SAME(DFN)   ; Is NOK1's Address the same the patient?
    187187 Q $$GET1^DIQ(2,DFN,.2125)
    188 NOK2FAM(DFN) ; NOK2 Family Name
    189  N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
    190  D NAMECOMP^XLFNAME(.NAME)
    191  Q NAME("FAMILY")
    192 NOK2GIV(DFN) ; NOK2 Given Name
    193  N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
    194  D NAMECOMP^XLFNAME(.NAME)
    195  Q NAME("GIVEN")
    196 NOK2MID(DFN) ; NOK2 Middle Name
    197  N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
    198  D NAMECOMP^XLFNAME(.NAME)
    199  Q NAME("MIDDLE")
    200 NOK2SUF(DFN) ; NOK2 Suffi Name
    201  N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
    202  D NAMECOMP^XLFNAME(.NAME)
    203  Q NAME("SUFFIX")
    204 NOK2DISP(DFN) ; NOK2 Display Name
    205  N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
    206  ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
    207  Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
    208 NOK2REL(DFN) ; NOK2 Relationship to the patient
     188NOK2FAM(DFN)    ; NOK2 Family Name
     189 N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
     190 D NAMECOMP^XLFNAME(.NAME)
     191 Q NAME("FAMILY")
     192NOK2GIV(DFN)    ; NOK2 Given Name
     193 N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
     194 D NAMECOMP^XLFNAME(.NAME)
     195 Q NAME("GIVEN")
     196NOK2MID(DFN)    ; NOK2 Middle Name
     197 N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
     198 D NAMECOMP^XLFNAME(.NAME)
     199 Q NAME("MIDDLE")
     200NOK2SUF(DFN)    ; NOK2 Suffi Name
     201 N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
     202 D NAMECOMP^XLFNAME(.NAME)
     203 Q NAME("SUFFIX")
     204NOK2DISP(DFN)   ; NOK2 Display Name
     205 N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
     206 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
     207 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
     208NOK2REL(DFN)    ; NOK2 Relationship to the patient
    209209 Q $$GET1^DIQ(2,DFN,.2192)
    210 NOK2ADD1(DFN) ; NOK2 Address 1
     210NOK2ADD1(DFN)   ; NOK2 Address 1
    211211 Q $$GET1^DIQ(2,DFN,.2193)
    212 NOK2ADD2(DFN) ; NOK2 Address 2
     212NOK2ADD2(DFN)   ; NOK2 Address 2
    213213 N ADDLN2,ADDLN3
    214214 S ADDLN2=$$GET1^DIQ(2,DFN,.2194),ADDLN3=$$GET1^DIQ(2,DFN,.2195)
    215215 Q:ADDLN3="" ADDLN2
    216216 Q ADDLN2_", "_ADDLN3
    217 NOK2CITY(DFN) ; NOK2 City
     217NOK2CITY(DFN)   ; NOK2 City
    218218 Q $$GET1^DIQ(2,DFN,.2196)
    219 NOK2STAT(DFN) ; NOK2 State
     219NOK2STAT(DFN)   ; NOK2 State
    220220 Q $$GET1^DIQ(2,DFN,.2197)
    221 NOK2ZIP(DFN) ; NOK2 Zip Code
     221NOK2ZIP(DFN)    ; NOK2 Zip Code
    222222 Q $$GET1^DIQ(2,DFN,.2198)
    223 NOK2HTEL(DFN) ; NOK2 Home Telephone
     223NOK2HTEL(DFN)   ; NOK2 Home Telephone
    224224 Q $$GET1^DIQ(2,DFN,.2199)
    225 NOK2WTEL(DFN) ; NOK2 Work Telephone
     225NOK2WTEL(DFN)   ; NOK2 Work Telephone
    226226 Q $$GET1^DIQ(2,DFN,.211011)
    227 NOK2SAME(DFN) ; Is NOK2's Address the same the patient?
     227NOK2SAME(DFN)   ; Is NOK2's Address the same the patient?
    228228 Q $$GET1^DIQ(2,DFN,.21925)
    229 EMERFAM(DFN) ; Emergency Contact (EMER) Family Name
    230  N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
    231  D NAMECOMP^XLFNAME(.NAME)
    232  Q NAME("FAMILY")
    233 EMERGIV(DFN) ; EMER Given Name
    234  N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
    235  D NAMECOMP^XLFNAME(.NAME)
    236  Q NAME("GIVEN")
    237 EMERMID(DFN) ; EMER Middle Name
    238  N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
    239  D NAMECOMP^XLFNAME(.NAME)
    240  Q NAME("MIDDLE")
    241 EMERSUF(DFN) ; EMER Suffi Name
    242  N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
    243  D NAMECOMP^XLFNAME(.NAME)
    244  Q NAME("SUFFIX")
    245 EMERDISP(DFN) ; EMER Display Name
    246  N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
    247  ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
    248  Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
    249 EMERREL(DFN) ; EMER Relationship to the patient
     229EMERFAM(DFN)    ; Emergency Contact (EMER) Family Name
     230 N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
     231 D NAMECOMP^XLFNAME(.NAME)
     232 Q NAME("FAMILY")
     233EMERGIV(DFN)    ; EMER Given Name
     234 N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
     235 D NAMECOMP^XLFNAME(.NAME)
     236 Q NAME("GIVEN")
     237EMERMID(DFN)    ; EMER Middle Name
     238 N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
     239 D NAMECOMP^XLFNAME(.NAME)
     240 Q NAME("MIDDLE")
     241EMERSUF(DFN)    ; EMER Suffi Name
     242 N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
     243 D NAMECOMP^XLFNAME(.NAME)
     244 Q NAME("SUFFIX")
     245EMERDISP(DFN)   ; EMER Display Name
     246 N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
     247 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
     248 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
     249EMERREL(DFN)    ; EMER Relationship to the patient
    250250 Q $$GET1^DIQ(2,DFN,.331)
    251 EMERADD1(DFN) ; EMER Address 1
     251EMERADD1(DFN)   ; EMER Address 1
    252252 Q $$GET1^DIQ(2,DFN,.333)
    253 EMERADD2(DFN) ; EMER Address 2
     253EMERADD2(DFN)   ; EMER Address 2
    254254 N ADDLN2,ADDLN3
    255255 S ADDLN2=$$GET1^DIQ(2,DFN,.334),ADDLN3=$$GET1^DIQ(2,DFN,.335)
    256256 Q:ADDLN3="" ADDLN2
    257257 Q ADDLN2_", "_ADDLN3
    258 EMERCITY(DFN) ; EMER City
     258EMERCITY(DFN)   ; EMER City
    259259 Q $$GET1^DIQ(2,DFN,.336)
    260 EMERSTAT(DFN) ; EMER State
     260EMERSTAT(DFN)   ; EMER State
    261261 Q $$GET1^DIQ(2,DFN,.337)
    262 EMERZIP(DFN) ; EMER Zip Code
     262EMERZIP(DFN)    ; EMER Zip Code
    263263 Q $$GET1^DIQ(2,DFN,.338)
    264 EMERHTEL(DFN) ; EMER Home Telephone
     264EMERHTEL(DFN)   ; EMER Home Telephone
    265265 Q $$GET1^DIQ(2,DFN,.339)
    266 EMERWTEL(DFN) ; EMER Work Telephone
     266EMERWTEL(DFN)   ; EMER Work Telephone
    267267 Q $$GET1^DIQ(2,DFN,.33011)
    268 EMERSAME(DFN) ; Is EMER's Address the same the NOK?
     268EMERSAME(DFN)   ; Is EMER's Address the same the NOK?
    269269 Q $$GET1^DIQ(2,DFN,.3305)
Note: See TracChangeset for help on using the changeset viewer.