Changeset 40 for ccr/trunk/p/CCRDPT.m
- Timestamp:
- Jul 3, 2008, 9:02:47 PM (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/CCRDPT.m
r26 r40 1 1 CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08 2 3 4 ;NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and5 ;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 for10 ;INIT 9 lines Copy DFN global to a local variable11 ;DESTROY 6 lines Kill local variable12 ;FAMILY 6 lines Family Name13 ;GIVEN 6 lines Given Name14 ;MIDDLE 6 lines Middle Name15 ; SUFFIX 6 lines Suffix Name 16 ;DISPNAME 5 lines Display Name17 ;DOB 6 lines Date of Birth18 ;GENDER 4 lines Get Gender19 ;SSN 4 lines Get SSN for ID20 ;ADDRTYPE 4 lines Get Home Address21 ;ADDR1 4 lines Get Home Address line 122 ;ADDR2 5 lines Get Home Address line 223 ;CITY 4 lines Get City for Home Address24 ;STATE 11 lines Get State for Home Address25 ;ZIP 4 lines Get Zip code for Home Address26 ;COUNTY 4 lines Get County for our Address27 ;COUNTRY 4 lines Get Country for our Address28 ;RESTEL 4 lines Residential Telephone29 ;WORKTEL 4 lines Work Telephone30 ;EMAIL 4 lines Email Adddress31 ;CELLTEL 4 lines Cell Phone32 ;NOK1FAM 6 lines Next of Kin 1 (NOK1) Family Name33 ;NOK1GIV 6 lines NOK1 Given Name34 ;NOK1MID 6 lines NOK1 Middle Name35 ;NOK1SUF 6 lines NOK1 Suffi Name36 ;NOK1DISP 5 lines NOK1 Display Name37 ;NOK1REL 4 lines NOK1 Relationship to the patient38 ;NOK1ADD1 4 lines NOK1 Address 139 ;NOK1ADD2 5 lines NOK1 Address 240 ;NOK1CITY 4 lines NOK1 City41 ;NOK1STAT 5 lines NOK1 State42 ;NOK1ZIP 4 lines NOK1 Zip Code43 ;NOK1HTEL; 4 lines NOK1 Home Telephone44 ;NOK1WTEL; 4 lines NOK1 Work Telephone45 ;NOK1SAME; 4 lines Is NOK1's Address the same the patient?46 ;NOK2FAM 6 lines NOK2 Family Name47 ;NOK2GIV 6 lines NOK2 Given Name48 ;NOK2MID 6 lines NOK2 Middle Name49 ;NOK2SUF 5 lines NOK2 Suffi Name50 ;NOK2DISP 5 lines NOK2 Display Name51 ;NOK2REL 4 lines NOK2 Relationship to the patient52 ;NOK2ADD1 4 lines NOK2 Address 153 ;NOK2ADD2 5 lines NOK2 Address 254 ;NOK2CITY 4 lines NOK2 City55 ;NOK2STAT 5 lines NOK2 State56 ;NOK2ZIP 4 lines NOK2 Zip Code57 ;NOK2HTEL; 4 lines NOK2 Home Telephone58 ;NOK2WTEL; 4 lines NOK2 Work Telephone59 ;NOK2SAME; 4 lines Is NOK2's Address the same the patient?60 ;EMERFAM 6 lines Emergency Contact (EMER) Family Name61 ;EMERGIV 6 lines EMER Given Name62 ;EMERMID 6 lines EMER Middle Name63 ;EMERSUF 5 lines EMER Suffi Name64 ;EMERDISP 5 lines EMER Display Name65 ;EMERREL 4 lines EMER Relationship to the patient66 ;EMERADD1 4 lines EMER Address 167 ;EMERADD2 5 lines EMER Address 268 ;EMERCITY 4 lines EMER City69 ;EMERSTAT 5 lines EMER State70 ;EMERZIP 4 lines EMER Zip Code71 ;EMERHTEL; 4 lines EMER Home Telephone72 ;EMERWTEL; 4 lines EMER Work Telephone73 ;EMERSAME; 4 lines Is EMER's Address the same the NOK?74 75 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 INTO86 ;==>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 INDICATOR89 ;==>[21S] ^90 ;^DPT(D0,.01,0)=^2.01^^ (#1) ALIAS91 ;^DPT(D0,.01,D1,0)= (#.01) ALIAS [1F] ^ (#1) ALIAS SSN [2F] ^ (#100.03) ALIAS92 ;==>COMPONENTS [3P:20] ^93 ;^DPT(D0,.11)= (#.111) STREET ADDRESS [LINE 1] [1F] ^ (#.112) STREET ADDRESS94 ;==>[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 CHANGE98 ;==>SOURCE [14S] ^ (#.12) ADDRESS CHANGE SITE [15P:4] ^ (#.121) BAD99 ;==>ADDRESS INDICATOR [16S] ^ (#.122) ADDRESS CHANGE USER [17P:200]100 ;==>^101 ;^DPT(D0,.121)= (#.1211) TEMPORARY STREET [LINE 1] [1F] ^ (#.1212) TEMPORARY102 ;==>STREET [LINE 2] [2F] ^ (#.1213) TEMPORARY STREET [LINE 3] [3F]103 ;==>^ (#.1214) TEMPORARY CITY [4F] ^ (#.1215) TEMPORARY STATE104 ;==>[5P:5] ^ (#.1216) TEMPORARY ZIP CODE [6F] ^ (#.1217) TEMPORARY105 ;==>ADDRESS START DATE [7D] ^ (#.1218) TEMPORARY ADDRESS END DATE106 ;==>[8D] ^ (#.12105) TEMPORARY ADDRESS ACTIVE? [9S] ^ (#.1219)107 ;==>TEMPORARY PHONE NUMBER [10F] ^ (#.12111) TEMPORARY ADDRESS108 ;==>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 NUMBER112 ;==>[WORK] [2F] ^ (#.133) EMAIL ADDRESS [3F] ^ (#.134) PHONE NUMBER113 ;==>[CELLULAR] [4F] ^ (#.135) PAGER NUMBER [5F] ^ (#.136) EMAIL114 ;==>ADDRESS CHANGE DT/TM [6D] ^ (#.137) EMAIL ADDRESS CHANGE SOURCE115 ;==>[7S] ^ (#.138) EMAIL ADDRESS CHANGE SITE [8P:4] ^ (#.139)116 ;==>CELLULAR NUMBER CHANGE DT/TM [9D] ^ (#.1311) CELLULAR NUMBER117 ;==>CHANGE SOURCE [10S] ^ (#.13111) CELLULAR NUMBER CHANGE SITE118 ;==>[11P:4] ^ (#.1312) PAGER NUMBER CHANGE DT/TM [12D] ^ (#.1313)119 ;==>PAGER NUMBER CHANGE SOURCE [13S] ^ (#.1314) PAGER NUMBER CHANGE120 ;==>SITE [14P:4] ^121 ;^DPT(D0,.21)= (#.211) K-NAME OF PRIMARY NOK [1F] ^ (#.212) K-RELATIONSHIP TO122 ;==>PATIENT [2F] ^ (#.213) K-STREET ADDRESS [LINE 1] [3F] ^ (#.214)123 ;==>K-STREET ADDRESS [LINE 2] [4F] ^ (#.215) K-STREET ADDRESS [LINE124 ;==>3] [5F] ^125 ;^DPT(D0,.21)= (#.216) K-CITY [6F] ^ (#.217) K-STATE [7P:5] ^ (#.218) K-ZIP126 ;==>CODE [8F] ^ (#.219) K-PHONE NUMBER [9F] ^ (#.2125) K-ADDRESS127 ;==>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 ADDRESS131 ;==>[LINE 1] [3F] ^ (#.2194) K2-STREET ADDRESS [LINE 2] [4F] ^132 ;==>(#.2195) K2-STREET ADDRESS [LINE 3] [5F] ^ (#.2196) K2-CITY133 ;==>[6F] ^ (#.2197) K2-STATE [7P:5] ^ (#.2198) K2-ZIP CODE [8F] ^134 ;==>(#.2199) K2-PHONE NUMBER [9F] ^ (#.21925) K2-ADDRESS SAME AS135 ;==>PATIENT'S? [10S] ^ (#.211011) K2-WORK PHONE NUMBER [11F] ^136 ;^DPT(D0,.25)= (#.251) SPOUSE'S EMPLOYER NAME [1F] ^ (#.252) SPOUSE'S EMP137 ;==>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'S140 ;==>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 STATUS143 ;==>[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-STREET146 ;==>ADDRESS [LINE 2] [4F] ^ (#.335) E-STREET ADDRESS [LINE 3] [5F]147 ;==>^ (#.336) E-CITY [6F] ^ (#.337) E-STATE [7P:5] ^ (#.338) E-ZIP148 ;==>CODE [8F] ^ (#.339) E-PHONE NUMBER [9F] ^ (#.3305) E-EMER.149 ;==>CONTACT SAME AS NOK? [10S] ^ (#.33011) E-WORK PHONE NUMBER150 ;==>[11F] ^151 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 152 INIT(DFN) ; Copy DFN global to a local variable; PUBLIC 153 154 155 156 157 158 159 160 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 161 DESTROY ; Kill local variable; PUBLIC 162 163 164 165 166 162 ; INPUT: None 163 ; OUTPUT: Kill PT from the Symbol Table after you are done 164 K PT 165 Q 166 ; 167 167 FAMILY() ; Family Name; PUBLIC; Extrinsic 168 169 170 171 172 173 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 174 GIVEN() ; Given Name; PUBLIC; Extrinsic 175 176 177 178 179 180 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 181 MIDDLE() ; Middle Name; PUBLIC; Extrinsic 182 183 184 185 186 187 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 188 SUFFIX() ; Suffi Name; PUBLIC; Extrinsic 189 190 191 192 193 194 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 195 DISPNAME() ; Display Name; PUBLIC; Extrinsic 196 197 198 199 200 201 DOB() ; Date of Birth; PUBLIC; Extrinsic202 203 204 205 206 207 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 OB() ; 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 208 GENDER() ; Get Gender; PUBLIC; Extrinsic 209 210 211 212 209 ; PREREQ: PT Defined 210 Q:$G(PT(0))="" "" 211 Q $P(PT(0),"^",2) 212 ; 213 213 SSN() ; Get SSN for ID; PUBLIC; Extrinsic 214 215 216 217 214 ; PREREQ: PT Defined 215 Q:$G(PT(0))="" "" 216 Q $P(PT(0),"^",9) 217 ; 218 218 ADDRTYPE() ; Get Home Address; PUBLIC; Extrinsic 219 220 221 222 219 ; Vista only stores a home address for the patient. 220 Q:$G(PT(0))="" "" 221 Q "Home" 222 ; 223 223 ADDR1() ; Get Home Address line 1; PUBLIC; Extrinsic 224 225 226 227 224 ; PREREQ: PT Defined 225 Q:$G(PT(.11))="" "" 226 Q $P(PT(.11),"^",1) 227 ; 228 228 ADDR2() ; Get Home Address line 2; PUBLIC; Extrinsic 229 230 231 232 233 234 235 236 237 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 238 CITY() ; Get City for Home Address; PUBLIC; Extrinsic 239 240 241 242 239 ; PREREQ: PT Defined 240 Q:$G(PT(.11))="" "" 241 Q $P(PT(.11),"^",4) 242 ; 243 243 STATE() ; Get State for Home Address; PUBLIC; Extrinsic 244 245 246 247 248 249 250 251 ; ==>[3F] ^ (#5) CAPITAL [4F] ^ (#2.1) AAC RECOGNIZED [5S] ^ (#2.2)252 ; ==>US STATE OR POSSESSION [6S] ^253 254 255 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 256 ZIP() ; Get Zip code for Home Address; PUBLIC; Extrinsic 257 258 259 260 257 ; PREREQ: PT Defined 258 Q:$G(PT(.11))="" "" 259 Q $P(PT(.11),"^",6) 260 ; 261 261 COUNTY() ; Get County for our Address; PUBLIC; Extrinsic 262 263 264 265 262 ; PREREQ: PT Defined 263 Q:$G(PT(.11))="" "" 264 Q $P(PT(.11),"^",7) 265 ; 266 266 COUNTRY() ; Get Country for our Address; PUBLIC; Extrinsic 267 268 269 270 267 ; Unfortunately, I can't find where that is stored, so the inevitable... 268 Q:$G(PT(.11))="" "" 269 Q "USA" 270 ; 271 271 RESTEL() ; Residential Telephone; PUBLIC; Extrinsic 272 273 274 275 272 ; PREREQ: PT Defined 273 Q:$G(PT(.13))="" "" 274 Q $P(PT(.13),"^",1) 275 ; 276 276 WORKTEL() ; Work Telephone; PUBLIC; Extrinsic 277 278 279 280 277 ; PREREQ: PT Defined 278 Q:$G(PT(.13))="" "" 279 Q $P(PT(.13),"^",2) 280 ; 281 281 EMAIL() ; Email Adddress; PUBLIC; Extrinsic 282 283 284 285 282 ; PREREQ: PT Defined 283 Q:$G(PT(.13))="" "" 284 Q $P(PT(.13),"^",3) 285 ; 286 286 CELLTEL() ; Cell Phone; PUBLIC; Extrinsic 287 288 289 290 287 ; PREREQ: PT Defined 288 Q:$G(PT(.13))="" "" 289 Q $P(PT(.13),"^",4) 290 ; 291 291 NOK1FAM() ; Next of Kin 1 (NOK1) Family Name; PUBLIC; Extrinsic 292 293 294 295 296 297 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 298 NOK1GIV() ; NOK1 Given Name; PUBLIC; Extrinsic 299 300 301 302 303 304 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 305 NOK1MID() ; NOK1 Middle Name; PUBLIC; Extrinsic 306 307 308 309 310 311 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 312 NOK1SUF() ; NOK1 Suffi Name; PUBLIC; Extrinsic 313 314 315 316 317 318 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 319 NOK1DISP() ; NOK1 Display Name; PUBLIC; Extrinsic 320 321 322 323 324 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 325 NOK1REL() ; NOK1 Relationship to the patient; PUBLIC; Extrinsic 326 327 328 329 326 ; PREREQ: PT Defined 327 Q:$G(PT(.21))="" "" 328 Q $P(PT(.21),"^",2) 329 ; 330 330 NOK1ADD1() ; NOK1 Address 1; PUBLIC; Extrinsic 331 332 333 334 331 ; PREREQ: PT Defined 332 Q:$G(PT(.21))="" "" 333 Q $P(PT(.21),"^",3) 334 ; 335 335 NOK1ADD2() ; NOK1 Address 2; PUBLIC; Extrinsic 336 337 338 339 340 341 342 343 344 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 345 NOK1CITY() ; NOK1 City; PUBLIC; Extrinsic 346 347 348 349 346 ; PREREQ: PT Defined 347 Q:$G(PT(.21))="" "" 348 Q $P(PT(.21),"^",6) 349 ; 350 350 NOK1STAT() ; NOK1 State; PUBLIC; Extrinsic 351 352 353 354 355 356 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 357 NOK1ZIP() ; NOK1 Zip Code; PUBLIC; Extrinsic 358 359 360 361 358 ; PREREQ: PT Defined 359 Q:$G(PT(.21))="" "" 360 Q $P(PT(.21),"^",8) 361 ; 362 362 NOK1HTEL() ; NOK1 Home Telephone; PUBLIC; Extrinsic 363 364 365 366 363 ; PREREQ: PT Defined 364 Q:$G(PT(.21))="" "" 365 Q $P(PT(.21),"^",9) 366 ; 367 367 NOK1WTEL() ; NOK1 Work Telephone; PUBLIC; Extrinsic 368 369 370 371 368 ; PREREQ: PT Defined 369 Q:$G(PT(.21))="" "" 370 Q $P(PT(.21),"^",11) 371 ; 372 372 NOK1SAME() ; Is NOK1's Address the same the patient?; PUBLIC; Extrinsic 373 374 375 376 373 ; PREREQ: PT Defined 374 Q:$G(PT(.21))="" "" 375 Q $P(PT(.21),"^",10) 376 ; 377 377 NOK2FAM() ; NOK2 Family Name; PUBLIC; Extrinsic 378 379 380 381 382 383 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 384 NOK2GIV() ; NOK2 Given Name; PUBLIC; Extrinsic ; PREREQ: PT Defined 385 386 387 388 389 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 390 NOK2MID() ; NOK2 Middle Name; PUBLIC; Extrinsic 391 392 393 394 395 396 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 397 NOK2SUF() ; NOK2 Suffi Name; PUBLIC; Extrinsic 398 399 400 401 402 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 403 NOK2DISP() ; NOK2 Display Name; PUBLIC; Extrinsic 404 405 406 407 408 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 409 NOK2REL() ; NOK2 Relationship to the patient; PUBLIC; Extrinsic 410 411 412 413 410 ; PREREQ: PT Defined 411 Q:$G(PT(.211))="" "" 412 Q $P(PT(.211),"^",2) 413 ; 414 414 NOK2ADD1() ; NOK2 Address 1; PUBLIC; Extrinsic 415 416 417 418 415 ; PREREQ: PT Defined 416 Q:$G(PT(.211))="" "" 417 Q $P(PT(.211),"^",3) 418 ; 419 419 NOK2ADD2() ; NOK2 Address 2; PUBLIC; Extrinsic 420 421 422 423 424 425 426 427 428 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 429 NOK2CITY() ; NOK2 City; PUBLIC; Extrinsic 430 431 432 433 430 ; PREREQ: PT Defined 431 Q:$G(PT(.211))="" "" 432 Q $P(PT(.211),"^",6) 433 ; 434 434 NOK2STAT() ; NOK2 State; PUBLIC; Extrinsic 435 436 437 438 439 440 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 441 NOK2ZIP() ; NOK2 Zip Code; PUBLIC; Extrinsic 442 443 444 445 442 ; PREREQ: PT Defined 443 Q:$G(PT(.211))="" "" 444 Q $P(PT(.211),"^",8) 445 ; 446 446 NOK2HTEL() ; NOK2 Home Telephone; PUBLIC; Extrinsic 447 448 449 450 447 ; PREREQ: PT Defined 448 Q:$G(PT(.211))="" "" 449 Q $P(PT(.211),"^",9) 450 ; 451 451 NOK2WTEL() ; NOK2 Work Telephone; PUBLIC; Extrinsic 452 453 454 455 452 ; PREREQ: PT Defined 453 Q:$G(PT(.211))="" "" 454 Q $P(PT(.211),"^",11) 455 ; 456 456 NOK2SAME() ; Is NOK2's Address the same the patient?; PUBLIC; Extrinsic 457 458 459 460 457 ; PREREQ: PT Defined 458 Q:$G(PT(.211))="" "" 459 Q $P(PT(.211),"^",10) 460 ; 461 461 EMERFAM() ; Emergency Contact (EMER) Family Name; PUBLIC; Extrinsic 462 463 464 465 466 467 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 468 EMERGIV() ; EMER Given Name; PUBLIC; Extrinsic 469 470 471 472 473 474 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 475 EMERMID() ; EMER Middle Name; PUBLIC; Extrinsic 476 477 478 479 480 481 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 482 EMERSUF() ; EMER Suffi Name; PUBLIC; Extrinsic 483 484 485 486 487 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 488 EMERDISP() ; EMER Display Name; PUBLIC; Extrinsic 489 490 491 492 493 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 494 EMERREL() ; EMER Relationship to the patient; PUBLIC; Extrinsic 495 496 497 498 495 ; PREREQ: PT Defined 496 Q:$G(PT(.33))="" "" 497 Q $P(PT(.33),"^",2) 498 ; 499 499 EMERADD1() ; EMER Address 1; PUBLIC; Extrinsic 500 501 502 503 500 ; PREREQ: PT Defined 501 Q:$G(PT(.33))="" "" 502 Q $P(PT(.33),"^",3) 503 ; 504 504 EMERADD2() ; EMER Address 2; PUBLIC; Extrinsic 505 506 507 508 509 510 511 512 513 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 514 EMERCITY() ; EMER City; PUBLIC; Extrinsic 515 516 517 518 515 ; PREREQ: PT Defined 516 Q:$G(PT(.33))="" "" 517 Q $P(PT(.33),"^",6) 518 ; 519 519 EMERSTAT() ; EMER State; PUBLIC; Extrinsic 520 521 522 523 524 525 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 526 EMERZIP() ; EMER Zip Code; PUBLIC; Extrinsic 527 528 529 530 527 ; PREREQ: PT Defined 528 Q:$G(PT(.33))="" "" 529 Q $P(PT(.33),"^",8) 530 ; 531 531 EMERHTEL() ; EMER Home Telephone; PUBLIC; Extrinsic 532 533 534 535 532 ; PREREQ: PT Defined 533 Q:$G(PT(.33))="" "" 534 Q $P(PT(.33),"^",9) 535 ; 536 536 EMERWTEL() ; EMER Work Telephone; PUBLIC; Extrinsic 537 538 539 540 537 ; PREREQ: PT Defined 538 Q:$G(PT(.33))="" "" 539 Q $P(PT(.33),"^",11) 540 ; 541 541 EMERSAME() ; Is EMER's Address the same the NOK?; PUBLIC; Extrinsic 542 543 544 545 542 ; PREREQ: PT Defined 543 Q:$G(PT(.33))="" "" 544 Q $P(PT(.33),"^",10) 545 ;
Note:
See TracChangeset
for help on using the changeset viewer.