| 1 | CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
|
|---|
| 2 | ;;0.1;CCRCCD;;Jun 15, 2008;
|
|---|
| 3 | ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
|---|
| 4 | ;General Public License See attached copy of the License.
|
|---|
| 5 | ;
|
|---|
| 6 | ;This program is free software; you can redistribute it and/or modify
|
|---|
| 7 | ;it under the terms of the GNU General Public License as published by
|
|---|
| 8 | ;the Free Software Foundation; either version 2 of the License, or
|
|---|
| 9 | ;(at your option) any later version.
|
|---|
| 10 | ;
|
|---|
| 11 | ;This program is distributed in the hope that it will be useful,
|
|---|
| 12 | ;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|---|
| 13 | ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|---|
| 14 | ;GNU General Public License for more details.
|
|---|
| 15 | ;
|
|---|
| 16 | ;You should have received a copy of the GNU General Public License along
|
|---|
| 17 | ;with this program; if not, write to the Free Software Foundation, Inc.,
|
|---|
| 18 | ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|---|
| 19 |
|
|---|
| 20 | ; NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and
|
|---|
| 21 | ; DESTROY to clean-up.
|
|---|
| 22 |
|
|---|
| 23 | ; The first line of every routine tests if the global exists.
|
|---|
| 24 |
|
|---|
| 25 | ; CCRDPT 83 lines CCRCCD/SMH - Routines to Extract Patient Data for
|
|---|
| 26 | ; INIT 9 lines Copy DFN global to a local variable
|
|---|
| 27 | ; DESTROY 6 lines Kill local variable
|
|---|
| 28 | ; FAMILY 6 lines Family Name
|
|---|
| 29 | ; GIVEN 6 lines Given Name
|
|---|
| 30 | ; MIDDLE 6 lines Middle Name
|
|---|
| 31 | ; SUFFIX 6 lines Suffix Name
|
|---|
| 32 | ; DISPNAME 5 lines Display Name
|
|---|
| 33 | ; DOB 6 lines Date of Birth
|
|---|
| 34 | ; GENDER 4 lines Get Gender
|
|---|
| 35 | ; SSN 4 lines Get SSN for ID
|
|---|
| 36 | ; ADDRTYPE 4 lines Get Home Address
|
|---|
| 37 | ; ADDR1 4 lines Get Home Address line 1
|
|---|
| 38 | ; ADDR2 5 lines Get Home Address line 2
|
|---|
| 39 | ; CITY 4 lines Get City for Home Address
|
|---|
| 40 | ; STATE 11 lines Get State for Home Address
|
|---|
| 41 | ; ZIP 4 lines Get Zip code for Home Address
|
|---|
| 42 | ; COUNTY 4 lines Get County for our Address
|
|---|
| 43 | ; COUNTRY 4 lines Get Country for our Address
|
|---|
| 44 | ; RESTEL 4 lines Residential Telephone
|
|---|
| 45 | ; WORKTEL 4 lines Work Telephone
|
|---|
| 46 | ; EMAIL 4 lines Email Adddress
|
|---|
| 47 | ; CELLTEL 4 lines Cell Phone
|
|---|
| 48 | ; NOK1FAM 6 lines Next of Kin 1 (NOK1) Family Name
|
|---|
| 49 | ; NOK1GIV 6 lines NOK1 Given Name
|
|---|
| 50 | ; NOK1MID 6 lines NOK1 Middle Name
|
|---|
| 51 | ; NOK1SUF 6 lines NOK1 Suffi Name
|
|---|
| 52 | ; NOK1DISP 5 lines NOK1 Display Name
|
|---|
| 53 | ; NOK1REL 4 lines NOK1 Relationship to the patient
|
|---|
| 54 | ; NOK1ADD1 4 lines NOK1 Address 1
|
|---|
| 55 | ; NOK1ADD2 5 lines NOK1 Address 2
|
|---|
| 56 | ; NOK1CITY 4 lines NOK1 City
|
|---|
| 57 | ; NOK1STAT 5 lines NOK1 State
|
|---|
| 58 | ; NOK1ZIP 4 lines NOK1 Zip Code
|
|---|
| 59 | ; NOK1HTEL; 4 lines NOK1 Home Telephone
|
|---|
| 60 | ; NOK1WTEL; 4 lines NOK1 Work Telephone
|
|---|
| 61 | ; NOK1SAME; 4 lines Is NOK1's Address the same the patient?
|
|---|
| 62 | ; NOK2FAM 6 lines NOK2 Family Name
|
|---|
| 63 | ; NOK2GIV 6 lines NOK2 Given Name
|
|---|
| 64 | ; NOK2MID 6 lines NOK2 Middle Name
|
|---|
| 65 | ; NOK2SUF 5 lines NOK2 Suffi Name
|
|---|
| 66 | ; NOK2DISP 5 lines NOK2 Display Name
|
|---|
| 67 | ; NOK2REL 4 lines NOK2 Relationship to the patient
|
|---|
| 68 | ; NOK2ADD1 4 lines NOK2 Address 1
|
|---|
| 69 | ; NOK2ADD2 5 lines NOK2 Address 2
|
|---|
| 70 | ; NOK2CITY 4 lines NOK2 City
|
|---|
| 71 | ; NOK2STAT 5 lines NOK2 State
|
|---|
| 72 | ; NOK2ZIP 4 lines NOK2 Zip Code
|
|---|
| 73 | ; NOK2HTEL; 4 lines NOK2 Home Telephone
|
|---|
| 74 | ; NOK2WTEL; 4 lines NOK2 Work Telephone
|
|---|
| 75 | ; NOK2SAME; 4 lines Is NOK2's Address the same the patient?
|
|---|
| 76 | ; EMERFAM 6 lines Emergency Contact (EMER) Family Name
|
|---|
| 77 | ; EMERGIV 6 lines EMER Given Name
|
|---|
| 78 | ; EMERMID 6 lines EMER Middle Name
|
|---|
| 79 | ; EMERSUF 5 lines EMER Suffi Name
|
|---|
| 80 | ; EMERDISP 5 lines EMER Display Name
|
|---|
| 81 | ; EMERREL 4 lines EMER Relationship to the patient
|
|---|
| 82 | ; EMERADD1 4 lines EMER Address 1
|
|---|
| 83 | ; EMERADD2 5 lines EMER Address 2
|
|---|
| 84 | ; EMERCITY 4 lines EMER City
|
|---|
| 85 | ; EMERSTAT 5 lines EMER State
|
|---|
| 86 | ; EMERZIP 4 lines EMER Zip Code
|
|---|
| 87 | ; EMERHTEL; 4 lines EMER Home Telephone
|
|---|
| 88 | ; EMERWTEL; 4 lines EMER Work Telephone
|
|---|
| 89 | ; EMERSAME; 4 lines Is EMER's Address the same the NOK?
|
|---|
| 90 |
|
|---|
| 91 | W "No Entry at top!" Q
|
|---|
| 92 |
|
|---|
| 93 | ; The following is a map of the relevant data in the patient global.
|
|---|
| 94 | ;
|
|---|
| 95 | ; ^DPT(D0,0)= (#.01) NAME [1F] ^ (#.02) SEX [2S] ^ (#.03) DATE OF BIRTH [3D] ^
|
|---|
| 96 | ; ==>^ (#.05) MARITAL STATUS [5P:11] ^ (#.06) RACE [6P:10] ^ (#.07)
|
|---|
| 97 | ; ==>OCCUPATION [7F] ^ (#.08) RELIGIOUS PREFERENCE [8P:13] ^ (#.09)
|
|---|
| 98 | ; ==>SOCIAL SECURITY NUMBER [9F] ^ (#.091) REMARKS [10F] ^ (#.092)
|
|---|
| 99 | ; ==>PLACE OF BIRTH [CITY] [11F] ^ (#.093) PLACE OF BIRTH [STATE]
|
|---|
| 100 | ; ==>[12P:5] ^ ^ (#.14) CURRENT MEANS TEST STATUS [14P:408.32] ^
|
|---|
| 101 | ; ==>(#.096) WHO ENTERED PATIENT [15P:200] ^ (#.097) DATE ENTERED INTO
|
|---|
| 102 | ; ==>FILE [16D] ^ (#.098) HOW WAS PATIENT ENTERED? [17S] ^ (#.081)
|
|---|
| 103 | ; ==>DUPLICATE STATUS [18S] ^ (#.082) PATIENT MERGED TO [19P:2] ^
|
|---|
| 104 | ; ==>(#.083) CHECK FOR DUPLICATE [20S] ^ (#.6) TEST PATIENT INDICATOR
|
|---|
| 105 | ; ==>[21S] ^
|
|---|
| 106 | ; ^DPT(D0,.01,0)=^2.01^^ (#1) ALIAS
|
|---|
| 107 | ; ^DPT(D0,.01,D1,0)= (#.01) ALIAS [1F] ^ (#1) ALIAS SSN [2F] ^ (#100.03) ALIAS
|
|---|
| 108 | ; ==>COMPONENTS [3P:20] ^
|
|---|
| 109 | ; ^DPT(D0,.11)= (#.111) STREET ADDRESS [LINE 1] [1F] ^ (#.112) STREET ADDRESS
|
|---|
| 110 | ; ==>[LINE 2] [2F] ^ (#.113) STREET ADDRESS [LINE 3] [3F] ^ (#.114)
|
|---|
| 111 | ; ==>CITY [4F] ^ (#.115) STATE [5P:5] ^ (#.116) ZIP CODE [6F] ^
|
|---|
| 112 | ; ==>(#.117) COUNTY [7N] ^ ^ ^ ^ ^ (#.1112) ZIP+4 [12F] ^
|
|---|
| 113 | ; ==>(#.118) ADDRESS CHANGE DT/TM [13D] ^ (#.119) ADDRESS CHANGE
|
|---|
| 114 | ; ==>SOURCE [14S] ^ (#.12) ADDRESS CHANGE SITE [15P:4] ^ (#.121) BAD
|
|---|
| 115 | ; ==>ADDRESS INDICATOR [16S] ^ (#.122) ADDRESS CHANGE USER [17P:200]
|
|---|
| 116 | ; ==>^
|
|---|
| 117 | ; ^DPT(D0,.121)= (#.1211) TEMPORARY STREET [LINE 1] [1F] ^ (#.1212) TEMPORARY
|
|---|
| 118 | ; ==>STREET [LINE 2] [2F] ^ (#.1213) TEMPORARY STREET [LINE 3] [3F]
|
|---|
| 119 | ; ==>^ (#.1214) TEMPORARY CITY [4F] ^ (#.1215) TEMPORARY STATE
|
|---|
| 120 | ; ==>[5P:5] ^ (#.1216) TEMPORARY ZIP CODE [6F] ^ (#.1217) TEMPORARY
|
|---|
| 121 | ; ==>ADDRESS START DATE [7D] ^ (#.1218) TEMPORARY ADDRESS END DATE
|
|---|
| 122 | ; ==>[8D] ^ (#.12105) TEMPORARY ADDRESS ACTIVE? [9S] ^ (#.1219)
|
|---|
| 123 | ; ==>TEMPORARY PHONE NUMBER [10F] ^ (#.12111) TEMPORARY ADDRESS
|
|---|
| 124 | ; ==>COUNTY [11N] ^ (#.12112) TEMPORARY ZIP+4 [12F] ^ (#.12113)
|
|---|
| 125 | ; ==>TEMPORARY ADDRESS CHANGE DT/TM [13D] ^
|
|---|
| 126 | ; ^DPT(D0,.121)= (#.12114) TEMPORARY ADDRESS CHANGE SITE [14P:4] ^
|
|---|
| 127 | ; ^DPT(D0,.13)= (#.131) PHONE NUMBER [RESIDENCE] [1F] ^ (#.132) PHONE NUMBER
|
|---|
| 128 | ; ==>[WORK] [2F] ^ (#.133) EMAIL ADDRESS [3F] ^ (#.134) PHONE NUMBER
|
|---|
| 129 | ; ==>[CELLULAR] [4F] ^ (#.135) PAGER NUMBER [5F] ^ (#.136) EMAIL
|
|---|
| 130 | ; ==>ADDRESS CHANGE DT/TM [6D] ^ (#.137) EMAIL ADDRESS CHANGE SOURCE
|
|---|
| 131 | ; ==>[7S] ^ (#.138) EMAIL ADDRESS CHANGE SITE [8P:4] ^ (#.139)
|
|---|
| 132 | ; ==>CELLULAR NUMBER CHANGE DT/TM [9D] ^ (#.1311) CELLULAR NUMBER
|
|---|
| 133 | ; ==>CHANGE SOURCE [10S] ^ (#.13111) CELLULAR NUMBER CHANGE SITE
|
|---|
| 134 | ; ==>[11P:4] ^ (#.1312) PAGER NUMBER CHANGE DT/TM [12D] ^ (#.1313)
|
|---|
| 135 | ; ==>PAGER NUMBER CHANGE SOURCE [13S] ^ (#.1314) PAGER NUMBER CHANGE
|
|---|
| 136 | ; ==>SITE [14P:4] ^
|
|---|
| 137 | ; ^DPT(D0,.21)= (#.211) K-NAME OF PRIMARY NOK [1F] ^ (#.212) K-RELATIONSHIP TO
|
|---|
| 138 | ; ==>PATIENT [2F] ^ (#.213) K-STREET ADDRESS [LINE 1] [3F] ^ (#.214)
|
|---|
| 139 | ; ==>K-STREET ADDRESS [LINE 2] [4F] ^ (#.215) K-STREET ADDRESS [LINE
|
|---|
| 140 | ; ==>3] [5F] ^
|
|---|
| 141 | ; ^DPT(D0,.21)= (#.216) K-CITY [6F] ^ (#.217) K-STATE [7P:5] ^ (#.218) K-ZIP
|
|---|
| 142 | ; ==>CODE [8F] ^ (#.219) K-PHONE NUMBER [9F] ^ (#.2125) K-ADDRESS
|
|---|
| 143 | ; ==>SAME AS PATIENT'S? [10S] ^ (#.21011) K-WORK PHONE NUMBER [11F]
|
|---|
| 144 | ; ==>^
|
|---|
| 145 | ; ^DPT(D0,.211)= (#.2191) K2-NAME OF SECONDARY NOK [1F] ^ (#.2192)
|
|---|
| 146 | ; ==>K2-RELATIONSHIP TO PATIENT [2F] ^ (#.2193) K2-STREET ADDRESS
|
|---|
| 147 | ; ==>[LINE 1] [3F] ^ (#.2194) K2-STREET ADDRESS [LINE 2] [4F] ^
|
|---|
| 148 | ; ==>(#.2195) K2-STREET ADDRESS [LINE 3] [5F] ^ (#.2196) K2-CITY
|
|---|
| 149 | ; ==>[6F] ^ (#.2197) K2-STATE [7P:5] ^ (#.2198) K2-ZIP CODE [8F] ^
|
|---|
| 150 | ; ==>(#.2199) K2-PHONE NUMBER [9F] ^ (#.21925) K2-ADDRESS SAME AS
|
|---|
| 151 | ; ==>PATIENT'S? [10S] ^ (#.211011) K2-WORK PHONE NUMBER [11F] ^
|
|---|
| 152 | ; ^DPT(D0,.25)= (#.251) SPOUSE'S EMPLOYER NAME [1F] ^ (#.252) SPOUSE'S EMP
|
|---|
| 153 | ; ==>STREET [LINE 1] [2F] ^ (#.253) SPOUSE'S EMP STREET [LINE 2]
|
|---|
| 154 | ; ==>[3F] ^ (#.254) SPOUSE'S EMP STREET [LINE 3] [4F] ^ (#.255)
|
|---|
| 155 | ; ==>SPOUSE'S EMPLOYER'S CITY [5F] ^ (#.256) SPOUSE'S EMPLOYER'S
|
|---|
| 156 | ; ==>STATE [6P:5] ^ (#.257) SPOUSE'S EMP ZIP CODE [7F] ^ (#.258)
|
|---|
| 157 | ; ==>SPOUSE'S EMP PHONE NUMBER [8F] ^ ^ ^ ^ ^ ^ (#.2514)
|
|---|
| 158 | ; ==>SPOUSE'S OCCUPATION [14F] ^ (#.2515) SPOUSE'S EMPLOYMENT STATUS
|
|---|
| 159 | ; ==>[15S] ^ (#.2516) SPOUSE'S RETIREMENT DATE [16D] ^
|
|---|
| 160 | ; ^DPT(D0,.33)= (#.331) E-NAME [1F] ^ (#.332) E-RELATIONSHIP TO PATIENT [2F] ^
|
|---|
| 161 | ; ==>(#.333) E-STREET ADDRESS [LINE 1] [3F] ^ (#.334) E-STREET
|
|---|
| 162 | ; ==>ADDRESS [LINE 2] [4F] ^ (#.335) E-STREET ADDRESS [LINE 3] [5F]
|
|---|
| 163 | ; ==>^ (#.336) E-CITY [6F] ^ (#.337) E-STATE [7P:5] ^ (#.338) E-ZIP
|
|---|
| 164 | ; ==>CODE [8F] ^ (#.339) E-PHONE NUMBER [9F] ^ (#.3305) E-EMER.
|
|---|
| 165 | ; ==>CONTACT SAME AS NOK? [10S] ^ (#.33011) E-WORK PHONE NUMBER
|
|---|
| 166 | ; ==>[11F] ^
|
|---|
| 167 |
|
|---|
| 168 | INIT(DFN) ; Copy DFN global to a local variable; PUBLIC
|
|---|
| 169 | ; INPUT: Patient IEN (DFN)
|
|---|
| 170 | ; OUTPUT: PT in the Symbol Table, representing the patient global
|
|---|
| 171 |
|
|---|
| 172 | ; Instead of accessing a global each single read (SLOOOOW)
|
|---|
| 173 | ; read it off a local variable stored in Memory.
|
|---|
| 174 | M PT=^DPT(DFN)
|
|---|
| 175 | Q
|
|---|
| 176 | ;
|
|---|
| 177 | DESTROY ; Kill local variable; PUBLIC
|
|---|
| 178 | ; INPUT: None
|
|---|
| 179 | ; OUTPUT: Kill PT from the Symbol Table after you are done
|
|---|
| 180 | K PT
|
|---|
| 181 | Q
|
|---|
| 182 | ;
|
|---|
| 183 | FAMILY() ; Family Name; PUBLIC; Extrinsic
|
|---|
| 184 | ; PREREQ: PT Defined
|
|---|
| 185 | Q:$G(PT(0))="" ""
|
|---|
| 186 | N NAME S NAME=$P(PT(0),"^",1)
|
|---|
| 187 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 188 | Q NAME("FAMILY")
|
|---|
| 189 | ;
|
|---|
| 190 | GIVEN() ; Given Name; PUBLIC; Extrinsic
|
|---|
| 191 | ; PREREQ: PT Defined
|
|---|
| 192 | Q:$G(PT(0))="" ""
|
|---|
| 193 | N NAME S NAME=$P(PT(0),"^",1)
|
|---|
| 194 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 195 | Q NAME("GIVEN")
|
|---|
| 196 | ;
|
|---|
| 197 | MIDDLE() ; Middle Name; PUBLIC; Extrinsic
|
|---|
| 198 | ; PREREQ: PT Defined
|
|---|
| 199 | Q:$G(PT(0))="" ""
|
|---|
| 200 | N NAME S NAME=$P(PT(0),"^",1)
|
|---|
| 201 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 202 | Q NAME("MIDDLE")
|
|---|
| 203 | ;
|
|---|
| 204 | SUFFIX() ; Suffi Name; PUBLIC; Extrinsic
|
|---|
| 205 | ; PREREQ: PT Defined
|
|---|
| 206 | Q:$G(PT(0))="" ""
|
|---|
| 207 | N NAME S NAME=$P(PT(0),"^",1)
|
|---|
| 208 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 209 | Q NAME("SUFFIX")
|
|---|
| 210 | ;
|
|---|
| 211 | DISPNAME() ; Display Name; PUBLIC; Extrinsic
|
|---|
| 212 | ; PREREQ: PT Defined
|
|---|
| 213 | Q:$G(PT(0))="" ""
|
|---|
| 214 | N NAME S NAME=$P(PT(0),"^",1)
|
|---|
| 215 | Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
|---|
| 216 | ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
|---|
| 217 | DOB() ; Date of Birth; PUBLIC; Extrinsic
|
|---|
| 218 | ; PREREQ: PT Defined
|
|---|
| 219 | Q:$G(PT(0))="" ""
|
|---|
| 220 | N DOB S DOB=$P(PT(0),"^",3)
|
|---|
| 221 | ; Date in FM Date Format. Convert to UTC/ISO 8601.
|
|---|
| 222 | Q $$FMDTOUTC^CCRUTIL(DOB,"D")
|
|---|
| 223 | ;
|
|---|
| 224 | GENDER() ; Get Gender; PUBLIC; Extrinsic
|
|---|
| 225 | ; PREREQ: PT Defined
|
|---|
| 226 | Q:$G(PT(0))="" ""
|
|---|
| 227 | Q $P(PT(0),"^",2)
|
|---|
| 228 | ;
|
|---|
| 229 | SSN() ; Get SSN for ID; PUBLIC; Extrinsic
|
|---|
| 230 | ; PREREQ: PT Defined
|
|---|
| 231 | Q:$G(PT(0))="" ""
|
|---|
| 232 | Q $P(PT(0),"^",9)
|
|---|
| 233 | ;
|
|---|
| 234 | ADDRTYPE() ; Get Home Address; PUBLIC; Extrinsic
|
|---|
| 235 | ; Vista only stores a home address for the patient.
|
|---|
| 236 | Q:$G(PT(0))="" ""
|
|---|
| 237 | Q "Home"
|
|---|
| 238 | ;
|
|---|
| 239 | ADDR1() ; Get Home Address line 1; PUBLIC; Extrinsic
|
|---|
| 240 | ; PREREQ: PT Defined
|
|---|
| 241 | Q:$G(PT(.11))="" ""
|
|---|
| 242 | Q $P(PT(.11),"^",1)
|
|---|
| 243 | ;
|
|---|
| 244 | ADDR2() ; Get Home Address line 2; PUBLIC; Extrinsic
|
|---|
| 245 | ; PREREQ: PT Defined
|
|---|
| 246 | ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
|
|---|
| 247 | Q:$G(PT(.11))="" ""
|
|---|
| 248 | ; If the thrid address is empty, just return the 2nd.
|
|---|
| 249 | ; If the 2nd is empty, we don't lose, b/c it will return ""
|
|---|
| 250 | ; This is so that we won't produce a comma if there is no 3rd addr.
|
|---|
| 251 | Q:$P(PT(.11),"^",3)="" $P(PT(.11),"^",2)
|
|---|
| 252 | Q $P(PT(.11),"^",2)_", "_$P(PT(.11),"^",3)
|
|---|
| 253 | ;
|
|---|
| 254 | CITY() ; Get City for Home Address; PUBLIC; Extrinsic
|
|---|
| 255 | ; PREREQ: PT Defined
|
|---|
| 256 | Q:$G(PT(.11))="" ""
|
|---|
| 257 | Q $P(PT(.11),"^",4)
|
|---|
| 258 | ;
|
|---|
| 259 | STATE() ; Get State for Home Address; PUBLIC; Extrinsic
|
|---|
| 260 | ; PREREQ: PT Defined
|
|---|
| 261 | Q:$G(PT(.11))="" ""
|
|---|
| 262 | ; State is stored as a pointer
|
|---|
| 263 | N STATENUM S STATENUM=$P(PT(.11),"^",5)
|
|---|
| 264 | ;
|
|---|
| 265 | ; State File Global is below
|
|---|
| 266 | ; ^DIC(5,D0,0)= (#.01) NAME [1] ^ (#1) ABBREVIATION [2F] ^ (#2) VA STATE CODE
|
|---|
| 267 | ; ==>[3F] ^ (#5) CAPITAL [4F] ^ (#2.1) AAC RECOGNIZED [5S] ^ (#2.2)
|
|---|
| 268 | ; ==>US STATE OR POSSESSION [6S] ^
|
|---|
| 269 | Q:STATENUM="" "" ; To prevent global undefined below if no state
|
|---|
| 270 | Q $P(^DIC(5,STATENUM,0),"^",1)
|
|---|
| 271 | ;
|
|---|
| 272 | ZIP() ; Get Zip code for Home Address; PUBLIC; Extrinsic
|
|---|
| 273 | ; PREREQ: PT Defined
|
|---|
| 274 | Q:$G(PT(.11))="" ""
|
|---|
| 275 | Q $P(PT(.11),"^",6)
|
|---|
| 276 | ;
|
|---|
| 277 | COUNTY() ; Get County for our Address; PUBLIC; Extrinsic
|
|---|
| 278 | ; PREREQ: PT Defined
|
|---|
| 279 | Q:$G(PT(.11))="" ""
|
|---|
| 280 | Q $P(PT(.11),"^",7)
|
|---|
| 281 | ;
|
|---|
| 282 | COUNTRY() ; Get Country for our Address; PUBLIC; Extrinsic
|
|---|
| 283 | ; Unfortunately, I can't find where that is stored, so the inevitable...
|
|---|
| 284 | Q:$G(PT(.11))="" ""
|
|---|
| 285 | Q "USA"
|
|---|
| 286 | ;
|
|---|
| 287 | RESTEL() ; Residential Telephone; PUBLIC; Extrinsic
|
|---|
| 288 | ; PREREQ: PT Defined
|
|---|
| 289 | Q:$G(PT(.13))="" ""
|
|---|
| 290 | Q $P(PT(.13),"^",1)
|
|---|
| 291 | ;
|
|---|
| 292 | WORKTEL() ; Work Telephone; PUBLIC; Extrinsic
|
|---|
| 293 | ; PREREQ: PT Defined
|
|---|
| 294 | Q:$G(PT(.13))="" ""
|
|---|
| 295 | Q $P(PT(.13),"^",2)
|
|---|
| 296 | ;
|
|---|
| 297 | EMAIL() ; Email Adddress; PUBLIC; Extrinsic
|
|---|
| 298 | ; PREREQ: PT Defined
|
|---|
| 299 | Q:$G(PT(.13))="" ""
|
|---|
| 300 | Q $P(PT(.13),"^",3)
|
|---|
| 301 | ;
|
|---|
| 302 | CELLTEL() ; Cell Phone; PUBLIC; Extrinsic
|
|---|
| 303 | ; PREREQ: PT Defined
|
|---|
| 304 | Q:$G(PT(.13))="" ""
|
|---|
| 305 | Q $P(PT(.13),"^",4)
|
|---|
| 306 | ;
|
|---|
| 307 | NOK1FAM() ; Next of Kin 1 (NOK1) Family Name; PUBLIC; Extrinsic
|
|---|
| 308 | ; PREREQ: PT Defined
|
|---|
| 309 | Q:$G(PT(.21))="" ""
|
|---|
| 310 | N NAME S NAME=$P(PT(.21),"^",1)
|
|---|
| 311 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 312 | Q NAME("FAMILY")
|
|---|
| 313 | ;
|
|---|
| 314 | NOK1GIV() ; NOK1 Given Name; PUBLIC; Extrinsic
|
|---|
| 315 | ; PREREQ: PT Defined
|
|---|
| 316 | Q:$G(PT(.21))="" ""
|
|---|
| 317 | N NAME S NAME=$P(PT(.21),"^",1)
|
|---|
| 318 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 319 | Q NAME("GIVEN")
|
|---|
| 320 | ;
|
|---|
| 321 | NOK1MID() ; NOK1 Middle Name; PUBLIC; Extrinsic
|
|---|
| 322 | ; PREREQ: PT Defined
|
|---|
| 323 | Q:$G(PT(.21))="" ""
|
|---|
| 324 | N NAME S NAME=$P(PT(.21),"^",1)
|
|---|
| 325 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 326 | Q NAME("MIDDLE")
|
|---|
| 327 | ;
|
|---|
| 328 | NOK1SUF() ; NOK1 Suffi Name; PUBLIC; Extrinsic
|
|---|
| 329 | ; PREREQ: PT Defined
|
|---|
| 330 | Q:$G(PT(.21))="" ""
|
|---|
| 331 | N NAME S NAME=$P(PT(.21),"^",1)
|
|---|
| 332 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 333 | Q NAME("SUFFIX")
|
|---|
| 334 | ;
|
|---|
| 335 | NOK1DISP() ; NOK1 Display Name; PUBLIC; Extrinsic
|
|---|
| 336 | ; PREREQ: PT Defined
|
|---|
| 337 | Q:$G(PT(.21))="" ""
|
|---|
| 338 | N NAME S NAME=$P(PT(.21),"^",1)
|
|---|
| 339 | Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
|---|
| 340 | ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
|---|
| 341 | NOK1REL() ; NOK1 Relationship to the patient; PUBLIC; Extrinsic
|
|---|
| 342 | ; PREREQ: PT Defined
|
|---|
| 343 | Q:$G(PT(.21))="" ""
|
|---|
| 344 | Q $P(PT(.21),"^",2)
|
|---|
| 345 | ;
|
|---|
| 346 | NOK1ADD1() ; NOK1 Address 1; PUBLIC; Extrinsic
|
|---|
| 347 | ; PREREQ: PT Defined
|
|---|
| 348 | Q:$G(PT(.21))="" ""
|
|---|
| 349 | Q $P(PT(.21),"^",3)
|
|---|
| 350 | ;
|
|---|
| 351 | NOK1ADD2() ; NOK1 Address 2; PUBLIC; Extrinsic
|
|---|
| 352 | ; PREREQ: PT Defined
|
|---|
| 353 | ; As before, CCR only allows two fileds for the address, so we have to compromise
|
|---|
| 354 | Q:$G(PT(.21))="" ""
|
|---|
| 355 | ; If the thrid address is empty, just return the 2nd.
|
|---|
| 356 | ; If the 2nd is empty, we don't lose, b/c it will return ""
|
|---|
| 357 | ; This is so that we won't produce a comma if there is no 3rd addr.
|
|---|
| 358 | Q:$P(PT(.21),"^",5)="" $P(PT(.21),"^",4)
|
|---|
| 359 | Q $P(PT(.21),"^",4)_", "_$P(PT(.21),"^",5)
|
|---|
| 360 | ;
|
|---|
| 361 | NOK1CITY() ; NOK1 City; PUBLIC; Extrinsic
|
|---|
| 362 | ; PREREQ: PT Defined
|
|---|
| 363 | Q:$G(PT(.21))="" ""
|
|---|
| 364 | Q $P(PT(.21),"^",6)
|
|---|
| 365 | ;
|
|---|
| 366 | NOK1STAT() ; NOK1 State; PUBLIC; Extrinsic
|
|---|
| 367 | ; PREREQ: PT Defined
|
|---|
| 368 | Q:$G(PT(.21))="" ""
|
|---|
| 369 | N STATENUM S STATENUM=$P(PT(.21),"^",7)
|
|---|
| 370 | Q:STATENUM="" ""
|
|---|
| 371 | Q $P(^DIC(5,STATENUM,0),"^",1)
|
|---|
| 372 | ;
|
|---|
| 373 | NOK1ZIP() ; NOK1 Zip Code; PUBLIC; Extrinsic
|
|---|
| 374 | ; PREREQ: PT Defined
|
|---|
| 375 | Q:$G(PT(.21))="" ""
|
|---|
| 376 | Q $P(PT(.21),"^",8)
|
|---|
| 377 | ;
|
|---|
| 378 | NOK1HTEL() ; NOK1 Home Telephone; PUBLIC; Extrinsic
|
|---|
| 379 | ; PREREQ: PT Defined
|
|---|
| 380 | Q:$G(PT(.21))="" ""
|
|---|
| 381 | Q $P(PT(.21),"^",9)
|
|---|
| 382 | ;
|
|---|
| 383 | NOK1WTEL() ; NOK1 Work Telephone; PUBLIC; Extrinsic
|
|---|
| 384 | ; PREREQ: PT Defined
|
|---|
| 385 | Q:$G(PT(.21))="" ""
|
|---|
| 386 | Q $P(PT(.21),"^",11)
|
|---|
| 387 | ;
|
|---|
| 388 | NOK1SAME() ; Is NOK1's Address the same the patient?; PUBLIC; Extrinsic
|
|---|
| 389 | ; PREREQ: PT Defined
|
|---|
| 390 | Q:$G(PT(.21))="" ""
|
|---|
| 391 | Q $P(PT(.21),"^",10)
|
|---|
| 392 | ;
|
|---|
| 393 | NOK2FAM() ; NOK2 Family Name; PUBLIC; Extrinsic
|
|---|
| 394 | ; PREREQ: PT Defined
|
|---|
| 395 | Q:$G(PT(.211))="" ""
|
|---|
| 396 | N NAME S NAME=$P(PT(.211),"^",1)
|
|---|
| 397 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 398 | Q NAME("FAMILY")
|
|---|
| 399 | ;
|
|---|
| 400 | NOK2GIV() ; NOK2 Given Name; PUBLIC; Extrinsic ; PREREQ: PT Defined
|
|---|
| 401 | Q:$G(PT(.211))="" ""
|
|---|
| 402 | N NAME S NAME=$P(PT(.211),"^",1)
|
|---|
| 403 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 404 | Q NAME("GIVEN")
|
|---|
| 405 | ;
|
|---|
| 406 | NOK2MID() ; NOK2 Middle Name; PUBLIC; Extrinsic
|
|---|
| 407 | ; PREREQ: PT Defined
|
|---|
| 408 | Q:$G(PT(.211))="" ""
|
|---|
| 409 | N NAME S NAME=$P(PT(.211),"^",1)
|
|---|
| 410 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 411 | Q NAME("MIDDLE")
|
|---|
| 412 | ;
|
|---|
| 413 | NOK2SUF() ; NOK2 Suffi Name; PUBLIC; Extrinsic
|
|---|
| 414 | ; PREREQ: PT Defined
|
|---|
| 415 | Q:$G(PT(.211))="" ""
|
|---|
| 416 | N NAME S NAME=$P(PT(.211),"^",1)
|
|---|
| 417 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 418 | Q NAME("SUFFIX")
|
|---|
| 419 | NOK2DISP() ; NOK2 Display Name; PUBLIC; Extrinsic
|
|---|
| 420 | ; PREREQ: PT Defined
|
|---|
| 421 | Q:$G(PT(.211))="" ""
|
|---|
| 422 | N NAME S NAME=$P(PT(.211),"^",1)
|
|---|
| 423 | Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
|---|
| 424 | ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
|---|
| 425 | NOK2REL() ; NOK2 Relationship to the patient; PUBLIC; Extrinsic
|
|---|
| 426 | ; PREREQ: PT Defined
|
|---|
| 427 | Q:$G(PT(.211))="" ""
|
|---|
| 428 | Q $P(PT(.211),"^",2)
|
|---|
| 429 | ;
|
|---|
| 430 | NOK2ADD1() ; NOK2 Address 1; PUBLIC; Extrinsic
|
|---|
| 431 | ; PREREQ: PT Defined
|
|---|
| 432 | Q:$G(PT(.211))="" ""
|
|---|
| 433 | Q $P(PT(.211),"^",3)
|
|---|
| 434 | ;
|
|---|
| 435 | NOK2ADD2() ; NOK2 Address 2; PUBLIC; Extrinsic
|
|---|
| 436 | ; PREREQ: PT Defined
|
|---|
| 437 | ; As before, CCR only allows two fileds for the address, so we have to compromise
|
|---|
| 438 | Q:$G(PT(.211))="" ""
|
|---|
| 439 | ; If the thrid address is empty, just return the 2nd.
|
|---|
| 440 | ; If the 2nd is empty, we don't lose, b/c it will return ""
|
|---|
| 441 | ; This is so that we won't produce a comma if there is no 3rd addr.
|
|---|
| 442 | Q:$P(PT(.211),"^",5)="" $P(PT(.211),"^",4)
|
|---|
| 443 | Q $P(PT(.211),"^",4)_", "_$P(PT(.211),"^",5)
|
|---|
| 444 | ;
|
|---|
| 445 | NOK2CITY() ; NOK2 City; PUBLIC; Extrinsic
|
|---|
| 446 | ; PREREQ: PT Defined
|
|---|
| 447 | Q:$G(PT(.211))="" ""
|
|---|
| 448 | Q $P(PT(.211),"^",6)
|
|---|
| 449 | ;
|
|---|
| 450 | NOK2STAT() ; NOK2 State; PUBLIC; Extrinsic
|
|---|
| 451 | ; PREREQ: PT Defined
|
|---|
| 452 | Q:$G(PT(.211))="" ""
|
|---|
| 453 | N STATENUM S STATENUM=$P(PT(.211),"^",7)
|
|---|
| 454 | Q:STATENUM="" "" ; To prevent global undefined below if no state
|
|---|
| 455 | Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
|
|---|
| 456 | ;
|
|---|
| 457 | NOK2ZIP() ; NOK2 Zip Code; PUBLIC; Extrinsic
|
|---|
| 458 | ; PREREQ: PT Defined
|
|---|
| 459 | Q:$G(PT(.211))="" ""
|
|---|
| 460 | Q $P(PT(.211),"^",8)
|
|---|
| 461 | ;
|
|---|
| 462 | NOK2HTEL() ; NOK2 Home Telephone; PUBLIC; Extrinsic
|
|---|
| 463 | ; PREREQ: PT Defined
|
|---|
| 464 | Q:$G(PT(.211))="" ""
|
|---|
| 465 | Q $P(PT(.211),"^",9)
|
|---|
| 466 | ;
|
|---|
| 467 | NOK2WTEL() ; NOK2 Work Telephone; PUBLIC; Extrinsic
|
|---|
| 468 | ; PREREQ: PT Defined
|
|---|
| 469 | Q:$G(PT(.211))="" ""
|
|---|
| 470 | Q $P(PT(.211),"^",11)
|
|---|
| 471 | ;
|
|---|
| 472 | NOK2SAME() ; Is NOK2's Address the same the patient?; PUBLIC; Extrinsic
|
|---|
| 473 | ; PREREQ: PT Defined
|
|---|
| 474 | Q:$G(PT(.211))="" ""
|
|---|
| 475 | Q $P(PT(.211),"^",10)
|
|---|
| 476 | ;
|
|---|
| 477 | EMERFAM() ; Emergency Contact (EMER) Family Name; PUBLIC; Extrinsic
|
|---|
| 478 | ; PREREQ: PT Defined
|
|---|
| 479 | Q:$G(PT(.33))="" ""
|
|---|
| 480 | N NAME S NAME=$P(PT(.33),"^",1)
|
|---|
| 481 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 482 | Q NAME("FAMILY")
|
|---|
| 483 | ;
|
|---|
| 484 | EMERGIV() ; EMER Given Name; PUBLIC; Extrinsic
|
|---|
| 485 | ; PREREQ: PT Defined
|
|---|
| 486 | Q:$G(PT(.33))="" ""
|
|---|
| 487 | N NAME S NAME=$P(PT(.33),"^",1)
|
|---|
| 488 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 489 | Q NAME("GIVEN")
|
|---|
| 490 | ;
|
|---|
| 491 | EMERMID() ; EMER Middle Name; PUBLIC; Extrinsic
|
|---|
| 492 | ; PREREQ: PT Defined
|
|---|
| 493 | Q:$G(PT(.33))="" ""
|
|---|
| 494 | N NAME S NAME=$P(PT(.33),"^",1)
|
|---|
| 495 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 496 | Q NAME("MIDDLE")
|
|---|
| 497 | ;
|
|---|
| 498 | EMERSUF() ; EMER Suffi Name; PUBLIC; Extrinsic
|
|---|
| 499 | ; PREREQ: PT Defined
|
|---|
| 500 | Q:$G(PT(.33))="" ""
|
|---|
| 501 | N NAME S NAME=$P(PT(.33),"^",1)
|
|---|
| 502 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 503 | Q NAME("SUFFIX")
|
|---|
| 504 | EMERDISP() ; EMER Display Name; PUBLIC; Extrinsic
|
|---|
| 505 | ; PREREQ: PT Defined
|
|---|
| 506 | Q:$G(PT(.33))="" ""
|
|---|
| 507 | N NAME S NAME=$P(PT(.33),"^",1)
|
|---|
| 508 | Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
|---|
| 509 | ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
|---|
| 510 | EMERREL() ; EMER Relationship to the patient; PUBLIC; Extrinsic
|
|---|
| 511 | ; PREREQ: PT Defined
|
|---|
| 512 | Q:$G(PT(.33))="" ""
|
|---|
| 513 | Q $P(PT(.33),"^",2)
|
|---|
| 514 | ;
|
|---|
| 515 | EMERADD1() ; EMER Address 1; PUBLIC; Extrinsic
|
|---|
| 516 | ; PREREQ: PT Defined
|
|---|
| 517 | Q:$G(PT(.33))="" ""
|
|---|
| 518 | Q $P(PT(.33),"^",3)
|
|---|
| 519 | ;
|
|---|
| 520 | EMERADD2() ; EMER Address 2; PUBLIC; Extrinsic
|
|---|
| 521 | ; PREREQ: PT Defined
|
|---|
| 522 | ; As before, CCR only allows two fileds for the address, so we have to compromise
|
|---|
| 523 | Q:$G(PT(.33))="" ""
|
|---|
| 524 | ; If the thrid address is empty, just return the 2nd.
|
|---|
| 525 | ; If the 2nd is empty, we don't lose, b/c it will return ""
|
|---|
| 526 | ; This is so that we won't produce a comma if there is no 3rd addr.
|
|---|
| 527 | Q:$P(PT(.33),"^",5)="" $P(PT(.33),"^",4)
|
|---|
| 528 | Q $P(PT(.33),"^",4)_", "_$P(PT(.33),"^",5)
|
|---|
| 529 | ;
|
|---|
| 530 | EMERCITY() ; EMER City; PUBLIC; Extrinsic
|
|---|
| 531 | ; PREREQ: PT Defined
|
|---|
| 532 | Q:$G(PT(.33))="" ""
|
|---|
| 533 | Q $P(PT(.33),"^",6)
|
|---|
| 534 | ;
|
|---|
| 535 | EMERSTAT() ; EMER State; PUBLIC; Extrinsic
|
|---|
| 536 | ; PREREQ: PT Defined
|
|---|
| 537 | Q:$G(PT(.33))="" ""
|
|---|
| 538 | N STATENUM S STATENUM=$P(PT(.33),"^",7)
|
|---|
| 539 | Q:STATENUM="" "" ; To prevent global undefined below if no state
|
|---|
| 540 | Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
|
|---|
| 541 | ;
|
|---|
| 542 | EMERZIP() ; EMER Zip Code; PUBLIC; Extrinsic
|
|---|
| 543 | ; PREREQ: PT Defined
|
|---|
| 544 | Q:$G(PT(.33))="" ""
|
|---|
| 545 | Q $P(PT(.33),"^",8)
|
|---|
| 546 | ;
|
|---|
| 547 | EMERHTEL() ; EMER Home Telephone; PUBLIC; Extrinsic
|
|---|
| 548 | ; PREREQ: PT Defined
|
|---|
| 549 | Q:$G(PT(.33))="" ""
|
|---|
| 550 | Q $P(PT(.33),"^",9)
|
|---|
| 551 | ;
|
|---|
| 552 | EMERWTEL() ; EMER Work Telephone; PUBLIC; Extrinsic
|
|---|
| 553 | ; PREREQ: PT Defined
|
|---|
| 554 | Q:$G(PT(.33))="" ""
|
|---|
| 555 | Q $P(PT(.33),"^",11)
|
|---|
| 556 | ;
|
|---|
| 557 | EMERSAME() ; Is EMER's Address the same the NOK?; PUBLIC; Extrinsic
|
|---|
| 558 | ; PREREQ: PT Defined
|
|---|
| 559 | Q:$G(PT(.33))="" ""
|
|---|
| 560 | Q $P(PT(.33),"^",10)
|
|---|
| 561 | ;
|
|---|
