Changeset 122
- Timestamp:
- Aug 30, 2008, 3:13:15 PM (16 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 14 edited
-
CCRDPT.m (modified) (2 diffs)
-
CCRDPTT.m (modified) (3 diffs)
-
CCRSYS.m (modified) (2 diffs)
-
CCRUNIT.m (modified) (1 diff)
-
CCRUTIL.m (modified) (1 diff)
-
CCRVA200.m (modified) (4 diffs)
-
GPLACTOR.m (modified) (1 diff)
-
GPLCCD.m (modified) (2 diffs)
-
GPLCCD1.m (modified) (2 diffs)
-
GPLCCR0.m (modified) (1 diff)
-
GPLMEDS.m (modified) (1 diff)
-
GPLPROBS.m (modified) (1 diff)
-
GPLUNIT.m (modified) (1 diff)
-
GPLVITAL.m (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/CCRDPT.m
r69 r122 1 1 CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08 2 2 ;;0.1;CCRCCD;;Jun 15, 2008; 3 3 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU 4 4 ;General Public License See attached copy of the License. … … 17 17 ;with this program; if not, write to the Free Software Foundation, Inc., 18 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 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 ; 91 89 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. 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) ; 174 169 M PT=^DPT(DFN) 175 170 Q -
ccr/trunk/p/CCRDPTT.m
r69 r122 1 1 CCRDPTT ; Unit Tester... 2 ;;0.1;CCRCCD;;Jun 15, 2008; 2 3 ; 3 4 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU … … 27 28 ; STATS(111,0)="MIDDLE() ; Middle Name; PUBLIC; Extrinsic " 28 29 ; etc. 29 30 ; 30 31 ; Load Routine Entry points; We get a sweeeeeet array 31 32 D ANALYZE^ARJTXRD("CCRDPT",.OUT) ; Analyze a routine in the directory … … 33 34 ; Select Patient 34 35 S DIC=2,DIC(0)="AEMQ" D ^DIC 35 36 ; 36 37 W "You have selected patient "_Y,!! 37 38 D INIT^CCRDPT($P(Y,"^")) 38 ZWR PT39 ; ZWR PT 39 40 N I S I=165 F S I=$O(OUT(I)) Q:I="" D 40 41 . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" " -
ccr/trunk/p/CCRSYS.m
r69 r122 19 19 ; 20 20 W "Enter at appropriate points." Q 21 21 ; 22 22 ; Originally, I was going to use VEPERVER, but VEPERVER 23 23 ; actually kills ^TMP($J), outputs it to the screen in a user-friendly 24 24 ; manner (press any key to continue), 25 25 ; and is really a very half finished routine 26 26 ; 27 27 ; So for now, I am hard-coding the values. 28 28 ; 29 29 SYSNAME() ;Get EHR System Name; PUBLIC; Extrinsic 30 30 Q "WorldVistA EHR/VOE" … … 33 33 Q "1.0" 34 34 ; 35 -
ccr/trunk/p/CCRUNIT.m
r101 r122 1 1 CCRUNIT ; A routine that tests some crap 2 Q 3 ; 2 ;;0.1;CCDCCR;;JUL 13, 2007;Build 0 3 Q 4 ; 4 5 MEDS 5 6 7 8 9 N T S T=$NA(^TMP($J,"CCR"))D LOAD^GPLCCR0(T)10 11 12 13 14 15 16 17 18 19 20 21 22 6 N DEBUG S DEBUG=0 7 N DFN S DFN=1 8 K ^TMP($J) 9 W "Loading CCR Template into T using LOAD^GPLCCR0($NA(^TMP($J,""CCR"")))",!! 10 N T S T=$NA(^TMP($J,"CCR")) D LOAD^GPLCCR0(T) 11 B 12 N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications" 13 W "XPATH is: "_XPATH,! 14 W "Getting Med Template into INXML using",! 15 W "QUERY^GPLXPATH(T,XPATH,""INXML"")",!! 16 N INXML 17 D QUERY^GPLXPATH(T,XPATH,"INXML") 18 B 19 W "Executing EXTRACT^GPLMEDS(""INXML"",DFN,OUTXML)",! 20 W "OUTXML will be ^TMP($J,""OUT"")",! 21 N OUTXML S OUTXML=$NA(^TMP($J,"OUT")) 22 D EXTRACT^GPLMEDS("INXML",DFN,OUTXML) 23 Q -
ccr/trunk/p/CCRUTIL.m
r121 r122 70 70 . I DEBUG W "ZTMP=",ZTMP," " 71 71 S V1(0)=ZCNT ; ARRAYS ARE THE SAME SIZE 72 I DEBUG ZWR V273 I DEBUG ZWR VSRT72 ; I DEBUG ZWR V2 73 ; I DEBUG ZWR VSRT 74 74 N ZD,ZT ; DATA AND TIME ITERATORS 75 75 N ZDONE ; DONE FLAG -
ccr/trunk/p/CCRVA200.m
r69 r122 20 20 ; This routine uses Kernel APIs and Direct Global Access to get 21 21 ; Proivder Data from File 200. 22 22 ; 23 23 ; The Global is VA(200,*) 24 24 ; 25 25 FAMILY(DUZ) ; Get Family Name; PUBLIC; EXTRINSIC 26 26 ; INPUT: DUZ (i.e. File 200 IEN) ByVal … … 76 76 ; Uses a Kernel API. Returns -1 if a specialty is not specified 77 77 ; in file 200. 78 ; Otherwise, returns IEN^Profession^Specialty^Sub 78 ; Otherwise, returns IEN^Profession^Specialty^Subspecialty^Effect date^Expired date^VA code 79 79 N STR S STR=$$GET^XUA4A72(DUZ) 80 80 Q:+STR<0 "" … … 91 91 ; INPUT: DUZ ByVal 92 92 ; Output: String. 93 93 ; 94 94 ; First, get site number from the institution file. 95 95 ; 1st piece returned by $$SITE^VASITE, which gets the system institution 96 96 N INST S INST=$P($$SITE^VASITE(),U) 97 97 ; 98 98 ; Second, get mailing address 99 99 ; There are two APIs to get the address, one for physical and one for … … 166 166 Q $P(EMAIL,U) 167 167 ; 168 -
ccr/trunk/p/GPLACTOR.m
r112 r122 82 82 S AMAP=$NA(^TMP($J,"AMAP")) 83 83 K @AMAP 84 84 D INIT^CCRDPT(AIEN) 85 85 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID 86 86 S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT -
ccr/trunk/p/GPLCCD.m
r121 r122 87 87 ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER 88 88 ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION 89 D ORG^GPLACTOR S(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG89 D ORG^GPLACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG 90 90 D CP^GPLXPATH("ACTT2",CCDGLO) 91 91 ; … … 116 116 ; D ACTLST^GPLCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST 117 117 ; D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT") 118 ; D EXTRACT^GPLACTOR S("ACTT",ACTGLO,"ACTT2")118 ; D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2") 119 119 ; D INSINNER^GPLXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors") 120 120 N I,J,DONE S DONE=0 121 F I=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE121 F I=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE 122 122 . S J=$$TRIM^GPLXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS 123 123 . W "TRIMMED",J,! -
ccr/trunk/p/GPLCCD1.m
r85 r122 1 GPLCCD 0; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/081 GPLCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08 2 2 ;;0.1;CCDCCR;nopatch;noreleasedate 3 3 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU … … 26 26 ; BAT is a string identifying the section 27 27 ; LINE is a test which will evaluate to true or false 28 ; I '$G(@ZARY) D 29 . S @ZARY@(0)=0 ; initially there are no elements30 . W "GOT HERE LOADING "_LINE,!28 ; I '$G(@ZARY) D ; IF ZARY DOES NOT EXIST ' 29 ; . S @ZARY@(0)=0 ; initially there are no elements 30 ; . W "GOT HERE LOADING "_LINE,! 31 31 N CNT ; count of array elements 32 32 S CNT=@ZARY@(0) ; contains array count -
ccr/trunk/p/GPLCCR0.m
r92 r122 26 26 ; BAT is a string identifying the section 27 27 ; LINE is a test which will evaluate to true or false 28 ; I '$G(@ZARY) D 29 . S @ZARY@(0)=0 ; initially there are no elements30 . W "GOT HERE LOADING "_LINE,!28 ; I '$G(@ZARY) D ; 29 ; . S @ZARY@(0)=0 ; initially there are no elements 30 ; . W "GOT HERE LOADING "_LINE,! 31 31 N CNT ; count of array elements 32 32 S CNT=@ZARY@(0) ; contains array count -
ccr/trunk/p/GPLMEDS.m
r110 r122 32 32 . S @MEDOUTXML@(0)=0 33 33 . Q 34 I DEBUG ZWR MEDRSLT34 ; I DEBUG ZWR MEDRSLT 35 35 M GPLMEDS=MEDRSLT 36 36 S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDICATIONS")) -
ccr/trunk/p/GPLPROBS.m
r121 r122 38 38 . S @OUTXML@(0)=0 39 39 . ; Q 40 I DEBUG ZWR RPCRSLT40 ; I DEBUG ZWR RPCRSLT 41 41 F J=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM IN THE LIST 42 42 . S VMAP=$NA(@TVMAP@(J)) -
ccr/trunk/p/GPLUNIT.m
r121 r122 113 113 W ! 114 114 W "THE TESTS!",! 115 I DEBUG ZWR ZTMP115 ; I DEBUG ZWR ZTMP 116 116 Q 117 117 ; -
ccr/trunk/p/GPLVITAL.m
r121 r122 39 39 N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX 40 40 D VITDATES(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY 41 I DEBUG ZWR VDATES ;DEBUG41 ; I DEBUG ZWR VDATES ;DEBUG 42 42 S VCNT=$$SORTDT^CCRUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE 43 43 ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY … … 175 175 . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP) 176 176 ; ZWR ^TMP($J,"VITALS",*) 177 ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS177 ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS 178 178 I DEBUG D PARY^GPLXPATH(VITOUTXML) 179 179 N VITTMP,I … … 183 183 . F I=1:1:VITTMP(0) W VITTMP(I),! 184 184 Q 185 ;186 VITSORT(V1,V2) ; DEPRECATED USE $$RSORTDT^CCRUTIL187 ; DATE SORT VITALS ARRAY AND RETURN INDEX IN V1 AND COUNT188 ; AS EXTRINSIC189 ; BOTH V1 AND V2 ARE PASSED BY REFERENCE190 N VSRT ; TEMP FOR HASHING DATES191 N ZI,ZJ,ZTMP,ZCNT,ZP1,ZP2192 S ZCNT=0 ; COUNTING NUMBER OF VITALS193 S ZTMP="" ;194 F ZI=0:0 D Q:$O(V2(ZTMP))="" ; FOR EACH VITAL IN THE ARRAY195 . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT196 . S ZTMP=$O(V2(ZTMP)) ; NEXT VITAL197 . I $D(V2(ZTMP)) D ; IF THE RESULT EXISTS198 . . S ZP1=$P($P(V2(ZTMP),U,4),".",1) ; THE DATE PIECE199 . . S ZP2=$P($P(V2(ZTMP),U,4),".",2) ; THE TIME PIECE200 . . S VSRT(ZP1,ZP2_"00000"_ZCNT)=ZCNT ; HASH ON DATE AND TIME201 . . ; S VSRT($P(V2(ZTMP),U,4)_"000000"_ZCNT)=ZCNT ; PULL DATE202 . I DEBUG W "ZTMP=",ZTMP," "203 S V1(0)=ZCNT ; ARRAYS ARE THE SAME SIZE204 I DEBUG ZWR V2205 I DEBUG ZWR VSRT206 N ZD,ZT ; DATA AND TIME ITERATORS207 N ZDONE ; DONE FLAG208 S (ZD,ZT)=""209 S ZDONE=0210 N ZZCNT S ZZCNT=0 ; ANOTHER COUNTER211 F ZI=0:0 D Q:ZDONE ; VISIT THE ARRAY IN DATE ORDER212 . S ZD=$O(VSRT(ZD),-1) ; NEXT DATE213 . I ZD="" S ZDONE=1214 . I 'ZDONE D ; MORE DATES215 . . S ZT="" ; WANT FIRST TIME FOR THIS DATE216 . . F ZJ=0:0 D Q:$O(VSRT(ZD,ZT),-1)="" ; LOOP THROUGH ALL TIMES217 . . . S ZT=$O(VSRT(ZD,ZT),-1) ; NEXT TIME218 . . . S ZZCNT=ZZCNT+1 ; INCREMENT COUNTER219 . . . S V1(ZZCNT)=VSRT(ZD,ZT) ; PULL OUT THE INDEX220 . ; S V1(ZI)=ZI ; PLUG FOR NOW, DATES NOT SORTED221 I DEBUG ZWR V1222 Q ZCNT223 185 ; 224 186 VITDATES(VDT) ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
Note:
See TracChangeset
for help on using the changeset viewer.
