| 1 | CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
|
|---|
| 2 | ;;0.1;CCRCCD;;Jun 15, 2008;
|
|---|
| 3 |
|
|---|
| 4 | ; NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and
|
|---|
| 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?
|
|---|
| 74 |
|
|---|
| 75 | W "No Entry at top!" Q
|
|---|
| 76 |
|
|---|
| 77 | ; The following is a map of the relevant data in the patient global.
|
|---|
| 78 | ;
|
|---|
| 79 | ; ^DPT(D0,0)= (#.01) NAME [1F] ^ (#.02) SEX [2S] ^ (#.03) DATE OF BIRTH [3D] ^
|
|---|
| 80 | ; ==>^ (#.05) MARITAL STATUS [5P:11] ^ (#.06) RACE [6P:10] ^ (#.07)
|
|---|
| 81 | ; ==>OCCUPATION [7F] ^ (#.08) RELIGIOUS PREFERENCE [8P:13] ^ (#.09)
|
|---|
| 82 | ; ==>SOCIAL SECURITY NUMBER [9F] ^ (#.091) REMARKS [10F] ^ (#.092)
|
|---|
| 83 | ; ==>PLACE OF BIRTH [CITY] [11F] ^ (#.093) PLACE OF BIRTH [STATE]
|
|---|
| 84 | ; ==>[12P:5] ^ ^ (#.14) CURRENT MEANS TEST STATUS [14P:408.32] ^
|
|---|
| 85 | ; ==>(#.096) WHO ENTERED PATIENT [15P:200] ^ (#.097) DATE ENTERED INTO
|
|---|
| 86 | ; ==>FILE [16D] ^ (#.098) HOW WAS PATIENT ENTERED? [17S] ^ (#.081)
|
|---|
| 87 | ; ==>DUPLICATE STATUS [18S] ^ (#.082) PATIENT MERGED TO [19P:2] ^
|
|---|
| 88 | ; ==>(#.083) CHECK FOR DUPLICATE [20S] ^ (#.6) TEST PATIENT INDICATOR
|
|---|
| 89 | ; ==>[21S] ^
|
|---|
| 90 | ; ^DPT(D0,.01,0)=^2.01^^ (#1) ALIAS
|
|---|
| 91 | ; ^DPT(D0,.01,D1,0)= (#.01) ALIAS [1F] ^ (#1) ALIAS SSN [2F] ^ (#100.03) ALIAS
|
|---|
| 92 | ; ==>COMPONENTS [3P:20] ^
|
|---|
| 93 | ; ^DPT(D0,.11)= (#.111) STREET ADDRESS [LINE 1] [1F] ^ (#.112) STREET ADDRESS
|
|---|
| 94 | ; ==>[LINE 2] [2F] ^ (#.113) STREET ADDRESS [LINE 3] [3F] ^ (#.114)
|
|---|
| 95 | ; ==>CITY [4F] ^ (#.115) STATE [5P:5] ^ (#.116) ZIP CODE [6F] ^
|
|---|
| 96 | ; ==>(#.117) COUNTY [7N] ^ ^ ^ ^ ^ (#.1112) ZIP+4 [12F] ^
|
|---|
| 97 | ; ==>(#.118) ADDRESS CHANGE DT/TM [13D] ^ (#.119) ADDRESS CHANGE
|
|---|
| 98 | ; ==>SOURCE [14S] ^ (#.12) ADDRESS CHANGE SITE [15P:4] ^ (#.121) BAD
|
|---|
| 99 | ; ==>ADDRESS INDICATOR [16S] ^ (#.122) ADDRESS CHANGE USER [17P:200]
|
|---|
| 100 | ; ==>^
|
|---|
| 101 | ; ^DPT(D0,.121)= (#.1211) TEMPORARY STREET [LINE 1] [1F] ^ (#.1212) TEMPORARY
|
|---|
| 102 | ; ==>STREET [LINE 2] [2F] ^ (#.1213) TEMPORARY STREET [LINE 3] [3F]
|
|---|
| 103 | ; ==>^ (#.1214) TEMPORARY CITY [4F] ^ (#.1215) TEMPORARY STATE
|
|---|
| 104 | ; ==>[5P:5] ^ (#.1216) TEMPORARY ZIP CODE [6F] ^ (#.1217) TEMPORARY
|
|---|
| 105 | ; ==>ADDRESS START DATE [7D] ^ (#.1218) TEMPORARY ADDRESS END DATE
|
|---|
| 106 | ; ==>[8D] ^ (#.12105) TEMPORARY ADDRESS ACTIVE? [9S] ^ (#.1219)
|
|---|
| 107 | ; ==>TEMPORARY PHONE NUMBER [10F] ^ (#.12111) TEMPORARY ADDRESS
|
|---|
| 108 | ; ==>COUNTY [11N] ^ (#.12112) TEMPORARY ZIP+4 [12F] ^ (#.12113)
|
|---|
| 109 | ; ==>TEMPORARY ADDRESS CHANGE DT/TM [13D] ^
|
|---|
| 110 | ; ^DPT(D0,.121)= (#.12114) TEMPORARY ADDRESS CHANGE SITE [14P:4] ^
|
|---|
| 111 | ; ^DPT(D0,.13)= (#.131) PHONE NUMBER [RESIDENCE] [1F] ^ (#.132) PHONE NUMBER
|
|---|
| 112 | ; ==>[WORK] [2F] ^ (#.133) EMAIL ADDRESS [3F] ^ (#.134) PHONE NUMBER
|
|---|
| 113 | ; ==>[CELLULAR] [4F] ^ (#.135) PAGER NUMBER [5F] ^ (#.136) EMAIL
|
|---|
| 114 | ; ==>ADDRESS CHANGE DT/TM [6D] ^ (#.137) EMAIL ADDRESS CHANGE SOURCE
|
|---|
| 115 | ; ==>[7S] ^ (#.138) EMAIL ADDRESS CHANGE SITE [8P:4] ^ (#.139)
|
|---|
| 116 | ; ==>CELLULAR NUMBER CHANGE DT/TM [9D] ^ (#.1311) CELLULAR NUMBER
|
|---|
| 117 | ; ==>CHANGE SOURCE [10S] ^ (#.13111) CELLULAR NUMBER CHANGE SITE
|
|---|
| 118 | ; ==>[11P:4] ^ (#.1312) PAGER NUMBER CHANGE DT/TM [12D] ^ (#.1313)
|
|---|
| 119 | ; ==>PAGER NUMBER CHANGE SOURCE [13S] ^ (#.1314) PAGER NUMBER CHANGE
|
|---|
| 120 | ; ==>SITE [14P:4] ^
|
|---|
| 121 | ; ^DPT(D0,.21)= (#.211) K-NAME OF PRIMARY NOK [1F] ^ (#.212) K-RELATIONSHIP TO
|
|---|
| 122 | ; ==>PATIENT [2F] ^ (#.213) K-STREET ADDRESS [LINE 1] [3F] ^ (#.214)
|
|---|
| 123 | ; ==>K-STREET ADDRESS [LINE 2] [4F] ^ (#.215) K-STREET ADDRESS [LINE
|
|---|
| 124 | ; ==>3] [5F] ^
|
|---|
| 125 | ; ^DPT(D0,.21)= (#.216) K-CITY [6F] ^ (#.217) K-STATE [7P:5] ^ (#.218) K-ZIP
|
|---|
| 126 | ; ==>CODE [8F] ^ (#.219) K-PHONE NUMBER [9F] ^ (#.2125) K-ADDRESS
|
|---|
| 127 | ; ==>SAME AS PATIENT'S? [10S] ^ (#.21011) K-WORK PHONE NUMBER [11F]
|
|---|
| 128 | ; ==>^
|
|---|
| 129 | ; ^DPT(D0,.211)= (#.2191) K2-NAME OF SECONDARY NOK [1F] ^ (#.2192)
|
|---|
| 130 | ; ==>K2-RELATIONSHIP TO PATIENT [2F] ^ (#.2193) K2-STREET ADDRESS
|
|---|
| 131 | ; ==>[LINE 1] [3F] ^ (#.2194) K2-STREET ADDRESS [LINE 2] [4F] ^
|
|---|
| 132 | ; ==>(#.2195) K2-STREET ADDRESS [LINE 3] [5F] ^ (#.2196) K2-CITY
|
|---|
| 133 | ; ==>[6F] ^ (#.2197) K2-STATE [7P:5] ^ (#.2198) K2-ZIP CODE [8F] ^
|
|---|
| 134 | ; ==>(#.2199) K2-PHONE NUMBER [9F] ^ (#.21925) K2-ADDRESS SAME AS
|
|---|
| 135 | ; ==>PATIENT'S? [10S] ^ (#.211011) K2-WORK PHONE NUMBER [11F] ^
|
|---|
| 136 | ; ^DPT(D0,.25)= (#.251) SPOUSE'S EMPLOYER NAME [1F] ^ (#.252) SPOUSE'S EMP
|
|---|
| 137 | ; ==>STREET [LINE 1] [2F] ^ (#.253) SPOUSE'S EMP STREET [LINE 2]
|
|---|
| 138 | ; ==>[3F] ^ (#.254) SPOUSE'S EMP STREET [LINE 3] [4F] ^ (#.255)
|
|---|
| 139 | ; ==>SPOUSE'S EMPLOYER'S CITY [5F] ^ (#.256) SPOUSE'S EMPLOYER'S
|
|---|
| 140 | ; ==>STATE [6P:5] ^ (#.257) SPOUSE'S EMP ZIP CODE [7F] ^ (#.258)
|
|---|
| 141 | ; ==>SPOUSE'S EMP PHONE NUMBER [8F] ^ ^ ^ ^ ^ ^ (#.2514)
|
|---|
| 142 | ; ==>SPOUSE'S OCCUPATION [14F] ^ (#.2515) SPOUSE'S EMPLOYMENT STATUS
|
|---|
| 143 | ; ==>[15S] ^ (#.2516) SPOUSE'S RETIREMENT DATE [16D] ^
|
|---|
| 144 | ; ^DPT(D0,.33)= (#.331) E-NAME [1F] ^ (#.332) E-RELATIONSHIP TO PATIENT [2F] ^
|
|---|
| 145 | ; ==>(#.333) E-STREET ADDRESS [LINE 1] [3F] ^ (#.334) E-STREET
|
|---|
| 146 | ; ==>ADDRESS [LINE 2] [4F] ^ (#.335) E-STREET ADDRESS [LINE 3] [5F]
|
|---|
| 147 | ; ==>^ (#.336) E-CITY [6F] ^ (#.337) E-STATE [7P:5] ^ (#.338) E-ZIP
|
|---|
| 148 | ; ==>CODE [8F] ^ (#.339) E-PHONE NUMBER [9F] ^ (#.3305) E-EMER.
|
|---|
| 149 | ; ==>CONTACT SAME AS NOK? [10S] ^ (#.33011) E-WORK PHONE NUMBER
|
|---|
| 150 | ; ==>[11F] ^
|
|---|
| 151 |
|
|---|
| 152 | INIT(DFN) ; Copy DFN global to a local variable; PUBLIC
|
|---|
| 153 | ; INPUT: Patient IEN (DFN)
|
|---|
| 154 | ; OUTPUT: PT in the Symbol Table, representing the patient global
|
|---|
| 155 |
|
|---|
| 156 | ; Instead of accessing a global each single read (SLOOOOW)
|
|---|
| 157 | ; read it off a local variable stored in Memory.
|
|---|
| 158 | M PT=^DPT(DFN)
|
|---|
| 159 | Q
|
|---|
| 160 | ;
|
|---|
| 161 | DESTROY ; Kill local variable; PUBLIC
|
|---|
| 162 | ; INPUT: None
|
|---|
| 163 | ; OUTPUT: Kill PT from the Symbol Table after you are done
|
|---|
| 164 | K PT
|
|---|
| 165 | Q
|
|---|
| 166 | ;
|
|---|
| 167 | FAMILY() ; Family Name; PUBLIC; Extrinsic
|
|---|
| 168 | ; PREREQ: PT Defined
|
|---|
| 169 | Q:$G(PT(0))="" ""
|
|---|
| 170 | N NAME S NAME=$P(PT(0),"^",1)
|
|---|
| 171 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 172 | Q NAME("FAMILY")
|
|---|
| 173 | ;
|
|---|
| 174 | GIVEN() ; Given Name; PUBLIC; Extrinsic
|
|---|
| 175 | ; PREREQ: PT Defined
|
|---|
| 176 | Q:$G(PT(0))="" ""
|
|---|
| 177 | N NAME S NAME=$P(PT(0),"^",1)
|
|---|
| 178 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 179 | Q NAME("GIVEN")
|
|---|
| 180 | ;
|
|---|
| 181 | MIDDLE() ; Middle Name; PUBLIC; Extrinsic
|
|---|
| 182 | ; PREREQ: PT Defined
|
|---|
| 183 | Q:$G(PT(0))="" ""
|
|---|
| 184 | N NAME S NAME=$P(PT(0),"^",1)
|
|---|
| 185 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 186 | Q NAME("MIDDLE")
|
|---|
| 187 | ;
|
|---|
| 188 | SUFFIX() ; Suffi Name; PUBLIC; Extrinsic
|
|---|
| 189 | ; PREREQ: PT Defined
|
|---|
| 190 | Q:$G(PT(0))="" ""
|
|---|
| 191 | N NAME S NAME=$P(PT(0),"^",1)
|
|---|
| 192 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 193 | Q NAME("SUFFIX")
|
|---|
| 194 | ;
|
|---|
| 195 | DISPNAME() ; Display Name; PUBLIC; Extrinsic
|
|---|
| 196 | ; PREREQ: PT Defined
|
|---|
| 197 | Q:$G(PT(0))="" ""
|
|---|
| 198 | N NAME S NAME=$P(PT(0),"^",1)
|
|---|
| 199 | Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
|---|
| 200 | ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
|---|
| 201 | DOB() ; Date of Birth; PUBLIC; Extrinsic
|
|---|
| 202 | ; PREREQ: PT Defined
|
|---|
| 203 | Q:$G(PT(0))="" ""
|
|---|
| 204 | N DOB S DOB=$P(PT(0),"^",3)
|
|---|
| 205 | ; Date in FM Date Format. Convert to UTC/ISO 8601.
|
|---|
| 206 | Q $$FMDTOUTC^CCRUTIL(DOB,"D")
|
|---|
| 207 | ;
|
|---|
| 208 | GENDER() ; Get Gender; PUBLIC; Extrinsic
|
|---|
| 209 | ; PREREQ: PT Defined
|
|---|
| 210 | Q:$G(PT(0))="" ""
|
|---|
| 211 | Q $P(PT(0),"^",2)
|
|---|
| 212 | ;
|
|---|
| 213 | SSN() ; Get SSN for ID; PUBLIC; Extrinsic
|
|---|
| 214 | ; PREREQ: PT Defined
|
|---|
| 215 | Q:$G(PT(0))="" ""
|
|---|
| 216 | Q $P(PT(0),"^",9)
|
|---|
| 217 | ;
|
|---|
| 218 | ADDRTYPE() ; Get Home Address; PUBLIC; Extrinsic
|
|---|
| 219 | ; Vista only stores a home address for the patient.
|
|---|
| 220 | Q:$G(PT(0))="" ""
|
|---|
| 221 | Q "Home"
|
|---|
| 222 | ;
|
|---|
| 223 | ADDR1() ; Get Home Address line 1; PUBLIC; Extrinsic
|
|---|
| 224 | ; PREREQ: PT Defined
|
|---|
| 225 | Q:$G(PT(.11))="" ""
|
|---|
| 226 | Q $P(PT(.11),"^",1)
|
|---|
| 227 | ;
|
|---|
| 228 | ADDR2() ; Get Home Address line 2; PUBLIC; Extrinsic
|
|---|
| 229 | ; PREREQ: PT Defined
|
|---|
| 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)
|
|---|
| 236 | Q $P(PT(.11),"^",2)_", "_$P(PT(.11),"^",3)
|
|---|
| 237 | ;
|
|---|
| 238 | CITY() ; Get City for Home Address; PUBLIC; Extrinsic
|
|---|
| 239 | ; PREREQ: PT Defined
|
|---|
| 240 | Q:$G(PT(.11))="" ""
|
|---|
| 241 | Q $P(PT(.11),"^",4)
|
|---|
| 242 | ;
|
|---|
| 243 | STATE() ; Get State for Home Address; PUBLIC; Extrinsic
|
|---|
| 244 | ; PREREQ: PT Defined
|
|---|
| 245 | Q:$G(PT(.11))="" ""
|
|---|
| 246 | ; State is stored as a pointer
|
|---|
| 247 | N STATENUM S STATENUM=$P(PT(.11),"^",5)
|
|---|
| 248 | ;
|
|---|
| 249 | ; State File Global is below
|
|---|
| 250 | ; ^DIC(5,D0,0)= (#.01) NAME [1] ^ (#1) ABBREVIATION [2F] ^ (#2) VA STATE CODE
|
|---|
| 251 | ; ==>[3F] ^ (#5) CAPITAL [4F] ^ (#2.1) AAC RECOGNIZED [5S] ^ (#2.2)
|
|---|
| 252 | ; ==>US STATE OR POSSESSION [6S] ^
|
|---|
| 253 | Q:STATENUM="" "" ; To prevent global undefined below if no state
|
|---|
| 254 | Q $P(^DIC(5,STATENUM,0),"^",1)
|
|---|
| 255 | ;
|
|---|
| 256 | ZIP() ; Get Zip code for Home Address; PUBLIC; Extrinsic
|
|---|
| 257 | ; PREREQ: PT Defined
|
|---|
| 258 | Q:$G(PT(.11))="" ""
|
|---|
| 259 | Q $P(PT(.11),"^",6)
|
|---|
| 260 | ;
|
|---|
| 261 | COUNTY() ; Get County for our Address; PUBLIC; Extrinsic
|
|---|
| 262 | ; PREREQ: PT Defined
|
|---|
| 263 | Q:$G(PT(.11))="" ""
|
|---|
| 264 | Q $P(PT(.11),"^",7)
|
|---|
| 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 | ;
|
|---|
