| 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 | W "No Entry at top!" Q
|
|---|
| 8 |
|
|---|
| 9 | ; The following is a map of the relevant data in the patient global.
|
|---|
| 10 | ;
|
|---|
| 11 | ; ^DPT(D0,0)= (#.01) NAME [1F] ^ (#.02) SEX [2S] ^ (#.03) DATE OF BIRTH [3D] ^
|
|---|
| 12 | ; ==>^ (#.05) MARITAL STATUS [5P:11] ^ (#.06) RACE [6P:10] ^ (#.07)
|
|---|
| 13 | ; ==>OCCUPATION [7F] ^ (#.08) RELIGIOUS PREFERENCE [8P:13] ^ (#.09)
|
|---|
| 14 | ; ==>SOCIAL SECURITY NUMBER [9F] ^ (#.091) REMARKS [10F] ^ (#.092)
|
|---|
| 15 | ; ==>PLACE OF BIRTH [CITY] [11F] ^ (#.093) PLACE OF BIRTH [STATE]
|
|---|
| 16 | ; ==>[12P:5] ^ ^ (#.14) CURRENT MEANS TEST STATUS [14P:408.32] ^
|
|---|
| 17 | ; ==>(#.096) WHO ENTERED PATIENT [15P:200] ^ (#.097) DATE ENTERED INTO
|
|---|
| 18 | ; ==>FILE [16D] ^ (#.098) HOW WAS PATIENT ENTERED? [17S] ^ (#.081)
|
|---|
| 19 | ; ==>DUPLICATE STATUS [18S] ^ (#.082) PATIENT MERGED TO [19P:2] ^
|
|---|
| 20 | ; ==>(#.083) CHECK FOR DUPLICATE [20S] ^ (#.6) TEST PATIENT INDICATOR
|
|---|
| 21 | ; ==>[21S] ^
|
|---|
| 22 | ; ^DPT(D0,.01,0)=^2.01^^ (#1) ALIAS
|
|---|
| 23 | ; ^DPT(D0,.01,D1,0)= (#.01) ALIAS [1F] ^ (#1) ALIAS SSN [2F] ^ (#100.03) ALIAS
|
|---|
| 24 | ; ==>COMPONENTS [3P:20] ^
|
|---|
| 25 | ; ^DPT(D0,.11)= (#.111) STREET ADDRESS [LINE 1] [1F] ^ (#.112) STREET ADDRESS
|
|---|
| 26 | ; ==>[LINE 2] [2F] ^ (#.113) STREET ADDRESS [LINE 3] [3F] ^ (#.114)
|
|---|
| 27 | ; ==>CITY [4F] ^ (#.115) STATE [5P:5] ^ (#.116) ZIP CODE [6F] ^
|
|---|
| 28 | ; ==>(#.117) COUNTY [7N] ^ ^ ^ ^ ^ (#.1112) ZIP+4 [12F] ^
|
|---|
| 29 | ; ==>(#.118) ADDRESS CHANGE DT/TM [13D] ^ (#.119) ADDRESS CHANGE
|
|---|
| 30 | ; ==>SOURCE [14S] ^ (#.12) ADDRESS CHANGE SITE [15P:4] ^ (#.121) BAD
|
|---|
| 31 | ; ==>ADDRESS INDICATOR [16S] ^ (#.122) ADDRESS CHANGE USER [17P:200]
|
|---|
| 32 | ; ==>^
|
|---|
| 33 | ; ^DPT(D0,.121)= (#.1211) TEMPORARY STREET [LINE 1] [1F] ^ (#.1212) TEMPORARY
|
|---|
| 34 | ; ==>STREET [LINE 2] [2F] ^ (#.1213) TEMPORARY STREET [LINE 3] [3F]
|
|---|
| 35 | ; ==>^ (#.1214) TEMPORARY CITY [4F] ^ (#.1215) TEMPORARY STATE
|
|---|
| 36 | ; ==>[5P:5] ^ (#.1216) TEMPORARY ZIP CODE [6F] ^ (#.1217) TEMPORARY
|
|---|
| 37 | ; ==>ADDRESS START DATE [7D] ^ (#.1218) TEMPORARY ADDRESS END DATE
|
|---|
| 38 | ; ==>[8D] ^ (#.12105) TEMPORARY ADDRESS ACTIVE? [9S] ^ (#.1219)
|
|---|
| 39 | ; ==>TEMPORARY PHONE NUMBER [10F] ^ (#.12111) TEMPORARY ADDRESS
|
|---|
| 40 | ; ==>COUNTY [11N] ^ (#.12112) TEMPORARY ZIP+4 [12F] ^ (#.12113)
|
|---|
| 41 | ; ==>TEMPORARY ADDRESS CHANGE DT/TM [13D] ^
|
|---|
| 42 | ; ^DPT(D0,.121)= (#.12114) TEMPORARY ADDRESS CHANGE SITE [14P:4] ^
|
|---|
| 43 | ; ^DPT(D0,.13)= (#.131) PHONE NUMBER [RESIDENCE] [1F] ^ (#.132) PHONE NUMBER
|
|---|
| 44 | ; ==>[WORK] [2F] ^ (#.133) EMAIL ADDRESS [3F] ^ (#.134) PHONE NUMBER
|
|---|
| 45 | ; ==>[CELLULAR] [4F] ^ (#.135) PAGER NUMBER [5F] ^ (#.136) EMAIL
|
|---|
| 46 | ; ==>ADDRESS CHANGE DT/TM [6D] ^ (#.137) EMAIL ADDRESS CHANGE SOURCE
|
|---|
| 47 | ; ==>[7S] ^ (#.138) EMAIL ADDRESS CHANGE SITE [8P:4] ^ (#.139)
|
|---|
| 48 | ; ==>CELLULAR NUMBER CHANGE DT/TM [9D] ^ (#.1311) CELLULAR NUMBER
|
|---|
| 49 | ; ==>CHANGE SOURCE [10S] ^ (#.13111) CELLULAR NUMBER CHANGE SITE
|
|---|
| 50 | ; ==>[11P:4] ^ (#.1312) PAGER NUMBER CHANGE DT/TM [12D] ^ (#.1313)
|
|---|
| 51 | ; ==>PAGER NUMBER CHANGE SOURCE [13S] ^ (#.1314) PAGER NUMBER CHANGE
|
|---|
| 52 | ; ==>SITE [14P:4] ^
|
|---|
| 53 | ; ^DPT(D0,.21)= (#.211) K-NAME OF PRIMARY NOK [1F] ^ (#.212) K-RELATIONSHIP TO
|
|---|
| 54 | ; ==>PATIENT [2F] ^ (#.213) K-STREET ADDRESS [LINE 1] [3F] ^ (#.214)
|
|---|
| 55 | ; ==>K-STREET ADDRESS [LINE 2] [4F] ^ (#.215) K-STREET ADDRESS [LINE
|
|---|
| 56 | ; ==>3] [5F] ^
|
|---|
| 57 | ; ^DPT(D0,.21)= (#.216) K-CITY [6F] ^ (#.217) K-STATE [7P:5] ^ (#.218) K-ZIP
|
|---|
| 58 | ; ==>CODE [8F] ^ (#.219) K-PHONE NUMBER [9F] ^ (#.2125) K-ADDRESS
|
|---|
| 59 | ; ==>SAME AS PATIENT'S? [10S] ^ (#.21011) K-WORK PHONE NUMBER [11F]
|
|---|
| 60 | ; ==>^
|
|---|
| 61 | ; ^DPT(D0,.211)= (#.2191) K2-NAME OF SECONDARY NOK [1F] ^ (#.2192)
|
|---|
| 62 | ; ==>K2-RELATIONSHIP TO PATIENT [2F] ^ (#.2193) K2-STREET ADDRESS
|
|---|
| 63 | ; ==>[LINE 1] [3F] ^ (#.2194) K2-STREET ADDRESS [LINE 2] [4F] ^
|
|---|
| 64 | ; ==>(#.2195) K2-STREET ADDRESS [LINE 3] [5F] ^ (#.2196) K2-CITY
|
|---|
| 65 | ; ==>[6F] ^ (#.2197) K2-STATE [7P:5] ^ (#.2198) K2-ZIP CODE [8F] ^
|
|---|
| 66 | ; ==>(#.2199) K2-PHONE NUMBER [9F] ^ (#.21925) K2-ADDRESS SAME AS
|
|---|
| 67 | ; ==>PATIENT'S? [10S] ^ (#.211011) K2-WORK PHONE NUMBER [11F] ^
|
|---|
| 68 | ; ^DPT(D0,.25)= (#.251) SPOUSE'S EMPLOYER NAME [1F] ^ (#.252) SPOUSE'S EMP
|
|---|
| 69 | ; ==>STREET [LINE 1] [2F] ^ (#.253) SPOUSE'S EMP STREET [LINE 2]
|
|---|
| 70 | ; ==>[3F] ^ (#.254) SPOUSE'S EMP STREET [LINE 3] [4F] ^ (#.255)
|
|---|
| 71 | ; ==>SPOUSE'S EMPLOYER'S CITY [5F] ^ (#.256) SPOUSE'S EMPLOYER'S
|
|---|
| 72 | ; ==>STATE [6P:5] ^ (#.257) SPOUSE'S EMP ZIP CODE [7F] ^ (#.258)
|
|---|
| 73 | ; ==>SPOUSE'S EMP PHONE NUMBER [8F] ^ ^ ^ ^ ^ ^ (#.2514)
|
|---|
| 74 | ; ==>SPOUSE'S OCCUPATION [14F] ^ (#.2515) SPOUSE'S EMPLOYMENT STATUS
|
|---|
| 75 | ; ==>[15S] ^ (#.2516) SPOUSE'S RETIREMENT DATE [16D] ^
|
|---|
| 76 | ; ^DPT(D0,.33)= (#.331) E-NAME [1F] ^ (#.332) E-RELATIONSHIP TO PATIENT [2F] ^
|
|---|
| 77 | ; ==>(#.333) E-STREET ADDRESS [LINE 1] [3F] ^ (#.334) E-STREET
|
|---|
| 78 | ; ==>ADDRESS [LINE 2] [4F] ^ (#.335) E-STREET ADDRESS [LINE 3] [5F]
|
|---|
| 79 | ; ==>^ (#.336) E-CITY [6F] ^ (#.337) E-STATE [7P:5] ^ (#.338) E-ZIP
|
|---|
| 80 | ; ==>CODE [8F] ^ (#.339) E-PHONE NUMBER [9F] ^ (#.3305) E-EMER.
|
|---|
| 81 | ; ==>CONTACT SAME AS NOK? [10S] ^ (#.33011) E-WORK PHONE NUMBER
|
|---|
| 82 | ; ==>[11F] ^
|
|---|
| 83 |
|
|---|
| 84 | INIT(DFN) ; Copy DFN global to a local variable; PUBLIC
|
|---|
| 85 | ; INPUT: Patient IEN (DFN)
|
|---|
| 86 | ; OUTPUT: PT in the Symbol Table, representing the patient global
|
|---|
| 87 |
|
|---|
| 88 | ; Instead of accessing a global each single read (SLOOOOW)
|
|---|
| 89 | ; read it off a local variable stored in Memory.
|
|---|
| 90 | M PT=^DPT(DFN)
|
|---|
| 91 | Q
|
|---|
| 92 | ;
|
|---|
| 93 | DESTROY ; Kill local variable; PUBLIC
|
|---|
| 94 | ; INPUT: None
|
|---|
| 95 | ; OUTPUT: Kill PT from the Symbol Table after you are done
|
|---|
| 96 | K PT
|
|---|
| 97 | Q
|
|---|
| 98 | ;
|
|---|
| 99 | FAMILY() ; Family Name; PUBLIC; Extrinsic
|
|---|
| 100 | ; PREREQ: PT Defined
|
|---|
| 101 | N NAME S NAME=$P(PT(0),"^",1)
|
|---|
| 102 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 103 | Q NAME("FAMILY")
|
|---|
| 104 | ;
|
|---|
| 105 | GIVEN() ; Given Name; PUBLIC; Extrinsic
|
|---|
| 106 | ; PREREQ: PT Defined
|
|---|
| 107 | N NAME S NAME=$P(PT(0),"^",1)
|
|---|
| 108 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 109 | Q NAME("GIVEN")
|
|---|
| 110 | ;
|
|---|
| 111 | MIDDLE() ; Middle Name; PUBLIC; Extrinsic
|
|---|
| 112 | ; PREREQ: PT Defined
|
|---|
| 113 | N NAME S NAME=$P(PT(0),"^",1)
|
|---|
| 114 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 115 | Q NAME("MIDDLE")
|
|---|
| 116 | ;
|
|---|
| 117 | SUFFIX() ; Suffi Name; PUBLIC; Extrinsic
|
|---|
| 118 | ; PREREQ: PT Defined
|
|---|
| 119 | N NAME S NAME=$P(PT(0),"^",1)
|
|---|
| 120 | D NAMECOMP^XLFNAME(.NAME)
|
|---|
| 121 | Q NAME("SUFFIX")
|
|---|
| 122 | ;
|
|---|
| 123 | DISPNAME() ; Display Name; PUBLIC; Extrinsic
|
|---|
| 124 | ; PREREQ: PT Defined
|
|---|
| 125 | N NAME S NAME=$P(PT(0),"^",1)
|
|---|
| 126 | Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
|---|
| 127 | ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
|---|
| 128 | DOB() ; Date of Birth; PUBLIC; Extrinsic
|
|---|
| 129 | ; PREREQ: PT Defined
|
|---|
| 130 | N DOB S DOB=$P(PT(0),"^",3)
|
|---|
| 131 | ; Date in FM Date Format. Convert to UTC/ISO 8601.
|
|---|
| 132 | Q $$FMDTOUTC^CCRUTIL(DOB,"D")
|
|---|
| 133 | ;
|
|---|
| 134 | GENDER() ; Get Gender; PUBLIC; Extrinsic
|
|---|
| 135 | ; PREREQ: PT Defined
|
|---|
| 136 | Q $P(PT(0),"^",2)
|
|---|
| 137 | ;
|
|---|
| 138 | SSN() ; Get SSN for ID; PUBLIC; Extrinsic
|
|---|
| 139 | ; PREREQ: PT Defined
|
|---|
| 140 | Q $P(PT(0),"^",9)
|
|---|
| 141 | ;
|
|---|
| 142 | ADDRTYPE(ADDR) ; Get Home Address; PUBLIC; Extrinsic
|
|---|
| 143 | ; Vista only stores a home address for the patient.
|
|---|
| 144 | Q "Home"
|
|---|
| 145 | ;
|
|---|
| 146 | ADDR1() ; Get Home Address line 1; PUBLIC; Extrinsic
|
|---|
| 147 | ; PREREQ: PT Defined
|
|---|
| 148 | Q $P(PT(.11),"^",1)
|
|---|
| 149 | ;
|
|---|
| 150 | ADDR2() ; Get Home Address line 2; PUBLIC; Extrinsic
|
|---|
| 151 | ; PREREQ: PT Defined
|
|---|
| 152 | ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
|
|---|
| 153 | Q $P(PT(.11),"^",2)_", "_$P(PT(.11),"^",3)
|
|---|
| 154 | ;
|
|---|
| 155 | CITY() ; Get City for Home Address; PUBLIC; Extrinsic
|
|---|
| 156 | ; PREREQ: PT Defined
|
|---|
| 157 | Q $P(PT(.11),"^",4)
|
|---|
| 158 | ;
|
|---|
| 159 | STATE() ; Get State for Home Address; PUBLIC; Extrinsic
|
|---|
| 160 | ; PREREQ: PT Defined
|
|---|
| 161 | ; State is stored as a pointer
|
|---|
| 162 | N STATENUM=$P(PT(.11)"^",5)
|
|---|
| 163 | ;
|
|---|
| 164 | ; State File Global is below
|
|---|
| 165 | ; ^DIC(5,D0,0)= (#.01) NAME [1] ^ (#1) ABBREVIATION [2F] ^ (#2) VA STATE CODE
|
|---|
| 166 | ; ==>[3F] ^ (#5) CAPITAL [4F] ^ (#2.1) AAC RECOGNIZED [5S] ^ (#2.2)
|
|---|
| 167 | ; ==>US STATE OR POSSESSION [6S] ^
|
|---|
| 168 | Q $P(^DIC(5,STATENUM,0),"^",1)
|
|---|
| 169 | ;
|
|---|
| 170 | ZIP() ; Get Zip code for Home Address
|
|---|
| 171 | ; PREREQ: PT Defined
|
|---|
| 172 | Q $P(PT(.11),"^",6)
|
|---|
| 173 | ;
|
|---|
| 174 | COUNTY() ; Get County for our Address
|
|---|
| 175 | ; PREREQ: PT Defined
|
|---|
| 176 | Q $P(PT(.11),"^",7)
|
|---|
| 177 | ;
|
|---|
