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