Changeset 1588
- Timestamp:
- Oct 30, 2012, 1:17:44 PM (11 years ago)
- Location:
- ccr/tags/CCD-CCR_GENERATION_UTILITIES_1P2
- Files:
-
- 2 edited
-
CCD-CCR_GENERATION_UTILITIES_1P2.KID (modified) (43 diffs)
-
README.txt (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/tags/CCD-CCR_GENERATION_UTILITIES_1P2/CCD-CCR_GENERATION_UTILITIES_1P2.KID
r1551 r1588 1 KIDS Distribution saved on Jun 25, 2012@10:01:502 C hanged name to full Package Name rather than nmsp1 KIDS Distribution saved on Oct 30, 2012@10:27:50 2 CCD/CCR Generation Package Version 1.2 3 3 **KIDS**:CCD/CCR GENERATION UTILITIES 1.2^ 4 4 5 5 **INSTALL NAME** 6 6 CCD/CCR GENERATION UTILITIES 1.2 7 "BLD",7891,0) 8 CCD/CCR GENERATION UTILITIES 1.2^CCD/CCR GENERATION UTILITIES^0^3120625^n 9 "BLD",7891,1,0) 10 ^^185^185^3120511^^^^ 11 "BLD",7891,1,1,0) 7 "BLD",7883,0) 8 CCD/CCR GENERATION UTILITIES 1.2^CCD/CCR GENERATION UTILITIES^0^3121030^n 9 "BLD",7883,1,0) 10 ^^188^188^3121029^ 11 "BLD",7883,1,1,0) 12 Licensed under AGPL v3. For complete license text, see 13 "BLD",7883,1,2,0) 14 http://www.gnu.org/licenses/agpl-3.0.html 15 "BLD",7883,1,3,0) 16 17 "BLD",7883,1,4,0) 12 18 CCR Project release v1.2 13 "BLD",78 91,1,2,0)19 "BLD",7883,1,5,0) 14 20 15 "BLD",78 91,1,3,0)21 "BLD",7883,1,6,0) 16 22 The purpose of the CCR package is to provide support for exporting and 17 "BLD",78 91,1,4,0)23 "BLD",7883,1,7,0) 18 24 eventually importing patient information from/to VistA in XML documents 19 "BLD",78 91,1,5,0)25 "BLD",7883,1,8,0) 20 26 conforming to the Continuity of Care Record (CCR - ASTM) and Continuity 21 "BLD",78 91,1,6,0)27 "BLD",7883,1,9,0) 22 28 of Care Document (CCD - HL7) standards. 23 "BLD",78 91,1,7,0)29 "BLD",7883,1,10,0) 24 30 25 "BLD",78 91,1,8,0)31 "BLD",7883,1,11,0) 26 32 This version of the CCR package provides: 27 "BLD",78 91,1,9,0)33 "BLD",7883,1,12,0) 28 34 29 "BLD",78 91,1,10,0)35 "BLD",7883,1,13,0) 30 36 EXPORT^C0CCCR 31 "BLD",78 91,1,11,0)37 "BLD",7883,1,14,0) 32 38 A command line interface to export a single patient's CCR to a host 33 "BLD",78 91,1,12,0)39 "BLD",7883,1,15,0) 34 40 directory by specifying the patient by name. 35 "BLD",78 91,1,13,0)41 "BLD",7883,1,16,0) 36 42 37 "BLD",78 91,1,14,0)43 "BLD",7883,1,17,0) 38 44 EXPORT^C0CCCD 39 "BLD",78 91,1,15,0)45 "BLD",7883,1,18,0) 40 46 A command line interface to export a single patient's CCD to a host 41 "BLD",78 91,1,16,0)47 "BLD",7883,1,19,0) 42 48 directory by specifying the patient by name. As an alternative to 43 "BLD",78 91,1,17,0)49 "BLD",7883,1,20,0) 44 50 generating the CCD directly, an XSLT transformation is available to 45 "BLD",78 91,1,18,0)51 "BLD",7883,1,21,0) 46 52 translate a CCR into a level 2 CCD. This tranformation has been tested 47 "BLD",78 91,1,19,0)53 "BLD",7883,1,22,0) 48 54 and produces a CCD with all currently supported sections of the CCR. The 49 "BLD",78 91,1,20,0)55 "BLD",7883,1,23,0) 50 56 EXPORT^C0CCCD only extracts the PROBLEMS section into a CCD. 51 "BLD",78 91,1,21,0)57 "BLD",7883,1,24,0) 52 58 53 "BLD",78 91,1,22,0)59 "BLD",7883,1,25,0) 54 60 XPAT^C0CCCR(DFN,OUTDIR,OUTFILE) 55 "BLD",78 91,1,23,0)61 "BLD",7883,1,26,0) 56 62 A command line and program interface to export a single patient's CCR 57 "BLD",78 91,1,24,0)63 "BLD",7883,1,27,0) 58 64 using the IEN of the patient in the ^DPT file (DFN). 59 "BLD",78 91,1,25,0)65 "BLD",7883,1,28,0) 60 66 OUTDIR specifies an existing directory on the Host system into which the 61 "BLD",78 91,1,26,0)67 "BLD",7883,1,29,0) 62 68 CCR XML document will be written. If OUTDIR is null (""), the output 63 "BLD",78 91,1,27,0)69 "BLD",7883,1,30,0) 64 70 directory name will be taken from ^TMP("C0CCCR","ODIR"). 65 "BLD",78 91,1,28,0)71 "BLD",7883,1,31,0) 66 72 OUFILE specifies the host file name of the CCR XML document that will be 67 "BLD",78 91,1,29,0)73 "BLD",7883,1,32,0) 68 74 written for this patient. If OUTFILE is null ("") the document name will 69 "BLD",78 91,1,30,0)75 "BLD",7883,1,33,0) 70 76 default to PAT_x_CCR_V1.xml where x is the DFN of the patient. 71 "BLD",78 91,1,31,0)77 "BLD",7883,1,34,0) 72 78 73 "BLD",78 91,1,32,0)79 "BLD",7883,1,35,0) 74 80 CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART) 75 "BLD",78 91,1,33,0)81 "BLD",7883,1,36,0) 76 82 An RPC and program interface to return in return array CCRGRTN (passed by 77 "BLD",78 91,1,34,0)83 "BLD",7883,1,37,0) 78 84 reference) a single patient's CCR. 79 "BLD",78 91,1,35,0)85 "BLD",7883,1,38,0) 80 86 DFN is the patient's IEN 81 "BLD",78 91,1,36,0)87 "BLD",7883,1,39,0) 82 88 CCRPART is what portion of the CCR should be returned. If "CCR" is 83 "BLD",78 91,1,37,0)89 "BLD",7883,1,40,0) 84 90 specified, the entire CCR will be returned. If "PROBLEMS", "VITALS", or 85 "BLD",78 91,1,38,0)91 "BLD",7883,1,41,0) 86 92 "MEDICATIONS" is specified, only that section of the CCR will be returned. 87 "BLD",78 91,1,39,0)93 "BLD",7883,1,42,0) 88 94 CCRPARMS ARE PARAMETERS THAT AFFECT THE EXTRACTION 89 "BLD",78 91,1,40,0)95 "BLD",7883,1,43,0) 90 96 IN THE FORM "PARM1:VALUE1^PARM2:VALUE2" 91 "BLD",78 91,1,41,0)97 "BLD",7883,1,44,0) 92 98 EXAMPLE: "LABLIMIT:T-60" TO LIMIT LAB EXTRACTION TO THE LAST 60 DAYS 93 "BLD",78 91,1,42,0)99 "BLD",7883,1,45,0) 94 100 SEE C0CPARMS FOR A COMPLETE LIST OF SUPPORTED PARAMETERS 95 "BLD",78 91,1,43,0)101 "BLD",7883,1,46,0) 96 102 97 "BLD",78 91,1,44,0)103 "BLD",7883,1,47,0) 98 104 ANALYZE^C0CRIMA(BGNDFN,DFNCNT,CCRPARMS) 99 "BLD",78 91,1,45,0)105 "BLD",7883,1,48,0) 100 106 A command line and program interface to analyze the data from multiple 101 "BLD",78 91,1,46,0)107 "BLD",7883,1,49,0) 102 108 patients into categories that can be batch extracted. 103 "BLD",78 91,1,47,0)109 "BLD",7883,1,50,0) 104 110 BGNDFN is the beginning DFN to be analyzed. If BGNDFN is null ("") its 105 "BLD",78 91,1,48,0)111 "BLD",7883,1,51,0) 106 112 value will be taken from ^TMP("C0CRIM","RESUME"). If this variable does 107 "BLD",78 91,1,49,0)113 "BLD",7883,1,52,0) 108 114 not exist, the routine will start with the first IEN in the patient file 109 "BLD",78 91,1,50,0)115 "BLD",7883,1,53,0) 110 116 ^DPT. ^TMP("C0CRIM","RESUME") is updated to the "next" patient to be 111 "BLD",78 91,1,51,0)117 "BLD",7883,1,54,0) 112 118 analyzed on successful completion. 113 "BLD",78 91,1,52,0)119 "BLD",7883,1,55,0) 114 120 DFNCNT is the count of how many patient records will be analyzed in this 115 "BLD",78 91,1,53,0)121 "BLD",7883,1,56,0) 116 122 execution. 117 "BLD",78 91,1,54,0)123 "BLD",7883,1,57,0) 118 124 For example ANALYZE^C0CRIMA(1000,1000) would start at patient DFN 1000 119 "BLD",78 91,1,55,0)125 "BLD",7883,1,58,0) 120 126 and analyzes 1000 patient records. ANALYZE^C0CRIMA("",1000) would then 121 "BLD",78 91,1,56,0)127 "BLD",7883,1,59,0) 122 128 analyze the next 1000 patients. When the end of the patient file is 123 "BLD",78 91,1,57,0)129 "BLD",7883,1,60,0) 124 130 reached, the routine terminates with a message that RESET^C0CRIMA would 125 "BLD",78 91,1,58,0)131 "BLD",7883,1,61,0) 126 132 need to be called to restart the analysis. 127 "BLD",78 91,1,59,0)133 "BLD",7883,1,62,0) 128 134 129 "BLD",78 91,1,60,0)135 "BLD",7883,1,63,0) 130 136 The categories into which the records are analyzed consist of attribute 131 "BLD",78 91,1,61,0)137 "BLD",7883,1,64,0) 132 138 strings. The attributes represent characteristics of the variables that 133 "BLD",78 91,1,62,0)139 "BLD",7883,1,65,0) 134 140 can be extracted for a given patient into the CCR or the CCD. This 135 "BLD",78 91,1,63,0)141 "BLD",7883,1,66,0) 136 142 version supports the following attributes: 137 "BLD",78 91,1,64,0)143 "BLD",7883,1,67,0) 138 144 VITALS : the patient has variables for the VITALS section of the CCR/CCD 139 "BLD",78 91,1,65,0)145 "BLD",7883,1,68,0) 140 146 PROBLEMS : the patient has variables for the PROBLEMS section of the 141 "BLD",78 91,1,66,0)147 "BLD",7883,1,69,0) 142 148 CCR/CCD 143 "BLD",78 91,1,67,0)149 "BLD",7883,1,70,0) 144 150 MEDS : the patient has variables for the MEDICATIONS section of the 145 "BLD",78 91,1,68,0)151 "BLD",7883,1,71,0) 146 152 CCR/CCD 147 "BLD",78 91,1,69,0)153 "BLD",7883,1,72,0) 148 154 HEADER : the patient has variables for the HEADER section of the CCR/CCD. 149 "BLD",78 91,1,70,0)155 "BLD",7883,1,73,0) 150 156 All patients are marked with the HEADER attribute in this version. 151 "BLD",78 91,1,71,0)157 "BLD",7883,1,74,0) 152 158 NOTEXTRACTED : the CCR or CCD has not yet been produced/extracted for 153 "BLD",78 91,1,72,0)159 "BLD",7883,1,75,0) 154 160 this patient. All patient records are marked with the NOTEXTRACTED 155 "BLD",78 91,1,73,0)161 "BLD",7883,1,76,0) 156 162 attribute in this version for batch control processing (not implemented 157 "BLD",78 91,1,74,0)163 "BLD",7883,1,77,0) 158 164 in this version). 159 "BLD",78 91,1,75,0)165 "BLD",7883,1,78,0) 160 166 161 "BLD",78 91,1,76,0)167 "BLD",7883,1,79,0) 162 168 ANAZYZE^C0CRIMA calls the variable extraction routines that would be used 163 "BLD",78 91,1,77,0)169 "BLD",7883,1,80,0) 164 170 to produce a CCR or a CCD and saves the results to ^TMP("C0CRIM",DFN) for 165 "BLD",78 91,1,78,0)171 "BLD",7883,1,81,0) 166 172 each patient. In addition, the attribute string for each patient is saved 167 "BLD",78 91,1,79,0)173 "BLD",7883,1,82,0) 168 174 in ^TMP("C0CRIM","ATTR") 169 "BLD",78 91,1,80,0)175 "BLD",7883,1,83,0) 170 176 171 "BLD",78 91,1,81,0)177 "BLD",7883,1,84,0) 172 178 Categories are created as they first occur based on each unique 173 "BLD",78 91,1,82,0)179 "BLD",7883,1,85,0) 174 180 combination of attributes that is encountered. They are named after the 175 "BLD",78 91,1,83,0)181 "BLD",7883,1,86,0) 176 182 attribute table that is used for the analysis. This version supports only 177 "BLD",78 91,1,84,0)183 "BLD",7883,1,87,0) 178 184 the attribute table .RIMTBL. and the categories are named "RIMTBL_x". An 179 "BLD",78 91,1,85,0)185 "BLD",7883,1,88,0) 180 186 example set of categories from a demo systems is: 181 "BLD",78 91,1,86,0)187 "BLD",7883,1,89,0) 182 188 183 "BLD",78 91,1,87,0)189 "BLD",7883,1,90,0) 184 190 GTM>D CLIST^C0CRIMA 185 "BLD",78 91,1,88,0)191 "BLD",7883,1,91,0) 186 192 (RIMTBL_1:105) ^NOTEXTRACTED^HEADER^^^PROBLEMS^^^^^VITALS^^^^^MEDS 187 "BLD",78 91,1,89,0)193 "BLD",7883,1,92,0) 188 194 (RIMTBL_2:596) ^NOTEXTRACTED^HEADER^^^^^^^^VITALS 189 "BLD",78 91,1,90,0)195 "BLD",7883,1,93,0) 190 196 (RIMTBL_3:44) ^NOTEXTRACTED^HEADER^^^PROBLEMS^^^^^VITALS 191 "BLD",78 91,1,91,0)197 "BLD",7883,1,94,0) 192 198 (RIMTBL_4:821) ^NOTEXTRACTED^HEADER 193 "BLD",78 91,1,92,0)199 "BLD",7883,1,95,0) 194 200 (RIMTBL_5:18) ^NOTEXTRACTED^HEADER^^^^^^^^VITALS^^^^^MEDS 195 "BLD",78 91,1,93,0)201 "BLD",7883,1,96,0) 196 202 (RIMTBL_6:14) ^NOTEXTRACTED^HEADER^^^PROBLEMS 197 "BLD",78 91,1,94,0)203 "BLD",7883,1,97,0) 198 204 (RIMTBL_7:15) ^NOTEXTRACTED^HEADER^^^^^^^^^^^^^MEDS 199 "BLD",78 91,1,95,0)205 "BLD",7883,1,98,0) 200 206 (RIMTBL_8:5) ^NOTEXTRACTED^HEADER^^^PROBLEMS^^^^^^^^^^MEDS 201 "BLD",78 91,1,96,0)207 "BLD",7883,1,99,0) 202 208 203 "BLD",78 91,1,97,0)209 "BLD",7883,1,100,0) 204 210 for RIMTBL_1 in this example, 105 is the record count of patients who 205 "BLD",78 91,1,98,0)211 "BLD",7883,1,101,0) 206 212 have this combination of attributes. The list of patients for each 207 "BLD",78 91,1,99,0)213 "BLD",7883,1,102,0) 208 214 category is also maintained for batch extraction. 209 "BLD",78 91,1,100,0)215 "BLD",7883,1,103,0) 210 216 211 "BLD",78 91,1,101,0)217 "BLD",7883,1,104,0) 212 218 CLIST^C0CRIMA 213 "BLD",78 91,1,102,0)219 "BLD",7883,1,105,0) 214 220 A command line interface to show a summary of the categories, record 215 "BLD",78 91,1,103,0)221 "BLD",7883,1,106,0) 216 222 counts, and attributes that have been analyzed so far. It produces the 217 "BLD",78 91,1,104,0)223 "BLD",7883,1,107,0) 218 224 listing in the example above from information stored in 219 "BLD",78 91,1,105,0)225 "BLD",7883,1,108,0) 220 226 ^TMP("C0CRIM","CATS","RIMTBL"). It is intended for future versions that 221 "BLD",78 91,1,106,0)227 "BLD",7883,1,109,0) 222 228 attribute tables be supported in addition to the default "RIMTBL". 223 "BLD",78 91,1,107,0)229 "BLD",7883,1,110,0) 224 230 225 "BLD",78 91,1,108,0)231 "BLD",7883,1,111,0) 226 232 CPAT^C0CRIMA(CPATCAT) 227 "BLD",78 91,1,109,0)233 "BLD",7883,1,112,0) 228 234 A command line interface which shows the DFN numbers of the patients 229 "BLD",78 91,1,110,0)235 "BLD",7883,1,113,0) 230 236 represented by the category CPATCAT. DFNs are listed 10 per line. For 231 "BLD",78 91,1,111,0)237 "BLD",7883,1,114,0) 232 238 example: 233 "BLD",78 91,1,112,0)239 "BLD",7883,1,115,0) 234 240 235 "BLD",78 91,1,113,0)241 "BLD",7883,1,116,0) 236 242 GTM>D CPAT^C0CRIMA("RIMTBL_1") 237 "BLD",78 91,1,114,0)243 "BLD",7883,1,117,0) 238 244 1 3 8 25 42 69 123 140 146 149 239 "BLD",78 91,1,115,0)245 "BLD",7883,1,118,0) 240 246 151 168 204 205 217 218 224 228 229 231 241 "BLD",78 91,1,116,0)247 "BLD",7883,1,119,0) 242 248 236 237 240 253 260 267 271 301 347 350 243 "BLD",78 91,1,117,0)249 "BLD",7883,1,120,0) 244 250 366 379 384 391 407 418 419 420 428 433 245 "BLD",78 91,1,118,0)251 "BLD",7883,1,121,0) 246 252 442 520 569 600 620 692 706 715 722 723 247 "BLD",78 91,1,119,0)253 "BLD",7883,1,122,0) 248 254 724 728 730 744 745 746 747 748 749 750 249 "BLD",78 91,1,120,0)255 "BLD",7883,1,123,0) 250 256 751 752 753 754 755 756 757 758 759 760 251 "BLD",78 91,1,121,0)257 "BLD",7883,1,124,0) 252 258 761 762 763 764 765 766 767 768 769 770 253 "BLD",78 91,1,122,0)259 "BLD",7883,1,125,0) 254 260 771 772 773 774 775 776 777 778 779 780 255 "BLD",78 91,1,123,0)261 "BLD",7883,1,126,0) 256 262 100000 100001 100002 100003 100004 100005 100006 100007 100008 100009 257 "BLD",78 91,1,124,0)263 "BLD",7883,1,127,0) 258 264 100010 100011 100012 100013 100014 259 "BLD",78 91,1,125,0)265 "BLD",7883,1,128,0) 260 266 261 "BLD",78 91,1,126,0)267 "BLD",7883,1,129,0) 262 268 These are the 105 patient records included in category "RIMTBL_1" from 263 "BLD",78 91,1,127,0)269 "BLD",7883,1,130,0) 264 270 the above example. 265 "BLD",78 91,1,128,0)271 "BLD",7883,1,131,0) 266 272 267 "BLD",78 91,1,129,0)273 "BLD",7883,1,132,0) 268 274 DPATV^C0CRIMA(DFN,"SECTION") 269 "BLD",78 91,1,130,0)275 "BLD",7883,1,133,0) 270 276 A command line interface to display the values of variables for a 271 "BLD",78 91,1,131,0)277 "BLD",7883,1,134,0) 272 278 patient. "SECTION" can be any of the CCR sections. ie 273 "BLD",78 91,1,132,0)279 "BLD",7883,1,135,0) 274 280 "ALERTS","RESULTS","MEDS". If SECTION is ommitted, all sections will be 275 "BLD",78 91,1,133,0)281 "BLD",7883,1,136,0) 276 282 shown. An example: 277 "BLD",78 91,1,134,0)283 "BLD",7883,1,137,0) 278 284 279 "BLD",78 91,1,135,0)285 "BLD",7883,1,138,0) 280 286 GTM>D DPATV^C0CRIMA(2,"PROBLEMS") 281 "BLD",78 91,1,136,0)287 "BLD",7883,1,139,0) 282 288 1 1^PROBLEMCODEVALUE^V18.0 283 "BLD",78 91,1,137,0)289 "BLD",7883,1,140,0) 284 290 2 1^PROBLEMCODINGVERSION^ 285 "BLD",78 91,1,138,0)291 "BLD",7883,1,141,0) 286 292 3 1^PROBLEMCONDITION^P 287 "BLD",78 91,1,139,0)293 "BLD",7883,1,142,0) 288 294 4 1^PROBLEMDATEMOD^2005-07-19T00:00:00-05:00 289 "BLD",78 91,1,140,0)295 "BLD",7883,1,143,0) 290 296 5 1^PROBLEMDATEOFONSET^1700--T00:00:00-05:00 291 "BLD",78 91,1,141,0)297 "BLD",7883,1,144,0) 292 298 6 1^PROBLEMDESCRIPTION^Family History of Diabetes Mellitus (ICD-9-CM 293 "BLD",78 91,1,142,0)299 "BLD",7883,1,145,0) 294 300 V18.0) 295 "BLD",78 91,1,143,0)301 "BLD",7883,1,146,0) 296 302 7 1^PROBLEMDTREC^1701--T00:00:00-05:00 297 "BLD",78 91,1,144,0)303 "BLD",7883,1,147,0) 298 304 8 1^PROBLEMHASCMT^ 299 "BLD",78 91,1,145,0)305 "BLD",7883,1,148,0) 300 306 9 1^PROBLEMIEN^8 301 "BLD",78 91,1,146,0)307 "BLD",7883,1,149,0) 302 308 10 1^PROBLEMINACT^1700--T00:00:00-05:00 303 "BLD",78 91,1,147,0)309 "BLD",7883,1,150,0) 304 310 305 "BLD",78 91,1,148,0)311 "BLD",7883,1,151,0) 306 312 DCCR^C0CCCR(DFN) 307 "BLD",78 91,1,149,0)313 "BLD",7883,1,152,0) 308 314 This will display the XML of a CCR that has been generated for a patient. 309 "BLD",78 91,1,150,0)315 "BLD",7883,1,153,0) 310 316 It is run after generating the CCR with XPAT^C0CCCR or XCPAT^C0CRIMA. 311 "BLD",78 91,1,151,0)317 "BLD",7883,1,154,0) 312 318 313 "BLD",78 91,1,152,0)319 "BLD",7883,1,155,0) 314 320 XCPAT^C0CRIMA(CPATCAT) 315 "BLD",78 91,1,153,0)321 "BLD",7883,1,156,0) 316 322 A command line interface to extract a batch of patient CCR documents that 317 "BLD",78 91,1,154,0)323 "BLD",7883,1,157,0) 318 324 are associated with the category CPATCAT. For example, 319 "BLD",78 91,1,155,0)325 "BLD",7883,1,158,0) 320 326 321 "BLD",78 91,1,156,0)327 "BLD",7883,1,159,0) 322 328 XCPAT^C0CRIMA("RIMTBL_1") to extract the CCR documents for the 105 323 "BLD",78 91,1,157,0)329 "BLD",7883,1,160,0) 324 330 patients in the above example. 325 "BLD",78 91,1,158,0)331 "BLD",7883,1,161,0) 326 332 327 "BLD",78 91,1,159,0)333 "BLD",7883,1,162,0) 328 334 RESET^C0CRIMA 329 "BLD",78 91,1,160,0)335 "BLD",7883,1,163,0) 330 336 A command line interface to kill all ANALYZE^C0CRIMA results stored so 331 "BLD",78 91,1,161,0)337 "BLD",7883,1,164,0) 332 338 far so that the analysis can be done again. It kills 333 "BLD",78 91,1,162,0)339 "BLD",7883,1,165,0) 334 340 ^TMP("C0CRIM","RESUME") and all extraction variables that have been saved 335 "BLD",78 91,1,163,0)341 "BLD",7883,1,166,0) 336 342 in ^TMP("C0CRIM") 337 "BLD",78 91,1,164,0)343 "BLD",7883,1,167,0) 338 344 339 "BLD",78 91,1,165,0)345 "BLD",7883,1,168,0) 340 346 NOTES: 341 "BLD",78 91,1,166,0)347 "BLD",7883,1,169,0) 342 348 This version of the package is a prototype, and does not yet make use of 343 "BLD",78 91,1,167,0)349 "BLD",7883,1,170,0) 344 350 the standard VistA features that are appropriate for it to use. 345 "BLD",78 91,1,168,0)351 "BLD",7883,1,171,0) 346 352 347 "BLD",78 91,1,169,0)353 "BLD",7883,1,172,0) 348 354 ^TMP("C0CCCR","ODIR") must be set manually to the output directory on the 349 "BLD",78 91,1,170,0)355 "BLD",7883,1,173,0) 350 356 Host System. It is intended that this be maintainable in a parameter file. 351 "BLD",78 91,1,171,0)357 "BLD",7883,1,174,0) 352 358 353 "BLD",78 91,1,172,0)359 "BLD",7883,1,175,0) 354 360 CCRRPC^C0CCCR and CCDRPC^C0CCCD are intended to be RPC interfaces to the 355 "BLD",78 91,1,173,0)361 "BLD",7883,1,176,0) 356 362 package but there is no entry for them in the RPC table and the RPC 357 "BLD",78 91,1,174,0)363 "BLD",7883,1,177,0) 358 364 method of access has not been tested. 359 "BLD",78 91,1,175,0)365 "BLD",7883,1,178,0) 360 366 361 "BLD",78 91,1,176,0)367 "BLD",7883,1,179,0) 362 368 Most of the command line interface functions in the package are intended 363 "BLD",78 91,1,177,0)369 "BLD",7883,1,180,0) 364 370 to also be made available as RPC calls. This will provide the ability to 365 "BLD",78 91,1,178,0)371 "BLD",7883,1,181,0) 366 372 invoke and control batch extraction and analysis via RPCs 367 "BLD",78 91,1,179,0)373 "BLD",7883,1,182,0) 368 374 369 "BLD",78 91,1,180,0)375 "BLD",7883,1,183,0) 370 376 The "RIM" variables and attributes that are now being stored in 371 "BLD",78 91,1,181,0)377 "BLD",7883,1,184,0) 372 378 ^TMP("C0CRIM") are intended to be maintained in a standard FILEMAN 373 "BLD",78 91,1,182,0)379 "BLD",7883,1,185,0) 374 380 global, and to take advantage of FILEMAN indexing for efficient batch 375 "BLD",78 91,1,183,0)381 "BLD",7883,1,186,0) 376 382 analysis and processing. 377 "BLD",78 91,1,184,0)383 "BLD",7883,1,187,0) 378 384 379 "BLD",78 91,1,185,0)385 "BLD",7883,1,188,0) 380 386 It is intended that menu interfaces be provided in addition to command 381 "BLD",78 91,4,0)387 "BLD",7883,4,0) 382 388 ^9.64PA^170.9^12 383 "BLD",78 91,4,170,0)389 "BLD",7883,4,170,0) 384 390 170 385 "BLD",78 91,4,170,222)391 "BLD",7883,4,170,222) 386 392 y^y^f^^n^^y^o^n 387 "BLD",78 91,4,170.101,0)393 "BLD",7883,4,170.101,0) 388 394 170.101 389 "BLD",78 91,4,170.101,222)395 "BLD",7883,4,170.101,222) 390 396 y^y^f^^n^^y^o^n 391 "BLD",78 91,4,170.9,0)397 "BLD",7883,4,170.9,0) 392 398 170.9 393 "BLD",78 91,4,170.9,222)399 "BLD",7883,4,170.9,222) 394 400 y^y^f^^n^^y^o^n 395 "BLD",78 91,4,171.101,0)401 "BLD",7883,4,171.101,0) 396 402 171.101 397 "BLD",78 91,4,171.101,222)403 "BLD",7883,4,171.101,222) 398 404 y^y^f^^^^n 399 "BLD",78 91,4,171.401,0)405 "BLD",7883,4,171.401,0) 400 406 171.401 401 "BLD",78 91,4,171.401,222)407 "BLD",7883,4,171.401,222) 402 408 y^y^f^^^^n 403 "BLD",78 91,4,175,0)409 "BLD",7883,4,175,0) 404 410 175 405 "BLD",78 91,4,175,222)411 "BLD",7883,4,175,222) 406 412 y^y^f^^^^n 407 "BLD",78 91,4,176.112,0)413 "BLD",7883,4,176.112,0) 408 414 176.112 409 "BLD",78 91,4,176.112,222)415 "BLD",7883,4,176.112,222) 410 416 y^y^f^^n^^y^o^n 411 "BLD",78 91,4,177.101,0)417 "BLD",7883,4,177.101,0) 412 418 177.101 413 "BLD",78 91,4,177.101,222)419 "BLD",7883,4,177.101,222) 414 420 y^y^f^^^^n 415 "BLD",78 91,4,177.201,0)421 "BLD",7883,4,177.201,0) 416 422 177.201 417 "BLD",78 91,4,177.201,222)423 "BLD",7883,4,177.201,222) 418 424 y^y^f^^n^^y^o^n 419 "BLD",78 91,4,177.301,0)425 "BLD",7883,4,177.301,0) 420 426 177.301 421 "BLD",78 91,4,177.301,222)427 "BLD",7883,4,177.301,222) 422 428 y^y^f^^^^n 423 "BLD",78 91,4,178.101,0)429 "BLD",7883,4,178.101,0) 424 430 178.101 425 "BLD",78 91,4,178.101,222)431 "BLD",7883,4,178.101,222) 426 432 y^y^f^^n^^y^o^n 427 "BLD",78 91,4,178.301,0)433 "BLD",7883,4,178.301,0) 428 434 178.301 429 "BLD",78 91,4,178.301,222)435 "BLD",7883,4,178.301,222) 430 436 y^y^f^^n^^y^o^n 431 "BLD",78 91,4,"B",170,170)437 "BLD",7883,4,"B",170,170) 432 438 433 "BLD",78 91,4,"B",170.101,170.101)439 "BLD",7883,4,"B",170.101,170.101) 434 440 435 "BLD",78 91,4,"B",170.9,170.9)441 "BLD",7883,4,"B",170.9,170.9) 436 442 437 "BLD",78 91,4,"B",171.101,171.101)443 "BLD",7883,4,"B",171.101,171.101) 438 444 439 "BLD",78 91,4,"B",171.401,171.401)445 "BLD",7883,4,"B",171.401,171.401) 440 446 441 "BLD",78 91,4,"B",175,175)447 "BLD",7883,4,"B",175,175) 442 448 443 "BLD",78 91,4,"B",176.112,176.112)449 "BLD",7883,4,"B",176.112,176.112) 444 450 445 "BLD",78 91,4,"B",177.101,177.101)451 "BLD",7883,4,"B",177.101,177.101) 446 452 447 "BLD",78 91,4,"B",177.201,177.201)453 "BLD",7883,4,"B",177.201,177.201) 448 454 449 "BLD",78 91,4,"B",177.301,177.301)455 "BLD",7883,4,"B",177.301,177.301) 450 456 451 "BLD",78 91,4,"B",178.101,178.101)457 "BLD",7883,4,"B",178.101,178.101) 452 458 453 "BLD",78 91,4,"B",178.301,178.301)459 "BLD",7883,4,"B",178.301,178.301) 454 460 455 "BLD",78 91,6.3)456 5 0457 "BLD",78 91,"ABNS",0)461 "BLD",7883,6.3) 462 51 463 "BLD",7883,"ABNS",0) 458 464 ^9.66A^^ 459 "BLD",78 91,"ABPKG")465 "BLD",7883,"ABPKG") 460 466 n^n 461 "BLD",78 91,"INI")467 "BLD",7883,"INI") 462 468 PRE^C0CENV 463 "BLD",78 91,"INIT")469 "BLD",7883,"INIT") 464 470 POST^C0CENV 465 "BLD",78 91,"KRN",0)471 "BLD",7883,"KRN",0) 466 472 ^9.67PA^779.2^20 467 "BLD",78 91,"KRN",.4,0)473 "BLD",7883,"KRN",.4,0) 468 474 .4 469 "BLD",78 91,"KRN",.401,0)475 "BLD",7883,"KRN",.401,0) 470 476 .401 471 "BLD",78 91,"KRN",.402,0)477 "BLD",7883,"KRN",.402,0) 472 478 .402 473 "BLD",78 91,"KRN",.403,0)479 "BLD",7883,"KRN",.403,0) 474 480 .403 475 "BLD",78 91,"KRN",.5,0)481 "BLD",7883,"KRN",.5,0) 476 482 .5 477 "BLD",78 91,"KRN",.84,0)483 "BLD",7883,"KRN",.84,0) 478 484 .84 479 "BLD",78 91,"KRN",3.6,0)485 "BLD",7883,"KRN",3.6,0) 480 486 3.6 481 "BLD",78 91,"KRN",3.8,0)487 "BLD",7883,"KRN",3.8,0) 482 488 3.8 483 "BLD",78 91,"KRN",9.2,0)489 "BLD",7883,"KRN",9.2,0) 484 490 9.2 485 "BLD",78 91,"KRN",9.8,0)491 "BLD",7883,"KRN",9.8,0) 486 492 9.8 487 "BLD",78 91,"KRN",9.8,"NM",0)493 "BLD",7883,"KRN",9.8,"NM",0) 488 494 ^9.68A^110^79 489 "BLD",78 91,"KRN",9.8,"NM",22,0)490 C0CRXN^^0^B10 3277157491 "BLD",78 91,"KRN",9.8,"NM",23,0)492 C0CRNF^^0^B19 5772222493 "BLD",78 91,"KRN",9.8,"NM",24,0)494 C0CFM1^^0^B2 7048099495 "BLD",78 91,"KRN",9.8,"NM",29,0)496 C0CPARMS^^0^B 10161575497 "BLD",78 91,"KRN",9.8,"NM",31,0)498 C0CFM2^^0^B 102195978499 "BLD",78 91,"KRN",9.8,"NM",34,0)500 C0CXPATH^^0^B5 21207435501 "BLD",78 91,"KRN",9.8,"NM",35,0)502 C0CXPAT0^^0^B 50736852503 "BLD",78 91,"KRN",9.8,"NM",36,0)504 C0CVITAL^^0^B31 9933080505 "BLD",78 91,"KRN",9.8,"NM",37,0)506 C0CUNIT^^0^B 43465566507 "BLD",78 91,"KRN",9.8,"NM",38,0)508 C0CRIMA^^0^B3 31901748509 "BLD",78 91,"KRN",9.8,"NM",39,0)510 C0CPROBS^^0^B5 3281308511 "BLD",78 91,"KRN",9.8,"NM",40,0)512 C0CLABS^^0^B2 82604886513 "BLD",78 91,"KRN",9.8,"NM",41,0)514 C0CIMMU^^0^B 20441765515 "BLD",78 91,"KRN",9.8,"NM",42,0)516 C0CCCR0^^0^B7 90419172517 "BLD",78 91,"KRN",9.8,"NM",43,0)518 C0CCCR^^0^B1 11682825519 "BLD",78 91,"KRN",9.8,"NM",44,0)520 C0CCCD1^^0^B 100634737521 "BLD",78 91,"KRN",9.8,"NM",45,0)522 C0CCCD^^0^B 114134049523 "BLD",78 91,"KRN",9.8,"NM",46,0)524 C0CALERT^^0^B31 627309525 "BLD",78 91,"KRN",9.8,"NM",47,0)526 C0CACTOR^^0^B9 9733742527 "BLD",78 91,"KRN",9.8,"NM",48,0)528 C0CMED^^0^B18 939705529 "BLD",78 91,"KRN",9.8,"NM",49,0)530 C0CMED1^^0^B11 3570971531 "BLD",78 91,"KRN",9.8,"NM",50,0)532 C0CMED2^^0^B14 7041837533 "BLD",78 91,"KRN",9.8,"NM",51,0)534 C0CMED3^^0^B17 2422279535 "BLD",78 91,"KRN",9.8,"NM",52,0)536 C0CMED6^^0^B19 4349409537 "BLD",78 91,"KRN",9.8,"NM",53,0)538 C0CDPT^^0^B4 5873061539 "BLD",78 91,"KRN",9.8,"NM",54,0)540 C0CUTIL^^0^B2 7079469541 "BLD",78 91,"KRN",9.8,"NM",55,0)542 C0CVA200^^0^B3 2092477543 "BLD",78 91,"KRN",9.8,"NM",56,0)544 C0CSYS^^0^B3 933593545 "BLD",78 91,"KRN",9.8,"NM",57,0)546 C0CBAT^^0^B56 971574547 "BLD",78 91,"KRN",9.8,"NM",61,0)548 C0CSUB1^^0^B1 6280924549 "BLD",78 91,"KRN",9.8,"NM",62,0)550 C0CLA7Q^^0^B2 1818572551 "BLD",78 91,"KRN",9.8,"NM",63,0)552 C0CPROC^^0^B2 7869918553 "BLD",78 91,"KRN",9.8,"NM",64,0)554 C0CMXP^^0^B7 7680190555 "BLD",78 91,"KRN",9.8,"NM",65,0)556 C0CMXML^^0^B5 6456416557 "BLD",78 91,"KRN",9.8,"NM",66,0)558 C0CVIT2^^0^B3 20700684559 "BLD",78 91,"KRN",9.8,"NM",67,0)560 C0CIM2^^0^B 20157375561 "BLD",78 91,"KRN",9.8,"NM",68,0)562 C0CCPT^^0^B1 6531537563 "BLD",78 91,"KRN",9.8,"NM",69,0)564 C0CSOAP^^0^B79 899662565 "BLD",78 91,"KRN",9.8,"NM",70,0)566 C0CENC^^0^B4 6321144567 "BLD",78 91,"KRN",9.8,"NM",71,0)568 C0CCMT^^0^B6 740701569 "BLD",78 91,"KRN",9.8,"NM",72,0)570 C0CIN^^0^B30 946883571 "BLD",78 91,"KRN",9.8,"NM",73,0)572 C0CDIC^^0^B4 3527636573 "BLD",78 91,"KRN",9.8,"NM",74,0)574 C0CDOM^^0^B86 773980575 "BLD",78 91,"KRN",9.8,"NM",75,0)576 C0CENV^^0^B2 5371113577 "BLD",78 91,"KRN",9.8,"NM",76,0)578 C0CEVC^^0^B 18388545579 "BLD",78 91,"KRN",9.8,"NM",77,0)580 C0CEWD^^0^B5 607678581 "BLD",78 91,"KRN",9.8,"NM",78,0)582 C0CEWD1^^0^B6 563070583 "BLD",78 91,"KRN",9.8,"NM",79,0)584 C0CFM3^^0^B6 8203631585 "BLD",78 91,"KRN",9.8,"NM",80,0)586 C0CLA7DD^^0^B 66668579587 "BLD",78 91,"KRN",9.8,"NM",81,0)588 C0CMAIL^^0^B9 2791623589 "BLD",78 91,"KRN",9.8,"NM",82,0)590 C0CMAIL2^^0^B16 6788518591 "BLD",78 91,"KRN",9.8,"NM",83,0)592 C0CMAIL3^^0^B22 4733815593 "BLD",78 91,"KRN",9.8,"NM",84,0)594 C0CMCCD^^0^B7 3168233595 "BLD",78 91,"KRN",9.8,"NM",85,0)596 C0CMED4^^0^B6 1058927597 "BLD",78 91,"KRN",9.8,"NM",86,0)598 C0CMIME^^0^B9 9031395599 "BLD",78 91,"KRN",9.8,"NM",87,0)600 C0CMXMLB^^0^B12 065941601 "BLD",78 91,"KRN",9.8,"NM",88,0)602 C0CNHIN^^0^B87 973392603 "BLD",78 91,"KRN",9.8,"NM",89,0)604 C0CNMED2^^0^B3 3217786605 "BLD",78 91,"KRN",9.8,"NM",90,0)606 C0CNMED4^^0^B9 9762510607 "BLD",78 91,"KRN",9.8,"NM",91,0)608 C0CORSLT^^0^B9 647157609 "BLD",78 91,"KRN",9.8,"NM",92,0)610 C0CPXRM^^0^B 14904056611 "BLD",78 91,"KRN",9.8,"NM",93,0)495 "BLD",7883,"KRN",9.8,"NM",22,0) 496 C0CRXN^^0^B102255510 497 "BLD",7883,"KRN",9.8,"NM",23,0) 498 C0CRNF^^0^B194328331 499 "BLD",7883,"KRN",9.8,"NM",24,0) 500 C0CFM1^^0^B26826658 501 "BLD",7883,"KRN",9.8,"NM",29,0) 502 C0CPARMS^^0^B9948429 503 "BLD",7883,"KRN",9.8,"NM",31,0) 504 C0CFM2^^0^B99587435 505 "BLD",7883,"KRN",9.8,"NM",34,0) 506 C0CXPATH^^0^B518646177 507 "BLD",7883,"KRN",9.8,"NM",35,0) 508 C0CXPAT0^^0^B49945143 509 "BLD",7883,"KRN",9.8,"NM",36,0) 510 C0CVITAL^^0^B314693716 511 "BLD",7883,"KRN",9.8,"NM",37,0) 512 C0CUNIT^^0^B33370246 513 "BLD",7883,"KRN",9.8,"NM",38,0) 514 C0CRIMA^^0^B328577528 515 "BLD",7883,"KRN",9.8,"NM",39,0) 516 C0CPROBS^^0^B51600314 517 "BLD",7883,"KRN",9.8,"NM",40,0) 518 C0CLABS^^0^B279276475 519 "BLD",7883,"KRN",9.8,"NM",41,0) 520 C0CIMMU^^0^B19603373 521 "BLD",7883,"KRN",9.8,"NM",42,0) 522 C0CCCR0^^0^B785598655 523 "BLD",7883,"KRN",9.8,"NM",43,0) 524 C0CCCR^^0^B109879694 525 "BLD",7883,"KRN",9.8,"NM",44,0) 526 C0CCCD1^^0^B96013153 527 "BLD",7883,"KRN",9.8,"NM",45,0) 528 C0CCCD^^0^B89035344 529 "BLD",7883,"KRN",9.8,"NM",46,0) 530 C0CALERT^^0^B31119471 531 "BLD",7883,"KRN",9.8,"NM",47,0) 532 C0CACTOR^^0^B98169360 533 "BLD",7883,"KRN",9.8,"NM",48,0) 534 C0CMED^^0^B18524779 535 "BLD",7883,"KRN",9.8,"NM",49,0) 536 C0CMED1^^0^B112207077 537 "BLD",7883,"KRN",9.8,"NM",50,0) 538 C0CMED2^^0^B145401668 539 "BLD",7883,"KRN",9.8,"NM",51,0) 540 C0CMED3^^0^B170674827 541 "BLD",7883,"KRN",9.8,"NM",52,0) 542 C0CMED6^^0^B192343303 543 "BLD",7883,"KRN",9.8,"NM",53,0) 544 C0CDPT^^0^B46820265 545 "BLD",7883,"KRN",9.8,"NM",54,0) 546 C0CUTIL^^0^B26410609 547 "BLD",7883,"KRN",9.8,"NM",55,0) 548 C0CVA200^^0^B31814686 549 "BLD",7883,"KRN",9.8,"NM",56,0) 550 C0CSYS^^0^B3817459 551 "BLD",7883,"KRN",9.8,"NM",57,0) 552 C0CBAT^^0^B56229594 553 "BLD",7883,"KRN",9.8,"NM",61,0) 554 C0CSUB1^^0^B15609029 555 "BLD",7883,"KRN",9.8,"NM",62,0) 556 C0CLA7Q^^0^B24672517 557 "BLD",7883,"KRN",9.8,"NM",63,0) 558 C0CPROC^^0^B26886546 559 "BLD",7883,"KRN",9.8,"NM",64,0) 560 C0CMXP^^0^B76428333 561 "BLD",7883,"KRN",9.8,"NM",65,0) 562 C0CMXML^^0^B55227178 563 "BLD",7883,"KRN",9.8,"NM",66,0) 564 C0CVIT2^^0^B317310035 565 "BLD",7883,"KRN",9.8,"NM",67,0) 566 C0CIM2^^0^B19669149 567 "BLD",7883,"KRN",9.8,"NM",68,0) 568 C0CCPT^^0^B17485471 569 "BLD",7883,"KRN",9.8,"NM",69,0) 570 C0CSOAP^^0^B79012960 571 "BLD",7883,"KRN",9.8,"NM",70,0) 572 C0CENC^^0^B45258660 573 "BLD",7883,"KRN",9.8,"NM",71,0) 574 C0CCMT^^0^B6559679 575 "BLD",7883,"KRN",9.8,"NM",72,0) 576 C0CIN^^0^B30222275 577 "BLD",7883,"KRN",9.8,"NM",73,0) 578 C0CDIC^^0^B42907516 579 "BLD",7883,"KRN",9.8,"NM",74,0) 580 C0CDOM^^0^B86328529 581 "BLD",7883,"KRN",9.8,"NM",75,0) 582 C0CENV^^0^B28427348 583 "BLD",7883,"KRN",9.8,"NM",76,0) 584 C0CEVC^^0^B21455969 585 "BLD",7883,"KRN",9.8,"NM",77,0) 586 C0CEWD^^0^B5530676 587 "BLD",7883,"KRN",9.8,"NM",78,0) 588 C0CEWD1^^0^B6276162 589 "BLD",7883,"KRN",9.8,"NM",79,0) 590 C0CFM3^^0^B66472582 591 "BLD",7883,"KRN",9.8,"NM",80,0) 592 C0CLA7DD^^0^B72588185 593 "BLD",7883,"KRN",9.8,"NM",81,0) 594 C0CMAIL^^0^B91585320 595 "BLD",7883,"KRN",9.8,"NM",82,0) 596 C0CMAIL2^^0^B165067910 597 "BLD",7883,"KRN",9.8,"NM",83,0) 598 C0CMAIL3^^0^B222669398 599 "BLD",7883,"KRN",9.8,"NM",84,0) 600 C0CMCCD^^0^B71988241 601 "BLD",7883,"KRN",9.8,"NM",85,0) 602 C0CMED4^^0^B60079150 603 "BLD",7883,"KRN",9.8,"NM",86,0) 604 C0CMIME^^0^B97918768 605 "BLD",7883,"KRN",9.8,"NM",87,0) 606 C0CMXMLB^^0^B12346525 607 "BLD",7883,"KRN",9.8,"NM",88,0) 608 C0CNHIN^^0^B87084020 609 "BLD",7883,"KRN",9.8,"NM",89,0) 610 C0CNMED2^^0^B32627824 611 "BLD",7883,"KRN",9.8,"NM",90,0) 612 C0CNMED4^^0^B98251317 613 "BLD",7883,"KRN",9.8,"NM",91,0) 614 C0CORSLT^^0^B9272901 615 "BLD",7883,"KRN",9.8,"NM",92,0) 616 C0CPXRM^^0^B4357 617 "BLD",7883,"KRN",9.8,"NM",93,0) 612 618 C0CQRY1^^0^B18992765 613 "BLD",78 91,"KRN",9.8,"NM",94,0)614 C0CQRY2^^0^B2 0465060615 "BLD",78 91,"KRN",9.8,"NM",95,0)616 C0CRNFRP^^0^B9 1701220617 "BLD",78 91,"KRN",9.8,"NM",96,0)618 C0CRPMS^^0^B1 6300714619 "BLD",78 91,"KRN",9.8,"NM",97,0)620 C0CRXNRD^^0^B3 1474664621 "BLD",78 91,"KRN",9.8,"NM",98,0)622 C0CSNOA^^0^B 56032588623 "BLD",78 91,"KRN",9.8,"NM",99,0)624 C0CVOBX1^^0^B1 2947698625 "BLD",78 91,"KRN",9.8,"NM",100,0)626 C0CVORU^^0^B 58596883627 "BLD",78 91,"KRN",9.8,"NM",101,0)628 C0CXEWD^^0^B15 380480629 "BLD",78 91,"KRN",9.8,"NM",102,0)630 C0COVREL^^0^B1 8541513631 "BLD",78 91,"KRN",9.8,"NM",103,0)632 C0COVRES^^0^B2 4677897633 "BLD",78 91,"KRN",9.8,"NM",104,0)634 C0COVREU^^0^B7 9442187635 "BLD",78 91,"KRN",9.8,"NM",105,0)636 C0CRAHL7^^0^B 54192731637 "BLD",78 91,"KRN",9.8,"NM",106,0)638 C0CRARPT^^0^B6 8379544639 "BLD",78 91,"KRN",9.8,"NM",107,0)640 C0CSQMB^^0^B 545540641 "BLD",78 91,"KRN",9.8,"NM",108,0)642 C0CTIU^^0^B6 2323461643 "BLD",78 91,"KRN",9.8,"NM",109,0)644 C0CTIU1^^0^B1 0596577645 "BLD",78 91,"KRN",9.8,"NM",110,0)646 C0CVALID^^0^B 2856461647 "BLD",78 91,"KRN",9.8,"NM","B","C0CACTOR",47)619 "BLD",7883,"KRN",9.8,"NM",94,0) 620 C0CQRY2^^0^B23443412 621 "BLD",7883,"KRN",9.8,"NM",95,0) 622 C0CRNFRP^^0^B90905910 623 "BLD",7883,"KRN",9.8,"NM",96,0) 624 C0CRPMS^^0^B15891746 625 "BLD",7883,"KRN",9.8,"NM",97,0) 626 C0CRXNRD^^0^B36296842 627 "BLD",7883,"KRN",9.8,"NM",98,0) 628 C0CSNOA^^0^B40683034 629 "BLD",7883,"KRN",9.8,"NM",99,0) 630 C0CVOBX1^^0^B14909630 631 "BLD",7883,"KRN",9.8,"NM",100,0) 632 C0CVORU^^0^B63096791 633 "BLD",7883,"KRN",9.8,"NM",101,0) 634 C0CXEWD^^0^B15053974 635 "BLD",7883,"KRN",9.8,"NM",102,0) 636 C0COVREL^^0^B19589538 637 "BLD",7883,"KRN",9.8,"NM",103,0) 638 C0COVRES^^0^B23183700 639 "BLD",7883,"KRN",9.8,"NM",104,0) 640 C0COVREU^^0^B78173648 641 "BLD",7883,"KRN",9.8,"NM",105,0) 642 C0CRAHL7^^0^B46426582 643 "BLD",7883,"KRN",9.8,"NM",106,0) 644 C0CRARPT^^0^B66576750 645 "BLD",7883,"KRN",9.8,"NM",107,0) 646 C0CSQMB^^0^B779536 647 "BLD",7883,"KRN",9.8,"NM",108,0) 648 C0CTIU^^0^B68529284 649 "BLD",7883,"KRN",9.8,"NM",109,0) 650 C0CTIU1^^0^B12758077 651 "BLD",7883,"KRN",9.8,"NM",110,0) 652 C0CVALID^^0^B3624866 653 "BLD",7883,"KRN",9.8,"NM","B","C0CACTOR",47) 648 654 649 "BLD",78 91,"KRN",9.8,"NM","B","C0CALERT",46)655 "BLD",7883,"KRN",9.8,"NM","B","C0CALERT",46) 650 656 651 "BLD",78 91,"KRN",9.8,"NM","B","C0CBAT",57)657 "BLD",7883,"KRN",9.8,"NM","B","C0CBAT",57) 652 658 653 "BLD",78 91,"KRN",9.8,"NM","B","C0CCCD",45)659 "BLD",7883,"KRN",9.8,"NM","B","C0CCCD",45) 654 660 655 "BLD",78 91,"KRN",9.8,"NM","B","C0CCCD1",44)661 "BLD",7883,"KRN",9.8,"NM","B","C0CCCD1",44) 656 662 657 "BLD",78 91,"KRN",9.8,"NM","B","C0CCCR",43)663 "BLD",7883,"KRN",9.8,"NM","B","C0CCCR",43) 658 664 659 "BLD",78 91,"KRN",9.8,"NM","B","C0CCCR0",42)665 "BLD",7883,"KRN",9.8,"NM","B","C0CCCR0",42) 660 666 661 "BLD",78 91,"KRN",9.8,"NM","B","C0CCMT",71)667 "BLD",7883,"KRN",9.8,"NM","B","C0CCMT",71) 662 668 663 "BLD",78 91,"KRN",9.8,"NM","B","C0CCPT",68)669 "BLD",7883,"KRN",9.8,"NM","B","C0CCPT",68) 664 670 665 "BLD",78 91,"KRN",9.8,"NM","B","C0CDIC",73)671 "BLD",7883,"KRN",9.8,"NM","B","C0CDIC",73) 666 672 667 "BLD",78 91,"KRN",9.8,"NM","B","C0CDOM",74)673 "BLD",7883,"KRN",9.8,"NM","B","C0CDOM",74) 668 674 669 "BLD",78 91,"KRN",9.8,"NM","B","C0CDPT",53)675 "BLD",7883,"KRN",9.8,"NM","B","C0CDPT",53) 670 676 671 "BLD",78 91,"KRN",9.8,"NM","B","C0CENC",70)677 "BLD",7883,"KRN",9.8,"NM","B","C0CENC",70) 672 678 673 "BLD",78 91,"KRN",9.8,"NM","B","C0CENV",75)679 "BLD",7883,"KRN",9.8,"NM","B","C0CENV",75) 674 680 675 "BLD",78 91,"KRN",9.8,"NM","B","C0CEVC",76)681 "BLD",7883,"KRN",9.8,"NM","B","C0CEVC",76) 676 682 677 "BLD",78 91,"KRN",9.8,"NM","B","C0CEWD",77)683 "BLD",7883,"KRN",9.8,"NM","B","C0CEWD",77) 678 684 679 "BLD",78 91,"KRN",9.8,"NM","B","C0CEWD1",78)685 "BLD",7883,"KRN",9.8,"NM","B","C0CEWD1",78) 680 686 681 "BLD",78 91,"KRN",9.8,"NM","B","C0CFM1",24)687 "BLD",7883,"KRN",9.8,"NM","B","C0CFM1",24) 682 688 683 "BLD",78 91,"KRN",9.8,"NM","B","C0CFM2",31)689 "BLD",7883,"KRN",9.8,"NM","B","C0CFM2",31) 684 690 685 "BLD",78 91,"KRN",9.8,"NM","B","C0CFM3",79)691 "BLD",7883,"KRN",9.8,"NM","B","C0CFM3",79) 686 692 687 "BLD",78 91,"KRN",9.8,"NM","B","C0CIM2",67)693 "BLD",7883,"KRN",9.8,"NM","B","C0CIM2",67) 688 694 689 "BLD",78 91,"KRN",9.8,"NM","B","C0CIMMU",41)695 "BLD",7883,"KRN",9.8,"NM","B","C0CIMMU",41) 690 696 691 "BLD",78 91,"KRN",9.8,"NM","B","C0CIN",72)697 "BLD",7883,"KRN",9.8,"NM","B","C0CIN",72) 692 698 693 "BLD",78 91,"KRN",9.8,"NM","B","C0CLA7DD",80)699 "BLD",7883,"KRN",9.8,"NM","B","C0CLA7DD",80) 694 700 695 "BLD",78 91,"KRN",9.8,"NM","B","C0CLA7Q",62)701 "BLD",7883,"KRN",9.8,"NM","B","C0CLA7Q",62) 696 702 697 "BLD",78 91,"KRN",9.8,"NM","B","C0CLABS",40)703 "BLD",7883,"KRN",9.8,"NM","B","C0CLABS",40) 698 704 699 "BLD",78 91,"KRN",9.8,"NM","B","C0CMAIL",81)705 "BLD",7883,"KRN",9.8,"NM","B","C0CMAIL",81) 700 706 701 "BLD",78 91,"KRN",9.8,"NM","B","C0CMAIL2",82)707 "BLD",7883,"KRN",9.8,"NM","B","C0CMAIL2",82) 702 708 703 "BLD",78 91,"KRN",9.8,"NM","B","C0CMAIL3",83)709 "BLD",7883,"KRN",9.8,"NM","B","C0CMAIL3",83) 704 710 705 "BLD",78 91,"KRN",9.8,"NM","B","C0CMCCD",84)711 "BLD",7883,"KRN",9.8,"NM","B","C0CMCCD",84) 706 712 707 "BLD",78 91,"KRN",9.8,"NM","B","C0CMED",48)713 "BLD",7883,"KRN",9.8,"NM","B","C0CMED",48) 708 714 709 "BLD",78 91,"KRN",9.8,"NM","B","C0CMED1",49)715 "BLD",7883,"KRN",9.8,"NM","B","C0CMED1",49) 710 716 711 "BLD",78 91,"KRN",9.8,"NM","B","C0CMED2",50)717 "BLD",7883,"KRN",9.8,"NM","B","C0CMED2",50) 712 718 713 "BLD",78 91,"KRN",9.8,"NM","B","C0CMED3",51)719 "BLD",7883,"KRN",9.8,"NM","B","C0CMED3",51) 714 720 715 "BLD",78 91,"KRN",9.8,"NM","B","C0CMED4",85)721 "BLD",7883,"KRN",9.8,"NM","B","C0CMED4",85) 716 722 717 "BLD",78 91,"KRN",9.8,"NM","B","C0CMED6",52)723 "BLD",7883,"KRN",9.8,"NM","B","C0CMED6",52) 718 724 719 "BLD",78 91,"KRN",9.8,"NM","B","C0CMIME",86)725 "BLD",7883,"KRN",9.8,"NM","B","C0CMIME",86) 720 726 721 "BLD",78 91,"KRN",9.8,"NM","B","C0CMXML",65)727 "BLD",7883,"KRN",9.8,"NM","B","C0CMXML",65) 722 728 723 "BLD",78 91,"KRN",9.8,"NM","B","C0CMXMLB",87)729 "BLD",7883,"KRN",9.8,"NM","B","C0CMXMLB",87) 724 730 725 "BLD",78 91,"KRN",9.8,"NM","B","C0CMXP",64)731 "BLD",7883,"KRN",9.8,"NM","B","C0CMXP",64) 726 732 727 "BLD",78 91,"KRN",9.8,"NM","B","C0CNHIN",88)733 "BLD",7883,"KRN",9.8,"NM","B","C0CNHIN",88) 728 734 729 "BLD",78 91,"KRN",9.8,"NM","B","C0CNMED2",89)735 "BLD",7883,"KRN",9.8,"NM","B","C0CNMED2",89) 730 736 731 "BLD",78 91,"KRN",9.8,"NM","B","C0CNMED4",90)737 "BLD",7883,"KRN",9.8,"NM","B","C0CNMED4",90) 732 738 733 "BLD",78 91,"KRN",9.8,"NM","B","C0CORSLT",91)739 "BLD",7883,"KRN",9.8,"NM","B","C0CORSLT",91) 734 740 735 "BLD",78 91,"KRN",9.8,"NM","B","C0COVREL",102)741 "BLD",7883,"KRN",9.8,"NM","B","C0COVREL",102) 736 742 737 "BLD",78 91,"KRN",9.8,"NM","B","C0COVRES",103)743 "BLD",7883,"KRN",9.8,"NM","B","C0COVRES",103) 738 744 739 "BLD",78 91,"KRN",9.8,"NM","B","C0COVREU",104)745 "BLD",7883,"KRN",9.8,"NM","B","C0COVREU",104) 740 746 741 "BLD",78 91,"KRN",9.8,"NM","B","C0CPARMS",29)747 "BLD",7883,"KRN",9.8,"NM","B","C0CPARMS",29) 742 748 743 "BLD",78 91,"KRN",9.8,"NM","B","C0CPROBS",39)749 "BLD",7883,"KRN",9.8,"NM","B","C0CPROBS",39) 744 750 745 "BLD",78 91,"KRN",9.8,"NM","B","C0CPROC",63)751 "BLD",7883,"KRN",9.8,"NM","B","C0CPROC",63) 746 752 747 "BLD",78 91,"KRN",9.8,"NM","B","C0CPXRM",92)753 "BLD",7883,"KRN",9.8,"NM","B","C0CPXRM",92) 748 754 749 "BLD",78 91,"KRN",9.8,"NM","B","C0CQRY1",93)755 "BLD",7883,"KRN",9.8,"NM","B","C0CQRY1",93) 750 756 751 "BLD",78 91,"KRN",9.8,"NM","B","C0CQRY2",94)757 "BLD",7883,"KRN",9.8,"NM","B","C0CQRY2",94) 752 758 753 "BLD",78 91,"KRN",9.8,"NM","B","C0CRAHL7",105)759 "BLD",7883,"KRN",9.8,"NM","B","C0CRAHL7",105) 754 760 755 "BLD",78 91,"KRN",9.8,"NM","B","C0CRARPT",106)761 "BLD",7883,"KRN",9.8,"NM","B","C0CRARPT",106) 756 762 757 "BLD",78 91,"KRN",9.8,"NM","B","C0CRIMA",38)763 "BLD",7883,"KRN",9.8,"NM","B","C0CRIMA",38) 758 764 759 "BLD",78 91,"KRN",9.8,"NM","B","C0CRNF",23)765 "BLD",7883,"KRN",9.8,"NM","B","C0CRNF",23) 760 766 761 "BLD",78 91,"KRN",9.8,"NM","B","C0CRNFRP",95)767 "BLD",7883,"KRN",9.8,"NM","B","C0CRNFRP",95) 762 768 763 "BLD",78 91,"KRN",9.8,"NM","B","C0CRPMS",96)769 "BLD",7883,"KRN",9.8,"NM","B","C0CRPMS",96) 764 770 765 "BLD",78 91,"KRN",9.8,"NM","B","C0CRXN",22)771 "BLD",7883,"KRN",9.8,"NM","B","C0CRXN",22) 766 772 767 "BLD",78 91,"KRN",9.8,"NM","B","C0CRXNRD",97)773 "BLD",7883,"KRN",9.8,"NM","B","C0CRXNRD",97) 768 774 769 "BLD",78 91,"KRN",9.8,"NM","B","C0CSNOA",98)775 "BLD",7883,"KRN",9.8,"NM","B","C0CSNOA",98) 770 776 771 "BLD",78 91,"KRN",9.8,"NM","B","C0CSOAP",69)777 "BLD",7883,"KRN",9.8,"NM","B","C0CSOAP",69) 772 778 773 "BLD",78 91,"KRN",9.8,"NM","B","C0CSQMB",107)779 "BLD",7883,"KRN",9.8,"NM","B","C0CSQMB",107) 774 780 775 "BLD",78 91,"KRN",9.8,"NM","B","C0CSUB1",61)781 "BLD",7883,"KRN",9.8,"NM","B","C0CSUB1",61) 776 782 777 "BLD",78 91,"KRN",9.8,"NM","B","C0CSYS",56)783 "BLD",7883,"KRN",9.8,"NM","B","C0CSYS",56) 778 784 779 "BLD",78 91,"KRN",9.8,"NM","B","C0CTIU",108)785 "BLD",7883,"KRN",9.8,"NM","B","C0CTIU",108) 780 786 781 "BLD",78 91,"KRN",9.8,"NM","B","C0CTIU1",109)787 "BLD",7883,"KRN",9.8,"NM","B","C0CTIU1",109) 782 788 783 "BLD",78 91,"KRN",9.8,"NM","B","C0CUNIT",37)789 "BLD",7883,"KRN",9.8,"NM","B","C0CUNIT",37) 784 790 785 "BLD",78 91,"KRN",9.8,"NM","B","C0CUTIL",54)791 "BLD",7883,"KRN",9.8,"NM","B","C0CUTIL",54) 786 792 787 "BLD",78 91,"KRN",9.8,"NM","B","C0CVA200",55)793 "BLD",7883,"KRN",9.8,"NM","B","C0CVA200",55) 788 794 789 "BLD",78 91,"KRN",9.8,"NM","B","C0CVALID",110)795 "BLD",7883,"KRN",9.8,"NM","B","C0CVALID",110) 790 796 791 "BLD",78 91,"KRN",9.8,"NM","B","C0CVIT2",66)797 "BLD",7883,"KRN",9.8,"NM","B","C0CVIT2",66) 792 798 793 "BLD",78 91,"KRN",9.8,"NM","B","C0CVITAL",36)799 "BLD",7883,"KRN",9.8,"NM","B","C0CVITAL",36) 794 800 795 "BLD",78 91,"KRN",9.8,"NM","B","C0CVOBX1",99)801 "BLD",7883,"KRN",9.8,"NM","B","C0CVOBX1",99) 796 802 797 "BLD",78 91,"KRN",9.8,"NM","B","C0CVORU",100)803 "BLD",7883,"KRN",9.8,"NM","B","C0CVORU",100) 798 804 799 "BLD",78 91,"KRN",9.8,"NM","B","C0CXEWD",101)805 "BLD",7883,"KRN",9.8,"NM","B","C0CXEWD",101) 800 806 801 "BLD",78 91,"KRN",9.8,"NM","B","C0CXPAT0",35)807 "BLD",7883,"KRN",9.8,"NM","B","C0CXPAT0",35) 802 808 803 "BLD",78 91,"KRN",9.8,"NM","B","C0CXPATH",34)809 "BLD",7883,"KRN",9.8,"NM","B","C0CXPATH",34) 804 810 805 "BLD",78 91,"KRN",19,0)811 "BLD",7883,"KRN",19,0) 806 812 19 807 "BLD",78 91,"KRN",19,"NM",0)813 "BLD",7883,"KRN",19,"NM",0) 808 814 ^9.68A^10^10 809 "BLD",78 91,"KRN",19,"NM",1,0)815 "BLD",7883,"KRN",19,"NM",1,0) 810 816 C0C BATCH OPTIONS^^0 811 "BLD",78 91,"KRN",19,"NM",2,0)817 "BLD",7883,"KRN",19,"NM",2,0) 812 818 C0C CCR EXPORT BY PATIENT NAME^^0 813 "BLD",78 91,"KRN",19,"NM",3,0)819 "BLD",7883,"KRN",19,"NM",3,0) 814 820 C0C CCR MENU^^0 815 "BLD",78 91,"KRN",19,"NM",4,0)821 "BLD",7883,"KRN",19,"NM",4,0) 816 822 C0C DISPLAY ELEMENTS^^0 817 "BLD",78 91,"KRN",19,"NM",5,0)823 "BLD",7883,"KRN",19,"NM",5,0) 818 824 C0C DISPLAY PATIENT VARIABLES^^0 819 "BLD",78 91,"KRN",19,"NM",6,0)825 "BLD",7883,"KRN",19,"NM",6,0) 820 826 C0C KILL BATCH JOB^^0 821 "BLD",78 91,"KRN",19,"NM",7,0)827 "BLD",7883,"KRN",19,"NM",7,0) 822 828 C0C LIST RIM CATEGORIES^^0 823 "BLD",78 91,"KRN",19,"NM",8,0)829 "BLD",7883,"KRN",19,"NM",8,0) 824 830 C0C START CCR BATCH PROCESSING^^0 825 "BLD",78 91,"KRN",19,"NM",9,0)831 "BLD",7883,"KRN",19,"NM",9,0) 826 832 C0C STATUS OF CCR BATCH^^0 827 "BLD",78 91,"KRN",19,"NM",10,0)833 "BLD",7883,"KRN",19,"NM",10,0) 828 834 C0C CCR RPC^^0 829 "BLD",78 91,"KRN",19,"NM","B","C0C BATCH OPTIONS",1)835 "BLD",7883,"KRN",19,"NM","B","C0C BATCH OPTIONS",1) 830 836 831 "BLD",78 91,"KRN",19,"NM","B","C0C CCR EXPORT BY PATIENT NAME",2)837 "BLD",7883,"KRN",19,"NM","B","C0C CCR EXPORT BY PATIENT NAME",2) 832 838 833 "BLD",78 91,"KRN",19,"NM","B","C0C CCR MENU",3)839 "BLD",7883,"KRN",19,"NM","B","C0C CCR MENU",3) 834 840 835 "BLD",78 91,"KRN",19,"NM","B","C0C CCR RPC",10)841 "BLD",7883,"KRN",19,"NM","B","C0C CCR RPC",10) 836 842 837 "BLD",78 91,"KRN",19,"NM","B","C0C DISPLAY ELEMENTS",4)843 "BLD",7883,"KRN",19,"NM","B","C0C DISPLAY ELEMENTS",4) 838 844 839 "BLD",78 91,"KRN",19,"NM","B","C0C DISPLAY PATIENT VARIABLES",5)845 "BLD",7883,"KRN",19,"NM","B","C0C DISPLAY PATIENT VARIABLES",5) 840 846 841 "BLD",78 91,"KRN",19,"NM","B","C0C KILL BATCH JOB",6)847 "BLD",7883,"KRN",19,"NM","B","C0C KILL BATCH JOB",6) 842 848 843 "BLD",78 91,"KRN",19,"NM","B","C0C LIST RIM CATEGORIES",7)849 "BLD",7883,"KRN",19,"NM","B","C0C LIST RIM CATEGORIES",7) 844 850 845 "BLD",78 91,"KRN",19,"NM","B","C0C START CCR BATCH PROCESSING",8)851 "BLD",7883,"KRN",19,"NM","B","C0C START CCR BATCH PROCESSING",8) 846 852 847 "BLD",78 91,"KRN",19,"NM","B","C0C STATUS OF CCR BATCH",9)853 "BLD",7883,"KRN",19,"NM","B","C0C STATUS OF CCR BATCH",9) 848 854 849 "BLD",78 91,"KRN",19.1,0)855 "BLD",7883,"KRN",19.1,0) 850 856 19.1 851 "BLD",78 91,"KRN",101,0)857 "BLD",7883,"KRN",101,0) 852 858 101 853 "BLD",78 91,"KRN",409.61,0)859 "BLD",7883,"KRN",409.61,0) 854 860 409.61 855 "BLD",78 91,"KRN",771,0)861 "BLD",7883,"KRN",771,0) 856 862 771 857 "BLD",78 91,"KRN",779.2,0)863 "BLD",7883,"KRN",779.2,0) 858 864 779.2 859 "BLD",78 91,"KRN",870,0)865 "BLD",7883,"KRN",870,0) 860 866 870 861 "BLD",78 91,"KRN",8989.51,0)867 "BLD",7883,"KRN",8989.51,0) 862 868 8989.51 863 "BLD",78 91,"KRN",8989.52,0)869 "BLD",7883,"KRN",8989.52,0) 864 870 8989.52 865 "BLD",78 91,"KRN",8994,0)871 "BLD",7883,"KRN",8994,0) 866 872 8994 867 "BLD",78 91,"KRN",8994,"NM",0)873 "BLD",7883,"KRN",8994,"NM",0) 868 874 ^9.68A^1^1 869 "BLD",78 91,"KRN",8994,"NM",1,0)875 "BLD",7883,"KRN",8994,"NM",1,0) 870 876 C0C CCR RPC^^0 871 "BLD",78 91,"KRN",8994,"NM","B","C0C CCR RPC",1)877 "BLD",7883,"KRN",8994,"NM","B","C0C CCR RPC",1) 872 878 873 "BLD",78 91,"KRN","B",.4,.4)879 "BLD",7883,"KRN","B",.4,.4) 874 880 875 "BLD",78 91,"KRN","B",.401,.401)881 "BLD",7883,"KRN","B",.401,.401) 876 882 877 "BLD",78 91,"KRN","B",.402,.402)883 "BLD",7883,"KRN","B",.402,.402) 878 884 879 "BLD",78 91,"KRN","B",.403,.403)885 "BLD",7883,"KRN","B",.403,.403) 880 886 881 "BLD",78 91,"KRN","B",.5,.5)887 "BLD",7883,"KRN","B",.5,.5) 882 888 883 "BLD",78 91,"KRN","B",.84,.84)889 "BLD",7883,"KRN","B",.84,.84) 884 890 885 "BLD",78 91,"KRN","B",3.6,3.6)891 "BLD",7883,"KRN","B",3.6,3.6) 886 892 887 "BLD",78 91,"KRN","B",3.8,3.8)893 "BLD",7883,"KRN","B",3.8,3.8) 888 894 889 "BLD",78 91,"KRN","B",9.2,9.2)895 "BLD",7883,"KRN","B",9.2,9.2) 890 896 891 "BLD",78 91,"KRN","B",9.8,9.8)897 "BLD",7883,"KRN","B",9.8,9.8) 892 898 893 "BLD",78 91,"KRN","B",19,19)899 "BLD",7883,"KRN","B",19,19) 894 900 895 "BLD",78 91,"KRN","B",19.1,19.1)901 "BLD",7883,"KRN","B",19.1,19.1) 896 902 897 "BLD",78 91,"KRN","B",101,101)903 "BLD",7883,"KRN","B",101,101) 898 904 899 "BLD",78 91,"KRN","B",409.61,409.61)905 "BLD",7883,"KRN","B",409.61,409.61) 900 906 901 "BLD",78 91,"KRN","B",771,771)907 "BLD",7883,"KRN","B",771,771) 902 908 903 "BLD",78 91,"KRN","B",779.2,779.2)909 "BLD",7883,"KRN","B",779.2,779.2) 904 910 905 "BLD",78 91,"KRN","B",870,870)911 "BLD",7883,"KRN","B",870,870) 906 912 907 "BLD",78 91,"KRN","B",8989.51,8989.51)913 "BLD",7883,"KRN","B",8989.51,8989.51) 908 914 909 "BLD",78 91,"KRN","B",8989.52,8989.52)915 "BLD",7883,"KRN","B",8989.52,8989.52) 910 916 911 "BLD",78 91,"KRN","B",8994,8994)917 "BLD",7883,"KRN","B",8994,8994) 912 918 913 "BLD",78 91,"PRE")919 "BLD",7883,"PRE") 914 920 C0CENV 915 "BLD",78 91,"QUES",0)921 "BLD",7883,"QUES",0) 916 922 ^9.62^^ 917 "BLD",78 91,"REQB",0)923 "BLD",7883,"REQB",0) 918 924 ^9.611^2^2 919 "BLD",78 91,"REQB",1,0)925 "BLD",7883,"REQB",1,0) 920 926 NHIN 1.0^2 921 "BLD",78 91,"REQB",2,0)927 "BLD",7883,"REQB",2,0) 922 928 NHIN*1.0*1^2 923 "BLD",78 91,"REQB","B","NHIN 1.0",1)929 "BLD",7883,"REQB","B","NHIN 1.0",1) 924 930 925 "BLD",78 91,"REQB","B","NHIN*1.0*1",2)931 "BLD",7883,"REQB","B","NHIN*1.0*1",2) 926 932 927 933 "DATA",170,1,0) … … 90348 90354 S X=DA(1) 90349 90355 "KEY",178.101,178.101,"A",0) 90350 178.101^A^P^55 890356 178.101^A^P^554 90351 90357 "KEY",178.101,178.101,"A",2,0) 90352 90358 ^.312IA^2^2 … … 90357 90363 "KEYPTR",178.101,178.101,"A") 90358 90364 178.101^C 90359 "KRN",19,109 99,-1)90365 "KRN",19,10988,-1) 90360 90366 0^9 90361 "KRN",19,109 99,0)90367 "KRN",19,10988,0) 90362 90368 C0C STATUS OF CCR BATCH^STATUS OF CCR BATCH^^I^^^^^^^^ 90363 "KRN",19,109 99,30)90369 "KRN",19,10988,30) 90364 90370 C0CB( 90365 "KRN",19,109 99,31)90371 "KRN",19,10988,31) 90366 90372 AEMQ 90367 "KRN",19,109 99,63)90373 "KRN",19,10988,63) 90368 90374 [C 90369 "KRN",19,109 99,80)90375 "KRN",19,10988,80) 90370 90376 C0CB( 90371 "KRN",19,109 99,"U")90377 "KRN",19,10988,"U") 90372 90378 STATUS OF CCR BATCH 90373 "KRN",19,1 1000,-1)90379 "KRN",19,10989,-1) 90374 90380 0^8 90375 "KRN",19,1 1000,0)90381 "KRN",19,10989,0) 90376 90382 C0C START CCR BATCH PROCESSING^BEGIN CCR BATCH PROCESSING^^A^^^^^^^^^^1 90377 "KRN",19,1 1000,20)90383 "KRN",19,10989,20) 90378 90384 D START^C0CBAT 90379 "KRN",19,1 1000,"U")90385 "KRN",19,10989,"U") 90380 90386 BEGIN CCR BATCH PROCESSING 90381 "KRN",19,1 1001,-1)90387 "KRN",19,10990,-1) 90382 90388 0^1 90383 "KRN",19,1 1001,0)90389 "KRN",19,10990,0) 90384 90390 C0C BATCH OPTIONS^BATCH CCR OPTIONS^^M^^^^^^^^ 90385 "KRN",19,1 1001,10,0)90391 "KRN",19,10990,10,0) 90386 90392 ^19.01IP^3^3 90387 "KRN",19,1 1001,10,1,0)90388 1 100090389 "KRN",19,1 1001,10,1,"^")90393 "KRN",19,10990,10,1,0) 90394 10989 90395 "KRN",19,10990,10,1,"^") 90390 90396 C0C START CCR BATCH PROCESSING 90391 "KRN",19,1 1001,10,2,0)90392 109 9990393 "KRN",19,1 1001,10,2,"^")90397 "KRN",19,10990,10,2,0) 90398 10988 90399 "KRN",19,10990,10,2,"^") 90394 90400 C0C STATUS OF CCR BATCH 90395 "KRN",19,1 1001,10,3,0)90396 1 100790397 "KRN",19,1 1001,10,3,"^")90401 "KRN",19,10990,10,3,0) 90402 10996 90403 "KRN",19,10990,10,3,"^") 90398 90404 C0C KILL BATCH JOB 90399 "KRN",19,1 1001,99)90400 62 633,3511390401 "KRN",19,1 1001,"U")90405 "KRN",19,10990,99) 90406 62759,57174 90407 "KRN",19,10990,"U") 90402 90408 BATCH CCR OPTIONS 90403 "KRN",19,1 1002,-1)90409 "KRN",19,10991,-1) 90404 90410 0^3 90405 "KRN",19,1 1002,0)90411 "KRN",19,10991,0) 90406 90412 C0C CCR MENU^CCR MENU^^M^^^^^^^^ 90407 "KRN",19,1 1002,10,0)90413 "KRN",19,10991,10,0) 90408 90414 ^19.01IP^5^5 90409 "KRN",19,1 1002,10,1,0)90410 1 100190411 "KRN",19,1 1002,10,1,"^")90415 "KRN",19,10991,10,1,0) 90416 10990 90417 "KRN",19,10991,10,1,"^") 90412 90418 C0C BATCH OPTIONS 90413 "KRN",19,1 1002,10,2,0)90414 1 100390415 "KRN",19,1 1002,10,2,"^")90419 "KRN",19,10991,10,2,0) 90420 10992 90421 "KRN",19,10991,10,2,"^") 90416 90422 C0C CCR EXPORT BY PATIENT NAME 90417 "KRN",19,1 1002,10,3,0)90418 1 100590419 "KRN",19,1 1002,10,3,"^")90423 "KRN",19,10991,10,3,0) 90424 10994 90425 "KRN",19,10991,10,3,"^") 90420 90426 C0C DISPLAY ELEMENTS 90421 "KRN",19,1 1002,10,4,0)90422 1 100490423 "KRN",19,1 1002,10,4,"^")90427 "KRN",19,10991,10,4,0) 90428 10993 90429 "KRN",19,10991,10,4,"^") 90424 90430 C0C DISPLAY PATIENT VARIABLES 90425 "KRN",19,1 1002,10,5,0)90426 1 100690427 "KRN",19,1 1002,10,5,"^")90431 "KRN",19,10991,10,5,0) 90432 10995 90433 "KRN",19,10991,10,5,"^") 90428 90434 C0C LIST RIM CATEGORIES 90429 "KRN",19,1 1002,99)90430 62 633,3511390431 "KRN",19,1 1002,"U")90435 "KRN",19,10991,99) 90436 62759,57174 90437 "KRN",19,10991,"U") 90432 90438 CCR MENU 90433 "KRN",19,1 1003,-1)90439 "KRN",19,10992,-1) 90434 90440 0^2 90435 "KRN",19,1 1003,0)90441 "KRN",19,10992,0) 90436 90442 C0C CCR EXPORT BY PATIENT NAME^CCR EXPORT BY PATIENT NAME^^A^^^^^^^^^^1 90437 "KRN",19,1 1003,20)90443 "KRN",19,10992,20) 90438 90444 D EXPORT^C0CCCR 90439 "KRN",19,1 1003,"U")90445 "KRN",19,10992,"U") 90440 90446 CCR EXPORT BY PATIENT NAME 90441 "KRN",19,1 1004,-1)90447 "KRN",19,10993,-1) 90442 90448 0^5 90443 "KRN",19,1 1004,0)90449 "KRN",19,10993,0) 90444 90450 C0C DISPLAY PATIENT VARIABLES^VARIABLES DISPLAY^^A^^^^^^^^^^1^1^^ 90445 "KRN",19,1 1004,15)90451 "KRN",19,10993,15) 90446 90452 D DPATV^C0CRIMA($P(Y,U,1)) 90447 "KRN",19,1 1004,20)90453 "KRN",19,10993,20) 90448 90454 S DIC=2,DIC(0)="AEMQ" D ^DIC I Y<1 Q 90449 "KRN",19,1 1004,26)90455 "KRN",19,10993,26) 90450 90456 90451 "KRN",19,1 1004,"U")90457 "KRN",19,10993,"U") 90452 90458 VARIABLES DISPLAY 90453 "KRN",19,1 1005,-1)90459 "KRN",19,10994,-1) 90454 90460 0^4 90455 "KRN",19,1 1005,0)90461 "KRN",19,10994,0) 90456 90462 C0C DISPLAY ELEMENTS^ELEMENT DISPLAY^^I^^^^^^^^^^ 90457 "KRN",19,1 1005,20)90463 "KRN",19,10994,20) 90458 90464 90459 "KRN",19,1 1005,30)90465 "KRN",19,10994,30) 90460 90466 C0CE( 90461 "KRN",19,1 1005,31)90467 "KRN",19,10994,31) 90462 90468 AEMQ 90463 "KRN",19,1 1005,63)90469 "KRN",19,10994,63) 90464 90470 [C 90465 "KRN",19,1 1005,80)90471 "KRN",19,10994,80) 90466 90472 C0CE( 90467 "KRN",19,1 1005,"U")90473 "KRN",19,10994,"U") 90468 90474 ELEMENT DISPLAY 90469 "KRN",19,1 1006,-1)90475 "KRN",19,10995,-1) 90470 90476 0^7 90471 "KRN",19,1 1006,0)90477 "KRN",19,10995,0) 90472 90478 C0C LIST RIM CATEGORIES^LIST RIM CATEGORIES^^A^^^^^^^^^^1 90473 "KRN",19,1 1006,20)90479 "KRN",19,10995,20) 90474 90480 D CLIST^C0CRIMA 90475 "KRN",19,1 1006,"U")90481 "KRN",19,10995,"U") 90476 90482 LIST RIM CATEGORIES 90477 "KRN",19,1 1007,-1)90483 "KRN",19,10996,-1) 90478 90484 0^6 90479 "KRN",19,1 1007,0)90485 "KRN",19,10996,0) 90480 90486 C0C KILL BATCH JOB^KILL CCR BATCH PROCESSING^^A^^^^^^^^^^1 90481 "KRN",19,1 1007,20)90487 "KRN",19,10996,20) 90482 90488 D STOP^C0CBAT 90483 "KRN",19,1 1007,"U")90489 "KRN",19,10996,"U") 90484 90490 KILL CCR BATCH PROCESSING 90485 "KRN",19,1 1008,-1)90491 "KRN",19,10997,-1) 90486 90492 0^10 90487 "KRN",19,1 1008,0)90493 "KRN",19,10997,0) 90488 90494 C0C CCR RPC^CCR RPC^^B^^^^^^^^^y 90489 "KRN",19,1 1008,"RPC",0)90495 "KRN",19,10997,"RPC",0) 90490 90496 ^19.05P^1^1 90491 "KRN",19,1 1008,"RPC",1,0)90497 "KRN",19,10997,"RPC",1,0) 90492 90498 C0C CCR RPC 90493 "KRN",19,1 1008,"U")90499 "KRN",19,10997,"U") 90494 90500 CCR RPC 90495 "KRN",8994,2 518,-1)90501 "KRN",8994,2411,-1) 90496 90502 0^1 90497 "KRN",8994,2 518,0)90503 "KRN",8994,2411,0) 90498 90504 C0C CCR RPC^CCRRPC^C0CCCR^2^P 90499 "KRN",8994,2 518,1,0)90505 "KRN",8994,2411,1,0) 90500 90506 ^8994.01^1^1^3090717^^ 90501 "KRN",8994,2 518,1,1,0)90507 "KRN",8994,2411,1,1,0) 90502 90508 RPC TO RETURN A PATIENT'S CCR 90503 "KRN",8994,2 518,2,0)90509 "KRN",8994,2411,2,0) 90504 90510 ^8994.02A^3^3 90505 "KRN",8994,2 518,2,1,0)90511 "KRN",8994,2411,2,1,0) 90506 90512 DFN^1^30^1^1 90507 "KRN",8994,2 518,2,1,1,0)90513 "KRN",8994,2411,2,1,1,0) 90508 90514 ^^1^1^3090707^ 90509 "KRN",8994,2 518,2,1,1,1,0)90515 "KRN",8994,2411,2,1,1,1,0) 90510 90516 PATIENT RECORD NUMBER 90511 "KRN",8994,2 518,2,2,0)90517 "KRN",8994,2411,2,2,0) 90512 90518 CCRPARMS^1^200^0^2 90513 "KRN",8994,2 518,2,2,1,0)90519 "KRN",8994,2411,2,2,1,0) 90514 90520 ^^1^1^3090707^ 90515 "KRN",8994,2 518,2,2,1,1,0)90521 "KRN",8994,2411,2,2,1,1,0) 90516 90522 PARAMETERS TO OVERRIDE DEFAULTS FOR EXTRACTING THE CCR 90517 "KRN",8994,2 518,2,3,0)90523 "KRN",8994,2411,2,3,0) 90518 90524 CCRPART^1^20^^3 90519 "KRN",8994,2 518,2,"B","CCRPARM",2)90525 "KRN",8994,2411,2,"B","CCRPARM",2) 90520 90526 90521 "KRN",8994,2 518,2,"B","CCRPARMS",2)90527 "KRN",8994,2411,2,"B","CCRPARMS",2) 90522 90528 90523 "KRN",8994,2 518,2,"B","CCRPART",3)90529 "KRN",8994,2411,2,"B","CCRPART",3) 90524 90530 90525 "KRN",8994,2 518,2,"B","DFN",1)90531 "KRN",8994,2411,2,"B","DFN",1) 90526 90532 90527 "KRN",8994,2 518,2,"PARAMSEQ",1,1)90533 "KRN",8994,2411,2,"PARAMSEQ",1,1) 90528 90534 90529 "KRN",8994,2 518,2,"PARAMSEQ",2,2)90535 "KRN",8994,2411,2,"PARAMSEQ",2,2) 90530 90536 90531 "KRN",8994,2 518,2,"PARAMSEQ",3,3)90537 "KRN",8994,2411,2,"PARAMSEQ",3,3) 90532 90538 90533 90539 "MBREQ") … … 90541 90547 "ORD",18,19,0) 90542 90548 OPTION 90543 "PKG",21 3,-1)90549 "PKG",210,-1) 90544 90550 1^1 90545 "PKG",21 3,0)90551 "PKG",210,0) 90546 90552 CCD/CCR GENERATION UTILITIES^C0C^Utilities for the Generation of the CCD/C32/CCR 90547 "PKG",21 3,20,0)90553 "PKG",210,20,0) 90548 90554 ^9.402P^^ 90549 "PKG",21 3,22,0)90555 "PKG",210,22,0) 90550 90556 ^9.49I^1^1 90551 "PKG",213,22,1,0) 90552 1.2^3120625^3120625^8 90553 "PKG",213,22,1,1,0) 90554 ^^185^185^3120625 90555 "PKG",213,22,1,1,1,0) 90557 "PKG",210,22,1,0) 90558 1.2^3121030^3121029^8 90559 "PKG",210,22,1,1,0) 90560 ^^188^188^3121030 90561 "PKG",210,22,1,1,1,0) 90562 Licensed under AGPL v3. For complete license text, see 90563 "PKG",210,22,1,1,2,0) 90564 http://www.gnu.org/licenses/agpl-3.0.html 90565 "PKG",210,22,1,1,3,0) 90566 90567 "PKG",210,22,1,1,4,0) 90556 90568 CCR Project release v1.2 90557 "PKG",21 3,22,1,1,2,0)90569 "PKG",210,22,1,1,5,0) 90558 90570 90559 "PKG",21 3,22,1,1,3,0)90571 "PKG",210,22,1,1,6,0) 90560 90572 The purpose of the CCR package is to provide support for exporting and 90561 "PKG",21 3,22,1,1,4,0)90573 "PKG",210,22,1,1,7,0) 90562 90574 eventually importing patient information from/to VistA in XML documents 90563 "PKG",21 3,22,1,1,5,0)90575 "PKG",210,22,1,1,8,0) 90564 90576 conforming to the Continuity of Care Record (CCR - ASTM) and Continuity 90565 "PKG",21 3,22,1,1,6,0)90577 "PKG",210,22,1,1,9,0) 90566 90578 of Care Document (CCD - HL7) standards. 90567 "PKG",21 3,22,1,1,7,0)90579 "PKG",210,22,1,1,10,0) 90568 90580 90569 "PKG",21 3,22,1,1,8,0)90581 "PKG",210,22,1,1,11,0) 90570 90582 This version of the CCR package provides: 90571 "PKG",21 3,22,1,1,9,0)90583 "PKG",210,22,1,1,12,0) 90572 90584 90573 "PKG",21 3,22,1,1,10,0)90585 "PKG",210,22,1,1,13,0) 90574 90586 EXPORT^C0CCCR 90575 "PKG",21 3,22,1,1,11,0)90587 "PKG",210,22,1,1,14,0) 90576 90588 A command line interface to export a single patient's CCR to a host 90577 "PKG",21 3,22,1,1,12,0)90589 "PKG",210,22,1,1,15,0) 90578 90590 directory by specifying the patient by name. 90579 "PKG",21 3,22,1,1,13,0)90591 "PKG",210,22,1,1,16,0) 90580 90592 90581 "PKG",21 3,22,1,1,14,0)90593 "PKG",210,22,1,1,17,0) 90582 90594 EXPORT^C0CCCD 90583 "PKG",21 3,22,1,1,15,0)90595 "PKG",210,22,1,1,18,0) 90584 90596 A command line interface to export a single patient's CCD to a host 90585 "PKG",21 3,22,1,1,16,0)90597 "PKG",210,22,1,1,19,0) 90586 90598 directory by specifying the patient by name. As an alternative to 90587 "PKG",21 3,22,1,1,17,0)90599 "PKG",210,22,1,1,20,0) 90588 90600 generating the CCD directly, an XSLT transformation is available to 90589 "PKG",21 3,22,1,1,18,0)90601 "PKG",210,22,1,1,21,0) 90590 90602 translate a CCR into a level 2 CCD. This tranformation has been tested 90591 "PKG",21 3,22,1,1,19,0)90603 "PKG",210,22,1,1,22,0) 90592 90604 and produces a CCD with all currently supported sections of the CCR. The 90593 "PKG",21 3,22,1,1,20,0)90605 "PKG",210,22,1,1,23,0) 90594 90606 EXPORT^C0CCCD only extracts the PROBLEMS section into a CCD. 90595 "PKG",21 3,22,1,1,21,0)90607 "PKG",210,22,1,1,24,0) 90596 90608 90597 "PKG",21 3,22,1,1,22,0)90609 "PKG",210,22,1,1,25,0) 90598 90610 XPAT^C0CCCR(DFN,OUTDIR,OUTFILE) 90599 "PKG",21 3,22,1,1,23,0)90611 "PKG",210,22,1,1,26,0) 90600 90612 A command line and program interface to export a single patient's CCR 90601 "PKG",21 3,22,1,1,24,0)90613 "PKG",210,22,1,1,27,0) 90602 90614 using the IEN of the patient in the ^DPT file (DFN). 90603 "PKG",21 3,22,1,1,25,0)90615 "PKG",210,22,1,1,28,0) 90604 90616 OUTDIR specifies an existing directory on the Host system into which the 90605 "PKG",21 3,22,1,1,26,0)90617 "PKG",210,22,1,1,29,0) 90606 90618 CCR XML document will be written. If OUTDIR is null (""), the output 90607 "PKG",21 3,22,1,1,27,0)90619 "PKG",210,22,1,1,30,0) 90608 90620 directory name will be taken from ^TMP("C0CCCR","ODIR"). 90609 "PKG",21 3,22,1,1,28,0)90621 "PKG",210,22,1,1,31,0) 90610 90622 OUFILE specifies the host file name of the CCR XML document that will be 90611 "PKG",21 3,22,1,1,29,0)90623 "PKG",210,22,1,1,32,0) 90612 90624 written for this patient. If OUTFILE is null ("") the document name will 90613 "PKG",21 3,22,1,1,30,0)90625 "PKG",210,22,1,1,33,0) 90614 90626 default to PAT_x_CCR_V1.xml where x is the DFN of the patient. 90615 "PKG",21 3,22,1,1,31,0)90627 "PKG",210,22,1,1,34,0) 90616 90628 90617 "PKG",21 3,22,1,1,32,0)90629 "PKG",210,22,1,1,35,0) 90618 90630 CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART) 90619 "PKG",21 3,22,1,1,33,0)90631 "PKG",210,22,1,1,36,0) 90620 90632 An RPC and program interface to return in return array CCRGRTN (passed by 90621 "PKG",21 3,22,1,1,34,0)90633 "PKG",210,22,1,1,37,0) 90622 90634 reference) a single patient's CCR. 90623 "PKG",21 3,22,1,1,35,0)90635 "PKG",210,22,1,1,38,0) 90624 90636 DFN is the patient's IEN 90625 "PKG",21 3,22,1,1,36,0)90637 "PKG",210,22,1,1,39,0) 90626 90638 CCRPART is what portion of the CCR should be returned. If "CCR" is 90627 "PKG",21 3,22,1,1,37,0)90639 "PKG",210,22,1,1,40,0) 90628 90640 specified, the entire CCR will be returned. If "PROBLEMS", "VITALS", or 90629 "PKG",21 3,22,1,1,38,0)90641 "PKG",210,22,1,1,41,0) 90630 90642 "MEDICATIONS" is specified, only that section of the CCR will be returned. 90631 "PKG",21 3,22,1,1,39,0)90643 "PKG",210,22,1,1,42,0) 90632 90644 CCRPARMS ARE PARAMETERS THAT AFFECT THE EXTRACTION 90633 "PKG",21 3,22,1,1,40,0)90645 "PKG",210,22,1,1,43,0) 90634 90646 IN THE FORM "PARM1:VALUE1^PARM2:VALUE2" 90635 "PKG",21 3,22,1,1,41,0)90647 "PKG",210,22,1,1,44,0) 90636 90648 EXAMPLE: "LABLIMIT:T-60" TO LIMIT LAB EXTRACTION TO THE LAST 60 DAYS 90637 "PKG",21 3,22,1,1,42,0)90649 "PKG",210,22,1,1,45,0) 90638 90650 SEE C0CPARMS FOR A COMPLETE LIST OF SUPPORTED PARAMETERS 90639 "PKG",21 3,22,1,1,43,0)90651 "PKG",210,22,1,1,46,0) 90640 90652 90641 "PKG",21 3,22,1,1,44,0)90653 "PKG",210,22,1,1,47,0) 90642 90654 ANALYZE^C0CRIMA(BGNDFN,DFNCNT,CCRPARMS) 90643 "PKG",21 3,22,1,1,45,0)90655 "PKG",210,22,1,1,48,0) 90644 90656 A command line and program interface to analyze the data from multiple 90645 "PKG",21 3,22,1,1,46,0)90657 "PKG",210,22,1,1,49,0) 90646 90658 patients into categories that can be batch extracted. 90647 "PKG",21 3,22,1,1,47,0)90659 "PKG",210,22,1,1,50,0) 90648 90660 BGNDFN is the beginning DFN to be analyzed. If BGNDFN is null ("") its 90649 "PKG",21 3,22,1,1,48,0)90661 "PKG",210,22,1,1,51,0) 90650 90662 value will be taken from ^TMP("C0CRIM","RESUME"). If this variable does 90651 "PKG",21 3,22,1,1,49,0)90663 "PKG",210,22,1,1,52,0) 90652 90664 not exist, the routine will start with the first IEN in the patient file 90653 "PKG",21 3,22,1,1,50,0)90665 "PKG",210,22,1,1,53,0) 90654 90666 ^DPT. ^TMP("C0CRIM","RESUME") is updated to the "next" patient to be 90655 "PKG",21 3,22,1,1,51,0)90667 "PKG",210,22,1,1,54,0) 90656 90668 analyzed on successful completion. 90657 "PKG",21 3,22,1,1,52,0)90669 "PKG",210,22,1,1,55,0) 90658 90670 DFNCNT is the count of how many patient records will be analyzed in this 90659 "PKG",21 3,22,1,1,53,0)90671 "PKG",210,22,1,1,56,0) 90660 90672 execution. 90661 "PKG",21 3,22,1,1,54,0)90673 "PKG",210,22,1,1,57,0) 90662 90674 For example ANALYZE^C0CRIMA(1000,1000) would start at patient DFN 1000 90663 "PKG",21 3,22,1,1,55,0)90675 "PKG",210,22,1,1,58,0) 90664 90676 and analyzes 1000 patient records. ANALYZE^C0CRIMA("",1000) would then 90665 "PKG",21 3,22,1,1,56,0)90677 "PKG",210,22,1,1,59,0) 90666 90678 analyze the next 1000 patients. When the end of the patient file is 90667 "PKG",21 3,22,1,1,57,0)90679 "PKG",210,22,1,1,60,0) 90668 90680 reached, the routine terminates with a message that RESET^C0CRIMA would 90669 "PKG",21 3,22,1,1,58,0)90681 "PKG",210,22,1,1,61,0) 90670 90682 need to be called to restart the analysis. 90671 "PKG",21 3,22,1,1,59,0)90683 "PKG",210,22,1,1,62,0) 90672 90684 90673 "PKG",21 3,22,1,1,60,0)90685 "PKG",210,22,1,1,63,0) 90674 90686 The categories into which the records are analyzed consist of attribute 90675 "PKG",21 3,22,1,1,61,0)90687 "PKG",210,22,1,1,64,0) 90676 90688 strings. The attributes represent characteristics of the variables that 90677 "PKG",21 3,22,1,1,62,0)90689 "PKG",210,22,1,1,65,0) 90678 90690 can be extracted for a given patient into the CCR or the CCD. This 90679 "PKG",21 3,22,1,1,63,0)90691 "PKG",210,22,1,1,66,0) 90680 90692 version supports the following attributes: 90681 "PKG",21 3,22,1,1,64,0)90693 "PKG",210,22,1,1,67,0) 90682 90694 VITALS : the patient has variables for the VITALS section of the CCR/CCD 90683 "PKG",21 3,22,1,1,65,0)90695 "PKG",210,22,1,1,68,0) 90684 90696 PROBLEMS : the patient has variables for the PROBLEMS section of the 90685 "PKG",21 3,22,1,1,66,0)90697 "PKG",210,22,1,1,69,0) 90686 90698 CCR/CCD 90687 "PKG",21 3,22,1,1,67,0)90699 "PKG",210,22,1,1,70,0) 90688 90700 MEDS : the patient has variables for the MEDICATIONS section of the 90689 "PKG",21 3,22,1,1,68,0)90701 "PKG",210,22,1,1,71,0) 90690 90702 CCR/CCD 90691 "PKG",21 3,22,1,1,69,0)90703 "PKG",210,22,1,1,72,0) 90692 90704 HEADER : the patient has variables for the HEADER section of the CCR/CCD. 90693 "PKG",21 3,22,1,1,70,0)90705 "PKG",210,22,1,1,73,0) 90694 90706 All patients are marked with the HEADER attribute in this version. 90695 "PKG",21 3,22,1,1,71,0)90707 "PKG",210,22,1,1,74,0) 90696 90708 NOTEXTRACTED : the CCR or CCD has not yet been produced/extracted for 90697 "PKG",21 3,22,1,1,72,0)90709 "PKG",210,22,1,1,75,0) 90698 90710 this patient. All patient records are marked with the NOTEXTRACTED 90699 "PKG",21 3,22,1,1,73,0)90711 "PKG",210,22,1,1,76,0) 90700 90712 attribute in this version for batch control processing (not implemented 90701 "PKG",21 3,22,1,1,74,0)90713 "PKG",210,22,1,1,77,0) 90702 90714 in this version). 90703 "PKG",21 3,22,1,1,75,0)90715 "PKG",210,22,1,1,78,0) 90704 90716 90705 "PKG",21 3,22,1,1,76,0)90717 "PKG",210,22,1,1,79,0) 90706 90718 ANAZYZE^C0CRIMA calls the variable extraction routines that would be used 90707 "PKG",21 3,22,1,1,77,0)90719 "PKG",210,22,1,1,80,0) 90708 90720 to produce a CCR or a CCD and saves the results to ^TMP("C0CRIM",DFN) for 90709 "PKG",21 3,22,1,1,78,0)90721 "PKG",210,22,1,1,81,0) 90710 90722 each patient. In addition, the attribute string for each patient is saved 90711 "PKG",21 3,22,1,1,79,0)90723 "PKG",210,22,1,1,82,0) 90712 90724 in ^TMP("C0CRIM","ATTR") 90713 "PKG",21 3,22,1,1,80,0)90725 "PKG",210,22,1,1,83,0) 90714 90726 90715 "PKG",21 3,22,1,1,81,0)90727 "PKG",210,22,1,1,84,0) 90716 90728 Categories are created as they first occur based on each unique 90717 "PKG",21 3,22,1,1,82,0)90729 "PKG",210,22,1,1,85,0) 90718 90730 combination of attributes that is encountered. They are named after the 90719 "PKG",21 3,22,1,1,83,0)90731 "PKG",210,22,1,1,86,0) 90720 90732 attribute table that is used for the analysis. This version supports only 90721 "PKG",21 3,22,1,1,84,0)90733 "PKG",210,22,1,1,87,0) 90722 90734 the attribute table .RIMTBL. and the categories are named "RIMTBL_x". An 90723 "PKG",21 3,22,1,1,85,0)90735 "PKG",210,22,1,1,88,0) 90724 90736 example set of categories from a demo systems is: 90725 "PKG",21 3,22,1,1,86,0)90737 "PKG",210,22,1,1,89,0) 90726 90738 90727 "PKG",21 3,22,1,1,87,0)90739 "PKG",210,22,1,1,90,0) 90728 90740 GTM>D CLIST^C0CRIMA 90729 "PKG",21 3,22,1,1,88,0)90741 "PKG",210,22,1,1,91,0) 90730 90742 (RIMTBL_1:105) ^NOTEXTRACTED^HEADER^^^PROBLEMS^^^^^VITALS^^^^^MEDS 90731 "PKG",21 3,22,1,1,89,0)90743 "PKG",210,22,1,1,92,0) 90732 90744 (RIMTBL_2:596) ^NOTEXTRACTED^HEADER^^^^^^^^VITALS 90733 "PKG",21 3,22,1,1,90,0)90745 "PKG",210,22,1,1,93,0) 90734 90746 (RIMTBL_3:44) ^NOTEXTRACTED^HEADER^^^PROBLEMS^^^^^VITALS 90735 "PKG",21 3,22,1,1,91,0)90747 "PKG",210,22,1,1,94,0) 90736 90748 (RIMTBL_4:821) ^NOTEXTRACTED^HEADER 90737 "PKG",21 3,22,1,1,92,0)90749 "PKG",210,22,1,1,95,0) 90738 90750 (RIMTBL_5:18) ^NOTEXTRACTED^HEADER^^^^^^^^VITALS^^^^^MEDS 90739 "PKG",21 3,22,1,1,93,0)90751 "PKG",210,22,1,1,96,0) 90740 90752 (RIMTBL_6:14) ^NOTEXTRACTED^HEADER^^^PROBLEMS 90741 "PKG",21 3,22,1,1,94,0)90753 "PKG",210,22,1,1,97,0) 90742 90754 (RIMTBL_7:15) ^NOTEXTRACTED^HEADER^^^^^^^^^^^^^MEDS 90743 "PKG",21 3,22,1,1,95,0)90755 "PKG",210,22,1,1,98,0) 90744 90756 (RIMTBL_8:5) ^NOTEXTRACTED^HEADER^^^PROBLEMS^^^^^^^^^^MEDS 90745 "PKG",21 3,22,1,1,96,0)90757 "PKG",210,22,1,1,99,0) 90746 90758 90747 "PKG",21 3,22,1,1,97,0)90759 "PKG",210,22,1,1,100,0) 90748 90760 for RIMTBL_1 in this example, 105 is the record count of patients who 90749 "PKG",21 3,22,1,1,98,0)90761 "PKG",210,22,1,1,101,0) 90750 90762 have this combination of attributes. The list of patients for each 90751 "PKG",21 3,22,1,1,99,0)90763 "PKG",210,22,1,1,102,0) 90752 90764 category is also maintained for batch extraction. 90753 "PKG",21 3,22,1,1,100,0)90765 "PKG",210,22,1,1,103,0) 90754 90766 90755 "PKG",21 3,22,1,1,101,0)90767 "PKG",210,22,1,1,104,0) 90756 90768 CLIST^C0CRIMA 90757 "PKG",21 3,22,1,1,102,0)90769 "PKG",210,22,1,1,105,0) 90758 90770 A command line interface to show a summary of the categories, record 90759 "PKG",21 3,22,1,1,103,0)90771 "PKG",210,22,1,1,106,0) 90760 90772 counts, and attributes that have been analyzed so far. It produces the 90761 "PKG",21 3,22,1,1,104,0)90773 "PKG",210,22,1,1,107,0) 90762 90774 listing in the example above from information stored in 90763 "PKG",21 3,22,1,1,105,0)90775 "PKG",210,22,1,1,108,0) 90764 90776 ^TMP("C0CRIM","CATS","RIMTBL"). It is intended for future versions that 90765 "PKG",21 3,22,1,1,106,0)90777 "PKG",210,22,1,1,109,0) 90766 90778 attribute tables be supported in addition to the default "RIMTBL". 90767 "PKG",21 3,22,1,1,107,0)90779 "PKG",210,22,1,1,110,0) 90768 90780 90769 "PKG",21 3,22,1,1,108,0)90781 "PKG",210,22,1,1,111,0) 90770 90782 CPAT^C0CRIMA(CPATCAT) 90771 "PKG",21 3,22,1,1,109,0)90783 "PKG",210,22,1,1,112,0) 90772 90784 A command line interface which shows the DFN numbers of the patients 90773 "PKG",21 3,22,1,1,110,0)90785 "PKG",210,22,1,1,113,0) 90774 90786 represented by the category CPATCAT. DFNs are listed 10 per line. For 90775 "PKG",21 3,22,1,1,111,0)90787 "PKG",210,22,1,1,114,0) 90776 90788 example: 90777 "PKG",21 3,22,1,1,112,0)90789 "PKG",210,22,1,1,115,0) 90778 90790 90779 "PKG",21 3,22,1,1,113,0)90791 "PKG",210,22,1,1,116,0) 90780 90792 GTM>D CPAT^C0CRIMA("RIMTBL_1") 90781 "PKG",21 3,22,1,1,114,0)90793 "PKG",210,22,1,1,117,0) 90782 90794 1 3 8 25 42 69 123 140 146 149 90783 "PKG",21 3,22,1,1,115,0)90795 "PKG",210,22,1,1,118,0) 90784 90796 151 168 204 205 217 218 224 228 229 231 90785 "PKG",21 3,22,1,1,116,0)90797 "PKG",210,22,1,1,119,0) 90786 90798 236 237 240 253 260 267 271 301 347 350 90787 "PKG",21 3,22,1,1,117,0)90799 "PKG",210,22,1,1,120,0) 90788 90800 366 379 384 391 407 418 419 420 428 433 90789 "PKG",21 3,22,1,1,118,0)90801 "PKG",210,22,1,1,121,0) 90790 90802 442 520 569 600 620 692 706 715 722 723 90791 "PKG",21 3,22,1,1,119,0)90803 "PKG",210,22,1,1,122,0) 90792 90804 724 728 730 744 745 746 747 748 749 750 90793 "PKG",21 3,22,1,1,120,0)90805 "PKG",210,22,1,1,123,0) 90794 90806 751 752 753 754 755 756 757 758 759 760 90795 "PKG",21 3,22,1,1,121,0)90807 "PKG",210,22,1,1,124,0) 90796 90808 761 762 763 764 765 766 767 768 769 770 90797 "PKG",21 3,22,1,1,122,0)90809 "PKG",210,22,1,1,125,0) 90798 90810 771 772 773 774 775 776 777 778 779 780 90799 "PKG",21 3,22,1,1,123,0)90811 "PKG",210,22,1,1,126,0) 90800 90812 100000 100001 100002 100003 100004 100005 100006 100007 100008 100009 90801 "PKG",21 3,22,1,1,124,0)90813 "PKG",210,22,1,1,127,0) 90802 90814 100010 100011 100012 100013 100014 90803 "PKG",21 3,22,1,1,125,0)90815 "PKG",210,22,1,1,128,0) 90804 90816 90805 "PKG",21 3,22,1,1,126,0)90817 "PKG",210,22,1,1,129,0) 90806 90818 These are the 105 patient records included in category "RIMTBL_1" from 90807 "PKG",21 3,22,1,1,127,0)90819 "PKG",210,22,1,1,130,0) 90808 90820 the above example. 90809 "PKG",21 3,22,1,1,128,0)90821 "PKG",210,22,1,1,131,0) 90810 90822 90811 "PKG",21 3,22,1,1,129,0)90823 "PKG",210,22,1,1,132,0) 90812 90824 DPATV^C0CRIMA(DFN,"SECTION") 90813 "PKG",21 3,22,1,1,130,0)90825 "PKG",210,22,1,1,133,0) 90814 90826 A command line interface to display the values of variables for a 90815 "PKG",21 3,22,1,1,131,0)90827 "PKG",210,22,1,1,134,0) 90816 90828 patient. "SECTION" can be any of the CCR sections. ie 90817 "PKG",21 3,22,1,1,132,0)90829 "PKG",210,22,1,1,135,0) 90818 90830 "ALERTS","RESULTS","MEDS". If SECTION is ommitted, all sections will be 90819 "PKG",21 3,22,1,1,133,0)90831 "PKG",210,22,1,1,136,0) 90820 90832 shown. An example: 90821 "PKG",21 3,22,1,1,134,0)90833 "PKG",210,22,1,1,137,0) 90822 90834 90823 "PKG",21 3,22,1,1,135,0)90835 "PKG",210,22,1,1,138,0) 90824 90836 GTM>D DPATV^C0CRIMA(2,"PROBLEMS") 90825 "PKG",21 3,22,1,1,136,0)90837 "PKG",210,22,1,1,139,0) 90826 90838 1 1^PROBLEMCODEVALUE^V18.0 90827 "PKG",21 3,22,1,1,137,0)90839 "PKG",210,22,1,1,140,0) 90828 90840 2 1^PROBLEMCODINGVERSION^ 90829 "PKG",21 3,22,1,1,138,0)90841 "PKG",210,22,1,1,141,0) 90830 90842 3 1^PROBLEMCONDITION^P 90831 "PKG",21 3,22,1,1,139,0)90843 "PKG",210,22,1,1,142,0) 90832 90844 4 1^PROBLEMDATEMOD^2005-07-19T00:00:00-05:00 90833 "PKG",21 3,22,1,1,140,0)90845 "PKG",210,22,1,1,143,0) 90834 90846 5 1^PROBLEMDATEOFONSET^1700--T00:00:00-05:00 90835 "PKG",21 3,22,1,1,141,0)90847 "PKG",210,22,1,1,144,0) 90836 90848 6 1^PROBLEMDESCRIPTION^Family History of Diabetes Mellitus (ICD-9-CM 90837 "PKG",21 3,22,1,1,142,0)90849 "PKG",210,22,1,1,145,0) 90838 90850 V18.0) 90839 "PKG",21 3,22,1,1,143,0)90851 "PKG",210,22,1,1,146,0) 90840 90852 7 1^PROBLEMDTREC^1701--T00:00:00-05:00 90841 "PKG",21 3,22,1,1,144,0)90853 "PKG",210,22,1,1,147,0) 90842 90854 8 1^PROBLEMHASCMT^ 90843 "PKG",21 3,22,1,1,145,0)90855 "PKG",210,22,1,1,148,0) 90844 90856 9 1^PROBLEMIEN^8 90845 "PKG",21 3,22,1,1,146,0)90857 "PKG",210,22,1,1,149,0) 90846 90858 10 1^PROBLEMINACT^1700--T00:00:00-05:00 90847 "PKG",21 3,22,1,1,147,0)90859 "PKG",210,22,1,1,150,0) 90848 90860 90849 "PKG",21 3,22,1,1,148,0)90861 "PKG",210,22,1,1,151,0) 90850 90862 DCCR^C0CCCR(DFN) 90851 "PKG",21 3,22,1,1,149,0)90863 "PKG",210,22,1,1,152,0) 90852 90864 This will display the XML of a CCR that has been generated for a patient. 90853 "PKG",21 3,22,1,1,150,0)90865 "PKG",210,22,1,1,153,0) 90854 90866 It is run after generating the CCR with XPAT^C0CCCR or XCPAT^C0CRIMA. 90855 "PKG",21 3,22,1,1,151,0)90867 "PKG",210,22,1,1,154,0) 90856 90868 90857 "PKG",21 3,22,1,1,152,0)90869 "PKG",210,22,1,1,155,0) 90858 90870 XCPAT^C0CRIMA(CPATCAT) 90859 "PKG",21 3,22,1,1,153,0)90871 "PKG",210,22,1,1,156,0) 90860 90872 A command line interface to extract a batch of patient CCR documents that 90861 "PKG",21 3,22,1,1,154,0)90873 "PKG",210,22,1,1,157,0) 90862 90874 are associated with the category CPATCAT. For example, 90863 "PKG",21 3,22,1,1,155,0)90875 "PKG",210,22,1,1,158,0) 90864 90876 90865 "PKG",21 3,22,1,1,156,0)90877 "PKG",210,22,1,1,159,0) 90866 90878 XCPAT^C0CRIMA("RIMTBL_1") to extract the CCR documents for the 105 90867 "PKG",21 3,22,1,1,157,0)90879 "PKG",210,22,1,1,160,0) 90868 90880 patients in the above example. 90869 "PKG",21 3,22,1,1,158,0)90881 "PKG",210,22,1,1,161,0) 90870 90882 90871 "PKG",21 3,22,1,1,159,0)90883 "PKG",210,22,1,1,162,0) 90872 90884 RESET^C0CRIMA 90873 "PKG",21 3,22,1,1,160,0)90885 "PKG",210,22,1,1,163,0) 90874 90886 A command line interface to kill all ANALYZE^C0CRIMA results stored so 90875 "PKG",21 3,22,1,1,161,0)90887 "PKG",210,22,1,1,164,0) 90876 90888 far so that the analysis can be done again. It kills 90877 "PKG",21 3,22,1,1,162,0)90889 "PKG",210,22,1,1,165,0) 90878 90890 ^TMP("C0CRIM","RESUME") and all extraction variables that have been saved 90879 "PKG",21 3,22,1,1,163,0)90891 "PKG",210,22,1,1,166,0) 90880 90892 in ^TMP("C0CRIM") 90881 "PKG",21 3,22,1,1,164,0)90893 "PKG",210,22,1,1,167,0) 90882 90894 90883 "PKG",21 3,22,1,1,165,0)90895 "PKG",210,22,1,1,168,0) 90884 90896 NOTES: 90885 "PKG",21 3,22,1,1,166,0)90897 "PKG",210,22,1,1,169,0) 90886 90898 This version of the package is a prototype, and does not yet make use of 90887 "PKG",21 3,22,1,1,167,0)90899 "PKG",210,22,1,1,170,0) 90888 90900 the standard VistA features that are appropriate for it to use. 90889 "PKG",21 3,22,1,1,168,0)90901 "PKG",210,22,1,1,171,0) 90890 90902 90891 "PKG",21 3,22,1,1,169,0)90903 "PKG",210,22,1,1,172,0) 90892 90904 ^TMP("C0CCCR","ODIR") must be set manually to the output directory on the 90893 "PKG",21 3,22,1,1,170,0)90905 "PKG",210,22,1,1,173,0) 90894 90906 Host System. It is intended that this be maintainable in a parameter file. 90895 "PKG",21 3,22,1,1,171,0)90907 "PKG",210,22,1,1,174,0) 90896 90908 90897 "PKG",21 3,22,1,1,172,0)90909 "PKG",210,22,1,1,175,0) 90898 90910 CCRRPC^C0CCCR and CCDRPC^C0CCCD are intended to be RPC interfaces to the 90899 "PKG",21 3,22,1,1,173,0)90911 "PKG",210,22,1,1,176,0) 90900 90912 package but there is no entry for them in the RPC table and the RPC 90901 "PKG",21 3,22,1,1,174,0)90913 "PKG",210,22,1,1,177,0) 90902 90914 method of access has not been tested. 90903 "PKG",21 3,22,1,1,175,0)90915 "PKG",210,22,1,1,178,0) 90904 90916 90905 "PKG",21 3,22,1,1,176,0)90917 "PKG",210,22,1,1,179,0) 90906 90918 Most of the command line interface functions in the package are intended 90907 "PKG",21 3,22,1,1,177,0)90919 "PKG",210,22,1,1,180,0) 90908 90920 to also be made available as RPC calls. This will provide the ability to 90909 "PKG",21 3,22,1,1,178,0)90921 "PKG",210,22,1,1,181,0) 90910 90922 invoke and control batch extraction and analysis via RPCs 90911 "PKG",21 3,22,1,1,179,0)90923 "PKG",210,22,1,1,182,0) 90912 90924 90913 "PKG",21 3,22,1,1,180,0)90925 "PKG",210,22,1,1,183,0) 90914 90926 The "RIM" variables and attributes that are now being stored in 90915 "PKG",21 3,22,1,1,181,0)90927 "PKG",210,22,1,1,184,0) 90916 90928 ^TMP("C0CRIM") are intended to be maintained in a standard FILEMAN 90917 "PKG",21 3,22,1,1,182,0)90929 "PKG",210,22,1,1,185,0) 90918 90930 global, and to take advantage of FILEMAN indexing for efficient batch 90919 "PKG",21 3,22,1,1,183,0)90931 "PKG",210,22,1,1,186,0) 90920 90932 analysis and processing. 90921 "PKG",21 3,22,1,1,184,0)90933 "PKG",210,22,1,1,187,0) 90922 90934 90923 "PKG",21 3,22,1,1,185,0)90935 "PKG",210,22,1,1,188,0) 90924 90936 It is intended that menu interfaces be provided in addition to command 90925 "PKG",21 3,"VERSION")90937 "PKG",210,"VERSION") 90926 90938 1.2 90927 90939 "PRE") … … 91000 91012 79 91001 91013 "RTN","C0CACTOR") 91002 0^47^B9 973374291014 0^47^B98169360 91003 91015 "RTN","C0CACTOR",1,0) 91004 C0CACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08 91016 C0CACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08 ; 10/29/12 4:04pm 91005 91017 "RTN","C0CACTOR",2,0) 91006 ;;1.2;C 0C;;May 11, 2012;Build 5091018 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 91007 91019 "RTN","C0CACTOR",3,0) 91008 91020 ;Copyright 2008,2009 George Lilly, University of Minnesota. 91009 91021 "RTN","C0CACTOR",4,0) 91010 ; Licensed under the terms of the GNU General Public License.91022 ; 91011 91023 "RTN","C0CACTOR",5,0) 91012 ; See attached copy of the License.91024 ; This program is free software: you can redistribute it and/or modify 91013 91025 "RTN","C0CACTOR",6,0) 91014 ; 91026 ; it under the terms of the GNU Affero General Public License as 91015 91027 "RTN","C0CACTOR",7,0) 91016 ; This program is free software; you can redistribute it and/or modify91028 ; published by the Free Software Foundation, either version 3 of the 91017 91029 "RTN","C0CACTOR",8,0) 91018 ; it under the terms of the GNU General Public License as published by91030 ; License, or (at your option) any later version. 91019 91031 "RTN","C0CACTOR",9,0) 91020 ; the Free Software Foundation; either version 2 of the License, or91032 ; 91021 91033 "RTN","C0CACTOR",10,0) 91022 ; (at your option) any later version.91034 ; This program is distributed in the hope that it will be useful, 91023 91035 "RTN","C0CACTOR",11,0) 91024 ; 91036 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 91025 91037 "RTN","C0CACTOR",12,0) 91026 ; This program is distributed in the hope that it will be useful,91038 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 91027 91039 "RTN","C0CACTOR",13,0) 91028 ; but WITHOUT ANY WARRANTY; without even the implied warranty of91040 ; GNU Affero General Public License for more details. 91029 91041 "RTN","C0CACTOR",14,0) 91030 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the91042 ; 91031 91043 "RTN","C0CACTOR",15,0) 91032 ; GNU General Public License for more details.91044 ; You should have received a copy of the GNU Affero General Public License 91033 91045 "RTN","C0CACTOR",16,0) 91034 ; 91046 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 91035 91047 "RTN","C0CACTOR",17,0) 91036 ; You should have received a copy of the GNU General Public License along91048 ; 91037 91049 "RTN","C0CACTOR",18,0) 91038 ; with this program; if not, write to the Free Software Foundation, Inc.,91050 ; PROCESS THE ACTORS SECTION OF THE CCR 91039 91051 "RTN","C0CACTOR",19,0) 91040 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.91052 ; 91041 91053 "RTN","C0CACTOR",20,0) 91042 ; 91054 ; ===Revision History=== 91043 91055 "RTN","C0CACTOR",21,0) 91044 ; PROCESS THE ACTORS SECTION OF THE CCR91056 ; 0.1 Initial Writing of Skeleton--GPL 91045 91057 "RTN","C0CACTOR",22,0) 91046 ; 91058 ; 0.2 Patient Data Extraction--SMH 91047 91059 "RTN","C0CACTOR",23,0) 91048 ; ===Revision History===91060 ; 0.3 Information System Info Extraction--SMH 91049 91061 "RTN","C0CACTOR",24,0) 91050 ; 0. 1 Initial Writing of Skeleton--GPL91062 ; 0.4 Patient data rouine refactored; adjustments here--SMH 91051 91063 "RTN","C0CACTOR",25,0) 91052 ; 0.2 Patient Data Extraction--SMH91064 ; 91053 91065 "RTN","C0CACTOR",26,0) 91054 ; 0.3 Information System Info Extraction--SMH 91066 EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE 91055 91067 "RTN","C0CACTOR",27,0) 91056 ; 0.4 Patient data rouine refactored; adjustments here--SMH91068 ; IPXML is the Input Actor Template into which we substitute values 91057 91069 "RTN","C0CACTOR",28,0) 91058 ; 91070 ; This is straight XML. Values to be substituted are in @@VAL@@ format. 91059 91071 "RTN","C0CACTOR",29,0) 91060 EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE 91072 ; ALST is the actor list global generated by ACTLST^C0CCCR and has format: 91061 91073 "RTN","C0CACTOR",30,0) 91062 ; IPXML is the Input Actor Template into which we substitute values91074 ; ^TMP(7542,1,"ACTORS",0)=Count 91063 91075 "RTN","C0CACTOR",31,0) 91064 ; This is straight XML. Values to be substituted are in @@VAL@@ format.91076 ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN" 91065 91077 "RTN","C0CACTOR",32,0) 91066 ; A LST is the actor list global generated by ACTLST^C0CCCR and has format:91078 ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM" 91067 91079 "RTN","C0CACTOR",33,0) 91068 ; ^TMP(7542,1,"ACTORS",0)=Count91080 ; AXML is the output arrary, to contain XML. 91069 91081 "RTN","C0CACTOR",34,0) 91070 ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"91082 ; 91071 91083 "RTN","C0CACTOR",35,0) 91072 ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"91084 N I,J,AMAP,AOID,ATYP,AIEN 91073 91085 "RTN","C0CACTOR",36,0) 91074 ; AXML is the output arrary, to contain XML.91086 D CP^C0CXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML 91075 91087 "RTN","C0CACTOR",37,0) 91076 ;91088 D REPLACE^C0CXPATH(AXML,"","//Actors") ; DELETE THE INSIDES 91077 91089 "RTN","C0CACTOR",38,0) 91078 N I,J,AMAP,AOID,ATYP,AIEN91090 I DEBUG W "PROCESSING ACTORS ",! 91079 91091 "RTN","C0CACTOR",39,0) 91080 D CP^C0CXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML91092 F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST 91081 91093 "RTN","C0CACTOR",40,0) 91082 D REPLACE^C0CXPATH(AXML,"","//Actors") ; DELETE THE INSIDES91094 . I @ALST@(I)["@@" Q ; NOT A VALID ACTOR 91083 91095 "RTN","C0CACTOR",41,0) 91084 I DEBUG W "PROCESSING ACTORS ",!91096 . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID 91085 91097 "RTN","C0CACTOR",42,0) 91086 F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST91098 . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE 91087 91099 "RTN","C0CACTOR",43,0) 91088 . I @ALST@(I)["@@" Q ; NOT A VALID ACTOR91100 . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER 91089 91101 "RTN","C0CACTOR",44,0) 91090 . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID91102 . I AIEN="" D Q ; IEN CAN'T BE NULL 91091 91103 "RTN","C0CACTOR",45,0) 91092 . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE91104 . . W "WARING NUL ACTOR: ",ATYP,! 91093 91105 "RTN","C0CACTOR",46,0) 91094 . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER91106 . I ATYP="" Q ; NOT A VALID ACTOR 91095 91107 "RTN","C0CACTOR",47,0) 91096 . I AIEN="" D Q ; IEN CAN'T BE NULL91108 . ; 91097 91109 "RTN","C0CACTOR",48,0) 91098 . . W "WARING NUL ACTOR: ",ATYP,!91110 . I DEBUG W AOID_" "_ATYP_" "_AIEN,! 91099 91111 "RTN","C0CACTOR",49,0) 91100 . I ATYP=" " Q ; NOT A VALID ACTOR91112 . I ATYP="PATIENT" D ; PATIENT ACTOR TYPE 91101 91113 "RTN","C0CACTOR",50,0) 91114 . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP") 91115 "RTN","C0CACTOR",51,0) 91116 . . D PATIENT("ATMP",AIEN,AOID,"ATMP2") 91117 "RTN","C0CACTOR",52,0) 91102 91118 . ; 91103 "RTN","C0CACTOR",51,0)91104 . I DEBUG W AOID_" "_ATYP_" "_AIEN,!91105 "RTN","C0CACTOR",52,0)91106 . I ATYP="PATIENT" D ; PATIENT ACTOR TYPE91107 91119 "RTN","C0CACTOR",53,0) 91108 . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")91120 . I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE 91109 91121 "RTN","C0CACTOR",54,0) 91110 . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")91122 . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP") 91111 91123 "RTN","C0CACTOR",55,0) 91124 . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2") 91125 "RTN","C0CACTOR",56,0) 91112 91126 . ; 91113 "RTN","C0CACTOR",56,0)91114 . I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE91115 91127 "RTN","C0CACTOR",57,0) 91116 . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")91128 . I ATYP="NOK" D ; NOK ACTOR TYPE 91117 91129 "RTN","C0CACTOR",58,0) 91118 . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")91130 . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP") 91119 91131 "RTN","C0CACTOR",59,0) 91132 . . D NOK("ATMP",AIEN,AOID,"ATMP2") 91133 "RTN","C0CACTOR",60,0) 91120 91134 . ; 91121 "RTN","C0CACTOR",60,0)91122 . I ATYP="NOK" D ; NOK ACTOR TYPE91123 91135 "RTN","C0CACTOR",61,0) 91124 . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")91136 . I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE 91125 91137 "RTN","C0CACTOR",62,0) 91126 . . D NOK("ATMP",AIEN,AOID,"ATMP2")91138 . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP") 91127 91139 "RTN","C0CACTOR",63,0) 91140 . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2") 91141 "RTN","C0CACTOR",64,0) 91128 91142 . ; 91129 "RTN","C0CACTOR",64,0)91130 . I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE91131 91143 "RTN","C0CACTOR",65,0) 91132 . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")91144 . I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE 91133 91145 "RTN","C0CACTOR",66,0) 91134 . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")91146 . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP") 91135 91147 "RTN","C0CACTOR",67,0) 91148 . . D ORG("ATMP",AIEN,AOID,"ATMP2") 91149 "RTN","C0CACTOR",68,0) 91136 91150 . ; 91137 "RTN","C0CACTOR",68,0)91138 . I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE91139 91151 "RTN","C0CACTOR",69,0) 91140 . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")91152 . W "PROCESSING:",ATYP," ",AIEN,! 91141 91153 "RTN","C0CACTOR",70,0) 91142 . . D ORG("ATMP",AIEN,AOID,"ATMP2")91154 . ;I @ATMP2@(0)=0 Q ; NOTHING RETURNED, SKIP THIS ONE 91143 91155 "RTN","C0CACTOR",71,0) 91144 . ;91156 . D INSINNER^C0CXPATH(AXML,"ATMP2") ; INSERT INTO ROOT 91145 91157 "RTN","C0CACTOR",72,0) 91146 . W "PROCESSING:",ATYP," ",AIEN,!91158 . K ATYP,AIEN,AOID,ATMP,ATMP2 ; BE SURE TO GET THE NEXT ONE 91147 91159 "RTN","C0CACTOR",73,0) 91148 . ;I @ATMP2@(0)=0 Q ; NOTHING RETURNED, SKIP THIS ONE91160 ; 91149 91161 "RTN","C0CACTOR",74,0) 91150 . D INSINNER^C0CXPATH(AXML,"ATMP2") ; INSERT INTO ROOT91162 N ACTTMP 91151 91163 "RTN","C0CACTOR",75,0) 91152 . K ATYP,AIEN,AOID,ATMP,ATMP2 ; BE SURE TO GET THE NEXT ONE91164 D MISSING^C0CXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS 91153 91165 "RTN","C0CACTOR",76,0) 91154 ;91166 I ACTTMP(0)>0 D ; IF THERE ARE MISSING VARS - 91155 91167 "RTN","C0CACTOR",77,0) 91156 N ACTTMP91168 . ; STRINGS MARKED AS @@X@@ 91157 91169 "RTN","C0CACTOR",78,0) 91158 D MISSING^C0CXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS91170 . W "ACTORS Missing list: ",! 91159 91171 "RTN","C0CACTOR",79,0) 91160 I ACTTMP(0)>0 D ; IF THERE ARE MISSING VARS -91172 . F I=1:1:ACTTMP(0) W ACTTMP(I),! 91161 91173 "RTN","C0CACTOR",80,0) 91162 . ; STRINGS MARKED AS @@X@@91174 Q 91163 91175 "RTN","C0CACTOR",81,0) 91164 . W "ACTORS Missing list: ",!91176 ; 91165 91177 "RTN","C0CACTOR",82,0) 91166 . F I=1:1:ACTTMP(0) W ACTTMP(I),! 91178 PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR 91167 91179 "RTN","C0CACTOR",83,0) 91180 I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,! 91181 "RTN","C0CACTOR",84,0) 91182 ;GPL SEPARATED EXTRACT FROM MAP FOR PROCESSING PATIENTS - TO MAKE 91183 "RTN","C0CACTOR",85,0) 91184 ; CODE REUSABLE FROM ERX 91185 "RTN","C0CACTOR",86,0) 91186 N AMAP 91187 "RTN","C0CACTOR",87,0) 91188 S AMAP=$NA(^TMP($J,"AMAP")) 91189 "RTN","C0CACTOR",88,0) 91190 K @AMAP 91191 "RTN","C0CACTOR",89,0) 91192 D PEXTRACT(AMAP,AIEN,AOID) ;EXTRACT THE PATIENT ACTOR 91193 "RTN","C0CACTOR",90,0) 91194 I $P($$SITE^VASITE(),U,2)="OROVILLE HOSPITAL" S C0CDE=1 91195 "RTN","C0CACTOR",91,0) 91196 I $G(C0CDE)'="" D DEIDENT(AMAP,AIEN) ; DEIDENTIFY THE CCR 91197 "RTN","C0CACTOR",92,0) 91198 D MAP(INXML,AMAP,OUTXML) ;MAP TO XML 91199 "RTN","C0CACTOR",93,0) 91200 K @AMAP ; CLEAN UP BEHIND US 91201 "RTN","C0CACTOR",94,0) 91168 91202 Q 91169 "RTN","C0CACTOR",84,0)91170 ;91171 "RTN","C0CACTOR",85,0)91172 PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR91173 "RTN","C0CACTOR",86,0)91174 I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!91175 "RTN","C0CACTOR",87,0)91176 ;GPL SEPARATED EXTRACT FROM MAP FOR PROCESSING PATIENTS - TO MAKE91177 "RTN","C0CACTOR",88,0)91178 ; CODE REUSABLE FROM ERX91179 "RTN","C0CACTOR",89,0)91180 N AMAP91181 "RTN","C0CACTOR",90,0)91182 S AMAP=$NA(^TMP($J,"AMAP"))91183 "RTN","C0CACTOR",91,0)91184 K @AMAP91185 "RTN","C0CACTOR",92,0)91186 D PEXTRACT(AMAP,AIEN,AOID) ;EXTRACT THE PATIENT ACTOR91187 "RTN","C0CACTOR",93,0)91188 I $P($$SITE^VASITE(),U,2)="OROVILLE HOSPITAL" S C0CDE=191189 "RTN","C0CACTOR",94,0)91190 I $G(C0CDE)'="" D DEIDENT(AMAP,AIEN) ; DEIDENTIFY THE CCR91191 91203 "RTN","C0CACTOR",95,0) 91192 D MAP(INXML,AMAP,OUTXML) ;MAP TO XML91204 ; 91193 91205 "RTN","C0CACTOR",96,0) 91194 K @AMAP ; CLEAN UP BEHIND US 91206 DEIDENT(GPL,ZDFN) ; QUICK WAY TO DEIDENTIFY THE CCR 91195 91207 "RTN","C0CACTOR",97,0) 91208 S @GPL@("ACTORADDRESSCITY")="ALTON" 91209 "RTN","C0CACTOR",98,0) 91210 S @GPL@("ACTORADDRESSLINE1")="1234 Somewhere Lane" 91211 "RTN","C0CACTOR",99,0) 91212 S @GPL@("ACTORADDRESSLINE2")="" 91213 "RTN","C0CACTOR",100,0) 91214 S @GPL@("ACTORADDRESSSOURCEID")="ACTORPATIENT_"_ZDFN 91215 "RTN","C0CACTOR",101,0) 91216 S @GPL@("ACTORADDRESSSTATE")="KANSAS" 91217 "RTN","C0CACTOR",102,0) 91218 S @GPL@("ACTORADDRESSTYPE")="Home" 91219 "RTN","C0CACTOR",103,0) 91220 S @GPL@("ACTORADDRESSZIPCODE")=67623 91221 "RTN","C0CACTOR",104,0) 91222 S @GPL@("ACTORCELLTEL")="" 91223 "RTN","C0CACTOR",105,0) 91224 S @GPL@("ACTORCELLTELTEXT")="" 91225 "RTN","C0CACTOR",106,0) 91226 S @GPL@("ACTORDATEOFBIRTH")="1957-12-25" 91227 "RTN","C0CACTOR",107,0) 91228 S @GPL@("ACTOREMAIL")="" 91229 "RTN","C0CACTOR",108,0) 91230 S @GPL@("ACTORFAMILYNAME")="ZZ PATIENT"_ZDFN 91231 "RTN","C0CACTOR",109,0) 91232 ;S @GPL@("ACTORGENDER")="MALE" 91233 "RTN","C0CACTOR",110,0) 91234 S @GPL@("ACTORGIVENNAME")="TEST"_ZDFN 91235 "RTN","C0CACTOR",111,0) 91236 S @GPL@("ACTORIEN")=2 91237 "RTN","C0CACTOR",112,0) 91238 S @GPL@("ACTORMIDDLENAME")="TWO" 91239 "RTN","C0CACTOR",113,0) 91240 S @GPL@("ACTOROBJECTID")="ACTORPATIENT_"_ZDFN 91241 "RTN","C0CACTOR",114,0) 91242 S @GPL@("ACTORRESTEL")="888-555-1212" 91243 "RTN","C0CACTOR",115,0) 91244 S @GPL@("ACTORRESTELTEXT")="Residential Telephone" 91245 "RTN","C0CACTOR",116,0) 91246 S @GPL@("ACTORSOURCEID")="ACTORSYSTEM_1" 91247 "RTN","C0CACTOR",117,0) 91248 S @GPL@("ACTORSSN")="769122557P" 91249 "RTN","C0CACTOR",118,0) 91250 S @GPL@("ACTORSSNSOURCEID")="ACTORPATIENT_"_ZDFN 91251 "RTN","C0CACTOR",119,0) 91252 S @GPL@("ACTORSSNTEXT")="SSN" 91253 "RTN","C0CACTOR",120,0) 91254 S @GPL@("ACTORSUFFIXNAME")="" 91255 "RTN","C0CACTOR",121,0) 91256 S @GPL@("ACTORWORKTEL")="888-121-1212" 91257 "RTN","C0CACTOR",122,0) 91258 S @GPL@("ACTORWORKTELTEXT")="Work Telephone" 91259 "RTN","C0CACTOR",123,0) 91196 91260 Q 91197 "RTN","C0CACTOR",98,0)91198 ;91199 "RTN","C0CACTOR",99,0)91200 DEIDENT(GPL,ZDFN) ; QUICK WAY TO DEIDENTIFY THE CCR91201 "RTN","C0CACTOR",100,0)91202 S @GPL@("ACTORADDRESSCITY")="ALTON"91203 "RTN","C0CACTOR",101,0)91204 S @GPL@("ACTORADDRESSLINE1")="1234 Somewhere Lane"91205 "RTN","C0CACTOR",102,0)91206 S @GPL@("ACTORADDRESSLINE2")=""91207 "RTN","C0CACTOR",103,0)91208 S @GPL@("ACTORADDRESSSOURCEID")="ACTORPATIENT_"_ZDFN91209 "RTN","C0CACTOR",104,0)91210 S @GPL@("ACTORADDRESSSTATE")="KANSAS"91211 "RTN","C0CACTOR",105,0)91212 S @GPL@("ACTORADDRESSTYPE")="Home"91213 "RTN","C0CACTOR",106,0)91214 S @GPL@("ACTORADDRESSZIPCODE")=6762391215 "RTN","C0CACTOR",107,0)91216 S @GPL@("ACTORCELLTEL")=""91217 "RTN","C0CACTOR",108,0)91218 S @GPL@("ACTORCELLTELTEXT")=""91219 "RTN","C0CACTOR",109,0)91220 S @GPL@("ACTORDATEOFBIRTH")="1957-12-25"91221 "RTN","C0CACTOR",110,0)91222 S @GPL@("ACTOREMAIL")=""91223 "RTN","C0CACTOR",111,0)91224 S @GPL@("ACTORFAMILYNAME")="ZZ PATIENT"_ZDFN91225 "RTN","C0CACTOR",112,0)91226 ;S @GPL@("ACTORGENDER")="MALE"91227 "RTN","C0CACTOR",113,0)91228 S @GPL@("ACTORGIVENNAME")="TEST"_ZDFN91229 "RTN","C0CACTOR",114,0)91230 S @GPL@("ACTORIEN")=291231 "RTN","C0CACTOR",115,0)91232 S @GPL@("ACTORMIDDLENAME")="TWO"91233 "RTN","C0CACTOR",116,0)91234 S @GPL@("ACTOROBJECTID")="ACTORPATIENT_"_ZDFN91235 "RTN","C0CACTOR",117,0)91236 S @GPL@("ACTORRESTEL")="888-555-1212"91237 "RTN","C0CACTOR",118,0)91238 S @GPL@("ACTORRESTELTEXT")="Residential Telephone"91239 "RTN","C0CACTOR",119,0)91240 S @GPL@("ACTORSOURCEID")="ACTORSYSTEM_1"91241 "RTN","C0CACTOR",120,0)91242 S @GPL@("ACTORSSN")="769122557P"91243 "RTN","C0CACTOR",121,0)91244 S @GPL@("ACTORSSNSOURCEID")="ACTORPATIENT_"_ZDFN91245 "RTN","C0CACTOR",122,0)91246 S @GPL@("ACTORSSNTEXT")="SSN"91247 "RTN","C0CACTOR",123,0)91248 S @GPL@("ACTORSUFFIXNAME")=""91249 91261 "RTN","C0CACTOR",124,0) 91250 S @GPL@("ACTORWORKTEL")="888-121-1212"91262 ; 91251 91263 "RTN","C0CACTOR",125,0) 91252 S @GPL@("ACTORWORKTELTEXT")="Work Telephone" 91264 PEXTRACT(AMAP,AIEN,AOID) ; EXTRACT TO RETURN ARRAY RARY PASSED BY NAME 91253 91265 "RTN","C0CACTOR",126,0) 91266 N ZX 91267 "RTN","C0CACTOR",127,0) 91268 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID 91269 "RTN","C0CACTOR",128,0) 91270 S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CDPT(AIEN) 91271 "RTN","C0CACTOR",129,0) 91272 S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CDPT(AIEN) 91273 "RTN","C0CACTOR",130,0) 91274 S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CDPT(AIEN) 91275 "RTN","C0CACTOR",131,0) 91276 S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^C0CDPT(AIEN) 91277 "RTN","C0CACTOR",132,0) 91278 S @AMAP@("ACTORGENDER")=$P($$GENDER^C0CDPT(AIEN),U,2) 91279 "RTN","C0CACTOR",133,0) 91280 S @AMAP@("ACTORGENDERCODE")=$P($$GENDER^C0CDPT(AIEN),U,1) 91281 "RTN","C0CACTOR",134,0) 91282 S @AMAP@("ACTORSSN")="" 91283 "RTN","C0CACTOR",135,0) 91284 S @AMAP@("ACTORSSNTEXT")="" 91285 "RTN","C0CACTOR",136,0) 91286 S @AMAP@("ACTORSSNSOURCEID")="" 91287 "RTN","C0CACTOR",137,0) 91288 S X="MSCDPTID" ; ROUTINE TO TEST FOR MRN ON OPENVISTA 91289 "RTN","C0CACTOR",138,0) 91290 X ^%ZOSF("TEST") ; TEST TO SEE IF THE ROUTINE EXISTS 91291 "RTN","C0CACTOR",139,0) 91292 I $T S MRN=$$^MSCDPTID(DFN) ;TEST FOR MRN ON OPENVISTA ;GPL 91293 "RTN","C0CACTOR",140,0) 91294 I $G(MRN)'="" D ; IF MRN IS PRESENT 91295 "RTN","C0CACTOR",141,0) 91296 . S @AMAP@("ACTORSSN")=MRN 91297 "RTN","C0CACTOR",142,0) 91298 . S @AMAP@("ACTORSSNTEXT")="MRN" 91299 "RTN","C0CACTOR",143,0) 91300 . S @AMAP@("ACTORSSNSOURCEID")=AOID 91301 "RTN","C0CACTOR",144,0) 91302 E D ; NO MRN, USE SSN 91303 "RTN","C0CACTOR",145,0) 91304 . S ZX=$$SSN^C0CDPT(AIEN) 91305 "RTN","C0CACTOR",146,0) 91306 . I ZX'="" D ; IF THERE IS A SSN IN THE RECORD 91307 "RTN","C0CACTOR",147,0) 91308 . . S @AMAP@("ACTORSSN")=ZX 91309 "RTN","C0CACTOR",148,0) 91310 . . S @AMAP@("ACTORSSNTEXT")="SSN" 91311 "RTN","C0CACTOR",149,0) 91312 . . S @AMAP@("ACTORSSNSOURCEID")=AOID 91313 "RTN","C0CACTOR",150,0) 91314 S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^C0CDPT(AIEN) 91315 "RTN","C0CACTOR",151,0) 91316 S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^C0CDPT(AIEN) 91317 "RTN","C0CACTOR",152,0) 91318 S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^C0CDPT(AIEN) 91319 "RTN","C0CACTOR",153,0) 91320 S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CDPT(AIEN) 91321 "RTN","C0CACTOR",154,0) 91322 S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CDPT(AIEN) 91323 "RTN","C0CACTOR",155,0) 91324 S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^C0CDPT(AIEN) 91325 "RTN","C0CACTOR",156,0) 91326 S @AMAP@("ACTORRESTEL")="" 91327 "RTN","C0CACTOR",157,0) 91328 S @AMAP@("ACTORRESTELTEXT")="" 91329 "RTN","C0CACTOR",158,0) 91330 S ZX=$$RESTEL^C0CDPT(AIEN) 91331 "RTN","C0CACTOR",159,0) 91332 I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD 91333 "RTN","C0CACTOR",160,0) 91334 . S @AMAP@("ACTORRESTEL")=ZX 91335 "RTN","C0CACTOR",161,0) 91336 . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone" 91337 "RTN","C0CACTOR",162,0) 91338 S @AMAP@("ACTORWORKTEL")="" 91339 "RTN","C0CACTOR",163,0) 91340 S @AMAP@("ACTORWORKTELTEXT")="" 91341 "RTN","C0CACTOR",164,0) 91342 S ZX=$$WORKTEL^C0CDPT(AIEN) 91343 "RTN","C0CACTOR",165,0) 91344 I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD 91345 "RTN","C0CACTOR",166,0) 91346 . S @AMAP@("ACTORWORKTEL")=ZX 91347 "RTN","C0CACTOR",167,0) 91348 . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone" 91349 "RTN","C0CACTOR",168,0) 91350 S @AMAP@("ACTORCELLTEL")="" 91351 "RTN","C0CACTOR",169,0) 91352 S @AMAP@("ACTORCELLTELTEXT")="" 91353 "RTN","C0CACTOR",170,0) 91354 S ZX=$$CELLTEL^C0CDPT(AIEN) 91355 "RTN","C0CACTOR",171,0) 91356 I ZX'="" D ; IF THERE IS A CELL PHONE IN THE RECORD 91357 "RTN","C0CACTOR",172,0) 91358 . S @AMAP@("ACTORCELLTEL")=ZX 91359 "RTN","C0CACTOR",173,0) 91360 . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone" 91361 "RTN","C0CACTOR",174,0) 91362 S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CDPT(AIEN) 91363 "RTN","C0CACTOR",175,0) 91364 S @AMAP@("ACTORADDRESSSOURCEID")=AOID 91365 "RTN","C0CACTOR",176,0) 91366 S @AMAP@("ACTORIEN")=AIEN 91367 "RTN","C0CACTOR",177,0) 91368 S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX 91369 "RTN","C0CACTOR",178,0) 91370 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE 91371 "RTN","C0CACTOR",179,0) 91254 91372 Q 91255 "RTN","C0CACTOR",127,0)91256 ;91257 "RTN","C0CACTOR",128,0)91258 PEXTRACT(AMAP,AIEN,AOID) ; EXTRACT TO RETURN ARRAY RARY PASSED BY NAME91259 "RTN","C0CACTOR",129,0)91260 N ZX91261 "RTN","C0CACTOR",130,0)91262 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID91263 "RTN","C0CACTOR",131,0)91264 S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CDPT(AIEN)91265 "RTN","C0CACTOR",132,0)91266 S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CDPT(AIEN)91267 "RTN","C0CACTOR",133,0)91268 S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CDPT(AIEN)91269 "RTN","C0CACTOR",134,0)91270 S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^C0CDPT(AIEN)91271 "RTN","C0CACTOR",135,0)91272 S @AMAP@("ACTORGENDER")=$P($$GENDER^C0CDPT(AIEN),U,2)91273 "RTN","C0CACTOR",136,0)91274 S @AMAP@("ACTORGENDERCODE")=$P($$GENDER^C0CDPT(AIEN),U,1)91275 "RTN","C0CACTOR",137,0)91276 S @AMAP@("ACTORSSN")=""91277 "RTN","C0CACTOR",138,0)91278 S @AMAP@("ACTORSSNTEXT")=""91279 "RTN","C0CACTOR",139,0)91280 S @AMAP@("ACTORSSNSOURCEID")=""91281 "RTN","C0CACTOR",140,0)91282 S X="MSCDPTID" ; ROUTINE TO TEST FOR MRN ON OPENVISTA91283 "RTN","C0CACTOR",141,0)91284 X ^%ZOSF("TEST") ; TEST TO SEE IF THE ROUTINE EXISTS91285 "RTN","C0CACTOR",142,0)91286 I $T S MRN=$$^MSCDPTID(DFN) ;TEST FOR MRN ON OPENVISTA ;GPL91287 "RTN","C0CACTOR",143,0)91288 I $G(MRN)'="" D ; IF MRN IS PRESENT91289 "RTN","C0CACTOR",144,0)91290 . S @AMAP@("ACTORSSN")=MRN91291 "RTN","C0CACTOR",145,0)91292 . S @AMAP@("ACTORSSNTEXT")="MRN"91293 "RTN","C0CACTOR",146,0)91294 . S @AMAP@("ACTORSSNSOURCEID")=AOID91295 "RTN","C0CACTOR",147,0)91296 E D ; NO MRN, USE SSN91297 "RTN","C0CACTOR",148,0)91298 . S ZX=$$SSN^C0CDPT(AIEN)91299 "RTN","C0CACTOR",149,0)91300 . I ZX'="" D ; IF THERE IS A SSN IN THE RECORD91301 "RTN","C0CACTOR",150,0)91302 . . S @AMAP@("ACTORSSN")=ZX91303 "RTN","C0CACTOR",151,0)91304 . . S @AMAP@("ACTORSSNTEXT")="SSN"91305 "RTN","C0CACTOR",152,0)91306 . . S @AMAP@("ACTORSSNSOURCEID")=AOID91307 "RTN","C0CACTOR",153,0)91308 S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^C0CDPT(AIEN)91309 "RTN","C0CACTOR",154,0)91310 S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^C0CDPT(AIEN)91311 "RTN","C0CACTOR",155,0)91312 S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^C0CDPT(AIEN)91313 "RTN","C0CACTOR",156,0)91314 S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CDPT(AIEN)91315 "RTN","C0CACTOR",157,0)91316 S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CDPT(AIEN)91317 "RTN","C0CACTOR",158,0)91318 S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^C0CDPT(AIEN)91319 "RTN","C0CACTOR",159,0)91320 S @AMAP@("ACTORRESTEL")=""91321 "RTN","C0CACTOR",160,0)91322 S @AMAP@("ACTORRESTELTEXT")=""91323 "RTN","C0CACTOR",161,0)91324 S ZX=$$RESTEL^C0CDPT(AIEN)91325 "RTN","C0CACTOR",162,0)91326 I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD91327 "RTN","C0CACTOR",163,0)91328 . S @AMAP@("ACTORRESTEL")=ZX91329 "RTN","C0CACTOR",164,0)91330 . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"91331 "RTN","C0CACTOR",165,0)91332 S @AMAP@("ACTORWORKTEL")=""91333 "RTN","C0CACTOR",166,0)91334 S @AMAP@("ACTORWORKTELTEXT")=""91335 "RTN","C0CACTOR",167,0)91336 S ZX=$$WORKTEL^C0CDPT(AIEN)91337 "RTN","C0CACTOR",168,0)91338 I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD91339 "RTN","C0CACTOR",169,0)91340 . S @AMAP@("ACTORWORKTEL")=ZX91341 "RTN","C0CACTOR",170,0)91342 . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"91343 "RTN","C0CACTOR",171,0)91344 S @AMAP@("ACTORCELLTEL")=""91345 "RTN","C0CACTOR",172,0)91346 S @AMAP@("ACTORCELLTELTEXT")=""91347 "RTN","C0CACTOR",173,0)91348 S ZX=$$CELLTEL^C0CDPT(AIEN)91349 "RTN","C0CACTOR",174,0)91350 I ZX'="" D ; IF THERE IS A CELL PHONE IN THE RECORD91351 "RTN","C0CACTOR",175,0)91352 . S @AMAP@("ACTORCELLTEL")=ZX91353 "RTN","C0CACTOR",176,0)91354 . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"91355 "RTN","C0CACTOR",177,0)91356 S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CDPT(AIEN)91357 "RTN","C0CACTOR",178,0)91358 S @AMAP@("ACTORADDRESSSOURCEID")=AOID91359 "RTN","C0CACTOR",179,0)91360 S @AMAP@("ACTORIEN")=AIEN91361 91373 "RTN","C0CACTOR",180,0) 91362 S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX91374 ; 91363 91375 "RTN","C0CACTOR",181,0) 91364 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE 91376 MAP(INXML,AMAP,OUTXML) ;MAP ANY ACTOR TO XML 91365 91377 "RTN","C0CACTOR",182,0) 91378 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE 91379 "RTN","C0CACTOR",183,0) 91366 91380 Q 91367 "RTN","C0CACTOR",183,0)91368 ;91369 91381 "RTN","C0CACTOR",184,0) 91370 MAP(INXML,AMAP,OUTXML) ;MAP ANY ACTOR TO XML 91382 ; 91371 91383 "RTN","C0CACTOR",185,0) 91372 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE 91384 SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR 91373 91385 "RTN","C0CACTOR",186,0) 91374 Q91386 ; 91375 91387 "RTN","C0CACTOR",187,0) 91376 ;91388 ; N AMAP 91377 91389 "RTN","C0CACTOR",188,0) 91378 SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR 91390 S AMAP=$NA(^TMP($J,"AMAP")) 91379 91391 "RTN","C0CACTOR",189,0) 91392 K @AMAP 91393 "RTN","C0CACTOR",190,0) 91394 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID 91395 "RTN","C0CACTOR",191,0) 91396 S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^C0CSYS 91397 "RTN","C0CACTOR",192,0) 91398 S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^C0CSYS 91399 "RTN","C0CACTOR",193,0) 91400 S @AMAP@("ACTORINFOSYSSOURCEID")=AOID 91401 "RTN","C0CACTOR",194,0) 91402 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE 91403 "RTN","C0CACTOR",195,0) 91404 Q 91405 "RTN","C0CACTOR",196,0) 91380 91406 ; 91381 "RTN","C0CACTOR",190,0) 91407 "RTN","C0CACTOR",197,0) 91408 NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR 91409 "RTN","C0CACTOR",198,0) 91410 ; 91411 "RTN","C0CACTOR",199,0) 91382 91412 ; N AMAP 91383 "RTN","C0CACTOR", 191,0)91413 "RTN","C0CACTOR",200,0) 91384 91414 S AMAP=$NA(^TMP($J,"AMAP")) 91385 "RTN","C0CACTOR", 192,0)91415 "RTN","C0CACTOR",201,0) 91386 91416 K @AMAP 91387 "RTN","C0CACTOR", 193,0)91417 "RTN","C0CACTOR",202,0) 91388 91418 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID 91389 "RTN","C0CACTOR",194,0) 91390 S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^C0CSYS 91391 "RTN","C0CACTOR",195,0) 91392 S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^C0CSYS 91393 "RTN","C0CACTOR",196,0) 91394 S @AMAP@("ACTORINFOSYSSOURCEID")=AOID 91395 "RTN","C0CACTOR",197,0) 91419 "RTN","C0CACTOR",203,0) 91420 S @AMAP@("ACTORDISPLAYNAME")="" 91421 "RTN","C0CACTOR",204,0) 91422 S @AMAP@("ACTORRELATION")="" 91423 "RTN","C0CACTOR",205,0) 91424 S @AMAP@("ACTORRELATIONSOURCEID")="" 91425 "RTN","C0CACTOR",206,0) 91426 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE 91427 "RTN","C0CACTOR",207,0) 91396 91428 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE 91397 "RTN","C0CACTOR", 198,0)91429 "RTN","C0CACTOR",208,0) 91398 91430 Q 91399 "RTN","C0CACTOR", 199,0)91431 "RTN","C0CACTOR",209,0) 91400 91432 ; 91401 "RTN","C0CACTOR",2 00,0)91402 NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR91403 "RTN","C0CACTOR",2 01,0)91433 "RTN","C0CACTOR",210,0) 91434 ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR 91435 "RTN","C0CACTOR",211,0) 91404 91436 ; 91405 "RTN","C0CACTOR",202,0) 91437 "RTN","C0CACTOR",212,0) 91438 N AMAP,ZIEN,ZSITE 91439 "RTN","C0CACTOR",213,0) 91440 S AMAP=$NA(^TMP($J,"AMAP")) 91441 "RTN","C0CACTOR",214,0) 91442 K @AMAP 91443 "RTN","C0CACTOR",215,0) 91444 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID 91445 "RTN","C0CACTOR",216,0) 91446 S ZSITE=$$SITE^VASITE ; SITE FORMAT IEN^NAME^DATE 91447 "RTN","C0CACTOR",217,0) 91448 S ZIEN=$P(ZSITE,"^",1) 91449 "RTN","C0CACTOR",218,0) 91450 S @AMAP@("ORGANIZATIONNAME")=$P(ZSITE,U,2) 91451 "RTN","C0CACTOR",219,0) 91452 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" 91453 "RTN","C0CACTOR",220,0) 91454 S @AMAP@("ACTORADDRESSTYPE")="Office" 91455 "RTN","C0CACTOR",221,0) 91456 S @AMAP@("ACTORADDRESSLINE1")=$$GET1^DIQ(4,ZIEN_",",1.01) 91457 "RTN","C0CACTOR",222,0) 91458 S @AMAP@("ACTORADDRESSLINE2")=$$GET1^DIQ(4,ZIEN_",",1.02) 91459 "RTN","C0CACTOR",223,0) 91460 S @AMAP@("ACTORADDRESSCITY")=$$GET1^DIQ(4,ZIEN_",",1.03) 91461 "RTN","C0CACTOR",224,0) 91462 S @AMAP@("ACTORADDRESSSTATE")=$$GET1^DIQ(4,ZIEN_",",.02) 91463 "RTN","C0CACTOR",225,0) 91464 S @AMAP@("ACTORPOSTALCODE")=$$GET1^DIQ(4,ZIEN_",",1.04) 91465 "RTN","C0CACTOR",226,0) 91466 S @AMAP@("ACTORTELEPHONE")="" 91467 "RTN","C0CACTOR",227,0) 91468 S @AMAP@("ACTORTELEPHONETYPE")="" 91469 "RTN","C0CACTOR",228,0) 91470 S ZX=$$GET1^DIQ(4.03,"1,"_ZIEN_",",.03) 91471 "RTN","C0CACTOR",229,0) 91472 I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE 91473 "RTN","C0CACTOR",230,0) 91474 . S @AMAP@("ACTORTELEPHONE")=ZX 91475 "RTN","C0CACTOR",231,0) 91476 . S @AMAP@("ACTORTELEPHONETYPE")="Office" 91477 "RTN","C0CACTOR",232,0) 91478 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE 91479 "RTN","C0CACTOR",233,0) 91480 K @AMAP 91481 "RTN","C0CACTOR",234,0) 91482 Q 91483 "RTN","C0CACTOR",235,0) 91484 ; 91485 "RTN","C0CACTOR",236,0) 91486 PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR 91487 "RTN","C0CACTOR",237,0) 91488 ; 91489 "RTN","C0CACTOR",238,0) 91406 91490 ; N AMAP 91407 "RTN","C0CACTOR",2 03,0)91491 "RTN","C0CACTOR",239,0) 91408 91492 S AMAP=$NA(^TMP($J,"AMAP")) 91409 "RTN","C0CACTOR",2 04,0)91493 "RTN","C0CACTOR",240,0) 91410 91494 K @AMAP 91411 "RTN","C0CACTOR",205,0) 91495 "RTN","C0CACTOR",241,0) 91496 I '$D(^VA(200,AIEN,0)) D Q ; IF NO PROVIDER RECORD (SHOULDN'T HAPPEN) 91497 "RTN","C0CACTOR",242,0) 91498 . W "WARNING - MISSING PROVIDER: ",AIEN,! 91499 "RTN","C0CACTOR",243,0) 91500 . S @OUTXML@(0)=0 ; SIGNAL NO OUTPUT 91501 "RTN","C0CACTOR",244,0) 91412 91502 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID 91413 "RTN","C0CACTOR",206,0) 91414 S @AMAP@("ACTORDISPLAYNAME")="" 91415 "RTN","C0CACTOR",207,0) 91416 S @AMAP@("ACTORRELATION")="" 91417 "RTN","C0CACTOR",208,0) 91418 S @AMAP@("ACTORRELATIONSOURCEID")="" 91419 "RTN","C0CACTOR",209,0) 91503 "RTN","C0CACTOR",245,0) 91504 S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CVA200(AIEN) 91505 "RTN","C0CACTOR",246,0) 91506 S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CVA200(AIEN) 91507 "RTN","C0CACTOR",247,0) 91508 S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CVA200(AIEN) 91509 "RTN","C0CACTOR",248,0) 91510 S @AMAP@("ACTORTITLE")=$$TITLE^C0CVA200(AIEN) 91511 "RTN","C0CACTOR",249,0) 91512 S @AMAP@("IDTYPE")=$P($$NPI^C0CVA200(AIEN),U,1) 91513 "RTN","C0CACTOR",250,0) 91514 S @AMAP@("ID")=$P($$NPI^C0CVA200(AIEN),U,2) 91515 "RTN","C0CACTOR",251,0) 91516 S @AMAP@("IDDESC")=$P($$NPI^C0CVA200(AIEN),U,3) 91517 "RTN","C0CACTOR",252,0) 91518 S @AMAP@("ACTORSPECIALITY")=$$SPEC^C0CVA200(AIEN) 91519 "RTN","C0CACTOR",253,0) 91520 S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^C0CVA200(AIEN) 91521 "RTN","C0CACTOR",254,0) 91522 S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^C0CVA200(AIEN) 91523 "RTN","C0CACTOR",255,0) 91524 S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CVA200(AIEN) 91525 "RTN","C0CACTOR",256,0) 91526 S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CVA200(AIEN) 91527 "RTN","C0CACTOR",257,0) 91528 S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^C0CVA200(AIEN) 91529 "RTN","C0CACTOR",258,0) 91530 S @AMAP@("ACTORTELEPHONE")="" 91531 "RTN","C0CACTOR",259,0) 91532 S @AMAP@("ACTORTELEPHONETYPE")="" 91533 "RTN","C0CACTOR",260,0) 91534 S ZX=$$TEL^C0CVA200(AIEN) 91535 "RTN","C0CACTOR",261,0) 91536 I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE 91537 "RTN","C0CACTOR",262,0) 91538 . S @AMAP@("ACTORTELEPHONE")=ZX 91539 "RTN","C0CACTOR",263,0) 91540 . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^C0CVA200(AIEN) 91541 "RTN","C0CACTOR",264,0) 91542 S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CVA200(AIEN) 91543 "RTN","C0CACTOR",265,0) 91544 S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1" 91545 "RTN","C0CACTOR",266,0) 91420 91546 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE 91421 "RTN","C0CACTOR",210,0) 91547 "RTN","C0CACTOR",267,0) 91548 S @AMAP@("ACTORORGLINK")="ACTORORGANIZATION_1" 91549 "RTN","C0CACTOR",268,0) 91422 91550 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE 91423 "RTN","C0CACTOR",2 11,0)91551 "RTN","C0CACTOR",269,0) 91424 91552 Q 91425 "RTN","C0CACTOR",212,0)91426 ;91427 "RTN","C0CACTOR",213,0)91428 ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR91429 "RTN","C0CACTOR",214,0)91430 ;91431 "RTN","C0CACTOR",215,0)91432 N AMAP,ZIEN,ZSITE91433 "RTN","C0CACTOR",216,0)91434 S AMAP=$NA(^TMP($J,"AMAP"))91435 "RTN","C0CACTOR",217,0)91436 K @AMAP91437 "RTN","C0CACTOR",218,0)91438 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID91439 "RTN","C0CACTOR",219,0)91440 S ZSITE=$$SITE^VASITE ; SITE FORMAT IEN^NAME^DATE91441 "RTN","C0CACTOR",220,0)91442 S ZIEN=$P(ZSITE,"^",1)91443 "RTN","C0CACTOR",221,0)91444 S @AMAP@("ORGANIZATIONNAME")=$P(ZSITE,U,2)91445 "RTN","C0CACTOR",222,0)91446 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"91447 "RTN","C0CACTOR",223,0)91448 S @AMAP@("ACTORADDRESSTYPE")="Office"91449 "RTN","C0CACTOR",224,0)91450 S @AMAP@("ACTORADDRESSLINE1")=$$GET1^DIQ(4,ZIEN_",",1.01)91451 "RTN","C0CACTOR",225,0)91452 S @AMAP@("ACTORADDRESSLINE2")=$$GET1^DIQ(4,ZIEN_",",1.02)91453 "RTN","C0CACTOR",226,0)91454 S @AMAP@("ACTORADDRESSCITY")=$$GET1^DIQ(4,ZIEN_",",1.03)91455 "RTN","C0CACTOR",227,0)91456 S @AMAP@("ACTORADDRESSSTATE")=$$GET1^DIQ(4,ZIEN_",",.02)91457 "RTN","C0CACTOR",228,0)91458 S @AMAP@("ACTORPOSTALCODE")=$$GET1^DIQ(4,ZIEN_",",1.04)91459 "RTN","C0CACTOR",229,0)91460 S @AMAP@("ACTORTELEPHONE")=""91461 "RTN","C0CACTOR",230,0)91462 S @AMAP@("ACTORTELEPHONETYPE")=""91463 "RTN","C0CACTOR",231,0)91464 S ZX=$$GET1^DIQ(4.03,"1,"_ZIEN_",",.03)91465 "RTN","C0CACTOR",232,0)91466 I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE91467 "RTN","C0CACTOR",233,0)91468 . S @AMAP@("ACTORTELEPHONE")=ZX91469 "RTN","C0CACTOR",234,0)91470 . S @AMAP@("ACTORTELEPHONETYPE")="Office"91471 "RTN","C0CACTOR",235,0)91472 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE91473 "RTN","C0CACTOR",236,0)91474 K @AMAP91475 "RTN","C0CACTOR",237,0)91476 Q91477 "RTN","C0CACTOR",238,0)91478 ;91479 "RTN","C0CACTOR",239,0)91480 PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR91481 "RTN","C0CACTOR",240,0)91482 ;91483 "RTN","C0CACTOR",241,0)91484 ; N AMAP91485 "RTN","C0CACTOR",242,0)91486 S AMAP=$NA(^TMP($J,"AMAP"))91487 "RTN","C0CACTOR",243,0)91488 K @AMAP91489 "RTN","C0CACTOR",244,0)91490 I '$D(^VA(200,AIEN,0)) D Q ; IF NO PROVIDER RECORD (SHOULDN'T HAPPEN)91491 "RTN","C0CACTOR",245,0)91492 . W "WARNING - MISSING PROVIDER: ",AIEN,!91493 "RTN","C0CACTOR",246,0)91494 . S @OUTXML@(0)=0 ; SIGNAL NO OUTPUT91495 "RTN","C0CACTOR",247,0)91496 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID91497 "RTN","C0CACTOR",248,0)91498 S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CVA200(AIEN)91499 "RTN","C0CACTOR",249,0)91500 S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CVA200(AIEN)91501 "RTN","C0CACTOR",250,0)91502 S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CVA200(AIEN)91503 "RTN","C0CACTOR",251,0)91504 S @AMAP@("ACTORTITLE")=$$TITLE^C0CVA200(AIEN)91505 "RTN","C0CACTOR",252,0)91506 S @AMAP@("IDTYPE")=$P($$NPI^C0CVA200(AIEN),U,1)91507 "RTN","C0CACTOR",253,0)91508 S @AMAP@("ID")=$P($$NPI^C0CVA200(AIEN),U,2)91509 "RTN","C0CACTOR",254,0)91510 S @AMAP@("IDDESC")=$P($$NPI^C0CVA200(AIEN),U,3)91511 "RTN","C0CACTOR",255,0)91512 S @AMAP@("ACTORSPECIALITY")=$$SPEC^C0CVA200(AIEN)91513 "RTN","C0CACTOR",256,0)91514 S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^C0CVA200(AIEN)91515 "RTN","C0CACTOR",257,0)91516 S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^C0CVA200(AIEN)91517 "RTN","C0CACTOR",258,0)91518 S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CVA200(AIEN)91519 "RTN","C0CACTOR",259,0)91520 S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CVA200(AIEN)91521 "RTN","C0CACTOR",260,0)91522 S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^C0CVA200(AIEN)91523 "RTN","C0CACTOR",261,0)91524 S @AMAP@("ACTORTELEPHONE")=""91525 "RTN","C0CACTOR",262,0)91526 S @AMAP@("ACTORTELEPHONETYPE")=""91527 "RTN","C0CACTOR",263,0)91528 S ZX=$$TEL^C0CVA200(AIEN)91529 "RTN","C0CACTOR",264,0)91530 I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE91531 "RTN","C0CACTOR",265,0)91532 . S @AMAP@("ACTORTELEPHONE")=ZX91533 "RTN","C0CACTOR",266,0)91534 . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^C0CVA200(AIEN)91535 "RTN","C0CACTOR",267,0)91536 S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CVA200(AIEN)91537 "RTN","C0CACTOR",268,0)91538 S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"91539 "RTN","C0CACTOR",269,0)91540 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE91541 91553 "RTN","C0CACTOR",270,0) 91542 S @AMAP@("ACTORORGLINK")="ACTORORGANIZATION_1"91543 "RTN","C0CACTOR",271,0)91544 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE91545 "RTN","C0CACTOR",272,0)91546 Q91547 "RTN","C0CACTOR",273,0)91548 91554 ; 91549 91555 "RTN","C0CALERT") 91550 0^46^B31 62730991556 0^46^B31119471 91551 91557 "RTN","C0CALERT",1,0) 91552 C0CALERT ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08 91558 C0CALERT ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08 ; 10/29/12 4:04pm 91553 91559 "RTN","C0CALERT",2,0) 91554 ;;1.2;C 0C;;May 11, 2012;Build 5091560 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 91555 91561 "RTN","C0CALERT",3,0) 91556 91562 ;Copyright 2008,2009 George Lilly, University of Minnesota and others. 91557 91563 "RTN","C0CALERT",4,0) 91558 ; Licensed under the terms of the GNU General Public License.91564 ; 91559 91565 "RTN","C0CALERT",5,0) 91560 ; See attached copy of the License.91566 ; This program is free software: you can redistribute it and/or modify 91561 91567 "RTN","C0CALERT",6,0) 91562 ; 91568 ; it under the terms of the GNU Affero General Public License as 91563 91569 "RTN","C0CALERT",7,0) 91564 ; This program is free software; you can redistribute it and/or modify91570 ; published by the Free Software Foundation, either version 3 of the 91565 91571 "RTN","C0CALERT",8,0) 91566 ; it under the terms of the GNU General Public License as published by91572 ; License, or (at your option) any later version. 91567 91573 "RTN","C0CALERT",9,0) 91568 ; the Free Software Foundation; either version 2 of the License, or91574 ; 91569 91575 "RTN","C0CALERT",10,0) 91570 ; (at your option) any later version.91576 ; This program is distributed in the hope that it will be useful, 91571 91577 "RTN","C0CALERT",11,0) 91572 ; 91578 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 91573 91579 "RTN","C0CALERT",12,0) 91574 ; This program is distributed in the hope that it will be useful,91580 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 91575 91581 "RTN","C0CALERT",13,0) 91576 ; but WITHOUT ANY WARRANTY; without even the implied warranty of91582 ; GNU Affero General Public License for more details. 91577 91583 "RTN","C0CALERT",14,0) 91578 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the91584 ; 91579 91585 "RTN","C0CALERT",15,0) 91580 ; GNU General Public License for more details.91586 ; You should have received a copy of the GNU Affero General Public License 91581 91587 "RTN","C0CALERT",16,0) 91582 ; 91588 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 91583 91589 "RTN","C0CALERT",17,0) 91584 ; You should have received a copy of the GNU General Public License along91590 ; 91585 91591 "RTN","C0CALERT",18,0) 91586 ; with this program; if not, write to the Free Software Foundation, Inc.,91592 ; 91587 91593 "RTN","C0CALERT",19,0) 91588 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.91594 W "NO ENTRY FROM TOP",! 91589 91595 "RTN","C0CALERT",20,0) 91590 ;91596 Q 91591 91597 "RTN","C0CALERT",21,0) 91592 W "NO ENTRY FROM TOP",!91598 ; 91593 91599 "RTN","C0CALERT",22,0) 91600 EXTRACT(ALTXML,DFN,ALTOUTXML,CALLBK) ; EXTRACT ALERTS INTO XML TEMPLATE 91601 "RTN","C0CALERT",23,0) 91602 ; CALLBACK IF PROVIDED IS CALLED FOR EACH ALLERGY BEFORE MAPPING 91603 "RTN","C0CALERT",24,0) 91604 ; ALTXML AND ALTOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED 91605 "RTN","C0CALERT",25,0) 91606 ; 91607 "RTN","C0CALERT",26,0) 91608 ; GET ADVERSE REACTIONS AND ALLERGIES 91609 "RTN","C0CALERT",27,0) 91610 ; N GMRA,GMRAL ; FOR DEBUGGING, DON'T NEW THESE VARIABLES 91611 "RTN","C0CALERT",28,0) 91612 S GMRA="0^0^111" 91613 "RTN","C0CALERT",29,0) 91614 D EN1^GMRADPT 91615 "RTN","C0CALERT",30,0) 91616 I $G(GMRAL)'=1 D Q ; NO ALLERGIES FOUND THUS *QUIT* 91617 "RTN","C0CALERT",31,0) 91618 . S @ALTOUTXML@(0)=0 91619 "RTN","C0CALERT",32,0) 91620 ; DEFINE MAPPING 91621 "RTN","C0CALERT",33,0) 91622 N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP 91623 "RTN","C0CALERT",34,0) 91624 S ALTTVMAP=$NA(^TMP("C0CCCR",$J,"ALERTS")) 91625 "RTN","C0CALERT",35,0) 91626 S ALTTARYTMP=$NA(^TMP("C0CCCR",$J,"ALERTSARYTMP")) 91627 "RTN","C0CALERT",36,0) 91628 K @ALTTVMAP,@ALTTARYTMP 91629 "RTN","C0CALERT",37,0) 91630 N ALTTMP,ALTCNT S ALTG=$NA(GMRAL),ALTCNT=1 91631 "RTN","C0CALERT",38,0) 91632 S ALTTMP="" ; 91633 "RTN","C0CALERT",39,0) 91634 F S ALTTMP=$O(@ALTG@(ALTTMP)) Q:ALTTMP="" D ; CHANGED TO $O BY GPL 91635 "RTN","C0CALERT",40,0) 91636 . W "ALTTMP="_ALTTMP,! 91637 "RTN","C0CALERT",41,0) 91638 . ; I $QS(ALTTMP,2)="S" W !,"S FOUND",! Q 91639 "RTN","C0CALERT",42,0) 91640 . S ALTVMAP=$NA(@ALTTVMAP@(ALTCNT)) 91641 "RTN","C0CALERT",43,0) 91642 . K @ALTVMAP 91643 "RTN","C0CALERT",44,0) 91644 . S @ALTVMAP@("ALERTOBJECTID")="ALERT"_ALTCNT 91645 "RTN","C0CALERT",45,0) 91646 . N A1 S A1=@ALTG@(ALTTMP) ; ALL THE PIECES 91647 "RTN","C0CALERT",46,0) 91648 . I $D(CALLBK) D @CALLBK ;CALLBACK FOR EPRESCRIBING 91649 "RTN","C0CALERT",47,0) 91650 . N A2 S A2=$$GET1^DIQ(120.8,ALTTMP,"MECHANISM","I") ; MECHANISM 91651 "RTN","C0CALERT",48,0) 91652 . N A3 S A3=$P(A1,U,5) ; ADVERSE FLAG 91653 "RTN","C0CALERT",49,0) 91654 . N ADT S ADT="Patient has an " ; X $ZINT H 5 91655 "RTN","C0CALERT",50,0) 91656 . S ADT=ADT_$S(A2="P":"ADVERSE",A2="A":"ALLERGIC",1:"UNKNOWN") 91657 "RTN","C0CALERT",51,0) 91658 . S ADT=ADT_" reaction to "_$P(@ALTG@(ALTTMP),U,2)_"." 91659 "RTN","C0CALERT",52,0) 91660 . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT 91661 "RTN","C0CALERT",53,0) 91662 . N ADTY S ADTY=$S(A2="P":"Adverse Reaction",A2="A":"Allergy",1:"") ; 91663 "RTN","C0CALERT",54,0) 91664 . S @ALTVMAP@("ALERTTYPE")=ADTY ; type of allergy 91665 "RTN","C0CALERT",55,0) 91666 . N ALTCDE ; SNOMED CODE THE THE ALERT 91667 "RTN","C0CALERT",56,0) 91668 . S ALTCDE=$S(A2="P":"282100009",A2="A":"416098002",1:"") ; IF NOT ADVERSE, IT IS ALLERGIC 91669 "RTN","C0CALERT",57,0) 91670 . S @ALTVMAP@("ALERTCODEVALUE")=ALTCDE ; 91671 "RTN","C0CALERT",58,0) 91672 . ; WILL USE 418634005 FOR ALLERGIC REACTION TO A SUBSTANCE 91673 "RTN","C0CALERT",59,0) 91674 . ; AND 282100009 FOR ADVERSE REACTION TO A SUBSTANCE 91675 "RTN","C0CALERT",60,0) 91676 . I ALTCDE'="" D ; IF THERE IS A CODE 91677 "RTN","C0CALERT",61,0) 91678 . . S @ALTVMAP@("ALERTCODESYSTEM")="SNOMED CT" 91679 "RTN","C0CALERT",62,0) 91680 . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")="2008" 91681 "RTN","C0CALERT",63,0) 91682 . E D ; SET TO NULL 91683 "RTN","C0CALERT",64,0) 91684 . . S @ALTVMAP@("ALERTCODESYSTEM")="" 91685 "RTN","C0CALERT",65,0) 91686 . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")="" 91687 "RTN","C0CALERT",66,0) 91688 . S @ALTVMAP@("ALERTSTATUSTEXT")="" ; WHERE DO WE GET THIS? 91689 "RTN","C0CALERT",67,0) 91690 . N ALTPROV S ALTPROV=$P(^GMR(120.8,ALTTMP,0),U,5) ; SOURCE PROVIDER IEN 91691 "RTN","C0CALERT",68,0) 91692 . I ALTPROV'="" D ; PROVIDER PROVIDEED 91693 "RTN","C0CALERT",69,0) 91694 . . S @ALTVMAP@("ALERTSOURCEID")="ACTORPROVIDER_"_ALTPROV 91695 "RTN","C0CALERT",70,0) 91696 . E S @ALTVMAP@("ALERTSOURCEID")="" ; SOURCE NULL - SHOULD NOT HAPPEN 91697 "RTN","C0CALERT",71,0) 91698 . W "RUNNING ALERTS, PROVIDER: ",@ALTVMAP@("ALERTSOURCEID"),! 91699 "RTN","C0CALERT",72,0) 91700 . N ACGL1,ACGFI,ACIEN,ACVUID,ACNM,ACTMP 91701 "RTN","C0CALERT",73,0) 91702 . S ACGL1=$P(@ALTG@(ALTTMP),U,9) ; ADDRESS OF THE REACTANT XX;GLB(YY.Z, 91703 "RTN","C0CALERT",74,0) 91704 . S ACGFI=$$PRSGLB($P(ACGL1,";",2)) ; FILE NUMBER 91705 "RTN","C0CALERT",75,0) 91706 . S ACIEN=$P(ACGL1,";",1) ; IEN OF REACTANT 91707 "RTN","C0CALERT",76,0) 91708 . S ACVUID=$$GET1^DIQ(ACGFI,ACIEN,"VUID") ; VUID OF THE REACTANT 91709 "RTN","C0CALERT",77,0) 91710 . S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="PRODUCT_"_ACIEN ; IE OF REACTANT 91711 "RTN","C0CALERT",78,0) 91712 . S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="" ; WHERE DO WE GET THIS? 91713 "RTN","C0CALERT",79,0) 91714 . S ACNM=$P(@ALTG@(ALTTMP),U,2) ; REACTANT 91715 "RTN","C0CALERT",80,0) 91716 . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM 91717 "RTN","C0CALERT",81,0) 91718 . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION 91719 "RTN","C0CALERT",82,0) 91720 . S (ZC,ZCD,ZCDS,ZCDSV)="" ; INITIALIZE 91721 "RTN","C0CALERT",83,0) 91722 . I ACVUID'="" D ; IF VUID IS NOT NULL 91723 "RTN","C0CALERT",84,0) 91724 . . S ZC=$$CODE^C0CUTIL(ACVUID) 91725 "RTN","C0CALERT",85,0) 91726 . . S ZCD=$P(ZC,"^",1) ; CODE TO USE 91727 "RTN","C0CALERT",86,0) 91728 . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID 91729 "RTN","C0CALERT",87,0) 91730 . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION 91731 "RTN","C0CALERT",88,0) 91732 . E D ; IF REACTANT CODE VALUE IS NULL 91733 "RTN","C0CALERT",89,0) 91734 . . I $G(DUZ("AG"))="I" D ; IF WE ARE RUNNING ON RPMS 91735 "RTN","C0CALERT",90,0) 91736 . . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ; 91737 "RTN","C0CALERT",91,0) 91738 . . . W "RPMS NAME FOUND",ACNM," ",ACTMP,! 91739 "RTN","C0CALERT",92,0) 91740 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="" 91741 "RTN","C0CALERT",93,0) 91742 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")="" 91743 "RTN","C0CALERT",94,0) 91744 . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ZCD 91745 "RTN","C0CALERT",95,0) 91746 . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=ZCDS 91747 "RTN","C0CALERT",96,0) 91748 . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM_" "_ZCDS_": "_ZCD 91749 "RTN","C0CALERT",97,0) 91750 . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT_" "_ZCDS_": "_ZCD 91751 "RTN","C0CALERT",98,0) 91752 . ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW 91753 "RTN","C0CALERT",99,0) 91754 . N ARTMP,ARIEN,ARDES,ARVUID 91755 "RTN","C0CALERT",100,0) 91756 . S (ARTMP,ARDES,ARVUID)="" 91757 "RTN","C0CALERT",101,0) 91758 . I $D(@ALTG@(ALTTMP,"S",1)) D ; IF REACTION EXISTS 91759 "RTN","C0CALERT",102,0) 91760 . . S ARTMP=@ALTG@(ALTTMP,"S",1) 91761 "RTN","C0CALERT",103,0) 91762 . . W "REACTION:",ARTMP,! 91763 "RTN","C0CALERT",104,0) 91764 . . S ARIEN=$P(ARTMP,";",2) 91765 "RTN","C0CALERT",105,0) 91766 . . S ARDES=$P(ARTMP,";",1) 91767 "RTN","C0CALERT",106,0) 91768 . . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID") 91769 "RTN","C0CALERT",107,0) 91770 . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES 91771 "RTN","C0CALERT",108,0) 91772 . I ARVUID'="" D ; IF REACTION VUID IS NOT NULL 91773 "RTN","C0CALERT",109,0) 91774 . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID 91775 "RTN","C0CALERT",110,0) 91776 . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID" 91777 "RTN","C0CALERT",111,0) 91778 . E D ; IF IT IS NULL DON'T SET CODE SYSTEM 91779 "RTN","C0CALERT",112,0) 91780 . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")="" 91781 "RTN","C0CALERT",113,0) 91782 . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="" 91783 "RTN","C0CALERT",114,0) 91784 . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT)) 91785 "RTN","C0CALERT",115,0) 91786 . ; NOW GO TO THE GLOBAL TO GET THE DATE/TIME AND BETTER DESCRIPTION 91787 "RTN","C0CALERT",116,0) 91788 . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL 91789 "RTN","C0CALERT",117,0) 91790 . D GETN1^C0CRNF("C0CG1",120.8,ALTTMP,"") ;GET VALUES BY NAME 91791 "RTN","C0CALERT",118,0) 91792 . S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1") 91793 "RTN","C0CALERT",119,0) 91794 . S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT,"DT") 91795 "RTN","C0CALERT",120,0) 91796 . K @ALTARYTMP 91797 "RTN","C0CALERT",121,0) 91798 . D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP) 91799 "RTN","C0CALERT",122,0) 91800 . I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML) 91801 "RTN","C0CALERT",123,0) 91802 . I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP) 91803 "RTN","C0CALERT",124,0) 91804 . S ALTCNT=ALTCNT+1 91805 "RTN","C0CALERT",125,0) 91806 S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS 91807 "RTN","C0CALERT",126,0) 91594 91808 Q 91595 "RTN","C0CALERT",23,0)91596 ;91597 "RTN","C0CALERT",24,0)91598 EXTRACT(ALTXML,DFN,ALTOUTXML,CALLBK) ; EXTRACT ALERTS INTO XML TEMPLATE91599 "RTN","C0CALERT",25,0)91600 ; CALLBACK IF PROVIDED IS CALLED FOR EACH ALLERGY BEFORE MAPPING91601 "RTN","C0CALERT",26,0)91602 ; ALTXML AND ALTOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED91603 "RTN","C0CALERT",27,0)91604 ;91605 "RTN","C0CALERT",28,0)91606 ; GET ADVERSE REACTIONS AND ALLERGIES91607 "RTN","C0CALERT",29,0)91608 ; N GMRA,GMRAL ; FOR DEBUGGING, DON'T NEW THESE VARIABLES91609 "RTN","C0CALERT",30,0)91610 S GMRA="0^0^111"91611 "RTN","C0CALERT",31,0)91612 D EN1^GMRADPT91613 "RTN","C0CALERT",32,0)91614 I $G(GMRAL)'=1 D Q ; NO ALLERGIES FOUND THUS *QUIT*91615 "RTN","C0CALERT",33,0)91616 . S @ALTOUTXML@(0)=091617 "RTN","C0CALERT",34,0)91618 ; DEFINE MAPPING91619 "RTN","C0CALERT",35,0)91620 N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP91621 "RTN","C0CALERT",36,0)91622 S ALTTVMAP=$NA(^TMP("C0CCCR",$J,"ALERTS"))91623 "RTN","C0CALERT",37,0)91624 S ALTTARYTMP=$NA(^TMP("C0CCCR",$J,"ALERTSARYTMP"))91625 "RTN","C0CALERT",38,0)91626 K @ALTTVMAP,@ALTTARYTMP91627 "RTN","C0CALERT",39,0)91628 N ALTTMP,ALTCNT S ALTG=$NA(GMRAL),ALTCNT=191629 "RTN","C0CALERT",40,0)91630 S ALTTMP="" ;91631 "RTN","C0CALERT",41,0)91632 F S ALTTMP=$O(@ALTG@(ALTTMP)) Q:ALTTMP="" D ; CHANGED TO $O BY GPL91633 "RTN","C0CALERT",42,0)91634 . W "ALTTMP="_ALTTMP,!91635 "RTN","C0CALERT",43,0)91636 . ; I $QS(ALTTMP,2)="S" W !,"S FOUND",! Q91637 "RTN","C0CALERT",44,0)91638 . S ALTVMAP=$NA(@ALTTVMAP@(ALTCNT))91639 "RTN","C0CALERT",45,0)91640 . K @ALTVMAP91641 "RTN","C0CALERT",46,0)91642 . S @ALTVMAP@("ALERTOBJECTID")="ALERT"_ALTCNT91643 "RTN","C0CALERT",47,0)91644 . N A1 S A1=@ALTG@(ALTTMP) ; ALL THE PIECES91645 "RTN","C0CALERT",48,0)91646 . I $D(CALLBK) D @CALLBK ;CALLBACK FOR EPRESCRIBING91647 "RTN","C0CALERT",49,0)91648 . N A2 S A2=$$GET1^DIQ(120.8,ALTTMP,"MECHANISM","I") ; MECHANISM91649 "RTN","C0CALERT",50,0)91650 . N A3 S A3=$P(A1,U,5) ; ADVERSE FLAG91651 "RTN","C0CALERT",51,0)91652 . N ADT S ADT="Patient has an " ; X $ZINT H 591653 "RTN","C0CALERT",52,0)91654 . S ADT=ADT_$S(A2="P":"ADVERSE",A2="A":"ALLERGIC",1:"UNKNOWN")91655 "RTN","C0CALERT",53,0)91656 . S ADT=ADT_" reaction to "_$P(@ALTG@(ALTTMP),U,2)_"."91657 "RTN","C0CALERT",54,0)91658 . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT91659 "RTN","C0CALERT",55,0)91660 . N ADTY S ADTY=$S(A2="P":"Adverse Reaction",A2="A":"Allergy",1:"") ;91661 "RTN","C0CALERT",56,0)91662 . S @ALTVMAP@("ALERTTYPE")=ADTY ; type of allergy91663 "RTN","C0CALERT",57,0)91664 . N ALTCDE ; SNOMED CODE THE THE ALERT91665 "RTN","C0CALERT",58,0)91666 . S ALTCDE=$S(A2="P":"282100009",A2="A":"416098002",1:"") ; IF NOT ADVERSE, IT IS ALLERGIC91667 "RTN","C0CALERT",59,0)91668 . S @ALTVMAP@("ALERTCODEVALUE")=ALTCDE ;91669 "RTN","C0CALERT",60,0)91670 . ; WILL USE 418634005 FOR ALLERGIC REACTION TO A SUBSTANCE91671 "RTN","C0CALERT",61,0)91672 . ; AND 282100009 FOR ADVERSE REACTION TO A SUBSTANCE91673 "RTN","C0CALERT",62,0)91674 . I ALTCDE'="" D ; IF THERE IS A CODE91675 "RTN","C0CALERT",63,0)91676 . . S @ALTVMAP@("ALERTCODESYSTEM")="SNOMED CT"91677 "RTN","C0CALERT",64,0)91678 . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")="2008"91679 "RTN","C0CALERT",65,0)91680 . E D ; SET TO NULL91681 "RTN","C0CALERT",66,0)91682 . . S @ALTVMAP@("ALERTCODESYSTEM")=""91683 "RTN","C0CALERT",67,0)91684 . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")=""91685 "RTN","C0CALERT",68,0)91686 . S @ALTVMAP@("ALERTSTATUSTEXT")="" ; WHERE DO WE GET THIS?91687 "RTN","C0CALERT",69,0)91688 . N ALTPROV S ALTPROV=$P(^GMR(120.8,ALTTMP,0),U,5) ; SOURCE PROVIDER IEN91689 "RTN","C0CALERT",70,0)91690 . I ALTPROV'="" D ; PROVIDER PROVIDEED91691 "RTN","C0CALERT",71,0)91692 . . S @ALTVMAP@("ALERTSOURCEID")="ACTORPROVIDER_"_ALTPROV91693 "RTN","C0CALERT",72,0)91694 . E S @ALTVMAP@("ALERTSOURCEID")="" ; SOURCE NULL - SHOULD NOT HAPPEN91695 "RTN","C0CALERT",73,0)91696 . W "RUNNING ALERTS, PROVIDER: ",@ALTVMAP@("ALERTSOURCEID"),!91697 "RTN","C0CALERT",74,0)91698 . N ACGL1,ACGFI,ACIEN,ACVUID,ACNM,ACTMP91699 "RTN","C0CALERT",75,0)91700 . S ACGL1=$P(@ALTG@(ALTTMP),U,9) ; ADDRESS OF THE REACTANT XX;GLB(YY.Z,91701 "RTN","C0CALERT",76,0)91702 . S ACGFI=$$PRSGLB($P(ACGL1,";",2)) ; FILE NUMBER91703 "RTN","C0CALERT",77,0)91704 . S ACIEN=$P(ACGL1,";",1) ; IEN OF REACTANT91705 "RTN","C0CALERT",78,0)91706 . S ACVUID=$$GET1^DIQ(ACGFI,ACIEN,"VUID") ; VUID OF THE REACTANT91707 "RTN","C0CALERT",79,0)91708 . S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="PRODUCT_"_ACIEN ; IE OF REACTANT91709 "RTN","C0CALERT",80,0)91710 . S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="" ; WHERE DO WE GET THIS?91711 "RTN","C0CALERT",81,0)91712 . S ACNM=$P(@ALTG@(ALTTMP),U,2) ; REACTANT91713 "RTN","C0CALERT",82,0)91714 . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM91715 "RTN","C0CALERT",83,0)91716 . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION91717 "RTN","C0CALERT",84,0)91718 . S (ZC,ZCD,ZCDS,ZCDSV)="" ; INITIALIZE91719 "RTN","C0CALERT",85,0)91720 . I ACVUID'="" D ; IF VUID IS NOT NULL91721 "RTN","C0CALERT",86,0)91722 . . S ZC=$$CODE^C0CUTIL(ACVUID)91723 "RTN","C0CALERT",87,0)91724 . . S ZCD=$P(ZC,"^",1) ; CODE TO USE91725 "RTN","C0CALERT",88,0)91726 . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID91727 "RTN","C0CALERT",89,0)91728 . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION91729 "RTN","C0CALERT",90,0)91730 . E D ; IF REACTANT CODE VALUE IS NULL91731 "RTN","C0CALERT",91,0)91732 . . I $G(DUZ("AG"))="I" D ; IF WE ARE RUNNING ON RPMS91733 "RTN","C0CALERT",92,0)91734 . . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ;91735 "RTN","C0CALERT",93,0)91736 . . . W "RPMS NAME FOUND",ACNM," ",ACTMP,!91737 "RTN","C0CALERT",94,0)91738 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=""91739 "RTN","C0CALERT",95,0)91740 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=""91741 "RTN","C0CALERT",96,0)91742 . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ZCD91743 "RTN","C0CALERT",97,0)91744 . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=ZCDS91745 "RTN","C0CALERT",98,0)91746 . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM_" "_ZCDS_": "_ZCD91747 "RTN","C0CALERT",99,0)91748 . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT_" "_ZCDS_": "_ZCD91749 "RTN","C0CALERT",100,0)91750 . ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW91751 "RTN","C0CALERT",101,0)91752 . N ARTMP,ARIEN,ARDES,ARVUID91753 "RTN","C0CALERT",102,0)91754 . S (ARTMP,ARDES,ARVUID)=""91755 "RTN","C0CALERT",103,0)91756 . I $D(@ALTG@(ALTTMP,"S",1)) D ; IF REACTION EXISTS91757 "RTN","C0CALERT",104,0)91758 . . S ARTMP=@ALTG@(ALTTMP,"S",1)91759 "RTN","C0CALERT",105,0)91760 . . W "REACTION:",ARTMP,!91761 "RTN","C0CALERT",106,0)91762 . . S ARIEN=$P(ARTMP,";",2)91763 "RTN","C0CALERT",107,0)91764 . . S ARDES=$P(ARTMP,";",1)91765 "RTN","C0CALERT",108,0)91766 . . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID")91767 "RTN","C0CALERT",109,0)91768 . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES91769 "RTN","C0CALERT",110,0)91770 . I ARVUID'="" D ; IF REACTION VUID IS NOT NULL91771 "RTN","C0CALERT",111,0)91772 . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID91773 "RTN","C0CALERT",112,0)91774 . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID"91775 "RTN","C0CALERT",113,0)91776 . E D ; IF IT IS NULL DON'T SET CODE SYSTEM91777 "RTN","C0CALERT",114,0)91778 . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=""91779 "RTN","C0CALERT",115,0)91780 . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")=""91781 "RTN","C0CALERT",116,0)91782 . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))91783 "RTN","C0CALERT",117,0)91784 . ; NOW GO TO THE GLOBAL TO GET THE DATE/TIME AND BETTER DESCRIPTION91785 "RTN","C0CALERT",118,0)91786 . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL91787 "RTN","C0CALERT",119,0)91788 . D GETN1^C0CRNF("C0CG1",120.8,ALTTMP,"") ;GET VALUES BY NAME91789 "RTN","C0CALERT",120,0)91790 . S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1")91791 "RTN","C0CALERT",121,0)91792 . S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT,"DT")91793 "RTN","C0CALERT",122,0)91794 . K @ALTARYTMP91795 "RTN","C0CALERT",123,0)91796 . D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP)91797 "RTN","C0CALERT",124,0)91798 . I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML)91799 "RTN","C0CALERT",125,0)91800 . I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP)91801 "RTN","C0CALERT",126,0)91802 . S ALTCNT=ALTCNT+191803 91809 "RTN","C0CALERT",127,0) 91804 S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS 91810 PRSGLB(INGLB) ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER 91805 91811 "RTN","C0CALERT",128,0) 91806 Q91812 ; INGLB IS OF THE FORM: PSNDF(50.6, 91807 91813 "RTN","C0CALERT",129,0) 91808 PRSGLB(INGLB) ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER 91814 ; RETURN 50.6 91809 91815 "RTN","C0CALERT",130,0) 91810 ; INGLB IS OF THE FORM: PSNDF(50.6,91811 "RTN","C0CALERT",131,0)91812 ; RETURN 50.691813 "RTN","C0CALERT",132,0)91814 91816 Q $P($P(INGLB,"(",2),",",1) ; 91815 91817 "RTN","C0CBAT") 91816 0^57^B56 97157491818 0^57^B56229594 91817 91819 "RTN","C0CBAT",1,0) 91818 91820 C0CBAT ; CCDCCR/GPL - CCR Batch utilities; 4/21/09 91819 91821 "RTN","C0CBAT",2,0) 91820 ;;1.2;C 0C;;May 11, 2012;Build 5091822 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 91821 91823 "RTN","C0CBAT",3,0) 91822 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU91824 ;Copyright 2009 George Lilly. 91823 91825 "RTN","C0CBAT",4,0) 91824 ; General Public License See attached copy of the License.91826 ; 91825 91827 "RTN","C0CBAT",5,0) 91826 ; 91828 ; This program is free software: you can redistribute it and/or modify 91827 91829 "RTN","C0CBAT",6,0) 91828 ; This program is free software; you can redistribute it and/or modify91830 ; it under the terms of the GNU Affero General Public License as 91829 91831 "RTN","C0CBAT",7,0) 91830 ; it under the terms of the GNU General Public License as published by91832 ; published by the Free Software Foundation, either version 3 of the 91831 91833 "RTN","C0CBAT",8,0) 91832 ; the Free Software Foundation; either version 2 of the License, or91834 ; License, or (at your option) any later version. 91833 91835 "RTN","C0CBAT",9,0) 91834 ; (at your option) any later version.91836 ; 91835 91837 "RTN","C0CBAT",10,0) 91836 ; 91838 ; This program is distributed in the hope that it will be useful, 91837 91839 "RTN","C0CBAT",11,0) 91838 ; This program is distributed in the hope that it will be useful,91840 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 91839 91841 "RTN","C0CBAT",12,0) 91840 ; but WITHOUT ANY WARRANTY; without even the implied warranty of91842 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 91841 91843 "RTN","C0CBAT",13,0) 91842 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the91844 ; GNU Affero General Public License for more details. 91843 91845 "RTN","C0CBAT",14,0) 91844 ; GNU General Public License for more details.91846 ; 91845 91847 "RTN","C0CBAT",15,0) 91846 ; 91848 ; You should have received a copy of the GNU Affero General Public License 91847 91849 "RTN","C0CBAT",16,0) 91848 ; You should have received a copy of the GNU General Public License along91850 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 91849 91851 "RTN","C0CBAT",17,0) 91850 ; with this program; if not, write to the Free Software Foundation, Inc.,91852 ; 91851 91853 "RTN","C0CBAT",18,0) 91852 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.91854 ; 91853 91855 "RTN","C0CBAT",19,0) 91854 ;91856 W "This is the CCR Batch Utility Library ",! 91855 91857 "RTN","C0CBAT",20,0) 91856 W "This is the CCR Batch Utility Library ",!91858 Q 91857 91859 "RTN","C0CBAT",21,0) 91860 ; 91861 "RTN","C0CBAT",22,0) 91862 STOP ; STOP A CURRENTLY RUNNING BATCH JOB 91863 "RTN","C0CBAT",23,0) 91864 I '$D(^TMP("C0CBAT","RUNNING")) Q ; 91865 "RTN","C0CBAT",24,0) 91866 W !,!,"HALTING CCR BATCH",! 91867 "RTN","C0CBAT",25,0) 91868 S ^TMP("C0CBAT","STOP")="" ; SIGNAL JOB TO TERMINATE 91869 "RTN","C0CBAT",26,0) 91870 H 10 ; WAIT TEN SECONDS FOR SIGNAL TO BE RECEIVED 91871 "RTN","C0CBAT",27,0) 91872 I '$D(^TMP("C0CBAT","STOP")) D ; SIGNAL RECEIVED 91873 "RTN","C0CBAT",28,0) 91874 . W "CCR BATCH JOB TERMINATING",! 91875 "RTN","C0CBAT",29,0) 91876 E D ; 91877 "RTN","C0CBAT",30,0) 91878 . K ^TMP("C0CBAT","STOP") ; STOP SIGNALING 91879 "RTN","C0CBAT",31,0) 91880 . W !,"BATCH PROCESSING APPARENTLY NOT RUNNING",! 91881 "RTN","C0CBAT",32,0) 91858 91882 Q 91859 "RTN","C0CBAT",22,0)91860 ;91861 "RTN","C0CBAT",23,0)91862 STOP ; STOP A CURRENTLY RUNNING BATCH JOB91863 "RTN","C0CBAT",24,0)91864 I '$D(^TMP("C0CBAT","RUNNING")) Q ;91865 "RTN","C0CBAT",25,0)91866 W !,!,"HALTING CCR BATCH",!91867 "RTN","C0CBAT",26,0)91868 S ^TMP("C0CBAT","STOP")="" ; SIGNAL JOB TO TERMINATE91869 "RTN","C0CBAT",27,0)91870 H 10 ; WAIT TEN SECONDS FOR SIGNAL TO BE RECEIVED91871 "RTN","C0CBAT",28,0)91872 I '$D(^TMP("C0CBAT","STOP")) D ; SIGNAL RECEIVED91873 "RTN","C0CBAT",29,0)91874 . W "CCR BATCH JOB TERMINATING",!91875 "RTN","C0CBAT",30,0)91876 E D ;91877 "RTN","C0CBAT",31,0)91878 . K ^TMP("C0CBAT","STOP") ; STOP SIGNALING91879 "RTN","C0CBAT",32,0)91880 . W !,"BATCH PROCESSING APPARENTLY NOT RUNNING",!91881 91883 "RTN","C0CBAT",33,0) 91884 ; 91885 "RTN","C0CBAT",34,0) 91886 START ; STARTS A TAKSMAN CCR BATCH JOB - FOR USE IN A MENU OPTION 91887 "RTN","C0CBAT",35,0) 91888 ; 91889 "RTN","C0CBAT",36,0) 91890 I $D(^TMP("C0CBAT","RUNNING")) D Q ; ONLY ONE ALLOWED AT A TIME 91891 "RTN","C0CBAT",37,0) 91892 . W !,"CCR BATCH ALREADY RUNNING",! 91893 "RTN","C0CBAT",38,0) 91894 . W !,"STOP FIRST WITH STOP^C0CBAT",! 91895 "RTN","C0CBAT",39,0) 91896 N ZTRTN,ZTDESC,ZTDTH,ZTSAVE,ZTSK,ZTIO 91897 "RTN","C0CBAT",40,0) 91898 S ZTRTN="EN^C0CBAT",ZTDESC="CCR Batch" 91899 "RTN","C0CBAT",41,0) 91900 S ZTDTH=$H ; 91901 "RTN","C0CBAT",42,0) 91902 ;S ZTDTH=$S(($P(ZTDTH,",",2)+10)\86400:(1+ZTDTH)_","_((($P(ZTDTH,",",2)+10)#86400)/100000),1:(+ZTDTH)_","_($P(ZTDTH,",",2)+10)) 91903 "RTN","C0CBAT",43,0) 91904 S ZTSAVE("C0C")="",ZTSAVE("C0C*")="" 91905 "RTN","C0CBAT",44,0) 91906 S ZTIO="NULL" ; 91907 "RTN","C0CBAT",45,0) 91908 W !,!,"CCR BATCH JOB STARTED",! 91909 "RTN","C0CBAT",46,0) 91910 D ^%ZTLOAD 91911 "RTN","C0CBAT",47,0) 91882 91912 Q 91883 "RTN","C0CBAT",34,0)91884 ;91885 "RTN","C0CBAT",35,0)91886 START ; STARTS A TAKSMAN CCR BATCH JOB - FOR USE IN A MENU OPTION91887 "RTN","C0CBAT",36,0)91888 ;91889 "RTN","C0CBAT",37,0)91890 I $D(^TMP("C0CBAT","RUNNING")) D Q ; ONLY ONE ALLOWED AT A TIME91891 "RTN","C0CBAT",38,0)91892 . W !,"CCR BATCH ALREADY RUNNING",!91893 "RTN","C0CBAT",39,0)91894 . W !,"STOP FIRST WITH STOP^C0CBAT",!91895 "RTN","C0CBAT",40,0)91896 N ZTRTN,ZTDESC,ZTDTH,ZTSAVE,ZTSK,ZTIO91897 "RTN","C0CBAT",41,0)91898 S ZTRTN="EN^C0CBAT",ZTDESC="CCR Batch"91899 "RTN","C0CBAT",42,0)91900 S ZTDTH=$H ;91901 "RTN","C0CBAT",43,0)91902 ;S ZTDTH=$S(($P(ZTDTH,",",2)+10)\86400:(1+ZTDTH)_","_((($P(ZTDTH,",",2)+10)#86400)/100000),1:(+ZTDTH)_","_($P(ZTDTH,",",2)+10))91903 "RTN","C0CBAT",44,0)91904 S ZTSAVE("C0C")="",ZTSAVE("C0C*")=""91905 "RTN","C0CBAT",45,0)91906 S ZTIO="NULL" ;91907 "RTN","C0CBAT",46,0)91908 W !,!,"CCR BATCH JOB STARTED",!91909 "RTN","C0CBAT",47,0)91910 D ^%ZTLOAD91911 91913 "RTN","C0CBAT",48,0) 91914 ; 91915 "RTN","C0CBAT",49,0) 91916 EN ; BATCH ENTRY POINT 91917 "RTN","C0CBAT",50,0) 91918 ; PROCESSES THE SUBSCRIPTION FILE, EXTRACTING CCR VARIABLES FOR EACH 91919 "RTN","C0CBAT",51,0) 91920 ; PATIENT WITH AN ACTIVE SUBSCRIPTION, AND IF CHECKSUMS INDICATE A CHANGE, 91921 "RTN","C0CBAT",52,0) 91922 ; GENERATES A NEW CCR FOR THE PATIENT 91923 "RTN","C0CBAT",53,0) 91924 ; UPDATES THE E2 CCR ELEMENTS FILE 91925 "RTN","C0CBAT",54,0) 91926 ; 91927 "RTN","C0CBAT",55,0) 91928 S C0CQT=1 ; QUIET MODE 91929 "RTN","C0CBAT",56,0) 91930 I $D(^TMP("C0CBAT","RUNNING")) Q ; ONLY ONE AT A TIME 91931 "RTN","C0CBAT",57,0) 91932 S ^TMP("C0CBAT","RUNNING")="" ; RUNNING SIGNAL 91933 "RTN","C0CBAT",58,0) 91934 S C0CBDT=$$NOW^XLFDT ; DATE OF THIS RUN 91935 "RTN","C0CBAT",59,0) 91936 S C0CBF=177.301 ; FILE NUMBER OF C0C BATCH CONTROL FILE 91937 "RTN","C0CBAT",60,0) 91938 S C0CBFR=177.3013 ; FILE NUMBER OF UPDATE SUBFILE 91939 "RTN","C0CBAT",61,0) 91940 S C0CBB=$NA(^TMP("C0CBATCH",C0CBDT)) ; BATCH WORK AREA 91941 "RTN","C0CBAT",62,0) 91942 I $D(@C0CBB@(0)) D ; ERROR SHOULDN'T EXIST 91943 "RTN","C0CBAT",63,0) 91944 . W "WORK AREA ERROR",! 91945 "RTN","C0CBAT",64,0) 91946 . S $EC=",U1," 91947 "RTN","C0CBAT",65,0) 91948 S @C0CBB@(0)="V22" ; VERSION USED TO CREATE THIS WORK AREA 91949 "RTN","C0CBAT",66,0) 91950 S C0CBH=$NA(@C0CBB@("HOTLIST")) ; BASE FOR HOT LIST 91951 "RTN","C0CBAT",67,0) 91952 S C0CBS=$NA(^C0CS("B")) ; SUBSCRIPTION LIST BASE 91953 "RTN","C0CBAT",68,0) 91954 ;I $D(^C0CB("B",C0CDT)) D ; BATCH RECORD EXISTS 91955 "RTN","C0CBAT",69,0) 91956 ;. H 10 ; HANG 10 SECONDS 91957 "RTN","C0CBAT",70,0) 91958 ;. S C0CBDT=$$NOW^XLFDT ; NEW DATE FOR THIS RUN 91959 "RTN","C0CBAT",71,0) 91960 ;. I $D(^C0CB("B",C0CDT)) B ;DIDN'T WORK 91961 "RTN","C0CBAT",72,0) 91962 D BLDHOT(C0CBH) ; BUILD THE HOT LIST 91963 "RTN","C0CBAT",73,0) 91964 S C0CHN=$$COUNT(C0CBH) ;COUNT NUMBER IN HOT LIST 91965 "RTN","C0CBAT",74,0) 91966 S C0CSN=$$COUNT(C0CBS) ;COUNT NUMBER OF PATIENTS WITH SUBSCRIPTIONS 91967 "RTN","C0CBAT",75,0) 91968 S C0CFDA(C0CBF,"+1,",.01)=C0CBDT ; DATE KEY OF BATCH CONTROL 91969 "RTN","C0CBAT",76,0) 91970 S C0CFDA(C0CBF,"+1,",.02)=C0CBDT ; BATCH ID IS DATE IN STRING FORM 91971 "RTN","C0CBAT",77,0) 91972 S C0CFDA(C0CBF,"+1,",1)=C0CSN ; TOTAL SUBSCRIPTIONS 91973 "RTN","C0CBAT",78,0) 91974 S C0CFDA(C0CBF,"+1,",2)=C0CHN ; TOTAL HOT LIST 91975 "RTN","C0CBAT",79,0) 91976 D UPDIE ; CREATE THE BATCH RECORD 91977 "RTN","C0CBAT",80,0) 91978 S C0CIEN=$O(^C0CB("B",C0CBDT,"")) 91979 "RTN","C0CBAT",81,0) 91980 S (C0CN,C0CNH)=0 ; COUNTERS FOR TOTAL AND HOT LIST 91981 "RTN","C0CBAT",82,0) 91982 S C0CBCUR="" ; CURRENT PATIENT 91983 "RTN","C0CBAT",83,0) 91984 S C0CSTOP=0 ; STOP FLAG FOR HALTING BATCH SET ^TMP("C0CBAT","STOP")="" 91985 "RTN","C0CBAT",84,0) 91986 ;F S C0CBCUR=$O(@C0CBH@(C0CBCUR),-1) Q:C0CBCUR="" D ; HOT LIST LATEST FIRST 91987 "RTN","C0CBAT",85,0) 91988 F S C0CBCUR=$O(@C0CBH@(C0CBCUR)) Q:(C0CSTOP)!(C0CBCUR="") D ; HOT LIST FIRST 91989 "RTN","C0CBAT",86,0) 91990 . D ANALYZE^C0CRIMA(C0CBCUR,1,"LABLIMIT:T-900^VITLIMIT:T-900") 91991 "RTN","C0CBAT",87,0) 91992 . I $G(C0CCHK) D ; 91993 "RTN","C0CBAT",88,0) 91994 . . D PUTRIM^C0CFM2(C0CBCUR) 91995 "RTN","C0CBAT",89,0) 91996 . . D XPAT^C0CCCR(C0CBCUR) ; IF VARIABLES HAVE CHANGED GENERATE CCR 91997 "RTN","C0CBAT",90,0) 91998 . . K C0CFDA 91999 "RTN","C0CBAT",91,0) 92000 . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",.01)=C0CBCUR 92001 "RTN","C0CBAT",92,0) 92002 . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",1)="Y" 92003 "RTN","C0CBAT",93,0) 92004 . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",2)=$G(^TMP("C0CCCR","FNAME",C0CBCUR)) 92005 "RTN","C0CBAT",94,0) 92006 . . D UPDIE ; CREATE UPDATE SUBFILE 92007 "RTN","C0CBAT",95,0) 92008 . S C0CN=C0CN+1 ; INCREMENT NUMBER IN TOTAL 92009 "RTN","C0CBAT",96,0) 92010 . S C0CNH=C0CNH+1 ; INCREMENT HOT LIST TOTAL 92011 "RTN","C0CBAT",97,0) 92012 . S C0CFDA(C0CBF,C0CIEN_",",1.1)=C0CN ;UPDATE TOTAL PROGRESS 92013 "RTN","C0CBAT",98,0) 92014 . S C0CFDA(C0CBF,C0CIEN_",",2.1)=C0CNH ; UPDATE HOT LIST PROGRESS 92015 "RTN","C0CBAT",99,0) 92016 . S C0CNOW=$$NOW^XLFDT 92017 "RTN","C0CBAT",100,0) 92018 . S C0CFDA(C0CBF,C0CIEN_",",4)=C0CNOW ; LAST UPDATED FIELD 92019 "RTN","C0CBAT",101,0) 92020 . S C0CELPS=$$FMDIFF^XLFDT(C0CNOW,C0CBDT,2) ; DIFFERENCE IN SECONDS 92021 "RTN","C0CBAT",102,0) 92022 . S C0CAVG=C0CELPS/C0CN ; AVERAGE ELAPSED TIME 92023 "RTN","C0CBAT",103,0) 92024 . S C0CFDA(C0CBF,C0CIEN_",",4.1)=C0CAVG ; AVERAGE ELAPSED TIME 92025 "RTN","C0CBAT",104,0) 92026 . S C0CETOT=C0CAVG*C0CSN ; EST TOT ELASPSED TIME 92027 "RTN","C0CBAT",105,0) 92028 . S C0CEST=$$FMADD^XLFDT(C0CBDT,0,0,0,C0CETOT) ; ADD SECONDS TO BATCH START 92029 "RTN","C0CBAT",106,0) 92030 . S C0CFDA(C0CBF,C0CIEN_",",4.2)=C0CEST ;ESTIMATED COMPLETION TIME 92031 "RTN","C0CBAT",107,0) 92032 . S C0CFDA(C0CBF,C0CIEN_",",5)=C0CBCUR ; LAST RECORD PROCESSED 92033 "RTN","C0CBAT",108,0) 92034 . D UPDIE ; 92035 "RTN","C0CBAT",109,0) 92036 . I $D(^TMP("C0CBAT","STOP")) D ; IF STOP SIGNAL DETECTED 92037 "RTN","C0CBAT",110,0) 92038 . . S C0CSTOP=1 92039 "RTN","C0CBAT",111,0) 92040 . . K ^TMP("C0CBAT","STOP") ; SIGNAL RECEIVED 92041 "RTN","C0CBAT",112,0) 92042 . H 1 ; GIVE OTHERS A CHANCE 92043 "RTN","C0CBAT",113,0) 92044 F S C0CBCUR=$O(@C0CBS@(C0CBCUR)) Q:(C0CSTOP)!(C0CBCUR="") D ; SUBS LIST 92045 "RTN","C0CBAT",114,0) 92046 . I $D(@C0CBH@(C0CBCUR)) Q ; SKIP IF IN HOT LIST - ALREADY DONE 92047 "RTN","C0CBAT",115,0) 92048 . D ANALYZE^C0CRIMA(C0CBCUR,1,"LABLIMIT:T-760^VITLIMIT:T-760") 92049 "RTN","C0CBAT",116,0) 92050 . I $G(C0CCHK) D ; IF CHECKSUMS HAVE CHANGED 92051 "RTN","C0CBAT",117,0) 92052 . . D PUTRIM^C0CFM2(C0CBCUR) 92053 "RTN","C0CBAT",118,0) 92054 . . D XPAT^C0CCCR(C0CBCUR) ; IF VARIABLES HAVE CHANGED GENERATE CCR 92055 "RTN","C0CBAT",119,0) 92056 . . K C0CFDA 92057 "RTN","C0CBAT",120,0) 92058 . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",.01)=C0CBCUR 92059 "RTN","C0CBAT",121,0) 92060 . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",1)="Y" 92061 "RTN","C0CBAT",122,0) 92062 . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",2)=$G(^TMP("C0CCCR","FNAME",C0CBCUR)) 92063 "RTN","C0CBAT",123,0) 92064 . . D UPDIE ; CREATE UPDATE SUBFILE 92065 "RTN","C0CBAT",124,0) 92066 . S C0CN=C0CN+1 ; INCREMENT NUMBER IN TOTAL 92067 "RTN","C0CBAT",125,0) 92068 . S C0CFDA(C0CBF,C0CIEN_",",1.1)=C0CN ;UPDATE TOTAL PROGRESS 92069 "RTN","C0CBAT",126,0) 92070 . S C0CNOW=$$NOW^XLFDT 92071 "RTN","C0CBAT",127,0) 92072 . S C0CFDA(C0CBF,C0CIEN_",",4)=C0CNOW ; LAST UPDATED FIELD 92073 "RTN","C0CBAT",128,0) 92074 . S C0CELPS=$$FMDIFF^XLFDT(C0CNOW,C0CBDT,2) ; DIFFERENCE IN SECONDS 92075 "RTN","C0CBAT",129,0) 92076 . S C0CAVG=C0CELPS/C0CN ; AVERAGE ELAPSED TIME 92077 "RTN","C0CBAT",130,0) 92078 . S C0CFDA(C0CBF,C0CIEN_",",4.1)=C0CAVG ; AVERAGE ELAPSED TIME 92079 "RTN","C0CBAT",131,0) 92080 . S C0CETOT=C0CAVG*C0CSN ; EST TOT ELASPSED TIME 92081 "RTN","C0CBAT",132,0) 92082 . S C0CEST=$$FMADD^XLFDT(C0CBDT,0,0,0,C0CETOT) ; ADD SECONDS TO BATCH START 92083 "RTN","C0CBAT",133,0) 92084 . S C0CFDA(C0CBF,C0CIEN_",",4.2)=C0CEST ;ESTIMATED COMPLETION TIME 92085 "RTN","C0CBAT",134,0) 92086 . S C0CFDA(C0CBF,C0CIEN_",",5)=C0CBCUR ; 92087 "RTN","C0CBAT",135,0) 92088 . D UPDIE ; 92089 "RTN","C0CBAT",136,0) 92090 . I $D(^TMP("C0CBAT","STOP")) D ; IF STOP SIGNAL DETECTED 92091 "RTN","C0CBAT",137,0) 92092 . . S C0CSTOP=1 92093 "RTN","C0CBAT",138,0) 92094 . . K ^TMP("C0CBAT","STOP") ; SIGNAL RECEIVED 92095 "RTN","C0CBAT",139,0) 92096 . H 1 ; GIVE IT A BREAK 92097 "RTN","C0CBAT",140,0) 92098 I (C0CSTOP) S C0CDISP="KILLED" 92099 "RTN","C0CBAT",141,0) 92100 E S C0CDISP="FINISHED" 92101 "RTN","C0CBAT",142,0) 92102 S C0CFDA(C0CBF,C0CIEN_",",6)=C0CDISP 92103 "RTN","C0CBAT",143,0) 92104 D UPDIE ; SET DISPOSITION FIELD 92105 "RTN","C0CBAT",144,0) 92106 K ^TMP("C0CBAT","RUNNING") 92107 "RTN","C0CBAT",145,0) 91912 92108 Q 91913 "RTN","C0CBAT",49,0)91914 ;91915 "RTN","C0CBAT",50,0)91916 EN ; BATCH ENTRY POINT91917 "RTN","C0CBAT",51,0)91918 ; PROCESSES THE SUBSCRIPTION FILE, EXTRACTING CCR VARIABLES FOR EACH91919 "RTN","C0CBAT",52,0)91920 ; PATIENT WITH AN ACTIVE SUBSCRIPTION, AND IF CHECKSUMS INDICATE A CHANGE,91921 "RTN","C0CBAT",53,0)91922 ; GENERATES A NEW CCR FOR THE PATIENT91923 "RTN","C0CBAT",54,0)91924 ; UPDATES THE E2 CCR ELEMENTS FILE91925 "RTN","C0CBAT",55,0)91926 ;91927 "RTN","C0CBAT",56,0)91928 S C0CQT=1 ; QUIET MODE91929 "RTN","C0CBAT",57,0)91930 I $D(^TMP("C0CBAT","RUNNING")) Q ; ONLY ONE AT A TIME91931 "RTN","C0CBAT",58,0)91932 S ^TMP("C0CBAT","RUNNING")="" ; RUNNING SIGNAL91933 "RTN","C0CBAT",59,0)91934 S C0CBDT=$$NOW^XLFDT ; DATE OF THIS RUN91935 "RTN","C0CBAT",60,0)91936 S C0CBF=177.301 ; FILE NUMBER OF C0C BATCH CONTROL FILE91937 "RTN","C0CBAT",61,0)91938 S C0CBFR=177.3013 ; FILE NUMBER OF UPDATE SUBFILE91939 "RTN","C0CBAT",62,0)91940 S C0CBB=$NA(^TMP("C0CBATCH",C0CBDT)) ; BATCH WORK AREA91941 "RTN","C0CBAT",63,0)91942 I $D(@C0CBB@(0)) D ; ERROR SHOULDN'T EXIST91943 "RTN","C0CBAT",64,0)91944 . W "WORK AREA ERROR",!91945 "RTN","C0CBAT",65,0)91946 . B91947 "RTN","C0CBAT",66,0)91948 S @C0CBB@(0)="V22" ; VERSION USED TO CREATE THIS WORK AREA91949 "RTN","C0CBAT",67,0)91950 S C0CBH=$NA(@C0CBB@("HOTLIST")) ; BASE FOR HOT LIST91951 "RTN","C0CBAT",68,0)91952 S C0CBS=$NA(^C0CS("B")) ; SUBSCRIPTION LIST BASE91953 "RTN","C0CBAT",69,0)91954 ;I $D(^C0CB("B",C0CDT)) D ; BATCH RECORD EXISTS91955 "RTN","C0CBAT",70,0)91956 ;. H 10 ; HANG 10 SECONDS91957 "RTN","C0CBAT",71,0)91958 ;. S C0CBDT=$$NOW^XLFDT ; NEW DATE FOR THIS RUN91959 "RTN","C0CBAT",72,0)91960 ;. I $D(^C0CB("B",C0CDT)) B ;DIDN'T WORK91961 "RTN","C0CBAT",73,0)91962 D BLDHOT(C0CBH) ; BUILD THE HOT LIST91963 "RTN","C0CBAT",74,0)91964 S C0CHN=$$COUNT(C0CBH) ;COUNT NUMBER IN HOT LIST91965 "RTN","C0CBAT",75,0)91966 S C0CSN=$$COUNT(C0CBS) ;COUNT NUMBER OF PATIENTS WITH SUBSCRIPTIONS91967 "RTN","C0CBAT",76,0)91968 S C0CFDA(C0CBF,"+1,",.01)=C0CBDT ; DATE KEY OF BATCH CONTROL91969 "RTN","C0CBAT",77,0)91970 S C0CFDA(C0CBF,"+1,",.02)=C0CBDT ; BATCH ID IS DATE IN STRING FORM91971 "RTN","C0CBAT",78,0)91972 S C0CFDA(C0CBF,"+1,",1)=C0CSN ; TOTAL SUBSCRIPTIONS91973 "RTN","C0CBAT",79,0)91974 S C0CFDA(C0CBF,"+1,",2)=C0CHN ; TOTAL HOT LIST91975 "RTN","C0CBAT",80,0)91976 D UPDIE ; CREATE THE BATCH RECORD91977 "RTN","C0CBAT",81,0)91978 S C0CIEN=$O(^C0CB("B",C0CBDT,""))91979 "RTN","C0CBAT",82,0)91980 S (C0CN,C0CNH)=0 ; COUNTERS FOR TOTAL AND HOT LIST91981 "RTN","C0CBAT",83,0)91982 S C0CBCUR="" ; CURRENT PATIENT91983 "RTN","C0CBAT",84,0)91984 S C0CSTOP=0 ; STOP FLAG FOR HALTING BATCH SET ^TMP("C0CBAT","STOP")=""91985 "RTN","C0CBAT",85,0)91986 ;F S C0CBCUR=$O(@C0CBH@(C0CBCUR),-1) Q:C0CBCUR="" D ; HOT LIST LATEST FIRST91987 "RTN","C0CBAT",86,0)91988 F S C0CBCUR=$O(@C0CBH@(C0CBCUR)) Q:(C0CSTOP)!(C0CBCUR="") D ; HOT LIST FIRST91989 "RTN","C0CBAT",87,0)91990 . D ANALYZE^C0CRIMA(C0CBCUR,1,"LABLIMIT:T-900^VITLIMIT:T-900")91991 "RTN","C0CBAT",88,0)91992 . I $G(C0CCHK) D ;91993 "RTN","C0CBAT",89,0)91994 . . D PUTRIM^C0CFM2(C0CBCUR)91995 "RTN","C0CBAT",90,0)91996 . . D XPAT^C0CCCR(C0CBCUR) ; IF VARIABLES HAVE CHANGED GENERATE CCR91997 "RTN","C0CBAT",91,0)91998 . . K C0CFDA91999 "RTN","C0CBAT",92,0)92000 . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",.01)=C0CBCUR92001 "RTN","C0CBAT",93,0)92002 . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",1)="Y"92003 "RTN","C0CBAT",94,0)92004 . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",2)=$G(^TMP("C0CCCR","FNAME",C0CBCUR))92005 "RTN","C0CBAT",95,0)92006 . . D UPDIE ; CREATE UPDATE SUBFILE92007 "RTN","C0CBAT",96,0)92008 . S C0CN=C0CN+1 ; INCREMENT NUMBER IN TOTAL92009 "RTN","C0CBAT",97,0)92010 . S C0CNH=C0CNH+1 ; INCREMENT HOT LIST TOTAL92011 "RTN","C0CBAT",98,0)92012 . S C0CFDA(C0CBF,C0CIEN_",",1.1)=C0CN ;UPDATE TOTAL PROGRESS92013 "RTN","C0CBAT",99,0)92014 . S C0CFDA(C0CBF,C0CIEN_",",2.1)=C0CNH ; UPDATE HOT LIST PROGRESS92015 "RTN","C0CBAT",100,0)92016 . S C0CNOW=$$NOW^XLFDT92017 "RTN","C0CBAT",101,0)92018 . S C0CFDA(C0CBF,C0CIEN_",",4)=C0CNOW ; LAST UPDATED FIELD92019 "RTN","C0CBAT",102,0)92020 . S C0CELPS=$$FMDIFF^XLFDT(C0CNOW,C0CBDT,2) ; DIFFERENCE IN SECONDS92021 "RTN","C0CBAT",103,0)92022 . S C0CAVG=C0CELPS/C0CN ; AVERAGE ELAPSED TIME92023 "RTN","C0CBAT",104,0)92024 . S C0CFDA(C0CBF,C0CIEN_",",4.1)=C0CAVG ; AVERAGE ELAPSED TIME92025 "RTN","C0CBAT",105,0)92026 . S C0CETOT=C0CAVG*C0CSN ; EST TOT ELASPSED TIME92027 "RTN","C0CBAT",106,0)92028 . S C0CEST=$$FMADD^XLFDT(C0CBDT,0,0,0,C0CETOT) ; ADD SECONDS TO BATCH START92029 "RTN","C0CBAT",107,0)92030 . S C0CFDA(C0CBF,C0CIEN_",",4.2)=C0CEST ;ESTIMATED COMPLETION TIME92031 "RTN","C0CBAT",108,0)92032 . S C0CFDA(C0CBF,C0CIEN_",",5)=C0CBCUR ; LAST RECORD PROCESSED92033 "RTN","C0CBAT",109,0)92034 . D UPDIE ;92035 "RTN","C0CBAT",110,0)92036 . I $D(^TMP("C0CBAT","STOP")) D ; IF STOP SIGNAL DETECTED92037 "RTN","C0CBAT",111,0)92038 . . S C0CSTOP=192039 "RTN","C0CBAT",112,0)92040 . . K ^TMP("C0CBAT","STOP") ; SIGNAL RECEIVED92041 "RTN","C0CBAT",113,0)92042 . H 1 ; GIVE OTHERS A CHANCE92043 "RTN","C0CBAT",114,0)92044 F S C0CBCUR=$O(@C0CBS@(C0CBCUR)) Q:(C0CSTOP)!(C0CBCUR="") D ; SUBS LIST92045 "RTN","C0CBAT",115,0)92046 . I $D(@C0CBH@(C0CBCUR)) Q ; SKIP IF IN HOT LIST - ALREADY DONE92047 "RTN","C0CBAT",116,0)92048 . D ANALYZE^C0CRIMA(C0CBCUR,1,"LABLIMIT:T-760^VITLIMIT:T-760")92049 "RTN","C0CBAT",117,0)92050 . I $G(C0CCHK) D ; IF CHECKSUMS HAVE CHANGED92051 "RTN","C0CBAT",118,0)92052 . . D PUTRIM^C0CFM2(C0CBCUR)92053 "RTN","C0CBAT",119,0)92054 . . D XPAT^C0CCCR(C0CBCUR) ; IF VARIABLES HAVE CHANGED GENERATE CCR92055 "RTN","C0CBAT",120,0)92056 . . K C0CFDA92057 "RTN","C0CBAT",121,0)92058 . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",.01)=C0CBCUR92059 "RTN","C0CBAT",122,0)92060 . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",1)="Y"92061 "RTN","C0CBAT",123,0)92062 . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",2)=$G(^TMP("C0CCCR","FNAME",C0CBCUR))92063 "RTN","C0CBAT",124,0)92064 . . D UPDIE ; CREATE UPDATE SUBFILE92065 "RTN","C0CBAT",125,0)92066 . S C0CN=C0CN+1 ; INCREMENT NUMBER IN TOTAL92067 "RTN","C0CBAT",126,0)92068 . S C0CFDA(C0CBF,C0CIEN_",",1.1)=C0CN ;UPDATE TOTAL PROGRESS92069 "RTN","C0CBAT",127,0)92070 . S C0CNOW=$$NOW^XLFDT92071 "RTN","C0CBAT",128,0)92072 . S C0CFDA(C0CBF,C0CIEN_",",4)=C0CNOW ; LAST UPDATED FIELD92073 "RTN","C0CBAT",129,0)92074 . S C0CELPS=$$FMDIFF^XLFDT(C0CNOW,C0CBDT,2) ; DIFFERENCE IN SECONDS92075 "RTN","C0CBAT",130,0)92076 . S C0CAVG=C0CELPS/C0CN ; AVERAGE ELAPSED TIME92077 "RTN","C0CBAT",131,0)92078 . S C0CFDA(C0CBF,C0CIEN_",",4.1)=C0CAVG ; AVERAGE ELAPSED TIME92079 "RTN","C0CBAT",132,0)92080 . S C0CETOT=C0CAVG*C0CSN ; EST TOT ELASPSED TIME92081 "RTN","C0CBAT",133,0)92082 . S C0CEST=$$FMADD^XLFDT(C0CBDT,0,0,0,C0CETOT) ; ADD SECONDS TO BATCH START92083 "RTN","C0CBAT",134,0)92084 . S C0CFDA(C0CBF,C0CIEN_",",4.2)=C0CEST ;ESTIMATED COMPLETION TIME92085 "RTN","C0CBAT",135,0)92086 . S C0CFDA(C0CBF,C0CIEN_",",5)=C0CBCUR ;92087 "RTN","C0CBAT",136,0)92088 . D UPDIE ;92089 "RTN","C0CBAT",137,0)92090 . I $D(^TMP("C0CBAT","STOP")) D ; IF STOP SIGNAL DETECTED92091 "RTN","C0CBAT",138,0)92092 . . S C0CSTOP=192093 "RTN","C0CBAT",139,0)92094 . . K ^TMP("C0CBAT","STOP") ; SIGNAL RECEIVED92095 "RTN","C0CBAT",140,0)92096 . H 1 ; GIVE IT A BREAK92097 "RTN","C0CBAT",141,0)92098 I (C0CSTOP) S C0CDISP="KILLED"92099 "RTN","C0CBAT",142,0)92100 E S C0CDISP="FINISHED"92101 "RTN","C0CBAT",143,0)92102 S C0CFDA(C0CBF,C0CIEN_",",6)=C0CDISP92103 "RTN","C0CBAT",144,0)92104 D UPDIE ; SET DISPOSITION FIELD92105 "RTN","C0CBAT",145,0)92106 K ^TMP("C0CBAT","RUNNING")92107 92109 "RTN","C0CBAT",146,0) 92110 ; 92111 "RTN","C0CBAT",147,0) 92112 BLDHOT(ZHB) ; BUILD HOT LIST AT GLOBAL ZHB, PASSED BY NAME 92113 "RTN","C0CBAT",148,0) 92114 ; SEARCHS FOR PATIENTS IN THE "AC" INDEX OF THE ORDER FILE 92115 "RTN","C0CBAT",149,0) 92116 N ZDFN 92117 "RTN","C0CBAT",150,0) 92118 S ZDFN="" 92119 "RTN","C0CBAT",151,0) 92120 F S ZDFN=$O(^OR(100,"AC",ZDFN)) Q:ZDFN="" D ; ALL PATIENTS IN THE AC INDX 92121 "RTN","C0CBAT",152,0) 92122 . S ZZDFN=$P(ZDFN,";",1) ; FORMAT IS "N;DPT(" 92123 "RTN","C0CBAT",153,0) 92124 . I '$D(@C0CBS@(ZZDFN)) Q ; SKIP IF NOT IN SUBSCRIPTION LIST 92125 "RTN","C0CBAT",154,0) 92126 . S @ZHB@(ZZDFN)="" ;ADD PATIENT TO THE HOT LIST 92127 "RTN","C0CBAT",155,0) 92108 92128 Q 92109 "RTN","C0CBAT",147,0)92110 ;92111 "RTN","C0CBAT",148,0)92112 BLDHOT(ZHB) ; BUILD HOT LIST AT GLOBAL ZHB, PASSED BY NAME92113 "RTN","C0CBAT",149,0)92114 ; SEARCHS FOR PATIENTS IN THE "AC" INDEX OF THE ORDER FILE92115 "RTN","C0CBAT",150,0)92116 N ZDFN92117 "RTN","C0CBAT",151,0)92118 S ZDFN=""92119 "RTN","C0CBAT",152,0)92120 F S ZDFN=$O(^OR(100,"AC",ZDFN)) Q:ZDFN="" D ; ALL PATIENTS IN THE AC INDX92121 "RTN","C0CBAT",153,0)92122 . S ZZDFN=$P(ZDFN,";",1) ; FORMAT IS "N;DPT("92123 "RTN","C0CBAT",154,0)92124 . I '$D(@C0CBS@(ZZDFN)) Q ; SKIP IF NOT IN SUBSCRIPTION LIST92125 "RTN","C0CBAT",155,0)92126 . S @ZHB@(ZZDFN)="" ;ADD PATIENT TO THE HOT LIST92127 92129 "RTN","C0CBAT",156,0) 92130 ; 92131 "RTN","C0CBAT",157,0) 92132 COUNT(ZB) ; EXTRINSIC THAT RETURNS THE NUMBER OF ARRAY ELEMENTS 92133 "RTN","C0CBAT",158,0) 92134 N ZI,ZN 92135 "RTN","C0CBAT",159,0) 92136 S ZN=0 92137 "RTN","C0CBAT",160,0) 92138 S ZI="" 92139 "RTN","C0CBAT",161,0) 92140 F S ZI=$O(@ZB@(ZI)) Q:ZI="" D ; 92141 "RTN","C0CBAT",162,0) 92142 . S ZN=ZN+1 92143 "RTN","C0CBAT",163,0) 92144 Q ZN 92145 "RTN","C0CBAT",164,0) 92146 ; 92147 "RTN","C0CBAT",165,0) 92148 UVARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE 92149 "RTN","C0CBAT",166,0) 92150 ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO 92151 "RTN","C0CBAT",167,0) 92152 ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO 92153 "RTN","C0CBAT",168,0) 92154 ; 92155 "RTN","C0CBAT",169,0) 92156 N ZCCRD,ZVARN,C0CFDA2 92157 "RTN","C0CBAT",170,0) 92158 S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY 92159 "RTN","C0CBAT",171,0) 92160 S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE 92161 "RTN","C0CBAT",172,0) 92162 I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT 92163 "RTN","C0CBAT",173,0) 92164 . I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE 92165 "RTN","C0CBAT",174,0) 92166 . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,! 92167 "RTN","C0CBAT",175,0) 92168 . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE 92169 "RTN","C0CBAT",176,0) 92170 . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE 92171 "RTN","C0CBAT",177,0) 92172 . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN 92173 "RTN","C0CBAT",178,0) 92174 . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY 92175 "RTN","C0CBAT",179,0) 92176 . I $D(ZERR) D ; LAYGO ERROR 92177 "RTN","C0CBAT",180,0) 92178 . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",! 92179 "RTN","C0CBAT",181,0) 92180 . E D ; 92181 "RTN","C0CBAT",182,0) 92182 . . D CLEAN^DILF ; CLEAN UP 92183 "RTN","C0CBAT",183,0) 92184 . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE 92185 "RTN","C0CBAT",184,0) 92186 . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,! 92187 "RTN","C0CBAT",185,0) 92188 Q ZVARN 92189 "RTN","C0CBAT",186,0) 92190 ; 92191 "RTN","C0CBAT",187,0) 92192 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 92193 "RTN","C0CBAT",188,0) 92194 K ZERR 92195 "RTN","C0CBAT",189,0) 92196 D CLEAN^DILF 92197 "RTN","C0CBAT",190,0) 92198 D UPDATE^DIE("","C0CFDA","","ZERR") 92199 "RTN","C0CBAT",191,0) 92200 I $D(ZERR) S $EC=",U1," 92201 "RTN","C0CBAT",192,0) 92202 K C0CFDA 92203 "RTN","C0CBAT",193,0) 92128 92204 Q 92129 "RTN","C0CBAT",157,0)92130 ;92131 "RTN","C0CBAT",158,0)92132 COUNT(ZB) ; EXTRINSIC THAT RETURNS THE NUMBER OF ARRAY ELEMENTS92133 "RTN","C0CBAT",159,0)92134 N ZI,ZN92135 "RTN","C0CBAT",160,0)92136 S ZN=092137 "RTN","C0CBAT",161,0)92138 S ZI=""92139 "RTN","C0CBAT",162,0)92140 F S ZI=$O(@ZB@(ZI)) Q:ZI="" D ;92141 "RTN","C0CBAT",163,0)92142 . S ZN=ZN+192143 "RTN","C0CBAT",164,0)92144 Q ZN92145 "RTN","C0CBAT",165,0)92146 ;92147 "RTN","C0CBAT",166,0)92148 UPDIEVARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE92149 "RTN","C0CBAT",167,0)92150 ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO92151 "RTN","C0CBAT",168,0)92152 ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO92153 "RTN","C0CBAT",169,0)92154 ;92155 "RTN","C0CBAT",170,0)92156 N ZCCRD,ZVARN,C0CFDA292157 "RTN","C0CBAT",171,0)92158 S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY92159 "RTN","C0CBAT",172,0)92160 S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE92161 "RTN","C0CBAT",173,0)92162 I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT92163 "RTN","C0CBAT",174,0)92164 . I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE92165 "RTN","C0CBAT",175,0)92166 . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!92167 "RTN","C0CBAT",176,0)92168 . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE92169 "RTN","C0CBAT",177,0)92170 . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE92171 "RTN","C0CBAT",178,0)92172 . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN92173 "RTN","C0CBAT",179,0)92174 . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY92175 "RTN","C0CBAT",180,0)92176 . I $D(ZERR) D ; LAYGO ERROR92177 "RTN","C0CBAT",181,0)92178 . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!92179 "RTN","C0CBAT",182,0)92180 . E D ;92181 "RTN","C0CBAT",183,0)92182 . . D CLEAN^DILF ; CLEAN UP92183 "RTN","C0CBAT",184,0)92184 . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE92185 "RTN","C0CBAT",185,0)92186 . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!92187 "RTN","C0CBAT",186,0)92188 Q ZVARN92189 "RTN","C0CBAT",187,0)92190 ;92191 "RTN","C0CBAT",188,0)92192 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS92193 "RTN","C0CBAT",189,0)92194 K ZERR92195 "RTN","C0CBAT",190,0)92196 D CLEAN^DILF92197 "RTN","C0CBAT",191,0)92198 D UPDATE^DIE("","C0CFDA","","ZERR")92199 "RTN","C0CBAT",192,0)92200 I $D(ZERR) D ;92201 "RTN","C0CBAT",193,0)92202 . W "ERROR",!92203 92205 "RTN","C0CBAT",194,0) 92204 . ZWR ZERR92206 ; 92205 92207 "RTN","C0CBAT",195,0) 92206 . B 92208 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN 92207 92209 "RTN","C0CBAT",196,0) 92208 K C0CFDA92210 ; TO SET TO VALUE C0CSV. 92209 92211 "RTN","C0CBAT",197,0) 92212 ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE 92213 "RTN","C0CBAT",198,0) 92214 ; C0CSN,C0CSV ARE PASSED BY VALUE 92215 "RTN","C0CBAT",199,0) 92216 ; 92217 "RTN","C0CBAT",200,0) 92218 N C0CSI,C0CSJ 92219 "RTN","C0CBAT",201,0) 92220 S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER 92221 "RTN","C0CBAT",202,0) 92222 S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER 92223 "RTN","C0CBAT",203,0) 92224 S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV 92225 "RTN","C0CBAT",204,0) 92210 92226 Q 92211 "RTN","C0CBAT",198,0)92212 ;92213 "RTN","C0CBAT",199,0)92214 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN92215 "RTN","C0CBAT",200,0)92216 ; TO SET TO VALUE C0CSV.92217 "RTN","C0CBAT",201,0)92218 ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE92219 "RTN","C0CBAT",202,0)92220 ; C0CSN,C0CSV ARE PASSED BY VALUE92221 "RTN","C0CBAT",203,0)92222 ;92223 "RTN","C0CBAT",204,0)92224 N C0CSI,C0CSJ92225 92227 "RTN","C0CBAT",205,0) 92226 S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER 92228 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 92227 92229 "RTN","C0CBAT",206,0) 92228 S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER92230 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN) 92229 92231 "RTN","C0CBAT",207,0) 92230 S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV92232 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 92231 92233 "RTN","C0CBAT",208,0) 92232 Q92234 I '$D(ZTAB) S ZTAB="C0CA" 92233 92235 "RTN","C0CBAT",209,0) 92234 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 92236 N ZR 92235 92237 "RTN","C0CBAT",210,0) 92236 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)92238 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1) 92237 92239 "RTN","C0CBAT",211,0) 92240 E S ZR="" 92241 "RTN","C0CBAT",212,0) 92242 Q ZR 92243 "RTN","C0CBAT",213,0) 92244 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED 92245 "RTN","C0CBAT",214,0) 92246 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN) 92247 "RTN","C0CBAT",215,0) 92238 92248 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 92239 "RTN","C0CBAT",21 2,0)92249 "RTN","C0CBAT",216,0) 92240 92250 I '$D(ZTAB) S ZTAB="C0CA" 92241 "RTN","C0CBAT",21 3,0)92251 "RTN","C0CBAT",217,0) 92242 92252 N ZR 92243 "RTN","C0CBAT",21 4,0)92244 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^", 1)92245 "RTN","C0CBAT",21 5,0)92253 "RTN","C0CBAT",218,0) 92254 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2) 92255 "RTN","C0CBAT",219,0) 92246 92256 E S ZR="" 92247 "RTN","C0CBAT",2 16,0)92257 "RTN","C0CBAT",220,0) 92248 92258 Q ZR 92249 "RTN","C0CBAT",217,0) 92250 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED 92251 "RTN","C0CBAT",218,0) 92252 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN) 92253 "RTN","C0CBAT",219,0) 92259 "RTN","C0CBAT",221,0) 92260 ; 92261 "RTN","C0CBAT",222,0) 92262 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED 92263 "RTN","C0CBAT",223,0) 92264 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN) 92265 "RTN","C0CBAT",224,0) 92254 92266 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 92255 "RTN","C0CBAT",22 0,0)92267 "RTN","C0CBAT",225,0) 92256 92268 I '$D(ZTAB) S ZTAB="C0CA" 92257 "RTN","C0CBAT",22 1,0)92269 "RTN","C0CBAT",226,0) 92258 92270 N ZR 92259 "RTN","C0CBAT",22 2,0)92260 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^", 2)92261 "RTN","C0CBAT",22 3,0)92271 "RTN","C0CBAT",227,0) 92272 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3) 92273 "RTN","C0CBAT",228,0) 92262 92274 E S ZR="" 92263 "RTN","C0CBAT",22 4,0)92275 "RTN","C0CBAT",229,0) 92264 92276 Q ZR 92265 "RTN","C0CBAT",225,0)92266 ;92267 "RTN","C0CBAT",226,0)92268 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED92269 "RTN","C0CBAT",227,0)92270 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)92271 "RTN","C0CBAT",228,0)92272 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA92273 "RTN","C0CBAT",229,0)92274 I '$D(ZTAB) S ZTAB="C0CA"92275 92277 "RTN","C0CBAT",230,0) 92276 N ZR92277 "RTN","C0CBAT",231,0)92278 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)92279 "RTN","C0CBAT",232,0)92280 E S ZR=""92281 "RTN","C0CBAT",233,0)92282 Q ZR92283 "RTN","C0CBAT",234,0)92284 92278 ; 92285 92279 "RTN","C0CCCD") 92286 0^45^B 11413404992280 0^45^B89035344 92287 92281 "RTN","C0CCCD",1,0) 92288 92282 C0CCCD ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08 92289 92283 "RTN","C0CCCD",2,0) 92290 ;;1.2;C 0C;;May 11, 2012;Build 5092284 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 92291 92285 "RTN","C0CCCD",3,0) 92292 92286 ;Copyright 2008,2009 George Lilly, University of Minnesota. 92293 92287 "RTN","C0CCCD",4,0) 92294 ; Licensed under the terms of the GNU General Public License.92288 ; 92295 92289 "RTN","C0CCCD",5,0) 92296 ; See attached copy of the License.92290 ; This program is free software: you can redistribute it and/or modify 92297 92291 "RTN","C0CCCD",6,0) 92298 ; 92292 ; it under the terms of the GNU Affero General Public License as 92299 92293 "RTN","C0CCCD",7,0) 92300 ; This program is free software; you can redistribute it and/or modify92294 ; published by the Free Software Foundation, either version 3 of the 92301 92295 "RTN","C0CCCD",8,0) 92302 ; it under the terms of the GNU General Public License as published by92296 ; License, or (at your option) any later version. 92303 92297 "RTN","C0CCCD",9,0) 92304 ; the Free Software Foundation; either version 2 of the License, or92298 ; 92305 92299 "RTN","C0CCCD",10,0) 92306 ; (at your option) any later version.92300 ; This program is distributed in the hope that it will be useful, 92307 92301 "RTN","C0CCCD",11,0) 92308 ; 92302 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 92309 92303 "RTN","C0CCCD",12,0) 92310 ; This program is distributed in the hope that it will be useful,92304 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 92311 92305 "RTN","C0CCCD",13,0) 92312 ; but WITHOUT ANY WARRANTY; without even the implied warranty of92306 ; GNU Affero General Public License for more details. 92313 92307 "RTN","C0CCCD",14,0) 92314 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the92308 ; 92315 92309 "RTN","C0CCCD",15,0) 92316 ; GNU General Public License for more details.92310 ; You should have received a copy of the GNU Affero General Public License 92317 92311 "RTN","C0CCCD",16,0) 92318 ; 92312 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 92319 92313 "RTN","C0CCCD",17,0) 92320 ; You should have received a copy of the GNU General Public License along92314 ; 92321 92315 "RTN","C0CCCD",18,0) 92322 ; with this program; if not, write to the Free Software Foundation, Inc.,92316 ; EXPORT A CCR 92323 92317 "RTN","C0CCCD",19,0) 92324 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.92318 ; 92325 92319 "RTN","C0CCCD",20,0) 92326 ; 92320 EXPORT ; EXPORT ENTRY POINT FOR CCR 92327 92321 "RTN","C0CCCD",21,0) 92328 ; EXPORT A CCR92322 ; Select a patient. 92329 92323 "RTN","C0CCCD",22,0) 92330 ;92324 S DIC=2,DIC(0)="AEMQ" D ^DIC 92331 92325 "RTN","C0CCCD",23,0) 92332 EXPORT ; EXPORT ENTRY POINT FOR CCR 92326 I Y<1 Q ; EXIT 92333 92327 "RTN","C0CCCD",24,0) 92334 ; Select a patient.92328 S DFN=$P(Y,U,1) ; SET THE PATIENT 92335 92329 "RTN","C0CCCD",25,0) 92336 S DIC=2,DIC(0)="AEMQ" D ^DIC92330 D XPAT(DFN,"","") ; EXPORT TO A FILE 92337 92331 "RTN","C0CCCD",26,0) 92338 I Y<1 Q ; EXIT92332 Q 92339 92333 "RTN","C0CCCD",27,0) 92340 S DFN=$P(Y,U,1) ; SET THE PATIENT92334 ; 92341 92335 "RTN","C0CCCD",28,0) 92342 D XPAT(DFN,"","") ; EXPORT TO A FILE92336 XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE 92343 92337 "RTN","C0CCCD",29,0) 92344 Q92338 ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR") 92345 92339 "RTN","C0CCCD",30,0) 92346 ;92340 ; FN IS FILE NAME, DEFAULTS IF NULL 92347 92341 "RTN","C0CCCD",31,0) 92348 XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE 92342 ; N CCDGLO 92349 92343 "RTN","C0CCCD",32,0) 92350 ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR")92344 D CCDRPC(.CCDGLO,DFN,"CCD","","","") 92351 92345 "RTN","C0CCCD",33,0) 92352 ; FN IS FILE NAME, DEFAULTS IF NULL92346 S OARY=$NA(^TMP("C0CCCR",$J,DFN,"CCD",1)) 92353 92347 "RTN","C0CCCD",34,0) 92354 ; N CCDGLO92348 S ONAM=FN 92355 92349 "RTN","C0CCCD",35,0) 92356 D CCDRPC(.CCDGLO,DFN,"CCD","","","")92350 I FN="" S ONAM="PAT_"_DFN_"_CCD_V1.xml" 92357 92351 "RTN","C0CCCD",36,0) 92358 S OARY=$NA(^TMP("C0CCCR",$J,DFN,"CCD",1))92352 S ODIRGLB=$NA(^TMP("C0CCCR","ODIR")) 92359 92353 "RTN","C0CCCD",37,0) 92360 S ONAM=FN92354 I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET 92361 92355 "RTN","C0CCCD",38,0) 92362 I FN="" S ONAM="PAT_"_DFN_"_CCD_V1.xml"92356 . S @ODIRGLB="/home/glilly/CCROUT" 92363 92357 "RTN","C0CCCD",39,0) 92364 S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))92358 . ;S @ODIRGLB="/home/cedwards/" 92365 92359 "RTN","C0CCCD",40,0) 92366 I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET92360 . ;S @ODIRGLB="/opt/wv/p/" 92367 92361 "RTN","C0CCCD",41,0) 92368 . S @ODIRGLB="/home/glilly/CCROUT"92362 S ODIR=DIR 92369 92363 "RTN","C0CCCD",42,0) 92370 . ;S @ODIRGLB="/home/cedwards/"92364 I DIR="" S ODIR=@ODIRGLB 92371 92365 "RTN","C0CCCD",43,0) 92372 . ;S @ODIRGLB="/opt/wv/p/"92366 N ZY 92373 92367 "RTN","C0CCCD",44,0) 92374 S ODIR=DIR92368 S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR) 92375 92369 "RTN","C0CCCD",45,0) 92376 I DIR="" S ODIR=@ODIRGLB92370 W $P(ZY,U,2) 92377 92371 "RTN","C0CCCD",46,0) 92378 N ZY92372 Q 92379 92373 "RTN","C0CCCD",47,0) 92380 S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR)92374 ; 92381 92375 "RTN","C0CCCD",48,0) 92382 W $P(ZY,U,2) 92376 CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT 92383 92377 "RTN","C0CCCD",49,0) 92384 Q92378 ; CCRGRTN IS RETURN ARRAY PASSED BY NAME 92385 92379 "RTN","C0CCCD",50,0) 92386 ;92380 ; DFN IS PATIENT IEN 92387 92381 "RTN","C0CCCD",51,0) 92388 CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT92382 ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART 92389 92383 "RTN","C0CCCD",52,0) 92390 ; CCRGRTN IS RETURN ARRAY PASSED BY NAME92384 ; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC 92391 92385 "RTN","C0CCCD",53,0) 92392 ; DFN IS PATIENT IEN92386 ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL 92393 92387 "RTN","C0CCCD",54,0) 92394 ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART92388 ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME 92395 92389 "RTN","C0CCCD",55,0) 92396 ; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC92390 ; - NULL MEANS NOW 92397 92391 "RTN","C0CCCD",56,0) 92398 ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL92392 ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND 92399 92393 "RTN","C0CCCD",57,0) 92400 ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME92394 ; "TO" VARIABLES 92401 92395 "RTN","C0CCCD",58,0) 92402 ; - NULL MEANS NOW92396 ; IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN 92403 92397 "RTN","C0CCCD",59,0) 92404 ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND92398 I '$D(DEBUG) S DEBUG=0 92405 92399 "RTN","C0CCCD",60,0) 92406 ; "TO" VARIABLES92400 N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD 92407 92401 "RTN","C0CCCD",61,0) 92408 ; IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN92402 I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD 92409 92403 "RTN","C0CCCD",62,0) 92410 I '$D(DEBUG) S DEBUG=092404 S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE 92411 92405 "RTN","C0CCCD",63,0) 92412 N CCD S CCD=0 ; FLAG FOR PROCESSING ACCD92406 I CCD S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD 92413 92407 "RTN","C0CCCD",64,0) 92414 I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD92408 E S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR 92415 92409 "RTN","C0CCCD",65,0) 92416 S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE92410 S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS 92417 92411 "RTN","C0CCCD",66,0) 92418 I CCD S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD92412 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC 92419 92413 "RTN","C0CCCD",67,0) 92420 E S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR92414 S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL 92421 92415 "RTN","C0CCCD",68,0) 92422 S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS92416 I CCD D LOAD^C0CCCD1(TGLOBAL) ; LOAD THE CCR TEMPLATE 92423 92417 "RTN","C0CCCD",69,0) 92424 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC92418 E D LOAD^C0CCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE 92425 92419 "RTN","C0CCCD",70,0) 92426 S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL92420 D CP^C0CXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL 92427 92421 "RTN","C0CCCD",71,0) 92428 I CCD D LOAD^C0CCCD1(TGLOBAL) ; LOAD THE CCR TEMPLATE92422 N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES 92429 92423 "RTN","C0CCCD",72,0) 92430 E D LOAD^C0CCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE92424 S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT 92431 92425 "RTN","C0CCCD",73,0) 92432 D CP^C0CXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL92426 S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD 92433 92427 "RTN","C0CCCD",74,0) 92434 N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES92428 S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT 92435 92429 "RTN","C0CCCD",75,0) 92436 S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT92430 S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO 92437 92431 "RTN","C0CCCD",76,0) 92438 S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD92432 S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP 92439 92433 "RTN","C0CCCD",77,0) 92440 S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT92434 S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP 92441 92435 "RTN","C0CCCD",78,0) 92442 S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO92436 ; 92443 92437 "RTN","C0CCCD",79,0) 92444 S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP92438 ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL 92445 92439 "RTN","C0CCCD",80,0) 92446 S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP92440 ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES 92447 92441 "RTN","C0CCCD",81,0) 92448 ;92442 D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body") 92449 92443 "RTN","C0CCCD",82,0) 92450 ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL92444 D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors") 92451 92445 "RTN","C0CCCD",83,0) 92452 ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES92446 I 'CCD D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures") 92453 92447 "RTN","C0CCCD",84,0) 92454 D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body")92448 I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),! 92455 92449 "RTN","C0CCCD",85,0) 92456 D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors")92450 ; 92457 92451 "RTN","C0CCCD",86,0) 92458 I 'CCD D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures")92452 I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES 92459 92453 "RTN","C0CCCD",87,0) 92460 I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),!92454 ; MAPPING THE PATIENT PORTION OF THE CDA HEADER 92461 92455 "RTN","C0CCCD",88,0) 92462 ;92456 S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient" 92463 92457 "RTN","C0CCCD",89,0) 92464 I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES92458 D QUERY^C0CXPATH(CCDGLO,ZZX,"ACTT1") 92465 92459 "RTN","C0CCCD",90,0) 92466 ; MAPPING THE PATIENT PORTION OF THE CDA HEADER92460 D PATIENT^C0CACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT 92467 92461 "RTN","C0CCCD",91,0) 92468 S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"92462 I DEBUG D PARY^C0CXPATH("ACTT2") 92469 92463 "RTN","C0CCCD",92,0) 92470 D QUERY^C0CXPATH(CCDGLO,ZZX,"ACTT1")92464 D REPLACE^C0CXPATH(CCDGLO,"ACTT2",ZZX) 92471 92465 "RTN","C0CCCD",93,0) 92472 D PATIENT^C0CACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT92466 I DEBUG D PARY^C0CXPATH(CCDGLO) 92473 92467 "RTN","C0CCCD",94,0) 92474 I DEBUG D PARY^C0CXPATH("ACTT2")92468 K ACTT1 K ACCT2 92475 92469 "RTN","C0CCCD",95,0) 92476 D REPLACE^C0CXPATH(CCDGLO,"ACTT2",ZZX)92470 ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER 92477 92471 "RTN","C0CCCD",96,0) 92478 I DEBUG D PARY^C0CXPATH(CCDGLO)92472 ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION 92479 92473 "RTN","C0CCCD",97,0) 92480 K ACTT1 K ACCT292474 D ORG^C0CACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG 92481 92475 "RTN","C0CCCD",98,0) 92482 ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER92476 D CP^C0CXPATH("ACTT2",CCDGLO) 92483 92477 "RTN","C0CCCD",99,0) 92484 ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION92478 ; 92485 92479 "RTN","C0CCCD",100,0) 92486 D ORG^C0CACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG92480 K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT 92487 92481 "RTN","C0CCCD",101,0) 92488 D CP^C0CXPATH("ACTT2",CCDGLO)92482 S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS 92489 92483 "RTN","C0CCCD",102,0) 92490 ;92484 D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS 92491 92485 "RTN","C0CCCD",103,0) 92492 K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT92486 N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD 92493 92487 "RTN","C0CCCD",104,0) 92494 S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS92488 F I=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS 92495 92489 "RTN","C0CCCD",105,0) 92496 D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS92490 . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE 92497 92491 "RTN","C0CCCD",106,0) 92498 N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD92492 . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL 92499 92493 "RTN","C0CCCD",107,0) 92500 F I=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS92494 . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL 92501 92495 "RTN","C0CCCD",108,0) 92502 . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE92496 . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE 92503 92497 "RTN","C0CCCD",109,0) 92504 . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL92498 . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS 92505 92499 "RTN","C0CCCD",110,0) 92506 . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL92500 . S IXML="INXML" 92507 92501 "RTN","C0CCCD",111,0) 92508 . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE92502 . I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION 92509 92503 "RTN","C0CCCD",112,0) 92510 . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS92504 . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES 92511 92505 "RTN","C0CCCD",113,0) 92512 . S IXML="INXML"92506 . ; W OXML,! 92513 92507 "RTN","C0CCCD",114,0) 92514 . I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION92508 . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL 92515 92509 "RTN","C0CCCD",115,0) 92516 . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES92510 . W "RUNNING ",CALL,! 92517 92511 "RTN","C0CCCD",116,0) 92518 . ; W OXML,!92512 . X CALL 92519 92513 "RTN","C0CCCD",117,0) 92520 . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL92514 . I @OXML@(0)'=0 D ; THERE IS A RESULT 92521 92515 "RTN","C0CCCD",118,0) 92522 . W "RUNNING ",CALL,!92516 . . I CCD D QUERY^C0CXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH 92523 92517 "RTN","C0CCCD",119,0) 92524 . X CALL92518 . . I CCD D UNSHAVE("ITMP",OXML) 92525 92519 "RTN","C0CCCD",120,0) 92526 . I @OXML@(0)'=0 D ; THERE IS A RESULT92520 . . I CCD D UNMARK^C0CXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION 92527 92521 "RTN","C0CCCD",121,0) 92528 . . I CCD D QUERY^C0CXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH92522 . ; NOW INSERT THE RESULTS IN THE CCR BUFFER 92529 92523 "RTN","C0CCCD",122,0) 92530 . . I CCD D UNSHAVE("ITMP",OXML)92524 . D INSERT^C0CXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body") 92531 92525 "RTN","C0CCCD",123,0) 92532 . . I CCD D UNMARK^C0CXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION92526 . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),! 92533 92527 "RTN","C0CCCD",124,0) 92534 . ; NOW INSERT THE RESULTS IN THE CCR BUFFER92528 ; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE 92535 92529 "RTN","C0CCCD",125,0) 92536 . D INSERT^C0CXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body")92530 ; D ACTLST^C0CCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST 92537 92531 "RTN","C0CCCD",126,0) 92538 . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!92532 ; D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT") 92539 92533 "RTN","C0CCCD",127,0) 92540 ; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE92534 ; D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2") 92541 92535 "RTN","C0CCCD",128,0) 92542 ; D ACTLST^C0CCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST92536 ; D INSINNER^C0CXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors") 92543 92537 "RTN","C0CCCD",129,0) 92544 ; D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")92538 N I,J,DONE S DONE=0 92545 92539 "RTN","C0CCCD",130,0) 92546 ; D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")92540 F I=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE 92547 92541 "RTN","C0CCCD",131,0) 92548 ; D INSINNER^C0CXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")92542 . S J=$$TRIM^C0CXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS 92549 92543 "RTN","C0CCCD",132,0) 92550 N I,J,DONE S DONE=092544 . W "TRIMMED",J,! 92551 92545 "RTN","C0CCCD",133,0) 92552 F I=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE92546 . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE 92553 92547 "RTN","C0CCCD",134,0) 92554 . S J=$$TRIM^C0CXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS92548 I CCD D ; TURN THE BODY INTO A CCD COMPONENT 92555 92549 "RTN","C0CCCD",135,0) 92556 . W "TRIMMED",J,!92550 . N I 92557 92551 "RTN","C0CCCD",136,0) 92558 . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE92552 . F I=1:1:@CCDGLO@(0) D ; SEARCH THROUGH THE ENTIRE ARRAY 92559 92553 "RTN","C0CCCD",137,0) 92560 I CCD D ; TURN THE BODY INTO A CCD COMPONENT92554 . . I @CCDGLO@(I)["<Body>" D ; REPLACE BODY MARKUP 92561 92555 "RTN","C0CCCD",138,0) 92562 . N I92556 . . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ 92563 92557 "RTN","C0CCCD",139,0) 92564 . F I=1:1:@CCDGLO@(0) D ; SEARCH THROUGH THE ENTIRE ARRAY92558 . . I @CCDGLO@(I)["</Body>" D ; REPLACE BODY MARKUP 92565 92559 "RTN","C0CCCD",140,0) 92566 . . I @CCDGLO@(I)["<Body>" D ; REPLACE BODY MARKUP92560 . . . S @CCDGLO@(I)="</structuredBody></component>" 92567 92561 "RTN","C0CCCD",141,0) 92568 . . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ92562 S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD 92569 92563 "RTN","C0CCCD",142,0) 92570 . . I @CCDGLO@(I)["</Body>" D ; REPLACE BODY MARKUP92564 S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE 92571 92565 "RTN","C0CCCD",143,0) 92572 . . . S @CCDGLO@(I)="</structuredBody></component>"92566 Q 92573 92567 "RTN","C0CCCD",144,0) 92574 S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD92568 ; 92575 92569 "RTN","C0CCCD",145,0) 92576 S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE 92570 INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS 92577 92571 "RTN","C0CCCD",146,0) 92578 Q92572 ; TAB IS PASSED BY NAME 92579 92573 "RTN","C0CCCD",147,0) 92580 ;92574 W "TAB= ",TAB,! 92581 92575 "RTN","C0CCCD",148,0) 92582 INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS92576 ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS 92583 92577 "RTN","C0CCCD",149,0) 92584 ; TAB IS PASSED BY NAME92578 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")") 92585 92579 "RTN","C0CCCD",150,0) 92586 W "TAB= ",TAB,!92580 ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")") 92587 92581 "RTN","C0CCCD",151,0) 92588 ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS92582 I 'CCD D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")") 92589 92583 "RTN","C0CCCD",152,0) 92590 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")")92584 Q 92591 92585 "RTN","C0CCCD",153,0) 92592 ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")92586 ; 92593 92587 "RTN","C0CCCD",154,0) 92594 I 'CCD D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")") 92588 SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT 92595 92589 "RTN","C0CCCD",155,0) 92596 Q92590 ; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION 92597 92591 "RTN","C0CCCD",156,0) 92598 ;92592 N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST 92599 92593 "RTN","C0CCCD",157,0) 92600 SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT 92594 W SHXML,! 92601 92595 "RTN","C0CCCD",158,0) 92602 ; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION92596 W @SHXML@(1),! 92603 92597 "RTN","C0CCCD",159,0) 92604 N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST92598 D QUEUE^C0CXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED 92605 92599 "RTN","C0CCCD",160,0) 92606 W SHXML,!92600 D QUEUE^C0CXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART 92607 92601 "RTN","C0CCCD",161,0) 92608 W @SHXML@(1),!92602 D QUEUE^C0CXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE 92609 92603 "RTN","C0CCCD",162,0) 92610 D QUEUE^C0CXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED92604 D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST 92611 92605 "RTN","C0CCCD",163,0) 92612 D QUEUE^C0CXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART92606 D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION 92613 92607 "RTN","C0CCCD",164,0) 92614 D QUEUE^C0CXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE92608 D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY 92615 92609 "RTN","C0CCCD",165,0) 92616 D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST92610 Q 92617 92611 "RTN","C0CCCD",166,0) 92618 D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION92612 ; 92619 92613 "RTN","C0CCCD",167,0) 92620 D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY 92614 UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE 92621 92615 "RTN","C0CCCD",168,0) 92622 Q92616 ; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML 92623 92617 "RTN","C0CCCD",169,0) 92624 ;92618 N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST 92625 92619 "RTN","C0CCCD",170,0) 92626 UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE 92620 W SHXML,! 92627 92621 "RTN","C0CCCD",171,0) 92628 ; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML92622 W @SHXML@(1),! 92629 92623 "RTN","C0CCCD",172,0) 92630 N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST92624 D QUEUE^C0CXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE 92631 92625 "RTN","C0CCCD",173,0) 92632 W SHXML,!92626 D QUEUE^C0CXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST 92633 92627 "RTN","C0CCCD",174,0) 92634 W @SHXML@(1),!92628 D QUEUE^C0CXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP 92635 92629 "RTN","C0CCCD",175,0) 92636 D QUEUE^C0CXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE92630 D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST 92637 92631 "RTN","C0CCCD",176,0) 92638 D QUEUE^C0CXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST92632 D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION 92639 92633 "RTN","C0CCCD",177,0) 92640 D QUEUE^C0CXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP92634 D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY 92641 92635 "RTN","C0CCCD",178,0) 92642 D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST92636 Q 92643 92637 "RTN","C0CCCD",179,0) 92644 D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION92638 ; 92645 92639 "RTN","C0CCCD",180,0) 92646 D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY 92640 HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT 92647 92641 "RTN","C0CCCD",181,0) 92648 Q92642 N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER")) 92649 92643 "RTN","C0CCCD",182,0) 92650 ;92644 ; K @VMAP 92651 92645 "RTN","C0CCCD",183,0) 92652 HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT 92646 S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT") 92653 92647 "RTN","C0CCCD",184,0) 92654 N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))92648 I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS 92655 92649 "RTN","C0CCCD",185,0) 92656 ; K @VMAP92650 . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN 92657 92651 "RTN","C0CCCD",186,0) 92658 S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")92652 . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ??? 92659 92653 "RTN","C0CCCD",187,0) 92660 I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS92654 . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM 92661 92655 "RTN","C0CCCD",188,0) 92662 . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN92656 . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES 92663 92657 "RTN","C0CCCD",189,0) 92664 . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???92658 . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES 92665 92659 "RTN","C0CCCD",190,0) 92666 . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM92660 . S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES 92667 92661 "RTN","C0CCCD",191,0) 92668 . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES92662 . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT 92669 92663 "RTN","C0CCCD",192,0) 92670 . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES92664 I IHDR'="" D ; HEADER VALUES ARE PROVIDED 92671 92665 "RTN","C0CCCD",193,0) 92672 . S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES92666 . D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY 92673 92667 "RTN","C0CCCD",194,0) 92674 . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT92668 N CTMP 92675 92669 "RTN","C0CCCD",195,0) 92676 I IHDR'="" D ; HEADER VALUES ARE PROVIDED92670 D MAP^C0CXPATH(CXML,VMAP,"CTMP") 92677 92671 "RTN","C0CCCD",196,0) 92678 . D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY92672 D CP^C0CXPATH("CTMP",CXML) 92679 92673 "RTN","C0CCCD",197,0) 92680 N CTMP92674 Q 92681 92675 "RTN","C0CCCD",198,0) 92682 D MAP^C0CXPATH(CXML,VMAP,"CTMP")92676 ; 92683 92677 "RTN","C0CCCD",199,0) 92684 D CP^C0CXPATH("CTMP",CXML) 92678 ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML 92685 92679 "RTN","C0CCCD",200,0) 92686 Q92680 ; AXML AND ACTRTN ARE PASSED BY NAME 92687 92681 "RTN","C0CCCD",201,0) 92688 ;92682 ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2 92689 92683 "RTN","C0CCCD",202,0) 92690 ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML 92684 ; P1= OBJECTID - ACTORPATIENT_2 92691 92685 "RTN","C0CCCD",203,0) 92692 ; AXML AND ACTRTN ARE PASSED BY NAME92686 ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE 92693 92687 "RTN","C0CCCD",204,0) 92694 ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_292688 ;OR INSTITUTION 92695 92689 "RTN","C0CCCD",205,0) 92696 ; P1= OBJECTID - ACTORPATIENT_292690 ; OR PERSON(IN PATIENT FILE IE NOK) 92697 92691 "RTN","C0CCCD",206,0) 92698 ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE92692 ; P3= IEN RECORD NUMBER FOR ACTOR - 2 92699 92693 "RTN","C0CCCD",207,0) 92700 ;OR INSTITUTION92694 N I,J,K,L 92701 92695 "RTN","C0CCCD",208,0) 92702 ; OR PERSON(IN PATIENT FILE IE NOK)92696 K @ACTRTN ; CLEAR RETURN ARRAY 92703 92697 "RTN","C0CCCD",209,0) 92704 ; P3= IEN RECORD NUMBER FOR ACTOR - 292698 F I=1:1:@AXML@(0) D ; SCAN ALL LINES 92705 92699 "RTN","C0CCCD",210,0) 92706 N I,J,K,L92700 . I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE 92707 92701 "RTN","C0CCCD",211,0) 92708 K @ACTRTN ; CLEAR RETURN ARRAY92702 . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1) 92709 92703 "RTN","C0CCCD",212,0) 92710 F I=1:1:@AXML@(0) D ; SCAN ALL LINES92704 . . W "<ActorID>=>",J,! 92711 92705 "RTN","C0CCCD",213,0) 92712 . I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE92706 . . I J'="" S K(J)="" ; HASHING ACTOR 92713 92707 "RTN","C0CCCD",214,0) 92714 . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)92708 . . ; TO GET RID OF DUPLICATES 92715 92709 "RTN","C0CCCD",215,0) 92716 . . W "<ActorID>=>",J,!92710 S I="" ; GOING TO $O THROUGH THE HASH 92717 92711 "RTN","C0CCCD",216,0) 92718 . . I J'="" S K(J)="" ; HASHING ACTOR92712 F J=0:0 D Q:$O(K(I))="" ; 92719 92713 "RTN","C0CCCD",217,0) 92720 . . ; TO GET RID OF DUPLICATES92714 . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS 92721 92715 "RTN","C0CCCD",218,0) 92722 S I="" ; GOING TO $O THROUGH THE HASH92716 . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID 92723 92717 "RTN","C0CCCD",219,0) 92724 F J=0:0 D Q:$O(K(I))="" ;92718 . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE 92725 92719 "RTN","C0CCCD",220,0) 92726 . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS92720 . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR 92727 92721 "RTN","C0CCCD",221,0) 92728 . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID92722 . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY 92729 92723 "RTN","C0CCCD",222,0) 92730 . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE92724 Q 92731 92725 "RTN","C0CCCD",223,0) 92732 . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR92726 ; 92733 92727 "RTN","C0CCCD",224,0) 92734 . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY 92728 TEST ; RUN ALL THE TEST CASES 92735 92729 "RTN","C0CCCD",225,0) 92736 Q92730 D TESTALL^C0CUNIT("C0CCCR") 92737 92731 "RTN","C0CCCD",226,0) 92738 ;92732 Q 92739 92733 "RTN","C0CCCD",227,0) 92740 TEST ; RUN ALL THE TEST CASES 92734 ; 92741 92735 "RTN","C0CCCD",228,0) 92742 D TESTALL^C0CUNIT("C0CCCR") 92736 ZTEST(WHICH) ; RUN ONE SET OF TESTS 92743 92737 "RTN","C0CCCD",229,0) 92744 Q92738 N ZTMP 92745 92739 "RTN","C0CCCD",230,0) 92746 ;92740 D ZLOAD^C0CUNIT("ZTMP","C0CCCR") 92747 92741 "RTN","C0CCCD",231,0) 92748 ZTEST(WHICH) ; RUN ONE SET OF TESTS 92742 D ZTEST^C0CUNIT(.ZTMP,WHICH) 92749 92743 "RTN","C0CCCD",232,0) 92750 N ZTMP92744 Q 92751 92745 "RTN","C0CCCD",233,0) 92752 D ZLOAD^C0CUNIT("ZTMP","C0CCCR")92746 ; 92753 92747 "RTN","C0CCCD",234,0) 92754 D ZTEST^C0CUNIT(.ZTMP,WHICH) 92748 TLIST ; LIST THE TESTS 92755 92749 "RTN","C0CCCD",235,0) 92756 Q92750 N ZTMP 92757 92751 "RTN","C0CCCD",236,0) 92758 ;92752 D ZLOAD^C0CUNIT("ZTMP","C0CCCR") 92759 92753 "RTN","C0CCCD",237,0) 92760 TLIST ; LIST THE TESTS 92754 D TLIST^C0CUNIT(.ZTMP) 92761 92755 "RTN","C0CCCD",238,0) 92762 N ZTMP92756 Q 92763 92757 "RTN","C0CCCD",239,0) 92764 D ZLOAD^C0CUNIT("ZTMP","C0CCCR")92758 ; 92765 92759 "RTN","C0CCCD",240,0) 92766 D TLIST^C0CUNIT(.ZTMP)92760 ;;><TEST> 92767 92761 "RTN","C0CCCD",241,0) 92768 Q92762 ;;><PROBLEMS> 92769 92763 "RTN","C0CCCD",242,0) 92770 ;92764 ;;>>>K C0C S C0C="" 92771 92765 "RTN","C0CCCD",243,0) 92772 ;;> <TEST>92766 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","","","") 92773 92767 "RTN","C0CCCD",244,0) 92774 ;;> <PROBLEMS>92768 ;;>>?@C0C@(@C0C@(0))["</Problems>" 92775 92769 "RTN","C0CCCD",245,0) 92770 ;;><VITALS> 92771 "RTN","C0CCCD",246,0) 92776 92772 ;;>>>K C0C S C0C="" 92777 "RTN","C0CCCD",246,0)92778 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","","","")92779 92773 "RTN","C0CCCD",247,0) 92780 ;;>> ?@C0C@(@C0C@(0))["</Problems>"92774 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","","","") 92781 92775 "RTN","C0CCCD",248,0) 92782 ;;> <VITALS>92776 ;;>>?@C0C@(@C0C@(0))["</VitalSigns>" 92783 92777 "RTN","C0CCCD",249,0) 92778 ;;><CCR> 92779 "RTN","C0CCCD",250,0) 92784 92780 ;;>>>K C0C S C0C="" 92785 "RTN","C0CCCD",250,0)92786 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","","","")92787 92781 "RTN","C0CCCD",251,0) 92788 ;;>> ?@C0C@(@C0C@(0))["</VitalSigns>"92782 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","") 92789 92783 "RTN","C0CCCD",252,0) 92790 ;;> <CCR>92784 ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>" 92791 92785 "RTN","C0CCCD",253,0) 92786 ;;><ACTLST> 92787 "RTN","C0CCCD",254,0) 92792 92788 ;;>>>K C0C S C0C="" 92793 "RTN","C0CCCD",25 4,0)92789 "RTN","C0CCCD",255,0) 92794 92790 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","") 92795 "RTN","C0CCCD",255,0) 92791 "RTN","C0CCCD",256,0) 92792 ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST") 92793 "RTN","C0CCCD",257,0) 92794 ;;><ACTORS> 92795 "RTN","C0CCCD",258,0) 92796 ;;>>>D ZTEST^C0CCCR("ACTLST") 92797 "RTN","C0CCCD",259,0) 92798 ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2") 92799 "RTN","C0CCCD",260,0) 92800 ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3") 92801 "RTN","C0CCCD",261,0) 92802 ;;>>?G3(G3(0))["</Actors>" 92803 "RTN","C0CCCD",262,0) 92804 ;;><TRIM> 92805 "RTN","C0CCCD",263,0) 92806 ;;>>>D ZTEST^C0CCCR("CCR") 92807 "RTN","C0CCCD",264,0) 92808 ;;>>>W $$TRIM^C0CXPATH(CCDGLO) 92809 "RTN","C0CCCD",265,0) 92810 ;;><CCD> 92811 "RTN","C0CCCD",266,0) 92812 ;;>>>K C0C S C0C="" 92813 "RTN","C0CCCD",267,0) 92814 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCD","","","") 92815 "RTN","C0CCCD",268,0) 92796 92816 ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>" 92797 "RTN","C0CCCD",256,0)92798 ;;><ACTLST>92799 "RTN","C0CCCD",257,0)92800 ;;>>>K C0C S C0C=""92801 "RTN","C0CCCD",258,0)92802 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","")92803 "RTN","C0CCCD",259,0)92804 ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST")92805 "RTN","C0CCCD",260,0)92806 ;;><ACTORS>92807 "RTN","C0CCCD",261,0)92808 ;;>>>D ZTEST^C0CCCR("ACTLST")92809 "RTN","C0CCCD",262,0)92810 ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")92811 "RTN","C0CCCD",263,0)92812 ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3")92813 "RTN","C0CCCD",264,0)92814 ;;>>?G3(G3(0))["</Actors>"92815 "RTN","C0CCCD",265,0)92816 ;;><TRIM>92817 "RTN","C0CCCD",266,0)92818 ;;>>>D ZTEST^C0CCCR("CCR")92819 "RTN","C0CCCD",267,0)92820 ;;>>>W $$TRIM^C0CXPATH(CCDGLO)92821 "RTN","C0CCCD",268,0)92822 ;;><CCD>92823 92817 "RTN","C0CCCD",269,0) 92824 ;;>>>K C0C S C0C=""92825 "RTN","C0CCCD",270,0)92826 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCD","","","")92827 "RTN","C0CCCD",271,0)92828 ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"92829 "RTN","C0CCCD",272,0)92830 92818 ;;></TEST> 92831 92819 "RTN","C0CCCD1") 92832 0^44^B 10063473792820 0^44^B96013153 92833 92821 "RTN","C0CCCD1",1,0) 92834 92822 C0CCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08 92835 92823 "RTN","C0CCCD1",2,0) 92836 ;;1.2;C 0C;;May 11, 2012;Build 5092824 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 92837 92825 "RTN","C0CCCD1",3,0) 92838 92826 ;Copyright 2008,2009 George Lilly, University of Minnesota. 92839 92827 "RTN","C0CCCD1",4,0) 92840 ; Licensed under the terms of the GNU General Public License.92828 ; 92841 92829 "RTN","C0CCCD1",5,0) 92842 ; See attached copy of the License.92830 ; This program is free software: you can redistribute it and/or modify 92843 92831 "RTN","C0CCCD1",6,0) 92844 ; 92832 ; it under the terms of the GNU Affero General Public License as 92845 92833 "RTN","C0CCCD1",7,0) 92846 ; This program is free software; you can redistribute it and/or modify92834 ; published by the Free Software Foundation, either version 3 of the 92847 92835 "RTN","C0CCCD1",8,0) 92848 ; it under the terms of the GNU General Public License as published by92836 ; License, or (at your option) any later version. 92849 92837 "RTN","C0CCCD1",9,0) 92850 ; the Free Software Foundation; either version 2 of the License, or92838 ; 92851 92839 "RTN","C0CCCD1",10,0) 92852 ; (at your option) any later version.92840 ; This program is distributed in the hope that it will be useful, 92853 92841 "RTN","C0CCCD1",11,0) 92854 ; 92842 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 92855 92843 "RTN","C0CCCD1",12,0) 92856 ; This program is distributed in the hope that it will be useful,92844 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 92857 92845 "RTN","C0CCCD1",13,0) 92858 ; but WITHOUT ANY WARRANTY; without even the implied warranty of92846 ; GNU Affero General Public License for more details. 92859 92847 "RTN","C0CCCD1",14,0) 92860 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the92848 ; 92861 92849 "RTN","C0CCCD1",15,0) 92862 ; GNU General Public License for more details.92850 ; You should have received a copy of the GNU Affero General Public License 92863 92851 "RTN","C0CCCD1",16,0) 92864 ; 92852 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 92865 92853 "RTN","C0CCCD1",17,0) 92866 ; You should have received a copy of the GNU General Public License along92854 ; 92867 92855 "RTN","C0CCCD1",18,0) 92868 ; with this program; if not, write to the Free Software Foundation, Inc.,92856 ; 92869 92857 "RTN","C0CCCD1",19,0) 92870 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.92858 W "This is a CCD TEMPLATE with processing routines",! 92871 92859 "RTN","C0CCCD1",20,0) 92872 ;92860 W ! 92873 92861 "RTN","C0CCCD1",21,0) 92874 W "This is a CCD TEMPLATE with processing routines",!92862 Q 92875 92863 "RTN","C0CCCD1",22,0) 92876 W !92864 ; 92877 92865 "RTN","C0CCCD1",23,0) 92878 Q 92866 ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array 92879 92867 "RTN","C0CCCD1",24,0) 92880 ;92868 ; ZARY IS PASSED BY NAME 92881 92869 "RTN","C0CCCD1",25,0) 92882 ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array 92870 ; BAT is a string identifying the section 92883 92871 "RTN","C0CCCD1",26,0) 92884 ; ZARY IS PASSED BY NAME92872 ; LINE is a test which will evaluate to true or false 92885 92873 "RTN","C0CCCD1",27,0) 92886 ; BAT is a string identifying the section92874 ; I '$G(@ZARY) D ; IF ZARY DOES NOT EXIST ' 92887 92875 "RTN","C0CCCD1",28,0) 92888 ; LINE is a test which will evaluate to true or false92876 ; . S @ZARY@(0)=0 ; initially there are no elements 92889 92877 "RTN","C0CCCD1",29,0) 92890 ; I '$G(@ZARY) D ; IF ZARY DOES NOT EXIST '92878 ; . W "GOT HERE LOADING "_LINE,! 92891 92879 "RTN","C0CCCD1",30,0) 92892 ; . S @ZARY@(0)=0 ; initially there are noelements92880 N CNT ; count of array elements 92893 92881 "RTN","C0CCCD1",31,0) 92894 ; . W "GOT HERE LOADING "_LINE,!92882 S CNT=@ZARY@(0) ; contains array count 92895 92883 "RTN","C0CCCD1",32,0) 92896 N CNT ; count of array elements92884 S CNT=CNT+1 ; increment count 92897 92885 "RTN","C0CCCD1",33,0) 92898 S CNT=@ZARY@(0) ; contains array count92886 S @ZARY@(CNT)=LINE ; put the line in the array 92899 92887 "RTN","C0CCCD1",34,0) 92900 S CNT=CNT+1 ; increment count92888 ; S @ZARY@(BAT,CNT)="" ; index the test by battery 92901 92889 "RTN","C0CCCD1",35,0) 92902 S @ZARY@(CNT)=LINE ; put the line in the array92890 S @ZARY@(0)=CNT ; update the array counter 92903 92891 "RTN","C0CCCD1",36,0) 92904 ; S @ZARY@(BAT,CNT)="" ; index the test by battery92892 Q 92905 92893 "RTN","C0CCCD1",37,0) 92906 S @ZARY@(0)=CNT ; update the array counter92894 ; 92907 92895 "RTN","C0CCCD1",38,0) 92908 Q 92896 ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference 92909 92897 "RTN","C0CCCD1",39,0) 92910 ;92898 ; ZARY IS PASSED BY NAME 92911 92899 "RTN","C0CCCD1",40,0) 92912 ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference 92900 ; ZARY = name of the root, closed array format (e.g., "^TMP($J)") 92913 92901 "RTN","C0CCCD1",41,0) 92914 ; ZARY IS PASSED BY NAME92902 ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE 92915 92903 "RTN","C0CCCD1",42,0) 92916 ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")92904 K @ZARY S @ZARY="" 92917 92905 "RTN","C0CCCD1",43,0) 92918 ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE92906 S @ZARY@(0)=0 ; initialize array count 92919 92907 "RTN","C0CCCD1",44,0) 92920 K @ZARY S @ZARY=""92908 N LINE,LABEL,BODY 92921 92909 "RTN","C0CCCD1",45,0) 92922 S @ZARY@(0)=0 ; initialize array count92910 N INTEST S INTEST=0 ; switch for in the TEMPLATE section 92923 92911 "RTN","C0CCCD1",46,0) 92924 N LINE,LABEL,BODY92912 N SECTION S SECTION="[anonymous]" ; NO section LABEL 92925 92913 "RTN","C0CCCD1",47,0) 92926 N INTEST S INTEST=0 ; switch for in the TEMPLATE section92914 ; 92927 92915 "RTN","C0CCCD1",48,0) 92928 N SECTION S SECTION="[anonymous]" ; NO section LABEL92916 N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D 92929 92917 "RTN","C0CCCD1",49,0) 92930 ;92918 . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section 92931 92919 "RTN","C0CCCD1",50,0) 92932 N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D92920 . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section 92933 92921 "RTN","C0CCCD1",51,0) 92934 . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; enteringsection92922 . I INTEST D ; within the section 92935 92923 "RTN","C0CCCD1",52,0) 92936 . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section92924 . . I LINE?." "1";><".E D ; sub-section name found 92937 92925 "RTN","C0CCCD1",53,0) 92938 . I INTEST D ; within the section92926 . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name 92939 92927 "RTN","C0CCCD1",54,0) 92940 . . I LINE?." "1";><".E D ; sub-section name found92928 . . I LINE?." "1";;".E D ; line found 92941 92929 "RTN","C0CCCD1",55,0) 92942 . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name92930 . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array 92943 92931 "RTN","C0CCCD1",56,0) 92944 . . I LINE?." "1";;".E D ; line found92932 Q 92945 92933 "RTN","C0CCCD1",57,0) 92946 . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array92934 ; 92947 92935 "RTN","C0CCCD1",58,0) 92948 Q 92936 LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME 92949 92937 "RTN","C0CCCD1",59,0) 92950 ;92938 D ZLOAD(ARY,"C0CCCD1") 92951 92939 "RTN","C0CCCD1",60,0) 92952 LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME 92940 ; ZWR @ARY 92953 92941 "RTN","C0CCCD1",61,0) 92954 D ZLOAD(ARY,"C0CCCD1")92942 Q 92955 92943 "RTN","C0CCCD1",62,0) 92956 ; ZWR @ARY92944 ; 92957 92945 "RTN","C0CCCD1",63,0) 92958 Q 92946 TRMCCD ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD 92959 92947 "RTN","C0CCCD1",64,0) 92960 ;92948 Q 92961 92949 "RTN","C0CCCD1",65,0) 92962 TRMCCD ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD 92950 MARKUP ;<MARKUP> 92963 92951 "RTN","C0CCCD1",66,0) 92964 Q92952 ;;<Body> 92965 92953 "RTN","C0CCCD1",67,0) 92966 MARKUP ;<MARKUP>92954 ;;<Problems> 92967 92955 "RTN","C0CCCD1",68,0) 92956 ;;</Problems> 92957 "RTN","C0CCCD1",69,0) 92958 ;;<FamilyHistory> 92959 "RTN","C0CCCD1",70,0) 92960 ;;</FamilyHistory> 92961 "RTN","C0CCCD1",71,0) 92962 ;;<SocialHistory> 92963 "RTN","C0CCCD1",72,0) 92964 ;;</SocialHistory> 92965 "RTN","C0CCCD1",73,0) 92966 ;;<Alerts> 92967 "RTN","C0CCCD1",74,0) 92968 ;;</Alerts> 92969 "RTN","C0CCCD1",75,0) 92970 ;;<Medications> 92971 "RTN","C0CCCD1",76,0) 92972 ;;</Medications> 92973 "RTN","C0CCCD1",77,0) 92974 ;;<VitalSigns> 92975 "RTN","C0CCCD1",78,0) 92976 ;;</VitalSigns> 92977 "RTN","C0CCCD1",79,0) 92978 ;;<Results> 92979 "RTN","C0CCCD1",80,0) 92980 ;;</Results> 92981 "RTN","C0CCCD1",81,0) 92982 ;;</Body> 92983 "RTN","C0CCCD1",82,0) 92984 ;;</ContinuityOfCareRecord> 92985 "RTN","C0CCCD1",83,0) 92986 ;</MARKUP> 92987 "RTN","C0CCCD1",84,0) 92988 ;;<ClinicalDocument xmlns="urn:hl7-org:v3" xmlns:voc="urn:hl7-org:v3/voc" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:hl7-org:v3 CDA.xsd"> 92989 "RTN","C0CCCD1",85,0) 92990 ;;</ClinicalDocument> 92991 "RTN","C0CCCD1",86,0) 92992 Q 92993 "RTN","C0CCCD1",87,0) 92994 ; 92995 "RTN","C0CCCD1",88,0) 92996 ;<TEMPLATE> 92997 "RTN","C0CCCD1",89,0) 92998 ;;<?xml version="1.0"?> 92999 "RTN","C0CCCD1",90,0) 93000 ;;<?xml-stylesheet type="text/xsl" href="CCD.xsl"?> 93001 "RTN","C0CCCD1",91,0) 93002 ;;<ClinicalDocument xmlns="urn:hl7-org:v3" xmlns:voc="urn:hl7-org:v3/voc" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:hl7-org:v3 CDA.xsd"> 93003 "RTN","C0CCCD1",92,0) 93004 ;;<typeId root="2.16.840.1.113883.1.3" extension="POCD_HD000040"/> 93005 "RTN","C0CCCD1",93,0) 93006 ;;<templateId root="2.16.840.1.113883.10.20.1"/> 93007 "RTN","C0CCCD1",94,0) 93008 ;;<id root="db734647-fc99-424c-a864-7e3cda82e703"/> 93009 "RTN","C0CCCD1",95,0) 93010 ;;<code code="34133-9" codeSystem="2.16.840.1.113883.6.1" displayName="Summarization of episode note"/> 93011 "RTN","C0CCCD1",96,0) 93012 ;;<title>Continuity of Care Document</title> 93013 "RTN","C0CCCD1",97,0) 93014 ;;<effectiveTime value="20000407130000+0500"/> 93015 "RTN","C0CCCD1",98,0) 93016 ;;<confidentialityCode code="N" codeSystem="2.16.840.1.113883.5.25"/> 93017 "RTN","C0CCCD1",99,0) 93018 ;;<languageCode code="en-US"/> 93019 "RTN","C0CCCD1",100,0) 93020 ;;<recordTarget> 93021 "RTN","C0CCCD1",101,0) 93022 ;;<patientRole> 93023 "RTN","C0CCCD1",102,0) 93024 ;;<id extension="@@ACTORIEN@@" root="2.16.840.1.113883.19.5"/> 93025 "RTN","C0CCCD1",103,0) 93026 ;;<patient> 93027 "RTN","C0CCCD1",104,0) 93028 ;;<name> 93029 "RTN","C0CCCD1",105,0) 93030 ;;<given>@@ACTORGIVENNAME@@</given> 93031 "RTN","C0CCCD1",106,0) 93032 ;;<family>@@ACTORFAMILYNAME@@</family> 93033 "RTN","C0CCCD1",107,0) 93034 ;;<suffix>@@ACTORSUFFIXNAME@@</suffix> 93035 "RTN","C0CCCD1",108,0) 93036 ;;</name> 93037 "RTN","C0CCCD1",109,0) 93038 ;;<administrativeGenderCode code="@@ACTORGENDER@@" codeSystem="2.16.840.1.113883.5.1"/> 93039 "RTN","C0CCCD1",110,0) 93040 ;;<birthTime value="@@ACTORDATEOFBIRTH@@"/> 93041 "RTN","C0CCCD1",111,0) 93042 ;;</patient> 93043 "RTN","C0CCCD1",112,0) 93044 ;;<providerOrganization> 93045 "RTN","C0CCCD1",113,0) 93046 ;;<id root="2.16.840.1.113883.19.5"/> 93047 "RTN","C0CCCD1",114,0) 93048 ;;<name>@@ORGANIZATIONNAME@@</name> 93049 "RTN","C0CCCD1",115,0) 93050 ;;</providerOrganization> 93051 "RTN","C0CCCD1",116,0) 93052 ;;</patientRole> 93053 "RTN","C0CCCD1",117,0) 93054 ;;</recordTarget> 93055 "RTN","C0CCCD1",118,0) 93056 ;;<author> 93057 "RTN","C0CCCD1",119,0) 93058 ;;<time value="20000407130000+0500"/> 93059 "RTN","C0CCCD1",120,0) 93060 ;;<assignedAuthor> 93061 "RTN","C0CCCD1",121,0) 93062 ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/> 93063 "RTN","C0CCCD1",122,0) 93064 ;;<assignedPerson> 93065 "RTN","C0CCCD1",123,0) 93066 ;;<name> 93067 "RTN","C0CCCD1",124,0) 93068 ;;<prefix>@@ACTORNAMEPREFIX@@</prefix> 93069 "RTN","C0CCCD1",125,0) 93070 ;;<given>@@ACTORGIVENNAME@@</given> 93071 "RTN","C0CCCD1",126,0) 93072 ;;<family>@@ACTORFAMILYNAME@@</family> 93073 "RTN","C0CCCD1",127,0) 93074 ;;</name> 93075 "RTN","C0CCCD1",128,0) 93076 ;;</assignedPerson> 93077 "RTN","C0CCCD1",129,0) 93078 ;;<representedOrganization> 93079 "RTN","C0CCCD1",130,0) 93080 ;;<id root="2.16.840.1.113883.19.5"/> 93081 "RTN","C0CCCD1",131,0) 93082 ;;<name>@@ORGANIZATIONNAME@@</name> 93083 "RTN","C0CCCD1",132,0) 93084 ;;</representedOrganization> 93085 "RTN","C0CCCD1",133,0) 93086 ;;</assignedAuthor> 93087 "RTN","C0CCCD1",134,0) 93088 ;;</author> 93089 "RTN","C0CCCD1",135,0) 93090 ;;<informant> 93091 "RTN","C0CCCD1",136,0) 93092 ;;<assignedEntity> 93093 "RTN","C0CCCD1",137,0) 93094 ;;<id nullFlavor="NI"/> 93095 "RTN","C0CCCD1",138,0) 93096 ;;<representedOrganization> 93097 "RTN","C0CCCD1",139,0) 93098 ;;<id root="2.16.840.1.113883.19.5"/> 93099 "RTN","C0CCCD1",140,0) 93100 ;;<name>@@ORGANIZATIONNAME@@</name> 93101 "RTN","C0CCCD1",141,0) 93102 ;;</representedOrganization> 93103 "RTN","C0CCCD1",142,0) 93104 ;;</assignedEntity> 93105 "RTN","C0CCCD1",143,0) 93106 ;;</informant> 93107 "RTN","C0CCCD1",144,0) 93108 ;;<custodian> 93109 "RTN","C0CCCD1",145,0) 93110 ;;<assignedCustodian> 93111 "RTN","C0CCCD1",146,0) 93112 ;;<representedCustodianOrganization> 93113 "RTN","C0CCCD1",147,0) 93114 ;;<id root="2.16.840.1.113883.19.5"/> 93115 "RTN","C0CCCD1",148,0) 93116 ;;<name>@@ORGANIZATIONNAME@@</name> 93117 "RTN","C0CCCD1",149,0) 93118 ;;</representedCustodianOrganization> 93119 "RTN","C0CCCD1",150,0) 93120 ;;</assignedCustodian> 93121 "RTN","C0CCCD1",151,0) 93122 ;;</custodian> 93123 "RTN","C0CCCD1",152,0) 93124 ;;<legalAuthenticator> 93125 "RTN","C0CCCD1",153,0) 93126 ;;<time value="20000407130000+0500"/> 93127 "RTN","C0CCCD1",154,0) 93128 ;;<signatureCode code="S"/> 93129 "RTN","C0CCCD1",155,0) 93130 ;;<assignedEntity> 93131 "RTN","C0CCCD1",156,0) 93132 ;;<id nullFlavor="NI"/> 93133 "RTN","C0CCCD1",157,0) 93134 ;;<representedOrganization> 93135 "RTN","C0CCCD1",158,0) 93136 ;;<id root="2.16.840.1.113883.19.5"/> 93137 "RTN","C0CCCD1",159,0) 93138 ;;<name>@@ORGANIZATIONNAME@@</name> 93139 "RTN","C0CCCD1",160,0) 93140 ;;</representedOrganization> 93141 "RTN","C0CCCD1",161,0) 93142 ;;</assignedEntity> 93143 "RTN","C0CCCD1",162,0) 93144 ;;</legalAuthenticator> 93145 "RTN","C0CCCD1",163,0) 93146 ;;<Actors> 93147 "RTN","C0CCCD1",164,0) 93148 ;;<ACTOR-NOK> 93149 "RTN","C0CCCD1",165,0) 93150 ;;<participant typeCode="IND"> 93151 "RTN","C0CCCD1",166,0) 93152 ;;<associatedEntity classCode="NOK"> 93153 "RTN","C0CCCD1",167,0) 93154 ;;<id root="4ac71514-6a10-4164-9715-f8d96af48e6d"/> 93155 "RTN","C0CCCD1",168,0) 93156 ;;<code code="65656005" codeSystem="2.16.840.1.113883.6.96" displayName="Biiological mother"/> 93157 "RTN","C0CCCD1",169,0) 93158 ;;<telecom value="tel:(999)555-1212"/> 93159 "RTN","C0CCCD1",170,0) 93160 ;;<associatedPerson> 93161 "RTN","C0CCCD1",171,0) 93162 ;;<name> 93163 "RTN","C0CCCD1",172,0) 93164 ;;<given>Henrietta</given> 93165 "RTN","C0CCCD1",173,0) 93166 ;;<family>Levin</family> 93167 "RTN","C0CCCD1",174,0) 93168 ;;</name> 93169 "RTN","C0CCCD1",175,0) 93170 ;;</associatedPerson> 93171 "RTN","C0CCCD1",176,0) 93172 ;;</associatedEntity> 93173 "RTN","C0CCCD1",177,0) 93174 ;;</participant> 93175 "RTN","C0CCCD1",178,0) 93176 ;;</ACTOR-NOK> 93177 "RTN","C0CCCD1",179,0) 93178 ;;</Actors> 93179 "RTN","C0CCCD1",180,0) 93180 ;;<documentationOf> 93181 "RTN","C0CCCD1",181,0) 93182 ;;<serviceEvent classCode="PCPR"> 93183 "RTN","C0CCCD1",182,0) 93184 ;;<effectiveTime> 93185 "RTN","C0CCCD1",183,0) 93186 ;;<high value="@@DATETIME@@"/> 93187 "RTN","C0CCCD1",184,0) 93188 ;;</effectiveTime> 93189 "RTN","C0CCCD1",185,0) 93190 ;;<performer typeCode="PRF"> 93191 "RTN","C0CCCD1",186,0) 93192 ;;<functionCode code="PCP" codeSystem="2.16.840.1.113883.5.88"/> 93193 "RTN","C0CCCD1",187,0) 93194 ;;<time> 93195 "RTN","C0CCCD1",188,0) 93196 ;;<low value="1990"/> 93197 "RTN","C0CCCD1",189,0) 93198 ;;<high value='20000407'/> 93199 "RTN","C0CCCD1",190,0) 93200 ;;</time> 93201 "RTN","C0CCCD1",191,0) 93202 ;;<assignedEntity> 93203 "RTN","C0CCCD1",192,0) 93204 ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/> 93205 "RTN","C0CCCD1",193,0) 93206 ;;<assignedPerson> 93207 "RTN","C0CCCD1",194,0) 93208 ;;<name> 93209 "RTN","C0CCCD1",195,0) 93210 ;;<prefix>@@ACTORPREFIXNAME@@</prefix> 93211 "RTN","C0CCCD1",196,0) 93212 ;;<given>@@ACTORGIVENNAME@@</given> 93213 "RTN","C0CCCD1",197,0) 93214 ;;<family>@@ACTORFAMILYNAME@@</family> 93215 "RTN","C0CCCD1",198,0) 93216 ;;</name> 93217 "RTN","C0CCCD1",199,0) 93218 ;;</assignedPerson> 93219 "RTN","C0CCCD1",200,0) 93220 ;;<representedOrganization> 93221 "RTN","C0CCCD1",201,0) 93222 ;;<id root="2.16.840.1.113883.19.5"/> 93223 "RTN","C0CCCD1",202,0) 93224 ;;<name>@@ORGANIZATIONNAME@@</name> 93225 "RTN","C0CCCD1",203,0) 93226 ;;</representedOrganization> 93227 "RTN","C0CCCD1",204,0) 93228 ;;</assignedEntity> 93229 "RTN","C0CCCD1",205,0) 93230 ;;</performer> 93231 "RTN","C0CCCD1",206,0) 93232 ;;</serviceEvent> 93233 "RTN","C0CCCD1",207,0) 93234 ;;</documentationOf> 93235 "RTN","C0CCCD1",208,0) 92968 93236 ;;<Body> 92969 "RTN","C0CCCD1",69,0) 93237 "RTN","C0CCCD1",209,0) 93238 ;;<PROBLEMS-HTML> 93239 "RTN","C0CCCD1",210,0) 93240 ;;<text><table border="1" width="100%"><thead><tr><th>Condition</th><th>Effective Dates</th><th>Condition Status</th></tr></thead><tbody> 93241 "RTN","C0CCCD1",211,0) 93242 ;;<tr><td>@@PROBLEMDESCRIPTION@@</td> 93243 "RTN","C0CCCD1",212,0) 93244 ;;<td>@@PROBLEMDATEOFONSET@@</td> 93245 "RTN","C0CCCD1",213,0) 93246 ;;<td>Active</td></tr> 93247 "RTN","C0CCCD1",214,0) 93248 ;;</tbody></table></text> 93249 "RTN","C0CCCD1",215,0) 93250 ;;</PROBLEMS-HTML> 93251 "RTN","C0CCCD1",216,0) 92970 93252 ;;<Problems> 92971 "RTN","C0CCCD1",70,0) 92972 ;;</Problems> 92973 "RTN","C0CCCD1",71,0) 92974 ;;<FamilyHistory> 92975 "RTN","C0CCCD1",72,0) 92976 ;;</FamilyHistory> 92977 "RTN","C0CCCD1",73,0) 92978 ;;<SocialHistory> 92979 "RTN","C0CCCD1",74,0) 92980 ;;</SocialHistory> 92981 "RTN","C0CCCD1",75,0) 92982 ;;<Alerts> 92983 "RTN","C0CCCD1",76,0) 92984 ;;</Alerts> 92985 "RTN","C0CCCD1",77,0) 92986 ;;<Medications> 92987 "RTN","C0CCCD1",78,0) 92988 ;;</Medications> 92989 "RTN","C0CCCD1",79,0) 92990 ;;<VitalSigns> 92991 "RTN","C0CCCD1",80,0) 92992 ;;</VitalSigns> 92993 "RTN","C0CCCD1",81,0) 92994 ;;<Results> 92995 "RTN","C0CCCD1",82,0) 92996 ;;</Results> 92997 "RTN","C0CCCD1",83,0) 92998 ;;</Body> 92999 "RTN","C0CCCD1",84,0) 93000 ;;</ContinuityOfCareRecord> 93001 "RTN","C0CCCD1",85,0) 93002 ;</MARKUP> 93003 "RTN","C0CCCD1",86,0) 93004 ;;<ClinicalDocument xmlns="urn:hl7-org:v3" xmlns:voc="urn:hl7-org:v3/voc" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:hl7-org:v3 CDA.xsd"> 93005 "RTN","C0CCCD1",87,0) 93006 ;;</ClinicalDocument> 93007 "RTN","C0CCCD1",88,0) 93008 Q 93009 "RTN","C0CCCD1",89,0) 93010 ; 93011 "RTN","C0CCCD1",90,0) 93012 ;<TEMPLATE> 93013 "RTN","C0CCCD1",91,0) 93014 ;;<?xml version="1.0"?> 93015 "RTN","C0CCCD1",92,0) 93016 ;;<?xml-stylesheet type="text/xsl" href="CCD.xsl"?> 93017 "RTN","C0CCCD1",93,0) 93018 ;;<ClinicalDocument xmlns="urn:hl7-org:v3" xmlns:voc="urn:hl7-org:v3/voc" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:hl7-org:v3 CDA.xsd"> 93019 "RTN","C0CCCD1",94,0) 93020 ;;<typeId root="2.16.840.1.113883.1.3" extension="POCD_HD000040"/> 93021 "RTN","C0CCCD1",95,0) 93022 ;;<templateId root="2.16.840.1.113883.10.20.1"/> 93023 "RTN","C0CCCD1",96,0) 93024 ;;<id root="db734647-fc99-424c-a864-7e3cda82e703"/> 93025 "RTN","C0CCCD1",97,0) 93026 ;;<code code="34133-9" codeSystem="2.16.840.1.113883.6.1" displayName="Summarization of episode note"/> 93027 "RTN","C0CCCD1",98,0) 93028 ;;<title>Continuity of Care Document</title> 93029 "RTN","C0CCCD1",99,0) 93030 ;;<effectiveTime value="20000407130000+0500"/> 93031 "RTN","C0CCCD1",100,0) 93032 ;;<confidentialityCode code="N" codeSystem="2.16.840.1.113883.5.25"/> 93033 "RTN","C0CCCD1",101,0) 93034 ;;<languageCode code="en-US"/> 93035 "RTN","C0CCCD1",102,0) 93036 ;;<recordTarget> 93037 "RTN","C0CCCD1",103,0) 93038 ;;<patientRole> 93039 "RTN","C0CCCD1",104,0) 93040 ;;<id extension="@@ACTORIEN@@" root="2.16.840.1.113883.19.5"/> 93041 "RTN","C0CCCD1",105,0) 93042 ;;<patient> 93043 "RTN","C0CCCD1",106,0) 93044 ;;<name> 93045 "RTN","C0CCCD1",107,0) 93046 ;;<given>@@ACTORGIVENNAME@@</given> 93047 "RTN","C0CCCD1",108,0) 93048 ;;<family>@@ACTORFAMILYNAME@@</family> 93049 "RTN","C0CCCD1",109,0) 93050 ;;<suffix>@@ACTORSUFFIXNAME@@</suffix> 93051 "RTN","C0CCCD1",110,0) 93052 ;;</name> 93053 "RTN","C0CCCD1",111,0) 93054 ;;<administrativeGenderCode code="@@ACTORGENDER@@" codeSystem="2.16.840.1.113883.5.1"/> 93055 "RTN","C0CCCD1",112,0) 93056 ;;<birthTime value="@@ACTORDATEOFBIRTH@@"/> 93057 "RTN","C0CCCD1",113,0) 93058 ;;</patient> 93059 "RTN","C0CCCD1",114,0) 93060 ;;<providerOrganization> 93061 "RTN","C0CCCD1",115,0) 93062 ;;<id root="2.16.840.1.113883.19.5"/> 93063 "RTN","C0CCCD1",116,0) 93064 ;;<name>@@ORGANIZATIONNAME@@</name> 93065 "RTN","C0CCCD1",117,0) 93066 ;;</providerOrganization> 93067 "RTN","C0CCCD1",118,0) 93068 ;;</patientRole> 93069 "RTN","C0CCCD1",119,0) 93070 ;;</recordTarget> 93071 "RTN","C0CCCD1",120,0) 93072 ;;<author> 93073 "RTN","C0CCCD1",121,0) 93074 ;;<time value="20000407130000+0500"/> 93075 "RTN","C0CCCD1",122,0) 93076 ;;<assignedAuthor> 93077 "RTN","C0CCCD1",123,0) 93078 ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/> 93079 "RTN","C0CCCD1",124,0) 93080 ;;<assignedPerson> 93081 "RTN","C0CCCD1",125,0) 93082 ;;<name> 93083 "RTN","C0CCCD1",126,0) 93084 ;;<prefix>@@ACTORNAMEPREFIX@@</prefix> 93085 "RTN","C0CCCD1",127,0) 93086 ;;<given>@@ACTORGIVENNAME@@</given> 93087 "RTN","C0CCCD1",128,0) 93088 ;;<family>@@ACTORFAMILYNAME@@</family> 93089 "RTN","C0CCCD1",129,0) 93090 ;;</name> 93091 "RTN","C0CCCD1",130,0) 93092 ;;</assignedPerson> 93093 "RTN","C0CCCD1",131,0) 93094 ;;<representedOrganization> 93095 "RTN","C0CCCD1",132,0) 93096 ;;<id root="2.16.840.1.113883.19.5"/> 93097 "RTN","C0CCCD1",133,0) 93098 ;;<name>@@ORGANIZATIONNAME@@</name> 93099 "RTN","C0CCCD1",134,0) 93100 ;;</representedOrganization> 93101 "RTN","C0CCCD1",135,0) 93102 ;;</assignedAuthor> 93103 "RTN","C0CCCD1",136,0) 93104 ;;</author> 93105 "RTN","C0CCCD1",137,0) 93106 ;;<informant> 93107 "RTN","C0CCCD1",138,0) 93108 ;;<assignedEntity> 93109 "RTN","C0CCCD1",139,0) 93110 ;;<id nullFlavor="NI"/> 93111 "RTN","C0CCCD1",140,0) 93112 ;;<representedOrganization> 93113 "RTN","C0CCCD1",141,0) 93114 ;;<id root="2.16.840.1.113883.19.5"/> 93115 "RTN","C0CCCD1",142,0) 93116 ;;<name>@@ORGANIZATIONNAME@@</name> 93117 "RTN","C0CCCD1",143,0) 93118 ;;</representedOrganization> 93119 "RTN","C0CCCD1",144,0) 93120 ;;</assignedEntity> 93121 "RTN","C0CCCD1",145,0) 93122 ;;</informant> 93123 "RTN","C0CCCD1",146,0) 93124 ;;<custodian> 93125 "RTN","C0CCCD1",147,0) 93126 ;;<assignedCustodian> 93127 "RTN","C0CCCD1",148,0) 93128 ;;<representedCustodianOrganization> 93129 "RTN","C0CCCD1",149,0) 93130 ;;<id root="2.16.840.1.113883.19.5"/> 93131 "RTN","C0CCCD1",150,0) 93132 ;;<name>@@ORGANIZATIONNAME@@</name> 93133 "RTN","C0CCCD1",151,0) 93134 ;;</representedCustodianOrganization> 93135 "RTN","C0CCCD1",152,0) 93136 ;;</assignedCustodian> 93137 "RTN","C0CCCD1",153,0) 93138 ;;</custodian> 93139 "RTN","C0CCCD1",154,0) 93140 ;;<legalAuthenticator> 93141 "RTN","C0CCCD1",155,0) 93142 ;;<time value="20000407130000+0500"/> 93143 "RTN","C0CCCD1",156,0) 93144 ;;<signatureCode code="S"/> 93145 "RTN","C0CCCD1",157,0) 93146 ;;<assignedEntity> 93147 "RTN","C0CCCD1",158,0) 93148 ;;<id nullFlavor="NI"/> 93149 "RTN","C0CCCD1",159,0) 93150 ;;<representedOrganization> 93151 "RTN","C0CCCD1",160,0) 93152 ;;<id root="2.16.840.1.113883.19.5"/> 93153 "RTN","C0CCCD1",161,0) 93154 ;;<name>@@ORGANIZATIONNAME@@</name> 93155 "RTN","C0CCCD1",162,0) 93156 ;;</representedOrganization> 93157 "RTN","C0CCCD1",163,0) 93158 ;;</assignedEntity> 93159 "RTN","C0CCCD1",164,0) 93160 ;;</legalAuthenticator> 93161 "RTN","C0CCCD1",165,0) 93162 ;;<Actors> 93163 "RTN","C0CCCD1",166,0) 93164 ;;<ACTOR-NOK> 93165 "RTN","C0CCCD1",167,0) 93166 ;;<participant typeCode="IND"> 93167 "RTN","C0CCCD1",168,0) 93168 ;;<associatedEntity classCode="NOK"> 93169 "RTN","C0CCCD1",169,0) 93170 ;;<id root="4ac71514-6a10-4164-9715-f8d96af48e6d"/> 93171 "RTN","C0CCCD1",170,0) 93172 ;;<code code="65656005" codeSystem="2.16.840.1.113883.6.96" displayName="Biiological mother"/> 93173 "RTN","C0CCCD1",171,0) 93174 ;;<telecom value="tel:(999)555-1212"/> 93175 "RTN","C0CCCD1",172,0) 93176 ;;<associatedPerson> 93177 "RTN","C0CCCD1",173,0) 93178 ;;<name> 93179 "RTN","C0CCCD1",174,0) 93180 ;;<given>Henrietta</given> 93181 "RTN","C0CCCD1",175,0) 93182 ;;<family>Levin</family> 93183 "RTN","C0CCCD1",176,0) 93184 ;;</name> 93185 "RTN","C0CCCD1",177,0) 93186 ;;</associatedPerson> 93187 "RTN","C0CCCD1",178,0) 93188 ;;</associatedEntity> 93189 "RTN","C0CCCD1",179,0) 93190 ;;</participant> 93191 "RTN","C0CCCD1",180,0) 93192 ;;</ACTOR-NOK> 93193 "RTN","C0CCCD1",181,0) 93194 ;;</Actors> 93195 "RTN","C0CCCD1",182,0) 93196 ;;<documentationOf> 93197 "RTN","C0CCCD1",183,0) 93198 ;;<serviceEvent classCode="PCPR"> 93199 "RTN","C0CCCD1",184,0) 93253 "RTN","C0CCCD1",217,0) 93254 ;;<component> 93255 "RTN","C0CCCD1",218,0) 93256 ;;<section> 93257 "RTN","C0CCCD1",219,0) 93258 ;;<templateId root='2.16.840.1.113883.10.20.1.11'/> 93259 "RTN","C0CCCD1",220,0) 93260 ;;<code code="11450-4" codeSystem="2.16.840.1.113883.6.1"/> 93261 "RTN","C0CCCD1",221,0) 93262 ;;<title>Problems</title> 93263 "RTN","C0CCCD1",222,0) 93264 ;;<entry typeCode="DRIV"> 93265 "RTN","C0CCCD1",223,0) 93266 ;;<act classCode="ACT" moodCode="EVN"> 93267 "RTN","C0CCCD1",224,0) 93268 ;;<templateId root='2.16.840.1.113883.10.20.1.27'/> 93269 "RTN","C0CCCD1",225,0) 93270 ;;<id root="6a2fa88d-4174-4909-aece-db44b60a3abb"/> 93271 "RTN","C0CCCD1",226,0) 93272 ;;<code nullFlavor="NA"/> 93273 "RTN","C0CCCD1",227,0) 93274 ;;<entryRelationship typeCode="SUBJ"> 93275 "RTN","C0CCCD1",228,0) 93276 ;;<observation classCode="OBS" moodCode="EVN"> 93277 "RTN","C0CCCD1",229,0) 93278 ;;<templateId root='2.16.840.1.113883.10.20.1.28'/> 93279 "RTN","C0CCCD1",230,0) 93280 ;;<id root="d11275e7-67ae-11db-bd13-0800200c9a66"/> 93281 "RTN","C0CCCD1",231,0) 93282 ;;<code code="ASSERTION" codeSystem="2.16.840.1.113883.5.4"/> 93283 "RTN","C0CCCD1",232,0) 93284 ;;<statusCode code="completed"/> 93285 "RTN","C0CCCD1",233,0) 93200 93286 ;;<effectiveTime> 93201 "RTN","C0CCCD1", 185,0)93202 ;;< high value="@@DATETIME@@"/>93203 "RTN","C0CCCD1", 186,0)93287 "RTN","C0CCCD1",234,0) 93288 ;;<low value="@@PROBLEMDATEOFONSET@@"/> 93289 "RTN","C0CCCD1",235,0) 93204 93290 ;;</effectiveTime> 93205 "RTN","C0CCCD1",187,0) 93206 ;;<performer typeCode="PRF"> 93207 "RTN","C0CCCD1",188,0) 93208 ;;<functionCode code="PCP" codeSystem="2.16.840.1.113883.5.88"/> 93209 "RTN","C0CCCD1",189,0) 93210 ;;<time> 93211 "RTN","C0CCCD1",190,0) 93212 ;;<low value="1990"/> 93213 "RTN","C0CCCD1",191,0) 93214 ;;<high value='20000407'/> 93215 "RTN","C0CCCD1",192,0) 93216 ;;</time> 93217 "RTN","C0CCCD1",193,0) 93218 ;;<assignedEntity> 93219 "RTN","C0CCCD1",194,0) 93220 ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/> 93221 "RTN","C0CCCD1",195,0) 93222 ;;<assignedPerson> 93223 "RTN","C0CCCD1",196,0) 93224 ;;<name> 93225 "RTN","C0CCCD1",197,0) 93226 ;;<prefix>@@ACTORPREFIXNAME@@</prefix> 93227 "RTN","C0CCCD1",198,0) 93228 ;;<given>@@ACTORGIVENNAME@@</given> 93229 "RTN","C0CCCD1",199,0) 93230 ;;<family>@@ACTORFAMILYNAME@@</family> 93231 "RTN","C0CCCD1",200,0) 93232 ;;</name> 93233 "RTN","C0CCCD1",201,0) 93234 ;;</assignedPerson> 93235 "RTN","C0CCCD1",202,0) 93236 ;;<representedOrganization> 93237 "RTN","C0CCCD1",203,0) 93238 ;;<id root="2.16.840.1.113883.19.5"/> 93239 "RTN","C0CCCD1",204,0) 93240 ;;<name>@@ORGANIZATIONNAME@@</name> 93241 "RTN","C0CCCD1",205,0) 93242 ;;</representedOrganization> 93243 "RTN","C0CCCD1",206,0) 93244 ;;</assignedEntity> 93245 "RTN","C0CCCD1",207,0) 93246 ;;</performer> 93247 "RTN","C0CCCD1",208,0) 93248 ;;</serviceEvent> 93249 "RTN","C0CCCD1",209,0) 93250 ;;</documentationOf> 93251 "RTN","C0CCCD1",210,0) 93252 ;;<Body> 93253 "RTN","C0CCCD1",211,0) 93254 ;;<PROBLEMS-HTML> 93255 "RTN","C0CCCD1",212,0) 93256 ;;<text><table border="1" width="100%"><thead><tr><th>Condition</th><th>Effective Dates</th><th>Condition Status</th></tr></thead><tbody> 93257 "RTN","C0CCCD1",213,0) 93258 ;;<tr><td>@@PROBLEMDESCRIPTION@@</td> 93259 "RTN","C0CCCD1",214,0) 93260 ;;<td>@@PROBLEMDATEOFONSET@@</td> 93261 "RTN","C0CCCD1",215,0) 93262 ;;<td>Active</td></tr> 93263 "RTN","C0CCCD1",216,0) 93264 ;;</tbody></table></text> 93265 "RTN","C0CCCD1",217,0) 93266 ;;</PROBLEMS-HTML> 93267 "RTN","C0CCCD1",218,0) 93268 ;;<Problems> 93269 "RTN","C0CCCD1",219,0) 93270 ;;<component> 93271 "RTN","C0CCCD1",220,0) 93272 ;;<section> 93273 "RTN","C0CCCD1",221,0) 93274 ;;<templateId root='2.16.840.1.113883.10.20.1.11'/> 93275 "RTN","C0CCCD1",222,0) 93276 ;;<code code="11450-4" codeSystem="2.16.840.1.113883.6.1"/> 93277 "RTN","C0CCCD1",223,0) 93278 ;;<title>Problems</title> 93279 "RTN","C0CCCD1",224,0) 93280 ;;<entry typeCode="DRIV"> 93281 "RTN","C0CCCD1",225,0) 93282 ;;<act classCode="ACT" moodCode="EVN"> 93283 "RTN","C0CCCD1",226,0) 93284 ;;<templateId root='2.16.840.1.113883.10.20.1.27'/> 93285 "RTN","C0CCCD1",227,0) 93286 ;;<id root="6a2fa88d-4174-4909-aece-db44b60a3abb"/> 93287 "RTN","C0CCCD1",228,0) 93288 ;;<code nullFlavor="NA"/> 93289 "RTN","C0CCCD1",229,0) 93290 ;;<entryRelationship typeCode="SUBJ"> 93291 "RTN","C0CCCD1",230,0) 93291 "RTN","C0CCCD1",236,0) 93292 ;;<value xsi:type="CD" code="@@PROBLEMCODEVALUE@@" codeSystem="2.16.840.1.113883.6.96" displayName="@@PROBLEMDESCRIPTION@@"/> 93293 "RTN","C0CCCD1",237,0) 93294 ;;<entryRelationship typeCode="REFR"> 93295 "RTN","C0CCCD1",238,0) 93292 93296 ;;<observation classCode="OBS" moodCode="EVN"> 93293 "RTN","C0CCCD1",231,0) 93294 ;;<templateId root='2.16.840.1.113883.10.20.1.28'/> 93295 "RTN","C0CCCD1",232,0) 93296 ;;<id root="d11275e7-67ae-11db-bd13-0800200c9a66"/> 93297 "RTN","C0CCCD1",233,0) 93298 ;;<code code="ASSERTION" codeSystem="2.16.840.1.113883.5.4"/> 93299 "RTN","C0CCCD1",234,0) 93297 "RTN","C0CCCD1",239,0) 93298 ;;<templateId root='2.16.840.1.113883.10.20.1.50'/> 93299 "RTN","C0CCCD1",240,0) 93300 ;;<code code="33999-4" codeSystem="2.16.840.1.113883.6.1" displayName="Status"/> 93301 "RTN","C0CCCD1",241,0) 93300 93302 ;;<statusCode code="completed"/> 93301 "RTN","C0CCCD1",235,0)93302 ;;<effectiveTime>93303 "RTN","C0CCCD1",236,0)93304 ;;<low value="@@PROBLEMDATEOFONSET@@"/>93305 "RTN","C0CCCD1",237,0)93306 ;;</effectiveTime>93307 "RTN","C0CCCD1",238,0)93308 ;;<value xsi:type="CD" code="@@PROBLEMCODEVALUE@@" codeSystem="2.16.840.1.113883.6.96" displayName="@@PROBLEMDESCRIPTION@@"/>93309 "RTN","C0CCCD1",239,0)93310 ;;<entryRelationship typeCode="REFR">93311 "RTN","C0CCCD1",240,0)93312 ;;<observation classCode="OBS" moodCode="EVN">93313 "RTN","C0CCCD1",241,0)93314 ;;<templateId root='2.16.840.1.113883.10.20.1.50'/>93315 93303 "RTN","C0CCCD1",242,0) 93316 ;;< code code="33999-4" codeSystem="2.16.840.1.113883.6.1" displayName="Status"/>93304 ;;<value xsi:type="CE" code="55561003" codeSystem="2.16.840.1.113883.6.96" displayName="Active"/> 93317 93305 "RTN","C0CCCD1",243,0) 93318 ;;< statusCode code="completed"/>93306 ;;</observation> 93319 93307 "RTN","C0CCCD1",244,0) 93320 ;;< value xsi:type="CE" code="55561003" codeSystem="2.16.840.1.113883.6.96" displayName="Active"/>93308 ;;</entryRelationship> 93321 93309 "RTN","C0CCCD1",245,0) 93322 93310 ;;</observation> … … 93324 93312 ;;</entryRelationship> 93325 93313 "RTN","C0CCCD1",247,0) 93326 ;;</ observation>93314 ;;</act> 93327 93315 "RTN","C0CCCD1",248,0) 93328 ;;</entry Relationship>93316 ;;</entry> 93329 93317 "RTN","C0CCCD1",249,0) 93330 ;;</ act>93318 ;;</section> 93331 93319 "RTN","C0CCCD1",250,0) 93332 ;;</ entry>93320 ;;</component> 93333 93321 "RTN","C0CCCD1",251,0) 93334 ;;</ section>93322 ;;</Problems> 93335 93323 "RTN","C0CCCD1",252,0) 93336 ;;< /component>93324 ;;<FamilyHistory> 93337 93325 "RTN","C0CCCD1",253,0) 93338 ;;</ Problems>93326 ;;</FamilyHistory> 93339 93327 "RTN","C0CCCD1",254,0) 93340 ;;< FamilyHistory>93328 ;;<SocialHistory> 93341 93329 "RTN","C0CCCD1",255,0) 93342 ;;</ FamilyHistory>93330 ;;</SocialHistory> 93343 93331 "RTN","C0CCCD1",256,0) 93344 ;;< SocialHistory>93332 ;;<Alerts> 93345 93333 "RTN","C0CCCD1",257,0) 93346 ;;</ SocialHistory>93334 ;;</Alerts> 93347 93335 "RTN","C0CCCD1",258,0) 93348 ;;< Alerts>93336 ;;<Medications> 93349 93337 "RTN","C0CCCD1",259,0) 93350 ;;</ Alerts>93338 ;;</Medications> 93351 93339 "RTN","C0CCCD1",260,0) 93352 ;;< Medications>93340 ;;<VitalSigns> 93353 93341 "RTN","C0CCCD1",261,0) 93354 ;;</ Medications>93342 ;;</VitalSigns> 93355 93343 "RTN","C0CCCD1",262,0) 93356 ;;< VitalSigns>93344 ;;<Results> 93357 93345 "RTN","C0CCCD1",263,0) 93358 ;;</ VitalSigns>93346 ;;</Results> 93359 93347 "RTN","C0CCCD1",264,0) 93360 ;;< Results>93348 ;;</Body> 93361 93349 "RTN","C0CCCD1",265,0) 93362 ;;</ Results>93350 ;;</ClinicalDocument> 93363 93351 "RTN","C0CCCD1",266,0) 93364 ;;</Body>93365 "RTN","C0CCCD1",267,0)93366 ;;</ClinicalDocument>93367 "RTN","C0CCCD1",268,0)93368 93352 ;</TEMPLATE> 93369 93353 "RTN","C0CCCR") 93370 0^43^B1 1168282593354 0^43^B109879694 93371 93355 "RTN","C0CCCR",1,0) 93372 93356 C0CCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08 93373 93357 "RTN","C0CCCR",2,0) 93374 ;;1.2;C 0C;;May 11, 2012;Build 5093358 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 93375 93359 "RTN","C0CCCR",3,0) 93376 93360 ;Copyright 2008,2009 George Lilly, University of Minnesota. 93377 93361 "RTN","C0CCCR",4,0) 93378 ; Licensed under the terms of the GNU General Public License.93362 ; 93379 93363 "RTN","C0CCCR",5,0) 93380 ; See attached copy of the License.93364 ; This program is free software: you can redistribute it and/or modify 93381 93365 "RTN","C0CCCR",6,0) 93382 ; 93366 ; it under the terms of the GNU Affero General Public License as 93383 93367 "RTN","C0CCCR",7,0) 93384 ; This program is free software; you can redistribute it and/or modify93368 ; published by the Free Software Foundation, either version 3 of the 93385 93369 "RTN","C0CCCR",8,0) 93386 ; it under the terms of the GNU General Public License as published by93370 ; License, or (at your option) any later version. 93387 93371 "RTN","C0CCCR",9,0) 93388 ; the Free Software Foundation; either version 2 of the License, or93372 ; 93389 93373 "RTN","C0CCCR",10,0) 93390 ; (at your option) any later version.93374 ; This program is distributed in the hope that it will be useful, 93391 93375 "RTN","C0CCCR",11,0) 93392 ; 93376 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 93393 93377 "RTN","C0CCCR",12,0) 93394 ; This program is distributed in the hope that it will be useful,93378 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 93395 93379 "RTN","C0CCCR",13,0) 93396 ; but WITHOUT ANY WARRANTY; without even the implied warranty of93380 ; GNU Affero General Public License for more details. 93397 93381 "RTN","C0CCCR",14,0) 93398 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the93382 ; 93399 93383 "RTN","C0CCCR",15,0) 93400 ; GNU General Public License for more details.93384 ; You should have received a copy of the GNU Affero General Public License 93401 93385 "RTN","C0CCCR",16,0) 93402 ; 93386 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 93403 93387 "RTN","C0CCCR",17,0) 93404 ; You should have received a copy of the GNU General Public License along93388 ; 93405 93389 "RTN","C0CCCR",18,0) 93406 ; with this program; if not, write to the Free Software Foundation, Inc.,93390 ; EXPORT A CCR 93407 93391 "RTN","C0CCCR",19,0) 93408 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.93392 ; 93409 93393 "RTN","C0CCCR",20,0) 93410 ; 93394 EXPORT ; EXPORT ENTRY POINT FOR CCR 93411 93395 "RTN","C0CCCR",21,0) 93412 ; EXPORT A CCR93396 ; Select a patient. 93413 93397 "RTN","C0CCCR",22,0) 93414 ;93398 S DIC=2,DIC(0)="AEMQ" D ^DIC 93415 93399 "RTN","C0CCCR",23,0) 93416 EXPORT ; EXPORT ENTRY POINT FOR CCR 93400 I Y<1 Q ; EXIT 93417 93401 "RTN","C0CCCR",24,0) 93418 ; Select a patient.93402 S DFN=$P(Y,U,1) ; SET THE PATIENT 93419 93403 "RTN","C0CCCR",25,0) 93420 S DIC=2,DIC(0)="AEMQ" D ^DIC93404 ;OHUM/RUT 3120109 commented 93421 93405 "RTN","C0CCCR",26,0) 93422 I Y<1 Q ; EXIT93406 ;;OHUM/RUT 3120102 To take inputs from user for date limits and notes 93423 93407 "RTN","C0CCCR",27,0) 93424 S DFN=$P(Y,U,1) ; SET THE PATIENT93408 ;D ^C0CVALID 93425 93409 "RTN","C0CCCR",28,0) 93426 ; OHUM/RUT 3120109 commented93410 ;;OHUM/RUT 93427 93411 "RTN","C0CCCR",29,0) 93428 ; ;OHUM/RUT 3120102 To take inputs from user for date limits and notes93412 ;OHUM/RUT 93429 93413 "RTN","C0CCCR",30,0) 93430 ;D ^C0CVALID93414 D XPAT(DFN) ; EXPORT TO A FILE 93431 93415 "RTN","C0CCCR",31,0) 93416 Q 93417 "RTN","C0CCCR",32,0) 93418 ; 93419 "RTN","C0CCCR",33,0) 93420 XPAT(DFN,XPARMS,DIR,FN) ; EXPORT ONE PATIENT TO A FILE 93421 "RTN","C0CCCR",34,0) 93422 ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR") 93423 "RTN","C0CCCR",35,0) 93424 ; FN IS FILE NAME, DEFAULTS IF NULL 93425 "RTN","C0CCCR",36,0) 93426 N CCRGLO,UDIR,UFN 93427 "RTN","C0CCCR",37,0) 93428 S C0CNRPC=1 ; FLAG FOR NOT AN RPC CALL - FOR DEBUGGING THE RPC 93429 "RTN","C0CCCR",38,0) 93430 I '$D(DIR) S UDIR="" 93431 "RTN","C0CCCR",39,0) 93432 E S UDIR=DIR 93433 "RTN","C0CCCR",40,0) 93434 I '$D(FN) S UFN="" ; IF FILENAME IS NOT PASSED 93435 "RTN","C0CCCR",41,0) 93436 E S UFN=FN 93437 "RTN","C0CCCR",42,0) 93438 I '$D(XPARMS) S XPARMS="" 93439 "RTN","C0CCCR",43,0) 93440 N C0CRTN ; RETURN ARRAY 93441 "RTN","C0CCCR",44,0) 93442 D CCRRPC(.C0CRTN,DFN,XPARMS,"CCR") 93443 "RTN","C0CCCR",45,0) 93444 S OARY=$NA(^TMP("C0CCUR",$J,DFN,"CCR",1)) 93445 "RTN","C0CCCR",46,0) 93446 S ONAM=UFN 93447 "RTN","C0CCCR",47,0) 93448 I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_0.xml" 93449 "RTN","C0CCCR",48,0) 93450 S ODIRGLB=$NA(^TMP("C0CCCR","ODIR")) 93451 "RTN","C0CCCR",49,0) 93452 S ^TMP("C0CCCR","FNAME",DFN)=ONAM ; FILE NAME FOR BATCH USE 93453 "RTN","C0CCCR",50,0) 93454 I $D(^TMP("GPLCCR","ODIR")) S @ODIRGLB=^TMP("GPLCCR","ODIR") 93455 "RTN","C0CCCR",51,0) 93456 I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET 93457 "RTN","C0CCCR",52,0) 93458 . W "Warning.. please set ^TMP(""C0CCCR"",""ODIR"")=""output path""",! Q 93459 "RTN","C0CCCR",53,0) 93460 . ;S @ODIRGLB="/home/glilly/CCROUT" 93461 "RTN","C0CCCR",54,0) 93462 . ;S @ODIRGLB="/home/cedwards/" 93463 "RTN","C0CCCR",55,0) 93464 . S @ODIRGLB="/opt/wv/p/" 93465 "RTN","C0CCCR",56,0) 93466 S ODIR=UDIR 93467 "RTN","C0CCCR",57,0) 93468 I UDIR="" S ODIR=@ODIRGLB 93469 "RTN","C0CCCR",58,0) 93470 N ZY 93471 "RTN","C0CCCR",59,0) 93472 S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR) 93473 "RTN","C0CCCR",60,0) 93474 W !,$P(ZY,U,2),! 93475 "RTN","C0CCCR",61,0) 93476 Q 93477 "RTN","C0CCCR",62,0) 93478 ; 93479 "RTN","C0CCCR",63,0) 93480 DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED 93481 "RTN","C0CCCR",64,0) 93482 ; 93483 "RTN","C0CCCR",65,0) 93484 N G1 93485 "RTN","C0CCCR",66,0) 93486 S G1=$NA(^TMP("C0CCUR",$J,DFN,"CCR")) 93487 "RTN","C0CCCR",67,0) 93488 I $D(@G1@(0)) D ; CCR EXISTS 93489 "RTN","C0CCCR",68,0) 93490 . D PARY^C0CXPATH(G1) 93491 "RTN","C0CCCR",69,0) 93492 E W "CCR NOT CREATED, RUN D XPAT^C0CCCR(DFN,"""","""") FIRST",! 93493 "RTN","C0CCCR",70,0) 93494 Q 93495 "RTN","C0CCCR",71,0) 93496 ; 93497 "RTN","C0CCCR",72,0) 93498 CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART) ;RPC ENTRY POINT FOR CCR OUTPUT 93499 "RTN","C0CCCR",73,0) 93500 ; CCRGRTN IS RETURN ARRAY PASSED BY REFERENCE 93501 "RTN","C0CCCR",74,0) 93502 ; DFN IS PATIENT IEN 93503 "RTN","C0CCCR",75,0) 93504 ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART 93505 "RTN","C0CCCR",76,0) 93506 ; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC 93507 "RTN","C0CCCR",77,0) 93508 ; CCRPARMS ARE PARAMETERS THAT AFFECT THE EXTRACTION 93509 "RTN","C0CCCR",78,0) 93510 ; IN THE FORM "PARM1:VALUE1^PARM2:VALUE2" 93511 "RTN","C0CCCR",79,0) 93512 ; EXAMPLE: "LABLIMIT:T-60" TO LIMIT LAB EXTRACTION TO THE LAST 60 DAYS 93513 "RTN","C0CCCR",80,0) 93514 ; SEE C0CPARMS FOR A COMPLETE LIST OF SUPPORTED PARAMETERS 93515 "RTN","C0CCCR",81,0) 93516 K ^TMP("C0CCCR",$J) ; CLEAN UP THE GLOBAL BEFORE WE USE IT 93517 "RTN","C0CCCR",82,0) 93518 M ^TMP("C0CSAV",$J)=^TMP($J) ; SAVING CALLER'S TMP SETTINGS 93519 "RTN","C0CCCR",83,0) 93520 K ^TMP($J) ; START CLEAN 93521 "RTN","C0CCCR",84,0) 93522 I '$D(DEBUG) S DEBUG=0 93523 "RTN","C0CCCR",85,0) 93524 S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD 93525 "RTN","C0CCCR",86,0) 93526 I '$D(CCRPARMS) S CCRPARMS="" 93527 "RTN","C0CCCR",87,0) 93528 I '$D(CCRPART) S CCRPART="CCR" 93529 "RTN","C0CCCR",88,0) 93530 I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"CALL",DFN)="" 93531 "RTN","C0CCCR",89,0) 93532 D SET^C0CPARMS(CCRPARMS) ;SET PARAMETERS WITH CCRPARMS AS OVERRIDES 93533 "RTN","C0CCCR",90,0) 93534 I '$D(TESTVIT) S TESTVIT=0 ; FLAG FOR TESTING VITALS 93535 "RTN","C0CCCR",91,0) 93536 I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION 93537 "RTN","C0CCCR",92,0) 93538 I '$D(TESTALERT) S TESTALERT=1 ; FLAG FOR TESTING ALERTS SECTION 93539 "RTN","C0CCCR",93,0) 93540 I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING C0CMED SECTION 93541 "RTN","C0CCCR",94,0) 93542 S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE 93543 "RTN","C0CCCR",95,0) 93544 S CCRGLO=$NA(^TMP("C0CCUR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR 93545 "RTN","C0CCCR",96,0) 93546 S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS 93547 "RTN","C0CCCR",97,0) 93548 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC 93549 "RTN","C0CCCR",98,0) 93550 ;M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART OR ALL 93551 "RTN","C0CCCR",99,0) 93552 D LOAD^C0CCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE 93553 "RTN","C0CCCR",100,0) 93554 D CP^C0CXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL 93555 "RTN","C0CCCR",101,0) 93556 ; 93557 "RTN","C0CCCR",102,0) 93558 ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL 93559 "RTN","C0CCCR",103,0) 93560 ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES 93561 "RTN","C0CCCR",104,0) 93562 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") 93563 "RTN","C0CCCR",105,0) 93564 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors") 93565 "RTN","C0CCCR",106,0) 93566 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures") 93567 "RTN","C0CCCR",107,0) 93568 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Comments") 93569 "RTN","C0CCCR",108,0) 93570 I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),! 93571 "RTN","C0CCCR",109,0) 93572 ; 93573 "RTN","C0CCCR",110,0) 93574 D HDRMAP(CCRGLO,DFN) ; MAP HEADER VARIABLES 93575 "RTN","C0CCCR",111,0) 93576 ; 93577 "RTN","C0CCCR",112,0) 93578 K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT 93579 "RTN","C0CCCR",113,0) 93580 S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS 93581 "RTN","C0CCCR",114,0) 93582 D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS 93583 "RTN","C0CCCR",115,0) 93584 N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD 93585 "RTN","C0CCCR",116,0) 93586 F PROCI=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS 93587 "RTN","C0CCCR",117,0) 93588 . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE 93589 "RTN","C0CCCR",118,0) 93590 . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL 93591 "RTN","C0CCCR",119,0) 93592 . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL 93593 "RTN","C0CCCR",120,0) 93594 . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE 93595 "RTN","C0CCCR",121,0) 93596 . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS 93597 "RTN","C0CCCR",122,0) 93598 . S IXML="INXML" 93599 "RTN","C0CCCR",123,0) 93600 . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES 93601 "RTN","C0CCCR",124,0) 93602 . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY 93603 "RTN","C0CCCR",125,0) 93604 . ; W OXML,! 93605 "RTN","C0CCCR",126,0) 93606 . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL 93607 "RTN","C0CCCR",127,0) 93608 . W "RUNNING ",CALL,! 93609 "RTN","C0CCCR",128,0) 93610 . X CALL 93611 "RTN","C0CCCR",129,0) 93612 . ; NOW INSERT THE RESULTS IN THE CCR BUFFER 93613 "RTN","C0CCCR",130,0) 93614 . I $G(@OXML@(0))>0 D ; THERE IS A RESULT 93615 "RTN","C0CCCR",131,0) 93616 . . D INSERT^C0CXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body") 93617 "RTN","C0CCCR",132,0) 93618 . . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),! 93619 "RTN","C0CCCR",133,0) 93620 N ACTT,ATMP,ACTT2,ATMP2 ; TEMPORARY ARRAY SYMBOLS FOR ACTOR PROCESSING 93621 "RTN","C0CCCR",134,0) 93622 D ACTLST^C0CCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST 93623 "RTN","C0CCCR",135,0) 93624 D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT") 93625 "RTN","C0CCCR",136,0) 93626 D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2") 93627 "RTN","C0CCCR",137,0) 93628 D INSINNER^C0CXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors") 93629 "RTN","C0CCCR",138,0) 93630 K ACTT,ACTT2 93631 "RTN","C0CCCR",139,0) 93632 ;D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Comments","CMTT") 93633 "RTN","C0CCCR",140,0) 93634 ;D EXTRACT^C0CCMT("CMTT",DFN,"CMTT2") 93635 "RTN","C0CCCR",141,0) 93636 ;D INSINNER^C0CXPATH(CCRGLO,"CMTT2","//ContinuityOfCareRecord/Comments") 93637 "RTN","C0CCCR",142,0) 93638 ; gpl - turned off Comments for Certification 93639 "RTN","C0CCCR",143,0) 93640 K CMTT,CMTT2 93641 "RTN","C0CCCR",144,0) 93642 N TRIMI,J,DONE S DONE=0 93643 "RTN","C0CCCR",145,0) 93644 F TRIMI=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE 93645 "RTN","C0CCCR",146,0) 93646 . S J=$$TRIM^C0CXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS 93647 "RTN","C0CCCR",147,0) 93648 . I DEBUG W "TRIMMED",J,! 93649 "RTN","C0CCCR",148,0) 93650 . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE 93651 "RTN","C0CCCR",149,0) 93652 ;S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLOBAL OF PART OR ALL 93653 "RTN","C0CCCR",150,0) 93654 I CCRPART="CCR" M CCRGRTN=@CCRGLO ; ENTIRE CCR 93655 "RTN","C0CCCR",151,0) 93656 E M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART 93657 "RTN","C0CCCR",152,0) 93658 I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"RESULT",CCRGRTN(0))="" 93659 "RTN","C0CCCR",153,0) 93660 K ^TMP("C0CCCR",$J) ; BEGIN TO CLEAN UP 93661 "RTN","C0CCCR",154,0) 93662 K ^TMP($J) ; REALLY CLEAN UP 93663 "RTN","C0CCCR",155,0) 93664 M ^TMP($J)=^TMP("C0CSAV",$J) ; RESTORE CALLER'S $J 93665 "RTN","C0CCCR",156,0) 93666 Q 93667 "RTN","C0CCCR",157,0) 93668 ; 93669 "RTN","C0CCCR",158,0) 93670 INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS 93671 "RTN","C0CCCR",159,0) 93672 ; TAB IS PASSED BY NAME 93673 "RTN","C0CCCR",160,0) 93674 I DEBUG W "TAB= ",TAB,! 93675 "RTN","C0CCCR",161,0) 93676 ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS 93677 "RTN","C0CCCR",162,0) 93678 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")") 93679 "RTN","C0CCCR",163,0) 93680 I TESTALERT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""C0CCCR"",$J,DFN,""ALERTS"")") 93681 "RTN","C0CCCR",164,0) 93682 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")") 93683 "RTN","C0CCCR",165,0) 93684 D PUSH^C0CXPATH(TAB,"MAP;C0CIMMU;//ContinuityOfCareRecord/Body/Immunizations;^TMP(""C0CCCR"",$J,DFN,""IMMUNE"")") 93685 "RTN","C0CCCR",166,0) 93686 I TESTVIT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVIT2;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")") 93687 "RTN","C0CCCR",167,0) 93688 E D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")") 93689 "RTN","C0CCCR",168,0) 93690 D PUSH^C0CXPATH(TAB,"MAP;C0CLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""C0CCCR"",$J,DFN,""RESULTS"")") 93691 "RTN","C0CCCR",169,0) 93692 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROC;//ContinuityOfCareRecord/Body/Procedures;^TMP(""C0CCCR"",$J,DFN,""PROCEDURES"")") 93693 "RTN","C0CCCR",170,0) 93694 ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")") 93695 "RTN","C0CCCR",171,0) 93696 ; gpl - turned off Encounters for Certification 93697 "RTN","C0CCCR",172,0) 93698 ;OHUM/RUT 3120109 Changed the condition 93699 "RTN","C0CCCR",173,0) 93700 ;;OHUM/RUT 3111228 Condition for Notes ; It should be included or not 93701 "RTN","C0CCCR",174,0) 93702 ;;I ^TMP("C0CCCR","TIULIMIT")'="" D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")") 93703 "RTN","C0CCCR",175,0) 93704 I $P(^C0CPARM(1,2),"^",3)=1 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")") 93705 "RTN","C0CCCR",176,0) 93432 93706 ;;OHUM/RUT 93433 "RTN","C0CCCR", 32,0)93707 "RTN","C0CCCR",177,0) 93434 93708 ;OHUM/RUT 93435 "RTN","C0CCCR",33,0) 93436 D XPAT(DFN) ; EXPORT TO A FILE 93437 "RTN","C0CCCR",34,0) 93709 "RTN","C0CCCR",178,0) 93438 93710 Q 93439 "RTN","C0CCCR",35,0) 93440 ; 93441 "RTN","C0CCCR",36,0) 93442 XPAT(DFN,XPARMS,DIR,FN) ; EXPORT ONE PATIENT TO A FILE 93443 "RTN","C0CCCR",37,0) 93444 ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR") 93445 "RTN","C0CCCR",38,0) 93446 ; FN IS FILE NAME, DEFAULTS IF NULL 93447 "RTN","C0CCCR",39,0) 93448 N CCRGLO,UDIR,UFN 93449 "RTN","C0CCCR",40,0) 93450 S C0CNRPC=1 ; FLAG FOR NOT AN RPC CALL - FOR DEBUGGING THE RPC 93451 "RTN","C0CCCR",41,0) 93452 I '$D(DIR) S UDIR="" 93453 "RTN","C0CCCR",42,0) 93454 E S UDIR=DIR 93455 "RTN","C0CCCR",43,0) 93456 I '$D(FN) S UFN="" ; IF FILENAME IS NOT PASSED 93457 "RTN","C0CCCR",44,0) 93458 E S UFN=FN 93459 "RTN","C0CCCR",45,0) 93460 I '$D(XPARMS) S XPARMS="" 93461 "RTN","C0CCCR",46,0) 93462 N C0CRTN ; RETURN ARRAY 93463 "RTN","C0CCCR",47,0) 93464 D CCRRPC(.C0CRTN,DFN,XPARMS,"CCR") 93465 "RTN","C0CCCR",48,0) 93466 S OARY=$NA(^TMP("C0CCUR",$J,DFN,"CCR",1)) 93467 "RTN","C0CCCR",49,0) 93468 S ONAM=UFN 93469 "RTN","C0CCCR",50,0) 93470 I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_0.xml" 93471 "RTN","C0CCCR",51,0) 93472 S ODIRGLB=$NA(^TMP("C0CCCR","ODIR")) 93473 "RTN","C0CCCR",52,0) 93474 S ^TMP("C0CCCR","FNAME",DFN)=ONAM ; FILE NAME FOR BATCH USE 93475 "RTN","C0CCCR",53,0) 93476 I $D(^TMP("GPLCCR","ODIR")) S @ODIRGLB=^TMP("GPLCCR","ODIR") 93477 "RTN","C0CCCR",54,0) 93478 I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET 93479 "RTN","C0CCCR",55,0) 93480 . W "Warning.. please set ^TMP(""C0CCCR"",""ODIR"")=""output path""",! Q 93481 "RTN","C0CCCR",56,0) 93482 . ;S @ODIRGLB="/home/glilly/CCROUT" 93483 "RTN","C0CCCR",57,0) 93484 . ;S @ODIRGLB="/home/cedwards/" 93485 "RTN","C0CCCR",58,0) 93486 . S @ODIRGLB="/opt/wv/p/" 93487 "RTN","C0CCCR",59,0) 93488 S ODIR=UDIR 93489 "RTN","C0CCCR",60,0) 93490 I UDIR="" S ODIR=@ODIRGLB 93491 "RTN","C0CCCR",61,0) 93492 N ZY 93493 "RTN","C0CCCR",62,0) 93494 S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR) 93495 "RTN","C0CCCR",63,0) 93496 W !,$P(ZY,U,2),! 93497 "RTN","C0CCCR",64,0) 93711 "RTN","C0CCCR",179,0) 93712 ; 93713 "RTN","C0CCCR",180,0) 93714 HDRMAP(CXML,DFN) ; MAP HEADER VARIABLES: FROM, TO ECT 93715 "RTN","C0CCCR",181,0) 93716 N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER")) 93717 "RTN","C0CCCR",182,0) 93718 ; K @VMAP 93719 "RTN","C0CCCR",183,0) 93720 S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT") 93721 "RTN","C0CCCR",184,0) 93722 ; I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS 93723 "RTN","C0CCCR",185,0) 93724 D ; ALWAYS MAP THESE VARIABLES 93725 "RTN","C0CCCR",186,0) 93726 . S @VMAP@("CCRDOCOBJECTID")=$$UUID^C0CUTIL ; UUID FOR THIS CCR 93727 "RTN","C0CCCR",187,0) 93728 . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN 93729 "RTN","C0CCCR",188,0) 93730 . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - FROM PROVIDER 93731 "RTN","C0CCCR",189,0) 93732 . ;S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ??? 93733 "RTN","C0CCCR",190,0) 93734 . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM 93735 "RTN","C0CCCR",191,0) 93736 . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES 93737 "RTN","C0CCCR",192,0) 93738 . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES 93739 "RTN","C0CCCR",193,0) 93740 . S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES 93741 "RTN","C0CCCR",194,0) 93742 . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT 93743 "RTN","C0CCCR",195,0) 93744 ;I IHDR'="" D ; HEADER VALUES ARE PROVIDED 93745 "RTN","C0CCCR",196,0) 93746 ;. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY 93747 "RTN","C0CCCR",197,0) 93748 N CTMP 93749 "RTN","C0CCCR",198,0) 93750 D MAP^C0CXPATH(CXML,VMAP,"CTMP") 93751 "RTN","C0CCCR",199,0) 93752 D CP^C0CXPATH("CTMP",CXML) 93753 "RTN","C0CCCR",200,0) 93754 N HRIMVARS ; 93755 "RTN","C0CCCR",201,0) 93756 S HRIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"HEADER")) ; TO PERSIST VARS 93757 "RTN","C0CCCR",202,0) 93758 M @HRIMVARS@(1)=@VMAP ; PERSIST THE HEADER VARIABLES IN RIM TABLE 93759 "RTN","C0CCCR",203,0) 93760 S @HRIMVARS@(0)=1 ; ONLY ONE SET OF HEADERS PER PATIENT 93761 "RTN","C0CCCR",204,0) 93498 93762 Q 93499 "RTN","C0CCCR",65,0) 93500 ; 93501 "RTN","C0CCCR",66,0) 93502 DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED 93503 "RTN","C0CCCR",67,0) 93504 ; 93505 "RTN","C0CCCR",68,0) 93506 N G1 93507 "RTN","C0CCCR",69,0) 93508 S G1=$NA(^TMP("C0CCUR",$J,DFN,"CCR")) 93509 "RTN","C0CCCR",70,0) 93510 I $D(@G1@(0)) D ; CCR EXISTS 93511 "RTN","C0CCCR",71,0) 93512 . D PARY^C0CXPATH(G1) 93513 "RTN","C0CCCR",72,0) 93514 E W "CCR NOT CREATED, RUN D XPAT^C0CCCR(DFN,"""","""") FIRST",! 93515 "RTN","C0CCCR",73,0) 93763 "RTN","C0CCCR",205,0) 93764 ; 93765 "RTN","C0CCCR",206,0) 93766 ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML 93767 "RTN","C0CCCR",207,0) 93768 ; AXML AND ACTRTN ARE PASSED BY NAME 93769 "RTN","C0CCCR",208,0) 93770 ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2 93771 "RTN","C0CCCR",209,0) 93772 ; P1= OBJECTID - ACTORPATIENT_2 93773 "RTN","C0CCCR",210,0) 93774 ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE 93775 "RTN","C0CCCR",211,0) 93776 ;OR INSTITUTION 93777 "RTN","C0CCCR",212,0) 93778 ; OR PERSON(IN PATIENT FILE IE NOK) 93779 "RTN","C0CCCR",213,0) 93780 ; P3= IEN RECORD NUMBER FOR ACTOR - 2 93781 "RTN","C0CCCR",214,0) 93782 N I,J,K,L 93783 "RTN","C0CCCR",215,0) 93784 K @ACTRTN ; CLEAR RETURN ARRAY 93785 "RTN","C0CCCR",216,0) 93786 F I=1:1:@AXML@(0) D ; FIRST FIX MISSING LINKS 93787 "RTN","C0CCCR",217,0) 93788 . I @AXML@(I)?.E1"_<".E D ; 93789 "RTN","C0CCCR",218,0) 93790 . . N ZA,ZB 93791 "RTN","C0CCCR",219,0) 93792 . . S ZA=$P(@AXML@(I),">",1)_">" 93793 "RTN","C0CCCR",220,0) 93794 . . S ZB="<"_$P(@AXML@(I),"<",3) 93795 "RTN","C0CCCR",221,0) 93796 . . S @AXML@(I)=ZA_"ACTORORGANIZATION_1"_ZB 93797 "RTN","C0CCCR",222,0) 93798 F I=1:1:@AXML@(0) D ; SCAN ALL LINES 93799 "RTN","C0CCCR",223,0) 93800 . I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE 93801 "RTN","C0CCCR",224,0) 93802 . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1) 93803 "RTN","C0CCCR",225,0) 93804 . . I $G(LINKDEBUG) W "<ActorID>=>",J,! 93805 "RTN","C0CCCR",226,0) 93806 . . I J'="" S K(J)="" ; HASHING ACTOR 93807 "RTN","C0CCCR",227,0) 93808 . I @AXML@(I)?.E1"<LinkID>".E D ; THERE IS AN ACTOR THIS LINE 93809 "RTN","C0CCCR",228,0) 93810 . . S J=$P($P(@AXML@(I),"<LinkID>",2),"</LinkID>",1) 93811 "RTN","C0CCCR",229,0) 93812 . . I $G(LINKDEBUG) W "<LinkID>=>",J,! 93813 "RTN","C0CCCR",230,0) 93814 . . I J'="" S K(J)="" ; HASHING ACTOR 93815 "RTN","C0CCCR",231,0) 93816 . . ; TO GET RID OF DUPLICATES 93817 "RTN","C0CCCR",232,0) 93818 S I="" ; GOING TO $O THROUGH THE HASH 93819 "RTN","C0CCCR",233,0) 93820 F J=0:0 D Q:$O(K(I))="" 93821 "RTN","C0CCCR",234,0) 93822 . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS 93823 "RTN","C0CCCR",235,0) 93824 . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID 93825 "RTN","C0CCCR",236,0) 93826 . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE 93827 "RTN","C0CCCR",237,0) 93828 . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR 93829 "RTN","C0CCCR",238,0) 93830 . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY 93831 "RTN","C0CCCR",239,0) 93516 93832 Q 93517 "RTN","C0CCCR",74,0) 93518 ; 93519 "RTN","C0CCCR",75,0) 93520 CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART) ;RPC ENTRY POINT FOR CCR OUTPUT 93521 "RTN","C0CCCR",76,0) 93522 ; CCRGRTN IS RETURN ARRAY PASSED BY REFERENCE 93523 "RTN","C0CCCR",77,0) 93524 ; DFN IS PATIENT IEN 93525 "RTN","C0CCCR",78,0) 93526 ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART 93527 "RTN","C0CCCR",79,0) 93528 ; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC 93529 "RTN","C0CCCR",80,0) 93530 ; CCRPARMS ARE PARAMETERS THAT AFFECT THE EXTRACTION 93531 "RTN","C0CCCR",81,0) 93532 ; IN THE FORM "PARM1:VALUE1^PARM2:VALUE2" 93533 "RTN","C0CCCR",82,0) 93534 ; EXAMPLE: "LABLIMIT:T-60" TO LIMIT LAB EXTRACTION TO THE LAST 60 DAYS 93535 "RTN","C0CCCR",83,0) 93536 ; SEE C0CPARMS FOR A COMPLETE LIST OF SUPPORTED PARAMETERS 93537 "RTN","C0CCCR",84,0) 93538 K ^TMP("C0CCCR",$J) ; CLEAN UP THE GLOBAL BEFORE WE USE IT 93539 "RTN","C0CCCR",85,0) 93540 M ^TMP("C0CSAV",$J)=^TMP($J) ; SAVING CALLER'S TMP SETTINGS 93541 "RTN","C0CCCR",86,0) 93542 K ^TMP($J) ; START CLEAN 93543 "RTN","C0CCCR",87,0) 93544 I '$D(DEBUG) S DEBUG=0 93545 "RTN","C0CCCR",88,0) 93546 S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD 93547 "RTN","C0CCCR",89,0) 93548 I '$D(CCRPARMS) S CCRPARMS="" 93549 "RTN","C0CCCR",90,0) 93550 I '$D(CCRPART) S CCRPART="CCR" 93551 "RTN","C0CCCR",91,0) 93552 I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"CALL",DFN)="" 93553 "RTN","C0CCCR",92,0) 93554 D SET^C0CPARMS(CCRPARMS) ;SET PARAMETERS WITH CCRPARMS AS OVERRIDES 93555 "RTN","C0CCCR",93,0) 93556 I '$D(TESTVIT) S TESTVIT=0 ; FLAG FOR TESTING VITALS 93557 "RTN","C0CCCR",94,0) 93558 I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION 93559 "RTN","C0CCCR",95,0) 93560 I '$D(TESTALERT) S TESTALERT=1 ; FLAG FOR TESTING ALERTS SECTION 93561 "RTN","C0CCCR",96,0) 93562 I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING C0CMED SECTION 93563 "RTN","C0CCCR",97,0) 93564 S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE 93565 "RTN","C0CCCR",98,0) 93566 S CCRGLO=$NA(^TMP("C0CCUR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR 93567 "RTN","C0CCCR",99,0) 93568 S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS 93569 "RTN","C0CCCR",100,0) 93570 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC 93571 "RTN","C0CCCR",101,0) 93572 ;M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART OR ALL 93573 "RTN","C0CCCR",102,0) 93574 D LOAD^C0CCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE 93575 "RTN","C0CCCR",103,0) 93576 D CP^C0CXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL 93577 "RTN","C0CCCR",104,0) 93578 ; 93579 "RTN","C0CCCR",105,0) 93580 ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL 93581 "RTN","C0CCCR",106,0) 93582 ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES 93583 "RTN","C0CCCR",107,0) 93584 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") 93585 "RTN","C0CCCR",108,0) 93586 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors") 93587 "RTN","C0CCCR",109,0) 93588 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures") 93589 "RTN","C0CCCR",110,0) 93590 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Comments") 93591 "RTN","C0CCCR",111,0) 93592 I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),! 93593 "RTN","C0CCCR",112,0) 93594 ; 93595 "RTN","C0CCCR",113,0) 93596 D HDRMAP(CCRGLO,DFN) ; MAP HEADER VARIABLES 93597 "RTN","C0CCCR",114,0) 93598 ; 93599 "RTN","C0CCCR",115,0) 93600 K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT 93601 "RTN","C0CCCR",116,0) 93602 S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS 93603 "RTN","C0CCCR",117,0) 93604 D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS 93605 "RTN","C0CCCR",118,0) 93606 N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD 93607 "RTN","C0CCCR",119,0) 93608 F PROCI=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS 93609 "RTN","C0CCCR",120,0) 93610 . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE 93611 "RTN","C0CCCR",121,0) 93612 . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL 93613 "RTN","C0CCCR",122,0) 93614 . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL 93615 "RTN","C0CCCR",123,0) 93616 . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE 93617 "RTN","C0CCCR",124,0) 93618 . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS 93619 "RTN","C0CCCR",125,0) 93620 . S IXML="INXML" 93621 "RTN","C0CCCR",126,0) 93622 . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES 93623 "RTN","C0CCCR",127,0) 93624 . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY 93625 "RTN","C0CCCR",128,0) 93626 . ; W OXML,! 93627 "RTN","C0CCCR",129,0) 93628 . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL 93629 "RTN","C0CCCR",130,0) 93630 . W "RUNNING ",CALL,! 93631 "RTN","C0CCCR",131,0) 93632 . X CALL 93633 "RTN","C0CCCR",132,0) 93634 . ; NOW INSERT THE RESULTS IN THE CCR BUFFER 93635 "RTN","C0CCCR",133,0) 93636 . I $G(@OXML@(0))>0 D ; THERE IS A RESULT 93637 "RTN","C0CCCR",134,0) 93638 . . D INSERT^C0CXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body") 93639 "RTN","C0CCCR",135,0) 93640 . . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),! 93641 "RTN","C0CCCR",136,0) 93642 N ACTT,ATMP,ACTT2,ATMP2 ; TEMPORARY ARRAY SYMBOLS FOR ACTOR PROCESSING 93643 "RTN","C0CCCR",137,0) 93644 D ACTLST^C0CCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST 93645 "RTN","C0CCCR",138,0) 93646 D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT") 93647 "RTN","C0CCCR",139,0) 93648 D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2") 93649 "RTN","C0CCCR",140,0) 93650 D INSINNER^C0CXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors") 93651 "RTN","C0CCCR",141,0) 93652 K ACTT,ACTT2 93653 "RTN","C0CCCR",142,0) 93654 ;D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Comments","CMTT") 93655 "RTN","C0CCCR",143,0) 93656 ;D EXTRACT^C0CCMT("CMTT",DFN,"CMTT2") 93657 "RTN","C0CCCR",144,0) 93658 ;D INSINNER^C0CXPATH(CCRGLO,"CMTT2","//ContinuityOfCareRecord/Comments") 93659 "RTN","C0CCCR",145,0) 93660 ; gpl - turned off Comments for Certification 93661 "RTN","C0CCCR",146,0) 93662 K CMTT,CMTT2 93663 "RTN","C0CCCR",147,0) 93664 N TRIMI,J,DONE S DONE=0 93665 "RTN","C0CCCR",148,0) 93666 F TRIMI=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE 93667 "RTN","C0CCCR",149,0) 93668 . S J=$$TRIM^C0CXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS 93669 "RTN","C0CCCR",150,0) 93670 . I DEBUG W "TRIMMED",J,! 93671 "RTN","C0CCCR",151,0) 93672 . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE 93673 "RTN","C0CCCR",152,0) 93674 ;S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLOBAL OF PART OR ALL 93675 "RTN","C0CCCR",153,0) 93676 I CCRPART="CCR" M CCRGRTN=@CCRGLO ; ENTIRE CCR 93677 "RTN","C0CCCR",154,0) 93678 E M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART 93679 "RTN","C0CCCR",155,0) 93680 I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"RESULT",CCRGRTN(0))="" 93681 "RTN","C0CCCR",156,0) 93682 K ^TMP("C0CCCR",$J) ; BEGIN TO CLEAN UP 93683 "RTN","C0CCCR",157,0) 93684 K ^TMP($J) ; REALLY CLEAN UP 93685 "RTN","C0CCCR",158,0) 93686 M ^TMP($J)=^TMP("C0CSAV",$J) ; RESTORE CALLER'S $J 93687 "RTN","C0CCCR",159,0) 93833 "RTN","C0CCCR",240,0) 93834 ; 93835 "RTN","C0CCCR",241,0) 93836 TEST ; RUN ALL THE TEST CASES 93837 "RTN","C0CCCR",242,0) 93838 D TESTALL^C0CUNIT("C0CCCR") 93839 "RTN","C0CCCR",243,0) 93688 93840 Q 93689 "RTN","C0CCCR",160,0) 93690 ; 93691 "RTN","C0CCCR",161,0) 93692 INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS 93693 "RTN","C0CCCR",162,0) 93694 ; TAB IS PASSED BY NAME 93695 "RTN","C0CCCR",163,0) 93696 I DEBUG W "TAB= ",TAB,! 93697 "RTN","C0CCCR",164,0) 93698 ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS 93699 "RTN","C0CCCR",165,0) 93700 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")") 93701 "RTN","C0CCCR",166,0) 93702 I TESTALERT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""C0CCCR"",$J,DFN,""ALERTS"")") 93703 "RTN","C0CCCR",167,0) 93704 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")") 93705 "RTN","C0CCCR",168,0) 93706 D PUSH^C0CXPATH(TAB,"MAP;C0CIMMU;//ContinuityOfCareRecord/Body/Immunizations;^TMP(""C0CCCR"",$J,DFN,""IMMUNE"")") 93707 "RTN","C0CCCR",169,0) 93708 I TESTVIT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVIT2;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")") 93709 "RTN","C0CCCR",170,0) 93710 E D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")") 93711 "RTN","C0CCCR",171,0) 93712 D PUSH^C0CXPATH(TAB,"MAP;C0CLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""C0CCCR"",$J,DFN,""RESULTS"")") 93713 "RTN","C0CCCR",172,0) 93714 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROC;//ContinuityOfCareRecord/Body/Procedures;^TMP(""C0CCCR"",$J,DFN,""PROCEDURES"")") 93715 "RTN","C0CCCR",173,0) 93716 ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")") 93717 "RTN","C0CCCR",174,0) 93718 ; gpl - turned off Encounters for Certification 93719 "RTN","C0CCCR",175,0) 93720 ;OHUM/RUT 3120109 Changed the condition 93721 "RTN","C0CCCR",176,0) 93722 ;;OHUM/RUT 3111228 Condition for Notes ; It should be included or not 93723 "RTN","C0CCCR",177,0) 93724 ;;I ^TMP("C0CCCR","TIULIMIT")'="" D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")") 93725 "RTN","C0CCCR",178,0) 93726 I $P(^C0CPARM(1,2),"^",3)=1 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")") 93727 "RTN","C0CCCR",179,0) 93728 ;;OHUM/RUT 93729 "RTN","C0CCCR",180,0) 93730 ;OHUM/RUT 93731 "RTN","C0CCCR",181,0) 93841 "RTN","C0CCCR",244,0) 93842 ; 93843 "RTN","C0CCCR",245,0) 93844 ZTEST(WHICH) ; RUN ONE SET OF TESTS 93845 "RTN","C0CCCR",246,0) 93846 N ZTMP 93847 "RTN","C0CCCR",247,0) 93848 D ZLOAD^C0CUNIT("ZTMP","C0CCCR") 93849 "RTN","C0CCCR",248,0) 93850 D ZTEST^C0CUNIT(.ZTMP,WHICH) 93851 "RTN","C0CCCR",249,0) 93732 93852 Q 93733 "RTN","C0CCCR",182,0) 93734 ; 93735 "RTN","C0CCCR",183,0) 93736 HDRMAP(CXML,DFN) ; MAP HEADER VARIABLES: FROM, TO ECT 93737 "RTN","C0CCCR",184,0) 93738 N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER")) 93739 "RTN","C0CCCR",185,0) 93740 ; K @VMAP 93741 "RTN","C0CCCR",186,0) 93742 S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT") 93743 "RTN","C0CCCR",187,0) 93744 ; I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS 93745 "RTN","C0CCCR",188,0) 93746 D ; ALWAYS MAP THESE VARIABLES 93747 "RTN","C0CCCR",189,0) 93748 . S @VMAP@("CCRDOCOBJECTID")=$$UUID^C0CUTIL ; UUID FOR THIS CCR 93749 "RTN","C0CCCR",190,0) 93750 . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN 93751 "RTN","C0CCCR",191,0) 93752 . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - FROM PROVIDER 93753 "RTN","C0CCCR",192,0) 93754 . ;S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ??? 93755 "RTN","C0CCCR",193,0) 93756 . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM 93757 "RTN","C0CCCR",194,0) 93758 . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES 93759 "RTN","C0CCCR",195,0) 93760 . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES 93761 "RTN","C0CCCR",196,0) 93762 . S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES 93763 "RTN","C0CCCR",197,0) 93764 . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT 93765 "RTN","C0CCCR",198,0) 93766 ;I IHDR'="" D ; HEADER VALUES ARE PROVIDED 93767 "RTN","C0CCCR",199,0) 93768 ;. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY 93769 "RTN","C0CCCR",200,0) 93770 N CTMP 93771 "RTN","C0CCCR",201,0) 93772 D MAP^C0CXPATH(CXML,VMAP,"CTMP") 93773 "RTN","C0CCCR",202,0) 93774 D CP^C0CXPATH("CTMP",CXML) 93775 "RTN","C0CCCR",203,0) 93776 N HRIMVARS ; 93777 "RTN","C0CCCR",204,0) 93778 S HRIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"HEADER")) ; TO PERSIST VARS 93779 "RTN","C0CCCR",205,0) 93780 M @HRIMVARS@(1)=@VMAP ; PERSIST THE HEADER VARIABLES IN RIM TABLE 93781 "RTN","C0CCCR",206,0) 93782 S @HRIMVARS@(0)=1 ; ONLY ONE SET OF HEADERS PER PATIENT 93783 "RTN","C0CCCR",207,0) 93853 "RTN","C0CCCR",250,0) 93854 ; 93855 "RTN","C0CCCR",251,0) 93856 TLIST ; LIST THE TESTS 93857 "RTN","C0CCCR",252,0) 93858 N ZTMP 93859 "RTN","C0CCCR",253,0) 93860 D ZLOAD^C0CUNIT("ZTMP","C0CCCR") 93861 "RTN","C0CCCR",254,0) 93862 D TLIST^C0CUNIT(.ZTMP) 93863 "RTN","C0CCCR",255,0) 93784 93864 Q 93785 "RTN","C0CCCR",208,0)93786 ;93787 "RTN","C0CCCR",209,0)93788 ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML93789 "RTN","C0CCCR",210,0)93790 ; AXML AND ACTRTN ARE PASSED BY NAME93791 "RTN","C0CCCR",211,0)93792 ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_293793 "RTN","C0CCCR",212,0)93794 ; P1= OBJECTID - ACTORPATIENT_293795 "RTN","C0CCCR",213,0)93796 ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE93797 "RTN","C0CCCR",214,0)93798 ;OR INSTITUTION93799 "RTN","C0CCCR",215,0)93800 ; OR PERSON(IN PATIENT FILE IE NOK)93801 "RTN","C0CCCR",216,0)93802 ; P3= IEN RECORD NUMBER FOR ACTOR - 293803 "RTN","C0CCCR",217,0)93804 N I,J,K,L93805 "RTN","C0CCCR",218,0)93806 K @ACTRTN ; CLEAR RETURN ARRAY93807 "RTN","C0CCCR",219,0)93808 F I=1:1:@AXML@(0) D ; FIRST FIX MISSING LINKS93809 "RTN","C0CCCR",220,0)93810 . I @AXML@(I)?.E1"_<".E D ;93811 "RTN","C0CCCR",221,0)93812 . . N ZA,ZB93813 "RTN","C0CCCR",222,0)93814 . . S ZA=$P(@AXML@(I),">",1)_">"93815 "RTN","C0CCCR",223,0)93816 . . S ZB="<"_$P(@AXML@(I),"<",3)93817 "RTN","C0CCCR",224,0)93818 . . S @AXML@(I)=ZA_"ACTORORGANIZATION_1"_ZB93819 "RTN","C0CCCR",225,0)93820 F I=1:1:@AXML@(0) D ; SCAN ALL LINES93821 "RTN","C0CCCR",226,0)93822 . I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE93823 "RTN","C0CCCR",227,0)93824 . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)93825 "RTN","C0CCCR",228,0)93826 . . I $G(LINKDEBUG) W "<ActorID>=>",J,!93827 "RTN","C0CCCR",229,0)93828 . . I J'="" S K(J)="" ; HASHING ACTOR93829 "RTN","C0CCCR",230,0)93830 . I @AXML@(I)?.E1"<LinkID>".E D ; THERE IS AN ACTOR THIS LINE93831 "RTN","C0CCCR",231,0)93832 . . S J=$P($P(@AXML@(I),"<LinkID>",2),"</LinkID>",1)93833 "RTN","C0CCCR",232,0)93834 . . I $G(LINKDEBUG) W "<LinkID>=>",J,!93835 "RTN","C0CCCR",233,0)93836 . . I J'="" S K(J)="" ; HASHING ACTOR93837 "RTN","C0CCCR",234,0)93838 . . ; TO GET RID OF DUPLICATES93839 "RTN","C0CCCR",235,0)93840 S I="" ; GOING TO $O THROUGH THE HASH93841 "RTN","C0CCCR",236,0)93842 F J=0:0 D Q:$O(K(I))=""93843 "RTN","C0CCCR",237,0)93844 . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS93845 "RTN","C0CCCR",238,0)93846 . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID93847 "RTN","C0CCCR",239,0)93848 . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE93849 "RTN","C0CCCR",240,0)93850 . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR93851 "RTN","C0CCCR",241,0)93852 . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY93853 "RTN","C0CCCR",242,0)93854 Q93855 "RTN","C0CCCR",243,0)93856 ;93857 "RTN","C0CCCR",244,0)93858 TEST ; RUN ALL THE TEST CASES93859 "RTN","C0CCCR",245,0)93860 D TESTALL^C0CUNIT("C0CCCR")93861 "RTN","C0CCCR",246,0)93862 Q93863 "RTN","C0CCCR",247,0)93864 ;93865 "RTN","C0CCCR",248,0)93866 ZTEST(WHICH) ; RUN ONE SET OF TESTS93867 "RTN","C0CCCR",249,0)93868 N ZTMP93869 "RTN","C0CCCR",250,0)93870 D ZLOAD^C0CUNIT("ZTMP","C0CCCR")93871 "RTN","C0CCCR",251,0)93872 D ZTEST^C0CUNIT(.ZTMP,WHICH)93873 "RTN","C0CCCR",252,0)93874 Q93875 "RTN","C0CCCR",253,0)93876 ;93877 "RTN","C0CCCR",254,0)93878 TLIST ; LIST THE TESTS93879 "RTN","C0CCCR",255,0)93880 N ZTMP93881 93865 "RTN","C0CCCR",256,0) 93882 D ZLOAD^C0CUNIT("ZTMP","C0CCCR")93866 ; 93883 93867 "RTN","C0CCCR",257,0) 93884 D TLIST^C0CUNIT(.ZTMP)93868 ;;><TEST> 93885 93869 "RTN","C0CCCR",258,0) 93886 Q93870 ;;><PROBLEMS> 93887 93871 "RTN","C0CCCR",259,0) 93888 ; 93872 ;;>>>K C0C S C0C="" 93889 93873 "RTN","C0CCCR",260,0) 93890 ;;> <TEST>93874 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","") 93891 93875 "RTN","C0CCCR",261,0) 93892 ;;> <PROBLEMS>93876 ;;>>?@C0C@(@C0C@(0))["</Problems>" 93893 93877 "RTN","C0CCCR",262,0) 93878 ;;><VITALS> 93879 "RTN","C0CCCR",263,0) 93894 93880 ;;>>>K C0C S C0C="" 93895 "RTN","C0CCCR",263,0)93896 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","")93897 93881 "RTN","C0CCCR",264,0) 93898 ;;>> ?@C0C@(@C0C@(0))["</Problems>"93882 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","") 93899 93883 "RTN","C0CCCR",265,0) 93900 ;;> <VITALS>93884 ;;>>?@C0C@(@C0C@(0))["</VitalSigns>" 93901 93885 "RTN","C0CCCR",266,0) 93886 ;;><CCR> 93887 "RTN","C0CCCR",267,0) 93902 93888 ;;>>>K C0C S C0C="" 93903 "RTN","C0CCCR",267,0)93904 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","")93905 93889 "RTN","C0CCCR",268,0) 93906 ;;>> ?@C0C@(@C0C@(0))["</VitalSigns>"93890 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","") 93907 93891 "RTN","C0CCCR",269,0) 93908 ;;> <CCR>93892 ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>" 93909 93893 "RTN","C0CCCR",270,0) 93894 ;;><ACTLST> 93895 "RTN","C0CCCR",271,0) 93910 93896 ;;>>>K C0C S C0C="" 93911 "RTN","C0CCCR",27 1,0)93897 "RTN","C0CCCR",272,0) 93912 93898 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","") 93913 "RTN","C0CCCR",272,0)93914 ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"93915 93899 "RTN","C0CCCR",273,0) 93916 ;;> <ACTLST>93900 ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST") 93917 93901 "RTN","C0CCCR",274,0) 93902 ;;><ACTORS> 93903 "RTN","C0CCCR",275,0) 93904 ;;>>>D ZTEST^C0CCCR("ACTLST") 93905 "RTN","C0CCCR",276,0) 93906 ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2") 93907 "RTN","C0CCCR",277,0) 93908 ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3") 93909 "RTN","C0CCCR",278,0) 93910 ;;>>?G3(G3(0))["</Actors>" 93911 "RTN","C0CCCR",279,0) 93912 ;;><TRIM> 93913 "RTN","C0CCCR",280,0) 93914 ;;>>>D ZTEST^C0CCCR("CCR") 93915 "RTN","C0CCCR",281,0) 93916 ;;>>>W $$TRIM^C0CXPATH(CCRGLO) 93917 "RTN","C0CCCR",282,0) 93918 ;;><ALERTS> 93919 "RTN","C0CCCR",283,0) 93920 ;;>>>S TESTALERT=1 93921 "RTN","C0CCCR",284,0) 93918 93922 ;;>>>K C0C S C0C="" 93919 "RTN","C0CCCR",275,0)93920 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")93921 "RTN","C0CCCR",276,0)93922 ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST")93923 "RTN","C0CCCR",277,0)93924 ;;><ACTORS>93925 "RTN","C0CCCR",278,0)93926 ;;>>>D ZTEST^C0CCCR("ACTLST")93927 "RTN","C0CCCR",279,0)93928 ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")93929 "RTN","C0CCCR",280,0)93930 ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3")93931 "RTN","C0CCCR",281,0)93932 ;;>>?G3(G3(0))["</Actors>"93933 "RTN","C0CCCR",282,0)93934 ;;><TRIM>93935 "RTN","C0CCCR",283,0)93936 ;;>>>D ZTEST^C0CCCR("CCR")93937 "RTN","C0CCCR",284,0)93938 ;;>>>W $$TRIM^C0CXPATH(CCRGLO)93939 93923 "RTN","C0CCCR",285,0) 93940 ;;> <ALERTS>93924 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","") 93941 93925 "RTN","C0CCCR",286,0) 93942 ;;>>>S TESTALERT=193943 "RTN","C0CCCR",287,0)93944 ;;>>>K C0C S C0C=""93945 "RTN","C0CCCR",288,0)93946 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","")93947 "RTN","C0CCCR",289,0)93948 93926 ;;>>?@C0C@(@C0C@(0))["</Alerts>" 93949 "RTN","C0CCCR",290,0)93950 93951 "RTN","C0CCCR",291,0)93952 93953 93927 "RTN","C0CCCR0") 93954 0^42^B7 9041917293928 0^42^B785598655 93955 93929 "RTN","C0CCCR0",1,0) 93956 93930 C0CCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08 93957 93931 "RTN","C0CCCR0",2,0) 93958 ;;1.2;C 0C;;May 11, 2012;Build 5093932 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 93959 93933 "RTN","C0CCCR0",3,0) 93960 93934 ;Copyright 2008,2009 George Lilly, University of Minnesota. 93961 93935 "RTN","C0CCCR0",4,0) 93962 ; Licensed under the terms of the GNU General Public License.93936 ; 93963 93937 "RTN","C0CCCR0",5,0) 93964 ; See attached copy of the License.93938 ; This program is free software: you can redistribute it and/or modify 93965 93939 "RTN","C0CCCR0",6,0) 93966 ; 93940 ; it under the terms of the GNU Affero General Public License as 93967 93941 "RTN","C0CCCR0",7,0) 93968 ; This program is free software; you can redistribute it and/or modify93942 ; published by the Free Software Foundation, either version 3 of the 93969 93943 "RTN","C0CCCR0",8,0) 93970 ; it under the terms of the GNU General Public License as published by93944 ; License, or (at your option) any later version. 93971 93945 "RTN","C0CCCR0",9,0) 93972 ; the Free Software Foundation; either version 2 of the License, or93946 ; 93973 93947 "RTN","C0CCCR0",10,0) 93974 ; (at your option) any later version.93948 ; This program is distributed in the hope that it will be useful, 93975 93949 "RTN","C0CCCR0",11,0) 93976 ; 93950 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 93977 93951 "RTN","C0CCCR0",12,0) 93978 ; This program is distributed in the hope that it will be useful,93952 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 93979 93953 "RTN","C0CCCR0",13,0) 93980 ; but WITHOUT ANY WARRANTY; without even the implied warranty of93954 ; GNU Affero General Public License for more details. 93981 93955 "RTN","C0CCCR0",14,0) 93982 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the93956 ; 93983 93957 "RTN","C0CCCR0",15,0) 93984 ; GNU General Public License for more details.93958 ; You should have received a copy of the GNU Affero General Public License 93985 93959 "RTN","C0CCCR0",16,0) 93986 ; 93960 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 93987 93961 "RTN","C0CCCR0",17,0) 93988 ; You should have received a copy of the GNU General Public License along93962 ; 93989 93963 "RTN","C0CCCR0",18,0) 93990 ;with this program; if not, write to the Free Software Foundation, Inc.,93964 W "This is a CCR TEMPLATE with processing routines",! 93991 93965 "RTN","C0CCCR0",19,0) 93992 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.93966 W ! 93993 93967 "RTN","C0CCCR0",20,0) 93994 ;93968 Q 93995 93969 "RTN","C0CCCR0",21,0) 93996 W "This is a CCR TEMPLATE with processing routines",!93970 ; 93997 93971 "RTN","C0CCCR0",22,0) 93998 W ! 93972 ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array 93999 93973 "RTN","C0CCCR0",23,0) 93974 ; ZARY IS PASSED BY NAME 93975 "RTN","C0CCCR0",24,0) 93976 ; BAT is a string identifying the section 93977 "RTN","C0CCCR0",25,0) 93978 ; LINE is a test which will evaluate to true or false 93979 "RTN","C0CCCR0",26,0) 93980 ; I '$G(@ZARY) D ; 93981 "RTN","C0CCCR0",27,0) 93982 ; . S @ZARY@(0)=0 ; initially there are no elements 93983 "RTN","C0CCCR0",28,0) 93984 ; . W "GOT HERE LOADING "_LINE,! 93985 "RTN","C0CCCR0",29,0) 93986 N CNT ; count of array elements 93987 "RTN","C0CCCR0",30,0) 93988 S CNT=@ZARY@(0) ; contains array count 93989 "RTN","C0CCCR0",31,0) 93990 S CNT=CNT+1 ; increment count 93991 "RTN","C0CCCR0",32,0) 93992 S @ZARY@(CNT)=LINE ; put the line in the array 93993 "RTN","C0CCCR0",33,0) 93994 ; S @ZARY@(BAT,CNT)="" ; index the test by battery 93995 "RTN","C0CCCR0",34,0) 93996 S @ZARY@(0)=CNT ; update the array counter 93997 "RTN","C0CCCR0",35,0) 94000 93998 Q 94001 "RTN","C0CCCR0", 24,0)94002 ; 94003 "RTN","C0CCCR0", 25,0)94004 Z T(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array94005 "RTN","C0CCCR0", 26,0)93999 "RTN","C0CCCR0",36,0) 94000 ; 94001 "RTN","C0CCCR0",37,0) 94002 ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference 94003 "RTN","C0CCCR0",38,0) 94006 94004 ; ZARY IS PASSED BY NAME 94007 "RTN","C0CCCR0",27,0) 94008 ; BAT is a string identifying the section 94009 "RTN","C0CCCR0",28,0) 94010 ; LINE is a test which will evaluate to true or false 94011 "RTN","C0CCCR0",29,0) 94012 ; I '$G(@ZARY) D ; 94013 "RTN","C0CCCR0",30,0) 94014 ; . S @ZARY@(0)=0 ; initially there are no elements 94015 "RTN","C0CCCR0",31,0) 94016 ; . W "GOT HERE LOADING "_LINE,! 94017 "RTN","C0CCCR0",32,0) 94018 N CNT ; count of array elements 94019 "RTN","C0CCCR0",33,0) 94020 S CNT=@ZARY@(0) ; contains array count 94021 "RTN","C0CCCR0",34,0) 94022 S CNT=CNT+1 ; increment count 94023 "RTN","C0CCCR0",35,0) 94024 S @ZARY@(CNT)=LINE ; put the line in the array 94025 "RTN","C0CCCR0",36,0) 94026 ; S @ZARY@(BAT,CNT)="" ; index the test by battery 94027 "RTN","C0CCCR0",37,0) 94028 S @ZARY@(0)=CNT ; update the array counter 94029 "RTN","C0CCCR0",38,0) 94005 "RTN","C0CCCR0",39,0) 94006 ; ZARY = name of the root, closed array format (e.g., "^TMP($J)") 94007 "RTN","C0CCCR0",40,0) 94008 ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE 94009 "RTN","C0CCCR0",41,0) 94010 K @ZARY S @ZARY="" 94011 "RTN","C0CCCR0",42,0) 94012 S @ZARY@(0)=0 ; initialize array count 94013 "RTN","C0CCCR0",43,0) 94014 N LINE,LABEL,BODY 94015 "RTN","C0CCCR0",44,0) 94016 N INTEST S INTEST=0 ; switch for in the TEMPLATE section 94017 "RTN","C0CCCR0",45,0) 94018 N SECTION S SECTION="[anonymous]" ; NO section LABEL 94019 "RTN","C0CCCR0",46,0) 94020 ; 94021 "RTN","C0CCCR0",47,0) 94022 N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D 94023 "RTN","C0CCCR0",48,0) 94024 . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section 94025 "RTN","C0CCCR0",49,0) 94026 . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section 94027 "RTN","C0CCCR0",50,0) 94028 . I INTEST D ; within the section 94029 "RTN","C0CCCR0",51,0) 94030 . . I LINE?." "1";><".E D ; sub-section name found 94031 "RTN","C0CCCR0",52,0) 94032 . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name 94033 "RTN","C0CCCR0",53,0) 94034 . . I LINE?." "1";;".E D ; line found 94035 "RTN","C0CCCR0",54,0) 94036 . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array 94037 "RTN","C0CCCR0",55,0) 94030 94038 Q 94031 "RTN","C0CCCR0",39,0)94032 ;94033 "RTN","C0CCCR0",40,0)94034 ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference94035 "RTN","C0CCCR0",41,0)94036 ; ZARY IS PASSED BY NAME94037 "RTN","C0CCCR0",42,0)94038 ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")94039 "RTN","C0CCCR0",43,0)94040 ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE94041 "RTN","C0CCCR0",44,0)94042 K @ZARY S @ZARY=""94043 "RTN","C0CCCR0",45,0)94044 S @ZARY@(0)=0 ; initialize array count94045 "RTN","C0CCCR0",46,0)94046 N LINE,LABEL,BODY94047 "RTN","C0CCCR0",47,0)94048 N INTEST S INTEST=0 ; switch for in the TEMPLATE section94049 "RTN","C0CCCR0",48,0)94050 N SECTION S SECTION="[anonymous]" ; NO section LABEL94051 "RTN","C0CCCR0",49,0)94052 ;94053 "RTN","C0CCCR0",50,0)94054 N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D94055 "RTN","C0CCCR0",51,0)94056 . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section94057 "RTN","C0CCCR0",52,0)94058 . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section94059 "RTN","C0CCCR0",53,0)94060 . I INTEST D ; within the section94061 "RTN","C0CCCR0",54,0)94062 . . I LINE?." "1";><".E D ; sub-section name found94063 "RTN","C0CCCR0",55,0)94064 . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name94065 94039 "RTN","C0CCCR0",56,0) 94066 . . I LINE?." "1";;".E D ; line found94040 ; 94067 94041 "RTN","C0CCCR0",57,0) 94068 . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array 94042 LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME 94069 94043 "RTN","C0CCCR0",58,0) 94044 D ZLOAD(ARY,"C0CCCR0") 94045 "RTN","C0CCCR0",59,0) 94046 ; ZWR @ARY 94047 "RTN","C0CCCR0",60,0) 94070 94048 Q 94071 "RTN","C0CCCR0",59,0)94072 ;94073 "RTN","C0CCCR0",60,0)94074 LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME94075 94049 "RTN","C0CCCR0",61,0) 94076 D ZLOAD(ARY,"C0CCCR0")94050 ; 94077 94051 "RTN","C0CCCR0",62,0) 94078 ; ZWR @ARY94052 ;<TEMPLATE> 94079 94053 "RTN","C0CCCR0",63,0) 94080 Q94054 ;;<?xml version="1.0" encoding="UTF-8"?> 94081 94055 "RTN","C0CCCR0",64,0) 94082 ; 94056 ;;<?xml-stylesheet type="text/xsl" href="ccr.xsl"?> 94083 94057 "RTN","C0CCCR0",65,0) 94084 ; <TEMPLATE>94058 ;;<ContinuityOfCareRecord xmlns="urn:astm-org:CCR"> 94085 94059 "RTN","C0CCCR0",66,0) 94086 ;;< ?xml version="1.0" encoding="UTF-8"?>94060 ;;<CCRDocumentObjectID>@@CCRDOCOBJECTID@@</CCRDocumentObjectID> 94087 94061 "RTN","C0CCCR0",67,0) 94088 ;;< ?xml-stylesheet type="text/xsl" href="ccr.xsl"?>94062 ;;<Language> 94089 94063 "RTN","C0CCCR0",68,0) 94090 ;;< ContinuityOfCareRecord xmlns="urn:astm-org:CCR">94064 ;;<Text>English</Text> 94091 94065 "RTN","C0CCCR0",69,0) 94092 ;;< CCRDocumentObjectID>@@CCRDOCOBJECTID@@</CCRDocumentObjectID>94066 ;;</Language> 94093 94067 "RTN","C0CCCR0",70,0) 94094 ;;< Language>94068 ;;<Version>V1.0</Version> 94095 94069 "RTN","C0CCCR0",71,0) 94096 ;;< Text>English</Text>94070 ;;<DateTime> 94097 94071 "RTN","C0CCCR0",72,0) 94098 ;;< /Language>94072 ;;<ExactDateTime>@@DATETIME@@</ExactDateTime> 94099 94073 "RTN","C0CCCR0",73,0) 94100 ;;< Version>V1.0</Version>94074 ;;</DateTime> 94101 94075 "RTN","C0CCCR0",74,0) 94102 ;;< DateTime>94076 ;;<Patient> 94103 94077 "RTN","C0CCCR0",75,0) 94104 ;;< ExactDateTime>@@DATETIME@@</ExactDateTime>94078 ;;<ActorID>@@ACTORPATIENT@@</ActorID> 94105 94079 "RTN","C0CCCR0",76,0) 94106 ;;</ DateTime>94080 ;;</Patient> 94107 94081 "RTN","C0CCCR0",77,0) 94108 ;;< Patient>94082 ;;<From> 94109 94083 "RTN","C0CCCR0",78,0) 94110 ;;<Actor ID>@@ACTORPATIENT@@</ActorID>94084 ;;<ActorLink> 94111 94085 "RTN","C0CCCR0",79,0) 94112 ;;< /Patient>94086 ;;<ActorID>@@ACTORFROM@@</ActorID> 94113 94087 "RTN","C0CCCR0",80,0) 94114 ;;< From>94088 ;;</ActorLink> 94115 94089 "RTN","C0CCCR0",81,0) 94116 94090 ;;<ActorLink> 94117 94091 "RTN","C0CCCR0",82,0) 94118 ;;<ActorID>@@ACTORFROM @@</ActorID>94092 ;;<ActorID>@@ACTORFROM2@@</ActorID> 94119 94093 "RTN","C0CCCR0",83,0) 94120 94094 ;;</ActorLink> 94121 94095 "RTN","C0CCCR0",84,0) 94096 ;;</From> 94097 "RTN","C0CCCR0",85,0) 94098 ;;<To> 94099 "RTN","C0CCCR0",86,0) 94122 94100 ;;<ActorLink> 94123 "RTN","C0CCCR0",85,0) 94124 ;;<ActorID>@@ACTORFROM2@@</ActorID> 94125 "RTN","C0CCCR0",86,0) 94101 "RTN","C0CCCR0",87,0) 94102 ;;<ActorID>@@ACTORTO@@</ActorID> 94103 "RTN","C0CCCR0",88,0) 94104 ;;<ActorRole> 94105 "RTN","C0CCCR0",89,0) 94106 ;;<Text>@@ACTORTOTEXT@@</Text> 94107 "RTN","C0CCCR0",90,0) 94108 ;;</ActorRole> 94109 "RTN","C0CCCR0",91,0) 94126 94110 ;;</ActorLink> 94127 "RTN","C0CCCR0",87,0) 94128 ;;</From> 94129 "RTN","C0CCCR0",88,0) 94130 ;;<To> 94131 "RTN","C0CCCR0",89,0) 94132 ;;<ActorLink> 94133 "RTN","C0CCCR0",90,0) 94134 ;;<ActorID>@@ACTORTO@@</ActorID> 94135 "RTN","C0CCCR0",91,0) 94111 "RTN","C0CCCR0",92,0) 94112 ;;</To> 94113 "RTN","C0CCCR0",93,0) 94114 ;;<Purpose> 94115 "RTN","C0CCCR0",94,0) 94116 ;;<Description> 94117 "RTN","C0CCCR0",95,0) 94118 ;;<Text>@@PURPOSEDESCRIPTION@@</Text> 94119 "RTN","C0CCCR0",96,0) 94120 ;;</Description> 94121 "RTN","C0CCCR0",97,0) 94122 ;;</Purpose> 94123 "RTN","C0CCCR0",98,0) 94124 ;;<Body> 94125 "RTN","C0CCCR0",99,0) 94126 ;;<Problems> 94127 "RTN","C0CCCR0",100,0) 94128 ;;<Problem> 94129 "RTN","C0CCCR0",101,0) 94130 ;;<CCRDataObjectID>@@PROBLEMOBJECTID@@</CCRDataObjectID> 94131 "RTN","C0CCCR0",102,0) 94132 ;;<DateTime> 94133 "RTN","C0CCCR0",103,0) 94134 ;;<ExactDateTime>@@PROBLEMDATEMOD@@</ExactDateTime> 94135 "RTN","C0CCCR0",104,0) 94136 ;;</DateTime> 94137 "RTN","C0CCCR0",105,0) 94138 ;;<Type> 94139 "RTN","C0CCCR0",106,0) 94140 ;;<Text>Problem</Text> 94141 "RTN","C0CCCR0",107,0) 94142 ;;</Type> 94143 "RTN","C0CCCR0",108,0) 94144 ;;<Description> 94145 "RTN","C0CCCR0",109,0) 94146 ;;<Text>@@PROBLEMDESCRIPTION@@</Text> 94147 "RTN","C0CCCR0",110,0) 94148 ;;<Code> 94149 "RTN","C0CCCR0",111,0) 94150 ;;<Value>@@PROBLEMCODEVALUE@@</Value> 94151 "RTN","C0CCCR0",112,0) 94152 ;;<CodingSystem>ICD9CM</CodingSystem> 94153 "RTN","C0CCCR0",113,0) 94154 ;;<Version>@@PROBLEMCODINGVERSION@@</Version> 94155 "RTN","C0CCCR0",114,0) 94156 ;;</Code> 94157 "RTN","C0CCCR0",115,0) 94158 ;;</Description> 94159 "RTN","C0CCCR0",116,0) 94160 ;;<Status> 94161 "RTN","C0CCCR0",117,0) 94162 ;;<Text>@@PROBLEMSTATUS@@</Text> 94163 "RTN","C0CCCR0",118,0) 94164 ;;</Status> 94165 "RTN","C0CCCR0",119,0) 94166 ;;<Source> 94167 "RTN","C0CCCR0",120,0) 94168 ;;<Actor> 94169 "RTN","C0CCCR0",121,0) 94170 ;;<ActorID>@@PROBLEMSOURCEACTORID@@</ActorID> 94171 "RTN","C0CCCR0",122,0) 94172 ;;</Actor> 94173 "RTN","C0CCCR0",123,0) 94174 ;;</Source> 94175 "RTN","C0CCCR0",124,0) 94176 ;;</Problem> 94177 "RTN","C0CCCR0",125,0) 94178 ;;</Problems> 94179 "RTN","C0CCCR0",126,0) 94180 ;;<Immunizations> 94181 "RTN","C0CCCR0",127,0) 94182 ;;<Immunization> 94183 "RTN","C0CCCR0",128,0) 94184 ;;<CCRDataObjectID>@@IMMUNEOBJECTID@@</CCRDataObjectID> 94185 "RTN","C0CCCR0",129,0) 94186 ;;<DateTime> 94187 "RTN","C0CCCR0",130,0) 94188 ;;<Type> 94189 "RTN","C0CCCR0",131,0) 94190 ;;<Text>@@IMMUNEDATETIMETYPETEXT@@</Text> 94191 "RTN","C0CCCR0",132,0) 94192 ;;</Type> 94193 "RTN","C0CCCR0",133,0) 94194 ;;<ExactDateTime>@@IMMUNEDATETIME@@</ExactDateTime> 94195 "RTN","C0CCCR0",134,0) 94196 ;;</DateTime> 94197 "RTN","C0CCCR0",135,0) 94198 ;;<Source> 94199 "RTN","C0CCCR0",136,0) 94200 ;;<Actor> 94201 "RTN","C0CCCR0",137,0) 94202 ;;<ActorID>@@IMMUNESOURCEACTORID@@</ActorID> 94203 "RTN","C0CCCR0",138,0) 94204 ;;</Actor> 94205 "RTN","C0CCCR0",139,0) 94206 ;;</Source> 94207 "RTN","C0CCCR0",140,0) 94208 ;;<Product> 94209 "RTN","C0CCCR0",141,0) 94210 ;;<ProductName> 94211 "RTN","C0CCCR0",142,0) 94212 ;;<Text>@@IMMUNEPRODUCTNAMETEXT@@</Text> 94213 "RTN","C0CCCR0",143,0) 94214 ;;<Code> 94215 "RTN","C0CCCR0",144,0) 94216 ;;<Value>@@IMMUNEPRODUCTCODE@@</Value> 94217 "RTN","C0CCCR0",145,0) 94218 ;;<CodingSystem>@@IMMUNEPRODUCTCODESYSTEM@@</CodingSystem> 94219 "RTN","C0CCCR0",146,0) 94220 ;;</Code> 94221 "RTN","C0CCCR0",147,0) 94222 ;;</ProductName> 94223 "RTN","C0CCCR0",148,0) 94224 ;;</Product> 94225 "RTN","C0CCCR0",149,0) 94226 ;;</Immunization> 94227 "RTN","C0CCCR0",150,0) 94228 ;;</Immunizations> 94229 "RTN","C0CCCR0",151,0) 94230 ;;<FamilyHistory> 94231 "RTN","C0CCCR0",152,0) 94232 ;;<FamilyProblemHistory> 94233 "RTN","C0CCCR0",153,0) 94234 ;;<CCRDataObjectID>@@FAMILYHISTORYOBJECTID@@</CCRDataObjectID> 94235 "RTN","C0CCCR0",154,0) 94236 ;;<Source> 94237 "RTN","C0CCCR0",155,0) 94238 ;;<Actor> 94239 "RTN","C0CCCR0",156,0) 94240 ;;<ActorID>@@FAMILYHISTORYACTORID@@</ActorID> 94241 "RTN","C0CCCR0",157,0) 94242 ;;</Actor> 94243 "RTN","C0CCCR0",158,0) 94244 ;;</Source> 94245 "RTN","C0CCCR0",159,0) 94246 ;;<FamilyMember> 94247 "RTN","C0CCCR0",160,0) 94248 ;;<ActorID>@@FAMILYMEMBERACTORID@@</ActorID> 94249 "RTN","C0CCCR0",161,0) 94136 94250 ;;<ActorRole> 94137 "RTN","C0CCCR0", 92,0)94138 ;;<Text>@@ ACTORTOTEXT@@</Text>94139 "RTN","C0CCCR0", 93,0)94251 "RTN","C0CCCR0",162,0) 94252 ;;<Text>@@FAMILYMEMBERACTORROLETEXT@@</Text> 94253 "RTN","C0CCCR0",163,0) 94140 94254 ;;</ActorRole> 94141 "RTN","C0CCCR0",94,0) 94142 ;;</ActorLink> 94143 "RTN","C0CCCR0",95,0) 94144 ;;</To> 94145 "RTN","C0CCCR0",96,0) 94146 ;;<Purpose> 94147 "RTN","C0CCCR0",97,0) 94255 "RTN","C0CCCR0",164,0) 94256 ;;<Source> 94257 "RTN","C0CCCR0",165,0) 94258 ;;<Actor> 94259 "RTN","C0CCCR0",166,0) 94260 ;;<ActorID>@@FAMILYMEMBERSOURCACTORID@@</ActorID> 94261 "RTN","C0CCCR0",167,0) 94262 ;;</Actor> 94263 "RTN","C0CCCR0",168,0) 94264 ;;</Source> 94265 "RTN","C0CCCR0",169,0) 94266 ;;</FamilyMember> 94267 "RTN","C0CCCR0",170,0) 94268 ;;<Problem> 94269 "RTN","C0CCCR0",171,0) 94270 ;;<Type> 94271 "RTN","C0CCCR0",172,0) 94272 ;;<Text>Problem</Text> 94273 "RTN","C0CCCR0",173,0) 94274 ;;</Type> 94275 "RTN","C0CCCR0",174,0) 94148 94276 ;;<Description> 94149 "RTN","C0CCCR0",98,0) 94150 ;;<Text>@@PURPOSEDESCRIPTION@@</Text> 94151 "RTN","C0CCCR0",99,0) 94277 "RTN","C0CCCR0",175,0) 94278 ;;<Text>@@FAMILYMEMBERPROBLEMDESCRIPTION@@</Text> 94279 "RTN","C0CCCR0",176,0) 94280 ;;<Code> 94281 "RTN","C0CCCR0",177,0) 94282 ;;<Value>@@FAMILYMEMBERPROBLEMCODE@@</Value> 94283 "RTN","C0CCCR0",178,0) 94284 ;;<CodingSystem>@@FAMILYMEMBERCODESYSTEM@@</CodingSystem> 94285 "RTN","C0CCCR0",179,0) 94286 ;;<Version>@@FAMILYMEMBERCODEVERSION@@</Version> 94287 "RTN","C0CCCR0",180,0) 94288 ;;</Code> 94289 "RTN","C0CCCR0",181,0) 94152 94290 ;;</Description> 94153 "RTN","C0CCCR0",100,0) 94154 ;;</Purpose> 94155 "RTN","C0CCCR0",101,0) 94156 ;;<Body> 94157 "RTN","C0CCCR0",102,0) 94158 ;;<Problems> 94159 "RTN","C0CCCR0",103,0) 94291 "RTN","C0CCCR0",182,0) 94292 ;;<Source> 94293 "RTN","C0CCCR0",183,0) 94294 ;;<Actor> 94295 "RTN","C0CCCR0",184,0) 94296 ;;<ActorID>@@FAMILYMEMBERPROBLEMSOURCEID@@</ActorID> 94297 "RTN","C0CCCR0",185,0) 94298 ;;</Actor> 94299 "RTN","C0CCCR0",186,0) 94300 ;;</Source> 94301 "RTN","C0CCCR0",187,0) 94302 ;;</Problem> 94303 "RTN","C0CCCR0",188,0) 94304 ;;</FamilyProblemHistory> 94305 "RTN","C0CCCR0",189,0) 94306 ;;</FamilyHistory> 94307 "RTN","C0CCCR0",190,0) 94308 ;;<SocialHistory> 94309 "RTN","C0CCCR0",191,0) 94310 ;;<SocialHistoryElement> 94311 "RTN","C0CCCR0",192,0) 94312 ;;<CCRDataObjectID>@@SOCIALHISTORYOBJECTID@@</CCRDataObjectID> 94313 "RTN","C0CCCR0",193,0) 94314 ;;<Type> 94315 "RTN","C0CCCR0",194,0) 94316 ;;<Text>@@SOCIALHISTORYTYPETEXT@@</Text> 94317 "RTN","C0CCCR0",195,0) 94318 ;;</Type> 94319 "RTN","C0CCCR0",196,0) 94320 ;;<Description> 94321 "RTN","C0CCCR0",197,0) 94322 ;;<Text>@@SOCIALHISTORYDESCRIPTIONTEXT@@</Text> 94323 "RTN","C0CCCR0",198,0) 94324 ;;</Description> 94325 "RTN","C0CCCR0",199,0) 94326 ;;<Source> 94327 "RTN","C0CCCR0",200,0) 94328 ;;<Actor> 94329 "RTN","C0CCCR0",201,0) 94330 ;;<ActorID>@@SOCIALHISTORYSOURCACTORID@@</ActorID> 94331 "RTN","C0CCCR0",202,0) 94332 ;;</Actor> 94333 "RTN","C0CCCR0",203,0) 94334 ;;</Source> 94335 "RTN","C0CCCR0",204,0) 94336 ;;</SocialHistoryElement> 94337 "RTN","C0CCCR0",205,0) 94338 ;;<SocialHistoryElement> 94339 "RTN","C0CCCR0",206,0) 94340 ;;<CCRDataObjectID>BB0005</CCRDataObjectID> 94341 "RTN","C0CCCR0",207,0) 94342 ;;<Type> 94343 "RTN","C0CCCR0",208,0) 94344 ;;<Text>Ethnic Origin</Text> 94345 "RTN","C0CCCR0",209,0) 94346 ;;</Type> 94347 "RTN","C0CCCR0",210,0) 94348 ;;<Description> 94349 "RTN","C0CCCR0",211,0) 94350 ;;<Text>Not Hispanic or Latino</Text> 94351 "RTN","C0CCCR0",212,0) 94352 ;;</Description> 94353 "RTN","C0CCCR0",213,0) 94354 ;;<Source> 94355 "RTN","C0CCCR0",214,0) 94356 ;;<Actor> 94357 "RTN","C0CCCR0",215,0) 94358 ;;<ActorID>AA0001</ActorID> 94359 "RTN","C0CCCR0",216,0) 94360 ;;</Actor> 94361 "RTN","C0CCCR0",217,0) 94362 ;;</Source> 94363 "RTN","C0CCCR0",218,0) 94364 ;;</SocialHistoryElement> 94365 "RTN","C0CCCR0",219,0) 94366 ;;<SocialHistoryElement> 94367 "RTN","C0CCCR0",220,0) 94368 ;;<CCRDataObjectID>BB0006</CCRDataObjectID> 94369 "RTN","C0CCCR0",221,0) 94370 ;;<Type> 94371 "RTN","C0CCCR0",222,0) 94372 ;;<Text>Race</Text> 94373 "RTN","C0CCCR0",223,0) 94374 ;;</Type> 94375 "RTN","C0CCCR0",224,0) 94376 ;;<Description> 94377 "RTN","C0CCCR0",225,0) 94378 ;;<Text>White</Text> 94379 "RTN","C0CCCR0",226,0) 94380 ;;</Description> 94381 "RTN","C0CCCR0",227,0) 94382 ;;<Source> 94383 "RTN","C0CCCR0",228,0) 94384 ;;<Actor> 94385 "RTN","C0CCCR0",229,0) 94386 ;;<ActorID>AA0001</ActorID> 94387 "RTN","C0CCCR0",230,0) 94388 ;;</Actor> 94389 "RTN","C0CCCR0",231,0) 94390 ;;</Source> 94391 "RTN","C0CCCR0",232,0) 94392 ;;</SocialHistoryElement> 94393 "RTN","C0CCCR0",233,0) 94394 ;;<SocialHistoryElement> 94395 "RTN","C0CCCR0",234,0) 94396 ;;<CCRDataObjectID>BB0007</CCRDataObjectID> 94397 "RTN","C0CCCR0",235,0) 94398 ;;<Type> 94399 "RTN","C0CCCR0",236,0) 94400 ;;<Text>Occupation</Text> 94401 "RTN","C0CCCR0",237,0) 94402 ;;</Type> 94403 "RTN","C0CCCR0",238,0) 94404 ;;<Description> 94405 "RTN","C0CCCR0",239,0) 94406 ;;<Text>Physician</Text> 94407 "RTN","C0CCCR0",240,0) 94408 ;;</Description> 94409 "RTN","C0CCCR0",241,0) 94410 ;;<Source> 94411 "RTN","C0CCCR0",242,0) 94412 ;;<Actor> 94413 "RTN","C0CCCR0",243,0) 94414 ;;<ActorID>AA0001</ActorID> 94415 "RTN","C0CCCR0",244,0) 94416 ;;</Actor> 94417 "RTN","C0CCCR0",245,0) 94418 ;;</Source> 94419 "RTN","C0CCCR0",246,0) 94420 ;;</SocialHistoryElement> 94421 "RTN","C0CCCR0",247,0) 94422 ;;</SocialHistory> 94423 "RTN","C0CCCR0",248,0) 94424 ;;<Alerts> 94425 "RTN","C0CCCR0",249,0) 94426 ;;<Alert> 94427 "RTN","C0CCCR0",250,0) 94428 ;;<CCRDataObjectID>@@ALERTOBJECTID@@</CCRDataObjectID> 94429 "RTN","C0CCCR0",251,0) 94430 ;;<DateTime> 94431 "RTN","C0CCCR0",252,0) 94432 ;;<ExactDateTime>@@ALERTDATETIME@@</ExactDateTime> 94433 "RTN","C0CCCR0",253,0) 94434 ;;</DateTime> 94435 "RTN","C0CCCR0",254,0) 94436 ;;<Type> 94437 "RTN","C0CCCR0",255,0) 94438 ;;<Text>@@ALERTTYPE@@</Text> 94439 "RTN","C0CCCR0",256,0) 94440 ;;</Type> 94441 "RTN","C0CCCR0",257,0) 94442 ;;<Status> 94443 "RTN","C0CCCR0",258,0) 94444 ;;<Text>@@ALERTSTATUSTEXT@@</Text> 94445 "RTN","C0CCCR0",259,0) 94446 ;;</Status> 94447 "RTN","C0CCCR0",260,0) 94448 ;;<Description> 94449 "RTN","C0CCCR0",261,0) 94450 ;;<Text>@@ALERTDESCRIPTIONTEXT@@</Text> 94451 "RTN","C0CCCR0",262,0) 94452 ;;<Code> 94453 "RTN","C0CCCR0",263,0) 94454 ;;<Value>@@ALERTCODEVALUE@@</Value> 94455 "RTN","C0CCCR0",264,0) 94456 ;;<CodingSystem>@@ALERTCODESYSTEM@@</CodingSystem> 94457 "RTN","C0CCCR0",265,0) 94458 ;;</Code> 94459 "RTN","C0CCCR0",266,0) 94460 ;;</Description> 94461 "RTN","C0CCCR0",267,0) 94462 ;;<Source> 94463 "RTN","C0CCCR0",268,0) 94464 ;;<Actor> 94465 "RTN","C0CCCR0",269,0) 94466 ;;<ActorID>@@ALERTSOURCEID@@</ActorID> 94467 "RTN","C0CCCR0",270,0) 94468 ;;</Actor> 94469 "RTN","C0CCCR0",271,0) 94470 ;;</Source> 94471 "RTN","C0CCCR0",272,0) 94472 ;;<Agent> 94473 "RTN","C0CCCR0",273,0) 94474 ;;<Products> 94475 "RTN","C0CCCR0",274,0) 94476 ;;<Product> 94477 "RTN","C0CCCR0",275,0) 94478 ;;<CCRDataObjectID>@@ALERTAGENTPRODUCTOBJECTID@@</CCRDataObjectID> 94479 "RTN","C0CCCR0",276,0) 94480 ;;<Source> 94481 "RTN","C0CCCR0",277,0) 94482 ;;<Actor> 94483 "RTN","C0CCCR0",278,0) 94484 ;;<ActorID>@@ALERTSOURCEID@@</ActorID> 94485 "RTN","C0CCCR0",279,0) 94486 ;;</Actor> 94487 "RTN","C0CCCR0",280,0) 94488 ;;</Source> 94489 "RTN","C0CCCR0",281,0) 94490 ;;<Product> 94491 "RTN","C0CCCR0",282,0) 94492 ;;<ProductName> 94493 "RTN","C0CCCR0",283,0) 94494 ;;<Text>@@ALERTAGENTPRODUCTNAMETEXT@@</Text> 94495 "RTN","C0CCCR0",284,0) 94496 ;;<Code> 94497 "RTN","C0CCCR0",285,0) 94498 ;;<Value>@@ALERTAGENTPRODUCTCODEVALUE@@</Value> 94499 "RTN","C0CCCR0",286,0) 94500 ;;<CodingSystem>@@ALERTAGENTPRODUCTCODESYSTEM@@</CodingSystem> 94501 "RTN","C0CCCR0",287,0) 94502 ;;</Code> 94503 "RTN","C0CCCR0",288,0) 94504 ;;</ProductName> 94505 "RTN","C0CCCR0",289,0) 94506 ;;</Product> 94507 "RTN","C0CCCR0",290,0) 94508 ;;</Product> 94509 "RTN","C0CCCR0",291,0) 94510 ;;</Products> 94511 "RTN","C0CCCR0",292,0) 94512 ;;</Agent> 94513 "RTN","C0CCCR0",293,0) 94514 ;;<Reaction> 94515 "RTN","C0CCCR0",294,0) 94516 ;;<Description> 94517 "RTN","C0CCCR0",295,0) 94518 ;;<Text>@@ALERTREACTIOINDESCRIPTIONTEXT@@</Text> 94519 "RTN","C0CCCR0",296,0) 94520 ;;<Code> 94521 "RTN","C0CCCR0",297,0) 94522 ;;<Value>@@ALERTREACTIONCODEVALUE@@</Value> 94523 "RTN","C0CCCR0",298,0) 94524 ;;<CodingSystem>@@ALERTREACTIONCODESYSTEM@@</CodingSystem> 94525 "RTN","C0CCCR0",299,0) 94526 ;;</Code> 94527 "RTN","C0CCCR0",300,0) 94528 ;;</Description> 94529 "RTN","C0CCCR0",301,0) 94530 ;;</Reaction> 94531 "RTN","C0CCCR0",302,0) 94532 ;;</Alert> 94533 "RTN","C0CCCR0",303,0) 94534 ;;</Alerts> 94535 "RTN","C0CCCR0",304,0) 94536 ;;<Medications> 94537 "RTN","C0CCCR0",305,0) 94538 ;;<Medication> 94539 "RTN","C0CCCR0",306,0) 94540 ;;<CCRDataObjectID>@@MEDOBJECTID@@</CCRDataObjectID> 94541 "RTN","C0CCCR0",307,0) 94542 ;;<DateTime> 94543 "RTN","C0CCCR0",308,0) 94544 ;;<Type> 94545 "RTN","C0CCCR0",309,0) 94546 ;;<Text>@@MEDISSUEDATETXT@@</Text> 94547 "RTN","C0CCCR0",310,0) 94548 ;;</Type> 94549 "RTN","C0CCCR0",311,0) 94550 ;;<ExactDateTime>@@MEDISSUEDATE@@</ExactDateTime> 94551 "RTN","C0CCCR0",312,0) 94552 ;;</DateTime> 94553 "RTN","C0CCCR0",313,0) 94554 ;;<DateTime> 94555 "RTN","C0CCCR0",314,0) 94556 ;;<Type> 94557 "RTN","C0CCCR0",315,0) 94558 ;;<Text>@@MEDLASTFILLDATETXT@@</Text> 94559 "RTN","C0CCCR0",316,0) 94560 ;;</Type> 94561 "RTN","C0CCCR0",317,0) 94562 ;;<ExactDateTime>@@MEDLASTFILLDATE@@</ExactDateTime> 94563 "RTN","C0CCCR0",318,0) 94564 ;;</DateTime> 94565 "RTN","C0CCCR0",319,0) 94566 ;;<IDs> 94567 "RTN","C0CCCR0",320,0) 94568 ;;<Type> 94569 "RTN","C0CCCR0",321,0) 94570 ;;<Text>@@MEDRXNOTXT@@</Text> 94571 "RTN","C0CCCR0",322,0) 94572 ;;</Type> 94573 "RTN","C0CCCR0",323,0) 94574 ;;<ID>@@MEDRXNO@@</ID> 94575 "RTN","C0CCCR0",324,0) 94576 ;;</IDs> 94577 "RTN","C0CCCR0",325,0) 94578 ;;<Type> 94579 "RTN","C0CCCR0",326,0) 94580 ;;<Text>@@MEDTYPETEXT@@</Text> 94581 "RTN","C0CCCR0",327,0) 94582 ;;</Type> 94583 "RTN","C0CCCR0",328,0) 94584 ;;<Description> 94585 "RTN","C0CCCR0",329,0) 94586 ;;<Text>@@MEDDETAILUNADORNED@@</Text> 94587 "RTN","C0CCCR0",330,0) 94588 ;;</Description> 94589 "RTN","C0CCCR0",331,0) 94590 ;;<Status> 94591 "RTN","C0CCCR0",332,0) 94592 ;;<Text>@@MEDSTATUSTEXT@@</Text> 94593 "RTN","C0CCCR0",333,0) 94594 ;;</Status> 94595 "RTN","C0CCCR0",334,0) 94596 ;;<Source> 94597 "RTN","C0CCCR0",335,0) 94598 ;;<Actor> 94599 "RTN","C0CCCR0",336,0) 94600 ;;<ActorID>@@MEDSOURCEACTORID@@</ActorID> 94601 "RTN","C0CCCR0",337,0) 94602 ;;</Actor> 94603 "RTN","C0CCCR0",338,0) 94604 ;;</Source> 94605 "RTN","C0CCCR0",339,0) 94606 ;;<Product> 94607 "RTN","C0CCCR0",340,0) 94608 ;;<ProductName> 94609 "RTN","C0CCCR0",341,0) 94610 ;;<Text>@@MEDPRODUCTNAMETEXT@@</Text> 94611 "RTN","C0CCCR0",342,0) 94612 ;;<Code> 94613 "RTN","C0CCCR0",343,0) 94614 ;;<Value>@@MEDPRODUCTNAMECODEVALUE@@</Value> 94615 "RTN","C0CCCR0",344,0) 94616 ;;<CodingSystem>@@MEDPRODUCTNAMECODINGINGSYSTEM@@</CodingSystem> 94617 "RTN","C0CCCR0",345,0) 94618 ;;<Version>@@MEDPRODUCTNAMECODEVERSION@@</Version> 94619 "RTN","C0CCCR0",346,0) 94620 ;;</Code> 94621 "RTN","C0CCCR0",347,0) 94622 ;;</ProductName> 94623 "RTN","C0CCCR0",348,0) 94624 ;;<BrandName> 94625 "RTN","C0CCCR0",349,0) 94626 ;;<Text>@@MEDBRANDNAMETEXT@@</Text> 94627 "RTN","C0CCCR0",350,0) 94628 ;;</BrandName> 94629 "RTN","C0CCCR0",351,0) 94630 ;;<Strength> 94631 "RTN","C0CCCR0",352,0) 94632 ;;<Value>@@MEDSTRENGTHVALUE@@</Value> 94633 "RTN","C0CCCR0",353,0) 94634 ;;<Units> 94635 "RTN","C0CCCR0",354,0) 94636 ;;<Unit>@@MEDSTRENGTHUNIT@@</Unit> 94637 "RTN","C0CCCR0",355,0) 94638 ;;</Units> 94639 "RTN","C0CCCR0",356,0) 94640 ;;</Strength> 94641 "RTN","C0CCCR0",357,0) 94642 ;;<Form> 94643 "RTN","C0CCCR0",358,0) 94644 ;;<Text>@@MEDFORMTEXT@@</Text> 94645 "RTN","C0CCCR0",359,0) 94646 ;;</Form> 94647 "RTN","C0CCCR0",360,0) 94648 ;;<Concentration> 94649 "RTN","C0CCCR0",361,0) 94650 ;;<Value>@@MEDCONCVALUE@@</Value> 94651 "RTN","C0CCCR0",362,0) 94652 ;;<Units> 94653 "RTN","C0CCCR0",363,0) 94654 ;;<Unit>@@MEDCONCUNIT@@</Unit> 94655 "RTN","C0CCCR0",364,0) 94656 ;;</Units> 94657 "RTN","C0CCCR0",365,0) 94658 ;;</Concentration> 94659 "RTN","C0CCCR0",366,0) 94660 ;;</Product> 94661 "RTN","C0CCCR0",367,0) 94662 ;;<Quantity> 94663 "RTN","C0CCCR0",368,0) 94664 ;;<Value>@@MEDQUANTITYVALUE@@</Value> 94665 "RTN","C0CCCR0",369,0) 94666 ;;<Units> 94667 "RTN","C0CCCR0",370,0) 94668 ;;<Unit>@@MEDQUANTITYUNIT@@</Unit> 94669 "RTN","C0CCCR0",371,0) 94670 ;;</Units> 94671 "RTN","C0CCCR0",372,0) 94672 ;;</Quantity> 94673 "RTN","C0CCCR0",373,0) 94674 ;;<Directions> 94675 "RTN","C0CCCR0",374,0) 94676 ;;<Direction> 94677 "RTN","C0CCCR0",375,0) 94678 ;;<Description> 94679 "RTN","C0CCCR0",376,0) 94680 ;;<Text>@@MEDDIRECTIONDESCRIPTIONTEXT@@</Text> 94681 "RTN","C0CCCR0",377,0) 94682 ;;</Description> 94683 "RTN","C0CCCR0",378,0) 94684 ;;<DoseIndicator> 94685 "RTN","C0CCCR0",379,0) 94686 ;;<Text>@@MEDDOSEINDICATOR@@</Text> 94687 "RTN","C0CCCR0",380,0) 94688 ;;</DoseIndicator> 94689 "RTN","C0CCCR0",381,0) 94690 ;;<DeliveryMethod> 94691 "RTN","C0CCCR0",382,0) 94692 ;;<Text>@@MEDDELIVERYMETHOD@@</Text> 94693 "RTN","C0CCCR0",383,0) 94694 ;;</DeliveryMethod> 94695 "RTN","C0CCCR0",384,0) 94696 ;;<Dose> 94697 "RTN","C0CCCR0",385,0) 94698 ;;<Value>@@MEDDOSEVALUE@@</Value> 94699 "RTN","C0CCCR0",386,0) 94700 ;;<Units> 94701 "RTN","C0CCCR0",387,0) 94702 ;;<Unit>@@MEDDOSEUNIT@@</Unit> 94703 "RTN","C0CCCR0",388,0) 94704 ;;</Units> 94705 "RTN","C0CCCR0",389,0) 94706 ;;<Rate> 94707 "RTN","C0CCCR0",390,0) 94708 ;;<Value>@@MEDRATEVALUE@@</Value> 94709 "RTN","C0CCCR0",391,0) 94710 ;;<Units> 94711 "RTN","C0CCCR0",392,0) 94712 ;;<Unit>@@MEDRATEUNIT@@</Unit> 94713 "RTN","C0CCCR0",393,0) 94714 ;;</Units> 94715 "RTN","C0CCCR0",394,0) 94716 ;;</Rate> 94717 "RTN","C0CCCR0",395,0) 94718 ;;</Dose> 94719 "RTN","C0CCCR0",396,0) 94720 ;;<Vehicle> 94721 "RTN","C0CCCR0",397,0) 94722 ;;<Text>@@MEDVEHICLETEXT@@</Text> 94723 "RTN","C0CCCR0",398,0) 94724 ;;</Vehicle> 94725 "RTN","C0CCCR0",399,0) 94726 ;;<Route> 94727 "RTN","C0CCCR0",400,0) 94728 ;;<Text>@@MEDDIRECTIONROUTETEXT@@</Text> 94729 "RTN","C0CCCR0",401,0) 94730 ;;</Route> 94731 "RTN","C0CCCR0",402,0) 94732 ;;<Frequency> 94733 "RTN","C0CCCR0",403,0) 94734 ;;<Value>@@MEDFREQUENCYVALUE@@</Value> 94735 "RTN","C0CCCR0",404,0) 94736 ;;</Frequency> 94737 "RTN","C0CCCR0",405,0) 94738 ;;<Interval> 94739 "RTN","C0CCCR0",406,0) 94740 ;;<Value>@@MEDINTERVALVALUE@@</Value> 94741 "RTN","C0CCCR0",407,0) 94742 ;;<Units> 94743 "RTN","C0CCCR0",408,0) 94744 ;;<Unit>@@MEDINTERVALUNIT@@</Unit> 94745 "RTN","C0CCCR0",409,0) 94746 ;;</Units> 94747 "RTN","C0CCCR0",410,0) 94748 ;;</Interval> 94749 "RTN","C0CCCR0",411,0) 94750 ;;<Duration> 94751 "RTN","C0CCCR0",412,0) 94752 ;;<Value>@@MEDDURATIONVALUE@@</Value> 94753 "RTN","C0CCCR0",413,0) 94754 ;;<Units> 94755 "RTN","C0CCCR0",414,0) 94756 ;;<Unit>@@MEDDURATIONUNIT@@</Unit> 94757 "RTN","C0CCCR0",415,0) 94758 ;;</Units> 94759 "RTN","C0CCCR0",416,0) 94760 ;;</Duration> 94761 "RTN","C0CCCR0",417,0) 94762 ;;<Indication> 94763 "RTN","C0CCCR0",418,0) 94764 ;;<PRNFlag> 94765 "RTN","C0CCCR0",419,0) 94766 ;;<Text>@@MEDPRNFLAG@@</Text> 94767 "RTN","C0CCCR0",420,0) 94768 ;;</PRNFlag> 94769 "RTN","C0CCCR0",421,0) 94160 94770 ;;<Problem> 94161 "RTN","C0CCCR0",104,0) 94162 ;;<CCRDataObjectID>@@PROBLEMOBJECTID@@</CCRDataObjectID> 94163 "RTN","C0CCCR0",105,0) 94771 "RTN","C0CCCR0",422,0) 94772 ;;<CCRDataObjectID>@@MEDPROBLEMOBJECTID@@</CCRDataObjectID> 94773 "RTN","C0CCCR0",423,0) 94774 ;;<Type> 94775 "RTN","C0CCCR0",424,0) 94776 ;;<Text>@@MEDPROBLEMTYPETXT@@</Text> 94777 "RTN","C0CCCR0",425,0) 94778 ;;</Type> 94779 "RTN","C0CCCR0",426,0) 94780 ;;<Description> 94781 "RTN","C0CCCR0",427,0) 94782 ;;<Text>@@MEDPROBLEMDESCRIPTION@@</Text> 94783 "RTN","C0CCCR0",428,0) 94784 ;;<Code> 94785 "RTN","C0CCCR0",429,0) 94786 ;;<Value>@@MEDPROBLEMCODEVALUE@@</Value> 94787 "RTN","C0CCCR0",430,0) 94788 ;;<CodingSystem>@@MEDPROBLEMCODINGSYSTEM@@</CodingSystem> 94789 "RTN","C0CCCR0",431,0) 94790 ;;<Version>@@MEDPROBLEMCODINGVERSION@@</Version> 94791 "RTN","C0CCCR0",432,0) 94792 ;;</Code> 94793 "RTN","C0CCCR0",433,0) 94794 ;;</Description> 94795 "RTN","C0CCCR0",434,0) 94796 ;;<Source> 94797 "RTN","C0CCCR0",435,0) 94798 ;;<Actor> 94799 "RTN","C0CCCR0",436,0) 94800 ;;<ActorID>@@MEDPROBLEMSOURCEACTORID@@</ActorID> 94801 "RTN","C0CCCR0",437,0) 94802 ;;</Actor> 94803 "RTN","C0CCCR0",438,0) 94804 ;;</Source> 94805 "RTN","C0CCCR0",439,0) 94806 ;;</Problem> 94807 "RTN","C0CCCR0",440,0) 94808 ;;</Indication> 94809 "RTN","C0CCCR0",441,0) 94810 ;;<StopIndicator> 94811 "RTN","C0CCCR0",442,0) 94812 ;;<Text>@@MEDSTOPINDICATOR@@</Text> 94813 "RTN","C0CCCR0",443,0) 94814 ;;</StopIndicator> 94815 "RTN","C0CCCR0",444,0) 94816 ;;<DirectionSequenceModifier>@@MEDDIRSEQ@@</DirectionSequenceModifier> 94817 "RTN","C0CCCR0",445,0) 94818 ;;<MultipleDirectionModifier> 94819 "RTN","C0CCCR0",446,0) 94820 ;;<Text>@@MEDMULDIRMOD@@</Text> 94821 "RTN","C0CCCR0",447,0) 94822 ;;</MultipleDirectionModifier> 94823 "RTN","C0CCCR0",448,0) 94824 ;;</Direction> 94825 "RTN","C0CCCR0",449,0) 94826 ;;</Directions> 94827 "RTN","C0CCCR0",450,0) 94828 ;;<PatientInstructions> 94829 "RTN","C0CCCR0",451,0) 94830 ;;<Instruction> 94831 "RTN","C0CCCR0",452,0) 94832 ;;<Text>@@MEDPTINSTRUCTIONS@@</Text> 94833 "RTN","C0CCCR0",453,0) 94834 ;;</Instruction> 94835 "RTN","C0CCCR0",454,0) 94836 ;;</PatientInstructions> 94837 "RTN","C0CCCR0",455,0) 94838 ;;<FullfillmentInstructions> 94839 "RTN","C0CCCR0",456,0) 94840 ;;<Text>@@MEDFULLFILLMENTINSTRUCTIONS@@</Text> 94841 "RTN","C0CCCR0",457,0) 94842 ;;</FullfillmentInstructions> 94843 "RTN","C0CCCR0",458,0) 94844 ;;<Refills> 94845 "RTN","C0CCCR0",459,0) 94846 ;;<Refill> 94847 "RTN","C0CCCR0",460,0) 94848 ;;<Number>@@MEDRFNO@@</Number> 94849 "RTN","C0CCCR0",461,0) 94850 ;;</Refill> 94851 "RTN","C0CCCR0",462,0) 94852 ;;</Refills> 94853 "RTN","C0CCCR0",463,0) 94854 ;;</Medication> 94855 "RTN","C0CCCR0",464,0) 94856 ;;</Medications> 94857 "RTN","C0CCCR0",465,0) 94858 ;;<VitalSigns> 94859 "RTN","C0CCCR0",466,0) 94860 ;;<Result> 94861 "RTN","C0CCCR0",467,0) 94862 ;;<CCRDataObjectID>@@VITALSIGNSDATAOBJECTID@@</CCRDataObjectID> 94863 "RTN","C0CCCR0",468,0) 94164 94864 ;;<DateTime> 94165 "RTN","C0CCCR0",106,0) 94166 ;;<ExactDateTime>@@PROBLEMDATEMOD@@</ExactDateTime> 94167 "RTN","C0CCCR0",107,0) 94865 "RTN","C0CCCR0",469,0) 94866 ;;<Type> 94867 "RTN","C0CCCR0",470,0) 94868 ;;<Text>@@VITALSIGNSDATETIMETYPETEXT@@</Text> 94869 "RTN","C0CCCR0",471,0) 94870 ;;</Type> 94871 "RTN","C0CCCR0",472,0) 94872 ;;<ExactDateTime>@@VITALSIGNSEXACTDATETIME@@</ExactDateTime> 94873 "RTN","C0CCCR0",473,0) 94168 94874 ;;</DateTime> 94169 "RTN","C0CCCR0",108,0) 94875 "RTN","C0CCCR0",474,0) 94876 ;;<Description> 94877 "RTN","C0CCCR0",475,0) 94878 ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text> 94879 "RTN","C0CCCR0",476,0) 94880 ;;</Description> 94881 "RTN","C0CCCR0",477,0) 94882 ;;<Source> 94883 "RTN","C0CCCR0",478,0) 94884 ;;<Actor> 94885 "RTN","C0CCCR0",479,0) 94886 ;;<ActorID>@@VITALSIGNSSOURCEACTORID@@</ActorID> 94887 "RTN","C0CCCR0",480,0) 94888 ;;</Actor> 94889 "RTN","C0CCCR0",481,0) 94890 ;;</Source> 94891 "RTN","C0CCCR0",482,0) 94892 ;;<Test> 94893 "RTN","C0CCCR0",483,0) 94894 ;;<CCRDataObjectID>@@VITALSIGNSTESTOBJECTID@@</CCRDataObjectID> 94895 "RTN","C0CCCR0",484,0) 94170 94896 ;;<Type> 94171 "RTN","C0CCCR0", 109,0)94172 ;;<Text> Problem</Text>94173 "RTN","C0CCCR0", 110,0)94897 "RTN","C0CCCR0",485,0) 94898 ;;<Text>@@VITALSIGNSTESTTYPETEXT@@</Text> 94899 "RTN","C0CCCR0",486,0) 94174 94900 ;;</Type> 94175 "RTN","C0CCCR0", 111,0)94901 "RTN","C0CCCR0",487,0) 94176 94902 ;;<Description> 94177 "RTN","C0CCCR0", 112,0)94178 ;;<Text>@@ PROBLEMDESCRIPTION@@</Text>94179 "RTN","C0CCCR0", 113,0)94903 "RTN","C0CCCR0",488,0) 94904 ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text> 94905 "RTN","C0CCCR0",489,0) 94180 94906 ;;<Code> 94181 "RTN","C0CCCR0", 114,0)94182 ;;<Value>@@ PROBLEMCODEVALUE@@</Value>94183 "RTN","C0CCCR0", 115,0)94184 ;;<CodingSystem> ICD9CM</CodingSystem>94185 "RTN","C0CCCR0", 116,0)94186 ;;<Version>@@ PROBLEMCODINGVERSION@@</Version>94187 "RTN","C0CCCR0", 117,0)94907 "RTN","C0CCCR0",490,0) 94908 ;;<Value>@@VITALSIGNSDESCCODEVALUE@@</Value> 94909 "RTN","C0CCCR0",491,0) 94910 ;;<CodingSystem>@@VITALSIGNSDESCCODINGSYSTEM@@</CodingSystem> 94911 "RTN","C0CCCR0",492,0) 94912 ;;<Version>@@VITALSIGNSCODEVERSION@@</Version> 94913 "RTN","C0CCCR0",493,0) 94188 94914 ;;</Code> 94189 "RTN","C0CCCR0", 118,0)94915 "RTN","C0CCCR0",494,0) 94190 94916 ;;</Description> 94191 "RTN","C0CCCR0",119,0) 94917 "RTN","C0CCCR0",495,0) 94918 ;;<Source> 94919 "RTN","C0CCCR0",496,0) 94920 ;;<Actor> 94921 "RTN","C0CCCR0",497,0) 94922 ;;<ActorID>@@VITALSIGNSTESTSOURCEACTORID@@</ActorID> 94923 "RTN","C0CCCR0",498,0) 94924 ;;</Actor> 94925 "RTN","C0CCCR0",499,0) 94926 ;;</Source> 94927 "RTN","C0CCCR0",500,0) 94928 ;;<TestResult> 94929 "RTN","C0CCCR0",501,0) 94930 ;;<Value>@@VITALSIGNSTESTRESULTVALUE@@</Value> 94931 "RTN","C0CCCR0",502,0) 94932 ;;<Units> 94933 "RTN","C0CCCR0",503,0) 94934 ;;<Unit>@@VITALSIGNSTESTRESULTUNIT@@</Unit> 94935 "RTN","C0CCCR0",504,0) 94936 ;;</Units> 94937 "RTN","C0CCCR0",505,0) 94938 ;;</TestResult> 94939 "RTN","C0CCCR0",506,0) 94940 ;;</Test> 94941 "RTN","C0CCCR0",507,0) 94942 ;;</Result> 94943 "RTN","C0CCCR0",508,0) 94944 ;;</VitalSigns> 94945 "RTN","C0CCCR0",509,0) 94946 ;;<Results> 94947 "RTN","C0CCCR0",510,0) 94948 ;;<Result> 94949 "RTN","C0CCCR0",511,0) 94950 ;;<CCRDataObjectID>@@RESULTOBJECTID@@</CCRDataObjectID> 94951 "RTN","C0CCCR0",512,0) 94952 ;;<DateTime> 94953 "RTN","C0CCCR0",513,0) 94954 ;;<Type> 94955 "RTN","C0CCCR0",514,0) 94956 ;;<Text>Assessment Time</Text> 94957 "RTN","C0CCCR0",515,0) 94958 ;;</Type> 94959 "RTN","C0CCCR0",516,0) 94960 ;;<ExactDateTime>@@RESULTASSESSMENTDATETIME@@</ExactDateTime> 94961 "RTN","C0CCCR0",517,0) 94962 ;;</DateTime> 94963 "RTN","C0CCCR0",518,0) 94964 ;;<Description> 94965 "RTN","C0CCCR0",519,0) 94966 ;;<Text>@@RESULTDESCRIPTIONTEXT@@</Text> 94967 "RTN","C0CCCR0",520,0) 94968 ;;<Code> 94969 "RTN","C0CCCR0",521,0) 94970 ;;<Value>@@RESULTCODE@@</Value> 94971 "RTN","C0CCCR0",522,0) 94972 ;;<CodingSystem>@@RESULTCODINGSYSTEM@@</CodingSystem> 94973 "RTN","C0CCCR0",523,0) 94974 ;;</Code> 94975 "RTN","C0CCCR0",524,0) 94976 ;;</Description> 94977 "RTN","C0CCCR0",525,0) 94192 94978 ;;<Status> 94193 "RTN","C0CCCR0", 120,0)94194 ;;<Text>@@ PROBLEMSTATUS@@</Text>94195 "RTN","C0CCCR0", 121,0)94979 "RTN","C0CCCR0",526,0) 94980 ;;<Text>@@RESULTSTATUS@@</Text> 94981 "RTN","C0CCCR0",527,0) 94196 94982 ;;</Status> 94197 "RTN","C0CCCR0", 122,0)94983 "RTN","C0CCCR0",528,0) 94198 94984 ;;<Source> 94199 "RTN","C0CCCR0", 123,0)94985 "RTN","C0CCCR0",529,0) 94200 94986 ;;<Actor> 94201 "RTN","C0CCCR0", 124,0)94202 ;;<ActorID>@@ PROBLEMSOURCEACTORID@@</ActorID>94203 "RTN","C0CCCR0", 125,0)94987 "RTN","C0CCCR0",530,0) 94988 ;;<ActorID>@@RESULTSOURCEACTORID@@</ActorID> 94989 "RTN","C0CCCR0",531,0) 94204 94990 ;;</Actor> 94205 "RTN","C0CCCR0", 126,0)94991 "RTN","C0CCCR0",532,0) 94206 94992 ;;</Source> 94207 "RTN","C0CCCR0",127,0) 94208 ;;</Problem> 94209 "RTN","C0CCCR0",128,0) 94210 ;;</Problems> 94211 "RTN","C0CCCR0",129,0) 94212 ;;<Immunizations> 94213 "RTN","C0CCCR0",130,0) 94214 ;;<Immunization> 94215 "RTN","C0CCCR0",131,0) 94216 ;;<CCRDataObjectID>@@IMMUNEOBJECTID@@</CCRDataObjectID> 94217 "RTN","C0CCCR0",132,0) 94993 "RTN","C0CCCR0",533,0) 94994 ;;<Test> 94995 "RTN","C0CCCR0",534,0) 94996 ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID> 94997 "RTN","C0CCCR0",535,0) 94218 94998 ;;<DateTime> 94219 "RTN","C0CCCR0", 133,0)94999 "RTN","C0CCCR0",536,0) 94220 95000 ;;<Type> 94221 "RTN","C0CCCR0", 134,0)94222 ;;<Text> @@IMMUNEDATETIMETYPETEXT@@</Text>94223 "RTN","C0CCCR0", 135,0)95001 "RTN","C0CCCR0",537,0) 95002 ;;<Text>Assessment Time</Text> 95003 "RTN","C0CCCR0",538,0) 94224 95004 ;;</Type> 94225 "RTN","C0CCCR0", 136,0)94226 ;;<ExactDateTime>@@ IMMUNEDATETIME@@</ExactDateTime>94227 "RTN","C0CCCR0", 137,0)95005 "RTN","C0CCCR0",539,0) 95006 ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime> 95007 "RTN","C0CCCR0",540,0) 94228 95008 ;;</DateTime> 94229 "RTN","C0CCCR0",138,0) 95009 "RTN","C0CCCR0",541,0) 95010 ;;<Description> 95011 "RTN","C0CCCR0",542,0) 95012 ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text> 95013 "RTN","C0CCCR0",543,0) 95014 ;;<Code> 95015 "RTN","C0CCCR0",544,0) 95016 ;;<Value>@@RESULTTESTCODEVALUE@@</Value> 95017 "RTN","C0CCCR0",545,0) 95018 ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem> 95019 "RTN","C0CCCR0",546,0) 95020 ;;</Code> 95021 "RTN","C0CCCR0",547,0) 95022 ;;</Description> 95023 "RTN","C0CCCR0",548,0) 95024 ;;<Status> 95025 "RTN","C0CCCR0",549,0) 95026 ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text> 95027 "RTN","C0CCCR0",550,0) 95028 ;;</Status> 95029 "RTN","C0CCCR0",551,0) 94230 95030 ;;<Source> 94231 "RTN","C0CCCR0", 139,0)95031 "RTN","C0CCCR0",552,0) 94232 95032 ;;<Actor> 94233 "RTN","C0CCCR0", 140,0)94234 ;;<ActorID>@@ IMMUNESOURCEACTORID@@</ActorID>94235 "RTN","C0CCCR0", 141,0)95033 "RTN","C0CCCR0",553,0) 95034 ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID> 95035 "RTN","C0CCCR0",554,0) 94236 95036 ;;</Actor> 94237 "RTN","C0CCCR0", 142,0)95037 "RTN","C0CCCR0",555,0) 94238 95038 ;;</Source> 94239 "RTN","C0CCCR0",143,0) 94240 ;;<Product> 94241 "RTN","C0CCCR0",144,0) 94242 ;;<ProductName> 94243 "RTN","C0CCCR0",145,0) 94244 ;;<Text>@@IMMUNEPRODUCTNAMETEXT@@</Text> 94245 "RTN","C0CCCR0",146,0) 95039 "RTN","C0CCCR0",556,0) 95040 ;;<TestResult> 95041 "RTN","C0CCCR0",557,0) 95042 ;;<Value>@@RESULTTESTVALUE@@</Value> 95043 "RTN","C0CCCR0",558,0) 95044 ;;<Units> 95045 "RTN","C0CCCR0",559,0) 95046 ;;<Unit>@@RESULTTESTUNITS@@</Unit> 95047 "RTN","C0CCCR0",560,0) 95048 ;;</Units> 95049 "RTN","C0CCCR0",561,0) 95050 ;;</TestResult> 95051 "RTN","C0CCCR0",562,0) 95052 ;;<NormalResult> 95053 "RTN","C0CCCR0",563,0) 95054 ;;<Normal> 95055 "RTN","C0CCCR0",564,0) 95056 ;;<Description> 95057 "RTN","C0CCCR0",565,0) 95058 ;;<Text>@@RESULTTESTNORMALDESCTEXT@@</Text> 95059 "RTN","C0CCCR0",566,0) 95060 ;;</Description> 95061 "RTN","C0CCCR0",567,0) 95062 ;;<Source> 95063 "RTN","C0CCCR0",568,0) 95064 ;;<Actor> 95065 "RTN","C0CCCR0",569,0) 95066 ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID> 95067 "RTN","C0CCCR0",570,0) 95068 ;;</Actor> 95069 "RTN","C0CCCR0",571,0) 95070 ;;</Source> 95071 "RTN","C0CCCR0",572,0) 95072 ;;</Normal> 95073 "RTN","C0CCCR0",573,0) 95074 ;;</NormalResult> 95075 "RTN","C0CCCR0",574,0) 95076 ;;<Flag> 95077 "RTN","C0CCCR0",575,0) 95078 ;;<Text>@@RESULTTESTFLAG@@</Text> 95079 "RTN","C0CCCR0",576,0) 95080 ;;</Flag> 95081 "RTN","C0CCCR0",577,0) 95082 ;;</Test> 95083 "RTN","C0CCCR0",578,0) 95084 ;;</Result> 95085 "RTN","C0CCCR0",579,0) 95086 ;;</Results> 95087 "RTN","C0CCCR0",580,0) 95088 ;;<Procedures> 95089 "RTN","C0CCCR0",581,0) 95090 ;;<Procedure> 95091 "RTN","C0CCCR0",582,0) 95092 ;;<CCRDataObjectID>@@PROCOBJECTID@@</CCRDataObjectID> 95093 "RTN","C0CCCR0",583,0) 95094 ;;<DateTime> 95095 "RTN","C0CCCR0",584,0) 95096 ;;<Type> 95097 "RTN","C0CCCR0",585,0) 95098 ;;<Text>@@PROCDATETEXT@@</Text> 95099 "RTN","C0CCCR0",586,0) 95100 ;;</Type> 95101 "RTN","C0CCCR0",587,0) 95102 ;;<ExactDateTime>@@PROCDATETIME@@</ExactDateTime> 95103 "RTN","C0CCCR0",588,0) 95104 ;;</DateTime> 95105 "RTN","C0CCCR0",589,0) 95106 ;;<Description> 95107 "RTN","C0CCCR0",590,0) 95108 ;;<Text>@@PROCDESCTEXT@@</Text> 95109 "RTN","C0CCCR0",591,0) 95110 ;;<ObjectAttribute> 95111 "RTN","C0CCCR0",592,0) 95112 ;;<Attribute>@@PROCDESCOBJATTR@@</Attribute> 95113 "RTN","C0CCCR0",593,0) 95114 ;;<AttributeValue> 95115 "RTN","C0CCCR0",594,0) 95116 ;;<Value>@@PROCDESCOBJATTRVAL@@</Value> 95117 "RTN","C0CCCR0",595,0) 94246 95118 ;;<Code> 94247 "RTN","C0CCCR0", 147,0)94248 ;;<Value>@@ IMMUNEPRODUCTCODE@@</Value>94249 "RTN","C0CCCR0", 148,0)94250 ;;<CodingSystem>@@ IMMUNEPRODUCTCODESYSTEM@@</CodingSystem>94251 "RTN","C0CCCR0", 149,0)95119 "RTN","C0CCCR0",596,0) 95120 ;;<Value>@@PROCDESCOBJATTRCODE@@</Value> 95121 "RTN","C0CCCR0",597,0) 95122 ;;<CodingSystem>@@PROCDESCOBJATTRCODESYS@@</CodingSystem> 95123 "RTN","C0CCCR0",598,0) 94252 95124 ;;</Code> 94253 "RTN","C0CCCR0",150,0) 94254 ;;</ProductName> 94255 "RTN","C0CCCR0",151,0) 94256 ;;</Product> 94257 "RTN","C0CCCR0",152,0) 94258 ;;</Immunization> 94259 "RTN","C0CCCR0",153,0) 94260 ;;</Immunizations> 94261 "RTN","C0CCCR0",154,0) 94262 ;;<FamilyHistory> 94263 "RTN","C0CCCR0",155,0) 94264 ;;<FamilyProblemHistory> 94265 "RTN","C0CCCR0",156,0) 94266 ;;<CCRDataObjectID>@@FAMILYHISTORYOBJECTID@@</CCRDataObjectID> 94267 "RTN","C0CCCR0",157,0) 95125 "RTN","C0CCCR0",599,0) 95126 ;;</AttributeValue> 95127 "RTN","C0CCCR0",600,0) 95128 ;;</ObjectAttribute> 95129 "RTN","C0CCCR0",601,0) 95130 ;;<Code> 95131 "RTN","C0CCCR0",602,0) 95132 ;;<Value>@@PROCCODE@@</Value> 95133 "RTN","C0CCCR0",603,0) 95134 ;;<CodingSystem>@@PROCCODESYS@@</CodingSystem> 95135 "RTN","C0CCCR0",604,0) 95136 ;;</Code> 95137 "RTN","C0CCCR0",605,0) 95138 ;;</Description> 95139 "RTN","C0CCCR0",606,0) 95140 ;;<Status> 95141 "RTN","C0CCCR0",607,0) 95142 ;;<Text>@@PROCSTATUS@@</Text> 95143 "RTN","C0CCCR0",608,0) 95144 ;;</Status> 95145 "RTN","C0CCCR0",609,0) 94268 95146 ;;<Source> 94269 "RTN","C0CCCR0", 158,0)95147 "RTN","C0CCCR0",610,0) 94270 95148 ;;<Actor> 94271 "RTN","C0CCCR0", 159,0)94272 ;;<ActorID>@@ FAMILYHISTORYACTORID@@</ActorID>94273 "RTN","C0CCCR0", 160,0)95149 "RTN","C0CCCR0",611,0) 95150 ;;<ActorID>@@PROCACTOROBJID@@</ActorID> 95151 "RTN","C0CCCR0",612,0) 94274 95152 ;;</Actor> 94275 "RTN","C0CCCR0", 161,0)95153 "RTN","C0CCCR0",613,0) 94276 95154 ;;</Source> 94277 "RTN","C0CCCR0",162,0) 94278 ;;<FamilyMember> 94279 "RTN","C0CCCR0",163,0) 94280 ;;<ActorID>@@FAMILYMEMBERACTORID@@</ActorID> 94281 "RTN","C0CCCR0",164,0) 95155 "RTN","C0CCCR0",614,0) 95156 ;;<InternalCCRLink> 95157 "RTN","C0CCCR0",615,0) 95158 ;;<LinkID>@@PROCLINKID@@</LinkID> 95159 "RTN","C0CCCR0",616,0) 95160 ;;<LinkRelationship>@@PROCLINKREL@@</LinkRelationship> 95161 "RTN","C0CCCR0",617,0) 95162 ;;</InternalCCRLink> 95163 "RTN","C0CCCR0",618,0) 95164 ;;</Procedure> 95165 "RTN","C0CCCR0",619,0) 95166 ;;</Procedures> 95167 "RTN","C0CCCR0",620,0) 95168 ;;<Encounters> 95169 "RTN","C0CCCR0",621,0) 95170 ;;<Encounter> 95171 "RTN","C0CCCR0",622,0) 95172 ;;<CCRDataObjectID>@@ENCOBJECTID@@</CCRDataObjectID> 95173 "RTN","C0CCCR0",623,0) 95174 ;;<DateTime> 95175 "RTN","C0CCCR0",624,0) 95176 ;;<ExactDateTime>@@ENCDATETIME@@</ExactDateTime> 95177 "RTN","C0CCCR0",625,0) 95178 ;;</DateTime> 95179 "RTN","C0CCCR0",626,0) 95180 ;;<Type> 95181 "RTN","C0CCCR0",627,0) 95182 ;;<Text>@@ENCTYPETXT@@</Text> 95183 "RTN","C0CCCR0",628,0) 95184 ;;<Code> 95185 "RTN","C0CCCR0",629,0) 95186 ;;<Value>@@ENCTYPECODE@@</Value> 95187 "RTN","C0CCCR0",630,0) 95188 ;;<CodingSystem>@@ENCTYPECODESYS@@</CodingSystem> 95189 "RTN","C0CCCR0",631,0) 95190 ;;</Code> 95191 "RTN","C0CCCR0",632,0) 95192 ;;</Type> 95193 "RTN","C0CCCR0",633,0) 95194 ;;<Description> 95195 "RTN","C0CCCR0",634,0) 95196 ;;<Text>@@ENCDESCTXT@@</Text> 95197 "RTN","C0CCCR0",635,0) 95198 ;;<Code> 95199 "RTN","C0CCCR0",636,0) 95200 ;;<Value>@@ENCDESCCODE@@</Value> 95201 "RTN","C0CCCR0",637,0) 95202 ;;<CodingSystem>@@ENCDESCCODESYS@@</CodingSystem> 95203 "RTN","C0CCCR0",638,0) 95204 ;;</Code> 95205 "RTN","C0CCCR0",639,0) 95206 ;;</Description> 95207 "RTN","C0CCCR0",640,0) 95208 ;;<Location> 95209 "RTN","C0CCCR0",641,0) 95210 ;;<Actor> 95211 "RTN","C0CCCR0",642,0) 95212 ;;<ActorID>@@ENCLOCACTORID@@</ActorID> 95213 "RTN","C0CCCR0",643,0) 95214 ;;</Actor> 95215 "RTN","C0CCCR0",644,0) 95216 ;;</Location> 95217 "RTN","C0CCCR0",645,0) 95218 ;;<Practioner> 95219 "RTN","C0CCCR0",646,0) 95220 ;;<Actor> 95221 "RTN","C0CCCR0",647,0) 95222 ;;<ActorID>@@ENCPRVACTORID@@</ActorID> 95223 "RTN","C0CCCR0",648,0) 95224 ;;</Actor> 95225 "RTN","C0CCCR0",649,0) 95226 ;;</Practioner> 95227 "RTN","C0CCCR0",650,0) 95228 ;;<Indication> 95229 "RTN","C0CCCR0",651,0) 95230 ;;<Text>@@ENCINDTXT@@</Text> 95231 "RTN","C0CCCR0",652,0) 95232 ;;<Code> 95233 "RTN","C0CCCR0",653,0) 95234 ;;<Value>@@ENCINDCODE@@</Value> 95235 "RTN","C0CCCR0",654,0) 95236 ;;<CodingSystem>@@ENCINDCODESYS@@</CodingSystem> 95237 "RTN","C0CCCR0",655,0) 95238 ;;</Code> 95239 "RTN","C0CCCR0",656,0) 95240 ;;</Indication> 95241 "RTN","C0CCCR0",657,0) 95242 ;;<Source> 95243 "RTN","C0CCCR0",658,0) 95244 ;;<Actor> 95245 "RTN","C0CCCR0",659,0) 95246 ;;<ActorID>@@ENCACTORID@@</ActorID> 95247 "RTN","C0CCCR0",660,0) 95248 ;;</Actor> 95249 "RTN","C0CCCR0",661,0) 95250 ;;</Source> 95251 "RTN","C0CCCR0",662,0) 95252 ;;<CommentID>@@ENCCOMMENTID@@</CommentID> 95253 "RTN","C0CCCR0",663,0) 95254 ;;</Encounter> 95255 "RTN","C0CCCR0",664,0) 95256 ;;</Encounters> 95257 "RTN","C0CCCR0",665,0) 95258 ;;<HealthCareProviders> 95259 "RTN","C0CCCR0",666,0) 95260 ;;<Provider> 95261 "RTN","C0CCCR0",667,0) 95262 ;;<ActorID>AA0005</ActorID> 95263 "RTN","C0CCCR0",668,0) 94282 95264 ;;<ActorRole> 94283 "RTN","C0CCCR0", 165,0)94284 ;;<Text> @@FAMILYMEMBERACTORROLETEXT@@</Text>94285 "RTN","C0CCCR0", 166,0)95265 "RTN","C0CCCR0",669,0) 95266 ;;<Text>Primary Provider</Text> 95267 "RTN","C0CCCR0",670,0) 94286 95268 ;;</ActorRole> 94287 "RTN","C0CCCR0",167,0) 95269 "RTN","C0CCCR0",671,0) 95270 ;;</Provider> 95271 "RTN","C0CCCR0",672,0) 95272 ;;</HealthCareProviders> 95273 "RTN","C0CCCR0",673,0) 95274 ;;</Body> 95275 "RTN","C0CCCR0",674,0) 95276 ;;<Actors> 95277 "RTN","C0CCCR0",675,0) 95278 ;;<ACTOR-PATIENT> 95279 "RTN","C0CCCR0",676,0) 95280 ;;<Actor> 95281 "RTN","C0CCCR0",677,0) 95282 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID> 95283 "RTN","C0CCCR0",678,0) 95284 ;;<Person> 95285 "RTN","C0CCCR0",679,0) 95286 ;;<Name> 95287 "RTN","C0CCCR0",680,0) 95288 ;;<CurrentName> 95289 "RTN","C0CCCR0",681,0) 95290 ;;<Given>@@ACTORGIVENNAME@@</Given> 95291 "RTN","C0CCCR0",682,0) 95292 ;;<Middle>@@ACTORMIDDLENAME@@</Middle> 95293 "RTN","C0CCCR0",683,0) 95294 ;;<Family>@@ACTORFAMILYNAME@@</Family> 95295 "RTN","C0CCCR0",684,0) 95296 ;;</CurrentName> 95297 "RTN","C0CCCR0",685,0) 95298 ;;</Name> 95299 "RTN","C0CCCR0",686,0) 95300 ;;<DateOfBirth> 95301 "RTN","C0CCCR0",687,0) 95302 ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime> 95303 "RTN","C0CCCR0",688,0) 95304 ;;</DateOfBirth> 95305 "RTN","C0CCCR0",689,0) 95306 ;;<Gender> 95307 "RTN","C0CCCR0",690,0) 95308 ;;<Text>@@ACTORGENDER@@</Text> 95309 "RTN","C0CCCR0",691,0) 95310 ;;<Code> 95311 "RTN","C0CCCR0",692,0) 95312 ;;<Value>@@ACTORGENDERCODE@@</Value> 95313 "RTN","C0CCCR0",693,0) 95314 ;;<CodingSystem>HL7 AdministrativeGender</CodingSystem> 95315 "RTN","C0CCCR0",694,0) 95316 ;;</Code> 95317 "RTN","C0CCCR0",695,0) 95318 ;;</Gender> 95319 "RTN","C0CCCR0",696,0) 95320 ;;</Person> 95321 "RTN","C0CCCR0",697,0) 95322 ;;<IDs> 95323 "RTN","C0CCCR0",698,0) 95324 ;;<Type> 95325 "RTN","C0CCCR0",699,0) 95326 ;;<Text>@@ACTORSSNTEXT@@</Text> 95327 "RTN","C0CCCR0",700,0) 95328 ;;</Type> 95329 "RTN","C0CCCR0",701,0) 95330 ;;<ID>@@ACTORSSN@@</ID> 95331 "RTN","C0CCCR0",702,0) 94288 95332 ;;<Source> 94289 "RTN","C0CCCR0", 168,0)95333 "RTN","C0CCCR0",703,0) 94290 95334 ;;<Actor> 94291 "RTN","C0CCCR0", 169,0)94292 ;;<ActorID>@@ FAMILYMEMBERSOURCACTORID@@</ActorID>94293 "RTN","C0CCCR0", 170,0)95335 "RTN","C0CCCR0",704,0) 95336 ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID> 95337 "RTN","C0CCCR0",705,0) 94294 95338 ;;</Actor> 94295 "RTN","C0CCCR0", 171,0)95339 "RTN","C0CCCR0",706,0) 94296 95340 ;;</Source> 94297 "RTN","C0CCCR0", 172,0)94298 ;;</ FamilyMember>94299 "RTN","C0CCCR0", 173,0)94300 ;;< Problem>94301 "RTN","C0CCCR0", 174,0)95341 "RTN","C0CCCR0",707,0) 95342 ;;</IDs> 95343 "RTN","C0CCCR0",708,0) 95344 ;;<Address> 95345 "RTN","C0CCCR0",709,0) 94302 95346 ;;<Type> 94303 "RTN","C0CCCR0", 175,0)94304 ;;<Text> Problem</Text>94305 "RTN","C0CCCR0", 176,0)95347 "RTN","C0CCCR0",710,0) 95348 ;;<Text>@@ACTORADDRESSTYPE@@</Text> 95349 "RTN","C0CCCR0",711,0) 94306 95350 ;;</Type> 94307 "RTN","C0CCCR0",177,0) 95351 "RTN","C0CCCR0",712,0) 95352 ;;<Line1>@@ACTORADDRESSLINE1@@</Line1> 95353 "RTN","C0CCCR0",713,0) 95354 ;;<Line2>@@ACTORADDRESSLINE2@@</Line2> 95355 "RTN","C0CCCR0",714,0) 95356 ;;<City>@@ACTORADDRESSCITY@@</City> 95357 "RTN","C0CCCR0",715,0) 95358 ;;<State>@@ACTORADDRESSSTATE@@</State> 95359 "RTN","C0CCCR0",716,0) 95360 ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode> 95361 "RTN","C0CCCR0",717,0) 95362 ;;</Address> 95363 "RTN","C0CCCR0",718,0) 95364 ;;<Telephone> 95365 "RTN","C0CCCR0",719,0) 95366 ;;<Value>@@ACTORRESTEL@@</Value> 95367 "RTN","C0CCCR0",720,0) 95368 ;;<Type> 95369 "RTN","C0CCCR0",721,0) 95370 ;;<Text>@@ACTORRESTELTEXT@@</Text> 95371 "RTN","C0CCCR0",722,0) 95372 ;;</Type> 95373 "RTN","C0CCCR0",723,0) 95374 ;;</Telephone> 95375 "RTN","C0CCCR0",724,0) 95376 ;;<Telephone> 95377 "RTN","C0CCCR0",725,0) 95378 ;;<Value>@@ACTORWORKTEL@@</Value> 95379 "RTN","C0CCCR0",726,0) 95380 ;;<Type> 95381 "RTN","C0CCCR0",727,0) 95382 ;;<Text>@@ACTORWORKTELTEXT@@</Text> 95383 "RTN","C0CCCR0",728,0) 95384 ;;</Type> 95385 "RTN","C0CCCR0",729,0) 95386 ;;</Telephone> 95387 "RTN","C0CCCR0",730,0) 95388 ;;<Telephone> 95389 "RTN","C0CCCR0",731,0) 95390 ;;<Value>@@ACTORCELLTEL@@</Value> 95391 "RTN","C0CCCR0",732,0) 95392 ;;<Type> 95393 "RTN","C0CCCR0",733,0) 95394 ;;<Text>@@ACTORCELLTELTEXT@@</Text> 95395 "RTN","C0CCCR0",734,0) 95396 ;;</Type> 95397 "RTN","C0CCCR0",735,0) 95398 ;;</Telephone> 95399 "RTN","C0CCCR0",736,0) 95400 ;;<EMail> 95401 "RTN","C0CCCR0",737,0) 95402 ;;<Value>@@ACTOREMAIL@@</Value> 95403 "RTN","C0CCCR0",738,0) 95404 ;;</EMail> 95405 "RTN","C0CCCR0",739,0) 95406 ;;<Source> 95407 "RTN","C0CCCR0",740,0) 95408 ;;<Actor> 95409 "RTN","C0CCCR0",741,0) 95410 ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID> 95411 "RTN","C0CCCR0",742,0) 95412 ;;</Actor> 95413 "RTN","C0CCCR0",743,0) 95414 ;;</Source> 95415 "RTN","C0CCCR0",744,0) 95416 ;;</Actor> 95417 "RTN","C0CCCR0",745,0) 95418 ;;</ACTOR-PATIENT> 95419 "RTN","C0CCCR0",746,0) 95420 ;;<ACTOR-SYSTEM> 95421 "RTN","C0CCCR0",747,0) 95422 ;;<Actor> 95423 "RTN","C0CCCR0",748,0) 95424 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID> 95425 "RTN","C0CCCR0",749,0) 95426 ;;<InformationSystem> 95427 "RTN","C0CCCR0",750,0) 95428 ;;<Name>@@ACTORINFOSYSNAME@@</Name> 95429 "RTN","C0CCCR0",751,0) 95430 ;;<Version>@@ACTORINFOSYSVER@@</Version> 95431 "RTN","C0CCCR0",752,0) 95432 ;;</InformationSystem> 95433 "RTN","C0CCCR0",753,0) 95434 ;;<Source> 95435 "RTN","C0CCCR0",754,0) 95436 ;;<Actor> 95437 "RTN","C0CCCR0",755,0) 95438 ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID> 95439 "RTN","C0CCCR0",756,0) 95440 ;;</Actor> 95441 "RTN","C0CCCR0",757,0) 95442 ;;</Source> 95443 "RTN","C0CCCR0",758,0) 95444 ;;</Actor> 95445 "RTN","C0CCCR0",759,0) 95446 ;;</ACTOR-SYSTEM> 95447 "RTN","C0CCCR0",760,0) 95448 ;;<ACTOR-NOK> 95449 "RTN","C0CCCR0",761,0) 95450 ;;<Actor> 95451 "RTN","C0CCCR0",762,0) 95452 ;;<ActorObjectID>AA0003</ActorObjectID> 95453 "RTN","C0CCCR0",763,0) 95454 ;;<Person> 95455 "RTN","C0CCCR0",764,0) 95456 ;;<Name> 95457 "RTN","C0CCCR0",765,0) 95458 ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName> 95459 "RTN","C0CCCR0",766,0) 95460 ;;</Name> 95461 "RTN","C0CCCR0",767,0) 95462 ;;</Person> 95463 "RTN","C0CCCR0",768,0) 95464 ;;<Relation> 95465 "RTN","C0CCCR0",769,0) 95466 ;;<Text>@@ACTORRELATION@@</Text> 95467 "RTN","C0CCCR0",770,0) 95468 ;;</Relation> 95469 "RTN","C0CCCR0",771,0) 95470 ;;<Source> 95471 "RTN","C0CCCR0",772,0) 95472 ;;<Actor> 95473 "RTN","C0CCCR0",773,0) 95474 ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID> 95475 "RTN","C0CCCR0",774,0) 95476 ;;</Actor> 95477 "RTN","C0CCCR0",775,0) 95478 ;;</Source> 95479 "RTN","C0CCCR0",776,0) 95480 ;;</Actor> 95481 "RTN","C0CCCR0",777,0) 95482 ;;</ACTOR-NOK> 95483 "RTN","C0CCCR0",778,0) 95484 ;;<ACTOR-PROVIDER> 95485 "RTN","C0CCCR0",779,0) 95486 ;;<Actor> 95487 "RTN","C0CCCR0",780,0) 95488 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID> 95489 "RTN","C0CCCR0",781,0) 95490 ;;<Person> 95491 "RTN","C0CCCR0",782,0) 95492 ;;<Name> 95493 "RTN","C0CCCR0",783,0) 95494 ;;<CurrentName> 95495 "RTN","C0CCCR0",784,0) 95496 ;;<Given>@@ACTORGIVENNAME@@</Given> 95497 "RTN","C0CCCR0",785,0) 95498 ;;<Middle>@@ACTORMIDDLENAME@@</Middle> 95499 "RTN","C0CCCR0",786,0) 95500 ;;<Family>@@ACTORFAMILYNAME@@</Family> 95501 "RTN","C0CCCR0",787,0) 95502 ;;<Title>@@ACTORTITLE@@</Title> 95503 "RTN","C0CCCR0",788,0) 95504 ;;</CurrentName> 95505 "RTN","C0CCCR0",789,0) 95506 ;;</Name> 95507 "RTN","C0CCCR0",790,0) 95508 ;;</Person> 95509 "RTN","C0CCCR0",791,0) 95510 ;;<Specialty> 95511 "RTN","C0CCCR0",792,0) 95512 ;;<Text>@@ACTORSPECIALITY@@</Text> 95513 "RTN","C0CCCR0",793,0) 95514 ;;</Specialty> 95515 "RTN","C0CCCR0",794,0) 95516 ;;<Address> 95517 "RTN","C0CCCR0",795,0) 95518 ;;<Type> 95519 "RTN","C0CCCR0",796,0) 95520 ;;<Text>@@ACTORADDRESSTYPE@@</Text> 95521 "RTN","C0CCCR0",797,0) 95522 ;;</Type> 95523 "RTN","C0CCCR0",798,0) 95524 ;;<Line1>@@ACTORADDRESSLINE1@@</Line1> 95525 "RTN","C0CCCR0",799,0) 95526 ;;<City>@@ACTORADDRESSCITY@@</City> 95527 "RTN","C0CCCR0",800,0) 95528 ;;<State>@@ACTORADDRESSSTATE@@</State> 95529 "RTN","C0CCCR0",801,0) 95530 ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode> 95531 "RTN","C0CCCR0",802,0) 95532 ;;</Address> 95533 "RTN","C0CCCR0",803,0) 95534 ;;<Telephone> 95535 "RTN","C0CCCR0",804,0) 95536 ;;<Value>@@ACTORTELEPHONE@@</Value> 95537 "RTN","C0CCCR0",805,0) 95538 ;;<Type> 95539 "RTN","C0CCCR0",806,0) 95540 ;;<Text>@@ACTORTELEPHONETYPE@@</Text> 95541 "RTN","C0CCCR0",807,0) 95542 ;;</Type> 95543 "RTN","C0CCCR0",808,0) 95544 ;;</Telephone> 95545 "RTN","C0CCCR0",809,0) 95546 ;;<Email> 95547 "RTN","C0CCCR0",810,0) 95548 ;;<Value>@@ACTOREMAIL@@</Value> 95549 "RTN","C0CCCR0",811,0) 95550 ;;</Email> 95551 "RTN","C0CCCR0",812,0) 95552 ;;<Source> 95553 "RTN","C0CCCR0",813,0) 95554 ;;<Actor> 95555 "RTN","C0CCCR0",814,0) 95556 ;;<ActorID>@@ACTORSOURCEID@@</ActorID> 95557 "RTN","C0CCCR0",815,0) 95558 ;;</Actor> 95559 "RTN","C0CCCR0",816,0) 95560 ;;</Source> 95561 "RTN","C0CCCR0",817,0) 95562 ;;<InternalCCRLink> 95563 "RTN","C0CCCR0",818,0) 95564 ;;<LinkID>@@ACTORORGLINK@@</LinkID> 95565 "RTN","C0CCCR0",819,0) 95566 ;;<LinkRelationship>representedOrganization</LinkRelationship> 95567 "RTN","C0CCCR0",820,0) 95568 ;;</InternalCCRLink> 95569 "RTN","C0CCCR0",821,0) 95570 ;;</Actor> 95571 "RTN","C0CCCR0",822,0) 95572 ;;</ACTOR-PROVIDER> 95573 "RTN","C0CCCR0",823,0) 95574 ;;<ACTOR-ORG> 95575 "RTN","C0CCCR0",824,0) 95576 ;;<Actor> 95577 "RTN","C0CCCR0",825,0) 95578 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID> 95579 "RTN","C0CCCR0",826,0) 95580 ;;<Organization> 95581 "RTN","C0CCCR0",827,0) 95582 ;;<Name>@@ORGANIZATIONNAME@@</Name> 95583 "RTN","C0CCCR0",828,0) 95584 ;;</Organization> 95585 "RTN","C0CCCR0",829,0) 95586 ;;<Address> 95587 "RTN","C0CCCR0",830,0) 95588 ;;<Type> 95589 "RTN","C0CCCR0",831,0) 95590 ;;<Text>@@ACTORADDRESSTYPE@@</Text> 95591 "RTN","C0CCCR0",832,0) 95592 ;;</Type> 95593 "RTN","C0CCCR0",833,0) 95594 ;;<Line1>@@ACTORADDRESSLINE1@@</Line1> 95595 "RTN","C0CCCR0",834,0) 95596 ;;<City>@@ACTORADDRESSCITY@@</City> 95597 "RTN","C0CCCR0",835,0) 95598 ;;<State>@@ACTORADDRESSSTATE@@</State> 95599 "RTN","C0CCCR0",836,0) 95600 ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode> 95601 "RTN","C0CCCR0",837,0) 95602 ;;</Address> 95603 "RTN","C0CCCR0",838,0) 95604 ;;<Telephone> 95605 "RTN","C0CCCR0",839,0) 95606 ;;<Value>@@ACTORTELEPHONE@@</Value> 95607 "RTN","C0CCCR0",840,0) 95608 ;;<Type> 95609 "RTN","C0CCCR0",841,0) 95610 ;;<Text>@@ACTORTELEPHONETYPE@@</Text> 95611 "RTN","C0CCCR0",842,0) 95612 ;;</Type> 95613 "RTN","C0CCCR0",843,0) 95614 ;;</Telephone> 95615 "RTN","C0CCCR0",844,0) 95616 ;;<Source> 95617 "RTN","C0CCCR0",845,0) 95618 ;;<Actor> 95619 "RTN","C0CCCR0",846,0) 95620 ;;<ActorID>@@ACTORSOURCEID@@</ActorID> 95621 "RTN","C0CCCR0",847,0) 95622 ;;</Actor> 95623 "RTN","C0CCCR0",848,0) 95624 ;;</Source> 95625 "RTN","C0CCCR0",849,0) 95626 ;;</Actor> 95627 "RTN","C0CCCR0",850,0) 95628 ;;</ACTOR-ORG> 95629 "RTN","C0CCCR0",851,0) 95630 ;;</Actors> 95631 "RTN","C0CCCR0",852,0) 95632 ;;<Signatures> 95633 "RTN","C0CCCR0",853,0) 95634 ;;<CCRSignature> 95635 "RTN","C0CCCR0",854,0) 95636 ;;<SignatureObjectID>S0001</SignatureObjectID> 95637 "RTN","C0CCCR0",855,0) 95638 ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime> 95639 "RTN","C0CCCR0",856,0) 95640 ;;<Source> 95641 "RTN","C0CCCR0",857,0) 95642 ;;<ActorID>AA0001</ActorID> 95643 "RTN","C0CCCR0",858,0) 95644 ;;</Source> 95645 "RTN","C0CCCR0",859,0) 95646 ;;<Signature> 95647 "RTN","C0CCCR0",860,0) 95648 ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#"> 95649 "RTN","C0CCCR0",861,0) 95650 ;;<SignedInfo> 95651 "RTN","C0CCCR0",862,0) 95652 ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/> 95653 "RTN","C0CCCR0",863,0) 95654 ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/> 95655 "RTN","C0CCCR0",864,0) 95656 ;;<Reference URI=""> 95657 "RTN","C0CCCR0",865,0) 95658 ;;<Transforms> 95659 "RTN","C0CCCR0",866,0) 95660 ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/> 95661 "RTN","C0CCCR0",867,0) 95662 ;;</Transforms> 95663 "RTN","C0CCCR0",868,0) 95664 ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/> 95665 "RTN","C0CCCR0",869,0) 95666 ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue> 95667 "RTN","C0CCCR0",870,0) 95668 ;;</Reference> 95669 "RTN","C0CCCR0",871,0) 95670 ;;</SignedInfo> 95671 "RTN","C0CCCR0",872,0) 95672 ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue> 95673 "RTN","C0CCCR0",873,0) 95674 ;;<KeyInfo> 95675 "RTN","C0CCCR0",874,0) 95676 ;;<KeyValue> 95677 "RTN","C0CCCR0",875,0) 95678 ;;<RSAKeyValue> 95679 "RTN","C0CCCR0",876,0) 95680 ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus> 95681 "RTN","C0CCCR0",877,0) 95682 ;;<Exponent>AQAB</Exponent> 95683 "RTN","C0CCCR0",878,0) 95684 ;;</RSAKeyValue> 95685 "RTN","C0CCCR0",879,0) 95686 ;;</KeyValue> 95687 "RTN","C0CCCR0",880,0) 95688 ;;</KeyInfo> 95689 "RTN","C0CCCR0",881,0) 95690 ;;</Signature> 95691 "RTN","C0CCCR0",882,0) 95692 ;;</Signature> 95693 "RTN","C0CCCR0",883,0) 95694 ;;</CCRSignature> 95695 "RTN","C0CCCR0",884,0) 95696 ;;</Signatures> 95697 "RTN","C0CCCR0",885,0) 95698 ;;<Comments> 95699 "RTN","C0CCCR0",886,0) 95700 ;;<Comment> 95701 "RTN","C0CCCR0",887,0) 95702 ;;<CommentObjectID>@@COMMENTOBJECTID@@</CommentObjectID> 95703 "RTN","C0CCCR0",888,0) 95704 ;;<DateTime> 95705 "RTN","C0CCCR0",889,0) 95706 ;;<ExactDateTime>@@CMTDATETIME@@</ExactDateTime> 95707 "RTN","C0CCCR0",890,0) 95708 ;;</DateTime> 95709 "RTN","C0CCCR0",891,0) 94308 95710 ;;<Description> 94309 "RTN","C0CCCR0",178,0) 94310 ;;<Text>@@FAMILYMEMBERPROBLEMDESCRIPTION@@</Text> 94311 "RTN","C0CCCR0",179,0) 94312 ;;<Code> 94313 "RTN","C0CCCR0",180,0) 94314 ;;<Value>@@FAMILYMEMBERPROBLEMCODE@@</Value> 94315 "RTN","C0CCCR0",181,0) 94316 ;;<CodingSystem>@@FAMILYMEMBERCODESYSTEM@@</CodingSystem> 94317 "RTN","C0CCCR0",182,0) 94318 ;;<Version>@@FAMILYMEMBERCODEVERSION@@</Version> 94319 "RTN","C0CCCR0",183,0) 94320 ;;</Code> 94321 "RTN","C0CCCR0",184,0) 95711 "RTN","C0CCCR0",892,0) 95712 ;;<Text> 95713 "RTN","C0CCCR0",893,0) 95714 ;;</Text> 95715 "RTN","C0CCCR0",894,0) 94322 95716 ;;</Description> 94323 "RTN","C0CCCR0", 185,0)95717 "RTN","C0CCCR0",895,0) 94324 95718 ;;<Source> 94325 "RTN","C0CCCR0", 186,0)95719 "RTN","C0CCCR0",896,0) 94326 95720 ;;<Actor> 94327 "RTN","C0CCCR0", 187,0)94328 ;;<ActorID>@@ FAMILYMEMBERPROBLEMSOURCEID@@</ActorID>94329 "RTN","C0CCCR0", 188,0)95721 "RTN","C0CCCR0",897,0) 95722 ;;<ActorID>@@ACTORSOURCEID@@</ActorID> 95723 "RTN","C0CCCR0",898,0) 94330 95724 ;;</Actor> 94331 "RTN","C0CCCR0", 189,0)95725 "RTN","C0CCCR0",899,0) 94332 95726 ;;</Source> 94333 "RTN","C0CCCR0",190,0)94334 ;;</Problem>94335 "RTN","C0CCCR0",191,0)94336 ;;</FamilyProblemHistory>94337 "RTN","C0CCCR0",192,0)94338 ;;</FamilyHistory>94339 "RTN","C0CCCR0",193,0)94340 ;;<SocialHistory>94341 "RTN","C0CCCR0",194,0)94342 ;;<SocialHistoryElement>94343 "RTN","C0CCCR0",195,0)94344 ;;<CCRDataObjectID>@@SOCIALHISTORYOBJECTID@@</CCRDataObjectID>94345 "RTN","C0CCCR0",196,0)94346 ;;<Type>94347 "RTN","C0CCCR0",197,0)94348 ;;<Text>@@SOCIALHISTORYTYPETEXT@@</Text>94349 "RTN","C0CCCR0",198,0)94350 ;;</Type>94351 "RTN","C0CCCR0",199,0)94352 ;;<Description>94353 "RTN","C0CCCR0",200,0)94354 ;;<Text>@@SOCIALHISTORYDESCRIPTIONTEXT@@</Text>94355 "RTN","C0CCCR0",201,0)94356 ;;</Description>94357 "RTN","C0CCCR0",202,0)94358 ;;<Source>94359 "RTN","C0CCCR0",203,0)94360 ;;<Actor>94361 "RTN","C0CCCR0",204,0)94362 ;;<ActorID>@@SOCIALHISTORYSOURCACTORID@@</ActorID>94363 "RTN","C0CCCR0",205,0)94364 ;;</Actor>94365 "RTN","C0CCCR0",206,0)94366 ;;</Source>94367 "RTN","C0CCCR0",207,0)94368 ;;</SocialHistoryElement>94369 "RTN","C0CCCR0",208,0)94370 ;;<SocialHistoryElement>94371 "RTN","C0CCCR0",209,0)94372 ;;<CCRDataObjectID>BB0005</CCRDataObjectID>94373 "RTN","C0CCCR0",210,0)94374 ;;<Type>94375 "RTN","C0CCCR0",211,0)94376 ;;<Text>Ethnic Origin</Text>94377 "RTN","C0CCCR0",212,0)94378 ;;</Type>94379 "RTN","C0CCCR0",213,0)94380 ;;<Description>94381 "RTN","C0CCCR0",214,0)94382 ;;<Text>Not Hispanic or Latino</Text>94383 "RTN","C0CCCR0",215,0)94384 ;;</Description>94385 "RTN","C0CCCR0",216,0)94386 ;;<Source>94387 "RTN","C0CCCR0",217,0)94388 ;;<Actor>94389 "RTN","C0CCCR0",218,0)94390 ;;<ActorID>AA0001</ActorID>94391 "RTN","C0CCCR0",219,0)94392 ;;</Actor>94393 "RTN","C0CCCR0",220,0)94394 ;;</Source>94395 "RTN","C0CCCR0",221,0)94396 ;;</SocialHistoryElement>94397 "RTN","C0CCCR0",222,0)94398 ;;<SocialHistoryElement>94399 "RTN","C0CCCR0",223,0)94400 ;;<CCRDataObjectID>BB0006</CCRDataObjectID>94401 "RTN","C0CCCR0",224,0)94402 ;;<Type>94403 "RTN","C0CCCR0",225,0)94404 ;;<Text>Race</Text>94405 "RTN","C0CCCR0",226,0)94406 ;;</Type>94407 "RTN","C0CCCR0",227,0)94408 ;;<Description>94409 "RTN","C0CCCR0",228,0)94410 ;;<Text>White</Text>94411 "RTN","C0CCCR0",229,0)94412 ;;</Description>94413 "RTN","C0CCCR0",230,0)94414 ;;<Source>94415 "RTN","C0CCCR0",231,0)94416 ;;<Actor>94417 "RTN","C0CCCR0",232,0)94418 ;;<ActorID>AA0001</ActorID>94419 "RTN","C0CCCR0",233,0)94420 ;;</Actor>94421 "RTN","C0CCCR0",234,0)94422 ;;</Source>94423 "RTN","C0CCCR0",235,0)94424 ;;</SocialHistoryElement>94425 "RTN","C0CCCR0",236,0)94426 ;;<SocialHistoryElement>94427 "RTN","C0CCCR0",237,0)94428 ;;<CCRDataObjectID>BB0007</CCRDataObjectID>94429 "RTN","C0CCCR0",238,0)94430 ;;<Type>94431 "RTN","C0CCCR0",239,0)94432 ;;<Text>Occupation</Text>94433 "RTN","C0CCCR0",240,0)94434 ;;</Type>94435 "RTN","C0CCCR0",241,0)94436 ;;<Description>94437 "RTN","C0CCCR0",242,0)94438 ;;<Text>Physician</Text>94439 "RTN","C0CCCR0",243,0)94440 ;;</Description>94441 "RTN","C0CCCR0",244,0)94442 ;;<Source>94443 "RTN","C0CCCR0",245,0)94444 ;;<Actor>94445 "RTN","C0CCCR0",246,0)94446 ;;<ActorID>AA0001</ActorID>94447 "RTN","C0CCCR0",247,0)94448 ;;</Actor>94449 "RTN","C0CCCR0",248,0)94450 ;;</Source>94451 "RTN","C0CCCR0",249,0)94452 ;;</SocialHistoryElement>94453 "RTN","C0CCCR0",250,0)94454 ;;</SocialHistory>94455 "RTN","C0CCCR0",251,0)94456 ;;<Alerts>94457 "RTN","C0CCCR0",252,0)94458 ;;<Alert>94459 "RTN","C0CCCR0",253,0)94460 ;;<CCRDataObjectID>@@ALERTOBJECTID@@</CCRDataObjectID>94461 "RTN","C0CCCR0",254,0)94462 ;;<DateTime>94463 "RTN","C0CCCR0",255,0)94464 ;;<ExactDateTime>@@ALERTDATETIME@@</ExactDateTime>94465 "RTN","C0CCCR0",256,0)94466 ;;</DateTime>94467 "RTN","C0CCCR0",257,0)94468 ;;<Type>94469 "RTN","C0CCCR0",258,0)94470 ;;<Text>@@ALERTTYPE@@</Text>94471 "RTN","C0CCCR0",259,0)94472 ;;</Type>94473 "RTN","C0CCCR0",260,0)94474 ;;<Status>94475 "RTN","C0CCCR0",261,0)94476 ;;<Text>@@ALERTSTATUSTEXT@@</Text>94477 "RTN","C0CCCR0",262,0)94478 ;;</Status>94479 "RTN","C0CCCR0",263,0)94480 ;;<Description>94481 "RTN","C0CCCR0",264,0)94482 ;;<Text>@@ALERTDESCRIPTIONTEXT@@</Text>94483 "RTN","C0CCCR0",265,0)94484 ;;<Code>94485 "RTN","C0CCCR0",266,0)94486 ;;<Value>@@ALERTCODEVALUE@@</Value>94487 "RTN","C0CCCR0",267,0)94488 ;;<CodingSystem>@@ALERTCODESYSTEM@@</CodingSystem>94489 "RTN","C0CCCR0",268,0)94490 ;;</Code>94491 "RTN","C0CCCR0",269,0)94492 ;;</Description>94493 "RTN","C0CCCR0",270,0)94494 ;;<Source>94495 "RTN","C0CCCR0",271,0)94496 ;;<Actor>94497 "RTN","C0CCCR0",272,0)94498 ;;<ActorID>@@ALERTSOURCEID@@</ActorID>94499 "RTN","C0CCCR0",273,0)94500 ;;</Actor>94501 "RTN","C0CCCR0",274,0)94502 ;;</Source>94503 "RTN","C0CCCR0",275,0)94504 ;;<Agent>94505 "RTN","C0CCCR0",276,0)94506 ;;<Products>94507 "RTN","C0CCCR0",277,0)94508 ;;<Product>94509 "RTN","C0CCCR0",278,0)94510 ;;<CCRDataObjectID>@@ALERTAGENTPRODUCTOBJECTID@@</CCRDataObjectID>94511 "RTN","C0CCCR0",279,0)94512 ;;<Source>94513 "RTN","C0CCCR0",280,0)94514 ;;<Actor>94515 "RTN","C0CCCR0",281,0)94516 ;;<ActorID>@@ALERTSOURCEID@@</ActorID>94517 "RTN","C0CCCR0",282,0)94518 ;;</Actor>94519 "RTN","C0CCCR0",283,0)94520 ;;</Source>94521 "RTN","C0CCCR0",284,0)94522 ;;<Product>94523 "RTN","C0CCCR0",285,0)94524 ;;<ProductName>94525 "RTN","C0CCCR0",286,0)94526 ;;<Text>@@ALERTAGENTPRODUCTNAMETEXT@@</Text>94527 "RTN","C0CCCR0",287,0)94528 ;;<Code>94529 "RTN","C0CCCR0",288,0)94530 ;;<Value>@@ALERTAGENTPRODUCTCODEVALUE@@</Value>94531 "RTN","C0CCCR0",289,0)94532 ;;<CodingSystem>@@ALERTAGENTPRODUCTCODESYSTEM@@</CodingSystem>94533 "RTN","C0CCCR0",290,0)94534 ;;</Code>94535 "RTN","C0CCCR0",291,0)94536 ;;</ProductName>94537 "RTN","C0CCCR0",292,0)94538 ;;</Product>94539 "RTN","C0CCCR0",293,0)94540 ;;</Product>94541 "RTN","C0CCCR0",294,0)94542 ;;</Products>94543 "RTN","C0CCCR0",295,0)94544 ;;</Agent>94545 "RTN","C0CCCR0",296,0)94546 ;;<Reaction>94547 "RTN","C0CCCR0",297,0)94548 ;;<Description>94549 "RTN","C0CCCR0",298,0)94550 ;;<Text>@@ALERTREACTIOINDESCRIPTIONTEXT@@</Text>94551 "RTN","C0CCCR0",299,0)94552 ;;<Code>94553 "RTN","C0CCCR0",300,0)94554 ;;<Value>@@ALERTREACTIONCODEVALUE@@</Value>94555 "RTN","C0CCCR0",301,0)94556 ;;<CodingSystem>@@ALERTREACTIONCODESYSTEM@@</CodingSystem>94557 "RTN","C0CCCR0",302,0)94558 ;;</Code>94559 "RTN","C0CCCR0",303,0)94560 ;;</Description>94561 "RTN","C0CCCR0",304,0)94562 ;;</Reaction>94563 "RTN","C0CCCR0",305,0)94564 ;;</Alert>94565 "RTN","C0CCCR0",306,0)94566 ;;</Alerts>94567 "RTN","C0CCCR0",307,0)94568 ;;<Medications>94569 "RTN","C0CCCR0",308,0)94570 ;;<Medication>94571 "RTN","C0CCCR0",309,0)94572 ;;<CCRDataObjectID>@@MEDOBJECTID@@</CCRDataObjectID>94573 "RTN","C0CCCR0",310,0)94574 ;;<DateTime>94575 "RTN","C0CCCR0",311,0)94576 ;;<Type>94577 "RTN","C0CCCR0",312,0)94578 ;;<Text>@@MEDISSUEDATETXT@@</Text>94579 "RTN","C0CCCR0",313,0)94580 ;;</Type>94581 "RTN","C0CCCR0",314,0)94582 ;;<ExactDateTime>@@MEDISSUEDATE@@</ExactDateTime>94583 "RTN","C0CCCR0",315,0)94584 ;;</DateTime>94585 "RTN","C0CCCR0",316,0)94586 ;;<DateTime>94587 "RTN","C0CCCR0",317,0)94588 ;;<Type>94589 "RTN","C0CCCR0",318,0)94590 ;;<Text>@@MEDLASTFILLDATETXT@@</Text>94591 "RTN","C0CCCR0",319,0)94592 ;;</Type>94593 "RTN","C0CCCR0",320,0)94594 ;;<ExactDateTime>@@MEDLASTFILLDATE@@</ExactDateTime>94595 "RTN","C0CCCR0",321,0)94596 ;;</DateTime>94597 "RTN","C0CCCR0",322,0)94598 ;;<IDs>94599 "RTN","C0CCCR0",323,0)94600 ;;<Type>94601 "RTN","C0CCCR0",324,0)94602 ;;<Text>@@MEDRXNOTXT@@</Text>94603 "RTN","C0CCCR0",325,0)94604 ;;</Type>94605 "RTN","C0CCCR0",326,0)94606 ;;<ID>@@MEDRXNO@@</ID>94607 "RTN","C0CCCR0",327,0)94608 ;;</IDs>94609 "RTN","C0CCCR0",328,0)94610 ;;<Type>94611 "RTN","C0CCCR0",329,0)94612 ;;<Text>@@MEDTYPETEXT@@</Text>94613 "RTN","C0CCCR0",330,0)94614 ;;</Type>94615 "RTN","C0CCCR0",331,0)94616 ;;<Description>94617 "RTN","C0CCCR0",332,0)94618 ;;<Text>@@MEDDETAILUNADORNED@@</Text>94619 "RTN","C0CCCR0",333,0)94620 ;;</Description>94621 "RTN","C0CCCR0",334,0)94622 ;;<Status>94623 "RTN","C0CCCR0",335,0)94624 ;;<Text>@@MEDSTATUSTEXT@@</Text>94625 "RTN","C0CCCR0",336,0)94626 ;;</Status>94627 "RTN","C0CCCR0",337,0)94628 ;;<Source>94629 "RTN","C0CCCR0",338,0)94630 ;;<Actor>94631 "RTN","C0CCCR0",339,0)94632 ;;<ActorID>@@MEDSOURCEACTORID@@</ActorID>94633 "RTN","C0CCCR0",340,0)94634 ;;</Actor>94635 "RTN","C0CCCR0",341,0)94636 ;;</Source>94637 "RTN","C0CCCR0",342,0)94638 ;;<Product>94639 "RTN","C0CCCR0",343,0)94640 ;;<ProductName>94641 "RTN","C0CCCR0",344,0)94642 ;;<Text>@@MEDPRODUCTNAMETEXT@@</Text>94643 "RTN","C0CCCR0",345,0)94644 ;;<Code>94645 "RTN","C0CCCR0",346,0)94646 ;;<Value>@@MEDPRODUCTNAMECODEVALUE@@</Value>94647 "RTN","C0CCCR0",347,0)94648 ;;<CodingSystem>@@MEDPRODUCTNAMECODINGINGSYSTEM@@</CodingSystem>94649 "RTN","C0CCCR0",348,0)94650 ;;<Version>@@MEDPRODUCTNAMECODEVERSION@@</Version>94651 "RTN","C0CCCR0",349,0)94652 ;;</Code>94653 "RTN","C0CCCR0",350,0)94654 ;;</ProductName>94655 "RTN","C0CCCR0",351,0)94656 ;;<BrandName>94657 "RTN","C0CCCR0",352,0)94658 ;;<Text>@@MEDBRANDNAMETEXT@@</Text>94659 "RTN","C0CCCR0",353,0)94660 ;;</BrandName>94661 "RTN","C0CCCR0",354,0)94662 ;;<Strength>94663 "RTN","C0CCCR0",355,0)94664 ;;<Value>@@MEDSTRENGTHVALUE@@</Value>94665 "RTN","C0CCCR0",356,0)94666 ;;<Units>94667 "RTN","C0CCCR0",357,0)94668 ;;<Unit>@@MEDSTRENGTHUNIT@@</Unit>94669 "RTN","C0CCCR0",358,0)94670 ;;</Units>94671 "RTN","C0CCCR0",359,0)94672 ;;</Strength>94673 "RTN","C0CCCR0",360,0)94674 ;;<Form>94675 "RTN","C0CCCR0",361,0)94676 ;;<Text>@@MEDFORMTEXT@@</Text>94677 "RTN","C0CCCR0",362,0)94678 ;;</Form>94679 "RTN","C0CCCR0",363,0)94680 ;;<Concentration>94681 "RTN","C0CCCR0",364,0)94682 ;;<Value>@@MEDCONCVALUE@@</Value>94683 "RTN","C0CCCR0",365,0)94684 ;;<Units>94685 "RTN","C0CCCR0",366,0)94686 ;;<Unit>@@MEDCONCUNIT@@</Unit>94687 "RTN","C0CCCR0",367,0)94688 ;;</Units>94689 "RTN","C0CCCR0",368,0)94690 ;;</Concentration>94691 "RTN","C0CCCR0",369,0)94692 ;;</Product>94693 "RTN","C0CCCR0",370,0)94694 ;;<Quantity>94695 "RTN","C0CCCR0",371,0)94696 ;;<Value>@@MEDQUANTITYVALUE@@</Value>94697 "RTN","C0CCCR0",372,0)94698 ;;<Units>94699 "RTN","C0CCCR0",373,0)94700 ;;<Unit>@@MEDQUANTITYUNIT@@</Unit>94701 "RTN","C0CCCR0",374,0)94702 ;;</Units>94703 "RTN","C0CCCR0",375,0)94704 ;;</Quantity>94705 "RTN","C0CCCR0",376,0)94706 ;;<Directions>94707 "RTN","C0CCCR0",377,0)94708 ;;<Direction>94709 "RTN","C0CCCR0",378,0)94710 ;;<Description>94711 "RTN","C0CCCR0",379,0)94712 ;;<Text>@@MEDDIRECTIONDESCRIPTIONTEXT@@</Text>94713 "RTN","C0CCCR0",380,0)94714 ;;</Description>94715 "RTN","C0CCCR0",381,0)94716 ;;<DoseIndicator>94717 "RTN","C0CCCR0",382,0)94718 ;;<Text>@@MEDDOSEINDICATOR@@</Text>94719 "RTN","C0CCCR0",383,0)94720 ;;</DoseIndicator>94721 "RTN","C0CCCR0",384,0)94722 ;;<DeliveryMethod>94723 "RTN","C0CCCR0",385,0)94724 ;;<Text>@@MEDDELIVERYMETHOD@@</Text>94725 "RTN","C0CCCR0",386,0)94726 ;;</DeliveryMethod>94727 "RTN","C0CCCR0",387,0)94728 ;;<Dose>94729 "RTN","C0CCCR0",388,0)94730 ;;<Value>@@MEDDOSEVALUE@@</Value>94731 "RTN","C0CCCR0",389,0)94732 ;;<Units>94733 "RTN","C0CCCR0",390,0)94734 ;;<Unit>@@MEDDOSEUNIT@@</Unit>94735 "RTN","C0CCCR0",391,0)94736 ;;</Units>94737 "RTN","C0CCCR0",392,0)94738 ;;<Rate>94739 "RTN","C0CCCR0",393,0)94740 ;;<Value>@@MEDRATEVALUE@@</Value>94741 "RTN","C0CCCR0",394,0)94742 ;;<Units>94743 "RTN","C0CCCR0",395,0)94744 ;;<Unit>@@MEDRATEUNIT@@</Unit>94745 "RTN","C0CCCR0",396,0)94746 ;;</Units>94747 "RTN","C0CCCR0",397,0)94748 ;;</Rate>94749 "RTN","C0CCCR0",398,0)94750 ;;</Dose>94751 "RTN","C0CCCR0",399,0)94752 ;;<Vehicle>94753 "RTN","C0CCCR0",400,0)94754 ;;<Text>@@MEDVEHICLETEXT@@</Text>94755 "RTN","C0CCCR0",401,0)94756 ;;</Vehicle>94757 "RTN","C0CCCR0",402,0)94758 ;;<Route>94759 "RTN","C0CCCR0",403,0)94760 ;;<Text>@@MEDDIRECTIONROUTETEXT@@</Text>94761 "RTN","C0CCCR0",404,0)94762 ;;</Route>94763 "RTN","C0CCCR0",405,0)94764 ;;<Frequency>94765 "RTN","C0CCCR0",406,0)94766 ;;<Value>@@MEDFREQUENCYVALUE@@</Value>94767 "RTN","C0CCCR0",407,0)94768 ;;</Frequency>94769 "RTN","C0CCCR0",408,0)94770 ;;<Interval>94771 "RTN","C0CCCR0",409,0)94772 ;;<Value>@@MEDINTERVALVALUE@@</Value>94773 "RTN","C0CCCR0",410,0)94774 ;;<Units>94775 "RTN","C0CCCR0",411,0)94776 ;;<Unit>@@MEDINTERVALUNIT@@</Unit>94777 "RTN","C0CCCR0",412,0)94778 ;;</Units>94779 "RTN","C0CCCR0",413,0)94780 ;;</Interval>94781 "RTN","C0CCCR0",414,0)94782 ;;<Duration>94783 "RTN","C0CCCR0",415,0)94784 ;;<Value>@@MEDDURATIONVALUE@@</Value>94785 "RTN","C0CCCR0",416,0)94786 ;;<Units>94787 "RTN","C0CCCR0",417,0)94788 ;;<Unit>@@MEDDURATIONUNIT@@</Unit>94789 "RTN","C0CCCR0",418,0)94790 ;;</Units>94791 "RTN","C0CCCR0",419,0)94792 ;;</Duration>94793 "RTN","C0CCCR0",420,0)94794 ;;<Indication>94795 "RTN","C0CCCR0",421,0)94796 ;;<PRNFlag>94797 "RTN","C0CCCR0",422,0)94798 ;;<Text>@@MEDPRNFLAG@@</Text>94799 "RTN","C0CCCR0",423,0)94800 ;;</PRNFlag>94801 "RTN","C0CCCR0",424,0)94802 ;;<Problem>94803 "RTN","C0CCCR0",425,0)94804 ;;<CCRDataObjectID>@@MEDPROBLEMOBJECTID@@</CCRDataObjectID>94805 "RTN","C0CCCR0",426,0)94806 ;;<Type>94807 "RTN","C0CCCR0",427,0)94808 ;;<Text>@@MEDPROBLEMTYPETXT@@</Text>94809 "RTN","C0CCCR0",428,0)94810 ;;</Type>94811 "RTN","C0CCCR0",429,0)94812 ;;<Description>94813 "RTN","C0CCCR0",430,0)94814 ;;<Text>@@MEDPROBLEMDESCRIPTION@@</Text>94815 "RTN","C0CCCR0",431,0)94816 ;;<Code>94817 "RTN","C0CCCR0",432,0)94818 ;;<Value>@@MEDPROBLEMCODEVALUE@@</Value>94819 "RTN","C0CCCR0",433,0)94820 ;;<CodingSystem>@@MEDPROBLEMCODINGSYSTEM@@</CodingSystem>94821 "RTN","C0CCCR0",434,0)94822 ;;<Version>@@MEDPROBLEMCODINGVERSION@@</Version>94823 "RTN","C0CCCR0",435,0)94824 ;;</Code>94825 "RTN","C0CCCR0",436,0)94826 ;;</Description>94827 "RTN","C0CCCR0",437,0)94828 ;;<Source>94829 "RTN","C0CCCR0",438,0)94830 ;;<Actor>94831 "RTN","C0CCCR0",439,0)94832 ;;<ActorID>@@MEDPROBLEMSOURCEACTORID@@</ActorID>94833 "RTN","C0CCCR0",440,0)94834 ;;</Actor>94835 "RTN","C0CCCR0",441,0)94836 ;;</Source>94837 "RTN","C0CCCR0",442,0)94838 ;;</Problem>94839 "RTN","C0CCCR0",443,0)94840 ;;</Indication>94841 "RTN","C0CCCR0",444,0)94842 ;;<StopIndicator>94843 "RTN","C0CCCR0",445,0)94844 ;;<Text>@@MEDSTOPINDICATOR@@</Text>94845 "RTN","C0CCCR0",446,0)94846 ;;</StopIndicator>94847 "RTN","C0CCCR0",447,0)94848 ;;<DirectionSequenceModifier>@@MEDDIRSEQ@@</DirectionSequenceModifier>94849 "RTN","C0CCCR0",448,0)94850 ;;<MultipleDirectionModifier>94851 "RTN","C0CCCR0",449,0)94852 ;;<Text>@@MEDMULDIRMOD@@</Text>94853 "RTN","C0CCCR0",450,0)94854 ;;</MultipleDirectionModifier>94855 "RTN","C0CCCR0",451,0)94856 ;;</Direction>94857 "RTN","C0CCCR0",452,0)94858 ;;</Directions>94859 "RTN","C0CCCR0",453,0)94860 ;;<PatientInstructions>94861 "RTN","C0CCCR0",454,0)94862 ;;<Instruction>94863 "RTN","C0CCCR0",455,0)94864 ;;<Text>@@MEDPTINSTRUCTIONS@@</Text>94865 "RTN","C0CCCR0",456,0)94866 ;;</Instruction>94867 "RTN","C0CCCR0",457,0)94868 ;;</PatientInstructions>94869 "RTN","C0CCCR0",458,0)94870 ;;<FullfillmentInstructions>94871 "RTN","C0CCCR0",459,0)94872 ;;<Text>@@MEDFULLFILLMENTINSTRUCTIONS@@</Text>94873 "RTN","C0CCCR0",460,0)94874 ;;</FullfillmentInstructions>94875 "RTN","C0CCCR0",461,0)94876 ;;<Refills>94877 "RTN","C0CCCR0",462,0)94878 ;;<Refill>94879 "RTN","C0CCCR0",463,0)94880 ;;<Number>@@MEDRFNO@@</Number>94881 "RTN","C0CCCR0",464,0)94882 ;;</Refill>94883 "RTN","C0CCCR0",465,0)94884 ;;</Refills>94885 "RTN","C0CCCR0",466,0)94886 ;;</Medication>94887 "RTN","C0CCCR0",467,0)94888 ;;</Medications>94889 "RTN","C0CCCR0",468,0)94890 ;;<VitalSigns>94891 "RTN","C0CCCR0",469,0)94892 ;;<Result>94893 "RTN","C0CCCR0",470,0)94894 ;;<CCRDataObjectID>@@VITALSIGNSDATAOBJECTID@@</CCRDataObjectID>94895 "RTN","C0CCCR0",471,0)94896 ;;<DateTime>94897 "RTN","C0CCCR0",472,0)94898 ;;<Type>94899 "RTN","C0CCCR0",473,0)94900 ;;<Text>@@VITALSIGNSDATETIMETYPETEXT@@</Text>94901 "RTN","C0CCCR0",474,0)94902 ;;</Type>94903 "RTN","C0CCCR0",475,0)94904 ;;<ExactDateTime>@@VITALSIGNSEXACTDATETIME@@</ExactDateTime>94905 "RTN","C0CCCR0",476,0)94906 ;;</DateTime>94907 "RTN","C0CCCR0",477,0)94908 ;;<Description>94909 "RTN","C0CCCR0",478,0)94910 ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>94911 "RTN","C0CCCR0",479,0)94912 ;;</Description>94913 "RTN","C0CCCR0",480,0)94914 ;;<Source>94915 "RTN","C0CCCR0",481,0)94916 ;;<Actor>94917 "RTN","C0CCCR0",482,0)94918 ;;<ActorID>@@VITALSIGNSSOURCEACTORID@@</ActorID>94919 "RTN","C0CCCR0",483,0)94920 ;;</Actor>94921 "RTN","C0CCCR0",484,0)94922 ;;</Source>94923 "RTN","C0CCCR0",485,0)94924 ;;<Test>94925 "RTN","C0CCCR0",486,0)94926 ;;<CCRDataObjectID>@@VITALSIGNSTESTOBJECTID@@</CCRDataObjectID>94927 "RTN","C0CCCR0",487,0)94928 ;;<Type>94929 "RTN","C0CCCR0",488,0)94930 ;;<Text>@@VITALSIGNSTESTTYPETEXT@@</Text>94931 "RTN","C0CCCR0",489,0)94932 ;;</Type>94933 "RTN","C0CCCR0",490,0)94934 ;;<Description>94935 "RTN","C0CCCR0",491,0)94936 ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>94937 "RTN","C0CCCR0",492,0)94938 ;;<Code>94939 "RTN","C0CCCR0",493,0)94940 ;;<Value>@@VITALSIGNSDESCCODEVALUE@@</Value>94941 "RTN","C0CCCR0",494,0)94942 ;;<CodingSystem>@@VITALSIGNSDESCCODINGSYSTEM@@</CodingSystem>94943 "RTN","C0CCCR0",495,0)94944 ;;<Version>@@VITALSIGNSCODEVERSION@@</Version>94945 "RTN","C0CCCR0",496,0)94946 ;;</Code>94947 "RTN","C0CCCR0",497,0)94948 ;;</Description>94949 "RTN","C0CCCR0",498,0)94950 ;;<Source>94951 "RTN","C0CCCR0",499,0)94952 ;;<Actor>94953 "RTN","C0CCCR0",500,0)94954 ;;<ActorID>@@VITALSIGNSTESTSOURCEACTORID@@</ActorID>94955 "RTN","C0CCCR0",501,0)94956 ;;</Actor>94957 "RTN","C0CCCR0",502,0)94958 ;;</Source>94959 "RTN","C0CCCR0",503,0)94960 ;;<TestResult>94961 "RTN","C0CCCR0",504,0)94962 ;;<Value>@@VITALSIGNSTESTRESULTVALUE@@</Value>94963 "RTN","C0CCCR0",505,0)94964 ;;<Units>94965 "RTN","C0CCCR0",506,0)94966 ;;<Unit>@@VITALSIGNSTESTRESULTUNIT@@</Unit>94967 "RTN","C0CCCR0",507,0)94968 ;;</Units>94969 "RTN","C0CCCR0",508,0)94970 ;;</TestResult>94971 "RTN","C0CCCR0",509,0)94972 ;;</Test>94973 "RTN","C0CCCR0",510,0)94974 ;;</Result>94975 "RTN","C0CCCR0",511,0)94976 ;;</VitalSigns>94977 "RTN","C0CCCR0",512,0)94978 ;;<Results>94979 "RTN","C0CCCR0",513,0)94980 ;;<Result>94981 "RTN","C0CCCR0",514,0)94982 ;;<CCRDataObjectID>@@RESULTOBJECTID@@</CCRDataObjectID>94983 "RTN","C0CCCR0",515,0)94984 ;;<DateTime>94985 "RTN","C0CCCR0",516,0)94986 ;;<Type>94987 "RTN","C0CCCR0",517,0)94988 ;;<Text>Assessment Time</Text>94989 "RTN","C0CCCR0",518,0)94990 ;;</Type>94991 "RTN","C0CCCR0",519,0)94992 ;;<ExactDateTime>@@RESULTASSESSMENTDATETIME@@</ExactDateTime>94993 "RTN","C0CCCR0",520,0)94994 ;;</DateTime>94995 "RTN","C0CCCR0",521,0)94996 ;;<Description>94997 "RTN","C0CCCR0",522,0)94998 ;;<Text>@@RESULTDESCRIPTIONTEXT@@</Text>94999 "RTN","C0CCCR0",523,0)95000 ;;<Code>95001 "RTN","C0CCCR0",524,0)95002 ;;<Value>@@RESULTCODE@@</Value>95003 "RTN","C0CCCR0",525,0)95004 ;;<CodingSystem>@@RESULTCODINGSYSTEM@@</CodingSystem>95005 "RTN","C0CCCR0",526,0)95006 ;;</Code>95007 "RTN","C0CCCR0",527,0)95008 ;;</Description>95009 "RTN","C0CCCR0",528,0)95010 ;;<Status>95011 "RTN","C0CCCR0",529,0)95012 ;;<Text>@@RESULTSTATUS@@</Text>95013 "RTN","C0CCCR0",530,0)95014 ;;</Status>95015 "RTN","C0CCCR0",531,0)95016 ;;<Source>95017 "RTN","C0CCCR0",532,0)95018 ;;<Actor>95019 "RTN","C0CCCR0",533,0)95020 ;;<ActorID>@@RESULTSOURCEACTORID@@</ActorID>95021 "RTN","C0CCCR0",534,0)95022 ;;</Actor>95023 "RTN","C0CCCR0",535,0)95024 ;;</Source>95025 "RTN","C0CCCR0",536,0)95026 ;;<Test>95027 "RTN","C0CCCR0",537,0)95028 ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>95029 "RTN","C0CCCR0",538,0)95030 ;;<DateTime>95031 "RTN","C0CCCR0",539,0)95032 ;;<Type>95033 "RTN","C0CCCR0",540,0)95034 ;;<Text>Assessment Time</Text>95035 "RTN","C0CCCR0",541,0)95036 ;;</Type>95037 "RTN","C0CCCR0",542,0)95038 ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>95039 "RTN","C0CCCR0",543,0)95040 ;;</DateTime>95041 "RTN","C0CCCR0",544,0)95042 ;;<Description>95043 "RTN","C0CCCR0",545,0)95044 ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>95045 "RTN","C0CCCR0",546,0)95046 ;;<Code>95047 "RTN","C0CCCR0",547,0)95048 ;;<Value>@@RESULTTESTCODEVALUE@@</Value>95049 "RTN","C0CCCR0",548,0)95050 ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>95051 "RTN","C0CCCR0",549,0)95052 ;;</Code>95053 "RTN","C0CCCR0",550,0)95054 ;;</Description>95055 "RTN","C0CCCR0",551,0)95056 ;;<Status>95057 "RTN","C0CCCR0",552,0)95058 ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>95059 "RTN","C0CCCR0",553,0)95060 ;;</Status>95061 "RTN","C0CCCR0",554,0)95062 ;;<Source>95063 "RTN","C0CCCR0",555,0)95064 ;;<Actor>95065 "RTN","C0CCCR0",556,0)95066 ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>95067 "RTN","C0CCCR0",557,0)95068 ;;</Actor>95069 "RTN","C0CCCR0",558,0)95070 ;;</Source>95071 "RTN","C0CCCR0",559,0)95072 ;;<TestResult>95073 "RTN","C0CCCR0",560,0)95074 ;;<Value>@@RESULTTESTVALUE@@</Value>95075 "RTN","C0CCCR0",561,0)95076 ;;<Units>95077 "RTN","C0CCCR0",562,0)95078 ;;<Unit>@@RESULTTESTUNITS@@</Unit>95079 "RTN","C0CCCR0",563,0)95080 ;;</Units>95081 "RTN","C0CCCR0",564,0)95082 ;;</TestResult>95083 "RTN","C0CCCR0",565,0)95084 ;;<NormalResult>95085 "RTN","C0CCCR0",566,0)95086 ;;<Normal>95087 "RTN","C0CCCR0",567,0)95088 ;;<Description>95089 "RTN","C0CCCR0",568,0)95090 ;;<Text>@@RESULTTESTNORMALDESCTEXT@@</Text>95091 "RTN","C0CCCR0",569,0)95092 ;;</Description>95093 "RTN","C0CCCR0",570,0)95094 ;;<Source>95095 "RTN","C0CCCR0",571,0)95096 ;;<Actor>95097 "RTN","C0CCCR0",572,0)95098 ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>95099 "RTN","C0CCCR0",573,0)95100 ;;</Actor>95101 "RTN","C0CCCR0",574,0)95102 ;;</Source>95103 "RTN","C0CCCR0",575,0)95104 ;;</Normal>95105 "RTN","C0CCCR0",576,0)95106 ;;</NormalResult>95107 "RTN","C0CCCR0",577,0)95108 ;;<Flag>95109 "RTN","C0CCCR0",578,0)95110 ;;<Text>@@RESULTTESTFLAG@@</Text>95111 "RTN","C0CCCR0",579,0)95112 ;;</Flag>95113 "RTN","C0CCCR0",580,0)95114 ;;</Test>95115 "RTN","C0CCCR0",581,0)95116 ;;</Result>95117 "RTN","C0CCCR0",582,0)95118 ;;</Results>95119 "RTN","C0CCCR0",583,0)95120 ;;<Procedures>95121 "RTN","C0CCCR0",584,0)95122 ;;<Procedure>95123 "RTN","C0CCCR0",585,0)95124 ;;<CCRDataObjectID>@@PROCOBJECTID@@</CCRDataObjectID>95125 "RTN","C0CCCR0",586,0)95126 ;;<DateTime>95127 "RTN","C0CCCR0",587,0)95128 ;;<Type>95129 "RTN","C0CCCR0",588,0)95130 ;;<Text>@@PROCDATETEXT@@</Text>95131 "RTN","C0CCCR0",589,0)95132 ;;</Type>95133 "RTN","C0CCCR0",590,0)95134 ;;<ExactDateTime>@@PROCDATETIME@@</ExactDateTime>95135 "RTN","C0CCCR0",591,0)95136 ;;</DateTime>95137 "RTN","C0CCCR0",592,0)95138 ;;<Description>95139 "RTN","C0CCCR0",593,0)95140 ;;<Text>@@PROCDESCTEXT@@</Text>95141 "RTN","C0CCCR0",594,0)95142 ;;<ObjectAttribute>95143 "RTN","C0CCCR0",595,0)95144 ;;<Attribute>@@PROCDESCOBJATTR@@</Attribute>95145 "RTN","C0CCCR0",596,0)95146 ;;<AttributeValue>95147 "RTN","C0CCCR0",597,0)95148 ;;<Value>@@PROCDESCOBJATTRVAL@@</Value>95149 "RTN","C0CCCR0",598,0)95150 ;;<Code>95151 "RTN","C0CCCR0",599,0)95152 ;;<Value>@@PROCDESCOBJATTRCODE@@</Value>95153 "RTN","C0CCCR0",600,0)95154 ;;<CodingSystem>@@PROCDESCOBJATTRCODESYS@@</CodingSystem>95155 "RTN","C0CCCR0",601,0)95156 ;;</Code>95157 "RTN","C0CCCR0",602,0)95158 ;;</AttributeValue>95159 "RTN","C0CCCR0",603,0)95160 ;;</ObjectAttribute>95161 "RTN","C0CCCR0",604,0)95162 ;;<Code>95163 "RTN","C0CCCR0",605,0)95164 ;;<Value>@@PROCCODE@@</Value>95165 "RTN","C0CCCR0",606,0)95166 ;;<CodingSystem>@@PROCCODESYS@@</CodingSystem>95167 "RTN","C0CCCR0",607,0)95168 ;;</Code>95169 "RTN","C0CCCR0",608,0)95170 ;;</Description>95171 "RTN","C0CCCR0",609,0)95172 ;;<Status>95173 "RTN","C0CCCR0",610,0)95174 ;;<Text>@@PROCSTATUS@@</Text>95175 "RTN","C0CCCR0",611,0)95176 ;;</Status>95177 "RTN","C0CCCR0",612,0)95178 ;;<Source>95179 "RTN","C0CCCR0",613,0)95180 ;;<Actor>95181 "RTN","C0CCCR0",614,0)95182 ;;<ActorID>@@PROCACTOROBJID@@</ActorID>95183 "RTN","C0CCCR0",615,0)95184 ;;</Actor>95185 "RTN","C0CCCR0",616,0)95186 ;;</Source>95187 "RTN","C0CCCR0",617,0)95188 ;;<InternalCCRLink>95189 "RTN","C0CCCR0",618,0)95190 ;;<LinkID>@@PROCLINKID@@</LinkID>95191 "RTN","C0CCCR0",619,0)95192 ;;<LinkRelationship>@@PROCLINKREL@@</LinkRelationship>95193 "RTN","C0CCCR0",620,0)95194 ;;</InternalCCRLink>95195 "RTN","C0CCCR0",621,0)95196 ;;</Procedure>95197 "RTN","C0CCCR0",622,0)95198 ;;</Procedures>95199 "RTN","C0CCCR0",623,0)95200 ;;<Encounters>95201 "RTN","C0CCCR0",624,0)95202 ;;<Encounter>95203 "RTN","C0CCCR0",625,0)95204 ;;<CCRDataObjectID>@@ENCOBJECTID@@</CCRDataObjectID>95205 "RTN","C0CCCR0",626,0)95206 ;;<DateTime>95207 "RTN","C0CCCR0",627,0)95208 ;;<ExactDateTime>@@ENCDATETIME@@</ExactDateTime>95209 "RTN","C0CCCR0",628,0)95210 ;;</DateTime>95211 "RTN","C0CCCR0",629,0)95212 ;;<Type>95213 "RTN","C0CCCR0",630,0)95214 ;;<Text>@@ENCTYPETXT@@</Text>95215 "RTN","C0CCCR0",631,0)95216 ;;<Code>95217 "RTN","C0CCCR0",632,0)95218 ;;<Value>@@ENCTYPECODE@@</Value>95219 "RTN","C0CCCR0",633,0)95220 ;;<CodingSystem>@@ENCTYPECODESYS@@</CodingSystem>95221 "RTN","C0CCCR0",634,0)95222 ;;</Code>95223 "RTN","C0CCCR0",635,0)95224 ;;</Type>95225 "RTN","C0CCCR0",636,0)95226 ;;<Description>95227 "RTN","C0CCCR0",637,0)95228 ;;<Text>@@ENCDESCTXT@@</Text>95229 "RTN","C0CCCR0",638,0)95230 ;;<Code>95231 "RTN","C0CCCR0",639,0)95232 ;;<Value>@@ENCDESCCODE@@</Value>95233 "RTN","C0CCCR0",640,0)95234 ;;<CodingSystem>@@ENCDESCCODESYS@@</CodingSystem>95235 "RTN","C0CCCR0",641,0)95236 ;;</Code>95237 "RTN","C0CCCR0",642,0)95238 ;;</Description>95239 "RTN","C0CCCR0",643,0)95240 ;;<Location>95241 "RTN","C0CCCR0",644,0)95242 ;;<Actor>95243 "RTN","C0CCCR0",645,0)95244 ;;<ActorID>@@ENCLOCACTORID@@</ActorID>95245 "RTN","C0CCCR0",646,0)95246 ;;</Actor>95247 "RTN","C0CCCR0",647,0)95248 ;;</Location>95249 "RTN","C0CCCR0",648,0)95250 ;;<Practioner>95251 "RTN","C0CCCR0",649,0)95252 ;;<Actor>95253 "RTN","C0CCCR0",650,0)95254 ;;<ActorID>@@ENCPRVACTORID@@</ActorID>95255 "RTN","C0CCCR0",651,0)95256 ;;</Actor>95257 "RTN","C0CCCR0",652,0)95258 ;;</Practioner>95259 "RTN","C0CCCR0",653,0)95260 ;;<Indication>95261 "RTN","C0CCCR0",654,0)95262 ;;<Text>@@ENCINDTXT@@</Text>95263 "RTN","C0CCCR0",655,0)95264 ;;<Code>95265 "RTN","C0CCCR0",656,0)95266 ;;<Value>@@ENCINDCODE@@</Value>95267 "RTN","C0CCCR0",657,0)95268 ;;<CodingSystem>@@ENCINDCODESYS@@</CodingSystem>95269 "RTN","C0CCCR0",658,0)95270 ;;</Code>95271 "RTN","C0CCCR0",659,0)95272 ;;</Indication>95273 "RTN","C0CCCR0",660,0)95274 ;;<Source>95275 "RTN","C0CCCR0",661,0)95276 ;;<Actor>95277 "RTN","C0CCCR0",662,0)95278 ;;<ActorID>@@ENCACTORID@@</ActorID>95279 "RTN","C0CCCR0",663,0)95280 ;;</Actor>95281 "RTN","C0CCCR0",664,0)95282 ;;</Source>95283 "RTN","C0CCCR0",665,0)95284 ;;<CommentID>@@ENCCOMMENTID@@</CommentID>95285 "RTN","C0CCCR0",666,0)95286 ;;</Encounter>95287 "RTN","C0CCCR0",667,0)95288 ;;</Encounters>95289 "RTN","C0CCCR0",668,0)95290 ;;<HealthCareProviders>95291 "RTN","C0CCCR0",669,0)95292 ;;<Provider>95293 "RTN","C0CCCR0",670,0)95294 ;;<ActorID>AA0005</ActorID>95295 "RTN","C0CCCR0",671,0)95296 ;;<ActorRole>95297 "RTN","C0CCCR0",672,0)95298 ;;<Text>Primary Provider</Text>95299 "RTN","C0CCCR0",673,0)95300 ;;</ActorRole>95301 "RTN","C0CCCR0",674,0)95302 ;;</Provider>95303 "RTN","C0CCCR0",675,0)95304 ;;</HealthCareProviders>95305 "RTN","C0CCCR0",676,0)95306 ;;</Body>95307 "RTN","C0CCCR0",677,0)95308 ;;<Actors>95309 "RTN","C0CCCR0",678,0)95310 ;;<ACTOR-PATIENT>95311 "RTN","C0CCCR0",679,0)95312 ;;<Actor>95313 "RTN","C0CCCR0",680,0)95314 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>95315 "RTN","C0CCCR0",681,0)95316 ;;<Person>95317 "RTN","C0CCCR0",682,0)95318 ;;<Name>95319 "RTN","C0CCCR0",683,0)95320 ;;<CurrentName>95321 "RTN","C0CCCR0",684,0)95322 ;;<Given>@@ACTORGIVENNAME@@</Given>95323 "RTN","C0CCCR0",685,0)95324 ;;<Middle>@@ACTORMIDDLENAME@@</Middle>95325 "RTN","C0CCCR0",686,0)95326 ;;<Family>@@ACTORFAMILYNAME@@</Family>95327 "RTN","C0CCCR0",687,0)95328 ;;</CurrentName>95329 "RTN","C0CCCR0",688,0)95330 ;;</Name>95331 "RTN","C0CCCR0",689,0)95332 ;;<DateOfBirth>95333 "RTN","C0CCCR0",690,0)95334 ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime>95335 "RTN","C0CCCR0",691,0)95336 ;;</DateOfBirth>95337 "RTN","C0CCCR0",692,0)95338 ;;<Gender>95339 "RTN","C0CCCR0",693,0)95340 ;;<Text>@@ACTORGENDER@@</Text>95341 "RTN","C0CCCR0",694,0)95342 ;;<Code>95343 "RTN","C0CCCR0",695,0)95344 ;;<Value>@@ACTORGENDERCODE@@</Value>95345 "RTN","C0CCCR0",696,0)95346 ;;<CodingSystem>HL7 AdministrativeGender</CodingSystem>95347 "RTN","C0CCCR0",697,0)95348 ;;</Code>95349 "RTN","C0CCCR0",698,0)95350 ;;</Gender>95351 "RTN","C0CCCR0",699,0)95352 ;;</Person>95353 "RTN","C0CCCR0",700,0)95354 ;;<IDs>95355 "RTN","C0CCCR0",701,0)95356 ;;<Type>95357 "RTN","C0CCCR0",702,0)95358 ;;<Text>@@ACTORSSNTEXT@@</Text>95359 "RTN","C0CCCR0",703,0)95360 ;;</Type>95361 "RTN","C0CCCR0",704,0)95362 ;;<ID>@@ACTORSSN@@</ID>95363 "RTN","C0CCCR0",705,0)95364 ;;<Source>95365 "RTN","C0CCCR0",706,0)95366 ;;<Actor>95367 "RTN","C0CCCR0",707,0)95368 ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID>95369 "RTN","C0CCCR0",708,0)95370 ;;</Actor>95371 "RTN","C0CCCR0",709,0)95372 ;;</Source>95373 "RTN","C0CCCR0",710,0)95374 ;;</IDs>95375 "RTN","C0CCCR0",711,0)95376 ;;<Address>95377 "RTN","C0CCCR0",712,0)95378 ;;<Type>95379 "RTN","C0CCCR0",713,0)95380 ;;<Text>@@ACTORADDRESSTYPE@@</Text>95381 "RTN","C0CCCR0",714,0)95382 ;;</Type>95383 "RTN","C0CCCR0",715,0)95384 ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>95385 "RTN","C0CCCR0",716,0)95386 ;;<Line2>@@ACTORADDRESSLINE2@@</Line2>95387 "RTN","C0CCCR0",717,0)95388 ;;<City>@@ACTORADDRESSCITY@@</City>95389 "RTN","C0CCCR0",718,0)95390 ;;<State>@@ACTORADDRESSSTATE@@</State>95391 "RTN","C0CCCR0",719,0)95392 ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode>95393 "RTN","C0CCCR0",720,0)95394 ;;</Address>95395 "RTN","C0CCCR0",721,0)95396 ;;<Telephone>95397 "RTN","C0CCCR0",722,0)95398 ;;<Value>@@ACTORRESTEL@@</Value>95399 "RTN","C0CCCR0",723,0)95400 ;;<Type>95401 "RTN","C0CCCR0",724,0)95402 ;;<Text>@@ACTORRESTELTEXT@@</Text>95403 "RTN","C0CCCR0",725,0)95404 ;;</Type>95405 "RTN","C0CCCR0",726,0)95406 ;;</Telephone>95407 "RTN","C0CCCR0",727,0)95408 ;;<Telephone>95409 "RTN","C0CCCR0",728,0)95410 ;;<Value>@@ACTORWORKTEL@@</Value>95411 "RTN","C0CCCR0",729,0)95412 ;;<Type>95413 "RTN","C0CCCR0",730,0)95414 ;;<Text>@@ACTORWORKTELTEXT@@</Text>95415 "RTN","C0CCCR0",731,0)95416 ;;</Type>95417 "RTN","C0CCCR0",732,0)95418 ;;</Telephone>95419 "RTN","C0CCCR0",733,0)95420 ;;<Telephone>95421 "RTN","C0CCCR0",734,0)95422 ;;<Value>@@ACTORCELLTEL@@</Value>95423 "RTN","C0CCCR0",735,0)95424 ;;<Type>95425 "RTN","C0CCCR0",736,0)95426 ;;<Text>@@ACTORCELLTELTEXT@@</Text>95427 "RTN","C0CCCR0",737,0)95428 ;;</Type>95429 "RTN","C0CCCR0",738,0)95430 ;;</Telephone>95431 "RTN","C0CCCR0",739,0)95432 ;;<EMail>95433 "RTN","C0CCCR0",740,0)95434 ;;<Value>@@ACTOREMAIL@@</Value>95435 "RTN","C0CCCR0",741,0)95436 ;;</EMail>95437 "RTN","C0CCCR0",742,0)95438 ;;<Source>95439 "RTN","C0CCCR0",743,0)95440 ;;<Actor>95441 "RTN","C0CCCR0",744,0)95442 ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID>95443 "RTN","C0CCCR0",745,0)95444 ;;</Actor>95445 "RTN","C0CCCR0",746,0)95446 ;;</Source>95447 "RTN","C0CCCR0",747,0)95448 ;;</Actor>95449 "RTN","C0CCCR0",748,0)95450 ;;</ACTOR-PATIENT>95451 "RTN","C0CCCR0",749,0)95452 ;;<ACTOR-SYSTEM>95453 "RTN","C0CCCR0",750,0)95454 ;;<Actor>95455 "RTN","C0CCCR0",751,0)95456 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>95457 "RTN","C0CCCR0",752,0)95458 ;;<InformationSystem>95459 "RTN","C0CCCR0",753,0)95460 ;;<Name>@@ACTORINFOSYSNAME@@</Name>95461 "RTN","C0CCCR0",754,0)95462 ;;<Version>@@ACTORINFOSYSVER@@</Version>95463 "RTN","C0CCCR0",755,0)95464 ;;</InformationSystem>95465 "RTN","C0CCCR0",756,0)95466 ;;<Source>95467 "RTN","C0CCCR0",757,0)95468 ;;<Actor>95469 "RTN","C0CCCR0",758,0)95470 ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID>95471 "RTN","C0CCCR0",759,0)95472 ;;</Actor>95473 "RTN","C0CCCR0",760,0)95474 ;;</Source>95475 "RTN","C0CCCR0",761,0)95476 ;;</Actor>95477 "RTN","C0CCCR0",762,0)95478 ;;</ACTOR-SYSTEM>95479 "RTN","C0CCCR0",763,0)95480 ;;<ACTOR-NOK>95481 "RTN","C0CCCR0",764,0)95482 ;;<Actor>95483 "RTN","C0CCCR0",765,0)95484 ;;<ActorObjectID>AA0003</ActorObjectID>95485 "RTN","C0CCCR0",766,0)95486 ;;<Person>95487 "RTN","C0CCCR0",767,0)95488 ;;<Name>95489 "RTN","C0CCCR0",768,0)95490 ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName>95491 "RTN","C0CCCR0",769,0)95492 ;;</Name>95493 "RTN","C0CCCR0",770,0)95494 ;;</Person>95495 "RTN","C0CCCR0",771,0)95496 ;;<Relation>95497 "RTN","C0CCCR0",772,0)95498 ;;<Text>@@ACTORRELATION@@</Text>95499 "RTN","C0CCCR0",773,0)95500 ;;</Relation>95501 "RTN","C0CCCR0",774,0)95502 ;;<Source>95503 "RTN","C0CCCR0",775,0)95504 ;;<Actor>95505 "RTN","C0CCCR0",776,0)95506 ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID>95507 "RTN","C0CCCR0",777,0)95508 ;;</Actor>95509 "RTN","C0CCCR0",778,0)95510 ;;</Source>95511 "RTN","C0CCCR0",779,0)95512 ;;</Actor>95513 "RTN","C0CCCR0",780,0)95514 ;;</ACTOR-NOK>95515 "RTN","C0CCCR0",781,0)95516 ;;<ACTOR-PROVIDER>95517 "RTN","C0CCCR0",782,0)95518 ;;<Actor>95519 "RTN","C0CCCR0",783,0)95520 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>95521 "RTN","C0CCCR0",784,0)95522 ;;<Person>95523 "RTN","C0CCCR0",785,0)95524 ;;<Name>95525 "RTN","C0CCCR0",786,0)95526 ;;<CurrentName>95527 "RTN","C0CCCR0",787,0)95528 ;;<Given>@@ACTORGIVENNAME@@</Given>95529 "RTN","C0CCCR0",788,0)95530 ;;<Middle>@@ACTORMIDDLENAME@@</Middle>95531 "RTN","C0CCCR0",789,0)95532 ;;<Family>@@ACTORFAMILYNAME@@</Family>95533 "RTN","C0CCCR0",790,0)95534 ;;<Title>@@ACTORTITLE@@</Title>95535 "RTN","C0CCCR0",791,0)95536 ;;</CurrentName>95537 "RTN","C0CCCR0",792,0)95538 ;;</Name>95539 "RTN","C0CCCR0",793,0)95540 ;;</Person>95541 "RTN","C0CCCR0",794,0)95542 ;;<Specialty>95543 "RTN","C0CCCR0",795,0)95544 ;;<Text>@@ACTORSPECIALITY@@</Text>95545 "RTN","C0CCCR0",796,0)95546 ;;</Specialty>95547 "RTN","C0CCCR0",797,0)95548 ;;<Address>95549 "RTN","C0CCCR0",798,0)95550 ;;<Type>95551 "RTN","C0CCCR0",799,0)95552 ;;<Text>@@ACTORADDRESSTYPE@@</Text>95553 "RTN","C0CCCR0",800,0)95554 ;;</Type>95555 "RTN","C0CCCR0",801,0)95556 ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>95557 "RTN","C0CCCR0",802,0)95558 ;;<City>@@ACTORADDRESSCITY@@</City>95559 "RTN","C0CCCR0",803,0)95560 ;;<State>@@ACTORADDRESSSTATE@@</State>95561 "RTN","C0CCCR0",804,0)95562 ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>95563 "RTN","C0CCCR0",805,0)95564 ;;</Address>95565 "RTN","C0CCCR0",806,0)95566 ;;<Telephone>95567 "RTN","C0CCCR0",807,0)95568 ;;<Value>@@ACTORTELEPHONE@@</Value>95569 "RTN","C0CCCR0",808,0)95570 ;;<Type>95571 "RTN","C0CCCR0",809,0)95572 ;;<Text>@@ACTORTELEPHONETYPE@@</Text>95573 "RTN","C0CCCR0",810,0)95574 ;;</Type>95575 "RTN","C0CCCR0",811,0)95576 ;;</Telephone>95577 "RTN","C0CCCR0",812,0)95578 ;;<Email>95579 "RTN","C0CCCR0",813,0)95580 ;;<Value>@@ACTOREMAIL@@</Value>95581 "RTN","C0CCCR0",814,0)95582 ;;</Email>95583 "RTN","C0CCCR0",815,0)95584 ;;<Source>95585 "RTN","C0CCCR0",816,0)95586 ;;<Actor>95587 "RTN","C0CCCR0",817,0)95588 ;;<ActorID>@@ACTORSOURCEID@@</ActorID>95589 "RTN","C0CCCR0",818,0)95590 ;;</Actor>95591 "RTN","C0CCCR0",819,0)95592 ;;</Source>95593 "RTN","C0CCCR0",820,0)95594 ;;<InternalCCRLink>95595 "RTN","C0CCCR0",821,0)95596 ;;<LinkID>@@ACTORORGLINK@@</LinkID>95597 "RTN","C0CCCR0",822,0)95598 ;;<LinkRelationship>representedOrganization</LinkRelationship>95599 "RTN","C0CCCR0",823,0)95600 ;;</InternalCCRLink>95601 "RTN","C0CCCR0",824,0)95602 ;;</Actor>95603 "RTN","C0CCCR0",825,0)95604 ;;</ACTOR-PROVIDER>95605 "RTN","C0CCCR0",826,0)95606 ;;<ACTOR-ORG>95607 "RTN","C0CCCR0",827,0)95608 ;;<Actor>95609 "RTN","C0CCCR0",828,0)95610 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>95611 "RTN","C0CCCR0",829,0)95612 ;;<Organization>95613 "RTN","C0CCCR0",830,0)95614 ;;<Name>@@ORGANIZATIONNAME@@</Name>95615 "RTN","C0CCCR0",831,0)95616 ;;</Organization>95617 "RTN","C0CCCR0",832,0)95618 ;;<Address>95619 "RTN","C0CCCR0",833,0)95620 ;;<Type>95621 "RTN","C0CCCR0",834,0)95622 ;;<Text>@@ACTORADDRESSTYPE@@</Text>95623 "RTN","C0CCCR0",835,0)95624 ;;</Type>95625 "RTN","C0CCCR0",836,0)95626 ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>95627 "RTN","C0CCCR0",837,0)95628 ;;<City>@@ACTORADDRESSCITY@@</City>95629 "RTN","C0CCCR0",838,0)95630 ;;<State>@@ACTORADDRESSSTATE@@</State>95631 "RTN","C0CCCR0",839,0)95632 ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>95633 "RTN","C0CCCR0",840,0)95634 ;;</Address>95635 "RTN","C0CCCR0",841,0)95636 ;;<Telephone>95637 "RTN","C0CCCR0",842,0)95638 ;;<Value>@@ACTORTELEPHONE@@</Value>95639 "RTN","C0CCCR0",843,0)95640 ;;<Type>95641 "RTN","C0CCCR0",844,0)95642 ;;<Text>@@ACTORTELEPHONETYPE@@</Text>95643 "RTN","C0CCCR0",845,0)95644 ;;</Type>95645 "RTN","C0CCCR0",846,0)95646 ;;</Telephone>95647 "RTN","C0CCCR0",847,0)95648 ;;<Source>95649 "RTN","C0CCCR0",848,0)95650 ;;<Actor>95651 "RTN","C0CCCR0",849,0)95652 ;;<ActorID>@@ACTORSOURCEID@@</ActorID>95653 "RTN","C0CCCR0",850,0)95654 ;;</Actor>95655 "RTN","C0CCCR0",851,0)95656 ;;</Source>95657 "RTN","C0CCCR0",852,0)95658 ;;</Actor>95659 "RTN","C0CCCR0",853,0)95660 ;;</ACTOR-ORG>95661 "RTN","C0CCCR0",854,0)95662 ;;</Actors>95663 "RTN","C0CCCR0",855,0)95664 ;;<Signatures>95665 "RTN","C0CCCR0",856,0)95666 ;;<CCRSignature>95667 "RTN","C0CCCR0",857,0)95668 ;;<SignatureObjectID>S0001</SignatureObjectID>95669 "RTN","C0CCCR0",858,0)95670 ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>95671 "RTN","C0CCCR0",859,0)95672 ;;<Source>95673 "RTN","C0CCCR0",860,0)95674 ;;<ActorID>AA0001</ActorID>95675 "RTN","C0CCCR0",861,0)95676 ;;</Source>95677 "RTN","C0CCCR0",862,0)95678 ;;<Signature>95679 "RTN","C0CCCR0",863,0)95680 ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">95681 "RTN","C0CCCR0",864,0)95682 ;;<SignedInfo>95683 "RTN","C0CCCR0",865,0)95684 ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>95685 "RTN","C0CCCR0",866,0)95686 ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>95687 "RTN","C0CCCR0",867,0)95688 ;;<Reference URI="">95689 "RTN","C0CCCR0",868,0)95690 ;;<Transforms>95691 "RTN","C0CCCR0",869,0)95692 ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>95693 "RTN","C0CCCR0",870,0)95694 ;;</Transforms>95695 "RTN","C0CCCR0",871,0)95696 ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>95697 "RTN","C0CCCR0",872,0)95698 ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>95699 "RTN","C0CCCR0",873,0)95700 ;;</Reference>95701 "RTN","C0CCCR0",874,0)95702 ;;</SignedInfo>95703 "RTN","C0CCCR0",875,0)95704 ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>95705 "RTN","C0CCCR0",876,0)95706 ;;<KeyInfo>95707 "RTN","C0CCCR0",877,0)95708 ;;<KeyValue>95709 "RTN","C0CCCR0",878,0)95710 ;;<RSAKeyValue>95711 "RTN","C0CCCR0",879,0)95712 ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>95713 "RTN","C0CCCR0",880,0)95714 ;;<Exponent>AQAB</Exponent>95715 "RTN","C0CCCR0",881,0)95716 ;;</RSAKeyValue>95717 "RTN","C0CCCR0",882,0)95718 ;;</KeyValue>95719 "RTN","C0CCCR0",883,0)95720 ;;</KeyInfo>95721 "RTN","C0CCCR0",884,0)95722 ;;</Signature>95723 "RTN","C0CCCR0",885,0)95724 ;;</Signature>95725 "RTN","C0CCCR0",886,0)95726 ;;</CCRSignature>95727 "RTN","C0CCCR0",887,0)95728 ;;</Signatures>95729 "RTN","C0CCCR0",888,0)95730 ;;<Comments>95731 "RTN","C0CCCR0",889,0)95732 ;;<Comment>95733 "RTN","C0CCCR0",890,0)95734 ;;<CommentObjectID>@@COMMENTOBJECTID@@</CommentObjectID>95735 "RTN","C0CCCR0",891,0)95736 ;;<DateTime>95737 "RTN","C0CCCR0",892,0)95738 ;;<ExactDateTime>@@CMTDATETIME@@</ExactDateTime>95739 "RTN","C0CCCR0",893,0)95740 ;;</DateTime>95741 "RTN","C0CCCR0",894,0)95742 ;;<Description>95743 "RTN","C0CCCR0",895,0)95744 ;;<Text>95745 "RTN","C0CCCR0",896,0)95746 ;;</Text>95747 "RTN","C0CCCR0",897,0)95748 ;;</Description>95749 "RTN","C0CCCR0",898,0)95750 ;;<Source>95751 "RTN","C0CCCR0",899,0)95752 ;;<Actor>95753 95727 "RTN","C0CCCR0",900,0) 95754 ;;< ActorID>@@ACTORSOURCEID@@</ActorID>95728 ;;</Comment> 95755 95729 "RTN","C0CCCR0",901,0) 95756 ;;</ Actor>95730 ;;</Comments> 95757 95731 "RTN","C0CCCR0",902,0) 95758 ;;</ Source>95732 ;;</ContinuityOfCareRecord> 95759 95733 "RTN","C0CCCR0",903,0) 95760 ;;</Comment>95761 "RTN","C0CCCR0",904,0)95762 ;;</Comments>95763 "RTN","C0CCCR0",905,0)95764 ;;</ContinuityOfCareRecord>95765 "RTN","C0CCCR0",906,0)95766 95734 ;</TEMPLATE> 95767 95735 "RTN","C0CCMT") 95768 0^71^B6 74070195736 0^71^B6559679 95769 95737 "RTN","C0CCMT",1,0) 95770 95738 C0CCMT ; CCDCCR/GPL - CCR/CCD PROCESSING FOR COMMENTS ; 05/21/10 95771 95739 "RTN","C0CCMT",2,0) 95772 ;;1.2;C 0C;;May 11, 2012;Build 5095740 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 95773 95741 "RTN","C0CCMT",3,0) 95774 95742 ;Copyright 2010 George Lilly, University of Minnesota and others. 95775 95743 "RTN","C0CCMT",4,0) 95776 ; Licensed under the terms of the GNU General Public License.95744 ; 95777 95745 "RTN","C0CCMT",5,0) 95778 ; See attached copy of the License.95746 ; This program is free software: you can redistribute it and/or modify 95779 95747 "RTN","C0CCMT",6,0) 95780 ; 95748 ; it under the terms of the GNU Affero General Public License as 95781 95749 "RTN","C0CCMT",7,0) 95782 ; This program is free software; you can redistribute it and/or modify95750 ; published by the Free Software Foundation, either version 3 of the 95783 95751 "RTN","C0CCMT",8,0) 95784 ; it under the terms of the GNU General Public License as published by95752 ; License, or (at your option) any later version. 95785 95753 "RTN","C0CCMT",9,0) 95786 ; the Free Software Foundation; either version 2 of the License, or95754 ; 95787 95755 "RTN","C0CCMT",10,0) 95788 ; (at your option) any later version.95756 ; This program is distributed in the hope that it will be useful, 95789 95757 "RTN","C0CCMT",11,0) 95790 ; 95758 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 95791 95759 "RTN","C0CCMT",12,0) 95792 ; This program is distributed in the hope that it will be useful,95760 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 95793 95761 "RTN","C0CCMT",13,0) 95794 ; but WITHOUT ANY WARRANTY; without even the implied warranty of95762 ; GNU Affero General Public License for more details. 95795 95763 "RTN","C0CCMT",14,0) 95796 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the95764 ; 95797 95765 "RTN","C0CCMT",15,0) 95798 ; GNU General Public License for more details.95766 ; You should have received a copy of the GNU Affero General Public License 95799 95767 "RTN","C0CCMT",16,0) 95800 ; 95768 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 95801 95769 "RTN","C0CCMT",17,0) 95802 ; You should have received a copy of the GNU General Public License along95770 ; 95803 95771 "RTN","C0CCMT",18,0) 95804 ; with this program; if not, write to the Free Software Foundation, Inc.,95772 ; 95805 95773 "RTN","C0CCMT",19,0) 95806 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.95774 W "NO ENTRY FROM TOP",! 95807 95775 "RTN","C0CCMT",20,0) 95808 ;95776 Q 95809 95777 "RTN","C0CCMT",21,0) 95810 W "NO ENTRY FROM TOP",!95778 ; 95811 95779 "RTN","C0CCMT",22,0) 95780 EXTRACT(NOTEXML,DFN,NOTEOUT) ; EXTRACT NOTES INTO XML TEMPLATE 95781 "RTN","C0CCMT",23,0) 95782 ; NOTEXML AND NOTEOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED 95783 "RTN","C0CCMT",24,0) 95784 ; 95785 "RTN","C0CCMT",25,0) 95786 D SETVARS^C0CPROC ; SET UP VARIABLES FOR PROCEDUCRES, ENCOUNTERS, AND NOTES 95787 "RTN","C0CCMT",26,0) 95788 ;I '$D(@C0CNTE) Q ; NO NOTES AVAILABLE 95789 "RTN","C0CCMT",27,0) 95790 D MAP(NOTEXML,C0CNTE,NOTEOUT) ;MAP RESULTS FOR NOTES 95791 "RTN","C0CCMT",28,0) 95812 95792 Q 95813 "RTN","C0CCMT",23,0)95814 ;95815 "RTN","C0CCMT",24,0)95816 EXTRACT(NOTEXML,DFN,NOTEOUT) ; EXTRACT NOTES INTO XML TEMPLATE95817 "RTN","C0CCMT",25,0)95818 ; NOTEXML AND NOTEOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED95819 "RTN","C0CCMT",26,0)95820 ;95821 "RTN","C0CCMT",27,0)95822 D SETVARS^C0CPROC ; SET UP VARIABLES FOR PROCEDUCRES, ENCOUNTERS, AND NOTES95823 "RTN","C0CCMT",28,0)95824 ;I '$D(@C0CNTE) Q ; NO NOTES AVAILABLE95825 95793 "RTN","C0CCMT",29,0) 95826 D MAP(NOTEXML,C0CNTE,NOTEOUT) ;MAP RESULTS FOR NOTES95794 ; 95827 95795 "RTN","C0CCMT",30,0) 95796 MAP(NOTEXML,C0CNTE,NOTEOUT) ; MAP PROCEDURES XML 95797 "RTN","C0CCMT",31,0) 95798 ; 95799 "RTN","C0CCMT",32,0) 95800 N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"NOTETEMP")) ;WORK AREA FOR TEMPLATE 95801 "RTN","C0CCMT",33,0) 95802 K @ZTEMP 95803 "RTN","C0CCMT",34,0) 95804 N ZBLD 95805 "RTN","C0CCMT",35,0) 95806 S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"NOTEBLD")) ; BUILD LIST AREA 95807 "RTN","C0CCMT",36,0) 95808 D QUEUE^C0CXPATH(ZBLD,NOTEXML,1,1) ; FIRST LINE 95809 "RTN","C0CCMT",37,0) 95810 N ZINNER 95811 "RTN","C0CCMT",38,0) 95812 D QUERY^C0CXPATH(NOTEXML,"//Comments/Comment","ZINNER") ;ONE NOTE 95813 "RTN","C0CCMT",39,0) 95814 N ZTMP,ZVAR,ZI 95815 "RTN","C0CCMT",40,0) 95816 S ZI="" 95817 "RTN","C0CCMT",41,0) 95818 F S ZI=$O(@C0CNTE@(ZI)) Q:ZI="" D ;FOR EACH NOTE 95819 "RTN","C0CCMT",42,0) 95820 . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS NOTE XML 95821 "RTN","C0CCMT",43,0) 95822 . S ZVAR=$NA(@C0CNTE@(ZI)) ;THIS NOTE VARIABLES 95823 "RTN","C0CCMT",44,0) 95824 . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE 95825 "RTN","C0CCMT",45,0) 95826 . N ZNOTE,ZN 95827 "RTN","C0CCMT",46,0) 95828 . D CLEAN($NA(@C0CNTE@(ZI,"TEXT"))) ;REMOVE CONTROL CHARS AND XML RESERVED 95829 "RTN","C0CCMT",47,0) 95830 . M ZNOTE=@C0CNTE@(ZI,"TEXT") ;THE NOTE TO ADD TO THE BUILD 95831 "RTN","C0CCMT",48,0) 95832 . S ZNOTE(0)=$O(ZNOTE(""),-1) ;LENGTH OF THE NOTE 95833 "RTN","C0CCMT",49,0) 95834 . D INSERT^C0CXPATH(ZTMP,"ZNOTE","//Comment/Description/Text") 95835 "RTN","C0CCMT",50,0) 95836 . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD 95837 "RTN","C0CCMT",51,0) 95838 D QUEUE^C0CXPATH(ZBLD,NOTEXML,@NOTEXML@(0),@NOTEXML@(0)) 95839 "RTN","C0CCMT",52,0) 95840 N ZZTMP 95841 "RTN","C0CCMT",53,0) 95842 D BUILD^C0CXPATH(ZBLD,NOTEOUT) ;BUILD FINAL XML 95843 "RTN","C0CCMT",54,0) 95844 K @ZTEMP,@ZBLD,@C0CNTE 95845 "RTN","C0CCMT",55,0) 95828 95846 Q 95829 "RTN","C0CCMT",31,0)95830 ;95831 "RTN","C0CCMT",32,0)95832 MAP(NOTEXML,C0CNTE,NOTEOUT) ; MAP PROCEDURES XML95833 "RTN","C0CCMT",33,0)95834 ;95835 "RTN","C0CCMT",34,0)95836 N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"NOTETEMP")) ;WORK AREA FOR TEMPLATE95837 "RTN","C0CCMT",35,0)95838 K @ZTEMP95839 "RTN","C0CCMT",36,0)95840 N ZBLD95841 "RTN","C0CCMT",37,0)95842 S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"NOTEBLD")) ; BUILD LIST AREA95843 "RTN","C0CCMT",38,0)95844 D QUEUE^C0CXPATH(ZBLD,NOTEXML,1,1) ; FIRST LINE95845 "RTN","C0CCMT",39,0)95846 N ZINNER95847 "RTN","C0CCMT",40,0)95848 D QUERY^C0CXPATH(NOTEXML,"//Comments/Comment","ZINNER") ;ONE NOTE95849 "RTN","C0CCMT",41,0)95850 N ZTMP,ZVAR,ZI95851 "RTN","C0CCMT",42,0)95852 S ZI=""95853 "RTN","C0CCMT",43,0)95854 F S ZI=$O(@C0CNTE@(ZI)) Q:ZI="" D ;FOR EACH NOTE95855 "RTN","C0CCMT",44,0)95856 . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS NOTE XML95857 "RTN","C0CCMT",45,0)95858 . S ZVAR=$NA(@C0CNTE@(ZI)) ;THIS NOTE VARIABLES95859 "RTN","C0CCMT",46,0)95860 . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE95861 "RTN","C0CCMT",47,0)95862 . N ZNOTE,ZN95863 "RTN","C0CCMT",48,0)95864 . D CLEAN($NA(@C0CNTE@(ZI,"TEXT"))) ;REMOVE CONTROL CHARS AND XML RESERVED95865 "RTN","C0CCMT",49,0)95866 . M ZNOTE=@C0CNTE@(ZI,"TEXT") ;THE NOTE TO ADD TO THE BUILD95867 "RTN","C0CCMT",50,0)95868 . S ZNOTE(0)=$O(ZNOTE(""),-1) ;LENGTH OF THE NOTE95869 "RTN","C0CCMT",51,0)95870 . D INSERT^C0CXPATH(ZTMP,"ZNOTE","//Comment/Description/Text")95871 "RTN","C0CCMT",52,0)95872 . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD95873 "RTN","C0CCMT",53,0)95874 D QUEUE^C0CXPATH(ZBLD,NOTEXML,@NOTEXML@(0),@NOTEXML@(0))95875 "RTN","C0CCMT",54,0)95876 N ZZTMP95877 "RTN","C0CCMT",55,0)95878 D BUILD^C0CXPATH(ZBLD,NOTEOUT) ;BUILD FINAL XML95879 95847 "RTN","C0CCMT",56,0) 95880 K @ZTEMP,@ZBLD,@C0CNTE95848 ; 95881 95849 "RTN","C0CCMT",57,0) 95850 CLEAN(INARY) ; INARY IS PASSED BY NAME 95851 "RTN","C0CCMT",58,0) 95852 ; REMOVE CONTROL CHARACTERS AND XML RESERVED SYMBOLS FROM THE ARRAY 95853 "RTN","C0CCMT",59,0) 95854 N ZI,ZJ S ZI="" 95855 "RTN","C0CCMT",60,0) 95856 F S ZI=$O(@INARY@(ZI)) Q:ZI="" D ; 95857 "RTN","C0CCMT",61,0) 95858 . S @INARY@(ZI)=$$CLEAN^C0CXPATH(@INARY@(ZI)) ; CONTROL CHARS 95859 "RTN","C0CCMT",62,0) 95860 . S @INARY@(ZI)=$$SYMENC^MXMLUTL(@INARY@(ZI)) ; XML RESERVED SYMBOLS 95861 "RTN","C0CCMT",63,0) 95882 95862 Q 95883 "RTN","C0CCMT",58,0)95884 ;95885 "RTN","C0CCMT",59,0)95886 CLEAN(INARY) ; INARY IS PASSED BY NAME95887 "RTN","C0CCMT",60,0)95888 ; REMOVE CONTROL CHARACTERS AND XML RESERVED SYMBOLS FROM THE ARRAY95889 "RTN","C0CCMT",61,0)95890 N ZI,ZJ S ZI=""95891 "RTN","C0CCMT",62,0)95892 F S ZI=$O(@INARY@(ZI)) Q:ZI="" D ;95893 "RTN","C0CCMT",63,0)95894 . S @INARY@(ZI)=$$CLEAN^C0CXPATH(@INARY@(ZI)) ; CONTROL CHARS95895 95863 "RTN","C0CCMT",64,0) 95896 . S @INARY@(ZI)=$$SYMENC^MXMLUTL(@INARY@(ZI)) ; XML RESERVED SYMBOLS95897 "RTN","C0CCMT",65,0)95898 Q95899 "RTN","C0CCMT",66,0)95900 95864 ; 95901 95865 "RTN","C0CCPT") 95902 0^68^B1 653153795866 0^68^B17485471 95903 95867 "RTN","C0CCPT",1,0) 95904 95868 C0CCPT ;;BSL;RETURN CPT DATA; 95905 95869 "RTN","C0CCPT",2,0) 95906 ;;1.2;C 0C;;May 11, 2012;Build 5095870 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 95907 95871 "RTN","C0CCPT",3,0) 95908 ; Sequence Managers Software GPL;;;;;Build 295872 ; (C) George Lilly 2010 95909 95873 "RTN","C0CCPT",4,0) 95910 ; Copied into C0C namespace from SQMCPT with permission from95874 ; 95911 95875 "RTN","C0CCPT",5,0) 95912 ; Brian Lord - and with our thanks. gpl 01/20/201095876 ; This program is free software: you can redistribute it and/or modify 95913 95877 "RTN","C0CCPT",6,0) 95878 ; it under the terms of the GNU Affero General Public License as 95879 "RTN","C0CCPT",7,0) 95880 ; published by the Free Software Foundation, either version 3 of the 95881 "RTN","C0CCPT",8,0) 95882 ; License, or (at your option) any later version. 95883 "RTN","C0CCPT",9,0) 95884 ; 95885 "RTN","C0CCPT",10,0) 95886 ; This program is distributed in the hope that it will be useful, 95887 "RTN","C0CCPT",11,0) 95888 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 95889 "RTN","C0CCPT",12,0) 95890 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 95891 "RTN","C0CCPT",13,0) 95892 ; GNU Affero General Public License for more details. 95893 "RTN","C0CCPT",14,0) 95894 ; 95895 "RTN","C0CCPT",15,0) 95896 ; You should have received a copy of the GNU Affero General Public License 95897 "RTN","C0CCPT",16,0) 95898 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 95899 "RTN","C0CCPT",17,0) 95900 ; 95901 "RTN","C0CCPT",18,0) 95914 95902 ENTRY(DFN,STDT,ENDDT,TXT) ;BUILD TOTAL ARRAY OF ALL IEN'S FOR TIU NOTES 95915 "RTN","C0CCPT", 7,0)95903 "RTN","C0CCPT",19,0) 95916 95904 ;DFN=PATIENT IEN 95917 "RTN","C0CCPT", 8,0)95905 "RTN","C0CCPT",20,0) 95918 95906 ;STDT=START DATE IN 3100101 FORMAT (VA YEAR YYYMMDD) 95919 "RTN","C0CCPT", 9,0)95907 "RTN","C0CCPT",21,0) 95920 95908 ;ENDDT=END DATE IN 3100101 FORMAT 95921 "RTN","C0CCPT", 10,0)95909 "RTN","C0CCPT",22,0) 95922 95910 ;TXT=INCLUDE TEXT FROM ENCOUNTER NOTE 95923 "RTN","C0CCPT", 11,0)95911 "RTN","C0CCPT",23,0) 95924 95912 ;THAT FALL INSIDE DATA RANGE. IF NO STDT OR ENDDT ASSUME 95925 "RTN","C0CCPT", 12,0)95926 95927 "RTN","C0CCPT", 13,0)95928 95929 "RTN","C0CCPT", 14,0)95930 95931 "RTN","C0CCPT", 15,0)95932 95933 "RTN","C0CCPT", 16,0)95934 95935 "RTN","C0CCPT", 17,0)95936 95937 "RTN","C0CCPT", 18,0)95938 95939 "RTN","C0CCPT", 19,0)95940 95941 "RTN","C0CCPT", 20,0)95942 95943 "RTN","C0CCPT", 21,0)95944 95945 "RTN","C0CCPT", 22,0)95913 "RTN","C0CCPT",24,0) 95914 ;ALL INCLUSIVE IN THAT DIRECTION 95915 "RTN","C0CCPT",25,0) 95916 ;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN) 95917 "RTN","C0CCPT",26,0) 95918 ;BUILD INTO NOTE(Y)="" 95919 "RTN","C0CCPT",27,0) 95920 S U="^",X="" 95921 "RTN","C0CCPT",28,0) 95922 F S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X="" D 95923 "RTN","C0CCPT",29,0) 95924 . S Y="" 95925 "RTN","C0CCPT",30,0) 95926 . F S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y="" D 95927 "RTN","C0CCPT",31,0) 95928 .. S NOTE(Y)="" 95929 "RTN","C0CCPT",32,0) 95930 ;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE 95931 "RTN","C0CCPT",33,0) 95932 ;GET DATE OF NOTE 95933 "RTN","C0CCPT",34,0) 95946 95934 ;RUT 3120109 Changing DATE in FILMAN's FORMAT 95947 "RTN","C0CCPT", 23,0)95948 ; ;OHUM/RUT 3111228 Date Range for Notes95949 "RTN","C0CCPT", 24,0)95950 95951 "RTN","C0CCPT", 25,0)95935 "RTN","C0CCPT",35,0) 95936 ;OHUM/RUT 3111228 Date Range for Notes 95937 "RTN","C0CCPT",36,0) 95938 ;S STDT=^TMP("C0CCCR","TIULIMIT") D NOW^%DTC S ENDDT=X 95939 "RTN","C0CCPT",37,0) 95952 95940 N FLAGS1,FLAGS2 95953 "RTN","C0CCPT", 26,0)95941 "RTN","C0CCPT",38,0) 95954 95942 S FLAGS1=$P(^C0CPARM(1,2),"^",1) S STDT=$$HTOF^C0CVALID(FLAGS1) 95955 "RTN","C0CCPT", 27,0)95943 "RTN","C0CCPT",39,0) 95956 95944 S FLAGS2=$P(^C0CPARM(1,2),"^",2) S ENDDT=$$HTOF^C0CVALID(FLAGS2) 95957 "RTN","C0CCPT", 28,0)95945 "RTN","C0CCPT",40,0) 95958 95946 ;S STDT=^TMP("C0CCCR","TIULIMIT"),ENDDT=^TMP("C0CCCR","TIUSTART") 95959 "RTN","C0CCPT", 29,0)95960 ;;OHUM/RUT95961 "RTN","C0CCPT", 30,0)95947 "RTN","C0CCPT",41,0) 95948 ;OHUM/RUT 95949 "RTN","C0CCPT",42,0) 95962 95950 ;RUT 95963 "RTN","C0CCPT", 31,0)95964 95965 "RTN","C0CCPT", 32,0)95966 95967 "RTN","C0CCPT", 33,0)95968 95969 "RTN","C0CCPT", 34,0)95970 95971 "RTN","C0CCPT", 35,0)95972 95973 "RTN","C0CCPT", 36,0)95974 95975 "RTN","C0CCPT", 37,0)95976 95977 "RTN","C0CCPT", 38,0)95978 95979 "RTN","C0CCPT", 39,0)95951 "RTN","C0CCPT",43,0) 95952 S Z="" 95953 "RTN","C0CCPT",44,0) 95954 F S Z=$O(NOTE(Z)) Q:Z="" D 95955 "RTN","C0CCPT",45,0) 95956 . S DT=$P(^TIU(8925,Z,0),U,7) 95957 "RTN","C0CCPT",46,0) 95958 . I $G(STDT)]"" D 95959 "RTN","C0CCPT",47,0) 95960 .. I STDT>DT S NOTE(Z)="D" ;SET NOTE TO BE DELETED 95961 "RTN","C0CCPT",48,0) 95962 . I $G(ENDDT)]"" D 95963 "RTN","C0CCPT",49,0) 95964 .. I ENDDT<DT S NOTE(Z)="D" 95965 "RTN","C0CCPT",50,0) 95966 . I NOTE(Z)="D" K NOTE(Z) 95967 "RTN","C0CCPT",51,0) 95980 95968 D VISIT 95981 "RTN","C0CCPT", 40,0)95982 95983 "RTN","C0CCPT", 41,0)95969 "RTN","C0CCPT",52,0) 95970 Q 95971 "RTN","C0CCPT",53,0) 95984 95972 VISIT ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT 95985 "RTN","C0CCPT", 42,0)95973 "RTN","C0CCPT",54,0) 95986 95974 S ILST=1,X0="",X12="",VISIT="",LST="",X811="" 95987 "RTN","C0CCPT", 43,0)95975 "RTN","C0CCPT",55,0) 95988 95976 S IEN="" F S IEN=$O(NOTE(IEN)) Q:IEN="" D 95989 "RTN","C0CCPT", 44,0)95977 "RTN","C0CCPT",56,0) 95990 95978 . S X0=^TIU(8925,IEN,0),X12=$G(^(12)) 95991 "RTN","C0CCPT", 45,0)95979 "RTN","C0CCPT",57,0) 95992 95980 . S VISIT=$P(X12,U,7) 95993 "RTN","C0CCPT", 46,0)95981 "RTN","C0CCPT",58,0) 95994 95982 . I 'VISIT S VISIT=$P(X0,U,3) 95995 "RTN","C0CCPT", 47,0)95983 "RTN","C0CCPT",59,0) 95996 95984 . K ^TMP("PXKENC",$J) 95997 "RTN","C0CCPT", 48,0)95985 "RTN","C0CCPT",60,0) 95998 95986 . Q:VISIT=""!(VISIT'>0) 95999 "RTN","C0CCPT", 49,0)95987 "RTN","C0CCPT",61,0) 96000 95988 . D ENCEVENT^PXKENC(VISIT,1) 96001 "RTN","C0CCPT", 50,0)95989 "RTN","C0CCPT",62,0) 96002 95990 . I '$D(^TMP("PXKENC",$J,VISIT,"VST",VISIT,0)) Q 96003 "RTN","C0CCPT", 51,0)95991 "RTN","C0CCPT",63,0) 96004 95992 . S IPRV=0 F S IPRV=$O(^TMP("PXKENC",$J,VISIT,"PRV",IPRV)) Q:'IPRV D 96005 "RTN","C0CCPT", 52,0)95993 "RTN","C0CCPT",64,0) 96006 95994 .. S X0=^TMP("PXKENC",$J,VISIT,"PRV",IPRV,0) 96007 "RTN","C0CCPT", 53,0)95995 "RTN","C0CCPT",65,0) 96008 95996 .. ;Q:$P(X0,U,4)'="P" 96009 "RTN","C0CCPT", 54,0)95997 "RTN","C0CCPT",66,0) 96010 95998 .. S CODE=$P(X0,U),NARR=$P($G(^VA(200,CODE,0)),U) 96011 "RTN","C0CCPT", 55,0)95999 "RTN","C0CCPT",67,0) 96012 96000 .. S PRIM=($P(X0,U,4)="P") 96013 "RTN","C0CCPT", 56,0)96001 "RTN","C0CCPT",68,0) 96014 96002 .. S ILST=ILST+1 96015 "RTN","C0CCPT", 57,0)96003 "RTN","C0CCPT",69,0) 96016 96004 .. S LST(ILST)="PRV"_U_CODE_"^^^"_NARR_"^"_PRIM 96017 "RTN","C0CCPT", 58,0)96005 "RTN","C0CCPT",70,0) 96018 96006 .. S VISIT(IEN,"PRV",ILST)=CODE_"^^^"_NARR_"^"_PRIM 96019 "RTN","C0CCPT", 59,0)96007 "RTN","C0CCPT",71,0) 96020 96008 . S IPOV=0 F S IPOV=$O(^TMP("PXKENC",$J,VISIT,"POV",IPOV)) Q:'IPOV D 96021 "RTN","C0CCPT", 60,0)96009 "RTN","C0CCPT",72,0) 96022 96010 .. S X0=^TMP("PXKENC",$J,VISIT,"POV",IPOV,0),X802=$G(^(802)),X811=$G(^(811)) 96023 "RTN","C0CCPT", 61,0)96011 "RTN","C0CCPT",73,0) 96024 96012 .. S CODE=$P(X0,U) 96025 "RTN","C0CCPT", 62,0)96013 "RTN","C0CCPT",74,0) 96026 96014 .. S:CODE CODE=$P(^ICD9(CODE,0),U) 96027 "RTN","C0CCPT", 63,0)96015 "RTN","C0CCPT",75,0) 96028 96016 .. S CAT=$P(X802,U) 96029 "RTN","C0CCPT", 64,0)96017 "RTN","C0CCPT",76,0) 96030 96018 .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U) 96031 "RTN","C0CCPT", 65,0)96019 "RTN","C0CCPT",77,0) 96032 96020 .. S NARR=$P(X0,U,4) 96033 "RTN","C0CCPT", 66,0)96021 "RTN","C0CCPT",78,0) 96034 96022 .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U) 96035 "RTN","C0CCPT", 67,0)96023 "RTN","C0CCPT",79,0) 96036 96024 .. S PRIM=($P(X0,U,12)="P") 96037 "RTN","C0CCPT", 68,0)96025 "RTN","C0CCPT",80,0) 96038 96026 .. S PRV=$P(X12,U,4) 96039 "RTN","C0CCPT", 69,0)96027 "RTN","C0CCPT",81,0) 96040 96028 .. S ILST=ILST+1 96041 "RTN","C0CCPT", 70,0)96029 "RTN","C0CCPT",82,0) 96042 96030 .. S LST(ILST)="POV"_U_CODE_U_CAT_U_NARR_U_PRIM_U_PRV 96043 "RTN","C0CCPT", 71,0)96031 "RTN","C0CCPT",83,0) 96044 96032 .. S VISIT(IEN,"POV",ILST)=CODE_U_CAT_U_NARR_U_PRIM_U_PRV 96045 "RTN","C0CCPT", 72,0)96033 "RTN","C0CCPT",84,0) 96046 96034 . S ICPT=0 F S ICPT=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT)) Q:'ICPT D 96047 "RTN","C0CCPT", 73,0)96035 "RTN","C0CCPT",85,0) 96048 96036 .. S X0=^TMP("PXKENC",$J,VISIT,"CPT",ICPT,0),X802=$G(^(802)),X12=$G(^(12)),X811=$G(^(811)) 96049 "RTN","C0CCPT", 74,0)96037 "RTN","C0CCPT",86,0) 96050 96038 .. ;S CODE=$P(X0,U) 96051 "RTN","C0CCPT", 75,0)96039 "RTN","C0CCPT",87,0) 96052 96040 .. S CODE=$O(^ICPT("B",$P(X0,U),0)) 96053 "RTN","C0CCPT", 76,0)96041 "RTN","C0CCPT",88,0) 96054 96042 .. S:CODE CODE=$P(^ICPT(CODE,0),U) 96055 "RTN","C0CCPT", 77,0)96043 "RTN","C0CCPT",89,0) 96056 96044 .. S CAT=$P(X802,U) 96057 "RTN","C0CCPT", 78,0)96045 "RTN","C0CCPT",90,0) 96058 96046 .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U) 96059 "RTN","C0CCPT", 79,0)96047 "RTN","C0CCPT",91,0) 96060 96048 .. S NARR=$P(X0,U,4) 96061 "RTN","C0CCPT", 80,0)96049 "RTN","C0CCPT",92,0) 96062 96050 .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U) 96063 "RTN","C0CCPT", 81,0)96051 "RTN","C0CCPT",93,0) 96064 96052 .. S QTY=$P(X0,U,16) 96065 "RTN","C0CCPT", 82,0)96053 "RTN","C0CCPT",94,0) 96066 96054 .. S PRV=$P(X12,U,4) 96067 "RTN","C0CCPT", 83,0)96055 "RTN","C0CCPT",95,0) 96068 96056 .. S MCNT=0,MIDX=0,MODS="" 96069 "RTN","C0CCPT", 84,0)96057 "RTN","C0CCPT",96,0) 96070 96058 .. F S MIDX=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX)) Q:'MIDX D 96071 "RTN","C0CCPT", 85,0)96059 "RTN","C0CCPT",97,0) 96072 96060 ... S MIEN=$G(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX,0)) 96073 "RTN","C0CCPT", 86,0)96061 "RTN","C0CCPT",98,0) 96074 96062 ... I +MIEN S MCNT=MCNT+1,MODS=MODS_";/"_MIEN 96075 "RTN","C0CCPT", 87,0)96063 "RTN","C0CCPT",99,0) 96076 96064 .. I +MCNT S MODS=MCNT_MODS 96077 "RTN","C0CCPT", 88,0)96065 "RTN","C0CCPT",100,0) 96078 96066 .. S ILST=ILST+1 96079 "RTN","C0CCPT", 89,0)96067 "RTN","C0CCPT",101,0) 96080 96068 .. S LST(ILST)="CPT"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS 96081 "RTN","C0CCPT", 90,0)96069 "RTN","C0CCPT",102,0) 96082 96070 .. S VISIT(IEN,"CPT",ILST)=CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS 96083 "RTN","C0CCPT", 91,0)96071 "RTN","C0CCPT",103,0) 96084 96072 . S VISIT(IEN,"DATE",0)=$P($P(^TIU(8925,IEN,0),U,7),".") 96085 "RTN","C0CCPT", 92,0)96073 "RTN","C0CCPT",104,0) 96086 96074 . S VISIT(IEN,"CLASS")=$$GET1^DIQ(8925,IEN_",",.04) ;GPL 5/21/10 96087 "RTN","C0CCPT", 93,0)96075 "RTN","C0CCPT",105,0) 96088 96076 . I $G(TXT)=1 D GETNOTE(IEN) 96089 "RTN","C0CCPT", 94,0)96077 "RTN","C0CCPT",106,0) 96090 96078 Q 96091 "RTN","C0CCPT", 95,0)96079 "RTN","C0CCPT",107,0) 96092 96080 GETNOTE(IEN) ;GET THE TEXT THAT GOES WITH VISIT 96093 "RTN","C0CCPT", 96,0)96081 "RTN","C0CCPT",108,0) 96094 96082 ;EXTRACT NOTE TEXT FROM ^TIU(8925,IEN,"TEXT" 96095 "RTN","C0CCPT", 97,0)96083 "RTN","C0CCPT",109,0) 96096 96084 Q:'$D(VISIT(IEN,"CPT")) 96097 "RTN","C0CCPT", 98,0)96085 "RTN","C0CCPT",110,0) 96098 96086 S TXTCNT=0 96099 "RTN","C0CCPT", 99,0)96087 "RTN","C0CCPT",111,0) 96100 96088 F S TXTCNT=TXTCNT+1 Q:'$D(^TIU(8925,IEN,"TEXT",TXTCNT,0)) D 96101 "RTN","C0CCPT",1 00,0)96089 "RTN","C0CCPT",112,0) 96102 96090 . S VISIT(IEN,"TEXT",TXTCNT)=^TIU(8925,IEN,"TEXT",TXTCNT,0) 96103 "RTN","C0CCPT",1 01,0)96091 "RTN","C0CCPT",113,0) 96104 96092 Q 96105 96093 "RTN","C0CDIC") 96106 0^73^B4 352763696094 0^73^B42907516 96107 96095 "RTN","C0CDIC",1,0) 96108 96096 C0CDIC ; CCDCCR/GPL - CCR Dictionary utilities; 6/1/08 96109 96097 "RTN","C0CDIC",2,0) 96110 ;;1.2;C 0C;;May 11, 2012;Build 5096098 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 96111 96099 "RTN","C0CDIC",3,0) 96112 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU96100 ;Copyright 2008 WorldVistA. 96113 96101 "RTN","C0CDIC",4,0) 96114 ; General Public License See attached copy of the License.96102 ; 96115 96103 "RTN","C0CDIC",5,0) 96116 ; 96104 ; This program is free software: you can redistribute it and/or modify 96117 96105 "RTN","C0CDIC",6,0) 96118 ; This program is free software; you can redistribute it and/or modify96106 ; it under the terms of the GNU Affero General Public License as 96119 96107 "RTN","C0CDIC",7,0) 96120 ; it under the terms of the GNU General Public License as published by96108 ; published by the Free Software Foundation, either version 3 of the 96121 96109 "RTN","C0CDIC",8,0) 96122 ; the Free Software Foundation; either version 2 of the License, or96110 ; License, or (at your option) any later version. 96123 96111 "RTN","C0CDIC",9,0) 96124 ; (at your option) any later version.96112 ; 96125 96113 "RTN","C0CDIC",10,0) 96126 ; 96114 ; This program is distributed in the hope that it will be useful, 96127 96115 "RTN","C0CDIC",11,0) 96128 ; This program is distributed in the hope that it will be useful,96116 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 96129 96117 "RTN","C0CDIC",12,0) 96130 ; but WITHOUT ANY WARRANTY; without even the implied warranty of96118 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 96131 96119 "RTN","C0CDIC",13,0) 96132 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the96120 ; GNU Affero General Public License for more details. 96133 96121 "RTN","C0CDIC",14,0) 96134 ; GNU General Public License for more details.96122 ; 96135 96123 "RTN","C0CDIC",15,0) 96136 ; 96124 ; You should have received a copy of the GNU Affero General Public License 96137 96125 "RTN","C0CDIC",16,0) 96138 ; You should have received a copy of the GNU General Public License along96126 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 96139 96127 "RTN","C0CDIC",17,0) 96140 ; with this program; if not, write to the Free Software Foundation, Inc.,96128 ; 96141 96129 "RTN","C0CDIC",18,0) 96142 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.96130 W "This is the CCR Dictionary Utility Library ",! 96143 96131 "RTN","C0CDIC",19,0) 96144 ;96132 W ! 96145 96133 "RTN","C0CDIC",20,0) 96146 W "This is the CCR Dictionary Utility Library ",!96134 Q 96147 96135 "RTN","C0CDIC",21,0) 96148 W !96136 ; 96149 96137 "RTN","C0CDIC",22,0) 96138 DIC2CSV ;OUTPUT THE CCR DICTIONARY TO A CSV FILE 96139 "RTN","C0CDIC",23,0) 96140 ; 96141 "RTN","C0CDIC",24,0) 96142 N ZI 96143 "RTN","C0CDIC",25,0) 96144 S ZI="" 96145 "RTN","C0CDIC",26,0) 96146 S G1=$NA(^TMP($J,"C0CCSV",1)) 96147 "RTN","C0CDIC",27,0) 96148 S G1A=$NA(@G1@("V")) 96149 "RTN","C0CDIC",28,0) 96150 S G2=$NA(^TMP($J,"C0CCSV",2)) 96151 "RTN","C0CDIC",29,0) 96152 D GETN2^C0CRNF(G1,170) ; GET THE MATRIX 96153 "RTN","C0CDIC",30,0) 96154 F S ZI=$O(@G1A@(ZI)) Q:ZI="" D ;FOR EACH ROW IN THE MATRIX 96155 "RTN","C0CDIC",31,0) 96156 . I $G(@G1A@(ZI,"MAPPING METHOD",1))'="" D ; 96157 "RTN","C0CDIC",32,0) 96158 . . W @G1A@(ZI,"MAPPING METHOD",1),! 96159 "RTN","C0CDIC",33,0) 96160 . . ;K @G1A@(ZI,"MAPPING METHOD") 96161 "RTN","C0CDIC",34,0) 96162 . ;W !,ZI,$G(@G1A@(ZI,"MAPPING METHOD",1)) 96163 "RTN","C0CDIC",35,0) 96164 D RNF2CSV^C0CRNF(G2,G1,"VN") ; PREPARE THE CVS FILE 96165 "RTN","C0CDIC",36,0) 96166 K @G1 96167 "RTN","C0CDIC",37,0) 96168 D FILEOUT^C0CRNF(G2,"FILE_"_170_".csv") 96169 "RTN","C0CDIC",38,0) 96170 K @G2 96171 "RTN","C0CDIC",39,0) 96150 96172 Q 96151 "RTN","C0CDIC",23,0)96152 ;96153 "RTN","C0CDIC",24,0)96154 DIC2CSV ;OUTPUT THE CCR DICTIONARY TO A CSV FILE96155 "RTN","C0CDIC",25,0)96156 ;96157 "RTN","C0CDIC",26,0)96158 N ZI96159 "RTN","C0CDIC",27,0)96160 S ZI=""96161 "RTN","C0CDIC",28,0)96162 S G1=$NA(^TMP($J,"C0CCSV",1))96163 "RTN","C0CDIC",29,0)96164 S G1A=$NA(@G1@("V"))96165 "RTN","C0CDIC",30,0)96166 S G2=$NA(^TMP($J,"C0CCSV",2))96167 "RTN","C0CDIC",31,0)96168 D GETN2^C0CRNF(G1,170) ; GET THE MATRIX96169 "RTN","C0CDIC",32,0)96170 F S ZI=$O(@G1A@(ZI)) Q:ZI="" D ;FOR EACH ROW IN THE MATRIX96171 "RTN","C0CDIC",33,0)96172 . I $G(@G1A@(ZI,"MAPPING METHOD",1))'="" D ;96173 "RTN","C0CDIC",34,0)96174 . . W @G1A@(ZI,"MAPPING METHOD",1),!96175 "RTN","C0CDIC",35,0)96176 . . ;K @G1A@(ZI,"MAPPING METHOD")96177 "RTN","C0CDIC",36,0)96178 . ;W !,ZI,$G(@G1A@(ZI,"MAPPING METHOD",1))96179 "RTN","C0CDIC",37,0)96180 D RNF2CSV^C0CRNF(G2,G1,"VN") ; PREPARE THE CVS FILE96181 "RTN","C0CDIC",38,0)96182 K @G196183 "RTN","C0CDIC",39,0)96184 D FILEOUT^C0CRNF(G2,"FILE_"_170_".csv")96185 96173 "RTN","C0CDIC",40,0) 96186 K @G296174 ; 96187 96175 "RTN","C0CDIC",41,0) 96176 GVARS(C0CVARS,C0CT) ; Get the CCR variables from the CCR template 96177 "RTN","C0CDIC",42,0) 96178 ; and return them in C0CVARS, which is passed by name 96179 "RTN","C0CDIC",43,0) 96180 ; FIRST PIECE OF C0CVARS(x) IS THE VARIABLE NAME, SECOND PIECE 96181 "RTN","C0CDIC",44,0) 96182 ; IS THE LINE NUMBER OF THE VARIABLE IN THE TEMPLATE 96183 "RTN","C0CDIC",45,0) 96184 ; C0CT IS RETURNED AS THE CCR TEMPLATE 96185 "RTN","C0CDIC",46,0) 96186 N C0CTVARS ; ARRAY FOR THE TEMPLATE AND ARRAY FOR THE VARS 96187 "RTN","C0CDIC",47,0) 96188 D LOAD^GPLCCR0(C0CT) ; LOAD THE CCR TEMPLATE 96189 "RTN","C0CDIC",48,0) 96190 D XVARS^GPLXPATH("C0CTVARS",C0CT) ; PULL OUT THE VARS 96191 "RTN","C0CDIC",49,0) 96192 N C0CI,C0CX 96193 "RTN","C0CDIC",50,0) 96194 S @C0CVARS@(0)=C0CTVARS(0) ; SAME COUNT 96195 "RTN","C0CDIC",51,0) 96196 F C0CI=1:1:C0CTVARS(0) D ; FOR EVERY LINE IN THE ARRAY 96197 "RTN","C0CDIC",52,0) 96198 . S C0CX=C0CTVARS(C0CI) ; THE VARIABLE - 3 PIECES, FIRST ONE NULL 96199 "RTN","C0CDIC",53,0) 96200 . S @C0CVARS@(C0CI)=$P(C0CX,"^",2)_"^"_$P(C0CX,"^",3) ; VAR NAME^LINE NUMBER 96201 "RTN","C0CDIC",54,0) 96202 ;D PARY^GPLXPATH("C0CVARS") 96203 "RTN","C0CDIC",55,0) 96188 96204 Q 96189 "RTN","C0CDIC",42,0)96190 ;96191 "RTN","C0CDIC",43,0)96192 GVARS(C0CVARS,C0CT) ; Get the CCR variables from the CCR template96193 "RTN","C0CDIC",44,0)96194 ; and return them in C0CVARS, which is passed by name96195 "RTN","C0CDIC",45,0)96196 ; FIRST PIECE OF C0CVARS(x) IS THE VARIABLE NAME, SECOND PIECE96197 "RTN","C0CDIC",46,0)96198 ; IS THE LINE NUMBER OF THE VARIABLE IN THE TEMPLATE96199 "RTN","C0CDIC",47,0)96200 ; C0CT IS RETURNED AS THE CCR TEMPLATE96201 "RTN","C0CDIC",48,0)96202 N C0CTVARS ; ARRAY FOR THE TEMPLATE AND ARRAY FOR THE VARS96203 "RTN","C0CDIC",49,0)96204 D LOAD^GPLCCR0(C0CT) ; LOAD THE CCR TEMPLATE96205 "RTN","C0CDIC",50,0)96206 D XVARS^GPLXPATH("C0CTVARS",C0CT) ; PULL OUT THE VARS96207 "RTN","C0CDIC",51,0)96208 N C0CI,C0CX96209 "RTN","C0CDIC",52,0)96210 S @C0CVARS@(0)=C0CTVARS(0) ; SAME COUNT96211 "RTN","C0CDIC",53,0)96212 F C0CI=1:1:C0CTVARS(0) D ; FOR EVERY LINE IN THE ARRAY96213 "RTN","C0CDIC",54,0)96214 . S C0CX=C0CTVARS(C0CI) ; THE VARIABLE - 3 PIECES, FIRST ONE NULL96215 "RTN","C0CDIC",55,0)96216 . S @C0CVARS@(C0CI)=$P(C0CX,"^",2)_"^"_$P(C0CX,"^",3) ; VAR NAME^LINE NUMBER96217 96205 "RTN","C0CDIC",56,0) 96218 ; D PARY^GPLXPATH("C0CVARS")96206 ; 96219 96207 "RTN","C0CDIC",57,0) 96208 GXPATH(C0CPVARS,C0CPT) ; LOAD THE CCR TEMPLATE INTO C0CPT, PULL OUT VARIABLES 96209 "RTN","C0CDIC",58,0) 96210 ; AND THE XPATH TO THE VARIABLES INTO C0CPVARS 96211 "RTN","C0CDIC",59,0) 96212 ; BY INDEXING THE TEMPLATE C0CT AND MATCHING THE XPATH TO THE VARIABLE 96213 "RTN","C0CDIC",60,0) 96214 ; BOTH ARE PASSED BY NAME 96215 "RTN","C0CDIC",61,0) 96216 ; C0CPVARS(x) IS VAR^LINENUM^XPATH SORTED BY LINENUM 96217 "RTN","C0CDIC",62,0) 96218 ; C0CPVARS(0) IS NUMBER OF VARIABLES 96219 "RTN","C0CDIC",63,0) 96220 ; C0CPT(0) IS NUMBER OF LINES IN THE TEMPLATE 96221 "RTN","C0CDIC",64,0) 96222 D GVARS(C0CPVARS,C0CPT) ; GET THE VARIABLES AND LINE NUMBERS 96223 "RTN","C0CDIC",65,0) 96224 ;N C0CTVARS ; HASH TABLE FOR VARIABLE BY LINE NUMBER 96225 "RTN","C0CDIC",66,0) 96226 D HASHV ; PUT THE VARIABLES IN A LINE NUMBER HASH FOR MATCHING TO XPATHS 96227 "RTN","C0CDIC",67,0) 96228 ; NOW GO GET THE XPATH INDEXES 96229 "RTN","C0CDIC",68,0) 96230 D INDEX^GPLXPATH(C0CPT) ; ADD THE XPATH INDEXES TO THE TEMPLATE ARRAY 96231 "RTN","C0CDIC",69,0) 96232 S C0CI="" ; GOING TO LOOP THROUGH THE WHOLE ARRAY LOOKING AT XPATHS 96233 "RTN","C0CDIC",70,0) 96234 F S C0CI=$O(@C0CPT@(C0CI)) Q:C0CI="" D ; VISIT EVERY LINE 96235 "RTN","C0CDIC",71,0) 96236 . I +C0CI'=0 Q ; SKIP EVERYTHING BUT THE XPATH INDEX 96237 "RTN","C0CDIC",72,0) 96238 . I C0CI=0 Q ; SKIP THE ZERO NODE 96239 "RTN","C0CDIC",73,0) 96240 . S C0CX=@C0CPT@(C0CI) ; PULL OUT THE LINE NUMBERS X^Y 96241 "RTN","C0CDIC",74,0) 96242 . S C0CY=$P(C0CX,"^",1) ; STARTING LINE NUMBER 96243 "RTN","C0CDIC",75,0) 96244 . S C0CZ=$P(C0CX,"^",2) ; ENDING LINE NUMBER 96245 "RTN","C0CDIC",76,0) 96246 . I C0CY=C0CZ D ; THIS IS AN XPATH END NODE, HAS A VARIABLE (WE HOPE) 96247 "RTN","C0CDIC",77,0) 96248 . . ; W "FOUND ",C0CI,! 96249 "RTN","C0CDIC",78,0) 96250 . . I $D(C0CTVARS(C0CY)) D ; IF THERE IS A VARIABLE THERE 96251 "RTN","C0CDIC",79,0) 96252 . . . S $P(C0CTVARS(C0CY),"^",3)=C0CI ; INSERT THE XPATH FOR THE VAR 96253 "RTN","C0CDIC",80,0) 96254 D SORTV ; SORT THE ARRAY BY LINE NUMBER 96255 "RTN","C0CDIC",81,0) 96220 96256 Q 96221 "RTN","C0CDIC",58,0)96222 ;96223 "RTN","C0CDIC",59,0)96224 GXPATH(C0CPVARS,C0CPT) ; LOAD THE CCR TEMPLATE INTO C0CPT, PULL OUT VARIABLES96225 "RTN","C0CDIC",60,0)96226 ; AND THE XPATH TO THE VARIABLES INTO C0CPVARS96227 "RTN","C0CDIC",61,0)96228 ; BY INDEXING THE TEMPLATE C0CT AND MATCHING THE XPATH TO THE VARIABLE96229 "RTN","C0CDIC",62,0)96230 ; BOTH ARE PASSED BY NAME96231 "RTN","C0CDIC",63,0)96232 ; C0CPVARS(x) IS VAR^LINENUM^XPATH SORTED BY LINENUM96233 "RTN","C0CDIC",64,0)96234 ; C0CPVARS(0) IS NUMBER OF VARIABLES96235 "RTN","C0CDIC",65,0)96236 ; C0CPT(0) IS NUMBER OF LINES IN THE TEMPLATE96237 "RTN","C0CDIC",66,0)96238 D GVARS(C0CPVARS,C0CPT) ; GET THE VARIABLES AND LINE NUMBERS96239 "RTN","C0CDIC",67,0)96240 ;N C0CTVARS ; HASH TABLE FOR VARIABLE BY LINE NUMBER96241 "RTN","C0CDIC",68,0)96242 D HASHV ; PUT THE VARIABLES IN A LINE NUMBER HASH FOR MATCHING TO XPATHS96243 "RTN","C0CDIC",69,0)96244 ; NOW GO GET THE XPATH INDEXES96245 "RTN","C0CDIC",70,0)96246 D INDEX^GPLXPATH(C0CPT) ; ADD THE XPATH INDEXES TO THE TEMPLATE ARRAY96247 "RTN","C0CDIC",71,0)96248 S C0CI="" ; GOING TO LOOP THROUGH THE WHOLE ARRAY LOOKING AT XPATHS96249 "RTN","C0CDIC",72,0)96250 F S C0CI=$O(@C0CPT@(C0CI)) Q:C0CI="" D ; VISIT EVERY LINE96251 "RTN","C0CDIC",73,0)96252 . I +C0CI'=0 Q ; SKIP EVERYTHING BUT THE XPATH INDEX96253 "RTN","C0CDIC",74,0)96254 . I C0CI=0 Q ; SKIP THE ZERO NODE96255 "RTN","C0CDIC",75,0)96256 . S C0CX=@C0CPT@(C0CI) ; PULL OUT THE LINE NUMBERS X^Y96257 "RTN","C0CDIC",76,0)96258 . S C0CY=$P(C0CX,"^",1) ; STARTING LINE NUMBER96259 "RTN","C0CDIC",77,0)96260 . S C0CZ=$P(C0CX,"^",2) ; ENDING LINE NUMBER96261 "RTN","C0CDIC",78,0)96262 . I C0CY=C0CZ D ; THIS IS AN XPATH END NODE, HAS A VARIABLE (WE HOPE)96263 "RTN","C0CDIC",79,0)96264 . . ; W "FOUND ",C0CI,!96265 "RTN","C0CDIC",80,0)96266 . . I $D(C0CTVARS(C0CY)) D ; IF THERE IS A VARIABLE THERE96267 "RTN","C0CDIC",81,0)96268 . . . S $P(C0CTVARS(C0CY),"^",3)=C0CI ; INSERT THE XPATH FOR THE VAR96269 96257 "RTN","C0CDIC",82,0) 96270 D SORTV ; SORT THE ARRAY BY LINE NUMBER96258 ; 96271 96259 "RTN","C0CDIC",83,0) 96260 HASHV ; INTERNAL ROUTINE TO PUT VARIABLE NAMES IN A LINE NUMBER HASH 96261 "RTN","C0CDIC",84,0) 96262 ;N C0CI,C0CTVARS,C0CX,C0CY 96263 "RTN","C0CDIC",85,0) 96264 F C0CI=1:1:@C0CPVARS@(0) D ; FOR THE ENTIRE ARRAY 96265 "RTN","C0CDIC",86,0) 96266 . S C0CX=$P(@C0CPVARS@(C0CI),"^",2) ; LINE NUMBER 96267 "RTN","C0CDIC",87,0) 96268 . S C0CY=$P(@C0CPVARS@(C0CI),"^",1) ; VARIABLE NAME 96269 "RTN","C0CDIC",88,0) 96270 . S C0CTVARS(C0CX)=C0CY ; BUILD HASH OF VARIABLES BY LINE NUMBER 96271 "RTN","C0CDIC",89,0) 96272 96272 Q 96273 "RTN","C0CDIC",84,0)96274 ;96275 "RTN","C0CDIC",85,0)96276 HASHV ; INTERNAL ROUTINE TO PUT VARIABLE NAMES IN A LINE NUMBER HASH96277 "RTN","C0CDIC",86,0)96278 ;N C0CI,C0CTVARS,C0CX,C0CY96279 "RTN","C0CDIC",87,0)96280 F C0CI=1:1:@C0CPVARS@(0) D ; FOR THE ENTIRE ARRAY96281 "RTN","C0CDIC",88,0)96282 . S C0CX=$P(@C0CPVARS@(C0CI),"^",2) ; LINE NUMBER96283 "RTN","C0CDIC",89,0)96284 . S C0CY=$P(@C0CPVARS@(C0CI),"^",1) ; VARIABLE NAME96285 96273 "RTN","C0CDIC",90,0) 96286 . S C0CTVARS(C0CX)=C0CY ; BUILD HASH OF VARIABLES BY LINE NUMBER96274 ; 96287 96275 "RTN","C0CDIC",91,0) 96276 SORTV ; INTERNAL ROUTINE TO OUTPUT VARIABLES (AND XPATHS) IN LINE NUMBER ORDER 96277 "RTN","C0CDIC",92,0) 96278 ;N C0CV2 ; SCRACTH SPACE FOR BUILDING SORTED ARRAY 96279 "RTN","C0CDIC",93,0) 96280 S C0CI="" ; 96281 "RTN","C0CDIC",94,0) 96282 F S C0CI=$O(C0CTVARS(C0CI)) Q:C0CI="" D ; BY LINE NUMBER 96283 "RTN","C0CDIC",95,0) 96284 . S C0CX=C0CTVARS(C0CI) ;VARIABLE NAME 96285 "RTN","C0CDIC",96,0) 96286 . S $P(C0CX,"^",2)=C0CI ; LINE NUMBER IS SECOND PIECE 96287 "RTN","C0CDIC",97,0) 96288 . D PUSH^GPLXPATH("C0C2",C0CX) ; PUT ONTO ARRAY 96289 "RTN","C0CDIC",98,0) 96290 K @C0CPVARS 96291 "RTN","C0CDIC",99,0) 96292 M @C0CPVARS=C0C2 96293 "RTN","C0CDIC",100,0) 96288 96294 Q 96289 "RTN","C0CDIC",92,0)96290 ;96291 "RTN","C0CDIC",93,0)96292 SORTV ; INTERNAL ROUTINE TO OUTPUT VARIABLES (AND XPATHS) IN LINE NUMBER ORDER96293 "RTN","C0CDIC",94,0)96294 ;N C0CV2 ; SCRACTH SPACE FOR BUILDING SORTED ARRAY96295 "RTN","C0CDIC",95,0)96296 S C0CI="" ;96297 "RTN","C0CDIC",96,0)96298 F S C0CI=$O(C0CTVARS(C0CI)) Q:C0CI="" D ; BY LINE NUMBER96299 "RTN","C0CDIC",97,0)96300 . S C0CX=C0CTVARS(C0CI) ;VARIABLE NAME96301 "RTN","C0CDIC",98,0)96302 . S $P(C0CX,"^",2)=C0CI ; LINE NUMBER IS SECOND PIECE96303 "RTN","C0CDIC",99,0)96304 . D PUSH^GPLXPATH("C0C2",C0CX) ; PUT ONTO ARRAY96305 "RTN","C0CDIC",100,0)96306 K @C0CPVARS96307 96295 "RTN","C0CDIC",101,0) 96308 M @C0CPVARS=C0C296296 ; 96309 96297 "RTN","C0CDIC",102,0) 96298 LOAD ; LOAD VARIABLE NAMES AND XPATH IN ^C0CDIC(170 96299 "RTN","C0CDIC",103,0) 96300 ; INITIAL LOAD OF THE CCR DICTIONARY 96301 "RTN","C0CDIC",104,0) 96302 ; 96303 "RTN","C0CDIC",105,0) 96304 N C0CDIC,C0CARY,C0CXML,C0CFDA,C0CI 96305 "RTN","C0CDIC",106,0) 96306 S C0CDIC="^C0CDIC(170," ; ROOT OF THE CCR DICTIONARY 96307 "RTN","C0CDIC",107,0) 96308 D GXPATH("C0CARY","C0CXML") ; FETCH THE VARIABLES AND XPATH INTO C0CARY 96309 "RTN","C0CDIC",108,0) 96310 ; C0CXML WILL CONTAIN THE TEMPLATE - NOT NEEDED FOR LOAD 96311 "RTN","C0CDIC",109,0) 96312 D PARY^GPLXPATH("C0CARY") ;TEST 96313 "RTN","C0CDIC",110,0) 96314 F C0CI=1:1:C0CARY(0) D ; LOAD EACH VARIABLE 96315 "RTN","C0CDIC",111,0) 96316 . S C0CFDA(170,"+"_C0CI_",",.01)=$P(C0CARY(C0CI),"^",1) ; VAR NAME 96317 "RTN","C0CDIC",112,0) 96318 . S C0CFDA(170,"+"_C0CI_",",2)=$P(C0CARY(C0CI),"^",3) ; XPATH 96319 "RTN","C0CDIC",113,0) 96320 . D UPDATE^DIE("","C0CFDA") 96321 "RTN","C0CDIC",114,0) 96322 . I $D(^TMP("DIERR",$J)) U $P BREAK 96323 "RTN","C0CDIC",115,0) 96324 . W "LOADING:",C0CI," ",C0CARY(C0CI),! 96325 "RTN","C0CDIC",116,0) 96310 96326 Q 96311 "RTN","C0CDIC",103,0)96312 ;96313 "RTN","C0CDIC",104,0)96314 LOAD ; LOAD VARIABLE NAMES AND XPATH IN ^C0CDIC(17096315 "RTN","C0CDIC",105,0)96316 ; INITIAL LOAD OF THE CCR DICTIONARY96317 "RTN","C0CDIC",106,0)96318 ;96319 "RTN","C0CDIC",107,0)96320 N C0CDIC,C0CARY,C0CXML,C0CFDA,C0CI96321 "RTN","C0CDIC",108,0)96322 S C0CDIC="^C0CDIC(170," ; ROOT OF THE CCR DICTIONARY96323 "RTN","C0CDIC",109,0)96324 D GXPATH("C0CARY","C0CXML") ; FETCH THE VARIABLES AND XPATH INTO C0CARY96325 "RTN","C0CDIC",110,0)96326 ; C0CXML WILL CONTAIN THE TEMPLATE - NOT NEEDED FOR LOAD96327 "RTN","C0CDIC",111,0)96328 D PARY^GPLXPATH("C0CARY") ;TEST96329 "RTN","C0CDIC",112,0)96330 F C0CI=1:1:C0CARY(0) D ; LOAD EACH VARIABLE96331 "RTN","C0CDIC",113,0)96332 . S C0CFDA(170,"+"_C0CI_",",.01)=$P(C0CARY(C0CI),"^",1) ; VAR NAME96333 "RTN","C0CDIC",114,0)96334 . S C0CFDA(170,"+"_C0CI_",",2)=$P(C0CARY(C0CI),"^",3) ; XPATH96335 "RTN","C0CDIC",115,0)96336 . D UPDATE^DIE("","C0CFDA")96337 "RTN","C0CDIC",116,0)96338 . I $D(^TMP("DIERR",$J)) U $P BREAK96339 96327 "RTN","C0CDIC",117,0) 96340 . W "LOADING:",C0CI," ",C0CARY(C0CI),!96328 ; 96341 96329 "RTN","C0CDIC",118,0) 96330 INIT ; INITIALIZE CCR DICTIONARY BASED ON VARIABLE NAMES 96331 "RTN","C0CDIC",119,0) 96332 ; 96333 "RTN","C0CDIC",120,0) 96334 ; CHEAT SHEET FOR VARIABLE NAMES IN ^C0CDIC(170.xx, 96335 "RTN","C0CDIC",121,0) 96336 ; THIS IS WHAT WILL BE IN C0CA FOR EACH DICTIONARY ENTRY 96337 "RTN","C0CDIC",122,0) 96338 ;G1("CODING")="170^8" 96339 "RTN","C0CDIC",123,0) 96340 ;G1("DATA ELEMENT")="170^7" 96341 "RTN","C0CDIC",124,0) 96342 ;G1("DESCRIPTION")="170^3" 96343 "RTN","C0CDIC",125,0) 96344 ;G1("ID")="170^1" 96345 "RTN","C0CDIC",126,0) 96346 ;G1("M","170^8","CODING")="170.08^.01" 96347 "RTN","C0CDIC",127,0) 96348 ;G1("MAPPING METHOD")="170.08^1" 96349 "RTN","C0CDIC",128,0) 96350 ;G1("SECTION")="170^10" 96351 "RTN","C0CDIC",129,0) 96352 ;G1("SOURCE")="170^4" 96353 "RTN","C0CDIC",130,0) 96354 ;G1("STATUS")="170^9" 96355 "RTN","C0CDIC",131,0) 96356 ;G1("TYPE")="170^6" 96357 "RTN","C0CDIC",132,0) 96358 ;G1("VARIABLE")="170^.01" 96359 "RTN","C0CDIC",133,0) 96360 ;G1("XPATH")="170^2" 96361 "RTN","C0CDIC",134,0) 96362 ; 96363 "RTN","C0CDIC",135,0) 96364 N C0CZA,C0CZX,C0CN,C0CSTAT 96365 "RTN","C0CDIC",136,0) 96366 S C0CZX=0 96367 "RTN","C0CDIC",137,0) 96368 S C0CSTAT=0 ; INIT STATUS SET FLAG 96369 "RTN","C0CDIC",138,0) 96370 F S C0CZX=$O(^C0CDIC(170,C0CZX)) Q:+C0CZX=0 D ; FOR EACH DICT ENTRY 96371 "RTN","C0CDIC",139,0) 96372 . ;W C0CZX,! 96373 "RTN","C0CDIC",140,0) 96374 . K C0CA,C0CN ; CLEAR OUT THE LAST ONE 96375 "RTN","C0CDIC",141,0) 96376 . D GETN1^C0CRNF("C0CA",170,C0CZX,"","ALL") ; GET VARIABLE HASH 96377 "RTN","C0CDIC",142,0) 96378 . ;ZWR C0CA B ; 96379 "RTN","C0CDIC",143,0) 96380 . S C0CN=$$ZVALUE("VARIABLE") ;NAME OF THE VARIABLE 96381 "RTN","C0CDIC",144,0) 96382 . W "VARIABLE: ",C0CN,! 96383 "RTN","C0CDIC",145,0) 96384 . I $E(C0CN,1,5)="ACTOR" D SETFDA("SECTION","ACTORS") ; 96385 "RTN","C0CDIC",146,0) 96386 . I $E(C0CN,1,6)="SOCIAL" D ; 96387 "RTN","C0CDIC",147,0) 96388 . . D SETFDA("SECTION","SOC") ; 96389 "RTN","C0CDIC",148,0) 96390 . . D SETFDA("STATUS","X") ;SOCIAL HISTORY NOT IMPLEMENTED 96391 "RTN","C0CDIC",149,0) 96392 . . S C0CSTAT=1 96393 "RTN","C0CDIC",150,0) 96394 . I $E(C0CN,1,6)="FAMILY" D ; 96395 "RTN","C0CDIC",151,0) 96396 . . D SETFDA("SECTION","FAM") ; 96397 "RTN","C0CDIC",152,0) 96398 . . D SETFDA("STATUS","X") ;FAMILY HISTORY NOT IMPLEMENTED 96399 "RTN","C0CDIC",153,0) 96400 . . S C0CSTAT=1 96401 "RTN","C0CDIC",154,0) 96402 . ;D SETFDA("TYPE","") ;CORRECT FOR TYPE ERRORS 96403 "RTN","C0CDIC",155,0) 96404 . I $E(C0CN,1,5)="ALERT" D SETFDA("SECTION","ALERTS") 96405 "RTN","C0CDIC",156,0) 96406 . I $E(C0CN,1,5)="VITAL" D SETFDA("SECTION","VITALS") 96407 "RTN","C0CDIC",157,0) 96408 . I $E(C0CN,1,7)="PROBLEM" D SETFDA("SECTION","PROBLEMS") 96409 "RTN","C0CDIC",158,0) 96410 . I $E(C0CN,1,10)="RESULTTEST" D SETFDA("SECTION","TEST") 96411 "RTN","C0CDIC",159,0) 96412 . E I $E(C0CN,1,6)="RESULT" D SETFDA("SECTION","LABS") 96413 "RTN","C0CDIC",160,0) 96414 . I C0CN["CODEVALUE" D SETFDA("TYPE","CD") ;CODES 96415 "RTN","C0CDIC",161,0) 96416 . I C0CN["CODEVERSION" D SETFDA("TYPE","CV") ; CODE VERSION 96417 "RTN","C0CDIC",162,0) 96418 . I C0CN["CODINGSYSTEM" D SETFDA("TYPE","CS") ;CODING SYSTEM 96419 "RTN","C0CDIC",163,0) 96420 . I $$ZVALUE("STATUS")=""!'C0CSTAT D SETFDA("STATUS","N") ;BLANK STATUS TO N 96421 "RTN","C0CDIC",164,0) 96422 . I $$ZVALUE("XPATH")["/Medication/Directions/" D ; MEDS DIRECTIONS VAR 96423 "RTN","C0CDIC",165,0) 96424 . . D SETFDA("SECTION","DIR") ; SPECIAL SECTION FOR DIRECTIONS 96425 "RTN","C0CDIC",166,0) 96426 . E I $$ZVALUE("XPATH")["/Medications/Medication/" D ; ALL OTHER MEDS 96427 "RTN","C0CDIC",167,0) 96428 . . D SETFDA("SECTION","MEDS") ; A MEDS VAR 96429 "RTN","C0CDIC",168,0) 96430 . I $E(C0CN,($L(C0CN)-1),$L(C0CN))="ID" D SETFDA("TYPE","ID") ;CATCH THE IDS 96431 "RTN","C0CDIC",169,0) 96432 . I C0CN["DATETIME" D SETFDA("TYPE","DT") ; DATE/TIME VARIABLE 96433 "RTN","C0CDIC",170,0) 96434 . W "VARIABLE: ",C0CZX," ",C0CA("VARIABLE"),! 96435 "RTN","C0CDIC",171,0) 96436 . ;ZWR C0CFDA 96437 "RTN","C0CDIC",172,0) 96438 . I $D(C0CFDA) D ; WE HAVE CHANGES ON THIS VARIABLE 96439 "RTN","C0CDIC",173,0) 96440 . . ;ZWR C0CFDA 96441 "RTN","C0CDIC",174,0) 96442 . . D UPDATE^DIE("","C0CFDA(C0CZX)") 96443 "RTN","C0CDIC",175,0) 96444 . . I $D(^TMP("DIERR",$J)) U $P BREAK 96445 "RTN","C0CDIC",176,0) 96446 . . D CLEAN^DILF ; CLEAN UP 96447 "RTN","C0CDIC",177,0) 96448 . ;ZWR C0CFDA 96449 "RTN","C0CDIC",178,0) 96342 96450 Q 96343 "RTN","C0CDIC",119,0)96344 ;96345 "RTN","C0CDIC",120,0)96346 INIT ; INITIALIZE CCR DICTIONARY BASED ON VARIABLE NAMES96347 "RTN","C0CDIC",121,0)96348 ;96349 "RTN","C0CDIC",122,0)96350 ; CHEAT SHEET FOR VARIABLE NAMES IN ^C0CDIC(170.xx,96351 "RTN","C0CDIC",123,0)96352 ; THIS IS WHAT WILL BE IN C0CA FOR EACH DICTIONARY ENTRY96353 "RTN","C0CDIC",124,0)96354 ;G1("CODING")="170^8"96355 "RTN","C0CDIC",125,0)96356 ;G1("DATA ELEMENT")="170^7"96357 "RTN","C0CDIC",126,0)96358 ;G1("DESCRIPTION")="170^3"96359 "RTN","C0CDIC",127,0)96360 ;G1("ID")="170^1"96361 "RTN","C0CDIC",128,0)96362 ;G1("M","170^8","CODING")="170.08^.01"96363 "RTN","C0CDIC",129,0)96364 ;G1("MAPPING METHOD")="170.08^1"96365 "RTN","C0CDIC",130,0)96366 ;G1("SECTION")="170^10"96367 "RTN","C0CDIC",131,0)96368 ;G1("SOURCE")="170^4"96369 "RTN","C0CDIC",132,0)96370 ;G1("STATUS")="170^9"96371 "RTN","C0CDIC",133,0)96372 ;G1("TYPE")="170^6"96373 "RTN","C0CDIC",134,0)96374 ;G1("VARIABLE")="170^.01"96375 "RTN","C0CDIC",135,0)96376 ;G1("XPATH")="170^2"96377 "RTN","C0CDIC",136,0)96378 ;96379 "RTN","C0CDIC",137,0)96380 N C0CZA,C0CZX,C0CN,C0CSTAT96381 "RTN","C0CDIC",138,0)96382 S C0CZX=096383 "RTN","C0CDIC",139,0)96384 S C0CSTAT=0 ; INIT STATUS SET FLAG96385 "RTN","C0CDIC",140,0)96386 F S C0CZX=$O(^C0CDIC(170,C0CZX)) Q:+C0CZX=0 D ; FOR EACH DICT ENTRY96387 "RTN","C0CDIC",141,0)96388 . ;W C0CZX,!96389 "RTN","C0CDIC",142,0)96390 . K C0CA,C0CN ; CLEAR OUT THE LAST ONE96391 "RTN","C0CDIC",143,0)96392 . D GETN1^C0CRNF("C0CA",170,C0CZX,"","ALL") ; GET VARIABLE HASH96393 "RTN","C0CDIC",144,0)96394 . ;ZWR C0CA B ;96395 "RTN","C0CDIC",145,0)96396 . S C0CN=$$ZVALUE("VARIABLE") ;NAME OF THE VARIABLE96397 "RTN","C0CDIC",146,0)96398 . W "VARIABLE: ",C0CN,!96399 "RTN","C0CDIC",147,0)96400 . I $E(C0CN,1,5)="ACTOR" D SETFDA("SECTION","ACTORS") ;96401 "RTN","C0CDIC",148,0)96402 . I $E(C0CN,1,6)="SOCIAL" D ;96403 "RTN","C0CDIC",149,0)96404 . . D SETFDA("SECTION","SOC") ;96405 "RTN","C0CDIC",150,0)96406 . . D SETFDA("STATUS","X") ;SOCIAL HISTORY NOT IMPLEMENTED96407 "RTN","C0CDIC",151,0)96408 . . S C0CSTAT=196409 "RTN","C0CDIC",152,0)96410 . I $E(C0CN,1,6)="FAMILY" D ;96411 "RTN","C0CDIC",153,0)96412 . . D SETFDA("SECTION","FAM") ;96413 "RTN","C0CDIC",154,0)96414 . . D SETFDA("STATUS","X") ;FAMILY HISTORY NOT IMPLEMENTED96415 "RTN","C0CDIC",155,0)96416 . . S C0CSTAT=196417 "RTN","C0CDIC",156,0)96418 . ;D SETFDA("TYPE","") ;CORRECT FOR TYPE ERRORS96419 "RTN","C0CDIC",157,0)96420 . I $E(C0CN,1,5)="ALERT" D SETFDA("SECTION","ALERTS")96421 "RTN","C0CDIC",158,0)96422 . I $E(C0CN,1,5)="VITAL" D SETFDA("SECTION","VITALS")96423 "RTN","C0CDIC",159,0)96424 . I $E(C0CN,1,7)="PROBLEM" D SETFDA("SECTION","PROBLEMS")96425 "RTN","C0CDIC",160,0)96426 . I $E(C0CN,1,10)="RESULTTEST" D SETFDA("SECTION","TEST")96427 "RTN","C0CDIC",161,0)96428 . E I $E(C0CN,1,6)="RESULT" D SETFDA("SECTION","LABS")96429 "RTN","C0CDIC",162,0)96430 . I C0CN["CODEVALUE" D SETFDA("TYPE","CD") ;CODES96431 "RTN","C0CDIC",163,0)96432 . I C0CN["CODEVERSION" D SETFDA("TYPE","CV") ; CODE VERSION96433 "RTN","C0CDIC",164,0)96434 . I C0CN["CODINGSYSTEM" D SETFDA("TYPE","CS") ;CODING SYSTEM96435 "RTN","C0CDIC",165,0)96436 . I $$ZVALUE("STATUS")=""!'C0CSTAT D SETFDA("STATUS","N") ;BLANK STATUS TO N96437 "RTN","C0CDIC",166,0)96438 . I $$ZVALUE("XPATH")["/Medication/Directions/" D ; MEDS DIRECTIONS VAR96439 "RTN","C0CDIC",167,0)96440 . . D SETFDA("SECTION","DIR") ; SPECIAL SECTION FOR DIRECTIONS96441 "RTN","C0CDIC",168,0)96442 . E I $$ZVALUE("XPATH")["/Medications/Medication/" D ; ALL OTHER MEDS96443 "RTN","C0CDIC",169,0)96444 . . D SETFDA("SECTION","MEDS") ; A MEDS VAR96445 "RTN","C0CDIC",170,0)96446 . I $E(C0CN,($L(C0CN)-1),$L(C0CN))="ID" D SETFDA("TYPE","ID") ;CATCH THE IDS96447 "RTN","C0CDIC",171,0)96448 . I C0CN["DATETIME" D SETFDA("TYPE","DT") ; DATE/TIME VARIABLE96449 "RTN","C0CDIC",172,0)96450 . W "VARIABLE: ",C0CZX," ",C0CA("VARIABLE"),!96451 "RTN","C0CDIC",173,0)96452 . ;ZWR C0CFDA96453 "RTN","C0CDIC",174,0)96454 . I $D(C0CFDA) D ; WE HAVE CHANGES ON THIS VARIABLE96455 "RTN","C0CDIC",175,0)96456 . . ;ZWR C0CFDA96457 "RTN","C0CDIC",176,0)96458 . . D UPDATE^DIE("","C0CFDA(C0CZX)")96459 "RTN","C0CDIC",177,0)96460 . . I $D(^TMP("DIERR",$J)) U $P BREAK96461 "RTN","C0CDIC",178,0)96462 . . D CLEAN^DILF ; CLEAN UP96463 96451 "RTN","C0CDIC",179,0) 96464 . ;ZWR C0CFDA96452 ; 96465 96453 "RTN","C0CDIC",180,0) 96454 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN 96455 "RTN","C0CDIC",181,0) 96456 ; TO SET TO VALUE C0CSV. 96457 "RTN","C0CDIC",182,0) 96458 ; C0CFDA,C0CA,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE 96459 "RTN","C0CDIC",183,0) 96460 ; C0CSN,C0CSV ARE PASSED BY VALUE 96461 "RTN","C0CDIC",184,0) 96462 ; 96463 "RTN","C0CDIC",185,0) 96464 N C0CSI,C0CSJ 96465 "RTN","C0CDIC",186,0) 96466 S C0CSI=$$ZFILE(C0CSN,"C0CA") ; FILE NUMBER 96467 "RTN","C0CDIC",187,0) 96468 S C0CSJ=$$ZFIELD(C0CSN,"C0CA") ; FIELD NUMBER 96469 "RTN","C0CDIC",188,0) 96470 S C0CFDA(C0CZX,C0CSI,C0CZX_",",C0CSJ)=C0CSV 96471 "RTN","C0CDIC",189,0) 96466 96472 Q 96467 "RTN","C0CDIC",181,0)96468 ;96469 "RTN","C0CDIC",182,0)96470 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN96471 "RTN","C0CDIC",183,0)96472 ; TO SET TO VALUE C0CSV.96473 "RTN","C0CDIC",184,0)96474 ; C0CFDA,C0CA,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE96475 "RTN","C0CDIC",185,0)96476 ; C0CSN,C0CSV ARE PASSED BY VALUE96477 "RTN","C0CDIC",186,0)96478 ;96479 "RTN","C0CDIC",187,0)96480 N C0CSI,C0CSJ96481 "RTN","C0CDIC",188,0)96482 S C0CSI=$$ZFILE(C0CSN,"C0CA") ; FILE NUMBER96483 "RTN","C0CDIC",189,0)96484 S C0CSJ=$$ZFIELD(C0CSN,"C0CA") ; FIELD NUMBER96485 96473 "RTN","C0CDIC",190,0) 96486 S C0CFDA(C0CZX,C0CSI,C0CZX_",",C0CSJ)=C0CSV 96474 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 96487 96475 "RTN","C0CDIC",191,0) 96488 Q96476 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN) 96489 96477 "RTN","C0CDIC",192,0) 96490 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 96478 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 96491 96479 "RTN","C0CDIC",193,0) 96492 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)96480 I '$D(ZTAB) S ZTAB="C0CA" 96493 96481 "RTN","C0CDIC",194,0) 96482 Q $P(@ZTAB@(ZFN),"^",1) 96483 "RTN","C0CDIC",195,0) 96484 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED 96485 "RTN","C0CDIC",196,0) 96486 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN) 96487 "RTN","C0CDIC",197,0) 96494 96488 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 96495 "RTN","C0CDIC",19 5,0)96489 "RTN","C0CDIC",198,0) 96496 96490 I '$D(ZTAB) S ZTAB="C0CA" 96497 "RTN","C0CDIC",196,0)96498 Q $P(@ZTAB@(ZFN),"^",1)96499 "RTN","C0CDIC",197,0)96500 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED96501 "RTN","C0CDIC",198,0)96502 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)96503 96491 "RTN","C0CDIC",199,0) 96492 Q $P(@ZTAB@(ZFN),"^",2) 96493 "RTN","C0CDIC",200,0) 96494 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED 96495 "RTN","C0CDIC",201,0) 96496 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN) 96497 "RTN","C0CDIC",202,0) 96504 96498 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 96505 "RTN","C0CDIC",20 0,0)96499 "RTN","C0CDIC",203,0) 96506 96500 I '$D(ZTAB) S ZTAB="C0CA" 96507 "RTN","C0CDIC",201,0)96508 Q $P(@ZTAB@(ZFN),"^",2)96509 "RTN","C0CDIC",202,0)96510 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED96511 "RTN","C0CDIC",203,0)96512 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)96513 96501 "RTN","C0CDIC",204,0) 96514 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA96502 Q $P(@ZTAB@(ZFN),"^",3) 96515 96503 "RTN","C0CDIC",205,0) 96516 I '$D(ZTAB) S ZTAB="C0CA"96517 "RTN","C0CDIC",206,0)96518 Q $P(@ZTAB@(ZFN),"^",3)96519 "RTN","C0CDIC",207,0)96520 96504 ; 96521 96505 "RTN","C0CDOM") 96522 0^74^B86 77398096506 0^74^B86328529 96523 96507 "RTN","C0CDOM",1,0) 96524 96508 C0CDOM ; GPL - DOM PROCESSING ROUTINES ;6/6/11 17:05 96525 96509 "RTN","C0CDOM",2,0) 96526 ;;1.2;C 0C;;May 11, 2012;Build 5096510 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 96527 96511 "RTN","C0CDOM",3,0) 96528 ;Copyright 2011 George Lilly. Licensed under the terms of the GNU96512 ;Copyright 2011 George Lilly. 96529 96513 "RTN","C0CDOM",4,0) 96530 ; General Public License See attached copy of the License.96514 ; 96531 96515 "RTN","C0CDOM",5,0) 96532 ; 96516 ; This program is free software: you can redistribute it and/or modify 96533 96517 "RTN","C0CDOM",6,0) 96534 ; This program is free software; you can redistribute it and/or modify96518 ; it under the terms of the GNU Affero General Public License as 96535 96519 "RTN","C0CDOM",7,0) 96536 ; it under the terms of the GNU General Public License as published by96520 ; published by the Free Software Foundation, either version 3 of the 96537 96521 "RTN","C0CDOM",8,0) 96538 ; the Free Software Foundation; either version 2 of the License, or96522 ; License, or (at your option) any later version. 96539 96523 "RTN","C0CDOM",9,0) 96540 ; (at your option) any later version.96524 ; 96541 96525 "RTN","C0CDOM",10,0) 96542 ; 96526 ; This program is distributed in the hope that it will be useful, 96543 96527 "RTN","C0CDOM",11,0) 96544 ; This program is distributed in the hope that it will be useful,96528 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 96545 96529 "RTN","C0CDOM",12,0) 96546 ; but WITHOUT ANY WARRANTY; without even the implied warranty of96530 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 96547 96531 "RTN","C0CDOM",13,0) 96548 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the96532 ; GNU Affero General Public License for more details. 96549 96533 "RTN","C0CDOM",14,0) 96550 ; GNU General Public License for more details.96534 ; 96551 96535 "RTN","C0CDOM",15,0) 96552 ; 96536 ; You should have received a copy of the GNU Affero General Public License 96553 96537 "RTN","C0CDOM",16,0) 96554 ; You should have received a copy of the GNU General Public License along96538 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 96555 96539 "RTN","C0CDOM",17,0) 96556 ; with this program; if not, write to the Free Software Foundation, Inc.,96540 ; 96557 96541 "RTN","C0CDOM",18,0) 96558 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.96542 ; 96559 96543 "RTN","C0CDOM",19,0) 96560 ;96544 Q 96561 96545 "RTN","C0CDOM",20,0) 96546 ; 96547 "RTN","C0CDOM",21,0) 96548 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE 96549 "RTN","C0CDOM",22,0) 96550 ; THE XPATH INDEX ZXIDX, PASSED BY NAME 96551 "RTN","C0CDOM",23,0) 96552 ; THE XPATH ARRAY XPARY, PASSED BY NAME 96553 "RTN","C0CDOM",24,0) 96554 ; ZOID IS THE STARTING OID 96555 "RTN","C0CDOM",25,0) 96556 ; ZPATH IS THE STARTING XPATH, USUALLY "/" 96557 "RTN","C0CDOM",26,0) 96558 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE 96559 "RTN","C0CDOM",27,0) 96560 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT 96561 "RTN","C0CDOM",28,0) 96562 I $G(ZREDUX)="" S ZREDUX="" 96563 "RTN","C0CDOM",29,0) 96564 N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY 96565 "RTN","C0CDOM",30,0) 96566 N NEWNUM S NEWNUM="" 96567 "RTN","C0CDOM",31,0) 96568 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" 96569 "RTN","C0CDOM",32,0) 96570 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE 96571 "RTN","C0CDOM",33,0) 96572 I $G(ZREDUX)'="" D ; REDUX PROVIDED? 96573 "RTN","C0CDOM",34,0) 96574 . N GT S GT=$P(NEWPATH,ZREDUX,2) 96575 "RTN","C0CDOM",35,0) 96576 . I GT'="" S NEWPATH=GT 96577 "RTN","C0CDOM",36,0) 96578 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX 96579 "RTN","C0CDOM",37,0) 96580 N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE 96581 "RTN","C0CDOM",38,0) 96582 I $D(GA) D ; PROCESS THE ATTRIBUTES 96583 "RTN","C0CDOM",39,0) 96584 . N ZI S ZI="" 96585 "RTN","C0CDOM",40,0) 96586 . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE 96587 "RTN","C0CDOM",41,0) 96588 . . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE 96589 "RTN","C0CDOM",42,0) 96590 . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY 96591 "RTN","C0CDOM",43,0) 96592 . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE 96593 "RTN","C0CDOM",44,0) 96594 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE 96595 "RTN","C0CDOM",45,0) 96596 I $D(GD(2)) D ; 96597 "RTN","C0CDOM",46,0) 96598 . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY 96599 "RTN","C0CDOM",47,0) 96600 E I $D(GD(1)) D ; 96601 "RTN","C0CDOM",48,0) 96602 . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY 96603 "RTN","C0CDOM",49,0) 96604 . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY 96605 "RTN","C0CDOM",50,0) 96606 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD 96607 "RTN","C0CDOM",51,0) 96608 I ZFRST'=0 D ; THERE IS A CHILD 96609 "RTN","C0CDOM",52,0) 96610 . N ZNUM 96611 "RTN","C0CDOM",53,0) 96612 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE 96613 "RTN","C0CDOM",54,0) 96614 . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD 96615 "RTN","C0CDOM",55,0) 96616 N GNXT S GNXT=$$NXTSIB(ZOID) 96617 "RTN","C0CDOM",56,0) 96618 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES 96619 "RTN","C0CDOM",57,0) 96620 I GNXT'=0 D ; 96621 "RTN","C0CDOM",58,0) 96622 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? 96623 "RTN","C0CDOM",59,0) 96624 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES 96625 "RTN","C0CDOM",60,0) 96626 . . N ZNUM S ZNUM=1 ; 96627 "RTN","C0CDOM",61,0) 96628 . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB 96629 "RTN","C0CDOM",62,0) 96630 . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB 96631 "RTN","C0CDOM",63,0) 96562 96632 Q 96563 "RTN","C0CDOM",21,0)96564 ;96565 "RTN","C0CDOM",22,0)96566 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE96567 "RTN","C0CDOM",23,0)96568 ; THE XPATH INDEX ZXIDX, PASSED BY NAME96569 "RTN","C0CDOM",24,0)96570 ; THE XPATH ARRAY XPARY, PASSED BY NAME96571 "RTN","C0CDOM",25,0)96572 ; ZOID IS THE STARTING OID96573 "RTN","C0CDOM",26,0)96574 ; ZPATH IS THE STARTING XPATH, USUALLY "/"96575 "RTN","C0CDOM",27,0)96576 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE96577 "RTN","C0CDOM",28,0)96578 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT96579 "RTN","C0CDOM",29,0)96580 I $G(ZREDUX)="" S ZREDUX=""96581 "RTN","C0CDOM",30,0)96582 N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY96583 "RTN","C0CDOM",31,0)96584 N NEWNUM S NEWNUM=""96585 "RTN","C0CDOM",32,0)96586 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"96587 "RTN","C0CDOM",33,0)96588 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE96589 "RTN","C0CDOM",34,0)96590 I $G(ZREDUX)'="" D ; REDUX PROVIDED?96591 "RTN","C0CDOM",35,0)96592 . N GT S GT=$P(NEWPATH,ZREDUX,2)96593 "RTN","C0CDOM",36,0)96594 . I GT'="" S NEWPATH=GT96595 "RTN","C0CDOM",37,0)96596 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX96597 "RTN","C0CDOM",38,0)96598 N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE96599 "RTN","C0CDOM",39,0)96600 I $D(GA) D ; PROCESS THE ATTRIBUTES96601 "RTN","C0CDOM",40,0)96602 . N ZI S ZI=""96603 "RTN","C0CDOM",41,0)96604 . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE96605 "RTN","C0CDOM",42,0)96606 . . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE96607 "RTN","C0CDOM",43,0)96608 . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY96609 "RTN","C0CDOM",44,0)96610 . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE96611 "RTN","C0CDOM",45,0)96612 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE96613 "RTN","C0CDOM",46,0)96614 I $D(GD(2)) D ;96615 "RTN","C0CDOM",47,0)96616 . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY96617 "RTN","C0CDOM",48,0)96618 E I $D(GD(1)) D ;96619 "RTN","C0CDOM",49,0)96620 . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY96621 "RTN","C0CDOM",50,0)96622 . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY96623 "RTN","C0CDOM",51,0)96624 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD96625 "RTN","C0CDOM",52,0)96626 I ZFRST'=0 D ; THERE IS A CHILD96627 "RTN","C0CDOM",53,0)96628 . N ZNUM96629 "RTN","C0CDOM",54,0)96630 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE96631 "RTN","C0CDOM",55,0)96632 . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD96633 "RTN","C0CDOM",56,0)96634 N GNXT S GNXT=$$NXTSIB(ZOID)96635 "RTN","C0CDOM",57,0)96636 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES96637 "RTN","C0CDOM",58,0)96638 I GNXT'=0 D ;96639 "RTN","C0CDOM",59,0)96640 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?96641 "RTN","C0CDOM",60,0)96642 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES96643 "RTN","C0CDOM",61,0)96644 . . N ZNUM S ZNUM=1 ;96645 "RTN","C0CDOM",62,0)96646 . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB96647 "RTN","C0CDOM",63,0)96648 . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB96649 96633 "RTN","C0CDOM",64,0) 96634 ; 96635 "RTN","C0CDOM",65,0) 96636 ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY 96637 "RTN","C0CDOM",66,0) 96638 ; 96639 "RTN","C0CDOM",67,0) 96640 ; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES 96641 "RTN","C0CDOM",68,0) 96642 ; 96643 "RTN","C0CDOM",69,0) 96644 N ZZI,ZZJ,ZZN 96645 "RTN","C0CDOM",70,0) 96646 S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY 96647 "RTN","C0CDOM",71,0) 96648 I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE 96649 "RTN","C0CDOM",72,0) 96650 S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY 96651 "RTN","C0CDOM",73,0) 96652 S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH . 96653 "RTN","C0CDOM",74,0) 96654 I ZZI'["]" D ; A SINGLETON 96655 "RTN","C0CDOM",75,0) 96656 . S ZZN=1 96657 "RTN","C0CDOM",76,0) 96658 E D ; THERE IS AN [x] OCCURANCE 96659 "RTN","C0CDOM",77,0) 96660 . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE 96661 "RTN","C0CDOM",78,0) 96662 . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X] 96663 "RTN","C0CDOM",79,0) 96664 I ZZJ'="" D ; TIME TO ADD THE VALUE 96665 "RTN","C0CDOM",80,0) 96666 . S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE 96667 "RTN","C0CDOM",81,0) 96650 96668 Q 96651 "RTN","C0CDOM",65,0)96652 ;96653 "RTN","C0CDOM",66,0)96654 ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY96655 "RTN","C0CDOM",67,0)96656 ;96657 "RTN","C0CDOM",68,0)96658 ; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES96659 "RTN","C0CDOM",69,0)96660 ;96661 "RTN","C0CDOM",70,0)96662 N ZZI,ZZJ,ZZN96663 "RTN","C0CDOM",71,0)96664 S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY96665 "RTN","C0CDOM",72,0)96666 I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE96667 "RTN","C0CDOM",73,0)96668 S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY96669 "RTN","C0CDOM",74,0)96670 S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .96671 "RTN","C0CDOM",75,0)96672 I ZZI'["]" D ; A SINGLETON96673 "RTN","C0CDOM",76,0)96674 . S ZZN=196675 "RTN","C0CDOM",77,0)96676 E D ; THERE IS AN [x] OCCURANCE96677 "RTN","C0CDOM",78,0)96678 . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE96679 "RTN","C0CDOM",79,0)96680 . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]96681 "RTN","C0CDOM",80,0)96682 I ZZJ'="" D ; TIME TO ADD THE VALUE96683 "RTN","C0CDOM",81,0)96684 . S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE96685 96669 "RTN","C0CDOM",82,0) 96670 ; 96671 "RTN","C0CDOM",83,0) 96672 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME 96673 "RTN","C0CDOM",84,0) 96674 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW 96675 "RTN","C0CDOM",85,0) 96676 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML 96677 "RTN","C0CDOM",86,0) 96678 ;Q $$EN^MXMLDOM(INXML) 96679 "RTN","C0CDOM",87,0) 96680 Q $$EN^MXMLDOM(INXML,"W") 96681 "RTN","C0CDOM",88,0) 96682 ; 96683 "RTN","C0CDOM",89,0) 96684 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE 96685 "RTN","C0CDOM",90,0) 96686 N ZN 96687 "RTN","C0CDOM",91,0) 96688 ;I $$TAG(ZOID)["entry" B 96689 "RTN","C0CDOM",92,0) 96690 S ZN=$$NXTSIB(ZOID) 96691 "RTN","C0CDOM",93,0) 96692 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG 96693 "RTN","C0CDOM",94,0) 96694 Q 0 96695 "RTN","C0CDOM",95,0) 96696 ; 96697 "RTN","C0CDOM",96,0) 96698 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID 96699 "RTN","C0CDOM",97,0) 96700 Q $$CHILD^MXMLDOM(C0CDOCID,ZOID) 96701 "RTN","C0CDOM",98,0) 96702 ; 96703 "RTN","C0CDOM",99,0) 96704 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID 96705 "RTN","C0CDOM",100,0) 96706 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID) 96707 "RTN","C0CDOM",101,0) 96708 ; 96709 "RTN","C0CDOM",102,0) 96710 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID 96711 "RTN","C0CDOM",103,0) 96712 S HANDLE=C0CDOCID 96713 "RTN","C0CDOM",104,0) 96714 K @RTN 96715 "RTN","C0CDOM",105,0) 96716 D GETTXT^MXMLDOM("A") 96717 "RTN","C0CDOM",106,0) 96686 96718 Q 96687 "RTN","C0CDOM",83,0)96688 ;96689 "RTN","C0CDOM",84,0)96690 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME96691 "RTN","C0CDOM",85,0)96692 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW96693 "RTN","C0CDOM",86,0)96694 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML96695 "RTN","C0CDOM",87,0)96696 ;Q $$EN^MXMLDOM(INXML)96697 "RTN","C0CDOM",88,0)96698 Q $$EN^MXMLDOM(INXML,"W")96699 "RTN","C0CDOM",89,0)96700 ;96701 "RTN","C0CDOM",90,0)96702 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE96703 "RTN","C0CDOM",91,0)96704 N ZN96705 "RTN","C0CDOM",92,0)96706 ;I $$TAG(ZOID)["entry" B96707 "RTN","C0CDOM",93,0)96708 S ZN=$$NXTSIB(ZOID)96709 "RTN","C0CDOM",94,0)96710 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG96711 "RTN","C0CDOM",95,0)96712 Q 096713 "RTN","C0CDOM",96,0)96714 ;96715 "RTN","C0CDOM",97,0)96716 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID96717 "RTN","C0CDOM",98,0)96718 Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)96719 "RTN","C0CDOM",99,0)96720 ;96721 "RTN","C0CDOM",100,0)96722 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID96723 "RTN","C0CDOM",101,0)96724 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)96725 "RTN","C0CDOM",102,0)96726 ;96727 "RTN","C0CDOM",103,0)96728 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID96729 "RTN","C0CDOM",104,0)96730 S HANDLE=C0CDOCID96731 "RTN","C0CDOM",105,0)96732 K @RTN96733 "RTN","C0CDOM",106,0)96734 D GETTXT^MXMLDOM("A")96735 96719 "RTN","C0CDOM",107,0) 96720 ; 96721 "RTN","C0CDOM",108,0) 96722 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE 96723 "RTN","C0CDOM",109,0) 96724 ;I ZOID=149 B ;GPLTEST 96725 "RTN","C0CDOM",110,0) 96726 N X,Y 96727 "RTN","C0CDOM",111,0) 96728 S Y="" 96729 "RTN","C0CDOM",112,0) 96730 S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE 96731 "RTN","C0CDOM",113,0) 96732 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y 96733 "RTN","C0CDOM",114,0) 96734 I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID) 96735 "RTN","C0CDOM",115,0) 96736 Q Y 96737 "RTN","C0CDOM",116,0) 96738 ; 96739 "RTN","C0CDOM",117,0) 96740 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING 96741 "RTN","C0CDOM",118,0) 96742 Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID) 96743 "RTN","C0CDOM",119,0) 96744 ; 96745 "RTN","C0CDOM",120,0) 96746 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE 96747 "RTN","C0CDOM",121,0) 96748 ;N ZT,ZN S ZT="" 96749 "RTN","C0CDOM",122,0) 96750 ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 96751 "RTN","C0CDOM",123,0) 96752 ;Q $G(@C0CDOM@(ZOID,"T",1)) 96753 "RTN","C0CDOM",124,0) 96754 S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT) 96755 "RTN","C0CDOM",125,0) 96736 96756 Q 96737 "RTN","C0CDOM",108,0)96738 ;96739 "RTN","C0CDOM",109,0)96740 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE96741 "RTN","C0CDOM",110,0)96742 ;I ZOID=149 B ;GPLTEST96743 "RTN","C0CDOM",111,0)96744 N X,Y96745 "RTN","C0CDOM",112,0)96746 S Y=""96747 "RTN","C0CDOM",113,0)96748 S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE96749 "RTN","C0CDOM",114,0)96750 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y96751 "RTN","C0CDOM",115,0)96752 I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)96753 "RTN","C0CDOM",116,0)96754 Q Y96755 "RTN","C0CDOM",117,0)96756 ;96757 "RTN","C0CDOM",118,0)96758 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING96759 "RTN","C0CDOM",119,0)96760 Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)96761 "RTN","C0CDOM",120,0)96762 ;96763 "RTN","C0CDOM",121,0)96764 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE96765 "RTN","C0CDOM",122,0)96766 ;N ZT,ZN S ZT=""96767 "RTN","C0CDOM",123,0)96768 ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))96769 "RTN","C0CDOM",124,0)96770 ;Q $G(@C0CDOM@(ZOID,"T",1))96771 "RTN","C0CDOM",125,0)96772 S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)96773 96757 "RTN","C0CDOM",126,0) 96758 ; 96759 "RTN","C0CDOM",127,0) 96760 OUTXML(ZRTN,INID,NO1ST) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM 96761 "RTN","C0CDOM",128,0) 96762 ; 96763 "RTN","C0CDOM",129,0) 96764 S C0CDOCID=INID 96765 "RTN","C0CDOM",130,0) 96766 I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE <?xml tag generation 96767 "RTN","C0CDOM",131,0) 96768 D START^C0CMXMLB($$TAG(1),,"G",NO1ST) 96769 "RTN","C0CDOM",132,0) 96770 D NDOUT($$FIRST(1)) 96771 "RTN","C0CDOM",133,0) 96772 D END^C0CMXMLB ;END THE DOCUMENT 96773 "RTN","C0CDOM",134,0) 96774 M @ZRTN=^TMP("MXMLBLD",$J) 96775 "RTN","C0CDOM",135,0) 96776 K ^TMP("MXMLBLD",$J) 96777 "RTN","C0CDOM",136,0) 96774 96778 Q 96775 "RTN","C0CDOM",127,0)96776 ;96777 "RTN","C0CDOM",128,0)96778 OUTXML(ZRTN,INID,NO1ST) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM96779 "RTN","C0CDOM",129,0)96780 ;96781 "RTN","C0CDOM",130,0)96782 S C0CDOCID=INID96783 "RTN","C0CDOM",131,0)96784 I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE <?xml tag generation96785 "RTN","C0CDOM",132,0)96786 D START^C0CMXMLB($$TAG(1),,"G",NO1ST)96787 "RTN","C0CDOM",133,0)96788 D NDOUT($$FIRST(1))96789 "RTN","C0CDOM",134,0)96790 D END^C0CMXMLB ;END THE DOCUMENT96791 "RTN","C0CDOM",135,0)96792 M @ZRTN=^TMP("MXMLBLD",$J)96793 "RTN","C0CDOM",136,0)96794 K ^TMP("MXMLBLD",$J)96795 96779 "RTN","C0CDOM",137,0) 96780 ; 96781 "RTN","C0CDOM",138,0) 96782 NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE 96783 "RTN","C0CDOM",139,0) 96784 N ZI S ZI=$$FIRST(ZOID) 96785 "RTN","C0CDOM",140,0) 96786 I ZI'=0 D ; THERE IS A CHILD 96787 "RTN","C0CDOM",141,0) 96788 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT 96789 "RTN","C0CDOM",142,0) 96790 . D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN 96791 "RTN","C0CDOM",143,0) 96792 E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT 96793 "RTN","C0CDOM",144,0) 96794 . ;W "DOING",ZOID,! 96795 "RTN","C0CDOM",145,0) 96796 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA 96797 "RTN","C0CDOM",146,0) 96798 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES 96799 "RTN","C0CDOM",147,0) 96800 . D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN 96801 "RTN","C0CDOM",148,0) 96802 I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING 96803 "RTN","C0CDOM",149,0) 96804 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS 96805 "RTN","C0CDOM",150,0) 96796 96806 Q 96797 "RTN","C0CDOM",138,0)96798 ;96799 "RTN","C0CDOM",139,0)96800 NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE96801 "RTN","C0CDOM",140,0)96802 N ZI S ZI=$$FIRST(ZOID)96803 "RTN","C0CDOM",141,0)96804 I ZI'=0 D ; THERE IS A CHILD96805 "RTN","C0CDOM",142,0)96806 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT96807 "RTN","C0CDOM",143,0)96808 . D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN96809 "RTN","C0CDOM",144,0)96810 E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT96811 "RTN","C0CDOM",145,0)96812 . ;W "DOING",ZOID,!96813 "RTN","C0CDOM",146,0)96814 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA96815 "RTN","C0CDOM",147,0)96816 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES96817 "RTN","C0CDOM",148,0)96818 . D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN96819 "RTN","C0CDOM",149,0)96820 I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING96821 "RTN","C0CDOM",150,0)96822 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS96823 96807 "RTN","C0CDOM",151,0) 96808 ; 96809 "RTN","C0CDOM",152,0) 96810 WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE 96811 "RTN","C0CDOM",153,0) 96812 ; 96813 "RTN","C0CDOM",154,0) 96814 N GN,GN2 96815 "RTN","C0CDOM",155,0) 96816 D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML 96817 "RTN","C0CDOM",156,0) 96818 S GN2=$NA(@GN@(1)) 96819 "RTN","C0CDOM",157,0) 96820 W $$OUTPUT^C0CXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/") 96821 "RTN","C0CDOM",158,0) 96824 96822 Q 96825 "RTN","C0CDOM",152,0)96826 ;96827 "RTN","C0CDOM",153,0)96828 WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE96829 "RTN","C0CDOM",154,0)96830 ;96831 "RTN","C0CDOM",155,0)96832 N GN,GN296833 "RTN","C0CDOM",156,0)96834 D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML96835 "RTN","C0CDOM",157,0)96836 S GN2=$NA(@GN@(1))96837 "RTN","C0CDOM",158,0)96838 W $$OUTPUT^C0CXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")96839 96823 "RTN","C0CDOM",159,0) 96824 ; 96825 "RTN","C0CDOM",160,0) 96826 NARY2XML(ZGOUT,ZGIN) ; CREATE XML FROM AN NHIN ARRAY 96827 "RTN","C0CDOM",161,0) 96828 ; ZGOUT AND ZGIN ARE PASSED BY NAME 96829 "RTN","C0CDOM",162,0) 96830 N C0CDOCID 96831 "RTN","C0CDOM",163,0) 96832 W !,ZGOUT," ",ZGIN 96833 "RTN","C0CDOM",164,0) 96834 S C0CDOCID=$$DOMI(ZGIN) ; PUT IT INTO THE DOM 96835 "RTN","C0CDOM",165,0) 96836 D OUTXML(ZGOUT,C0CDOCID) 96837 "RTN","C0CDOM",166,0) 96840 96838 Q 96841 "RTN","C0CDOM",160,0)96842 ;96843 "RTN","C0CDOM",161,0)96844 NARY2XML(ZGOUT,ZGIN) ; CREATE XML FROM AN NHIN ARRAY96845 "RTN","C0CDOM",162,0)96846 ; ZGOUT AND ZGIN ARE PASSED BY NAME96847 "RTN","C0CDOM",163,0)96848 N C0CDOCID96849 "RTN","C0CDOM",164,0)96850 W !,ZGOUT," ",ZGIN96851 "RTN","C0CDOM",165,0)96852 S C0CDOCID=$$DOMI(ZGIN) ; PUT IT INTO THE DOM96853 "RTN","C0CDOM",166,0)96854 D OUTXML(ZGOUT,C0CDOCID)96855 96839 "RTN","C0CDOM",167,0) 96840 ; 96841 "RTN","C0CDOM",168,0) 96842 ; EXAMPLE OF NHIN ARRAY FORMAT - THIS IS AN OUTPUT OF DOMO ABOVE WHEN RUN 96843 "RTN","C0CDOM",169,0) 96844 ; AGAINST THE OUTPUT OF THE GET^NHINV ROUTINE. (THIS IS NOT REAL PATIENT DATA) 96845 "RTN","C0CDOM",170,0) 96846 ; 96847 "RTN","C0CDOM",171,0) 96848 ;GNARY("med",1,"doses.dose@dose")=10 96849 "RTN","C0CDOM",172,0) 96850 ;GNARY("med",1,"doses.dose@noun")="TABLET" 96851 "RTN","C0CDOM",173,0) 96852 ;GNARY("med",1,"doses.dose@route")="PO" 96853 "RTN","C0CDOM",174,0) 96854 ;GNARY("med",1,"doses.dose@schedule")="QD" 96855 "RTN","C0CDOM",175,0) 96856 ;GNARY("med",1,"doses.dose@units")="MG" 96857 "RTN","C0CDOM",176,0) 96858 ;GNARY("med",1,"doses.dose@unitsPerDose")=1 96859 "RTN","C0CDOM",177,0) 96860 ;GNARY("med",1,"facility@code")=100 96861 "RTN","C0CDOM",178,0) 96862 ;GNARY("med",1,"facility@name")="VOE OFFICE INSTITUTION" 96863 "RTN","C0CDOM",179,0) 96864 ;GNARY("med",1,"form@value")="TAB" 96865 "RTN","C0CDOM",180,0) 96866 ;GNARY("med",1,"id@value")="1N;O" 96867 "RTN","C0CDOM",181,0) 96868 ;GNARY("med",1,"location@code")=5 96869 "RTN","C0CDOM",182,0) 96870 ;GNARY("med",1,"location@name")="3 WEST" 96871 "RTN","C0CDOM",183,0) 96872 ;GNARY("med",1,"name@value")="LISINOPRIL TAB" 96873 "RTN","C0CDOM",184,0) 96874 ;GNARY("med",1,"orderID@value")=294 96875 "RTN","C0CDOM",185,0) 96876 ;GNARY("med",1,"ordered@value")=3110531.001233 96877 "RTN","C0CDOM",186,0) 96878 ;GNARY("med",1,"orderingProvider@code")=63 96879 "RTN","C0CDOM",187,0) 96880 ;GNARY("med",1,"orderingProvider@name")="KING,MATTHEW MICHAEL" 96881 "RTN","C0CDOM",188,0) 96882 ;GNARY("med",1,"products.product.class@code")="ACE INHIBITORS" 96883 "RTN","C0CDOM",189,0) 96884 ;GNARY("med",1,"products.product.vaGeneric@code")=1990 96885 "RTN","C0CDOM",190,0) 96886 ;GNARY("med",1,"products.product.vaGeneric@name")="LISINOPRIL" 96887 "RTN","C0CDOM",191,0) 96888 ;GNARY("med",1,"products.product.vaGeneric@vuid")=4019380 96889 "RTN","C0CDOM",192,0) 96890 ;GNARY("med",1,"products.product.vaProduct@code")=8118 96891 "RTN","C0CDOM",193,0) 96892 ;GNARY("med",1,"products.product.vaProduct@name")="LISINOPRIL 10MG TAB" 96893 "RTN","C0CDOM",194,0) 96894 ;GNARY("med",1,"products.product.vaProduct@vuid")=4008593 96895 "RTN","C0CDOM",195,0) 96896 ;GNARY("med",1,"products.product@code")=6174 96897 "RTN","C0CDOM",196,0) 96898 ;GNARY("med",1,"products.product@name")="LISINOPRIL 10MG U/D" 96899 "RTN","C0CDOM",197,0) 96900 ;GNARY("med",1,"products.product@role")="D" 96901 "RTN","C0CDOM",198,0) 96902 ;GNARY("med",1,"sig")="10MG BY MOUTH EVERY DAY" 96903 "RTN","C0CDOM",199,0) 96904 ;GNARY("med",1,"sig@xml:space")="preserve" 96905 "RTN","C0CDOM",200,0) 96906 ;GNARY("med",1,"status@value")="active" 96907 "RTN","C0CDOM",201,0) 96908 ;GNARY("med",1,"type@value")="OTC" 96909 "RTN","C0CDOM",202,0) 96910 ;GNARY("med",1,"vaType@value")="N" 96911 "RTN","C0CDOM",203,0) 96912 ; 96913 "RTN","C0CDOM",204,0) 96914 ; DOMI is an extrinsic to insert NHIN ARRAY FORMAT arrays into the DOM 96915 "RTN","C0CDOM",205,0) 96916 ; it returns 0 or 1 based on success. 96917 "RTN","C0CDOM",206,0) 96918 ; 96919 "RTN","C0CDOM",207,0) 96920 ; INARY is passed by name and has the format shown above 96921 "RTN","C0CDOM",208,0) 96922 ; HANDLE is the document number in the DOM (both MXML and EWD DOMs will 96923 "RTN","C0CDOM",209,0) 96924 ; be supported eventually - initial implementation is for MXML 96925 "RTN","C0CDOM",210,0) 96926 ; 96927 "RTN","C0CDOM",211,0) 96928 ; PARENT is the node id or tag of the parent under which the DOM will 96929 "RTN","C0CDOM",212,0) 96930 ; be populated. If it is numeric, it is a node. If it is a string, the DOM 96931 "RTN","C0CDOM",213,0) 96932 ; will be searched to find the tag. If not found and there is no root, 96933 "RTN","C0CDOM",214,0) 96934 ; it will be inserted as the root. If not found and there is a root, it 96935 "RTN","C0CDOM",215,0) 96936 ; will be inserted under the root. 96937 "RTN","C0CDOM",216,0) 96938 ; 96939 "RTN","C0CDOM",217,0) 96940 ; For the above example the call would be OK=$$DOMI("GNARY",0,"results") 96941 "RTN","C0CDOM",218,0) 96942 ; because "results" is the root tag. Use OUTXML to render the xml from 96943 "RTN","C0CDOM",219,0) 96944 ; the DOM. 96945 "RTN","C0CDOM",220,0) 96946 ; 96947 "RTN","C0CDOM",221,0) 96948 DOMI(INARY,HANDLE,PARENT) ; EXTRINSIC TO INSERT NHIN ARRAYS TO A DOM 96949 "RTN","C0CDOM",222,0) 96950 ; 96951 "RTN","C0CDOM",223,0) 96952 N ZPARNODE 96953 "RTN","C0CDOM",224,0) 96954 S (SUCCESS,LEVEL,LEVEL(0),NODE)=0 96955 "RTN","C0CDOM",225,0) 96956 I '$D(INARY) Q 0 ; NO ARRAY PASSED 96957 "RTN","C0CDOM",226,0) 96958 I '$D(HANDLE) S HANDLE=$$NEWDOM() ; MAKE A NEW DOM 96959 "RTN","C0CDOM",227,0) 96960 ;I PARENT="" S PARENT="root" 96961 "RTN","C0CDOM",228,0) 96962 I +$G(PARENT)>0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID 96963 "RTN","C0CDOM",229,0) 96964 E I $L($G(PARENT))>0 D ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL 96965 "RTN","C0CDOM",230,0) 96966 . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE 96967 "RTN","C0CDOM",231,0) 96968 . S ZPARNODE=1 ; 96969 "RTN","C0CDOM",232,0) 96970 ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET 96971 "RTN","C0CDOM",233,0) 96972 N ZEXARY 96973 "RTN","C0CDOM",234,0) 96974 D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY 96975 "RTN","C0CDOM",235,0) 96976 D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED 96977 "RTN","C0CDOM",236,0) 96978 I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE 96979 "RTN","C0CDOM",237,0) 96980 Q HANDLE ; SUCCESS 96981 "RTN","C0CDOM",238,0) 96982 ; 96983 "RTN","C0CDOM",239,0) 96984 MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES 96985 "RTN","C0CDOM",240,0) 96986 N ZI S ZI="" 96987 "RTN","C0CDOM",241,0) 96988 N ZTAG 96989 "RTN","C0CDOM",242,0) 96990 F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH SECTION 96991 "RTN","C0CDOM",243,0) 96992 . N ZELEADD S ZELEADD=0 96993 "RTN","C0CDOM",244,0) 96994 . I ZI["@" D ; END NODE HAS NO VALUE, ONLY ATTRIBUTES 96995 "RTN","C0CDOM",245,0) 96996 . . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG 96997 "RTN","C0CDOM",246,0) 96998 . . K ZATT ; CLEAR OUT LAST ONE 96999 "RTN","C0CDOM",247,0) 97000 . . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY 97001 "RTN","C0CDOM",248,0) 97002 . . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE 97003 "RTN","C0CDOM",249,0) 97004 . . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE 97005 "RTN","C0CDOM",250,0) 97006 . I $O(@ZARY@(ZI,""))="" D ;END NODE 97007 "RTN","C0CDOM",251,0) 97008 . . S ZTAG=ZI ; USE ZI FOR THE TAG 97009 "RTN","C0CDOM",252,0) 97010 . . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE 97011 "RTN","C0CDOM",253,0) 97012 . . S ZELEADD=1 ; ADDED AN ELEMENT 97013 "RTN","C0CDOM",254,0) 97014 . . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE 97015 "RTN","C0CDOM",255,0) 97016 . I ZELEADD D Q ; NO MORE TO DO ON THIS LEVEL 97017 "RTN","C0CDOM",256,0) 97018 . . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING 97019 "RTN","C0CDOM",257,0) 97020 . N NEWARY ; INDENTED ARRAY 97021 "RTN","C0CDOM",258,0) 97022 . N ZN S ZN=0 97023 "RTN","C0CDOM",259,0) 97024 . F S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN="" D ; FOR EACH MULTIPLE 97025 "RTN","C0CDOM",260,0) 97026 . . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG 97027 "RTN","C0CDOM",261,0) 97028 . . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY 97029 "RTN","C0CDOM",262,0) 97030 . . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY 97031 "RTN","C0CDOM",263,0) 97032 . . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG 97033 "RTN","C0CDOM",264,0) 96856 97034 Q 96857 "RTN","C0CDOM",168,0)96858 ;96859 "RTN","C0CDOM",169,0)96860 ; EXAMPLE OF NHIN ARRAY FORMAT - THIS IS AN OUTPUT OF DOMO ABOVE WHEN RUN96861 "RTN","C0CDOM",170,0)96862 ; AGAINST THE OUTPUT OF THE GET^NHINV ROUTINE. (THIS IS NOT REAL PATIENT DATA)96863 "RTN","C0CDOM",171,0)96864 ;96865 "RTN","C0CDOM",172,0)96866 ;GNARY("med",1,"doses.dose@dose")=1096867 "RTN","C0CDOM",173,0)96868 ;GNARY("med",1,"doses.dose@noun")="TABLET"96869 "RTN","C0CDOM",174,0)96870 ;GNARY("med",1,"doses.dose@route")="PO"96871 "RTN","C0CDOM",175,0)96872 ;GNARY("med",1,"doses.dose@schedule")="QD"96873 "RTN","C0CDOM",176,0)96874 ;GNARY("med",1,"doses.dose@units")="MG"96875 "RTN","C0CDOM",177,0)96876 ;GNARY("med",1,"doses.dose@unitsPerDose")=196877 "RTN","C0CDOM",178,0)96878 ;GNARY("med",1,"facility@code")=10096879 "RTN","C0CDOM",179,0)96880 ;GNARY("med",1,"facility@name")="VOE OFFICE INSTITUTION"96881 "RTN","C0CDOM",180,0)96882 ;GNARY("med",1,"form@value")="TAB"96883 "RTN","C0CDOM",181,0)96884 ;GNARY("med",1,"id@value")="1N;O"96885 "RTN","C0CDOM",182,0)96886 ;GNARY("med",1,"location@code")=596887 "RTN","C0CDOM",183,0)96888 ;GNARY("med",1,"location@name")="3 WEST"96889 "RTN","C0CDOM",184,0)96890 ;GNARY("med",1,"name@value")="LISINOPRIL TAB"96891 "RTN","C0CDOM",185,0)96892 ;GNARY("med",1,"orderID@value")=29496893 "RTN","C0CDOM",186,0)96894 ;GNARY("med",1,"ordered@value")=3110531.00123396895 "RTN","C0CDOM",187,0)96896 ;GNARY("med",1,"orderingProvider@code")=6396897 "RTN","C0CDOM",188,0)96898 ;GNARY("med",1,"orderingProvider@name")="KING,MATTHEW MICHAEL"96899 "RTN","C0CDOM",189,0)96900 ;GNARY("med",1,"products.product.class@code")="ACE INHIBITORS"96901 "RTN","C0CDOM",190,0)96902 ;GNARY("med",1,"products.product.vaGeneric@code")=199096903 "RTN","C0CDOM",191,0)96904 ;GNARY("med",1,"products.product.vaGeneric@name")="LISINOPRIL"96905 "RTN","C0CDOM",192,0)96906 ;GNARY("med",1,"products.product.vaGeneric@vuid")=401938096907 "RTN","C0CDOM",193,0)96908 ;GNARY("med",1,"products.product.vaProduct@code")=811896909 "RTN","C0CDOM",194,0)96910 ;GNARY("med",1,"products.product.vaProduct@name")="LISINOPRIL 10MG TAB"96911 "RTN","C0CDOM",195,0)96912 ;GNARY("med",1,"products.product.vaProduct@vuid")=400859396913 "RTN","C0CDOM",196,0)96914 ;GNARY("med",1,"products.product@code")=617496915 "RTN","C0CDOM",197,0)96916 ;GNARY("med",1,"products.product@name")="LISINOPRIL 10MG U/D"96917 "RTN","C0CDOM",198,0)96918 ;GNARY("med",1,"products.product@role")="D"96919 "RTN","C0CDOM",199,0)96920 ;GNARY("med",1,"sig")="10MG BY MOUTH EVERY DAY"96921 "RTN","C0CDOM",200,0)96922 ;GNARY("med",1,"sig@xml:space")="preserve"96923 "RTN","C0CDOM",201,0)96924 ;GNARY("med",1,"status@value")="active"96925 "RTN","C0CDOM",202,0)96926 ;GNARY("med",1,"type@value")="OTC"96927 "RTN","C0CDOM",203,0)96928 ;GNARY("med",1,"vaType@value")="N"96929 "RTN","C0CDOM",204,0)96930 ;96931 "RTN","C0CDOM",205,0)96932 ; DOMI is an extrinsic to insert NHIN ARRAY FORMAT arrays into the DOM96933 "RTN","C0CDOM",206,0)96934 ; it returns 0 or 1 based on success.96935 "RTN","C0CDOM",207,0)96936 ;96937 "RTN","C0CDOM",208,0)96938 ; INARY is passed by name and has the format shown above96939 "RTN","C0CDOM",209,0)96940 ; HANDLE is the document number in the DOM (both MXML and EWD DOMs will96941 "RTN","C0CDOM",210,0)96942 ; be supported eventually - initial implementation is for MXML96943 "RTN","C0CDOM",211,0)96944 ;96945 "RTN","C0CDOM",212,0)96946 ; PARENT is the node id or tag of the parent under which the DOM will96947 "RTN","C0CDOM",213,0)96948 ; be populated. If it is numeric, it is a node. If it is a string, the DOM96949 "RTN","C0CDOM",214,0)96950 ; will be searched to find the tag. If not found and there is no root,96951 "RTN","C0CDOM",215,0)96952 ; it will be inserted as the root. If not found and there is a root, it96953 "RTN","C0CDOM",216,0)96954 ; will be inserted under the root.96955 "RTN","C0CDOM",217,0)96956 ;96957 "RTN","C0CDOM",218,0)96958 ; For the above example the call would be OK=$$DOMI("GNARY",0,"results")96959 "RTN","C0CDOM",219,0)96960 ; because "results" is the root tag. Use OUTXML to render the xml from96961 "RTN","C0CDOM",220,0)96962 ; the DOM.96963 "RTN","C0CDOM",221,0)96964 ;96965 "RTN","C0CDOM",222,0)96966 DOMI(INARY,HANDLE,PARENT) ; EXTRINSIC TO INSERT NHIN ARRAYS TO A DOM96967 "RTN","C0CDOM",223,0)96968 ;96969 "RTN","C0CDOM",224,0)96970 N ZPARNODE96971 "RTN","C0CDOM",225,0)96972 S (SUCCESS,LEVEL,LEVEL(0),NODE)=096973 "RTN","C0CDOM",226,0)96974 I '$D(INARY) Q 0 ; NO ARRAY PASSED96975 "RTN","C0CDOM",227,0)96976 I '$D(HANDLE) S HANDLE=$$NEWDOM() ; MAKE A NEW DOM96977 "RTN","C0CDOM",228,0)96978 ;I PARENT="" S PARENT="root"96979 "RTN","C0CDOM",229,0)96980 I +$G(PARENT)>0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID96981 "RTN","C0CDOM",230,0)96982 E I $L($G(PARENT))>0 D ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL96983 "RTN","C0CDOM",231,0)96984 . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE96985 "RTN","C0CDOM",232,0)96986 . S ZPARNODE=1 ;96987 "RTN","C0CDOM",233,0)96988 ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET96989 "RTN","C0CDOM",234,0)96990 N ZEXARY96991 "RTN","C0CDOM",235,0)96992 D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY96993 "RTN","C0CDOM",236,0)96994 D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED96995 "RTN","C0CDOM",237,0)96996 I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE96997 "RTN","C0CDOM",238,0)96998 Q HANDLE ; SUCCESS96999 "RTN","C0CDOM",239,0)97000 ;97001 "RTN","C0CDOM",240,0)97002 MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES97003 "RTN","C0CDOM",241,0)97004 N ZI S ZI=""97005 "RTN","C0CDOM",242,0)97006 N ZTAG97007 "RTN","C0CDOM",243,0)97008 F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH SECTION97009 "RTN","C0CDOM",244,0)97010 . N ZELEADD S ZELEADD=097011 "RTN","C0CDOM",245,0)97012 . I ZI["@" D ; END NODE HAS NO VALUE, ONLY ATTRIBUTES97013 "RTN","C0CDOM",246,0)97014 . . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG97015 "RTN","C0CDOM",247,0)97016 . . K ZATT ; CLEAR OUT LAST ONE97017 "RTN","C0CDOM",248,0)97018 . . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY97019 "RTN","C0CDOM",249,0)97020 . . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE97021 "RTN","C0CDOM",250,0)97022 . . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE97023 "RTN","C0CDOM",251,0)97024 . I $O(@ZARY@(ZI,""))="" D ;END NODE97025 "RTN","C0CDOM",252,0)97026 . . S ZTAG=ZI ; USE ZI FOR THE TAG97027 "RTN","C0CDOM",253,0)97028 . . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE97029 "RTN","C0CDOM",254,0)97030 . . S ZELEADD=1 ; ADDED AN ELEMENT97031 "RTN","C0CDOM",255,0)97032 . . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE97033 "RTN","C0CDOM",256,0)97034 . I ZELEADD D Q ; NO MORE TO DO ON THIS LEVEL97035 "RTN","C0CDOM",257,0)97036 . . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING97037 "RTN","C0CDOM",258,0)97038 . N NEWARY ; INDENTED ARRAY97039 "RTN","C0CDOM",259,0)97040 . N ZN S ZN=097041 "RTN","C0CDOM",260,0)97042 . F S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN="" D ; FOR EACH MULTIPLE97043 "RTN","C0CDOM",261,0)97044 . . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG97045 "RTN","C0CDOM",262,0)97046 . . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY97047 "RTN","C0CDOM",263,0)97048 . . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY97049 "RTN","C0CDOM",264,0)97050 . . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG97051 97035 "RTN","C0CDOM",265,0) 97036 ; 97037 "RTN","C0CDOM",266,0) 97038 EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED 97039 "RTN","C0CDOM",267,0) 97040 ; CONSISTENT FORMAT 97041 "RTN","C0CDOM",268,0) 97042 ; GNARY("patient",1,"facilities[2].facility@code")="050" 97043 "RTN","C0CDOM",269,0) 97044 ; becomes G2ARY("patient",1,"facilities",2,"facility@",1,"code")="050" 97045 "RTN","C0CDOM",270,0) 97046 ; for easier processing (this is fileman format genius) 97047 "RTN","C0CDOM",271,0) 97048 ; basically removes the dot notation from the strings 97049 "RTN","C0CDOM",272,0) 97050 ; 97051 "RTN","C0CDOM",273,0) 97052 N ZZI 97053 "RTN","C0CDOM",274,0) 97054 S ZZI="" 97055 "RTN","C0CDOM",275,0) 97056 F S ZZI=$O(@ZZIN@(ZZI)) Q:ZZI="" D ; 97057 "RTN","C0CDOM",276,0) 97058 . N ZZN S ZZN=0 97059 "RTN","C0CDOM",277,0) 97060 . F S ZZN=$O(@ZZIN@(ZZI,ZZN)) Q:ZZN="" D ; 97061 "RTN","C0CDOM",278,0) 97062 . . N ZZS S ZZS="" 97063 "RTN","C0CDOM",279,0) 97064 . . N GA ;PUSH STACK 97065 "RTN","C0CDOM",280,0) 97066 . . F S ZZS=$O(@ZZIN@(ZZI,ZZN,ZZS)) Q:ZZS="" D ; 97067 "RTN","C0CDOM",281,0) 97068 . . . K GA ; NEW STACK 97069 "RTN","C0CDOM",282,0) 97070 . . . D PUSH^C0CXPATH("GA",ZZI_"^"_ZZN) ; PUSH PARENT 97071 "RTN","C0CDOM",283,0) 97072 . . . N ZZV ; PLACE TO STASH THE VALUE 97073 "RTN","C0CDOM",284,0) 97074 . . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE 97075 "RTN","C0CDOM",285,0) 97076 . . . W !,"VALUE:",ZZV 97077 "RTN","C0CDOM",286,0) 97078 . . . N GK ; COUNTER 97079 "RTN","C0CDOM",287,0) 97080 . . . F GK=1:1:$L(ZZS,".") D ; FOR EACH INTERMEDIATE NODE 97081 "RTN","C0CDOM",288,0) 97082 . . . . N ZZN2 S ZZN2=1 ; DEFAULT IF NO [X] 97083 "RTN","C0CDOM",289,0) 97084 . . . . N GM S GM=$P(ZZS,".",GK) ; TAG 97085 "RTN","C0CDOM",290,0) 97086 . . . . I GM["[" D ; IT'S A MULTIPLE 97087 "RTN","C0CDOM",291,0) 97088 . . . . . S ZZN2=$P($P(GM,"[",2),"]",1) ; PULL OUT THE NUMBER 97089 "RTN","C0CDOM",292,0) 97090 . . . . . S GM=$P(GM,"[",1) ; PULL OUT THE TAG 97091 "RTN","C0CDOM",293,0) 97092 . . . . I GM["@" D ; IT'S GOT ATTRIBUTES 97093 "RTN","C0CDOM",294,0) 97094 . . . . . N GM2 S GM2=$P(GM,"@",2) ; PULLOUT THE ATTRIBUTE NAME 97095 "RTN","C0CDOM",295,0) 97096 . . . . . D PUSH^C0CXPATH("GA",$P(GM,"@",1)_"@"_"^"_ZZN2) ; PUSH THE TAG 97097 "RTN","C0CDOM",296,0) 97098 . . . . . D PUSH^C0CXPATH("GA",GM2_"^"_ZZN2) 97099 "RTN","C0CDOM",297,0) 97100 . . . . E D PUSH^C0CXPATH("GA",GM_"^"_ZZN2) ; 97101 "RTN","C0CDOM",298,0) 97102 . . . S GA(GA(0))=$P(GA(GA(0)),"^",1)_"^" ; GET RID OF THE LAST "1" 97103 "RTN","C0CDOM",299,0) 97104 . . . N GZI S GZI="" ; STRING FOR THE INDEX 97105 "RTN","C0CDOM",300,0) 97106 . . . F GK=1:1:GA(0) D ; TIME TO REVERSE POP THE TAGS 97107 "RTN","C0CDOM",301,0) 97108 . . . . S GM=$P(GA(GK),"^",1) ; THE TAG 97109 "RTN","C0CDOM",302,0) 97110 . . . . S ZZN2=$P(GA(GK),"^",2) ; THE NUMBER IF ANY 97111 "RTN","C0CDOM",303,0) 97112 . . . . I ZZN2="" S GZI=GZI_""""_GM_"""" ; FOR THE LAST ONE 97113 "RTN","C0CDOM",304,0) 97114 . . . . E S GZI=GZI_""""_GM_""""_","_ZZN2_"," ; FOR THE REST 97115 "RTN","C0CDOM",305,0) 97116 . . . S GZI2=ZZOUT_"("_GZI_")" ; INCLUDE THE ARRAY NAME 97117 "RTN","C0CDOM",306,0) 97118 . . . W !,GZI 97119 "RTN","C0CDOM",307,0) 97120 . . . S @GZI2=ZZV ; REMEMBER THE VALUE? 97121 "RTN","C0CDOM",308,0) 97052 97122 Q 97053 "RTN","C0CDOM",266,0)97054 ;97055 "RTN","C0CDOM",267,0)97056 EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED97057 "RTN","C0CDOM",268,0)97058 ; CONSISTENT FORMAT97059 "RTN","C0CDOM",269,0)97060 ; GNARY("patient",1,"facilities[2].facility@code")="050"97061 "RTN","C0CDOM",270,0)97062 ; becomes G2ARY("patient",1,"facilities",2,"facility@",1,"code")="050"97063 "RTN","C0CDOM",271,0)97064 ; for easier processing (this is fileman format genius)97065 "RTN","C0CDOM",272,0)97066 ; basically removes the dot notation from the strings97067 "RTN","C0CDOM",273,0)97068 ;97069 "RTN","C0CDOM",274,0)97070 N ZZI97071 "RTN","C0CDOM",275,0)97072 S ZZI=""97073 "RTN","C0CDOM",276,0)97074 F S ZZI=$O(@ZZIN@(ZZI)) Q:ZZI="" D ;97075 "RTN","C0CDOM",277,0)97076 . N ZZN S ZZN=097077 "RTN","C0CDOM",278,0)97078 . F S ZZN=$O(@ZZIN@(ZZI,ZZN)) Q:ZZN="" D ;97079 "RTN","C0CDOM",279,0)97080 . . N ZZS S ZZS=""97081 "RTN","C0CDOM",280,0)97082 . . N GA ;PUSH STACK97083 "RTN","C0CDOM",281,0)97084 . . F S ZZS=$O(@ZZIN@(ZZI,ZZN,ZZS)) Q:ZZS="" D ;97085 "RTN","C0CDOM",282,0)97086 . . . K GA ; NEW STACK97087 "RTN","C0CDOM",283,0)97088 . . . D PUSH^C0CXPATH("GA",ZZI_"^"_ZZN) ; PUSH PARENT97089 "RTN","C0CDOM",284,0)97090 . . . N ZZV ; PLACE TO STASH THE VALUE97091 "RTN","C0CDOM",285,0)97092 . . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE97093 "RTN","C0CDOM",286,0)97094 . . . W !,"VALUE:",ZZV97095 "RTN","C0CDOM",287,0)97096 . . . N GK ; COUNTER97097 "RTN","C0CDOM",288,0)97098 . . . F GK=1:1:$L(ZZS,".") D ; FOR EACH INTERMEDIATE NODE97099 "RTN","C0CDOM",289,0)97100 . . . . N ZZN2 S ZZN2=1 ; DEFAULT IF NO [X]97101 "RTN","C0CDOM",290,0)97102 . . . . N GM S GM=$P(ZZS,".",GK) ; TAG97103 "RTN","C0CDOM",291,0)97104 . . . . I GM["[" D ; IT'S A MULTIPLE97105 "RTN","C0CDOM",292,0)97106 . . . . . S ZZN2=$P($P(GM,"[",2),"]",1) ; PULL OUT THE NUMBER97107 "RTN","C0CDOM",293,0)97108 . . . . . S GM=$P(GM,"[",1) ; PULL OUT THE TAG97109 "RTN","C0CDOM",294,0)97110 . . . . I GM["@" D ; IT'S GOT ATTRIBUTES97111 "RTN","C0CDOM",295,0)97112 . . . . . N GM2 S GM2=$P(GM,"@",2) ; PULLOUT THE ATTRIBUTE NAME97113 "RTN","C0CDOM",296,0)97114 . . . . . D PUSH^C0CXPATH("GA",$P(GM,"@",1)_"@"_"^"_ZZN2) ; PUSH THE TAG97115 "RTN","C0CDOM",297,0)97116 . . . . . D PUSH^C0CXPATH("GA",GM2_"^"_ZZN2)97117 "RTN","C0CDOM",298,0)97118 . . . . E D PUSH^C0CXPATH("GA",GM_"^"_ZZN2) ;97119 "RTN","C0CDOM",299,0)97120 . . . S GA(GA(0))=$P(GA(GA(0)),"^",1)_"^" ; GET RID OF THE LAST "1"97121 "RTN","C0CDOM",300,0)97122 . . . N GZI S GZI="" ; STRING FOR THE INDEX97123 "RTN","C0CDOM",301,0)97124 . . . F GK=1:1:GA(0) D ; TIME TO REVERSE POP THE TAGS97125 "RTN","C0CDOM",302,0)97126 . . . . S GM=$P(GA(GK),"^",1) ; THE TAG97127 "RTN","C0CDOM",303,0)97128 . . . . S ZZN2=$P(GA(GK),"^",2) ; THE NUMBER IF ANY97129 "RTN","C0CDOM",304,0)97130 . . . . I ZZN2="" S GZI=GZI_""""_GM_"""" ; FOR THE LAST ONE97131 "RTN","C0CDOM",305,0)97132 . . . . E S GZI=GZI_""""_GM_""""_","_ZZN2_"," ; FOR THE REST97133 "RTN","C0CDOM",306,0)97134 . . . S GZI2=ZZOUT_"("_GZI_")" ; INCLUDE THE ARRAY NAME97135 "RTN","C0CDOM",307,0)97136 . . . W !,GZI97137 "RTN","C0CDOM",308,0)97138 . . . S @GZI2=ZZV ; REMEMBER THE VALUE?97139 97123 "RTN","C0CDOM",309,0) 97140 Q97124 ; 97141 97125 "RTN","C0CDOM",310,0) 97142 ; 97126 NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE 97143 97127 "RTN","C0CDOM",311,0) 97144 NEWDOM() ; extrinsic which creates a new DOM and returns theHANDLE97128 N CBK,SUCCESS,LEVEL,NODE,HANDLE 97145 97129 "RTN","C0CDOM",312,0) 97146 N CBK,SUCCESS,LEVEL,NODE,HANDLE97130 K ^TMP("MXMLERR",$J) 97147 97131 "RTN","C0CDOM",313,0) 97148 K ^TMP("MXMLERR",$J)97132 L +^TMP("MXMLDOM",$J):5 97149 97133 "RTN","C0CDOM",314,0) 97150 L +^TMP("MXMLDOM",$J):597134 E Q 0 97151 97135 "RTN","C0CDOM",315,0) 97152 E Q 097136 S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)="" 97153 97137 "RTN","C0CDOM",316,0) 97154 S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)=""97138 L -^TMP("MXMLDOM",$J) 97155 97139 "RTN","C0CDOM",317,0) 97156 L -^TMP("MXMLDOM",$J)97140 Q HANDLE 97157 97141 "RTN","C0CDOM",318,0) 97158 Q HANDLE97159 "RTN","C0CDOM",319,0)97160 97142 ; 97161 97143 "RTN","C0CDPT") 97162 0^53^B4 587306197144 0^53^B46820265 97163 97145 "RTN","C0CDPT",1,0) 97164 97146 C0CDPT ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08 97165 97147 "RTN","C0CDPT",2,0) 97166 ;;1.2;C 0C;;May 11, 2012;Build 5097148 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 97167 97149 "RTN","C0CDPT",3,0) 97168 97150 ; 97169 97151 "RTN","C0CDPT",4,0) 97170 ; Copyright 2008 WorldVistA. Licensed under the terms of the GNU97152 ; Copyright 2008 WorldVistA. 97171 97153 "RTN","C0CDPT",5,0) 97172 ; General Public License.97154 ; 97173 97155 "RTN","C0CDPT",6,0) 97174 ; 97156 ; This program is free software: you can redistribute it and/or modify 97175 97157 "RTN","C0CDPT",7,0) 97158 ; it under the terms of the GNU Affero General Public License as 97159 "RTN","C0CDPT",8,0) 97160 ; published by the Free Software Foundation, either version 3 of the 97161 "RTN","C0CDPT",9,0) 97162 ; License, or (at your option) any later version. 97163 "RTN","C0CDPT",10,0) 97164 ; 97165 "RTN","C0CDPT",11,0) 97176 97166 ; This program is distributed in the hope that it will be useful, 97177 "RTN","C0CDPT", 8,0)97167 "RTN","C0CDPT",12,0) 97178 97168 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 97179 "RTN","C0CDPT", 9,0)97169 "RTN","C0CDPT",13,0) 97180 97170 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 97181 "RTN","C0CDPT",10,0)97182 ; GNU General Public License for more details.97183 "RTN","C0CDPT",11,0)97184 ;97185 "RTN","C0CDPT",12,0)97186 ; You should have received a copy of the GNU General Public License along97187 "RTN","C0CDPT",13,0)97188 ; with this program; if not, write to the Free Software Foundation, Inc.,97189 97171 "RTN","C0CDPT",14,0) 97190 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.97172 ; GNU Affero General Public License for more details. 97191 97173 "RTN","C0CDPT",15,0) 97192 97174 ; 97193 97175 "RTN","C0CDPT",16,0) 97176 ; You should have received a copy of the GNU Affero General Public License 97177 "RTN","C0CDPT",17,0) 97178 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 97179 "RTN","C0CDPT",18,0) 97180 ; 97181 "RTN","C0CDPT",19,0) 97182 ; 97183 "RTN","C0CDPT",20,0) 97194 97184 ; FAMILY Family Name 97195 "RTN","C0CDPT", 17,0)97185 "RTN","C0CDPT",21,0) 97196 97186 ; GIVEN Given Name 97197 "RTN","C0CDPT", 18,0)97187 "RTN","C0CDPT",22,0) 97198 97188 ; MIDDLE Middle Name 97199 "RTN","C0CDPT", 19,0)97189 "RTN","C0CDPT",23,0) 97200 97190 ; SUFFIX Suffix Name 97201 "RTN","C0CDPT",2 0,0)97191 "RTN","C0CDPT",24,0) 97202 97192 ; DISPNAME Display Name 97203 "RTN","C0CDPT",2 1,0)97193 "RTN","C0CDPT",25,0) 97204 97194 ; DOB Date of Birth 97205 "RTN","C0CDPT",2 2,0)97195 "RTN","C0CDPT",26,0) 97206 97196 ; GENDER Get Gender 97207 "RTN","C0CDPT",2 3,0)97197 "RTN","C0CDPT",27,0) 97208 97198 ; SSN Get SSN for ID 97209 "RTN","C0CDPT",2 4,0)97199 "RTN","C0CDPT",28,0) 97210 97200 ; ADDRTYPE Get Home Address 97211 "RTN","C0CDPT",2 5,0)97201 "RTN","C0CDPT",29,0) 97212 97202 ; ADDR1 Get Home Address line 1 97213 "RTN","C0CDPT", 26,0)97203 "RTN","C0CDPT",30,0) 97214 97204 ; ADDR2 Get Home Address line 2 97215 "RTN","C0CDPT", 27,0)97205 "RTN","C0CDPT",31,0) 97216 97206 ; CITY Get City for Home Address 97217 "RTN","C0CDPT", 28,0)97207 "RTN","C0CDPT",32,0) 97218 97208 ; STATE Get State for Home Address 97219 "RTN","C0CDPT", 29,0)97209 "RTN","C0CDPT",33,0) 97220 97210 ; ZIP Get Zip code for Home Address 97221 "RTN","C0CDPT",3 0,0)97211 "RTN","C0CDPT",34,0) 97222 97212 ; COUNTY Get County for our Address 97223 "RTN","C0CDPT",3 1,0)97213 "RTN","C0CDPT",35,0) 97224 97214 ; COUNTRY Get Country for our Address 97225 "RTN","C0CDPT",3 2,0)97215 "RTN","C0CDPT",36,0) 97226 97216 ; RESTEL Residential Telephone 97227 "RTN","C0CDPT",3 3,0)97217 "RTN","C0CDPT",37,0) 97228 97218 ; WORKTEL Work Telephone 97229 "RTN","C0CDPT",3 4,0)97219 "RTN","C0CDPT",38,0) 97230 97220 ; EMAIL Email Adddress 97231 "RTN","C0CDPT",3 5,0)97221 "RTN","C0CDPT",39,0) 97232 97222 ; CELLTEL Cell Phone 97233 "RTN","C0CDPT", 36,0)97223 "RTN","C0CDPT",40,0) 97234 97224 ; NOK1FAM Next of Kin 1 (NOK1) Family Name 97235 "RTN","C0CDPT", 37,0)97225 "RTN","C0CDPT",41,0) 97236 97226 ; NOK1GIV NOK1 Given Name 97237 "RTN","C0CDPT", 38,0)97227 "RTN","C0CDPT",42,0) 97238 97228 ; NOK1MID NOK1 Middle Name 97239 "RTN","C0CDPT", 39,0)97229 "RTN","C0CDPT",43,0) 97240 97230 ; NOK1SUF NOK1 Suffi Name 97241 "RTN","C0CDPT",4 0,0)97231 "RTN","C0CDPT",44,0) 97242 97232 ; NOK1DISP NOK1 Display Name 97243 "RTN","C0CDPT",4 1,0)97233 "RTN","C0CDPT",45,0) 97244 97234 ; NOK1REL NOK1 Relationship to the patient 97245 "RTN","C0CDPT",4 2,0)97235 "RTN","C0CDPT",46,0) 97246 97236 ; NOK1ADD1 NOK1 Address 1 97247 "RTN","C0CDPT",4 3,0)97237 "RTN","C0CDPT",47,0) 97248 97238 ; NOK1ADD2 NOK1 Address 2 97249 "RTN","C0CDPT",4 4,0)97239 "RTN","C0CDPT",48,0) 97250 97240 ; NOK1CITY NOK1 City 97251 "RTN","C0CDPT",4 5,0)97241 "RTN","C0CDPT",49,0) 97252 97242 ; NOK1STAT NOK1 State 97253 "RTN","C0CDPT", 46,0)97243 "RTN","C0CDPT",50,0) 97254 97244 ; NOK1ZIP NOK1 Zip Code 97255 "RTN","C0CDPT", 47,0)97245 "RTN","C0CDPT",51,0) 97256 97246 ; NOK1HTEL NOK1 Home Telephone 97257 "RTN","C0CDPT", 48,0)97247 "RTN","C0CDPT",52,0) 97258 97248 ; NOK1WTEL NOK1 Work Telephone 97259 "RTN","C0CDPT", 49,0)97249 "RTN","C0CDPT",53,0) 97260 97250 ; NOK1SAME Is NOK1's Address the same the patient? 97261 "RTN","C0CDPT",5 0,0)97251 "RTN","C0CDPT",54,0) 97262 97252 ; NOK2FAM NOK2 Family Name 97263 "RTN","C0CDPT",5 1,0)97253 "RTN","C0CDPT",55,0) 97264 97254 ; NOK2GIV NOK2 Given Name 97265 "RTN","C0CDPT",5 2,0)97255 "RTN","C0CDPT",56,0) 97266 97256 ; NOK2MID NOK2 Middle Name 97267 "RTN","C0CDPT",5 3,0)97257 "RTN","C0CDPT",57,0) 97268 97258 ; NOK2SUF NOK2 Suffi Name 97269 "RTN","C0CDPT",5 4,0)97259 "RTN","C0CDPT",58,0) 97270 97260 ; NOK2DISP NOK2 Display Name 97271 "RTN","C0CDPT",5 5,0)97261 "RTN","C0CDPT",59,0) 97272 97262 ; NOK2REL NOK2 Relationship to the patient 97273 "RTN","C0CDPT", 56,0)97263 "RTN","C0CDPT",60,0) 97274 97264 ; NOK2ADD1 NOK2 Address 1 97275 "RTN","C0CDPT", 57,0)97265 "RTN","C0CDPT",61,0) 97276 97266 ; NOK2ADD2 NOK2 Address 2 97277 "RTN","C0CDPT", 58,0)97267 "RTN","C0CDPT",62,0) 97278 97268 ; NOK2CITY NOK2 City 97279 "RTN","C0CDPT", 59,0)97269 "RTN","C0CDPT",63,0) 97280 97270 ; NOK2STAT NOK2 State 97281 "RTN","C0CDPT",6 0,0)97271 "RTN","C0CDPT",64,0) 97282 97272 ; NOK2ZIP NOK2 Zip Code 97283 "RTN","C0CDPT",6 1,0)97273 "RTN","C0CDPT",65,0) 97284 97274 ; NOK2HTEL NOK2 Home Telephone 97285 "RTN","C0CDPT",6 2,0)97275 "RTN","C0CDPT",66,0) 97286 97276 ; NOK2WTEL NOK2 Work Telephone 97287 "RTN","C0CDPT",6 3,0)97277 "RTN","C0CDPT",67,0) 97288 97278 ; NOK2SAME Is NOK2's Address the same the patient? 97289 "RTN","C0CDPT",6 4,0)97279 "RTN","C0CDPT",68,0) 97290 97280 ; EMERFAM Emergency Contact (EMER) Family Name 97291 "RTN","C0CDPT",6 5,0)97281 "RTN","C0CDPT",69,0) 97292 97282 ; EMERGIV EMER Given Name 97293 "RTN","C0CDPT", 66,0)97283 "RTN","C0CDPT",70,0) 97294 97284 ; EMERMID EMER Middle Name 97295 "RTN","C0CDPT", 67,0)97285 "RTN","C0CDPT",71,0) 97296 97286 ; EMERSUF EMER Suffi Name 97297 "RTN","C0CDPT", 68,0)97287 "RTN","C0CDPT",72,0) 97298 97288 ; EMERDISP EMER Display Name 97299 "RTN","C0CDPT", 69,0)97289 "RTN","C0CDPT",73,0) 97300 97290 ; EMERREL EMER Relationship to the patient 97301 "RTN","C0CDPT",7 0,0)97291 "RTN","C0CDPT",74,0) 97302 97292 ; EMERADD1 EMER Address 1 97303 "RTN","C0CDPT",7 1,0)97293 "RTN","C0CDPT",75,0) 97304 97294 ; EMERADD2 EMER Address 2 97305 "RTN","C0CDPT",7 2,0)97295 "RTN","C0CDPT",76,0) 97306 97296 ; EMERCITY EMER City 97307 "RTN","C0CDPT",7 3,0)97297 "RTN","C0CDPT",77,0) 97308 97298 ; EMERSTAT EMER State 97309 "RTN","C0CDPT",7 4,0)97299 "RTN","C0CDPT",78,0) 97310 97300 ; EMERZIP EMER Zip Code 97311 "RTN","C0CDPT",7 5,0)97301 "RTN","C0CDPT",79,0) 97312 97302 ; EMERHTEL EMER Home Telephone 97313 "RTN","C0CDPT", 76,0)97303 "RTN","C0CDPT",80,0) 97314 97304 ; EMERWTEL EMER Work Telephone 97315 "RTN","C0CDPT", 77,0)97305 "RTN","C0CDPT",81,0) 97316 97306 ; EMERSAME Is EMER's Address the same the NOK? 97317 "RTN","C0CDPT", 78,0)97318 ; 97319 "RTN","C0CDPT", 79,0)97307 "RTN","C0CDPT",82,0) 97308 ; 97309 "RTN","C0CDPT",83,0) 97320 97310 W "No Entry at top!" Q 97321 "RTN","C0CDPT",8 0,0)97322 ; 97323 "RTN","C0CDPT",8 1,0)97311 "RTN","C0CDPT",84,0) 97312 ; 97313 "RTN","C0CDPT",85,0) 97324 97314 ;**Revision History** 97325 "RTN","C0CDPT",8 2,0)97315 "RTN","C0CDPT",86,0) 97326 97316 ; - June 15, 08: v0.1 using merged global 97327 "RTN","C0CDPT",8 3,0)97317 "RTN","C0CDPT",87,0) 97328 97318 ; - Oct 3, 08: v0.2 using fileman calls, many formatting changes. 97329 "RTN","C0CDPT",8 4,0)97330 ; 97331 "RTN","C0CDPT",8 5,0)97319 "RTN","C0CDPT",88,0) 97320 ; 97321 "RTN","C0CDPT",89,0) 97332 97322 ; All methods are Public and Extrinsic 97333 "RTN","C0CDPT", 86,0)97323 "RTN","C0CDPT",90,0) 97334 97324 ; All calls use Fileman file 2 (Patient). 97335 "RTN","C0CDPT", 87,0)97325 "RTN","C0CDPT",91,0) 97336 97326 ; You can obtain field numbers using the data dictionary 97337 "RTN","C0CDPT", 88,0)97338 ; 97339 "RTN","C0CDPT", 89,0)97327 "RTN","C0CDPT",92,0) 97328 ; 97329 "RTN","C0CDPT",93,0) 97340 97330 FAMILY(DFN) ; Family Name 97341 "RTN","C0CDPT",90,0)97342 N NAME S NAME=$$GET1^DIQ(2,DFN,.01)97343 "RTN","C0CDPT",91,0)97344 D NAMECOMP^XLFNAME(.NAME)97345 "RTN","C0CDPT",92,0)97346 Q NAME("FAMILY")97347 "RTN","C0CDPT",93,0)97348 GIVEN(DFN) ; Given Name97349 97331 "RTN","C0CDPT",94,0) 97350 97332 N NAME S NAME=$$GET1^DIQ(2,DFN,.01) … … 97352 97334 D NAMECOMP^XLFNAME(.NAME) 97353 97335 "RTN","C0CDPT",96,0) 97354 Q NAME(" GIVEN")97336 Q NAME("FAMILY") 97355 97337 "RTN","C0CDPT",97,0) 97356 MIDDLE(DFN) ; MiddleName97338 GIVEN(DFN) ; Given Name 97357 97339 "RTN","C0CDPT",98,0) 97358 97340 N NAME S NAME=$$GET1^DIQ(2,DFN,.01) … … 97360 97342 D NAMECOMP^XLFNAME(.NAME) 97361 97343 "RTN","C0CDPT",100,0) 97362 Q NAME(" MIDDLE")97344 Q NAME("GIVEN") 97363 97345 "RTN","C0CDPT",101,0) 97364 SUFFIX(DFN) ; SuffiName97346 MIDDLE(DFN) ; Middle Name 97365 97347 "RTN","C0CDPT",102,0) 97366 97348 N NAME S NAME=$$GET1^DIQ(2,DFN,.01) … … 97368 97350 D NAMECOMP^XLFNAME(.NAME) 97369 97351 "RTN","C0CDPT",104,0) 97370 Q NAME(" SUFFIX")97352 Q NAME("MIDDLE") 97371 97353 "RTN","C0CDPT",105,0) 97372 DISPNAME(DFN) ; DisplayName97354 SUFFIX(DFN) ; Suffi Name 97373 97355 "RTN","C0CDPT",106,0) 97374 97356 N NAME S NAME=$$GET1^DIQ(2,DFN,.01) 97375 97357 "RTN","C0CDPT",107,0) 97358 D NAMECOMP^XLFNAME(.NAME) 97359 "RTN","C0CDPT",108,0) 97360 Q NAME("SUFFIX") 97361 "RTN","C0CDPT",109,0) 97362 DISPNAME(DFN) ; Display Name 97363 "RTN","C0CDPT",110,0) 97364 N NAME S NAME=$$GET1^DIQ(2,DFN,.01) 97365 "RTN","C0CDPT",111,0) 97376 97366 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma 97377 "RTN","C0CDPT",1 08,0)97367 "RTN","C0CDPT",112,0) 97378 97368 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") 97379 "RTN","C0CDPT",1 09,0)97369 "RTN","C0CDPT",113,0) 97380 97370 DOB(DFN) ; Date of Birth 97381 "RTN","C0CDPT",11 0,0)97371 "RTN","C0CDPT",114,0) 97382 97372 N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I") 97383 "RTN","C0CDPT",11 1,0)97373 "RTN","C0CDPT",115,0) 97384 97374 ; Date in FM Date Format. Convert to UTC/ISO 8601. 97385 "RTN","C0CDPT",11 2,0)97375 "RTN","C0CDPT",116,0) 97386 97376 Q $$FMDTOUTC^C0CUTIL(DOB,"D") 97387 "RTN","C0CDPT",11 3,0)97377 "RTN","C0CDPT",117,0) 97388 97378 GENDER(DFN) ; Gender/Sex 97389 "RTN","C0CDPT",11 4,0)97379 "RTN","C0CDPT",118,0) 97390 97380 Q $$GET1^DIQ(2,DFN,.02,"I")_"^"_$$GET1^DIQ(2,DFN,.02,"E") ; 97391 "RTN","C0CDPT",11 5,0)97381 "RTN","C0CDPT",119,0) 97392 97382 SSN(DFN) ; SSN 97393 "RTN","C0CDPT",1 16,0)97383 "RTN","C0CDPT",120,0) 97394 97384 Q $$GET1^DIQ(2,DFN,.09) 97395 "RTN","C0CDPT",1 17,0)97385 "RTN","C0CDPT",121,0) 97396 97386 ADDRTYPE(DFN) ; Address Type 97397 "RTN","C0CDPT",1 18,0)97387 "RTN","C0CDPT",122,0) 97398 97388 ; Vista only stores a home address for the patient. 97399 "RTN","C0CDPT",1 19,0)97389 "RTN","C0CDPT",123,0) 97400 97390 Q "Home" 97401 "RTN","C0CDPT",12 0,0)97391 "RTN","C0CDPT",124,0) 97402 97392 ADDR1(DFN) ; Get Home Address line 1 97403 "RTN","C0CDPT",12 1,0)97393 "RTN","C0CDPT",125,0) 97404 97394 Q $$GET1^DIQ(2,DFN,.111) 97405 "RTN","C0CDPT",12 2,0)97395 "RTN","C0CDPT",126,0) 97406 97396 ADDR2(DFN) ; Get Home Address line 2 97407 "RTN","C0CDPT",12 3,0)97397 "RTN","C0CDPT",127,0) 97408 97398 ; Vista has Lines 2,3; CCR has only line 1,2; so compromise 97409 "RTN","C0CDPT",12 4,0)97399 "RTN","C0CDPT",128,0) 97410 97400 N ADDLN2,ADDLN3 97411 "RTN","C0CDPT",12 5,0)97401 "RTN","C0CDPT",129,0) 97412 97402 S ADDLN2=$$GET1^DIQ(2,DFN,.112),ADDLN3=$$GET1^DIQ(2,DFN,.113) 97413 "RTN","C0CDPT",1 26,0)97403 "RTN","C0CDPT",130,0) 97414 97404 Q:ADDLN3="" ADDLN2 97415 "RTN","C0CDPT",1 27,0)97405 "RTN","C0CDPT",131,0) 97416 97406 Q ADDLN2_", "_ADDLN3 97417 "RTN","C0CDPT",1 28,0)97407 "RTN","C0CDPT",132,0) 97418 97408 CITY(DFN) ; Get City for Home Address 97419 "RTN","C0CDPT",1 29,0)97409 "RTN","C0CDPT",133,0) 97420 97410 Q $$GET1^DIQ(2,DFN,.114) 97421 "RTN","C0CDPT",13 0,0)97411 "RTN","C0CDPT",134,0) 97422 97412 STATE(DFN) ; Get State for Home Address 97423 "RTN","C0CDPT",13 1,0)97413 "RTN","C0CDPT",135,0) 97424 97414 Q $$GET1^DIQ(2,DFN,.115) 97425 "RTN","C0CDPT",13 2,0)97415 "RTN","C0CDPT",136,0) 97426 97416 ZIP(DFN) ; Get Zip code for Home Address 97427 "RTN","C0CDPT",13 3,0)97417 "RTN","C0CDPT",137,0) 97428 97418 Q $$GET1^DIQ(2,DFN,.116) 97429 "RTN","C0CDPT",13 4,0)97419 "RTN","C0CDPT",138,0) 97430 97420 COUNTY(DFN) ; Get County for our Address 97431 "RTN","C0CDPT",13 5,0)97421 "RTN","C0CDPT",139,0) 97432 97422 Q $$GET1^DIQ(2,DFN,.117) 97433 "RTN","C0CDPT",1 36,0)97423 "RTN","C0CDPT",140,0) 97434 97424 COUNTRY(DFN) ; Get Country for our Address 97435 "RTN","C0CDPT",1 37,0)97425 "RTN","C0CDPT",141,0) 97436 97426 ; Unfortunately, it's not stored anywhere in Vista, so the inevitable... 97437 "RTN","C0CDPT",1 38,0)97427 "RTN","C0CDPT",142,0) 97438 97428 Q "USA" 97439 "RTN","C0CDPT",1 39,0)97429 "RTN","C0CDPT",143,0) 97440 97430 RESTEL(DFN) ; Residential Telephone 97441 "RTN","C0CDPT",14 0,0)97431 "RTN","C0CDPT",144,0) 97442 97432 Q $$GET1^DIQ(2,DFN,.131) 97443 "RTN","C0CDPT",14 1,0)97433 "RTN","C0CDPT",145,0) 97444 97434 WORKTEL(DFN) ; Work Telephone 97445 "RTN","C0CDPT",14 2,0)97435 "RTN","C0CDPT",146,0) 97446 97436 Q $$GET1^DIQ(2,DFN,.132) 97447 "RTN","C0CDPT",14 3,0)97437 "RTN","C0CDPT",147,0) 97448 97438 EMAIL(DFN) ; Email Adddress 97449 "RTN","C0CDPT",14 4,0)97439 "RTN","C0CDPT",148,0) 97450 97440 Q $$GET1^DIQ(2,DFN,.133) 97451 "RTN","C0CDPT",14 5,0)97441 "RTN","C0CDPT",149,0) 97452 97442 CELLTEL(DFN) ; Cell Phone 97453 "RTN","C0CDPT",1 46,0)97443 "RTN","C0CDPT",150,0) 97454 97444 Q $$GET1^DIQ(2,DFN,.134) 97455 "RTN","C0CDPT",1 47,0)97445 "RTN","C0CDPT",151,0) 97456 97446 NOK1FAM(DFN) ; Next of Kin 1 (NOK1) Family Name 97457 "RTN","C0CDPT",148,0)97458 N NAME S NAME=$$GET1^DIQ(2,DFN,.211)97459 "RTN","C0CDPT",149,0)97460 D NAMECOMP^XLFNAME(.NAME)97461 "RTN","C0CDPT",150,0)97462 Q NAME("FAMILY")97463 "RTN","C0CDPT",151,0)97464 NOK1GIV(DFN) ; NOK1 Given Name97465 97447 "RTN","C0CDPT",152,0) 97466 97448 N NAME S NAME=$$GET1^DIQ(2,DFN,.211) … … 97468 97450 D NAMECOMP^XLFNAME(.NAME) 97469 97451 "RTN","C0CDPT",154,0) 97470 Q NAME(" GIVEN")97452 Q NAME("FAMILY") 97471 97453 "RTN","C0CDPT",155,0) 97472 NOK1 MID(DFN) ; NOK1 MiddleName97454 NOK1GIV(DFN) ; NOK1 Given Name 97473 97455 "RTN","C0CDPT",156,0) 97474 97456 N NAME S NAME=$$GET1^DIQ(2,DFN,.211) … … 97476 97458 D NAMECOMP^XLFNAME(.NAME) 97477 97459 "RTN","C0CDPT",158,0) 97478 Q NAME(" MIDDLE")97460 Q NAME("GIVEN") 97479 97461 "RTN","C0CDPT",159,0) 97480 NOK1 SUF(DFN) ; NOK1 SuffiName97462 NOK1MID(DFN) ; NOK1 Middle Name 97481 97463 "RTN","C0CDPT",160,0) 97482 97464 N NAME S NAME=$$GET1^DIQ(2,DFN,.211) … … 97484 97466 D NAMECOMP^XLFNAME(.NAME) 97485 97467 "RTN","C0CDPT",162,0) 97486 Q NAME(" SUFFIX")97468 Q NAME("MIDDLE") 97487 97469 "RTN","C0CDPT",163,0) 97488 NOK1 DISP(DFN) ; NOK1 DisplayName97470 NOK1SUF(DFN) ; NOK1 Suffi Name 97489 97471 "RTN","C0CDPT",164,0) 97490 97472 N NAME S NAME=$$GET1^DIQ(2,DFN,.211) 97491 97473 "RTN","C0CDPT",165,0) 97474 D NAMECOMP^XLFNAME(.NAME) 97475 "RTN","C0CDPT",166,0) 97476 Q NAME("SUFFIX") 97477 "RTN","C0CDPT",167,0) 97478 NOK1DISP(DFN) ; NOK1 Display Name 97479 "RTN","C0CDPT",168,0) 97480 N NAME S NAME=$$GET1^DIQ(2,DFN,.211) 97481 "RTN","C0CDPT",169,0) 97492 97482 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma 97493 "RTN","C0CDPT",1 66,0)97483 "RTN","C0CDPT",170,0) 97494 97484 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") 97495 "RTN","C0CDPT",1 67,0)97485 "RTN","C0CDPT",171,0) 97496 97486 NOK1REL(DFN) ; NOK1 Relationship to the patient 97497 "RTN","C0CDPT",1 68,0)97487 "RTN","C0CDPT",172,0) 97498 97488 Q $$GET1^DIQ(2,DFN,.212) 97499 "RTN","C0CDPT",1 69,0)97489 "RTN","C0CDPT",173,0) 97500 97490 NOK1ADD1(DFN) ; NOK1 Address 1 97501 "RTN","C0CDPT",17 0,0)97491 "RTN","C0CDPT",174,0) 97502 97492 Q $$GET1^DIQ(2,DFN,.213) 97503 "RTN","C0CDPT",17 1,0)97493 "RTN","C0CDPT",175,0) 97504 97494 NOK1ADD2(DFN) ; NOK1 Address 2 97505 "RTN","C0CDPT",17 2,0)97495 "RTN","C0CDPT",176,0) 97506 97496 N ADDLN2,ADDLN3 97507 "RTN","C0CDPT",17 3,0)97497 "RTN","C0CDPT",177,0) 97508 97498 S ADDLN2=$$GET1^DIQ(2,DFN,.214),ADDLN3=$$GET1^DIQ(2,DFN,.215) 97509 "RTN","C0CDPT",17 4,0)97499 "RTN","C0CDPT",178,0) 97510 97500 Q:ADDLN3="" ADDLN2 97511 "RTN","C0CDPT",17 5,0)97501 "RTN","C0CDPT",179,0) 97512 97502 Q ADDLN2_", "_ADDLN3 97513 "RTN","C0CDPT",1 76,0)97503 "RTN","C0CDPT",180,0) 97514 97504 NOK1CITY(DFN) ; NOK1 City 97515 "RTN","C0CDPT",1 77,0)97505 "RTN","C0CDPT",181,0) 97516 97506 Q $$GET1^DIQ(2,DFN,.216) 97517 "RTN","C0CDPT",1 78,0)97507 "RTN","C0CDPT",182,0) 97518 97508 NOK1STAT(DFN) ; NOK1 State 97519 "RTN","C0CDPT",1 79,0)97509 "RTN","C0CDPT",183,0) 97520 97510 Q $$GET1^DIQ(2,DFN,.217) 97521 "RTN","C0CDPT",18 0,0)97511 "RTN","C0CDPT",184,0) 97522 97512 NOK1ZIP(DFN) ; NOK1 Zip Code 97523 "RTN","C0CDPT",18 1,0)97513 "RTN","C0CDPT",185,0) 97524 97514 Q $$GET1^DIQ(2,DFN,.218) 97525 "RTN","C0CDPT",18 2,0)97515 "RTN","C0CDPT",186,0) 97526 97516 NOK1HTEL(DFN) ; NOK1 Home Telephone 97527 "RTN","C0CDPT",18 3,0)97517 "RTN","C0CDPT",187,0) 97528 97518 Q $$GET1^DIQ(2,DFN,.219) 97529 "RTN","C0CDPT",18 4,0)97519 "RTN","C0CDPT",188,0) 97530 97520 NOK1WTEL(DFN) ; NOK1 Work Telephone 97531 "RTN","C0CDPT",18 5,0)97521 "RTN","C0CDPT",189,0) 97532 97522 Q $$GET1^DIQ(2,DFN,.21011) 97533 "RTN","C0CDPT",1 86,0)97523 "RTN","C0CDPT",190,0) 97534 97524 NOK1SAME(DFN) ; Is NOK1's Address the same the patient? 97535 "RTN","C0CDPT",1 87,0)97525 "RTN","C0CDPT",191,0) 97536 97526 Q $$GET1^DIQ(2,DFN,.2125) 97537 "RTN","C0CDPT",1 88,0)97527 "RTN","C0CDPT",192,0) 97538 97528 NOK2FAM(DFN) ; NOK2 Family Name 97539 "RTN","C0CDPT",189,0)97540 N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)97541 "RTN","C0CDPT",190,0)97542 D NAMECOMP^XLFNAME(.NAME)97543 "RTN","C0CDPT",191,0)97544 Q NAME("FAMILY")97545 "RTN","C0CDPT",192,0)97546 NOK2GIV(DFN) ; NOK2 Given Name97547 97529 "RTN","C0CDPT",193,0) 97548 97530 N NAME S NAME=$$GET1^DIQ(2,DFN,.2191) … … 97550 97532 D NAMECOMP^XLFNAME(.NAME) 97551 97533 "RTN","C0CDPT",195,0) 97552 Q NAME(" GIVEN")97534 Q NAME("FAMILY") 97553 97535 "RTN","C0CDPT",196,0) 97554 NOK2 MID(DFN) ; NOK2 MiddleName97536 NOK2GIV(DFN) ; NOK2 Given Name 97555 97537 "RTN","C0CDPT",197,0) 97556 97538 N NAME S NAME=$$GET1^DIQ(2,DFN,.2191) … … 97558 97540 D NAMECOMP^XLFNAME(.NAME) 97559 97541 "RTN","C0CDPT",199,0) 97560 Q NAME(" MIDDLE")97542 Q NAME("GIVEN") 97561 97543 "RTN","C0CDPT",200,0) 97562 NOK2 SUF(DFN) ; NOK2 SuffiName97544 NOK2MID(DFN) ; NOK2 Middle Name 97563 97545 "RTN","C0CDPT",201,0) 97564 97546 N NAME S NAME=$$GET1^DIQ(2,DFN,.2191) … … 97566 97548 D NAMECOMP^XLFNAME(.NAME) 97567 97549 "RTN","C0CDPT",203,0) 97568 Q NAME(" SUFFIX")97550 Q NAME("MIDDLE") 97569 97551 "RTN","C0CDPT",204,0) 97570 NOK2 DISP(DFN) ; NOK2 DisplayName97552 NOK2SUF(DFN) ; NOK2 Suffi Name 97571 97553 "RTN","C0CDPT",205,0) 97572 97554 N NAME S NAME=$$GET1^DIQ(2,DFN,.2191) 97573 97555 "RTN","C0CDPT",206,0) 97556 D NAMECOMP^XLFNAME(.NAME) 97557 "RTN","C0CDPT",207,0) 97558 Q NAME("SUFFIX") 97559 "RTN","C0CDPT",208,0) 97560 NOK2DISP(DFN) ; NOK2 Display Name 97561 "RTN","C0CDPT",209,0) 97562 N NAME S NAME=$$GET1^DIQ(2,DFN,.2191) 97563 "RTN","C0CDPT",210,0) 97574 97564 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma 97575 "RTN","C0CDPT",2 07,0)97565 "RTN","C0CDPT",211,0) 97576 97566 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") 97577 "RTN","C0CDPT",2 08,0)97567 "RTN","C0CDPT",212,0) 97578 97568 NOK2REL(DFN) ; NOK2 Relationship to the patient 97579 "RTN","C0CDPT",2 09,0)97569 "RTN","C0CDPT",213,0) 97580 97570 Q $$GET1^DIQ(2,DFN,.2192) 97581 "RTN","C0CDPT",21 0,0)97571 "RTN","C0CDPT",214,0) 97582 97572 NOK2ADD1(DFN) ; NOK2 Address 1 97583 "RTN","C0CDPT",21 1,0)97573 "RTN","C0CDPT",215,0) 97584 97574 Q $$GET1^DIQ(2,DFN,.2193) 97585 "RTN","C0CDPT",21 2,0)97575 "RTN","C0CDPT",216,0) 97586 97576 NOK2ADD2(DFN) ; NOK2 Address 2 97587 "RTN","C0CDPT",21 3,0)97577 "RTN","C0CDPT",217,0) 97588 97578 N ADDLN2,ADDLN3 97589 "RTN","C0CDPT",21 4,0)97579 "RTN","C0CDPT",218,0) 97590 97580 S ADDLN2=$$GET1^DIQ(2,DFN,.2194),ADDLN3=$$GET1^DIQ(2,DFN,.2195) 97591 "RTN","C0CDPT",21 5,0)97581 "RTN","C0CDPT",219,0) 97592 97582 Q:ADDLN3="" ADDLN2 97593 "RTN","C0CDPT",2 16,0)97583 "RTN","C0CDPT",220,0) 97594 97584 Q ADDLN2_", "_ADDLN3 97595 "RTN","C0CDPT",2 17,0)97585 "RTN","C0CDPT",221,0) 97596 97586 NOK2CITY(DFN) ; NOK2 City 97597 "RTN","C0CDPT",2 18,0)97587 "RTN","C0CDPT",222,0) 97598 97588 Q $$GET1^DIQ(2,DFN,.2196) 97599 "RTN","C0CDPT",2 19,0)97589 "RTN","C0CDPT",223,0) 97600 97590 NOK2STAT(DFN) ; NOK2 State 97601 "RTN","C0CDPT",22 0,0)97591 "RTN","C0CDPT",224,0) 97602 97592 Q $$GET1^DIQ(2,DFN,.2197) 97603 "RTN","C0CDPT",22 1,0)97593 "RTN","C0CDPT",225,0) 97604 97594 NOK2ZIP(DFN) ; NOK2 Zip Code 97605 "RTN","C0CDPT",22 2,0)97595 "RTN","C0CDPT",226,0) 97606 97596 Q $$GET1^DIQ(2,DFN,.2198) 97607 "RTN","C0CDPT",22 3,0)97597 "RTN","C0CDPT",227,0) 97608 97598 NOK2HTEL(DFN) ; NOK2 Home Telephone 97609 "RTN","C0CDPT",22 4,0)97599 "RTN","C0CDPT",228,0) 97610 97600 Q $$GET1^DIQ(2,DFN,.2199) 97611 "RTN","C0CDPT",22 5,0)97601 "RTN","C0CDPT",229,0) 97612 97602 NOK2WTEL(DFN) ; NOK2 Work Telephone 97613 "RTN","C0CDPT",2 26,0)97603 "RTN","C0CDPT",230,0) 97614 97604 Q $$GET1^DIQ(2,DFN,.211011) 97615 "RTN","C0CDPT",2 27,0)97605 "RTN","C0CDPT",231,0) 97616 97606 NOK2SAME(DFN) ; Is NOK2's Address the same the patient? 97617 "RTN","C0CDPT",2 28,0)97607 "RTN","C0CDPT",232,0) 97618 97608 Q $$GET1^DIQ(2,DFN,.21925) 97619 "RTN","C0CDPT",2 29,0)97609 "RTN","C0CDPT",233,0) 97620 97610 EMERFAM(DFN) ; Emergency Contact (EMER) Family Name 97621 "RTN","C0CDPT",230,0)97622 N NAME S NAME=$$GET1^DIQ(2,DFN,.331)97623 "RTN","C0CDPT",231,0)97624 D NAMECOMP^XLFNAME(.NAME)97625 "RTN","C0CDPT",232,0)97626 Q NAME("FAMILY")97627 "RTN","C0CDPT",233,0)97628 EMERGIV(DFN) ; EMER Given Name97629 97611 "RTN","C0CDPT",234,0) 97630 97612 N NAME S NAME=$$GET1^DIQ(2,DFN,.331) … … 97632 97614 D NAMECOMP^XLFNAME(.NAME) 97633 97615 "RTN","C0CDPT",236,0) 97634 Q NAME(" GIVEN")97616 Q NAME("FAMILY") 97635 97617 "RTN","C0CDPT",237,0) 97636 EMER MID(DFN) ; EMER MiddleName97618 EMERGIV(DFN) ; EMER Given Name 97637 97619 "RTN","C0CDPT",238,0) 97638 97620 N NAME S NAME=$$GET1^DIQ(2,DFN,.331) … … 97640 97622 D NAMECOMP^XLFNAME(.NAME) 97641 97623 "RTN","C0CDPT",240,0) 97642 Q NAME(" MIDDLE")97624 Q NAME("GIVEN") 97643 97625 "RTN","C0CDPT",241,0) 97644 EMER SUF(DFN) ; EMER SuffiName97626 EMERMID(DFN) ; EMER Middle Name 97645 97627 "RTN","C0CDPT",242,0) 97646 97628 N NAME S NAME=$$GET1^DIQ(2,DFN,.331) … … 97648 97630 D NAMECOMP^XLFNAME(.NAME) 97649 97631 "RTN","C0CDPT",244,0) 97650 Q NAME(" SUFFIX")97632 Q NAME("MIDDLE") 97651 97633 "RTN","C0CDPT",245,0) 97652 EMER DISP(DFN) ; EMER DisplayName97634 EMERSUF(DFN) ; EMER Suffi Name 97653 97635 "RTN","C0CDPT",246,0) 97654 97636 N NAME S NAME=$$GET1^DIQ(2,DFN,.331) 97655 97637 "RTN","C0CDPT",247,0) 97638 D NAMECOMP^XLFNAME(.NAME) 97639 "RTN","C0CDPT",248,0) 97640 Q NAME("SUFFIX") 97641 "RTN","C0CDPT",249,0) 97642 EMERDISP(DFN) ; EMER Display Name 97643 "RTN","C0CDPT",250,0) 97644 N NAME S NAME=$$GET1^DIQ(2,DFN,.331) 97645 "RTN","C0CDPT",251,0) 97656 97646 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma 97657 "RTN","C0CDPT",2 48,0)97647 "RTN","C0CDPT",252,0) 97658 97648 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") 97659 "RTN","C0CDPT",2 49,0)97649 "RTN","C0CDPT",253,0) 97660 97650 EMERREL(DFN) ; EMER Relationship to the patient 97661 "RTN","C0CDPT",25 0,0)97651 "RTN","C0CDPT",254,0) 97662 97652 Q $$GET1^DIQ(2,DFN,.331) 97663 "RTN","C0CDPT",25 1,0)97653 "RTN","C0CDPT",255,0) 97664 97654 EMERADD1(DFN) ; EMER Address 1 97665 "RTN","C0CDPT",25 2,0)97655 "RTN","C0CDPT",256,0) 97666 97656 Q $$GET1^DIQ(2,DFN,.333) 97667 "RTN","C0CDPT",25 3,0)97657 "RTN","C0CDPT",257,0) 97668 97658 EMERADD2(DFN) ; EMER Address 2 97669 "RTN","C0CDPT",25 4,0)97659 "RTN","C0CDPT",258,0) 97670 97660 N ADDLN2,ADDLN3 97671 "RTN","C0CDPT",25 5,0)97661 "RTN","C0CDPT",259,0) 97672 97662 S ADDLN2=$$GET1^DIQ(2,DFN,.334),ADDLN3=$$GET1^DIQ(2,DFN,.335) 97673 "RTN","C0CDPT",2 56,0)97663 "RTN","C0CDPT",260,0) 97674 97664 Q:ADDLN3="" ADDLN2 97675 "RTN","C0CDPT",2 57,0)97665 "RTN","C0CDPT",261,0) 97676 97666 Q ADDLN2_", "_ADDLN3 97677 "RTN","C0CDPT",2 58,0)97667 "RTN","C0CDPT",262,0) 97678 97668 EMERCITY(DFN) ; EMER City 97679 "RTN","C0CDPT",2 59,0)97669 "RTN","C0CDPT",263,0) 97680 97670 Q $$GET1^DIQ(2,DFN,.336) 97681 "RTN","C0CDPT",26 0,0)97671 "RTN","C0CDPT",264,0) 97682 97672 EMERSTAT(DFN) ; EMER State 97683 "RTN","C0CDPT",26 1,0)97673 "RTN","C0CDPT",265,0) 97684 97674 Q $$GET1^DIQ(2,DFN,.337) 97685 "RTN","C0CDPT",26 2,0)97675 "RTN","C0CDPT",266,0) 97686 97676 EMERZIP(DFN) ; EMER Zip Code 97687 "RTN","C0CDPT",26 3,0)97677 "RTN","C0CDPT",267,0) 97688 97678 Q $$GET1^DIQ(2,DFN,.338) 97689 "RTN","C0CDPT",26 4,0)97679 "RTN","C0CDPT",268,0) 97690 97680 EMERHTEL(DFN) ; EMER Home Telephone 97691 "RTN","C0CDPT",26 5,0)97681 "RTN","C0CDPT",269,0) 97692 97682 Q $$GET1^DIQ(2,DFN,.339) 97693 "RTN","C0CDPT",2 66,0)97683 "RTN","C0CDPT",270,0) 97694 97684 EMERWTEL(DFN) ; EMER Work Telephone 97695 "RTN","C0CDPT",2 67,0)97685 "RTN","C0CDPT",271,0) 97696 97686 Q $$GET1^DIQ(2,DFN,.33011) 97697 "RTN","C0CDPT",2 68,0)97687 "RTN","C0CDPT",272,0) 97698 97688 EMERSAME(DFN) ; Is EMER's Address the same the NOK? 97699 "RTN","C0CDPT",2 69,0)97689 "RTN","C0CDPT",273,0) 97700 97690 Q $$GET1^DIQ(2,DFN,.3305) 97701 97691 "RTN","C0CENC") 97702 0^70^B4 632114497692 0^70^B45258660 97703 97693 "RTN","C0CENC",1,0) 97704 97694 C0CENC ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ENCOUNTERS ; 05/21/10 97705 97695 "RTN","C0CENC",2,0) 97706 ;;1.2;C 0C;;May 11, 2012;Build 5097696 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 97707 97697 "RTN","C0CENC",3,0) 97708 97698 ;Copyright 2010 George Lilly, University of Minnesota and others. 97709 97699 "RTN","C0CENC",4,0) 97710 ; Licensed under the terms of the GNU General Public License.97700 ; 97711 97701 "RTN","C0CENC",5,0) 97712 ; See attached copy of the License.97702 ; This program is free software: you can redistribute it and/or modify 97713 97703 "RTN","C0CENC",6,0) 97714 ; 97704 ; it under the terms of the GNU Affero General Public License as 97715 97705 "RTN","C0CENC",7,0) 97716 ; This program is free software; you can redistribute it and/or modify97706 ; published by the Free Software Foundation, either version 3 of the 97717 97707 "RTN","C0CENC",8,0) 97718 ; it under the terms of the GNU General Public License as published by97708 ; License, or (at your option) any later version. 97719 97709 "RTN","C0CENC",9,0) 97720 ; the Free Software Foundation; either version 2 of the License, or97710 ; 97721 97711 "RTN","C0CENC",10,0) 97722 ; (at your option) any later version.97712 ; This program is distributed in the hope that it will be useful, 97723 97713 "RTN","C0CENC",11,0) 97724 ; 97714 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 97725 97715 "RTN","C0CENC",12,0) 97726 ; This program is distributed in the hope that it will be useful,97716 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 97727 97717 "RTN","C0CENC",13,0) 97728 ; but WITHOUT ANY WARRANTY; without even the implied warranty of97718 ; GNU Affero General Public License for more details. 97729 97719 "RTN","C0CENC",14,0) 97730 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the97720 ; 97731 97721 "RTN","C0CENC",15,0) 97732 ; GNU General Public License for more details.97722 ; You should have received a copy of the GNU Affero General Public License 97733 97723 "RTN","C0CENC",16,0) 97734 ; 97724 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 97735 97725 "RTN","C0CENC",17,0) 97736 ; You should have received a copy of the GNU General Public License along97726 ; 97737 97727 "RTN","C0CENC",18,0) 97738 ;with this program; if not, write to the Free Software Foundation, Inc.,97728 W "NO ENTRY FROM TOP",! 97739 97729 "RTN","C0CENC",19,0) 97740 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.97730 Q 97741 97731 "RTN","C0CENC",20,0) 97742 97732 ; 97743 97733 "RTN","C0CENC",21,0) 97744 W "NO ENTRY FROM TOP",! 97734 EXTRACT(ENCXML,DFN,ENCOUT) ; EXTRACT ENCOUNTERS INTO XML TEMPLATE 97745 97735 "RTN","C0CENC",22,0) 97736 ; ENCXML AND ENCOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED 97737 "RTN","C0CENC",23,0) 97738 ; 97739 "RTN","C0CENC",24,0) 97740 D SETVARS^C0CPROC ; SET UP VARIABLES FOR PROCEDUCRES, ENCOUNTERS, AND NOTES 97741 "RTN","C0CENC",25,0) 97742 ;I '$D(@C0CENC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE 97743 "RTN","C0CENC",26,0) 97744 K @C0CENC 97745 "RTN","C0CENC",27,0) 97746 D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET ENCOUNTERS 97747 "RTN","C0CENC",28,0) 97748 D MAP(ENCXML,C0CENC,ENCOUT) ;MAP RESULTS FOR ENCOUNTERS 97749 "RTN","C0CENC",29,0) 97746 97750 Q 97747 "RTN","C0CENC",23,0)97748 ;97749 "RTN","C0CENC",24,0)97750 EXTRACT(ENCXML,DFN,ENCOUT) ; EXTRACT ENCOUNTERS INTO XML TEMPLATE97751 "RTN","C0CENC",25,0)97752 ; ENCXML AND ENCOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED97753 "RTN","C0CENC",26,0)97754 ;97755 "RTN","C0CENC",27,0)97756 D SETVARS^C0CPROC ; SET UP VARIABLES FOR PROCEDUCRES, ENCOUNTERS, AND NOTES97757 "RTN","C0CENC",28,0)97758 ;I '$D(@C0CENC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE97759 "RTN","C0CENC",29,0)97760 K @C0CENC97761 97751 "RTN","C0CENC",30,0) 97762 D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET ENCOUNTERS97752 ; 97763 97753 "RTN","C0CENC",31,0) 97764 D MAP(ENCXML,C0CENC,ENCOUT) ;MAP RESULTS FOR ENCOUNTERS 97754 TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES, 97765 97755 "RTN","C0CENC",32,0) 97756 ; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME 97757 "RTN","C0CENC",33,0) 97758 ; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES 97759 "RTN","C0CENC",34,0) 97760 ; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT 97761 "RTN","C0CENC",35,0) 97762 ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY 97763 "RTN","C0CENC",36,0) 97764 ; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM 97765 "RTN","C0CENC",37,0) 97766 ; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS 97767 "RTN","C0CENC",38,0) 97768 ; 97769 "RTN","C0CENC",39,0) 97770 ;K VISIT,LST,NOTE 97771 "RTN","C0CENC",40,0) 97772 I '$D(C0CPRC) D SETVARS^C0CPROC ; INITIALIZE WORK AREAS IF NOT ALREADY THERE 97773 "RTN","C0CENC",41,0) 97774 I '$D(VISIT) D ENTRY^C0CCPT(DFN,,,1) ; RETURNS VISIT LOCAL VARIABLE 97775 "RTN","C0CENC",42,0) 97776 ; NEED TO ADD START AND END DATES FROM PARAMETERS 97777 "RTN","C0CENC",43,0) 97778 N ZI S ZI="" 97779 "RTN","C0CENC",44,0) 97780 N PREVCPT,PREVDT S (PREVCPT,PREVDT)="" 97781 "RTN","C0CENC",45,0) 97782 F S ZI=$O(VISIT(ZI),-1) Q:ZI="" D ; REVERSE TIME ORDER - MOST RECENT FIRST 97783 "RTN","C0CENC",46,0) 97784 . N ZDATE 97785 "RTN","C0CENC",47,0) 97786 . S ZDATE=$$DATE(VISIT(ZI,"DATE",0)) 97787 "RTN","C0CENC",48,0) 97788 . S ZPRVARY=$NA(VISIT(ZI,"PRV")) 97789 "RTN","C0CENC",49,0) 97790 . N ZPRV 97791 "RTN","C0CENC",50,0) 97792 . S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM 97793 "RTN","C0CENC",51,0) 97794 . ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON 97795 "RTN","C0CENC",52,0) 97796 . ; ENCOBJECTID - ENCOUNTER OBJECT ID 97797 "RTN","C0CENC",53,0) 97798 . ; ENCDATETIME - ENCOUNTER DATE TIME 97799 "RTN","C0CENC",54,0) 97800 . ; ENCTYPETXT - ENCOUNTER TYPE (PLANNING TO USE ADMINISTRATIVE CPT IF AVAIL) 97801 "RTN","C0CENC",55,0) 97802 . ; ENCTYPECODE - CODE OF TYPE - PLANNING CPT CODE 97803 "RTN","C0CENC",56,0) 97804 . ; ENCTYPECODESYS - CODING SYSTEM OF TYPE - CPT-4 97805 "RTN","C0CENC",57,0) 97806 . ; ENCDESCTXT - ENCOUNTER DESCRIPTION TEXT 97807 "RTN","C0CENC",58,0) 97808 . ; ENCDESCCODE - ENCOUNTER DESCRIPTION CODE 97809 "RTN","C0CENC",59,0) 97810 . ; ENCDESCCODESYS - ENCOUNTER DESCRIPTION CODE SYSTEM 97811 "RTN","C0CENC",60,0) 97812 . ; ENCLOCACTORID - ENCOUNTER LOCATION ACTOR ID 97813 "RTN","C0CENC",61,0) 97814 . ; ENCPRVACTORID - ENCOUNTER PRACTIONER ACTOR ID 97815 "RTN","C0CENC",62,0) 97816 . ; ENCINDTXT - ENCOUNTER INDICATION TEXT 97817 "RTN","C0CENC",63,0) 97818 . ; ENCINDCODE - ENCOUNTER INDICATION CODE 97819 "RTN","C0CENC",64,0) 97820 . ; ENCINDCODESYS - ENCOUNTER INDICATION CODE SYSTEM 97821 "RTN","C0CENC",65,0) 97822 . ; ENCACTORID - ENCOUNTER SOURCE ACTOR ID 97823 "RTN","C0CENC",66,0) 97824 . ; ENCCOMMENTID - ENCOUNTER COMMENT ID - POINTER TO NOTE IN COMMENT SECTION 97825 "RTN","C0CENC",67,0) 97826 . S ZRNF("ENCOBJECTID")="ENCOUNTER_"_ZI 97827 "RTN","C0CENC",68,0) 97828 . S ZRNF("ENCDATETIME")=ZDATE ; ENCOUNTER DATE TIME 97829 "RTN","C0CENC",69,0) 97830 . S ZRNF("ENCTYPETXT")="" 97831 "RTN","C0CENC",70,0) 97832 . S ZRNF("ENCTYPECODE")="" 97833 "RTN","C0CENC",71,0) 97834 . S ZRNF("ENCTYPECODESYS")="" 97835 "RTN","C0CENC",72,0) 97836 . S ZRNF("ENCDESCTXT")="" 97837 "RTN","C0CENC",73,0) 97838 . S ZRNF("ENCDESCCODE")="" 97839 "RTN","C0CENC",74,0) 97840 . S ZRNF("ENCDESCCODESYS")="" 97841 "RTN","C0CENC",75,0) 97842 . N TYPTXT,TYPCDE,TYPSYS ; WILL BE UPDATED BY GETTYPE CALL 97843 "RTN","C0CENC",76,0) 97844 . I $$GETTYPE("VISIT(ZI)",.TYPTXT,.TYPCDE,.TYPSYS) D ; RETURNS FALSE IF NO TYPE 97845 "RTN","C0CENC",77,0) 97846 . . S ZRNF("ENCTYPETXT")=TYPTXT 97847 "RTN","C0CENC",78,0) 97848 . . S ZRNF("ENCTYPECODE")=TYPCDE 97849 "RTN","C0CENC",79,0) 97850 . . S ZRNF("ENCTYPECODESYS")=TYPSYS 97851 "RTN","C0CENC",80,0) 97852 . . S ZRNF("ENCDESCTXT")=TYPTXT ; FOR NOW, DESCRIPTION IS SAME AS TYPE 97853 "RTN","C0CENC",81,0) 97854 . . S ZRNF("ENCDESCCODE")=TYPCDE ; DESCRIPTION IS REQUIRED (TYPE IS NOT) 97855 "RTN","C0CENC",82,0) 97856 . . S ZRNF("ENCDESCCODESYS")=TYPSYS ; NEED TO CLARIFY FOR VISTA 97857 "RTN","C0CENC",83,0) 97858 . S ZRNF("ENCLOCACTORID")="ACTORORGANIZATION_1" 97859 "RTN","C0CENC",84,0) 97860 . S ZRNF("ENCPRVACTORID")=ZPRV ; PRIMARY PROVIDER LISTED FOR THE ENCOUNTER 97861 "RTN","C0CENC",85,0) 97862 . S ZRNF("ENCINDTXT")="" ; WE WILL PUT POINTERS TO PROBLEMS HERE 97863 "RTN","C0CENC",86,0) 97864 . S ZRNF("ENCINDCODE")="" 97865 "RTN","C0CENC",87,0) 97866 . S ZRNF("ENCINDCODESYS")="" 97867 "RTN","C0CENC",88,0) 97868 . S ZRNF("ENCACTORID")=ZPRV ; SOURCE WILL BE PRIMARY PROVIDER 97869 "RTN","C0CENC",89,0) 97870 . S ZRNF("ENCCOMMENTID")="" 97871 "RTN","C0CENC",90,0) 97872 . I $G(VISIT(ZI,"TEXT",1))'="" D ; THERE IS A NOTE 97873 "RTN","C0CENC",91,0) 97874 . . M @C0CNTE@(ZI,"TEXT")=VISIT(ZI,"TEXT") ; COPY THE TEXT OF THE NOTE 97875 "RTN","C0CENC",92,0) 97876 . . S @C0CNTE@(ZI,"COMMENTOBJECTID")="NOTE_"_ZI 97877 "RTN","C0CENC",93,0) 97878 . . S @C0CNTE@(ZI,"CMTDATETIME")=ZDATE ; DATE OF THE NOTE 97879 "RTN","C0CENC",94,0) 97880 . . S @C0CNTE@(ZI,"ACTORSOURCEID")=ZPRV ; SOURCE OF THE NOTE 97881 "RTN","C0CENC",95,0) 97882 . . S ZRNF("ENCCOMMENTID")="NOTE_"_ZI ; POINT TO THE NOTE FROM THE ENCOUNTER 97883 "RTN","C0CENC",96,0) 97884 . D RNF1TO2^C0CRNF(C0CENC,"ZRNF") ; ADD THIS ROW TO THE ARRAY 97885 "RTN","C0CENC",97,0) 97886 . ;S PREVCPT=ZCPT 97887 "RTN","C0CENC",98,0) 97888 . ;S PREVDT=ZDATE 97889 "RTN","C0CENC",99,0) 97890 N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"ENCOUNTERS")) 97891 "RTN","C0CENC",100,0) 97892 M @ZRIM=@C0CENC@("V") 97893 "RTN","C0CENC",101,0) 97894 K VISIT,LST,NOTE 97895 "RTN","C0CENC",102,0) 97766 97896 Q 97767 "RTN","C0CENC",33,0)97768 ;97769 "RTN","C0CENC",34,0)97770 TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES,97771 "RTN","C0CENC",35,0)97772 ; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME97773 "RTN","C0CENC",36,0)97774 ; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES97775 "RTN","C0CENC",37,0)97776 ; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT97777 "RTN","C0CENC",38,0)97778 ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY97779 "RTN","C0CENC",39,0)97780 ; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM97781 "RTN","C0CENC",40,0)97782 ; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS97783 "RTN","C0CENC",41,0)97784 ;97785 "RTN","C0CENC",42,0)97786 ;K VISIT,LST,NOTE97787 "RTN","C0CENC",43,0)97788 I '$D(C0CPRC) D SETVARS^C0CPROC ; INITIALIZE WORK AREAS IF NOT ALREADY THERE97789 "RTN","C0CENC",44,0)97790 I '$D(VISIT) D ENTRY^C0CCPT(DFN,,,1) ; RETURNS VISIT LOCAL VARIABLE97791 "RTN","C0CENC",45,0)97792 ; NEED TO ADD START AND END DATES FROM PARAMETERS97793 "RTN","C0CENC",46,0)97794 N ZI S ZI=""97795 "RTN","C0CENC",47,0)97796 N PREVCPT,PREVDT S (PREVCPT,PREVDT)=""97797 "RTN","C0CENC",48,0)97798 F S ZI=$O(VISIT(ZI),-1) Q:ZI="" D ; REVERSE TIME ORDER - MOST RECENT FIRST97799 "RTN","C0CENC",49,0)97800 . N ZDATE97801 "RTN","C0CENC",50,0)97802 . S ZDATE=$$DATE(VISIT(ZI,"DATE",0))97803 "RTN","C0CENC",51,0)97804 . S ZPRVARY=$NA(VISIT(ZI,"PRV"))97805 "RTN","C0CENC",52,0)97806 . N ZPRV97807 "RTN","C0CENC",53,0)97808 . S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM97809 "RTN","C0CENC",54,0)97810 . ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON97811 "RTN","C0CENC",55,0)97812 . ; ENCOBJECTID - ENCOUNTER OBJECT ID97813 "RTN","C0CENC",56,0)97814 . ; ENCDATETIME - ENCOUNTER DATE TIME97815 "RTN","C0CENC",57,0)97816 . ; ENCTYPETXT - ENCOUNTER TYPE (PLANNING TO USE ADMINISTRATIVE CPT IF AVAIL)97817 "RTN","C0CENC",58,0)97818 . ; ENCTYPECODE - CODE OF TYPE - PLANNING CPT CODE97819 "RTN","C0CENC",59,0)97820 . ; ENCTYPECODESYS - CODING SYSTEM OF TYPE - CPT-497821 "RTN","C0CENC",60,0)97822 . ; ENCDESCTXT - ENCOUNTER DESCRIPTION TEXT97823 "RTN","C0CENC",61,0)97824 . ; ENCDESCCODE - ENCOUNTER DESCRIPTION CODE97825 "RTN","C0CENC",62,0)97826 . ; ENCDESCCODESYS - ENCOUNTER DESCRIPTION CODE SYSTEM97827 "RTN","C0CENC",63,0)97828 . ; ENCLOCACTORID - ENCOUNTER LOCATION ACTOR ID97829 "RTN","C0CENC",64,0)97830 . ; ENCPRVACTORID - ENCOUNTER PRACTIONER ACTOR ID97831 "RTN","C0CENC",65,0)97832 . ; ENCINDTXT - ENCOUNTER INDICATION TEXT97833 "RTN","C0CENC",66,0)97834 . ; ENCINDCODE - ENCOUNTER INDICATION CODE97835 "RTN","C0CENC",67,0)97836 . ; ENCINDCODESYS - ENCOUNTER INDICATION CODE SYSTEM97837 "RTN","C0CENC",68,0)97838 . ; ENCACTORID - ENCOUNTER SOURCE ACTOR ID97839 "RTN","C0CENC",69,0)97840 . ; ENCCOMMENTID - ENCOUNTER COMMENT ID - POINTER TO NOTE IN COMMENT SECTION97841 "RTN","C0CENC",70,0)97842 . S ZRNF("ENCOBJECTID")="ENCOUNTER_"_ZI97843 "RTN","C0CENC",71,0)97844 . S ZRNF("ENCDATETIME")=ZDATE ; ENCOUNTER DATE TIME97845 "RTN","C0CENC",72,0)97846 . S ZRNF("ENCTYPETXT")=""97847 "RTN","C0CENC",73,0)97848 . S ZRNF("ENCTYPECODE")=""97849 "RTN","C0CENC",74,0)97850 . S ZRNF("ENCTYPECODESYS")=""97851 "RTN","C0CENC",75,0)97852 . S ZRNF("ENCDESCTXT")=""97853 "RTN","C0CENC",76,0)97854 . S ZRNF("ENCDESCCODE")=""97855 "RTN","C0CENC",77,0)97856 . S ZRNF("ENCDESCCODESYS")=""97857 "RTN","C0CENC",78,0)97858 . N TYPTXT,TYPCDE,TYPSYS ; WILL BE UPDATED BY GETTYPE CALL97859 "RTN","C0CENC",79,0)97860 . I $$GETTYPE("VISIT(ZI)",.TYPTXT,.TYPCDE,.TYPSYS) D ; RETURNS FALSE IF NO TYPE97861 "RTN","C0CENC",80,0)97862 . . S ZRNF("ENCTYPETXT")=TYPTXT97863 "RTN","C0CENC",81,0)97864 . . S ZRNF("ENCTYPECODE")=TYPCDE97865 "RTN","C0CENC",82,0)97866 . . S ZRNF("ENCTYPECODESYS")=TYPSYS97867 "RTN","C0CENC",83,0)97868 . . S ZRNF("ENCDESCTXT")=TYPTXT ; FOR NOW, DESCRIPTION IS SAME AS TYPE97869 "RTN","C0CENC",84,0)97870 . . S ZRNF("ENCDESCCODE")=TYPCDE ; DESCRIPTION IS REQUIRED (TYPE IS NOT)97871 "RTN","C0CENC",85,0)97872 . . S ZRNF("ENCDESCCODESYS")=TYPSYS ; NEED TO CLARIFY FOR VISTA97873 "RTN","C0CENC",86,0)97874 . S ZRNF("ENCLOCACTORID")="ACTORORGANIZATION_1"97875 "RTN","C0CENC",87,0)97876 . S ZRNF("ENCPRVACTORID")=ZPRV ; PRIMARY PROVIDER LISTED FOR THE ENCOUNTER97877 "RTN","C0CENC",88,0)97878 . S ZRNF("ENCINDTXT")="" ; WE WILL PUT POINTERS TO PROBLEMS HERE97879 "RTN","C0CENC",89,0)97880 . S ZRNF("ENCINDCODE")=""97881 "RTN","C0CENC",90,0)97882 . S ZRNF("ENCINDCODESYS")=""97883 "RTN","C0CENC",91,0)97884 . S ZRNF("ENCACTORID")=ZPRV ; SOURCE WILL BE PRIMARY PROVIDER97885 "RTN","C0CENC",92,0)97886 . S ZRNF("ENCCOMMENTID")=""97887 "RTN","C0CENC",93,0)97888 . I $G(VISIT(ZI,"TEXT",1))'="" D ; THERE IS A NOTE97889 "RTN","C0CENC",94,0)97890 . . M @C0CNTE@(ZI,"TEXT")=VISIT(ZI,"TEXT") ; COPY THE TEXT OF THE NOTE97891 "RTN","C0CENC",95,0)97892 . . S @C0CNTE@(ZI,"COMMENTOBJECTID")="NOTE_"_ZI97893 "RTN","C0CENC",96,0)97894 . . S @C0CNTE@(ZI,"CMTDATETIME")=ZDATE ; DATE OF THE NOTE97895 "RTN","C0CENC",97,0)97896 . . S @C0CNTE@(ZI,"ACTORSOURCEID")=ZPRV ; SOURCE OF THE NOTE97897 "RTN","C0CENC",98,0)97898 . . S ZRNF("ENCCOMMENTID")="NOTE_"_ZI ; POINT TO THE NOTE FROM THE ENCOUNTER97899 "RTN","C0CENC",99,0)97900 . D RNF1TO2^C0CRNF(C0CENC,"ZRNF") ; ADD THIS ROW TO THE ARRAY97901 "RTN","C0CENC",100,0)97902 . ;S PREVCPT=ZCPT97903 "RTN","C0CENC",101,0)97904 . ;S PREVDT=ZDATE97905 "RTN","C0CENC",102,0)97906 N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"ENCOUNTERS"))97907 97897 "RTN","C0CENC",103,0) 97908 M @ZRIM=@C0CENC@("V")97898 ; 97909 97899 "RTN","C0CENC",104,0) 97910 K VISIT,LST,NOTE97900 GETTYPE(ZARY,ZTXT,ZCDE,ZSYS) ; EXTRINSIC WHICH RETURNS FALSE IF NO ENCOUNTER TYPE 97911 97901 "RTN","C0CENC",105,0) 97902 ; UPDATES ZTXT WITH ENCOUNTER TYPE TEXT, ZCDE WITH ENCOUNTER TYPE CODE 97903 "RTN","C0CENC",106,0) 97904 ; AND ZSYS WITH ENCOUNTER TYPE CODING SYSTEM 97905 "RTN","C0CENC",107,0) 97906 ; THIS ROUTINE SHOULD BE UPDATED TO SEARCH FOR AN ADMINISTRATIVE CPT CODE 97907 "RTN","C0CENC",108,0) 97908 ; INSTEAD OF JUST THE FIRST ONE IN THE LIST - GPL 1/23/10 97909 "RTN","C0CENC",109,0) 97910 N ZS,ZC 97911 "RTN","C0CENC",110,0) 97912 S ZC="" S ZS="" 97913 "RTN","C0CENC",111,0) 97914 S (ZTXT,ZCDE,ZSYS)="" 97915 "RTN","C0CENC",112,0) 97916 F S ZC=$O(@ZARY@("CPT",ZC)) Q:ZC="" D ; TRY AND FIND A "99" CPT CODE 97917 "RTN","C0CENC",113,0) 97918 . N ZT 97919 "RTN","C0CENC",114,0) 97920 . S ZT=$$CPT^C0CPROC(@ZARY@("CPT",ZC)) ; VALUES IN A CPT MULTIPLE 97921 "RTN","C0CENC",115,0) 97922 . I $E($P(ZT,U,1),1,2)="99" S ZS=ZT ; IS IT AN ADMIN CPT CODE? 97923 "RTN","C0CENC",116,0) 97924 I ZS'="" D ; CODED ENCOUNTER TYPE FOUND 97925 "RTN","C0CENC",117,0) 97926 . S ZTXT=$P(ZS,U,2)_" "_$P(ZS,U,3) ; USE BOTH PIECES FOR THE TYPE 97927 "RTN","C0CENC",118,0) 97928 . S ZCDE=$P($$CPT^C0CPROC(ZS),U,1) ; CPT CODE FOR ENCOUTER 97929 "RTN","C0CENC",119,0) 97930 . S ZSYS="" 97931 "RTN","C0CENC",120,0) 97932 . I ZCDE'="" S ZSYS="CPT-4" ; ONLY HAVE A CODING SYSTEM IF THERE IS A CODE 97933 "RTN","C0CENC",121,0) 97934 I ZS="" S ZTXT=$$ANYTXT(ZARY) ; TRY AND GET FREE FORM TEXT FROM CPT MULTIPLES 97935 "RTN","C0CENC",122,0) 97936 I ZTXT="" Q 0 ; FAILED 97937 "RTN","C0CENC",123,0) 97938 W !,ZTXT 97939 "RTN","C0CENC",124,0) 97940 Q 1 ; SUCCESS 97941 "RTN","C0CENC",125,0) 97942 ; 97943 "RTN","C0CENC",126,0) 97944 ANYTXT(ZVST) ; EXTRINSIC WHICH RETURNS TEXT FROM THE CPT MULTIPLE 97945 "RTN","C0CENC",127,0) 97946 ; OF A VISIT ARRAY WITHOUT CHECKING THE CPT CODE (THAT HAVING FAILED) 97947 "RTN","C0CENC",128,0) 97948 ; ZVST IS THE VISIT ARRAY AND IS PASSED BY NAME 97949 "RTN","C0CENC",129,0) 97950 ; RETURNS TEXT TO USE AS ENCOUNTER TYPE IF ANY 97951 "RTN","C0CENC",130,0) 97952 N ZK,ZL 97953 "RTN","C0CENC",131,0) 97954 S ZK="" S ZL="" 97955 "RTN","C0CENC",132,0) 97956 F S ZK=$O(@ZVST@("CPT",ZK)) Q:ZK="" D ; LOOK FOR SOME TEXT TO USE 97957 "RTN","C0CENC",133,0) 97958 . N ZT 97959 "RTN","C0CENC",134,0) 97960 . S ZT=$G(@ZVST@("CPT",ZK)) ; LOOK AT THIS CPT MULTIPLE 97961 "RTN","C0CENC",135,0) 97962 . I $P(ZT,U,2)_" "_$P(ZT,U,3)'=" " S ZL=$P(ZT,U,2)_" "_$P(ZT,U,3) 97963 "RTN","C0CENC",136,0) 97964 . ; CONCATENATE PIECE 2 AND 3 OF THE CPT MULTIPLE FOR A TYPE 97965 "RTN","C0CENC",137,0) 97966 I ZL="" S ZL=$G(@ZVST@("CLASS")) ; USE THE NOTE DOCUMENT CLASS FOR ENCOUTNER TYPE 97967 "RTN","C0CENC",138,0) 97968 Q ZL 97969 "RTN","C0CENC",139,0) 97970 ; 97971 "RTN","C0CENC",140,0) 97972 PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME 97973 "RTN","C0CENC",141,0) 97974 N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN="" 97975 "RTN","C0CENC",142,0) 97976 F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH PRV SEG 97977 "RTN","C0CENC",143,0) 97978 . I ZR'="" Q ;ONLY WANT THE FIRST PRIMARY PROVIDER 97979 "RTN","C0CENC",144,0) 97980 . I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1) 97981 "RTN","C0CENC",145,0) 97982 I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR 97983 "RTN","C0CENC",146,0) 97984 Q ZRTN 97985 "RTN","C0CENC",147,0) 97986 ; 97987 "RTN","C0CENC",148,0) 97988 DATE(ISTR) ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT 97989 "RTN","C0CENC",149,0) 97990 Q $$FMDTOUTC^C0CUTIL(ISTR,"DT") 97991 "RTN","C0CENC",150,0) 97992 ; 97993 "RTN","C0CENC",151,0) 97994 CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS 97995 "RTN","C0CENC",152,0) 97996 ; CPT^CATEGORY^TEXT 97997 "RTN","C0CENC",153,0) 97998 N Z1,Z2,Z3,ZRTN 97999 "RTN","C0CENC",154,0) 98000 S Z1=$P(ISTR,U,1) 98001 "RTN","C0CENC",155,0) 98002 I Z1="" D ; 98003 "RTN","C0CENC",156,0) 98004 . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1) 98005 "RTN","C0CENC",157,0) 98006 I Z1'="" D ; IF THERE IS A CPT CODE IN THERE 98007 "RTN","C0CENC",158,0) 98008 . ;S Z1=$P(ISTR,U,1) 98009 "RTN","C0CENC",159,0) 98010 . S Z2=$P(ISTR,U,2) 98011 "RTN","C0CENC",160,0) 98012 . S Z3=$P(ISTR,U,3) 98013 "RTN","C0CENC",161,0) 98014 . S ZRTN=Z1_U_Z2_U_Z3 98015 "RTN","C0CENC",162,0) 98016 E S ZRTN="" 98017 "RTN","C0CENC",163,0) 98018 Q ZRTN 98019 "RTN","C0CENC",164,0) 98020 ; 98021 "RTN","C0CENC",165,0) 98022 MAP(ENCXML,C0CENC,ENCOUT) ; MAP PROCEDURES XML 98023 "RTN","C0CENC",166,0) 98024 ; 98025 "RTN","C0CENC",167,0) 98026 N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"ENCTEMP")) ;WORK AREA FOR TEMPLATE 98027 "RTN","C0CENC",168,0) 98028 K @ZTEMP 98029 "RTN","C0CENC",169,0) 98030 N ZBLD 98031 "RTN","C0CENC",170,0) 98032 S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"ENCBLD")) ; BUILD LIST AREA 98033 "RTN","C0CENC",171,0) 98034 D QUEUE^C0CXPATH(ZBLD,ENCXML,1,1) ; FIRST LINE 98035 "RTN","C0CENC",172,0) 98036 N ZINNER 98037 "RTN","C0CENC",173,0) 98038 D QUERY^C0CXPATH(ENCXML,"//Encounters/Encounter","ZINNER") ;ONE ENCOUNTER 98039 "RTN","C0CENC",174,0) 98040 N ZTMP,ZVAR,ZI 98041 "RTN","C0CENC",175,0) 98042 S ZI="" 98043 "RTN","C0CENC",176,0) 98044 F S ZI=$O(@C0CENC@("V",ZI)) Q:ZI="" D ;FOR EACH ENCOUNTER 98045 "RTN","C0CENC",177,0) 98046 . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS ENCOUNTER XML 98047 "RTN","C0CENC",178,0) 98048 . S ZVAR=$NA(@C0CENC@("V",ZI)) ;THIS ENCOUNTER VARIABLES 98049 "RTN","C0CENC",179,0) 98050 . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE 98051 "RTN","C0CENC",180,0) 98052 . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD 98053 "RTN","C0CENC",181,0) 98054 D QUEUE^C0CXPATH(ZBLD,ENCXML,@ENCXML@(0),@ENCXML@(0)) 98055 "RTN","C0CENC",182,0) 98056 N ZZTMP 98057 "RTN","C0CENC",183,0) 98058 D BUILD^C0CXPATH(ZBLD,ENCOUT) ;BUILD FINAL XML 98059 "RTN","C0CENC",184,0) 98060 K @ZTEMP,@ZBLD,@C0CENC 98061 "RTN","C0CENC",185,0) 97912 98062 Q 97913 "RTN","C0CENC",106,0)97914 ;97915 "RTN","C0CENC",107,0)97916 GETTYPE(ZARY,ZTXT,ZCDE,ZSYS) ; EXTRINSIC WHICH RETURNS FALSE IF NO ENCOUNTER TYPE97917 "RTN","C0CENC",108,0)97918 ; UPDATES ZTXT WITH ENCOUNTER TYPE TEXT, ZCDE WITH ENCOUNTER TYPE CODE97919 "RTN","C0CENC",109,0)97920 ; AND ZSYS WITH ENCOUNTER TYPE CODING SYSTEM97921 "RTN","C0CENC",110,0)97922 ; THIS ROUTINE SHOULD BE UPDATED TO SEARCH FOR AN ADMINISTRATIVE CPT CODE97923 "RTN","C0CENC",111,0)97924 ; INSTEAD OF JUST THE FIRST ONE IN THE LIST - GPL 1/23/1097925 "RTN","C0CENC",112,0)97926 N ZS,ZC97927 "RTN","C0CENC",113,0)97928 S ZC="" S ZS=""97929 "RTN","C0CENC",114,0)97930 S (ZTXT,ZCDE,ZSYS)=""97931 "RTN","C0CENC",115,0)97932 F S ZC=$O(@ZARY@("CPT",ZC)) Q:ZC="" D ; TRY AND FIND A "99" CPT CODE97933 "RTN","C0CENC",116,0)97934 . N ZT97935 "RTN","C0CENC",117,0)97936 . S ZT=$$CPT^C0CPROC(@ZARY@("CPT",ZC)) ; VALUES IN A CPT MULTIPLE97937 "RTN","C0CENC",118,0)97938 . I $E($P(ZT,U,1),1,2)="99" S ZS=ZT ; IS IT AN ADMIN CPT CODE?97939 "RTN","C0CENC",119,0)97940 I ZS'="" D ; CODED ENCOUNTER TYPE FOUND97941 "RTN","C0CENC",120,0)97942 . S ZTXT=$P(ZS,U,2)_" "_$P(ZS,U,3) ; USE BOTH PIECES FOR THE TYPE97943 "RTN","C0CENC",121,0)97944 . S ZCDE=$P($$CPT^C0CPROC(ZS),U,1) ; CPT CODE FOR ENCOUTER97945 "RTN","C0CENC",122,0)97946 . S ZSYS=""97947 "RTN","C0CENC",123,0)97948 . I ZCDE'="" S ZSYS="CPT-4" ; ONLY HAVE A CODING SYSTEM IF THERE IS A CODE97949 "RTN","C0CENC",124,0)97950 I ZS="" S ZTXT=$$ANYTXT(ZARY) ; TRY AND GET FREE FORM TEXT FROM CPT MULTIPLES97951 "RTN","C0CENC",125,0)97952 I ZTXT="" Q 0 ; FAILED97953 "RTN","C0CENC",126,0)97954 W !,ZTXT97955 "RTN","C0CENC",127,0)97956 Q 1 ; SUCCESS97957 "RTN","C0CENC",128,0)97958 ;97959 "RTN","C0CENC",129,0)97960 ANYTXT(ZVST) ; EXTRINSIC WHICH RETURNS TEXT FROM THE CPT MULTIPLE97961 "RTN","C0CENC",130,0)97962 ; OF A VISIT ARRAY WITHOUT CHECKING THE CPT CODE (THAT HAVING FAILED)97963 "RTN","C0CENC",131,0)97964 ; ZVST IS THE VISIT ARRAY AND IS PASSED BY NAME97965 "RTN","C0CENC",132,0)97966 ; RETURNS TEXT TO USE AS ENCOUNTER TYPE IF ANY97967 "RTN","C0CENC",133,0)97968 N ZK,ZL97969 "RTN","C0CENC",134,0)97970 S ZK="" S ZL=""97971 "RTN","C0CENC",135,0)97972 F S ZK=$O(@ZVST@("CPT",ZK)) Q:ZK="" D ; LOOK FOR SOME TEXT TO USE97973 "RTN","C0CENC",136,0)97974 . N ZT97975 "RTN","C0CENC",137,0)97976 . S ZT=$G(@ZVST@("CPT",ZK)) ; LOOK AT THIS CPT MULTIPLE97977 "RTN","C0CENC",138,0)97978 . I $P(ZT,U,2)_" "_$P(ZT,U,3)'=" " S ZL=$P(ZT,U,2)_" "_$P(ZT,U,3)97979 "RTN","C0CENC",139,0)97980 . ; CONCATENATE PIECE 2 AND 3 OF THE CPT MULTIPLE FOR A TYPE97981 "RTN","C0CENC",140,0)97982 I ZL="" S ZL=$G(@ZVST@("CLASS")) ; USE THE NOTE DOCUMENT CLASS FOR ENCOUTNER TYPE97983 "RTN","C0CENC",141,0)97984 Q ZL97985 "RTN","C0CENC",142,0)97986 ;97987 "RTN","C0CENC",143,0)97988 PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME97989 "RTN","C0CENC",144,0)97990 N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN=""97991 "RTN","C0CENC",145,0)97992 F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH PRV SEG97993 "RTN","C0CENC",146,0)97994 . I ZR'="" Q ;ONLY WANT THE FIRST PRIMARY PROVIDER97995 "RTN","C0CENC",147,0)97996 . I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1)97997 "RTN","C0CENC",148,0)97998 I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR97999 "RTN","C0CENC",149,0)98000 Q ZRTN98001 "RTN","C0CENC",150,0)98002 ;98003 "RTN","C0CENC",151,0)98004 DATE(ISTR) ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT98005 "RTN","C0CENC",152,0)98006 Q $$FMDTOUTC^C0CUTIL(ISTR,"DT")98007 "RTN","C0CENC",153,0)98008 ;98009 "RTN","C0CENC",154,0)98010 CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS98011 "RTN","C0CENC",155,0)98012 ; CPT^CATEGORY^TEXT98013 "RTN","C0CENC",156,0)98014 N Z1,Z2,Z3,ZRTN98015 "RTN","C0CENC",157,0)98016 S Z1=$P(ISTR,U,1)98017 "RTN","C0CENC",158,0)98018 I Z1="" D ;98019 "RTN","C0CENC",159,0)98020 . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)98021 "RTN","C0CENC",160,0)98022 I Z1'="" D ; IF THERE IS A CPT CODE IN THERE98023 "RTN","C0CENC",161,0)98024 . ;S Z1=$P(ISTR,U,1)98025 "RTN","C0CENC",162,0)98026 . S Z2=$P(ISTR,U,2)98027 "RTN","C0CENC",163,0)98028 . S Z3=$P(ISTR,U,3)98029 "RTN","C0CENC",164,0)98030 . S ZRTN=Z1_U_Z2_U_Z398031 "RTN","C0CENC",165,0)98032 E S ZRTN=""98033 "RTN","C0CENC",166,0)98034 Q ZRTN98035 "RTN","C0CENC",167,0)98036 ;98037 "RTN","C0CENC",168,0)98038 MAP(ENCXML,C0CENC,ENCOUT) ; MAP PROCEDURES XML98039 "RTN","C0CENC",169,0)98040 ;98041 "RTN","C0CENC",170,0)98042 N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"ENCTEMP")) ;WORK AREA FOR TEMPLATE98043 "RTN","C0CENC",171,0)98044 K @ZTEMP98045 "RTN","C0CENC",172,0)98046 N ZBLD98047 "RTN","C0CENC",173,0)98048 S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"ENCBLD")) ; BUILD LIST AREA98049 "RTN","C0CENC",174,0)98050 D QUEUE^C0CXPATH(ZBLD,ENCXML,1,1) ; FIRST LINE98051 "RTN","C0CENC",175,0)98052 N ZINNER98053 "RTN","C0CENC",176,0)98054 D QUERY^C0CXPATH(ENCXML,"//Encounters/Encounter","ZINNER") ;ONE ENCOUNTER98055 "RTN","C0CENC",177,0)98056 N ZTMP,ZVAR,ZI98057 "RTN","C0CENC",178,0)98058 S ZI=""98059 "RTN","C0CENC",179,0)98060 F S ZI=$O(@C0CENC@("V",ZI)) Q:ZI="" D ;FOR EACH ENCOUNTER98061 "RTN","C0CENC",180,0)98062 . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS ENCOUNTER XML98063 "RTN","C0CENC",181,0)98064 . S ZVAR=$NA(@C0CENC@("V",ZI)) ;THIS ENCOUNTER VARIABLES98065 "RTN","C0CENC",182,0)98066 . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE98067 "RTN","C0CENC",183,0)98068 . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD98069 "RTN","C0CENC",184,0)98070 D QUEUE^C0CXPATH(ZBLD,ENCXML,@ENCXML@(0),@ENCXML@(0))98071 "RTN","C0CENC",185,0)98072 N ZZTMP98073 98063 "RTN","C0CENC",186,0) 98074 D BUILD^C0CXPATH(ZBLD,ENCOUT) ;BUILD FINAL XML98075 "RTN","C0CENC",187,0)98076 K @ZTEMP,@ZBLD,@C0CENC98077 "RTN","C0CENC",188,0)98078 Q98079 "RTN","C0CENC",189,0)98080 98064 ; 98081 98065 "RTN","C0CENV") 98082 0^75^B2 537111398066 0^75^B28427348 98083 98067 "RTN","C0CENV",1,0) 98084 98068 C0CENV ;WV/JMC - CCD/CCR Environment Check/Install Routine ; Aug 16, 2009 98085 98069 "RTN","C0CENV",2,0) 98086 ;;1.2;C 0C;;May 11, 2012;Build 5098070 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 98087 98071 "RTN","C0CENV",3,0) 98088 98072 ; 98089 98073 "RTN","C0CENV",4,0) 98090 ; 98074 ; (C) John McCormack 2009 98091 98075 "RTN","C0CENV",5,0) 98076 ; 98077 "RTN","C0CENV",6,0) 98078 ; This program is free software: you can redistribute it and/or modify 98079 "RTN","C0CENV",7,0) 98080 ; it under the terms of the GNU Affero General Public License as 98081 "RTN","C0CENV",8,0) 98082 ; published by the Free Software Foundation, either version 3 of the 98083 "RTN","C0CENV",9,0) 98084 ; License, or (at your option) any later version. 98085 "RTN","C0CENV",10,0) 98086 ; 98087 "RTN","C0CENV",11,0) 98088 ; This program is distributed in the hope that it will be useful, 98089 "RTN","C0CENV",12,0) 98090 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 98091 "RTN","C0CENV",13,0) 98092 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 98093 "RTN","C0CENV",14,0) 98094 ; GNU Affero General Public License for more details. 98095 "RTN","C0CENV",15,0) 98096 ; 98097 "RTN","C0CENV",16,0) 98098 ; You should have received a copy of the GNU Affero General Public License 98099 "RTN","C0CENV",17,0) 98100 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 98101 "RTN","C0CENV",18,0) 98102 ; 98103 "RTN","C0CENV",19,0) 98104 ; 98105 "RTN","C0CENV",20,0) 98092 98106 ENV ; Does not prevent loading of the transport global. 98093 "RTN","C0CENV", 6,0)98107 "RTN","C0CENV",21,0) 98094 98108 ; Environment check is done only during the install. 98095 "RTN","C0CENV", 7,0)98096 ; 98097 "RTN","C0CENV", 8,0)98109 "RTN","C0CENV",22,0) 98110 ; 98111 "RTN","C0CENV",23,0) 98098 98112 N XQA,XQAMSG 98099 "RTN","C0CENV", 9,0)98100 ; 98101 "RTN","C0CENV", 10,0)98102 ; 98103 "RTN","C0CENV", 11,0)98113 "RTN","C0CENV",24,0) 98114 ; 98115 "RTN","C0CENV",25,0) 98116 ; 98117 "RTN","C0CENV",26,0) 98104 98118 ; Make sure the patch name exist 98105 "RTN","C0CENV", 12,0)98106 ; 98107 "RTN","C0CENV", 13,0)98119 "RTN","C0CENV",27,0) 98120 ; 98121 "RTN","C0CENV",28,0) 98108 98122 I '$D(XPDNM) D Q 98109 "RTN","C0CENV", 14,0)98123 "RTN","C0CENV",29,0) 98110 98124 . D BMES("No valid patch name exist") 98111 "RTN","C0CENV", 15,0)98125 "RTN","C0CENV",30,0) 98112 98126 . S XPDQUIT=2 98113 "RTN","C0CENV", 16,0)98127 "RTN","C0CENV",31,0) 98114 98128 . D EXIT 98115 "RTN","C0CENV", 17,0)98116 ; 98117 "RTN","C0CENV", 18,0)98129 "RTN","C0CENV",32,0) 98130 ; 98131 "RTN","C0CENV",33,0) 98118 98132 D CHECK 98119 "RTN","C0CENV", 19,0)98133 "RTN","C0CENV",34,0) 98120 98134 D EXIT 98121 "RTN","C0CENV", 20,0)98135 "RTN","C0CENV",35,0) 98122 98136 Q 98123 "RTN","C0CENV", 21,0)98124 ; 98125 "RTN","C0CENV", 22,0)98126 ; 98127 "RTN","C0CENV", 23,0)98137 "RTN","C0CENV",36,0) 98138 ; 98139 "RTN","C0CENV",37,0) 98140 ; 98141 "RTN","C0CENV",38,0) 98128 98142 CHECK ; Perform environment check 98129 "RTN","C0CENV", 24,0)98130 ; 98131 "RTN","C0CENV", 25,0)98143 "RTN","C0CENV",39,0) 98144 ; 98145 "RTN","C0CENV",40,0) 98132 98146 I $S('$G(IOM):1,'$G(IOSL):1,$G(U)'="^":1,1:0) D 98133 "RTN","C0CENV", 26,0)98147 "RTN","C0CENV",41,0) 98134 98148 . D BMES("Terminal Device is not defined") 98135 "RTN","C0CENV", 27,0)98149 "RTN","C0CENV",42,0) 98136 98150 . S XPDQUIT=2 98137 "RTN","C0CENV", 28,0)98138 ; 98139 "RTN","C0CENV", 29,0)98151 "RTN","C0CENV",43,0) 98152 ; 98153 "RTN","C0CENV",44,0) 98140 98154 I $S('$G(DUZ):1,$D(DUZ)[0:1,$D(DUZ(0))[0:1,1:0) D 98141 "RTN","C0CENV", 30,0)98155 "RTN","C0CENV",45,0) 98142 98156 . D BMES("Please log in to set local DUZ... variables") 98143 "RTN","C0CENV", 31,0)98157 "RTN","C0CENV",46,0) 98144 98158 . S XPDQUIT=2 98145 "RTN","C0CENV", 32,0)98146 ; 98147 "RTN","C0CENV", 33,0)98159 "RTN","C0CENV",47,0) 98160 ; 98161 "RTN","C0CENV",48,0) 98148 98162 I $P($$ACTIVE^XUSER(DUZ),"^")'=1 D 98149 "RTN","C0CENV", 34,0)98163 "RTN","C0CENV",49,0) 98150 98164 . D BMES("You are not a valid user on this system") 98151 "RTN","C0CENV", 35,0)98165 "RTN","C0CENV",50,0) 98152 98166 . S XPDQUIT=2 98153 "RTN","C0CENV", 36,0)98167 "RTN","C0CENV",51,0) 98154 98168 Q 98155 "RTN","C0CENV", 37,0)98156 ; 98157 "RTN","C0CENV", 38,0)98158 ; 98159 "RTN","C0CENV", 39,0)98169 "RTN","C0CENV",52,0) 98170 ; 98171 "RTN","C0CENV",53,0) 98172 ; 98173 "RTN","C0CENV",54,0) 98160 98174 EXIT ; 98161 "RTN","C0CENV", 40,0)98162 ; 98163 "RTN","C0CENV", 41,0)98164 ; 98165 "RTN","C0CENV", 42,0)98175 "RTN","C0CENV",55,0) 98176 ; 98177 "RTN","C0CENV",56,0) 98178 ; 98179 "RTN","C0CENV",57,0) 98166 98180 I $G(XPDQUIT) D BMES("--- Install Environment Check FAILED ---") Q 98167 "RTN","C0CENV", 43,0)98181 "RTN","C0CENV",58,0) 98168 98182 D BMES("--- Environment Check is Ok ---") 98169 "RTN","C0CENV", 44,0)98170 ; 98171 "RTN","C0CENV", 45,0)98183 "RTN","C0CENV",59,0) 98184 ; 98185 "RTN","C0CENV",60,0) 98172 98186 Q 98173 "RTN","C0CENV", 46,0)98174 ; 98175 "RTN","C0CENV", 47,0)98176 ; 98177 "RTN","C0CENV", 48,0)98187 "RTN","C0CENV",61,0) 98188 ; 98189 "RTN","C0CENV",62,0) 98190 ; 98191 "RTN","C0CENV",63,0) 98178 98192 PRE ;Pre-install entry point 98179 "RTN","C0CENV", 49,0)98180 ; 98181 "RTN","C0CENV", 50,0)98193 "RTN","C0CENV",64,0) 98194 ; 98195 "RTN","C0CENV",65,0) 98182 98196 ; No action needed in pre-install 98183 "RTN","C0CENV", 51,0)98197 "RTN","C0CENV",66,0) 98184 98198 D BMES("No action need for pre-install") 98185 "RTN","C0CENV", 52,0)98186 ; 98187 "RTN","C0CENV", 53,0)98199 "RTN","C0CENV",67,0) 98200 ; 98201 "RTN","C0CENV",68,0) 98188 98202 Q 98189 "RTN","C0CENV", 54,0)98190 ; 98191 "RTN","C0CENV", 55,0)98192 ; 98193 "RTN","C0CENV", 56,0)98203 "RTN","C0CENV",69,0) 98204 ; 98205 "RTN","C0CENV",70,0) 98206 ; 98207 "RTN","C0CENV",71,0) 98194 98208 POST ;Post install 98195 "RTN","C0CENV", 57,0)98196 ; 98197 "RTN","C0CENV", 58,0)98209 "RTN","C0CENV",72,0) 98210 ; 98211 "RTN","C0CENV",73,0) 98198 98212 ; Check for RPMS system with V LAB file. 98199 "RTN","C0CENV", 59,0)98200 ; 98201 "RTN","C0CENV", 60,0)98213 "RTN","C0CENV",74,0) 98214 ; 98215 "RTN","C0CENV",75,0) 98202 98216 I $$VFILE^DILFD(9000010.09)'=1 Q 98203 "RTN","C0CENV", 61,0)98204 ; 98205 "RTN","C0CENV", 62,0)98217 "RTN","C0CENV",76,0) 98218 ; 98219 "RTN","C0CENV",77,0) 98206 98220 S %=$$NEWCP^XPDUTL("RPMS1","POST1^C0CENV") 98207 "RTN","C0CENV", 63,0)98221 "RTN","C0CENV",78,0) 98208 98222 S %=$$NEWCP^XPDUTL("RPMS2","POST2^C0CENV") 98209 "RTN","C0CENV", 64,0)98223 "RTN","C0CENV",79,0) 98210 98224 S %=$$NEWCP^XPDUTL("RPMS3","POST3^C0CENV") 98211 "RTN","C0CENV", 65,0)98225 "RTN","C0CENV",80,0) 98212 98226 S %=$$NEWCP^XPDUTL("RPMS4","POST4^C0CENV") 98213 "RTN","C0CENV", 66,0)98227 "RTN","C0CENV",81,0) 98214 98228 S %=$$NEWCP^XPDUTL("RPMS5","POST5^C0CENV") 98215 "RTN","C0CENV", 67,0)98229 "RTN","C0CENV",82,0) 98216 98230 S %=$$NEWCP^XPDUTL("RPMS6","POST6^C0CENV") 98217 "RTN","C0CENV", 68,0)98231 "RTN","C0CENV",83,0) 98218 98232 S %=$$NEWCP^XPDUTL("RPMS7","POST7^C0CENV") 98219 "RTN","C0CENV", 69,0)98220 ; 98221 "RTN","C0CENV", 70,0)98233 "RTN","C0CENV",84,0) 98234 ; 98235 "RTN","C0CENV",85,0) 98222 98236 Q 98223 "RTN","C0CENV", 71,0)98224 ; 98225 "RTN","C0CENV", 72,0)98226 ; 98227 "RTN","C0CENV", 73,0)98237 "RTN","C0CENV",86,0) 98238 ; 98239 "RTN","C0CENV",87,0) 98240 ; 98241 "RTN","C0CENV",88,0) 98228 98242 POST1 ; Checkpoint call back entry point. 98229 "RTN","C0CENV", 74,0)98243 "RTN","C0CENV",89,0) 98230 98244 ; Add new style ALR1 cross-reference to V LAB file. 98231 "RTN","C0CENV", 75,0)98232 ; 98233 "RTN","C0CENV", 76,0)98245 "RTN","C0CENV",90,0) 98246 ; 98247 "RTN","C0CENV",91,0) 98234 98248 N MSG 98235 "RTN","C0CENV", 77,0)98249 "RTN","C0CENV",92,0) 98236 98250 S MSG="Starting installation of ALR1 cross-reference at "_$$HTE^XLFDT($H,"1Z") 98237 "RTN","C0CENV",78,0)98238 D BMES(MSG)98239 "RTN","C0CENV",79,0)98240 D ALR1^C0CLA7DD98241 "RTN","C0CENV",80,0)98242 S MSG="Installation of ALR1 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")98243 "RTN","C0CENV",81,0)98244 D BMES(MSG)98245 "RTN","C0CENV",82,0)98246 Q98247 "RTN","C0CENV",83,0)98248 ;98249 "RTN","C0CENV",84,0)98250 ;98251 "RTN","C0CENV",85,0)98252 POST2 ; Checkpoint call back entry point.98253 "RTN","C0CENV",86,0)98254 ; Add new style ALR2 cross-reference to V LAB file.98255 "RTN","C0CENV",87,0)98256 ;98257 "RTN","C0CENV",88,0)98258 N MSG98259 "RTN","C0CENV",89,0)98260 S MSG="Starting installation of ALR2 cross-reference at "_$$HTE^XLFDT($H,"1Z")98261 "RTN","C0CENV",90,0)98262 D BMES(MSG)98263 "RTN","C0CENV",91,0)98264 D ALR2^C0CLA7DD98265 "RTN","C0CENV",92,0)98266 S MSG="Installation of ALR2 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")98267 98251 "RTN","C0CENV",93,0) 98268 98252 D BMES(MSG) 98269 98253 "RTN","C0CENV",94,0) 98254 D ALR1^C0CLA7DD 98255 "RTN","C0CENV",95,0) 98256 S MSG="Installation of ALR1 cross-reference completed at "_$$HTE^XLFDT($H,"1Z") 98257 "RTN","C0CENV",96,0) 98258 D BMES(MSG) 98259 "RTN","C0CENV",97,0) 98270 98260 Q 98271 "RTN","C0CENV",95,0)98272 ;98273 "RTN","C0CENV",96,0)98274 ;98275 "RTN","C0CENV",97,0)98276 POST3 ; Checkpoint call back entry point.98277 98261 "RTN","C0CENV",98,0) 98278 ; Add new style ALR3 cross-reference to V LAB file.98262 ; 98279 98263 "RTN","C0CENV",99,0) 98280 98264 ; 98281 98265 "RTN","C0CENV",100,0) 98266 POST2 ; Checkpoint call back entry point. 98267 "RTN","C0CENV",101,0) 98268 ; Add new style ALR2 cross-reference to V LAB file. 98269 "RTN","C0CENV",102,0) 98270 ; 98271 "RTN","C0CENV",103,0) 98282 98272 N MSG 98283 "RTN","C0CENV",101,0)98284 S MSG="Starting installation of ALR3 cross-reference at "_$$HTE^XLFDT($H,"1Z")98285 "RTN","C0CENV",102,0)98286 D BMES(MSG)98287 "RTN","C0CENV",103,0)98288 D ALR3^C0CLA7DD98289 98273 "RTN","C0CENV",104,0) 98290 S MSG=" Installation of ALR3 cross-reference completedat "_$$HTE^XLFDT($H,"1Z")98274 S MSG="Starting installation of ALR2 cross-reference at "_$$HTE^XLFDT($H,"1Z") 98291 98275 "RTN","C0CENV",105,0) 98292 98276 D BMES(MSG) 98293 98277 "RTN","C0CENV",106,0) 98278 D ALR2^C0CLA7DD 98279 "RTN","C0CENV",107,0) 98280 S MSG="Installation of ALR2 cross-reference completed at "_$$HTE^XLFDT($H,"1Z") 98281 "RTN","C0CENV",108,0) 98282 D BMES(MSG) 98283 "RTN","C0CENV",109,0) 98294 98284 Q 98295 "RTN","C0CENV",107,0)98296 ;98297 "RTN","C0CENV",108,0)98298 ;98299 "RTN","C0CENV",109,0)98300 POST4 ; Checkpoint call back entry point.98301 98285 "RTN","C0CENV",110,0) 98302 ; Add new style ALR4 cross-reference to V LAB file.98286 ; 98303 98287 "RTN","C0CENV",111,0) 98304 98288 ; 98305 98289 "RTN","C0CENV",112,0) 98290 POST3 ; Checkpoint call back entry point. 98291 "RTN","C0CENV",113,0) 98292 ; Add new style ALR3 cross-reference to V LAB file. 98293 "RTN","C0CENV",114,0) 98294 ; 98295 "RTN","C0CENV",115,0) 98306 98296 N MSG 98307 "RTN","C0CENV",113,0)98308 S MSG="Starting installation of ALR4 cross-reference at "_$$HTE^XLFDT($H,"1Z")98309 "RTN","C0CENV",114,0)98310 D BMES(MSG)98311 "RTN","C0CENV",115,0)98312 D ALR4^C0CLA7DD98313 98297 "RTN","C0CENV",116,0) 98314 S MSG=" Installation of ALR4 cross-reference completedat "_$$HTE^XLFDT($H,"1Z")98298 S MSG="Starting installation of ALR3 cross-reference at "_$$HTE^XLFDT($H,"1Z") 98315 98299 "RTN","C0CENV",117,0) 98316 98300 D BMES(MSG) 98317 98301 "RTN","C0CENV",118,0) 98302 D ALR3^C0CLA7DD 98303 "RTN","C0CENV",119,0) 98304 S MSG="Installation of ALR3 cross-reference completed at "_$$HTE^XLFDT($H,"1Z") 98305 "RTN","C0CENV",120,0) 98306 D BMES(MSG) 98307 "RTN","C0CENV",121,0) 98318 98308 Q 98319 "RTN","C0CENV",119,0)98320 ;98321 "RTN","C0CENV",120,0)98322 ;98323 "RTN","C0CENV",121,0)98324 POST5 ; Checkpoint call back entry point.98325 98309 "RTN","C0CENV",122,0) 98326 ; Add new style ALR5 cross-reference to V LAB file.98310 ; 98327 98311 "RTN","C0CENV",123,0) 98328 98312 ; 98329 98313 "RTN","C0CENV",124,0) 98314 POST4 ; Checkpoint call back entry point. 98315 "RTN","C0CENV",125,0) 98316 ; Add new style ALR4 cross-reference to V LAB file. 98317 "RTN","C0CENV",126,0) 98318 ; 98319 "RTN","C0CENV",127,0) 98330 98320 N MSG 98331 "RTN","C0CENV",125,0)98332 S MSG="Starting installation of ALR5 cross-reference at "_$$HTE^XLFDT($H,"1Z")98333 "RTN","C0CENV",126,0)98334 D BMES(MSG)98335 "RTN","C0CENV",127,0)98336 D ALR5^C0CLA7DD98337 98321 "RTN","C0CENV",128,0) 98338 S MSG=" Installation of ALR5 cross-reference completedat "_$$HTE^XLFDT($H,"1Z")98322 S MSG="Starting installation of ALR4 cross-reference at "_$$HTE^XLFDT($H,"1Z") 98339 98323 "RTN","C0CENV",129,0) 98340 98324 D BMES(MSG) 98341 98325 "RTN","C0CENV",130,0) 98326 D ALR4^C0CLA7DD 98327 "RTN","C0CENV",131,0) 98328 S MSG="Installation of ALR4 cross-reference completed at "_$$HTE^XLFDT($H,"1Z") 98329 "RTN","C0CENV",132,0) 98330 D BMES(MSG) 98331 "RTN","C0CENV",133,0) 98342 98332 Q 98343 "RTN","C0CENV",131,0) 98344 ; 98345 "RTN","C0CENV",132,0) 98346 ; 98347 "RTN","C0CENV",133,0) 98333 "RTN","C0CENV",134,0) 98334 ; 98335 "RTN","C0CENV",135,0) 98336 ; 98337 "RTN","C0CENV",136,0) 98338 POST5 ; Checkpoint call back entry point. 98339 "RTN","C0CENV",137,0) 98340 ; Add new style ALR5 cross-reference to V LAB file. 98341 "RTN","C0CENV",138,0) 98342 ; 98343 "RTN","C0CENV",139,0) 98344 N MSG 98345 "RTN","C0CENV",140,0) 98346 S MSG="Starting installation of ALR5 cross-reference at "_$$HTE^XLFDT($H,"1Z") 98347 "RTN","C0CENV",141,0) 98348 D BMES(MSG) 98349 "RTN","C0CENV",142,0) 98350 D ALR5^C0CLA7DD 98351 "RTN","C0CENV",143,0) 98352 S MSG="Installation of ALR5 cross-reference completed at "_$$HTE^XLFDT($H,"1Z") 98353 "RTN","C0CENV",144,0) 98354 D BMES(MSG) 98355 "RTN","C0CENV",145,0) 98356 Q 98357 "RTN","C0CENV",146,0) 98358 ; 98359 "RTN","C0CENV",147,0) 98360 ; 98361 "RTN","C0CENV",148,0) 98348 98362 POST6 ; Checkpoint call back entry point. 98349 "RTN","C0CENV",1 34,0)98363 "RTN","C0CENV",149,0) 98350 98364 ; Check for RPMS system and determine LAB patch level 98351 "RTN","C0CENV",1 35,0)98365 "RTN","C0CENV",150,0) 98352 98366 ; and need to load in C0C version of LA7 routines. 98353 "RTN","C0CENV",1 36,0)98354 ; 98355 "RTN","C0CENV",1 37,0)98367 "RTN","C0CENV",151,0) 98368 ; 98369 "RTN","C0CENV",152,0) 98356 98370 N MSG 98357 "RTN","C0CENV",1 38,0)98358 ; 98359 "RTN","C0CENV",1 39,0)98371 "RTN","C0CENV",153,0) 98372 ; 98373 "RTN","C0CENV",154,0) 98360 98374 ; Load and rename C0CQRY2 to LA7QRY2 if LA*5.2*69 not installed 98361 "RTN","C0CENV",1 40,0)98375 "RTN","C0CENV",155,0) 98362 98376 I '$$PATCH^XPDUTL("LA*5.2*69") D 98363 "RTN","C0CENV",1 41,0)98377 "RTN","C0CENV",156,0) 98364 98378 . S MSG="This system missing LAB patch LA*5.2*69" 98365 "RTN","C0CENV",1 42,0)98379 "RTN","C0CENV",157,0) 98366 98380 . D BMES(MSG) 98367 "RTN","C0CENV",1 43,0)98381 "RTN","C0CENV",158,0) 98368 98382 . S MSG="Renaming routine C0CQRY2 to LA7QRY2" 98369 "RTN","C0CENV",1 44,0)98383 "RTN","C0CENV",159,0) 98370 98384 . D BMES(MSG) 98371 "RTN","C0CENV",1 45,0)98385 "RTN","C0CENV",160,0) 98372 98386 . D LOAD("C0CQRY2") 98373 "RTN","C0CENV",1 46,0)98387 "RTN","C0CENV",161,0) 98374 98388 . D SAVE("C0CQRY2","LA7QRY2") 98375 "RTN","C0CENV",1 47,0)98376 ; 98377 "RTN","C0CENV",1 48,0)98389 "RTN","C0CENV",162,0) 98390 ; 98391 "RTN","C0CENV",163,0) 98378 98392 ; Load and rename C0CVOBX1 to LA7VOBX1 if LA*5.2*64 not installed. 98379 "RTN","C0CENV",1 49,0)98393 "RTN","C0CENV",164,0) 98380 98394 I '$$PATCH^XPDUTL("LA*5.2*64") D 98381 "RTN","C0CENV",1 50,0)98395 "RTN","C0CENV",165,0) 98382 98396 . S MSG="This system missing LAB patch LA*5.2*64" 98383 "RTN","C0CENV",1 51,0)98397 "RTN","C0CENV",166,0) 98384 98398 . D BMES(MSG) 98385 "RTN","C0CENV",1 52,0)98399 "RTN","C0CENV",167,0) 98386 98400 . S MSG="Renaming routine C0CVOBX1 to LA7VOBX1" 98387 "RTN","C0CENV",1 53,0)98401 "RTN","C0CENV",168,0) 98388 98402 . D BMES(MSG) 98389 "RTN","C0CENV",1 54,0)98403 "RTN","C0CENV",169,0) 98390 98404 . D LOAD("C0CVOBX1") 98391 "RTN","C0CENV",1 55,0)98405 "RTN","C0CENV",170,0) 98392 98406 . D SAVE("C0CVOBX1","LA7VOBX1") 98393 "RTN","C0CENV",1 56,0)98394 ; 98395 "RTN","C0CENV",1 57,0)98407 "RTN","C0CENV",171,0) 98408 ; 98409 "RTN","C0CENV",172,0) 98396 98410 ; Load and rename C0CQRY1 to LA7QRY1 if LA*5.2*68 not installed. 98397 "RTN","C0CENV",1 58,0)98411 "RTN","C0CENV",173,0) 98398 98412 I '$$PATCH^XPDUTL("LA*5.2*68") D 98399 "RTN","C0CENV",1 59,0)98413 "RTN","C0CENV",174,0) 98400 98414 . S MSG="This system missing LAB patch LA*5.2*68" 98401 "RTN","C0CENV",1 60,0)98415 "RTN","C0CENV",175,0) 98402 98416 . D BMES(MSG) 98403 "RTN","C0CENV",1 61,0)98417 "RTN","C0CENV",176,0) 98404 98418 . S MSG="Renaming routine C0CQRY1 to LA7QRY1" 98405 "RTN","C0CENV",1 62,0)98419 "RTN","C0CENV",177,0) 98406 98420 . D BMES(MSG) 98407 "RTN","C0CENV",1 63,0)98421 "RTN","C0CENV",178,0) 98408 98422 . D LOAD("C0CQRY1") 98409 "RTN","C0CENV",1 64,0)98423 "RTN","C0CENV",179,0) 98410 98424 . D SAVE("C0CQRY1","LA7QRY1") 98411 "RTN","C0CENV",1 65,0)98412 ; 98413 "RTN","C0CENV",1 66,0)98425 "RTN","C0CENV",180,0) 98426 ; 98427 "RTN","C0CENV",181,0) 98414 98428 Q 98415 "RTN","C0CENV",1 67,0)98416 ; 98417 "RTN","C0CENV",1 68,0)98418 ; 98419 "RTN","C0CENV",1 69,0)98429 "RTN","C0CENV",182,0) 98430 ; 98431 "RTN","C0CENV",183,0) 98432 ; 98433 "RTN","C0CENV",184,0) 98420 98434 POST7 ; Checkpoint call back entry point. 98421 "RTN","C0CENV",1 70,0)98422 ; 98423 "RTN","C0CENV",1 71,0)98435 "RTN","C0CENV",185,0) 98436 ; 98437 "RTN","C0CENV",186,0) 98424 98438 D REINDEX^C0CLA7DD 98425 "RTN","C0CENV",172,0)98426 ;98427 "RTN","C0CENV",173,0)98428 Q98429 "RTN","C0CENV",174,0)98430 ;98431 "RTN","C0CENV",175,0)98432 ;98433 "RTN","C0CENV",176,0)98434 BMES(STR) ; Write BMES^XPDUTL statements98435 "RTN","C0CENV",177,0)98436 ;98437 "RTN","C0CENV",178,0)98438 D BMES^XPDUTL($$CJ^XLFSTR(STR,IOM))98439 "RTN","C0CENV",179,0)98440 ;98441 "RTN","C0CENV",180,0)98442 Q98443 "RTN","C0CENV",181,0)98444 ;98445 "RTN","C0CENV",182,0)98446 ;98447 "RTN","C0CENV",183,0)98448 LOAD(X) ; load routine X98449 "RTN","C0CENV",184,0)98450 N %N,DIF,XCNP98451 "RTN","C0CENV",185,0)98452 K ^TMP($J,X)98453 "RTN","C0CENV",186,0)98454 S DIF="^TMP($J,X,",XCNP=098455 98439 "RTN","C0CENV",187,0) 98456 X ^%ZOSF("LOAD")98440 ; 98457 98441 "RTN","C0CENV",188,0) 98458 98442 Q … … 98462 98446 ; 98463 98447 "RTN","C0CENV",191,0) 98464 SAVE(OLD,NEW) ; restore routine X 98448 BMES(STR) ; Write BMES^XPDUTL statements 98465 98449 "RTN","C0CENV",192,0) 98466 N %,DIE,X,XCM,XCN,XCS98450 ; 98467 98451 "RTN","C0CENV",193,0) 98468 S DIE="^TMP($J,"""_OLD_""",",XCN=0,X=NEW98452 D BMES^XPDUTL($$CJ^XLFSTR(STR,IOM)) 98469 98453 "RTN","C0CENV",194,0) 98470 X ^%ZOSF("SAVE")98454 ; 98471 98455 "RTN","C0CENV",195,0) 98472 98456 Q 98457 "RTN","C0CENV",196,0) 98458 ; 98459 "RTN","C0CENV",197,0) 98460 ; 98461 "RTN","C0CENV",198,0) 98462 LOAD(X) ; load routine X 98463 "RTN","C0CENV",199,0) 98464 N %N,DIF,XCNP 98465 "RTN","C0CENV",200,0) 98466 K ^TMP($J,X) 98467 "RTN","C0CENV",201,0) 98468 S DIF="^TMP($J,X,",XCNP=0 98469 "RTN","C0CENV",202,0) 98470 X ^%ZOSF("LOAD") 98471 "RTN","C0CENV",203,0) 98472 Q 98473 "RTN","C0CENV",204,0) 98474 ; 98475 "RTN","C0CENV",205,0) 98476 ; 98477 "RTN","C0CENV",206,0) 98478 SAVE(OLD,NEW) ; restore routine X 98479 "RTN","C0CENV",207,0) 98480 N %,DIE,X,XCM,XCN,XCS 98481 "RTN","C0CENV",208,0) 98482 S DIE="^TMP($J,"""_OLD_""",",XCN=0,X=NEW 98483 "RTN","C0CENV",209,0) 98484 X ^%ZOSF("SAVE") 98485 "RTN","C0CENV",210,0) 98486 Q 98473 98487 "RTN","C0CEVC") 98474 0^76^B 1838854598488 0^76^B21455969 98475 98489 "RTN","C0CEVC",1,0) 98476 98490 C0CEVC ; CCDCCR/GPL - SUPPORT FOR EWD VISTCOM PAGES ; 3/1/2010 98477 98491 "RTN","C0CEVC",2,0) 98478 ;;1.2;C 0C;;May 11, 2012;Build 5098492 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 98479 98493 "RTN","C0CEVC",3,0) 98494 ; 98495 "RTN","C0CEVC",4,0) 98496 ; (C) Geroge Lilly 2010. 98497 "RTN","C0CEVC",5,0) 98498 ; 98499 "RTN","C0CEVC",6,0) 98500 ; This program is free software: you can redistribute it and/or modify 98501 "RTN","C0CEVC",7,0) 98502 ; it under the terms of the GNU Affero General Public License as 98503 "RTN","C0CEVC",8,0) 98504 ; published by the Free Software Foundation, either version 3 of the 98505 "RTN","C0CEVC",9,0) 98506 ; License, or (at your option) any later version. 98507 "RTN","C0CEVC",10,0) 98508 ; 98509 "RTN","C0CEVC",11,0) 98510 ; This program is distributed in the hope that it will be useful, 98511 "RTN","C0CEVC",12,0) 98512 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 98513 "RTN","C0CEVC",13,0) 98514 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 98515 "RTN","C0CEVC",14,0) 98516 ; GNU Affero General Public License for more details. 98517 "RTN","C0CEVC",15,0) 98518 ; 98519 "RTN","C0CEVC",16,0) 98520 ; You should have received a copy of the GNU Affero General Public License 98521 "RTN","C0CEVC",17,0) 98522 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 98523 "RTN","C0CEVC",18,0) 98524 ; 98525 "RTN","C0CEVC",19,0) 98480 98526 gpltest2 ; experiment with sending a CCR to an ewd page 98481 "RTN","C0CEVC", 4,0)98527 "RTN","C0CEVC",20,0) 98482 98528 N ZI 98483 "RTN","C0CEVC", 5,0)98529 "RTN","C0CEVC",21,0) 98484 98530 S ZI="" 98485 "RTN","C0CEVC", 6,0)98531 "RTN","C0CEVC",22,0) 98486 98532 D PSEUDO 98487 "RTN","C0CEVC", 7,0)98533 "RTN","C0CEVC",23,0) 98488 98534 N ZIO 98489 "RTN","C0CEVC", 8,0)98535 "RTN","C0CEVC",24,0) 98490 98536 S ZIO=IO 98491 "RTN","C0CEVC", 9,0)98537 "RTN","C0CEVC",25,0) 98492 98538 S IO="/dev/null" 98493 "RTN","C0CEVC", 10,0)98539 "RTN","C0CEVC",26,0) 98494 98540 OPEN IO 98495 "RTN","C0CEVC", 11,0)98541 "RTN","C0CEVC",27,0) 98496 98542 U IO 98497 "RTN","C0CEVC", 12,0)98543 "RTN","C0CEVC",28,0) 98498 98544 N G 98499 "RTN","C0CEVC", 13,0)98545 "RTN","C0CEVC",29,0) 98500 98546 S G=$$URLTOKEN^C0CEWD 98501 "RTN","C0CEVC", 14,0)98547 "RTN","C0CEVC",30,0) 98502 98548 D CCRRPC^C0CCCR(.GPL,2) 98503 "RTN","C0CEVC", 15,0)98549 "RTN","C0CEVC",31,0) 98504 98550 S IO=ZIO 98505 "RTN","C0CEVC", 16,0)98551 "RTN","C0CEVC",32,0) 98506 98552 OPEN IO 98507 "RTN","C0CEVC", 17,0)98553 "RTN","C0CEVC",33,0) 98508 98554 U IO 98509 "RTN","C0CEVC", 18,0)98555 "RTN","C0CEVC",34,0) 98510 98556 K GPL(0) 98511 "RTN","C0CEVC", 19,0)98557 "RTN","C0CEVC",35,0) 98512 98558 F S ZI=$O(GPL(ZI)) Q:ZI="" W GPL(ZI),! 98513 "RTN","C0CEVC", 20,0)98559 "RTN","C0CEVC",36,0) 98514 98560 Q 98515 "RTN","C0CEVC", 21,0)98516 ; 98517 "RTN","C0CEVC", 22,0)98561 "RTN","C0CEVC",37,0) 98562 ; 98563 "RTN","C0CEVC",38,0) 98518 98564 gpltest ; experiment with sending a CCR to an ewd page 98519 "RTN","C0CEVC", 23,0)98565 "RTN","C0CEVC",39,0) 98520 98566 N ZI 98521 "RTN","C0CEVC", 24,0)98567 "RTN","C0CEVC",40,0) 98522 98568 S ZI="" 98523 "RTN","C0CEVC", 25,0)98569 "RTN","C0CEVC",41,0) 98524 98570 K ^GPL(0) 98525 "RTN","C0CEVC", 26,0)98571 "RTN","C0CEVC",42,0) 98526 98572 S ^GPL(2)="<?xml-stylesheet type=""text/xsl"" href=""/resources/ccr.xsl""?>" 98527 "RTN","C0CEVC", 27,0)98573 "RTN","C0CEVC",43,0) 98528 98574 F S ZI=$O(^GPL(ZI)) Q:ZI="" W ^GPL(ZI),! 98529 "RTN","C0CEVC", 28,0)98575 "RTN","C0CEVC",44,0) 98530 98576 Q 98531 "RTN","C0CEVC", 29,0)98532 ; 98533 "RTN","C0CEVC", 30,0)98577 "RTN","C0CEVC",45,0) 98578 ; 98579 "RTN","C0CEVC",46,0) 98534 98580 TEST(sessid); 98535 "RTN","C0CEVC", 31,0)98581 "RTN","C0CEVC",47,0) 98536 98582 d setSessionValue^%zewdAPI("person.Name","Rob",sessid) 98537 "RTN","C0CEVC", 32,0)98583 "RTN","C0CEVC",48,0) 98538 98584 d setSessionValue^%zewdAPI("person.DateOfBirth","13/06/55",sessid) 98539 "RTN","C0CEVC", 33,0)98585 "RTN","C0CEVC",49,0) 98540 98586 d setSessionValue^%zewdAPI("person.Address.PostCode","SW1 3QA",sessid) 98541 "RTN","C0CEVC", 34,0)98587 "RTN","C0CEVC",50,0) 98542 98588 d setSessionValue^%zewdAPI("person.Address.Line1","1 The Street",sessid) 98543 "RTN","C0CEVC", 35,0)98589 "RTN","C0CEVC",51,0) 98544 98590 d setSessionValue^%zewdAPI("person.Address.2.hello","world",sessid) 98545 "RTN","C0CEVC", 36,0)98591 "RTN","C0CEVC",52,0) 98546 98592 d setJSONValue^%zewdAPI("json","person",sessid) 98547 "RTN","C0CEVC", 37,0)98593 "RTN","C0CEVC",53,0) 98548 98594 Q "" 98549 "RTN","C0CEVC", 38,0)98595 "RTN","C0CEVC",54,0) 98550 98596 98551 "RTN","C0CEVC", 39,0)98597 "RTN","C0CEVC",55,0) 98552 98598 PARSE(INXML,INDOC) ;CALL THE EWD PARSER ON INXML, PASSED BY NAME 98553 "RTN","C0CEVC", 40,0)98599 "RTN","C0CEVC",56,0) 98554 98600 ; INDOC IS PASSED AS THE DOCUMENT NAME TO EWD 98555 "RTN","C0CEVC", 41,0)98601 "RTN","C0CEVC",57,0) 98556 98602 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY EWD 98557 "RTN","C0CEVC", 42,0)98603 "RTN","C0CEVC",58,0) 98558 98604 N ZR 98559 "RTN","C0CEVC", 43,0)98605 "RTN","C0CEVC",59,0) 98560 98606 M ^CacheTempEWD($j)=@INXML ; 98561 "RTN","C0CEVC", 44,0)98607 "RTN","C0CEVC",60,0) 98562 98608 S ZR=$$parseDocument^%zewdHTMLParser(INDOC) 98563 "RTN","C0CEVC", 45,0)98609 "RTN","C0CEVC",61,0) 98564 98610 Q ZR 98565 "RTN","C0CEVC", 46,0)98566 ; 98567 "RTN","C0CEVC", 47,0)98611 "RTN","C0CEVC",62,0) 98612 ; 98613 "RTN","C0CEVC",63,0) 98568 98614 TEST2(sessid) ; try to put a ccr in the session 98569 "RTN","C0CEVC", 48,0)98615 "RTN","C0CEVC",64,0) 98570 98616 S U="^" 98571 "RTN","C0CEVC", 49,0)98617 "RTN","C0CEVC",65,0) 98572 98618 D PSEUDO ; FAKE LOGIN 98573 "RTN","C0CEVC", 50,0)98619 "RTN","C0CEVC",66,0) 98574 98620 S ZIO=$IO 98575 "RTN","C0CEVC", 51,0)98621 "RTN","C0CEVC",67,0) 98576 98622 S DEV="/dev/null" 98577 "RTN","C0CEVC", 52,0)98623 "RTN","C0CEVC",68,0) 98578 98624 O DEV U DEV 98579 "RTN","C0CEVC", 53,0)98625 "RTN","C0CEVC",69,0) 98580 98626 N G 98581 "RTN","C0CEVC", 54,0)98627 "RTN","C0CEVC",70,0) 98582 98628 N ZDFN 98583 "RTN","C0CEVC", 55,0)98629 "RTN","C0CEVC",71,0) 98584 98630 S ZDFN=$$getSessionValue^%zewdAPI("vista.dfn",sessid) 98585 "RTN","C0CEVC", 56,0)98631 "RTN","C0CEVC",72,0) 98586 98632 I ZDFN="" S ZDFN=2 98587 "RTN","C0CEVC", 57,0)98633 "RTN","C0CEVC",73,0) 98588 98634 ;K ^TMP("GPL") 98589 "RTN","C0CEVC", 58,0)98635 "RTN","C0CEVC",74,0) 98590 98636 ;M ^TMP("GPL")=^%zewdSession("session",sessid) 98591 "RTN","C0CEVC", 59,0)98637 "RTN","C0CEVC",75,0) 98592 98638 D CCRRPC^C0CCCR(.GPL,ZDFN) 98593 "RTN","C0CEVC", 60,0)98639 "RTN","C0CEVC",76,0) 98594 98640 K GPL(0) 98595 "RTN","C0CEVC", 61,0)98641 "RTN","C0CEVC",77,0) 98596 98642 S GPL(2)="<?xml-stylesheet type=""text/xsl"" href=""/resources/ccr.xsl""?>" 98597 "RTN","C0CEVC", 62,0)98643 "RTN","C0CEVC",78,0) 98598 98644 C DEV U ZIO 98599 "RTN","C0CEVC", 63,0)98645 "RTN","C0CEVC",79,0) 98600 98646 ;M ^CacheTempEWD($j)=GPL 98601 "RTN","C0CEVC", 64,0)98647 "RTN","C0CEVC",80,0) 98602 98648 S DOCNAME="CCR" 98603 "RTN","C0CEVC", 65,0)98649 "RTN","C0CEVC",81,0) 98604 98650 ;ZWR GPL 98605 "RTN","C0CEVC", 66,0)98651 "RTN","C0CEVC",82,0) 98606 98652 ;S ZR=$$parseDocument^%zewdHTMLParser(DOCNAME) 98607 "RTN","C0CEVC", 67,0)98653 "RTN","C0CEVC",83,0) 98608 98654 ;d setSessionValues^%zewdAPI(DOCNAME,GPL,sessid) 98609 "RTN","C0CEVC", 68,0)98655 "RTN","C0CEVC",84,0) 98610 98656 d mergeArrayToSession^%zewdAPI(.GPL,DOCNAME,sessid) 98611 "RTN","C0CEVC", 69,0)98657 "RTN","C0CEVC",85,0) 98612 98658 Q "" 98613 "RTN","C0CEVC", 70,0)98614 ; 98615 "RTN","C0CEVC", 71,0)98659 "RTN","C0CEVC",86,0) 98660 ; 98661 "RTN","C0CEVC",87,0) 98616 98662 INITSES(sessid) ;initialize an EWD/CPRS session 98617 "RTN","C0CEVC", 72,0)98663 "RTN","C0CEVC",88,0) 98618 98664 K ^TMP("GPL") 98619 "RTN","C0CEVC", 73,0)98665 "RTN","C0CEVC",89,0) 98620 98666 ;M ^TMP("GPL")=^%zewdSession("session",sessid) 98621 "RTN","C0CEVC", 74,0)98667 "RTN","C0CEVC",90,0) 98622 98668 N ZT,ZDFN 98623 "RTN","C0CEVC", 75,0)98669 "RTN","C0CEVC",91,0) 98624 98670 S ZT=$$URLTOKEN^C0CEWD(sessid) 98625 "RTN","C0CEVC", 76,0)98671 "RTN","C0CEVC",92,0) 98626 98672 ;S ^TMP("GPL")=ZT 98627 "RTN","C0CEVC", 77,0)98673 "RTN","C0CEVC",93,0) 98628 98674 d trace^%zewdAPI("*********************ZT="_ZT) 98629 "RTN","C0CEVC", 78,0)98675 "RTN","C0CEVC",94,0) 98630 98676 S ZDFN=$$PRSEORTK(ZT) ; PARSE THE TOKEN AND LOOK UP THE DFN 98631 "RTN","C0CEVC", 79,0)98677 "RTN","C0CEVC",95,0) 98632 98678 S ^TMP("GPL","DFN")=ZDFN 98633 "RTN","C0CEVC", 80,0)98679 "RTN","C0CEVC",96,0) 98634 98680 I ZDFN=0 S DFN=2 ; DEFAULT TEST PATIENT 98635 "RTN","C0CEVC", 81,0)98681 "RTN","C0CEVC",97,0) 98636 98682 D setSessionValue^%zewdAPI("vista.dfn",ZDFN,sessid) 98637 "RTN","C0CEVC", 82,0)98683 "RTN","C0CEVC",98,0) 98638 98684 ;M ^TMP("GPL","request")=requestArray 98639 "RTN","C0CEVC", 83,0)98685 "RTN","C0CEVC",99,0) 98640 98686 ;D PSEUDO 98641 "RTN","C0CEVC", 84,0)98687 "RTN","C0CEVC",100,0) 98642 98688 ;D ^%ZTER 98643 "RTN","C0CEVC", 85,0)98689 "RTN","C0CEVC",101,0) 98644 98690 q "" 98645 "RTN","C0CEVC", 86,0)98646 ; 98647 "RTN","C0CEVC", 87,0)98691 "RTN","C0CEVC",102,0) 98692 ; 98693 "RTN","C0CEVC",103,0) 98648 98694 PRSEORTK(ZTOKEN) ;PARSES THE TOKEN SENT BY CPRS AND RETURNS THE DFN 98649 "RTN","C0CEVC", 88,0)98695 "RTN","C0CEVC",104,0) 98650 98696 ; OF THE PATIENT ; HERE'S WHAT THE TOKEN LOOKS LIKE: 98651 "RTN","C0CEVC", 89,0)98697 "RTN","C0CEVC",105,0) 98652 98698 ; ^TMP('ORWCHART',6547,'192.168.169.8',002E0FE6) 98653 "RTN","C0CEVC", 90,0)98699 "RTN","C0CEVC",106,0) 98654 98700 N ZX,ZN1,ZIP,ZN2,ZDFN,ZG 98655 "RTN","C0CEVC", 91,0)98701 "RTN","C0CEVC",107,0) 98656 98702 S ZDFN=0 ; DEFAULT RETURN 98657 "RTN","C0CEVC", 92,0)98703 "RTN","C0CEVC",108,0) 98658 98704 S ZN1=$P(ZTOKEN,",",2) ; FIRST NUMBER 98659 "RTN","C0CEVC", 93,0)98705 "RTN","C0CEVC",109,0) 98660 98706 S ZIP=$P(ZTOKEN,",",3) ; IP NUMBER 98661 "RTN","C0CEVC", 94,0)98707 "RTN","C0CEVC",110,0) 98662 98708 S ZIP=$P(ZIP,"'",2) ; GET RID OF ' 98663 "RTN","C0CEVC", 95,0)98709 "RTN","C0CEVC",111,0) 98664 98710 S ZN2=$P(ZTOKEN,",",4) ; SECOND NUMBER 98665 "RTN","C0CEVC", 96,0)98711 "RTN","C0CEVC",112,0) 98666 98712 S ZN2=$P(ZN2,")",1) ; GET RID OF ) 98667 "RTN","C0CEVC", 97,0)98713 "RTN","C0CEVC",113,0) 98668 98714 S ZG=$NA(^TMP("ORWCHART",ZN1,ZIP,ZN2)) ; BUILD THE GLOBAL NAME 98669 "RTN","C0CEVC", 98,0)98715 "RTN","C0CEVC",114,0) 98670 98716 I $G(@ZG)'="" S ZDFN=@ZG ; ACCESS THE GLOBAL 98671 "RTN","C0CEVC", 99,0)98717 "RTN","C0CEVC",115,0) 98672 98718 S ^TMP("GPL","FIRSTDFN")=ZDFN 98673 "RTN","C0CEVC",1 00,0)98719 "RTN","C0CEVC",116,0) 98674 98720 S ^TMP("GPL","FIRSTGLB")=ZG 98675 "RTN","C0CEVC",1 01,0)98721 "RTN","C0CEVC",117,0) 98676 98722 Q ZDFN 98677 "RTN","C0CEVC",1 02,0)98678 ; 98679 "RTN","C0CEVC",1 03,0)98723 "RTN","C0CEVC",118,0) 98724 ; 98725 "RTN","C0CEVC",119,0) 98680 98726 GETPATIENTLIST(sessid) ; 98681 "RTN","C0CEVC",1 04,0)98727 "RTN","C0CEVC",120,0) 98682 98728 D PSEUDO 98683 "RTN","C0CEVC",1 05,0)98729 "RTN","C0CEVC",121,0) 98684 98730 D LISTALL^ORWPT(.RTN,"NAME","1") 98685 "RTN","C0CEVC",1 06,0)98731 "RTN","C0CEVC",122,0) 98686 98732 N ZI 98687 "RTN","C0CEVC",1 07,0)98733 "RTN","C0CEVC",123,0) 98688 98734 S ZI="" 98689 "RTN","C0CEVC",1 08,0)98735 "RTN","C0CEVC",124,0) 98690 98736 F S ZI=$O(RTN(ZI)) Q:ZI="" D ; 98691 "RTN","C0CEVC",1 09,0)98737 "RTN","C0CEVC",125,0) 98692 98738 . S data(ZI,"DFN")=$P(RTN(ZI),"^",1) 98693 "RTN","C0CEVC",1 10,0)98739 "RTN","C0CEVC",126,0) 98694 98740 . S data(ZI,"Name")=$P(RTN(ZI),"^",2) 98695 "RTN","C0CEVC",1 11,0)98741 "RTN","C0CEVC",127,0) 98696 98742 ; ZWR data 98697 "RTN","C0CEVC",1 12,0)98743 "RTN","C0CEVC",128,0) 98698 98744 ;S data(1,"DFN")=$P(RTN(1),"^",1) 98699 "RTN","C0CEVC",1 13,0)98745 "RTN","C0CEVC",129,0) 98700 98746 ;S data(1,"Name")=$P(RTN(1),"^",2) 98701 "RTN","C0CEVC",1 14,0)98747 "RTN","C0CEVC",130,0) 98702 98748 d deleteFromSession^%zewdAPI("patients",sessid) 98703 "RTN","C0CEVC",1 15,0)98749 "RTN","C0CEVC",131,0) 98704 98750 d createDataTableStore^%zewdYUIRuntime(.data,"patients",sessid) 98705 "RTN","C0CEVC",1 16,0)98751 "RTN","C0CEVC",132,0) 98706 98752 ;d mergeArrayToSession^%zewdAPI(.data,"patients",sessid) 98707 "RTN","C0CEVC",1 17,0)98753 "RTN","C0CEVC",133,0) 98708 98754 Q "" 98709 "RTN","C0CEVC",1 18,0)98710 ; 98711 "RTN","C0CEVC",1 19,0)98755 "RTN","C0CEVC",134,0) 98756 ; 98757 "RTN","C0CEVC",135,0) 98712 98758 PSEUDO 98713 "RTN","C0CEVC",1 20,0)98759 "RTN","C0CEVC",136,0) 98714 98760 S U="^" 98715 "RTN","C0CEVC",1 21,0)98761 "RTN","C0CEVC",137,0) 98716 98762 S DILOCKTM=3 98717 "RTN","C0CEVC",1 22,0)98763 "RTN","C0CEVC",138,0) 98718 98764 S DISYS=19 98719 "RTN","C0CEVC",1 23,0)98765 "RTN","C0CEVC",139,0) 98720 98766 S DT=3100219 98721 "RTN","C0CEVC",1 24,0)98767 "RTN","C0CEVC",140,0) 98722 98768 S DTIME=999 98723 "RTN","C0CEVC",1 25,0)98769 "RTN","C0CEVC",141,0) 98724 98770 S DUZ=10 98725 "RTN","C0CEVC",1 26,0)98771 "RTN","C0CEVC",142,0) 98726 98772 S DUZ(0)="@" 98727 "RTN","C0CEVC",1 27,0)98773 "RTN","C0CEVC",143,0) 98728 98774 S DUZ(1)="" 98729 "RTN","C0CEVC",1 28,0)98775 "RTN","C0CEVC",144,0) 98730 98776 S DUZ(2)=1 98731 "RTN","C0CEVC",1 29,0)98777 "RTN","C0CEVC",145,0) 98732 98778 S DUZ("AG")="V" 98733 "RTN","C0CEVC",1 30,0)98779 "RTN","C0CEVC",146,0) 98734 98780 S DUZ("BUF")=1 98735 "RTN","C0CEVC",1 31,0)98781 "RTN","C0CEVC",147,0) 98736 98782 S DUZ("LANG")="" 98737 "RTN","C0CEVC",1 32,0)98783 "RTN","C0CEVC",148,0) 98738 98784 ;S IO="/dev/pts/2" 98739 "RTN","C0CEVC",1 33,0)98785 "RTN","C0CEVC",149,0) 98740 98786 ;S IO(0)="/dev/pts/2" 98741 "RTN","C0CEVC",1 34,0)98787 "RTN","C0CEVC",150,0) 98742 98788 ;S IO(1,"/dev/pts/2")="" 98743 "RTN","C0CEVC",1 35,0)98789 "RTN","C0CEVC",151,0) 98744 98790 ;S IO("ERROR")="" 98745 "RTN","C0CEVC",1 36,0)98791 "RTN","C0CEVC",152,0) 98746 98792 ;S IO("HOME")="41^/dev/pts/2" 98747 "RTN","C0CEVC",1 37,0)98793 "RTN","C0CEVC",153,0) 98748 98794 ;S IO("ZIO")="/dev/pts/2" 98749 "RTN","C0CEVC",1 38,0)98795 "RTN","C0CEVC",154,0) 98750 98796 ;S IOBS="$C(8)" 98751 "RTN","C0CEVC",1 39,0)98797 "RTN","C0CEVC",155,0) 98752 98798 ;S IOF="#,$C(27,91,50,74,27,91,72)" 98753 "RTN","C0CEVC",1 40,0)98799 "RTN","C0CEVC",156,0) 98754 98800 ;S SIOM=80 98755 "RTN","C0CEVC",1 41,0)98801 "RTN","C0CEVC",157,0) 98756 98802 Q 98757 "RTN","C0CEVC",1 42,0)98758 ; 98759 "RTN","C0CEVC",1 43,0)98803 "RTN","C0CEVC",158,0) 98804 ; 98805 "RTN","C0CEVC",159,0) 98760 98806 PSEUDO2 ; FAKE LOGIN SETS SOME LOCAL VARIABLE TO FOOL FILEMAN 98761 "RTN","C0CEVC",1 44,0)98807 "RTN","C0CEVC",160,0) 98762 98808 S DILOCKTM=3 98763 "RTN","C0CEVC",1 45,0)98809 "RTN","C0CEVC",161,0) 98764 98810 S DISYS=19 98765 "RTN","C0CEVC",1 46,0)98811 "RTN","C0CEVC",162,0) 98766 98812 S DT=3100112 98767 "RTN","C0CEVC",1 47,0)98813 "RTN","C0CEVC",163,0) 98768 98814 S DTIME=9999 98769 "RTN","C0CEVC",1 48,0)98815 "RTN","C0CEVC",164,0) 98770 98816 S DUZ=10000000020 98771 "RTN","C0CEVC",1 49,0)98817 "RTN","C0CEVC",165,0) 98772 98818 S DUZ(0)="@" 98773 "RTN","C0CEVC",1 50,0)98819 "RTN","C0CEVC",166,0) 98774 98820 S DUZ(1)="" 98775 "RTN","C0CEVC",1 51,0)98821 "RTN","C0CEVC",167,0) 98776 98822 S DUZ(2)=67 98777 "RTN","C0CEVC",1 52,0)98823 "RTN","C0CEVC",168,0) 98778 98824 S DUZ("AG")="E" 98779 "RTN","C0CEVC",1 53,0)98825 "RTN","C0CEVC",169,0) 98780 98826 S DUZ("BUF")=1 98781 "RTN","C0CEVC",1 54,0)98827 "RTN","C0CEVC",170,0) 98782 98828 S DUZ("LANG")=1 98783 "RTN","C0CEVC",1 55,0)98829 "RTN","C0CEVC",171,0) 98784 98830 S IO="/dev/pts/0" 98785 "RTN","C0CEVC",1 56,0)98831 "RTN","C0CEVC",172,0) 98786 98832 ;S IO(0)="/dev/pts/0" 98787 "RTN","C0CEVC",1 57,0)98833 "RTN","C0CEVC",173,0) 98788 98834 ;S IO(1,"/dev/pts/0")="" 98789 "RTN","C0CEVC",1 58,0)98835 "RTN","C0CEVC",174,0) 98790 98836 ;S IO("ERROR")="" 98791 "RTN","C0CEVC",1 59,0)98837 "RTN","C0CEVC",175,0) 98792 98838 ;S IO("HOME")="50^/dev/pts/0" 98793 "RTN","C0CEVC",1 60,0)98839 "RTN","C0CEVC",176,0) 98794 98840 ;S IO("ZIO")="/dev/pts/0" 98795 "RTN","C0CEVC",1 61,0)98841 "RTN","C0CEVC",177,0) 98796 98842 ;S IOBS="$C(8)" 98797 "RTN","C0CEVC",1 62,0)98843 "RTN","C0CEVC",178,0) 98798 98844 ;S IOF="!!!!!!!!!!!!!!!!!!!!!!!!,#,$C(27,91,50,74,27,91,72)" 98799 "RTN","C0CEVC",1 63,0)98845 "RTN","C0CEVC",179,0) 98800 98846 ;S IOM=80 98801 "RTN","C0CEVC",1 64,0)98847 "RTN","C0CEVC",180,0) 98802 98848 ;S ION="GTM/UNIX TELNET" 98803 "RTN","C0CEVC",1 65,0)98849 "RTN","C0CEVC",181,0) 98804 98850 ;S IOS=50 98805 "RTN","C0CEVC",1 66,0)98851 "RTN","C0CEVC",182,0) 98806 98852 ;S IOSL=24 98807 "RTN","C0CEVC",1 67,0)98853 "RTN","C0CEVC",183,0) 98808 98854 ;S IOST="C-VT100" 98809 "RTN","C0CEVC",1 68,0)98855 "RTN","C0CEVC",184,0) 98810 98856 ;S IOST(0)=9 98811 "RTN","C0CEVC",1 69,0)98857 "RTN","C0CEVC",185,0) 98812 98858 ;S IOT="VTRM" 98813 "RTN","C0CEVC",1 70,0)98859 "RTN","C0CEVC",186,0) 98814 98860 ;S IOXY="W $C(27,91)_((DY+1))_$C(59)_((DX+1))_$C(72)" 98815 "RTN","C0CEVC",1 71,0)98861 "RTN","C0CEVC",187,0) 98816 98862 S U="^" 98817 "RTN","C0CEVC",1 72,0)98863 "RTN","C0CEVC",188,0) 98818 98864 S X="1;DIC(4.2," 98819 "RTN","C0CEVC",1 73,0)98865 "RTN","C0CEVC",189,0) 98820 98866 S XPARSYS="1;DIC(4.2," 98821 "RTN","C0CEVC",1 74,0)98867 "RTN","C0CEVC",190,0) 98822 98868 S XQXFLG="^^XUP" 98823 "RTN","C0CEVC",1 75,0)98869 "RTN","C0CEVC",191,0) 98824 98870 S Y="DEV^VISTA^hollywood^VISTA:hollywood" 98825 "RTN","C0CEVC",1 76,0)98871 "RTN","C0CEVC",192,0) 98826 98872 Q 98827 "RTN","C0CEVC",1 77,0)98873 "RTN","C0CEVC",193,0) 98828 98874 ; 98829 98875 "RTN","C0CEWD") 98830 0^77^B5 60767898876 0^77^B5530676 98831 98877 "RTN","C0CEWD",1,0) 98832 98878 C0CEWD ; CCDCCR/GPL - CCR EWD utilities; 1/6/11 98833 98879 "RTN","C0CEWD",2,0) 98834 ;;1.2;C 0C;;May 11, 2012;Build 5098880 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 98835 98881 "RTN","C0CEWD",3,0) 98836 ; Copyright 2011 George Lilly. Licensed under the terms of the GNU98882 ; 98837 98883 "RTN","C0CEWD",4,0) 98838 ; General Public License See attached copy of the License.98884 ;Copyright 2011 George Lilly. 98839 98885 "RTN","C0CEWD",5,0) 98840 98886 ; 98841 98887 "RTN","C0CEWD",6,0) 98842 ; This program is free software;you can redistribute it and/or modify98888 ; This program is free software: you can redistribute it and/or modify 98843 98889 "RTN","C0CEWD",7,0) 98844 ; it under the terms of the GNU General Public License as published by98890 ; it under the terms of the GNU Affero General Public License as 98845 98891 "RTN","C0CEWD",8,0) 98846 ; the Free Software Foundation; either version 2 of the License, or98892 ; published by the Free Software Foundation, either version 3 of the 98847 98893 "RTN","C0CEWD",9,0) 98848 ; (at your option) any later version.98894 ; License, or (at your option) any later version. 98849 98895 "RTN","C0CEWD",10,0) 98850 98896 ; 98851 98897 "RTN","C0CEWD",11,0) 98852 ; This program is distributed in the hope that it will be useful,98898 ; This program is distributed in the hope that it will be useful, 98853 98899 "RTN","C0CEWD",12,0) 98854 ; but WITHOUT ANY WARRANTY; without even the implied warranty of98900 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 98855 98901 "RTN","C0CEWD",13,0) 98856 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the98902 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 98857 98903 "RTN","C0CEWD",14,0) 98858 ; GNUGeneral Public License for more details.98904 ; GNU Affero General Public License for more details. 98859 98905 "RTN","C0CEWD",15,0) 98860 98906 ; 98861 98907 "RTN","C0CEWD",16,0) 98862 ; You should have received a copy of the GNU General Public License along98908 ; You should have received a copy of the GNU Affero General Public License 98863 98909 "RTN","C0CEWD",17,0) 98864 ; with this program; if not, write to the Free Software Foundation, Inc.,98910 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 98865 98911 "RTN","C0CEWD",18,0) 98866 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.98912 ; 98867 98913 "RTN","C0CEWD",19,0) 98868 ;98914 Q 98869 98915 "RTN","C0CEWD",20,0) 98916 ; 98917 "RTN","C0CEWD",21,0) 98918 TOKEN() ; EXTRINSIC WHICH RETURNS A NEW RANDOM TOKEN 98919 "RTN","C0CEWD",22,0) 98920 Q $$UUID^C0CUTIL ; USE THE UUID FUNCTION IN THE CCR PACKAGE 98921 "RTN","C0CEWD",23,0) 98922 ; 98923 "RTN","C0CEWD",24,0) 98924 STORE(ZARY) ; STORE AN ARRAY OF VALUES INDEXED BY A NEW TOKEN 98925 "RTN","C0CEWD",25,0) 98926 ; IN ^TMP("C0E","TOKEN") FOR LATER RETRIEVAL FROM INSIDE AN EWD SESSION 98927 "RTN","C0CEWD",26,0) 98928 ; RETURNS THE TOKEN. ZARY IS PASSED BY NAME 98929 "RTN","C0CEWD",27,0) 98930 N ZT 98931 "RTN","C0CEWD",28,0) 98932 S ZT=$$TOKEN ; GET A NEW TOKEN 98933 "RTN","C0CEWD",29,0) 98934 M ^TMP("C0E","TOKEN",ZT)=@ZARY ; 98935 "RTN","C0CEWD",30,0) 98936 Q ZT 98937 "RTN","C0CEWD",31,0) 98938 ; 98939 "RTN","C0CEWD",32,0) 98940 GET(C0ERTN,C0ETOKEN,NOKILL) ; RETRIEVE A STORED ARRAY INDEXED BY ZTOKEN 98941 "RTN","C0CEWD",33,0) 98942 ; KILL THE ARRAY AFTER RETRIEVAL UNLESS NOKILL=1 98943 "RTN","C0CEWD",34,0) 98944 ; C0ERTN IS PASSED BY NAME 98945 "RTN","C0CEWD",35,0) 98946 I '$D(^TMP("C0E","TOKEN",C0ETOKEN)) D Q ; DOESN'T EXIST 98947 "RTN","C0CEWD",36,0) 98948 . S @C0ERTN="" ; PASS BACK NULL 98949 "RTN","C0CEWD",37,0) 98950 M @C0ERTN=^TMP("C0E","TOKEN",C0ETOKEN) ; RETRIEVE 98951 "RTN","C0CEWD",38,0) 98952 I $G(NOKILL)'=1 K ^TMP("C0E","TOKEN",C0ETOKEN) ; DELETE 98953 "RTN","C0CEWD",39,0) 98870 98954 Q 98871 "RTN","C0CEWD",21,0)98872 ;98873 "RTN","C0CEWD",22,0)98874 TOKEN() ; EXTRINSIC WHICH RETURNS A NEW RANDOM TOKEN98875 "RTN","C0CEWD",23,0)98876 Q $$UUID^C0CUTIL ; USE THE UUID FUNCTION IN THE CCR PACKAGE98877 "RTN","C0CEWD",24,0)98878 ;98879 "RTN","C0CEWD",25,0)98880 STORE(ZARY) ; STORE AN ARRAY OF VALUES INDEXED BY A NEW TOKEN98881 "RTN","C0CEWD",26,0)98882 ; IN ^TMP("C0E","TOKEN") FOR LATER RETRIEVAL FROM INSIDE AN EWD SESSION98883 "RTN","C0CEWD",27,0)98884 ; RETURNS THE TOKEN. ZARY IS PASSED BY NAME98885 "RTN","C0CEWD",28,0)98886 N ZT98887 "RTN","C0CEWD",29,0)98888 S ZT=$$TOKEN ; GET A NEW TOKEN98889 "RTN","C0CEWD",30,0)98890 M ^TMP("C0E","TOKEN",ZT)=@ZARY ;98891 "RTN","C0CEWD",31,0)98892 Q ZT98893 "RTN","C0CEWD",32,0)98894 ;98895 "RTN","C0CEWD",33,0)98896 GET(C0ERTN,C0ETOKEN,NOKILL) ; RETRIEVE A STORED ARRAY INDEXED BY ZTOKEN98897 "RTN","C0CEWD",34,0)98898 ; KILL THE ARRAY AFTER RETRIEVAL UNLESS NOKILL=198899 "RTN","C0CEWD",35,0)98900 ; C0ERTN IS PASSED BY NAME98901 "RTN","C0CEWD",36,0)98902 I '$D(^TMP("C0E","TOKEN",C0ETOKEN)) D Q ; DOESN'T EXIST98903 "RTN","C0CEWD",37,0)98904 . S @C0ERTN="" ; PASS BACK NULL98905 "RTN","C0CEWD",38,0)98906 M @C0ERTN=^TMP("C0E","TOKEN",C0ETOKEN) ; RETRIEVE98907 "RTN","C0CEWD",39,0)98908 I $G(NOKILL)'=1 K ^TMP("C0E","TOKEN",C0ETOKEN) ; DELETE98909 98955 "RTN","C0CEWD",40,0) 98910 Q98956 ; 98911 98957 "RTN","C0CEWD",41,0) 98912 ; 98958 URLTOKEN(sessid) ; EXTRINSIC WHICH RETRIEVES THE TOKEN PASSED ON THE URL 98913 98959 "RTN","C0CEWD",42,0) 98914 URLTOKEN(sessid) ; EXTRINSIC WHICH RETRIEVES THE TOKEN PASSED ON THE URL 98960 ; IN EWD EXAMPLE: https://example.com/ewd/myApp/index.ewd?token="12345" 98915 98961 "RTN","C0CEWD",43,0) 98916 ; IN EWD EXAMPLE: https://example.com/ewd/myApp/index.ewd?token="12345"98962 N token 98917 98963 "RTN","C0CEWD",44,0) 98918 N token98964 S token="" 98919 98965 "RTN","C0CEWD",45,0) 98920 S token=""98966 s token=$$getRequestValue^%zewdAPI("token",sessid) 98921 98967 "RTN","C0CEWD",46,0) 98922 s token=$ $getRequestValue^%zewdAPI("token",sessid)98968 s token=$tr(token,"""") ; strip out quotes 98923 98969 "RTN","C0CEWD",47,0) 98924 s token=$tr(token,"""") ; strip out quotes98970 Q token 98925 98971 "RTN","C0CEWD",48,0) 98926 Q token98972 ; 98927 98973 "RTN","C0CEWD",49,0) 98928 ; 98974 cbTestMethod(prefix,seedValue,lastSeedValue,optionNo,options) 98929 98975 "RTN","C0CEWD",50,0) 98930 cbTestMethod(prefix,seedValue,lastSeedValue,optionNo,options) 98976 ; 98931 98977 "RTN","C0CEWD",51,0) 98932 ;98978 n maxNo,noFound 98933 98979 "RTN","C0CEWD",52,0) 98934 n maxNo,noFound98980 ; 98935 98981 "RTN","C0CEWD",53,0) 98936 ;98982 s maxNo=50 98937 98983 "RTN","C0CEWD",54,0) 98938 s maxNo=5098984 s noFound=0 98939 98985 "RTN","C0CEWD",55,0) 98940 s noFound=098986 f s seedValue=$o(^DPT("B",seedValue)) q:seedValue="" q:noFound=maxNo d 98941 98987 "RTN","C0CEWD",56,0) 98942 f s seedValue=$o(^DPT("B",seedValue)) q:seedValue="" q:noFound=maxNo d98988 . s lastSeedValue=seedValue 98943 98989 "RTN","C0CEWD",57,0) 98944 . s lastSeedValue=seedValue98990 . i prefix'="",$e(seedValue,1,$l(prefix))'=prefix q 98945 98991 "RTN","C0CEWD",58,0) 98946 . i prefix'="",$e(seedValue,1,$l(prefix))'=prefix q98992 . s optionNo=optionNo+1 98947 98993 "RTN","C0CEWD",59,0) 98948 . s optionNo=optionNo+198994 . s noFound=noFound+1 98949 98995 "RTN","C0CEWD",60,0) 98950 . s noFound=noFound+198996 . s options(optionNo)=seedValue 98951 98997 "RTN","C0CEWD",61,0) 98952 . s options(optionNo)=seedValue98998 QUIT 98953 98999 "RTN","C0CEWD",62,0) 98954 QUIT99000 ; 98955 99001 "RTN","C0CEWD",63,0) 98956 ;99002 set1 ; 98957 99003 "RTN","C0CEWD",64,0) 98958 set1 ; 99004 s ^zewd("comboPlus","methodMap","test")="cbTestMethod^C0PEREW" 98959 99005 "RTN","C0CEWD",65,0) 98960 s ^zewd("comboPlus","methodMap","test")="cbTestMethod^C0PEREW"99006 q 98961 99007 "RTN","C0CEWD",66,0) 98962 q99008 ; 98963 99009 "RTN","C0CEWD",67,0) 98964 ;99010 test1(sessid) ; 98965 99011 "RTN","C0CEWD",68,0) 98966 test1(sessid) ; 99012 d setSessionValue^%zewdAPI("testing","ZZ",sessid) 98967 99013 "RTN","C0CEWD",69,0) 98968 d setSessionValue^%zewdAPI("testing","ZZ",sessid)99014 q 0 98969 99015 "RTN","C0CEWD",70,0) 98970 q 098971 "RTN","C0CEWD",71,0)98972 99016 ; 98973 99017 "RTN","C0CEWD1") 98974 0^78^B6 56307099018 0^78^B6276162 98975 99019 "RTN","C0CEWD1",1,0) 98976 99020 C0CEWD1 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08 98977 99021 "RTN","C0CEWD1",2,0) 98978 ;;1.2;C 0C;;May 11, 2012;Build 5099022 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 98979 99023 "RTN","C0CEWD1",3,0) 98980 ; Copyright 2009 George Lilly. Licensed under the terms of the GNU99024 ; 98981 99025 "RTN","C0CEWD1",4,0) 98982 ; General Public License See attached copy of the License.99026 ; This program is free software: you can redistribute it and/or modify 98983 99027 "RTN","C0CEWD1",5,0) 98984 ; 99028 ; it under the terms of the GNU Affero General Public License as 98985 99029 "RTN","C0CEWD1",6,0) 98986 ; This program is free software; you can redistribute it and/or modify99030 ; published by the Free Software Foundation, either version 3 of the 98987 99031 "RTN","C0CEWD1",7,0) 98988 ; it under the terms of the GNU General Public License as published by99032 ; License, or (at your option) any later version. 98989 99033 "RTN","C0CEWD1",8,0) 98990 ; the Free Software Foundation; either version 2 of the License, or99034 ; 98991 99035 "RTN","C0CEWD1",9,0) 98992 ; (at your option) any later version.99036 ; This program is distributed in the hope that it will be useful, 98993 99037 "RTN","C0CEWD1",10,0) 98994 ; 99038 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 98995 99039 "RTN","C0CEWD1",11,0) 98996 ; This program is distributed in the hope that it will be useful,99040 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 98997 99041 "RTN","C0CEWD1",12,0) 98998 ; but WITHOUT ANY WARRANTY; without even the implied warranty of99042 ; GNU Affero General Public License for more details. 98999 99043 "RTN","C0CEWD1",13,0) 99000 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the99044 ; 99001 99045 "RTN","C0CEWD1",14,0) 99002 ; GNU General Public License for more details.99046 ; You should have received a copy of the GNU Affero General Public License 99003 99047 "RTN","C0CEWD1",15,0) 99004 ; 99048 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 99005 99049 "RTN","C0CEWD1",16,0) 99006 ; You should have received a copy of the GNU General Public License along99050 ; 99007 99051 "RTN","C0CEWD1",17,0) 99008 ;with this program; if not, write to the Free Software Foundation, Inc.,99052 Q 99009 99053 "RTN","C0CEWD1",18,0) 99010 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.99054 ; 99011 99055 "RTN","C0CEWD1",19,0) 99012 ; 99056 TEST(filepath) ; filepath IS THE PATH/FILE TO BE READ IN 99013 99057 "RTN","C0CEWD1",20,0) 99014 Q99058 i $g(^%ZISH)["" d ; if the VistA Kernal routine %ZISH exists 99015 99059 "RTN","C0CEWD1",21,0) 99016 ;99060 . n zfile,zpath,ztmp s (zfile,zpath,ztmp)="" 99017 99061 "RTN","C0CEWD1",22,0) 99018 TEST(filepath) ; filepath IS THE PATH/FILE TO BE READ IN 99062 . s zfile=$re($p($re(filepath),"/",1)) ;file name 99019 99063 "RTN","C0CEWD1",23,0) 99020 i $g(^%ZISH)["" d ; if the VistA Kernal routine %ZISH exists99064 . s zpath=$p(filepath,zfile,1) ; file path 99021 99065 "RTN","C0CEWD1",24,0) 99022 . n zfile,zpath,ztmp s (zfile,zpath,ztmp)=""99066 . s ztmp=$na(^CacheTempEWD($j,0)) 99023 99067 "RTN","C0CEWD1",25,0) 99068 . s ok=$$FTG^%ZISH(zpath,zfile,ztmp,2) ; import the file incrementing subscr 2 99069 "RTN","C0CEWD1",26,0) 99070 q 99071 "RTN","C0CEWD1",27,0) 99072 ; 99073 "RTN","C0CEWD1",28,0) 99074 TEST2 ; 99075 "RTN","C0CEWD1",29,0) 99076 s zfilepath="/home/vademo2/CCR/PAT_780_CCR_V1_0_17.xml" 99077 "RTN","C0CEWD1",30,0) 99078 ;s ok=$$gtmImportFile^%zewdHTMLParser(zfilepath) 99079 "RTN","C0CEWD1",31,0) 99080 s ok=$$LOAD(zfilepath) ;load the XML file to the EWD global 99081 "RTN","C0CEWD1",32,0) 99082 s ok=$$parseDocument^%zewdHTMLParser("DerekDOM",0) 99083 "RTN","C0CEWD1",33,0) 99084 ;s ok=$$parseXMLFile^%zewdAPI(zfilepath,"fourthDOM") 99085 "RTN","C0CEWD1",34,0) 99086 w ok,! 99087 "RTN","C0CEWD1",35,0) 99088 q 99089 "RTN","C0CEWD1",36,0) 99090 ; 99091 "RTN","C0CEWD1",37,0) 99092 LOAD(filepath) ; load an xml file into the EWD global for DOM processing 99093 "RTN","C0CEWD1",38,0) 99094 ; need to call s error=$$parseDocument^%zewdHTMLParser(docName,isHTML) 99095 "RTN","C0CEWD1",39,0) 99096 ; after to process it to the DOM - isHTML=0 for XML files 99097 "RTN","C0CEWD1",40,0) 99098 n i 99099 "RTN","C0CEWD1",41,0) 99100 i $g(^%ZISH)["" d QUIT i ; if VistA Kernal routine %ZISH exists - gpl 2/23/09 99101 "RTN","C0CEWD1",42,0) 99102 . n zfile,zpath,ztmp,zok s (zfile,zpath,ztmp)="" 99103 "RTN","C0CEWD1",43,0) 99024 99104 . s zfile=$re($p($re(filepath),"/",1)) ;file name 99025 "RTN","C0CEWD1", 26,0)99105 "RTN","C0CEWD1",44,0) 99026 99106 . s zpath=$p(filepath,zfile,1) ; file path 99027 "RTN","C0CEWD1", 27,0)99107 "RTN","C0CEWD1",45,0) 99028 99108 . s ztmp=$na(^CacheTempEWD($j,0)) 99029 "RTN","C0CEWD1",28,0) 99030 . s ok=$$FTG^%ZISH(zpath,zfile,ztmp,2) ; import the file incrementing subscr 2 99031 "RTN","C0CEWD1",29,0) 99109 "RTN","C0CEWD1",46,0) 99110 . s zok=$$FTG^%ZISH(zpath,zfile,ztmp,2) ; import the file increment subscr 2 99111 "RTN","C0CEWD1",47,0) 99112 . s i=$o(^CacheTempEWD($j,""),-1) ; highest line number 99113 "RTN","C0CEWD1",48,0) 99114 q i 99115 "RTN","C0CEWD1",49,0) 99116 ; 99117 "RTN","C0CEWD1",50,0) 99118 Q(ZQ,ZD) ; SEND QUERY ZQ TO DOM ZD AND DIPLAY NODES RETURNED 99119 "RTN","C0CEWD1",51,0) 99120 I '$D(ZD) S ZD="DerekDOM" 99121 "RTN","C0CEWD1",52,0) 99122 s error=$$select^%zewdXPath(ZQ,ZD,.nodes) ; 99123 "RTN","C0CEWD1",53,0) 99124 d displayNodes^%zewdXPath(.nodes) 99125 "RTN","C0CEWD1",54,0) 99032 99126 q 99033 "RTN","C0CEWD1",30,0)99034 ;99035 "RTN","C0CEWD1",31,0)99036 TEST2 ;99037 "RTN","C0CEWD1",32,0)99038 s zfilepath="/home/vademo2/CCR/PAT_780_CCR_V1_0_17.xml"99039 "RTN","C0CEWD1",33,0)99040 ;s ok=$$gtmImportFile^%zewdHTMLParser(zfilepath)99041 "RTN","C0CEWD1",34,0)99042 s ok=$$LOAD(zfilepath) ;load the XML file to the EWD global99043 "RTN","C0CEWD1",35,0)99044 s ok=$$parseDocument^%zewdHTMLParser("DerekDOM",0)99045 "RTN","C0CEWD1",36,0)99046 ;s ok=$$parseXMLFile^%zewdAPI(zfilepath,"fourthDOM")99047 "RTN","C0CEWD1",37,0)99048 w ok,!99049 "RTN","C0CEWD1",38,0)99050 q99051 "RTN","C0CEWD1",39,0)99052 ;99053 "RTN","C0CEWD1",40,0)99054 LOAD(filepath) ; load an xml file into the EWD global for DOM processing99055 "RTN","C0CEWD1",41,0)99056 ; need to call s error=$$parseDocument^%zewdHTMLParser(docName,isHTML)99057 "RTN","C0CEWD1",42,0)99058 ; after to process it to the DOM - isHTML=0 for XML files99059 "RTN","C0CEWD1",43,0)99060 n i99061 "RTN","C0CEWD1",44,0)99062 i $g(^%ZISH)["" d QUIT i ; if VistA Kernal routine %ZISH exists - gpl 2/23/0999063 "RTN","C0CEWD1",45,0)99064 . n zfile,zpath,ztmp,zok s (zfile,zpath,ztmp)=""99065 "RTN","C0CEWD1",46,0)99066 . s zfile=$re($p($re(filepath),"/",1)) ;file name99067 "RTN","C0CEWD1",47,0)99068 . s zpath=$p(filepath,zfile,1) ; file path99069 "RTN","C0CEWD1",48,0)99070 . s ztmp=$na(^CacheTempEWD($j,0))99071 "RTN","C0CEWD1",49,0)99072 . s zok=$$FTG^%ZISH(zpath,zfile,ztmp,2) ; import the file increment subscr 299073 "RTN","C0CEWD1",50,0)99074 . s i=$o(^CacheTempEWD($j,""),-1) ; highest line number99075 "RTN","C0CEWD1",51,0)99076 q i99077 "RTN","C0CEWD1",52,0)99078 ;99079 "RTN","C0CEWD1",53,0)99080 Q(ZQ,ZD) ; SEND QUERY ZQ TO DOM ZD AND DIPLAY NODES RETURNED99081 "RTN","C0CEWD1",54,0)99082 I '$D(ZD) S ZD="DerekDOM"99083 99127 "RTN","C0CEWD1",55,0) 99084 s error=$$select^%zewdXPath(ZQ,ZD,.nodes);99128 ; 99085 99129 "RTN","C0CEWD1",56,0) 99086 d displayNodes^%zewdXPath(.nodes) 99130 GET1URL0(URL) ; 99087 99131 "RTN","C0CEWD1",57,0) 99088 q99132 s ok=$$httpGET^%zewdGTM(URL,.gpl) 99089 99133 "RTN","C0CEWD1",58,0) 99090 ;99134 D INDEX^C0CXPATH("gpl","gpl2") 99091 99135 "RTN","C0CEWD1",59,0) 99092 GET1URL0(URL) ; 99136 W !,"S URL=""",URL,"""",! 99093 99137 "RTN","C0CEWD1",60,0) 99094 s ok=$$httpGET^%zewdGTM(URL,.gpl)99138 S G="" 99095 99139 "RTN","C0CEWD1",61,0) 99096 D INDEX^C0CXPATH("gpl","gpl2")99140 F S G=$O(gpl2(G)) Q:G="" D ; 99097 99141 "RTN","C0CEWD1",62,0) 99098 W !,"S URL=""",URL,"""",!99142 . W " S VDX(""",G,""")=""",gpl2(G),"""",! 99099 99143 "RTN","C0CEWD1",63,0) 99100 S G=""99144 W ! 99101 99145 "RTN","C0CEWD1",64,0) 99102 F S G=$O(gpl2(G)) Q:G="" D ;99103 "RTN","C0CEWD1",65,0)99104 . W " S VDX(""",G,""")=""",gpl2(G),"""",!99105 "RTN","C0CEWD1",66,0)99106 W !99107 "RTN","C0CEWD1",67,0)99108 99146 Q 99109 99147 "RTN","C0CFM1") 99110 0^24^B2 704809999148 0^24^B26826658 99111 99149 "RTN","C0CFM1",1,0) 99112 99150 C0CFM1 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08 99113 99151 "RTN","C0CFM1",2,0) 99114 ;;1.2;C 0C;;May 11, 2012;Build 5099152 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 99115 99153 "RTN","C0CFM1",3,0) 99116 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU99154 ;Copyright 2009 George Lilly. 99117 99155 "RTN","C0CFM1",4,0) 99118 ; General Public License See attached copy of the License.99156 ; 99119 99157 "RTN","C0CFM1",5,0) 99120 ; 99158 ; This program is free software: you can redistribute it and/or modify 99121 99159 "RTN","C0CFM1",6,0) 99122 ; This program is free software; you can redistribute it and/or modify99160 ; it under the terms of the GNU Affero General Public License as 99123 99161 "RTN","C0CFM1",7,0) 99124 ; it under the terms of the GNU General Public License as published by99162 ; published by the Free Software Foundation, either version 3 of the 99125 99163 "RTN","C0CFM1",8,0) 99126 ; the Free Software Foundation; either version 2 of the License, or99164 ; License, or (at your option) any later version. 99127 99165 "RTN","C0CFM1",9,0) 99128 ; (at your option) any later version.99166 ; 99129 99167 "RTN","C0CFM1",10,0) 99130 ; 99168 ; This program is distributed in the hope that it will be useful, 99131 99169 "RTN","C0CFM1",11,0) 99132 ; This program is distributed in the hope that it will be useful,99170 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 99133 99171 "RTN","C0CFM1",12,0) 99134 ; but WITHOUT ANY WARRANTY; without even the implied warranty of99172 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 99135 99173 "RTN","C0CFM1",13,0) 99136 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the99174 ; GNU Affero General Public License for more details. 99137 99175 "RTN","C0CFM1",14,0) 99138 ; GNU General Public License for more details.99176 ; 99139 99177 "RTN","C0CFM1",15,0) 99140 ; 99178 ; You should have received a copy of the GNU Affero General Public License 99141 99179 "RTN","C0CFM1",16,0) 99142 ; You should have received a copy of the GNU General Public License along99180 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 99143 99181 "RTN","C0CFM1",17,0) 99144 ; with this program; if not, write to the Free Software Foundation, Inc.,99182 ; 99145 99183 "RTN","C0CFM1",18,0) 99146 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.99184 ; 99147 99185 "RTN","C0CFM1",19,0) 99148 ;99186 W "This is the CCR FILEMAN Utility Library ",! 99149 99187 "RTN","C0CFM1",20,0) 99150 W "This is the CCR FILEMAN Utility Library ",!99188 W ! 99151 99189 "RTN","C0CFM1",21,0) 99152 W !99190 Q 99153 99191 "RTN","C0CFM1",22,0) 99192 ; 99193 "RTN","C0CFM1",23,0) 99194 PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE 99195 "RTN","C0CFM1",24,0) 99196 ; 99197 "RTN","C0CFM1",25,0) 99198 S C0CGLB=$NA(^TMP("GPLRIM","VARS",DFN)) 99199 "RTN","C0CFM1",26,0) 99200 I '$D(ZWHICH) S ZWHICH="ALL" 99201 "RTN","C0CFM1",27,0) 99202 I ZWHICH'="ALL" D ; SINGLE SECTION REQUESTED 99203 "RTN","C0CFM1",28,0) 99204 . S C0CVARS=$NA(@C0CGLB@(ZWHICH)) 99205 "RTN","C0CFM1",29,0) 99206 . D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION 99207 "RTN","C0CFM1",30,0) 99208 E D ; MULTIPLE SECTIONS 99209 "RTN","C0CFM1",31,0) 99210 . S C0CVARS=$NA(@C0CGLB) 99211 "RTN","C0CFM1",32,0) 99212 . S C0CI="" 99213 "RTN","C0CFM1",33,0) 99214 . F S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI="" D ;FOR EACH SECTION 99215 "RTN","C0CFM1",34,0) 99216 . . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION 99217 "RTN","C0CFM1",35,0) 99218 . . D PUTRIM1(DFN,C0CI,C0CVARSN) 99219 "RTN","C0CFM1",36,0) 99154 99220 Q 99155 "RTN","C0CFM1",23,0)99156 ;99157 "RTN","C0CFM1",24,0)99158 PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE99159 "RTN","C0CFM1",25,0)99160 ;99161 "RTN","C0CFM1",26,0)99162 S C0CGLB=$NA(^TMP("GPLRIM","VARS",DFN))99163 "RTN","C0CFM1",27,0)99164 I '$D(ZWHICH) S ZWHICH="ALL"99165 "RTN","C0CFM1",28,0)99166 I ZWHICH'="ALL" D ; SINGLE SECTION REQUESTED99167 "RTN","C0CFM1",29,0)99168 . S C0CVARS=$NA(@C0CGLB@(ZWHICH))99169 "RTN","C0CFM1",30,0)99170 . D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION99171 "RTN","C0CFM1",31,0)99172 E D ; MULTIPLE SECTIONS99173 "RTN","C0CFM1",32,0)99174 . S C0CVARS=$NA(@C0CGLB)99175 "RTN","C0CFM1",33,0)99176 . S C0CI=""99177 "RTN","C0CFM1",34,0)99178 . F S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI="" D ;FOR EACH SECTION99179 "RTN","C0CFM1",35,0)99180 . . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION99181 "RTN","C0CFM1",36,0)99182 . . D PUTRIM1(DFN,C0CI,C0CVARSN)99183 99221 "RTN","C0CFM1",37,0) 99222 ; 99223 "RTN","C0CFM1",38,0) 99224 PUTRIM1(DFN,ZZTYP,ZVARS) ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS 99225 "RTN","C0CFM1",39,0) 99226 ; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1" 99227 "RTN","C0CFM1",40,0) 99228 S C0CX=0 99229 "RTN","C0CFM1",41,0) 99230 F S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX="" D ; FOR EACH OCCURANCE 99231 "RTN","C0CFM1",42,0) 99232 . W "ZOCC=",C0CX,! 99233 "RTN","C0CFM1",43,0) 99234 . S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE 99235 "RTN","C0CFM1",44,0) 99236 . D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE 99237 "RTN","C0CFM1",45,0) 99184 99238 Q 99185 "RTN","C0CFM1",38,0)99186 ;99187 "RTN","C0CFM1",39,0)99188 PUTRIM1(DFN,ZZTYP,ZVARS) ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS99189 "RTN","C0CFM1",40,0)99190 ; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1"99191 "RTN","C0CFM1",41,0)99192 S C0CX=099193 "RTN","C0CFM1",42,0)99194 F S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX="" D ; FOR EACH OCCURANCE99195 "RTN","C0CFM1",43,0)99196 . W "ZOCC=",C0CX,!99197 "RTN","C0CFM1",44,0)99198 . S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE99199 "RTN","C0CFM1",45,0)99200 . D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE99201 99239 "RTN","C0CFM1",46,0) 99240 ; 99241 "RTN","C0CFM1",47,0) 99242 PUTELS(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE 99243 "RTN","C0CFM1",48,0) 99244 ; ^C0C(171.201, DFN IS THE PATIENT IEN PASSED BY VALUE 99245 "RTN","C0CFM1",49,0) 99246 ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE 99247 "RTN","C0CFM1",50,0) 99248 ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC 99249 "RTN","C0CFM1",51,0) 99250 ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM 99251 "RTN","C0CFM1",52,0) 99252 ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT 99253 "RTN","C0CFM1",53,0) 99254 ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES 99255 "RTN","C0CFM1",54,0) 99256 ; 99257 "RTN","C0CFM1",55,0) 99258 S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1 99259 "RTN","C0CFM1",56,0) 99260 ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE 99261 "RTN","C0CFM1",57,0) 99262 N ZF,ZFV S ZF=171.201 S ZFV=171.2012 99263 "RTN","C0CFM1",58,0) 99264 S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS 99265 "RTN","C0CFM1",59,0) 99266 N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER 99267 "RTN","C0CFM1",60,0) 99268 N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,"")) 99269 "RTN","C0CFM1",61,0) 99270 W "ZTYPE: ",ZTYPE," ",ZTYPN,! 99271 "RTN","C0CFM1",62,0) 99272 N ZVARN ; IEN OF VARIABLE BEING PROCESSED 99273 "RTN","C0CFM1",63,0) 99274 ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE 99275 "RTN","C0CFM1",64,0) 99276 S C0CFDA(ZF,"?+1,",.01)=DFN 99277 "RTN","C0CFM1",65,0) 99278 S C0CFDA(ZF,"?+1,",.02)=ZSRC 99279 "RTN","C0CFM1",66,0) 99280 S C0CFDA(ZF,"?+1,",.03)=ZTYPN 99281 "RTN","C0CFM1",67,0) 99282 S C0CFDA(ZF,"?+1,",.04)=ZOCC ;CREATE OCCURANCE 99283 "RTN","C0CFM1",68,0) 99284 K ZERR 99285 "RTN","C0CFM1",69,0) 99286 D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER 99287 "RTN","C0CFM1",70,0) 99288 I $D(ZERR) S $EC=",U1," 99289 "RTN","C0CFM1",71,0) 99290 K C0CFDA 99291 "RTN","C0CFM1",72,0) 99292 S ZD0=$O(^C0C(ZF,"C",DFN,ZSRC,ZTYPN,ZOCC,"")) 99293 "RTN","C0CFM1",73,0) 99294 W "RECORD NUMBER: ",ZD0,! 99295 "RTN","C0CFM1",74,0) 99296 ;B 99297 "RTN","C0CFM1",75,0) 99298 S ZCNT=0 99299 "RTN","C0CFM1",76,0) 99300 S ZC0CI="" ; 99301 "RTN","C0CFM1",77,0) 99302 F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ; 99303 "RTN","C0CFM1",78,0) 99304 . I ZC0CI'="M" D ; NOT A SUBVARIABLE 99305 "RTN","C0CFM1",79,0) 99306 . . S ZCNT=ZCNT+1 ;INCREMENT COUNT 99307 "RTN","C0CFM1",80,0) 99308 . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT 99309 "RTN","C0CFM1",81,0) 99310 . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND 99311 "RTN","C0CFM1",82,0) 99312 . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN 99313 "RTN","C0CFM1",83,0) 99314 . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI) 99315 "RTN","C0CFM1",84,0) 99316 . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN 99317 "RTN","C0CFM1",85,0) 99318 . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI) 99319 "RTN","C0CFM1",86,0) 99320 ;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT" 99321 "RTN","C0CFM1",87,0) 99322 ;S GT1(170,"?+1,",12)="DIR" 99323 "RTN","C0CFM1",88,0) 99324 ;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT" 99325 "RTN","C0CFM1",89,0) 99326 ;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT" 99327 "RTN","C0CFM1",90,0) 99328 D CLEAN^DILF 99329 "RTN","C0CFM1",91,0) 99330 D UPDATE^DIE("","C0CFDA","","ZERR") 99331 "RTN","C0CFM1",92,0) 99202 99332 Q 99203 "RTN","C0CFM1",47,0)99204 ;99205 "RTN","C0CFM1",48,0)99206 PUTELS(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE99207 "RTN","C0CFM1",49,0)99208 ; ^C0C(171.201, DFN IS THE PATIENT IEN PASSED BY VALUE99209 "RTN","C0CFM1",50,0)99210 ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE99211 "RTN","C0CFM1",51,0)99212 ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC99213 "RTN","C0CFM1",52,0)99214 ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM99215 "RTN","C0CFM1",53,0)99216 ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT99217 "RTN","C0CFM1",54,0)99218 ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES99219 "RTN","C0CFM1",55,0)99220 ;99221 "RTN","C0CFM1",56,0)99222 S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 199223 "RTN","C0CFM1",57,0)99224 ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE99225 "RTN","C0CFM1",58,0)99226 N ZF,ZFV S ZF=171.201 S ZFV=171.201299227 "RTN","C0CFM1",59,0)99228 S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS99229 "RTN","C0CFM1",60,0)99230 N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER99231 "RTN","C0CFM1",61,0)99232 N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))99233 "RTN","C0CFM1",62,0)99234 W "ZTYPE: ",ZTYPE," ",ZTYPN,!99235 "RTN","C0CFM1",63,0)99236 N ZVARN ; IEN OF VARIABLE BEING PROCESSED99237 "RTN","C0CFM1",64,0)99238 ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE99239 "RTN","C0CFM1",65,0)99240 S C0CFDA(ZF,"?+1,",.01)=DFN99241 "RTN","C0CFM1",66,0)99242 S C0CFDA(ZF,"?+1,",.02)=ZSRC99243 "RTN","C0CFM1",67,0)99244 S C0CFDA(ZF,"?+1,",.03)=ZTYPN99245 "RTN","C0CFM1",68,0)99246 S C0CFDA(ZF,"?+1,",.04)=ZOCC ;CREATE OCCURANCE99247 "RTN","C0CFM1",69,0)99248 K ZERR99249 "RTN","C0CFM1",70,0)99250 D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER99251 "RTN","C0CFM1",71,0)99252 I $D(ZERR) B ;OOPS99253 "RTN","C0CFM1",72,0)99254 K C0CFDA99255 "RTN","C0CFM1",73,0)99256 S ZD0=$O(^C0C(ZF,"C",DFN,ZSRC,ZTYPN,ZOCC,""))99257 "RTN","C0CFM1",74,0)99258 W "RECORD NUMBER: ",ZD0,!99259 "RTN","C0CFM1",75,0)99260 ;B99261 "RTN","C0CFM1",76,0)99262 S ZCNT=099263 "RTN","C0CFM1",77,0)99264 S ZC0CI="" ;99265 "RTN","C0CFM1",78,0)99266 F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ;99267 "RTN","C0CFM1",79,0)99268 . I ZC0CI'="M" D ; NOT A SUBVARIABLE99269 "RTN","C0CFM1",80,0)99270 . . S ZCNT=ZCNT+1 ;INCREMENT COUNT99271 "RTN","C0CFM1",81,0)99272 . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT99273 "RTN","C0CFM1",82,0)99274 . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND99275 "RTN","C0CFM1",83,0)99276 . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN99277 "RTN","C0CFM1",84,0)99278 . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI)99279 "RTN","C0CFM1",85,0)99280 . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN99281 "RTN","C0CFM1",86,0)99282 . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI)99283 "RTN","C0CFM1",87,0)99284 ;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT"99285 "RTN","C0CFM1",88,0)99286 ;S GT1(170,"?+1,",12)="DIR"99287 "RTN","C0CFM1",89,0)99288 ;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT"99289 "RTN","C0CFM1",90,0)99290 ;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"99291 "RTN","C0CFM1",91,0)99292 D CLEAN^DILF99293 "RTN","C0CFM1",92,0)99294 D UPDATE^DIE("","C0CFDA","","ZERR")99295 99333 "RTN","C0CFM1",93,0) 99334 ; 99335 "RTN","C0CFM1",94,0) 99336 VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE 99337 "RTN","C0CFM1",95,0) 99338 ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO 99339 "RTN","C0CFM1",96,0) 99340 ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO 99341 "RTN","C0CFM1",97,0) 99342 ; 99343 "RTN","C0CFM1",98,0) 99344 N ZCCRD,ZVARN,C0CFDA2 99345 "RTN","C0CFM1",99,0) 99346 S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY 99347 "RTN","C0CFM1",100,0) 99348 S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE 99349 "RTN","C0CFM1",101,0) 99350 I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT 99351 "RTN","C0CFM1",102,0) 99352 . I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE 99353 "RTN","C0CFM1",103,0) 99354 . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,! 99355 "RTN","C0CFM1",104,0) 99356 . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE 99357 "RTN","C0CFM1",105,0) 99358 . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE 99359 "RTN","C0CFM1",106,0) 99360 . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN 99361 "RTN","C0CFM1",107,0) 99362 . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY 99363 "RTN","C0CFM1",108,0) 99364 . I $D(ZERR) D ; LAYGO ERROR 99365 "RTN","C0CFM1",109,0) 99366 . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",! 99367 "RTN","C0CFM1",110,0) 99368 . E D ; 99369 "RTN","C0CFM1",111,0) 99370 . . D CLEAN^DILF ; CLEAN UP 99371 "RTN","C0CFM1",112,0) 99372 . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE 99373 "RTN","C0CFM1",113,0) 99374 . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,! 99375 "RTN","C0CFM1",114,0) 99376 Q ZVARN 99377 "RTN","C0CFM1",115,0) 99378 ; 99379 "RTN","C0CFM1",116,0) 99380 BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,) 99381 "RTN","C0CFM1",117,0) 99382 ; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED 99383 "RTN","C0CFM1",118,0) 99384 ; 99385 "RTN","C0CFM1",119,0) 99386 N C0CDIC,C0CNODE ; 99387 "RTN","C0CFM1",120,0) 99388 S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY 99389 "RTN","C0CFM1",121,0) 99390 S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE 99391 "RTN","C0CFM1",122,0) 99296 99392 Q 99297 "RTN","C0CFM1",94,0)99298 ;99299 "RTN","C0CFM1",95,0)99300 VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE99301 "RTN","C0CFM1",96,0)99302 ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO99303 "RTN","C0CFM1",97,0)99304 ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO99305 "RTN","C0CFM1",98,0)99306 ;99307 "RTN","C0CFM1",99,0)99308 N ZCCRD,ZVARN,C0CFDA299309 "RTN","C0CFM1",100,0)99310 S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY99311 "RTN","C0CFM1",101,0)99312 S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE99313 "RTN","C0CFM1",102,0)99314 I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT99315 "RTN","C0CFM1",103,0)99316 . I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE99317 "RTN","C0CFM1",104,0)99318 . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!99319 "RTN","C0CFM1",105,0)99320 . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE99321 "RTN","C0CFM1",106,0)99322 . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE99323 "RTN","C0CFM1",107,0)99324 . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN99325 "RTN","C0CFM1",108,0)99326 . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY99327 "RTN","C0CFM1",109,0)99328 . I $D(ZERR) D ; LAYGO ERROR99329 "RTN","C0CFM1",110,0)99330 . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!99331 "RTN","C0CFM1",111,0)99332 . E D ;99333 "RTN","C0CFM1",112,0)99334 . . D CLEAN^DILF ; CLEAN UP99335 "RTN","C0CFM1",113,0)99336 . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE99337 "RTN","C0CFM1",114,0)99338 . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!99339 "RTN","C0CFM1",115,0)99340 Q ZVARN99341 "RTN","C0CFM1",116,0)99342 ;99343 "RTN","C0CFM1",117,0)99344 BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,)99345 "RTN","C0CFM1",118,0)99346 ; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED99347 "RTN","C0CFM1",119,0)99348 ;99349 "RTN","C0CFM1",120,0)99350 N C0CDIC,C0CNODE ;99351 "RTN","C0CFM1",121,0)99352 S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY99353 "RTN","C0CFM1",122,0)99354 S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE99355 99393 "RTN","C0CFM1",123,0) 99394 ; 99395 "RTN","C0CFM1",124,0) 99396 FIXSEC ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED 99397 "RTN","C0CFM1",125,0) 99398 ; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET 99399 "RTN","C0CFM1",126,0) 99400 ; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS 99401 "RTN","C0CFM1",127,0) 99402 ; CONVERSION 99403 "RTN","C0CFM1",128,0) 99404 ;N C0CC,C0CI,C0CJ,C0CN,C0CZX 99405 "RTN","C0CFM1",129,0) 99406 D FIELDS^C0CRNF("C0CC",170) 99407 "RTN","C0CFM1",130,0) 99408 S C0CI="" 99409 "RTN","C0CFM1",131,0) 99410 F S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI="" D ; EACH SECTION 99411 "RTN","C0CFM1",132,0) 99412 . S C0CZX="" 99413 "RTN","C0CFM1",133,0) 99414 . F S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX="" D ; EACH VARIABLE 99415 "RTN","C0CFM1",134,0) 99416 . . W "SECTION ",C0CI," VAR ",C0CZX 99417 "RTN","C0CFM1",135,0) 99418 . . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,"")) 99419 "RTN","C0CFM1",136,0) 99420 . . W " TYPE: ",C0CV,! 99421 "RTN","C0CFM1",137,0) 99422 . . D SETFDA("SECTION",C0CV) 99423 "RTN","C0CFM1",138,0) 99424 . . ;ZWR C0CFDA 99425 "RTN","C0CFM1",139,0) 99356 99426 Q 99357 "RTN","C0CFM1",124,0)99358 ;99359 "RTN","C0CFM1",125,0)99360 FIXSEC ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED99361 "RTN","C0CFM1",126,0)99362 ; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET99363 "RTN","C0CFM1",127,0)99364 ; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS99365 "RTN","C0CFM1",128,0)99366 ; CONVERSION99367 "RTN","C0CFM1",129,0)99368 ;N C0CC,C0CI,C0CJ,C0CN,C0CZX99369 "RTN","C0CFM1",130,0)99370 D FIELDS^C0CRNF("C0CC",170)99371 "RTN","C0CFM1",131,0)99372 S C0CI=""99373 "RTN","C0CFM1",132,0)99374 F S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI="" D ; EACH SECTION99375 "RTN","C0CFM1",133,0)99376 . S C0CZX=""99377 "RTN","C0CFM1",134,0)99378 . F S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX="" D ; EACH VARIABLE99379 "RTN","C0CFM1",135,0)99380 . . W "SECTION ",C0CI," VAR ",C0CZX99381 "RTN","C0CFM1",136,0)99382 . . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,""))99383 "RTN","C0CFM1",137,0)99384 . . W " TYPE: ",C0CV,!99385 "RTN","C0CFM1",138,0)99386 . . D SETFDA("SECTION",C0CV)99387 "RTN","C0CFM1",139,0)99388 . . ;ZWR C0CFDA99389 99427 "RTN","C0CFM1",140,0) 99428 ; 99429 "RTN","C0CFM1",141,0) 99430 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN 99431 "RTN","C0CFM1",142,0) 99432 ; TO SET TO VALUE C0CSV. 99433 "RTN","C0CFM1",143,0) 99434 ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE 99435 "RTN","C0CFM1",144,0) 99436 ; C0CSN,C0CSV ARE PASSED BY VALUE 99437 "RTN","C0CFM1",145,0) 99438 ; 99439 "RTN","C0CFM1",146,0) 99440 N C0CSI,C0CSJ 99441 "RTN","C0CFM1",147,0) 99442 S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER 99443 "RTN","C0CFM1",148,0) 99444 S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER 99445 "RTN","C0CFM1",149,0) 99446 S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV 99447 "RTN","C0CFM1",150,0) 99390 99448 Q 99391 "RTN","C0CFM1",141,0)99392 ;99393 "RTN","C0CFM1",142,0)99394 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN99395 "RTN","C0CFM1",143,0)99396 ; TO SET TO VALUE C0CSV.99397 "RTN","C0CFM1",144,0)99398 ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE99399 "RTN","C0CFM1",145,0)99400 ; C0CSN,C0CSV ARE PASSED BY VALUE99401 "RTN","C0CFM1",146,0)99402 ;99403 "RTN","C0CFM1",147,0)99404 N C0CSI,C0CSJ99405 "RTN","C0CFM1",148,0)99406 S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER99407 "RTN","C0CFM1",149,0)99408 S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER99409 "RTN","C0CFM1",150,0)99410 S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV99411 99449 "RTN","C0CFM1",151,0) 99412 Q 99450 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 99413 99451 "RTN","C0CFM1",152,0) 99414 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 99452 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN) 99415 99453 "RTN","C0CFM1",153,0) 99416 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)99454 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 99417 99455 "RTN","C0CFM1",154,0) 99456 I '$D(ZTAB) S ZTAB="C0CA" 99457 "RTN","C0CFM1",155,0) 99458 N ZR 99459 "RTN","C0CFM1",156,0) 99460 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1) 99461 "RTN","C0CFM1",157,0) 99462 E S ZR="" 99463 "RTN","C0CFM1",158,0) 99464 Q ZR 99465 "RTN","C0CFM1",159,0) 99466 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED 99467 "RTN","C0CFM1",160,0) 99468 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN) 99469 "RTN","C0CFM1",161,0) 99418 99470 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 99419 "RTN","C0CFM1",1 55,0)99471 "RTN","C0CFM1",162,0) 99420 99472 I '$D(ZTAB) S ZTAB="C0CA" 99421 "RTN","C0CFM1",1 56,0)99473 "RTN","C0CFM1",163,0) 99422 99474 N ZR 99423 "RTN","C0CFM1",1 57,0)99424 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^", 1)99425 "RTN","C0CFM1",1 58,0)99475 "RTN","C0CFM1",164,0) 99476 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2) 99477 "RTN","C0CFM1",165,0) 99426 99478 E S ZR="" 99427 "RTN","C0CFM1",1 59,0)99479 "RTN","C0CFM1",166,0) 99428 99480 Q ZR 99429 "RTN","C0CFM1",160,0) 99430 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED 99431 "RTN","C0CFM1",161,0) 99432 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN) 99433 "RTN","C0CFM1",162,0) 99481 "RTN","C0CFM1",167,0) 99482 ; 99483 "RTN","C0CFM1",168,0) 99484 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED 99485 "RTN","C0CFM1",169,0) 99486 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN) 99487 "RTN","C0CFM1",170,0) 99434 99488 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 99435 "RTN","C0CFM1",1 63,0)99489 "RTN","C0CFM1",171,0) 99436 99490 I '$D(ZTAB) S ZTAB="C0CA" 99437 "RTN","C0CFM1",1 64,0)99491 "RTN","C0CFM1",172,0) 99438 99492 N ZR 99439 "RTN","C0CFM1",1 65,0)99440 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^", 2)99441 "RTN","C0CFM1",1 66,0)99493 "RTN","C0CFM1",173,0) 99494 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3) 99495 "RTN","C0CFM1",174,0) 99442 99496 E S ZR="" 99443 "RTN","C0CFM1",1 67,0)99497 "RTN","C0CFM1",175,0) 99444 99498 Q ZR 99445 "RTN","C0CFM1",168,0)99446 ;99447 "RTN","C0CFM1",169,0)99448 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED99449 "RTN","C0CFM1",170,0)99450 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)99451 "RTN","C0CFM1",171,0)99452 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA99453 "RTN","C0CFM1",172,0)99454 I '$D(ZTAB) S ZTAB="C0CA"99455 "RTN","C0CFM1",173,0)99456 N ZR99457 "RTN","C0CFM1",174,0)99458 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)99459 "RTN","C0CFM1",175,0)99460 E S ZR=""99461 99499 "RTN","C0CFM1",176,0) 99462 Q ZR99463 "RTN","C0CFM1",177,0)99464 99500 ; 99465 99501 "RTN","C0CFM2") 99466 0^31^B 10219597899502 0^31^B99587435 99467 99503 "RTN","C0CFM2",1,0) 99468 99504 C0CFM2 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08 99469 99505 "RTN","C0CFM2",2,0) 99470 ;;1.2;C 0C;;May 11, 2012;Build 5099506 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 99471 99507 "RTN","C0CFM2",3,0) 99472 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU99508 ;Copyright 2009 George Lilly. 99473 99509 "RTN","C0CFM2",4,0) 99474 ; General Public License See attached copy of the License.99510 ; 99475 99511 "RTN","C0CFM2",5,0) 99476 ; 99512 ; This program is free software: you can redistribute it and/or modify 99477 99513 "RTN","C0CFM2",6,0) 99478 ; This program is free software; you can redistribute it and/or modify99514 ; it under the terms of the GNU Affero General Public License as 99479 99515 "RTN","C0CFM2",7,0) 99480 ; it under the terms of the GNU General Public License as published by99516 ; published by the Free Software Foundation, either version 3 of the 99481 99517 "RTN","C0CFM2",8,0) 99482 ; the Free Software Foundation; either version 2 of the License, or99518 ; License, or (at your option) any later version. 99483 99519 "RTN","C0CFM2",9,0) 99484 ; (at your option) any later version.99520 ; 99485 99521 "RTN","C0CFM2",10,0) 99486 ; 99522 ; This program is distributed in the hope that it will be useful, 99487 99523 "RTN","C0CFM2",11,0) 99488 ; This program is distributed in the hope that it will be useful,99524 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 99489 99525 "RTN","C0CFM2",12,0) 99490 ; but WITHOUT ANY WARRANTY; without even the implied warranty of99526 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 99491 99527 "RTN","C0CFM2",13,0) 99492 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the99528 ; GNU Affero General Public License for more details. 99493 99529 "RTN","C0CFM2",14,0) 99494 ; GNU General Public License for more details.99530 ; 99495 99531 "RTN","C0CFM2",15,0) 99496 ; 99532 ; You should have received a copy of the GNU Affero General Public License 99497 99533 "RTN","C0CFM2",16,0) 99498 ; You should have received a copy of the GNU General Public License along99534 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 99499 99535 "RTN","C0CFM2",17,0) 99500 ; with this program; if not, write to the Free Software Foundation, Inc.,99536 ; 99501 99537 "RTN","C0CFM2",18,0) 99502 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.99538 ; 99503 99539 "RTN","C0CFM2",19,0) 99504 ;99540 W "This is the CCR FILEMAN Utility Library ",! 99505 99541 "RTN","C0CFM2",20,0) 99506 W "This is the CCR FILEMAN Utility Library ",!99542 ; THIS SET OF ROUTINES USE CCR E2 (^C0CE(, FILE 171.101) INSTEAD OF 99507 99543 "RTN","C0CFM2",21,0) 99508 ; THIS SET OF ROUTINES USE CCR E2 (^C0CE(, FILE 171.101) INSTEAD OF99544 ; CCR ELEMENTS (^C0C(179.201, 99509 99545 "RTN","C0CFM2",22,0) 99510 ; CCR ELEMENTS (^C0C(179.201,99546 ; E2 IS A SIMPLIFICATION OF CCR ELEMENTS WHERE SUB-ELEMENTS ARE 99511 99547 "RTN","C0CFM2",23,0) 99512 ; E2 IS A SIMPLIFICATION OF CCR ELEMENTS WHERE SUB-ELEMENTS ARE99548 ; AT THE TOP LEVEL. OCCURANCE, THE 4TH PART OF THE KEY IS NOW FREE TEXT 99513 99549 "RTN","C0CFM2",24,0) 99514 ; A T THE TOP LEVEL. OCCURANCE, THE 4TH PART OF THE KEY IS NOW FREE TEXT99550 ; AND HAS THE FORM X;Y FOR SUB-ELEMENTS 99515 99551 "RTN","C0CFM2",25,0) 99516 ; A ND HAS THE FORM X;Y FOR SUB-ELEMENTS99552 ; ALL SUB-VARIABLES HAVE BEEN REMOVED 99517 99553 "RTN","C0CFM2",26,0) 99518 ; ALL SUB-VARIABLES HAVE BEEN REMOVED99554 W ! 99519 99555 "RTN","C0CFM2",27,0) 99520 W !99556 Q 99521 99557 "RTN","C0CFM2",28,0) 99558 ; 99559 "RTN","C0CFM2",29,0) 99560 RIMTBL(ZWHICH) ; PUT ALL PATIENT IN RIMTBL ZWHICH INTO THE CCR ELEMENTS FILE 99561 "RTN","C0CFM2",30,0) 99562 ; 99563 "RTN","C0CFM2",31,0) 99564 I '$D(RIMBASE) D ASETUP^C0CRIMA ; FOR COMMAND LINE CALLS 99565 "RTN","C0CFM2",32,0) 99566 N ZI,ZJ,ZC,ZPATBASE 99567 "RTN","C0CFM2",33,0) 99568 S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",ZWHICH)) 99569 "RTN","C0CFM2",34,0) 99570 S ZI="" 99571 "RTN","C0CFM2",35,0) 99572 F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END 99573 "RTN","C0CFM2",36,0) 99574 . S ZI=$O(@ZPATBASE@(ZI)) 99575 "RTN","C0CFM2",37,0) 99576 . D PUTRIM(ZI) ; EXPORT THE PATIENT TO A FILE 99577 "RTN","C0CFM2",38,0) 99522 99578 Q 99523 "RTN","C0CFM2",29,0)99524 ;99525 "RTN","C0CFM2",30,0)99526 RIMTBL(ZWHICH) ; PUT ALL PATIENT IN RIMTBL ZWHICH INTO THE CCR ELEMENTS FILE99527 "RTN","C0CFM2",31,0)99528 ;99529 "RTN","C0CFM2",32,0)99530 I '$D(RIMBASE) D ASETUP^C0CRIMA ; FOR COMMAND LINE CALLS99531 "RTN","C0CFM2",33,0)99532 N ZI,ZJ,ZC,ZPATBASE99533 "RTN","C0CFM2",34,0)99534 S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",ZWHICH))99535 "RTN","C0CFM2",35,0)99536 S ZI=""99537 "RTN","C0CFM2",36,0)99538 F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END99539 "RTN","C0CFM2",37,0)99540 . S ZI=$O(@ZPATBASE@(ZI))99541 "RTN","C0CFM2",38,0)99542 . D PUTRIM(ZI) ; EXPORT THE PATIENT TO A FILE99543 99579 "RTN","C0CFM2",39,0) 99580 ; 99581 "RTN","C0CFM2",40,0) 99582 PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE 99583 "RTN","C0CFM2",41,0) 99584 ; 99585 "RTN","C0CFM2",42,0) 99586 S C0CGLB=$NA(^TMP("C0CRIM","VARS",DFN)) 99587 "RTN","C0CFM2",43,0) 99588 I '$D(ZWHICH) S ZWHICH="ALL" 99589 "RTN","C0CFM2",44,0) 99590 I ZWHICH'="ALL" D ; SINGLE SECTION REQUESTED 99591 "RTN","C0CFM2",45,0) 99592 . S C0CVARS=$NA(@C0CGLB@(ZWHICH)) 99593 "RTN","C0CFM2",46,0) 99594 . D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION 99595 "RTN","C0CFM2",47,0) 99596 E D ; MULTIPLE SECTIONS 99597 "RTN","C0CFM2",48,0) 99598 . S C0CVARS=$NA(@C0CGLB) 99599 "RTN","C0CFM2",49,0) 99600 . S C0CI="" 99601 "RTN","C0CFM2",50,0) 99602 . F S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI="" D ;FOR EACH SECTION 99603 "RTN","C0CFM2",51,0) 99604 . . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION 99605 "RTN","C0CFM2",52,0) 99606 . . D PUTRIM1(DFN,C0CI,C0CVARSN) 99607 "RTN","C0CFM2",53,0) 99544 99608 Q 99545 "RTN","C0CFM2",40,0)99546 ;99547 "RTN","C0CFM2",41,0)99548 PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE99549 "RTN","C0CFM2",42,0)99550 ;99551 "RTN","C0CFM2",43,0)99552 S C0CGLB=$NA(^TMP("C0CRIM","VARS",DFN))99553 "RTN","C0CFM2",44,0)99554 I '$D(ZWHICH) S ZWHICH="ALL"99555 "RTN","C0CFM2",45,0)99556 I ZWHICH'="ALL" D ; SINGLE SECTION REQUESTED99557 "RTN","C0CFM2",46,0)99558 . S C0CVARS=$NA(@C0CGLB@(ZWHICH))99559 "RTN","C0CFM2",47,0)99560 . D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION99561 "RTN","C0CFM2",48,0)99562 E D ; MULTIPLE SECTIONS99563 "RTN","C0CFM2",49,0)99564 . S C0CVARS=$NA(@C0CGLB)99565 "RTN","C0CFM2",50,0)99566 . S C0CI=""99567 "RTN","C0CFM2",51,0)99568 . F S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI="" D ;FOR EACH SECTION99569 "RTN","C0CFM2",52,0)99570 . . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION99571 "RTN","C0CFM2",53,0)99572 . . D PUTRIM1(DFN,C0CI,C0CVARSN)99573 99609 "RTN","C0CFM2",54,0) 99610 ; 99611 "RTN","C0CFM2",55,0) 99612 PUTRIM1(DFN,ZZTYP,ZVARS) ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS 99613 "RTN","C0CFM2",56,0) 99614 ; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1" 99615 "RTN","C0CFM2",57,0) 99616 S C0CX=0 99617 "RTN","C0CFM2",58,0) 99618 F S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX="" D ; FOR EACH OCCURANCE 99619 "RTN","C0CFM2",59,0) 99620 . W "ZOCC=",C0CX,! 99621 "RTN","C0CFM2",60,0) 99622 . K C0CMDO ; MULTIPLE SUBELEMENTS FOR THIS OCCURANCE PASSED BY NAME 99623 "RTN","C0CFM2",61,0) 99624 . S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE 99625 "RTN","C0CFM2",62,0) 99626 . D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE 99627 "RTN","C0CFM2",63,0) 99628 . I $D(C0CMDO) D ; MULTIPLES TO HANDLE (THIS IS INSTEAD OF RECURSION :() 99629 "RTN","C0CFM2",64,0) 99630 . . N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV 99631 "RTN","C0CFM2",65,0) 99632 . . S ZZCNT=0 99633 "RTN","C0CFM2",66,0) 99634 . . S ZZC0CI=0 99635 "RTN","C0CFM2",67,0) 99636 . . S ZZVALS=$NA(@C0CMDO@("M")) ; LOCATION OF THIS MULTILPE 99637 "RTN","C0CFM2",68,0) 99638 . . S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE 99639 "RTN","C0CFM2",69,0) 99640 . . S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR 99641 "RTN","C0CFM2",70,0) 99642 . . W "MULTIPLE:",ZZVALS,! 99643 "RTN","C0CFM2",71,0) 99644 . . ;B 99645 "RTN","C0CFM2",72,0) 99646 . . F S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI="" D ; EACH MULTIPLE 99647 "RTN","C0CFM2",73,0) 99648 . . . S ZZCNT=ZZCNT+1 ;INCREMENT COUNT 99649 "RTN","C0CFM2",74,0) 99650 . . . W "COUNT:",ZZCNT,! 99651 "RTN","C0CFM2",75,0) 99652 . . . S ZV=$NA(@ZZVALS@(ZZC0CI)) 99653 "RTN","C0CFM2",76,0) 99654 . . . D PUTELS(DFN,ZT,C0CX_";"_ZZCNT,ZV) 99655 "RTN","C0CFM2",77,0) 99574 99656 Q 99575 "RTN","C0CFM2",55,0) 99576 ; 99577 "RTN","C0CFM2",56,0) 99578 PUTRIM1(DFN,ZZTYP,ZVARS) ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS 99579 "RTN","C0CFM2",57,0) 99580 ; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1" 99581 "RTN","C0CFM2",58,0) 99582 S C0CX=0 99583 "RTN","C0CFM2",59,0) 99584 F S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX="" D ; FOR EACH OCCURANCE 99585 "RTN","C0CFM2",60,0) 99586 . W "ZOCC=",C0CX,! 99587 "RTN","C0CFM2",61,0) 99588 . K C0CMDO ; MULTIPLE SUBELEMENTS FOR THIS OCCURANCE PASSED BY NAME 99589 "RTN","C0CFM2",62,0) 99590 . S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE 99591 "RTN","C0CFM2",63,0) 99592 . D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE 99593 "RTN","C0CFM2",64,0) 99594 . I $D(C0CMDO) D ; MULTIPLES TO HANDLE (THIS IS INSTEAD OF RECURSION :() 99595 "RTN","C0CFM2",65,0) 99596 . . N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV 99597 "RTN","C0CFM2",66,0) 99598 . . S ZZCNT=0 99599 "RTN","C0CFM2",67,0) 99600 . . S ZZC0CI=0 99601 "RTN","C0CFM2",68,0) 99602 . . S ZZVALS=$NA(@C0CMDO@("M")) ; LOCATION OF THIS MULTILPE 99603 "RTN","C0CFM2",69,0) 99604 . . S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE 99605 "RTN","C0CFM2",70,0) 99606 . . S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR 99607 "RTN","C0CFM2",71,0) 99608 . . W "MULTIPLE:",ZZVALS,! 99609 "RTN","C0CFM2",72,0) 99657 "RTN","C0CFM2",78,0) 99658 ; 99659 "RTN","C0CFM2",79,0) 99660 PUTELS(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE 99661 "RTN","C0CFM2",80,0) 99662 ; 171.101, ^C0CE DFN IS THE PATIENT IEN PASSED BY VALUE 99663 "RTN","C0CFM2",81,0) 99664 ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE 99665 "RTN","C0CFM2",82,0) 99666 ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC 99667 "RTN","C0CFM2",83,0) 99668 ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM 99669 "RTN","C0CFM2",84,0) 99670 ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT 99671 "RTN","C0CFM2",85,0) 99672 ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES 99673 "RTN","C0CFM2",86,0) 99674 ; 99675 "RTN","C0CFM2",87,0) 99676 N PATN,ZTYPN,XD0,ZTYP 99677 "RTN","C0CFM2",88,0) 99678 I '$D(ZSRC) S ZSRC=1 ; CCR SOURCE IS ASSUMED, 1 IF NOT SET 99679 "RTN","C0CFM2",89,0) 99680 ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE 99681 "RTN","C0CFM2",90,0) 99682 N C0CFPAT S C0CFPAT=171.101 ; FILE AT PATIENT LEVEL 99683 "RTN","C0CFM2",91,0) 99684 N C0CFSRC S C0CFSRC=171.111 ; FILE AT CCR SOURCE LVL 99685 "RTN","C0CFM2",92,0) 99686 N C0CFTYP S C0CFTYP=171.121 ; FILE AT ELEMENT TYPE LVL 99687 "RTN","C0CFM2",93,0) 99688 N C0CFOCC S C0CFOCC=171.131 ; FILE AT OCCURANCE LVL 99689 "RTN","C0CFM2",94,0) 99690 N C0CFVAR S C0CFVAR=171.1311 ; FILE AT VARIABLE LVL 99691 "RTN","C0CFM2",95,0) 99692 ;FILE IS ^C0CE(PAT,1,SCR,1,TYP,1,OCC,1,VAR,1, ... 99693 "RTN","C0CFM2",96,0) 99694 ; AND WE HAVE TO ADD THEM LEVEL AT A TIME I THINK 99695 "RTN","C0CFM2",97,0) 99696 N C0CFDA 99697 "RTN","C0CFM2",98,0) 99698 S C0CFDA(C0CFPAT,"?+1,",.01)=DFN 99699 "RTN","C0CFM2",99,0) 99700 D UPDIE ; ADD THE PATIENT 99701 "RTN","C0CFM2",100,0) 99702 S PATN=$O(^C0CE("B",DFN,"")) ; IEN FOR THE PATIENT 99703 "RTN","C0CFM2",101,0) 99704 S C0CFDA(C0CFSRC,"?+1,"_PATN_",",.01)=ZSRC 99705 "RTN","C0CFM2",102,0) 99706 D UPDIE ; ADD THE CCR SOURCE 99707 "RTN","C0CFM2",103,0) 99708 N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,"")) ; FIND THE ELE TYPE 99709 "RTN","C0CFM2",104,0) 99710 S C0CFDA(C0CFTYP,"?+1,"_ZSRC_","_PATN_",",.01)=ZTYPN 99711 "RTN","C0CFM2",105,0) 99712 D UPDIE ; ADD THE ELEMENT TYPE 99713 "RTN","C0CFM2",106,0) 99714 S ZTYP=$O(^C0CE(PATN,1,ZSRC,1,"B",ZTYPN,"")) ; IEN OF ELEMENT TYPE 99715 "RTN","C0CFM2",107,0) 99716 S C0CFDA(C0CFOCC,"?+1,"_ZTYP_","_ZSRC_","_PATN_",",.01)=ZOCC ; STRING OCC 99717 "RTN","C0CFM2",108,0) 99718 ; OCC IS PRECEDED BY " " TO FORCE STRING STORAGE AND PRESERVE 99719 "RTN","C0CFM2",109,0) 99720 ; STRING COLLATION ON THE INDEX 99721 "RTN","C0CFM2",110,0) 99722 D UPDIE ; ADD THE OCCURANCE 99723 "RTN","C0CFM2",111,0) 99724 S ZD0=$O(^C0CE(PATN,1,ZSRC,1,ZTYP,1,"B",ZOCC,"")) 99725 "RTN","C0CFM2",112,0) 99726 W "RECORD NUMBER: ",ZD0,! 99727 "RTN","C0CFM2",113,0) 99728 ;I ZD0=32 B 99729 "RTN","C0CFM2",114,0) 99730 ;I ZD0=31 B 99731 "RTN","C0CFM2",115,0) 99732 N ZCNT,ZC0CI,ZVARN,C0CZ1 99733 "RTN","C0CFM2",116,0) 99734 S ZCNT=0 99735 "RTN","C0CFM2",117,0) 99736 S ZC0CI="" ; 99737 "RTN","C0CFM2",118,0) 99738 F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ; 99739 "RTN","C0CFM2",119,0) 99740 . I ZC0CI'="M" D ; NOT A SUBVARIABLE 99741 "RTN","C0CFM2",120,0) 99742 . . S ZCNT=ZCNT+1 ;INCREMENT COUNT 99743 "RTN","C0CFM2",121,0) 99744 . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT 99745 "RTN","C0CFM2",122,0) 99746 . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND 99747 "RTN","C0CFM2",123,0) 99748 . . S C0CZ1=ZTYP_","_ZSRC_","_PATN_"," 99749 "RTN","C0CFM2",124,0) 99750 . . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,.01)=ZVARN 99751 "RTN","C0CFM2",125,0) 99752 . . S ZZVAL=$TR(@ZVALS@(ZC0CI),"^","|") 99753 "RTN","C0CFM2",126,0) 99754 . . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,1)=ZZVAL 99755 "RTN","C0CFM2",127,0) 99756 . E D ; THIS IS A SUBELEMENT 99757 "RTN","C0CFM2",128,0) 99758 . . ;PUT THE FOLLOWING BACK TO USE RECURSION 99759 "RTN","C0CFM2",129,0) 99760 . . ;N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV 99761 "RTN","C0CFM2",130,0) 99762 . . ;S ZZCNT=0 99763 "RTN","C0CFM2",131,0) 99764 . . ;S ZZC0CI=0 99765 "RTN","C0CFM2",132,0) 99766 . . ;S ZZVALS=$NA(@ZVALS@("M")) ; LOCATION OF THIS MULTILPE 99767 "RTN","C0CFM2",133,0) 99768 . . ;S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE 99769 "RTN","C0CFM2",134,0) 99770 . . ;S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR 99771 "RTN","C0CFM2",135,0) 99772 . . ;W "MULTIPLE:",ZZVALS,! 99773 "RTN","C0CFM2",136,0) 99610 99774 . . ;B 99611 "RTN","C0CFM2",73,0) 99612 . . F S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI="" D ; EACH MULTIPLE 99613 "RTN","C0CFM2",74,0) 99614 . . . S ZZCNT=ZZCNT+1 ;INCREMENT COUNT 99615 "RTN","C0CFM2",75,0) 99616 . . . W "COUNT:",ZZCNT,! 99617 "RTN","C0CFM2",76,0) 99618 . . . S ZV=$NA(@ZZVALS@(ZZC0CI)) 99619 "RTN","C0CFM2",77,0) 99620 . . . D PUTELS(DFN,ZT,C0CX_";"_ZZCNT,ZV) 99621 "RTN","C0CFM2",78,0) 99775 "RTN","C0CFM2",137,0) 99776 . . ;F S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI="" D ; EACH MULTIPLE 99777 "RTN","C0CFM2",138,0) 99778 . . ;. S ZZCNT=ZZCNT+1 ;INCREMENT COUNT 99779 "RTN","C0CFM2",139,0) 99780 . . ;. W "COUNT:",ZZCNT,! 99781 "RTN","C0CFM2",140,0) 99782 . . ;. S ZV=$NA(@ZZVALS@(ZZC0CI)) 99783 "RTN","C0CFM2",141,0) 99784 . . ;. D PUTELS(DFN,ZT,ZOCC_";"_ZZCNT,ZV) ; PUT THIS BACK TO DEBUG RECURSION 99785 "RTN","C0CFM2",142,0) 99786 . . S C0CMDO=ZVALS ; FLAG TO HANDLE MULTIPLES (INSTEAD OF RECURSION) 99787 "RTN","C0CFM2",143,0) 99788 D UPDIE ; UPDATE 99789 "RTN","C0CFM2",144,0) 99622 99790 Q 99623 "RTN","C0CFM2",79,0) 99624 ; 99625 "RTN","C0CFM2",80,0) 99626 PUTELS(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE 99627 "RTN","C0CFM2",81,0) 99791 "RTN","C0CFM2",145,0) 99792 ; 99793 "RTN","C0CFM2",146,0) 99794 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 99795 "RTN","C0CFM2",147,0) 99796 K ZERR 99797 "RTN","C0CFM2",148,0) 99798 D CLEAN^DILF 99799 "RTN","C0CFM2",149,0) 99800 D UPDATE^DIE("","C0CFDA","","ZERR") 99801 "RTN","C0CFM2",150,0) 99802 I $D(ZERR) S $EC=",U1," 99803 "RTN","C0CFM2",151,0) 99804 K C0CFDA 99805 "RTN","C0CFM2",152,0) 99806 Q 99807 "RTN","C0CFM2",153,0) 99808 ; 99809 "RTN","C0CFM2",154,0) 99810 CHECK ; CHECKSUM EXPERIMENTS 99811 "RTN","C0CFM2",155,0) 99812 ; 99813 "RTN","C0CFM2",156,0) 99814 ;B 99815 "RTN","C0CFM2",157,0) 99816 S ZG=$NA(^C0CE(DA(2),1,DA(1),1,DA)) 99817 "RTN","C0CFM2",158,0) 99818 ;S G2=$NA(^C0CE(8,1,1,1,2,1,6)) 99819 "RTN","C0CFM2",159,0) 99820 S X=$$CHKSUM^XUSESIG1(ZG) 99821 "RTN","C0CFM2",160,0) 99822 W G1,! 99823 "RTN","C0CFM2",161,0) 99824 Q 99825 "RTN","C0CFM2",162,0) 99826 ; 99827 "RTN","C0CFM2",163,0) 99828 CHKELS(DFN) ; CHECKSUM ALL ELEMENTS FOR A PATIENT 99829 "RTN","C0CFM2",164,0) 99830 ; 99831 "RTN","C0CFM2",165,0) 99832 S ZGLB=$NA(^TMP("C0CCHK")) 99833 "RTN","C0CFM2",166,0) 99834 S ZPAT=$O(^C0CE("B",DFN,"")) 99835 "RTN","C0CFM2",167,0) 99836 K @ZGLB@(ZPAT) ; CLEAR PREVIOUS CHECKSUMS 99837 "RTN","C0CFM2",168,0) 99838 S ZSRC="" 99839 "RTN","C0CFM2",169,0) 99840 F S ZSRC=$O(^C0CE(ZPAT,1,"B",ZSRC)) Q:ZSRC="" D ; 99841 "RTN","C0CFM2",170,0) 99842 . W "PAT:",ZPAT," SRC:",ZSRC,! 99843 "RTN","C0CFM2",171,0) 99844 . S ZEL="" 99845 "RTN","C0CFM2",172,0) 99846 . F S ZEL=$O(^C0CE(ZPAT,1,ZSRC,1,"B",ZEL)) Q:ZEL="" D ;ELEMENTS 99847 "RTN","C0CFM2",173,0) 99848 . . W "ELEMENT:",ZEL," " 99849 "RTN","C0CFM2",174,0) 99850 . . S ZELE=$$GET1^DIQ(170.101,ZEL,.01,"E") ;ELEMENT NAME 99851 "RTN","C0CFM2",175,0) 99852 . . W ZELE," " 99853 "RTN","C0CFM2",176,0) 99854 . . S ZELI=$O(^C0CE(ZPAT,1,ZSRC,1,"B",ZEL,"")) 99855 "RTN","C0CFM2",177,0) 99856 . . S ZG=$NA(^C0CE(ZPAT,1,ZSRC,1,ZELI)) 99857 "RTN","C0CFM2",178,0) 99858 . . S ZCHK=$$CHKSUM^XUSESIG1(ZG) ; CHECKSUM FOR THE ELEMENT 99859 "RTN","C0CFM2",179,0) 99860 . . W ZCHK,! 99861 "RTN","C0CFM2",180,0) 99862 . . S @ZGLB@(ZPAT,ZELE,ZSRC)=ZCHK 99863 "RTN","C0CFM2",181,0) 99864 ; ZWR ^TMP("C0CCHK",ZPAT,*) 99865 "RTN","C0CFM2",182,0) 99866 Q 99867 "RTN","C0CFM2",183,0) 99868 ; 99869 "RTN","C0CFM2",184,0) 99870 DOIT(DFN) ; EXPERIMENT FOR TIMING CALLS USING mumps -dir DOIT^C0CFM2(DFN) 99871 "RTN","C0CFM2",185,0) 99872 D SETXUP 99873 "RTN","C0CFM2",186,0) 99874 D CHKELS(DFN) 99875 "RTN","C0CFM2",187,0) 99876 Q 99877 "RTN","C0CFM2",188,0) 99878 ; 99879 "RTN","C0CFM2",189,0) 99880 SETXUP ; SET UP ENVIRONMENT 99881 "RTN","C0CFM2",190,0) 99882 S DISYS=19 99883 "RTN","C0CFM2",191,0) 99884 S DT=3090325 99885 "RTN","C0CFM2",192,0) 99886 S DTIME=300 99887 "RTN","C0CFM2",193,0) 99888 S DUZ=1 99889 "RTN","C0CFM2",194,0) 99890 S DUZ(0)="@" 99891 "RTN","C0CFM2",195,0) 99892 S DUZ(1)="" 99893 "RTN","C0CFM2",196,0) 99894 S DUZ(2)=7247 99895 "RTN","C0CFM2",197,0) 99896 S DUZ("AG")="I" 99897 "RTN","C0CFM2",198,0) 99898 S DUZ("BUF")=1 99899 "RTN","C0CFM2",199,0) 99900 S DUZ("LANG")="" 99901 "RTN","C0CFM2",200,0) 99902 S IO="/dev/pts/20" 99903 "RTN","C0CFM2",201,0) 99904 S IO(0)="/dev/pts/20" 99905 "RTN","C0CFM2",202,0) 99906 S IO(1,"/dev/pts/20")="" 99907 "RTN","C0CFM2",203,0) 99908 S IO("ERROR")="" 99909 "RTN","C0CFM2",204,0) 99910 S IO("HOME")="344^/dev/pts/20" 99911 "RTN","C0CFM2",205,0) 99912 S IO("ZIO")="/dev/pts/20" 99913 "RTN","C0CFM2",206,0) 99914 S IOBS="$C(8)" 99915 "RTN","C0CFM2",207,0) 99916 S IOF="#,$C(27,91,50,74,27,91,72)" 99917 "RTN","C0CFM2",208,0) 99918 S IOM=80 99919 "RTN","C0CFM2",209,0) 99920 S ION="TELNET" 99921 "RTN","C0CFM2",210,0) 99922 S IOS=344 99923 "RTN","C0CFM2",211,0) 99924 S IOSL=24 99925 "RTN","C0CFM2",212,0) 99926 S IOST="C-VT100" 99927 "RTN","C0CFM2",213,0) 99928 S IOST(0)=9 99929 "RTN","C0CFM2",214,0) 99930 S IOT="VTRM" 99931 "RTN","C0CFM2",215,0) 99932 S IOXY="W $C(27,91)_((DY+1))_$C(59)_((DX+1))_$C(72)" 99933 "RTN","C0CFM2",216,0) 99934 S U="^" 99935 "RTN","C0CFM2",217,0) 99936 S X="216;DIC(4.2," 99937 "RTN","C0CFM2",218,0) 99938 S XPARSYS="216;DIC(4.2," 99939 "RTN","C0CFM2",219,0) 99940 S XQXFLG="^^XUP" 99941 "RTN","C0CFM2",220,0) 99942 Q 99943 "RTN","C0CFM2",221,0) 99944 ; 99945 "RTN","C0CFM2",222,0) 99946 PUTELSO(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE 99947 "RTN","C0CFM2",223,0) 99628 99948 ; 171.101, ^C0CE DFN IS THE PATIENT IEN PASSED BY VALUE 99629 "RTN","C0CFM2", 82,0)99949 "RTN","C0CFM2",224,0) 99630 99950 ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE 99631 "RTN","C0CFM2", 83,0)99951 "RTN","C0CFM2",225,0) 99632 99952 ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC 99633 "RTN","C0CFM2", 84,0)99953 "RTN","C0CFM2",226,0) 99634 99954 ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM 99635 "RTN","C0CFM2", 85,0)99955 "RTN","C0CFM2",227,0) 99636 99956 ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT 99637 "RTN","C0CFM2", 86,0)99957 "RTN","C0CFM2",228,0) 99638 99958 ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES 99639 "RTN","C0CFM2",87,0) 99640 ; 99641 "RTN","C0CFM2",88,0) 99642 N PATN,ZTYPN,XD0,ZTYP 99643 "RTN","C0CFM2",89,0) 99644 I '$D(ZSRC) S ZSRC=1 ; CCR SOURCE IS ASSUMED, 1 IF NOT SET 99645 "RTN","C0CFM2",90,0) 99959 "RTN","C0CFM2",229,0) 99960 ; 99961 "RTN","C0CFM2",230,0) 99962 S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1 99963 "RTN","C0CFM2",231,0) 99646 99964 ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE 99647 "RTN","C0CFM2",91,0) 99648 N C0CFPAT S C0CFPAT=171.101 ; FILE AT PATIENT LEVEL 99649 "RTN","C0CFM2",92,0) 99650 N C0CFSRC S C0CFSRC=171.111 ; FILE AT CCR SOURCE LVL 99651 "RTN","C0CFM2",93,0) 99652 N C0CFTYP S C0CFTYP=171.121 ; FILE AT ELEMENT TYPE LVL 99653 "RTN","C0CFM2",94,0) 99654 N C0CFOCC S C0CFOCC=171.131 ; FILE AT OCCURANCE LVL 99655 "RTN","C0CFM2",95,0) 99656 N C0CFVAR S C0CFVAR=171.1311 ; FILE AT VARIABLE LVL 99657 "RTN","C0CFM2",96,0) 99658 ;FILE IS ^C0CE(PAT,1,SCR,1,TYP,1,OCC,1,VAR,1, ... 99659 "RTN","C0CFM2",97,0) 99660 ; AND WE HAVE TO ADD THEM LEVEL AT A TIME I THINK 99661 "RTN","C0CFM2",98,0) 99662 N C0CFDA 99663 "RTN","C0CFM2",99,0) 99664 S C0CFDA(C0CFPAT,"?+1,",.01)=DFN 99665 "RTN","C0CFM2",100,0) 99666 D UPDIE ; ADD THE PATIENT 99667 "RTN","C0CFM2",101,0) 99668 S PATN=$O(^C0CE("B",DFN,"")) ; IEN FOR THE PATIENT 99669 "RTN","C0CFM2",102,0) 99670 S C0CFDA(C0CFSRC,"?+1,"_PATN_",",.01)=ZSRC 99671 "RTN","C0CFM2",103,0) 99672 D UPDIE ; ADD THE CCR SOURCE 99673 "RTN","C0CFM2",104,0) 99674 N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,"")) ; FIND THE ELE TYPE 99675 "RTN","C0CFM2",105,0) 99676 S C0CFDA(C0CFTYP,"?+1,"_ZSRC_","_PATN_",",.01)=ZTYPN 99677 "RTN","C0CFM2",106,0) 99678 D UPDIE ; ADD THE ELEMENT TYPE 99679 "RTN","C0CFM2",107,0) 99680 S ZTYP=$O(^C0CE(PATN,1,ZSRC,1,"B",ZTYPN,"")) ; IEN OF ELEMENT TYPE 99681 "RTN","C0CFM2",108,0) 99682 S C0CFDA(C0CFOCC,"?+1,"_ZTYP_","_ZSRC_","_PATN_",",.01)=ZOCC ; STRING OCC 99683 "RTN","C0CFM2",109,0) 99684 ; OCC IS PRECEDED BY " " TO FORCE STRING STORAGE AND PRESERVE 99685 "RTN","C0CFM2",110,0) 99686 ; STRING COLLATION ON THE INDEX 99687 "RTN","C0CFM2",111,0) 99688 D UPDIE ; ADD THE OCCURANCE 99689 "RTN","C0CFM2",112,0) 99690 S ZD0=$O(^C0CE(PATN,1,ZSRC,1,ZTYP,1,"B",ZOCC,"")) 99691 "RTN","C0CFM2",113,0) 99965 "RTN","C0CFM2",232,0) 99966 N ZF,ZFV S ZF=171.101 S ZFV=171.1011 99967 "RTN","C0CFM2",233,0) 99968 ;S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS 99969 "RTN","C0CFM2",234,0) 99970 ;N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER 99971 "RTN","C0CFM2",235,0) 99972 N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,"")) 99973 "RTN","C0CFM2",236,0) 99974 W "ZTYPE: ",ZTYPE," ",ZTYPN,! 99975 "RTN","C0CFM2",237,0) 99976 N ZVARN ; IEN OF VARIABLE BEING PROCESSED 99977 "RTN","C0CFM2",238,0) 99978 ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE 99979 "RTN","C0CFM2",239,0) 99980 K C0CFDA 99981 "RTN","C0CFM2",240,0) 99982 S C0CFDA(ZF,"?+1,",.01)=DFN 99983 "RTN","C0CFM2",241,0) 99984 S C0CFDA(ZF,"?+1,",.02)=ZSRC 99985 "RTN","C0CFM2",242,0) 99986 S C0CFDA(ZF,"?+1,",.03)=ZTYPN 99987 "RTN","C0CFM2",243,0) 99988 S C0CFDA(ZF,"?+1,",.04)=" "_ZOCC ;CREATE OCCURANCE 99989 "RTN","C0CFM2",244,0) 99990 K ZERR 99991 "RTN","C0CFM2",245,0) 99992 ;B 99993 "RTN","C0CFM2",246,0) 99994 D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER 99995 "RTN","C0CFM2",247,0) 99996 I $D(ZERR) S $EC=",U1," 99997 "RTN","C0CFM2",248,0) 99998 K C0CFDA 99999 "RTN","C0CFM2",249,0) 100000 S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,"")) 100001 "RTN","C0CFM2",250,0) 99692 100002 W "RECORD NUMBER: ",ZD0,! 99693 "RTN","C0CFM2",114,0) 99694 ;I ZD0=32 B 99695 "RTN","C0CFM2",115,0) 99696 ;I ZD0=31 B 99697 "RTN","C0CFM2",116,0) 99698 N ZCNT,ZC0CI,ZVARN,C0CZ1 99699 "RTN","C0CFM2",117,0) 100003 "RTN","C0CFM2",251,0) 99700 100004 S ZCNT=0 99701 "RTN","C0CFM2", 118,0)100005 "RTN","C0CFM2",252,0) 99702 100006 S ZC0CI="" ; 99703 "RTN","C0CFM2", 119,0)100007 "RTN","C0CFM2",253,0) 99704 100008 F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ; 99705 "RTN","C0CFM2", 120,0)100009 "RTN","C0CFM2",254,0) 99706 100010 . I ZC0CI'="M" D ; NOT A SUBVARIABLE 99707 "RTN","C0CFM2", 121,0)100011 "RTN","C0CFM2",255,0) 99708 100012 . . S ZCNT=ZCNT+1 ;INCREMENT COUNT 99709 "RTN","C0CFM2", 122,0)100013 "RTN","C0CFM2",256,0) 99710 100014 . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT 99711 "RTN","C0CFM2", 123,0)100015 "RTN","C0CFM2",257,0) 99712 100016 . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND 99713 "RTN","C0CFM2",124,0) 99714 . . S C0CZ1=ZTYP_","_ZSRC_","_PATN_"," 99715 "RTN","C0CFM2",125,0) 99716 . . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,.01)=ZVARN 99717 "RTN","C0CFM2",126,0) 99718 . . S ZZVAL=$TR(@ZVALS@(ZC0CI),"^","|") 99719 "RTN","C0CFM2",127,0) 99720 . . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,1)=ZZVAL 99721 "RTN","C0CFM2",128,0) 99722 . E D ; THIS IS A SUBELEMENT 99723 "RTN","C0CFM2",129,0) 99724 . . ;PUT THE FOLLOWING BACK TO USE RECURSION 99725 "RTN","C0CFM2",130,0) 99726 . . ;N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV 99727 "RTN","C0CFM2",131,0) 99728 . . ;S ZZCNT=0 99729 "RTN","C0CFM2",132,0) 99730 . . ;S ZZC0CI=0 99731 "RTN","C0CFM2",133,0) 99732 . . ;S ZZVALS=$NA(@ZVALS@("M")) ; LOCATION OF THIS MULTILPE 99733 "RTN","C0CFM2",134,0) 99734 . . ;S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE 99735 "RTN","C0CFM2",135,0) 99736 . . ;S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR 99737 "RTN","C0CFM2",136,0) 99738 . . ;W "MULTIPLE:",ZZVALS,! 99739 "RTN","C0CFM2",137,0) 99740 . . ;B 99741 "RTN","C0CFM2",138,0) 99742 . . ;F S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI="" D ; EACH MULTIPLE 99743 "RTN","C0CFM2",139,0) 99744 . . ;. S ZZCNT=ZZCNT+1 ;INCREMENT COUNT 99745 "RTN","C0CFM2",140,0) 99746 . . ;. W "COUNT:",ZZCNT,! 99747 "RTN","C0CFM2",141,0) 99748 . . ;. S ZV=$NA(@ZZVALS@(ZZC0CI)) 99749 "RTN","C0CFM2",142,0) 99750 . . ;. D PUTELS(DFN,ZT,ZOCC_";"_ZZCNT,ZV) ; PUT THIS BACK TO DEBUG RECURSION 99751 "RTN","C0CFM2",143,0) 99752 . . S C0CMDO=ZVALS ; FLAG TO HANDLE MULTIPLES (INSTEAD OF RECURSION) 99753 "RTN","C0CFM2",144,0) 99754 D UPDIE ; UPDATE 99755 "RTN","C0CFM2",145,0) 100017 "RTN","C0CFM2",258,0) 100018 . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN 100019 "RTN","C0CFM2",259,0) 100020 . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI) 100021 "RTN","C0CFM2",260,0) 100022 . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN 100023 "RTN","C0CFM2",261,0) 100024 . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI) 100025 "RTN","C0CFM2",262,0) 100026 ;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT" 100027 "RTN","C0CFM2",263,0) 100028 ;S GT1(170,"?+1,",12)="DIR" 100029 "RTN","C0CFM2",264,0) 100030 ;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT" 100031 "RTN","C0CFM2",265,0) 100032 ;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT" 100033 "RTN","C0CFM2",266,0) 100034 D CLEAN^DILF 100035 "RTN","C0CFM2",267,0) 100036 D UPDATE^DIE("","C0CFDA","","ZERR") 100037 "RTN","C0CFM2",268,0) 100038 I $D(ZERR) S $EC=",U1," 100039 "RTN","C0CFM2",269,0) 100040 K C0CFDA 100041 "RTN","C0CFM2",270,0) 99756 100042 Q 99757 "RTN","C0CFM2",146,0) 99758 ; 99759 "RTN","C0CFM2",147,0) 99760 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 99761 "RTN","C0CFM2",148,0) 99762 K ZERR 99763 "RTN","C0CFM2",149,0) 99764 D CLEAN^DILF 99765 "RTN","C0CFM2",150,0) 99766 D UPDATE^DIE("","C0CFDA","","ZERR") 99767 "RTN","C0CFM2",151,0) 99768 I $D(ZERR) D ; 99769 "RTN","C0CFM2",152,0) 99770 . W "ERROR",! 99771 "RTN","C0CFM2",153,0) 99772 . ZWR ZERR 99773 "RTN","C0CFM2",154,0) 99774 . B 99775 "RTN","C0CFM2",155,0) 99776 K C0CFDA 99777 "RTN","C0CFM2",156,0) 100043 "RTN","C0CFM2",271,0) 100044 ; 100045 "RTN","C0CFM2",272,0) 100046 VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE 100047 "RTN","C0CFM2",273,0) 100048 ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO 100049 "RTN","C0CFM2",274,0) 100050 ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO 100051 "RTN","C0CFM2",275,0) 100052 ; 100053 "RTN","C0CFM2",276,0) 100054 N ZCCRD,ZVARN,C0CFDA2 100055 "RTN","C0CFM2",277,0) 100056 S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY 100057 "RTN","C0CFM2",278,0) 100058 S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE 100059 "RTN","C0CFM2",279,0) 100060 I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT 100061 "RTN","C0CFM2",280,0) 100062 . I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE 100063 "RTN","C0CFM2",281,0) 100064 . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,! 100065 "RTN","C0CFM2",282,0) 100066 . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE 100067 "RTN","C0CFM2",283,0) 100068 . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE 100069 "RTN","C0CFM2",284,0) 100070 . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN 100071 "RTN","C0CFM2",285,0) 100072 . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY 100073 "RTN","C0CFM2",286,0) 100074 . I $D(ZERR) D ; LAYGO ERROR 100075 "RTN","C0CFM2",287,0) 100076 . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",! 100077 "RTN","C0CFM2",288,0) 100078 . E D ; 100079 "RTN","C0CFM2",289,0) 100080 . . D CLEAN^DILF ; CLEAN UP 100081 "RTN","C0CFM2",290,0) 100082 . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE 100083 "RTN","C0CFM2",291,0) 100084 . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,! 100085 "RTN","C0CFM2",292,0) 100086 Q ZVARN 100087 "RTN","C0CFM2",293,0) 100088 ; 100089 "RTN","C0CFM2",294,0) 100090 BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,) 100091 "RTN","C0CFM2",295,0) 100092 ; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED 100093 "RTN","C0CFM2",296,0) 100094 ; 100095 "RTN","C0CFM2",297,0) 100096 N C0CDIC,C0CNODE ; 100097 "RTN","C0CFM2",298,0) 100098 S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY 100099 "RTN","C0CFM2",299,0) 100100 S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE 100101 "RTN","C0CFM2",300,0) 99778 100102 Q 99779 "RTN","C0CFM2",157,0) 99780 ; 99781 "RTN","C0CFM2",158,0) 99782 CHECK ; CHECKSUM EXPERIMENTS 99783 "RTN","C0CFM2",159,0) 99784 ; 99785 "RTN","C0CFM2",160,0) 99786 ;B 99787 "RTN","C0CFM2",161,0) 99788 S ZG=$NA(^C0CE(DA(2),1,DA(1),1,DA)) 99789 "RTN","C0CFM2",162,0) 99790 ;S G2=$NA(^C0CE(8,1,1,1,2,1,6)) 99791 "RTN","C0CFM2",163,0) 99792 S X=$$CHKSUM^XUSESIG1(ZG) 99793 "RTN","C0CFM2",164,0) 99794 W G1,! 99795 "RTN","C0CFM2",165,0) 100103 "RTN","C0CFM2",301,0) 100104 ; 100105 "RTN","C0CFM2",302,0) 100106 FIXSEC ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED 100107 "RTN","C0CFM2",303,0) 100108 ; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET 100109 "RTN","C0CFM2",304,0) 100110 ; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS 100111 "RTN","C0CFM2",305,0) 100112 ; CONVERSION 100113 "RTN","C0CFM2",306,0) 100114 ;N C0CC,C0CI,C0CJ,C0CN,C0CZX 100115 "RTN","C0CFM2",307,0) 100116 D FIELDS^C0CRNF("C0CC",170) 100117 "RTN","C0CFM2",308,0) 100118 S C0CI="" 100119 "RTN","C0CFM2",309,0) 100120 F S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI="" D ; EACH SECTION 100121 "RTN","C0CFM2",310,0) 100122 . S C0CZX="" 100123 "RTN","C0CFM2",311,0) 100124 . F S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX="" D ; EACH VARIABLE 100125 "RTN","C0CFM2",312,0) 100126 . . W "SECTION ",C0CI," VAR ",C0CZX 100127 "RTN","C0CFM2",313,0) 100128 . . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,"")) 100129 "RTN","C0CFM2",314,0) 100130 . . W " TYPE: ",C0CV,! 100131 "RTN","C0CFM2",315,0) 100132 . . D SETFDA("SECTION",C0CV) 100133 "RTN","C0CFM2",316,0) 100134 . . ;ZWR C0CFDA 100135 "RTN","C0CFM2",317,0) 99796 100136 Q 99797 "RTN","C0CFM2",166,0) 99798 ; 99799 "RTN","C0CFM2",167,0) 99800 CHKELS(DFN) ; CHECKSUM ALL ELEMENTS FOR A PATIENT 99801 "RTN","C0CFM2",168,0) 99802 ; 99803 "RTN","C0CFM2",169,0) 99804 S ZGLB=$NA(^TMP("C0CCHK")) 99805 "RTN","C0CFM2",170,0) 99806 S ZPAT=$O(^C0CE("B",DFN,"")) 99807 "RTN","C0CFM2",171,0) 99808 K @ZGLB@(ZPAT) ; CLEAR PREVIOUS CHECKSUMS 99809 "RTN","C0CFM2",172,0) 99810 S ZSRC="" 99811 "RTN","C0CFM2",173,0) 99812 F S ZSRC=$O(^C0CE(ZPAT,1,"B",ZSRC)) Q:ZSRC="" D ; 99813 "RTN","C0CFM2",174,0) 99814 . W "PAT:",ZPAT," SRC:",ZSRC,! 99815 "RTN","C0CFM2",175,0) 99816 . S ZEL="" 99817 "RTN","C0CFM2",176,0) 99818 . F S ZEL=$O(^C0CE(ZPAT,1,ZSRC,1,"B",ZEL)) Q:ZEL="" D ;ELEMENTS 99819 "RTN","C0CFM2",177,0) 99820 . . W "ELEMENT:",ZEL," " 99821 "RTN","C0CFM2",178,0) 99822 . . S ZELE=$$GET1^DIQ(170.101,ZEL,.01,"E") ;ELEMENT NAME 99823 "RTN","C0CFM2",179,0) 99824 . . W ZELE," " 99825 "RTN","C0CFM2",180,0) 99826 . . S ZELI=$O(^C0CE(ZPAT,1,ZSRC,1,"B",ZEL,"")) 99827 "RTN","C0CFM2",181,0) 99828 . . S ZG=$NA(^C0CE(ZPAT,1,ZSRC,1,ZELI)) 99829 "RTN","C0CFM2",182,0) 99830 . . S ZCHK=$$CHKSUM^XUSESIG1(ZG) ; CHECKSUM FOR THE ELEMENT 99831 "RTN","C0CFM2",183,0) 99832 . . W ZCHK,! 99833 "RTN","C0CFM2",184,0) 99834 . . S @ZGLB@(ZPAT,ZELE,ZSRC)=ZCHK 99835 "RTN","C0CFM2",185,0) 99836 ZWR ^TMP("C0CCHK",ZPAT,*) 99837 "RTN","C0CFM2",186,0) 100137 "RTN","C0CFM2",318,0) 100138 ; 100139 "RTN","C0CFM2",319,0) 100140 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN 100141 "RTN","C0CFM2",320,0) 100142 ; TO SET TO VALUE C0CSV. 100143 "RTN","C0CFM2",321,0) 100144 ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE 100145 "RTN","C0CFM2",322,0) 100146 ; C0CSN,C0CSV ARE PASSED BY VALUE 100147 "RTN","C0CFM2",323,0) 100148 ; 100149 "RTN","C0CFM2",324,0) 100150 N C0CSI,C0CSJ 100151 "RTN","C0CFM2",325,0) 100152 S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER 100153 "RTN","C0CFM2",326,0) 100154 S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER 100155 "RTN","C0CFM2",327,0) 100156 S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV 100157 "RTN","C0CFM2",328,0) 99838 100158 Q 99839 "RTN","C0CFM2",187,0)99840 ;99841 "RTN","C0CFM2",188,0)99842 DOIT(DFN) ; EXPERIMENT FOR TIMING CALLS USING mumps -dir DOIT^C0CFM2(DFN)99843 "RTN","C0CFM2",189,0)99844 D SETXUP99845 "RTN","C0CFM2",190,0)99846 D CHKELS(DFN)99847 "RTN","C0CFM2",191,0)99848 Q99849 "RTN","C0CFM2",192,0)99850 ;99851 "RTN","C0CFM2",193,0)99852 SETXUP ; SET UP ENVIRONMENT99853 "RTN","C0CFM2",194,0)99854 S DISYS=1999855 "RTN","C0CFM2",195,0)99856 S DT=309032599857 "RTN","C0CFM2",196,0)99858 S DTIME=30099859 "RTN","C0CFM2",197,0)99860 S DUZ=199861 "RTN","C0CFM2",198,0)99862 S DUZ(0)="@"99863 "RTN","C0CFM2",199,0)99864 S DUZ(1)=""99865 "RTN","C0CFM2",200,0)99866 S DUZ(2)=724799867 "RTN","C0CFM2",201,0)99868 S DUZ("AG")="I"99869 "RTN","C0CFM2",202,0)99870 S DUZ("BUF")=199871 "RTN","C0CFM2",203,0)99872 S DUZ("LANG")=""99873 "RTN","C0CFM2",204,0)99874 S IO="/dev/pts/20"99875 "RTN","C0CFM2",205,0)99876 S IO(0)="/dev/pts/20"99877 "RTN","C0CFM2",206,0)99878 S IO(1,"/dev/pts/20")=""99879 "RTN","C0CFM2",207,0)99880 S IO("ERROR")=""99881 "RTN","C0CFM2",208,0)99882 S IO("HOME")="344^/dev/pts/20"99883 "RTN","C0CFM2",209,0)99884 S IO("ZIO")="/dev/pts/20"99885 "RTN","C0CFM2",210,0)99886 S IOBS="$C(8)"99887 "RTN","C0CFM2",211,0)99888 S IOF="#,$C(27,91,50,74,27,91,72)"99889 "RTN","C0CFM2",212,0)99890 S IOM=8099891 "RTN","C0CFM2",213,0)99892 S ION="TELNET"99893 "RTN","C0CFM2",214,0)99894 S IOS=34499895 "RTN","C0CFM2",215,0)99896 S IOSL=2499897 "RTN","C0CFM2",216,0)99898 S IOST="C-VT100"99899 "RTN","C0CFM2",217,0)99900 S IOST(0)=999901 "RTN","C0CFM2",218,0)99902 S IOT="VTRM"99903 "RTN","C0CFM2",219,0)99904 S IOXY="W $C(27,91)_((DY+1))_$C(59)_((DX+1))_$C(72)"99905 "RTN","C0CFM2",220,0)99906 S U="^"99907 "RTN","C0CFM2",221,0)99908 S X="216;DIC(4.2,"99909 "RTN","C0CFM2",222,0)99910 S XPARSYS="216;DIC(4.2,"99911 "RTN","C0CFM2",223,0)99912 S XQXFLG="^^XUP"99913 "RTN","C0CFM2",224,0)99914 Q99915 "RTN","C0CFM2",225,0)99916 ;99917 "RTN","C0CFM2",226,0)99918 PUTELSOLD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE99919 "RTN","C0CFM2",227,0)99920 ; 171.101, ^C0CE DFN IS THE PATIENT IEN PASSED BY VALUE99921 "RTN","C0CFM2",228,0)99922 ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE99923 "RTN","C0CFM2",229,0)99924 ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC99925 "RTN","C0CFM2",230,0)99926 ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM99927 "RTN","C0CFM2",231,0)99928 ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT99929 "RTN","C0CFM2",232,0)99930 ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES99931 "RTN","C0CFM2",233,0)99932 ;99933 "RTN","C0CFM2",234,0)99934 S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 199935 "RTN","C0CFM2",235,0)99936 ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE99937 "RTN","C0CFM2",236,0)99938 N ZF,ZFV S ZF=171.101 S ZFV=171.101199939 "RTN","C0CFM2",237,0)99940 ;S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS99941 "RTN","C0CFM2",238,0)99942 ;N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER99943 "RTN","C0CFM2",239,0)99944 N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))99945 "RTN","C0CFM2",240,0)99946 W "ZTYPE: ",ZTYPE," ",ZTYPN,!99947 "RTN","C0CFM2",241,0)99948 N ZVARN ; IEN OF VARIABLE BEING PROCESSED99949 "RTN","C0CFM2",242,0)99950 ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE99951 "RTN","C0CFM2",243,0)99952 K C0CFDA99953 "RTN","C0CFM2",244,0)99954 S C0CFDA(ZF,"?+1,",.01)=DFN99955 "RTN","C0CFM2",245,0)99956 S C0CFDA(ZF,"?+1,",.02)=ZSRC99957 "RTN","C0CFM2",246,0)99958 S C0CFDA(ZF,"?+1,",.03)=ZTYPN99959 "RTN","C0CFM2",247,0)99960 S C0CFDA(ZF,"?+1,",.04)=" "_ZOCC ;CREATE OCCURANCE99961 "RTN","C0CFM2",248,0)99962 K ZERR99963 "RTN","C0CFM2",249,0)99964 ;B99965 "RTN","C0CFM2",250,0)99966 D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER99967 "RTN","C0CFM2",251,0)99968 I $D(ZERR) B ;OOPS99969 "RTN","C0CFM2",252,0)99970 K C0CFDA99971 "RTN","C0CFM2",253,0)99972 S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,""))99973 "RTN","C0CFM2",254,0)99974 W "RECORD NUMBER: ",ZD0,!99975 "RTN","C0CFM2",255,0)99976 ;B99977 "RTN","C0CFM2",256,0)99978 S ZCNT=099979 "RTN","C0CFM2",257,0)99980 S ZC0CI="" ;99981 "RTN","C0CFM2",258,0)99982 F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ;99983 "RTN","C0CFM2",259,0)99984 . I ZC0CI'="M" D ; NOT A SUBVARIABLE99985 "RTN","C0CFM2",260,0)99986 . . S ZCNT=ZCNT+1 ;INCREMENT COUNT99987 "RTN","C0CFM2",261,0)99988 . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT99989 "RTN","C0CFM2",262,0)99990 . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND99991 "RTN","C0CFM2",263,0)99992 . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN99993 "RTN","C0CFM2",264,0)99994 . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI)99995 "RTN","C0CFM2",265,0)99996 . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN99997 "RTN","C0CFM2",266,0)99998 . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI)99999 "RTN","C0CFM2",267,0)100000 ;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT"100001 "RTN","C0CFM2",268,0)100002 ;S GT1(170,"?+1,",12)="DIR"100003 "RTN","C0CFM2",269,0)100004 ;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT"100005 "RTN","C0CFM2",270,0)100006 ;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"100007 "RTN","C0CFM2",271,0)100008 D CLEAN^DILF100009 "RTN","C0CFM2",272,0)100010 D UPDATE^DIE("","C0CFDA","","ZERR")100011 "RTN","C0CFM2",273,0)100012 I $D(ZERR) D ;100013 "RTN","C0CFM2",274,0)100014 . W "ERROR",!100015 "RTN","C0CFM2",275,0)100016 . ZWR ZERR100017 "RTN","C0CFM2",276,0)100018 . B100019 "RTN","C0CFM2",277,0)100020 K C0CFDA100021 "RTN","C0CFM2",278,0)100022 Q100023 "RTN","C0CFM2",279,0)100024 ;100025 "RTN","C0CFM2",280,0)100026 VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE100027 "RTN","C0CFM2",281,0)100028 ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO100029 "RTN","C0CFM2",282,0)100030 ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO100031 "RTN","C0CFM2",283,0)100032 ;100033 "RTN","C0CFM2",284,0)100034 N ZCCRD,ZVARN,C0CFDA2100035 "RTN","C0CFM2",285,0)100036 S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY100037 "RTN","C0CFM2",286,0)100038 S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE100039 "RTN","C0CFM2",287,0)100040 I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT100041 "RTN","C0CFM2",288,0)100042 . I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE100043 "RTN","C0CFM2",289,0)100044 . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!100045 "RTN","C0CFM2",290,0)100046 . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE100047 "RTN","C0CFM2",291,0)100048 . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE100049 "RTN","C0CFM2",292,0)100050 . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN100051 "RTN","C0CFM2",293,0)100052 . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY100053 "RTN","C0CFM2",294,0)100054 . I $D(ZERR) D ; LAYGO ERROR100055 "RTN","C0CFM2",295,0)100056 . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!100057 "RTN","C0CFM2",296,0)100058 . E D ;100059 "RTN","C0CFM2",297,0)100060 . . D CLEAN^DILF ; CLEAN UP100061 "RTN","C0CFM2",298,0)100062 . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE100063 "RTN","C0CFM2",299,0)100064 . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!100065 "RTN","C0CFM2",300,0)100066 Q ZVARN100067 "RTN","C0CFM2",301,0)100068 ;100069 "RTN","C0CFM2",302,0)100070 BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,)100071 "RTN","C0CFM2",303,0)100072 ; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED100073 "RTN","C0CFM2",304,0)100074 ;100075 "RTN","C0CFM2",305,0)100076 N C0CDIC,C0CNODE ;100077 "RTN","C0CFM2",306,0)100078 S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY100079 "RTN","C0CFM2",307,0)100080 S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE100081 "RTN","C0CFM2",308,0)100082 Q100083 "RTN","C0CFM2",309,0)100084 ;100085 "RTN","C0CFM2",310,0)100086 FIXSEC ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED100087 "RTN","C0CFM2",311,0)100088 ; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET100089 "RTN","C0CFM2",312,0)100090 ; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS100091 "RTN","C0CFM2",313,0)100092 ; CONVERSION100093 "RTN","C0CFM2",314,0)100094 ;N C0CC,C0CI,C0CJ,C0CN,C0CZX100095 "RTN","C0CFM2",315,0)100096 D FIELDS^C0CRNF("C0CC",170)100097 "RTN","C0CFM2",316,0)100098 S C0CI=""100099 "RTN","C0CFM2",317,0)100100 F S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI="" D ; EACH SECTION100101 "RTN","C0CFM2",318,0)100102 . S C0CZX=""100103 "RTN","C0CFM2",319,0)100104 . F S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX="" D ; EACH VARIABLE100105 "RTN","C0CFM2",320,0)100106 . . W "SECTION ",C0CI," VAR ",C0CZX100107 "RTN","C0CFM2",321,0)100108 . . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,""))100109 "RTN","C0CFM2",322,0)100110 . . W " TYPE: ",C0CV,!100111 "RTN","C0CFM2",323,0)100112 . . D SETFDA("SECTION",C0CV)100113 "RTN","C0CFM2",324,0)100114 . . ;ZWR C0CFDA100115 "RTN","C0CFM2",325,0)100116 Q100117 "RTN","C0CFM2",326,0)100118 ;100119 "RTN","C0CFM2",327,0)100120 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN100121 "RTN","C0CFM2",328,0)100122 ; TO SET TO VALUE C0CSV.100123 100159 "RTN","C0CFM2",329,0) 100124 ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE 100160 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 100125 100161 "RTN","C0CFM2",330,0) 100126 ; C0CSN,C0CSV ARE PASSED BY VALUE100162 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN) 100127 100163 "RTN","C0CFM2",331,0) 100128 ; 100164 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 100129 100165 "RTN","C0CFM2",332,0) 100130 N C0CSI,C0CSJ100166 I '$D(ZTAB) S ZTAB="C0CA" 100131 100167 "RTN","C0CFM2",333,0) 100132 S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER100168 N ZR 100133 100169 "RTN","C0CFM2",334,0) 100134 S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER100170 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1) 100135 100171 "RTN","C0CFM2",335,0) 100136 S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV100172 E S ZR="" 100137 100173 "RTN","C0CFM2",336,0) 100138 Q 100174 Q ZR 100139 100175 "RTN","C0CFM2",337,0) 100140 ZFI LE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILENUMBER FOR FIELD NAME PASSED100176 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED 100141 100177 "RTN","C0CFM2",338,0) 100142 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1OF C0CA(ZFN)100178 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN) 100143 100179 "RTN","C0CFM2",339,0) 100144 100180 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA … … 100148 100184 N ZR 100149 100185 "RTN","C0CFM2",342,0) 100150 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^", 1)100186 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2) 100151 100187 "RTN","C0CFM2",343,0) 100152 100188 E S ZR="" … … 100154 100190 Q ZR 100155 100191 "RTN","C0CFM2",345,0) 100156 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED 100192 ; 100157 100193 "RTN","C0CFM2",346,0) 100158 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN) 100194 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED 100159 100195 "RTN","C0CFM2",347,0) 100196 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN) 100197 "RTN","C0CFM2",348,0) 100160 100198 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 100161 "RTN","C0CFM2",34 8,0)100199 "RTN","C0CFM2",349,0) 100162 100200 I '$D(ZTAB) S ZTAB="C0CA" 100163 "RTN","C0CFM2",3 49,0)100201 "RTN","C0CFM2",350,0) 100164 100202 N ZR 100165 "RTN","C0CFM2",350,0)100166 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)100167 100203 "RTN","C0CFM2",351,0) 100204 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3) 100205 "RTN","C0CFM2",352,0) 100168 100206 E S ZR="" 100169 "RTN","C0CFM2",35 2,0)100207 "RTN","C0CFM2",353,0) 100170 100208 Q ZR 100171 "RTN","C0CFM2",353,0)100172 ;100173 100209 "RTN","C0CFM2",354,0) 100174 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED100175 "RTN","C0CFM2",355,0)100176 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)100177 "RTN","C0CFM2",356,0)100178 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA100179 "RTN","C0CFM2",357,0)100180 I '$D(ZTAB) S ZTAB="C0CA"100181 "RTN","C0CFM2",358,0)100182 N ZR100183 "RTN","C0CFM2",359,0)100184 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)100185 "RTN","C0CFM2",360,0)100186 E S ZR=""100187 "RTN","C0CFM2",361,0)100188 Q ZR100189 "RTN","C0CFM2",362,0)100190 100210 ; 100191 100211 "RTN","C0CFM3") 100192 0^79^B6 8203631100212 0^79^B66472582 100193 100213 "RTN","C0CFM3",1,0) 100194 100214 C0CFM3 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08 100195 100215 "RTN","C0CFM3",2,0) 100196 ;;1.2;C 0C;;May 11, 2012;Build 50100216 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 100197 100217 "RTN","C0CFM3",3,0) 100198 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU100218 ;Copyright 2009 George Lilly. 100199 100219 "RTN","C0CFM3",4,0) 100200 ; General Public License See attached copy of the License.100220 ; 100201 100221 "RTN","C0CFM3",5,0) 100202 ; 100222 ; This program is free software: you can redistribute it and/or modify 100203 100223 "RTN","C0CFM3",6,0) 100204 ; This program is free software; you can redistribute it and/or modify100224 ; it under the terms of the GNU Affero General Public License as 100205 100225 "RTN","C0CFM3",7,0) 100206 ; it under the terms of the GNU General Public License as published by100226 ; published by the Free Software Foundation, either version 3 of the 100207 100227 "RTN","C0CFM3",8,0) 100208 ; the Free Software Foundation; either version 2 of the License, or100228 ; License, or (at your option) any later version. 100209 100229 "RTN","C0CFM3",9,0) 100210 ; (at your option) any later version.100230 ; 100211 100231 "RTN","C0CFM3",10,0) 100212 ; 100232 ; This program is distributed in the hope that it will be useful, 100213 100233 "RTN","C0CFM3",11,0) 100214 ; This program is distributed in the hope that it will be useful,100234 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 100215 100235 "RTN","C0CFM3",12,0) 100216 ; but WITHOUT ANY WARRANTY; without even the implied warranty of100236 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 100217 100237 "RTN","C0CFM3",13,0) 100218 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the100238 ; GNU Affero General Public License for more details. 100219 100239 "RTN","C0CFM3",14,0) 100220 ; GNU General Public License for more details.100240 ; 100221 100241 "RTN","C0CFM3",15,0) 100222 ; 100242 ; You should have received a copy of the GNU Affero General Public License 100223 100243 "RTN","C0CFM3",16,0) 100224 ; You should have received a copy of the GNU General Public License along100244 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 100225 100245 "RTN","C0CFM3",17,0) 100226 ; with this program; if not, write to the Free Software Foundation, Inc.,100246 ; 100227 100247 "RTN","C0CFM3",18,0) 100228 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.100248 ; 100229 100249 "RTN","C0CFM3",19,0) 100230 ;100250 W "This is the CCR FILEMAN Utility Library ",! 100231 100251 "RTN","C0CFM3",20,0) 100232 W "This is the CCR FILEMAN Utility Library ",!100252 ; THIS SET OF ROUTINES USE CCR E2 (^C0CE(, FILE 171.101) INSTEAD OF 100233 100253 "RTN","C0CFM3",21,0) 100234 ; THIS SET OF ROUTINES USE CCR E2 (^C0CE(, FILE 171.101) INSTEAD OF100254 ; CCR ELEMENTS (^C0C(179.201, 100235 100255 "RTN","C0CFM3",22,0) 100236 ; CCR ELEMENTS (^C0C(179.201,100256 ; E2 IS A SIMPLIFICATION OF CCR ELEMENTS WHERE SUB-ELEMENTS ARE 100237 100257 "RTN","C0CFM3",23,0) 100238 ; E2 IS A SIMPLIFICATION OF CCR ELEMENTS WHERE SUB-ELEMENTS ARE100258 ; AT THE TOP LEVEL. OCCURANCE, THE 4TH PART OF THE KEY IS NOW FREE TEXT 100239 100259 "RTN","C0CFM3",24,0) 100240 ; A T THE TOP LEVEL. OCCURANCE, THE 4TH PART OF THE KEY IS NOW FREE TEXT100260 ; AND HAS THE FORM X;Y FOR SUB-ELEMENTS 100241 100261 "RTN","C0CFM3",25,0) 100242 ; A ND HAS THE FORM X;Y FOR SUB-ELEMENTS100262 ; ALL SUB-VARIABLES HAVE BEEN REMOVED 100243 100263 "RTN","C0CFM3",26,0) 100244 ; ALL SUB-VARIABLES HAVE BEEN REMOVED100264 W ! 100245 100265 "RTN","C0CFM3",27,0) 100246 W !100266 Q 100247 100267 "RTN","C0CFM3",28,0) 100268 ; 100269 "RTN","C0CFM3",29,0) 100270 RIMTBL(ZWHICH) ; PUT ALL PATIENT IN RIMTBL ZWHICH INTO THE CCR ELEMENTS FILE 100271 "RTN","C0CFM3",30,0) 100272 ; ' 100273 "RTN","C0CFM3",31,0) 100274 I '$D(RIMBASE) D ASETUP^GPLRIMA ; FOR COMMAND LINE CALLS 100275 "RTN","C0CFM3",32,0) 100276 N ZI,ZJ,ZC,ZPATBASE 100277 "RTN","C0CFM3",33,0) 100278 S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",ZWHICH)) 100279 "RTN","C0CFM3",34,0) 100280 S ZI="" 100281 "RTN","C0CFM3",35,0) 100282 F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END 100283 "RTN","C0CFM3",36,0) 100284 . S ZI=$O(@ZPATBASE@(ZI)) 100285 "RTN","C0CFM3",37,0) 100286 . D PUTRIM(ZI) ; EXPORT THE PATIENT TO A FILE 100287 "RTN","C0CFM3",38,0) 100248 100288 Q 100249 "RTN","C0CFM3",29,0)100250 ;100251 "RTN","C0CFM3",30,0)100252 RIMTBL(ZWHICH) ; PUT ALL PATIENT IN RIMTBL ZWHICH INTO THE CCR ELEMENTS FILE100253 "RTN","C0CFM3",31,0)100254 ; '100255 "RTN","C0CFM3",32,0)100256 I '$D(RIMBASE) D ASETUP^GPLRIMA ; FOR COMMAND LINE CALLS100257 "RTN","C0CFM3",33,0)100258 N ZI,ZJ,ZC,ZPATBASE100259 "RTN","C0CFM3",34,0)100260 S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",ZWHICH))100261 "RTN","C0CFM3",35,0)100262 S ZI=""100263 "RTN","C0CFM3",36,0)100264 F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END100265 "RTN","C0CFM3",37,0)100266 . S ZI=$O(@ZPATBASE@(ZI))100267 "RTN","C0CFM3",38,0)100268 . D PUTRIM(ZI) ; EXPORT THE PATIENT TO A FILE100269 100289 "RTN","C0CFM3",39,0) 100290 ; 100291 "RTN","C0CFM3",40,0) 100292 PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE 100293 "RTN","C0CFM3",41,0) 100294 ; 100295 "RTN","C0CFM3",42,0) 100296 S C0CGLB=$NA(^TMP("C0CRIM","VARS",DFN)) 100297 "RTN","C0CFM3",43,0) 100298 I '$D(ZWHICH) S ZWHICH="ALL" 100299 "RTN","C0CFM3",44,0) 100300 I ZWHICH'="ALL" D ; SINGLE SECTION REQUESTED 100301 "RTN","C0CFM3",45,0) 100302 . S C0CVARS=$NA(@C0CGLB@(ZWHICH)) 100303 "RTN","C0CFM3",46,0) 100304 . D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION 100305 "RTN","C0CFM3",47,0) 100306 E D ; MULTIPLE SECTIONS 100307 "RTN","C0CFM3",48,0) 100308 . S C0CVARS=$NA(@C0CGLB) 100309 "RTN","C0CFM3",49,0) 100310 . S C0CI="" 100311 "RTN","C0CFM3",50,0) 100312 . F S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI="" D ;FOR EACH SECTION 100313 "RTN","C0CFM3",51,0) 100314 . . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION 100315 "RTN","C0CFM3",52,0) 100316 . . D PUTRIM1(DFN,C0CI,C0CVARSN) 100317 "RTN","C0CFM3",53,0) 100270 100318 Q 100271 "RTN","C0CFM3",40,0)100272 ;100273 "RTN","C0CFM3",41,0)100274 PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE100275 "RTN","C0CFM3",42,0)100276 ;100277 "RTN","C0CFM3",43,0)100278 S C0CGLB=$NA(^TMP("C0CRIM","VARS",DFN))100279 "RTN","C0CFM3",44,0)100280 I '$D(ZWHICH) S ZWHICH="ALL"100281 "RTN","C0CFM3",45,0)100282 I ZWHICH'="ALL" D ; SINGLE SECTION REQUESTED100283 "RTN","C0CFM3",46,0)100284 . S C0CVARS=$NA(@C0CGLB@(ZWHICH))100285 "RTN","C0CFM3",47,0)100286 . D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION100287 "RTN","C0CFM3",48,0)100288 E D ; MULTIPLE SECTIONS100289 "RTN","C0CFM3",49,0)100290 . S C0CVARS=$NA(@C0CGLB)100291 "RTN","C0CFM3",50,0)100292 . S C0CI=""100293 "RTN","C0CFM3",51,0)100294 . F S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI="" D ;FOR EACH SECTION100295 "RTN","C0CFM3",52,0)100296 . . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION100297 "RTN","C0CFM3",53,0)100298 . . D PUTRIM1(DFN,C0CI,C0CVARSN)100299 100319 "RTN","C0CFM3",54,0) 100320 ; 100321 "RTN","C0CFM3",55,0) 100322 PUTRIM1(DFN,ZZTYP,ZVARS) ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS 100323 "RTN","C0CFM3",56,0) 100324 ; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1" 100325 "RTN","C0CFM3",57,0) 100326 S C0CX=0 100327 "RTN","C0CFM3",58,0) 100328 F S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX="" D ; FOR EACH OCCURANCE 100329 "RTN","C0CFM3",59,0) 100330 . W "ZOCC=",C0CX,! 100331 "RTN","C0CFM3",60,0) 100332 . K C0CMDO ; MULTIPLE SUBELEMENTS FOR THIS OCCURANCE PASSED BY NAME 100333 "RTN","C0CFM3",61,0) 100334 . S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE 100335 "RTN","C0CFM3",62,0) 100336 . D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE 100337 "RTN","C0CFM3",63,0) 100338 . I $D(C0CMDO) D ; MULTIPLES TO HANDLE (THIS IS INSTEAD OF RECURSION :() 100339 "RTN","C0CFM3",64,0) 100340 . . N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV 100341 "RTN","C0CFM3",65,0) 100342 . . S ZZCNT=0 100343 "RTN","C0CFM3",66,0) 100344 . . S ZZC0CI=0 100345 "RTN","C0CFM3",67,0) 100346 . . S ZZVALS=$NA(@C0CMDO@("M")) ; LOCATION OF THIS MULTILPE 100347 "RTN","C0CFM3",68,0) 100348 . . S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE 100349 "RTN","C0CFM3",69,0) 100350 . . S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR 100351 "RTN","C0CFM3",70,0) 100352 . . W "MULTIPLE:",ZZVALS,! 100353 "RTN","C0CFM3",71,0) 100354 . . ;B 100355 "RTN","C0CFM3",72,0) 100356 . . F S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI="" D ; EACH MULTIPLE 100357 "RTN","C0CFM3",73,0) 100358 . . . S ZZCNT=ZZCNT+1 ;INCREMENT COUNT 100359 "RTN","C0CFM3",74,0) 100360 . . . W "COUNT:",ZZCNT,! 100361 "RTN","C0CFM3",75,0) 100362 . . . S ZV=$NA(@ZZVALS@(ZZC0CI)) 100363 "RTN","C0CFM3",76,0) 100364 . . . D PUTELS(DFN,ZT,C0CX_";"_ZZCNT,ZV) 100365 "RTN","C0CFM3",77,0) 100300 100366 Q 100301 "RTN","C0CFM3",55,0) 100302 ; 100303 "RTN","C0CFM3",56,0) 100304 PUTRIM1(DFN,ZZTYP,ZVARS) ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS 100305 "RTN","C0CFM3",57,0) 100306 ; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1" 100307 "RTN","C0CFM3",58,0) 100308 S C0CX=0 100309 "RTN","C0CFM3",59,0) 100310 F S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX="" D ; FOR EACH OCCURANCE 100311 "RTN","C0CFM3",60,0) 100312 . W "ZOCC=",C0CX,! 100313 "RTN","C0CFM3",61,0) 100314 . K C0CMDO ; MULTIPLE SUBELEMENTS FOR THIS OCCURANCE PASSED BY NAME 100315 "RTN","C0CFM3",62,0) 100316 . S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE 100317 "RTN","C0CFM3",63,0) 100318 . D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE 100319 "RTN","C0CFM3",64,0) 100320 . I $D(C0CMDO) D ; MULTIPLES TO HANDLE (THIS IS INSTEAD OF RECURSION :() 100321 "RTN","C0CFM3",65,0) 100322 . . N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV 100323 "RTN","C0CFM3",66,0) 100324 . . S ZZCNT=0 100325 "RTN","C0CFM3",67,0) 100326 . . S ZZC0CI=0 100327 "RTN","C0CFM3",68,0) 100328 . . S ZZVALS=$NA(@C0CMDO@("M")) ; LOCATION OF THIS MULTILPE 100329 "RTN","C0CFM3",69,0) 100330 . . S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE 100331 "RTN","C0CFM3",70,0) 100332 . . S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR 100333 "RTN","C0CFM3",71,0) 100334 . . W "MULTIPLE:",ZZVALS,! 100335 "RTN","C0CFM3",72,0) 100367 "RTN","C0CFM3",78,0) 100368 ; 100369 "RTN","C0CFM3",79,0) 100370 PUTELS(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE 100371 "RTN","C0CFM3",80,0) 100372 ; 171.601, ^C0CE DFN IS THE PATIENT IEN PASSED BY VALUE 100373 "RTN","C0CFM3",81,0) 100374 ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE 100375 "RTN","C0CFM3",82,0) 100376 ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC 100377 "RTN","C0CFM3",83,0) 100378 ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM 100379 "RTN","C0CFM3",84,0) 100380 ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT 100381 "RTN","C0CFM3",85,0) 100382 ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES 100383 "RTN","C0CFM3",86,0) 100384 ; 100385 "RTN","C0CFM3",87,0) 100386 N ZSRC,PATN,ZTYPN,XD0,ZTYP 100387 "RTN","C0CFM3",88,0) 100388 S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1 100389 "RTN","C0CFM3",89,0) 100390 ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE 100391 "RTN","C0CFM3",90,0) 100392 N C0CF S C0CF=171.601 ; FILE AT ELEMENT LEVEL 100393 "RTN","C0CFM3",91,0) 100394 N C0CFV S C0CFV=171.6011 ; FILE AT VARIABLE LVL 100395 "RTN","C0CFM3",92,0) 100396 N C0CFDA 100397 "RTN","C0CFM3",93,0) 100398 N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,"")) 100399 "RTN","C0CFM3",94,0) 100400 W "ZTYPE: ",ZTYPE," ",ZTYPN,! 100401 "RTN","C0CFM3",95,0) 100402 N ZVARN ; IEN OF VARIABLE BEING PROCESSED 100403 "RTN","C0CFM3",96,0) 100404 ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE 100405 "RTN","C0CFM3",97,0) 100406 S C0CFDA(C0CF,"+1,",.01)=ZTYPN 100407 "RTN","C0CFM3",98,0) 100408 S C0CFDA(C0CF,"+1,",.02)=DFN 100409 "RTN","C0CFM3",99,0) 100410 S C0CFDA(C0CF,"+1,",.03)=ZSRC 100411 "RTN","C0CFM3",100,0) 100412 S C0CFDA(C0CF,"+1,",.04)=" "_ZOCC ;CREATE OCCURANCE with leading space 100413 "RTN","C0CFM3",101,0) 100414 D UPDIE ; CREATE THE RECORD 100415 "RTN","C0CFM3",102,0) 100416 S C0CIEN=$O(^C0CE4("C",DFN,ZSRC,ZTYPN," "_ZOCC,"")) 100417 "RTN","C0CFM3",103,0) 100418 N ZCNT,ZC0CI,ZVARN,C0CZ1 100419 "RTN","C0CFM3",104,0) 100420 S ZCNT=0 100421 "RTN","C0CFM3",105,0) 100422 S ZC0CI="" ; 100423 "RTN","C0CFM3",106,0) 100424 F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ; 100425 "RTN","C0CFM3",107,0) 100426 . I ZC0CI'="M" D ; NOT A SUBVARIABLE 100427 "RTN","C0CFM3",108,0) 100428 . . S ZCNT=ZCNT+1 ;INCREMENT COUNT 100429 "RTN","C0CFM3",109,0) 100430 . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT 100431 "RTN","C0CFM3",110,0) 100432 . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND 100433 "RTN","C0CFM3",111,0) 100434 . . S C0CFDA(C0CFV,"+"_ZCNT_","_C0CIEN_",",.01)=ZVARN 100435 "RTN","C0CFM3",112,0) 100436 . . S C0CFDA(C0CFV,"+"_ZCNT_","_C0CIEN_",",1)=@ZVALS@(ZC0CI) 100437 "RTN","C0CFM3",113,0) 100438 . E D ; THIS IS A SUBELEMENT 100439 "RTN","C0CFM3",114,0) 100440 . . ;PUT THE FOLLOWING BACK TO USE RECURSION 100441 "RTN","C0CFM3",115,0) 100442 . . ;N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV 100443 "RTN","C0CFM3",116,0) 100444 . . ;S ZZCNT=0 100445 "RTN","C0CFM3",117,0) 100446 . . ;S ZZC0CI=0 100447 "RTN","C0CFM3",118,0) 100448 . . ;S ZZVALS=$NA(@ZVALS@("M")) ; LOCATION OF THIS MULTILPE 100449 "RTN","C0CFM3",119,0) 100450 . . ;S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE 100451 "RTN","C0CFM3",120,0) 100452 . . ;S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR 100453 "RTN","C0CFM3",121,0) 100454 . . ;W "MULTIPLE:",ZZVALS,! 100455 "RTN","C0CFM3",122,0) 100336 100456 . . ;B 100337 "RTN","C0CFM3",73,0) 100338 . . F S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI="" D ; EACH MULTIPLE 100339 "RTN","C0CFM3",74,0) 100340 . . . S ZZCNT=ZZCNT+1 ;INCREMENT COUNT 100341 "RTN","C0CFM3",75,0) 100342 . . . W "COUNT:",ZZCNT,! 100343 "RTN","C0CFM3",76,0) 100344 . . . S ZV=$NA(@ZZVALS@(ZZC0CI)) 100345 "RTN","C0CFM3",77,0) 100346 . . . D PUTELS(DFN,ZT,C0CX_";"_ZZCNT,ZV) 100347 "RTN","C0CFM3",78,0) 100457 "RTN","C0CFM3",123,0) 100458 . . ;F S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI="" D ; EACH MULTIPLE 100459 "RTN","C0CFM3",124,0) 100460 . . ;. S ZZCNT=ZZCNT+1 ;INCREMENT COUNT 100461 "RTN","C0CFM3",125,0) 100462 . . ;. W "COUNT:",ZZCNT,! 100463 "RTN","C0CFM3",126,0) 100464 . . ;. S ZV=$NA(@ZZVALS@(ZZC0CI)) 100465 "RTN","C0CFM3",127,0) 100466 . . ;. D PUTELS(DFN,ZT,ZOCC_";"_ZZCNT,ZV) ; PUT THIS BACK TO DEBUG RECURSION 100467 "RTN","C0CFM3",128,0) 100468 . . S C0CMDO=ZVALS ; FLAG TO HANDLE MULTIPLES (INSTEAD OF RECURSION) 100469 "RTN","C0CFM3",129,0) 100470 D UPDIE ; UPDATE 100471 "RTN","C0CFM3",130,0) 100348 100472 Q 100349 "RTN","C0CFM3",79,0) 100350 ; 100351 "RTN","C0CFM3",80,0) 100352 PUTELS(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE 100353 "RTN","C0CFM3",81,0) 100354 ; 171.601, ^C0CE DFN IS THE PATIENT IEN PASSED BY VALUE 100355 "RTN","C0CFM3",82,0) 100473 "RTN","C0CFM3",131,0) 100474 ; 100475 "RTN","C0CFM3",132,0) 100476 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 100477 "RTN","C0CFM3",133,0) 100478 K ZERR 100479 "RTN","C0CFM3",134,0) 100480 D CLEAN^DILF 100481 "RTN","C0CFM3",135,0) 100482 D UPDATE^DIE("","C0CFDA","","ZERR") 100483 "RTN","C0CFM3",136,0) 100484 I $D(ZERR) S $EC=",U1," 100485 "RTN","C0CFM3",137,0) 100486 K C0CFDA 100487 "RTN","C0CFM3",138,0) 100488 Q 100489 "RTN","C0CFM3",139,0) 100490 ; 100491 "RTN","C0CFM3",140,0) 100492 PUTELSO(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE 100493 "RTN","C0CFM3",141,0) 100494 ; 171.101, ^C0CE DFN IS THE PATIENT IEN PASSED BY VALUE 100495 "RTN","C0CFM3",142,0) 100356 100496 ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE 100357 "RTN","C0CFM3", 83,0)100497 "RTN","C0CFM3",143,0) 100358 100498 ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC 100359 "RTN","C0CFM3", 84,0)100499 "RTN","C0CFM3",144,0) 100360 100500 ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM 100361 "RTN","C0CFM3", 85,0)100501 "RTN","C0CFM3",145,0) 100362 100502 ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT 100363 "RTN","C0CFM3", 86,0)100503 "RTN","C0CFM3",146,0) 100364 100504 ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES 100365 "RTN","C0CFM3",87,0) 100366 ; 100367 "RTN","C0CFM3",88,0) 100368 N ZSRC,PATN,ZTYPN,XD0,ZTYP 100369 "RTN","C0CFM3",89,0) 100505 "RTN","C0CFM3",147,0) 100506 ; 100507 "RTN","C0CFM3",148,0) 100370 100508 S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1 100371 "RTN","C0CFM3", 90,0)100509 "RTN","C0CFM3",149,0) 100372 100510 ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE 100373 "RTN","C0CFM3", 91,0)100374 N C0CF S C0CF=171.601 ; FILE AT ELEMENT LEVEL100375 "RTN","C0CFM3", 92,0)100376 N C0CFV S C0CFV=171.6011 ; FILE AT VARIABLE LVL100377 "RTN","C0CFM3", 93,0)100378 N C0CFDA100379 "RTN","C0CFM3", 94,0)100511 "RTN","C0CFM3",150,0) 100512 N ZF,ZFV S ZF=171.101 S ZFV=171.1011 100513 "RTN","C0CFM3",151,0) 100514 ;S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS 100515 "RTN","C0CFM3",152,0) 100516 ;N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER 100517 "RTN","C0CFM3",153,0) 100380 100518 N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,"")) 100381 "RTN","C0CFM3", 95,0)100519 "RTN","C0CFM3",154,0) 100382 100520 W "ZTYPE: ",ZTYPE," ",ZTYPN,! 100383 "RTN","C0CFM3", 96,0)100521 "RTN","C0CFM3",155,0) 100384 100522 N ZVARN ; IEN OF VARIABLE BEING PROCESSED 100385 "RTN","C0CFM3", 97,0)100523 "RTN","C0CFM3",156,0) 100386 100524 ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE 100387 "RTN","C0CFM3",98,0) 100388 S C0CFDA(C0CF,"+1,",.01)=ZTYPN 100389 "RTN","C0CFM3",99,0) 100390 S C0CFDA(C0CF,"+1,",.02)=DFN 100391 "RTN","C0CFM3",100,0) 100392 S C0CFDA(C0CF,"+1,",.03)=ZSRC 100393 "RTN","C0CFM3",101,0) 100394 S C0CFDA(C0CF,"+1,",.04)=" "_ZOCC ;CREATE OCCURANCE with leading space 100395 "RTN","C0CFM3",102,0) 100396 D UPDIE ; CREATE THE RECORD 100397 "RTN","C0CFM3",103,0) 100398 S C0CIEN=$O(^C0CE4("C",DFN,ZSRC,ZTYPN," "_ZOCC,"")) 100399 "RTN","C0CFM3",104,0) 100400 N ZCNT,ZC0CI,ZVARN,C0CZ1 100401 "RTN","C0CFM3",105,0) 100525 "RTN","C0CFM3",157,0) 100526 K C0CFDA 100527 "RTN","C0CFM3",158,0) 100528 S C0CFDA(ZF,"?+1,",.01)=DFN 100529 "RTN","C0CFM3",159,0) 100530 S C0CFDA(ZF,"?+1,",.02)=ZSRC 100531 "RTN","C0CFM3",160,0) 100532 S C0CFDA(ZF,"?+1,",.03)=ZTYPN 100533 "RTN","C0CFM3",161,0) 100534 S C0CFDA(ZF,"?+1,",.04)=" "_ZOCC ;CREATE OCCURANCE 100535 "RTN","C0CFM3",162,0) 100536 K ZERR 100537 "RTN","C0CFM3",163,0) 100538 ;B 100539 "RTN","C0CFM3",164,0) 100540 D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER 100541 "RTN","C0CFM3",165,0) 100542 I $D(ZERR) S $EC=",U1," 100543 "RTN","C0CFM3",166,0) 100544 K C0CFDA 100545 "RTN","C0CFM3",167,0) 100546 S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,"")) 100547 "RTN","C0CFM3",168,0) 100548 W "RECORD NUMBER: ",ZD0,! 100549 "RTN","C0CFM3",169,0) 100550 ;B 100551 "RTN","C0CFM3",170,0) 100402 100552 S ZCNT=0 100403 "RTN","C0CFM3",1 06,0)100553 "RTN","C0CFM3",171,0) 100404 100554 S ZC0CI="" ; 100405 "RTN","C0CFM3",1 07,0)100555 "RTN","C0CFM3",172,0) 100406 100556 F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ; 100407 "RTN","C0CFM3",1 08,0)100557 "RTN","C0CFM3",173,0) 100408 100558 . I ZC0CI'="M" D ; NOT A SUBVARIABLE 100409 "RTN","C0CFM3",1 09,0)100559 "RTN","C0CFM3",174,0) 100410 100560 . . S ZCNT=ZCNT+1 ;INCREMENT COUNT 100411 "RTN","C0CFM3",1 10,0)100561 "RTN","C0CFM3",175,0) 100412 100562 . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT 100413 "RTN","C0CFM3",1 11,0)100563 "RTN","C0CFM3",176,0) 100414 100564 . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND 100415 "RTN","C0CFM3",112,0) 100416 . . S C0CFDA(C0CFV,"+"_ZCNT_","_C0CIEN_",",.01)=ZVARN 100417 "RTN","C0CFM3",113,0) 100418 . . S C0CFDA(C0CFV,"+"_ZCNT_","_C0CIEN_",",1)=@ZVALS@(ZC0CI) 100419 "RTN","C0CFM3",114,0) 100420 . E D ; THIS IS A SUBELEMENT 100421 "RTN","C0CFM3",115,0) 100422 . . ;PUT THE FOLLOWING BACK TO USE RECURSION 100423 "RTN","C0CFM3",116,0) 100424 . . ;N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV 100425 "RTN","C0CFM3",117,0) 100426 . . ;S ZZCNT=0 100427 "RTN","C0CFM3",118,0) 100428 . . ;S ZZC0CI=0 100429 "RTN","C0CFM3",119,0) 100430 . . ;S ZZVALS=$NA(@ZVALS@("M")) ; LOCATION OF THIS MULTILPE 100431 "RTN","C0CFM3",120,0) 100432 . . ;S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE 100433 "RTN","C0CFM3",121,0) 100434 . . ;S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR 100435 "RTN","C0CFM3",122,0) 100436 . . ;W "MULTIPLE:",ZZVALS,! 100437 "RTN","C0CFM3",123,0) 100438 . . ;B 100439 "RTN","C0CFM3",124,0) 100440 . . ;F S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI="" D ; EACH MULTIPLE 100441 "RTN","C0CFM3",125,0) 100442 . . ;. S ZZCNT=ZZCNT+1 ;INCREMENT COUNT 100443 "RTN","C0CFM3",126,0) 100444 . . ;. W "COUNT:",ZZCNT,! 100445 "RTN","C0CFM3",127,0) 100446 . . ;. S ZV=$NA(@ZZVALS@(ZZC0CI)) 100447 "RTN","C0CFM3",128,0) 100448 . . ;. D PUTELS(DFN,ZT,ZOCC_";"_ZZCNT,ZV) ; PUT THIS BACK TO DEBUG RECURSION 100449 "RTN","C0CFM3",129,0) 100450 . . S C0CMDO=ZVALS ; FLAG TO HANDLE MULTIPLES (INSTEAD OF RECURSION) 100451 "RTN","C0CFM3",130,0) 100452 D UPDIE ; UPDATE 100453 "RTN","C0CFM3",131,0) 100565 "RTN","C0CFM3",177,0) 100566 . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN 100567 "RTN","C0CFM3",178,0) 100568 . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI) 100569 "RTN","C0CFM3",179,0) 100570 . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN 100571 "RTN","C0CFM3",180,0) 100572 . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI) 100573 "RTN","C0CFM3",181,0) 100574 ;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT" 100575 "RTN","C0CFM3",182,0) 100576 ;S GT1(170,"?+1,",12)="DIR" 100577 "RTN","C0CFM3",183,0) 100578 ;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT" 100579 "RTN","C0CFM3",184,0) 100580 ;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT" 100581 "RTN","C0CFM3",185,0) 100582 D CLEAN^DILF 100583 "RTN","C0CFM3",186,0) 100584 D UPDATE^DIE("","C0CFDA","","ZERR") 100585 "RTN","C0CFM3",187,0) 100586 I $D(ZERR) S $EC=",U1," 100587 "RTN","C0CFM3",188,0) 100588 K C0CFDA 100589 "RTN","C0CFM3",189,0) 100454 100590 Q 100455 "RTN","C0CFM3",132,0) 100456 ; 100457 "RTN","C0CFM3",133,0) 100458 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 100459 "RTN","C0CFM3",134,0) 100460 K ZERR 100461 "RTN","C0CFM3",135,0) 100462 D CLEAN^DILF 100463 "RTN","C0CFM3",136,0) 100464 D UPDATE^DIE("","C0CFDA","","ZERR") 100465 "RTN","C0CFM3",137,0) 100466 I $D(ZERR) D ; 100467 "RTN","C0CFM3",138,0) 100468 . W "ERROR",! 100469 "RTN","C0CFM3",139,0) 100470 . ZWR ZERR 100471 "RTN","C0CFM3",140,0) 100472 . B 100473 "RTN","C0CFM3",141,0) 100474 K C0CFDA 100475 "RTN","C0CFM3",142,0) 100591 "RTN","C0CFM3",190,0) 100592 ; 100593 "RTN","C0CFM3",191,0) 100594 VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE 100595 "RTN","C0CFM3",192,0) 100596 ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO 100597 "RTN","C0CFM3",193,0) 100598 ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO 100599 "RTN","C0CFM3",194,0) 100600 ; 100601 "RTN","C0CFM3",195,0) 100602 N ZCCRD,ZVARN,C0CFDA2 100603 "RTN","C0CFM3",196,0) 100604 S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY 100605 "RTN","C0CFM3",197,0) 100606 S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE 100607 "RTN","C0CFM3",198,0) 100608 I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT 100609 "RTN","C0CFM3",199,0) 100610 . I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE 100611 "RTN","C0CFM3",200,0) 100612 . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,! 100613 "RTN","C0CFM3",201,0) 100614 . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE 100615 "RTN","C0CFM3",202,0) 100616 . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE 100617 "RTN","C0CFM3",203,0) 100618 . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN 100619 "RTN","C0CFM3",204,0) 100620 . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY 100621 "RTN","C0CFM3",205,0) 100622 . I $D(ZERR) D ; LAYGO ERROR 100623 "RTN","C0CFM3",206,0) 100624 . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",! 100625 "RTN","C0CFM3",207,0) 100626 . E D ; 100627 "RTN","C0CFM3",208,0) 100628 . . D CLEAN^DILF ; CLEAN UP 100629 "RTN","C0CFM3",209,0) 100630 . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE 100631 "RTN","C0CFM3",210,0) 100632 . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,! 100633 "RTN","C0CFM3",211,0) 100634 Q ZVARN 100635 "RTN","C0CFM3",212,0) 100636 ; 100637 "RTN","C0CFM3",213,0) 100638 BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,) 100639 "RTN","C0CFM3",214,0) 100640 ; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED 100641 "RTN","C0CFM3",215,0) 100642 ; 100643 "RTN","C0CFM3",216,0) 100644 N C0CDIC,C0CNODE ; 100645 "RTN","C0CFM3",217,0) 100646 S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY 100647 "RTN","C0CFM3",218,0) 100648 S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE 100649 "RTN","C0CFM3",219,0) 100476 100650 Q 100477 "RTN","C0CFM3",143,0) 100478 ; 100479 "RTN","C0CFM3",144,0) 100480 PUTELSOLD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE 100481 "RTN","C0CFM3",145,0) 100482 ; 171.101, ^C0CE DFN IS THE PATIENT IEN PASSED BY VALUE 100483 "RTN","C0CFM3",146,0) 100484 ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE 100485 "RTN","C0CFM3",147,0) 100486 ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC 100487 "RTN","C0CFM3",148,0) 100488 ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM 100489 "RTN","C0CFM3",149,0) 100490 ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT 100491 "RTN","C0CFM3",150,0) 100492 ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES 100493 "RTN","C0CFM3",151,0) 100494 ; 100495 "RTN","C0CFM3",152,0) 100496 S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1 100497 "RTN","C0CFM3",153,0) 100498 ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE 100499 "RTN","C0CFM3",154,0) 100500 N ZF,ZFV S ZF=171.101 S ZFV=171.1011 100501 "RTN","C0CFM3",155,0) 100502 ;S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS 100503 "RTN","C0CFM3",156,0) 100504 ;N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER 100505 "RTN","C0CFM3",157,0) 100506 N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,"")) 100507 "RTN","C0CFM3",158,0) 100508 W "ZTYPE: ",ZTYPE," ",ZTYPN,! 100509 "RTN","C0CFM3",159,0) 100510 N ZVARN ; IEN OF VARIABLE BEING PROCESSED 100511 "RTN","C0CFM3",160,0) 100512 ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE 100513 "RTN","C0CFM3",161,0) 100514 K C0CFDA 100515 "RTN","C0CFM3",162,0) 100516 S C0CFDA(ZF,"?+1,",.01)=DFN 100517 "RTN","C0CFM3",163,0) 100518 S C0CFDA(ZF,"?+1,",.02)=ZSRC 100519 "RTN","C0CFM3",164,0) 100520 S C0CFDA(ZF,"?+1,",.03)=ZTYPN 100521 "RTN","C0CFM3",165,0) 100522 S C0CFDA(ZF,"?+1,",.04)=" "_ZOCC ;CREATE OCCURANCE 100523 "RTN","C0CFM3",166,0) 100524 K ZERR 100525 "RTN","C0CFM3",167,0) 100526 ;B 100527 "RTN","C0CFM3",168,0) 100528 D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER 100529 "RTN","C0CFM3",169,0) 100530 I $D(ZERR) B ;OOPS 100531 "RTN","C0CFM3",170,0) 100532 K C0CFDA 100533 "RTN","C0CFM3",171,0) 100534 S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,"")) 100535 "RTN","C0CFM3",172,0) 100536 W "RECORD NUMBER: ",ZD0,! 100537 "RTN","C0CFM3",173,0) 100538 ;B 100539 "RTN","C0CFM3",174,0) 100540 S ZCNT=0 100541 "RTN","C0CFM3",175,0) 100542 S ZC0CI="" ; 100543 "RTN","C0CFM3",176,0) 100544 F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ; 100545 "RTN","C0CFM3",177,0) 100546 . I ZC0CI'="M" D ; NOT A SUBVARIABLE 100547 "RTN","C0CFM3",178,0) 100548 . . S ZCNT=ZCNT+1 ;INCREMENT COUNT 100549 "RTN","C0CFM3",179,0) 100550 . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT 100551 "RTN","C0CFM3",180,0) 100552 . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND 100553 "RTN","C0CFM3",181,0) 100554 . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN 100555 "RTN","C0CFM3",182,0) 100556 . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI) 100557 "RTN","C0CFM3",183,0) 100558 . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN 100559 "RTN","C0CFM3",184,0) 100560 . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI) 100561 "RTN","C0CFM3",185,0) 100562 ;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT" 100563 "RTN","C0CFM3",186,0) 100564 ;S GT1(170,"?+1,",12)="DIR" 100565 "RTN","C0CFM3",187,0) 100566 ;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT" 100567 "RTN","C0CFM3",188,0) 100568 ;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT" 100569 "RTN","C0CFM3",189,0) 100570 D CLEAN^DILF 100571 "RTN","C0CFM3",190,0) 100572 D UPDATE^DIE("","C0CFDA","","ZERR") 100573 "RTN","C0CFM3",191,0) 100574 I $D(ZERR) D ; 100575 "RTN","C0CFM3",192,0) 100576 . W "ERROR",! 100577 "RTN","C0CFM3",193,0) 100578 . ZWR ZERR 100579 "RTN","C0CFM3",194,0) 100580 . B 100581 "RTN","C0CFM3",195,0) 100582 K C0CFDA 100583 "RTN","C0CFM3",196,0) 100651 "RTN","C0CFM3",220,0) 100652 ; 100653 "RTN","C0CFM3",221,0) 100654 FIXSEC ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED 100655 "RTN","C0CFM3",222,0) 100656 ; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET 100657 "RTN","C0CFM3",223,0) 100658 ; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS 100659 "RTN","C0CFM3",224,0) 100660 ; CONVERSION 100661 "RTN","C0CFM3",225,0) 100662 ;N C0CC,C0CI,C0CJ,C0CN,C0CZX 100663 "RTN","C0CFM3",226,0) 100664 D FIELDS^C0CRNF("C0CC",170) 100665 "RTN","C0CFM3",227,0) 100666 S C0CI="" 100667 "RTN","C0CFM3",228,0) 100668 F S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI="" D ; EACH SECTION 100669 "RTN","C0CFM3",229,0) 100670 . S C0CZX="" 100671 "RTN","C0CFM3",230,0) 100672 . F S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX="" D ; EACH VARIABLE 100673 "RTN","C0CFM3",231,0) 100674 . . W "SECTION ",C0CI," VAR ",C0CZX 100675 "RTN","C0CFM3",232,0) 100676 . . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,"")) 100677 "RTN","C0CFM3",233,0) 100678 . . W " TYPE: ",C0CV,! 100679 "RTN","C0CFM3",234,0) 100680 . . D SETFDA("SECTION",C0CV) 100681 "RTN","C0CFM3",235,0) 100682 . . ;ZWR C0CFDA 100683 "RTN","C0CFM3",236,0) 100584 100684 Q 100585 "RTN","C0CFM3",197,0) 100586 ; 100587 "RTN","C0CFM3",198,0) 100588 VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE 100589 "RTN","C0CFM3",199,0) 100590 ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO 100591 "RTN","C0CFM3",200,0) 100592 ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO 100593 "RTN","C0CFM3",201,0) 100594 ; 100595 "RTN","C0CFM3",202,0) 100596 N ZCCRD,ZVARN,C0CFDA2 100597 "RTN","C0CFM3",203,0) 100598 S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY 100599 "RTN","C0CFM3",204,0) 100600 S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE 100601 "RTN","C0CFM3",205,0) 100602 I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT 100603 "RTN","C0CFM3",206,0) 100604 . I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE 100605 "RTN","C0CFM3",207,0) 100606 . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,! 100607 "RTN","C0CFM3",208,0) 100608 . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE 100609 "RTN","C0CFM3",209,0) 100610 . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE 100611 "RTN","C0CFM3",210,0) 100612 . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN 100613 "RTN","C0CFM3",211,0) 100614 . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY 100615 "RTN","C0CFM3",212,0) 100616 . I $D(ZERR) D ; LAYGO ERROR 100617 "RTN","C0CFM3",213,0) 100618 . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",! 100619 "RTN","C0CFM3",214,0) 100620 . E D ; 100621 "RTN","C0CFM3",215,0) 100622 . . D CLEAN^DILF ; CLEAN UP 100623 "RTN","C0CFM3",216,0) 100624 . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE 100625 "RTN","C0CFM3",217,0) 100626 . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,! 100627 "RTN","C0CFM3",218,0) 100628 Q ZVARN 100629 "RTN","C0CFM3",219,0) 100630 ; 100631 "RTN","C0CFM3",220,0) 100632 BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,) 100633 "RTN","C0CFM3",221,0) 100634 ; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED 100635 "RTN","C0CFM3",222,0) 100636 ; 100637 "RTN","C0CFM3",223,0) 100638 N C0CDIC,C0CNODE ; 100639 "RTN","C0CFM3",224,0) 100640 S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY 100641 "RTN","C0CFM3",225,0) 100642 S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE 100643 "RTN","C0CFM3",226,0) 100685 "RTN","C0CFM3",237,0) 100686 ; 100687 "RTN","C0CFM3",238,0) 100688 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN 100689 "RTN","C0CFM3",239,0) 100690 ; TO SET TO VALUE C0CSV. 100691 "RTN","C0CFM3",240,0) 100692 ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE 100693 "RTN","C0CFM3",241,0) 100694 ; C0CSN,C0CSV ARE PASSED BY VALUE 100695 "RTN","C0CFM3",242,0) 100696 ; 100697 "RTN","C0CFM3",243,0) 100698 N C0CSI,C0CSJ 100699 "RTN","C0CFM3",244,0) 100700 S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER 100701 "RTN","C0CFM3",245,0) 100702 S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER 100703 "RTN","C0CFM3",246,0) 100704 S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV 100705 "RTN","C0CFM3",247,0) 100644 100706 Q 100645 "RTN","C0CFM3",227,0) 100646 ; 100647 "RTN","C0CFM3",228,0) 100648 FIXSEC ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED 100649 "RTN","C0CFM3",229,0) 100650 ; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET 100651 "RTN","C0CFM3",230,0) 100652 ; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS 100653 "RTN","C0CFM3",231,0) 100654 ; CONVERSION 100655 "RTN","C0CFM3",232,0) 100656 ;N C0CC,C0CI,C0CJ,C0CN,C0CZX 100657 "RTN","C0CFM3",233,0) 100658 D FIELDS^C0CRNF("C0CC",170) 100659 "RTN","C0CFM3",234,0) 100660 S C0CI="" 100661 "RTN","C0CFM3",235,0) 100662 F S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI="" D ; EACH SECTION 100663 "RTN","C0CFM3",236,0) 100664 . S C0CZX="" 100665 "RTN","C0CFM3",237,0) 100666 . F S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX="" D ; EACH VARIABLE 100667 "RTN","C0CFM3",238,0) 100668 . . W "SECTION ",C0CI," VAR ",C0CZX 100669 "RTN","C0CFM3",239,0) 100670 . . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,"")) 100671 "RTN","C0CFM3",240,0) 100672 . . W " TYPE: ",C0CV,! 100673 "RTN","C0CFM3",241,0) 100674 . . D SETFDA("SECTION",C0CV) 100675 "RTN","C0CFM3",242,0) 100676 . . ;ZWR C0CFDA 100677 "RTN","C0CFM3",243,0) 100707 "RTN","C0CFM3",248,0) 100708 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 100709 "RTN","C0CFM3",249,0) 100710 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN) 100711 "RTN","C0CFM3",250,0) 100712 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 100713 "RTN","C0CFM3",251,0) 100714 I '$D(ZTAB) S ZTAB="C0CA" 100715 "RTN","C0CFM3",252,0) 100716 N ZR 100717 "RTN","C0CFM3",253,0) 100718 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1) 100719 "RTN","C0CFM3",254,0) 100720 E S ZR="" 100721 "RTN","C0CFM3",255,0) 100722 Q ZR 100723 "RTN","C0CFM3",256,0) 100724 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED 100725 "RTN","C0CFM3",257,0) 100726 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN) 100727 "RTN","C0CFM3",258,0) 100728 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 100729 "RTN","C0CFM3",259,0) 100730 I '$D(ZTAB) S ZTAB="C0CA" 100731 "RTN","C0CFM3",260,0) 100732 N ZR 100733 "RTN","C0CFM3",261,0) 100734 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2) 100735 "RTN","C0CFM3",262,0) 100736 E S ZR="" 100737 "RTN","C0CFM3",263,0) 100738 Q ZR 100739 "RTN","C0CFM3",264,0) 100740 ; 100741 "RTN","C0CFM3",265,0) 100742 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED 100743 "RTN","C0CFM3",266,0) 100744 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN) 100745 "RTN","C0CFM3",267,0) 100746 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 100747 "RTN","C0CFM3",268,0) 100748 I '$D(ZTAB) S ZTAB="C0CA" 100749 "RTN","C0CFM3",269,0) 100750 N ZR 100751 "RTN","C0CFM3",270,0) 100752 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3) 100753 "RTN","C0CFM3",271,0) 100754 E S ZR="" 100755 "RTN","C0CFM3",272,0) 100756 Q ZR 100757 "RTN","C0CFM3",273,0) 100758 ; 100759 "RTN","C0CFM3",274,0) 100760 SHOWE4(DFN) ; 100761 "RTN","C0CFM3",275,0) 100762 ; 100763 "RTN","C0CFM3",276,0) 100764 N ZG 100765 "RTN","C0CFM3",277,0) 100766 S ZG="" 100767 "RTN","C0CFM3",278,0) 100768 F S ZG=$O(^C0CE4("P",DFN,ZG)) Q:ZG="" D 100769 "RTN","C0CFM3",279,0) 100770 . ; ZWR ^C0CE4(ZG,*) 100771 "RTN","C0CFM3",280,0) 100678 100772 Q 100679 "RTN","C0CFM3",244,0)100680 ;100681 "RTN","C0CFM3",245,0)100682 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN100683 "RTN","C0CFM3",246,0)100684 ; TO SET TO VALUE C0CSV.100685 "RTN","C0CFM3",247,0)100686 ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE100687 "RTN","C0CFM3",248,0)100688 ; C0CSN,C0CSV ARE PASSED BY VALUE100689 "RTN","C0CFM3",249,0)100690 ;100691 "RTN","C0CFM3",250,0)100692 N C0CSI,C0CSJ100693 "RTN","C0CFM3",251,0)100694 S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER100695 "RTN","C0CFM3",252,0)100696 S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER100697 "RTN","C0CFM3",253,0)100698 S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV100699 "RTN","C0CFM3",254,0)100700 Q100701 "RTN","C0CFM3",255,0)100702 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED100703 "RTN","C0CFM3",256,0)100704 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)100705 "RTN","C0CFM3",257,0)100706 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA100707 "RTN","C0CFM3",258,0)100708 I '$D(ZTAB) S ZTAB="C0CA"100709 "RTN","C0CFM3",259,0)100710 N ZR100711 "RTN","C0CFM3",260,0)100712 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)100713 "RTN","C0CFM3",261,0)100714 E S ZR=""100715 "RTN","C0CFM3",262,0)100716 Q ZR100717 "RTN","C0CFM3",263,0)100718 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED100719 "RTN","C0CFM3",264,0)100720 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)100721 "RTN","C0CFM3",265,0)100722 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA100723 "RTN","C0CFM3",266,0)100724 I '$D(ZTAB) S ZTAB="C0CA"100725 "RTN","C0CFM3",267,0)100726 N ZR100727 "RTN","C0CFM3",268,0)100728 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)100729 "RTN","C0CFM3",269,0)100730 E S ZR=""100731 "RTN","C0CFM3",270,0)100732 Q ZR100733 "RTN","C0CFM3",271,0)100734 ;100735 "RTN","C0CFM3",272,0)100736 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED100737 "RTN","C0CFM3",273,0)100738 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)100739 "RTN","C0CFM3",274,0)100740 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA100741 "RTN","C0CFM3",275,0)100742 I '$D(ZTAB) S ZTAB="C0CA"100743 "RTN","C0CFM3",276,0)100744 N ZR100745 "RTN","C0CFM3",277,0)100746 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)100747 "RTN","C0CFM3",278,0)100748 E S ZR=""100749 "RTN","C0CFM3",279,0)100750 Q ZR100751 "RTN","C0CFM3",280,0)100752 ;100753 100773 "RTN","C0CFM3",281,0) 100754 SHOWE4(DFN) ;100755 "RTN","C0CFM3",282,0)100756 ;100757 "RTN","C0CFM3",283,0)100758 N ZG100759 "RTN","C0CFM3",284,0)100760 S ZG=""100761 "RTN","C0CFM3",285,0)100762 F S ZG=$O(^C0CE4("P",DFN,ZG)) Q:ZG="" D ZWR ^C0CE4(ZG,*)100763 "RTN","C0CFM3",286,0)100764 Q100765 "RTN","C0CFM3",287,0)100766 100774 ; 100767 100775 "RTN","C0CIM2") 100768 0^67^B 20157375100776 0^67^B19669149 100769 100777 "RTN","C0CIM2",1,0) 100770 100778 C0CIM2 ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 01/27/10 100771 100779 "RTN","C0CIM2",2,0) 100772 ;;1.2;C 0C;;May 11, 2012;Build 50100780 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 100773 100781 "RTN","C0CIM2",3,0) 100774 100782 ;Copyright 2010 George Lilly, University of Minnesota and others. 100775 100783 "RTN","C0CIM2",4,0) 100776 ; Licensed under the terms of the GNU General Public License.100784 ; 100777 100785 "RTN","C0CIM2",5,0) 100778 ; See attached copy of the License.100786 ; This program is free software: you can redistribute it and/or modify 100779 100787 "RTN","C0CIM2",6,0) 100780 ; 100788 ; it under the terms of the GNU Affero General Public License as 100781 100789 "RTN","C0CIM2",7,0) 100782 ; This program is free software; you can redistribute it and/or modify100790 ; published by the Free Software Foundation, either version 3 of the 100783 100791 "RTN","C0CIM2",8,0) 100784 ; it under the terms of the GNU General Public License as published by100792 ; License, or (at your option) any later version. 100785 100793 "RTN","C0CIM2",9,0) 100786 ; the Free Software Foundation; either version 2 of the License, or100794 ; 100787 100795 "RTN","C0CIM2",10,0) 100788 ; (at your option) any later version.100796 ; This program is distributed in the hope that it will be useful, 100789 100797 "RTN","C0CIM2",11,0) 100790 ; 100798 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 100791 100799 "RTN","C0CIM2",12,0) 100792 ; This program is distributed in the hope that it will be useful,100800 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 100793 100801 "RTN","C0CIM2",13,0) 100794 ; but WITHOUT ANY WARRANTY; without even the implied warranty of100802 ; GNU Affero General Public License for more details. 100795 100803 "RTN","C0CIM2",14,0) 100796 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the100804 ; 100797 100805 "RTN","C0CIM2",15,0) 100798 ; GNU General Public License for more details.100806 ; You should have received a copy of the GNU Affero General Public License 100799 100807 "RTN","C0CIM2",16,0) 100800 ; 100808 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 100801 100809 "RTN","C0CIM2",17,0) 100802 ; You should have received a copy of the GNU General Public License along100810 ; 100803 100811 "RTN","C0CIM2",18,0) 100804 ;with this program; if not, write to the Free Software Foundation, Inc.,100812 W "NO ENTRY FROM TOP",! 100805 100813 "RTN","C0CIM2",19,0) 100806 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.100814 Q 100807 100815 "RTN","C0CIM2",20,0) 100808 100816 ; 100809 100817 "RTN","C0CIM2",21,0) 100810 W "NO ENTRY FROM TOP",! 100818 EXTRACT(IMMXML,DFN,IMMOUT) ; EXTRACT PROCEDURES INTO XML TEMPLATE 100811 100819 "RTN","C0CIM2",22,0) 100820 ; IMMXML AND IMMOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED 100821 "RTN","C0CIM2",23,0) 100822 ; 100823 "RTN","C0CIM2",24,0) 100824 ; USE THE FOLLOWING TEMPLATE FOR THE RNF2 ARRAYS 100825 "RTN","C0CIM2",25,0) 100826 ; THAT GET PASSED TO *GET ROUTINES 100827 "RTN","C0CIM2",26,0) 100828 ;C0C[NAME]=$NA(^TMP("C0CCCR",$J,DFN,"C0C(NAME)) 100829 "RTN","C0CIM2",27,0) 100830 N C0CIMM 100831 "RTN","C0CIM2",28,0) 100832 S C0CIMM=$NA(^TMP("C0CCCR",$J,DFN,"C0CIMM")) 100833 "RTN","C0CIM2",29,0) 100834 ; USE THE FOLLOWING TEMPLATE FOR GETTING/GENERATING THE RNF2 ARRAYS 100835 "RTN","C0CIM2",30,0) 100836 ; THAT GET INSERTED INTO THE XML TEMPLATE 100837 "RTN","C0CIM2",31,0) 100838 ; I '$D(@C0CIMM) D GET[VISTA/RPMS](DFN,C0CIMM) ; GET VARS IF NOT THERE 100839 "RTN","C0CIM2",32,0) 100840 D GETRPMS(DFN,C0CIMM) ; GET VARS IF NOT THERE 100841 "RTN","C0CIM2",33,0) 100842 ; USE THE FOLLOWING TEMPATE FOR MAPPING RNF2 ARRAYS TO XML TEMPLATE 100843 "RTN","C0CIM2",34,0) 100844 ; D MAP([NAME]XML,C0C[NAME],[NAME]OUT) ;MAP RESULTS FOR PROCEDURES 100845 "RTN","C0CIM2",35,0) 100846 D MAP(IMMXML,C0CIMM,IMMOUT) ;MAP RESULTS FOR PROCEDURES 100847 "RTN","C0CIM2",36,0) 100812 100848 Q 100813 "RTN","C0CIM2",23,0)100814 ;100815 "RTN","C0CIM2",24,0)100816 EXTRACT(IMMXML,DFN,IMMOUT) ; EXTRACT PROCEDURES INTO XML TEMPLATE100817 "RTN","C0CIM2",25,0)100818 ; IMMXML AND IMMOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED100819 "RTN","C0CIM2",26,0)100820 ;100821 "RTN","C0CIM2",27,0)100822 ; USE THE FOLLOWING TEMPLATE FOR THE RNF2 ARRAYS100823 "RTN","C0CIM2",28,0)100824 ; THAT GET PASSED TO *GET ROUTINES100825 "RTN","C0CIM2",29,0)100826 ;C0C[NAME]=$NA(^TMP("C0CCCR",$J,DFN,"C0C(NAME))100827 "RTN","C0CIM2",30,0)100828 N C0CIMM100829 "RTN","C0CIM2",31,0)100830 S C0CIMM=$NA(^TMP("C0CCCR",$J,DFN,"C0CIMM"))100831 "RTN","C0CIM2",32,0)100832 ; USE THE FOLLOWING TEMPLATE FOR GETTING/GENERATING THE RNF2 ARRAYS100833 "RTN","C0CIM2",33,0)100834 ; THAT GET INSERTED INTO THE XML TEMPLATE100835 "RTN","C0CIM2",34,0)100836 ; I '$D(@C0CIMM) D GET[VISTA/RPMS](DFN,C0CIMM) ; GET VARS IF NOT THERE100837 "RTN","C0CIM2",35,0)100838 D GETRPMS(DFN,C0CIMM) ; GET VARS IF NOT THERE100839 "RTN","C0CIM2",36,0)100840 ; USE THE FOLLOWING TEMPATE FOR MAPPING RNF2 ARRAYS TO XML TEMPLATE100841 100849 "RTN","C0CIM2",37,0) 100842 ; D MAP([NAME]XML,C0C[NAME],[NAME]OUT) ;MAP RESULTS FOR PROCEDURES100850 ; 100843 100851 "RTN","C0CIM2",38,0) 100844 D MAP(IMMXML,C0CIMM,IMMOUT) ;MAP RESULTS FOR PROCEDURES 100852 GETRPMS(DFN,C0CIMM) ; CALLS GET^BGOVIMM TO GET IMMUNIZATIONS. 100845 100853 "RTN","C0CIM2",39,0) 100854 ; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME 100855 "RTN","C0CIM2",40,0) 100856 ; C0CIMM: IMMUNIZATIONS 100857 "RTN","C0CIM2",41,0) 100858 ; READY TO BE MAPPED TO XML BY MAP^C0CIMM 100859 "RTN","C0CIM2",42,0) 100860 ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY 100861 "RTN","C0CIM2",43,0) 100862 ; EXIST. 100863 "RTN","C0CIM2",44,0) 100864 ; 100865 "RTN","C0CIM2",45,0) 100866 ; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J)) 100867 "RTN","C0CIM2",46,0) 100868 ; 100869 "RTN","C0CIM2",47,0) 100870 ; SETUP RPC/API CALL HERE 100871 "RTN","C0CIM2",48,0) 100872 ; USE START AND END DATES FROM PARAMETERS IF REQUIRED 100873 "RTN","C0CIM2",49,0) 100874 N IMMA 100875 "RTN","C0CIM2",50,0) 100876 D GET^BGOVIMM(.IMMA,DFN) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE 100877 "RTN","C0CIM2",51,0) 100878 ; PREFORM SORT HERE IF NEEDED 100879 "RTN","C0CIM2",52,0) 100880 ; 100881 "RTN","C0CIM2",53,0) 100882 ; NO SORT REQUIRED FOR IMMUNIZATIONS 100883 "RTN","C0CIM2",54,0) 100884 ; 100885 "RTN","C0CIM2",55,0) 100886 ; MAP EACH ROW OF RPC/API TO RNF1 ARRAY 100887 "RTN","C0CIM2",56,0) 100888 ; RNF1 ARRAY FORMAT: 100889 "RTN","C0CIM2",57,0) 100890 ; VAR("NAME_OF_RIM_VARIABLE")=VALUE 100891 "RTN","C0CIM2",58,0) 100892 ; 100893 "RTN","C0CIM2",59,0) 100894 ; IMMUNIZATIONS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF IMMUNIZATION RESULTS 100895 "RTN","C0CIM2",60,0) 100896 ; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD 100897 "RTN","C0CIM2",61,0) 100898 ; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS 100899 "RTN","C0CIM2",62,0) 100900 N C0CIM,C0CC,ZRNF 100901 "RTN","C0CIM2",63,0) 100902 S C0CIM="" ; INITIALIZE FOR $O 100903 "RTN","C0CIM2",64,0) 100904 F C0CC=1:1 S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM="" D ; FOR EACH IMMUNE TYPE IN THE LIST 100905 "RTN","C0CIM2",65,0) 100906 . I DEBUG W @IMMA@(C0CIM),! 100907 "RTN","C0CIM2",66,0) 100908 . ; FIGURE OUT WHICH TYPE OF IMMUNIZATION IT IS (IMMUNIZATION, FORECAST, CONTRAINDICATIONS, REFUSALS) 100909 "RTN","C0CIM2",67,0) 100910 . D:$P(@IMMA@(C0CIM),U,1)="I" IMMUN 100911 "RTN","C0CIM2",68,0) 100912 . D:$P(@IMMA@(C0CIM),U,1)="F" FORECAST 100913 "RTN","C0CIM2",69,0) 100914 . D:$P(@IMMA@(C0CIM),U,1)="C" CONTRA 100915 "RTN","C0CIM2",70,0) 100916 . D:$P(@IMMA@(C0CIM),U,1)="R" REFUSE 100917 "RTN","C0CIM2",71,0) 100918 . D RNF1TO2^C0CRNF(C0CIMM,"ZRNF") ;ADD THIS ROW TO THE ARRAY 100919 "RTN","C0CIM2",72,0) 100920 . K ZRNF 100921 "RTN","C0CIM2",73,0) 100922 ; SAVE RIM VARIABLES SEE C0CRIMA 100923 "RTN","C0CIM2",74,0) 100924 N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE")) 100925 "RTN","C0CIM2",75,0) 100926 M @ZRIM=@C0CIMM@("V") 100927 "RTN","C0CIM2",76,0) 100846 100928 Q 100847 "RTN","C0CIM2",40,0)100848 ;100849 "RTN","C0CIM2",41,0)100850 GETRPMS(DFN,C0CIMM) ; CALLS GET^BGOVIMM TO GET IMMUNIZATIONS.100851 "RTN","C0CIM2",42,0)100852 ; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME100853 "RTN","C0CIM2",43,0)100854 ; C0CIMM: IMMUNIZATIONS100855 "RTN","C0CIM2",44,0)100856 ; READY TO BE MAPPED TO XML BY MAP^C0CIMM100857 "RTN","C0CIM2",45,0)100858 ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY100859 "RTN","C0CIM2",46,0)100860 ; EXIST.100861 "RTN","C0CIM2",47,0)100862 ;100863 "RTN","C0CIM2",48,0)100864 ; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J))100865 "RTN","C0CIM2",49,0)100866 ;100867 "RTN","C0CIM2",50,0)100868 ; SETUP RPC/API CALL HERE100869 "RTN","C0CIM2",51,0)100870 ; USE START AND END DATES FROM PARAMETERS IF REQUIRED100871 "RTN","C0CIM2",52,0)100872 N IMMA100873 "RTN","C0CIM2",53,0)100874 D GET^BGOVIMM(.IMMA,DFN) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE100875 "RTN","C0CIM2",54,0)100876 ; PREFORM SORT HERE IF NEEDED100877 "RTN","C0CIM2",55,0)100878 ;100879 "RTN","C0CIM2",56,0)100880 ; NO SORT REQUIRED FOR IMMUNIZATIONS100881 "RTN","C0CIM2",57,0)100882 ;100883 "RTN","C0CIM2",58,0)100884 ; MAP EACH ROW OF RPC/API TO RNF1 ARRAY100885 "RTN","C0CIM2",59,0)100886 ; RNF1 ARRAY FORMAT:100887 "RTN","C0CIM2",60,0)100888 ; VAR("NAME_OF_RIM_VARIABLE")=VALUE100889 "RTN","C0CIM2",61,0)100890 ;100891 "RTN","C0CIM2",62,0)100892 ; IMMUNIZATIONS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF IMMUNIZATION RESULTS100893 "RTN","C0CIM2",63,0)100894 ; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD100895 "RTN","C0CIM2",64,0)100896 ; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS100897 "RTN","C0CIM2",65,0)100898 N C0CIM,C0CC,ZRNF100899 "RTN","C0CIM2",66,0)100900 S C0CIM="" ; INITIALIZE FOR $O100901 "RTN","C0CIM2",67,0)100902 F C0CC=1:1 S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM="" D ; FOR EACH IMMUNE TYPE IN THE LIST100903 "RTN","C0CIM2",68,0)100904 . I DEBUG W @IMMA@(C0CIM),!100905 "RTN","C0CIM2",69,0)100906 . ; FIGURE OUT WHICH TYPE OF IMMUNIZATION IT IS (IMMUNIZATION, FORECAST, CONTRAINDICATIONS, REFUSALS)100907 "RTN","C0CIM2",70,0)100908 . D:$P(@IMMA@(C0CIM),U,1)="I" IMMUN100909 "RTN","C0CIM2",71,0)100910 . D:$P(@IMMA@(C0CIM),U,1)="F" FORECAST100911 "RTN","C0CIM2",72,0)100912 . D:$P(@IMMA@(C0CIM),U,1)="C" CONTRA100913 "RTN","C0CIM2",73,0)100914 . D:$P(@IMMA@(C0CIM),U,1)="R" REFUSE100915 "RTN","C0CIM2",74,0)100916 . D RNF1TO2^C0CRNF(C0CIMM,"ZRNF") ;ADD THIS ROW TO THE ARRAY100917 "RTN","C0CIM2",75,0)100918 . K ZRNF100919 "RTN","C0CIM2",76,0)100920 ; SAVE RIM VARIABLES SEE C0CRIMA100921 100929 "RTN","C0CIM2",77,0) 100922 N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE"))100930 ; 100923 100931 "RTN","C0CIM2",78,0) 100924 M @ZRIM=@C0CIMM@("V") 100932 IMMUN ; PARSES IMMUNIZATION TYPE ROWS FOR RPMS 100925 100933 "RTN","C0CIM2",79,0) 100934 ; RPC FORMAT 100935 "RTN","C0CIM2",80,0) 100936 ; I ^ Imm Name [2] ^ Visit Date [3] ^ V File IEN [4] ^ Other Location [5] ^ Group [6] ^ Imm IEN [7] ^ Lot [8] ^ 100937 "RTN","C0CIM2",81,0) 100938 ; Reaction [9] ^ VIS Date [10] ^ Age [11] ^ Visit Date [12] ^ Provider IEN~Name [13] ^ Inj Site [14] ^ 100939 "RTN","C0CIM2",82,0) 100940 ; Volume [15] ^ Visit IEN [16] ^ Visit Category [17] ^ Full Name [18] ^ Location IEN~Name [19] ^ Visit Locked [20] 100941 "RTN","C0CIM2",83,0) 100942 ; RETRIEVE IMMUNIZATION RECORD FROM IMMUNIZATION FILE (9999999.14) FOR THIS IMMUNIZATION 100943 "RTN","C0CIM2",84,0) 100944 D GETN^C0CRNF("C0CZIM",9999999.14,$P(@IMMA@(C0CIM),U,7)) ; GET IMMUNIZATION RECORD 100945 "RTN","C0CIM2",85,0) 100946 ; RETIREVE IMMUNIZATION RECORD FROM V IMMUNIZATION FILE (9000010.11) FOR THIS IMMUNIZATION 100947 "RTN","C0CIM2",86,0) 100948 D GETN^C0CRNF("C0CZVI",9000010.11,$P(@IMMA@(C0CIM),U,4)) ; GET V IMMUNIZATION RECORD 100949 "RTN","C0CIM2",87,0) 100950 S ZRNF("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID 100951 "RTN","C0CIM2",88,0) 100952 S ZRNF("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME 100953 "RTN","C0CIM2",89,0) 100954 S ZRNF("IMMUNEDATETIME")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("EVENT DATE AND TIME","C0CZVI"),"DT") 100955 "RTN","C0CIM2",90,0) 100956 S ZRNF("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_$P($P(@IMMA@(C0CIM),U,13),"~",1) 100957 "RTN","C0CIM2",91,0) 100958 S ZRNF("IMMUNEPRODUCTNAMETEXT")=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD 100959 "RTN","C0CIM2",92,0) 100960 S ZRNF("IMMUNEPRODUCTCODE")=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE 100961 "RTN","C0CIM2",93,0) 100962 I $$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM")'="" S ZRNF("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code" 100963 "RTN","C0CIM2",94,0) 100964 E S ZRNF("IMMUNEPRODUCTCODESYSTEM")="" ;NULL 100965 "RTN","C0CIM2",95,0) 100966 ;CLEANUP FROM C0CRNF CALLS 100967 "RTN","C0CIM2",96,0) 100968 K C0CZIM,C0CZVI 100969 "RTN","C0CIM2",97,0) 100926 100970 Q 100927 "RTN","C0CIM2",80,0)100928 ;100929 "RTN","C0CIM2",81,0)100930 IMMUN ; PARSES IMMUNIZATION TYPE ROWS FOR RPMS100931 "RTN","C0CIM2",82,0)100932 ; RPC FORMAT100933 "RTN","C0CIM2",83,0)100934 ; I ^ Imm Name [2] ^ Visit Date [3] ^ V File IEN [4] ^ Other Location [5] ^ Group [6] ^ Imm IEN [7] ^ Lot [8] ^100935 "RTN","C0CIM2",84,0)100936 ; Reaction [9] ^ VIS Date [10] ^ Age [11] ^ Visit Date [12] ^ Provider IEN~Name [13] ^ Inj Site [14] ^100937 "RTN","C0CIM2",85,0)100938 ; Volume [15] ^ Visit IEN [16] ^ Visit Category [17] ^ Full Name [18] ^ Location IEN~Name [19] ^ Visit Locked [20]100939 "RTN","C0CIM2",86,0)100940 ; RETRIEVE IMMUNIZATION RECORD FROM IMMUNIZATION FILE (9999999.14) FOR THIS IMMUNIZATION100941 "RTN","C0CIM2",87,0)100942 D GETN^C0CRNF("C0CZIM",9999999.14,$P(@IMMA@(C0CIM),U,7)) ; GET IMMUNIZATION RECORD100943 "RTN","C0CIM2",88,0)100944 ; RETIREVE IMMUNIZATION RECORD FROM V IMMUNIZATION FILE (9000010.11) FOR THIS IMMUNIZATION100945 "RTN","C0CIM2",89,0)100946 D GETN^C0CRNF("C0CZVI",9000010.11,$P(@IMMA@(C0CIM),U,4)) ; GET V IMMUNIZATION RECORD100947 "RTN","C0CIM2",90,0)100948 S ZRNF("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID100949 "RTN","C0CIM2",91,0)100950 S ZRNF("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME100951 "RTN","C0CIM2",92,0)100952 S ZRNF("IMMUNEDATETIME")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("EVENT DATE AND TIME","C0CZVI"),"DT")100953 "RTN","C0CIM2",93,0)100954 S ZRNF("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_$P($P(@IMMA@(C0CIM),U,13),"~",1)100955 "RTN","C0CIM2",94,0)100956 S ZRNF("IMMUNEPRODUCTNAMETEXT")=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD100957 "RTN","C0CIM2",95,0)100958 S ZRNF("IMMUNEPRODUCTCODE")=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE100959 "RTN","C0CIM2",96,0)100960 I $$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM")'="" S ZRNF("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code"100961 "RTN","C0CIM2",97,0)100962 E S ZRNF("IMMUNEPRODUCTCODESYSTEM")="" ;NULL100963 100971 "RTN","C0CIM2",98,0) 100964 ;CLEANUP FROM C0CRNF CALLS100972 FORECAST ; PARSES FORECAST TYPE ROWS FOR RPMS 100965 100973 "RTN","C0CIM2",99,0) 100966 K C0CZIM,C0CZVI100974 ; CURRENTLY DISABLED 100967 100975 "RTN","C0CIM2",100,0) 100968 100976 Q 100969 100977 "RTN","C0CIM2",101,0) 100970 FORECAST; PARSES FORECAST TYPE ROWS FOR RPMS100978 CONTRA ; PARSES FORECAST TYPE ROWS FOR RPMS 100971 100979 "RTN","C0CIM2",102,0) 100972 100980 ; CURRENTLY DISABLED … … 100974 100982 Q 100975 100983 "RTN","C0CIM2",104,0) 100976 CONTRA; PARSES FORECAST TYPE ROWS FOR RPMS100984 REFUSE ; PARSES FORECAST TYPE ROWS FOR RPMS 100977 100985 "RTN","C0CIM2",105,0) 100978 100986 ; CURRENTLY DISABLED … … 100980 100988 Q 100981 100989 "RTN","C0CIM2",107,0) 100982 REFUSE ; PARSES FORECAST TYPE ROWS FOR RPMS 100990 ; 100983 100991 "RTN","C0CIM2",108,0) 100984 ; CURRENTLY DISABLED 100992 MAP(IMMXML,C0CIMM,IMMOUT) ; MAP IMMUNIZATION XML 100985 100993 "RTN","C0CIM2",109,0) 100994 ; 100995 "RTN","C0CIM2",110,0) 100996 N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"IMMTEMP")) ;WORK AREA FOR TEMPLATE 100997 "RTN","C0CIM2",111,0) 100998 K @ZTEMP 100999 "RTN","C0CIM2",112,0) 101000 N ZBLD 101001 "RTN","C0CIM2",113,0) 101002 S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"IMMBLD")) ; BUILD LIST AREA 101003 "RTN","C0CIM2",114,0) 101004 D QUEUE^C0CXPATH(ZBLD,IMMXML,1,1) ; FIRST LINE 101005 "RTN","C0CIM2",115,0) 101006 N ZINNER 101007 "RTN","C0CIM2",116,0) 101008 ; XPATH NEEDS TO MATCH YOUR SECTION 101009 "RTN","C0CIM2",117,0) 101010 D QUERY^C0CXPATH(IMMXML,"//Immunizations/Immunization","ZINNER") ;ONE PROC 101011 "RTN","C0CIM2",118,0) 101012 N ZTMP,ZVAR,ZI 101013 "RTN","C0CIM2",119,0) 101014 S ZI="" 101015 "RTN","C0CIM2",120,0) 101016 F S ZI=$O(@C0CIMM@("V",ZI)) Q:ZI="" D ;FOR EACH IMMUNIZATION 101017 "RTN","C0CIM2",121,0) 101018 . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS IMMUNIZATION XML 101019 "RTN","C0CIM2",122,0) 101020 . S ZVAR=$NA(@C0CIMM@("V",ZI)) ;THIS IMMUNIZATION VARIABLES 101021 "RTN","C0CIM2",123,0) 101022 . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE IMMUNIZATION 101023 "RTN","C0CIM2",124,0) 101024 . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUEUE FOR BUILD 101025 "RTN","C0CIM2",125,0) 101026 D QUEUE^C0CXPATH(ZBLD,IMMXML,@IMMXML@(0),@IMMXML@(0)) 101027 "RTN","C0CIM2",126,0) 101028 N ZZTMP ; IS THIS NEEDED? 101029 "RTN","C0CIM2",127,0) 101030 D BUILD^C0CXPATH(ZBLD,IMMOUT) ;BUILD FINAL XML 101031 "RTN","C0CIM2",128,0) 101032 K @ZTEMP,@ZBLD 101033 "RTN","C0CIM2",129,0) 100986 101034 Q 100987 "RTN","C0CIM2",110,0)100988 ;100989 "RTN","C0CIM2",111,0)100990 MAP(IMMXML,C0CIMM,IMMOUT) ; MAP IMMUNIZATION XML100991 "RTN","C0CIM2",112,0)100992 ;100993 "RTN","C0CIM2",113,0)100994 N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"IMMTEMP")) ;WORK AREA FOR TEMPLATE100995 "RTN","C0CIM2",114,0)100996 K @ZTEMP100997 "RTN","C0CIM2",115,0)100998 N ZBLD100999 "RTN","C0CIM2",116,0)101000 S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"IMMBLD")) ; BUILD LIST AREA101001 "RTN","C0CIM2",117,0)101002 D QUEUE^C0CXPATH(ZBLD,IMMXML,1,1) ; FIRST LINE101003 "RTN","C0CIM2",118,0)101004 N ZINNER101005 "RTN","C0CIM2",119,0)101006 ; XPATH NEEDS TO MATCH YOUR SECTION101007 "RTN","C0CIM2",120,0)101008 D QUERY^C0CXPATH(IMMXML,"//Immunizations/Immunization","ZINNER") ;ONE PROC101009 "RTN","C0CIM2",121,0)101010 N ZTMP,ZVAR,ZI101011 "RTN","C0CIM2",122,0)101012 S ZI=""101013 "RTN","C0CIM2",123,0)101014 F S ZI=$O(@C0CIMM@("V",ZI)) Q:ZI="" D ;FOR EACH IMMUNIZATION101015 "RTN","C0CIM2",124,0)101016 . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS IMMUNIZATION XML101017 "RTN","C0CIM2",125,0)101018 . S ZVAR=$NA(@C0CIMM@("V",ZI)) ;THIS IMMUNIZATION VARIABLES101019 "RTN","C0CIM2",126,0)101020 . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE IMMUNIZATION101021 "RTN","C0CIM2",127,0)101022 . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUEUE FOR BUILD101023 "RTN","C0CIM2",128,0)101024 D QUEUE^C0CXPATH(ZBLD,IMMXML,@IMMXML@(0),@IMMXML@(0))101025 "RTN","C0CIM2",129,0)101026 N ZZTMP ; IS THIS NEEDED?101027 101035 "RTN","C0CIM2",130,0) 101028 D BUILD^C0CXPATH(ZBLD,IMMOUT) ;BUILD FINAL XML101029 "RTN","C0CIM2",131,0)101030 K @ZTEMP,@ZBLD101031 "RTN","C0CIM2",132,0)101032 Q101033 "RTN","C0CIM2",133,0)101034 101036 ; 101035 101037 "RTN","C0CIMMU") 101036 0^41^B 20441765101038 0^41^B19603373 101037 101039 "RTN","C0CIMMU",1,0) 101038 101040 C0CIMMU ; CCDCCR/GPL - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 2/2/09 101039 101041 "RTN","C0CIMMU",2,0) 101040 ;;1.2;C 0C;;May 11, 2012;Build 50101042 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 101041 101043 "RTN","C0CIMMU",3,0) 101042 101044 ;Copyright 2008,2009 George Lilly, University of Minnesota. 101043 101045 "RTN","C0CIMMU",4,0) 101044 ; Licensed under the terms of the GNU General Public License.101046 ; 101045 101047 "RTN","C0CIMMU",5,0) 101046 ; See attached copy of the License.101048 ; This program is free software: you can redistribute it and/or modify 101047 101049 "RTN","C0CIMMU",6,0) 101048 ; 101050 ; it under the terms of the GNU Affero General Public License as 101049 101051 "RTN","C0CIMMU",7,0) 101050 ; This program is free software; you can redistribute it and/or modify101052 ; published by the Free Software Foundation, either version 3 of the 101051 101053 "RTN","C0CIMMU",8,0) 101052 ; it under the terms of the GNU General Public License as published by101054 ; License, or (at your option) any later version. 101053 101055 "RTN","C0CIMMU",9,0) 101054 ; the Free Software Foundation; either version 2 of the License, or101056 ; 101055 101057 "RTN","C0CIMMU",10,0) 101056 ; (at your option) any later version.101058 ; This program is distributed in the hope that it will be useful, 101057 101059 "RTN","C0CIMMU",11,0) 101058 ; 101060 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 101059 101061 "RTN","C0CIMMU",12,0) 101060 ; This program is distributed in the hope that it will be useful,101062 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 101061 101063 "RTN","C0CIMMU",13,0) 101062 ; but WITHOUT ANY WARRANTY; without even the implied warranty of101064 ; GNU Affero General Public License for more details. 101063 101065 "RTN","C0CIMMU",14,0) 101064 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the101066 ; 101065 101067 "RTN","C0CIMMU",15,0) 101066 ; GNU General Public License for more details.101068 ; You should have received a copy of the GNU Affero General Public License 101067 101069 "RTN","C0CIMMU",16,0) 101068 ; 101070 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 101069 101071 "RTN","C0CIMMU",17,0) 101070 ; You should have received a copy of the GNU General Public License along101072 ; 101071 101073 "RTN","C0CIMMU",18,0) 101072 ; with this program; if not, write to the Free Software Foundation, Inc.,101074 ; PROCESS THE IMMUNIZATIONS SECTION OF THE CCR 101073 101075 "RTN","C0CIMMU",19,0) 101074 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.101076 ; 101075 101077 "RTN","C0CIMMU",20,0) 101076 ; 101078 MAP(IPXML,DFN,OUTXML) ; MAP IMMUNIZATIONS 101077 101079 "RTN","C0CIMMU",21,0) 101078 101080 ; 101079 101081 "RTN","C0CIMMU",22,0) 101080 ; PROCESS THE IMMUNIZATIONS SECTION OF THE CCR101082 N C0CZV,C0CZVI ; TO STORE MAPPED VARIABLES 101081 101083 "RTN","C0CIMMU",23,0) 101082 ;101084 N C0CZT ; TMP ARRAY OF MAPPED XML 101083 101085 "RTN","C0CIMMU",24,0) 101084 MAP(IPXML,DFN,OUTXML) ; MAP IMMUNIZATIONS101086 S C0CZV=$NA(^TMP("C0CCCR",$J,"IMMUNE")) ; TEMP STORAGE FOR VARIABLES 101085 101087 "RTN","C0CIMMU",25,0) 101086 ;101088 D EXTRACT(IPXML,DFN,OUTXML) ;EXTRACT THE VARIABLES 101087 101089 "RTN","C0CIMMU",26,0) 101088 N C0CZ V,C0CZVI ; TO STORE MAPPED VARIABLES101090 N C0CZI,C0CZIC ; COUNT OF IMMUNIZATIONS 101089 101091 "RTN","C0CIMMU",27,0) 101090 N C0CZT ; TMP ARRAY OF MAPPED XML101092 S C0CZIC=$G(@C0CZV@(0)) ; TOTAL FROM VARIABLE ARRAY 101091 101093 "RTN","C0CIMMU",28,0) 101092 S C0CZV=$NA(^TMP("C0CCCR",$J,"IMMUNE")) ; TEMP STORAGE FOR VARIABLES101094 I C0CZIC>0 D ;IMMUNIZATIONS FOUND 101093 101095 "RTN","C0CIMMU",29,0) 101094 D EXTRACT(IPXML,DFN,OUTXML) ;EXTRACT THE VARIABLES101096 . F C0CZI=1:1:C0CZIC D ;FOR EACH IMMUNIZATION 101095 101097 "RTN","C0CIMMU",30,0) 101096 N C0CZI,C0CZIC ; COUNT OF IMMUNIZATIONS101098 . . S C0CZVI=$NA(@C0CZV@(C0CZI)) ;THIS IMMUNIZATION 101097 101099 "RTN","C0CIMMU",31,0) 101098 S C0CZIC=$G(@C0CZV@(0)) ; TOTAL FROM VARIABLE ARRAY101100 . . D MAP^C0CXPATH(IPXML,C0CZVI,"C0CZT") ;MAP THE VARIABLES TO XML 101099 101101 "RTN","C0CIMMU",32,0) 101100 I C0CZIC>0 D ;IMMUNIZATIONS FOUND101102 . . I C0CZI=1 D ; FIRST ONE 101101 101103 "RTN","C0CIMMU",33,0) 101102 . F C0CZI=1:1:C0CZIC D ;FOR EACH IMMUNIZATION101104 . . . D CP^C0CXPATH("C0CZT",OUTXML) ;JUST COPY RESULTS 101103 101105 "RTN","C0CIMMU",34,0) 101104 . . S C0CZVI=$NA(@C0CZV@(C0CZI)) ;THIS IMMUNIZATION101106 . . E D ;NOT THE FIRST 101105 101107 "RTN","C0CIMMU",35,0) 101106 . . D MAP^C0CXPATH(IPXML,C0CZVI,"C0CZT") ;MAP THE VARIABLES TO XML101108 . . . D INSINNER^C0CXPATH(OUTXML,"C0CZT") 101107 101109 "RTN","C0CIMMU",36,0) 101108 . . I C0CZI=1 D ; FIRST ONE101110 E S @OUTXML@(0)=0 ; SIGNAL NO IMMUNIZATIONS 101109 101111 "RTN","C0CIMMU",37,0) 101110 . . . D CP^C0CXPATH("C0CZT",OUTXML) ;JUST COPY RESULTS101112 N IMMUTMP,I 101111 101113 "RTN","C0CIMMU",38,0) 101112 . . E D ;NOT THE FIRST101114 D MISSING^C0CXPATH(OUTXML,"IMMUTMP") ; SEARCH XML FOR MISSING VARS 101113 101115 "RTN","C0CIMMU",39,0) 101114 . . . D INSINNER^C0CXPATH(OUTXML,"C0CZT")101116 I IMMUTMP(0)>0 D ; IF THERE ARE MISSING VARS - 101115 101117 "RTN","C0CIMMU",40,0) 101116 E S @OUTXML@(0)=0 ; SIGNAL NO IMMUNIZATIONS101118 . ; STRINGS MARKED AS @@X@@ 101117 101119 "RTN","C0CIMMU",41,0) 101118 N IMMUTMP,I101120 . W !,"IMMUNE Missing list: ",! 101119 101121 "RTN","C0CIMMU",42,0) 101120 D MISSING^C0CXPATH(OUTXML,"IMMUTMP") ; SEARCH XML FOR MISSING VARS101122 . F I=1:1:IMMUTMP(0) W IMMUTMP(I),! 101121 101123 "RTN","C0CIMMU",43,0) 101122 I IMMUTMP(0)>0 D ; IF THERE ARE MISSING VARS -101124 Q 101123 101125 "RTN","C0CIMMU",44,0) 101124 . ; STRINGS MARKED AS @@X@@101126 ; 101125 101127 "RTN","C0CIMMU",45,0) 101126 . W !,"IMMUNE Missing list: ",! 101128 EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT IMMUNIZATIONS INTO VARIABLES 101127 101129 "RTN","C0CIMMU",46,0) 101128 . F I=1:1:IMMUTMP(0) W IMMUTMP(I),!101130 ; 101129 101131 "RTN","C0CIMMU",47,0) 101132 ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED 101133 "RTN","C0CIMMU",48,0) 101134 ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE 101135 "RTN","C0CIMMU",49,0) 101136 ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE 101137 "RTN","C0CIMMU",50,0) 101138 ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS 101139 "RTN","C0CIMMU",51,0) 101140 ; INSERT^C0CXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT 101141 "RTN","C0CIMMU",52,0) 101142 ; 101143 "RTN","C0CIMMU",53,0) 101144 N RPCRSLT,J,K,PTMP,X,VMAP,TBU 101145 "RTN","C0CIMMU",54,0) 101146 S TVMAP=$NA(^TMP("C0CCCR",$J,"IMMUNE")) 101147 "RTN","C0CIMMU",55,0) 101148 S TARYTMP=$NA(^TMP("C0CCCR",$J,"IMMUARYTMP")) 101149 "RTN","C0CIMMU",56,0) 101150 S IMMA=$NA(^TMP("PXI",$J)) ; 101151 "RTN","C0CIMMU",57,0) 101152 K @IMMA ; CLEAR OUT PREVIOUS RESULTS 101153 "RTN","C0CIMMU",58,0) 101154 K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES 101155 "RTN","C0CIMMU",59,0) 101156 D IMMUN^PXRHS03(DFN) ; 101157 "RTN","C0CIMMU",60,0) 101158 I $O(@IMMA@(""))="" D Q ; RPC RETURNS NULL 101159 "RTN","C0CIMMU",61,0) 101160 . W "NULL RESULT FROM IMMUN^PXRHS03 ",! 101161 "RTN","C0CIMMU",62,0) 101162 . S @TVMAP@(0)=0 101163 "RTN","C0CIMMU",63,0) 101164 N C0CIM,C0CC,C0CIMD,C0CIEN,C0CT ; 101165 "RTN","C0CIMMU",64,0) 101166 S C0CIM="" 101167 "RTN","C0CIMMU",65,0) 101168 S C0CC=0 ; COUNT 101169 "RTN","C0CIMMU",66,0) 101170 F S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM="" D ; FOR EACH IMMUNE TYPE IN THE LIST 101171 "RTN","C0CIMMU",67,0) 101172 . S C0CC=C0CC+1 ;INCREMENT COUNT 101173 "RTN","C0CIMMU",68,0) 101174 . S @TVMAP@(0)=C0CC ; SAVE NEW COUNT TO ARRAY 101175 "RTN","C0CIMMU",69,0) 101176 . S VMAP=$NA(@TVMAP@(C0CC)) ; THIS IMMUNE ELEMENT 101177 "RTN","C0CIMMU",70,0) 101178 . K @VMAP ; MAKE SURE IT IS CLEARED OUT 101179 "RTN","C0CIMMU",71,0) 101180 . W C0CIM,! 101181 "RTN","C0CIMMU",72,0) 101182 . S C0CIMD="" ; IMMUNE DATE 101183 "RTN","C0CIMMU",73,0) 101184 . F S C0CIMD=$O(@IMMA@(C0CIM,C0CIMD)) Q:C0CIMD="" D ; FOR EACH DATE 101185 "RTN","C0CIMMU",74,0) 101186 . . S C0CIEN=$O(@IMMA@(C0CIM,C0CIMD,"")) ;IEN OF IMMUNE RECORD 101187 "RTN","C0CIMMU",75,0) 101188 . . D GETN^C0CRNF("C0CI",9000010.11,C0CIEN) ; GET THE FILEMAN RECORD FOR IENS 101189 "RTN","C0CIMMU",76,0) 101190 . . W C0CIEN,"_",C0CIMD 101191 "RTN","C0CIMMU",77,0) 101192 . . S C0CT=$$FMDTOUTC^C0CUTIL(9999999-C0CIMD,"DT") ; FORMAT DATE/TIME 101193 "RTN","C0CIMMU",78,0) 101194 . . W C0CT,! 101195 "RTN","C0CIMMU",79,0) 101196 . . S @VMAP@("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID 101197 "RTN","C0CIMMU",80,0) 101198 . . S @VMAP@("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME 101199 "RTN","C0CIMMU",81,0) 101200 . . S @VMAP@("IMMUNEDATETIME")=C0CT ;FORMATTED DATE/TIME 101201 "RTN","C0CIMMU",82,0) 101202 . . S C0CIP=$$ZVALUEI^C0CRNF("ENCOUNTER PROVIDER","C0CI") ;IEN OF PROVIDER 101203 "RTN","C0CIMMU",83,0) 101204 . . S @VMAP@("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_C0CIP 101205 "RTN","C0CIMMU",84,0) 101206 . . S C0CIIEN=$$ZVALUEI^C0CRNF("IMMUNIZATION","C0CI") ;IEN OF IMMUNIZATION 101207 "RTN","C0CIMMU",85,0) 101208 . . I $G(DUZ("AG"))="I" D ; RUNNING IN RPMS 101209 "RTN","C0CIMMU",86,0) 101210 . . . D GETN^C0CRNF("C0CZIM",9999999.14,C0CIIEN) ;GET IMMUNE RECORD 101211 "RTN","C0CIMMU",87,0) 101212 . . . S C0CIN=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD 101213 "RTN","C0CIMMU",88,0) 101214 . . . ; FOR LOOKING UP THE CODE 101215 "RTN","C0CIMMU",89,0) 101216 . . . ; GET IT FROM THE CODE FILE 101217 "RTN","C0CIMMU",90,0) 101218 . . . S C0CICD=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE 101219 "RTN","C0CIMMU",91,0) 101220 . . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME 101221 "RTN","C0CIMMU",92,0) 101222 . . . S @VMAP@("IMMUNEPRODUCTCODE")=C0CICD ; CVX CODE 101223 "RTN","C0CIMMU",93,0) 101224 . . . I C0CICD'="" S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code" ; 101225 "RTN","C0CIMMU",94,0) 101226 . . . E S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NULL 101227 "RTN","C0CIMMU",95,0) 101228 . . E D ; NOT IN RPMS 101229 "RTN","C0CIMMU",96,0) 101230 . . . S C0CIN=$$ZVALUE^C0CRNF("IMMUNIZATION","C0CI") ;NAME OF IMMUNIZATION 101231 "RTN","C0CIMMU",97,0) 101232 . . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME 101233 "RTN","C0CIMMU",98,0) 101234 . . . S @VMAP@("IMMUNEPRODUCTCODE")="" ; CVX CODE 101235 "RTN","C0CIMMU",99,0) 101236 . . . S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NO CODE 101237 "RTN","C0CIMMU",100,0) 101238 N C0CIRIM S C0CIRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE")) 101239 "RTN","C0CIMMU",101,0) 101240 M @C0CIRIM=@TVMAP ; PERSIST RIM VARIABLES 101241 "RTN","C0CIMMU",102,0) 101130 101242 Q 101131 "RTN","C0CIMMU",48,0)101132 ;101133 "RTN","C0CIMMU",49,0)101134 EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT IMMUNIZATIONS INTO VARIABLES101135 "RTN","C0CIMMU",50,0)101136 ;101137 "RTN","C0CIMMU",51,0)101138 ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED101139 "RTN","C0CIMMU",52,0)101140 ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE101141 "RTN","C0CIMMU",53,0)101142 ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE101143 "RTN","C0CIMMU",54,0)101144 ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS101145 "RTN","C0CIMMU",55,0)101146 ; INSERT^C0CXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT101147 "RTN","C0CIMMU",56,0)101148 ;101149 "RTN","C0CIMMU",57,0)101150 N RPCRSLT,J,K,PTMP,X,VMAP,TBU101151 "RTN","C0CIMMU",58,0)101152 S TVMAP=$NA(^TMP("C0CCCR",$J,"IMMUNE"))101153 "RTN","C0CIMMU",59,0)101154 S TARYTMP=$NA(^TMP("C0CCCR",$J,"IMMUARYTMP"))101155 "RTN","C0CIMMU",60,0)101156 S IMMA=$NA(^TMP("PXI",$J)) ;101157 "RTN","C0CIMMU",61,0)101158 K @IMMA ; CLEAR OUT PREVIOUS RESULTS101159 "RTN","C0CIMMU",62,0)101160 K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES101161 "RTN","C0CIMMU",63,0)101162 D IMMUN^PXRHS03(DFN) ;101163 "RTN","C0CIMMU",64,0)101164 I $O(@IMMA@(""))="" D Q ; RPC RETURNS NULL101165 "RTN","C0CIMMU",65,0)101166 . W "NULL RESULT FROM IMMUN^PXRHS03 ",!101167 "RTN","C0CIMMU",66,0)101168 . S @TVMAP@(0)=0101169 "RTN","C0CIMMU",67,0)101170 N C0CIM,C0CC,C0CIMD,C0CIEN,C0CT ;101171 "RTN","C0CIMMU",68,0)101172 S C0CIM=""101173 "RTN","C0CIMMU",69,0)101174 S C0CC=0 ; COUNT101175 "RTN","C0CIMMU",70,0)101176 F S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM="" D ; FOR EACH IMMUNE TYPE IN THE LIST101177 "RTN","C0CIMMU",71,0)101178 . S C0CC=C0CC+1 ;INCREMENT COUNT101179 "RTN","C0CIMMU",72,0)101180 . S @TVMAP@(0)=C0CC ; SAVE NEW COUNT TO ARRAY101181 "RTN","C0CIMMU",73,0)101182 . S VMAP=$NA(@TVMAP@(C0CC)) ; THIS IMMUNE ELEMENT101183 "RTN","C0CIMMU",74,0)101184 . K @VMAP ; MAKE SURE IT IS CLEARED OUT101185 "RTN","C0CIMMU",75,0)101186 . W C0CIM,!101187 "RTN","C0CIMMU",76,0)101188 . S C0CIMD="" ; IMMUNE DATE101189 "RTN","C0CIMMU",77,0)101190 . F S C0CIMD=$O(@IMMA@(C0CIM,C0CIMD)) Q:C0CIMD="" D ; FOR EACH DATE101191 "RTN","C0CIMMU",78,0)101192 . . S C0CIEN=$O(@IMMA@(C0CIM,C0CIMD,"")) ;IEN OF IMMUNE RECORD101193 "RTN","C0CIMMU",79,0)101194 . . D GETN^C0CRNF("C0CI",9000010.11,C0CIEN) ; GET THE FILEMAN RECORD FOR IENS101195 "RTN","C0CIMMU",80,0)101196 . . W C0CIEN,"_",C0CIMD101197 "RTN","C0CIMMU",81,0)101198 . . S C0CT=$$FMDTOUTC^C0CUTIL(9999999-C0CIMD,"DT") ; FORMAT DATE/TIME101199 "RTN","C0CIMMU",82,0)101200 . . W C0CT,!101201 "RTN","C0CIMMU",83,0)101202 . . S @VMAP@("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID101203 "RTN","C0CIMMU",84,0)101204 . . S @VMAP@("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME101205 "RTN","C0CIMMU",85,0)101206 . . S @VMAP@("IMMUNEDATETIME")=C0CT ;FORMATTED DATE/TIME101207 "RTN","C0CIMMU",86,0)101208 . . S C0CIP=$$ZVALUEI^C0CRNF("ENCOUNTER PROVIDER","C0CI") ;IEN OF PROVIDER101209 "RTN","C0CIMMU",87,0)101210 . . S @VMAP@("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_C0CIP101211 "RTN","C0CIMMU",88,0)101212 . . S C0CIIEN=$$ZVALUEI^C0CRNF("IMMUNIZATION","C0CI") ;IEN OF IMMUNIZATION101213 "RTN","C0CIMMU",89,0)101214 . . I $G(DUZ("AG"))="I" D ; RUNNING IN RPMS101215 "RTN","C0CIMMU",90,0)101216 . . . D GETN^C0CRNF("C0CZIM",9999999.14,C0CIIEN) ;GET IMMUNE RECORD101217 "RTN","C0CIMMU",91,0)101218 . . . S C0CIN=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD101219 "RTN","C0CIMMU",92,0)101220 . . . ; FOR LOOKING UP THE CODE101221 "RTN","C0CIMMU",93,0)101222 . . . ; GET IT FROM THE CODE FILE101223 "RTN","C0CIMMU",94,0)101224 . . . S C0CICD=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE101225 "RTN","C0CIMMU",95,0)101226 . . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME101227 "RTN","C0CIMMU",96,0)101228 . . . S @VMAP@("IMMUNEPRODUCTCODE")=C0CICD ; CVX CODE101229 "RTN","C0CIMMU",97,0)101230 . . . I C0CICD'="" S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code" ;101231 "RTN","C0CIMMU",98,0)101232 . . . E S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NULL101233 "RTN","C0CIMMU",99,0)101234 . . E D ; NOT IN RPMS101235 "RTN","C0CIMMU",100,0)101236 . . . S C0CIN=$$ZVALUE^C0CRNF("IMMUNIZATION","C0CI") ;NAME OF IMMUNIZATION101237 "RTN","C0CIMMU",101,0)101238 . . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME101239 "RTN","C0CIMMU",102,0)101240 . . . S @VMAP@("IMMUNEPRODUCTCODE")="" ; CVX CODE101241 101243 "RTN","C0CIMMU",103,0) 101242 . . . S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NO CODE101243 "RTN","C0CIMMU",104,0)101244 N C0CIRIM S C0CIRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE"))101245 "RTN","C0CIMMU",105,0)101246 M @C0CIRIM=@TVMAP ; PERSIST RIM VARIABLES101247 "RTN","C0CIMMU",106,0)101248 Q101249 "RTN","C0CIMMU",107,0)101250 101244 ; 101251 101245 "RTN","C0CIN") 101252 0^72^B30 946883101246 0^72^B30222275 101253 101247 "RTN","C0CIN",1,0) 101254 101248 C0CIN ; CCDCCR/GPL - CCR IMPORT utilities; 9/20/08 101255 101249 "RTN","C0CIN",2,0) 101256 ;;1.2;C 0C;;May 11, 2012;Build 50101250 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 101257 101251 "RTN","C0CIN",3,0) 101258 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU101252 ;Copyright 2009 George Lilly. 101259 101253 "RTN","C0CIN",4,0) 101260 ; General Public License See attached copy of the License.101254 ; 101261 101255 "RTN","C0CIN",5,0) 101262 ; 101256 ; This program is free software: you can redistribute it and/or modify 101263 101257 "RTN","C0CIN",6,0) 101264 ; This program is free software; you can redistribute it and/or modify101258 ; it under the terms of the GNU Affero General Public License as 101265 101259 "RTN","C0CIN",7,0) 101266 ; it under the terms of the GNU General Public License as published by101260 ; published by the Free Software Foundation, either version 3 of the 101267 101261 "RTN","C0CIN",8,0) 101268 ; the Free Software Foundation; either version 2 of the License, or101262 ; License, or (at your option) any later version. 101269 101263 "RTN","C0CIN",9,0) 101270 ; (at your option) any later version.101264 ; 101271 101265 "RTN","C0CIN",10,0) 101272 ; 101266 ; This program is distributed in the hope that it will be useful, 101273 101267 "RTN","C0CIN",11,0) 101274 ; This program is distributed in the hope that it will be useful,101268 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 101275 101269 "RTN","C0CIN",12,0) 101276 ; but WITHOUT ANY WARRANTY; without even the implied warranty of101270 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 101277 101271 "RTN","C0CIN",13,0) 101278 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the101272 ; GNU Affero General Public License for more details. 101279 101273 "RTN","C0CIN",14,0) 101280 ; GNU General Public License for more details.101274 ; 101281 101275 "RTN","C0CIN",15,0) 101282 ; 101276 ; You should have received a copy of the GNU Affero General Public License 101283 101277 "RTN","C0CIN",16,0) 101284 ; You should have received a copy of the GNU General Public License along101278 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 101285 101279 "RTN","C0CIN",17,0) 101286 ; with this program; if not, write to the Free Software Foundation, Inc.,101280 ; 101287 101281 "RTN","C0CIN",18,0) 101288 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.101282 W "This is the CCR Import Utility Library ",! 101289 101283 "RTN","C0CIN",19,0) 101290 ;101284 Q 101291 101285 "RTN","C0CIN",20,0) 101292 W "This is the CCR Import Utility Library ",!101286 ; 101293 101287 "RTN","C0CIN",21,0) 101288 TEST ; TESTS BOTH ROUTINES AT ONCE 101289 "RTN","C0CIN",22,0) 101290 N ZI,ZJ 101291 "RTN","C0CIN",23,0) 101292 S ZI="/home/vademo2/CCR" ;directory purposely leaving off the trailing / 101293 "RTN","C0CIN",24,0) 101294 S ZJ="PAT_358_CCR_V1_0_21.xml" ; random test patient 101295 "RTN","C0CIN",25,0) 101296 D RPCFIN(.GPL,358,135,"GPLTEST","CCR",ZJ,ZI) 101297 "RTN","C0CIN",26,0) 101294 101298 Q 101295 "RTN","C0CIN",22,0)101296 ;101297 "RTN","C0CIN",23,0)101298 TEST ; TESTS BOTH ROUTINES AT ONCE101299 "RTN","C0CIN",24,0)101300 N ZI,ZJ101301 "RTN","C0CIN",25,0)101302 S ZI="/home/vademo2/CCR" ;directory purposely leaving off the trailing /101303 "RTN","C0CIN",26,0)101304 S ZJ="PAT_358_CCR_V1_0_21.xml" ; random test patient101305 101299 "RTN","C0CIN",27,0) 101306 D RPCFIN(.GPL,358,135,"GPLTEST","CCR",ZJ,ZI)101300 ; 101307 101301 "RTN","C0CIN",28,0) 101302 RPCAIN(RTN,DFN,DUZ,SOURCE,TYPE,ARY) ; ARRAY IN RPC - ACCEPT AN XML DOCUMENT 101303 "RTN","C0CIN",29,0) 101304 ; AND STORE IT IN THE INCOMING XML FILE 101305 "RTN","C0CIN",30,0) 101306 ; RETURNS THE IEN OF THE RECORD OR TEXT IF THERE IS AN ERROR 101307 "RTN","C0CIN",31,0) 101308 I $G(DFN)="" S RTN="DFN NOT DEFINED" Q ; 101309 "RTN","C0CIN",32,0) 101310 N C0CXF S C0CXF=175 ; FILE NUMBER FOR INCOMING XML FILE 101311 "RTN","C0CIN",33,0) 101312 N C0CFDA,ZX 101313 "RTN","C0CIN",34,0) 101314 S C0CFDA(C0CXF,"+1,",.01)=DFN ; PATIENT 101315 "RTN","C0CIN",35,0) 101316 S C0CFDA(C0CXF,"+1,",.02)=DUZ ; PROVIDER CREATING THE RECORD 101317 "RTN","C0CIN",36,0) 101318 S C0CFDA(C0CXF,"+1,",1)=$$NOW^XLFDT ;DATE 101319 "RTN","C0CIN",37,0) 101320 S C0CFDA(C0CXF,"+1,",2)=TYPE ;TYPE 101321 "RTN","C0CIN",38,0) 101322 S C0CFDA(C0CXF,"+1,",3)=$$ADDSRC(SOURCE) ;SOURCE 101323 "RTN","C0CIN",39,0) 101324 S C0CFDA(C0CXF,"+1,",7)="NEW" ; STATUS OF NEW FOR NOT PROCESSED 101325 "RTN","C0CIN",40,0) 101326 D UPDIE ; CREATE THE RECORD 101327 "RTN","C0CIN",41,0) 101328 S ZX=C0CIEN(1) ; CAPTURE THE RECORD NUMBER 101329 "RTN","C0CIN",42,0) 101330 D WP^DIE(C0CXF,ZX_",",4,,ARY,"ZERR") 101331 "RTN","C0CIN",43,0) 101332 ;W "RECORD:",ZX,! 101333 "RTN","C0CIN",44,0) 101334 S RTN=ZX ; RETURN IEN OF THE XML FILE 101335 "RTN","C0CIN",45,0) 101308 101336 Q 101309 "RTN","C0CIN",29,0)101310 ;101311 "RTN","C0CIN",30,0)101312 RPCAIN(RTN,DFN,DUZ,SOURCE,TYPE,ARY) ; ARRAY IN RPC - ACCEPT AN XML DOCUMENT101313 "RTN","C0CIN",31,0)101314 ; AND STORE IT IN THE INCOMING XML FILE101315 "RTN","C0CIN",32,0)101316 ; RETURNS THE IEN OF THE RECORD OR TEXT IF THERE IS AN ERROR101317 "RTN","C0CIN",33,0)101318 I $G(DFN)="" S RTN="DFN NOT DEFINED" Q ;101319 "RTN","C0CIN",34,0)101320 N C0CXF S C0CXF=175 ; FILE NUMBER FOR INCOMING XML FILE101321 "RTN","C0CIN",35,0)101322 N C0CFDA,ZX101323 "RTN","C0CIN",36,0)101324 S C0CFDA(C0CXF,"+1,",.01)=DFN ; PATIENT101325 "RTN","C0CIN",37,0)101326 S C0CFDA(C0CXF,"+1,",.02)=DUZ ; PROVIDER CREATING THE RECORD101327 "RTN","C0CIN",38,0)101328 S C0CFDA(C0CXF,"+1,",1)=$$NOW^XLFDT ;DATE101329 "RTN","C0CIN",39,0)101330 S C0CFDA(C0CXF,"+1,",2)=TYPE ;TYPE101331 "RTN","C0CIN",40,0)101332 S C0CFDA(C0CXF,"+1,",3)=$$ADDSRC(SOURCE) ;SOURCE101333 "RTN","C0CIN",41,0)101334 S C0CFDA(C0CXF,"+1,",7)="NEW" ; STATUS OF NEW FOR NOT PROCESSED101335 "RTN","C0CIN",42,0)101336 D UPDIE ; CREATE THE RECORD101337 "RTN","C0CIN",43,0)101338 S ZX=C0CIEN(1) ; CAPTURE THE RECORD NUMBER101339 "RTN","C0CIN",44,0)101340 D WP^DIE(C0CXF,ZX_",",4,,ARY,"ZERR")101341 "RTN","C0CIN",45,0)101342 ;W "RECORD:",ZX,!101343 101337 "RTN","C0CIN",46,0) 101344 S RTN=ZX ; RETURN IEN OF THE XML FILE101338 ; 101345 101339 "RTN","C0CIN",47,0) 101340 ADDSRC(ZSRC) ;EXTRISIC TO ADD A SOURCE TO THE CCR SOURCE FILE 101341 "RTN","C0CIN",48,0) 101342 ; RETURNS RECORD NUMBER. IF SOURCE EXISTS, JUST RETURNS IT'S RECORD NUMBER 101343 "RTN","C0CIN",49,0) 101344 ; 101345 "RTN","C0CIN",50,0) 101346 N ZX,ZF,C0CFDA 101347 "RTN","C0CIN",51,0) 101348 S ZF=171.401 ; FILE NUMBER FOR CCR SOURCE FILE 101349 "RTN","C0CIN",52,0) 101350 S C0CFDA(ZF,"?+1,",.01)=ZSRC 101351 "RTN","C0CIN",53,0) 101352 D UPDIE 101353 "RTN","C0CIN",54,0) 101354 Q $O(^C0C(171.401,"B",ZSRC,"")) 101355 "RTN","C0CIN",55,0) 101356 ; 101357 "RTN","C0CIN",56,0) 101358 RPCFIN(RTN,DFN,DUZ,SOURCE,TYPE,FN,FP) ; FILE IN RPC - READ AN XML DOCUMENT 101359 "RTN","C0CIN",57,0) 101360 ; FROM A HOST FILE AND STORE IT IN THE INCOMING XML FILE 101361 "RTN","C0CIN",58,0) 101362 N ZX,ZTMP 101363 "RTN","C0CIN",59,0) 101364 I $E($RE(FP))'="/" S ZX=FP_"/" 101365 "RTN","C0CIN",60,0) 101366 E S ZX=FP 101367 "RTN","C0CIN",61,0) 101368 S ZX=ZX_FN 101369 "RTN","C0CIN",62,0) 101370 D LOAD("ZTMP",ZX) 101371 "RTN","C0CIN",63,0) 101372 I '$D(ZTMP) D Q ; NO LUCK 101373 "RTN","C0CIN",64,0) 101374 . W "FILE NOT LOADED",! 101375 "RTN","C0CIN",65,0) 101376 D RPCAIN(.RTN,DFN,DUZ,SOURCE,TYPE,"ZTMP") 101377 "RTN","C0CIN",66,0) 101378 N C0CFDA 101379 "RTN","C0CIN",67,0) 101380 S C0CFDA(175,RTN_",",5)=FN ; FILE NAME 101381 "RTN","C0CIN",68,0) 101382 S C0CFDA(175,RTN_",",6)=FP ; FILE PATH 101383 "RTN","C0CIN",69,0) 101384 D UPDIE ; UPDATE WITH FILE NAME AND PATH 101385 "RTN","C0CIN",70,0) 101346 101386 Q 101347 "RTN","C0CIN",48,0)101348 ;101349 "RTN","C0CIN",49,0)101350 ADDSRC(ZSRC) ;EXTRISIC TO ADD A SOURCE TO THE CCR SOURCE FILE101351 "RTN","C0CIN",50,0)101352 ; RETURNS RECORD NUMBER. IF SOURCE EXISTS, JUST RETURNS IT'S RECORD NUMBER101353 "RTN","C0CIN",51,0)101354 ;101355 "RTN","C0CIN",52,0)101356 N ZX,ZF,C0CFDA101357 "RTN","C0CIN",53,0)101358 S ZF=171.401 ; FILE NUMBER FOR CCR SOURCE FILE101359 "RTN","C0CIN",54,0)101360 S C0CFDA(ZF,"?+1,",.01)=ZSRC101361 "RTN","C0CIN",55,0)101362 D UPDIE101363 "RTN","C0CIN",56,0)101364 Q $O(^C0C(171.401,"B",ZSRC,""))101365 "RTN","C0CIN",57,0)101366 ;101367 "RTN","C0CIN",58,0)101368 RPCFIN(RTN,DFN,DUZ,SOURCE,TYPE,FN,FP) ; FILE IN RPC - READ AN XML DOCUMENT101369 "RTN","C0CIN",59,0)101370 ; FROM A HOST FILE AND STORE IT IN THE INCOMING XML FILE101371 "RTN","C0CIN",60,0)101372 N ZX,ZTMP101373 "RTN","C0CIN",61,0)101374 I $E($RE(FP))'="/" S ZX=FP_"/"101375 "RTN","C0CIN",62,0)101376 E S ZX=FP101377 "RTN","C0CIN",63,0)101378 S ZX=ZX_FN101379 "RTN","C0CIN",64,0)101380 D LOAD("ZTMP",ZX)101381 "RTN","C0CIN",65,0)101382 I '$D(ZTMP) D Q ; NO LUCK101383 "RTN","C0CIN",66,0)101384 . W "FILE NOT LOADED",!101385 "RTN","C0CIN",67,0)101386 D RPCAIN(.RTN,DFN,DUZ,SOURCE,TYPE,"ZTMP")101387 "RTN","C0CIN",68,0)101388 N C0CFDA101389 "RTN","C0CIN",69,0)101390 S C0CFDA(175,RTN_",",5)=FN ; FILE NAME101391 "RTN","C0CIN",70,0)101392 S C0CFDA(175,RTN_",",6)=FP ; FILE PATH101393 101387 "RTN","C0CIN",71,0) 101394 D UPDIE ; UPDATE WITH FILE NAME AND PATH101388 ; 101395 101389 "RTN","C0CIN",72,0) 101390 RPCLIST(RTN,DFN) ; CCR LIST - LIST XML DOCUMENTS FOR PATIENT DFN 101391 "RTN","C0CIN",73,0) 101392 ; THAT ARE STORED IN THE INCOMING XML FILE 101393 "RTN","C0CIN",74,0) 101394 ; RETURNS AN ARRAY OF THE FORM 101395 "RTN","C0CIN",75,0) 101396 ; RTN(x)="IEN^DATE^TYPE^SOURCE^STATUS^CREATEDBY" WHERE 101397 "RTN","C0CIN",76,0) 101398 ; IEN IS THE RECORD NUMBER OF THE XML DOCUMENT 101399 "RTN","C0CIN",77,0) 101400 ; DATE IS THE DATE THE DOCUMENT WAS STORED IN THE FILE 101401 "RTN","C0CIN",78,0) 101402 ; TYPE IS "CCD" OR "CCR" OR "OTHER" 101403 "RTN","C0CIN",79,0) 101404 ; SOURCE IS THE NAME OF THE DOCUMENT SOURCE FROM THE CCR SOURCE FILE 101405 "RTN","C0CIN",80,0) 101406 ; STATUS IS THE STATUS OF THE DOCUMENT (VALUES TO BE DEFINED) 101407 "RTN","C0CIN",81,0) 101408 ; CREATEDBY IS THE NAME OF THE PROVIDER WHO UPLOADED THE XML 101409 "RTN","C0CIN",82,0) 101410 N ZF S ZF=175 ; FILE NUMBER OF INCOMING XML FILE 101411 "RTN","C0CIN",83,0) 101412 N ZI S ZI="" 101413 "RTN","C0CIN",84,0) 101414 N ZN S ZN=0 101415 "RTN","C0CIN",85,0) 101416 F S ZI=$O(^C0CIN("B",DFN,ZI),-1) Q:ZI="" D ; FOR EACH RECORD FOR THIS PATIENT 101417 "RTN","C0CIN",86,0) 101418 . S ZN=ZN+1 ;INCREMENT COUNT OF RETURN ARRAY 101419 "RTN","C0CIN",87,0) 101420 . S $P(RTN(ZN),"^",1)=ZI ; IEN OF RECORD 101421 "RTN","C0CIN",88,0) 101422 . S $P(RTN(ZN),"^",2)=$$GET1^DIQ(ZF,ZI_",",1,"E") ;DATE 101423 "RTN","C0CIN",89,0) 101424 . S $P(RTN(ZN),"^",3)=$$GET1^DIQ(ZF,ZI_",",2,"E") ;TYPE 101425 "RTN","C0CIN",90,0) 101426 . S $P(RTN(ZN),"^",4)=$$GET1^DIQ(ZF,ZI_",",3,"E") ;SOURCE 101427 "RTN","C0CIN",91,0) 101428 . S $P(RTN(ZN),"^",5)=$$GET1^DIQ(ZF,ZI_",",7,"I") ; STATUS 101429 "RTN","C0CIN",92,0) 101430 . S $P(RTN(ZN),"^",6)=$$GET1^DIQ(ZF,ZI_",",.02,"E") ; CREATED BY 101431 "RTN","C0CIN",93,0) 101396 101432 Q 101397 "RTN","C0CIN",73,0)101398 ;101399 "RTN","C0CIN",74,0)101400 RPCLIST(RTN,DFN) ; CCR LIST - LIST XML DOCUMENTS FOR PATIENT DFN101401 "RTN","C0CIN",75,0)101402 ; THAT ARE STORED IN THE INCOMING XML FILE101403 "RTN","C0CIN",76,0)101404 ; RETURNS AN ARRAY OF THE FORM101405 "RTN","C0CIN",77,0)101406 ; RTN(x)="IEN^DATE^TYPE^SOURCE^STATUS^CREATEDBY" WHERE101407 "RTN","C0CIN",78,0)101408 ; IEN IS THE RECORD NUMBER OF THE XML DOCUMENT101409 "RTN","C0CIN",79,0)101410 ; DATE IS THE DATE THE DOCUMENT WAS STORED IN THE FILE101411 "RTN","C0CIN",80,0)101412 ; TYPE IS "CCD" OR "CCR" OR "OTHER"101413 "RTN","C0CIN",81,0)101414 ; SOURCE IS THE NAME OF THE DOCUMENT SOURCE FROM THE CCR SOURCE FILE101415 "RTN","C0CIN",82,0)101416 ; STATUS IS THE STATUS OF THE DOCUMENT (VALUES TO BE DEFINED)101417 "RTN","C0CIN",83,0)101418 ; CREATEDBY IS THE NAME OF THE PROVIDER WHO UPLOADED THE XML101419 "RTN","C0CIN",84,0)101420 N ZF S ZF=175 ; FILE NUMBER OF INCOMING XML FILE101421 "RTN","C0CIN",85,0)101422 N ZI S ZI=""101423 "RTN","C0CIN",86,0)101424 N ZN S ZN=0101425 "RTN","C0CIN",87,0)101426 F S ZI=$O(^C0CIN("B",DFN,ZI),-1) Q:ZI="" D ; FOR EACH RECORD FOR THIS PATIENT101427 "RTN","C0CIN",88,0)101428 . S ZN=ZN+1 ;INCREMENT COUNT OF RETURN ARRAY101429 "RTN","C0CIN",89,0)101430 . S $P(RTN(ZN),"^",1)=ZI ; IEN OF RECORD101431 "RTN","C0CIN",90,0)101432 . S $P(RTN(ZN),"^",2)=$$GET1^DIQ(ZF,ZI_",",1,"E") ;DATE101433 "RTN","C0CIN",91,0)101434 . S $P(RTN(ZN),"^",3)=$$GET1^DIQ(ZF,ZI_",",2,"E") ;TYPE101435 "RTN","C0CIN",92,0)101436 . S $P(RTN(ZN),"^",4)=$$GET1^DIQ(ZF,ZI_",",3,"E") ;SOURCE101437 "RTN","C0CIN",93,0)101438 . S $P(RTN(ZN),"^",5)=$$GET1^DIQ(ZF,ZI_",",7,"I") ; STATUS101439 101433 "RTN","C0CIN",94,0) 101440 . S $P(RTN(ZN),"^",6)=$$GET1^DIQ(ZF,ZI_",",.02,"E") ; CREATED BY101434 ; 101441 101435 "RTN","C0CIN",95,0) 101436 RPCDOC(RTN,IEN) ; RETRIEVE DOCUMENT NUMBER IEN FROM THE INCOMING XML FILE 101437 "RTN","C0CIN",96,0) 101438 ; RETURNED IN ARRAY RTN 101439 "RTN","C0CIN",97,0) 101440 N ZI 101441 "RTN","C0CIN",98,0) 101442 S ZI=$$GET1^DIQ(175,IEN_",",4,,"RTN") 101443 "RTN","C0CIN",99,0) 101442 101444 Q 101443 "RTN","C0CIN",96,0)101444 ;101445 "RTN","C0CIN",97,0)101446 RPCDOC(RTN,IEN) ; RETRIEVE DOCUMENT NUMBER IEN FROM THE INCOMING XML FILE101447 "RTN","C0CIN",98,0)101448 ; RETURNED IN ARRAY RTN101449 "RTN","C0CIN",99,0)101450 N ZI101451 101445 "RTN","C0CIN",100,0) 101452 S ZI=$$GET1^DIQ(175,IEN_",",4,,"RTN")101446 ; 101453 101447 "RTN","C0CIN",101,0) 101448 EN(INXML,SOURCE,C0CDFN) ; IMPORT A CCR, PASSED BY NAME INXML 101449 "RTN","C0CIN",102,0) 101450 ; FILE UNDER SOURCE, WHICH IS A POINTER TO THE CCR SOURCE FILE 101451 "RTN","C0CIN",103,0) 101452 ; FOR PATIENT C0CDFN 101453 "RTN","C0CIN",104,0) 101454 ;N C0CXP 101455 "RTN","C0CIN",105,0) 101456 S C0CINB=$NA(^TMP("C0CIN",$J,"VARS",C0CDFN)) 101457 "RTN","C0CIN",106,0) 101458 S C0CDOCID=$$PARSE^C0CMXML(INXML) ;W !,"DocID: ",C0CDOCID 101459 "RTN","C0CIN",107,0) 101460 ;S REDUX="//ContinuityOfCareRecord/Body" 101461 "RTN","C0CIN",108,0) 101462 S REDUX="" 101463 "RTN","C0CIN",109,0) 101464 D XPATH^C0CMXML(1,"/","C0CIDX","C0CXP",,REDUX) 101465 "RTN","C0CIN",110,0) 101466 ;D INDEX^C0CXPATH(INXML,"C0CXP",-1) ; GENERATE XPATHS FROM THE CCR 101467 "RTN","C0CIN",111,0) 101468 ;N ZI,ZJ,ZK 101469 "RTN","C0CIN",112,0) 101470 S ZI="" 101471 "RTN","C0CIN",113,0) 101472 F S ZI=$O(C0CXP(ZI)) Q:ZI="" D ; FOR EACH XPATH 101473 "RTN","C0CIN",114,0) 101474 . D DEMUX^C0CMXP("ZJ",ZI) ; 101475 "RTN","C0CIN",115,0) 101476 . W ZJ,! 101477 "RTN","C0CIN",116,0) 101478 . S ZK=$P(ZJ,"^",3) ; PULL OUT THE XPATH 101479 "RTN","C0CIN",117,0) 101480 . S ZM=$P(ZJ,"^",1) ; PULL OUT THE MULTIPLE 101481 "RTN","C0CIN",118,0) 101482 . S ZS=$P(ZJ,"^",2) ; PULL OUT THE SUBMULTIPLE 101483 "RTN","C0CIN",119,0) 101484 . S C0CDICN=$O(^C0CDIC(170,"XPATH",ZK,"")) 101485 "RTN","C0CIN",120,0) 101486 . I C0CDICN="" D Q ; 101487 "RTN","C0CIN",121,0) 101488 . . W "MISSING XPATH:",!,ZK,! ; OOPS, XPATH NOT IN C0CDIC 101489 "RTN","C0CIN",122,0) 101490 . . S MISSING(ZK)="" 101491 "RTN","C0CIN",123,0) 101492 . ;D GETS^DIQ(170,C0CDICN_",","*",,"C0CFDA") 101493 "RTN","C0CIN",124,0) 101494 . S C0CVAR=$$GET1^DIQ(170,C0CDICN_",",.01) ; VARIABLE NAME 101495 "RTN","C0CIN",125,0) 101496 . S C0CSEC=$$GET1^DIQ(170,C0CDICN_",",12) ;ELEMENT TYPE 101497 "RTN","C0CIN",126,0) 101498 . W C0CSEC,":",C0CVAR,! 101499 "RTN","C0CIN",127,0) 101454 101500 Q 101455 "RTN","C0CIN",102,0) 101456 ; 101457 "RTN","C0CIN",103,0) 101458 EN(INXML,SOURCE,C0CDFN) ; IMPORT A CCR, PASSED BY NAME INXML 101459 "RTN","C0CIN",104,0) 101460 ; FILE UNDER SOURCE, WHICH IS A POINTER TO THE CCR SOURCE FILE 101461 "RTN","C0CIN",105,0) 101462 ; FOR PATIENT C0CDFN 101463 "RTN","C0CIN",106,0) 101464 ;N C0CXP 101465 "RTN","C0CIN",107,0) 101466 S C0CINB=$NA(^TMP("C0CIN",$J,"VARS",C0CDFN)) 101467 "RTN","C0CIN",108,0) 101468 S C0CDOCID=$$PARSE^C0CMXML(INXML) ;W !,"DocID: ",C0CDOCID 101469 "RTN","C0CIN",109,0) 101470 ;S REDUX="//ContinuityOfCareRecord/Body" 101471 "RTN","C0CIN",110,0) 101472 S REDUX="" 101473 "RTN","C0CIN",111,0) 101474 D XPATH^C0CMXML(1,"/","C0CIDX","C0CXP",,REDUX) 101475 "RTN","C0CIN",112,0) 101476 ;D INDEX^C0CXPATH(INXML,"C0CXP",-1) ; GENERATE XPATHS FROM THE CCR 101477 "RTN","C0CIN",113,0) 101478 ;N ZI,ZJ,ZK 101479 "RTN","C0CIN",114,0) 101501 "RTN","C0CIN",128,0) 101502 ; 101503 "RTN","C0CIN",129,0) 101504 GETACCR(AOUT,C0CDFN) ; EXTRACT A CCR FOR PATIENT ADFN AND PUT IT IN ARRAY AOUT 101505 "RTN","C0CIN",130,0) 101506 ;PASSED BY NAME 101507 "RTN","C0CIN",131,0) 101508 N ZT 101509 "RTN","C0CIN",132,0) 101510 D CCRRPC^C0CCCR(.ZT,C0CDFN,"LABLIMIT:T-1000") 101511 "RTN","C0CIN",133,0) 101512 M @AOUT=ZT 101513 "RTN","C0CIN",134,0) 101514 Q 101515 "RTN","C0CIN",135,0) 101516 ; 101517 "RTN","C0CIN",136,0) 101518 TEST64 ;TEST BASE64 DECODING FOR IMPORTING CCR FROM THE NHIN 101519 "RTN","C0CIN",137,0) 101520 W $$FTG^%ZISH("/tmp/","base64_encoded_ccr.txt","G64(1)",1) 101521 "RTN","C0CIN",138,0) 101522 S G=G64(1) 101523 "RTN","C0CIN",139,0) 101480 101524 S ZI="" 101481 "RTN","C0CIN",115,0) 101482 F S ZI=$O(C0CXP(ZI)) Q:ZI="" D ; FOR EACH XPATH 101483 "RTN","C0CIN",116,0) 101484 . D DEMUX^C0CMXP("ZJ",ZI) ; 101485 "RTN","C0CIN",117,0) 101486 . W ZJ,! 101487 "RTN","C0CIN",118,0) 101488 . S ZK=$P(ZJ,"^",3) ; PULL OUT THE XPATH 101489 "RTN","C0CIN",119,0) 101490 . S ZM=$P(ZJ,"^",1) ; PULL OUT THE MULTIPLE 101491 "RTN","C0CIN",120,0) 101492 . S ZS=$P(ZJ,"^",2) ; PULL OUT THE SUBMULTIPLE 101493 "RTN","C0CIN",121,0) 101494 . S C0CDICN=$O(^C0CDIC(170,"XPATH",ZK,"")) 101495 "RTN","C0CIN",122,0) 101496 . I C0CDICN="" D Q ; 101497 "RTN","C0CIN",123,0) 101498 . . W "MISSING XPATH:",!,ZK,! ; OOPS, XPATH NOT IN C0CDIC 101499 "RTN","C0CIN",124,0) 101500 . . S MISSING(ZK)="" 101501 "RTN","C0CIN",125,0) 101502 . ;D GETS^DIQ(170,C0CDICN_",","*",,"C0CFDA") 101503 "RTN","C0CIN",126,0) 101504 . S C0CVAR=$$GET1^DIQ(170,C0CDICN_",",.01) ; VARIABLE NAME 101505 "RTN","C0CIN",127,0) 101506 . S C0CSEC=$$GET1^DIQ(170,C0CDICN_",",12) ;ELEMENT TYPE 101507 "RTN","C0CIN",128,0) 101508 . W C0CSEC,":",C0CVAR,! 101509 "RTN","C0CIN",129,0) 101525 "RTN","C0CIN",140,0) 101526 F S ZI=$O(G64(1,"OVF",ZI)) Q:ZI="" D ; FOR EVERY OVERFLOW RECORD 101527 "RTN","C0CIN",141,0) 101528 . S G=G_G64(1,"OVF",ZI) ;HOPE IT'S NOT TOO BIG 101529 "RTN","C0CIN",142,0) 101530 S G2=$$DECODE^RGUTUU(G) 101531 "RTN","C0CIN",143,0) 101510 101532 Q 101511 "RTN","C0CIN",130,0) 101512 ; 101513 "RTN","C0CIN",131,0) 101514 GETACCR(AOUT,C0CDFN) ; EXTRACT A CCR FOR PATIENT ADFN AND PUT IT IN ARRAY AOUT 101515 "RTN","C0CIN",132,0) 101516 ;PASSED BY NAME 101517 "RTN","C0CIN",133,0) 101518 N ZT 101519 "RTN","C0CIN",134,0) 101520 D CCRRPC^C0CCCR(.ZT,C0CDFN,"LABLIMIT:T-1000") 101521 "RTN","C0CIN",135,0) 101522 M @AOUT=ZT 101523 "RTN","C0CIN",136,0) 101533 "RTN","C0CIN",144,0) 101534 ; 101535 "RTN","C0CIN",145,0) 101536 NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML 101537 "RTN","C0CIN",146,0) 101538 ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME 101539 "RTN","C0CIN",147,0) 101540 ; 101541 "RTN","C0CIN",148,0) 101542 N ZI,ZN,ZTMP 101543 "RTN","C0CIN",149,0) 101544 S ZN=1 101545 "RTN","C0CIN",150,0) 101546 S @OUTXML@(ZN)=$P(@INXML,"><",ZN)_">" 101547 "RTN","C0CIN",151,0) 101548 S ZN=ZN+1 101549 "RTN","C0CIN",152,0) 101550 F S @OUTXML@(ZN)="<"_$P(@INXML,"><",ZN) Q:$P(@INXML,"><",ZN+1)="" D ; 101551 "RTN","C0CIN",153,0) 101552 . S @OUTXML@(ZN)=@OUTXML@(ZN)_">" 101553 "RTN","C0CIN",154,0) 101554 . S ZN=ZN+1 101555 "RTN","C0CIN",155,0) 101524 101556 Q 101525 "RTN","C0CIN",137,0) 101526 ; 101527 "RTN","C0CIN",138,0) 101528 TEST64 ;TEST BASE64 DECODING FOR IMPORTING CCR FROM THE NHIN 101529 "RTN","C0CIN",139,0) 101530 W $$FTG^%ZISH("/tmp/","base64_encoded_ccr.txt","G64(1)",1) 101531 "RTN","C0CIN",140,0) 101532 S G=G64(1) 101533 "RTN","C0CIN",141,0) 101534 S ZI="" 101535 "RTN","C0CIN",142,0) 101536 F S ZI=$O(G64(1,"OVF",ZI)) Q:ZI="" D ; FOR EVERY OVERFLOW RECORD 101537 "RTN","C0CIN",143,0) 101538 . S G=G_G64(1,"OVF",ZI) ;HOPE IT'S NOT TOO BIG 101539 "RTN","C0CIN",144,0) 101540 S G2=$$DECODE^RGUTUU(G) 101541 "RTN","C0CIN",145,0) 101557 "RTN","C0CIN",156,0) 101558 ; 101559 "RTN","C0CIN",157,0) 101560 CLEANCR(OUTXML,INXML) ; USE $C(10) TO SEPARATE THE STRING INXML INTO 101561 "RTN","C0CIN",158,0) 101562 ;AN ARRAY OUTXML(n) OUTXML AND INXML PASSED BY NAME 101563 "RTN","C0CIN",159,0) 101564 N ZX,ZY,ZN 101565 "RTN","C0CIN",160,0) 101566 S ZX=1,ZN=1 101567 "RTN","C0CIN",161,0) 101568 F S ZY=$F(@INXML,$C(10),ZX) Q:ZY=0 D ; 101569 "RTN","C0CIN",162,0) 101570 . S @OUTXML@(ZN)=$E(G2,ZX,ZY-2) 101571 "RTN","C0CIN",163,0) 101572 . I @OUTXML@(ZN)'="" S ZN=ZN+1 101573 "RTN","C0CIN",164,0) 101574 . S ZX=ZY 101575 "RTN","C0CIN",165,0) 101542 101576 Q 101543 "RTN","C0CIN",146,0) 101544 ; 101545 "RTN","C0CIN",147,0) 101546 NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML 101547 "RTN","C0CIN",148,0) 101548 ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME 101549 "RTN","C0CIN",149,0) 101550 ; 101551 "RTN","C0CIN",150,0) 101552 N ZI,ZN,ZTMP 101553 "RTN","C0CIN",151,0) 101554 S ZN=1 101555 "RTN","C0CIN",152,0) 101556 S @OUTXML@(ZN)=$P(@INXML,"><",ZN)_">" 101557 "RTN","C0CIN",153,0) 101558 S ZN=ZN+1 101559 "RTN","C0CIN",154,0) 101560 F S @OUTXML@(ZN)="<"_$P(@INXML,"><",ZN) Q:$P(@INXML,"><",ZN+1)="" D ; 101561 "RTN","C0CIN",155,0) 101562 . S @OUTXML@(ZN)=@OUTXML@(ZN)_">" 101563 "RTN","C0CIN",156,0) 101564 . S ZN=ZN+1 101565 "RTN","C0CIN",157,0) 101577 "RTN","C0CIN",166,0) 101578 ; 101579 "RTN","C0CIN",167,0) 101580 LOAD(ZRTN,filepath) ; load an xml file into the ZRTN array, passed by name 101581 "RTN","C0CIN",168,0) 101582 n i 101583 "RTN","C0CIN",169,0) 101584 D ; 101585 "RTN","C0CIN",170,0) 101586 . n zfile,zpath,ztmp,zok s (zfile,zpath,ztmp)="" 101587 "RTN","C0CIN",171,0) 101588 . s ztmp=$na(^TMP("C0CLOAD",$J)) 101589 "RTN","C0CIN",172,0) 101590 . k @ztmp 101591 "RTN","C0CIN",173,0) 101592 . s zfile=$re($p($re(filepath),"/",1)) ;file name 101593 "RTN","C0CIN",174,0) 101594 . s zpath=$p(filepath,zfile,1) ; file path 101595 "RTN","C0CIN",175,0) 101596 . s zok=$$FTG^%ZISH(zpath,zfile,$NA(@ztmp@(1)),3) ; import the file incr sub 3 101597 "RTN","C0CIN",176,0) 101598 . m @ZRTN=@ztmp 101599 "RTN","C0CIN",177,0) 101600 . k @ztmp 101601 "RTN","C0CIN",178,0) 101602 . s i=$o(@ZRTN@(""),-1) ; highest line number 101603 "RTN","C0CIN",179,0) 101604 q 101605 "RTN","C0CIN",180,0) 101606 ; 101607 "RTN","C0CIN",181,0) 101608 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 101609 "RTN","C0CIN",182,0) 101610 K ZERR,C0CIEN 101611 "RTN","C0CIN",183,0) 101612 D CLEAN^DILF 101613 "RTN","C0CIN",184,0) 101614 D UPDATE^DIE("","C0CFDA","C0CIEN","ZERR") 101615 "RTN","C0CIN",185,0) 101616 I $D(ZERR) S $EC=",U1," 101617 "RTN","C0CIN",186,0) 101618 K C0CFDA 101619 "RTN","C0CIN",187,0) 101566 101620 Q 101567 "RTN","C0CIN",158,0)101568 ;101569 "RTN","C0CIN",159,0)101570 CLEANCR(OUTXML,INXML) ; USE $C(10) TO SEPARATE THE STRING INXML INTO101571 "RTN","C0CIN",160,0)101572 ;AN ARRAY OUTXML(n) OUTXML AND INXML PASSED BY NAME101573 "RTN","C0CIN",161,0)101574 N ZX,ZY,ZN101575 "RTN","C0CIN",162,0)101576 S ZX=1,ZN=1101577 "RTN","C0CIN",163,0)101578 F S ZY=$F(@INXML,$C(10),ZX) Q:ZY=0 D ;101579 "RTN","C0CIN",164,0)101580 . S @OUTXML@(ZN)=$E(G2,ZX,ZY-2)101581 "RTN","C0CIN",165,0)101582 . I @OUTXML@(ZN)'="" S ZN=ZN+1101583 "RTN","C0CIN",166,0)101584 . S ZX=ZY101585 "RTN","C0CIN",167,0)101586 Q101587 "RTN","C0CIN",168,0)101588 ;101589 "RTN","C0CIN",169,0)101590 LOAD(ZRTN,filepath) ; load an xml file into the ZRTN array, passed by name101591 "RTN","C0CIN",170,0)101592 n i101593 "RTN","C0CIN",171,0)101594 D ;101595 "RTN","C0CIN",172,0)101596 . n zfile,zpath,ztmp,zok s (zfile,zpath,ztmp)=""101597 "RTN","C0CIN",173,0)101598 . s ztmp=$na(^TMP("C0CLOAD",$J))101599 "RTN","C0CIN",174,0)101600 . k @ztmp101601 "RTN","C0CIN",175,0)101602 . s zfile=$re($p($re(filepath),"/",1)) ;file name101603 "RTN","C0CIN",176,0)101604 . s zpath=$p(filepath,zfile,1) ; file path101605 "RTN","C0CIN",177,0)101606 . s zok=$$FTG^%ZISH(zpath,zfile,$NA(@ztmp@(1)),3) ; import the file incr sub 3101607 "RTN","C0CIN",178,0)101608 . m @ZRTN=@ztmp101609 "RTN","C0CIN",179,0)101610 . k @ztmp101611 "RTN","C0CIN",180,0)101612 . s i=$o(@ZRTN@(""),-1) ; highest line number101613 "RTN","C0CIN",181,0)101614 q101615 "RTN","C0CIN",182,0)101616 ;101617 "RTN","C0CIN",183,0)101618 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS101619 "RTN","C0CIN",184,0)101620 K ZERR,C0CIEN101621 "RTN","C0CIN",185,0)101622 D CLEAN^DILF101623 "RTN","C0CIN",186,0)101624 D UPDATE^DIE("","C0CFDA","C0CIEN","ZERR")101625 "RTN","C0CIN",187,0)101626 I $D(ZERR) D ;101627 101621 "RTN","C0CIN",188,0) 101628 . W "ERROR",!101629 "RTN","C0CIN",189,0)101630 . ZWR ZERR101631 "RTN","C0CIN",190,0)101632 . B101633 "RTN","C0CIN",191,0)101634 K C0CFDA101635 "RTN","C0CIN",192,0)101636 Q101637 "RTN","C0CIN",193,0)101638 101622 ; 101639 101623 "RTN","C0CLA7DD") 101640 0^80^B 66668579101624 0^80^B72588185 101641 101625 "RTN","C0CLA7DD",1,0) 101642 C0CLA7DD ;WV/JMC - CCD/CCR Post Install DD X-Ref Setup Routine ; Aug 31, 2009 101626 C0CLA7DD ;WV/JMC - CCD/CCR Post Install DD X-Ref Setup Routine ; Aug 31, 2009 ; 10/30/12 10:16am 101643 101627 "RTN","C0CLA7DD",2,0) 101644 ;;1.2;C 0C;;May 11, 2012;Build 50101628 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 101645 101629 "RTN","C0CLA7DD",3,0) 101646 ; 101630 ; (C) 2009 John McCormack 101647 101631 "RTN","C0CLA7DD",4,0) 101632 ; 101633 "RTN","C0CLA7DD",5,0) 101634 ; This program is free software: you can redistribute it and/or modify 101635 "RTN","C0CLA7DD",6,0) 101636 ; it under the terms of the GNU Affero General Public License as 101637 "RTN","C0CLA7DD",7,0) 101638 ; published by the Free Software Foundation, either version 3 of the 101639 "RTN","C0CLA7DD",8,0) 101640 ; License, or (at your option) any later version. 101641 "RTN","C0CLA7DD",9,0) 101642 ; 101643 "RTN","C0CLA7DD",10,0) 101644 ; This program is distributed in the hope that it will be useful, 101645 "RTN","C0CLA7DD",11,0) 101646 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 101647 "RTN","C0CLA7DD",12,0) 101648 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 101649 "RTN","C0CLA7DD",13,0) 101650 ; GNU Affero General Public License for more details. 101651 "RTN","C0CLA7DD",14,0) 101652 ; 101653 "RTN","C0CLA7DD",15,0) 101654 ; You should have received a copy of the GNU Affero General Public License 101655 "RTN","C0CLA7DD",16,0) 101656 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 101657 "RTN","C0CLA7DD",17,0) 101658 ; 101659 "RTN","C0CLA7DD",18,0) 101648 101660 ; Tasked by C0C post-install routine C0CENV to create C0C cross-references on V LAB file. 101649 "RTN","C0CLA7DD", 5,0)101650 ; 101651 "RTN","C0CLA7DD", 6,0)101661 "RTN","C0CLA7DD",19,0) 101662 ; 101663 "RTN","C0CLA7DD",20,0) 101652 101664 Q 101653 "RTN","C0CLA7DD", 7,0)101654 ; 101655 "RTN","C0CLA7DD", 8,0)101656 ; 101657 "RTN","C0CLA7DD", 9,0)101665 "RTN","C0CLA7DD",21,0) 101666 ; 101667 "RTN","C0CLA7DD",22,0) 101668 ; 101669 "RTN","C0CLA7DD",23,0) 101658 101670 EN ; Add new style cross-references to V LAB file if it exists. 101659 "RTN","C0CLA7DD", 10,0)101671 "RTN","C0CLA7DD",24,0) 101660 101672 ; OLD entry point - see new KIDS check points in C0CENV. 101661 "RTN","C0CLA7DD", 11,0)101662 ; 101663 "RTN","C0CLA7DD", 12,0)101664 ; 101665 "RTN","C0CLA7DD", 13,0)101673 "RTN","C0CLA7DD",25,0) 101674 ; 101675 "RTN","C0CLA7DD",26,0) 101676 ; 101677 "RTN","C0CLA7DD",27,0) 101666 101678 ; Quit if AUPNVLAB global does not exist. 101667 "RTN","C0CLA7DD", 14,0)101679 "RTN","C0CLA7DD",28,0) 101668 101680 I $$VFILE^DILFD(9000010.09)'=1 Q 101669 "RTN","C0CLA7DD", 15,0)101670 ; 101671 "RTN","C0CLA7DD", 16,0)101681 "RTN","C0CLA7DD",29,0) 101682 ; 101683 "RTN","C0CLA7DD",30,0) 101672 101684 N MSG 101673 "RTN","C0CLA7DD", 17,0)101674 ; 101675 "RTN","C0CLA7DD", 18,0)101685 "RTN","C0CLA7DD",31,0) 101686 ; 101687 "RTN","C0CLA7DD",32,0) 101676 101688 S MSG="Starting installation of ALR1 cross-reference at "_$$HTE^XLFDT($H,"1Z") 101677 "RTN","C0CLA7DD", 19,0)101689 "RTN","C0CLA7DD",33,0) 101678 101690 D BMES(MSG) 101679 "RTN","C0CLA7DD", 20,0)101691 "RTN","C0CLA7DD",34,0) 101680 101692 D ALR1 101681 "RTN","C0CLA7DD", 21,0)101693 "RTN","C0CLA7DD",35,0) 101682 101694 S MSG="Installation of ALR1 cross-reference completed at "_$$HTE^XLFDT($H,"1Z") 101683 "RTN","C0CLA7DD", 22,0)101695 "RTN","C0CLA7DD",36,0) 101684 101696 D BMES(MSG) 101685 "RTN","C0CLA7DD", 23,0)101686 ; 101687 "RTN","C0CLA7DD", 24,0)101697 "RTN","C0CLA7DD",37,0) 101698 ; 101699 "RTN","C0CLA7DD",38,0) 101688 101700 S MSG="Starting installation of ALR2 cross-reference at "_$$HTE^XLFDT($H,"1Z") 101689 "RTN","C0CLA7DD", 25,0)101701 "RTN","C0CLA7DD",39,0) 101690 101702 D BMES(MSG) 101691 "RTN","C0CLA7DD", 26,0)101703 "RTN","C0CLA7DD",40,0) 101692 101704 D ALR2 101693 "RTN","C0CLA7DD", 27,0)101705 "RTN","C0CLA7DD",41,0) 101694 101706 S MSG="Installation of ALR2 cross-reference completed at "_$$HTE^XLFDT($H,"1Z") 101695 "RTN","C0CLA7DD", 28,0)101707 "RTN","C0CLA7DD",42,0) 101696 101708 D BMES(MSG) 101697 "RTN","C0CLA7DD", 29,0)101698 ; 101699 "RTN","C0CLA7DD", 30,0)101709 "RTN","C0CLA7DD",43,0) 101710 ; 101711 "RTN","C0CLA7DD",44,0) 101700 101712 S MSG="Starting installation of ALR3 cross-reference at "_$$HTE^XLFDT($H,"1Z") 101701 "RTN","C0CLA7DD", 31,0)101713 "RTN","C0CLA7DD",45,0) 101702 101714 D BMES(MSG) 101703 "RTN","C0CLA7DD", 32,0)101715 "RTN","C0CLA7DD",46,0) 101704 101716 D ALR3 101705 "RTN","C0CLA7DD", 33,0)101717 "RTN","C0CLA7DD",47,0) 101706 101718 S MSG="Installation of ALR3 cross-reference completed at "_$$HTE^XLFDT($H,"1Z") 101707 "RTN","C0CLA7DD", 34,0)101719 "RTN","C0CLA7DD",48,0) 101708 101720 D BMES(MSG) 101709 "RTN","C0CLA7DD", 35,0)101710 ; 101711 "RTN","C0CLA7DD", 36,0)101721 "RTN","C0CLA7DD",49,0) 101722 ; 101723 "RTN","C0CLA7DD",50,0) 101712 101724 S MSG="Starting installation of ALR4 cross-reference at "_$$HTE^XLFDT($H,"1Z") 101713 "RTN","C0CLA7DD", 37,0)101725 "RTN","C0CLA7DD",51,0) 101714 101726 D BMES(MSG) 101715 "RTN","C0CLA7DD", 38,0)101727 "RTN","C0CLA7DD",52,0) 101716 101728 D ALR4 101717 "RTN","C0CLA7DD", 39,0)101729 "RTN","C0CLA7DD",53,0) 101718 101730 S MSG="Installation of ALR4 cross-reference completed at "_$$HTE^XLFDT($H,"1Z") 101719 "RTN","C0CLA7DD", 40,0)101731 "RTN","C0CLA7DD",54,0) 101720 101732 D BMES(MSG) 101721 "RTN","C0CLA7DD", 41,0)101722 ; 101723 "RTN","C0CLA7DD", 42,0)101733 "RTN","C0CLA7DD",55,0) 101734 ; 101735 "RTN","C0CLA7DD",56,0) 101724 101736 S MSG="Starting installation of ALR5 cross-reference at "_$$HTE^XLFDT($H,"1Z") 101725 "RTN","C0CLA7DD", 43,0)101737 "RTN","C0CLA7DD",57,0) 101726 101738 D BMES(MSG) 101727 "RTN","C0CLA7DD", 44,0)101739 "RTN","C0CLA7DD",58,0) 101728 101740 D ALR5 101729 "RTN","C0CLA7DD", 45,0)101741 "RTN","C0CLA7DD",59,0) 101730 101742 S MSG="Installation of ALR5 cross-reference completed at "_$$HTE^XLFDT($H,"1Z") 101731 "RTN","C0CLA7DD", 46,0)101743 "RTN","C0CLA7DD",60,0) 101732 101744 D BMES(MSG) 101733 "RTN","C0CLA7DD", 47,0)101734 ; 101735 "RTN","C0CLA7DD", 48,0)101745 "RTN","C0CLA7DD",61,0) 101746 ; 101747 "RTN","C0CLA7DD",62,0) 101736 101748 Q 101737 "RTN","C0CLA7DD", 49,0)101738 ; 101739 "RTN","C0CLA7DD", 50,0)101740 ; 101741 "RTN","C0CLA7DD", 51,0)101749 "RTN","C0CLA7DD",63,0) 101750 ; 101751 "RTN","C0CLA7DD",64,0) 101752 ; 101753 "RTN","C0CLA7DD",65,0) 101742 101754 ALR1 ; Installation of ALR1 cross-reference 101743 "RTN","C0CLA7DD", 52,0)101744 ; 101745 "RTN","C0CLA7DD", 53,0)101755 "RTN","C0CLA7DD",66,0) 101756 ; 101757 "RTN","C0CLA7DD",67,0) 101746 101758 N C0CFLAG,C0CXR,C0CRES,C0COUT 101747 "RTN","C0CLA7DD", 54,0)101748 ; 101749 "RTN","C0CLA7DD", 55,0)101759 "RTN","C0CLA7DD",68,0) 101760 ; 101761 "RTN","C0CLA7DD",69,0) 101750 101762 S C0CFLAG="" 101751 "RTN","C0CLA7DD", 56,0)101752 ; 101753 "RTN","C0CLA7DD", 57,0)101763 "RTN","C0CLA7DD",70,0) 101764 ; 101765 "RTN","C0CLA7DD",71,0) 101754 101766 S C0CXR("FILE")=9000010.09 101755 "RTN","C0CLA7DD", 58,0)101767 "RTN","C0CLA7DD",72,0) 101756 101768 S C0CXR("NAME")="ALR1" 101757 "RTN","C0CLA7DD", 59,0)101769 "RTN","C0CLA7DD",73,0) 101758 101770 S C0CXR("TYPE")="R" 101759 "RTN","C0CLA7DD", 60,0)101771 "RTN","C0CLA7DD",74,0) 101760 101772 S C0CXR("USE")="S" 101761 "RTN","C0CLA7DD", 61,0)101773 "RTN","C0CLA7DD",75,0) 101762 101774 S C0CXR("EXECUTION")="R" 101763 "RTN","C0CLA7DD", 62,0)101775 "RTN","C0CLA7DD",76,0) 101764 101776 S C0CXR("ACTIVITY")="IR" 101765 "RTN","C0CLA7DD", 63,0)101777 "RTN","C0CLA7DD",77,0) 101766 101778 S C0CXR("SHORT DESCR")="X-ref to link entry with parent in LAB DATA file (#63)" 101767 "RTN","C0CLA7DD", 64,0)101779 "RTN","C0CLA7DD",78,0) 101768 101780 S C0CXR("VAL",1)=.02 101769 "RTN","C0CLA7DD", 65,0)101781 "RTN","C0CLA7DD",79,0) 101770 101782 S C0CXR("VAL",1,"SUBSCRIPT")=1 101771 "RTN","C0CLA7DD", 66,0)101783 "RTN","C0CLA7DD",80,0) 101772 101784 S C0CXR("VAL",1,"COLLATION")="F" 101773 "RTN","C0CLA7DD", 67,0)101785 "RTN","C0CLA7DD",81,0) 101774 101786 S C0CXR("VAL",2)=.06 101775 "RTN","C0CLA7DD", 68,0)101787 "RTN","C0CLA7DD",82,0) 101776 101788 S C0CXR("VAL",2,"SUBSCRIPT")=2 101777 "RTN","C0CLA7DD", 69,0)101789 "RTN","C0CLA7DD",83,0) 101778 101790 S C0CXR("VAL",2,"LENGTH")=30 101779 "RTN","C0CLA7DD", 70,0)101791 "RTN","C0CLA7DD",84,0) 101780 101792 S C0CXR("VAL",2,"COLLATION")="F" 101781 "RTN","C0CLA7DD", 71,0)101793 "RTN","C0CLA7DD",85,0) 101782 101794 S C0CXR("VAL",3)=.01 101783 "RTN","C0CLA7DD", 72,0)101795 "RTN","C0CLA7DD",86,0) 101784 101796 S C0CXR("VAL",3,"SUBSCRIPT")=3 101785 "RTN","C0CLA7DD", 73,0)101797 "RTN","C0CLA7DD",87,0) 101786 101798 S C0CXR("VAL",3,"COLLATION")="F" 101787 "RTN","C0CLA7DD", 74,0)101799 "RTN","C0CLA7DD",88,0) 101788 101800 S C0CXR("VAL",4)=1201 101789 "RTN","C0CLA7DD", 75,0)101801 "RTN","C0CLA7DD",89,0) 101790 101802 S C0CXR("VAL",4,"SUBSCRIPT")=4 101791 "RTN","C0CLA7DD", 76,0)101803 "RTN","C0CLA7DD",90,0) 101792 101804 S C0CXR("VAL",4,"COLLATION")="F" 101793 "RTN","C0CLA7DD", 77,0)101805 "RTN","C0CLA7DD",91,0) 101794 101806 D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT") 101795 "RTN","C0CLA7DD", 78,0)101796 ; 101797 "RTN","C0CLA7DD", 79,0)101807 "RTN","C0CLA7DD",92,0) 101808 ; 101809 "RTN","C0CLA7DD",93,0) 101798 101810 Q 101799 "RTN","C0CLA7DD", 80,0)101800 ; 101801 "RTN","C0CLA7DD", 81,0)101802 ; 101803 "RTN","C0CLA7DD", 82,0)101811 "RTN","C0CLA7DD",94,0) 101812 ; 101813 "RTN","C0CLA7DD",95,0) 101814 ; 101815 "RTN","C0CLA7DD",96,0) 101804 101816 ALR2 ; Installation of ALR2 cross-reference 101805 "RTN","C0CLA7DD", 83,0)101806 ; 101807 "RTN","C0CLA7DD", 84,0)101817 "RTN","C0CLA7DD",97,0) 101818 ; 101819 "RTN","C0CLA7DD",98,0) 101808 101820 N C0CFLAG,C0CXR,C0CRES,C0COUT 101809 "RTN","C0CLA7DD", 85,0)101810 ; 101811 "RTN","C0CLA7DD", 86,0)101821 "RTN","C0CLA7DD",99,0) 101822 ; 101823 "RTN","C0CLA7DD",100,0) 101812 101824 S C0CFLAG="" 101813 "RTN","C0CLA7DD", 87,0)101814 ; 101815 "RTN","C0CLA7DD", 88,0)101825 "RTN","C0CLA7DD",101,0) 101826 ; 101827 "RTN","C0CLA7DD",102,0) 101816 101828 S C0CXR("FILE")=9000010.09 101817 "RTN","C0CLA7DD", 89,0)101829 "RTN","C0CLA7DD",103,0) 101818 101830 S C0CXR("NAME")="ALR2" 101819 "RTN","C0CLA7DD", 90,0)101831 "RTN","C0CLA7DD",104,0) 101820 101832 S C0CXR("TYPE")="MU" 101821 "RTN","C0CLA7DD", 91,0)101833 "RTN","C0CLA7DD",105,0) 101822 101834 S C0CXR("USE")="S" 101823 "RTN","C0CLA7DD", 92,0)101835 "RTN","C0CLA7DD",106,0) 101824 101836 S C0CXR("EXECUTION")="R" 101825 "RTN","C0CLA7DD", 93,0)101837 "RTN","C0CLA7DD",107,0) 101826 101838 S C0CXR("ACTIVITY")="IR" 101827 "RTN","C0CLA7DD", 94,0)101839 "RTN","C0CLA7DD",108,0) 101828 101840 S C0CXR("SHORT DESCR")="X-ref for LOINC code related to test result." 101829 "RTN","C0CLA7DD", 95,0)101841 "RTN","C0CLA7DD",109,0) 101830 101842 S C0CXR("DESCR",1)="This cross-reference is used to identify the LOINC codes" 101831 "RTN","C0CLA7DD", 96,0)101843 "RTN","C0CLA7DD",110,0) 101832 101844 S C0CXR("DESCR",2)="that has been assigned to a lab result. Allows queries to" 101833 "RTN","C0CLA7DD", 97,0)101845 "RTN","C0CLA7DD",111,0) 101834 101846 S C0CXR("DESCR",3)="retrieve the LOINC code associated with a specific test" 101835 "RTN","C0CLA7DD", 98,0)101847 "RTN","C0CLA7DD",112,0) 101836 101848 S C0CXR("DESCR",4)="result." 101837 "RTN","C0CLA7DD", 99,0)101849 "RTN","C0CLA7DD",113,0) 101838 101850 S C0CXR("SET")="S ^AUPNVLAB(""ALR2"",X(1),X(2),X(3),X(4),X(5),DA)=""""" 101839 "RTN","C0CLA7DD",1 00,0)101851 "RTN","C0CLA7DD",114,0) 101840 101852 S C0CXR("KILL")="K ^AUPNVLAB(""ALR2"",X(1),X(2),X(3),X(4),X(5),DA)" 101841 "RTN","C0CLA7DD",1 01,0)101853 "RTN","C0CLA7DD",115,0) 101842 101854 S C0CXR("WHOLE KILL")="K ^AUPNVLAB(""ALR2"")" 101843 "RTN","C0CLA7DD",1 02,0)101855 "RTN","C0CLA7DD",116,0) 101844 101856 S C0CXR("VAL",1)=.02 101845 "RTN","C0CLA7DD",1 03,0)101857 "RTN","C0CLA7DD",117,0) 101846 101858 S C0CXR("VAL",1,"SUBSCRIPT")=1 101847 "RTN","C0CLA7DD",1 04,0)101859 "RTN","C0CLA7DD",118,0) 101848 101860 S C0CXR("VAL",1,"COLLATION")="F" 101849 "RTN","C0CLA7DD",1 05,0)101861 "RTN","C0CLA7DD",119,0) 101850 101862 S C0CXR("VAL",2)=1201 101851 "RTN","C0CLA7DD",1 06,0)101863 "RTN","C0CLA7DD",120,0) 101852 101864 S C0CXR("VAL",2,"SUBSCRIPT")=2 101853 "RTN","C0CLA7DD",1 07,0)101865 "RTN","C0CLA7DD",121,0) 101854 101866 S C0CXR("VAL",2,"COLLATION")="F" 101855 "RTN","C0CLA7DD",1 08,0)101867 "RTN","C0CLA7DD",122,0) 101856 101868 S C0CXR("VAL",3)=.06 101857 "RTN","C0CLA7DD",1 09,0)101869 "RTN","C0CLA7DD",123,0) 101858 101870 S C0CXR("VAL",3,"SUBSCRIPT")=3 101859 "RTN","C0CLA7DD",1 10,0)101871 "RTN","C0CLA7DD",124,0) 101860 101872 S C0CXR("VAL",3,"COLLATION")="F" 101861 "RTN","C0CLA7DD",1 11,0)101873 "RTN","C0CLA7DD",125,0) 101862 101874 S C0CXR("VAL",4)=.01 101863 "RTN","C0CLA7DD",1 12,0)101875 "RTN","C0CLA7DD",126,0) 101864 101876 S C0CXR("VAL",4,"SUBSCRIPT")=4 101865 "RTN","C0CLA7DD",1 13,0)101877 "RTN","C0CLA7DD",127,0) 101866 101878 S C0CXR("VAL",4,"COLLATION")="F" 101867 "RTN","C0CLA7DD",1 14,0)101879 "RTN","C0CLA7DD",128,0) 101868 101880 S C0CXR("VAL",5)=1113 101869 "RTN","C0CLA7DD",1 15,0)101881 "RTN","C0CLA7DD",129,0) 101870 101882 S C0CXR("VAL",5,"SUBSCRIPT")=5 101871 "RTN","C0CLA7DD",1 16,0)101883 "RTN","C0CLA7DD",130,0) 101872 101884 S C0CXR("VAL",5,"COLLATION")="F" 101873 "RTN","C0CLA7DD",1 17,0)101885 "RTN","C0CLA7DD",131,0) 101874 101886 D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT") 101875 "RTN","C0CLA7DD",1 18,0)101876 ; 101877 "RTN","C0CLA7DD",1 19,0)101887 "RTN","C0CLA7DD",132,0) 101888 ; 101889 "RTN","C0CLA7DD",133,0) 101878 101890 Q 101879 "RTN","C0CLA7DD",1 20,0)101880 ; 101881 "RTN","C0CLA7DD",1 21,0)101882 ; 101883 "RTN","C0CLA7DD",1 22,0)101891 "RTN","C0CLA7DD",134,0) 101892 ; 101893 "RTN","C0CLA7DD",135,0) 101894 ; 101895 "RTN","C0CLA7DD",136,0) 101884 101896 ALR3 ; Installation of ALR3 cross-reference 101885 "RTN","C0CLA7DD",1 23,0)101886 ; 101887 "RTN","C0CLA7DD",1 24,0)101897 "RTN","C0CLA7DD",137,0) 101898 ; 101899 "RTN","C0CLA7DD",138,0) 101888 101900 N C0CFLAG,C0CXR,C0CRES,C0COUT 101889 "RTN","C0CLA7DD",1 25,0)101890 ; 101891 "RTN","C0CLA7DD",1 26,0)101901 "RTN","C0CLA7DD",139,0) 101902 ; 101903 "RTN","C0CLA7DD",140,0) 101892 101904 S C0CFLAG="" 101893 "RTN","C0CLA7DD",1 27,0)101894 ; 101895 "RTN","C0CLA7DD",1 28,0)101905 "RTN","C0CLA7DD",141,0) 101906 ; 101907 "RTN","C0CLA7DD",142,0) 101896 101908 S C0CXR("FILE")=9000010.09 101897 "RTN","C0CLA7DD",1 29,0)101909 "RTN","C0CLA7DD",143,0) 101898 101910 S C0CXR("NAME")="ALR3" 101899 "RTN","C0CLA7DD",1 30,0)101911 "RTN","C0CLA7DD",144,0) 101900 101912 S C0CXR("TYPE")="R" 101901 "RTN","C0CLA7DD",1 31,0)101913 "RTN","C0CLA7DD",145,0) 101902 101914 S C0CXR("USE")="S" 101903 "RTN","C0CLA7DD",1 32,0)101915 "RTN","C0CLA7DD",146,0) 101904 101916 S C0CXR("EXECUTION")="F" 101905 "RTN","C0CLA7DD",1 33,0)101917 "RTN","C0CLA7DD",147,0) 101906 101918 S C0CXR("ACTIVITY")="IR" 101907 "RTN","C0CLA7DD",1 34,0)101919 "RTN","C0CLA7DD",148,0) 101908 101920 S C0CXR("SHORT DESCR")="X-ref for LOINC code related to test result - any patient" 101909 "RTN","C0CLA7DD",1 35,0)101921 "RTN","C0CLA7DD",149,0) 101910 101922 S C0CXR("DESCR",1)="This cross-reference is used to identify the LOINC codes that has been assigned to a lab result. Allows queries" 101911 "RTN","C0CLA7DD",1 36,0)101923 "RTN","C0CLA7DD",150,0) 101912 101924 S C0CXR("DESCR",2)="to retrieve the LOINC code associated with a specific test result. It allows any patient" 101913 "RTN","C0CLA7DD",1 37,0)101925 "RTN","C0CLA7DD",151,0) 101914 101926 S C0CXR("DESCR",3)="lab results to be identified by LOINC" 101915 "RTN","C0CLA7DD",1 38,0)101927 "RTN","C0CLA7DD",152,0) 101916 101928 S C0CXR("VAL",1)=1113 101917 "RTN","C0CLA7DD",1 39,0)101929 "RTN","C0CLA7DD",153,0) 101918 101930 S C0CXR("VAL",1,"SUBSCRIPT")=1 101919 "RTN","C0CLA7DD",1 40,0)101931 "RTN","C0CLA7DD",154,0) 101920 101932 S C0CXR("VAL",1,"COLLATION")="F" 101921 "RTN","C0CLA7DD",1 41,0)101922 ; 101923 "RTN","C0CLA7DD",1 42,0)101933 "RTN","C0CLA7DD",155,0) 101934 ; 101935 "RTN","C0CLA7DD",156,0) 101924 101936 D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT") 101925 "RTN","C0CLA7DD",1 43,0)101926 ; 101927 "RTN","C0CLA7DD",1 44,0)101937 "RTN","C0CLA7DD",157,0) 101938 ; 101939 "RTN","C0CLA7DD",158,0) 101928 101940 Q 101929 "RTN","C0CLA7DD",1 45,0)101930 ; 101931 "RTN","C0CLA7DD",1 46,0)101932 ; 101933 "RTN","C0CLA7DD",1 47,0)101941 "RTN","C0CLA7DD",159,0) 101942 ; 101943 "RTN","C0CLA7DD",160,0) 101944 ; 101945 "RTN","C0CLA7DD",161,0) 101934 101946 ALR4 ; Installation of ALR4 cross-reference 101935 "RTN","C0CLA7DD",1 48,0)101936 ; 101937 "RTN","C0CLA7DD",1 49,0)101947 "RTN","C0CLA7DD",162,0) 101948 ; 101949 "RTN","C0CLA7DD",163,0) 101938 101950 N C0CFLAG,C0CXR,C0CRES,C0COUT 101939 "RTN","C0CLA7DD",1 50,0)101940 ; 101941 "RTN","C0CLA7DD",1 51,0)101951 "RTN","C0CLA7DD",164,0) 101952 ; 101953 "RTN","C0CLA7DD",165,0) 101942 101954 S C0CFLAG="" 101943 "RTN","C0CLA7DD",1 52,0)101944 ; 101945 "RTN","C0CLA7DD",1 53,0)101955 "RTN","C0CLA7DD",166,0) 101956 ; 101957 "RTN","C0CLA7DD",167,0) 101946 101958 S C0CXR("FILE")=9000010.09 101947 "RTN","C0CLA7DD",1 54,0)101959 "RTN","C0CLA7DD",168,0) 101948 101960 S C0CXR("NAME")="ALR4" 101949 "RTN","C0CLA7DD",1 55,0)101961 "RTN","C0CLA7DD",169,0) 101950 101962 S C0CXR("TYPE")="R" 101951 "RTN","C0CLA7DD",1 56,0)101963 "RTN","C0CLA7DD",170,0) 101952 101964 S C0CXR("USE")="S" 101953 "RTN","C0CLA7DD",1 57,0)101965 "RTN","C0CLA7DD",171,0) 101954 101966 S C0CXR("EXECUTION")="R" 101955 "RTN","C0CLA7DD",1 58,0)101967 "RTN","C0CLA7DD",172,0) 101956 101968 S C0CXR("ACTIVITY")="IR" 101957 "RTN","C0CLA7DD",1 59,0)101969 "RTN","C0CLA7DD",173,0) 101958 101970 S C0CXR("SHORT DESCR")="X-ref by patient and collection date/time" 101959 "RTN","C0CLA7DD",1 60,0)101971 "RTN","C0CLA7DD",174,0) 101960 101972 S C0CXR("DESCR",1)="This cross-reference is used to identify all lab results for a" 101961 "RTN","C0CLA7DD",1 61,0)101973 "RTN","C0CLA7DD",175,0) 101962 101974 S C0CXR("DESCR",2)="patient by collection date/time. This includes results that are only in" 101963 "RTN","C0CLA7DD",1 62,0)101975 "RTN","C0CLA7DD",176,0) 101964 101976 S C0CXR("DESCR",3)="this file and therefore do not have a corresponding entry in LAB DATA" 101965 "RTN","C0CLA7DD",1 63,0)101977 "RTN","C0CLA7DD",177,0) 101966 101978 S C0CXR("DESCR",4)="file (#63)." 101967 "RTN","C0CLA7DD",1 64,0)101979 "RTN","C0CLA7DD",178,0) 101968 101980 S C0CXR("VAL",1)=.02 101969 "RTN","C0CLA7DD",1 65,0)101981 "RTN","C0CLA7DD",179,0) 101970 101982 S C0CXR("VAL",1,"SUBSCRIPT")=1 101971 "RTN","C0CLA7DD",1 66,0)101983 "RTN","C0CLA7DD",180,0) 101972 101984 S C0CXR("VAL",1,"COLLATION")="F" 101973 "RTN","C0CLA7DD",1 67,0)101985 "RTN","C0CLA7DD",181,0) 101974 101986 S C0CXR("VAL",2)=1201 101975 "RTN","C0CLA7DD",1 68,0)101987 "RTN","C0CLA7DD",182,0) 101976 101988 S C0CXR("VAL",2,"SUBSCRIPT")=2 101977 "RTN","C0CLA7DD",1 69,0)101989 "RTN","C0CLA7DD",183,0) 101978 101990 S C0CXR("VAL",2,"COLLATION")="F" 101979 "RTN","C0CLA7DD",1 70,0)101980 ; 101981 "RTN","C0CLA7DD",1 71,0)101991 "RTN","C0CLA7DD",184,0) 101992 ; 101993 "RTN","C0CLA7DD",185,0) 101982 101994 D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT") 101983 "RTN","C0CLA7DD",1 72,0)101984 ; 101985 "RTN","C0CLA7DD",1 73,0)101995 "RTN","C0CLA7DD",186,0) 101996 ; 101997 "RTN","C0CLA7DD",187,0) 101986 101998 Q 101987 "RTN","C0CLA7DD",1 74,0)101988 ; 101989 "RTN","C0CLA7DD",1 75,0)101990 ; 101991 "RTN","C0CLA7DD",1 76,0)101999 "RTN","C0CLA7DD",188,0) 102000 ; 102001 "RTN","C0CLA7DD",189,0) 102002 ; 102003 "RTN","C0CLA7DD",190,0) 101992 102004 ALR5 ; Installation of ALR5 cross-reference 101993 "RTN","C0CLA7DD",1 77,0)101994 ; 101995 "RTN","C0CLA7DD",1 78,0)102005 "RTN","C0CLA7DD",191,0) 102006 ; 102007 "RTN","C0CLA7DD",192,0) 101996 102008 N C0CFLAG,C0CXR,C0CRES,C0COUT 101997 "RTN","C0CLA7DD",1 79,0)101998 ; 101999 "RTN","C0CLA7DD",1 80,0)102009 "RTN","C0CLA7DD",193,0) 102010 ; 102011 "RTN","C0CLA7DD",194,0) 102000 102012 S C0CFLAG="" 102001 "RTN","C0CLA7DD",1 81,0)102002 ; 102003 "RTN","C0CLA7DD",1 82,0)102013 "RTN","C0CLA7DD",195,0) 102014 ; 102015 "RTN","C0CLA7DD",196,0) 102004 102016 S C0CXR("FILE")=9000010.09 102005 "RTN","C0CLA7DD",1 83,0)102017 "RTN","C0CLA7DD",197,0) 102006 102018 S C0CXR("NAME")="ALR5" 102007 "RTN","C0CLA7DD",1 84,0)102019 "RTN","C0CLA7DD",198,0) 102008 102020 S C0CXR("TYPE")="R" 102009 "RTN","C0CLA7DD",1 85,0)102021 "RTN","C0CLA7DD",199,0) 102010 102022 S C0CXR("USE")="S" 102011 "RTN","C0CLA7DD", 186,0)102023 "RTN","C0CLA7DD",200,0) 102012 102024 S C0CXR("EXECUTION")="R" 102013 "RTN","C0CLA7DD", 187,0)102025 "RTN","C0CLA7DD",201,0) 102014 102026 S C0CXR("ACTIVITY")="IR" 102015 "RTN","C0CLA7DD", 188,0)102027 "RTN","C0CLA7DD",202,0) 102016 102028 S C0CXR("SHORT DESCR")="X-ref by patient and results availble date/time" 102017 "RTN","C0CLA7DD", 189,0)102029 "RTN","C0CLA7DD",203,0) 102018 102030 S C0CXR("DESCR",1)="This cross-reference is used to identify all lab results for a" 102019 "RTN","C0CLA7DD", 190,0)102031 "RTN","C0CLA7DD",204,0) 102020 102032 S C0CXR("DESCR",2)="patient by results available date/time. This includes results that are only in" 102021 "RTN","C0CLA7DD", 191,0)102033 "RTN","C0CLA7DD",205,0) 102022 102034 S C0CXR("DESCR",3)="this file and therefore do not have a corresponding entry in LAB DATA" 102023 "RTN","C0CLA7DD", 192,0)102035 "RTN","C0CLA7DD",206,0) 102024 102036 S C0CXR("DESCR",4)="file (#63)." 102025 "RTN","C0CLA7DD", 193,0)102037 "RTN","C0CLA7DD",207,0) 102026 102038 S C0CXR("VAL",1)=.02 102027 "RTN","C0CLA7DD", 194,0)102039 "RTN","C0CLA7DD",208,0) 102028 102040 S C0CXR("VAL",1,"SUBSCRIPT")=1 102029 "RTN","C0CLA7DD", 195,0)102041 "RTN","C0CLA7DD",209,0) 102030 102042 S C0CXR("VAL",1,"COLLATION")="F" 102031 "RTN","C0CLA7DD", 196,0)102043 "RTN","C0CLA7DD",210,0) 102032 102044 S C0CXR("VAL",2)=1212 102033 "RTN","C0CLA7DD", 197,0)102045 "RTN","C0CLA7DD",211,0) 102034 102046 S C0CXR("VAL",2,"SUBSCRIPT")=2 102035 "RTN","C0CLA7DD", 198,0)102047 "RTN","C0CLA7DD",212,0) 102036 102048 S C0CXR("VAL",2,"COLLATION")="F" 102037 "RTN","C0CLA7DD", 199,0)102038 ; 102039 "RTN","C0CLA7DD",2 00,0)102049 "RTN","C0CLA7DD",213,0) 102050 ; 102051 "RTN","C0CLA7DD",214,0) 102040 102052 D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT") 102041 "RTN","C0CLA7DD",2 01,0)102042 ; 102043 "RTN","C0CLA7DD",2 02,0)102053 "RTN","C0CLA7DD",215,0) 102054 ; 102055 "RTN","C0CLA7DD",216,0) 102044 102056 Q 102045 "RTN","C0CLA7DD",2 03,0)102046 ; 102047 "RTN","C0CLA7DD",2 04,0)102048 ; 102049 "RTN","C0CLA7DD",2 05,0)102057 "RTN","C0CLA7DD",217,0) 102058 ; 102059 "RTN","C0CLA7DD",218,0) 102060 ; 102061 "RTN","C0CLA7DD",219,0) 102050 102062 REINDEX ; Set data into indexes for current entries. 102051 "RTN","C0CLA7DD",2 06,0)102052 ; 102053 "RTN","C0CLA7DD",2 07,0)102054 ; 102055 "RTN","C0CLA7DD",2 08,0)102063 "RTN","C0CLA7DD",220,0) 102064 ; 102065 "RTN","C0CLA7DD",221,0) 102066 ; 102067 "RTN","C0CLA7DD",222,0) 102056 102068 N C0CHLOG,DA,DIK,MSG 102057 "RTN","C0CLA7DD",2 09,0)102058 ; 102059 "RTN","C0CLA7DD",2 10,0)102069 "RTN","C0CLA7DD",223,0) 102070 ; 102071 "RTN","C0CLA7DD",224,0) 102060 102072 S C0CHLOG("START")=$H 102061 "RTN","C0CLA7DD",2 11,0)102073 "RTN","C0CLA7DD",225,0) 102062 102074 S MSG="Starting indexing of ALR1, ALR2, ALR4, ALR5 indexes - "_$$HTE^XLFDT(C0CHLOG("START"),"1Z") 102063 "RTN","C0CLA7DD",2 12,0)102075 "RTN","C0CLA7DD",226,0) 102064 102076 D BMES(MSG),SENDXQA(MSG) 102065 "RTN","C0CLA7DD",2 13,0)102066 ; 102067 "RTN","C0CLA7DD",2 14,0)102077 "RTN","C0CLA7DD",227,0) 102078 ; 102079 "RTN","C0CLA7DD",228,0) 102068 102080 S DIK="^AUPNVLAB(" 102069 "RTN","C0CLA7DD",2 15,0)102081 "RTN","C0CLA7DD",229,0) 102070 102082 S DIK(1)=".02^ALR1^ALR2^ALR4^ALR5" 102071 "RTN","C0CLA7DD",2 16,0)102083 "RTN","C0CLA7DD",230,0) 102072 102084 D ENALL^DIK 102073 "RTN","C0CLA7DD",2 17,0)102074 ; 102075 "RTN","C0CLA7DD",2 18,0)102085 "RTN","C0CLA7DD",231,0) 102086 ; 102087 "RTN","C0CLA7DD",232,0) 102076 102088 S C0CHLOG("END")=$H 102077 "RTN","C0CLA7DD",2 19,0)102089 "RTN","C0CLA7DD",233,0) 102078 102090 S MSG="Finished indexing of ALR1, ALR2, ALR4, ALR5 indexes - "_$$HTE^XLFDT(C0CHLOG("END"),"1Z") 102079 "RTN","C0CLA7DD",2 20,0)102091 "RTN","C0CLA7DD",234,0) 102080 102092 D BMES(MSG),SENDXQA(MSG) 102081 "RTN","C0CLA7DD",2 21,0)102082 ; 102083 "RTN","C0CLA7DD",2 22,0)102093 "RTN","C0CLA7DD",235,0) 102094 ; 102095 "RTN","C0CLA7DD",236,0) 102084 102096 S MSG="Elapsed Time: "_$$HDIFF^XLFDT(C0CHLOG("END"),C0CHLOG("START"),3) 102085 "RTN","C0CLA7DD",2 23,0)102097 "RTN","C0CLA7DD",237,0) 102086 102098 D BMES(MSG) 102087 "RTN","C0CLA7DD",2 24,0)102088 ; 102089 "RTN","C0CLA7DD",2 25,0)102099 "RTN","C0CLA7DD",238,0) 102100 ; 102101 "RTN","C0CLA7DD",239,0) 102090 102102 S C0CHLOG("START")=$H 102091 "RTN","C0CLA7DD",2 26,0)102103 "RTN","C0CLA7DD",240,0) 102092 102104 S MSG="Starting indexing of ALR3 index - "_$$HTE^XLFDT(C0CHLOG("START"),"1Z") 102093 "RTN","C0CLA7DD",2 27,0)102105 "RTN","C0CLA7DD",241,0) 102094 102106 D BMES(MSG),SENDXQA(MSG) 102095 "RTN","C0CLA7DD",2 28,0)102096 ; 102097 "RTN","C0CLA7DD",2 29,0)102107 "RTN","C0CLA7DD",242,0) 102108 ; 102109 "RTN","C0CLA7DD",243,0) 102098 102110 K DA,DIK 102099 "RTN","C0CLA7DD",2 30,0)102111 "RTN","C0CLA7DD",244,0) 102100 102112 S DIK="^AUPNVLAB(" 102101 "RTN","C0CLA7DD",2 31,0)102113 "RTN","C0CLA7DD",245,0) 102102 102114 S DIK(1)="1113^ALR3" 102103 "RTN","C0CLA7DD",2 32,0)102115 "RTN","C0CLA7DD",246,0) 102104 102116 D ENALL^DIK 102105 "RTN","C0CLA7DD",2 33,0)102106 ; 102107 "RTN","C0CLA7DD",2 34,0)102117 "RTN","C0CLA7DD",247,0) 102118 ; 102119 "RTN","C0CLA7DD",248,0) 102108 102120 S C0CHLOG("END")=$H 102109 "RTN","C0CLA7DD",2 35,0)102121 "RTN","C0CLA7DD",249,0) 102110 102122 S MSG="Finished indexing of ALR3 index - "_$$HTE^XLFDT(C0CHLOG("END"),"1Z") 102111 "RTN","C0CLA7DD",2 36,0)102123 "RTN","C0CLA7DD",250,0) 102112 102124 D BMES(MSG),SENDXQA(MSG) 102113 "RTN","C0CLA7DD",2 37,0)102114 ; 102115 "RTN","C0CLA7DD",2 38,0)102125 "RTN","C0CLA7DD",251,0) 102126 ; 102127 "RTN","C0CLA7DD",252,0) 102116 102128 S MSG="Elapsed Time: "_$$HDIFF^XLFDT(C0CHLOG("END"),C0CHLOG("START"),3) 102117 "RTN","C0CLA7DD",2 39,0)102129 "RTN","C0CLA7DD",253,0) 102118 102130 D BMES(MSG) 102119 "RTN","C0CLA7DD",2 40,0)102120 ; 102121 "RTN","C0CLA7DD",2 41,0)102131 "RTN","C0CLA7DD",254,0) 102132 ; 102133 "RTN","C0CLA7DD",255,0) 102122 102134 Q 102123 "RTN","C0CLA7DD",2 42,0)102124 ; 102125 "RTN","C0CLA7DD",2 43,0)102126 ; 102127 "RTN","C0CLA7DD",2 44,0)102135 "RTN","C0CLA7DD",256,0) 102136 ; 102137 "RTN","C0CLA7DD",257,0) 102138 ; 102139 "RTN","C0CLA7DD",258,0) 102128 102140 BMES(STR) ; Write BMES^XPDUTL statements 102129 "RTN","C0CLA7DD",2 45,0)102130 ; 102131 "RTN","C0CLA7DD",2 46,0)102141 "RTN","C0CLA7DD",259,0) 102142 ; 102143 "RTN","C0CLA7DD",260,0) 102132 102144 D BMES^XPDUTL($$CJ^XLFSTR(STR,IOM)) 102133 "RTN","C0CLA7DD",2 47,0)102134 ; 102135 "RTN","C0CLA7DD",2 48,0)102145 "RTN","C0CLA7DD",261,0) 102146 ; 102147 "RTN","C0CLA7DD",262,0) 102136 102148 Q 102137 "RTN","C0CLA7DD",2 49,0)102138 ; 102139 "RTN","C0CLA7DD",2 50,0)102140 ; 102141 "RTN","C0CLA7DD",2 51,0)102149 "RTN","C0CLA7DD",263,0) 102150 ; 102151 "RTN","C0CLA7DD",264,0) 102152 ; 102153 "RTN","C0CLA7DD",265,0) 102142 102154 SENDXQA(MSG) ; Send alert for reindex status 102143 "RTN","C0CLA7DD",2 52,0)102144 ; 102145 "RTN","C0CLA7DD",2 53,0)102155 "RTN","C0CLA7DD",266,0) 102156 ; 102157 "RTN","C0CLA7DD",267,0) 102146 102158 N XQA,XQAMSG 102147 "RTN","C0CLA7DD",2 54,0)102148 ; 102149 "RTN","C0CLA7DD",2 55,0)102159 "RTN","C0CLA7DD",268,0) 102160 ; 102161 "RTN","C0CLA7DD",269,0) 102150 102162 S XQA(DUZ)="" 102151 "RTN","C0CLA7DD",2 56,0)102163 "RTN","C0CLA7DD",270,0) 102152 102164 S XQAMSG=MSG 102153 "RTN","C0CLA7DD",2 57,0)102165 "RTN","C0CLA7DD",271,0) 102154 102166 D SETUP^XQALERT 102155 "RTN","C0CLA7DD",2 58,0)102156 ; 102157 "RTN","C0CLA7DD",2 59,0)102167 "RTN","C0CLA7DD",272,0) 102168 ; 102169 "RTN","C0CLA7DD",273,0) 102158 102170 Q 102159 102171 "RTN","C0CLA7Q") 102160 0^62^B2 1818572102172 0^62^B24672517 102161 102173 "RTN","C0CLA7Q",1,0) 102162 C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Jul 6, 2009 102174 C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Jul 6, 2009 ; 10/30/12 10:16am 102163 102175 "RTN","C0CLA7Q",2,0) 102164 ;;1.2;C 0C;;May 11, 2012;Build 50102176 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 102165 102177 "RTN","C0CLA7Q",3,0) 102166 102178 ; 102167 102179 "RTN","C0CLA7Q",4,0) 102168 ; 102180 ; (C) 2009 John McCormack 102169 102181 "RTN","C0CLA7Q",5,0) 102182 ; 102183 "RTN","C0CLA7Q",6,0) 102184 ; This program is free software: you can redistribute it and/or modify 102185 "RTN","C0CLA7Q",7,0) 102186 ; it under the terms of the GNU Affero General Public License as 102187 "RTN","C0CLA7Q",8,0) 102188 ; published by the Free Software Foundation, either version 3 of the 102189 "RTN","C0CLA7Q",9,0) 102190 ; License, or (at your option) any later version. 102191 "RTN","C0CLA7Q",10,0) 102192 ; 102193 "RTN","C0CLA7Q",11,0) 102194 ; This program is distributed in the hope that it will be useful, 102195 "RTN","C0CLA7Q",12,0) 102196 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 102197 "RTN","C0CLA7Q",13,0) 102198 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 102199 "RTN","C0CLA7Q",14,0) 102200 ; GNU Affero General Public License for more details. 102201 "RTN","C0CLA7Q",15,0) 102202 ; 102203 "RTN","C0CLA7Q",16,0) 102204 ; You should have received a copy of the GNU Affero General Public License 102205 "RTN","C0CLA7Q",17,0) 102206 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 102207 "RTN","C0CLA7Q",18,0) 102208 ; 102209 "RTN","C0CLA7Q",19,0) 102210 ; 102211 "RTN","C0CLA7Q",20,0) 102170 102212 Q 102171 "RTN","C0CLA7Q", 6,0)102172 ; 102173 "RTN","C0CLA7Q", 7,0)102174 ; 102175 "RTN","C0CLA7Q", 8,0)102213 "RTN","C0CLA7Q",21,0) 102214 ; 102215 "RTN","C0CLA7Q",22,0) 102216 ; 102217 "RTN","C0CLA7Q",23,0) 102176 102218 LAB(C0CPTID,C0CSDT,C0CEDT,C0CSC,C0CSPEC,C0CERR,C0CDEST,C0CHL7) ; Entry point for Lab Result Query 102177 "RTN","C0CLA7Q", 9,0)102178 ; 102179 "RTN","C0CLA7Q", 10,0)102180 ; 102181 "RTN","C0CLA7Q", 11,0)102219 "RTN","C0CLA7Q",24,0) 102220 ; 102221 "RTN","C0CLA7Q",25,0) 102222 ; 102223 "RTN","C0CLA7Q",26,0) 102182 102224 K ^TMP("C0C-VLAB",$J) 102183 "RTN","C0CLA7Q", 12,0)102184 ; 102185 "RTN","C0CLA7Q", 13,0)102225 "RTN","C0CLA7Q",27,0) 102226 ; 102227 "RTN","C0CLA7Q",28,0) 102186 102228 ; Check and retrieve lab results from LAB DATA file (#63) 102187 "RTN","C0CLA7Q", 14,0)102229 "RTN","C0CLA7Q",29,0) 102188 102230 S C0CDEST=$$GCPR^LA7QRY($G(C0CPTID),$G(C0CSDT),$G(C0CEDT),.C0CSC,.C0CSPEC,.C0CERR,$G(C0CDEST),$G(C0CHL7)) 102189 "RTN","C0CLA7Q", 15,0)102190 ; 102191 "RTN","C0CLA7Q", 16,0)102231 "RTN","C0CLA7Q",30,0) 102232 ; 102233 "RTN","C0CLA7Q",31,0) 102192 102234 ; If V LAB file present then check for lab results that are only in this file 102193 "RTN","C0CLA7Q", 17,0)102235 "RTN","C0CLA7Q",32,0) 102194 102236 ; If results found in V Lab file then build results and add to above results. 102195 "RTN","C0CLA7Q", 18,0)102237 "RTN","C0CLA7Q",33,0) 102196 102238 I $D(^AUPNVLAB) D 102197 "RTN","C0CLA7Q", 19,0)102239 "RTN","C0CLA7Q",34,0) 102198 102240 . D VCHECK 102199 "RTN","C0CLA7Q", 20,0)102241 "RTN","C0CLA7Q",35,0) 102200 102242 . I $D(^TMP("C0C-VLAB",$J,3)) D VBUILD 102201 "RTN","C0CLA7Q", 21,0)102202 ; 102203 "RTN","C0CLA7Q", 22,0)102243 "RTN","C0CLA7Q",36,0) 102244 ; 102245 "RTN","C0CLA7Q",37,0) 102204 102246 ;K ^TMP("C0C-VLAB",$J) 102205 "RTN","C0CLA7Q", 23,0)102206 ; 102207 "RTN","C0CLA7Q", 24,0)102247 "RTN","C0CLA7Q",38,0) 102248 ; 102249 "RTN","C0CLA7Q",39,0) 102208 102250 Q C0CDEST 102209 "RTN","C0CLA7Q", 25,0)102210 ; 102211 "RTN","C0CLA7Q", 26,0)102212 ; 102213 "RTN","C0CLA7Q", 27,0)102251 "RTN","C0CLA7Q",40,0) 102252 ; 102253 "RTN","C0CLA7Q",41,0) 102254 ; 102255 "RTN","C0CLA7Q",42,0) 102214 102256 VCHECK ; If V LAB file present then check for lab results that are only in this file. 102215 "RTN","C0CLA7Q", 28,0)102216 ; 102217 "RTN","C0CLA7Q", 29,0)102257 "RTN","C0CLA7Q",43,0) 102258 ; 102259 "RTN","C0CLA7Q",44,0) 102218 102260 N C0CDA,C0CEND,C0CROOT,C0CVLAB,LA7PTID,LA7SC,LA7SCRC,LA7SPEC 102219 "RTN","C0CLA7Q", 30,0)102220 ; 102221 "RTN","C0CLA7Q", 31,0)102261 "RTN","C0CLA7Q",45,0) 102262 ; 102263 "RTN","C0CLA7Q",46,0) 102222 102264 S LA7PTID=C0CPTID 102223 "RTN","C0CLA7Q", 32,0)102265 "RTN","C0CLA7Q",47,0) 102224 102266 D PATID^LA7QRY2 102225 "RTN","C0CLA7Q", 33,0)102267 "RTN","C0CLA7Q",48,0) 102226 102268 I $D(LA7ERR) Q 102227 "RTN","C0CLA7Q", 34,0)102228 ; 102229 "RTN","C0CLA7Q", 35,0)102269 "RTN","C0CLA7Q",49,0) 102270 ; 102271 "RTN","C0CLA7Q",50,0) 102230 102272 ; Resolve search codes to lab datanames 102231 "RTN","C0CLA7Q", 36,0)102273 "RTN","C0CLA7Q",51,0) 102232 102274 S LA7SC=$G(C0CSC) 102233 "RTN","C0CLA7Q", 37,0)102275 "RTN","C0CLA7Q",52,0) 102234 102276 I $T(SCLIST^LA7QRY2)'="" D 102235 "RTN","C0CLA7Q", 38,0)102277 "RTN","C0CLA7Q",53,0) 102236 102278 . N TMP 102237 "RTN","C0CLA7Q", 39,0)102279 "RTN","C0CLA7Q",54,0) 102238 102280 . S LA7SCRC=$G(C0CSC) 102239 "RTN","C0CLA7Q", 40,0)102281 "RTN","C0CLA7Q",55,0) 102240 102282 . S TMP=$$SCLIST^LA7QRY2(LA7SCRC) 102241 "RTN","C0CLA7Q", 41,0)102283 "RTN","C0CLA7Q",56,0) 102242 102284 . S LA7SC=TMP 102243 "RTN","C0CLA7Q", 42,0)102244 ; 102245 "RTN","C0CLA7Q", 43,0)102285 "RTN","C0CLA7Q",57,0) 102286 ; 102287 "RTN","C0CLA7Q",58,0) 102246 102288 I LA7SC'="*" D CHKSC^LA7QRY1 102247 "RTN","C0CLA7Q", 44,0)102248 ; 102249 "RTN","C0CLA7Q", 45,0)102289 "RTN","C0CLA7Q",59,0) 102290 ; 102291 "RTN","C0CLA7Q",60,0) 102250 102292 ; Convert specimen codes to file #61 Topography entries 102251 "RTN","C0CLA7Q", 46,0)102293 "RTN","C0CLA7Q",61,0) 102252 102294 S LA7SPEC=$G(C0CSPEC) 102253 "RTN","C0CLA7Q", 47,0)102295 "RTN","C0CLA7Q",62,0) 102254 102296 I LA7SPEC'="*" D SPEC^LA7QRY1 102255 "RTN","C0CLA7Q", 48,0)102256 ; 102257 "RTN","C0CLA7Q", 49,0)102297 "RTN","C0CLA7Q",63,0) 102298 ; 102299 "RTN","C0CLA7Q",64,0) 102258 102300 S C0CROOT="^AUPNVLAB(""ALR4"",DFN,C0CSDT)",C0CEND=0 102259 "RTN","C0CLA7Q", 50,0)102260 ; 102261 "RTN","C0CLA7Q", 51,0)102301 "RTN","C0CLA7Q",65,0) 102302 ; 102303 "RTN","C0CLA7Q",66,0) 102262 102304 F S C0CROOT=$Q(@C0CROOT) Q:C0CROOT="" D Q:C0CEND 102263 "RTN","C0CLA7Q", 52,0)102305 "RTN","C0CLA7Q",67,0) 102264 102306 . I $QS(C0CROOT,1)'="ALR4"!($QS(C0CROOT,2)'=DFN) S C0CEND=1 Q ; Left x-ref or patient 102265 "RTN","C0CLA7Q", 53,0)102307 "RTN","C0CLA7Q",68,0) 102266 102308 . I $QS(C0CROOT,3)>C0CEDT S C0CEND=1 Q ; Exceeded end date/time 102267 "RTN","C0CLA7Q", 54,0)102309 "RTN","C0CLA7Q",69,0) 102268 102310 . S C0CDA=$QS(C0CROOT,4) 102269 "RTN","C0CLA7Q", 55,0)102311 "RTN","C0CLA7Q",70,0) 102270 102312 . I $D(^TMP("C0C-VLAB",$J,1,C0CDA)) Q ; Already checked during scan of file #63 102271 "RTN","C0CLA7Q", 56,0)102313 "RTN","C0CLA7Q",71,0) 102272 102314 . I $P($G(^AUPNVLAB(C0CDA,11)),"^",8)=1 Q ; Source is LAB DATA file - skip 102273 "RTN","C0CLA7Q", 57,0)102315 "RTN","C0CLA7Q",72,0) 102274 102316 . D VCHK1 102275 "RTN","C0CLA7Q", 58,0)102276 ; 102277 "RTN","C0CLA7Q", 59,0)102278 ; 102279 "RTN","C0CLA7Q", 60,0)102317 "RTN","C0CLA7Q",73,0) 102318 ; 102319 "RTN","C0CLA7Q",74,0) 102320 ; 102321 "RTN","C0CLA7Q",75,0) 102280 102322 Q 102281 "RTN","C0CLA7Q", 61,0)102282 ; 102283 "RTN","C0CLA7Q", 62,0)102284 ; 102285 "RTN","C0CLA7Q", 63,0)102323 "RTN","C0CLA7Q",76,0) 102324 ; 102325 "RTN","C0CLA7Q",77,0) 102326 ; 102327 "RTN","C0CLA7Q",78,0) 102286 102328 VBUILD ; Build results found only in V LAB file into HL7 structure. 102287 "RTN","C0CLA7Q", 64,0)102288 ; 102289 "RTN","C0CLA7Q", 65,0)102290 ; 102291 "RTN","C0CLA7Q", 66,0)102329 "RTN","C0CLA7Q",79,0) 102330 ; 102331 "RTN","C0CLA7Q",80,0) 102332 ; 102333 "RTN","C0CLA7Q",81,0) 102292 102334 Q 102293 "RTN","C0CLA7Q", 67,0)102294 ; 102295 "RTN","C0CLA7Q", 68,0)102296 ; 102297 "RTN","C0CLA7Q", 69,0)102335 "RTN","C0CLA7Q",82,0) 102336 ; 102337 "RTN","C0CLA7Q",83,0) 102338 ; 102339 "RTN","C0CLA7Q",84,0) 102298 102340 LNCHK ; Check for corresponding entry in V LAB file and related LOINC code for a result in file #63. 102299 "RTN","C0CLA7Q", 70,0)102341 "RTN","C0CLA7Q",85,0) 102300 102342 ; Call from LA7QRY2 102301 "RTN","C0CLA7Q", 71,0)102302 ; 102303 "RTN","C0CLA7Q", 72,0)102343 "RTN","C0CLA7Q",86,0) 102344 ; 102345 "RTN","C0CLA7Q",87,0) 102304 102346 N DFN,C0C60,C0C63,C0CACC,C0CDA,C0CDT,C0CLN,C0CPDA,C0CPTEST,C0CSPEC,C0CTEST,X 102305 "RTN","C0CLA7Q", 73,0)102306 ; 102307 "RTN","C0CLA7Q", 74,0)102347 "RTN","C0CLA7Q",88,0) 102348 ; 102349 "RTN","C0CLA7Q",89,0) 102308 102350 S DFN=$P(^LR(LRDFN,0),"^",3) 102309 "RTN","C0CLA7Q", 75,0)102351 "RTN","C0CLA7Q",90,0) 102310 102352 S C0C63(0)=^LR(LRDFN,LRSS,LRIDT,0) 102311 "RTN","C0CLA7Q", 76,0)102353 "RTN","C0CLA7Q",91,0) 102312 102354 S C0CDT=$P(C0C63(0),"^"),C0CACC=$P(C0C63(0),"^",6),C0CSPEC=$P(C0C63(0),"^",5) 102313 "RTN","C0CLA7Q", 77,0)102355 "RTN","C0CLA7Q",92,0) 102314 102356 S (C0CTEST,C0CTEST(64),C0CPTEST,C0CPTEST(64),C0CLN)="" 102315 "RTN","C0CLA7Q", 78,0)102316 ; 102317 "RTN","C0CLA7Q", 79,0)102357 "RTN","C0CLA7Q",93,0) 102358 ; 102359 "RTN","C0CLA7Q",94,0) 102318 102360 ; ^AUPNVLAB("ALR1",5380,"EKT 0307 48",173,3080307.211055,5427197)="" 102319 "RTN","C0CLA7Q", 80,0)102320 ; 102321 "RTN","C0CLA7Q", 81,0)102361 "RTN","C0CLA7Q",95,0) 102362 ; 102363 "RTN","C0CLA7Q",96,0) 102322 102364 S C0C60="" 102323 "RTN","C0CLA7Q", 82,0)102365 "RTN","C0CLA7Q",97,0) 102324 102366 F S C0C60=$O(^LAB(60,"C",LRSS_";"_LRSB_";1",C0C60)) Q:'C0C60 D Q:C0CLN'="" 102325 "RTN","C0CLA7Q", 83,0)102367 "RTN","C0CLA7Q",98,0) 102326 102368 . D FINDDT 102327 "RTN","C0CLA7Q", 84,0)102369 "RTN","C0CLA7Q",99,0) 102328 102370 . I C0CDA<1 Q 102329 "RTN","C0CLA7Q", 85,0)102371 "RTN","C0CLA7Q",100,0) 102330 102372 . I $P($G(^AUPNVLAB(C0CDA,11)),"^",8)'=1 Q ; Source is not LAB DATA file - skip 102331 "RTN","C0CLA7Q", 86,0)102373 "RTN","C0CLA7Q",101,0) 102332 102374 . S C0CLN=$P($G(^AUPNVLAB(C0CDA,11)),"^",13) 102333 "RTN","C0CLA7Q", 87,0)102375 "RTN","C0CLA7Q",102,0) 102334 102376 . S C0CPDA=$P($G(^AUPNVLAB(C0CDA,12)),"^",8) 102335 "RTN","C0CLA7Q", 88,0)102377 "RTN","C0CLA7Q",103,0) 102336 102378 . I C0CPDA,'$D(^AUPNVLAB(C0CPDA,0)) S C0CPDA="" ; Dangling pointer 102337 "RTN","C0CLA7Q", 89,0)102379 "RTN","C0CLA7Q",104,0) 102338 102380 . I C0CPDA="" S C0CPDA=C0CDA 102339 "RTN","C0CLA7Q", 90,0)102381 "RTN","C0CLA7Q",105,0) 102340 102382 . S C0CTEST=$P($G(^AUPNVLAB(C0CDA,0)),"^"),X=$P($G(^LAB(60,C0CTEST,64)),"^",2) 102341 "RTN","C0CLA7Q", 91,0)102383 "RTN","C0CLA7Q",106,0) 102342 102384 . I X S C0CTEST(64)=$P($G(^LAM(X,0)),"^",2) 102343 "RTN","C0CLA7Q", 92,0)102385 "RTN","C0CLA7Q",107,0) 102344 102386 . S C0CPTEST=$P($G(^AUPNVLAB(C0CPDA,0)),"^"),X=$P($G(^LAB(60,C0CPTEST,64)),"^") 102345 "RTN","C0CLA7Q", 93,0)102387 "RTN","C0CLA7Q",108,0) 102346 102388 . I X S C0CPTEST(64)=$P($G(^LAM(X,0)),"^",2) 102347 "RTN","C0CLA7Q", 94,0)102389 "RTN","C0CLA7Q",109,0) 102348 102390 . S ^TMP("C0C-VLAB",$J,1,C0CDA)="" 102349 "RTN","C0CLA7Q", 95,0)102391 "RTN","C0CLA7Q",110,0) 102350 102392 . I C0CDA'=C0CPDA S ^TMP("C0C-VLAB",$J,1,C0CPDA)="" 102351 "RTN","C0CLA7Q", 96,0)102393 "RTN","C0CLA7Q",111,0) 102352 102394 . S ^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB)=C0CPTEST(64)_"^"_C0CTEST(64)_"^"_C0CLN_"^"_C0CDA_"^"_C0CTEST_"^"_C0CPDA_"^"_C0CPTEST 102353 "RTN","C0CLA7Q", 97,0)102354 ; 102355 "RTN","C0CLA7Q", 98,0)102395 "RTN","C0CLA7Q",112,0) 102396 ; 102397 "RTN","C0CLA7Q",113,0) 102356 102398 S X=$P(LA7X,"^",3) 102357 "RTN","C0CLA7Q", 99,0)102399 "RTN","C0CLA7Q",114,0) 102358 102400 ; If order NLT then update if no order NLT 102359 "RTN","C0CLA7Q",1 00,0)102401 "RTN","C0CLA7Q",115,0) 102360 102402 I C0CPTEST(64),$P(X,"!")="" S $P(X,"!")=C0CPTEST(64) 102361 "RTN","C0CLA7Q",1 01,0)102362 ; 102363 "RTN","C0CLA7Q",1 02,0)102403 "RTN","C0CLA7Q",116,0) 102404 ; 102405 "RTN","C0CLA7Q",117,0) 102364 102406 ; If result NLT then update if no result NLT 102365 "RTN","C0CLA7Q",1 03,0)102407 "RTN","C0CLA7Q",118,0) 102366 102408 I C0CTEST(64),$P(X,"!",2)="" S $P(X,"!",2)=C0CTEST(64) 102367 "RTN","C0CLA7Q",1 04,0)102368 ; 102369 "RTN","C0CLA7Q",1 05,0)102409 "RTN","C0CLA7Q",119,0) 102410 ; 102411 "RTN","C0CLA7Q",120,0) 102370 102412 ; If LOINC found then update variable with LN code 102371 "RTN","C0CLA7Q",1 06,0)102413 "RTN","C0CLA7Q",121,0) 102372 102414 I C0CLN'="",$P(X,"!",3)="" S $P(X,"!",3)=C0CLN 102373 "RTN","C0CLA7Q",1 07,0)102374 ; 102375 "RTN","C0CLA7Q",1 08,0)102415 "RTN","C0CLA7Q",122,0) 102416 ; 102417 "RTN","C0CLA7Q",123,0) 102376 102418 S $P(LA7X,"^",3)=X 102377 "RTN","C0CLA7Q",1 09,0)102378 ; 102379 "RTN","C0CLA7Q",1 10,0)102419 "RTN","C0CLA7Q",124,0) 102420 ; 102421 "RTN","C0CLA7Q",125,0) 102380 102422 Q 102381 "RTN","C0CLA7Q",1 11,0)102382 ; 102383 "RTN","C0CLA7Q",1 12,0)102384 ; 102385 "RTN","C0CLA7Q",1 13,0)102423 "RTN","C0CLA7Q",126,0) 102424 ; 102425 "RTN","C0CLA7Q",127,0) 102426 ; 102427 "RTN","C0CLA7Q",128,0) 102386 102428 TMPCHK ; Check if LN/NLT codes saved from V LAB file above and use when building OBR/OBX segments 102387 "RTN","C0CLA7Q",1 14,0)102429 "RTN","C0CLA7Q",129,0) 102388 102430 ; Called from LA7VOBX1 102389 "RTN","C0CLA7Q",1 15,0)102390 ; 102391 "RTN","C0CLA7Q",1 16,0)102431 "RTN","C0CLA7Q",130,0) 102432 ; 102433 "RTN","C0CLA7Q",131,0) 102392 102434 N I,X 102393 "RTN","C0CLA7Q",1 17,0)102394 ; 102395 "RTN","C0CLA7Q",1 18,0)102435 "RTN","C0CLA7Q",132,0) 102436 ; 102437 "RTN","C0CLA7Q",133,0) 102396 102438 S X=$G(^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB)) 102397 "RTN","C0CLA7Q",1 19,0)102439 "RTN","C0CLA7Q",134,0) 102398 102440 I X="" Q 102399 "RTN","C0CLA7Q",1 20,0)102441 "RTN","C0CLA7Q",135,0) 102400 102442 F I=1:1:3 I $P(LA7X,"!",I)="",$P(X,"^",I)'="" S $P(LA7X,"!",I)=$P(X,"^",I) 102401 "RTN","C0CLA7Q",1 21,0)102443 "RTN","C0CLA7Q",136,0) 102402 102444 S $P(LA7VAL,"^",3)=LA7X 102403 "RTN","C0CLA7Q",1 22,0)102404 ; 102405 "RTN","C0CLA7Q",1 23,0)102445 "RTN","C0CLA7Q",137,0) 102446 ; 102447 "RTN","C0CLA7Q",138,0) 102406 102448 Q 102407 "RTN","C0CLA7Q",1 24,0)102408 ; 102409 "RTN","C0CLA7Q",1 25,0)102410 ; 102411 "RTN","C0CLA7Q",1 26,0)102449 "RTN","C0CLA7Q",139,0) 102450 ; 102451 "RTN","C0CLA7Q",140,0) 102452 ; 102453 "RTN","C0CLA7Q",141,0) 102412 102454 VCHK1 ; Check the entry in V Lab to determine if it meets criteria 102413 "RTN","C0CLA7Q",1 27,0)102414 ; 102415 "RTN","C0CLA7Q",1 28,0)102455 "RTN","C0CLA7Q",142,0) 102456 ; 102457 "RTN","C0CLA7Q",143,0) 102416 102458 N C0CVLAB,I 102417 "RTN","C0CLA7Q",1 29,0)102418 ; 102419 "RTN","C0CLA7Q",1 30,0)102459 "RTN","C0CLA7Q",144,0) 102460 ; 102461 "RTN","C0CLA7Q",145,0) 102420 102462 F I=0,12 S C0CVLAB(I)=$G(^AUPNVLAB(C0CDA,I)) 102421 "RTN","C0CLA7Q",1 31,0)102422 ; 102423 "RTN","C0CLA7Q",1 32,0)102463 "RTN","C0CLA7Q",146,0) 102464 ; 102465 "RTN","C0CLA7Q",147,0) 102424 102466 ; JMC 04/13/09 - Store anything for now that meets date criteria. 102425 "RTN","C0CLA7Q",1 33,0)102467 "RTN","C0CLA7Q",148,0) 102426 102468 D VSTORE 102427 "RTN","C0CLA7Q",1 34,0)102428 ; 102429 "RTN","C0CLA7Q",1 35,0)102469 "RTN","C0CLA7Q",149,0) 102470 ; 102471 "RTN","C0CLA7Q",150,0) 102430 102472 Q 102431 "RTN","C0CLA7Q",1 36,0)102432 ; 102433 "RTN","C0CLA7Q",1 37,0)102434 ; 102435 "RTN","C0CLA7Q",1 38,0)102473 "RTN","C0CLA7Q",151,0) 102474 ; 102475 "RTN","C0CLA7Q",152,0) 102476 ; 102477 "RTN","C0CLA7Q",153,0) 102436 102478 VSTORE ; Store entry for building in HL7 message when parent is from V LAB file. 102437 "RTN","C0CLA7Q",1 39,0)102438 ; 102439 "RTN","C0CLA7Q",1 40,0)102479 "RTN","C0CLA7Q",154,0) 102480 ; 102481 "RTN","C0CLA7Q",155,0) 102440 102482 N C0CPDA,C0CPTEST 102441 "RTN","C0CLA7Q",1 41,0)102442 ; 102443 "RTN","C0CLA7Q",1 42,0)102483 "RTN","C0CLA7Q",156,0) 102484 ; 102485 "RTN","C0CLA7Q",157,0) 102444 102486 ; Determine parent test to use for OBR segment 102445 "RTN","C0CLA7Q",1 43,0)102487 "RTN","C0CLA7Q",158,0) 102446 102488 S C0CPDA=$P(C0CVLAB(12),"^",8) 102447 "RTN","C0CLA7Q",1 44,0)102489 "RTN","C0CLA7Q",159,0) 102448 102490 I C0CPDA="" S C0CPDA=C0CDA 102449 "RTN","C0CLA7Q",1 45,0)102450 ; 102451 "RTN","C0CLA7Q",1 46,0)102491 "RTN","C0CLA7Q",160,0) 102492 ; 102493 "RTN","C0CLA7Q",161,0) 102452 102494 ; Determine parent test 102453 "RTN","C0CLA7Q",1 47,0)102495 "RTN","C0CLA7Q",162,0) 102454 102496 S C0CPTEST=$P($G(^AUPNVLAB(C0CPDA,0)),"^") 102455 "RTN","C0CLA7Q",1 48,0)102456 ; 102457 "RTN","C0CLA7Q",1 49,0)102497 "RTN","C0CLA7Q",163,0) 102498 ; 102499 "RTN","C0CLA7Q",164,0) 102458 102500 S ^TMP("C0C-VLAB",$J,3,$P(C0CVLAB(0),"^",2),$P(C0CVLAB(12),"^"),C0CPTEST,C0CDA)=C0CPDA 102459 "RTN","C0CLA7Q",1 50,0)102460 ; 102461 "RTN","C0CLA7Q",1 51,0)102501 "RTN","C0CLA7Q",165,0) 102502 ; 102503 "RTN","C0CLA7Q",166,0) 102462 102504 Q 102463 "RTN","C0CLA7Q",1 52,0)102464 ; 102465 "RTN","C0CLA7Q",1 53,0)102466 ; 102467 "RTN","C0CLA7Q",1 54,0)102505 "RTN","C0CLA7Q",167,0) 102506 ; 102507 "RTN","C0CLA7Q",168,0) 102508 ; 102509 "RTN","C0CLA7Q",169,0) 102468 102510 FINDDT ; Find entry in V LAB for the date/time or one close to it. 102469 "RTN","C0CLA7Q",1 55,0)102511 "RTN","C0CLA7Q",170,0) 102470 102512 ; RPMS stores related specimen entries under the same date/time. 102471 "RTN","C0CLA7Q",1 56,0)102513 "RTN","C0CLA7Q",171,0) 102472 102514 ; Lab file #63 creates unique entries with slightly different times. 102473 "RTN","C0CLA7Q",1 57,0)102474 ; 102475 "RTN","C0CLA7Q",1 58,0)102515 "RTN","C0CLA7Q",172,0) 102516 ; 102517 "RTN","C0CLA7Q",173,0) 102476 102518 S C0CDA=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,C0CDT,0)) 102477 "RTN","C0CLA7Q",1 59,0)102519 "RTN","C0CLA7Q",174,0) 102478 102520 I C0CDA>0 Q 102479 "RTN","C0CLA7Q",1 60,0)102480 ; 102481 "RTN","C0CLA7Q",1 61,0)102521 "RTN","C0CLA7Q",175,0) 102522 ; 102523 "RTN","C0CLA7Q",176,0) 102482 102524 ; If entry found then confirm that specimen type matches. 102483 "RTN","C0CLA7Q",1 62,0)102525 "RTN","C0CLA7Q",177,0) 102484 102526 N C0CDTY 102485 "RTN","C0CLA7Q",1 63,0)102527 "RTN","C0CLA7Q",178,0) 102486 102528 S C0CDTY=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,0)) 102487 "RTN","C0CLA7Q",1 64,0)102529 "RTN","C0CLA7Q",179,0) 102488 102530 I C0CDTY D 102489 "RTN","C0CLA7Q",1 65,0)102531 "RTN","C0CLA7Q",180,0) 102490 102532 . I $P(C0CDT,".")'=$P(C0CDTY,".") Q 102491 "RTN","C0CLA7Q",1 66,0)102533 "RTN","C0CLA7Q",181,0) 102492 102534 . S C0CDA=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,C0CDTY,0)) 102493 "RTN","C0CLA7Q",1 67,0)102535 "RTN","C0CLA7Q",182,0) 102494 102536 . I C0CSPEC'=$P($G(^AUPNVLAB(C0CDA,11)),"^",3) S C0CDA="" 102495 "RTN","C0CLA7Q",1 68,0)102496 ; 102497 "RTN","C0CLA7Q",1 69,0)102537 "RTN","C0CLA7Q",183,0) 102538 ; 102539 "RTN","C0CLA7Q",184,0) 102498 102540 Q 102499 102541 "RTN","C0CLABS") 102500 0^40^B2 82604886102542 0^40^B279276475 102501 102543 "RTN","C0CLABS",1,0) 102502 102544 C0CLABS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR LAB RESULTS ; 10/01/08 ; 5/10/12 2:49pm 102503 102545 "RTN","C0CLABS",2,0) 102504 ;;1.2;C 0C;;May 11, 2012;Build 50102546 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 102505 102547 "RTN","C0CLABS",3,0) 102506 102548 ;Copyright 2008,2009 George Lilly, University of Minnesota. 102507 102549 "RTN","C0CLABS",4,0) 102508 ; Licensed under the terms of the GNU General Public License.102550 ; 102509 102551 "RTN","C0CLABS",5,0) 102510 ; See attached copy of the License.102552 ; This program is free software: you can redistribute it and/or modify 102511 102553 "RTN","C0CLABS",6,0) 102512 ; 102554 ; it under the terms of the GNU Affero General Public License as 102513 102555 "RTN","C0CLABS",7,0) 102514 ; This program is free software; you can redistribute it and/or modify102556 ; published by the Free Software Foundation, either version 3 of the 102515 102557 "RTN","C0CLABS",8,0) 102516 ; it under the terms of the GNU General Public License as published by102558 ; License, or (at your option) any later version. 102517 102559 "RTN","C0CLABS",9,0) 102518 ; the Free Software Foundation; either version 2 of the License, or102560 ; 102519 102561 "RTN","C0CLABS",10,0) 102520 ; (at your option) any later version.102562 ; This program is distributed in the hope that it will be useful, 102521 102563 "RTN","C0CLABS",11,0) 102522 ; 102564 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 102523 102565 "RTN","C0CLABS",12,0) 102524 ; This program is distributed in the hope that it will be useful,102566 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 102525 102567 "RTN","C0CLABS",13,0) 102526 ; but WITHOUT ANY WARRANTY; without even the implied warranty of102568 ; GNU Affero General Public License for more details. 102527 102569 "RTN","C0CLABS",14,0) 102528 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the102570 ; 102529 102571 "RTN","C0CLABS",15,0) 102530 ; GNU General Public License for more details.102572 ; You should have received a copy of the GNU Affero General Public License 102531 102573 "RTN","C0CLABS",16,0) 102532 ; 102574 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 102533 102575 "RTN","C0CLABS",17,0) 102534 ; You should have received a copy of the GNU General Public License along102576 ; 102535 102577 "RTN","C0CLABS",18,0) 102536 ;with this program; if not, write to the Free Software Foundation, Inc., 102578 MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT 102537 102579 "RTN","C0CLABS",19,0) 102538 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.102580 ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR 102539 102581 "RTN","C0CLABS",20,0) 102540 ;102582 ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME 102541 102583 "RTN","C0CLABS",21,0) 102542 MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT 102584 ; MIXML IS THE TEMPLATE TO USE 102543 102585 "RTN","C0CLABS",22,0) 102544 ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR102586 ; MOXML IS THE OUTPUT XML ARRAY 102545 102587 "RTN","C0CLABS",23,0) 102546 ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME102588 ; DFN IS THE PATIENT RECORD NUMBER 102547 102589 "RTN","C0CLABS",24,0) 102548 ; MIXML IS THE TEMPLATE TO USE102590 N C0COXML,C0CO,C0CV,C0CIXML 102549 102591 "RTN","C0CLABS",25,0) 102550 ; MOXML IS THE OUTPUT XML ARRAY102592 I '$D(MIVAR) S C0CV="" ;DEFAULT 102551 102593 "RTN","C0CLABS",26,0) 102552 ; DFN IS THE PATIENT RECORD NUMBER102594 E S C0CV=MIVAR ;PASSED VARIABLE ARRAY 102553 102595 "RTN","C0CLABS",27,0) 102554 N C0COXML,C0CO,C0CV,C0CIXML102596 I '$D(MIXML) S C0CIXML="" ;DEFAULT 102555 102597 "RTN","C0CLABS",28,0) 102556 I '$D(MIVAR) S C0CV="" ;DEFAULT102598 E S C0CIXML=MIXML ;PASSED INPUT XML 102557 102599 "RTN","C0CLABS",29,0) 102558 E S C0CV=MIVAR ;PASSED VARIABLE ARRAY102600 D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK 102559 102601 "RTN","C0CLABS",30,0) 102560 I '$D(M IXML) S C0CIXML="" ;DEFAULT102602 I '$D(MOXML) S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT 102561 102603 "RTN","C0CLABS",31,0) 102562 E S C0C IXML=MIXML ;PASSED INPUTXML102604 E S C0CO=MOXML 102563 102605 "RTN","C0CLABS",32,0) 102564 D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK102606 ; ZWR C0COXML 102565 102607 "RTN","C0CLABS",33,0) 102566 I '$D(MOXML) S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOROUTPUT102608 M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT 102567 102609 "RTN","C0CLABS",34,0) 102568 E S C0CO=MOXML102610 Q 102569 102611 "RTN","C0CLABS",35,0) 102570 ; ZWR C0COXML102612 ; 102571 102613 "RTN","C0CLABS",36,0) 102572 M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT 102614 RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS 102573 102615 "RTN","C0CLABS",37,0) 102616 ; RTN IS PASSED BY REFERENCE 102617 "RTN","C0CLABS",38,0) 102618 ;N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES 102619 "RTN","C0CLABS",39,0) 102620 ;N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE 102621 "RTN","C0CLABS",40,0) 102622 I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING 102623 "RTN","C0CLABS",41,0) 102624 I RMIXML="" D ; INPUT XML NOT PASSED 102625 "RTN","C0CLABS",42,0) 102626 . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE 102627 "RTN","C0CLABS",43,0) 102628 . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R") 102629 "RTN","C0CLABS",44,0) 102630 . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE 102631 "RTN","C0CLABS",45,0) 102632 E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE 102633 "RTN","C0CLABS",46,0) 102634 I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED 102635 "RTN","C0CLABS",47,0) 102636 . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION 102637 "RTN","C0CLABS",48,0) 102638 E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS 102639 "RTN","C0CLABS",49,0) 102640 D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE 102641 "RTN","C0CLABS",50,0) 102642 D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ 102643 "RTN","C0CLABS",51,0) 102644 D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE 102645 "RTN","C0CLABS",52,0) 102646 I '$D(C0CQT) S C0CQT=0 ; DEFAULT NOT SILENT 102647 "RTN","C0CLABS",53,0) 102648 I 'C0CQT D ; WE ARE DEBUGGING 102649 "RTN","C0CLABS",54,0) 102650 . W "I MAPPED",! 102651 "RTN","C0CLABS",55,0) 102652 . W "VARS:",C0CV,! 102653 "RTN","C0CLABS",56,0) 102654 . W "DFN:",DFN,! 102655 "RTN","C0CLABS",57,0) 102656 . ;D PARY^C0CXPATH("C0CT") ; SECTION TEMPLATE 102657 "RTN","C0CLABS",58,0) 102658 . ;D PARY^C0CXPATH("C0CRT") ;REQUEST TEMPLATE (OCR) 102659 "RTN","C0CLABS",59,0) 102660 . ;D PARY^C0CXPATH("C0CTT") ;TEST TEMPLATE (OCX) 102661 "RTN","C0CLABS",60,0) 102662 D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT 102663 "RTN","C0CLABS",61,0) 102664 I '$D(@C0CV@(0)) D Q ; NO VARS THERE 102665 "RTN","C0CLABS",62,0) 102666 . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR 102667 "RTN","C0CLABS",63,0) 102668 I @C0CV@(0)=0 S RTN(0)=0 Q ; NO RESULTS 102669 "RTN","C0CLABS",64,0) 102670 S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS")) 102671 "RTN","C0CLABS",65,0) 102672 K @RIMVARS 102673 "RTN","C0CLABS",66,0) 102674 M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH 102675 "RTN","C0CLABS",67,0) 102676 N C0CI,C0CJ,C0CMAP,C0CTMAP,C0CTMP 102677 "RTN","C0CLABS",68,0) 102678 S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR) 102679 "RTN","C0CLABS",69,0) 102680 N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT 102681 "RTN","C0CLABS",70,0) 102682 N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA 102683 "RTN","C0CLABS",71,0) 102684 N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END 102685 "RTN","C0CLABS",72,0) 102686 ; TO IMPROVE PERFORMANCE 102687 "RTN","C0CLABS",73,0) 102688 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results> 102689 "RTN","C0CLABS",74,0) 102690 F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES 102691 "RTN","C0CLABS",75,0) 102692 . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES 102693 "RTN","C0CLABS",76,0) 102694 . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST 102695 "RTN","C0CLABS",77,0) 102696 . S C0CMAP=$NA(@C0CV@(C0CI)) ; 102697 "RTN","C0CLABS",78,0) 102698 . I 'C0CQT W "MAPOBR:",C0CMAP,! 102699 "RTN","C0CLABS",79,0) 102700 . ;MAPPING FOR TEST REQUEST GOES HERE 102701 "RTN","C0CLABS",80,0) 102702 . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA 102703 "RTN","C0CLABS",81,0) 102704 . ;D QOPEN^C0CXPATH("C0CRBLD",C0CRTMP,C0CIS) ;1ST PART OF XML 102705 "RTN","C0CLABS",82,0) 102706 . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test> 102707 "RTN","C0CLABS",83,0) 102708 . I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST 102709 "RTN","C0CLABS",84,0) 102710 . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS 102711 "RTN","C0CLABS",85,0) 102712 . . K C0CTO ; CLEAR OUTPUT VARIABLE 102713 "RTN","C0CLABS",86,0) 102714 . . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT 102715 "RTN","C0CLABS",87,0) 102716 . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS 102717 "RTN","C0CLABS",88,0) 102718 . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS 102719 "RTN","C0CLABS",89,0) 102720 . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ; 102721 "RTN","C0CLABS",90,0) 102722 . . . I 'C0CQT W "MAPOBX:",C0CTMAP,! 102723 "RTN","C0CLABS",91,0) 102724 . . . D MAP^C0CXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP 102725 "RTN","C0CLABS",92,0) 102726 . . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE <Test> 102727 "RTN","C0CLABS",93,0) 102728 . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;</Test> 102729 "RTN","C0CLABS",94,0) 102730 . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML 102731 "RTN","C0CLABS",95,0) 102732 . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST 102733 "RTN","C0CLABS",96,0) 102734 . . . ;I C0CJ=1 D ; FIRST TIME, JUST COPY 102735 "RTN","C0CLABS",97,0) 102736 . . . ;. D CP^C0CXPATH("C0CTMP","C0CTO") ; START BUILDING TEST XML 102737 "RTN","C0CLABS",98,0) 102738 . . . ;E D INSINNER^C0CXPATH("C0CTO","C0CTMP") 102739 "RTN","C0CLABS",99,0) 102740 . . . ; 102741 "RTN","C0CLABS",100,0) 102742 . . . ;D PUSHA^C0CXPATH("C0CTO",C0CTMP) ;ADD THE TEST TO BUFFER 102743 "RTN","C0CLABS",101,0) 102744 . . ; I 'C0CQT D PARY^C0CXPATH("C0CTO") 102745 "RTN","C0CLABS",102,0) 102746 . . ;D INSINNER^C0CXPATH(C0CRTMP,"C0CTO","//Results/Result/Test") ;INSERT TST 102747 "RTN","C0CLABS",103,0) 102748 . ;D QCLOSE^C0CXPATH("C0CRBLD",C0CRTMP,"//Results/Result/Test") ;END OF XML 102749 "RTN","C0CLABS",104,0) 102750 . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result> 102751 "RTN","C0CLABS",105,0) 102752 . ;I C0CI=1 D ; FIRST TIME, COPY INSTEAD OF INSERT 102753 "RTN","C0CLABS",106,0) 102754 . ;. D CP^C0CXPATH(C0CRTMP,"RTN") ; 102755 "RTN","C0CLABS",107,0) 102756 . ;E D INSINNER^C0CXPATH("RTN",C0CRTMP) ; INSERT THIS TEST REQUEST 102757 "RTN","C0CLABS",108,0) 102758 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results> 102759 "RTN","C0CLABS",109,0) 102760 D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML 102761 "RTN","C0CLABS",110,0) 102762 K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE 102763 "RTN","C0CLABS",111,0) 102574 102764 Q 102575 "RTN","C0CLABS",38,0)102576 ;102577 "RTN","C0CLABS",39,0)102578 RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS102579 "RTN","C0CLABS",40,0)102580 ; RTN IS PASSED BY REFERENCE102581 "RTN","C0CLABS",41,0)102582 ;N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES102583 "RTN","C0CLABS",42,0)102584 ;N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE102585 "RTN","C0CLABS",43,0)102586 I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING102587 "RTN","C0CLABS",44,0)102588 I RMIXML="" D ; INPUT XML NOT PASSED102589 "RTN","C0CLABS",45,0)102590 . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE102591 "RTN","C0CLABS",46,0)102592 . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")102593 "RTN","C0CLABS",47,0)102594 . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE102595 "RTN","C0CLABS",48,0)102596 E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE102597 "RTN","C0CLABS",49,0)102598 I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED102599 "RTN","C0CLABS",50,0)102600 . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION102601 "RTN","C0CLABS",51,0)102602 E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS102603 "RTN","C0CLABS",52,0)102604 D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE102605 "RTN","C0CLABS",53,0)102606 D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ102607 "RTN","C0CLABS",54,0)102608 D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE102609 "RTN","C0CLABS",55,0)102610 I '$D(C0CQT) S C0CQT=0 ; DEFAULT NOT SILENT102611 "RTN","C0CLABS",56,0)102612 I 'C0CQT D ; WE ARE DEBUGGING102613 "RTN","C0CLABS",57,0)102614 . W "I MAPPED",!102615 "RTN","C0CLABS",58,0)102616 . W "VARS:",C0CV,!102617 "RTN","C0CLABS",59,0)102618 . W "DFN:",DFN,!102619 "RTN","C0CLABS",60,0)102620 . ;D PARY^C0CXPATH("C0CT") ; SECTION TEMPLATE102621 "RTN","C0CLABS",61,0)102622 . ;D PARY^C0CXPATH("C0CRT") ;REQUEST TEMPLATE (OCR)102623 "RTN","C0CLABS",62,0)102624 . ;D PARY^C0CXPATH("C0CTT") ;TEST TEMPLATE (OCX)102625 "RTN","C0CLABS",63,0)102626 D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT102627 "RTN","C0CLABS",64,0)102628 I '$D(@C0CV@(0)) D Q ; NO VARS THERE102629 "RTN","C0CLABS",65,0)102630 . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR102631 "RTN","C0CLABS",66,0)102632 I @C0CV@(0)=0 S RTN(0)=0 Q ; NO RESULTS102633 "RTN","C0CLABS",67,0)102634 S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))102635 "RTN","C0CLABS",68,0)102636 K @RIMVARS102637 "RTN","C0CLABS",69,0)102638 M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH102639 "RTN","C0CLABS",70,0)102640 N C0CI,C0CJ,C0CMAP,C0CTMAP,C0CTMP102641 "RTN","C0CLABS",71,0)102642 S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)102643 "RTN","C0CLABS",72,0)102644 N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT102645 "RTN","C0CLABS",73,0)102646 N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA102647 "RTN","C0CLABS",74,0)102648 N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END102649 "RTN","C0CLABS",75,0)102650 ; TO IMPROVE PERFORMANCE102651 "RTN","C0CLABS",76,0)102652 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>102653 "RTN","C0CLABS",77,0)102654 F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES102655 "RTN","C0CLABS",78,0)102656 . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES102657 "RTN","C0CLABS",79,0)102658 . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST102659 "RTN","C0CLABS",80,0)102660 . S C0CMAP=$NA(@C0CV@(C0CI)) ;102661 "RTN","C0CLABS",81,0)102662 . I 'C0CQT W "MAPOBR:",C0CMAP,!102663 "RTN","C0CLABS",82,0)102664 . ;MAPPING FOR TEST REQUEST GOES HERE102665 "RTN","C0CLABS",83,0)102666 . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA102667 "RTN","C0CLABS",84,0)102668 . ;D QOPEN^C0CXPATH("C0CRBLD",C0CRTMP,C0CIS) ;1ST PART OF XML102669 "RTN","C0CLABS",85,0)102670 . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>102671 "RTN","C0CLABS",86,0)102672 . I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST102673 "RTN","C0CLABS",87,0)102674 . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS102675 "RTN","C0CLABS",88,0)102676 . . K C0CTO ; CLEAR OUTPUT VARIABLE102677 "RTN","C0CLABS",89,0)102678 . . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT102679 "RTN","C0CLABS",90,0)102680 . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS102681 "RTN","C0CLABS",91,0)102682 . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS102683 "RTN","C0CLABS",92,0)102684 . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;102685 "RTN","C0CLABS",93,0)102686 . . . I 'C0CQT W "MAPOBX:",C0CTMAP,!102687 "RTN","C0CLABS",94,0)102688 . . . D MAP^C0CXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP102689 "RTN","C0CLABS",95,0)102690 . . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE <Test>102691 "RTN","C0CLABS",96,0)102692 . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;</Test>102693 "RTN","C0CLABS",97,0)102694 . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML102695 "RTN","C0CLABS",98,0)102696 . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST102697 "RTN","C0CLABS",99,0)102698 . . . ;I C0CJ=1 D ; FIRST TIME, JUST COPY102699 "RTN","C0CLABS",100,0)102700 . . . ;. D CP^C0CXPATH("C0CTMP","C0CTO") ; START BUILDING TEST XML102701 "RTN","C0CLABS",101,0)102702 . . . ;E D INSINNER^C0CXPATH("C0CTO","C0CTMP")102703 "RTN","C0CLABS",102,0)102704 . . . ;102705 "RTN","C0CLABS",103,0)102706 . . . ;D PUSHA^C0CXPATH("C0CTO",C0CTMP) ;ADD THE TEST TO BUFFER102707 "RTN","C0CLABS",104,0)102708 . . ; I 'C0CQT D PARY^C0CXPATH("C0CTO")102709 "RTN","C0CLABS",105,0)102710 . . ;D INSINNER^C0CXPATH(C0CRTMP,"C0CTO","//Results/Result/Test") ;INSERT TST102711 "RTN","C0CLABS",106,0)102712 . ;D QCLOSE^C0CXPATH("C0CRBLD",C0CRTMP,"//Results/Result/Test") ;END OF XML102713 "RTN","C0CLABS",107,0)102714 . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>102715 "RTN","C0CLABS",108,0)102716 . ;I C0CI=1 D ; FIRST TIME, COPY INSTEAD OF INSERT102717 "RTN","C0CLABS",109,0)102718 . . ;D CP^C0CXPATH(C0CRTMP,"RTN") ;102719 "RTN","C0CLABS",110,0)102720 . ;E D INSINNER^C0CXPATH("RTN",C0CRTMP) ; INSERT THIS TEST REQUEST102721 "RTN","C0CLABS",111,0)102722 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>102723 102765 "RTN","C0CLABS",112,0) 102724 D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML102766 ; 102725 102767 "RTN","C0CLABS",113,0) 102726 K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE 102768 EXTRACT(ILXML,DFN,OLXML) ; EXTRACT LABS INTO THE C0CLVAR GLOBAL 102727 102769 "RTN","C0CLABS",114,0) 102770 ; 102771 "RTN","C0CLABS",115,0) 102772 ; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED 102773 "RTN","C0CLABS",116,0) 102774 ; 102775 "RTN","C0CLABS",117,0) 102776 ; 102777 "RTN","C0CLABS",118,0) 102778 ; 102779 "RTN","C0CLABS",119,0) 102780 N C0CNSSN ; IS THERE AN SSN FLAG 102781 "RTN","C0CLABS",120,0) 102782 S C0CNSSN=0 102783 "RTN","C0CLABS",121,0) 102784 S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS 102785 "RTN","C0CLABS",122,0) 102786 D GHL7 ; GET HL7 MESSAGE FOR THIS PATIENT 102787 "RTN","C0CLABS",123,0) 102788 I C0CNSSN=1 D Q ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT 102789 "RTN","C0CLABS",124,0) 102790 . S @C0CLB@(0)=0 102791 "RTN","C0CLABS",125,0) 102792 K @C0CLB ; CLEAR OUT OLD VARS IF ANY 102793 "RTN","C0CLABS",126,0) 102794 N QTSAV S QTSAV=C0CQT ;SAVE QUIET FLAG 102795 "RTN","C0CLABS",127,0) 102796 S C0CQT=1 ; SURPRESS LISTING 102797 "RTN","C0CLABS",128,0) 102798 D LIST ; EXTRACT THE VARIABLES 102799 "RTN","C0CLABS",129,0) 102800 ; FOR CERTIFICATION, SEE IF THERE ARE OTHER RESULTS TO ADD 102801 "RTN","C0CLABS",130,0) 102802 D EN^C0CORSLT(C0CLB,DFN) ; LOOKS FOR ECG TESTS 102803 "RTN","C0CLABS",131,0) 102804 S C0CQT=QTSAV ; RESET SILENT FLAG 102805 "RTN","C0CLABS",132,0) 102806 K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT 102807 "RTN","C0CLABS",133,0) 102808 I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS 102809 "RTN","C0CLABS",134,0) 102728 102810 Q 102729 "RTN","C0CLABS",115,0)102730 ;102731 "RTN","C0CLABS",116,0)102732 EXTRACT(ILXML,DFN,OLXML) ; EXTRACT LABS INTO THE C0CLVAR GLOBAL102733 "RTN","C0CLABS",117,0)102734 ;102735 "RTN","C0CLABS",118,0)102736 ; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED102737 "RTN","C0CLABS",119,0)102738 ;102739 "RTN","C0CLABS",120,0)102740 ;102741 "RTN","C0CLABS",121,0)102742 ;102743 "RTN","C0CLABS",122,0)102744 N C0CNSSN ; IS THERE AN SSN FLAG102745 "RTN","C0CLABS",123,0)102746 S C0CNSSN=0102747 "RTN","C0CLABS",124,0)102748 S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS102749 "RTN","C0CLABS",125,0)102750 D GHL7 ; GET HL7 MESSAGE FOR THIS PATIENT102751 "RTN","C0CLABS",126,0)102752 I C0CNSSN=1 D Q ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT102753 "RTN","C0CLABS",127,0)102754 . S @C0CLB@(0)=0102755 "RTN","C0CLABS",128,0)102756 K @C0CLB ; CLEAR OUT OLD VARS IF ANY102757 "RTN","C0CLABS",129,0)102758 N QTSAV S QTSAV=C0CQT ;SAVE QUIET FLAG102759 "RTN","C0CLABS",130,0)102760 S C0CQT=1 ; SURPRESS LISTING102761 "RTN","C0CLABS",131,0)102762 D LIST ; EXTRACT THE VARIABLES102763 "RTN","C0CLABS",132,0)102764 ; FOR CERTIFICATION, SEE IF THERE ARE OTHER RESULTS TO ADD102765 "RTN","C0CLABS",133,0)102766 D EN^C0CORSLT(C0CLB,DFN) ; LOOKS FOR ECG TESTS102767 "RTN","C0CLABS",134,0)102768 S C0CQT=QTSAV ; RESET SILENT FLAG102769 102811 "RTN","C0CLABS",135,0) 102770 K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT102812 ; 102771 102813 "RTN","C0CLABS",136,0) 102772 I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS 102814 GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT 102773 102815 "RTN","C0CLABS",137,0) 102816 ; N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR 102817 "RTN","C0CLABS",138,0) 102818 ; SET UP FOR LAB API CALL 102819 "RTN","C0CLABS",139,0) 102820 S C0CPTID=$$SSN^C0CDPT(DFN) ; GET THE SSN FOR THIS PATIENT 102821 "RTN","C0CLABS",140,0) 102822 I C0CPTID="" D Q ; NO SSN, COMPLAIN AND QUIT 102823 "RTN","C0CLABS",141,0) 102824 . W "LAB LOOKUP FAILED, NO SSN",! 102825 "RTN","C0CLABS",142,0) 102826 . S C0CNSSN=1 ; SET NO SSN FLAG 102827 "RTN","C0CLABS",143,0) 102828 S C0CSPC="*" ; LOOKING FOR ALL LABS 102829 "RTN","C0CLABS",144,0) 102830 ;I $D(^TMP("C0CCCR","RPMS")) D ; RUNNING RPMS 102831 "RTN","C0CLABS",145,0) 102832 ;. D DT^DILF(,"T-365",.C0CSDT) ; START DATE ONE YEAR AGO TO LIMIT VOLUME 102833 "RTN","C0CLABS",146,0) 102834 ;E D DT^DILF(,"T-5000",.C0CSDT) ; START DATE LONG AGO TO GET EVERYTHING 102835 "RTN","C0CLABS",147,0) 102836 ;D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY 102837 "RTN","C0CLABS",148,0) 102838 S C0CLLMT=$$GET^C0CPARMS("LABLIMIT") ; GET THE LIMIT PARM 102839 "RTN","C0CLABS",149,0) 102840 S C0CLSTRT=$$GET^C0CPARMS("LABSTART") ; GET START PARM 102841 "RTN","C0CLABS",150,0) 102842 D DT^DILF(,C0CLLMT,.C0CSDT) ; 102843 "RTN","C0CLABS",151,0) 102844 W "LAB LIMIT: ",C0CLLMT,! 102845 "RTN","C0CLABS",152,0) 102846 D DT^DILF(,C0CLSTRT,.C0CEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM 102847 "RTN","C0CLABS",153,0) 102848 S C0CEDT=$$NOW^XLFDT ; PULL LABS STARTING NOW 102849 "RTN","C0CLABS",154,0) 102850 S C0CR=$$LAB^C0CLA7Q(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP 102851 "RTN","C0CLABS",155,0) 102774 102852 Q 102775 "RTN","C0CLABS",138,0)102776 ;102777 "RTN","C0CLABS",139,0)102778 GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT102779 "RTN","C0CLABS",140,0)102780 ; N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR102781 "RTN","C0CLABS",141,0)102782 ; SET UP FOR LAB API CALL102783 "RTN","C0CLABS",142,0)102784 S C0CPTID=$$SSN^C0CDPT(DFN) ; GET THE SSN FOR THIS PATIENT102785 "RTN","C0CLABS",143,0)102786 I C0CPTID="" D Q ; NO SSN, COMPLAIN AND QUIT102787 "RTN","C0CLABS",144,0)102788 . W "LAB LOOKUP FAILED, NO SSN",!102789 "RTN","C0CLABS",145,0)102790 . S C0CNSSN=1 ; SET NO SSN FLAG102791 "RTN","C0CLABS",146,0)102792 S C0CSPC="*" ; LOOKING FOR ALL LABS102793 "RTN","C0CLABS",147,0)102794 ;I $D(^TMP("C0CCCR","RPMS")) D ; RUNNING RPMS102795 "RTN","C0CLABS",148,0)102796 ;. D DT^DILF(,"T-365",.C0CSDT) ; START DATE ONE YEAR AGO TO LIMIT VOLUME102797 "RTN","C0CLABS",149,0)102798 ;E D DT^DILF(,"T-5000",.C0CSDT) ; START DATE LONG AGO TO GET EVERYTHING102799 "RTN","C0CLABS",150,0)102800 ;D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY102801 "RTN","C0CLABS",151,0)102802 S C0CLLMT=$$GET^C0CPARMS("LABLIMIT") ; GET THE LIMIT PARM102803 "RTN","C0CLABS",152,0)102804 S C0CLSTRT=$$GET^C0CPARMS("LABSTART") ; GET START PARM102805 "RTN","C0CLABS",153,0)102806 D DT^DILF(,C0CLLMT,.C0CSDT) ;102807 "RTN","C0CLABS",154,0)102808 W "LAB LIMIT: ",C0CLLMT,!102809 "RTN","C0CLABS",155,0)102810 D DT^DILF(,C0CLSTRT,.C0CEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM102811 102853 "RTN","C0CLABS",156,0) 102812 S C0CEDT=$$NOW^XLFDT ; PULL LABS STARTING NOW102854 ; 102813 102855 "RTN","C0CLABS",157,0) 102814 S C0CR=$$LAB^C0CLA7Q(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP 102856 LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB 102815 102857 "RTN","C0CLABS",158,0) 102858 ; 102859 "RTN","C0CLABS",159,0) 102860 ; N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR 102861 "RTN","C0CLABS",160,0) 102862 I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS 102863 "RTN","C0CLABS",161,0) 102864 I '$D(C0CQT) S C0CQT=0 102865 "RTN","C0CLABS",162,0) 102866 I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT 102867 "RTN","C0CLABS",163,0) 102868 I '$D(^TMP("C0CCCR","LABTBL",0)) D SETTBL ;INITIALIZE LAB TABLE 102869 "RTN","C0CLABS",164,0) 102870 I ^TMP("C0CCCR","LABTBL",0)'="V3" D SETTBL ;NEED NEWEST VERSION 102871 "RTN","C0CLABS",165,0) 102872 I '$D(^TMP("HLS",$J,1)) D GHL7 ; GET HL7 MGS IF NOT ALREADY DONE 102873 "RTN","C0CLABS",166,0) 102874 S C0CTAB=$NA(^TMP("C0CCCR","LABTBL")) ; BASE OF OBX TABLE 102875 "RTN","C0CLABS",167,0) 102876 S C0CHB=$NA(^TMP("HLS",$J)) 102877 "RTN","C0CLABS",168,0) 102878 S C0CI="" 102879 "RTN","C0CLABS",169,0) 102880 S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT 102881 "RTN","C0CLABS",170,0) 102882 F S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI="" D ; FOR ALL RECORDS IN HL7 MSG 102883 "RTN","C0CLABS",171,0) 102884 . K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES 102885 "RTN","C0CLABS",172,0) 102886 . S C0CTYP=$P(@C0CHB@(C0CI),"|",1) 102887 "RTN","C0CLABS",173,0) 102888 . D LTYP(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT) 102889 "RTN","C0CLABS",174,0) 102890 . I $G(C0CVAR("RESULTCODINGSYSTEM"))="LN" D ; gpl - for certification 102891 "RTN","C0CLABS",175,0) 102892 . . S C0CVAR("RESULTCODINGSYSTEM")="LOINC" ; NEED TO SPELL IT OUT 102893 "RTN","C0CLABS",176,0) 102894 . . N C0CRDT S C0CRDT=C0CVAR("RESULTDESCRIPTIONTEXT") ; THE DESCRIPTION 102895 "RTN","C0CLABS",177,0) 102896 . . N C0CRCD S C0CRCD=C0CVAR("RESULTCODE") ; THE LOINC CODE 102897 "RTN","C0CLABS",178,0) 102898 . . S C0CVAR("RESULTDESCRIPTIONTEXT")=C0CRDT_" LOINC: "_C0CRCD 102899 "RTN","C0CLABS",179,0) 102900 . M XV=C0CVAR ; 102901 "RTN","C0CLABS",180,0) 102902 . I C0CTYP="OBR" D ; BEGINNING OF NEW SECTION 102903 "RTN","C0CLABS",181,0) 102904 . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT 102905 "RTN","C0CLABS",182,0) 102906 . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT 102907 "RTN","C0CLABS",183,0) 102908 . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS 102909 "RTN","C0CLABS",184,0) 102910 . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI 102911 "RTN","C0CLABS",185,0) 102912 . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR 102913 "RTN","C0CLABS",186,0) 102914 . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1) 102915 "RTN","C0CLABS",187,0) 102916 . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT 102917 "RTN","C0CLABS",188,0) 102918 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL 102919 "RTN","C0CLABS",189,0) 102920 . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME 102921 "RTN","C0CLABS",190,0) 102922 . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS 102923 "RTN","C0CLABS",191,0) 102924 . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION 102925 "RTN","C0CLABS",192,0) 102926 . I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX3 102927 "RTN","C0CLABS",193,0) 102928 . . ; RESULTTESTCODEVALUE 102929 "RTN","C0CLABS",194,0) 102930 . . ; RESULTTESTDESCRIPTIONTEXT 102931 "RTN","C0CLABS",195,0) 102932 . . I C0CVAR("C3")="LN" D ; PRIMARY CODE IS LOINC 102933 "RTN","C0CLABS",196,0) 102934 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE LOINC CODE VALUE 102935 "RTN","C0CLABS",197,0) 102936 . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC 102937 "RTN","C0CLABS",198,0) 102938 . . . ;S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESC TXT 102939 "RTN","C0CLABS",199,0) 102940 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2")_" LOINC: "_C0CVAR("C1") 102941 "RTN","C0CLABS",200,0) 102942 . . E I C0CVAR("C6")="LN" D ; SECONDARY CODE IS LOINC 102943 "RTN","C0CLABS",201,0) 102944 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; THE LOINC CODE VALUE 102945 "RTN","C0CLABS",202,0) 102946 . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC 102947 "RTN","C0CLABS",203,0) 102948 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; DESCRIPTION TEXT 102949 "RTN","C0CLABS",204,0) 102950 . . E I C0CVAR("C6")'="" D ; NO LOINC CODES, USE SECONDARY IF PRESENT 102951 "RTN","C0CLABS",205,0) 102952 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE 102953 "RTN","C0CLABS",206,0) 102954 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME 102955 "RTN","C0CLABS",207,0) 102956 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT 102957 "RTN","C0CLABS",208,0) 102958 . . E D ; NO SECONDARY, USE PRIMARY 102959 "RTN","C0CLABS",209,0) 102960 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE 102961 "RTN","C0CLABS",210,0) 102962 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME 102963 "RTN","C0CLABS",211,0) 102964 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT 102965 "RTN","C0CLABS",212,0) 102966 . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ; 102967 "RTN","C0CLABS",213,0) 102968 . . ; mod to remove local XML escaping rely upon MAP^C0CXPATH 102969 "RTN","C0CLABS",214,0) 102970 . . ;S XV("RESULTTESTNORMALDESCTEXT")=$$SYMENC^MXMLUTL(C0CZG) ;ESCAPE 102971 "RTN","C0CLABS",215,0) 102972 . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG 102973 "RTN","C0CLABS",216,0) 102974 . . S C0CZG=XV("RESULTTESTVALUE") 102975 "RTN","C0CLABS",217,0) 102976 . . ; mod to remove local XML escaping rely upon MAP^C0CXPATH 102977 "RTN","C0CLABS",218,0) 102978 . . ;S XV("RESULTTESTVALUE")=$$SYMENC^MXMLUTL(C0CZG) ;ESCAPE 102979 "RTN","C0CLABS",219,0) 102980 . . S XV("RESULTTESTVALUE")=C0CZG 102981 "RTN","C0CLABS",220,0) 102982 . I C0CTYP="OBX" D ; PROCESS TEST RESULTS 102983 "RTN","C0CLABS",221,0) 102984 . . I C0CLOBX=0 D ; FIRST TEST RESULT FOR THIS SECTION 102985 "RTN","C0CLABS",222,0) 102986 . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS 102987 "RTN","C0CLABS",223,0) 102988 . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT 102989 "RTN","C0CLABS",224,0) 102990 . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT 102991 "RTN","C0CLABS",225,0) 102992 . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX 102993 "RTN","C0CLABS",226,0) 102994 . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE 102995 "RTN","C0CLABS",227,0) 102996 . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER 102997 "RTN","C0CLABS",228,0) 102998 . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2 102999 "RTN","C0CLABS",229,0) 103000 . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID") 103001 "RTN","C0CLABS",230,0) 103002 . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT 103003 "RTN","C0CLABS",231,0) 103004 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL 103005 "RTN","C0CLABS",232,0) 103006 . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME 103007 "RTN","C0CLABS",233,0) 103008 . . ; I 'C0CQT ZWR XV 103009 "RTN","C0CLABS",234,0) 103010 . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES 103011 "RTN","C0CLABS",235,0) 103012 . I 'C0CQT D ; 103013 "RTN","C0CLABS",236,0) 103014 . . W C0CI," ",C0CTYP,! 103015 "RTN","C0CLABS",237,0) 103016 . ; S C0CI=$O(@C0CHB@(C0CI)) 103017 "RTN","C0CLABS",238,0) 103018 ;K ^TMP("C0CRIM","VARS",DFN,"RESULTS") 103019 "RTN","C0CLABS",239,0) 103020 ;M ^TMP("C0CRIM","VARS",DFN,"RESULTS")=@C0CLB 103021 "RTN","C0CLABS",240,0) 102816 103022 Q 102817 "RTN","C0CLABS",159,0)102818 ;102819 "RTN","C0CLABS",160,0)102820 LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB102821 "RTN","C0CLABS",161,0)102822 ;102823 "RTN","C0CLABS",162,0)102824 ; N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR102825 "RTN","C0CLABS",163,0)102826 I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS102827 "RTN","C0CLABS",164,0)102828 I '$D(C0CQT) S C0CQT=0102829 "RTN","C0CLABS",165,0)102830 I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT102831 "RTN","C0CLABS",166,0)102832 I '$D(^TMP("C0CCCR","LABTBL",0)) D SETTBL ;INITIALIZE LAB TABLE102833 "RTN","C0CLABS",167,0)102834 I ^TMP("C0CCCR","LABTBL",0)'="V3" D SETTBL ;NEED NEWEST VERSION102835 "RTN","C0CLABS",168,0)102836 I '$D(^TMP("HLS",$J,1)) D GHL7 ; GET HL7 MGS IF NOT ALREADY DONE102837 "RTN","C0CLABS",169,0)102838 S C0CTAB=$NA(^TMP("C0CCCR","LABTBL")) ; BASE OF OBX TABLE102839 "RTN","C0CLABS",170,0)102840 S C0CHB=$NA(^TMP("HLS",$J))102841 "RTN","C0CLABS",171,0)102842 S C0CI=""102843 "RTN","C0CLABS",172,0)102844 S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT102845 "RTN","C0CLABS",173,0)102846 F S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI="" D ; FOR ALL RECORDS IN HL7 MSG102847 "RTN","C0CLABS",174,0)102848 . K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES102849 "RTN","C0CLABS",175,0)102850 . S C0CTYP=$P(@C0CHB@(C0CI),"|",1)102851 "RTN","C0CLABS",176,0)102852 . D LTYP(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)102853 "RTN","C0CLABS",177,0)102854 . I $G(C0CVAR("RESULTCODINGSYSTEM"))="LN" D ; gpl - for certification102855 "RTN","C0CLABS",178,0)102856 . . S C0CVAR("RESULTCODINGSYSTEM")="LOINC" ; NEED TO SPELL IT OUT102857 "RTN","C0CLABS",179,0)102858 . . N C0CRDT S C0CRDT=C0CVAR("RESULTDESCRIPTIONTEXT") ; THE DESCRIPTION102859 "RTN","C0CLABS",180,0)102860 . . N C0CRCD S C0CRCD=C0CVAR("RESULTCODE") ; THE LOINC CODE102861 "RTN","C0CLABS",181,0)102862 . . S C0CVAR("RESULTDESCRIPTIONTEXT")=C0CRDT_" LOINC: "_C0CRCD102863 "RTN","C0CLABS",182,0)102864 . M XV=C0CVAR ;102865 "RTN","C0CLABS",183,0)102866 . I C0CTYP="OBR" D ; BEGINNING OF NEW SECTION102867 "RTN","C0CLABS",184,0)102868 . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT102869 "RTN","C0CLABS",185,0)102870 . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT102871 "RTN","C0CLABS",186,0)102872 . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS102873 "RTN","C0CLABS",187,0)102874 . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI102875 "RTN","C0CLABS",188,0)102876 . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR102877 "RTN","C0CLABS",189,0)102878 . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)102879 "RTN","C0CLABS",190,0)102880 . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT102881 "RTN","C0CLABS",191,0)102882 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL102883 "RTN","C0CLABS",192,0)102884 . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME102885 "RTN","C0CLABS",193,0)102886 . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS102887 "RTN","C0CLABS",194,0)102888 . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION102889 "RTN","C0CLABS",195,0)102890 . I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX3102891 "RTN","C0CLABS",196,0)102892 . . ; RESULTTESTCODEVALUE102893 "RTN","C0CLABS",197,0)102894 . . ; RESULTTESTDESCRIPTIONTEXT102895 "RTN","C0CLABS",198,0)102896 . . I C0CVAR("C3")="LN" D ; PRIMARY CODE IS LOINC102897 "RTN","C0CLABS",199,0)102898 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE LOINC CODE VALUE102899 "RTN","C0CLABS",200,0)102900 . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC102901 "RTN","C0CLABS",201,0)102902 . . . ;S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESC TXT102903 "RTN","C0CLABS",202,0)102904 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2")_" LOINC: "_C0CVAR("C1")102905 "RTN","C0CLABS",203,0)102906 . . E I C0CVAR("C6")="LN" D ; SECONDARY CODE IS LOINC102907 "RTN","C0CLABS",204,0)102908 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; THE LOINC CODE VALUE102909 "RTN","C0CLABS",205,0)102910 . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC102911 "RTN","C0CLABS",206,0)102912 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; DESCRIPTION TEXT102913 "RTN","C0CLABS",207,0)102914 . . E I C0CVAR("C6")'="" D ; NO LOINC CODES, USE SECONDARY IF PRESENT102915 "RTN","C0CLABS",208,0)102916 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE102917 "RTN","C0CLABS",209,0)102918 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME102919 "RTN","C0CLABS",210,0)102920 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT102921 "RTN","C0CLABS",211,0)102922 . . E D ; NO SECONDARY, USE PRIMARY102923 "RTN","C0CLABS",212,0)102924 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE102925 "RTN","C0CLABS",213,0)102926 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME102927 "RTN","C0CLABS",214,0)102928 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT102929 "RTN","C0CLABS",215,0)102930 . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;102931 "RTN","C0CLABS",216,0)102932 . . ; mod to remove local XML escaping rely upon MAP^C0CXPATH102933 "RTN","C0CLABS",217,0)102934 . . ;S XV("RESULTTESTNORMALDESCTEXT")=$$SYMENC^MXMLUTL(C0CZG) ;ESCAPE102935 "RTN","C0CLABS",218,0)102936 . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG102937 "RTN","C0CLABS",219,0)102938 . . S C0CZG=XV("RESULTTESTVALUE")102939 "RTN","C0CLABS",220,0)102940 . . ; mod to remove local XML escaping rely upon MAP^C0CXPATH102941 "RTN","C0CLABS",221,0)102942 . . ;S XV("RESULTTESTVALUE")=$$SYMENC^MXMLUTL(C0CZG) ;ESCAPE102943 "RTN","C0CLABS",222,0)102944 . . S XV("RESULTTESTVALUE")=C0CZG102945 "RTN","C0CLABS",223,0)102946 . I C0CTYP="OBX" D ; PROCESS TEST RESULTS102947 "RTN","C0CLABS",224,0)102948 . . I C0CLOBX=0 D ; FIRST TEST RESULT FOR THIS SECTION102949 "RTN","C0CLABS",225,0)102950 . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS102951 "RTN","C0CLABS",226,0)102952 . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT102953 "RTN","C0CLABS",227,0)102954 . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT102955 "RTN","C0CLABS",228,0)102956 . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX102957 "RTN","C0CLABS",229,0)102958 . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE102959 "RTN","C0CLABS",230,0)102960 . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER102961 "RTN","C0CLABS",231,0)102962 . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2102963 "RTN","C0CLABS",232,0)102964 . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")102965 "RTN","C0CLABS",233,0)102966 . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT102967 "RTN","C0CLABS",234,0)102968 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL102969 "RTN","C0CLABS",235,0)102970 . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME102971 "RTN","C0CLABS",236,0)102972 . . ; I 'C0CQT ZWR XV102973 "RTN","C0CLABS",237,0)102974 . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES102975 "RTN","C0CLABS",238,0)102976 . I 'C0CQT D ;102977 "RTN","C0CLABS",239,0)102978 . . W C0CI," ",C0CTYP,!102979 "RTN","C0CLABS",240,0)102980 . ; S C0CI=$O(@C0CHB@(C0CI))102981 103023 "RTN","C0CLABS",241,0) 102982 ;K ^TMP("C0CRIM","VARS",DFN,"RESULTS") 103024 LTYP(OSEG,OTYP,OVARA,OC0CQT) ; 102983 103025 "RTN","C0CLABS",242,0) 102984 ;M ^TMP("C0CRIM","VARS",DFN,"RESULTS")=@C0CLB103026 S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE 102985 103027 "RTN","C0CLABS",243,0) 103028 I '$D(OC0CQT) S C0CQT=0 ; NOT C0CQT IS DEFAULT 103029 "RTN","C0CLABS",244,0) 103030 E S C0CQT=OC0CQT ; ACCEPT C0CQT FLAG 103031 "RTN","C0CLABS",245,0) 103032 I 1 D ; FOR HL7 SEGMENT TYPE 103033 "RTN","C0CLABS",246,0) 103034 . S OI="" ; INDEX INTO FIELDS IN SEG 103035 "RTN","C0CLABS",247,0) 103036 . F S OI=$O(@OTAB@(OI)) Q:OI="" D ; FOR EACH FIELD OF THE SEGMENT 103037 "RTN","C0CLABS",248,0) 103038 . . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX 103039 "RTN","C0CLABS",249,0) 103040 . . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED 103041 "RTN","C0CLABS",250,0) 103042 . . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE 103043 "RTN","C0CLABS",251,0) 103044 . . I $P(OI,";",2)'="" D ; THIS IS DEFINING A SUB-VALUE 103045 "RTN","C0CLABS",252,0) 103046 . . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX 103047 "RTN","C0CLABS",253,0) 103048 . . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE 103049 "RTN","C0CLABS",254,0) 103050 . . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE 103051 "RTN","C0CLABS",255,0) 103052 . . I 'C0CQT D ; PRINT OUTPUT IF C0CQT IS FALSE 103053 "RTN","C0CLABS",256,0) 103054 . . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,! 103055 "RTN","C0CLABS",257,0) 102986 103056 Q 102987 "RTN","C0CLABS",244,0)102988 LTYP(OSEG,OTYP,OVARA,OC0CQT) ;102989 "RTN","C0CLABS",245,0)102990 S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE102991 "RTN","C0CLABS",246,0)102992 I '$D(OC0CQT) S C0CQT=0 ; NOT C0CQT IS DEFAULT102993 "RTN","C0CLABS",247,0)102994 E S C0CQT=OC0CQT ; ACCEPT C0CQT FLAG102995 "RTN","C0CLABS",248,0)102996 I 1 D ; FOR HL7 SEGMENT TYPE102997 "RTN","C0CLABS",249,0)102998 . S OI="" ; INDEX INTO FIELDS IN SEG102999 "RTN","C0CLABS",250,0)103000 . F S OI=$O(@OTAB@(OI)) Q:OI="" D ; FOR EACH FIELD OF THE SEGMENT103001 "RTN","C0CLABS",251,0)103002 . . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX103003 "RTN","C0CLABS",252,0)103004 . . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED103005 "RTN","C0CLABS",253,0)103006 . . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE103007 "RTN","C0CLABS",254,0)103008 . . I $P(OI,";",2)'="" D ; THIS IS DEFINING A SUB-VALUE103009 "RTN","C0CLABS",255,0)103010 . . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX103011 "RTN","C0CLABS",256,0)103012 . . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE103013 "RTN","C0CLABS",257,0)103014 . . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE103015 103057 "RTN","C0CLABS",258,0) 103016 . . I 'C0CQT D ; PRINT OUTPUT IF C0CQT IS FALSE 103058 LOBX ; 103017 103059 "RTN","C0CLABS",259,0) 103018 . . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,!103060 Q 103019 103061 "RTN","C0CLABS",260,0) 103062 ; 103063 "RTN","C0CLABS",261,0) 103064 OUT(DFN) ; WRITE OUT A CCR THAT HAS JUST BEEN PROCESSED (FOR TESTING) 103065 "RTN","C0CLABS",262,0) 103066 N GA,GF,GD 103067 "RTN","C0CLABS",263,0) 103068 S GA=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1)) 103069 "RTN","C0CLABS",264,0) 103070 S GF="RPMS_CCR_"_DFN_"_"_DT_".xml" 103071 "RTN","C0CLABS",265,0) 103072 S GD=^TMP("C0CCCR","ODIR") 103073 "RTN","C0CLABS",266,0) 103074 W $$OUTPUT^C0CXPATH(GA,GF,GD) 103075 "RTN","C0CLABS",267,0) 103020 103076 Q 103021 "RTN","C0CLABS",261,0) 103022 LOBX ; 103023 "RTN","C0CLABS",262,0) 103077 "RTN","C0CLABS",268,0) 103078 ; 103079 "RTN","C0CLABS",269,0) 103080 SETTBL ; 103081 "RTN","C0CLABS",270,0) 103082 K X ; CLEAR X 103083 "RTN","C0CLABS",271,0) 103084 S X("PID","PID1")="1^00104^Set ID - Patient ID" 103085 "RTN","C0CLABS",272,0) 103086 S X("PID","PID2")="2^00105^Patient ID (External ID)" 103087 "RTN","C0CLABS",273,0) 103088 S X("PID","PID3")="3^00106^Patient ID (Internal ID)" 103089 "RTN","C0CLABS",274,0) 103090 S X("PID","PID4")="4^00107^Alternate Patient ID" 103091 "RTN","C0CLABS",275,0) 103092 S X("PID","PID5")="5^00108^Patient's Name" 103093 "RTN","C0CLABS",276,0) 103094 S X("PID","PID6")="6^00109^Mother's Maiden Name" 103095 "RTN","C0CLABS",277,0) 103096 S X("PID","PID7")="7^00110^Date of Birth" 103097 "RTN","C0CLABS",278,0) 103098 S X("PID","PID8")="8^00111^Sex" 103099 "RTN","C0CLABS",279,0) 103100 S X("PID","PID9")="9^00112^Patient Alias" 103101 "RTN","C0CLABS",280,0) 103102 S X("PID","PID10")="10^00113^Race" 103103 "RTN","C0CLABS",281,0) 103104 S X("PID","PID11")="11^00114^Patient Address" 103105 "RTN","C0CLABS",282,0) 103106 S X("PID","PID12")="12^00115^County Code" 103107 "RTN","C0CLABS",283,0) 103108 S X("PID","PID13")="13^00116^Phone Number - Home" 103109 "RTN","C0CLABS",284,0) 103110 S X("PID","PID14")="14^00117^Phone Number - Business" 103111 "RTN","C0CLABS",285,0) 103112 S X("PID","PID15")="15^00118^Language - Patient" 103113 "RTN","C0CLABS",286,0) 103114 S X("PID","PID16")="16^00119^Marital Status" 103115 "RTN","C0CLABS",287,0) 103116 S X("PID","PID17")="17^00120^Religion" 103117 "RTN","C0CLABS",288,0) 103118 S X("PID","PID18")="18^00121^Patient Account Number" 103119 "RTN","C0CLABS",289,0) 103120 S X("PID","PID19")="19^00122^SSN Number - Patient" 103121 "RTN","C0CLABS",290,0) 103122 S X("PID","PID20")="20^00123^Drivers License - Patient" 103123 "RTN","C0CLABS",291,0) 103124 S X("PID","PID21")="21^00124^Mother's Identifier" 103125 "RTN","C0CLABS",292,0) 103126 S X("PID","PID22")="22^00125^Ethnic Group" 103127 "RTN","C0CLABS",293,0) 103128 S X("PID","PID23")="23^00126^Birth Place" 103129 "RTN","C0CLABS",294,0) 103130 S X("PID","PID24")="24^00127^Multiple Birth Indicator" 103131 "RTN","C0CLABS",295,0) 103132 S X("PID","PID25")="25^00128^Birth Order" 103133 "RTN","C0CLABS",296,0) 103134 S X("PID","PID26")="26^00129^Citizenship" 103135 "RTN","C0CLABS",297,0) 103136 S X("PID","PID27")="27^00130^Veteran.s Military Status" 103137 "RTN","C0CLABS",298,0) 103138 S X("PID","PID28")="28^00739^Nationality" 103139 "RTN","C0CLABS",299,0) 103140 S X("PID","PID29")="29^00740^Patient Death Date/Time" 103141 "RTN","C0CLABS",300,0) 103142 S X("PID","PID30")="30^00741^Patient Death Indicator" 103143 "RTN","C0CLABS",301,0) 103144 S X("NTE","NTE1")="1^00573^Set ID - NTE" 103145 "RTN","C0CLABS",302,0) 103146 S X("NTE","NTE2")="2^00574^Source of Comment" 103147 "RTN","C0CLABS",303,0) 103148 S X("NTE","NTE3")="3^00575^Comment" 103149 "RTN","C0CLABS",304,0) 103150 S X("ORC","ORC1")="1^00215^Order Control" 103151 "RTN","C0CLABS",305,0) 103152 S X("ORC","ORC2")="2^00216^Placer Order Number" 103153 "RTN","C0CLABS",306,0) 103154 S X("ORC","ORC3")="3^00217^Filler Order Number" 103155 "RTN","C0CLABS",307,0) 103156 S X("ORC","ORC4")="4^00218^Placer Order Number" 103157 "RTN","C0CLABS",308,0) 103158 S X("ORC","ORC5")="5^00219^Order Status" 103159 "RTN","C0CLABS",309,0) 103160 S X("ORC","ORC6")="6^00220^Response Flag" 103161 "RTN","C0CLABS",310,0) 103162 S X("ORC","ORC7")="7^00221^Quantity/Timing" 103163 "RTN","C0CLABS",311,0) 103164 S X("ORC","ORC8")="8^00222^Parent" 103165 "RTN","C0CLABS",312,0) 103166 S X("ORC","ORC9")="9^00223^Date/Time of Transaction" 103167 "RTN","C0CLABS",313,0) 103168 S X("ORC","ORC10")="10^00224^Entered By" 103169 "RTN","C0CLABS",314,0) 103170 S X("ORC","ORC11")="11^00225^Verified By" 103171 "RTN","C0CLABS",315,0) 103172 S X("ORC","ORC12")="12^00226^Ordering Provider" 103173 "RTN","C0CLABS",316,0) 103174 S X("ORC","ORC13")="13^00227^Enterer's Location" 103175 "RTN","C0CLABS",317,0) 103176 S X("ORC","ORC14")="14^00228^Call Back Phone Number" 103177 "RTN","C0CLABS",318,0) 103178 S X("ORC","ORC15")="15^00229^Order Effective Date/Time" 103179 "RTN","C0CLABS",319,0) 103180 S X("ORC","ORC16")="16^00230^Order Control Code Reason" 103181 "RTN","C0CLABS",320,0) 103182 S X("ORC","ORC17")="17^00231^Entering Organization" 103183 "RTN","C0CLABS",321,0) 103184 S X("ORC","ORC18")="18^00232^Entering Device" 103185 "RTN","C0CLABS",322,0) 103186 S X("ORC","ORC19")="19^00233^Action By" 103187 "RTN","C0CLABS",323,0) 103188 S X("OBR","OBR1")="1^00237^Set ID - Observation Request" 103189 "RTN","C0CLABS",324,0) 103190 S X("OBR","OBR2")="2^00216^Placer Order Number" 103191 "RTN","C0CLABS",325,0) 103192 S X("OBR","OBR3")="3^00217^Filler Order Number" 103193 "RTN","C0CLABS",326,0) 103194 S X("OBR","OBR4")="4^00238^Universal Service ID" 103195 "RTN","C0CLABS",327,0) 103196 S X("OBR","OBR4;LOINC")="4;1^00238^Universal Service ID - LOINC^RESULTCODE" 103197 "RTN","C0CLABS",328,0) 103198 S X("OBR","OBR4;DESC")="4;2^00238^Universal Service ID - DESC^RESULTDESCRIPTIONTEXT" 103199 "RTN","C0CLABS",329,0) 103200 S X("OBR","OBR4;VACODE")="4;3^00238^Universal Service ID - VACODE^RESULTCODINGSYSTEM" 103201 "RTN","C0CLABS",330,0) 103202 S X("OBR","OBR5")="5^00239^Priority" 103203 "RTN","C0CLABS",331,0) 103204 S X("OBR","OBR6")="6^00240^Requested Date/Time" 103205 "RTN","C0CLABS",332,0) 103206 S X("OBR","OBR7")="7^00241^Observation Date/Time^RESULTASSESSMENTDATETIME" 103207 "RTN","C0CLABS",333,0) 103208 S X("OBR","OBR8")="8^00242^Observation End Date/Time" 103209 "RTN","C0CLABS",334,0) 103210 S X("OBR","OBR9")="9^00243^Collection Volume" 103211 "RTN","C0CLABS",335,0) 103212 S X("OBR","OBR10")="10^00244^Collector Identifier" 103213 "RTN","C0CLABS",336,0) 103214 S X("OBR","OBR11")="11^00245^Specimen Action Code" 103215 "RTN","C0CLABS",337,0) 103216 S X("OBR","OBR12")="12^00246^Danger Code" 103217 "RTN","C0CLABS",338,0) 103218 S X("OBR","OBR13")="13^00247^Relevant Clinical Info." 103219 "RTN","C0CLABS",339,0) 103220 S X("OBR","OBR14")="14^00248^Specimen Rcv'd. Date/Time" 103221 "RTN","C0CLABS",340,0) 103222 S X("OBR","OBR15")="15^00249^Specimen Source" 103223 "RTN","C0CLABS",341,0) 103224 S X("OBR","OBR16")="16^00226^Ordering Provider XCN^RESULTSOURCEACTORID" 103225 "RTN","C0CLABS",342,0) 103226 S X("OBR","OBR17")="17^00250^Order Callback Phone Number" 103227 "RTN","C0CLABS",343,0) 103228 S X("OBR","OBR18")="18^00251^Placers Field 1" 103229 "RTN","C0CLABS",344,0) 103230 S X("OBR","OBR19")="19^00252^Placers Field 2" 103231 "RTN","C0CLABS",345,0) 103232 S X("OBR","OBR20")="20^00253^Filler Field 1" 103233 "RTN","C0CLABS",346,0) 103234 S X("OBR","OBR21")="21^00254^Filler Field 2" 103235 "RTN","C0CLABS",347,0) 103236 S X("OBR","OBR22")="22^00255^Results Rpt./Status Change" 103237 "RTN","C0CLABS",348,0) 103238 S X("OBR","OBR23")="23^00256^Charge to Practice" 103239 "RTN","C0CLABS",349,0) 103240 S X("OBR","OBR24")="24^00257^Diagnostic Service Sect" 103241 "RTN","C0CLABS",350,0) 103242 S X("OBR","OBR25")="25^00258^Result Status^RESULTSTATUS" 103243 "RTN","C0CLABS",351,0) 103244 S X("OBR","OBR26")="26^00259^Parent Result" 103245 "RTN","C0CLABS",352,0) 103246 S X("OBR","OBR27")="27^00221^Quantity/Timing" 103247 "RTN","C0CLABS",353,0) 103248 S X("OBR","OBR28")="28^00260^Result Copies to" 103249 "RTN","C0CLABS",354,0) 103250 S X("OBR","OBR29")="29^00261^Parent Number" 103251 "RTN","C0CLABS",355,0) 103252 S X("OBR","OBR30")="30^00262^Transportation Mode" 103253 "RTN","C0CLABS",356,0) 103254 S X("OBR","OBR31")="31^00263^Reason for Study" 103255 "RTN","C0CLABS",357,0) 103256 S X("OBR","OBR32")="32^00264^Principal Result Interpreter" 103257 "RTN","C0CLABS",358,0) 103258 S X("OBR","OBR33")="33^00265^Assistant Result Interpreter" 103259 "RTN","C0CLABS",359,0) 103260 S X("OBR","OBR34")="34^00266^Technician" 103261 "RTN","C0CLABS",360,0) 103262 S X("OBR","OBR35")="35^00267^Transcriptionist" 103263 "RTN","C0CLABS",361,0) 103264 S X("OBR","OBR36")="36^00268^Scheduled Date/Time" 103265 "RTN","C0CLABS",362,0) 103266 S X("OBR","OBR37")="37^01028^Number of Sample Containers" 103267 "RTN","C0CLABS",363,0) 103268 S X("OBR","OBR38")="38^38^01029 Transport Logistics of Collected Sample" 103269 "RTN","C0CLABS",364,0) 103270 S X("OBR","OBR39")="39^01030^Collector.s Comment" 103271 "RTN","C0CLABS",365,0) 103272 S X("OBR","OBR40")="40^01031^Transport Arrangement Responsibility" 103273 "RTN","C0CLABS",366,0) 103274 S X("OBR","OBR41")="41^01032^Transport Arranged" 103275 "RTN","C0CLABS",367,0) 103276 S X("OBR","OBR42")="42^01033^Escort Required" 103277 "RTN","C0CLABS",368,0) 103278 S X("OBR","OBR43")="43^01034^Planned Patient Transport Comment" 103279 "RTN","C0CLABS",369,0) 103280 S X("OBX","OBX1")="1^00559^Set ID - OBX" 103281 "RTN","C0CLABS",370,0) 103282 S X("OBX","OBX2")="2^00676^Value Type" 103283 "RTN","C0CLABS",371,0) 103284 S X("OBX","OBX3")="3^00560^Observation Identifier" 103285 "RTN","C0CLABS",372,0) 103286 S X("OBX","OBX3;C1")="3;1^00560^Observation Identifier^C1" 103287 "RTN","C0CLABS",373,0) 103288 S X("OBX","OBX3;C2")="3;2^00560^Observation Identifier^C2" 103289 "RTN","C0CLABS",374,0) 103290 S X("OBX","OBX3;C3")="3;3^00560^Observation Identifier^C3" 103291 "RTN","C0CLABS",375,0) 103292 S X("OBX","OBX3;C4")="3;4^00560^Observation Identifier^C4" 103293 "RTN","C0CLABS",376,0) 103294 S X("OBX","OBX3;C5")="3;5^00560^Observation Identifier^C5" 103295 "RTN","C0CLABS",377,0) 103296 S X("OBX","OBX3;C6")="3;6^00560^Observation Identifier^C6" 103297 "RTN","C0CLABS",378,0) 103298 S X("OBX","OBX4")="4^00769^Observation Sub-Id" 103299 "RTN","C0CLABS",379,0) 103300 S X("OBX","OBX5")="5^00561^Observation Results^RESULTTESTVALUE" 103301 "RTN","C0CLABS",380,0) 103302 S X("OBX","OBX6")="6^00562^Units^RESULTTESTUNITS" 103303 "RTN","C0CLABS",381,0) 103304 S X("OBX","OBX7")="7^00563^Reference Range^RESULTTESTNORMALDESCTEXT" 103305 "RTN","C0CLABS",382,0) 103306 S X("OBX","OBX8")="8^00564^Abnormal Flags^RESULTTESTFLAG" 103307 "RTN","C0CLABS",383,0) 103308 S X("OBX","OBX9")="9^00639^Probability" 103309 "RTN","C0CLABS",384,0) 103310 S X("OBX","OBX10")="10^00565^Nature of Abnormal Test" 103311 "RTN","C0CLABS",385,0) 103312 S X("OBX","OBX11")="11^00566^Observ. Result Status^RESULTTESTSTATUSTEXT" 103313 "RTN","C0CLABS",386,0) 103314 S X("OBX","OBX12")="12^00567^Date Last Normal Value" 103315 "RTN","C0CLABS",387,0) 103316 S X("OBX","OBX13")="13^00581^User Defined Access Checks" 103317 "RTN","C0CLABS",388,0) 103318 S X("OBX","OBX14")="14^00582^Date/Time of Observation^RESULTTESTDATETIME" 103319 "RTN","C0CLABS",389,0) 103320 S X("OBX","OBX15")="15^00583^Producer.s ID^RESULTTESTSOURCEACTORID" 103321 "RTN","C0CLABS",390,0) 103322 S X("OBX","OBX16")="16^00584^Responsible Observer" 103323 "RTN","C0CLABS",391,0) 103324 S X("OBX","OBX17")="17^00936^Observation Method" 103325 "RTN","C0CLABS",392,0) 103326 K ^TMP("C0CCCR","LABTBL") 103327 "RTN","C0CLABS",393,0) 103328 M ^TMP("C0CCCR","LABTBL")=X ; SET VALUES IN LAB TBL 103329 "RTN","C0CLABS",394,0) 103330 S ^TMP("C0CCCR","LABTBL",0)="V3" 103331 "RTN","C0CLABS",395,0) 103024 103332 Q 103025 "RTN","C0CLABS",263,0)103026 ;103027 "RTN","C0CLABS",264,0)103028 OUT(DFN) ; WRITE OUT A CCR THAT HAS JUST BEEN PROCESSED (FOR TESTING)103029 "RTN","C0CLABS",265,0)103030 N GA,GF,GD103031 "RTN","C0CLABS",266,0)103032 S GA=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1))103033 "RTN","C0CLABS",267,0)103034 S GF="RPMS_CCR_"_DFN_"_"_DT_".xml"103035 "RTN","C0CLABS",268,0)103036 S GD=^TMP("C0CCCR","ODIR")103037 "RTN","C0CLABS",269,0)103038 W $$OUTPUT^C0CXPATH(GA,GF,GD)103039 "RTN","C0CLABS",270,0)103040 Q103041 "RTN","C0CLABS",271,0)103042 ;103043 "RTN","C0CLABS",272,0)103044 SETTBL ;103045 "RTN","C0CLABS",273,0)103046 K X ; CLEAR X103047 "RTN","C0CLABS",274,0)103048 S X("PID","PID1")="1^00104^Set ID - Patient ID"103049 "RTN","C0CLABS",275,0)103050 S X("PID","PID2")="2^00105^Patient ID (External ID)"103051 "RTN","C0CLABS",276,0)103052 S X("PID","PID3")="3^00106^Patient ID (Internal ID)"103053 "RTN","C0CLABS",277,0)103054 S X("PID","PID4")="4^00107^Alternate Patient ID"103055 "RTN","C0CLABS",278,0)103056 S X("PID","PID5")="5^00108^Patient's Name"103057 "RTN","C0CLABS",279,0)103058 S X("PID","PID6")="6^00109^Mother's Maiden Name"103059 "RTN","C0CLABS",280,0)103060 S X("PID","PID7")="7^00110^Date of Birth"103061 "RTN","C0CLABS",281,0)103062 S X("PID","PID8")="8^00111^Sex"103063 "RTN","C0CLABS",282,0)103064 S X("PID","PID9")="9^00112^Patient Alias"103065 "RTN","C0CLABS",283,0)103066 S X("PID","PID10")="10^00113^Race"103067 "RTN","C0CLABS",284,0)103068 S X("PID","PID11")="11^00114^Patient Address"103069 "RTN","C0CLABS",285,0)103070 S X("PID","PID12")="12^00115^County Code"103071 "RTN","C0CLABS",286,0)103072 S X("PID","PID13")="13^00116^Phone Number - Home"103073 "RTN","C0CLABS",287,0)103074 S X("PID","PID14")="14^00117^Phone Number - Business"103075 "RTN","C0CLABS",288,0)103076 S X("PID","PID15")="15^00118^Language - Patient"103077 "RTN","C0CLABS",289,0)103078 S X("PID","PID16")="16^00119^Marital Status"103079 "RTN","C0CLABS",290,0)103080 S X("PID","PID17")="17^00120^Religion"103081 "RTN","C0CLABS",291,0)103082 S X("PID","PID18")="18^00121^Patient Account Number"103083 "RTN","C0CLABS",292,0)103084 S X("PID","PID19")="19^00122^SSN Number - Patient"103085 "RTN","C0CLABS",293,0)103086 S X("PID","PID20")="20^00123^Drivers License - Patient"103087 "RTN","C0CLABS",294,0)103088 S X("PID","PID21")="21^00124^Mother's Identifier"103089 "RTN","C0CLABS",295,0)103090 S X("PID","PID22")="22^00125^Ethnic Group"103091 "RTN","C0CLABS",296,0)103092 S X("PID","PID23")="23^00126^Birth Place"103093 "RTN","C0CLABS",297,0)103094 S X("PID","PID24")="24^00127^Multiple Birth Indicator"103095 "RTN","C0CLABS",298,0)103096 S X("PID","PID25")="25^00128^Birth Order"103097 "RTN","C0CLABS",299,0)103098 S X("PID","PID26")="26^00129^Citizenship"103099 "RTN","C0CLABS",300,0)103100 S X("PID","PID27")="27^00130^Veteran.s Military Status"103101 "RTN","C0CLABS",301,0)103102 S X("PID","PID28")="28^00739^Nationality"103103 "RTN","C0CLABS",302,0)103104 S X("PID","PID29")="29^00740^Patient Death Date/Time"103105 "RTN","C0CLABS",303,0)103106 S X("PID","PID30")="30^00741^Patient Death Indicator"103107 "RTN","C0CLABS",304,0)103108 S X("NTE","NTE1")="1^00573^Set ID - NTE"103109 "RTN","C0CLABS",305,0)103110 S X("NTE","NTE2")="2^00574^Source of Comment"103111 "RTN","C0CLABS",306,0)103112 S X("NTE","NTE3")="3^00575^Comment"103113 "RTN","C0CLABS",307,0)103114 S X("ORC","ORC1")="1^00215^Order Control"103115 "RTN","C0CLABS",308,0)103116 S X("ORC","ORC2")="2^00216^Placer Order Number"103117 "RTN","C0CLABS",309,0)103118 S X("ORC","ORC3")="3^00217^Filler Order Number"103119 "RTN","C0CLABS",310,0)103120 S X("ORC","ORC4")="4^00218^Placer Order Number"103121 "RTN","C0CLABS",311,0)103122 S X("ORC","ORC5")="5^00219^Order Status"103123 "RTN","C0CLABS",312,0)103124 S X("ORC","ORC6")="6^00220^Response Flag"103125 "RTN","C0CLABS",313,0)103126 S X("ORC","ORC7")="7^00221^Quantity/Timing"103127 "RTN","C0CLABS",314,0)103128 S X("ORC","ORC8")="8^00222^Parent"103129 "RTN","C0CLABS",315,0)103130 S X("ORC","ORC9")="9^00223^Date/Time of Transaction"103131 "RTN","C0CLABS",316,0)103132 S X("ORC","ORC10")="10^00224^Entered By"103133 "RTN","C0CLABS",317,0)103134 S X("ORC","ORC11")="11^00225^Verified By"103135 "RTN","C0CLABS",318,0)103136 S X("ORC","ORC12")="12^00226^Ordering Provider"103137 "RTN","C0CLABS",319,0)103138 S X("ORC","ORC13")="13^00227^Enterer's Location"103139 "RTN","C0CLABS",320,0)103140 S X("ORC","ORC14")="14^00228^Call Back Phone Number"103141 "RTN","C0CLABS",321,0)103142 S X("ORC","ORC15")="15^00229^Order Effective Date/Time"103143 "RTN","C0CLABS",322,0)103144 S X("ORC","ORC16")="16^00230^Order Control Code Reason"103145 "RTN","C0CLABS",323,0)103146 S X("ORC","ORC17")="17^00231^Entering Organization"103147 "RTN","C0CLABS",324,0)103148 S X("ORC","ORC18")="18^00232^Entering Device"103149 "RTN","C0CLABS",325,0)103150 S X("ORC","ORC19")="19^00233^Action By"103151 "RTN","C0CLABS",326,0)103152 S X("OBR","OBR1")="1^00237^Set ID - Observation Request"103153 "RTN","C0CLABS",327,0)103154 S X("OBR","OBR2")="2^00216^Placer Order Number"103155 "RTN","C0CLABS",328,0)103156 S X("OBR","OBR3")="3^00217^Filler Order Number"103157 "RTN","C0CLABS",329,0)103158 S X("OBR","OBR4")="4^00238^Universal Service ID"103159 "RTN","C0CLABS",330,0)103160 S X("OBR","OBR4;LOINC")="4;1^00238^Universal Service ID - LOINC^RESULTCODE"103161 "RTN","C0CLABS",331,0)103162 S X("OBR","OBR4;DESC")="4;2^00238^Universal Service ID - DESC^RESULTDESCRIPTIONTEXT"103163 "RTN","C0CLABS",332,0)103164 S X("OBR","OBR4;VACODE")="4;3^00238^Universal Service ID - VACODE^RESULTCODINGSYSTEM"103165 "RTN","C0CLABS",333,0)103166 S X("OBR","OBR5")="5^00239^Priority"103167 "RTN","C0CLABS",334,0)103168 S X("OBR","OBR6")="6^00240^Requested Date/Time"103169 "RTN","C0CLABS",335,0)103170 S X("OBR","OBR7")="7^00241^Observation Date/Time^RESULTASSESSMENTDATETIME"103171 "RTN","C0CLABS",336,0)103172 S X("OBR","OBR8")="8^00242^Observation End Date/Time"103173 "RTN","C0CLABS",337,0)103174 S X("OBR","OBR9")="9^00243^Collection Volume"103175 "RTN","C0CLABS",338,0)103176 S X("OBR","OBR10")="10^00244^Collector Identifier"103177 "RTN","C0CLABS",339,0)103178 S X("OBR","OBR11")="11^00245^Specimen Action Code"103179 "RTN","C0CLABS",340,0)103180 S X("OBR","OBR12")="12^00246^Danger Code"103181 "RTN","C0CLABS",341,0)103182 S X("OBR","OBR13")="13^00247^Relevant Clinical Info."103183 "RTN","C0CLABS",342,0)103184 S X("OBR","OBR14")="14^00248^Specimen Rcv'd. Date/Time"103185 "RTN","C0CLABS",343,0)103186 S X("OBR","OBR15")="15^00249^Specimen Source"103187 "RTN","C0CLABS",344,0)103188 S X("OBR","OBR16")="16^00226^Ordering Provider XCN^RESULTSOURCEACTORID"103189 "RTN","C0CLABS",345,0)103190 S X("OBR","OBR17")="17^00250^Order Callback Phone Number"103191 "RTN","C0CLABS",346,0)103192 S X("OBR","OBR18")="18^00251^Placers Field 1"103193 "RTN","C0CLABS",347,0)103194 S X("OBR","OBR19")="19^00252^Placers Field 2"103195 "RTN","C0CLABS",348,0)103196 S X("OBR","OBR20")="20^00253^Filler Field 1"103197 "RTN","C0CLABS",349,0)103198 S X("OBR","OBR21")="21^00254^Filler Field 2"103199 "RTN","C0CLABS",350,0)103200 S X("OBR","OBR22")="22^00255^Results Rpt./Status Change"103201 "RTN","C0CLABS",351,0)103202 S X("OBR","OBR23")="23^00256^Charge to Practice"103203 "RTN","C0CLABS",352,0)103204 S X("OBR","OBR24")="24^00257^Diagnostic Service Sect"103205 "RTN","C0CLABS",353,0)103206 S X("OBR","OBR25")="25^00258^Result Status^RESULTSTATUS"103207 "RTN","C0CLABS",354,0)103208 S X("OBR","OBR26")="26^00259^Parent Result"103209 "RTN","C0CLABS",355,0)103210 S X("OBR","OBR27")="27^00221^Quantity/Timing"103211 "RTN","C0CLABS",356,0)103212 S X("OBR","OBR28")="28^00260^Result Copies to"103213 "RTN","C0CLABS",357,0)103214 S X("OBR","OBR29")="29^00261^Parent Number"103215 "RTN","C0CLABS",358,0)103216 S X("OBR","OBR30")="30^00262^Transportation Mode"103217 "RTN","C0CLABS",359,0)103218 S X("OBR","OBR31")="31^00263^Reason for Study"103219 "RTN","C0CLABS",360,0)103220 S X("OBR","OBR32")="32^00264^Principal Result Interpreter"103221 "RTN","C0CLABS",361,0)103222 S X("OBR","OBR33")="33^00265^Assistant Result Interpreter"103223 "RTN","C0CLABS",362,0)103224 S X("OBR","OBR34")="34^00266^Technician"103225 "RTN","C0CLABS",363,0)103226 S X("OBR","OBR35")="35^00267^Transcriptionist"103227 "RTN","C0CLABS",364,0)103228 S X("OBR","OBR36")="36^00268^Scheduled Date/Time"103229 "RTN","C0CLABS",365,0)103230 S X("OBR","OBR37")="37^01028^Number of Sample Containers"103231 "RTN","C0CLABS",366,0)103232 S X("OBR","OBR38")="38^38^01029 Transport Logistics of Collected Sample"103233 "RTN","C0CLABS",367,0)103234 S X("OBR","OBR39")="39^01030^Collector.s Comment"103235 "RTN","C0CLABS",368,0)103236 S X("OBR","OBR40")="40^01031^Transport Arrangement Responsibility"103237 "RTN","C0CLABS",369,0)103238 S X("OBR","OBR41")="41^01032^Transport Arranged"103239 "RTN","C0CLABS",370,0)103240 S X("OBR","OBR42")="42^01033^Escort Required"103241 "RTN","C0CLABS",371,0)103242 S X("OBR","OBR43")="43^01034^Planned Patient Transport Comment"103243 "RTN","C0CLABS",372,0)103244 S X("OBX","OBX1")="1^00559^Set ID - OBX"103245 "RTN","C0CLABS",373,0)103246 S X("OBX","OBX2")="2^00676^Value Type"103247 "RTN","C0CLABS",374,0)103248 S X("OBX","OBX3")="3^00560^Observation Identifier"103249 "RTN","C0CLABS",375,0)103250 S X("OBX","OBX3;C1")="3;1^00560^Observation Identifier^C1"103251 "RTN","C0CLABS",376,0)103252 S X("OBX","OBX3;C2")="3;2^00560^Observation Identifier^C2"103253 "RTN","C0CLABS",377,0)103254 S X("OBX","OBX3;C3")="3;3^00560^Observation Identifier^C3"103255 "RTN","C0CLABS",378,0)103256 S X("OBX","OBX3;C4")="3;4^00560^Observation Identifier^C4"103257 "RTN","C0CLABS",379,0)103258 S X("OBX","OBX3;C5")="3;5^00560^Observation Identifier^C5"103259 "RTN","C0CLABS",380,0)103260 S X("OBX","OBX3;C6")="3;6^00560^Observation Identifier^C6"103261 "RTN","C0CLABS",381,0)103262 S X("OBX","OBX4")="4^00769^Observation Sub-Id"103263 "RTN","C0CLABS",382,0)103264 S X("OBX","OBX5")="5^00561^Observation Results^RESULTTESTVALUE"103265 "RTN","C0CLABS",383,0)103266 S X("OBX","OBX6")="6^00562^Units^RESULTTESTUNITS"103267 "RTN","C0CLABS",384,0)103268 S X("OBX","OBX7")="7^00563^Reference Range^RESULTTESTNORMALDESCTEXT"103269 "RTN","C0CLABS",385,0)103270 S X("OBX","OBX8")="8^00564^Abnormal Flags^RESULTTESTFLAG"103271 "RTN","C0CLABS",386,0)103272 S X("OBX","OBX9")="9^00639^Probability"103273 "RTN","C0CLABS",387,0)103274 S X("OBX","OBX10")="10^00565^Nature of Abnormal Test"103275 "RTN","C0CLABS",388,0)103276 S X("OBX","OBX11")="11^00566^Observ. Result Status^RESULTTESTSTATUSTEXT"103277 "RTN","C0CLABS",389,0)103278 S X("OBX","OBX12")="12^00567^Date Last Normal Value"103279 "RTN","C0CLABS",390,0)103280 S X("OBX","OBX13")="13^00581^User Defined Access Checks"103281 "RTN","C0CLABS",391,0)103282 S X("OBX","OBX14")="14^00582^Date/Time of Observation^RESULTTESTDATETIME"103283 "RTN","C0CLABS",392,0)103284 S X("OBX","OBX15")="15^00583^Producer.s ID^RESULTTESTSOURCEACTORID"103285 "RTN","C0CLABS",393,0)103286 S X("OBX","OBX16")="16^00584^Responsible Observer"103287 "RTN","C0CLABS",394,0)103288 S X("OBX","OBX17")="17^00936^Observation Method"103289 "RTN","C0CLABS",395,0)103290 K ^TMP("C0CCCR","LABTBL")103291 103333 "RTN","C0CLABS",396,0) 103292 M ^TMP("C0CCCR","LABTBL")=X ; SET VALUES IN LAB TBL103293 "RTN","C0CLABS",397,0)103294 S ^TMP("C0CCCR","LABTBL",0)="V3"103295 "RTN","C0CLABS",398,0)103296 Q103297 "RTN","C0CLABS",399,0)103298 103334 ; 103299 103335 "RTN","C0CMAIL") 103300 0^81^B9 2791623103336 0^81^B91585320 103301 103337 "RTN","C0CMAIL",1,0) 103302 103338 C0CMAIL ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr 103303 103339 "RTN","C0CMAIL",2,0) 103304 V ;;1.2;C 0C;;May 11, 2012;Build 50103340 V ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 103305 103341 "RTN","C0CMAIL",3,0) 103306 103342 ;Copyright 2011 Chris Richardson, Richardson Computer Research … … 103310 103346 ; rcr@rcresearch.us 103311 103347 "RTN","C0CMAIL",6,0) 103312 ; Licensed under the terms of the GNU103348 ; 103313 103349 "RTN","C0CMAIL",7,0) 103314 ; General Public License See attached copy of the License.103350 ; This program is free software: you can redistribute it and/or modify 103315 103351 "RTN","C0CMAIL",8,0) 103316 ; 103352 ; it under the terms of the GNU Affero General Public License as 103317 103353 "RTN","C0CMAIL",9,0) 103318 ; This program is free software; you can redistribute it and/or modify103354 ; published by the Free Software Foundation, either version 3 of the 103319 103355 "RTN","C0CMAIL",10,0) 103320 ; it under the terms of the GNU General Public License as published by103356 ; License, or (at your option) any later version. 103321 103357 "RTN","C0CMAIL",11,0) 103322 ; the Free Software Foundation; either version 2 of the License, or103358 ; 103323 103359 "RTN","C0CMAIL",12,0) 103324 ; (at your option) any later version.103360 ; This program is distributed in the hope that it will be useful, 103325 103361 "RTN","C0CMAIL",13,0) 103326 ; 103362 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 103327 103363 "RTN","C0CMAIL",14,0) 103328 ; This program is distributed in the hope that it will be useful,103364 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 103329 103365 "RTN","C0CMAIL",15,0) 103330 ; but WITHOUT ANY WARRANTY; without even the implied warranty of103366 ; GNU Affero General Public License for more details. 103331 103367 "RTN","C0CMAIL",16,0) 103332 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the103368 ; 103333 103369 "RTN","C0CMAIL",17,0) 103334 ; GNU General Public License for more details.103370 ; You should have received a copy of the GNU Affero General Public License 103335 103371 "RTN","C0CMAIL",18,0) 103336 ; 103372 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 103337 103373 "RTN","C0CMAIL",19,0) 103338 ; You should have received a copy of the GNU General Public License along103374 ; 103339 103375 "RTN","C0CMAIL",20,0) 103340 ; with this program; if not, write to the Free Software Foundation, Inc.,103376 ; ------------------ 103341 103377 "RTN","C0CMAIL",21,0) 103342 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.103378 ;Entry Points 103343 103379 "RTN","C0CMAIL",22,0) 103344 ; 103380 ; GETMSG^C0CMAIL(.C0CDATA,.C0CINPUT) 103345 103381 "RTN","C0CMAIL",23,0) 103346 ; ------------------103382 ; Input: 103347 103383 "RTN","C0CMAIL",24,0) 103348 ; Entry Points103384 ; C0CINPUT = "DUZ;MAILBOX_Name[or IEN for box (comma Separated);MALL 103349 103385 "RTN","C0CMAIL",25,0) 103350 ; GETMSG^C0CMAIL(.C0CDATA,.C0CINPUT)103386 ; or "*" for all boxes, default is "IN" if missing]" 103351 103387 "RTN","C0CMAIL",26,0) 103352 ; Input:103388 ; $P(C0CINPUT,";",3)=MALL, default=NUL means "New only", 103353 103389 "RTN","C0CMAIL",27,0) 103354 ; C0CINPUT = "DUZ;MAILBOX_Name[or IEN for box (comma Separated);MALL103390 ; "*" for All or 9,999 maximum 103355 103391 "RTN","C0CMAIL",28,0) 103356 ; or "*" for all boxes, default is "IN" if missing]"103392 ; MALL?1.n = that number of the n most recent 103357 103393 "RTN","C0CMAIL",29,0) 103358 ; $P(C0CINPUT,";",3)=MALL, default=NUL means "New only",103394 ; Internally: 103359 103395 "RTN","C0CMAIL",30,0) 103360 ; "*" for All or 9,999 maximum103396 ; BNAM = Box Name 103361 103397 "RTN","C0CMAIL",31,0) 103362 ; MALL?1.n = that number of the n most recent103398 ; Output: 103363 103399 "RTN","C0CMAIL",32,0) 103364 ; Internally:103400 ; C0CDATA 103365 103401 "RTN","C0CMAIL",33,0) 103366 ; BNAM = Box Name103402 ; = (BNAM,"NUMBER") = Number of NEW Emails in Basket 103367 103403 "RTN","C0CMAIL",34,0) 103368 ; Output:103404 ; (BNAM,"MSG",C0CIEN,"FROM")=Name 103369 103405 "RTN","C0CMAIL",35,0) 103370 ; C0CDATA103406 ; (BNAM,"MSG",C0CIEN,"TO",n)=DUZ, or EMAIL Address 103371 103407 "RTN","C0CMAIL",36,0) 103372 ; = (BNAM,"NUMBER") = Number of NEW Emails in Basket103408 ; (BNAM,"MSG",C0CIEN,"TO NAME",n)=Names or EMAIL Address 103373 103409 "RTN","C0CMAIL",37,0) 103374 ; (BNAM,"MSG",C0CIEN," FROM")=Name103410 ; (BNAM,"MSG",C0CIEN,"TITLE")=EMAIL Title 103375 103411 "RTN","C0CMAIL",38,0) 103376 ; (BNAM,"MSG",C0CIEN ,"TO",n)=DUZ, or EMAIL Address103412 ; (BNAM,"MSG",C0CIEN[for File 3.9])=Number of Attachments 103377 103413 "RTN","C0CMAIL",39,0) 103378 ; (BNAM,"MSG",C0CIEN, "TO NAME",n)=Names or EMAIL Address103414 ; (BNAM,"MSG",C0CIEN,num,"CONT") = Free Text 103379 103415 "RTN","C0CMAIL",40,0) 103380 ; (BNAM,"MSG",C0CIEN, "TITLE")=EMAIL Title103416 ; (BNAM,"MSG",C0CIEN,num,"LINES") = Number of Lines of Text 103381 103417 "RTN","C0CMAIL",41,0) 103382 ; (BNAM,"MSG",C0CIEN [for File 3.9])=Number of Attachments103418 ; (BNAM,"MSG",C0CIEN,num,"SIZE") = Size of the Message in Bytes 103383 103419 "RTN","C0CMAIL",42,0) 103384 ; (BNAM,"MSG",C0CIEN,num," CONT") = Free Text103420 ; (BNAM,"MSG",C0CIEN,num,"TXT",LINE#) = Message Data (No Attachment) 103385 103421 "RTN","C0CMAIL",43,0) 103386 ; (BNAM,"MSG",C0CIEN,num,"LINES") = Number of Lines of Text103422 ; (BNAM,"MSG",C0CIEN,"SEG",NUM) = First Line^Last Line 103387 103423 "RTN","C0CMAIL",44,0) 103388 ; (BNAM,"MSG",C0CIEN,num,"SIZE") = Size of the Message in Bytes103424 ; (BNAM,"MSG",C0CIEN,"SEG",NUM,"CONT",type) = Message Details 103389 103425 "RTN","C0CMAIL",45,0) 103390 ; (BNAM,"MSG",C0CIEN,num,"TXT",LINE#) = Message Data (No Attachment)103426 ; (BNAM,"MSG",C0CIEN,"SEG",NUM,LINE#) = Message Data 103391 103427 "RTN","C0CMAIL",46,0) 103392 ; (BNAM,"MSG",C0CIEN,"SEG",NUM) = First Line^Last Line103428 ; 103393 103429 "RTN","C0CMAIL",47,0) 103394 ; (BNAM,"MSG",C0CIEN,"SEG",NUM,"CONT",type) = Message Details103430 ; DO DETAIL^C0CMAIL(.OUTBF,D0) ; For each Email Message and Attachments 103395 103431 "RTN","C0CMAIL",48,0) 103396 ; (BNAM,"MSG",C0CIEN,"SEG",NUM,LINE#) = Message Data103432 ; Input; 103397 103433 "RTN","C0CMAIL",49,0) 103434 ; D0 - The IEN for the message in file 3.9, MESSAGE global 103435 "RTN","C0CMAIL",50,0) 103436 ; Output 103437 "RTN","C0CMAIL",51,0) 103438 ; OUTBF - The array of your choice to save the expanded and decoded message. 103439 "RTN","C0CMAIL",52,0) 103398 103440 ; 103399 "RTN","C0CMAIL",50,0)103400 ; DO DETAIL^C0CMAIL(.OUTBF,D0) ; For each Email Message and Attachments103401 "RTN","C0CMAIL",51,0)103402 ; Input;103403 "RTN","C0CMAIL",52,0)103404 ; D0 - The IEN for the message in file 3.9, MESSAGE global103405 103441 "RTN","C0CMAIL",53,0) 103406 ; Output 103442 GETMSG(C0CDATA,C0CINPUT) ; Common Entry Point for Mailbox Data 103407 103443 "RTN","C0CMAIL",54,0) 103408 ; OUTBF - The array of your choice to save the expanded and decoded message.103444 K:'$G(C0CDATA("KEEP")) C0CDATA 103409 103445 "RTN","C0CMAIL",55,0) 103410 ;103446 N U 103411 103447 "RTN","C0CMAIL",56,0) 103412 GETMSG(C0CDATA,C0CINPUT) ; Common Entry Point for Mailbox Data 103448 S U="^" 103413 103449 "RTN","C0CMAIL",57,0) 103414 K:'$G(C0CDATA("KEEP")) C0CDATA103450 D:$G(C0CINPUT) 103415 103451 "RTN","C0CMAIL",58,0) 103416 N U103452 . N BF,DUZ,I,INPUT,J,L,LST,MBLST,MALL 103417 103453 "RTN","C0CMAIL",59,0) 103418 S U="^"103454 . S INPUT=C0CINPUT 103419 103455 "RTN","C0CMAIL",60,0) 103420 D:$G(C0CINPUT)103456 . S DUZ=+INPUT 103421 103457 "RTN","C0CMAIL",61,0) 103422 . N BF,DUZ,I,INPUT,J,L,LST,MBLST,MALL103458 . D:$D(^XMB(3.7,DUZ,0))#2 103423 103459 "RTN","C0CMAIL",62,0) 103424 . S INPUT=C0CINPUT103460 . . S MBLST=$P(INPUT,";",2) 103425 103461 "RTN","C0CMAIL",63,0) 103426 . S DUZ=+INPUT103462 . . S MALL=$P(INPUT,";",3) ; New or All Mail Flag 103427 103463 "RTN","C0CMAIL",64,0) 103428 . D:$D(^XMB(3.7,DUZ,0))#2103464 . . S:MALL["*" MALL=99999 103429 103465 "RTN","C0CMAIL",65,0) 103430 . . S MBLST=$P(INPUT,";",2)103466 . . ; Only one of these can be correct 103431 103467 "RTN","C0CMAIL",66,0) 103432 . . S MALL=$P(INPUT,";",3) ; New or All Mail Flag103468 . . D 103433 103469 "RTN","C0CMAIL",67,0) 103434 . . S:MALL["*" MALL=99999103470 . . . ; If nul, make it "IN" only 103435 103471 "RTN","C0CMAIL",68,0) 103436 . . ; Only one of these can be correct103472 . . . I MBLST="" D QUIT 103437 103473 "RTN","C0CMAIL",69,0) 103438 . . D103474 . . . . S MBLST("IN")=0,I=0 103439 103475 "RTN","C0CMAIL",70,0) 103440 . . . ; If nul, make it "IN" only103476 . . . . D GATHER(DUZ,"IN",.LST) 103441 103477 "RTN","C0CMAIL",71,0) 103442 . . . I MBLST="" DQUIT103478 . . . .QUIT 103443 103479 "RTN","C0CMAIL",72,0) 103444 . . . . S MBLST("IN")=0,I=0103480 . . . ; 103445 103481 "RTN","C0CMAIL",73,0) 103446 . . . . D GATHER(DUZ,"IN",.LST)103482 . . . ; If "*", Get all Mailboxes and look for New Messages 103447 103483 "RTN","C0CMAIL",74,0) 103484 . . . I MBLST["*" D QUIT 103485 "RTN","C0CMAIL",75,0) 103486 . . . . N NAM,NUM 103487 "RTN","C0CMAIL",76,0) 103488 . . . . S NUM=0 103489 "RTN","C0CMAIL",77,0) 103490 . . . . F S NUM=$O(^XMB(3.7,DUZ,2,NUM)) Q:'NUM D 103491 "RTN","C0CMAIL",78,0) 103492 . . . . . S NAM=$P(^XMB(3.7,DUZ,2,NUM,0),U) 103493 "RTN","C0CMAIL",79,0) 103494 . . . . . D GATHER(DUZ,NAM,.LST) 103495 "RTN","C0CMAIL",80,0) 103496 . . . . .QUIT 103497 "RTN","C0CMAIL",81,0) 103448 103498 . . . .QUIT 103449 "RTN","C0CMAIL", 75,0)103499 "RTN","C0CMAIL",82,0) 103450 103500 . . . ; 103451 "RTN","C0CMAIL",76,0) 103452 . . . ; If "*", Get all Mailboxes and look for New Messages 103453 "RTN","C0CMAIL",77,0) 103454 . . . I MBLST["*" D QUIT 103455 "RTN","C0CMAIL",78,0) 103456 . . . . N NAM,NUM 103457 "RTN","C0CMAIL",79,0) 103458 . . . . S NUM=0 103459 "RTN","C0CMAIL",80,0) 103460 . . . . F S NUM=$O(^XMB(3.7,DUZ,2,NUM)) Q:'NUM D 103461 "RTN","C0CMAIL",81,0) 103462 . . . . . S NAM=$P(^XMB(3.7,DUZ,2,NUM,0),U) 103463 "RTN","C0CMAIL",82,0) 103501 "RTN","C0CMAIL",83,0) 103502 . . . ; If comma separated, look for mailboxes with new messages 103503 "RTN","C0CMAIL",84,0) 103504 . . . I $L(MBLST,",")>1 D QUIT 103505 "RTN","C0CMAIL",85,0) 103506 . . . . S NAM="" 103507 "RTN","C0CMAIL",86,0) 103508 . . . . N T,V 103509 "RTN","C0CMAIL",87,0) 103510 . . . . F T=1:1:$L(MBLST,",") S V=$P(MBLST,",",T) I $L(V) D 103511 "RTN","C0CMAIL",88,0) 103512 . . . . . I V S NAM=$P($G(^XMB(3.7,DUZ,2,V,0)),U) 103513 "RTN","C0CMAIL",89,0) 103514 . . . . . S:NAM="" NAM=V 103515 "RTN","C0CMAIL",90,0) 103464 103516 . . . . . D GATHER(DUZ,NAM,.LST) 103465 "RTN","C0CMAIL", 83,0)103517 "RTN","C0CMAIL",91,0) 103466 103518 . . . . .QUIT 103467 "RTN","C0CMAIL", 84,0)103519 "RTN","C0CMAIL",92,0) 103468 103520 . . . .QUIT 103469 "RTN","C0CMAIL", 85,0)103521 "RTN","C0CMAIL",93,0) 103470 103522 . . . ; 103471 "RTN","C0CMAIL",86,0)103472 . . . ; If comma separated, look for mailboxes with new messages103473 "RTN","C0CMAIL",87,0)103474 . . . I $L(MBLST,",")>1 D QUIT103475 "RTN","C0CMAIL",88,0)103476 . . . . S NAM=""103477 "RTN","C0CMAIL",89,0)103478 . . . . N T,V103479 "RTN","C0CMAIL",90,0)103480 . . . . F T=1:1:$L(MBLST,",") S V=$P(MBLST,",",T) I $L(V) D103481 "RTN","C0CMAIL",91,0)103482 . . . . . I V S NAM=$P($G(^XMB(3.7,DUZ,2,V,0)),U)103483 "RTN","C0CMAIL",92,0)103484 . . . . . S:NAM="" NAM=V103485 "RTN","C0CMAIL",93,0)103486 . . . . . D GATHER(DUZ,NAM,.LST)103487 103523 "RTN","C0CMAIL",94,0) 103488 . . . . .QUIT103524 . . . ; If only 1 mailbox named, go get it 103489 103525 "RTN","C0CMAIL",95,0) 103490 . . . .QUIT103526 . . . I $L(MBLST) D GATHER(DUZ,MBLST,.LST) QUIT 103491 103527 "RTN","C0CMAIL",96,0) 103492 . . . ;103528 . . .QUIT 103493 103529 "RTN","C0CMAIL",97,0) 103494 . . . ; If only 1 mailbox named, go get it103530 . . MERGE C0CDATA=LST 103495 103531 "RTN","C0CMAIL",98,0) 103496 . . . I $L(MBLST) D GATHER(DUZ,MBLST,.LST)QUIT103532 . .QUIT 103497 103533 "RTN","C0CMAIL",99,0) 103498 . . .QUIT103534 .QUIT 103499 103535 "RTN","C0CMAIL",100,0) 103500 . . MERGE C0CDATA=LST103536 QUIT 103501 103537 "RTN","C0CMAIL",101,0) 103538 ; =================== 103539 "RTN","C0CMAIL",102,0) 103540 GATHER(DUZ,NAM,LST) ; Gather Data about the Baskets and their mail 103541 "RTN","C0CMAIL",103,0) 103542 N I,J,K,L 103543 "RTN","C0CMAIL",104,0) 103544 S (I,K)=0 103545 "RTN","C0CMAIL",105,0) 103546 S J=$O(^XMB(3.7,DUZ,2,"B",NAM,"")) 103547 "RTN","C0CMAIL",106,0) 103548 F S I=$O(^XMB(3.7,DUZ,2,J,1,I)) Q:'I D 103549 "RTN","C0CMAIL",107,0) 103550 . S L=$P(^XMB(3.7,DUZ,2,J,1,I,0),U,3) 103551 "RTN","C0CMAIL",108,0) 103552 . D ; :L 103553 "RTN","C0CMAIL",109,0) 103554 . . S:L K=K+1,LST(NAM,"MSG",I,"NEW")="" ; Flag NEW emails 103555 "RTN","C0CMAIL",110,0) 103556 . . S LST(NAM,"MSG",I)=L 103557 "RTN","C0CMAIL",111,0) 103558 . . D GETTYP(I) 103559 "RTN","C0CMAIL",112,0) 103502 103560 . .QUIT 103503 "RTN","C0CMAIL",1 02,0)103561 "RTN","C0CMAIL",113,0) 103504 103562 .QUIT 103505 "RTN","C0CMAIL",103,0) 103563 "RTN","C0CMAIL",114,0) 103564 S LST(NAM,"NUMBER")=K 103565 "RTN","C0CMAIL",115,0) 103506 103566 QUIT 103507 "RTN","C0CMAIL",1 04,0)103567 "RTN","C0CMAIL",116,0) 103508 103568 ; =================== 103509 "RTN","C0CMAIL",105,0)103510 GATHER(DUZ,NAM,LST) ; Gather Data about the Baskets and their mail103511 "RTN","C0CMAIL",106,0)103512 N I,J,K,L103513 "RTN","C0CMAIL",107,0)103514 S (I,K)=0103515 "RTN","C0CMAIL",108,0)103516 S J=$O(^XMB(3.7,DUZ,2,"B",NAM,""))103517 "RTN","C0CMAIL",109,0)103518 F S I=$O(^XMB(3.7,DUZ,2,J,1,I)) Q:'I D103519 "RTN","C0CMAIL",110,0)103520 . S L=$P(^XMB(3.7,DUZ,2,J,1,I,0),U,3)103521 "RTN","C0CMAIL",111,0)103522 . D ; :L103523 "RTN","C0CMAIL",112,0)103524 . . S:L K=K+1,LST(NAM,"MSG",I,"NEW")="" ; Flag NEW emails103525 "RTN","C0CMAIL",113,0)103526 . . S LST(NAM,"MSG",I)=L103527 "RTN","C0CMAIL",114,0)103528 . . D GETTYP(I)103529 "RTN","C0CMAIL",115,0)103530 . .QUIT103531 "RTN","C0CMAIL",116,0)103532 .QUIT103533 103569 "RTN","C0CMAIL",117,0) 103534 S LST(NAM,"NUMBER")=K103570 ; D0 is the IEN into the Message Global ^XMB(3.9,D0) 103535 103571 "RTN","C0CMAIL",118,0) 103536 QUIT103572 ; The products of these emails are scanned to identify 103537 103573 "RTN","C0CMAIL",119,0) 103538 ; ===================103574 ; the number of documents stored in the MIME package. 103539 103575 "RTN","C0CMAIL",120,0) 103540 ; D0 is the IEN into the Message Global ^XMB(3.9,D0)103576 ; The protocol runs like this; 103541 103577 "RTN","C0CMAIL",121,0) 103542 ; The products of these emails are scanned to identify103578 ; Line 1 is the --separator 103543 103579 "RTN","C0CMAIL",122,0) 103544 ; the number of documents stored in the MIME package.103580 ; Line 2 thru n >Look for Content-[detail type:]Description ; Next CMD 103545 103581 "RTN","C0CMAIL",123,0) 103546 ; The protocol runs like this;103582 ; Line n+2 thru t-1 where t does NOT have "Content-" 103547 103583 "RTN","C0CMAIL",124,0) 103548 ; Line 1 is the--separator103584 ; Line t is Next Section Terminator, or Message Terminator, --separator 103549 103585 "RTN","C0CMAIL",125,0) 103550 ; Line 2 thru n >Look for Content-[detail type:]Description ; Next CMD103586 ; Line t+1 should not exist in the data set if Message Terminator 103551 103587 "RTN","C0CMAIL",126,0) 103552 ; Line n+2 thru t-1 where t does NOT have"Content-"103588 ; CON = "Content-" 103553 103589 "RTN","C0CMAIL",127,0) 103554 ; Line t is Next Section Terminator, or Message Terminator, --separator103590 ; FLG = "--" 103555 103591 "RTN","C0CMAIL",128,0) 103556 ; Line t+1 should not exist in the data set if Message Terminator103592 ; SEP = FLG+7 or more characters ; Separator 103557 103593 "RTN","C0CMAIL",129,0) 103558 ; CON = "Content-"103594 ; END = SEP+FLG 103559 103595 "RTN","C0CMAIL",130,0) 103560 ; FLG = "--"103596 ; SGC = Segment Count 103561 103597 "RTN","C0CMAIL",131,0) 103562 ; SEP = FLG+7 or more characters ; Separator103598 ; Note: separator is a string of specific characters of 103563 103599 "RTN","C0CMAIL",132,0) 103564 ; END = SEP+FLG103600 ; indeterminate length 103565 103601 "RTN","C0CMAIL",133,0) 103566 ; SGC = Segment Count103602 ; LST() the transfer array 103567 103603 "RTN","C0CMAIL",134,0) 103568 ; Note: separator is a string of specific characters of103604 ; LST(NAM,"MSG",C0CIEN,"SEG",SGN)=Starting Line^Ending Line 103569 103605 "RTN","C0CMAIL",135,0) 103570 ; indeterminate length103606 ; LST(NAM,"MSG",C0CIEN,"SEG",SGN,1:n)=Decoded Message Data 103571 103607 "RTN","C0CMAIL",136,0) 103572 ; LST() the transfer array103608 ; 103573 103609 "RTN","C0CMAIL",137,0) 103574 ; LST(NAM,"MSG",C0CIEN,"SEG",SGN)=Starting Line^Ending Line 103610 GETTYP(D0) ; Look for the goodies in the Mail 103575 103611 "RTN","C0CMAIL",138,0) 103576 ; LST(NAM,"MSG",C0CIEN,"SEG",SGN,1:n)=Decoded Message Data103612 N I,J,N,BCN,CON,CNT,D1,END,FLG,SEP,SGC,XX,XXNM 103577 103613 "RTN","C0CMAIL",139,0) 103578 ;103614 S CON="Content-" 103579 103615 "RTN","C0CMAIL",140,0) 103580 GETTYP(D0) ; Look for the goodies in the Mail 103616 S FLG="--" 103581 103617 "RTN","C0CMAIL",141,0) 103582 N I,J,N,BCN,CON,CNT,D1,END,FLG,SEP,SGC,XX,XXNM103618 S SEP="" ; Start SEP as null, so we can use this to help identify the type 103583 103619 "RTN","C0CMAIL",142,0) 103584 S CON="Content-"103620 S (BCN,CNT,D1,END,SGC)=0 103585 103621 "RTN","C0CMAIL",143,0) 103586 S FLG="--"103622 S XX=$G(^XMB(3.9,D0,0)) 103587 103623 "RTN","C0CMAIL",144,0) 103588 S SEP="" ; Start SEP as null, so we can use this to help identify the type103624 S LST(NAM,"MSG",D0,"TITLE")=$P($G(^XMB(3.9,D0,0)),U,1) 103589 103625 "RTN","C0CMAIL",145,0) 103590 S (BCN,CNT,D1,END,SGC)=0103626 S LST(NAM,"MSG",D0,"CREATED")=$G(^XMB(3.9,D0,.6)) 103591 103627 "RTN","C0CMAIL",146,0) 103592 S XX=$G(^XMB(3.9,D0,0))103628 F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM) 103593 103629 "RTN","C0CMAIL",147,0) 103594 S LST(NAM,"MSG",D0," TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)103630 S LST(NAM,"MSG",D0,"FROM")=$$NAME(XXNM) 103595 103631 "RTN","C0CMAIL",148,0) 103596 S LST(NAM,"MSG",D0," CREATED")=$G(^XMB(3.9,D0,.6))103632 S LST(NAM,"MSG",D0,"SENT")=$$TIME($P(XX,U,3)) 103597 103633 "RTN","C0CMAIL",149,0) 103598 F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM)103634 ; Get the folks the email is sent to. 103599 103635 "RTN","C0CMAIL",150,0) 103600 S LST(NAM,"MSG",D0,"FROM")=$$NAME(XXNM)103636 S D1=0 103601 103637 "RTN","C0CMAIL",151,0) 103602 S LST(NAM,"MSG",D0,"SENT")=$$TIME($P(XX,U,3))103638 F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D 103603 103639 "RTN","C0CMAIL",152,0) 103604 ; Get the folks the email is sent to.103640 . N T 103605 103641 "RTN","C0CMAIL",153,0) 103606 S D1=0103642 . S T=+$G(^XMB(3.9,D0,1,D1,0)) 103607 103643 "RTN","C0CMAIL",154,0) 103608 F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D103644 . S:T T=$P($G(^VA(200,+T,0)),"^") 103609 103645 "RTN","C0CMAIL",155,0) 103610 . NT103646 . S LST("TO",D1)=T 103611 103647 "RTN","C0CMAIL",156,0) 103612 . S T= +$G(^XMB(3.9,D0,1,D1,0))103648 . S T=$G(^XMB(3.9,D0,6,D1,0)) 103613 103649 "RTN","C0CMAIL",157,0) 103614 103650 . S:T T=$P($G(^VA(200,+T,0)),"^") 103615 103651 "RTN","C0CMAIL",158,0) 103616 . S LST("TO",D1)=T103652 . S:T="" T="<Unknown>" 103617 103653 "RTN","C0CMAIL",159,0) 103618 . S T=$G(^XMB(3.9,D0,6,D1,0))103654 . S LST("TO NAME",D1)=T 103619 103655 "RTN","C0CMAIL",160,0) 103620 . S:T T=$P($G(^VA(200,+T,0)),"^")103656 .QUIT 103621 103657 "RTN","C0CMAIL",161,0) 103658 ; Preload first Segment (0) with beginning on Line 1 103659 "RTN","C0CMAIL",162,0) 103660 ; if not a 64bit 103661 "RTN","C0CMAIL",163,0) 103662 S LST(NAM,"MSG",D0,"SEG",0)=1 103663 "RTN","C0CMAIL",164,0) 103664 S D1=.9999,SEP="--" 103665 "RTN","C0CMAIL",165,0) 103666 F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D 103667 "RTN","C0CMAIL",166,0) 103668 . ; Clear any control characters (cr/lf/ff) off 103669 "RTN","C0CMAIL",167,0) 103670 . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13)) 103671 "RTN","C0CMAIL",168,0) 103672 . ; Enter once to set the SEP to capture the separator 103673 "RTN","C0CMAIL",169,0) 103674 . I SEP=FLG&($E(X,1,2)=FLG)&($L(X,FLG)=2)&($L($P(X,FLG,2)>5)) D Q 103675 "RTN","C0CMAIL",170,0) 103676 . . S SEP=X,END=X_FLG 103677 "RTN","C0CMAIL",171,0) 103678 . . S (CNT,SGC)=1,BCN=0 103679 "RTN","C0CMAIL",172,0) 103680 . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1 103681 "RTN","C0CMAIL",173,0) 103682 . .QUIT 103683 "RTN","C0CMAIL",174,0) 103684 . ; 103685 "RTN","C0CMAIL",175,0) 103686 . ; A new separator is set, process original 103687 "RTN","C0CMAIL",176,0) 103688 . I X=SEP D QUIT 103689 "RTN","C0CMAIL",177,0) 103690 . . S LST(NAM,"MSG",D0,SGC,"SIZE")=BCN 103691 "RTN","C0CMAIL",178,0) 103692 . . S LST(NAM,"MSG",D0,"SEG",SGC)=$G(LST(NAM,"MSG",D0,"SEG",SGC))_"^"_(D1-1) 103693 "RTN","C0CMAIL",179,0) 103694 . . S SGC=SGC+1,BCN=0 103695 "RTN","C0CMAIL",180,0) 103696 . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1 103697 "RTN","C0CMAIL",181,0) 103698 . .QUIT 103699 "RTN","C0CMAIL",182,0) 103700 . ; 103701 "RTN","C0CMAIL",183,0) 103702 . S BCN=BCN+$L(X) 103703 "RTN","C0CMAIL",184,0) 103704 . I X[CON D Q 103705 "RTN","C0CMAIL",185,0) 103706 . . S J=$P($P(X,";"),CON,2) 103707 "RTN","C0CMAIL",186,0) 103708 . . S LST(NAM,"MSG",D0,"SEG",SGC,"CONT",CNT,$P(J,":"))=$P(J,":",2) 103709 "RTN","C0CMAIL",187,0) 103710 . .QUIT 103711 "RTN","C0CMAIL",188,0) 103712 . ; 103713 "RTN","C0CMAIL",189,0) 103714 . ; S LST(NAM,"MSG",D0,"SEG",D1)=X 103715 "RTN","C0CMAIL",190,0) 103716 .QUIT 103717 "RTN","C0CMAIL",191,0) 103718 QUIT 103719 "RTN","C0CMAIL",192,0) 103720 ; =================== 103721 "RTN","C0CMAIL",193,0) 103722 NAME(NM) ; Return the name of the Sender 103723 "RTN","C0CMAIL",194,0) 103724 N NAME 103725 "RTN","C0CMAIL",195,0) 103726 S NAME="<Unknown Sender>" 103727 "RTN","C0CMAIL",196,0) 103728 D 103729 "RTN","C0CMAIL",197,0) 103730 . ; Look first for a value to use with the NEW PERSON file 103731 "RTN","C0CMAIL",198,0) 103732 . ; 103733 "RTN","C0CMAIL",199,0) 103734 . I NM=+NM S NAME=$P(^VA(200,NM,0),U,1) Q 103735 "RTN","C0CMAIL",200,0) 103736 . ; 103737 "RTN","C0CMAIL",201,0) 103738 . I $L(NM) S NAME=NM Q 103739 "RTN","C0CMAIL",202,0) 103740 . ; 103741 "RTN","C0CMAIL",203,0) 103742 . ; Else, pull the data from the message and display the foreign source 103743 "RTN","C0CMAIL",204,0) 103744 . ; of the message. 103745 "RTN","C0CMAIL",205,0) 103746 . N T 103747 "RTN","C0CMAIL",206,0) 103748 . S VAL=$G(^XMB(3.9,D0,.7)) 103749 "RTN","C0CMAIL",207,0) 103750 . S:VAL T=$P(^VA(200,VAL,0),U) 103751 "RTN","C0CMAIL",208,0) 103752 . I $L($G(T)) S NAME=T Q 103753 "RTN","C0CMAIL",209,0) 103754 . ; 103755 "RTN","C0CMAIL",210,0) 103756 .QUIT 103757 "RTN","C0CMAIL",211,0) 103758 QUIT NAME 103759 "RTN","C0CMAIL",212,0) 103760 ; =================== 103761 "RTN","C0CMAIL",213,0) 103762 TIME(Y) ; The time and date of the sending 103763 "RTN","C0CMAIL",214,0) 103764 X ^DD("DD") 103765 "RTN","C0CMAIL",215,0) 103766 QUIT Y 103767 "RTN","C0CMAIL",216,0) 103768 ; =================== 103769 "RTN","C0CMAIL",217,0) 103770 ; Segments in Message need to be identified and decoded properly 103771 "RTN","C0CMAIL",218,0) 103772 ; D DETAIL^C0CMAIL(.ARRAY,D0) ; Call One for each message 103773 "RTN","C0CMAIL",219,0) 103774 ; ARRAY will have the details of this one call 103775 "RTN","C0CMAIL",220,0) 103776 ; 103777 "RTN","C0CMAIL",221,0) 103778 ; Inputs; 103779 "RTN","C0CMAIL",222,0) 103780 ; C0CINPUT - The IEN of the message to expand 103781 "RTN","C0CMAIL",223,0) 103782 ; Outputs; 103783 "RTN","C0CMAIL",224,0) 103784 ; C0CDATA - Carrier for the returned structure of the Message 103785 "RTN","C0CMAIL",225,0) 103786 ; C0CDATA(D0,"SEG")=number of SEGMENTS 103787 "RTN","C0CMAIL",226,0) 103788 ; C0CDATA(D0,"SEG",0:n)=SEGMENT n details 103789 "RTN","C0CMAIL",227,0) 103790 ; C0CDATA(D0,"SEG",0:n,"CONTENT",type)=Content details 103791 "RTN","C0CMAIL",228,0) 103792 ; C0CDATA(D0,"SEG",0:n,"MSG",D3)=Content details 103793 "RTN","C0CMAIL",229,0) 103794 ; C0CDATA(D0,"SEG",0:n,"HTML",D3)=Content details 103795 "RTN","C0CMAIL",230,0) 103796 ; 103797 "RTN","C0CMAIL",231,0) 103798 DETAIL(C0CDATA,C0CINPUT) ; Message Detail Delivery 103799 "RTN","C0CMAIL",232,0) 103800 N LST,D0,D1,U 103801 "RTN","C0CMAIL",233,0) 103802 S U="^" 103803 "RTN","C0CMAIL",234,0) 103804 S D0=+$G(C0CINPUT) 103805 "RTN","C0CMAIL",235,0) 103806 I D0 D QUIT 103807 "RTN","C0CMAIL",236,0) 103808 . D GETTYP2(D0) 103809 "RTN","C0CMAIL",237,0) 103810 . I $D(LST) M C0CDATA(D0)=LST 103811 "RTN","C0CMAIL",238,0) 103812 .QUIT 103813 "RTN","C0CMAIL",239,0) 103814 QUIT 103815 "RTN","C0CMAIL",240,0) 103816 ; =================== 103817 "RTN","C0CMAIL",241,0) 103818 ; End note if needed 103819 "RTN","C0CMAIL",242,0) 103820 ; MSK - Set of characters that do not exist in 64 bit encoding 103821 "RTN","C0CMAIL",243,0) 103822 GETTYP2(D0) ; Try to get the types and MSK for the 103823 "RTN","C0CMAIL",244,0) 103824 N I,J,K,N,BCN,BF,CON,CNT,D1,END,FLG,MSK,SEP,SGC,U,XX,ZN,XXNM 103825 "RTN","C0CMAIL",245,0) 103826 S CON="Content-",U="^" 103827 "RTN","C0CMAIL",246,0) 103828 S FLG="--" 103829 "RTN","C0CMAIL",247,0) 103830 S MSK=" !""#$%&'()*,-.:;<>?@[\]^_`{|}~" 103831 "RTN","C0CMAIL",248,0) 103832 S (BF,SEP)="" ; Start SEP as null, so we can use this to help identify the type 103833 "RTN","C0CMAIL",249,0) 103834 S (BCN,CNT,D1,END,SGC)=0 103835 "RTN","C0CMAIL",250,0) 103836 S XX=$G(^XMB(3.9,D0,0)) 103837 "RTN","C0CMAIL",251,0) 103838 ; S K=$P(^XMB(3.9,D0,2,0),U,3) 103839 "RTN","C0CMAIL",252,0) 103840 S LST("TITLE")=$P($G(^XMB(3.9,D0,0)),U,1) 103841 "RTN","C0CMAIL",253,0) 103842 S LST("CREATED")=$$TIME($P(XX,U,3)) 103843 "RTN","C0CMAIL",254,0) 103844 F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM) 103845 "RTN","C0CMAIL",255,0) 103846 S LST("FROM")=$$NAME(XXNM) 103847 "RTN","C0CMAIL",256,0) 103848 ; Get the folks the email is sent to. 103849 "RTN","C0CMAIL",257,0) 103850 S D1=0 103851 "RTN","C0CMAIL",258,0) 103852 F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D Q:D1="" 103853 "RTN","C0CMAIL",259,0) 103854 . N I,T 103855 "RTN","C0CMAIL",260,0) 103856 . S T=$P($G(^XMB(3.9,D0,1,D1,0)),U) 103857 "RTN","C0CMAIL",261,0) 103858 . S:T T=$P($G(^VA(200,T,0)),"^") 103859 "RTN","C0CMAIL",262,0) 103860 . S LST("TO",+D1)=T 103861 "RTN","C0CMAIL",263,0) 103862 . S T=$G(^XMB(3.9,D0,6,+D1,0)) 103863 "RTN","C0CMAIL",264,0) 103864 . S:T="" T=$P($G(^VA(200,+T,0)),"^") 103865 "RTN","C0CMAIL",265,0) 103622 103866 . S:T="" T="<Unknown>" 103623 "RTN","C0CMAIL", 162,0)103867 "RTN","C0CMAIL",266,0) 103624 103868 . S LST("TO NAME",D1)=T 103625 "RTN","C0CMAIL", 163,0)103869 "RTN","C0CMAIL",267,0) 103626 103870 .QUIT 103627 "RTN","C0CMAIL",164,0) 103628 ; Preload first Segment (0) with beginning on Line 1 103629 "RTN","C0CMAIL",165,0) 103630 ; if not a 64bit 103631 "RTN","C0CMAIL",166,0) 103632 S LST(NAM,"MSG",D0,"SEG",0)=1 103633 "RTN","C0CMAIL",167,0) 103634 S D1=.9999,SEP="--" 103635 "RTN","C0CMAIL",168,0) 103871 "RTN","C0CMAIL",268,0) 103872 ; Get the Header for the message 103873 "RTN","C0CMAIL",269,0) 103874 S D1=0 103875 "RTN","C0CMAIL",270,0) 103876 F I=1:1 S D1=$O(^XMB(3.9,D0,2,D1)) Q:D1="" Q:(D1>.99999) D 103877 "RTN","C0CMAIL",271,0) 103878 . S LST("HDR",I)=$G(^XMB(3.9,D0,2,D1,0)) 103879 "RTN","C0CMAIL",272,0) 103880 .QUIT 103881 "RTN","C0CMAIL",273,0) 103882 ; Start walking the different sections 103883 "RTN","C0CMAIL",274,0) 103884 S D1=.99999,SEP="--" 103885 "RTN","C0CMAIL",275,0) 103636 103886 F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D 103637 "RTN","C0CMAIL", 169,0)103887 "RTN","C0CMAIL",276,0) 103638 103888 . ; Clear any control characters (cr/lf/ff) off 103639 "RTN","C0CMAIL", 170,0)103889 "RTN","C0CMAIL",277,0) 103640 103890 . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13)) 103641 "RTN","C0CMAIL", 171,0)103891 "RTN","C0CMAIL",278,0) 103642 103892 . ; Enter once to set the SEP to capture the separator 103643 "RTN","C0CMAIL", 172,0)103644 . I SEP=FLG&($E(X,1,2)=FLG)&($L(X,FLG)=2)&($L($P(X,FLG,2)>5))D Q103645 "RTN","C0CMAIL", 173,0)103893 "RTN","C0CMAIL",279,0) 103894 . I (SEP="--")&($E(X,1,2)=FLG)&($L(X,FLG)=2) D Q 103895 "RTN","C0CMAIL",280,0) 103646 103896 . . S SEP=X,END=X_FLG 103647 "RTN","C0CMAIL", 174,0)103897 "RTN","C0CMAIL",281,0) 103648 103898 . . S (CNT,SGC)=1,BCN=0 103649 "RTN","C0CMAIL", 175,0)103650 . . S LST( NAM,"MSG",D0,"SEG",SGC)=D1103651 "RTN","C0CMAIL", 176,0)103899 "RTN","C0CMAIL",282,0) 103900 . . S LST("SEG",SGC)=D1 103901 "RTN","C0CMAIL",283,0) 103652 103902 . .QUIT 103653 "RTN","C0CMAIL", 177,0)103903 "RTN","C0CMAIL",284,0) 103654 103904 . ; 103655 "RTN","C0CMAIL", 178,0)103656 . ; A new separator is set, process original103657 "RTN","C0CMAIL", 179,0)103905 "RTN","C0CMAIL",285,0) 103906 . ; A new SEGMENT separator is set, process original 103907 "RTN","C0CMAIL",286,0) 103658 103908 . I X=SEP D QUIT 103659 "RTN","C0CMAIL",180,0) 103660 . . S LST(NAM,"MSG",D0,SGC,"SIZE")=BCN 103661 "RTN","C0CMAIL",181,0) 103662 . . S LST(NAM,"MSG",D0,"SEG",SGC)=$G(LST(NAM,"MSG",D0,"SEG",SGC))_"^"_(D1-1) 103663 "RTN","C0CMAIL",182,0) 103909 "RTN","C0CMAIL",287,0) 103910 . . ; Save Current Values 103911 "RTN","C0CMAIL",288,0) 103912 . . S LST("SEG",SGC,"SIZE")=BCN 103913 "RTN","C0CMAIL",289,0) 103914 . . ; Close this Segment and prepare to start a New Segment 103915 "RTN","C0CMAIL",290,0) 103916 . . S LST("SEG",SGC)=$G(LST("SEG",SGC))_"^"_(D1-1) 103917 "RTN","C0CMAIL",291,0) 103918 . . ; Put the result in LST("SEG",SGC,"XML") 103919 "RTN","C0CMAIL",292,0) 103920 . . I $L(BF) D 103921 "RTN","C0CMAIL",293,0) 103922 . . . S ZN=1 103923 "RTN","C0CMAIL",294,0) 103924 . . . N I,T,TBF 103925 "RTN","C0CMAIL",295,0) 103926 . . . S TBF=BF 103927 "RTN","C0CMAIL",296,0) 103928 . . . F I=1:1:($L(TBF,"=")) D 103929 "RTN","C0CMAIL",297,0) 103930 . . . . S BF=$P(TBF,"=",I)_"=" 103931 "RTN","C0CMAIL",298,0) 103932 . . . . I BF'="=" D DECODER 103933 "RTN","C0CMAIL",299,0) 103934 . . . .QUIT 103935 "RTN","C0CMAIL",300,0) 103936 . . . S BF="" 103937 "RTN","C0CMAIL",301,0) 103938 . . .QUIT 103939 "RTN","C0CMAIL",302,0) 103664 103940 . . S SGC=SGC+1,BCN=0 103665 "RTN","C0CMAIL",183,0) 103666 . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1 103667 "RTN","C0CMAIL",184,0) 103941 "RTN","C0CMAIL",303,0) 103942 . . ; Incriment SGC to start a new Segment 103943 "RTN","C0CMAIL",304,0) 103944 . . S LST("SEG",SGC)=D1 103945 "RTN","C0CMAIL",305,0) 103668 103946 . .QUIT 103669 "RTN","C0CMAIL", 185,0)103947 "RTN","C0CMAIL",306,0) 103670 103948 . ; 103671 "RTN","C0CMAIL",186,0) 103949 "RTN","C0CMAIL",307,0) 103950 . ; Accumulate the 64 bit encoding 103951 "RTN","C0CMAIL",308,0) 103952 . I X=$TR(X,MSK)&$L(X) D Q 103953 "RTN","C0CMAIL",309,0) 103954 . . S BF=BF_X 103955 "RTN","C0CMAIL",310,0) 103956 . . S BCN=BCN+$L(X) 103957 "RTN","C0CMAIL",311,0) 103958 . .QUIT 103959 "RTN","C0CMAIL",312,0) 103960 . ; 103961 "RTN","C0CMAIL",313,0) 103962 . ; Ending Condition, close out the Segment 103963 "RTN","C0CMAIL",314,0) 103964 . I X=END D QUIT 103965 "RTN","C0CMAIL",315,0) 103966 . . S LST("SEG",SGC)=$G(LST("SEG",SGC))_"^"_(D1-1) 103967 "RTN","C0CMAIL",316,0) 103968 . . I $L(BF) S ZN=1 D DECODER S BF="" Q 103969 "RTN","C0CMAIL",317,0) 103970 . .QUIT 103971 "RTN","C0CMAIL",318,0) 103972 . ; 103973 "RTN","C0CMAIL",319,0) 103672 103974 . S BCN=BCN+$L(X) 103673 "RTN","C0CMAIL",187,0) 103975 "RTN","C0CMAIL",320,0) 103976 . ; Split out the Content Info 103977 "RTN","C0CMAIL",321,0) 103674 103978 . I X[CON D Q 103675 "RTN","C0CMAIL", 188,0)103676 . . S J=$P( $P(X,";"),CON,2)103677 "RTN","C0CMAIL", 189,0)103678 . . S LST( NAM,"MSG",D0,"SEG",SGC,"CONT",CNT,$P(J,":"))=$P(J,":",2)103679 "RTN","C0CMAIL", 190,0)103979 "RTN","C0CMAIL",322,0) 103980 . . S J=$P(X,CON,2) 103981 "RTN","C0CMAIL",323,0) 103982 . . S LST("SEG",SGC,"CONTENT",$P(J,":"))=$P(J,":",2,9) 103983 "RTN","C0CMAIL",324,0) 103680 103984 . .QUIT 103681 "RTN","C0CMAIL", 191,0)103985 "RTN","C0CMAIL",325,0) 103682 103986 . ; 103683 "RTN","C0CMAIL",192,0) 103684 . ; S LST(NAM,"MSG",D0,"SEG",D1)=X 103685 "RTN","C0CMAIL",193,0) 103987 "RTN","C0CMAIL",326,0) 103988 . ; Everything else is Text 103989 "RTN","C0CMAIL",327,0) 103990 . S LST("SEG",SGC,"TXT",D1)=X 103991 "RTN","C0CMAIL",328,0) 103686 103992 .QUIT 103687 "RTN","C0CMAIL", 194,0)103993 "RTN","C0CMAIL",329,0) 103688 103994 QUIT 103689 "RTN","C0CMAIL", 195,0)103995 "RTN","C0CMAIL",330,0) 103690 103996 ; =================== 103691 "RTN","C0CMAIL", 196,0)103692 NAME(NM) ; Return the name of the Sender 103693 "RTN","C0CMAIL", 197,0)103694 N NAME103695 "RTN","C0CMAIL", 198,0)103696 S NAME="<Unknown Sender>" 103697 "RTN","C0CMAIL", 199,0)103698 D103699 "RTN","C0CMAIL", 200,0)103700 . ; Look first for a value to use with the NEW PERSON file103701 "RTN","C0CMAIL", 201,0)103702 . ;103703 "RTN","C0CMAIL", 202,0)103704 . I NM=+NM S NAME=$P(^VA(200,NM,0),U,1) Q103705 "RTN","C0CMAIL", 203,0)103706 . ;103707 "RTN","C0CMAIL", 204,0)103708 . I $L(NM) S NAME=NM Q103709 "RTN","C0CMAIL", 205,0)103710 . ; 103711 "RTN","C0CMAIL", 206,0)103712 . ; Else, pull the data from the message and display the foreign source103713 "RTN","C0CMAIL", 207,0)103714 . ; of the message.103715 "RTN","C0CMAIL", 208,0)103716 . N T103717 "RTN","C0CMAIL", 209,0)103718 . S VAL=$G(^XMB(3.9,D0,.7))103719 "RTN","C0CMAIL", 210,0)103720 . S:VAL T=$P(^VA(200,VAL,0),U)103721 "RTN","C0CMAIL", 211,0)103722 . I $L($G(T)) S NAME=T Q103723 "RTN","C0CMAIL", 212,0)103724 . ;103725 "RTN","C0CMAIL", 213,0)103997 "RTN","C0CMAIL",331,0) 103998 ; Break down the Buffer Array so it can be saved. 103999 "RTN","C0CMAIL",332,0) 104000 ; BF is passed in. 104001 "RTN","C0CMAIL",333,0) 104002 DECODER ; 104003 "RTN","C0CMAIL",334,0) 104004 N RCNT,TBF,ZBF,ZI,ZJ,ZK,ZSIZE 104005 "RTN","C0CMAIL",335,0) 104006 S ZBF=BF 104007 "RTN","C0CMAIL",336,0) 104008 ; Full Buffer, BF, now check for Encryption and Unpack 104009 "RTN","C0CMAIL",337,0) 104010 F RCNT=1:1:$L(ZBF,"=") D 104011 "RTN","C0CMAIL",338,0) 104012 . N BF 104013 "RTN","C0CMAIL",339,0) 104014 . S BF=$P(ZBF,"=",RCNT) 104015 "RTN","C0CMAIL",340,0) 104016 . ; Unpacking the 64 bit encoding 104017 "RTN","C0CMAIL",341,0) 104018 . S TBF=$TR($$DECODE^RGUTUU(BF),$C(10,12,13)) 104019 "RTN","C0CMAIL",342,0) 104020 . D:$L(TBF) 104021 "RTN","C0CMAIL",343,0) 104022 . . N XBF 104023 "RTN","C0CMAIL",344,0) 104024 . . S BF=BF_"=" 104025 "RTN","C0CMAIL",345,0) 104026 . . D NORMAL(.XBF,.TBF) 104027 "RTN","C0CMAIL",346,0) 104028 . . M LST("SEG",SGC,"XML",RCNT)=XBF 104029 "RTN","C0CMAIL",347,0) 104030 . .QUIT 104031 "RTN","C0CMAIL",348,0) 103726 104032 .QUIT 103727 "RTN","C0CMAIL", 214,0)103728 QUIT NAME103729 "RTN","C0CMAIL", 215,0)104033 "RTN","C0CMAIL",349,0) 104034 QUIT 104035 "RTN","C0CMAIL",350,0) 103730 104036 ; =================== 103731 "RTN","C0CMAIL",216,0) 103732 TIME(Y) ; The time and date of the sending 103733 "RTN","C0CMAIL",217,0) 103734 X ^DD("DD") 103735 "RTN","C0CMAIL",218,0) 103736 QUIT Y 103737 "RTN","C0CMAIL",219,0) 104037 "RTN","C0CMAIL",351,0) 104038 ; OUTXML = OUTBF = OUT = OUTPUT ARRAY TO BE BUILT 104039 "RTN","C0CMAIL",352,0) 104040 ; BF = INXML = INPUT ARRAY TO PROVIDE INPUT 104041 "RTN","C0CMAIL",353,0) 104042 ; >D NORMAL^C0CMAIL(.OUT,BF) 104043 "RTN","C0CMAIL",354,0) 104044 NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML 104045 "RTN","C0CMAIL",355,0) 104046 ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME 104047 "RTN","C0CMAIL",356,0) 104048 ; 104049 "RTN","C0CMAIL",357,0) 104050 N ZN,OUTBF 104051 "RTN","C0CMAIL",358,0) 104052 S ZN=1 104053 "RTN","C0CMAIL",359,0) 104054 S OUTBF(ZN)=$P(INXML,"><",ZN)_">" 104055 "RTN","C0CMAIL",360,0) 104056 F ZN=ZN+1:1 S OUTBF(ZN)="<"_$P(INXML,"><",ZN) Q:$P(INXML,"><",ZN+1)="" D ; 104057 "RTN","C0CMAIL",361,0) 104058 . S OUTBF(ZN)=OUTBF(ZN)_">" 104059 "RTN","C0CMAIL",362,0) 104060 .QUIT 104061 "RTN","C0CMAIL",363,0) 104062 M OUTXML=OUTBF 104063 "RTN","C0CMAIL",364,0) 104064 QUIT 104065 "RTN","C0CMAIL",365,0) 103738 104066 ; =================== 103739 "RTN","C0CMAIL",220,0) 103740 ; Segments in Message need to be identified and decoded properly 103741 "RTN","C0CMAIL",221,0) 103742 ; D DETAIL^C0CMAIL(.ARRAY,D0) ; Call One for each message 103743 "RTN","C0CMAIL",222,0) 103744 ; ARRAY will have the details of this one call 103745 "RTN","C0CMAIL",223,0) 103746 ; 103747 "RTN","C0CMAIL",224,0) 103748 ; Inputs; 103749 "RTN","C0CMAIL",225,0) 103750 ; C0CINPUT - The IEN of the message to expand 103751 "RTN","C0CMAIL",226,0) 103752 ; Outputs; 103753 "RTN","C0CMAIL",227,0) 103754 ; C0CDATA - Carrier for the returned structure of the Message 103755 "RTN","C0CMAIL",228,0) 103756 ; C0CDATA(D0,"SEG")=number of SEGMENTS 103757 "RTN","C0CMAIL",229,0) 103758 ; C0CDATA(D0,"SEG",0:n)=SEGMENT n details 103759 "RTN","C0CMAIL",230,0) 103760 ; C0CDATA(D0,"SEG",0:n,"CONTENT",type)=Content details 103761 "RTN","C0CMAIL",231,0) 103762 ; C0CDATA(D0,"SEG",0:n,"MSG",D3)=Content details 103763 "RTN","C0CMAIL",232,0) 103764 ; C0CDATA(D0,"SEG",0:n,"HTML",D3)=Content details 103765 "RTN","C0CMAIL",233,0) 103766 ; 103767 "RTN","C0CMAIL",234,0) 103768 DETAIL(C0CDATA,C0CINPUT) ; Message Detail Delivery 103769 "RTN","C0CMAIL",235,0) 103770 N LST,D0,D1,U 103771 "RTN","C0CMAIL",236,0) 103772 S U="^" 103773 "RTN","C0CMAIL",237,0) 103774 S D0=+$G(C0CINPUT) 103775 "RTN","C0CMAIL",238,0) 103776 I D0 D QUIT 103777 "RTN","C0CMAIL",239,0) 103778 . D GETTYP2(D0) 103779 "RTN","C0CMAIL",240,0) 103780 . I $D(LST) M C0CDATA(D0)=LST 103781 "RTN","C0CMAIL",241,0) 103782 .QUIT 103783 "RTN","C0CMAIL",242,0) 104067 "RTN","C0CMAIL",366,0) 104068 ; vvvvvvvvvvvvvvv Not Needed vvvvvvvvvvvvvvvvvvvvvvvvvv 104069 "RTN","C0CMAIL",367,0) 104070 ; End note if needed 104071 "RTN","C0CMAIL",368,0) 103784 104072 QUIT 103785 "RTN","C0CMAIL",243,0)103786 ; ===================103787 "RTN","C0CMAIL",244,0)103788 ; End note if needed103789 "RTN","C0CMAIL",245,0)103790 ; MSK - Set of characters that do not exist in 64 bit encoding103791 "RTN","C0CMAIL",246,0)103792 GETTYP2(D0) ; Try to get the types and MSK for the103793 "RTN","C0CMAIL",247,0)103794 N I,J,K,N,BCN,BF,CON,CNT,D1,END,FLG,MSK,SEP,SGC,U,XX,ZN,XXNM103795 "RTN","C0CMAIL",248,0)103796 S CON="Content-",U="^"103797 "RTN","C0CMAIL",249,0)103798 S FLG="--"103799 "RTN","C0CMAIL",250,0)103800 S MSK=" !""#$%&'()*,-.:;<>?@[\]^_`{|}~"103801 "RTN","C0CMAIL",251,0)103802 S (BF,SEP)="" ; Start SEP as null, so we can use this to help identify the type103803 "RTN","C0CMAIL",252,0)103804 S (BCN,CNT,D1,END,SGC)=0103805 "RTN","C0CMAIL",253,0)103806 S XX=$G(^XMB(3.9,D0,0))103807 "RTN","C0CMAIL",254,0)103808 ; S K=$P(^XMB(3.9,D0,2,0),U,3)103809 "RTN","C0CMAIL",255,0)103810 S LST("TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)103811 "RTN","C0CMAIL",256,0)103812 S LST("CREATED")=$$TIME($P(XX,U,3))103813 "RTN","C0CMAIL",257,0)103814 F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM)103815 "RTN","C0CMAIL",258,0)103816 S LST("FROM")=$$NAME(XXNM)103817 "RTN","C0CMAIL",259,0)103818 ; Get the folks the email is sent to.103819 "RTN","C0CMAIL",260,0)103820 S D1=0103821 "RTN","C0CMAIL",261,0)103822 F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D Q:D1=""103823 "RTN","C0CMAIL",262,0)103824 . N I,T103825 "RTN","C0CMAIL",263,0)103826 . S T=$P($G(^XMB(3.9,D0,1,D1,0)),U)103827 "RTN","C0CMAIL",264,0)103828 . S:T T=$P($G(^VA(200,T,0)),"^")103829 "RTN","C0CMAIL",265,0)103830 . S LST("TO",+D1)=T103831 "RTN","C0CMAIL",266,0)103832 . S T=$G(^XMB(3.9,D0,6,+D1,0))103833 "RTN","C0CMAIL",267,0)103834 . S:T="" T=$P($G(^VA(200,+T,0)),"^")103835 "RTN","C0CMAIL",268,0)103836 . S:T="" T="<Unknown>"103837 "RTN","C0CMAIL",269,0)103838 . S LST("TO NAME",D1)=T103839 "RTN","C0CMAIL",270,0)103840 .QUIT103841 "RTN","C0CMAIL",271,0)103842 ; Get the Header for the message103843 "RTN","C0CMAIL",272,0)103844 S D1=0103845 "RTN","C0CMAIL",273,0)103846 F I=1:1 S D1=$O(^XMB(3.9,D0,2,D1)) Q:D1="" Q:(D1>.99999) D103847 "RTN","C0CMAIL",274,0)103848 . S LST("HDR",I)=$G(^XMB(3.9,D0,2,D1,0))103849 "RTN","C0CMAIL",275,0)103850 .QUIT103851 "RTN","C0CMAIL",276,0)103852 ; Start walking the different sections103853 "RTN","C0CMAIL",277,0)103854 S D1=.99999,SEP="--"103855 "RTN","C0CMAIL",278,0)103856 F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D103857 "RTN","C0CMAIL",279,0)103858 . ; Clear any control characters (cr/lf/ff) off103859 "RTN","C0CMAIL",280,0)103860 . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))103861 "RTN","C0CMAIL",281,0)103862 . ; Enter once to set the SEP to capture the separator103863 "RTN","C0CMAIL",282,0)103864 . I (SEP="--")&($E(X,1,2)=FLG)&($L(X,FLG)=2) D Q103865 "RTN","C0CMAIL",283,0)103866 . . S SEP=X,END=X_FLG103867 "RTN","C0CMAIL",284,0)103868 . . S (CNT,SGC)=1,BCN=0103869 "RTN","C0CMAIL",285,0)103870 . . S LST("SEG",SGC)=D1103871 "RTN","C0CMAIL",286,0)103872 . .QUIT103873 "RTN","C0CMAIL",287,0)103874 . ;103875 "RTN","C0CMAIL",288,0)103876 . ; A new SEGMENT separator is set, process original103877 "RTN","C0CMAIL",289,0)103878 . I X=SEP D QUIT103879 "RTN","C0CMAIL",290,0)103880 . . ; Save Current Values103881 "RTN","C0CMAIL",291,0)103882 . . S LST("SEG",SGC,"SIZE")=BCN103883 "RTN","C0CMAIL",292,0)103884 . . ; Close this Segment and prepare to start a New Segment103885 "RTN","C0CMAIL",293,0)103886 . . S LST("SEG",SGC)=$G(LST("SEG",SGC))_"^"_(D1-1)103887 "RTN","C0CMAIL",294,0)103888 . . ; Put the result in LST("SEG",SGC,"XML")103889 "RTN","C0CMAIL",295,0)103890 . . I $L(BF) D103891 "RTN","C0CMAIL",296,0)103892 . . . S ZN=1103893 "RTN","C0CMAIL",297,0)103894 . . . N I,T,TBF103895 "RTN","C0CMAIL",298,0)103896 . . . S TBF=BF103897 "RTN","C0CMAIL",299,0)103898 . . . F I=1:1:($L(TBF,"=")) D103899 "RTN","C0CMAIL",300,0)103900 . . . . S BF=$P(TBF,"=",I)_"="103901 "RTN","C0CMAIL",301,0)103902 . . . . I BF'="=" D DECODER103903 "RTN","C0CMAIL",302,0)103904 . . . .QUIT103905 "RTN","C0CMAIL",303,0)103906 . . . S BF=""103907 "RTN","C0CMAIL",304,0)103908 . . .QUIT103909 "RTN","C0CMAIL",305,0)103910 . . S SGC=SGC+1,BCN=0103911 "RTN","C0CMAIL",306,0)103912 . . ; Incriment SGC to start a new Segment103913 "RTN","C0CMAIL",307,0)103914 . . S LST("SEG",SGC)=D1103915 "RTN","C0CMAIL",308,0)103916 . .QUIT103917 "RTN","C0CMAIL",309,0)103918 . ;103919 "RTN","C0CMAIL",310,0)103920 . ; Accumulate the 64 bit encoding103921 "RTN","C0CMAIL",311,0)103922 . I X=$TR(X,MSK)&$L(X) D Q103923 "RTN","C0CMAIL",312,0)103924 . . S BF=BF_X103925 "RTN","C0CMAIL",313,0)103926 . . S BCN=BCN+$L(X)103927 "RTN","C0CMAIL",314,0)103928 . .QUIT103929 "RTN","C0CMAIL",315,0)103930 . ;103931 "RTN","C0CMAIL",316,0)103932 . ; Ending Condition, close out the Segment103933 "RTN","C0CMAIL",317,0)103934 . I X=END D QUIT103935 "RTN","C0CMAIL",318,0)103936 . . S LST("SEG",SGC)=$G(LST("SEG",SGC))_"^"_(D1-1)103937 "RTN","C0CMAIL",319,0)103938 . . I $L(BF) S ZN=1 D DECODER S BF="" Q103939 "RTN","C0CMAIL",320,0)103940 . .QUIT103941 "RTN","C0CMAIL",321,0)103942 . ;103943 "RTN","C0CMAIL",322,0)103944 . S BCN=BCN+$L(X)103945 "RTN","C0CMAIL",323,0)103946 . ; Split out the Content Info103947 "RTN","C0CMAIL",324,0)103948 . I X[CON D Q103949 "RTN","C0CMAIL",325,0)103950 . . S J=$P(X,CON,2)103951 "RTN","C0CMAIL",326,0)103952 . . S LST("SEG",SGC,"CONTENT",$P(J,":"))=$P(J,":",2,9)103953 "RTN","C0CMAIL",327,0)103954 . .QUIT103955 "RTN","C0CMAIL",328,0)103956 . ;103957 "RTN","C0CMAIL",329,0)103958 . ; Everything else is Text103959 "RTN","C0CMAIL",330,0)103960 . S LST("SEG",SGC,"TXT",D1)=X103961 "RTN","C0CMAIL",331,0)103962 .QUIT103963 "RTN","C0CMAIL",332,0)103964 QUIT103965 "RTN","C0CMAIL",333,0)103966 ; ===================103967 "RTN","C0CMAIL",334,0)103968 ; Break down the Buffer Array so it can be saved.103969 "RTN","C0CMAIL",335,0)103970 ; BF is passed in.103971 "RTN","C0CMAIL",336,0)103972 DECODER ;103973 "RTN","C0CMAIL",337,0)103974 N RCNT,TBF,ZBF,ZI,ZJ,ZK,ZSIZE103975 "RTN","C0CMAIL",338,0)103976 S ZBF=BF103977 "RTN","C0CMAIL",339,0)103978 ; Full Buffer, BF, now check for Encryption and Unpack103979 "RTN","C0CMAIL",340,0)103980 F RCNT=1:1:$L(ZBF,"=") D103981 "RTN","C0CMAIL",341,0)103982 . N BF103983 "RTN","C0CMAIL",342,0)103984 . S BF=$P(ZBF,"=",RCNT)103985 "RTN","C0CMAIL",343,0)103986 . ; Unpacking the 64 bit encoding103987 "RTN","C0CMAIL",344,0)103988 . S TBF=$TR($$DECODE^RGUTUU(BF),$C(10,12,13))103989 "RTN","C0CMAIL",345,0)103990 . D:$L(TBF)103991 "RTN","C0CMAIL",346,0)103992 . . N XBF103993 "RTN","C0CMAIL",347,0)103994 . . S BF=BF_"="103995 "RTN","C0CMAIL",348,0)103996 . . D NORMAL(.XBF,.TBF)103997 "RTN","C0CMAIL",349,0)103998 . . M LST("SEG",SGC,"XML",RCNT)=XBF103999 "RTN","C0CMAIL",350,0)104000 . .QUIT104001 "RTN","C0CMAIL",351,0)104002 .QUIT104003 "RTN","C0CMAIL",352,0)104004 QUIT104005 "RTN","C0CMAIL",353,0)104006 ; ===================104007 "RTN","C0CMAIL",354,0)104008 ; OUTXML = OUTBF = OUT = OUTPUT ARRAY TO BE BUILT104009 "RTN","C0CMAIL",355,0)104010 ; BF = INXML = INPUT ARRAY TO PROVIDE INPUT104011 "RTN","C0CMAIL",356,0)104012 ; >D NORMAL^C0CMAIL(.OUT,BF)104013 "RTN","C0CMAIL",357,0)104014 NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML104015 "RTN","C0CMAIL",358,0)104016 ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME104017 "RTN","C0CMAIL",359,0)104018 ;104019 "RTN","C0CMAIL",360,0)104020 N ZN,OUTBF104021 "RTN","C0CMAIL",361,0)104022 S ZN=1104023 "RTN","C0CMAIL",362,0)104024 S OUTBF(ZN)=$P(INXML,"><",ZN)_">"104025 "RTN","C0CMAIL",363,0)104026 F ZN=ZN+1:1 S OUTBF(ZN)="<"_$P(INXML,"><",ZN) Q:$P(INXML,"><",ZN+1)="" D ;104027 "RTN","C0CMAIL",364,0)104028 . S OUTBF(ZN)=OUTBF(ZN)_">"104029 "RTN","C0CMAIL",365,0)104030 .QUIT104031 "RTN","C0CMAIL",366,0)104032 M OUTXML=OUTBF104033 "RTN","C0CMAIL",367,0)104034 QUIT104035 "RTN","C0CMAIL",368,0)104036 ; ===================104037 104073 "RTN","C0CMAIL",369,0) 104038 ; vvvvvvvvvvvvvvv Not Needed vvvvvvvvvvvvvvvvvvvvvvvvvv104039 "RTN","C0CMAIL",370,0)104040 ; End note if needed104041 "RTN","C0CMAIL",371,0)104042 QUIT104043 "RTN","C0CMAIL",372,0)104044 104074 ; =================== 104045 104075 "RTN","C0CMAIL2") 104046 0^82^B16 6788518104076 0^82^B165067910 104047 104077 "RTN","C0CMAIL2",1,0) 104048 104078 C0CMAIL2 ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr ; 5/10/12 2:50pm 104049 104079 "RTN","C0CMAIL2",2,0) 104050 ;;1.2;C 0C;;May 11, 2012;Build 50104080 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 104051 104081 "RTN","C0CMAIL2",3,0) 104052 104082 ;Copyright 2011 Chris Richardson, Richardson Computer Research … … 104056 104086 ; rcr@rcresearch.us 104057 104087 "RTN","C0CMAIL2",6,0) 104058 ; Licensed under the terms of the GNU104088 ; 104059 104089 "RTN","C0CMAIL2",7,0) 104060 ; General Public License See attached copy of the License.104090 ; This program is free software: you can redistribute it and/or modify 104061 104091 "RTN","C0CMAIL2",8,0) 104062 ; 104092 ; it under the terms of the GNU Affero General Public License as 104063 104093 "RTN","C0CMAIL2",9,0) 104064 ; This program is free software; you can redistribute it and/or modify104094 ; published by the Free Software Foundation, either version 3 of the 104065 104095 "RTN","C0CMAIL2",10,0) 104066 ; it under the terms of the GNU General Public License as published by104096 ; License, or (at your option) any later version. 104067 104097 "RTN","C0CMAIL2",11,0) 104068 ; the Free Software Foundation; either version 2 of the License, or104098 ; 104069 104099 "RTN","C0CMAIL2",12,0) 104070 ; (at your option) any later version.104100 ; This program is distributed in the hope that it will be useful, 104071 104101 "RTN","C0CMAIL2",13,0) 104072 ; 104102 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 104073 104103 "RTN","C0CMAIL2",14,0) 104074 ; This program is distributed in the hope that it will be useful,104104 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 104075 104105 "RTN","C0CMAIL2",15,0) 104076 ; but WITHOUT ANY WARRANTY; without even the implied warranty of104106 ; GNU Affero General Public License for more details. 104077 104107 "RTN","C0CMAIL2",16,0) 104078 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the104108 ; 104079 104109 "RTN","C0CMAIL2",17,0) 104080 ; GNU General Public License for more details.104110 ; You should have received a copy of the GNU Affero General Public License 104081 104111 "RTN","C0CMAIL2",18,0) 104082 ; 104112 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 104083 104113 "RTN","C0CMAIL2",19,0) 104084 ; You should have received a copy of the GNU General Public License along104114 ; 104085 104115 "RTN","C0CMAIL2",20,0) 104086 ; with this program; if not, write to the Free Software Foundation, Inc.,104116 ; ------------------ 104087 104117 "RTN","C0CMAIL2",21,0) 104088 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.104118 ;Entry Points 104089 104119 "RTN","C0CMAIL2",22,0) 104090 ; 104120 ; DETAIL^C0CMAIL(.C0CDATA,IEN) --> Get details of the Mail Message and Attachments 104091 104121 "RTN","C0CMAIL2",23,0) 104092 ; ------------------104122 ; GETMSG^C0CMAIL(.C0CDATA,.C0CINPUT) 104093 104123 "RTN","C0CMAIL2",24,0) 104094 ; Entry Points104124 ; Input: 104095 104125 "RTN","C0CMAIL2",25,0) 104096 ; DETAIL^C0CMAIL(.C0CDATA,IEN) --> Get details of the Mail Message and Attachments104126 ; C0CINPUT = "DUZ;MAILBOX_Name[or IEN for box (comma Separated);MALL 104097 104127 "RTN","C0CMAIL2",26,0) 104098 ; GETMSG^C0CMAIL(.C0CDATA,.C0CINPUT)104128 ; or "*" for all boxes, default is "IN" if missing]" 104099 104129 "RTN","C0CMAIL2",27,0) 104100 ; Input:104130 ; $P(C0CINPUT,";",3)=MALL, default=NUL means "New only", 104101 104131 "RTN","C0CMAIL2",28,0) 104102 ; C0CINPUT = "DUZ;MAILBOX_Name[or IEN for box (comma Separated);MALL104132 ; "*" for All or 9,999 maximum 104103 104133 "RTN","C0CMAIL2",29,0) 104104 ; or "*" for all boxes, default is "IN" if missing]"104134 ; MALL?1.n = that number of the n most recent 104105 104135 "RTN","C0CMAIL2",30,0) 104106 ; $P(C0CINPUT,";",3)=MALL, default=NUL means "New only",104136 ; Internally: 104107 104137 "RTN","C0CMAIL2",31,0) 104108 ; "*" for All or 9,999 maximum104138 ; BNAM = Box Name 104109 104139 "RTN","C0CMAIL2",32,0) 104110 ; MALL?1.n = that number of the n most recent104140 ; Output: 104111 104141 "RTN","C0CMAIL2",33,0) 104112 ; Internally:104142 ; C0CDATA 104113 104143 "RTN","C0CMAIL2",34,0) 104114 ; BNAM = Box Name104144 ; = (BNAM,"NUMBER") = Number of NEW Emails in Basket 104115 104145 "RTN","C0CMAIL2",35,0) 104116 ; Output:104146 ; (BNAM,"MSG",C0CIEN,"FROM")=Name 104117 104147 "RTN","C0CMAIL2",36,0) 104118 ; C0CDATA104148 ; (BNAM,"MSG",C0CIEN,"TO",n)=DUZ, or EMAIL Address 104119 104149 "RTN","C0CMAIL2",37,0) 104120 ; = (BNAM,"NUMBER") = Number of NEW Emails in Basket104150 ; (BNAM,"MSG",C0CIEN,"TO NAME",n)=Names or EMAIL Address 104121 104151 "RTN","C0CMAIL2",38,0) 104122 ; (BNAM,"MSG",C0CIEN," FROM")=Name104152 ; (BNAM,"MSG",C0CIEN,"TITLE")=EMAIL Title 104123 104153 "RTN","C0CMAIL2",39,0) 104124 ; (BNAM,"MSG",C0CIEN ,"TO",n)=DUZ, or EMAIL Address104154 ; (BNAM,"MSG",C0CIEN[for File 3.9])=Number of Attachments 104125 104155 "RTN","C0CMAIL2",40,0) 104126 ; (BNAM,"MSG",C0CIEN, "TO NAME",n)=Names or EMAIL Address104156 ; (BNAM,"MSG",C0CIEN,num,"CONT") = Free Text 104127 104157 "RTN","C0CMAIL2",41,0) 104128 ; (BNAM,"MSG",C0CIEN, "TITLE")=EMAIL Title104158 ; (BNAM,"MSG",C0CIEN,num,"LINES") = Number of Lines of Text 104129 104159 "RTN","C0CMAIL2",42,0) 104130 ; (BNAM,"MSG",C0CIEN [for File 3.9])=Number of Attachments104160 ; (BNAM,"MSG",C0CIEN,num,"SIZE") = Size of the Message in Bytes 104131 104161 "RTN","C0CMAIL2",43,0) 104132 ; (BNAM,"MSG",C0CIEN,num," CONT") = Free Text104162 ; (BNAM,"MSG",C0CIEN,num,"TXT",LINE#) = Message Data (No Attachment) 104133 104163 "RTN","C0CMAIL2",44,0) 104134 ; (BNAM,"MSG",C0CIEN,num,"LINES") = Number of Lines of Text104164 ; (BNAM,"MSG",C0CIEN,"SEG",NUM) = First Line^Last Line 104135 104165 "RTN","C0CMAIL2",45,0) 104136 ; (BNAM,"MSG",C0CIEN,num,"SIZE") = Size of the Message in Bytes104166 ; (BNAM,"MSG",C0CIEN,"SEG",NUM,"CONT",type) = Message Details 104137 104167 "RTN","C0CMAIL2",46,0) 104138 ; (BNAM,"MSG",C0CIEN,num,"TXT",LINE#) = Message Data (No Attachment)104168 ; (BNAM,"MSG",C0CIEN,"SEG",NUM,LINE#) = Message Data 104139 104169 "RTN","C0CMAIL2",47,0) 104140 ; (BNAM,"MSG",C0CIEN,"SEG",NUM) = First Line^Last Line104170 ; 104141 104171 "RTN","C0CMAIL2",48,0) 104142 ; (BNAM,"MSG",C0CIEN,"SEG",NUM,"CONT",type) = Message Details104172 ; DO DETAIL^C0CMAIL(.OUTBF,D0) ; For each Email Message and Attachments 104143 104173 "RTN","C0CMAIL2",49,0) 104144 ; (BNAM,"MSG",C0CIEN,"SEG",NUM,LINE#) = Message Data104174 ; Input; 104145 104175 "RTN","C0CMAIL2",50,0) 104176 ; D0 - The IEN for the message in file 3.9, MESSAGE global 104177 "RTN","C0CMAIL2",51,0) 104178 ; Output 104179 "RTN","C0CMAIL2",52,0) 104180 ; OUTBF - The array of your choice to save the expanded and decoded message. 104181 "RTN","C0CMAIL2",53,0) 104146 104182 ; 104147 "RTN","C0CMAIL2",51,0)104148 ; DO DETAIL^C0CMAIL(.OUTBF,D0) ; For each Email Message and Attachments104149 "RTN","C0CMAIL2",52,0)104150 ; Input;104151 "RTN","C0CMAIL2",53,0)104152 ; D0 - The IEN for the message in file 3.9, MESSAGE global104153 104183 "RTN","C0CMAIL2",54,0) 104154 ; Output 104184 GETMSG(C0CDATA,C0CINPUT) ; Common Entry Point for Mailbox Data 104155 104185 "RTN","C0CMAIL2",55,0) 104156 ; OUTBF - The array of your choice to save the expanded and decoded message.104186 K:'$G(C0CDATA("KEEP")) C0CDATA 104157 104187 "RTN","C0CMAIL2",56,0) 104158 ;104188 N U 104159 104189 "RTN","C0CMAIL2",57,0) 104160 GETMSG(C0CDATA,C0CINPUT) ; Common Entry Point for Mailbox Data 104190 S U="^" 104161 104191 "RTN","C0CMAIL2",58,0) 104162 K:'$G(C0CDATA("KEEP")) C0CDATA104192 D:$G(C0CINPUT) 104163 104193 "RTN","C0CMAIL2",59,0) 104164 N U104194 . N BF,DUZ,I,INPUT,J,L,LST,MBLST,MALL 104165 104195 "RTN","C0CMAIL2",60,0) 104166 S U="^"104196 . S INPUT=C0CINPUT 104167 104197 "RTN","C0CMAIL2",61,0) 104168 D:$G(C0CINPUT)104198 . S DUZ=+INPUT 104169 104199 "RTN","C0CMAIL2",62,0) 104170 . N BF,DUZ,I,INPUT,J,L,LST,MBLST,MALL104200 . I $D(^VA(200,DUZ))=0!('$D(^VA(200,DUZ,0))) D ERROR("ER06") Q 104171 104201 "RTN","C0CMAIL2",63,0) 104172 . S INPUT=C0CINPUT104202 . ; 104173 104203 "RTN","C0CMAIL2",64,0) 104174 . S DUZ=+INPUT104204 . D:$D(^XMB(3.7,DUZ,0))#2 104175 104205 "RTN","C0CMAIL2",65,0) 104176 . I $D(^VA(200,DUZ))=0!('$D(^VA(200,DUZ,0))) D ERROR("ER06") Q104206 . . S MBLST=$P(INPUT,";",2) 104177 104207 "RTN","C0CMAIL2",66,0) 104178 . ;104208 . . S MALL=$P(INPUT,";",3) ; New or All Mail Flag 104179 104209 "RTN","C0CMAIL2",67,0) 104180 . D:$D(^XMB(3.7,DUZ,0))#2104210 . . S:MALL["*" MALL=99999 104181 104211 "RTN","C0CMAIL2",68,0) 104182 . . S MBLST=$P(INPUT,";",2)104212 . . ; Only one of these can be correct 104183 104213 "RTN","C0CMAIL2",69,0) 104184 . . S MALL=$P(INPUT,";",3) ; New or All Mail Flag104214 . . D 104185 104215 "RTN","C0CMAIL2",70,0) 104186 . . S:MALL["*" MALL=99999104216 . . . ; If nul, make it "IN" only 104187 104217 "RTN","C0CMAIL2",71,0) 104188 . . ; Only one of these can be correct104218 . . . I MBLST="" D QUIT 104189 104219 "RTN","C0CMAIL2",72,0) 104190 . . D104220 . . . . S MBLST("IN")=0,I=0 104191 104221 "RTN","C0CMAIL2",73,0) 104192 . . . ; If nul, make it "IN" only104222 . . . . D GATHER(DUZ,"IN",.LST) 104193 104223 "RTN","C0CMAIL2",74,0) 104194 . . . I MBLST="" DQUIT104224 . . . .QUIT 104195 104225 "RTN","C0CMAIL2",75,0) 104196 . . . . S MBLST("IN")=0,I=0104226 . . . ; 104197 104227 "RTN","C0CMAIL2",76,0) 104198 . . . . D GATHER(DUZ,"IN",.LST)104228 . . . ; If "*", Get all Mailboxes and look for New Messages 104199 104229 "RTN","C0CMAIL2",77,0) 104230 . . . I MBLST["*" D QUIT 104231 "RTN","C0CMAIL2",78,0) 104232 . . . . N NAM,NUM 104233 "RTN","C0CMAIL2",79,0) 104234 . . . . S NUM=0 104235 "RTN","C0CMAIL2",80,0) 104236 . . . . F S NUM=$O(^XMB(3.7,DUZ,2,NUM)) Q:'NUM D 104237 "RTN","C0CMAIL2",81,0) 104238 . . . . . S NAM=$P(^XMB(3.7,DUZ,2,NUM,0),U) 104239 "RTN","C0CMAIL2",82,0) 104240 . . . . . D GATHER(DUZ,NAM,.LST) 104241 "RTN","C0CMAIL2",83,0) 104242 . . . . .QUIT 104243 "RTN","C0CMAIL2",84,0) 104200 104244 . . . .QUIT 104201 "RTN","C0CMAIL2", 78,0)104245 "RTN","C0CMAIL2",85,0) 104202 104246 . . . ; 104203 "RTN","C0CMAIL2",79,0)104204 . . . ; If "*", Get all Mailboxes and look for New Messages104205 "RTN","C0CMAIL2",80,0)104206 . . . I MBLST["*" D QUIT104207 "RTN","C0CMAIL2",81,0)104208 . . . . N NAM,NUM104209 "RTN","C0CMAIL2",82,0)104210 . . . . S NUM=0104211 "RTN","C0CMAIL2",83,0)104212 . . . . F S NUM=$O(^XMB(3.7,DUZ,2,NUM)) Q:'NUM D104213 "RTN","C0CMAIL2",84,0)104214 . . . . . S NAM=$P(^XMB(3.7,DUZ,2,NUM,0),U)104215 "RTN","C0CMAIL2",85,0)104216 . . . . . D GATHER(DUZ,NAM,.LST)104217 104247 "RTN","C0CMAIL2",86,0) 104248 . . . ; If comma separated, look for mailboxes with new messages 104249 "RTN","C0CMAIL2",87,0) 104250 . . . I $L(MBLST,",")>1 D QUIT 104251 "RTN","C0CMAIL2",88,0) 104252 . . . . S NAM="" 104253 "RTN","C0CMAIL2",89,0) 104254 . . . . N TN,V 104255 "RTN","C0CMAIL2",90,0) 104256 . . . . F TN=1:1:$L(MBLST,",") S V=$P(MBLST,",",TN) D 104257 "RTN","C0CMAIL2",91,0) 104258 . . . . . I $L(V) D QUIT 104259 "RTN","C0CMAIL2",92,0) 104260 . . . . . . I V S NAM=$P($G(^XMB(3.7,DUZ,2,V,0)),U) 104261 "RTN","C0CMAIL2",93,0) 104262 . . . . . . S:NAM="" NAM=V 104263 "RTN","C0CMAIL2",94,0) 104264 . . . . . . D GATHER(DUZ,NAM,.LST) 104265 "RTN","C0CMAIL2",95,0) 104266 . . . . . .QUIT 104267 "RTN","C0CMAIL2",96,0) 104268 . . . . . ; 104269 "RTN","C0CMAIL2",97,0) 104270 . . . . . D ERROR("ER08") 104271 "RTN","C0CMAIL2",98,0) 104218 104272 . . . . .QUIT 104219 "RTN","C0CMAIL2", 87,0)104273 "RTN","C0CMAIL2",99,0) 104220 104274 . . . .QUIT 104221 "RTN","C0CMAIL2", 88,0)104275 "RTN","C0CMAIL2",100,0) 104222 104276 . . . ; 104223 "RTN","C0CMAIL2",89,0)104224 . . . ; If comma separated, look for mailboxes with new messages104225 "RTN","C0CMAIL2",90,0)104226 . . . I $L(MBLST,",")>1 D QUIT104227 "RTN","C0CMAIL2",91,0)104228 . . . . S NAM=""104229 "RTN","C0CMAIL2",92,0)104230 . . . . N TN,V104231 "RTN","C0CMAIL2",93,0)104232 . . . . F TN=1:1:$L(MBLST,",") S V=$P(MBLST,",",TN) D104233 "RTN","C0CMAIL2",94,0)104234 . . . . . I $L(V) D QUIT104235 "RTN","C0CMAIL2",95,0)104236 . . . . . . I V S NAM=$P($G(^XMB(3.7,DUZ,2,V,0)),U)104237 "RTN","C0CMAIL2",96,0)104238 . . . . . . S:NAM="" NAM=V104239 "RTN","C0CMAIL2",97,0)104240 . . . . . . D GATHER(DUZ,NAM,.LST)104241 "RTN","C0CMAIL2",98,0)104242 . . . . . .QUIT104243 "RTN","C0CMAIL2",99,0)104244 . . . . . ;104245 "RTN","C0CMAIL2",100,0)104246 . . . . . D ERROR("ER08")104247 104277 "RTN","C0CMAIL2",101,0) 104248 . . . . .QUIT104278 . . . ; If only 1 mailbox named, go get it 104249 104279 "RTN","C0CMAIL2",102,0) 104250 . . . .QUIT104280 . . . I $L(MBLST) D QUIT 104251 104281 "RTN","C0CMAIL2",103,0) 104252 . . . ;104282 . . . . I $D(^XMB(3.7,DUZ,2,"B",MBLST)) D GATHER(DUZ,MBLST,.LST) QUIT 104253 104283 "RTN","C0CMAIL2",104,0) 104254 . . . ; If only 1 mailbox named, go get it104284 . . . . ; 104255 104285 "RTN","C0CMAIL2",105,0) 104256 . . . I $L(MBLST) D QUIT104286 . . . . D ERROR("ER07") 104257 104287 "RTN","C0CMAIL2",106,0) 104258 . . . . I $D(^XMB(3.7,DUZ,2,"B",MBLST)) D GATHER(DUZ,MBLST,.LST)QUIT104288 . . .QUIT 104259 104289 "RTN","C0CMAIL2",107,0) 104260 . . . . ;104290 . . MERGE C0CDATA=LST 104261 104291 "RTN","C0CMAIL2",108,0) 104262 . . . . D ERROR("ER07")104292 . .QUIT 104263 104293 "RTN","C0CMAIL2",109,0) 104264 . . .QUIT104294 .QUIT 104265 104295 "RTN","C0CMAIL2",110,0) 104266 . . MERGE C0CDATA=LST104296 QUIT 104267 104297 "RTN","C0CMAIL2",111,0) 104298 ; =================== 104299 "RTN","C0CMAIL2",112,0) 104300 GATHER(DUZ,NAM,LST) ; Gather Data about the Baskets and their mail 104301 "RTN","C0CMAIL2",113,0) 104302 N I,J,K,L 104303 "RTN","C0CMAIL2",114,0) 104304 S (I,K)=0 104305 "RTN","C0CMAIL2",115,0) 104306 S J=$O(^XMB(3.7,DUZ,2,"B",NAM,"")) 104307 "RTN","C0CMAIL2",116,0) 104308 F S I=$O(^XMB(3.7,DUZ,2,J,1,I)) Q:'I D 104309 "RTN","C0CMAIL2",117,0) 104310 . S L=$P(^XMB(3.7,DUZ,2,J,1,I,0),U,3) 104311 "RTN","C0CMAIL2",118,0) 104312 . D ; :L 104313 "RTN","C0CMAIL2",119,0) 104314 . . S:L K=K+1,LST(NAM,"MSG",I,"NEW")="" ; Flag NEW emails 104315 "RTN","C0CMAIL2",120,0) 104316 . . S LST(NAM,"MSG",I)=L 104317 "RTN","C0CMAIL2",121,0) 104318 . . D GETTYP(I) 104319 "RTN","C0CMAIL2",122,0) 104268 104320 . .QUIT 104269 "RTN","C0CMAIL2",1 12,0)104321 "RTN","C0CMAIL2",123,0) 104270 104322 .QUIT 104271 "RTN","C0CMAIL2",113,0) 104323 "RTN","C0CMAIL2",124,0) 104324 S LST(NAM,"NUMBER")=K 104325 "RTN","C0CMAIL2",125,0) 104272 104326 QUIT 104273 "RTN","C0CMAIL2",1 14,0)104327 "RTN","C0CMAIL2",126,0) 104274 104328 ; =================== 104275 "RTN","C0CMAIL2",115,0)104276 GATHER(DUZ,NAM,LST) ; Gather Data about the Baskets and their mail104277 "RTN","C0CMAIL2",116,0)104278 N I,J,K,L104279 "RTN","C0CMAIL2",117,0)104280 S (I,K)=0104281 "RTN","C0CMAIL2",118,0)104282 S J=$O(^XMB(3.7,DUZ,2,"B",NAM,""))104283 "RTN","C0CMAIL2",119,0)104284 F S I=$O(^XMB(3.7,DUZ,2,J,1,I)) Q:'I D104285 "RTN","C0CMAIL2",120,0)104286 . S L=$P(^XMB(3.7,DUZ,2,J,1,I,0),U,3)104287 "RTN","C0CMAIL2",121,0)104288 . D ; :L104289 "RTN","C0CMAIL2",122,0)104290 . . S:L K=K+1,LST(NAM,"MSG",I,"NEW")="" ; Flag NEW emails104291 "RTN","C0CMAIL2",123,0)104292 . . S LST(NAM,"MSG",I)=L104293 "RTN","C0CMAIL2",124,0)104294 . . D GETTYP(I)104295 "RTN","C0CMAIL2",125,0)104296 . .QUIT104297 "RTN","C0CMAIL2",126,0)104298 .QUIT104299 104329 "RTN","C0CMAIL2",127,0) 104300 S LST(NAM,"NUMBER")=K104330 ; D0 is the IEN into the Message Global ^XMB(3.9,D0) 104301 104331 "RTN","C0CMAIL2",128,0) 104302 QUIT104332 ; The products of these emails are scanned to identify 104303 104333 "RTN","C0CMAIL2",129,0) 104304 ; ===================104334 ; the number of documents stored in the MIME package. 104305 104335 "RTN","C0CMAIL2",130,0) 104306 ; D0 is the IEN into the Message Global ^XMB(3.9,D0)104336 ; The protocol runs like this; 104307 104337 "RTN","C0CMAIL2",131,0) 104308 ; The products of these emails are scanned to identify104338 ; Line 1 is the --separator 104309 104339 "RTN","C0CMAIL2",132,0) 104310 ; the number of documents stored in the MIME package.104340 ; Line 2 thru n >Look for Content-[detail type:]Description ; Next CMD 104311 104341 "RTN","C0CMAIL2",133,0) 104312 ; The protocol runs like this;104342 ; Line n+2 thru t-1 where t does NOT have "Content-" 104313 104343 "RTN","C0CMAIL2",134,0) 104314 ; Line 1 is the--separator104344 ; Line t is Next Section Terminator, or Message Terminator, --separator 104315 104345 "RTN","C0CMAIL2",135,0) 104316 ; Line 2 thru n >Look for Content-[detail type:]Description ; Next CMD104346 ; Line t+1 should not exist in the data set if Message Terminator 104317 104347 "RTN","C0CMAIL2",136,0) 104318 ; Line n+2 thru t-1 where t does NOT have"Content-"104348 ; CON = "Content-" 104319 104349 "RTN","C0CMAIL2",137,0) 104320 ; Line t is Next Section Terminator, or Message Terminator, --separator104350 ; FLG = "--" 104321 104351 "RTN","C0CMAIL2",138,0) 104322 ; Line t+1 should not exist in the data set if Message Terminator104352 ; SEP = FLG+7 or more characters ; Separator 104323 104353 "RTN","C0CMAIL2",139,0) 104324 ; CON = "Content-"104354 ; END = SEP+FLG 104325 104355 "RTN","C0CMAIL2",140,0) 104326 ; FLG = "--"104356 ; SGC = Segment Count 104327 104357 "RTN","C0CMAIL2",141,0) 104328 ; SEP = FLG+7 or more characters ; Separator104358 ; Note: separator is a string of specific characters of 104329 104359 "RTN","C0CMAIL2",142,0) 104330 ; END = SEP+FLG104360 ; indeterminate length 104331 104361 "RTN","C0CMAIL2",143,0) 104332 ; SGC = Segment Count104362 ; LST() the transfer array 104333 104363 "RTN","C0CMAIL2",144,0) 104334 ; Note: separator is a string of specific characters of104364 ; LST(NAM,"MSG",C0CIEN,"SEG",SGN)=Starting Line^Ending Line 104335 104365 "RTN","C0CMAIL2",145,0) 104336 ; indeterminate length104366 ; LST(NAM,"MSG",C0CIEN,"SEG",SGN,1:n)=Decoded Message Data 104337 104367 "RTN","C0CMAIL2",146,0) 104338 ; LST() the transfer array104368 ; 104339 104369 "RTN","C0CMAIL2",147,0) 104340 ; LST(NAM,"MSG",C0CIEN,"SEG",SGN)=Starting Line^Ending Line 104370 GETTYP(D0) ; Look for the goodies in the Mail 104341 104371 "RTN","C0CMAIL2",148,0) 104342 ; LST(NAM,"MSG",C0CIEN,"SEG",SGN,1:n)=Decoded Message Data104372 N I,J,N,BCN,CON,CNT,D1,END,FLG,SEP,SGC,XX,XXNM 104343 104373 "RTN","C0CMAIL2",149,0) 104344 ;104374 S CON="Content-" 104345 104375 "RTN","C0CMAIL2",150,0) 104346 GETTYP(D0) ; Look for the goodies in the Mail 104376 S FLG="--" 104347 104377 "RTN","C0CMAIL2",151,0) 104348 N I,J,N,BCN,CON,CNT,D1,END,FLG,SEP,SGC,XX,XXNM104378 S SEP="" ; Start SEP as null, so we can use this to help identify the type 104349 104379 "RTN","C0CMAIL2",152,0) 104350 S CON="Content-"104380 S (BCN,CNT,D1,END,SGC)=0 104351 104381 "RTN","C0CMAIL2",153,0) 104352 S FLG="--"104382 S XX=$G(^XMB(3.9,D0,0)) 104353 104383 "RTN","C0CMAIL2",154,0) 104354 S SEP="" ; Start SEP as null, so we can use this to help identify the type104384 S LST(NAM,"MSG",D0,"TITLE")=$P($G(^XMB(3.9,D0,0)),U,1) 104355 104385 "RTN","C0CMAIL2",155,0) 104356 S (BCN,CNT,D1,END,SGC)=0104386 S LST(NAM,"MSG",D0,"CREATED")=$G(^XMB(3.9,D0,.6)) 104357 104387 "RTN","C0CMAIL2",156,0) 104358 S XX=$G(^XMB(3.9,D0,0))104388 F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM) 104359 104389 "RTN","C0CMAIL2",157,0) 104360 S LST(NAM,"MSG",D0," TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)104390 S LST(NAM,"MSG",D0,"FROM")=$$NAME(XXNM) 104361 104391 "RTN","C0CMAIL2",158,0) 104362 S LST(NAM,"MSG",D0," CREATED")=$G(^XMB(3.9,D0,.6))104392 S LST(NAM,"MSG",D0,"SENT")=$$TIME($P(XX,U,3)) 104363 104393 "RTN","C0CMAIL2",159,0) 104364 F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM)104394 ; Get the folks the email is sent to. 104365 104395 "RTN","C0CMAIL2",160,0) 104366 S LST(NAM,"MSG",D0,"FROM")=$$NAME(XXNM)104396 S D1=0 104367 104397 "RTN","C0CMAIL2",161,0) 104368 S LST(NAM,"MSG",D0,"SENT")=$$TIME($P(XX,U,3))104398 F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D 104369 104399 "RTN","C0CMAIL2",162,0) 104370 ; Get the folks the email is sent to.104400 . N T 104371 104401 "RTN","C0CMAIL2",163,0) 104372 S D1=0104402 . S T=+$G(^XMB(3.9,D0,1,D1,0)) 104373 104403 "RTN","C0CMAIL2",164,0) 104374 F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D104404 . S:T T=$P($G(^VA(200,+T,0)),"^") 104375 104405 "RTN","C0CMAIL2",165,0) 104376 . NT104406 . S LST("TO",D1)=T 104377 104407 "RTN","C0CMAIL2",166,0) 104378 . S T= +$G(^XMB(3.9,D0,1,D1,0))104408 . S T=$G(^XMB(3.9,D0,6,D1,0)) 104379 104409 "RTN","C0CMAIL2",167,0) 104380 104410 . S:T T=$P($G(^VA(200,+T,0)),"^") 104381 104411 "RTN","C0CMAIL2",168,0) 104382 . S LST("TO",D1)=T104412 . S:T="" T="<Unknown>" 104383 104413 "RTN","C0CMAIL2",169,0) 104384 . S T=$G(^XMB(3.9,D0,6,D1,0))104414 . S LST("TO NAME",D1)=T 104385 104415 "RTN","C0CMAIL2",170,0) 104386 . S:T T=$P($G(^VA(200,+T,0)),"^")104416 .QUIT 104387 104417 "RTN","C0CMAIL2",171,0) 104388 . S:T="" T="<Unknown>"104418 ; Preload first Segment (0) with beginning on Line 1 104389 104419 "RTN","C0CMAIL2",172,0) 104390 . S LST("TO NAME",D1)=T104420 ; if not a 64bit 104391 104421 "RTN","C0CMAIL2",173,0) 104422 S LST(NAM,"MSG",D0,"SEG",0)=1 104423 "RTN","C0CMAIL2",174,0) 104424 S D1=.9999,SEP="@@" 104425 "RTN","C0CMAIL2",175,0) 104426 F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D 104427 "RTN","C0CMAIL2",176,0) 104428 . ; Clear any control characters (cr/lf/ff) off 104429 "RTN","C0CMAIL2",177,0) 104430 . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13)) 104431 "RTN","C0CMAIL2",178,0) 104432 . ; Enter once to set the SEP to capture the separator 104433 "RTN","C0CMAIL2",179,0) 104434 . I SEP=FLG&($E(X,1,2)=FLG)&($L(X,FLG)=2)&($L($P(X,FLG,2)>5)) D Q 104435 "RTN","C0CMAIL2",180,0) 104436 . . S SEP=X,END=X_FLG 104437 "RTN","C0CMAIL2",181,0) 104438 . . S (CNT,SGC)=1,BCN=0 104439 "RTN","C0CMAIL2",182,0) 104440 . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1 104441 "RTN","C0CMAIL2",183,0) 104442 . .QUIT 104443 "RTN","C0CMAIL2",184,0) 104444 . ; 104445 "RTN","C0CMAIL2",185,0) 104446 . ; A new separator is set, process original 104447 "RTN","C0CMAIL2",186,0) 104448 . I X=SEP D QUIT 104449 "RTN","C0CMAIL2",187,0) 104450 . . S LST(NAM,"MSG",D0,SGC,"SIZE")=BCN+$L(BF) 104451 "RTN","C0CMAIL2",188,0) 104452 . . S LST(NAM,"MSG",D0,"SEG",SGC)=$G(LST(NAM,"MSG",D0,"SEG",SGC))_"^"_(D1-1) 104453 "RTN","C0CMAIL2",189,0) 104454 . . S SGC=SGC+1,BCN=0 104455 "RTN","C0CMAIL2",190,0) 104456 . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1 104457 "RTN","C0CMAIL2",191,0) 104458 . .QUIT 104459 "RTN","C0CMAIL2",192,0) 104460 . ; 104461 "RTN","C0CMAIL2",193,0) 104462 . S BCN=BCN+$L(X) 104463 "RTN","C0CMAIL2",194,0) 104464 . I X[CON D Q 104465 "RTN","C0CMAIL2",195,0) 104466 . . S J=$P($P(X,";"),CON,2) 104467 "RTN","C0CMAIL2",196,0) 104468 . . S LST(NAM,"MSG",D0,"SEG",SGC,"CONT",CNT,$P(J,":"))=$P(J,":",2) 104469 "RTN","C0CMAIL2",197,0) 104470 . .QUIT 104471 "RTN","C0CMAIL2",198,0) 104472 . ; 104473 "RTN","C0CMAIL2",199,0) 104474 . ; S LST(NAM,"MSG",D0,"SEG",D1)=X 104475 "RTN","C0CMAIL2",200,0) 104392 104476 .QUIT 104393 "RTN","C0CMAIL2",174,0) 104394 ; Preload first Segment (0) with beginning on Line 1 104395 "RTN","C0CMAIL2",175,0) 104396 ; if not a 64bit 104397 "RTN","C0CMAIL2",176,0) 104398 S LST(NAM,"MSG",D0,"SEG",0)=1 104399 "RTN","C0CMAIL2",177,0) 104400 S D1=.9999,SEP="@@" 104401 "RTN","C0CMAIL2",178,0) 104402 F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D 104403 "RTN","C0CMAIL2",179,0) 104404 . ; Clear any control characters (cr/lf/ff) off 104405 "RTN","C0CMAIL2",180,0) 104406 . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13)) 104407 "RTN","C0CMAIL2",181,0) 104408 . ; Enter once to set the SEP to capture the separator 104409 "RTN","C0CMAIL2",182,0) 104410 . I SEP=FLG&($E(X,1,2)=FLG)&($L(X,FLG)=2)&($L($P(X,FLG,2)>5)) D Q 104411 "RTN","C0CMAIL2",183,0) 104412 . . S SEP=X,END=X_FLG 104413 "RTN","C0CMAIL2",184,0) 104414 . . S (CNT,SGC)=1,BCN=0 104415 "RTN","C0CMAIL2",185,0) 104416 . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1 104417 "RTN","C0CMAIL2",186,0) 104418 . .QUIT 104419 "RTN","C0CMAIL2",187,0) 104477 "RTN","C0CMAIL2",201,0) 104478 QUIT 104479 "RTN","C0CMAIL2",202,0) 104480 ; =================== 104481 "RTN","C0CMAIL2",203,0) 104482 NAME(NM) ; Return the name of the Sender 104483 "RTN","C0CMAIL2",204,0) 104484 N NAME 104485 "RTN","C0CMAIL2",205,0) 104486 S NAME="<Unknown Sender>" 104487 "RTN","C0CMAIL2",206,0) 104488 D 104489 "RTN","C0CMAIL2",207,0) 104490 . ; Look first for a value to use with the NEW PERSON file 104491 "RTN","C0CMAIL2",208,0) 104420 104492 . ; 104421 "RTN","C0CMAIL2",188,0) 104422 . ; A new separator is set, process original 104423 "RTN","C0CMAIL2",189,0) 104424 . I X=SEP D QUIT 104425 "RTN","C0CMAIL2",190,0) 104426 . . S LST(NAM,"MSG",D0,SGC,"SIZE")=BCN+$L(BF) 104427 "RTN","C0CMAIL2",191,0) 104428 . . S LST(NAM,"MSG",D0,"SEG",SGC)=$G(LST(NAM,"MSG",D0,"SEG",SGC))_"^"_(D1-1) 104429 "RTN","C0CMAIL2",192,0) 104430 . . S SGC=SGC+1,BCN=0 104431 "RTN","C0CMAIL2",193,0) 104432 . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1 104433 "RTN","C0CMAIL2",194,0) 104434 . .QUIT 104435 "RTN","C0CMAIL2",195,0) 104493 "RTN","C0CMAIL2",209,0) 104494 . I NM=+NM S NAME=$P(^VA(200,NM,0),U,1) Q 104495 "RTN","C0CMAIL2",210,0) 104436 104496 . ; 104437 "RTN","C0CMAIL2",196,0) 104438 . S BCN=BCN+$L(X) 104439 "RTN","C0CMAIL2",197,0) 104440 . I X[CON D Q 104441 "RTN","C0CMAIL2",198,0) 104442 . . S J=$P($P(X,";"),CON,2) 104443 "RTN","C0CMAIL2",199,0) 104444 . . S LST(NAM,"MSG",D0,"SEG",SGC,"CONT",CNT,$P(J,":"))=$P(J,":",2) 104445 "RTN","C0CMAIL2",200,0) 104446 . .QUIT 104447 "RTN","C0CMAIL2",201,0) 104497 "RTN","C0CMAIL2",211,0) 104498 . I $L(NM) S NAME=NM Q 104499 "RTN","C0CMAIL2",212,0) 104448 104500 . ; 104449 "RTN","C0CMAIL2",202,0) 104450 . ; S LST(NAM,"MSG",D0,"SEG",D1)=X 104451 "RTN","C0CMAIL2",203,0) 104501 "RTN","C0CMAIL2",213,0) 104502 . ; Else, pull the data from the message and display the foreign source 104503 "RTN","C0CMAIL2",214,0) 104504 . ; of the message. 104505 "RTN","C0CMAIL2",215,0) 104506 . N T 104507 "RTN","C0CMAIL2",216,0) 104508 . S VAL=$G(^XMB(3.9,D0,.7)) 104509 "RTN","C0CMAIL2",217,0) 104510 . S:VAL T=$P(^VA(200,VAL,0),U) 104511 "RTN","C0CMAIL2",218,0) 104512 . I $L($G(T)) S NAME=T Q 104513 "RTN","C0CMAIL2",219,0) 104514 . ; 104515 "RTN","C0CMAIL2",220,0) 104452 104516 .QUIT 104453 "RTN","C0CMAIL2",2 04,0)104454 QUIT 104455 "RTN","C0CMAIL2",2 05,0)104517 "RTN","C0CMAIL2",221,0) 104518 QUIT NAME 104519 "RTN","C0CMAIL2",222,0) 104456 104520 ; =================== 104457 "RTN","C0CMAIL2",206,0) 104458 NAME(NM) ; Return the name of the Sender 104459 "RTN","C0CMAIL2",207,0) 104460 N NAME 104461 "RTN","C0CMAIL2",208,0) 104462 S NAME="<Unknown Sender>" 104463 "RTN","C0CMAIL2",209,0) 104464 D 104465 "RTN","C0CMAIL2",210,0) 104466 . ; Look first for a value to use with the NEW PERSON file 104467 "RTN","C0CMAIL2",211,0) 104521 "RTN","C0CMAIL2",223,0) 104522 TIME(Y) ; The time and date of the sending 104523 "RTN","C0CMAIL2",224,0) 104524 X ^DD("DD") 104525 "RTN","C0CMAIL2",225,0) 104526 QUIT Y 104527 "RTN","C0CMAIL2",226,0) 104528 ; =================== 104529 "RTN","C0CMAIL2",227,0) 104530 ; Segments in Message need to be identified and decoded properly 104531 "RTN","C0CMAIL2",228,0) 104532 ; D DETAIL^C0CMAIL(.ARRAY,D0) ; Call One for each message 104533 "RTN","C0CMAIL2",229,0) 104534 ; ARRAY will have the details of this one call 104535 "RTN","C0CMAIL2",230,0) 104536 ; 104537 "RTN","C0CMAIL2",231,0) 104538 ; Inputs; 104539 "RTN","C0CMAIL2",232,0) 104540 ; C0CINPUT - The IEN of the message to expand 104541 "RTN","C0CMAIL2",233,0) 104542 ; Outputs; 104543 "RTN","C0CMAIL2",234,0) 104544 ; C0CDATA - Carrier for the returned structure of the Message 104545 "RTN","C0CMAIL2",235,0) 104546 ; C0CDATA(D0,"SEG")=number of SEGMENTS 104547 "RTN","C0CMAIL2",236,0) 104548 ; C0CDATA(D0,"SEG",0:n)=SEGMENT n details; First;Last;Type 104549 "RTN","C0CMAIL2",237,0) 104550 ; C0CDATA(D0,"SEG",0:n,"CONTENT",type)=Content details 104551 "RTN","C0CMAIL2",238,0) 104552 ; C0CDATA(D0,"SEG",0:n,"MSG",D3)=Content details 104553 "RTN","C0CMAIL2",239,0) 104554 ; C0CDATA(D0,"SEG",0:n,"HTML",D3)=Content details 104555 "RTN","C0CMAIL2",240,0) 104556 ; 104557 "RTN","C0CMAIL2",241,0) 104558 DETAIL(C0CDATA,C0CINPUT) ; Message Detail Delivery 104559 "RTN","C0CMAIL2",242,0) 104560 N LST,D0,D1,U 104561 "RTN","C0CMAIL2",243,0) 104562 S U="^" 104563 "RTN","C0CMAIL2",244,0) 104564 S D0=+$G(C0CINPUT) 104565 "RTN","C0CMAIL2",245,0) 104566 I D0 D QUIT 104567 "RTN","C0CMAIL2",246,0) 104568 . I $D(^XMB(3.9,D0))<10 D ERROR("ER01") QUIT 104569 "RTN","C0CMAIL2",247,0) 104468 104570 . ; 104469 "RTN","C0CMAIL2",212,0)104470 . I NM=+NM S NAME=$P(^VA(200,NM,0),U,1) Q104471 "RTN","C0CMAIL2",213,0)104472 . ;104473 "RTN","C0CMAIL2",214,0)104474 . I $L(NM) S NAME=NM Q104475 "RTN","C0CMAIL2",215,0)104476 . ;104477 "RTN","C0CMAIL2",216,0)104478 . ; Else, pull the data from the message and display the foreign source104479 "RTN","C0CMAIL2",217,0)104480 . ; of the message.104481 "RTN","C0CMAIL2",218,0)104482 . N T104483 "RTN","C0CMAIL2",219,0)104484 . S VAL=$G(^XMB(3.9,D0,.7))104485 "RTN","C0CMAIL2",220,0)104486 . S:VAL T=$P(^VA(200,VAL,0),U)104487 "RTN","C0CMAIL2",221,0)104488 . I $L($G(T)) S NAME=T Q104489 "RTN","C0CMAIL2",222,0)104490 . ;104491 "RTN","C0CMAIL2",223,0)104492 .QUIT104493 "RTN","C0CMAIL2",224,0)104494 QUIT NAME104495 "RTN","C0CMAIL2",225,0)104496 ; ===================104497 "RTN","C0CMAIL2",226,0)104498 TIME(Y) ; The time and date of the sending104499 "RTN","C0CMAIL2",227,0)104500 X ^DD("DD")104501 "RTN","C0CMAIL2",228,0)104502 QUIT Y104503 "RTN","C0CMAIL2",229,0)104504 ; ===================104505 "RTN","C0CMAIL2",230,0)104506 ; Segments in Message need to be identified and decoded properly104507 "RTN","C0CMAIL2",231,0)104508 ; D DETAIL^C0CMAIL(.ARRAY,D0) ; Call One for each message104509 "RTN","C0CMAIL2",232,0)104510 ; ARRAY will have the details of this one call104511 "RTN","C0CMAIL2",233,0)104512 ;104513 "RTN","C0CMAIL2",234,0)104514 ; Inputs;104515 "RTN","C0CMAIL2",235,0)104516 ; C0CINPUT - The IEN of the message to expand104517 "RTN","C0CMAIL2",236,0)104518 ; Outputs;104519 "RTN","C0CMAIL2",237,0)104520 ; C0CDATA - Carrier for the returned structure of the Message104521 "RTN","C0CMAIL2",238,0)104522 ; C0CDATA(D0,"SEG")=number of SEGMENTS104523 "RTN","C0CMAIL2",239,0)104524 ; C0CDATA(D0,"SEG",0:n)=SEGMENT n details; First;Last;Type104525 "RTN","C0CMAIL2",240,0)104526 ; C0CDATA(D0,"SEG",0:n,"CONTENT",type)=Content details104527 "RTN","C0CMAIL2",241,0)104528 ; C0CDATA(D0,"SEG",0:n,"MSG",D3)=Content details104529 "RTN","C0CMAIL2",242,0)104530 ; C0CDATA(D0,"SEG",0:n,"HTML",D3)=Content details104531 "RTN","C0CMAIL2",243,0)104532 ;104533 "RTN","C0CMAIL2",244,0)104534 DETAIL(C0CDATA,C0CINPUT) ; Message Detail Delivery104535 "RTN","C0CMAIL2",245,0)104536 N LST,D0,D1,U104537 "RTN","C0CMAIL2",246,0)104538 S U="^"104539 "RTN","C0CMAIL2",247,0)104540 S D0=+$G(C0CINPUT)104541 104571 "RTN","C0CMAIL2",248,0) 104542 I D0 D QUIT104572 . D GETTYP2(D0) 104543 104573 "RTN","C0CMAIL2",249,0) 104544 . I $D( ^XMB(3.9,D0))<10 D ERROR("ER01") QUIT104574 . I $D(LST) M C0CDATA(D0)=LST Q 104545 104575 "RTN","C0CMAIL2",250,0) 104546 104576 . ; 104547 104577 "RTN","C0CMAIL2",251,0) 104548 . D GETTYP2(D0)104578 . D ERROR("ER02") 104549 104579 "RTN","C0CMAIL2",252,0) 104550 . I $D(LST) M C0CDATA(D0)=LST Q104580 .QUIT 104551 104581 "RTN","C0CMAIL2",253,0) 104582 QUIT 104583 "RTN","C0CMAIL2",254,0) 104584 ; =================== 104585 "RTN","C0CMAIL2",255,0) 104586 ; End note if needed 104587 "RTN","C0CMAIL2",256,0) 104588 ; MSK - Set of characters that do not exist in 64 bit encoding 104589 "RTN","C0CMAIL2",257,0) 104590 GETTYP2(D0) ; Try to get the types and MSK for the 104591 "RTN","C0CMAIL2",258,0) 104592 N I,J,K,N,BCN,BF,CON,CNT,D1,END,FLG,MSK,SEP,SGC,U,XX,ZN,XXNM 104593 "RTN","C0CMAIL2",259,0) 104594 S CON="Content-",U="^" 104595 "RTN","C0CMAIL2",260,0) 104596 S FLG="--" 104597 "RTN","C0CMAIL2",261,0) 104598 S MSK=" !""#$%&'()*,-.:;<>?@[\]^_`{|}~" 104599 "RTN","C0CMAIL2",262,0) 104600 S (BF,SEP)="" ; Start SEP as null, so we can use this to help identify the type 104601 "RTN","C0CMAIL2",263,0) 104602 S (BCN,CNT,D1,END,SGC)=0 104603 "RTN","C0CMAIL2",264,0) 104604 S XX=$G(^XMB(3.9,D0,0)) 104605 "RTN","C0CMAIL2",265,0) 104606 ; S K=$P(^XMB(3.9,D0,2,0),U,3) 104607 "RTN","C0CMAIL2",266,0) 104608 S LST("TITLE")=$P($G(^XMB(3.9,D0,0)),U,1) 104609 "RTN","C0CMAIL2",267,0) 104610 S LST("CREATED")=$$TIME($P(XX,U,3)) 104611 "RTN","C0CMAIL2",268,0) 104612 F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM) 104613 "RTN","C0CMAIL2",269,0) 104614 S LST("FROM")=$$NAME(XXNM) 104615 "RTN","C0CMAIL2",270,0) 104616 ; Get the folks the email is sent to. 104617 "RTN","C0CMAIL2",271,0) 104618 S D1=0 104619 "RTN","C0CMAIL2",272,0) 104620 F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D Q:D1="" 104621 "RTN","C0CMAIL2",273,0) 104622 . N I,T 104623 "RTN","C0CMAIL2",274,0) 104624 . S T=$P($G(^XMB(3.9,D0,1,D1,0)),U) 104625 "RTN","C0CMAIL2",275,0) 104626 . S:T T=$P($G(^VA(200,T,0)),"^") 104627 "RTN","C0CMAIL2",276,0) 104628 . S LST("TO",+D1)=T 104629 "RTN","C0CMAIL2",277,0) 104630 . S T=$G(^XMB(3.9,D0,6,+D1,0)) 104631 "RTN","C0CMAIL2",278,0) 104632 . S:T="" T=$P($G(^VA(200,+T,0)),"^") 104633 "RTN","C0CMAIL2",279,0) 104634 . S:T="" T="<Unknown>" 104635 "RTN","C0CMAIL2",280,0) 104636 . S LST("TO NAME",D1)=T 104637 "RTN","C0CMAIL2",281,0) 104638 .QUIT 104639 "RTN","C0CMAIL2",282,0) 104640 ; Get the Header for the message 104641 "RTN","C0CMAIL2",283,0) 104642 S D1=0 104643 "RTN","C0CMAIL2",284,0) 104644 F I=1:1 S D1=$O(^XMB(3.9,D0,2,D1)) Q:D1="" Q:(D1>.99999) D 104645 "RTN","C0CMAIL2",285,0) 104646 . S LST("HDR",I)=$G(^XMB(3.9,D0,2,D1,0)) 104647 "RTN","C0CMAIL2",286,0) 104648 .QUIT 104649 "RTN","C0CMAIL2",287,0) 104650 ; Start walking the different sections 104651 "RTN","C0CMAIL2",288,0) 104652 S D1=.99999,SEP="@@",SGC=0 104653 "RTN","C0CMAIL2",289,0) 104654 F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D 104655 "RTN","C0CMAIL2",290,0) 104656 . ; Clear any control characters (cr/lf/ff) off 104657 "RTN","C0CMAIL2",291,0) 104658 . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13)) 104659 "RTN","C0CMAIL2",292,0) 104660 . ; Enter once to set the SEP to capture the separator 104661 "RTN","C0CMAIL2",293,0) 104662 . I (SEP="@@")&(X?2."--"5.AN.E) D Q 104663 "RTN","C0CMAIL2",294,0) 104664 . . I $L(X,FLG)>2 D ERROR("ER10") 104665 "RTN","C0CMAIL2",295,0) 104666 . . S SEP=X,END=X_FLG 104667 "RTN","C0CMAIL2",296,0) 104668 . . S (CNT,SGC)=1,BCN=0 104669 "RTN","C0CMAIL2",297,0) 104670 . . S LST("SEG",SGC)=D1 104671 "RTN","C0CMAIL2",298,0) 104672 . .QUIT 104673 "RTN","C0CMAIL2",299,0) 104552 104674 . ; 104553 "RTN","C0CMAIL2",254,0)104554 . D ERROR("ER02")104555 "RTN","C0CMAIL2",255,0)104556 .QUIT104557 "RTN","C0CMAIL2",256,0)104558 QUIT104559 "RTN","C0CMAIL2",257,0)104560 ; ===================104561 "RTN","C0CMAIL2",258,0)104562 ; End note if needed104563 "RTN","C0CMAIL2",259,0)104564 ; MSK - Set of characters that do not exist in 64 bit encoding104565 "RTN","C0CMAIL2",260,0)104566 GETTYP2(D0) ; Try to get the types and MSK for the104567 "RTN","C0CMAIL2",261,0)104568 N I,J,K,N,BCN,BF,CON,CNT,D1,END,FLG,MSK,SEP,SGC,U,XX,ZN,XXNM104569 "RTN","C0CMAIL2",262,0)104570 S CON="Content-",U="^"104571 "RTN","C0CMAIL2",263,0)104572 S FLG="--"104573 "RTN","C0CMAIL2",264,0)104574 S MSK=" !""#$%&'()*,-.:;<>?@[\]^_`{|}~"104575 "RTN","C0CMAIL2",265,0)104576 S (BF,SEP)="" ; Start SEP as null, so we can use this to help identify the type104577 "RTN","C0CMAIL2",266,0)104578 S (BCN,CNT,D1,END,SGC)=0104579 "RTN","C0CMAIL2",267,0)104580 S XX=$G(^XMB(3.9,D0,0))104581 "RTN","C0CMAIL2",268,0)104582 ; S K=$P(^XMB(3.9,D0,2,0),U,3)104583 "RTN","C0CMAIL2",269,0)104584 S LST("TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)104585 "RTN","C0CMAIL2",270,0)104586 S LST("CREATED")=$$TIME($P(XX,U,3))104587 "RTN","C0CMAIL2",271,0)104588 F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM)104589 "RTN","C0CMAIL2",272,0)104590 S LST("FROM")=$$NAME(XXNM)104591 "RTN","C0CMAIL2",273,0)104592 ; Get the folks the email is sent to.104593 "RTN","C0CMAIL2",274,0)104594 S D1=0104595 "RTN","C0CMAIL2",275,0)104596 F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D Q:D1=""104597 "RTN","C0CMAIL2",276,0)104598 . N I,T104599 "RTN","C0CMAIL2",277,0)104600 . S T=$P($G(^XMB(3.9,D0,1,D1,0)),U)104601 "RTN","C0CMAIL2",278,0)104602 . S:T T=$P($G(^VA(200,T,0)),"^")104603 "RTN","C0CMAIL2",279,0)104604 . S LST("TO",+D1)=T104605 "RTN","C0CMAIL2",280,0)104606 . S T=$G(^XMB(3.9,D0,6,+D1,0))104607 "RTN","C0CMAIL2",281,0)104608 . S:T="" T=$P($G(^VA(200,+T,0)),"^")104609 "RTN","C0CMAIL2",282,0)104610 . S:T="" T="<Unknown>"104611 "RTN","C0CMAIL2",283,0)104612 . S LST("TO NAME",D1)=T104613 "RTN","C0CMAIL2",284,0)104614 .QUIT104615 "RTN","C0CMAIL2",285,0)104616 ; Get the Header for the message104617 "RTN","C0CMAIL2",286,0)104618 S D1=0104619 "RTN","C0CMAIL2",287,0)104620 F I=1:1 S D1=$O(^XMB(3.9,D0,2,D1)) Q:D1="" Q:(D1>.99999) D104621 "RTN","C0CMAIL2",288,0)104622 . S LST("HDR",I)=$G(^XMB(3.9,D0,2,D1,0))104623 "RTN","C0CMAIL2",289,0)104624 .QUIT104625 "RTN","C0CMAIL2",290,0)104626 ; Start walking the different sections104627 "RTN","C0CMAIL2",291,0)104628 S D1=.99999,SEP="@@",SGC=0104629 "RTN","C0CMAIL2",292,0)104630 F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D104631 "RTN","C0CMAIL2",293,0)104632 . ; Clear any control characters (cr/lf/ff) off104633 "RTN","C0CMAIL2",294,0)104634 . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))104635 "RTN","C0CMAIL2",295,0)104636 . ; Enter once to set the SEP to capture the separator104637 "RTN","C0CMAIL2",296,0)104638 . I (SEP="@@")&(X?2."--"5.AN.E) D Q104639 "RTN","C0CMAIL2",297,0)104640 . . I $L(X,FLG)>2 D ERROR("ER10")104641 "RTN","C0CMAIL2",298,0)104642 . . S SEP=X,END=X_FLG104643 "RTN","C0CMAIL2",299,0)104644 . . S (CNT,SGC)=1,BCN=0104645 104675 "RTN","C0CMAIL2",300,0) 104676 . ; A new SEGMENT separator is set, process original 104677 "RTN","C0CMAIL2",301,0) 104678 . I X=SEP D QUIT 104679 "RTN","C0CMAIL2",302,0) 104680 . . ; Save Current Values 104681 "RTN","C0CMAIL2",303,0) 104682 . . S LST("SEG",SGC,"SIZE")=BCN+$L(BF) 104683 "RTN","C0CMAIL2",304,0) 104684 . . ; Close this Segment and prepare to start a New Segment 104685 "RTN","C0CMAIL2",305,0) 104686 . . S $P(LST("SEG",SGC),"^",1,2)=$P($G(LST("SEG",SGC)),"^",1)_"^"_(D1-1) 104687 "RTN","C0CMAIL2",306,0) 104688 . . ; Put the result in LST("SEG",SGC,"XML") 104689 "RTN","C0CMAIL2",307,0) 104690 . . I $L(BF) D 104691 "RTN","C0CMAIL2",308,0) 104692 . . . S ZN=1 104693 "RTN","C0CMAIL2",309,0) 104694 . . . N I,T,TBF 104695 "RTN","C0CMAIL2",310,0) 104696 . . . S TBF=BF 104697 "RTN","C0CMAIL2",311,0) 104698 . . . F I=1:1:($L(TBF,"=")) D 104699 "RTN","C0CMAIL2",312,0) 104700 . . . . S BF=$P(TBF,"=",I)_"=" 104701 "RTN","C0CMAIL2",313,0) 104702 . . . . I BF'="=" D DECODER 104703 "RTN","C0CMAIL2",314,0) 104704 . . . .QUIT 104705 "RTN","C0CMAIL2",315,0) 104706 . . . S BF="" 104707 "RTN","C0CMAIL2",316,0) 104708 . . .QUIT 104709 "RTN","C0CMAIL2",317,0) 104710 . . S SGC=SGC+1,BCN=0 104711 "RTN","C0CMAIL2",318,0) 104712 . . ; Incriment SGC to start a new Segment 104713 "RTN","C0CMAIL2",319,0) 104646 104714 . . S LST("SEG",SGC)=D1 104647 "RTN","C0CMAIL2",3 01,0)104715 "RTN","C0CMAIL2",320,0) 104648 104716 . .QUIT 104649 "RTN","C0CMAIL2",3 02,0)104717 "RTN","C0CMAIL2",321,0) 104650 104718 . ; 104651 "RTN","C0CMAIL2",303,0)104652 . ; A new SEGMENT separator is set, process original104653 "RTN","C0CMAIL2",304,0)104654 . I X=SEP D QUIT104655 "RTN","C0CMAIL2",305,0)104656 . . ; Save Current Values104657 "RTN","C0CMAIL2",306,0)104658 . . S LST("SEG",SGC,"SIZE")=BCN+$L(BF)104659 "RTN","C0CMAIL2",307,0)104660 . . ; Close this Segment and prepare to start a New Segment104661 "RTN","C0CMAIL2",308,0)104662 . . S $P(LST("SEG",SGC),"^",1,2)=$P($G(LST("SEG",SGC)),"^",1)_"^"_(D1-1)104663 "RTN","C0CMAIL2",309,0)104664 . . ; Put the result in LST("SEG",SGC,"XML")104665 "RTN","C0CMAIL2",310,0)104666 . . I $L(BF) D104667 "RTN","C0CMAIL2",311,0)104668 . . . S ZN=1104669 "RTN","C0CMAIL2",312,0)104670 . . . N I,T,TBF104671 "RTN","C0CMAIL2",313,0)104672 . . . S TBF=BF104673 "RTN","C0CMAIL2",314,0)104674 . . . F I=1:1:($L(TBF,"=")) D104675 "RTN","C0CMAIL2",315,0)104676 . . . . S BF=$P(TBF,"=",I)_"="104677 "RTN","C0CMAIL2",316,0)104678 . . . . I BF'="=" D DECODER104679 "RTN","C0CMAIL2",317,0)104680 . . . .QUIT104681 "RTN","C0CMAIL2",318,0)104682 . . . S BF=""104683 "RTN","C0CMAIL2",319,0)104684 . . .QUIT104685 "RTN","C0CMAIL2",320,0)104686 . . S SGC=SGC+1,BCN=0104687 "RTN","C0CMAIL2",321,0)104688 . . ; Incriment SGC to start a new Segment104689 104719 "RTN","C0CMAIL2",322,0) 104690 . . S LST("SEG",SGC)=D1104720 . ; Accumulate the 64 bit encoding 104691 104721 "RTN","C0CMAIL2",323,0) 104692 . .QUIT104722 . I X=$TR(X,MSK)&$L(X) S BF=BF_X QUIT 104693 104723 "RTN","C0CMAIL2",324,0) 104694 104724 . ; 104695 104725 "RTN","C0CMAIL2",325,0) 104696 . ; Accumulate the 64 bit encoding104726 . ; Ending Condition, close out the Segment 104697 104727 "RTN","C0CMAIL2",326,0) 104698 . I X= $TR(X,MSK)&$L(X) S BF=BF_XQUIT104728 . I X=END D QUIT 104699 104729 "RTN","C0CMAIL2",327,0) 104730 . . S LST("SEG",SGC)=$G(LST("SEG",SGC))_"^"_(D1-1) 104731 "RTN","C0CMAIL2",328,0) 104732 . . I $L(BF) S ZN=1 D DECODER S BF="" Q 104733 "RTN","C0CMAIL2",329,0) 104734 . .QUIT 104735 "RTN","C0CMAIL2",330,0) 104700 104736 . ; 104701 "RTN","C0CMAIL2",328,0)104702 . ; Ending Condition, close out the Segment104703 "RTN","C0CMAIL2",329,0)104704 . I X=END D QUIT104705 "RTN","C0CMAIL2",330,0)104706 . . S LST("SEG",SGC)=$G(LST("SEG",SGC))_"^"_(D1-1)104707 104737 "RTN","C0CMAIL2",331,0) 104708 . . I $L(BF) S ZN=1 D DECODER S BF="" Q104738 . ; Accumulate the lengths of other lines of the message 104709 104739 "RTN","C0CMAIL2",332,0) 104710 . .QUIT104740 . S BCN=BCN+$L(X) 104711 104741 "RTN","C0CMAIL2",333,0) 104712 . ; 104742 . ; Split out the Content Info 104713 104743 "RTN","C0CMAIL2",334,0) 104714 . ; Accumulate the lengths of other lines of the message104744 . I X[CON D Q 104715 104745 "RTN","C0CMAIL2",335,0) 104716 . S BCN=BCN+$L(X)104746 . . S J=$P(X,CON,2) 104717 104747 "RTN","C0CMAIL2",336,0) 104718 . ; Split out the Content Info104748 . . I J[" boundary=" D 104719 104749 "RTN","C0CMAIL2",337,0) 104720 . I X[CON D Q104750 . . . S SEP=$P($P(J," boundary=",2),"""",2),END=SEP_FLG 104721 104751 "RTN","C0CMAIL2",338,0) 104722 . . S J=$P(X,CON,2)104752 . . . Q:SEP?2"-"5.ANP 104723 104753 "RTN","C0CMAIL2",339,0) 104724 . . I J[" boundary=" D104754 . . . ; 104725 104755 "RTN","C0CMAIL2",340,0) 104726 . . . S SEP=$P($P(J," boundary=",2),"""",2),END=SEP_FLG104756 . . . D ERROR("ER11") 104727 104757 "RTN","C0CMAIL2",341,0) 104728 . . . Q:SEP ?2"-"5.ANP104758 . . . Q:SEP'[" " 104729 104759 "RTN","C0CMAIL2",342,0) 104730 104760 . . . ; 104731 104761 "RTN","C0CMAIL2",343,0) 104732 . . . D ERROR("ER1 1")104762 . . . D ERROR("ER12") 104733 104763 "RTN","C0CMAIL2",344,0) 104734 . . . Q:SEP'[" "104764 . . .QUIT 104735 104765 "RTN","C0CMAIL2",345,0) 104766 . . S LST("SEG",SGC,"CONTENT",$P(J,":"))=$P(J,":",2,9) 104767 "RTN","C0CMAIL2",346,0) 104768 . .QUIT 104769 "RTN","C0CMAIL2",347,0) 104770 . ; 104771 "RTN","C0CMAIL2",348,0) 104772 . ; Everything else is Text, Check for CCR/CCD. 104773 "RTN","C0CMAIL2",349,0) 104774 . N KK,UBF 104775 "RTN","C0CMAIL2",350,0) 104776 . D 104777 "RTN","C0CMAIL2",351,0) 104778 . . S UBF=$$UPPER(X) 104779 "RTN","C0CMAIL2",352,0) 104780 . . I UBF["<CONTINUITYOFCARERECORD" S $P(LST("SEG",SGC),U,3)="CCR" Q 104781 "RTN","C0CMAIL2",353,0) 104782 . . ; 104783 "RTN","C0CMAIL2",354,0) 104784 . . I UBF["<CLINICALDOCUMENT" S $P(LST("SEG",SGC),U,3)="CCD" Q 104785 "RTN","C0CMAIL2",355,0) 104786 . .QUIT 104787 "RTN","C0CMAIL2",356,0) 104788 . ; Look for directives in the text before it gets published 104789 "RTN","C0CMAIL2",357,0) 104790 . ; Look for "=3D" and replace it with a single "=". I can do more parsing 104791 "RTN","C0CMAIL2",358,0) 104792 . ; but there may be situations where the line has been wrapped. 104793 "RTN","C0CMAIL2",359,0) 104794 . D:X["=3D" 104795 "RTN","C0CMAIL2",360,0) 104796 . . F KK=1:1 S X=$P(X,"=3D",1)_"="_$P(X,"=3D",2,999) Q:X'["=3D" 104797 "RTN","C0CMAIL2",361,0) 104798 . .QUIT 104799 "RTN","C0CMAIL2",362,0) 104800 . S LST("SEG",SGC,"TXT",D1)=X 104801 "RTN","C0CMAIL2",363,0) 104802 .QUIT 104803 "RTN","C0CMAIL2",364,0) 104804 QUIT 104805 "RTN","C0CMAIL2",365,0) 104806 ; =================== 104807 "RTN","C0CMAIL2",366,0) 104808 ; Break down the Buffer Array so it can be saved. 104809 "RTN","C0CMAIL2",367,0) 104810 ; BF is passed in. 104811 "RTN","C0CMAIL2",368,0) 104812 DECODER ; 104813 "RTN","C0CMAIL2",369,0) 104814 N RCNT,TBF,UBF,ZBF,ZI,ZJ,ZK,ZSIZE 104815 "RTN","C0CMAIL2",370,0) 104816 S ZBF=BF 104817 "RTN","C0CMAIL2",371,0) 104818 ; Full Buffer, BF, now check for Encryption and Unpack 104819 "RTN","C0CMAIL2",372,0) 104820 F RCNT=1:1:$L(ZBF,"=") D 104821 "RTN","C0CMAIL2",373,0) 104822 . N BF 104823 "RTN","C0CMAIL2",374,0) 104824 . S BF=$P(ZBF,"=",RCNT) 104825 "RTN","C0CMAIL2",375,0) 104826 . ; Unpacking the 64 bit encoding 104827 "RTN","C0CMAIL2",376,0) 104828 . S TBF=$TR($$DECODE^RGUTUU(BF),$C(10,12,13)) 104829 "RTN","C0CMAIL2",377,0) 104830 . D:$L(TBF) 104831 "RTN","C0CMAIL2",378,0) 104832 . . N C,OK,OKCNT,KK,XBF,UBF 104833 "RTN","C0CMAIL2",379,0) 104834 . . D 104835 "RTN","C0CMAIL2",380,0) 104836 . . . S UBF=$$UPPER(TBF) 104837 "RTN","C0CMAIL2",381,0) 104838 . . . I UBF["<CONTINUITYOFCARERECORD XMLNS=" S $P(LST("SEG",SGC),U,3)="CCR" Q 104839 "RTN","C0CMAIL2",382,0) 104736 104840 . . . ; 104737 "RTN","C0CMAIL2",3 46,0)104738 . . . D ERROR("ER12")104739 "RTN","C0CMAIL2",3 47,0)104841 "RTN","C0CMAIL2",383,0) 104842 . . . I UBF["<CLINICALDOCUMENT XMLNS=" S $P(LST("SEG",SGC),U,3)="CCD" Q 104843 "RTN","C0CMAIL2",384,0) 104740 104844 . . .QUIT 104741 "RTN","C0CMAIL2",348,0) 104742 . . S LST("SEG",SGC,"CONTENT",$P(J,":"))=$P(J,":",2,9) 104743 "RTN","C0CMAIL2",349,0) 104845 "RTN","C0CMAIL2",385,0) 104846 . . ; Check for Bad Signature Decoding, after 100 bad characters 104847 "RTN","C0CMAIL2",386,0) 104848 . . S OK=1,OKCNT=0 104849 "RTN","C0CMAIL2",387,0) 104850 . . F KK=1:1:$L(UBF) S C=$A(UBF,KK) S:C>126 OKCNT=OKCNT+1 I OKCNT>100 S OK=0 Q 104851 "RTN","C0CMAIL2",388,0) 104852 . . ; 104853 "RTN","C0CMAIL2",389,0) 104854 . . D 104855 "RTN","C0CMAIL2",390,0) 104856 . . . I 'OK S (BF,UBF,TBF,XBF)="<Crypto-Signature redacted>" Q 104857 "RTN","C0CMAIL2",391,0) 104858 . . . ; 104859 "RTN","C0CMAIL2",392,0) 104860 . . . S BF=BF_"=" 104861 "RTN","C0CMAIL2",393,0) 104862 . . . D NORMAL(.XBF,.TBF) 104863 "RTN","C0CMAIL2",394,0) 104864 . . .QUIT 104865 "RTN","C0CMAIL2",395,0) 104866 . . M LST("SEG",SGC,"XML",RCNT)=XBF 104867 "RTN","C0CMAIL2",396,0) 104744 104868 . .QUIT 104745 "RTN","C0CMAIL2",350,0) 104869 "RTN","C0CMAIL2",397,0) 104870 .QUIT 104871 "RTN","C0CMAIL2",398,0) 104872 QUIT 104873 "RTN","C0CMAIL2",399,0) 104874 ; =================== 104875 "RTN","C0CMAIL2",400,0) 104876 ; OUTXML = OUTBF = OUT = OUTPUT ARRAY TO BE BUILT 104877 "RTN","C0CMAIL2",401,0) 104878 ; BF = INXML = INPUT ARRAY TO PROVIDE INPUT 104879 "RTN","C0CMAIL2",402,0) 104880 ; >D NORMAL^C0CMAIL(.OUT,BF) 104881 "RTN","C0CMAIL2",403,0) 104882 NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML 104883 "RTN","C0CMAIL2",404,0) 104884 ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME 104885 "RTN","C0CMAIL2",405,0) 104886 ; 104887 "RTN","C0CMAIL2",406,0) 104888 N ZN,OUTBF,XX,ZSEP 104889 "RTN","C0CMAIL2",407,0) 104890 S INXML=$TR(INXML,$C(10,12,13)) 104891 "RTN","C0CMAIL2",408,0) 104892 S ZN=1,ZSEP=">" 104893 "RTN","C0CMAIL2",409,0) 104894 S OUTBF(1)=$P(INXML,"><",1)_ZSEP,XX="<"_$P(INXML,"><",2)_ZSEP,ZN=2,ZL=1 104895 "RTN","C0CMAIL2",410,0) 104896 F ZN=ZN+1:1:$L(INXML,"><") D Q:XX="" 104897 "RTN","C0CMAIL2",411,0) 104898 . S XX=$P(INXML,"><",ZN) 104899 "RTN","C0CMAIL2",412,0) 104900 . S:$E($RE(XX))=">" ZSEP="" 104901 "RTN","C0CMAIL2",413,0) 104902 . Q:XX="" 104903 "RTN","C0CMAIL2",414,0) 104746 104904 . ; 104747 "RTN","C0CMAIL2",351,0) 104748 . ; Everything else is Text, Check for CCR/CCD. 104749 "RTN","C0CMAIL2",352,0) 104750 . N KK,UBF 104751 "RTN","C0CMAIL2",353,0) 104905 "RTN","C0CMAIL2",415,0) 104906 . S XX="<"_XX_ZSEP 104907 "RTN","C0CMAIL2",416,0) 104752 104908 . D 104753 "RTN","C0CMAIL2",354,0) 104754 . . S UBF=$$UPPER(X) 104755 "RTN","C0CMAIL2",355,0) 104756 . . I UBF["<CONTINUITYOFCARERECORD" S $P(LST("SEG",SGC),U,3)="CCR" Q 104757 "RTN","C0CMAIL2",356,0) 104909 "RTN","C0CMAIL2",417,0) 104910 . . I $L(XX)<4000 S OUTBF(ZL)=XX,XX=$P(INXML,"><",ZN),ZL=ZL+1 Q 104911 "RTN","C0CMAIL2",418,0) 104758 104912 . . ; 104759 "RTN","C0CMAIL2",357,0) 104760 . . I UBF["<CLINICALDOCUMENT" S $P(LST("SEG",SGC),U,3)="CCD" Q 104761 "RTN","C0CMAIL2",358,0) 104913 "RTN","C0CMAIL2",419,0) 104914 . . D ERROR("ER05") 104915 "RTN","C0CMAIL2",420,0) 104916 . . F ZL=ZL+1:1 D Q:XX="" 104917 "RTN","C0CMAIL2",421,0) 104918 . . . N XL 104919 "RTN","C0CMAIL2",422,0) 104920 . . . S XL=$E(XX,1,4000) 104921 "RTN","C0CMAIL2",423,0) 104922 . . . S $E(XX,1,4000)="" ; S XX=$E(XX,4001,999999) ; Remove 4K characters 104923 "RTN","C0CMAIL2",424,0) 104924 . . . S OUTBF(ZL)=XL 104925 "RTN","C0CMAIL2",425,0) 104926 . . .QUIT 104927 "RTN","C0CMAIL2",426,0) 104762 104928 . .QUIT 104763 "RTN","C0CMAIL2",359,0) 104764 . ; Look for directives in the text before it gets published 104765 "RTN","C0CMAIL2",360,0) 104766 . ; Look for "=3D" and replace it with a single "=". I can do more parsing 104767 "RTN","C0CMAIL2",361,0) 104768 . ; but there may be situations where the line has been wrapped. 104769 "RTN","C0CMAIL2",362,0) 104770 . D:X["=3D" 104771 "RTN","C0CMAIL2",363,0) 104772 . . F KK=1:1 S X=$P(X,"=3D",1)_"="_$P(X,"=3D",2,999) Q:X'["=3D" 104773 "RTN","C0CMAIL2",364,0) 104774 . .QUIT 104775 "RTN","C0CMAIL2",365,0) 104776 . S LST("SEG",SGC,"TXT",D1)=X 104777 "RTN","C0CMAIL2",366,0) 104929 "RTN","C0CMAIL2",427,0) 104778 104930 .QUIT 104779 "RTN","C0CMAIL2",367,0) 104931 "RTN","C0CMAIL2",428,0) 104932 M OUTXML=OUTBF 104933 "RTN","C0CMAIL2",429,0) 104780 104934 QUIT 104781 "RTN","C0CMAIL2", 368,0)104935 "RTN","C0CMAIL2",430,0) 104782 104936 ; =================== 104783 "RTN","C0CMAIL2",369,0)104784 ; Break down the Buffer Array so it can be saved.104785 "RTN","C0CMAIL2",370,0)104786 ; BF is passed in.104787 "RTN","C0CMAIL2",371,0)104788 DECODER ;104789 "RTN","C0CMAIL2",372,0)104790 N RCNT,TBF,UBF,ZBF,ZI,ZJ,ZK,ZSIZE104791 "RTN","C0CMAIL2",373,0)104792 S ZBF=BF104793 "RTN","C0CMAIL2",374,0)104794 ; Full Buffer, BF, now check for Encryption and Unpack104795 "RTN","C0CMAIL2",375,0)104796 F RCNT=1:1:$L(ZBF,"=") D104797 "RTN","C0CMAIL2",376,0)104798 . N BF104799 "RTN","C0CMAIL2",377,0)104800 . S BF=$P(ZBF,"=",RCNT)104801 "RTN","C0CMAIL2",378,0)104802 . ; Unpacking the 64 bit encoding104803 "RTN","C0CMAIL2",379,0)104804 . S TBF=$TR($$DECODE^RGUTUU(BF),$C(10,12,13))104805 "RTN","C0CMAIL2",380,0)104806 . D:$L(TBF)104807 "RTN","C0CMAIL2",381,0)104808 . . N C,OK,OKCNT,KK,XBF,UBF104809 "RTN","C0CMAIL2",382,0)104810 . . D104811 "RTN","C0CMAIL2",383,0)104812 . . . S UBF=$$UPPER(TBF)104813 "RTN","C0CMAIL2",384,0)104814 . . . I UBF["<CONTINUITYOFCARERECORD XMLNS=" S $P(LST("SEG",SGC),U,3)="CCR" Q104815 "RTN","C0CMAIL2",385,0)104816 . . . ;104817 "RTN","C0CMAIL2",386,0)104818 . . . I UBF["<CLINICALDOCUMENT XMLNS=" S $P(LST("SEG",SGC),U,3)="CCD" Q104819 "RTN","C0CMAIL2",387,0)104820 . . .QUIT104821 "RTN","C0CMAIL2",388,0)104822 . . ; Check for Bad Signature Decoding, after 100 bad characters104823 "RTN","C0CMAIL2",389,0)104824 . . S OK=1,OKCNT=0104825 "RTN","C0CMAIL2",390,0)104826 . . F KK=1:1:$L(UBF) S C=$A(UBF,KK) S:C>126 OKCNT=OKCNT+1 I OKCNT>100 S OK=0 Q104827 "RTN","C0CMAIL2",391,0)104828 . . ;104829 "RTN","C0CMAIL2",392,0)104830 . . D104831 "RTN","C0CMAIL2",393,0)104832 . . . I 'OK S (BF,UBF,TBF,XBF)="<Crypto-Signature redacted>" Q104833 "RTN","C0CMAIL2",394,0)104834 . . . ;104835 "RTN","C0CMAIL2",395,0)104836 . . . S BF=BF_"="104837 "RTN","C0CMAIL2",396,0)104838 . . . D NORMAL(.XBF,.TBF)104839 "RTN","C0CMAIL2",397,0)104840 . . .QUIT104841 "RTN","C0CMAIL2",398,0)104842 . . M LST("SEG",SGC,"XML",RCNT)=XBF104843 "RTN","C0CMAIL2",399,0)104844 . .QUIT104845 "RTN","C0CMAIL2",400,0)104846 .QUIT104847 "RTN","C0CMAIL2",401,0)104848 QUIT104849 "RTN","C0CMAIL2",402,0)104850 ; ===================104851 "RTN","C0CMAIL2",403,0)104852 ; OUTXML = OUTBF = OUT = OUTPUT ARRAY TO BE BUILT104853 "RTN","C0CMAIL2",404,0)104854 ; BF = INXML = INPUT ARRAY TO PROVIDE INPUT104855 "RTN","C0CMAIL2",405,0)104856 ; >D NORMAL^C0CMAIL(.OUT,BF)104857 "RTN","C0CMAIL2",406,0)104858 NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML104859 "RTN","C0CMAIL2",407,0)104860 ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME104861 "RTN","C0CMAIL2",408,0)104862 ;104863 "RTN","C0CMAIL2",409,0)104864 N ZN,OUTBF,XX,ZSEP104865 "RTN","C0CMAIL2",410,0)104866 S INXML=$TR(INXML,$C(10,12,13))104867 "RTN","C0CMAIL2",411,0)104868 S ZN=1,ZSEP=">"104869 "RTN","C0CMAIL2",412,0)104870 S OUTBF(1)=$P(INXML,"><",1)_ZSEP,XX="<"_$P(INXML,"><",2)_ZSEP,ZN=2,ZL=1104871 "RTN","C0CMAIL2",413,0)104872 F ZN=ZN+1:1:$L(INXML,"><") D Q:XX=""104873 "RTN","C0CMAIL2",414,0)104874 . S XX=$P(INXML,"><",ZN)104875 "RTN","C0CMAIL2",415,0)104876 . S:$E($RE(XX))=">" ZSEP=""104877 "RTN","C0CMAIL2",416,0)104878 . Q:XX=""104879 "RTN","C0CMAIL2",417,0)104880 . ;104881 "RTN","C0CMAIL2",418,0)104882 . S XX="<"_XX_ZSEP104883 "RTN","C0CMAIL2",419,0)104884 . D104885 "RTN","C0CMAIL2",420,0)104886 . . I $L(XX)<4000 S OUTBF(ZL)=XX,XX=$P(INXML,"><",ZN),ZL=ZL+1 Q104887 "RTN","C0CMAIL2",421,0)104888 . . ;104889 "RTN","C0CMAIL2",422,0)104890 . . D ERROR("ER05")104891 "RTN","C0CMAIL2",423,0)104892 . . F ZL=ZL+1:1 D Q:XX=""104893 "RTN","C0CMAIL2",424,0)104894 . . . N XL104895 "RTN","C0CMAIL2",425,0)104896 . . . S XL=$E(XX,1,4000)104897 "RTN","C0CMAIL2",426,0)104898 . . . S $E(XX,1,4000)="" ; S XX=$E(XX,4001,999999) ; Remove 4K characters104899 "RTN","C0CMAIL2",427,0)104900 . . . S OUTBF(ZL)=XL104901 "RTN","C0CMAIL2",428,0)104902 . . .QUIT104903 "RTN","C0CMAIL2",429,0)104904 . .QUIT104905 "RTN","C0CMAIL2",430,0)104906 .QUIT104907 104937 "RTN","C0CMAIL2",431,0) 104908 M OUTXML=OUTBF 104938 UPPER(X) ; Convert any lowercase letters to Uppercase letters 104909 104939 "RTN","C0CMAIL2",432,0) 104910 QUIT 104940 QUIT $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") 104911 104941 "RTN","C0CMAIL2",433,0) 104912 104942 ; =================== 104913 104943 "RTN","C0CMAIL2",434,0) 104914 UPPER(X) ; Convert any lowercase letters to Uppercase letters104944 ; EN is a counter that remains between error events 104915 104945 "RTN","C0CMAIL2",435,0) 104916 QUIT $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") 104946 ERROR(ER) ; Error Handler 104917 104947 "RTN","C0CMAIL2",436,0) 104948 N TXXQ,XXXQ 104949 "RTN","C0CMAIL2",437,0) 104950 S XXXQ="Unknown Error Encountered = "_ER 104951 "RTN","C0CMAIL2",438,0) 104952 S TXXQ=$P($T(@(ER_"^"_$T(+0))),";;",2,99) 104953 "RTN","C0CMAIL2",439,0) 104954 I TXXQ'="" D 104955 "RTN","C0CMAIL2",440,0) 104956 . I TXXQ["_" X "S TXXQ="_TXXQ 104957 "RTN","C0CMAIL2",441,0) 104958 . S XXXQ=TXXQ 104959 "RTN","C0CMAIL2",442,0) 104960 .QUIT 104961 "RTN","C0CMAIL2",443,0) 104962 S EN(ER)=$G(EN(ER))+1 104963 "RTN","C0CMAIL2",444,0) 104964 S LST("ERR",ER,EN(ER))=XXXQ 104965 "RTN","C0CMAIL2",445,0) 104966 QUIT 104967 "RTN","C0CMAIL2",446,0) 104918 104968 ; =================== 104919 "RTN","C0CMAIL2",437,0)104920 ; EN is a counter that remains between error events104921 "RTN","C0CMAIL2",438,0)104922 ERROR(ER) ; Error Handler104923 "RTN","C0CMAIL2",439,0)104924 N TXXQ,XXXQ104925 "RTN","C0CMAIL2",440,0)104926 S XXXQ="Unknown Error Encountered = "_ER104927 "RTN","C0CMAIL2",441,0)104928 S TXXQ=$P($T(@(ER_"^"_$T(+0))),";;",2,99)104929 "RTN","C0CMAIL2",442,0)104930 I TXXQ'="" D104931 "RTN","C0CMAIL2",443,0)104932 . I TXXQ["_" X "S TXXQ="_TXXQ104933 "RTN","C0CMAIL2",444,0)104934 . S XXXQ=TXXQ104935 "RTN","C0CMAIL2",445,0)104936 .QUIT104937 "RTN","C0CMAIL2",446,0)104938 S EN(ER)=$G(EN(ER))+1104939 104969 "RTN","C0CMAIL2",447,0) 104940 S LST("ERR",ER,EN(ER))=XXXQ 104970 ER01 ;;Message Missing 104941 104971 "RTN","C0CMAIL2",448,0) 104972 ER02 ;;Message Text Missing 104973 "RTN","C0CMAIL2",449,0) 104974 ER03 ;;Message Not Identifiable 104975 "RTN","C0CMAIL2",450,0) 104976 ER04 ;;Segment is too large 104977 "RTN","C0CMAIL2",451,0) 104978 ER05 ;;Mailbox Missing 104979 "RTN","C0CMAIL2",452,0) 104980 ER06 ;;"User Missing = "_$G(DUZ) 104981 "RTN","C0CMAIL2",453,0) 104982 ER07 ;;"Bad DUZ = "_DUZ 104983 "RTN","C0CMAIL2",454,0) 104984 ER08 ;;"Bad Basket ID = "_MBLST_" >> "_$G(TN) 104985 "RTN","C0CMAIL2",455,0) 104986 ER10 ;;"Bad Separator found = "_X 104987 "RTN","C0CMAIL2",456,0) 104988 ER11 ;;"Non-Standard Separator Found:>"_$G(J) 104989 "RTN","C0CMAIL2",457,0) 104990 ER12 ;;"Spaces are not allowed in Separators:>"_$G(J) 104991 "RTN","C0CMAIL2",458,0) 104992 ; vvvvvvvvvvvvvvv Not Needed vvvvvvvvvvvvvvvvvvvvvvvvvv 104993 "RTN","C0CMAIL2",459,0) 104994 ; End note if needed 104995 "RTN","C0CMAIL2",460,0) 104942 104996 QUIT 104943 "RTN","C0CMAIL2",449,0)104944 ; ===================104945 "RTN","C0CMAIL2",450,0)104946 ER01 ;;Message Missing104947 "RTN","C0CMAIL2",451,0)104948 ER02 ;;Message Text Missing104949 "RTN","C0CMAIL2",452,0)104950 ER03 ;;Message Not Identifiable104951 "RTN","C0CMAIL2",453,0)104952 ER04 ;;Segment is too large104953 "RTN","C0CMAIL2",454,0)104954 ER05 ;;Mailbox Missing104955 "RTN","C0CMAIL2",455,0)104956 ER06 ;;"User Missing = "_$G(DUZ)104957 "RTN","C0CMAIL2",456,0)104958 ER07 ;;"Bad DUZ = "_DUZ104959 "RTN","C0CMAIL2",457,0)104960 ER08 ;;"Bad Basket ID = "_MBLST_" >> "_$G(TN)104961 "RTN","C0CMAIL2",458,0)104962 ER10 ;;"Bad Separator found = "_X104963 "RTN","C0CMAIL2",459,0)104964 ER11 ;;"Non-Standard Separator Found:>"_$G(J)104965 "RTN","C0CMAIL2",460,0)104966 ER12 ;;"Spaces are not allowed in Separators:>"_$G(J)104967 104997 "RTN","C0CMAIL2",461,0) 104968 ; vvvvvvvvvvvvvvv Not Needed vvvvvvvvvvvvvvvvvvvvvvvvvv104969 "RTN","C0CMAIL2",462,0)104970 ; End note if needed104971 "RTN","C0CMAIL2",463,0)104972 QUIT104973 "RTN","C0CMAIL2",464,0)104974 104998 ; =================== 104975 104999 "RTN","C0CMAIL3") 104976 0^83^B22 4733815105000 0^83^B222669398 104977 105001 "RTN","C0CMAIL3",1,0) 104978 105002 C0CMAIL3 ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr ; 5/10/12 2:51pm 104979 105003 "RTN","C0CMAIL3",2,0) 104980 ;;1.2;C 0C;;May 11, 2012;Build 50105004 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 104981 105005 "RTN","C0CMAIL3",3,0) 104982 105006 ;Copyright 2011 Chris Richardson, Richardson Computer Research … … 104986 105010 ; rcr@rcresearch.us 104987 105011 "RTN","C0CMAIL3",6,0) 104988 ; Licensed under the terms of the GNU105012 ; 104989 105013 "RTN","C0CMAIL3",7,0) 104990 ; General Public License See attached copy of the License.105014 ; This program is free software: you can redistribute it and/or modify 104991 105015 "RTN","C0CMAIL3",8,0) 104992 ; 105016 ; it under the terms of the GNU Affero General Public License as 104993 105017 "RTN","C0CMAIL3",9,0) 104994 ; This program is free software; you can redistribute it and/or modify105018 ; published by the Free Software Foundation, either version 3 of the 104995 105019 "RTN","C0CMAIL3",10,0) 104996 ; it under the terms of the GNU General Public License as published by105020 ; License, or (at your option) any later version. 104997 105021 "RTN","C0CMAIL3",11,0) 104998 ; the Free Software Foundation; either version 2 of the License, or105022 ; 104999 105023 "RTN","C0CMAIL3",12,0) 105000 ; (at your option) any later version.105024 ; This program is distributed in the hope that it will be useful, 105001 105025 "RTN","C0CMAIL3",13,0) 105002 ; 105026 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 105003 105027 "RTN","C0CMAIL3",14,0) 105004 ; This program is distributed in the hope that it will be useful,105028 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 105005 105029 "RTN","C0CMAIL3",15,0) 105006 ; but WITHOUT ANY WARRANTY; without even the implied warranty of105030 ; GNU Affero General Public License for more details. 105007 105031 "RTN","C0CMAIL3",16,0) 105008 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the105032 ; 105009 105033 "RTN","C0CMAIL3",17,0) 105010 ; GNU General Public License for more details.105034 ; You should have received a copy of the GNU Affero General Public License 105011 105035 "RTN","C0CMAIL3",18,0) 105012 ; 105036 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 105013 105037 "RTN","C0CMAIL3",19,0) 105014 ; You should have received a copy of the GNU General Public License along105038 ; 105015 105039 "RTN","C0CMAIL3",20,0) 105016 ; with this program; if not, write to the Free Software Foundation, Inc.,105040 ; ------------------ 105017 105041 "RTN","C0CMAIL3",21,0) 105018 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.105042 ;Entry Points 105019 105043 "RTN","C0CMAIL3",22,0) 105020 ; 105044 ; DETAIL^C0CMAIL(.C0CDATA,IEN) --> Get details of the Mail Message and Attachments 105021 105045 "RTN","C0CMAIL3",23,0) 105022 ; ------------------105046 ; GETMSG^C0CMAIL(.C0CDATA,.C0CINPUT) 105023 105047 "RTN","C0CMAIL3",24,0) 105024 ; Entry Points105048 ; Input: 105025 105049 "RTN","C0CMAIL3",25,0) 105026 ; DETAIL^C0CMAIL(.C0CDATA,IEN) --> Get details of the Mail Message and Attachments105050 ; C0CINPUT = "DUZ;MAILBOX_Name[or IEN for box (comma Separated);MALL 105027 105051 "RTN","C0CMAIL3",26,0) 105028 ; GETMSG^C0CMAIL(.C0CDATA,.C0CINPUT)105052 ; or "*" for all boxes, default is "IN" if missing]" 105029 105053 "RTN","C0CMAIL3",27,0) 105030 ; Input:105054 ; $P(C0CINPUT,";",3)=MALL, default=NUL means "New only", 105031 105055 "RTN","C0CMAIL3",28,0) 105032 ; C0CINPUT = "DUZ;MAILBOX_Name[or IEN for box (comma Separated);MALL105056 ; "*" for All or 9,999 maximum 105033 105057 "RTN","C0CMAIL3",29,0) 105034 ; or "*" for all boxes, default is "IN" if missing]"105058 ; MALL?1.n = that number of the n most recent 105035 105059 "RTN","C0CMAIL3",30,0) 105036 ; $P(C0CINPUT,";",3)=MALL, default=NUL means "New only",105060 ; Internally: 105037 105061 "RTN","C0CMAIL3",31,0) 105038 ; "*" for All or 9,999 maximum105062 ; BNAM = Box Name 105039 105063 "RTN","C0CMAIL3",32,0) 105040 ; MALL?1.n = that number of the n most recent105064 ; Output: 105041 105065 "RTN","C0CMAIL3",33,0) 105042 ; Internally:105066 ; C0CDATA 105043 105067 "RTN","C0CMAIL3",34,0) 105044 ; BNAM = Box Name105068 ; = (BNAM,"NUMBER") = Number of NEW Emails in Basket 105045 105069 "RTN","C0CMAIL3",35,0) 105046 ; Output:105070 ; (BNAM,"MSG",C0CIEN,"FROM")=Name 105047 105071 "RTN","C0CMAIL3",36,0) 105048 ; C0CDATA105072 ; (BNAM,"MSG",C0CIEN,"TO",n)=DUZ, or EMAIL Address 105049 105073 "RTN","C0CMAIL3",37,0) 105050 ; = (BNAM,"NUMBER") = Number of NEW Emails in Basket105074 ; (BNAM,"MSG",C0CIEN,"TO NAME",n)=Names or EMAIL Address 105051 105075 "RTN","C0CMAIL3",38,0) 105052 ; (BNAM,"MSG",C0CIEN," FROM")=Name105076 ; (BNAM,"MSG",C0CIEN,"TITLE")=EMAIL Title 105053 105077 "RTN","C0CMAIL3",39,0) 105054 ; (BNAM,"MSG",C0CIEN ,"TO",n)=DUZ, or EMAIL Address105078 ; (BNAM,"MSG",C0CIEN[for File 3.9])=Number of Attachments 105055 105079 "RTN","C0CMAIL3",40,0) 105056 ; (BNAM,"MSG",C0CIEN, "TO NAME",n)=Names or EMAIL Address105080 ; (BNAM,"MSG",C0CIEN,num,"CONT") = Free Text 105057 105081 "RTN","C0CMAIL3",41,0) 105058 ; (BNAM,"MSG",C0CIEN, "TITLE")=EMAIL Title105082 ; (BNAM,"MSG",C0CIEN,num,"LINES") = Number of Lines of Text 105059 105083 "RTN","C0CMAIL3",42,0) 105060 ; (BNAM,"MSG",C0CIEN [for File 3.9])=Number of Attachments105084 ; (BNAM,"MSG",C0CIEN,num,"SIZE") = Size of the Message in Bytes 105061 105085 "RTN","C0CMAIL3",43,0) 105062 ; (BNAM,"MSG",C0CIEN,num," CONT") = Free Text105086 ; (BNAM,"MSG",C0CIEN,num,"TXT",LINE#) = Message Data (No Attachment) 105063 105087 "RTN","C0CMAIL3",44,0) 105064 ; (BNAM,"MSG",C0CIEN,num,"LINES") = Number of Lines of Text105088 ; (BNAM,"MSG",C0CIEN,"SEG",NUM) = First Line^Last Line 105065 105089 "RTN","C0CMAIL3",45,0) 105066 ; (BNAM,"MSG",C0CIEN,num,"SIZE") = Size of the Message in Bytes105090 ; (BNAM,"MSG",C0CIEN,"SEG",NUM,"CONT",type) = Message Details 105067 105091 "RTN","C0CMAIL3",46,0) 105068 ; (BNAM,"MSG",C0CIEN,num,"TXT",LINE#) = Message Data (No Attachment)105092 ; (BNAM,"MSG",C0CIEN,"SEG",NUM,LINE#) = Message Data 105069 105093 "RTN","C0CMAIL3",47,0) 105070 ; (BNAM,"MSG",C0CIEN,"SEG",NUM) = First Line^Last Line105094 ; 105071 105095 "RTN","C0CMAIL3",48,0) 105072 ; (BNAM,"MSG",C0CIEN,"SEG",NUM,"CONT",type) = Message Details105096 ; DO DETAIL^C0CMAIL(.OUTBF,D0) ; For each Email Message and Attachments 105073 105097 "RTN","C0CMAIL3",49,0) 105074 ; (BNAM,"MSG",C0CIEN,"SEG",NUM,LINE#) = Message Data105098 ; Input; 105075 105099 "RTN","C0CMAIL3",50,0) 105100 ; D0 - The IEN for the message in file 3.9, MESSAGE global 105101 "RTN","C0CMAIL3",51,0) 105102 ; Output 105103 "RTN","C0CMAIL3",52,0) 105104 ; OUTBF - The array of your choice to save the expanded and decoded message. 105105 "RTN","C0CMAIL3",53,0) 105076 105106 ; 105077 "RTN","C0CMAIL3",51,0)105078 ; DO DETAIL^C0CMAIL(.OUTBF,D0) ; For each Email Message and Attachments105079 "RTN","C0CMAIL3",52,0)105080 ; Input;105081 "RTN","C0CMAIL3",53,0)105082 ; D0 - The IEN for the message in file 3.9, MESSAGE global105083 105107 "RTN","C0CMAIL3",54,0) 105084 ; Output 105108 GETMSG(C0CDATA,C0CINPUT) ; Common Entry Point for Mailbox Data 105085 105109 "RTN","C0CMAIL3",55,0) 105086 ; OUTBF - The array of your choice to save the expanded and decoded message.105110 K:'$G(C0CDATA("KEEP")) C0CDATA 105087 105111 "RTN","C0CMAIL3",56,0) 105088 ;105112 N U 105089 105113 "RTN","C0CMAIL3",57,0) 105090 GETMSG(C0CDATA,C0CINPUT) ; Common Entry Point for Mailbox Data 105114 S U="^" 105091 105115 "RTN","C0CMAIL3",58,0) 105092 K:'$G(C0CDATA("KEEP")) C0CDATA105116 D:$G(C0CINPUT) 105093 105117 "RTN","C0CMAIL3",59,0) 105094 N U105118 . N BF,DUZ,I,INPUT,J,L,LST,MBLST,MALL 105095 105119 "RTN","C0CMAIL3",60,0) 105096 S U="^"105120 . S INPUT=C0CINPUT 105097 105121 "RTN","C0CMAIL3",61,0) 105098 D:$G(C0CINPUT)105122 . S DUZ=+INPUT 105099 105123 "RTN","C0CMAIL3",62,0) 105100 . N BF,DUZ,I,INPUT,J,L,LST,MBLST,MALL105124 . I $D(^VA(200,DUZ))=0!('$D(^VA(200,DUZ,0))) D ERROR("ER06") Q 105101 105125 "RTN","C0CMAIL3",63,0) 105102 . S INPUT=C0CINPUT105126 . ; 105103 105127 "RTN","C0CMAIL3",64,0) 105104 . S DUZ=+INPUT105128 . D:$D(^XMB(3.7,DUZ,0))#2 105105 105129 "RTN","C0CMAIL3",65,0) 105106 . I $D(^VA(200,DUZ))=0!('$D(^VA(200,DUZ,0))) D ERROR("ER06") Q105130 . . S MBLST=$P(INPUT,";",2) 105107 105131 "RTN","C0CMAIL3",66,0) 105108 . ;105132 . . S MALL=$P(INPUT,";",3) ; New or All Mail Flag 105109 105133 "RTN","C0CMAIL3",67,0) 105110 . D:$D(^XMB(3.7,DUZ,0))#2105134 . . S:MALL["*" MALL=99999 105111 105135 "RTN","C0CMAIL3",68,0) 105112 . . S MBLST=$P(INPUT,";",2)105136 . . ; Only one of these can be correct 105113 105137 "RTN","C0CMAIL3",69,0) 105114 . . S MALL=$P(INPUT,";",3) ; New or All Mail Flag105138 . . D 105115 105139 "RTN","C0CMAIL3",70,0) 105116 . . S:MALL["*" MALL=99999105140 . . . ; If nul, make it "IN" only 105117 105141 "RTN","C0CMAIL3",71,0) 105118 . . ; Only one of these can be correct105142 . . . I MBLST="" D QUIT 105119 105143 "RTN","C0CMAIL3",72,0) 105120 . . D105144 . . . . S MBLST("IN")=0,I=0 105121 105145 "RTN","C0CMAIL3",73,0) 105122 . . . ; If nul, make it "IN" only105146 . . . . D GATHER(DUZ,"IN",.LST) 105123 105147 "RTN","C0CMAIL3",74,0) 105124 . . . I MBLST="" DQUIT105148 . . . .QUIT 105125 105149 "RTN","C0CMAIL3",75,0) 105126 . . . . S MBLST("IN")=0,I=0105150 . . . ; 105127 105151 "RTN","C0CMAIL3",76,0) 105128 . . . . D GATHER(DUZ,"IN",.LST)105152 . . . ; If "*", Get all Mailboxes and look for New Messages 105129 105153 "RTN","C0CMAIL3",77,0) 105154 . . . I MBLST["*" D QUIT 105155 "RTN","C0CMAIL3",78,0) 105156 . . . . N NAM,NUM 105157 "RTN","C0CMAIL3",79,0) 105158 . . . . S NUM=0 105159 "RTN","C0CMAIL3",80,0) 105160 . . . . F S NUM=$O(^XMB(3.7,DUZ,2,NUM)) Q:'NUM D 105161 "RTN","C0CMAIL3",81,0) 105162 . . . . . S NAM=$P(^XMB(3.7,DUZ,2,NUM,0),U) 105163 "RTN","C0CMAIL3",82,0) 105164 . . . . . D GATHER(DUZ,NAM,.LST) 105165 "RTN","C0CMAIL3",83,0) 105166 . . . . .QUIT 105167 "RTN","C0CMAIL3",84,0) 105130 105168 . . . .QUIT 105131 "RTN","C0CMAIL3", 78,0)105169 "RTN","C0CMAIL3",85,0) 105132 105170 . . . ; 105133 "RTN","C0CMAIL3",79,0)105134 . . . ; If "*", Get all Mailboxes and look for New Messages105135 "RTN","C0CMAIL3",80,0)105136 . . . I MBLST["*" D QUIT105137 "RTN","C0CMAIL3",81,0)105138 . . . . N NAM,NUM105139 "RTN","C0CMAIL3",82,0)105140 . . . . S NUM=0105141 "RTN","C0CMAIL3",83,0)105142 . . . . F S NUM=$O(^XMB(3.7,DUZ,2,NUM)) Q:'NUM D105143 "RTN","C0CMAIL3",84,0)105144 . . . . . S NAM=$P(^XMB(3.7,DUZ,2,NUM,0),U)105145 "RTN","C0CMAIL3",85,0)105146 . . . . . D GATHER(DUZ,NAM,.LST)105147 105171 "RTN","C0CMAIL3",86,0) 105172 . . . ; If comma separated, look for mailboxes with new messages 105173 "RTN","C0CMAIL3",87,0) 105174 . . . I $L(MBLST,",")>1 D QUIT 105175 "RTN","C0CMAIL3",88,0) 105176 . . . . S NAM="" 105177 "RTN","C0CMAIL3",89,0) 105178 . . . . N TN,V 105179 "RTN","C0CMAIL3",90,0) 105180 . . . . F TN=1:1:$L(MBLST,",") S V=$P(MBLST,",",TN) D 105181 "RTN","C0CMAIL3",91,0) 105182 . . . . . I $L(V) D QUIT 105183 "RTN","C0CMAIL3",92,0) 105184 . . . . . . I V S NAM=$P($G(^XMB(3.7,DUZ,2,V,0)),U) 105185 "RTN","C0CMAIL3",93,0) 105186 . . . . . . S:NAM="" NAM=V 105187 "RTN","C0CMAIL3",94,0) 105188 . . . . . . D GATHER(DUZ,NAM,.LST) 105189 "RTN","C0CMAIL3",95,0) 105190 . . . . . .QUIT 105191 "RTN","C0CMAIL3",96,0) 105192 . . . . . ; 105193 "RTN","C0CMAIL3",97,0) 105194 . . . . . D ERROR("ER08") 105195 "RTN","C0CMAIL3",98,0) 105148 105196 . . . . .QUIT 105149 "RTN","C0CMAIL3", 87,0)105197 "RTN","C0CMAIL3",99,0) 105150 105198 . . . .QUIT 105151 "RTN","C0CMAIL3", 88,0)105199 "RTN","C0CMAIL3",100,0) 105152 105200 . . . ; 105153 "RTN","C0CMAIL3",89,0)105154 . . . ; If comma separated, look for mailboxes with new messages105155 "RTN","C0CMAIL3",90,0)105156 . . . I $L(MBLST,",")>1 D QUIT105157 "RTN","C0CMAIL3",91,0)105158 . . . . S NAM=""105159 "RTN","C0CMAIL3",92,0)105160 . . . . N TN,V105161 "RTN","C0CMAIL3",93,0)105162 . . . . F TN=1:1:$L(MBLST,",") S V=$P(MBLST,",",TN) D105163 "RTN","C0CMAIL3",94,0)105164 . . . . . I $L(V) D QUIT105165 "RTN","C0CMAIL3",95,0)105166 . . . . . . I V S NAM=$P($G(^XMB(3.7,DUZ,2,V,0)),U)105167 "RTN","C0CMAIL3",96,0)105168 . . . . . . S:NAM="" NAM=V105169 "RTN","C0CMAIL3",97,0)105170 . . . . . . D GATHER(DUZ,NAM,.LST)105171 "RTN","C0CMAIL3",98,0)105172 . . . . . .QUIT105173 "RTN","C0CMAIL3",99,0)105174 . . . . . ;105175 "RTN","C0CMAIL3",100,0)105176 . . . . . D ERROR("ER08")105177 105201 "RTN","C0CMAIL3",101,0) 105178 . . . . .QUIT105202 . . . ; If only 1 mailbox named, go get it 105179 105203 "RTN","C0CMAIL3",102,0) 105180 . . . .QUIT105204 . . . I $L(MBLST) D QUIT 105181 105205 "RTN","C0CMAIL3",103,0) 105182 . . . ;105206 . . . . I $D(^XMB(3.7,DUZ,2,"B",MBLST)) D GATHER(DUZ,MBLST,.LST) QUIT 105183 105207 "RTN","C0CMAIL3",104,0) 105184 . . . ; If only 1 mailbox named, go get it105208 . . . . ; 105185 105209 "RTN","C0CMAIL3",105,0) 105186 . . . I $L(MBLST) D QUIT105210 . . . . D ERROR("ER07") 105187 105211 "RTN","C0CMAIL3",106,0) 105188 . . . . I $D(^XMB(3.7,DUZ,2,"B",MBLST)) D GATHER(DUZ,MBLST,.LST)QUIT105212 . . .QUIT 105189 105213 "RTN","C0CMAIL3",107,0) 105190 . . . . ;105214 . . MERGE C0CDATA=LST 105191 105215 "RTN","C0CMAIL3",108,0) 105192 . . . . D ERROR("ER07")105216 . .QUIT 105193 105217 "RTN","C0CMAIL3",109,0) 105194 . . .QUIT105218 .QUIT 105195 105219 "RTN","C0CMAIL3",110,0) 105196 . . MERGE C0CDATA=LST105220 QUIT 105197 105221 "RTN","C0CMAIL3",111,0) 105222 ; =================== 105223 "RTN","C0CMAIL3",112,0) 105224 GATHER(DUZ,NAM,LST) ; Gather Data about the Baskets and their mail 105225 "RTN","C0CMAIL3",113,0) 105226 N I,J,K,L 105227 "RTN","C0CMAIL3",114,0) 105228 S (I,K)=0 105229 "RTN","C0CMAIL3",115,0) 105230 S J=$O(^XMB(3.7,DUZ,2,"B",NAM,"")) 105231 "RTN","C0CMAIL3",116,0) 105232 F S I=$O(^XMB(3.7,DUZ,2,J,1,I)) Q:'I D 105233 "RTN","C0CMAIL3",117,0) 105234 . S L=$P(^XMB(3.7,DUZ,2,J,1,I,0),U,3) 105235 "RTN","C0CMAIL3",118,0) 105236 . D ; :L 105237 "RTN","C0CMAIL3",119,0) 105238 . . S:L K=K+1,LST(NAM,"MSG",I,"NEW")="" ; Flag NEW emails 105239 "RTN","C0CMAIL3",120,0) 105240 . . S LST(NAM,"MSG",I)=L 105241 "RTN","C0CMAIL3",121,0) 105242 . . D GETTYP(I) 105243 "RTN","C0CMAIL3",122,0) 105198 105244 . .QUIT 105199 "RTN","C0CMAIL3",1 12,0)105245 "RTN","C0CMAIL3",123,0) 105200 105246 .QUIT 105201 "RTN","C0CMAIL3",113,0) 105247 "RTN","C0CMAIL3",124,0) 105248 S LST(NAM,"NUMBER")=K 105249 "RTN","C0CMAIL3",125,0) 105202 105250 QUIT 105203 "RTN","C0CMAIL3",1 14,0)105251 "RTN","C0CMAIL3",126,0) 105204 105252 ; =================== 105205 "RTN","C0CMAIL3",115,0)105206 GATHER(DUZ,NAM,LST) ; Gather Data about the Baskets and their mail105207 "RTN","C0CMAIL3",116,0)105208 N I,J,K,L105209 "RTN","C0CMAIL3",117,0)105210 S (I,K)=0105211 "RTN","C0CMAIL3",118,0)105212 S J=$O(^XMB(3.7,DUZ,2,"B",NAM,""))105213 "RTN","C0CMAIL3",119,0)105214 F S I=$O(^XMB(3.7,DUZ,2,J,1,I)) Q:'I D105215 "RTN","C0CMAIL3",120,0)105216 . S L=$P(^XMB(3.7,DUZ,2,J,1,I,0),U,3)105217 "RTN","C0CMAIL3",121,0)105218 . D ; :L105219 "RTN","C0CMAIL3",122,0)105220 . . S:L K=K+1,LST(NAM,"MSG",I,"NEW")="" ; Flag NEW emails105221 "RTN","C0CMAIL3",123,0)105222 . . S LST(NAM,"MSG",I)=L105223 "RTN","C0CMAIL3",124,0)105224 . . D GETTYP(I)105225 "RTN","C0CMAIL3",125,0)105226 . .QUIT105227 "RTN","C0CMAIL3",126,0)105228 .QUIT105229 105253 "RTN","C0CMAIL3",127,0) 105230 S LST(NAM,"NUMBER")=K105254 ; D0 is the IEN into the Message Global ^XMB(3.9,D0) 105231 105255 "RTN","C0CMAIL3",128,0) 105232 QUIT105256 ; The products of these emails are scanned to identify 105233 105257 "RTN","C0CMAIL3",129,0) 105234 ; ===================105258 ; the number of documents stored in the MIME package. 105235 105259 "RTN","C0CMAIL3",130,0) 105236 ; D0 is the IEN into the Message Global ^XMB(3.9,D0)105260 ; The protocol runs like this; 105237 105261 "RTN","C0CMAIL3",131,0) 105238 ; The products of these emails are scanned to identify105262 ; Line 1 is the --separator 105239 105263 "RTN","C0CMAIL3",132,0) 105240 ; the number of documents stored in the MIME package.105264 ; Line 2 thru n >Look for Content-[detail type:]Description ; Next CMD 105241 105265 "RTN","C0CMAIL3",133,0) 105242 ; The protocol runs like this;105266 ; Line n+2 thru t-1 where t does NOT have "Content-" 105243 105267 "RTN","C0CMAIL3",134,0) 105244 ; Line 1 is the--separator105268 ; Line t is Next Section Terminator, or Message Terminator, --separator 105245 105269 "RTN","C0CMAIL3",135,0) 105246 ; Line 2 thru n >Look for Content-[detail type:]Description ; Next CMD105270 ; Line t+1 should not exist in the data set if Message Terminator 105247 105271 "RTN","C0CMAIL3",136,0) 105248 ; Line n+2 thru t-1 where t does NOT have"Content-"105272 ; CON = "Content-" 105249 105273 "RTN","C0CMAIL3",137,0) 105250 ; Line t is Next Section Terminator, or Message Terminator, --separator105274 ; FLG = "--" 105251 105275 "RTN","C0CMAIL3",138,0) 105252 ; Line t+1 should not exist in the data set if Message Terminator105276 ; SEP = FLG+7 or more characters ; Separator 105253 105277 "RTN","C0CMAIL3",139,0) 105254 ; CON = "Content-"105278 ; END = SEP+FLG 105255 105279 "RTN","C0CMAIL3",140,0) 105256 ; FLG = "--"105280 ; SGC = Segment Count 105257 105281 "RTN","C0CMAIL3",141,0) 105258 ; SEP = FLG+7 or more characters ; Separator105282 ; Note: separator is a string of specific characters of 105259 105283 "RTN","C0CMAIL3",142,0) 105260 ; END = SEP+FLG105284 ; indeterminate length 105261 105285 "RTN","C0CMAIL3",143,0) 105262 ; SGC = Segment Count105286 ; LST() the transfer array 105263 105287 "RTN","C0CMAIL3",144,0) 105264 ; Note: separator is a string of specific characters of105288 ; LST(NAM,"MSG",C0CIEN,"SEG",SGN)=Starting Line^Ending Line 105265 105289 "RTN","C0CMAIL3",145,0) 105266 ; indeterminate length105290 ; LST(NAM,"MSG",C0CIEN,"SEG",SGN,1:n)=Decoded Message Data 105267 105291 "RTN","C0CMAIL3",146,0) 105268 ; LST() the transfer array105292 ; 105269 105293 "RTN","C0CMAIL3",147,0) 105270 ; LST(NAM,"MSG",C0CIEN,"SEG",SGN)=Starting Line^Ending Line 105294 GETTYP(D0) ; Look for the goodies in the Mail 105271 105295 "RTN","C0CMAIL3",148,0) 105272 ; LST(NAM,"MSG",C0CIEN,"SEG",SGN,1:n)=Decoded Message Data105296 N I,J,N,BCN,CON,CNT,D1,END,FLG,SEP,SGC,XX,XXNM 105273 105297 "RTN","C0CMAIL3",149,0) 105274 ;105298 S CON="Content-" 105275 105299 "RTN","C0CMAIL3",150,0) 105276 GETTYP(D0) ; Look for the goodies in the Mail 105300 S FLG="--" 105277 105301 "RTN","C0CMAIL3",151,0) 105278 N I,J,N,BCN,CON,CNT,D1,END,FLG,SEP,SGC,XX,XXNM105302 S SEP="" ; Start SEP as null, so we can use this to help identify the type 105279 105303 "RTN","C0CMAIL3",152,0) 105280 S CON="Content-"105304 S (BCN,CNT,D1,END,SGC)=0 105281 105305 "RTN","C0CMAIL3",153,0) 105282 S FLG="--"105306 S XX=$G(^XMB(3.9,D0,0)) 105283 105307 "RTN","C0CMAIL3",154,0) 105284 S SEP="" ; Start SEP as null, so we can use this to help identify the type105308 S LST(NAM,"MSG",D0,"TITLE")=$P($G(^XMB(3.9,D0,0)),U,1) 105285 105309 "RTN","C0CMAIL3",155,0) 105286 S (BCN,CNT,D1,END,SGC)=0105310 S LST(NAM,"MSG",D0,"CREATED")=$G(^XMB(3.9,D0,.6)) 105287 105311 "RTN","C0CMAIL3",156,0) 105288 S XX=$G(^XMB(3.9,D0,0))105312 F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM) 105289 105313 "RTN","C0CMAIL3",157,0) 105290 S LST(NAM,"MSG",D0," TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)105314 S LST(NAM,"MSG",D0,"FROM")=$$NAME(XXNM) 105291 105315 "RTN","C0CMAIL3",158,0) 105292 S LST(NAM,"MSG",D0," CREATED")=$G(^XMB(3.9,D0,.6))105316 S LST(NAM,"MSG",D0,"SENT")=$$TIME($P(XX,U,3)) 105293 105317 "RTN","C0CMAIL3",159,0) 105294 F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM)105318 ; Get the folks the email is sent to. 105295 105319 "RTN","C0CMAIL3",160,0) 105296 S LST(NAM,"MSG",D0,"FROM")=$$NAME(XXNM)105320 S D1=0 105297 105321 "RTN","C0CMAIL3",161,0) 105298 S LST(NAM,"MSG",D0,"SENT")=$$TIME($P(XX,U,3))105322 F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D 105299 105323 "RTN","C0CMAIL3",162,0) 105300 ; Get the folks the email is sent to.105324 . N T 105301 105325 "RTN","C0CMAIL3",163,0) 105302 S D1=0105326 . S T=+$G(^XMB(3.9,D0,1,D1,0)) 105303 105327 "RTN","C0CMAIL3",164,0) 105304 F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D105328 . S:T T=$P($G(^VA(200,+T,0)),"^") 105305 105329 "RTN","C0CMAIL3",165,0) 105306 . NT105330 . S LST("TO",D1)=T 105307 105331 "RTN","C0CMAIL3",166,0) 105308 . S T= +$G(^XMB(3.9,D0,1,D1,0))105332 . S T=$G(^XMB(3.9,D0,6,D1,0)) 105309 105333 "RTN","C0CMAIL3",167,0) 105310 105334 . S:T T=$P($G(^VA(200,+T,0)),"^") 105311 105335 "RTN","C0CMAIL3",168,0) 105312 . S LST("TO",D1)=T105336 . S:T="" T="<Unknown>" 105313 105337 "RTN","C0CMAIL3",169,0) 105314 . S T=$G(^XMB(3.9,D0,6,D1,0))105338 . S LST("TO NAME",D1)=T 105315 105339 "RTN","C0CMAIL3",170,0) 105316 . S:T T=$P($G(^VA(200,+T,0)),"^")105340 .QUIT 105317 105341 "RTN","C0CMAIL3",171,0) 105318 . S:T="" T="<Unknown>"105342 ; Preload first Segment (0) with beginning on Line 1 105319 105343 "RTN","C0CMAIL3",172,0) 105320 . S LST("TO NAME",D1)=T105344 ; if not a 64bit 105321 105345 "RTN","C0CMAIL3",173,0) 105346 S LST(NAM,"MSG",D0,"SEG",0)=1 105347 "RTN","C0CMAIL3",174,0) 105348 S D1=.9999,SEP="@@" 105349 "RTN","C0CMAIL3",175,0) 105350 F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D 105351 "RTN","C0CMAIL3",176,0) 105352 . ; Clear any control characters (cr/lf/ff) off 105353 "RTN","C0CMAIL3",177,0) 105354 . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13)) 105355 "RTN","C0CMAIL3",178,0) 105356 . ; Enter once to set the SEP to capture the separator 105357 "RTN","C0CMAIL3",179,0) 105358 . I SEP=FLG&($E(X,1,2)=FLG)&($L(X,FLG)=2)&($L($P(X,FLG,2)>5)) D Q 105359 "RTN","C0CMAIL3",180,0) 105360 . . S SEP=X,END=X_FLG 105361 "RTN","C0CMAIL3",181,0) 105362 . . S (CNT,SGC)=1,BCN=0 105363 "RTN","C0CMAIL3",182,0) 105364 . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1 105365 "RTN","C0CMAIL3",183,0) 105366 . .QUIT 105367 "RTN","C0CMAIL3",184,0) 105368 . ; 105369 "RTN","C0CMAIL3",185,0) 105370 . ; A new separator is set, process original 105371 "RTN","C0CMAIL3",186,0) 105372 . I X=SEP D QUIT 105373 "RTN","C0CMAIL3",187,0) 105374 . . S LST(NAM,"MSG",D0,SGC,"SIZE")=BCN+$L(BF) 105375 "RTN","C0CMAIL3",188,0) 105376 . . S LST(NAM,"MSG",D0,"SEG",SGC)=$G(LST(NAM,"MSG",D0,"SEG",SGC))_"^"_(D1-1) 105377 "RTN","C0CMAIL3",189,0) 105378 . . S SGC=SGC+1,BCN=0 105379 "RTN","C0CMAIL3",190,0) 105380 . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1 105381 "RTN","C0CMAIL3",191,0) 105382 . .QUIT 105383 "RTN","C0CMAIL3",192,0) 105384 . ; 105385 "RTN","C0CMAIL3",193,0) 105386 . S BCN=BCN+$L(X) 105387 "RTN","C0CMAIL3",194,0) 105388 . I X[CON D Q 105389 "RTN","C0CMAIL3",195,0) 105390 . . S J=$P($P(X,";"),CON,2) 105391 "RTN","C0CMAIL3",196,0) 105392 . . S LST(NAM,"MSG",D0,"SEG",SGC,"CONT",CNT,$P(J,":"))=$P(J,":",2) 105393 "RTN","C0CMAIL3",197,0) 105394 . .QUIT 105395 "RTN","C0CMAIL3",198,0) 105396 . ; 105397 "RTN","C0CMAIL3",199,0) 105398 . ; S LST(NAM,"MSG",D0,"SEG",D1)=X 105399 "RTN","C0CMAIL3",200,0) 105322 105400 .QUIT 105323 "RTN","C0CMAIL3",174,0) 105324 ; Preload first Segment (0) with beginning on Line 1 105325 "RTN","C0CMAIL3",175,0) 105326 ; if not a 64bit 105327 "RTN","C0CMAIL3",176,0) 105328 S LST(NAM,"MSG",D0,"SEG",0)=1 105329 "RTN","C0CMAIL3",177,0) 105330 S D1=.9999,SEP="@@" 105331 "RTN","C0CMAIL3",178,0) 105332 F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D 105333 "RTN","C0CMAIL3",179,0) 105334 . ; Clear any control characters (cr/lf/ff) off 105335 "RTN","C0CMAIL3",180,0) 105336 . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13)) 105337 "RTN","C0CMAIL3",181,0) 105338 . ; Enter once to set the SEP to capture the separator 105339 "RTN","C0CMAIL3",182,0) 105340 . I SEP=FLG&($E(X,1,2)=FLG)&($L(X,FLG)=2)&($L($P(X,FLG,2)>5)) D Q 105341 "RTN","C0CMAIL3",183,0) 105342 . . S SEP=X,END=X_FLG 105343 "RTN","C0CMAIL3",184,0) 105344 . . S (CNT,SGC)=1,BCN=0 105345 "RTN","C0CMAIL3",185,0) 105346 . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1 105347 "RTN","C0CMAIL3",186,0) 105348 . .QUIT 105349 "RTN","C0CMAIL3",187,0) 105401 "RTN","C0CMAIL3",201,0) 105402 QUIT 105403 "RTN","C0CMAIL3",202,0) 105404 ; =================== 105405 "RTN","C0CMAIL3",203,0) 105406 NAME(NM) ; Return the name of the Sender 105407 "RTN","C0CMAIL3",204,0) 105408 N NAME 105409 "RTN","C0CMAIL3",205,0) 105410 S NAME="<Unknown Sender>" 105411 "RTN","C0CMAIL3",206,0) 105412 D 105413 "RTN","C0CMAIL3",207,0) 105414 . ; Look first for a value to use with the NEW PERSON file 105415 "RTN","C0CMAIL3",208,0) 105350 105416 . ; 105351 "RTN","C0CMAIL3",188,0) 105352 . ; A new separator is set, process original 105353 "RTN","C0CMAIL3",189,0) 105354 . I X=SEP D QUIT 105355 "RTN","C0CMAIL3",190,0) 105356 . . S LST(NAM,"MSG",D0,SGC,"SIZE")=BCN+$L(BF) 105357 "RTN","C0CMAIL3",191,0) 105358 . . S LST(NAM,"MSG",D0,"SEG",SGC)=$G(LST(NAM,"MSG",D0,"SEG",SGC))_"^"_(D1-1) 105359 "RTN","C0CMAIL3",192,0) 105360 . . S SGC=SGC+1,BCN=0 105361 "RTN","C0CMAIL3",193,0) 105362 . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1 105363 "RTN","C0CMAIL3",194,0) 105364 . .QUIT 105365 "RTN","C0CMAIL3",195,0) 105417 "RTN","C0CMAIL3",209,0) 105418 . I NM=+NM S NAME=$P(^VA(200,NM,0),U,1) Q 105419 "RTN","C0CMAIL3",210,0) 105366 105420 . ; 105367 "RTN","C0CMAIL3",196,0) 105368 . S BCN=BCN+$L(X) 105369 "RTN","C0CMAIL3",197,0) 105370 . I X[CON D Q 105371 "RTN","C0CMAIL3",198,0) 105372 . . S J=$P($P(X,";"),CON,2) 105373 "RTN","C0CMAIL3",199,0) 105374 . . S LST(NAM,"MSG",D0,"SEG",SGC,"CONT",CNT,$P(J,":"))=$P(J,":",2) 105375 "RTN","C0CMAIL3",200,0) 105376 . .QUIT 105377 "RTN","C0CMAIL3",201,0) 105421 "RTN","C0CMAIL3",211,0) 105422 . I $L(NM) S NAME=NM Q 105423 "RTN","C0CMAIL3",212,0) 105378 105424 . ; 105379 "RTN","C0CMAIL3",202,0) 105380 . ; S LST(NAM,"MSG",D0,"SEG",D1)=X 105381 "RTN","C0CMAIL3",203,0) 105425 "RTN","C0CMAIL3",213,0) 105426 . ; Else, pull the data from the message and display the foreign source 105427 "RTN","C0CMAIL3",214,0) 105428 . ; of the message. 105429 "RTN","C0CMAIL3",215,0) 105430 . N T 105431 "RTN","C0CMAIL3",216,0) 105432 . S VAL=$G(^XMB(3.9,D0,.7)) 105433 "RTN","C0CMAIL3",217,0) 105434 . S:VAL T=$P(^VA(200,VAL,0),U) 105435 "RTN","C0CMAIL3",218,0) 105436 . I $L($G(T)) S NAME=T Q 105437 "RTN","C0CMAIL3",219,0) 105438 . ; 105439 "RTN","C0CMAIL3",220,0) 105382 105440 .QUIT 105383 "RTN","C0CMAIL3",2 04,0)105384 QUIT 105385 "RTN","C0CMAIL3",2 05,0)105441 "RTN","C0CMAIL3",221,0) 105442 QUIT NAME 105443 "RTN","C0CMAIL3",222,0) 105386 105444 ; =================== 105387 "RTN","C0CMAIL3",206,0) 105388 NAME(NM) ; Return the name of the Sender 105389 "RTN","C0CMAIL3",207,0) 105390 N NAME 105391 "RTN","C0CMAIL3",208,0) 105392 S NAME="<Unknown Sender>" 105393 "RTN","C0CMAIL3",209,0) 105394 D 105395 "RTN","C0CMAIL3",210,0) 105396 . ; Look first for a value to use with the NEW PERSON file 105397 "RTN","C0CMAIL3",211,0) 105445 "RTN","C0CMAIL3",223,0) 105446 TIME(Y) ; The time and date of the sending 105447 "RTN","C0CMAIL3",224,0) 105448 X ^DD("DD") 105449 "RTN","C0CMAIL3",225,0) 105450 QUIT Y 105451 "RTN","C0CMAIL3",226,0) 105452 ; =================== 105453 "RTN","C0CMAIL3",227,0) 105454 ; Segments in Message need to be identified and decoded properly 105455 "RTN","C0CMAIL3",228,0) 105456 ; D DETAIL^C0CMAIL(.ARRAY,D0) ; Call One for each message 105457 "RTN","C0CMAIL3",229,0) 105458 ; ARRAY will have the details of this one call 105459 "RTN","C0CMAIL3",230,0) 105460 ; 105461 "RTN","C0CMAIL3",231,0) 105462 ; Inputs; 105463 "RTN","C0CMAIL3",232,0) 105464 ; C0CINPUT - The IEN of the message to expand 105465 "RTN","C0CMAIL3",233,0) 105466 ; Outputs; 105467 "RTN","C0CMAIL3",234,0) 105468 ; C0CDATA - Carrier for the returned structure of the Message 105469 "RTN","C0CMAIL3",235,0) 105470 ; C0CDATA(D0,"SEG")=number of SEGMENTS 105471 "RTN","C0CMAIL3",236,0) 105472 ; C0CDATA(D0,"SEG",0:n)=SEGMENT n details; First;Last;Type 105473 "RTN","C0CMAIL3",237,0) 105474 ; C0CDATA(D0,"SEG",0:n,"CONTENT",type)=Content details 105475 "RTN","C0CMAIL3",238,0) 105476 ; C0CDATA(D0,"SEG",0:n,"MSG",D3)=Content details 105477 "RTN","C0CMAIL3",239,0) 105478 ; C0CDATA(D0,"SEG",0:n,"HTML",D3)=Content details 105479 "RTN","C0CMAIL3",240,0) 105480 ; 105481 "RTN","C0CMAIL3",241,0) 105482 DETAIL(C0CDATA,C0CINPUT) ; Message Detail Delivery 105483 "RTN","C0CMAIL3",242,0) 105484 N LST,D0,D1,U 105485 "RTN","C0CMAIL3",243,0) 105486 S U="^" 105487 "RTN","C0CMAIL3",244,0) 105488 S D0=+$G(C0CINPUT) 105489 "RTN","C0CMAIL3",245,0) 105490 I D0 D QUIT 105491 "RTN","C0CMAIL3",246,0) 105492 . I $D(^XMB(3.9,D0))<10 D ERROR("ER01") QUIT 105493 "RTN","C0CMAIL3",247,0) 105398 105494 . ; 105399 "RTN","C0CMAIL3",212,0)105400 . I NM=+NM S NAME=$P(^VA(200,NM,0),U,1) Q105401 "RTN","C0CMAIL3",213,0)105402 . ;105403 "RTN","C0CMAIL3",214,0)105404 . I $L(NM) S NAME=NM Q105405 "RTN","C0CMAIL3",215,0)105406 . ;105407 "RTN","C0CMAIL3",216,0)105408 . ; Else, pull the data from the message and display the foreign source105409 "RTN","C0CMAIL3",217,0)105410 . ; of the message.105411 "RTN","C0CMAIL3",218,0)105412 . N T105413 "RTN","C0CMAIL3",219,0)105414 . S VAL=$G(^XMB(3.9,D0,.7))105415 "RTN","C0CMAIL3",220,0)105416 . S:VAL T=$P(^VA(200,VAL,0),U)105417 "RTN","C0CMAIL3",221,0)105418 . I $L($G(T)) S NAME=T Q105419 "RTN","C0CMAIL3",222,0)105420 . ;105421 "RTN","C0CMAIL3",223,0)105422 .QUIT105423 "RTN","C0CMAIL3",224,0)105424 QUIT NAME105425 "RTN","C0CMAIL3",225,0)105426 ; ===================105427 "RTN","C0CMAIL3",226,0)105428 TIME(Y) ; The time and date of the sending105429 "RTN","C0CMAIL3",227,0)105430 X ^DD("DD")105431 "RTN","C0CMAIL3",228,0)105432 QUIT Y105433 "RTN","C0CMAIL3",229,0)105434 ; ===================105435 "RTN","C0CMAIL3",230,0)105436 ; Segments in Message need to be identified and decoded properly105437 "RTN","C0CMAIL3",231,0)105438 ; D DETAIL^C0CMAIL(.ARRAY,D0) ; Call One for each message105439 "RTN","C0CMAIL3",232,0)105440 ; ARRAY will have the details of this one call105441 "RTN","C0CMAIL3",233,0)105442 ;105443 "RTN","C0CMAIL3",234,0)105444 ; Inputs;105445 "RTN","C0CMAIL3",235,0)105446 ; C0CINPUT - The IEN of the message to expand105447 "RTN","C0CMAIL3",236,0)105448 ; Outputs;105449 "RTN","C0CMAIL3",237,0)105450 ; C0CDATA - Carrier for the returned structure of the Message105451 "RTN","C0CMAIL3",238,0)105452 ; C0CDATA(D0,"SEG")=number of SEGMENTS105453 "RTN","C0CMAIL3",239,0)105454 ; C0CDATA(D0,"SEG",0:n)=SEGMENT n details; First;Last;Type105455 "RTN","C0CMAIL3",240,0)105456 ; C0CDATA(D0,"SEG",0:n,"CONTENT",type)=Content details105457 "RTN","C0CMAIL3",241,0)105458 ; C0CDATA(D0,"SEG",0:n,"MSG",D3)=Content details105459 "RTN","C0CMAIL3",242,0)105460 ; C0CDATA(D0,"SEG",0:n,"HTML",D3)=Content details105461 "RTN","C0CMAIL3",243,0)105462 ;105463 "RTN","C0CMAIL3",244,0)105464 DETAIL(C0CDATA,C0CINPUT) ; Message Detail Delivery105465 "RTN","C0CMAIL3",245,0)105466 N LST,D0,D1,U105467 "RTN","C0CMAIL3",246,0)105468 S U="^"105469 "RTN","C0CMAIL3",247,0)105470 S D0=+$G(C0CINPUT)105471 105495 "RTN","C0CMAIL3",248,0) 105472 I D0 D QUIT105496 . D GETTYP2(D0) 105473 105497 "RTN","C0CMAIL3",249,0) 105474 . I $D( ^XMB(3.9,D0))<10 D ERROR("ER01") QUIT105498 . I $D(LST) M C0CDATA(D0)=LST Q 105475 105499 "RTN","C0CMAIL3",250,0) 105476 105500 . ; 105477 105501 "RTN","C0CMAIL3",251,0) 105478 . D GETTYP2(D0)105502 . D ERROR("ER02") 105479 105503 "RTN","C0CMAIL3",252,0) 105480 . I $D(LST) M C0CDATA(D0)=LST Q105504 .QUIT 105481 105505 "RTN","C0CMAIL3",253,0) 105506 QUIT 105507 "RTN","C0CMAIL3",254,0) 105508 ; =================== 105509 "RTN","C0CMAIL3",255,0) 105510 ; End note if needed 105511 "RTN","C0CMAIL3",256,0) 105512 ; MSK - Set of characters that do not exist in 64 bit encoding 105513 "RTN","C0CMAIL3",257,0) 105514 GETTYP2(D0) ; Try to get the types and MSK for the 105515 "RTN","C0CMAIL3",258,0) 105516 N I,J,K,N,BCN,BF,CON,CNT,D1,END,FLG,MSK,SEP,SGC,U,XX,ZN,XXNM 105517 "RTN","C0CMAIL3",259,0) 105518 S CON="Content-",U="^" 105519 "RTN","C0CMAIL3",260,0) 105520 S FLG="--",MSK=" !""#$%&'()*,-.:;<>?@[\]^_`{|}~" 105521 "RTN","C0CMAIL3",261,0) 105522 S (BF,SEP)="" ; Start SEP as null, so we can use this to help identify the type 105523 "RTN","C0CMAIL3",262,0) 105524 S (BCN,CNT,D1,END,SGC)=0 105525 "RTN","C0CMAIL3",263,0) 105526 S XX=$G(^XMB(3.9,D0,0)) 105527 "RTN","C0CMAIL3",264,0) 105528 ; S K=$P(^XMB(3.9,D0,2,0),U,3) 105529 "RTN","C0CMAIL3",265,0) 105530 S LST("TITLE")=$P($G(^XMB(3.9,D0,0)),U,1) 105531 "RTN","C0CMAIL3",266,0) 105532 S LST("CREATED")=$$TIME($P(XX,U,3)) 105533 "RTN","C0CMAIL3",267,0) 105534 F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM) 105535 "RTN","C0CMAIL3",268,0) 105536 S LST("FROM")=$$NAME(XXNM) 105537 "RTN","C0CMAIL3",269,0) 105538 ; Get the folks the email is sent to. 105539 "RTN","C0CMAIL3",270,0) 105540 S D1=0 105541 "RTN","C0CMAIL3",271,0) 105542 F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D Q:D1="" 105543 "RTN","C0CMAIL3",272,0) 105544 . N I,T 105545 "RTN","C0CMAIL3",273,0) 105546 . S T=$P($G(^XMB(3.9,D0,1,D1,0)),U) 105547 "RTN","C0CMAIL3",274,0) 105548 . S:T T=$P($G(^VA(200,T,0)),"^") 105549 "RTN","C0CMAIL3",275,0) 105550 . S LST("TO",+D1)=T 105551 "RTN","C0CMAIL3",276,0) 105552 . S T=$G(^XMB(3.9,D0,6,+D1,0)) 105553 "RTN","C0CMAIL3",277,0) 105554 . S:T="" T=$P($G(^VA(200,+T,0)),"^") 105555 "RTN","C0CMAIL3",278,0) 105556 . S:T="" T="<Unknown>" 105557 "RTN","C0CMAIL3",279,0) 105558 . S LST("TO NAME",D1)=T 105559 "RTN","C0CMAIL3",280,0) 105560 .QUIT 105561 "RTN","C0CMAIL3",281,0) 105562 ; Get the Header for the message and store as "HDR" 105563 "RTN","C0CMAIL3",282,0) 105564 S D1=0,SGC=0 105565 "RTN","C0CMAIL3",283,0) 105566 F I=1:1 S D1=$O(^XMB(3.9,D0,2,D1)) Q:D1="" Q:(D1>.99999) D 105567 "RTN","C0CMAIL3",284,0) 105568 . S LST("HDR",I)=$G(^XMB(3.9,D0,2,D1,0)) 105569 "RTN","C0CMAIL3",285,0) 105570 .QUIT 105571 "RTN","C0CMAIL3",286,0) 105572 N BNDRY,STKL,SEG 105573 "RTN","C0CMAIL3",287,0) 105574 S STKL=0,SEG=0 105575 "RTN","C0CMAIL3",288,0) 105576 ; Find boundaries and map them 105577 "RTN","C0CMAIL3",289,0) 105578 S D1=0 105579 "RTN","C0CMAIL3",290,0) 105580 F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D 105581 "RTN","C0CMAIL3",291,0) 105582 . ; Clear any control characters (cr/lf/ff) off 105583 "RTN","C0CMAIL3",292,0) 105584 . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13)) 105585 "RTN","C0CMAIL3",293,0) 105586 . ; Look for " boundary=" in the various parts. Map the establishment and the 105587 "RTN","C0CMAIL3",294,0) 105588 . ; terminator markers and the actual boundary markers. 105589 "RTN","C0CMAIL3",295,0) 105590 . I X[" boundary=" D Q 105591 "RTN","C0CMAIL3",296,0) 105592 . . S SEP=$P(X," boundary=",2) 105593 "RTN","C0CMAIL3",297,0) 105594 . . S:$E(SEP)="""" SEP=$TR(SEP,"""") 105595 "RTN","C0CMAIL3",298,0) 105596 . . S STKL=STKL+1 105597 "RTN","C0CMAIL3",299,0) 105598 . . S END=SEP_FLG 105599 "RTN","C0CMAIL3",300,0) 105600 . . S BNDRY(STKL,SEP)=0 105601 "RTN","C0CMAIL3",301,0) 105602 . . S BNDRX(SEP)=STKL,BNDRZ(END)=0 105603 "RTN","C0CMAIL3",302,0) 105604 . .QUIT 105605 "RTN","C0CMAIL3",303,0) 105482 105606 . ; 105483 "RTN","C0CMAIL3",254,0) 105484 . D ERROR("ER02") 105485 "RTN","C0CMAIL3",255,0) 105607 "RTN","C0CMAIL3",304,0) 105608 . ; Look for information as to how amy boudaries are present and where 105609 "RTN","C0CMAIL3",305,0) 105610 . ; they terminate 105611 "RTN","C0CMAIL3",306,0) 105612 . D:X'=""&($E(X,1,2)="--")&($E(X,$L(X)-1,9999)'="--") 105613 "RTN","C0CMAIL3",307,0) 105614 . . ; Boundary Found 105615 "RTN","C0CMAIL3",308,0) 105616 . . I $D(BNDRX(X)) D Q 105617 "RTN","C0CMAIL3",309,0) 105618 . . . S SEG=SEG+1 105619 "RTN","C0CMAIL3",310,0) 105620 . . . S BNDRE(X)=$G(BNDRE(X))_D1_";" 105621 "RTN","C0CMAIL3",311,0) 105622 . . . S BND1(D1)=STKL_";B;"_SEG_";"_X 105623 "RTN","C0CMAIL3",312,0) 105624 . . . S BNDR(X,D1,"B")=STKL 105625 "RTN","C0CMAIL3",313,0) 105626 . . . I BNDRX(X)=X D ERROR("ER13") 105627 "RTN","C0CMAIL3",314,0) 105628 . . .QUIT 105629 "RTN","C0CMAIL3",315,0) 105630 . . ; 105631 "RTN","C0CMAIL3",316,0) 105632 . . ; Boundary Terminator 105633 "RTN","C0CMAIL3",317,0) 105634 . . I $D(BNDRZ(X)) D Q 105635 "RTN","C0CMAIL3",318,0) 105636 . . . S BNDR(X,D1,"E")=STKL 105637 "RTN","C0CMAIL3",319,0) 105638 . . . S BNDRZ(X)=BNDRZ(X)+1 105639 "RTN","C0CMAIL3",320,0) 105640 . . . S BND1(D1)=STKL_";E;"_SEG_";"_X 105641 "RTN","C0CMAIL3",321,0) 105642 . . . S SEG=SEG+1 105643 "RTN","C0CMAIL3",322,0) 105644 . . . I BNDRX(X)=X D ERROR("ER14") 105645 "RTN","C0CMAIL3",323,0) 105646 . . . S STKL=STKL-1 105647 "RTN","C0CMAIL3",324,0) 105648 . . .QUIT 105649 "RTN","C0CMAIL3",325,0) 105650 . .QUIT 105651 "RTN","C0CMAIL3",326,0) 105486 105652 .QUIT 105487 "RTN","C0CMAIL3",256,0) 105488 QUIT 105489 "RTN","C0CMAIL3",257,0) 105490 ; =================== 105491 "RTN","C0CMAIL3",258,0) 105492 ; End note if needed 105493 "RTN","C0CMAIL3",259,0) 105494 ; MSK - Set of characters that do not exist in 64 bit encoding 105495 "RTN","C0CMAIL3",260,0) 105496 GETTYP2(D0) ; Try to get the types and MSK for the 105497 "RTN","C0CMAIL3",261,0) 105498 N I,J,K,N,BCN,BF,CON,CNT,D1,END,FLG,MSK,SEP,SGC,U,XX,ZN,XXNM 105499 "RTN","C0CMAIL3",262,0) 105500 S CON="Content-",U="^" 105501 "RTN","C0CMAIL3",263,0) 105502 S FLG="--",MSK=" !""#$%&'()*,-.:;<>?@[\]^_`{|}~" 105503 "RTN","C0CMAIL3",264,0) 105504 S (BF,SEP)="" ; Start SEP as null, so we can use this to help identify the type 105505 "RTN","C0CMAIL3",265,0) 105506 S (BCN,CNT,D1,END,SGC)=0 105507 "RTN","C0CMAIL3",266,0) 105508 S XX=$G(^XMB(3.9,D0,0)) 105509 "RTN","C0CMAIL3",267,0) 105510 ; S K=$P(^XMB(3.9,D0,2,0),U,3) 105511 "RTN","C0CMAIL3",268,0) 105512 S LST("TITLE")=$P($G(^XMB(3.9,D0,0)),U,1) 105513 "RTN","C0CMAIL3",269,0) 105514 S LST("CREATED")=$$TIME($P(XX,U,3)) 105515 "RTN","C0CMAIL3",270,0) 105516 F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM) 105517 "RTN","C0CMAIL3",271,0) 105518 S LST("FROM")=$$NAME(XXNM) 105519 "RTN","C0CMAIL3",272,0) 105520 ; Get the folks the email is sent to. 105521 "RTN","C0CMAIL3",273,0) 105522 S D1=0 105523 "RTN","C0CMAIL3",274,0) 105524 F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D Q:D1="" 105525 "RTN","C0CMAIL3",275,0) 105526 . N I,T 105527 "RTN","C0CMAIL3",276,0) 105528 . S T=$P($G(^XMB(3.9,D0,1,D1,0)),U) 105529 "RTN","C0CMAIL3",277,0) 105530 . S:T T=$P($G(^VA(200,T,0)),"^") 105531 "RTN","C0CMAIL3",278,0) 105532 . S LST("TO",+D1)=T 105533 "RTN","C0CMAIL3",279,0) 105534 . S T=$G(^XMB(3.9,D0,6,+D1,0)) 105535 "RTN","C0CMAIL3",280,0) 105536 . S:T="" T=$P($G(^VA(200,+T,0)),"^") 105537 "RTN","C0CMAIL3",281,0) 105538 . S:T="" T="<Unknown>" 105539 "RTN","C0CMAIL3",282,0) 105540 . S LST("TO NAME",D1)=T 105541 "RTN","C0CMAIL3",283,0) 105542 .QUIT 105543 "RTN","C0CMAIL3",284,0) 105544 ; Get the Header for the message and store as "HDR" 105545 "RTN","C0CMAIL3",285,0) 105546 S D1=0,SGC=0 105547 "RTN","C0CMAIL3",286,0) 105548 F I=1:1 S D1=$O(^XMB(3.9,D0,2,D1)) Q:D1="" Q:(D1>.99999) D 105549 "RTN","C0CMAIL3",287,0) 105550 . S LST("HDR",I)=$G(^XMB(3.9,D0,2,D1,0)) 105551 "RTN","C0CMAIL3",288,0) 105552 .QUIT 105553 "RTN","C0CMAIL3",289,0) 105554 N BNDRY,STKL,SEG 105555 "RTN","C0CMAIL3",290,0) 105556 S STKL=0,SEG=0 105557 "RTN","C0CMAIL3",291,0) 105558 ; Find boundaries and map them 105559 "RTN","C0CMAIL3",292,0) 105560 S D1=0 105561 "RTN","C0CMAIL3",293,0) 105653 "RTN","C0CMAIL3",327,0) 105654 ; Start walking the TEXT/XML/64-BIT ENCODING sections of the message 105655 "RTN","C0CMAIL3",328,0) 105656 N A,B,C,STACK,STYP,SEG,AX 105657 "RTN","C0CMAIL3",329,0) 105658 S D1=.99999,SGC=0 105659 "RTN","C0CMAIL3",330,0) 105562 105660 F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D 105563 "RTN","C0CMAIL3", 294,0)105661 "RTN","C0CMAIL3",331,0) 105564 105662 . ; Clear any control characters (cr/lf/ff) off 105565 "RTN","C0CMAIL3", 295,0)105663 "RTN","C0CMAIL3",332,0) 105566 105664 . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13)) 105567 "RTN","C0CMAIL3",296,0) 105568 . ; Look for " boundary=" in the various parts. Map the establishment and the 105569 "RTN","C0CMAIL3",297,0) 105570 . ; terminator markers and the actual boundary markers. 105571 "RTN","C0CMAIL3",298,0) 105572 . I X[" boundary=" D Q 105573 "RTN","C0CMAIL3",299,0) 105574 . . S SEP=$P(X," boundary=",2) 105575 "RTN","C0CMAIL3",300,0) 105576 . . S:$E(SEP)="""" SEP=$TR(SEP,"""") 105577 "RTN","C0CMAIL3",301,0) 105578 . . S STKL=STKL+1 105579 "RTN","C0CMAIL3",302,0) 105580 . . S END=SEP_FLG 105581 "RTN","C0CMAIL3",303,0) 105582 . . S BNDRY(STKL,SEP)=0 105583 "RTN","C0CMAIL3",304,0) 105584 . . S BNDRX(SEP)=STKL,BNDRZ(END)=0 105585 "RTN","C0CMAIL3",305,0) 105586 . .QUIT 105587 "RTN","C0CMAIL3",306,0) 105665 "RTN","C0CMAIL3",333,0) 105588 105666 . ; 105589 "RTN","C0CMAIL3",307,0) 105590 . ; Look for information as to how amy boudaries are present and where 105591 "RTN","C0CMAIL3",308,0) 105592 . ; they terminate 105593 "RTN","C0CMAIL3",309,0) 105594 . D:X'=""&($E(X,1,2)="--")&($E(X,$L(X)-1,9999)'="--") 105595 "RTN","C0CMAIL3",310,0) 105596 . . ; Boundary Found 105597 "RTN","C0CMAIL3",311,0) 105598 . . I $D(BNDRX(X)) D Q 105599 "RTN","C0CMAIL3",312,0) 105600 . . . S SEG=SEG+1 105601 "RTN","C0CMAIL3",313,0) 105602 . . . S BNDRE(X)=$G(BNDRE(X))_D1_";" 105603 "RTN","C0CMAIL3",314,0) 105604 . . . S BND1(D1)=STKL_";B;"_SEG_";"_X 105605 "RTN","C0CMAIL3",315,0) 105606 . . . S BNDR(X,D1,"B")=STKL 105607 "RTN","C0CMAIL3",316,0) 105608 . . . I BNDRX(X)=X D ERROR("ER13") 105609 "RTN","C0CMAIL3",317,0) 105610 . . .QUIT 105611 "RTN","C0CMAIL3",318,0) 105667 "RTN","C0CMAIL3",334,0) 105668 . D 105669 "RTN","C0CMAIL3",335,0) 105670 . . I $D(BND1(D1)) D BOUNDARY(X) QUIT 105671 "RTN","C0CMAIL3",336,0) 105612 105672 . . ; 105613 "RTN","C0CMAIL3",319,0)105614 . . ; Boundary Terminator105615 "RTN","C0CMAIL3",320,0)105616 . . I $D(BNDRZ(X)) D Q105617 "RTN","C0CMAIL3",321,0)105618 . . . S BNDR(X,D1,"E")=STKL105619 "RTN","C0CMAIL3",322,0)105620 . . . S BNDRZ(X)=BNDRZ(X)+1105621 "RTN","C0CMAIL3",323,0)105622 . . . S BND1(D1)=STKL_";E;"_SEG_";"_X105623 "RTN","C0CMAIL3",324,0)105624 . . . S SEG=SEG+1105625 "RTN","C0CMAIL3",325,0)105626 . . . I BNDRX(X)=X D ERROR("ER14")105627 "RTN","C0CMAIL3",326,0)105628 . . . S STKL=STKL-1105629 "RTN","C0CMAIL3",327,0)105630 . . .QUIT105631 "RTN","C0CMAIL3",328,0)105632 . .QUIT105633 "RTN","C0CMAIL3",329,0)105634 .QUIT105635 "RTN","C0CMAIL3",330,0)105636 ; Start walking the TEXT/XML/64-BIT ENCODING sections of the message105637 "RTN","C0CMAIL3",331,0)105638 N A,B,C,STACK,STYP,SEG,AX105639 "RTN","C0CMAIL3",332,0)105640 S D1=.99999,SGC=0105641 "RTN","C0CMAIL3",333,0)105642 F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D105643 "RTN","C0CMAIL3",334,0)105644 . ; Clear any control characters (cr/lf/ff) off105645 "RTN","C0CMAIL3",335,0)105646 . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))105647 "RTN","C0CMAIL3",336,0)105648 . ;105649 105673 "RTN","C0CMAIL3",337,0) 105650 . D105674 . . S DX=$O(BND1(D1)) 105651 105675 "RTN","C0CMAIL3",338,0) 105652 . . I $D(BND1(D1)) D BOUNDARY(X) QUIT105676 . . I DX="" D ERROR("ER15") Q 105653 105677 "RTN","C0CMAIL3",339,0) 105654 105678 . . ; 105655 105679 "RTN","C0CMAIL3",340,0) 105656 . . S DX=$O(BND1(D1))105680 . . ; Good situation, extract the parts for the section 105657 105681 "RTN","C0CMAIL3",341,0) 105658 . . I DX="" D ERROR("ER15") Q105682 . . S A=$G(BND1(DX)) 105659 105683 "RTN","C0CMAIL3",342,0) 105660 . . ;105684 . . S STACK=+A,STYP=$P(A,";",2),SGC=$P(A,";",3),AX=$P(A,";",4,999) 105661 105685 "RTN","C0CMAIL3",343,0) 105662 . . ; Good situation, extract the parts for the section105686 . .QUIT 105663 105687 "RTN","C0CMAIL3",344,0) 105664 . . S A=$G(BND1(DX))105688 . ; Enter once to set the SEP to capture the separator 105665 105689 "RTN","C0CMAIL3",345,0) 105666 . . S STACK=+A,STYP=$P(A,";",2),SGC=$P(A,";",3),AX=$P(A,";",4,999)105690 . ; 105667 105691 "RTN","C0CMAIL3",346,0) 105692 . ; A new SEGMENT separator is set, process original 105693 "RTN","C0CMAIL3",347,0) 105694 . I $D(BND1(X)) D QUIT 105695 "RTN","C0CMAIL3",348,0) 105696 . . ; Save Current Values 105697 "RTN","C0CMAIL3",349,0) 105698 . . S LST("SEG",SGC,"SIZE")=BCN+$L(BF) 105699 "RTN","C0CMAIL3",350,0) 105700 . . ; Close this Segment and prepare to start a New Segment 105701 "RTN","C0CMAIL3",351,0) 105702 . . S $P(LST("SEG",SGC),"^",1,2)=$P($G(LST("SEG",SGC)),"^",1)_"^"_(D1-1) 105703 "RTN","C0CMAIL3",352,0) 105704 . . ; Put the result in LST("SEG",SGC,"XML") 105705 "RTN","C0CMAIL3",353,0) 105706 . . I $L(BF) D 105707 "RTN","C0CMAIL3",354,0) 105708 . . . S ZN=1 105709 "RTN","C0CMAIL3",355,0) 105710 . . . N I,T,TBF 105711 "RTN","C0CMAIL3",356,0) 105712 . . . S TBF=BF 105713 "RTN","C0CMAIL3",357,0) 105714 . . . F I=1:1:($L(TBF,"=")) D 105715 "RTN","C0CMAIL3",358,0) 105716 . . . . S BF=$P(TBF,"=",I)_"=" 105717 "RTN","C0CMAIL3",359,0) 105718 . . . . I "="'[BF D DECODER(.BF,.TYP) 105719 "RTN","C0CMAIL3",360,0) 105720 . . . .QUIT 105721 "RTN","C0CMAIL3",361,0) 105722 . . . S BF="" 105723 "RTN","C0CMAIL3",362,0) 105724 . . .QUIT 105725 "RTN","C0CMAIL3",363,0) 105726 . . S SGC=SGC+1,BCN=0 105727 "RTN","C0CMAIL3",364,0) 105728 . . ; Incriment SGC to start a new Segment 105729 "RTN","C0CMAIL3",365,0) 105730 . . S LST("SEG",SGC)=D1 105731 "RTN","C0CMAIL3",366,0) 105668 105732 . .QUIT 105669 "RTN","C0CMAIL3",347,0) 105670 . ; Enter once to set the SEP to capture the separator 105671 "RTN","C0CMAIL3",348,0) 105733 "RTN","C0CMAIL3",367,0) 105672 105734 . ; 105673 "RTN","C0CMAIL3",349,0)105674 . ; A new SEGMENT separator is set, process original105675 "RTN","C0CMAIL3",350,0)105676 . I $D(BND1(X)) D QUIT105677 "RTN","C0CMAIL3",351,0)105678 . . ; Save Current Values105679 "RTN","C0CMAIL3",352,0)105680 . . S LST("SEG",SGC,"SIZE")=BCN+$L(BF)105681 "RTN","C0CMAIL3",353,0)105682 . . ; Close this Segment and prepare to start a New Segment105683 "RTN","C0CMAIL3",354,0)105684 . . S $P(LST("SEG",SGC),"^",1,2)=$P($G(LST("SEG",SGC)),"^",1)_"^"_(D1-1)105685 "RTN","C0CMAIL3",355,0)105686 . . ; Put the result in LST("SEG",SGC,"XML")105687 "RTN","C0CMAIL3",356,0)105688 . . I $L(BF) D105689 "RTN","C0CMAIL3",357,0)105690 . . . S ZN=1105691 "RTN","C0CMAIL3",358,0)105692 . . . N I,T,TBF105693 "RTN","C0CMAIL3",359,0)105694 . . . S TBF=BF105695 "RTN","C0CMAIL3",360,0)105696 . . . F I=1:1:($L(TBF,"=")) D105697 "RTN","C0CMAIL3",361,0)105698 . . . . S BF=$P(TBF,"=",I)_"="105699 "RTN","C0CMAIL3",362,0)105700 . . . . I "="'[BF D DECODER(.BF,.TYP)105701 "RTN","C0CMAIL3",363,0)105702 . . . .QUIT105703 "RTN","C0CMAIL3",364,0)105704 . . . S BF=""105705 "RTN","C0CMAIL3",365,0)105706 . . .QUIT105707 "RTN","C0CMAIL3",366,0)105708 . . S SGC=SGC+1,BCN=0105709 "RTN","C0CMAIL3",367,0)105710 . . ; Incriment SGC to start a new Segment105711 105735 "RTN","C0CMAIL3",368,0) 105712 . . S LST("SEG",SGC)=D1105736 . ; Accumulate the 64 bit encoding, no spaces, or other non-64bit characters 105713 105737 "RTN","C0CMAIL3",369,0) 105714 . .QUIT105738 . I X=$TR(X,MSK)&$L(X) S BF=BF_X QUIT 105715 105739 "RTN","C0CMAIL3",370,0) 105716 105740 . ; 105717 105741 "RTN","C0CMAIL3",371,0) 105718 . ; Accumulate the 64 bit encoding, no spaces, or other non-64bit characters105742 . ; Ending Condition, close out the Segment 105719 105743 "RTN","C0CMAIL3",372,0) 105720 . I X=$TR(X,MSK)&$L(X) S BF=BF_XQUIT105744 . I $D(BNDRZ(X)) D QUIT 105721 105745 "RTN","C0CMAIL3",373,0) 105746 . . S $P(LST("SEG",SGC),"^",2)=D1-1 105747 "RTN","C0CMAIL3",374,0) 105748 . . I $L(BF) S ZN=1 D DECODER(.BF,.TYP) S BF="" Q 105749 "RTN","C0CMAIL3",375,0) 105750 . .QUIT 105751 "RTN","C0CMAIL3",376,0) 105722 105752 . ; 105723 "RTN","C0CMAIL3",374,0)105724 . ; Ending Condition, close out the Segment105725 "RTN","C0CMAIL3",375,0)105726 . I $D(BNDRZ(X)) D QUIT105727 "RTN","C0CMAIL3",376,0)105728 . . S $P(LST("SEG",SGC),"^",2)=D1-1105729 105753 "RTN","C0CMAIL3",377,0) 105730 . . I $L(BF) S ZN=1 D DECODER(.BF,.TYP) S BF="" Q105754 . ; Accumulate the content lines of the message 105731 105755 "RTN","C0CMAIL3",378,0) 105756 . S BCN=BCN+$L(X) 105757 "RTN","C0CMAIL3",379,0) 105758 . ; Split out the Content Info 105759 "RTN","C0CMAIL3",380,0) 105760 . I X[CON D Q 105761 "RTN","C0CMAIL3",381,0) 105762 . . S J=$P(X,CON,2) 105763 "RTN","C0CMAIL3",382,0) 105764 . . S TYP="CONTENT" 105765 "RTN","C0CMAIL3",383,0) 105766 . . S LST("SEG",SGC,TYP,$P(J,":"))=$P(J,":",2,9) 105767 "RTN","C0CMAIL3",384,0) 105768 . . D CONTENT(D1) 105769 "RTN","C0CMAIL3",385,0) 105732 105770 . .QUIT 105733 "RTN","C0CMAIL3",3 79,0)105771 "RTN","C0CMAIL3",386,0) 105734 105772 . ; 105735 "RTN","C0CMAIL3",380,0)105736 . ; Accumulate the content lines of the message105737 "RTN","C0CMAIL3",381,0)105738 . S BCN=BCN+$L(X)105739 "RTN","C0CMAIL3",382,0)105740 . ; Split out the Content Info105741 "RTN","C0CMAIL3",383,0)105742 . I X[CON D Q105743 "RTN","C0CMAIL3",384,0)105744 . . S J=$P(X,CON,2)105745 "RTN","C0CMAIL3",385,0)105746 . . S TYP="CONTENT"105747 "RTN","C0CMAIL3",386,0)105748 . . S LST("SEG",SGC,TYP,$P(J,":"))=$P(J,":",2,9)105749 105773 "RTN","C0CMAIL3",387,0) 105750 . . D CONTENT(D1)105774 . ; Everything else is Text, Check for CCR/CCD. 105751 105775 "RTN","C0CMAIL3",388,0) 105776 . N KK,UBF 105777 "RTN","C0CMAIL3",389,0) 105778 . D 105779 "RTN","C0CMAIL3",390,0) 105780 . . S UBF=$$UPPER(X) 105781 "RTN","C0CMAIL3",391,0) 105782 . . I UBF["<CONTINUITYOFCARERECORD" S $P(LST("SEG",SGC),U,3)="CCR" Q 105783 "RTN","C0CMAIL3",392,0) 105784 . . ; 105785 "RTN","C0CMAIL3",393,0) 105786 . . I UBF["<CLINICALDOCUMENT" S $P(LST("SEG",SGC),U,3)="CCD" Q 105787 "RTN","C0CMAIL3",394,0) 105752 105788 . .QUIT 105753 "RTN","C0CMAIL3",389,0) 105789 "RTN","C0CMAIL3",395,0) 105790 . ; Look for directives in the text before it gets published 105791 "RTN","C0CMAIL3",396,0) 105792 . ; Look for "=3D" and replace it with a single "=". I can do more parsing 105793 "RTN","C0CMAIL3",397,0) 105794 . ; but there may be situations where the line has been wrapped. 105795 "RTN","C0CMAIL3",398,0) 105796 . D:X["=3D" 105797 "RTN","C0CMAIL3",399,0) 105798 . . F KK=1:1 S X=$P(X,"=3D",1)_"="_$P(X,"=3D",2,999) Q:X'["=3D" 105799 "RTN","C0CMAIL3",400,0) 105800 . .QUIT 105801 "RTN","C0CMAIL3",401,0) 105802 . S LST("SEG",SGC,TYP,D1)=X 105803 "RTN","C0CMAIL3",402,0) 105804 .QUIT 105805 "RTN","C0CMAIL3",403,0) 105806 QUIT 105807 "RTN","C0CMAIL3",404,0) 105808 ; =================== 105809 "RTN","C0CMAIL3",405,0) 105810 CONTENT(D1) ; Try pulling Content Statements 105811 "RTN","C0CMAIL3",406,0) 105812 N J,UP,X 105813 "RTN","C0CMAIL3",407,0) 105814 S X=$G(^XMB(3.9,D0,2,D1,0)) 105815 "RTN","C0CMAIL3",408,0) 105816 S J=$P(X,CON,2) 105817 "RTN","C0CMAIL3",409,0) 105818 S UP=$TR($$UPPER(X),"""") 105819 "RTN","C0CMAIL3",410,0) 105820 S:$G(TYP)="" TYP="TXT" 105821 "RTN","C0CMAIL3",411,0) 105822 D 105823 "RTN","C0CMAIL3",412,0) 105824 . I UP["NAME=",($L(UP,".")>1) S TYP=$P(UP,".",2) Q 105825 "RTN","C0CMAIL3",413,0) 105826 . I UP["XML" S TYP="XML" Q 105827 "RTN","C0CMAIL3",414,0) 105828 . I UP["P7S" S TYP="P7S" Q 105829 "RTN","C0CMAIL3",415,0) 105830 . I J[" boundary=" D BOUNDARY(J) 105831 "RTN","C0CMAIL3",416,0) 105832 .QUIT 105833 "RTN","C0CMAIL3",417,0) 105834 S LIS("CON",SGC,D1)=X 105835 "RTN","C0CMAIL3",418,0) 105836 S LIS("CON",SGC,D1,"TYP")=TYP 105837 "RTN","C0CMAIL3",419,0) 105838 ; If there is a follow-on, look for another line after this. 105839 "RTN","C0CMAIL3",420,0) 105840 I $E($RE(X),1)=";" D CONTENT(D1+1) 105841 "RTN","C0CMAIL3",421,0) 105842 QUIT 105843 "RTN","C0CMAIL3",422,0) 105844 ; =================== 105845 "RTN","C0CMAIL3",423,0) 105846 BOUNDARY(X) ; Set an additional BOUNDARY, and activate another stack level 105847 "RTN","C0CMAIL3",424,0) 105848 S SEP=$P($P(X," boundary=",2),"""",2),END=SEP_FLG 105849 "RTN","C0CMAIL3",425,0) 105850 Q:SEP?2"-".ANP 105851 "RTN","C0CMAIL3",426,0) 105852 ; 105853 "RTN","C0CMAIL3",427,0) 105854 D ERROR("ER11") 105855 "RTN","C0CMAIL3",428,0) 105856 Q:SEP'[" " 105857 "RTN","C0CMAIL3",429,0) 105858 ; 105859 "RTN","C0CMAIL3",430,0) 105860 D ERROR("ER12") 105861 "RTN","C0CMAIL3",431,0) 105862 QUIT 105863 "RTN","C0CMAIL3",432,0) 105864 ; =================== 105865 "RTN","C0CMAIL3",433,0) 105866 ; Break down the Buffer Array so it can be saved. 105867 "RTN","C0CMAIL3",434,0) 105868 ; BF is passed in. 105869 "RTN","C0CMAIL3",435,0) 105870 ; TYP is the type of 105871 "RTN","C0CMAIL3",436,0) 105872 DECODER(BF,TYP) ; 105873 "RTN","C0CMAIL3",437,0) 105874 N RCNT,TBF,UBF,ZBF,ZI,ZJ,ZK,ZSIZE 105875 "RTN","C0CMAIL3",438,0) 105876 S:$G(TYP)="" TYP="XML" 105877 "RTN","C0CMAIL3",439,0) 105878 S ZBF=BF 105879 "RTN","C0CMAIL3",440,0) 105880 ; Full Buffer, BF, now check for Encryption and Unpack 105881 "RTN","C0CMAIL3",441,0) 105882 F RCNT=1:1:$L(ZBF,"=") D 105883 "RTN","C0CMAIL3",442,0) 105884 . N BF 105885 "RTN","C0CMAIL3",443,0) 105886 . S BF=$P(ZBF,"=",RCNT) 105887 "RTN","C0CMAIL3",444,0) 105888 . ; Unpacking the 64 bit encoding 105889 "RTN","C0CMAIL3",445,0) 105890 . S TBF=$TR($$DECODE^RGUTUU(BF),$C(10,12,13)) 105891 "RTN","C0CMAIL3",446,0) 105892 . D:$L(TBF) 105893 "RTN","C0CMAIL3",447,0) 105894 . . N C,OK,OKCNT,KK,XBF,UBF 105895 "RTN","C0CMAIL3",448,0) 105896 . . D 105897 "RTN","C0CMAIL3",449,0) 105898 . . . S UBF=$$UPPER(TBF) 105899 "RTN","C0CMAIL3",450,0) 105900 . . . I UBF["<CONTINUITYOFCARERECORD XMLNS=" S $P(LST("SEG",SGC),U,3)="CCR" Q 105901 "RTN","C0CMAIL3",451,0) 105902 . . . ; 105903 "RTN","C0CMAIL3",452,0) 105904 . . . I UBF["<CLINICALDOCUMENT XMLNS=" S $P(LST("SEG",SGC),U,3)="CCD" Q 105905 "RTN","C0CMAIL3",453,0) 105906 . . .QUIT 105907 "RTN","C0CMAIL3",454,0) 105908 . . ; Check for Bad Signature Decoding, after 100 bad characters 105909 "RTN","C0CMAIL3",455,0) 105910 . . S OK=1,OKCNT=0 105911 "RTN","C0CMAIL3",456,0) 105912 . . F KK=1:1:$L(UBF) S C=$A(UBF,KK) S:C>126 OKCNT=OKCNT+1 I OKCNT>100 S OK=0 Q 105913 "RTN","C0CMAIL3",457,0) 105914 . . ; 105915 "RTN","C0CMAIL3",458,0) 105916 . . D 105917 "RTN","C0CMAIL3",459,0) 105918 . . . I 'OK S (BF,UBF,TBF,XBF)="<Crypto-Signature redacted>" Q 105919 "RTN","C0CMAIL3",460,0) 105920 . . . ; 105921 "RTN","C0CMAIL3",461,0) 105922 . . . S BF=BF_"=" 105923 "RTN","C0CMAIL3",462,0) 105924 . . . D NORMAL(.XBF,.TBF) 105925 "RTN","C0CMAIL3",463,0) 105926 . . .QUIT 105927 "RTN","C0CMAIL3",464,0) 105928 . . M LST("SEG",SGC,TYP,RCNT)=XBF 105929 "RTN","C0CMAIL3",465,0) 105930 . .QUIT 105931 "RTN","C0CMAIL3",466,0) 105932 .QUIT 105933 "RTN","C0CMAIL3",467,0) 105934 QUIT 105935 "RTN","C0CMAIL3",468,0) 105936 ; =================== 105937 "RTN","C0CMAIL3",469,0) 105938 ; OUTXML = OUTBF = OUT = OUTPUT ARRAY TO BE BUILT 105939 "RTN","C0CMAIL3",470,0) 105940 ; BF = INXML = INPUT ARRAY TO PROVIDE INPUT 105941 "RTN","C0CMAIL3",471,0) 105942 ; >D NORMAL^C0CMAIL(.OUT,BF) 105943 "RTN","C0CMAIL3",472,0) 105944 NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML 105945 "RTN","C0CMAIL3",473,0) 105946 ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME 105947 "RTN","C0CMAIL3",474,0) 105948 ; 105949 "RTN","C0CMAIL3",475,0) 105950 N ZN,OUTBF,XX,ZSEP 105951 "RTN","C0CMAIL3",476,0) 105952 S INXML=$TR(INXML,$C(10,12,13)) 105953 "RTN","C0CMAIL3",477,0) 105954 S ZN=1,ZSEP=">" 105955 "RTN","C0CMAIL3",478,0) 105956 S OUTBF(1)=$P(INXML,"><",1)_ZSEP,XX="<"_$P(INXML,"><",2)_ZSEP,ZN=2,ZL=1 105957 "RTN","C0CMAIL3",479,0) 105958 F ZN=ZN+1:1:$L(INXML,"><") D Q:XX="" 105959 "RTN","C0CMAIL3",480,0) 105960 . S XX=$P(INXML,"><",ZN) 105961 "RTN","C0CMAIL3",481,0) 105962 . S:$E($RE(XX))=">" ZSEP="" 105963 "RTN","C0CMAIL3",482,0) 105964 . Q:XX="" 105965 "RTN","C0CMAIL3",483,0) 105754 105966 . ; 105755 "RTN","C0CMAIL3",390,0) 105756 . ; Everything else is Text, Check for CCR/CCD. 105757 "RTN","C0CMAIL3",391,0) 105758 . N KK,UBF 105759 "RTN","C0CMAIL3",392,0) 105967 "RTN","C0CMAIL3",484,0) 105968 . S XX="<"_XX_ZSEP 105969 "RTN","C0CMAIL3",485,0) 105760 105970 . D 105761 "RTN","C0CMAIL3",393,0) 105762 . . S UBF=$$UPPER(X) 105763 "RTN","C0CMAIL3",394,0) 105764 . . I UBF["<CONTINUITYOFCARERECORD" S $P(LST("SEG",SGC),U,3)="CCR" Q 105765 "RTN","C0CMAIL3",395,0) 105971 "RTN","C0CMAIL3",486,0) 105972 . . I $L(XX)<4000 S OUTBF(ZL)=XX,XX=$P(INXML,"><",ZN),ZL=ZL+1 Q 105973 "RTN","C0CMAIL3",487,0) 105766 105974 . . ; 105767 "RTN","C0CMAIL3",396,0) 105768 . . I UBF["<CLINICALDOCUMENT" S $P(LST("SEG",SGC),U,3)="CCD" Q 105769 "RTN","C0CMAIL3",397,0) 105975 "RTN","C0CMAIL3",488,0) 105976 . . D ERROR("ER05") 105977 "RTN","C0CMAIL3",489,0) 105978 . . F ZL=ZL+1:1 D Q:XX="" 105979 "RTN","C0CMAIL3",490,0) 105980 . . . N XL 105981 "RTN","C0CMAIL3",491,0) 105982 . . . S XL=$E(XX,1,4000) 105983 "RTN","C0CMAIL3",492,0) 105984 . . . S $E(XX,1,4000)="" ; S XX=$E(XX,4001,999999) ; Remove 4K characters 105985 "RTN","C0CMAIL3",493,0) 105986 . . . S OUTBF(ZL)=XL 105987 "RTN","C0CMAIL3",494,0) 105988 . . .QUIT 105989 "RTN","C0CMAIL3",495,0) 105770 105990 . .QUIT 105771 "RTN","C0CMAIL3",398,0) 105772 . ; Look for directives in the text before it gets published 105773 "RTN","C0CMAIL3",399,0) 105774 . ; Look for "=3D" and replace it with a single "=". I can do more parsing 105775 "RTN","C0CMAIL3",400,0) 105776 . ; but there may be situations where the line has been wrapped. 105777 "RTN","C0CMAIL3",401,0) 105778 . D:X["=3D" 105779 "RTN","C0CMAIL3",402,0) 105780 . . F KK=1:1 S X=$P(X,"=3D",1)_"="_$P(X,"=3D",2,999) Q:X'["=3D" 105781 "RTN","C0CMAIL3",403,0) 105782 . .QUIT 105783 "RTN","C0CMAIL3",404,0) 105784 . S LST("SEG",SGC,TYP,D1)=X 105785 "RTN","C0CMAIL3",405,0) 105991 "RTN","C0CMAIL3",496,0) 105786 105992 .QUIT 105787 "RTN","C0CMAIL3",406,0) 105993 "RTN","C0CMAIL3",497,0) 105994 M OUTXML=OUTBF 105995 "RTN","C0CMAIL3",498,0) 105788 105996 QUIT 105789 "RTN","C0CMAIL3",4 07,0)105997 "RTN","C0CMAIL3",499,0) 105790 105998 ; =================== 105791 "RTN","C0CMAIL3",408,0)105792 CONTENT(D1) ; Try pulling Content Statements105793 "RTN","C0CMAIL3",409,0)105794 N J,UP,X105795 "RTN","C0CMAIL3",410,0)105796 S X=$G(^XMB(3.9,D0,2,D1,0))105797 "RTN","C0CMAIL3",411,0)105798 S J=$P(X,CON,2)105799 "RTN","C0CMAIL3",412,0)105800 S UP=$TR($$UPPER(X),"""")105801 "RTN","C0CMAIL3",413,0)105802 S:$G(TYP)="" TYP="TXT"105803 "RTN","C0CMAIL3",414,0)105804 D105805 "RTN","C0CMAIL3",415,0)105806 . I UP["NAME=",($L(UP,".")>1) S TYP=$P(UP,".",2) Q105807 "RTN","C0CMAIL3",416,0)105808 . I UP["XML" S TYP="XML" Q105809 "RTN","C0CMAIL3",417,0)105810 . I UP["P7S" S TYP="P7S" Q105811 "RTN","C0CMAIL3",418,0)105812 . I J[" boundary=" D BOUNDARY(J)105813 "RTN","C0CMAIL3",419,0)105814 .QUIT105815 "RTN","C0CMAIL3",420,0)105816 S LIS("CON",SGC,D1)=X105817 "RTN","C0CMAIL3",421,0)105818 S LIS("CON",SGC,D1,"TYP")=TYP105819 "RTN","C0CMAIL3",422,0)105820 ; If there is a follow-on, look for another line after this.105821 "RTN","C0CMAIL3",423,0)105822 I $E($RE(X),1)=";" D CONTENT(D1+1)105823 "RTN","C0CMAIL3",424,0)105824 QUIT105825 "RTN","C0CMAIL3",425,0)105826 ; ===================105827 "RTN","C0CMAIL3",426,0)105828 BOUNDARY(X) ; Set an additional BOUNDARY, and activate another stack level105829 "RTN","C0CMAIL3",427,0)105830 S SEP=$P($P(X," boundary=",2),"""",2),END=SEP_FLG105831 "RTN","C0CMAIL3",428,0)105832 Q:SEP?2"-".ANP105833 "RTN","C0CMAIL3",429,0)105834 ;105835 "RTN","C0CMAIL3",430,0)105836 D ERROR("ER11")105837 "RTN","C0CMAIL3",431,0)105838 Q:SEP'[" "105839 "RTN","C0CMAIL3",432,0)105840 ;105841 "RTN","C0CMAIL3",433,0)105842 D ERROR("ER12")105843 "RTN","C0CMAIL3",434,0)105844 QUIT105845 "RTN","C0CMAIL3",435,0)105846 ; ===================105847 "RTN","C0CMAIL3",436,0)105848 ; Break down the Buffer Array so it can be saved.105849 "RTN","C0CMAIL3",437,0)105850 ; BF is passed in.105851 "RTN","C0CMAIL3",438,0)105852 ; TYP is the type of105853 "RTN","C0CMAIL3",439,0)105854 DECODER(BF,TYP) ;105855 "RTN","C0CMAIL3",440,0)105856 N RCNT,TBF,UBF,ZBF,ZI,ZJ,ZK,ZSIZE105857 "RTN","C0CMAIL3",441,0)105858 S:$G(TYP)="" TYP="XML"105859 "RTN","C0CMAIL3",442,0)105860 S ZBF=BF105861 "RTN","C0CMAIL3",443,0)105862 ; Full Buffer, BF, now check for Encryption and Unpack105863 "RTN","C0CMAIL3",444,0)105864 F RCNT=1:1:$L(ZBF,"=") D105865 "RTN","C0CMAIL3",445,0)105866 . N BF105867 "RTN","C0CMAIL3",446,0)105868 . S BF=$P(ZBF,"=",RCNT)105869 "RTN","C0CMAIL3",447,0)105870 . ; Unpacking the 64 bit encoding105871 "RTN","C0CMAIL3",448,0)105872 . S TBF=$TR($$DECODE^RGUTUU(BF),$C(10,12,13))105873 "RTN","C0CMAIL3",449,0)105874 . D:$L(TBF)105875 "RTN","C0CMAIL3",450,0)105876 . . N C,OK,OKCNT,KK,XBF,UBF105877 "RTN","C0CMAIL3",451,0)105878 . . D105879 "RTN","C0CMAIL3",452,0)105880 . . . S UBF=$$UPPER(TBF)105881 "RTN","C0CMAIL3",453,0)105882 . . . I UBF["<CONTINUITYOFCARERECORD XMLNS=" S $P(LST("SEG",SGC),U,3)="CCR" Q105883 "RTN","C0CMAIL3",454,0)105884 . . . ;105885 "RTN","C0CMAIL3",455,0)105886 . . . I UBF["<CLINICALDOCUMENT XMLNS=" S $P(LST("SEG",SGC),U,3)="CCD" Q105887 "RTN","C0CMAIL3",456,0)105888 . . .QUIT105889 "RTN","C0CMAIL3",457,0)105890 . . ; Check for Bad Signature Decoding, after 100 bad characters105891 "RTN","C0CMAIL3",458,0)105892 . . S OK=1,OKCNT=0105893 "RTN","C0CMAIL3",459,0)105894 . . F KK=1:1:$L(UBF) S C=$A(UBF,KK) S:C>126 OKCNT=OKCNT+1 I OKCNT>100 S OK=0 Q105895 "RTN","C0CMAIL3",460,0)105896 . . ;105897 "RTN","C0CMAIL3",461,0)105898 . . D105899 "RTN","C0CMAIL3",462,0)105900 . . . I 'OK S (BF,UBF,TBF,XBF)="<Crypto-Signature redacted>" Q105901 "RTN","C0CMAIL3",463,0)105902 . . . ;105903 "RTN","C0CMAIL3",464,0)105904 . . . S BF=BF_"="105905 "RTN","C0CMAIL3",465,0)105906 . . . D NORMAL(.XBF,.TBF)105907 "RTN","C0CMAIL3",466,0)105908 . . .QUIT105909 "RTN","C0CMAIL3",467,0)105910 . . M LST("SEG",SGC,TYP,RCNT)=XBF105911 "RTN","C0CMAIL3",468,0)105912 . .QUIT105913 "RTN","C0CMAIL3",469,0)105914 .QUIT105915 "RTN","C0CMAIL3",470,0)105916 QUIT105917 "RTN","C0CMAIL3",471,0)105918 ; ===================105919 "RTN","C0CMAIL3",472,0)105920 ; OUTXML = OUTBF = OUT = OUTPUT ARRAY TO BE BUILT105921 "RTN","C0CMAIL3",473,0)105922 ; BF = INXML = INPUT ARRAY TO PROVIDE INPUT105923 "RTN","C0CMAIL3",474,0)105924 ; >D NORMAL^C0CMAIL(.OUT,BF)105925 "RTN","C0CMAIL3",475,0)105926 NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML105927 "RTN","C0CMAIL3",476,0)105928 ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME105929 "RTN","C0CMAIL3",477,0)105930 ;105931 "RTN","C0CMAIL3",478,0)105932 N ZN,OUTBF,XX,ZSEP105933 "RTN","C0CMAIL3",479,0)105934 S INXML=$TR(INXML,$C(10,12,13))105935 "RTN","C0CMAIL3",480,0)105936 S ZN=1,ZSEP=">"105937 "RTN","C0CMAIL3",481,0)105938 S OUTBF(1)=$P(INXML,"><",1)_ZSEP,XX="<"_$P(INXML,"><",2)_ZSEP,ZN=2,ZL=1105939 "RTN","C0CMAIL3",482,0)105940 F ZN=ZN+1:1:$L(INXML,"><") D Q:XX=""105941 "RTN","C0CMAIL3",483,0)105942 . S XX=$P(INXML,"><",ZN)105943 "RTN","C0CMAIL3",484,0)105944 . S:$E($RE(XX))=">" ZSEP=""105945 "RTN","C0CMAIL3",485,0)105946 . Q:XX=""105947 "RTN","C0CMAIL3",486,0)105948 . ;105949 "RTN","C0CMAIL3",487,0)105950 . S XX="<"_XX_ZSEP105951 "RTN","C0CMAIL3",488,0)105952 . D105953 "RTN","C0CMAIL3",489,0)105954 . . I $L(XX)<4000 S OUTBF(ZL)=XX,XX=$P(INXML,"><",ZN),ZL=ZL+1 Q105955 "RTN","C0CMAIL3",490,0)105956 . . ;105957 "RTN","C0CMAIL3",491,0)105958 . . D ERROR("ER05")105959 "RTN","C0CMAIL3",492,0)105960 . . F ZL=ZL+1:1 D Q:XX=""105961 "RTN","C0CMAIL3",493,0)105962 . . . N XL105963 "RTN","C0CMAIL3",494,0)105964 . . . S XL=$E(XX,1,4000)105965 "RTN","C0CMAIL3",495,0)105966 . . . S $E(XX,1,4000)="" ; S XX=$E(XX,4001,999999) ; Remove 4K characters105967 "RTN","C0CMAIL3",496,0)105968 . . . S OUTBF(ZL)=XL105969 "RTN","C0CMAIL3",497,0)105970 . . .QUIT105971 "RTN","C0CMAIL3",498,0)105972 . .QUIT105973 "RTN","C0CMAIL3",499,0)105974 .QUIT105975 105999 "RTN","C0CMAIL3",500,0) 105976 M OUTXML=OUTBF 106000 UPPER(X) ; Convert any lowercase letters to Uppercase letters 105977 106001 "RTN","C0CMAIL3",501,0) 105978 QUIT 106002 QUIT $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") 105979 106003 "RTN","C0CMAIL3",502,0) 105980 106004 ; =================== 105981 106005 "RTN","C0CMAIL3",503,0) 105982 UPPER(X) ; Convert any lowercase letters to Uppercase letters106006 ; EN is a counter that remains between error events 105983 106007 "RTN","C0CMAIL3",504,0) 105984 QUIT $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") 106008 ERROR(ER) ; Error Handler 105985 106009 "RTN","C0CMAIL3",505,0) 106010 N TXXQ,XXXQ 106011 "RTN","C0CMAIL3",506,0) 106012 S XXXQ="Unknown Error Encountered = "_ER 106013 "RTN","C0CMAIL3",507,0) 106014 S TXXQ=$P($T(@(ER_"^"_$T(+0))),";;",2,99) 106015 "RTN","C0CMAIL3",508,0) 106016 I TXXQ'="" D 106017 "RTN","C0CMAIL3",509,0) 106018 . I TXXQ["_" X "S TXXQ="_TXXQ 106019 "RTN","C0CMAIL3",510,0) 106020 . S XXXQ=TXXQ 106021 "RTN","C0CMAIL3",511,0) 106022 .QUIT 106023 "RTN","C0CMAIL3",512,0) 106024 S EN(ER)=$G(EN(ER))+1 106025 "RTN","C0CMAIL3",513,0) 106026 S LST("ERR",ER,EN(ER))=XXXQ 106027 "RTN","C0CMAIL3",514,0) 106028 QUIT 106029 "RTN","C0CMAIL3",515,0) 105986 106030 ; =================== 105987 "RTN","C0CMAIL3",506,0)105988 ; EN is a counter that remains between error events105989 "RTN","C0CMAIL3",507,0)105990 ERROR(ER) ; Error Handler105991 "RTN","C0CMAIL3",508,0)105992 N TXXQ,XXXQ105993 "RTN","C0CMAIL3",509,0)105994 S XXXQ="Unknown Error Encountered = "_ER105995 "RTN","C0CMAIL3",510,0)105996 S TXXQ=$P($T(@(ER_"^"_$T(+0))),";;",2,99)105997 "RTN","C0CMAIL3",511,0)105998 I TXXQ'="" D105999 "RTN","C0CMAIL3",512,0)106000 . I TXXQ["_" X "S TXXQ="_TXXQ106001 "RTN","C0CMAIL3",513,0)106002 . S XXXQ=TXXQ106003 "RTN","C0CMAIL3",514,0)106004 .QUIT106005 "RTN","C0CMAIL3",515,0)106006 S EN(ER)=$G(EN(ER))+1106007 106031 "RTN","C0CMAIL3",516,0) 106008 S LST("ERR",ER,EN(ER))=XXXQ 106032 ER01 ;;Message Missing 106009 106033 "RTN","C0CMAIL3",517,0) 106034 ER02 ;;Message Text Missing 106035 "RTN","C0CMAIL3",518,0) 106036 ER03 ;;Message Not Identifiable 106037 "RTN","C0CMAIL3",519,0) 106038 ER04 ;;Segment is too large 106039 "RTN","C0CMAIL3",520,0) 106040 ER05 ;;Mailbox Missing 106041 "RTN","C0CMAIL3",521,0) 106042 ER06 ;;"User Missing = "_$G(DUZ) 106043 "RTN","C0CMAIL3",522,0) 106044 ER07 ;;"Bad DUZ = "_DUZ 106045 "RTN","C0CMAIL3",523,0) 106046 ER08 ;;"Bad Basket ID = "_MBLST_" >> "_$G(TN) 106047 "RTN","C0CMAIL3",524,0) 106048 ER10 ;;"Bad Separator found = "_X 106049 "RTN","C0CMAIL3",525,0) 106050 ER11 ;;"Non-Standard Separator Found:>"_$G(J) 106051 "RTN","C0CMAIL3",526,0) 106052 ER12 ;;"Spaces are not allowed in Separators:>"_$G(J) 106053 "RTN","C0CMAIL3",527,0) 106054 ER13 ;;"Bad Stack Level Detected >"_STKL_":"_BNDRY(X)_":"_X 106055 "RTN","C0CMAIL3",528,0) 106056 ; vvvvvvvvvvvvvvv Not Needed vvvvvvvvvvvvvvvvvvvvvvvvvv 106057 "RTN","C0CMAIL3",529,0) 106058 ; End note if needed 106059 "RTN","C0CMAIL3",530,0) 106010 106060 QUIT 106011 "RTN","C0CMAIL3",518,0)106012 ; ===================106013 "RTN","C0CMAIL3",519,0)106014 ER01 ;;Message Missing106015 "RTN","C0CMAIL3",520,0)106016 ER02 ;;Message Text Missing106017 "RTN","C0CMAIL3",521,0)106018 ER03 ;;Message Not Identifiable106019 "RTN","C0CMAIL3",522,0)106020 ER04 ;;Segment is too large106021 "RTN","C0CMAIL3",523,0)106022 ER05 ;;Mailbox Missing106023 "RTN","C0CMAIL3",524,0)106024 ER06 ;;"User Missing = "_$G(DUZ)106025 "RTN","C0CMAIL3",525,0)106026 ER07 ;;"Bad DUZ = "_DUZ106027 "RTN","C0CMAIL3",526,0)106028 ER08 ;;"Bad Basket ID = "_MBLST_" >> "_$G(TN)106029 "RTN","C0CMAIL3",527,0)106030 ER10 ;;"Bad Separator found = "_X106031 "RTN","C0CMAIL3",528,0)106032 ER11 ;;"Non-Standard Separator Found:>"_$G(J)106033 "RTN","C0CMAIL3",529,0)106034 ER12 ;;"Spaces are not allowed in Separators:>"_$G(J)106035 "RTN","C0CMAIL3",530,0)106036 ER13 ;;"Bad Stack Level Detected >"_STKL_":"_BNDRY(X)_":"_X106037 106061 "RTN","C0CMAIL3",531,0) 106038 ; vvvvvvvvvvvvvvv Not Needed vvvvvvvvvvvvvvvvvvvvvvvvvv106039 "RTN","C0CMAIL3",532,0)106040 ; End note if needed106041 "RTN","C0CMAIL3",533,0)106042 QUIT106043 "RTN","C0CMAIL3",534,0)106044 106062 ; =================== 106045 106063 "RTN","C0CMCCD") 106046 0^84^B7 3168233106064 0^84^B71988241 106047 106065 "RTN","C0CMCCD",1,0) 106048 106066 C0CMCCD ; GPL - MXML based CCD utilities;12/04/09 17:05 106049 106067 "RTN","C0CMCCD",2,0) 106050 ;;1.2;C 0C;;May 11, 2012;Build 50106068 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 106051 106069 "RTN","C0CMCCD",3,0) 106052 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU106070 ;Copyright 2009 George Lilly. 106053 106071 "RTN","C0CMCCD",4,0) 106054 ; General Public License See attached copy of the License.106072 ; 106055 106073 "RTN","C0CMCCD",5,0) 106056 ; 106074 ; This program is free software: you can redistribute it and/or modify 106057 106075 "RTN","C0CMCCD",6,0) 106058 ; This program is free software; you can redistribute it and/or modify106076 ; it under the terms of the GNU Affero General Public License as 106059 106077 "RTN","C0CMCCD",7,0) 106060 ; it under the terms of the GNU General Public License as published by106078 ; published by the Free Software Foundation, either version 3 of the 106061 106079 "RTN","C0CMCCD",8,0) 106062 ; the Free Software Foundation; either version 2 of the License, or106080 ; License, or (at your option) any later version. 106063 106081 "RTN","C0CMCCD",9,0) 106064 ; (at your option) any later version.106082 ; 106065 106083 "RTN","C0CMCCD",10,0) 106066 ; 106084 ; This program is distributed in the hope that it will be useful, 106067 106085 "RTN","C0CMCCD",11,0) 106068 ; This program is distributed in the hope that it will be useful,106086 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 106069 106087 "RTN","C0CMCCD",12,0) 106070 ; but WITHOUT ANY WARRANTY; without even the implied warranty of106088 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 106071 106089 "RTN","C0CMCCD",13,0) 106072 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the106090 ; GNU Affero General Public License for more details. 106073 106091 "RTN","C0CMCCD",14,0) 106074 ; GNU General Public License for more details.106092 ; 106075 106093 "RTN","C0CMCCD",15,0) 106076 ; 106094 ; You should have received a copy of the GNU Affero General Public License 106077 106095 "RTN","C0CMCCD",16,0) 106078 ; You should have received a copy of the GNU General Public License along106096 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 106079 106097 "RTN","C0CMCCD",17,0) 106080 ; with this program; if not, write to the Free Software Foundation, Inc.,106098 ; 106081 106099 "RTN","C0CMCCD",18,0) 106082 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.106100 Q 106083 106101 "RTN","C0CMCCD",19,0) 106084 106102 ; 106085 106103 "RTN","C0CMCCD",20,0) 106104 PARSCCD(DOC,OPTION) ; THIS WAS COPIED FROM EN^MXMLDOM TO CUSTIMIZE FOR 106105 "RTN","C0CMCCD",21,0) 106106 ; PROCESSING CCDS 106107 "RTN","C0CMCCD",22,0) 106108 N CBK,SUCCESS,LEVEL,NODE,HANDLE 106109 "RTN","C0CMCCD",23,0) 106110 K ^TMP("MXMLERR",$J) 106111 "RTN","C0CMCCD",24,0) 106112 L +^TMP("MXMLDOM",$J):5 106113 "RTN","C0CMCCD",25,0) 106114 E Q 0 106115 "RTN","C0CMCCD",26,0) 106116 S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)="" 106117 "RTN","C0CMCCD",27,0) 106118 L -^TMP("MXMLDOM",$J) 106119 "RTN","C0CMCCD",28,0) 106120 S CBK("STARTELEMENT")="STARTELE^C0CMCCD" ; ONLY THIS ONE IS CHANGED ;GPL 106121 "RTN","C0CMCCD",29,0) 106122 S CBK("ENDELEMENT")="ENDELE^MXMLDOM" 106123 "RTN","C0CMCCD",30,0) 106124 S CBK("COMMENT")="COMMENT^MXMLDOM" 106125 "RTN","C0CMCCD",31,0) 106126 S CBK("CHARACTERS")="CHAR^MXMLDOM" 106127 "RTN","C0CMCCD",32,0) 106128 S CBK("ENDDOCUMENT")="ENDDOC^MXMLDOM" 106129 "RTN","C0CMCCD",33,0) 106130 S CBK("ERROR")="ERROR^MXMLDOM" 106131 "RTN","C0CMCCD",34,0) 106132 S (SUCCESS,LEVEL,LEVEL(0),NODE)=0,OPTION=$G(OPTION,"V1") 106133 "RTN","C0CMCCD",35,0) 106134 D EN^MXMLPRSE(DOC,.CBK,OPTION) 106135 "RTN","C0CMCCD",36,0) 106136 D:'SUCCESS DELETE^MXMLDOM(HANDLE) 106137 "RTN","C0CMCCD",37,0) 106138 Q $S(SUCCESS:HANDLE,1:0) 106139 "RTN","C0CMCCD",38,0) 106140 ; Start element 106141 "RTN","C0CMCCD",39,0) 106142 ; Create new child node and push info on stack 106143 "RTN","C0CMCCD",40,0) 106144 STARTELE(ELE,ATTR) ; COPIED FROM STARTELE^MXMLDOM AND MODIFIED TO TREAT 106145 "RTN","C0CMCCD",41,0) 106146 ; ATTRIBUTES AS SUBELEMENTS TO MAKE CCD XPATH PROCESSING EASIER 106147 "RTN","C0CMCCD",42,0) 106148 N PARENT 106149 "RTN","C0CMCCD",43,0) 106150 S PARENT=LEVEL(LEVEL),NODE=NODE+1 106151 "RTN","C0CMCCD",44,0) 106152 S:PARENT ^TMP("MXMLDOM",$J,HANDLE,PARENT,"C",NODE)=ELE 106153 "RTN","C0CMCCD",45,0) 106154 S LEVEL=LEVEL+1,LEVEL(LEVEL)=NODE,LEVEL(LEVEL,0)=ELE 106155 "RTN","C0CMCCD",46,0) 106156 S ^TMP("MXMLDOM",$J,HANDLE,NODE)=ELE,^(NODE,"P")=PARENT 106157 "RTN","C0CMCCD",47,0) 106158 ;M ^("A")=ATTR 106159 "RTN","C0CMCCD",48,0) 106160 N ZI S ZI="" ; INDEX FOR ATTR 106161 "RTN","C0CMCCD",49,0) 106162 F S ZI=$O(ATTR(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE 106163 "RTN","C0CMCCD",50,0) 106164 . N ELE,TXT ; ABOUT TO RECURSE 106165 "RTN","C0CMCCD",51,0) 106166 . S ELE=ZI ; TAG 106167 "RTN","C0CMCCD",52,0) 106168 . S TXT=ATTR(ZI) ; DATA 106169 "RTN","C0CMCCD",53,0) 106170 . D STARTELE(ELE,"") ; CREATE A NEW SUBNODE 106171 "RTN","C0CMCCD",54,0) 106172 . D TXT^MXMLDOM("T") ; INSERT DATA TO TAG 106173 "RTN","C0CMCCD",55,0) 106174 . D ENDELE^MXMLDOM(ELE) ; POP BACK UP A LEVEL 106175 "RTN","C0CMCCD",56,0) 106086 106176 Q 106087 "RTN","C0CMCCD",21,0)106088 ;106089 "RTN","C0CMCCD",22,0)106090 PARSCCD(DOC,OPTION) ; THIS WAS COPIED FROM EN^MXMLDOM TO CUSTIMIZE FOR106091 "RTN","C0CMCCD",23,0)106092 ; PROCESSING CCDS106093 "RTN","C0CMCCD",24,0)106094 N CBK,SUCCESS,LEVEL,NODE,HANDLE106095 "RTN","C0CMCCD",25,0)106096 K ^TMP("MXMLERR",$J)106097 "RTN","C0CMCCD",26,0)106098 L +^TMP("MXMLDOM",$J):5106099 "RTN","C0CMCCD",27,0)106100 E Q 0106101 "RTN","C0CMCCD",28,0)106102 S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)=""106103 "RTN","C0CMCCD",29,0)106104 L -^TMP("MXMLDOM",$J)106105 "RTN","C0CMCCD",30,0)106106 S CBK("STARTELEMENT")="STARTELE^C0CMCCD" ; ONLY THIS ONE IS CHANGED ;GPL106107 "RTN","C0CMCCD",31,0)106108 S CBK("ENDELEMENT")="ENDELE^MXMLDOM"106109 "RTN","C0CMCCD",32,0)106110 S CBK("COMMENT")="COMMENT^MXMLDOM"106111 "RTN","C0CMCCD",33,0)106112 S CBK("CHARACTERS")="CHAR^MXMLDOM"106113 "RTN","C0CMCCD",34,0)106114 S CBK("ENDDOCUMENT")="ENDDOC^MXMLDOM"106115 "RTN","C0CMCCD",35,0)106116 S CBK("ERROR")="ERROR^MXMLDOM"106117 "RTN","C0CMCCD",36,0)106118 S (SUCCESS,LEVEL,LEVEL(0),NODE)=0,OPTION=$G(OPTION,"V1")106119 "RTN","C0CMCCD",37,0)106120 D EN^MXMLPRSE(DOC,.CBK,OPTION)106121 "RTN","C0CMCCD",38,0)106122 D:'SUCCESS DELETE^MXMLDOM(HANDLE)106123 "RTN","C0CMCCD",39,0)106124 Q $S(SUCCESS:HANDLE,1:0)106125 "RTN","C0CMCCD",40,0)106126 ; Start element106127 "RTN","C0CMCCD",41,0)106128 ; Create new child node and push info on stack106129 "RTN","C0CMCCD",42,0)106130 STARTELE(ELE,ATTR) ; COPIED FROM STARTELE^MXMLDOM AND MODIFIED TO TREAT106131 "RTN","C0CMCCD",43,0)106132 ; ATTRIBUTES AS SUBELEMENTS TO MAKE CCD XPATH PROCESSING EASIER106133 "RTN","C0CMCCD",44,0)106134 N PARENT106135 "RTN","C0CMCCD",45,0)106136 S PARENT=LEVEL(LEVEL),NODE=NODE+1106137 "RTN","C0CMCCD",46,0)106138 S:PARENT ^TMP("MXMLDOM",$J,HANDLE,PARENT,"C",NODE)=ELE106139 "RTN","C0CMCCD",47,0)106140 S LEVEL=LEVEL+1,LEVEL(LEVEL)=NODE,LEVEL(LEVEL,0)=ELE106141 "RTN","C0CMCCD",48,0)106142 S ^TMP("MXMLDOM",$J,HANDLE,NODE)=ELE,^(NODE,"P")=PARENT106143 "RTN","C0CMCCD",49,0)106144 ;M ^("A")=ATTR106145 "RTN","C0CMCCD",50,0)106146 N ZI S ZI="" ; INDEX FOR ATTR106147 "RTN","C0CMCCD",51,0)106148 F S ZI=$O(ATTR(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE106149 "RTN","C0CMCCD",52,0)106150 . N ELE,TXT ; ABOUT TO RECURSE106151 "RTN","C0CMCCD",53,0)106152 . S ELE=ZI ; TAG106153 "RTN","C0CMCCD",54,0)106154 . S TXT=ATTR(ZI) ; DATA106155 "RTN","C0CMCCD",55,0)106156 . D STARTELE(ELE,"") ; CREATE A NEW SUBNODE106157 "RTN","C0CMCCD",56,0)106158 . D TXT^MXMLDOM("T") ; INSERT DATA TO TAG106159 106177 "RTN","C0CMCCD",57,0) 106160 . D ENDELE^MXMLDOM(ELE) ; POP BACK UP A LEVEL106178 ; 106161 106179 "RTN","C0CMCCD",58,0) 106180 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE 106181 "RTN","C0CMCCD",59,0) 106182 N ZN 106183 "RTN","C0CMCCD",60,0) 106184 ;I $$TAG(ZOID)["entry" B 106185 "RTN","C0CMCCD",61,0) 106186 S ZN=$$NXTSIB(ZOID) 106187 "RTN","C0CMCCD",62,0) 106188 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG 106189 "RTN","C0CMCCD",63,0) 106190 Q 0 106191 "RTN","C0CMCCD",64,0) 106192 ; 106193 "RTN","C0CMCCD",65,0) 106194 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID 106195 "RTN","C0CMCCD",66,0) 106196 Q $$CHILD^MXMLDOM(C0CDOCID,ZOID) 106197 "RTN","C0CMCCD",67,0) 106198 ; 106199 "RTN","C0CMCCD",68,0) 106200 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID 106201 "RTN","C0CMCCD",69,0) 106202 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID) 106203 "RTN","C0CMCCD",70,0) 106204 ; 106205 "RTN","C0CMCCD",71,0) 106206 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID 106207 "RTN","C0CMCCD",72,0) 106208 S HANDLE=C0CDOCID 106209 "RTN","C0CMCCD",73,0) 106210 K @RTN 106211 "RTN","C0CMCCD",74,0) 106212 D GETTXT^MXMLDOM("A") 106213 "RTN","C0CMCCD",75,0) 106162 106214 Q 106163 "RTN","C0CMCCD",59,0)106164 ;106165 "RTN","C0CMCCD",60,0)106166 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE106167 "RTN","C0CMCCD",61,0)106168 N ZN106169 "RTN","C0CMCCD",62,0)106170 ;I $$TAG(ZOID)["entry" B106171 "RTN","C0CMCCD",63,0)106172 S ZN=$$NXTSIB(ZOID)106173 "RTN","C0CMCCD",64,0)106174 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG106175 "RTN","C0CMCCD",65,0)106176 Q 0106177 "RTN","C0CMCCD",66,0)106178 ;106179 "RTN","C0CMCCD",67,0)106180 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID106181 "RTN","C0CMCCD",68,0)106182 Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)106183 "RTN","C0CMCCD",69,0)106184 ;106185 "RTN","C0CMCCD",70,0)106186 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID106187 "RTN","C0CMCCD",71,0)106188 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)106189 "RTN","C0CMCCD",72,0)106190 ;106191 "RTN","C0CMCCD",73,0)106192 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID106193 "RTN","C0CMCCD",74,0)106194 S HANDLE=C0CDOCID106195 "RTN","C0CMCCD",75,0)106196 K @RTN106197 106215 "RTN","C0CMCCD",76,0) 106198 D GETTXT^MXMLDOM("A")106216 ; 106199 106217 "RTN","C0CMCCD",77,0) 106218 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE 106219 "RTN","C0CMCCD",78,0) 106220 ;I ZOID=149 B ;GPLTEST 106221 "RTN","C0CMCCD",79,0) 106222 N X,Y 106223 "RTN","C0CMCCD",80,0) 106224 S Y="" 106225 "RTN","C0CMCCD",81,0) 106226 S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE 106227 "RTN","C0CMCCD",82,0) 106228 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y 106229 "RTN","C0CMCCD",83,0) 106230 I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID) 106231 "RTN","C0CMCCD",84,0) 106232 Q Y 106233 "RTN","C0CMCCD",85,0) 106234 ; 106235 "RTN","C0CMCCD",86,0) 106236 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING 106237 "RTN","C0CMCCD",87,0) 106238 Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID) 106239 "RTN","C0CMCCD",88,0) 106240 ; 106241 "RTN","C0CMCCD",89,0) 106242 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE 106243 "RTN","C0CMCCD",90,0) 106244 ;N ZT,ZN S ZT="" 106245 "RTN","C0CMCCD",91,0) 106246 ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 106247 "RTN","C0CMCCD",92,0) 106248 ;Q $G(@C0CDOM@(ZOID,"T",1)) 106249 "RTN","C0CMCCD",93,0) 106250 S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT) 106251 "RTN","C0CMCCD",94,0) 106200 106252 Q 106201 "RTN","C0CMCCD",78,0)106202 ;106203 "RTN","C0CMCCD",79,0)106204 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE106205 "RTN","C0CMCCD",80,0)106206 ;I ZOID=149 B ;GPLTEST106207 "RTN","C0CMCCD",81,0)106208 N X,Y106209 "RTN","C0CMCCD",82,0)106210 S Y=""106211 "RTN","C0CMCCD",83,0)106212 S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE106213 "RTN","C0CMCCD",84,0)106214 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y106215 "RTN","C0CMCCD",85,0)106216 I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)106217 "RTN","C0CMCCD",86,0)106218 Q Y106219 "RTN","C0CMCCD",87,0)106220 ;106221 "RTN","C0CMCCD",88,0)106222 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING106223 "RTN","C0CMCCD",89,0)106224 Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)106225 "RTN","C0CMCCD",90,0)106226 ;106227 "RTN","C0CMCCD",91,0)106228 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE106229 "RTN","C0CMCCD",92,0)106230 ;N ZT,ZN S ZT=""106231 "RTN","C0CMCCD",93,0)106232 ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))106233 "RTN","C0CMCCD",94,0)106234 ;Q $G(@C0CDOM@(ZOID,"T",1))106235 106253 "RTN","C0CMCCD",95,0) 106236 S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)106254 ; 106237 106255 "RTN","C0CMCCD",96,0) 106256 CLEANARY(OUTARY,INARY) ; GOES THROUGH AN ARRAY AND CALLS CLEAN ON EACH NODE 106257 "RTN","C0CMCCD",97,0) 106258 ; INARY AND OUTARY PASSED BY NAME 106259 "RTN","C0CMCCD",98,0) 106260 N ZI S ZI="" 106261 "RTN","C0CMCCD",99,0) 106262 F S ZI=$O(@INARY@(ZI)) Q:ZI="" D ; FOR EACH NODE 106263 "RTN","C0CMCCD",100,0) 106264 . S @OUTARY@(ZI)=$$CLEAN(@INARY@(ZI)) ; CLEAN THE NODE 106265 "RTN","C0CMCCD",101,0) 106238 106266 Q 106239 "RTN","C0CMCCD",97,0)106240 ;106241 "RTN","C0CMCCD",98,0)106242 CLEANARY(OUTARY,INARY) ; GOES THROUGH AN ARRAY AND CALLS CLEAN ON EACH NODE106243 "RTN","C0CMCCD",99,0)106244 ; INARY AND OUTARY PASSED BY NAME106245 "RTN","C0CMCCD",100,0)106246 N ZI S ZI=""106247 "RTN","C0CMCCD",101,0)106248 F S ZI=$O(@INARY@(ZI)) Q:ZI="" D ; FOR EACH NODE106249 106267 "RTN","C0CMCCD",102,0) 106250 . S @OUTARY@(ZI)=$$CLEAN(@INARY@(ZI)) ; CLEAN THE NODE106268 ; 106251 106269 "RTN","C0CMCCD",103,0) 106270 CLEAN(STR) ; extrinsic function; returns string 106271 "RTN","C0CMCCD",104,0) 106272 ;; Removes all non printable characters from a string. 106273 "RTN","C0CMCCD",105,0) 106274 ;; STR by Value 106275 "RTN","C0CMCCD",106,0) 106276 N TR,I 106277 "RTN","C0CMCCD",107,0) 106278 F I=0:1:31 S TR=$G(TR)_$C(I) 106279 "RTN","C0CMCCD",108,0) 106280 S TR=TR_$C(127) 106281 "RTN","C0CMCCD",109,0) 106282 QUIT $TR(STR,TR) 106283 "RTN","C0CMCCD",110,0) 106284 ; 106285 "RTN","C0CMCCD",111,0) 106286 STRIPTXT(OUTARY,ZARY) ; STRIPS THE "TEXT" PORTION OUT OF AN XML FILE 106287 "RTN","C0CMCCD",112,0) 106288 ; THIS IS USED TO DELETE THE NARATIVE HTML OUT OF THE CCD XML FILES BECAUSE 106289 "RTN","C0CMCCD",113,0) 106290 ; THEY DO NOT WORK RIGHT WITH THE PARSER 106291 "RTN","C0CMCCD",114,0) 106292 ;N ZWRK,ZBLD,ZI ; WORK ARRAY,BUILD ARRAY, AND COUNTER 106293 "RTN","C0CMCCD",115,0) 106294 S ZI=$O(@ZARY@("")) ; GET FIRST LINE NUMBER 106295 "RTN","C0CMCCD",116,0) 106296 D C0CBEGIN("ZWRK",ZI) ; INSERT FIRST LINE IN WORK ARRAY 106297 "RTN","C0CMCCD",117,0) 106298 F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH LINE OF THE ARRAY 106299 "RTN","C0CMCCD",118,0) 106300 . I $O(@ZARY@(ZI))="" D Q ; AT THE END 106301 "RTN","C0CMCCD",119,0) 106302 . . D C0CEND("ZWRK",ZI) ; INCLUDE LAST LINE IN WORK ARRAY 106303 "RTN","C0CMCCD",120,0) 106304 . I ZI=1 D C0CBEGIN("ZWRK",ZI) ; START WITH FIRST LINE 106305 "RTN","C0CMCCD",121,0) 106306 . I @ZARY@(ZI)["<text" D C0CEND("ZWRK",ZI-1) ;PREV LINE IS AN END 106307 "RTN","C0CMCCD",122,0) 106308 . I @ZARY@(ZI)["</text>" D C0CBEGIN("ZWRK",ZI+1) ;NEXT LINE IS A BEGIN 106309 "RTN","C0CMCCD",123,0) 106310 S ZI="" 106311 "RTN","C0CMCCD",124,0) 106312 F S ZI=$O(ZWRK(ZI)) Q:ZI="" D ; MAKE A BUILD LIST FROM THE WORK ARRAY 106313 "RTN","C0CMCCD",125,0) 106314 . D QUEUE^C0CXPATH("ZBLD",ZARY,$P(ZWRK(ZI),"^",1),$P(ZWRK(ZI),"^",2)) 106315 "RTN","C0CMCCD",126,0) 106316 D BUILD^C0CXPATH("ZBLD",OUTARY) ; BUILD NEW ARRAY WITHOUT TEXT SECTIONS 106317 "RTN","C0CMCCD",127,0) 106318 K @OUTARY@(0) ; GET RID OF THE LINE COUNT 106319 "RTN","C0CMCCD",128,0) 106252 106320 Q 106253 "RTN","C0CMCCD",104,0) 106254 ; 106255 "RTN","C0CMCCD",105,0) 106256 CLEAN(STR) ; extrinsic function; returns string 106257 "RTN","C0CMCCD",106,0) 106258 ;; Removes all non printable characters from a string. 106259 "RTN","C0CMCCD",107,0) 106260 ;; STR by Value 106261 "RTN","C0CMCCD",108,0) 106262 N TR,I 106263 "RTN","C0CMCCD",109,0) 106264 F I=0:1:31 S TR=$G(TR)_$C(I) 106265 "RTN","C0CMCCD",110,0) 106266 S TR=TR_$C(127) 106267 "RTN","C0CMCCD",111,0) 106268 QUIT $TR(STR,TR) 106269 "RTN","C0CMCCD",112,0) 106270 ; 106271 "RTN","C0CMCCD",113,0) 106272 STRIPTXT(OUTARY,ZARY) ; STRIPS THE "TEXT" PORTION OUT OF AN XML FILE 106273 "RTN","C0CMCCD",114,0) 106274 ; THIS IS USED TO DELETE THE NARATIVE HTML OUT OF THE CCD XML FILES BECAUSE 106275 "RTN","C0CMCCD",115,0) 106276 ; THEY DO NOT WORK RIGHT WITH THE PARSER 106277 "RTN","C0CMCCD",116,0) 106278 ;N ZWRK,ZBLD,ZI ; WORK ARRAY,BUILD ARRAY, AND COUNTER 106279 "RTN","C0CMCCD",117,0) 106280 S ZI=$O(@ZARY@("")) ; GET FIRST LINE NUMBER 106281 "RTN","C0CMCCD",118,0) 106282 D C0CBEGIN("ZWRK",ZI) ; INSERT FIRST LINE IN WORK ARRAY 106283 "RTN","C0CMCCD",119,0) 106284 F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH LINE OF THE ARRAY 106285 "RTN","C0CMCCD",120,0) 106286 . I $O(@ZARY@(ZI))="" D Q ; AT THE END 106287 "RTN","C0CMCCD",121,0) 106288 . . D C0CEND("ZWRK",ZI) ; INCLUDE LAST LINE IN WORK ARRAY 106289 "RTN","C0CMCCD",122,0) 106290 . I ZI=1 D C0CBEGIN("ZWRK",ZI) ; START WITH FIRST LINE 106291 "RTN","C0CMCCD",123,0) 106292 . I @ZARY@(ZI)["<text" D C0CEND("ZWRK",ZI-1) ;PREV LINE IS AN END 106293 "RTN","C0CMCCD",124,0) 106294 . I @ZARY@(ZI)["</text>" D C0CBEGIN("ZWRK",ZI+1) ;NEXT LINE IS A BEGIN 106295 "RTN","C0CMCCD",125,0) 106321 "RTN","C0CMCCD",129,0) 106322 ; 106323 "RTN","C0CMCCD",130,0) 106324 C0CBEGIN(ZA,LN) ; INSERTS A BEGIN LINE LN INTO ARRAY ZWRK, PASSED BY NAME 106325 "RTN","C0CMCCD",131,0) 106326 N ZI 106327 "RTN","C0CMCCD",132,0) 106328 S ZI=$O(@ZA@(""),-1) 106329 "RTN","C0CMCCD",133,0) 106330 I ZI="" S ZI=1 106331 "RTN","C0CMCCD",134,0) 106332 E S ZI=ZI+1 ; INCREMENT COUNT IN WORK ARRAY 106333 "RTN","C0CMCCD",135,0) 106334 S $P(@ZA@(ZI),"^",1)=LN 106335 "RTN","C0CMCCD",136,0) 106336 Q 106337 "RTN","C0CMCCD",137,0) 106338 ; 106339 "RTN","C0CMCCD",138,0) 106340 C0CEND(ZB,LN) ; INSERTS AN END LINE LN INTO ARRAY ZWRK, PASSED BY NAME 106341 "RTN","C0CMCCD",139,0) 106342 N ZI 106343 "RTN","C0CMCCD",140,0) 106344 S ZI=$O(@ZB@(""),-1) 106345 "RTN","C0CMCCD",141,0) 106346 I ZI="" S ZI=1 106347 "RTN","C0CMCCD",142,0) 106348 S $P(@ZB@(ZI),"^",2)=LN 106349 "RTN","C0CMCCD",143,0) 106350 Q 106351 "RTN","C0CMCCD",144,0) 106352 ; 106353 "RTN","C0CMCCD",145,0) 106354 SEPARATE(OUTARY,INARY) ; SEPARATES XPATH VARIABLES ACCORDING TO THEIR 106355 "RTN","C0CMCCD",146,0) 106356 ; ROOT ; /Problems/etc/etc goes to @OUTARY@("Problems","/Problems/etc/etc") 106357 "RTN","C0CMCCD",147,0) 106296 106358 S ZI="" 106297 "RTN","C0CMCCD",126,0) 106298 F S ZI=$O(ZWRK(ZI)) Q:ZI="" D ; MAKE A BUILD LIST FROM THE WORK ARRAY 106299 "RTN","C0CMCCD",127,0) 106300 . D QUEUE^C0CXPATH("ZBLD",ZARY,$P(ZWRK(ZI),"^",1),$P(ZWRK(ZI),"^",2)) 106301 "RTN","C0CMCCD",128,0) 106302 D BUILD^C0CXPATH("ZBLD",OUTARY) ; BUILD NEW ARRAY WITHOUT TEXT SECTIONS 106303 "RTN","C0CMCCD",129,0) 106304 K @OUTARY@(0) ; GET RID OF THE LINE COUNT 106305 "RTN","C0CMCCD",130,0) 106359 "RTN","C0CMCCD",148,0) 106360 F S ZI=$O(@INARY@(ZI)) Q:ZI="" D ; FOR EACH ELEMENT OF THE ARRAY 106361 "RTN","C0CMCCD",149,0) 106362 . I $P(ZI,"//",2)'="" D ; FOR NON-BODY ENTRIES 106363 "RTN","C0CMCCD",150,0) 106364 . . S ZJ=$P(ZI,"/",4) ; things like From Patient Actor 106365 "RTN","C0CMCCD",151,0) 106366 . E D ; FOR BODY PARTS 106367 "RTN","C0CMCCD",152,0) 106368 . . S ZJ=$P(ZI,"/",2) ; 106369 "RTN","C0CMCCD",153,0) 106370 . . I ZJ="" S ZJ=$P(ZI,"/",3) ; 106371 "RTN","C0CMCCD",154,0) 106372 . S @OUTARY@(ZJ,ZI)=$G(@INARY@(ZI)) ;FIX THIS FOR MULTILINE COMMENTS 106373 "RTN","C0CMCCD",155,0) 106306 106374 Q 106307 "RTN","C0CMCCD",131,0) 106308 ; 106309 "RTN","C0CMCCD",132,0) 106310 C0CBEGIN(ZA,LN) ; INSERTS A BEGIN LINE LN INTO ARRAY ZWRK, PASSED BY NAME 106311 "RTN","C0CMCCD",133,0) 106312 N ZI 106313 "RTN","C0CMCCD",134,0) 106314 S ZI=$O(@ZA@(""),-1) 106315 "RTN","C0CMCCD",135,0) 106316 I ZI="" S ZI=1 106317 "RTN","C0CMCCD",136,0) 106318 E S ZI=ZI+1 ; INCREMENT COUNT IN WORK ARRAY 106319 "RTN","C0CMCCD",137,0) 106320 S $P(@ZA@(ZI),"^",1)=LN 106321 "RTN","C0CMCCD",138,0) 106375 "RTN","C0CMCCD",156,0) 106376 ; 106377 "RTN","C0CMCCD",157,0) 106378 FINDTID ; FIND TEMPLATE IDS IN DOM 1 106379 "RTN","C0CMCCD",158,0) 106380 S C0CDOCID=1 106381 "RTN","C0CMCCD",159,0) 106382 S ZD=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 106383 "RTN","C0CMCCD",160,0) 106384 S ZN="" 106385 "RTN","C0CMCCD",161,0) 106386 S CURSEC="" 106387 "RTN","C0CMCCD",162,0) 106388 S TID="" 106389 "RTN","C0CMCCD",163,0) 106390 F S ZN=$O(@ZD@(ZN)) Q:ZN="" D ; 106391 "RTN","C0CMCCD",164,0) 106392 . I $$TAG(ZN)="root" D ; 106393 "RTN","C0CMCCD",165,0) 106394 . . I $$TAG($$PARENT(ZN))="templateId" D ; ONLY LOOKING FOR TEMPLATES 106395 "RTN","C0CMCCD",166,0) 106396 . . . S ZG=$$PARENT($$PARENT(ZN)) 106397 "RTN","C0CMCCD",167,0) 106398 . . . S ZG2=$$PARENT(ZG) ;COMPONENT THAT HOLDS THIS SECTION 106399 "RTN","C0CMCCD",168,0) 106400 . . . S CMT=$G(@ZD@(ZG,"X",1)) 106401 "RTN","C0CMCCD",169,0) 106402 . . . I CMT="" S CMT="?" 106403 "RTN","C0CMCCD",170,0) 106404 . . . I $$TAG(ZG)="section" D ;START OF A SECTION 106405 "RTN","C0CMCCD",171,0) 106406 . . . . S CURSEC=$$PARENT(ZG) 106407 "RTN","C0CMCCD",172,0) 106408 . . . . S SECCMT=$G(@ZD@(CURSEC,"X",1)) 106409 "RTN","C0CMCCD",173,0) 106410 . . . . I SECCMT="" S SECCMT="?" 106411 "RTN","C0CMCCD",174,0) 106412 . . . . S SECTID=$G(@ZD@(ZN,"T",1)) ;SECTION TEMPLATE ID 106413 "RTN","C0CMCCD",175,0) 106414 . . . S TID=$G(@ZD@(ZN,"T",1)) ;TEMPLATE ID 106415 "RTN","C0CMCCD",176,0) 106416 . . . I CURSEC'="" D ; IF WE ARE IN A SECTION 106417 "RTN","C0CMCCD",177,0) 106418 . . . . S CCDDIR(ZG2,CURSEC,$$TAG(ZG2),CMT,SECCMT)=TID 106419 "RTN","C0CMCCD",178,0) 106420 . . . . S DOMMAP(ZG2)=CURSEC_U_$$TAG(ZG2)_U_TID_U_SECTID 106421 "RTN","C0CMCCD",179,0) 106422 . . . W !,$$TAG(ZG2)," ",$G(@ZD@(ZG,"X",1)) 106423 "RTN","C0CMCCD",180,0) 106424 . . . W " root ",ZN," ",@ZD@(ZN,"T",1) 106425 "RTN","C0CMCCD",181,0) 106322 106426 Q 106323 "RTN","C0CMCCD",139,0) 106324 ; 106325 "RTN","C0CMCCD",140,0) 106326 C0CEND(ZB,LN) ; INSERTS AN END LINE LN INTO ARRAY ZWRK, PASSED BY NAME 106327 "RTN","C0CMCCD",141,0) 106328 N ZI 106329 "RTN","C0CMCCD",142,0) 106330 S ZI=$O(@ZB@(""),-1) 106331 "RTN","C0CMCCD",143,0) 106332 I ZI="" S ZI=1 106333 "RTN","C0CMCCD",144,0) 106334 S $P(@ZB@(ZI),"^",2)=LN 106335 "RTN","C0CMCCD",145,0) 106427 "RTN","C0CMCCD",182,0) 106428 ; 106429 "RTN","C0CMCCD",183,0) 106430 FINDALT ; PROCESS THE DOMMAP AND FIND THE ALT TAGS FOR COMPONENTS 106431 "RTN","C0CMCCD",184,0) 106432 ; 106433 "RTN","C0CMCCD",185,0) 106434 S ZI="" 106435 "RTN","C0CMCCD",186,0) 106436 F S ZI=$O(DOMMAP(ZI)) Q:ZI="" D ; FOR EACH NODE IN THE MAP 106437 "RTN","C0CMCCD",187,0) 106438 . S ZJ=DOMMAP(ZI) ; 106439 "RTN","C0CMCCD",188,0) 106440 . S PARNODE=$P(ZJ,U,1) ;PARENT NODE 106441 "RTN","C0CMCCD",189,0) 106442 . S TAG=$P(ZJ,U,2) ;THIS TAG 106443 "RTN","C0CMCCD",190,0) 106444 . S TID=$P(ZJ,U,3) ;THIS TEMPLATE ID 106445 "RTN","C0CMCCD",191,0) 106446 . S PARTID=$P(ZJ,U,4) ;PARENT TEMPLATE ID 106447 "RTN","C0CMCCD",192,0) 106448 . S ZIEN=$O(^C0CXDS(178.101,"TID",TID,"")) ;THIS NODE IEN 106449 "RTN","C0CMCCD",193,0) 106450 . S PARIEN=$O(^C0CXDS(178.101,"TID",PARTID,"")) ;PARENT NODE IEN 106451 "RTN","C0CMCCD",194,0) 106452 . I ZI=PARNODE D ; IF THIS IS A SECTION NODE 106453 "RTN","C0CMCCD",195,0) 106454 . . S ALTTAG=$$GET1^DIQ(178.101,PARIEN_",",.03) ;ALT TAG FIELD FOR PARENT 106455 "RTN","C0CMCCD",196,0) 106456 . . S NAME=$$GET1^DIQ(178.101,ZIEN_",",.01) ;NAME OF THIS NODE'S TEMPLATE 106457 "RTN","C0CMCCD",197,0) 106458 . . W ZI," ",TAG," ",ALTTAG," ",NAME,! 106459 "RTN","C0CMCCD",198,0) 106460 . . S C0CTAGS(ZI)=ALTTAG 106461 "RTN","C0CMCCD",199,0) 106462 . E D ; NOT A SECTION NODE 106463 "RTN","C0CMCCD",200,0) 106464 . . N ZJ S ZJ="" 106465 "RTN","C0CMCCD",201,0) 106466 . . S ZJ=$O(^C0CXDS(178.101,"D",PARIEN,ZIEN,"")) ;A WHEREUSED POINTER? 106467 "RTN","C0CMCCD",202,0) 106468 . . I ZJ'="" D ; THERE IS A NEW LABEL FOR THIS NODE 106469 "RTN","C0CMCCD",203,0) 106470 . . . N ZK 106471 "RTN","C0CMCCD",204,0) 106472 . . . S ZK=$$GET1^DIQ(178.111,ZJ_","_ZIEN_",",2) 106473 "RTN","C0CMCCD",205,0) 106474 . . . I ZK'="" D ; 106475 "RTN","C0CMCCD",206,0) 106476 . . . . W "FOUND ",ZK,! 106477 "RTN","C0CMCCD",207,0) 106478 . . . . S C0CTAGS(ZI)=ZK ; NEW TAG FOR INTERSECTION 106479 "RTN","C0CMCCD",208,0) 106336 106480 Q 106337 "RTN","C0CMCCD",146,0) 106338 ; 106339 "RTN","C0CMCCD",147,0) 106340 SEPARATE(OUTARY,INARY) ; SEPARATES XPATH VARIABLES ACCORDING TO THEIR 106341 "RTN","C0CMCCD",148,0) 106342 ; ROOT ; /Problems/etc/etc goes to @OUTARY@("Problems","/Problems/etc/etc") 106343 "RTN","C0CMCCD",149,0) 106344 S ZI="" 106345 "RTN","C0CMCCD",150,0) 106346 F S ZI=$O(@INARY@(ZI)) Q:ZI="" D ; FOR EACH ELEMENT OF THE ARRAY 106347 "RTN","C0CMCCD",151,0) 106348 . I $P(ZI,"//",2)'="" D ; FOR NON-BODY ENTRIES 106349 "RTN","C0CMCCD",152,0) 106350 . . S ZJ=$P(ZI,"/",4) ; things like From Patient Actor 106351 "RTN","C0CMCCD",153,0) 106352 . E D ; FOR BODY PARTS 106353 "RTN","C0CMCCD",154,0) 106354 . . S ZJ=$P(ZI,"/",2) ; 106355 "RTN","C0CMCCD",155,0) 106356 . . I ZJ="" S ZJ=$P(ZI,"/",3) ; 106357 "RTN","C0CMCCD",156,0) 106358 . S @OUTARY@(ZJ,ZI)=$G(@INARY@(ZI)) ;FIX THIS FOR MULTILINE COMMENTS 106359 "RTN","C0CMCCD",157,0) 106481 "RTN","C0CMCCD",209,0) 106482 ; 106483 "RTN","C0CMCCD",210,0) 106484 ALTTAG(NODE) ; SET Y EQUAL TO THE ALT TAG FOUND IN C0CTAGS IF NODE IF FOUND 106485 "RTN","C0CMCCD",211,0) 106486 ; 106487 "RTN","C0CMCCD",212,0) 106488 S Y=$G(C0CTAGS(NODE)) 106489 "RTN","C0CMCCD",213,0) 106360 106490 Q 106361 "RTN","C0CMCCD",158,0) 106362 ; 106363 "RTN","C0CMCCD",159,0) 106364 FINDTID ; FIND TEMPLATE IDS IN DOM 1 106365 "RTN","C0CMCCD",160,0) 106366 S C0CDOCID=1 106367 "RTN","C0CMCCD",161,0) 106368 S ZD=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 106369 "RTN","C0CMCCD",162,0) 106370 S ZN="" 106371 "RTN","C0CMCCD",163,0) 106372 S CURSEC="" 106373 "RTN","C0CMCCD",164,0) 106374 S TID="" 106375 "RTN","C0CMCCD",165,0) 106376 F S ZN=$O(@ZD@(ZN)) Q:ZN="" D ; 106377 "RTN","C0CMCCD",166,0) 106378 . I $$TAG(ZN)="root" D ; 106379 "RTN","C0CMCCD",167,0) 106380 . . I $$TAG($$PARENT(ZN))="templateId" D ; ONLY LOOKING FOR TEMPLATES 106381 "RTN","C0CMCCD",168,0) 106382 . . . S ZG=$$PARENT($$PARENT(ZN)) 106383 "RTN","C0CMCCD",169,0) 106384 . . . S ZG2=$$PARENT(ZG) ;COMPONENT THAT HOLDS THIS SECTION 106385 "RTN","C0CMCCD",170,0) 106386 . . . S CMT=$G(@ZD@(ZG,"X",1)) 106387 "RTN","C0CMCCD",171,0) 106388 . . . I CMT="" S CMT="?" 106389 "RTN","C0CMCCD",172,0) 106390 . . . I $$TAG(ZG)="section" D ;START OF A SECTION 106391 "RTN","C0CMCCD",173,0) 106392 . . . . S CURSEC=$$PARENT(ZG) 106393 "RTN","C0CMCCD",174,0) 106394 . . . . S SECCMT=$G(@ZD@(CURSEC,"X",1)) 106395 "RTN","C0CMCCD",175,0) 106396 . . . . I SECCMT="" S SECCMT="?" 106397 "RTN","C0CMCCD",176,0) 106398 . . . . S SECTID=$G(@ZD@(ZN,"T",1)) ;SECTION TEMPLATE ID 106399 "RTN","C0CMCCD",177,0) 106400 . . . S TID=$G(@ZD@(ZN,"T",1)) ;TEMPLATE ID 106401 "RTN","C0CMCCD",178,0) 106402 . . . I CURSEC'="" D ; IF WE ARE IN A SECTION 106403 "RTN","C0CMCCD",179,0) 106404 . . . . S CCDDIR(ZG2,CURSEC,$$TAG(ZG2),CMT,SECCMT)=TID 106405 "RTN","C0CMCCD",180,0) 106406 . . . . S DOMMAP(ZG2)=CURSEC_U_$$TAG(ZG2)_U_TID_U_SECTID 106407 "RTN","C0CMCCD",181,0) 106408 . . . W !,$$TAG(ZG2)," ",$G(@ZD@(ZG,"X",1)) 106409 "RTN","C0CMCCD",182,0) 106410 . . . W " root ",ZN," ",@ZD@(ZN,"T",1) 106411 "RTN","C0CMCCD",183,0) 106491 "RTN","C0CMCCD",214,0) 106492 ; 106493 "RTN","C0CMCCD",215,0) 106494 SETCBK ; SET THE TAG CALLBACK FOR XPATH PROCESSSING OF THE CCD 106495 "RTN","C0CMCCD",216,0) 106496 S C0CCBK("TAG")="D ALTTAG^C0CMCCD(ZOID)" 106497 "RTN","C0CMCCD",217,0) 106412 106498 Q 106413 "RTN","C0CMCCD",184,0) 106414 ; 106415 "RTN","C0CMCCD",185,0) 106416 FINDALT ; PROCESS THE DOMMAP AND FIND THE ALT TAGS FOR COMPONENTS 106417 "RTN","C0CMCCD",186,0) 106418 ; 106419 "RTN","C0CMCCD",187,0) 106420 S ZI="" 106421 "RTN","C0CMCCD",188,0) 106422 F S ZI=$O(DOMMAP(ZI)) Q:ZI="" D ; FOR EACH NODE IN THE MAP 106423 "RTN","C0CMCCD",189,0) 106424 . S ZJ=DOMMAP(ZI) ; 106425 "RTN","C0CMCCD",190,0) 106426 . S PARNODE=$P(ZJ,U,1) ;PARENT NODE 106427 "RTN","C0CMCCD",191,0) 106428 . S TAG=$P(ZJ,U,2) ;THIS TAG 106429 "RTN","C0CMCCD",192,0) 106430 . S TID=$P(ZJ,U,3) ;THIS TEMPLATE ID 106431 "RTN","C0CMCCD",193,0) 106432 . S PARTID=$P(ZJ,U,4) ;PARENT TEMPLATE ID 106433 "RTN","C0CMCCD",194,0) 106434 . S ZIEN=$O(^C0CXDS(178.101,"TID",TID,"")) ;THIS NODE IEN 106435 "RTN","C0CMCCD",195,0) 106436 . S PARIEN=$O(^C0CXDS(178.101,"TID",PARTID,"")) ;PARENT NODE IEN 106437 "RTN","C0CMCCD",196,0) 106438 . I ZI=PARNODE D ; IF THIS IS A SECTION NODE 106439 "RTN","C0CMCCD",197,0) 106440 . . S ALTTAG=$$GET1^DIQ(178.101,PARIEN_",",.03) ;ALT TAG FIELD FOR PARENT 106441 "RTN","C0CMCCD",198,0) 106442 . . S NAME=$$GET1^DIQ(178.101,ZIEN_",",.01) ;NAME OF THIS NODE'S TEMPLATE 106443 "RTN","C0CMCCD",199,0) 106444 . . W ZI," ",TAG," ",ALTTAG," ",NAME,! 106445 "RTN","C0CMCCD",200,0) 106446 . . S C0CTAGS(ZI)=ALTTAG 106447 "RTN","C0CMCCD",201,0) 106448 . E D ; NOT A SECTION NODE 106449 "RTN","C0CMCCD",202,0) 106450 . . N ZJ S ZJ="" 106451 "RTN","C0CMCCD",203,0) 106452 . . S ZJ=$O(^C0CXDS(178.101,"D",PARIEN,ZIEN,"")) ;A WHEREUSED POINTER? 106453 "RTN","C0CMCCD",204,0) 106454 . . I ZJ'="" D ; THERE IS A NEW LABEL FOR THIS NODE 106455 "RTN","C0CMCCD",205,0) 106456 . . . N ZK 106457 "RTN","C0CMCCD",206,0) 106458 . . . S ZK=$$GET1^DIQ(178.111,ZJ_","_ZIEN_",",2) 106459 "RTN","C0CMCCD",207,0) 106460 . . . I ZK'="" D ; 106461 "RTN","C0CMCCD",208,0) 106462 . . . . W "FOUND ",ZK,! 106463 "RTN","C0CMCCD",209,0) 106464 . . . . S C0CTAGS(ZI)=ZK ; NEW TAG FOR INTERSECTION 106465 "RTN","C0CMCCD",210,0) 106499 "RTN","C0CMCCD",218,0) 106500 ; 106501 "RTN","C0CMCCD",219,0) 106502 OUTCCD(GARYIN) ; OUTPUT THE PARSED CCD TO A TEXT FILE 106503 "RTN","C0CMCCD",220,0) 106504 ;D TEST3^C0CMXML 106505 "RTN","C0CMCCD",221,0) 106506 N ZT S ZT=$NA(^TMP("CCDOUT",$J)) 106507 "RTN","C0CMCCD",222,0) 106508 N ZI,ZJ 106509 "RTN","C0CMCCD",223,0) 106510 S ZI=1 S ZJ="" 106511 "RTN","C0CMCCD",224,0) 106512 K @ZT 106513 "RTN","C0CMCCD",225,0) 106514 F S ZJ=$O(GARYIN(ZJ)) Q:ZJ="" D ; 106515 "RTN","C0CMCCD",226,0) 106516 . S @ZT@(ZI)=ZJ_"^"_GARYIN(ZJ) 106517 "RTN","C0CMCCD",227,0) 106518 . S ZI=ZI+1 106519 "RTN","C0CMCCD",228,0) 106520 S ONAME=$NA(@ZT@(1)) 106521 "RTN","C0CMCCD",229,0) 106522 W $$OUTPUT^C0CXPATH(ONAME,"CCDOUT.txt","/home/vademo2/CCR") 106523 "RTN","C0CMCCD",230,0) 106524 K @ZT 106525 "RTN","C0CMCCD",231,0) 106466 106526 Q 106467 "RTN","C0CMCCD",211,0) 106468 ; 106469 "RTN","C0CMCCD",212,0) 106470 ALTTAG(NODE) ; SET Y EQUAL TO THE ALT TAG FOUND IN C0CTAGS IF NODE IF FOUND 106471 "RTN","C0CMCCD",213,0) 106472 ; 106473 "RTN","C0CMCCD",214,0) 106474 S Y=$G(C0CTAGS(NODE)) 106475 "RTN","C0CMCCD",215,0) 106527 "RTN","C0CMCCD",232,0) 106528 ; 106529 "RTN","C0CMCCD",233,0) 106530 GENXDS(ZD) ; GENERATE THE XDS PROTOTYPE RECORDS FROM A CCDDIR ARRAY 106531 "RTN","C0CMCCD",234,0) 106532 ; ARRAY ELEMENTS LOOK LIKE: 106533 "RTN","C0CMCCD",235,0) 106534 ; CCDDIR(1659,1634,"observation"," Result observaion template "," Vital signs section template ")="2.16.840.1.113883.10.20.1.31" 106535 "RTN","C0CMCCD",236,0) 106536 ;or CCDDIR(cur node,section node,cur tag,cur name,sec name)=templateId 106537 "RTN","C0CMCCD",237,0) 106538 S ZF=178.101 ; FILE NUMBER FOR THE C0C XDS PROTOTYPE FILE 106539 "RTN","C0CMCCD",238,0) 106540 S ZI=$Q(@ZD@("")) ;FIRST ARRAY ELEMENT 106541 "RTN","C0CMCCD",239,0) 106542 S DONE=0 106543 "RTN","C0CMCCD",240,0) 106544 F Q:DONE D ; 106545 "RTN","C0CMCCD",241,0) 106546 . W @ZI,! 106547 "RTN","C0CMCCD",242,0) 106548 . S ZJ=$QS(ZI,5) 106549 "RTN","C0CMCCD",243,0) 106550 . S ZJ=$E(ZJ,2,$L(ZJ)) ;STRIP THE LEADING SPACE 106551 "RTN","C0CMCCD",244,0) 106552 . S C0CFDA(ZF,"?+1,",.01)=ZJ 106553 "RTN","C0CMCCD",245,0) 106554 . S C0CFDA(ZF,"?+1,",.02)=$QS(ZI,4) ; TAG FOR THIS TEMPLATE 106555 "RTN","C0CMCCD",246,0) 106556 . S C0CFDA(ZF,"?+1,",1)=@ZI 106557 "RTN","C0CMCCD",247,0) 106558 . D UPDIE 106559 "RTN","C0CMCCD",248,0) 106560 . S ZI=$Q(@ZI) 106561 "RTN","C0CMCCD",249,0) 106562 . I ZI="" S DONE=1 106563 "RTN","C0CMCCD",250,0) 106476 106564 Q 106477 "RTN","C0CMCCD",216,0) 106478 ; 106479 "RTN","C0CMCCD",217,0) 106480 SETCBK ; SET THE TAG CALLBACK FOR XPATH PROCESSSING OF THE CCD 106481 "RTN","C0CMCCD",218,0) 106482 S C0CCBK("TAG")="D ALTTAG^C0CMCCD(ZOID)" 106483 "RTN","C0CMCCD",219,0) 106565 "RTN","C0CMCCD",251,0) 106566 ; 106567 "RTN","C0CMCCD",252,0) 106568 WHRUSD(ZD) ; UPDATE THE C0C XDS FILE WITH WHERE USED DATA FROM 106569 "RTN","C0CMCCD",253,0) 106570 ; CCDDIR PASS BY NAME 106571 "RTN","C0CMCCD",254,0) 106572 ; ARRAY ELEMENTS LOOK LIKE: 106573 "RTN","C0CMCCD",255,0) 106574 ; CCDDIR(1634," Vital signs section template ",1659,"observation"," Result observaion template ")="2.16.840.1.113883.10.20.1.31" 106575 "RTN","C0CMCCD",256,0) 106576 ;or CCDDIR(section node,sec name, cur node,cur tag,cur name)=templateId 106577 "RTN","C0CMCCD",257,0) 106578 S ZF=178.101 ; FILE NUMBER FOR THE C0C XDS PROTOTYPE FILE 106579 "RTN","C0CMCCD",258,0) 106580 S ZSF=178.111 ; WHERE USED SUBFILE OF C0C XDS PROTOTYPE FILE 106581 "RTN","C0CMCCD",259,0) 106582 S ZI=$Q(@ZD@("")) ;FIRST ARRAY ELEMENT 106583 "RTN","C0CMCCD",260,0) 106584 S DONE=0 106585 "RTN","C0CMCCD",261,0) 106586 F Q:DONE D ; 106587 "RTN","C0CMCCD",262,0) 106588 . W @ZI 106589 "RTN","C0CMCCD",263,0) 106590 . S ZIEN=$O(^C0CXDS(178.101,"TID",@ZI,"")) ; IEN FOR THIS NODE'S TEMPLATE 106591 "RTN","C0CMCCD",264,0) 106592 . W " IEN:",ZIEN 106593 "RTN","C0CMCCD",265,0) 106594 . S ZJ=$QS(ZI,2) 106595 "RTN","C0CMCCD",266,0) 106596 . S ZJ=$E(ZJ,2,$L(ZJ)) ;STRIP THE LEADING SPACE 106597 "RTN","C0CMCCD",267,0) 106598 . S ZPIEN=$O(^C0CXDS(178.101,"B",ZJ,"")) ; PARENT IEN 106599 "RTN","C0CMCCD",268,0) 106600 . W " PARENT IEN:",ZPIEN 106601 "RTN","C0CMCCD",269,0) 106602 . S ZTAG=$QS(ZI,4) ; TAG FOR THIS TEMPLATE 106603 "RTN","C0CMCCD",270,0) 106604 . W " TAG:",ZTAG,! 106605 "RTN","C0CMCCD",271,0) 106606 . I ZIEN'=ZPIEN D ; ONLY FOR CHILD TEMPLATES 106607 "RTN","C0CMCCD",272,0) 106608 . . S C0CFDA(ZSF,"?+1,"_ZIEN_",",.01)=ZPIEN ; NEW SUBFILE ENTRY WITH PAR PTR 106609 "RTN","C0CMCCD",273,0) 106610 . . S C0CFDA(ZSF,"?+1,"_ZIEN_",",1)=ZTAG ; TAG FOR NEW ENTRY 106611 "RTN","C0CMCCD",274,0) 106612 . . D UPDIE 106613 "RTN","C0CMCCD",275,0) 106614 . ;S C0CFDA(ZF,"?+1,",1)=@ZI 106615 "RTN","C0CMCCD",276,0) 106616 . ;D UPDIE 106617 "RTN","C0CMCCD",277,0) 106618 . S ZI=$Q(@ZI) 106619 "RTN","C0CMCCD",278,0) 106620 . I ZI="" S DONE=1 106621 "RTN","C0CMCCD",279,0) 106484 106622 Q 106485 "RTN","C0CMCCD",220,0) 106486 ; 106487 "RTN","C0CMCCD",221,0) 106488 OUTCCD(GARYIN) ; OUTPUT THE PARSED CCD TO A TEXT FILE 106489 "RTN","C0CMCCD",222,0) 106490 ;D TEST3^C0CMXML 106491 "RTN","C0CMCCD",223,0) 106492 N ZT S ZT=$NA(^TMP("CCDOUT",$J)) 106493 "RTN","C0CMCCD",224,0) 106494 N ZI,ZJ 106495 "RTN","C0CMCCD",225,0) 106496 S ZI=1 S ZJ="" 106497 "RTN","C0CMCCD",226,0) 106498 K @ZT 106499 "RTN","C0CMCCD",227,0) 106500 F S ZJ=$O(GARYIN(ZJ)) Q:ZJ="" D ; 106501 "RTN","C0CMCCD",228,0) 106502 . S @ZT@(ZI)=ZJ_"^"_GARYIN(ZJ) 106503 "RTN","C0CMCCD",229,0) 106504 . S ZI=ZI+1 106505 "RTN","C0CMCCD",230,0) 106506 S ONAME=$NA(@ZT@(1)) 106507 "RTN","C0CMCCD",231,0) 106508 W $$OUTPUT^C0CXPATH(ONAME,"CCDOUT.txt","/home/vademo2/CCR") 106509 "RTN","C0CMCCD",232,0) 106510 K @ZT 106511 "RTN","C0CMCCD",233,0) 106623 "RTN","C0CMCCD",280,0) 106624 ; 106625 "RTN","C0CMCCD",281,0) 106626 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 106627 "RTN","C0CMCCD",282,0) 106628 K ZERR 106629 "RTN","C0CMCCD",283,0) 106630 D CLEAN^DILF 106631 "RTN","C0CMCCD",284,0) 106632 D UPDATE^DIE("","C0CFDA","","ZERR") 106633 "RTN","C0CMCCD",285,0) 106634 I $D(ZERR) S $EC=",U1," 106635 "RTN","C0CMCCD",286,0) 106636 K C0CFDA 106637 "RTN","C0CMCCD",287,0) 106512 106638 Q 106513 "RTN","C0CMCCD",234,0)106514 ;106515 "RTN","C0CMCCD",235,0)106516 GENXDS(ZD) ; GENERATE THE XDS PROTOTYPE RECORDS FROM A CCDDIR ARRAY106517 "RTN","C0CMCCD",236,0)106518 ; ARRAY ELEMENTS LOOK LIKE:106519 "RTN","C0CMCCD",237,0)106520 ; CCDDIR(1659,1634,"observation"," Result observaion template "," Vital signs section template ")="2.16.840.1.113883.10.20.1.31"106521 "RTN","C0CMCCD",238,0)106522 ;or CCDDIR(cur node,section node,cur tag,cur name,sec name)=templateId106523 "RTN","C0CMCCD",239,0)106524 S ZF=178.101 ; FILE NUMBER FOR THE C0C XDS PROTOTYPE FILE106525 "RTN","C0CMCCD",240,0)106526 S ZI=$Q(@ZD@("")) ;FIRST ARRAY ELEMENT106527 "RTN","C0CMCCD",241,0)106528 S DONE=0106529 "RTN","C0CMCCD",242,0)106530 F Q:DONE D ;106531 "RTN","C0CMCCD",243,0)106532 . W @ZI,!106533 "RTN","C0CMCCD",244,0)106534 . S ZJ=$QS(ZI,5)106535 "RTN","C0CMCCD",245,0)106536 . S ZJ=$E(ZJ,2,$L(ZJ)) ;STRIP THE LEADING SPACE106537 "RTN","C0CMCCD",246,0)106538 . S C0CFDA(ZF,"?+1,",.01)=ZJ106539 "RTN","C0CMCCD",247,0)106540 . S C0CFDA(ZF,"?+1,",.02)=$QS(ZI,4) ; TAG FOR THIS TEMPLATE106541 "RTN","C0CMCCD",248,0)106542 . S C0CFDA(ZF,"?+1,",1)=@ZI106543 "RTN","C0CMCCD",249,0)106544 . D UPDIE106545 "RTN","C0CMCCD",250,0)106546 . S ZI=$Q(@ZI)106547 "RTN","C0CMCCD",251,0)106548 . I ZI="" S DONE=1106549 "RTN","C0CMCCD",252,0)106550 Q106551 "RTN","C0CMCCD",253,0)106552 ;106553 "RTN","C0CMCCD",254,0)106554 WHRUSD(ZD) ; UPDATE THE C0C XDS FILE WITH WHERE USED DATA FROM106555 "RTN","C0CMCCD",255,0)106556 ; CCDDIR PASS BY NAME106557 "RTN","C0CMCCD",256,0)106558 ; ARRAY ELEMENTS LOOK LIKE:106559 "RTN","C0CMCCD",257,0)106560 ; CCDDIR(1634," Vital signs section template ",1659,"observation"," Result observaion template ")="2.16.840.1.113883.10.20.1.31"106561 "RTN","C0CMCCD",258,0)106562 ;or CCDDIR(section node,sec name, cur node,cur tag,cur name)=templateId106563 "RTN","C0CMCCD",259,0)106564 S ZF=178.101 ; FILE NUMBER FOR THE C0C XDS PROTOTYPE FILE106565 "RTN","C0CMCCD",260,0)106566 S ZSF=178.111 ; WHERE USED SUBFILE OF C0C XDS PROTOTYPE FILE106567 "RTN","C0CMCCD",261,0)106568 S ZI=$Q(@ZD@("")) ;FIRST ARRAY ELEMENT106569 "RTN","C0CMCCD",262,0)106570 S DONE=0106571 "RTN","C0CMCCD",263,0)106572 F Q:DONE D ;106573 "RTN","C0CMCCD",264,0)106574 . W @ZI106575 "RTN","C0CMCCD",265,0)106576 . S ZIEN=$O(^C0CXDS(178.101,"TID",@ZI,"")) ; IEN FOR THIS NODE'S TEMPLATE106577 "RTN","C0CMCCD",266,0)106578 . W " IEN:",ZIEN106579 "RTN","C0CMCCD",267,0)106580 . S ZJ=$QS(ZI,2)106581 "RTN","C0CMCCD",268,0)106582 . S ZJ=$E(ZJ,2,$L(ZJ)) ;STRIP THE LEADING SPACE106583 "RTN","C0CMCCD",269,0)106584 . S ZPIEN=$O(^C0CXDS(178.101,"B",ZJ,"")) ; PARENT IEN106585 "RTN","C0CMCCD",270,0)106586 . W " PARENT IEN:",ZPIEN106587 "RTN","C0CMCCD",271,0)106588 . S ZTAG=$QS(ZI,4) ; TAG FOR THIS TEMPLATE106589 "RTN","C0CMCCD",272,0)106590 . W " TAG:",ZTAG,!106591 "RTN","C0CMCCD",273,0)106592 . I ZIEN'=ZPIEN D ; ONLY FOR CHILD TEMPLATES106593 "RTN","C0CMCCD",274,0)106594 . . S C0CFDA(ZSF,"?+1,"_ZIEN_",",.01)=ZPIEN ; NEW SUBFILE ENTRY WITH PAR PTR106595 "RTN","C0CMCCD",275,0)106596 . . S C0CFDA(ZSF,"?+1,"_ZIEN_",",1)=ZTAG ; TAG FOR NEW ENTRY106597 "RTN","C0CMCCD",276,0)106598 . . D UPDIE106599 "RTN","C0CMCCD",277,0)106600 . ;S C0CFDA(ZF,"?+1,",1)=@ZI106601 "RTN","C0CMCCD",278,0)106602 . ;D UPDIE106603 "RTN","C0CMCCD",279,0)106604 . S ZI=$Q(@ZI)106605 "RTN","C0CMCCD",280,0)106606 . I ZI="" S DONE=1106607 "RTN","C0CMCCD",281,0)106608 Q106609 "RTN","C0CMCCD",282,0)106610 ;106611 "RTN","C0CMCCD",283,0)106612 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS106613 "RTN","C0CMCCD",284,0)106614 K ZERR106615 "RTN","C0CMCCD",285,0)106616 D CLEAN^DILF106617 "RTN","C0CMCCD",286,0)106618 D UPDATE^DIE("","C0CFDA","","ZERR")106619 "RTN","C0CMCCD",287,0)106620 I $D(ZERR) D ;106621 106639 "RTN","C0CMCCD",288,0) 106622 . W "ERROR",!106623 "RTN","C0CMCCD",289,0)106624 . ZWR ZERR106625 "RTN","C0CMCCD",290,0)106626 . B106627 "RTN","C0CMCCD",291,0)106628 K C0CFDA106629 "RTN","C0CMCCD",292,0)106630 Q106631 "RTN","C0CMCCD",293,0)106632 106640 ; 106633 106641 "RTN","C0CMED") 106634 0^48^B18 939705106642 0^48^B18524779 106635 106643 "RTN","C0CMED",1,0) 106636 106644 C0CMED ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009 106637 106645 "RTN","C0CMED",2,0) 106638 ;;1.2;C 0C;;May 11, 2012;Build 50106646 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 106639 106647 "RTN","C0CMED",3,0) 106640 106648 ; Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel. 106641 106649 "RTN","C0CMED",4,0) 106642 ; Licensed under the terms of the GNU General Public License.106650 ; 106643 106651 "RTN","C0CMED",5,0) 106644 ; See attached copy of the License.106652 ; This program is free software: you can redistribute it and/or modify 106645 106653 "RTN","C0CMED",6,0) 106654 ; it under the terms of the GNU Affero General Public License as 106655 "RTN","C0CMED",7,0) 106656 ; published by the Free Software Foundation, either version 3 of the 106657 "RTN","C0CMED",8,0) 106658 ; License, or (at your option) any later version. 106659 "RTN","C0CMED",9,0) 106660 ; 106661 "RTN","C0CMED",10,0) 106662 ; This program is distributed in the hope that it will be useful, 106663 "RTN","C0CMED",11,0) 106664 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 106665 "RTN","C0CMED",12,0) 106666 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 106667 "RTN","C0CMED",13,0) 106668 ; GNU Affero General Public License for more details. 106669 "RTN","C0CMED",14,0) 106670 ; 106671 "RTN","C0CMED",15,0) 106672 ; You should have received a copy of the GNU Affero General Public License 106673 "RTN","C0CMED",16,0) 106674 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 106675 "RTN","C0CMED",17,0) 106676 ; 106677 "RTN","C0CMED",18,0) 106678 ; 106679 "RTN","C0CMED",19,0) 106680 ; --Revision History 106681 "RTN","C0CMED",20,0) 106682 ; July 2008 - Initial Version/GPL 106683 "RTN","C0CMED",21,0) 106684 ; July 2008 - March 2009 various revisions 106685 "RTN","C0CMED",22,0) 106686 ; March 2009 - Reconstruction of routine as driver for other med routines/SMH 106687 "RTN","C0CMED",23,0) 106688 ; 106689 "RTN","C0CMED",24,0) 106690 Q 106691 "RTN","C0CMED",25,0) 106692 EXTRACT(MEDXML,DFN,MEDOUTXML) ; Private; Extract medications into provided XML template 106693 "RTN","C0CMED",26,0) 106694 ; DFN passed by reference 106695 "RTN","C0CMED",27,0) 106696 ; MEDXML and MEDOUTXML are passed by Name 106697 "RTN","C0CMED",28,0) 106698 ; MEDXML is the input template 106699 "RTN","C0CMED",29,0) 106700 ; MEDOUTXML is the output template 106701 "RTN","C0CMED",30,0) 106702 ; Both of them refer to ^TMP globals where the XML documents are stored 106703 "RTN","C0CMED",31,0) 106646 106704 ; 106647 "RTN","C0CMED",7,0) 106648 ; This program is free software; you can redistribute it and/or modify 106649 "RTN","C0CMED",8,0) 106650 ; it under the terms of the GNU General Public License as published by 106651 "RTN","C0CMED",9,0) 106652 ; the Free Software Foundation; either version 2 of the License, or 106653 "RTN","C0CMED",10,0) 106654 ; (at your option) any later version. 106655 "RTN","C0CMED",11,0) 106656 ; 106657 "RTN","C0CMED",12,0) 106658 ; This program is distributed in the hope that it will be useful, 106659 "RTN","C0CMED",13,0) 106660 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 106661 "RTN","C0CMED",14,0) 106662 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 106663 "RTN","C0CMED",15,0) 106664 ; GNU General Public License for more details. 106665 "RTN","C0CMED",16,0) 106666 ; 106667 "RTN","C0CMED",17,0) 106668 ; You should have received a copy of the GNU General Public License along 106669 "RTN","C0CMED",18,0) 106670 ; with this program; if not, write to the Free Software Foundation, Inc., 106671 "RTN","C0CMED",19,0) 106672 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 106673 "RTN","C0CMED",20,0) 106674 ; 106675 "RTN","C0CMED",21,0) 106676 ; --Revision History 106677 "RTN","C0CMED",22,0) 106678 ; July 2008 - Initial Version/GPL 106679 "RTN","C0CMED",23,0) 106680 ; July 2008 - March 2009 various revisions 106681 "RTN","C0CMED",24,0) 106682 ; March 2009 - Reconstruction of routine as driver for other med routines/SMH 106683 "RTN","C0CMED",25,0) 106684 ; 106685 "RTN","C0CMED",26,0) 106705 "RTN","C0CMED",32,0) 106706 ; -- This ep is the driver for extracting medications into the provided XML template 106707 "RTN","C0CMED",33,0) 106708 ; 1. VA Outpatient Meds are in C0CMED1 106709 "RTN","C0CMED",34,0) 106710 ; 2. VA Pending Meds are in C0CMED2 106711 "RTN","C0CMED",35,0) 106712 ; 3. VA non-VA Meds are in C0CMED3 106713 "RTN","C0CMED",36,0) 106714 ; 4. VA Inpatient IV Meds are in C0CMED4 (not functional) 106715 "RTN","C0CMED",37,0) 106716 ; 5. VA Inpatient UD Meds are in C0CMED5 (doesn't exist yet)--March 2009 106717 "RTN","C0CMED",38,0) 106718 ; 6. RPMS Meds are in C0CMED6. Need to create other routines for subdivisions of RPMS Meds is not known at this time. 106719 "RTN","C0CMED",39,0) 106720 ; 106721 "RTN","C0CMED",40,0) 106722 ; --Get parameters for meds 106723 "RTN","C0CMED",41,0) 106724 S @MEDOUTXML@(0)=0 ; By default, empty. 106725 "RTN","C0CMED",42,0) 106726 N C0CMFLAG 106727 "RTN","C0CMED",43,0) 106728 S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING") 106729 "RTN","C0CMED",44,0) 106730 W:$G(DEBUG) "Med Parameters: ",! 106731 "RTN","C0CMED",45,0) 106732 W:$G(DEBUG) "ALL: ",+C0CMFLAG,! 106733 "RTN","C0CMED",46,0) 106734 W:$G(DEBUG) "LIMIT: ",$P(C0CMFLAG,U,2),! 106735 "RTN","C0CMED",47,0) 106736 W:$G(DEBUG) "ACTIVE: ",$P(C0CMFLAG,U,3),! 106737 "RTN","C0CMED",48,0) 106738 W:$G(DEBUG) "PEND: ",$P(C0CMFLAG,U,4),! 106739 "RTN","C0CMED",49,0) 106740 ; --Find out what system we are on and branch out... 106741 "RTN","C0CMED",50,0) 106742 W:$G(DEBUG) "Agenecy: ",$G(DUZ("AG")) 106743 "RTN","C0CMED",51,0) 106744 I $$RPMS^C0CUTIL() D RPMS QUIT 106745 "RTN","C0CMED",52,0) 106746 I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT 106747 "RTN","C0CMED",53,0) 106748 RPMS ; 106749 "RTN","C0CMED",54,0) 106750 ;D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML,C0CMFLAG) QUIT 106751 "RTN","C0CMED",55,0) 106752 N MEDCOUNT S MEDCOUNT=0 106753 "RTN","C0CMED",56,0) 106754 K ^TMP($J,"MED") 106755 "RTN","C0CMED",57,0) 106756 N HIST S HIST=$NA(^TMP($J,"MED","HIST")) ; Meds already dispensed 106757 "RTN","C0CMED",58,0) 106758 N NVA S NVA=$NA(^TMP($J,"MED","NVA")) ; non-VA Meds 106759 "RTN","C0CMED",59,0) 106760 S @HIST@(0)=0,@NVA@(0)=0 ; At first, they are all empty... (prevent undefined errors) 106761 "RTN","C0CMED",60,0) 106762 D EXTRACT^C0CMED6(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds 106763 "RTN","C0CMED",61,0) 106764 D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds 106765 "RTN","C0CMED",62,0) 106766 I @HIST@(0)>0 D 106767 "RTN","C0CMED",63,0) 106768 . D CP^C0CXPATH(HIST,MEDOUTXML) 106769 "RTN","C0CMED",64,0) 106770 . W:$G(DEBUG) "HAS ACTIVE OP MEDS",! 106771 "RTN","C0CMED",65,0) 106772 I @NVA@(0)>0 D 106773 "RTN","C0CMED",66,0) 106774 . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,NVA) 106775 "RTN","C0CMED",67,0) 106776 . ;E D CP^C0CXPATH(NVA,MEDOUTXML) 106777 "RTN","C0CMED",68,0) 106778 . W:$G(DEBUG) "HAS NON-VA MEDS",! 106779 "RTN","C0CMED",69,0) 106686 106780 Q 106687 "RTN","C0CMED",27,0) 106688 EXTRACT(MEDXML,DFN,MEDOUTXML) ; Private; Extract medications into provided XML template 106689 "RTN","C0CMED",28,0) 106690 ; DFN passed by reference 106691 "RTN","C0CMED",29,0) 106692 ; MEDXML and MEDOUTXML are passed by Name 106693 "RTN","C0CMED",30,0) 106694 ; MEDXML is the input template 106695 "RTN","C0CMED",31,0) 106696 ; MEDOUTXML is the output template 106697 "RTN","C0CMED",32,0) 106698 ; Both of them refer to ^TMP globals where the XML documents are stored 106699 "RTN","C0CMED",33,0) 106700 ; 106701 "RTN","C0CMED",34,0) 106702 ; -- This ep is the driver for extracting medications into the provided XML template 106703 "RTN","C0CMED",35,0) 106704 ; 1. VA Outpatient Meds are in C0CMED1 106705 "RTN","C0CMED",36,0) 106706 ; 2. VA Pending Meds are in C0CMED2 106707 "RTN","C0CMED",37,0) 106708 ; 3. VA non-VA Meds are in C0CMED3 106709 "RTN","C0CMED",38,0) 106710 ; 4. VA Inpatient IV Meds are in C0CMED4 (not functional) 106711 "RTN","C0CMED",39,0) 106712 ; 5. VA Inpatient UD Meds are in C0CMED5 (doesn't exist yet)--March 2009 106713 "RTN","C0CMED",40,0) 106714 ; 6. RPMS Meds are in C0CMED6. Need to create other routines for subdivisions of RPMS Meds is not known at this time. 106715 "RTN","C0CMED",41,0) 106716 ; 106717 "RTN","C0CMED",42,0) 106718 ; --Get parameters for meds 106719 "RTN","C0CMED",43,0) 106720 S @MEDOUTXML@(0)=0 ; By default, empty. 106721 "RTN","C0CMED",44,0) 106722 N C0CMFLAG 106723 "RTN","C0CMED",45,0) 106724 S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING") 106725 "RTN","C0CMED",46,0) 106726 W:$G(DEBUG) "Med Parameters: ",! 106727 "RTN","C0CMED",47,0) 106728 W:$G(DEBUG) "ALL: ",+C0CMFLAG,! 106729 "RTN","C0CMED",48,0) 106730 W:$G(DEBUG) "LIMIT: ",$P(C0CMFLAG,U,2),! 106731 "RTN","C0CMED",49,0) 106732 W:$G(DEBUG) "ACTIVE: ",$P(C0CMFLAG,U,3),! 106733 "RTN","C0CMED",50,0) 106734 W:$G(DEBUG) "PEND: ",$P(C0CMFLAG,U,4),! 106735 "RTN","C0CMED",51,0) 106736 ; --Find out what system we are on and branch out... 106737 "RTN","C0CMED",52,0) 106738 W:$G(DEBUG) "Agenecy: ",$G(DUZ("AG")) 106739 "RTN","C0CMED",53,0) 106740 I $$RPMS^C0CUTIL() D RPMS QUIT 106741 "RTN","C0CMED",54,0) 106742 I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT 106743 "RTN","C0CMED",55,0) 106744 RPMS 106745 "RTN","C0CMED",56,0) 106746 ;D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML,C0CMFLAG) QUIT 106747 "RTN","C0CMED",57,0) 106781 "RTN","C0CMED",70,0) 106782 VISTA ; 106783 "RTN","C0CMED",71,0) 106748 106784 N MEDCOUNT S MEDCOUNT=0 106749 "RTN","C0CMED", 58,0)106785 "RTN","C0CMED",72,0) 106750 106786 K ^TMP($J,"MED") 106751 "RTN","C0CMED", 59,0)106787 "RTN","C0CMED",73,0) 106752 106788 N HIST S HIST=$NA(^TMP($J,"MED","HIST")) ; Meds already dispensed 106753 "RTN","C0CMED",60,0) 106789 "RTN","C0CMED",74,0) 106790 N PEND S PEND=$NA(^TMP($J,"MED","PEND")) ; Pending Meds 106791 "RTN","C0CMED",75,0) 106754 106792 N NVA S NVA=$NA(^TMP($J,"MED","NVA")) ; non-VA Meds 106755 "RTN","C0CMED",61,0) 106756 S @HIST@(0)=0,@NVA@(0)=0 ; At first, they are all empty... (prevent undefined errors) 106757 "RTN","C0CMED",62,0) 106758 D EXTRACT^C0CMED6(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds 106759 "RTN","C0CMED",63,0) 106760 D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds 106761 "RTN","C0CMED",64,0) 106762 I @HIST@(0)>0 D 106763 "RTN","C0CMED",65,0) 106793 "RTN","C0CMED",76,0) 106794 K @HIST K @PEND K @NVA ; MAKE SURE THEY ARE EMPTY 106795 "RTN","C0CMED",77,0) 106796 S @HIST@(0)=0,@PEND@(0)=0,@NVA@(0)=0 ; At first, they are all empty... (prevent undefined errors) 106797 "RTN","C0CMED",78,0) 106798 ; N IPIV ; Inpatient IV Meds 106799 "RTN","C0CMED",79,0) 106800 N IPUD S IPUD=$NA(^TMP($J,"MED","IPUD")) ; Inpatient UD Meds 106801 "RTN","C0CMED",80,0) 106802 K @IPUD 106803 "RTN","C0CMED",81,0) 106804 S @IPUD@(0)=0 106805 "RTN","C0CMED",82,0) 106806 ; 106807 "RTN","C0CMED",83,0) 106808 D EXTRACT^C0CMED1(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds 106809 "RTN","C0CMED",84,0) 106810 D:$P(C0CMFLAG,U,4) EXTRACT^C0CMED2(MEDXML,DFN,PEND,.MEDCOUNT) ; Pending Meds 106811 "RTN","C0CMED",85,0) 106812 ;D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds 106813 "RTN","C0CMED",86,0) 106814 D EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds GPL 106815 "RTN","C0CMED",87,0) 106816 D EXTRACT^C0CNMED4(MEDXML,DFN,IPUD,.MEDCOUNT) ; inpatient gpl 106817 "RTN","C0CMED",88,0) 106818 I @HIST@(0)>0 D 106819 "RTN","C0CMED",89,0) 106764 106820 . D CP^C0CXPATH(HIST,MEDOUTXML) 106765 "RTN","C0CMED", 66,0)106821 "RTN","C0CMED",90,0) 106766 106822 . W:$G(DEBUG) "HAS ACTIVE OP MEDS",! 106767 "RTN","C0CMED",67,0) 106768 I @NVA@(0)>0 D 106769 "RTN","C0CMED",68,0) 106770 . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,NVA) 106771 "RTN","C0CMED",69,0) 106772 . ;E D CP^C0CXPATH(NVA,MEDOUTXML) 106773 "RTN","C0CMED",70,0) 106823 "RTN","C0CMED",91,0) 106824 I @PEND@(0)>0 D 106825 "RTN","C0CMED",92,0) 106826 . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,PEND) ;Add Pending to Historical 106827 "RTN","C0CMED",93,0) 106828 . E D CP^C0CXPATH(PEND,MEDOUTXML) ; No historical, just copy 106829 "RTN","C0CMED",94,0) 106830 . W:$G(DEBUG) "HAS OP PENDING MEDS",! 106831 "RTN","C0CMED",95,0) 106832 I @NVA@(0)>0 D 106833 "RTN","C0CMED",96,0) 106834 . I @HIST@(0)>0!(@PEND@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,NVA) 106835 "RTN","C0CMED",97,0) 106836 . E D CP^C0CXPATH(NVA,MEDOUTXML) 106837 "RTN","C0CMED",98,0) 106774 106838 . W:$G(DEBUG) "HAS NON-VA MEDS",! 106775 "RTN","C0CMED",71,0) 106839 "RTN","C0CMED",99,0) 106840 I @IPUD@(0)>0 D 106841 "RTN","C0CMED",100,0) 106842 . I @HIST@(0)>0!(@PEND@(0)>0)!(@NVA@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,IPUD) 106843 "RTN","C0CMED",101,0) 106844 . E D CP^C0CXPATH(IPUD,MEDOUTXML) 106845 "RTN","C0CMED",102,0) 106846 . W:$G(DEBUG) "HAS INPATIENT MEDS",! 106847 "RTN","C0CMED",103,0) 106848 N ZI 106849 "RTN","C0CMED",104,0) 106850 S ZI=$NA(^TMP("C0CCCR",$J,"MEDMAP")) 106851 "RTN","C0CMED",105,0) 106852 M ^TMP("C0CRIM","VARS",DFN,"MEDS")=@ZI ; PERSIST MEDS VARIABLES 106853 "RTN","C0CMED",106,0) 106854 K @ZI ; CLEAN UP MED MAP AFTER - GPL 10/10 106855 "RTN","C0CMED",107,0) 106856 K @PEND 106857 "RTN","C0CMED",108,0) 106858 K @HIST 106859 "RTN","C0CMED",109,0) 106860 K @NVA 106861 "RTN","C0CMED",110,0) 106862 K @IPUD 106863 "RTN","C0CMED",111,0) 106776 106864 Q 106777 "RTN","C0CMED",72,0)106778 VISTA106779 "RTN","C0CMED",73,0)106780 N MEDCOUNT S MEDCOUNT=0106781 "RTN","C0CMED",74,0)106782 K ^TMP($J,"MED")106783 "RTN","C0CMED",75,0)106784 N HIST S HIST=$NA(^TMP($J,"MED","HIST")) ; Meds already dispensed106785 "RTN","C0CMED",76,0)106786 N PEND S PEND=$NA(^TMP($J,"MED","PEND")) ; Pending Meds106787 "RTN","C0CMED",77,0)106788 N NVA S NVA=$NA(^TMP($J,"MED","NVA")) ; non-VA Meds106789 "RTN","C0CMED",78,0)106790 K @HIST K @PEND K @NVA ; MAKE SURE THEY ARE EMPTY106791 "RTN","C0CMED",79,0)106792 S @HIST@(0)=0,@PEND@(0)=0,@NVA@(0)=0 ; At first, they are all empty... (prevent undefined errors)106793 "RTN","C0CMED",80,0)106794 ; N IPIV ; Inpatient IV Meds106795 "RTN","C0CMED",81,0)106796 N IPUD S IPUD=$NA(^TMP($J,"MED","IPUD")) ; Inpatient UD Meds106797 "RTN","C0CMED",82,0)106798 K @IPUD106799 "RTN","C0CMED",83,0)106800 S @IPUD@(0)=0106801 "RTN","C0CMED",84,0)106802 ;106803 "RTN","C0CMED",85,0)106804 D EXTRACT^C0CMED1(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds106805 "RTN","C0CMED",86,0)106806 D:$P(C0CMFLAG,U,4) EXTRACT^C0CMED2(MEDXML,DFN,PEND,.MEDCOUNT) ; Pending Meds106807 "RTN","C0CMED",87,0)106808 ;D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds106809 "RTN","C0CMED",88,0)106810 D EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds GPL106811 "RTN","C0CMED",89,0)106812 D EXTRACT^C0CNMED4(MEDXML,DFN,IPUD,.MEDCOUNT) ; inpatient gpl106813 "RTN","C0CMED",90,0)106814 I @HIST@(0)>0 D106815 "RTN","C0CMED",91,0)106816 . D CP^C0CXPATH(HIST,MEDOUTXML)106817 "RTN","C0CMED",92,0)106818 . W:$G(DEBUG) "HAS ACTIVE OP MEDS",!106819 "RTN","C0CMED",93,0)106820 I @PEND@(0)>0 D106821 "RTN","C0CMED",94,0)106822 . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,PEND) ;Add Pending to Historical106823 "RTN","C0CMED",95,0)106824 . E D CP^C0CXPATH(PEND,MEDOUTXML) ; No historical, just copy106825 "RTN","C0CMED",96,0)106826 . W:$G(DEBUG) "HAS OP PENDING MEDS",!106827 "RTN","C0CMED",97,0)106828 I @NVA@(0)>0 D106829 "RTN","C0CMED",98,0)106830 . I @HIST@(0)>0!(@PEND@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,NVA)106831 "RTN","C0CMED",99,0)106832 . E D CP^C0CXPATH(NVA,MEDOUTXML)106833 "RTN","C0CMED",100,0)106834 . W:$G(DEBUG) "HAS NON-VA MEDS",!106835 "RTN","C0CMED",101,0)106836 I @IPUD@(0)>0 D106837 "RTN","C0CMED",102,0)106838 . I @HIST@(0)>0!(@PEND@(0)>0)!(@NVA@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,IPUD)106839 "RTN","C0CMED",103,0)106840 . E D CP^C0CXPATH(IPUD,MEDOUTXML)106841 "RTN","C0CMED",104,0)106842 . W:$G(DEBUG) "HAS INPATIENT MEDS",!106843 "RTN","C0CMED",105,0)106844 N ZI106845 "RTN","C0CMED",106,0)106846 S ZI=$NA(^TMP("C0CCCR",$J,"MEDMAP"))106847 "RTN","C0CMED",107,0)106848 M ^TMP("C0CRIM","VARS",DFN,"MEDS")=@ZI ; PERSIST MEDS VARIABLES106849 "RTN","C0CMED",108,0)106850 K @ZI ; CLEAN UP MED MAP AFTER - GPL 10/10106851 "RTN","C0CMED",109,0)106852 K @PEND106853 "RTN","C0CMED",110,0)106854 K @HIST106855 "RTN","C0CMED",111,0)106856 K @NVA106857 "RTN","C0CMED",112,0)106858 K @IPUD106859 "RTN","C0CMED",113,0)106860 Q106861 "RTN","C0CMED",114,0)106862 106863 106865 "RTN","C0CMED1") 106864 0^49^B11 3570971106866 0^49^B112207077 106865 106867 "RTN","C0CMED1",1,0) 106866 106868 C0CMED1 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;01/10/09 106867 106869 "RTN","C0CMED1",2,0) 106868 ;;1.2;C 0C;;May 11, 2012;Build 50106870 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 106869 106871 "RTN","C0CMED1",3,0) 106870 106872 ;;Last modified Sat Jan 10 21:42:27 PST 2009 106871 106873 "RTN","C0CMED1",4,0) 106872 ; Copyright 2009 WorldVistA. Licensed under the terms of the GNU106874 ; Copyright 2009 WorldVistA. 106873 106875 "RTN","C0CMED1",5,0) 106874 ; General Public License See attached copy of the License.106876 ; 106875 106877 "RTN","C0CMED1",6,0) 106876 ; 106878 ; This program is free software: you can redistribute it and/or modify 106877 106879 "RTN","C0CMED1",7,0) 106878 ; This program is free software; you can redistribute it and/or modify106880 ; it under the terms of the GNU Affero General Public License as 106879 106881 "RTN","C0CMED1",8,0) 106880 ; it under the terms of the GNU General Public License as published by106882 ; published by the Free Software Foundation, either version 3 of the 106881 106883 "RTN","C0CMED1",9,0) 106882 ; the Free Software Foundation; either version 2 of the License, or106884 ; License, or (at your option) any later version. 106883 106885 "RTN","C0CMED1",10,0) 106884 ; (at your option) any later version.106886 ; 106885 106887 "RTN","C0CMED1",11,0) 106886 ; 106888 ; This program is distributed in the hope that it will be useful, 106887 106889 "RTN","C0CMED1",12,0) 106888 ; This program is distributed in the hope that it will be useful,106890 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 106889 106891 "RTN","C0CMED1",13,0) 106890 ; but WITHOUT ANY WARRANTY; without even the implied warranty of106892 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 106891 106893 "RTN","C0CMED1",14,0) 106892 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the106894 ; GNU Affero General Public License for more details. 106893 106895 "RTN","C0CMED1",15,0) 106894 ; GNU General Public License for more details.106896 ; 106895 106897 "RTN","C0CMED1",16,0) 106896 ; 106898 ; You should have received a copy of the GNU Affero General Public License 106897 106899 "RTN","C0CMED1",17,0) 106898 ; You should have received a copy of the GNU General Public License along106900 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 106899 106901 "RTN","C0CMED1",18,0) 106900 ; with this program; if not, write to the Free Software Foundation, Inc.,106902 ; 106901 106903 "RTN","C0CMED1",19,0) 106902 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.106904 W "NO ENTRY FROM TOP",! 106903 106905 "RTN","C0CMED1",20,0) 106904 ;106906 Q 106905 106907 "RTN","C0CMED1",21,0) 106906 W "NO ENTRY FROM TOP",!106908 ; 106907 106909 "RTN","C0CMED1",22,0) 106908 Q 106910 EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT,FLAGS) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE 106909 106911 "RTN","C0CMED1",23,0) 106910 106912 ; 106911 106913 "RTN","C0CMED1",24,0) 106912 EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT,FLAGS) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE 106914 ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED 106913 106915 "RTN","C0CMED1",25,0) 106914 ; 106916 ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE 106915 106917 "RTN","C0CMED1",26,0) 106916 ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED106918 ; 106917 106919 "RTN","C0CMED1",27,0) 106918 ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE106920 ; MEDS is return array from RPC. 106919 106921 "RTN","C0CMED1",28,0) 106920 ; 106922 ; MAP is a mapping variable map (store result) for each med 106921 106923 "RTN","C0CMED1",29,0) 106922 ; MED S is return array from RPC.106924 ; MED is holds each array element from MEDS(J), one medicine 106923 106925 "RTN","C0CMED1",30,0) 106924 ; M AP is a mapping variable map (store result) for each med106926 ; MEDCOUNT is a counter passed by Reference. 106925 106927 "RTN","C0CMED1",31,0) 106926 ; MED is holds each array element from MEDS(J), one medicine106928 ; FLAGS are: MEDALL(bool)^MEDLIMIT(int)^MEDACTIVE(bool)^MEDPENDING(bool) 106927 106929 "RTN","C0CMED1",32,0) 106928 ; MEDCOUNT is a counter passed by Reference.106930 ; FLAGS are set-up in C0CMED. 106929 106931 "RTN","C0CMED1",33,0) 106930 ; FLAGS are: MEDALL(bool)^MEDLIMIT(int)^MEDACTIVE(bool)^MEDPENDING(bool)106932 ; 106931 106933 "RTN","C0CMED1",34,0) 106932 ; FLAGS are set-up in C0CMED.106934 ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all 106933 106935 "RTN","C0CMED1",35,0) 106934 ; 106936 ; med data available. 106935 106937 "RTN","C0CMED1",36,0) 106936 ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all106938 ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf 106937 106939 "RTN","C0CMED1",37,0) 106938 ; med data available.106940 ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS). 106939 106941 "RTN","C0CMED1",38,0) 106940 ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf106942 ; D PARY^C0CXPATH(MINXML) 106941 106943 "RTN","C0CMED1",39,0) 106942 ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).106944 N MEDS,MAP 106943 106945 "RTN","C0CMED1",40,0) 106944 ; D PARY^C0CXPATH(MINXML)106946 K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!! 106945 106947 "RTN","C0CMED1",41,0) 106946 N MEDS,MAP106948 N ALL S ALL=+FLAGS 106947 106949 "RTN","C0CMED1",42,0) 106948 K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!106950 N ACTIVE S ACTIVE=$P(FLAGS,U,3) 106949 106951 "RTN","C0CMED1",43,0) 106950 N ALL S ALL=+FLAGS106952 N PENDING S PENDING=$P(FLAGS,U,4) ;OHUM/RUT 3120504 ADDED FOR VALIDATION OF PENDING MEDICATIONS 106951 106953 "RTN","C0CMED1",44,0) 106952 N ACTIVE S ACTIVE=$P(FLAGS,U,3)106954 ; Below, X1 is today; X2 is the number of days we want to go back 106953 106955 "RTN","C0CMED1",45,0) 106954 N PENDING S PENDING=$P(FLAGS,U,4) ;OHUM/RUT 3120504 ADDED FOR VALIDATION OF PENDING MEDICATIONS106956 ; X is the result of this calculation using C^%DTC. 106955 106957 "RTN","C0CMED1",46,0) 106956 ; Below, X1 is today; X2 is the number of days we want to go back106958 N X,X1,X2 106957 106959 "RTN","C0CMED1",47,0) 106958 ; X is the result of this calculation using C^%DTC.106960 S X1=DT 106959 106961 "RTN","C0CMED1",48,0) 106960 N X,X1,X2106962 S X2=-$P($P(FLAGS,U,2),"-",2) 106961 106963 "RTN","C0CMED1",49,0) 106962 S X1=DT106964 D C^%DTC 106963 106965 "RTN","C0CMED1",50,0) 106964 S X2=-$P($P(FLAGS,U,2),"-",2)106966 ; I discovered that I shouldn't put an ending date (last parameter) 106965 106967 "RTN","C0CMED1",51,0) 106966 D C^%DTC106968 ; because it seems that it will get meds whose beginning is after X but 106967 106969 "RTN","C0CMED1",52,0) 106968 ; I discovered that I shouldn't put an ending date (last parameter)106970 ; whose exipriation is before the ending date. 106969 106971 "RTN","C0CMED1",53,0) 106970 ; because it seems that it will get meds whose beginning is after X but106972 D RX^PSO52API(DFN,"CCDCCR","","","",X,"") 106971 106973 "RTN","C0CMED1",54,0) 106972 ; whose exipriation is before the ending date.106974 M MEDS=^TMP($J,"CCDCCR",DFN) 106973 106975 "RTN","C0CMED1",55,0) 106974 D RX^PSO52API(DFN,"CCDCCR","","","",X,"")106976 ; @(0) contains the number of meds or -1^NO DATA FOUND 106975 106977 "RTN","C0CMED1",56,0) 106976 M MEDS=^TMP($J,"CCDCCR",DFN)106978 ; If it is -1, we quit. 106977 106979 "RTN","C0CMED1",57,0) 106978 ; @(0) contains the number of meds or -1^NO DATA FOUND106980 I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 Q 106979 106981 "RTN","C0CMED1",58,0) 106980 ; If it is -1, we quit.106982 ; ZWRITE:$G(DEBUG) MEDS 106981 106983 "RTN","C0CMED1",59,0) 106982 I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 Q106984 N RXIEN S RXIEN=0 106983 106985 "RTN","C0CMED1",60,0) 106984 ZWRITE:$G(DEBUG) MEDS106986 F S RXIEN=$O(MEDS(RXIEN)) Q:$G(RXIEN)="" D ; FOR EACH MEDICATION IN THE LIST 106985 106987 "RTN","C0CMED1",61,0) 106986 N RXIEN S RXIEN=0106988 . N MED M MED=MEDS(RXIEN) 106987 106989 "RTN","C0CMED1",62,0) 106988 F S RXIEN=$O(MEDS(RXIEN)) Q:$G(RXIEN)="" D ; FOR EACH MEDICATION IN THE LIST106990 . I 'ALL,ACTIVE,$P(MED(100),U,2)'="ACTIVE" QUIT 106989 106991 "RTN","C0CMED1",63,0) 106990 . N MED M MED=MEDS(RXIEN)106992 . I 'ALL,PENDING,$P(MED(100),U,2)'="PENDING" QUIT ;OHUM/RUT 3120504 ADDED FOR VALIDATION OF PENDING MEDICATIONS 106991 106993 "RTN","C0CMED1",64,0) 106992 . I 'ALL,ACTIVE,$P(MED(100),U,2)'="ACTIVE" QUIT106994 . S MEDCOUNT=MEDCOUNT+1 106993 106995 "RTN","C0CMED1",65,0) 106994 . I 'ALL,PENDING,$P(MED(100),U,2)'="PENDING" QUIT ;OHUM/RUT 3120504 ADDED FOR VALIDATION OF PENDING MEDICATIONS106996 . W:$G(DEBUG) "RXIEN IS ",RXIEN,! 106995 106997 "RTN","C0CMED1",66,0) 106996 . S M EDCOUNT=MEDCOUNT+1106998 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT)) 106997 106999 "RTN","C0CMED1",67,0) 106998 . W:$G(DEBUG) "RXIEN IS ",RXIEN,!107000 . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED 106999 107001 "RTN","C0CMED1",68,0) 107000 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))107002 . W:$G(DEBUG) "MAP= ",MAP,! 107001 107003 "RTN","C0CMED1",69,0) 107002 . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED107004 . S @MAP@("MEDOBJECTID")="MED"_MEDCOUNT ; MEDCOUNT FOR ID 107003 107005 "RTN","C0CMED1",70,0) 107004 . W:$G(DEBUG) "MAP= ",MAP,!107006 . ; S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number 107005 107007 "RTN","C0CMED1",71,0) 107006 . S @MAP@("MED OBJECTID")="MED"_MEDCOUNT ; MEDCOUNT FOR ID107008 . S @MAP@("MEDISSUEDATETXT")="Issue Date" 107007 107009 "RTN","C0CMED1",72,0) 107008 . ; S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number107010 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(1),U)) 107009 107011 "RTN","C0CMED1",73,0) 107010 . S @MAP@("MED ISSUEDATETXT")="IssueDate"107012 . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date" 107011 107013 "RTN","C0CMED1",74,0) 107012 . S @MAP@("MED ISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(1),U))107014 . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P($G(MED(101)),U)) 107013 107015 "RTN","C0CMED1",75,0) 107014 . S @MAP@("MED LASTFILLDATETXT")="Last Fill Date"107016 . S @MAP@("MEDRXNOTXT")="Prescription Number" 107015 107017 "RTN","C0CMED1",76,0) 107016 . S @MAP@("MED LASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P($G(MED(101)),U))107018 . S @MAP@("MEDRXNO")=MED(.01) 107017 107019 "RTN","C0CMED1",77,0) 107018 . S @MAP@("MED RXNOTXT")="Prescription Number"107020 . S @MAP@("MEDTYPETEXT")="Medication" 107019 107021 "RTN","C0CMED1",78,0) 107020 . S @MAP@("MED RXNO")=MED(.01)107022 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses 107021 107023 "RTN","C0CMED1",79,0) 107022 . S @MAP@("MED TYPETEXT")="Medication"107024 . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2) 107023 107025 "RTN","C0CMED1",80,0) 107024 . S @MAP@("MED DETAILUNADORNED")="" ; Leave blank, field has its uses107026 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U) 107025 107027 "RTN","C0CMED1",81,0) 107026 . S @MAP@("MED STATUSTEXT")=$P(MED(100),U,2)107028 . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2) 107027 107029 "RTN","C0CMED1",82,0) 107028 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)107030 . ; 12/30/08: I will be using RxNorm for coding... 107029 107031 "RTN","C0CMED1",83,0) 107030 . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)107032 . ; 176.001 is the file for Concepts; 176.003 is the file for 107031 107033 "RTN","C0CMED1",84,0) 107032 . ; 12/30/08: I will be using RxNorm for coding...107034 . ; sources (i.e. for RxNorm Version) 107033 107035 "RTN","C0CMED1",85,0) 107034 . ; 176.001 is the file for Concepts; 176.003 is the file for107036 . ; 107035 107037 "RTN","C0CMED1",86,0) 107036 . ; sources (i.e. for RxNorm Version)107038 . ; We need the VUID first for the National Drug File entry first 107037 107039 "RTN","C0CMED1",87,0) 107040 . ; We get the VUID of the drug, by looking up the VA Product entry 107041 "RTN","C0CMED1",88,0) 107042 . ; (file 50.68) using the call NDF^PSS50, returned in node 22. 107043 "RTN","C0CMED1",89,0) 107044 . ; Field 99.99 is the VUID. 107045 "RTN","C0CMED1",90,0) 107038 107046 . ; 107039 "RTN","C0CMED1",88,0)107040 . ; We need the VUID first for the National Drug File entry first107041 "RTN","C0CMED1",89,0)107042 . ; We get the VUID of the drug, by looking up the VA Product entry107043 "RTN","C0CMED1",90,0)107044 . ; (file 50.68) using the call NDF^PSS50, returned in node 22.107045 107047 "RTN","C0CMED1",91,0) 107046 . ; Field 99.99 is the VUID.107048 . ; We use the VUID to look up the RxNorm in file 176.001; same idea. 107047 107049 "RTN","C0CMED1",92,0) 107050 . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by 107051 "RTN","C0CMED1",93,0) 107052 . ; $$GET1^DIQ. 107053 "RTN","C0CMED1",94,0) 107048 107054 . ; 107049 "RTN","C0CMED1",93,0)107050 . ; We use the VUID to look up the RxNorm in file 176.001; same idea.107051 "RTN","C0CMED1",94,0)107052 . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by107053 107055 "RTN","C0CMED1",95,0) 107054 . ; $$GET1^DIQ.107056 . ; I get the RxNorm name and version from the RxNorm Sources (file 107055 107057 "RTN","C0CMED1",96,0) 107058 . ; 176.003), by searching for "RXNORM", then get the data. 107059 "RTN","C0CMED1",97,0) 107060 . N MEDIEN S MEDIEN=$P(MED(6),U) 107061 "RTN","C0CMED1",98,0) 107062 . D NDF^PSS50(MEDIEN,,,,,"NDF") 107063 "RTN","C0CMED1",99,0) 107064 . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN) 107065 "RTN","C0CMED1",100,0) 107066 . N NDFIEN S NDFIEN=$P(NDFDATA(20),U) 107067 "RTN","C0CMED1",101,0) 107068 . N VAPROD S VAPROD=$P(NDFDATA(22),U) 107069 "RTN","C0CMED1",102,0) 107056 107070 . ; 107057 "RTN","C0CMED1",97,0)107058 . ; I get the RxNorm name and version from the RxNorm Sources (file107059 "RTN","C0CMED1",98,0)107060 . ; 176.003), by searching for "RXNORM", then get the data.107061 "RTN","C0CMED1",99,0)107062 . N MEDIEN S MEDIEN=$P(MED(6),U)107063 "RTN","C0CMED1",100,0)107064 . D NDF^PSS50(MEDIEN,,,,,"NDF")107065 "RTN","C0CMED1",101,0)107066 . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)107067 "RTN","C0CMED1",102,0)107068 . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)107069 107071 "RTN","C0CMED1",103,0) 107070 . N VAPROD S VAPROD=$P(NDFDATA(22),U)107072 . ; NDFIEN is not necessarily defined; it won't be if the drug 107071 107073 "RTN","C0CMED1",104,0) 107074 . ; is not matched to the national drug file (e.g. if the drug is 107075 "RTN","C0CMED1",105,0) 107076 . ; new on the market, compounded, or is a fake drug [blue pill]. 107077 "RTN","C0CMED1",106,0) 107078 . ; To protect against failure, I will put an if/else block 107079 "RTN","C0CMED1",107,0) 107072 107080 . ; 107073 "RTN","C0CMED1",105,0)107074 . ; NDFIEN is not necessarily defined; it won't be if the drug107075 "RTN","C0CMED1",106,0)107076 . ; is not matched to the national drug file (e.g. if the drug is107077 "RTN","C0CMED1",107,0)107078 . ; new on the market, compounded, or is a fake drug [blue pill].107079 107081 "RTN","C0CMED1",108,0) 107080 . ; To protect against failure, I will put an if/else block107082 . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER 107081 107083 "RTN","C0CMED1",109,0) 107084 . I NDFIEN,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet. 107085 "RTN","C0CMED1",110,0) 107086 . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99) 107087 "RTN","C0CMED1",111,0) 107088 . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID") 107089 "RTN","C0CMED1",112,0) 107090 . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01) 107091 "RTN","C0CMED1",113,0) 107092 . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM") 107093 "RTN","C0CMED1",114,0) 107094 . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6) 107095 "RTN","C0CMED1",115,0) 107096 . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7) 107097 "RTN","C0CMED1",116,0) 107082 107098 . ; 107083 "RTN","C0CMED1",110,0)107084 . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER107085 "RTN","C0CMED1",111,0)107086 . I NDFIEN,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet.107087 "RTN","C0CMED1",112,0)107088 . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)107089 "RTN","C0CMED1",113,0)107090 . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")107091 "RTN","C0CMED1",114,0)107092 . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)107093 "RTN","C0CMED1",115,0)107094 . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")107095 "RTN","C0CMED1",116,0)107096 . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)107097 107099 "RTN","C0CMED1",117,0) 107098 . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)107100 . E S (RXNORM,RXNNAME,RXNVER)="" 107099 107101 "RTN","C0CMED1",118,0) 107102 . ; End if/else block 107103 "RTN","C0CMED1",119,0) 107104 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM 107105 "RTN","C0CMED1",120,0) 107106 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME 107107 "RTN","C0CMED1",121,0) 107108 . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER 107109 "RTN","C0CMED1",122,0) 107100 107110 . ; 107101 "RTN","C0CMED1",119,0)107102 . E S (RXNORM,RXNNAME,RXNVER)=""107103 "RTN","C0CMED1",120,0)107104 . ; End if/else block107105 "RTN","C0CMED1",121,0)107106 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM107107 "RTN","C0CMED1",122,0)107108 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME107109 107111 "RTN","C0CMED1",123,0) 107110 . S @MAP@("MED PRODUCTNAMECODEVERSION")=RXNVER107112 . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5) 107111 107113 "RTN","C0CMED1",124,0) 107114 . D DOSE^PSS50(MEDIEN,,,,,"DOSE") 107115 "RTN","C0CMED1",125,0) 107116 . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN) 107117 "RTN","C0CMED1",126,0) 107118 . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901) 107119 "RTN","C0CMED1",127,0) 107120 . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2) 107121 "RTN","C0CMED1",128,0) 107122 . ; Units, concentration, etc, come from another call 107123 "RTN","C0CMED1",129,0) 107124 . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit 107125 "RTN","C0CMED1",130,0) 107126 . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters 107127 "RTN","C0CMED1",131,0) 107128 . ; NDF Entry IEN, and VA Product IEN 107129 "RTN","C0CMED1",132,0) 107130 . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT") 107131 "RTN","C0CMED1",133,0) 107132 . ; These have been collected above. 107133 "RTN","C0CMED1",134,0) 107134 . N CONCDATA 107135 "RTN","C0CMED1",135,0) 107136 . ; If a drug was not matched to NDF, then the NDFIEN is gonna be "" 107137 "RTN","C0CMED1",136,0) 107138 . ; and this will crash the call. So... 107139 "RTN","C0CMED1",137,0) 107140 . I NDFIEN="" S CONCDATA="" 107141 "RTN","C0CMED1",138,0) 107142 . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD) 107143 "RTN","C0CMED1",139,0) 107144 . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1) 107145 "RTN","C0CMED1",140,0) 107146 . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3) 107147 "RTN","C0CMED1",141,0) 107148 . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4) 107149 "RTN","C0CMED1",142,0) 107150 . S @MAP@("MEDQUANTITYVALUE")=MED(7) 107151 "RTN","C0CMED1",143,0) 107152 . ; Oddly, there is no easy place to find the dispense unit. 107153 "RTN","C0CMED1",144,0) 107154 . ; It's not included in the original call, so we have to go to the drug file. 107155 "RTN","C0CMED1",145,0) 107156 . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT") 107157 "RTN","C0CMED1",146,0) 107158 . ; Node 14.5 is the Dispense Unit 107159 "RTN","C0CMED1",147,0) 107160 . D DATA^PSS50(MEDIEN,,,,,"QTY") 107161 "RTN","C0CMED1",148,0) 107162 . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN) 107163 "RTN","C0CMED1",149,0) 107164 . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5) 107165 "RTN","C0CMED1",150,0) 107112 107166 . ; 107113 "RTN","C0CMED1",125,0)107114 . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)107115 "RTN","C0CMED1",126,0)107116 . D DOSE^PSS50(MEDIEN,,,,,"DOSE")107117 "RTN","C0CMED1",127,0)107118 . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)107119 "RTN","C0CMED1",128,0)107120 . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)107121 "RTN","C0CMED1",129,0)107122 . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)107123 "RTN","C0CMED1",130,0)107124 . ; Units, concentration, etc, come from another call107125 "RTN","C0CMED1",131,0)107126 . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit107127 "RTN","C0CMED1",132,0)107128 . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters107129 "RTN","C0CMED1",133,0)107130 . ; NDF Entry IEN, and VA Product IEN107131 "RTN","C0CMED1",134,0)107132 . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")107133 "RTN","C0CMED1",135,0)107134 . ; These have been collected above.107135 "RTN","C0CMED1",136,0)107136 . N CONCDATA107137 "RTN","C0CMED1",137,0)107138 . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""107139 "RTN","C0CMED1",138,0)107140 . ; and this will crash the call. So...107141 "RTN","C0CMED1",139,0)107142 . I NDFIEN="" S CONCDATA=""107143 "RTN","C0CMED1",140,0)107144 . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)107145 "RTN","C0CMED1",141,0)107146 . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)107147 "RTN","C0CMED1",142,0)107148 . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)107149 "RTN","C0CMED1",143,0)107150 . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)107151 "RTN","C0CMED1",144,0)107152 . S @MAP@("MEDQUANTITYVALUE")=MED(7)107153 "RTN","C0CMED1",145,0)107154 . ; Oddly, there is no easy place to find the dispense unit.107155 "RTN","C0CMED1",146,0)107156 . ; It's not included in the original call, so we have to go to the drug file.107157 "RTN","C0CMED1",147,0)107158 . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")107159 "RTN","C0CMED1",148,0)107160 . ; Node 14.5 is the Dispense Unit107161 "RTN","C0CMED1",149,0)107162 . D DATA^PSS50(MEDIEN,,,,,"QTY")107163 "RTN","C0CMED1",150,0)107164 . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)107165 107167 "RTN","C0CMED1",151,0) 107166 . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)107168 . ; --- START OF DIRECTIONS --- 107167 107169 "RTN","C0CMED1",152,0) 107170 . ; Sig data not in any API :-( Oh yes, you can get the whole thing, but... 107171 "RTN","C0CMED1",153,0) 107172 . ; we want the compoenents. 107173 "RTN","C0CMED1",154,0) 107174 . ; It's in node 6 of ^PSRX(IEN) 107175 "RTN","C0CMED1",155,0) 107176 . ; So, here we go again 107177 "RTN","C0CMED1",156,0) 107178 . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE 107179 "RTN","C0CMED1",157,0) 107180 . ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4) 107181 "RTN","C0CMED1",158,0) 107182 . ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE 107183 "RTN","C0CMED1",159,0) 107184 . ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^ 107185 "RTN","C0CMED1",160,0) 107168 107186 . ; 107169 "RTN","C0CMED1",153,0)107170 . ; --- START OF DIRECTIONS ---107171 "RTN","C0CMED1",154,0)107172 . ; Sig data not in any API :-( Oh yes, you can get the whole thing, but...107173 "RTN","C0CMED1",155,0)107174 . ; we want the compoenents.107175 "RTN","C0CMED1",156,0)107176 . ; It's in node 6 of ^PSRX(IEN)107177 "RTN","C0CMED1",157,0)107178 . ; So, here we go again107179 "RTN","C0CMED1",158,0)107180 . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE107181 "RTN","C0CMED1",159,0)107182 . ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)107183 "RTN","C0CMED1",160,0)107184 . ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE107185 107187 "RTN","C0CMED1",161,0) 107186 . ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^107188 . N DIRNUM S DIRNUM=0 ; Sigline number 107187 107189 "RTN","C0CMED1",162,0) 107190 . S DIRCNT=0 ; COUNT OF MULTIPLE DIRECTIONS 107191 "RTN","C0CMED1",163,0) 107192 . F S DIRNUM=$O(^PSRX(RXIEN,6,DIRNUM)) Q:DIRNUM="" D 107193 "RTN","C0CMED1",164,0) 107194 . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT 107195 "RTN","C0CMED1",165,0) 107196 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components. 107197 "RTN","C0CMED1",166,0) 107198 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05. 107199 "RTN","C0CMED1",167,0) 107200 . . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,DIRNUM,0) 107201 "RTN","C0CMED1",168,0) 107202 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$P(SIGDATA,U,9) 107203 "RTN","C0CMED1",169,0) 107204 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$P(SIGDATA,U,1) 107205 "RTN","C0CMED1",170,0) 107206 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT") 107207 "RTN","C0CMED1",171,0) 107208 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient 107209 "RTN","C0CMED1",172,0) 107210 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient 107211 "RTN","C0CMED1",173,0) 107212 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient 107213 "RTN","C0CMED1",174,0) 107214 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01) 107215 "RTN","C0CMED1",175,0) 107216 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8) 107217 "RTN","C0CMED1",176,0) 107218 . . ; Invervals... again another call. 107219 "RTN","C0CMED1",177,0) 107220 . . ; In the wisdom of the original programmers, the schedule is a free text field 107221 "RTN","C0CMED1",178,0) 107222 . . ; However, it gets translated by a call to the administration schedule file 107223 "RTN","C0CMED1",179,0) 107224 . . ; to see if that schedule exists. 107225 "RTN","C0CMED1",180,0) 107226 . . ; That's the same thing I am going to do. 107227 "RTN","C0CMED1",181,0) 107228 . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ). 107229 "RTN","C0CMED1",182,0) 107230 . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO-- 107231 "RTN","C0CMED1",183,0) 107232 . . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in. 107233 "RTN","C0CMED1",184,0) 107234 . . ; So... 107235 "RTN","C0CMED1",185,0) 107236 . . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE") 107237 "RTN","C0CMED1",186,0) 107238 . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE") 107239 "RTN","C0CMED1",187,0) 107240 . . N INTERVAL 107241 "RTN","C0CMED1",188,0) 107242 . . I $P(SCHEDATA(0),U)=-1 S INTERVAL="" 107243 "RTN","C0CMED1",189,0) 107244 . . E D 107245 "RTN","C0CMED1",190,0) 107246 . . . N SUB S SUB=$O(SCHEDATA(0)) 107247 "RTN","C0CMED1",191,0) 107248 . . . S INTERVAL=SCHEDATA(SUB,2) 107249 "RTN","C0CMED1",192,0) 107250 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL 107251 "RTN","C0CMED1",193,0) 107252 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute" 107253 "RTN","C0CMED1",194,0) 107254 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$P(SIGDATA,U,5) 107255 "RTN","C0CMED1",195,0) 107256 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")="" 107257 "RTN","C0CMED1",196,0) 107258 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN" 107259 "RTN","C0CMED1",197,0) 107260 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")="" 107261 "RTN","C0CMED1",198,0) 107262 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")="" 107263 "RTN","C0CMED1",199,0) 107264 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")="" 107265 "RTN","C0CMED1",200,0) 107266 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")="" 107267 "RTN","C0CMED1",201,0) 107268 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")="" 107269 "RTN","C0CMED1",202,0) 107270 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")="" 107271 "RTN","C0CMED1",203,0) 107272 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")="" 107273 "RTN","C0CMED1",204,0) 107274 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" 107275 "RTN","C0CMED1",205,0) 107276 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM 107277 "RTN","C0CMED1",206,0) 107278 . . N DIRMOD S DIRMOD=$P(SIGDATA,U,6) 107279 "RTN","C0CMED1",207,0) 107280 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$S(DIRMOD="T":"THEN",DIRMOD="A":"AND",DIRMOD="X":"EXCEPT",1:"") 107281 "RTN","C0CMED1",208,0) 107188 107282 . ; 107189 "RTN","C0CMED1",163,0)107190 . N DIRNUM S DIRNUM=0 ; Sigline number107191 "RTN","C0CMED1",164,0)107192 . S DIRCNT=0 ; COUNT OF MULTIPLE DIRECTIONS107193 "RTN","C0CMED1",165,0)107194 . F S DIRNUM=$O(^PSRX(RXIEN,6,DIRNUM)) Q:DIRNUM="" D107195 "RTN","C0CMED1",166,0)107196 . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT107197 "RTN","C0CMED1",167,0)107198 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components.107199 "RTN","C0CMED1",168,0)107200 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05.107201 "RTN","C0CMED1",169,0)107202 . . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,DIRNUM,0)107203 "RTN","C0CMED1",170,0)107204 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$P(SIGDATA,U,9)107205 "RTN","C0CMED1",171,0)107206 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$P(SIGDATA,U,1)107207 "RTN","C0CMED1",172,0)107208 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")107209 "RTN","C0CMED1",173,0)107210 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient107211 "RTN","C0CMED1",174,0)107212 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient107213 "RTN","C0CMED1",175,0)107214 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient107215 "RTN","C0CMED1",176,0)107216 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)107217 "RTN","C0CMED1",177,0)107218 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)107219 "RTN","C0CMED1",178,0)107220 . . ; Invervals... again another call.107221 "RTN","C0CMED1",179,0)107222 . . ; In the wisdom of the original programmers, the schedule is a free text field107223 "RTN","C0CMED1",180,0)107224 . . ; However, it gets translated by a call to the administration schedule file107225 "RTN","C0CMED1",181,0)107226 . . ; to see if that schedule exists.107227 "RTN","C0CMED1",182,0)107228 . . ; That's the same thing I am going to do.107229 "RTN","C0CMED1",183,0)107230 . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).107231 "RTN","C0CMED1",184,0)107232 . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--107233 "RTN","C0CMED1",185,0)107234 . . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in.107235 "RTN","C0CMED1",186,0)107236 . . ; So...107237 "RTN","C0CMED1",187,0)107238 . . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE")107239 "RTN","C0CMED1",188,0)107240 . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")107241 "RTN","C0CMED1",189,0)107242 . . N INTERVAL107243 "RTN","C0CMED1",190,0)107244 . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""107245 "RTN","C0CMED1",191,0)107246 . . E D107247 "RTN","C0CMED1",192,0)107248 . . . N SUB S SUB=$O(SCHEDATA(0))107249 "RTN","C0CMED1",193,0)107250 . . . S INTERVAL=SCHEDATA(SUB,2)107251 "RTN","C0CMED1",194,0)107252 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL107253 "RTN","C0CMED1",195,0)107254 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"107255 "RTN","C0CMED1",196,0)107256 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$P(SIGDATA,U,5)107257 "RTN","C0CMED1",197,0)107258 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""107259 "RTN","C0CMED1",198,0)107260 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN"107261 "RTN","C0CMED1",199,0)107262 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""107263 "RTN","C0CMED1",200,0)107264 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""107265 "RTN","C0CMED1",201,0)107266 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""107267 "RTN","C0CMED1",202,0)107268 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""107269 "RTN","C0CMED1",203,0)107270 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""107271 "RTN","C0CMED1",204,0)107272 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""107273 "RTN","C0CMED1",205,0)107274 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""107275 "RTN","C0CMED1",206,0)107276 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")=""107277 "RTN","C0CMED1",207,0)107278 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM107279 "RTN","C0CMED1",208,0)107280 . . N DIRMOD S DIRMOD=$P(SIGDATA,U,6)107281 107283 "RTN","C0CMED1",209,0) 107282 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$S(DIRMOD="T":"THEN",DIRMOD="A":"AND",DIRMOD="X":"EXCEPT",1:"")107284 . ; --- END OF DIRECTIONS --- 107283 107285 "RTN","C0CMED1",210,0) 107284 107286 . ; 107285 107287 "RTN","C0CMED1",211,0) 107286 . ; --- END OF DIRECTIONS ---107288 . ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE" 107287 107289 "RTN","C0CMED1",212,0) 107288 . ;107290 . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0)) 107289 107291 "RTN","C0CMED1",213,0) 107290 . ; ^PSRX(22," INS1",1,0)="FOR BLOOD PRESSURE"107292 . ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command" 107291 107293 "RTN","C0CMED1",214,0) 107292 . S @MAP@("MED PTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0))107294 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0)) 107293 107295 "RTN","C0CMED1",215,0) 107294 . ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command"107296 . S @MAP@("MEDRFNO")=MED(9) 107295 107297 "RTN","C0CMED1",216,0) 107296 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0))107298 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED")) 107297 107299 "RTN","C0CMED1",217,0) 107298 . S @MAP@("MEDRFNO")=MED(9)107300 . K @RESULT 107299 107301 "RTN","C0CMED1",218,0) 107300 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))107302 . D MAP^C0CXPATH(MINXML,MAP,RESULT) 107301 107303 "RTN","C0CMED1",219,0) 107302 . K @RESULT107304 . ; MAPPING DIRECTIONS 107303 107305 "RTN","C0CMED1",220,0) 107304 . D MAP^C0CXPATH(MINXML,MAP,RESULT)107306 . N DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE 107305 107307 "RTN","C0CMED1",221,0) 107306 . ; MAPPING DIRECTIONS107308 . N DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT 107307 107309 "RTN","C0CMED1",222,0) 107308 . N DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE107310 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1) 107309 107311 "RTN","C0CMED1",223,0) 107310 . N DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT107312 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions") 107311 107313 "RTN","C0CMED1",224,0) 107312 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)107314 . ; N MDZ1,MDZNA 107313 107315 "RTN","C0CMED1",225,0) 107314 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")107316 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS 107315 107317 "RTN","C0CMED1",226,0) 107316 . ; N MDZ1,MDZNA107318 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION 107317 107319 "RTN","C0CMED1",227,0) 107318 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS107320 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1)) 107319 107321 "RTN","C0CMED1",228,0) 107320 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION107322 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2) 107321 107323 "RTN","C0CMED1",229,0) 107322 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))107324 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication") 107323 107325 "RTN","C0CMED1",230,0) 107324 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)107326 . I MEDCOUNT=1 D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy 107325 107327 "RTN","C0CMED1",231,0) 107326 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")107328 . E D INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML 107327 107329 "RTN","C0CMED1",232,0) 107328 . I MEDCOUNT=1 D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy107330 N MEDTMP,MEDI 107329 107331 "RTN","C0CMED1",233,0) 107330 . E D INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML107332 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 107331 107333 "RTN","C0CMED1",234,0) 107332 N MEDTMP,MEDI107334 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 107333 107335 "RTN","C0CMED1",235,0) 107334 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS107336 . W "MEDICATION MISSING ",! 107335 107337 "RTN","C0CMED1",236,0) 107336 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@107338 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! 107337 107339 "RTN","C0CMED1",237,0) 107338 . W "MEDICATION MISSING ",!107340 Q 107339 107341 "RTN","C0CMED1",238,0) 107340 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!107341 "RTN","C0CMED1",239,0)107342 Q107343 "RTN","C0CMED1",240,0)107344 107342 ; 107345 107343 "RTN","C0CMED2") 107346 0^50^B14 7041837107344 0^50^B145401668 107347 107345 "RTN","C0CMED2",1,0) 107348 107346 C0CMED2 ; WV/CCDCCR/SMH - CCR/CCD Meds - Pending for Vista 107349 107347 "RTN","C0CMED2",2,0) 107350 ;;1.2;C 0C;;May 11, 2012;Build 50107348 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 107351 107349 "RTN","C0CMED2",3,0) 107352 107350 ;;Last Modified Sat Jan 10 21:41:14 PST 2009 107353 107351 "RTN","C0CMED2",4,0) 107354 ; Copyright 2008 WorldVistA. Licensed under the terms of the GNU107352 ; Copyright 2008 WorldVistA. 107355 107353 "RTN","C0CMED2",5,0) 107356 ; General Public License See attached copy of the License.107354 ; 107357 107355 "RTN","C0CMED2",6,0) 107358 ; 107356 ; This program is free software: you can redistribute it and/or modify 107359 107357 "RTN","C0CMED2",7,0) 107360 ; This program is free software; you can redistribute it and/or modify107358 ; it under the terms of the GNU Affero General Public License as 107361 107359 "RTN","C0CMED2",8,0) 107362 ; it under the terms of the GNU General Public License as published by107360 ; published by the Free Software Foundation, either version 3 of the 107363 107361 "RTN","C0CMED2",9,0) 107364 ; the Free Software Foundation; either version 2 of the License, or107362 ; License, or (at your option) any later version. 107365 107363 "RTN","C0CMED2",10,0) 107366 ; (at your option) any later version.107364 ; 107367 107365 "RTN","C0CMED2",11,0) 107368 ; 107366 ; This program is distributed in the hope that it will be useful, 107369 107367 "RTN","C0CMED2",12,0) 107370 ; This program is distributed in the hope that it will be useful,107368 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 107371 107369 "RTN","C0CMED2",13,0) 107372 ; but WITHOUT ANY WARRANTY; without even the implied warranty of107370 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 107373 107371 "RTN","C0CMED2",14,0) 107374 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the107372 ; GNU Affero General Public License for more details. 107375 107373 "RTN","C0CMED2",15,0) 107376 ; GNU General Public License for more details.107374 ; 107377 107375 "RTN","C0CMED2",16,0) 107378 ; 107376 ; You should have received a copy of the GNU Affero General Public License 107379 107377 "RTN","C0CMED2",17,0) 107380 ; You should have received a copy of the GNU General Public License along107378 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 107381 107379 "RTN","C0CMED2",18,0) 107382 ; with this program; if not, write to the Free Software Foundation, Inc.,107380 ; 107383 107381 "RTN","C0CMED2",19,0) 107384 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.107382 W "NO ENTRY FROM TOP",! 107385 107383 "RTN","C0CMED2",20,0) 107386 ;107384 Q 107387 107385 "RTN","C0CMED2",21,0) 107388 W "NO ENTRY FROM TOP",!107386 ; 107389 107387 "RTN","C0CMED2",22,0) 107390 Q 107388 EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE 107391 107389 "RTN","C0CMED2",23,0) 107392 107390 ; 107393 107391 "RTN","C0CMED2",24,0) 107394 EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE 107392 ; MINXML is the Input XML Template, passed by name 107395 107393 "RTN","C0CMED2",25,0) 107396 ; 107394 ; DFN is Patient IEN (by Value) 107397 107395 "RTN","C0CMED2",26,0) 107398 ; MINXML is the Input XML Template, passed by name107396 ; OUTXML is the resultant XML (by Name) 107399 107397 "RTN","C0CMED2",27,0) 107400 ; DFN is Patient IEN (by Value)107398 ; MEDCOUNT is the current count of extracted meds, passed by Reference 107401 107399 "RTN","C0CMED2",28,0) 107402 ; OUTXML is the resultant XML (by Name)107400 ; 107403 107401 "RTN","C0CMED2",29,0) 107404 ; MED COUNT is the current count of extracted meds, passed by Reference107402 ; MEDS is return array from RPC. 107405 107403 "RTN","C0CMED2",30,0) 107406 ; 107404 ; MAP is a mapping variable map (store result) for each med 107407 107405 "RTN","C0CMED2",31,0) 107408 ; MED S is return array from RPC.107406 ; MED is holds each array element from MEDS, one medicine 107409 107407 "RTN","C0CMED2",32,0) 107410 ; MAP is a mapping variable map (store result) for each med107408 ; 107411 107409 "RTN","C0CMED2",33,0) 107412 ; MED is holds each array element from MEDS, one medicine107410 ; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending 107413 107411 "RTN","C0CMED2",34,0) 107414 ; 107412 ; meds data available. 107415 107413 "RTN","C0CMED2",35,0) 107416 ; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending107414 ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf 107417 107415 "RTN","C0CMED2",36,0) 107418 ; meds data available.107416 ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS). 107419 107417 "RTN","C0CMED2",37,0) 107420 ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf107418 ; File for pending meds is 52.41 107421 107419 "RTN","C0CMED2",38,0) 107422 ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).107420 ; Unfortuantely, API does not supply us with any useful info beyond 107423 107421 "RTN","C0CMED2",39,0) 107424 ; File for pending meds is 52.41107422 ; the IEN in 52.41, and the Med Name, and route. 107425 107423 "RTN","C0CMED2",40,0) 107426 ; Unfortuantely, API does not supply us with any useful info beyond107424 ; So, most of the info is going to get pulled from 52.41. 107427 107425 "RTN","C0CMED2",41,0) 107428 ; the IEN in 52.41, and the Med Name, and route.107426 N MEDS,MAP 107429 107427 "RTN","C0CMED2",42,0) 107430 ; So, most of the info is going to get pulled from 52.41.107428 K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!! 107431 107429 "RTN","C0CMED2",43,0) 107432 N MEDS,MAP107430 D PEN^PSO5241(DFN,"CCDCCR") 107433 107431 "RTN","C0CMED2",44,0) 107434 K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!107432 M MEDS=^TMP($J,"CCDCCR",DFN) 107435 107433 "RTN","C0CMED2",45,0) 107436 D PEN^PSO5241(DFN,"CCDCCR")107434 ; @(0) contains the number of meds or -1^NO DATA FOUND 107437 107435 "RTN","C0CMED2",46,0) 107438 M MEDS=^TMP($J,"CCDCCR",DFN)107436 ; If it is -1, we quit. 107439 107437 "RTN","C0CMED2",47,0) 107440 ; @(0) contains the number of meds or -1^NO DATA FOUND107438 I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT 107441 107439 "RTN","C0CMED2",48,0) 107442 ; If it is -1, we quit.107440 ; ZWRITE:$G(DEBUG) MEDS 107443 107441 "RTN","C0CMED2",49,0) 107444 I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT107442 N RXIEN S RXIEN=0 107445 107443 "RTN","C0CMED2",50,0) 107446 ZWRITE:$G(DEBUG) MEDS107444 N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED IN THIS SECTION FOR MERGING 107447 107445 "RTN","C0CMED2",51,0) 107448 N RXIEN S RXIEN=0107446 F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B" D ; FOR EACH MEDICATION IN THE LIST 107449 107447 "RTN","C0CMED2",52,0) 107450 N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED IN THIS SECTION FOR MERGING107448 . I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT ; Dont' want refill request as a "pending" order 107451 107449 "RTN","C0CMED2",53,0) 107452 F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B" D ; FOR EACH MEDICATION IN THE LIST107450 . S MEDCOUNT=MEDCOUNT+1 107453 107451 "RTN","C0CMED2",54,0) 107454 . I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT ; Dont' want refill request as a "pending" order107452 . I DEBUG W "RXIEN IS ",RXIEN,! 107455 107453 "RTN","C0CMED2",55,0) 107456 . S M EDCOUNT=MEDCOUNT+1107454 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT)) 107457 107455 "RTN","C0CMED2",56,0) 107458 . I DEBUG W "RXIEN IS ",RXIEN,!107456 . ; K @MAP DON'T KILL MAP HERE, IT IS DONE IN C0CMED 107459 107457 "RTN","C0CMED2",57,0) 107460 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))107458 . I DEBUG W "MAP= ",MAP,! 107461 107459 "RTN","C0CMED2",58,0) 107462 . ; K @MAP DON'T KILL MAP HERE, IT IS DONE IN C0CMED107460 . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM 107463 107461 "RTN","C0CMED2",59,0) 107464 . I DEBUG W "MAP= ",MAP,!107462 . S @MAP@("MEDOBJECTID")="MED_PENDING"_MEDCOUNT ; MEDCOUNT FOR ID 107465 107463 "RTN","C0CMED2",60,0) 107466 . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM107464 . ; S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN 107467 107465 "RTN","C0CMED2",61,0) 107468 . S @MAP@("MED OBJECTID")="MED_PENDING"_MEDCOUNT ; MEDCOUNT FOR ID107466 . S @MAP@("MEDISSUEDATETXT")="Issue Date" 107469 107467 "RTN","C0CMED2",62,0) 107470 . ; S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN107468 . ; Field 6 is "Effective date", and we pull it in timson format w/ I 107471 107469 "RTN","C0CMED2",63,0) 107472 . S @MAP@("MEDISSUEDATE TXT")="Issue Date"107470 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($$GET1^DIQ(52.41,RXIEN,6,"I"),"DT") 107473 107471 "RTN","C0CMED2",64,0) 107474 . ; Field 6 is "Effective date", and we pull it in timson format w/ I107472 . ; Med never filled; next 4 fields are not applicable. 107475 107473 "RTN","C0CMED2",65,0) 107476 . S @MAP@("MED ISSUEDATE")=$$FMDTOUTC^C0CUTIL($$GET1^DIQ(52.41,RXIEN,6,"I"),"DT")107474 . S @MAP@("MEDLASTFILLDATETXT")="" 107477 107475 "RTN","C0CMED2",66,0) 107478 . ; Med never filled; next 4 fields are not applicable.107476 . S @MAP@("MEDLASTFILLDATE")="" 107479 107477 "RTN","C0CMED2",67,0) 107480 . S @MAP@("MED LASTFILLDATETXT")=""107478 . S @MAP@("MEDRXNOTXT")="" 107481 107479 "RTN","C0CMED2",68,0) 107482 . S @MAP@("MED LASTFILLDATE")=""107480 . S @MAP@("MEDRXNO")="" 107483 107481 "RTN","C0CMED2",69,0) 107484 . S @MAP@("MED RXNOTXT")=""107482 . S @MAP@("MEDTYPETEXT")="Medication" 107485 107483 "RTN","C0CMED2",70,0) 107486 . S @MAP@("MED RXNO")=""107484 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses 107487 107485 "RTN","C0CMED2",71,0) 107488 . S @MAP@("MED TYPETEXT")="Medication"107486 . S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds 107489 107487 "RTN","C0CMED2",72,0) 107490 . S @MAP@("MED DETAILUNADORNED")="" ; Leave blank, field has its uses107488 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I") 107491 107489 "RTN","C0CMED2",73,0) 107492 . S @MAP@("MED STATUSTEXT")="On Hold" ; nearest status for pending meds107490 . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2) 107493 107491 "RTN","C0CMED2",74,0) 107494 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I")107492 . ; NDC not supplied in API, but is rather trivial to obtain 107495 107493 "RTN","C0CMED2",75,0) 107496 . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2)107494 . ; MED(11) piece 1 has the IEN of the drug (file 50) 107497 107495 "RTN","C0CMED2",76,0) 107498 . ; NDC not supplied in API, but is rather trivial to obtain107496 . ; IEN is field 31 in the drug file. 107499 107497 "RTN","C0CMED2",77,0) 107500 . ; MED(11) piece 1 has the IEN of the drug (file 50)107498 . ; 107501 107499 "RTN","C0CMED2",78,0) 107502 . ; IEN is field 31 in the drug file.107500 . ; MEDIEN (node 11 in the returned output) might not necessarily be defined 107503 107501 "RTN","C0CMED2",79,0) 107502 . ; It is not defined when a dose in not chosen in CPRS. There is a long 107503 "RTN","C0CMED2",80,0) 107504 . ; series of fields that depend on it. We will use If and Else to deal 107505 "RTN","C0CMED2",81,0) 107506 . ; with that 107507 "RTN","C0CMED2",82,0) 107508 . N MEDIEN S MEDIEN=$P(MED(11),U) 107509 "RTN","C0CMED2",83,0) 107510 . I +MEDIEN>0 D ; start of if/else block 107511 "RTN","C0CMED2",84,0) 107512 . . ; 12/30/08: I will be using RxNorm for coding... 107513 "RTN","C0CMED2",85,0) 107514 . . ; 176.001 is the file for Concepts; 176.003 is the file for 107515 "RTN","C0CMED2",86,0) 107516 . . ; sources (i.e. for RxNorm Version) 107517 "RTN","C0CMED2",87,0) 107518 . . ; 107519 "RTN","C0CMED2",88,0) 107520 . . ; We need the VUID first for the National Drug File entry first 107521 "RTN","C0CMED2",89,0) 107522 . . ; We get the VUID of the drug, by looking up the VA Product entry 107523 "RTN","C0CMED2",90,0) 107524 . . ; (file 50.68) using the call NDF^PSS50, returned in node 22. 107525 "RTN","C0CMED2",91,0) 107526 . . ; Field 99.99 is the VUID. 107527 "RTN","C0CMED2",92,0) 107528 . . ; 107529 "RTN","C0CMED2",93,0) 107530 . . ; We use the VUID to look up the RxNorm in file 176.001; same idea. 107531 "RTN","C0CMED2",94,0) 107532 . . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by 107533 "RTN","C0CMED2",95,0) 107534 . . ; $$GET1^DIQ. 107535 "RTN","C0CMED2",96,0) 107536 . . ; 107537 "RTN","C0CMED2",97,0) 107538 . . ; I get the RxNorm name and version from the RxNorm Sources (file 107539 "RTN","C0CMED2",98,0) 107540 . . ; 176.003), by searching for "RXNORM", then get the data. 107541 "RTN","C0CMED2",99,0) 107542 . . D NDF^PSS50(MEDIEN,,,,,"NDF") 107543 "RTN","C0CMED2",100,0) 107544 . . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN) 107545 "RTN","C0CMED2",101,0) 107546 . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U) 107547 "RTN","C0CMED2",102,0) 107548 . . N VAPROD S VAPROD=$P(NDFDATA(22),U) 107549 "RTN","C0CMED2",103,0) 107550 . . ; 107551 "RTN","C0CMED2",104,0) 107552 . . ; NDFIEN is not necessarily defined; it won't be if the drug 107553 "RTN","C0CMED2",105,0) 107554 . . ; is not matched to the national drug file (e.g. if the drug is 107555 "RTN","C0CMED2",106,0) 107556 . . ; new on the market, compounded, or is a fake drug [blue pill]. 107557 "RTN","C0CMED2",107,0) 107558 . . ; To protect against failure, I will put an if/else block 107559 "RTN","C0CMED2",108,0) 107560 . . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER 107561 "RTN","C0CMED2",109,0) 107562 . . I NDFIEN,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet. 107563 "RTN","C0CMED2",110,0) 107564 . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99) 107565 "RTN","C0CMED2",111,0) 107566 . . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID") 107567 "RTN","C0CMED2",112,0) 107568 . . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01) 107569 "RTN","C0CMED2",113,0) 107570 . . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM") 107571 "RTN","C0CMED2",114,0) 107572 . . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6) 107573 "RTN","C0CMED2",115,0) 107574 . . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7) 107575 "RTN","C0CMED2",116,0) 107576 . . ; 107577 "RTN","C0CMED2",117,0) 107578 . . E S (RXNORM,RXNNAME,RXNVER)="" 107579 "RTN","C0CMED2",118,0) 107580 . . ; End if/else block 107581 "RTN","C0CMED2",119,0) 107582 . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM 107583 "RTN","C0CMED2",120,0) 107584 . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME 107585 "RTN","C0CMED2",121,0) 107586 . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER 107587 "RTN","C0CMED2",122,0) 107588 . . ; 107589 "RTN","C0CMED2",123,0) 107590 . . S @MAP@("MEDBRANDNAMETEXT")="" 107591 "RTN","C0CMED2",124,0) 107592 . . D DOSE^PSS50(MEDIEN,,,,,"DOSE") 107593 "RTN","C0CMED2",125,0) 107594 . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN) 107595 "RTN","C0CMED2",126,0) 107596 . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901) 107597 "RTN","C0CMED2",127,0) 107598 . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2) 107599 "RTN","C0CMED2",128,0) 107600 . . ; Units, concentration, etc, come from another call 107601 "RTN","C0CMED2",129,0) 107602 . . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit 107603 "RTN","C0CMED2",130,0) 107604 . . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters 107605 "RTN","C0CMED2",131,0) 107606 . . ; NDF Entry IEN, and VA Product Name 107607 "RTN","C0CMED2",132,0) 107608 . . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT") 107609 "RTN","C0CMED2",133,0) 107610 . . ; Documented in the same manual; executed above. 107611 "RTN","C0CMED2",134,0) 107612 . . N CONCDATA 107613 "RTN","C0CMED2",135,0) 107614 . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be "" 107615 "RTN","C0CMED2",136,0) 107616 . . ; and this will crash the call. So... 107617 "RTN","C0CMED2",137,0) 107618 . . I NDFIEN="" S CONCDATA="" 107619 "RTN","C0CMED2",138,0) 107620 . . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD) 107621 "RTN","C0CMED2",139,0) 107622 . . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1) 107623 "RTN","C0CMED2",140,0) 107624 . . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3) 107625 "RTN","C0CMED2",141,0) 107626 . . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4) 107627 "RTN","C0CMED2",142,0) 107628 . . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12) 107629 "RTN","C0CMED2",143,0) 107630 . . ; Oddly, there is no easy place to find the dispense unit. 107631 "RTN","C0CMED2",144,0) 107632 . . ; It's not included in the original call, so we have to go to the drug file. 107633 "RTN","C0CMED2",145,0) 107634 . . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT") 107635 "RTN","C0CMED2",146,0) 107636 . . ; Node 14.5 is the Dispense Unit 107637 "RTN","C0CMED2",147,0) 107638 . . D DATA^PSS50(MEDIEN,,,,,"QTY") 107639 "RTN","C0CMED2",148,0) 107640 . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN) 107641 "RTN","C0CMED2",149,0) 107642 . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5) 107643 "RTN","C0CMED2",150,0) 107644 . E D 107645 "RTN","C0CMED2",151,0) 107646 . . S @MAP@("MEDPRODUCTNAMECODEVALUE")="" 107647 "RTN","C0CMED2",152,0) 107648 . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="" 107649 "RTN","C0CMED2",153,0) 107650 . . S @MAP@("MEDPRODUCTNAMECODEVERSION")="" 107651 "RTN","C0CMED2",154,0) 107652 . . S @MAP@("MEDBRANDNAMETEXT")="" 107653 "RTN","C0CMED2",155,0) 107654 . . S @MAP@("MEDSTRENGTHVALUE")="" 107655 "RTN","C0CMED2",156,0) 107656 . . S @MAP@("MEDSTRENGTHUNIT")="" 107657 "RTN","C0CMED2",157,0) 107658 . . S @MAP@("MEDFORMTEXT")="" 107659 "RTN","C0CMED2",158,0) 107660 . . S @MAP@("MEDCONCVALUE")="" 107661 "RTN","C0CMED2",159,0) 107662 . . S @MAP@("MEDCONCUNIT")="" 107663 "RTN","C0CMED2",160,0) 107664 . . S @MAP@("MEDSIZETEXT")="" 107665 "RTN","C0CMED2",161,0) 107666 . . S @MAP@("MEDQUANTITYVALUE")="" 107667 "RTN","C0CMED2",162,0) 107668 . . S @MAP@("MEDQUANTITYUNIT")="" 107669 "RTN","C0CMED2",163,0) 107670 . ; end of if/else block 107671 "RTN","C0CMED2",164,0) 107504 107672 . ; 107505 "RTN","C0CMED2",80,0)107506 . ; MEDIEN (node 11 in the returned output) might not necessarily be defined107507 "RTN","C0CMED2",81,0)107508 . ; It is not defined when a dose in not chosen in CPRS. There is a long107509 "RTN","C0CMED2",82,0)107510 . ; series of fields that depend on it. We will use If and Else to deal107511 "RTN","C0CMED2",83,0)107512 . ; with that107513 "RTN","C0CMED2",84,0)107514 . N MEDIEN S MEDIEN=$P(MED(11),U)107515 "RTN","C0CMED2",85,0)107516 . I +MEDIEN>0 D ; start of if/else block107517 "RTN","C0CMED2",86,0)107518 . . ; 12/30/08: I will be using RxNorm for coding...107519 "RTN","C0CMED2",87,0)107520 . . ; 176.001 is the file for Concepts; 176.003 is the file for107521 "RTN","C0CMED2",88,0)107522 . . ; sources (i.e. for RxNorm Version)107523 "RTN","C0CMED2",89,0)107524 . . ;107525 "RTN","C0CMED2",90,0)107526 . . ; We need the VUID first for the National Drug File entry first107527 "RTN","C0CMED2",91,0)107528 . . ; We get the VUID of the drug, by looking up the VA Product entry107529 "RTN","C0CMED2",92,0)107530 . . ; (file 50.68) using the call NDF^PSS50, returned in node 22.107531 "RTN","C0CMED2",93,0)107532 . . ; Field 99.99 is the VUID.107533 "RTN","C0CMED2",94,0)107534 . . ;107535 "RTN","C0CMED2",95,0)107536 . . ; We use the VUID to look up the RxNorm in file 176.001; same idea.107537 "RTN","C0CMED2",96,0)107538 . . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by107539 "RTN","C0CMED2",97,0)107540 . . ; $$GET1^DIQ.107541 "RTN","C0CMED2",98,0)107542 . . ;107543 "RTN","C0CMED2",99,0)107544 . . ; I get the RxNorm name and version from the RxNorm Sources (file107545 "RTN","C0CMED2",100,0)107546 . . ; 176.003), by searching for "RXNORM", then get the data.107547 "RTN","C0CMED2",101,0)107548 . . D NDF^PSS50(MEDIEN,,,,,"NDF")107549 "RTN","C0CMED2",102,0)107550 . . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)107551 "RTN","C0CMED2",103,0)107552 . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)107553 "RTN","C0CMED2",104,0)107554 . . N VAPROD S VAPROD=$P(NDFDATA(22),U)107555 "RTN","C0CMED2",105,0)107556 . . ;107557 "RTN","C0CMED2",106,0)107558 . . ; NDFIEN is not necessarily defined; it won't be if the drug107559 "RTN","C0CMED2",107,0)107560 . . ; is not matched to the national drug file (e.g. if the drug is107561 "RTN","C0CMED2",108,0)107562 . . ; new on the market, compounded, or is a fake drug [blue pill].107563 "RTN","C0CMED2",109,0)107564 . . ; To protect against failure, I will put an if/else block107565 "RTN","C0CMED2",110,0)107566 . . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER107567 "RTN","C0CMED2",111,0)107568 . . I NDFIEN,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet.107569 "RTN","C0CMED2",112,0)107570 . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)107571 "RTN","C0CMED2",113,0)107572 . . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")107573 "RTN","C0CMED2",114,0)107574 . . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)107575 "RTN","C0CMED2",115,0)107576 . . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")107577 "RTN","C0CMED2",116,0)107578 . . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)107579 "RTN","C0CMED2",117,0)107580 . . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)107581 "RTN","C0CMED2",118,0)107582 . . ;107583 "RTN","C0CMED2",119,0)107584 . . E S (RXNORM,RXNNAME,RXNVER)=""107585 "RTN","C0CMED2",120,0)107586 . . ; End if/else block107587 "RTN","C0CMED2",121,0)107588 . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM107589 "RTN","C0CMED2",122,0)107590 . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME107591 "RTN","C0CMED2",123,0)107592 . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER107593 "RTN","C0CMED2",124,0)107594 . . ;107595 "RTN","C0CMED2",125,0)107596 . . S @MAP@("MEDBRANDNAMETEXT")=""107597 "RTN","C0CMED2",126,0)107598 . . D DOSE^PSS50(MEDIEN,,,,,"DOSE")107599 "RTN","C0CMED2",127,0)107600 . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)107601 "RTN","C0CMED2",128,0)107602 . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)107603 "RTN","C0CMED2",129,0)107604 . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)107605 "RTN","C0CMED2",130,0)107606 . . ; Units, concentration, etc, come from another call107607 "RTN","C0CMED2",131,0)107608 . . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit107609 "RTN","C0CMED2",132,0)107610 . . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters107611 "RTN","C0CMED2",133,0)107612 . . ; NDF Entry IEN, and VA Product Name107613 "RTN","C0CMED2",134,0)107614 . . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")107615 "RTN","C0CMED2",135,0)107616 . . ; Documented in the same manual; executed above.107617 "RTN","C0CMED2",136,0)107618 . . N CONCDATA107619 "RTN","C0CMED2",137,0)107620 . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""107621 "RTN","C0CMED2",138,0)107622 . . ; and this will crash the call. So...107623 "RTN","C0CMED2",139,0)107624 . . I NDFIEN="" S CONCDATA=""107625 "RTN","C0CMED2",140,0)107626 . . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)107627 "RTN","C0CMED2",141,0)107628 . . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)107629 "RTN","C0CMED2",142,0)107630 . . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)107631 "RTN","C0CMED2",143,0)107632 . . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)107633 "RTN","C0CMED2",144,0)107634 . . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12)107635 "RTN","C0CMED2",145,0)107636 . . ; Oddly, there is no easy place to find the dispense unit.107637 "RTN","C0CMED2",146,0)107638 . . ; It's not included in the original call, so we have to go to the drug file.107639 "RTN","C0CMED2",147,0)107640 . . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")107641 "RTN","C0CMED2",148,0)107642 . . ; Node 14.5 is the Dispense Unit107643 "RTN","C0CMED2",149,0)107644 . . D DATA^PSS50(MEDIEN,,,,,"QTY")107645 "RTN","C0CMED2",150,0)107646 . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)107647 "RTN","C0CMED2",151,0)107648 . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)107649 "RTN","C0CMED2",152,0)107650 . E D107651 "RTN","C0CMED2",153,0)107652 . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""107653 "RTN","C0CMED2",154,0)107654 . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""107655 "RTN","C0CMED2",155,0)107656 . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""107657 "RTN","C0CMED2",156,0)107658 . . S @MAP@("MEDBRANDNAMETEXT")=""107659 "RTN","C0CMED2",157,0)107660 . . S @MAP@("MEDSTRENGTHVALUE")=""107661 "RTN","C0CMED2",158,0)107662 . . S @MAP@("MEDSTRENGTHUNIT")=""107663 "RTN","C0CMED2",159,0)107664 . . S @MAP@("MEDFORMTEXT")=""107665 "RTN","C0CMED2",160,0)107666 . . S @MAP@("MEDCONCVALUE")=""107667 "RTN","C0CMED2",161,0)107668 . . S @MAP@("MEDCONCUNIT")=""107669 "RTN","C0CMED2",162,0)107670 . . S @MAP@("MEDSIZETEXT")=""107671 "RTN","C0CMED2",163,0)107672 . . S @MAP@("MEDQUANTITYVALUE")=""107673 "RTN","C0CMED2",164,0)107674 . . S @MAP@("MEDQUANTITYUNIT")=""107675 107673 "RTN","C0CMED2",165,0) 107676 . ; end of if/else block107674 . ; --- START OF DIRECTIONS --- 107677 107675 "RTN","C0CMED2",166,0) 107676 . ; Sig data is not in any API. We obtain it using the IEN from 107677 "RTN","C0CMED2",167,0) 107678 . ; the PEN API to file 52.41. It's in field 3, which is a multiple. 107679 "RTN","C0CMED2",168,0) 107680 . ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT) 107681 "RTN","C0CMED2",169,0) 107682 . K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call 107683 "RTN","C0CMED2",170,0) 107684 . D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG") 107685 "RTN","C0CMED2",171,0) 107686 . N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman. 107687 "RTN","C0CMED2",172,0) 107688 . ; FMSIGNUM gets outputted as "IEN,RXIEN,". 107689 "RTN","C0CMED2",173,0) 107690 . ; DIRNUM will be first piece for IEN. 107691 "RTN","C0CMED2",174,0) 107692 . ; DIRNUM is the proper Sigline numer. 107693 "RTN","C0CMED2",175,0) 107694 . ; SIGDATA is the simplfied array. Subscripts are really field numbers 107695 "RTN","C0CMED2",176,0) 107696 . ; in subfile 52.413. 107697 "RTN","C0CMED2",177,0) 107698 . N DIRCNT S DIRCNT=0 ; COUNT OF DIRECTIONS 107699 "RTN","C0CMED2",178,0) 107700 . F S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM="" D 107701 "RTN","C0CMED2",179,0) 107702 . . N DIRNUM S DIRNUM=$P(FMSIGNUM,",") 107703 "RTN","C0CMED2",180,0) 107704 . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT 107705 "RTN","C0CMED2",181,0) 107706 . . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM) 107707 "RTN","C0CMED2",182,0) 107708 . . ; If this is an order for a refill; it's not really a new order; move on to next 107709 "RTN","C0CMED2",183,0) 107710 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components. 107711 "RTN","C0CMED2",184,0) 107712 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05. 107713 "RTN","C0CMED2",185,0) 107714 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=SIGDATA(13) 107715 "RTN","C0CMED2",186,0) 107716 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=SIGDATA(8) 107717 "RTN","C0CMED2",187,0) 107718 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT") 107719 "RTN","C0CMED2",188,0) 107720 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient 107721 "RTN","C0CMED2",189,0) 107722 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient 107723 "RTN","C0CMED2",190,0) 107724 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient 107725 "RTN","C0CMED2",191,0) 107726 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=SIGDATA(10) 107727 "RTN","C0CMED2",192,0) 107728 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=SIGDATA(1) 107729 "RTN","C0CMED2",193,0) 107730 . . ; Invervals... again another call. 107731 "RTN","C0CMED2",194,0) 107732 . . ; The schedule is a free text field 107733 "RTN","C0CMED2",195,0) 107734 . . ; However, it gets translated by a call to the administration 107735 "RTN","C0CMED2",196,0) 107736 . . ; schedule file to see if that schedule exists. 107737 "RTN","C0CMED2",197,0) 107738 . . ; That's the same thing I am going to do. 107739 "RTN","C0CMED2",198,0) 107740 . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ). 107741 "RTN","C0CMED2",199,0) 107742 . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO-- 107743 "RTN","C0CMED2",200,0) 107744 . . ; I looked), PSSFT is the name, 107745 "RTN","C0CMED2",201,0) 107746 . . ; and list is the ^TMP name to store the data in. 107747 "RTN","C0CMED2",202,0) 107748 . . ; Also, freqency may have "PRN" in it, so strip that out 107749 "RTN","C0CMED2",203,0) 107750 . . N FREQ S FREQ=SIGDATA(1) 107751 "RTN","C0CMED2",204,0) 107752 . . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp 107753 "RTN","C0CMED2",205,0) 107754 . . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE") 107755 "RTN","C0CMED2",206,0) 107756 . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE") 107757 "RTN","C0CMED2",207,0) 107758 . . N INTERVAL 107759 "RTN","C0CMED2",208,0) 107760 . . I $P(SCHEDATA(0),U)=-1 S INTERVAL="" 107761 "RTN","C0CMED2",209,0) 107762 . . E D 107763 "RTN","C0CMED2",210,0) 107764 . . . N SUB S SUB=$O(SCHEDATA(0)) 107765 "RTN","C0CMED2",211,0) 107766 . . . S INTERVAL=SCHEDATA(SUB,2) 107767 "RTN","C0CMED2",212,0) 107768 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL 107769 "RTN","C0CMED2",213,0) 107770 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute" 107771 "RTN","C0CMED2",214,0) 107772 . . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months 107773 "RTN","C0CMED2",215,0) 107774 . . N DUR S DUR=SIGDATA(2) 107775 "RTN","C0CMED2",216,0) 107776 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR)) 107777 "RTN","C0CMED2",217,0) 107778 . . N DURUNIT S DURUNIT=$E(DUR) 107779 "RTN","C0CMED2",218,0) 107780 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"") 107781 "RTN","C0CMED2",219,0) 107782 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=SIGDATA(1)["PRN" 107783 "RTN","C0CMED2",220,0) 107784 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")="" 107785 "RTN","C0CMED2",221,0) 107786 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")="" 107787 "RTN","C0CMED2",222,0) 107788 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")="" 107789 "RTN","C0CMED2",223,0) 107790 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")="" 107791 "RTN","C0CMED2",224,0) 107792 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")="" 107793 "RTN","C0CMED2",225,0) 107794 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")="" 107795 "RTN","C0CMED2",226,0) 107796 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")="" 107797 "RTN","C0CMED2",227,0) 107798 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field 107799 "RTN","C0CMED2",228,0) 107800 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM 107801 "RTN","C0CMED2",229,0) 107802 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=SIGDATA(6) 107803 "RTN","C0CMED2",230,0) 107678 107804 . ; 107679 "RTN","C0CMED2",167,0)107680 . ; --- START OF DIRECTIONS ---107681 "RTN","C0CMED2",168,0)107682 . ; Sig data is not in any API. We obtain it using the IEN from107683 "RTN","C0CMED2",169,0)107684 . ; the PEN API to file 52.41. It's in field 3, which is a multiple.107685 "RTN","C0CMED2",170,0)107686 . ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT)107687 "RTN","C0CMED2",171,0)107688 . K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call107689 "RTN","C0CMED2",172,0)107690 . D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG")107691 "RTN","C0CMED2",173,0)107692 . N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman.107693 "RTN","C0CMED2",174,0)107694 . ; FMSIGNUM gets outputted as "IEN,RXIEN,".107695 "RTN","C0CMED2",175,0)107696 . ; DIRNUM will be first piece for IEN.107697 "RTN","C0CMED2",176,0)107698 . ; DIRNUM is the proper Sigline numer.107699 "RTN","C0CMED2",177,0)107700 . ; SIGDATA is the simplfied array. Subscripts are really field numbers107701 "RTN","C0CMED2",178,0)107702 . ; in subfile 52.413.107703 "RTN","C0CMED2",179,0)107704 . N DIRCNT S DIRCNT=0 ; COUNT OF DIRECTIONS107705 "RTN","C0CMED2",180,0)107706 . F S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM="" D107707 "RTN","C0CMED2",181,0)107708 . . N DIRNUM S DIRNUM=$P(FMSIGNUM,",")107709 "RTN","C0CMED2",182,0)107710 . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT107711 "RTN","C0CMED2",183,0)107712 . . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM)107713 "RTN","C0CMED2",184,0)107714 . . ; If this is an order for a refill; it's not really a new order; move on to next107715 "RTN","C0CMED2",185,0)107716 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components.107717 "RTN","C0CMED2",186,0)107718 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05.107719 "RTN","C0CMED2",187,0)107720 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=SIGDATA(13)107721 "RTN","C0CMED2",188,0)107722 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=SIGDATA(8)107723 "RTN","C0CMED2",189,0)107724 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")107725 "RTN","C0CMED2",190,0)107726 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient107727 "RTN","C0CMED2",191,0)107728 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient107729 "RTN","C0CMED2",192,0)107730 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient107731 "RTN","C0CMED2",193,0)107732 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=SIGDATA(10)107733 "RTN","C0CMED2",194,0)107734 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=SIGDATA(1)107735 "RTN","C0CMED2",195,0)107736 . . ; Invervals... again another call.107737 "RTN","C0CMED2",196,0)107738 . . ; The schedule is a free text field107739 "RTN","C0CMED2",197,0)107740 . . ; However, it gets translated by a call to the administration107741 "RTN","C0CMED2",198,0)107742 . . ; schedule file to see if that schedule exists.107743 "RTN","C0CMED2",199,0)107744 . . ; That's the same thing I am going to do.107745 "RTN","C0CMED2",200,0)107746 . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).107747 "RTN","C0CMED2",201,0)107748 . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--107749 "RTN","C0CMED2",202,0)107750 . . ; I looked), PSSFT is the name,107751 "RTN","C0CMED2",203,0)107752 . . ; and list is the ^TMP name to store the data in.107753 "RTN","C0CMED2",204,0)107754 . . ; Also, freqency may have "PRN" in it, so strip that out107755 "RTN","C0CMED2",205,0)107756 . . N FREQ S FREQ=SIGDATA(1)107757 "RTN","C0CMED2",206,0)107758 . . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp107759 "RTN","C0CMED2",207,0)107760 . . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE")107761 "RTN","C0CMED2",208,0)107762 . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")107763 "RTN","C0CMED2",209,0)107764 . . N INTERVAL107765 "RTN","C0CMED2",210,0)107766 . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""107767 "RTN","C0CMED2",211,0)107768 . . E D107769 "RTN","C0CMED2",212,0)107770 . . . N SUB S SUB=$O(SCHEDATA(0))107771 "RTN","C0CMED2",213,0)107772 . . . S INTERVAL=SCHEDATA(SUB,2)107773 "RTN","C0CMED2",214,0)107774 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL107775 "RTN","C0CMED2",215,0)107776 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"107777 "RTN","C0CMED2",216,0)107778 . . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months107779 "RTN","C0CMED2",217,0)107780 . . N DUR S DUR=SIGDATA(2)107781 "RTN","C0CMED2",218,0)107782 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR))107783 "RTN","C0CMED2",219,0)107784 . . N DURUNIT S DURUNIT=$E(DUR)107785 "RTN","C0CMED2",220,0)107786 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"")107787 "RTN","C0CMED2",221,0)107788 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=SIGDATA(1)["PRN"107789 "RTN","C0CMED2",222,0)107790 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""107791 "RTN","C0CMED2",223,0)107792 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""107793 "RTN","C0CMED2",224,0)107794 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""107795 "RTN","C0CMED2",225,0)107796 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""107797 "RTN","C0CMED2",226,0)107798 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""107799 "RTN","C0CMED2",227,0)107800 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""107801 "RTN","C0CMED2",228,0)107802 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""107803 "RTN","C0CMED2",229,0)107804 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field107805 "RTN","C0CMED2",230,0)107806 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM107807 107805 "RTN","C0CMED2",231,0) 107808 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=SIGDATA(6)107806 . ; --- END OF DIRECTIONS --- 107809 107807 "RTN","C0CMED2",232,0) 107810 107808 . ; 107811 107809 "RTN","C0CMED2",233,0) 107812 . ; --- END OF DIRECTIONS ---107810 . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105" 107813 107811 "RTN","C0CMED2",234,0) 107814 . ;107812 . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PI",1,0)) ;GPL 107815 107813 "RTN","C0CMED2",235,0) 107816 . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"107814 . ; W @MAP@("MEDPTINSTRUCTIONS"),! 107817 107815 "RTN","C0CMED2",236,0) 107818 . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PI",1,0)) ;GPL107816 . ; S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9" 107819 107817 "RTN","C0CMED2",237,0) 107820 . ; W @MAP@("MEDPTINSTRUCTIONS"),!107818 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"SIG1",1,0)) ;GPL 107821 107819 "RTN","C0CMED2",238,0) 107822 . ; S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9"107820 . ; W @MAP@("MEDFULLFILLMENTINSTRUCTIONS"),! 107823 107821 "RTN","C0CMED2",239,0) 107824 . S @MAP@("MED FULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"SIG1",1,0)) ;GPL107822 . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13) 107825 107823 "RTN","C0CMED2",240,0) 107826 . ; W @MAP@("MEDFULLFILLMENTINSTRUCTIONS"),!107824 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED")) 107827 107825 "RTN","C0CMED2",241,0) 107828 . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13)107826 . K @RESULT 107829 107827 "RTN","C0CMED2",242,0) 107830 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))107828 . D MAP^C0CXPATH(MINXML,MAP,RESULT) 107831 107829 "RTN","C0CMED2",243,0) 107832 . K @RESULT107830 . ; D PARY^C0CXPATH(RESULT) 107833 107831 "RTN","C0CMED2",244,0) 107834 . D MAP^C0CXPATH(MINXML,MAP,RESULT)107832 . ; MAPPING DIRECTIONS 107835 107833 "RTN","C0CMED2",245,0) 107836 . ; D PARY^C0CXPATH(RESULT)107834 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE 107837 107835 "RTN","C0CMED2",246,0) 107838 . ; MAPPING DIRECTIONS107836 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT 107839 107837 "RTN","C0CMED2",247,0) 107840 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE107838 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1) 107841 107839 "RTN","C0CMED2",248,0) 107842 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT107840 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions") 107843 107841 "RTN","C0CMED2",249,0) 107844 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)107842 . ; N MDZ1,MDZNA 107845 107843 "RTN","C0CMED2",250,0) 107846 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")107844 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS 107847 107845 "RTN","C0CMED2",251,0) 107848 . ; N MDZ1,MDZNA107846 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION 107849 107847 "RTN","C0CMED2",252,0) 107850 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS107848 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1)) 107851 107849 "RTN","C0CMED2",253,0) 107852 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION107850 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2) 107853 107851 "RTN","C0CMED2",254,0) 107854 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))107852 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication") 107855 107853 "RTN","C0CMED2",255,0) 107856 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)107854 . I MEDFIRST D ; 107857 107855 "RTN","C0CMED2",256,0) 107858 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")107856 . . ;S MEDFIRST=0 ; RESET FIRST FLAG ;OHUM/RUT COMMENTED (1ST PENDING MEDICATION WAS GETTING DUPLICATED) 107859 107857 "RTN","C0CMED2",257,0) 107860 . I MEDFIRST D ;107858 . . D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy 107861 107859 "RTN","C0CMED2",258,0) 107862 . . ;S MEDFIRST=0 ; RESET FIRST FLAG ;OHUM/RUT COMMENTED (1ST PENDING MEDICATION WAS GETTING DUPLICATED)107860 . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER 107863 107861 "RTN","C0CMED2",259,0) 107864 . . D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy107862 . I MEDFIRST S MEDFIRST=0 ;OHUM/RUT ADDED 107865 107863 "RTN","C0CMED2",260,0) 107866 . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER107864 N MEDTMP,MEDI 107867 107865 "RTN","C0CMED2",261,0) 107868 . I MEDFIRST S MEDFIRST=0 ;OHUM/RUT ADDED107866 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 107869 107867 "RTN","C0CMED2",262,0) 107870 N MEDTMP,MEDI107868 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 107871 107869 "RTN","C0CMED2",263,0) 107872 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS107870 . W "Pending Medication MISSING ",! 107873 107871 "RTN","C0CMED2",264,0) 107874 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@107872 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! 107875 107873 "RTN","C0CMED2",265,0) 107876 . W "Pending Medication MISSING ",!107874 Q 107877 107875 "RTN","C0CMED2",266,0) 107878 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!107879 "RTN","C0CMED2",267,0)107880 Q107881 "RTN","C0CMED2",268,0)107882 107876 ; 107883 107877 "RTN","C0CMED3") 107884 0^51^B17 2422279107878 0^51^B170674827 107885 107879 "RTN","C0CMED3",1,0) 107886 107880 C0CMED3 ; WV/CCDCCR/SMH - Meds: Non-VA/Outside Meds for Vista 107887 107881 "RTN","C0CMED3",2,0) 107888 ;;1.2;C 0C;;May 11, 2012;Build 50107882 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 107889 107883 "RTN","C0CMED3",3,0) 107890 107884 ;;Last Modified: Sun Jan 11 05:45:03 UTC 2009 107891 107885 "RTN","C0CMED3",4,0) 107892 ; Copyright 2009 WorldVistA. Licensed under the terms of the GNU107886 ; Copyright 2009 WorldVistA. 107893 107887 "RTN","C0CMED3",5,0) 107894 ; General Public License See attached copy of the License.107888 ; 107895 107889 "RTN","C0CMED3",6,0) 107896 ; 107890 ; This program is free software: you can redistribute it and/or modify 107897 107891 "RTN","C0CMED3",7,0) 107898 ; This program is free software; you can redistribute it and/or modify107892 ; it under the terms of the GNU Affero General Public License as 107899 107893 "RTN","C0CMED3",8,0) 107900 ; it under the terms of the GNU General Public License as published by107894 ; published by the Free Software Foundation, either version 3 of the 107901 107895 "RTN","C0CMED3",9,0) 107902 ; the Free Software Foundation; either version 2 of the License, or107896 ; License, or (at your option) any later version. 107903 107897 "RTN","C0CMED3",10,0) 107904 ; (at your option) any later version.107898 ; 107905 107899 "RTN","C0CMED3",11,0) 107906 ; 107900 ; This program is distributed in the hope that it will be useful, 107907 107901 "RTN","C0CMED3",12,0) 107908 ; This program is distributed in the hope that it will be useful,107902 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 107909 107903 "RTN","C0CMED3",13,0) 107910 ; but WITHOUT ANY WARRANTY; without even the implied warranty of107904 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 107911 107905 "RTN","C0CMED3",14,0) 107912 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the107906 ; GNU Affero General Public License for more details. 107913 107907 "RTN","C0CMED3",15,0) 107914 ; GNU General Public License for more details.107908 ; 107915 107909 "RTN","C0CMED3",16,0) 107916 ; 107910 ; You should have received a copy of the GNU Affero General Public License 107917 107911 "RTN","C0CMED3",17,0) 107918 ; You should have received a copy of the GNU General Public License along107912 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 107919 107913 "RTN","C0CMED3",18,0) 107920 ; with this program; if not, write to the Free Software Foundation, Inc.,107914 ; 107921 107915 "RTN","C0CMED3",19,0) 107922 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.107916 W "NO ENTRY FROM TOP",! 107923 107917 "RTN","C0CMED3",20,0) 107924 ;107918 Q 107925 107919 "RTN","C0CMED3",21,0) 107926 W "NO ENTRY FROM TOP",!107920 ; 107927 107921 "RTN","C0CMED3",22,0) 107928 Q 107922 EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; Extract medications into provided xml template 107929 107923 "RTN","C0CMED3",23,0) 107930 107924 ; 107931 107925 "RTN","C0CMED3",24,0) 107932 EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; Extract medications into provided xml template 107926 ; MINXML is the Input XML Template, (passed by name) 107933 107927 "RTN","C0CMED3",25,0) 107934 ; 107928 ; DFN is Patient IEN (passed by value) 107935 107929 "RTN","C0CMED3",26,0) 107936 ; MINXML is the Input XML Template,(passed by name)107930 ; OUTXML is the resultant XML (passed by name) 107937 107931 "RTN","C0CMED3",27,0) 107938 ; DFN is Patient IEN (passed by value)107932 ; MEDCOUNT is the number of Meds extracted so far (passed by reference) 107939 107933 "RTN","C0CMED3",28,0) 107940 ; OUTXML is the resultant XML (passed by name)107934 ; 107941 107935 "RTN","C0CMED3",29,0) 107942 ; MED COUNT is the number of Meds extracted so far (passed by reference)107936 ; MEDS is return array from RPC. 107943 107937 "RTN","C0CMED3",30,0) 107944 ; 107938 ; MAP is a mapping variable map (store result) for each med 107945 107939 "RTN","C0CMED3",31,0) 107946 ; MED S is return array from RPC.107940 ; MED is holds each array element from MEDS, one medicine 107947 107941 "RTN","C0CMED3",32,0) 107948 ; MAP is a mapping variable map (store result) for each med107942 ; 107949 107943 "RTN","C0CMED3",33,0) 107950 ; MED is holds each array element from MEDS, one medicine107944 ; Non-VA meds don't have an API. They are stored in file 55, subfile 52.2 107951 107945 "RTN","C0CMED3",34,0) 107952 ; 107946 ; Discontinued meds are indicated by the presence of a value in fields 107953 107947 "RTN","C0CMED3",35,0) 107954 ; Non-VA meds don't have an API. They are stored in file 55, subfile 52.2107948 ; 5 or 6 (STATUS 1 or 2, and DISCONTINUED DATE) 107955 107949 "RTN","C0CMED3",36,0) 107956 ; Discontinued meds are indicated by the presence of a value in fields107950 ; Will use Fileman API GETS^DIQ 107957 107951 "RTN","C0CMED3",37,0) 107958 ; 5 or 6 (STATUS 1 or 2, and DISCONTINUED DATE)107952 ; 107959 107953 "RTN","C0CMED3",38,0) 107960 ; Will use Fileman API GETS^DIQ107954 N MEDS,MAP 107961 107955 "RTN","C0CMED3",39,0) 107962 ;107956 K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!! 107963 107957 "RTN","C0CMED3",40,0) 107964 N MEDS,MAP107958 N NVA 107965 107959 "RTN","C0CMED3",41,0) 107966 K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!107960 D GETS^DIQ(55,DFN,"52.2*","IE","NVA") ; Output in NVA in FDA array format. 107967 107961 "RTN","C0CMED3",42,0) 107968 N NVA107962 ; If NVA does not exist, then patient has no non-VA meds 107969 107963 "RTN","C0CMED3",43,0) 107970 D GETS^DIQ(55,DFN,"52.2*","IE","NVA") ; Output in NVA in FDA array format.107964 I $D(NVA)=0 S @OUTXML@(0)=0 QUIT 107971 107965 "RTN","C0CMED3",44,0) 107972 ; If NVA does not exist, then patient has no non-VA meds107966 ; Otherwise, we go on... 107973 107967 "RTN","C0CMED3",45,0) 107974 I $D(NVA)=0 S @OUTXML@(0)=0 QUIT107968 M MEDS=NVA(55.05) 107975 107969 "RTN","C0CMED3",46,0) 107976 ; Otherwise, we go on...107970 ; We are done with NVA 107977 107971 "RTN","C0CMED3",47,0) 107978 M MEDS=NVA(55.05)107972 K NVA 107979 107973 "RTN","C0CMED3",48,0) 107980 ; We are done with NVA107974 ; 107981 107975 "RTN","C0CMED3",49,0) 107982 K NVA107976 ; I DEBUG ZWRITE MEDS 107983 107977 "RTN","C0CMED3",50,0) 107984 ;107978 N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array. 107985 107979 "RTN","C0CMED3",51,0) 107986 I DEBUG ZWRITE MEDS107980 N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED PROCESSED HERE 107987 107981 "RTN","C0CMED3",52,0) 107988 N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array.107982 F S FDAIEN=$O(MEDS(FDAIEN)) Q:FDAIEN="" D ; FOR EACH MEDICATION IN THE LIST 107989 107983 "RTN","C0CMED3",53,0) 107990 N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED PROCESSED HERE107984 . N MED M MED=MEDS(FDAIEN) 107991 107985 "RTN","C0CMED3",54,0) 107992 F S FDAIEN=$O(MEDS(FDAIEN)) Q:FDAIEN="" D ; FOR EACH MEDICATION IN THE LIST107986 . I MED(5,"I")!MED(6,"I") QUIT ; If disconinued, we don't want to pull it. 107993 107987 "RTN","C0CMED3",55,0) 107994 . N MED M MED=MEDS(FDAIEN)107988 . S MEDCOUNT=MEDCOUNT+1 107995 107989 "RTN","C0CMED3",56,0) 107996 . I MED(5,"I")!MED(6,"I") QUIT ; If disconinued, we don't want to pull it.107990 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT)) 107997 107991 "RTN","C0CMED3",57,0) 107998 . S MEDCOUNT=MEDCOUNT+1107992 . N RXIEN S RXIEN=$P(FDAIEN,",") ; First piece of FDAIEN is the number of the med for this patient 107999 107993 "RTN","C0CMED3",58,0) 108000 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))107994 . I DEBUG W "RXIEN IS ",RXIEN,! 108001 107995 "RTN","C0CMED3",59,0) 108002 . N RXIEN S RXIEN=$P(FDAIEN,",") ; First piece of FDAIEN is the number of the med for this patient107996 . I DEBUG W "MAP= ",MAP,! 108003 107997 "RTN","C0CMED3",60,0) 108004 . I DEBUG W "RXIEN IS ",RXIEN,!107998 . S @MAP@("MEDOBJECTID")="MED_OUTSIDE"_MEDCOUNT ; MEDCOUNT FOR ID 108005 107999 "RTN","C0CMED3",61,0) 108006 . I DEBUG W "MAP= ",MAP,!108000 . S @MAP@("MEDISSUEDATETXT")="Documented Date" 108007 108001 "RTN","C0CMED3",62,0) 108008 . S @MAP@("MEDOBJECTID")="MED_OUTSIDE"_MEDCOUNT ; MEDCOUNT FOR ID108002 . ; Field 6 is "Effective date", and we pull it in timson format w/ I 108009 108003 "RTN","C0CMED3",63,0) 108010 . S @MAP@("MEDISSUEDATE TXT")="Documented Date"108004 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL(MED(11,"I"),"DT") 108011 108005 "RTN","C0CMED3",64,0) 108012 . ; Field 6 is "Effective date", and we pull it in timson format w/ I108006 . ; Med never filled; next 4 fields are not applicable. 108013 108007 "RTN","C0CMED3",65,0) 108014 . S @MAP@("MED ISSUEDATE")=$$FMDTOUTC^C0CUTIL(MED(11,"I"),"DT")108008 . S @MAP@("MEDLASTFILLDATETXT")="" 108015 108009 "RTN","C0CMED3",66,0) 108016 . ; Med never filled; next 4 fields are not applicable.108010 . S @MAP@("MEDLASTFILLDATE")="" 108017 108011 "RTN","C0CMED3",67,0) 108018 . S @MAP@("MED LASTFILLDATETXT")=""108012 . S @MAP@("MEDRXNOTXT")="" 108019 108013 "RTN","C0CMED3",68,0) 108020 . S @MAP@("MED LASTFILLDATE")=""108014 . S @MAP@("MEDRXNO")="" 108021 108015 "RTN","C0CMED3",69,0) 108022 . S @MAP@("MED RXNOTXT")=""108016 . S @MAP@("MEDTYPETEXT")="Medication" 108023 108017 "RTN","C0CMED3",70,0) 108024 . S @MAP@("MED RXNO")=""108018 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses 108025 108019 "RTN","C0CMED3",71,0) 108026 . S @MAP@("MED TYPETEXT")="Medication"108020 . S @MAP@("MEDSTATUSTEXT")="Active" ; nearest status for pending meds 108027 108021 "RTN","C0CMED3",72,0) 108028 . S @MAP@("MED DETAILUNADORNED")="" ; Leave blank, field has its uses108022 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_MED(12,"I") 108029 108023 "RTN","C0CMED3",73,0) 108030 . S @MAP@("MED STATUSTEXT")="Active" ; nearest status for pending meds108024 . S @MAP@("MEDPRODUCTNAMETEXT")=MED(.01,"E") 108031 108025 "RTN","C0CMED3",74,0) 108032 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_MED(12,"I")108026 . ; NDC is field 31 in the drug file. 108033 108027 "RTN","C0CMED3",75,0) 108034 . S @MAP@("MEDPRODUCTNAMETEXT")=MED(.01,"E")108028 . ; The actual drug entry in the drug file (MEDIEN) is not necessarily supplied. 108035 108029 "RTN","C0CMED3",76,0) 108036 . ; NDC is field 31 in the drug file.108030 . ; It' node 1, internal form. 108037 108031 "RTN","C0CMED3",77,0) 108038 . ; The actual drug entry in the drug file (MEDIEN) is not necessarily supplied.108032 . N MEDIEN S MEDIEN=MED(1,"I") 108039 108033 "RTN","C0CMED3",78,0) 108040 . ; It' node 1, internal form.108034 . I +MEDIEN D ; start of if/else block 108041 108035 "RTN","C0CMED3",79,0) 108042 . N MEDIEN S MEDIEN=MED(1,"I")108036 . . ; 12/30/08: I will be using RxNorm for coding... 108043 108037 "RTN","C0CMED3",80,0) 108044 . I +MEDIEN D ; start of if/else block108038 . . ; 176.001 is the file for Concepts; 176.003 is the file for 108045 108039 "RTN","C0CMED3",81,0) 108046 . . ; 12/30/08: I will be using RxNorm for coding...108040 . . ; sources (i.e. for RxNorm Version) 108047 108041 "RTN","C0CMED3",82,0) 108048 . . ; 176.001 is the file for Concepts; 176.003 is the file for108042 . . ; 108049 108043 "RTN","C0CMED3",83,0) 108050 . . ; sources (i.e. for RxNorm Version)108044 . . ; We need the VUID first for the National Drug File entry first 108051 108045 "RTN","C0CMED3",84,0) 108046 . . ; We get the VUID of the drug, by looking up the VA Product entry 108047 "RTN","C0CMED3",85,0) 108048 . . ; (file 50.68) using the call NDF^PSS50, returned in node 22. 108049 "RTN","C0CMED3",86,0) 108050 . . ; Field 99.99 is the VUID. 108051 "RTN","C0CMED3",87,0) 108052 108052 . . ; 108053 "RTN","C0CMED3",85,0)108054 . . ; We need the VUID first for the National Drug File entry first108055 "RTN","C0CMED3",86,0)108056 . . ; We get the VUID of the drug, by looking up the VA Product entry108057 "RTN","C0CMED3",87,0)108058 . . ; (file 50.68) using the call NDF^PSS50, returned in node 22.108059 108053 "RTN","C0CMED3",88,0) 108060 . . ; Field 99.99 is the VUID.108054 . . ; We use the VUID to look up the RxNorm in file 176.001; same idea. 108061 108055 "RTN","C0CMED3",89,0) 108056 . . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by 108057 "RTN","C0CMED3",90,0) 108058 . . ; $$GET1^DIQ. 108059 "RTN","C0CMED3",91,0) 108062 108060 . . ; 108063 "RTN","C0CMED3",90,0)108064 . . ; We use the VUID to look up the RxNorm in file 176.001; same idea.108065 "RTN","C0CMED3",91,0)108066 . . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by108067 108061 "RTN","C0CMED3",92,0) 108068 . . ; $$GET1^DIQ.108062 . . ; I get the RxNorm name and version from the RxNorm Sources (file 108069 108063 "RTN","C0CMED3",93,0) 108064 . . ; 176.003), by searching for "RXNORM", then get the data. 108065 "RTN","C0CMED3",94,0) 108066 . . ; NDF^PSS50 ONLY EXISTS ON VISTA 108067 "RTN","C0CMED3",95,0) 108068 . . N NDFDATA,NDFIEN,VAPROD 108069 "RTN","C0CMED3",96,0) 108070 . . S NDFIEN="" 108071 "RTN","C0CMED3",97,0) 108072 . . I '$$RPMS^C0CUTIL() D 108073 "RTN","C0CMED3",98,0) 108074 . . . D NDF^PSS50(MEDIEN,,,,,"NDF") 108075 "RTN","C0CMED3",99,0) 108076 . . . ;N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN) 108077 "RTN","C0CMED3",100,0) 108078 . . . ;N NDFIEN S NDFIEN=$P(NDFDATA(20),U) 108079 "RTN","C0CMED3",101,0) 108080 . . . ;N VAPROD S VAPROD=$P(NDFDATA(22),U) 108081 "RTN","C0CMED3",102,0) 108082 . . . M NDFDATA=^TMP($J,"NDF",MEDIEN) 108083 "RTN","C0CMED3",103,0) 108084 . . . S NDFIEN=$P(NDFDATA(20),U) 108085 "RTN","C0CMED3",104,0) 108086 . . . S VAPROD=$P(NDFDATA(22),U) 108087 "RTN","C0CMED3",105,0) 108088 . . . S @MAP@("MEDPRODUCTNAMETEXT")=$$GET1^DIQ(50.68,VAPROD,.01) ; 108089 "RTN","C0CMED3",106,0) 108090 . . ; GPL - RESET THE NAME TO THE REAL NAME OF THE DRUG NOW THAT WE 108091 "RTN","C0CMED3",107,0) 108092 . . ; HAVE IT. 108093 "RTN","C0CMED3",108,0) 108070 108094 . . ; 108071 "RTN","C0CMED3",94,0) 108072 . . ; I get the RxNorm name and version from the RxNorm Sources (file 108073 "RTN","C0CMED3",95,0) 108074 . . ; 176.003), by searching for "RXNORM", then get the data. 108075 "RTN","C0CMED3",96,0) 108076 . . ; NDF^PSS50 ONLY EXISTS ON VISTA 108077 "RTN","C0CMED3",97,0) 108078 . . N NDFDATA,NDFIEN,VAPROD 108079 "RTN","C0CMED3",98,0) 108080 . . S NDFIEN="" 108081 "RTN","C0CMED3",99,0) 108095 "RTN","C0CMED3",109,0) 108096 . . ; NDFIEN is not necessarily defined; it won't be if the drug 108097 "RTN","C0CMED3",110,0) 108098 . . ; is not matched to the national drug file (e.g. if the drug is 108099 "RTN","C0CMED3",111,0) 108100 . . ; new on the market, compounded, or is a fake drug [blue pill]. 108101 "RTN","C0CMED3",112,0) 108102 . . ; To protect against failure, I will put an if/else block 108103 "RTN","C0CMED3",113,0) 108104 . . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER 108105 "RTN","C0CMED3",114,0) 108106 . . ; 108107 "RTN","C0CMED3",115,0) 108108 . . ; begin changes for systems that have eRx installed 108109 "RTN","C0CMED3",116,0) 108110 . . ; RxNorm is found in the ^C0P("RXN") global - gpl 108111 "RTN","C0CMED3",117,0) 108112 . . ; 108113 "RTN","C0CMED3",118,0) 108114 . . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION 108115 "RTN","C0CMED3",119,0) 108116 . . S (ZC,ZCD,ZCDS,ZCDSV)="" ; INITIALIZE 108117 "RTN","C0CMED3",120,0) 108118 . . S (RXNORM,RXNNAME,RXNVER)="" ;INITIALIZE 108119 "RTN","C0CMED3",121,0) 108120 . . I NDFIEN,$D(^C0P("RXN")) D ; 108121 "RTN","C0CMED3",122,0) 108122 . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99) 108123 "RTN","C0CMED3",123,0) 108124 . . . S ZC=$$CODE^C0CUTIL(VUID) 108125 "RTN","C0CMED3",124,0) 108126 . . . S ZCD=$P(ZC,"^",1) ; CODE TO USE 108127 "RTN","C0CMED3",125,0) 108128 . . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID 108129 "RTN","C0CMED3",126,0) 108130 . . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION 108131 "RTN","C0CMED3",127,0) 108132 . . . S RXNORM=ZCD ; THE CODE 108133 "RTN","C0CMED3",128,0) 108134 . . . S RXNNAME=ZCDS ; THE CODING SYSTEM 108135 "RTN","C0CMED3",129,0) 108136 . . . S RXNVER=ZCDSV ; THE CODING SYSTEM VERSION 108137 "RTN","C0CMED3",130,0) 108138 . . . N ZGMED S ZGMED=@MAP@("MEDPRODUCTNAMETEXT") 108139 "RTN","C0CMED3",131,0) 108140 . . . S @MAP@("MEDPRODUCTNAMETEXT")=ZGMED_" "_ZCDS_": "_ZCD 108141 "RTN","C0CMED3",132,0) 108142 . . E I NDFIEN,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet. 108143 "RTN","C0CMED3",133,0) 108144 . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99) 108145 "RTN","C0CMED3",134,0) 108146 . . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID") 108147 "RTN","C0CMED3",135,0) 108148 . . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01) 108149 "RTN","C0CMED3",136,0) 108150 . . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM") 108151 "RTN","C0CMED3",137,0) 108152 . . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6) 108153 "RTN","C0CMED3",138,0) 108154 . . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7) 108155 "RTN","C0CMED3",139,0) 108156 . . ; 108157 "RTN","C0CMED3",140,0) 108158 . . ;E S (RXNORM,RXNNAME,RXNVER)="" 108159 "RTN","C0CMED3",141,0) 108160 . . ; End if/else block 108161 "RTN","C0CMED3",142,0) 108162 . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM 108163 "RTN","C0CMED3",143,0) 108164 . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME 108165 "RTN","C0CMED3",144,0) 108166 . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER 108167 "RTN","C0CMED3",145,0) 108168 . . ; 108169 "RTN","C0CMED3",146,0) 108170 . . S @MAP@("MEDBRANDNAMETEXT")="" 108171 "RTN","C0CMED3",147,0) 108172 . . ; DOSE^PSS50 ONLY ESISTS ON VISTA 108173 "RTN","C0CMED3",148,0) 108082 108174 . . I '$$RPMS^C0CUTIL() D 108083 "RTN","C0CMED3",100,0) 108084 . . . D NDF^PSS50(MEDIEN,,,,,"NDF") 108085 "RTN","C0CMED3",101,0) 108086 . . . ;N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN) 108087 "RTN","C0CMED3",102,0) 108088 . . . ;N NDFIEN S NDFIEN=$P(NDFDATA(20),U) 108089 "RTN","C0CMED3",103,0) 108090 . . . ;N VAPROD S VAPROD=$P(NDFDATA(22),U) 108091 "RTN","C0CMED3",104,0) 108092 . . . M NDFDATA=^TMP($J,"NDF",MEDIEN) 108093 "RTN","C0CMED3",105,0) 108094 . . . S NDFIEN=$P(NDFDATA(20),U) 108095 "RTN","C0CMED3",106,0) 108096 . . . S VAPROD=$P(NDFDATA(22),U) 108097 "RTN","C0CMED3",107,0) 108098 . . . S @MAP@("MEDPRODUCTNAMETEXT")=$$GET1^DIQ(50.68,VAPROD,.01) ; 108099 "RTN","C0CMED3",108,0) 108100 . . ; GPL - RESET THE NAME TO THE REAL NAME OF THE DRUG NOW THAT WE 108101 "RTN","C0CMED3",109,0) 108102 . . ; HAVE IT. 108103 "RTN","C0CMED3",110,0) 108175 "RTN","C0CMED3",149,0) 108176 . . . D DOSE^PSS50(MEDIEN,,,,,"DOSE") 108177 "RTN","C0CMED3",150,0) 108178 . . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN) 108179 "RTN","C0CMED3",151,0) 108180 . . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901) 108181 "RTN","C0CMED3",152,0) 108182 . . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2) 108183 "RTN","C0CMED3",153,0) 108184 . . E S @MAP@("MEDSTRENGTHVALUE")="" S @MAP@("MEDSTRENGTHUNIT")="" 108185 "RTN","C0CMED3",154,0) 108186 . . ; Units, concentration, etc, come from another call 108187 "RTN","C0CMED3",155,0) 108188 . . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit 108189 "RTN","C0CMED3",156,0) 108190 . . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters 108191 "RTN","C0CMED3",157,0) 108192 . . ; NDF Entry IEN, and VA Product Name 108193 "RTN","C0CMED3",158,0) 108194 . . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT") 108195 "RTN","C0CMED3",159,0) 108196 . . ; Documented in the same manual; executed above. 108197 "RTN","C0CMED3",160,0) 108104 108198 . . ; 108105 "RTN","C0CMED3",111,0) 108106 . . ; NDFIEN is not necessarily defined; it won't be if the drug 108107 "RTN","C0CMED3",112,0) 108108 . . ; is not matched to the national drug file (e.g. if the drug is 108109 "RTN","C0CMED3",113,0) 108110 . . ; new on the market, compounded, or is a fake drug [blue pill]. 108111 "RTN","C0CMED3",114,0) 108112 . . ; To protect against failure, I will put an if/else block 108113 "RTN","C0CMED3",115,0) 108114 . . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER 108115 "RTN","C0CMED3",116,0) 108116 . . ; 108117 "RTN","C0CMED3",117,0) 108118 . . ; begin changes for systems that have eRx installed 108119 "RTN","C0CMED3",118,0) 108120 . . ; RxNorm is found in the ^C0P("RXN") global - gpl 108121 "RTN","C0CMED3",119,0) 108122 . . ; 108123 "RTN","C0CMED3",120,0) 108124 . . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION 108125 "RTN","C0CMED3",121,0) 108126 . . S (ZC,ZCD,ZCDS,ZCDSV)="" ; INITIALIZE 108127 "RTN","C0CMED3",122,0) 108128 . . S (RXNORM,RXNNAME,RXNVER)="" ;INITIALIZE 108129 "RTN","C0CMED3",123,0) 108130 . . I NDFIEN,$D(^C0P("RXN")) D ; 108131 "RTN","C0CMED3",124,0) 108132 . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99) 108133 "RTN","C0CMED3",125,0) 108134 . . . S ZC=$$CODE^C0CUTIL(VUID) 108135 "RTN","C0CMED3",126,0) 108136 . . . S ZCD=$P(ZC,"^",1) ; CODE TO USE 108137 "RTN","C0CMED3",127,0) 108138 . . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID 108139 "RTN","C0CMED3",128,0) 108140 . . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION 108141 "RTN","C0CMED3",129,0) 108142 . . . S RXNORM=ZCD ; THE CODE 108143 "RTN","C0CMED3",130,0) 108144 . . . S RXNNAME=ZCDS ; THE CODING SYSTEM 108145 "RTN","C0CMED3",131,0) 108146 . . . S RXNVER=ZCDSV ; THE CODING SYSTEM VERSION 108147 "RTN","C0CMED3",132,0) 108148 . . . N ZGMED S ZGMED=@MAP@("MEDPRODUCTNAMETEXT") 108149 "RTN","C0CMED3",133,0) 108150 . . . S @MAP@("MEDPRODUCTNAMETEXT")=ZGMED_" "_ZCDS_": "_ZCD 108151 "RTN","C0CMED3",134,0) 108152 . . E I NDFIEN,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet. 108153 "RTN","C0CMED3",135,0) 108154 . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99) 108155 "RTN","C0CMED3",136,0) 108156 . . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID") 108157 "RTN","C0CMED3",137,0) 108158 . . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01) 108159 "RTN","C0CMED3",138,0) 108160 . . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM") 108161 "RTN","C0CMED3",139,0) 108162 . . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6) 108163 "RTN","C0CMED3",140,0) 108164 . . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7) 108165 "RTN","C0CMED3",141,0) 108166 . . ; 108167 "RTN","C0CMED3",142,0) 108168 . . ;E S (RXNORM,RXNNAME,RXNVER)="" 108169 "RTN","C0CMED3",143,0) 108170 . . ; End if/else block 108171 "RTN","C0CMED3",144,0) 108172 . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM 108173 "RTN","C0CMED3",145,0) 108174 . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME 108175 "RTN","C0CMED3",146,0) 108176 . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER 108177 "RTN","C0CMED3",147,0) 108178 . . ; 108179 "RTN","C0CMED3",148,0) 108199 "RTN","C0CMED3",161,0) 108200 . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be "" 108201 "RTN","C0CMED3",162,0) 108202 . . ; and this will crash the call. So... 108203 "RTN","C0CMED3",163,0) 108204 . . I NDFIEN="" S CONCDATA="" 108205 "RTN","C0CMED3",164,0) 108206 . . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD) 108207 "RTN","C0CMED3",165,0) 108208 . . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1) 108209 "RTN","C0CMED3",166,0) 108210 . . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3) 108211 "RTN","C0CMED3",167,0) 108212 . . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4) 108213 "RTN","C0CMED3",168,0) 108214 . . S @MAP@("MEDQUANTITYVALUE")="" ; not provided for in Non-VA meds. 108215 "RTN","C0CMED3",169,0) 108216 . . ; Oddly, there is no easy place to find the dispense unit. 108217 "RTN","C0CMED3",170,0) 108218 . . ; It's not included in the original call, so we have to go to the drug file. 108219 "RTN","C0CMED3",171,0) 108220 . . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT") 108221 "RTN","C0CMED3",172,0) 108222 . . ; Node 14.5 is the Dispense Unit 108223 "RTN","C0CMED3",173,0) 108224 . . ; PSS50 ONLY EXISTS ON VISTA 108225 "RTN","C0CMED3",174,0) 108226 . . I '$$RPMS^C0CUTIL() D 108227 "RTN","C0CMED3",175,0) 108228 . . . D DATA^PSS50(MEDIEN,,,,,"QTY") 108229 "RTN","C0CMED3",176,0) 108230 . . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN) 108231 "RTN","C0CMED3",177,0) 108232 . . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5) 108233 "RTN","C0CMED3",178,0) 108234 . . E S @MAP@("MEDQUANTITYUNIT")="" 108235 "RTN","C0CMED3",179,0) 108236 . . S @MAP@("MEDQUANTITYUNIT")="" ; don't show these 108237 "RTN","C0CMED3",180,0) 108238 . E D 108239 "RTN","C0CMED3",181,0) 108240 . . S @MAP@("MEDPRODUCTNAMECODEVALUE")="" 108241 "RTN","C0CMED3",182,0) 108242 . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="" 108243 "RTN","C0CMED3",183,0) 108244 . . S @MAP@("MEDPRODUCTNAMECODEVERSION")="" 108245 "RTN","C0CMED3",184,0) 108180 108246 . . S @MAP@("MEDBRANDNAMETEXT")="" 108181 "RTN","C0CMED3",149,0)108182 . . ; DOSE^PSS50 ONLY ESISTS ON VISTA108183 "RTN","C0CMED3",150,0)108184 . . I '$$RPMS^C0CUTIL() D108185 "RTN","C0CMED3",151,0)108186 . . . D DOSE^PSS50(MEDIEN,,,,,"DOSE")108187 "RTN","C0CMED3",152,0)108188 . . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)108189 "RTN","C0CMED3",153,0)108190 . . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)108191 "RTN","C0CMED3",154,0)108192 . . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)108193 "RTN","C0CMED3",155,0)108194 . . E S @MAP@("MEDSTRENGTHVALUE")="" S @MAP@("MEDSTRENGTHUNIT")=""108195 "RTN","C0CMED3",156,0)108196 . . ; Units, concentration, etc, come from another call108197 "RTN","C0CMED3",157,0)108198 . . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit108199 "RTN","C0CMED3",158,0)108200 . . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters108201 "RTN","C0CMED3",159,0)108202 . . ; NDF Entry IEN, and VA Product Name108203 "RTN","C0CMED3",160,0)108204 . . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")108205 "RTN","C0CMED3",161,0)108206 . . ; Documented in the same manual; executed above.108207 "RTN","C0CMED3",162,0)108208 . . ;108209 "RTN","C0CMED3",163,0)108210 . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""108211 "RTN","C0CMED3",164,0)108212 . . ; and this will crash the call. So...108213 "RTN","C0CMED3",165,0)108214 . . I NDFIEN="" S CONCDATA=""108215 "RTN","C0CMED3",166,0)108216 . . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)108217 "RTN","C0CMED3",167,0)108218 . . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)108219 "RTN","C0CMED3",168,0)108220 . . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)108221 "RTN","C0CMED3",169,0)108222 . . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)108223 "RTN","C0CMED3",170,0)108224 . . S @MAP@("MEDQUANTITYVALUE")="" ; not provided for in Non-VA meds.108225 "RTN","C0CMED3",171,0)108226 . . ; Oddly, there is no easy place to find the dispense unit.108227 "RTN","C0CMED3",172,0)108228 . . ; It's not included in the original call, so we have to go to the drug file.108229 "RTN","C0CMED3",173,0)108230 . . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")108231 "RTN","C0CMED3",174,0)108232 . . ; Node 14.5 is the Dispense Unit108233 "RTN","C0CMED3",175,0)108234 . . ; PSS50 ONLY EXISTS ON VISTA108235 "RTN","C0CMED3",176,0)108236 . . I '$$RPMS^C0CUTIL() D108237 "RTN","C0CMED3",177,0)108238 . . . D DATA^PSS50(MEDIEN,,,,,"QTY")108239 "RTN","C0CMED3",178,0)108240 . . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)108241 "RTN","C0CMED3",179,0)108242 . . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)108243 "RTN","C0CMED3",180,0)108244 . . E S @MAP@("MEDQUANTITYUNIT")=""108245 "RTN","C0CMED3",181,0)108246 . . S @MAP@("MEDQUANTITYUNIT")="" ; don't show these108247 "RTN","C0CMED3",182,0)108248 . E D108249 "RTN","C0CMED3",183,0)108250 . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""108251 "RTN","C0CMED3",184,0)108252 . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""108253 108247 "RTN","C0CMED3",185,0) 108254 . . S @MAP@("MED PRODUCTNAMECODEVERSION")=""108248 . . S @MAP@("MEDSTRENGTHVALUE")="" 108255 108249 "RTN","C0CMED3",186,0) 108256 . . S @MAP@("MED BRANDNAMETEXT")=""108250 . . S @MAP@("MEDSTRENGTHUNIT")="" 108257 108251 "RTN","C0CMED3",187,0) 108258 . . S @MAP@("MED STRENGTHVALUE")=""108252 . . S @MAP@("MEDFORMTEXT")="" 108259 108253 "RTN","C0CMED3",188,0) 108260 . . S @MAP@("MED STRENGTHUNIT")=""108254 . . S @MAP@("MEDCONCVALUE")="" 108261 108255 "RTN","C0CMED3",189,0) 108262 . . S @MAP@("MED FORMTEXT")=""108256 . . S @MAP@("MEDCONCUNIT")="" 108263 108257 "RTN","C0CMED3",190,0) 108264 . . S @MAP@("MED CONCVALUE")=""108258 . . S @MAP@("MEDSIZETEXT")="" 108265 108259 "RTN","C0CMED3",191,0) 108266 . . S @MAP@("MED CONCUNIT")=""108260 . . S @MAP@("MEDQUANTITYVALUE")="" 108267 108261 "RTN","C0CMED3",192,0) 108268 . . S @MAP@("MED SIZETEXT")=""108262 . . S @MAP@("MEDQUANTITYUNIT")="" 108269 108263 "RTN","C0CMED3",193,0) 108270 . . S @MAP@("MEDQUANTITYVALUE")=""108264 . ; End If/Else 108271 108265 "RTN","C0CMED3",194,0) 108272 . . S @MAP@("MEDQUANTITYUNIT")=""108266 . ; --- START OF DIRECTIONS --- 108273 108267 "RTN","C0CMED3",195,0) 108274 . ; End If/Else108268 . ; Dosage is field 2, route is 3, schedule is 4 108275 108269 "RTN","C0CMED3",196,0) 108276 . ; --- START OF DIRECTIONS ---108270 . ; These are all free text fields, and don't point to any files 108277 108271 "RTN","C0CMED3",197,0) 108278 . ; Dosage is field 2, route is 3, schedule is 4108272 . ; For that reason, I will use the field I never used before: 108279 108273 "RTN","C0CMED3",198,0) 108280 . ; These are all free text fields, and don't point to any files108274 . ; MEDDIRECTIONDESCRIPTIONTEXT 108281 108275 "RTN","C0CMED3",199,0) 108282 . ; For that reason, I will use the field I never used before:108276 . S DIRCNT=1 ; THERE IS ONLY ONE DIRECTION FOR OUTSIDE MEDS 108283 108277 "RTN","C0CMED3",200,0) 108284 . ; MEDDIRECTIONDESCRIPTIONTEXT108278 . ; 108285 108279 "RTN","C0CMED3",201,0) 108286 . S DIRCNT=1 ; THERE IS ONLY ONE DIRECTION FOR OUTSIDE MEDS108280 . ; change for eRx meds - gpl 6/25/2011 108287 108281 "RTN","C0CMED3",202,0) 108288 108282 . ; 108289 108283 "RTN","C0CMED3",203,0) 108290 . ; change for eRx meds - gpl 6/25/2011108284 . N ZERX S ZERX=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E") 108291 108285 "RTN","C0CMED3",204,0) 108286 . I ZERX["|" S ZERX=$P(ZERX,"|",2) ; GET RID OF MED NAME 108287 "RTN","C0CMED3",205,0) 108288 . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=ZERX 108289 "RTN","C0CMED3",206,0) 108290 . N ZERX2 S ZERX2=$P(MED(2,"E"),"|",2) ; sig for quantity 108291 "RTN","C0CMED3",207,0) 108292 . N ZFDBDRUG S ZFDBDRUG=$P(MED(2,"E"),"|",1) ; FDB DRUG NAME 108293 "RTN","C0CMED3",208,0) 108294 . I @MAP@("MEDPRODUCTNAMETEXT")["FREE TXT" D ; FIX THE DRUG NAME 108295 "RTN","C0CMED3",209,0) 108296 . . S @MAP@("MEDPRODUCTNAMETEXT")=ZFDBDRUG ; USE FDB NAME 108297 "RTN","C0CMED3",210,0) 108298 . . S RXNORM=$P($P($G(MED(14,7)),"RXNORM:",2)," ",1) ; THE RXNORM 108299 "RTN","C0CMED3",211,0) 108300 . . S RXNORM=$$NISTMAP^C0CUTIL(RXNORM) ; CHANGE IF NECESSARY 108301 "RTN","C0CMED3",212,0) 108302 . . I RXNORM'="" D ; 108303 "RTN","C0CMED3",213,0) 108304 . . . W !,"FOUND FREE TEXT RXNORM:",RXNORM 108305 "RTN","C0CMED3",214,0) 108306 . . . S RXNNAME="RXNORM" ; THE CODING SYSTEM 108307 "RTN","C0CMED3",215,0) 108308 . . . S RXNVER="" ; THE CODING SYSTEM VERSION 108309 "RTN","C0CMED3",216,0) 108310 . . . N ZGMED S ZGMED=@MAP@("MEDPRODUCTNAMETEXT") 108311 "RTN","C0CMED3",217,0) 108312 . . . S @MAP@("MEDPRODUCTNAMETEXT")=ZGMED_" "_RXNNAME_": "_RXNORM 108313 "RTN","C0CMED3",218,0) 108314 . . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM 108315 "RTN","C0CMED3",219,0) 108316 . . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME 108317 "RTN","C0CMED3",220,0) 108318 . . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER 108319 "RTN","C0CMED3",221,0) 108320 . . . I RXNORM["979334" D ; PATCH FOR CERTIFICATION 108321 "RTN","C0CMED3",222,0) 108322 . . . . S @MAP@("MEDSTRENGTHVALUE")=650 108323 "RTN","C0CMED3",223,0) 108324 . . . . S @MAP@("MEDSTRENGTHUNIT")="mcg" 108325 "RTN","C0CMED3",224,0) 108326 . . . . S @MAP@("MEDFORMTEXT")="INHALER" 108327 "RTN","C0CMED3",225,0) 108328 . S @MAP@("MEDQUANTITYUNIT")=$P(ZERX2," ",3) ; THE UNITS 108329 "RTN","C0CMED3",226,0) 108330 . S @MAP@("MEDQUANTITYVALUE")=$P(ZERX2," ",2) ; THE QUANTITY 108331 "RTN","C0CMED3",227,0) 108332 . I @MAP@("MEDFORMTEXT")="" S @MAP@("MEDFORMTEXT")=$P(ZERX2," ",3) ; 108333 "RTN","C0CMED3",228,0) 108334 . ;S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E") 108335 "RTN","C0CMED3",229,0) 108336 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4" ; means look in description text. See E2369-05. 108337 "RTN","C0CMED3",230,0) 108338 . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")="" 108339 "RTN","C0CMED3",231,0) 108340 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")="" 108341 "RTN","C0CMED3",232,0) 108342 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")="" 108343 "RTN","C0CMED3",233,0) 108344 . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")="" 108345 "RTN","C0CMED3",234,0) 108346 . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")="" 108347 "RTN","C0CMED3",235,0) 108348 . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")="" 108349 "RTN","C0CMED3",236,0) 108350 . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")="" 108351 "RTN","C0CMED3",237,0) 108352 . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")="" 108353 "RTN","C0CMED3",238,0) 108354 . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")="" 108355 "RTN","C0CMED3",239,0) 108356 . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")="" 108357 "RTN","C0CMED3",240,0) 108358 . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")="" 108359 "RTN","C0CMED3",241,0) 108360 . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")="" 108361 "RTN","C0CMED3",242,0) 108362 . S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")="" 108363 "RTN","C0CMED3",243,0) 108364 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")="" 108365 "RTN","C0CMED3",244,0) 108366 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")="" 108367 "RTN","C0CMED3",245,0) 108368 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")="" 108369 "RTN","C0CMED3",246,0) 108370 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")="" 108371 "RTN","C0CMED3",247,0) 108372 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")="" 108373 "RTN","C0CMED3",248,0) 108374 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")="" 108375 "RTN","C0CMED3",249,0) 108376 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")="" 108377 "RTN","C0CMED3",250,0) 108378 . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")="" 108379 "RTN","C0CMED3",251,0) 108380 . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")="" 108381 "RTN","C0CMED3",252,0) 108382 . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")="" 108383 "RTN","C0CMED3",253,0) 108292 108384 . ; 108293 "RTN","C0CMED3",205,0)108294 . N ZERX S ZERX=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")108295 "RTN","C0CMED3",206,0)108296 . I ZERX["|" S ZERX=$P(ZERX,"|",2) ; GET RID OF MED NAME108297 "RTN","C0CMED3",207,0)108298 . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=ZERX108299 "RTN","C0CMED3",208,0)108300 . N ZERX2 S ZERX2=$P(MED(2,"E"),"|",2) ; sig for quantity108301 "RTN","C0CMED3",209,0)108302 . N ZFDBDRUG S ZFDBDRUG=$P(MED(2,"E"),"|",1) ; FDB DRUG NAME108303 "RTN","C0CMED3",210,0)108304 . I @MAP@("MEDPRODUCTNAMETEXT")["FREE TXT" D ; FIX THE DRUG NAME108305 "RTN","C0CMED3",211,0)108306 . . S @MAP@("MEDPRODUCTNAMETEXT")=ZFDBDRUG ; USE FDB NAME108307 "RTN","C0CMED3",212,0)108308 . . S RXNORM=$P($P($G(MED(14,7)),"RXNORM:",2)," ",1) ; THE RXNORM108309 "RTN","C0CMED3",213,0)108310 . . S RXNORM=$$NISTMAP^C0CUTIL(RXNORM) ; CHANGE IF NECESSARY108311 "RTN","C0CMED3",214,0)108312 . . I RXNORM'="" D ;108313 "RTN","C0CMED3",215,0)108314 . . . W !,"FOUND FREE TEXT RXNORM:",RXNORM108315 "RTN","C0CMED3",216,0)108316 . . . S RXNNAME="RXNORM" ; THE CODING SYSTEM108317 "RTN","C0CMED3",217,0)108318 . . . S RXNVER="" ; THE CODING SYSTEM VERSION108319 "RTN","C0CMED3",218,0)108320 . . . N ZGMED S ZGMED=@MAP@("MEDPRODUCTNAMETEXT")108321 "RTN","C0CMED3",219,0)108322 . . . S @MAP@("MEDPRODUCTNAMETEXT")=ZGMED_" "_RXNNAME_": "_RXNORM108323 "RTN","C0CMED3",220,0)108324 . . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM108325 "RTN","C0CMED3",221,0)108326 . . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME108327 "RTN","C0CMED3",222,0)108328 . . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER108329 "RTN","C0CMED3",223,0)108330 . . . I RXNORM["979334" D ; PATCH FOR CERTIFICATION108331 "RTN","C0CMED3",224,0)108332 . . . . S @MAP@("MEDSTRENGTHVALUE")=650108333 "RTN","C0CMED3",225,0)108334 . . . . S @MAP@("MEDSTRENGTHUNIT")="mcg"108335 "RTN","C0CMED3",226,0)108336 . . . . S @MAP@("MEDFORMTEXT")="INHALER"108337 "RTN","C0CMED3",227,0)108338 . S @MAP@("MEDQUANTITYUNIT")=$P(ZERX2," ",3) ; THE UNITS108339 "RTN","C0CMED3",228,0)108340 . S @MAP@("MEDQUANTITYVALUE")=$P(ZERX2," ",2) ; THE QUANTITY108341 "RTN","C0CMED3",229,0)108342 . I @MAP@("MEDFORMTEXT")="" S @MAP@("MEDFORMTEXT")=$P(ZERX2," ",3) ;108343 "RTN","C0CMED3",230,0)108344 . ;S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")108345 "RTN","C0CMED3",231,0)108346 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4" ; means look in description text. See E2369-05.108347 "RTN","C0CMED3",232,0)108348 . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""108349 "RTN","C0CMED3",233,0)108350 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""108351 "RTN","C0CMED3",234,0)108352 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""108353 "RTN","C0CMED3",235,0)108354 . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""108355 "RTN","C0CMED3",236,0)108356 . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""108357 "RTN","C0CMED3",237,0)108358 . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""108359 "RTN","C0CMED3",238,0)108360 . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""108361 "RTN","C0CMED3",239,0)108362 . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""108363 "RTN","C0CMED3",240,0)108364 . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""108365 "RTN","C0CMED3",241,0)108366 . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""108367 "RTN","C0CMED3",242,0)108368 . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""108369 "RTN","C0CMED3",243,0)108370 . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""108371 "RTN","C0CMED3",244,0)108372 . S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""108373 "RTN","C0CMED3",245,0)108374 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""108375 "RTN","C0CMED3",246,0)108376 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""108377 "RTN","C0CMED3",247,0)108378 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""108379 "RTN","C0CMED3",248,0)108380 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""108381 "RTN","C0CMED3",249,0)108382 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""108383 "RTN","C0CMED3",250,0)108384 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""108385 "RTN","C0CMED3",251,0)108386 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""108387 "RTN","C0CMED3",252,0)108388 . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""108389 "RTN","C0CMED3",253,0)108390 . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""108391 108385 "RTN","C0CMED3",254,0) 108392 . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""108386 . ; --- END OF DIRECTIONS --- 108393 108387 "RTN","C0CMED3",255,0) 108394 108388 . ; 108395 108389 "RTN","C0CMED3",256,0) 108396 . ; --- END OF DIRECTIONS ---108390 . S @MAP@("MEDRFNO")="" 108397 108391 "RTN","C0CMED3",257,0) 108392 . I $D(MED(14,1)) D ; 108393 "RTN","C0CMED3",258,0) 108394 . . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field 108395 "RTN","C0CMED3",259,0) 108396 . E S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")="" 108397 "RTN","C0CMED3",260,0) 108398 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")="" ; don't put in these - gpl 108399 "RTN","C0CMED3",261,0) 108400 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED")) 108401 "RTN","C0CMED3",262,0) 108402 . K @RESULT 108403 "RTN","C0CMED3",263,0) 108404 . D MAP^C0CXPATH(MINXML,MAP,RESULT) 108405 "RTN","C0CMED3",264,0) 108406 . ; D PARY^C0CXPATH(RESULT) 108407 "RTN","C0CMED3",265,0) 108408 . ; MAPPING DIRECTIONS 108409 "RTN","C0CMED3",266,0) 108410 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE 108411 "RTN","C0CMED3",267,0) 108412 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT 108413 "RTN","C0CMED3",268,0) 108414 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1) 108415 "RTN","C0CMED3",269,0) 108416 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions") 108417 "RTN","C0CMED3",270,0) 108418 . N MDZ1,MDZNA 108419 "RTN","C0CMED3",271,0) 108420 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS 108421 "RTN","C0CMED3",272,0) 108422 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION 108423 "RTN","C0CMED3",273,0) 108424 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1)) 108425 "RTN","C0CMED3",274,0) 108426 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2) 108427 "RTN","C0CMED3",275,0) 108428 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication") 108429 "RTN","C0CMED3",276,0) 108398 108430 . ; 108399 "RTN","C0CMED3",258,0)108400 . S @MAP@("MEDRFNO")=""108401 "RTN","C0CMED3",259,0)108402 . I $D(MED(14,1)) D ;108403 "RTN","C0CMED3",260,0)108404 . . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field108405 "RTN","C0CMED3",261,0)108406 . E S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=""108407 "RTN","C0CMED3",262,0)108408 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")="" ; don't put in these - gpl108409 "RTN","C0CMED3",263,0)108410 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))108411 "RTN","C0CMED3",264,0)108412 . K @RESULT108413 "RTN","C0CMED3",265,0)108414 . D MAP^C0CXPATH(MINXML,MAP,RESULT)108415 "RTN","C0CMED3",266,0)108416 . ; D PARY^C0CXPATH(RESULT)108417 "RTN","C0CMED3",267,0)108418 . ; MAPPING DIRECTIONS108419 "RTN","C0CMED3",268,0)108420 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE108421 "RTN","C0CMED3",269,0)108422 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT108423 "RTN","C0CMED3",270,0)108424 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)108425 "RTN","C0CMED3",271,0)108426 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")108427 "RTN","C0CMED3",272,0)108428 . N MDZ1,MDZNA108429 "RTN","C0CMED3",273,0)108430 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS108431 "RTN","C0CMED3",274,0)108432 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION108433 "RTN","C0CMED3",275,0)108434 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))108435 "RTN","C0CMED3",276,0)108436 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)108437 108431 "RTN","C0CMED3",277,0) 108438 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")108432 . ; MAP PATIENT INSTRUCTIONS - HAVE TO DO THIS AFTER MAPPING DIRECTIONS DUE TO XML SCHEMA VALIDATION 108439 108433 "RTN","C0CMED3",278,0) 108434 . N MEDINT1,INTXML1 S INTXML1="MENINT1" ; VARIABLE AND NAME VARIABLE TEMPLATE 108435 "RTN","C0CMED3",279,0) 108436 . N MEDINT2,INTXML2 S INTXML2="MEDINT2" ; VARIABLE AND NAME VARIABLE RESULT 108437 "RTN","C0CMED3",280,0) 108438 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/PatientInstructions",INTXML1) 108439 "RTN","C0CMED3",281,0) 108440 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/PatientInstructions") 108441 "RTN","C0CMED3",282,0) 108442 . ;N MDI1 ; removing the "I" which is not in the protocol gpl 1/2010 108443 "RTN","C0CMED3",283,0) 108444 . ;S MDI1=$NA(@MAP@("I")) 108445 "RTN","C0CMED3",284,0) 108446 . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105" 108447 "RTN","C0CMED3",285,0) 108448 . I $D(MED(10,1)) D ; 108449 "RTN","C0CMED3",286,0) 108450 . . ;S @MAP@("I","MEDPTINSTRUCTIONS")=$P(MED(10,1)," ",1) ; WP Field 108451 "RTN","C0CMED3",287,0) 108452 . . S @MAP@("MEDPTINSTRUCTIONS")=$P(MED(10,1)," ",1) ; WP Field 108453 "RTN","C0CMED3",288,0) 108454 . E S @MAP@("MEDPTINSTRUCTIONS")="" 108455 "RTN","C0CMED3",289,0) 108456 . ;E S @MAP@("I","MEDPTINSTRUCTIONS")="" 108457 "RTN","C0CMED3",290,0) 108458 . ;D MAP^C0CXPATH(INTXML1,MDI1,INTXML2) 108459 "RTN","C0CMED3",291,0) 108460 . D MAP^C0CXPATH(INTXML1,MAP,INTXML2) ; JUST MAP WORKS.. GPL 108461 "RTN","C0CMED3",292,0) 108462 . D INSERT^C0CXPATH(RESULT,INTXML2,"//Medications/Medication") 108463 "RTN","C0CMED3",293,0) 108440 108464 . ; 108441 "RTN","C0CMED3",279,0)108442 . ; MAP PATIENT INSTRUCTIONS - HAVE TO DO THIS AFTER MAPPING DIRECTIONS DUE TO XML SCHEMA VALIDATION108443 "RTN","C0CMED3",280,0)108444 . N MEDINT1,INTXML1 S INTXML1="MENINT1" ; VARIABLE AND NAME VARIABLE TEMPLATE108445 "RTN","C0CMED3",281,0)108446 . N MEDINT2,INTXML2 S INTXML2="MEDINT2" ; VARIABLE AND NAME VARIABLE RESULT108447 "RTN","C0CMED3",282,0)108448 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/PatientInstructions",INTXML1)108449 "RTN","C0CMED3",283,0)108450 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/PatientInstructions")108451 "RTN","C0CMED3",284,0)108452 . ;N MDI1 ; removing the "I" which is not in the protocol gpl 1/2010108453 "RTN","C0CMED3",285,0)108454 . ;S MDI1=$NA(@MAP@("I"))108455 "RTN","C0CMED3",286,0)108456 . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"108457 "RTN","C0CMED3",287,0)108458 . I $D(MED(10,1)) D ;108459 "RTN","C0CMED3",288,0)108460 . . ;S @MAP@("I","MEDPTINSTRUCTIONS")=$P(MED(10,1)," ",1) ; WP Field108461 "RTN","C0CMED3",289,0)108462 . . S @MAP@("MEDPTINSTRUCTIONS")=$P(MED(10,1)," ",1) ; WP Field108463 "RTN","C0CMED3",290,0)108464 . E S @MAP@("MEDPTINSTRUCTIONS")=""108465 "RTN","C0CMED3",291,0)108466 . ;E S @MAP@("I","MEDPTINSTRUCTIONS")=""108467 "RTN","C0CMED3",292,0)108468 . ;D MAP^C0CXPATH(INTXML1,MDI1,INTXML2)108469 "RTN","C0CMED3",293,0)108470 . D MAP^C0CXPATH(INTXML1,MAP,INTXML2) ; JUST MAP WORKS.. GPL108471 108465 "RTN","C0CMED3",294,0) 108472 . D INSERT^C0CXPATH(RESULT,INTXML2,"//Medications/Medication")108466 . ; FLAG HAS TO BE RESET OUTSIDE THE IF STATMENT. 108473 108467 "RTN","C0CMED3",295,0) 108474 . ; 108468 . ;I MEDFIRST D ; 108475 108469 "RTN","C0CMED3",296,0) 108476 . ; FLAG HAS TO BE RESET OUTSIDE THE IF STATMENT.108470 . ;. S MEDFIRST=0 ; RESET FIRST FLAG 108477 108471 "RTN","C0CMED3",297,0) 108478 . ; I MEDFIRST D ;108472 . ;. D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy 108479 108473 "RTN","C0CMED3",298,0) 108480 . ; . S MEDFIRST=0 ; RESET FIRST FLAG108474 . ;D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML 108481 108475 "RTN","C0CMED3",299,0) 108482 . ;. DCP^C0CXPATH(RESULT,OUTXML) ; First one is a copy108476 . D:MEDFIRST CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy 108483 108477 "RTN","C0CMED3",300,0) 108484 . ;D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTERFIRST, INSERT INNER XML108478 . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML 108485 108479 "RTN","C0CMED3",301,0) 108486 . D:MEDFIRST CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy108480 . I MEDFIRST S MEDFIRST=0 108487 108481 "RTN","C0CMED3",302,0) 108488 . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML108482 N MEDTMP,MEDI 108489 108483 "RTN","C0CMED3",303,0) 108490 . I MEDFIRST S MEDFIRST=0108484 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 108491 108485 "RTN","C0CMED3",304,0) 108492 N MEDTMP,MEDI108486 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 108493 108487 "RTN","C0CMED3",305,0) 108494 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS108488 . W "MEDICATION MISSING ",! 108495 108489 "RTN","C0CMED3",306,0) 108496 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@108490 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! 108497 108491 "RTN","C0CMED3",307,0) 108498 . W "MEDICATION MISSING ",!108492 Q 108499 108493 "RTN","C0CMED3",308,0) 108500 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!108501 "RTN","C0CMED3",309,0)108502 Q108503 "RTN","C0CMED3",310,0)108504 108494 ; 108505 108495 "RTN","C0CMED4") 108506 0^85^B6 1058927108496 0^85^B60079150 108507 108497 "RTN","C0CMED4",1,0) 108508 108498 C0CMED4 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS - Inpatient Meds/Unit Dose ;10/13/08 ; 5/10/12 2:38pm 108509 108499 "RTN","C0CMED4",2,0) 108510 ;;1.2;C 0C;;May 11, 2012;Build 50108500 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 108511 108501 "RTN","C0CMED4",3,0) 108512 ; Copyright 2008 WorldVistA. Licensed under the terms of the GNU108502 ; Copyright 2008 WorldVistA. 108513 108503 "RTN","C0CMED4",4,0) 108514 ; General Public License See attached copy of the License.108504 ; 108515 108505 "RTN","C0CMED4",5,0) 108516 ; 108506 ; This program is free software: you can redistribute it and/or modify 108517 108507 "RTN","C0CMED4",6,0) 108518 ; This program is free software; you can redistribute it and/or modify108508 ; it under the terms of the GNU Affero General Public License as 108519 108509 "RTN","C0CMED4",7,0) 108520 ; it under the terms of the GNU General Public License as published by108510 ; published by the Free Software Foundation, either version 3 of the 108521 108511 "RTN","C0CMED4",8,0) 108522 ; the Free Software Foundation; either version 2 of the License, or108512 ; License, or (at your option) any later version. 108523 108513 "RTN","C0CMED4",9,0) 108524 ; (at your option) any later version.108514 ; 108525 108515 "RTN","C0CMED4",10,0) 108526 ; 108516 ; This program is distributed in the hope that it will be useful, 108527 108517 "RTN","C0CMED4",11,0) 108528 ; This program is distributed in the hope that it will be useful,108518 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 108529 108519 "RTN","C0CMED4",12,0) 108530 ; but WITHOUT ANY WARRANTY; without even the implied warranty of108520 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 108531 108521 "RTN","C0CMED4",13,0) 108532 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the108522 ; GNU Affero General Public License for more details. 108533 108523 "RTN","C0CMED4",14,0) 108534 ; GNU General Public License for more details.108524 ; 108535 108525 "RTN","C0CMED4",15,0) 108536 ; 108526 ; You should have received a copy of the GNU Affero General Public License 108537 108527 "RTN","C0CMED4",16,0) 108538 ; You should have received a copy of the GNU General Public License along108528 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 108539 108529 "RTN","C0CMED4",17,0) 108540 ; with this program; if not, write to the Free Software Foundation, Inc.,108530 ; 108541 108531 "RTN","C0CMED4",18,0) 108542 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.108532 W "NO ENTRY FROM TOP",! 108543 108533 "RTN","C0CMED4",19,0) 108544 ;108534 Q 108545 108535 "RTN","C0CMED4",20,0) 108546 W "NO ENTRY FROM TOP",!108536 ; 108547 108537 "RTN","C0CMED4",21,0) 108548 Q 108538 EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE 108549 108539 "RTN","C0CMED4",22,0) 108550 108540 ; 108551 108541 "RTN","C0CMED4",23,0) 108552 EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE 108542 ; MINXML is the Input XML Template, passed by name 108553 108543 "RTN","C0CMED4",24,0) 108554 ; 108544 ; DFN is Patient IEN 108555 108545 "RTN","C0CMED4",25,0) 108556 ; MINXML is the Input XML Template, passed by name108546 ; OUTXML is the resultant XML. 108557 108547 "RTN","C0CMED4",26,0) 108558 ; DFN is Patient IEN108548 ; 108559 108549 "RTN","C0CMED4",27,0) 108560 ; OUTXML is the resultant XML.108550 ; MEDS is return array from API. 108561 108551 "RTN","C0CMED4",28,0) 108562 ; 108552 ; MED is holds each array element from MEDS, one medicine 108563 108553 "RTN","C0CMED4",29,0) 108564 ; M EDS is return array from API.108554 ; MAP is a mapping variable map (store result) for each med 108565 108555 "RTN","C0CMED4",30,0) 108566 ; MED is holds each array element from MEDS, one medicine108556 ; 108567 108557 "RTN","C0CMED4",31,0) 108568 ; MAP is a mapping variable map (store result) for each med108558 ; Inpatient Meds will be extracted using this routine and and the one following. 108569 108559 "RTN","C0CMED4",32,0) 108570 ; 108560 ; Inpatient Meds Unit Dose is going to be C0CMED4 108571 108561 "RTN","C0CMED4",33,0) 108572 ; Inpatient Meds will be extracted using this routine and and the one following.108562 ; Inpatient Meds IVs is going to be C0CMED5 108573 108563 "RTN","C0CMED4",34,0) 108574 ; Inpatient Meds Unit Dose is going to be C0CMED4108564 ; 108575 108565 "RTN","C0CMED4",35,0) 108576 ; Inpatient Meds IVs is going to be C0CMED5108566 ; We will use two Pharmacy ReEnginnering API's: 108577 108567 "RTN","C0CMED4",36,0) 108578 ; 108568 ; PSS431^PSS55(DFN,PO,PSDATE,PEDATE,LIST) - provides most info 108579 108569 "RTN","C0CMED4",37,0) 108580 ; We will use two Pharmacy ReEnginnering API's:108570 ; PSS432^PSS55(DFN,PO,LIST) - provides schedule info 108581 108571 "RTN","C0CMED4",38,0) 108582 ; PSS431^PSS55(DFN,PO,PSDATE,PEDATE,LIST) - provides most info108572 ; For more information, see the PRE documentation at: 108583 108573 "RTN","C0CMED4",39,0) 108584 ; PSS432^PSS55(DFN,PO,LIST) - provides schedule info108574 ; http://www.va.gov/vdl/documents/Clinical/Pharm-Inpatient_Med/phar_1_api_r0807.pdf 108585 108575 "RTN","C0CMED4",40,0) 108586 ; For more information, see the PRE documentation at:108576 ; 108587 108577 "RTN","C0CMED4",41,0) 108588 ; http://www.va.gov/vdl/documents/Clinical/Pharm-Inpatient_Med/phar_1_api_r0807.pdf108578 ; Med data is stored in Unit Dose multiple of file 55, pharmacy patient 108589 108579 "RTN","C0CMED4",42,0) 108590 ; 108580 ; 108591 108581 "RTN","C0CMED4",43,0) 108592 ; Med data is stored in Unit Dose multiple of file 55, pharmacy patient108582 N MEDS,MAP 108593 108583 "RTN","C0CMED4",44,0) 108594 ;108584 K ^TMP($J) 108595 108585 "RTN","C0CMED4",45,0) 108596 N MEDS,MAP108586 D PSS431^PSS55(DFN,,,,"UD") ; Output is in ^TMP($J,"UD",*) 108597 108587 "RTN","C0CMED4",46,0) 108598 K ^TMP($J)108588 I ^TMP($J,"UD",0)'>0 S @OUTXML@(0)=0 QUIT ; No Meds - Quit 108599 108589 "RTN","C0CMED4",47,0) 108600 D PSS431^PSS55(DFN,,,,"UD") ; Output is in ^TMP($J,"UD",*)108590 ; Otherwise, we go on... 108601 108591 "RTN","C0CMED4",48,0) 108602 I ^TMP($J,"UD",0)'>0 S @OUTXML@(0)=0 QUIT ; No Meds - Quit108592 M MEDS=^TMP($J,"UD") 108603 108593 "RTN","C0CMED4",49,0) 108604 ; Otherwise, we go on...108594 ; I DEBUG ZWR MEDS 108605 108595 "RTN","C0CMED4",50,0) 108606 M MEDS=^TMP($J,"UD")108596 S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP")) 108607 108597 "RTN","C0CMED4",51,0) 108608 I DEBUG ZWR MEDS108598 N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array 108609 108599 "RTN","C0CMED4",52,0) 108610 S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))108600 N I S I=0 108611 108601 "RTN","C0CMED4",53,0) 108612 N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array108602 F S I=$O(MEDS("B",I)) Q:'I D ; For each medication in B index 108613 108603 "RTN","C0CMED4",54,0) 108614 N I S I=0108604 . N MED M MED=MEDS(I) 108615 108605 "RTN","C0CMED4",55,0) 108616 F S I=$O(MEDS("B",I)) Q:'I D ; For each medication in B index108606 . S MEDCOUNT=MEDCOUNT+1 108617 108607 "RTN","C0CMED4",56,0) 108618 . N MED M MED=MEDS(I)108608 . S @MEDMAP@(0)=MEDCOUNT ; Update MedMap array counter 108619 108609 "RTN","C0CMED4",57,0) 108620 . S M EDCOUNT=MEDCOUNT+1108610 . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT)) 108621 108611 "RTN","C0CMED4",58,0) 108622 . S @MEDMAP@(0)=MEDCOUNT ; Update MedMap array counter108612 . N RXIEN S RXIEN=MED(.01) ; Order Number 108623 108613 "RTN","C0CMED4",59,0) 108624 . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))108614 . I DEBUG W "RXIEN IS ",RXIEN,! 108625 108615 "RTN","C0CMED4",60,0) 108626 . N RXIEN S RXIEN=MED(.01) ; Order Number108616 . I DEBUG W "MAP= ",MAP,! 108627 108617 "RTN","C0CMED4",61,0) 108628 . I DEBUG W "RXIEN IS ",RXIEN,!108618 . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN 108629 108619 "RTN","C0CMED4",62,0) 108630 . I DEBUG W "MAP= ",MAP,!108620 . S @MAP@("MEDISSUEDATETXT")="Order Date" 108631 108621 "RTN","C0CMED4",63,0) 108632 . S @MAP@("MED OBJECTID")="MED_INPATIENT_UD"_RXIEN108622 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT") 108633 108623 "RTN","C0CMED4",64,0) 108634 . S @MAP@("MED ISSUEDATETXT")="Order Date"108624 . S @MAP@("MEDLASTFILLDATETXT")="" ; For Outpatient 108635 108625 "RTN","C0CMED4",65,0) 108636 . S @MAP@("MED ISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT")108626 . S @MAP@("MEDLASTFILLDATE")="" ; For Outpatient 108637 108627 "RTN","C0CMED4",66,0) 108638 . S @MAP@("MED LASTFILLDATETXT")="" ; For Outpatient108628 . S @MAP@("MEDRXNOTXT")="" ; For Outpatient 108639 108629 "RTN","C0CMED4",67,0) 108640 . S @MAP@("MED LASTFILLDATE")="" ; For Outpatient108630 . S @MAP@("MEDRXNO")="" ; For Outpatient 108641 108631 "RTN","C0CMED4",68,0) 108642 . S @MAP@("MED RXNOTXT")="" ; For Outpatient108632 . S @MAP@("MEDTYPETEXT")="Medication" 108643 108633 "RTN","C0CMED4",69,0) 108644 . S @MAP@("MED RXNO")="" ; For Outpatient108634 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses 108645 108635 "RTN","C0CMED4",70,0) 108646 . S @MAP@("MED TYPETEXT")="Medication"108636 . S @MAP@("MEDSTATUSTEXT")="ACTIVE" 108647 108637 "RTN","C0CMED4",71,0) 108648 . S @MAP@("MED DETAILUNADORNED")="" ; Leave blank, field has its uses108638 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U) 108649 108639 "RTN","C0CMED4",72,0) 108650 . S @MAP@("MED STATUSTEXT")="ACTIVE"108640 . S @MAP@("MEDPRODUCTNAMETEXT")=MED("DDRUG",1,.01) 108651 108641 "RTN","C0CMED4",73,0) 108652 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U)108642 . ; NDC is field 31 in the drug file. 108653 108643 "RTN","C0CMED4",74,0) 108654 . S @MAP@("MEDPRODUCTNAMETEXT")=MED("DDRUG",1,.01)108644 . ; The actual drug entry in the drug file is not necessarily supplied. 108655 108645 "RTN","C0CMED4",75,0) 108656 . ; NDC is field 31 in the drug file.108646 . ; It' node 1, internal form. 108657 108647 "RTN","C0CMED4",76,0) 108658 . ; The actual drug entry in the drug file is not necessarily supplied.108648 . N MEDIEN S MEDIEN=MED(1,"I") 108659 108649 "RTN","C0CMED4",77,0) 108660 . ; It' node 1, internal form.108650 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=$S($L(MEDIEN):$$GET1^DIQ(50,MEDIEN,31,"E"),1:"") 108661 108651 "RTN","C0CMED4",78,0) 108662 . N MEDIEN S MEDIEN=MED(1,"I")108652 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=$S($L(MEDIEN):"NDC",1:"") 108663 108653 "RTN","C0CMED4",79,0) 108664 . S @MAP@("MEDPRODUCTNAMECODEV ALUE")=$S($L(MEDIEN):$$GET1^DIQ(50,MEDIEN,31,"E"),1:"")108654 . S @MAP@("MEDPRODUCTNAMECODEVERSION")=$S($L(MEDIEN):"none",1:"") 108665 108655 "RTN","C0CMED4",80,0) 108666 . S @MAP@("MED PRODUCTNAMECODINGINGSYSTEM")=$S($L(MEDIEN):"NDC",1:"")108656 . S @MAP@("MEDBRANDNAMETEXT")="" 108667 108657 "RTN","C0CMED4",81,0) 108668 . S @MAP@("MEDPRODUCTNAMECODEVERSION")=$S($L(MEDIEN):"none",1:"")108658 . I $L(MEDIEN) D DOSE^PSS50(MEDIEN,,,,,"DOSE") 108669 108659 "RTN","C0CMED4",82,0) 108670 . S @MAP@("MEDBRANDNAMETEXT")=""108660 . I $L(MEDIEN) N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN) 108671 108661 "RTN","C0CMED4",83,0) 108672 . I $L(MEDIEN) D DOSE^PSS50(MEDIEN,,,,,"DOSE")108662 . S @MAP@("MEDSTRENGTHVALUE")=$S($L(MEDIEN):DOSEDATA(901),1:"") 108673 108663 "RTN","C0CMED4",84,0) 108674 . I $L(MEDIEN) N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)108664 . S @MAP@("MEDSTRENGTHUNIT")=$S($L(MEDIEN):$P(DOSEDATA(902),U,2),1:"") 108675 108665 "RTN","C0CMED4",85,0) 108676 . S @MAP@("MEDSTRENGTHVALUE")=$S($L(MEDIEN):DOSEDATA(901),1:"")108666 . ; Units, concentration, etc, come from another call 108677 108667 "RTN","C0CMED4",86,0) 108678 . S @MAP@("MEDSTRENGTHUNIT")=$S($L(MEDIEN):$P(DOSEDATA(902),U,2),1:"")108668 . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit 108679 108669 "RTN","C0CMED4",87,0) 108680 . ; Units, concentration, etc, come from another call108670 . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters 108681 108671 "RTN","C0CMED4",88,0) 108682 . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit108672 . ; NDF Entry IEN, and VA Product Name 108683 108673 "RTN","C0CMED4",89,0) 108684 . ; Th is call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters108674 . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT") 108685 108675 "RTN","C0CMED4",90,0) 108686 . ; NDF Entry IEN, and VA Product Name108676 . ; Documented in the same manual. 108687 108677 "RTN","C0CMED4",91,0) 108688 . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")108678 . N NDFDATA,CONCDATA 108689 108679 "RTN","C0CMED4",92,0) 108690 . ; Documented in the same manual.108680 . I $L(MEDIEN) D 108691 108681 "RTN","C0CMED4",93,0) 108692 . N NDFDATA,CONCDATA108682 . . D NDF^PSS50(MEDIEN,,,,,"CONC") 108693 108683 "RTN","C0CMED4",94,0) 108684 . . M NDFDATA=^TMP($J,"CONC",MEDIEN) 108685 "RTN","C0CMED4",95,0) 108686 . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U) 108687 "RTN","C0CMED4",96,0) 108688 . . N VAPROD S VAPROD=$P(NDFDATA(22),U) 108689 "RTN","C0CMED4",97,0) 108690 . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be "" 108691 "RTN","C0CMED4",98,0) 108692 . . ; and this will crash the call. So... 108693 "RTN","C0CMED4",99,0) 108694 . . I NDFIEN="" S CONCDATA="" 108695 "RTN","C0CMED4",100,0) 108696 . . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD) 108697 "RTN","C0CMED4",101,0) 108698 . E S (NDFDATA,CONCDATA)="" ; This line is defensive programming to prevent undef errors. 108699 "RTN","C0CMED4",102,0) 108700 . S @MAP@("MEDFORMTEXT")=$S($L(MEDIEN):$P(CONCDATA,U,1),1:"") 108701 "RTN","C0CMED4",103,0) 108702 . S @MAP@("MEDCONCVALUE")=$S($L(MEDIEN):$P(CONCDATA,U,3),1:"") 108703 "RTN","C0CMED4",104,0) 108704 . S @MAP@("MEDCONCUNIT")=$S($L(MEDIEN):$P(CONCDATA,U,4),1:"") 108705 "RTN","C0CMED4",105,0) 108706 . S @MAP@("MEDQUANTITYVALUE")="" ; not provided for in Non-VA meds. 108707 "RTN","C0CMED4",106,0) 108708 . ; Oddly, there is no easy place to find the dispense unit. 108709 "RTN","C0CMED4",107,0) 108710 . ; It's not included in the original call, so we have to go to the drug file. 108711 "RTN","C0CMED4",108,0) 108712 . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT") 108713 "RTN","C0CMED4",109,0) 108714 . ; Node 14.5 is the Dispense Unit 108715 "RTN","C0CMED4",110,0) 108694 108716 . I $L(MEDIEN) D 108695 "RTN","C0CMED4",95,0)108696 . . D NDF^PSS50(MEDIEN,,,,,"CONC")108697 "RTN","C0CMED4",96,0)108698 . . M NDFDATA=^TMP($J,"CONC",MEDIEN)108699 "RTN","C0CMED4",97,0)108700 . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)108701 "RTN","C0CMED4",98,0)108702 . . N VAPROD S VAPROD=$P(NDFDATA(22),U)108703 "RTN","C0CMED4",99,0)108704 . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""108705 "RTN","C0CMED4",100,0)108706 . . ; and this will crash the call. So...108707 "RTN","C0CMED4",101,0)108708 . . I NDFIEN="" S CONCDATA=""108709 "RTN","C0CMED4",102,0)108710 . . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)108711 "RTN","C0CMED4",103,0)108712 . E S (NDFDATA,CONCDATA)="" ; This line is defensive programming to prevent undef errors.108713 "RTN","C0CMED4",104,0)108714 . S @MAP@("MEDFORMTEXT")=$S($L(MEDIEN):$P(CONCDATA,U,1),1:"")108715 "RTN","C0CMED4",105,0)108716 . S @MAP@("MEDCONCVALUE")=$S($L(MEDIEN):$P(CONCDATA,U,3),1:"")108717 "RTN","C0CMED4",106,0)108718 . S @MAP@("MEDCONCUNIT")=$S($L(MEDIEN):$P(CONCDATA,U,4),1:"")108719 "RTN","C0CMED4",107,0)108720 . S @MAP@("MEDQUANTITYVALUE")="" ; not provided for in Non-VA meds.108721 "RTN","C0CMED4",108,0)108722 . ; Oddly, there is no easy place to find the dispense unit.108723 "RTN","C0CMED4",109,0)108724 . ; It's not included in the original call, so we have to go to the drug file.108725 "RTN","C0CMED4",110,0)108726 . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")108727 108717 "RTN","C0CMED4",111,0) 108728 . ; Node 14.5 is the Dispense Unit108718 . . D DATA^PSS50(MEDIEN,,,,,"QTY") 108729 108719 "RTN","C0CMED4",112,0) 108730 . I $L(MEDIEN) D108720 . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN) 108731 108721 "RTN","C0CMED4",113,0) 108732 . . D DATA^PSS50(MEDIEN,,,,,"QTY")108722 . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5) 108733 108723 "RTN","C0CMED4",114,0) 108734 . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)108724 . E S @MAP@("MEDQUANTITYUNIT")="" 108735 108725 "RTN","C0CMED4",115,0) 108736 . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)108726 . ; 108737 108727 "RTN","C0CMED4",116,0) 108738 E S @MAP@("MEDQUANTITYUNIT")=""108728 . ; --- START OF DIRECTIONS --- 108739 108729 "RTN","C0CMED4",117,0) 108730 . ; Dosage is field 2, route is 3, schedule is 4 108731 "RTN","C0CMED4",118,0) 108732 . ; These are all free text fields, and don't point to any files 108733 "RTN","C0CMED4",119,0) 108734 . ; For that reason, I will use the field I never used before: 108735 "RTN","C0CMED4",120,0) 108736 . ; MEDDIRECTIONDESCRIPTIONTEXT 108737 "RTN","C0CMED4",121,0) 108738 . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E") 108739 "RTN","C0CMED4",122,0) 108740 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4" ; means look in description text. See E2369-05. 108741 "RTN","C0CMED4",123,0) 108742 . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")="" 108743 "RTN","C0CMED4",124,0) 108744 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")="" 108745 "RTN","C0CMED4",125,0) 108746 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")="" 108747 "RTN","C0CMED4",126,0) 108748 . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")="" 108749 "RTN","C0CMED4",127,0) 108750 . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")="" 108751 "RTN","C0CMED4",128,0) 108752 . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")="" 108753 "RTN","C0CMED4",129,0) 108754 . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")="" 108755 "RTN","C0CMED4",130,0) 108756 . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")="" 108757 "RTN","C0CMED4",131,0) 108758 . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")="" 108759 "RTN","C0CMED4",132,0) 108760 . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")="" 108761 "RTN","C0CMED4",133,0) 108762 . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")="" 108763 "RTN","C0CMED4",134,0) 108764 . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")="" 108765 "RTN","C0CMED4",135,0) 108766 . S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")="" 108767 "RTN","C0CMED4",136,0) 108768 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")="" 108769 "RTN","C0CMED4",137,0) 108770 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")="" 108771 "RTN","C0CMED4",138,0) 108772 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")="" 108773 "RTN","C0CMED4",139,0) 108774 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")="" 108775 "RTN","C0CMED4",140,0) 108776 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")="" 108777 "RTN","C0CMED4",141,0) 108778 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")="" 108779 "RTN","C0CMED4",142,0) 108780 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")="" 108781 "RTN","C0CMED4",143,0) 108782 . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")="" 108783 "RTN","C0CMED4",144,0) 108784 . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")="" 108785 "RTN","C0CMED4",145,0) 108786 . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")="" 108787 "RTN","C0CMED4",146,0) 108740 108788 . ; 108741 "RTN","C0CMED4",118,0)108742 . ; --- START OF DIRECTIONS ---108743 "RTN","C0CMED4",119,0)108744 . ; Dosage is field 2, route is 3, schedule is 4108745 "RTN","C0CMED4",120,0)108746 . ; These are all free text fields, and don't point to any files108747 "RTN","C0CMED4",121,0)108748 . ; For that reason, I will use the field I never used before:108749 "RTN","C0CMED4",122,0)108750 . ; MEDDIRECTIONDESCRIPTIONTEXT108751 "RTN","C0CMED4",123,0)108752 . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")108753 "RTN","C0CMED4",124,0)108754 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4" ; means look in description text. See E2369-05.108755 "RTN","C0CMED4",125,0)108756 . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""108757 "RTN","C0CMED4",126,0)108758 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""108759 "RTN","C0CMED4",127,0)108760 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""108761 "RTN","C0CMED4",128,0)108762 . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""108763 "RTN","C0CMED4",129,0)108764 . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""108765 "RTN","C0CMED4",130,0)108766 . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""108767 "RTN","C0CMED4",131,0)108768 . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""108769 "RTN","C0CMED4",132,0)108770 . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""108771 "RTN","C0CMED4",133,0)108772 . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""108773 "RTN","C0CMED4",134,0)108774 . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""108775 "RTN","C0CMED4",135,0)108776 . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""108777 "RTN","C0CMED4",136,0)108778 . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""108779 "RTN","C0CMED4",137,0)108780 . S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""108781 "RTN","C0CMED4",138,0)108782 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""108783 "RTN","C0CMED4",139,0)108784 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""108785 "RTN","C0CMED4",140,0)108786 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""108787 "RTN","C0CMED4",141,0)108788 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""108789 "RTN","C0CMED4",142,0)108790 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""108791 "RTN","C0CMED4",143,0)108792 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""108793 "RTN","C0CMED4",144,0)108794 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""108795 "RTN","C0CMED4",145,0)108796 . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""108797 "RTN","C0CMED4",146,0)108798 . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""108799 108789 "RTN","C0CMED4",147,0) 108800 . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""108790 . ; --- END OF DIRECTIONS --- 108801 108791 "RTN","C0CMED4",148,0) 108802 108792 . ; 108803 108793 "RTN","C0CMED4",149,0) 108804 . ; --- END OF DIRECTIONS ---108794 . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105" 108805 108795 "RTN","C0CMED4",150,0) 108806 . ;108796 . S @MAP@("MEDPTINSTRUCTIONS")=MED(10,1) ; WP Field 108807 108797 "RTN","C0CMED4",151,0) 108808 . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"108798 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field 108809 108799 "RTN","C0CMED4",152,0) 108810 . S @MAP@("MED PTINSTRUCTIONS")=MED(10,1) ; WP Field108800 . S @MAP@("MEDRFNO")="" 108811 108801 "RTN","C0CMED4",153,0) 108812 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field108802 . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED")) 108813 108803 "RTN","C0CMED4",154,0) 108814 . S @MAP@("MEDRFNO")=""108804 . K @RESULT 108815 108805 "RTN","C0CMED4",155,0) 108816 . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))108806 . D MAP^GPLXPATH(MINXML,MAP,RESULT) 108817 108807 "RTN","C0CMED4",156,0) 108818 . K @RESULT108808 . ; D PARY^GPLXPATH(RESULT) 108819 108809 "RTN","C0CMED4",157,0) 108820 . D MAP^GPLXPATH(MINXML,MAP,RESULT)108810 . ; MAPPING DIRECTIONS 108821 108811 "RTN","C0CMED4",158,0) 108822 . ; D PARY^GPLXPATH(RESULT)108812 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE 108823 108813 "RTN","C0CMED4",159,0) 108824 . ; MAPPING DIRECTIONS108814 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT 108825 108815 "RTN","C0CMED4",160,0) 108826 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE108816 . D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1) 108827 108817 "RTN","C0CMED4",161,0) 108828 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT108818 . D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions") 108829 108819 "RTN","C0CMED4",162,0) 108830 . D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)108820 . ; N MDZ1,MDZNA 108831 108821 "RTN","C0CMED4",163,0) 108832 . D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions")108822 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS 108833 108823 "RTN","C0CMED4",164,0) 108834 . ; N MDZ1,MDZNA108824 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION 108835 108825 "RTN","C0CMED4",165,0) 108836 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS108826 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1)) 108837 108827 "RTN","C0CMED4",166,0) 108838 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION108828 . . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2) 108839 108829 "RTN","C0CMED4",167,0) 108840 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))108830 . . . D INSERT^GPLXPATH(RESULT,DIRXML2,"//Medications/Medication") 108841 108831 "RTN","C0CMED4",168,0) 108842 . . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2)108832 . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy 108843 108833 "RTN","C0CMED4",169,0) 108844 . . . D INSERT^GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")108834 . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML 108845 108835 "RTN","C0CMED4",170,0) 108846 . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy108836 N MEDTMP,MEDI 108847 108837 "RTN","C0CMED4",171,0) 108848 . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML108838 D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 108849 108839 "RTN","C0CMED4",172,0) 108850 N MEDTMP,MEDI108840 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 108851 108841 "RTN","C0CMED4",173,0) 108852 D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS108842 . W "MEDICATION MISSING ",! 108853 108843 "RTN","C0CMED4",174,0) 108854 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@108844 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! 108855 108845 "RTN","C0CMED4",175,0) 108856 . W "MEDICATION MISSING ",!108846 Q 108857 108847 "RTN","C0CMED4",176,0) 108858 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!108859 "RTN","C0CMED4",177,0)108860 Q108861 "RTN","C0CMED4",178,0)108862 108848 ; 108863 108849 "RTN","C0CMED6") 108864 0^52^B19 4349409108850 0^52^B192343303 108865 108851 "RTN","C0CMED6",1,0) 108866 108852 C0CMED6 ; WV/CCDCCR/SMH - Meds from RPMS: Outpatient Meds;01/10/09 108867 108853 "RTN","C0CMED6",2,0) 108868 ;;1.2;C 0C;;May 11, 2012;Build 50108854 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 108869 108855 "RTN","C0CMED6",3,0) 108870 ; Copyright 2008 WorldVistA. Licensed under the terms of the GNU108856 ; Copyright 2008 WorldVistA. 108871 108857 "RTN","C0CMED6",4,0) 108872 ; General Public License See attached copy of the License.108858 ; 108873 108859 "RTN","C0CMED6",5,0) 108874 ; 108860 ; This program is free software: you can redistribute it and/or modify 108875 108861 "RTN","C0CMED6",6,0) 108876 ; This program is free software; you can redistribute it and/or modify108862 ; it under the terms of the GNU Affero General Public License as 108877 108863 "RTN","C0CMED6",7,0) 108878 ; it under the terms of the GNU General Public License as published by108864 ; published by the Free Software Foundation, either version 3 of the 108879 108865 "RTN","C0CMED6",8,0) 108880 ; the Free Software Foundation; either version 2 of the License, or108866 ; License, or (at your option) any later version. 108881 108867 "RTN","C0CMED6",9,0) 108882 ; (at your option) any later version.108868 ; 108883 108869 "RTN","C0CMED6",10,0) 108884 ; 108870 ; This program is distributed in the hope that it will be useful, 108885 108871 "RTN","C0CMED6",11,0) 108886 ; This program is distributed in the hope that it will be useful,108872 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 108887 108873 "RTN","C0CMED6",12,0) 108888 ; but WITHOUT ANY WARRANTY; without even the implied warranty of108874 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 108889 108875 "RTN","C0CMED6",13,0) 108890 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the108876 ; GNU Affero General Public License for more details. 108891 108877 "RTN","C0CMED6",14,0) 108892 ; GNU General Public License for more details.108878 ; 108893 108879 "RTN","C0CMED6",15,0) 108894 ; 108880 ; You should have received a copy of the GNU Affero General Public License 108895 108881 "RTN","C0CMED6",16,0) 108896 ; You should have received a copy of the GNU General Public License along108882 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 108897 108883 "RTN","C0CMED6",17,0) 108898 ; with this program; if not, write to the Free Software Foundation, Inc.,108884 ; 108899 108885 "RTN","C0CMED6",18,0) 108900 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.108886 W "NO ENTRY FROM TOP",! 108901 108887 "RTN","C0CMED6",19,0) 108902 ;108888 Q 108903 108889 "RTN","C0CMED6",20,0) 108904 W "NO ENTRY FROM TOP",!108890 ; 108905 108891 "RTN","C0CMED6",21,0) 108906 Q 108892 EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT,FLAGS) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE 108907 108893 "RTN","C0CMED6",22,0) 108908 108894 ; 108909 108895 "RTN","C0CMED6",23,0) 108910 EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT,FLAGS) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE 108896 ; MINXML and OUTXML are passed by name so globals can be used 108911 108897 "RTN","C0CMED6",24,0) 108912 ; 108898 ; MINXML will contain only the medications skeleton of the overall template 108913 108899 "RTN","C0CMED6",25,0) 108914 ; M INXML and OUTXML are passed by name so globals can be used108900 ; MEDCOUNT is a counter passed by Reference. 108915 108901 "RTN","C0CMED6",26,0) 108916 ; MINXML will contain only the medications skeleton of the overall template108902 ; FLAGS are: MEDALL(bool)^MEDLIMIT(int)^MEDACTIVE(bool)^MEDPENDING(bool) 108917 108903 "RTN","C0CMED6",27,0) 108918 ; MEDCOUNT is a counter passed by Reference.108904 ; FLAGS are set-up in C0CMED. 108919 108905 "RTN","C0CMED6",28,0) 108920 ; FLAGS are: MEDALL(bool)^MEDLIMIT(int)^MEDACTIVE(bool)^MEDPENDING(bool)108906 ; 108921 108907 "RTN","C0CMED6",29,0) 108922 ; FLAGS are set-up in C0CMED.108908 ; MEDS is return array from RPC. 108923 108909 "RTN","C0CMED6",30,0) 108924 ; 108910 ; MAP is a mapping variable map (store result) for each med 108925 108911 "RTN","C0CMED6",31,0) 108926 ; MED S is return array from RPC.108912 ; MED is holds each array element from MEDS(J), one medicine 108927 108913 "RTN","C0CMED6",32,0) 108928 ; MAP is a mapping variable map (store result) for each med108914 ; J is a counter. 108929 108915 "RTN","C0CMED6",33,0) 108930 ; MED is holds each array element from MEDS(J), one medicine108916 ; 108931 108917 "RTN","C0CMED6",34,0) 108932 ; J is a counter.108918 ; GETRXS^BEHORXFN(ARRAYNAME,DFN,DAYS) will be the the API used. 108933 108919 "RTN","C0CMED6",35,0) 108934 ; 108920 ; This API has been developed by Medsphere for IHS for getting 108935 108921 "RTN","C0CMED6",36,0) 108936 ; GETRXS^BEHORXFN(ARRAYNAME,DFN,DAYS) will be the the API used.108922 ; Medications from RPMS. It has most of what we need. 108937 108923 "RTN","C0CMED6",37,0) 108938 ; This API has been developed by Medsphere for IHS for getting108924 ; API written by Doug Martin when he worked for Medsphere (thanks Doug!) 108939 108925 "RTN","C0CMED6",38,0) 108940 ; Medications from RPMS. It has most of what we need.108926 ; -- ARRAYNAME is passed by name (required) 108941 108927 "RTN","C0CMED6",39,0) 108942 ; API written by Doug Martin when he worked for Medsphere (thanks Doug!)108928 ; -- DFN is passed by value (required) 108943 108929 "RTN","C0CMED6",40,0) 108944 ; -- ARRAYNAME is passed by name (required)108930 ; -- DAYS is passed by value (optional; if not passed defaults to 365) 108945 108931 "RTN","C0CMED6",41,0) 108946 ; -- DFN is passed by value (required)108932 ; 108947 108933 "RTN","C0CMED6",42,0) 108948 ; -- DAYS is passed by value (optional; if not passed defaults to 365)108934 ; Return: 108949 108935 "RTN","C0CMED6",43,0) 108936 ; ~Type^PharmID^Drug^InfRate^StopDt^RefRem^TotDose^UnitDose^OrderID 108937 "RTN","C0CMED6",44,0) 108938 ; ^Status^LastFill^Chronic^Issued^Rx #^Provider^ 108939 "RTN","C0CMED6",45,0) 108940 ; Status Reason^DEA Handling 108941 "RTN","C0CMED6",46,0) 108950 108942 ; 108951 "RTN","C0CMED6",44,0)108952 ; Return:108953 "RTN","C0CMED6",45,0)108954 ; ~Type^PharmID^Drug^InfRate^StopDt^RefRem^TotDose^UnitDose^OrderID108955 "RTN","C0CMED6",46,0)108956 ; ^Status^LastFill^Chronic^Issued^Rx #^Provider^108957 108943 "RTN","C0CMED6",47,0) 108958 ; Status Reason^DEA Handling108944 N MEDS,MEDS1,MAP 108959 108945 "RTN","C0CMED6",48,0) 108960 ;108946 D GETRXS^BEHORXFN("MEDS1",DFN,$P($P(FLAGS,U,2),"-",2)) ; 2nd piece of FLAGS is # of days to retrieve, which comes in the form "T-360" 108961 108947 "RTN","C0CMED6",49,0) 108962 N MEDS,MEDS1,MAP108948 N ALL S ALL=+FLAGS 108963 108949 "RTN","C0CMED6",50,0) 108964 D GETRXS^BEHORXFN("MEDS1",DFN,$P($P(FLAGS,U,2),"-",2)) ; 2nd piece of FLAGS is # of days to retrieve, which comes in the form "T-360"108950 N ACTIVE S ACTIVE=$P(FLAGS,U,3) 108965 108951 "RTN","C0CMED6",51,0) 108966 N ALL S ALL=+FLAGS108952 N PENDING S PENDING=$P(FLAGS,U,4) 108967 108953 "RTN","C0CMED6",52,0) 108968 N ACTIVE S ACTIVE=$P(FLAGS,U,3)108954 S @OUTXML@(0)=0 ;By default, no meds 108969 108955 "RTN","C0CMED6",53,0) 108970 N PENDING S PENDING=$P(FLAGS,U,4)108956 ; If MEDS1 is not defined, then no meds 108971 108957 "RTN","C0CMED6",54,0) 108972 S @OUTXML@(0)=0 ;By default, no meds108958 I '$D(MEDS1) QUIT 108973 108959 "RTN","C0CMED6",55,0) 108974 ; If MEDS1 is not defined, then no meds108960 ;I DEBUG ZWR MEDS1,MINXML 108975 108961 "RTN","C0CMED6",56,0) 108976 I '$D(MEDS1) QUIT108962 N MEDCNT S MEDCNT=0 ; Med Count 108977 108963 "RTN","C0CMED6",57,0) 108978 I DEBUG ZWR MEDS1,MINXML108964 ; The next line is a super line. It goes through the array return 108979 108965 "RTN","C0CMED6",58,0) 108980 N MEDCNT S MEDCNT=0 ; Med Count108966 ; and if the first characters are ~OP, it grabs the line. 108981 108967 "RTN","C0CMED6",59,0) 108982 ; Th e next line is a super line. It goes through the array return108968 ; This means that line is for a dispensed Outpatient Med. 108983 108969 "RTN","C0CMED6",60,0) 108984 ; and if the first characters are ~OP, it grabs the line.108970 ; That line has the metadata about the med that I need. 108985 108971 "RTN","C0CMED6",61,0) 108986 ; Th is means that line is for a dispensed Outpatient Med.108972 ; The next lines, however many, are the med and the sig. 108987 108973 "RTN","C0CMED6",62,0) 108988 ; That line has the metadata about the med that I need.108974 ; I won't be using those because I have to get the sig parsed exactly. 108989 108975 "RTN","C0CMED6",63,0) 108990 ; The next lines, however many, are the med and the sig.108976 N J S J="" F S J=$O(MEDS1(J)) Q:J="" I $E(MEDS1(J),1,3)="~OP" S MEDCNT=MEDCNT+1 S MEDS(MEDCNT)=MEDS1(J) 108991 108977 "RTN","C0CMED6",64,0) 108992 ; I won't be using those because I have to get the sig parsed exactly.108978 K MEDS1 108993 108979 "RTN","C0CMED6",65,0) 108994 N J S J="" F S J=$O(MEDS1(J)) Q:J="" I $E(MEDS1(J),1,3)="~OP" S MEDCNT=MEDCNT+1 S MEDS(MEDCNT)=MEDS1(J)108980 S MEDCNT="" ; Initialize for $Order 108995 108981 "RTN","C0CMED6",66,0) 108996 K MEDS1108982 F S MEDCNT=$O(MEDS(MEDCNT)) Q:MEDCNT="" D ; for each medication in the list 108997 108983 "RTN","C0CMED6",67,0) 108998 S MEDCNT="" ; Initialize for $Order108984 . I 'ALL,ACTIVE,$P(MEDS(MEDCNT),U,10)'="ACTIVE" QUIT 108999 108985 "RTN","C0CMED6",68,0) 109000 F S MEDCNT=$O(MEDS(MEDCNT)) Q:MEDCNT="" D ; for each medication in the list108986 . I 'ALL,PENDING,$P(MEDS(MEDCNT),U,10)'="PENDING" QUIT 109001 108987 "RTN","C0CMED6",69,0) 109002 . I 'ALL,ACTIVE,$P(MEDS(MEDCNT),U,10)'="ACTIVE" QUIT108988 . I DEBUG W "MEDCNT IS ",MEDCNT,! 109003 108989 "RTN","C0CMED6",70,0) 109004 . I 'ALL,PENDING,$P(MEDS(MEDCNT),U,10)'="PENDING" QUIT108990 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCNT)) 109005 108991 "RTN","C0CMED6",71,0) 109006 . I DEBUG W "MEDCNT IS ",MEDCNT,!108992 . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED 109007 108993 "RTN","C0CMED6",72,0) 109008 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCNT))108994 . I DEBUG W "MAP= ",MAP,! 109009 108995 "RTN","C0CMED6",73,0) 109010 . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED108996 . S @MAP@("MEDOBJECTID")="MED"_MEDCNT ; MEDCNT FOR ID 109011 108997 "RTN","C0CMED6",74,0) 109012 . I DEBUG W "MAP= ",MAP,!108998 . S @MAP@("MEDISSUEDATETXT")="Issue Date" 109013 108999 "RTN","C0CMED6",75,0) 109014 . S @MAP@("MED OBJECTID")="MED"_MEDCNT ; MEDCNT FOR ID109000 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,15),"DT") 109015 109001 "RTN","C0CMED6",76,0) 109016 . S @MAP@("MED ISSUEDATETXT")="IssueDate"109002 . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date" 109017 109003 "RTN","C0CMED6",77,0) 109018 . S @MAP@("MED ISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,15),"DT")109004 . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,11),"DT") 109019 109005 "RTN","C0CMED6",78,0) 109020 . S @MAP@("MED LASTFILLDATETXT")="Last Fill Date"109006 . S @MAP@("MEDRXNOTXT")="Prescription Number" 109021 109007 "RTN","C0CMED6",79,0) 109022 . S @MAP@("MED LASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,11),"DT")109008 . S @MAP@("MEDRXNO")=$P(MEDS(MEDCNT),U,14) 109023 109009 "RTN","C0CMED6",80,0) 109024 . S @MAP@("MED RXNOTXT")="Prescription Number"109010 . S @MAP@("MEDTYPETEXT")="Medication" 109025 109011 "RTN","C0CMED6",81,0) 109026 . S @MAP@("MED RXNO")=$P(MEDS(MEDCNT),U,14)109012 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses 109027 109013 "RTN","C0CMED6",82,0) 109028 . S @MAP@("MED TYPETEXT")="Medication"109014 . S @MAP@("MEDSTATUSTEXT")=$P(MEDS(MEDCNT),U,10) 109029 109015 "RTN","C0CMED6",83,0) 109030 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses109016 . ; Provider only provided in API as text, not DUZ. 109031 109017 "RTN","C0CMED6",84,0) 109032 . S @MAP@("MEDSTATUSTEXT")=$P(MEDS(MEDCNT),U,10)109018 . ; We need to get DUZ from filman file 52 (Prescription) 109033 109019 "RTN","C0CMED6",85,0) 109034 . ; Provider only provided in API as text, not DUZ.109020 . ; Field 4; IEN is Piece 2 of Meds stripped of trailing characters. 109035 109021 "RTN","C0CMED6",86,0) 109036 . ; We need to get DUZ from filman file 52 (Prescription)109022 . ; Note that I will use RXIEN several times later 109037 109023 "RTN","C0CMED6",87,0) 109038 . ; Field 4; IEN is Piece 2 of Meds stripped of trailing characters.109024 . N RXIEN S RXIEN=+$P(MEDS(MEDCNT),U,2) 109039 109025 "RTN","C0CMED6",88,0) 109040 . ; Note that I will use RXIEN several times later109026 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52,RXIEN,4,"I") 109041 109027 "RTN","C0CMED6",89,0) 109042 . N RXIEN S RXIEN=+$P(MEDS(MEDCNT),U,2)109028 . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MEDS(MEDCNT),U,3) 109043 109029 "RTN","C0CMED6",90,0) 109044 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52,RXIEN,4,"I")109030 . ; --- RxNorm Stuff 109045 109031 "RTN","C0CMED6",91,0) 109046 . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MEDS(MEDCNT),U,3)109032 . ; 176.001 is the file for Concepts; 176.003 is the file for 109047 109033 "RTN","C0CMED6",92,0) 109048 . ; --- RxNorm Stuff109034 . ; sources (i.e. for RxNorm Version) 109049 109035 "RTN","C0CMED6",93,0) 109050 . ; 176.001 is the file for Concepts; 176.003 is the file for109036 . ; 109051 109037 "RTN","C0CMED6",94,0) 109052 . ; sources (i.e. for RxNorm Version)109038 . ; I use 176.001 for the Vista version of this routine (files 1-3) 109053 109039 "RTN","C0CMED6",95,0) 109040 . ; Since IHS does not have VUID's, I will be getting RxNorm codes 109041 "RTN","C0CMED6",96,0) 109042 . ; using NDCs. My specially crafted index (sounds evil) named "NDC" 109043 "RTN","C0CMED6",97,0) 109044 . ; is in file 176.002. The file is called RxNorm NDC to VUID. 109045 "RTN","C0CMED6",98,0) 109046 . ; Except that I don't need the VUID, but it's there if I need it. 109047 "RTN","C0CMED6",99,0) 109054 109048 . ; 109055 "RTN","C0CMED6",96,0)109056 . ; I use 176.001 for the Vista version of this routine (files 1-3)109057 "RTN","C0CMED6",97,0)109058 . ; Since IHS does not have VUID's, I will be getting RxNorm codes109059 "RTN","C0CMED6",98,0)109060 . ; using NDCs. My specially crafted index (sounds evil) named "NDC"109061 "RTN","C0CMED6",99,0)109062 . ; is in file 176.002. The file is called RxNorm NDC to VUID.109063 109049 "RTN","C0CMED6",100,0) 109064 . ; Except that I don't need the VUID, but it's there if I need it.109050 . ; We obviously need the NDC. That is easily obtained from the prescription. 109065 109051 "RTN","C0CMED6",101,0) 109052 . ; Field 27 in file 52 109053 "RTN","C0CMED6",102,0) 109054 . N NDC S NDC=$$GET1^DIQ(52,RXIEN,27,"I") 109055 "RTN","C0CMED6",103,0) 109056 . ; I discovered that file 176.002 might give you two codes for the NDC 109057 "RTN","C0CMED6",104,0) 109058 . ; One for the Clinical Drug, and one for the ingredient. 109059 "RTN","C0CMED6",105,0) 109060 . ; So the plan is to get the two RxNorm codes, and then find from 109061 "RTN","C0CMED6",106,0) 109062 . ; file 176.001 which one is the Clinical Drug. 109063 "RTN","C0CMED6",107,0) 109064 . ; ... I refactored this into GETRXN 109065 "RTN","C0CMED6",108,0) 109066 . N RXNORM,SRCIEN,RXNNAME,RXNVER 109067 "RTN","C0CMED6",109,0) 109068 . I +NDC,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet. 109069 "RTN","C0CMED6",110,0) 109070 . . S RXNORM=$$GETRXN(NDC) 109071 "RTN","C0CMED6",111,0) 109072 . . S SRCIEN=$$FIND1^DIC(176.003,,,"RXNORM","B") 109073 "RTN","C0CMED6",112,0) 109074 . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6) 109075 "RTN","C0CMED6",113,0) 109076 . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7) 109077 "RTN","C0CMED6",114,0) 109078 . ; 109079 "RTN","C0CMED6",115,0) 109080 . E S (RXNORM,RXNNAME,RXNVER)="" 109081 "RTN","C0CMED6",116,0) 109082 . ; End if/else block 109083 "RTN","C0CMED6",117,0) 109084 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM 109085 "RTN","C0CMED6",118,0) 109086 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME 109087 "RTN","C0CMED6",119,0) 109088 . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER 109089 "RTN","C0CMED6",120,0) 109090 . ; --- End RxNorm section 109091 "RTN","C0CMED6",121,0) 109092 . ; 109093 "RTN","C0CMED6",122,0) 109094 . ; Brand name is 52 field 6.5 109095 "RTN","C0CMED6",123,0) 109096 . S @MAP@("MEDBRANDNAMETEXT")=$$GET1^DIQ(52,RXIEN,6.5) 109097 "RTN","C0CMED6",124,0) 109098 . ; 109099 "RTN","C0CMED6",125,0) 109100 . ; Next I need Med Form (tab, cap etc), strength (250mg) 109101 "RTN","C0CMED6",126,0) 109102 . ; concentration for liquids (250mg/mL) 109103 "RTN","C0CMED6",127,0) 109104 . ; Since IHS does not have any of the new calls that 109105 "RTN","C0CMED6",128,0) 109106 . ; Vista has, I will be doing a crosswalk: 109107 "RTN","C0CMED6",129,0) 109108 . ; File 52, field 6 is Drug IEN in file 50 109109 "RTN","C0CMED6",130,0) 109110 . ; File 50, field 22 is VA Product IEN in file 50.68 109111 "RTN","C0CMED6",131,0) 109112 . ; In file 50.68, I will get the following: 109113 "RTN","C0CMED6",132,0) 109114 . ; -- 1: Dosage Form 109115 "RTN","C0CMED6",133,0) 109116 . ; -- 2: Strength 109117 "RTN","C0CMED6",134,0) 109118 . ; -- 3: Units 109119 "RTN","C0CMED6",135,0) 109120 . ; -- 8: Dispense Units 109121 "RTN","C0CMED6",136,0) 109122 . ; -- Conc is 2 concatenated with 3 109123 "RTN","C0CMED6",137,0) 109066 109124 . ; 109067 "RTN","C0CMED6",102,0) 109068 . ; We obviously need the NDC. That is easily obtained from the prescription. 109069 "RTN","C0CMED6",103,0) 109070 . ; Field 27 in file 52 109071 "RTN","C0CMED6",104,0) 109072 . N NDC S NDC=$$GET1^DIQ(52,RXIEN,27,"I") 109073 "RTN","C0CMED6",105,0) 109074 . ; I discovered that file 176.002 might give you two codes for the NDC 109075 "RTN","C0CMED6",106,0) 109076 . ; One for the Clinical Drug, and one for the ingredient. 109077 "RTN","C0CMED6",107,0) 109078 . ; So the plan is to get the two RxNorm codes, and then find from 109079 "RTN","C0CMED6",108,0) 109080 . ; file 176.001 which one is the Clinical Drug. 109081 "RTN","C0CMED6",109,0) 109082 . ; ... I refactored this into GETRXN 109083 "RTN","C0CMED6",110,0) 109084 . N RXNORM,SRCIEN,RXNNAME,RXNVER 109085 "RTN","C0CMED6",111,0) 109086 . I +NDC,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet. 109087 "RTN","C0CMED6",112,0) 109088 . . S RXNORM=$$GETRXN(NDC) 109089 "RTN","C0CMED6",113,0) 109090 . . S SRCIEN=$$FIND1^DIC(176.003,,,"RXNORM","B") 109091 "RTN","C0CMED6",114,0) 109092 . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6) 109093 "RTN","C0CMED6",115,0) 109094 . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7) 109095 "RTN","C0CMED6",116,0) 109125 "RTN","C0CMED6",138,0) 109126 . ; *** If Drug is not matched to NDF, then VA Product will be "" *** 109127 "RTN","C0CMED6",139,0) 109096 109128 . ; 109097 "RTN","C0CMED6",117,0) 109098 . E S (RXNORM,RXNNAME,RXNVER)="" 109099 "RTN","C0CMED6",118,0) 109100 . ; End if/else block 109101 "RTN","C0CMED6",119,0) 109102 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM 109103 "RTN","C0CMED6",120,0) 109104 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME 109105 "RTN","C0CMED6",121,0) 109106 . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER 109107 "RTN","C0CMED6",122,0) 109108 . ; --- End RxNorm section 109109 "RTN","C0CMED6",123,0) 109129 "RTN","C0CMED6",140,0) 109130 . N MEDIEN S MEDIEN=$$GET1^DIQ(52,RXIEN,6,"I") ; Drug IEN in 50 109131 "RTN","C0CMED6",141,0) 109132 . N VAPROD S VAPROD=$$GET1^DIQ(50,MEDIEN,22,"I") ; VA Product in file 50.68 109133 "RTN","C0CMED6",142,0) 109134 . I +VAPROD D 109135 "RTN","C0CMED6",143,0) 109136 . . S @MAP@("MEDSTRENGTHVALUE")=$$GET1^DIQ(50.68,VAPROD,2) 109137 "RTN","C0CMED6",144,0) 109138 . . S @MAP@("MEDSTRENGTHUNIT")=$$GET1^DIQ(50.68,VAPROD,3) 109139 "RTN","C0CMED6",145,0) 109140 . . S @MAP@("MEDFORMTEXT")=$$GET1^DIQ(50.68,VAPROD,1) 109141 "RTN","C0CMED6",146,0) 109142 . . S @MAP@("MEDCONCVALUE")=@MAP@("MEDSTRENGTHVALUE") 109143 "RTN","C0CMED6",147,0) 109144 . . S @MAP@("MEDCONCUNIT")=@MAP@("MEDSTRENGTHUNIT") 109145 "RTN","C0CMED6",148,0) 109146 . E D 109147 "RTN","C0CMED6",149,0) 109148 . . S @MAP@("MEDSTRENGTHVALUE")="" 109149 "RTN","C0CMED6",150,0) 109150 . . S @MAP@("MEDSTRENGTHUNIT")="" 109151 "RTN","C0CMED6",151,0) 109152 . . S @MAP@("MEDFORMTEXT")="" 109153 "RTN","C0CMED6",152,0) 109154 . . S @MAP@("MEDCONCVALUE")="" 109155 "RTN","C0CMED6",153,0) 109156 . . S @MAP@("MEDCONCUNIT")="" 109157 "RTN","C0CMED6",154,0) 109158 . ; End Strengh/Conc stuff 109159 "RTN","C0CMED6",155,0) 109110 109160 . ; 109111 "RTN","C0CMED6",124,0) 109112 . ; Brand name is 52 field 6.5 109113 "RTN","C0CMED6",125,0) 109114 . S @MAP@("MEDBRANDNAMETEXT")=$$GET1^DIQ(52,RXIEN,6.5) 109115 "RTN","C0CMED6",126,0) 109161 "RTN","C0CMED6",156,0) 109162 . ; Quantity is in the prescription, field 7 109163 "RTN","C0CMED6",157,0) 109164 . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52,RXIEN,7) 109165 "RTN","C0CMED6",158,0) 109166 . ; Dispense unit is in the drug file, field 14.5 109167 "RTN","C0CMED6",159,0) 109168 . S @MAP@("MEDQUANTITYUNIT")=$$GET1^DIQ(50,MEDIEN,14.5) 109169 "RTN","C0CMED6",160,0) 109116 109170 . ; 109117 "RTN","C0CMED6",127,0) 109118 . ; Next I need Med Form (tab, cap etc), strength (250mg) 109119 "RTN","C0CMED6",128,0) 109120 . ; concentration for liquids (250mg/mL) 109121 "RTN","C0CMED6",129,0) 109122 . ; Since IHS does not have any of the new calls that 109123 "RTN","C0CMED6",130,0) 109124 . ; Vista has, I will be doing a crosswalk: 109125 "RTN","C0CMED6",131,0) 109126 . ; File 52, field 6 is Drug IEN in file 50 109127 "RTN","C0CMED6",132,0) 109128 . ; File 50, field 22 is VA Product IEN in file 50.68 109129 "RTN","C0CMED6",133,0) 109130 . ; In file 50.68, I will get the following: 109131 "RTN","C0CMED6",134,0) 109132 . ; -- 1: Dosage Form 109133 "RTN","C0CMED6",135,0) 109134 . ; -- 2: Strength 109135 "RTN","C0CMED6",136,0) 109136 . ; -- 3: Units 109137 "RTN","C0CMED6",137,0) 109138 . ; -- 8: Dispense Units 109139 "RTN","C0CMED6",138,0) 109140 . ; -- Conc is 2 concatenated with 3 109141 "RTN","C0CMED6",139,0) 109142 . ; 109143 "RTN","C0CMED6",140,0) 109144 . ; *** If Drug is not matched to NDF, then VA Product will be "" *** 109145 "RTN","C0CMED6",141,0) 109171 "RTN","C0CMED6",161,0) 109172 . ; --- START OF DIRECTIONS --- 109173 "RTN","C0CMED6",162,0) 109174 . ; Sig data not in any API :-( Oh yes, you can get the whole thing, but... 109175 "RTN","C0CMED6",163,0) 109176 . ; we want the components. 109177 "RTN","C0CMED6",164,0) 109178 . ; It's in multiple 113 in the Prescription File (52) 109179 "RTN","C0CMED6",165,0) 109180 . ; #.01 DOSAGE ORDERED [1F] "20" 109181 "RTN","C0CMED6",166,0) 109182 . ; #1 DISPENSE UNITS PER DOSE [2N] "1" 109183 "RTN","C0CMED6",167,0) 109184 . ; #2 UNITS [3P:50.607] "MG" 109185 "RTN","C0CMED6",168,0) 109186 . ; #3 NOUN [4F] "TABLET" 109187 "RTN","C0CMED6",169,0) 109188 . ; #4 DURATION [5F] "10D" 109189 "RTN","C0CMED6",170,0) 109190 . ; #5 CONJUNCTION [6S] "AND" 109191 "RTN","C0CMED6",171,0) 109192 . ; #6 ROUTE [7P:51.2] "ORAL" 109193 "RTN","C0CMED6",172,0) 109194 . ; #7 SCHEDULE [8F] "BID" 109195 "RTN","C0CMED6",173,0) 109196 . ; #8 VERB [9F] "TAKE" 109197 "RTN","C0CMED6",174,0) 109146 109198 . ; 109147 "RTN","C0CMED6",142,0) 109148 . N MEDIEN S MEDIEN=$$GET1^DIQ(52,RXIEN,6,"I") ; Drug IEN in 50 109149 "RTN","C0CMED6",143,0) 109150 . N VAPROD S VAPROD=$$GET1^DIQ(50,MEDIEN,22,"I") ; VA Product in file 50.68 109151 "RTN","C0CMED6",144,0) 109152 . I +VAPROD D 109153 "RTN","C0CMED6",145,0) 109154 . . S @MAP@("MEDSTRENGTHVALUE")=$$GET1^DIQ(50.68,VAPROD,2) 109155 "RTN","C0CMED6",146,0) 109156 . . S @MAP@("MEDSTRENGTHUNIT")=$$GET1^DIQ(50.68,VAPROD,3) 109157 "RTN","C0CMED6",147,0) 109158 . . S @MAP@("MEDFORMTEXT")=$$GET1^DIQ(50.68,VAPROD,1) 109159 "RTN","C0CMED6",148,0) 109160 . . S @MAP@("MEDCONCVALUE")=@MAP@("MEDSTRENGTHVALUE") 109161 "RTN","C0CMED6",149,0) 109162 . . S @MAP@("MEDCONCUNIT")=@MAP@("MEDSTRENGTHUNIT") 109163 "RTN","C0CMED6",150,0) 109164 . E D 109165 "RTN","C0CMED6",151,0) 109166 . . S @MAP@("MEDSTRENGTHVALUE")="" 109167 "RTN","C0CMED6",152,0) 109168 . . S @MAP@("MEDSTRENGTHUNIT")="" 109169 "RTN","C0CMED6",153,0) 109170 . . S @MAP@("MEDFORMTEXT")="" 109171 "RTN","C0CMED6",154,0) 109172 . . S @MAP@("MEDCONCVALUE")="" 109173 "RTN","C0CMED6",155,0) 109174 . . S @MAP@("MEDCONCUNIT")="" 109175 "RTN","C0CMED6",156,0) 109176 . ; End Strengh/Conc stuff 109177 "RTN","C0CMED6",157,0) 109199 "RTN","C0CMED6",175,0) 109200 . ; Will use GETS^DIQ to get fields. 109201 "RTN","C0CMED6",176,0) 109202 . ; Data comes out like this: 109203 "RTN","C0CMED6",177,0) 109204 . ; SAMINS(52.0113,"1,23,",.01)=20 109205 "RTN","C0CMED6",178,0) 109206 . ; SAMINS(52.0113,"1,23,",1)=1 109207 "RTN","C0CMED6",179,0) 109208 . ; SAMINS(52.0113,"1,23,",2)="MG" 109209 "RTN","C0CMED6",180,0) 109210 . ; SAMINS(52.0113,"1,23,",3)="TABLET" 109211 "RTN","C0CMED6",181,0) 109212 . ; SAMINS(52.0113,"1,23,",4)="5D" 109213 "RTN","C0CMED6",182,0) 109214 . ; SAMINS(52.0113,"1,23,",5)="THEN" 109215 "RTN","C0CMED6",183,0) 109178 109216 . ; 109179 "RTN","C0CMED6",158,0) 109180 . ; Quantity is in the prescription, field 7 109181 "RTN","C0CMED6",159,0) 109182 . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52,RXIEN,7) 109183 "RTN","C0CMED6",160,0) 109184 . ; Dispense unit is in the drug file, field 14.5 109185 "RTN","C0CMED6",161,0) 109186 . S @MAP@("MEDQUANTITYUNIT")=$$GET1^DIQ(50,MEDIEN,14.5) 109187 "RTN","C0CMED6",162,0) 109217 "RTN","C0CMED6",184,0) 109218 . N RAWDATA 109219 "RTN","C0CMED6",185,0) 109220 . D GETS^DIQ(52,RXIEN,"113*",,"RAWDATA","DIERR") 109221 "RTN","C0CMED6",186,0) 109222 . D:$D(DIERR) ^%ZTER ; Log if there's an error in retrieving sig field 109223 "RTN","C0CMED6",187,0) 109224 . ; none the less, continue; some parts are retrievable. 109225 "RTN","C0CMED6",188,0) 109226 . N FMSIG M FMSIG=RAWDATA(52.0113) ; Merge into subfile... 109227 "RTN","C0CMED6",189,0) 109228 . K RAWDATA 109229 "RTN","C0CMED6",190,0) 109230 . N FMSIGNUM S FMSIGNUM="" ; Sigline number in fileman. 109231 "RTN","C0CMED6",191,0) 109232 . ; FMSIGNUM gets outputted as "IEN,RXIEN,". 109233 "RTN","C0CMED6",192,0) 109234 . ; DIRCNT is the proper Sigline numer. 109235 "RTN","C0CMED6",193,0) 109236 . ; SIGDATA is the simplfied array. 109237 "RTN","C0CMED6",194,0) 109238 . F S FMSIGNUM=$O(FMSIG(FMSIGNUM)) Q:FMSIGNUM="" D 109239 "RTN","C0CMED6",195,0) 109240 . . N DIRCNT S DIRCNT=$P(FMSIGNUM,",") 109241 "RTN","C0CMED6",196,0) 109242 . . N SIGDATA M SIGDATA=FMSIG(FMSIGNUM) 109243 "RTN","C0CMED6",197,0) 109244 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components. 109245 "RTN","C0CMED6",198,0) 109246 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05. 109247 "RTN","C0CMED6",199,0) 109248 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$G(SIGDATA(8)) 109249 "RTN","C0CMED6",200,0) 109250 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$G(SIGDATA(.01)) 109251 "RTN","C0CMED6",201,0) 109252 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=$G(SIGDATA(2)) 109253 "RTN","C0CMED6",202,0) 109254 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient 109255 "RTN","C0CMED6",203,0) 109256 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient 109257 "RTN","C0CMED6",204,0) 109258 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient 109259 "RTN","C0CMED6",205,0) 109260 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$G(SIGDATA(6)) 109261 "RTN","C0CMED6",206,0) 109262 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$G(SIGDATA(7)) 109263 "RTN","C0CMED6",207,0) 109264 . . ; Invervals... again another call. 109265 "RTN","C0CMED6",208,0) 109266 . . ; In the wisdom of the original programmers, the schedule is a free text field 109267 "RTN","C0CMED6",209,0) 109268 . . ; However, it gets translated by a call to the administration schedule file 109269 "RTN","C0CMED6",210,0) 109270 . . ; to see if that schedule exists. 109271 "RTN","C0CMED6",211,0) 109272 . . ; That's the same thing I am going to do. 109273 "RTN","C0CMED6",212,0) 109274 . . ; Search B index of 51.1 (Admin Schedule) with schedule 109275 "RTN","C0CMED6",213,0) 109276 . . ; First, remove "PRN" if it exists (don't ask, that's how the file 109277 "RTN","C0CMED6",214,0) 109278 . . ; works; I wouldn't do it that way). 109279 "RTN","C0CMED6",215,0) 109280 . . N SCHNOPRN S SCHNOPRN=$G(SIGDATA(7)) 109281 "RTN","C0CMED6",216,0) 109282 . . I SCHNOPRN["PRN" S SCHNOPRN=$E(SCHNOPRN,1,$F(SCHNOPRN,"PRN")-5) 109283 "RTN","C0CMED6",217,0) 109284 . . ; Super call below: 109285 "RTN","C0CMED6",218,0) 109286 . . ; 1=File 51.1 3=Field 2 (Frequency in Minutes) 109287 "RTN","C0CMED6",219,0) 109288 . . ; 4=Packed format, Exact Match 5=Lookup Value 109289 "RTN","C0CMED6",220,0) 109290 . . ; 6=# of entries to return 7=Index 10=Return Array 109291 "RTN","C0CMED6",221,0) 109292 . . ; 109293 "RTN","C0CMED6",222,0) 109294 . . ; I do not account for the fact that two schedules can be 109295 "RTN","C0CMED6",223,0) 109296 . . ; spelled identically (ie duplicate entry). In that case, 109297 "RTN","C0CMED6",224,0) 109298 . . ; I get the first. That's just a bad pharmacy pkg maintainer. 109299 "RTN","C0CMED6",225,0) 109300 . . N C0C515 109301 "RTN","C0CMED6",226,0) 109302 . . D FIND^DIC(51.1,,"@;2","PX",SCHNOPRN,1,"B",,,"C0C515") 109303 "RTN","C0CMED6",227,0) 109304 . . N INTERVAL S INTERVAL="" ; Default 109305 "RTN","C0CMED6",228,0) 109306 . . ; If there are entries found, get it 109307 "RTN","C0CMED6",229,0) 109308 . . I +$G(C0C515("DILIST",0)) S INTERVAL=$P(C0C515("DILIST",1,0),U,2) 109309 "RTN","C0CMED6",230,0) 109310 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL 109311 "RTN","C0CMED6",231,0) 109312 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute" 109313 "RTN","C0CMED6",232,0) 109314 . . ; Duration is 10M minutes, 10H hours, 10D for Days 109315 "RTN","C0CMED6",233,0) 109316 . . ; 10W for weeks, 10L for months. I smell $Select 109317 "RTN","C0CMED6",234,0) 109318 . . ; But we don't need to do that if there isn't a duration 109319 "RTN","C0CMED6",235,0) 109320 . . I +$G(SIGDATA(4)) D 109321 "RTN","C0CMED6",236,0) 109322 . . . N DURUNIT S DURUNIT=$E(SIGDATA(4),$L(SIGDATA(4))) ; get last char 109323 "RTN","C0CMED6",237,0) 109324 . . . N DURTXT S DURTXT=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"Days") 109325 "RTN","C0CMED6",238,0) 109326 . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=+SIGDATA(4) 109327 "RTN","C0CMED6",239,0) 109328 . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=DURTXT 109329 "RTN","C0CMED6",240,0) 109330 . . E D 109331 "RTN","C0CMED6",241,0) 109332 . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")="" 109333 "RTN","C0CMED6",242,0) 109334 . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")="" 109335 "RTN","C0CMED6",243,0) 109336 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$G(SIGDATA(4))["PRN" 109337 "RTN","C0CMED6",244,0) 109338 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")="" ; when avail 109339 "RTN","C0CMED6",245,0) 109340 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")="" 109341 "RTN","C0CMED6",246,0) 109342 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")="" 109343 "RTN","C0CMED6",247,0) 109344 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")="" 109345 "RTN","C0CMED6",248,0) 109346 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")="" 109347 "RTN","C0CMED6",249,0) 109348 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")="" 109349 "RTN","C0CMED6",250,0) 109350 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")="" 109351 "RTN","C0CMED6",251,0) 109352 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; not stored 109353 "RTN","C0CMED6",252,0) 109354 . . ; Another confusing line; I am pretty bad: 109355 "RTN","C0CMED6",253,0) 109356 . . ; If there is another entry in the FMSIG array (i.e. another line 109357 "RTN","C0CMED6",254,0) 109358 . . ; in the sig), set the direction count indicator. 109359 "RTN","C0CMED6",255,0) 109360 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")="" ; Default 109361 "RTN","C0CMED6",256,0) 109362 . . S:+$O(FMSIG(FMSIGNUM)) @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRCNT 109363 "RTN","C0CMED6",257,0) 109364 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$G(SIGDATA(5)) 109365 "RTN","C0CMED6",258,0) 109188 109366 . ; 109189 "RTN","C0CMED6",163,0)109190 . ; --- START OF DIRECTIONS ---109191 "RTN","C0CMED6",164,0)109192 . ; Sig data not in any API :-( Oh yes, you can get the whole thing, but...109193 "RTN","C0CMED6",165,0)109194 . ; we want the components.109195 "RTN","C0CMED6",166,0)109196 . ; It's in multiple 113 in the Prescription File (52)109197 "RTN","C0CMED6",167,0)109198 . ; #.01 DOSAGE ORDERED [1F] "20"109199 "RTN","C0CMED6",168,0)109200 . ; #1 DISPENSE UNITS PER DOSE [2N] "1"109201 "RTN","C0CMED6",169,0)109202 . ; #2 UNITS [3P:50.607] "MG"109203 "RTN","C0CMED6",170,0)109204 . ; #3 NOUN [4F] "TABLET"109205 "RTN","C0CMED6",171,0)109206 . ; #4 DURATION [5F] "10D"109207 "RTN","C0CMED6",172,0)109208 . ; #5 CONJUNCTION [6S] "AND"109209 "RTN","C0CMED6",173,0)109210 . ; #6 ROUTE [7P:51.2] "ORAL"109211 "RTN","C0CMED6",174,0)109212 . ; #7 SCHEDULE [8F] "BID"109213 "RTN","C0CMED6",175,0)109214 . ; #8 VERB [9F] "TAKE"109215 "RTN","C0CMED6",176,0)109216 . ;109217 "RTN","C0CMED6",177,0)109218 . ; Will use GETS^DIQ to get fields.109219 "RTN","C0CMED6",178,0)109220 . ; Data comes out like this:109221 "RTN","C0CMED6",179,0)109222 . ; SAMINS(52.0113,"1,23,",.01)=20109223 "RTN","C0CMED6",180,0)109224 . ; SAMINS(52.0113,"1,23,",1)=1109225 "RTN","C0CMED6",181,0)109226 . ; SAMINS(52.0113,"1,23,",2)="MG"109227 "RTN","C0CMED6",182,0)109228 . ; SAMINS(52.0113,"1,23,",3)="TABLET"109229 "RTN","C0CMED6",183,0)109230 . ; SAMINS(52.0113,"1,23,",4)="5D"109231 "RTN","C0CMED6",184,0)109232 . ; SAMINS(52.0113,"1,23,",5)="THEN"109233 "RTN","C0CMED6",185,0)109234 . ;109235 "RTN","C0CMED6",186,0)109236 . N RAWDATA109237 "RTN","C0CMED6",187,0)109238 . D GETS^DIQ(52,RXIEN,"113*",,"RAWDATA","DIERR")109239 "RTN","C0CMED6",188,0)109240 . D:$D(DIERR) ^%ZTER ; Log if there's an error in retrieving sig field109241 "RTN","C0CMED6",189,0)109242 . ; none the less, continue; some parts are retrievable.109243 "RTN","C0CMED6",190,0)109244 . N FMSIG M FMSIG=RAWDATA(52.0113) ; Merge into subfile...109245 "RTN","C0CMED6",191,0)109246 . K RAWDATA109247 "RTN","C0CMED6",192,0)109248 . N FMSIGNUM S FMSIGNUM="" ; Sigline number in fileman.109249 "RTN","C0CMED6",193,0)109250 . ; FMSIGNUM gets outputted as "IEN,RXIEN,".109251 "RTN","C0CMED6",194,0)109252 . ; DIRCNT is the proper Sigline numer.109253 "RTN","C0CMED6",195,0)109254 . ; SIGDATA is the simplfied array.109255 "RTN","C0CMED6",196,0)109256 . F S FMSIGNUM=$O(FMSIG(FMSIGNUM)) Q:FMSIGNUM="" D109257 "RTN","C0CMED6",197,0)109258 . . N DIRCNT S DIRCNT=$P(FMSIGNUM,",")109259 "RTN","C0CMED6",198,0)109260 . . N SIGDATA M SIGDATA=FMSIG(FMSIGNUM)109261 "RTN","C0CMED6",199,0)109262 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components.109263 "RTN","C0CMED6",200,0)109264 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05.109265 "RTN","C0CMED6",201,0)109266 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$G(SIGDATA(8))109267 "RTN","C0CMED6",202,0)109268 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$G(SIGDATA(.01))109269 "RTN","C0CMED6",203,0)109270 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=$G(SIGDATA(2))109271 "RTN","C0CMED6",204,0)109272 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient109273 "RTN","C0CMED6",205,0)109274 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient109275 "RTN","C0CMED6",206,0)109276 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient109277 "RTN","C0CMED6",207,0)109278 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$G(SIGDATA(6))109279 "RTN","C0CMED6",208,0)109280 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$G(SIGDATA(7))109281 "RTN","C0CMED6",209,0)109282 . . ; Invervals... again another call.109283 "RTN","C0CMED6",210,0)109284 . . ; In the wisdom of the original programmers, the schedule is a free text field109285 "RTN","C0CMED6",211,0)109286 . . ; However, it gets translated by a call to the administration schedule file109287 "RTN","C0CMED6",212,0)109288 . . ; to see if that schedule exists.109289 "RTN","C0CMED6",213,0)109290 . . ; That's the same thing I am going to do.109291 "RTN","C0CMED6",214,0)109292 . . ; Search B index of 51.1 (Admin Schedule) with schedule109293 "RTN","C0CMED6",215,0)109294 . . ; First, remove "PRN" if it exists (don't ask, that's how the file109295 "RTN","C0CMED6",216,0)109296 . . ; works; I wouldn't do it that way).109297 "RTN","C0CMED6",217,0)109298 . . N SCHNOPRN S SCHNOPRN=$G(SIGDATA(7))109299 "RTN","C0CMED6",218,0)109300 . . I SCHNOPRN["PRN" S SCHNOPRN=$E(SCHNOPRN,1,$F(SCHNOPRN,"PRN")-5)109301 "RTN","C0CMED6",219,0)109302 . . ; Super call below:109303 "RTN","C0CMED6",220,0)109304 . . ; 1=File 51.1 3=Field 2 (Frequency in Minutes)109305 "RTN","C0CMED6",221,0)109306 . . ; 4=Packed format, Exact Match 5=Lookup Value109307 "RTN","C0CMED6",222,0)109308 . . ; 6=# of entries to return 7=Index 10=Return Array109309 "RTN","C0CMED6",223,0)109310 . . ;109311 "RTN","C0CMED6",224,0)109312 . . ; I do not account for the fact that two schedules can be109313 "RTN","C0CMED6",225,0)109314 . . ; spelled identically (ie duplicate entry). In that case,109315 "RTN","C0CMED6",226,0)109316 . . ; I get the first. That's just a bad pharmacy pkg maintainer.109317 "RTN","C0CMED6",227,0)109318 . . N C0C515109319 "RTN","C0CMED6",228,0)109320 . . D FIND^DIC(51.1,,"@;2","PX",SCHNOPRN,1,"B",,,"C0C515")109321 "RTN","C0CMED6",229,0)109322 . . N INTERVAL S INTERVAL="" ; Default109323 "RTN","C0CMED6",230,0)109324 . . ; If there are entries found, get it109325 "RTN","C0CMED6",231,0)109326 . . I +$G(C0C515("DILIST",0)) S INTERVAL=$P(C0C515("DILIST",1,0),U,2)109327 "RTN","C0CMED6",232,0)109328 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL109329 "RTN","C0CMED6",233,0)109330 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"109331 "RTN","C0CMED6",234,0)109332 . . ; Duration is 10M minutes, 10H hours, 10D for Days109333 "RTN","C0CMED6",235,0)109334 . . ; 10W for weeks, 10L for months. I smell $Select109335 "RTN","C0CMED6",236,0)109336 . . ; But we don't need to do that if there isn't a duration109337 "RTN","C0CMED6",237,0)109338 . . I +$G(SIGDATA(4)) D109339 "RTN","C0CMED6",238,0)109340 . . . N DURUNIT S DURUNIT=$E(SIGDATA(4),$L(SIGDATA(4))) ; get last char109341 "RTN","C0CMED6",239,0)109342 . . . N DURTXT S DURTXT=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"Days")109343 "RTN","C0CMED6",240,0)109344 . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=+SIGDATA(4)109345 "RTN","C0CMED6",241,0)109346 . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=DURTXT109347 "RTN","C0CMED6",242,0)109348 . . E D109349 "RTN","C0CMED6",243,0)109350 . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=""109351 "RTN","C0CMED6",244,0)109352 . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""109353 "RTN","C0CMED6",245,0)109354 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$G(SIGDATA(4))["PRN"109355 "RTN","C0CMED6",246,0)109356 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")="" ; when avail109357 "RTN","C0CMED6",247,0)109358 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""109359 "RTN","C0CMED6",248,0)109360 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""109361 "RTN","C0CMED6",249,0)109362 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""109363 "RTN","C0CMED6",250,0)109364 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""109365 "RTN","C0CMED6",251,0)109366 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""109367 "RTN","C0CMED6",252,0)109368 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""109369 "RTN","C0CMED6",253,0)109370 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; not stored109371 "RTN","C0CMED6",254,0)109372 . . ; Another confusing line; I am pretty bad:109373 "RTN","C0CMED6",255,0)109374 . . ; If there is another entry in the FMSIG array (i.e. another line109375 "RTN","C0CMED6",256,0)109376 . . ; in the sig), set the direction count indicator.109377 "RTN","C0CMED6",257,0)109378 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")="" ; Default109379 "RTN","C0CMED6",258,0)109380 . . S:+$O(FMSIG(FMSIGNUM)) @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRCNT109381 109367 "RTN","C0CMED6",259,0) 109382 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$G(SIGDATA(5))109368 . ; --- END OF DIRECTIONS --- 109383 109369 "RTN","C0CMED6",260,0) 109384 109370 . ; 109385 109371 "RTN","C0CMED6",261,0) 109386 . ; --- END OF DIRECTIONS ---109372 . ; Med instructions is a WP field, thus the acrobatics 109387 109373 "RTN","C0CMED6",262,0) 109374 . ; Notice buffer overflow protection set at 10,000 chars 109375 "RTN","C0CMED6",263,0) 109376 . ; -- 1. Med Patient Instructions 109377 "RTN","C0CMED6",264,0) 109378 . N MEDPTIN1 S MEDPTIN1=$$GET1^DIQ(52,RXIEN,115,,"MEDPTIN1") 109379 "RTN","C0CMED6",265,0) 109380 . N MEDPTIN2,J S (MEDPTIN2,J)="" 109381 "RTN","C0CMED6",266,0) 109382 . I $L(MEDPTIN1) F S J=$O(@MEDPTIN1@(J)) Q:J="" Q:$L(MEDPTIN2)>10000 S MEDPTIN2=MEDPTIN2_@MEDPTIN1@(J)_" " 109383 "RTN","C0CMED6",267,0) 109384 . S @MAP@("MEDPTINSTRUCTIONS")=MEDPTIN2 109385 "RTN","C0CMED6",268,0) 109386 . K J 109387 "RTN","C0CMED6",269,0) 109388 . ; -- 2. Med Provider Instructions 109389 "RTN","C0CMED6",270,0) 109390 . N MEDPVIN1 S MEDPVIN1=$$GET1^DIQ(52,RXIEN,39,,"MEDPVIN1") 109391 "RTN","C0CMED6",271,0) 109392 . N MEDPVIN2,J S (MEDPVIN2,J)="" 109393 "RTN","C0CMED6",272,0) 109394 . I $L(MEDPVIN1) F S J=$O(@MEDPVIN1@(J)) Q:J="" Q:$L(MEDPVIN2)>10000 S MEDPVIN2=MEDPVIN2_@MEDPVIN1@(J)_" " 109395 "RTN","C0CMED6",273,0) 109396 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MEDPVIN2 109397 "RTN","C0CMED6",274,0) 109388 109398 . ; 109389 "RTN","C0CMED6",263,0)109390 . ; Med instructions is a WP field, thus the acrobatics109391 "RTN","C0CMED6",264,0)109392 . ; Notice buffer overflow protection set at 10,000 chars109393 "RTN","C0CMED6",265,0)109394 . ; -- 1. Med Patient Instructions109395 "RTN","C0CMED6",266,0)109396 . N MEDPTIN1 S MEDPTIN1=$$GET1^DIQ(52,RXIEN,115,,"MEDPTIN1")109397 "RTN","C0CMED6",267,0)109398 . N MEDPTIN2,J S (MEDPTIN2,J)=""109399 "RTN","C0CMED6",268,0)109400 . I $L(MEDPTIN1) F S J=$O(@MEDPTIN1@(J)) Q:J="" Q:$L(MEDPTIN2)>10000 S MEDPTIN2=MEDPTIN2_@MEDPTIN1@(J)_" "109401 "RTN","C0CMED6",269,0)109402 . S @MAP@("MEDPTINSTRUCTIONS")=MEDPTIN2109403 "RTN","C0CMED6",270,0)109404 . K J109405 "RTN","C0CMED6",271,0)109406 . ; -- 2. Med Provider Instructions109407 "RTN","C0CMED6",272,0)109408 . N MEDPVIN1 S MEDPVIN1=$$GET1^DIQ(52,RXIEN,39,,"MEDPVIN1")109409 "RTN","C0CMED6",273,0)109410 . N MEDPVIN2,J S (MEDPVIN2,J)=""109411 "RTN","C0CMED6",274,0)109412 . I $L(MEDPVIN1) F S J=$O(@MEDPVIN1@(J)) Q:J="" Q:$L(MEDPVIN2)>10000 S MEDPVIN2=MEDPVIN2_@MEDPVIN1@(J)_" "109413 109399 "RTN","C0CMED6",275,0) 109414 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MEDPVIN2109400 . ; Remaining refills 109415 109401 "RTN","C0CMED6",276,0) 109402 . S @MAP@("MEDRFNO")=$P(MEDS(MEDCNT),U,6) 109403 "RTN","C0CMED6",277,0) 109404 . ; ------ END OF MAPPING 109405 "RTN","C0CMED6",278,0) 109416 109406 . ; 109417 "RTN","C0CMED6",277,0)109418 . ; Remaining refills109419 "RTN","C0CMED6",278,0)109420 . S @MAP@("MEDRFNO")=$P(MEDS(MEDCNT),U,6)109421 109407 "RTN","C0CMED6",279,0) 109422 . ; ------ END OF MAPPING109408 . ; ------ BEGIN XML INSERTION 109423 109409 "RTN","C0CMED6",280,0) 109424 . ;109410 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED")) 109425 109411 "RTN","C0CMED6",281,0) 109426 . ; ------ BEGIN XML INSERTION109412 . K @RESULT 109427 109413 "RTN","C0CMED6",282,0) 109428 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))109414 . D MAP^C0CXPATH(MINXML,MAP,RESULT) 109429 109415 "RTN","C0CMED6",283,0) 109430 . K @RESULT109416 . ; D PARY^C0CXPATH(RESULT) 109431 109417 "RTN","C0CMED6",284,0) 109432 . D MAP^C0CXPATH(MINXML,MAP,RESULT)109418 . ; MAPPING DIRECTIONS 109433 109419 "RTN","C0CMED6",285,0) 109434 . ; D PARY^C0CXPATH(RESULT)109420 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE 109435 109421 "RTN","C0CMED6",286,0) 109436 . ; MAPPING DIRECTIONS109422 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT 109437 109423 "RTN","C0CMED6",287,0) 109438 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE109424 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1) 109439 109425 "RTN","C0CMED6",288,0) 109440 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT109426 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions") 109441 109427 "RTN","C0CMED6",289,0) 109442 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)109428 . ; N MDZ1,MDZNA 109443 109429 "RTN","C0CMED6",290,0) 109444 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")109430 . N DIRCNT S DIRCNT="" 109445 109431 "RTN","C0CMED6",291,0) 109446 . ; N MDZ1,MDZNA109432 . I +$O(@MAP@("M","DIRECTIONS",DIRCNT)) D ; IF THERE ARE DIRCTIONS 109447 109433 "RTN","C0CMED6",292,0) 109448 . N DIRCNT S DIRCNT=""109434 . . F DIRCNT=$O(@MAP@("M","DIRECTIONS",DIRCNT)) D ; FOR EACH DIRECTION 109449 109435 "RTN","C0CMED6",293,0) 109450 . I +$O(@MAP@("M","DIRECTIONS",DIRCNT)) D ; IF THERE ARE DIRCTIONS109436 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",DIRCNT)) 109451 109437 "RTN","C0CMED6",294,0) 109452 . . F DIRCNT=$O(@MAP@("M","DIRECTIONS",DIRCNT)) D ; FOR EACH DIRECTION109438 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2) 109453 109439 "RTN","C0CMED6",295,0) 109454 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",DIRCNT))109440 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication") 109455 109441 "RTN","C0CMED6",296,0) 109456 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)109442 . D:MEDCNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy 109457 109443 "RTN","C0CMED6",297,0) 109458 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")109444 . D:MEDCNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML 109459 109445 "RTN","C0CMED6",298,0) 109460 . D:MEDCNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy109446 . S MEDCOUNT=MEDCNT 109461 109447 "RTN","C0CMED6",299,0) 109462 . D:MEDCNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML109448 N MEDTMP,MEDI 109463 109449 "RTN","C0CMED6",300,0) 109464 . S MEDCOUNT=MEDCNT109450 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 109465 109451 "RTN","C0CMED6",301,0) 109466 N MEDTMP,MEDI109452 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 109467 109453 "RTN","C0CMED6",302,0) 109468 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS109454 . W "MEDICATION MISSING ",! 109469 109455 "RTN","C0CMED6",303,0) 109470 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@109456 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! 109471 109457 "RTN","C0CMED6",304,0) 109472 . W "MEDICATION MISSING ",!109458 Q 109473 109459 "RTN","C0CMED6",305,0) 109474 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!109460 ; 109475 109461 "RTN","C0CMED6",306,0) 109476 Q 109462 GETRXN(NDC) ; Extrinsic Function; PUBLIC; NDC to RxNorm 109477 109463 "RTN","C0CMED6",307,0) 109478 ; 109464 ;; Get RxNorm Concept Number for a Given NDC 109479 109465 "RTN","C0CMED6",308,0) 109480 GETRXN(NDC) ; Extrinsic Function; PUBLIC; NDC to RxNorm 109466 ; 109481 109467 "RTN","C0CMED6",309,0) 109482 ;; Get RxNorm Concept Number for a Given NDC109468 S NDC=$TR(NDC,"-") ; Remove dashes 109483 109469 "RTN","C0CMED6",310,0) 109484 ;109470 N RXNORM,C0CZRXN,DIERR 109485 109471 "RTN","C0CMED6",311,0) 109486 S NDC=$TR(NDC,"-") ; Remove dashes109472 D FIND^DIC(176.002,,"@;.01","PX",NDC,"*","NDC",,,"C0CZRXN","DIERR") 109487 109473 "RTN","C0CMED6",312,0) 109488 N RXNORM,C0CZRXN,DIERR109474 I $D(DIERR) S $EC=",U1," 109489 109475 "RTN","C0CMED6",313,0) 109490 D FIND^DIC(176.002,,"@;.01","PX",NDC,"*","NDC",,,"C0CZRXN","DIERR")109476 S RXNORM(0)=+C0CZRXN("DILIST",0) ; RxNorm(0) will be # of entries 109491 109477 "RTN","C0CMED6",314,0) 109492 I $D(DIERR) D ^%ZTER BREAK109478 N I S I=0 109493 109479 "RTN","C0CMED6",315,0) 109494 S RXNORM(0)=+C0CZRXN("DILIST",0) ; RxNorm(0) will be # of entries109480 F S I=$O(C0CZRXN("DILIST",I)) Q:I="" S RXNORM(I)=$P(C0CZRXN("DILIST",I,0),U,2) 109495 109481 "RTN","C0CMED6",316,0) 109496 N I S I=0109482 ; At this point, RxNorm(0) is # of entries; RxNorm(1...) are the entries 109497 109483 "RTN","C0CMED6",317,0) 109498 F S I=$O(C0CZRXN("DILIST",I)) Q:I="" S RXNORM(I)=$P(C0CZRXN("DILIST",I,0),U,2)109484 ; If RxNorm(0) is 1, then we only have one entry, and that's it. 109499 109485 "RTN","C0CMED6",318,0) 109500 ; At this point, RxNorm(0) is # of entries; RxNorm(1...) are the entries109486 I RXNORM(0)=1 QUIT RXNORM(1) ; RETURN RXNORM(1) 109501 109487 "RTN","C0CMED6",319,0) 109502 ; If RxNorm(0) is 1, then we only have one entry, and that's it.109488 ; Otherwise, we need to find out which one is the semantic 109503 109489 "RTN","C0CMED6",320,0) 109504 I RXNORM(0)=1 QUIT RXNORM(1) ; RETURN RXNORM(1)109490 ; clinical drug. I built an index on 176.001 (RxNorm Concepts) 109505 109491 "RTN","C0CMED6",321,0) 109506 ; Otherwise, we need to find out which one is the semantic109492 ; for that purpose. 109507 109493 "RTN","C0CMED6",322,0) 109508 ; clinical drug. I built an index on 176.001 (RxNorm Concepts)109494 I RXNORM(0)>1 D 109509 109495 "RTN","C0CMED6",323,0) 109510 ; for that purpose.109496 . S I=0 109511 109497 "RTN","C0CMED6",324,0) 109512 I RXNORM(0)>1 D109498 . F S I=$O(RXNORM(I)) Q:I="" D Q:$G(RXNORM) 109513 109499 "RTN","C0CMED6",325,0) 109514 . S I=0109500 . . N RXNIEN S RXNIEN=$$FIND1^DIC(176.001,,,RXNORM(I),"SCD") 109515 109501 "RTN","C0CMED6",326,0) 109516 . F S I=$O(RXNORM(I)) Q:I="" D Q:$G(RXNORM)109502 . . I +$G(RXNIEN)=0 QUIT ; try the next entry... 109517 109503 "RTN","C0CMED6",327,0) 109518 . . N RXNIEN S RXNIEN=$$FIND1^DIC(176.001,,,RXNORM(I),"SCD")109504 . . E S RXNORM=RXNORM(I) QUIT ; We found the right code 109519 109505 "RTN","C0CMED6",328,0) 109520 . . I +$G(RXNIEN)=0 QUIT ; try the next entry...109521 "RTN","C0CMED6",329,0)109522 . . E S RXNORM=RXNORM(I) QUIT ; We found the right code109523 "RTN","C0CMED6",330,0)109524 109506 QUIT +$G(RXNORM) ; RETURN RXNORM; if we couldn't find a clnical drug, return with 0 109525 "RTN","C0CMED6",331,0)109526 109527 109507 "RTN","C0CMIME") 109528 0^86^B9 9031395109508 0^86^B97918768 109529 109509 "RTN","C0CMIME",1,0) 109530 109510 C0CMIME ; CCDCCR/GPL - MIME manipulation utilities; 3/8/11 ; 5/16/11 2:32pm 109531 109511 "RTN","C0CMIME",2,0) 109532 ;;1.2;C 0C;;May 11, 2012;Build 50109512 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 109533 109513 "RTN","C0CMIME",3,0) 109534 ;Copyright 2008 George Lilly. Licensed under the terms of the GNU109514 ;Copyright 2008 George Lilly. 109535 109515 "RTN","C0CMIME",4,0) 109536 ; General Public License See attached copy of the License.109516 ; 109537 109517 "RTN","C0CMIME",5,0) 109538 ; 109518 ; This program is free software: you can redistribute it and/or modify 109539 109519 "RTN","C0CMIME",6,0) 109540 ; This program is free software; you can redistribute it and/or modify109520 ; it under the terms of the GNU Affero General Public License as 109541 109521 "RTN","C0CMIME",7,0) 109542 ; it under the terms of the GNU General Public License as published by109522 ; published by the Free Software Foundation, either version 3 of the 109543 109523 "RTN","C0CMIME",8,0) 109544 ; the Free Software Foundation; either version 2 of the License, or109524 ; License, or (at your option) any later version. 109545 109525 "RTN","C0CMIME",9,0) 109546 ; (at your option) any later version.109526 ; 109547 109527 "RTN","C0CMIME",10,0) 109548 ; 109528 ; This program is distributed in the hope that it will be useful, 109549 109529 "RTN","C0CMIME",11,0) 109550 ; This program is distributed in the hope that it will be useful,109530 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 109551 109531 "RTN","C0CMIME",12,0) 109552 ; but WITHOUT ANY WARRANTY; without even the implied warranty of109532 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 109553 109533 "RTN","C0CMIME",13,0) 109554 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the109534 ; GNU Affero General Public License for more details. 109555 109535 "RTN","C0CMIME",14,0) 109556 ; GNU General Public License for more details.109536 ; 109557 109537 "RTN","C0CMIME",15,0) 109558 ; 109538 ; You should have received a copy of the GNU Affero General Public License 109559 109539 "RTN","C0CMIME",16,0) 109560 ; You should have received a copy of the GNU General Public License along109540 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 109561 109541 "RTN","C0CMIME",17,0) 109562 ; with this program; if not, write to the Free Software Foundation, Inc.,109542 ; 109563 109543 "RTN","C0CMIME",18,0) 109564 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.109544 Q 109565 109545 "RTN","C0CMIME",19,0) 109566 109546 ; 109567 109547 "RTN","C0CMIME",20,0) 109548 TEST(ZDFN) ; 109549 "RTN","C0CMIME",21,0) 109550 D CCRRPC^C0CCCR(.ZCCR,ZDFN) ; GET A CCR TO WORK WITH 109551 "RTN","C0CMIME",22,0) 109552 ;M ZCOPY=ZCCR 109553 "RTN","C0CMIME",23,0) 109554 S ZCOPY(1)="" 109555 "RTN","C0CMIME",24,0) 109556 N ZI S ZI=0 109557 "RTN","C0CMIME",25,0) 109558 F S ZI=$O(ZCCR(ZI)) Q:ZI="" D ; FOR EACH LINE 109559 "RTN","C0CMIME",26,0) 109560 . S ZCOPY(1)=ZCOPY(1)_ZCCR(ZI) 109561 "RTN","C0CMIME",27,0) 109562 ;D ENCODE("ZCOPY",1,ZCOPY(1)) 109563 "RTN","C0CMIME",28,0) 109564 S G(1)=$$ENCODE^RGUTUU(ZCOPY(1)) 109565 "RTN","C0CMIME",29,0) 109566 D CHUNK("G2","G",45) 109567 "RTN","C0CMIME",30,0) 109568 109568 Q 109569 "RTN","C0CMIME",21,0) 109570 ; 109571 "RTN","C0CMIME",22,0) 109572 TEST(ZDFN) ; 109573 "RTN","C0CMIME",23,0) 109574 D CCRRPC^C0CCCR(.ZCCR,ZDFN) ; GET A CCR TO WORK WITH 109575 "RTN","C0CMIME",24,0) 109576 ;M ZCOPY=ZCCR 109577 "RTN","C0CMIME",25,0) 109569 "RTN","C0CMIME",31,0) 109570 ENCODE(ZRTN,ZARY) ; 109571 "RTN","C0CMIME",32,0) 109572 ; ROUTINE TO ENCODE AN XML DOCUMENT FOR SENDING 109573 "RTN","C0CMIME",33,0) 109574 ; ZARY IS PASSED BY NAME 109575 "RTN","C0CMIME",34,0) 109576 ; ZRTN IS PASSED BY REFERENCE AND IS THE RETURN 109577 "RTN","C0CMIME",35,0) 109578 ; 109579 "RTN","C0CMIME",36,0) 109578 109580 S ZCOPY(1)="" 109579 "RTN","C0CMIME", 26,0)109581 "RTN","C0CMIME",37,0) 109580 109582 N ZI S ZI=0 109581 "RTN","C0CMIME", 27,0)109582 F S ZI=$O( ZCCR(ZI)) Q:ZI="" D ; FOR EACH LINE109583 "RTN","C0CMIME", 28,0)109584 . S ZCOPY(1)=ZCOPY(1)_ ZCCR(ZI)109585 "RTN","C0CMIME", 29,0)109586 ;D ENCODE("ZCOPY",1,ZCOPY(1))109587 "RTN","C0CMIME", 30,0)109583 "RTN","C0CMIME",38,0) 109584 F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH LINE 109585 "RTN","C0CMIME",39,0) 109586 . S ZCOPY(1)=ZCOPY(1)_@ZARY@(ZI) 109587 "RTN","C0CMIME",40,0) 109588 N G 109589 "RTN","C0CMIME",41,0) 109588 109590 S G(1)=$$ENCODE^RGUTUU(ZCOPY(1)) 109589 "RTN","C0CMIME", 31,0)109590 D CHUNK( "G2","G",45)109591 "RTN","C0CMIME", 32,0)109591 "RTN","C0CMIME",42,0) 109592 D CHUNK(ZRTN,"G",45) 109593 "RTN","C0CMIME",43,0) 109592 109594 Q 109593 "RTN","C0CMIME",33,0) 109594 ENCODE(ZRTN,ZARY) ; 109595 "RTN","C0CMIME",34,0) 109596 ; ROUTINE TO ENCODE AN XML DOCUMENT FOR SENDING 109597 "RTN","C0CMIME",35,0) 109598 ; ZARY IS PASSED BY NAME 109599 "RTN","C0CMIME",36,0) 109600 ; ZRTN IS PASSED BY REFERENCE AND IS THE RETURN 109601 "RTN","C0CMIME",37,0) 109602 ; 109603 "RTN","C0CMIME",38,0) 109604 S ZCOPY(1)="" 109605 "RTN","C0CMIME",39,0) 109595 "RTN","C0CMIME",44,0) 109596 ; THIS ROUTINE WAS COPIED FROM LRSRVR4 AND THEN MODIFIED . THANKS JOHN 109597 "RTN","C0CMIME",45,0) 109598 ENCODEO(IARY,LRNODE,LRSTR) ; Encode a string, keep remainder for next line 109599 "RTN","C0CMIME",46,0) 109600 ; Call with LRSTR by reference, Remainder returned in LRSTR 109601 "RTN","C0CMIME",47,0) 109602 ; IARY IS PASSED BY NAME 109603 "RTN","C0CMIME",48,0) 109604 S LRQUIT=0,LRLEN=$L(LRSTR) 109605 "RTN","C0CMIME",49,0) 109606 F D Q:LRQUIT 109607 "RTN","C0CMIME",50,0) 109608 . I $L(LRSTR)<45 S LRQUIT=1 Q 109609 "RTN","C0CMIME",51,0) 109610 . S LRX=$E(LRSTR,1,45) 109611 "RTN","C0CMIME",52,0) 109612 . S LRNODE=LRNODE+1,@IARY@(LRNODE)=$$UUEN^LRSRVR4(LRX) 109613 "RTN","C0CMIME",53,0) 109614 . S LRSTR=$E(LRSTR,46,LRLEN) 109615 "RTN","C0CMIME",54,0) 109616 Q 109617 "RTN","C0CMIME",55,0) 109618 ; 109619 "RTN","C0CMIME",56,0) 109620 TESTMAIL ; 109621 "RTN","C0CMIME",57,0) 109622 ; TEST OF MAILSEND 109623 "RTN","C0CMIME",58,0) 109624 ;S ZTO("glilly@glilly.net")="" 109625 "RTN","C0CMIME",59,0) 109626 S ZTO("mish@nhin.openforum.opensourcevista.net")="" 109627 "RTN","C0CMIME",60,0) 109628 ;S ZTO("martijn@djigzo.com")="" 109629 "RTN","C0CMIME",61,0) 109630 ;S ZTO("profmish@gmail.com")="" 109631 "RTN","C0CMIME",62,0) 109632 ;S ZTO("nanthracite@earthlink.net")="" 109633 "RTN","C0CMIME",63,0) 109634 S ZFROM="ANTHRACITE.NANCY" 109635 "RTN","C0CMIME",64,0) 109636 S ZATTACH=$NA(^GPL("CCR")) 109637 "RTN","C0CMIME",65,0) 109638 I $G(@ZATTACH@(1))="" D ; NO CCR THERE 109639 "RTN","C0CMIME",66,0) 109640 . D CCRRPC^C0CCCR(.GPL,2) ; GET ONE FROM PATIENT 2 109641 "RTN","C0CMIME",67,0) 109642 . M @ZATTACH=GPL ; PUT IT IN THERE FOR NEXT TIME 109643 "RTN","C0CMIME",68,0) 109644 S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE" 109645 "RTN","C0CMIME",69,0) 109646 D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,,ZATTACH) 109647 "RTN","C0CMIME",70,0) 109648 ; ZWR GR 109649 "RTN","C0CMIME",71,0) 109650 Q 109651 "RTN","C0CMIME",72,0) 109652 ; 109653 "RTN","C0CMIME",73,0) 109654 TESTMAI2 ; 109655 "RTN","C0CMIME",74,0) 109656 ; TEST OF MAILSEND TO gpl.mdc-crew.net 109657 "RTN","C0CMIME",75,0) 109658 N C0CGM 109659 "RTN","C0CMIME",76,0) 109660 S C0CGM(1)="This is a test message." 109661 "RTN","C0CMIME",77,0) 109662 S C0CGM(2)="A Continuity of Care record is attached" 109663 "RTN","C0CMIME",78,0) 109664 S C0CGM(3)="It contains no Protected Health Information (PHI)" 109665 "RTN","C0CMIME",79,0) 109666 S C0CGM(4)="It is purely test data used for software development" 109667 "RTN","C0CMIME",80,0) 109668 S C0CGM(5)="It does not represent information about any person living or dead" 109669 "RTN","C0CMIME",81,0) 109670 ;S ZTO("glilly@glilly.net")="" 109671 "RTN","C0CMIME",82,0) 109672 ;S ZTO("george.lilly@pobox.com")="" 109673 "RTN","C0CMIME",83,0) 109674 ;S ZTO("george@nhin.openforum.opensourcevista.net")="" 109675 "RTN","C0CMIME",84,0) 109676 ;S ZTO("mish@nhin.openforum.opensourcevista.net")="" 109677 "RTN","C0CMIME",85,0) 109678 S ZTO("brooks.richard@securemail.opensourcevista.net")="" 109679 "RTN","C0CMIME",86,0) 109680 ;S ZTO("LILLY.GEORGE@mdc-crew.net")="" 109681 "RTN","C0CMIME",87,0) 109682 ;S ZTO("ncoal@live.com")="" 109683 "RTN","C0CMIME",88,0) 109684 ;S ZTO("martijn@djigzo.com")="" 109685 "RTN","C0CMIME",89,0) 109686 ;S ZTO("profmish@gmail.com")="" 109687 "RTN","C0CMIME",90,0) 109688 ;S ZTO("nanthracite@earthlink.net")="" 109689 "RTN","C0CMIME",91,0) 109690 S ZTO("gpl.doctortest@gmail.com")="" 109691 "RTN","C0CMIME",92,0) 109692 S ZFROM="LILLY.GEORGE" 109693 "RTN","C0CMIME",93,0) 109694 S ZATTACH=$NA(^GPL("CCR")) 109695 "RTN","C0CMIME",94,0) 109696 I $G(@ZATTACH@(1))="" D ; NO CCR THERE 109697 "RTN","C0CMIME",95,0) 109698 . D CCRRPC^C0CCCR(.GPL,2) ; GET ONE FROM PATIENT 2 109699 "RTN","C0CMIME",96,0) 109700 . M @ZATTACH=GPL ; PUT IT IN THERE FOR NEXT TIME 109701 "RTN","C0CMIME",97,0) 109702 S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE" 109703 "RTN","C0CMIME",98,0) 109704 D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,"C0CGM",ZATTACH,"CCR.xml") 109705 "RTN","C0CMIME",99,0) 109706 ; ZWR GR 109707 "RTN","C0CMIME",100,0) 109708 Q 109709 "RTN","C0CMIME",101,0) 109710 ; 109711 "RTN","C0CMIME",102,0) 109712 LINE(C0CFILE,C0CTO) ; read a file name passed in C0CFILE and send it to 109713 "RTN","C0CMIME",103,0) 109714 ; the email address in C0CTO 109715 "RTN","C0CMIME",104,0) 109716 ; the directory and the "from" are all hard coded 109717 "RTN","C0CMIME",105,0) 109718 ; 109719 "RTN","C0CMIME",106,0) 109720 N ZZFROM S ZZFROM="LILLY.GEORGE" 109721 "RTN","C0CMIME",107,0) 109722 N GN S GN=$NA(^TMP("C0CMIME2",$J)) 109723 "RTN","C0CMIME",108,0) 109724 N GN1 S GN1=$NA(@GN@(1)) 109725 "RTN","C0CMIME",109,0) 109726 K @GN 109727 "RTN","C0CMIME",110,0) 109728 I '$D(C0CFILE) Q ; NO FILENAME PASSED 109729 "RTN","C0CMIME",111,0) 109730 I '$D(C0CTO) S C0CTO="brooks.richard@securemail.opensourcevista.net" 109731 "RTN","C0CMIME",112,0) 109732 S ZZTO(C0CTO)="" 109733 "RTN","C0CMIME",113,0) 109734 N ZMESS S ZMESS(1)="file transmission from wvehr3-09" 109735 "RTN","C0CMIME",114,0) 109736 N GD S GD="/home/wvehr3-09/EHR/" ; directory 109737 "RTN","C0CMIME",115,0) 109738 I '$$FTG^%ZISH(GD,C0CFILE,GN1,3) Q D ; 109739 "RTN","C0CMIME",116,0) 109740 . W !,"error reading file",C0CFILE 109741 "RTN","C0CMIME",117,0) 109742 D MAILSEND(.ZRTN,ZZFROM,"ZZTO",,"file transmission","ZMESS",GN,C0CFILE) 109743 "RTN","C0CMIME",118,0) 109744 K @GN ; CLEAN UP 109745 "RTN","C0CMIME",119,0) 109746 ;ZWR ZRTN 109747 "RTN","C0CMIME",120,0) 109748 W !,$G(ZRTN(1)) 109749 "RTN","C0CMIME",121,0) 109750 Q 109751 "RTN","C0CMIME",122,0) 109752 ; 109753 "RTN","C0CMIME",123,0) 109754 MAILSEND(RTN,FROM,TO,CC,SUBJECT,MESSAGE,ATTACH,FNAME,FLAGS) ; MAIL SENDING INTERFACE 109755 "RTN","C0CMIME",124,0) 109756 ; RTN IS THE RETURN ARRAY PASSED BY REFERENCE 109757 "RTN","C0CMIME",125,0) 109758 ; FROM IS PASSED BY VALUE AND IS THE EMAIL ADDRESS OF THE SENDER 109759 "RTN","C0CMIME",126,0) 109760 ; IF NULL, WILL SEND FROM THE CURRENT DUZ 109761 "RTN","C0CMIME",127,0) 109762 ; TO AND CC ARE RECIEPIENT EMAIL ADDRESSES PASSED BY NAME 109763 "RTN","C0CMIME",128,0) 109764 ; @TO@("addr1@domain1.net") 109765 "RTN","C0CMIME",129,0) 109766 ; @CC@("addr2@domain2.com") both can be multiples 109767 "RTN","C0CMIME",130,0) 109768 ; SUBJECT IS PASSED BY VALUE AND WILL GO IN THE SUBJECT LINE 109769 "RTN","C0CMIME",131,0) 109770 ; MESSAGE IS PASSED BY NAME AND IS AN ARRAY OF TEXT 109771 "RTN","C0CMIME",132,0) 109772 ; ATTACH IS PASSED BY NAME AND IS AN XML OR HTML FILE TO BE ATTACHED 109773 "RTN","C0CMIME",133,0) 109774 ; FNAME IS THE FILENAME OF THE ATTACHMENT, DEFAULT IS ccr.xml 109775 "RTN","C0CMIME",134,0) 109776 ; 109777 "RTN","C0CMIME",135,0) 109778 I '$D(FNAME) S FNAME="ccr.xml" ; default filename 109779 "RTN","C0CMIME",136,0) 109780 N GN 109781 "RTN","C0CMIME",137,0) 109782 S GN=$NA(^TMP($J,"C0CMIME")) 109783 "RTN","C0CMIME",138,0) 109784 K @GN 109785 "RTN","C0CMIME",139,0) 109786 S GM(1)="MIME-Version: 1.0" 109787 "RTN","C0CMIME",140,0) 109788 S GM(2)="Content-Type: multipart/mixed; boudary=""1234567""" 109789 "RTN","C0CMIME",141,0) 109790 S GM(3)="" 109791 "RTN","C0CMIME",142,0) 109792 S GM(4)="" 109793 "RTN","C0CMIME",143,0) 109794 ;S GM(5)="--123456788888" 109795 "RTN","C0CMIME",144,0) 109796 ;S GM(5)=$$REPEAT^XLFSTR("-",$L(X)) 109797 "RTN","C0CMIME",145,0) 109798 S GM(5)="--123456899999" 109799 "RTN","C0CMIME",146,0) 109800 S GM(6)="Content-Type: text/xml; name="_FNAME 109801 "RTN","C0CMIME",147,0) 109802 S GM(7)="Content-Transfer-Encoding: base64" 109803 "RTN","C0CMIME",148,0) 109804 S GM(8)="Content-Disposition: attachment; filename="_FNAME 109805 "RTN","C0CMIME",149,0) 109806 S GM(9)="" 109807 "RTN","C0CMIME",150,0) 109808 S GM(10)="" ; FOR THE END 109809 "RTN","C0CMIME",151,0) 109810 ;S GM(11)="--123456788888--" 109811 "RTN","C0CMIME",152,0) 109812 S GM(11)="--123456899999--" 109813 "RTN","C0CMIME",153,0) 109814 S GM(12)="" 109815 "RTN","C0CMIME",154,0) 109816 S GM(13)="" 109817 "RTN","C0CMIME",155,0) 109818 S GG(1)="--123456899999" 109819 "RTN","C0CMIME",156,0) 109820 S GG(2)="Content-Type: text/plain; charset=ISO-8859-1; format=flowed" 109821 "RTN","C0CMIME",157,0) 109822 S GG(3)="Content-Transfer-Encoding: 7bit" 109823 "RTN","C0CMIME",158,0) 109824 S GG(4)="" 109825 "RTN","C0CMIME",159,0) 109826 S GG(5)="This is a test message." 109827 "RTN","C0CMIME",160,0) 109828 S GG(6)="A Continuity of Care record is attached" 109829 "RTN","C0CMIME",161,0) 109830 S GG(7)="It contains no Protected Health Information (PHI)" 109831 "RTN","C0CMIME",162,0) 109832 S GG(8)="It is purely test data used for software development" 109833 "RTN","C0CMIME",163,0) 109834 S GG(9)="It does not represent information about any person living or dead" 109835 "RTN","C0CMIME",164,0) 109836 S GG(10)="" 109837 "RTN","C0CMIME",165,0) 109838 S GG(11)="--123456899999--" 109839 "RTN","C0CMIME",166,0) 109840 ;S GG(11)="Content-Type: text/plain; charset=""us-ascii""" 109841 "RTN","C0CMIME",167,0) 109842 S GG(12)="" 109843 "RTN","C0CMIME",168,0) 109844 ;S GG(13)="This is a test message." 109845 "RTN","C0CMIME",169,0) 109846 S GG(14)="A Continuity of Care record is attached" 109847 "RTN","C0CMIME",170,0) 109848 S GG(15)="It contains no Protected Health Information (PHI)" 109849 "RTN","C0CMIME",171,0) 109850 S GG(16)="It is purely test data used for software development" 109851 "RTN","C0CMIME",172,0) 109852 S GG(17)="It does not represent information about any person living or dead" 109853 "RTN","C0CMIME",173,0) 109854 S GG(18)="" 109855 "RTN","C0CMIME",174,0) 109856 S GG(19)="--123456899999" 109857 "RTN","C0CMIME",175,0) 109858 S GG(20)="--987654321--" 109859 "RTN","C0CMIME",176,0) 109860 K GBLD 109861 "RTN","C0CMIME",177,0) 109862 ;D QUEUE^C0CXPATH("GBLD","GGG",1,3) ; THE MESSAGE 109863 "RTN","C0CMIME",178,0) 109864 ;D QUEUE^C0CXPATH("GBLD","GG",1,10) ; THE MESSAGE 109865 "RTN","C0CMIME",179,0) 109866 I $D(MESSAGE)'="" D ; THERE IS A MESSAGE 109867 "RTN","C0CMIME",180,0) 109868 . D QUEUE^C0CXPATH("GBLD","GG",1,4) ; THE MIME BOUNDARY 109869 "RTN","C0CMIME",181,0) 109870 . D QUEUE^C0CXPATH("GBLD",MESSAGE,1,$O(@MESSAGE@(""),-1)) ;THE MESSAGE 109871 "RTN","C0CMIME",182,0) 109872 . D QUEUE^C0CXPATH("GBLD","GG",10,10) ;A BLANK LINE 109873 "RTN","C0CMIME",183,0) 109874 D QUEUE^C0CXPATH("GBLD","GM",5,9) 109875 "RTN","C0CMIME",184,0) 109876 I $D(ATTACH)'="" D ; IF WE HAVE AN ATTACHMENT 109877 "RTN","C0CMIME",185,0) 109878 . D ENCODE("G2",ATTACH) ; ENCODE FOR SENDING 109879 "RTN","C0CMIME",186,0) 109880 . D QUEUE^C0CXPATH("GBLD","G2",1,$O(G2(""),-1)) 109881 "RTN","C0CMIME",187,0) 109882 D QUEUE^C0CXPATH("GBLD","GM",11,12) 109883 "RTN","C0CMIME",188,0) 109884 D BUILD^C0CXPATH("GBLD",GN) 109885 "RTN","C0CMIME",189,0) 109886 ;S GGG=$NA(^GPL("MIME2")) 109887 "RTN","C0CMIME",190,0) 109888 K @GN@(0) ; KILL THE LINE COUNT 109889 "RTN","C0CMIME",191,0) 109890 K LRINSTR,LRTASK,LRTO,XMERR,XMZ 109891 "RTN","C0CMIME",192,0) 109892 M LRTO=@TO 109893 "RTN","C0CMIME",193,0) 109894 I $D(CC) M LRTO=@CC 109895 "RTN","C0CMIME",194,0) 109896 S LRINSTR("ADDR FLAGS")="R" 109897 "RTN","C0CMIME",195,0) 109898 S LRINSTR("FROM")=$G(FROM) 109899 "RTN","C0CMIME",196,0) 109900 S LRMSUBJ=$G(SUBJECT) 109901 "RTN","C0CMIME",197,0) 109902 S LRMSUBJ=$E(LRMSUBJ,1,65) 109903 "RTN","C0CMIME",198,0) 109904 D SENDMSG^XMXAPI(DUZ,LRMSUBJ,GN,.LRTO,.LRINSTR,.LRTASK) 109905 "RTN","C0CMIME",199,0) 109906 I $G(XMERR)=1 S RTN(1)="ERROR SENDING MESSAGE" Q ; 109907 "RTN","C0CMIME",200,0) 109908 S RTN(1)="OK" 109909 "RTN","C0CMIME",201,0) 109910 Q 109911 "RTN","C0CMIME",202,0) 109912 ; 109913 "RTN","C0CMIME",203,0) 109914 MAILSEN0(LRMSUBJ) ; Send extract back to requestor. 109915 "RTN","C0CMIME",204,0) 109916 ; 109917 "RTN","C0CMIME",205,0) 109918 ;D TEST 109919 "RTN","C0CMIME",206,0) 109920 S GN=$NA(^TMP($J,"C0CMIME")) 109921 "RTN","C0CMIME",207,0) 109922 K @GN 109923 "RTN","C0CMIME",208,0) 109924 ;M @GN=G2 109925 "RTN","C0CMIME",209,0) 109926 S GM(1)="MIME-Version: 1.0" 109927 "RTN","C0CMIME",210,0) 109928 S GM(2)="Content-Type: multipart/mixed; boudary=""1234567""" 109929 "RTN","C0CMIME",211,0) 109930 S GM(3)="" 109931 "RTN","C0CMIME",212,0) 109932 S GM(4)="" 109933 "RTN","C0CMIME",213,0) 109934 S GM(5)="--1234567" 109935 "RTN","C0CMIME",214,0) 109936 ;S GM(5)=$$REPEAT^XLFSTR("-",$L(X)) 109937 "RTN","C0CMIME",215,0) 109938 S GM(6)="Content-Type: text/xml; name=""ccr.xml""" 109939 "RTN","C0CMIME",216,0) 109940 S GM(7)="Content-Transfer-Encoding: base64" 109941 "RTN","C0CMIME",217,0) 109942 S GM(8)="Content-Disposition: attachment; filename=""ccr.xml""" 109943 "RTN","C0CMIME",218,0) 109944 ;S GM(6)=$$UUBEGFN^LRSRVR2A("CCR.xml") 109945 "RTN","C0CMIME",219,0) 109946 S GM(9)="" 109947 "RTN","C0CMIME",220,0) 109948 S GM(10)="" ; FOR THE END 109949 "RTN","C0CMIME",221,0) 109950 S GM(11)="--frontier--" 109951 "RTN","C0CMIME",222,0) 109952 S GM(12)="." 109953 "RTN","C0CMIME",223,0) 109954 S GM(13)="" 109955 "RTN","C0CMIME",224,0) 109956 K GBLD 109957 "RTN","C0CMIME",225,0) 109958 ;D QUEUE^C0CXPATH("GBLD","GM",1,9) 109959 "RTN","C0CMIME",226,0) 109960 ;D QUEUE^C0CXPATH("GBLD","G2",1,$O(G2(""),-1)) 109961 "RTN","C0CMIME",227,0) 109962 ;D QUEUE^C0CXPATH("GBLD","GM",10,13) 109963 "RTN","C0CMIME",228,0) 109964 ;D BUILD^C0CXPATH("GBLD",GN) 109965 "RTN","C0CMIME",229,0) 109966 S GGG=$NA(^GPL("MIME2")) 109967 "RTN","C0CMIME",230,0) 109968 ;D QUEUE^C0CXPATH("GBLD","GM",1,1) 109969 "RTN","C0CMIME",231,0) 109970 D QUEUE^C0CXPATH("GBLD",GGG,21,159) 109971 "RTN","C0CMIME",232,0) 109972 D BUILD^C0CXPATH("GBLD",GN) 109973 "RTN","C0CMIME",233,0) 109974 K @GN@(0) ; KILL THE LINE COUNT 109975 "RTN","C0CMIME",234,0) 109976 K LRINSTR,LRTASK,LRTO,XMERR,XMZ 109977 "RTN","C0CMIME",235,0) 109978 S XQSND="glilly@glilly.net" 109979 "RTN","C0CMIME",236,0) 109980 ;S XQSND="nanthracite@earthlink.net" 109981 "RTN","C0CMIME",237,0) 109982 ;S XQSND="dlefevre@orohosp.com" 109983 "RTN","C0CMIME",238,0) 109984 ;S XQSND="gregwoodhouse@me.com" 109985 "RTN","C0CMIME",239,0) 109986 ;S XQSND="rick.marshall@vistaexpertise.net" 109987 "RTN","C0CMIME",240,0) 109988 S LRTO(XQSND)="" 109989 "RTN","C0CMIME",241,0) 109990 S LRINSTR("ADDR FLAGS")="R" 109991 "RTN","C0CMIME",242,0) 109992 S LRINSTR("FROM")="CCR_PACKAGE" 109993 "RTN","C0CMIME",243,0) 109994 S LRMSUBJ="A SAMPLE CCR" 109995 "RTN","C0CMIME",244,0) 109996 S LRMSUBJ=$E(LRMSUBJ,1,65) 109997 "RTN","C0CMIME",245,0) 109998 D SENDMSG^XMXAPI(9,LRMSUBJ,GN,.LRTO,.LRINSTR,.LRTASK) 109999 "RTN","C0CMIME",246,0) 110000 I $G(XMERR)=1 W !,"ERROR SENDING MESSAGE" Q ; 110001 "RTN","C0CMIME",247,0) 110002 ;S ^XMB(3.9,LRTASK,1,.1130590,0)="MIME-Version: 1.0" 110003 "RTN","C0CMIME",248,0) 110004 ;S ^XMB(3.9,LRTASK,1,.1130591,0)="Content-type: multipart/mixed; boundary=000e0cd6ae026c3d4b049e7befe9" 110005 "RTN","C0CMIME",249,0) 110006 Q 110007 "RTN","C0CMIME",250,0) 110008 ; 110009 "RTN","C0CMIME",251,0) 110010 MAILSEN2(UDFN,ADDR) ; Send extract back to requestor. 110011 "RTN","C0CMIME",252,0) 110012 ; 110013 "RTN","C0CMIME",253,0) 110014 I +$G(UDFN)=0 S UDFN=2 ; 110015 "RTN","C0CMIME",254,0) 110016 D TEST(UDFN) 110017 "RTN","C0CMIME",255,0) 110018 S GN=$NA(^TMP($J,"C0CMIME")) 110019 "RTN","C0CMIME",256,0) 110020 K @GN 110021 "RTN","C0CMIME",257,0) 110022 ;M @GN=G2 110023 "RTN","C0CMIME",258,0) 110024 S GM(1)="MIME-Version: 1.0" 110025 "RTN","C0CMIME",259,0) 110026 S GM(2)="Content-Type: multipart/mixed; boudary=""1234567""" 110027 "RTN","C0CMIME",260,0) 110028 S GM(3)="" 110029 "RTN","C0CMIME",261,0) 110030 S GM(4)="" 110031 "RTN","C0CMIME",262,0) 110032 S GM(5)="--1234567" 110033 "RTN","C0CMIME",263,0) 110034 ;S GM(5)=$$REPEAT^XLFSTR("-",$L(X)) 110035 "RTN","C0CMIME",264,0) 110036 S GM(6)="Content-Type: text/xml; name=""ccr.xml""" 110037 "RTN","C0CMIME",265,0) 110038 S GM(7)="Content-Transfer-Encoding: base64" 110039 "RTN","C0CMIME",266,0) 110040 S GM(8)="Content-Disposition: attachment; filename=""ccr.xml""" 110041 "RTN","C0CMIME",267,0) 110042 ;S GM(6)=$$UUBEGFN^LRSRVR2A("CCR.xml") 110043 "RTN","C0CMIME",268,0) 110044 S GM(9)="" 110045 "RTN","C0CMIME",269,0) 110046 S GM(10)="" ; FOR THE END 110047 "RTN","C0CMIME",270,0) 110048 S GM(11)="--1234567--" 110049 "RTN","C0CMIME",271,0) 110050 S GM(12)="" 110051 "RTN","C0CMIME",272,0) 110052 S GM(13)="" 110053 "RTN","C0CMIME",273,0) 110054 K GBLD 110055 "RTN","C0CMIME",274,0) 110056 D QUEUE^C0CXPATH("GBLD","GM",5,9) 110057 "RTN","C0CMIME",275,0) 110058 D QUEUE^C0CXPATH("GBLD","G2",1,$O(G2(""),-1)) 110059 "RTN","C0CMIME",276,0) 110060 D QUEUE^C0CXPATH("GBLD","GM",10,12) 110061 "RTN","C0CMIME",277,0) 110062 D BUILD^C0CXPATH("GBLD",GN) 110063 "RTN","C0CMIME",278,0) 110064 S GGG=$NA(^GPL("MIME2")) 110065 "RTN","C0CMIME",279,0) 110066 ;D QUEUE^C0CXPATH("GBLD","GM",1,1) 110067 "RTN","C0CMIME",280,0) 110068 ;D QUEUE^C0CXPATH("GBLD",GGG,21,159) 110069 "RTN","C0CMIME",281,0) 110070 ;D BUILD^C0CXPATH("GBLD",GN) 110071 "RTN","C0CMIME",282,0) 110072 K @GN@(0) ; KILL THE LINE COUNT 110073 "RTN","C0CMIME",283,0) 110074 K LRINSTR,LRTASK,LRTO,XMERR,XMZ 110075 "RTN","C0CMIME",284,0) 110076 I $G(ADDR)'="" S XQSND=ADDR 110077 "RTN","C0CMIME",285,0) 110078 E S XQSND="glilly@glilly.net" 110079 "RTN","C0CMIME",286,0) 110080 ;S XQSND="nanthracite@earthlink.net" 110081 "RTN","C0CMIME",287,0) 110082 ;S XQSND="dlefevre@orohosp.com" 110083 "RTN","C0CMIME",288,0) 110084 ;S XQSND="gregwoodhouse@me.com" 110085 "RTN","C0CMIME",289,0) 110086 ;S XQSND="rick.marshall@vistaexpertise.net" 110087 "RTN","C0CMIME",290,0) 110088 S LRTO(XQSND)="" 110089 "RTN","C0CMIME",291,0) 110090 ;S LRTO("glilly@glilly.net")="" 110091 "RTN","C0CMIME",292,0) 110092 S LRINSTR("ADDR FLAGS")="R" 110093 "RTN","C0CMIME",293,0) 110094 S LRINSTR("FROM")="ANTHRACITE.NANCY" 110095 "RTN","C0CMIME",294,0) 110096 S LRMSUBJ="Sending a CCR with Mailman" 110097 "RTN","C0CMIME",295,0) 110098 S LRMSUBJ=$E(LRMSUBJ,1,65) 110099 "RTN","C0CMIME",296,0) 110100 D SENDMSG^XMXAPI(9,LRMSUBJ,GN,.LRTO,.LRINSTR,.LRTASK) 110101 "RTN","C0CMIME",297,0) 110102 I $G(XMERR)=1 W !,"ERROR SENDING MESSAGE" Q ; 110103 "RTN","C0CMIME",298,0) 110104 ;S ^XMB(3.9,LRTASK,1,.1130590,0)="MIME-Version: 1.0" 110105 "RTN","C0CMIME",299,0) 110106 ;S ^XMB(3.9,LRTASK,1,.1130591,0)="Content-type: multipart/mixed; boundary=000e0cd6ae026c3d4b049e7befe9" 110107 "RTN","C0CMIME",300,0) 110108 Q 110109 "RTN","C0CMIME",301,0) 110110 ; 110111 "RTN","C0CMIME",302,0) 110112 SIMPLE ; 110113 "RTN","C0CMIME",303,0) 110114 S GN(1)="SIMPLE TEST MESSAGE" 110115 "RTN","C0CMIME",304,0) 110116 K LRINSTR,LRTASK,LRTO,XMERR,XMZ 110117 "RTN","C0CMIME",305,0) 110118 S XQSND="glilly@glilly.net" 110119 "RTN","C0CMIME",306,0) 110120 S LRTO(XQSND)="" 110121 "RTN","C0CMIME",307,0) 110122 S LRINSTR("ADDR FLAGS")="R" 110123 "RTN","C0CMIME",308,0) 110124 S LRINSTR("FROM")="CCR_PACKAGE" 110125 "RTN","C0CMIME",309,0) 110126 S LRMSUBJ="A SAMPLE CCR" 110127 "RTN","C0CMIME",310,0) 110128 S LRMSUBJ=$E(LRMSUBJ,1,65) 110129 "RTN","C0CMIME",311,0) 110130 D SENDMSG^XMXAPI(9,LRMSUBJ,"GN",.LRTO,.LRINSTR,.LRTASK) 110131 "RTN","C0CMIME",312,0) 110132 Q 110133 "RTN","C0CMIME",313,0) 110134 CHUNK(OUTXML,INXML,ZSIZE) ; BREAKS INXML INTO ZSIZE BLOCKS 110135 "RTN","C0CMIME",314,0) 110136 ; INXML IS AN ARRAY PASSED BY NAME OF STRINGS 110137 "RTN","C0CMIME",315,0) 110138 ; OUTXML IS ALSO PASSED BY NAME 110139 "RTN","C0CMIME",316,0) 110140 ; IF ZSIZE IS NOT PASSED, 1000 IS USED 110141 "RTN","C0CMIME",317,0) 110142 I '$D(ZSIZE) S ZSIZE=1000 ; DEFAULT BLOCK SIZE 110143 "RTN","C0CMIME",318,0) 110144 N ZB,ZI,ZJ,ZK,ZL,ZN 110145 "RTN","C0CMIME",319,0) 110146 S ZB=ZSIZE-1 110147 "RTN","C0CMIME",320,0) 110148 S ZN=1 110149 "RTN","C0CMIME",321,0) 110150 S ZI=0 ; BEGINNING OF INDEX TO INXML 110151 "RTN","C0CMIME",322,0) 110152 F S ZI=$O(@INXML@(ZI)) Q:+ZI=0 D ; FOR EACH STRING IN INXML 110153 "RTN","C0CMIME",323,0) 110154 . S ZL=$L(@INXML@(ZI)) ; LENGTH OF THE STRING 110155 "RTN","C0CMIME",324,0) 110156 . F ZJ=1:ZSIZE:ZL D ; 110157 "RTN","C0CMIME",325,0) 110158 . . S ZK=$S(ZJ+ZB<ZL:ZJ+ZB,1:ZL) ; END FOR EXTRACT 110159 "RTN","C0CMIME",326,0) 110160 . . S @OUTXML@(ZN)=$E(@INXML@(ZI),ZJ,ZK) ; PULL OUT THE PIECE 110161 "RTN","C0CMIME",327,0) 110162 . . S ZN=ZN+1 ; INCREMENT OUT ARRAY INDEX 110163 "RTN","C0CMIME",328,0) 110164 Q 110165 "RTN","C0CMIME",329,0) 110166 ; 110167 "RTN","C0CMIME",330,0) 110168 CLEAN(IARY) ; RUNS THROUGH AN ARRAY PASSED BY NAME AND STRIPS OUT $C(13) 110169 "RTN","C0CMIME",331,0) 110170 ; 110171 "RTN","C0CMIME",332,0) 109606 110172 N ZI S ZI=0 109607 "RTN","C0CMIME",40,0) 109608 F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH LINE 109609 "RTN","C0CMIME",41,0) 109610 . S ZCOPY(1)=ZCOPY(1)_@ZARY@(ZI) 109611 "RTN","C0CMIME",42,0) 109612 N G 109613 "RTN","C0CMIME",43,0) 109614 S G(1)=$$ENCODE^RGUTUU(ZCOPY(1)) 109615 "RTN","C0CMIME",44,0) 109616 D CHUNK(ZRTN,"G",45) 109617 "RTN","C0CMIME",45,0) 110173 "RTN","C0CMIME",333,0) 110174 F S ZI=$O(@IARY@(ZI)) Q:+ZI=0 D ; 110175 "RTN","C0CMIME",334,0) 110176 . S @IARY@(ZI)=$TR(@IARY@(ZI),$C(13)) ; 110177 "RTN","C0CMIME",335,0) 110178 . I $F(@IARY@(ZI)," <") S @IARY@(ZI)="<"_$P(@IARY@(ZI)," <",2) ; RM BLNKS 110179 "RTN","C0CMIME",336,0) 109618 110180 Q 109619 "RTN","C0CMIME",46,0)109620 ; THIS ROUTINE WAS COPIED FROM LRSRVR4 AND THEN MODIFIED . THANKS JOHN109621 "RTN","C0CMIME",47,0)109622 ENCODEOLD(IARY,LRNODE,LRSTR) ; Encode a string, keep remainder for next line109623 "RTN","C0CMIME",48,0)109624 ; Call with LRSTR by reference, Remainder returned in LRSTR109625 "RTN","C0CMIME",49,0)109626 ; IARY IS PASSED BY NAME109627 "RTN","C0CMIME",50,0)109628 S LRQUIT=0,LRLEN=$L(LRSTR)109629 "RTN","C0CMIME",51,0)109630 F D Q:LRQUIT109631 "RTN","C0CMIME",52,0)109632 . I $L(LRSTR)<45 S LRQUIT=1 Q109633 "RTN","C0CMIME",53,0)109634 . S LRX=$E(LRSTR,1,45)109635 "RTN","C0CMIME",54,0)109636 . S LRNODE=LRNODE+1,@IARY@(LRNODE)=$$UUEN^LRSRVR4(LRX)109637 "RTN","C0CMIME",55,0)109638 . S LRSTR=$E(LRSTR,46,LRLEN)109639 "RTN","C0CMIME",56,0)109640 Q109641 "RTN","C0CMIME",57,0)109642 ;109643 "RTN","C0CMIME",58,0)109644 TESTMAIL ;109645 "RTN","C0CMIME",59,0)109646 ; TEST OF MAILSEND109647 "RTN","C0CMIME",60,0)109648 ;S ZTO("glilly@glilly.net")=""109649 "RTN","C0CMIME",61,0)109650 S ZTO("mish@nhin.openforum.opensourcevista.net")=""109651 "RTN","C0CMIME",62,0)109652 ;S ZTO("martijn@djigzo.com")=""109653 "RTN","C0CMIME",63,0)109654 ;S ZTO("profmish@gmail.com")=""109655 "RTN","C0CMIME",64,0)109656 ;S ZTO("nanthracite@earthlink.net")=""109657 "RTN","C0CMIME",65,0)109658 S ZFROM="ANTHRACITE.NANCY"109659 "RTN","C0CMIME",66,0)109660 S ZATTACH=$NA(^GPL("CCR"))109661 "RTN","C0CMIME",67,0)109662 I $G(@ZATTACH@(1))="" D ; NO CCR THERE109663 "RTN","C0CMIME",68,0)109664 . D CCRRPC^C0CCCR(.GPL,2) ; GET ONE FROM PATIENT 2109665 "RTN","C0CMIME",69,0)109666 . M @ZATTACH=GPL ; PUT IT IN THERE FOR NEXT TIME109667 "RTN","C0CMIME",70,0)109668 S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE"109669 "RTN","C0CMIME",71,0)109670 D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,,ZATTACH)109671 "RTN","C0CMIME",72,0)109672 ZWR GR109673 "RTN","C0CMIME",73,0)109674 Q109675 "RTN","C0CMIME",74,0)109676 ;109677 "RTN","C0CMIME",75,0)109678 TESTMAIL2 ;109679 "RTN","C0CMIME",76,0)109680 ; TEST OF MAILSEND TO gpl.mdc-crew.net109681 "RTN","C0CMIME",77,0)109682 N C0CGM109683 "RTN","C0CMIME",78,0)109684 S C0CGM(1)="This is a test message."109685 "RTN","C0CMIME",79,0)109686 S C0CGM(2)="A Continuity of Care record is attached"109687 "RTN","C0CMIME",80,0)109688 S C0CGM(3)="It contains no Protected Health Information (PHI)"109689 "RTN","C0CMIME",81,0)109690 S C0CGM(4)="It is purely test data used for software development"109691 "RTN","C0CMIME",82,0)109692 S C0CGM(5)="It does not represent information about any person living or dead"109693 "RTN","C0CMIME",83,0)109694 ;S ZTO("glilly@glilly.net")=""109695 "RTN","C0CMIME",84,0)109696 ;S ZTO("george.lilly@pobox.com")=""109697 "RTN","C0CMIME",85,0)109698 ;S ZTO("george@nhin.openforum.opensourcevista.net")=""109699 "RTN","C0CMIME",86,0)109700 ;S ZTO("mish@nhin.openforum.opensourcevista.net")=""109701 "RTN","C0CMIME",87,0)109702 S ZTO("brooks.richard@securemail.opensourcevista.net")=""109703 "RTN","C0CMIME",88,0)109704 ;S ZTO("LILLY.GEORGE@mdc-crew.net")=""109705 "RTN","C0CMIME",89,0)109706 ;S ZTO("ncoal@live.com")=""109707 "RTN","C0CMIME",90,0)109708 ;S ZTO("martijn@djigzo.com")=""109709 "RTN","C0CMIME",91,0)109710 ;S ZTO("profmish@gmail.com")=""109711 "RTN","C0CMIME",92,0)109712 ;S ZTO("nanthracite@earthlink.net")=""109713 "RTN","C0CMIME",93,0)109714 S ZTO("gpl.doctortest@gmail.com")=""109715 "RTN","C0CMIME",94,0)109716 S ZFROM="LILLY.GEORGE"109717 "RTN","C0CMIME",95,0)109718 S ZATTACH=$NA(^GPL("CCR"))109719 "RTN","C0CMIME",96,0)109720 I $G(@ZATTACH@(1))="" D ; NO CCR THERE109721 "RTN","C0CMIME",97,0)109722 . D CCRRPC^C0CCCR(.GPL,2) ; GET ONE FROM PATIENT 2109723 "RTN","C0CMIME",98,0)109724 . M @ZATTACH=GPL ; PUT IT IN THERE FOR NEXT TIME109725 "RTN","C0CMIME",99,0)109726 S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE"109727 "RTN","C0CMIME",100,0)109728 D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,"C0CGM",ZATTACH,"CCR.xml")109729 "RTN","C0CMIME",101,0)109730 ZWR GR109731 "RTN","C0CMIME",102,0)109732 Q109733 "RTN","C0CMIME",103,0)109734 ;109735 "RTN","C0CMIME",104,0)109736 LINE(C0CFILE,C0CTO) ; read a file name passed in C0CFILE and send it to109737 "RTN","C0CMIME",105,0)109738 ; the email address in C0CTO109739 "RTN","C0CMIME",106,0)109740 ; the directory and the "from" are all hard coded109741 "RTN","C0CMIME",107,0)109742 ;109743 "RTN","C0CMIME",108,0)109744 N ZZFROM S ZZFROM="LILLY.GEORGE"109745 "RTN","C0CMIME",109,0)109746 N GN S GN=$NA(^TMP("C0CMIME2",$J))109747 "RTN","C0CMIME",110,0)109748 N GN1 S GN1=$NA(@GN@(1))109749 "RTN","C0CMIME",111,0)109750 K @GN109751 "RTN","C0CMIME",112,0)109752 I '$D(C0CFILE) Q ; NO FILENAME PASSED109753 "RTN","C0CMIME",113,0)109754 I '$D(C0CTO) S C0CTO="brooks.richard@securemail.opensourcevista.net"109755 "RTN","C0CMIME",114,0)109756 S ZZTO(C0CTO)=""109757 "RTN","C0CMIME",115,0)109758 N ZMESS S ZMESS(1)="file transmission from wvehr3-09"109759 "RTN","C0CMIME",116,0)109760 N GD S GD="/home/wvehr3-09/EHR/" ; directory109761 "RTN","C0CMIME",117,0)109762 I '$$FTG^%ZISH(GD,C0CFILE,GN1,3) Q D ;109763 "RTN","C0CMIME",118,0)109764 . W !,"error reading file",C0CFILE109765 "RTN","C0CMIME",119,0)109766 D MAILSEND(.ZRTN,ZZFROM,"ZZTO",,"file transmission","ZMESS",GN,C0CFILE)109767 "RTN","C0CMIME",120,0)109768 K @GN ; CLEAN UP109769 "RTN","C0CMIME",121,0)109770 ;ZWR ZRTN109771 "RTN","C0CMIME",122,0)109772 W !,$G(ZRTN(1))109773 "RTN","C0CMIME",123,0)109774 Q109775 "RTN","C0CMIME",124,0)109776 ;109777 "RTN","C0CMIME",125,0)109778 MAILSEND(RTN,FROM,TO,CC,SUBJECT,MESSAGE,ATTACH,FNAME,FLAGS) ; MAIL SENDING INTERFACE109779 "RTN","C0CMIME",126,0)109780 ; RTN IS THE RETURN ARRAY PASSED BY REFERENCE109781 "RTN","C0CMIME",127,0)109782 ; FROM IS PASSED BY VALUE AND IS THE EMAIL ADDRESS OF THE SENDER109783 "RTN","C0CMIME",128,0)109784 ; IF NULL, WILL SEND FROM THE CURRENT DUZ109785 "RTN","C0CMIME",129,0)109786 ; TO AND CC ARE RECIEPIENT EMAIL ADDRESSES PASSED BY NAME109787 "RTN","C0CMIME",130,0)109788 ; @TO@("addr1@domain1.net")109789 "RTN","C0CMIME",131,0)109790 ; @CC@("addr2@domain2.com") both can be multiples109791 "RTN","C0CMIME",132,0)109792 ; SUBJECT IS PASSED BY VALUE AND WILL GO IN THE SUBJECT LINE109793 "RTN","C0CMIME",133,0)109794 ; MESSAGE IS PASSED BY NAME AND IS AN ARRAY OF TEXT109795 "RTN","C0CMIME",134,0)109796 ; ATTACH IS PASSED BY NAME AND IS AN XML OR HTML FILE TO BE ATTACHED109797 "RTN","C0CMIME",135,0)109798 ; FNAME IS THE FILENAME OF THE ATTACHMENT, DEFAULT IS ccr.xml109799 "RTN","C0CMIME",136,0)109800 ;109801 "RTN","C0CMIME",137,0)109802 I '$D(FNAME) S FNAME="ccr.xml" ; default filename109803 "RTN","C0CMIME",138,0)109804 N GN109805 "RTN","C0CMIME",139,0)109806 S GN=$NA(^TMP($J,"C0CMIME"))109807 "RTN","C0CMIME",140,0)109808 K @GN109809 "RTN","C0CMIME",141,0)109810 S GM(1)="MIME-Version: 1.0"109811 "RTN","C0CMIME",142,0)109812 S GM(2)="Content-Type: multipart/mixed; boudary=""1234567"""109813 "RTN","C0CMIME",143,0)109814 S GM(3)=""109815 "RTN","C0CMIME",144,0)109816 S GM(4)=""109817 "RTN","C0CMIME",145,0)109818 ;S GM(5)="--123456788888"109819 "RTN","C0CMIME",146,0)109820 ;S GM(5)=$$REPEAT^XLFSTR("-",$L(X))109821 "RTN","C0CMIME",147,0)109822 S GM(5)="--123456899999"109823 "RTN","C0CMIME",148,0)109824 S GM(6)="Content-Type: text/xml; name="_FNAME109825 "RTN","C0CMIME",149,0)109826 S GM(7)="Content-Transfer-Encoding: base64"109827 "RTN","C0CMIME",150,0)109828 S GM(8)="Content-Disposition: attachment; filename="_FNAME109829 "RTN","C0CMIME",151,0)109830 S GM(9)=""109831 "RTN","C0CMIME",152,0)109832 S GM(10)="" ; FOR THE END109833 "RTN","C0CMIME",153,0)109834 ;S GM(11)="--123456788888--"109835 "RTN","C0CMIME",154,0)109836 S GM(11)="--123456899999--"109837 "RTN","C0CMIME",155,0)109838 S GM(12)=""109839 "RTN","C0CMIME",156,0)109840 S GM(13)=""109841 "RTN","C0CMIME",157,0)109842 S GG(1)="--123456899999"109843 "RTN","C0CMIME",158,0)109844 S GG(2)="Content-Type: text/plain; charset=ISO-8859-1; format=flowed"109845 "RTN","C0CMIME",159,0)109846 S GG(3)="Content-Transfer-Encoding: 7bit"109847 "RTN","C0CMIME",160,0)109848 S GG(4)=""109849 "RTN","C0CMIME",161,0)109850 S GG(5)="This is a test message."109851 "RTN","C0CMIME",162,0)109852 S GG(6)="A Continuity of Care record is attached"109853 "RTN","C0CMIME",163,0)109854 S GG(7)="It contains no Protected Health Information (PHI)"109855 "RTN","C0CMIME",164,0)109856 S GG(8)="It is purely test data used for software development"109857 "RTN","C0CMIME",165,0)109858 S GG(9)="It does not represent information about any person living or dead"109859 "RTN","C0CMIME",166,0)109860 S GG(10)=""109861 "RTN","C0CMIME",167,0)109862 S GG(11)="--123456899999--"109863 "RTN","C0CMIME",168,0)109864 ;S GG(11)="Content-Type: text/plain; charset=""us-ascii"""109865 "RTN","C0CMIME",169,0)109866 S GG(12)=""109867 "RTN","C0CMIME",170,0)109868 ;S GG(13)="This is a test message."109869 "RTN","C0CMIME",171,0)109870 S GG(14)="A Continuity of Care record is attached"109871 "RTN","C0CMIME",172,0)109872 S GG(15)="It contains no Protected Health Information (PHI)"109873 "RTN","C0CMIME",173,0)109874 S GG(16)="It is purely test data used for software development"109875 "RTN","C0CMIME",174,0)109876 S GG(17)="It does not represent information about any person living or dead"109877 "RTN","C0CMIME",175,0)109878 S GG(18)=""109879 "RTN","C0CMIME",176,0)109880 S GG(19)="--123456899999"109881 "RTN","C0CMIME",177,0)109882 S GG(20)="--987654321--"109883 "RTN","C0CMIME",178,0)109884 K GBLD109885 "RTN","C0CMIME",179,0)109886 ;D QUEUE^C0CXPATH("GBLD","GGG",1,3) ; THE MESSAGE109887 "RTN","C0CMIME",180,0)109888 ;D QUEUE^C0CXPATH("GBLD","GG",1,10) ; THE MESSAGE109889 "RTN","C0CMIME",181,0)109890 I $D(MESSAGE)'="" D ; THERE IS A MESSAGE109891 "RTN","C0CMIME",182,0)109892 . D QUEUE^C0CXPATH("GBLD","GG",1,4) ; THE MIME BOUNDARY109893 "RTN","C0CMIME",183,0)109894 . D QUEUE^C0CXPATH("GBLD",MESSAGE,1,$O(@MESSAGE@(""),-1)) ;THE MESSAGE109895 "RTN","C0CMIME",184,0)109896 . D QUEUE^C0CXPATH("GBLD","GG",10,10) ;A BLANK LINE109897 "RTN","C0CMIME",185,0)109898 D QUEUE^C0CXPATH("GBLD","GM",5,9)109899 "RTN","C0CMIME",186,0)109900 I $D(ATTACH)'="" D ; IF WE HAVE AN ATTACHMENT109901 "RTN","C0CMIME",187,0)109902 . D ENCODE("G2",ATTACH) ; ENCODE FOR SENDING109903 "RTN","C0CMIME",188,0)109904 . D QUEUE^C0CXPATH("GBLD","G2",1,$O(G2(""),-1))109905 "RTN","C0CMIME",189,0)109906 D QUEUE^C0CXPATH("GBLD","GM",11,12)109907 "RTN","C0CMIME",190,0)109908 D BUILD^C0CXPATH("GBLD",GN)109909 "RTN","C0CMIME",191,0)109910 ;S GGG=$NA(^GPL("MIME2"))109911 "RTN","C0CMIME",192,0)109912 K @GN@(0) ; KILL THE LINE COUNT109913 "RTN","C0CMIME",193,0)109914 K LRINSTR,LRTASK,LRTO,XMERR,XMZ109915 "RTN","C0CMIME",194,0)109916 M LRTO=@TO109917 "RTN","C0CMIME",195,0)109918 I $D(CC) M LRTO=@CC109919 "RTN","C0CMIME",196,0)109920 S LRINSTR("ADDR FLAGS")="R"109921 "RTN","C0CMIME",197,0)109922 S LRINSTR("FROM")=$G(FROM)109923 "RTN","C0CMIME",198,0)109924 S LRMSUBJ=$G(SUBJECT)109925 "RTN","C0CMIME",199,0)109926 S LRMSUBJ=$E(LRMSUBJ,1,65)109927 "RTN","C0CMIME",200,0)109928 D SENDMSG^XMXAPI(DUZ,LRMSUBJ,GN,.LRTO,.LRINSTR,.LRTASK)109929 "RTN","C0CMIME",201,0)109930 I $G(XMERR)=1 S RTN(1)="ERROR SENDING MESSAGE" Q ;109931 "RTN","C0CMIME",202,0)109932 S RTN(1)="OK"109933 "RTN","C0CMIME",203,0)109934 Q109935 "RTN","C0CMIME",204,0)109936 ;109937 "RTN","C0CMIME",205,0)109938 MAILSEND0(LRMSUBJ) ; Send extract back to requestor.109939 "RTN","C0CMIME",206,0)109940 ;109941 "RTN","C0CMIME",207,0)109942 ;D TEST109943 "RTN","C0CMIME",208,0)109944 S GN=$NA(^TMP($J,"C0CMIME"))109945 "RTN","C0CMIME",209,0)109946 K @GN109947 "RTN","C0CMIME",210,0)109948 ;M @GN=G2109949 "RTN","C0CMIME",211,0)109950 S GM(1)="MIME-Version: 1.0"109951 "RTN","C0CMIME",212,0)109952 S GM(2)="Content-Type: multipart/mixed; boudary=""1234567"""109953 "RTN","C0CMIME",213,0)109954 S GM(3)=""109955 "RTN","C0CMIME",214,0)109956 S GM(4)=""109957 "RTN","C0CMIME",215,0)109958 S GM(5)="--1234567"109959 "RTN","C0CMIME",216,0)109960 ;S GM(5)=$$REPEAT^XLFSTR("-",$L(X))109961 "RTN","C0CMIME",217,0)109962 S GM(6)="Content-Type: text/xml; name=""ccr.xml"""109963 "RTN","C0CMIME",218,0)109964 S GM(7)="Content-Transfer-Encoding: base64"109965 "RTN","C0CMIME",219,0)109966 S GM(8)="Content-Disposition: attachment; filename=""ccr.xml"""109967 "RTN","C0CMIME",220,0)109968 ;S GM(6)=$$UUBEGFN^LRSRVR2A("CCR.xml")109969 "RTN","C0CMIME",221,0)109970 S GM(9)=""109971 "RTN","C0CMIME",222,0)109972 S GM(10)="" ; FOR THE END109973 "RTN","C0CMIME",223,0)109974 S GM(11)="--frontier--"109975 "RTN","C0CMIME",224,0)109976 S GM(12)="."109977 "RTN","C0CMIME",225,0)109978 S GM(13)=""109979 "RTN","C0CMIME",226,0)109980 K GBLD109981 "RTN","C0CMIME",227,0)109982 ;D QUEUE^C0CXPATH("GBLD","GM",1,9)109983 "RTN","C0CMIME",228,0)109984 ;D QUEUE^C0CXPATH("GBLD","G2",1,$O(G2(""),-1))109985 "RTN","C0CMIME",229,0)109986 ;D QUEUE^C0CXPATH("GBLD","GM",10,13)109987 "RTN","C0CMIME",230,0)109988 ;D BUILD^C0CXPATH("GBLD",GN)109989 "RTN","C0CMIME",231,0)109990 S GGG=$NA(^GPL("MIME2"))109991 "RTN","C0CMIME",232,0)109992 ;D QUEUE^C0CXPATH("GBLD","GM",1,1)109993 "RTN","C0CMIME",233,0)109994 D QUEUE^C0CXPATH("GBLD",GGG,21,159)109995 "RTN","C0CMIME",234,0)109996 D BUILD^C0CXPATH("GBLD",GN)109997 "RTN","C0CMIME",235,0)109998 K @GN@(0) ; KILL THE LINE COUNT109999 "RTN","C0CMIME",236,0)110000 K LRINSTR,LRTASK,LRTO,XMERR,XMZ110001 "RTN","C0CMIME",237,0)110002 S XQSND="glilly@glilly.net"110003 "RTN","C0CMIME",238,0)110004 ;S XQSND="nanthracite@earthlink.net"110005 "RTN","C0CMIME",239,0)110006 ;S XQSND="dlefevre@orohosp.com"110007 "RTN","C0CMIME",240,0)110008 ;S XQSND="gregwoodhouse@me.com"110009 "RTN","C0CMIME",241,0)110010 ;S XQSND="rick.marshall@vistaexpertise.net"110011 "RTN","C0CMIME",242,0)110012 S LRTO(XQSND)=""110013 "RTN","C0CMIME",243,0)110014 S LRINSTR("ADDR FLAGS")="R"110015 "RTN","C0CMIME",244,0)110016 S LRINSTR("FROM")="CCR_PACKAGE"110017 "RTN","C0CMIME",245,0)110018 S LRMSUBJ="A SAMPLE CCR"110019 "RTN","C0CMIME",246,0)110020 S LRMSUBJ=$E(LRMSUBJ,1,65)110021 "RTN","C0CMIME",247,0)110022 D SENDMSG^XMXAPI(9,LRMSUBJ,GN,.LRTO,.LRINSTR,.LRTASK)110023 "RTN","C0CMIME",248,0)110024 I $G(XMERR)=1 W !,"ERROR SENDING MESSAGE" Q ;110025 "RTN","C0CMIME",249,0)110026 ;S ^XMB(3.9,LRTASK,1,.1130590,0)="MIME-Version: 1.0"110027 "RTN","C0CMIME",250,0)110028 ;S ^XMB(3.9,LRTASK,1,.1130591,0)="Content-type: multipart/mixed; boundary=000e0cd6ae026c3d4b049e7befe9"110029 "RTN","C0CMIME",251,0)110030 Q110031 "RTN","C0CMIME",252,0)110032 ;110033 "RTN","C0CMIME",253,0)110034 MAILSEND2(UDFN,ADDR) ; Send extract back to requestor.110035 "RTN","C0CMIME",254,0)110036 ;110037 "RTN","C0CMIME",255,0)110038 I +$G(UDFN)=0 S UDFN=2 ;110039 "RTN","C0CMIME",256,0)110040 D TEST(UDFN)110041 "RTN","C0CMIME",257,0)110042 S GN=$NA(^TMP($J,"C0CMIME"))110043 "RTN","C0CMIME",258,0)110044 K @GN110045 "RTN","C0CMIME",259,0)110046 ;M @GN=G2110047 "RTN","C0CMIME",260,0)110048 S GM(1)="MIME-Version: 1.0"110049 "RTN","C0CMIME",261,0)110050 S GM(2)="Content-Type: multipart/mixed; boudary=""1234567"""110051 "RTN","C0CMIME",262,0)110052 S GM(3)=""110053 "RTN","C0CMIME",263,0)110054 S GM(4)=""110055 "RTN","C0CMIME",264,0)110056 S GM(5)="--1234567"110057 "RTN","C0CMIME",265,0)110058 ;S GM(5)=$$REPEAT^XLFSTR("-",$L(X))110059 "RTN","C0CMIME",266,0)110060 S GM(6)="Content-Type: text/xml; name=""ccr.xml"""110061 "RTN","C0CMIME",267,0)110062 S GM(7)="Content-Transfer-Encoding: base64"110063 "RTN","C0CMIME",268,0)110064 S GM(8)="Content-Disposition: attachment; filename=""ccr.xml"""110065 "RTN","C0CMIME",269,0)110066 ;S GM(6)=$$UUBEGFN^LRSRVR2A("CCR.xml")110067 "RTN","C0CMIME",270,0)110068 S GM(9)=""110069 "RTN","C0CMIME",271,0)110070 S GM(10)="" ; FOR THE END110071 "RTN","C0CMIME",272,0)110072 S GM(11)="--1234567--"110073 "RTN","C0CMIME",273,0)110074 S GM(12)=""110075 "RTN","C0CMIME",274,0)110076 S GM(13)=""110077 "RTN","C0CMIME",275,0)110078 K GBLD110079 "RTN","C0CMIME",276,0)110080 D QUEUE^C0CXPATH("GBLD","GM",5,9)110081 "RTN","C0CMIME",277,0)110082 D QUEUE^C0CXPATH("GBLD","G2",1,$O(G2(""),-1))110083 "RTN","C0CMIME",278,0)110084 D QUEUE^C0CXPATH("GBLD","GM",10,12)110085 "RTN","C0CMIME",279,0)110086 D BUILD^C0CXPATH("GBLD",GN)110087 "RTN","C0CMIME",280,0)110088 S GGG=$NA(^GPL("MIME2"))110089 "RTN","C0CMIME",281,0)110090 ;D QUEUE^C0CXPATH("GBLD","GM",1,1)110091 "RTN","C0CMIME",282,0)110092 ;D QUEUE^C0CXPATH("GBLD",GGG,21,159)110093 "RTN","C0CMIME",283,0)110094 ;D BUILD^C0CXPATH("GBLD",GN)110095 "RTN","C0CMIME",284,0)110096 K @GN@(0) ; KILL THE LINE COUNT110097 "RTN","C0CMIME",285,0)110098 K LRINSTR,LRTASK,LRTO,XMERR,XMZ110099 "RTN","C0CMIME",286,0)110100 I $G(ADDR)'="" S XQSND=ADDR110101 "RTN","C0CMIME",287,0)110102 E S XQSND="glilly@glilly.net"110103 "RTN","C0CMIME",288,0)110104 ;S XQSND="nanthracite@earthlink.net"110105 "RTN","C0CMIME",289,0)110106 ;S XQSND="dlefevre@orohosp.com"110107 "RTN","C0CMIME",290,0)110108 ;S XQSND="gregwoodhouse@me.com"110109 "RTN","C0CMIME",291,0)110110 ;S XQSND="rick.marshall@vistaexpertise.net"110111 "RTN","C0CMIME",292,0)110112 S LRTO(XQSND)=""110113 "RTN","C0CMIME",293,0)110114 ;S LRTO("glilly@glilly.net")=""110115 "RTN","C0CMIME",294,0)110116 S LRINSTR("ADDR FLAGS")="R"110117 "RTN","C0CMIME",295,0)110118 S LRINSTR("FROM")="ANTHRACITE.NANCY"110119 "RTN","C0CMIME",296,0)110120 S LRMSUBJ="Sending a CCR with Mailman"110121 "RTN","C0CMIME",297,0)110122 S LRMSUBJ=$E(LRMSUBJ,1,65)110123 "RTN","C0CMIME",298,0)110124 D SENDMSG^XMXAPI(9,LRMSUBJ,GN,.LRTO,.LRINSTR,.LRTASK)110125 "RTN","C0CMIME",299,0)110126 I $G(XMERR)=1 W !,"ERROR SENDING MESSAGE" Q ;110127 "RTN","C0CMIME",300,0)110128 ;S ^XMB(3.9,LRTASK,1,.1130590,0)="MIME-Version: 1.0"110129 "RTN","C0CMIME",301,0)110130 ;S ^XMB(3.9,LRTASK,1,.1130591,0)="Content-type: multipart/mixed; boundary=000e0cd6ae026c3d4b049e7befe9"110131 "RTN","C0CMIME",302,0)110132 Q110133 "RTN","C0CMIME",303,0)110134 ;110135 "RTN","C0CMIME",304,0)110136 SIMPLE ;110137 "RTN","C0CMIME",305,0)110138 S GN(1)="SIMPLE TEST MESSAGE"110139 "RTN","C0CMIME",306,0)110140 K LRINSTR,LRTASK,LRTO,XMERR,XMZ110141 "RTN","C0CMIME",307,0)110142 S XQSND="glilly@glilly.net"110143 "RTN","C0CMIME",308,0)110144 S LRTO(XQSND)=""110145 "RTN","C0CMIME",309,0)110146 S LRINSTR("ADDR FLAGS")="R"110147 "RTN","C0CMIME",310,0)110148 S LRINSTR("FROM")="CCR_PACKAGE"110149 "RTN","C0CMIME",311,0)110150 S LRMSUBJ="A SAMPLE CCR"110151 "RTN","C0CMIME",312,0)110152 S LRMSUBJ=$E(LRMSUBJ,1,65)110153 "RTN","C0CMIME",313,0)110154 D SENDMSG^XMXAPI(9,LRMSUBJ,"GN",.LRTO,.LRINSTR,.LRTASK)110155 "RTN","C0CMIME",314,0)110156 Q110157 "RTN","C0CMIME",315,0)110158 CHUNK(OUTXML,INXML,ZSIZE) ; BREAKS INXML INTO ZSIZE BLOCKS110159 "RTN","C0CMIME",316,0)110160 ; INXML IS AN ARRAY PASSED BY NAME OF STRINGS110161 "RTN","C0CMIME",317,0)110162 ; OUTXML IS ALSO PASSED BY NAME110163 "RTN","C0CMIME",318,0)110164 ; IF ZSIZE IS NOT PASSED, 1000 IS USED110165 "RTN","C0CMIME",319,0)110166 I '$D(ZSIZE) S ZSIZE=1000 ; DEFAULT BLOCK SIZE110167 "RTN","C0CMIME",320,0)110168 N ZB,ZI,ZJ,ZK,ZL,ZN110169 "RTN","C0CMIME",321,0)110170 S ZB=ZSIZE-1110171 "RTN","C0CMIME",322,0)110172 S ZN=1110173 "RTN","C0CMIME",323,0)110174 S ZI=0 ; BEGINNING OF INDEX TO INXML110175 "RTN","C0CMIME",324,0)110176 F S ZI=$O(@INXML@(ZI)) Q:+ZI=0 D ; FOR EACH STRING IN INXML110177 "RTN","C0CMIME",325,0)110178 . S ZL=$L(@INXML@(ZI)) ; LENGTH OF THE STRING110179 "RTN","C0CMIME",326,0)110180 . F ZJ=1:ZSIZE:ZL D ;110181 "RTN","C0CMIME",327,0)110182 . . S ZK=$S(ZJ+ZB<ZL:ZJ+ZB,1:ZL) ; END FOR EXTRACT110183 "RTN","C0CMIME",328,0)110184 . . S @OUTXML@(ZN)=$E(@INXML@(ZI),ZJ,ZK) ; PULL OUT THE PIECE110185 "RTN","C0CMIME",329,0)110186 . . S ZN=ZN+1 ; INCREMENT OUT ARRAY INDEX110187 "RTN","C0CMIME",330,0)110188 Q110189 "RTN","C0CMIME",331,0)110190 ;110191 "RTN","C0CMIME",332,0)110192 CLEAN(IARY) ; RUNS THROUGH AN ARRAY PASSED BY NAME AND STRIPS OUT $C(13)110193 "RTN","C0CMIME",333,0)110194 ;110195 "RTN","C0CMIME",334,0)110196 N ZI S ZI=0110197 "RTN","C0CMIME",335,0)110198 F S ZI=$O(@IARY@(ZI)) Q:+ZI=0 D ;110199 "RTN","C0CMIME",336,0)110200 . S @IARY@(ZI)=$TR(@IARY@(ZI),$C(13)) ;110201 110181 "RTN","C0CMIME",337,0) 110202 . I $F(@IARY@(ZI)," <") S @IARY@(ZI)="<"_$P(@IARY@(ZI)," <",2) ; RM BLNKS110203 "RTN","C0CMIME",338,0)110204 Q110205 "RTN","C0CMIME",339,0)110206 110182 ; 110207 110183 "RTN","C0CMXML") 110208 0^65^B5 6456416110184 0^65^B55227178 110209 110185 "RTN","C0CMXML",1,0) 110210 110186 C0CMXML ; GPL - MXML based XPath utilities;10/13/09 17:05 110211 110187 "RTN","C0CMXML",2,0) 110212 ;;1.2;C 0C;;May 11, 2012;Build 50110188 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 110213 110189 "RTN","C0CMXML",3,0) 110214 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU110190 ;Copyright 2009 George Lilly. 110215 110191 "RTN","C0CMXML",4,0) 110216 ; General Public License See attached copy of the License.110192 ; 110217 110193 "RTN","C0CMXML",5,0) 110218 ; 110194 ; This program is free software: you can redistribute it and/or modify 110219 110195 "RTN","C0CMXML",6,0) 110220 ; This program is free software; you can redistribute it and/or modify110196 ; it under the terms of the GNU Affero General Public License as 110221 110197 "RTN","C0CMXML",7,0) 110222 ; it under the terms of the GNU General Public License as published by110198 ; published by the Free Software Foundation, either version 3 of the 110223 110199 "RTN","C0CMXML",8,0) 110224 ; the Free Software Foundation; either version 2 of the License, or110200 ; License, or (at your option) any later version. 110225 110201 "RTN","C0CMXML",9,0) 110226 ; (at your option) any later version.110202 ; 110227 110203 "RTN","C0CMXML",10,0) 110228 ; 110204 ; This program is distributed in the hope that it will be useful, 110229 110205 "RTN","C0CMXML",11,0) 110230 ; This program is distributed in the hope that it will be useful,110206 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 110231 110207 "RTN","C0CMXML",12,0) 110232 ; but WITHOUT ANY WARRANTY; without even the implied warranty of110208 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 110233 110209 "RTN","C0CMXML",13,0) 110234 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the110210 ; GNU Affero General Public License for more details. 110235 110211 "RTN","C0CMXML",14,0) 110236 ; GNU General Public License for more details.110212 ; 110237 110213 "RTN","C0CMXML",15,0) 110238 ; 110214 ; You should have received a copy of the GNU Affero General Public License 110239 110215 "RTN","C0CMXML",16,0) 110240 ; You should have received a copy of the GNU General Public License along110216 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 110241 110217 "RTN","C0CMXML",17,0) 110242 ; with this program; if not, write to the Free Software Foundation, Inc.,110218 ; 110243 110219 "RTN","C0CMXML",18,0) 110244 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.110220 Q 110245 110221 "RTN","C0CMXML",19,0) 110246 ; 110222 ; THIS FILE CONTAINS THE XPATH CREATOR, THE PARSE CALL TO THE MXML PARSER 110247 110223 "RTN","C0CMXML",20,0) 110224 ; AND THE OUTXML XML GENERATOR THAT OUTPUTS XML FROM AN MXML DOM 110225 "RTN","C0CMXML",21,0) 110226 ; FOR CCD SPECIFIC ROUTINES, SEE C0CMCCD 110227 "RTN","C0CMXML",22,0) 110228 ; FOR TEMPLATE FILE RELATED ROUTINES, SEE C0CMXP 110229 "RTN","C0CMXML",23,0) 110230 ; 110231 "RTN","C0CMXML",24,0) 110232 TEST ; 110233 "RTN","C0CMXML",25,0) 110234 S C0CXMLIN=$NA(^TMP("C0CMXML",$J)) 110235 "RTN","C0CMXML",26,0) 110236 K GARY 110237 "RTN","C0CMXML",27,0) 110238 W $$FTG^%ZISH("/home/vademo2/EHR/p/","mxml-test.xml",$NA(@C0CXMLIN@(1)),3) 110239 "RTN","C0CMXML",28,0) 110240 S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DocID: ",C0CDOCID 110241 "RTN","C0CMXML",29,0) 110242 S REDUX="//ContinuityOfCareRecord/Body" 110243 "RTN","C0CMXML",30,0) 110244 D XPATH(1,"/","GIDX","GARY",,REDUX) 110245 "RTN","C0CMXML",31,0) 110246 D SEPARATE^C0CMCCD("GARY2","GARY") 110247 "RTN","C0CMXML",32,0) 110248 S ZI="" 110249 "RTN","C0CMXML",33,0) 110250 F S ZI=$O(GARY2(ZI)) Q:ZI="" D ; 110251 "RTN","C0CMXML",34,0) 110252 . N GTMP,G2 110253 "RTN","C0CMXML",35,0) 110254 . M G2=GARY2(ZI) 110255 "RTN","C0CMXML",36,0) 110256 . D DEMUX2^C0CMXP("GTMP","G2",2) 110257 "RTN","C0CMXML",37,0) 110258 . M GARY3(ZI)=GTMP 110259 "RTN","C0CMXML",38,0) 110248 110260 Q 110249 "RTN","C0CMXML",21,0) 110250 ; THIS FILE CONTAINS THE XPATH CREATOR, THE PARSE CALL TO THE MXML PARSER 110251 "RTN","C0CMXML",22,0) 110252 ; AND THE OUTXML XML GENERATOR THAT OUTPUTS XML FROM AN MXML DOM 110253 "RTN","C0CMXML",23,0) 110254 ; FOR CCD SPECIFIC ROUTINES, SEE C0CMCCD 110255 "RTN","C0CMXML",24,0) 110256 ; FOR TEMPLATE FILE RELATED ROUTINES, SEE C0CMXP 110257 "RTN","C0CMXML",25,0) 110258 ; 110259 "RTN","C0CMXML",26,0) 110260 TEST ; 110261 "RTN","C0CMXML",27,0) 110261 "RTN","C0CMXML",39,0) 110262 ; 110263 "RTN","C0CMXML",40,0) 110264 TEST2 ; 110265 "RTN","C0CMXML",41,0) 110266 S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail" 110267 "RTN","C0CMXML",42,0) 110268 D XPATH(1,"/","GIDX","GARY","",REDUX) 110269 "RTN","C0CMXML",43,0) 110270 Q 110271 "RTN","C0CMXML",44,0) 110272 ; 110273 "RTN","C0CMXML",45,0) 110274 TEST3 ; 110275 "RTN","C0CMXML",46,0) 110262 110276 S C0CXMLIN=$NA(^TMP("C0CMXML",$J)) 110263 "RTN","C0CMXML",28,0) 110264 K GARY 110265 "RTN","C0CMXML",29,0) 110266 W $$FTG^%ZISH("/home/vademo2/EHR/p/","mxml-test.xml",$NA(@C0CXMLIN@(1)),3) 110267 "RTN","C0CMXML",30,0) 110268 S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DocID: ",C0CDOCID 110269 "RTN","C0CMXML",31,0) 110270 S REDUX="//ContinuityOfCareRecord/Body" 110271 "RTN","C0CMXML",32,0) 110277 "RTN","C0CMXML",47,0) 110278 K GARY,GTMP,GIDX 110279 "RTN","C0CMXML",48,0) 110280 K @C0CXMLIN 110281 "RTN","C0CMXML",49,0) 110282 W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3) 110283 "RTN","C0CMXML",50,0) 110284 D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS 110285 "RTN","C0CMXML",51,0) 110286 K @C0CXMLIN 110287 "RTN","C0CMXML",52,0) 110288 M @C0CXMLIN=GTMP 110289 "RTN","C0CMXML",53,0) 110290 K GTMP 110291 "RTN","C0CMXML",54,0) 110292 D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN) 110293 "RTN","C0CMXML",55,0) 110294 K @C0CXMLIN 110295 "RTN","C0CMXML",56,0) 110296 M @C0CXMLIN=GTMP 110297 "RTN","C0CMXML",57,0) 110298 K GTMP 110299 "RTN","C0CMXML",58,0) 110300 S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID 110301 "RTN","C0CMXML",59,0) 110302 S REDUX="//ClinicalDocument/component/structuredBody" 110303 "RTN","C0CMXML",60,0) 110304 D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS 110305 "RTN","C0CMXML",61,0) 110306 D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS 110307 "RTN","C0CMXML",62,0) 110308 D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS 110309 "RTN","C0CMXML",63,0) 110272 110310 D XPATH(1,"/","GIDX","GARY",,REDUX) 110273 "RTN","C0CMXML",33,0) 110274 D SEPARATE^C0CMCCD("GARY2","GARY") 110275 "RTN","C0CMXML",34,0) 110311 "RTN","C0CMXML",64,0) 110312 K C0CCBK("TAG") 110313 "RTN","C0CMXML",65,0) 110314 D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING 110315 "RTN","C0CMXML",66,0) 110316 D TEST3A 110317 "RTN","C0CMXML",67,0) 110318 Q 110319 "RTN","C0CMXML",68,0) 110320 ; 110321 "RTN","C0CMXML",69,0) 110322 TEST3A ; INTERNAL ROUTINE 110323 "RTN","C0CMXML",70,0) 110276 110324 S ZI="" 110277 "RTN","C0CMXML", 35,0)110325 "RTN","C0CMXML",71,0) 110278 110326 F S ZI=$O(GARY2(ZI)) Q:ZI="" D ; 110279 "RTN","C0CMXML", 36,0)110327 "RTN","C0CMXML",72,0) 110280 110328 . N GTMP,G2 110281 "RTN","C0CMXML", 37,0)110329 "RTN","C0CMXML",73,0) 110282 110330 . M G2=GARY2(ZI) 110283 "RTN","C0CMXML", 38,0)110331 "RTN","C0CMXML",74,0) 110284 110332 . D DEMUX2^C0CMXP("GTMP","G2",2) 110285 "RTN","C0CMXML", 39,0)110286 . M GARY 3(ZI)=GTMP110287 "RTN","C0CMXML", 40,0)110333 "RTN","C0CMXML",75,0) 110334 . M GARY4(ZI)=GTMP 110335 "RTN","C0CMXML",76,0) 110288 110336 Q 110289 "RTN","C0CMXML",41,0) 110290 ; 110291 "RTN","C0CMXML",42,0) 110292 TEST2 ; 110293 "RTN","C0CMXML",43,0) 110294 S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail" 110295 "RTN","C0CMXML",44,0) 110296 D XPATH(1,"/","GIDX","GARY","",REDUX) 110297 "RTN","C0CMXML",45,0) 110337 "RTN","C0CMXML",77,0) 110338 ; 110339 "RTN","C0CMXML",78,0) 110340 TESTQ ; TEST OF THE QRDA TEMPLATE GPL 7/8/2010 110341 "RTN","C0CMXML",79,0) 110342 S C0CXMLIN=$NA(^TMP("C0CMXML",$J)) 110343 "RTN","C0CMXML",80,0) 110344 K GARY,GTMP,GIDX 110345 "RTN","C0CMXML",81,0) 110346 K @C0CXMLIN 110347 "RTN","C0CMXML",82,0) 110348 W $$FTG^%ZISH("/home/vademo2/","QRDA_CategoryI_WorldVistA1.xml",$NA(@C0CXMLIN@(1)),3) 110349 "RTN","C0CMXML",83,0) 110350 D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS 110351 "RTN","C0CMXML",84,0) 110352 K @C0CXMLIN 110353 "RTN","C0CMXML",85,0) 110354 S GTMP(1)="<"_$P(GTMP(1),"<",2) 110355 "RTN","C0CMXML",86,0) 110356 M @C0CXMLIN=GTMP 110357 "RTN","C0CMXML",87,0) 110358 K GTMP 110359 "RTN","C0CMXML",88,0) 110360 D TESTQ2 110361 "RTN","C0CMXML",89,0) 110298 110362 Q 110299 "RTN","C0CMXML",46,0) 110300 ; 110301 "RTN","C0CMXML",47,0) 110302 TEST3 110303 "RTN","C0CMXML",48,0) 110363 "RTN","C0CMXML",90,0) 110364 ; 110365 "RTN","C0CMXML",91,0) 110366 TESTQ2 ; SECOND PART OF TESTQ 110367 "RTN","C0CMXML",92,0) 110368 D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN) 110369 "RTN","C0CMXML",93,0) 110370 K @C0CXMLIN 110371 "RTN","C0CMXML",94,0) 110372 M @C0CXMLIN=GTMP 110373 "RTN","C0CMXML",95,0) 110374 K GTMP 110375 "RTN","C0CMXML",96,0) 110376 S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID 110377 "RTN","C0CMXML",97,0) 110378 S REDUX="//ClinicalDocument/component/structuredBody" 110379 "RTN","C0CMXML",98,0) 110380 D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS 110381 "RTN","C0CMXML",99,0) 110382 D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS 110383 "RTN","C0CMXML",100,0) 110384 D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS 110385 "RTN","C0CMXML",101,0) 110386 D XPATH(1,"/","GIDX","GARY",,REDUX) 110387 "RTN","C0CMXML",102,0) 110388 K C0CCBK("TAG") 110389 "RTN","C0CMXML",103,0) 110390 D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING 110391 "RTN","C0CMXML",104,0) 110392 D TEST3A 110393 "RTN","C0CMXML",105,0) 110394 Q 110395 "RTN","C0CMXML",106,0) 110396 ; 110397 "RTN","C0CMXML",107,0) 110398 TEST4 ; TEST OF OUTPUTING AN XML FILE FROM THE DOM .. this one is the CCR 110399 "RTN","C0CMXML",108,0) 110400 ; 110401 "RTN","C0CMXML",109,0) 110402 D TEST ; SET UP THE DOM 110403 "RTN","C0CMXML",110,0) 110404 D START^C0CMXMLB($$TAG(1),,"G") 110405 "RTN","C0CMXML",111,0) 110406 D NDOUT($$FIRST(1)) 110407 "RTN","C0CMXML",112,0) 110408 D END^C0CMXMLB ;END THE DOCUMENT 110409 "RTN","C0CMXML",113,0) 110410 M ZCCR=^TMP("MXMLBLD",$J) 110411 "RTN","C0CMXML",114,0) 110412 ; ZWR ZCCR 110413 "RTN","C0CMXML",115,0) 110414 Q 110415 "RTN","C0CMXML",116,0) 110416 ; 110417 "RTN","C0CMXML",117,0) 110418 TEST5 ; SAME AS TEST4, BUT THIS TIME THE CCD 110419 "RTN","C0CMXML",118,0) 110304 110420 S C0CXMLIN=$NA(^TMP("C0CMXML",$J)) 110305 "RTN","C0CMXML", 49,0)110421 "RTN","C0CMXML",119,0) 110306 110422 K GARY,GTMP,GIDX 110307 "RTN","C0CMXML", 50,0)110423 "RTN","C0CMXML",120,0) 110308 110424 K @C0CXMLIN 110309 "RTN","C0CMXML", 51,0)110425 "RTN","C0CMXML",121,0) 110310 110426 W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3) 110311 "RTN","C0CMXML", 52,0)110427 "RTN","C0CMXML",122,0) 110312 110428 D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS 110313 "RTN","C0CMXML", 53,0)110429 "RTN","C0CMXML",123,0) 110314 110430 K @C0CXMLIN 110315 "RTN","C0CMXML", 54,0)110431 "RTN","C0CMXML",124,0) 110316 110432 M @C0CXMLIN=GTMP 110317 "RTN","C0CMXML", 55,0)110433 "RTN","C0CMXML",125,0) 110318 110434 K GTMP 110319 "RTN","C0CMXML", 56,0)110435 "RTN","C0CMXML",126,0) 110320 110436 D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN) 110321 "RTN","C0CMXML", 57,0)110437 "RTN","C0CMXML",127,0) 110322 110438 K @C0CXMLIN 110323 "RTN","C0CMXML", 58,0)110439 "RTN","C0CMXML",128,0) 110324 110440 M @C0CXMLIN=GTMP 110325 "RTN","C0CMXML", 59,0)110441 "RTN","C0CMXML",129,0) 110326 110442 K GTMP 110327 "RTN","C0CMXML",60,0) 110328 S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID 110329 "RTN","C0CMXML",61,0) 110330 S REDUX="//ClinicalDocument/component/structuredBody" 110331 "RTN","C0CMXML",62,0) 110332 D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS 110333 "RTN","C0CMXML",63,0) 110334 D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS 110335 "RTN","C0CMXML",64,0) 110336 D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS 110337 "RTN","C0CMXML",65,0) 110338 D XPATH(1,"/","GIDX","GARY",,REDUX) 110339 "RTN","C0CMXML",66,0) 110340 K C0CCBK("TAG") 110341 "RTN","C0CMXML",67,0) 110342 D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING 110343 "RTN","C0CMXML",68,0) 110344 D TEST3A 110345 "RTN","C0CMXML",69,0) 110443 "RTN","C0CMXML",130,0) 110444 S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DOCID: ",C0CDOCID ;CALL REGULAR PARSER 110445 "RTN","C0CMXML",131,0) 110446 ;D XPATH(1,"/","GIDX2","GARY2",,REDUX) 110447 "RTN","C0CMXML",132,0) 110448 D OUTXML("ZCCD",C0CDOCID) 110449 "RTN","C0CMXML",133,0) 110450 ;D START^C0CMXMLB($$TAG(1),,"G") 110451 "RTN","C0CMXML",134,0) 110452 ;D NDOUT($$FIRST(1)) 110453 "RTN","C0CMXML",135,0) 110454 ;D END^C0CMXMLB ;EOND THE DOCUMENT 110455 "RTN","C0CMXML",136,0) 110456 ;M ZCCD=^TMP("MXMLBLD",$J) 110457 "RTN","C0CMXML",137,0) 110458 ; ZWR ZCCD(1:30) 110459 "RTN","C0CMXML",138,0) 110346 110460 Q 110347 "RTN","C0CMXML",70,0) 110348 ; 110349 "RTN","C0CMXML",71,0) 110350 TEST3A ; INTERNAL ROUTINE 110351 "RTN","C0CMXML",72,0) 110352 S ZI="" 110353 "RTN","C0CMXML",73,0) 110354 F S ZI=$O(GARY2(ZI)) Q:ZI="" D ; 110355 "RTN","C0CMXML",74,0) 110356 . N GTMP,G2 110357 "RTN","C0CMXML",75,0) 110358 . M G2=GARY2(ZI) 110359 "RTN","C0CMXML",76,0) 110360 . D DEMUX2^C0CMXP("GTMP","G2",2) 110361 "RTN","C0CMXML",77,0) 110362 . M GARY4(ZI)=GTMP 110363 "RTN","C0CMXML",78,0) 110461 "RTN","C0CMXML",139,0) 110462 ; 110463 "RTN","C0CMXML",140,0) 110464 XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE 110465 "RTN","C0CMXML",141,0) 110466 ; THE XPATH INDEX ZXIDX, PASSED BY NAME 110467 "RTN","C0CMXML",142,0) 110468 ; THE XPATH ARRAY XPARY, PASSED BY NAME 110469 "RTN","C0CMXML",143,0) 110470 ; ZOID IS THE STARTING OID 110471 "RTN","C0CMXML",144,0) 110472 ; ZPATH IS THE STARTING XPATH, USUALLY "/" 110473 "RTN","C0CMXML",145,0) 110474 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE 110475 "RTN","C0CMXML",146,0) 110476 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT 110477 "RTN","C0CMXML",147,0) 110478 I $G(ZREDUX)="" S ZREDUX="" 110479 "RTN","C0CMXML",148,0) 110480 N NEWPATH 110481 "RTN","C0CMXML",149,0) 110482 N NEWNUM S NEWNUM="" 110483 "RTN","C0CMXML",150,0) 110484 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" 110485 "RTN","C0CMXML",151,0) 110486 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE 110487 "RTN","C0CMXML",152,0) 110488 I $G(ZREDUX)'="" D ; REDUX PROVIDED? 110489 "RTN","C0CMXML",153,0) 110490 . N GT S GT=$P(NEWPATH,ZREDUX,2) 110491 "RTN","C0CMXML",154,0) 110492 . I GT'="" S NEWPATH=GT 110493 "RTN","C0CMXML",155,0) 110494 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX 110495 "RTN","C0CMXML",156,0) 110496 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE 110497 "RTN","C0CMXML",157,0) 110498 I $D(GD(2)) M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY 110499 "RTN","C0CMXML",158,0) 110500 E I $D(GD(1)) S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY 110501 "RTN","C0CMXML",159,0) 110502 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD 110503 "RTN","C0CMXML",160,0) 110504 I ZFRST'=0 D ; THERE IS A CHILD 110505 "RTN","C0CMXML",161,0) 110506 . N ZNUM 110507 "RTN","C0CMXML",162,0) 110508 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE 110509 "RTN","C0CMXML",163,0) 110510 . D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD 110511 "RTN","C0CMXML",164,0) 110512 N GNXT S GNXT=$$NXTSIB(ZOID) 110513 "RTN","C0CMXML",165,0) 110514 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES 110515 "RTN","C0CMXML",166,0) 110516 I GNXT'=0 D ; 110517 "RTN","C0CMXML",167,0) 110518 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? 110519 "RTN","C0CMXML",168,0) 110520 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES 110521 "RTN","C0CMXML",169,0) 110522 . . N ZNUM S ZNUM=1 ; 110523 "RTN","C0CMXML",170,0) 110524 . . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB 110525 "RTN","C0CMXML",171,0) 110526 . E D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB 110527 "RTN","C0CMXML",172,0) 110364 110528 Q 110365 "RTN","C0CMXML",79,0) 110366 ; 110367 "RTN","C0CMXML",80,0) 110368 TESTQ ; TEST OF THE QRDA TEMPLATE GPL 7/8/2010 110369 "RTN","C0CMXML",81,0) 110370 S C0CXMLIN=$NA(^TMP("C0CMXML",$J)) 110371 "RTN","C0CMXML",82,0) 110372 K GARY,GTMP,GIDX 110373 "RTN","C0CMXML",83,0) 110374 K @C0CXMLIN 110375 "RTN","C0CMXML",84,0) 110376 W $$FTG^%ZISH("/home/vademo2/","QRDA_CategoryI_WorldVistA1.xml",$NA(@C0CXMLIN@(1)),3) 110377 "RTN","C0CMXML",85,0) 110378 D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS 110379 "RTN","C0CMXML",86,0) 110380 K @C0CXMLIN 110381 "RTN","C0CMXML",87,0) 110382 S GTMP(1)="<"_$P(GTMP(1),"<",2) 110383 "RTN","C0CMXML",88,0) 110384 M @C0CXMLIN=GTMP 110385 "RTN","C0CMXML",89,0) 110386 K GTMP 110387 "RTN","C0CMXML",90,0) 110388 D TESTQ2 110389 "RTN","C0CMXML",91,0) 110529 "RTN","C0CMXML",173,0) 110530 ; 110531 "RTN","C0CMXML",174,0) 110532 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME 110533 "RTN","C0CMXML",175,0) 110534 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW 110535 "RTN","C0CMXML",176,0) 110536 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML 110537 "RTN","C0CMXML",177,0) 110538 ;Q $$EN^MXMLDOM(INXML) 110539 "RTN","C0CMXML",178,0) 110540 Q $$EN^MXMLDOM(INXML,"W") 110541 "RTN","C0CMXML",179,0) 110542 ; 110543 "RTN","C0CMXML",180,0) 110544 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE 110545 "RTN","C0CMXML",181,0) 110546 N ZN 110547 "RTN","C0CMXML",182,0) 110548 ;I $$TAG(ZOID)["entry" B 110549 "RTN","C0CMXML",183,0) 110550 S ZN=$$NXTSIB(ZOID) 110551 "RTN","C0CMXML",184,0) 110552 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG 110553 "RTN","C0CMXML",185,0) 110554 Q 0 110555 "RTN","C0CMXML",186,0) 110556 ; 110557 "RTN","C0CMXML",187,0) 110558 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID 110559 "RTN","C0CMXML",188,0) 110560 Q $$CHILD^MXMLDOM(C0CDOCID,ZOID) 110561 "RTN","C0CMXML",189,0) 110562 ; 110563 "RTN","C0CMXML",190,0) 110564 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID 110565 "RTN","C0CMXML",191,0) 110566 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID) 110567 "RTN","C0CMXML",192,0) 110568 ; 110569 "RTN","C0CMXML",193,0) 110570 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID 110571 "RTN","C0CMXML",194,0) 110572 S HANDLE=C0CDOCID 110573 "RTN","C0CMXML",195,0) 110574 K @RTN 110575 "RTN","C0CMXML",196,0) 110576 D GETTXT^MXMLDOM("A") 110577 "RTN","C0CMXML",197,0) 110390 110578 Q 110391 "RTN","C0CMXML",92,0) 110392 ; 110393 "RTN","C0CMXML",93,0) 110394 TESTQ2 ; SECOND PART OF TESTQ 110395 "RTN","C0CMXML",94,0) 110396 D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN) 110397 "RTN","C0CMXML",95,0) 110398 K @C0CXMLIN 110399 "RTN","C0CMXML",96,0) 110400 M @C0CXMLIN=GTMP 110401 "RTN","C0CMXML",97,0) 110402 K GTMP 110403 "RTN","C0CMXML",98,0) 110404 S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID 110405 "RTN","C0CMXML",99,0) 110406 S REDUX="//ClinicalDocument/component/structuredBody" 110407 "RTN","C0CMXML",100,0) 110408 D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS 110409 "RTN","C0CMXML",101,0) 110410 D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS 110411 "RTN","C0CMXML",102,0) 110412 D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS 110413 "RTN","C0CMXML",103,0) 110414 D XPATH(1,"/","GIDX","GARY",,REDUX) 110415 "RTN","C0CMXML",104,0) 110416 K C0CCBK("TAG") 110417 "RTN","C0CMXML",105,0) 110418 D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING 110419 "RTN","C0CMXML",106,0) 110420 D TEST3A 110421 "RTN","C0CMXML",107,0) 110579 "RTN","C0CMXML",198,0) 110580 ; 110581 "RTN","C0CMXML",199,0) 110582 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE 110583 "RTN","C0CMXML",200,0) 110584 ;I ZOID=149 B ;GPLTEST 110585 "RTN","C0CMXML",201,0) 110586 N X,Y 110587 "RTN","C0CMXML",202,0) 110588 S Y="" 110589 "RTN","C0CMXML",203,0) 110590 S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE 110591 "RTN","C0CMXML",204,0) 110592 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y 110593 "RTN","C0CMXML",205,0) 110594 I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID) 110595 "RTN","C0CMXML",206,0) 110596 Q Y 110597 "RTN","C0CMXML",207,0) 110598 ; 110599 "RTN","C0CMXML",208,0) 110600 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING 110601 "RTN","C0CMXML",209,0) 110602 Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID) 110603 "RTN","C0CMXML",210,0) 110604 ; 110605 "RTN","C0CMXML",211,0) 110606 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE 110607 "RTN","C0CMXML",212,0) 110608 ;N ZT,ZN S ZT="" 110609 "RTN","C0CMXML",213,0) 110610 ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 110611 "RTN","C0CMXML",214,0) 110612 ;Q $G(@C0CDOM@(ZOID,"T",1)) 110613 "RTN","C0CMXML",215,0) 110614 S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT) 110615 "RTN","C0CMXML",216,0) 110422 110616 Q 110423 "RTN","C0CMXML", 108,0)110424 ; 110425 "RTN","C0CMXML", 109,0)110426 TEST4 ; TEST OF OUTPUTING AN XML FILE FROM THE DOM .. this one is the CCR 110427 "RTN","C0CMXML", 110,0)110428 ; 110429 "RTN","C0CMXML", 111,0)110430 D TEST ; SET UP THE DOM110431 "RTN","C0CMXML", 112,0)110617 "RTN","C0CMXML",217,0) 110618 ; 110619 "RTN","C0CMXML",218,0) 110620 OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM 110621 "RTN","C0CMXML",219,0) 110622 ; 110623 "RTN","C0CMXML",220,0) 110624 S C0CDOCID=INID 110625 "RTN","C0CMXML",221,0) 110432 110626 D START^C0CMXMLB($$TAG(1),,"G") 110433 "RTN","C0CMXML", 113,0)110627 "RTN","C0CMXML",222,0) 110434 110628 D NDOUT($$FIRST(1)) 110435 "RTN","C0CMXML", 114,0)110629 "RTN","C0CMXML",223,0) 110436 110630 D END^C0CMXMLB ;END THE DOCUMENT 110437 "RTN","C0CMXML", 115,0)110438 M ZCCR=^TMP("MXMLBLD",$J)110439 "RTN","C0CMXML", 116,0)110440 ZWR ZCCR110441 "RTN","C0CMXML", 117,0)110631 "RTN","C0CMXML",224,0) 110632 M @ZRTN=^TMP("MXMLBLD",$J) 110633 "RTN","C0CMXML",225,0) 110634 K ^TMP("MXMLBLD",$J) 110635 "RTN","C0CMXML",226,0) 110442 110636 Q 110443 "RTN","C0CMXML",118,0) 110444 ; 110445 "RTN","C0CMXML",119,0) 110446 TEST5 ; SAME AS TEST4, BUT THIS TIME THE CCD 110447 "RTN","C0CMXML",120,0) 110448 S C0CXMLIN=$NA(^TMP("C0CMXML",$J)) 110449 "RTN","C0CMXML",121,0) 110450 K GARY,GTMP,GIDX 110451 "RTN","C0CMXML",122,0) 110452 K @C0CXMLIN 110453 "RTN","C0CMXML",123,0) 110454 W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3) 110455 "RTN","C0CMXML",124,0) 110456 D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS 110457 "RTN","C0CMXML",125,0) 110458 K @C0CXMLIN 110459 "RTN","C0CMXML",126,0) 110460 M @C0CXMLIN=GTMP 110461 "RTN","C0CMXML",127,0) 110462 K GTMP 110463 "RTN","C0CMXML",128,0) 110464 D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN) 110465 "RTN","C0CMXML",129,0) 110466 K @C0CXMLIN 110467 "RTN","C0CMXML",130,0) 110468 M @C0CXMLIN=GTMP 110469 "RTN","C0CMXML",131,0) 110470 K GTMP 110471 "RTN","C0CMXML",132,0) 110472 S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DOCID: ",C0CDOCID ;CALL REGULAR PARSER 110473 "RTN","C0CMXML",133,0) 110474 ;D XPATH(1,"/","GIDX2","GARY2",,REDUX) 110475 "RTN","C0CMXML",134,0) 110476 D OUTXML("ZCCD",C0CDOCID) 110477 "RTN","C0CMXML",135,0) 110478 ;D START^C0CMXMLB($$TAG(1),,"G") 110479 "RTN","C0CMXML",136,0) 110480 ;D NDOUT($$FIRST(1)) 110481 "RTN","C0CMXML",137,0) 110482 ;D END^C0CMXMLB ;EOND THE DOCUMENT 110483 "RTN","C0CMXML",138,0) 110484 ;M ZCCD=^TMP("MXMLBLD",$J) 110485 "RTN","C0CMXML",139,0) 110486 ZWR ZCCD(1:30) 110487 "RTN","C0CMXML",140,0) 110637 "RTN","C0CMXML",227,0) 110638 ; 110639 "RTN","C0CMXML",228,0) 110640 NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE 110641 "RTN","C0CMXML",229,0) 110642 N ZI S ZI=$$FIRST(ZOID) 110643 "RTN","C0CMXML",230,0) 110644 I ZI'=0 D ; THERE IS A CHILD 110645 "RTN","C0CMXML",231,0) 110646 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT 110647 "RTN","C0CMXML",232,0) 110648 . D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN 110649 "RTN","C0CMXML",233,0) 110650 E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT 110651 "RTN","C0CMXML",234,0) 110652 . ;W "DOING",ZOID,! 110653 "RTN","C0CMXML",235,0) 110654 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA 110655 "RTN","C0CMXML",236,0) 110656 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES 110657 "RTN","C0CMXML",237,0) 110658 . D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN 110659 "RTN","C0CMXML",238,0) 110660 I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING 110661 "RTN","C0CMXML",239,0) 110662 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS 110663 "RTN","C0CMXML",240,0) 110488 110664 Q 110489 "RTN","C0CMXML",141,0) 110490 ; 110491 "RTN","C0CMXML",142,0) 110492 XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE 110493 "RTN","C0CMXML",143,0) 110494 ; THE XPATH INDEX ZXIDX, PASSED BY NAME 110495 "RTN","C0CMXML",144,0) 110496 ; THE XPATH ARRAY XPARY, PASSED BY NAME 110497 "RTN","C0CMXML",145,0) 110498 ; ZOID IS THE STARTING OID 110499 "RTN","C0CMXML",146,0) 110500 ; ZPATH IS THE STARTING XPATH, USUALLY "/" 110501 "RTN","C0CMXML",147,0) 110502 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE 110503 "RTN","C0CMXML",148,0) 110504 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT 110505 "RTN","C0CMXML",149,0) 110506 I $G(ZREDUX)="" S ZREDUX="" 110507 "RTN","C0CMXML",150,0) 110508 N NEWPATH 110509 "RTN","C0CMXML",151,0) 110510 N NEWNUM S NEWNUM="" 110511 "RTN","C0CMXML",152,0) 110512 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" 110513 "RTN","C0CMXML",153,0) 110514 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE 110515 "RTN","C0CMXML",154,0) 110516 I $G(ZREDUX)'="" D ; REDUX PROVIDED? 110517 "RTN","C0CMXML",155,0) 110518 . N GT S GT=$P(NEWPATH,ZREDUX,2) 110519 "RTN","C0CMXML",156,0) 110520 . I GT'="" S NEWPATH=GT 110521 "RTN","C0CMXML",157,0) 110522 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX 110523 "RTN","C0CMXML",158,0) 110524 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE 110525 "RTN","C0CMXML",159,0) 110526 I $D(GD(2)) M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY 110527 "RTN","C0CMXML",160,0) 110528 E I $D(GD(1)) S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY 110529 "RTN","C0CMXML",161,0) 110530 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD 110531 "RTN","C0CMXML",162,0) 110532 I ZFRST'=0 D ; THERE IS A CHILD 110533 "RTN","C0CMXML",163,0) 110534 . N ZNUM 110535 "RTN","C0CMXML",164,0) 110536 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE 110537 "RTN","C0CMXML",165,0) 110538 . D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD 110539 "RTN","C0CMXML",166,0) 110540 N GNXT S GNXT=$$NXTSIB(ZOID) 110541 "RTN","C0CMXML",167,0) 110542 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES 110543 "RTN","C0CMXML",168,0) 110544 I GNXT'=0 D ; 110545 "RTN","C0CMXML",169,0) 110546 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? 110547 "RTN","C0CMXML",170,0) 110548 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES 110549 "RTN","C0CMXML",171,0) 110550 . . N ZNUM S ZNUM=1 ; 110551 "RTN","C0CMXML",172,0) 110552 . . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB 110553 "RTN","C0CMXML",173,0) 110554 . E D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB 110555 "RTN","C0CMXML",174,0) 110665 "RTN","C0CMXML",241,0) 110666 ; 110667 "RTN","C0CMXML",242,0) 110668 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 110669 "RTN","C0CMXML",243,0) 110670 K ZERR 110671 "RTN","C0CMXML",244,0) 110672 D CLEAN^DILF 110673 "RTN","C0CMXML",245,0) 110674 D UPDATE^DIE("","C0CFDA","","ZERR") 110675 "RTN","C0CMXML",246,0) 110676 I $D(ZERR) S $EC=",U1," 110677 "RTN","C0CMXML",247,0) 110678 K C0CFDA 110679 "RTN","C0CMXML",248,0) 110556 110680 Q 110557 "RTN","C0CMXML",175,0)110558 ;110559 "RTN","C0CMXML",176,0)110560 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME110561 "RTN","C0CMXML",177,0)110562 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW110563 "RTN","C0CMXML",178,0)110564 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML110565 "RTN","C0CMXML",179,0)110566 ;Q $$EN^MXMLDOM(INXML)110567 "RTN","C0CMXML",180,0)110568 Q $$EN^MXMLDOM(INXML,"W")110569 "RTN","C0CMXML",181,0)110570 ;110571 "RTN","C0CMXML",182,0)110572 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE110573 "RTN","C0CMXML",183,0)110574 N ZN110575 "RTN","C0CMXML",184,0)110576 ;I $$TAG(ZOID)["entry" B110577 "RTN","C0CMXML",185,0)110578 S ZN=$$NXTSIB(ZOID)110579 "RTN","C0CMXML",186,0)110580 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG110581 "RTN","C0CMXML",187,0)110582 Q 0110583 "RTN","C0CMXML",188,0)110584 ;110585 "RTN","C0CMXML",189,0)110586 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID110587 "RTN","C0CMXML",190,0)110588 Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)110589 "RTN","C0CMXML",191,0)110590 ;110591 "RTN","C0CMXML",192,0)110592 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID110593 "RTN","C0CMXML",193,0)110594 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)110595 "RTN","C0CMXML",194,0)110596 ;110597 "RTN","C0CMXML",195,0)110598 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID110599 "RTN","C0CMXML",196,0)110600 S HANDLE=C0CDOCID110601 "RTN","C0CMXML",197,0)110602 K @RTN110603 "RTN","C0CMXML",198,0)110604 D GETTXT^MXMLDOM("A")110605 "RTN","C0CMXML",199,0)110606 Q110607 "RTN","C0CMXML",200,0)110608 ;110609 "RTN","C0CMXML",201,0)110610 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE110611 "RTN","C0CMXML",202,0)110612 ;I ZOID=149 B ;GPLTEST110613 "RTN","C0CMXML",203,0)110614 N X,Y110615 "RTN","C0CMXML",204,0)110616 S Y=""110617 "RTN","C0CMXML",205,0)110618 S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE110619 "RTN","C0CMXML",206,0)110620 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y110621 "RTN","C0CMXML",207,0)110622 I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)110623 "RTN","C0CMXML",208,0)110624 Q Y110625 "RTN","C0CMXML",209,0)110626 ;110627 "RTN","C0CMXML",210,0)110628 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING110629 "RTN","C0CMXML",211,0)110630 Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)110631 "RTN","C0CMXML",212,0)110632 ;110633 "RTN","C0CMXML",213,0)110634 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE110635 "RTN","C0CMXML",214,0)110636 ;N ZT,ZN S ZT=""110637 "RTN","C0CMXML",215,0)110638 ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))110639 "RTN","C0CMXML",216,0)110640 ;Q $G(@C0CDOM@(ZOID,"T",1))110641 "RTN","C0CMXML",217,0)110642 S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)110643 "RTN","C0CMXML",218,0)110644 Q110645 "RTN","C0CMXML",219,0)110646 ;110647 "RTN","C0CMXML",220,0)110648 OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM110649 "RTN","C0CMXML",221,0)110650 ;110651 "RTN","C0CMXML",222,0)110652 S C0CDOCID=INID110653 "RTN","C0CMXML",223,0)110654 D START^C0CMXMLB($$TAG(1),,"G")110655 "RTN","C0CMXML",224,0)110656 D NDOUT($$FIRST(1))110657 "RTN","C0CMXML",225,0)110658 D END^C0CMXMLB ;END THE DOCUMENT110659 "RTN","C0CMXML",226,0)110660 M @ZRTN=^TMP("MXMLBLD",$J)110661 "RTN","C0CMXML",227,0)110662 K ^TMP("MXMLBLD",$J)110663 "RTN","C0CMXML",228,0)110664 Q110665 "RTN","C0CMXML",229,0)110666 ;110667 "RTN","C0CMXML",230,0)110668 NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE110669 "RTN","C0CMXML",231,0)110670 N ZI S ZI=$$FIRST(ZOID)110671 "RTN","C0CMXML",232,0)110672 I ZI'=0 D ; THERE IS A CHILD110673 "RTN","C0CMXML",233,0)110674 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT110675 "RTN","C0CMXML",234,0)110676 . D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN110677 "RTN","C0CMXML",235,0)110678 E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT110679 "RTN","C0CMXML",236,0)110680 . ;W "DOING",ZOID,!110681 "RTN","C0CMXML",237,0)110682 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA110683 "RTN","C0CMXML",238,0)110684 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES110685 "RTN","C0CMXML",239,0)110686 . D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN110687 "RTN","C0CMXML",240,0)110688 I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING110689 "RTN","C0CMXML",241,0)110690 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS110691 "RTN","C0CMXML",242,0)110692 Q110693 "RTN","C0CMXML",243,0)110694 ;110695 "RTN","C0CMXML",244,0)110696 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS110697 "RTN","C0CMXML",245,0)110698 K ZERR110699 "RTN","C0CMXML",246,0)110700 D CLEAN^DILF110701 "RTN","C0CMXML",247,0)110702 D UPDATE^DIE("","C0CFDA","","ZERR")110703 "RTN","C0CMXML",248,0)110704 I $D(ZERR) D ;110705 110681 "RTN","C0CMXML",249,0) 110706 . W "ERROR",!110707 "RTN","C0CMXML",250,0)110708 . ZWR ZERR110709 "RTN","C0CMXML",251,0)110710 . B110711 "RTN","C0CMXML",252,0)110712 K C0CFDA110713 "RTN","C0CMXML",253,0)110714 Q110715 "RTN","C0CMXML",254,0)110716 110682 ; 110717 110683 "RTN","C0CMXMLB") 110718 0^87^B12 065941110684 0^87^B12346525 110719 110685 "RTN","C0CMXMLB",1,0) 110720 110686 C0CMXMLB ;;ISF/RWF - Tool to build XML ; 5/10/12 2:51pm 110721 110687 "RTN","C0CMXMLB",2,0) 110722 ;;1.2;C 0C;;May 11, 2012;Build 50110688 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 110723 110689 "RTN","C0CMXMLB",3,0) 110724 110690 QUIT … … 110726 110692 ; 110727 110693 "RTN","C0CMXMLB",5,0) 110694 ; FOIA Routine - Public Domain 110695 "RTN","C0CMXMLB",6,0) 110696 ; 110697 "RTN","C0CMXMLB",7,0) 110728 110698 ;DOC - The top level tag 110729 "RTN","C0CMXMLB", 6,0)110699 "RTN","C0CMXMLB",8,0) 110730 110700 ;DOCTYPE - Want to include a DOCTYPE node 110731 "RTN","C0CMXMLB", 7,0)110701 "RTN","C0CMXMLB",9,0) 110732 110702 ;FLAG - Set to 'G' to store the output in the global ^TMP("MXMLBLD",$J, 110733 "RTN","C0CMXMLB", 8,0)110703 "RTN","C0CMXMLB",10,0) 110734 110704 START(DOC,DOCTYPE,FLAG,NO1ST) ;Call this once at the begining. 110735 "RTN","C0CMXMLB", 9,0)110705 "RTN","C0CMXMLB",11,0) 110736 110706 K ^TMP("MXMLBLD",$J) 110737 "RTN","C0CMXMLB",1 0,0)110707 "RTN","C0CMXMLB",12,0) 110738 110708 S ^TMP("MXMLBLD",$J,"DOC")=DOC,^TMP("MXMLBLD",$J,"STK")=0 110739 "RTN","C0CMXMLB",1 1,0)110709 "RTN","C0CMXMLB",13,0) 110740 110710 I $G(FLAG)["G" S ^TMP("MXMLBLD",$J,"CNT")=1 110741 "RTN","C0CMXMLB",1 2,0)110742 I $G(NO1ST)'=1 D OUTPUT($$XMLHDR) 110743 "RTN","C0CMXMLB",1 3,0)110711 "RTN","C0CMXMLB",14,0) 110712 I $G(NO1ST)'=1 D OUTPUT($$XMLHDR) 110713 "RTN","C0CMXMLB",15,0) 110744 110714 D:$L($G(DOCTYPE)) OUTPUT("<!DOCTYPE "_DOCTYPE_">") D OUTPUT("<"_DOC_">") 110745 "RTN","C0CMXMLB",1 4,0)110715 "RTN","C0CMXMLB",16,0) 110746 110716 Q 110747 "RTN","C0CMXMLB",1 5,0)110748 ; 110749 "RTN","C0CMXMLB",1 6,0)110717 "RTN","C0CMXMLB",17,0) 110718 ; 110719 "RTN","C0CMXMLB",18,0) 110750 110720 END ;Call this once to close out the document 110751 "RTN","C0CMXMLB",1 7,0)110721 "RTN","C0CMXMLB",19,0) 110752 110722 D OUTPUT("</"_$G(^TMP("MXMLBLD",$J,"DOC"))_">") 110753 "RTN","C0CMXMLB", 18,0)110723 "RTN","C0CMXMLB",20,0) 110754 110724 I '$G(^TMP("MXMLBLD",$J,"CNT")) K ^TMP("MXMLBLD",$J) 110755 "RTN","C0CMXMLB", 19,0)110725 "RTN","C0CMXMLB",21,0) 110756 110726 K ^TMP("MXMLBLD",$J,"DOC"),^("CNT"),^("STK") 110757 "RTN","C0CMXMLB",2 0,0)110727 "RTN","C0CMXMLB",22,0) 110758 110728 Q 110759 "RTN","C0CMXMLB",2 1,0)110760 ; 110761 "RTN","C0CMXMLB",2 2,0)110729 "RTN","C0CMXMLB",23,0) 110730 ; 110731 "RTN","C0CMXMLB",24,0) 110762 110732 ITEM(INDENT,TAG,ATT,VALUE) ;Output a Item 110763 "RTN","C0CMXMLB",2 3,0)110733 "RTN","C0CMXMLB",25,0) 110764 110734 N I,X 110765 "RTN","C0CMXMLB",2 4,0)110735 "RTN","C0CMXMLB",26,0) 110766 110736 S ATT=$G(ATT) 110767 "RTN","C0CMXMLB",2 5,0)110737 "RTN","C0CMXMLB",27,0) 110768 110738 I '$D(VALUE) D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_" />") Q 110769 "RTN","C0CMXMLB",2 6,0)110739 "RTN","C0CMXMLB",28,0) 110770 110740 D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">"_$$CHARCHK(VALUE)_"</"_TAG_">") 110771 "RTN","C0CMXMLB",2 7,0)110741 "RTN","C0CMXMLB",29,0) 110772 110742 Q 110773 "RTN","C0CMXMLB", 28,0)110743 "RTN","C0CMXMLB",30,0) 110774 110744 ;DOITEM is a callback to output the lower level. 110775 "RTN","C0CMXMLB", 29,0)110745 "RTN","C0CMXMLB",31,0) 110776 110746 MULTI(INDENT,TAG,ATT,DOITEM) ;Output a Multipule 110777 "RTN","C0CMXMLB",3 0,0)110747 "RTN","C0CMXMLB",32,0) 110778 110748 N I,X,S 110779 "RTN","C0CMXMLB",3 1,0)110749 "RTN","C0CMXMLB",33,0) 110780 110750 S ATT=$G(ATT) 110781 "RTN","C0CMXMLB",3 2,0)110751 "RTN","C0CMXMLB",34,0) 110782 110752 D PUSH($G(INDENT),TAG,.ATT) 110783 "RTN","C0CMXMLB",3 3,0)110753 "RTN","C0CMXMLB",35,0) 110784 110754 D @DOITEM 110785 "RTN","C0CMXMLB",3 4,0)110755 "RTN","C0CMXMLB",36,0) 110786 110756 D POP 110787 "RTN","C0CMXMLB",3 5,0)110757 "RTN","C0CMXMLB",37,0) 110788 110758 Q 110789 "RTN","C0CMXMLB",3 6,0)110790 ; 110791 "RTN","C0CMXMLB",3 7,0)110759 "RTN","C0CMXMLB",38,0) 110760 ; 110761 "RTN","C0CMXMLB",39,0) 110792 110762 ATT(ATT) ;Output a string of attributes 110793 "RTN","C0CMXMLB", 38,0)110763 "RTN","C0CMXMLB",40,0) 110794 110764 I $D(ATT)<9 Q "" 110795 "RTN","C0CMXMLB", 39,0)110765 "RTN","C0CMXMLB",41,0) 110796 110766 N I,S,V 110797 "RTN","C0CMXMLB",4 0,0)110767 "RTN","C0CMXMLB",42,0) 110798 110768 S S="",I="" 110799 "RTN","C0CMXMLB",4 1,0)110769 "RTN","C0CMXMLB",43,0) 110800 110770 F S I=$O(ATT(I)) Q:I="" S S=S_" "_I_"="_$$Q(ATT(I)) 110801 "RTN","C0CMXMLB",4 2,0)110771 "RTN","C0CMXMLB",44,0) 110802 110772 Q S 110803 "RTN","C0CMXMLB",4 3,0)110804 ; 110805 "RTN","C0CMXMLB",4 4,0)110773 "RTN","C0CMXMLB",45,0) 110774 ; 110775 "RTN","C0CMXMLB",46,0) 110806 110776 Q(X) ;Add Quotes - Changed by gpl to use single instead of double quotes 6/11 110807 "RTN","C0CMXMLB",4 5,0)110777 "RTN","C0CMXMLB",47,0) 110808 110778 ;I X'[$C(34) Q $C(34)_X_$C(34) 110809 "RTN","C0CMXMLB",4 6,0)110779 "RTN","C0CMXMLB",48,0) 110810 110780 I X'[$C(39) Q $C(39)_X_$C(39) 110811 "RTN","C0CMXMLB",4 7,0)110781 "RTN","C0CMXMLB",49,0) 110812 110782 ;N Q,Y,I,Z S Q=$C(34),(Y,Z)="" 110813 "RTN","C0CMXMLB", 48,0)110783 "RTN","C0CMXMLB",50,0) 110814 110784 N Q,Y,I,Z S Q=$C(39),(Y,Z)="" 110815 "RTN","C0CMXMLB", 49,0)110785 "RTN","C0CMXMLB",51,0) 110816 110786 F I=1:1:$L(X,Q)-1 S Y=Y_$P(X,Q,I)_Q_Q 110817 "RTN","C0CMXMLB",5 0,0)110787 "RTN","C0CMXMLB",52,0) 110818 110788 S Y=Y_$P(X,Q,$L(X,Q)) 110819 "RTN","C0CMXMLB",5 1,0)110789 "RTN","C0CMXMLB",53,0) 110820 110790 ;Q $C(34)_Y_$C(34) 110821 "RTN","C0CMXMLB",5 2,0)110791 "RTN","C0CMXMLB",54,0) 110822 110792 Q $C(39)_Y_$C(39) 110823 "RTN","C0CMXMLB",5 3,0)110824 ; 110825 "RTN","C0CMXMLB",5 4,0)110793 "RTN","C0CMXMLB",55,0) 110794 ; 110795 "RTN","C0CMXMLB",56,0) 110826 110796 XMLHDR() ; -- provides current XML standard header 110827 "RTN","C0CMXMLB",5 5,0)110797 "RTN","C0CMXMLB",57,0) 110828 110798 Q "<?xml version=""1.0"" encoding=""utf-8"" ?>" 110829 "RTN","C0CMXMLB",5 6,0)110830 ; 110831 "RTN","C0CMXMLB",5 7,0)110799 "RTN","C0CMXMLB",58,0) 110800 ; 110801 "RTN","C0CMXMLB",59,0) 110832 110802 OUTPUT(S) ;Output 110833 "RTN","C0CMXMLB", 58,0)110803 "RTN","C0CMXMLB",60,0) 110834 110804 N C S C=$G(^TMP("MXMLBLD",$J,"CNT")) 110835 "RTN","C0CMXMLB", 59,0)110805 "RTN","C0CMXMLB",61,0) 110836 110806 I C S ^TMP("MXMLBLD",$J,C)=S,^TMP("MXMLBLD",$J,"CNT")=C+1 Q 110837 "RTN","C0CMXMLB",6 0,0)110807 "RTN","C0CMXMLB",62,0) 110838 110808 W S,! 110839 "RTN","C0CMXMLB",6 1,0)110809 "RTN","C0CMXMLB",63,0) 110840 110810 Q 110841 "RTN","C0CMXMLB",6 2,0)110842 ; 110843 "RTN","C0CMXMLB",6 3,0)110811 "RTN","C0CMXMLB",64,0) 110812 ; 110813 "RTN","C0CMXMLB",65,0) 110844 110814 CHARCHK(STR) ; -- replace xml character limits with entities 110845 "RTN","C0CMXMLB",6 4,0)110815 "RTN","C0CMXMLB",66,0) 110846 110816 N A,I,X,Y,Z,NEWSTR 110847 "RTN","C0CMXMLB",6 5,0)110817 "RTN","C0CMXMLB",67,0) 110848 110818 S (Y,Z)="" 110849 "RTN","C0CMXMLB",6 6,0)110819 "RTN","C0CMXMLB",68,0) 110850 110820 ;IF STR["&" SET NEWSTR=STR DO SET STR=Y_Z 110851 "RTN","C0CMXMLB",6 7,0)110821 "RTN","C0CMXMLB",69,0) 110852 110822 ;. FOR X=1:1 SET Y=Y_$PIECE(NEWSTR,"&",X)_"&",Z=$PIECE(STR,"&",X+1,999) QUIT:Z'["&" 110853 "RTN","C0CMXMLB", 68,0)110823 "RTN","C0CMXMLB",70,0) 110854 110824 I STR["&" F I=1:1:$L(STR,"&")-1 S STR=$P(STR,"&",1,I)_"&"_$P(STR,"&",I+1,999) 110855 "RTN","C0CMXMLB", 69,0)110825 "RTN","C0CMXMLB",71,0) 110856 110826 I STR["<" F S STR=$PIECE(STR,"<",1)_"<"_$PIECE(STR,"<",2,99) Q:STR'["<" 110857 "RTN","C0CMXMLB",7 0,0)110827 "RTN","C0CMXMLB",72,0) 110858 110828 I STR[">" F S STR=$PIECE(STR,">",1)_">"_$PIECE(STR,">",2,99) Q:STR'[">" 110859 "RTN","C0CMXMLB",7 1,0)110829 "RTN","C0CMXMLB",73,0) 110860 110830 I STR["'" F S STR=$PIECE(STR,"'",1)_"'"_$PIECE(STR,"'",2,99) Q:STR'["'" 110861 "RTN","C0CMXMLB",7 2,0)110831 "RTN","C0CMXMLB",74,0) 110862 110832 I STR["""" F S STR=$PIECE(STR,"""",1)_"""_$PIECE(STR,"""",2,99) Q:STR'["""" 110863 "RTN","C0CMXMLB",7 3,0)110864 ; 110865 "RTN","C0CMXMLB",7 4,0)110833 "RTN","C0CMXMLB",75,0) 110834 ; 110835 "RTN","C0CMXMLB",76,0) 110866 110836 S STR=$TR(STR,$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31)) 110867 "RTN","C0CMXMLB",7 5,0)110837 "RTN","C0CMXMLB",77,0) 110868 110838 QUIT STR 110869 "RTN","C0CMXMLB",7 6,0)110870 ; 110871 "RTN","C0CMXMLB",7 7,0)110839 "RTN","C0CMXMLB",78,0) 110840 ; 110841 "RTN","C0CMXMLB",79,0) 110872 110842 COMMENT(VAL) ;Add Comments 110873 "RTN","C0CMXMLB", 78,0)110843 "RTN","C0CMXMLB",80,0) 110874 110844 N I,L 110875 "RTN","C0CMXMLB", 79,0)110845 "RTN","C0CMXMLB",81,0) 110876 110846 ;I $D($G(VAL))=1 D OUTPUT("<!-- "_ATT_" -->") Q 110877 "RTN","C0CMXMLB",8 0,0)110847 "RTN","C0CMXMLB",82,0) 110878 110848 I $D(VAL) D OUTPUT("<!-- "_ATT_" -->") Q ;CHANGED BY GPL FOR GTM 110879 "RTN","C0CMXMLB",8 1,0)110849 "RTN","C0CMXMLB",83,0) 110880 110850 S I="",L="<!--" 110881 "RTN","C0CMXMLB",8 2,0)110851 "RTN","C0CMXMLB",84,0) 110882 110852 F S I=$O(ATT(I)) Q:I="" D OUTPUT(L_ATT(I)) S L="" 110883 "RTN","C0CMXMLB",8 3,0)110853 "RTN","C0CMXMLB",85,0) 110884 110854 D OUTPUT("-->") 110885 "RTN","C0CMXMLB",8 4,0)110855 "RTN","C0CMXMLB",86,0) 110886 110856 Q 110887 "RTN","C0CMXMLB",8 5,0)110888 ; 110889 "RTN","C0CMXMLB",8 6,0)110857 "RTN","C0CMXMLB",87,0) 110858 ; 110859 "RTN","C0CMXMLB",88,0) 110890 110860 PUSH(INDENT,TAG,ATT) ;Write a TAG and save. 110891 "RTN","C0CMXMLB",8 7,0)110861 "RTN","C0CMXMLB",89,0) 110892 110862 N CNT 110893 "RTN","C0CMXMLB", 88,0)110863 "RTN","C0CMXMLB",90,0) 110894 110864 S ATT=$G(ATT) 110895 "RTN","C0CMXMLB", 89,0)110865 "RTN","C0CMXMLB",91,0) 110896 110866 D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">") 110897 "RTN","C0CMXMLB",9 0,0)110867 "RTN","C0CMXMLB",92,0) 110898 110868 S CNT=$G(^TMP("MXMLBLD",$J,"STK"))+1,^TMP("MXMLBLD",$J,"STK")=CNT,^TMP("MXMLBLD",$J,"STK",CNT)=INDENT_"^"_TAG 110899 "RTN","C0CMXMLB",9 1,0)110869 "RTN","C0CMXMLB",93,0) 110900 110870 Q 110901 "RTN","C0CMXMLB",9 2,0)110902 ; 110903 "RTN","C0CMXMLB",9 3,0)110871 "RTN","C0CMXMLB",94,0) 110872 ; 110873 "RTN","C0CMXMLB",95,0) 110904 110874 POP ;Write last pushed tag and pop 110905 "RTN","C0CMXMLB",9 4,0)110875 "RTN","C0CMXMLB",96,0) 110906 110876 N CNT,TAG,INDENT,X 110907 "RTN","C0CMXMLB",9 5,0)110877 "RTN","C0CMXMLB",97,0) 110908 110878 S CNT=$G(^TMP("MXMLBLD",$J,"STK")),X=^TMP("MXMLBLD",$J,"STK",CNT),^TMP("MXMLBLD",$J,"STK")=CNT-1 110909 "RTN","C0CMXMLB",9 6,0)110879 "RTN","C0CMXMLB",98,0) 110910 110880 S INDENT=+X,TAG=$P(X,"^",2) 110911 "RTN","C0CMXMLB",9 7,0)110881 "RTN","C0CMXMLB",99,0) 110912 110882 D OUTPUT($$BLS(INDENT)_"</"_TAG_">") 110913 "RTN","C0CMXMLB", 98,0)110883 "RTN","C0CMXMLB",100,0) 110914 110884 Q 110915 "RTN","C0CMXMLB", 99,0)110916 ; 110917 "RTN","C0CMXMLB",10 0,0)110885 "RTN","C0CMXMLB",101,0) 110886 ; 110887 "RTN","C0CMXMLB",102,0) 110918 110888 BLS(I) ;Return INDENT string 110919 "RTN","C0CMXMLB",10 1,0)110889 "RTN","C0CMXMLB",103,0) 110920 110890 N S 110921 "RTN","C0CMXMLB",10 2,0)110891 "RTN","C0CMXMLB",104,0) 110922 110892 S S="",I=$G(I) S:I>0 $P(S," ",I)=" " 110923 "RTN","C0CMXMLB",10 3,0)110893 "RTN","C0CMXMLB",105,0) 110924 110894 Q S 110925 "RTN","C0CMXMLB",10 4,0)110926 ; 110927 "RTN","C0CMXMLB",10 5,0)110895 "RTN","C0CMXMLB",106,0) 110896 ; 110897 "RTN","C0CMXMLB",107,0) 110928 110898 INDENT() ;Renturn indent level 110929 "RTN","C0CMXMLB",10 6,0)110899 "RTN","C0CMXMLB",108,0) 110930 110900 Q +$G(^TMP("MXMLBLD",$J,"STK")) 110931 110901 "RTN","C0CMXP") 110932 0^64^B7 7680190110902 0^64^B76428333 110933 110903 "RTN","C0CMXP",1,0) 110934 110904 C0CMXP ; GPL - MXML based XPath utilities;12/04/09 17:05 110935 110905 "RTN","C0CMXP",2,0) 110936 ;;1.2;C 0C;;May 11, 2012;Build 50110906 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 110937 110907 "RTN","C0CMXP",3,0) 110938 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU110908 ;Copyright 2009 George Lilly. 110939 110909 "RTN","C0CMXP",4,0) 110940 ; General Public License See attached copy of the License.110910 ; 110941 110911 "RTN","C0CMXP",5,0) 110942 ; 110912 ; This program is free software: you can redistribute it and/or modify 110943 110913 "RTN","C0CMXP",6,0) 110944 ; This program is free software; you can redistribute it and/or modify110914 ; it under the terms of the GNU Affero General Public License as 110945 110915 "RTN","C0CMXP",7,0) 110946 ; it under the terms of the GNU General Public License as published by110916 ; published by the Free Software Foundation, either version 3 of the 110947 110917 "RTN","C0CMXP",8,0) 110948 ; the Free Software Foundation; either version 2 of the License, or110918 ; License, or (at your option) any later version. 110949 110919 "RTN","C0CMXP",9,0) 110950 ; (at your option) any later version.110920 ; 110951 110921 "RTN","C0CMXP",10,0) 110952 ; 110922 ; This program is distributed in the hope that it will be useful, 110953 110923 "RTN","C0CMXP",11,0) 110954 ; This program is distributed in the hope that it will be useful,110924 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 110955 110925 "RTN","C0CMXP",12,0) 110956 ; but WITHOUT ANY WARRANTY; without even the implied warranty of110926 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 110957 110927 "RTN","C0CMXP",13,0) 110958 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the110928 ; GNU Affero General Public License for more details. 110959 110929 "RTN","C0CMXP",14,0) 110960 ; GNU General Public License for more details.110930 ; 110961 110931 "RTN","C0CMXP",15,0) 110962 ; 110932 ; You should have received a copy of the GNU Affero General Public License 110963 110933 "RTN","C0CMXP",16,0) 110964 ; You should have received a copy of the GNU General Public License along110934 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 110965 110935 "RTN","C0CMXP",17,0) 110966 ; with this program; if not, write to the Free Software Foundation, Inc.,110936 ; 110967 110937 "RTN","C0CMXP",18,0) 110968 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.110938 Q 110969 110939 "RTN","C0CMXP",19,0) 110970 110940 ; 110971 110941 "RTN","C0CMXP",20,0) 110942 INITXPF(ARY) ;INITIAL XML/XPATH FILE ARRAY 110943 "RTN","C0CMXP",21,0) 110944 ; DON'T USE THIS ONE ... USE INITFARY^C0CSOAP("FARY") INSTEAD 110945 "RTN","C0CMXP",22,0) 110946 D INITFARY^C0CSOAP(ARY) ; 110947 "RTN","C0CMXP",23,0) 110972 110948 Q 110973 "RTN","C0CMXP",21,0)110974 ;110975 "RTN","C0CMXP",22,0)110976 INITXPF(ARY) ;INITIAL XML/XPATH FILE ARRAY110977 "RTN","C0CMXP",23,0)110978 ; DON'T USE THIS ONE ... USE INITFARY^C0CSOAP("FARY") INSTEAD110979 110949 "RTN","C0CMXP",24,0) 110980 D INITFARY^C0CSOAP(ARY) ;110950 S @ARY@("XML FILE NUMBER")=178.101 110981 110951 "RTN","C0CMXP",25,0) 110952 S @ARY@("XML SOURCE FIELD")=2.1 110953 "RTN","C0CMXP",26,0) 110954 S @ARY@("XML TEMPLATE FIELD")=3 110955 "RTN","C0CMXP",27,0) 110956 S @ARY@("XPATH BINDING SUBFILE")=178.1014 110957 "RTN","C0CMXP",28,0) 110958 S @ARY@("REDUX FIELD")=2.5 110959 "RTN","C0CMXP",29,0) 110982 110960 Q 110983 "RTN","C0CMXP",26,0)110984 S @ARY@("XML FILE NUMBER")=178.101110985 "RTN","C0CMXP",27,0)110986 S @ARY@("XML SOURCE FIELD")=2.1110987 "RTN","C0CMXP",28,0)110988 S @ARY@("XML TEMPLATE FIELD")=3110989 "RTN","C0CMXP",29,0)110990 S @ARY@("XPATH BINDING SUBFILE")=178.1014110991 110961 "RTN","C0CMXP",30,0) 110992 S @ARY@("REDUX FIELD")=2.5110962 ; 110993 110963 "RTN","C0CMXP",31,0) 110964 SETXPF(ARY) ; SET FILE AND FIELD VARIABLES FROM XPF ARRAY 110965 "RTN","C0CMXP",32,0) 110966 ; 110967 "RTN","C0CMXP",33,0) 110968 S C0CXPF=@ARY@("XML FILE NUMBER") 110969 "RTN","C0CMXP",34,0) 110970 S C0CXFLD=@ARY@("XML") 110971 "RTN","C0CMXP",35,0) 110972 S C0CXTFLD=@ARY@("TEMPLATE XML") 110973 "RTN","C0CMXP",36,0) 110974 S C0CXPBF=@ARY@("BINDING SUBFILE NUMBER") 110975 "RTN","C0CMXP",37,0) 110976 S C0CRDUXF=@ARY@("XPATH REDUCTION STRING") 110977 "RTN","C0CMXP",38,0) 110994 110978 Q 110995 "RTN","C0CMXP",32,0)110996 ;110997 "RTN","C0CMXP",33,0)110998 SETXPF(ARY) ; SET FILE AND FIELD VARIABLES FROM XPF ARRAY110999 "RTN","C0CMXP",34,0)111000 ;111001 "RTN","C0CMXP",35,0)111002 S C0CXPF=@ARY@("XML FILE NUMBER")111003 "RTN","C0CMXP",36,0)111004 S C0CXFLD=@ARY@("XML")111005 "RTN","C0CMXP",37,0)111006 S C0CXTFLD=@ARY@("TEMPLATE XML")111007 "RTN","C0CMXP",38,0)111008 S C0CXPBF=@ARY@("BINDING SUBFILE NUMBER")111009 110979 "RTN","C0CMXP",39,0) 111010 S C0CRDUXF=@ARY@("XPATH REDUCTION STRING")110980 ; 111011 110981 "RTN","C0CMXP",40,0) 110982 ADDXP(INARY,TID,FARY) ;ADD XPATH .01 FIELD TO BINDING SUBFILE OF TEMPLATE TID 110983 "RTN","C0CMXP",41,0) 110984 I '$D(FARY) D ; 110985 "RTN","C0CMXP",42,0) 110986 . S FARY="FARY" ; FILE ARRAY 110987 "RTN","C0CMXP",43,0) 110988 . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE 110989 "RTN","C0CMXP",44,0) 110990 D SETXPF(FARY) ;SET FILE VARIABLES 110991 "RTN","C0CMXP",45,0) 110992 N C0CA,C0CB 110993 "RTN","C0CMXP",46,0) 110994 S C0CA="" S C0CB=0 110995 "RTN","C0CMXP",47,0) 110996 F S C0CA=$O(@INARY@(C0CA)) Q:C0CA="" D ; FOR EACH XPATH 110997 "RTN","C0CMXP",48,0) 110998 . S C0CB=C0CB+1 ; COUNT OF XPATHS 110999 "RTN","C0CMXP",49,0) 111000 . S C0CFDA(C0CXPBF,"?+"_C0CB_","_TID_",",.01)=C0CA 111001 "RTN","C0CMXP",50,0) 111002 . D UPDIE ; CREATE THE BINDING SUBFILE FOR THIS XPATH 111003 "RTN","C0CMXP",51,0) 111012 111004 Q 111013 "RTN","C0CMXP",41,0) 111014 ; 111015 "RTN","C0CMXP",42,0) 111016 ADDXP(INARY,TID,FARY) ;ADD XPATH .01 FIELD TO BINDING SUBFILE OF TEMPLATE TID 111017 "RTN","C0CMXP",43,0) 111005 "RTN","C0CMXP",52,0) 111006 ; 111007 "RTN","C0CMXP",53,0) 111008 FIXICD9 ; FIX THE ICD9RESULT XML 111009 "RTN","C0CMXP",54,0) 111010 D GETXML("GPL","ICD9RESULT") ; GET SOME BAD XML OUT OF THE FILE 111011 "RTN","C0CMXP",55,0) 111012 S ZI="" 111013 "RTN","C0CMXP",56,0) 111014 S G="" 111015 "RTN","C0CMXP",57,0) 111016 F S ZI=$O(GPL(ZI)) Q:ZI="" D ; FOR EACH LINE 111017 "RTN","C0CMXP",58,0) 111018 . S G=G_GPL(ZI) ; MAKE ONE BIG STRING OF XML 111019 "RTN","C0CMXP",59,0) 111020 D NORMAL^C0CSOAP("G2","G") ;NO NORMALIZE IT BACK INTO AN ARRAY 111021 "RTN","C0CMXP",60,0) 111022 D ADDXML("G2","ICD9RESULT") ; AND PUT IT BACK 111023 "RTN","C0CMXP",61,0) 111024 Q 111025 "RTN","C0CMXP",62,0) 111026 ADDXML(INXML,TEMPID,INFARY) ;ADD XML TO A TEMPLATE ID TEMPID 111027 "RTN","C0CMXP",63,0) 111028 ; INXML IS PASSED BY NAME 111029 "RTN","C0CMXP",64,0) 111030 I '$D(INFARY) D ; 111031 "RTN","C0CMXP",65,0) 111032 . S INFARY="FARY" ; FILE ARRAY 111033 "RTN","C0CMXP",66,0) 111034 . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE 111035 "RTN","C0CMXP",67,0) 111036 I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME 111037 "RTN","C0CMXP",68,0) 111038 D SETXPF(INFARY) ;SET FILE VARIABLES 111039 "RTN","C0CMXP",69,0) 111040 D WP^DIE(C0CXPF,TEMPID_",",C0CXFLD,,INXML) 111041 "RTN","C0CMXP",70,0) 111042 Q 111043 "RTN","C0CMXP",71,0) 111044 ; 111045 "RTN","C0CMXP",72,0) 111046 ADDTEMP(INXML,TEMPID,INFARY) ;ADD XML TEMPLATE TO TEMPLATE RECORD TEMPID 111047 "RTN","C0CMXP",73,0) 111048 ; 111049 "RTN","C0CMXP",74,0) 111050 I '$D(INFARY) D ; 111051 "RTN","C0CMXP",75,0) 111052 . S INFARY="FARY" ; FILE ARRAY 111053 "RTN","C0CMXP",76,0) 111054 . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE 111055 "RTN","C0CMXP",77,0) 111056 I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME 111057 "RTN","C0CMXP",78,0) 111058 D SETXPF(INFARY) ;SET FILE VARIABLES 111059 "RTN","C0CMXP",79,0) 111060 D WP^DIE(C0CXPF,TEMPID_",",C0CXTFLD,,INXML) 111061 "RTN","C0CMXP",80,0) 111062 Q 111063 "RTN","C0CMXP",81,0) 111064 ; 111065 "RTN","C0CMXP",82,0) 111066 GETXML(OUTXML,TEMPID,INFARY) ;GET THE XML FROM TEMPLATE TEMPID 111067 "RTN","C0CMXP",83,0) 111068 ; 111069 "RTN","C0CMXP",84,0) 111070 I '$D(INFARY) D ; 111071 "RTN","C0CMXP",85,0) 111072 . S INFARY="FARY" ; FILE ARRAY 111073 "RTN","C0CMXP",86,0) 111074 . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE 111075 "RTN","C0CMXP",87,0) 111076 D SETXPF(INFARY) ;SET FILE VARIABLES 111077 "RTN","C0CMXP",88,0) 111078 I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME 111079 "RTN","C0CMXP",89,0) 111080 I $$GET1^DIQ(C0CXPF,TEMPID_",",C0CXFLD,,OUTXML)'=OUTXML D Q ; 111081 "RTN","C0CMXP",90,0) 111082 . W "ERROR RETRIEVING TEMPLATE",! 111083 "RTN","C0CMXP",91,0) 111084 Q 111085 "RTN","C0CMXP",92,0) 111086 ; 111087 "RTN","C0CMXP",93,0) 111088 GETTEMP(OUTXML,TEMPID,FARY) ;GET THE TEMPLATE XML FROM TEMPLATE TEMPID 111089 "RTN","C0CMXP",94,0) 111090 ; 111091 "RTN","C0CMXP",95,0) 111018 111092 I '$D(FARY) D ; 111019 "RTN","C0CMXP", 44,0)111093 "RTN","C0CMXP",96,0) 111020 111094 . S FARY="FARY" ; FILE ARRAY 111021 "RTN","C0CMXP", 45,0)111095 "RTN","C0CMXP",97,0) 111022 111096 . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE 111023 "RTN","C0CMXP", 46,0)111097 "RTN","C0CMXP",98,0) 111024 111098 D SETXPF(FARY) ;SET FILE VARIABLES 111025 "RTN","C0CMXP",47,0) 111026 N C0CA,C0CB 111027 "RTN","C0CMXP",48,0) 111028 S C0CA="" S C0CB=0 111029 "RTN","C0CMXP",49,0) 111030 F S C0CA=$O(@INARY@(C0CA)) Q:C0CA="" D ; FOR EACH XPATH 111031 "RTN","C0CMXP",50,0) 111032 . S C0CB=C0CB+1 ; COUNT OF XPATHS 111033 "RTN","C0CMXP",51,0) 111034 . S C0CFDA(C0CXPBF,"?+"_C0CB_","_TID_",",.01)=C0CA 111035 "RTN","C0CMXP",52,0) 111036 . D UPDIE ; CREATE THE BINDING SUBFILE FOR THIS XPATH 111037 "RTN","C0CMXP",53,0) 111099 "RTN","C0CMXP",99,0) 111100 I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,FARY) ;RESOLVE TEMPLATE NAME 111101 "RTN","C0CMXP",100,0) 111102 I $$GET1^DIQ(C0CXPF,TEMPID_",",C0CXTFLD,,OUTXML)'=OUTXML D Q ; 111103 "RTN","C0CMXP",101,0) 111104 . W "ERROR RETRIEVING TEMPLATE",! 111105 "RTN","C0CMXP",102,0) 111038 111106 Q 111039 "RTN","C0CMXP",54,0) 111040 ; 111041 "RTN","C0CMXP",55,0) 111042 FIXICD9 ; FIX THE ICD9RESULT XML 111043 "RTN","C0CMXP",56,0) 111044 D GETXML("GPL","ICD9RESULT") ; GET SOME BAD XML OUT OF THE FILE 111045 "RTN","C0CMXP",57,0) 111107 "RTN","C0CMXP",103,0) 111108 ; 111109 "RTN","C0CMXP",104,0) 111110 COPYWP(ZFLD,ZSRCREC,ZDESTREC,ZSRCF,ZDESTF) ; COPIES A WORD PROCESSING FIELD 111111 "RTN","C0CMXP",105,0) 111112 ; FROM ONE RECORD TO ANOTHER RECORD 111113 "RTN","C0CMXP",106,0) 111114 ; ZFLD IS EITHER A NUMBERIC FIELD OR A NAME IN ZSRCF 111115 "RTN","C0CMXP",107,0) 111116 ; ZSRCF IS THE SOURCE FILE, IN FILE REDIRECT FORMAT 111117 "RTN","C0CMXP",108,0) 111118 ; IF ZSRCF IS OMMITED, THE DEFAULT C0C XML MISC FILE WILL BE ASSUMED 111119 "RTN","C0CMXP",109,0) 111120 ; ZDESTF IS DESTINATION FILE. IF OMMITED, IS ASSUMED TO BE THE SAME 111121 "RTN","C0CMXP",110,0) 111122 ; A ZSRCF 111123 "RTN","C0CMXP",111,0) 111124 I '$D(ZSRCF) D ; 111125 "RTN","C0CMXP",112,0) 111126 . S ZSRCF="ZSRCF" 111127 "RTN","C0CMXP",113,0) 111128 . D INITFARY^C0CSOAP(ZSRCF) 111129 "RTN","C0CMXP",114,0) 111130 I '$D(ZDESTF) D ; 111131 "RTN","C0CMXP",115,0) 111132 . S ZDESTF="ZDESTF" 111133 "RTN","C0CMXP",116,0) 111134 . M @ZDESTF=@ZSRCF 111135 "RTN","C0CMXP",117,0) 111136 N ZSF,ZDF,ZSFREF,ZDFREF 111137 "RTN","C0CMXP",118,0) 111138 S ZSF=@ZSRCF@("XML FILE NUMBER") 111139 "RTN","C0CMXP",119,0) 111140 S ZSFREF=$$FILEREF^C0CRNF(ZSF) 111141 "RTN","C0CMXP",120,0) 111142 S ZDF=@ZDESTF@("XML FILE NUMBER") 111143 "RTN","C0CMXP",121,0) 111144 S ZDFREF=$$FILEREF^C0CRNF(ZDF) 111145 "RTN","C0CMXP",122,0) 111146 N ZSIEN,ZDIEN 111147 "RTN","C0CMXP",123,0) 111148 S ZSIEN=$O(@ZSFREF@("B",ZSRCREC,"")) 111149 "RTN","C0CMXP",124,0) 111150 I ZSIEN="" W !,"ERROR SOURCE RECORD NOT FOUND" Q ; 111151 "RTN","C0CMXP",125,0) 111152 S ZDIEN=$O(@ZDFREF@("B",ZDESTREC,"")) 111153 "RTN","C0CMXP",126,0) 111154 I ZDIEN="" W !,"ERROR DESTINATION RECORD NOT FOUND" Q ; 111155 "RTN","C0CMXP",127,0) 111156 N ZFLDNUM 111157 "RTN","C0CMXP",128,0) 111158 I +ZFLD=0 S ZFLDNUM=@ZSRCF@(ZFLD) ; IF FIELD IS PASSED BY NAME 111159 "RTN","C0CMXP",129,0) 111160 E S ZFLDNUM=ZFLD ; IF FIELD IS PASSED BY NUMBER 111161 "RTN","C0CMXP",130,0) 111162 N ZWP,ZWPN 111163 "RTN","C0CMXP",131,0) 111164 S ZWPN=$$GET1^DIQ(ZSF,ZSIEN_",",ZFLDNUM,,"ZWP") ; GET WP FROM SOURCE 111165 "RTN","C0CMXP",132,0) 111166 I ZWPN'="ZWP" W !,"ERROR SOURCE FIELD EMPTY" Q ; 111167 "RTN","C0CMXP",133,0) 111168 D WP^DIE(ZDF,ZDIEN_",",ZFLDNUM,,"ZWP") ; PUT WP FIELD TO DEST 111169 "RTN","C0CMXP",134,0) 111170 Q 111171 "RTN","C0CMXP",135,0) 111172 ; 111173 "RTN","C0CMXP",136,0) 111174 COMPILE(TID,UFARY) ; COMPILES AN XML TEMPLATE AND GENERATES XPATH BINDINGS 111175 "RTN","C0CMXP",137,0) 111176 ; UFARY IF SPECIFIED WILL REDIRECT THE XML FILE TO USE 111177 "RTN","C0CMXP",138,0) 111178 ; INTID IS THE IEN OF THE RECORD TO USE IN THE XML FILE 111179 "RTN","C0CMXP",139,0) 111180 ; XML IS PULLED FROM THE "XML" FIELD AND THE COMPILED RESULT PUT 111181 "RTN","C0CMXP",140,0) 111182 ; IN THE "XML TEMPLATE" FIELD. ALL XPATHS USED IN THE TEMPLATE 111183 "RTN","C0CMXP",141,0) 111184 ; WILL BE POPULATED TO THE XPATH BINDINGS SUBFILE AS .01 111185 "RTN","C0CMXP",142,0) 111186 I '$D(UFARY) D ; 111187 "RTN","C0CMXP",143,0) 111188 . S UFARY="DEFFARY" ; FILE ARRAY 111189 "RTN","C0CMXP",144,0) 111190 . ;D INITXPF("UFARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE 111191 "RTN","C0CMXP",145,0) 111192 . D INITFARY^C0CSOAP(UFARY) 111193 "RTN","C0CMXP",146,0) 111194 D SETXPF(UFARY) ;SET FILE VARIABLES 111195 "RTN","C0CMXP",147,0) 111196 I +TID=0 S INTID=$$RESTID^C0CSOAP(TID,UFARY) 111197 "RTN","C0CMXP",148,0) 111198 E S INTID=TID 111199 "RTN","C0CMXP",149,0) 111200 ;B 111201 "RTN","C0CMXP",150,0) 111202 ;N C0CXML,C0CREDUX,C0CTEMP,C0CIDX 111203 "RTN","C0CMXP",151,0) 111204 D GETXML("C0CXML",INTID,UFARY) 111205 "RTN","C0CMXP",152,0) 111206 S C0CREDUX=$$GET1^DIQ(C0CXPF,INTID_",",C0CRDUXF,"E") ;XPATH REDUCTION STRING 111207 "RTN","C0CMXP",153,0) 111208 D MKTPLATE("C0CTEMP","C0CIDX","C0CXML",C0CREDUX) ; CREATE TEMPLATE AND IDX 111209 "RTN","C0CMXP",154,0) 111210 D ADDTEMP("C0CTEMP",INTID,UFARY) ; WRITE THE TEMPLATE TO FILE 111211 "RTN","C0CMXP",155,0) 111212 D ADDXP("C0CIDX",INTID,UFARY) ;CREATE XPATH SUBFILE ENTRIES FOR EVERY XPATH 111213 "RTN","C0CMXP",156,0) 111214 Q 111215 "RTN","C0CMXP",157,0) 111216 ; 111217 "RTN","C0CMXP",158,0) 111218 MKTPLATE(OUTT,OUTIDX,INXML,REDUX) ;MAKE A TEMPLATE FROM INXML, RETURNED IN OUTT 111219 "RTN","C0CMXP",159,0) 111220 ; BOTH PASSED BY NAME. THE REDUX XPATH REDUCTION STRING IS USED IF PASSED 111221 "RTN","C0CMXP",160,0) 111222 ; OUTIDX IS AN ARRAY OF THE XPATHS USED IN MAKING THE TEMPLATE 111223 "RTN","C0CMXP",161,0) 111224 ; 111225 "RTN","C0CMXP",162,0) 111226 S C0CXLOC=$NA(^TMP("C0CXML",$J)) 111227 "RTN","C0CMXP",163,0) 111228 K @C0CXLOC 111229 "RTN","C0CMXP",164,0) 111230 M @C0CXLOC=@INXML 111231 "RTN","C0CMXP",165,0) 111232 S C0CDOCID=$$PARSE^C0CMXML(C0CXLOC,"C0CMKT") 111233 "RTN","C0CMXP",166,0) 111234 K @C0CXLOC 111235 "RTN","C0CMXP",167,0) 111236 S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 111237 "RTN","C0CMXP",168,0) 111238 ;N GIDX,GIDX2,GARY,GARY2 111239 "RTN","C0CMXP",169,0) 111240 I '$D(REDUX) S REDUX="" 111241 "RTN","C0CMXP",170,0) 111242 D XPATH^C0CMXML(1,"/","GIDX","GARY",,REDUX) 111243 "RTN","C0CMXP",171,0) 111244 D INVERT("GIDX2","GIDX") ;MAKE ARRAY TO LOOK UP XPATH BY NODE 111245 "RTN","C0CMXP",172,0) 111246 N ZI,ZD S ZI="" 111247 "RTN","C0CMXP",173,0) 111248 F S ZI=$O(@C0CDOM@(ZI)) Q:ZI="" D ; FOR EACH NODE IN THE DOM 111249 "RTN","C0CMXP",174,0) 111250 . K ZD ;FOR DATA 111251 "RTN","C0CMXP",175,0) 111252 . D DATA^C0CMXML("ZD",ZI) ;SEE IF THERE IS DATA FOR THIS NODE 111253 "RTN","C0CMXP",176,0) 111254 . ;I $D(ZD(1)) D ; IF YES 111255 "RTN","C0CMXP",177,0) 111256 . I $$FIRST^C0CMXML(ZI)=0 D ; IF THERE ARE NO CHILDREN TO THIS NODE 111257 "RTN","C0CMXP",178,0) 111258 . . ;I ZI<3 B ;W !,ZD(1) 111259 "RTN","C0CMXP",179,0) 111260 . . K @C0CDOM@(ZI,"T") ; KILL THE DATA 111261 "RTN","C0CMXP",180,0) 111262 . . N ZXPATH 111263 "RTN","C0CMXP",181,0) 111264 . . S ZXPATH=$G(GIDX2(ZI)) ;FIND AN XPATH FOR THIS NODE 111265 "RTN","C0CMXP",182,0) 111266 . . S @C0CDOM@(ZI,"T",1)="@@"_ZXPATH_"@@" 111267 "RTN","C0CMXP",183,0) 111268 . . I ZXPATH'="" S @OUTIDX@(ZXPATH)="" ; PASS BACK XPATH USED IN IDX 111269 "RTN","C0CMXP",184,0) 111270 D OUTXML^C0CMXML(OUTT,C0CDOCID) 111271 "RTN","C0CMXP",185,0) 111272 Q 111273 "RTN","C0CMXP",186,0) 111274 ; 111275 "RTN","C0CMXP",187,0) 111276 INVERT(OUTX,INX) ;INVERTS AN XPATH INDEX RETURNING @OUTX@(x)=XPath from 111277 "RTN","C0CMXP",188,0) 111278 ; @INX@(XPath)=x 111279 "RTN","C0CMXP",189,0) 111280 N ZI S ZI="" 111281 "RTN","C0CMXP",190,0) 111282 F S ZI=$O(@INX@(ZI)) Q:ZI="" D ;FOR EACH XPATH IN THE INPUT 111283 "RTN","C0CMXP",191,0) 111284 . S @OUTX@(@INX@(ZI))=ZI ; SET INVERTED ENTRY 111285 "RTN","C0CMXP",192,0) 111286 Q 111287 "RTN","C0CMXP",193,0) 111288 ; 111289 "RTN","C0CMXP",194,0) 111290 DEMUX(OUTX,INX) ;PARSES XPATH PASSED BY VALUE IN INX TO REMOVE [x] MULTIPLES 111291 "RTN","C0CMXP",195,0) 111292 ; RETURNS OUTX: MULTIPLE^SUBMULTIPLE^XPATH 111293 "RTN","C0CMXP",196,0) 111294 N ZX,ZY,ZZ,ZZ1,ZMULT,ZSUB 111295 "RTN","C0CMXP",197,0) 111296 S (ZMULT,ZSUB)="" 111297 "RTN","C0CMXP",198,0) 111298 S ZX=$P(INX,"[",2) 111299 "RTN","C0CMXP",199,0) 111300 I ZX'="" D ; THERE IS A [x] MULTIPLE 111301 "RTN","C0CMXP",200,0) 111302 . S ZY=$P(INX,"[",1) ;FIRST PART OF XPATH 111303 "RTN","C0CMXP",201,0) 111304 . S ZMULT=$P(ZX,"]",1) ; NUMBER OF THE MULTIPLE 111305 "RTN","C0CMXP",202,0) 111306 . S ZX=ZY_$P(ZX,"]",2) ; REST OF THE XPATH 111307 "RTN","C0CMXP",203,0) 111308 . I $P(ZX,"[",2)'="" D ; A SUB MULTIPLE EXISTS 111309 "RTN","C0CMXP",204,0) 111310 . . S ZZ=$P(ZX,"[",1) ; FIRST PART OF XPATH 111311 "RTN","C0CMXP",205,0) 111312 . . S ZX=$P(ZX,"[",2) ; DELETE THE [ 111313 "RTN","C0CMXP",206,0) 111314 . . S ZSUB=$P(ZX,"]",1) ; NUMBER OF THE SUBMULTIPLE 111315 "RTN","C0CMXP",207,0) 111316 . . S ZX=ZZ_$P(ZX,"]",2) ; REST OF THE XPATH 111317 "RTN","C0CMXP",208,0) 111318 E S ZX=INX ;NO MULTIPLE HERE 111319 "RTN","C0CMXP",209,0) 111320 S @OUTX=ZMULT_"^"_ZSUB_"^"_ZX ;RETURN MULTIPLE^SUBMULTIPLE^XPATH 111321 "RTN","C0CMXP",210,0) 111322 Q 111323 "RTN","C0CMXP",211,0) 111324 ; 111325 "RTN","C0CMXP",212,0) 111326 DEMUXARY(OARY,IARY,DEPTH) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO 111327 "RTN","C0CMXP",213,0) 111328 ; FORMAT @OARY@(x,variablename) where x is the first multiple 111329 "RTN","C0CMXP",214,0) 111330 ; IF DEPTH=2, THE LAST 2 PARTS OF THE XPATH WILL BE USED 111331 "RTN","C0CMXP",215,0) 111332 N ZI,ZJ,ZK,ZL,ZM S ZI="" 111333 "RTN","C0CMXP",216,0) 111334 F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; 111335 "RTN","C0CMXP",217,0) 111336 . D DEMUX^C0CMXP("ZJ",ZI) 111337 "RTN","C0CMXP",218,0) 111338 . S ZK=$P(ZJ,"^",3) 111339 "RTN","C0CMXP",219,0) 111340 . S ZM=$RE($P($RE(ZK),"/",1)) 111341 "RTN","C0CMXP",220,0) 111342 . I $G(DEPTH)=2 D ;LAST TWO PARTS OF XPATH USED FOR THE VARIABLE NAME 111343 "RTN","C0CMXP",221,0) 111344 . . S ZM=$RE($P($RE(ZK),"/",2))_ZM 111345 "RTN","C0CMXP",222,0) 111346 . S ZL=$P(ZJ,"^",1) 111347 "RTN","C0CMXP",223,0) 111348 . I ZL="" S ZL=1 111349 "RTN","C0CMXP",224,0) 111350 . I $D(@OARY@(ZL,ZM)) D ;IT'S A DUP 111351 "RTN","C0CMXP",225,0) 111352 . . S @OARY@(ZL,ZM_"[2]")=@IARY@(ZI) 111353 "RTN","C0CMXP",226,0) 111354 . E S @OARY@(ZL,ZM)=@IARY@(ZI) 111355 "RTN","C0CMXP",227,0) 111356 Q 111357 "RTN","C0CMXP",228,0) 111358 ; 111359 "RTN","C0CMXP",229,0) 111360 DEMUX2(OARY,IARY,DEPTH) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO 111361 "RTN","C0CMXP",230,0) 111362 ; FORMAT @OARY@(x,variablename) where x is the first multiple 111363 "RTN","C0CMXP",231,0) 111364 ; IF DEPTH=2, THE LAST 2 PARTS OF THE XPATH WILL BE USED 111365 "RTN","C0CMXP",232,0) 111366 N ZI,ZJ,ZK,ZL,ZM S ZI="" 111367 "RTN","C0CMXP",233,0) 111368 F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; 111369 "RTN","C0CMXP",234,0) 111370 . D DEMUX^C0CMXP("ZJ",ZI) 111371 "RTN","C0CMXP",235,0) 111372 . S ZK=$P(ZJ,"^",3) 111373 "RTN","C0CMXP",236,0) 111374 . S ZM=$RE($P($RE(ZK),"/",1)) 111375 "RTN","C0CMXP",237,0) 111376 . I $G(DEPTH)=2 D ;LAST TWO PARTS OF XPATH USED FOR THE VARIABLE NAME 111377 "RTN","C0CMXP",238,0) 111378 . . S ZM=$RE($P($RE(ZK),"/",2))_"."_ZM 111379 "RTN","C0CMXP",239,0) 111380 . S ZL=$P(ZJ,"^",1) 111381 "RTN","C0CMXP",240,0) 111382 . I ZL="" S ZL=1 111383 "RTN","C0CMXP",241,0) 111384 . I $D(@OARY@(ZL,ZM)) D ;IT'S A DUP 111385 "RTN","C0CMXP",242,0) 111386 . . S @OARY@(ZL,ZM_"[2]")=@IARY@(ZI) 111387 "RTN","C0CMXP",243,0) 111388 . E S @OARY@(ZL,ZM)=@IARY@(ZI) 111389 "RTN","C0CMXP",244,0) 111390 Q 111391 "RTN","C0CMXP",245,0) 111392 ; 111393 "RTN","C0CMXP",246,0) 111394 DEMUXXP1(OARY,IARY) ;IARY IS INCOMING XPATH ARRAY 111395 "RTN","C0CMXP",247,0) 111396 ; BOTH IARY AND OARY ARE PASSED BY NAME 111397 "RTN","C0CMXP",248,0) 111398 ; RETURNS A SIMPLE XPATH ARRAY WITHOUT MULTIPLES. DUPLICATES ARE REMOVED 111399 "RTN","C0CMXP",249,0) 111400 N ZI,ZJ,ZK 111401 "RTN","C0CMXP",250,0) 111046 111402 S ZI="" 111047 "RTN","C0CMXP",58,0) 111048 S G="" 111049 "RTN","C0CMXP",59,0) 111050 F S ZI=$O(GPL(ZI)) Q:ZI="" D ; FOR EACH LINE 111051 "RTN","C0CMXP",60,0) 111052 . S G=G_GPL(ZI) ; MAKE ONE BIG STRING OF XML 111053 "RTN","C0CMXP",61,0) 111054 D NORMAL^C0CSOAP("G2","G") ;NO NORMALIZE IT BACK INTO AN ARRAY 111055 "RTN","C0CMXP",62,0) 111056 D ADDXML("G2","ICD9RESULT") ; AND PUT IT BACK 111057 "RTN","C0CMXP",63,0) 111403 "RTN","C0CMXP",251,0) 111404 F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH XPATH IN IARY 111405 "RTN","C0CMXP",252,0) 111406 . D DEMUX^C0CMXP("ZJ",ZI) 111407 "RTN","C0CMXP",253,0) 111408 . S ZK=$P(ZJ,"^",3) ;THE XPATH 111409 "RTN","C0CMXP",254,0) 111410 . S @OARY@(ZK)=@IARY@(ZI) ;THE RESULT. DUPLICATES WILL NOT SHOW 111411 "RTN","C0CMXP",255,0) 111412 . ; CAUTION, IF THERE ARE MULTIPLES, ONLY THE DATA FOR THE LAST 111413 "RTN","C0CMXP",256,0) 111414 . ; MULTIPLE WILL BE INCLUDED IN THE OUTPUT ARRAY, ASSIGNED TO THE 111415 "RTN","C0CMXP",257,0) 111416 . ; COMMON XPATH 111417 "RTN","C0CMXP",258,0) 111058 111418 Q 111059 "RTN","C0CMXP",64,0) 111060 ADDXML(INXML,TEMPID,INFARY) ;ADD XML TO A TEMPLATE ID TEMPID 111061 "RTN","C0CMXP",65,0) 111062 ; INXML IS PASSED BY NAME 111063 "RTN","C0CMXP",66,0) 111064 I '$D(INFARY) D ; 111065 "RTN","C0CMXP",67,0) 111066 . S INFARY="FARY" ; FILE ARRAY 111067 "RTN","C0CMXP",68,0) 111068 . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE 111069 "RTN","C0CMXP",69,0) 111070 I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME 111071 "RTN","C0CMXP",70,0) 111072 D SETXPF(INFARY) ;SET FILE VARIABLES 111073 "RTN","C0CMXP",71,0) 111074 D WP^DIE(C0CXPF,TEMPID_",",C0CXFLD,,INXML) 111075 "RTN","C0CMXP",72,0) 111419 "RTN","C0CMXP",259,0) 111420 ; 111421 "RTN","C0CMXP",260,0) 111422 DEMUXXP2(OARY,IARY) ; IARY AND OARY ARE PASSED BY NAME 111423 "RTN","C0CMXP",261,0) 111424 ; IARY IS AN XPATH ARRAY THAT MAY CONTAIN MULTIPLES 111425 "RTN","C0CMXP",262,0) 111426 ; OARY IS THE OUTPUT ARRAY WHERE MULTIPLES ARE RETURNED IN THE FORM 111427 "RTN","C0CMXP",263,0) 111428 ; @OARY@(x,Xpath)=data or @OARY@(x,y,Xpath)=data WHERE x AND y ARE 111429 "RTN","C0CMXP",264,0) 111430 ; THE MULTIPLES AND Xpath IS THE BASE XPATH WITHOUT [x] AND [y] 111431 "RTN","C0CMXP",265,0) 111432 ; 111433 "RTN","C0CMXP",266,0) 111434 N ZI,ZJ,ZK,ZX,ZY,ZP 111435 "RTN","C0CMXP",267,0) 111436 S ZI="" 111437 "RTN","C0CMXP",268,0) 111438 F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH INPUT XPATH 111439 "RTN","C0CMXP",269,0) 111440 . D DEMUX("ZJ",ZI) ; PULL OUT THE MULTIPLES 111441 "RTN","C0CMXP",270,0) 111442 . S ZX=$P(ZJ,"^",1) ;x 111443 "RTN","C0CMXP",271,0) 111444 . S ZY=$P(ZJ,"^",2) ;y 111445 "RTN","C0CMXP",272,0) 111446 . S ZP=$P(ZJ,"^",3) ;Xpath 111447 "RTN","C0CMXP",273,0) 111448 . I ZX="" S ZX=1 ; NO MULTIPLE WILL STORE IN x=1 111449 "RTN","C0CMXP",274,0) 111450 . I ZY'="" D ;IS THERE A y? 111451 "RTN","C0CMXP",275,0) 111452 . . S @OARY@(ZX,ZY,ZP)=@IARY@(ZI) 111453 "RTN","C0CMXP",276,0) 111454 . E D ;NO y 111455 "RTN","C0CMXP",277,0) 111456 . . S @OARY@(ZX,ZP)=@IARY@(ZI) 111457 "RTN","C0CMXP",278,0) 111076 111458 Q 111077 "RTN","C0CMXP",73,0) 111078 ; 111079 "RTN","C0CMXP",74,0) 111080 ADDTEMP(INXML,TEMPID,INFARY) ;ADD XML TEMPLATE TO TEMPLATE RECORD TEMPID 111081 "RTN","C0CMXP",75,0) 111082 ; 111083 "RTN","C0CMXP",76,0) 111084 I '$D(INFARY) D ; 111085 "RTN","C0CMXP",77,0) 111086 . S INFARY="FARY" ; FILE ARRAY 111087 "RTN","C0CMXP",78,0) 111088 . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE 111089 "RTN","C0CMXP",79,0) 111090 I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME 111091 "RTN","C0CMXP",80,0) 111092 D SETXPF(INFARY) ;SET FILE VARIABLES 111093 "RTN","C0CMXP",81,0) 111094 D WP^DIE(C0CXPF,TEMPID_",",C0CXTFLD,,INXML) 111095 "RTN","C0CMXP",82,0) 111459 "RTN","C0CMXP",279,0) 111460 ; 111461 "RTN","C0CMXP",280,0) 111462 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 111463 "RTN","C0CMXP",281,0) 111464 K ZERR 111465 "RTN","C0CMXP",282,0) 111466 D CLEAN^DILF 111467 "RTN","C0CMXP",283,0) 111468 D UPDATE^DIE("","C0CFDA","","ZERR") 111469 "RTN","C0CMXP",284,0) 111470 I $D(ZERR) S $EC=",U1," 111471 "RTN","C0CMXP",285,0) 111472 K C0CFDA 111473 "RTN","C0CMXP",286,0) 111096 111474 Q 111097 "RTN","C0CMXP",83,0)111098 ;111099 "RTN","C0CMXP",84,0)111100 GETXML(OUTXML,TEMPID,INFARY) ;GET THE XML FROM TEMPLATE TEMPID111101 "RTN","C0CMXP",85,0)111102 ;111103 "RTN","C0CMXP",86,0)111104 I '$D(INFARY) D ;111105 "RTN","C0CMXP",87,0)111106 . S INFARY="FARY" ; FILE ARRAY111107 "RTN","C0CMXP",88,0)111108 . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE111109 "RTN","C0CMXP",89,0)111110 D SETXPF(INFARY) ;SET FILE VARIABLES111111 "RTN","C0CMXP",90,0)111112 I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME111113 "RTN","C0CMXP",91,0)111114 I $$GET1^DIQ(C0CXPF,TEMPID_",",C0CXFLD,,OUTXML)'=OUTXML D Q ;111115 "RTN","C0CMXP",92,0)111116 . W "ERROR RETRIEVING TEMPLATE",!111117 "RTN","C0CMXP",93,0)111118 Q111119 "RTN","C0CMXP",94,0)111120 ;111121 "RTN","C0CMXP",95,0)111122 GETTEMP(OUTXML,TEMPID,FARY) ;GET THE TEMPLATE XML FROM TEMPLATE TEMPID111123 "RTN","C0CMXP",96,0)111124 ;111125 "RTN","C0CMXP",97,0)111126 I '$D(FARY) D ;111127 "RTN","C0CMXP",98,0)111128 . S FARY="FARY" ; FILE ARRAY111129 "RTN","C0CMXP",99,0)111130 . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE111131 "RTN","C0CMXP",100,0)111132 D SETXPF(FARY) ;SET FILE VARIABLES111133 "RTN","C0CMXP",101,0)111134 I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,FARY) ;RESOLVE TEMPLATE NAME111135 "RTN","C0CMXP",102,0)111136 I $$GET1^DIQ(C0CXPF,TEMPID_",",C0CXTFLD,,OUTXML)'=OUTXML D Q ;111137 "RTN","C0CMXP",103,0)111138 . W "ERROR RETRIEVING TEMPLATE",!111139 "RTN","C0CMXP",104,0)111140 Q111141 "RTN","C0CMXP",105,0)111142 ;111143 "RTN","C0CMXP",106,0)111144 COPYWP(ZFLD,ZSRCREC,ZDESTREC,ZSRCF,ZDESTF) ; COPIES A WORD PROCESSING FIELD111145 "RTN","C0CMXP",107,0)111146 ; FROM ONE RECORD TO ANOTHER RECORD111147 "RTN","C0CMXP",108,0)111148 ; ZFLD IS EITHER A NUMBERIC FIELD OR A NAME IN ZSRCF111149 "RTN","C0CMXP",109,0)111150 ; ZSRCF IS THE SOURCE FILE, IN FILE REDIRECT FORMAT111151 "RTN","C0CMXP",110,0)111152 ; IF ZSRCF IS OMMITED, THE DEFAULT C0C XML MISC FILE WILL BE ASSUMED111153 "RTN","C0CMXP",111,0)111154 ; ZDESTF IS DESTINATION FILE. IF OMMITED, IS ASSUMED TO BE THE SAME111155 "RTN","C0CMXP",112,0)111156 ; A ZSRCF111157 "RTN","C0CMXP",113,0)111158 I '$D(ZSRCF) D ;111159 "RTN","C0CMXP",114,0)111160 . S ZSRCF="ZSRCF"111161 "RTN","C0CMXP",115,0)111162 . D INITFARY^C0CSOAP(ZSRCF)111163 "RTN","C0CMXP",116,0)111164 I '$D(ZDESTF) D ;111165 "RTN","C0CMXP",117,0)111166 . S ZDESTF="ZDESTF"111167 "RTN","C0CMXP",118,0)111168 . M @ZDESTF=@ZSRCF111169 "RTN","C0CMXP",119,0)111170 N ZSF,ZDF,ZSFREF,ZDFREF111171 "RTN","C0CMXP",120,0)111172 S ZSF=@ZSRCF@("XML FILE NUMBER")111173 "RTN","C0CMXP",121,0)111174 S ZSFREF=$$FILEREF^C0CRNF(ZSF)111175 "RTN","C0CMXP",122,0)111176 S ZDF=@ZDESTF@("XML FILE NUMBER")111177 "RTN","C0CMXP",123,0)111178 S ZDFREF=$$FILEREF^C0CRNF(ZDF)111179 "RTN","C0CMXP",124,0)111180 N ZSIEN,ZDIEN111181 "RTN","C0CMXP",125,0)111182 S ZSIEN=$O(@ZSFREF@("B",ZSRCREC,""))111183 "RTN","C0CMXP",126,0)111184 I ZSIEN="" W !,"ERROR SOURCE RECORD NOT FOUND" Q ;111185 "RTN","C0CMXP",127,0)111186 S ZDIEN=$O(@ZDFREF@("B",ZDESTREC,""))111187 "RTN","C0CMXP",128,0)111188 I ZDIEN="" W !,"ERROR DESTINATION RECORD NOT FOUND" Q ;111189 "RTN","C0CMXP",129,0)111190 N ZFLDNUM111191 "RTN","C0CMXP",130,0)111192 I +ZFLD=0 S ZFLDNUM=@ZSRCF@(ZFLD) ; IF FIELD IS PASSED BY NAME111193 "RTN","C0CMXP",131,0)111194 E S ZFLDNUM=ZFLD ; IF FIELD IS PASSED BY NUMBER111195 "RTN","C0CMXP",132,0)111196 N ZWP,ZWPN111197 "RTN","C0CMXP",133,0)111198 S ZWPN=$$GET1^DIQ(ZSF,ZSIEN_",",ZFLDNUM,,"ZWP") ; GET WP FROM SOURCE111199 "RTN","C0CMXP",134,0)111200 I ZWPN'="ZWP" W !,"ERROR SOURCE FIELD EMPTY" Q ;111201 "RTN","C0CMXP",135,0)111202 D WP^DIE(ZDF,ZDIEN_",",ZFLDNUM,,"ZWP") ; PUT WP FIELD TO DEST111203 "RTN","C0CMXP",136,0)111204 Q111205 "RTN","C0CMXP",137,0)111206 ;111207 "RTN","C0CMXP",138,0)111208 COMPILE(TID,UFARY) ; COMPILES AN XML TEMPLATE AND GENERATES XPATH BINDINGS111209 "RTN","C0CMXP",139,0)111210 ; UFARY IF SPECIFIED WILL REDIRECT THE XML FILE TO USE111211 "RTN","C0CMXP",140,0)111212 ; INTID IS THE IEN OF THE RECORD TO USE IN THE XML FILE111213 "RTN","C0CMXP",141,0)111214 ; XML IS PULLED FROM THE "XML" FIELD AND THE COMPILED RESULT PUT111215 "RTN","C0CMXP",142,0)111216 ; IN THE "XML TEMPLATE" FIELD. ALL XPATHS USED IN THE TEMPLATE111217 "RTN","C0CMXP",143,0)111218 ; WILL BE POPULATED TO THE XPATH BINDINGS SUBFILE AS .01111219 "RTN","C0CMXP",144,0)111220 I '$D(UFARY) D ;111221 "RTN","C0CMXP",145,0)111222 . S UFARY="DEFFARY" ; FILE ARRAY111223 "RTN","C0CMXP",146,0)111224 . ;D INITXPF("UFARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE111225 "RTN","C0CMXP",147,0)111226 . D INITFARY^C0CSOAP(UFARY)111227 "RTN","C0CMXP",148,0)111228 D SETXPF(UFARY) ;SET FILE VARIABLES111229 "RTN","C0CMXP",149,0)111230 I +TID=0 S INTID=$$RESTID^C0CSOAP(TID,UFARY)111231 "RTN","C0CMXP",150,0)111232 E S INTID=TID111233 "RTN","C0CMXP",151,0)111234 ;B111235 "RTN","C0CMXP",152,0)111236 ;N C0CXML,C0CREDUX,C0CTEMP,C0CIDX111237 "RTN","C0CMXP",153,0)111238 D GETXML("C0CXML",INTID,UFARY)111239 "RTN","C0CMXP",154,0)111240 S C0CREDUX=$$GET1^DIQ(C0CXPF,INTID_",",C0CRDUXF,"E") ;XPATH REDUCTION STRING111241 "RTN","C0CMXP",155,0)111242 D MKTPLATE("C0CTEMP","C0CIDX","C0CXML",C0CREDUX) ; CREATE TEMPLATE AND IDX111243 "RTN","C0CMXP",156,0)111244 D ADDTEMP("C0CTEMP",INTID,UFARY) ; WRITE THE TEMPLATE TO FILE111245 "RTN","C0CMXP",157,0)111246 D ADDXP("C0CIDX",INTID,UFARY) ;CREATE XPATH SUBFILE ENTRIES FOR EVERY XPATH111247 "RTN","C0CMXP",158,0)111248 Q111249 "RTN","C0CMXP",159,0)111250 ;111251 "RTN","C0CMXP",160,0)111252 MKTPLATE(OUTT,OUTIDX,INXML,REDUX) ;MAKE A TEMPLATE FROM INXML, RETURNED IN OUTT111253 "RTN","C0CMXP",161,0)111254 ; BOTH PASSED BY NAME. THE REDUX XPATH REDUCTION STRING IS USED IF PASSED111255 "RTN","C0CMXP",162,0)111256 ; OUTIDX IS AN ARRAY OF THE XPATHS USED IN MAKING THE TEMPLATE111257 "RTN","C0CMXP",163,0)111258 ;111259 "RTN","C0CMXP",164,0)111260 S C0CXLOC=$NA(^TMP("C0CXML",$J))111261 "RTN","C0CMXP",165,0)111262 K @C0CXLOC111263 "RTN","C0CMXP",166,0)111264 M @C0CXLOC=@INXML111265 "RTN","C0CMXP",167,0)111266 S C0CDOCID=$$PARSE^C0CMXML(C0CXLOC,"C0CMKT")111267 "RTN","C0CMXP",168,0)111268 K @C0CXLOC111269 "RTN","C0CMXP",169,0)111270 S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))111271 "RTN","C0CMXP",170,0)111272 ;N GIDX,GIDX2,GARY,GARY2111273 "RTN","C0CMXP",171,0)111274 I '$D(REDUX) S REDUX=""111275 "RTN","C0CMXP",172,0)111276 D XPATH^C0CMXML(1,"/","GIDX","GARY",,REDUX)111277 "RTN","C0CMXP",173,0)111278 D INVERT("GIDX2","GIDX") ;MAKE ARRAY TO LOOK UP XPATH BY NODE111279 "RTN","C0CMXP",174,0)111280 N ZI,ZD S ZI=""111281 "RTN","C0CMXP",175,0)111282 F S ZI=$O(@C0CDOM@(ZI)) Q:ZI="" D ; FOR EACH NODE IN THE DOM111283 "RTN","C0CMXP",176,0)111284 . K ZD ;FOR DATA111285 "RTN","C0CMXP",177,0)111286 . D DATA^C0CMXML("ZD",ZI) ;SEE IF THERE IS DATA FOR THIS NODE111287 "RTN","C0CMXP",178,0)111288 . ;I $D(ZD(1)) D ; IF YES111289 "RTN","C0CMXP",179,0)111290 . I $$FIRST^C0CMXML(ZI)=0 D ; IF THERE ARE NO CHILDREN TO THIS NODE111291 "RTN","C0CMXP",180,0)111292 . . ;I ZI<3 B ;W !,ZD(1)111293 "RTN","C0CMXP",181,0)111294 . . K @C0CDOM@(ZI,"T") ; KILL THE DATA111295 "RTN","C0CMXP",182,0)111296 . . N ZXPATH111297 "RTN","C0CMXP",183,0)111298 . . S ZXPATH=$G(GIDX2(ZI)) ;FIND AN XPATH FOR THIS NODE111299 "RTN","C0CMXP",184,0)111300 . . S @C0CDOM@(ZI,"T",1)="@@"_ZXPATH_"@@"111301 "RTN","C0CMXP",185,0)111302 . . I ZXPATH'="" S @OUTIDX@(ZXPATH)="" ; PASS BACK XPATH USED IN IDX111303 "RTN","C0CMXP",186,0)111304 D OUTXML^C0CMXML(OUTT,C0CDOCID)111305 "RTN","C0CMXP",187,0)111306 Q111307 "RTN","C0CMXP",188,0)111308 ;111309 "RTN","C0CMXP",189,0)111310 INVERT(OUTX,INX) ;INVERTS AN XPATH INDEX RETURNING @OUTX@(x)=XPath from111311 "RTN","C0CMXP",190,0)111312 ; @INX@(XPath)=x111313 "RTN","C0CMXP",191,0)111314 N ZI S ZI=""111315 "RTN","C0CMXP",192,0)111316 F S ZI=$O(@INX@(ZI)) Q:ZI="" D ;FOR EACH XPATH IN THE INPUT111317 "RTN","C0CMXP",193,0)111318 . S @OUTX@(@INX@(ZI))=ZI ; SET INVERTED ENTRY111319 "RTN","C0CMXP",194,0)111320 Q111321 "RTN","C0CMXP",195,0)111322 ;111323 "RTN","C0CMXP",196,0)111324 DEMUX(OUTX,INX) ;PARSES XPATH PASSED BY VALUE IN INX TO REMOVE [x] MULTIPLES111325 "RTN","C0CMXP",197,0)111326 ; RETURNS OUTX: MULTIPLE^SUBMULTIPLE^XPATH111327 "RTN","C0CMXP",198,0)111328 N ZX,ZY,ZZ,ZZ1,ZMULT,ZSUB111329 "RTN","C0CMXP",199,0)111330 S (ZMULT,ZSUB)=""111331 "RTN","C0CMXP",200,0)111332 S ZX=$P(INX,"[",2)111333 "RTN","C0CMXP",201,0)111334 I ZX'="" D ; THERE IS A [x] MULTIPLE111335 "RTN","C0CMXP",202,0)111336 . S ZY=$P(INX,"[",1) ;FIRST PART OF XPATH111337 "RTN","C0CMXP",203,0)111338 . S ZMULT=$P(ZX,"]",1) ; NUMBER OF THE MULTIPLE111339 "RTN","C0CMXP",204,0)111340 . S ZX=ZY_$P(ZX,"]",2) ; REST OF THE XPATH111341 "RTN","C0CMXP",205,0)111342 . I $P(ZX,"[",2)'="" D ; A SUB MULTIPLE EXISTS111343 "RTN","C0CMXP",206,0)111344 . . S ZZ=$P(ZX,"[",1) ; FIRST PART OF XPATH111345 "RTN","C0CMXP",207,0)111346 . . S ZX=$P(ZX,"[",2) ; DELETE THE [111347 "RTN","C0CMXP",208,0)111348 . . S ZSUB=$P(ZX,"]",1) ; NUMBER OF THE SUBMULTIPLE111349 "RTN","C0CMXP",209,0)111350 . . S ZX=ZZ_$P(ZX,"]",2) ; REST OF THE XPATH111351 "RTN","C0CMXP",210,0)111352 E S ZX=INX ;NO MULTIPLE HERE111353 "RTN","C0CMXP",211,0)111354 S @OUTX=ZMULT_"^"_ZSUB_"^"_ZX ;RETURN MULTIPLE^SUBMULTIPLE^XPATH111355 "RTN","C0CMXP",212,0)111356 Q111357 "RTN","C0CMXP",213,0)111358 ;111359 "RTN","C0CMXP",214,0)111360 DEMUXARY(OARY,IARY,DEPTH) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO111361 "RTN","C0CMXP",215,0)111362 ; FORMAT @OARY@(x,variablename) where x is the first multiple111363 "RTN","C0CMXP",216,0)111364 ; IF DEPTH=2, THE LAST 2 PARTS OF THE XPATH WILL BE USED111365 "RTN","C0CMXP",217,0)111366 N ZI,ZJ,ZK,ZL,ZM S ZI=""111367 "RTN","C0CMXP",218,0)111368 F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ;111369 "RTN","C0CMXP",219,0)111370 . D DEMUX^C0CMXP("ZJ",ZI)111371 "RTN","C0CMXP",220,0)111372 . S ZK=$P(ZJ,"^",3)111373 "RTN","C0CMXP",221,0)111374 . S ZM=$RE($P($RE(ZK),"/",1))111375 "RTN","C0CMXP",222,0)111376 . I $G(DEPTH)=2 D ;LAST TWO PARTS OF XPATH USED FOR THE VARIABLE NAME111377 "RTN","C0CMXP",223,0)111378 . . S ZM=$RE($P($RE(ZK),"/",2))_ZM111379 "RTN","C0CMXP",224,0)111380 . S ZL=$P(ZJ,"^",1)111381 "RTN","C0CMXP",225,0)111382 . I ZL="" S ZL=1111383 "RTN","C0CMXP",226,0)111384 . I $D(@OARY@(ZL,ZM)) D ;IT'S A DUP111385 "RTN","C0CMXP",227,0)111386 . . S @OARY@(ZL,ZM_"[2]")=@IARY@(ZI)111387 "RTN","C0CMXP",228,0)111388 . E S @OARY@(ZL,ZM)=@IARY@(ZI)111389 "RTN","C0CMXP",229,0)111390 Q111391 "RTN","C0CMXP",230,0)111392 ;111393 "RTN","C0CMXP",231,0)111394 DEMUX2(OARY,IARY,DEPTH) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO111395 "RTN","C0CMXP",232,0)111396 ; FORMAT @OARY@(x,variablename) where x is the first multiple111397 "RTN","C0CMXP",233,0)111398 ; IF DEPTH=2, THE LAST 2 PARTS OF THE XPATH WILL BE USED111399 "RTN","C0CMXP",234,0)111400 N ZI,ZJ,ZK,ZL,ZM S ZI=""111401 "RTN","C0CMXP",235,0)111402 F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ;111403 "RTN","C0CMXP",236,0)111404 . D DEMUX^C0CMXP("ZJ",ZI)111405 "RTN","C0CMXP",237,0)111406 . S ZK=$P(ZJ,"^",3)111407 "RTN","C0CMXP",238,0)111408 . S ZM=$RE($P($RE(ZK),"/",1))111409 "RTN","C0CMXP",239,0)111410 . I $G(DEPTH)=2 D ;LAST TWO PARTS OF XPATH USED FOR THE VARIABLE NAME111411 "RTN","C0CMXP",240,0)111412 . . S ZM=$RE($P($RE(ZK),"/",2))_"."_ZM111413 "RTN","C0CMXP",241,0)111414 . S ZL=$P(ZJ,"^",1)111415 "RTN","C0CMXP",242,0)111416 . I ZL="" S ZL=1111417 "RTN","C0CMXP",243,0)111418 . I $D(@OARY@(ZL,ZM)) D ;IT'S A DUP111419 "RTN","C0CMXP",244,0)111420 . . S @OARY@(ZL,ZM_"[2]")=@IARY@(ZI)111421 "RTN","C0CMXP",245,0)111422 . E S @OARY@(ZL,ZM)=@IARY@(ZI)111423 "RTN","C0CMXP",246,0)111424 Q111425 "RTN","C0CMXP",247,0)111426 ;111427 "RTN","C0CMXP",248,0)111428 DEMUXXP1(OARY,IARY) ;IARY IS INCOMING XPATH ARRAY111429 "RTN","C0CMXP",249,0)111430 ; BOTH IARY AND OARY ARE PASSED BY NAME111431 "RTN","C0CMXP",250,0)111432 ; RETURNS A SIMPLE XPATH ARRAY WITHOUT MULTIPLES. DUPLICATES ARE REMOVED111433 "RTN","C0CMXP",251,0)111434 N ZI,ZJ,ZK111435 "RTN","C0CMXP",252,0)111436 S ZI=""111437 "RTN","C0CMXP",253,0)111438 F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH XPATH IN IARY111439 "RTN","C0CMXP",254,0)111440 . D DEMUX^C0CMXP("ZJ",ZI)111441 "RTN","C0CMXP",255,0)111442 . S ZK=$P(ZJ,"^",3) ;THE XPATH111443 "RTN","C0CMXP",256,0)111444 . S @OARY@(ZK)=@IARY@(ZI) ;THE RESULT. DUPLICATES WILL NOT SHOW111445 "RTN","C0CMXP",257,0)111446 . ; CAUTION, IF THERE ARE MULTIPLES, ONLY THE DATA FOR THE LAST111447 "RTN","C0CMXP",258,0)111448 . ; MULTIPLE WILL BE INCLUDED IN THE OUTPUT ARRAY, ASSIGNED TO THE111449 "RTN","C0CMXP",259,0)111450 . ; COMMON XPATH111451 "RTN","C0CMXP",260,0)111452 Q111453 "RTN","C0CMXP",261,0)111454 ;111455 "RTN","C0CMXP",262,0)111456 DEMUXXP2(OARY,IARY) ; IARY AND OARY ARE PASSED BY NAME111457 "RTN","C0CMXP",263,0)111458 ; IARY IS AN XPATH ARRAY THAT MAY CONTAIN MULTIPLES111459 "RTN","C0CMXP",264,0)111460 ; OARY IS THE OUTPUT ARRAY WHERE MULTIPLES ARE RETURNED IN THE FORM111461 "RTN","C0CMXP",265,0)111462 ; @OARY@(x,Xpath)=data or @OARY@(x,y,Xpath)=data WHERE x AND y ARE111463 "RTN","C0CMXP",266,0)111464 ; THE MULTIPLES AND Xpath IS THE BASE XPATH WITHOUT [x] AND [y]111465 "RTN","C0CMXP",267,0)111466 ;111467 "RTN","C0CMXP",268,0)111468 N ZI,ZJ,ZK,ZX,ZY,ZP111469 "RTN","C0CMXP",269,0)111470 S ZI=""111471 "RTN","C0CMXP",270,0)111472 F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH INPUT XPATH111473 "RTN","C0CMXP",271,0)111474 . D DEMUX("ZJ",ZI) ; PULL OUT THE MULTIPLES111475 "RTN","C0CMXP",272,0)111476 . S ZX=$P(ZJ,"^",1) ;x111477 "RTN","C0CMXP",273,0)111478 . S ZY=$P(ZJ,"^",2) ;y111479 "RTN","C0CMXP",274,0)111480 . S ZP=$P(ZJ,"^",3) ;Xpath111481 "RTN","C0CMXP",275,0)111482 . I ZX="" S ZX=1 ; NO MULTIPLE WILL STORE IN x=1111483 "RTN","C0CMXP",276,0)111484 . I ZY'="" D ;IS THERE A y?111485 "RTN","C0CMXP",277,0)111486 . . S @OARY@(ZX,ZY,ZP)=@IARY@(ZI)111487 "RTN","C0CMXP",278,0)111488 . E D ;NO y111489 "RTN","C0CMXP",279,0)111490 . . S @OARY@(ZX,ZP)=@IARY@(ZI)111491 "RTN","C0CMXP",280,0)111492 Q111493 "RTN","C0CMXP",281,0)111494 ;111495 "RTN","C0CMXP",282,0)111496 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS111497 "RTN","C0CMXP",283,0)111498 K ZERR111499 "RTN","C0CMXP",284,0)111500 D CLEAN^DILF111501 "RTN","C0CMXP",285,0)111502 D UPDATE^DIE("","C0CFDA","","ZERR")111503 "RTN","C0CMXP",286,0)111504 I $D(ZERR) D ;111505 111475 "RTN","C0CMXP",287,0) 111506 . W "ERROR",!111507 "RTN","C0CMXP",288,0)111508 . ZWR ZERR111509 "RTN","C0CMXP",289,0)111510 . B111511 "RTN","C0CMXP",290,0)111512 K C0CFDA111513 "RTN","C0CMXP",291,0)111514 Q111515 "RTN","C0CMXP",292,0)111516 111476 ; 111517 111477 "RTN","C0CNHIN") 111518 0^88^B87 973392111478 0^88^B87084020 111519 111479 "RTN","C0CNHIN",1,0) 111520 111480 C0CNHIN ; GPL - PROCESSING FOR OUTPUT OF NHINV ROUTINES;6/3/11 17:05 111521 111481 "RTN","C0CNHIN",2,0) 111522 ;;1.2;C 0C;;May 11, 2012;Build 50111482 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 111523 111483 "RTN","C0CNHIN",3,0) 111524 ;Copyright 2011 George Lilly. Licensed under the terms of the GNU111484 ;Copyright 2011 George Lilly. 111525 111485 "RTN","C0CNHIN",4,0) 111526 ; General Public License See attached copy of the License.111486 ; 111527 111487 "RTN","C0CNHIN",5,0) 111528 ; 111488 ; This program is free software: you can redistribute it and/or modify 111529 111489 "RTN","C0CNHIN",6,0) 111530 ; This program is free software; you can redistribute it and/or modify111490 ; it under the terms of the GNU Affero General Public License as 111531 111491 "RTN","C0CNHIN",7,0) 111532 ; it under the terms of the GNU General Public License as published by111492 ; published by the Free Software Foundation, either version 3 of the 111533 111493 "RTN","C0CNHIN",8,0) 111534 ; the Free Software Foundation; either version 2 of the License, or111494 ; License, or (at your option) any later version. 111535 111495 "RTN","C0CNHIN",9,0) 111536 ; (at your option) any later version.111496 ; 111537 111497 "RTN","C0CNHIN",10,0) 111538 ; 111498 ; This program is distributed in the hope that it will be useful, 111539 111499 "RTN","C0CNHIN",11,0) 111540 ; This program is distributed in the hope that it will be useful,111500 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 111541 111501 "RTN","C0CNHIN",12,0) 111542 ; but WITHOUT ANY WARRANTY; without even the implied warranty of111502 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 111543 111503 "RTN","C0CNHIN",13,0) 111544 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the111504 ; GNU Affero General Public License for more details. 111545 111505 "RTN","C0CNHIN",14,0) 111546 ; GNU General Public License for more details.111506 ; 111547 111507 "RTN","C0CNHIN",15,0) 111548 ; 111508 ; You should have received a copy of the GNU Affero General Public License 111549 111509 "RTN","C0CNHIN",16,0) 111550 ; You should have received a copy of the GNU General Public License along111510 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 111551 111511 "RTN","C0CNHIN",17,0) 111552 ; with this program; if not, write to the Free Software Foundation, Inc.,111512 ; 111553 111513 "RTN","C0CNHIN",18,0) 111554 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.111514 Q 111555 111515 "RTN","C0CNHIN",19,0) 111556 ; 111516 EN(ZRTN,ZDFN,ZPART,KEEP) ; GENERATE AN NHIN ARRAY FOR A PATIENT 111557 111517 "RTN","C0CNHIN",20,0) 111518 ; 111519 "RTN","C0CNHIN",21,0) 111520 K GARY,GNARY,GIDX,C0CDOCID 111521 "RTN","C0CNHIN",22,0) 111522 N GN 111523 "RTN","C0CNHIN",23,0) 111524 K ^TMP("NHINV",$J) ; CLEAN UP FROM LAST CALL 111525 "RTN","C0CNHIN",24,0) 111526 K ^TMP("MXMLDOM",$J) ; CLEAN UP DOM 111527 "RTN","C0CNHIN",25,0) 111528 K ^TMP("MXMLERR",$J) ; CLEAN UP MXML ERRORS 111529 "RTN","C0CNHIN",26,0) 111530 D GET^NHINV(.GN,ZDFN,ZPART) ; CALL NHINV ROUTINES TO PULL XML 111531 "RTN","C0CNHIN",27,0) 111532 S GN=$P(GN,")",1)_")" ; CUT OFF THE REST OF LINE PROTOCOL 111533 "RTN","C0CNHIN",28,0) 111534 S C0CDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML 111535 "RTN","C0CNHIN",29,0) 111536 D DOMO^C0CDOM(C0CDOCID,"/","ZRTN","GIDX","GARY",,"/results/") ; BLD ARRAYS 111537 "RTN","C0CNHIN",30,0) 111538 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 111539 "RTN","C0CNHIN",31,0) 111540 ;D PROCESS("ZRTN",GN,"/result/",$G(KEEP)) 111541 "RTN","C0CNHIN",32,0) 111558 111542 Q 111559 "RTN","C0CNHIN",21,0) 111560 EN(ZRTN,ZDFN,ZPART,KEEP) ; GENERATE AN NHIN ARRAY FOR A PATIENT 111561 "RTN","C0CNHIN",22,0) 111562 ; 111563 "RTN","C0CNHIN",23,0) 111564 K GARY,GNARY,GIDX,C0CDOCID 111565 "RTN","C0CNHIN",24,0) 111543 "RTN","C0CNHIN",33,0) 111544 ; 111545 "RTN","C0CNHIN",34,0) 111546 PQRI(ZOUT,KEEP) ; RETURN THE NHIN ARRAY FOR THE PQRI XML TEMPLATE 111547 "RTN","C0CNHIN",35,0) 111548 ; 111549 "RTN","C0CNHIN",36,0) 111550 N ZG 111551 "RTN","C0CNHIN",37,0) 111552 S ZG=$NA(^TMP("PQRIXML",$J)) 111553 "RTN","C0CNHIN",38,0) 111554 K @ZG 111555 "RTN","C0CNHIN",39,0) 111556 D GETXML^C0CMXP(ZG,"PQRIXML") ; GET THE XML FROM C0C MISC XML 111557 "RTN","C0CNHIN",40,0) 111558 N C0CDOCID 111559 "RTN","C0CNHIN",41,0) 111560 S C0CDOCID=$$PARSE^C0CDOM(ZG,"PQRIXML") ; PARSE THE XML 111561 "RTN","C0CNHIN",42,0) 111562 D DOMO^C0CDOM(C0CDOCID,"/","ZOUT","GIDX","GARY",,"//submission") ; BLD ARRAYS 111563 "RTN","C0CNHIN",43,0) 111564 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 111565 "RTN","C0CNHIN",44,0) 111566 Q 111567 "RTN","C0CNHIN",45,0) 111568 ; 111569 "RTN","C0CNHIN",46,0) 111570 PQRI2(ZRTN) ; RETURN THE NHIN ARRAY FOR PQRI ONE MEASURE 111571 "RTN","C0CNHIN",47,0) 111572 ; 111573 "RTN","C0CNHIN",48,0) 111574 ;N GG 111575 "RTN","C0CNHIN",49,0) 111576 D GETXML^C0CMXP("GG","PQRI ONE MEASURE") 111577 "RTN","C0CNHIN",50,0) 111578 D PROCESS(ZRTN,"GG","root",1) 111579 "RTN","C0CNHIN",51,0) 111580 Q 111581 "RTN","C0CNHIN",52,0) 111582 ; 111583 "RTN","C0CNHIN",53,0) 111584 PROCESS(ZRSLT,ZXML,ZREDUCE,KEEP) ; PARSE AND RUN DOMO ON XML 111585 "RTN","C0CNHIN",54,0) 111586 ; ZRTN IS PASSED BY REFERENCE 111587 "RTN","C0CNHIN",55,0) 111588 ; ZXML IS PASSED BY NAME 111589 "RTN","C0CNHIN",56,0) 111590 ; IF KEEP IS 1, GARY AND GIDX ARE NOT KILLED 111591 "RTN","C0CNHIN",57,0) 111592 ; 111593 "RTN","C0CNHIN",58,0) 111566 111594 N GN 111567 "RTN","C0CNHIN",25,0) 111568 K ^TMP("NHINV",$J) ; CLEAN UP FROM LAST CALL 111569 "RTN","C0CNHIN",26,0) 111570 K ^TMP("MXMLDOM",$J) ; CLEAN UP DOM 111571 "RTN","C0CNHIN",27,0) 111572 K ^TMP("MXMLERR",$J) ; CLEAN UP MXML ERRORS 111573 "RTN","C0CNHIN",28,0) 111574 D GET^NHINV(.GN,ZDFN,ZPART) ; CALL NHINV ROUTINES TO PULL XML 111575 "RTN","C0CNHIN",29,0) 111576 S GN=$P(GN,")",1)_")" ; CUT OFF THE REST OF LINE PROTOCOL 111577 "RTN","C0CNHIN",30,0) 111595 "RTN","C0CNHIN",59,0) 111596 S GN=$NA(^TMP("C0CPROCESS",$J)) 111597 "RTN","C0CNHIN",60,0) 111598 K @GN 111599 "RTN","C0CNHIN",61,0) 111600 M @GN=@ZXML 111601 "RTN","C0CNHIN",62,0) 111578 111602 S C0CDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML 111579 "RTN","C0CNHIN",31,0) 111580 D DOMO^C0CDOM(C0CDOCID,"/","ZRTN","GIDX","GARY",,"/results/") ; BLD ARRAYS 111581 "RTN","C0CNHIN",32,0) 111603 "RTN","C0CNHIN",63,0) 111604 K @GN 111605 "RTN","C0CNHIN",64,0) 111606 D DOMO^C0CDOM(C0CDOCID,"/","ZRSLT","GIDX","GARY",,$G(ZREDUCE)) ; BLD ARRAYS 111607 "RTN","C0CNHIN",65,0) 111582 111608 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 111583 "RTN","C0CNHIN",33,0) 111584 ;D PROCESS("ZRTN",GN,"/result/",$G(KEEP)) 111585 "RTN","C0CNHIN",34,0) 111609 "RTN","C0CNHIN",66,0) 111586 111610 Q 111587 "RTN","C0CNHIN",35,0) 111588 ; 111589 "RTN","C0CNHIN",36,0) 111590 PQRI(ZOUT,KEEP) ; RETURN THE NHIN ARRAY FOR THE PQRI XML TEMPLATE 111591 "RTN","C0CNHIN",37,0) 111592 ; 111593 "RTN","C0CNHIN",38,0) 111594 N ZG 111595 "RTN","C0CNHIN",39,0) 111596 S ZG=$NA(^TMP("PQRIXML",$J)) 111597 "RTN","C0CNHIN",40,0) 111598 K @ZG 111599 "RTN","C0CNHIN",41,0) 111600 D GETXML^C0CMXP(ZG,"PQRIXML") ; GET THE XML FROM C0C MISC XML 111601 "RTN","C0CNHIN",42,0) 111602 N C0CDOCID 111603 "RTN","C0CNHIN",43,0) 111604 S C0CDOCID=$$PARSE^C0CDOM(ZG,"PQRIXML") ; PARSE THE XML 111605 "RTN","C0CNHIN",44,0) 111606 D DOMO^C0CDOM(C0CDOCID,"/","ZOUT","GIDX","GARY",,"//submission") ; BLD ARRAYS 111607 "RTN","C0CNHIN",45,0) 111608 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 111609 "RTN","C0CNHIN",46,0) 111611 "RTN","C0CNHIN",67,0) 111612 ; 111613 "RTN","C0CNHIN",68,0) 111614 LOADSMRT ; 111615 "RTN","C0CNHIN",69,0) 111616 ; 111617 "RTN","C0CNHIN",70,0) 111618 K ^GPL("SMART") 111619 "RTN","C0CNHIN",71,0) 111620 S GN=$NA(^GPL("SMART",1)) 111621 "RTN","C0CNHIN",72,0) 111622 I $$FTG^%ZISH("/home/george/","alex-lewis2.xml",GN,2) W !,"SMART FILE LOADED" 111623 "RTN","C0CNHIN",73,0) 111610 111624 Q 111611 "RTN","C0CNHIN",47,0) 111612 ; 111613 "RTN","C0CNHIN",48,0) 111614 PQRI2(ZRTN) ; RETURN THE NHIN ARRAY FOR PQRI ONE MEASURE 111615 "RTN","C0CNHIN",49,0) 111616 ; 111617 "RTN","C0CNHIN",50,0) 111618 ;N GG 111619 "RTN","C0CNHIN",51,0) 111620 D GETXML^C0CMXP("GG","PQRI ONE MEASURE") 111621 "RTN","C0CNHIN",52,0) 111622 D PROCESS(ZRTN,"GG","root",1) 111623 "RTN","C0CNHIN",53,0) 111625 "RTN","C0CNHIN",74,0) 111626 ; 111627 "RTN","C0CNHIN",75,0) 111628 SMART ; TRY IT WITH SMART 111629 "RTN","C0CNHIN",76,0) 111630 ; 111631 "RTN","C0CNHIN",77,0) 111632 S GN=$NA(^GPL("SMART")) 111633 "RTN","C0CNHIN",78,0) 111634 ;K ^TMP("MXMLDOM",$J) 111635 "RTN","C0CNHIN",79,0) 111636 K ^TMP("MXMLERR",$J) 111637 "RTN","C0CNHIN",80,0) 111638 S C0CDOCID=$$PARSE(GN,"SMART") 111639 "RTN","C0CNHIN",81,0) 111640 D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//rdf:RDF/") 111641 "RTN","C0CNHIN",82,0) 111642 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG 111643 "RTN","C0CNHIN",83,0) 111624 111644 Q 111625 "RTN","C0CNHIN",54,0) 111626 ; 111627 "RTN","C0CNHIN",55,0) 111628 PROCESS(ZRSLT,ZXML,ZREDUCE,KEEP) ; PARSE AND RUN DOMO ON XML 111629 "RTN","C0CNHIN",56,0) 111630 ; ZRTN IS PASSED BY REFERENCE 111631 "RTN","C0CNHIN",57,0) 111632 ; ZXML IS PASSED BY NAME 111633 "RTN","C0CNHIN",58,0) 111634 ; IF KEEP IS 1, GARY AND GIDX ARE NOT KILLED 111635 "RTN","C0CNHIN",59,0) 111636 ; 111637 "RTN","C0CNHIN",60,0) 111638 N GN 111639 "RTN","C0CNHIN",61,0) 111640 S GN=$NA(^TMP("C0CPROCESS",$J)) 111641 "RTN","C0CNHIN",62,0) 111642 K @GN 111643 "RTN","C0CNHIN",63,0) 111644 M @GN=@ZXML 111645 "RTN","C0CNHIN",64,0) 111646 S C0CDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML 111647 "RTN","C0CNHIN",65,0) 111648 K @GN 111649 "RTN","C0CNHIN",66,0) 111650 D DOMO^C0CDOM(C0CDOCID,"/","ZRSLT","GIDX","GARY",,$G(ZREDUCE)) ; BLD ARRAYS 111651 "RTN","C0CNHIN",67,0) 111652 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 111653 "RTN","C0CNHIN",68,0) 111645 "RTN","C0CNHIN",84,0) 111646 ; 111647 "RTN","C0CNHIN",85,0) 111648 CCR ; TRY IT WITH A CCR 111649 "RTN","C0CNHIN",86,0) 111650 ; 111651 "RTN","C0CNHIN",87,0) 111652 S GN=$NA(^GPL("CCR")) 111653 "RTN","C0CNHIN",88,0) 111654 ;K ^TMP("MXMLDOM",$J) 111655 "RTN","C0CNHIN",89,0) 111656 K ^TMP("MXMLERR",$J) 111657 "RTN","C0CNHIN",90,0) 111658 S C0CDOCID=$$PARSE(GN,"CCR") 111659 "RTN","C0CNHIN",91,0) 111660 D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//ContinuityOfCareRecord/Body/") 111661 "RTN","C0CNHIN",92,0) 111662 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG 111663 "RTN","C0CNHIN",93,0) 111654 111664 Q 111655 "RTN","C0CNHIN",69,0) 111656 ; 111657 "RTN","C0CNHIN",70,0) 111658 LOADSMRT ; 111659 "RTN","C0CNHIN",71,0) 111660 ; 111661 "RTN","C0CNHIN",72,0) 111662 K ^GPL("SMART") 111663 "RTN","C0CNHIN",73,0) 111664 S GN=$NA(^GPL("SMART",1)) 111665 "RTN","C0CNHIN",74,0) 111666 I $$FTG^%ZISH("/home/george/","alex-lewis2.xml",GN,2) W !,"SMART FILE LOADED" 111667 "RTN","C0CNHIN",75,0) 111665 "RTN","C0CNHIN",94,0) 111666 ; 111667 "RTN","C0CNHIN",95,0) 111668 MED ; TRY IT WITH A CCR MED SECTION 111669 "RTN","C0CNHIN",96,0) 111670 ; 111671 "RTN","C0CNHIN",97,0) 111672 S GN=$NA(^GPL("MED")) 111673 "RTN","C0CNHIN",98,0) 111674 K ^TMP("MXMLDOM",$J) 111675 "RTN","C0CNHIN",99,0) 111676 K ^TMP("MXMLERR",$J) 111677 "RTN","C0CNHIN",100,0) 111678 S C0CDOCID=$$PARSE(GN,"MED") 111679 "RTN","C0CNHIN",101,0) 111680 D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//Medications/") 111681 "RTN","C0CNHIN",102,0) 111682 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG 111683 "RTN","C0CNHIN",103,0) 111668 111684 Q 111669 "RTN","C0CNHIN", 76,0)111670 ; 111671 "RTN","C0CNHIN", 77,0)111672 SMART ; TRY IT WITH SMART 111673 "RTN","C0CNHIN", 78,0)111674 ; 111675 "RTN","C0CNHIN", 79,0)111676 S GN=$NA(^GPL(" SMART"))111677 "RTN","C0CNHIN", 80,0)111685 "RTN","C0CNHIN",104,0) 111686 ; 111687 "RTN","C0CNHIN",105,0) 111688 CCD ; TRY IT WITH A CCD 111689 "RTN","C0CNHIN",106,0) 111690 ; 111691 "RTN","C0CNHIN",107,0) 111692 S GN=$NA(^GPL("CCD")) 111693 "RTN","C0CNHIN",108,0) 111678 111694 ;K ^TMP("MXMLDOM",$J) 111679 "RTN","C0CNHIN", 81,0)111695 "RTN","C0CNHIN",109,0) 111680 111696 K ^TMP("MXMLERR",$J) 111681 "RTN","C0CNHIN", 82,0)111682 S C0CDOCID=$$PARSE(GN," SMART")111683 "RTN","C0CNHIN", 83,0)111684 D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"// rdf:RDF/")111685 "RTN","C0CNHIN", 84,0)111697 "RTN","C0CNHIN",110,0) 111698 S C0CDOCID=$$PARSE(GN,"CCD") 111699 "RTN","C0CNHIN",111,0) 111700 D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//ClinicalDocument/component/structuredBody/") 111701 "RTN","C0CNHIN",112,0) 111686 111702 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG 111687 "RTN","C0CNHIN", 85,0)111703 "RTN","C0CNHIN",113,0) 111688 111704 Q 111689 "RTN","C0CNHIN",86,0) 111690 ; 111691 "RTN","C0CNHIN",87,0) 111692 CCR ; TRY IT WITH A CCR 111693 "RTN","C0CNHIN",88,0) 111694 ; 111695 "RTN","C0CNHIN",89,0) 111696 S GN=$NA(^GPL("CCR")) 111697 "RTN","C0CNHIN",90,0) 111698 ;K ^TMP("MXMLDOM",$J) 111699 "RTN","C0CNHIN",91,0) 111700 K ^TMP("MXMLERR",$J) 111701 "RTN","C0CNHIN",92,0) 111702 S C0CDOCID=$$PARSE(GN,"CCR") 111703 "RTN","C0CNHIN",93,0) 111704 D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//ContinuityOfCareRecord/Body/") 111705 "RTN","C0CNHIN",94,0) 111706 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG 111707 "RTN","C0CNHIN",95,0) 111705 "RTN","C0CNHIN",114,0) 111706 ; 111707 "RTN","C0CNHIN",115,0) 111708 TEST1 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") 111709 "RTN","C0CNHIN",116,0) 111710 ; PARSED WITH MXML 111711 "RTN","C0CNHIN",117,0) 111712 ; RUN THROUGH XPATH 111713 "RTN","C0CNHIN",118,0) 111714 K GARY,GIDX,C0CDOCID 111715 "RTN","C0CNHIN",119,0) 111716 S GN=$NA(^GPL("NHIN")) 111717 "RTN","C0CNHIN",120,0) 111718 ;S GN=$NA(^GPL("DOMI")) 111719 "RTN","C0CNHIN",121,0) 111720 S C0CDOCID=$$PARSE(GN,"GPLTEST") 111721 "RTN","C0CNHIN",122,0) 111722 D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"/results/") 111723 "RTN","C0CNHIN",123,0) 111724 K ^GPL("GNARY") 111725 "RTN","C0CNHIN",124,0) 111726 M ^GPL("GNARY")=GNARY 111727 "RTN","C0CNHIN",125,0) 111708 111728 Q 111709 "RTN","C0CNHIN",96,0) 111710 ; 111711 "RTN","C0CNHIN",97,0) 111712 MED ; TRY IT WITH A CCR MED SECTION 111713 "RTN","C0CNHIN",98,0) 111714 ; 111715 "RTN","C0CNHIN",99,0) 111716 S GN=$NA(^GPL("MED")) 111717 "RTN","C0CNHIN",100,0) 111718 K ^TMP("MXMLDOM",$J) 111719 "RTN","C0CNHIN",101,0) 111720 K ^TMP("MXMLERR",$J) 111721 "RTN","C0CNHIN",102,0) 111722 S C0CDOCID=$$PARSE(GN,"MED") 111723 "RTN","C0CNHIN",103,0) 111724 D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//Medications/") 111725 "RTN","C0CNHIN",104,0) 111726 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG 111727 "RTN","C0CNHIN",105,0) 111729 "RTN","C0CNHIN",126,0) 111730 ; 111731 "RTN","C0CNHIN",127,0) 111732 TEST2 ; PUT GNARY THROUGH DOMI AND STORE XML IN ^GPL("DOMI") 111733 "RTN","C0CNHIN",128,0) 111734 ; 111735 "RTN","C0CNHIN",129,0) 111736 S GN=$NA(^GPL("GNARY")) 111737 "RTN","C0CNHIN",130,0) 111738 S C0CDOCID=$$DOMI^C0CDOM(GN,,"results") 111739 "RTN","C0CNHIN",131,0) 111740 D OUTXML^C0CDOM("G",C0CDOCID) 111741 "RTN","C0CNHIN",132,0) 111742 K ^GPL("DOMI") 111743 "RTN","C0CNHIN",133,0) 111744 M ^GPL("DOMI")=G 111745 "RTN","C0CNHIN",134,0) 111728 111746 Q 111729 "RTN","C0CNHIN",1 06,0)111730 ; 111731 "RTN","C0CNHIN",1 07,0)111732 CCD ; TRY IT WITH A CCD 111733 "RTN","C0CNHIN",1 08,0)111734 ; 111735 "RTN","C0CNHIN",1 09,0)111736 S GN=$NA(^GPL("CCD"))111737 "RTN","C0CNHIN",1 10,0)111738 ;K ^TMP("MXMLDOM",$J)111739 "RTN","C0CNHIN",1 11,0)111740 K ^TMP("MXMLERR",$J)111741 "RTN","C0CNHIN",1 12,0)111742 S C0CDOCID=$$PARSE(GN,"CCD")111743 "RTN","C0CNHIN",1 13,0)111744 D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//ClinicalDocument/component/structuredBody/")111745 "RTN","C0CNHIN",1 14,0)111746 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG111747 "RTN","C0CNHIN",1 15,0)111747 "RTN","C0CNHIN",135,0) 111748 ; 111749 "RTN","C0CNHIN",136,0) 111750 TEST3 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") 111751 "RTN","C0CNHIN",137,0) 111752 ; PARSED WITH MXML 111753 "RTN","C0CNHIN",138,0) 111754 ; RUN THROUGH XPATH 111755 "RTN","C0CNHIN",139,0) 111756 K GARY,GIDX,C0CDOCID 111757 "RTN","C0CNHIN",140,0) 111758 ;S GN=$NA(^GPL("NHIN")) 111759 "RTN","C0CNHIN",141,0) 111760 S GN=$NA(^GPL("DOMI")) 111761 "RTN","C0CNHIN",142,0) 111762 S C0CDOCID=$$PARSE(GN,"GPLTEST") 111763 "RTN","C0CNHIN",143,0) 111764 D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"/results/") 111765 "RTN","C0CNHIN",144,0) 111748 111766 Q 111749 "RTN","C0CNHIN",116,0) 111750 ; 111751 "RTN","C0CNHIN",117,0) 111752 TEST1 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") 111753 "RTN","C0CNHIN",118,0) 111754 ; PARSED WITH MXML 111755 "RTN","C0CNHIN",119,0) 111756 ; RUN THROUGH XPATH 111757 "RTN","C0CNHIN",120,0) 111758 K GARY,GIDX,C0CDOCID 111759 "RTN","C0CNHIN",121,0) 111760 S GN=$NA(^GPL("NHIN")) 111761 "RTN","C0CNHIN",122,0) 111762 ;S GN=$NA(^GPL("DOMI")) 111763 "RTN","C0CNHIN",123,0) 111764 S C0CDOCID=$$PARSE(GN,"GPLTEST") 111765 "RTN","C0CNHIN",124,0) 111766 D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"/results/") 111767 "RTN","C0CNHIN",125,0) 111768 K ^GPL("GNARY") 111769 "RTN","C0CNHIN",126,0) 111770 M ^GPL("GNARY")=GNARY 111771 "RTN","C0CNHIN",127,0) 111767 "RTN","C0CNHIN",145,0) 111768 ; 111769 "RTN","C0CNHIN",146,0) 111770 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE 111771 "RTN","C0CNHIN",147,0) 111772 ; THE XPATH INDEX ZXIDX, PASSED BY NAME 111773 "RTN","C0CNHIN",148,0) 111774 ; THE XPATH ARRAY XPARY, PASSED BY NAME 111775 "RTN","C0CNHIN",149,0) 111776 ; ZOID IS THE STARTING OID 111777 "RTN","C0CNHIN",150,0) 111778 ; ZPATH IS THE STARTING XPATH, USUALLY "/" 111779 "RTN","C0CNHIN",151,0) 111780 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE 111781 "RTN","C0CNHIN",152,0) 111782 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT 111783 "RTN","C0CNHIN",153,0) 111784 I $G(ZREDUX)="" S ZREDUX="" 111785 "RTN","C0CNHIN",154,0) 111786 N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY 111787 "RTN","C0CNHIN",155,0) 111788 N NEWNUM S NEWNUM="" 111789 "RTN","C0CNHIN",156,0) 111790 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" 111791 "RTN","C0CNHIN",157,0) 111792 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE 111793 "RTN","C0CNHIN",158,0) 111794 I $G(ZREDUX)'="" D ; REDUX PROVIDED? 111795 "RTN","C0CNHIN",159,0) 111796 . N GT S GT=$P(NEWPATH,ZREDUX,2) 111797 "RTN","C0CNHIN",160,0) 111798 . I GT'="" S NEWPATH=GT 111799 "RTN","C0CNHIN",161,0) 111800 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX 111801 "RTN","C0CNHIN",162,0) 111802 N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE 111803 "RTN","C0CNHIN",163,0) 111804 I $D(GA) D ; PROCESS THE ATTRIBUTES 111805 "RTN","C0CNHIN",164,0) 111806 . N ZI S ZI="" 111807 "RTN","C0CNHIN",165,0) 111808 . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE 111809 "RTN","C0CNHIN",166,0) 111810 . . N ZP S ZP=NEWPATH_"/"_ZI ; PATH FOR ATTRIBUTE 111811 "RTN","C0CNHIN",167,0) 111812 . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY 111813 "RTN","C0CNHIN",168,0) 111814 . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE 111815 "RTN","C0CNHIN",169,0) 111816 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE 111817 "RTN","C0CNHIN",170,0) 111818 I $D(GD(2)) D ; 111819 "RTN","C0CNHIN",171,0) 111820 . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY 111821 "RTN","C0CNHIN",172,0) 111822 E I $D(GD(1)) D ; 111823 "RTN","C0CNHIN",173,0) 111824 . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY 111825 "RTN","C0CNHIN",174,0) 111826 . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY 111827 "RTN","C0CNHIN",175,0) 111828 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD 111829 "RTN","C0CNHIN",176,0) 111830 I ZFRST'=0 D ; THERE IS A CHILD 111831 "RTN","C0CNHIN",177,0) 111832 . N ZNUM 111833 "RTN","C0CNHIN",178,0) 111834 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE 111835 "RTN","C0CNHIN",179,0) 111836 . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD 111837 "RTN","C0CNHIN",180,0) 111838 N GNXT S GNXT=$$NXTSIB(ZOID) 111839 "RTN","C0CNHIN",181,0) 111840 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES 111841 "RTN","C0CNHIN",182,0) 111842 I GNXT'=0 D ; 111843 "RTN","C0CNHIN",183,0) 111844 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? 111845 "RTN","C0CNHIN",184,0) 111846 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES 111847 "RTN","C0CNHIN",185,0) 111848 . . N ZNUM S ZNUM=1 ; 111849 "RTN","C0CNHIN",186,0) 111850 . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB 111851 "RTN","C0CNHIN",187,0) 111852 . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB 111853 "RTN","C0CNHIN",188,0) 111772 111854 Q 111773 "RTN","C0CNHIN",128,0) 111774 ; 111775 "RTN","C0CNHIN",129,0) 111776 TEST2 ; PUT GNARY THROUGH DOMI AND STORE XML IN ^GPL("DOMI") 111777 "RTN","C0CNHIN",130,0) 111778 ; 111779 "RTN","C0CNHIN",131,0) 111780 S GN=$NA(^GPL("GNARY")) 111781 "RTN","C0CNHIN",132,0) 111782 S C0CDOCID=$$DOMI^C0CDOM(GN,,"results") 111783 "RTN","C0CNHIN",133,0) 111784 D OUTXML^C0CDOM("G",C0CDOCID) 111785 "RTN","C0CNHIN",134,0) 111786 K ^GPL("DOMI") 111787 "RTN","C0CNHIN",135,0) 111788 M ^GPL("DOMI")=G 111789 "RTN","C0CNHIN",136,0) 111855 "RTN","C0CNHIN",189,0) 111856 ; 111857 "RTN","C0CNHIN",190,0) 111858 ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY 111859 "RTN","C0CNHIN",191,0) 111860 ; 111861 "RTN","C0CNHIN",192,0) 111862 N ZZI,ZZJ,ZZN 111863 "RTN","C0CNHIN",193,0) 111864 S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY 111865 "RTN","C0CNHIN",194,0) 111866 I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE 111867 "RTN","C0CNHIN",195,0) 111868 S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY 111869 "RTN","C0CNHIN",196,0) 111870 S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH . 111871 "RTN","C0CNHIN",197,0) 111872 I ZZI'["]" D ; A SINGLETON 111873 "RTN","C0CNHIN",198,0) 111874 . S ZZN=1 111875 "RTN","C0CNHIN",199,0) 111876 E D ; THERE IS AN [x] OCCURANCE 111877 "RTN","C0CNHIN",200,0) 111878 . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE 111879 "RTN","C0CNHIN",201,0) 111880 . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X] 111881 "RTN","C0CNHIN",202,0) 111882 I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE 111883 "RTN","C0CNHIN",203,0) 111790 111884 Q 111791 "RTN","C0CNHIN",137,0) 111792 ; 111793 "RTN","C0CNHIN",138,0) 111794 TEST3 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") 111795 "RTN","C0CNHIN",139,0) 111796 ; PARSED WITH MXML 111797 "RTN","C0CNHIN",140,0) 111798 ; RUN THROUGH XPATH 111799 "RTN","C0CNHIN",141,0) 111800 K GARY,GIDX,C0CDOCID 111801 "RTN","C0CNHIN",142,0) 111802 ;S GN=$NA(^GPL("NHIN")) 111803 "RTN","C0CNHIN",143,0) 111804 S GN=$NA(^GPL("DOMI")) 111805 "RTN","C0CNHIN",144,0) 111806 S C0CDOCID=$$PARSE(GN,"GPLTEST") 111807 "RTN","C0CNHIN",145,0) 111808 D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"/results/") 111809 "RTN","C0CNHIN",146,0) 111885 "RTN","C0CNHIN",204,0) 111886 ; 111887 "RTN","C0CNHIN",205,0) 111888 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME 111889 "RTN","C0CNHIN",206,0) 111890 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW 111891 "RTN","C0CNHIN",207,0) 111892 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML 111893 "RTN","C0CNHIN",208,0) 111894 ;Q $$EN^MXMLDOM(INXML) 111895 "RTN","C0CNHIN",209,0) 111896 Q $$EN^MXMLDOM(INXML,"W") 111897 "RTN","C0CNHIN",210,0) 111898 ; 111899 "RTN","C0CNHIN",211,0) 111900 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE 111901 "RTN","C0CNHIN",212,0) 111902 N ZN 111903 "RTN","C0CNHIN",213,0) 111904 ;I $$TAG(ZOID)["entry" B 111905 "RTN","C0CNHIN",214,0) 111906 S ZN=$$NXTSIB(ZOID) 111907 "RTN","C0CNHIN",215,0) 111908 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG 111909 "RTN","C0CNHIN",216,0) 111910 Q 0 111911 "RTN","C0CNHIN",217,0) 111912 ; 111913 "RTN","C0CNHIN",218,0) 111914 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID 111915 "RTN","C0CNHIN",219,0) 111916 Q $$CHILD^MXMLDOM(C0CDOCID,ZOID) 111917 "RTN","C0CNHIN",220,0) 111918 ; 111919 "RTN","C0CNHIN",221,0) 111920 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID 111921 "RTN","C0CNHIN",222,0) 111922 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID) 111923 "RTN","C0CNHIN",223,0) 111924 ; 111925 "RTN","C0CNHIN",224,0) 111926 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID 111927 "RTN","C0CNHIN",225,0) 111928 S HANDLE=C0CDOCID 111929 "RTN","C0CNHIN",226,0) 111930 K @RTN 111931 "RTN","C0CNHIN",227,0) 111932 D GETTXT^MXMLDOM("A") 111933 "RTN","C0CNHIN",228,0) 111810 111934 Q 111811 "RTN","C0CNHIN",147,0) 111812 ; 111813 "RTN","C0CNHIN",148,0) 111814 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE 111815 "RTN","C0CNHIN",149,0) 111816 ; THE XPATH INDEX ZXIDX, PASSED BY NAME 111817 "RTN","C0CNHIN",150,0) 111818 ; THE XPATH ARRAY XPARY, PASSED BY NAME 111819 "RTN","C0CNHIN",151,0) 111820 ; ZOID IS THE STARTING OID 111821 "RTN","C0CNHIN",152,0) 111822 ; ZPATH IS THE STARTING XPATH, USUALLY "/" 111823 "RTN","C0CNHIN",153,0) 111824 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE 111825 "RTN","C0CNHIN",154,0) 111826 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT 111827 "RTN","C0CNHIN",155,0) 111828 I $G(ZREDUX)="" S ZREDUX="" 111829 "RTN","C0CNHIN",156,0) 111830 N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY 111831 "RTN","C0CNHIN",157,0) 111832 N NEWNUM S NEWNUM="" 111833 "RTN","C0CNHIN",158,0) 111834 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" 111835 "RTN","C0CNHIN",159,0) 111836 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE 111837 "RTN","C0CNHIN",160,0) 111838 I $G(ZREDUX)'="" D ; REDUX PROVIDED? 111839 "RTN","C0CNHIN",161,0) 111840 . N GT S GT=$P(NEWPATH,ZREDUX,2) 111841 "RTN","C0CNHIN",162,0) 111842 . I GT'="" S NEWPATH=GT 111843 "RTN","C0CNHIN",163,0) 111844 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX 111845 "RTN","C0CNHIN",164,0) 111846 N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE 111847 "RTN","C0CNHIN",165,0) 111848 I $D(GA) D ; PROCESS THE ATTRIBUTES 111849 "RTN","C0CNHIN",166,0) 111850 . N ZI S ZI="" 111851 "RTN","C0CNHIN",167,0) 111852 . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE 111853 "RTN","C0CNHIN",168,0) 111854 . . N ZP S ZP=NEWPATH_"/"_ZI ; PATH FOR ATTRIBUTE 111855 "RTN","C0CNHIN",169,0) 111856 . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY 111857 "RTN","C0CNHIN",170,0) 111858 . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE 111859 "RTN","C0CNHIN",171,0) 111860 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE 111861 "RTN","C0CNHIN",172,0) 111862 I $D(GD(2)) D ; 111863 "RTN","C0CNHIN",173,0) 111864 . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY 111865 "RTN","C0CNHIN",174,0) 111866 E I $D(GD(1)) D ; 111867 "RTN","C0CNHIN",175,0) 111868 . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY 111869 "RTN","C0CNHIN",176,0) 111870 . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY 111871 "RTN","C0CNHIN",177,0) 111872 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD 111873 "RTN","C0CNHIN",178,0) 111874 I ZFRST'=0 D ; THERE IS A CHILD 111875 "RTN","C0CNHIN",179,0) 111876 . N ZNUM 111877 "RTN","C0CNHIN",180,0) 111878 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE 111879 "RTN","C0CNHIN",181,0) 111880 . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD 111881 "RTN","C0CNHIN",182,0) 111882 N GNXT S GNXT=$$NXTSIB(ZOID) 111883 "RTN","C0CNHIN",183,0) 111884 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES 111885 "RTN","C0CNHIN",184,0) 111886 I GNXT'=0 D ; 111887 "RTN","C0CNHIN",185,0) 111888 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? 111889 "RTN","C0CNHIN",186,0) 111890 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES 111891 "RTN","C0CNHIN",187,0) 111892 . . N ZNUM S ZNUM=1 ; 111893 "RTN","C0CNHIN",188,0) 111894 . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB 111895 "RTN","C0CNHIN",189,0) 111896 . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB 111897 "RTN","C0CNHIN",190,0) 111935 "RTN","C0CNHIN",229,0) 111936 ; 111937 "RTN","C0CNHIN",230,0) 111938 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE 111939 "RTN","C0CNHIN",231,0) 111940 ;I ZOID=149 B ;GPLTEST 111941 "RTN","C0CNHIN",232,0) 111942 N X,Y 111943 "RTN","C0CNHIN",233,0) 111944 S Y="" 111945 "RTN","C0CNHIN",234,0) 111946 S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE 111947 "RTN","C0CNHIN",235,0) 111948 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y 111949 "RTN","C0CNHIN",236,0) 111950 I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID) 111951 "RTN","C0CNHIN",237,0) 111952 Q Y 111953 "RTN","C0CNHIN",238,0) 111954 ; 111955 "RTN","C0CNHIN",239,0) 111956 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING 111957 "RTN","C0CNHIN",240,0) 111958 Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID) 111959 "RTN","C0CNHIN",241,0) 111960 ; 111961 "RTN","C0CNHIN",242,0) 111962 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE 111963 "RTN","C0CNHIN",243,0) 111964 ;N ZT,ZN S ZT="" 111965 "RTN","C0CNHIN",244,0) 111966 ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 111967 "RTN","C0CNHIN",245,0) 111968 ;Q $G(@C0CDOM@(ZOID,"T",1)) 111969 "RTN","C0CNHIN",246,0) 111970 S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT) 111971 "RTN","C0CNHIN",247,0) 111898 111972 Q 111899 "RTN","C0CNHIN",191,0) 111900 ; 111901 "RTN","C0CNHIN",192,0) 111902 ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY 111903 "RTN","C0CNHIN",193,0) 111904 ; 111905 "RTN","C0CNHIN",194,0) 111906 N ZZI,ZZJ,ZZN 111907 "RTN","C0CNHIN",195,0) 111908 S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY 111909 "RTN","C0CNHIN",196,0) 111910 I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE 111911 "RTN","C0CNHIN",197,0) 111912 S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY 111913 "RTN","C0CNHIN",198,0) 111914 S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH . 111915 "RTN","C0CNHIN",199,0) 111916 I ZZI'["]" D ; A SINGLETON 111917 "RTN","C0CNHIN",200,0) 111918 . S ZZN=1 111919 "RTN","C0CNHIN",201,0) 111920 E D ; THERE IS AN [x] OCCURANCE 111921 "RTN","C0CNHIN",202,0) 111922 . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE 111923 "RTN","C0CNHIN",203,0) 111924 . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X] 111925 "RTN","C0CNHIN",204,0) 111926 I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE 111927 "RTN","C0CNHIN",205,0) 111973 "RTN","C0CNHIN",248,0) 111974 ; 111975 "RTN","C0CNHIN",249,0) 111976 OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM 111977 "RTN","C0CNHIN",250,0) 111978 ; 111979 "RTN","C0CNHIN",251,0) 111980 S C0CDOCID=INID 111981 "RTN","C0CNHIN",252,0) 111982 D START^C0CMXMLB($$TAG(1),,"G") 111983 "RTN","C0CNHIN",253,0) 111984 D NDOUT($$FIRST(1)) 111985 "RTN","C0CNHIN",254,0) 111986 D END^C0CMXMLB ;END THE DOCUMENT 111987 "RTN","C0CNHIN",255,0) 111988 M @ZRTN=^TMP("MXMLBLD",$J) 111989 "RTN","C0CNHIN",256,0) 111990 K ^TMP("MXMLBLD",$J) 111991 "RTN","C0CNHIN",257,0) 111928 111992 Q 111929 "RTN","C0CNHIN",206,0) 111930 ; 111931 "RTN","C0CNHIN",207,0) 111932 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME 111933 "RTN","C0CNHIN",208,0) 111934 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW 111935 "RTN","C0CNHIN",209,0) 111936 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML 111937 "RTN","C0CNHIN",210,0) 111938 ;Q $$EN^MXMLDOM(INXML) 111939 "RTN","C0CNHIN",211,0) 111940 Q $$EN^MXMLDOM(INXML,"W") 111941 "RTN","C0CNHIN",212,0) 111942 ; 111943 "RTN","C0CNHIN",213,0) 111944 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE 111945 "RTN","C0CNHIN",214,0) 111946 N ZN 111947 "RTN","C0CNHIN",215,0) 111948 ;I $$TAG(ZOID)["entry" B 111949 "RTN","C0CNHIN",216,0) 111950 S ZN=$$NXTSIB(ZOID) 111951 "RTN","C0CNHIN",217,0) 111952 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG 111953 "RTN","C0CNHIN",218,0) 111954 Q 0 111955 "RTN","C0CNHIN",219,0) 111956 ; 111957 "RTN","C0CNHIN",220,0) 111958 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID 111959 "RTN","C0CNHIN",221,0) 111960 Q $$CHILD^MXMLDOM(C0CDOCID,ZOID) 111961 "RTN","C0CNHIN",222,0) 111962 ; 111963 "RTN","C0CNHIN",223,0) 111964 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID 111965 "RTN","C0CNHIN",224,0) 111966 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID) 111967 "RTN","C0CNHIN",225,0) 111968 ; 111969 "RTN","C0CNHIN",226,0) 111970 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID 111971 "RTN","C0CNHIN",227,0) 111972 S HANDLE=C0CDOCID 111973 "RTN","C0CNHIN",228,0) 111974 K @RTN 111975 "RTN","C0CNHIN",229,0) 111976 D GETTXT^MXMLDOM("A") 111977 "RTN","C0CNHIN",230,0) 111993 "RTN","C0CNHIN",258,0) 111994 ; 111995 "RTN","C0CNHIN",259,0) 111996 NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE 111997 "RTN","C0CNHIN",260,0) 111998 N ZI S ZI=$$FIRST(ZOID) 111999 "RTN","C0CNHIN",261,0) 112000 I ZI'=0 D ; THERE IS A CHILD 112001 "RTN","C0CNHIN",262,0) 112002 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT 112003 "RTN","C0CNHIN",263,0) 112004 . D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN 112005 "RTN","C0CNHIN",264,0) 112006 E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT 112007 "RTN","C0CNHIN",265,0) 112008 . ;W "DOING",ZOID,! 112009 "RTN","C0CNHIN",266,0) 112010 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA 112011 "RTN","C0CNHIN",267,0) 112012 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES 112013 "RTN","C0CNHIN",268,0) 112014 . D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN 112015 "RTN","C0CNHIN",269,0) 112016 I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING 112017 "RTN","C0CNHIN",270,0) 112018 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS 112019 "RTN","C0CNHIN",271,0) 111978 112020 Q 111979 "RTN","C0CNHIN",231,0) 111980 ; 111981 "RTN","C0CNHIN",232,0) 111982 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE 111983 "RTN","C0CNHIN",233,0) 111984 ;I ZOID=149 B ;GPLTEST 111985 "RTN","C0CNHIN",234,0) 111986 N X,Y 111987 "RTN","C0CNHIN",235,0) 111988 S Y="" 111989 "RTN","C0CNHIN",236,0) 111990 S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE 111991 "RTN","C0CNHIN",237,0) 111992 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y 111993 "RTN","C0CNHIN",238,0) 111994 I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID) 111995 "RTN","C0CNHIN",239,0) 111996 Q Y 111997 "RTN","C0CNHIN",240,0) 111998 ; 111999 "RTN","C0CNHIN",241,0) 112000 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING 112001 "RTN","C0CNHIN",242,0) 112002 Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID) 112003 "RTN","C0CNHIN",243,0) 112004 ; 112005 "RTN","C0CNHIN",244,0) 112006 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE 112007 "RTN","C0CNHIN",245,0) 112008 ;N ZT,ZN S ZT="" 112009 "RTN","C0CNHIN",246,0) 112010 ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 112011 "RTN","C0CNHIN",247,0) 112012 ;Q $G(@C0CDOM@(ZOID,"T",1)) 112013 "RTN","C0CNHIN",248,0) 112014 S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT) 112015 "RTN","C0CNHIN",249,0) 112021 "RTN","C0CNHIN",272,0) 112022 ; 112023 "RTN","C0CNHIN",273,0) 112024 WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE 112025 "RTN","C0CNHIN",274,0) 112026 ; 112027 "RTN","C0CNHIN",275,0) 112028 N GN,GN2 112029 "RTN","C0CNHIN",276,0) 112030 D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML 112031 "RTN","C0CNHIN",277,0) 112032 S GN2=$NA(@GN@(1)) 112033 "RTN","C0CNHIN",278,0) 112034 W $$OUTPUT^C0CXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/") 112035 "RTN","C0CNHIN",279,0) 112016 112036 Q 112017 "RTN","C0CNHIN",250,0) 112018 ; 112019 "RTN","C0CNHIN",251,0) 112020 OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM 112021 "RTN","C0CNHIN",252,0) 112022 ; 112023 "RTN","C0CNHIN",253,0) 112024 S C0CDOCID=INID 112025 "RTN","C0CNHIN",254,0) 112026 D START^C0CMXMLB($$TAG(1),,"G") 112027 "RTN","C0CNHIN",255,0) 112028 D NDOUT($$FIRST(1)) 112029 "RTN","C0CNHIN",256,0) 112030 D END^C0CMXMLB ;END THE DOCUMENT 112031 "RTN","C0CNHIN",257,0) 112032 M @ZRTN=^TMP("MXMLBLD",$J) 112033 "RTN","C0CNHIN",258,0) 112034 K ^TMP("MXMLBLD",$J) 112035 "RTN","C0CNHIN",259,0) 112037 "RTN","C0CNHIN",280,0) 112038 ; 112039 "RTN","C0CNHIN",281,0) 112040 TESTNARY ; TEST MAKING A NHIN ARRAY 112041 "RTN","C0CNHIN",282,0) 112042 N ZI S ZI="" 112043 "RTN","C0CNHIN",283,0) 112044 N ZH ; DOM HANDLE 112045 "RTN","C0CNHIN",284,0) 112046 D TEST1 ; PARSE AN NHIN RESULT INTO THE DOM 112047 "RTN","C0CNHIN",285,0) 112048 S ZH=C0CDOCID ; SET THE HANDLE 112049 "RTN","C0CNHIN",286,0) 112050 N ZD S ZD=$NA(^TMP("MXMLDOM",$J,ZH)) 112051 "RTN","C0CNHIN",287,0) 112052 F S ZI=$O(@ZD@(ZI)) Q:ZI="" D ; FOR EACH NODE 112053 "RTN","C0CNHIN",288,0) 112054 . N ZATT 112055 "RTN","C0CNHIN",289,0) 112056 . D MNARY(.ZATT,ZH,ZI) 112057 "RTN","C0CNHIN",290,0) 112058 . N ZPRE,ZN 112059 "RTN","C0CNHIN",291,0) 112060 . S ZPRE=$$PRE(ZI) 112061 "RTN","C0CNHIN",292,0) 112062 . S ZN=$P(ZPRE,",",2) 112063 "RTN","C0CNHIN",293,0) 112064 . S ZPRE=$P(ZPRE,",",1) 112065 "RTN","C0CNHIN",294,0) 112066 . ;I $D(ZATT) ZWR ZATT 112067 "RTN","C0CNHIN",295,0) 112068 . N ZJ S ZJ="" 112069 "RTN","C0CNHIN",296,0) 112070 . F S ZJ=$O(ZATT(ZJ)) Q:ZJ="" D ; FOR EACH ATTRIBUTE 112071 "RTN","C0CNHIN",297,0) 112072 . . W ZPRE_"["_ZN_"]"_$$TAG(ZI)_"."_ZJ_"="_ZATT(ZJ),! 112073 "RTN","C0CNHIN",298,0) 112074 . . S GOUT(ZPRE,ZN,$$TAG(ZI)_"."_ZJ)=ZATT(ZJ) 112075 "RTN","C0CNHIN",299,0) 112036 112076 Q 112037 "RTN","C0CNHIN",260,0) 112038 ; 112039 "RTN","C0CNHIN",261,0) 112040 NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE 112041 "RTN","C0CNHIN",262,0) 112042 N ZI S ZI=$$FIRST(ZOID) 112043 "RTN","C0CNHIN",263,0) 112044 I ZI'=0 D ; THERE IS A CHILD 112045 "RTN","C0CNHIN",264,0) 112046 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT 112047 "RTN","C0CNHIN",265,0) 112048 . D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN 112049 "RTN","C0CNHIN",266,0) 112050 E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT 112051 "RTN","C0CNHIN",267,0) 112052 . ;W "DOING",ZOID,! 112053 "RTN","C0CNHIN",268,0) 112054 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA 112055 "RTN","C0CNHIN",269,0) 112056 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES 112057 "RTN","C0CNHIN",270,0) 112058 . D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN 112059 "RTN","C0CNHIN",271,0) 112060 I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING 112061 "RTN","C0CNHIN",272,0) 112062 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS 112063 "RTN","C0CNHIN",273,0) 112077 "RTN","C0CNHIN",300,0) 112078 ; 112079 "RTN","C0CNHIN",301,0) 112080 PRE(ZNODE) ; EXTRINSIC WHICH RETURNS THE PREFIX FOR A NODE 112081 "RTN","C0CNHIN",302,0) 112082 ; 112083 "RTN","C0CNHIN",303,0) 112084 N GI,GI2,GPT,GJ,GN 112085 "RTN","C0CNHIN",304,0) 112086 S GI=$$PARENT(ZNODE) ; PARENT NODE 112087 "RTN","C0CNHIN",305,0) 112088 I GI=0 Q "" ; NO PARENT 112089 "RTN","C0CNHIN",306,0) 112090 S GPT=$$TAG(GI) ; TAG OF PARENT 112091 "RTN","C0CNHIN",307,0) 112092 S GI2=$$PARENT(GI) ; PARENT OF PARENT 112093 "RTN","C0CNHIN",308,0) 112094 I (GI2'=0)&($$TAG(GI2)'="results") S GPT=$$TAG(GI2)_"."_GPT 112095 "RTN","C0CNHIN",309,0) 112096 S GJ=$$FIRST(GI) ; NODE OF FIRST SIB 112097 "RTN","C0CNHIN",310,0) 112098 I GJ=ZNODE Q:$$TAG(GI)_",1" 112099 "RTN","C0CNHIN",311,0) 112100 F GN=2:1 Q:GJ=ZNODE D ; 112101 "RTN","C0CNHIN",312,0) 112102 . S GJ=$$NXTSIB(GJ) ; NEXT SIBLING 112103 "RTN","C0CNHIN",313,0) 112104 Q GPT_","_GN 112105 "RTN","C0CNHIN",314,0) 112106 ; 112107 "RTN","C0CNHIN",315,0) 112108 MNARY(ZRTN,ZHANDLE,ZOID) ; MAKE A NHIN ARRAY FROM A DOM NODE 112109 "RTN","C0CNHIN",316,0) 112110 ; RETURNED IN ZRTN, PASSED BY REFERENCE 112111 "RTN","C0CNHIN",317,0) 112112 ; ZHANDLE IS THE DOM DOCUMENT ID 112113 "RTN","C0CNHIN",318,0) 112114 ; ZOID IS THE DOM NODE 112115 "RTN","C0CNHIN",319,0) 112116 D ATT("ZRTN",ZOID) 112117 "RTN","C0CNHIN",320,0) 112064 112118 Q 112065 "RTN","C0CNHIN",274,0)112066 ;112067 "RTN","C0CNHIN",275,0)112068 WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE112069 "RTN","C0CNHIN",276,0)112070 ;112071 "RTN","C0CNHIN",277,0)112072 N GN,GN2112073 "RTN","C0CNHIN",278,0)112074 D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML112075 "RTN","C0CNHIN",279,0)112076 S GN2=$NA(@GN@(1))112077 "RTN","C0CNHIN",280,0)112078 W $$OUTPUT^C0CXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")112079 "RTN","C0CNHIN",281,0)112080 Q112081 "RTN","C0CNHIN",282,0)112082 ;112083 "RTN","C0CNHIN",283,0)112084 TESTNARY ; TEST MAKING A NHIN ARRAY112085 "RTN","C0CNHIN",284,0)112086 N ZI S ZI=""112087 "RTN","C0CNHIN",285,0)112088 N ZH ; DOM HANDLE112089 "RTN","C0CNHIN",286,0)112090 D TEST1 ; PARSE AN NHIN RESULT INTO THE DOM112091 "RTN","C0CNHIN",287,0)112092 S ZH=C0CDOCID ; SET THE HANDLE112093 "RTN","C0CNHIN",288,0)112094 N ZD S ZD=$NA(^TMP("MXMLDOM",$J,ZH))112095 "RTN","C0CNHIN",289,0)112096 F S ZI=$O(@ZD@(ZI)) Q:ZI="" D ; FOR EACH NODE112097 "RTN","C0CNHIN",290,0)112098 . N ZATT112099 "RTN","C0CNHIN",291,0)112100 . D MNARY(.ZATT,ZH,ZI)112101 "RTN","C0CNHIN",292,0)112102 . N ZPRE,ZN112103 "RTN","C0CNHIN",293,0)112104 . S ZPRE=$$PRE(ZI)112105 "RTN","C0CNHIN",294,0)112106 . S ZN=$P(ZPRE,",",2)112107 "RTN","C0CNHIN",295,0)112108 . S ZPRE=$P(ZPRE,",",1)112109 "RTN","C0CNHIN",296,0)112110 . ;I $D(ZATT) ZWR ZATT112111 "RTN","C0CNHIN",297,0)112112 . N ZJ S ZJ=""112113 "RTN","C0CNHIN",298,0)112114 . F S ZJ=$O(ZATT(ZJ)) Q:ZJ="" D ; FOR EACH ATTRIBUTE112115 "RTN","C0CNHIN",299,0)112116 . . W ZPRE_"["_ZN_"]"_$$TAG(ZI)_"."_ZJ_"="_ZATT(ZJ),!112117 "RTN","C0CNHIN",300,0)112118 . . S GOUT(ZPRE,ZN,$$TAG(ZI)_"."_ZJ)=ZATT(ZJ)112119 "RTN","C0CNHIN",301,0)112120 Q112121 "RTN","C0CNHIN",302,0)112122 ;112123 "RTN","C0CNHIN",303,0)112124 PRE(ZNODE) ; EXTRINSIC WHICH RETURNS THE PREFIX FOR A NODE112125 "RTN","C0CNHIN",304,0)112126 ;112127 "RTN","C0CNHIN",305,0)112128 N GI,GI2,GPT,GJ,GN112129 "RTN","C0CNHIN",306,0)112130 S GI=$$PARENT(ZNODE) ; PARENT NODE112131 "RTN","C0CNHIN",307,0)112132 I GI=0 Q "" ; NO PARENT112133 "RTN","C0CNHIN",308,0)112134 S GPT=$$TAG(GI) ; TAG OF PARENT112135 "RTN","C0CNHIN",309,0)112136 S GI2=$$PARENT(GI) ; PARENT OF PARENT112137 "RTN","C0CNHIN",310,0)112138 I (GI2'=0)&($$TAG(GI2)'="results") S GPT=$$TAG(GI2)_"."_GPT112139 "RTN","C0CNHIN",311,0)112140 S GJ=$$FIRST(GI) ; NODE OF FIRST SIB112141 "RTN","C0CNHIN",312,0)112142 I GJ=ZNODE Q:$$TAG(GI)_",1"112143 "RTN","C0CNHIN",313,0)112144 F GN=2:1 Q:GJ=ZNODE D ;112145 "RTN","C0CNHIN",314,0)112146 . S GJ=$$NXTSIB(GJ) ; NEXT SIBLING112147 "RTN","C0CNHIN",315,0)112148 Q GPT_","_GN112149 "RTN","C0CNHIN",316,0)112150 ;112151 "RTN","C0CNHIN",317,0)112152 MNARY(ZRTN,ZHANDLE,ZOID) ; MAKE A NHIN ARRAY FROM A DOM NODE112153 "RTN","C0CNHIN",318,0)112154 ; RETURNED IN ZRTN, PASSED BY REFERENCE112155 "RTN","C0CNHIN",319,0)112156 ; ZHANDLE IS THE DOM DOCUMENT ID112157 "RTN","C0CNHIN",320,0)112158 ; ZOID IS THE DOM NODE112159 112119 "RTN","C0CNHIN",321,0) 112160 D ATT("ZRTN",ZOID)112161 "RTN","C0CNHIN",322,0)112162 Q112163 "RTN","C0CNHIN",323,0)112164 112120 ; 112165 112121 "RTN","C0CNMED2") 112166 0^89^B3 3217786112122 0^89^B32627824 112167 112123 "RTN","C0CNMED2",1,0) 112168 112124 C0CNMED2 ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009 ; 5/10/12 2:53pm 112169 112125 "RTN","C0CNMED2",2,0) 112170 ;;1.2;C 0C;;May 11, 2012;Build 50112126 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 112171 112127 "RTN","C0CNMED2",3,0) 112172 112128 ; Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel. 112173 112129 "RTN","C0CNMED2",4,0) 112174 ; Licensed under the terms of the GNU General Public License.112130 ; 112175 112131 "RTN","C0CNMED2",5,0) 112176 ; See attached copy of the License.112132 ; This program is free software: you can redistribute it and/or modify 112177 112133 "RTN","C0CNMED2",6,0) 112178 ; 112134 ; it under the terms of the GNU Affero General Public License as 112179 112135 "RTN","C0CNMED2",7,0) 112180 ; This program is free software; you can redistribute it and/or modify112136 ; published by the Free Software Foundation, either version 3 of the 112181 112137 "RTN","C0CNMED2",8,0) 112182 ; it under the terms of the GNU General Public License as published by112138 ; License, or (at your option) any later version. 112183 112139 "RTN","C0CNMED2",9,0) 112184 ; the Free Software Foundation; either version 2 of the License, or112140 ; 112185 112141 "RTN","C0CNMED2",10,0) 112186 ; (at your option) any later version.112142 ; This program is distributed in the hope that it will be useful, 112187 112143 "RTN","C0CNMED2",11,0) 112188 ; 112144 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 112189 112145 "RTN","C0CNMED2",12,0) 112190 ; This program is distributed in the hope that it will be useful,112146 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 112191 112147 "RTN","C0CNMED2",13,0) 112192 ; but WITHOUT ANY WARRANTY; without even the implied warranty of112148 ; GNU Affero General Public License for more details. 112193 112149 "RTN","C0CNMED2",14,0) 112194 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the112150 ; 112195 112151 "RTN","C0CNMED2",15,0) 112196 ; GNU General Public License for more details.112152 ; You should have received a copy of the GNU Affero General Public License 112197 112153 "RTN","C0CNMED2",16,0) 112198 ; 112154 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 112199 112155 "RTN","C0CNMED2",17,0) 112200 ; You should have received a copy of the GNU General Public License along112156 ; 112201 112157 "RTN","C0CNMED2",18,0) 112202 ; with this program; if not, write to the Free Software Foundation, Inc.,112158 ; 112203 112159 "RTN","C0CNMED2",19,0) 112204 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.112160 ; --Revision History 112205 112161 "RTN","C0CNMED2",20,0) 112206 ; 112162 ; July 2008 - Initial Version/GPL 112207 112163 "RTN","C0CNMED2",21,0) 112208 ; --Revision History112164 ; July 2008 - March 2009 various revisions 112209 112165 "RTN","C0CNMED2",22,0) 112210 ; July 2008 - Initial Version/GPL112166 ; March 2009 - Reconstruction of routine as driver for other med routines/SMH 112211 112167 "RTN","C0CNMED2",23,0) 112212 ; Ju ly 2008 - March 2009 various revisions112168 ; June 2011 - Redone to support all meds using the FOIA NHIN routines/gpl 112213 112169 "RTN","C0CNMED2",24,0) 112214 ; March 2009 - Reconstruction of routine as driver for other med routines/SMH112170 ; 112215 112171 "RTN","C0CNMED2",25,0) 112216 ; June 2011 - Redone to support all meds using the FOIA NHIN routines/gpl112172 Q 112217 112173 "RTN","C0CNMED2",26,0) 112218 112174 ; 112219 112175 "RTN","C0CNMED2",27,0) 112176 ; THIS VERSION IS DEPRECATED BECAUSE IT DOES NOT GENEREATE XML IN 112177 "RTN","C0CNMED2",28,0) 112178 ; THE RIGHT ORDER... AND IT HAS TO BE IN THE RIGHT ORDER... :( 112179 "RTN","C0CNMED2",29,0) 112180 ; GPL 112181 "RTN","C0CNMED2",30,0) 112182 ; 112183 "RTN","C0CNMED2",31,0) 112184 EXTRACT(MEDXML,DFN,MEDOUTXML) ; Private; Extract medications into provided XML template 112185 "RTN","C0CNMED2",32,0) 112186 ; DFN passed by reference 112187 "RTN","C0CNMED2",33,0) 112188 ; MEDXML and MEDOUTXML are passed by Name 112189 "RTN","C0CNMED2",34,0) 112190 ; MEDXML is the input template 112191 "RTN","C0CNMED2",35,0) 112192 ; MEDOUTXML is the output template 112193 "RTN","C0CNMED2",36,0) 112194 ; Both of them refer to ^TMP globals where the XML documents are stored 112195 "RTN","C0CNMED2",37,0) 112196 ; 112197 "RTN","C0CNMED2",38,0) 112198 N GN 112199 "RTN","C0CNMED2",39,0) 112200 D EN^C0CNHIN(.GN,DFN,"MED;",1) ; RETRIEVE NHIN ARRAY OF MEDS 112201 "RTN","C0CNMED2",40,0) 112202 ; this call uses GET^NHINV to retrieve xml of the meds and then 112203 "RTN","C0CNMED2",41,0) 112204 ; parses with MXML and uses DOMO^C0CDOM to extract an NHIN array 112205 "RTN","C0CNMED2",42,0) 112206 ; 112207 "RTN","C0CNMED2",43,0) 112208 ; we now create an NHIN Array of the Meds section of the CCR 112209 "RTN","C0CNMED2",44,0) 112210 ; 112211 "RTN","C0CNMED2",45,0) 112212 N ZI S ZI="" 112213 "RTN","C0CNMED2",46,0) 112214 F S ZI=$O(GN("med",ZI)) Q:ZI="" D ; for each med 112215 "RTN","C0CNMED2",47,0) 112216 . N GA S GA=$NA(GN("med",ZI)) 112217 "RTN","C0CNMED2",48,0) 112218 . N GM S GM="Medication" ; to keep the lines shorter 112219 "RTN","C0CNMED2",49,0) 112220 . S GC(GM,ZI,"CCRDataObjectID")="MED_"_ZI 112221 "RTN","C0CNMED2",50,0) 112222 . N ZD,ZD2 S ZD=$G(@GA@("ordered@value")) ; FILEMAN DATE 112223 "RTN","C0CNMED2",51,0) 112224 . I ZD="" S ZD=$G(@GA@("start@value")) ; for inpatient meds 112225 "RTN","C0CNMED2",52,0) 112226 . S ZD2=$$FMDTOUTC^C0CUTIL(ZD,"DT") 112227 "RTN","C0CNMED2",53,0) 112228 . S GC(GM,ZI,"DateTime[1].ExactDateTime")=ZD2 112229 "RTN","C0CNMED2",54,0) 112230 . S GC(GM,ZI,"DateTime[1].Type.Text")="Documented Date" 112231 "RTN","C0CNMED2",55,0) 112232 . ;S GC(GM,ZI,"DateTime[2].ExactDateTime")="" 112233 "RTN","C0CNMED2",56,0) 112234 . ;S GC(GM,ZI,"DateTime[2].Type.Text")="" 112235 "RTN","C0CNMED2",57,0) 112236 . N GSIG S GSIG=$G(@GA@("sig")) 112237 "RTN","C0CNMED2",58,0) 112238 . I GSIG["|" S GSIG=$P(GSIG,"|",2) ; eRx has name of drug separated by | 112239 "RTN","C0CNMED2",59,0) 112240 . S GC(GM,ZI,"Description.Text")=GSIG 112241 "RTN","C0CNMED2",60,0) 112242 . N GD S GD="Directions.Direction" ; MAKING THE STRINGS SHORTER 112243 "RTN","C0CNMED2",61,0) 112244 . ;S GC(GM,ZI,GD_".DeliveryMethod.Text")="@@MEDDELIVERYMETHOD@@" 112245 "RTN","C0CNMED2",62,0) 112246 . ;S GC(GM,ZI,GD_".Description.Text")="" 112247 "RTN","C0CNMED2",63,0) 112248 . ;S GC(GM,ZI,GD_".DirectionSequenceModifier")="@@MEDDIRSEQ@@" 112249 "RTN","C0CNMED2",64,0) 112250 . ;S GC(GM,ZI,GD_".Dose.Rate.Units.Unit")="@@MEDRATEUNIT@@" 112251 "RTN","C0CNMED2",65,0) 112252 . ;S GC(GM,ZI,GD_".Dose.Rate.Value")="@@MEDRATEVALUE@@" 112253 "RTN","C0CNMED2",66,0) 112254 . ;S GC(GM,ZI,GD_".Dose.Units.Unit")="@@MEDDOSEUNIT@@" 112255 "RTN","C0CNMED2",67,0) 112256 . ;S GC(GM,ZI,GD_".Dose.Value")="@@MEDDOSEVALUE@@" 112257 "RTN","C0CNMED2",68,0) 112258 . ;S GC(GM,ZI,GD_".DoseIndicator.Text")="@@MEDDOSEINDICATOR@@" 112259 "RTN","C0CNMED2",69,0) 112260 . ;S GC(GM,ZI,GD_".Duration.Units.Unit")="@@MEDDURATIONUNIT@@" 112261 "RTN","C0CNMED2",70,0) 112262 . ;S GC(GM,ZI,GD_".Duration.Value")="@@MEDDURATIONVALUE@@" 112263 "RTN","C0CNMED2",71,0) 112264 . ;S GC(GM,ZI,GD_".Frequency.Value")="@@MEDFREQUENCYVALUE@@" 112265 "RTN","C0CNMED2",72,0) 112266 . ;S GC(GM,ZI,GD_".Indication.PRNFlag.Text")="@@MEDPRNFLAG@@" 112267 "RTN","C0CNMED2",73,0) 112268 . ;S GC(GM,ZI,GD_".Indication.Problem.CCRDataObjectID")="" 112269 "RTN","C0CNMED2",74,0) 112270 . ;S GC(GM,ZI,GD_".Indication.Problem.Description.Code.CodingSystem")="" 112271 "RTN","C0CNMED2",75,0) 112272 . ;S GC(GM,ZI,GD_".Indication.Problem.Description.Code.Value")="" 112273 "RTN","C0CNMED2",76,0) 112274 . ;S GC(GM,ZI,GD_".Indication.Problem.Description.Code.Version")="" 112275 "RTN","C0CNMED2",77,0) 112276 . ;S GC(GM,ZI,GD_".Indication.Problem.Description.Text")="" 112277 "RTN","C0CNMED2",78,0) 112278 . ;S GC(GM,ZI,GD_".Indication.Problem.Source.Actor.ActorID")="" 112279 "RTN","C0CNMED2",79,0) 112280 . ;S GC(GM,ZI,GD_".Indication.Problem.Type.Text")="" 112281 "RTN","C0CNMED2",80,0) 112282 . ;S GC(GM,ZI,GD_".Interval.Units.Unit")="@@MEDINTERVALUNIT@@" 112283 "RTN","C0CNMED2",81,0) 112284 . ;S GC(GM,ZI,GD_".Interval.Value")="@@MEDINTERVALVALUE@@" 112285 "RTN","C0CNMED2",82,0) 112286 . ;S GC(GM,ZI,GD_".MultipleDirectionModifier.Text")="@@MEDMULDIRMOD@@" 112287 "RTN","C0CNMED2",83,0) 112288 . S GC(GM,ZI,GD_".Route.Text")=$G(@GA@("doses.dose@route")) 112289 "RTN","C0CNMED2",84,0) 112290 . ;S GC(GM,ZI,GD_".StopIndicator.Text")="@@MEDSTOPINDICATOR@@" 112291 "RTN","C0CNMED2",85,0) 112292 . ;S GC(GM,ZI,GD_".Vehicle.Text")="@@MEDVEHICLETEXT@@" 112293 "RTN","C0CNMED2",86,0) 112294 . ;S GC(GM,ZI,"FullfillmentInstructions.Text")="" 112295 "RTN","C0CNMED2",87,0) 112296 . ;S GC(GM,ZI,"IDs.ID")="@@MEDRXNO@@" 112297 "RTN","C0CNMED2",88,0) 112298 . ;S GC(GM,ZI,"IDs.Type.Text")="@@MEDRXNOTXT@@" 112299 "RTN","C0CNMED2",89,0) 112300 . ;S GC(GM,ZI,"PatientInstructions.Instruction.Text")="@@MEDPTINSTRUCTIONS@@" 112301 "RTN","C0CNMED2",90,0) 112302 . ;S GC(GM,ZI,"Product.BrandName.Text")="@@MEDBRANDNAMETEXT@@" 112303 "RTN","C0CNMED2",91,0) 112304 . S GC(GM,ZI,"Product.Concentration.Units.Unit")=$G(@GA@("doses.dose@units")) 112305 "RTN","C0CNMED2",92,0) 112306 . S GC(GM,ZI,"Product.Concentration.Value")=$G(@GA@("doses.dose@dose")) 112307 "RTN","C0CNMED2",93,0) 112308 . S GC(GM,ZI,"Product.Form.Text")=$G(@GA@("form@value")) 112309 "RTN","C0CNMED2",94,0) 112310 . N GV S GV=$G(@GA@("products.product.vaProduct@vuid")) 112311 "RTN","C0CNMED2",95,0) 112312 . N GR S GR=$$RXNCUI3^C0PLKUP(GV) 112313 "RTN","C0CNMED2",96,0) 112314 . S GC(GM,ZI,"Product.ProductName.Code.CodingSystem")=$S(GR:"RxNorm",1:"VUID") 112315 "RTN","C0CNMED2",97,0) 112316 . S GC(GM,ZI,"Product.ProductName.Code.Value")=$S(GR:GR,1:GV) 112317 "RTN","C0CNMED2",98,0) 112318 . S GC(GM,ZI,"Product.ProductName.Code.Version")="08AB_081201F" 112319 "RTN","C0CNMED2",99,0) 112320 . S GC(GM,ZI,"Product.ProductName.Text")=$G(@GA@("name@value")) 112321 "RTN","C0CNMED2",100,0) 112322 . S GC(GM,ZI,"Product.Strength.Units.Unit")=$G(@GA@("doses.dose@units")) 112323 "RTN","C0CNMED2",101,0) 112324 . S GC(GM,ZI,"Product.Strength.Value")=$G(@GA@("doses.dose@dose")) 112325 "RTN","C0CNMED2",102,0) 112326 . ;S GC(GM,ZI,"Quantity.Units.Unit")="@@MEDQUANTITYUNIT@@" 112327 "RTN","C0CNMED2",103,0) 112328 . ;S GC(GM,ZI,"Quantity.Value")="@@MEDQUANTITYVALUE@@" 112329 "RTN","C0CNMED2",104,0) 112330 . ;S GC(GM,ZI,"Refills.Refill.Number")="@@MEDRFNO@@" 112331 "RTN","C0CNMED2",105,0) 112332 . N GDUZ S GDUZ=$G(@GA@("orderingProvider@code")) ;PROVIDER DUZ 112333 "RTN","C0CNMED2",106,0) 112334 . S GC(GM,ZI,"Source.Actor.ActorID")="PROVIDER_"_GDUZ 112335 "RTN","C0CNMED2",107,0) 112336 . S GC(GM,ZI,"Status.Text")=$G(@GA@("status@value")) 112337 "RTN","C0CNMED2",108,0) 112338 . S GC(GM,ZI,"Type.Text")="Medication" 112339 "RTN","C0CNMED2",109,0) 112340 N C0CDOCID 112341 "RTN","C0CNMED2",110,0) 112342 S C0CDOCID=$$DOMI^C0CDOM("GC",,"Medications") ; insert to dom 112343 "RTN","C0CNMED2",111,0) 112344 D OUTXML^C0CDOM(MEDOUTXML,C0CDOCID,1) ; render the xml 112345 "RTN","C0CNMED2",112,0) 112346 N ZSIZE S ZSIZE=$O(@MEDOUTXML@(""),-1) 112347 "RTN","C0CNMED2",113,0) 112348 S @MEDOUTXML@(0)=ZSIZE ; RETURN STATUS IS NUMBER OF LINES OF XML 112349 "RTN","C0CNMED2",114,0) 112350 W !,MEDOUTXML 112351 "RTN","C0CNMED2",115,0) 112352 ;ZWR GN 112353 "RTN","C0CNMED2",116,0) 112354 ;ZWR GC 112355 "RTN","C0CNMED2",117,0) 112356 ;B 112357 "RTN","C0CNMED2",118,0) 112220 112358 Q 112221 "RTN","C0CNMED2",28,0)112222 ;112223 "RTN","C0CNMED2",29,0)112224 ; THIS VERSION IS DEPRECATED BECAUSE IT DOES NOT GENEREATE XML IN112225 "RTN","C0CNMED2",30,0)112226 ; THE RIGHT ORDER... AND IT HAS TO BE IN THE RIGHT ORDER... :(112227 "RTN","C0CNMED2",31,0)112228 ; GPL112229 "RTN","C0CNMED2",32,0)112230 ;112231 "RTN","C0CNMED2",33,0)112232 EXTRACT(MEDXML,DFN,MEDOUTXML) ; Private; Extract medications into provided XML template112233 "RTN","C0CNMED2",34,0)112234 ; DFN passed by reference112235 "RTN","C0CNMED2",35,0)112236 ; MEDXML and MEDOUTXML are passed by Name112237 "RTN","C0CNMED2",36,0)112238 ; MEDXML is the input template112239 "RTN","C0CNMED2",37,0)112240 ; MEDOUTXML is the output template112241 "RTN","C0CNMED2",38,0)112242 ; Both of them refer to ^TMP globals where the XML documents are stored112243 "RTN","C0CNMED2",39,0)112244 ;112245 "RTN","C0CNMED2",40,0)112246 N GN112247 "RTN","C0CNMED2",41,0)112248 D EN^C0CNHIN(.GN,DFN,"MED;",1) ; RETRIEVE NHIN ARRAY OF MEDS112249 "RTN","C0CNMED2",42,0)112250 ; this call uses GET^NHINV to retrieve xml of the meds and then112251 "RTN","C0CNMED2",43,0)112252 ; parses with MXML and uses DOMO^C0CDOM to extract an NHIN array112253 "RTN","C0CNMED2",44,0)112254 ;112255 "RTN","C0CNMED2",45,0)112256 ; we now create an NHIN Array of the Meds section of the CCR112257 "RTN","C0CNMED2",46,0)112258 ;112259 "RTN","C0CNMED2",47,0)112260 N ZI S ZI=""112261 "RTN","C0CNMED2",48,0)112262 F S ZI=$O(GN("med",ZI)) Q:ZI="" D ; for each med112263 "RTN","C0CNMED2",49,0)112264 . N GA S GA=$NA(GN("med",ZI))112265 "RTN","C0CNMED2",50,0)112266 . N GM S GM="Medication" ; to keep the lines shorter112267 "RTN","C0CNMED2",51,0)112268 . S GC(GM,ZI,"CCRDataObjectID")="MED_"_ZI112269 "RTN","C0CNMED2",52,0)112270 . N ZD,ZD2 S ZD=$G(@GA@("ordered@value")) ; FILEMAN DATE112271 "RTN","C0CNMED2",53,0)112272 . I ZD="" S ZD=$G(@GA@("start@value")) ; for inpatient meds112273 "RTN","C0CNMED2",54,0)112274 . S ZD2=$$FMDTOUTC^C0CUTIL(ZD,"DT")112275 "RTN","C0CNMED2",55,0)112276 . S GC(GM,ZI,"DateTime[1].ExactDateTime")=ZD2112277 "RTN","C0CNMED2",56,0)112278 . S GC(GM,ZI,"DateTime[1].Type.Text")="Documented Date"112279 "RTN","C0CNMED2",57,0)112280 . ;S GC(GM,ZI,"DateTime[2].ExactDateTime")=""112281 "RTN","C0CNMED2",58,0)112282 . ;S GC(GM,ZI,"DateTime[2].Type.Text")=""112283 "RTN","C0CNMED2",59,0)112284 . N GSIG S GSIG=$G(@GA@("sig"))112285 "RTN","C0CNMED2",60,0)112286 . I GSIG["|" S GSIG=$P(GSIG,"|",2) ; eRx has name of drug separated by |112287 "RTN","C0CNMED2",61,0)112288 . S GC(GM,ZI,"Description.Text")=GSIG112289 "RTN","C0CNMED2",62,0)112290 . N GD S GD="Directions.Direction" ; MAKING THE STRINGS SHORTER112291 "RTN","C0CNMED2",63,0)112292 . ;S GC(GM,ZI,GD_".DeliveryMethod.Text")="@@MEDDELIVERYMETHOD@@"112293 "RTN","C0CNMED2",64,0)112294 . ;S GC(GM,ZI,GD_".Description.Text")=""112295 "RTN","C0CNMED2",65,0)112296 . ;S GC(GM,ZI,GD_".DirectionSequenceModifier")="@@MEDDIRSEQ@@"112297 "RTN","C0CNMED2",66,0)112298 . ;S GC(GM,ZI,GD_".Dose.Rate.Units.Unit")="@@MEDRATEUNIT@@"112299 "RTN","C0CNMED2",67,0)112300 . ;S GC(GM,ZI,GD_".Dose.Rate.Value")="@@MEDRATEVALUE@@"112301 "RTN","C0CNMED2",68,0)112302 . ;S GC(GM,ZI,GD_".Dose.Units.Unit")="@@MEDDOSEUNIT@@"112303 "RTN","C0CNMED2",69,0)112304 . ;S GC(GM,ZI,GD_".Dose.Value")="@@MEDDOSEVALUE@@"112305 "RTN","C0CNMED2",70,0)112306 . ;S GC(GM,ZI,GD_".DoseIndicator.Text")="@@MEDDOSEINDICATOR@@"112307 "RTN","C0CNMED2",71,0)112308 . ;S GC(GM,ZI,GD_".Duration.Units.Unit")="@@MEDDURATIONUNIT@@"112309 "RTN","C0CNMED2",72,0)112310 . ;S GC(GM,ZI,GD_".Duration.Value")="@@MEDDURATIONVALUE@@"112311 "RTN","C0CNMED2",73,0)112312 . ;S GC(GM,ZI,GD_".Frequency.Value")="@@MEDFREQUENCYVALUE@@"112313 "RTN","C0CNMED2",74,0)112314 . ;S GC(GM,ZI,GD_".Indication.PRNFlag.Text")="@@MEDPRNFLAG@@"112315 "RTN","C0CNMED2",75,0)112316 . ;S GC(GM,ZI,GD_".Indication.Problem.CCRDataObjectID")=""112317 "RTN","C0CNMED2",76,0)112318 . ;S GC(GM,ZI,GD_".Indication.Problem.Description.Code.CodingSystem")=""112319 "RTN","C0CNMED2",77,0)112320 . ;S GC(GM,ZI,GD_".Indication.Problem.Description.Code.Value")=""112321 "RTN","C0CNMED2",78,0)112322 . ;S GC(GM,ZI,GD_".Indication.Problem.Description.Code.Version")=""112323 "RTN","C0CNMED2",79,0)112324 . ;S GC(GM,ZI,GD_".Indication.Problem.Description.Text")=""112325 "RTN","C0CNMED2",80,0)112326 . ;S GC(GM,ZI,GD_".Indication.Problem.Source.Actor.ActorID")=""112327 "RTN","C0CNMED2",81,0)112328 . ;S GC(GM,ZI,GD_".Indication.Problem.Type.Text")=""112329 "RTN","C0CNMED2",82,0)112330 . ;S GC(GM,ZI,GD_".Interval.Units.Unit")="@@MEDINTERVALUNIT@@"112331 "RTN","C0CNMED2",83,0)112332 . ;S GC(GM,ZI,GD_".Interval.Value")="@@MEDINTERVALVALUE@@"112333 "RTN","C0CNMED2",84,0)112334 . ;S GC(GM,ZI,GD_".MultipleDirectionModifier.Text")="@@MEDMULDIRMOD@@"112335 "RTN","C0CNMED2",85,0)112336 . S GC(GM,ZI,GD_".Route.Text")=$G(@GA@("doses.dose@route"))112337 "RTN","C0CNMED2",86,0)112338 . ;S GC(GM,ZI,GD_".StopIndicator.Text")="@@MEDSTOPINDICATOR@@"112339 "RTN","C0CNMED2",87,0)112340 . ;S GC(GM,ZI,GD_".Vehicle.Text")="@@MEDVEHICLETEXT@@"112341 "RTN","C0CNMED2",88,0)112342 . ;S GC(GM,ZI,"FullfillmentInstructions.Text")=""112343 "RTN","C0CNMED2",89,0)112344 . ;S GC(GM,ZI,"IDs.ID")="@@MEDRXNO@@"112345 "RTN","C0CNMED2",90,0)112346 . ;S GC(GM,ZI,"IDs.Type.Text")="@@MEDRXNOTXT@@"112347 "RTN","C0CNMED2",91,0)112348 . ;S GC(GM,ZI,"PatientInstructions.Instruction.Text")="@@MEDPTINSTRUCTIONS@@"112349 "RTN","C0CNMED2",92,0)112350 . ;S GC(GM,ZI,"Product.BrandName.Text")="@@MEDBRANDNAMETEXT@@"112351 "RTN","C0CNMED2",93,0)112352 . S GC(GM,ZI,"Product.Concentration.Units.Unit")=$G(@GA@("doses.dose@units"))112353 "RTN","C0CNMED2",94,0)112354 . S GC(GM,ZI,"Product.Concentration.Value")=$G(@GA@("doses.dose@dose"))112355 "RTN","C0CNMED2",95,0)112356 . S GC(GM,ZI,"Product.Form.Text")=$G(@GA@("form@value"))112357 "RTN","C0CNMED2",96,0)112358 . N GV S GV=$G(@GA@("products.product.vaProduct@vuid"))112359 "RTN","C0CNMED2",97,0)112360 . N GR S GR=$$RXNCUI3^C0PLKUP(GV)112361 "RTN","C0CNMED2",98,0)112362 . S GC(GM,ZI,"Product.ProductName.Code.CodingSystem")=$S(GR:"RxNorm",1:"VUID")112363 "RTN","C0CNMED2",99,0)112364 . S GC(GM,ZI,"Product.ProductName.Code.Value")=$S(GR:GR,1:GV)112365 "RTN","C0CNMED2",100,0)112366 . S GC(GM,ZI,"Product.ProductName.Code.Version")="08AB_081201F"112367 "RTN","C0CNMED2",101,0)112368 . S GC(GM,ZI,"Product.ProductName.Text")=$G(@GA@("name@value"))112369 "RTN","C0CNMED2",102,0)112370 . S GC(GM,ZI,"Product.Strength.Units.Unit")=$G(@GA@("doses.dose@units"))112371 "RTN","C0CNMED2",103,0)112372 . S GC(GM,ZI,"Product.Strength.Value")=$G(@GA@("doses.dose@dose"))112373 "RTN","C0CNMED2",104,0)112374 . ;S GC(GM,ZI,"Quantity.Units.Unit")="@@MEDQUANTITYUNIT@@"112375 "RTN","C0CNMED2",105,0)112376 . ;S GC(GM,ZI,"Quantity.Value")="@@MEDQUANTITYVALUE@@"112377 "RTN","C0CNMED2",106,0)112378 . ;S GC(GM,ZI,"Refills.Refill.Number")="@@MEDRFNO@@"112379 "RTN","C0CNMED2",107,0)112380 . N GDUZ S GDUZ=$G(@GA@("orderingProvider@code")) ;PROVIDER DUZ112381 "RTN","C0CNMED2",108,0)112382 . S GC(GM,ZI,"Source.Actor.ActorID")="PROVIDER_"_GDUZ112383 "RTN","C0CNMED2",109,0)112384 . S GC(GM,ZI,"Status.Text")=$G(@GA@("status@value"))112385 "RTN","C0CNMED2",110,0)112386 . S GC(GM,ZI,"Type.Text")="Medication"112387 "RTN","C0CNMED2",111,0)112388 N C0CDOCID112389 "RTN","C0CNMED2",112,0)112390 S C0CDOCID=$$DOMI^C0CDOM("GC",,"Medications") ; insert to dom112391 "RTN","C0CNMED2",113,0)112392 D OUTXML^C0CDOM(MEDOUTXML,C0CDOCID,1) ; render the xml112393 "RTN","C0CNMED2",114,0)112394 N ZSIZE S ZSIZE=$O(@MEDOUTXML@(""),-1)112395 "RTN","C0CNMED2",115,0)112396 S @MEDOUTXML@(0)=ZSIZE ; RETURN STATUS IS NUMBER OF LINES OF XML112397 "RTN","C0CNMED2",116,0)112398 W !,MEDOUTXML112399 "RTN","C0CNMED2",117,0)112400 ;ZWR GN112401 "RTN","C0CNMED2",118,0)112402 ;ZWR GC112403 112359 "RTN","C0CNMED2",119,0) 112404 ;B112405 "RTN","C0CNMED2",120,0)112406 Q112407 "RTN","C0CNMED2",121,0)112408 112360 ; 112409 112361 "RTN","C0CNMED4") 112410 0^90^B9 9762510112362 0^90^B98251317 112411 112363 "RTN","C0CNMED4",1,0) 112412 112364 C0CNMED4 ; WV/CCDCCR/SMH/gpl - CCR/CCD PROCESSING FOR MEDICATIONS - Inpatient Meds/Unit Dose ;10/13/08 ; 5/10/12 2:54pm 112413 112365 "RTN","C0CNMED4",2,0) 112414 ;;1.2;C 0C;;May 11, 2012;Build 50112366 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 112415 112367 "RTN","C0CNMED4",3,0) 112416 ; Copyright 2008 WorldVistA. Licensed under the terms of the GNU112368 ; Copyright 2008 WorldVistA. 112417 112369 "RTN","C0CNMED4",4,0) 112418 ; General Public License See attached copy of the License.112370 ; 112419 112371 "RTN","C0CNMED4",5,0) 112420 ; 112372 ; This program is free software: you can redistribute it and/or modify 112421 112373 "RTN","C0CNMED4",6,0) 112422 ; This program is free software; you can redistribute it and/or modify112374 ; it under the terms of the GNU Affero General Public License as 112423 112375 "RTN","C0CNMED4",7,0) 112424 ; it under the terms of the GNU General Public License as published by112376 ; published by the Free Software Foundation, either version 3 of the 112425 112377 "RTN","C0CNMED4",8,0) 112426 ; the Free Software Foundation; either version 2 of the License, or112378 ; License, or (at your option) any later version. 112427 112379 "RTN","C0CNMED4",9,0) 112428 ; (at your option) any later version.112380 ; 112429 112381 "RTN","C0CNMED4",10,0) 112430 ; 112382 ; This program is distributed in the hope that it will be useful, 112431 112383 "RTN","C0CNMED4",11,0) 112432 ; This program is distributed in the hope that it will be useful,112384 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 112433 112385 "RTN","C0CNMED4",12,0) 112434 ; but WITHOUT ANY WARRANTY; without even the implied warranty of112386 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 112435 112387 "RTN","C0CNMED4",13,0) 112436 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the112388 ; GNU Affero General Public License for more details. 112437 112389 "RTN","C0CNMED4",14,0) 112438 ; GNU General Public License for more details.112390 ; 112439 112391 "RTN","C0CNMED4",15,0) 112440 ; 112392 ; You should have received a copy of the GNU Affero General Public License 112441 112393 "RTN","C0CNMED4",16,0) 112442 ; You should have received a copy of the GNU General Public License along112394 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 112443 112395 "RTN","C0CNMED4",17,0) 112444 ; with this program; if not, write to the Free Software Foundation, Inc.,112396 ; 112445 112397 "RTN","C0CNMED4",18,0) 112446 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.112398 W "NO ENTRY FROM TOP",! 112447 112399 "RTN","C0CNMED4",19,0) 112448 ;112400 Q 112449 112401 "RTN","C0CNMED4",20,0) 112450 W "NO ENTRY FROM TOP",!112402 ; 112451 112403 "RTN","C0CNMED4",21,0) 112452 Q 112404 EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE 112453 112405 "RTN","C0CNMED4",22,0) 112454 112406 ; 112455 112407 "RTN","C0CNMED4",23,0) 112456 EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE 112408 ; this routine has be adapted to retrieve meds from GET^NHINV by gpl 6/2011 112457 112409 "RTN","C0CNMED4",24,0) 112458 112410 ; 112459 112411 "RTN","C0CNMED4",25,0) 112460 ; this routine has be adapted to retrieve meds from GET^NHINV by gpl 6/2011112412 ; MINXML is the Input XML Template, passed by name 112461 112413 "RTN","C0CNMED4",26,0) 112462 ; 112414 ; DFN is Patient IEN 112463 112415 "RTN","C0CNMED4",27,0) 112464 ; MINXML is the Input XML Template, passed by name112416 ; OUTXML is the resultant XML. 112465 112417 "RTN","C0CNMED4",28,0) 112466 ; DFN is Patient IEN112418 ; 112467 112419 "RTN","C0CNMED4",29,0) 112468 ; OUTXML is the resultant XML.112420 ; MEDS is return array from API. 112469 112421 "RTN","C0CNMED4",30,0) 112470 ; 112422 ; MED is holds each array element from MEDS, one medicine 112471 112423 "RTN","C0CNMED4",31,0) 112472 ; M EDS is return array from API.112424 ; MAP is a mapping variable map (store result) for each med 112473 112425 "RTN","C0CNMED4",32,0) 112474 ; MED is holds each array element from MEDS, one medicine112426 ; 112475 112427 "RTN","C0CNMED4",33,0) 112476 ; MAP is a mapping variable map (store result) for each med112428 ; Inpatient Meds will be extracted using this routine and and the one following. 112477 112429 "RTN","C0CNMED4",34,0) 112478 ; 112430 ; Inpatient Meds Unit Dose is going to be C0CMED4 112479 112431 "RTN","C0CNMED4",35,0) 112480 ; Inpatient Meds will be extracted using this routine and and the one following.112432 ; Inpatient Meds IVs is going to be C0CMED5 112481 112433 "RTN","C0CNMED4",36,0) 112482 ; Inpatient Meds Unit Dose is going to be C0CMED4112434 ; 112483 112435 "RTN","C0CNMED4",37,0) 112484 ; Inpatient Meds IVs is going to be C0CMED5112436 ; We will use two Pharmacy ReEnginnering API's: 112485 112437 "RTN","C0CNMED4",38,0) 112486 ; 112438 ; PSS431^PSS55(DFN,PO,PSDATE,PEDATE,LIST) - provides most info 112487 112439 "RTN","C0CNMED4",39,0) 112488 ; We will use two Pharmacy ReEnginnering API's:112440 ; PSS432^PSS55(DFN,PO,LIST) - provides schedule info 112489 112441 "RTN","C0CNMED4",40,0) 112490 ; PSS431^PSS55(DFN,PO,PSDATE,PEDATE,LIST) - provides most info112442 ; For more information, see the PRE documentation at: 112491 112443 "RTN","C0CNMED4",41,0) 112492 ; PSS432^PSS55(DFN,PO,LIST) - provides schedule info112444 ; http://www.va.gov/vdl/documents/Clinical/Pharm-Inpatient_Med/phar_1_api_r0807.pdf 112493 112445 "RTN","C0CNMED4",42,0) 112494 ; For more information, see the PRE documentation at:112446 ; 112495 112447 "RTN","C0CNMED4",43,0) 112496 ; http://www.va.gov/vdl/documents/Clinical/Pharm-Inpatient_Med/phar_1_api_r0807.pdf112448 ; Med data is stored in Unit Dose multiple of file 55, pharmacy patient 112497 112449 "RTN","C0CNMED4",44,0) 112498 ; 112450 ; 112499 112451 "RTN","C0CNMED4",45,0) 112500 ; Med data is stored in Unit Dose multiple of file 55, pharmacy patient112452 N MEDS,MAP 112501 112453 "RTN","C0CNMED4",46,0) 112502 ; 112454 ;K ^TMP($J) 112503 112455 "RTN","C0CNMED4",47,0) 112504 N MEDS,MAP112456 ;D PSS431^PSS55(DFN,,,,"UD") ; Output is in ^TMP($J,"UD",*) 112505 112457 "RTN","C0CNMED4",48,0) 112506 ; K ^TMP($J)112458 ;I ^TMP($J,"UD",0)'>0 S @OUTXML@(0)=0 QUIT ; No Meds - Quit 112507 112459 "RTN","C0CNMED4",49,0) 112508 ; D PSS431^PSS55(DFN,,,,"UD") ; Output is in ^TMP($J,"UD",*)112460 ;; Otherwise, we go on... 112509 112461 "RTN","C0CNMED4",50,0) 112510 ;I ^TMP($J,"UD",0)'>0 S @OUTXML@(0)=0 QUIT ; No Meds - Quit112462 D EN^C0CNHIN(.MEDS,DFN,"MED;") ; gpl get the NHIN Array of meds 112511 112463 "RTN","C0CNMED4",51,0) 112512 ;; Otherwise, we go on...112464 I '$D(MEDS) Q ; no meds 112513 112465 "RTN","C0CNMED4",52,0) 112514 D EN^C0CNHIN(.MEDS,DFN,"MED;") ; gpl get the NHIN Array of meds112466 N ZI S ZI="" 112515 112467 "RTN","C0CNMED4",53,0) 112516 I '$D(MEDS) Q ; no meds112468 N ZCOUNT S ZCOUNT=0 112517 112469 "RTN","C0CNMED4",54,0) 112518 N ZI S ZI=""112470 F S ZI=$O(MEDS("med",ZI)) Q:ZI="" D ; for each returned med 112519 112471 "RTN","C0CNMED4",55,0) 112520 N ZCOUNT S ZCOUNT=0112472 . I $G(MEDS("med",ZI,"vaType@value"))="I" S ZCOUNT=ZCOUNT+1 112521 112473 "RTN","C0CNMED4",56,0) 112522 F S ZI=$O(MEDS("med",ZI)) Q:ZI="" D ; for each returned med112474 IF ZCOUNT=0 Q ; no inpatient meds 112523 112475 "RTN","C0CNMED4",57,0) 112524 . I $G(MEDS("med",ZI,"vaType@value"))="I" S ZCOUNT=ZCOUNT+1112476 ;M MEDS=^TMP($J,"UD") 112525 112477 "RTN","C0CNMED4",58,0) 112526 IF ZCOUNT=0 Q ; no inpatient meds112478 ;I DEBUG ZWR MEDS 112527 112479 "RTN","C0CNMED4",59,0) 112528 ;M MEDS=^TMP($J,"UD")112480 S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) 112529 112481 "RTN","C0CNMED4",60,0) 112530 I DEBUG ZWR MEDS112482 ;N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array 112531 112483 "RTN","C0CNMED4",61,0) 112532 S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP"))112484 S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING") ;SETTING FLAG 112533 112485 "RTN","C0CNMED4",62,0) 112534 ;N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array112486 N I S I=0 112535 112487 "RTN","C0CNMED4",63,0) 112536 S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING") ;SETTING FLAG112488 F S I=$O(MEDS("med",I)) Q:'I D ; For each medication 112537 112489 "RTN","C0CNMED4",64,0) 112538 N I S I=0112490 . ;OHUM/RUT 3120507 ;STATUS VALIDATION FOR INPATIENT 112539 112491 "RTN","C0CNMED4",65,0) 112540 F S I=$O(MEDS("med",I)) Q:'I D ; For each medication112492 . I ($P(C0CMFLAG,"^",1)'=1) D 112541 112493 "RTN","C0CNMED4",66,0) 112542 . ;OHUM/RUT 3120507 ;STATUS VALIDATION FOR INPATIENT112494 . . I ($P(C0CMFLAG,"^",3)=1)&(MEDS("med",I,"vaStatus@value")'="ACTIVE") D 112543 112495 "RTN","C0CNMED4",67,0) 112544 . I ($P(C0CMFLAG,"^",1)'=1) D112496 . . . K MEDS("med",I) Q 112545 112497 "RTN","C0CNMED4",68,0) 112546 . . I ($P(C0CMFLAG,"^",3)=1)&(MEDS("med",I,"vaStatus@value")'="ACTIVE") D112498 . . I ($P(C0CMFLAG,"^",4)=1)&(MEDS("med",I,"vaStatus@value")'="PENDING") D 112547 112499 "RTN","C0CNMED4",69,0) 112548 112500 . . . K MEDS("med",I) Q 112549 112501 "RTN","C0CNMED4",70,0) 112550 . . I ($P(C0CMFLAG,"^",4)=1)&(MEDS("med",I,"vaStatus@value")'="PENDING") D112502 . ;OHUM/RUT 112551 112503 "RTN","C0CNMED4",71,0) 112552 . . . K MEDS("med",I) Q112504 . N MED M MED=MEDS("med",I) 112553 112505 "RTN","C0CNMED4",72,0) 112554 . ;OHUM/RUT112506 . I $G(MED("vaType@value"))'="I" Q ; not inpatient 112555 112507 "RTN","C0CNMED4",73,0) 112556 . N MED M MED=MEDS("med",I)112508 . S MEDCOUNT=MEDCOUNT+1 112557 112509 "RTN","C0CNMED4",74,0) 112558 . I $G(MED("vaType@value"))'="I" Q ; not inpatient112510 . S @MEDMAP@(0)=MEDCOUNT ; Update MedMap array counter 112559 112511 "RTN","C0CNMED4",75,0) 112560 . S M EDCOUNT=MEDCOUNT+1112512 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT)) 112561 112513 "RTN","C0CNMED4",76,0) 112562 . S @MEDMAP@(0)=MEDCOUNT ; Update MedMap array counter112514 . ;N RXIEN S RXIEN=MED(.01) ; Order Number 112563 112515 "RTN","C0CNMED4",77,0) 112564 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))112516 . N RXIEN S RXIEN=$G(MED("orderID@value")) ; ien of the med 112565 112517 "RTN","C0CNMED4",78,0) 112566 . ;N RXIEN S RXIEN=MED(.01) ; Order Number112518 . I DEBUG W "RXIEN IS ",RXIEN,! 112567 112519 "RTN","C0CNMED4",79,0) 112568 . N RXIEN S RXIEN=$G(MED("orderID@value")) ; ien of the med112520 . I DEBUG W "MAP= ",MAP,! 112569 112521 "RTN","C0CNMED4",80,0) 112570 . I DEBUG W "RXIEN IS ",RXIEN,!112522 . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN 112571 112523 "RTN","C0CNMED4",81,0) 112572 . I DEBUG W "MAP= ",MAP,!112524 . S @MAP@("MEDISSUEDATETXT")="Order Date" 112573 112525 "RTN","C0CNMED4",82,0) 112574 . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN112526 . ;S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT") 112575 112527 "RTN","C0CNMED4",83,0) 112576 . S @MAP@("MEDISSUEDATE TXT")="Order Date"112528 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($G(MED("start@value")),"DT") 112577 112529 "RTN","C0CNMED4",84,0) 112578 . ;S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT")112530 . S @MAP@("MEDLASTFILLDATETXT")="" ; For Outpatient 112579 112531 "RTN","C0CNMED4",85,0) 112580 . S @MAP@("MED ISSUEDATE")=$$FMDTOUTC^C0CUTIL($G(MED("start@value")),"DT")112532 . S @MAP@("MEDLASTFILLDATE")="" ; For Outpatient 112581 112533 "RTN","C0CNMED4",86,0) 112582 . S @MAP@("MED LASTFILLDATETXT")="" ; For Outpatient112534 . S @MAP@("MEDRXNOTXT")="" ; For Outpatient 112583 112535 "RTN","C0CNMED4",87,0) 112584 . S @MAP@("MED LASTFILLDATE")="" ; For Outpatient112536 . S @MAP@("MEDRXNO")="" ; For Outpatient 112585 112537 "RTN","C0CNMED4",88,0) 112586 . S @MAP@("MED RXNOTXT")="" ; For Outpatient112538 . S @MAP@("MEDTYPETEXT")="Medication" 112587 112539 "RTN","C0CNMED4",89,0) 112588 . S @MAP@("MED RXNO")="" ; For Outpatient112540 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses 112589 112541 "RTN","C0CNMED4",90,0) 112590 . S @MAP@("MEDTYPETEXT")="Medication"112542 . ;S @MAP@("MEDSTATUSTEXT")="ACTIVE" 112591 112543 "RTN","C0CNMED4",91,0) 112592 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses112544 . N C0CMST S C0CMST=$G(MED("vaStatus@value")) ; need to filter status 112593 112545 "RTN","C0CNMED4",92,0) 112594 . ;S @MAP@("MEDSTATUSTEXT")="ACTIVE"112546 . I C0CMST="EXPIRED" S C0CMST="Prior History No Longer Active" 112595 112547 "RTN","C0CNMED4",93,0) 112596 . N C0CMST S C0CMST=$G(MED("vaStatus@value")) ; need to filter status112548 . I C0CMST="ACTIVE" S C0CMST="Active" ; 112597 112549 "RTN","C0CNMED4",94,0) 112598 . I C0CMST="EXPIRED" S C0CMST="Prior History No Longer Active"112550 . S @MAP@("MEDSTATUSTEXT")=C0CMST 112599 112551 "RTN","C0CNMED4",95,0) 112600 . I C0CMST="ACTIVE" S C0CMST="Active" ;112552 . ;S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U) 112601 112553 "RTN","C0CNMED4",96,0) 112602 . S @MAP@("MEDS TATUSTEXT")=C0CMST112554 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$G(MED("orderingProvider@code")) 112603 112555 "RTN","C0CNMED4",97,0) 112604 . ;S @MAP@("MED SOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U)112556 . ;S @MAP@("MEDPRODUCTNAMETEXT")=MED("DDRUG",1,.01) 112605 112557 "RTN","C0CNMED4",98,0) 112606 . S @MAP@("MED SOURCEACTORID")="ACTORPROVIDER_"_$G(MED("orderingProvider@code"))112558 . S @MAP@("MEDPRODUCTNAMETEXT")=$G(MED("name@value")) 112607 112559 "RTN","C0CNMED4",99,0) 112608 . ; S @MAP@("MEDPRODUCTNAMETEXT")=MED("DDRUG",1,.01)112560 . ; NDC is field 31 in the drug file. 112609 112561 "RTN","C0CNMED4",100,0) 112610 . S @MAP@("MEDPRODUCTNAMETEXT")=$G(MED("name@value"))112562 . ; The actual drug entry in the drug file is not necessarily supplied. 112611 112563 "RTN","C0CNMED4",101,0) 112612 . ; NDC is field 31 in the drug file.112564 . ; It' node 1, internal form. 112613 112565 "RTN","C0CNMED4",102,0) 112614 . ; The actual drug entry in the drug file is not necessarily supplied.112566 . ;N MEDIEN S MEDIEN=MED(1,"I") 112615 112567 "RTN","C0CNMED4",103,0) 112616 . ; It' node 1, internal form.112568 . ;S @MAP@("MEDPRODUCTNAMECODEVALUE")=$S($L(MEDIEN):$$GET1^DIQ(50,MEDIEN,31,"E"),1:"") 112617 112569 "RTN","C0CNMED4",104,0) 112618 . ;N MEDIEN S MEDIEN=MED(1,"I")112570 . N ZVUID S ZVUID=$G(MED("products.product.vaProduct@vuid")) ; VUID 112619 112571 "RTN","C0CNMED4",105,0) 112620 . ;S @MAP@("MEDPRODUCTNAMECODEVALUE")=$S($L(MEDIEN):$$GET1^DIQ(50,MEDIEN,31,"E"),1:"")112572 . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION 112621 112573 "RTN","C0CNMED4",106,0) 112622 . N ZVUID S ZVUID=$G(MED("products.product.vaProduct@vuid")) ; VUID112574 . D ; 112623 112575 "RTN","C0CNMED4",107,0) 112624 . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION112576 . . S ZC=$$CODE^C0CUTIL(ZVUID) 112625 112577 "RTN","C0CNMED4",108,0) 112626 . D ;112578 . . S ZCD=$P(ZC,"^",1) ; CODE TO USE 112627 112579 "RTN","C0CNMED4",109,0) 112628 . . S ZC =$$CODE^C0CUTIL(ZVUID)112580 . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID 112629 112581 "RTN","C0CNMED4",110,0) 112630 . . S ZCD =$P(ZC,"^",1) ; CODE TO USE112582 . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION 112631 112583 "RTN","C0CNMED4",111,0) 112632 . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID112584 . ;N ZRXNORM S ZRXNORM="" 112633 112585 "RTN","C0CNMED4",112,0) 112634 . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION112586 . ;S ZRXNORM=$$RXNCUI3^C0PLKUP(ZVUID) 112635 112587 "RTN","C0CNMED4",113,0) 112636 . ;N ZRXNORM S ZRXNORM=""112588 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=ZCD 112637 112589 "RTN","C0CNMED4",114,0) 112638 . ;S ZRXNORM=$$RXNCUI3^C0PLKUP(ZVUID)112590 . ;S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=$S($L(MEDIEN):"NDC",1:"") 112639 112591 "RTN","C0CNMED4",115,0) 112640 . S @MAP@("MEDPRODUCTNAMECOD EVALUE")=ZCD112592 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=ZCDS 112641 112593 "RTN","C0CNMED4",116,0) 112642 . ;S @MAP@("MEDPRODUCTNAMECOD INGINGSYSTEM")=$S($L(MEDIEN):"NDC",1:"")112594 . ;S @MAP@("MEDPRODUCTNAMECODEVERSION")=$S($L(MEDIEN):"none",1:"") 112643 112595 "RTN","C0CNMED4",117,0) 112644 . S @MAP@("MEDPRODUCTNAMECOD INGINGSYSTEM")=ZCDS112596 . S @MAP@("MEDPRODUCTNAMECODEVERSION")=ZCDSV 112645 112597 "RTN","C0CNMED4",118,0) 112646 . ;S @MAP@("MEDPRODUCTNAMECODEVERSION")=$S($L(MEDIEN):"none",1:"")112598 . S @MAP@("MEDBRANDNAMETEXT")="" 112647 112599 "RTN","C0CNMED4",119,0) 112648 . S @MAP@("MEDPRODUCTNAME CODEVERSION")=ZCDSV112600 . S @MAP@("MEDPRODUCTNAMETEXT")=$G(MED("name@value"))_" "_ZCDS_": "_ZCD 112649 112601 "RTN","C0CNMED4",120,0) 112650 . S @MAP@("MEDBRANDNAMETEXT")=""112602 . ;I $L(MEDIEN) D DOSE^PSS50(MEDIEN,,,,,"DOSE") 112651 112603 "RTN","C0CNMED4",121,0) 112652 . S @MAP@("MEDPRODUCTNAMETEXT")=$G(MED("name@value"))_" "_ZCDS_": "_ZCD112604 . ;I $L(MEDIEN) N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN) 112653 112605 "RTN","C0CNMED4",122,0) 112654 . ; I $L(MEDIEN) D DOSE^PSS50(MEDIEN,,,,,"DOSE")112606 . ;S @MAP@("MEDSTRENGTHVALUE")=$S($L(MEDIEN):DOSEDATA(901),1:"") 112655 112607 "RTN","C0CNMED4",123,0) 112656 . ;I $L(MEDIEN) N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)112608 . S @MAP@("MEDSTRENGTHVALUE")=$G(MED("doses.dose@dose")) 112657 112609 "RTN","C0CNMED4",124,0) 112658 . ;S @MAP@("MEDSTRENGTH VALUE")=$S($L(MEDIEN):DOSEDATA(901),1:"")112610 . ;S @MAP@("MEDSTRENGTHUNIT")=$S($P(DOSEDATA(902),U,2),1:"") 112659 112611 "RTN","C0CNMED4",125,0) 112660 . S @MAP@("MEDSTRENGTH VALUE")=$G(MED("doses.dose@dose"))112612 . S @MAP@("MEDSTRENGTHUNIT")=$G(MED("doses.dose@units")) 112661 112613 "RTN","C0CNMED4",126,0) 112662 . ; S @MAP@("MEDSTRENGTHUNIT")=$S($P(DOSEDATA(902),U,2),1:"")112614 . ; Units, concentration, etc, come from another call 112663 112615 "RTN","C0CNMED4",127,0) 112664 . S @MAP@("MEDSTRENGTHUNIT")=$G(MED("doses.dose@units"))112616 . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit 112665 112617 "RTN","C0CNMED4",128,0) 112666 . ; Units, concentration, etc, come from another call112618 . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters 112667 112619 "RTN","C0CNMED4",129,0) 112668 . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit112620 . ; NDF Entry IEN, and VA Product Name 112669 112621 "RTN","C0CNMED4",130,0) 112670 . ; Th is call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters112622 . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT") 112671 112623 "RTN","C0CNMED4",131,0) 112672 . ; NDF Entry IEN, and VA Product Name112624 . ; Documented in the same manual. 112673 112625 "RTN","C0CNMED4",132,0) 112674 . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")112626 . ;N NDFDATA,CONCDATA 112675 112627 "RTN","C0CNMED4",133,0) 112676 . ; Documented in the same manual.112628 . ;I $L(MEDIEN) D 112677 112629 "RTN","C0CNMED4",134,0) 112678 . ; N NDFDATA,CONCDATA112630 . ;. D NDF^PSS50(MEDIEN,,,,,"CONC") 112679 112631 "RTN","C0CNMED4",135,0) 112632 . ;. M NDFDATA=^TMP($J,"CONC",MEDIEN) 112633 "RTN","C0CNMED4",136,0) 112634 . ;. N NDFIEN S NDFIEN=$P(NDFDATA(20),U) 112635 "RTN","C0CNMED4",137,0) 112636 . ;. N VAPROD S VAPROD=$P(NDFDATA(22),U) 112637 "RTN","C0CNMED4",138,0) 112638 . ;. ; If a drug was not matched to NDF, then the NDFIEN is gonna be "" 112639 "RTN","C0CNMED4",139,0) 112640 . ;. ; and this will crash the call. So... 112641 "RTN","C0CNMED4",140,0) 112642 . ;. I NDFIEN="" S CONCDATA="" 112643 "RTN","C0CNMED4",141,0) 112644 . ;. E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD) 112645 "RTN","C0CNMED4",142,0) 112646 . ;E S (NDFDATA,CONCDATA)="" ; This line is defensive programming to prevent undef errors. 112647 "RTN","C0CNMED4",143,0) 112648 . ;S @MAP@("MEDFORMTEXT")=$S($L(MEDIEN):$P(CONCDATA,U,1),1:"") 112649 "RTN","C0CNMED4",144,0) 112650 . S @MAP@("MEDFORMTEXT")=$G(MED("form@value")) 112651 "RTN","C0CNMED4",145,0) 112652 . ;S @MAP@("MEDCONCVALUE")=$S($L(MEDIEN):$P(CONCDATA,U,3),1:"") 112653 "RTN","C0CNMED4",146,0) 112654 . S @MAP@("MEDCONCVALUE")=$G(MED("doses.dose@dose")) 112655 "RTN","C0CNMED4",147,0) 112656 . ;S @MAP@("MEDCONCUNIT")=$S($L(MEDIEN):$P(CONCDATA,U,4),1:"") 112657 "RTN","C0CNMED4",148,0) 112658 . S @MAP@("MEDCONCUNIT")=$G(MED("doses.does@units")) 112659 "RTN","C0CNMED4",149,0) 112660 . ;S @MAP@("MEDQUANTITYVALUE")="" ; not provided for in Non-VA meds. 112661 "RTN","C0CNMED4",150,0) 112662 . S @MAP@("MEDQUANTITYVALUE")=$G(MED("doses.dose@unitsPerDose")) ; 112663 "RTN","C0CNMED4",151,0) 112664 . ; Oddly, there is no easy place to find the dispense unit. 112665 "RTN","C0CNMED4",152,0) 112666 . ; It's not included in the original call, so we have to go to the drug file. 112667 "RTN","C0CNMED4",153,0) 112668 . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT") 112669 "RTN","C0CNMED4",154,0) 112670 . ; Node 14.5 is the Dispense Unit 112671 "RTN","C0CNMED4",155,0) 112680 112672 . ;I $L(MEDIEN) D 112681 "RTN","C0CNMED4",136,0)112682 . ;. D NDF^PSS50(MEDIEN,,,,,"CONC")112683 "RTN","C0CNMED4",137,0)112684 . ;. M NDFDATA=^TMP($J,"CONC",MEDIEN)112685 "RTN","C0CNMED4",138,0)112686 . ;. N NDFIEN S NDFIEN=$P(NDFDATA(20),U)112687 "RTN","C0CNMED4",139,0)112688 . ;. N VAPROD S VAPROD=$P(NDFDATA(22),U)112689 "RTN","C0CNMED4",140,0)112690 . ;. ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""112691 "RTN","C0CNMED4",141,0)112692 . ;. ; and this will crash the call. So...112693 "RTN","C0CNMED4",142,0)112694 . ;. I NDFIEN="" S CONCDATA=""112695 "RTN","C0CNMED4",143,0)112696 . ;. E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)112697 "RTN","C0CNMED4",144,0)112698 . ;E S (NDFDATA,CONCDATA)="" ; This line is defensive programming to prevent undef errors.112699 "RTN","C0CNMED4",145,0)112700 . ;S @MAP@("MEDFORMTEXT")=$S($L(MEDIEN):$P(CONCDATA,U,1),1:"")112701 "RTN","C0CNMED4",146,0)112702 . S @MAP@("MEDFORMTEXT")=$G(MED("form@value"))112703 "RTN","C0CNMED4",147,0)112704 . ;S @MAP@("MEDCONCVALUE")=$S($L(MEDIEN):$P(CONCDATA,U,3),1:"")112705 "RTN","C0CNMED4",148,0)112706 . S @MAP@("MEDCONCVALUE")=$G(MED("doses.dose@dose"))112707 "RTN","C0CNMED4",149,0)112708 . ;S @MAP@("MEDCONCUNIT")=$S($L(MEDIEN):$P(CONCDATA,U,4),1:"")112709 "RTN","C0CNMED4",150,0)112710 . S @MAP@("MEDCONCUNIT")=$G(MED("doses.does@units"))112711 "RTN","C0CNMED4",151,0)112712 . ;S @MAP@("MEDQUANTITYVALUE")="" ; not provided for in Non-VA meds.112713 "RTN","C0CNMED4",152,0)112714 . S @MAP@("MEDQUANTITYVALUE")=$G(MED("doses.dose@unitsPerDose")) ;112715 "RTN","C0CNMED4",153,0)112716 . ; Oddly, there is no easy place to find the dispense unit.112717 "RTN","C0CNMED4",154,0)112718 . ; It's not included in the original call, so we have to go to the drug file.112719 "RTN","C0CNMED4",155,0)112720 . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")112721 112673 "RTN","C0CNMED4",156,0) 112722 . ; Node 14.5 is the Dispense Unit112674 . ;. D DATA^PSS50(MEDIEN,,,,,"QTY") 112723 112675 "RTN","C0CNMED4",157,0) 112724 . ; I $L(MEDIEN) D112676 . ;. N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN) 112725 112677 "RTN","C0CNMED4",158,0) 112726 . ;. D DATA^PSS50(MEDIEN,,,,,"QTY")112678 . ;. S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5) 112727 112679 "RTN","C0CNMED4",159,0) 112728 . ; . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)112680 . ;E S @MAP@("MEDQUANTITYUNIT")="" 112729 112681 "RTN","C0CNMED4",160,0) 112730 . ;. S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)112682 . S @MAP@("MEDQUANTITYUNIT")=$G(MED("dose.dose@unitsPerDose")) 112731 112683 "RTN","C0CNMED4",161,0) 112732 . ; E S @MAP@("MEDQUANTITYUNIT")=""112684 . ; 112733 112685 "RTN","C0CNMED4",162,0) 112734 . S @MAP@("MEDQUANTITYUNIT")=$G(MED("dose.dose@unitsPerDose"))112686 . ; --- START OF DIRECTIONS --- 112735 112687 "RTN","C0CNMED4",163,0) 112688 . ; Dosage is field 2, route is 3, schedule is 4 112689 "RTN","C0CNMED4",164,0) 112690 . ; These are all free text fields, and don't point to any files 112691 "RTN","C0CNMED4",165,0) 112692 . ; For that reason, I will use the field I never used before: 112693 "RTN","C0CNMED4",166,0) 112694 . ; MEDDIRECTIONDESCRIPTIONTEXT 112695 "RTN","C0CNMED4",167,0) 112696 . ;S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E") 112697 "RTN","C0CNMED4",168,0) 112698 . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=$G(MED("sig")) 112699 "RTN","C0CNMED4",169,0) 112700 . ; $G(MED("products.product.vaProduct@name")) 112701 "RTN","C0CNMED4",170,0) 112702 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4" ; means look in description text. See E2369-05. 112703 "RTN","C0CNMED4",171,0) 112704 . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")="" 112705 "RTN","C0CNMED4",172,0) 112706 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")="" 112707 "RTN","C0CNMED4",173,0) 112708 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")="" 112709 "RTN","C0CNMED4",174,0) 112710 . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")="" 112711 "RTN","C0CNMED4",175,0) 112712 . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")="" 112713 "RTN","C0CNMED4",176,0) 112714 . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")="" 112715 "RTN","C0CNMED4",177,0) 112716 . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")="" 112717 "RTN","C0CNMED4",178,0) 112718 . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")="" 112719 "RTN","C0CNMED4",179,0) 112720 . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")="" 112721 "RTN","C0CNMED4",180,0) 112722 . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")="" 112723 "RTN","C0CNMED4",181,0) 112724 . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")="" 112725 "RTN","C0CNMED4",182,0) 112726 . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")="" 112727 "RTN","C0CNMED4",183,0) 112728 . S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")="" 112729 "RTN","C0CNMED4",184,0) 112730 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")="" 112731 "RTN","C0CNMED4",185,0) 112732 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")="" 112733 "RTN","C0CNMED4",186,0) 112734 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")="" 112735 "RTN","C0CNMED4",187,0) 112736 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")="" 112737 "RTN","C0CNMED4",188,0) 112738 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")="" 112739 "RTN","C0CNMED4",189,0) 112740 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")="" 112741 "RTN","C0CNMED4",190,0) 112742 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")="" 112743 "RTN","C0CNMED4",191,0) 112744 . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")="" 112745 "RTN","C0CNMED4",192,0) 112746 . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")="" 112747 "RTN","C0CNMED4",193,0) 112748 . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")="" 112749 "RTN","C0CNMED4",194,0) 112736 112750 . ; 112737 "RTN","C0CNMED4",164,0)112738 . ; --- START OF DIRECTIONS ---112739 "RTN","C0CNMED4",165,0)112740 . ; Dosage is field 2, route is 3, schedule is 4112741 "RTN","C0CNMED4",166,0)112742 . ; These are all free text fields, and don't point to any files112743 "RTN","C0CNMED4",167,0)112744 . ; For that reason, I will use the field I never used before:112745 "RTN","C0CNMED4",168,0)112746 . ; MEDDIRECTIONDESCRIPTIONTEXT112747 "RTN","C0CNMED4",169,0)112748 . ;S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")112749 "RTN","C0CNMED4",170,0)112750 . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=$G(MED("sig"))112751 "RTN","C0CNMED4",171,0)112752 . ; $G(MED("products.product.vaProduct@name"))112753 "RTN","C0CNMED4",172,0)112754 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4" ; means look in description text. See E2369-05.112755 "RTN","C0CNMED4",173,0)112756 . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""112757 "RTN","C0CNMED4",174,0)112758 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""112759 "RTN","C0CNMED4",175,0)112760 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""112761 "RTN","C0CNMED4",176,0)112762 . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""112763 "RTN","C0CNMED4",177,0)112764 . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""112765 "RTN","C0CNMED4",178,0)112766 . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""112767 "RTN","C0CNMED4",179,0)112768 . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""112769 "RTN","C0CNMED4",180,0)112770 . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""112771 "RTN","C0CNMED4",181,0)112772 . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""112773 "RTN","C0CNMED4",182,0)112774 . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""112775 "RTN","C0CNMED4",183,0)112776 . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""112777 "RTN","C0CNMED4",184,0)112778 . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""112779 "RTN","C0CNMED4",185,0)112780 . S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""112781 "RTN","C0CNMED4",186,0)112782 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""112783 "RTN","C0CNMED4",187,0)112784 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""112785 "RTN","C0CNMED4",188,0)112786 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""112787 "RTN","C0CNMED4",189,0)112788 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""112789 "RTN","C0CNMED4",190,0)112790 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""112791 "RTN","C0CNMED4",191,0)112792 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""112793 "RTN","C0CNMED4",192,0)112794 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""112795 "RTN","C0CNMED4",193,0)112796 . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""112797 "RTN","C0CNMED4",194,0)112798 . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""112799 112751 "RTN","C0CNMED4",195,0) 112800 . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""112752 . ; --- END OF DIRECTIONS --- 112801 112753 "RTN","C0CNMED4",196,0) 112802 112754 . ; 112803 112755 "RTN","C0CNMED4",197,0) 112804 . ; --- END OF DIRECTIONS ---112756 . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105" 112805 112757 "RTN","C0CNMED4",198,0) 112806 . ; 112758 . ;S @MAP@("MEDPTINSTRUCTIONS")=MED(10,1) ; WP Field 112807 112759 "RTN","C0CNMED4",199,0) 112808 . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"112760 . S @MAP@("MEDPTINSTRUCTIONS")="" 112809 112761 "RTN","C0CNMED4",200,0) 112810 . ;S @MAP@("MED PTINSTRUCTIONS")=MED(10,1) ; WP Field112762 . ;S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field 112811 112763 "RTN","C0CNMED4",201,0) 112812 . S @MAP@("MED PTINSTRUCTIONS")=""112764 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")="" 112813 112765 "RTN","C0CNMED4",202,0) 112814 . ;S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field112766 . S @MAP@("MEDRFNO")="" 112815 112767 "RTN","C0CNMED4",203,0) 112816 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=""112768 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED")) 112817 112769 "RTN","C0CNMED4",204,0) 112818 . S @MAP@("MEDRFNO")=""112770 . K @RESULT 112819 112771 "RTN","C0CNMED4",205,0) 112820 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))112772 . D MAP^C0CXPATH(MINXML,MAP,RESULT) 112821 112773 "RTN","C0CNMED4",206,0) 112822 . K @RESULT112774 . ; D PARY^C0CXPATH(RESULT) 112823 112775 "RTN","C0CNMED4",207,0) 112824 . D MAP^C0CXPATH(MINXML,MAP,RESULT)112776 . ; MAPPING DIRECTIONS 112825 112777 "RTN","C0CNMED4",208,0) 112826 . ; D PARY^C0CXPATH(RESULT)112778 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE 112827 112779 "RTN","C0CNMED4",209,0) 112828 . ; MAPPING DIRECTIONS112780 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT 112829 112781 "RTN","C0CNMED4",210,0) 112830 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE112782 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1) 112831 112783 "RTN","C0CNMED4",211,0) 112832 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT112784 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions") 112833 112785 "RTN","C0CNMED4",212,0) 112834 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)112786 . ; N MDZ1,MDZNA 112835 112787 "RTN","C0CNMED4",213,0) 112836 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")112788 . N DIRCNT S DIRCNT=1 ; THERE ARE ALWAYS DIRECTIONS 112837 112789 "RTN","C0CNMED4",214,0) 112838 . ; N MDZ1,MDZNA112790 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS 112839 112791 "RTN","C0CNMED4",215,0) 112840 . N DIRCNT S DIRCNT=1 ; THERE ARE ALWAYS DIRECTIONS112792 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION 112841 112793 "RTN","C0CNMED4",216,0) 112842 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS112794 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1)) 112843 112795 "RTN","C0CNMED4",217,0) 112844 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION112796 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2) 112845 112797 "RTN","C0CNMED4",218,0) 112846 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))112798 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication") 112847 112799 "RTN","C0CNMED4",219,0) 112848 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)112800 . D:MEDCOUNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy 112849 112801 "RTN","C0CNMED4",220,0) 112850 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")112802 . D:MEDCOUNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML 112851 112803 "RTN","C0CNMED4",221,0) 112852 . D:MEDCOUNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy112804 N MEDTMP,MEDI 112853 112805 "RTN","C0CNMED4",222,0) 112854 . D:MEDCOUNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML112806 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 112855 112807 "RTN","C0CNMED4",223,0) 112856 N MEDTMP,MEDI112808 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 112857 112809 "RTN","C0CNMED4",224,0) 112858 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS112810 . W "MEDICATION MISSING ",! 112859 112811 "RTN","C0CNMED4",225,0) 112860 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@112812 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! 112861 112813 "RTN","C0CNMED4",226,0) 112862 . W "MEDICATION MISSING ",!112814 Q 112863 112815 "RTN","C0CNMED4",227,0) 112864 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!112865 "RTN","C0CNMED4",228,0)112866 Q112867 "RTN","C0CNMED4",229,0)112868 112816 ; 112869 112817 "RTN","C0CORSLT") 112870 0^91^B9 647157112818 0^91^B9272901 112871 112819 "RTN","C0CORSLT",1,0) 112872 112820 C0CORSLT ; CCDCCR/GPL - CCR/CCD PROCESSING ADDITIONAL RESULTS ; 06/27/11 112873 112821 "RTN","C0CORSLT",2,0) 112874 ;;1.2;C 0C;;May 11, 2012;Build 50112822 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 112875 112823 "RTN","C0CORSLT",3,0) 112876 112824 ;Copyright 2011 George Lilly. 112877 112825 "RTN","C0CORSLT",4,0) 112878 ; Licensed under the terms of the GNU General Public License.112826 ; 112879 112827 "RTN","C0CORSLT",5,0) 112880 ; See attached copy of the License.112828 ; This program is free software: you can redistribute it and/or modify 112881 112829 "RTN","C0CORSLT",6,0) 112882 ; 112830 ; it under the terms of the GNU Affero General Public License as 112883 112831 "RTN","C0CORSLT",7,0) 112884 ; This program is free software; you can redistribute it and/or modify112832 ; published by the Free Software Foundation, either version 3 of the 112885 112833 "RTN","C0CORSLT",8,0) 112886 ; it under the terms of the GNU General Public License as published by112834 ; License, or (at your option) any later version. 112887 112835 "RTN","C0CORSLT",9,0) 112888 ; the Free Software Foundation; either version 2 of the License, or112836 ; 112889 112837 "RTN","C0CORSLT",10,0) 112890 ; (at your option) any later version.112838 ; This program is distributed in the hope that it will be useful, 112891 112839 "RTN","C0CORSLT",11,0) 112892 ; 112840 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 112893 112841 "RTN","C0CORSLT",12,0) 112894 ; This program is distributed in the hope that it will be useful,112842 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 112895 112843 "RTN","C0CORSLT",13,0) 112896 ; but WITHOUT ANY WARRANTY; without even the implied warranty of112844 ; GNU Affero General Public License for more details. 112897 112845 "RTN","C0CORSLT",14,0) 112898 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the112846 ; 112899 112847 "RTN","C0CORSLT",15,0) 112900 ; GNU General Public License for more details.112848 ; You should have received a copy of the GNU Affero General Public License 112901 112849 "RTN","C0CORSLT",16,0) 112902 ; 112850 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 112903 112851 "RTN","C0CORSLT",17,0) 112904 ; You should have received a copy of the GNU General Public License along112852 ; 112905 112853 "RTN","C0CORSLT",18,0) 112906 ;with this program; if not, write to the Free Software Foundation, Inc.,112854 W "NO ENTRY FROM TOP",! 112907 112855 "RTN","C0CORSLT",19,0) 112908 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.112856 Q 112909 112857 "RTN","C0CORSLT",20,0) 112910 112858 ; 112911 112859 "RTN","C0CORSLT",21,0) 112912 W "NO ENTRY FROM TOP",! 112860 EN(ZVARS,DFN) ; LOOKS FOR CCR RESULTS THAT ARE NOT LAB RESULTS AND ADDS 112913 112861 "RTN","C0CORSLT",22,0) 112862 ; THEM TO THE LAB VARIABLES ZVARS IS PASSED BY REFERENCE 112863 "RTN","C0CORSLT",23,0) 112864 ; AN EXAMPLE IS EKG RESULTS THAT ARE FOUND IN NOTES AND CONSULTS 112865 "RTN","C0CORSLT",24,0) 112866 ; THIS IS CREATED FOR MU CERTIFICATION BY GPL 112867 "RTN","C0CORSLT",25,0) 112868 D ENTRY^C0CCPT(DFN,,,1) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE 112869 "RTN","C0CORSLT",26,0) 112870 N ZN ; RESULT NUMBER 112871 "RTN","C0CORSLT",27,0) 112872 S ZN=$O(@ZVARS@(""),-1) ; NEXT RESULT 112873 "RTN","C0CORSLT",28,0) 112874 N ZI S ZI="" 112875 "RTN","C0CORSLT",29,0) 112876 F S ZI=$O(VISIT(ZI)) Q:ZI="" D ; FOR EACH VISIT 112877 "RTN","C0CORSLT",30,0) 112878 . I $G(VISIT(ZI,"TEXT",1))["ECG DONE" D ; GOT AN ECG 112879 "RTN","C0CORSLT",31,0) 112880 . . S ZN=ZN+1 ; INCREMENT RESULT COUNT 112881 "RTN","C0CORSLT",32,0) 112882 . . N ZDATE,ZPRV,ZTXT 112883 "RTN","C0CORSLT",33,0) 112884 . . S ZDATE=$G(VISIT(ZI,"DATE",0)) ; DATE OF PROCEDURE 112885 "RTN","C0CORSLT",34,0) 112886 . . S ZPRV=$P($G(VISIT(ZI,"PRV",2)),"^",1) ;PROVIDER 112887 "RTN","C0CORSLT",35,0) 112888 . . S ZTXT=$P($G(VISIT(ZI,"TEXT",4)),"ECG RESULTS: ",2) 112889 "RTN","C0CORSLT",36,0) 112890 . . S @ZVARS@(ZN,"RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(ZDATE,"DT") 112891 "RTN","C0CORSLT",37,0) 112892 . . S @ZVARS@(ZN,"RESULTCODE")="34534-8" 112893 "RTN","C0CORSLT",38,0) 112894 . . S @ZVARS@(ZN,"RESULTCODINGSYSTEM")="LOINC" 112895 "RTN","C0CORSLT",39,0) 112896 . . S @ZVARS@(ZN,"RESULTDESCRIPTIONTEXT")="Electrocardiogram LOINC:34534-8" 112897 "RTN","C0CORSLT",40,0) 112898 . . S @ZVARS@(ZN,"RESULTOBJECTID")="RESULT"_ZN 112899 "RTN","C0CORSLT",41,0) 112900 . . S @ZVARS@(ZN,"RESULTSOURCEACTORID")="ACTORPROVIDER_"_ZPRV 112901 "RTN","C0CORSLT",42,0) 112902 . . S @ZVARS@(ZN,"RESULTSTATUS")="" 112903 "RTN","C0CORSLT",43,0) 112904 . . S @ZVARS@(ZN,"M","TEST",0)=1 112905 "RTN","C0CORSLT",44,0) 112906 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTCODEVALUE")="34534-8" 112907 "RTN","C0CORSLT",45,0) 112908 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTCODINGSYSTEM")="LOINC" 112909 "RTN","C0CORSLT",46,0) 112910 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(ZDATE,"DT") 112911 "RTN","C0CORSLT",47,0) 112912 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTDESCRIPTIONTEXT")="Electrocardiogram LOINC:34534-8" 112913 "RTN","C0CORSLT",48,0) 112914 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTFLAG")="" 112915 "RTN","C0CORSLT",49,0) 112916 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTNORMALDESCTEXT")="" 112917 "RTN","C0CORSLT",50,0) 112918 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTNORMALSOURCEACTORID")="ACTORORGANIZATION_VASTANUM" 112919 "RTN","C0CORSLT",51,0) 112920 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTOBJECTID")="RESULTTEST_ECG_"_ZN 112921 "RTN","C0CORSLT",52,0) 112922 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTSOURCEACTORID")="ACTORPROVIDER"_ZPRV 112923 "RTN","C0CORSLT",53,0) 112924 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTSTATUSTEXT")="F" 112925 "RTN","C0CORSLT",54,0) 112926 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTUNITS")="" 112927 "RTN","C0CORSLT",55,0) 112928 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTVALUE")=ZTXT 112929 "RTN","C0CORSLT",56,0) 112930 . . S @ZVARS@(0)=ZN ; UPDATE RESULTS COUNT 112931 "RTN","C0CORSLT",57,0) 112914 112932 Q 112915 "RTN","C0CORSLT",23,0)112916 ;112917 "RTN","C0CORSLT",24,0)112918 EN(ZVARS,DFN) ; LOOKS FOR CCR RESULTS THAT ARE NOT LAB RESULTS AND ADDS112919 "RTN","C0CORSLT",25,0)112920 ; THEM TO THE LAB VARIABLES ZVARS IS PASSED BY REFERENCE112921 "RTN","C0CORSLT",26,0)112922 ; AN EXAMPLE IS EKG RESULTS THAT ARE FOUND IN NOTES AND CONSULTS112923 "RTN","C0CORSLT",27,0)112924 ; THIS IS CREATED FOR MU CERTIFICATION BY GPL112925 "RTN","C0CORSLT",28,0)112926 D ENTRY^C0CCPT(DFN,,,1) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE112927 "RTN","C0CORSLT",29,0)112928 N ZN ; RESULT NUMBER112929 "RTN","C0CORSLT",30,0)112930 S ZN=$O(@ZVARS@(""),-1) ; NEXT RESULT112931 "RTN","C0CORSLT",31,0)112932 N ZI S ZI=""112933 "RTN","C0CORSLT",32,0)112934 F S ZI=$O(VISIT(ZI)) Q:ZI="" D ; FOR EACH VISIT112935 "RTN","C0CORSLT",33,0)112936 . I $G(VISIT(ZI,"TEXT",1))["ECG DONE" D ; GOT AN ECG112937 "RTN","C0CORSLT",34,0)112938 . . S ZN=ZN+1 ; INCREMENT RESULT COUNT112939 "RTN","C0CORSLT",35,0)112940 . . N ZDATE,ZPRV,ZTXT112941 "RTN","C0CORSLT",36,0)112942 . . S ZDATE=$G(VISIT(ZI,"DATE",0)) ; DATE OF PROCEDURE112943 "RTN","C0CORSLT",37,0)112944 . . S ZPRV=$P($G(VISIT(ZI,"PRV",2)),"^",1) ;PROVIDER112945 "RTN","C0CORSLT",38,0)112946 . . S ZTXT=$P($G(VISIT(ZI,"TEXT",4)),"ECG RESULTS: ",2)112947 "RTN","C0CORSLT",39,0)112948 . . S @ZVARS@(ZN,"RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(ZDATE,"DT")112949 "RTN","C0CORSLT",40,0)112950 . . S @ZVARS@(ZN,"RESULTCODE")="34534-8"112951 "RTN","C0CORSLT",41,0)112952 . . S @ZVARS@(ZN,"RESULTCODINGSYSTEM")="LOINC"112953 "RTN","C0CORSLT",42,0)112954 . . S @ZVARS@(ZN,"RESULTDESCRIPTIONTEXT")="Electrocardiogram LOINC:34534-8"112955 "RTN","C0CORSLT",43,0)112956 . . S @ZVARS@(ZN,"RESULTOBJECTID")="RESULT"_ZN112957 "RTN","C0CORSLT",44,0)112958 . . S @ZVARS@(ZN,"RESULTSOURCEACTORID")="ACTORPROVIDER_"_ZPRV112959 "RTN","C0CORSLT",45,0)112960 . . S @ZVARS@(ZN,"RESULTSTATUS")=""112961 "RTN","C0CORSLT",46,0)112962 . . S @ZVARS@(ZN,"M","TEST",0)=1112963 "RTN","C0CORSLT",47,0)112964 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTCODEVALUE")="34534-8"112965 "RTN","C0CORSLT",48,0)112966 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTCODINGSYSTEM")="LOINC"112967 "RTN","C0CORSLT",49,0)112968 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(ZDATE,"DT")112969 "RTN","C0CORSLT",50,0)112970 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTDESCRIPTIONTEXT")="Electrocardiogram LOINC:34534-8"112971 "RTN","C0CORSLT",51,0)112972 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTFLAG")=""112973 "RTN","C0CORSLT",52,0)112974 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTNORMALDESCTEXT")=""112975 "RTN","C0CORSLT",53,0)112976 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTNORMALSOURCEACTORID")="ACTORORGANIZATION_VASTANUM"112977 "RTN","C0CORSLT",54,0)112978 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTOBJECTID")="RESULTTEST_ECG_"_ZN112979 "RTN","C0CORSLT",55,0)112980 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTSOURCEACTORID")="ACTORPROVIDER"_ZPRV112981 "RTN","C0CORSLT",56,0)112982 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTSTATUSTEXT")="F"112983 "RTN","C0CORSLT",57,0)112984 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTUNITS")=""112985 112933 "RTN","C0CORSLT",58,0) 112986 . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTVALUE")=ZTXT112934 ; 112987 112935 "RTN","C0CORSLT",59,0) 112988 . . S @ZVARS@(0)=ZN ; UPDATE RESULTS COUNT 112936 OLD ; OLD CODE FOR OTHER WAYS OF DOING THE ECG 112989 112937 "RTN","C0CORSLT",60,0) 112938 ; FOR CERTIFICATION - SAVE EKG RESULTS gpl 112939 "RTN","C0CORSLT",61,0) 112940 W !,"CPT=",ZCPT 112941 "RTN","C0CORSLT",62,0) 112942 I ZCPT["93000" D ; THIS IS AN EKG 112943 "RTN","C0CORSLT",63,0) 112944 . D RNF1TO2^C0CRNF(C0CPRSLT,"ZRNF") ; SAVE FOR LABS 112945 "RTN","C0CORSLT",64,0) 112946 . M ^GPL("RNF2")=@C0CPRSLT 112947 "RTN","C0CORSLT",65,0) 112990 112948 Q 112991 "RTN","C0CORSLT",61,0)112992 ;112993 "RTN","C0CORSLT",62,0)112994 OLD ; OLD CODE FOR OTHER WAYS OF DOING THE ECG112995 "RTN","C0CORSLT",63,0)112996 ; FOR CERTIFICATION - SAVE EKG RESULTS gpl112997 "RTN","C0CORSLT",64,0)112998 W !,"CPT=",ZCPT112999 "RTN","C0CORSLT",65,0)113000 I ZCPT["93000" D ; THIS IS AN EKG113001 112949 "RTN","C0CORSLT",66,0) 113002 . D RNF1TO2^C0CRNF(C0CPRSLT,"ZRNF") ; SAVE FOR LABS113003 "RTN","C0CORSLT",67,0)113004 . M ^GPL("RNF2")=@C0CPRSLT113005 "RTN","C0CORSLT",68,0)113006 Q113007 "RTN","C0CORSLT",69,0)113008 112950 ; 113009 112951 "RTN","C0COVREL") 113010 0^102^B1 8541513112952 0^102^B19589538 113011 112953 "RTN","C0COVREL",1,0) 113012 112954 C0COVREL ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15 113013 112955 "RTN","C0COVREL",2,0) 113014 ;;1.2;C0C;;May 11, 2012;Build 50112956 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 113015 112957 "RTN","C0COVREL",3,0) 113016 LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB 112958 ; (C) ELN 2012 113017 112959 "RTN","C0COVREL",4,0) 113018 N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CLB2,C0CLB,C0CLI,C0CLOBX,C0CTAB,C0CTYP112960 ; 113019 112961 "RTN","C0COVREL",5,0) 113020 I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS112962 ; This program is free software: you can redistribute it and/or modify 113021 112963 "RTN","C0COVREL",6,0) 113022 I '$D(C0CQT) S C0CQT=0112964 ; it under the terms of the GNU Affero General Public License as 113023 112965 "RTN","C0COVREL",7,0) 113024 I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT112966 ; published by the Free Software Foundation, either version 3 of the 113025 112967 "RTN","C0COVREL",8,0) 113026 I '$D(^TMP("C0CCCR","LABTBL",0)) D SETTBL^C0COVREU ;INITIALIZE LAB TABLE112968 ; License, or (at your option) any later version. 113027 112969 "RTN","C0COVREL",9,0) 113028 I ^TMP("C0CCCR","LABTBL",0)'="V3" D SETTBL^C0COVREU ;NEED NEWEST VERSION112970 ; 113029 112971 "RTN","C0COVREL",10,0) 113030 I '$D(^TMP("HLS",$J,1)) D GHL7^C0COVREU ; GET HL7 MGS IF NOT ALREADY DONE112972 ; This program is distributed in the hope that it will be useful, 113031 112973 "RTN","C0COVREL",11,0) 113032 S C0CTAB=$NA(^TMP("C0CCCR","LABTBL")) ; BASE OF OBX TABLE112974 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 113033 112975 "RTN","C0COVREL",12,0) 113034 S C0CHB=$NA(^TMP("HLS",$J))112976 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 113035 112977 "RTN","C0COVREL",13,0) 113036 S C0CI=""112978 ; GNU Affero General Public License for more details. 113037 112979 "RTN","C0COVREL",14,0) 113038 S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT112980 ; 113039 112981 "RTN","C0COVREL",15,0) 113040 F S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI="" D ; FOR ALL RECORDS IN HL7 MSG112982 ; You should have received a copy of the GNU Affero General Public License 113041 112983 "RTN","C0COVREL",16,0) 113042 . K C0CVAR,XV,C0CX1,C0CX2 ; CLEAR OUT VARIABLE VALUES112984 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 113043 112985 "RTN","C0COVREL",17,0) 113044 . S C0CTYP=$P(@C0CHB@(C0CI),"|",1)112986 ; 113045 112987 "RTN","C0COVREL",18,0) 113046 . D LTYP^C0COVREU(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT) 112988 LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB 113047 112989 "RTN","C0COVREL",19,0) 113048 . M XV=C0CVAR ;112990 N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CLB2,C0CLB,C0CLI,C0CLOBX,C0CTAB,C0CTYP 113049 112991 "RTN","C0COVREL",20,0) 113050 . I C0CTYP="OBR" D ; BEGINNING OF NEW SECTION112992 I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS 113051 112993 "RTN","C0COVREL",21,0) 113052 . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT112994 I '$D(C0CQT) S C0CQT=0 113053 112995 "RTN","C0COVREL",22,0) 113054 . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT112996 I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT 113055 112997 "RTN","C0COVREL",23,0) 113056 . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS112998 I '$D(^TMP("C0CCCR","LABTBL",0)) D SETTBL^C0COVREU ;INITIALIZE LAB TABLE 113057 112999 "RTN","C0COVREL",24,0) 113058 . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI113000 I ^TMP("C0CCCR","LABTBL",0)'="V3" D SETTBL^C0COVREU ;NEED NEWEST VERSION 113059 113001 "RTN","C0COVREL",25,0) 113060 . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR113002 I '$D(^TMP("HLS",$J,1)) D GHL7^C0COVREU ; GET HL7 MGS IF NOT ALREADY DONE 113061 113003 "RTN","C0COVREL",26,0) 113062 . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)113004 S C0CTAB=$NA(^TMP("C0CCCR","LABTBL")) ; BASE OF OBX TABLE 113063 113005 "RTN","C0COVREL",27,0) 113064 . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT113006 S C0CHB=$NA(^TMP("HLS",$J)) 113065 113007 "RTN","C0COVREL",28,0) 113066 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL113008 S C0CI="" 113067 113009 "RTN","C0COVREL",29,0) 113068 . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME113010 S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT 113069 113011 "RTN","C0COVREL",30,0) 113070 . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS113012 F S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI="" D ; FOR ALL RECORDS IN HL7 MSG 113071 113013 "RTN","C0COVREL",31,0) 113072 . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION113014 . K C0CVAR,XV,C0CX1,C0CX2 ; CLEAR OUT VARIABLE VALUES 113073 113015 "RTN","C0COVREL",32,0) 113074 . I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX113016 . S C0CTYP=$P(@C0CHB@(C0CI),"|",1) 113075 113017 "RTN","C0COVREL",33,0) 113076 . . ; RESULTTESTCODEVALUE AND RESULTTESTDESCRIPTIONTEXT113018 . D LTYP^C0COVREU(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT) 113077 113019 "RTN","C0COVREL",34,0) 113078 . . I C0CVAR("C3")="LN" D ; PRIMARY CODE IS LOINC113020 . M XV=C0CVAR ; 113079 113021 "RTN","C0COVREL",35,0) 113080 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE LOINC CODE VALUE113022 . I C0CTYP="OBR" D ; BEGINNING OF NEW SECTION 113081 113023 "RTN","C0COVREL",36,0) 113082 . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC113024 . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT 113083 113025 "RTN","C0COVREL",37,0) 113084 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT113026 . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT 113085 113027 "RTN","C0COVREL",38,0) 113086 . . E I C0CVAR("C6")="LN" D ; SECONDARY CODE IS LOINC113028 . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS 113087 113029 "RTN","C0COVREL",39,0) 113088 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; THE LOINC CODE VALUE113030 . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI 113089 113031 "RTN","C0COVREL",40,0) 113090 . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC113032 . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR 113091 113033 "RTN","C0COVREL",41,0) 113092 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; DESCRIPTION TEXT113034 . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1) 113093 113035 "RTN","C0COVREL",42,0) 113094 . . E I C0CVAR("C6")'="" D ; NO LOINC CODES, USE SECONDARY IF PRESENT113036 . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT 113095 113037 "RTN","C0COVREL",43,0) 113096 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE113038 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL 113097 113039 "RTN","C0COVREL",44,0) 113098 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME113040 . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME 113099 113041 "RTN","C0COVREL",45,0) 113100 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT113042 . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS 113101 113043 "RTN","C0COVREL",46,0) 113102 . . E D ; NO SECONDARY, USE PRIMARY113044 . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION 113103 113045 "RTN","C0COVREL",47,0) 113104 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE113046 . I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX 113105 113047 "RTN","C0COVREL",48,0) 113106 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME113048 . . ; RESULTTESTCODEVALUE AND RESULTTESTDESCRIPTIONTEXT 113107 113049 "RTN","C0COVREL",49,0) 113108 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT113050 . . I C0CVAR("C3")="LN" D ; PRIMARY CODE IS LOINC 113109 113051 "RTN","C0COVREL",50,0) 113110 . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;113052 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE LOINC CODE VALUE 113111 113053 "RTN","C0COVREL",51,0) 113112 . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG113054 . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC 113113 113055 "RTN","C0COVREL",52,0) 113114 . . S C0CZG=XV("RESULTTESTVALUE")113056 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT 113115 113057 "RTN","C0COVREL",53,0) 113116 . . S XV("RESULTTESTVALUE")=C0CZG113058 . . E I C0CVAR("C6")="LN" D ; SECONDARY CODE IS LOINC 113117 113059 "RTN","C0COVREL",54,0) 113118 . I C0CTYP="OBX" D ; PROCESS TEST RESULTS113060 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; THE LOINC CODE VALUE 113119 113061 "RTN","C0COVREL",55,0) 113120 . . I C0CLOBX=0 D ; FIRST TEST RESULT FOR THIS SECTION113062 . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC 113121 113063 "RTN","C0COVREL",56,0) 113122 . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS113064 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; DESCRIPTION TEXT 113123 113065 "RTN","C0COVREL",57,0) 113124 . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT113066 . . E I C0CVAR("C6")'="" D ; NO LOINC CODES, USE SECONDARY IF PRESENT 113125 113067 "RTN","C0COVREL",58,0) 113126 . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT113068 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE 113127 113069 "RTN","C0COVREL",59,0) 113128 . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX113070 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME 113129 113071 "RTN","C0COVREL",60,0) 113130 . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE113072 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT 113131 113073 "RTN","C0COVREL",61,0) 113132 . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER113074 . . E D ; NO SECONDARY, USE PRIMARY 113133 113075 "RTN","C0COVREL",62,0) 113134 . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2113076 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE 113135 113077 "RTN","C0COVREL",63,0) 113136 . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")113078 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME 113137 113079 "RTN","C0COVREL",64,0) 113138 . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT113080 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT 113139 113081 "RTN","C0COVREL",65,0) 113140 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL113082 . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ; 113141 113083 "RTN","C0COVREL",66,0) 113142 . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME113084 . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG 113143 113085 "RTN","C0COVREL",67,0) 113144 . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES113086 . . S C0CZG=XV("RESULTTESTVALUE") 113145 113087 "RTN","C0COVREL",68,0) 113146 . I 'C0CQT D ;113088 . . S XV("RESULTTESTVALUE")=C0CZG 113147 113089 "RTN","C0COVREL",69,0) 113148 . . W C0CI," ",C0CTYP,!113090 . I C0CTYP="OBX" D ; PROCESS TEST RESULTS 113149 113091 "RTN","C0COVREL",70,0) 113150 Q 113092 . . I C0CLOBX=0 D ; FIRST TEST RESULT FOR THIS SECTION 113093 "RTN","C0COVREL",71,0) 113094 . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS 113095 "RTN","C0COVREL",72,0) 113096 . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT 113097 "RTN","C0COVREL",73,0) 113098 . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT 113099 "RTN","C0COVREL",74,0) 113100 . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX 113101 "RTN","C0COVREL",75,0) 113102 . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE 113103 "RTN","C0COVREL",76,0) 113104 . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER 113105 "RTN","C0COVREL",77,0) 113106 . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2 113107 "RTN","C0COVREL",78,0) 113108 . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID") 113109 "RTN","C0COVREL",79,0) 113110 . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT 113111 "RTN","C0COVREL",80,0) 113112 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL 113113 "RTN","C0COVREL",81,0) 113114 . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME 113115 "RTN","C0COVREL",82,0) 113116 . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES 113117 "RTN","C0COVREL",83,0) 113118 . I 'C0CQT D ; 113119 "RTN","C0COVREL",84,0) 113120 . . W C0CI," ",C0CTYP,! 113121 "RTN","C0COVREL",85,0) 113122 Q 113151 113123 "RTN","C0COVRES") 113152 0^103^B2 4677897113124 0^103^B23183700 113153 113125 "RTN","C0COVRES",1,0) 113154 113126 C0COVRES ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15 113155 113127 "RTN","C0COVRES",2,0) 113156 ;;1.2;C0C;;May 11, 2012;Build 50113128 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 113157 113129 "RTN","C0COVRES",3,0) 113158 ;113130 ; (C) ELN 2012 113159 113131 "RTN","C0COVRES",4,0) 113132 ; 113133 "RTN","C0COVRES",5,0) 113134 ; This program is free software: you can redistribute it and/or modify 113135 "RTN","C0COVRES",6,0) 113136 ; it under the terms of the GNU Affero General Public License as 113137 "RTN","C0COVRES",7,0) 113138 ; published by the Free Software Foundation, either version 3 of the 113139 "RTN","C0COVRES",8,0) 113140 ; License, or (at your option) any later version. 113141 "RTN","C0COVRES",9,0) 113142 ; 113143 "RTN","C0COVRES",10,0) 113144 ; This program is distributed in the hope that it will be useful, 113145 "RTN","C0COVRES",11,0) 113146 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 113147 "RTN","C0COVRES",12,0) 113148 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 113149 "RTN","C0COVRES",13,0) 113150 ; GNU Affero General Public License for more details. 113151 "RTN","C0COVRES",14,0) 113152 ; 113153 "RTN","C0COVRES",15,0) 113154 ; You should have received a copy of the GNU Affero General Public License 113155 "RTN","C0COVRES",16,0) 113156 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 113157 "RTN","C0COVRES",17,0) 113158 ; 113159 "RTN","C0COVRES",18,0) 113160 113160 MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT 113161 "RTN","C0COVRES",5,0)113162 ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR113163 "RTN","C0COVRES",6,0)113164 ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME113165 "RTN","C0COVRES",7,0)113166 ; MIXML IS THE TEMPLATE TO USE113167 "RTN","C0COVRES",8,0)113168 ; MOXML IS THE OUTPUT XML ARRAY113169 "RTN","C0COVRES",9,0)113170 ; DFN IS THE PATIENT RECORD NUMBER113171 "RTN","C0COVRES",10,0)113172 N C0COXML,C0CO,C0CV,C0CIXML113173 "RTN","C0COVRES",11,0)113174 I '$D(MIVAR) S C0CV="" ;DEFAULT113175 "RTN","C0COVRES",12,0)113176 E S C0CV=MIVAR ;PASSED VARIABLE ARRAY113177 "RTN","C0COVRES",13,0)113178 I '$D(MIXML) S C0CIXML="" ;DEFAULT113179 "RTN","C0COVRES",14,0)113180 E S C0CIXML=MIXML ;PASSED INPUT XML113181 "RTN","C0COVRES",15,0)113182 D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK113183 "RTN","C0COVRES",16,0)113184 I '$D(MOXML) S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT113185 "RTN","C0COVRES",17,0)113186 E S C0CO=MOXML113187 "RTN","C0COVRES",18,0)113188 M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT113189 113161 "RTN","C0COVRES",19,0) 113190 Q113162 ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR 113191 113163 "RTN","C0COVRES",20,0) 113164 ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME 113165 "RTN","C0COVRES",21,0) 113166 ; MIXML IS THE TEMPLATE TO USE 113167 "RTN","C0COVRES",22,0) 113168 ; MOXML IS THE OUTPUT XML ARRAY 113169 "RTN","C0COVRES",23,0) 113170 ; DFN IS THE PATIENT RECORD NUMBER 113171 "RTN","C0COVRES",24,0) 113172 N C0COXML,C0CO,C0CV,C0CIXML 113173 "RTN","C0COVRES",25,0) 113174 I '$D(MIVAR) S C0CV="" ;DEFAULT 113175 "RTN","C0COVRES",26,0) 113176 E S C0CV=MIVAR ;PASSED VARIABLE ARRAY 113177 "RTN","C0COVRES",27,0) 113178 I '$D(MIXML) S C0CIXML="" ;DEFAULT 113179 "RTN","C0COVRES",28,0) 113180 E S C0CIXML=MIXML ;PASSED INPUT XML 113181 "RTN","C0COVRES",29,0) 113182 D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK 113183 "RTN","C0COVRES",30,0) 113184 I '$D(MOXML) S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT 113185 "RTN","C0COVRES",31,0) 113186 E S C0CO=MOXML 113187 "RTN","C0COVRES",32,0) 113188 M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT 113189 "RTN","C0COVRES",33,0) 113190 Q 113191 "RTN","C0COVRES",34,0) 113192 113192 RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS 113193 "RTN","C0COVRES",21,0)113194 ; RTN IS PASSED BY REFERENCE113195 "RTN","C0COVRES",22,0)113196 N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES113197 "RTN","C0COVRES",23,0)113198 N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE113199 "RTN","C0COVRES",24,0)113200 I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING113201 "RTN","C0COVRES",25,0)113202 I RMIXML="" D ; INPUT XML NOT PASSED113203 "RTN","C0COVRES",26,0)113204 . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE113205 "RTN","C0COVRES",27,0)113206 . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")113207 "RTN","C0COVRES",28,0)113208 . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE113209 "RTN","C0COVRES",29,0)113210 E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE113211 "RTN","C0COVRES",30,0)113212 I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED113213 "RTN","C0COVRES",31,0)113214 . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION113215 "RTN","C0COVRES",32,0)113216 E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS113217 "RTN","C0COVRES",33,0)113218 D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE113219 "RTN","C0COVRES",34,0)113220 D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ113221 113193 "RTN","C0COVRES",35,0) 113222 D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE113194 ; RTN IS PASSED BY REFERENCE 113223 113195 "RTN","C0COVRES",36,0) 113224 D EXTRACT("C0CT",DFN,) ; LAB EXTRACT113196 N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES 113225 113197 "RTN","C0COVRES",37,0) 113226 D EXTRACT^C0CRARPT("C0CT",DFN,) ; RAD REPORT EXTRACT113198 N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE 113227 113199 "RTN","C0COVRES",38,0) 113228 ;OHUM/RUT 3111221113200 I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING 113229 113201 "RTN","C0COVRES",39,0) 113230 ;D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT113202 I RMIXML="" D ; INPUT XML NOT PASSED 113231 113203 "RTN","C0COVRES",40,0) 113232 I ^TMP("C0CCCR","TIULIMIT")'="" D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT113204 . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE 113233 113205 "RTN","C0COVRES",41,0) 113234 ;OHUM/RUT113206 . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R") 113235 113207 "RTN","C0COVRES",42,0) 113236 I '$D(@C0CV@(0)) D Q ; NO VARS THERE113208 . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE 113237 113209 "RTN","C0COVRES",43,0) 113238 . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR113210 E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE 113239 113211 "RTN","C0COVRES",44,0) 113240 ; NO RESULTS113212 I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED 113241 113213 "RTN","C0COVRES",45,0) 113242 I @C0CV@(0)=0 S RTN(0)=0 Q113214 . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION 113243 113215 "RTN","C0COVRES",46,0) 113244 S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))113216 E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS 113245 113217 "RTN","C0COVRES",47,0) 113246 K @RIMVARS113218 D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE 113247 113219 "RTN","C0COVRES",48,0) 113248 ;M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH113220 D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ 113249 113221 "RTN","C0COVRES",49,0) 113250 N C0CI,C0CIN,C0CJ,C0CJN,C0CJE,C0CJS,C0CMAP,C0CTMAP,C0CTMP113222 D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE 113251 113223 "RTN","C0COVRES",50,0) 113252 S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)113224 D EXTRACT("C0CT",DFN,) ; LAB EXTRACT 113253 113225 "RTN","C0COVRES",51,0) 113254 N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT113226 D EXTRACT^C0CRARPT("C0CT",DFN,) ; RAD REPORT EXTRACT 113255 113227 "RTN","C0COVRES",52,0) 113256 N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA113228 ;OHUM/RUT 3111221 113257 113229 "RTN","C0COVRES",53,0) 113258 N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END113230 ;D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT 113259 113231 "RTN","C0COVRES",54,0) 113260 ; TO IMPROVE PERFORMANCE113232 I ^TMP("C0CCCR","TIULIMIT")'="" D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT 113261 113233 "RTN","C0COVRES",55,0) 113262 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>113234 ;OHUM/RUT 113263 113235 "RTN","C0COVRES",56,0) 113264 F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES113236 I '$D(@C0CV@(0)) D Q ; NO VARS THERE 113265 113237 "RTN","C0COVRES",57,0) 113266 . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES113238 . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR 113267 113239 "RTN","C0COVRES",58,0) 113268 . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST113240 ; NO RESULTS 113269 113241 "RTN","C0COVRES",59,0) 113270 . S C0CMAP=$NA(@C0CV@(C0CI)) ;MAPPING FOR TEST REQUEST GOES HERE113242 I @C0CV@(0)=0 S RTN(0)=0 Q 113271 113243 "RTN","C0COVRES",60,0) 113272 . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA113244 S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS")) 113273 113245 "RTN","C0COVRES",61,0) 113274 . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>113246 K @RIMVARS 113275 113247 "RTN","C0COVRES",62,0) 113276 . I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST113248 ;M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH 113277 113249 "RTN","C0COVRES",63,0) 113278 . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS113250 N C0CI,C0CIN,C0CJ,C0CJN,C0CJE,C0CJS,C0CMAP,C0CTMAP,C0CTMP 113279 113251 "RTN","C0COVRES",64,0) 113280 . . K C0CTO ; CLEAR OUTPUT VARIABLE113252 S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR) 113281 113253 "RTN","C0COVRES",65,0) 113282 . . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT113254 N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT 113283 113255 "RTN","C0COVRES",66,0) 113284 . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS113256 N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA 113285 113257 "RTN","C0COVRES",67,0) 113286 . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS113258 N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END 113287 113259 "RTN","C0COVRES",68,0) 113288 . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;113260 ; TO IMPROVE PERFORMANCE 113289 113261 "RTN","C0COVRES",69,0) 113290 . . . D XMAP^C0CTIU1("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP113262 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results> 113291 113263 "RTN","C0COVRES",70,0) 113292 . . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE <Test>113264 F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES 113293 113265 "RTN","C0COVRES",71,0) 113294 . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;</Test>113266 . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES 113295 113267 "RTN","C0COVRES",72,0) 113296 . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML113268 . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST 113297 113269 "RTN","C0COVRES",73,0) 113298 . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST113270 . S C0CMAP=$NA(@C0CV@(C0CI)) ;MAPPING FOR TEST REQUEST GOES HERE 113299 113271 "RTN","C0COVRES",74,0) 113300 . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>113272 . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA 113301 113273 "RTN","C0COVRES",75,0) 113302 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>113274 . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test> 113303 113275 "RTN","C0COVRES",76,0) 113304 D BUILD^C0CTIU1("C0CRBLD","RTN") ;RENDER THE XML113276 . I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST 113305 113277 "RTN","C0COVRES",77,0) 113306 K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE113278 . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS 113307 113279 "RTN","C0COVRES",78,0) 113308 Q113280 . . K C0CTO ; CLEAR OUTPUT VARIABLE 113309 113281 "RTN","C0COVRES",79,0) 113282 . . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT 113283 "RTN","C0COVRES",80,0) 113284 . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS 113285 "RTN","C0COVRES",81,0) 113286 . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS 113287 "RTN","C0COVRES",82,0) 113288 . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ; 113289 "RTN","C0COVRES",83,0) 113290 . . . D XMAP^C0CTIU1("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP 113291 "RTN","C0COVRES",84,0) 113292 . . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE <Test> 113293 "RTN","C0COVRES",85,0) 113294 . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;</Test> 113295 "RTN","C0COVRES",86,0) 113296 . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML 113297 "RTN","C0COVRES",87,0) 113298 . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST 113299 "RTN","C0COVRES",88,0) 113300 . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result> 113301 "RTN","C0COVRES",89,0) 113302 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results> 113303 "RTN","C0COVRES",90,0) 113304 D BUILD^C0CTIU1("C0CRBLD","RTN") ;RENDER THE XML 113305 "RTN","C0COVRES",91,0) 113306 K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE 113307 "RTN","C0COVRES",92,0) 113308 Q 113309 "RTN","C0COVRES",93,0) 113310 113310 EXTRACT(ILXML,DFN,OLXML) ; EXTRACT LABS INTO THE C0CLVAR GLOBAL 113311 "RTN","C0COVRES",80,0)113312 ; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED113313 "RTN","C0COVRES",81,0)113314 N C0CNSSN,C0CLB ; IS THERE AN SSN FLAG113315 "RTN","C0COVRES",82,0)113316 S C0CNSSN=0113317 "RTN","C0COVRES",83,0)113318 S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS113319 "RTN","C0COVRES",84,0)113320 D GHL7^C0COVREU ; GET HL7 MESSAGE FOR THIS PATIENT113321 "RTN","C0COVRES",85,0)113322 I C0CNSSN=1 D Q ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT113323 "RTN","C0COVRES",86,0)113324 . S @C0CLB@(0)=0113325 "RTN","C0COVRES",87,0)113326 ;K @C0CLB ; CLEAR OUT OLD VARS IF ANY113327 "RTN","C0COVRES",88,0)113328 N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG113329 "RTN","C0COVRES",89,0)113330 S C0CQT=1 ; SURPRESS LISTING113331 "RTN","C0COVRES",90,0)113332 D LIST^C0COVREL ; EXTRACT THE VARIABLES113333 "RTN","C0COVRES",91,0)113334 S C0CQT=QTSAV ; RESET SILENT FLAG113335 "RTN","C0COVRES",92,0)113336 K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT113337 "RTN","C0COVRES",93,0)113338 I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS113339 113311 "RTN","C0COVRES",94,0) 113340 Q 113312 ; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED 113313 "RTN","C0COVRES",95,0) 113314 N C0CNSSN,C0CLB ; IS THERE AN SSN FLAG 113315 "RTN","C0COVRES",96,0) 113316 S C0CNSSN=0 113317 "RTN","C0COVRES",97,0) 113318 S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS 113319 "RTN","C0COVRES",98,0) 113320 D GHL7^C0COVREU ; GET HL7 MESSAGE FOR THIS PATIENT 113321 "RTN","C0COVRES",99,0) 113322 I C0CNSSN=1 D Q ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT 113323 "RTN","C0COVRES",100,0) 113324 . S @C0CLB@(0)=0 113325 "RTN","C0COVRES",101,0) 113326 ;K @C0CLB ; CLEAR OUT OLD VARS IF ANY 113327 "RTN","C0COVRES",102,0) 113328 N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG 113329 "RTN","C0COVRES",103,0) 113330 S C0CQT=1 ; SURPRESS LISTING 113331 "RTN","C0COVRES",104,0) 113332 D LIST^C0COVREL ; EXTRACT THE VARIABLES 113333 "RTN","C0COVRES",105,0) 113334 S C0CQT=QTSAV ; RESET SILENT FLAG 113335 "RTN","C0COVRES",106,0) 113336 K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT 113337 "RTN","C0COVRES",107,0) 113338 I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS 113339 "RTN","C0COVRES",108,0) 113340 Q 113341 113341 "RTN","C0COVREU") 113342 0^104^B7 9442187113342 0^104^B78173648 113343 113343 "RTN","C0COVREU",1,0) 113344 113344 C0COVREU ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15 113345 113345 "RTN","C0COVREU",2,0) 113346 ;;1.2;C0C;;May 11, 2012;Build 50113346 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 113347 113347 "RTN","C0COVREU",3,0) 113348 113348 ; 113349 113349 "RTN","C0COVREU",4,0) 113350 113350 ; 113351 113351 "RTN","C0COVREU",5,0) 113352 GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT 113352 ; This program is free software: you can redistribute it and/or modify 113353 113353 "RTN","C0COVREU",6,0) 113354 N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR,C0CLLMT,C0CLSTRT113354 ; it under the terms of the GNU Affero General Public License as 113355 113355 "RTN","C0COVREU",7,0) 113356 ; SET UP FOR LAB API CALL113356 ; published by the Free Software Foundation, either version 3 of the 113357 113357 "RTN","C0COVREU",8,0) 113358 S C0CPTID=$$SSN^C0CDPT(DFN) ; GET THE SSN FOR THIS PATIENT113358 ; License, or (at your option) any later version. 113359 113359 "RTN","C0COVREU",9,0) 113360 I C0CPTID="" D Q ; NO SSN, COMPLAIN AND QUIT113360 ; 113361 113361 "RTN","C0COVREU",10,0) 113362 . W "LAB LOOKUP FAILED, NO SSN",!113362 ; This program is distributed in the hope that it will be useful, 113363 113363 "RTN","C0COVREU",11,0) 113364 . S C0CNSSN=1 ; SET NO SSN FLAG113364 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 113365 113365 "RTN","C0COVREU",12,0) 113366 S C0CSPC="*" ; LOOKING FOR ALL LABS113366 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 113367 113367 "RTN","C0COVREU",13,0) 113368 ;I $D(^TMP("C0CCCR","RPMS")) D ; RUNNING RPMS113368 ; GNU Affero General Public License for more details. 113369 113369 "RTN","C0COVREU",14,0) 113370 ;. D DT^DILF(,"T-365",.C0CSDT) ; START DATE ONE YEAR AGO TO LIMIT VOLUME113370 ; 113371 113371 "RTN","C0COVREU",15,0) 113372 ;E D DT^DILF(,"T-5000",.C0CSDT) ; START DATE LONG AGO TO GET EVERYTHING113372 ; You should have received a copy of the GNU Affero General Public License 113373 113373 "RTN","C0COVREU",16,0) 113374 ;D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY113374 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 113375 113375 "RTN","C0COVREU",17,0) 113376 S C0CLLMT=$$GET^C0CPARMS("LABLIMIT") ; GET THE LIMIT PARM113376 ; 113377 113377 "RTN","C0COVREU",18,0) 113378 S C0CLSTRT=$$GET^C0CPARMS("LABSTART") ; GET START PARM113378 ; 113379 113379 "RTN","C0COVREU",19,0) 113380 D DT^DILF(,C0CLLMT,.C0CSDT) ; 113380 GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT 113381 113381 "RTN","C0COVREU",20,0) 113382 W "LAB LIMIT: ",C0CLLMT,!113382 N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR,C0CLLMT,C0CLSTRT 113383 113383 "RTN","C0COVREU",21,0) 113384 D DT^DILF(,C0CLSTRT,.C0CEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM113384 ; SET UP FOR LAB API CALL 113385 113385 "RTN","C0COVREU",22,0) 113386 S C0CR=$$LAB^C0CLA7Q(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP113386 S C0CPTID=$$SSN^C0CDPT(DFN) ; GET THE SSN FOR THIS PATIENT 113387 113387 "RTN","C0COVREU",23,0) 113388 Q113388 I C0CPTID="" D Q ; NO SSN, COMPLAIN AND QUIT 113389 113389 "RTN","C0COVREU",24,0) 113390 . W "LAB LOOKUP FAILED, NO SSN",! 113391 "RTN","C0COVREU",25,0) 113392 . S C0CNSSN=1 ; SET NO SSN FLAG 113393 "RTN","C0COVREU",26,0) 113394 S C0CSPC="*" ; LOOKING FOR ALL LABS 113395 "RTN","C0COVREU",27,0) 113396 ;I $D(^TMP("C0CCCR","RPMS")) D ; RUNNING RPMS 113397 "RTN","C0COVREU",28,0) 113398 ;. D DT^DILF(,"T-365",.C0CSDT) ; START DATE ONE YEAR AGO TO LIMIT VOLUME 113399 "RTN","C0COVREU",29,0) 113400 ;E D DT^DILF(,"T-5000",.C0CSDT) ; START DATE LONG AGO TO GET EVERYTHING 113401 "RTN","C0COVREU",30,0) 113402 ;D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY 113403 "RTN","C0COVREU",31,0) 113404 S C0CLLMT=$$GET^C0CPARMS("LABLIMIT") ; GET THE LIMIT PARM 113405 "RTN","C0COVREU",32,0) 113406 S C0CLSTRT=$$GET^C0CPARMS("LABSTART") ; GET START PARM 113407 "RTN","C0COVREU",33,0) 113408 D DT^DILF(,C0CLLMT,.C0CSDT) ; 113409 "RTN","C0COVREU",34,0) 113410 W "LAB LIMIT: ",C0CLLMT,! 113411 "RTN","C0COVREU",35,0) 113412 D DT^DILF(,C0CLSTRT,.C0CEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM 113413 "RTN","C0COVREU",36,0) 113414 S C0CR=$$LAB^C0CLA7Q(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP 113415 "RTN","C0COVREU",37,0) 113416 Q 113417 "RTN","C0COVREU",38,0) 113390 113418 LTYP(OSEG,OTYP,OVARA,OC0CQT) ; 113391 "RTN","C0COVREU",25,0)113392 N OI,OI2,OTAB,OTI,OV,OVAR113393 "RTN","C0COVREU",26,0)113394 S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE113395 "RTN","C0COVREU",27,0)113396 I '$D(OC0CQT) S C0CQT=0 ; NOT C0CQT IS DEFAULT113397 "RTN","C0COVREU",28,0)113398 E S C0CQT=OC0CQT ; ACCEPT C0CQT FLAG113399 "RTN","C0COVREU",29,0)113400 I 1 D ; FOR HL7 SEGMENT TYPE113401 "RTN","C0COVREU",30,0)113402 . S OI="" ; INDEX INTO FIELDS IN SEG113403 "RTN","C0COVREU",31,0)113404 . F S OI=$O(@OTAB@(OI)) Q:OI="" D ; FOR EACH FIELD OF THE SEGMENT113405 "RTN","C0COVREU",32,0)113406 . . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX113407 "RTN","C0COVREU",33,0)113408 . . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED113409 "RTN","C0COVREU",34,0)113410 . . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE113411 "RTN","C0COVREU",35,0)113412 . . I $P(OI,";",2)'="" D ; THIS IS DEFINING A SUB-VALUE113413 "RTN","C0COVREU",36,0)113414 . . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX113415 "RTN","C0COVREU",37,0)113416 . . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE113417 "RTN","C0COVREU",38,0)113418 . . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE113419 113419 "RTN","C0COVREU",39,0) 113420 . . I 'C0CQT D ; PRINT OUTPUT IF C0CQT IS FALSE113420 N OI,OI2,OTAB,OTI,OV,OVAR 113421 113421 "RTN","C0COVREU",40,0) 113422 . . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,!113422 S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE 113423 113423 "RTN","C0COVREU",41,0) 113424 Q113424 I '$D(OC0CQT) S C0CQT=0 ; NOT C0CQT IS DEFAULT 113425 113425 "RTN","C0COVREU",42,0) 113426 E S C0CQT=OC0CQT ; ACCEPT C0CQT FLAG 113427 "RTN","C0COVREU",43,0) 113428 I 1 D ; FOR HL7 SEGMENT TYPE 113429 "RTN","C0COVREU",44,0) 113430 . S OI="" ; INDEX INTO FIELDS IN SEG 113431 "RTN","C0COVREU",45,0) 113432 . F S OI=$O(@OTAB@(OI)) Q:OI="" D ; FOR EACH FIELD OF THE SEGMENT 113433 "RTN","C0COVREU",46,0) 113434 . . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX 113435 "RTN","C0COVREU",47,0) 113436 . . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED 113437 "RTN","C0COVREU",48,0) 113438 . . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE 113439 "RTN","C0COVREU",49,0) 113440 . . I $P(OI,";",2)'="" D ; THIS IS DEFINING A SUB-VALUE 113441 "RTN","C0COVREU",50,0) 113442 . . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX 113443 "RTN","C0COVREU",51,0) 113444 . . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE 113445 "RTN","C0COVREU",52,0) 113446 . . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE 113447 "RTN","C0COVREU",53,0) 113448 . . I 'C0CQT D ; PRINT OUTPUT IF C0CQT IS FALSE 113449 "RTN","C0COVREU",54,0) 113450 . . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,! 113451 "RTN","C0COVREU",55,0) 113452 Q 113453 "RTN","C0COVREU",56,0) 113426 113454 LOBX ; 113427 "RTN","C0COVREU",43,0) 113428 Q 113429 "RTN","C0COVREU",44,0) 113430 ; 113431 "RTN","C0COVREU",45,0) 113455 "RTN","C0COVREU",57,0) 113456 Q 113457 "RTN","C0COVREU",58,0) 113432 113458 OUT(DFN) ; WRITE OUT A CCR THAT HAS JUST BEEN PROCESSED (FOR TESTING) 113433 "RTN","C0COVREU", 46,0)113434 113435 "RTN","C0COVREU", 47,0)113436 113437 "RTN","C0COVREU", 48,0)113438 113439 "RTN","C0COVREU", 49,0)113440 113441 "RTN","C0COVREU", 50,0)113442 113443 "RTN","C0COVREU", 51,0)113444 113445 "RTN","C0COVREU", 52,0)113459 "RTN","C0COVREU",59,0) 113460 N GA,GF,GD 113461 "RTN","C0COVREU",60,0) 113462 S GA=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1)) 113463 "RTN","C0COVREU",61,0) 113464 S GF="RPMS_CCR_"_DFN_"_"_DT_".xml" 113465 "RTN","C0COVREU",62,0) 113466 S GD=^TMP("C0CCCR","ODIR") 113467 "RTN","C0COVREU",63,0) 113468 W $$OUTPUT^C0CXPATH(GA,GF,GD) 113469 "RTN","C0COVREU",64,0) 113470 Q 113471 "RTN","C0COVREU",65,0) 113446 113472 SETTBL ; 113447 "RTN","C0COVREU",53,0)113448 K X ; CLEAR X113449 "RTN","C0COVREU",54,0)113450 S X("PID","PID1")="1^00104^Set ID - Patient ID"113451 "RTN","C0COVREU",55,0)113452 S X("PID","PID2")="2^00105^Patient ID (External ID)"113453 "RTN","C0COVREU",56,0)113454 S X("PID","PID3")="3^00106^Patient ID (Internal ID)"113455 "RTN","C0COVREU",57,0)113456 S X("PID","PID4")="4^00107^Alternate Patient ID"113457 "RTN","C0COVREU",58,0)113458 S X("PID","PID5")="5^00108^Patient's Name"113459 "RTN","C0COVREU",59,0)113460 S X("PID","PID6")="6^00109^Mother's Maiden Name"113461 "RTN","C0COVREU",60,0)113462 S X("PID","PID7")="7^00110^Date of Birth"113463 "RTN","C0COVREU",61,0)113464 S X("PID","PID8")="8^00111^Sex"113465 "RTN","C0COVREU",62,0)113466 S X("PID","PID9")="9^00112^Patient Alias"113467 "RTN","C0COVREU",63,0)113468 S X("PID","PID10")="10^00113^Race"113469 "RTN","C0COVREU",64,0)113470 S X("PID","PID11")="11^00114^Patient Address"113471 "RTN","C0COVREU",65,0)113472 S X("PID","PID12")="12^00115^County Code"113473 113473 "RTN","C0COVREU",66,0) 113474 S X("PID","PID13")="13^00116^Phone Number - Home"113474 K X ; CLEAR X 113475 113475 "RTN","C0COVREU",67,0) 113476 S X("PID","PID14")="14^00117^Phone Number - Business"113476 S X("PID","PID1")="1^00104^Set ID - Patient ID" 113477 113477 "RTN","C0COVREU",68,0) 113478 S X("PID","PID15")="15^00118^Language - Patient"113478 S X("PID","PID2")="2^00105^Patient ID (External ID)" 113479 113479 "RTN","C0COVREU",69,0) 113480 S X("PID","PID16")="16^00119^Marital Status"113480 S X("PID","PID3")="3^00106^Patient ID (Internal ID)" 113481 113481 "RTN","C0COVREU",70,0) 113482 S X("PID","PID17")="17^00120^Religion"113482 S X("PID","PID4")="4^00107^Alternate Patient ID" 113483 113483 "RTN","C0COVREU",71,0) 113484 S X("PID","PID18")="18^00121^Patient Account Number"113484 S X("PID","PID5")="5^00108^Patient's Name" 113485 113485 "RTN","C0COVREU",72,0) 113486 S X("PID","PID19")="19^00122^SSN Number - Patient"113486 S X("PID","PID6")="6^00109^Mother's Maiden Name" 113487 113487 "RTN","C0COVREU",73,0) 113488 S X("PID","PID20")="20^00123^Drivers License - Patient"113488 S X("PID","PID7")="7^00110^Date of Birth" 113489 113489 "RTN","C0COVREU",74,0) 113490 S X("PID","PID21")="21^00124^Mother's Identifier"113490 S X("PID","PID8")="8^00111^Sex" 113491 113491 "RTN","C0COVREU",75,0) 113492 S X("PID","PID22")="22^00125^Ethnic Group"113492 S X("PID","PID9")="9^00112^Patient Alias" 113493 113493 "RTN","C0COVREU",76,0) 113494 S X("PID","PID23")="23^00126^Birth Place"113494 S X("PID","PID10")="10^00113^Race" 113495 113495 "RTN","C0COVREU",77,0) 113496 S X("PID","PID24")="24^00127^Multiple Birth Indicator"113496 S X("PID","PID11")="11^00114^Patient Address" 113497 113497 "RTN","C0COVREU",78,0) 113498 S X("PID","PID25")="25^00128^Birth Order"113498 S X("PID","PID12")="12^00115^County Code" 113499 113499 "RTN","C0COVREU",79,0) 113500 S X("PID","PID26")="26^00129^Citizenship"113500 S X("PID","PID13")="13^00116^Phone Number - Home" 113501 113501 "RTN","C0COVREU",80,0) 113502 S X("PID","PID27")="27^00130^Veteran.s Military Status"113502 S X("PID","PID14")="14^00117^Phone Number - Business" 113503 113503 "RTN","C0COVREU",81,0) 113504 S X("PID","PID28")="28^00739^Nationality"113504 S X("PID","PID15")="15^00118^Language - Patient" 113505 113505 "RTN","C0COVREU",82,0) 113506 S X("PID","PID29")="29^00740^Patient Death Date/Time"113506 S X("PID","PID16")="16^00119^Marital Status" 113507 113507 "RTN","C0COVREU",83,0) 113508 S X("PID","PID30")="30^00741^Patient Death Indicator"113508 S X("PID","PID17")="17^00120^Religion" 113509 113509 "RTN","C0COVREU",84,0) 113510 S X("NTE","NTE1")="1^00573^Set ID - NTE"113510 S X("PID","PID18")="18^00121^Patient Account Number" 113511 113511 "RTN","C0COVREU",85,0) 113512 S X("NTE","NTE2")="2^00574^Source of Comment"113512 S X("PID","PID19")="19^00122^SSN Number - Patient" 113513 113513 "RTN","C0COVREU",86,0) 113514 S X("NTE","NTE3")="3^00575^Comment"113514 S X("PID","PID20")="20^00123^Drivers License - Patient" 113515 113515 "RTN","C0COVREU",87,0) 113516 S X("ORC","ORC1")="1^00215^Order Control"113516 S X("PID","PID21")="21^00124^Mother's Identifier" 113517 113517 "RTN","C0COVREU",88,0) 113518 S X("ORC","ORC2")="2^00216^Placer Order Number"113518 S X("PID","PID22")="22^00125^Ethnic Group" 113519 113519 "RTN","C0COVREU",89,0) 113520 S X("ORC","ORC3")="3^00217^Filler Order Number"113520 S X("PID","PID23")="23^00126^Birth Place" 113521 113521 "RTN","C0COVREU",90,0) 113522 S X("ORC","ORC4")="4^00218^Placer Order Number"113522 S X("PID","PID24")="24^00127^Multiple Birth Indicator" 113523 113523 "RTN","C0COVREU",91,0) 113524 S X("ORC","ORC5")="5^00219^Order Status"113524 S X("PID","PID25")="25^00128^Birth Order" 113525 113525 "RTN","C0COVREU",92,0) 113526 S X("ORC","ORC6")="6^00220^Response Flag"113526 S X("PID","PID26")="26^00129^Citizenship" 113527 113527 "RTN","C0COVREU",93,0) 113528 S X("ORC","ORC7")="7^00221^Quantity/Timing"113528 S X("PID","PID27")="27^00130^Veteran.s Military Status" 113529 113529 "RTN","C0COVREU",94,0) 113530 S X("ORC","ORC8")="8^00222^Parent"113530 S X("PID","PID28")="28^00739^Nationality" 113531 113531 "RTN","C0COVREU",95,0) 113532 S X("ORC","ORC9")="9^00223^Date/Time of Transaction"113532 S X("PID","PID29")="29^00740^Patient Death Date/Time" 113533 113533 "RTN","C0COVREU",96,0) 113534 S X("ORC","ORC10")="10^00224^Entered By"113534 S X("PID","PID30")="30^00741^Patient Death Indicator" 113535 113535 "RTN","C0COVREU",97,0) 113536 S X("ORC","ORC11")="11^00225^Verified By"113536 S X("NTE","NTE1")="1^00573^Set ID - NTE" 113537 113537 "RTN","C0COVREU",98,0) 113538 S X("ORC","ORC12")="12^00226^Ordering Provider"113538 S X("NTE","NTE2")="2^00574^Source of Comment" 113539 113539 "RTN","C0COVREU",99,0) 113540 S X("ORC","ORC13")="13^00227^Enterer's Location"113540 S X("NTE","NTE3")="3^00575^Comment" 113541 113541 "RTN","C0COVREU",100,0) 113542 S X("ORC","ORC14")="14^00228^Call Back Phone Number"113542 S X("ORC","ORC1")="1^00215^Order Control" 113543 113543 "RTN","C0COVREU",101,0) 113544 S X("ORC","ORC15")="15^00229^Order Effective Date/Time"113544 S X("ORC","ORC2")="2^00216^Placer Order Number" 113545 113545 "RTN","C0COVREU",102,0) 113546 S X("ORC","ORC16")="16^00230^Order Control Code Reason"113546 S X("ORC","ORC3")="3^00217^Filler Order Number" 113547 113547 "RTN","C0COVREU",103,0) 113548 S X("ORC","ORC17")="17^00231^Entering Organization"113548 S X("ORC","ORC4")="4^00218^Placer Order Number" 113549 113549 "RTN","C0COVREU",104,0) 113550 S X("ORC","ORC18")="18^00232^Entering Device"113550 S X("ORC","ORC5")="5^00219^Order Status" 113551 113551 "RTN","C0COVREU",105,0) 113552 S X("ORC","ORC19")="19^00233^Action By"113552 S X("ORC","ORC6")="6^00220^Response Flag" 113553 113553 "RTN","C0COVREU",106,0) 113554 S X("OBR","OBR1")="1^00237^Set ID - Observation Request"113554 S X("ORC","ORC7")="7^00221^Quantity/Timing" 113555 113555 "RTN","C0COVREU",107,0) 113556 S X("OBR","OBR2")="2^00216^Placer Order Number"113556 S X("ORC","ORC8")="8^00222^Parent" 113557 113557 "RTN","C0COVREU",108,0) 113558 S X("OBR","OBR3")="3^00217^Filler Order Number"113558 S X("ORC","ORC9")="9^00223^Date/Time of Transaction" 113559 113559 "RTN","C0COVREU",109,0) 113560 S X("OBR","OBR4")="4^00238^Universal Service ID"113560 S X("ORC","ORC10")="10^00224^Entered By" 113561 113561 "RTN","C0COVREU",110,0) 113562 S X("OBR","OBR4;LOINC")="4;1^00238^Universal Service ID - LOINC^RESULTCODE"113562 S X("ORC","ORC11")="11^00225^Verified By" 113563 113563 "RTN","C0COVREU",111,0) 113564 S X("OBR","OBR4;DESC")="4;2^00238^Universal Service ID - DESC^RESULTDESCRIPTIONTEXT"113564 S X("ORC","ORC12")="12^00226^Ordering Provider" 113565 113565 "RTN","C0COVREU",112,0) 113566 S X("OBR","OBR4;VACODE")="4;3^00238^Universal Service ID - VACODE^RESULTCODINGSYSTEM"113566 S X("ORC","ORC13")="13^00227^Enterer's Location" 113567 113567 "RTN","C0COVREU",113,0) 113568 S X("OBR","OBR5")="5^00239^Priority"113568 S X("ORC","ORC14")="14^00228^Call Back Phone Number" 113569 113569 "RTN","C0COVREU",114,0) 113570 S X("OBR","OBR6")="6^00240^RequestedDate/Time"113570 S X("ORC","ORC15")="15^00229^Order Effective Date/Time" 113571 113571 "RTN","C0COVREU",115,0) 113572 S X("OBR","OBR7")="7^00241^Observation Date/Time^RESULTASSESSMENTDATETIME"113572 S X("ORC","ORC16")="16^00230^Order Control Code Reason" 113573 113573 "RTN","C0COVREU",116,0) 113574 S X("OBR","OBR8")="8^00242^Observation End Date/Time"113574 S X("ORC","ORC17")="17^00231^Entering Organization" 113575 113575 "RTN","C0COVREU",117,0) 113576 S X("OBR","OBR9")="9^00243^Collection Volume"113576 S X("ORC","ORC18")="18^00232^Entering Device" 113577 113577 "RTN","C0COVREU",118,0) 113578 S X("OBR","OBR10")="10^00244^Collector Identifier"113578 S X("ORC","ORC19")="19^00233^Action By" 113579 113579 "RTN","C0COVREU",119,0) 113580 S X("OBR","OBR11")="11^00245^Specimen Action Code"113580 S X("OBR","OBR1")="1^00237^Set ID - Observation Request" 113581 113581 "RTN","C0COVREU",120,0) 113582 S X("OBR","OBR12")="12^00246^Danger Code"113582 S X("OBR","OBR2")="2^00216^Placer Order Number" 113583 113583 "RTN","C0COVREU",121,0) 113584 S X("OBR","OBR13")="13^00247^Relevant Clinical Info."113584 S X("OBR","OBR3")="3^00217^Filler Order Number" 113585 113585 "RTN","C0COVREU",122,0) 113586 S X("OBR","OBR14")="14^00248^Specimen Rcv'd. Date/Time"113586 S X("OBR","OBR4")="4^00238^Universal Service ID" 113587 113587 "RTN","C0COVREU",123,0) 113588 S X("OBR","OBR15")="15^00249^Specimen Source"113588 S X("OBR","OBR4;LOINC")="4;1^00238^Universal Service ID - LOINC^RESULTCODE" 113589 113589 "RTN","C0COVREU",124,0) 113590 S X("OBR","OBR16")="16^00226^Ordering Provider XCN^RESULTSOURCEACTORID"113590 S X("OBR","OBR4;DESC")="4;2^00238^Universal Service ID - DESC^RESULTDESCRIPTIONTEXT" 113591 113591 "RTN","C0COVREU",125,0) 113592 S X("OBR","OBR17")="17^00250^Order Callback Phone Number"113592 S X("OBR","OBR4;VACODE")="4;3^00238^Universal Service ID - VACODE^RESULTCODINGSYSTEM" 113593 113593 "RTN","C0COVREU",126,0) 113594 S X("OBR","OBR18")="18^00251^Placers Field 1"113594 S X("OBR","OBR5")="5^00239^Priority" 113595 113595 "RTN","C0COVREU",127,0) 113596 S X("OBR","OBR19")="19^00252^Placers Field 2"113596 S X("OBR","OBR6")="6^00240^Requested Date/Time" 113597 113597 "RTN","C0COVREU",128,0) 113598 S X("OBR","OBR20")="20^00253^Filler Field 1"113598 S X("OBR","OBR7")="7^00241^Observation Date/Time^RESULTASSESSMENTDATETIME" 113599 113599 "RTN","C0COVREU",129,0) 113600 S X("OBR","OBR21")="21^00254^Filler Field 2"113600 S X("OBR","OBR8")="8^00242^Observation End Date/Time" 113601 113601 "RTN","C0COVREU",130,0) 113602 S X("OBR","OBR22")="22^00255^Results Rpt./Status Change"113602 S X("OBR","OBR9")="9^00243^Collection Volume" 113603 113603 "RTN","C0COVREU",131,0) 113604 S X("OBR","OBR23")="23^00256^Charge to Practice"113604 S X("OBR","OBR10")="10^00244^Collector Identifier" 113605 113605 "RTN","C0COVREU",132,0) 113606 S X("OBR","OBR24")="24^00257^Diagnostic Service Sect"113606 S X("OBR","OBR11")="11^00245^Specimen Action Code" 113607 113607 "RTN","C0COVREU",133,0) 113608 S X("OBR","OBR25")="25^00258^Result Status^RESULTSTATUS"113608 S X("OBR","OBR12")="12^00246^Danger Code" 113609 113609 "RTN","C0COVREU",134,0) 113610 S X("OBR","OBR26")="26^00259^Parent Result"113610 S X("OBR","OBR13")="13^00247^Relevant Clinical Info." 113611 113611 "RTN","C0COVREU",135,0) 113612 S X("OBR","OBR27")="27^00221^Quantity/Timing"113612 S X("OBR","OBR14")="14^00248^Specimen Rcv'd. Date/Time" 113613 113613 "RTN","C0COVREU",136,0) 113614 S X("OBR","OBR28")="28^00260^Result Copies to"113614 S X("OBR","OBR15")="15^00249^Specimen Source" 113615 113615 "RTN","C0COVREU",137,0) 113616 S X("OBR","OBR29")="29^00261^Parent Number"113616 S X("OBR","OBR16")="16^00226^Ordering Provider XCN^RESULTSOURCEACTORID" 113617 113617 "RTN","C0COVREU",138,0) 113618 S X("OBR","OBR30")="30^00262^Transportation Mode"113618 S X("OBR","OBR17")="17^00250^Order Callback Phone Number" 113619 113619 "RTN","C0COVREU",139,0) 113620 S X("OBR","OBR31")="31^00263^Reason for Study"113620 S X("OBR","OBR18")="18^00251^Placers Field 1" 113621 113621 "RTN","C0COVREU",140,0) 113622 S X("OBR","OBR32")="32^00264^Principal Result Interpreter"113622 S X("OBR","OBR19")="19^00252^Placers Field 2" 113623 113623 "RTN","C0COVREU",141,0) 113624 S X("OBR","OBR33")="33^00265^Assistant Result Interpreter"113624 S X("OBR","OBR20")="20^00253^Filler Field 1" 113625 113625 "RTN","C0COVREU",142,0) 113626 S X("OBR","OBR34")="34^00266^Technician"113626 S X("OBR","OBR21")="21^00254^Filler Field 2" 113627 113627 "RTN","C0COVREU",143,0) 113628 S X("OBR","OBR35")="35^00267^Transcriptionist"113628 S X("OBR","OBR22")="22^00255^Results Rpt./Status Change" 113629 113629 "RTN","C0COVREU",144,0) 113630 S X("OBR","OBR36")="36^00268^Scheduled Date/Time"113630 S X("OBR","OBR23")="23^00256^Charge to Practice" 113631 113631 "RTN","C0COVREU",145,0) 113632 S X("OBR","OBR37")="37^01028^Number of Sample Containers"113632 S X("OBR","OBR24")="24^00257^Diagnostic Service Sect" 113633 113633 "RTN","C0COVREU",146,0) 113634 S X("OBR","OBR38")="38^38^01029 Transport Logistics of Collected Sample"113634 S X("OBR","OBR25")="25^00258^Result Status^RESULTSTATUS" 113635 113635 "RTN","C0COVREU",147,0) 113636 S X("OBR","OBR39")="39^01030^Collector.s Comment"113636 S X("OBR","OBR26")="26^00259^Parent Result" 113637 113637 "RTN","C0COVREU",148,0) 113638 S X("OBR","OBR40")="40^01031^Transport Arrangement Responsibility"113638 S X("OBR","OBR27")="27^00221^Quantity/Timing" 113639 113639 "RTN","C0COVREU",149,0) 113640 S X("OBR","OBR41")="41^01032^Transport Arranged"113640 S X("OBR","OBR28")="28^00260^Result Copies to" 113641 113641 "RTN","C0COVREU",150,0) 113642 S X("OBR","OBR42")="42^01033^Escort Required"113642 S X("OBR","OBR29")="29^00261^Parent Number" 113643 113643 "RTN","C0COVREU",151,0) 113644 S X("OBR","OBR43")="43^01034^Planned Patient Transport Comment"113644 S X("OBR","OBR30")="30^00262^Transportation Mode" 113645 113645 "RTN","C0COVREU",152,0) 113646 S X("OBX","OBX1")="1^00559^Set ID - OBX"113646 S X("OBR","OBR31")="31^00263^Reason for Study" 113647 113647 "RTN","C0COVREU",153,0) 113648 S X("OBX","OBX2")="2^00676^Value Type"113648 S X("OBR","OBR32")="32^00264^Principal Result Interpreter" 113649 113649 "RTN","C0COVREU",154,0) 113650 S X("OBX","OBX3")="3^00560^Observation Identifier"113650 S X("OBR","OBR33")="33^00265^Assistant Result Interpreter" 113651 113651 "RTN","C0COVREU",155,0) 113652 S X("OBX","OBX3;C1")="3;1^00560^Observation Identifier^C1"113652 S X("OBR","OBR34")="34^00266^Technician" 113653 113653 "RTN","C0COVREU",156,0) 113654 S X("OBX","OBX3;C2")="3;2^00560^Observation Identifier^C2"113654 S X("OBR","OBR35")="35^00267^Transcriptionist" 113655 113655 "RTN","C0COVREU",157,0) 113656 S X("OBX","OBX3;C3")="3;3^00560^Observation Identifier^C3"113656 S X("OBR","OBR36")="36^00268^Scheduled Date/Time" 113657 113657 "RTN","C0COVREU",158,0) 113658 S X("OBX","OBX3;C4")="3;4^00560^Observation Identifier^C4"113658 S X("OBR","OBR37")="37^01028^Number of Sample Containers" 113659 113659 "RTN","C0COVREU",159,0) 113660 S X("OBX","OBX3;C5")="3;5^00560^Observation Identifier^C5"113660 S X("OBR","OBR38")="38^38^01029 Transport Logistics of Collected Sample" 113661 113661 "RTN","C0COVREU",160,0) 113662 S X("OBX","OBX3;C6")="3;6^00560^Observation Identifier^C6"113662 S X("OBR","OBR39")="39^01030^Collector.s Comment" 113663 113663 "RTN","C0COVREU",161,0) 113664 S X("OBX","OBX4")="4^00769^Observation Sub-Id"113664 S X("OBR","OBR40")="40^01031^Transport Arrangement Responsibility" 113665 113665 "RTN","C0COVREU",162,0) 113666 S X("OBX","OBX5")="5^00561^Observation Results^RESULTTESTVALUE"113666 S X("OBR","OBR41")="41^01032^Transport Arranged" 113667 113667 "RTN","C0COVREU",163,0) 113668 S X("OBX","OBX6")="6^00562^Units^RESULTTESTUNITS"113668 S X("OBR","OBR42")="42^01033^Escort Required" 113669 113669 "RTN","C0COVREU",164,0) 113670 S X("OBX","OBX7")="7^00563^Reference Range^RESULTTESTNORMALDESCTEXT"113670 S X("OBR","OBR43")="43^01034^Planned Patient Transport Comment" 113671 113671 "RTN","C0COVREU",165,0) 113672 S X("OBX","OBX8")="8^00564^Abnormal Flags^RESULTTESTFLAG"113672 S X("OBX","OBX1")="1^00559^Set ID - OBX" 113673 113673 "RTN","C0COVREU",166,0) 113674 S X("OBX","OBX9")="9^00639^Probability"113674 S X("OBX","OBX2")="2^00676^Value Type" 113675 113675 "RTN","C0COVREU",167,0) 113676 S X("OBX","OBX10")="10^00565^Nature of Abnormal Test"113676 S X("OBX","OBX3")="3^00560^Observation Identifier" 113677 113677 "RTN","C0COVREU",168,0) 113678 S X("OBX","OBX11")="11^00566^Observ. Result Status^RESULTTESTSTATUSTEXT"113678 S X("OBX","OBX3;C1")="3;1^00560^Observation Identifier^C1" 113679 113679 "RTN","C0COVREU",169,0) 113680 S X("OBX","OBX12")="12^00567^Date Last Normal Value"113680 S X("OBX","OBX3;C2")="3;2^00560^Observation Identifier^C2" 113681 113681 "RTN","C0COVREU",170,0) 113682 S X("OBX","OBX13")="13^00581^User Defined Access Checks"113682 S X("OBX","OBX3;C3")="3;3^00560^Observation Identifier^C3" 113683 113683 "RTN","C0COVREU",171,0) 113684 S X("OBX","OBX14")="14^00582^Date/Time of Observation^RESULTTESTDATETIME"113684 S X("OBX","OBX3;C4")="3;4^00560^Observation Identifier^C4" 113685 113685 "RTN","C0COVREU",172,0) 113686 S X("OBX","OBX15")="15^00583^Producer.s ID^RESULTTESTSOURCEACTORID"113686 S X("OBX","OBX3;C5")="3;5^00560^Observation Identifier^C5" 113687 113687 "RTN","C0COVREU",173,0) 113688 S X("OBX","OBX16")="16^00584^Responsible Observer"113688 S X("OBX","OBX3;C6")="3;6^00560^Observation Identifier^C6" 113689 113689 "RTN","C0COVREU",174,0) 113690 S X("OBX","OBX17")="17^00936^Observation Method"113690 S X("OBX","OBX4")="4^00769^Observation Sub-Id" 113691 113691 "RTN","C0COVREU",175,0) 113692 K ^TMP("C0CCCR","LABTBL")113692 S X("OBX","OBX5")="5^00561^Observation Results^RESULTTESTVALUE" 113693 113693 "RTN","C0COVREU",176,0) 113694 M ^TMP("C0CCCR","LABTBL")=X ; SET VALUES IN LAB TBL113694 S X("OBX","OBX6")="6^00562^Units^RESULTTESTUNITS" 113695 113695 "RTN","C0COVREU",177,0) 113696 S ^TMP("C0CCCR","LABTBL",0)="V3"113696 S X("OBX","OBX7")="7^00563^Reference Range^RESULTTESTNORMALDESCTEXT" 113697 113697 "RTN","C0COVREU",178,0) 113698 Q 113698 S X("OBX","OBX8")="8^00564^Abnormal Flags^RESULTTESTFLAG" 113699 "RTN","C0COVREU",179,0) 113700 S X("OBX","OBX9")="9^00639^Probability" 113701 "RTN","C0COVREU",180,0) 113702 S X("OBX","OBX10")="10^00565^Nature of Abnormal Test" 113703 "RTN","C0COVREU",181,0) 113704 S X("OBX","OBX11")="11^00566^Observ. Result Status^RESULTTESTSTATUSTEXT" 113705 "RTN","C0COVREU",182,0) 113706 S X("OBX","OBX12")="12^00567^Date Last Normal Value" 113707 "RTN","C0COVREU",183,0) 113708 S X("OBX","OBX13")="13^00581^User Defined Access Checks" 113709 "RTN","C0COVREU",184,0) 113710 S X("OBX","OBX14")="14^00582^Date/Time of Observation^RESULTTESTDATETIME" 113711 "RTN","C0COVREU",185,0) 113712 S X("OBX","OBX15")="15^00583^Producer.s ID^RESULTTESTSOURCEACTORID" 113713 "RTN","C0COVREU",186,0) 113714 S X("OBX","OBX16")="16^00584^Responsible Observer" 113715 "RTN","C0COVREU",187,0) 113716 S X("OBX","OBX17")="17^00936^Observation Method" 113717 "RTN","C0COVREU",188,0) 113718 K ^TMP("C0CCCR","LABTBL") 113719 "RTN","C0COVREU",189,0) 113720 M ^TMP("C0CCCR","LABTBL")=X ; SET VALUES IN LAB TBL 113721 "RTN","C0COVREU",190,0) 113722 S ^TMP("C0CCCR","LABTBL",0)="V3" 113723 "RTN","C0COVREU",191,0) 113724 Q 113699 113725 "RTN","C0CPARMS") 113700 0^29^B 10161575113726 0^29^B9948429 113701 113727 "RTN","C0CPARMS",1,0) 113702 113728 C0CPARMS ; CCDCCR/GPL - CCR/CCD PARAMETER PROCESSING ; 1/29/09 ; 6/15/12 3:46pm 113703 113729 "RTN","C0CPARMS",2,0) 113704 ;;1.2;C 0C;;May 11, 2012;Build 50113730 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 113705 113731 "RTN","C0CPARMS",3,0) 113706 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU113732 ;Copyright 2008 WorldVistA. 113707 113733 "RTN","C0CPARMS",4,0) 113708 ; General Public License See attached copy of the License.113734 ; 113709 113735 "RTN","C0CPARMS",5,0) 113710 ; 113736 ; This program is free software: you can redistribute it and/or modify 113711 113737 "RTN","C0CPARMS",6,0) 113712 ; This program is free software; you can redistribute it and/or modify113738 ; it under the terms of the GNU Affero General Public License as 113713 113739 "RTN","C0CPARMS",7,0) 113714 ; it under the terms of the GNU General Public License as published by113740 ; published by the Free Software Foundation, either version 3 of the 113715 113741 "RTN","C0CPARMS",8,0) 113716 ; the Free Software Foundation; either version 2 of the License, or113742 ; License, or (at your option) any later version. 113717 113743 "RTN","C0CPARMS",9,0) 113718 ; (at your option) any later version.113744 ; 113719 113745 "RTN","C0CPARMS",10,0) 113720 ; 113746 ; This program is distributed in the hope that it will be useful, 113721 113747 "RTN","C0CPARMS",11,0) 113722 ; This program is distributed in the hope that it will be useful,113748 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 113723 113749 "RTN","C0CPARMS",12,0) 113724 ; but WITHOUT ANY WARRANTY; without even the implied warranty of113750 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 113725 113751 "RTN","C0CPARMS",13,0) 113726 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the113752 ; GNU Affero General Public License for more details. 113727 113753 "RTN","C0CPARMS",14,0) 113728 ; GNU General Public License for more details.113754 ; 113729 113755 "RTN","C0CPARMS",15,0) 113730 ; 113756 ; You should have received a copy of the GNU Affero General Public License 113731 113757 "RTN","C0CPARMS",16,0) 113732 ; You should have received a copy of the GNU General Public License along113758 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 113733 113759 "RTN","C0CPARMS",17,0) 113734 ; with this program; if not, write to the Free Software Foundation, Inc.,113760 ; 113735 113761 "RTN","C0CPARMS",18,0) 113736 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 113762 SET(INPARMS) ;INITIALIZE RUNTIME PARMS USING INPARMS TO OVERRIDE DEFAULTS 113737 113763 "RTN","C0CPARMS",19,0) 113738 ; 113764 ; PARAMETERS ARE PASSED AS A STRING: "PARM1:VALUE1^PARM2:VALUE2^ETC" 113739 113765 "RTN","C0CPARMS",20,0) 113740 SET(INPARMS) ;INITIALIZE RUNTIME PARMS USING INPARMS TO OVERRIDE DEFAULTS113766 ; THE SAME FORMAT IS USED BY RPC AND COMMAND LINE ENTRY POINTS 113741 113767 "RTN","C0CPARMS",21,0) 113742 ; PARAMETERS ARE PASSED AS A STRING: "PARM1:VALUE1^PARM2:VALUE2^ETC"113768 ; 113743 113769 "RTN","C0CPARMS",22,0) 113744 ; THE SAME FORMAT IS USED BY RPC AND COMMAND LINE ENTRY POINTS113770 N PTMP ; 113745 113771 "RTN","C0CPARMS",23,0) 113746 ;113772 S C0CPARMS=$NA(^TMP("C0CPARMS",$J)) ;BASE FOR THIS RUN 113747 113773 "RTN","C0CPARMS",24,0) 113748 N PTMP ;113774 K @C0CPARMS ;START WITH EMPTY PARMS; MAY NOT WANT TO DO THIS KILL 113749 113775 "RTN","C0CPARMS",25,0) 113750 S C0CPARMS=$NA(^TMP("C0CPARMS",$J)) ;BASE FOR THIS RUN113776 I $G(INPARMS)'="" D ; OVERRIDES PROVIDED 113751 113777 "RTN","C0CPARMS",26,0) 113752 K @C0CPARMS ;START WITH EMPTY PARMS; MAY NOT WANT TO DO THIS KILL113778 . N C0CI S C0CI="" 113753 113779 "RTN","C0CPARMS",27,0) 113754 I $G(INPARMS)'="" D ; OVERRIDES PROVIDED113780 . N C0CN S C0CN=1 113755 113781 "RTN","C0CPARMS",28,0) 113756 . N C0CI S C0CI=""113782 . F S C0CI=$P(INPARMS,"^",C0CN) Q:C0CI="" D ; 113757 113783 "RTN","C0CPARMS",29,0) 113758 . N C0CN S C0CN=1113784 . . S C0CN=C0CN+1 ;NEXT PARM 113759 113785 "RTN","C0CPARMS",30,0) 113760 . F S C0CI=$P(INPARMS,"^",C0CN) Q:C0CI="" D ;113786 . . N C1,C2 113761 113787 "RTN","C0CPARMS",31,0) 113762 . . S C 0CN=C0CN+1 ;NEXT PARM113788 . . S C1=$P(C0CI,":",1) ; PARAMETER 113763 113789 "RTN","C0CPARMS",32,0) 113764 . . N C1,C2113790 . . S C2=$P(C0CI,":",2) ; VALUE 113765 113791 "RTN","C0CPARMS",33,0) 113766 . . S C1=$P(C0CI,":",1) ; PARAMETER113792 . . I C2="" S C2=1 113767 113793 "RTN","C0CPARMS",34,0) 113768 . . S C2=$P(C0CI,":",2) ; VALUE113794 . . S @C0CPARMS@(C1)=C2 113769 113795 "RTN","C0CPARMS",35,0) 113770 . . I C2="" S C2=1113796 . I C0CN=1 S @C0CPARMS@($P(INPARMS,":",1))=$P(C0CI,":",2) ; ONLY ONE 113771 113797 "RTN","C0CPARMS",36,0) 113772 . . S @C0CPARMS@(C1)=C2113798 ; THIS IS WHERE WE WILL INSERT CALLS TO THE PARAMETER FILE FOR DEFAULTS 113773 113799 "RTN","C0CPARMS",37,0) 113774 . I C0CN=1 S @C0CPARMS@($P(INPARMS,":",1))=$P(C0CI,":",2) ; ONLY ONE113800 ; IF THEY FAIL, THE FOLLOWING WILL BE HARDCODED DEFAULTS 113775 113801 "RTN","C0CPARMS",38,0) 113776 ; THIS IS WHERE WE WILL INSERT CALLS TO THE PARAMETER FILE FOR DEFAULTS113802 ;OHUM/RUT commented the hardcoded limits 113777 113803 "RTN","C0CPARMS",39,0) 113778 ; IF THEY FAIL, THE FOLLOWING WILL BE HARDCODED DEFAULTS113804 ;I '$D(@C0CPARMS@("LABLIMIT")) S @C0CPARMS@("LABLIMIT")="T-360" ;ONE YR WORTH 113779 113805 "RTN","C0CPARMS",40,0) 113780 ; OHUM/RUT commented the hardcoded limits113806 ;I '$D(@C0CPARMS@("LABSTART")) S @C0CPARMS@("LABSTART")="T" ;TODAY 113781 113807 "RTN","C0CPARMS",41,0) 113782 ;I '$D(@C0CPARMS@(" LABLIMIT")) S @C0CPARMS@("LABLIMIT")="T-360" ;ONE YR WORTH113808 ;I '$D(@C0CPARMS@("VITLIMIT")) S @C0CPARMS@("VITLIMIT")="T-360" ;ONE YR VITALS 113783 113809 "RTN","C0CPARMS",42,0) 113810 ;I '$D(@C0CPARMS@("VITSTART")) S @C0CPARMS@("VITSTART")="T" ;TODAY 113811 "RTN","C0CPARMS",43,0) 113812 ;I '$D(@C0CPARMS@("MEDSTART")) S @C0CPARMS@("MEDSTART")="T" ; TODAY 113813 "RTN","C0CPARMS",44,0) 113814 ;I '$D(@C0CPARMS@("MEDSLIMIT")) S @C0CPARMS@("MEDLIMIT")="T-360" ; ONE YR MEDS 113815 "RTN","C0CPARMS",45,0) 113816 ;I '$D(@C0CPARMS@("MEDACTIVE")) S @C0CPARMS@("MEDACTIVE")=1 ; YES 113817 "RTN","C0CPARMS",46,0) 113818 ;I '$D(@C0CPARMS@("MEDPENDING")) S @C0CPARMS@("MEDPENDING")=0 ; NO 113819 "RTN","C0CPARMS",47,0) 113820 ;I '$D(@C0CPARMS@("MEDALL")) S @C0CPARMS@("MEDALL")=0 ; NON-PENDING NON-ACTIVE 113821 "RTN","C0CPARMS",48,0) 113822 ;OHUM/RUT 3120109 ; commented all limits 113823 "RTN","C0CPARMS",49,0) 113824 ;S @C0CPARMS@("LABLIMIT")=^TMP("C0CCCR","LABLIMIT"),@C0CPARMS@("VITLIMIT")=^TMP("C0CCCR","VITLIMIT"),@C0CPARMS@("TIULIMIT")=^TMP("C0CCCR","TIULIMIT"),@C0CPARMS@("MEDLIMIT")=^TMP("C0CCCR","MEDLIMIT") 113825 "RTN","C0CPARMS",50,0) 113784 113826 ;I '$D(@C0CPARMS@("LABSTART")) S @C0CPARMS@("LABSTART")="T" ;TODAY 113785 "RTN","C0CPARMS",43,0) 113786 ;I '$D(@C0CPARMS@("VITLIMIT")) S @C0CPARMS@("VITLIMIT")="T-360" ;ONE YR VITALS 113787 "RTN","C0CPARMS",44,0) 113827 "RTN","C0CPARMS",51,0) 113788 113828 ;I '$D(@C0CPARMS@("VITSTART")) S @C0CPARMS@("VITSTART")="T" ;TODAY 113789 "RTN","C0CPARMS", 45,0)113829 "RTN","C0CPARMS",52,0) 113790 113830 ;I '$D(@C0CPARMS@("MEDSTART")) S @C0CPARMS@("MEDSTART")="T" ; TODAY 113791 "RTN","C0CPARMS",46,0) 113792 ;I '$D(@C0CPARMS@("MEDSLIMIT")) S @C0CPARMS@("MEDLIMIT")="T-360" ; ONE YR MEDS 113793 "RTN","C0CPARMS",47,0) 113831 "RTN","C0CPARMS",53,0) 113794 113832 ;I '$D(@C0CPARMS@("MEDACTIVE")) S @C0CPARMS@("MEDACTIVE")=1 ; YES 113795 "RTN","C0CPARMS", 48,0)113833 "RTN","C0CPARMS",54,0) 113796 113834 ;I '$D(@C0CPARMS@("MEDPENDING")) S @C0CPARMS@("MEDPENDING")=0 ; NO 113797 "RTN","C0CPARMS",49,0)113798 ;I '$D(@C0CPARMS@("MEDALL")) S @C0CPARMS@("MEDALL")=0 ; NON-PENDING NON-ACTIVE113799 "RTN","C0CPARMS",50,0)113800 ;OHUM/RUT 3120109 ; commented all limits113801 "RTN","C0CPARMS",51,0)113802 ;S @C0CPARMS@("LABLIMIT")=^TMP("C0CCCR","LABLIMIT"),@C0CPARMS@("VITLIMIT")=^TMP("C0CCCR","VITLIMIT"),@C0CPARMS@("TIULIMIT")=^TMP("C0CCCR","TIULIMIT"),@C0CPARMS@("MEDLIMIT")=^TMP("C0CCCR","MEDLIMIT")113803 "RTN","C0CPARMS",52,0)113804 ;I '$D(@C0CPARMS@("LABSTART")) S @C0CPARMS@("LABSTART")="T" ;TODAY113805 "RTN","C0CPARMS",53,0)113806 ;I '$D(@C0CPARMS@("VITSTART")) S @C0CPARMS@("VITSTART")="T" ;TODAY113807 "RTN","C0CPARMS",54,0)113808 ;I '$D(@C0CPARMS@("MEDSTART")) S @C0CPARMS@("MEDSTART")="T" ; TODAY113809 113835 "RTN","C0CPARMS",55,0) 113810 ;I '$D(@C0CPARMS@("MEDA CTIVE")) S @C0CPARMS@("MEDACTIVE")=1 ; YES113836 ;I '$D(@C0CPARMS@("MEDALL")) S @C0CPARMS@("MEDALL")=1 ; NON-PENDING NON-ACTIVE 113811 113837 "RTN","C0CPARMS",56,0) 113812 ; I '$D(@C0CPARMS@("MEDPENDING")) S @C0CPARMS@("MEDPENDING")=0 ; NO113838 ;;I '$D(@C0CPARMS@("RALIMIT")) S @C0CPARMS@("RALIMIT")="T-36500" ;ONE YR WORTH 113813 113839 "RTN","C0CPARMS",57,0) 113814 ; I '$D(@C0CPARMS@("MEDALL")) S @C0CPARMS@("MEDALL")=1 ; NON-PENDING NON-ACTIVE113840 ;;I '$D(@C0CPARMS@("RASTART")) S @C0CPARMS@("RASTART")="T" ;TODAY 113815 113841 "RTN","C0CPARMS",58,0) 113816 ; ;I '$D(@C0CPARMS@("RALIMIT")) S @C0CPARMS@("RALIMIT")="T-36500" ;ONE YR WORTH113842 ;I '$D(@C0CPARMS@("TIUSTART")) S @C0CPARMS@("TIUSTART")="T" ;TODAY 113817 113843 "RTN","C0CPARMS",59,0) 113818 ;; I '$D(@C0CPARMS@("RASTART")) S @C0CPARMS@("RASTART")="T" ;TODAY113844 ;;OHUM/RUT 113819 113845 "RTN","C0CPARMS",60,0) 113820 ;I '$D(@C0CPARMS@("TIUSTART")) S @C0CPARMS@("TIUSTART")="T" ;TODAY113846 S @C0CPARMS@("LABLIMIT")=$P(^C0CPARM(1,0),"^",2) 113821 113847 "RTN","C0CPARMS",61,0) 113822 ;;OHUM/RUT113848 S @C0CPARMS@("LABSTART")=$P(^C0CPARM(1,0),"^",3) 113823 113849 "RTN","C0CPARMS",62,0) 113824 S @C0CPARMS@("LABLIMIT")=$P(^C0CPARM(1,0),"^",2)113850 S @C0CPARMS@("VITLIMIT")=$P(^C0CPARM(1,0),"^",4) 113825 113851 "RTN","C0CPARMS",63,0) 113826 S @C0CPARMS@(" LABSTART")=$P(^C0CPARM(1,0),"^",3)113852 S @C0CPARMS@("VITSTART")=$P(^C0CPARM(1,1),"^",1) 113827 113853 "RTN","C0CPARMS",64,0) 113828 S @C0CPARMS@(" VITLIMIT")=$P(^C0CPARM(1,0),"^",4)113854 S @C0CPARMS@("MEDLIMIT")=$P(^C0CPARM(1,1),"^",2) 113829 113855 "RTN","C0CPARMS",65,0) 113830 S @C0CPARMS@(" VITSTART")=$P(^C0CPARM(1,1),"^",1)113856 S @C0CPARMS@("MEDSTART")=$P(^C0CPARM(1,1),"^",3) 113831 113857 "RTN","C0CPARMS",66,0) 113832 S @C0CPARMS@("MED LIMIT")=$P(^C0CPARM(1,1),"^",2)113858 S @C0CPARMS@("MEDACTIVE")=0 113833 113859 "RTN","C0CPARMS",67,0) 113834 S @C0CPARMS@("MED START")=$P(^C0CPARM(1,1),"^",3)113860 S @C0CPARMS@("MEDPENDING")=0 113835 113861 "RTN","C0CPARMS",68,0) 113836 S @C0CPARMS@("MEDA CTIVE")=0113862 S @C0CPARMS@("MEDALL")=0 ;OHUM/RUT 3120504 INITIALISING MEDICATION STATUS VARIABLES WITH ZERO 113837 113863 "RTN","C0CPARMS",69,0) 113838 S @C0CPARMS@("MEDPENDING")=0113864 I $P(^C0CPARM(1,1),"^",4)="ACT" S @C0CPARMS@("MEDACTIVE")=1 113839 113865 "RTN","C0CPARMS",70,0) 113840 S @C0CPARMS@("MEDALL")=0 ;OHUM/RUT 3120504 INITIALISING MEDICATION STATUS VARIABLES WITH ZERO113866 I $P(^C0CPARM(1,1),"^",4)="PEN" S @C0CPARMS@("MEDPENDING")=1 113841 113867 "RTN","C0CPARMS",71,0) 113842 I $P(^C0CPARM(1,1),"^",4)="A CT" S @C0CPARMS@("MEDACTIVE")=1113868 I $P(^C0CPARM(1,1),"^",4)="ALL" S @C0CPARMS@("MEDALL")=1,@C0CPARMS@("MEDPENDING")=1 ;OHUM/RUT 3120504 ADDED FOR INCLUDING PENDING MEDICATIONS FOR STATUS "ALL" 113843 113869 "RTN","C0CPARMS",72,0) 113844 I $P(^C0CPARM(1,1),"^",4)="PEN" S @C0CPARMS@("MEDPENDING")=1113870 ;S ^TMP("C0CCCR","TIULIMIT")="",^TMP("C0CCCR","TIUSTART")="" 113845 113871 "RTN","C0CPARMS",73,0) 113846 I $P(^C0CPARM(1, 1),"^",4)="ALL" S @C0CPARMS@("MEDALL")=1,@C0CPARMS@("MEDPENDING")=1 ;OHUM/RUT 3120504 ADDED FOR INCLUDING PENDING MEDICATIONS FOR STATUS "ALL"113872 I $P(^C0CPARM(1,2),"^",3)=1 S @C0CPARMS@("TIULIMIT")=$P(^C0CPARM(1,2),"^",1),@C0CPARMS@("TIUSTART")=$P(^C0CPARM(1,2),"^",2) 113847 113873 "RTN","C0CPARMS",74,0) 113848 ; S ^TMP("C0CCCR","TIULIMIT")="",^TMP("C0CCCR","TIUSTART")=""113874 ;OHUM/RUT 113849 113875 "RTN","C0CPARMS",75,0) 113850 I $P(^C0CPARM(1,2),"^",3)=1 S @C0CPARMS@("TIULIMIT")=$P(^C0CPARM(1,2),"^",1),@C0CPARMS@("TIUSTART")=$P(^C0CPARM(1,2),"^",2)113876 Q 113851 113877 "RTN","C0CPARMS",76,0) 113852 ; OHUM/RUT113878 ; 113853 113879 "RTN","C0CPARMS",77,0) 113880 CHECK ; CHECK TO SEE IF PARMS ARE PRESENT, ELSE RUN SET 113881 "RTN","C0CPARMS",78,0) 113882 ; 113883 "RTN","C0CPARMS",79,0) 113884 I '$D(C0CPARMS) S C0CPARMS=$NA(^TMP("C0CPARMS",$J)) ;SHOULDN'T HAPPEN 113885 "RTN","C0CPARMS",80,0) 113886 I '$D(@C0CPARMS) D SET("SETWITHCHECK:1") 113887 "RTN","C0CPARMS",81,0) 113854 113888 Q 113855 "RTN","C0CPARMS",78,0)113856 ;113857 "RTN","C0CPARMS",79,0)113858 CHECK ; CHECK TO SEE IF PARMS ARE PRESENT, ELSE RUN SET113859 "RTN","C0CPARMS",80,0)113860 ;113861 "RTN","C0CPARMS",81,0)113862 I '$D(C0CPARMS) S C0CPARMS=$NA(^TMP("C0CPARMS",$J)) ;SHOULDN'T HAPPEN113863 113889 "RTN","C0CPARMS",82,0) 113864 I '$D(@C0CPARMS) D SET("SETWITHCHECK:1")113890 ; 113865 113891 "RTN","C0CPARMS",83,0) 113866 Q 113892 GET(WHICHP) ;EXTRINSIC TO RETURN THE VALUE OF PARAMETER WHICHP 113867 113893 "RTN","C0CPARMS",84,0) 113868 113894 ; 113869 113895 "RTN","C0CPARMS",85,0) 113870 GET(WHICHP) ;EXTRINSIC TO RETURN THE VALUE OF PARAMETER WHICHP 113896 D CHECK ; SHOULDN'T HAPPEN BUT TO BE SAFE 113871 113897 "RTN","C0CPARMS",86,0) 113872 ;113898 N GTMP 113873 113899 "RTN","C0CPARMS",87,0) 113874 D CHECK ; SHOULDN'T HAPPEN BUT TO BE SAFE113900 Q $G(@C0CPARMS@(WHICHP)) ;PULL THE PARM FROM THE TABLE 113875 113901 "RTN","C0CPARMS",88,0) 113876 N GTMP113877 "RTN","C0CPARMS",89,0)113878 Q $G(@C0CPARMS@(WHICHP)) ;PULL THE PARM FROM THE TABLE113879 "RTN","C0CPARMS",90,0)113880 113902 ; 113881 113903 "RTN","C0CPROBS") 113882 0^39^B5 3281308113904 0^39^B51600314 113883 113905 "RTN","C0CPROBS",1,0) 113884 113906 C0CPROBS ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08 113885 113907 "RTN","C0CPROBS",2,0) 113886 ;;1.2;C 0C;;May 11, 2012;Build 50113908 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 113887 113909 "RTN","C0CPROBS",3,0) 113888 113910 ;Copyright 2008,2009 George Lilly, University of Minnesota. 113889 113911 "RTN","C0CPROBS",4,0) 113890 ; Licensed under the terms of the GNU General Public License.113912 ; 113891 113913 "RTN","C0CPROBS",5,0) 113892 ; See attached copy of the License.113914 ; This program is free software: you can redistribute it and/or modify 113893 113915 "RTN","C0CPROBS",6,0) 113894 ; 113916 ; it under the terms of the GNU Affero General Public License as 113895 113917 "RTN","C0CPROBS",7,0) 113896 ; This program is free software; you can redistribute it and/or modify113918 ; published by the Free Software Foundation, either version 3 of the 113897 113919 "RTN","C0CPROBS",8,0) 113898 ; it under the terms of the GNU General Public License as published by113920 ; License, or (at your option) any later version. 113899 113921 "RTN","C0CPROBS",9,0) 113900 ; the Free Software Foundation; either version 2 of the License, or113922 ; 113901 113923 "RTN","C0CPROBS",10,0) 113902 ; (at your option) any later version.113924 ; This program is distributed in the hope that it will be useful, 113903 113925 "RTN","C0CPROBS",11,0) 113904 ; 113926 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 113905 113927 "RTN","C0CPROBS",12,0) 113906 ; This program is distributed in the hope that it will be useful,113928 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 113907 113929 "RTN","C0CPROBS",13,0) 113908 ; but WITHOUT ANY WARRANTY; without even the implied warranty of113930 ; GNU Affero General Public License for more details. 113909 113931 "RTN","C0CPROBS",14,0) 113910 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the113932 ; 113911 113933 "RTN","C0CPROBS",15,0) 113912 ; GNU General Public License for more details.113934 ; You should have received a copy of the GNU Affero General Public License 113913 113935 "RTN","C0CPROBS",16,0) 113914 ; 113936 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 113915 113937 "RTN","C0CPROBS",17,0) 113916 ; You should have received a copy of the GNU General Public License along113938 ; 113917 113939 "RTN","C0CPROBS",18,0) 113918 ; with this program; if not, write to the Free Software Foundation, Inc.,113940 ; PROCESS THE PROBLEMS SECTION OF THE CCR 113919 113941 "RTN","C0CPROBS",19,0) 113920 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.113942 ; 113921 113943 "RTN","C0CPROBS",20,0) 113922 ; 113944 EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE 113923 113945 "RTN","C0CPROBS",21,0) 113924 113946 ; 113925 113947 "RTN","C0CPROBS",22,0) 113926 ; PROCESS THE PROBLEMS SECTION OF THE CCR113948 ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED 113927 113949 "RTN","C0CPROBS",23,0) 113928 ; 113950 ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE 113929 113951 "RTN","C0CPROBS",24,0) 113930 EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE113952 ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE 113931 113953 "RTN","C0CPROBS",25,0) 113932 ; 113954 ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS 113933 113955 "RTN","C0CPROBS",26,0) 113934 ; IN XML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED113956 ; INSERT^C0CXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT 113935 113957 "RTN","C0CPROBS",27,0) 113936 ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE113958 ; 113937 113959 "RTN","C0CPROBS",28,0) 113938 ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE113960 N RPCRSLT,J,K,PTMP,X,VMAP,TBU 113939 113961 "RTN","C0CPROBS",29,0) 113940 ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS113962 S TVMAP=$NA(^TMP("C0CCCR",$J,"PROBVALS")) 113941 113963 "RTN","C0CPROBS",30,0) 113942 ; INSERT^C0CXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT113964 S TARYTMP=$NA(^TMP("C0CCCR",$J,"PROBARYTMP")) 113943 113965 "RTN","C0CPROBS",31,0) 113944 ;113966 K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES 113945 113967 "RTN","C0CPROBS",32,0) 113946 N RPCRSLT,J,K,PTMP,X,VMAP,TBU113968 I $$RPMS^C0CUTIL() D RPMS ; IF BGOPRB ROUTINE IS MISSING (IE RPMS) 113947 113969 "RTN","C0CPROBS",33,0) 113948 S TVMAP=$NA(^TMP("C0CCCR",$J,"PROBVALS"))113970 I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT 113949 113971 "RTN","C0CPROBS",34,0) 113950 S TARYTMP=$NA(^TMP("C0CCCR",$J,"PROBARYTMP"))113972 Q 113951 113973 "RTN","C0CPROBS",35,0) 113952 K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES113974 ; 113953 113975 "RTN","C0CPROBS",36,0) 113954 I $$RPMS^C0CUTIL() D RPMS ; IF BGOPRB ROUTINE IS MISSING (IE RPMS) 113976 RPMS ; GETS THE PROBLEM LIST FOR RPMS 113955 113977 "RTN","C0CPROBS",37,0) 113956 I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT113978 S RPCGLO=$NA(^TMP("BGO",$J)) 113957 113979 "RTN","C0CPROBS",38,0) 113980 D GET^BGOPROB(.RPCRSLT,DFN) ; CALL THE PROBLEM LIST RPC 113981 "RTN","C0CPROBS",39,0) 113982 ; FORMAT OF RPC: 113983 "RTN","C0CPROBS",40,0) 113984 ; Number Code [1] ^ Patient IEN [2] ^ ICD Code [3] ^ Modify Date [4] ^ Class [5] ^ Provider Narrative [6] ^ 113985 "RTN","C0CPROBS",41,0) 113986 ; Date Entered [7] ^ Status [8] ^ Date Onset [9] ^ Problem IEN [10] ^ Notes [11] ^ ICD9 IEN [12] ^ 113987 "RTN","C0CPROBS",42,0) 113988 ; ICD9 Short Name [13] ^ Provider [14] ^ Facility IEN [15] ^ Priority [16] 113989 "RTN","C0CPROBS",43,0) 113990 I '$D(@RPCGLO) W "NULL RESULT FROM GET^BGOPROB ",! S @OUTXML@(0)=0 Q 113991 "RTN","C0CPROBS",44,0) 113992 S J="" 113993 "RTN","C0CPROBS",45,0) 113994 F S J=$O(@RPCGLO@(J)) Q:J="" D ; FOR EACH PROBLEM IN THE LIST 113995 "RTN","C0CPROBS",46,0) 113996 . S VMAP=$NA(@TVMAP@(J)) 113997 "RTN","C0CPROBS",47,0) 113998 . K @VMAP 113999 "RTN","C0CPROBS",48,0) 114000 . I DEBUG W "VMAP= ",VMAP,! 114001 "RTN","C0CPROBS",49,0) 114002 . S PTMP=@RPCRSLT@(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY 114003 "RTN","C0CPROBS",50,0) 114004 . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL 114005 "RTN","C0CPROBS",51,0) 114006 . D GETN1^C0CRNF("C0CG1",9000011,$P(PTMP,U,10),"") ;GET VALUES BY NAME 114007 "RTN","C0CPROBS",52,0) 114008 . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM 114009 "RTN","C0CPROBS",53,0) 114010 . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,10) 114011 "RTN","C0CPROBS",54,0) 114012 . S @VMAP@("PROBLEMSTATUS")=$S($P(PTMP,U,8)="A":"Active",$P(PTMP,U,8)="I":"Inactive",1:"") 114013 "RTN","C0CPROBS",55,0) 114014 . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,6) 114015 "RTN","C0CPROBS",56,0) 114016 . S @VMAP@("PROBLEMCODINGVERSION")="" 114017 "RTN","C0CPROBS",57,0) 114018 . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,3) 114019 "RTN","C0CPROBS",58,0) 114020 . ; FOR CERTIFICATION - GPL 114021 "RTN","C0CPROBS",59,0) 114022 . I @VMAP@("PROBLEMCODEVALUE")=493.90 S @VMAP@("PROBLEMCODEVALUE")=493 114023 "RTN","C0CPROBS",60,0) 114024 . S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("DATE OF ONSET","C0CG1"),"DT") 114025 "RTN","C0CPROBS",61,0) 114026 . S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("DATE LAST MODIFIED","C0CG1"),"DT") 114027 "RTN","C0CPROBS",62,0) 114028 . ;S @VMAP@("PROBLEMSC")=$P(PTMP,U,7) ;UNKNOWN NOT MAPPED IN C0CCCR0 114029 "RTN","C0CPROBS",63,0) 114030 . ;S @VMAP@("PROBLEMSE")=$P(PTMP,U,8) ;UNKNOWN NOT MAPPED IN C0CCCR0 114031 "RTN","C0CPROBS",64,0) 114032 . ;S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9) ;NOT MAPPED IN C0CCCR0 114033 "RTN","C0CPROBS",65,0) 114034 . ;S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10) ;NOT MAPPED IN C0CCCR0 114035 "RTN","C0CPROBS",66,0) 114036 . ;S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11) ;NOT MAPPED IN C0CCCR0 114037 "RTN","C0CPROBS",67,0) 114038 . ;S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12) ;NOT MAPPED IN C0CCCR0 114039 "RTN","C0CPROBS",68,0) 114040 . ;S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER 114041 "RTN","C0CPROBS",69,0) 114042 . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$$ZVALUEI^C0CRNF("RECORDING PROVIDER","C0CG1") 114043 "RTN","C0CPROBS",70,0) 114044 . ;S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13) ;NOT MAPPED IN C0CCCR0 114045 "RTN","C0CPROBS",71,0) 114046 . ;S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14) ;NOT MAPPED IN C0CCCR0 114047 "RTN","C0CPROBS",72,0) 114048 . ;S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,15),"DT") ;NOT MAPPED IN C0CCCR0 114049 "RTN","C0CPROBS",73,0) 114050 . ;S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,16),"DT") ;NOT MAPPED IN C0CCCR0 114051 "RTN","C0CPROBS",74,0) 114052 . S ARYTMP=$NA(@TARYTMP@(J)) 114053 "RTN","C0CPROBS",75,0) 114054 . ; W "ARYTMP= ",ARYTMP,! 114055 "RTN","C0CPROBS",76,0) 114056 . K @ARYTMP 114057 "RTN","C0CPROBS",77,0) 114058 . D MAP^C0CXPATH(IPXML,VMAP,ARYTMP) ; 114059 "RTN","C0CPROBS",78,0) 114060 . I J=1 D ; FIRST ONE IS JUST A COPY 114061 "RTN","C0CPROBS",79,0) 114062 . . ; W "FIRST ONE",! 114063 "RTN","C0CPROBS",80,0) 114064 . . D CP^C0CXPATH(ARYTMP,OUTXML) 114065 "RTN","C0CPROBS",81,0) 114066 . . ; W "OUTXML ",OUTXML,! 114067 "RTN","C0CPROBS",82,0) 114068 . I J>1 D ; AFTER THE FIRST, INSERT INNER XML 114069 "RTN","C0CPROBS",83,0) 114070 . . D INSINNER^C0CXPATH(OUTXML,ARYTMP) 114071 "RTN","C0CPROBS",84,0) 114072 ; ZWR ^TMP("C0CCCR",$J,"PROBVALS",*) 114073 "RTN","C0CPROBS",85,0) 114074 ; ZWR ^TMP("C0CCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS 114075 "RTN","C0CPROBS",86,0) 114076 ; ZWR @OUTXML 114077 "RTN","C0CPROBS",87,0) 114078 ; $$HTML^DILF( 114079 "RTN","C0CPROBS",88,0) 114080 ; GENERATE THE NARITIVE HTML FOR THE CCD 114081 "RTN","C0CPROBS",89,0) 114082 I CCD D CCD ; IF THIS IS FOR A CCD 114083 "RTN","C0CPROBS",90,0) 114084 D MISSVARS 114085 "RTN","C0CPROBS",91,0) 113958 114086 Q 113959 "RTN","C0CPROBS",39,0) 113960 ; 113961 "RTN","C0CPROBS",40,0) 113962 RPMS ; GETS THE PROBLEM LIST FOR RPMS 113963 "RTN","C0CPROBS",41,0) 113964 S RPCGLO=$NA(^TMP("BGO",$J)) 113965 "RTN","C0CPROBS",42,0) 113966 D GET^BGOPROB(.RPCRSLT,DFN) ; CALL THE PROBLEM LIST RPC 113967 "RTN","C0CPROBS",43,0) 113968 ; FORMAT OF RPC: 113969 "RTN","C0CPROBS",44,0) 113970 ; Number Code [1] ^ Patient IEN [2] ^ ICD Code [3] ^ Modify Date [4] ^ Class [5] ^ Provider Narrative [6] ^ 113971 "RTN","C0CPROBS",45,0) 113972 ; Date Entered [7] ^ Status [8] ^ Date Onset [9] ^ Problem IEN [10] ^ Notes [11] ^ ICD9 IEN [12] ^ 113973 "RTN","C0CPROBS",46,0) 113974 ; ICD9 Short Name [13] ^ Provider [14] ^ Facility IEN [15] ^ Priority [16] 113975 "RTN","C0CPROBS",47,0) 113976 I '$D(@RPCGLO) W "NULL RESULT FROM GET^BGOPROB ",! S @OUTXML@(0)=0 Q 113977 "RTN","C0CPROBS",48,0) 113978 S J="" 113979 "RTN","C0CPROBS",49,0) 113980 F S J=$O(@RPCGLO@(J)) Q:J="" D ; FOR EACH PROBLEM IN THE LIST 113981 "RTN","C0CPROBS",50,0) 114087 "RTN","C0CPROBS",92,0) 114088 ; 114089 "RTN","C0CPROBS",93,0) 114090 VISTA ; GETS THE PROBLEM LIST FOR VISTA 114091 "RTN","C0CPROBS",94,0) 114092 D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC 114093 "RTN","C0CPROBS",95,0) 114094 I '$D(RPCRSLT(1)) D Q ; RPC RETURNS NULL 114095 "RTN","C0CPROBS",96,0) 114096 . W "NULL RESULT FROM LIST^ORQQPL3 ",! 114097 "RTN","C0CPROBS",97,0) 114098 . S @OUTXML@(0)=0 114099 "RTN","C0CPROBS",98,0) 114100 . ; Q 114101 "RTN","C0CPROBS",99,0) 114102 ; I DEBUG ZWR RPCRSLT 114103 "RTN","C0CPROBS",100,0) 114104 S @TVMAP@(0)=RPCRSLT(0) ; SAVE NUMBER OF PROBLEMS 114105 "RTN","C0CPROBS",101,0) 114106 F J=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM IN THE LIST 114107 "RTN","C0CPROBS",102,0) 113982 114108 . S VMAP=$NA(@TVMAP@(J)) 113983 "RTN","C0CPROBS", 51,0)114109 "RTN","C0CPROBS",103,0) 113984 114110 . K @VMAP 113985 "RTN","C0CPROBS", 52,0)114111 "RTN","C0CPROBS",104,0) 113986 114112 . I DEBUG W "VMAP= ",VMAP,! 113987 "RTN","C0CPROBS",53,0) 113988 . S PTMP=@RPCRSLT@(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY 113989 "RTN","C0CPROBS",54,0) 113990 . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL 113991 "RTN","C0CPROBS",55,0) 113992 . D GETN1^C0CRNF("C0CG1",9000011,$P(PTMP,U,10),"") ;GET VALUES BY NAME 113993 "RTN","C0CPROBS",56,0) 114113 "RTN","C0CPROBS",105,0) 114114 . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY 114115 "RTN","C0CPROBS",106,0) 113994 114116 . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM 113995 "RTN","C0CPROBS",57,0) 113996 . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,10) 113997 "RTN","C0CPROBS",58,0) 113998 . S @VMAP@("PROBLEMSTATUS")=$S($P(PTMP,U,8)="A":"Active",$P(PTMP,U,8)="I":"Inactive",1:"") 113999 "RTN","C0CPROBS",59,0) 114000 . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,6) 114001 "RTN","C0CPROBS",60,0) 114117 "RTN","C0CPROBS",107,0) 114118 . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1) 114119 "RTN","C0CPROBS",108,0) 114120 . S @VMAP@("PROBLEMSTATUS")=$S($P(PTMP,U,2)="A":"Active",$P(PTMP,U,2)="I":"Inactive",1:"") 114121 "RTN","C0CPROBS",109,0) 114122 . N ZPRIOR S ZPRIOR=$P(PTMP,U,14) ;PRIORITY FLAG 114123 "RTN","C0CPROBS",110,0) 114124 . ; turn off acute/chronic for certification gpl 114125 "RTN","C0CPROBS",111,0) 114126 . ;S @VMAP@("PROBLEMSTATUS")=@VMAP@("PROBLEMSTATUS")_$S(ZPRIOR="A":"/Acute",ZPRIOR="C":"/Chronic",1:"") ; append Chronic and Accute to Status 114127 "RTN","C0CPROBS",112,0) 114128 . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3) 114129 "RTN","C0CPROBS",113,0) 114002 114130 . S @VMAP@("PROBLEMCODINGVERSION")="" 114003 "RTN","C0CPROBS", 61,0)114004 . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U, 3)114005 "RTN","C0CPROBS", 62,0)114131 "RTN","C0CPROBS",114,0) 114132 . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4) 114133 "RTN","C0CPROBS",115,0) 114006 114134 . ; FOR CERTIFICATION - GPL 114007 "RTN","C0CPROBS", 63,0)114008 . I @VMAP@("PROBLEMCODEVALUE") =493.90S @VMAP@("PROBLEMCODEVALUE")=493114009 "RTN","C0CPROBS", 64,0)114010 . S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($ $ZVALUEI^C0CRNF("DATE OF ONSET","C0CG1"),"DT")114011 "RTN","C0CPROBS", 65,0)114012 . S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($ $ZVALUEI^C0CRNF("DATE LAST MODIFIED","C0CG1"),"DT")114013 "RTN","C0CPROBS", 66,0)114014 . ;S @VMAP@("PROBLEMSC")=$P(PTMP,U,7) ;UNKNOWN NOT MAPPED IN C0CCCR0114015 "RTN","C0CPROBS", 67,0)114016 . ;S @VMAP@("PROBLEMSE")=$P(PTMP,U,8) ;UNKNOWN NOT MAPPED IN C0CCCR0114017 "RTN","C0CPROBS", 68,0)114018 . ;S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9) ;NOT MAPPED IN C0CCCR0114019 "RTN","C0CPROBS", 69,0)114020 . ;S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10) ;NOT MAPPED IN C0CCCR0114021 "RTN","C0CPROBS", 70,0)114022 . ;S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11) ;NOT MAPPED IN C0CCCR0114023 "RTN","C0CPROBS", 71,0)114024 . ;S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12) ;NOT MAPPED IN C0CCCR0114025 "RTN","C0CPROBS", 72,0)114026 . ;S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER114027 "RTN","C0CPROBS", 73,0)114028 . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$ $ZVALUEI^C0CRNF("RECORDING PROVIDER","C0CG1")114029 "RTN","C0CPROBS", 74,0)114030 . ;S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13) ;NOT MAPPED IN C0CCCR0114031 "RTN","C0CPROBS", 75,0)114032 . ;S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14) ;NOT MAPPED IN C0CCCR0114033 "RTN","C0CPROBS", 76,0)114034 . ;S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,15),"DT") ;NOT MAPPED IN C0CCCR0114035 "RTN","C0CPROBS", 77,0)114036 . ;S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,16),"DT") ;NOT MAPPED IN C0CCCR0114037 "RTN","C0CPROBS", 78,0)114135 "RTN","C0CPROBS",116,0) 114136 . I @VMAP@("PROBLEMCODEVALUE")["493.90" S @VMAP@("PROBLEMCODEVALUE")=493 114137 "RTN","C0CPROBS",117,0) 114138 . S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,5),"DT") 114139 "RTN","C0CPROBS",118,0) 114140 . S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,6),"DT") 114141 "RTN","C0CPROBS",119,0) 114142 . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7) 114143 "RTN","C0CPROBS",120,0) 114144 . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8) 114145 "RTN","C0CPROBS",121,0) 114146 . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9) 114147 "RTN","C0CPROBS",122,0) 114148 . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10) 114149 "RTN","C0CPROBS",123,0) 114150 . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11) 114151 "RTN","C0CPROBS",124,0) 114152 . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12) 114153 "RTN","C0CPROBS",125,0) 114154 . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER 114155 "RTN","C0CPROBS",126,0) 114156 . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1) 114157 "RTN","C0CPROBS",127,0) 114158 . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13) 114159 "RTN","C0CPROBS",128,0) 114160 . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14) 114161 "RTN","C0CPROBS",129,0) 114162 . S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,15),"DT") 114163 "RTN","C0CPROBS",130,0) 114164 . S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,16),"DT") 114165 "RTN","C0CPROBS",131,0) 114038 114166 . S ARYTMP=$NA(@TARYTMP@(J)) 114039 "RTN","C0CPROBS", 79,0)114167 "RTN","C0CPROBS",132,0) 114040 114168 . ; W "ARYTMP= ",ARYTMP,! 114041 "RTN","C0CPROBS", 80,0)114169 "RTN","C0CPROBS",133,0) 114042 114170 . K @ARYTMP 114043 "RTN","C0CPROBS", 81,0)114171 "RTN","C0CPROBS",134,0) 114044 114172 . D MAP^C0CXPATH(IPXML,VMAP,ARYTMP) ; 114045 "RTN","C0CPROBS", 82,0)114173 "RTN","C0CPROBS",135,0) 114046 114174 . I J=1 D ; FIRST ONE IS JUST A COPY 114047 "RTN","C0CPROBS", 83,0)114175 "RTN","C0CPROBS",136,0) 114048 114176 . . ; W "FIRST ONE",! 114049 "RTN","C0CPROBS", 84,0)114177 "RTN","C0CPROBS",137,0) 114050 114178 . . D CP^C0CXPATH(ARYTMP,OUTXML) 114051 "RTN","C0CPROBS", 85,0)114179 "RTN","C0CPROBS",138,0) 114052 114180 . . ; W "OUTXML ",OUTXML,! 114053 "RTN","C0CPROBS", 86,0)114181 "RTN","C0CPROBS",139,0) 114054 114182 . I J>1 D ; AFTER THE FIRST, INSERT INNER XML 114055 "RTN","C0CPROBS", 87,0)114183 "RTN","C0CPROBS",140,0) 114056 114184 . . D INSINNER^C0CXPATH(OUTXML,ARYTMP) 114057 "RTN","C0CPROBS", 88,0)114185 "RTN","C0CPROBS",141,0) 114058 114186 ; ZWR ^TMP("C0CCCR",$J,"PROBVALS",*) 114059 "RTN","C0CPROBS", 89,0)114187 "RTN","C0CPROBS",142,0) 114060 114188 ; ZWR ^TMP("C0CCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS 114061 "RTN","C0CPROBS", 90,0)114189 "RTN","C0CPROBS",143,0) 114062 114190 ; ZWR @OUTXML 114063 "RTN","C0CPROBS", 91,0)114191 "RTN","C0CPROBS",144,0) 114064 114192 ; $$HTML^DILF( 114065 "RTN","C0CPROBS", 92,0)114193 "RTN","C0CPROBS",145,0) 114066 114194 ; GENERATE THE NARITIVE HTML FOR THE CCD 114067 "RTN","C0CPROBS", 93,0)114195 "RTN","C0CPROBS",146,0) 114068 114196 I CCD D CCD ; IF THIS IS FOR A CCD 114069 "RTN","C0CPROBS", 94,0)114070 D MISS INGVARS114071 "RTN","C0CPROBS", 95,0)114197 "RTN","C0CPROBS",147,0) 114198 D MISSVARS 114199 "RTN","C0CPROBS",148,0) 114072 114200 Q 114073 "RTN","C0CPROBS",96,0)114074 ;114075 "RTN","C0CPROBS",97,0)114076 VISTA ; GETS THE PROBLEM LIST FOR VISTA114077 "RTN","C0CPROBS",98,0)114078 D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC114079 "RTN","C0CPROBS",99,0)114080 I '$D(RPCRSLT(1)) D Q ; RPC RETURNS NULL114081 "RTN","C0CPROBS",100,0)114082 . W "NULL RESULT FROM LIST^ORQQPL3 ",!114083 "RTN","C0CPROBS",101,0)114084 . S @OUTXML@(0)=0114085 "RTN","C0CPROBS",102,0)114086 . ; Q114087 "RTN","C0CPROBS",103,0)114088 ; I DEBUG ZWR RPCRSLT114089 "RTN","C0CPROBS",104,0)114090 S @TVMAP@(0)=RPCRSLT(0) ; SAVE NUMBER OF PROBLEMS114091 "RTN","C0CPROBS",105,0)114092 F J=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM IN THE LIST114093 "RTN","C0CPROBS",106,0)114094 . S VMAP=$NA(@TVMAP@(J))114095 "RTN","C0CPROBS",107,0)114096 . K @VMAP114097 "RTN","C0CPROBS",108,0)114098 . I DEBUG W "VMAP= ",VMAP,!114099 "RTN","C0CPROBS",109,0)114100 . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY114101 "RTN","C0CPROBS",110,0)114102 . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM114103 "RTN","C0CPROBS",111,0)114104 . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)114105 "RTN","C0CPROBS",112,0)114106 . S @VMAP@("PROBLEMSTATUS")=$S($P(PTMP,U,2)="A":"Active",$P(PTMP,U,2)="I":"Inactive",1:"")114107 "RTN","C0CPROBS",113,0)114108 . N ZPRIOR S ZPRIOR=$P(PTMP,U,14) ;PRIORITY FLAG114109 "RTN","C0CPROBS",114,0)114110 . ; turn off acute/chronic for certification gpl114111 "RTN","C0CPROBS",115,0)114112 . ;S @VMAP@("PROBLEMSTATUS")=@VMAP@("PROBLEMSTATUS")_$S(ZPRIOR="A":"/Acute",ZPRIOR="C":"/Chronic",1:"") ; append Chronic and Accute to Status114113 "RTN","C0CPROBS",116,0)114114 . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)114115 "RTN","C0CPROBS",117,0)114116 . S @VMAP@("PROBLEMCODINGVERSION")=""114117 "RTN","C0CPROBS",118,0)114118 . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)114119 "RTN","C0CPROBS",119,0)114120 . ; FOR CERTIFICATION - GPL114121 "RTN","C0CPROBS",120,0)114122 . I @VMAP@("PROBLEMCODEVALUE")["493.90" S @VMAP@("PROBLEMCODEVALUE")=493114123 "RTN","C0CPROBS",121,0)114124 . S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,5),"DT")114125 "RTN","C0CPROBS",122,0)114126 . S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,6),"DT")114127 "RTN","C0CPROBS",123,0)114128 . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)114129 "RTN","C0CPROBS",124,0)114130 . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)114131 "RTN","C0CPROBS",125,0)114132 . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)114133 "RTN","C0CPROBS",126,0)114134 . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)114135 "RTN","C0CPROBS",127,0)114136 . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)114137 "RTN","C0CPROBS",128,0)114138 . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)114139 "RTN","C0CPROBS",129,0)114140 . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER114141 "RTN","C0CPROBS",130,0)114142 . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)114143 "RTN","C0CPROBS",131,0)114144 . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)114145 "RTN","C0CPROBS",132,0)114146 . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)114147 "RTN","C0CPROBS",133,0)114148 . S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,15),"DT")114149 "RTN","C0CPROBS",134,0)114150 . S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,16),"DT")114151 "RTN","C0CPROBS",135,0)114152 . S ARYTMP=$NA(@TARYTMP@(J))114153 "RTN","C0CPROBS",136,0)114154 . ; W "ARYTMP= ",ARYTMP,!114155 "RTN","C0CPROBS",137,0)114156 . K @ARYTMP114157 "RTN","C0CPROBS",138,0)114158 . D MAP^C0CXPATH(IPXML,VMAP,ARYTMP) ;114159 "RTN","C0CPROBS",139,0)114160 . I J=1 D ; FIRST ONE IS JUST A COPY114161 "RTN","C0CPROBS",140,0)114162 . . ; W "FIRST ONE",!114163 "RTN","C0CPROBS",141,0)114164 . . D CP^C0CXPATH(ARYTMP,OUTXML)114165 "RTN","C0CPROBS",142,0)114166 . . ; W "OUTXML ",OUTXML,!114167 "RTN","C0CPROBS",143,0)114168 . I J>1 D ; AFTER THE FIRST, INSERT INNER XML114169 "RTN","C0CPROBS",144,0)114170 . . D INSINNER^C0CXPATH(OUTXML,ARYTMP)114171 "RTN","C0CPROBS",145,0)114172 ; ZWR ^TMP("C0CCCR",$J,"PROBVALS",*)114173 "RTN","C0CPROBS",146,0)114174 ; ZWR ^TMP("C0CCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS114175 "RTN","C0CPROBS",147,0)114176 ; ZWR @OUTXML114177 "RTN","C0CPROBS",148,0)114178 ; $$HTML^DILF(114179 114201 "RTN","C0CPROBS",149,0) 114180 ; GENERATE THE NARITIVE HTML FOR THE CCD 114202 CCD ; 114181 114203 "RTN","C0CPROBS",150,0) 114182 I CCD D CCD ; IF THIS IS FOR A CCD114204 N HTMP,HOUT,HTMLO,C0CPROBI,ZX 114183 114205 "RTN","C0CPROBS",151,0) 114184 D MISSINGVARS114206 F C0CPROBI=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM 114185 114207 "RTN","C0CPROBS",152,0) 114208 . S VMAP=$NA(@TVMAP@(C0CPROBI)) 114209 "RTN","C0CPROBS",153,0) 114210 . I DEBUG W "VMAP =",VMAP,! 114211 "RTN","C0CPROBS",154,0) 114212 . D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE 114213 "RTN","C0CPROBS",155,0) 114214 . D UNMARK^C0CXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP 114215 "RTN","C0CPROBS",156,0) 114216 . ; D PARY^C0CXPATH("HTMP") ; PRINT IT 114217 "RTN","C0CPROBS",157,0) 114218 . D MAP^C0CXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES 114219 "RTN","C0CPROBS",158,0) 114220 . ; D PARY^C0CXPATH("HOUT") ; PRINT IT AGAIN 114221 "RTN","C0CPROBS",159,0) 114222 . I C0CPROBI=1 D ; FIRST ONE IS JUST A COPY 114223 "RTN","C0CPROBS",160,0) 114224 . . D CP^C0CXPATH("HOUT","HTMLO") 114225 "RTN","C0CPROBS",161,0) 114226 . I C0CPROBI>1 D ; AFTER THE FIRST, INSERT INNER HTML 114227 "RTN","C0CPROBS",162,0) 114228 . . I DEBUG W "DOING INNER",! 114229 "RTN","C0CPROBS",163,0) 114230 . . N HTMLBLD,HTMLTMP 114231 "RTN","C0CPROBS",164,0) 114232 . . D QUEUE^C0CXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1) 114233 "RTN","C0CPROBS",165,0) 114234 . . D QUEUE^C0CXPATH("HTMLBLD","HOUT",2,HOUT(0)-1) 114235 "RTN","C0CPROBS",166,0) 114236 . . D QUEUE^C0CXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0)) 114237 "RTN","C0CPROBS",167,0) 114238 . . D BUILD^C0CXPATH("HTMLBLD","HTMLTMP") 114239 "RTN","C0CPROBS",168,0) 114240 . . D CP^C0CXPATH("HTMLTMP","HTMLO") 114241 "RTN","C0CPROBS",169,0) 114242 . . ; D INSINNER^C0CXPATH("HOUT","HTMLO","//") 114243 "RTN","C0CPROBS",170,0) 114244 I DEBUG D PARY^C0CXPATH("HTMLO") 114245 "RTN","C0CPROBS",171,0) 114246 D INSB4^C0CXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION 114247 "RTN","C0CPROBS",172,0) 114186 114248 Q 114187 "RTN","C0CPROBS",153,0)114188 CCD114189 "RTN","C0CPROBS",154,0)114190 N HTMP,HOUT,HTMLO,C0CPROBI,ZX114191 "RTN","C0CPROBS",155,0)114192 F C0CPROBI=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM114193 "RTN","C0CPROBS",156,0)114194 . S VMAP=$NA(@TVMAP@(C0CPROBI))114195 "RTN","C0CPROBS",157,0)114196 . I DEBUG W "VMAP =",VMAP,!114197 "RTN","C0CPROBS",158,0)114198 . D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE114199 "RTN","C0CPROBS",159,0)114200 . D UNMARK^C0CXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP114201 "RTN","C0CPROBS",160,0)114202 . ; D PARY^C0CXPATH("HTMP") ; PRINT IT114203 "RTN","C0CPROBS",161,0)114204 . D MAP^C0CXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES114205 "RTN","C0CPROBS",162,0)114206 . ; D PARY^C0CXPATH("HOUT") ; PRINT IT AGAIN114207 "RTN","C0CPROBS",163,0)114208 . I C0CPROBI=1 D ; FIRST ONE IS JUST A COPY114209 "RTN","C0CPROBS",164,0)114210 . . D CP^C0CXPATH("HOUT","HTMLO")114211 "RTN","C0CPROBS",165,0)114212 . I C0CPROBI>1 D ; AFTER THE FIRST, INSERT INNER HTML114213 "RTN","C0CPROBS",166,0)114214 . . I DEBUG W "DOING INNER",!114215 "RTN","C0CPROBS",167,0)114216 . . N HTMLBLD,HTMLTMP114217 "RTN","C0CPROBS",168,0)114218 . . D QUEUE^C0CXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)114219 "RTN","C0CPROBS",169,0)114220 . . D QUEUE^C0CXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)114221 "RTN","C0CPROBS",170,0)114222 . . D QUEUE^C0CXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))114223 "RTN","C0CPROBS",171,0)114224 . . D BUILD^C0CXPATH("HTMLBLD","HTMLTMP")114225 "RTN","C0CPROBS",172,0)114226 . . D CP^C0CXPATH("HTMLTMP","HTMLO")114227 114249 "RTN","C0CPROBS",173,0) 114228 . . ; D INSINNER^C0CXPATH("HOUT","HTMLO","//") 114250 MISSVARS ; Missing Variables 114229 114251 "RTN","C0CPROBS",174,0) 114230 I DEBUG D PARY^C0CXPATH("HTMLO")114252 N PROBSTMP,I 114231 114253 "RTN","C0CPROBS",175,0) 114232 D INSB4^C0CXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION114254 D MISSING^C0CXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS 114233 114255 "RTN","C0CPROBS",176,0) 114256 I PROBSTMP(0)>0 D ; IF THERE ARE MISSING VARS - 114257 "RTN","C0CPROBS",177,0) 114258 . ; STRINGS MARKED AS @@X@@ 114259 "RTN","C0CPROBS",178,0) 114260 . W !,"PROBLEMS Missing list: ",! 114261 "RTN","C0CPROBS",179,0) 114262 . F I=1:1:PROBSTMP(0) W PROBSTMP(I),! 114263 "RTN","C0CPROBS",180,0) 114234 114264 Q 114235 "RTN","C0CPROBS",177,0)114236 MISSINGVARS114237 "RTN","C0CPROBS",178,0)114238 N PROBSTMP,I114239 "RTN","C0CPROBS",179,0)114240 D MISSING^C0CXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS114241 "RTN","C0CPROBS",180,0)114242 I PROBSTMP(0)>0 D ; IF THERE ARE MISSING VARS -114243 114265 "RTN","C0CPROBS",181,0) 114244 . ; STRINGS MARKED AS @@X@@114245 "RTN","C0CPROBS",182,0)114246 . W !,"PROBLEMS Missing list: ",!114247 "RTN","C0CPROBS",183,0)114248 . F I=1:1:PROBSTMP(0) W PROBSTMP(I),!114249 "RTN","C0CPROBS",184,0)114250 Q114251 "RTN","C0CPROBS",185,0)114252 114266 ; 114253 114267 "RTN","C0CPROC") 114254 0^63^B2 7869918114268 0^63^B26886546 114255 114269 "RTN","C0CPROC",1,0) 114256 114270 C0CPROC ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROCEDURES ; 01/21/10 114257 114271 "RTN","C0CPROC",2,0) 114258 ;;1.2;C 0C;;May 11, 2012;Build 50114272 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 114259 114273 "RTN","C0CPROC",3,0) 114260 ; Copyright 2010 George Lilly, University of Minnesota and others.114274 ; 114261 114275 "RTN","C0CPROC",4,0) 114262 ; Licensed under the terms of the GNU General Public License.114276 ; This program is free software: you can redistribute it and/or modify 114263 114277 "RTN","C0CPROC",5,0) 114264 ; See attached copy of the License.114278 ; it under the terms of the GNU Affero General Public License as 114265 114279 "RTN","C0CPROC",6,0) 114266 ; 114280 ; published by the Free Software Foundation, either version 3 of the 114267 114281 "RTN","C0CPROC",7,0) 114268 ; This program is free software; you can redistribute it and/or modify114282 ; License, or (at your option) any later version. 114269 114283 "RTN","C0CPROC",8,0) 114270 ; it under the terms of the GNU General Public License as published by114284 ; 114271 114285 "RTN","C0CPROC",9,0) 114272 ; the Free Software Foundation; either version 2 of the License, or114286 ; This program is distributed in the hope that it will be useful, 114273 114287 "RTN","C0CPROC",10,0) 114274 ; (at your option) any later version.114288 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 114275 114289 "RTN","C0CPROC",11,0) 114276 ; 114290 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 114277 114291 "RTN","C0CPROC",12,0) 114278 ; This program is distributed in the hope that it will be useful,114292 ; GNU Affero General Public License for more details. 114279 114293 "RTN","C0CPROC",13,0) 114280 ; but WITHOUT ANY WARRANTY; without even the implied warranty of114294 ; 114281 114295 "RTN","C0CPROC",14,0) 114282 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the114296 ; You should have received a copy of the GNU Affero General Public License 114283 114297 "RTN","C0CPROC",15,0) 114284 ; GNU General Public License for more details.114298 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 114285 114299 "RTN","C0CPROC",16,0) 114286 114300 ; 114287 114301 "RTN","C0CPROC",17,0) 114288 ;You should have received a copy of the GNU General Public License along114302 W "NO ENTRY FROM TOP",! 114289 114303 "RTN","C0CPROC",18,0) 114290 ;with this program; if not, write to the Free Software Foundation, Inc.,114304 Q 114291 114305 "RTN","C0CPROC",19,0) 114292 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.114306 ; 114293 114307 "RTN","C0CPROC",20,0) 114294 ; 114308 SETVARS ; SET UP VARIABLES FOR PROCEDURES, ENCOUNTERS, AND NOTES 114295 114309 "RTN","C0CPROC",21,0) 114296 W "NO ENTRY FROM TOP",!114310 S C0CENC=$NA(^TMP("C0CCCR",$J,"C0CENC",DFN)) 114297 114311 "RTN","C0CPROC",22,0) 114312 S C0CPRC=$NA(^TMP("C0CCCR",$J,"C0CPRC",DFN)) 114313 "RTN","C0CPROC",23,0) 114314 S C0CNTE=$NA(^TMP("C0CCCR",$J,"C0CNTE",DFN)) 114315 "RTN","C0CPROC",24,0) 114316 ; ADDITION FOR CERTIFICATION 114317 "RTN","C0CPROC",25,0) 114318 S C0CPRSLT=$NA(^TMP("C0CCCR",$J,"C0CPRSLT",DFN)) 114319 "RTN","C0CPROC",26,0) 114298 114320 Q 114299 "RTN","C0CPROC",23,0)114300 ;114301 "RTN","C0CPROC",24,0)114302 SETVARS ; SET UP VARIABLES FOR PROCEDURES, ENCOUNTERS, AND NOTES114303 "RTN","C0CPROC",25,0)114304 S C0CENC=$NA(^TMP("C0CCCR",$J,"C0CENC",DFN))114305 "RTN","C0CPROC",26,0)114306 S C0CPRC=$NA(^TMP("C0CCCR",$J,"C0CPRC",DFN))114307 114321 "RTN","C0CPROC",27,0) 114308 S C0CNTE=$NA(^TMP("C0CCCR",$J,"C0CNTE",DFN))114322 ; 114309 114323 "RTN","C0CPROC",28,0) 114310 ; ADDITION FOR CERTIFICATION 114324 EXTRACT(PROCXML,DFN,PROCOUT) ; EXTRACT PROCEDURES INTO XML TEMPLATE 114311 114325 "RTN","C0CPROC",29,0) 114312 S C0CPRSLT=$NA(^TMP("C0CCCR",$J,"C0CPRSLT",DFN))114326 ; PROCXML AND PROCOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED 114313 114327 "RTN","C0CPROC",30,0) 114328 ; 114329 "RTN","C0CPROC",31,0) 114330 D SETVARS ; SET UP VARIABLES 114331 "RTN","C0CPROC",32,0) 114332 I '$D(@C0CPRC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE 114333 "RTN","C0CPROC",33,0) 114334 D MAP(PROCXML,C0CPRC,PROCOUT) ;MAP RESULTS FOR PROCEDURES 114335 "RTN","C0CPROC",34,0) 114314 114336 Q 114315 "RTN","C0CPROC",31,0)114316 ;114317 "RTN","C0CPROC",32,0)114318 EXTRACT(PROCXML,DFN,PROCOUT) ; EXTRACT PROCEDURES INTO XML TEMPLATE114319 "RTN","C0CPROC",33,0)114320 ; PROCXML AND PROCOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED114321 "RTN","C0CPROC",34,0)114322 ;114323 114337 "RTN","C0CPROC",35,0) 114324 D SETVARS ; SET UP VARIABLES114338 ; 114325 114339 "RTN","C0CPROC",36,0) 114326 I '$D(@C0CPRC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE 114340 TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES, 114327 114341 "RTN","C0CPROC",37,0) 114328 D MAP(PROCXML,C0CPRC,PROCOUT) ;MAP RESULTS FOR PROCEDURES114342 ; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME 114329 114343 "RTN","C0CPROC",38,0) 114344 ; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES 114345 "RTN","C0CPROC",39,0) 114346 ; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT 114347 "RTN","C0CPROC",40,0) 114348 ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY 114349 "RTN","C0CPROC",41,0) 114350 ; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM 114351 "RTN","C0CPROC",42,0) 114352 ; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS 114353 "RTN","C0CPROC",43,0) 114354 ; 114355 "RTN","C0CPROC",44,0) 114356 K VISIT,LST,NOTE,C0CLPRC 114357 "RTN","C0CPROC",45,0) 114358 ; C0CLPRC IS A LOOKUP TABLE FOR USE IN BUILDING ENCOUNTERS 114359 "RTN","C0CPROC",46,0) 114360 ; FORMAT C0CLPRC(VISITIEN,CPT)=PROCOBJECTID FOR BUILDING LINKS TO PROCEDURES 114361 "RTN","C0CPROC",47,0) 114362 D ENTRY^C0CCPT(DFN,,,1) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE 114363 "RTN","C0CPROC",48,0) 114364 ; NEED TO ADD START AND END DATES FROM PARAMETERS 114365 "RTN","C0CPROC",49,0) 114366 N ZI S ZI="" 114367 "RTN","C0CPROC",50,0) 114368 N PREVCPT,PREVDT S (PREVCPT,PREVDT)="" 114369 "RTN","C0CPROC",51,0) 114370 F S ZI=$O(VISIT(ZI),-1) Q:ZI="" D ; REVERSE TIME ORDER - MOST RECENT FIRST 114371 "RTN","C0CPROC",52,0) 114372 . N ZDATE 114373 "RTN","C0CPROC",53,0) 114374 . S ZDATE=$$DATE(VISIT(ZI,"DATE",0)) 114375 "RTN","C0CPROC",54,0) 114376 . S ZPRVARY=$NA(VISIT(ZI,"PRV")) 114377 "RTN","C0CPROC",55,0) 114378 . N ZPRV 114379 "RTN","C0CPROC",56,0) 114380 . S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM 114381 "RTN","C0CPROC",57,0) 114382 . ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON 114383 "RTN","C0CPROC",58,0) 114384 . N ZJ S ZJ="" 114385 "RTN","C0CPROC",59,0) 114386 . F S ZJ=$O(VISIT(ZI,"CPT",ZJ)) Q:ZJ="" D ;FOR EACH CPT SEG 114387 "RTN","C0CPROC",60,0) 114388 . . N ZRNF 114389 "RTN","C0CPROC",61,0) 114390 . . N ZCPT S ZCPT=$$CPT(VISIT(ZI,"CPT",ZJ)) ;GET CPT CODE AND TEXT 114391 "RTN","C0CPROC",62,0) 114392 . . I ZCPT'="" D ;IF CPT CODE IS PRESENT 114393 "RTN","C0CPROC",63,0) 114394 . . . I (ZCPT=PREVCPT)&(ZDATE=PREVDT) Q ; NO DUPS ALLOWED 114395 "RTN","C0CPROC",64,0) 114396 . . . W !,ZCPT," ",ZDATE," ",ZPRV 114397 "RTN","C0CPROC",65,0) 114398 . . . S ZRNF("PROCACTOROBJID")=ZPRV 114399 "RTN","C0CPROC",66,0) 114400 . . . N PROCCODE S PROCCODE=$P(ZCPT,U,1) 114401 "RTN","C0CPROC",67,0) 114402 . . . S ZRNF("PROCCODE")=PROCCODE 114403 "RTN","C0CPROC",68,0) 114404 . . . S ZRNF("PROCCODESYS")="CPT-4" 114405 "RTN","C0CPROC",69,0) 114406 . . . S ZRNF("PROCDATETEXT")="Procedure Date" 114407 "RTN","C0CPROC",70,0) 114408 . . . S ZRNF("PROCDATETIME")=ZDATE 114409 "RTN","C0CPROC",71,0) 114410 . . . S ZRNF("PROCDESCOBJATTRCODE")="" ;NO PROC ATTRIBUTES YET 114411 "RTN","C0CPROC",72,0) 114412 . . . S ZRNF("PROCDESCOBJATTR")="" 114413 "RTN","C0CPROC",73,0) 114414 . . . S ZRNF("PROCDESCOBJATTRCODESYS")="" ;WE DON'T HAVE PROC ATTRIBUTES 114415 "RTN","C0CPROC",74,0) 114416 . . . S ZRNF("PROCDESCOBJATTRVAL")="" 114417 "RTN","C0CPROC",75,0) 114418 . . . S ZRNF("PROCDESCTEXT")=$P(ZCPT,U,3) 114419 "RTN","C0CPROC",76,0) 114420 . . . S ZRNF("PROCLINKID")="" ; NO LINKS YET 114421 "RTN","C0CPROC",77,0) 114422 . . . S ZRNF("PROCLINKREL")="" ; NO LINKS YET 114423 "RTN","C0CPROC",78,0) 114424 . . . ; additions for Certification - need to have EKG in Results 114425 "RTN","C0CPROC",79,0) 114426 . . . S ZRNF("PROCTEXT")=$G(VISIT(ZI,"TEXT",1)) ; POTENTIAL RESULT 114427 "RTN","C0CPROC",80,0) 114428 . . . S ZRNF("PROCOBJECTID")="PROCEDURE_"_ZI_"_"_ZJ 114429 "RTN","C0CPROC",81,0) 114430 . . . S C0CLPRC(ZI,PROCCODE)=ZRNF("PROCOBJECTID") ; LOOKUP TABLE FOR ENCOUNTERS 114431 "RTN","C0CPROC",82,0) 114432 . . . S ZRNF("PROCSTATUS")="Completed" ; Is this right? 114433 "RTN","C0CPROC",83,0) 114434 . . . S ZRNF("PROCTYPE")=$P(ZCPT,U,2) ; NEED TO ADD THIS TO TEMPLATE 114435 "RTN","C0CPROC",84,0) 114436 . . . D RNF1TO2^C0CRNF(C0CPRC,"ZRNF") ; ADD THIS ROW TO THE ARRAY 114437 "RTN","C0CPROC",85,0) 114438 . . . ; FOR CERTIFICATION - SAVE EKG RESULTS gpl 114439 "RTN","C0CPROC",86,0) 114440 . . . W !,"CPT=",ZCPT 114441 "RTN","C0CPROC",87,0) 114442 . . . I ZCPT["93000" D ; THIS IS AN EKG 114443 "RTN","C0CPROC",88,0) 114444 . . . . D RNF1TO2^C0CRNF(C0CPRSLT,"ZRNF") ; SAVE FOR LABS 114445 "RTN","C0CPROC",89,0) 114446 . . . . M ^GPL("RNF2")=@C0CPRSLT 114447 "RTN","C0CPROC",90,0) 114448 . . . S PREVCPT=ZCPT 114449 "RTN","C0CPROC",91,0) 114450 . . . S PREVDT=ZDATE 114451 "RTN","C0CPROC",92,0) 114452 N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"PROCEDURES")) 114453 "RTN","C0CPROC",93,0) 114454 M @ZRIM=@C0CPRC@("V") 114455 "RTN","C0CPROC",94,0) 114330 114456 Q 114331 "RTN","C0CPROC",39,0)114332 ;114333 "RTN","C0CPROC",40,0)114334 TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES,114335 "RTN","C0CPROC",41,0)114336 ; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME114337 "RTN","C0CPROC",42,0)114338 ; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES114339 "RTN","C0CPROC",43,0)114340 ; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT114341 "RTN","C0CPROC",44,0)114342 ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY114343 "RTN","C0CPROC",45,0)114344 ; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM114345 "RTN","C0CPROC",46,0)114346 ; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS114347 "RTN","C0CPROC",47,0)114348 ;114349 "RTN","C0CPROC",48,0)114350 K VISIT,LST,NOTE,C0CLPRC114351 "RTN","C0CPROC",49,0)114352 ; C0CLPRC IS A LOOKUP TABLE FOR USE IN BUILDING ENCOUNTERS114353 "RTN","C0CPROC",50,0)114354 ; FORMAT C0CLPRC(VISITIEN,CPT)=PROCOBJECTID FOR BUILDING LINKS TO PROCEDURES114355 "RTN","C0CPROC",51,0)114356 D ENTRY^C0CCPT(DFN,,,1) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE114357 "RTN","C0CPROC",52,0)114358 ; NEED TO ADD START AND END DATES FROM PARAMETERS114359 "RTN","C0CPROC",53,0)114360 N ZI S ZI=""114361 "RTN","C0CPROC",54,0)114362 N PREVCPT,PREVDT S (PREVCPT,PREVDT)=""114363 "RTN","C0CPROC",55,0)114364 F S ZI=$O(VISIT(ZI),-1) Q:ZI="" D ; REVERSE TIME ORDER - MOST RECENT FIRST114365 "RTN","C0CPROC",56,0)114366 . N ZDATE114367 "RTN","C0CPROC",57,0)114368 . S ZDATE=$$DATE(VISIT(ZI,"DATE",0))114369 "RTN","C0CPROC",58,0)114370 . S ZPRVARY=$NA(VISIT(ZI,"PRV"))114371 "RTN","C0CPROC",59,0)114372 . N ZPRV114373 "RTN","C0CPROC",60,0)114374 . S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM114375 "RTN","C0CPROC",61,0)114376 . ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON114377 "RTN","C0CPROC",62,0)114378 . N ZJ S ZJ=""114379 "RTN","C0CPROC",63,0)114380 . F S ZJ=$O(VISIT(ZI,"CPT",ZJ)) Q:ZJ="" D ;FOR EACH CPT SEG114381 "RTN","C0CPROC",64,0)114382 . . N ZRNF114383 "RTN","C0CPROC",65,0)114384 . . N ZCPT S ZCPT=$$CPT(VISIT(ZI,"CPT",ZJ)) ;GET CPT CODE AND TEXT114385 "RTN","C0CPROC",66,0)114386 . . I ZCPT'="" D ;IF CPT CODE IS PRESENT114387 "RTN","C0CPROC",67,0)114388 . . . I (ZCPT=PREVCPT)&(ZDATE=PREVDT) Q ; NO DUPS ALLOWED114389 "RTN","C0CPROC",68,0)114390 . . . W !,ZCPT," ",ZDATE," ",ZPRV114391 "RTN","C0CPROC",69,0)114392 . . . S ZRNF("PROCACTOROBJID")=ZPRV114393 "RTN","C0CPROC",70,0)114394 . . . N PROCCODE S PROCCODE=$P(ZCPT,U,1)114395 "RTN","C0CPROC",71,0)114396 . . . S ZRNF("PROCCODE")=PROCCODE114397 "RTN","C0CPROC",72,0)114398 . . . S ZRNF("PROCCODESYS")="CPT-4"114399 "RTN","C0CPROC",73,0)114400 . . . S ZRNF("PROCDATETEXT")="Procedure Date"114401 "RTN","C0CPROC",74,0)114402 . . . S ZRNF("PROCDATETIME")=ZDATE114403 "RTN","C0CPROC",75,0)114404 . . . S ZRNF("PROCDESCOBJATTRCODE")="" ;NO PROC ATTRIBUTES YET114405 "RTN","C0CPROC",76,0)114406 . . . S ZRNF("PROCDESCOBJATTR")=""114407 "RTN","C0CPROC",77,0)114408 . . . S ZRNF("PROCDESCOBJATTRCODESYS")="" ;WE DON'T HAVE PROC ATTRIBUTES114409 "RTN","C0CPROC",78,0)114410 . . . S ZRNF("PROCDESCOBJATTRVAL")=""114411 "RTN","C0CPROC",79,0)114412 . . . S ZRNF("PROCDESCTEXT")=$P(ZCPT,U,3)114413 "RTN","C0CPROC",80,0)114414 . . . S ZRNF("PROCLINKID")="" ; NO LINKS YET114415 "RTN","C0CPROC",81,0)114416 . . . S ZRNF("PROCLINKREL")="" ; NO LINKS YET114417 "RTN","C0CPROC",82,0)114418 . . . ; additions for Certification - need to have EKG in Results114419 "RTN","C0CPROC",83,0)114420 . . . S ZRNF("PROCTEXT")=$G(VISIT(ZI,"TEXT",1)) ; POTENTIAL RESULT114421 "RTN","C0CPROC",84,0)114422 . . . S ZRNF("PROCOBJECTID")="PROCEDURE_"_ZI_"_"_ZJ114423 "RTN","C0CPROC",85,0)114424 . . . S C0CLPRC(ZI,PROCCODE)=ZRNF("PROCOBJECTID") ; LOOKUP TABLE FOR ENCOUNTERS114425 "RTN","C0CPROC",86,0)114426 . . . S ZRNF("PROCSTATUS")="Completed" ; Is this right?114427 "RTN","C0CPROC",87,0)114428 . . . S ZRNF("PROCTYPE")=$P(ZCPT,U,2) ; NEED TO ADD THIS TO TEMPLATE114429 "RTN","C0CPROC",88,0)114430 . . . D RNF1TO2^C0CRNF(C0CPRC,"ZRNF") ; ADD THIS ROW TO THE ARRAY114431 "RTN","C0CPROC",89,0)114432 . . . ; FOR CERTIFICATION - SAVE EKG RESULTS gpl114433 "RTN","C0CPROC",90,0)114434 . . . W !,"CPT=",ZCPT114435 "RTN","C0CPROC",91,0)114436 . . . I ZCPT["93000" D ; THIS IS AN EKG114437 "RTN","C0CPROC",92,0)114438 . . . . D RNF1TO2^C0CRNF(C0CPRSLT,"ZRNF") ; SAVE FOR LABS114439 "RTN","C0CPROC",93,0)114440 . . . . M ^GPL("RNF2")=@C0CPRSLT114441 "RTN","C0CPROC",94,0)114442 . . . S PREVCPT=ZCPT114443 114457 "RTN","C0CPROC",95,0) 114444 . . . S PREVDT=ZDATE114458 ; 114445 114459 "RTN","C0CPROC",96,0) 114446 N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"PROCEDURES")) 114460 PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME 114447 114461 "RTN","C0CPROC",97,0) 114448 M @ZRIM=@C0CPRC@("V")114462 N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN="" 114449 114463 "RTN","C0CPROC",98,0) 114464 F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH PRV SEG 114465 "RTN","C0CPROC",99,0) 114466 . I ZR'="" Q ;ONLY WANT THE FIRST PRIMARY PROVIDER 114467 "RTN","C0CPROC",100,0) 114468 . I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1) 114469 "RTN","C0CPROC",101,0) 114470 I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR 114471 "RTN","C0CPROC",102,0) 114472 Q ZRTN 114473 "RTN","C0CPROC",103,0) 114474 ; 114475 "RTN","C0CPROC",104,0) 114476 DATE(ISTR) ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT 114477 "RTN","C0CPROC",105,0) 114478 Q $$FMDTOUTC^C0CUTIL(ISTR,"DT") 114479 "RTN","C0CPROC",106,0) 114480 ; 114481 "RTN","C0CPROC",107,0) 114482 CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS 114483 "RTN","C0CPROC",108,0) 114484 ; CPT^CATEGORY^TEXT 114485 "RTN","C0CPROC",109,0) 114486 N Z1,Z2,Z3,ZRTN 114487 "RTN","C0CPROC",110,0) 114488 S Z1=$P(ISTR,U,1) 114489 "RTN","C0CPROC",111,0) 114490 I Z1="" D ; 114491 "RTN","C0CPROC",112,0) 114492 . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1) 114493 "RTN","C0CPROC",113,0) 114494 I Z1'="" D ; IF THERE IS A CPT CODE IN THERE 114495 "RTN","C0CPROC",114,0) 114496 . ;S Z1=$P(ISTR,U,1) 114497 "RTN","C0CPROC",115,0) 114498 . S Z2=$P(ISTR,U,2) 114499 "RTN","C0CPROC",116,0) 114500 . S Z3=$P(ISTR,U,3) 114501 "RTN","C0CPROC",117,0) 114502 . S ZRTN=Z1_U_Z2_U_Z3 114503 "RTN","C0CPROC",118,0) 114504 E S ZRTN="" 114505 "RTN","C0CPROC",119,0) 114506 Q ZRTN 114507 "RTN","C0CPROC",120,0) 114508 ; 114509 "RTN","C0CPROC",121,0) 114510 MAP(PROCXML,C0CPRC,PROCOUT) ; MAP PROCEDURES XML 114511 "RTN","C0CPROC",122,0) 114512 ; 114513 "RTN","C0CPROC",123,0) 114514 N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"PROCTEMP")) ;WORK AREA FOR TEMPLATE 114515 "RTN","C0CPROC",124,0) 114516 K @ZTEMP 114517 "RTN","C0CPROC",125,0) 114518 N ZBLD 114519 "RTN","C0CPROC",126,0) 114520 S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"PROCBLD")) ; BUILD LIST AREA 114521 "RTN","C0CPROC",127,0) 114522 D QUEUE^C0CXPATH(ZBLD,PROCXML,1,1) ; FIRST LINE 114523 "RTN","C0CPROC",128,0) 114524 N ZINNER 114525 "RTN","C0CPROC",129,0) 114526 D QUERY^C0CXPATH(PROCXML,"//Procedures/Procedure","ZINNER") ;ONE PROC 114527 "RTN","C0CPROC",130,0) 114528 N ZTMP,ZVAR,ZI 114529 "RTN","C0CPROC",131,0) 114530 S ZI="" 114531 "RTN","C0CPROC",132,0) 114532 F S ZI=$O(@C0CPRC@("V",ZI)) Q:ZI="" D ;FOR EACH PROCEDURE 114533 "RTN","C0CPROC",133,0) 114534 . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS PROCEDURE XML 114535 "RTN","C0CPROC",134,0) 114536 . S ZVAR=$NA(@C0CPRC@("V",ZI)) ;THIS PROCEDURE VARIABLES 114537 "RTN","C0CPROC",135,0) 114538 . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE 114539 "RTN","C0CPROC",136,0) 114540 . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD 114541 "RTN","C0CPROC",137,0) 114542 D QUEUE^C0CXPATH(ZBLD,PROCXML,@PROCXML@(0),@PROCXML@(0)) 114543 "RTN","C0CPROC",138,0) 114544 N ZZTMP 114545 "RTN","C0CPROC",139,0) 114546 D BUILD^C0CXPATH(ZBLD,PROCOUT) ;BUILD FINAL XML 114547 "RTN","C0CPROC",140,0) 114548 K @ZTEMP,@ZBLD,@C0CPRC 114549 "RTN","C0CPROC",141,0) 114450 114550 Q 114451 "RTN","C0CPROC",99,0)114452 ;114453 "RTN","C0CPROC",100,0)114454 PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME114455 "RTN","C0CPROC",101,0)114456 N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN=""114457 "RTN","C0CPROC",102,0)114458 F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH PRV SEG114459 "RTN","C0CPROC",103,0)114460 . I ZR'="" Q ;ONLY WANT THE FIRST PRIMARY PROVIDER114461 "RTN","C0CPROC",104,0)114462 . I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1)114463 "RTN","C0CPROC",105,0)114464 I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR114465 "RTN","C0CPROC",106,0)114466 Q ZRTN114467 "RTN","C0CPROC",107,0)114468 ;114469 "RTN","C0CPROC",108,0)114470 DATE(ISTR) ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT114471 "RTN","C0CPROC",109,0)114472 Q $$FMDTOUTC^C0CUTIL(ISTR,"DT")114473 "RTN","C0CPROC",110,0)114474 ;114475 "RTN","C0CPROC",111,0)114476 CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS114477 "RTN","C0CPROC",112,0)114478 ; CPT^CATEGORY^TEXT114479 "RTN","C0CPROC",113,0)114480 N Z1,Z2,Z3,ZRTN114481 "RTN","C0CPROC",114,0)114482 S Z1=$P(ISTR,U,1)114483 "RTN","C0CPROC",115,0)114484 I Z1="" D ;114485 "RTN","C0CPROC",116,0)114486 . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)114487 "RTN","C0CPROC",117,0)114488 I Z1'="" D ; IF THERE IS A CPT CODE IN THERE114489 "RTN","C0CPROC",118,0)114490 . ;S Z1=$P(ISTR,U,1)114491 "RTN","C0CPROC",119,0)114492 . S Z2=$P(ISTR,U,2)114493 "RTN","C0CPROC",120,0)114494 . S Z3=$P(ISTR,U,3)114495 "RTN","C0CPROC",121,0)114496 . S ZRTN=Z1_U_Z2_U_Z3114497 "RTN","C0CPROC",122,0)114498 E S ZRTN=""114499 "RTN","C0CPROC",123,0)114500 Q ZRTN114501 "RTN","C0CPROC",124,0)114502 ;114503 "RTN","C0CPROC",125,0)114504 MAP(PROCXML,C0CPRC,PROCOUT) ; MAP PROCEDURES XML114505 "RTN","C0CPROC",126,0)114506 ;114507 "RTN","C0CPROC",127,0)114508 N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"PROCTEMP")) ;WORK AREA FOR TEMPLATE114509 "RTN","C0CPROC",128,0)114510 K @ZTEMP114511 "RTN","C0CPROC",129,0)114512 N ZBLD114513 "RTN","C0CPROC",130,0)114514 S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"PROCBLD")) ; BUILD LIST AREA114515 "RTN","C0CPROC",131,0)114516 D QUEUE^C0CXPATH(ZBLD,PROCXML,1,1) ; FIRST LINE114517 "RTN","C0CPROC",132,0)114518 N ZINNER114519 "RTN","C0CPROC",133,0)114520 D QUERY^C0CXPATH(PROCXML,"//Procedures/Procedure","ZINNER") ;ONE PROC114521 "RTN","C0CPROC",134,0)114522 N ZTMP,ZVAR,ZI114523 "RTN","C0CPROC",135,0)114524 S ZI=""114525 "RTN","C0CPROC",136,0)114526 F S ZI=$O(@C0CPRC@("V",ZI)) Q:ZI="" D ;FOR EACH PROCEDURE114527 "RTN","C0CPROC",137,0)114528 . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS PROCEDURE XML114529 "RTN","C0CPROC",138,0)114530 . S ZVAR=$NA(@C0CPRC@("V",ZI)) ;THIS PROCEDURE VARIABLES114531 "RTN","C0CPROC",139,0)114532 . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE114533 "RTN","C0CPROC",140,0)114534 . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD114535 "RTN","C0CPROC",141,0)114536 D QUEUE^C0CXPATH(ZBLD,PROCXML,@PROCXML@(0),@PROCXML@(0))114537 114551 "RTN","C0CPROC",142,0) 114538 N ZZTMP114539 "RTN","C0CPROC",143,0)114540 D BUILD^C0CXPATH(ZBLD,PROCOUT) ;BUILD FINAL XML114541 "RTN","C0CPROC",144,0)114542 K @ZTEMP,@ZBLD,@C0CPRC114543 "RTN","C0CPROC",145,0)114544 Q114545 "RTN","C0CPROC",146,0)114546 114552 ; 114547 114553 "RTN","C0CPXRM") 114548 0^92^B 14904056114554 0^92^B4357 114549 114555 "RTN","C0CPXRM",1,0) 114550 114556 C0CPXRM ; 114551 114557 "RTN","C0CPXRM",2,0) 114552 ;;1.2;C 0C;;May 11, 2012;Build 50114558 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 114553 114559 "RTN","C0CPXRM",3,0) 114554 114560 DOIT ; 114555 114561 "RTN","C0CPXRM",4,0) 114556 S G="PXRMXSEPCLINIC3110302.224804" ZWR ^XTMP(G,*)114562 ; S G="PXRMXSEPCLINIC3110302.224804" ZWR ^XTMP(G,*) 114557 114563 "RTN","C0CPXRM",5,0) 114558 S G="PXRMXSEPCLINIC3110302.223957" ZWR ^XTMP(G,*)114564 ; S G="PXRMXSEPCLINIC3110302.223957" ZWR ^XTMP(G,*) 114559 114565 "RTN","C0CPXRM",6,0) 114560 S G="PXRMXSEPCLINIC3110302.223738" ZWR ^XTMP(G,*)114566 ; S G="PXRMXSEPCLINIC3110302.223738" ZWR ^XTMP(G,*) 114561 114567 "RTN","C0CPXRM",7,0) 114562 S G="PXRMXSEPCLINIC3110302.223516" ZWR ^XTMP(G,*)114568 ; S G="PXRMXSEPCLINIC3110302.223516" ZWR ^XTMP(G,*) 114563 114569 "RTN","C0CPXRM",8,0) 114564 S G="PXRMXSEPCLINIC3110302.222158" ZWR ^XTMP(G,*)114570 ; S G="PXRMXSEPCLINIC3110302.222158" ZWR ^XTMP(G,*) 114565 114571 "RTN","C0CPXRM",9,0) 114566 S G="PXRMXSEPCLINIC3110302.213944" ZWR ^XTMP(G,*)114572 ; S G="PXRMXSEPCLINIC3110302.213944" ZWR ^XTMP(G,*) 114567 114573 "RTN","C0CPXRM",10,0) 114568 S G="PXRMXSEPCLINIC3110302.212219" ZWR ^XTMP(G,*)114574 ; S G="PXRMXSEPCLINIC3110302.212219" ZWR ^XTMP(G,*) 114569 114575 "RTN","C0CPXRM",11,0) 114570 S G="PXRMXSEPCLINIC3110302.211506" ZWR ^XTMP(G,*)114576 ; S G="PXRMXSEPCLINIC3110302.211506" ZWR ^XTMP(G,*) 114571 114577 "RTN","C0CPXRM",12,0) 114572 S G="PXRMXSEPCLINIC3110302.002714" ZWR ^XTMP(G,*)114578 ; S G="PXRMXSEPCLINIC3110302.002714" ZWR ^XTMP(G,*) 114573 114579 "RTN","C0CPXRM",13,0) 114574 S G="PXRMXSEPCLINIC3110302.001841" ZWR ^XTMP(G,*)114580 ; S G="PXRMXSEPCLINIC3110302.001841" ZWR ^XTMP(G,*) 114575 114581 "RTN","C0CPXRM",14,0) 114576 S G="PXRMXSEPCLINIC3110302.000846" ZWR ^XTMP(G,*)114582 ; S G="PXRMXSEPCLINIC3110302.000846" ZWR ^XTMP(G,*) 114577 114583 "RTN","C0CPXRM",15,0) 114578 S G="PXRMXSEPCLINIC3110115.141918" ZWR ^XTMP(G,*)114584 ; S G="PXRMXSEPCLINIC3110115.141918" ZWR ^XTMP(G,*) 114579 114585 "RTN","C0CPXRM",16,0) 114580 S G="PXRMXSEPCLINIC3110115.132312" ZWR ^XTMP(G,*)114586 ; S G="PXRMXSEPCLINIC3110115.132312" ZWR ^XTMP(G,*) 114581 114587 "RTN","C0CPXRM",17,0) 114582 S G="PXRMXSEPCLINIC3110115.131653" ZWR ^XTMP(G,*)114588 ; S G="PXRMXSEPCLINIC3110115.131653" ZWR ^XTMP(G,*) 114583 114589 "RTN","C0CPXRM",18,0) 114584 S G="PXRMXSEPCLINIC3110115.131008" ZWR ^XTMP(G,*)114590 ; S G="PXRMXSEPCLINIC3110115.131008" ZWR ^XTMP(G,*) 114585 114591 "RTN","C0CPXRM",19,0) 114586 S G="PXRM PXK EVENT988 3110224.210456" ZWR ^XTMP(G,*)114592 ; S G="PXRM PXK EVENT988 3110224.210456" ZWR ^XTMP(G,*) 114587 114593 "RTN","C0CPXRM",20,0) 114588 S G="PXRM PXK EVENT986 3110224.210456" ZWR ^XTMP(G,*)114594 ; S G="PXRM PXK EVENT986 3110224.210456" ZWR ^XTMP(G,*) 114589 114595 "RTN","C0CPXRM",21,0) 114590 S G="PXRM PXK EVENT932 3110224.210456" ZWR ^XTMP(G,*)114596 ; S G="PXRM PXK EVENT932 3110224.210456" ZWR ^XTMP(G,*) 114591 114597 "RTN","C0CPXRM",22,0) 114592 S G="PXRM PXK EVENT932 3110224.210455" ZWR ^XTMP(G,*)114598 ; S G="PXRM PXK EVENT932 3110224.210455" ZWR ^XTMP(G,*) 114593 114599 "RTN","C0CPXRM",23,0) 114594 S G="PXRM PXK EVENT8015 3110301.215142" ZWR ^XTMP(G,*)114600 ; S G="PXRM PXK EVENT8015 3110301.215142" ZWR ^XTMP(G,*) 114595 114601 "RTN","C0CPXRM",24,0) 114596 S G="PXRM PXK EVENT8015 3110301.215141" ZWR ^XTMP(G,*)114602 ; S G="PXRM PXK EVENT8015 3110301.215141" ZWR ^XTMP(G,*) 114597 114603 "RTN","C0CPXRM",25,0) 114598 S G="PXRM PXK EVENT5265 3110309.124047" ZWR ^XTMP(G,*)114604 ; S G="PXRM PXK EVENT5265 3110309.124047" ZWR ^XTMP(G,*) 114599 114605 "RTN","C0CPXRM",26,0) 114600 S G="PXRM PXK EVENT5265 3110309.124046" ZWR ^XTMP(G,*)114606 ; S G="PXRM PXK EVENT5265 3110309.124046" ZWR ^XTMP(G,*) 114601 114607 "RTN","C0CPXRM",27,0) 114602 S G="PXRM PXK EVENT4742 3101129.221201" ZWR ^XTMP(G,*)114608 ; S G="PXRM PXK EVENT4742 3101129.221201" ZWR ^XTMP(G,*) 114603 114609 "RTN","C0CPXRM",28,0) 114604 S G="PXRM PXK EVENT4742 3101129.215741" ZWR ^XTMP(G,*)114610 ; S G="PXRM PXK EVENT4742 3101129.215741" ZWR ^XTMP(G,*) 114605 114611 "RTN","C0CPXRM",29,0) 114606 S G="PXRM PXK EVENT4710 3101129.215701" ZWR ^XTMP(G,*)114612 ; S G="PXRM PXK EVENT4710 3101129.215701" ZWR ^XTMP(G,*) 114607 114613 "RTN","C0CPXRM",30,0) 114608 S G="PXRM PXK EVENT3297 3101127.123134" ZWR ^XTMP(G,*)114614 ; S G="PXRM PXK EVENT3297 3101127.123134" ZWR ^XTMP(G,*) 114609 114615 "RTN","C0CPXRM",31,0) 114610 S G="PXRM PXK EVENT32495 3110224.194246" ZWR ^XTMP(G,*)114616 ; S G="PXRM PXK EVENT32495 3110224.194246" ZWR ^XTMP(G,*) 114611 114617 "RTN","C0CPXRM",32,0) 114612 S G="PXRM PXK EVENT32493 3110224.194246" ZWR ^XTMP(G,*)114618 ; S G="PXRM PXK EVENT32493 3110224.194246" ZWR ^XTMP(G,*) 114613 114619 "RTN","C0CPXRM",33,0) 114614 S G="PXRM PXK EVENT32354 3110224.194246" ZWR ^XTMP(G,*)114620 ; S G="PXRM PXK EVENT32354 3110224.194246" ZWR ^XTMP(G,*) 114615 114621 "RTN","C0CPXRM",34,0) 114616 S G="PXRM PXK EVENT32354 3110224.194245" ZWR ^XTMP(G,*)114622 ; S G="PXRM PXK EVENT32354 3110224.194245" ZWR ^XTMP(G,*) 114617 114623 "RTN","C0CPXRM",35,0) 114618 S G="PXRM PXK EVENT31106 3110224.175105" ZWR ^XTMP(G,*)114624 ; S G="PXRM PXK EVENT31106 3110224.175105" ZWR ^XTMP(G,*) 114619 114625 "RTN","C0CPXRM",36,0) 114620 S G="PXRM PXK EVENT31090 3110224.175105" ZWR ^XTMP(G,*)114626 ; S G="PXRM PXK EVENT31090 3110224.175105" ZWR ^XTMP(G,*) 114621 114627 "RTN","C0CPXRM",37,0) 114622 S G="PXRM PXK EVENT30339 3110224.175105" ZWR ^XTMP(G,*)114628 ; S G="PXRM PXK EVENT30339 3110224.175105" ZWR ^XTMP(G,*) 114623 114629 "RTN","C0CPXRM",38,0) 114624 S G="PXRM PXK EVENT30339 3110224.175103" ZWR ^XTMP(G,*)114630 ; S G="PXRM PXK EVENT30339 3110224.175103" ZWR ^XTMP(G,*) 114625 114631 "RTN","C0CPXRM",39,0) 114626 S G="PXRM PXK EVENT2761 3110115.174109" ZWR ^XTMP(G,*)114632 ; S G="PXRM PXK EVENT2761 3110115.174109" ZWR ^XTMP(G,*) 114627 114633 "RTN","C0CPXRM",40,0) 114628 S G="PXRM PXK EVENT2761 3110115.174108" ZWR ^XTMP(G,*)114634 ; S G="PXRM PXK EVENT2761 3110115.174108" ZWR ^XTMP(G,*) 114629 114635 "RTN","C0CPXRM",41,0) 114630 S G="PXRM PXK EVENT27327 3110227.013658" ZWR ^XTMP(G,*)114636 ; S G="PXRM PXK EVENT27327 3110227.013658" ZWR ^XTMP(G,*) 114631 114637 "RTN","C0CPXRM",42,0) 114632 S G="PXRM PXK EVENT27327 3110227.013657" ZWR ^XTMP(G,*)114638 ; S G="PXRM PXK EVENT27327 3110227.013657" ZWR ^XTMP(G,*) 114633 114639 "RTN","C0CPXRM",43,0) 114634 S G="PXRM PXK EVENT27327 3110227.013523" ZWR ^XTMP(G,*)114640 ; S G="PXRM PXK EVENT27327 3110227.013523" ZWR ^XTMP(G,*) 114635 114641 "RTN","C0CPXRM",44,0) 114636 S G="PXRM PXK EVENT27327 3110227.013522" ZWR ^XTMP(G,*)114642 ; S G="PXRM PXK EVENT27327 3110227.013522" ZWR ^XTMP(G,*) 114637 114643 "RTN","C0CPXRM",45,0) 114638 S G="PXRM PXK EVENT27253 3110227.012747" ZWR ^XTMP(G,*)114644 ; S G="PXRM PXK EVENT27253 3110227.012747" ZWR ^XTMP(G,*) 114639 114645 "RTN","C0CPXRM",46,0) 114640 S G="PXRM PXK EVENT27253 3110227.012746" ZWR ^XTMP(G,*)114646 ; S G="PXRM PXK EVENT27253 3110227.012746" ZWR ^XTMP(G,*) 114641 114647 "RTN","C0CPXRM",47,0) 114642 S G="PXRM PXK EVENT2559 3110115.170835" ZWR ^XTMP(G,*)114648 ; S G="PXRM PXK EVENT2559 3110115.170835" ZWR ^XTMP(G,*) 114643 114649 "RTN","C0CPXRM",48,0) 114644 S G="PXRM PXK EVENT25549 3110228.231135" ZWR ^XTMP(G,*)114650 ; S G="PXRM PXK EVENT25549 3110228.231135" ZWR ^XTMP(G,*) 114645 114651 "RTN","C0CPXRM",49,0) 114646 S G="PXRM PXK EVENT25549 3110228.231134" ZWR ^XTMP(G,*)114652 ; S G="PXRM PXK EVENT25549 3110228.231134" ZWR ^XTMP(G,*) 114647 114653 "RTN","C0CPXRM",50,0) 114648 S G="PXRM PXK EVENT2205 3101129.215343" ZWR ^XTMP(G,*)114654 ; S G="PXRM PXK EVENT2205 3101129.215343" ZWR ^XTMP(G,*) 114649 114655 "RTN","C0CPXRM",51,0) 114650 S G="PXRM PXK EVENT21092 3110114.195621" ZWR ^XTMP(G,*)114656 ; S G="PXRM PXK EVENT21092 3110114.195621" ZWR ^XTMP(G,*) 114651 114657 "RTN","C0CPXRM",52,0) 114652 S G="PXRM PXK EVENT21092 3110114.193803" ZWR ^XTMP(G,*)114658 ; S G="PXRM PXK EVENT21092 3110114.193803" ZWR ^XTMP(G,*) 114653 114659 "RTN","C0CPXRM",53,0) 114654 S G="PXRM PXK EVENT19640 3110226.032943" ZWR ^XTMP(G,*)114660 ; S G="PXRM PXK EVENT19640 3110226.032943" ZWR ^XTMP(G,*) 114655 114661 "RTN","C0CPXRM",54,0) 114656 S G="PXRM PXK EVENT19640 3110226.032941" ZWR ^XTMP(G,*)114662 ; S G="PXRM PXK EVENT19640 3110226.032941" ZWR ^XTMP(G,*) 114657 114663 "RTN","C0CPXRM",55,0) 114658 S G="PXRM PXK EVENT19353 3101212.162833" ZWR ^XTMP(G,*)114664 ; S G="PXRM PXK EVENT19353 3101212.162833" ZWR ^XTMP(G,*) 114659 114665 "RTN","C0CPXRM",56,0) 114660 S G="PXRM PXK EVENT18780 3110221.215603" ZWR ^XTMP(G,*)114666 ; S G="PXRM PXK EVENT18780 3110221.215603" ZWR ^XTMP(G,*) 114661 114667 "RTN","C0CPXRM",57,0) 114662 S G="PXRM PXK EVENT18156 3101212.152654" ZWR ^XTMP(G,*)114668 ; S G="PXRM PXK EVENT18156 3101212.152654" ZWR ^XTMP(G,*) 114663 114669 "RTN","C0CPXRM",58,0) 114664 S G="PXRM PXK EVENT17800 3110315.202432" ZWR ^XTMP(G,*)114670 ; S G="PXRM PXK EVENT17800 3110315.202432" ZWR ^XTMP(G,*) 114665 114671 "RTN","C0CPXRM",59,0) 114666 S G="PXRM PXK EVENT1650 3110220.192925" ZWR ^XTMP(G,*)114672 ; S G="PXRM PXK EVENT1650 3110220.192925" ZWR ^XTMP(G,*) 114667 114673 "RTN","C0CPXRM",60,0) 114668 S G="PXRM PXK EVENT16110 3110313.224636" ZWR ^XTMP(G,*)114674 ; S G="PXRM PXK EVENT16110 3110313.224636" ZWR ^XTMP(G,*) 114669 114675 "RTN","C0CPXRM",61,0) 114670 S G="PXRM PXK EVENT16004 3110317.151215" ZWR ^XTMP(G,*)114676 ; S G="PXRM PXK EVENT16004 3110317.151215" ZWR ^XTMP(G,*) 114671 114677 "RTN","C0CPXRM",62,0) 114672 S G="PXRM PXK EVENT16004 3110317.150834" ZWR ^XTMP(G,*)114678 ; S G="PXRM PXK EVENT16004 3110317.150834" ZWR ^XTMP(G,*) 114673 114679 "RTN","C0CPXRM",63,0) 114674 S G="PXRM PXK EVENT14955 3110315.165018" ZWR ^XTMP(G,*)114680 ; S G="PXRM PXK EVENT14955 3110315.165018" ZWR ^XTMP(G,*) 114675 114681 "RTN","C0CPXRM",64,0) 114676 S G="PXRM PXK EVENT14816 3110315.164839" ZWR ^XTMP(G,*)114682 ; S G="PXRM PXK EVENT14816 3110315.164839" ZWR ^XTMP(G,*) 114677 114683 "RTN","C0CPXRM",65,0) 114678 S G="PXRM PXK EVENT14816 3110315.164512" ZWR ^XTMP(G,*)114684 ; S G="PXRM PXK EVENT14816 3110315.164512" ZWR ^XTMP(G,*) 114679 114685 "RTN","C0CPXRM",66,0) 114680 S G="PXRM PXK EVENT12415 3110315.135514" ZWR ^XTMP(G,*)114686 ; S G="PXRM PXK EVENT12415 3110315.135514" ZWR ^XTMP(G,*) 114681 114687 "RTN","C0CPXRM",67,0) 114682 S G="PXRM PXK EVENT11797 3110315.131141" ZWR ^XTMP(G,*)114688 ; S G="PXRM PXK EVENT11797 3110315.131141" ZWR ^XTMP(G,*) 114683 114689 "RTN","C0CPXRM",68,0) 114684 S G="PXRM PXK EVENT11573 3110315.131811" ZWR ^XTMP(G,*)114690 ; S G="PXRM PXK EVENT11573 3110315.131811" ZWR ^XTMP(G,*) 114685 114691 "RTN","C0CPXRM",69,0) 114686 S G="PXRM PXK EVENT10728 3110114.025022" ZWR ^XTMP(G,*)114692 ; S G="PXRM PXK EVENT10728 3110114.025022" ZWR ^XTMP(G,*) 114687 114693 "RTN","C0CPXRM",70,0) 114688 S G="PXRM PXK EVENT10578 3110114.021524" ZWR ^XTMP(G,*)114694 ; S G="PXRM PXK EVENT10578 3110114.021524" ZWR ^XTMP(G,*) 114689 114695 "RTN","C0CPXRM",71,0) 114690 S G="PXRM PXK EVENT10243 3110114.020338" ZWR ^XTMP(G,*)114696 ; S G="PXRM PXK EVENT10243 3110114.020338" ZWR ^XTMP(G,*) 114691 114697 "RTN","C0CPXRM",72,0) 114692 S G="PXRM PXK EVENT10105 3101204.230554" ZWR ^XTMP(G,*)114698 ; S G="PXRM PXK EVENT10105 3101204.230554" ZWR ^XTMP(G,*) 114693 114699 "RTN","C0CPXRM",73,0) 114694 Q114700 ; Q 114695 114701 "RTN","C0CPXRM",74,0) 114696 114702 ; … … 114700 114706 LA7QRY1 ;DALOI/JMC - Lab HL7 Query Utility ;01/19/99 13:48 114701 114707 "RTN","C0CQRY1",2,0) 114702 ;;1.2;C 0C;;May 11, 2012;Build 50114708 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 114703 114709 "RTN","C0CQRY1",3,0) 114704 114710 ; … … 114944 114950 Q 114945 114951 "RTN","C0CQRY2") 114946 0^94^B2 0465060114952 0^94^B23443412 114947 114953 "RTN","C0CQRY2",1,0) 114948 LA7QRY2 ;DALOI/JMC - Lab HL7 Query Utility ; 04/13/09 114954 LA7QRY2 ;DALOI/JMC - Lab HL7 Query Utility ; 04/13/09 ; 10/30/12 10:16am 114949 114955 "RTN","C0CQRY2",2,0) 114950 ;;1.2;C 0C;;May 11, 2012;Build 50114956 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 114951 114957 "RTN","C0CQRY2",3,0) 114952 114958 ; JMC - mods to check for IHS V LAB file … … 114954 114960 ; 114955 114961 "RTN","C0CQRY2",5,0) 114962 ; (C) John McCormack 2009 114963 "RTN","C0CQRY2",6,0) 114964 ; 114965 "RTN","C0CQRY2",7,0) 114966 ; This program is free software: you can redistribute it and/or modify 114967 "RTN","C0CQRY2",8,0) 114968 ; it under the terms of the GNU Affero General Public License as 114969 "RTN","C0CQRY2",9,0) 114970 ; published by the Free Software Foundation, either version 3 of the 114971 "RTN","C0CQRY2",10,0) 114972 ; License, or (at your option) any later version. 114973 "RTN","C0CQRY2",11,0) 114974 ; 114975 "RTN","C0CQRY2",12,0) 114976 ; This program is distributed in the hope that it will be useful, 114977 "RTN","C0CQRY2",13,0) 114978 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 114979 "RTN","C0CQRY2",14,0) 114980 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 114981 "RTN","C0CQRY2",15,0) 114982 ; GNU Affero General Public License for more details. 114983 "RTN","C0CQRY2",16,0) 114984 ; 114985 "RTN","C0CQRY2",17,0) 114986 ; You should have received a copy of the GNU Affero General Public License 114987 "RTN","C0CQRY2",18,0) 114988 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 114989 "RTN","C0CQRY2",19,0) 114990 ; 114991 "RTN","C0CQRY2",20,0) 114992 ; 114993 "RTN","C0CQRY2",21,0) 114956 114994 Q 114957 "RTN","C0CQRY2", 6,0)114958 ; 114959 "RTN","C0CQRY2", 7,0)114995 "RTN","C0CQRY2",22,0) 114996 ; 114997 "RTN","C0CQRY2",23,0) 114960 114998 PATID ; Resolve patient id and establish patient environment 114961 "RTN","C0CQRY2", 8,0)114962 ; 114963 "RTN","C0CQRY2", 9,0)114999 "RTN","C0CQRY2",24,0) 115000 ; 115001 "RTN","C0CQRY2",25,0) 114964 115002 N LA7X 114965 "RTN","C0CQRY2", 10,0)114966 ; 114967 "RTN","C0CQRY2", 11,0)115003 "RTN","C0CQRY2",26,0) 115004 ; 115005 "RTN","C0CQRY2",27,0) 114968 115006 S (DFN,LRDFN)="",LA7PTYP=0 114969 "RTN","C0CQRY2", 12,0)114970 ; 114971 "RTN","C0CQRY2", 13,0)115007 "RTN","C0CQRY2",28,0) 115008 ; 115009 "RTN","C0CQRY2",29,0) 114972 115010 ; SSN passed as patient identifier 114973 "RTN","C0CQRY2", 14,0)115011 "RTN","C0CQRY2",30,0) 114974 115012 I LA7PTID?9N.1A D 114975 "RTN","C0CQRY2", 15,0)115013 "RTN","C0CQRY2",31,0) 114976 115014 . S LA7PTYP=1 114977 "RTN","C0CQRY2", 16,0)115015 "RTN","C0CQRY2",32,0) 114978 115016 . S LA7X=$O(^DPT("SSN",LA7PTID,0)) 114979 "RTN","C0CQRY2", 17,0)115017 "RTN","C0CQRY2",33,0) 114980 115018 . I LA7X>0 D SETDFN(LA7X) 114981 "RTN","C0CQRY2", 18,0)114982 ; 114983 "RTN","C0CQRY2", 19,0)115019 "RTN","C0CQRY2",34,0) 115020 ; 115021 "RTN","C0CQRY2",35,0) 114984 115022 ; MPI/ICN (integration control number) passed as patient identifier 114985 "RTN","C0CQRY2", 20,0)115023 "RTN","C0CQRY2",36,0) 114986 115024 I LA7PTID?10N1"V"6N D 114987 "RTN","C0CQRY2", 21,0)115025 "RTN","C0CQRY2",37,0) 114988 115026 . S LA7PTYP=2 114989 "RTN","C0CQRY2", 22,0)115027 "RTN","C0CQRY2",38,0) 114990 115028 . S LA7X=$$GETDFN^MPIF001($P(LA7PTID,"V")) 114991 "RTN","C0CQRY2", 23,0)115029 "RTN","C0CQRY2",39,0) 114992 115030 . I LA7X>0 D SETDFN(LA7X) 114993 "RTN","C0CQRY2", 24,0)114994 ; 114995 "RTN","C0CQRY2", 25,0)115031 "RTN","C0CQRY2",40,0) 115032 ; 115033 "RTN","C0CQRY2",41,0) 114996 115034 ; If no patient identified/no laboratory record - return exception message 114997 "RTN","C0CQRY2", 26,0)115035 "RTN","C0CQRY2",42,0) 114998 115036 I 'LA7PTYP S LA7ERR(1)="Invalid patient identifier passed" 114999 "RTN","C0CQRY2", 27,0)115037 "RTN","C0CQRY2",43,0) 115000 115038 I 'DFN S LA7ERR(2)="No patient found with requested identifier" 115001 "RTN","C0CQRY2", 28,0)115039 "RTN","C0CQRY2",44,0) 115002 115040 I DFN,'LRDFN S LA7ERR(3)="No laboratory record for requested patient" 115003 "RTN","C0CQRY2", 29,0)115041 "RTN","C0CQRY2",45,0) 115004 115042 I LRDFN,'$D(^LR(LRDFN)) S LA7ERR(4)="Database error - missing laboratory record for requested patient" 115005 "RTN","C0CQRY2", 30,0)115043 "RTN","C0CQRY2",46,0) 115006 115044 Q 115007 "RTN","C0CQRY2", 31,0)115008 ; 115009 "RTN","C0CQRY2", 32,0)115010 ; 115011 "RTN","C0CQRY2", 33,0)115045 "RTN","C0CQRY2",47,0) 115046 ; 115047 "RTN","C0CQRY2",48,0) 115048 ; 115049 "RTN","C0CQRY2",49,0) 115012 115050 BCD ; Search by specimen collection date. 115013 "RTN","C0CQRY2", 34,0)115014 ; 115015 "RTN","C0CQRY2", 35,0)115051 "RTN","C0CQRY2",50,0) 115052 ; 115053 "RTN","C0CQRY2",51,0) 115016 115054 N LA763,LA7QUIT 115017 "RTN","C0CQRY2", 36,0)115018 ; 115019 "RTN","C0CQRY2", 37,0)115055 "RTN","C0CQRY2",52,0) 115056 ; 115057 "RTN","C0CQRY2",53,0) 115020 115058 S (LA7SDT(0),LA7EDT(0))=0 115021 "RTN","C0CQRY2", 38,0)115059 "RTN","C0CQRY2",54,0) 115022 115060 I LA7SDT S LA7SDT(0)=9999999-LA7SDT 115023 "RTN","C0CQRY2", 39,0)115061 "RTN","C0CQRY2",55,0) 115024 115062 I LA7EDT S LA7EDT(0)=9999999-LA7EDT 115025 "RTN","C0CQRY2", 40,0)115026 ; 115027 "RTN","C0CQRY2", 41,0)115063 "RTN","C0CQRY2",56,0) 115064 ; 115065 "RTN","C0CQRY2",57,0) 115028 115066 F LRSS="CH","MI","SP" D 115029 "RTN","C0CQRY2", 42,0)115067 "RTN","C0CQRY2",58,0) 115030 115068 . S (LA7QUIT,LRIDT)=0 115031 "RTN","C0CQRY2", 43,0)115069 "RTN","C0CQRY2",59,0) 115032 115070 . I LA7EDT(0) S LRIDT=$O(^LR(LRDFN,LRSS,LA7EDT(0)),-1) 115033 "RTN","C0CQRY2", 44,0)115071 "RTN","C0CQRY2",60,0) 115034 115072 . F S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) Q:LA7QUIT D 115035 "RTN","C0CQRY2", 45,0)115073 "RTN","C0CQRY2",61,0) 115036 115074 . . ; Quit if reached end of data or outside date criteria 115037 "RTN","C0CQRY2", 46,0)115075 "RTN","C0CQRY2",62,0) 115038 115076 . . I 'LRIDT!(LRIDT>LA7SDT(0)) S LA7QUIT=1 Q 115039 "RTN","C0CQRY2", 47,0)115077 "RTN","C0CQRY2",63,0) 115040 115078 . . D SEARCH 115041 "RTN","C0CQRY2", 48,0)115042 ; 115043 "RTN","C0CQRY2", 49,0)115079 "RTN","C0CQRY2",64,0) 115080 ; 115081 "RTN","C0CQRY2",65,0) 115044 115082 Q 115045 "RTN","C0CQRY2", 50,0)115046 ; 115047 "RTN","C0CQRY2", 51,0)115048 ; 115049 "RTN","C0CQRY2", 52,0)115083 "RTN","C0CQRY2",66,0) 115084 ; 115085 "RTN","C0CQRY2",67,0) 115086 ; 115087 "RTN","C0CQRY2",68,0) 115050 115088 BRAD ; Search by results available date (completion date). 115051 "RTN","C0CQRY2", 53,0)115089 "RTN","C0CQRY2",69,0) 115052 115090 ; Assumes cross-references still exist for dates in LRO(69) global. 115053 "RTN","C0CQRY2", 54,0)115091 "RTN","C0CQRY2",70,0) 115054 115092 ; Collects specimen date/time values for a given LRDFN and completion date. 115055 "RTN","C0CQRY2", 55,0)115093 "RTN","C0CQRY2",71,0) 115056 115094 ; Cross-reference is by date only, time stripped from start date. 115057 "RTN","C0CQRY2", 56,0)115095 "RTN","C0CQRY2",72,0) 115058 115096 ; Uses cross-reference ^LRO(69,DT,1,"AN",'LOCATION',LRDFN,LRIDT)="" 115059 "RTN","C0CQRY2", 57,0)115060 ; 115061 "RTN","C0CQRY2", 58,0)115097 "RTN","C0CQRY2",73,0) 115098 ; 115099 "RTN","C0CQRY2",74,0) 115062 115100 N LA763,LA7DT,LA7ROOT,LA7SRC,X 115063 "RTN","C0CQRY2", 59,0)115064 ; 115065 "RTN","C0CQRY2", 60,0)115101 "RTN","C0CQRY2",75,0) 115102 ; 115103 "RTN","C0CQRY2",76,0) 115066 115104 ; Check if orders still exist Iin file #69 for search range 115067 "RTN","C0CQRY2", 61,0)115105 "RTN","C0CQRY2",77,0) 115068 115106 S LA7SDT(1)=(LA7SDT\1)-.0000000001,LA7EDT(1)=(LA7EDT\1)+.24,LA7SRC=0 115069 "RTN","C0CQRY2", 62,0)115107 "RTN","C0CQRY2",78,0) 115070 115108 S X=$O(^LRO(69,LA7SDT(1))) 115071 "RTN","C0CQRY2", 63,0)115109 "RTN","C0CQRY2",79,0) 115072 115110 I X,X<LA7EDT(1) S LA7SRC=1 115073 "RTN","C0CQRY2", 64,0)115074 ; 115075 "RTN","C0CQRY2", 65,0)115111 "RTN","C0CQRY2",80,0) 115112 ; 115113 "RTN","C0CQRY2",81,0) 115076 115114 ; Search "AN" cross-reference in file #69. 115077 "RTN","C0CQRY2", 66,0)115115 "RTN","C0CQRY2",82,0) 115078 115116 I LA7SRC D 115079 "RTN","C0CQRY2", 67,0)115117 "RTN","C0CQRY2",83,0) 115080 115118 . S LA7DT=LA7SDT(1) 115081 "RTN","C0CQRY2", 68,0)115119 "RTN","C0CQRY2",84,0) 115082 115120 . F S LA7DT=$O(^LRO(69,LA7DT)) Q:'LA7DT!(LA7DT>LA7EDT(1)) D 115083 "RTN","C0CQRY2", 69,0)115121 "RTN","C0CQRY2",85,0) 115084 115122 . . S LA7ROOT="^LRO(69,LA7DT,1,""AN"")" 115085 "RTN","C0CQRY2", 70,0)115123 "RTN","C0CQRY2",86,0) 115086 115124 . . F S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT=""!($QS(LA7ROOT,2)'=LA7DT)!($QS(LA7ROOT,4)'="AN") D 115087 "RTN","C0CQRY2", 71,0)115125 "RTN","C0CQRY2",87,0) 115088 115126 . . . I $QS(LA7ROOT,6)'=LRDFN Q 115089 "RTN","C0CQRY2", 72,0)115127 "RTN","C0CQRY2",88,0) 115090 115128 . . . S LRIDT=$QS(LA7ROOT,7) 115091 "RTN","C0CQRY2", 73,0)115129 "RTN","C0CQRY2",89,0) 115092 115130 . . . F LRSS="CH","MI","SP" D SEARCH 115093 "RTN","C0CQRY2", 74,0)115094 ; 115095 "RTN","C0CQRY2", 75,0)115131 "RTN","C0CQRY2",90,0) 115132 ; 115133 "RTN","C0CQRY2",91,0) 115096 115134 ; If no orders in #69 then do long search through file #63. 115097 "RTN","C0CQRY2", 76,0)115135 "RTN","C0CQRY2",92,0) 115098 115136 I 'LA7SRC D 115099 "RTN","C0CQRY2", 77,0)115137 "RTN","C0CQRY2",93,0) 115100 115138 . F LRSS="CH","MI","SP" D 115101 "RTN","C0CQRY2", 78,0)115139 "RTN","C0CQRY2",94,0) 115102 115140 . . S LRIDT=0 115103 "RTN","C0CQRY2", 79,0)115141 "RTN","C0CQRY2",95,0) 115104 115142 . . F S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) Q:'LRIDT D 115105 "RTN","C0CQRY2", 80,0)115143 "RTN","C0CQRY2",96,0) 115106 115144 . . . S LA763(0)=$G(^LR(LRDFN,LRSS,LRIDT,0)) 115107 "RTN","C0CQRY2", 81,0)115145 "RTN","C0CQRY2",97,0) 115108 115146 . . . I $P(LA763(0),"^",3)>LA7SDT(1),$P(LA763(0),"^",3)<LA7EDT(1) D SEARCH 115109 "RTN","C0CQRY2", 82,0)115110 ; 115111 "RTN","C0CQRY2", 83,0)115147 "RTN","C0CQRY2",98,0) 115148 ; 115149 "RTN","C0CQRY2",99,0) 115112 115150 Q 115113 "RTN","C0CQRY2", 84,0)115114 ; 115115 "RTN","C0CQRY2", 85,0)115116 ; 115117 "RTN","C0CQRY2", 86,0)115151 "RTN","C0CQRY2",100,0) 115152 ; 115153 "RTN","C0CQRY2",101,0) 115154 ; 115155 "RTN","C0CQRY2",102,0) 115118 115156 SEARCH ; Search subscript for a specific collection date/time 115119 "RTN","C0CQRY2", 87,0)115120 ; 115121 "RTN","C0CQRY2", 88,0)115157 "RTN","C0CQRY2",103,0) 115158 ; 115159 "RTN","C0CQRY2",104,0) 115122 115160 K LA763 115123 "RTN","C0CQRY2", 89,0)115161 "RTN","C0CQRY2",105,0) 115124 115162 S LA763(0)=$G(^LR(LRDFN,LRSS,LRIDT,0)) 115125 "RTN","C0CQRY2", 90,0)115126 ; 115127 "RTN","C0CQRY2", 91,0)115163 "RTN","C0CQRY2",106,0) 115164 ; 115165 "RTN","C0CQRY2",107,0) 115128 115166 ; Only CH, MI, and BB subscripts store pointer to file #61 in 5th piece of zeroth node. 115129 "RTN","C0CQRY2", 92,0)115167 "RTN","C0CQRY2",108,0) 115130 115168 ; Quit if specific specimen codes and they do not match 115131 "RTN","C0CQRY2", 93,0)115169 "RTN","C0CQRY2",109,0) 115132 115170 I "CHMIBB"[LRSS S LA761=+$P(LA763(0),"^",5) 115133 "RTN","C0CQRY2", 94,0)115171 "RTN","C0CQRY2",110,0) 115134 115172 E S LA761=0 115135 "RTN","C0CQRY2", 95,0)115173 "RTN","C0CQRY2",111,0) 115136 115174 I LA761,$D(^TMP("LA7-61",$J)),'$D(^TMP("LA7-61",$J,LA761)) Q 115137 "RTN","C0CQRY2", 96,0)115138 ; 115139 "RTN","C0CQRY2", 97,0)115175 "RTN","C0CQRY2",112,0) 115176 ; 115177 "RTN","C0CQRY2",113,0) 115140 115178 ; --- Chemistry 115141 "RTN","C0CQRY2", 98,0)115179 "RTN","C0CQRY2",114,0) 115142 115180 I LRSS="CH" D CHSS Q 115143 "RTN","C0CQRY2", 99,0)115181 "RTN","C0CQRY2",115,0) 115144 115182 ; --- Microbiology 115145 "RTN","C0CQRY2",1 00,0)115183 "RTN","C0CQRY2",116,0) 115146 115184 I LRSS="MI" D MISS Q 115147 "RTN","C0CQRY2",1 01,0)115185 "RTN","C0CQRY2",117,0) 115148 115186 ; --- Surgical pathology 115149 "RTN","C0CQRY2",1 02,0)115187 "RTN","C0CQRY2",118,0) 115150 115188 I LRSS="SP" D APSS Q 115151 "RTN","C0CQRY2",1 03,0)115189 "RTN","C0CQRY2",119,0) 115152 115190 ; --- Cytology 115153 "RTN","C0CQRY2",1 04,0)115191 "RTN","C0CQRY2",120,0) 115154 115192 I LRSS="CY" D APSS Q 115155 "RTN","C0CQRY2",1 05,0)115193 "RTN","C0CQRY2",121,0) 115156 115194 ; --- Electron Micrscopsy 115157 "RTN","C0CQRY2",1 06,0)115195 "RTN","C0CQRY2",122,0) 115158 115196 I LRSS="EM" D APSS Q 115159 "RTN","C0CQRY2",1 07,0)115197 "RTN","C0CQRY2",123,0) 115160 115198 ; --- Autopsy 115161 "RTN","C0CQRY2",1 08,0)115199 "RTN","C0CQRY2",124,0) 115162 115200 I LRSS="AU" D APSS Q 115163 "RTN","C0CQRY2",1 09,0)115201 "RTN","C0CQRY2",125,0) 115164 115202 ; --- Blood Bank 115165 "RTN","C0CQRY2",1 10,0)115203 "RTN","C0CQRY2",126,0) 115166 115204 I LRSS="BB" D BBSS Q 115167 "RTN","C0CQRY2",1 11,0)115205 "RTN","C0CQRY2",127,0) 115168 115206 Q 115169 "RTN","C0CQRY2",1 12,0)115170 ; 115171 "RTN","C0CQRY2",1 13,0)115172 ; 115173 "RTN","C0CQRY2",1 14,0)115207 "RTN","C0CQRY2",128,0) 115208 ; 115209 "RTN","C0CQRY2",129,0) 115210 ; 115211 "RTN","C0CQRY2",130,0) 115174 115212 CHSS ; Search "CH" datanames for matching codes 115175 "RTN","C0CQRY2",1 15,0)115176 ; 115177 "RTN","C0CQRY2",1 16,0)115213 "RTN","C0CQRY2",131,0) 115214 ; 115215 "RTN","C0CQRY2",132,0) 115178 115216 N LA7X,LRSB 115179 "RTN","C0CQRY2",1 17,0)115180 ; 115181 "RTN","C0CQRY2",1 18,0)115217 "RTN","C0CQRY2",133,0) 115218 ; 115219 "RTN","C0CQRY2",134,0) 115182 115220 S LRSB=1 115183 "RTN","C0CQRY2",1 19,0)115221 "RTN","C0CQRY2",135,0) 115184 115222 F S LRSB=$O(^LR(LRDFN,LRSS,LRIDT,LRSB)) Q:'LRSB D 115185 "RTN","C0CQRY2",1 20,0)115223 "RTN","C0CQRY2",136,0) 115186 115224 . S LA7X=$G(^LR(LRDFN,LRSS,LRIDT,LRSB)) 115187 "RTN","C0CQRY2",1 21,0)115225 "RTN","C0CQRY2",137,0) 115188 115226 . I $D(^AUPNVLAB) D LNCHK^C0CLA7Q ; WV check for IHS. 115189 "RTN","C0CQRY2",1 22,0)115227 "RTN","C0CQRY2",138,0) 115190 115228 . S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,$P(LA7X,"^",3),LA761) 115191 "RTN","C0CQRY2",1 23,0)115229 "RTN","C0CQRY2",139,0) 115192 115230 . D CHECK 115193 "RTN","C0CQRY2",1 24,0)115194 ; 115195 "RTN","C0CQRY2",1 25,0)115231 "RTN","C0CQRY2",140,0) 115232 ; 115233 "RTN","C0CQRY2",141,0) 115196 115234 Q 115197 "RTN","C0CQRY2",1 26,0)115198 ; 115199 "RTN","C0CQRY2",1 27,0)115200 ; 115201 "RTN","C0CQRY2",1 28,0)115235 "RTN","C0CQRY2",142,0) 115236 ; 115237 "RTN","C0CQRY2",143,0) 115238 ; 115239 "RTN","C0CQRY2",144,0) 115202 115240 MISS ; Search "MI" subscripts for matching codes 115203 "RTN","C0CQRY2",1 29,0)115204 ; 115205 "RTN","C0CQRY2",1 30,0)115241 "RTN","C0CQRY2",145,0) 115242 ; 115243 "RTN","C0CQRY2",146,0) 115206 115244 N LA7ND,LRSB 115207 "RTN","C0CQRY2",1 31,0)115208 ; 115209 "RTN","C0CQRY2",1 32,0)115245 "RTN","C0CQRY2",147,0) 115246 ; 115247 "RTN","C0CQRY2",148,0) 115210 115248 S LA7ND=0 115211 "RTN","C0CQRY2",1 33,0)115249 "RTN","C0CQRY2",149,0) 115212 115250 F LA7ND=1,5,8,11,16 I $D(^LR(LRDFN,LRSS,LRIDT,LA7ND)) D 115213 "RTN","C0CQRY2",1 34,0)115251 "RTN","C0CQRY2",150,0) 115214 115252 . S LRSB=$S(LA7ND=1:11,LA7ND=5:14,LA7ND=8:18,LA7ND=11:22,LA7ND=16:33,1:11) 115215 "RTN","C0CQRY2",1 35,0)115253 "RTN","C0CQRY2",151,0) 115216 115254 . S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,"",LA761) 115217 "RTN","C0CQRY2",1 36,0)115255 "RTN","C0CQRY2",152,0) 115218 115256 . D CHECK 115219 "RTN","C0CQRY2",1 37,0)115257 "RTN","C0CQRY2",153,0) 115220 115258 Q 115221 "RTN","C0CQRY2",1 38,0)115222 ; 115223 "RTN","C0CQRY2",1 39,0)115224 ; 115225 "RTN","C0CQRY2",1 40,0)115259 "RTN","C0CQRY2",154,0) 115260 ; 115261 "RTN","C0CQRY2",155,0) 115262 ; 115263 "RTN","C0CQRY2",156,0) 115226 115264 APSS ; Search AP subscripts for matching codes 115227 "RTN","C0CQRY2",1 41,0)115265 "RTN","C0CQRY2",157,0) 115228 115266 ; AP results are currently not coded - use defaults 115229 "RTN","C0CQRY2",1 42,0)115230 ; 115231 "RTN","C0CQRY2",1 43,0)115267 "RTN","C0CQRY2",158,0) 115268 ; 115269 "RTN","C0CQRY2",159,0) 115232 115270 N LA7CODE,LRSB 115233 "RTN","C0CQRY2",1 44,0)115234 ; 115235 "RTN","C0CQRY2",1 45,0)115271 "RTN","C0CQRY2",160,0) 115272 ; 115273 "RTN","C0CQRY2",161,0) 115236 115274 S LRSB=.012 115237 "RTN","C0CQRY2",1 46,0)115275 "RTN","C0CQRY2",162,0) 115238 115276 S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,"","") 115239 "RTN","C0CQRY2",1 47,0)115277 "RTN","C0CQRY2",163,0) 115240 115278 D CHECK 115241 "RTN","C0CQRY2",1 48,0)115242 ; 115243 "RTN","C0CQRY2",1 49,0)115279 "RTN","C0CQRY2",164,0) 115280 ; 115281 "RTN","C0CQRY2",165,0) 115244 115282 Q 115245 "RTN","C0CQRY2",1 50,0)115246 ; 115247 "RTN","C0CQRY2",1 51,0)115248 ; 115249 "RTN","C0CQRY2",1 52,0)115283 "RTN","C0CQRY2",166,0) 115284 ; 115285 "RTN","C0CQRY2",167,0) 115286 ; 115287 "RTN","C0CQRY2",168,0) 115250 115288 BBSS ; Search BB subscript for matching codes 115251 "RTN","C0CQRY2",1 53,0)115289 "RTN","C0CQRY2",169,0) 115252 115290 ; *** This subscript currently not supported *** 115253 "RTN","C0CQRY2",1 54,0)115291 "RTN","C0CQRY2",170,0) 115254 115292 Q 115255 "RTN","C0CQRY2",1 55,0)115256 ; 115257 "RTN","C0CQRY2",1 56,0)115258 ; 115259 "RTN","C0CQRY2",1 57,0)115293 "RTN","C0CQRY2",171,0) 115294 ; 115295 "RTN","C0CQRY2",172,0) 115296 ; 115297 "RTN","C0CQRY2",173,0) 115260 115298 CHECK ; Check NLT order/result and LOINC codes. 115261 "RTN","C0CQRY2",1 58,0)115262 ; 115263 "RTN","C0CQRY2",1 59,0)115299 "RTN","C0CQRY2",174,0) 115300 ; 115301 "RTN","C0CQRY2",175,0) 115264 115302 N LA7QUIT 115265 "RTN","C0CQRY2",1 60,0)115266 ; 115267 "RTN","C0CQRY2",1 61,0)115303 "RTN","C0CQRY2",176,0) 115304 ; 115305 "RTN","C0CQRY2",177,0) 115268 115306 ; If wildcard then store 115269 "RTN","C0CQRY2",1 62,0)115307 "RTN","C0CQRY2",178,0) 115270 115308 ; Otherwise check for specific NLT order/result and LOINC codes 115271 "RTN","C0CQRY2",1 63,0)115309 "RTN","C0CQRY2",179,0) 115272 115310 I LA7SC="*" D STORE Q 115273 "RTN","C0CQRY2",1 64,0)115311 "RTN","C0CQRY2",180,0) 115274 115312 S LA7QUIT=0 115275 "RTN","C0CQRY2",1 65,0)115313 "RTN","C0CQRY2",181,0) 115276 115314 F I=1:1:3 D Q:LA7QUIT 115277 "RTN","C0CQRY2",1 66,0)115315 "RTN","C0CQRY2",182,0) 115278 115316 . ; If no test code then skip 115279 "RTN","C0CQRY2",1 67,0)115317 "RTN","C0CQRY2",183,0) 115280 115318 . I '$L($P(LA7CODE,"!",I)) Q 115281 "RTN","C0CQRY2",1 68,0)115319 "RTN","C0CQRY2",184,0) 115282 115320 . ; If test code does not match a search code then quit 115283 "RTN","C0CQRY2",1 69,0)115321 "RTN","C0CQRY2",185,0) 115284 115322 . I '$D(^TMP($S(I=3:"LA7-LN",1:"LA7-NLT"),$J,$P(LA7CODE,"!",I))) Q 115285 "RTN","C0CQRY2",1 70,0)115323 "RTN","C0CQRY2",186,0) 115286 115324 . D STORE S LA7QUIT=1 115287 "RTN","C0CQRY2",1 71,0)115288 ; 115289 "RTN","C0CQRY2",1 72,0)115325 "RTN","C0CQRY2",187,0) 115326 ; 115327 "RTN","C0CQRY2",188,0) 115290 115328 Q 115291 "RTN","C0CQRY2",1 73,0)115292 ; 115293 "RTN","C0CQRY2",1 74,0)115294 ; 115295 "RTN","C0CQRY2",1 75,0)115329 "RTN","C0CQRY2",189,0) 115330 ; 115331 "RTN","C0CQRY2",190,0) 115332 ; 115333 "RTN","C0CQRY2",191,0) 115296 115334 STORE ; Store entry for building in HL7 message 115297 "RTN","C0CQRY2",1 76,0)115298 ; 115299 "RTN","C0CQRY2",1 77,0)115335 "RTN","C0CQRY2",192,0) 115336 ; 115337 "RTN","C0CQRY2",193,0) 115300 115338 S ^TMP("LA7-QRY",$J,LRDFN,LRIDT,LRSS,LA7CODE,LRSB)="" 115301 "RTN","C0CQRY2",1 78,0)115339 "RTN","C0CQRY2",194,0) 115302 115340 Q 115303 "RTN","C0CQRY2",1 79,0)115304 ; 115305 "RTN","C0CQRY2",1 80,0)115306 ; 115307 "RTN","C0CQRY2",1 81,0)115341 "RTN","C0CQRY2",195,0) 115342 ; 115343 "RTN","C0CQRY2",196,0) 115344 ; 115345 "RTN","C0CQRY2",197,0) 115308 115346 SETDFN(LA7X) ; Setup DFN and other lab variables. 115309 "RTN","C0CQRY2",1 82,0)115310 ; 115311 "RTN","C0CQRY2",1 83,0)115347 "RTN","C0CQRY2",198,0) 115348 ; 115349 "RTN","C0CQRY2",199,0) 115312 115350 S DFN=LA7X,LRDFN=$P($G(^DPT(DFN,"LR")),"^") 115313 "RTN","C0CQRY2", 184,0)115351 "RTN","C0CQRY2",200,0) 115314 115352 Q 115315 115353 "RTN","C0CRAHL7") 115316 0^105^B 54192731115354 0^105^B46426582 115317 115355 "RTN","C0CRAHL7",1,0) 115318 115356 C0CRAHL7 ; C0C/ELN - CCR/CCD PROCESSING FOR RAD REPORT ; 25/10/2010 115319 115357 "RTN","C0CRAHL7",2,0) 115320 ;;1.2;C0C;;May 11, 2012;Build 50115358 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 115321 115359 "RTN","C0CRAHL7",3,0) 115322 ;;115360 ; 115323 115361 "RTN","C0CRAHL7",4,0) 115324 Q115362 ; (C) ELN 2010. 115325 115363 "RTN","C0CRAHL7",5,0) 115326 ;LENGTH OF SEGMENTS COMPROMISED115364 ; 115327 115365 "RTN","C0CRAHL7",6,0) 115328 GHL7 ; Loop through ^RADPT with RADFN 115366 ; This program is free software: you can redistribute it and/or modify 115329 115367 "RTN","C0CRAHL7",7,0) 115330 ; Get Case Number and Reprot Information115368 ; it under the terms of the GNU Affero General Public License as 115331 115369 "RTN","C0CRAHL7",8,0) 115332 ; Extract RAD Report as HL7 Message115370 ; published by the Free Software Foundation, either version 3 of the 115333 115371 "RTN","C0CRAHL7",9,0) 115334 ; HL7 Message Set In Sequence as ^TMP("HLS",$J,SEQ)115372 ; License, or (at your option) any later version. 115335 115373 "RTN","C0CRAHL7",10,0) 115336 115374 ; 115337 115375 "RTN","C0CRAHL7",11,0) 115338 D DT^DILF(,$$GET^C0CPARMS("RASTART"),.C0CRASDT)115376 ; This program is distributed in the hope that it will be useful, 115339 115377 "RTN","C0CRAHL7",12,0) 115340 D DT^DILF(,$$GET^C0CPARMS("RALIMIT"),.C0CRAEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM115378 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 115341 115379 "RTN","C0CRAHL7",13,0) 115342 S C0CCNT=0115380 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 115343 115381 "RTN","C0CRAHL7",14,0) 115344 F S C0CRAEDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT)) Q:C0CRAEDT'>0!(C0CRAEDT>C0CRASDT) D115382 ; GNU Affero General Public License for more details. 115345 115383 "RTN","C0CRAHL7",15,0) 115346 . S C0CRAIDT=0115384 ; 115347 115385 "RTN","C0CRAHL7",16,0) 115348 . F S C0CRAIDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT,C0CRAIDT)) Q:C0CRAIDT'>0 D115386 ; You should have received a copy of the GNU Affero General Public License 115349 115387 "RTN","C0CRAHL7",17,0) 115350 . . S C0CRANO=0115388 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 115351 115389 "RTN","C0CRAHL7",18,0) 115352 . . F S C0CRANO=$O(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO)) Q:C0CRANO'>0 D115390 ; 115353 115391 "RTN","C0CRAHL7",19,0) 115354 . . . S C0CRAXAM(0)=$G(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO,0))115392 ; 115355 115393 "RTN","C0CRAHL7",20,0) 115356 . . . Q:C0CRAXAM(0)=""115394 Q 115357 115395 "RTN","C0CRAHL7",21,0) 115358 . . . S RARPT=+$P(C0CRAXAM(0),"^",17),RACNI=C0CRANO,RADTI=C0CRAIDT115396 ;LENGTH OF SEGMENTS COMPROMISED 115359 115397 "RTN","C0CRAHL7",22,0) 115360 . . . Q:RARPT=""!(RARPT=0) 115398 GHL7 ; Loop through ^RADPT with RADFN 115361 115399 "RTN","C0CRAHL7",23,0) 115362 . . . ;Quit if no report information present115400 ; Get Case Number and Reprot Information 115363 115401 "RTN","C0CRAHL7",24,0) 115364 . . . D SETHL7115402 ; Extract RAD Report as HL7 Message 115365 115403 "RTN","C0CRAHL7",25,0) 115366 . . . S C0CSBCNT=0115404 ; HL7 Message Set In Sequence as ^TMP("HLS",$J,SEQ) 115367 115405 "RTN","C0CRAHL7",26,0) 115368 . . . F S C0CSBCNT=$O(HLA("HLS",C0CSBCNT)) Q:C0CSBCNT="" D115406 ; 115369 115407 "RTN","C0CRAHL7",27,0) 115370 . . . . S ^TMP("HLS",$J,C0CCNT)=$G(HLA("HLS",C0CSBCNT))115408 D DT^DILF(,$$GET^C0CPARMS("RASTART"),.C0CRASDT) 115371 115409 "RTN","C0CRAHL7",28,0) 115372 . . . . S C0CCNT=C0CCNT+1115410 D DT^DILF(,$$GET^C0CPARMS("RALIMIT"),.C0CRAEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM 115373 115411 "RTN","C0CRAHL7",29,0) 115374 ;115412 S C0CCNT=0 115375 115413 "RTN","C0CRAHL7",30,0) 115376 K HLA("HLS"),RARPT,C0CSBCNT,C0CRANO,C0CRAIDT,C0CRASDT,C0CRLMT,C0CSTRT115414 F S C0CRAEDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT)) Q:C0CRAEDT'>0!(C0CRAEDT>C0CRASDT) D 115377 115415 "RTN","C0CRAHL7",31,0) 115378 K C0CRAXAM,C0CCNT,C0CRAEDT115416 . S C0CRAIDT=0 115379 115417 "RTN","C0CRAHL7",32,0) 115380 Q115418 . F S C0CRAIDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT,C0CRAIDT)) Q:C0CRAIDT'>0 D 115381 115419 "RTN","C0CRAHL7",33,0) 115382 ;115420 . . S C0CRANO=0 115383 115421 "RTN","C0CRAHL7",34,0) 115384 SETHL7 ;SETHL7 SEGMENTS 115422 . . F S C0CRANO=$O(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO)) Q:C0CRANO'>0 D 115385 115423 "RTN","C0CRAHL7",35,0) 115386 N RASET,RACN0115424 . . . S C0CRAXAM(0)=$G(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO,0)) 115387 115425 "RTN","C0CRAHL7",36,0) 115388 S RASET=0115426 . . . Q:C0CRAXAM(0)="" 115389 115427 "RTN","C0CRAHL7",37,0) 115390 S RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)115428 . . . S RARPT=+$P(C0CRAXAM(0),"^",17),RACNI=C0CRANO,RADTI=C0CRAIDT 115391 115429 "RTN","C0CRAHL7",38,0) 115392 I +$P(RACN0,U,25)=2 D Q ; printset115430 . . . Q:RARPT=""!(RARPT=0) 115393 115431 "RTN","C0CRAHL7",39,0) 115394 . ; loop through all cases in set and create message115432 . . . ;Quit if no report information present 115395 115433 "RTN","C0CRAHL7",40,0) 115396 . S RASET=1115434 . . . D SETHL7 115397 115435 "RTN","C0CRAHL7",41,0) 115398 . N RACNI,RAII S RAII=0115436 . . . S C0CSBCNT=0 115399 115437 "RTN","C0CRAHL7",42,0) 115400 . F S RAII=$O(^RADPT(RADFN,"DT",RADTI,"P",RAII)) Q:RAII'>0D115438 . . . F S C0CSBCNT=$O(HLA("HLS",C0CSBCNT)) Q:C0CSBCNT="" D 115401 115439 "RTN","C0CRAHL7",43,0) 115402 . . Q:$P(^RADPT(RADFN,"DT",RADTI,"P",RAII,0),U,25)'=2115440 . . . . S ^TMP("HLS",$J,C0CCNT)=$G(HLA("HLS",C0CSBCNT)) 115403 115441 "RTN","C0CRAHL7",44,0) 115404 . . S RACNI=RAII115442 . . . . S C0CCNT=C0CCNT+1 115405 115443 "RTN","C0CRAHL7",45,0) 115406 . . D NEW115444 ; 115407 115445 "RTN","C0CRAHL7",46,0) 115408 NEW ; new variables 115446 K HLA("HLS"),RARPT,C0CSBCNT,C0CRANO,C0CRAIDT,C0CRASDT,C0CRLMT,C0CSTRT 115409 115447 "RTN","C0CRAHL7",47,0) 115410 ;S:$D(ZTQUEUED) ZTREQ="@" ; delete task from task global115448 K C0CRAXAM,C0CCNT,C0CRAEDT 115411 115449 "RTN","C0CRAHL7",48,0) 115412 N DIWF,DIWL,DIWR,RACPT,RACPTNDE,RADTECN,RADTE0,RADTV,RAI,RAN,RAOBR4,RAPRCNDE,RAPROC,RAPROCIT,RAPRV,RARPT0,VADM,VAERR,X,X1,X2,XX2,Y,X0,OBR36,DFN115450 Q 115413 115451 "RTN","C0CRAHL7",49,0) 115414 N EID,HL,INT,HLQ,HLFS,HLECH,RAN K RAVADM115452 ; 115415 115453 "RTN","C0CRAHL7",50,0) 115416 S HLDT=$$NOW^XLFDT(),HLDT1=$$HLDATE^HLFNC(HLDT) 115454 SETHL7 ;SETHL7 SEGMENTS 115417 115455 "RTN","C0CRAHL7",51,0) 115418 S (HLECH,HL("ECH"))="^~\&"115456 N RASET,RACN0 115419 115457 "RTN","C0CRAHL7",52,0) 115420 S (HLFS,HL("FS"))="|"115458 S RASET=0 115421 115459 "RTN","C0CRAHL7",53,0) 115422 S (HLQ,HL("Q"))=""""115460 S RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0) 115423 115461 "RTN","C0CRAHL7",54,0) 115424 S DFN=RADFN D DEM^VADPT115462 I +$P(RACN0,U,25)=2 D Q ; printset 115425 115463 "RTN","C0CRAHL7",55,0) 115426 I VADM(1)']"" S HLP("ERRTEXT")="Invalid Patient Identifier" G EXIT115464 . ; loop through all cases in set and create message 115427 115465 "RTN","C0CRAHL7",56,0) 115428 S RAN=0115466 . S RASET=1 115429 115467 "RTN","C0CRAHL7",57,0) 115430 S RAVADM(3)=$S($E(+VADM(3),6,7)="00":"",1:+VADM(3))115468 . N RACNI,RAII S RAII=0 115431 115469 "RTN","C0CRAHL7",58,0) 115432 D SETUP,PID,OBR,OBXRPT115470 . F S RAII=$O(^RADPT(RADFN,"DT",RADTI,"P",RAII)) Q:RAII'>0 D 115433 115471 "RTN","C0CRAHL7",59,0) 115434 EXIT ;EXIT FROM NEW 115472 . . Q:$P(^RADPT(RADFN,"DT",RADTI,"P",RAII,0),U,25)'=2 115435 115473 "RTN","C0CRAHL7",60,0) 115436 K HL,HLDT,HLDT1,VADM,VA("PID"),C0COBRFR,RADTI115474 . . S RACNI=RAII 115437 115475 "RTN","C0CRAHL7",61,0) 115438 Q115476 . . D NEW 115439 115477 "RTN","C0CRAHL7",62,0) 115440 ; 115478 NEW ; new variables 115441 115479 "RTN","C0CRAHL7",63,0) 115442 OBR ;Compile 'OBR' Segment 115480 ;S:$D(ZTQUEUED) ZTREQ="@" ; delete task from task global 115443 115481 "RTN","C0CRAHL7",64,0) 115444 S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$P(RACPTNDE,U,2)_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP"115482 N DIWF,DIWL,DIWR,RACPT,RACPTNDE,RADTECN,RADTE0,RADTV,RAI,RAN,RAOBR4,RAPRCNDE,RAPROC,RAPROCIT,RAPRV,RARPT0,VADM,VAERR,X,X1,X2,XX2,Y,X0,OBR36,DFN 115445 115483 "RTN","C0CRAHL7",65,0) 115446 S C0COBRFR=$P(RACPTNDE,U)_$E(HLECH)_"RAD Procedure"_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP"115484 N EID,HL,INT,HLQ,HLFS,HLECH,RAN K RAVADM 115447 115485 "RTN","C0CRAHL7",66,0) 115448 ; Replace above with following when Imaging can cope with ESC chars115486 S HLDT=$$NOW^XLFDT(),HLDT1=$$HLDATE^HLFNC(HLDT) 115449 115487 "RTN","C0CRAHL7",67,0) 115450 ; S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$$ESCAPE^RAHLRU($P(RACPTNDE,U,2))_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$$ESCAPE^RAHLRU($P(RAPRCNDE,U))_$E(HLECH)_"99RAP"115488 S (HLECH,HL("ECH"))="^~\&" 115451 115489 "RTN","C0CRAHL7",68,0) 115452 ; Have to use LOCAL code if Broad Procedure - no CPT code115490 S (HLFS,HL("FS"))="|" 115453 115491 "RTN","C0CRAHL7",69,0) 115454 I $P(RAOBR4,$E(HLECH))=""!($P(RAOBR4,$E(HLECH),2)="") S $P(RAOBR4,$E(HLECH),1,3)=$P(RAOBR4,$E(HLECH),4,5)_$E(HLECH)_"LOCAL"115492 S (HLQ,HL("Q"))="""" 115455 115493 "RTN","C0CRAHL7",70,0) 115456 S X1="OBR"_HLFS_HLFS_HLFS_RADTI_"-"_RACNI_$E(HLECH)_RADTECN_$E(HLECH)_"L"_HLFS_C0COBRFR_HLFS_HLFS_HLFS_RADTE0_HLFS_HLQ_HLFS_HLQ_HLFS_HLFS_HLFS_HLFS_HLFS,Y=$$HLDATE^HLFNC($P(RARPT0,"^",6)) S X1=X1_Y_HLFS_HLFS115494 S DFN=RADFN D DEM^VADPT 115457 115495 "RTN","C0CRAHL7",71,0) 115458 S RAPRV=$$GET1^DIQ(200,+$P(RACN0,"^",14),.01)115496 I VADM(1)']"" S HLP("ERRTEXT")="Invalid Patient Identifier" G EXIT 115459 115497 "RTN","C0CRAHL7",72,0) 115460 S Y=$$HLNAME^HLFNC(RAPRV) S X1=X1_$S(Y]"":+$P(RACN0,"^",14)_$E(HLECH)_Y,1:"")115498 S RAN=0 115461 115499 "RTN","C0CRAHL7",73,0) 115462 S $P(X1,HLFS,19)=$S($D(^DIC(42,+$P(RACN0,"^",6),0)):$P(^(0),"^"),$D(^SC(+$P(RACN0,"^",8),0)):$P(^(0),"^"),1:"Unknown")115500 S RAVADM(3)=$S($E(+VADM(3),6,7)="00":"",1:+VADM(3)) 115463 115501 "RTN","C0CRAHL7",74,0) 115464 ; PCE 21 -> ien file #79.1~name of img loc~stn #~stn name115502 D SETUP,PID,OBR,OBXRPT 115465 115503 "RTN","C0CRAHL7",75,0) 115466 N RACN00,RA20 S RACN00=$G(^RADPT(RADFN,"DT",RADTI,0)) 115504 EXIT ;EXIT FROM NEW 115467 115505 "RTN","C0CRAHL7",76,0) 115468 S RA20=+$G(^RA(79.1,+$P(RACN00,U,4),0))115506 K HL,HLDT,HLDT1,VADM,VA("PID"),C0COBRFR,RADTI 115469 115507 "RTN","C0CRAHL7",77,0) 115470 S $P(X1,HLFS,21)=$P(RACN00,"^",4)_$E(HLECH)_$P($G(^SC(RA20,0)),"^")_$E(HLECH)_$P(RACN00,"^",3)_$E(HLECH)_$P($G(^DIC(4,$P(RACN00,U,3),0)),"^")115508 Q 115471 115509 "RTN","C0CRAHL7",78,0) 115472 S $P(X1,HLFS,21)=$P(X1,HLFS,21)115510 ; 115473 115511 "RTN","C0CRAHL7",79,0) 115474 ; Replace above with following when Imaging can cope with ESC chars 115512 OBR ;Compile 'OBR' Segment 115475 115513 "RTN","C0CRAHL7",80,0) 115476 ; S $P(X1,HLFS,21)=$$ESCAPE^RAHLRU($P(X1,HLFS,21))115514 S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$P(RACPTNDE,U,2)_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP" 115477 115515 "RTN","C0CRAHL7",81,0) 115478 ;115516 S C0COBRFR=$P(RACPTNDE,U)_$E(HLECH)_"RAD Procedure"_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP" 115479 115517 "RTN","C0CRAHL7",82,0) 115480 S OBR36=9999999.9999-RADTI115518 ; Replace above with following when Imaging can cope with ESC chars 115481 115519 "RTN","C0CRAHL7",83,0) 115482 S $P(X1,HLFS,37)=$$FMTHL7^XLFDT(OBR36)115520 ; S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$$ESCAPE^RAHLRU($P(RACPTNDE,U,2))_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$$ESCAPE^RAHLRU($P(RAPRCNDE,U))_$E(HLECH)_"99RAP" 115483 115521 "RTN","C0CRAHL7",84,0) 115484 ;115522 ; Have to use LOCAL code if Broad Procedure - no CPT code 115485 115523 "RTN","C0CRAHL7",85,0) 115486 S RADTV=HLDT1 I $P(RARPT0,"^",5)="V",$P(RARPT0,"^",7) K RADTV S RADTV=$$HLDATE^HLFNC($P(RARPT0,"^",7))115524 I $P(RAOBR4,$E(HLECH))=""!($P(RAOBR4,$E(HLECH),2)="") S $P(RAOBR4,$E(HLECH),1,3)=$P(RAOBR4,$E(HLECH),4,5)_$E(HLECH)_"LOCAL" 115487 115525 "RTN","C0CRAHL7",86,0) 115488 S $P(X1,HLFS,23)=RADTV,$P(X1,HLFS,26)=$S($P(RARPT0,"^",5)="V":"F",1:"R")115526 S X1="OBR"_HLFS_HLFS_HLFS_RADTI_"-"_RACNI_$E(HLECH)_RADTECN_$E(HLECH)_"L"_HLFS_C0COBRFR_HLFS_HLFS_HLFS_RADTE0_HLFS_HLQ_HLFS_HLQ_HLFS_HLFS_HLFS_HLFS_HLFS,Y=$$HLDATE^HLFNC($P(RARPT0,"^",6)) S X1=X1_Y_HLFS_HLFS 115489 115527 "RTN","C0CRAHL7",87,0) 115490 ;Principal Result Interpreter = Verifying Physician115528 S RAPRV=$$GET1^DIQ(200,+$P(RACN0,"^",14),.01) 115491 115529 "RTN","C0CRAHL7",88,0) 115492 S $P(X1,HLFS,33)="" I $P(RARPT0,"^",9) D115530 S Y=$$HLNAME^HLFNC(RAPRV) S X1=X1_$S(Y]"":+$P(RACN0,"^",14)_$E(HLECH)_Y,1:"") 115493 115531 "RTN","C0CRAHL7",89,0) 115494 .S X2=$$GET1^DIQ(200,$P(RARPT0,"^",9),.01) Q:X2']""115532 S $P(X1,HLFS,19)=$S($D(^DIC(42,+$P(RACN0,"^",6),0)):$P(^(0),"^"),$D(^SC(+$P(RACN0,"^",8),0)):$P(^(0),"^"),1:"Unknown") 115495 115533 "RTN","C0CRAHL7",90,0) 115496 .S Y=$$HLNAME^HLFNC(X2) Q:Y']""115534 ; PCE 21 -> ien file #79.1~name of img loc~stn #~stn name 115497 115535 "RTN","C0CRAHL7",91,0) 115498 .S $P(X1,HLFS,33)=$P(RARPT0,"^",9)_$E(HLECH)_Y115536 N RACN00,RA20 S RACN00=$G(^RADPT(RADFN,"DT",RADTI,0)) 115499 115537 "RTN","C0CRAHL7",92,0) 115500 ;Assistant Result Interpreter = Primary Interpreting Staff OR Resident115538 S RA20=+$G(^RA(79.1,+$P(RACN00,U,4),0)) 115501 115539 "RTN","C0CRAHL7",93,0) 115502 S $P(X1,HLFS,34)="" I $P(RACN0,"^",15) D115540 S $P(X1,HLFS,21)=$P(RACN00,"^",4)_$E(HLECH)_$P($G(^SC(RA20,0)),"^")_$E(HLECH)_$P(RACN00,"^",3)_$E(HLECH)_$P($G(^DIC(4,$P(RACN00,U,3),0)),"^") 115503 115541 "RTN","C0CRAHL7",94,0) 115504 .S X2=$$GET1^DIQ(200,$P(RACN0,"^",15),.01) Q:X2']""115542 S $P(X1,HLFS,21)=$P(X1,HLFS,21) 115505 115543 "RTN","C0CRAHL7",95,0) 115506 .S Y=$$HLNAME^HLFNC(X2) Q:Y']""115544 ; Replace above with following when Imaging can cope with ESC chars 115507 115545 "RTN","C0CRAHL7",96,0) 115508 .S $P(X1,HLFS,34)=$P(RACN0,"^",15)_$E(HLECH)_Y115546 ; S $P(X1,HLFS,21)=$$ESCAPE^RAHLRU($P(X1,HLFS,21)) 115509 115547 "RTN","C0CRAHL7",97,0) 115510 I $P(RACN0,"^",12) D115548 ; 115511 115549 "RTN","C0CRAHL7",98,0) 115512 .S X2=$$GET1^DIQ(200,$P(RACN0,"^",12),.01) Q:X2']""115550 S OBR36=9999999.9999-RADTI 115513 115551 "RTN","C0CRAHL7",99,0) 115514 .S Y=$$HLNAME^HLFNC(X2) Q:Y']""115552 S $P(X1,HLFS,37)=$$FMTHL7^XLFDT(OBR36) 115515 115553 "RTN","C0CRAHL7",100,0) 115516 .S $P(X1,HLFS,34)=$P(RACN0,"^",12)_$E(HLECH)_Y115554 ; 115517 115555 "RTN","C0CRAHL7",101,0) 115518 ;Technician = Technologist115556 S RADTV=HLDT1 I $P(RARPT0,"^",5)="V",$P(RARPT0,"^",7) K RADTV S RADTV=$$HLDATE^HLFNC($P(RARPT0,"^",7)) 115519 115557 "RTN","C0CRAHL7",102,0) 115520 S $P(X1,HLFS,35)="" I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) D115558 S $P(X1,HLFS,23)=RADTV,$P(X1,HLFS,26)=$S($P(RARPT0,"^",5)="V":"F",1:"R") 115521 115559 "RTN","C0CRAHL7",103,0) 115522 .S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) I X2']"" Q115560 ;Principal Result Interpreter = Verifying Physician 115523 115561 "RTN","C0CRAHL7",104,0) 115524 .S X2=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",X2,0)) I X2']"" Q115562 S $P(X1,HLFS,33)="" I $P(RARPT0,"^",9) D 115525 115563 "RTN","C0CRAHL7",105,0) 115526 .S XX2=$$GET1^DIQ(200,X2,.01) Q:XX2']""115564 .S X2=$$GET1^DIQ(200,$P(RARPT0,"^",9),.01) Q:X2']"" 115527 115565 "RTN","C0CRAHL7",106,0) 115528 .S Y=$$HLNAME^HLFNC(XX2) I Y']"" Q115566 .S Y=$$HLNAME^HLFNC(X2) Q:Y']"" 115529 115567 "RTN","C0CRAHL7",107,0) 115530 .S $P(X1,HLFS,35)=X2_$E(HLECH)_Y115568 .S $P(X1,HLFS,33)=$P(RARPT0,"^",9)_$E(HLECH)_Y 115531 115569 "RTN","C0CRAHL7",108,0) 115532 ;Transcriptionist115570 ;Assistant Result Interpreter = Primary Interpreting Staff OR Resident 115533 115571 "RTN","C0CRAHL7",109,0) 115534 S $P(X1,HLFS,36)="" I $G(^RARPT(RARPT,"T")) D115572 S $P(X1,HLFS,34)="" I $P(RACN0,"^",15) D 115535 115573 "RTN","C0CRAHL7",110,0) 115536 .S X2=$$GET1^DIQ(200,^RARPT(RARPT,"T"),.01) I X2']"" Q115574 .S X2=$$GET1^DIQ(200,$P(RACN0,"^",15),.01) Q:X2']"" 115537 115575 "RTN","C0CRAHL7",111,0) 115538 .S Y=$$HLNAME^HLFNC(X2) I Y']"" Q115576 .S Y=$$HLNAME^HLFNC(X2) Q:Y']"" 115539 115577 "RTN","C0CRAHL7",112,0) 115540 .S $P(X1,HLFS,36)=^RARPT(RARPT,"T")_$E(HLECH)_Y115578 .S $P(X1,HLFS,34)=$P(RACN0,"^",15)_$E(HLECH)_Y 115541 115579 "RTN","C0CRAHL7",113,0) 115542 ;115580 I $P(RACN0,"^",12) D 115543 115581 "RTN","C0CRAHL7",114,0) 115544 S RAN=RAN+1115582 .S X2=$$GET1^DIQ(200,$P(RACN0,"^",12),.01) Q:X2']"" 115545 115583 "RTN","C0CRAHL7",115,0) 115546 I $D(RAPART) S HLA("HLS",RAN)=$P(RAPART(1),HLFS)_HLFS,HLA("HLS",RAN,1)=$P(RAPART(1),HLFS,2,99)_HLFS,HLA("HLS",RAN,2)=RAPART(2) K RAPART Q115584 .S Y=$$HLNAME^HLFNC(X2) Q:Y']"" 115547 115585 "RTN","C0CRAHL7",116,0) 115548 S HLA("HLS",RAN)=X1115586 .S $P(X1,HLFS,34)=$P(RACN0,"^",12)_$E(HLECH)_Y 115549 115587 "RTN","C0CRAHL7",117,0) 115550 Q115588 ;Technician = Technologist 115551 115589 "RTN","C0CRAHL7",118,0) 115590 S $P(X1,HLFS,35)="" I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) D 115591 "RTN","C0CRAHL7",119,0) 115592 .S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) I X2']"" Q 115593 "RTN","C0CRAHL7",120,0) 115594 .S X2=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",X2,0)) I X2']"" Q 115595 "RTN","C0CRAHL7",121,0) 115596 .S XX2=$$GET1^DIQ(200,X2,.01) Q:XX2']"" 115597 "RTN","C0CRAHL7",122,0) 115598 .S Y=$$HLNAME^HLFNC(XX2) I Y']"" Q 115599 "RTN","C0CRAHL7",123,0) 115600 .S $P(X1,HLFS,35)=X2_$E(HLECH)_Y 115601 "RTN","C0CRAHL7",124,0) 115602 ;Transcriptionist 115603 "RTN","C0CRAHL7",125,0) 115604 S $P(X1,HLFS,36)="" I $G(^RARPT(RARPT,"T")) D 115605 "RTN","C0CRAHL7",126,0) 115606 .S X2=$$GET1^DIQ(200,^RARPT(RARPT,"T"),.01) I X2']"" Q 115607 "RTN","C0CRAHL7",127,0) 115608 .S Y=$$HLNAME^HLFNC(X2) I Y']"" Q 115609 "RTN","C0CRAHL7",128,0) 115610 .S $P(X1,HLFS,36)=^RARPT(RARPT,"T")_$E(HLECH)_Y 115611 "RTN","C0CRAHL7",129,0) 115612 ; 115613 "RTN","C0CRAHL7",130,0) 115614 S RAN=RAN+1 115615 "RTN","C0CRAHL7",131,0) 115616 I $D(RAPART) S HLA("HLS",RAN)=$P(RAPART(1),HLFS)_HLFS,HLA("HLS",RAN,1)=$P(RAPART(1),HLFS,2,99)_HLFS,HLA("HLS",RAN,2)=RAPART(2) K RAPART Q 115617 "RTN","C0CRAHL7",132,0) 115618 S HLA("HLS",RAN)=X1 115619 "RTN","C0CRAHL7",133,0) 115620 Q 115621 "RTN","C0CRAHL7",134,0) 115552 115622 OBXRPT ;Compile 'OBX' Segment for Radiology Report Text 115553 "RTN","C0CRAHL7",119,0)115554 N RATX115555 "RTN","C0CRAHL7",120,0)115556 I '$O(^RARPT(RARPT,"R",0)) S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_"None Entered" D OBX11^RAHLRU Q115557 "RTN","C0CRAHL7",121,0)115558 S RATX="" F RAI=0:0 S RAI=$O(^RARPT(RARPT,"R",RAI)) Q:'RAI I $D(^(RAI,0)) S RATX=RATX_^(0)115559 "RTN","C0CRAHL7",122,0)115560 S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_$G(RATX) D OBX11^RAHLRU115561 "RTN","C0CRAHL7",123,0)115562 Q115563 "RTN","C0CRAHL7",124,0)115564 PID ;Compile 'PID' Segment115565 "RTN","C0CRAHL7",125,0)115566 ;115567 "RTN","C0CRAHL7",126,0)115568 S X1="",X1="PID"_HLFS_HLFS_$G(VA("PID"))_HLFS_Y_HLFS_HLFS S X=VADM(1),Y=$$HLNAME^HLFNC(X) S X1=X1_Y_HLFS_HLFS115569 "RTN","C0CRAHL7",127,0)115570 S X=RAVADM(3),Y=$$HLDATE^HLFNC(X) S X1=X1_Y_HLFS_$S(VADM(5)]"":$S("MF"[$P(VADM(5),"^"):$P(VADM(5),"^"),1:"O")) S:$P(VADM(2),"^")]"" $P(X1,HLFS,20)=$P(VADM(2),"^") S RAN=RAN+1,HLA("HLS",RAN)=X1115571 "RTN","C0CRAHL7",128,0)115572 Q115573 "RTN","C0CRAHL7",129,0)115574 SETUP ; Setup basic examination information115575 "RTN","C0CRAHL7",130,0)115576 S:RASET RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)115577 "RTN","C0CRAHL7",131,0)115578 S RADTE0=9999999.9999-RADTI,RADTECN=$E(RADTE0,4,7)_$E(RADTE0,2,3)_"-"_+RACN0,RARPT0=^RARPT(RARPT,0)115579 "RTN","C0CRAHL7",132,0)115580 S RAPROC=+$P(RACN0,U,2),RAPROCIT=+$P($G(^RAMIS(71,RAPROC,0)),U,12),RAPROCIT=$P(^RA(79.2,RAPROCIT,0),U,1)115581 "RTN","C0CRAHL7",133,0)115582 S RAPRCNDE=$G(^RAMIS(71,+RAPROC,0)),RACPT=+$P(RAPRCNDE,U,9)115583 "RTN","C0CRAHL7",134,0)115584 S RACPTNDE=$$NAMCODE^RACPTMSC(RACPT,DT)115585 115623 "RTN","C0CRAHL7",135,0) 115586 S Y=$$HLDATE^HLFNC(RADTE0) S RADTE0=$S(Y:Y,1:HLQ),Y=$$M11^HLFNC(RADFN)115624 N RATX 115587 115625 "RTN","C0CRAHL7",136,0) 115588 Q 115626 I '$O(^RARPT(RARPT,"R",0)) S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_"None Entered" D OBX11^RAHLRU Q 115627 "RTN","C0CRAHL7",137,0) 115628 S RATX="" F RAI=0:0 S RAI=$O(^RARPT(RARPT,"R",RAI)) Q:'RAI I $D(^(RAI,0)) S RATX=RATX_^(0) 115629 "RTN","C0CRAHL7",138,0) 115630 S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_$G(RATX) D OBX11^RAHLRU 115631 "RTN","C0CRAHL7",139,0) 115632 Q 115633 "RTN","C0CRAHL7",140,0) 115634 PID ;Compile 'PID' Segment 115635 "RTN","C0CRAHL7",141,0) 115636 ; 115637 "RTN","C0CRAHL7",142,0) 115638 S X1="",X1="PID"_HLFS_HLFS_$G(VA("PID"))_HLFS_Y_HLFS_HLFS S X=VADM(1),Y=$$HLNAME^HLFNC(X) S X1=X1_Y_HLFS_HLFS 115639 "RTN","C0CRAHL7",143,0) 115640 S X=RAVADM(3),Y=$$HLDATE^HLFNC(X) S X1=X1_Y_HLFS_$S(VADM(5)]"":$S("MF"[$P(VADM(5),"^"):$P(VADM(5),"^"),1:"O")) S:$P(VADM(2),"^")]"" $P(X1,HLFS,20)=$P(VADM(2),"^") S RAN=RAN+1,HLA("HLS",RAN)=X1 115641 "RTN","C0CRAHL7",144,0) 115642 Q 115643 "RTN","C0CRAHL7",145,0) 115644 SETUP ; Setup basic examination information 115645 "RTN","C0CRAHL7",146,0) 115646 S:RASET RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0) 115647 "RTN","C0CRAHL7",147,0) 115648 S RADTE0=9999999.9999-RADTI,RADTECN=$E(RADTE0,4,7)_$E(RADTE0,2,3)_"-"_+RACN0,RARPT0=^RARPT(RARPT,0) 115649 "RTN","C0CRAHL7",148,0) 115650 S RAPROC=+$P(RACN0,U,2),RAPROCIT=+$P($G(^RAMIS(71,RAPROC,0)),U,12),RAPROCIT=$P(^RA(79.2,RAPROCIT,0),U,1) 115651 "RTN","C0CRAHL7",149,0) 115652 S RAPRCNDE=$G(^RAMIS(71,+RAPROC,0)),RACPT=+$P(RAPRCNDE,U,9) 115653 "RTN","C0CRAHL7",150,0) 115654 S RACPTNDE=$$NAMCODE^RACPTMSC(RACPT,DT) 115655 "RTN","C0CRAHL7",151,0) 115656 S Y=$$HLDATE^HLFNC(RADTE0) S RADTE0=$S(Y:Y,1:HLQ),Y=$$M11^HLFNC(RADFN) 115657 "RTN","C0CRAHL7",152,0) 115658 Q 115589 115659 "RTN","C0CRARPT") 115590 0^106^B6 8379544115660 0^106^B66576750 115591 115661 "RTN","C0CRARPT",1,0) 115592 C0CRARPT 115662 C0CRARPT ; C0C/ELN - CCR/CCD PROCESSING FOR RAD REPORT ; 19/10/2010 115593 115663 "RTN","C0CRARPT",2,0) 115594 ;;1.2;C0C;;May 11, 2012;Build 50115664 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 115595 115665 "RTN","C0CRARPT",3,0) 115596 MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT 115666 ; 115597 115667 "RTN","C0CRARPT",4,0) 115598 ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR115668 ; (C) ELN 2010 115599 115669 "RTN","C0CRARPT",5,0) 115600 ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME115670 ; 115601 115671 "RTN","C0CRARPT",6,0) 115602 ; MIXML IS THE TEMPLATE TO USE115672 ; This program is free software: you can redistribute it and/or modify 115603 115673 "RTN","C0CRARPT",7,0) 115604 ; MOXML IS THE OUTPUT XML ARRAY115674 ; it under the terms of the GNU Affero General Public License as 115605 115675 "RTN","C0CRARPT",8,0) 115606 ; DFN IS THE PATIENT RECORD NUMBER115676 ; published by the Free Software Foundation, either version 3 of the 115607 115677 "RTN","C0CRARPT",9,0) 115608 N C0COXML,C0CO,C0CV,C0CIXML115678 ; License, or (at your option) any later version. 115609 115679 "RTN","C0CRARPT",10,0) 115610 I '$D(MIVAR) S C0CV="" ;DEFAULT115680 ; 115611 115681 "RTN","C0CRARPT",11,0) 115612 E S C0CV=MIVAR ;PASSED VARIABLE ARRAY115682 ; This program is distributed in the hope that it will be useful, 115613 115683 "RTN","C0CRARPT",12,0) 115614 I '$D(MIXML) S C0CIXML="" ;DEFAULT115684 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 115615 115685 "RTN","C0CRARPT",13,0) 115616 E S C0CIXML=MIXML ;PASSED INPUT XML115686 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 115617 115687 "RTN","C0CRARPT",14,0) 115618 D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK115688 ; GNU Affero General Public License for more details. 115619 115689 "RTN","C0CRARPT",15,0) 115620 I '$D(MOXML) D Q115690 ; 115621 115691 "RTN","C0CRARPT",16,0) 115622 . S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT115692 ; You should have received a copy of the GNU Affero General Public License 115623 115693 "RTN","C0CRARPT",17,0) 115624 . M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT115694 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 115625 115695 "RTN","C0CRARPT",18,0) 115626 E D115696 ; 115627 115697 "RTN","C0CRARPT",19,0) 115628 . N C0COOXML 115698 MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT 115629 115699 "RTN","C0CRARPT",20,0) 115630 . S CCRGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR"))115700 ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR 115631 115701 "RTN","C0CRARPT",21,0) 115632 . D QUERY^C0CXPATH(CCRGLO,"//ContinuityOfCareRecord/Body/Results","C0CRSXML")115702 ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME 115633 115703 "RTN","C0CRARPT",22,0) 115634 . S C0COCNT=$O(C0CRSXML(""),-1)115704 ; MIXML IS THE TEMPLATE TO USE 115635 115705 "RTN","C0CRARPT",23,0) 115636 . S C0CRES=0115706 ; MOXML IS THE OUTPUT XML ARRAY 115637 115707 "RTN","C0CRARPT",24,0) 115638 . F S C0CRES=$O(C0COXML(C0CRES)) Q:C0CRES="" D115708 ; DFN IS THE PATIENT RECORD NUMBER 115639 115709 "RTN","C0CRARPT",25,0) 115640 . . Q:$G(C0COXML(C0CRES))="<Results>"!($G(C0COXML(C0CRES))="</Results>")115710 N C0COXML,C0CO,C0CV,C0CIXML 115641 115711 "RTN","C0CRARPT",26,0) 115642 . . S C0CRSXML(C0COCNT)=$G(C0COXML(C0CRES))115712 I '$D(MIVAR) S C0CV="" ;DEFAULT 115643 115713 "RTN","C0CRARPT",27,0) 115644 . . S C0COCNT=C0COCNT+1115714 E S C0CV=MIVAR ;PASSED VARIABLE ARRAY 115645 115715 "RTN","C0CRARPT",28,0) 115646 . S C0CRSXML(C0COCNT)="</Results>"115716 I '$D(MIXML) S C0CIXML="" ;DEFAULT 115647 115717 "RTN","C0CRARPT",29,0) 115648 . S C0CRSXML(0)=C0COCNT115718 E S C0CIXML=MIXML ;PASSED INPUT XML 115649 115719 "RTN","C0CRARPT",30,0) 115650 . D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")115720 D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK 115651 115721 "RTN","C0CRARPT",31,0) 115652 . D INSERT^C0CXPATH(CCRGLO,"C0CRSXML","//ContinuityOfCareRecord/Body")115722 I '$D(MOXML) D Q 115653 115723 "RTN","C0CRARPT",32,0) 115654 S C0CO=MOXML,@C0CO@(0)=0115724 . S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT 115655 115725 "RTN","C0CRARPT",33,0) 115656 K C0CRSXML,C0COCNT,C0COXML,C0CRES115726 . M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT 115657 115727 "RTN","C0CRARPT",34,0) 115658 Q115728 E D 115659 115729 "RTN","C0CRARPT",35,0) 115660 RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS 115730 . N C0COOXML 115661 115731 "RTN","C0CRARPT",36,0) 115662 ; RTN IS PASSED BY REFERENCE115732 . S CCRGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) 115663 115733 "RTN","C0CRARPT",37,0) 115664 N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES115734 . D QUERY^C0CXPATH(CCRGLO,"//ContinuityOfCareRecord/Body/Results","C0CRSXML") 115665 115735 "RTN","C0CRARPT",38,0) 115666 N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE115736 . S C0COCNT=$O(C0CRSXML(""),-1) 115667 115737 "RTN","C0CRARPT",39,0) 115668 I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING115738 . S C0CRES=0 115669 115739 "RTN","C0CRARPT",40,0) 115670 I RMIXML="" D ; INPUT XML NOT PASSED115740 . F S C0CRES=$O(C0COXML(C0CRES)) Q:C0CRES="" D 115671 115741 "RTN","C0CRARPT",41,0) 115672 . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE115742 . . Q:$G(C0COXML(C0CRES))="<Results>"!($G(C0COXML(C0CRES))="</Results>") 115673 115743 "RTN","C0CRARPT",42,0) 115674 . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")115744 . . S C0CRSXML(C0COCNT)=$G(C0COXML(C0CRES)) 115675 115745 "RTN","C0CRARPT",43,0) 115676 . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE115746 . . S C0COCNT=C0COCNT+1 115677 115747 "RTN","C0CRARPT",44,0) 115678 E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE115748 . S C0CRSXML(C0COCNT)="</Results>" 115679 115749 "RTN","C0CRARPT",45,0) 115680 I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED115750 . S C0CRSXML(0)=C0COCNT 115681 115751 "RTN","C0CRARPT",46,0) 115682 . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION115752 . D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") 115683 115753 "RTN","C0CRARPT",47,0) 115684 E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS115754 . D INSERT^C0CXPATH(CCRGLO,"C0CRSXML","//ContinuityOfCareRecord/Body") 115685 115755 "RTN","C0CRARPT",48,0) 115686 D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE115756 S C0CO=MOXML,@C0CO@(0)=0 115687 115757 "RTN","C0CRARPT",49,0) 115688 D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ115758 K C0CRSXML,C0COCNT,C0COXML,C0CRES 115689 115759 "RTN","C0CRARPT",50,0) 115690 D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE115760 Q 115691 115761 "RTN","C0CRARPT",51,0) 115692 D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT 115762 RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS 115693 115763 "RTN","C0CRARPT",52,0) 115694 I '$D(@C0CV@(0)) D Q ; NO VARS THERE115764 ; RTN IS PASSED BY REFERENCE 115695 115765 "RTN","C0CRARPT",53,0) 115696 . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR115766 N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES 115697 115767 "RTN","C0CRARPT",54,0) 115698 ; NO RESULTS115768 N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE 115699 115769 "RTN","C0CRARPT",55,0) 115700 I @C0CV@(0)=0 S RTN(0)=0 Q115770 I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING 115701 115771 "RTN","C0CRARPT",56,0) 115702 S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))115772 I RMIXML="" D ; INPUT XML NOT PASSED 115703 115773 "RTN","C0CRARPT",57,0) 115704 K @RIMVARS115774 . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE 115705 115775 "RTN","C0CRARPT",58,0) 115706 M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH115776 . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R") 115707 115777 "RTN","C0CRARPT",59,0) 115708 N C0CI,C0CIN,C0CJ,C0CJE,C0CJS,C0CJN,C0CMAP,C0CTMAP,C0CTMP115778 . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE 115709 115779 "RTN","C0CRARPT",60,0) 115710 S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)115780 E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE 115711 115781 "RTN","C0CRARPT",61,0) 115712 N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT115782 I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED 115713 115783 "RTN","C0CRARPT",62,0) 115714 N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA115784 . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION 115715 115785 "RTN","C0CRARPT",63,0) 115716 N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END115786 E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS 115717 115787 "RTN","C0CRARPT",64,0) 115718 ; TO IMPROVE PERFORMANCE115788 D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE 115719 115789 "RTN","C0CRARPT",65,0) 115720 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>115790 D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ 115721 115791 "RTN","C0CRARPT",66,0) 115722 F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES115792 D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE 115723 115793 "RTN","C0CRARPT",67,0) 115724 . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES115794 D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT 115725 115795 "RTN","C0CRARPT",68,0) 115726 . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST115796 I '$D(@C0CV@(0)) D Q ; NO VARS THERE 115727 115797 "RTN","C0CRARPT",69,0) 115728 . S C0CMAP=$NA(@C0CV@(C0CI)) ;115798 . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR 115729 115799 "RTN","C0CRARPT",70,0) 115730 . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA115800 ; NO RESULTS 115731 115801 "RTN","C0CRARPT",71,0) 115732 . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>115802 I @C0CV@(0)=0 S RTN(0)=0 Q 115733 115803 "RTN","C0CRARPT",72,0) 115734 . I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST115804 S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS")) 115735 115805 "RTN","C0CRARPT",73,0) 115736 . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS115806 K @RIMVARS 115737 115807 "RTN","C0CRARPT",74,0) 115738 . . K C0CTO ; CLEAR OUTPUT VARIABLE115808 M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH 115739 115809 "RTN","C0CRARPT",75,0) 115740 . . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT115810 N C0CI,C0CIN,C0CJ,C0CJE,C0CJS,C0CJN,C0CMAP,C0CTMAP,C0CTMP 115741 115811 "RTN","C0CRARPT",76,0) 115742 . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS115812 S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR) 115743 115813 "RTN","C0CRARPT",77,0) 115744 . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS115814 N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT 115745 115815 "RTN","C0CRARPT",78,0) 115746 . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;115816 N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA 115747 115817 "RTN","C0CRARPT",79,0) 115748 . . . D MAP^C0CXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP115818 N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END 115749 115819 "RTN","C0CRARPT",80,0) 115750 . . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE <Test>115820 ; TO IMPROVE PERFORMANCE 115751 115821 "RTN","C0CRARPT",81,0) 115752 . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;</Test>115822 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results> 115753 115823 "RTN","C0CRARPT",82,0) 115754 . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML115824 F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES 115755 115825 "RTN","C0CRARPT",83,0) 115756 . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST115826 . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES 115757 115827 "RTN","C0CRARPT",84,0) 115758 . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>115828 . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST 115759 115829 "RTN","C0CRARPT",85,0) 115760 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>115830 . S C0CMAP=$NA(@C0CV@(C0CI)) ; 115761 115831 "RTN","C0CRARPT",86,0) 115762 D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML115832 . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA 115763 115833 "RTN","C0CRARPT",87,0) 115764 K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE115834 . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test> 115765 115835 "RTN","C0CRARPT",88,0) 115766 Q115836 . I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST 115767 115837 "RTN","C0CRARPT",89,0) 115768 EXTRACT(ILXML,DFN,OLXML) ; EXTRACT RADIOLOGY REPORTS INTO THE C0CLVAR GLOBAL 115838 . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS 115769 115839 "RTN","C0CRARPT",90,0) 115770 S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR RADS VARS115840 . . K C0CTO ; CLEAR OUTPUT VARIABLE 115771 115841 "RTN","C0CRARPT",91,0) 115772 S RADFN=DFN115842 . . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT 115773 115843 "RTN","C0CRARPT",92,0) 115774 D GHL7^C0CRAHL7 ; GET HL7 MESSAGE FOR THIS PATIENT115844 . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS 115775 115845 "RTN","C0CRARPT",93,0) 115776 ;ELN K @C0CLB ; CLEAR OUT OLD VARS IF ANY115846 . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS 115777 115847 "RTN","C0CRARPT",94,0) 115778 N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG115848 . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ; 115779 115849 "RTN","C0CRARPT",95,0) 115780 S C0CQT=1 ; SURPRESS LISTING115850 . . . D MAP^C0CXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP 115781 115851 "RTN","C0CRARPT",96,0) 115782 D LIST ; EXTRACT THE VARIABLES115852 . . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE <Test> 115783 115853 "RTN","C0CRARPT",97,0) 115784 ;S C0CQT=QTSAV ; RESET SILENT FLAG115854 . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;</Test> 115785 115855 "RTN","C0CRARPT",98,0) 115786 K ^TMP("HLS",$J),^TMP("C0CCCR","RATBL") ; KILL HL7 MESSAGE OUTPUT115856 . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML 115787 115857 "RTN","C0CRARPT",99,0) 115788 K C0CLB,C0CLB2,C0CLI,C0CLOBX,RADFN115858 . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST 115789 115859 "RTN","C0CRARPT",100,0) 115790 I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS115860 . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result> 115791 115861 "RTN","C0CRARPT",101,0) 115792 Q115862 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results> 115793 115863 "RTN","C0CRARPT",102,0) 115794 LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB 115864 D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML 115795 115865 "RTN","C0CRARPT",103,0) 115796 N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CTAB,C0CTYP115866 K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE 115797 115867 "RTN","C0CRARPT",104,0) 115798 I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS115868 Q 115799 115869 "RTN","C0CRARPT",105,0) 115800 I '$D(C0CQT) S C0CQT=0 115870 EXTRACT(ILXML,DFN,OLXML) ; EXTRACT RADIOLOGY REPORTS INTO THE C0CLVAR GLOBAL 115801 115871 "RTN","C0CRARPT",106,0) 115802 I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT115872 S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR RADS VARS 115803 115873 "RTN","C0CRARPT",107,0) 115804 I '$D(^TMP("C0CCCR","RATBL",0))!($G(^TMP("C0CCCR","RATBL",0))'="V3") D115874 S RADFN=DFN 115805 115875 "RTN","C0CRARPT",108,0) 115806 . D SETTBL^C0CLABS ;INITIALIZE LAB TABLE115876 D GHL7^C0CRAHL7 ; GET HL7 MESSAGE FOR THIS PATIENT 115807 115877 "RTN","C0CRARPT",109,0) 115808 . K ^TMP("C0CCCR","RATBL")115878 ;ELN K @C0CLB ; CLEAR OUT OLD VARS IF ANY 115809 115879 "RTN","C0CRARPT",110,0) 115810 . M ^TMP("C0CCCR","RATBL")=^TMP("C0CCCR","LABTBL")115880 N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG 115811 115881 "RTN","C0CRARPT",111,0) 115812 I '$D(^TMP("HLS",$J,1)) D GHL7^C0CRAHL7 ; GET HL7 MGS IF NOT ALREADY DONE115882 S C0CQT=1 ; SURPRESS LISTING 115813 115883 "RTN","C0CRARPT",112,0) 115814 S C0CTAB=$NA(^TMP("C0CCCR","RATBL")) ; BASE OF OBX TABLE115884 D LIST ; EXTRACT THE VARIABLES 115815 115885 "RTN","C0CRARPT",113,0) 115816 S C0CHB=$NA(^TMP("HLS",$J))115886 ;S C0CQT=QTSAV ; RESET SILENT FLAG 115817 115887 "RTN","C0CRARPT",114,0) 115818 S C0CI=""115888 K ^TMP("HLS",$J),^TMP("C0CCCR","RATBL") ; KILL HL7 MESSAGE OUTPUT 115819 115889 "RTN","C0CRARPT",115,0) 115820 S @C0CLB@(0)=$O(^TMP("C0CCCR",$J,"RESULTS",""),-1) ; INITALIZE RESULTS VARS COUNT115890 K C0CLB,C0CLB2,C0CLI,C0CLOBX,RADFN 115821 115891 "RTN","C0CRARPT",116,0) 115822 F S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI="" D ; FOR ALL RECORDS IN HL7 MSG115892 I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS 115823 115893 "RTN","C0CRARPT",117,0) 115824 . K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES115894 Q 115825 115895 "RTN","C0CRARPT",118,0) 115826 . S C0CTYP=$P(@C0CHB@(C0CI),"|",1) 115896 LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB 115827 115897 "RTN","C0CRARPT",119,0) 115828 . D LTYP^C0CLABS(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)115898 N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CTAB,C0CTYP 115829 115899 "RTN","C0CRARPT",120,0) 115830 . M XV=C0CVAR ;115900 I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS 115831 115901 "RTN","C0CRARPT",121,0) 115832 . I C0CTYP="OBR" D ; BEGINNING OF NEW SECTION115902 I '$D(C0CQT) S C0CQT=0 115833 115903 "RTN","C0CRARPT",122,0) 115834 . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT115904 I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT 115835 115905 "RTN","C0CRARPT",123,0) 115836 . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT115906 I '$D(^TMP("C0CCCR","RATBL",0))!($G(^TMP("C0CCCR","RATBL",0))'="V3") D 115837 115907 "RTN","C0CRARPT",124,0) 115838 . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS115908 . D SETTBL^C0CLABS ;INITIALIZE LAB TABLE 115839 115909 "RTN","C0CRARPT",125,0) 115840 . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI115910 . K ^TMP("C0CCCR","RATBL") 115841 115911 "RTN","C0CRARPT",126,0) 115842 . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR115912 . M ^TMP("C0CCCR","RATBL")=^TMP("C0CCCR","LABTBL") 115843 115913 "RTN","C0CRARPT",127,0) 115844 . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)115914 I '$D(^TMP("HLS",$J,1)) D GHL7^C0CRAHL7 ; GET HL7 MGS IF NOT ALREADY DONE 115845 115915 "RTN","C0CRARPT",128,0) 115846 . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT115916 S C0CTAB=$NA(^TMP("C0CCCR","RATBL")) ; BASE OF OBX TABLE 115847 115917 "RTN","C0CRARPT",129,0) 115848 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL115918 S C0CHB=$NA(^TMP("HLS",$J)) 115849 115919 "RTN","C0CRARPT",130,0) 115850 . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME115920 S C0CI="" 115851 115921 "RTN","C0CRARPT",131,0) 115852 . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS115922 S @C0CLB@(0)=$O(^TMP("C0CCCR",$J,"RESULTS",""),-1) ; INITALIZE RESULTS VARS COUNT 115853 115923 "RTN","C0CRARPT",132,0) 115854 . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION115924 F S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI="" D ; FOR ALL RECORDS IN HL7 MSG 115855 115925 "RTN","C0CRARPT",133,0) 115856 . I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX3115926 . K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES 115857 115927 "RTN","C0CRARPT",134,0) 115858 . . ; RESULTTESTCODEVALUE115928 . S C0CTYP=$P(@C0CHB@(C0CI),"|",1) 115859 115929 "RTN","C0CRARPT",135,0) 115860 . . ; RESULTTESTDESCRIPTIONTEXT115930 . D LTYP^C0CLABS(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT) 115861 115931 "RTN","C0CRARPT",136,0) 115862 . . I C0CVAR("C3")="C4" D ; PRIMARY CODE "CPT"115932 . M XV=C0CVAR ; 115863 115933 "RTN","C0CRARPT",137,0) 115864 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE CPT CODE VALUE115934 . I C0CTYP="OBR" D ; BEGINNING OF NEW SECTION 115865 115935 "RTN","C0CRARPT",138,0) 115866 . . . S XV("RESULTTESTCODINGSYSTEM")="CPT" ; DISPLAY NAME FOR CPT115936 . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT 115867 115937 "RTN","C0CRARPT",139,0) 115868 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT115938 . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT 115869 115939 "RTN","C0CRARPT",140,0) 115870 . . E I C0CVAR("C6")'="" D ; NO CPT CODES, USE SECONDARY IF PRESENT115940 . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS 115871 115941 "RTN","C0CRARPT",141,0) 115872 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE115942 . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI 115873 115943 "RTN","C0CRARPT",142,0) 115874 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME115944 . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR 115875 115945 "RTN","C0CRARPT",143,0) 115876 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT115946 . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1) 115877 115947 "RTN","C0CRARPT",144,0) 115878 . . E D ; NO SECONDARY, USE PRIMARY115948 . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT 115879 115949 "RTN","C0CRARPT",145,0) 115880 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE115950 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL 115881 115951 "RTN","C0CRARPT",146,0) 115882 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME115952 . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME 115883 115953 "RTN","C0CRARPT",147,0) 115884 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT115954 . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS 115885 115955 "RTN","C0CRARPT",148,0) 115886 . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;115956 . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION 115887 115957 "RTN","C0CRARPT",149,0) 115888 . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG115958 . I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX3 115889 115959 "RTN","C0CRARPT",150,0) 115890 . . S C0CZG=XV("RESULTTESTVALUE")115960 . . ; RESULTTESTCODEVALUE 115891 115961 "RTN","C0CRARPT",151,0) 115892 . . S XV("RESULTTESTVALUE")=C0CZG115962 . . ; RESULTTESTDESCRIPTIONTEXT 115893 115963 "RTN","C0CRARPT",152,0) 115894 . . I C0CLOBX=0 D ; FIRST TEST RESULT FOR THIS SECTION115964 . . I C0CVAR("C3")="C4" D ; PRIMARY CODE "CPT" 115895 115965 "RTN","C0CRARPT",153,0) 115896 . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS115966 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE CPT CODE VALUE 115897 115967 "RTN","C0CRARPT",154,0) 115898 . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT115968 . . . S XV("RESULTTESTCODINGSYSTEM")="CPT" ; DISPLAY NAME FOR CPT 115899 115969 "RTN","C0CRARPT",155,0) 115900 . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT115970 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT 115901 115971 "RTN","C0CRARPT",156,0) 115902 . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX115972 . . E I C0CVAR("C6")'="" D ; NO CPT CODES, USE SECONDARY IF PRESENT 115903 115973 "RTN","C0CRARPT",157,0) 115904 . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE115974 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE 115905 115975 "RTN","C0CRARPT",158,0) 115906 . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER115976 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME 115907 115977 "RTN","C0CRARPT",159,0) 115908 . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2115978 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT 115909 115979 "RTN","C0CRARPT",160,0) 115910 . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")115980 . . E D ; NO SECONDARY, USE PRIMARY 115911 115981 "RTN","C0CRARPT",161,0) 115912 . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT115982 . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE 115913 115983 "RTN","C0CRARPT",162,0) 115914 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL115984 . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME 115915 115985 "RTN","C0CRARPT",163,0) 115916 . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME115986 . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT 115917 115987 "RTN","C0CRARPT",164,0) 115918 . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES115988 . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ; 115919 115989 "RTN","C0CRARPT",165,0) 115920 K XV,C0CZG,C0CX1,C0CX2,C0CVAR115990 . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG 115921 115991 "RTN","C0CRARPT",166,0) 115922 Q 115992 . . S C0CZG=XV("RESULTTESTVALUE") 115993 "RTN","C0CRARPT",167,0) 115994 . . S XV("RESULTTESTVALUE")=C0CZG 115995 "RTN","C0CRARPT",168,0) 115996 . . I C0CLOBX=0 D ; FIRST TEST RESULT FOR THIS SECTION 115997 "RTN","C0CRARPT",169,0) 115998 . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS 115999 "RTN","C0CRARPT",170,0) 116000 . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT 116001 "RTN","C0CRARPT",171,0) 116002 . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT 116003 "RTN","C0CRARPT",172,0) 116004 . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX 116005 "RTN","C0CRARPT",173,0) 116006 . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE 116007 "RTN","C0CRARPT",174,0) 116008 . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER 116009 "RTN","C0CRARPT",175,0) 116010 . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2 116011 "RTN","C0CRARPT",176,0) 116012 . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID") 116013 "RTN","C0CRARPT",177,0) 116014 . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT 116015 "RTN","C0CRARPT",178,0) 116016 . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL 116017 "RTN","C0CRARPT",179,0) 116018 . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME 116019 "RTN","C0CRARPT",180,0) 116020 . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES 116021 "RTN","C0CRARPT",181,0) 116022 K XV,C0CZG,C0CX1,C0CX2,C0CVAR 116023 "RTN","C0CRARPT",182,0) 116024 Q 115923 116025 "RTN","C0CRIMA") 115924 0^38^B3 31901748116026 0^38^B328577528 115925 116027 "RTN","C0CRIMA",1,0) 115926 116028 C0CRIMA ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08 115927 116029 "RTN","C0CRIMA",2,0) 115928 ;;1.2;C 0C;;May 11, 2012;Build 50116030 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 115929 116031 "RTN","C0CRIMA",3,0) 115930 116032 ;Copyright 2008,2009 George Lilly, University of Minnesota. 115931 116033 "RTN","C0CRIMA",4,0) 115932 ; Licensed under the terms of the GNU General Public License.116034 ; 115933 116035 "RTN","C0CRIMA",5,0) 115934 ; See attached copy of the License.116036 ; This program is free software: you can redistribute it and/or modify 115935 116037 "RTN","C0CRIMA",6,0) 115936 ; 116038 ; it under the terms of the GNU Affero General Public License as 115937 116039 "RTN","C0CRIMA",7,0) 115938 ; This program is free software; you can redistribute it and/or modify116040 ; published by the Free Software Foundation, either version 3 of the 115939 116041 "RTN","C0CRIMA",8,0) 115940 ; it under the terms of the GNU General Public License as published by116042 ; License, or (at your option) any later version. 115941 116043 "RTN","C0CRIMA",9,0) 115942 ; the Free Software Foundation; either version 2 of the License, or116044 ; 115943 116045 "RTN","C0CRIMA",10,0) 115944 ; (at your option) any later version.116046 ; This program is distributed in the hope that it will be useful, 115945 116047 "RTN","C0CRIMA",11,0) 115946 ; 116048 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 115947 116049 "RTN","C0CRIMA",12,0) 115948 ; This program is distributed in the hope that it will be useful,116050 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 115949 116051 "RTN","C0CRIMA",13,0) 115950 ; but WITHOUT ANY WARRANTY; without even the implied warranty of116052 ; GNU Affero General Public License for more details. 115951 116053 "RTN","C0CRIMA",14,0) 115952 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the116054 ; 115953 116055 "RTN","C0CRIMA",15,0) 115954 ; GNU General Public License for more details.116056 ; You should have received a copy of the GNU Affero General Public License 115955 116057 "RTN","C0CRIMA",16,0) 115956 ; 116058 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 115957 116059 "RTN","C0CRIMA",17,0) 115958 ; You should have received a copy of the GNU General Public License along116060 ; 115959 116061 "RTN","C0CRIMA",18,0) 115960 ; with this program; if not, write to the Free Software Foundation, Inc.,116062 ; THESE ROUTINES EXAMINE ONE OR MORE, UP TO ALL, OF THE PATIENTS ON THE 115961 116063 "RTN","C0CRIMA",19,0) 115962 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.116064 ; SYSTEM TO DETERMINE HOW COMPLETE THE RESULTING CCR OR CCD WOULD BE FOR 115963 116065 "RTN","C0CRIMA",20,0) 115964 ; 116066 ; THESE PATIENTS. IT BEGINS TO MEASURE "HL7 RIM COHERENCE" WHICH IS HOW USEFUL 115965 116067 "RTN","C0CRIMA",21,0) 115966 ; THE SE ROUTINES EXAMINE ONE OR MORE, UP TO ALL, OF THE PATIENTS ON THE116068 ; THE VARIABLES WILL BE TO A RIM-MODELED APPLICATION AFTER THEY ARE 115967 116069 "RTN","C0CRIMA",22,0) 115968 ; SYSTEM TO DETERMINE HOW COMPLETE THE RESULTING CCR OR CCD WOULD BE FOR116070 ; CONVEYED VIA THE CCR OR CCD. 115969 116071 "RTN","C0CRIMA",23,0) 115970 ; THESE PATIENTS. IT BEGINS TO MEASURE "HL7 RIM COHERENCE" WHICH IS HOW USEFUL116072 ; FACTORS THAT AFFECT RIM COHERENCE INCLUDE: 115971 116073 "RTN","C0CRIMA",24,0) 115972 ; THE VARIABLES WILL BE TO A RIM-MODELED APPLICATION AFTER THEY ARE116074 ; 1. THE PRESENSE OF CLINICAL DATA IN A SECTION 115973 116075 "RTN","C0CRIMA",25,0) 115974 ; CONVEYED VIA THE CCR OR CCD.116076 ; 2. ARE THE DATA ELEMENTS TIME-BOUND 115975 116077 "RTN","C0CRIMA",26,0) 115976 ; FACTORS THAT AFFECT RIM COHERENCE INCLUDE:116078 ; 3. ARE THE DATA ELEMENTS CODED WITH SNOMED OR LOINC ETC 115977 116079 "RTN","C0CRIMA",27,0) 115978 ; 1. THE PRESENSE OF CLINICAL DATA IN A SECTION116080 ; 4. ARE SOURCE ACTORS ASSOCIATED WITH THE DATA ELEMENTS 115979 116081 "RTN","C0CRIMA",28,0) 115980 ; 2. ARE THE DATA ELEMENTS TIME-BOUND116082 ; 5. ARE ACTORS IDENTIFIED REGARDING THEIR ROLE 115981 116083 "RTN","C0CRIMA",29,0) 115982 ; 3. ARE THE DATA ELEMENTS CODED WITH SNOMED OR LOINC ETC116084 ; .. AND OTHER FACTORS YET TO BE DETERMINED 115983 116085 "RTN","C0CRIMA",30,0) 115984 ; 4. ARE SOURCE ACTORS ASSOCIATED WITH THE DATA ELEMENTS116086 ; 115985 116087 "RTN","C0CRIMA",31,0) 115986 ; 5. ARE ACTORS IDENTIFIED REGARDING THEIR ROLE116088 ; SINCE THESE MEASUREMENTS ARE DONE AT THE VARIABLE LEVEL, THEY 115987 116089 "RTN","C0CRIMA",32,0) 115988 ; .. AND OTHER FACTORS YET TO BE DETERMINED116090 ; REFLECT ON RIM COHERENCE WHETHER THE CCR OR THE CCD IS USED FOR 115989 116091 "RTN","C0CRIMA",33,0) 115990 ; 116092 ; CONVEYANCE TO THE RIM APPLICATION. 115991 116093 "RTN","C0CRIMA",34,0) 115992 ; SINCE THESE MEASUREMENTS ARE DONE AT THE VARIABLE LEVEL, THEY116094 ; 115993 116095 "RTN","C0CRIMA",35,0) 115994 ; REFLECT ON RIM COHERENCE WHETHER THE CCR OR THE CCD IS USED FOR116096 ; 115995 116097 "RTN","C0CRIMA",36,0) 115996 ; CONVEYANCE TO THE RIM APPLICATION. 116098 ANALYZE(BEGDFN,DFNCNT,APARMS) ; RIM COHERANCE ANALYSIS ROUTINE 115997 116099 "RTN","C0CRIMA",37,0) 115998 ;116100 ; BEGINS AT BEGDFN AND GOES FOR DFNCNT PATIENTS 115999 116101 "RTN","C0CRIMA",38,0) 116000 ;116102 ; TO RESUME AT NEXT PATIENT, USE BEGDFN="" 116001 116103 "RTN","C0CRIMA",39,0) 116002 ANALYZE(BEGDFN,DFNCNT,APARMS) ; RIM COHERANCE ANALYSIS ROUTINE 116104 ; USE RESET^C0CRIMA TO RESET TO TOP OF PATIENT LIST 116003 116105 "RTN","C0CRIMA",40,0) 116004 ; BEGINS AT BEGDFN AND GOES FOR DFNCNT PATIENTS116106 ; APARMS ARE PARAMETERS TO BE USED IN THE EXTRACTION 116005 116107 "RTN","C0CRIMA",41,0) 116006 ; TO RESUME AT NEXT PATIENT, USE BEGDFN=""116108 ; SEE C0CPARMS FOR SUPPORTED PARAMTERS 116007 116109 "RTN","C0CRIMA",42,0) 116008 ; USE RESET^C0CRIMA TO RESET TO TOP OF PATIENT LIST116110 ; 116009 116111 "RTN","C0CRIMA",43,0) 116010 ; APARMS ARE PARAMETERS TO BE USED IN THE EXTRACTION116112 N RIMARY,RIMTMP,RIMI,RIMDFN,RATTR 116011 116113 "RTN","C0CRIMA",44,0) 116012 ; SEE C0CPARMS FOR SUPPORTED PARAMTERS116114 N CCRGLO 116013 116115 "RTN","C0CRIMA",45,0) 116014 ;116116 S C0CCHK=0 ; CHECKSUM FLAG 116015 116117 "RTN","C0CRIMA",46,0) 116016 N RIMARY,RIMTMP,RIMI,RIMDFN,RATTR116118 D ASETUP ; SET UP VARIABLES AND GLOBALS 116017 116119 "RTN","C0CRIMA",47,0) 116018 N CCRGLO116120 D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE 116019 116121 "RTN","C0CRIMA",48,0) 116020 S C0CCHK=0 ; CHECKSUM FLAG116122 I '$D(@RIMBASE@("RESUME")) S @RIMBASE@("RESUME")=$O(^DPT(0)) ; FIRST TIME 116021 116123 "RTN","C0CRIMA",49,0) 116022 D ASETUP ; SET UP VARIABLES AND GLOBALS116124 S RESUME=@RIMBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN 116023 116125 "RTN","C0CRIMA",50,0) 116024 D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE116126 S RIMDFN=BEGDFN ; BEGIN WITH THE BEGDFN PATIENT 116025 116127 "RTN","C0CRIMA",51,0) 116026 I '$D(@RIMBASE@("RESUME")) S @RIMBASE@("RESUME")=$O(^DPT(0)) ; FIRST TIME116128 I RIMDFN="" S RIMDFN=RESUME 116027 116129 "RTN","C0CRIMA",52,0) 116028 S RESUME=@RIMBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN116130 I +RIMDFN=0 D Q ; AT THE END OF THE PATIENTS 116029 116131 "RTN","C0CRIMA",53,0) 116030 S RIMDFN=BEGDFN ; BEGIN WITH THE BEGDFN PATIENT116132 . W "END OF PATIENT LIST, CALL RESET^C0CRIMA",! 116031 116133 "RTN","C0CRIMA",54,0) 116032 I RIMDFN="" S RIMDFN=RESUME116134 I '$D(APARMS) S APARMS="" ; DEFAULT NO OVERRIDE PARMS 116033 116135 "RTN","C0CRIMA",55,0) 116034 I +RIMDFN=0 D Q ; AT THE END OF THE PATIENTS116136 F RIMI=1:1:DFNCNT D Q:+RIMDFN=0 ; FOR DFNCNT NUMBER OF PATIENTS OR END 116035 116137 "RTN","C0CRIMA",56,0) 116036 . W "END OF PATIENT LIST, CALL RESET^C0CRIMA",!116138 . K @RIMBASE@("VARS",RIMDFN) ; CLEAR OUT OLD VARS 116037 116139 "RTN","C0CRIMA",57,0) 116038 I '$D(APARMS) S APARMS="" ; DEFAULT NO OVERRIDE PARMS116140 . D CCRRPC^C0CCCR(.CCRGLO,RIMDFN,APARMS,"CCR") ;PROCESS THE CCR 116039 116141 "RTN","C0CRIMA",58,0) 116040 F RIMI=1:1:DFNCNT D Q:+RIMDFN=0 ; FOR DFNCNT NUMBER OF PATIENTS OR END116142 . W RIMDFN,! 116041 116143 "RTN","C0CRIMA",59,0) 116042 . K @RIMBASE@("VARS",RIMDFN) ; CLEAR OUT OLD VARS116144 . ; 116043 116145 "RTN","C0CRIMA",60,0) 116044 . D CCRRPC^C0CCCR(.CCRGLO,RIMDFN,APARMS,"CCR") ;PROCESS THE CCR116146 . ; COPY ALL THE VARIABLES TO THE RIM MAP AREA INDEXED BY PATIENT 116045 116147 "RTN","C0CRIMA",61,0) 116046 . W RIMDFN,!116148 . ; 116047 116149 "RTN","C0CRIMA",62,0) 116150 . I $D(^TMP("C0CCCR",$J,"PROBVALS",1)) D ; PROBLEM VARS EXISTS 116151 "RTN","C0CRIMA",63,0) 116152 . . M @RIMBASE@("VARS",RIMDFN,"PROBLEMS")=^TMP("C0CCCR",$J,"PROBVALS") 116153 "RTN","C0CRIMA",64,0) 116154 . . S @RIMBASE@("VARS",RIMDFN,"PROBLEMS",0)=$O(^TMP("C0CCCR",$J,"PROBVALS",""),-1) 116155 "RTN","C0CRIMA",65,0) 116156 . I $D(^TMP("C0CCCR",$J,"VITALS",1)) D ; VITALS VARS EXISTS 116157 "RTN","C0CRIMA",66,0) 116158 . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("C0CCCR",$J,"VITALS") 116159 "RTN","C0CRIMA",67,0) 116160 . I $D(^TMP("C0CCCR",$J,"MEDMAP",1)) D ; MEDS VARS EXISTS 116161 "RTN","C0CRIMA",68,0) 116162 . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("C0CCCR",$J,"MEDMAP") 116163 "RTN","C0CRIMA",69,0) 116164 . I $D(^TMP("C0CCCR",$J,"ALERTS",1,"ALERTOBJECTID")) D ; ALERTS EXIST 116165 "RTN","C0CRIMA",70,0) 116166 . . W "FOUND ALERT VARS",! 116167 "RTN","C0CRIMA",71,0) 116168 . . M @RIMBASE@("VARS",RIMDFN,"ALERTS")=^TMP("C0CCCR",$J,"ALERTS") 116169 "RTN","C0CRIMA",72,0) 116170 . I $D(^TMP("C0CCCR",$J,"RESULTS",0)) D ; RESULTS EXIST 116171 "RTN","C0CRIMA",73,0) 116172 . . W "FOUND RESULTS VARS",! 116173 "RTN","C0CRIMA",74,0) 116174 . . M @RIMBASE@("VARS",RIMDFN,"RESULTS")=^TMP("C0CCCR",$J,"RESULTS") 116175 "RTN","C0CRIMA",75,0) 116176 . S C0CCHK=0 116177 "RTN","C0CRIMA",76,0) 116178 . I $$CHKSUM(RIMDFN) D ; CHECKSUM HAS CHANGED 116179 "RTN","C0CRIMA",77,0) 116180 . . W "CHECKSUM IS NEW OR HAS CHANGED",! 116181 "RTN","C0CRIMA",78,0) 116182 . . ;ZWR ^TMP("C0CRIM","CHKSUM",RIMDFN,*) 116183 "RTN","C0CRIMA",79,0) 116184 . . S C0CCHK=1 116185 "RTN","C0CRIMA",80,0) 116186 . K ^TMP("C0CCCR",$J) ; KILL WORK AREA FOR CCR BUILDING 116187 "RTN","C0CRIMA",81,0) 116048 116188 . ; 116049 "RTN","C0CRIMA", 63,0)116050 . ; COPY ALL THE VARIABLES TO THE RIM MAP AREA INDEXED BY PATIENT116051 "RTN","C0CRIMA", 64,0)116189 "RTN","C0CRIMA",82,0) 116190 . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP 116191 "RTN","C0CRIMA",83,0) 116052 116192 . ; 116053 "RTN","C0CRIMA",65,0)116054 . I $D(^TMP("C0CCCR",$J,"PROBVALS",1)) D ; PROBLEM VARS EXISTS116055 "RTN","C0CRIMA",66,0)116056 . . M @RIMBASE@("VARS",RIMDFN,"PROBLEMS")=^TMP("C0CCCR",$J,"PROBVALS")116057 "RTN","C0CRIMA",67,0)116058 . . S @RIMBASE@("VARS",RIMDFN,"PROBLEMS",0)=$O(^TMP("C0CCCR",$J,"PROBVALS",""),-1)116059 "RTN","C0CRIMA",68,0)116060 . I $D(^TMP("C0CCCR",$J,"VITALS",1)) D ; VITALS VARS EXISTS116061 "RTN","C0CRIMA",69,0)116062 . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("C0CCCR",$J,"VITALS")116063 "RTN","C0CRIMA",70,0)116064 . I $D(^TMP("C0CCCR",$J,"MEDMAP",1)) D ; MEDS VARS EXISTS116065 "RTN","C0CRIMA",71,0)116066 . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("C0CCCR",$J,"MEDMAP")116067 "RTN","C0CRIMA",72,0)116068 . I $D(^TMP("C0CCCR",$J,"ALERTS",1,"ALERTOBJECTID")) D ; ALERTS EXIST116069 "RTN","C0CRIMA",73,0)116070 . . W "FOUND ALERT VARS",!116071 "RTN","C0CRIMA",74,0)116072 . . M @RIMBASE@("VARS",RIMDFN,"ALERTS")=^TMP("C0CCCR",$J,"ALERTS")116073 "RTN","C0CRIMA",75,0)116074 . I $D(^TMP("C0CCCR",$J,"RESULTS",0)) D ; RESULTS EXIST116075 "RTN","C0CRIMA",76,0)116076 . . W "FOUND RESULTS VARS",!116077 "RTN","C0CRIMA",77,0)116078 . . M @RIMBASE@("VARS",RIMDFN,"RESULTS")=^TMP("C0CCCR",$J,"RESULTS")116079 "RTN","C0CRIMA",78,0)116080 . S C0CCHK=0116081 "RTN","C0CRIMA",79,0)116082 . I $$CHKSUM(RIMDFN) D ; CHECKSUM HAS CHANGED116083 "RTN","C0CRIMA",80,0)116084 . . W "CHECKSUM IS NEW OR HAS CHANGED",!116085 "RTN","C0CRIMA",81,0)116086 . . ;ZWR ^TMP("C0CRIM","CHKSUM",RIMDFN,*)116087 "RTN","C0CRIMA",82,0)116088 . . S C0CCHK=1116089 "RTN","C0CRIMA",83,0)116090 . K ^TMP("C0CCCR",$J) ; KILL WORK AREA FOR CCR BUILDING116091 116193 "RTN","C0CRIMA",84,0) 116092 . ;116194 . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS 116093 116195 "RTN","C0CRIMA",85,0) 116094 . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP116196 . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT 116095 116197 "RTN","C0CRIMA",86,0) 116096 116198 . ; 116097 116199 "RTN","C0CRIMA",87,0) 116098 . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS116200 . ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL 116099 116201 "RTN","C0CRIMA",88,0) 116100 . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT116202 . ; 116101 116203 "RTN","C0CRIMA",89,0) 116204 . ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D ; IF FIRST PAT WITH THESE ATTRS 116205 "RTN","C0CRIMA",90,0) 116206 . ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED 116207 "RTN","C0CRIMA",91,0) 116208 . ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT 116209 "RTN","C0CRIMA",92,0) 116102 116210 . ; 116103 "RTN","C0CRIMA",90,0) 116104 . ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL 116105 "RTN","C0CRIMA",91,0) 116211 "RTN","C0CRIMA",93,0) 116212 . N CATNAME,CATTBL 116213 "RTN","C0CRIMA",94,0) 116214 . ; S CATBASE=$NA(@RIMBASE@("ANALYSIS")) 116215 "RTN","C0CRIMA",95,0) 116216 . S CATNAME="" 116217 "RTN","C0CRIMA",96,0) 116218 . D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY 116219 "RTN","C0CRIMA",97,0) 116220 . W "CATEGORY NAME: ",CATNAME,! 116221 "RTN","C0CRIMA",98,0) 116106 116222 . ; 116107 "RTN","C0CRIMA",92,0)116108 . ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D ; IF FIRST PAT WITH THESE ATTRS116109 "RTN","C0CRIMA",93,0)116110 . ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED116111 "RTN","C0CRIMA",94,0)116112 . ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT116113 "RTN","C0CRIMA",95,0)116114 . ;116115 "RTN","C0CRIMA",96,0)116116 . N CATNAME,CATTBL116117 "RTN","C0CRIMA",97,0)116118 . ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))116119 "RTN","C0CRIMA",98,0)116120 . S CATNAME=""116121 116223 "RTN","C0CRIMA",99,0) 116122 . D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY116224 . F S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^C0CSYS(RIMDFN) ; NEXT PATIENT 116123 116225 "RTN","C0CRIMA",100,0) 116124 . W "CATEGORY NAME: ",CATNAME,!116226 . ; PTST TESTS TO SEE IF PATIENT WAS MERGED 116125 116227 "RTN","C0CRIMA",101,0) 116126 . ; 116228 . ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT 116127 116229 "RTN","C0CRIMA",102,0) 116128 . F S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^C0CSYS(RIMDFN) ; NEXT PATIENT116230 . ; AND WE SKIP IT 116129 116231 "RTN","C0CRIMA",103,0) 116130 . ; PTST TESTS TO SEE IF PATIENT WAS MERGED116232 . S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN 116131 116233 "RTN","C0CRIMA",104,0) 116132 . ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT116234 ; D PARY^C0CXPATH(@RIMBASE@("ATTRTBL")) 116133 116235 "RTN","C0CRIMA",105,0) 116134 . ; AND WE SKIP IT116236 Q 116135 116237 "RTN","C0CRIMA",106,0) 116136 . S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN116238 ; 116137 116239 "RTN","C0CRIMA",107,0) 116138 ; D PARY^C0CXPATH(@RIMBASE@("ATTRTBL")) 116240 SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS 116139 116241 "RTN","C0CRIMA",108,0) 116242 N SBASE,SATTR 116243 "RTN","C0CRIMA",109,0) 116244 S SBASE=$NA(@RIMBASE@("VARS",SDFN)) 116245 "RTN","C0CRIMA",110,0) 116246 D APOST("SATTR","RIMTBL","HEADER") 116247 "RTN","C0CRIMA",111,0) 116248 I $D(@SBASE@("PROBLEMS",1)) D ; 116249 "RTN","C0CRIMA",112,0) 116250 . D APOST("SATTR","RIMTBL","PROBLEMS") 116251 "RTN","C0CRIMA",113,0) 116252 . ; W "POSTING PROBLEMS",! 116253 "RTN","C0CRIMA",114,0) 116254 I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS") 116255 "RTN","C0CRIMA",115,0) 116256 I $D(@SBASE@("IMMUNE",1)) D ;IMMUNIZATIONS PRESENT 116257 "RTN","C0CRIMA",116,0) 116258 . D APOST("SATTR","RIMTBL","IMMUNE") 116259 "RTN","C0CRIMA",117,0) 116260 . N ZR,ZI 116261 "RTN","C0CRIMA",118,0) 116262 . D GETPA(.ZR,SDFN,"IMMUNE","IMMUNEPRODUCTCODE") 116263 "RTN","C0CRIMA",119,0) 116264 . I ZR(0)>0 D APOST("SATTR","RIMTBL","IMMUNECODE") ;IMMUNIZATION CODES 116265 "RTN","C0CRIMA",120,0) 116266 I $D(@SBASE@("MEDS",1)) D ; IF THE PATIENT HAS MEDS VARIABLES 116267 "RTN","C0CRIMA",121,0) 116268 . D APOST("SATTR","RIMTBL","MEDS") 116269 "RTN","C0CRIMA",122,0) 116270 . N ZR,ZI 116271 "RTN","C0CRIMA",123,0) 116272 . D GETPA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES 116273 "RTN","C0CRIMA",124,0) 116274 . I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN 116275 "RTN","C0CRIMA",125,0) 116276 . . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS 116277 "RTN","C0CRIMA",126,0) 116278 . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","MEDSCODE") ;CODES 116279 "RTN","C0CRIMA",127,0) 116280 . ; D PATD^C0CRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES 116281 "RTN","C0CRIMA",128,0) 116282 I $D(@SBASE@("ALERTS",1)) D ; IF THE PATIENT HAS ALERTS 116283 "RTN","C0CRIMA",129,0) 116284 . D APOST("SATTR","RIMTBL","ALERTS") 116285 "RTN","C0CRIMA",130,0) 116286 . N ZR,ZI 116287 "RTN","C0CRIMA",131,0) 116288 . D GETPA(.ZR,SDFN,"ALERTS","ALERTAGENTPRODUCTCODEVALUE") ;REACTANT CODES 116289 "RTN","C0CRIMA",132,0) 116290 . I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN 116291 "RTN","C0CRIMA",133,0) 116292 . . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS 116293 "RTN","C0CRIMA",134,0) 116294 . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","ALERTSCODE") ;CODES 116295 "RTN","C0CRIMA",135,0) 116296 I $D(@SBASE@("RESULTS",1)) D ; IF THE PATIENT HAS LABS VARIABLES 116297 "RTN","C0CRIMA",136,0) 116298 . D APOST("SATTR","RIMTBL","RESULTS") 116299 "RTN","C0CRIMA",137,0) 116300 . N ZR,ZI 116301 "RTN","C0CRIMA",138,0) 116302 . S ZR(0)=0 ; INITIALIZE TO NONE 116303 "RTN","C0CRIMA",139,0) 116304 . D RPCGV(.ZR,SDFN,"RESULTS") ;CHECK FOR LABS CODES 116305 "RTN","C0CRIMA",140,0) 116306 . ; D PARY^C0CXPATH("ZR") ; 116307 "RTN","C0CRIMA",141,0) 116308 . I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN 116309 "RTN","C0CRIMA",142,0) 116310 . . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS 116311 "RTN","C0CRIMA",143,0) 116312 . . . I $P(ZR(ZI),"^",2)="RESULTTESTCODINGSYSTEM" D ; LOINC CODE CHECK 116313 "RTN","C0CRIMA",144,0) 116314 . . . . I $P(ZR(ZI),"^",3)="LOINC" D APOST("SATTR","RIMTBL","RESULTSLN") ; 116315 "RTN","C0CRIMA",145,0) 116316 ; D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED 116317 "RTN","C0CRIMA",146,0) 116318 I $D(@SBASE@("PROCEDURES",1)) D ; 116319 "RTN","C0CRIMA",147,0) 116320 . D APOST("SATTR","RIMTBL","PROCEDURES") 116321 "RTN","C0CRIMA",148,0) 116322 W "ATTRIBUTES: ",SATTR,! 116323 "RTN","C0CRIMA",149,0) 116324 Q SATTR 116325 "RTN","C0CRIMA",150,0) 116326 ; 116327 "RTN","C0CRIMA",151,0) 116328 RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES 116329 "RTN","C0CRIMA",152,0) 116330 K ^TMP("C0CRIM","RESUME") 116331 "RTN","C0CRIMA",153,0) 116332 K ^TMP("C0CRIM") 116333 "RTN","C0CRIMA",154,0) 116140 116334 Q 116141 "RTN","C0CRIMA",1 09,0)116335 "RTN","C0CRIMA",155,0) 116142 116336 ; 116143 "RTN","C0CRIMA",110,0) 116144 SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS 116145 "RTN","C0CRIMA",111,0) 116146 N SBASE,SATTR 116147 "RTN","C0CRIMA",112,0) 116148 S SBASE=$NA(@RIMBASE@("VARS",SDFN)) 116149 "RTN","C0CRIMA",113,0) 116150 D APOST("SATTR","RIMTBL","HEADER") 116151 "RTN","C0CRIMA",114,0) 116152 I $D(@SBASE@("PROBLEMS",1)) D ; 116153 "RTN","C0CRIMA",115,0) 116154 . D APOST("SATTR","RIMTBL","PROBLEMS") 116155 "RTN","C0CRIMA",116,0) 116156 . ; W "POSTING PROBLEMS",! 116157 "RTN","C0CRIMA",117,0) 116158 I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS") 116159 "RTN","C0CRIMA",118,0) 116160 I $D(@SBASE@("IMMUNE",1)) D ;IMMUNIZATIONS PRESENT 116161 "RTN","C0CRIMA",119,0) 116162 . D APOST("SATTR","RIMTBL","IMMUNE") 116163 "RTN","C0CRIMA",120,0) 116164 . N ZR,ZI 116165 "RTN","C0CRIMA",121,0) 116166 . D GETPA(.ZR,SDFN,"IMMUNE","IMMUNEPRODUCTCODE") 116167 "RTN","C0CRIMA",122,0) 116168 . I ZR(0)>0 D APOST("SATTR","RIMTBL","IMMUNECODE") ;IMMUNIZATION CODES 116169 "RTN","C0CRIMA",123,0) 116170 I $D(@SBASE@("MEDS",1)) D ; IF THE PATIENT HAS MEDS VARIABLES 116171 "RTN","C0CRIMA",124,0) 116172 . D APOST("SATTR","RIMTBL","MEDS") 116173 "RTN","C0CRIMA",125,0) 116174 . N ZR,ZI 116175 "RTN","C0CRIMA",126,0) 116176 . D GETPA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES 116177 "RTN","C0CRIMA",127,0) 116178 . I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN 116179 "RTN","C0CRIMA",128,0) 116180 . . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS 116181 "RTN","C0CRIMA",129,0) 116182 . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","MEDSCODE") ;CODES 116183 "RTN","C0CRIMA",130,0) 116184 . ; D PATD^C0CRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES 116185 "RTN","C0CRIMA",131,0) 116186 I $D(@SBASE@("ALERTS",1)) D ; IF THE PATIENT HAS ALERTS 116187 "RTN","C0CRIMA",132,0) 116188 . D APOST("SATTR","RIMTBL","ALERTS") 116189 "RTN","C0CRIMA",133,0) 116190 . N ZR,ZI 116191 "RTN","C0CRIMA",134,0) 116192 . D GETPA(.ZR,SDFN,"ALERTS","ALERTAGENTPRODUCTCODEVALUE") ;REACTANT CODES 116193 "RTN","C0CRIMA",135,0) 116194 . I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN 116195 "RTN","C0CRIMA",136,0) 116196 . . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS 116197 "RTN","C0CRIMA",137,0) 116198 . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","ALERTSCODE") ;CODES 116199 "RTN","C0CRIMA",138,0) 116200 I $D(@SBASE@("RESULTS",1)) D ; IF THE PATIENT HAS LABS VARIABLES 116201 "RTN","C0CRIMA",139,0) 116202 . D APOST("SATTR","RIMTBL","RESULTS") 116203 "RTN","C0CRIMA",140,0) 116204 . N ZR,ZI 116205 "RTN","C0CRIMA",141,0) 116206 . S ZR(0)=0 ; INITIALIZE TO NONE 116207 "RTN","C0CRIMA",142,0) 116208 . D RPCGV(.ZR,SDFN,"RESULTS") ;CHECK FOR LABS CODES 116209 "RTN","C0CRIMA",143,0) 116210 . ; D PARY^C0CXPATH("ZR") ; 116211 "RTN","C0CRIMA",144,0) 116212 . I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN 116213 "RTN","C0CRIMA",145,0) 116214 . . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS 116215 "RTN","C0CRIMA",146,0) 116216 . . . I $P(ZR(ZI),"^",2)="RESULTTESTCODINGSYSTEM" D ; LOINC CODE CHECK 116217 "RTN","C0CRIMA",147,0) 116218 . . . . I $P(ZR(ZI),"^",3)="LOINC" D APOST("SATTR","RIMTBL","RESULTSLN") ; 116219 "RTN","C0CRIMA",148,0) 116220 ; D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED 116221 "RTN","C0CRIMA",149,0) 116222 I $D(@SBASE@("PROCEDURES",1)) D ; 116223 "RTN","C0CRIMA",150,0) 116224 . D APOST("SATTR","RIMTBL","PROCEDURES") 116225 "RTN","C0CRIMA",151,0) 116226 W "ATTRIBUTES: ",SATTR,! 116227 "RTN","C0CRIMA",152,0) 116228 Q SATTR 116229 "RTN","C0CRIMA",153,0) 116337 "RTN","C0CRIMA",156,0) 116338 CLIST ; LIST THE CATEGORIES 116339 "RTN","C0CRIMA",157,0) 116230 116340 ; 116231 "RTN","C0CRIMA",154,0) 116232 RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES 116233 "RTN","C0CRIMA",155,0) 116234 K ^TMP("C0CRIM","RESUME") 116235 "RTN","C0CRIMA",156,0) 116236 K ^TMP("C0CRIM") 116237 "RTN","C0CRIMA",157,0) 116341 "RTN","C0CRIMA",158,0) 116342 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS 116343 "RTN","C0CRIMA",159,0) 116344 N CLBASE,CLNUM,ZI,CLIDX 116345 "RTN","C0CRIMA",160,0) 116346 S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS")) 116347 "RTN","C0CRIMA",161,0) 116348 S CLNUM=@CLBASE@(0) 116349 "RTN","C0CRIMA",162,0) 116350 F ZI=1:1:CLNUM D ; LOOP THROUGH THE CATEGORIES 116351 "RTN","C0CRIMA",163,0) 116352 . S CLIDX=@CLBASE@(ZI) 116353 "RTN","C0CRIMA",164,0) 116354 . W "(",$P(@CLBASE@(CLIDX),"^",1) 116355 "RTN","C0CRIMA",165,0) 116356 . W ":",$P(@CLBASE@(CLIDX),"^",2),") " 116357 "RTN","C0CRIMA",166,0) 116358 . W CLIDX,! 116359 "RTN","C0CRIMA",167,0) 116360 ; D PARY^C0CXPATH(CLBASE) 116361 "RTN","C0CRIMA",168,0) 116238 116362 Q 116239 "RTN","C0CRIMA",1 58,0)116363 "RTN","C0CRIMA",169,0) 116240 116364 ; 116241 "RTN","C0CRIMA",159,0) 116242 CLIST ; LIST THE CATEGORIES 116243 "RTN","C0CRIMA",160,0) 116365 "RTN","C0CRIMA",170,0) 116366 CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES 116367 "RTN","C0CRIMA",171,0) 116368 ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT 116369 "RTN","C0CRIMA",172,0) 116370 ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE 116371 "RTN","C0CRIMA",173,0) 116372 ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME 116373 "RTN","C0CRIMA",174,0) 116374 ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES, 116375 "RTN","C0CRIMA",175,0) 116376 ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X" 116377 "RTN","C0CRIMA",176,0) 116378 ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES 116379 "RTN","C0CRIMA",177,0) 116380 ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY 116381 "RTN","C0CRIMA",178,0) 116382 ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING 116383 "RTN","C0CRIMA",179,0) 116384 ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY 116385 "RTN","C0CRIMA",180,0) 116386 ; NUMBER IE CTBL_X(CDFN)="" 116387 "RTN","C0CRIMA",181,0) 116244 116388 ; 116245 "RTN","C0CRIMA",161,0) 116389 "RTN","C0CRIMA",182,0) 116390 ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST 116391 "RTN","C0CRIMA",183,0) 116392 S CCTBL=$NA(@CBASE@(CTBL,"CATS")) 116393 "RTN","C0CRIMA",184,0) 116394 W "CBASE: ",CCTBL,! 116395 "RTN","C0CRIMA",185,0) 116396 ; 116397 "RTN","C0CRIMA",186,0) 116398 I '$D(@CCTBL@(CATTR)) D ; FIRST PATIENT IN THIS CATEGORY 116399 "RTN","C0CRIMA",187,0) 116400 . D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY 116401 "RTN","C0CRIMA",188,0) 116402 . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY 116403 "RTN","C0CRIMA",189,0) 116404 . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT 116405 "RTN","C0CRIMA",190,0) 116406 . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY 116407 "RTN","C0CRIMA",191,0) 116408 . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME 116409 "RTN","C0CRIMA",192,0) 116410 . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0 116411 "RTN","C0CRIMA",193,0) 116412 ; 116413 "RTN","C0CRIMA",194,0) 116414 S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY 116415 "RTN","C0CRIMA",195,0) 116416 S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT 116417 "RTN","C0CRIMA",196,0) 116418 S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK 116419 "RTN","C0CRIMA",197,0) 116420 ; 116421 "RTN","C0CRIMA",198,0) 116422 S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED 116423 "RTN","C0CRIMA",199,0) 116424 ; 116425 "RTN","C0CRIMA",200,0) 116426 S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT 116427 "RTN","C0CRIMA",201,0) 116428 W "PATS BASE: ",CPATLIST,! 116429 "RTN","C0CRIMA",202,0) 116430 S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST 116431 "RTN","C0CRIMA",203,0) 116432 ; 116433 "RTN","C0CRIMA",204,0) 116434 Q 116435 "RTN","C0CRIMA",205,0) 116436 ; 116437 "RTN","C0CRIMA",206,0) 116438 CHKSUM(CKDFN) ; DOES A CHECKSUM AND STORES IT IN MUMPS GLOBALS 116439 "RTN","C0CRIMA",207,0) 116440 ; 116441 "RTN","C0CRIMA",208,0) 116442 S C0CCKB=$NA(^TMP("C0CRIM","CHKSUM")) ;CHECKSUM BASE 116443 "RTN","C0CRIMA",209,0) 116444 S C0CGLB=$NA(^TMP("C0CRIM","VARS")) ;CCR VARIABLE BASE 116445 "RTN","C0CRIMA",210,0) 116446 S C0CI="" 116447 "RTN","C0CRIMA",211,0) 116448 F S C0CI=$O(@C0CGLB@(CKDFN,C0CI)) Q:C0CI="" D ;FOR EACH DOMAIN 116449 "RTN","C0CRIMA",212,0) 116450 . ;W "DFN:",CKDFN," DOMAIN:",C0CI,! 116451 "RTN","C0CRIMA",213,0) 116452 . S C0CJ=$NA(@C0CGLB@(CKDFN,C0CI)) 116453 "RTN","C0CRIMA",214,0) 116454 . I C0CI="HEADER" D ; HAVE TO TAKE OUT THE "DATE GENERATED" 116455 "RTN","C0CRIMA",215,0) 116456 . . S C0CDT=@C0CGLB@(CKDFN,C0CI,1,"DATETIME") 116457 "RTN","C0CRIMA",216,0) 116458 . . K @C0CGLB@(CKDFN,C0CI,1,"DATETIME") 116459 "RTN","C0CRIMA",217,0) 116460 . S C0CCK(C0CI)=$$CHKSUM^XUSESIG1(C0CJ) 116461 "RTN","C0CRIMA",218,0) 116462 . I C0CI="HEADER" D ; PUT IT BACK 116463 "RTN","C0CRIMA",219,0) 116464 . . S @C0CGLB@(CKDFN,C0CI,1,"DATETIME")=C0CDT 116465 "RTN","C0CRIMA",220,0) 116466 S C0CK="C0CCK" ; 116467 "RTN","C0CRIMA",221,0) 116468 S C0CALL=$$CHKSUM^XUSESIG1(C0CK) ;CHECKSUM OF ALL DOMAIN CHECKSUMS 116469 "RTN","C0CRIMA",222,0) 116470 S CHKR=0 ; RESULT DEFAULT 116471 "RTN","C0CRIMA",223,0) 116472 I $D(^TMP("C0CRIM","CHKSUM",CKDFN,"ALL")) D ; OLD CHECKSUM EXISTS 116473 "RTN","C0CRIMA",224,0) 116474 . I @C0CCKB@(CKDFN,"ALL")'=C0CALL S CHKR=1 116475 "RTN","C0CRIMA",225,0) 116476 E S CHKR=1 ;CHECKSUM IS NEW 116477 "RTN","C0CRIMA",226,0) 116478 S @C0CCKB@(CKDFN,"ALL")=C0CALL 116479 "RTN","C0CRIMA",227,0) 116480 M @C0CCKB@(CKDFN,"DOMAIN")=C0CCK 116481 "RTN","C0CRIMA",228,0) 116482 ;ZWR ^TMP("C0CRIM","CHKSUM",CKDFN,*) 116483 "RTN","C0CRIMA",229,0) 116484 Q CHKR 116485 "RTN","C0CRIMA",230,0) 116486 ; 116487 "RTN","C0CRIMA",231,0) 116488 CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE 116489 "RTN","C0CRIMA",232,0) 116490 ; 116491 "RTN","C0CRIMA",233,0) 116246 116492 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS 116247 "RTN","C0CRIMA",162,0) 116248 N CLBASE,CLNUM,ZI,CLIDX 116249 "RTN","C0CRIMA",163,0) 116250 S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS")) 116251 "RTN","C0CRIMA",164,0) 116252 S CLNUM=@CLBASE@(0) 116253 "RTN","C0CRIMA",165,0) 116254 F ZI=1:1:CLNUM D ; LOOP THROUGH THE CATEGORIES 116255 "RTN","C0CRIMA",166,0) 116256 . S CLIDX=@CLBASE@(ZI) 116257 "RTN","C0CRIMA",167,0) 116258 . W "(",$P(@CLBASE@(CLIDX),"^",1) 116259 "RTN","C0CRIMA",168,0) 116260 . W ":",$P(@CLBASE@(CLIDX),"^",2),") " 116261 "RTN","C0CRIMA",169,0) 116262 . W CLIDX,! 116263 "RTN","C0CRIMA",170,0) 116264 ; D PARY^C0CXPATH(CLBASE) 116265 "RTN","C0CRIMA",171,0) 116493 "RTN","C0CRIMA",234,0) 116494 N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT 116495 "RTN","C0CRIMA",235,0) 116496 S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES 116497 "RTN","C0CRIMA",236,0) 116498 S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS 116499 "RTN","C0CRIMA",237,0) 116500 S ZTOT=0 ; INITIALIZE OVERALL TOTAL 116501 "RTN","C0CRIMA",238,0) 116502 F ZI=1:1:@ZCBASE@(0) D ; FOR ALL CATS 116503 "RTN","C0CRIMA",239,0) 116504 . S ZCNT=0 116505 "RTN","C0CRIMA",240,0) 116506 . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY 116507 "RTN","C0CRIMA",241,0) 116508 . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME 116509 "RTN","C0CRIMA",242,0) 116510 . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST 116511 "RTN","C0CRIMA",243,0) 116512 . ; F ZJ=0:0 D Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS 116513 "RTN","C0CRIMA",244,0) 116514 . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT 116515 "RTN","C0CRIMA",245,0) 116516 . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,! 116517 "RTN","C0CRIMA",246,0) 116518 . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX)) 116519 "RTN","C0CRIMA",247,0) 116520 . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT))) 116521 "RTN","C0CRIMA",248,0) 116522 . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD 116523 "RTN","C0CRIMA",249,0) 116524 . S ZTOT=ZTOT+ZCNT 116525 "RTN","C0CRIMA",250,0) 116526 W "TOTAL: ",ZTOT,! 116527 "RTN","C0CRIMA",251,0) 116266 116528 Q 116267 "RTN","C0CRIMA", 172,0)116529 "RTN","C0CRIMA",252,0) 116268 116530 ; 116269 "RTN","C0CRIMA", 173,0)116270 C PUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES116271 "RTN","C0CRIMA", 174,0)116272 ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT116273 "RTN","C0CRIMA", 175,0)116274 ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE116275 "RTN","C0CRIMA", 176,0)116276 ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME116277 "RTN","C0CRIMA", 177,0)116278 ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,116279 "RTN","C0CRIMA", 178,0)116280 ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"116281 "RTN","C0CRIMA", 179,0)116282 ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES116283 "RTN","C0CRIMA", 180,0)116284 ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY116285 "RTN","C0CRIMA", 181,0)116286 ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING116287 "RTN","C0CRIMA", 182,0)116288 ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY116289 "RTN","C0CRIMA", 183,0)116290 ; NUMBER IE CTBL_X(CDFN)=""116291 "RTN","C0CRIMA", 184,0)116531 "RTN","C0CRIMA",253,0) 116532 CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST 116533 "RTN","C0CRIMA",254,0) 116534 ; INLST IS PASSED BY NAME 116535 "RTN","C0CRIMA",255,0) 116536 N ZI,ZDX,ZCOUNT 116537 "RTN","C0CRIMA",256,0) 116538 W INLST,! 116539 "RTN","C0CRIMA",257,0) 116540 S ZCOUNT=0 116541 "RTN","C0CRIMA",258,0) 116542 S ZDX="" 116543 "RTN","C0CRIMA",259,0) 116544 F ZI=$O(@INLST@(ZDX)):0 D Q:$O(@INLST@(ZDX))="" ; LOOP UNTIL THE END 116545 "RTN","C0CRIMA",260,0) 116546 . S ZCOUNT=ZCOUNT+1 116547 "RTN","C0CRIMA",261,0) 116548 . S ZDX=$O(@INLST@(ZDX)) 116549 "RTN","C0CRIMA",262,0) 116550 . W "ZDX:",ZDX," ZCNT:",ZCOUNT,! 116551 "RTN","C0CRIMA",263,0) 116552 Q ZCOUNT 116553 "RTN","C0CRIMA",264,0) 116292 116554 ; 116293 "RTN","C0CRIMA",185,0) 116294 ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST 116295 "RTN","C0CRIMA",186,0) 116296 S CCTBL=$NA(@CBASE@(CTBL,"CATS")) 116297 "RTN","C0CRIMA",187,0) 116298 W "CBASE: ",CCTBL,! 116299 "RTN","C0CRIMA",188,0) 116555 "RTN","C0CRIMA",265,0) 116556 XCPAT(CPATCAT,CPATPARM) ; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT 116557 "RTN","C0CRIMA",266,0) 116300 116558 ; 116301 "RTN","C0CRIMA",189,0) 116302 I '$D(@CCTBL@(CATTR)) D ; FIRST PATIENT IN THIS CATEGORY 116303 "RTN","C0CRIMA",190,0) 116304 . D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY 116305 "RTN","C0CRIMA",191,0) 116306 . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY 116307 "RTN","C0CRIMA",192,0) 116308 . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT 116309 "RTN","C0CRIMA",193,0) 116310 . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY 116311 "RTN","C0CRIMA",194,0) 116312 . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME 116313 "RTN","C0CRIMA",195,0) 116314 . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0 116315 "RTN","C0CRIMA",196,0) 116559 "RTN","C0CRIMA",267,0) 116560 I '$D(CPATPARM) S CPATPARM="" 116561 "RTN","C0CRIMA",268,0) 116562 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS 116563 "RTN","C0CRIMA",269,0) 116564 N ZI,ZJ,ZC,ZPATBASE 116565 "RTN","C0CRIMA",270,0) 116566 S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT)) 116567 "RTN","C0CRIMA",271,0) 116568 S ZI="" 116569 "RTN","C0CRIMA",272,0) 116570 F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END 116571 "RTN","C0CRIMA",273,0) 116572 . S ZI=$O(@ZPATBASE@(ZI)) 116573 "RTN","C0CRIMA",274,0) 116574 . D XPAT^C0CCCR(ZI,CPATPARM) ; EXPORT THE PATIENT TO A FILE 116575 "RTN","C0CRIMA",275,0) 116576 Q 116577 "RTN","C0CRIMA",276,0) 116316 116578 ; 116317 "RTN","C0CRIMA",197,0) 116318 S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY 116319 "RTN","C0CRIMA",198,0) 116320 S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT 116321 "RTN","C0CRIMA",199,0) 116322 S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK 116323 "RTN","C0CRIMA",200,0) 116579 "RTN","C0CRIMA",277,0) 116580 CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT 116581 "RTN","C0CRIMA",278,0) 116324 116582 ; 116325 "RTN","C0CRIMA",201,0) 116326 S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED 116327 "RTN","C0CRIMA",202,0) 116583 "RTN","C0CRIMA",279,0) 116584 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS 116585 "RTN","C0CRIMA",280,0) 116586 N ZI,ZJ,ZC,ZPATBASE 116587 "RTN","C0CRIMA",281,0) 116588 S ZC=0 ; COUNT FOR SPACING THE PRINTOUT 116589 "RTN","C0CRIMA",282,0) 116590 S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT)) 116591 "RTN","C0CRIMA",283,0) 116592 S ZI="" 116593 "RTN","C0CRIMA",284,0) 116594 F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END 116595 "RTN","C0CRIMA",285,0) 116596 . S ZI=$O(@ZPATBASE@(ZI)) 116597 "RTN","C0CRIMA",286,0) 116598 . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT 116599 "RTN","C0CRIMA",287,0) 116600 . W ZI," " 116601 "RTN","C0CRIMA",288,0) 116602 . I ZC=10 D ; NEW LINE 116603 "RTN","C0CRIMA",289,0) 116604 . . S ZC=0 116605 "RTN","C0CRIMA",290,0) 116606 . . W ! 116607 "RTN","C0CRIMA",291,0) 116608 Q 116609 "RTN","C0CRIMA",292,0) 116328 116610 ; 116329 "RTN","C0CRIMA",203,0) 116330 S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT 116331 "RTN","C0CRIMA",204,0) 116332 W "PATS BASE: ",CPATLIST,! 116333 "RTN","C0CRIMA",205,0) 116334 S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST 116335 "RTN","C0CRIMA",206,0) 116611 "RTN","C0CRIMA",293,0) 116612 PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT 116613 "RTN","C0CRIMA",294,0) 116336 116614 ; 116337 "RTN","C0CRIMA",207,0) 116615 "RTN","C0CRIMA",295,0) 116616 N ATTR S ATTR="" 116617 "RTN","C0CRIMA",296,0) 116618 I '$D(^TMP("C0CRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT 116619 "RTN","C0CRIMA",297,0) 116620 . D ANALYZE(DFN,1) ; EXTRACT THE RIM VARIABLE FOR THIS PATIENT 116621 "RTN","C0CRIMA",298,0) 116622 S ATTR=^TMP("C0CRIM","ATTR",DFN) 116623 "RTN","C0CRIMA",299,0) 116624 I ATTR="" W "THIS PATIENT NOT ANALYZED.",! Q ;NO ATTRIBUTES FOUND 116625 "RTN","C0CRIMA",300,0) 116626 I $D(^TMP("C0CRIM","RIMTBL","CATS",ATTR)) D ; FOUND A CAT 116627 "RTN","C0CRIMA",301,0) 116628 . N CAT 116629 "RTN","C0CRIMA",302,0) 116630 . S CAT=$P(^TMP("C0CRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT 116631 "RTN","C0CRIMA",303,0) 116632 . W CAT,": ",ATTR,! 116633 "RTN","C0CRIMA",304,0) 116338 116634 Q 116339 "RTN","C0CRIMA", 208,0)116635 "RTN","C0CRIMA",305,0) 116340 116636 ; 116341 "RTN","C0CRIMA",209,0) 116342 CHKSUM(CKDFN) ; DOES A CHECKSUM AND STORES IT IN MUMPS GLOBALS 116343 "RTN","C0CRIMA",210,0) 116344 ; 116345 "RTN","C0CRIMA",211,0) 116346 S C0CCKB=$NA(^TMP("C0CRIM","CHKSUM")) ;CHECKSUM BASE 116347 "RTN","C0CRIMA",212,0) 116348 S C0CGLB=$NA(^TMP("C0CRIM","VARS")) ;CCR VARIABLE BASE 116349 "RTN","C0CRIMA",213,0) 116350 S C0CI="" 116351 "RTN","C0CRIMA",214,0) 116352 F S C0CI=$O(@C0CGLB@(CKDFN,C0CI)) Q:C0CI="" D ;FOR EACH DOMAIN 116353 "RTN","C0CRIMA",215,0) 116354 . ;W "DFN:",CKDFN," DOMAIN:",C0CI,! 116355 "RTN","C0CRIMA",216,0) 116356 . S C0CJ=$NA(@C0CGLB@(CKDFN,C0CI)) 116357 "RTN","C0CRIMA",217,0) 116358 . I C0CI="HEADER" D ; HAVE TO TAKE OUT THE "DATE GENERATED" 116359 "RTN","C0CRIMA",218,0) 116360 . . S C0CDT=@C0CGLB@(CKDFN,C0CI,1,"DATETIME") 116361 "RTN","C0CRIMA",219,0) 116362 . . K @C0CGLB@(CKDFN,C0CI,1,"DATETIME") 116363 "RTN","C0CRIMA",220,0) 116364 . S C0CCK(C0CI)=$$CHKSUM^XUSESIG1(C0CJ) 116365 "RTN","C0CRIMA",221,0) 116366 . I C0CI="HEADER" D ; PUT IT BACK 116367 "RTN","C0CRIMA",222,0) 116368 . . S @C0CGLB@(CKDFN,C0CI,1,"DATETIME")=C0CDT 116369 "RTN","C0CRIMA",223,0) 116370 S C0CK="C0CCK" ; 116371 "RTN","C0CRIMA",224,0) 116372 S C0CALL=$$CHKSUM^XUSESIG1(C0CK) ;CHECKSUM OF ALL DOMAIN CHECKSUMS 116373 "RTN","C0CRIMA",225,0) 116374 S CHKR=0 ; RESULT DEFAULT 116375 "RTN","C0CRIMA",226,0) 116376 I $D(^TMP("C0CRIM","CHKSUM",CKDFN,"ALL")) D ; OLD CHECKSUM EXISTS 116377 "RTN","C0CRIMA",227,0) 116378 . I @C0CCKB@(CKDFN,"ALL")'=C0CALL S CHKR=1 116379 "RTN","C0CRIMA",228,0) 116380 E S CHKR=1 ;CHECKSUM IS NEW 116381 "RTN","C0CRIMA",229,0) 116382 S @C0CCKB@(CKDFN,"ALL")=C0CALL 116383 "RTN","C0CRIMA",230,0) 116384 M @C0CCKB@(CKDFN,"DOMAIN")=C0CCK 116385 "RTN","C0CRIMA",231,0) 116386 ;ZWR ^TMP("C0CRIM","CHKSUM",CKDFN,*) 116387 "RTN","C0CRIMA",232,0) 116388 Q CHKR 116389 "RTN","C0CRIMA",233,0) 116390 ; 116391 "RTN","C0CRIMA",234,0) 116392 CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE 116393 "RTN","C0CRIMA",235,0) 116637 "RTN","C0CRIMA",306,0) 116638 APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME) 116639 "RTN","C0CRIMA",307,0) 116640 ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT 116641 "RTN","C0CRIMA",308,0) 116642 ; AND AMAP(N)=AVAL IS THE NTH AVAL 116643 "RTN","C0CRIMA",309,0) 116644 ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE 116645 "RTN","C0CRIMA",310,0) 116646 ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE 116647 "RTN","C0CRIMA",311,0) 116648 ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED 116649 "RTN","C0CRIMA",312,0) 116650 ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED 116651 "RTN","C0CRIMA",313,0) 116394 116652 ; 116395 "RTN","C0CRIMA",236,0) 116396 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS 116397 "RTN","C0CRIMA",237,0) 116398 N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT 116399 "RTN","C0CRIMA",238,0) 116653 "RTN","C0CRIMA",314,0) 116654 I '$D(@AMAP) D ; IF THE MAP DOES NOT EXIST 116655 "RTN","C0CRIMA",315,0) 116656 . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS 116657 "RTN","C0CRIMA",316,0) 116658 S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT 116659 "RTN","C0CRIMA",317,0) 116660 S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY 116661 "RTN","C0CRIMA",318,0) 116662 S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF 116663 "RTN","C0CRIMA",319,0) 116664 Q 116665 "RTN","C0CRIMA",320,0) 116666 ; 116667 "RTN","C0CRIMA",321,0) 116668 ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL 116669 "RTN","C0CRIMA",322,0) 116670 I '$D(RIMBASE) S RIMBASE=$NA(^TMP("C0CRIM")) 116671 "RTN","C0CRIMA",323,0) 116672 I '$D(@RIMBASE) S @RIMBASE="" 116673 "RTN","C0CRIMA",324,0) 116674 I '$D(RIMTBL) S RIMTBL=$NA(^TMP("C0CRIM","RIMTBL","TABLE")) ; ATTR TABLE 116675 "RTN","C0CRIMA",325,0) 116676 S ^TMP("C0CRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES 116677 "RTN","C0CRIMA",326,0) 116678 Q 116679 "RTN","C0CRIMA",327,0) 116680 ; 116681 "RTN","C0CRIMA",328,0) 116682 AINIT ; INITIALIZE ATTRIBUTE TABLE 116683 "RTN","C0CRIMA",329,0) 116684 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS 116685 "RTN","C0CRIMA",330,0) 116686 K @RIMTBL 116687 "RTN","C0CRIMA",331,0) 116688 D APUSH(RIMTBL,"EXTRACTED") 116689 "RTN","C0CRIMA",332,0) 116690 D APUSH(RIMTBL,"NOTEXTRACTED") 116691 "RTN","C0CRIMA",333,0) 116692 D APUSH(RIMTBL,"HEADER") 116693 "RTN","C0CRIMA",334,0) 116694 D APUSH(RIMTBL,"NOPCP") 116695 "RTN","C0CRIMA",335,0) 116696 D APUSH(RIMTBL,"PCP") 116697 "RTN","C0CRIMA",336,0) 116698 D APUSH(RIMTBL,"PROBLEMS") 116699 "RTN","C0CRIMA",337,0) 116700 D APUSH(RIMTBL,"PROBCODE") 116701 "RTN","C0CRIMA",338,0) 116702 D APUSH(RIMTBL,"PROBNOCODE") 116703 "RTN","C0CRIMA",339,0) 116704 D APUSH(RIMTBL,"PROBDATE") 116705 "RTN","C0CRIMA",340,0) 116706 D APUSH(RIMTBL,"PROBNODATE") 116707 "RTN","C0CRIMA",341,0) 116708 D APUSH(RIMTBL,"VITALS") 116709 "RTN","C0CRIMA",342,0) 116710 D APUSH(RIMTBL,"VITALSCODE") 116711 "RTN","C0CRIMA",343,0) 116712 D APUSH(RIMTBL,"VITALSNOCODE") 116713 "RTN","C0CRIMA",344,0) 116714 D APUSH(RIMTBL,"VITALSDATE") 116715 "RTN","C0CRIMA",345,0) 116716 D APUSH(RIMTBL,"VITALSNODATE") 116717 "RTN","C0CRIMA",346,0) 116718 D APUSH(RIMTBL,"IMMUNE") 116719 "RTN","C0CRIMA",347,0) 116720 D APUSH(RIMTBL,"IMMUNECODE") 116721 "RTN","C0CRIMA",348,0) 116722 D APUSH(RIMTBL,"MEDS") 116723 "RTN","C0CRIMA",349,0) 116724 D APUSH(RIMTBL,"MEDSCODE") 116725 "RTN","C0CRIMA",350,0) 116726 D APUSH(RIMTBL,"MEDSNOCODE") 116727 "RTN","C0CRIMA",351,0) 116728 D APUSH(RIMTBL,"MEDSDATE") 116729 "RTN","C0CRIMA",352,0) 116730 D APUSH(RIMTBL,"MEDSNODATE") 116731 "RTN","C0CRIMA",353,0) 116732 D APUSH(RIMTBL,"ALERTS") 116733 "RTN","C0CRIMA",354,0) 116734 D APUSH(RIMTBL,"ALERTSCODE") 116735 "RTN","C0CRIMA",355,0) 116736 D APUSH(RIMTBL,"RESULTS") 116737 "RTN","C0CRIMA",356,0) 116738 D APUSH(RIMTBL,"RESULTSLN") 116739 "RTN","C0CRIMA",357,0) 116740 D APUSH(RIMTBL,"PROCEDURES") 116741 "RTN","C0CRIMA",358,0) 116742 D APUSH(RIMTBL,"ENCOUNTERS") 116743 "RTN","C0CRIMA",359,0) 116744 D APUSH(RIMTBL,"NOTES") 116745 "RTN","C0CRIMA",360,0) 116746 Q 116747 "RTN","C0CRIMA",361,0) 116748 ; 116749 "RTN","C0CRIMA",362,0) 116750 APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL 116751 "RTN","C0CRIMA",363,0) 116752 ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING 116753 "RTN","C0CRIMA",364,0) 116754 ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES 116755 "RTN","C0CRIMA",365,0) 116756 ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL)) 116757 "RTN","C0CRIMA",366,0) 116758 I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING 116759 "RTN","C0CRIMA",367,0) 116760 N USETBL 116761 "RTN","C0CRIMA",368,0) 116762 I '$D(@RIMBASE@("TABLES",PTBL)) D Q ; NO TABLE 116763 "RTN","C0CRIMA",369,0) 116764 . W "ERROR NO SUCH TABLE",! 116765 "RTN","C0CRIMA",370,0) 116766 S USETBL=@RIMBASE@("TABLES",PTBL) 116767 "RTN","C0CRIMA",371,0) 116768 S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL 116769 "RTN","C0CRIMA",372,0) 116770 Q 116771 "RTN","C0CRIMA",373,0) 116772 GETPA(RTN,DFN,ISEC,IVAR) ; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN 116773 "RTN","C0CRIMA",374,0) 116774 ; EXAMPLE: D GETPA(.RT,2,"MEDS","MEDSSTATUSTEXT") 116775 "RTN","C0CRIMA",375,0) 116776 ; RETURNS AN ARRAY RT OF VALUES OF MEDSTATUSTEXT FOR PATIENT 2 IN P2 116777 "RTN","C0CRIMA",376,0) 116778 ; IN SECTION "MEDS" 116779 "RTN","C0CRIMA",377,0) 116780 ; P1 IS THE IEN OF THE MED WITH THE VALUE IE 2^PENDING WOULD BE STATUS 116781 "RTN","C0CRIMA",378,0) 116782 ; PENDING FOR MED 2 FOR PATIENT 2 116783 "RTN","C0CRIMA",379,0) 116784 ; RT(0) IS THE COUNT OF HOW MANY IN THE ARRAY. NULL VALUES ARE 116785 "RTN","C0CRIMA",380,0) 116786 ; RETURNED. RTN IS PASSED BY REFERENCE 116787 "RTN","C0CRIMA",381,0) 116788 ; 116789 "RTN","C0CRIMA",382,0) 116790 S RTN(0)=0 ; SET NULL DEFAULT RETURN VALUE 116791 "RTN","C0CRIMA",383,0) 116792 I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES 116793 "RTN","C0CRIMA",384,0) 116794 S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES 116795 "RTN","C0CRIMA",385,0) 116796 I '$D(@ZVBASE@(DFN,ISEC,0)) D Q ; NO VARIABLES IN SECTION 116797 "RTN","C0CRIMA",386,0) 116798 . W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,! 116799 "RTN","C0CRIMA",387,0) 116800 N ZZI,ZZS 116801 "RTN","C0CRIMA",388,0) 116802 S ZZS=$NA(@ZVBASE@(DFN,ISEC)) ; SECTION VARIABLE ARRAY FOR THIS PATIENT 116803 "RTN","C0CRIMA",389,0) 116804 ; ZWR @ZZS@(1) 116805 "RTN","C0CRIMA",390,0) 116806 S RTN(0)=@ZZS@(0) 116807 "RTN","C0CRIMA",391,0) 116808 F ZZI=1:1:RTN(0) D ; FOR ALL PARTS OF THIS SECTION ( IE FOR ALL MEDS) 116809 "RTN","C0CRIMA",392,0) 116810 . S $P(RTN(ZZI),"^",1)=ZZI ; INDEX FOR VARIABLE 116811 "RTN","C0CRIMA",393,0) 116812 . S $P(RTN(ZZI),"^",2)=@ZZS@(ZZI,IVAR) ; THE VALUE OF THE VARIABLE 116813 "RTN","C0CRIMA",394,0) 116814 Q 116815 "RTN","C0CRIMA",395,0) 116816 ; 116817 "RTN","C0CRIMA",396,0) 116818 PATD(DFN,ISEC,IVAR) ; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR 116819 "RTN","C0CRIMA",397,0) 116820 ; 116821 "RTN","C0CRIMA",398,0) 116822 N ZR 116823 "RTN","C0CRIMA",399,0) 116824 D GETPA(.ZR,DFN,ISEC,IVAR) 116825 "RTN","C0CRIMA",400,0) 116826 I $D(ZR(0)) D PARY^C0CXPATH("ZR") 116827 "RTN","C0CRIMA",401,0) 116828 E W "NOTHING RETURNED",! 116829 "RTN","C0CRIMA",402,0) 116830 Q 116831 "RTN","C0CRIMA",403,0) 116832 ; 116833 "RTN","C0CRIMA",404,0) 116834 CAGET(RTN,IATTR) ; 116835 "RTN","C0CRIMA",405,0) 116836 ; GETPA LOOKS AT RIMTBL TO FIND PATIENTS WITH ATTRIBUTE IATTR 116837 "RTN","C0CRIMA",406,0) 116838 ; IT DOES NOT SEARCH ALL PATIENTS, ONLY THE ONES WITH THE ATTRIBUTE 116839 "RTN","C0CRIMA",407,0) 116840 ; IT RETURNS AN ARRAY OF THE VALUES OF VARIABLE IVAR IN SECTION ISEC 116841 "RTN","C0CRIMA",408,0) 116842 Q 116843 "RTN","C0CRIMA",409,0) 116844 ; 116845 "RTN","C0CRIMA",410,0) 116846 PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR 116847 "RTN","C0CRIMA",411,0) 116848 ; 116849 "RTN","C0CRIMA",412,0) 116850 I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES 116851 "RTN","C0CRIMA",413,0) 116852 N ZLST 116853 "RTN","C0CRIMA",414,0) 116854 S @LSTRTN@(0)=0 ; DEFAULT RETURN NONE 116855 "RTN","C0CRIMA",415,0) 116400 116856 S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES 116401 "RTN","C0CRIMA", 239,0)116857 "RTN","C0CRIMA",416,0) 116402 116858 S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS 116403 "RTN","C0CRIMA",240,0) 116404 S ZTOT=0 ; INITIALIZE OVERALL TOTAL 116405 "RTN","C0CRIMA",241,0) 116406 F ZI=1:1:@ZCBASE@(0) D ; FOR ALL CATS 116407 "RTN","C0CRIMA",242,0) 116408 . S ZCNT=0 116409 "RTN","C0CRIMA",243,0) 116410 . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY 116411 "RTN","C0CRIMA",244,0) 116412 . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME 116413 "RTN","C0CRIMA",245,0) 116414 . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST 116415 "RTN","C0CRIMA",246,0) 116416 . ; F ZJ=0:0 D Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS 116417 "RTN","C0CRIMA",247,0) 116418 . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT 116419 "RTN","C0CRIMA",248,0) 116420 . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,! 116421 "RTN","C0CRIMA",249,0) 116422 . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX)) 116423 "RTN","C0CRIMA",250,0) 116424 . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT))) 116425 "RTN","C0CRIMA",251,0) 116426 . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD 116427 "RTN","C0CRIMA",252,0) 116428 . S ZTOT=ZTOT+ZCNT 116429 "RTN","C0CRIMA",253,0) 116430 W "TOTAL: ",ZTOT,! 116431 "RTN","C0CRIMA",254,0) 116859 "RTN","C0CRIMA",417,0) 116860 N ZNC ; ZNC IS NUMBER OF CATEGORIES 116861 "RTN","C0CRIMA",418,0) 116862 S ZNC=@ZCBASE@(0) 116863 "RTN","C0CRIMA",419,0) 116864 I ZNC=0 Q ; NO CATEGORIES TO SEARCH 116865 "RTN","C0CRIMA",420,0) 116866 N ZAP ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE 116867 "RTN","C0CRIMA",421,0) 116868 S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR) 116869 "RTN","C0CRIMA",422,0) 116870 N ZI,ZCATTBL,ZATBL,ZCNT,ZPAT 116871 "RTN","C0CRIMA",423,0) 116872 F ZI=1:1:ZNC D ; FOR ALL CATEGORIES 116873 "RTN","C0CRIMA",424,0) 116874 . S ZATBL=@ZCBASE@(ZI) ; PULL OUT ATTR TBL FOR CAT 116875 "RTN","C0CRIMA",425,0) 116876 . I $P(ZATBL,"^",ZAP)'="" D ; CAT HAS ATTR 116877 "RTN","C0CRIMA",426,0) 116878 . . S ZCATTBL=$P(@ZCBASE@(ZATBL),"^",1) ; NAME OF TBL 116879 "RTN","C0CRIMA",427,0) 116880 . . M @LSTRTN=@ZPBASE@(ZCATTBL) ; MERGE PATS FROM CAT 116881 "RTN","C0CRIMA",428,0) 116882 S ZCNT=0 ; INITIALIZE COUNT OF PATIENTS 116883 "RTN","C0CRIMA",429,0) 116884 S ZPAT=0 ; START AT FIRST PATIENT IN LIST 116885 "RTN","C0CRIMA",430,0) 116886 F S ZPAT=$O(@LSTRTN@(ZPAT)) Q:ZPAT="" D ; 116887 "RTN","C0CRIMA",431,0) 116888 . S ZCNT=ZCNT+1 116889 "RTN","C0CRIMA",432,0) 116890 S @LSTRTN@(0)=ZCNT ; COUNT OF PATIENTS IN ARRAY 116891 "RTN","C0CRIMA",433,0) 116432 116892 Q 116433 "RTN","C0CRIMA", 255,0)116893 "RTN","C0CRIMA",434,0) 116434 116894 ; 116435 "RTN","C0CRIMA",256,0) 116436 CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST 116437 "RTN","C0CRIMA",257,0) 116438 ; INLST IS PASSED BY NAME 116439 "RTN","C0CRIMA",258,0) 116440 N ZI,ZDX,ZCOUNT 116441 "RTN","C0CRIMA",259,0) 116442 W INLST,! 116443 "RTN","C0CRIMA",260,0) 116444 S ZCOUNT=0 116445 "RTN","C0CRIMA",261,0) 116446 S ZDX="" 116447 "RTN","C0CRIMA",262,0) 116448 F ZI=$O(@INLST@(ZDX)):0 D Q:$O(@INLST@(ZDX))="" ; LOOP UNTIL THE END 116449 "RTN","C0CRIMA",263,0) 116450 . S ZCOUNT=ZCOUNT+1 116451 "RTN","C0CRIMA",264,0) 116452 . S ZDX=$O(@INLST@(ZDX)) 116453 "RTN","C0CRIMA",265,0) 116454 . W "ZDX:",ZDX," ZCNT:",ZCOUNT,! 116455 "RTN","C0CRIMA",266,0) 116456 Q ZCOUNT 116457 "RTN","C0CRIMA",267,0) 116895 "RTN","C0CRIMA",435,0) 116896 DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR 116897 "RTN","C0CRIMA",436,0) 116458 116898 ; 116459 "RTN","C0CRIMA",268,0) 116460 XCPAT(CPATCAT,CPATPARM) ; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT 116461 "RTN","C0CRIMA",269,0) 116899 "RTN","C0CRIMA",437,0) 116900 ;N ZR 116901 "RTN","C0CRIMA",438,0) 116902 D PCLST("ZR",CATTR) 116903 "RTN","C0CRIMA",439,0) 116904 I ZR(0)=0 D Q ; 116905 "RTN","C0CRIMA",440,0) 116906 . W "NO PATIENTS RETURNED",! 116907 "RTN","C0CRIMA",441,0) 116908 E D ; 116909 "RTN","C0CRIMA",442,0) 116910 . N ZI S ZI=0 116911 "RTN","C0CRIMA",443,0) 116912 . F S ZI=$O(ZR(ZI)) Q:ZI="" D ; 116913 "RTN","C0CRIMA",444,0) 116914 . . W !,ZI 116915 "RTN","C0CRIMA",445,0) 116916 . ;D PARY^C0CXPATH("ZR") ; PRINT ARRAY 116917 "RTN","C0CRIMA",446,0) 116918 . W !,"COUNT=",ZR(0) 116919 "RTN","C0CRIMA",447,0) 116920 Q 116921 "RTN","C0CRIMA",448,0) 116462 116922 ; 116463 "RTN","C0CRIMA",270,0) 116464 I '$D(CPATPARM) S CPATPARM="" 116465 "RTN","C0CRIMA",271,0) 116466 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS 116467 "RTN","C0CRIMA",272,0) 116468 N ZI,ZJ,ZC,ZPATBASE 116469 "RTN","C0CRIMA",273,0) 116470 S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT)) 116471 "RTN","C0CRIMA",274,0) 116472 S ZI="" 116473 "RTN","C0CRIMA",275,0) 116474 F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END 116475 "RTN","C0CRIMA",276,0) 116476 . S ZI=$O(@ZPATBASE@(ZI)) 116477 "RTN","C0CRIMA",277,0) 116478 . D XPAT^C0CCCR(ZI,CPATPARM) ; EXPORT THE PATIENT TO A FILE 116479 "RTN","C0CRIMA",278,0) 116923 "RTN","C0CRIMA",449,0) 116924 RPCGV(RTN,DFN,WHICH) ; RPC GET VARS 116925 "RTN","C0CRIMA",450,0) 116926 ; RETURNS IN RTN (PASSED BY REFERENCE) THE VARS AND VALUES 116927 "RTN","C0CRIMA",451,0) 116928 ; FOUND AT INARY RTN(X)="VAR^VALUE" RTN(0) IS THE COUNT 116929 "RTN","C0CRIMA",452,0) 116930 ; DFN IS THE PATIENT NUMBER. 116931 "RTN","C0CRIMA",453,0) 116932 ; WHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS","IMMUNE" 116933 "RTN","C0CRIMA",454,0) 116934 ; OR OTHER SECTIONS AS THEY ARE ADDED 116935 "RTN","C0CRIMA",455,0) 116936 ; THIS IS MEANT TO BE AVAILABLE AS AN RPC 116937 "RTN","C0CRIMA",456,0) 116938 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS 116939 "RTN","C0CRIMA",457,0) 116940 S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES 116941 "RTN","C0CRIMA",458,0) 116942 S RTN(0)=0 ; DEFAULT NOTHING IS RETURNED 116943 "RTN","C0CRIMA",459,0) 116944 N ZZGI 116945 "RTN","C0CRIMA",460,0) 116946 I WHICH="ALL" D ; VARIABLES FROM ALL SECTIONS 116947 "RTN","C0CRIMA",461,0) 116948 . F ZZGI="HEADER","PROBLEMS","VITALS","MEDS","ALERTS","RESULTS","IMMUNE","PROCEDURES" D ; 116949 "RTN","C0CRIMA",462,0) 116950 . . D ZGVWRK(ZZGI) ; DO EACH SECTION 116951 "RTN","C0CRIMA",463,0) 116952 . . I $G(DEBUG)'="" W "DID ",ZZGI,! 116953 "RTN","C0CRIMA",464,0) 116954 E D ZGVWRK(WHICH) ; ONLY ONE SECTION ASKED FOR 116955 "RTN","C0CRIMA",465,0) 116956 Q 116957 "RTN","C0CRIMA",466,0) 116958 ; 116959 "RTN","C0CRIMA",467,0) 116960 ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV 116961 "RTN","C0CRIMA",468,0) 116962 ; 116963 "RTN","C0CRIMA",469,0) 116964 N ZZGN ; NAME FOR SECTION VARIABLES 116965 "RTN","C0CRIMA",470,0) 116966 S ZZGN=$NA(@ZVBASE@(DFN,ZWHICH)) ; BASE OF VARS FOR SECTION 116967 "RTN","C0CRIMA",471,0) 116968 ;I '$D(@ZZGN@(0)) Q ; NO VARS FOR THIS SECTION 116969 "RTN","C0CRIMA",472,0) 116970 I $O(@ZZGN@(""),-1)="" D ; 116971 "RTN","C0CRIMA",473,0) 116972 E D ; VARS EXIST 116973 "RTN","C0CRIMA",474,0) 116974 . N ZGVI,ZGVN 116975 "RTN","C0CRIMA",475,0) 116976 . S ZGVN=$O(@ZZGN@(""),-1) ;COUNT OF VARS 116977 "RTN","C0CRIMA",476,0) 116978 . F ZGVI=1:1:ZGVN D ; FOR EACH MULTIPLE IN SECTION 116979 "RTN","C0CRIMA",477,0) 116980 . . K ZZGA N ZZGA ; TEMP ARRAY FOR SECTION VARS 116981 "RTN","C0CRIMA",478,0) 116982 . . K ZZGN2 N ZZGN2 ; NAME FOR MULTIPLE 116983 "RTN","C0CRIMA",479,0) 116984 . . S ZZGN2=$NA(@ZZGN@(ZGVI)) 116985 "RTN","C0CRIMA",480,0) 116986 . . I $G(DEBUG)'="" W ZZGN2,!,$O(@ZZGN2@("")),! 116987 "RTN","C0CRIMA",481,0) 116988 . . D H2ARY^C0CXPATH("ZZGA",ZZGN2,ZGVI) ; CONVERT HASH TO ARRAY 116989 "RTN","C0CRIMA",482,0) 116990 . . ; D PARY^C0CXPATH("ZZGA") 116991 "RTN","C0CRIMA",483,0) 116992 . . D PUSHA^C0CXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN 116993 "RTN","C0CRIMA",484,0) 116480 116994 Q 116481 "RTN","C0CRIMA", 279,0)116995 "RTN","C0CRIMA",485,0) 116482 116996 ; 116483 "RTN","C0CRIMA",280,0) 116484 CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT 116485 "RTN","C0CRIMA",281,0) 116997 "RTN","C0CRIMA",486,0) 116998 DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN C0CRIM 116999 "RTN","C0CRIMA",487,0) 117000 ; ALONG WITH SAMPLE VALUES. 117001 "RTN","C0CRIMA",488,0) 117002 ; IWHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS","HEADER" 117003 "RTN","C0CRIMA",489,0) 117004 N GTMP 117005 "RTN","C0CRIMA",490,0) 117006 I '$D(^TMP("C0CRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT 117007 "RTN","C0CRIMA",491,0) 117008 . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES 117009 "RTN","C0CRIMA",492,0) 117010 I '$D(IWHICH) S IWHICH="ALL" 117011 "RTN","C0CRIMA",493,0) 117012 D RPCGV(.GTMP,DFN,IWHICH) 117013 "RTN","C0CRIMA",494,0) 117014 D PARY^C0CXPATH("GTMP") 117015 "RTN","C0CRIMA",495,0) 117016 Q 117017 "RTN","C0CRIMA",496,0) 116486 117018 ; 116487 "RTN","C0CRIMA",282,0) 116488 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS 116489 "RTN","C0CRIMA",283,0) 116490 N ZI,ZJ,ZC,ZPATBASE 116491 "RTN","C0CRIMA",284,0) 116492 S ZC=0 ; COUNT FOR SPACING THE PRINTOUT 116493 "RTN","C0CRIMA",285,0) 116494 S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT)) 116495 "RTN","C0CRIMA",286,0) 116496 S ZI="" 116497 "RTN","C0CRIMA",287,0) 116498 F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END 116499 "RTN","C0CRIMA",288,0) 116500 . S ZI=$O(@ZPATBASE@(ZI)) 116501 "RTN","C0CRIMA",289,0) 116502 . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT 116503 "RTN","C0CRIMA",290,0) 116504 . W ZI," " 116505 "RTN","C0CRIMA",291,0) 116506 . I ZC=10 D ; NEW LINE 116507 "RTN","C0CRIMA",292,0) 116508 . . S ZC=0 116509 "RTN","C0CRIMA",293,0) 116510 . . W ! 116511 "RTN","C0CRIMA",294,0) 116512 Q 116513 "RTN","C0CRIMA",295,0) 116514 ; 116515 "RTN","C0CRIMA",296,0) 116516 PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT 116517 "RTN","C0CRIMA",297,0) 116518 ; 116519 "RTN","C0CRIMA",298,0) 116520 N ATTR S ATTR="" 116521 "RTN","C0CRIMA",299,0) 116522 I '$D(^TMP("C0CRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT 116523 "RTN","C0CRIMA",300,0) 116524 . D ANALYZE(DFN,1) ; EXTRACT THE RIM VARIABLE FOR THIS PATIENT 116525 "RTN","C0CRIMA",301,0) 116526 S ATTR=^TMP("C0CRIM","ATTR",DFN) 116527 "RTN","C0CRIMA",302,0) 116528 I ATTR="" W "THIS PATIENT NOT ANALYZED.",! Q ;NO ATTRIBUTES FOUND 116529 "RTN","C0CRIMA",303,0) 116530 I $D(^TMP("C0CRIM","RIMTBL","CATS",ATTR)) D ; FOUND A CAT 116531 "RTN","C0CRIMA",304,0) 116532 . N CAT 116533 "RTN","C0CRIMA",305,0) 116534 . S CAT=$P(^TMP("C0CRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT 116535 "RTN","C0CRIMA",306,0) 116536 . W CAT,": ",ATTR,! 116537 "RTN","C0CRIMA",307,0) 116538 Q 116539 "RTN","C0CRIMA",308,0) 116540 ; 116541 "RTN","C0CRIMA",309,0) 116542 APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME) 116543 "RTN","C0CRIMA",310,0) 116544 ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT 116545 "RTN","C0CRIMA",311,0) 116546 ; AND AMAP(N)=AVAL IS THE NTH AVAL 116547 "RTN","C0CRIMA",312,0) 116548 ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE 116549 "RTN","C0CRIMA",313,0) 116550 ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE 116551 "RTN","C0CRIMA",314,0) 116552 ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED 116553 "RTN","C0CRIMA",315,0) 116554 ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED 116555 "RTN","C0CRIMA",316,0) 116556 ; 116557 "RTN","C0CRIMA",317,0) 116558 I '$D(@AMAP) D ; IF THE MAP DOES NOT EXIST 116559 "RTN","C0CRIMA",318,0) 116560 . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS 116561 "RTN","C0CRIMA",319,0) 116562 S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT 116563 "RTN","C0CRIMA",320,0) 116564 S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY 116565 "RTN","C0CRIMA",321,0) 116566 S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF 116567 "RTN","C0CRIMA",322,0) 116568 Q 116569 "RTN","C0CRIMA",323,0) 116570 ; 116571 "RTN","C0CRIMA",324,0) 116572 ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL 116573 "RTN","C0CRIMA",325,0) 116574 I '$D(RIMBASE) S RIMBASE=$NA(^TMP("C0CRIM")) 116575 "RTN","C0CRIMA",326,0) 116576 I '$D(@RIMBASE) S @RIMBASE="" 116577 "RTN","C0CRIMA",327,0) 116578 I '$D(RIMTBL) S RIMTBL=$NA(^TMP("C0CRIM","RIMTBL","TABLE")) ; ATTR TABLE 116579 "RTN","C0CRIMA",328,0) 116580 S ^TMP("C0CRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES 116581 "RTN","C0CRIMA",329,0) 116582 Q 116583 "RTN","C0CRIMA",330,0) 116584 ; 116585 "RTN","C0CRIMA",331,0) 116586 AINIT ; INITIALIZE ATTRIBUTE TABLE 116587 "RTN","C0CRIMA",332,0) 116588 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS 116589 "RTN","C0CRIMA",333,0) 116590 K @RIMTBL 116591 "RTN","C0CRIMA",334,0) 116592 D APUSH(RIMTBL,"EXTRACTED") 116593 "RTN","C0CRIMA",335,0) 116594 D APUSH(RIMTBL,"NOTEXTRACTED") 116595 "RTN","C0CRIMA",336,0) 116596 D APUSH(RIMTBL,"HEADER") 116597 "RTN","C0CRIMA",337,0) 116598 D APUSH(RIMTBL,"NOPCP") 116599 "RTN","C0CRIMA",338,0) 116600 D APUSH(RIMTBL,"PCP") 116601 "RTN","C0CRIMA",339,0) 116602 D APUSH(RIMTBL,"PROBLEMS") 116603 "RTN","C0CRIMA",340,0) 116604 D APUSH(RIMTBL,"PROBCODE") 116605 "RTN","C0CRIMA",341,0) 116606 D APUSH(RIMTBL,"PROBNOCODE") 116607 "RTN","C0CRIMA",342,0) 116608 D APUSH(RIMTBL,"PROBDATE") 116609 "RTN","C0CRIMA",343,0) 116610 D APUSH(RIMTBL,"PROBNODATE") 116611 "RTN","C0CRIMA",344,0) 116612 D APUSH(RIMTBL,"VITALS") 116613 "RTN","C0CRIMA",345,0) 116614 D APUSH(RIMTBL,"VITALSCODE") 116615 "RTN","C0CRIMA",346,0) 116616 D APUSH(RIMTBL,"VITALSNOCODE") 116617 "RTN","C0CRIMA",347,0) 116618 D APUSH(RIMTBL,"VITALSDATE") 116619 "RTN","C0CRIMA",348,0) 116620 D APUSH(RIMTBL,"VITALSNODATE") 116621 "RTN","C0CRIMA",349,0) 116622 D APUSH(RIMTBL,"IMMUNE") 116623 "RTN","C0CRIMA",350,0) 116624 D APUSH(RIMTBL,"IMMUNECODE") 116625 "RTN","C0CRIMA",351,0) 116626 D APUSH(RIMTBL,"MEDS") 116627 "RTN","C0CRIMA",352,0) 116628 D APUSH(RIMTBL,"MEDSCODE") 116629 "RTN","C0CRIMA",353,0) 116630 D APUSH(RIMTBL,"MEDSNOCODE") 116631 "RTN","C0CRIMA",354,0) 116632 D APUSH(RIMTBL,"MEDSDATE") 116633 "RTN","C0CRIMA",355,0) 116634 D APUSH(RIMTBL,"MEDSNODATE") 116635 "RTN","C0CRIMA",356,0) 116636 D APUSH(RIMTBL,"ALERTS") 116637 "RTN","C0CRIMA",357,0) 116638 D APUSH(RIMTBL,"ALERTSCODE") 116639 "RTN","C0CRIMA",358,0) 116640 D APUSH(RIMTBL,"RESULTS") 116641 "RTN","C0CRIMA",359,0) 116642 D APUSH(RIMTBL,"RESULTSLN") 116643 "RTN","C0CRIMA",360,0) 116644 D APUSH(RIMTBL,"PROCEDURES") 116645 "RTN","C0CRIMA",361,0) 116646 D APUSH(RIMTBL,"ENCOUNTERS") 116647 "RTN","C0CRIMA",362,0) 116648 D APUSH(RIMTBL,"NOTES") 116649 "RTN","C0CRIMA",363,0) 116650 Q 116651 "RTN","C0CRIMA",364,0) 116652 ; 116653 "RTN","C0CRIMA",365,0) 116654 APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL 116655 "RTN","C0CRIMA",366,0) 116656 ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING 116657 "RTN","C0CRIMA",367,0) 116658 ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES 116659 "RTN","C0CRIMA",368,0) 116660 ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL)) 116661 "RTN","C0CRIMA",369,0) 116662 I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING 116663 "RTN","C0CRIMA",370,0) 116664 N USETBL 116665 "RTN","C0CRIMA",371,0) 116666 I '$D(@RIMBASE@("TABLES",PTBL)) D Q ; NO TABLE 116667 "RTN","C0CRIMA",372,0) 116668 . W "ERROR NO SUCH TABLE",! 116669 "RTN","C0CRIMA",373,0) 116670 S USETBL=@RIMBASE@("TABLES",PTBL) 116671 "RTN","C0CRIMA",374,0) 116672 S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL 116673 "RTN","C0CRIMA",375,0) 116674 Q 116675 "RTN","C0CRIMA",376,0) 116676 GETPA(RTN,DFN,ISEC,IVAR) ; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN 116677 "RTN","C0CRIMA",377,0) 116678 ; EXAMPLE: D GETPA(.RT,2,"MEDS","MEDSSTATUSTEXT") 116679 "RTN","C0CRIMA",378,0) 116680 ; RETURNS AN ARRAY RT OF VALUES OF MEDSTATUSTEXT FOR PATIENT 2 IN P2 116681 "RTN","C0CRIMA",379,0) 116682 ; IN SECTION "MEDS" 116683 "RTN","C0CRIMA",380,0) 116684 ; P1 IS THE IEN OF THE MED WITH THE VALUE IE 2^PENDING WOULD BE STATUS 116685 "RTN","C0CRIMA",381,0) 116686 ; PENDING FOR MED 2 FOR PATIENT 2 116687 "RTN","C0CRIMA",382,0) 116688 ; RT(0) IS THE COUNT OF HOW MANY IN THE ARRAY. NULL VALUES ARE 116689 "RTN","C0CRIMA",383,0) 116690 ; RETURNED. RTN IS PASSED BY REFERENCE 116691 "RTN","C0CRIMA",384,0) 116692 ; 116693 "RTN","C0CRIMA",385,0) 116694 S RTN(0)=0 ; SET NULL DEFAULT RETURN VALUE 116695 "RTN","C0CRIMA",386,0) 116696 I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES 116697 "RTN","C0CRIMA",387,0) 116698 S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES 116699 "RTN","C0CRIMA",388,0) 116700 I '$D(@ZVBASE@(DFN,ISEC,0)) D Q ; NO VARIABLES IN SECTION 116701 "RTN","C0CRIMA",389,0) 116702 . W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,! 116703 "RTN","C0CRIMA",390,0) 116704 N ZZI,ZZS 116705 "RTN","C0CRIMA",391,0) 116706 S ZZS=$NA(@ZVBASE@(DFN,ISEC)) ; SECTION VARIABLE ARRAY FOR THIS PATIENT 116707 "RTN","C0CRIMA",392,0) 116708 ; ZWR @ZZS@(1) 116709 "RTN","C0CRIMA",393,0) 116710 S RTN(0)=@ZZS@(0) 116711 "RTN","C0CRIMA",394,0) 116712 F ZZI=1:1:RTN(0) D ; FOR ALL PARTS OF THIS SECTION ( IE FOR ALL MEDS) 116713 "RTN","C0CRIMA",395,0) 116714 . S $P(RTN(ZZI),"^",1)=ZZI ; INDEX FOR VARIABLE 116715 "RTN","C0CRIMA",396,0) 116716 . S $P(RTN(ZZI),"^",2)=@ZZS@(ZZI,IVAR) ; THE VALUE OF THE VARIABLE 116717 "RTN","C0CRIMA",397,0) 116718 Q 116719 "RTN","C0CRIMA",398,0) 116720 ; 116721 "RTN","C0CRIMA",399,0) 116722 PATD(DFN,ISEC,IVAR) ; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR 116723 "RTN","C0CRIMA",400,0) 116724 ; 116725 "RTN","C0CRIMA",401,0) 116726 N ZR 116727 "RTN","C0CRIMA",402,0) 116728 D GETPA(.ZR,DFN,ISEC,IVAR) 116729 "RTN","C0CRIMA",403,0) 116730 I $D(ZR(0)) D PARY^C0CXPATH("ZR") 116731 "RTN","C0CRIMA",404,0) 116732 E W "NOTHING RETURNED",! 116733 "RTN","C0CRIMA",405,0) 116734 Q 116735 "RTN","C0CRIMA",406,0) 116736 ; 116737 "RTN","C0CRIMA",407,0) 116738 CAGET(RTN,IATTR) ; 116739 "RTN","C0CRIMA",408,0) 116740 ; GETPA LOOKS AT RIMTBL TO FIND PATIENTS WITH ATTRIBUTE IATTR 116741 "RTN","C0CRIMA",409,0) 116742 ; IT DOES NOT SEARCH ALL PATIENTS, ONLY THE ONES WITH THE ATTRIBUTE 116743 "RTN","C0CRIMA",410,0) 116744 ; IT RETURNS AN ARRAY OF THE VALUES OF VARIABLE IVAR IN SECTION ISEC 116745 "RTN","C0CRIMA",411,0) 116746 Q 116747 "RTN","C0CRIMA",412,0) 116748 ; 116749 "RTN","C0CRIMA",413,0) 116750 PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR 116751 "RTN","C0CRIMA",414,0) 116752 ; 116753 "RTN","C0CRIMA",415,0) 116754 I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES 116755 "RTN","C0CRIMA",416,0) 116756 N ZLST 116757 "RTN","C0CRIMA",417,0) 116758 S @LSTRTN@(0)=0 ; DEFAULT RETURN NONE 116759 "RTN","C0CRIMA",418,0) 116760 S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES 116761 "RTN","C0CRIMA",419,0) 116762 S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS 116763 "RTN","C0CRIMA",420,0) 116764 N ZNC ; ZNC IS NUMBER OF CATEGORIES 116765 "RTN","C0CRIMA",421,0) 116766 S ZNC=@ZCBASE@(0) 116767 "RTN","C0CRIMA",422,0) 116768 I ZNC=0 Q ; NO CATEGORIES TO SEARCH 116769 "RTN","C0CRIMA",423,0) 116770 N ZAP ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE 116771 "RTN","C0CRIMA",424,0) 116772 S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR) 116773 "RTN","C0CRIMA",425,0) 116774 N ZI,ZCATTBL,ZATBL,ZCNT,ZPAT 116775 "RTN","C0CRIMA",426,0) 116776 F ZI=1:1:ZNC D ; FOR ALL CATEGORIES 116777 "RTN","C0CRIMA",427,0) 116778 . S ZATBL=@ZCBASE@(ZI) ; PULL OUT ATTR TBL FOR CAT 116779 "RTN","C0CRIMA",428,0) 116780 . I $P(ZATBL,"^",ZAP)'="" D ; CAT HAS ATTR 116781 "RTN","C0CRIMA",429,0) 116782 . . S ZCATTBL=$P(@ZCBASE@(ZATBL),"^",1) ; NAME OF TBL 116783 "RTN","C0CRIMA",430,0) 116784 . . M @LSTRTN=@ZPBASE@(ZCATTBL) ; MERGE PATS FROM CAT 116785 "RTN","C0CRIMA",431,0) 116786 S ZCNT=0 ; INITIALIZE COUNT OF PATIENTS 116787 "RTN","C0CRIMA",432,0) 116788 S ZPAT=0 ; START AT FIRST PATIENT IN LIST 116789 "RTN","C0CRIMA",433,0) 116790 F S ZPAT=$O(@LSTRTN@(ZPAT)) Q:ZPAT="" D ; 116791 "RTN","C0CRIMA",434,0) 116792 . S ZCNT=ZCNT+1 116793 "RTN","C0CRIMA",435,0) 116794 S @LSTRTN@(0)=ZCNT ; COUNT OF PATIENTS IN ARRAY 116795 "RTN","C0CRIMA",436,0) 116796 Q 116797 "RTN","C0CRIMA",437,0) 116798 ; 116799 "RTN","C0CRIMA",438,0) 116800 DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR 116801 "RTN","C0CRIMA",439,0) 116802 ; 116803 "RTN","C0CRIMA",440,0) 116804 ;N ZR 116805 "RTN","C0CRIMA",441,0) 116806 D PCLST("ZR",CATTR) 116807 "RTN","C0CRIMA",442,0) 116808 I ZR(0)=0 D Q ; 116809 "RTN","C0CRIMA",443,0) 116810 . W "NO PATIENTS RETURNED",! 116811 "RTN","C0CRIMA",444,0) 116812 E D ; 116813 "RTN","C0CRIMA",445,0) 116814 . N ZI S ZI=0 116815 "RTN","C0CRIMA",446,0) 116816 . F S ZI=$O(ZR(ZI)) Q:ZI="" D ; 116817 "RTN","C0CRIMA",447,0) 116818 . . W !,ZI 116819 "RTN","C0CRIMA",448,0) 116820 . ;D PARY^C0CXPATH("ZR") ; PRINT ARRAY 116821 "RTN","C0CRIMA",449,0) 116822 . W !,"COUNT=",ZR(0) 116823 "RTN","C0CRIMA",450,0) 116824 Q 116825 "RTN","C0CRIMA",451,0) 116826 ; 116827 "RTN","C0CRIMA",452,0) 116828 RPCGV(RTN,DFN,WHICH) ; RPC GET VARS 116829 "RTN","C0CRIMA",453,0) 116830 ; RETURNS IN RTN (PASSED BY REFERENCE) THE VARS AND VALUES 116831 "RTN","C0CRIMA",454,0) 116832 ; FOUND AT INARY RTN(X)="VAR^VALUE" RTN(0) IS THE COUNT 116833 "RTN","C0CRIMA",455,0) 116834 ; DFN IS THE PATIENT NUMBER. 116835 "RTN","C0CRIMA",456,0) 116836 ; WHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS","IMMUNE" 116837 "RTN","C0CRIMA",457,0) 116838 ; OR OTHER SECTIONS AS THEY ARE ADDED 116839 "RTN","C0CRIMA",458,0) 116840 ; THIS IS MEANT TO BE AVAILABLE AS AN RPC 116841 "RTN","C0CRIMA",459,0) 116842 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS 116843 "RTN","C0CRIMA",460,0) 116844 S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES 116845 "RTN","C0CRIMA",461,0) 116846 S RTN(0)=0 ; DEFAULT NOTHING IS RETURNED 116847 "RTN","C0CRIMA",462,0) 116848 N ZZGI 116849 "RTN","C0CRIMA",463,0) 116850 I WHICH="ALL" D ; VARIABLES FROM ALL SECTIONS 116851 "RTN","C0CRIMA",464,0) 116852 . F ZZGI="HEADER","PROBLEMS","VITALS","MEDS","ALERTS","RESULTS","IMMUNE","PROCEDURES" D ; 116853 "RTN","C0CRIMA",465,0) 116854 . . D ZGVWRK(ZZGI) ; DO EACH SECTION 116855 "RTN","C0CRIMA",466,0) 116856 . . I $G(DEBUG)'="" W "DID ",ZZGI,! 116857 "RTN","C0CRIMA",467,0) 116858 E D ZGVWRK(WHICH) ; ONLY ONE SECTION ASKED FOR 116859 "RTN","C0CRIMA",468,0) 117019 "RTN","C0CRIMA",497,0) 117020 RIM2RNF(R2RTN,DFN,RWHICH) ; CONVERTS RIM VARIABLES TO RNF2 FORMAT 117021 "RTN","C0CRIMA",498,0) 117022 ; RETURN IN R2RTN, WHICH IS PASSED BY NAME 117023 "RTN","C0CRIMA",499,0) 117024 ; RWHICH IS RIM SECTION TO RETURN, DEFAULTS TO "ALL" 117025 "RTN","C0CRIMA",500,0) 117026 ; 117027 "RTN","C0CRIMA",501,0) 117028 I '$D(RWHICH) S RWHICH="ALL" 117029 "RTN","C0CRIMA",502,0) 117030 ;N R2TMP 117031 "RTN","C0CRIMA",503,0) 117032 I '$D(^TMP("C0CRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT 117033 "RTN","C0CRIMA",504,0) 117034 . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES 117035 "RTN","C0CRIMA",505,0) 117036 D RPCGV(.R2TMP,DFN,RWHICH) ; RETRIEVE ALL THE VARIABLES I AN ARRAY 117037 "RTN","C0CRIMA",506,0) 117038 N R2I,R2J,R2X,R2X1,R2X2,R2Y,R2Z 117039 "RTN","C0CRIMA",507,0) 117040 F R2I=1:1:R2TMP(0) D ; FOR EVERY LINE OF THE ARRAY 117041 "RTN","C0CRIMA",508,0) 117042 . S R2X=$P(R2TMP(R2I),"^",1) ; OCCURANCE 117043 "RTN","C0CRIMA",509,0) 117044 . S R2Y=$P(R2TMP(R2I),"^",2) ; VARIABLE NAME 117045 "RTN","C0CRIMA",510,0) 117046 . I $L(R2Y)<4 Q ; SKIP SHORT VARIABLES (THEY ARE FOR DEBUGGING) 117047 "RTN","C0CRIMA",511,0) 117048 . S R2Z=$P(R2TMP(R2I),"^",3) ; VALUE 117049 "RTN","C0CRIMA",512,0) 117050 . I R2X[";" D ; THERES MULTIPLES 117051 "RTN","C0CRIMA",513,0) 117052 . . S R2X1=$P(R2X,";",1) ; FIRST INDEX 117053 "RTN","C0CRIMA",514,0) 117054 . . S R2X2=$P(R2X,";",2) ; SECOND INDEX 117055 "RTN","C0CRIMA",515,0) 117056 . . S R2J=R2Y_"["_R2X2_"]" ; BUILD THE VARIABLE NAME 117057 "RTN","C0CRIMA",516,0) 117058 . . S @R2RTN@("F",R2J,1)="" ; PUT VARIABLE NAME IN FIELD MAP 117059 "RTN","C0CRIMA",517,0) 117060 . . S @R2RTN@("V",R2X1,R2J,1)=R2Z ; PUT THE VALUE IN THE ARRAY 117061 "RTN","C0CRIMA",518,0) 117062 . E D ; NO SUB-MULTIPLES 117063 "RTN","C0CRIMA",519,0) 117064 . . S @R2RTN@("F",R2Y,1)="" ; PUT VARIABLE NAME IN FIELD MAP 117065 "RTN","C0CRIMA",520,0) 117066 . . S @R2RTN@("V",R2X,R2Y,1)=R2Z ; PUT THE VALUE IN THE ARRAY 117067 "RTN","C0CRIMA",521,0) 116860 117068 Q 116861 "RTN","C0CRIMA",469,0)116862 ;116863 "RTN","C0CRIMA",470,0)116864 ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV116865 "RTN","C0CRIMA",471,0)116866 ;116867 "RTN","C0CRIMA",472,0)116868 N ZZGN ; NAME FOR SECTION VARIABLES116869 "RTN","C0CRIMA",473,0)116870 S ZZGN=$NA(@ZVBASE@(DFN,ZWHICH)) ; BASE OF VARS FOR SECTION116871 "RTN","C0CRIMA",474,0)116872 ;I '$D(@ZZGN@(0)) Q ; NO VARS FOR THIS SECTION116873 "RTN","C0CRIMA",475,0)116874 I $O(@ZZGN@(""),-1)="" D ;116875 "RTN","C0CRIMA",476,0)116876 E D ; VARS EXIST116877 "RTN","C0CRIMA",477,0)116878 . N ZGVI,ZGVN116879 "RTN","C0CRIMA",478,0)116880 . S ZGVN=$O(@ZZGN@(""),-1) ;COUNT OF VARS116881 "RTN","C0CRIMA",479,0)116882 . F ZGVI=1:1:ZGVN D ; FOR EACH MULTIPLE IN SECTION116883 "RTN","C0CRIMA",480,0)116884 . . K ZZGA N ZZGA ; TEMP ARRAY FOR SECTION VARS116885 "RTN","C0CRIMA",481,0)116886 . . K ZZGN2 N ZZGN2 ; NAME FOR MULTIPLE116887 "RTN","C0CRIMA",482,0)116888 . . S ZZGN2=$NA(@ZZGN@(ZGVI))116889 "RTN","C0CRIMA",483,0)116890 . . I $G(DEBUG)'="" W ZZGN2,!,$O(@ZZGN2@("")),!116891 "RTN","C0CRIMA",484,0)116892 . . D H2ARY^C0CXPATH("ZZGA",ZZGN2,ZGVI) ; CONVERT HASH TO ARRAY116893 "RTN","C0CRIMA",485,0)116894 . . ; D PARY^C0CXPATH("ZZGA")116895 "RTN","C0CRIMA",486,0)116896 . . D PUSHA^C0CXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN116897 "RTN","C0CRIMA",487,0)116898 Q116899 "RTN","C0CRIMA",488,0)116900 ;116901 "RTN","C0CRIMA",489,0)116902 DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN C0CRIM116903 "RTN","C0CRIMA",490,0)116904 ; ALONG WITH SAMPLE VALUES.116905 "RTN","C0CRIMA",491,0)116906 ; IWHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS","HEADER"116907 "RTN","C0CRIMA",492,0)116908 N GTMP116909 "RTN","C0CRIMA",493,0)116910 I '$D(^TMP("C0CRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT116911 "RTN","C0CRIMA",494,0)116912 . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES116913 "RTN","C0CRIMA",495,0)116914 I '$D(IWHICH) S IWHICH="ALL"116915 "RTN","C0CRIMA",496,0)116916 D RPCGV(.GTMP,DFN,IWHICH)116917 "RTN","C0CRIMA",497,0)116918 D PARY^C0CXPATH("GTMP")116919 "RTN","C0CRIMA",498,0)116920 Q116921 "RTN","C0CRIMA",499,0)116922 ;116923 "RTN","C0CRIMA",500,0)116924 RIM2RNF(R2RTN,DFN,RWHICH) ; CONVERTS RIM VARIABLES TO RNF2 FORMAT116925 "RTN","C0CRIMA",501,0)116926 ; RETURN IN R2RTN, WHICH IS PASSED BY NAME116927 "RTN","C0CRIMA",502,0)116928 ; RWHICH IS RIM SECTION TO RETURN, DEFAULTS TO "ALL"116929 "RTN","C0CRIMA",503,0)116930 ;116931 "RTN","C0CRIMA",504,0)116932 I '$D(RWHICH) S RWHICH="ALL"116933 "RTN","C0CRIMA",505,0)116934 ;N R2TMP116935 "RTN","C0CRIMA",506,0)116936 I '$D(^TMP("C0CRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT116937 "RTN","C0CRIMA",507,0)116938 . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES116939 "RTN","C0CRIMA",508,0)116940 D RPCGV(.R2TMP,DFN,RWHICH) ; RETRIEVE ALL THE VARIABLES I AN ARRAY116941 "RTN","C0CRIMA",509,0)116942 N R2I,R2J,R2X,R2X1,R2X2,R2Y,R2Z116943 "RTN","C0CRIMA",510,0)116944 F R2I=1:1:R2TMP(0) D ; FOR EVERY LINE OF THE ARRAY116945 "RTN","C0CRIMA",511,0)116946 . S R2X=$P(R2TMP(R2I),"^",1) ; OCCURANCE116947 "RTN","C0CRIMA",512,0)116948 . S R2Y=$P(R2TMP(R2I),"^",2) ; VARIABLE NAME116949 "RTN","C0CRIMA",513,0)116950 . I $L(R2Y)<4 Q ; SKIP SHORT VARIABLES (THEY ARE FOR DEBUGGING)116951 "RTN","C0CRIMA",514,0)116952 . S R2Z=$P(R2TMP(R2I),"^",3) ; VALUE116953 "RTN","C0CRIMA",515,0)116954 . I R2X[";" D ; THERES MULTIPLES116955 "RTN","C0CRIMA",516,0)116956 . . S R2X1=$P(R2X,";",1) ; FIRST INDEX116957 "RTN","C0CRIMA",517,0)116958 . . S R2X2=$P(R2X,";",2) ; SECOND INDEX116959 "RTN","C0CRIMA",518,0)116960 . . S R2J=R2Y_"["_R2X2_"]" ; BUILD THE VARIABLE NAME116961 "RTN","C0CRIMA",519,0)116962 . . S @R2RTN@("F",R2J,1)="" ; PUT VARIABLE NAME IN FIELD MAP116963 "RTN","C0CRIMA",520,0)116964 . . S @R2RTN@("V",R2X1,R2J,1)=R2Z ; PUT THE VALUE IN THE ARRAY116965 "RTN","C0CRIMA",521,0)116966 . E D ; NO SUB-MULTIPLES116967 117069 "RTN","C0CRIMA",522,0) 116968 . . S @R2RTN@("F",R2Y,1)="" ; PUT VARIABLE NAME IN FIELD MAP117070 ; 116969 117071 "RTN","C0CRIMA",523,0) 116970 . . S @R2RTN@("V",R2X,R2Y,1)=R2Z ; PUT THE VALUE IN THE ARRAY 117072 RIM2CSV(DFN) ; WRITE THE RIM VARIABLES FOR A PATIENT TO A CSV FILE 116971 117073 "RTN","C0CRIMA",524,0) 117074 ; 117075 "RTN","C0CRIMA",525,0) 117076 N R2CTMP,R2CARY 117077 "RTN","C0CRIMA",526,0) 117078 D RIM2RNF("R2CTMP",DFN) ; CONVERT VARIABLES TO RNF FORMAT 117079 "RTN","C0CRIMA",527,0) 117080 D RNF2CSV^C0CRNF("R2CARY","R2CTMP","NV") ; CONVERT RNF TO CSV FORMAT 117081 "RTN","C0CRIMA",528,0) 117082 D FILEOUT^C0CRNF("R2CARY","VARS-"_DFN_".csv") 117083 "RTN","C0CRIMA",529,0) 116972 117084 Q 116973 "RTN","C0CRIMA",525,0)116974 ;116975 "RTN","C0CRIMA",526,0)116976 RIM2CSV(DFN) ; WRITE THE RIM VARIABLES FOR A PATIENT TO A CSV FILE116977 "RTN","C0CRIMA",527,0)116978 ;116979 "RTN","C0CRIMA",528,0)116980 N R2CTMP,R2CARY116981 "RTN","C0CRIMA",529,0)116982 D RIM2RNF("R2CTMP",DFN) ; CONVERT VARIABLES TO RNF FORMAT116983 117085 "RTN","C0CRIMA",530,0) 116984 D RNF2CSV^C0CRNF("R2CARY","R2CTMP","NV") ; CONVERT RNF TO CSV FORMAT116985 "RTN","C0CRIMA",531,0)116986 D FILEOUT^C0CRNF("R2CARY","VARS-"_DFN_".csv")116987 "RTN","C0CRIMA",532,0)116988 Q116989 "RTN","C0CRIMA",533,0)116990 117086 ; 116991 117087 "RTN","C0CRNF") 116992 0^23^B19 5772222117088 0^23^B194328331 116993 117089 "RTN","C0CRNF",1,0) 116994 117090 C0CRNF ; CCDCCR/GPL - Reference Name Format (RNF) utilities; 12/6/08 116995 117091 "RTN","C0CRNF",2,0) 116996 ;;1.2;C 0C;;May 11, 2012;Build 50117092 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 116997 117093 "RTN","C0CRNF",3,0) 116998 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU117094 ;Copyright 2009 George Lilly. 116999 117095 "RTN","C0CRNF",4,0) 117000 ; General Public License See attached copy of the License.117096 ; 117001 117097 "RTN","C0CRNF",5,0) 117002 ; 117098 ; This program is free software: you can redistribute it and/or modify 117003 117099 "RTN","C0CRNF",6,0) 117004 ; This program is free software; you can redistribute it and/or modify117100 ; it under the terms of the GNU Affero General Public License as 117005 117101 "RTN","C0CRNF",7,0) 117006 ; it under the terms of the GNU General Public License as published by117102 ; published by the Free Software Foundation, either version 3 of the 117007 117103 "RTN","C0CRNF",8,0) 117008 ; the Free Software Foundation; either version 2 of the License, or117104 ; License, or (at your option) any later version. 117009 117105 "RTN","C0CRNF",9,0) 117010 ; (at your option) any later version.117106 ; 117011 117107 "RTN","C0CRNF",10,0) 117012 ; 117108 ; This program is distributed in the hope that it will be useful, 117013 117109 "RTN","C0CRNF",11,0) 117014 ; This program is distributed in the hope that it will be useful,117110 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 117015 117111 "RTN","C0CRNF",12,0) 117016 ; but WITHOUT ANY WARRANTY; without even the implied warranty of117112 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 117017 117113 "RTN","C0CRNF",13,0) 117018 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the117114 ; GNU Affero General Public License for more details. 117019 117115 "RTN","C0CRNF",14,0) 117020 ; GNU General Public License for more details.117116 ; 117021 117117 "RTN","C0CRNF",15,0) 117022 ; 117118 ; You should have received a copy of the GNU Affero General Public License 117023 117119 "RTN","C0CRNF",16,0) 117024 ; You should have received a copy of the GNU General Public License along117120 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 117025 117121 "RTN","C0CRNF",17,0) 117026 ; with this program; if not, write to the Free Software Foundation, Inc.,117122 ; 117027 117123 "RTN","C0CRNF",18,0) 117028 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.117124 W "This is the Reference Name Format (RNF) Utility Library ",! 117029 117125 "RTN","C0CRNF",19,0) 117030 ;117126 W ! 117031 117127 "RTN","C0CRNF",20,0) 117032 W "This is the Reference Name Format (RNF) Utility Library ",!117128 Q 117033 117129 "RTN","C0CRNF",21,0) 117034 W !117130 ; 117035 117131 "RTN","C0CRNF",22,0) 117132 FIELDS(C0CFRTN,C0CF) ; RETURNS AN ARRAY OF THE FIELDS IN FILE C0CF, 117133 "RTN","C0CRNF",23,0) 117134 ; C0CFRTN IS PASSED BY NAME, C0CF IS PASSED BY VALUE 117135 "RTN","C0CRNF",24,0) 117136 ; 117137 "RTN","C0CRNF",25,0) 117138 N C0CFI,C0CFJ ;INNER LOOP, OUTER LOOP 117139 "RTN","C0CRNF",26,0) 117140 N C0CFN ; FIELD NAME 117141 "RTN","C0CRNF",27,0) 117142 S C0CFI=0 S C0CFJ=C0CF 117143 "RTN","C0CRNF",28,0) 117144 K @C0CFRTN ; CLEAR THE RETURN ARRAY 117145 "RTN","C0CRNF",29,0) 117146 F Q:C0CFJ'[C0CF D ; FOR THE C0CF FILE AND ALL SUBFILES INCLUSIVE 117147 "RTN","C0CRNF",30,0) 117148 . ;W "1: "_C0CFJ," ",C0CFI,! 117149 "RTN","C0CRNF",31,0) 117150 . F S C0CFI=$O(^DD(C0CFJ,C0CFI)) Q:+C0CFI=0 D ; EVERY FIELD 117151 "RTN","C0CRNF",32,0) 117152 . . ;W "2: "_C0CFJ," ",C0CFI,! 117153 "RTN","C0CRNF",33,0) 117154 . . S C0CFN=$P($G(^DD(C0CFJ,C0CFI,0)),"^",1) ;PULL FIELD NAME FROM ^DD 117155 "RTN","C0CRNF",34,0) 117156 . . ;W "N: ",C0CFN,! 117157 "RTN","C0CRNF",35,0) 117158 . . ;I C0CFN="STR" W C0CFN," ",C0CFJ,! 117159 "RTN","C0CRNF",36,0) 117160 . . I $D(@C0CFRTN@(C0CFN)) D ; IS THIS A DUPLICATE? 117161 "RTN","C0CRNF",37,0) 117162 . . . I $G(DEBUG) D ; 117163 "RTN","C0CRNF",38,0) 117164 . . . . W "DUPLICATE FOUND! ",C0CFJ," ",C0CFI," ",C0CFN,!,@C0CFRTN@(C0CFN),! 117165 "RTN","C0CRNF",39,0) 117166 . . . S @C0CFRTN@(C0CFN_"_"_C0CFJ)=C0CFJ_"^"_C0CFI 117167 "RTN","C0CRNF",40,0) 117168 . . E S @C0CFRTN@(C0CFN)=C0CFJ_"^"_C0CFI 117169 "RTN","C0CRNF",41,0) 117170 . S C0CFJ=$O(^DD(C0CFJ)) ; NEXT SUBFILE 117171 "RTN","C0CRNF",42,0) 117036 117172 Q 117037 "RTN","C0CRNF",23,0)117038 ;117039 "RTN","C0CRNF",24,0)117040 FIELDS(C0CFRTN,C0CF) ; RETURNS AN ARRAY OF THE FIELDS IN FILE C0CF,117041 "RTN","C0CRNF",25,0)117042 ; C0CFRTN IS PASSED BY NAME, C0CF IS PASSED BY VALUE117043 "RTN","C0CRNF",26,0)117044 ;117045 "RTN","C0CRNF",27,0)117046 N C0CFI,C0CFJ ;INNER LOOP, OUTER LOOP117047 "RTN","C0CRNF",28,0)117048 N C0CFN ; FIELD NAME117049 "RTN","C0CRNF",29,0)117050 S C0CFI=0 S C0CFJ=C0CF117051 "RTN","C0CRNF",30,0)117052 K @C0CFRTN ; CLEAR THE RETURN ARRAY117053 "RTN","C0CRNF",31,0)117054 F Q:C0CFJ'[C0CF D ; FOR THE C0CF FILE AND ALL SUBFILES INCLUSIVE117055 "RTN","C0CRNF",32,0)117056 . ;W "1: "_C0CFJ," ",C0CFI,!117057 "RTN","C0CRNF",33,0)117058 . F S C0CFI=$O(^DD(C0CFJ,C0CFI)) Q:+C0CFI=0 D ; EVERY FIELD117059 "RTN","C0CRNF",34,0)117060 . . ;W "2: "_C0CFJ," ",C0CFI,!117061 "RTN","C0CRNF",35,0)117062 . . S C0CFN=$P($G(^DD(C0CFJ,C0CFI,0)),"^",1) ;PULL FIELD NAME FROM ^DD117063 "RTN","C0CRNF",36,0)117064 . . ;W "N: ",C0CFN,!117065 "RTN","C0CRNF",37,0)117066 . . ;I C0CFN="STR" W C0CFN," ",C0CFJ,!117067 "RTN","C0CRNF",38,0)117068 . . I $D(@C0CFRTN@(C0CFN)) D ; IS THIS A DUPLICATE?117069 "RTN","C0CRNF",39,0)117070 . . . I $G(DEBUG) D ;117071 "RTN","C0CRNF",40,0)117072 . . . . W "DUPLICATE FOUND! ",C0CFJ," ",C0CFI," ",C0CFN,!,@C0CFRTN@(C0CFN),!117073 "RTN","C0CRNF",41,0)117074 . . . S @C0CFRTN@(C0CFN_"_"_C0CFJ)=C0CFJ_"^"_C0CFI117075 "RTN","C0CRNF",42,0)117076 . . E S @C0CFRTN@(C0CFN)=C0CFJ_"^"_C0CFI117077 117173 "RTN","C0CRNF",43,0) 117078 . S C0CFJ=$O(^DD(C0CFJ)) ; NEXT SUBFILE117174 ; 117079 117175 "RTN","C0CRNF",44,0) 117176 TESTRNF ; TEST THE RNF1TO2 ROUTINE 117177 "RTN","C0CRNF",45,0) 117178 S G1("ONE")=1 117179 "RTN","C0CRNF",46,0) 117180 S G1("TWO")=2 117181 "RTN","C0CRNF",47,0) 117182 S G1("THREE")=3 117183 "RTN","C0CRNF",48,0) 117184 D RNF1TO2("GPL","G1") 117185 "RTN","C0CRNF",49,0) 117186 S G1("ONE")="NOT1" 117187 "RTN","C0CRNF",50,0) 117188 S G1("TWO")="STILL2" 117189 "RTN","C0CRNF",51,0) 117190 S G1("THREE")=3 117191 "RTN","C0CRNF",52,0) 117192 D RNF1TO2("GPL","G1") 117193 "RTN","C0CRNF",53,0) 117194 ; ZWR GPL 117195 "RTN","C0CRNF",54,0) 117080 117196 Q 117081 "RTN","C0CRNF",45,0)117082 ;117083 "RTN","C0CRNF",46,0)117084 TESTRNF ; TEST THE RNF1TO2 ROUTINE117085 "RTN","C0CRNF",47,0)117086 S G1("ONE")=1117087 "RTN","C0CRNF",48,0)117088 S G1("TWO")=2117089 "RTN","C0CRNF",49,0)117090 S G1("THREE")=3117091 "RTN","C0CRNF",50,0)117092 D RNF1TO2("GPL","G1")117093 "RTN","C0CRNF",51,0)117094 S G1("ONE")="NOT1"117095 "RTN","C0CRNF",52,0)117096 S G1("TWO")="STILL2"117097 "RTN","C0CRNF",53,0)117098 S G1("THREE")=3117099 "RTN","C0CRNF",54,0)117100 D RNF1TO2("GPL","G1")117101 117197 "RTN","C0CRNF",55,0) 117102 ZWR GPL117198 ; 117103 117199 "RTN","C0CRNF",56,0) 117200 RNF1TO2(ZOUT,ZIN) ; ADDS AN RNF1 ARRAY (ZIN) TO THE END OF AN RNF2 ARRAY 117201 "RTN","C0CRNF",57,0) 117202 ; (ZOUT) BOTH ARE PASSED BY NAME 117203 "RTN","C0CRNF",58,0) 117204 ; RNF1 IS OF THE FORM: 117205 "RTN","C0CRNF",59,0) 117206 ; @ZIN@("VAR1")=VAL1 117207 "RTN","C0CRNF",60,0) 117208 ; @ZIN@("VAR2")=VAL2 117209 "RTN","C0CRNF",61,0) 117210 ; RNF2 IS OF THE FORM: 117211 "RTN","C0CRNF",62,0) 117212 ; @ZOUT@("F","VAR1")="" 117213 "RTN","C0CRNF",63,0) 117214 ; @ZOUT@("F","VAR2")="" 117215 "RTN","C0CRNF",64,0) 117216 ; @ZOUT@("V",n,"VAR1")=VAL1 117217 "RTN","C0CRNF",65,0) 117218 ; @ZOUT@("V",n,"VAR2")=VAL2 117219 "RTN","C0CRNF",66,0) 117220 ; WHERE n IS THE "ROW" OF THE ARRAY 117221 "RTN","C0CRNF",67,0) 117222 N ZI S ZI="" 117223 "RTN","C0CRNF",68,0) 117224 N ZN 117225 "RTN","C0CRNF",69,0) 117226 I '$D(@ZOUT@("V",1)) S ZN=1 117227 "RTN","C0CRNF",70,0) 117228 E S ZN=$O(@ZOUT@("V",""),-1)+1 117229 "RTN","C0CRNF",71,0) 117230 F S ZI=$O(@ZIN@(ZI)) Q:ZI="" D ; 117231 "RTN","C0CRNF",72,0) 117232 . S @ZOUT@("F",ZI)="" 117233 "RTN","C0CRNF",73,0) 117234 . S @ZOUT@("V",ZN,ZI)=@ZIN@(ZI) 117235 "RTN","C0CRNF",74,0) 117104 117236 Q 117105 "RTN","C0CRNF",57,0) 117106 ; 117107 "RTN","C0CRNF",58,0) 117108 RNF1TO2(ZOUT,ZIN) ; ADDS AN RNF1 ARRAY (ZIN) TO THE END OF AN RNF2 ARRAY 117109 "RTN","C0CRNF",59,0) 117237 "RTN","C0CRNF",75,0) 117238 ; 117239 "RTN","C0CRNF",76,0) 117240 RNF1TO2B(ZOUT,ZIN) ; ADDS AN RNF1 ARRAY (ZIN) TO THE END OF AN RNF2 ARRAY 117241 "RTN","C0CRNF",77,0) 117242 ; THE "B" ROUTINE SUPPORTS WP FIELDS IN THE ARRAY 117243 "RTN","C0CRNF",78,0) 117244 ; EVERY "V" VARIABLE IS FOLLOWED BY A "1" 117245 "RTN","C0CRNF",79,0) 117246 ; FOR EXAMPLE @G@("V",n,"VAR1",1)="VALUE1" 117247 "RTN","C0CRNF",80,0) 117248 ; USE THIS ROUTINE IF YOU WANT TO CONVERT THE RESULT TO A CSV 117249 "RTN","C0CRNF",81,0) 117250 ; WITH RNF2CSV 117251 "RTN","C0CRNF",82,0) 117110 117252 ; (ZOUT) BOTH ARE PASSED BY NAME 117111 "RTN","C0CRNF", 60,0)117253 "RTN","C0CRNF",83,0) 117112 117254 ; RNF1 IS OF THE FORM: 117113 "RTN","C0CRNF", 61,0)117255 "RTN","C0CRNF",84,0) 117114 117256 ; @ZIN@("VAR1")=VAL1 117115 "RTN","C0CRNF", 62,0)117257 "RTN","C0CRNF",85,0) 117116 117258 ; @ZIN@("VAR2")=VAL2 117117 "RTN","C0CRNF", 63,0)117259 "RTN","C0CRNF",86,0) 117118 117260 ; RNF2 IS OF THE FORM: 117119 "RTN","C0CRNF", 64,0)117261 "RTN","C0CRNF",87,0) 117120 117262 ; @ZOUT@("F","VAR1")="" 117121 "RTN","C0CRNF", 65,0)117263 "RTN","C0CRNF",88,0) 117122 117264 ; @ZOUT@("F","VAR2")="" 117123 "RTN","C0CRNF", 66,0)117124 ; @ZOUT@("V",n,"VAR1" )=VAL1117125 "RTN","C0CRNF", 67,0)117126 ; @ZOUT@("V",n,"VAR2" )=VAL2117127 "RTN","C0CRNF", 68,0)117265 "RTN","C0CRNF",89,0) 117266 ; @ZOUT@("V",n,"VAR1",1)=VAL1 117267 "RTN","C0CRNF",90,0) 117268 ; @ZOUT@("V",n,"VAR2",1)=VAL2 117269 "RTN","C0CRNF",91,0) 117128 117270 ; WHERE n IS THE "ROW" OF THE ARRAY 117129 "RTN","C0CRNF", 69,0)117271 "RTN","C0CRNF",92,0) 117130 117272 N ZI S ZI="" 117131 "RTN","C0CRNF", 70,0)117273 "RTN","C0CRNF",93,0) 117132 117274 N ZN 117133 "RTN","C0CRNF", 71,0)117275 "RTN","C0CRNF",94,0) 117134 117276 I '$D(@ZOUT@("V",1)) S ZN=1 117135 "RTN","C0CRNF", 72,0)117277 "RTN","C0CRNF",95,0) 117136 117278 E S ZN=$O(@ZOUT@("V",""),-1)+1 117137 "RTN","C0CRNF", 73,0)117279 "RTN","C0CRNF",96,0) 117138 117280 F S ZI=$O(@ZIN@(ZI)) Q:ZI="" D ; 117139 "RTN","C0CRNF", 74,0)117281 "RTN","C0CRNF",97,0) 117140 117282 . S @ZOUT@("F",ZI)="" 117141 "RTN","C0CRNF", 75,0)117142 . S @ZOUT@("V",ZN,ZI )=@ZIN@(ZI)117143 "RTN","C0CRNF", 76,0)117283 "RTN","C0CRNF",98,0) 117284 . S @ZOUT@("V",ZN,ZI,1)=@ZIN@(ZI) 117285 "RTN","C0CRNF",99,0) 117144 117286 Q 117145 "RTN","C0CRNF",77,0)117146 ;117147 "RTN","C0CRNF",78,0)117148 RNF1TO2B(ZOUT,ZIN) ; ADDS AN RNF1 ARRAY (ZIN) TO THE END OF AN RNF2 ARRAY117149 "RTN","C0CRNF",79,0)117150 ; THE "B" ROUTINE SUPPORTS WP FIELDS IN THE ARRAY117151 "RTN","C0CRNF",80,0)117152 ; EVERY "V" VARIABLE IS FOLLOWED BY A "1"117153 "RTN","C0CRNF",81,0)117154 ; FOR EXAMPLE @G@("V",n,"VAR1",1)="VALUE1"117155 "RTN","C0CRNF",82,0)117156 ; USE THIS ROUTINE IF YOU WANT TO CONVERT THE RESULT TO A CSV117157 "RTN","C0CRNF",83,0)117158 ; WITH RNF2CSV117159 "RTN","C0CRNF",84,0)117160 ; (ZOUT) BOTH ARE PASSED BY NAME117161 "RTN","C0CRNF",85,0)117162 ; RNF1 IS OF THE FORM:117163 "RTN","C0CRNF",86,0)117164 ; @ZIN@("VAR1")=VAL1117165 "RTN","C0CRNF",87,0)117166 ; @ZIN@("VAR2")=VAL2117167 "RTN","C0CRNF",88,0)117168 ; RNF2 IS OF THE FORM:117169 "RTN","C0CRNF",89,0)117170 ; @ZOUT@("F","VAR1")=""117171 "RTN","C0CRNF",90,0)117172 ; @ZOUT@("F","VAR2")=""117173 "RTN","C0CRNF",91,0)117174 ; @ZOUT@("V",n,"VAR1",1)=VAL1117175 "RTN","C0CRNF",92,0)117176 ; @ZOUT@("V",n,"VAR2",1)=VAL2117177 "RTN","C0CRNF",93,0)117178 ; WHERE n IS THE "ROW" OF THE ARRAY117179 "RTN","C0CRNF",94,0)117180 N ZI S ZI=""117181 "RTN","C0CRNF",95,0)117182 N ZN117183 "RTN","C0CRNF",96,0)117184 I '$D(@ZOUT@("V",1)) S ZN=1117185 "RTN","C0CRNF",97,0)117186 E S ZN=$O(@ZOUT@("V",""),-1)+1117187 "RTN","C0CRNF",98,0)117188 F S ZI=$O(@ZIN@(ZI)) Q:ZI="" D ;117189 "RTN","C0CRNF",99,0)117190 . S @ZOUT@("F",ZI)=""117191 117287 "RTN","C0CRNF",100,0) 117192 . S @ZOUT@("V",ZN,ZI,1)=@ZIN@(ZI)117288 ; 117193 117289 "RTN","C0CRNF",101,0) 117290 GETNOLD(GRTN,GFILE,GIEN,GNN) ; GET FIELDS FOR ACCESS BY NAME 117291 "RTN","C0CRNF",102,0) 117292 ; GRTN IS PASSED BY NAME 117293 "RTN","C0CRNF",103,0) 117294 ; 117295 "RTN","C0CRNF",104,0) 117296 N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME 117297 "RTN","C0CRNF",105,0) 117298 I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED) 117299 "RTN","C0CRNF",106,0) 117300 E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED) 117301 "RTN","C0CRNF",107,0) 117302 S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE 117303 "RTN","C0CRNF",108,0) 117304 D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP 117305 "RTN","C0CRNF",109,0) 117306 D GETS^DIQ(GFILE,C0CREF,"**","I","C0CTMP") 117307 "RTN","C0CRNF",110,0) 117308 D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE 117309 "RTN","C0CRNF",111,0) 117310 S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J ; STRUCTURE SIGNATURE 117311 "RTN","C0CRNF",112,0) 117312 S (C0CI,C0CJ)="" 117313 "RTN","C0CRNF",113,0) 117314 F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES 117315 "RTN","C0CRNF",114,0) 117316 . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE 117317 "RTN","C0CRNF",115,0) 117318 . F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS 117319 "RTN","C0CRNF",116,0) 117320 . . ;W C0CJ," ",C0CI,! 117321 "RTN","C0CRNF",117,0) 117322 . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME 117323 "RTN","C0CRNF",118,0) 117324 . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI) ; 117325 "RTN","C0CRNF",119,0) 117326 . . I C0CVALUE["C0CTMP" S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,1) ;1ST LINE OF WP 117327 "RTN","C0CRNF",120,0) 117328 . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3 117329 "RTN","C0CRNF",121,0) 117330 I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED 117331 "RTN","C0CRNF",122,0) 117332 . S C0CI="" 117333 "RTN","C0CRNF",123,0) 117334 . F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY 117335 "RTN","C0CRNF",124,0) 117336 . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES 117337 "RTN","C0CRNF",125,0) 117194 117338 Q 117195 "RTN","C0CRNF",102,0) 117196 ; 117197 "RTN","C0CRNF",103,0) 117198 GETNOLD(GRTN,GFILE,GIEN,GNN) ; GET FIELDS FOR ACCESS BY NAME 117199 "RTN","C0CRNF",104,0) 117200 ; GRTN IS PASSED BY NAME 117201 "RTN","C0CRNF",105,0) 117202 ; 117203 "RTN","C0CRNF",106,0) 117204 N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME 117205 "RTN","C0CRNF",107,0) 117339 "RTN","C0CRNF",126,0) 117340 ; 117341 "RTN","C0CRNF",127,0) 117342 GETN(GRTN,GFILE,GREF,GNDX,GNN) ; GET BY NAME ; RETURN A FIELD VALUE MAP 117343 "RTN","C0CRNF",128,0) 117344 ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1 117345 "RTN","C0CRNF",129,0) 117346 ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL 117347 "RTN","C0CRNF",130,0) 117348 ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN 117349 "RTN","C0CRNF",131,0) 117350 ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP 117351 "RTN","C0CRNF",132,0) 117352 ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")="" 117353 "RTN","C0CRNF",133,0) 117354 ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP 117355 "RTN","C0CRNF",134,0) 117356 ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE 117357 "RTN","C0CRNF",135,0) 117358 ; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE 117359 "RTN","C0CRNF",136,0) 117360 ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP 117361 "RTN","C0CRNF",137,0) 117362 ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP 117363 "RTN","C0CRNF",138,0) 117364 ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE 117365 "RTN","C0CRNF",139,0) 117366 ; IF GREF IS "" THE FIRST RECORD IS OBTAINED 117367 "RTN","C0CRNF",140,0) 117368 ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE 117369 "RTN","C0CRNF",141,0) 117370 ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN 117371 "RTN","C0CRNF",142,0) 117372 ; GREF IS THE VALUE FOR THE INDEX 117373 "RTN","C0CRNF",143,0) 117374 ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED 117375 "RTN","C0CRNF",144,0) 117376 ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN 117377 "RTN","C0CRNF",145,0) 117378 ; 117379 "RTN","C0CRNF",146,0) 117380 ; 117381 "RTN","C0CRNF",147,0) 117382 N GIEN,GF 117383 "RTN","C0CRNF",148,0) 117384 S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE 117385 "RTN","C0CRNF",149,0) 117386 I ('$D(GNDX))!($G(GNDX)="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN 117387 "RTN","C0CRNF",150,0) 117388 E D ; WE ARE USING AN INDEX 117389 "RTN","C0CRNF",151,0) 117390 . ;N ZG 117391 "RTN","C0CRNF",152,0) 117392 . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX 117393 "RTN","C0CRNF",153,0) 117394 . I ZG'="" D ; 117395 "RTN","C0CRNF",154,0) 117396 . . I $QS(ZG,3)=GREF D ; IS GREF IN INDEX? 117397 "RTN","C0CRNF",155,0) 117398 . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN 117399 "RTN","C0CRNF",156,0) 117400 . . E S GIEN="" ; NOT FOUND IN INDEX 117401 "RTN","C0CRNF",157,0) 117402 . E S GIEN="" ; 117403 "RTN","C0CRNF",158,0) 117404 ;W "IEN: ",GIEN,! 117405 "RTN","C0CRNF",159,0) 117406 ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME 117407 "RTN","C0CRNF",160,0) 117206 117408 I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED) 117207 "RTN","C0CRNF",1 08,0)117409 "RTN","C0CRNF",161,0) 117208 117410 E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED) 117209 "RTN","C0CRNF",1 09,0)117411 "RTN","C0CRNF",162,0) 117210 117412 S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE 117211 "RTN","C0CRNF",1 10,0)117413 "RTN","C0CRNF",163,0) 117212 117414 D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP 117213 "RTN","C0CRNF",111,0) 117214 D GETS^DIQ(GFILE,C0CREF,"**","I","C0CTMP") 117215 "RTN","C0CRNF",112,0) 117415 "RTN","C0CRNF",164,0) 117416 K C0CTMP 117417 "RTN","C0CRNF",165,0) 117418 D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP") 117419 "RTN","C0CRNF",166,0) 117216 117420 D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE 117217 "RTN","C0CRNF",1 13,0)117218 S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J ; STRUCTURE SIGNATURE117219 "RTN","C0CRNF",1 14,0)117421 "RTN","C0CRNF",167,0) 117422 S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE 117423 "RTN","C0CRNF",168,0) 117220 117424 S (C0CI,C0CJ)="" 117221 "RTN","C0CRNF",1 15,0)117425 "RTN","C0CRNF",169,0) 117222 117426 F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES 117223 "RTN","C0CRNF",1 16,0)117427 "RTN","C0CRNF",170,0) 117224 117428 . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE 117225 "RTN","C0CRNF",1 17,0)117429 "RTN","C0CRNF",171,0) 117226 117430 . F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS 117227 "RTN","C0CRNF",1 18,0)117431 "RTN","C0CRNF",172,0) 117228 117432 . . ;W C0CJ," ",C0CI,! 117229 "RTN","C0CRNF",1 19,0)117433 "RTN","C0CRNF",173,0) 117230 117434 . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME 117231 "RTN","C0CRNF",120,0) 117232 . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI) ; 117233 "RTN","C0CRNF",121,0) 117234 . . I C0CVALUE["C0CTMP" S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,1) ;1ST LINE OF WP 117235 "RTN","C0CRNF",122,0) 117435 "RTN","C0CRNF",174,0) 117436 . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ; 117437 "RTN","C0CRNF",175,0) 117438 . . I C0CVALUE["C0CTMP" D ; WP FIELD 117439 "RTN","C0CRNF",176,0) 117440 . . . N ZT,ZWP S ZWP=0 ;ITERATOR 117441 "RTN","C0CRNF",177,0) 117442 . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE 117443 "RTN","C0CRNF",178,0) 117444 . . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE 117445 "RTN","C0CRNF",179,0) 117446 . . . F S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP D ; 117447 "RTN","C0CRNF",180,0) 117448 . . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP 117449 "RTN","C0CRNF",181,0) 117450 . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT " 117451 "RTN","C0CRNF",182,0) 117452 . . . . S C0CVALUE=C0CVALUE_ZT ; 117453 "RTN","C0CRNF",183,0) 117236 117454 . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3 117237 "RTN","C0CRNF",123,0) 117455 "RTN","C0CRNF",184,0) 117456 . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I")) 117457 "RTN","C0CRNF",185,0) 117238 117458 I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED 117239 "RTN","C0CRNF",1 24,0)117459 "RTN","C0CRNF",186,0) 117240 117460 . S C0CI="" 117241 "RTN","C0CRNF",1 25,0)117461 "RTN","C0CRNF",187,0) 117242 117462 . F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY 117243 "RTN","C0CRNF",1 26,0)117463 "RTN","C0CRNF",188,0) 117244 117464 . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES 117245 "RTN","C0CRNF",1 27,0)117465 "RTN","C0CRNF",189,0) 117246 117466 Q 117247 "RTN","C0CRNF",1 28,0)117248 ; 117249 "RTN","C0CRNF",1 29,0)117250 GETN (GRTN,GFILE,GREF,GNDX,GNN) ; GET BY NAME; RETURN A FIELD VALUE MAP117251 "RTN","C0CRNF",1 30,0)117467 "RTN","C0CRNF",190,0) 117468 ; 117469 "RTN","C0CRNF",191,0) 117470 GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP 117471 "RTN","C0CRNF",192,0) 117252 117472 ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1 117253 "RTN","C0CRNF",1 31,0)117473 "RTN","C0CRNF",193,0) 117254 117474 ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL 117255 "RTN","C0CRNF",1 32,0)117475 "RTN","C0CRNF",194,0) 117256 117476 ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN 117257 "RTN","C0CRNF",1 33,0)117477 "RTN","C0CRNF",195,0) 117258 117478 ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP 117259 "RTN","C0CRNF",1 34,0)117479 "RTN","C0CRNF",196,0) 117260 117480 ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")="" 117261 "RTN","C0CRNF",1 35,0)117481 "RTN","C0CRNF",197,0) 117262 117482 ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP 117263 "RTN","C0CRNF",1 36,0)117483 "RTN","C0CRNF",198,0) 117264 117484 ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE 117265 "RTN","C0CRNF",1 37,0)117485 "RTN","C0CRNF",199,0) 117266 117486 ; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE 117267 "RTN","C0CRNF", 138,0)117487 "RTN","C0CRNF",200,0) 117268 117488 ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP 117269 "RTN","C0CRNF", 139,0)117489 "RTN","C0CRNF",201,0) 117270 117490 ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP 117271 "RTN","C0CRNF", 140,0)117491 "RTN","C0CRNF",202,0) 117272 117492 ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE 117273 "RTN","C0CRNF", 141,0)117493 "RTN","C0CRNF",203,0) 117274 117494 ; IF GREF IS "" THE FIRST RECORD IS OBTAINED 117275 "RTN","C0CRNF", 142,0)117495 "RTN","C0CRNF",204,0) 117276 117496 ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE 117277 "RTN","C0CRNF", 143,0)117497 "RTN","C0CRNF",205,0) 117278 117498 ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN 117279 "RTN","C0CRNF", 144,0)117499 "RTN","C0CRNF",206,0) 117280 117500 ; GREF IS THE VALUE FOR THE INDEX 117281 "RTN","C0CRNF", 145,0)117501 "RTN","C0CRNF",207,0) 117282 117502 ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED 117283 "RTN","C0CRNF", 146,0)117503 "RTN","C0CRNF",208,0) 117284 117504 ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN 117285 "RTN","C0CRNF", 147,0)117286 ; 117287 "RTN","C0CRNF", 148,0)117288 ; 117289 "RTN","C0CRNF", 149,0)117505 "RTN","C0CRNF",209,0) 117506 ; 117507 "RTN","C0CRNF",210,0) 117508 ; 117509 "RTN","C0CRNF",211,0) 117290 117510 N GIEN,GF 117291 "RTN","C0CRNF", 150,0)117511 "RTN","C0CRNF",212,0) 117292 117512 S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE 117293 "RTN","C0CRNF", 151,0)117294 I ('$D(GNDX))!( $G(GNDX)="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN117295 "RTN","C0CRNF", 152,0)117513 "RTN","C0CRNF",213,0) 117514 I ('$D(GNDX))!(GNDX="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN 117515 "RTN","C0CRNF",214,0) 117296 117516 E D ; WE ARE USING AN INDEX 117297 "RTN","C0CRNF", 153,0)117517 "RTN","C0CRNF",215,0) 117298 117518 . ;N ZG 117299 "RTN","C0CRNF", 154,0)117519 "RTN","C0CRNF",216,0) 117300 117520 . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX 117301 "RTN","C0CRNF", 155,0)117521 "RTN","C0CRNF",217,0) 117302 117522 . I ZG'="" D ; 117303 "RTN","C0CRNF", 156,0)117523 "RTN","C0CRNF",218,0) 117304 117524 . . I $QS(ZG,3)=GREF D ; IS GREF IN INDEX? 117305 "RTN","C0CRNF", 157,0)117525 "RTN","C0CRNF",219,0) 117306 117526 . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN 117307 "RTN","C0CRNF", 158,0)117527 "RTN","C0CRNF",220,0) 117308 117528 . . E S GIEN="" ; NOT FOUND IN INDEX 117309 "RTN","C0CRNF", 159,0)117529 "RTN","C0CRNF",221,0) 117310 117530 . E S GIEN="" ; 117311 "RTN","C0CRNF", 160,0)117531 "RTN","C0CRNF",222,0) 117312 117532 ;W "IEN: ",GIEN,! 117313 "RTN","C0CRNF", 161,0)117533 "RTN","C0CRNF",223,0) 117314 117534 ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME 117315 "RTN","C0CRNF", 162,0)117535 "RTN","C0CRNF",224,0) 117316 117536 I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED) 117317 "RTN","C0CRNF", 163,0)117537 "RTN","C0CRNF",225,0) 117318 117538 E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED) 117319 "RTN","C0CRNF", 164,0)117539 "RTN","C0CRNF",226,0) 117320 117540 S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE 117321 "RTN","C0CRNF", 165,0)117541 "RTN","C0CRNF",227,0) 117322 117542 D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP 117323 "RTN","C0CRNF", 166,0)117543 "RTN","C0CRNF",228,0) 117324 117544 K C0CTMP 117325 "RTN","C0CRNF", 167,0)117545 "RTN","C0CRNF",229,0) 117326 117546 D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP") 117327 "RTN","C0CRNF", 168,0)117547 "RTN","C0CRNF",230,0) 117328 117548 D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE 117329 "RTN","C0CRNF", 169,0)117549 "RTN","C0CRNF",231,0) 117330 117550 S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE 117331 "RTN","C0CRNF", 170,0)117551 "RTN","C0CRNF",232,0) 117332 117552 S (C0CI,C0CJ)="" 117333 "RTN","C0CRNF", 171,0)117553 "RTN","C0CRNF",233,0) 117334 117554 F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES 117335 "RTN","C0CRNF", 172,0)117555 "RTN","C0CRNF",234,0) 117336 117556 . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE 117337 "RTN","C0CRNF", 173,0)117557 "RTN","C0CRNF",235,0) 117338 117558 . F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS 117339 "RTN","C0CRNF", 174,0)117559 "RTN","C0CRNF",236,0) 117340 117560 . . ;W C0CJ," ",C0CI,! 117341 "RTN","C0CRNF", 175,0)117561 "RTN","C0CRNF",237,0) 117342 117562 . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME 117343 "RTN","C0CRNF", 176,0)117563 "RTN","C0CRNF",238,0) 117344 117564 . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ; 117345 "RTN","C0CRNF", 177,0)117565 "RTN","C0CRNF",239,0) 117346 117566 . . I C0CVALUE["C0CTMP" D ; WP FIELD 117347 "RTN","C0CRNF", 178,0)117567 "RTN","C0CRNF",240,0) 117348 117568 . . . N ZT,ZWP S ZWP=0 ;ITERATOR 117349 "RTN","C0CRNF", 179,0)117569 "RTN","C0CRNF",241,0) 117350 117570 . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE 117351 "RTN","C0CRNF", 180,0)117571 "RTN","C0CRNF",242,0) 117352 117572 . . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE 117353 "RTN","C0CRNF", 181,0)117573 "RTN","C0CRNF",243,0) 117354 117574 . . . F S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP D ; 117355 "RTN","C0CRNF", 182,0)117575 "RTN","C0CRNF",244,0) 117356 117576 . . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP 117357 "RTN","C0CRNF", 183,0)117577 "RTN","C0CRNF",245,0) 117358 117578 . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT " 117359 "RTN","C0CRNF", 184,0)117579 "RTN","C0CRNF",246,0) 117360 117580 . . . . S C0CVALUE=C0CVALUE_ZT ; 117361 "RTN","C0CRNF", 185,0)117581 "RTN","C0CRNF",247,0) 117362 117582 . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3 117363 "RTN","C0CRNF", 186,0)117583 "RTN","C0CRNF",248,0) 117364 117584 . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I")) 117365 "RTN","C0CRNF", 187,0)117585 "RTN","C0CRNF",249,0) 117366 117586 I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED 117367 "RTN","C0CRNF", 188,0)117587 "RTN","C0CRNF",250,0) 117368 117588 . S C0CI="" 117369 "RTN","C0CRNF", 189,0)117589 "RTN","C0CRNF",251,0) 117370 117590 . F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY 117371 "RTN","C0CRNF", 190,0)117591 "RTN","C0CRNF",252,0) 117372 117592 . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES 117373 "RTN","C0CRNF", 191,0)117593 "RTN","C0CRNF",253,0) 117374 117594 Q 117375 "RTN","C0CRNF",192,0) 117376 ; 117377 "RTN","C0CRNF",193,0) 117378 GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP 117379 "RTN","C0CRNF",194,0) 117380 ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1 117381 "RTN","C0CRNF",195,0) 117382 ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL 117383 "RTN","C0CRNF",196,0) 117384 ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN 117385 "RTN","C0CRNF",197,0) 117386 ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP 117387 "RTN","C0CRNF",198,0) 117388 ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")="" 117389 "RTN","C0CRNF",199,0) 117595 "RTN","C0CRNF",254,0) 117596 ; 117597 "RTN","C0CRNF",255,0) 117598 GETN2(GARTN,GAFILE,GAIDX,GACNT,GASTRT,GANN) ; RETURN FIELD MAP AND VALUES 117599 "RTN","C0CRNF",256,0) 117600 ; GARTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP 117601 "RTN","C0CRNF",257,0) 117602 ; .. FIELD MAP @GARTN@("F","FIELDNAME")="FILE;FIELD#" 117603 "RTN","C0CRNF",258,0) 117390 117604 ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP 117391 "RTN","C0CRNF",200,0) 117392 ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE 117393 "RTN","C0CRNF",201,0) 117394 ; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE 117395 "RTN","C0CRNF",202,0) 117396 ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP 117397 "RTN","C0CRNF",203,0) 117398 ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP 117399 "RTN","C0CRNF",204,0) 117605 "RTN","C0CRNF",259,0) 117606 ; .. VALUE MAP @GARTN@("V","IEN","FIELDNAME","N")=VALUE 117607 "RTN","C0CRNF",260,0) 117608 ; .. WHERE N IS THE INDEX FOR MULTIPLES.. 1 FOR SINGLE VALUES 117609 "RTN","C0CRNF",261,0) 117610 ; .. GARTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE 117611 "RTN","C0CRNF",262,0) 117612 ; .. IF GANN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP 117613 "RTN","C0CRNF",263,0) 117614 ; .. EVEN IF GANN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP 117615 "RTN","C0CRNF",264,0) 117400 117616 ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE 117401 "RTN","C0CRNF",205,0) 117402 ; IF GREF IS "" THE FIRST RECORD IS OBTAINED 117403 "RTN","C0CRNF",206,0) 117404 ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE 117405 "RTN","C0CRNF",207,0) 117406 ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN 117407 "RTN","C0CRNF",208,0) 117408 ; GREF IS THE VALUE FOR THE INDEX 117409 "RTN","C0CRNF",209,0) 117617 "RTN","C0CRNF",265,0) 117618 ; GAFILE IS THE FILE NUMBER TO BE PROCESSED. IT IS PASSED BY VALUE 117619 "RTN","C0CRNF",266,0) 117620 ; GAIDX IS THE OPTIONAL INDEX TO USE IN THE FILE. IF GAIDX IS "" THE IEN 117621 "RTN","C0CRNF",267,0) 117622 ; .. OF THE FILE WILL BE USED 117623 "RTN","C0CRNF",268,0) 117624 ; GACNT IS THE NUMBER OF RECORDS TO PROCESS. IT IS PASSED BY VALUE 117625 "RTN","C0CRNF",269,0) 117626 ; .. IF GARCNT IS NULL, ALL RECORDS ARE PROCESSED 117627 "RTN","C0CRNF",270,0) 117628 ; GASTRT IS THE IEN OF THE FIRST RECORD TO PROCESS. IT IS PASSED BY VALUE 117629 "RTN","C0CRNF",271,0) 117630 ; .. IF GARSTART IS NULL, PROCESSING STARTS AT THE FIRST RECORD 117631 "RTN","C0CRNF",272,0) 117410 117632 ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED 117411 "RTN","C0CRNF",210,0) 117412 ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN 117413 "RTN","C0CRNF",211,0) 117414 ; 117415 "RTN","C0CRNF",212,0) 117416 ; 117417 "RTN","C0CRNF",213,0) 117418 N GIEN,GF 117419 "RTN","C0CRNF",214,0) 117420 S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE 117421 "RTN","C0CRNF",215,0) 117422 I ('$D(GNDX))!(GNDX="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN 117423 "RTN","C0CRNF",216,0) 117424 E D ; WE ARE USING AN INDEX 117425 "RTN","C0CRNF",217,0) 117426 . ;N ZG 117427 "RTN","C0CRNF",218,0) 117428 . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX 117429 "RTN","C0CRNF",219,0) 117430 . I ZG'="" D ; 117431 "RTN","C0CRNF",220,0) 117432 . . I $QS(ZG,3)=GREF D ; IS GREF IN INDEX? 117433 "RTN","C0CRNF",221,0) 117434 . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN 117435 "RTN","C0CRNF",222,0) 117436 . . E S GIEN="" ; NOT FOUND IN INDEX 117437 "RTN","C0CRNF",223,0) 117438 . E S GIEN="" ; 117439 "RTN","C0CRNF",224,0) 117440 ;W "IEN: ",GIEN,! 117441 "RTN","C0CRNF",225,0) 117442 ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME 117443 "RTN","C0CRNF",226,0) 117444 I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED) 117445 "RTN","C0CRNF",227,0) 117446 E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED) 117447 "RTN","C0CRNF",228,0) 117448 S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE 117449 "RTN","C0CRNF",229,0) 117450 D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP 117451 "RTN","C0CRNF",230,0) 117452 K C0CTMP 117453 "RTN","C0CRNF",231,0) 117454 D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP") 117455 "RTN","C0CRNF",232,0) 117456 D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE 117457 "RTN","C0CRNF",233,0) 117458 S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE 117459 "RTN","C0CRNF",234,0) 117460 S (C0CI,C0CJ)="" 117461 "RTN","C0CRNF",235,0) 117462 F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES 117463 "RTN","C0CRNF",236,0) 117464 . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE 117465 "RTN","C0CRNF",237,0) 117466 . F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS 117467 "RTN","C0CRNF",238,0) 117468 . . ;W C0CJ," ",C0CI,! 117469 "RTN","C0CRNF",239,0) 117470 . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME 117471 "RTN","C0CRNF",240,0) 117472 . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ; 117473 "RTN","C0CRNF",241,0) 117474 . . I C0CVALUE["C0CTMP" D ; WP FIELD 117475 "RTN","C0CRNF",242,0) 117476 . . . N ZT,ZWP S ZWP=0 ;ITERATOR 117477 "RTN","C0CRNF",243,0) 117478 . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE 117479 "RTN","C0CRNF",244,0) 117480 . . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE 117481 "RTN","C0CRNF",245,0) 117482 . . . F S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP D ; 117483 "RTN","C0CRNF",246,0) 117484 . . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP 117485 "RTN","C0CRNF",247,0) 117486 . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT " 117487 "RTN","C0CRNF",248,0) 117488 . . . . S C0CVALUE=C0CVALUE_ZT ; 117489 "RTN","C0CRNF",249,0) 117490 . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3 117491 "RTN","C0CRNF",250,0) 117492 . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I")) 117493 "RTN","C0CRNF",251,0) 117494 I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED 117495 "RTN","C0CRNF",252,0) 117496 . S C0CI="" 117497 "RTN","C0CRNF",253,0) 117498 . F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY 117499 "RTN","C0CRNF",254,0) 117500 . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES 117501 "RTN","C0CRNF",255,0) 117633 "RTN","C0CRNF",273,0) 117634 ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GARFLD AND GARVAL 117635 "RTN","C0CRNF",274,0) 117636 ;N GATMP,GAI,GAF 117637 "RTN","C0CRNF",275,0) 117638 S GAF=$$FILEREF(GAFILE) ; GET CLOSED ROOT FOR THE FILE NUMBER GAFILE 117639 "RTN","C0CRNF",276,0) 117640 I '$D(GAIDX) S GAIDX="" ;DEFAULT 117641 "RTN","C0CRNF",277,0) 117642 I '$D(GANN) S GANN="" ;DEFAULT ONLY POPULATED FIELDS RETURNED 117643 "RTN","C0CRNF",278,0) 117644 I GAIDX'="" S GAF=$NA(@GAF@(GAIDX)) ; IF WE ARE USING AN INDEX 117645 "RTN","C0CRNF",279,0) 117646 W GAF,! 117647 "RTN","C0CRNF",280,0) 117648 W $O(@GAF@(0)) ; 117649 "RTN","C0CRNF",281,0) 117650 S GAI=0 ;ITERATOR 117651 "RTN","C0CRNF",282,0) 117652 F S GAI=$O(@GAF@(GAI)) Q:GAI="" D ; 117653 "RTN","C0CRNF",283,0) 117654 . D GETN1("GATMP",GAFILE,GAI,GAIDX,GANN) ;GET ONE RECORD 117655 "RTN","C0CRNF",284,0) 117656 . N GAX S GAX=0 117657 "RTN","C0CRNF",285,0) 117658 . F S GAX=$O(GATMP(GAX)) Q:GAX="" D ;PULL OUT THE FIELDS 117659 "RTN","C0CRNF",286,0) 117660 . . D ADDNV(GARTN,GAI,GAX,GATMP(GAX)) ;INSERT THE NAME/VALUE INTO GARTN 117661 "RTN","C0CRNF",287,0) 117502 117662 Q 117503 "RTN","C0CRNF",256,0)117504 ;117505 "RTN","C0CRNF",257,0)117506 GETN2(GARTN,GAFILE,GAIDX,GACNT,GASTRT,GANN) ; RETURN FIELD MAP AND VALUES117507 "RTN","C0CRNF",258,0)117508 ; GARTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP117509 "RTN","C0CRNF",259,0)117510 ; .. FIELD MAP @GARTN@("F","FIELDNAME")="FILE;FIELD#"117511 "RTN","C0CRNF",260,0)117512 ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP117513 "RTN","C0CRNF",261,0)117514 ; .. VALUE MAP @GARTN@("V","IEN","FIELDNAME","N")=VALUE117515 "RTN","C0CRNF",262,0)117516 ; .. WHERE N IS THE INDEX FOR MULTIPLES.. 1 FOR SINGLE VALUES117517 "RTN","C0CRNF",263,0)117518 ; .. GARTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE117519 "RTN","C0CRNF",264,0)117520 ; .. IF GANN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP117521 "RTN","C0CRNF",265,0)117522 ; .. EVEN IF GANN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP117523 "RTN","C0CRNF",266,0)117524 ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE117525 "RTN","C0CRNF",267,0)117526 ; GAFILE IS THE FILE NUMBER TO BE PROCESSED. IT IS PASSED BY VALUE117527 "RTN","C0CRNF",268,0)117528 ; GAIDX IS THE OPTIONAL INDEX TO USE IN THE FILE. IF GAIDX IS "" THE IEN117529 "RTN","C0CRNF",269,0)117530 ; .. OF THE FILE WILL BE USED117531 "RTN","C0CRNF",270,0)117532 ; GACNT IS THE NUMBER OF RECORDS TO PROCESS. IT IS PASSED BY VALUE117533 "RTN","C0CRNF",271,0)117534 ; .. IF GARCNT IS NULL, ALL RECORDS ARE PROCESSED117535 "RTN","C0CRNF",272,0)117536 ; GASTRT IS THE IEN OF THE FIRST RECORD TO PROCESS. IT IS PASSED BY VALUE117537 "RTN","C0CRNF",273,0)117538 ; .. IF GARSTART IS NULL, PROCESSING STARTS AT THE FIRST RECORD117539 "RTN","C0CRNF",274,0)117540 ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED117541 "RTN","C0CRNF",275,0)117542 ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GARFLD AND GARVAL117543 "RTN","C0CRNF",276,0)117544 ;N GATMP,GAI,GAF117545 "RTN","C0CRNF",277,0)117546 S GAF=$$FILEREF(GAFILE) ; GET CLOSED ROOT FOR THE FILE NUMBER GAFILE117547 "RTN","C0CRNF",278,0)117548 I '$D(GAIDX) S GAIDX="" ;DEFAULT117549 "RTN","C0CRNF",279,0)117550 I '$D(GANN) S GANN="" ;DEFAULT ONLY POPULATED FIELDS RETURNED117551 "RTN","C0CRNF",280,0)117552 I GAIDX'="" S GAF=$NA(@GAF@(GAIDX)) ; IF WE ARE USING AN INDEX117553 "RTN","C0CRNF",281,0)117554 W GAF,!117555 "RTN","C0CRNF",282,0)117556 W $O(@GAF@(0)) ;117557 "RTN","C0CRNF",283,0)117558 S GAI=0 ;ITERATOR117559 "RTN","C0CRNF",284,0)117560 F S GAI=$O(@GAF@(GAI)) Q:GAI="" D ;117561 "RTN","C0CRNF",285,0)117562 . D GETN1("GATMP",GAFILE,GAI,GAIDX,GANN) ;GET ONE RECORD117563 "RTN","C0CRNF",286,0)117564 . N GAX S GAX=0117565 "RTN","C0CRNF",287,0)117566 . F S GAX=$O(GATMP(GAX)) Q:GAX="" D ;PULL OUT THE FIELDS117567 117663 "RTN","C0CRNF",288,0) 117568 . . D ADDNV(GARTN,GAI,GAX,GATMP(GAX)) ;INSERT THE NAME/VALUE INTO GARTN117664 ; 117569 117665 "RTN","C0CRNF",289,0) 117666 ADDNV(GNV,GNVN,GNVF,GNVV) ; CREATE AN ELEMENT OF THE MATRIX 117667 "RTN","C0CRNF",290,0) 117668 ; 117669 "RTN","C0CRNF",291,0) 117670 S @GNV@("F",GNVF)=$P(GNVV,"^",1)_"^"_$P(GNVV,"^",2) ;NAME=FILE^FIELD# 117671 "RTN","C0CRNF",292,0) 117672 S @GNV@("V",GNVN,GNVF,1)=$P(GNVV,"^",3) ;SET THE VALUE 117673 "RTN","C0CRNF",293,0) 117570 117674 Q 117571 "RTN","C0CRNF",290,0)117572 ;117573 "RTN","C0CRNF",291,0)117574 ADDNV(GNV,GNVN,GNVF,GNVV) ; CREATE AN ELEMENT OF THE MATRIX117575 "RTN","C0CRNF",292,0)117576 ;117577 "RTN","C0CRNF",293,0)117578 S @GNV@("F",GNVF)=$P(GNVV,"^",1)_"^"_$P(GNVV,"^",2) ;NAME=FILE^FIELD#117579 117675 "RTN","C0CRNF",294,0) 117580 S @GNV@("V",GNVN,GNVF,1)=$P(GNVV,"^",3) ;SET THE VALUE117676 ; 117581 117677 "RTN","C0CRNF",295,0) 117678 RNF2CSV(RNRTN,RNIN,RNSTY) ;CONVERTS AN RFN2 GLOBAL TO A CSV FORMAT 117679 "RTN","C0CRNF",296,0) 117680 ; READY TO WRITE FOR USE WITH EXCEL @RNRTN@(0) IS NUMBER OF LINES 117681 "RTN","C0CRNF",297,0) 117682 ; RNSTY IS STYLE OF THE OUTPUT - 117683 "RTN","C0CRNF",298,0) 117684 ; .. "NV"= ROWS ARE NAMES, COLUMNS ARE VALUES 117685 "RTN","C0CRNF",299,0) 117686 ; .. "VN"= ROWS ARE VALUES, COLUMNS ARE NAMES 117687 "RTN","C0CRNF",300,0) 117688 ; .. DEFAULT IS "NV" BECAUSE MANY MATRICES HAVE MORE FIELDS THAN VALUES 117689 "RTN","C0CRNF",301,0) 117690 N RNR,RNC ;ROW ROOT,COL ROOT 117691 "RTN","C0CRNF",302,0) 117692 N RNI,RNJ,RNX 117693 "RTN","C0CRNF",303,0) 117694 I '$D(RNSTY) S RNSTY="NV" ;DEFAULT 117695 "RTN","C0CRNF",304,0) 117696 I RNSTY="NV" D NV(RNRTN,RNIN) ; INTERNAL SUBROUTINES DEPENDING ON ORIENTATION 117697 "RTN","C0CRNF",305,0) 117698 E D VN(RNRTN,RNIN) ; 117699 "RTN","C0CRNF",306,0) 117582 117700 Q 117583 "RTN","C0CRNF",296,0)117584 ;117585 "RTN","C0CRNF",297,0)117586 RNF2CSV(RNRTN,RNIN,RNSTY) ;CONVERTS AN RFN2 GLOBAL TO A CSV FORMAT117587 "RTN","C0CRNF",298,0)117588 ; READY TO WRITE FOR USE WITH EXCEL @RNRTN@(0) IS NUMBER OF LINES117589 "RTN","C0CRNF",299,0)117590 ; RNSTY IS STYLE OF THE OUTPUT -117591 "RTN","C0CRNF",300,0)117592 ; .. "NV"= ROWS ARE NAMES, COLUMNS ARE VALUES117593 "RTN","C0CRNF",301,0)117594 ; .. "VN"= ROWS ARE VALUES, COLUMNS ARE NAMES117595 "RTN","C0CRNF",302,0)117596 ; .. DEFAULT IS "NV" BECAUSE MANY MATRICES HAVE MORE FIELDS THAN VALUES117597 "RTN","C0CRNF",303,0)117598 N RNR,RNC ;ROW ROOT,COL ROOT117599 "RTN","C0CRNF",304,0)117600 N RNI,RNJ,RNX117601 "RTN","C0CRNF",305,0)117602 I '$D(RNSTY) S RNSTY="NV" ;DEFAULT117603 "RTN","C0CRNF",306,0)117604 I RNSTY="NV" D NV(RNRTN,RNIN) ; INTERNAL SUBROUTINES DEPENDING ON ORIENTATION117605 117701 "RTN","C0CRNF",307,0) 117606 E D VN(RNRTN,RNIN);117702 ; 117607 117703 "RTN","C0CRNF",308,0) 117704 NV(RNRTN,RNIN) ; 117705 "RTN","C0CRNF",309,0) 117706 S RNR=$NA(@RNIN@("F")) 117707 "RTN","C0CRNF",310,0) 117708 S RNC=$NA(@RNIN@("V")) 117709 "RTN","C0CRNF",311,0) 117710 ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER 117711 "RTN","C0CRNF",312,0) 117712 S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD" 117713 "RTN","C0CRNF",313,0) 117714 S RNI="" 117715 "RTN","C0CRNF",314,0) 117716 F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN 117717 "RTN","C0CRNF",315,0) 117718 . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA 117719 "RTN","C0CRNF",316,0) 117720 S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA 117721 "RTN","C0CRNF",317,0) 117722 D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS 117723 "RTN","C0CRNF",318,0) 117724 S RNI="" 117725 "RTN","C0CRNF",319,0) 117726 F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW 117727 "RTN","C0CRNF",320,0) 117728 . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD 117729 "RTN","C0CRNF",321,0) 117730 . S RNJ="" 117731 "RTN","C0CRNF",322,0) 117732 . F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL 117733 "RTN","C0CRNF",323,0) 117734 . . I $D(@RNC@(RNJ,RNI,1)) D ; THIS ROW HAS THIS COLUMN 117735 "RTN","C0CRNF",324,0) 117736 . . . S RNX=RNX_""""_@RNC@(RNJ,RNI,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA 117737 "RTN","C0CRNF",325,0) 117738 . . E S RNX=RNX_"," ; NUL COLUMN 117739 "RTN","C0CRNF",326,0) 117740 . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA 117741 "RTN","C0CRNF",327,0) 117742 . D PUSH^C0CXPATH(RNRTN,RNX) 117743 "RTN","C0CRNF",328,0) 117608 117744 Q 117609 "RTN","C0CRNF",3 09,0)117610 ; 117611 "RTN","C0CRNF",3 10,0)117612 NV(RNRTN,RNIN) ;117613 "RTN","C0CRNF",3 11,0)117614 S RNR=$NA(@RNIN@(" F"))117615 "RTN","C0CRNF",3 12,0)117616 S RNC=$NA(@RNIN@(" V"))117617 "RTN","C0CRNF",3 13,0)117745 "RTN","C0CRNF",329,0) 117746 ; 117747 "RTN","C0CRNF",330,0) 117748 VN(RNRTN,RNIN) ; 117749 "RTN","C0CRNF",331,0) 117750 S RNR=$NA(@RNIN@("V")) 117751 "RTN","C0CRNF",332,0) 117752 S RNC=$NA(@RNIN@("F")) 117753 "RTN","C0CRNF",333,0) 117618 117754 ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER 117619 "RTN","C0CRNF",3 14,0)117620 S RNX=""" FILE"""_"," ; FIRST COLUMN NAME IS "FIELD"117621 "RTN","C0CRNF",3 15,0)117755 "RTN","C0CRNF",334,0) 117756 S RNX="""ROW"""_"," ; FIRST COLUMN NAME IS "ROW" 117757 "RTN","C0CRNF",335,0) 117622 117758 S RNI="" 117623 "RTN","C0CRNF",3 16,0)117759 "RTN","C0CRNF",336,0) 117624 117760 F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN 117625 "RTN","C0CRNF",3 17,0)117761 "RTN","C0CRNF",337,0) 117626 117762 . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA 117627 "RTN","C0CRNF",3 18,0)117763 "RTN","C0CRNF",338,0) 117628 117764 S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA 117629 "RTN","C0CRNF",3 19,0)117765 "RTN","C0CRNF",339,0) 117630 117766 D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS 117631 "RTN","C0CRNF",3 20,0)117767 "RTN","C0CRNF",340,0) 117632 117768 S RNI="" 117633 "RTN","C0CRNF",3 21,0)117769 "RTN","C0CRNF",341,0) 117634 117770 F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW 117635 "RTN","C0CRNF",3 22,0)117771 "RTN","C0CRNF",342,0) 117636 117772 . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD 117637 "RTN","C0CRNF",3 23,0)117773 "RTN","C0CRNF",343,0) 117638 117774 . S RNJ="" 117639 "RTN","C0CRNF",3 24,0)117775 "RTN","C0CRNF",344,0) 117640 117776 . F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL 117641 "RTN","C0CRNF",325,0) 117642 . . I $D(@RNC@(RNJ,RNI,1)) D ; THIS ROW HAS THIS COLUMN 117643 "RTN","C0CRNF",326,0) 117644 . . . S RNX=RNX_""""_@RNC@(RNJ,RNI,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA 117645 "RTN","C0CRNF",327,0) 117777 "RTN","C0CRNF",345,0) 117778 . . I $D(@RNR@(RNI,RNJ,1)) D ; THIS ROW HAS THIS COLUMN 117779 "RTN","C0CRNF",346,0) 117780 . . . S RNV=$TR(@RNR@(RNI,RNJ,1),"""","") 117781 "RTN","C0CRNF",347,0) 117782 . . . S RNV=$TR(RNV,",","") 117783 "RTN","C0CRNF",348,0) 117784 . . . S RNX=RNX_""""_RNV_""""_"," ; ADD THE ELEMENT PLUS A COMMA 117785 "RTN","C0CRNF",349,0) 117646 117786 . . E S RNX=RNX_"," ; NUL COLUMN 117647 "RTN","C0CRNF",3 28,0)117787 "RTN","C0CRNF",350,0) 117648 117788 . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA 117649 "RTN","C0CRNF",3 29,0)117789 "RTN","C0CRNF",351,0) 117650 117790 . D PUSH^C0CXPATH(RNRTN,RNX) 117651 "RTN","C0CRNF",3 30,0)117791 "RTN","C0CRNF",352,0) 117652 117792 Q 117653 "RTN","C0CRNF",331,0)117654 ;117655 "RTN","C0CRNF",332,0)117656 VN(RNRTN,RNIN) ;117657 "RTN","C0CRNF",333,0)117658 S RNR=$NA(@RNIN@("V"))117659 "RTN","C0CRNF",334,0)117660 S RNC=$NA(@RNIN@("F"))117661 "RTN","C0CRNF",335,0)117662 ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER117663 "RTN","C0CRNF",336,0)117664 S RNX="""ROW"""_"," ; FIRST COLUMN NAME IS "ROW"117665 "RTN","C0CRNF",337,0)117666 S RNI=""117667 "RTN","C0CRNF",338,0)117668 F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN117669 "RTN","C0CRNF",339,0)117670 . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA117671 "RTN","C0CRNF",340,0)117672 S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA117673 "RTN","C0CRNF",341,0)117674 D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS117675 "RTN","C0CRNF",342,0)117676 S RNI=""117677 "RTN","C0CRNF",343,0)117678 F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW117679 "RTN","C0CRNF",344,0)117680 . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD117681 "RTN","C0CRNF",345,0)117682 . S RNJ=""117683 "RTN","C0CRNF",346,0)117684 . F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL117685 "RTN","C0CRNF",347,0)117686 . . I $D(@RNR@(RNI,RNJ,1)) D ; THIS ROW HAS THIS COLUMN117687 "RTN","C0CRNF",348,0)117688 . . . S RNV=$TR(@RNR@(RNI,RNJ,1),"""","")117689 "RTN","C0CRNF",349,0)117690 . . . S RNV=$TR(RNV,",","")117691 "RTN","C0CRNF",350,0)117692 . . . S RNX=RNX_""""_RNV_""""_"," ; ADD THE ELEMENT PLUS A COMMA117693 "RTN","C0CRNF",351,0)117694 . . E S RNX=RNX_"," ; NUL COLUMN117695 "RTN","C0CRNF",352,0)117696 . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA117697 117793 "RTN","C0CRNF",353,0) 117698 . D PUSH^C0CXPATH(RNRTN,RNX)117794 ; 117699 117795 "RTN","C0CRNF",354,0) 117796 READCSV(PATH,NAME,GLB) ; READ A CSV FILE IN FROM UNIX TO GLB, PASSED BY NAME 117797 "RTN","C0CRNF",355,0) 117798 ; 117799 "RTN","C0CRNF",356,0) 117800 Q $$FTG^%ZISH(PATH,NAME,GLB,1) 117801 "RTN","C0CRNF",357,0) 117802 ; 117803 "RTN","C0CRNF",358,0) 117804 FILE2CSV(FNUM,FVN) ; WRITES OUT A FILEMAN FILE TO CSV 117805 "RTN","C0CRNF",359,0) 117806 ; 117807 "RTN","C0CRNF",360,0) 117808 ;N G1,G2 117809 "RTN","C0CRNF",361,0) 117810 I '$D(FVN) S FVN="NV" ; DEFAULT ORIENTATION OF CVS FILE 117811 "RTN","C0CRNF",362,0) 117812 S G1=$NA(^TMP($J,"C0CCSV",1)) 117813 "RTN","C0CRNF",363,0) 117814 S G2=$NA(^TMP($J,"C0CCSV",2)) 117815 "RTN","C0CRNF",364,0) 117816 D GETN2(G1,FNUM) ; GET THE MATRIX 117817 "RTN","C0CRNF",365,0) 117818 D RNF2CSV(G2,G1,FVN) ; PREPARE THE CVS FILE 117819 "RTN","C0CRNF",366,0) 117820 K @G1 117821 "RTN","C0CRNF",367,0) 117822 D FILEOUT(G2,"FILE_"_FNUM_".csv") 117823 "RTN","C0CRNF",368,0) 117824 K @G2 117825 "RTN","C0CRNF",369,0) 117700 117826 Q 117701 "RTN","C0CRNF",355,0)117702 ;117703 "RTN","C0CRNF",356,0)117704 READCSV(PATH,NAME,GLB) ; READ A CSV FILE IN FROM UNIX TO GLB, PASSED BY NAME117705 "RTN","C0CRNF",357,0)117706 ;117707 "RTN","C0CRNF",358,0)117708 Q $$FTG^%ZISH(PATH,NAME,GLB,1)117709 "RTN","C0CRNF",359,0)117710 ;117711 "RTN","C0CRNF",360,0)117712 FILE2CSV(FNUM,FVN) ; WRITES OUT A FILEMAN FILE TO CSV117713 "RTN","C0CRNF",361,0)117714 ;117715 "RTN","C0CRNF",362,0)117716 ;N G1,G2117717 "RTN","C0CRNF",363,0)117718 I '$D(FVN) S FVN="NV" ; DEFAULT ORIENTATION OF CVS FILE117719 "RTN","C0CRNF",364,0)117720 S G1=$NA(^TMP($J,"C0CCSV",1))117721 "RTN","C0CRNF",365,0)117722 S G2=$NA(^TMP($J,"C0CCSV",2))117723 "RTN","C0CRNF",366,0)117724 D GETN2(G1,FNUM) ; GET THE MATRIX117725 "RTN","C0CRNF",367,0)117726 D RNF2CSV(G2,G1,FVN) ; PREPARE THE CVS FILE117727 "RTN","C0CRNF",368,0)117728 K @G1117729 "RTN","C0CRNF",369,0)117730 D FILEOUT(G2,"FILE_"_FNUM_".csv")117731 117827 "RTN","C0CRNF",370,0) 117732 K @G2117828 ; 117733 117829 "RTN","C0CRNF",371,0) 117830 FILEOUT(FOARY,FONAM) ; WRITE OUT A FILE 117831 "RTN","C0CRNF",372,0) 117832 ; 117833 "RTN","C0CRNF",373,0) 117834 W $$OUTPUT^C0CXPATH($NA(@FOARY@(1)),FONAM,^TMP("C0CCCR","ODIR")) 117835 "RTN","C0CRNF",374,0) 117734 117836 Q 117735 "RTN","C0CRNF",372,0)117736 ;117737 "RTN","C0CRNF",373,0)117738 FILEOUT(FOARY,FONAM) ; WRITE OUT A FILE117739 "RTN","C0CRNF",374,0)117740 ;117741 117837 "RTN","C0CRNF",375,0) 117742 W $$OUTPUT^C0CXPATH($NA(@FOARY@(1)),FONAM,^TMP("C0CCCR","ODIR"))117838 ; 117743 117839 "RTN","C0CRNF",376,0) 117840 FILEREF(FNUM) ; EXTRINSIC THAT RETURNS A CLOSED ROOT FOR FILE NUMBER FNUM 117841 "RTN","C0CRNF",377,0) 117842 ; 117843 "RTN","C0CRNF",378,0) 117844 N C0CF 117845 "RTN","C0CRNF",379,0) 117846 S C0CF=^DIC(FNUM,0,"GL") ;OPEN ROOT TO FILE 117847 "RTN","C0CRNF",380,0) 117848 S C0CF=$P(C0CF,",",1)_")" ; CLOSE THE ROOT 117849 "RTN","C0CRNF",381,0) 117850 I C0CF["()" S C0CF=$P(C0CF,"()",1) 117851 "RTN","C0CRNF",382,0) 117852 Q C0CF 117853 "RTN","C0CRNF",383,0) 117854 ; 117855 "RTN","C0CRNF",384,0) 117856 SKIP ; 117857 "RTN","C0CRNF",385,0) 117858 N TXT,DIERR 117859 "RTN","C0CRNF",386,0) 117860 S TXT=$$GET1^DIQ(8925,TIUIEN,"2","","TXT") 117861 "RTN","C0CRNF",387,0) 117862 I $D(DIERR) D CLEAN^DILF Q 117863 "RTN","C0CRNF",388,0) 117864 W " report_text:",! ;Progress Note Text 117865 "RTN","C0CRNF",389,0) 117866 N LN S LN=0 117867 "RTN","C0CRNF",390,0) 117868 F S LN=$O(TXT(LN)) Q:'LN D 117869 "RTN","C0CRNF",391,0) 117870 . W " text"_LN_": "_TXT(LN),! 117871 "RTN","C0CRNF",392,0) 117872 . Q 117873 "RTN","C0CRNF",393,0) 117744 117874 Q 117745 "RTN","C0CRNF",377,0)117746 ;117747 "RTN","C0CRNF",378,0)117748 FILEREF(FNUM) ; EXTRINSIC THAT RETURNS A CLOSED ROOT FOR FILE NUMBER FNUM117749 "RTN","C0CRNF",379,0)117750 ;117751 "RTN","C0CRNF",380,0)117752 N C0CF117753 "RTN","C0CRNF",381,0)117754 S C0CF=^DIC(FNUM,0,"GL") ;OPEN ROOT TO FILE117755 "RTN","C0CRNF",382,0)117756 S C0CF=$P(C0CF,",",1)_")" ; CLOSE THE ROOT117757 "RTN","C0CRNF",383,0)117758 I C0CF["()" S C0CF=$P(C0CF,"()",1)117759 "RTN","C0CRNF",384,0)117760 Q C0CF117761 "RTN","C0CRNF",385,0)117762 ;117763 "RTN","C0CRNF",386,0)117764 SKIP ;117765 "RTN","C0CRNF",387,0)117766 N TXT,DIERR117767 "RTN","C0CRNF",388,0)117768 S TXT=$$GET1^DIQ(8925,TIUIEN,"2","","TXT")117769 "RTN","C0CRNF",389,0)117770 I $D(DIERR) D CLEAN^DILF Q117771 "RTN","C0CRNF",390,0)117772 W " report_text:",! ;Progress Note Text117773 "RTN","C0CRNF",391,0)117774 N LN S LN=0117775 "RTN","C0CRNF",392,0)117776 F S LN=$O(TXT(LN)) Q:'LN D117777 "RTN","C0CRNF",393,0)117778 . W " text"_LN_": "_TXT(LN),!117779 117875 "RTN","C0CRNF",394,0) 117780 . Q117876 ; 117781 117877 "RTN","C0CRNF",395,0) 117878 RNF2HNV(ZOUT,ZIN) ;RETURN AN HTML TABLE IN ZOUT, PASSED BY NAME 117879 "RTN","C0CRNF",396,0) 117880 ; OF ZIN, WHICH IS PASSED BY NAME AND IS IN RNF2 FORMAT 117881 "RTN","C0CRNF",397,0) 117882 ; ZOUT IS NOT INITIALIZED, SO THE TABLE WILL GO AT THE END 117883 "RTN","C0CRNF",398,0) 117884 ; THE TABLE WILL BE IN NV FORMAT, ROWS ARE NAMES COLUMNS ARE VALUES 117885 "RTN","C0CRNF",399,0) 117886 D PUSH^C0CXPATH(ZOUT,"<table border=""1"">") 117887 "RTN","C0CRNF",400,0) 117888 N ZI,ZJ,ZV,ZN S ZI="" S ZJ=0 117889 "RTN","C0CRNF",401,0) 117890 D PUSH^C0CXPATH(ZOUT,"<tr><td></td>") ;begin row and leave a blank col 117891 "RTN","C0CRNF",402,0) 117892 F S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0 D ; FOR EACH OCCURANCE 117893 "RTN","C0CRNF",403,0) 117894 . S ZV="<td>"_ZJ_"</td>" ; OCCURANCE AS COLUMNS HEADER 117895 "RTN","C0CRNF",404,0) 117896 . D PUSH^C0CXPATH(ZOUT,ZV) 117897 "RTN","C0CRNF",405,0) 117898 D PUSH^C0CXPATH(ZOUT,"</tr>") ;end of first row 117899 "RTN","C0CRNF",406,0) 117900 S ZI="" 117901 "RTN","C0CRNF",407,0) 117902 F S ZI=$O(@ZIN@("F",ZI)) Q:ZI="" D ; FOR EACH VARIABLE 117903 "RTN","C0CRNF",408,0) 117904 . S ZN="<tr><td>"_ZI_"</td>" ; VARIABLE NAME IN FIRST COLUMN 117905 "RTN","C0CRNF",409,0) 117906 . D PUSH^C0CXPATH(ZOUT,ZN) 117907 "RTN","C0CRNF",410,0) 117908 . S ZJ=0 ;RESET TO DO IT AGAIN 117909 "RTN","C0CRNF",411,0) 117910 . F S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0 D ; FOR EACH OCCURANCE 117911 "RTN","C0CRNF",412,0) 117912 . . S ZV="<td>"_$G(@ZIN@("V",ZJ,ZI,1))_"</td>" 117913 "RTN","C0CRNF",413,0) 117914 . . D PUSH^C0CXPATH(ZOUT,ZV) 117915 "RTN","C0CRNF",414,0) 117916 . D PUSH^C0CXPATH(ZOUT,"</tr>") ;END OF ROW 117917 "RTN","C0CRNF",415,0) 117918 D PUSH^C0CXPATH(ZOUT,"</table>") ; end of table 117919 "RTN","C0CRNF",416,0) 117782 117920 Q 117783 "RTN","C0CRNF", 396,0)117784 ; 117785 "RTN","C0CRNF", 397,0)117786 RNF2H NV(ZOUT,ZIN) ;RETURN AN HTML TABLE IN ZOUT, PASSED BY NAME117787 "RTN","C0CRNF", 398,0)117921 "RTN","C0CRNF",417,0) 117922 ; 117923 "RTN","C0CRNF",418,0) 117924 RNF2HVN(ZOUT,ZIN) ;RETURN AN HTML TABLE IN ZOUT, PASSED BY NAME 117925 "RTN","C0CRNF",419,0) 117788 117926 ; OF ZIN, WHICH IS PASSED BY NAME AND IS IN RNF2 FORMAT 117789 "RTN","C0CRNF", 399,0)117927 "RTN","C0CRNF",420,0) 117790 117928 ; ZOUT IS NOT INITIALIZED, SO THE TABLE WILL GO AT THE END 117791 "RTN","C0CRNF",4 00,0)117792 ; THE TABLE WILL BE IN NV FORMAT, ROWS ARE NAMES COLUMNS ARE VALUES117793 "RTN","C0CRNF",4 01,0)117929 "RTN","C0CRNF",421,0) 117930 ; THE TABLE WILL BE IN VN FORMAT, ROWS ARE VALUES COLUMNS ARE NAMES 117931 "RTN","C0CRNF",422,0) 117794 117932 D PUSH^C0CXPATH(ZOUT,"<table border=""1"">") 117795 "RTN","C0CRNF",402,0) 117796 N ZI,ZJ,ZV,ZN S ZI="" S ZJ=0 117797 "RTN","C0CRNF",403,0) 117798 D PUSH^C0CXPATH(ZOUT,"<tr><td></td>") ;begin row and leave a blank col 117799 "RTN","C0CRNF",404,0) 117800 F S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0 D ; FOR EACH OCCURANCE 117801 "RTN","C0CRNF",405,0) 117802 . S ZV="<td>"_ZJ_"</td>" ; OCCURANCE AS COLUMNS HEADER 117803 "RTN","C0CRNF",406,0) 117804 . D PUSH^C0CXPATH(ZOUT,ZV) 117805 "RTN","C0CRNF",407,0) 117806 D PUSH^C0CXPATH(ZOUT,"</tr>") ;end of first row 117807 "RTN","C0CRNF",408,0) 117808 S ZI="" 117809 "RTN","C0CRNF",409,0) 117933 "RTN","C0CRNF",423,0) 117934 N ZI,ZJ S ZI="" S ZJ=0 117935 "RTN","C0CRNF",424,0) 117936 D PUSH^C0CXPATH(ZOUT,"<tr>") ;new row for column headers 117937 "RTN","C0CRNF",425,0) 117810 117938 F S ZI=$O(@ZIN@("F",ZI)) Q:ZI="" D ; FOR EACH VARIABLE 117811 "RTN","C0CRNF",410,0) 117812 . S ZN="<tr><td>"_ZI_"</td>" ; VARIABLE NAME IN FIRST COLUMN 117813 "RTN","C0CRNF",411,0) 117814 . D PUSH^C0CXPATH(ZOUT,ZN) 117815 "RTN","C0CRNF",412,0) 117816 . S ZJ=0 ;RESET TO DO IT AGAIN 117817 "RTN","C0CRNF",413,0) 117818 . F S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0 D ; FOR EACH OCCURANCE 117819 "RTN","C0CRNF",414,0) 117820 . . S ZV="<td>"_$G(@ZIN@("V",ZJ,ZI,1))_"</td>" 117821 "RTN","C0CRNF",415,0) 117822 . . D PUSH^C0CXPATH(ZOUT,ZV) 117823 "RTN","C0CRNF",416,0) 117824 . D PUSH^C0CXPATH(ZOUT,"</tr>") ;END OF ROW 117825 "RTN","C0CRNF",417,0) 117826 D PUSH^C0CXPATH(ZOUT,"</table>") ; end of table 117827 "RTN","C0CRNF",418,0) 117939 "RTN","C0CRNF",426,0) 117940 . S ZV="<td>"_ZI_"</td>" 117941 "RTN","C0CRNF",427,0) 117942 . D PUSH^C0CXPATH(ZOUT,ZV) ; name 117943 "RTN","C0CRNF",428,0) 117944 D PUSH^C0CXPATH(ZOUT,"</tr>") ; end header row 117945 "RTN","C0CRNF",429,0) 117946 S ZI="" ;RESET TO DO AGAIN 117947 "RTN","C0CRNF",430,0) 117948 F S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0 D ; FOR EACH ROW OF VARIABLES 117949 "RTN","C0CRNF",431,0) 117950 . D PUSH^C0CXPATH(ZOUT,"<tr>") ;begin row 117951 "RTN","C0CRNF",432,0) 117952 . F S ZI=$O(@ZIN@("F",ZI)) Q:ZI="" D ; FOR EACH VARIABLE 117953 "RTN","C0CRNF",433,0) 117954 . . S ZV="<td>"_$G(@ZIN@("V",ZJ,ZI,1))_"</td>" ; value 117955 "RTN","C0CRNF",434,0) 117956 . . D PUSH^C0CXPATH(ZOUT,ZV) ; value 117957 "RTN","C0CRNF",435,0) 117958 . D PUSH^C0CXPATH(ZOUT,"</tr>") ; end header 117959 "RTN","C0CRNF",436,0) 117960 D PUSH^C0CXPATH(ZOUT,"</table>") ;end of table 117961 "RTN","C0CRNF",437,0) 117828 117962 Q 117829 "RTN","C0CRNF",419,0)117830 ;117831 "RTN","C0CRNF",420,0)117832 RNF2HVN(ZOUT,ZIN) ;RETURN AN HTML TABLE IN ZOUT, PASSED BY NAME117833 "RTN","C0CRNF",421,0)117834 ; OF ZIN, WHICH IS PASSED BY NAME AND IS IN RNF2 FORMAT117835 "RTN","C0CRNF",422,0)117836 ; ZOUT IS NOT INITIALIZED, SO THE TABLE WILL GO AT THE END117837 "RTN","C0CRNF",423,0)117838 ; THE TABLE WILL BE IN VN FORMAT, ROWS ARE VALUES COLUMNS ARE NAMES117839 "RTN","C0CRNF",424,0)117840 D PUSH^C0CXPATH(ZOUT,"<table border=""1"">")117841 "RTN","C0CRNF",425,0)117842 N ZI,ZJ S ZI="" S ZJ=0117843 "RTN","C0CRNF",426,0)117844 D PUSH^C0CXPATH(ZOUT,"<tr>") ;new row for column headers117845 "RTN","C0CRNF",427,0)117846 F S ZI=$O(@ZIN@("F",ZI)) Q:ZI="" D ; FOR EACH VARIABLE117847 "RTN","C0CRNF",428,0)117848 . S ZV="<td>"_ZI_"</td>"117849 "RTN","C0CRNF",429,0)117850 . D PUSH^C0CXPATH(ZOUT,ZV) ; name117851 "RTN","C0CRNF",430,0)117852 D PUSH^C0CXPATH(ZOUT,"</tr>") ; end header row117853 "RTN","C0CRNF",431,0)117854 S ZI="" ;RESET TO DO AGAIN117855 "RTN","C0CRNF",432,0)117856 F S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0 D ; FOR EACH ROW OF VARIABLES117857 "RTN","C0CRNF",433,0)117858 . D PUSH^C0CXPATH(ZOUT,"<tr>") ;begin row117859 "RTN","C0CRNF",434,0)117860 . F S ZI=$O(@ZIN@("F",ZI)) Q:ZI="" D ; FOR EACH VARIABLE117861 "RTN","C0CRNF",435,0)117862 . . S ZV="<td>"_$G(@ZIN@("V",ZJ,ZI,1))_"</td>" ; value117863 "RTN","C0CRNF",436,0)117864 . . D PUSH^C0CXPATH(ZOUT,ZV) ; value117865 "RTN","C0CRNF",437,0)117866 . D PUSH^C0CXPATH(ZOUT,"</tr>") ; end header117867 117963 "RTN","C0CRNF",438,0) 117868 D PUSH^C0CXPATH(ZOUT,"</table>") ;end of table117964 ; 117869 117965 "RTN","C0CRNF",439,0) 117870 Q 117966 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 117871 117967 "RTN","C0CRNF",440,0) 117872 ; 117968 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF @ZTAB@(ZFN) 117873 117969 "RTN","C0CRNF",441,0) 117874 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 117970 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 117875 117971 "RTN","C0CRNF",442,0) 117876 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF @ZTAB@(ZFN)117972 I '$D(ZTAB) S ZTAB="C0CA" 117877 117973 "RTN","C0CRNF",443,0) 117974 Q $P(@ZTAB@(ZFN),"^",1) 117975 "RTN","C0CRNF",444,0) 117976 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED 117977 "RTN","C0CRNF",445,0) 117978 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF @ZTAB@(ZFN) 117979 "RTN","C0CRNF",446,0) 117878 117980 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 117879 "RTN","C0CRNF",44 4,0)117981 "RTN","C0CRNF",447,0) 117880 117982 I '$D(ZTAB) S ZTAB="C0CA" 117881 "RTN","C0CRNF",445,0)117882 Q $P(@ZTAB@(ZFN),"^",1)117883 "RTN","C0CRNF",446,0)117884 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED117885 "RTN","C0CRNF",447,0)117886 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF @ZTAB@(ZFN)117887 117983 "RTN","C0CRNF",448,0) 117984 Q $P(@ZTAB@(ZFN),"^",2) 117985 "RTN","C0CRNF",449,0) 117986 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED 117987 "RTN","C0CRNF",450,0) 117988 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN) 117989 "RTN","C0CRNF",451,0) 117888 117990 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 117889 "RTN","C0CRNF",4 49,0)117991 "RTN","C0CRNF",452,0) 117890 117992 I '$D(ZTAB) S ZTAB="C0CA" 117891 "RTN","C0CRNF",450,0) 117892 Q $P(@ZTAB@(ZFN),"^",2) 117893 "RTN","C0CRNF",451,0) 117894 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED 117895 "RTN","C0CRNF",452,0) 117993 "RTN","C0CRNF",453,0) 117994 Q $P($G(@ZTAB@(ZFN)),"^",3) 117995 "RTN","C0CRNF",454,0) 117996 ; 117997 "RTN","C0CRNF",455,0) 117998 ZVALUEI(ZFN,ZTAB) ;EXTRINSIC TO RETURN INTERNAL VALUE FOR FIELD NAME PASSED 117999 "RTN","C0CRNF",456,0) 117896 118000 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN) 117897 "RTN","C0CRNF",45 3,0)118001 "RTN","C0CRNF",457,0) 117898 118002 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 117899 "RTN","C0CRNF",45 4,0)118003 "RTN","C0CRNF",458,0) 117900 118004 I '$D(ZTAB) S ZTAB="C0CA" 117901 "RTN","C0CRNF",455,0)117902 Q $P($G(@ZTAB@(ZFN)),"^",3)117903 "RTN","C0CRNF",456,0)117904 ;117905 "RTN","C0CRNF",457,0)117906 ZVALUEI(ZFN,ZTAB) ;EXTRINSIC TO RETURN INTERNAL VALUE FOR FIELD NAME PASSED117907 "RTN","C0CRNF",458,0)117908 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)117909 118005 "RTN","C0CRNF",459,0) 117910 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA118006 Q $P($G(@ZTAB@(ZFN,"I")),"^",3) 117911 118007 "RTN","C0CRNF",460,0) 117912 I '$D(ZTAB) S ZTAB="C0CA"117913 "RTN","C0CRNF",461,0)117914 Q $P($G(@ZTAB@(ZFN,"I")),"^",3)117915 "RTN","C0CRNF",462,0)117916 118008 ; 117917 118009 "RTN","C0CRNFRP") 117918 0^95^B9 1701220118010 0^95^B90905910 117919 118011 "RTN","C0CRNFRP",1,0) 117920 118012 C0CRNFRP ; CCDCCR/GPL - Reference Name Format (RNF) RPCs; 12/9/09 ; 5/10/12 2:56pm 117921 118013 "RTN","C0CRNFRP",2,0) 117922 ;;1.2;C 0C;;May 11, 2012;Build 50118014 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 117923 118015 "RTN","C0CRNFRP",3,0) 117924 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU118016 ;Copyright 2009 George Lilly. 117925 118017 "RTN","C0CRNFRP",4,0) 117926 ; General Public License See attached copy of the License.118018 ; 117927 118019 "RTN","C0CRNFRP",5,0) 117928 ; 118020 ; This program is free software: you can redistribute it and/or modify 117929 118021 "RTN","C0CRNFRP",6,0) 117930 ; This program is free software; you can redistribute it and/or modify118022 ; it under the terms of the GNU Affero General Public License as 117931 118023 "RTN","C0CRNFRP",7,0) 117932 ; it under the terms of the GNU General Public License as published by118024 ; published by the Free Software Foundation, either version 3 of the 117933 118025 "RTN","C0CRNFRP",8,0) 117934 ; the Free Software Foundation; either version 2 of the License, or118026 ; License, or (at your option) any later version. 117935 118027 "RTN","C0CRNFRP",9,0) 117936 ; (at your option) any later version.118028 ; 117937 118029 "RTN","C0CRNFRP",10,0) 117938 ; 118030 ; This program is distributed in the hope that it will be useful, 117939 118031 "RTN","C0CRNFRP",11,0) 117940 ; This program is distributed in the hope that it will be useful,118032 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 117941 118033 "RTN","C0CRNFRP",12,0) 117942 ; but WITHOUT ANY WARRANTY; without even the implied warranty of118034 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 117943 118035 "RTN","C0CRNFRP",13,0) 117944 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the118036 ; GNU Affero General Public License for more details. 117945 118037 "RTN","C0CRNFRP",14,0) 117946 ; GNU General Public License for more details.118038 ; 117947 118039 "RTN","C0CRNFRP",15,0) 117948 ; 118040 ; You should have received a copy of the GNU Affero General Public License 117949 118041 "RTN","C0CRNFRP",16,0) 117950 ; You should have received a copy of the GNU General Public License along118042 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 117951 118043 "RTN","C0CRNFRP",17,0) 117952 ; with this program; if not, write to the Free Software Foundation, Inc.,118044 ; 117953 118045 "RTN","C0CRNFRP",18,0) 117954 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.118046 W "This is the Reference Name Format (RNF) RPC Library ",! 117955 118047 "RTN","C0CRNFRP",19,0) 117956 ;118048 W ! 117957 118049 "RTN","C0CRNFRP",20,0) 117958 W "This is the Reference Name Format (RNF) RPC Library ",!118050 Q 117959 118051 "RTN","C0CRNFRP",21,0) 117960 W !118052 ; 117961 118053 "RTN","C0CRNFRP",22,0) 118054 ;This routine will be mirroring C0CRNF and transform the output 118055 "RTN","C0CRNFRP",23,0) 118056 ;of the tags into an RPC friendly format 118057 "RTN","C0CRNFRP",24,0) 118058 ;The tags will be exactly as they are in C0CRNF 118059 "RTN","C0CRNFRP",25,0) 118060 FIELDS(C0CFRTN,C0CFILE) ; RETURNS AN ARRAY OF THE FIELDS IN FILE C0CF, 118061 "RTN","C0CRNFRP",26,0) 118062 ;C0CFRTN IS PASSED BY REFERENCE, C0CF IS PASSED BY VALUE 118063 "RTN","C0CRNFRP",27,0) 118064 ;RETURN FORMAT: 118065 "RTN","C0CRNFRP",28,0) 118066 ;^TMP("C0CRNF",$J,0)="NUMBER_OF_RESULTS 118067 "RTN","C0CRNFRP",29,0) 118068 ;^TMP("C0CRNF",$J,I)="FIELD_NAME^FILE_NUMBER^FIELD_NUMBER" 118069 "RTN","C0CRNFRP",30,0) 118070 ; 118071 "RTN","C0CRNFRP",31,0) 118072 ;SAMPLE OUTPUT FROM FIELDS^C0CRNF: 118073 "RTN","C0CRNFRP",32,0) 118074 ;C0CRNFFIELDS("*AMOUNT OF MILITARY RETIREMENT")="2^.3625" 118075 "RTN","C0CRNFRP",33,0) 118076 ; 118077 "RTN","C0CRNFRP",34,0) 118078 ;FORMAT APPEARS TO BE: 118079 "RTN","C0CRNFRP",35,0) 118080 ;VARIABLENAME("FIELD_NAME")="FILE_NUMBER^FIELD_NUMBER" 118081 "RTN","C0CRNFRP",36,0) 118082 ; 118083 "RTN","C0CRNFRP",37,0) 118084 ;SET DEBUG VALUE - REQUIRED - 0=OFF 1=ON 118085 "RTN","C0CRNFRP",38,0) 118086 S DEBUG=0 118087 "RTN","C0CRNFRP",39,0) 118088 ;SET RETURN VALUE 118089 "RTN","C0CRNFRP",40,0) 118090 S C0CFRTN=$NA(^TMP("C0CRNF",$J)) 118091 "RTN","C0CRNFRP",41,0) 118092 K @C0CFRTN 118093 "RTN","C0CRNFRP",42,0) 118094 ;RUN WRAPPED CALL 118095 "RTN","C0CRNFRP",43,0) 118096 D FIELDS^C0CRNF("C0CRTN",C0CFILE) 118097 "RTN","C0CRNFRP",44,0) 118098 S J="" 118099 "RTN","C0CRNFRP",45,0) 118100 S I=1 118101 "RTN","C0CRNFRP",46,0) 118102 ;FORMAT RETURN 118103 "RTN","C0CRNFRP",47,0) 118104 F S J=$O(C0CRTN(J)) Q:J="" D ; FOR EACH FIELD IN THE ARRAY 118105 "RTN","C0CRNFRP",48,0) 118106 . S @C0CFRTN@(I)=J_"^"_C0CRTN(J) 118107 "RTN","C0CRNFRP",49,0) 118108 . S I=I+1 118109 "RTN","C0CRNFRP",50,0) 118110 S @C0CFRTN@(0)=I-1 118111 "RTN","C0CRNFRP",51,0) 118112 ;CLEAN UP 118113 "RTN","C0CRNFRP",52,0) 118114 K J,I 118115 "RTN","C0CRNFRP",53,0) 117962 118116 Q 117963 "RTN","C0CRNFRP",23,0) 117964 ; 117965 "RTN","C0CRNFRP",24,0) 117966 ;This routine will be mirroring C0CRNF and transform the output 117967 "RTN","C0CRNFRP",25,0) 117968 ;of the tags into an RPC friendly format 117969 "RTN","C0CRNFRP",26,0) 117970 ;The tags will be exactly as they are in C0CRNF 117971 "RTN","C0CRNFRP",27,0) 117972 FIELDS(C0CFRTN,C0CFILE) ; RETURNS AN ARRAY OF THE FIELDS IN FILE C0CF, 117973 "RTN","C0CRNFRP",28,0) 117974 ;C0CFRTN IS PASSED BY REFERENCE, C0CF IS PASSED BY VALUE 117975 "RTN","C0CRNFRP",29,0) 118117 "RTN","C0CRNFRP",54,0) 118118 ; 118119 "RTN","C0CRNFRP",55,0) 118120 GETNOLD(GRTN,GFILE,GIEN,GNN) ; GET FIELDS FOR ACCESS BY NAME 118121 "RTN","C0CRNFRP",56,0) 118122 ; GRTN IS PASSED BY NAME 118123 "RTN","C0CRNFRP",57,0) 118124 ; 118125 "RTN","C0CRNFRP",58,0) 118126 ; OLD TAG DO NOT USE! 118127 "RTN","C0CRNFRP",59,0) 118128 Q 118129 "RTN","C0CRNFRP",60,0) 118130 ; 118131 "RTN","C0CRNFRP",61,0) 118132 GETN(C0CGRTN,GFILE,GREF,GNDX,GNN) ; GET BY NAME ; RETURN A FIELD VALUE MAP 118133 "RTN","C0CRNFRP",62,0) 118134 ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL 118135 "RTN","C0CRNFRP",63,0) 118136 ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP 118137 "RTN","C0CRNFRP",64,0) 118138 ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")="" 118139 "RTN","C0CRNFRP",65,0) 118140 ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP 118141 "RTN","C0CRNFRP",66,0) 118142 ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE 118143 "RTN","C0CRNFRP",67,0) 118144 ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP 118145 "RTN","C0CRNFRP",68,0) 118146 ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP 118147 "RTN","C0CRNFRP",69,0) 118148 ; .. NULL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE 118149 "RTN","C0CRNFRP",70,0) 118150 ; IF GREF IS "" THE FIRST RECORD IS OBTAINED 118151 "RTN","C0CRNFRP",71,0) 118152 ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE 118153 "RTN","C0CRNFRP",72,0) 118154 ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN 118155 "RTN","C0CRNFRP",73,0) 118156 ; GREF IS THE VALUE FOR THE INDEX 118157 "RTN","C0CRNFRP",74,0) 118158 ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED 118159 "RTN","C0CRNFRP",75,0) 118160 ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN 118161 "RTN","C0CRNFRP",76,0) 118162 ; 118163 "RTN","C0CRNFRP",77,0) 118164 ; 118165 "RTN","C0CRNFRP",78,0) 117976 118166 ;RETURN FORMAT: 117977 "RTN","C0CRNFRP", 30,0)117978 ;^TMP("C0CRNF",$J,0)="NUMBER_OF_RESULTS 117979 "RTN","C0CRNFRP", 31,0)117980 ;^TMP("C0CRNF",$J,I)="FIELD_NAME^FILE_NUMBER^FIELD_NUMBER "117981 "RTN","C0CRNFRP", 32,0)117982 ; 117983 "RTN","C0CRNFRP", 33,0)118167 "RTN","C0CRNFRP",79,0) 118168 ;^TMP("C0CRNF",$J,0)="NUMBER_OF_RESULTS^FILE_NUMBER^RNF1^IEN^CURRENT_DATE^$J^DUZ_$C(30)" 118169 "RTN","C0CRNFRP",80,0) 118170 ;^TMP("C0CRNF",$J,I)="FIELD_NAME^FILE_NUMBER^FIELD_NUMBER^VALUE^INTERNAL_VALUE_$C(30)" 118171 "RTN","C0CRNFRP",81,0) 118172 ; 118173 "RTN","C0CRNFRP",82,0) 117984 118174 ;SAMPLE OUTPUT FROM FIELDS^C0CRNF: 117985 "RTN","C0CRNFRP",34,0) 117986 ;C0CRNFFIELDS("*AMOUNT OF MILITARY RETIREMENT")="2^.3625" 117987 "RTN","C0CRNFRP",35,0) 117988 ; 117989 "RTN","C0CRNFRP",36,0) 118175 "RTN","C0CRNFRP",83,0) 118176 ;C0CRNFGETN(0)="2^RNF1^5095^3091209^2908^3268" 118177 "RTN","C0CRNFRP",84,0) 118178 ;C0CRNFGETN("1U4N")="2^.0905^H5369" 118179 "RTN","C0CRNFRP",85,0) 118180 ;C0CRNFGETN("1U4N","I")="^^H5369" 118181 "RTN","C0CRNFRP",86,0) 118182 ;C0CRNFGETN("ADDRESS CHANGE DT/TM")="2^.118^OCT 21,2009@08:03:26" 118183 "RTN","C0CRNFRP",87,0) 118184 ;C0CRNFGETN("ADDRESS CHANGE DT/TM","I")="^^3091021.080326" 118185 "RTN","C0CRNFRP",88,0) 118186 ; 118187 "RTN","C0CRNFRP",89,0) 117990 118188 ;FORMAT APPEARS TO BE: 117991 "RTN","C0CRNFRP",37,0) 117992 ;VARIABLENAME("FIELD_NAME")="FILE_NUMBER^FIELD_NUMBER" 117993 "RTN","C0CRNFRP",38,0) 117994 ; 117995 "RTN","C0CRNFRP",39,0) 118189 "RTN","C0CRNFRP",90,0) 118190 ;VARIABLENAME(0)="FILE_NUMBER^RNF1^IEN^CURRENT_DATE^$J^DUZ" 118191 "RTN","C0CRNFRP",91,0) 118192 ;VARIABLENAME("FIELD_NAME")="FILE_NUMBER^FIELD_NUMBER^VALUE" 118193 "RTN","C0CRNFRP",92,0) 118194 ;VARIABLENAME("FIELD_NAME","I")="^^INTERNAL_VALUE" 118195 "RTN","C0CRNFRP",93,0) 118196 ; 118197 "RTN","C0CRNFRP",94,0) 117996 118198 ;SET DEBUG VALUE - REQUIRED - 0=OFF 1=ON 117997 "RTN","C0CRNFRP", 40,0)118199 "RTN","C0CRNFRP",95,0) 117998 118200 S DEBUG=0 117999 "RTN","C0CRNFRP", 41,0)118201 "RTN","C0CRNFRP",96,0) 118000 118202 ;SET RETURN VALUE 118001 "RTN","C0CRNFRP", 42,0)118002 S C0C FRTN=$NA(^TMP("C0CRNF",$J))118003 "RTN","C0CRNFRP", 43,0)118004 K @C0C FRTN118005 "RTN","C0CRNFRP", 44,0)118203 "RTN","C0CRNFRP",97,0) 118204 S C0CGRTN=$NA(^TMP("C0CRNF",$J)) 118205 "RTN","C0CRNFRP",98,0) 118206 K @C0CGRTN 118207 "RTN","C0CRNFRP",99,0) 118006 118208 ;RUN WRAPPED CALL 118007 "RTN","C0CRNFRP", 45,0)118008 D FIELDS^C0CRNF("C0CRTN",C0CFILE)118009 "RTN","C0CRNFRP", 46,0)118209 "RTN","C0CRNFRP",100,0) 118210 D GETN^C0CRNF("C0CRTN",$G(GFILE),$G(GREF),$G(GNDX),$G(GNN)) 118211 "RTN","C0CRNFRP",101,0) 118010 118212 S J="" 118011 "RTN","C0CRNFRP", 47,0)118213 "RTN","C0CRNFRP",102,0) 118012 118214 S I=1 118013 "RTN","C0CRNFRP", 48,0)118215 "RTN","C0CRNFRP",103,0) 118014 118216 ;FORMAT RETURN 118015 "RTN","C0CRNFRP", 49,0)118217 "RTN","C0CRNFRP",104,0) 118016 118218 F S J=$O(C0CRTN(J)) Q:J="" D ; FOR EACH FIELD IN THE ARRAY 118017 "RTN","C0CRNFRP",50,0) 118018 . S @C0CFRTN@(I)=J_"^"_C0CRTN(J) 118019 "RTN","C0CRNFRP",51,0) 118219 "RTN","C0CRNFRP",105,0) 118220 . I J=0 S J=$O(C0CRTN(J)) ; SKIP THE 0 NODE 118221 "RTN","C0CRNFRP",106,0) 118222 . S @C0CGRTN@(I)=J_"^"_C0CRTN(J)_"^" ; GETS THE FIRST LINE 118223 "RTN","C0CRNFRP",107,0) 118224 . ;S J=$O(C0CRTN(J)) ; INCREMENT J SO WE CAN GET THE INTERNAL DATA 118225 "RTN","C0CRNFRP",108,0) 118226 . ;TEST TO SEE IF INTERNAL DATA EXISTS 118227 "RTN","C0CRNFRP",109,0) 118228 . I $D(C0CRTN(J,"I"))=1 D 118229 "RTN","C0CRNFRP",110,0) 118230 . . S @C0CGRTN@(I)=@C0CGRTN@(I)_$P(C0CRTN(J,"I"),U,3) ; GETS THE INTERNAL VALUE PIECE 3 118231 "RTN","C0CRNFRP",111,0) 118020 118232 . S I=I+1 118021 "RTN","C0CRNFRP", 52,0)118022 S @C0C FRTN@(0)=I-1118023 "RTN","C0CRNFRP", 53,0)118233 "RTN","C0CRNFRP",112,0) 118234 S @C0CGRTN@(0)=I-1_"^"_C0CRTN(0) 118235 "RTN","C0CRNFRP",113,0) 118024 118236 ;CLEAN UP 118025 "RTN","C0CRNFRP", 54,0)118237 "RTN","C0CRNFRP",114,0) 118026 118238 K J,I 118027 "RTN","C0CRNFRP", 55,0)118239 "RTN","C0CRNFRP",115,0) 118028 118240 Q 118029 "RTN","C0CRNFRP",56,0) 118030 ; 118031 "RTN","C0CRNFRP",57,0) 118032 GETNOLD(GRTN,GFILE,GIEN,GNN) ; GET FIELDS FOR ACCESS BY NAME 118033 "RTN","C0CRNFRP",58,0) 118034 ; GRTN IS PASSED BY NAME 118035 "RTN","C0CRNFRP",59,0) 118036 ; 118037 "RTN","C0CRNFRP",60,0) 118038 ; OLD TAG DO NOT USE! 118039 "RTN","C0CRNFRP",61,0) 118241 "RTN","C0CRNFRP",116,0) 118242 ; 118243 "RTN","C0CRNFRP",117,0) 118244 GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP 118245 "RTN","C0CRNFRP",118,0) 118246 ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1 118247 "RTN","C0CRNFRP",119,0) 118248 ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL 118249 "RTN","C0CRNFRP",120,0) 118250 ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN 118251 "RTN","C0CRNFRP",121,0) 118252 ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP 118253 "RTN","C0CRNFRP",122,0) 118254 ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")="" 118255 "RTN","C0CRNFRP",123,0) 118256 ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP 118257 "RTN","C0CRNFRP",124,0) 118258 ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE 118259 "RTN","C0CRNFRP",125,0) 118260 ; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE 118261 "RTN","C0CRNFRP",126,0) 118262 ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP 118263 "RTN","C0CRNFRP",127,0) 118264 ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP 118265 "RTN","C0CRNFRP",128,0) 118266 ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE 118267 "RTN","C0CRNFRP",129,0) 118268 ; IF GREF IS "" THE FIRST RECORD IS OBTAINED 118269 "RTN","C0CRNFRP",130,0) 118270 ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE 118271 "RTN","C0CRNFRP",131,0) 118272 ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN 118273 "RTN","C0CRNFRP",132,0) 118274 ; GREF IS THE VALUE FOR THE INDEX 118275 "RTN","C0CRNFRP",133,0) 118276 ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED 118277 "RTN","C0CRNFRP",134,0) 118278 ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN 118279 "RTN","C0CRNFRP",135,0) 118280 ; 118281 "RTN","C0CRNFRP",136,0) 118282 ; 118283 "RTN","C0CRNFRP",137,0) 118284 N GIEN,GF 118285 "RTN","C0CRNFRP",138,0) 118286 S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE 118287 "RTN","C0CRNFRP",139,0) 118288 I ('$D(GNDX))!(GNDX="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN 118289 "RTN","C0CRNFRP",140,0) 118290 E D ; WE ARE USING AN INDEX 118291 "RTN","C0CRNFRP",141,0) 118292 . ;N ZG 118293 "RTN","C0CRNFRP",142,0) 118294 . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX 118295 "RTN","C0CRNFRP",143,0) 118296 . I ZG'="" D ; 118297 "RTN","C0CRNFRP",144,0) 118298 . . I $QS(ZG,3)=GREF D ; IS GREF IN INDEX? 118299 "RTN","C0CRNFRP",145,0) 118300 . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN 118301 "RTN","C0CRNFRP",146,0) 118302 . . E S GIEN="" ; NOT FOUND IN INDEX 118303 "RTN","C0CRNFRP",147,0) 118304 . E S GIEN="" ; 118305 "RTN","C0CRNFRP",148,0) 118306 ;W "IEN: ",GIEN,! 118307 "RTN","C0CRNFRP",149,0) 118308 ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME 118309 "RTN","C0CRNFRP",150,0) 118310 I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED) 118311 "RTN","C0CRNFRP",151,0) 118312 E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED) 118313 "RTN","C0CRNFRP",152,0) 118314 S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE 118315 "RTN","C0CRNFRP",153,0) 118316 D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP 118317 "RTN","C0CRNFRP",154,0) 118318 K C0CTMP 118319 "RTN","C0CRNFRP",155,0) 118320 D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP") 118321 "RTN","C0CRNFRP",156,0) 118322 D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE 118323 "RTN","C0CRNFRP",157,0) 118324 S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE 118325 "RTN","C0CRNFRP",158,0) 118326 S (C0CI,C0CJ)="" 118327 "RTN","C0CRNFRP",159,0) 118328 F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES 118329 "RTN","C0CRNFRP",160,0) 118330 . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE 118331 "RTN","C0CRNFRP",161,0) 118332 . F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS 118333 "RTN","C0CRNFRP",162,0) 118334 . . ;W C0CJ," ",C0CI,! 118335 "RTN","C0CRNFRP",163,0) 118336 . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME 118337 "RTN","C0CRNFRP",164,0) 118338 . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ; 118339 "RTN","C0CRNFRP",165,0) 118340 . . I C0CVALUE["C0CTMP" D ; WP FIELD 118341 "RTN","C0CRNFRP",166,0) 118342 . . . N ZT,ZWP S ZWP=0 ;ITERATOR 118343 "RTN","C0CRNFRP",167,0) 118344 . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE 118345 "RTN","C0CRNFRP",168,0) 118346 . . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE 118347 "RTN","C0CRNFRP",169,0) 118348 . . . F S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP D ; 118349 "RTN","C0CRNFRP",170,0) 118350 . . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP 118351 "RTN","C0CRNFRP",171,0) 118352 . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT " 118353 "RTN","C0CRNFRP",172,0) 118354 . . . . S C0CVALUE=C0CVALUE_ZT ; 118355 "RTN","C0CRNFRP",173,0) 118356 . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3 118357 "RTN","C0CRNFRP",174,0) 118358 . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I")) 118359 "RTN","C0CRNFRP",175,0) 118360 I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED 118361 "RTN","C0CRNFRP",176,0) 118362 . S C0CI="" 118363 "RTN","C0CRNFRP",177,0) 118364 . F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY 118365 "RTN","C0CRNFRP",178,0) 118366 . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES 118367 "RTN","C0CRNFRP",179,0) 118040 118368 Q 118041 "RTN","C0CRNFRP",62,0) 118042 ; 118043 "RTN","C0CRNFRP",63,0) 118044 GETN(C0CGRTN,GFILE,GREF,GNDX,GNN) ; GET BY NAME ; RETURN A FIELD VALUE MAP 118045 "RTN","C0CRNFRP",64,0) 118046 ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL 118047 "RTN","C0CRNFRP",65,0) 118048 ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP 118049 "RTN","C0CRNFRP",66,0) 118050 ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")="" 118051 "RTN","C0CRNFRP",67,0) 118369 "RTN","C0CRNFRP",180,0) 118370 ; 118371 "RTN","C0CRNFRP",181,0) 118372 GETN2(GARTN,GAFILE,GAIDX,GACNT,GASTRT,GANN) ; RETURN FIELD MAP AND VALUES 118373 "RTN","C0CRNFRP",182,0) 118374 ; GARTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP 118375 "RTN","C0CRNFRP",183,0) 118376 ; .. FIELD MAP @GARTN@("F","FIELDNAME")="FILE;FIELD#" 118377 "RTN","C0CRNFRP",184,0) 118052 118378 ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP 118053 "RTN","C0CRNFRP",68,0) 118054 ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE 118055 "RTN","C0CRNFRP",69,0) 118056 ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP 118057 "RTN","C0CRNFRP",70,0) 118058 ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP 118059 "RTN","C0CRNFRP",71,0) 118060 ; .. NULL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE 118061 "RTN","C0CRNFRP",72,0) 118062 ; IF GREF IS "" THE FIRST RECORD IS OBTAINED 118063 "RTN","C0CRNFRP",73,0) 118064 ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE 118065 "RTN","C0CRNFRP",74,0) 118066 ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN 118067 "RTN","C0CRNFRP",75,0) 118068 ; GREF IS THE VALUE FOR THE INDEX 118069 "RTN","C0CRNFRP",76,0) 118379 "RTN","C0CRNFRP",185,0) 118380 ; .. VALUE MAP @GARTN@("V","IEN","FIELDNAME","N")=VALUE 118381 "RTN","C0CRNFRP",186,0) 118382 ; .. WHERE N IS THE INDEX FOR MULTIPLES.. 1 FOR SINGLE VALUES 118383 "RTN","C0CRNFRP",187,0) 118384 ; .. GARTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE 118385 "RTN","C0CRNFRP",188,0) 118386 ; .. IF GANN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP 118387 "RTN","C0CRNFRP",189,0) 118388 ; .. EVEN IF GANN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP 118389 "RTN","C0CRNFRP",190,0) 118390 ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE 118391 "RTN","C0CRNFRP",191,0) 118392 ; GAFILE IS THE FILE NUMBER TO BE PROCESSED. IT IS PASSED BY VALUE 118393 "RTN","C0CRNFRP",192,0) 118394 ; GAIDX IS THE OPTIONAL INDEX TO USE IN THE FILE. IF GAIDX IS "" THE IEN 118395 "RTN","C0CRNFRP",193,0) 118396 ; .. OF THE FILE WILL BE USED 118397 "RTN","C0CRNFRP",194,0) 118398 ; GACNT IS THE NUMBER OF RECORDS TO PROCESS. IT IS PASSED BY VALUE 118399 "RTN","C0CRNFRP",195,0) 118400 ; .. IF GARCNT IS NULL, ALL RECORDS ARE PROCESSED 118401 "RTN","C0CRNFRP",196,0) 118402 ; GASTRT IS THE IEN OF THE FIRST RECORD TO PROCESS. IT IS PASSED BY VALUE 118403 "RTN","C0CRNFRP",197,0) 118404 ; .. IF GARSTART IS NULL, PROCESSING STARTS AT THE FIRST RECORD 118405 "RTN","C0CRNFRP",198,0) 118070 118406 ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED 118071 "RTN","C0CRNFRP",77,0) 118072 ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN 118073 "RTN","C0CRNFRP",78,0) 118074 ; 118075 "RTN","C0CRNFRP",79,0) 118076 ; 118077 "RTN","C0CRNFRP",80,0) 118078 ;RETURN FORMAT: 118079 "RTN","C0CRNFRP",81,0) 118080 ;^TMP("C0CRNF",$J,0)="NUMBER_OF_RESULTS^FILE_NUMBER^RNF1^IEN^CURRENT_DATE^$J^DUZ_$C(30)" 118081 "RTN","C0CRNFRP",82,0) 118082 ;^TMP("C0CRNF",$J,I)="FIELD_NAME^FILE_NUMBER^FIELD_NUMBER^VALUE^INTERNAL_VALUE_$C(30)" 118083 "RTN","C0CRNFRP",83,0) 118084 ; 118085 "RTN","C0CRNFRP",84,0) 118086 ;SAMPLE OUTPUT FROM FIELDS^C0CRNF: 118087 "RTN","C0CRNFRP",85,0) 118088 ;C0CRNFGETN(0)="2^RNF1^5095^3091209^2908^3268" 118089 "RTN","C0CRNFRP",86,0) 118090 ;C0CRNFGETN("1U4N")="2^.0905^H5369" 118091 "RTN","C0CRNFRP",87,0) 118092 ;C0CRNFGETN("1U4N","I")="^^H5369" 118093 "RTN","C0CRNFRP",88,0) 118094 ;C0CRNFGETN("ADDRESS CHANGE DT/TM")="2^.118^OCT 21,2009@08:03:26" 118095 "RTN","C0CRNFRP",89,0) 118096 ;C0CRNFGETN("ADDRESS CHANGE DT/TM","I")="^^3091021.080326" 118097 "RTN","C0CRNFRP",90,0) 118098 ; 118099 "RTN","C0CRNFRP",91,0) 118100 ;FORMAT APPEARS TO BE: 118101 "RTN","C0CRNFRP",92,0) 118102 ;VARIABLENAME(0)="FILE_NUMBER^RNF1^IEN^CURRENT_DATE^$J^DUZ" 118103 "RTN","C0CRNFRP",93,0) 118104 ;VARIABLENAME("FIELD_NAME")="FILE_NUMBER^FIELD_NUMBER^VALUE" 118105 "RTN","C0CRNFRP",94,0) 118106 ;VARIABLENAME("FIELD_NAME","I")="^^INTERNAL_VALUE" 118107 "RTN","C0CRNFRP",95,0) 118108 ; 118109 "RTN","C0CRNFRP",96,0) 118110 ;SET DEBUG VALUE - REQUIRED - 0=OFF 1=ON 118111 "RTN","C0CRNFRP",97,0) 118112 S DEBUG=0 118113 "RTN","C0CRNFRP",98,0) 118114 ;SET RETURN VALUE 118115 "RTN","C0CRNFRP",99,0) 118116 S C0CGRTN=$NA(^TMP("C0CRNF",$J)) 118117 "RTN","C0CRNFRP",100,0) 118118 K @C0CGRTN 118119 "RTN","C0CRNFRP",101,0) 118120 ;RUN WRAPPED CALL 118121 "RTN","C0CRNFRP",102,0) 118122 D GETN^C0CRNF("C0CRTN",$G(GFILE),$G(GREF),$G(GNDX),$G(GNN)) 118123 "RTN","C0CRNFRP",103,0) 118124 S J="" 118125 "RTN","C0CRNFRP",104,0) 118126 S I=1 118127 "RTN","C0CRNFRP",105,0) 118128 ;FORMAT RETURN 118129 "RTN","C0CRNFRP",106,0) 118130 F S J=$O(C0CRTN(J)) Q:J="" D ; FOR EACH FIELD IN THE ARRAY 118131 "RTN","C0CRNFRP",107,0) 118132 . I J=0 S J=$O(C0CRTN(J)) ; SKIP THE 0 NODE 118133 "RTN","C0CRNFRP",108,0) 118134 . S @C0CGRTN@(I)=J_"^"_C0CRTN(J)_"^" ; GETS THE FIRST LINE 118135 "RTN","C0CRNFRP",109,0) 118136 . ;S J=$O(C0CRTN(J)) ; INCREMENT J SO WE CAN GET THE INTERNAL DATA 118137 "RTN","C0CRNFRP",110,0) 118138 . ;TEST TO SEE IF INTERNAL DATA EXISTS 118139 "RTN","C0CRNFRP",111,0) 118140 . I $D(C0CRTN(J,"I"))=1 D 118141 "RTN","C0CRNFRP",112,0) 118142 . . S @C0CGRTN@(I)=@C0CGRTN@(I)_$P(C0CRTN(J,"I"),U,3) ; GETS THE INTERNAL VALUE PIECE 3 118143 "RTN","C0CRNFRP",113,0) 118144 . S I=I+1 118145 "RTN","C0CRNFRP",114,0) 118146 S @C0CGRTN@(0)=I-1_"^"_C0CRTN(0) 118147 "RTN","C0CRNFRP",115,0) 118148 ;CLEAN UP 118149 "RTN","C0CRNFRP",116,0) 118150 K J,I 118151 "RTN","C0CRNFRP",117,0) 118407 "RTN","C0CRNFRP",199,0) 118408 ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GARFLD AND GARVAL 118409 "RTN","C0CRNFRP",200,0) 118410 ;N GATMP,GAI,GAF 118411 "RTN","C0CRNFRP",201,0) 118412 S GAF=$$FILEREF(GAFILE) ; GET CLOSED ROOT FOR THE FILE NUMBER GAFILE 118413 "RTN","C0CRNFRP",202,0) 118414 I '$D(GAIDX) S GAIDX="" ;DEFAULT 118415 "RTN","C0CRNFRP",203,0) 118416 I '$D(GANN) S GANN="" ;DEFAULT ONLY POPULATED FIELDS RETURNED 118417 "RTN","C0CRNFRP",204,0) 118418 I GAIDX'="" S GAF=$NA(@GAF@(GAIDX)) ; IF WE ARE USING AN INDEX 118419 "RTN","C0CRNFRP",205,0) 118420 W GAF,! 118421 "RTN","C0CRNFRP",206,0) 118422 W $O(@GAF@(0)) ; 118423 "RTN","C0CRNFRP",207,0) 118424 S GAI=0 ;ITERATOR 118425 "RTN","C0CRNFRP",208,0) 118426 F S GAI=$O(@GAF@(GAI)) Q:GAI="" D ; 118427 "RTN","C0CRNFRP",209,0) 118428 . D GETN1("GATMP",GAFILE,GAI,GAIDX,GANN) ;GET ONE RECORD 118429 "RTN","C0CRNFRP",210,0) 118430 . N GAX S GAX=0 118431 "RTN","C0CRNFRP",211,0) 118432 . F S GAX=$O(GATMP(GAX)) Q:GAX="" D ;PULL OUT THE FIELDS 118433 "RTN","C0CRNFRP",212,0) 118434 . . D ADDNV(GARTN,GAI,GAX,GATMP(GAX)) ;INSERT THE NAME/VALUE INTO GARTN 118435 "RTN","C0CRNFRP",213,0) 118152 118436 Q 118153 "RTN","C0CRNFRP",118,0) 118154 ; 118155 "RTN","C0CRNFRP",119,0) 118156 GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP 118157 "RTN","C0CRNFRP",120,0) 118158 ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1 118159 "RTN","C0CRNFRP",121,0) 118160 ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL 118161 "RTN","C0CRNFRP",122,0) 118162 ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN 118163 "RTN","C0CRNFRP",123,0) 118164 ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP 118165 "RTN","C0CRNFRP",124,0) 118166 ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")="" 118167 "RTN","C0CRNFRP",125,0) 118168 ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP 118169 "RTN","C0CRNFRP",126,0) 118170 ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE 118171 "RTN","C0CRNFRP",127,0) 118172 ; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE 118173 "RTN","C0CRNFRP",128,0) 118174 ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP 118175 "RTN","C0CRNFRP",129,0) 118176 ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP 118177 "RTN","C0CRNFRP",130,0) 118178 ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE 118179 "RTN","C0CRNFRP",131,0) 118180 ; IF GREF IS "" THE FIRST RECORD IS OBTAINED 118181 "RTN","C0CRNFRP",132,0) 118182 ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE 118183 "RTN","C0CRNFRP",133,0) 118184 ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN 118185 "RTN","C0CRNFRP",134,0) 118186 ; GREF IS THE VALUE FOR THE INDEX 118187 "RTN","C0CRNFRP",135,0) 118188 ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED 118189 "RTN","C0CRNFRP",136,0) 118190 ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN 118191 "RTN","C0CRNFRP",137,0) 118192 ; 118193 "RTN","C0CRNFRP",138,0) 118194 ; 118195 "RTN","C0CRNFRP",139,0) 118196 N GIEN,GF 118197 "RTN","C0CRNFRP",140,0) 118198 S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE 118199 "RTN","C0CRNFRP",141,0) 118200 I ('$D(GNDX))!(GNDX="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN 118201 "RTN","C0CRNFRP",142,0) 118202 E D ; WE ARE USING AN INDEX 118203 "RTN","C0CRNFRP",143,0) 118204 . ;N ZG 118205 "RTN","C0CRNFRP",144,0) 118206 . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX 118207 "RTN","C0CRNFRP",145,0) 118208 . I ZG'="" D ; 118209 "RTN","C0CRNFRP",146,0) 118210 . . I $QS(ZG,3)=GREF D ; IS GREF IN INDEX? 118211 "RTN","C0CRNFRP",147,0) 118212 . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN 118213 "RTN","C0CRNFRP",148,0) 118214 . . E S GIEN="" ; NOT FOUND IN INDEX 118215 "RTN","C0CRNFRP",149,0) 118216 . E S GIEN="" ; 118217 "RTN","C0CRNFRP",150,0) 118218 ;W "IEN: ",GIEN,! 118219 "RTN","C0CRNFRP",151,0) 118220 ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME 118221 "RTN","C0CRNFRP",152,0) 118222 I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED) 118223 "RTN","C0CRNFRP",153,0) 118224 E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED) 118225 "RTN","C0CRNFRP",154,0) 118226 S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE 118227 "RTN","C0CRNFRP",155,0) 118228 D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP 118229 "RTN","C0CRNFRP",156,0) 118230 K C0CTMP 118231 "RTN","C0CRNFRP",157,0) 118232 D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP") 118233 "RTN","C0CRNFRP",158,0) 118234 D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE 118235 "RTN","C0CRNFRP",159,0) 118236 S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE 118237 "RTN","C0CRNFRP",160,0) 118238 S (C0CI,C0CJ)="" 118239 "RTN","C0CRNFRP",161,0) 118240 F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES 118241 "RTN","C0CRNFRP",162,0) 118242 . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE 118243 "RTN","C0CRNFRP",163,0) 118244 . F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS 118245 "RTN","C0CRNFRP",164,0) 118246 . . ;W C0CJ," ",C0CI,! 118247 "RTN","C0CRNFRP",165,0) 118248 . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME 118249 "RTN","C0CRNFRP",166,0) 118250 . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ; 118251 "RTN","C0CRNFRP",167,0) 118252 . . I C0CVALUE["C0CTMP" D ; WP FIELD 118253 "RTN","C0CRNFRP",168,0) 118254 . . . N ZT,ZWP S ZWP=0 ;ITERATOR 118255 "RTN","C0CRNFRP",169,0) 118256 . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE 118257 "RTN","C0CRNFRP",170,0) 118258 . . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE 118259 "RTN","C0CRNFRP",171,0) 118260 . . . F S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP D ; 118261 "RTN","C0CRNFRP",172,0) 118262 . . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP 118263 "RTN","C0CRNFRP",173,0) 118264 . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT " 118265 "RTN","C0CRNFRP",174,0) 118266 . . . . S C0CVALUE=C0CVALUE_ZT ; 118267 "RTN","C0CRNFRP",175,0) 118268 . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3 118269 "RTN","C0CRNFRP",176,0) 118270 . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I")) 118271 "RTN","C0CRNFRP",177,0) 118272 I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED 118273 "RTN","C0CRNFRP",178,0) 118274 . S C0CI="" 118275 "RTN","C0CRNFRP",179,0) 118276 . F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY 118277 "RTN","C0CRNFRP",180,0) 118278 . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES 118279 "RTN","C0CRNFRP",181,0) 118437 "RTN","C0CRNFRP",214,0) 118438 ; 118439 "RTN","C0CRNFRP",215,0) 118440 ADDNV(GNV,GNVN,GNVF,GNVV) ; CREATE AN ELEMENT OF THE MATRIX 118441 "RTN","C0CRNFRP",216,0) 118442 ; 118443 "RTN","C0CRNFRP",217,0) 118444 S @GNV@("F",GNVF)=$P(GNVV,"^",1)_"^"_$P(GNVV,"^",2) ;NAME=FILE^FIELD# 118445 "RTN","C0CRNFRP",218,0) 118446 S @GNV@("V",GNVN,GNVF,1)=$P(GNVV,"^",3) ;SET THE VALUE 118447 "RTN","C0CRNFRP",219,0) 118280 118448 Q 118281 "RTN","C0CRNFRP",182,0) 118282 ; 118283 "RTN","C0CRNFRP",183,0) 118284 GETN2(GARTN,GAFILE,GAIDX,GACNT,GASTRT,GANN) ; RETURN FIELD MAP AND VALUES 118285 "RTN","C0CRNFRP",184,0) 118286 ; GARTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP 118287 "RTN","C0CRNFRP",185,0) 118288 ; .. FIELD MAP @GARTN@("F","FIELDNAME")="FILE;FIELD#" 118289 "RTN","C0CRNFRP",186,0) 118290 ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP 118291 "RTN","C0CRNFRP",187,0) 118292 ; .. VALUE MAP @GARTN@("V","IEN","FIELDNAME","N")=VALUE 118293 "RTN","C0CRNFRP",188,0) 118294 ; .. WHERE N IS THE INDEX FOR MULTIPLES.. 1 FOR SINGLE VALUES 118295 "RTN","C0CRNFRP",189,0) 118296 ; .. GARTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE 118297 "RTN","C0CRNFRP",190,0) 118298 ; .. IF GANN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP 118299 "RTN","C0CRNFRP",191,0) 118300 ; .. EVEN IF GANN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP 118301 "RTN","C0CRNFRP",192,0) 118302 ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE 118303 "RTN","C0CRNFRP",193,0) 118304 ; GAFILE IS THE FILE NUMBER TO BE PROCESSED. IT IS PASSED BY VALUE 118305 "RTN","C0CRNFRP",194,0) 118306 ; GAIDX IS THE OPTIONAL INDEX TO USE IN THE FILE. IF GAIDX IS "" THE IEN 118307 "RTN","C0CRNFRP",195,0) 118308 ; .. OF THE FILE WILL BE USED 118309 "RTN","C0CRNFRP",196,0) 118310 ; GACNT IS THE NUMBER OF RECORDS TO PROCESS. IT IS PASSED BY VALUE 118311 "RTN","C0CRNFRP",197,0) 118312 ; .. IF GARCNT IS NULL, ALL RECORDS ARE PROCESSED 118313 "RTN","C0CRNFRP",198,0) 118314 ; GASTRT IS THE IEN OF THE FIRST RECORD TO PROCESS. IT IS PASSED BY VALUE 118315 "RTN","C0CRNFRP",199,0) 118316 ; .. IF GARSTART IS NULL, PROCESSING STARTS AT THE FIRST RECORD 118317 "RTN","C0CRNFRP",200,0) 118318 ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED 118319 "RTN","C0CRNFRP",201,0) 118320 ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GARFLD AND GARVAL 118321 "RTN","C0CRNFRP",202,0) 118322 ;N GATMP,GAI,GAF 118323 "RTN","C0CRNFRP",203,0) 118324 S GAF=$$FILEREF(GAFILE) ; GET CLOSED ROOT FOR THE FILE NUMBER GAFILE 118325 "RTN","C0CRNFRP",204,0) 118326 I '$D(GAIDX) S GAIDX="" ;DEFAULT 118327 "RTN","C0CRNFRP",205,0) 118328 I '$D(GANN) S GANN="" ;DEFAULT ONLY POPULATED FIELDS RETURNED 118329 "RTN","C0CRNFRP",206,0) 118330 I GAIDX'="" S GAF=$NA(@GAF@(GAIDX)) ; IF WE ARE USING AN INDEX 118331 "RTN","C0CRNFRP",207,0) 118332 W GAF,! 118333 "RTN","C0CRNFRP",208,0) 118334 W $O(@GAF@(0)) ; 118335 "RTN","C0CRNFRP",209,0) 118336 S GAI=0 ;ITERATOR 118337 "RTN","C0CRNFRP",210,0) 118338 F S GAI=$O(@GAF@(GAI)) Q:GAI="" D ; 118339 "RTN","C0CRNFRP",211,0) 118340 . D GETN1("GATMP",GAFILE,GAI,GAIDX,GANN) ;GET ONE RECORD 118341 "RTN","C0CRNFRP",212,0) 118342 . N GAX S GAX=0 118343 "RTN","C0CRNFRP",213,0) 118344 . F S GAX=$O(GATMP(GAX)) Q:GAX="" D ;PULL OUT THE FIELDS 118345 "RTN","C0CRNFRP",214,0) 118346 . . D ADDNV(GARTN,GAI,GAX,GATMP(GAX)) ;INSERT THE NAME/VALUE INTO GARTN 118347 "RTN","C0CRNFRP",215,0) 118449 "RTN","C0CRNFRP",220,0) 118450 ; 118451 "RTN","C0CRNFRP",221,0) 118452 RNF2CSV(RNRTN,RNIN,RNSTY) ;CONVERTS AN RFN2 GLOBAL TO A CSV FORMAT 118453 "RTN","C0CRNFRP",222,0) 118454 ; READY TO WRITE FOR USE WITH EXCEL @RNRTN@(0) IS NUMBER OF LINES 118455 "RTN","C0CRNFRP",223,0) 118456 ; RNSTY IS STYLE OF THE OUTPUT - 118457 "RTN","C0CRNFRP",224,0) 118458 ; .. "NV"= ROWS ARE NAMES, COLUMNS ARE VALUES 118459 "RTN","C0CRNFRP",225,0) 118460 ; .. "VN"= ROWS ARE VALUES, COLUMNS ARE NAMES 118461 "RTN","C0CRNFRP",226,0) 118462 ; .. DEFAULT IS "NV" BECAUSE MANY MATRICES HAVE MORE FIELDS THAN VALUES 118463 "RTN","C0CRNFRP",227,0) 118464 N RNR,RNC ;ROW ROOT,COL ROOT 118465 "RTN","C0CRNFRP",228,0) 118466 N RNI,RNJ,RNX 118467 "RTN","C0CRNFRP",229,0) 118468 I '$D(RNSTY) S RNSTY="NV" ;DEFAULT 118469 "RTN","C0CRNFRP",230,0) 118470 I RNSTY="NV" D NV(RNRTN,RNIN) ; INTERNAL SUBROUTINES DEPENDING ON ORIENTATION 118471 "RTN","C0CRNFRP",231,0) 118472 E D VN(RNRTN,RNIN) ; 118473 "RTN","C0CRNFRP",232,0) 118348 118474 Q 118349 "RTN","C0CRNFRP",216,0) 118350 ; 118351 "RTN","C0CRNFRP",217,0) 118352 ADDNV(GNV,GNVN,GNVF,GNVV) ; CREATE AN ELEMENT OF THE MATRIX 118353 "RTN","C0CRNFRP",218,0) 118354 ; 118355 "RTN","C0CRNFRP",219,0) 118356 S @GNV@("F",GNVF)=$P(GNVV,"^",1)_"^"_$P(GNVV,"^",2) ;NAME=FILE^FIELD# 118357 "RTN","C0CRNFRP",220,0) 118358 S @GNV@("V",GNVN,GNVF,1)=$P(GNVV,"^",3) ;SET THE VALUE 118359 "RTN","C0CRNFRP",221,0) 118475 "RTN","C0CRNFRP",233,0) 118476 ; 118477 "RTN","C0CRNFRP",234,0) 118478 NV(RNRTN,RNIN) ; 118479 "RTN","C0CRNFRP",235,0) 118480 S RNR=$NA(@RNIN@("F")) 118481 "RTN","C0CRNFRP",236,0) 118482 S RNC=$NA(@RNIN@("V")) 118483 "RTN","C0CRNFRP",237,0) 118484 ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER 118485 "RTN","C0CRNFRP",238,0) 118486 S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD" 118487 "RTN","C0CRNFRP",239,0) 118488 S RNI="" 118489 "RTN","C0CRNFRP",240,0) 118490 F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN 118491 "RTN","C0CRNFRP",241,0) 118492 . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA 118493 "RTN","C0CRNFRP",242,0) 118494 S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA 118495 "RTN","C0CRNFRP",243,0) 118496 D PUSH^GPLXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS 118497 "RTN","C0CRNFRP",244,0) 118498 S RNI="" 118499 "RTN","C0CRNFRP",245,0) 118500 F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW 118501 "RTN","C0CRNFRP",246,0) 118502 . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD 118503 "RTN","C0CRNFRP",247,0) 118504 . S RNJ="" 118505 "RTN","C0CRNFRP",248,0) 118506 . F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL 118507 "RTN","C0CRNFRP",249,0) 118508 . . I $D(@RNC@(RNJ,RNI,1)) D ; THIS ROW HAS THIS COLUMN 118509 "RTN","C0CRNFRP",250,0) 118510 . . . S RNX=RNX_""""_@RNC@(RNJ,RNI,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA 118511 "RTN","C0CRNFRP",251,0) 118512 . . E S RNX=RNX_"," ; NUL COLUMN 118513 "RTN","C0CRNFRP",252,0) 118514 . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA 118515 "RTN","C0CRNFRP",253,0) 118516 . D PUSH^GPLXPATH(RNRTN,RNX) 118517 "RTN","C0CRNFRP",254,0) 118360 118518 Q 118361 "RTN","C0CRNFRP",222,0) 118362 ; 118363 "RTN","C0CRNFRP",223,0) 118364 RNF2CSV(RNRTN,RNIN,RNSTY) ;CONVERTS AN RFN2 GLOBAL TO A CSV FORMAT 118365 "RTN","C0CRNFRP",224,0) 118366 ; READY TO WRITE FOR USE WITH EXCEL @RNRTN@(0) IS NUMBER OF LINES 118367 "RTN","C0CRNFRP",225,0) 118368 ; RNSTY IS STYLE OF THE OUTPUT - 118369 "RTN","C0CRNFRP",226,0) 118370 ; .. "NV"= ROWS ARE NAMES, COLUMNS ARE VALUES 118371 "RTN","C0CRNFRP",227,0) 118372 ; .. "VN"= ROWS ARE VALUES, COLUMNS ARE NAMES 118373 "RTN","C0CRNFRP",228,0) 118374 ; .. DEFAULT IS "NV" BECAUSE MANY MATRICES HAVE MORE FIELDS THAN VALUES 118375 "RTN","C0CRNFRP",229,0) 118376 N RNR,RNC ;ROW ROOT,COL ROOT 118377 "RTN","C0CRNFRP",230,0) 118378 N RNI,RNJ,RNX 118379 "RTN","C0CRNFRP",231,0) 118380 I '$D(RNSTY) S RNSTY="NV" ;DEFAULT 118381 "RTN","C0CRNFRP",232,0) 118382 I RNSTY="NV" D NV(RNRTN,RNIN) ; INTERNAL SUBROUTINES DEPENDING ON ORIENTATION 118383 "RTN","C0CRNFRP",233,0) 118384 E D VN(RNRTN,RNIN) ; 118385 "RTN","C0CRNFRP",234,0) 118519 "RTN","C0CRNFRP",255,0) 118520 ; 118521 "RTN","C0CRNFRP",256,0) 118522 VN(RNRTN,RNIN) ; 118523 "RTN","C0CRNFRP",257,0) 118524 S RNR=$NA(@RNIN@("V")) 118525 "RTN","C0CRNFRP",258,0) 118526 S RNC=$NA(@RNIN@("F")) 118527 "RTN","C0CRNFRP",259,0) 118528 ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER 118529 "RTN","C0CRNFRP",260,0) 118530 S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD" 118531 "RTN","C0CRNFRP",261,0) 118532 S RNI="" 118533 "RTN","C0CRNFRP",262,0) 118534 F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN 118535 "RTN","C0CRNFRP",263,0) 118536 . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA 118537 "RTN","C0CRNFRP",264,0) 118538 S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA 118539 "RTN","C0CRNFRP",265,0) 118540 D PUSH^GPLXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS 118541 "RTN","C0CRNFRP",266,0) 118542 S RNI="" 118543 "RTN","C0CRNFRP",267,0) 118544 F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW 118545 "RTN","C0CRNFRP",268,0) 118546 . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD 118547 "RTN","C0CRNFRP",269,0) 118548 . S RNJ="" 118549 "RTN","C0CRNFRP",270,0) 118550 . F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL 118551 "RTN","C0CRNFRP",271,0) 118552 . . I $D(@RNR@(RNI,RNJ,1)) D ; THIS ROW HAS THIS COLUMN 118553 "RTN","C0CRNFRP",272,0) 118554 . . . S RNX=RNX_""""_@RNR@(RNI,RNJ,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA 118555 "RTN","C0CRNFRP",273,0) 118556 . . E S RNX=RNX_"," ; NUL COLUMN 118557 "RTN","C0CRNFRP",274,0) 118558 . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA 118559 "RTN","C0CRNFRP",275,0) 118560 . D PUSH^GPLXPATH(RNRTN,RNX) 118561 "RTN","C0CRNFRP",276,0) 118386 118562 Q 118387 "RTN","C0CRNFRP",235,0) 118388 ; 118389 "RTN","C0CRNFRP",236,0) 118390 NV(RNRTN,RNIN) ; 118391 "RTN","C0CRNFRP",237,0) 118392 S RNR=$NA(@RNIN@("F")) 118393 "RTN","C0CRNFRP",238,0) 118394 S RNC=$NA(@RNIN@("V")) 118395 "RTN","C0CRNFRP",239,0) 118396 ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER 118397 "RTN","C0CRNFRP",240,0) 118398 S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD" 118399 "RTN","C0CRNFRP",241,0) 118400 S RNI="" 118401 "RTN","C0CRNFRP",242,0) 118402 F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN 118403 "RTN","C0CRNFRP",243,0) 118404 . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA 118405 "RTN","C0CRNFRP",244,0) 118406 S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA 118407 "RTN","C0CRNFRP",245,0) 118408 D PUSH^GPLXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS 118409 "RTN","C0CRNFRP",246,0) 118410 S RNI="" 118411 "RTN","C0CRNFRP",247,0) 118412 F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW 118413 "RTN","C0CRNFRP",248,0) 118414 . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD 118415 "RTN","C0CRNFRP",249,0) 118416 . S RNJ="" 118417 "RTN","C0CRNFRP",250,0) 118418 . F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL 118419 "RTN","C0CRNFRP",251,0) 118420 . . I $D(@RNC@(RNJ,RNI,1)) D ; THIS ROW HAS THIS COLUMN 118421 "RTN","C0CRNFRP",252,0) 118422 . . . S RNX=RNX_""""_@RNC@(RNJ,RNI,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA 118423 "RTN","C0CRNFRP",253,0) 118424 . . E S RNX=RNX_"," ; NUL COLUMN 118425 "RTN","C0CRNFRP",254,0) 118426 . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA 118427 "RTN","C0CRNFRP",255,0) 118428 . D PUSH^GPLXPATH(RNRTN,RNX) 118429 "RTN","C0CRNFRP",256,0) 118563 "RTN","C0CRNFRP",277,0) 118564 ; 118565 "RTN","C0CRNFRP",278,0) 118566 READCSV(PATH,NAME,GLB) ; READ A CSV FILE IN FROM UNIX TO GLB, PASSED BY NAME 118567 "RTN","C0CRNFRP",279,0) 118568 ; 118569 "RTN","C0CRNFRP",280,0) 118570 Q $$FTG^%ZISH(PATH,NAME,GLB,1) 118571 "RTN","C0CRNFRP",281,0) 118572 ; 118573 "RTN","C0CRNFRP",282,0) 118574 FILE2CSV(FNUM,FVN) ; WRITES OUT A FILEMAN FILE TO CSV 118575 "RTN","C0CRNFRP",283,0) 118576 ; 118577 "RTN","C0CRNFRP",284,0) 118578 ;N G1,G2 118579 "RTN","C0CRNFRP",285,0) 118580 I '$D(FVN) S FVN="NV" ; DEFAULT ORIENTATION OF CVS FILE 118581 "RTN","C0CRNFRP",286,0) 118582 S G1=$NA(^TMP($J,"C0CCSV",1)) 118583 "RTN","C0CRNFRP",287,0) 118584 S G2=$NA(^TMP($J,"C0CCSV",2)) 118585 "RTN","C0CRNFRP",288,0) 118586 D GETN2(G1,FNUM) ; GET THE MATRIX 118587 "RTN","C0CRNFRP",289,0) 118588 D RNF2CSV(G2,G1,FVN) ; PREPARE THE CVS FILE 118589 "RTN","C0CRNFRP",290,0) 118590 K @G1 118591 "RTN","C0CRNFRP",291,0) 118592 D FILEOUT(G2,"FILE_"_FNUM_".csv") 118593 "RTN","C0CRNFRP",292,0) 118594 K @G2 118595 "RTN","C0CRNFRP",293,0) 118430 118596 Q 118431 "RTN","C0CRNFRP",257,0) 118432 ; 118433 "RTN","C0CRNFRP",258,0) 118434 VN(RNRTN,RNIN) ; 118435 "RTN","C0CRNFRP",259,0) 118436 S RNR=$NA(@RNIN@("V")) 118437 "RTN","C0CRNFRP",260,0) 118438 S RNC=$NA(@RNIN@("F")) 118439 "RTN","C0CRNFRP",261,0) 118440 ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER 118441 "RTN","C0CRNFRP",262,0) 118442 S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD" 118443 "RTN","C0CRNFRP",263,0) 118444 S RNI="" 118445 "RTN","C0CRNFRP",264,0) 118446 F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN 118447 "RTN","C0CRNFRP",265,0) 118448 . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA 118449 "RTN","C0CRNFRP",266,0) 118450 S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA 118451 "RTN","C0CRNFRP",267,0) 118452 D PUSH^GPLXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS 118453 "RTN","C0CRNFRP",268,0) 118454 S RNI="" 118455 "RTN","C0CRNFRP",269,0) 118456 F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW 118457 "RTN","C0CRNFRP",270,0) 118458 . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD 118459 "RTN","C0CRNFRP",271,0) 118460 . S RNJ="" 118461 "RTN","C0CRNFRP",272,0) 118462 . F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL 118463 "RTN","C0CRNFRP",273,0) 118464 . . I $D(@RNR@(RNI,RNJ,1)) D ; THIS ROW HAS THIS COLUMN 118465 "RTN","C0CRNFRP",274,0) 118466 . . . S RNX=RNX_""""_@RNR@(RNI,RNJ,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA 118467 "RTN","C0CRNFRP",275,0) 118468 . . E S RNX=RNX_"," ; NUL COLUMN 118469 "RTN","C0CRNFRP",276,0) 118470 . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA 118471 "RTN","C0CRNFRP",277,0) 118472 . D PUSH^GPLXPATH(RNRTN,RNX) 118473 "RTN","C0CRNFRP",278,0) 118597 "RTN","C0CRNFRP",294,0) 118598 ; 118599 "RTN","C0CRNFRP",295,0) 118600 FILEOUT(FOARY,FONAM) ; WRITE OUT A FILE 118601 "RTN","C0CRNFRP",296,0) 118602 ; 118603 "RTN","C0CRNFRP",297,0) 118604 W $$OUTPUT^GPLXPATH($NA(@FOARY@(1)),FONAM,^TMP("GPLCCR","ODIR")) 118605 "RTN","C0CRNFRP",298,0) 118474 118606 Q 118475 "RTN","C0CRNFRP",279,0) 118476 ; 118477 "RTN","C0CRNFRP",280,0) 118478 READCSV(PATH,NAME,GLB) ; READ A CSV FILE IN FROM UNIX TO GLB, PASSED BY NAME 118479 "RTN","C0CRNFRP",281,0) 118480 ; 118481 "RTN","C0CRNFRP",282,0) 118482 Q $$FTG^%ZISH(PATH,NAME,GLB,1) 118483 "RTN","C0CRNFRP",283,0) 118484 ; 118485 "RTN","C0CRNFRP",284,0) 118486 FILE2CSV(FNUM,FVN) ; WRITES OUT A FILEMAN FILE TO CSV 118487 "RTN","C0CRNFRP",285,0) 118488 ; 118489 "RTN","C0CRNFRP",286,0) 118490 ;N G1,G2 118491 "RTN","C0CRNFRP",287,0) 118492 I '$D(FVN) S FVN="NV" ; DEFAULT ORIENTATION OF CVS FILE 118493 "RTN","C0CRNFRP",288,0) 118494 S G1=$NA(^TMP($J,"C0CCSV",1)) 118495 "RTN","C0CRNFRP",289,0) 118496 S G2=$NA(^TMP($J,"C0CCSV",2)) 118497 "RTN","C0CRNFRP",290,0) 118498 D GETN2(G1,FNUM) ; GET THE MATRIX 118499 "RTN","C0CRNFRP",291,0) 118500 D RNF2CSV(G2,G1,FVN) ; PREPARE THE CVS FILE 118501 "RTN","C0CRNFRP",292,0) 118502 K @G1 118503 "RTN","C0CRNFRP",293,0) 118504 D FILEOUT(G2,"FILE_"_FNUM_".csv") 118505 "RTN","C0CRNFRP",294,0) 118506 K @G2 118507 "RTN","C0CRNFRP",295,0) 118607 "RTN","C0CRNFRP",299,0) 118608 ; 118609 "RTN","C0CRNFRP",300,0) 118610 FILEREF(FNUM) ; EXTRINSIC THAT RETURNS A CLOSED ROOT FOR FILE NUMBER FNUM 118611 "RTN","C0CRNFRP",301,0) 118612 ; 118613 "RTN","C0CRNFRP",302,0) 118614 N C0CF 118615 "RTN","C0CRNFRP",303,0) 118616 S C0CF=^DIC(FNUM,0,"GL") ;OPEN ROOT TO FILE 118617 "RTN","C0CRNFRP",304,0) 118618 S C0CF=$P(C0CF,",",1)_")" ; CLOSE THE ROOT 118619 "RTN","C0CRNFRP",305,0) 118620 I C0CF["()" S C0CF=$P(C0CF,"()",1) 118621 "RTN","C0CRNFRP",306,0) 118622 Q C0CF 118623 "RTN","C0CRNFRP",307,0) 118624 ; 118625 "RTN","C0CRNFRP",308,0) 118626 SKIP ; 118627 "RTN","C0CRNFRP",309,0) 118628 N TXT,DIERR 118629 "RTN","C0CRNFRP",310,0) 118630 S TXT=$$GET1^DIQ(8925,TIUIEN,"2","","TXT") 118631 "RTN","C0CRNFRP",311,0) 118632 I $D(DIERR) D CLEAN^DILF Q 118633 "RTN","C0CRNFRP",312,0) 118634 W " report_text:",! ;Progress Note Text 118635 "RTN","C0CRNFRP",313,0) 118636 N LN S LN=0 118637 "RTN","C0CRNFRP",314,0) 118638 F S LN=$O(TXT(LN)) Q:'LN D 118639 "RTN","C0CRNFRP",315,0) 118640 . W " text"_LN_": "_TXT(LN),! 118641 "RTN","C0CRNFRP",316,0) 118642 . Q 118643 "RTN","C0CRNFRP",317,0) 118508 118644 Q 118509 "RTN","C0CRNFRP",296,0)118510 ;118511 "RTN","C0CRNFRP",297,0)118512 FILEOUT(FOARY,FONAM) ; WRITE OUT A FILE118513 "RTN","C0CRNFRP",298,0)118514 ;118515 "RTN","C0CRNFRP",299,0)118516 W $$OUTPUT^GPLXPATH($NA(@FOARY@(1)),FONAM,^TMP("GPLCCR","ODIR"))118517 "RTN","C0CRNFRP",300,0)118518 Q118519 "RTN","C0CRNFRP",301,0)118520 ;118521 "RTN","C0CRNFRP",302,0)118522 FILEREF(FNUM) ; EXTRINSIC THAT RETURNS A CLOSED ROOT FOR FILE NUMBER FNUM118523 "RTN","C0CRNFRP",303,0)118524 ;118525 "RTN","C0CRNFRP",304,0)118526 N C0CF118527 "RTN","C0CRNFRP",305,0)118528 S C0CF=^DIC(FNUM,0,"GL") ;OPEN ROOT TO FILE118529 "RTN","C0CRNFRP",306,0)118530 S C0CF=$P(C0CF,",",1)_")" ; CLOSE THE ROOT118531 "RTN","C0CRNFRP",307,0)118532 I C0CF["()" S C0CF=$P(C0CF,"()",1)118533 "RTN","C0CRNFRP",308,0)118534 Q C0CF118535 "RTN","C0CRNFRP",309,0)118536 ;118537 "RTN","C0CRNFRP",310,0)118538 SKIP ;118539 "RTN","C0CRNFRP",311,0)118540 N TXT,DIERR118541 "RTN","C0CRNFRP",312,0)118542 S TXT=$$GET1^DIQ(8925,TIUIEN,"2","","TXT")118543 "RTN","C0CRNFRP",313,0)118544 I $D(DIERR) D CLEAN^DILF Q118545 "RTN","C0CRNFRP",314,0)118546 W " report_text:",! ;Progress Note Text118547 "RTN","C0CRNFRP",315,0)118548 N LN S LN=0118549 "RTN","C0CRNFRP",316,0)118550 F S LN=$O(TXT(LN)) Q:'LN D118551 "RTN","C0CRNFRP",317,0)118552 . W " text"_LN_": "_TXT(LN),!118553 118645 "RTN","C0CRNFRP",318,0) 118554 . Q118646 ; 118555 118647 "RTN","C0CRNFRP",319,0) 118556 Q 118648 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 118557 118649 "RTN","C0CRNFRP",320,0) 118558 ; 118650 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF @ZTAB@(ZFN) 118559 118651 "RTN","C0CRNFRP",321,0) 118560 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 118652 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 118561 118653 "RTN","C0CRNFRP",322,0) 118562 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF @ZTAB@(ZFN)118654 I '$D(ZTAB) S ZTAB="C0CA" 118563 118655 "RTN","C0CRNFRP",323,0) 118656 Q $P(@ZTAB@(ZFN),"^",1) 118657 "RTN","C0CRNFRP",324,0) 118658 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED 118659 "RTN","C0CRNFRP",325,0) 118660 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF @ZTAB@(ZFN) 118661 "RTN","C0CRNFRP",326,0) 118564 118662 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 118565 "RTN","C0CRNFRP",32 4,0)118663 "RTN","C0CRNFRP",327,0) 118566 118664 I '$D(ZTAB) S ZTAB="C0CA" 118567 "RTN","C0CRNFRP",325,0)118568 Q $P(@ZTAB@(ZFN),"^",1)118569 "RTN","C0CRNFRP",326,0)118570 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED118571 "RTN","C0CRNFRP",327,0)118572 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF @ZTAB@(ZFN)118573 118665 "RTN","C0CRNFRP",328,0) 118666 Q $P(@ZTAB@(ZFN),"^",2) 118667 "RTN","C0CRNFRP",329,0) 118668 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED 118669 "RTN","C0CRNFRP",330,0) 118670 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN) 118671 "RTN","C0CRNFRP",331,0) 118574 118672 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 118575 "RTN","C0CRNFRP",3 29,0)118673 "RTN","C0CRNFRP",332,0) 118576 118674 I '$D(ZTAB) S ZTAB="C0CA" 118577 "RTN","C0CRNFRP",330,0) 118578 Q $P(@ZTAB@(ZFN),"^",2) 118579 "RTN","C0CRNFRP",331,0) 118580 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED 118581 "RTN","C0CRNFRP",332,0) 118675 "RTN","C0CRNFRP",333,0) 118676 Q $P($G(@ZTAB@(ZFN)),"^",3) 118677 "RTN","C0CRNFRP",334,0) 118678 ; 118679 "RTN","C0CRNFRP",335,0) 118680 ZVALUEI(ZFN,ZTAB) ;EXTRINSIC TO RETURN INTERNAL VALUE FOR FIELD NAME PASSED 118681 "RTN","C0CRNFRP",336,0) 118582 118682 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN) 118583 "RTN","C0CRNFRP",33 3,0)118683 "RTN","C0CRNFRP",337,0) 118584 118684 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 118585 "RTN","C0CRNFRP",33 4,0)118685 "RTN","C0CRNFRP",338,0) 118586 118686 I '$D(ZTAB) S ZTAB="C0CA" 118587 "RTN","C0CRNFRP",335,0)118588 Q $P($G(@ZTAB@(ZFN)),"^",3)118589 "RTN","C0CRNFRP",336,0)118590 ;118591 "RTN","C0CRNFRP",337,0)118592 ZVALUEI(ZFN,ZTAB) ;EXTRINSIC TO RETURN INTERNAL VALUE FOR FIELD NAME PASSED118593 "RTN","C0CRNFRP",338,0)118594 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)118595 118687 "RTN","C0CRNFRP",339,0) 118596 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA118688 Q $P($G(@ZTAB@(ZFN,"I")),"^",3) 118597 118689 "RTN","C0CRNFRP",340,0) 118598 I '$D(ZTAB) S ZTAB="C0CA"118599 "RTN","C0CRNFRP",341,0)118600 Q $P($G(@ZTAB@(ZFN,"I")),"^",3)118601 "RTN","C0CRNFRP",342,0)118602 118690 ; 118603 118691 "RTN","C0CRPMS") 118604 0^96^B1 6300714118692 0^96^B15891746 118605 118693 "RTN","C0CRPMS",1,0) 118606 118694 C0CRPMS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR RPMS ;1/14/09 14:33 118607 118695 "RTN","C0CRPMS",2,0) 118608 ;;1.2;C 0C;;May 11, 2012;Build 50118696 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 118609 118697 "RTN","C0CRPMS",3,0) 118610 ; Copyright 2008 George Lilly. Licensed under the terms of the GNU118698 ; 118611 118699 "RTN","C0CRPMS",4,0) 118612 ; General Public License See attached copy of the License.118700 ; This program is free software: you can redistribute it and/or modify 118613 118701 "RTN","C0CRPMS",5,0) 118614 ; 118702 ; it under the terms of the GNU Affero General Public License as 118615 118703 "RTN","C0CRPMS",6,0) 118616 ; This program is free software; you can redistribute it and/or modify118704 ; published by the Free Software Foundation, either version 3 of the 118617 118705 "RTN","C0CRPMS",7,0) 118618 ; it under the terms of the GNU General Public License as published by118706 ; License, or (at your option) any later version. 118619 118707 "RTN","C0CRPMS",8,0) 118620 ; the Free Software Foundation; either version 2 of the License, or118708 ; 118621 118709 "RTN","C0CRPMS",9,0) 118622 ; (at your option) any later version.118710 ; This program is distributed in the hope that it will be useful, 118623 118711 "RTN","C0CRPMS",10,0) 118624 ; 118712 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 118625 118713 "RTN","C0CRPMS",11,0) 118626 ; This program is distributed in the hope that it will be useful,118714 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 118627 118715 "RTN","C0CRPMS",12,0) 118628 ; but WITHOUT ANY WARRANTY; without even the implied warranty of118716 ; GNU Affero General Public License for more details. 118629 118717 "RTN","C0CRPMS",13,0) 118630 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the118718 ; 118631 118719 "RTN","C0CRPMS",14,0) 118632 ; GNU General Public License for more details.118720 ; You should have received a copy of the GNU Affero General Public License 118633 118721 "RTN","C0CRPMS",15,0) 118634 ; 118722 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 118635 118723 "RTN","C0CRPMS",16,0) 118636 ; You should have received a copy of the GNU General Public License along118724 ; 118637 118725 "RTN","C0CRPMS",17,0) 118638 ;with this program; if not, write to the Free Software Foundation, Inc.,118726 W "NO ENTRY FROM TOP",! 118639 118727 "RTN","C0CRPMS",18,0) 118640 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.118728 Q 118641 118729 "RTN","C0CRPMS",19,0) 118642 118730 ; 118643 118731 "RTN","C0CRPMS",20,0) 118644 W "NO ENTRY FROM TOP",! 118732 DISPLAY ; RUN THE PCC DISPLAY ROUTINE 118645 118733 "RTN","C0CRPMS",21,0) 118734 D ^APCDDISP 118735 "RTN","C0CRPMS",22,0) 118646 118736 Q 118647 "RTN","C0CRPMS",22,0)118648 ;118649 118737 "RTN","C0CRPMS",23,0) 118650 DISPLAY ; RUN THE PCC DISPLAY ROUTINE 118738 ; 118651 118739 "RTN","C0CRPMS",24,0) 118652 D ^APCDDISP 118740 VTYPES ; 118653 118741 "RTN","C0CRPMS",25,0) 118742 D GETN2^C0CRNF("G1",9999999.07) 118743 "RTN","C0CRPMS",26,0) 118744 ; ZWR G1 118745 "RTN","C0CRPMS",27,0) 118654 118746 Q 118655 "RTN","C0CRPMS",26,0)118656 ;118657 "RTN","C0CRPMS",27,0)118658 VTYPES ;118659 118747 "RTN","C0CRPMS",28,0) 118660 D GETN2^C0CRNF("G1",9999999.07)118748 ; 118661 118749 "RTN","C0CRPMS",29,0) 118662 ZWR G1 118750 VISITS(C0CDFN,C0CCNT) ;LIST VISIT DATES FOR PATIENT DFN 118663 118751 "RTN","C0CRPMS",30,0) 118752 ; C0CCNT IS A LIMIT ON HOW MANY VISITS TO DISPLAY ; DEFAULTS TO ALL 118753 "RTN","C0CRPMS",31,0) 118754 I '$D(C0CCNT) S C0CCNT=999999999 118755 "RTN","C0CRPMS",32,0) 118756 N G,GN 118757 "RTN","C0CRPMS",33,0) 118758 S G="" S GN=0 118759 "RTN","C0CRPMS",34,0) 118760 F S G=$O(^AUPNVSIT("AA",C0CDFN,G)) Q:(G="")!(GN>C0CCNT) D ; 118761 "RTN","C0CRPMS",35,0) 118762 . S GN=GN+1 118763 "RTN","C0CRPMS",36,0) 118764 . W $$FMDTOUTC^C0CUTIL(9999999-G),! 118765 "RTN","C0CRPMS",37,0) 118664 118766 Q 118665 "RTN","C0CRPMS",31,0)118666 ;118667 "RTN","C0CRPMS",32,0)118668 VISITS(C0CDFN,C0CCNT) ;LIST VISIT DATES FOR PATIENT DFN118669 "RTN","C0CRPMS",33,0)118670 ; C0CCNT IS A LIMIT ON HOW MANY VISITS TO DISPLAY ; DEFAULTS TO ALL118671 "RTN","C0CRPMS",34,0)118672 I '$D(C0CCNT) S C0CCNT=999999999118673 "RTN","C0CRPMS",35,0)118674 N G,GN118675 "RTN","C0CRPMS",36,0)118676 S G="" S GN=0118677 "RTN","C0CRPMS",37,0)118678 F S G=$O(^AUPNVSIT("AA",C0CDFN,G)) Q:(G="")!(GN>C0CCNT) D ;118679 118767 "RTN","C0CRPMS",38,0) 118768 ; 118769 "RTN","C0CRPMS",39,0) 118770 VISITS2(C0CDFN,C0CCNT) ;SECOND VERSION USING NEXTV 118771 "RTN","C0CRPMS",40,0) 118772 ; 118773 "RTN","C0CRPMS",41,0) 118774 N C0CG,GN 118775 "RTN","C0CRPMS",42,0) 118776 S C0CG="" 118777 "RTN","C0CRPMS",43,0) 118778 S GN=0 118779 "RTN","C0CRPMS",44,0) 118780 I '$D(C0CCNT) S C0CCNT=99999999 118781 "RTN","C0CRPMS",45,0) 118782 F S C0CG=$$NEXTV(C0CDFN,C0CG) Q:(C0CG="")!(GN'<C0CCNT) D ; 118783 "RTN","C0CRPMS",46,0) 118680 118784 . S GN=GN+1 118681 "RTN","C0CRPMS", 39,0)118682 . W $$FMDTOUTC^C0CUTIL( 9999999-G),!118683 "RTN","C0CRPMS",4 0,0)118785 "RTN","C0CRPMS",47,0) 118786 . W $$FMDTOUTC^C0CUTIL(C0CG),! 118787 "RTN","C0CRPMS",48,0) 118684 118788 Q 118685 "RTN","C0CRPMS",41,0)118686 ;118687 "RTN","C0CRPMS",42,0)118688 VISITS2(C0CDFN,C0CCNT) ;SECOND VERSION USING NEXTV118689 "RTN","C0CRPMS",43,0)118690 ;118691 "RTN","C0CRPMS",44,0)118692 N C0CG,GN118693 "RTN","C0CRPMS",45,0)118694 S C0CG=""118695 "RTN","C0CRPMS",46,0)118696 S GN=0118697 "RTN","C0CRPMS",47,0)118698 I '$D(C0CCNT) S C0CCNT=99999999118699 "RTN","C0CRPMS",48,0)118700 F S C0CG=$$NEXTV(C0CDFN,C0CG) Q:(C0CG="")!(GN'<C0CCNT) D ;118701 118789 "RTN","C0CRPMS",49,0) 118702 . S GN=GN+1118790 ; 118703 118791 "RTN","C0CRPMS",50,0) 118704 . W $$FMDTOUTC^C0CUTIL(C0CG),! 118792 NEXTV(C0CDFN,C0CVDT) ;EXTRINSIC WHICH RETURNS THE NEXT VISIT DATE 118705 118793 "RTN","C0CRPMS",51,0) 118794 ;FOR PATIENT C0CDFN IN REVERSE TIME ORDER; PASS "" TO GET THE MOST 118795 "RTN","C0CRPMS",52,0) 118796 ; RECENT VISIT 118797 "RTN","C0CRPMS",53,0) 118798 N G 118799 "RTN","C0CRPMS",54,0) 118800 S G=C0CVDT 118801 "RTN","C0CRPMS",55,0) 118802 I G'="" S G=9999999-C0CVDT ;INVERT FOR INDEX 118803 "RTN","C0CRPMS",56,0) 118804 S G=$O(^AUPNVSIT("AA",C0CDFN,G)) 118805 "RTN","C0CRPMS",57,0) 118806 I G="" Q "" 118807 "RTN","C0CRPMS",58,0) 118808 E Q 9999999-G 118809 "RTN","C0CRPMS",59,0) 118810 ; 118811 "RTN","C0CRPMS",60,0) 118812 GETV(C0CDFN,C0CVDT) ; GET VISIT USING DATE C0CVDT . IF C0CVDT IS NULL, 118813 "RTN","C0CRPMS",61,0) 118814 ; GET MOST RECENT VISIT 118815 "RTN","C0CRPMS",62,0) 118816 N C0CG 118817 "RTN","C0CRPMS",63,0) 118818 I '$D(C0CVDT) S C0CVDT=$$NEXTV(C0CDFN,"") 118819 "RTN","C0CRPMS",64,0) 118820 S APCDVLDT=C0CVDT 118821 "RTN","C0CRPMS",65,0) 118822 S APCDPAT=C0CDFN 118823 "RTN","C0CRPMS",66,0) 118824 D ^APCDVLK 118825 "RTN","C0CRPMS",67,0) 118826 D ^APCDVD 118827 "RTN","C0CRPMS",68,0) 118828 ;K APCDCLN,APCDCAT,APCDDATE,APCDLOC,APCDVSIT,APCDLOOK,APCDTYPE 118829 "RTN","C0CRPMS",69,0) 118706 118830 Q 118707 "RTN","C0CRPMS",52,0)118708 ;118709 "RTN","C0CRPMS",53,0)118710 NEXTV(C0CDFN,C0CVDT) ;EXTRINSIC WHICH RETURNS THE NEXT VISIT DATE118711 "RTN","C0CRPMS",54,0)118712 ;FOR PATIENT C0CDFN IN REVERSE TIME ORDER; PASS "" TO GET THE MOST118713 "RTN","C0CRPMS",55,0)118714 ; RECENT VISIT118715 "RTN","C0CRPMS",56,0)118716 N G118717 "RTN","C0CRPMS",57,0)118718 S G=C0CVDT118719 "RTN","C0CRPMS",58,0)118720 I G'="" S G=9999999-C0CVDT ;INVERT FOR INDEX118721 "RTN","C0CRPMS",59,0)118722 S G=$O(^AUPNVSIT("AA",C0CDFN,G))118723 "RTN","C0CRPMS",60,0)118724 I G="" Q ""118725 "RTN","C0CRPMS",61,0)118726 E Q 9999999-G118727 "RTN","C0CRPMS",62,0)118728 ;118729 "RTN","C0CRPMS",63,0)118730 GETV(C0CDFN,C0CVDT) ; GET VISIT USING DATE C0CVDT . IF C0CVDT IS NULL,118731 "RTN","C0CRPMS",64,0)118732 ; GET MOST RECENT VISIT118733 "RTN","C0CRPMS",65,0)118734 N C0CG118735 "RTN","C0CRPMS",66,0)118736 I '$D(C0CVDT) S C0CVDT=$$NEXTV(C0CDFN,"")118737 "RTN","C0CRPMS",67,0)118738 S APCDVLDT=C0CVDT118739 "RTN","C0CRPMS",68,0)118740 S APCDPAT=C0CDFN118741 "RTN","C0CRPMS",69,0)118742 D ^APCDVLK118743 118831 "RTN","C0CRPMS",70,0) 118744 D ^APCDVD118832 ; 118745 118833 "RTN","C0CRPMS",71,0) 118746 ;K APCDCLN,APCDCAT,APCDDATE,APCDLOC,APCDVSIT,APCDLOOK,APCDTYPE 118834 GETNV(C0CDFN) ;GET MANY VISITS 118747 118835 "RTN","C0CRPMS",72,0) 118836 ; 118837 "RTN","C0CRPMS",73,0) 118838 S APCDPAT=C0CDFN ; 118839 "RTN","C0CRPMS",74,0) 118840 N C0CG S C0CG="" 118841 "RTN","C0CRPMS",75,0) 118842 F S C0CG=$$NEXTV(C0CDFN,C0CG) Q:C0CG="" D ; LOOP BACKWARD THROUGH VISITS 118843 "RTN","C0CRPMS",76,0) 118844 . W C0CG," ",$$FMDTOUTC^C0CUTIL(C0CG),! 118845 "RTN","C0CRPMS",77,0) 118846 . S APCDVLDT=C0CG 118847 "RTN","C0CRPMS",78,0) 118848 . D ^APCDVLK 118849 "RTN","C0CRPMS",79,0) 118850 . D ^APCDVD 118851 "RTN","C0CRPMS",80,0) 118852 . K APCDCLN,APCDCAT,APCDDATE,APCDLOC,APCDVSIT,APCDLOOK,APCDTYPE 118853 "RTN","C0CRPMS",81,0) 118748 118854 Q 118749 "RTN","C0CRPMS", 73,0)118750 ; 118751 "RTN","C0CRPMS", 74,0)118752 GET NV(C0CDFN) ;GET MANY VISITS118753 "RTN","C0CRPMS", 75,0)118754 ; 118755 "RTN","C0CRPMS", 76,0)118756 S APCDPAT=C0CDFN ;118757 "RTN","C0CRPMS", 77,0)118855 "RTN","C0CRPMS",82,0) 118856 ; 118857 "RTN","C0CRPMS",83,0) 118858 GETTBL(C0CTBL) ; SCAN FOR AND DISPLAY PATIENTS IN A RIMTBL, PASSED BY VALUE 118859 "RTN","C0CRPMS",84,0) 118860 ; 118861 "RTN","C0CRPMS",85,0) 118862 N ZG S ZG=$NA(^TMP("GPLRIM","RIMTBL","PATS",C0CTBL)) 118863 "RTN","C0CRPMS",86,0) 118758 118864 N C0CG S C0CG="" 118759 "RTN","C0CRPMS", 78,0)118760 F S C0CG=$$NEXTV(C0CDFN,C0CG) Q:C0CG="" D ; LOOP BACKWARD THROUGH VISITS118761 "RTN","C0CRPMS", 79,0)118762 . W C0CG," ",$$FMDTOUTC^C0CUTIL(C0CG),!118763 "RTN","C0CRPMS",8 0,0)118764 . S APCDVLDT=C0CG118765 "RTN","C0CRPMS", 81,0)118766 . D ^APCDVLK118767 "RTN","C0CRPMS", 82,0)118768 . D ^APCDVD118769 "RTN","C0CRPMS", 83,0)118770 . K APCDCLN,APCDCAT,APCDDATE,APCDLOC,APCDVSIT,APCDLOOK,APCDTYPE118771 "RTN","C0CRPMS", 84,0)118865 "RTN","C0CRPMS",87,0) 118866 N C0CQ S C0CQ=0 118867 "RTN","C0CRPMS",88,0) 118868 F S C0CG=$O(@ZG@(C0CG),-1) Q:(C0CG="") D ; 118869 "RTN","C0CRPMS",89,0) 118870 . W "PAT: ",C0CG,! 118871 "RTN","C0CRPMS",90,0) 118872 . D GETNV^C0CRPMS(C0CG) 118873 "RTN","C0CRPMS",91,0) 118874 . K X R X:DTIME 118875 "RTN","C0CRPMS",92,0) 118876 . I X="Q" S C0CQ=1 ; QUIT IF Q 118877 "RTN","C0CRPMS",93,0) 118772 118878 Q 118773 "RTN","C0CRPMS",85,0)118774 ;118775 "RTN","C0CRPMS",86,0)118776 GETTBL(C0CTBL) ; SCAN FOR AND DISPLAY PATIENTS IN A RIMTBL, PASSED BY VALUE118777 "RTN","C0CRPMS",87,0)118778 ;118779 "RTN","C0CRPMS",88,0)118780 N ZG S ZG=$NA(^TMP("GPLRIM","RIMTBL","PATS",C0CTBL))118781 "RTN","C0CRPMS",89,0)118782 N C0CG S C0CG=""118783 "RTN","C0CRPMS",90,0)118784 N C0CQ S C0CQ=0118785 "RTN","C0CRPMS",91,0)118786 F S C0CG=$O(@ZG@(C0CG),-1) Q:(C0CG="") D ;118787 "RTN","C0CRPMS",92,0)118788 . W "PAT: ",C0CG,!118789 "RTN","C0CRPMS",93,0)118790 . D GETNV^C0CRPMS(C0CG)118791 118879 "RTN","C0CRPMS",94,0) 118792 . K X R X118880 ; 118793 118881 "RTN","C0CRPMS",95,0) 118794 . I X="Q" S C0CQ=1 ; QUIT IF Q 118882 CMPDRG ; COMPARE THE DRUG FILE TO THE VA VUID MAPPING FILE FOR MATCHES 118795 118883 "RTN","C0CRPMS",96,0) 118884 ; 118885 "RTN","C0CRPMS",97,0) 118886 S C0CZI=0 ; 118887 "RTN","C0CRPMS",98,0) 118888 F S C0CZI=$O(^C0CDRUG("V",C0CZI)) Q:C0CZI="" D ;ALL DRUGS IN RPMS DRUG FILE 118889 "RTN","C0CRPMS",99,0) 118890 . S C0CZJ="" ; FOR EVERY FIELD AND SUBFIELD IN THE DRUG FILE 118891 "RTN","C0CRPMS",100,0) 118892 . ;W "C0CZI:",C0CZI 118893 "RTN","C0CRPMS",101,0) 118894 . F S C0CZJ=$O(^C0CDRUG("V",C0CZI,C0CZJ)) Q:C0CZJ="" D ; 118895 "RTN","C0CRPMS",102,0) 118896 . . ;W " C0CZJ:",C0CZJ 118897 "RTN","C0CRPMS",103,0) 118898 . . N C0CZN,C0CZV ; 118899 "RTN","C0CRPMS",104,0) 118900 . . S C0CZN=^C0CDRUG("V",C0CZI,C0CZJ,1) ; EVERY FIELD VALUE 118901 "RTN","C0CRPMS",105,0) 118902 . . ;W " C0CZN:",C0CZN,! 118903 "RTN","C0CRPMS",106,0) 118904 . . D GETN1^C0CRNF("C0CZV",176.112,C0CZN,"C") ;LOOK IN C XREF 118905 "RTN","C0CRPMS",107,0) 118906 . . I $D(C0CZV) D ;FOUND A MATCH 118907 "RTN","C0CRPMS",108,0) 118908 . . . S C0CVO="FOUND:^"_C0CZI_"^"_C0CZJ_"^"_C0CZN 118909 "RTN","C0CRPMS",109,0) 118910 . . . S C0CVO=C0CVO_"^RXNORM:^"_$$ZVALUE^C0CRNF("MEDIATION CODE","C0CZV") 118911 "RTN","C0CRPMS",110,0) 118912 . . . D PUSH^GPLXPATH("^C0CZRX",C0CVO) 118913 "RTN","C0CRPMS",111,0) 118914 . . . W C0CVO,! 118915 "RTN","C0CRPMS",112,0) 118796 118916 Q 118797 "RTN","C0CRPMS", 97,0)118798 ; 118799 "RTN","C0CRPMS", 98,0)118800 CMPDRG ; COMPARE THE DRUG FILE TO THE VA VUID MAPPING FILE FOR MATCHES118801 "RTN","C0CRPMS", 99,0)118802 ; 118803 "RTN","C0CRPMS",1 00,0)118917 "RTN","C0CRPMS",113,0) 118918 ; 118919 "RTN","C0CRPMS",114,0) 118920 CMPDRG2 ; COMPARE THE DRUG FILE TO THE VA VUID MAPPING FILE FOR MATCHES 118921 "RTN","C0CRPMS",115,0) 118922 ; 118923 "RTN","C0CRPMS",116,0) 118804 118924 S C0CZI=0 ; 118805 "RTN","C0CRPMS",1 01,0)118925 "RTN","C0CRPMS",117,0) 118806 118926 F S C0CZI=$O(^C0CDRUG("V",C0CZI)) Q:C0CZI="" D ;ALL DRUGS IN RPMS DRUG FILE 118807 "RTN","C0CRPMS",1 02,0)118927 "RTN","C0CRPMS",118,0) 118808 118928 . S C0CZJ="" ; FOR EVERY FIELD AND SUBFIELD IN THE DRUG FILE 118809 "RTN","C0CRPMS",1 03,0)118810 . ;W "C0CZI:",C0CZI118811 "RTN","C0CRPMS",1 04,0)118929 "RTN","C0CRPMS",119,0) 118930 . W "C0CZI:",C0CZI 118931 "RTN","C0CRPMS",120,0) 118812 118932 . F S C0CZJ=$O(^C0CDRUG("V",C0CZI,C0CZJ)) Q:C0CZJ="" D ; 118813 "RTN","C0CRPMS",1 05,0)118814 . . ;W " C0CZJ:",C0CZJ118815 "RTN","C0CRPMS",1 06,0)118933 "RTN","C0CRPMS",121,0) 118934 . . W " C0CZJ:",C0CZJ 118935 "RTN","C0CRPMS",122,0) 118816 118936 . . N C0CZN,C0CZV ; 118817 "RTN","C0CRPMS",1 07,0)118937 "RTN","C0CRPMS",123,0) 118818 118938 . . S C0CZN=^C0CDRUG("V",C0CZI,C0CZJ,1) ; EVERY FIELD VALUE 118819 "RTN","C0CRPMS",1 08,0)118820 . . ;W " C0CZN:",C0CZN,!118821 "RTN","C0CRPMS",1 09,0)118939 "RTN","C0CRPMS",124,0) 118940 . . W " C0CZN:",C0CZN,! 118941 "RTN","C0CRPMS",125,0) 118822 118942 . . D GETN1^C0CRNF("C0CZV",176.112,C0CZN,"C") ;LOOK IN C XREF 118823 "RTN","C0CRPMS",1 10,0)118943 "RTN","C0CRPMS",126,0) 118824 118944 . . I $D(C0CZV) D ;FOUND A MATCH 118825 "RTN","C0CRPMS",111,0) 118826 . . . S C0CVO="FOUND:^"_C0CZI_"^"_C0CZJ_"^"_C0CZN 118827 "RTN","C0CRPMS",112,0) 118828 . . . S C0CVO=C0CVO_"^RXNORM:^"_$$ZVALUE^C0CRNF("MEDIATION CODE","C0CZV") 118829 "RTN","C0CRPMS",113,0) 118830 . . . D PUSH^GPLXPATH("^C0CZRX",C0CVO) 118831 "RTN","C0CRPMS",114,0) 118832 . . . W C0CVO,! 118833 "RTN","C0CRPMS",115,0) 118945 "RTN","C0CRPMS",127,0) 118946 . . . W "FOUND: ",C0CZI," ",C0CZJ," ",C0CZN 118947 "RTN","C0CRPMS",128,0) 118948 . . . W " VUID:",$$ZVALUE^C0CRNF("VUID","C0CZV"),! 118949 "RTN","C0CRPMS",129,0) 118834 118950 Q 118835 "RTN","C0CRPMS",116,0)118836 ;118837 "RTN","C0CRPMS",117,0)118838 CMPDRG2 ; COMPARE THE DRUG FILE TO THE VA VUID MAPPING FILE FOR MATCHES118839 "RTN","C0CRPMS",118,0)118840 ;118841 "RTN","C0CRPMS",119,0)118842 S C0CZI=0 ;118843 "RTN","C0CRPMS",120,0)118844 F S C0CZI=$O(^C0CDRUG("V",C0CZI)) Q:C0CZI="" D ;ALL DRUGS IN RPMS DRUG FILE118845 "RTN","C0CRPMS",121,0)118846 . S C0CZJ="" ; FOR EVERY FIELD AND SUBFIELD IN THE DRUG FILE118847 "RTN","C0CRPMS",122,0)118848 . W "C0CZI:",C0CZI118849 "RTN","C0CRPMS",123,0)118850 . F S C0CZJ=$O(^C0CDRUG("V",C0CZI,C0CZJ)) Q:C0CZJ="" D ;118851 "RTN","C0CRPMS",124,0)118852 . . W " C0CZJ:",C0CZJ118853 "RTN","C0CRPMS",125,0)118854 . . N C0CZN,C0CZV ;118855 "RTN","C0CRPMS",126,0)118856 . . S C0CZN=^C0CDRUG("V",C0CZI,C0CZJ,1) ; EVERY FIELD VALUE118857 "RTN","C0CRPMS",127,0)118858 . . W " C0CZN:",C0CZN,!118859 "RTN","C0CRPMS",128,0)118860 . . D GETN1^C0CRNF("C0CZV",176.112,C0CZN,"C") ;LOOK IN C XREF118861 "RTN","C0CRPMS",129,0)118862 . . I $D(C0CZV) D ;FOUND A MATCH118863 118951 "RTN","C0CRPMS",130,0) 118864 . . . W "FOUND: ",C0CZI," ",C0CZJ," ",C0CZN118865 "RTN","C0CRPMS",131,0)118866 . . . W " VUID:",$$ZVALUE^C0CRNF("VUID","C0CZV"),!118867 "RTN","C0CRPMS",132,0)118868 Q118869 "RTN","C0CRPMS",133,0)118870 118952 ; 118871 118953 "RTN","C0CRXN") 118872 0^22^B10 3277157118954 0^22^B102255510 118873 118955 "RTN","C0CRXN",1,0) 118874 118956 C0CRXN ; CCDCCR/GPL - CCR RXN utilities; 12/6/08 118875 118957 "RTN","C0CRXN",2,0) 118876 ;;1.2;C 0C;;May 11, 2012;Build 50118958 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 118877 118959 "RTN","C0CRXN",3,0) 118878 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU118960 ;Copyright 2009 George Lilly. 118879 118961 "RTN","C0CRXN",4,0) 118880 ; General Public License See attached copy of the License.118962 ; 118881 118963 "RTN","C0CRXN",5,0) 118882 ; 118964 ; This program is free software: you can redistribute it and/or modify 118883 118965 "RTN","C0CRXN",6,0) 118884 ; This program is free software; you can redistribute it and/or modify118966 ; it under the terms of the GNU Affero General Public License as 118885 118967 "RTN","C0CRXN",7,0) 118886 ; it under the terms of the GNU General Public License as published by118968 ; published by the Free Software Foundation, either version 3 of the 118887 118969 "RTN","C0CRXN",8,0) 118888 ; the Free Software Foundation; either version 2 of the License, or118970 ; License, or (at your option) any later version. 118889 118971 "RTN","C0CRXN",9,0) 118890 ; (at your option) any later version.118972 ; 118891 118973 "RTN","C0CRXN",10,0) 118892 ; 118974 ; This program is distributed in the hope that it will be useful, 118893 118975 "RTN","C0CRXN",11,0) 118894 ; This program is distributed in the hope that it will be useful,118976 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 118895 118977 "RTN","C0CRXN",12,0) 118896 ; but WITHOUT ANY WARRANTY; without even the implied warranty of118978 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 118897 118979 "RTN","C0CRXN",13,0) 118898 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the118980 ; GNU Affero General Public License for more details. 118899 118981 "RTN","C0CRXN",14,0) 118900 ; GNU General Public License for more details.118982 ; 118901 118983 "RTN","C0CRXN",15,0) 118902 ; 118984 ; You should have received a copy of the GNU Affero General Public License 118903 118985 "RTN","C0CRXN",16,0) 118904 ; You should have received a copy of the GNU General Public License along118986 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 118905 118987 "RTN","C0CRXN",17,0) 118906 ; with this program; if not, write to the Free Software Foundation, Inc.,118988 ; 118907 118989 "RTN","C0CRXN",18,0) 118908 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.118990 W "This is the CCR RXNORM Utility Library ",! 118909 118991 "RTN","C0CRXN",19,0) 118910 ;118992 W ! 118911 118993 "RTN","C0CRXN",20,0) 118912 W "This is the CCR RXNORM Utility Library ",!118994 Q 118913 118995 "RTN","C0CRXN",21,0) 118914 W !118996 ; 118915 118997 "RTN","C0CRXN",22,0) 118998 EXPAND ; MAIN ROUTINE TO CREATE THE C0C RXNORM VUID EXPANSION FILE (176.112) 118999 "RTN","C0CRXN",23,0) 119000 ; READ EACH RECORD FROM 176.111 AND USE THE VUID TO LOOK UP THE RXNORM 119001 "RTN","C0CRXN",24,0) 119002 ; CODE FROM 176.001 (RXNORM CONCEPTS) 119003 "RTN","C0CRXN",25,0) 119004 ; POPULATE ALL FIELDS IN 176.112 AND SET "NEW" TO "Y" IF 176.111 DOES NOT 119005 "RTN","C0CRXN",26,0) 119006 ; ALREADY HAVE AN RXNORM CODE. 119007 "RTN","C0CRXN",27,0) 119008 ; ADD THE RXNORM TEXT FIELD TO EVERY RECORD (NOT PRESENT IN 176.111) 119009 "RTN","C0CRXN",28,0) 119010 ; AND COMPARE THE RXNORM TEXT FIELD WITH THE VUID TEXT FIELD, SETTING THE 119011 "RTN","C0CRXN",29,0) 119012 ; "DIFFERENT TEXT" FIELD TO "Y" IF THERE ARE DIFFERENCES 119013 "RTN","C0CRXN",30,0) 119014 ; USES SUPPORT ROUTINES FROM C0CRNF.m 119015 "RTN","C0CRXN",31,0) 119016 N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR 119017 "RTN","C0CRXN",32,0) 119018 N C0CFVA,C0CFRXN ; CLOSED ROOTS FOR SOURCE FILES 119019 "RTN","C0CRXN",33,0) 119020 N C0CF ; CLOSED ROOT FOR DESTINATION FILE 119021 "RTN","C0CRXN",34,0) 119022 S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE 119023 "RTN","C0CRXN",35,0) 119024 S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE 119025 "RTN","C0CRXN",36,0) 119026 S C0CF=$$FILEREF^C0CRNF(176.112) ; C0C RXNORM VUID MAPPING EXPANSION FILE 119027 "RTN","C0CRXN",37,0) 119028 W C0CVA,C0CFRXN,C0CF,! 119029 "RTN","C0CRXN",38,0) 119030 S C0CZX=0 119031 "RTN","C0CRXN",39,0) 119032 S (HASRXN,NORXN,NOVUID,RXFOUND,RXMATCH,TXTMATCH)=0 ; INITIALIZE COUNTERS 119033 "RTN","C0CRXN",40,0) 119034 F S C0CZX=$O(^C0CCODES(176.111,C0CZX)) Q:+C0CZX=0 D ; FOR EVERY RECORD 119035 "RTN","C0CRXN",41,0) 119036 . K C0CA,C0CB,C0CC ; CLEAR ARRAYS 119037 "RTN","C0CRXN",42,0) 119038 . D FIELDS^C0CRNF("C0CC",176.112) ;GET FIELD NAMES FOR OUTPUT FILE 119039 "RTN","C0CRXN",43,0) 119040 . D GETN1^C0CRNF("C0CA",176.111,C0CZX,"","ALL") ;GET THE FIELDS 119041 "RTN","C0CRXN",44,0) 119042 . I $$ZVALUE("MEDIATION CODE")="" D 119043 "RTN","C0CRXN",45,0) 119044 . . S NORXN=NORXN+1 ; 119045 "RTN","C0CRXN",46,0) 119046 . E D ; PROCESS MEDIATION CODE 119047 "RTN","C0CRXN",47,0) 119048 . . S HASRXN=HASRXN+1 119049 "RTN","C0CRXN",48,0) 119050 . . D SETFDA("MEDIATION CODE",$$ZVALUE("MEDIATION CODE")) ; 119051 "RTN","C0CRXN",49,0) 119052 . I $$ZVALUE("VUID")="" D ; BAD RECORD 119053 "RTN","C0CRXN",50,0) 119054 . . S NOVUID=NOVUID+1 119055 "RTN","C0CRXN",51,0) 119056 . . ;D SETFDA("VUID",$$ZVALUE("VUID")) 119057 "RTN","C0CRXN",52,0) 119058 . E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT")) 119059 "RTN","C0CRXN",53,0) 119060 . ;ZWR C0CA 119061 "RTN","C0CRXN",54,0) 119062 . D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL") 119063 "RTN","C0CRXN",55,0) 119064 . I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND 119065 "RTN","C0CRXN",56,0) 119066 . . S RXFOUND=RXFOUND+1 119067 "RTN","C0CRXN",57,0) 119068 . . I $$ZVALUE("MEDIATION CODE")="" D ; THIS IS A NEW CODE 119069 "RTN","C0CRXN",58,0) 119070 . . . D SETFDA("MEDIATION CODE",$$ZVALUE("RXCUI","C0CB")) 119071 "RTN","C0CRXN",59,0) 119072 . . . D SETFDA("NEW","Y") ;FLAG RECORD HAS HAVING NEW RXNORM 119073 "RTN","C0CRXN",60,0) 119074 . . W "RXNORM=",$$ZVALUE("RXCUI","C0CB")," ",$$ZVALUE("STR","C0CB"),! 119075 "RTN","C0CRXN",61,0) 119076 . . W "VUID TEXT: ",$$ZVALUE("VUID TEXT"),! 119077 "RTN","C0CRXN",62,0) 119078 . . I $$ZVALUE("VUID TEXT")=$$ZVALUE("STR","C0CB") S TXTMATCH=TXTMATCH+1 119079 "RTN","C0CRXN",63,0) 119080 . . E D ; 119081 "RTN","C0CRXN",64,0) 119082 . . . S ZZ=$$ZVALUE("VUID TEXT")_"^"_$$ZVALUE("STR","C0CB") 119083 "RTN","C0CRXN",65,0) 119084 . . . D PUSH^GPLXPATH("NOMATCH",ZZ) 119085 "RTN","C0CRXN",66,0) 119086 . . . D SETFDA("RXNORM TEXT",$$ZVALUE("STR","C0CB")) ; 119087 "RTN","C0CRXN",67,0) 119088 . . . D SETFDA("DIFFERENT TEXT","Y") ;FLAG RECORD FOR DIFFERENT TEXT 119089 "RTN","C0CRXN",68,0) 119090 . I $$ZVALUE("MEDIATION CODE")=$$ZVALUE("RXCUI","C0CB") D ; 119091 "RTN","C0CRXN",69,0) 119092 . . S RXMATCH=RXMATCH+1 119093 "RTN","C0CRXN",70,0) 119094 . . W "VUID=",$$ZVALUE("VUID")," MATCH RXNORM=",$$ZVALUE("MEDIATION CODE"),! 119095 "RTN","C0CRXN",71,0) 119096 . D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP 119097 "RTN","C0CRXN",72,0) 119098 . S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD 119099 "RTN","C0CRXN",73,0) 119100 . D UPDATE^DIE("","C0CFDA") 119101 "RTN","C0CRXN",74,0) 119102 . I $D(^TMP("DIERR",$J)) S $EC=",U1," 119103 "RTN","C0CRXN",75,0) 119104 W "HAS RXN=",HASRXN,! 119105 "RTN","C0CRXN",76,0) 119106 W "NO RXN=",NORXN,! 119107 "RTN","C0CRXN",77,0) 119108 W "NO VUID=",NOVUID,! 119109 "RTN","C0CRXN",78,0) 119110 W "RXNORM FOUND=",RXFOUND,! 119111 "RTN","C0CRXN",79,0) 119112 W "RXNORM MATCHES:",RXMATCH,! 119113 "RTN","C0CRXN",80,0) 119114 W "TEXT MATCHES:",TXTMATCH,! 119115 "RTN","C0CRXN",81,0) 118916 119116 Q 118917 "RTN","C0CRXN",23,0) 118918 ; 118919 "RTN","C0CRXN",24,0) 118920 EXPAND ; MAIN ROUTINE TO CREATE THE C0C RXNORM VUID EXPANSION FILE (176.112) 118921 "RTN","C0CRXN",25,0) 118922 ; READ EACH RECORD FROM 176.111 AND USE THE VUID TO LOOK UP THE RXNORM 118923 "RTN","C0CRXN",26,0) 118924 ; CODE FROM 176.001 (RXNORM CONCEPTS) 118925 "RTN","C0CRXN",27,0) 118926 ; POPULATE ALL FIELDS IN 176.112 AND SET "NEW" TO "Y" IF 176.111 DOES NOT 118927 "RTN","C0CRXN",28,0) 118928 ; ALREADY HAVE AN RXNORM CODE. 118929 "RTN","C0CRXN",29,0) 118930 ; ADD THE RXNORM TEXT FIELD TO EVERY RECORD (NOT PRESENT IN 176.111) 118931 "RTN","C0CRXN",30,0) 118932 ; AND COMPARE THE RXNORM TEXT FIELD WITH THE VUID TEXT FIELD, SETTING THE 118933 "RTN","C0CRXN",31,0) 118934 ; "DIFFERENT TEXT" FIELD TO "Y" IF THERE ARE DIFFERENCES 118935 "RTN","C0CRXN",32,0) 118936 ; USES SUPPORT ROUTINES FROM C0CRNF.m 118937 "RTN","C0CRXN",33,0) 119117 "RTN","C0CRXN",82,0) 119118 ; 119119 "RTN","C0CRXN",83,0) 119120 EXP2 ; ROUTINE TO CREATE 176.113 C0C RXNORM VUID MAPPING DISCREPANCIES FILE 119121 "RTN","C0CRXN",84,0) 119122 ; CROSS CHECKS THE NATIONAL DRUG FILE AND THE VA MAPPING FILE AGAINST 119123 "RTN","C0CRXN",85,0) 119124 ; THE UMLS RXNORM DATABASE 119125 "RTN","C0CRXN",86,0) 119126 ; THIS ROUTINE HAS BEEN ENHANCED TO ALSO CHECK THE 50.416 DRUG INGREDIENT 119127 "RTN","C0CRXN",87,0) 119128 ; FILE AND TREAT VUIDS FOUND THERE LIKE THE ONES BEING FOUND IN THE NDF 119129 "RTN","C0CRXN",88,0) 119130 ; IF THE VUID EXISISTS IN ALL THREE FILES, THE RXNORM CODE MATCHES IN 119131 "RTN","C0CRXN",89,0) 119132 ; THE VA MAPPING FILE AND THE TEXT STRINGS ARE THE SAME, THE VUID IS INCLUDED 119133 "RTN","C0CRXN",90,0) 119134 ; IN THE FILE BUT NO FLAGS ARE SET 119135 "RTN","C0CRXN",91,0) 119136 ; IF THE VUID IS MISSING FROM THE NATIONAL DRUG FILE NDF=N 119137 "RTN","C0CRXN",92,0) 119138 ; (IF THE VUID IS MISSING FROM THE NDF, IT IS CHECKED IN THE DRUG INGREDIENT 119139 "RTN","C0CRXN",93,0) 119140 ; FILE, AND IF FOUND, THE FLAG IS NOT SET. IN THIS CASE THE TEXT FROM THE 119141 "RTN","C0CRXN",94,0) 119142 ; DRUG INGREDIENT FILE IS USED FOR COMPARISONS) 119143 "RTN","C0CRXN",95,0) 119144 ; IF THE VUID IS MISSING FROM THE VA MAPPING FILE VAMAP=N 119145 "RTN","C0CRXN",96,0) 119146 ; IF THE VUID IS PRESENT IN THE VA MAPPING FILE, BUT THE RXNORM 119147 "RTN","C0CRXN",97,0) 119148 ; CODE IS MISSING IN THAT FILE, VARXN=N 119149 "RTN","C0CRXN",98,0) 119150 ; IF THE TEXT STRINGS DO NOT MATCH EXACTLY, TXTM=N AND ALL THREE STRINGS 119151 "RTN","C0CRXN",99,0) 119152 ; ARE SHOWN; NDF TEXT=NDF TEXT STRING, VA MAP TEXT=VA MAPPING TEXT STRING 119153 "RTN","C0CRXN",100,0) 119154 ; RXNORM TEXT=RXNORM TEXT STRING 119155 "RTN","C0CRXN",101,0) 119156 ; THE FILE IS KEYED ON VUID AND WOULD USUALLY BE SORTED BY VUID 119157 "RTN","C0CRXN",102,0) 119158 ; THE OBJECTIVE IS TO SEE IF NDF (50.68) AND VA MAPPING (176.111) HAVE 119159 "RTN","C0CRXN",103,0) 119160 ; ALL THE VUID CODES THAT ARE IN THE UMLS RXNORM DATABASE 119161 "RTN","C0CRXN",104,0) 118938 119162 N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR 118939 "RTN","C0CRXN", 34,0)119163 "RTN","C0CRXN",105,0) 118940 119164 N C0CFVA,C0CFRXN ; CLOSED ROOTS FOR SOURCE FILES 118941 "RTN","C0CRXN", 35,0)119165 "RTN","C0CRXN",106,0) 118942 119166 N C0CF ; CLOSED ROOT FOR DESTINATION FILE 118943 "RTN","C0CRXN", 36,0)119167 "RTN","C0CRXN",107,0) 118944 119168 S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE 118945 "RTN","C0CRXN", 37,0)119169 "RTN","C0CRXN",108,0) 118946 119170 S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE 118947 "RTN","C0CRXN", 38,0)118948 S C0CF=$$FILEREF^C0CRNF(176.112) ; C0C RXNORM VUID MAPPING EXPANSIONFILE118949 "RTN","C0CRXN", 39,0)118950 W C0CVA,C0CFRXN, C0CF,!118951 "RTN","C0CRXN", 40,0)119171 "RTN","C0CRXN",109,0) 119172 ;S C0CF=$$FILEREF^C0CRNF(176.113) ; C0C RXNORM VUID MAPPING ADDITIONAL FILE 119173 "RTN","C0CRXN",110,0) 119174 W C0CVA,C0CFRXN,! ;C0CF,! 119175 "RTN","C0CRXN",111,0) 118952 119176 S C0CZX=0 118953 "RTN","C0CRXN",41,0) 118954 S (HASRXN,NORXN,NOVUID,RXFOUND,RXMATCH,TXTMATCH)=0 ; INITIALIZE COUNTERS 118955 "RTN","C0CRXN",42,0) 118956 F S C0CZX=$O(^C0CCODES(176.111,C0CZX)) Q:+C0CZX=0 D ; FOR EVERY RECORD 118957 "RTN","C0CRXN",43,0) 118958 . K C0CA,C0CB,C0CC ; CLEAR ARRAYS 118959 "RTN","C0CRXN",44,0) 118960 . D FIELDS^C0CRNF("C0CC",176.112) ;GET FIELD NAMES FOR OUTPUT FILE 118961 "RTN","C0CRXN",45,0) 118962 . D GETN1^C0CRNF("C0CA",176.111,C0CZX,"","ALL") ;GET THE FIELDS 118963 "RTN","C0CRXN",46,0) 119177 "RTN","C0CRXN",112,0) 119178 S (NDFVCNT,NDFTCNT,NDFNO)=0 ; COUNTERS FOR NDF TESTS 119179 "RTN","C0CRXN",113,0) 119180 S (VAVCNT,VATCNT,VARCNT,VANO)=0 ; COUNTERS FOR VA MAPPING FILE TESTS 119181 "RTN","C0CRXN",114,0) 119182 F S C0CZX=$O(^C0CRXN(176.001,"VUID",C0CZX)) Q:+C0CZX=0 D ; FOR EVERY VUID 119183 "RTN","C0CRXN",115,0) 119184 . K C0CA,C0CB,C0CC,C0CD ; CLEAR ARRAYS 119185 "RTN","C0CRXN",116,0) 119186 . D FIELDS^C0CRNF("C0CC",176.113) ;GET FIELD NAMES FOR OUTPUT FILE 119187 "RTN","C0CRXN",117,0) 119188 . D GETN1^C0CRNF("C0CA",176.001,C0CZX,"VUID","ALL") ;GET FROM RXNORM FILE 119189 "RTN","C0CRXN",118,0) 119190 . D GETN1^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;GET FROM VA MAPPING FILE 119191 "RTN","C0CRXN",119,0) 119192 . D GETN1^C0CRNF("C0CD",50.68,C0CZX,"AVUID","ALL") ;GET FROM NDF 119193 "RTN","C0CRXN",120,0) 119194 . D GETN1^C0CRNF("C0CE",50.416,C0CZX,"AVUID","ALL") ;GET FROM DRUG INGREDIENTS 119195 "RTN","C0CRXN",121,0) 119196 . ;D SETFDA("VUID",$$ZVALUE("CODE")) ;SET THE VUID CODE 119197 "RTN","C0CRXN",122,0) 119198 . D SETFDA("RXNORM",$$ZVALUE("RXCUI")) ;SET THE RXNORM CODE 119199 "RTN","C0CRXN",123,0) 119200 . D SETFDA("RXNORM TEXT",$$ZVALUE("STR")) ;SET THE RXNORM TEXT 119201 "RTN","C0CRXN",124,0) 119202 . ;VA MAPPING FILE TESTS 119203 "RTN","C0CRXN",125,0) 119204 . I $$ZVALUE("VUID","C0CB")=C0CZX D ; VUID FOUND 119205 "RTN","C0CRXN",126,0) 119206 . . S VAVCNT=VAVCNT+1 ;INCREMENT COUNT 119207 "RTN","C0CRXN",127,0) 119208 . . I $$ZVALUE("STR")'=$$ZVALUE("VUID TEXT","C0CB") D ;TEXT MISMATCH 119209 "RTN","C0CRXN",128,0) 119210 . . . S VATCNT=VATCNT+1 ; INCREMENT VA TEXT MISMATCH COUNT 119211 "RTN","C0CRXN",129,0) 119212 . . . D SETFDA("TXTM","N") ;MARK THAT TEXT DOESN'T MATCH 119213 "RTN","C0CRXN",130,0) 119214 . . . D SETFDA("VA MAP TEXT",$$ZVALUE("VUID TEXT","C0CB")) ; SET VA MAP TEXT 119215 "RTN","C0CRXN",131,0) 119216 . E D ; VUID NOT FOUND 119217 "RTN","C0CRXN",132,0) 119218 . . S VANO=VANO+1 119219 "RTN","C0CRXN",133,0) 119220 . . D SETFDA("VAMAP","N") ;MARK AS MISSING FROM VA MAPPING FILE 119221 "RTN","C0CRXN",134,0) 119222 . ; NATIONAL DRUG FILE TESTS 119223 "RTN","C0CRXN",135,0) 119224 . I ($$ZVALUE("VUID","C0CD")=C0CZX)!($$ZVALUE("VUID","C0CE")=C0CZX) D ; 119225 "RTN","C0CRXN",136,0) 119226 . . ;FOUND IN NATIONAL DRUG FILE OR DRUG INGREDIENT FILE 119227 "RTN","C0CRXN",137,0) 119228 . . S NDFVCNT=NDFVCNT+1 ;INCREMENT VUID FOUND COUNT 119229 "RTN","C0CRXN",138,0) 119230 . . I $$ZVALUE("NAME","C0CD")'=$$ZVALUE("STR") D ;NDF TEXT DOESN'T MATCH 119231 "RTN","C0CRXN",139,0) 119232 . . . I $$ZVALUE("NAME","C0CE")'=$$ZVALUE("STR") D ;DRUG ING FILE ALSO 119233 "RTN","C0CRXN",140,0) 119234 . . . . S NDFTCNT=NDFTCNT+1 ; INCREMENT MISMATCHED NDF TEXT COUNT 119235 "RTN","C0CRXN",141,0) 119236 . . . . D SETFDA("TXTM","N") ; SET TEXT MATCH FLAG TO N 119237 "RTN","C0CRXN",142,0) 119238 . . . . D SETFDA("NDF TEXT",$$ZVALUE("NAME","C0CD")) ;POST THE TEXT 119239 "RTN","C0CRXN",143,0) 119240 . . . . D SETFDA("NAT DRUG TEXT",$$ZVALUE("NAME","C0CE")) ;POST TEXT 119241 "RTN","C0CRXN",144,0) 119242 . E D ; 119243 "RTN","C0CRXN",145,0) 119244 . . D SETFDA("NDF","N") ;MARK AS MISSING 119245 "RTN","C0CRXN",146,0) 119246 . . S NDFNO=NDFNO+1 ;INCREMENT MISSING COUNT 119247 "RTN","C0CRXN",147,0) 119248 . D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP 119249 "RTN","C0CRXN",148,0) 119250 . S C0CFDA(176.113,"+"_C0CZX_",",.01)=C0CZX ; NEW VUID RECORD 119251 "RTN","C0CRXN",149,0) 119252 . D UPDATE^DIE("","C0CFDA") 119253 "RTN","C0CRXN",150,0) 119254 . I $D(^TMP("DIERR",$J)) S $EC=",U1," 119255 "RTN","C0CRXN",151,0) 119256 W "VA MAPPING VUID COUNT: ",VAVCNT,! 119257 "RTN","C0CRXN",152,0) 119258 W "VA MAPPING MISSING: ",VANO,! 119259 "RTN","C0CRXN",153,0) 119260 W "VA MAPPING TEXT MISMATCH: ",VATCNT,! 119261 "RTN","C0CRXN",154,0) 119262 W "NDF VUID COUNT: ",NDFVCNT,! 119263 "RTN","C0CRXN",155,0) 119264 W "NDF MISSING: ",NDFNO,! 119265 "RTN","C0CRXN",156,0) 119266 W "NDF TEXT MISMATCH: ",NDFTCNT,! 119267 "RTN","C0CRXN",157,0) 119268 Q 119269 "RTN","C0CRXN",158,0) 119270 CHKNDF ; ROUTINE TO CHECK THE NATIONAL DRUG FILE WITH THE UMLS RXNORM DB 119271 "RTN","C0CRXN",159,0) 119272 ; USING THE AVUID INDEX, READS ALL VUID CODES IN ^PSNDF(50.68), 119273 "RTN","C0CRXN",160,0) 119274 ; CHECKS TO SEE IF THE CODE IS IN 176.001, AND CREATES A RECORD 119275 "RTN","C0CRXN",161,0) 119276 ; IN 176.114 119277 "RTN","C0CRXN",162,0) 119278 ; THE OBJECTIVE IS TO SEE IF ^PSNDF(50.68) HAS ALL THE VUID CODES IN THE 119279 "RTN","C0CRXN",163,0) 119280 ; UMLS RXNORM DATABASE AND IF THE TEXT FIELDS MATCH 119281 "RTN","C0CRXN",164,0) 119282 ; ALSO CAPTURES THE RXNORM CODE MAPPING 119283 "RTN","C0CRXN",165,0) 119284 ; CHKNDF2 WILL CHECK THE OTHER DIRECTION, STARTING WITH THE 176.001 VUID INDEX 119285 "RTN","C0CRXN",166,0) 119286 ; THIS ROUTINE ALSO CHECKS IF THE VUID CODE IS IN 176.111 AND IF NOT 119287 "RTN","C0CRXN",167,0) 119288 ; SETS NOTMAPPED=Y 119289 "RTN","C0CRXN",168,0) 119290 N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR 119291 "RTN","C0CRXN",169,0) 119292 N C0CFVA,C0CFRXN,C0CPSNDF ; CLOSED ROOTS FOR SOURCE FILES 119293 "RTN","C0CRXN",170,0) 119294 N C0CF ; CLOSED ROOT FOR DESTINATION FILE 119295 "RTN","C0CRXN",171,0) 119296 S C0CPSNDF=$$FILEREF^C0CRNF(50.68) ; NDF CLOSED ROOT REFERENCE 119297 "RTN","C0CRXN",172,0) 119298 S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE 119299 "RTN","C0CRXN",173,0) 119300 S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE 119301 "RTN","C0CRXN",174,0) 119302 ;S C0CF=$$FILEREF^C0CRNF(176.113) ; C0C RXNORM VUID MAPPING ADDITIONAL FILE 119303 "RTN","C0CRXN",175,0) 119304 W C0CVA,C0CFRXN,! ;C0CF,! 119305 "RTN","C0CRXN",176,0) 119306 S C0CZX=0 119307 "RTN","C0CRXN",177,0) 119308 S (FOUND,MISSING)=0 119309 "RTN","C0CRXN",178,0) 119310 S (NOVUID,VMATCH,NOMATCH,MISSING,FOUND,TXTMATCH,NOTM,NVAM)=0 ; COUNTERS 119311 "RTN","C0CRXN",179,0) 119312 F S C0CZX=$O(^PSNDF(50.68,"AVUID",C0CZX)) Q:+C0CZX=0 D ; FOR EVERY VUID 119313 "RTN","C0CRXN",180,0) 119314 . K C0CA,C0CB,C0CC,C0CD ; CLEAR ARRAYS 119315 "RTN","C0CRXN",181,0) 119316 . ;D FIELDS^C0CRNF("C0CC",176.113) ;GET FIELD NAMES FOR OUTPUT FILE 119317 "RTN","C0CRXN",182,0) 119318 . D GETN1^C0CRNF("C0CA",50.68,C0CZX,"AVUID","ALL") ;GET THE FIELDS 119319 "RTN","C0CRXN",183,0) 119320 . I $$ZVALUE("VUID")="" D ; ERROR, SHOULD NOT HAPPEN 119321 "RTN","C0CRXN",184,0) 119322 . . S NOVUID=NOVUID+1 ; FLAG THE ERROR 119323 "RTN","C0CRXN",185,0) 119324 . . D PUSH^GPLXPATH("NOVUID",C0CZX) ; RECORD THE VUID 119325 "RTN","C0CRXN",186,0) 119326 . D GETN1^C0CRNF("C0CD",176.001,C0CZX,"VUID","ALL") ;TRY RXNORM DB 119327 "RTN","C0CRXN",187,0) 119328 . I $$ZVALUE("CODE","C0CD")=C0CZX D ; FOUND IN RXNORM 119329 "RTN","C0CRXN",188,0) 119330 . . S VMATCH=VMATCH+1 ; COUNT OF PSNDF VUIDS FOUND IN RXNORM 119331 "RTN","C0CRXN",189,0) 119332 . . I $$ZVALUE("NAME")=$$ZVALUE("STR","C0CD") D ;TEXT MATCHES 119333 "RTN","C0CRXN",190,0) 119334 . . . S TXTMATCH=TXTMATCH+1 ; COUNT IT 119335 "RTN","C0CRXN",191,0) 119336 . . E D ; TEXT DOESN'T MATCH 119337 "RTN","C0CRXN",192,0) 119338 . . . S NOTM=NOTM+1 ;NO TEXT MATCH COUNTER 119339 "RTN","C0CRXN",193,0) 119340 . . . S ZV=$$ZVALUE("NAME")_"^"_$$ZVALUE("STR","C0CD") 119341 "RTN","C0CRXN",194,0) 119342 . . . W ZV,! 119343 "RTN","C0CRXN",195,0) 119344 . . . D PUSH^GPLXPATH("TXTNM",ZV) ; RECORD THE TXT MISMATCH 119345 "RTN","C0CRXN",196,0) 119346 . E S NOMATCH=NOMATCH+1 ; NOT FOUND IN RXNORM 119347 "RTN","C0CRXN",197,0) 119348 . D GETN1^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;TRY TO GET FROM 176.111 119349 "RTN","C0CRXN",198,0) 119350 . I $$ZVALUE("VUID","C0CB")="" D ; VUID NOT FOUND 119351 "RTN","C0CRXN",199,0) 119352 . . ;W "NOT FOUND: ",C0CZX," ",$$ZVALUE("STR")," ",$$ZVALUE("RXCUI"),! 119353 "RTN","C0CRXN",200,0) 119354 . . S MISSING=MISSING+1 119355 "RTN","C0CRXN",201,0) 119356 . . D PUSH^GPLXPATH("MISSING",C0CZX) ;MISSING FROM MAPPING FILE 119357 "RTN","C0CRXN",202,0) 119358 . E D ; FOUND IN VA MAPPING FILE 119359 "RTN","C0CRXN",203,0) 119360 . . S FOUND=FOUND+1 119361 "RTN","C0CRXN",204,0) 119362 . . I $$ZVALUE("VUID TEXT","C0CB")'=$$ZVALUE("NAME") D ; TEXT DOESN'T MATCH 119363 "RTN","C0CRXN",205,0) 119364 . . . S NVAM=NVAM+1 ; MAPPING FILE TEXT IS DIFFERENT THAN NDF 119365 "RTN","C0CRXN",206,0) 119366 . . . S ZY=$$ZVALUE("VUID TEXT","C0CB")_"^"_$$ZVALUE("NAME") ;BOTH STRINGS 119367 "RTN","C0CRXN",207,0) 119368 . . . W "VA: ",ZY,! 119369 "RTN","C0CRXN",208,0) 119370 . . . D PUSH^GPLXPATH("NVAM",ZY) ;SAVE IT 119371 "RTN","C0CRXN",209,0) 119372 W "MISSING IN MAPPING FILE: ",MISSING,! 119373 "RTN","C0CRXN",210,0) 119374 W "FOUND IN MAPPING FILE: ",FOUND,! 119375 "RTN","C0CRXN",211,0) 119376 W "FOUND IN RXNORM: ",VMATCH,! 119377 "RTN","C0CRXN",212,0) 119378 W "NOT FOUND IN RXNORM: ",NOMATCH,! 119379 "RTN","C0CRXN",213,0) 119380 W "ERRORS: ",NOVUID,! 119381 "RTN","C0CRXN",214,0) 119382 Q 119383 "RTN","C0CRXN",215,0) 119384 ; 119385 "RTN","C0CRXN",216,0) 119386 D 119387 "RTN","C0CRXN",217,0) 118964 119388 . I $$ZVALUE("MEDIATION CODE")="" D 118965 "RTN","C0CRXN", 47,0)119389 "RTN","C0CRXN",218,0) 118966 119390 . . S NORXN=NORXN+1 ; 118967 "RTN","C0CRXN", 48,0)119391 "RTN","C0CRXN",219,0) 118968 119392 . E D ; PROCESS MEDIATION CODE 118969 "RTN","C0CRXN", 49,0)119393 "RTN","C0CRXN",220,0) 118970 119394 . . S HASRXN=HASRXN+1 118971 "RTN","C0CRXN", 50,0)119395 "RTN","C0CRXN",221,0) 118972 119396 . . D SETFDA("MEDIATION CODE",$$ZVALUE("MEDIATION CODE")) ; 118973 "RTN","C0CRXN", 51,0)119397 "RTN","C0CRXN",222,0) 118974 119398 . I $$ZVALUE("VUID")="" D ; BAD RECORD 118975 "RTN","C0CRXN", 52,0)119399 "RTN","C0CRXN",223,0) 118976 119400 . . S NOVUID=NOVUID+1 118977 "RTN","C0CRXN", 53,0)119401 "RTN","C0CRXN",224,0) 118978 119402 . . ;D SETFDA("VUID",$$ZVALUE("VUID")) 118979 "RTN","C0CRXN", 54,0)119403 "RTN","C0CRXN",225,0) 118980 119404 . E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT")) 118981 "RTN","C0CRXN", 55,0)118982 . .;ZWR C0CA118983 "RTN","C0CRXN", 56,0)119405 "RTN","C0CRXN",226,0) 119406 . ;ZWR C0CA 119407 "RTN","C0CRXN",227,0) 118984 119408 . D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL") 118985 "RTN","C0CRXN", 57,0)119409 "RTN","C0CRXN",228,0) 118986 119410 . I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND 118987 "RTN","C0CRXN", 58,0)119411 "RTN","C0CRXN",229,0) 118988 119412 . . S RXFOUND=RXFOUND+1 118989 "RTN","C0CRXN", 59,0)119413 "RTN","C0CRXN",230,0) 118990 119414 . . I $$ZVALUE("MEDIATION CODE")="" D ; THIS IS A NEW CODE 118991 "RTN","C0CRXN", 60,0)119415 "RTN","C0CRXN",231,0) 118992 119416 . . . D SETFDA("MEDIATION CODE",$$ZVALUE("RXCUI","C0CB")) 118993 "RTN","C0CRXN", 61,0)119417 "RTN","C0CRXN",232,0) 118994 119418 . . . D SETFDA("NEW","Y") ;FLAG RECORD HAS HAVING NEW RXNORM 118995 "RTN","C0CRXN", 62,0)119419 "RTN","C0CRXN",233,0) 118996 119420 . . W "RXNORM=",$$ZVALUE("RXCUI","C0CB")," ",$$ZVALUE("STR","C0CB"),! 118997 "RTN","C0CRXN", 63,0)119421 "RTN","C0CRXN",234,0) 118998 119422 . . W "VUID TEXT: ",$$ZVALUE("VUID TEXT"),! 118999 "RTN","C0CRXN", 64,0)119423 "RTN","C0CRXN",235,0) 119000 119424 . . I $$ZVALUE("VUID TEXT")=$$ZVALUE("STR","C0CB") S TXTMATCH=TXTMATCH+1 119001 "RTN","C0CRXN", 65,0)119425 "RTN","C0CRXN",236,0) 119002 119426 . . E D ; 119003 "RTN","C0CRXN",66,0) 119004 . . . S ZZ=$$ZVALUE("VUID TEXT")_"^"_$$ZVALUE("STR","C0CB") 119005 "RTN","C0CRXN",67,0) 119006 . . . D PUSH^GPLXPATH("NOMATCH",ZZ) 119007 "RTN","C0CRXN",68,0) 119427 "RTN","C0CRXN",237,0) 119428 . . . D PUSH^GPLXPATH("NOMATCH",$$ZVALUE("VUID TEXT")_"^"_$$ZVALUE("STR","C0CB")) 119429 "RTN","C0CRXN",238,0) 119008 119430 . . . D SETFDA("RXNORM TEXT",$$ZVALUE("STR","C0CB")) ; 119009 "RTN","C0CRXN", 69,0)119431 "RTN","C0CRXN",239,0) 119010 119432 . . . D SETFDA("DIFFERENT TEXT","Y") ;FLAG RECORD FOR DIFFERENT TEXT 119011 "RTN","C0CRXN", 70,0)119433 "RTN","C0CRXN",240,0) 119012 119434 . I $$ZVALUE("MEDIATION CODE")=$$ZVALUE("RXCUI","C0CB") D ; 119013 "RTN","C0CRXN", 71,0)119435 "RTN","C0CRXN",241,0) 119014 119436 . . S RXMATCH=RXMATCH+1 119015 "RTN","C0CRXN", 72,0)119437 "RTN","C0CRXN",242,0) 119016 119438 . . W "VUID=",$$ZVALUE("VUID")," MATCH RXNORM=",$$ZVALUE("MEDIATION CODE"),! 119017 "RTN","C0CRXN", 73,0)119439 "RTN","C0CRXN",243,0) 119018 119440 . D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP 119019 "RTN","C0CRXN", 74,0)119441 "RTN","C0CRXN",244,0) 119020 119442 . S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD 119021 "RTN","C0CRXN", 75,0)119443 "RTN","C0CRXN",245,0) 119022 119444 . D UPDATE^DIE("","C0CFDA") 119023 "RTN","C0CRXN", 76,0)119024 . I $D(^TMP("DIERR",$J)) U $P BREAK119025 "RTN","C0CRXN", 77,0)119445 "RTN","C0CRXN",246,0) 119446 . I $D(^TMP("DIERR",$J)) S $EC=",U1," 119447 "RTN","C0CRXN",247,0) 119026 119448 W "HAS RXN=",HASRXN,! 119027 "RTN","C0CRXN", 78,0)119449 "RTN","C0CRXN",248,0) 119028 119450 W "NO RXN=",NORXN,! 119029 "RTN","C0CRXN", 79,0)119451 "RTN","C0CRXN",249,0) 119030 119452 W "NO VUID=",NOVUID,! 119031 "RTN","C0CRXN", 80,0)119453 "RTN","C0CRXN",250,0) 119032 119454 W "RXNORM FOUND=",RXFOUND,! 119033 "RTN","C0CRXN", 81,0)119455 "RTN","C0CRXN",251,0) 119034 119456 W "RXNORM MATCHES:",RXMATCH,! 119035 "RTN","C0CRXN", 82,0)119457 "RTN","C0CRXN",252,0) 119036 119458 W "TEXT MATCHES:",TXTMATCH,! 119037 "RTN","C0CRXN", 83,0)119459 "RTN","C0CRXN",253,0) 119038 119460 Q 119039 "RTN","C0CRXN",84,0) 119040 ; 119041 "RTN","C0CRXN",85,0) 119042 EXP2 ; ROUTINE TO CREATE 176.113 C0C RXNORM VUID MAPPING DISCREPANCIES FILE 119043 "RTN","C0CRXN",86,0) 119044 ; CROSS CHECKS THE NATIONAL DRUG FILE AND THE VA MAPPING FILE AGAINST 119045 "RTN","C0CRXN",87,0) 119046 ; THE UMLS RXNORM DATABASE 119047 "RTN","C0CRXN",88,0) 119048 ; THIS ROUTINE HAS BEEN ENHANCED TO ALSO CHECK THE 50.416 DRUG INGREDIENT 119049 "RTN","C0CRXN",89,0) 119050 ; FILE AND TREAT VUIDS FOUND THERE LIKE THE ONES BEING FOUND IN THE NDF 119051 "RTN","C0CRXN",90,0) 119052 ; IF THE VUID EXISISTS IN ALL THREE FILES, THE RXNORM CODE MATCHES IN 119053 "RTN","C0CRXN",91,0) 119054 ; THE VA MAPPING FILE AND THE TEXT STRINGS ARE THE SAME, THE VUID IS INCLUDED 119055 "RTN","C0CRXN",92,0) 119056 ; IN THE FILE BUT NO FLAGS ARE SET 119057 "RTN","C0CRXN",93,0) 119058 ; IF THE VUID IS MISSING FROM THE NATIONAL DRUG FILE NDF=N 119059 "RTN","C0CRXN",94,0) 119060 ; (IF THE VUID IS MISSING FROM THE NDF, IT IS CHECKED IN THE DRUG INGREDIENT 119061 "RTN","C0CRXN",95,0) 119062 ; FILE, AND IF FOUND, THE FLAG IS NOT SET. IN THIS CASE THE TEXT FROM THE 119063 "RTN","C0CRXN",96,0) 119064 ; DRUG INGREDIENT FILE IS USED FOR COMPARISONS) 119065 "RTN","C0CRXN",97,0) 119066 ; IF THE VUID IS MISSING FROM THE VA MAPPING FILE VAMAP=N 119067 "RTN","C0CRXN",98,0) 119068 ; IF THE VUID IS PRESENT IN THE VA MAPPING FILE, BUT THE RXNORM 119069 "RTN","C0CRXN",99,0) 119070 ; CODE IS MISSING IN THAT FILE, VARXN=N 119071 "RTN","C0CRXN",100,0) 119072 ; IF THE TEXT STRINGS DO NOT MATCH EXACTLY, TXTM=N AND ALL THREE STRINGS 119073 "RTN","C0CRXN",101,0) 119074 ; ARE SHOWN; NDF TEXT=NDF TEXT STRING, VA MAP TEXT=VA MAPPING TEXT STRING 119075 "RTN","C0CRXN",102,0) 119076 ; RXNORM TEXT=RXNORM TEXT STRING 119077 "RTN","C0CRXN",103,0) 119078 ; THE FILE IS KEYED ON VUID AND WOULD USUALLY BE SORTED BY VUID 119079 "RTN","C0CRXN",104,0) 119080 ; THE OBJECTIVE IS TO SEE IF NDF (50.68) AND VA MAPPING (176.111) HAVE 119081 "RTN","C0CRXN",105,0) 119082 ; ALL THE VUID CODES THAT ARE IN THE UMLS RXNORM DATABASE 119083 "RTN","C0CRXN",106,0) 119084 N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR 119085 "RTN","C0CRXN",107,0) 119086 N C0CFVA,C0CFRXN ; CLOSED ROOTS FOR SOURCE FILES 119087 "RTN","C0CRXN",108,0) 119088 N C0CF ; CLOSED ROOT FOR DESTINATION FILE 119089 "RTN","C0CRXN",109,0) 119090 S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE 119091 "RTN","C0CRXN",110,0) 119092 S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE 119093 "RTN","C0CRXN",111,0) 119094 ;S C0CF=$$FILEREF^C0CRNF(176.113) ; C0C RXNORM VUID MAPPING ADDITIONAL FILE 119095 "RTN","C0CRXN",112,0) 119096 W C0CVA,C0CFRXN,! ;C0CF,! 119097 "RTN","C0CRXN",113,0) 119098 S C0CZX=0 119099 "RTN","C0CRXN",114,0) 119100 S (NDFVCNT,NDFTCNT,NDFNO)=0 ; COUNTERS FOR NDF TESTS 119101 "RTN","C0CRXN",115,0) 119102 S (VAVCNT,VATCNT,VARCNT,VANO)=0 ; COUNTERS FOR VA MAPPING FILE TESTS 119103 "RTN","C0CRXN",116,0) 119104 F S C0CZX=$O(^C0CRXN(176.001,"VUID",C0CZX)) Q:+C0CZX=0 D ; FOR EVERY VUID 119105 "RTN","C0CRXN",117,0) 119106 . K C0CA,C0CB,C0CC,C0CD ; CLEAR ARRAYS 119107 "RTN","C0CRXN",118,0) 119108 . D FIELDS^C0CRNF("C0CC",176.113) ;GET FIELD NAMES FOR OUTPUT FILE 119109 "RTN","C0CRXN",119,0) 119110 . D GETN1^C0CRNF("C0CA",176.001,C0CZX,"VUID","ALL") ;GET FROM RXNORM FILE 119111 "RTN","C0CRXN",120,0) 119112 . D GETN1^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;GET FROM VA MAPPING FILE 119113 "RTN","C0CRXN",121,0) 119114 . D GETN1^C0CRNF("C0CD",50.68,C0CZX,"AVUID","ALL") ;GET FROM NDF 119115 "RTN","C0CRXN",122,0) 119116 . D GETN1^C0CRNF("C0CE",50.416,C0CZX,"AVUID","ALL") ;GET FROM DRUG INGREDIENTS 119117 "RTN","C0CRXN",123,0) 119118 . ;D SETFDA("VUID",$$ZVALUE("CODE")) ;SET THE VUID CODE 119119 "RTN","C0CRXN",124,0) 119120 . D SETFDA("RXNORM",$$ZVALUE("RXCUI")) ;SET THE RXNORM CODE 119121 "RTN","C0CRXN",125,0) 119122 . D SETFDA("RXNORM TEXT",$$ZVALUE("STR")) ;SET THE RXNORM TEXT 119123 "RTN","C0CRXN",126,0) 119124 . ;VA MAPPING FILE TESTS 119125 "RTN","C0CRXN",127,0) 119126 . I $$ZVALUE("VUID","C0CB")=C0CZX D ; VUID FOUND 119127 "RTN","C0CRXN",128,0) 119128 . . S VAVCNT=VAVCNT+1 ;INCREMENT COUNT 119129 "RTN","C0CRXN",129,0) 119130 . . I $$ZVALUE("STR")'=$$ZVALUE("VUID TEXT","C0CB") D ;TEXT MISMATCH 119131 "RTN","C0CRXN",130,0) 119132 . . . S VATCNT=VATCNT+1 ; INCREMENT VA TEXT MISMATCH COUNT 119133 "RTN","C0CRXN",131,0) 119134 . . . D SETFDA("TXTM","N") ;MARK THAT TEXT DOESN'T MATCH 119135 "RTN","C0CRXN",132,0) 119136 . . . D SETFDA("VA MAP TEXT",$$ZVALUE("VUID TEXT","C0CB")) ; SET VA MAP TEXT 119137 "RTN","C0CRXN",133,0) 119138 . E D ; VUID NOT FOUND 119139 "RTN","C0CRXN",134,0) 119140 . . S VANO=VANO+1 119141 "RTN","C0CRXN",135,0) 119142 . . D SETFDA("VAMAP","N") ;MARK AS MISSING FROM VA MAPPING FILE 119143 "RTN","C0CRXN",136,0) 119144 . ; NATIONAL DRUG FILE TESTS 119145 "RTN","C0CRXN",137,0) 119146 . I ($$ZVALUE("VUID","C0CD")=C0CZX)!($$ZVALUE("VUID","C0CE")=C0CZX) D ; 119147 "RTN","C0CRXN",138,0) 119148 . . ;FOUND IN NATIONAL DRUG FILE OR DRUG INGREDIENT FILE 119149 "RTN","C0CRXN",139,0) 119150 . . S NDFVCNT=NDFVCNT+1 ;INCREMENT VUID FOUND COUNT 119151 "RTN","C0CRXN",140,0) 119152 . . I $$ZVALUE("NAME","C0CD")'=$$ZVALUE("STR") D ;NDF TEXT DOESN'T MATCH 119153 "RTN","C0CRXN",141,0) 119154 . . . I $$ZVALUE("NAME","C0CE")'=$$ZVALUE("STR") D ;DRUG ING FILE ALSO 119155 "RTN","C0CRXN",142,0) 119156 . . . . S NDFTCNT=NDFTCNT+1 ; INCREMENT MISMATCHED NDF TEXT COUNT 119157 "RTN","C0CRXN",143,0) 119158 . . . . D SETFDA("TXTM","N") ; SET TEXT MATCH FLAG TO N 119159 "RTN","C0CRXN",144,0) 119160 . . . . D SETFDA("NDF TEXT",$$ZVALUE("NAME","C0CD")) ;POST THE TEXT 119161 "RTN","C0CRXN",145,0) 119162 . . . . D SETFDA("NAT DRUG TEXT",$$ZVALUE("NAME","C0CE")) ;POST TEXT 119163 "RTN","C0CRXN",146,0) 119164 . E D ; 119165 "RTN","C0CRXN",147,0) 119166 . . D SETFDA("NDF","N") ;MARK AS MISSING 119167 "RTN","C0CRXN",148,0) 119168 . . S NDFNO=NDFNO+1 ;INCREMENT MISSING COUNT 119169 "RTN","C0CRXN",149,0) 119170 . D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP 119171 "RTN","C0CRXN",150,0) 119172 . S C0CFDA(176.113,"+"_C0CZX_",",.01)=C0CZX ; NEW VUID RECORD 119173 "RTN","C0CRXN",151,0) 119174 . D UPDATE^DIE("","C0CFDA") 119175 "RTN","C0CRXN",152,0) 119176 . I $D(^TMP("DIERR",$J)) U $P BREAK 119177 "RTN","C0CRXN",153,0) 119178 W "VA MAPPING VUID COUNT: ",VAVCNT,! 119179 "RTN","C0CRXN",154,0) 119180 W "VA MAPPING MISSING: ",VANO,! 119181 "RTN","C0CRXN",155,0) 119182 W "VA MAPPING TEXT MISMATCH: ",VATCNT,! 119183 "RTN","C0CRXN",156,0) 119184 W "NDF VUID COUNT: ",NDFVCNT,! 119185 "RTN","C0CRXN",157,0) 119186 W "NDF MISSING: ",NDFNO,! 119187 "RTN","C0CRXN",158,0) 119188 W "NDF TEXT MISMATCH: ",NDFTCNT,! 119189 "RTN","C0CRXN",159,0) 119461 "RTN","C0CRXN",254,0) 119462 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN 119463 "RTN","C0CRXN",255,0) 119464 ; TO SET TO VALUE C0CSV. 119465 "RTN","C0CRXN",256,0) 119466 ; C0CFDA,C0CA,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE 119467 "RTN","C0CRXN",257,0) 119468 ; C0CSN,C0CSV ARE PASSED BY VALUE 119469 "RTN","C0CRXN",258,0) 119470 ; 119471 "RTN","C0CRXN",259,0) 119472 N C0CSI,C0CSJ 119473 "RTN","C0CRXN",260,0) 119474 S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER 119475 "RTN","C0CRXN",261,0) 119476 S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER 119477 "RTN","C0CRXN",262,0) 119478 S C0CFDA(C0CSI,"+"_C0CZX_",",C0CSJ)=C0CSV 119479 "RTN","C0CRXN",263,0) 119190 119480 Q 119191 "RTN","C0CRXN",160,0)119192 CHKNDF ; ROUTINE TO CHECK THE NATIONAL DRUG FILE WITH THE UMLS RXNORM DB119193 "RTN","C0CRXN",161,0)119194 ; USING THE AVUID INDEX, READS ALL VUID CODES IN ^PSNDF(50.68),119195 "RTN","C0CRXN",162,0)119196 ; CHECKS TO SEE IF THE CODE IS IN 176.001, AND CREATES A RECORD119197 "RTN","C0CRXN",163,0)119198 ; IN 176.114119199 "RTN","C0CRXN",164,0)119200 ; THE OBJECTIVE IS TO SEE IF ^PSNDF(50.68) HAS ALL THE VUID CODES IN THE119201 "RTN","C0CRXN",165,0)119202 ; UMLS RXNORM DATABASE AND IF THE TEXT FIELDS MATCH119203 "RTN","C0CRXN",166,0)119204 ; ALSO CAPTURES THE RXNORM CODE MAPPING119205 "RTN","C0CRXN",167,0)119206 ; CHKNDF2 WILL CHECK THE OTHER DIRECTION, STARTING WITH THE 176.001 VUID INDEX119207 "RTN","C0CRXN",168,0)119208 ; THIS ROUTINE ALSO CHECKS IF THE VUID CODE IS IN 176.111 AND IF NOT119209 "RTN","C0CRXN",169,0)119210 ; SETS NOTMAPPED=Y119211 "RTN","C0CRXN",170,0)119212 N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR119213 "RTN","C0CRXN",171,0)119214 N C0CFVA,C0CFRXN,C0CPSNDF ; CLOSED ROOTS FOR SOURCE FILES119215 "RTN","C0CRXN",172,0)119216 N C0CF ; CLOSED ROOT FOR DESTINATION FILE119217 "RTN","C0CRXN",173,0)119218 S C0CPSNDF=$$FILEREF^C0CRNF(50.68) ; NDF CLOSED ROOT REFERENCE119219 "RTN","C0CRXN",174,0)119220 S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE119221 "RTN","C0CRXN",175,0)119222 S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE119223 "RTN","C0CRXN",176,0)119224 ;S C0CF=$$FILEREF^C0CRNF(176.113) ; C0C RXNORM VUID MAPPING ADDITIONAL FILE119225 "RTN","C0CRXN",177,0)119226 W C0CVA,C0CFRXN,! ;C0CF,!119227 "RTN","C0CRXN",178,0)119228 S C0CZX=0119229 "RTN","C0CRXN",179,0)119230 S (FOUND,MISSING)=0119231 "RTN","C0CRXN",180,0)119232 S (NOVUID,VMATCH,NOMATCH,MISSING,FOUND,TXTMATCH,NOTM,NVAM)=0 ; COUNTERS119233 "RTN","C0CRXN",181,0)119234 F S C0CZX=$O(^PSNDF(50.68,"AVUID",C0CZX)) Q:+C0CZX=0 D ; FOR EVERY VUID119235 "RTN","C0CRXN",182,0)119236 . K C0CA,C0CB,C0CC,C0CD ; CLEAR ARRAYS119237 "RTN","C0CRXN",183,0)119238 . ;D FIELDS^C0CRNF("C0CC",176.113) ;GET FIELD NAMES FOR OUTPUT FILE119239 "RTN","C0CRXN",184,0)119240 . D GETN1^C0CRNF("C0CA",50.68,C0CZX,"AVUID","ALL") ;GET THE FIELDS119241 "RTN","C0CRXN",185,0)119242 . I $$ZVALUE("VUID")="" D ; ERROR, SHOULD NOT HAPPEN119243 "RTN","C0CRXN",186,0)119244 . . S NOVUID=NOVUID+1 ; FLAG THE ERROR119245 "RTN","C0CRXN",187,0)119246 . . D PUSH^GPLXPATH("NOVUID",C0CZX) ; RECORD THE VUID119247 "RTN","C0CRXN",188,0)119248 . D GETN1^C0CRNF("C0CD",176.001,C0CZX,"VUID","ALL") ;TRY RXNORM DB119249 "RTN","C0CRXN",189,0)119250 . I $$ZVALUE("CODE","C0CD")=C0CZX D ; FOUND IN RXNORM119251 "RTN","C0CRXN",190,0)119252 . . S VMATCH=VMATCH+1 ; COUNT OF PSNDF VUIDS FOUND IN RXNORM119253 "RTN","C0CRXN",191,0)119254 . . I $$ZVALUE("NAME")=$$ZVALUE("STR","C0CD") D ;TEXT MATCHES119255 "RTN","C0CRXN",192,0)119256 . . . S TXTMATCH=TXTMATCH+1 ; COUNT IT119257 "RTN","C0CRXN",193,0)119258 . . E D ; TEXT DOESN'T MATCH119259 "RTN","C0CRXN",194,0)119260 . . . S NOTM=NOTM+1 ;NO TEXT MATCH COUNTER119261 "RTN","C0CRXN",195,0)119262 . . . S ZV=$$ZVALUE("NAME")_"^"_$$ZVALUE("STR","C0CD")119263 "RTN","C0CRXN",196,0)119264 . . . W ZV,!119265 "RTN","C0CRXN",197,0)119266 . . . D PUSH^GPLXPATH("TXTNM",ZV) ; RECORD THE TXT MISMATCH119267 "RTN","C0CRXN",198,0)119268 . E S NOMATCH=NOMATCH+1 ; NOT FOUND IN RXNORM119269 "RTN","C0CRXN",199,0)119270 . D GETN1^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;TRY TO GET FROM 176.111119271 "RTN","C0CRXN",200,0)119272 . I $$ZVALUE("VUID","C0CB")="" D ; VUID NOT FOUND119273 "RTN","C0CRXN",201,0)119274 . . ;W "NOT FOUND: ",C0CZX," ",$$ZVALUE("STR")," ",$$ZVALUE("RXCUI"),!119275 "RTN","C0CRXN",202,0)119276 . . S MISSING=MISSING+1119277 "RTN","C0CRXN",203,0)119278 . . D PUSH^GPLXPATH("MISSING",C0CZX) ;MISSING FROM MAPPING FILE119279 "RTN","C0CRXN",204,0)119280 . E D ; FOUND IN VA MAPPING FILE119281 "RTN","C0CRXN",205,0)119282 . . S FOUND=FOUND+1119283 "RTN","C0CRXN",206,0)119284 . . I $$ZVALUE("VUID TEXT","C0CB")'=$$ZVALUE("NAME") D ; TEXT DOESN'T MATCH119285 "RTN","C0CRXN",207,0)119286 . . . S NVAM=NVAM+1 ; MAPPING FILE TEXT IS DIFFERENT THAN NDF119287 "RTN","C0CRXN",208,0)119288 . . . S ZY=$$ZVALUE("VUID TEXT","C0CB")_"^"_$$ZVALUE("NAME") ;BOTH STRINGS119289 "RTN","C0CRXN",209,0)119290 . . . W "VA: ",ZY,!119291 "RTN","C0CRXN",210,0)119292 . . . D PUSH^GPLXPATH("NVAM",ZY) ;SAVE IT119293 "RTN","C0CRXN",211,0)119294 W "MISSING IN MAPPING FILE: ",MISSING,!119295 "RTN","C0CRXN",212,0)119296 W "FOUND IN MAPPING FILE: ",FOUND,!119297 "RTN","C0CRXN",213,0)119298 W "FOUND IN RXNORM: ",VMATCH,!119299 "RTN","C0CRXN",214,0)119300 W "NOT FOUND IN RXNORM: ",NOMATCH,!119301 "RTN","C0CRXN",215,0)119302 W "ERRORS: ",NOVUID,!119303 "RTN","C0CRXN",216,0)119304 Q119305 "RTN","C0CRXN",217,0)119306 ;119307 "RTN","C0CRXN",218,0)119308 . I $$ZVALUE("MEDIATION CODE")="" D119309 "RTN","C0CRXN",219,0)119310 . . S NORXN=NORXN+1 ;119311 "RTN","C0CRXN",220,0)119312 . E D ; PROCESS MEDIATION CODE119313 "RTN","C0CRXN",221,0)119314 . . S HASRXN=HASRXN+1119315 "RTN","C0CRXN",222,0)119316 . . D SETFDA("MEDIATION CODE",$$ZVALUE("MEDIATION CODE")) ;119317 "RTN","C0CRXN",223,0)119318 . I $$ZVALUE("VUID")="" D ; BAD RECORD119319 "RTN","C0CRXN",224,0)119320 . . S NOVUID=NOVUID+1119321 "RTN","C0CRXN",225,0)119322 . . ;D SETFDA("VUID",$$ZVALUE("VUID"))119323 "RTN","C0CRXN",226,0)119324 . E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT"))119325 "RTN","C0CRXN",227,0)119326 . . ;ZWR C0CA119327 "RTN","C0CRXN",228,0)119328 . D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")119329 "RTN","C0CRXN",229,0)119330 . I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND119331 "RTN","C0CRXN",230,0)119332 . . S RXFOUND=RXFOUND+1119333 "RTN","C0CRXN",231,0)119334 . . I $$ZVALUE("MEDIATION CODE")="" D ; THIS IS A NEW CODE119335 "RTN","C0CRXN",232,0)119336 . . . D SETFDA("MEDIATION CODE",$$ZVALUE("RXCUI","C0CB"))119337 "RTN","C0CRXN",233,0)119338 . . . D SETFDA("NEW","Y") ;FLAG RECORD HAS HAVING NEW RXNORM119339 "RTN","C0CRXN",234,0)119340 . . W "RXNORM=",$$ZVALUE("RXCUI","C0CB")," ",$$ZVALUE("STR","C0CB"),!119341 "RTN","C0CRXN",235,0)119342 . . W "VUID TEXT: ",$$ZVALUE("VUID TEXT"),!119343 "RTN","C0CRXN",236,0)119344 . . I $$ZVALUE("VUID TEXT")=$$ZVALUE("STR","C0CB") S TXTMATCH=TXTMATCH+1119345 "RTN","C0CRXN",237,0)119346 . . E D ;119347 "RTN","C0CRXN",238,0)119348 . . . D PUSH^GPLXPATH("NOMATCH",$$ZVALUE("VUID TEXT")_"^"_$$ZVALUE("STR","C0CB"))119349 "RTN","C0CRXN",239,0)119350 . . . D SETFDA("RXNORM TEXT",$$ZVALUE("STR","C0CB")) ;119351 "RTN","C0CRXN",240,0)119352 . . . D SETFDA("DIFFERENT TEXT","Y") ;FLAG RECORD FOR DIFFERENT TEXT119353 "RTN","C0CRXN",241,0)119354 . I $$ZVALUE("MEDIATION CODE")=$$ZVALUE("RXCUI","C0CB") D ;119355 "RTN","C0CRXN",242,0)119356 . . S RXMATCH=RXMATCH+1119357 "RTN","C0CRXN",243,0)119358 . . W "VUID=",$$ZVALUE("VUID")," MATCH RXNORM=",$$ZVALUE("MEDIATION CODE"),!119359 "RTN","C0CRXN",244,0)119360 . D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP119361 "RTN","C0CRXN",245,0)119362 . S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD119363 "RTN","C0CRXN",246,0)119364 . D UPDATE^DIE("","C0CFDA")119365 "RTN","C0CRXN",247,0)119366 . I $D(^TMP("DIERR",$J)) U $P BREAK119367 "RTN","C0CRXN",248,0)119368 W "HAS RXN=",HASRXN,!119369 "RTN","C0CRXN",249,0)119370 W "NO RXN=",NORXN,!119371 "RTN","C0CRXN",250,0)119372 W "NO VUID=",NOVUID,!119373 "RTN","C0CRXN",251,0)119374 W "RXNORM FOUND=",RXFOUND,!119375 "RTN","C0CRXN",252,0)119376 W "RXNORM MATCHES:",RXMATCH,!119377 "RTN","C0CRXN",253,0)119378 W "TEXT MATCHES:",TXTMATCH,!119379 "RTN","C0CRXN",254,0)119380 Q119381 "RTN","C0CRXN",255,0)119382 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN119383 "RTN","C0CRXN",256,0)119384 ; TO SET TO VALUE C0CSV.119385 "RTN","C0CRXN",257,0)119386 ; C0CFDA,C0CA,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE119387 "RTN","C0CRXN",258,0)119388 ; C0CSN,C0CSV ARE PASSED BY VALUE119389 "RTN","C0CRXN",259,0)119390 ;119391 "RTN","C0CRXN",260,0)119392 N C0CSI,C0CSJ119393 "RTN","C0CRXN",261,0)119394 S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER119395 "RTN","C0CRXN",262,0)119396 S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER119397 "RTN","C0CRXN",263,0)119398 S C0CFDA(C0CSI,"+"_C0CZX_",",C0CSJ)=C0CSV119399 119481 "RTN","C0CRXN",264,0) 119400 Q 119482 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 119401 119483 "RTN","C0CRXN",265,0) 119402 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 119484 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN) 119403 119485 "RTN","C0CRXN",266,0) 119404 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)119486 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 119405 119487 "RTN","C0CRXN",267,0) 119488 I '$D(ZTAB) S ZTAB="C0CA" 119489 "RTN","C0CRXN",268,0) 119490 N ZR 119491 "RTN","C0CRXN",269,0) 119492 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1) 119493 "RTN","C0CRXN",270,0) 119494 E S ZR="" 119495 "RTN","C0CRXN",271,0) 119496 Q ZR 119497 "RTN","C0CRXN",272,0) 119498 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED 119499 "RTN","C0CRXN",273,0) 119500 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN) 119501 "RTN","C0CRXN",274,0) 119406 119502 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 119407 "RTN","C0CRXN",2 68,0)119503 "RTN","C0CRXN",275,0) 119408 119504 I '$D(ZTAB) S ZTAB="C0CA" 119409 "RTN","C0CRXN",2 69,0)119505 "RTN","C0CRXN",276,0) 119410 119506 N ZR 119411 "RTN","C0CRXN",27 0,0)119412 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^", 1)119413 "RTN","C0CRXN",27 1,0)119507 "RTN","C0CRXN",277,0) 119508 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2) 119509 "RTN","C0CRXN",278,0) 119414 119510 E S ZR="" 119415 "RTN","C0CRXN",27 2,0)119511 "RTN","C0CRXN",279,0) 119416 119512 Q ZR 119417 "RTN","C0CRXN",273,0) 119418 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED 119419 "RTN","C0CRXN",274,0) 119420 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN) 119421 "RTN","C0CRXN",275,0) 119513 "RTN","C0CRXN",280,0) 119514 ; 119515 "RTN","C0CRXN",281,0) 119516 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED 119517 "RTN","C0CRXN",282,0) 119518 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN) 119519 "RTN","C0CRXN",283,0) 119422 119520 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 119423 "RTN","C0CRXN",2 76,0)119521 "RTN","C0CRXN",284,0) 119424 119522 I '$D(ZTAB) S ZTAB="C0CA" 119425 "RTN","C0CRXN",2 77,0)119523 "RTN","C0CRXN",285,0) 119426 119524 N ZR 119427 "RTN","C0CRXN",2 78,0)119428 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^", 2)119429 "RTN","C0CRXN",2 79,0)119525 "RTN","C0CRXN",286,0) 119526 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3) 119527 "RTN","C0CRXN",287,0) 119430 119528 E S ZR="" 119431 "RTN","C0CRXN",28 0,0)119529 "RTN","C0CRXN",288,0) 119432 119530 Q ZR 119433 "RTN","C0CRXN",281,0)119434 ;119435 "RTN","C0CRXN",282,0)119436 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED119437 "RTN","C0CRXN",283,0)119438 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)119439 "RTN","C0CRXN",284,0)119440 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA119441 "RTN","C0CRXN",285,0)119442 I '$D(ZTAB) S ZTAB="C0CA"119443 "RTN","C0CRXN",286,0)119444 N ZR119445 "RTN","C0CRXN",287,0)119446 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)119447 "RTN","C0CRXN",288,0)119448 E S ZR=""119449 119531 "RTN","C0CRXN",289,0) 119450 Q ZR119451 "RTN","C0CRXN",290,0)119452 119532 ; 119453 119533 "RTN","C0CRXNRD") 119454 0^97^B3 1474664119534 0^97^B36296842 119455 119535 "RTN","C0CRXNRD",1,0) 119456 119536 C0CRXNRD ; WV/SMH - CCR/CCD PROJECT: Routine to Read RxNorm files;11/15/08 119457 119537 "RTN","C0CRXNRD",2,0) 119458 ;;1.2;C 0C;;May 11, 2012;Build 50119538 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 119459 119539 "RTN","C0CRXNRD",3,0) 119540 ; Copyright Sam Habiel 2008. 119541 "RTN","C0CRXNRD",4,0) 119542 ; 119543 "RTN","C0CRXNRD",5,0) 119544 ; This program is free software: you can redistribute it and/or modify 119545 "RTN","C0CRXNRD",6,0) 119546 ; it under the terms of the GNU Affero General Public License as 119547 "RTN","C0CRXNRD",7,0) 119548 ; published by the Free Software Foundation, either version 3 of the 119549 "RTN","C0CRXNRD",8,0) 119550 ; License, or (at your option) any later version. 119551 "RTN","C0CRXNRD",9,0) 119552 ; 119553 "RTN","C0CRXNRD",10,0) 119554 ; This program is distributed in the hope that it will be useful, 119555 "RTN","C0CRXNRD",11,0) 119556 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 119557 "RTN","C0CRXNRD",12,0) 119558 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 119559 "RTN","C0CRXNRD",13,0) 119560 ; GNU Affero General Public License for more details. 119561 "RTN","C0CRXNRD",14,0) 119562 ; 119563 "RTN","C0CRXNRD",15,0) 119564 ; You should have received a copy of the GNU Affero General Public License 119565 "RTN","C0CRXNRD",16,0) 119566 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 119567 "RTN","C0CRXNRD",17,0) 119568 ; 119569 "RTN","C0CRXNRD",18,0) 119460 119570 W "No entry from top" Q 119461 "RTN","C0CRXNRD", 4,0)119462 IMPORT(PATH) 119463 "RTN","C0CRXNRD", 5,0)119571 "RTN","C0CRXNRD",19,0) 119572 IMPORT(PATH) ; Main entry point 119573 "RTN","C0CRXNRD",20,0) 119464 119574 I PATH="" QUIT 119465 "RTN","C0CRXNRD", 6,0)119575 "RTN","C0CRXNRD",21,0) 119466 119576 D READSRC(PATH),READCON(PATH),READNDC(PATH) 119467 "RTN","C0CRXNRD", 7,0)119577 "RTN","C0CRXNRD",22,0) 119468 119578 QUIT 119469 "RTN","C0CRXNRD", 8,0)119470 ; 119471 "RTN","C0CRXNRD", 9,0)119579 "RTN","C0CRXNRD",23,0) 119580 ; 119581 "RTN","C0CRXNRD",24,0) 119472 119582 DELFILED(FN) ; Delete file data; PEP procedure; only for RxNorm files 119473 "RTN","C0CRXNRD", 10,0)119583 "RTN","C0CRXNRD",25,0) 119474 119584 ; FN is Filenumber passed by Value 119475 "RTN","C0CRXNRD", 11,0)119585 "RTN","C0CRXNRD",26,0) 119476 119586 QUIT:$E(FN,1,3)'=176 ; Quit if not RxNorm files 119477 "RTN","C0CRXNRD", 12,0)119587 "RTN","C0CRXNRD",27,0) 119478 119588 D CLEAN^DILF ; Clean FM variables 119479 "RTN","C0CRXNRD", 13,0)119589 "RTN","C0CRXNRD",28,0) 119480 119590 N ROOT S ROOT=$$ROOT^DILFD(FN,"",1) ; global root 119481 "RTN","C0CRXNRD", 14,0)119591 "RTN","C0CRXNRD",29,0) 119482 119592 N ZERO S ZERO=@ROOT@(0) ; Save zero node 119483 "RTN","C0CRXNRD", 15,0)119593 "RTN","C0CRXNRD",30,0) 119484 119594 S $P(ZERO,U,3,9999)="" ; Remove entry # and last edited 119485 "RTN","C0CRXNRD", 16,0)119595 "RTN","C0CRXNRD",31,0) 119486 119596 K @ROOT ; Kill the file -- so sad! 119487 "RTN","C0CRXNRD", 17,0)119597 "RTN","C0CRXNRD",32,0) 119488 119598 S @ROOT@(0)=ZERO ; It riseth again! 119489 "RTN","C0CRXNRD", 18,0)119599 "RTN","C0CRXNRD",33,0) 119490 119600 QUIT 119491 "RTN","C0CRXNRD", 19,0)119601 "RTN","C0CRXNRD",34,0) 119492 119602 GETLINES(PATH,FILENAME) ; Get number of lines in a file 119493 "RTN","C0CRXNRD", 20,0)119603 "RTN","C0CRXNRD",35,0) 119494 119604 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 119495 "RTN","C0CRXNRD", 21,0)119605 "RTN","C0CRXNRD",36,0) 119496 119606 U IO 119497 "RTN","C0CRXNRD", 22,0)119607 "RTN","C0CRXNRD",37,0) 119498 119608 N I 119499 "RTN","C0CRXNRD", 23,0)119500 F I=1:1 R LINE Q:$$STATUS^%ZISH119501 "RTN","C0CRXNRD", 24,0)119609 "RTN","C0CRXNRD",38,0) 119610 F I=1:1 R LINE:0 Q:$$STATUS^%ZISH 119611 "RTN","C0CRXNRD",39,0) 119502 119612 D CLOSE^%ZISH("FILE") 119503 "RTN","C0CRXNRD", 25,0)119613 "RTN","C0CRXNRD",40,0) 119504 119614 Q I-1 119505 "RTN","C0CRXNRD", 26,0)119615 "RTN","C0CRXNRD",41,0) 119506 119616 READCON(PATH,INCRES) ; Open and read concepts file: RXNCONSO.RRF; EP 119507 "RTN","C0CRXNRD", 27,0)119617 "RTN","C0CRXNRD",42,0) 119508 119618 ; PATH ByVal, path of RxNorm files 119509 "RTN","C0CRXNRD", 28,0)119619 "RTN","C0CRXNRD",43,0) 119510 119620 ; INCRES ByVal, include restricted sources. 1 for yes, 0 for no 119511 "RTN","C0CRXNRD", 29,0)119621 "RTN","C0CRXNRD",44,0) 119512 119622 I PATH="" QUIT 119513 "RTN","C0CRXNRD", 30,0)119623 "RTN","C0CRXNRD",45,0) 119514 119624 S INCRES=+$G(INCRES) ; if not passed, becomes zero. 119515 "RTN","C0CRXNRD", 31,0)119625 "RTN","C0CRXNRD",46,0) 119516 119626 N FILENAME S FILENAME="RXNCONSO.RRF" 119517 "RTN","C0CRXNRD", 32,0)119627 "RTN","C0CRXNRD",47,0) 119518 119628 D DELFILED(176.001) ; delete data 119519 "RTN","C0CRXNRD", 33,0)119629 "RTN","C0CRXNRD",48,0) 119520 119630 N LINES S LINES=$$GETLINES(PATH,FILENAME) 119521 "RTN","C0CRXNRD", 34,0)119631 "RTN","C0CRXNRD",49,0) 119522 119632 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 119523 "RTN","C0CRXNRD", 35,0)119633 "RTN","C0CRXNRD",50,0) 119524 119634 IF POP D EN^DDIOL("Error reading file..., Please check...") G EX 119525 "RTN","C0CRXNRD", 36,0)119635 "RTN","C0CRXNRD",51,0) 119526 119636 N C0CCOUNT 119527 "RTN","C0CRXNRD", 37,0)119637 "RTN","C0CRXNRD",52,0) 119528 119638 F C0CCOUNT=1:1 D Q:$$STATUS^%ZISH 119529 "RTN","C0CRXNRD", 38,0)119639 "RTN","C0CRXNRD",53,0) 119530 119640 . U IO 119531 "RTN","C0CRXNRD", 39,0)119532 . N LINE R LINE 119533 "RTN","C0CRXNRD", 40,0)119641 "RTN","C0CRXNRD",54,0) 119642 . N LINE R LINE:0 119643 "RTN","C0CRXNRD",55,0) 119534 119644 . IF $$STATUS^%ZISH QUIT 119535 "RTN","C0CRXNRD", 41,0)119645 "RTN","C0CRXNRD",56,0) 119536 119646 . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000 119537 "RTN","C0CRXNRD", 42,0)119647 "RTN","C0CRXNRD",57,0) 119538 119648 . N RXCUI,RXAUI,SAB,TTY,CODE,STR ; Fileman fields numbers below 119539 "RTN","C0CRXNRD", 43,0)119649 "RTN","C0CRXNRD",58,0) 119540 119650 . S RXCUI=$P(LINE,"|",1) ; .01 119541 "RTN","C0CRXNRD", 44,0)119651 "RTN","C0CRXNRD",59,0) 119542 119652 . S RXAUI=$P(LINE,"|",8) ; 1 119543 "RTN","C0CRXNRD", 45,0)119653 "RTN","C0CRXNRD",60,0) 119544 119654 . S SAB=$P(LINE,"|",12) ; 2 119545 "RTN","C0CRXNRD", 46,0)119655 "RTN","C0CRXNRD",61,0) 119546 119656 . ; If the source is a restricted source, decide what to do based on what's asked. 119547 "RTN","C0CRXNRD", 47,0)119657 "RTN","C0CRXNRD",62,0) 119548 119658 . N SRCIEN S SRCIEN=$$FIND1^DIC(176.003,"","QX",SAB,"B") ; SrcIEN in RXNORM SOURCES file 119549 "RTN","C0CRXNRD", 48,0)119659 "RTN","C0CRXNRD",63,0) 119550 119660 . N RESTRIC S RESTRIC=$$GET1^DIQ(176.003,SRCIEN,14,"I") ; 14 is restriction field; values 0-4 119551 "RTN","C0CRXNRD", 49,0)119661 "RTN","C0CRXNRD",64,0) 119552 119662 . ; If RESTRIC is zero, then it's unrestricted. Everything else is restricted. 119553 "RTN","C0CRXNRD", 50,0)119663 "RTN","C0CRXNRD",65,0) 119554 119664 . ; If user didn't ask to include restricted sources, and the source is restricted, then quit 119555 "RTN","C0CRXNRD", 51,0)119665 "RTN","C0CRXNRD",66,0) 119556 119666 . I 'INCRES,RESTRIC QUIT 119557 "RTN","C0CRXNRD", 52,0)119667 "RTN","C0CRXNRD",67,0) 119558 119668 . S TTY=$P(LINE,"|",13) ; 3 119559 "RTN","C0CRXNRD", 53,0)119669 "RTN","C0CRXNRD",68,0) 119560 119670 . S CODE=$P(LINE,"|",14) ; 4 119561 "RTN","C0CRXNRD", 54,0)119671 "RTN","C0CRXNRD",69,0) 119562 119672 . S STR=$P(LINE,"|",15) ; 5 119563 "RTN","C0CRXNRD", 55,0)119673 "RTN","C0CRXNRD",70,0) 119564 119674 . ; Remove embedded "^" 119565 "RTN","C0CRXNRD", 56,0)119675 "RTN","C0CRXNRD",71,0) 119566 119676 . S STR=$TR(STR,"^") 119567 "RTN","C0CRXNRD", 57,0)119677 "RTN","C0CRXNRD",72,0) 119568 119678 . ; Convert STR into an array of 80 characters on each line 119569 "RTN","C0CRXNRD", 58,0)119679 "RTN","C0CRXNRD",73,0) 119570 119680 . N STRLINE S STRLINE=$L(STR)\80+1 119571 "RTN","C0CRXNRD", 59,0)119681 "RTN","C0CRXNRD",74,0) 119572 119682 . ; In each line, chop 80 characters off, reset STR to be the rest 119573 "RTN","C0CRXNRD", 60,0)119683 "RTN","C0CRXNRD",75,0) 119574 119684 . N J F J=1:1:STRLINE S STR(J)=$E(STR,1,80) S STR=$E(STR,81,$L(STR)) 119575 "RTN","C0CRXNRD", 61,0)119685 "RTN","C0CRXNRD",76,0) 119576 119686 . ; Now, construct the FDA array 119577 "RTN","C0CRXNRD", 62,0)119687 "RTN","C0CRXNRD",77,0) 119578 119688 . N RXNFDA 119579 "RTN","C0CRXNRD", 63,0)119689 "RTN","C0CRXNRD",78,0) 119580 119690 . S RXNFDA(176.001,"+1,",.01)=RXCUI 119581 "RTN","C0CRXNRD", 64,0)119691 "RTN","C0CRXNRD",79,0) 119582 119692 . S RXNFDA(176.001,"+1,",1)=RXAUI 119583 "RTN","C0CRXNRD", 65,0)119693 "RTN","C0CRXNRD",80,0) 119584 119694 . S RXNFDA(176.001,"+1,",2)=SAB 119585 "RTN","C0CRXNRD", 66,0)119695 "RTN","C0CRXNRD",81,0) 119586 119696 . S RXNFDA(176.001,"+1,",3)=TTY 119587 "RTN","C0CRXNRD", 67,0)119697 "RTN","C0CRXNRD",82,0) 119588 119698 . S RXNFDA(176.001,"+1,",4)=CODE 119589 "RTN","C0CRXNRD", 68,0)119699 "RTN","C0CRXNRD",83,0) 119590 119700 . N RXNIEN S RXNIEN(1)=C0CCOUNT 119591 "RTN","C0CRXNRD", 69,0)119701 "RTN","C0CRXNRD",84,0) 119592 119702 . D UPDATE^DIE("","RXNFDA","RXNIEN") 119593 "RTN","C0CRXNRD", 70,0)119703 "RTN","C0CRXNRD",85,0) 119594 119704 . I $D(^TMP("DIERR",$J)) D EN^DDIOL("ERROR") G EX 119595 "RTN","C0CRXNRD", 71,0)119705 "RTN","C0CRXNRD",86,0) 119596 119706 . ; Now, file WP field STR 119597 "RTN","C0CRXNRD", 72,0)119707 "RTN","C0CRXNRD",87,0) 119598 119708 . D WP^DIE(176.001,C0CCOUNT_",",5,,$NA(STR)) 119599 "RTN","C0CRXNRD", 73,0)119709 "RTN","C0CRXNRD",88,0) 119600 119710 EX D CLOSE^%ZISH("FILE") 119601 "RTN","C0CRXNRD", 74,0)119711 "RTN","C0CRXNRD",89,0) 119602 119712 QUIT 119603 "RTN","C0CRXNRD", 75,0)119713 "RTN","C0CRXNRD",90,0) 119604 119714 READNDC(PATH) ; Open and read NDC/RxNorm/VANDF relationship file: RXNSAT.RRF 119605 "RTN","C0CRXNRD", 76,0)119715 "RTN","C0CRXNRD",91,0) 119606 119716 I PATH="" QUIT 119607 "RTN","C0CRXNRD", 77,0)119717 "RTN","C0CRXNRD",92,0) 119608 119718 N FILENAME S FILENAME="RXNSAT.RRF" 119609 "RTN","C0CRXNRD", 78,0)119719 "RTN","C0CRXNRD",93,0) 119610 119720 D DELFILED(176.002) ; delete data 119611 "RTN","C0CRXNRD", 79,0)119721 "RTN","C0CRXNRD",94,0) 119612 119722 N LINES S LINES=$$GETLINES(PATH,FILENAME) 119613 "RTN","C0CRXNRD", 80,0)119723 "RTN","C0CRXNRD",95,0) 119614 119724 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 119615 "RTN","C0CRXNRD", 81,0)119725 "RTN","C0CRXNRD",96,0) 119616 119726 IF POP W "Error reading file..., Please check...",! G EX2 119617 "RTN","C0CRXNRD", 82,0)119727 "RTN","C0CRXNRD",97,0) 119618 119728 F C0CCOUNT=1:1 Q:$$STATUS^%ZISH D 119619 "RTN","C0CRXNRD", 83,0)119729 "RTN","C0CRXNRD",98,0) 119620 119730 . U IO 119621 "RTN","C0CRXNRD", 84,0)119622 . N LINE R LINE 119623 "RTN","C0CRXNRD", 85,0)119731 "RTN","C0CRXNRD",99,0) 119732 . N LINE R LINE:0 119733 "RTN","C0CRXNRD",100,0) 119624 119734 . IF $$STATUS^%ZISH QUIT 119625 "RTN","C0CRXNRD", 86,0)119735 "RTN","C0CRXNRD",101,0) 119626 119736 . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000 119627 "RTN","C0CRXNRD", 87,0)119737 "RTN","C0CRXNRD",102,0) 119628 119738 . IF LINE'["NDC|RXNORM" QUIT 119629 "RTN","C0CRXNRD", 88,0)119739 "RTN","C0CRXNRD",103,0) 119630 119740 . ; Otherwise, we are good to go 119631 "RTN","C0CRXNRD", 89,0)119741 "RTN","C0CRXNRD",104,0) 119632 119742 . N RXCUI,NDC ; Fileman fields below 119633 "RTN","C0CRXNRD", 90,0)119743 "RTN","C0CRXNRD",105,0) 119634 119744 . S RXCUI=$P(LINE,"|",1) ; .01 119635 "RTN","C0CRXNRD", 91,0)119745 "RTN","C0CRXNRD",106,0) 119636 119746 . S NDC=$P(LINE,"|",11) ; 2 119637 "RTN","C0CRXNRD", 92,0)119747 "RTN","C0CRXNRD",107,0) 119638 119748 . ; Using classic call to update. 119639 "RTN","C0CRXNRD", 93,0)119749 "RTN","C0CRXNRD",108,0) 119640 119750 . N DIC,X,DA,DR 119641 "RTN","C0CRXNRD", 94,0)119751 "RTN","C0CRXNRD",109,0) 119642 119752 . K DO 119643 "RTN","C0CRXNRD", 95,0)119753 "RTN","C0CRXNRD",110,0) 119644 119754 . S DIC="^C0CRXN(176.002,",DIC(0)="F",X=RXCUI,DIC("DR")="2////"_NDC 119645 "RTN","C0CRXNRD", 96,0)119755 "RTN","C0CRXNRD",111,0) 119646 119756 . D FILE^DICN 119647 "RTN","C0CRXNRD", 97,0)119757 "RTN","C0CRXNRD",112,0) 119648 119758 . I Y<1 U $P W !,"THERE IS TROUBLE IN RIVER CITY",! G EX2 119649 "RTN","C0CRXNRD", 98,0)119759 "RTN","C0CRXNRD",113,0) 119650 119760 EX2 D CLOSE^%ZISH("FILE") 119651 "RTN","C0CRXNRD", 99,0)119761 "RTN","C0CRXNRD",114,0) 119652 119762 QUIT 119653 "RTN","C0CRXNRD",1 00,0)119763 "RTN","C0CRXNRD",115,0) 119654 119764 READSRC(PATH) ; Open the read RxNorm Sources file: RXNSAB.RRF 119655 "RTN","C0CRXNRD",1 01,0)119765 "RTN","C0CRXNRD",116,0) 119656 119766 I PATH="" QUIT 119657 "RTN","C0CRXNRD",1 02,0)119767 "RTN","C0CRXNRD",117,0) 119658 119768 N FILENAME S FILENAME="RXNSAB.RRF" 119659 "RTN","C0CRXNRD",1 03,0)119769 "RTN","C0CRXNRD",118,0) 119660 119770 D DELFILED(176.003) ; delete data 119661 "RTN","C0CRXNRD",1 04,0)119771 "RTN","C0CRXNRD",119,0) 119662 119772 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 119663 "RTN","C0CRXNRD",1 05,0)119773 "RTN","C0CRXNRD",120,0) 119664 119774 IF POP W "Error reading file..., Please check...",! G EX3 119665 "RTN","C0CRXNRD",1 06,0)119775 "RTN","C0CRXNRD",121,0) 119666 119776 F I=1:1 Q:$$STATUS^%ZISH D 119667 "RTN","C0CRXNRD",1 07,0)119777 "RTN","C0CRXNRD",122,0) 119668 119778 . U IO 119669 "RTN","C0CRXNRD",1 08,0)119670 . N LINE R LINE 119671 "RTN","C0CRXNRD",1 09,0)119779 "RTN","C0CRXNRD",123,0) 119780 . N LINE R LINE:0 119781 "RTN","C0CRXNRD",124,0) 119672 119782 . IF $$STATUS^%ZISH QUIT 119673 "RTN","C0CRXNRD",1 10,0)119783 "RTN","C0CRXNRD",125,0) 119674 119784 . U $P W I,! U IO ; Write I to the screen, then go back to reading the file 119675 "RTN","C0CRXNRD",1 11,0)119785 "RTN","C0CRXNRD",126,0) 119676 119786 . N VCUI,RCUI,VSAB,RSAB,SON,SF,SVER,SRL,SCIT ; Fileman fields numbers below 119677 "RTN","C0CRXNRD",1 12,0)119787 "RTN","C0CRXNRD",127,0) 119678 119788 . S VCUI=$P(LINE,"|",1) ; .01 119679 "RTN","C0CRXNRD",1 13,0)119789 "RTN","C0CRXNRD",128,0) 119680 119790 . S RCUI=$P(LINE,"|",2) ; 2 119681 "RTN","C0CRXNRD",1 14,0)119791 "RTN","C0CRXNRD",129,0) 119682 119792 . S VSAB=$P(LINE,"|",3) ; 3 119683 "RTN","C0CRXNRD",1 15,0)119793 "RTN","C0CRXNRD",130,0) 119684 119794 . S RSAB=$P(LINE,"|",4) ; 4 119685 "RTN","C0CRXNRD",1 16,0)119795 "RTN","C0CRXNRD",131,0) 119686 119796 . S SON=$P(LINE,"|",5) ; 5 119687 "RTN","C0CRXNRD",1 17,0)119797 "RTN","C0CRXNRD",132,0) 119688 119798 . S SF=$P(LINE,"|",6) ; 6 119689 "RTN","C0CRXNRD",1 18,0)119799 "RTN","C0CRXNRD",133,0) 119690 119800 . S SVER=$P(LINE,"|",7) ; 7 119691 "RTN","C0CRXNRD",1 19,0)119801 "RTN","C0CRXNRD",134,0) 119692 119802 . S SRL=$P(LINE,"|",14) ; 14 119693 "RTN","C0CRXNRD",1 20,0)119803 "RTN","C0CRXNRD",135,0) 119694 119804 . S SCIT=$P(LINE,"|",25) ; 25 119695 "RTN","C0CRXNRD",1 21,0)119805 "RTN","C0CRXNRD",136,0) 119696 119806 . ; Remove embedded "^" 119697 "RTN","C0CRXNRD",1 22,0)119807 "RTN","C0CRXNRD",137,0) 119698 119808 . S SCIT=$TR(SCIT,"^") 119699 "RTN","C0CRXNRD",1 23,0)119809 "RTN","C0CRXNRD",138,0) 119700 119810 . ; Convert SCIT into an array of 80 characters on each line 119701 "RTN","C0CRXNRD",1 24,0)119811 "RTN","C0CRXNRD",139,0) 119702 119812 . ; In each line, chop 80 characters off, reset SCIT to be the rest 119703 "RTN","C0CRXNRD",1 25,0)119813 "RTN","C0CRXNRD",140,0) 119704 119814 . N SCITLINE S SCITLINE=$L(SCIT)\80+1 119705 "RTN","C0CRXNRD",1 26,0)119815 "RTN","C0CRXNRD",141,0) 119706 119816 . F J=1:1:SCITLINE S SCIT(J)=$E(SCIT,1,80) S SCIT=$E(SCIT,81,$L(SCIT)) 119707 "RTN","C0CRXNRD",1 27,0)119817 "RTN","C0CRXNRD",142,0) 119708 119818 . ; Now, construct the FDA array 119709 "RTN","C0CRXNRD",1 28,0)119819 "RTN","C0CRXNRD",143,0) 119710 119820 . N RXNFDA 119711 "RTN","C0CRXNRD",1 29,0)119821 "RTN","C0CRXNRD",144,0) 119712 119822 . S RXNFDA(176.003,"+"_I_",",.01)=VCUI 119713 "RTN","C0CRXNRD",1 30,0)119823 "RTN","C0CRXNRD",145,0) 119714 119824 . S RXNFDA(176.003,"+"_I_",",2)=RCUI 119715 "RTN","C0CRXNRD",1 31,0)119825 "RTN","C0CRXNRD",146,0) 119716 119826 . S RXNFDA(176.003,"+"_I_",",3)=VSAB 119717 "RTN","C0CRXNRD",1 32,0)119827 "RTN","C0CRXNRD",147,0) 119718 119828 . S RXNFDA(176.003,"+"_I_",",4)=RSAB 119719 "RTN","C0CRXNRD",1 33,0)119829 "RTN","C0CRXNRD",148,0) 119720 119830 . S RXNFDA(176.003,"+"_I_",",5)=SON 119721 "RTN","C0CRXNRD",1 34,0)119831 "RTN","C0CRXNRD",149,0) 119722 119832 . S RXNFDA(176.003,"+"_I_",",6)=SF 119723 "RTN","C0CRXNRD",1 35,0)119833 "RTN","C0CRXNRD",150,0) 119724 119834 . S RXNFDA(176.003,"+"_I_",",7)=SVER 119725 "RTN","C0CRXNRD",1 36,0)119835 "RTN","C0CRXNRD",151,0) 119726 119836 . S RXNFDA(176.003,"+"_I_",",14)=SRL 119727 "RTN","C0CRXNRD",1 37,0)119837 "RTN","C0CRXNRD",152,0) 119728 119838 . D UPDATE^DIE("","RXNFDA") 119729 "RTN","C0CRXNRD",1 38,0)119839 "RTN","C0CRXNRD",153,0) 119730 119840 . I $D(^TMP("DIERR",$J)) U $P W "ERR" G EX 119731 "RTN","C0CRXNRD",1 39,0)119841 "RTN","C0CRXNRD",154,0) 119732 119842 . ; Now, file WP field SCIT 119733 "RTN","C0CRXNRD",1 40,0)119843 "RTN","C0CRXNRD",155,0) 119734 119844 . D WP^DIE(176.003,I_",",25,,$NA(SCIT)) 119735 "RTN","C0CRXNRD",1 41,0)119845 "RTN","C0CRXNRD",156,0) 119736 119846 EX3 D CLOSE^%ZISH("FILE") 119737 "RTN","C0CRXNRD",1 42,0)119847 "RTN","C0CRXNRD",157,0) 119738 119848 Q 119739 "RTN","C0CRXNRD",143,0)119740 119741 119849 "RTN","C0CSNOA") 119742 0^98^B 56032588119850 0^98^B40683034 119743 119851 "RTN","C0CSNOA",1,0) 119744 119852 C0CSNOA ; CCDCCR/GPL - SNOMED CT ANALYSIS ROUTINES; 10/14/08 119745 119853 "RTN","C0CSNOA",2,0) 119746 ;;1.2;C 0C;;May 11, 2012;Build 50119854 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 119747 119855 "RTN","C0CSNOA",3,0) 119748 119856 ;Copyright 2008,2009 George Lilly, University of Minnesota. 119749 119857 "RTN","C0CSNOA",4,0) 119750 ; Licensed under the terms of the GNU General Public License.119858 ; 119751 119859 "RTN","C0CSNOA",5,0) 119752 ; See attached copy of the License.119860 ; This program is free software: you can redistribute it and/or modify 119753 119861 "RTN","C0CSNOA",6,0) 119754 ; 119862 ; it under the terms of the GNU Affero General Public License as 119755 119863 "RTN","C0CSNOA",7,0) 119756 ; This program is free software; you can redistribute it and/or modify119864 ; published by the Free Software Foundation, either version 3 of the 119757 119865 "RTN","C0CSNOA",8,0) 119758 ; it under the terms of the GNU General Public License as published by119866 ; License, or (at your option) any later version. 119759 119867 "RTN","C0CSNOA",9,0) 119760 ; the Free Software Foundation; either version 2 of the License, or119868 ; 119761 119869 "RTN","C0CSNOA",10,0) 119762 ; (at your option) any later version.119870 ; This program is distributed in the hope that it will be useful, 119763 119871 "RTN","C0CSNOA",11,0) 119764 ; 119872 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 119765 119873 "RTN","C0CSNOA",12,0) 119766 ; This program is distributed in the hope that it will be useful,119874 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 119767 119875 "RTN","C0CSNOA",13,0) 119768 ; but WITHOUT ANY WARRANTY; without even the implied warranty of119876 ; GNU Affero General Public License for more details. 119769 119877 "RTN","C0CSNOA",14,0) 119770 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the119878 ; 119771 119879 "RTN","C0CSNOA",15,0) 119772 ; GNU General Public License for more details.119880 ; You should have received a copy of the GNU Affero General Public License 119773 119881 "RTN","C0CSNOA",16,0) 119774 ; 119882 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 119775 119883 "RTN","C0CSNOA",17,0) 119776 ; You should have received a copy of the GNU General Public License along119884 ; 119777 119885 "RTN","C0CSNOA",18,0) 119778 ;with this program; if not, write to the Free Software Foundation, Inc., 119886 ANALYZE(BEGIEN,IENCNT) ; SNOMED RETRIEVAL ANALYSIS ROUTINE 119779 119887 "RTN","C0CSNOA",19,0) 119780 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.119888 ; BEGINS AT BEGIEN AND GOES FOR IENCNT DRUGS IN GMRD 119781 119889 "RTN","C0CSNOA",20,0) 119782 ; 119890 ; TO RESUME AT NEXT DRUG, USE BEGIEN="" 119783 119891 "RTN","C0CSNOA",21,0) 119784 ; THESE ROUTINES ANALYZE THE POTENTIAL RETRIEVAL OF SNOMED CT CODES119892 ; USE RESET^C0CSNOA TO RESET TO TOP OF DRUG LIST 119785 119893 "RTN","C0CSNOA",22,0) 119786 ; FOR PATIENT DRUG ALLERGIES FOR INCLUSION IN THE CCR OR CCD119894 ; 119787 119895 "RTN","C0CSNOA",23,0) 119788 ; USING THE VISTA LEXICON ^LEX119896 N SNOARY,SNOTMP,SNOI,SNOIEN,RATTR 119789 119897 "RTN","C0CSNOA",24,0) 119790 ;119898 N CCRGLO 119791 119899 "RTN","C0CSNOA",25,0) 119792 ANALYZE(BEGIEN,IENCNT) ; SNOMED RETRIEVAL ANALYSIS ROUTINE 119900 D ASETUP ; SET UP VARIABLES AND GLOBALS 119793 119901 "RTN","C0CSNOA",26,0) 119794 ; BEGINS AT BEGIEN AND GOES FOR IENCNT DRUGS IN GMRD119902 D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE 119795 119903 "RTN","C0CSNOA",27,0) 119796 ; TO RESUME AT NEXT DRUG, USE BEGIEN=""119904 I '$D(@SNOBASE@("RESUME")) S @SNOBASE@("RESUME")=$O(@GMRBASE@(1)) ;1ST TME 119797 119905 "RTN","C0CSNOA",28,0) 119798 ; USE RESET^C0CSNOA TO RESET TO TOP OF DRUG LIST119906 S RESUME=@SNOBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN 119799 119907 "RTN","C0CSNOA",29,0) 119800 ;119908 S SNOIEN=BEGIEN ; BEGIN WITH THE BEGIEN RECORD 119801 119909 "RTN","C0CSNOA",30,0) 119802 N SNOARY,SNOTMP,SNOI,SNOIEN,RATTR119910 I SNOIEN="" S SNOIEN=RESUME 119803 119911 "RTN","C0CSNOA",31,0) 119804 N CCRGLO119912 I +SNOIEN=0 D Q ; AT THE END OF THE ALLERGY LIST 119805 119913 "RTN","C0CSNOA",32,0) 119806 D ASETUP ; SET UP VARIABLES AND GLOBALS119914 . W "END OF DRUG LIST, CALL RESET^C0CSNOA",! 119807 119915 "RTN","C0CSNOA",33,0) 119808 D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE119916 F SNOI=1:1:IENCNT D Q:+SNOIEN=0 ; FOR IENCNT NUMBER OF PATIENTS OR END 119809 119917 "RTN","C0CSNOA",34,0) 119810 I '$D(@SNOBASE@("RESUME")) S @SNOBASE@("RESUME")=$O(@GMRBASE@(1)) ;1ST TME119918 . ;D CCRRPC^C0CCCR(.CCRGLO,SNOIEN,"CCR","","","") ;PROCESS THE CCR 119811 119919 "RTN","C0CSNOA",35,0) 119812 S RESUME=@SNOBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN119920 . W SNOIEN,@GMRBASE@(SNOIEN,0),! 119813 119921 "RTN","C0CSNOA",36,0) 119814 S SNOIEN=BEGIEN ; BEGIN WITH THE BEGIEN RECORD119922 . N SNORTN,TTERM ; RETURN ARRAY 119815 119923 "RTN","C0CSNOA",37,0) 119816 I SNOIEN="" S SNOIEN=RESUME119924 . S TTERM=$P(@GMRBASE@(SNOIEN,0),"^",1)_" ALLERGY" 119817 119925 "RTN","C0CSNOA",38,0) 119818 I +SNOIEN=0 D Q ; AT THE END OF THE ALLERGY LIST119926 . D TEXTRPC(.SNORTN,TTERM) 119819 119927 "RTN","C0CSNOA",39,0) 119820 . W "END OF DRUG LIST, CALL RESET^C0CSNOA",!119928 . ; I $D(SNORTN) ZWR SNORTN 119821 119929 "RTN","C0CSNOA",40,0) 119822 F SNOI=1:1:IENCNT D Q:+SNOIEN=0 ; FOR IENCNT NUMBER OF PATIENTS OR END119930 . K @SNOBASE@("VARS",SNOIEN) ; CLEAR OUT OLD VARS 119823 119931 "RTN","C0CSNOA",41,0) 119824 . ;D CCRRPC^C0CCCR(.CCRGLO,SNOIEN,"CCR","","","") ;PROCESS THE CCR119932 . I $P(TTMP,"^",1)=1 S @SNOBASE@("VARS",SNOIEN)=TTERM_"^"_TTMP_"^"_SNORTN(0) 119825 119933 "RTN","C0CSNOA",42,0) 119826 . W SNOIEN,@GMRBASE@(SNOIEN,0),!119934 . ; 119827 119935 "RTN","C0CSNOA",43,0) 119828 . N SNORTN,TTERM ; RETURN ARRAY119936 . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP 119829 119937 "RTN","C0CSNOA",44,0) 119830 . S TTERM=$P(@GMRBASE@(SNOIEN,0),"^",1)_" ALLERGY"119938 . ; 119831 119939 "RTN","C0CSNOA",45,0) 119832 . D TEXTRPC(.SNORTN,TTERM)119940 . S RATTR=$$SETATTR(SNOIEN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS 119833 119941 "RTN","C0CSNOA",46,0) 119834 . I $D(SNORTN) ZWR SNORTN119942 . S @SNOBASE@("ATTR",SNOIEN)=RATTR ; SAVE THE ATRIBUTES FOR THIS DRUG 119835 119943 "RTN","C0CSNOA",47,0) 119836 . K @SNOBASE@("VARS",SNOIEN) ; CLEAR OUT OLD VARS119944 . ; 119837 119945 "RTN","C0CSNOA",48,0) 119838 . I $P(TTMP,"^",1)=1 S @SNOBASE@("VARS",SNOIEN)=TTERM_"^"_TTMP_"^"_SNORTN(0)119946 . N CATNAME,CATTBL 119839 119947 "RTN","C0CSNOA",49,0) 119840 . ;119948 . S CATNAME="" 119841 119949 "RTN","C0CSNOA",50,0) 119842 . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP119950 . D CPUSH(.CATNAME,SNOBASE,"SNOTBL",SNOIEN,RATTR) ; ADD TO CATEGORY 119843 119951 "RTN","C0CSNOA",51,0) 119844 . ;119952 . ; W "CATEGORY NAME: ",CATNAME,! 119845 119953 "RTN","C0CSNOA",52,0) 119846 . S RATTR=$$SETATTR(SNOIEN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS119954 . ; 119847 119955 "RTN","C0CSNOA",53,0) 119848 . S @SNOBASE@("ATTR",SNOIEN)=RATTR ; SAVE THE ATRIBUTES FOR THIS DRUG119956 . S SNOIEN=$O(@GMRBASE@(SNOIEN)) ; NEXT RECORD 119849 119957 "RTN","C0CSNOA",54,0) 119850 . ;119958 . S @SNOBASE@("RESUME")=SNOIEN ; WHERE WE ARE LEAVING OFF THIS RUN 119851 119959 "RTN","C0CSNOA",55,0) 119852 . N CATNAME,CATTBL119960 ; D PARY^C0CXPATH(@SNOBASE@("ATTRTBL")) 119853 119961 "RTN","C0CSNOA",56,0) 119854 . S CATNAME=""119962 Q 119855 119963 "RTN","C0CSNOA",57,0) 119856 . D CPUSH(.CATNAME,SNOBASE,"SNOTBL",SNOIEN,RATTR) ; ADD TO CATEGORY119964 ; 119857 119965 "RTN","C0CSNOA",58,0) 119858 . ; W "CATEGORY NAME: ",CATNAME,! 119966 TEXTRPC(ORTN,ITEXT) ; CALL THE LEXICON WITH ITEXT AND RETURN RESULTS IN ORTN 119859 119967 "RTN","C0CSNOA",59,0) 119860 .;119968 ; 119861 119969 "RTN","C0CSNOA",60,0) 119862 . S SNOIEN=$O(@GMRBASE@(SNOIEN)) ; NEXT RECORD119970 ;N TTMP 119863 119971 "RTN","C0CSNOA",61,0) 119864 . S @SNOBASE@("RESUME")=SNOIEN ; WHERE WE ARE LEAVING OFF THIS RUN119972 W ITEXT,! 119865 119973 "RTN","C0CSNOA",62,0) 119866 ; D PARY^C0CXPATH(@SNOBASE@("ATTRTBL"))119974 S TTMP=$$TEXT^LEXTRAN(ITEXT,"","","SCT","ORTN") 119867 119975 "RTN","C0CSNOA",63,0) 119868 119976 Q 119869 119977 "RTN","C0CSNOA",64,0) 119870 119978 ; 119871 119979 "RTN","C0CSNOA",65,0) 119872 TEXTRPC(ORTN,ITEXT) ; CALL THE LEXICON WITH ITEXT AND RETURN RESULTS IN ORTN 119980 ASETUP ; SET UP GLOBALS AND VARS SNOBASE AND SNOTBL 119873 119981 "RTN","C0CSNOA",66,0) 119874 ;119982 I '$D(SNOBASE) S SNOBASE=$NA(^TMP("C0CSNO")) 119875 119983 "RTN","C0CSNOA",67,0) 119876 ;N TTMP119984 I '$D(@SNOBASE) S @SNOBASE="" 119877 119985 "RTN","C0CSNOA",68,0) 119878 W ITEXT,!119986 I '$D(GMRBASE) S GMRBASE=$NA(^GMRD(120.82)) 119879 119987 "RTN","C0CSNOA",69,0) 119880 S TTMP=$$TEXT^LEXTRAN(ITEXT,"","","SCT","ORTN")119988 I '$D(SNOTBL) S SNOTBL=$NA(^TMP("C0CSNO","SNOTBL","TABLE")) ; ATTR TABLE 119881 119989 "RTN","C0CSNOA",70,0) 119990 S ^TMP("C0CSNO","TABLES","SNOTBL")=SNOTBL ; TABLE OF TABLES 119991 "RTN","C0CSNOA",71,0) 119882 119992 Q 119883 "RTN","C0CSNOA",71,0)119884 ;119885 119993 "RTN","C0CSNOA",72,0) 119886 ASETUP ; SET UP GLOBALS AND VARS SNOBASE AND SNOTBL 119994 ; 119887 119995 "RTN","C0CSNOA",73,0) 119888 I '$D(SNOBASE) S SNOBASE=$NA(^TMP("C0CSNO")) 119996 AINIT ; INITIALIZE ATTRIBUTE TABLE 119889 119997 "RTN","C0CSNOA",74,0) 119890 I '$D(@SNOBASE) S @SNOBASE=""119998 I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS 119891 119999 "RTN","C0CSNOA",75,0) 119892 I '$D(GMRBASE) S GMRBASE=$NA(^GMRD(120.82))120000 K @SNOTBL 119893 120001 "RTN","C0CSNOA",76,0) 119894 I '$D(SNOTBL) S SNOTBL=$NA(^TMP("C0CSNO","SNOTBL","TABLE")) ; ATTR TABLE120002 D APUSH^C0CRIMA(SNOTBL,"CODE") 119895 120003 "RTN","C0CSNOA",77,0) 119896 S ^TMP("C0CSNO","TABLES","SNOTBL")=SNOTBL ; TABLE OF TABLES120004 D APUSH^C0CRIMA(SNOTBL,"NOCODE") 119897 120005 "RTN","C0CSNOA",78,0) 119898 Q120006 D APUSH^C0CRIMA(SNOTBL,"MULTICODE") 119899 120007 "RTN","C0CSNOA",79,0) 119900 ;120008 D APUSH^C0CRIMA(SNOTBL,"SUBMULTI") 119901 120009 "RTN","C0CSNOA",80,0) 119902 AINIT ; INITIALIZE ATTRIBUTE TABLE 120010 D APUSH^C0CRIMA(SNOTBL,"DONE") 119903 120011 "RTN","C0CSNOA",81,0) 119904 I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS120012 Q 119905 120013 "RTN","C0CSNOA",82,0) 119906 K @SNOTBL120014 APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL 119907 120015 "RTN","C0CSNOA",83,0) 119908 D APUSH^C0CRIMA(SNOTBL,"CODE")120016 ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING 119909 120017 "RTN","C0CSNOA",84,0) 119910 D APUSH^C0CRIMA(SNOTBL,"NOCODE")120018 ; PTBL IS THE NAME OF A TABLE IN @SNOBASE@("TABLES") - "SNOTBL"=ALL VALUES 119911 120019 "RTN","C0CSNOA",85,0) 119912 D APUSH^C0CRIMA(SNOTBL,"MULTICODE")120020 ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL)) 119913 120021 "RTN","C0CSNOA",86,0) 119914 D APUSH^C0CRIMA(SNOTBL,"SUBMULTI")120022 I '$D(SNOBASE) D ASETUP ; FOR COMMANDLINE PROCESSING 119915 120023 "RTN","C0CSNOA",87,0) 119916 D APUSH^C0CRIMA(SNOTBL,"DONE")120024 N USETBL 119917 120025 "RTN","C0CSNOA",88,0) 119918 Q120026 I '$D(@SNOBASE@("TABLES",PTBL)) D Q ; NO TABLE 119919 120027 "RTN","C0CSNOA",89,0) 119920 APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL 120028 . W "ERROR NO SUCH TABLE",! 119921 120029 "RTN","C0CSNOA",90,0) 119922 ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING120030 S USETBL=@SNOBASE@("TABLES",PTBL) 119923 120031 "RTN","C0CSNOA",91,0) 119924 ; PTBL IS THE NAME OF A TABLE IN @SNOBASE@("TABLES") - "SNOTBL"=ALL VALUES120032 S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL 119925 120033 "RTN","C0CSNOA",92,0) 119926 ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))120034 Q 119927 120035 "RTN","C0CSNOA",93,0) 119928 I '$D(SNOBASE) D ASETUP ; FOR COMMANDLINE PROCESSING 120036 SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS 119929 120037 "RTN","C0CSNOA",94,0) 119930 N USETBL120038 N SBASE,SATTR 119931 120039 "RTN","C0CSNOA",95,0) 119932 I '$D(@SNOBASE@("TABLES",PTBL)) D Q ; NO TABLE120040 S SBASE=$NA(@SNOBASE@("VARS",SDFN)) 119933 120041 "RTN","C0CSNOA",96,0) 119934 . W "ERROR NO SUCH TABLE",!120042 D APOST("SATTR","SNOTBL","DONE") 119935 120043 "RTN","C0CSNOA",97,0) 119936 S USETBL=@SNOBASE@("TABLES",PTBL)120044 I $P(TTMP,"^",1)=1 D APOST("SATTR","SNOTBL","CODE") 119937 120045 "RTN","C0CSNOA",98,0) 119938 S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL120046 I $P(TTMP,"^",1)=-1 D APOST("SATTR","SNOTBL","NOCODE") 119939 120047 "RTN","C0CSNOA",99,0) 119940 Q120048 Q SATTR ; C0C 119941 120049 "RTN","C0CSNOA",100,0) 119942 SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS 120050 I $D(@SBASE@("PROBLEMS",1)) D ; 119943 120051 "RTN","C0CSNOA",101,0) 119944 N SBASE,SATTR120052 . D APOST("SATTR","SNOTBL","PROBLEMS") 119945 120053 "RTN","C0CSNOA",102,0) 119946 S SBASE=$NA(@SNOBASE@("VARS",SDFN))120054 . ; W "POSTING PROBLEMS",! 119947 120055 "RTN","C0CSNOA",103,0) 119948 D APOST("SATTR","SNOTBL","DONE")120056 I $D(@SBASE@("VITALS",1)) D APOST("SATTR","SNOTBL","VITALS") 119949 120057 "RTN","C0CSNOA",104,0) 119950 I $P(TTMP,"^",1)=1 D APOST("SATTR","SNOTBL","CODE")120058 I $D(@SBASE@("MEDS",1)) D ; IF THE PATIENT HAS MEDS VARIABLES 119951 120059 "RTN","C0CSNOA",105,0) 119952 I $P(TTMP,"^",1)=-1 D APOST("SATTR","SNOTBL","NOCODE")120060 . D APOST("SATTR","SNOTBL","MEDS") 119953 120061 "RTN","C0CSNOA",106,0) 119954 Q SATTR ; C0C120062 . N ZR,ZI 119955 120063 "RTN","C0CSNOA",107,0) 119956 I $D(@SBASE@("PROBLEMS",1)) D ;120064 . D GETPA^C0CRIMA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES 119957 120065 "RTN","C0CSNOA",108,0) 119958 . D APOST("SATTR","SNOTBL","PROBLEMS")120066 . I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN 119959 120067 "RTN","C0CSNOA",109,0) 119960 . ; W "POSTING PROBLEMS",!120068 . . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS 119961 120069 "RTN","C0CSNOA",110,0) 119962 I $D(@SBASE@("VITALS",1)) D APOST("SATTR","SNOTBL","VITALS")120070 . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","SNOTBL","MEDSCODE") ;CODES 119963 120071 "RTN","C0CSNOA",111,0) 119964 I $D(@SBASE@("MEDS",1)) D ; IF THE PATIENT HAS MEDS VARIABLES120072 . ; D PATD^C0CSNOA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES 119965 120073 "RTN","C0CSNOA",112,0) 119966 . D APOST("SATTR","SNOTBL","MEDS")120074 D APOST("SATTR","SNOTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED 119967 120075 "RTN","C0CSNOA",113,0) 119968 . N ZR,ZI120076 ; W "ATTRIBUTES: ",SATTR,! 119969 120077 "RTN","C0CSNOA",114,0) 119970 . D GETPA^C0CRIMA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES120078 Q SATTR 119971 120079 "RTN","C0CSNOA",115,0) 119972 . I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN120080 ; 119973 120081 "RTN","C0CSNOA",116,0) 119974 . . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS120082 RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL SNO TMP VALUES 119975 120083 "RTN","C0CSNOA",117,0) 119976 . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","SNOTBL","MEDSCODE") ;CODES120084 K ^TMP("C0CSNO","RESUME") 119977 120085 "RTN","C0CSNOA",118,0) 119978 . ; D PATD^C0CSNOA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES120086 K ^TMP("C0CSNO") 119979 120087 "RTN","C0CSNOA",119,0) 119980 D APOST("SATTR","SNOTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED120088 Q 119981 120089 "RTN","C0CSNOA",120,0) 119982 ; W "ATTRIBUTES: ",SATTR,!120090 ; 119983 120091 "RTN","C0CSNOA",121,0) 119984 Q SATTR 120092 CLIST ; LIST THE CATEGORIES 119985 120093 "RTN","C0CSNOA",122,0) 119986 120094 ; 119987 120095 "RTN","C0CSNOA",123,0) 119988 RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL SNO TMP VALUES120096 I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS 119989 120097 "RTN","C0CSNOA",124,0) 119990 K ^TMP("C0CSNO","RESUME")120098 N CLBASE,CLNUM,ZI,CLIDX 119991 120099 "RTN","C0CSNOA",125,0) 119992 K ^TMP("C0CSNO")120100 S CLBASE=$NA(@SNOBASE@("SNOTBL","CATS")) 119993 120101 "RTN","C0CSNOA",126,0) 119994 Q120102 S CLNUM=@CLBASE@(0) 119995 120103 "RTN","C0CSNOA",127,0) 119996 ;120104 F ZI=1:1:CLNUM D ; LOOP THROUGH THE CATEGORIES 119997 120105 "RTN","C0CSNOA",128,0) 119998 CLIST ; LIST THE CATEGORIES 120106 . S CLIDX=@CLBASE@(ZI) 119999 120107 "RTN","C0CSNOA",129,0) 120000 ;120108 . W "(",$P(@CLBASE@(CLIDX),"^",1) 120001 120109 "RTN","C0CSNOA",130,0) 120002 I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS120110 . W ":",$P(@CLBASE@(CLIDX),"^",2),") " 120003 120111 "RTN","C0CSNOA",131,0) 120004 N CLBASE,CLNUM,ZI,CLIDX120112 . W CLIDX,! 120005 120113 "RTN","C0CSNOA",132,0) 120006 S CLBASE=$NA(@SNOBASE@("SNOTBL","CATS"))120114 ; D PARY^C0CXPATH(CLBASE) 120007 120115 "RTN","C0CSNOA",133,0) 120008 S CLNUM=@CLBASE@(0)120116 Q 120009 120117 "RTN","C0CSNOA",134,0) 120010 F ZI=1:1:CLNUM D ; LOOP THROUGH THE CATEGORIES120118 ; 120011 120119 "RTN","C0CSNOA",135,0) 120012 . S CLIDX=@CLBASE@(ZI) 120120 CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES 120013 120121 "RTN","C0CSNOA",136,0) 120014 . W "(",$P(@CLBASE@(CLIDX),"^",1)120122 ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT 120015 120123 "RTN","C0CSNOA",137,0) 120016 . W ":",$P(@CLBASE@(CLIDX),"^",2),") "120124 ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE 120017 120125 "RTN","C0CSNOA",138,0) 120018 . W CLIDX,!120126 ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME 120019 120127 "RTN","C0CSNOA",139,0) 120020 ; D PARY^C0CXPATH(CLBASE)120128 ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES, 120021 120129 "RTN","C0CSNOA",140,0) 120022 Q120130 ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X" 120023 120131 "RTN","C0CSNOA",141,0) 120024 ;120132 ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES 120025 120133 "RTN","C0CSNOA",142,0) 120026 CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES 120134 ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY 120027 120135 "RTN","C0CSNOA",143,0) 120028 ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT120136 ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING 120029 120137 "RTN","C0CSNOA",144,0) 120030 ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE120138 ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY 120031 120139 "RTN","C0CSNOA",145,0) 120032 ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME120140 ; NUMBER IE CTBL_X(CDFN)="" 120033 120141 "RTN","C0CSNOA",146,0) 120034 ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,120142 ; 120035 120143 "RTN","C0CSNOA",147,0) 120036 ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"120144 ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST 120037 120145 "RTN","C0CSNOA",148,0) 120038 ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES120146 S CCTBL=$NA(@CBASE@(CTBL,"CATS")) 120039 120147 "RTN","C0CSNOA",149,0) 120040 ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY120148 ; W "CBASE: ",CCTBL,! 120041 120149 "RTN","C0CSNOA",150,0) 120042 ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING120150 ; 120043 120151 "RTN","C0CSNOA",151,0) 120044 ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BYCATEGORY120152 I '$D(@CCTBL@(CATTR)) D ; FIRST PATIENT IN THIS CATEGORY 120045 120153 "RTN","C0CSNOA",152,0) 120046 ; NUMBER IE CTBL_X(CDFN)=""120154 . D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY 120047 120155 "RTN","C0CSNOA",153,0) 120048 ;120156 . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY 120049 120157 "RTN","C0CSNOA",154,0) 120050 ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST120158 . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT 120051 120159 "RTN","C0CSNOA",155,0) 120052 S CCTBL=$NA(@CBASE@(CTBL,"CATS"))120160 . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY 120053 120161 "RTN","C0CSNOA",156,0) 120054 ; W "CBASE: ",CCTBL,!120162 . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME 120055 120163 "RTN","C0CSNOA",157,0) 120056 ;120164 . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0 120057 120165 "RTN","C0CSNOA",158,0) 120058 I '$D(@CCTBL@(CATTR)) D ; FIRST PATIENT IN THIS CATEGORY120166 ; 120059 120167 "RTN","C0CSNOA",159,0) 120060 . D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY120168 S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY 120061 120169 "RTN","C0CSNOA",160,0) 120062 . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY120170 S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT 120063 120171 "RTN","C0CSNOA",161,0) 120064 . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT120172 S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK 120065 120173 "RTN","C0CSNOA",162,0) 120066 . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY120174 ; 120067 120175 "RTN","C0CSNOA",163,0) 120068 . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME120176 S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED 120069 120177 "RTN","C0CSNOA",164,0) 120070 . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0120178 ; 120071 120179 "RTN","C0CSNOA",165,0) 120072 ;120180 S CPATLIST=$NA(@CBASE@(CTBL,"IENS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT 120073 120181 "RTN","C0CSNOA",166,0) 120074 S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY120182 ; W "IENS BASE: ",CPATLIST,! 120075 120183 "RTN","C0CSNOA",167,0) 120076 S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT120184 S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST 120077 120185 "RTN","C0CSNOA",168,0) 120078 S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK120186 ; 120079 120187 "RTN","C0CSNOA",169,0) 120080 ;120188 Q 120081 120189 "RTN","C0CSNOA",170,0) 120082 S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED120190 ; 120083 120191 "RTN","C0CSNOA",171,0) 120084 ; 120192 REUSE ; GET SAVED VALUES FROM ^TMP("C0CSAV") AND PUT THEM IN A DATABASE 120085 120193 "RTN","C0CSNOA",172,0) 120086 S CPATLIST=$NA(@CBASE@(CTBL,"IENS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT120194 ; 120087 120195 "RTN","C0CSNOA",173,0) 120088 ; W "IENS BASE: ",CPATLIST,!120196 D ASETUP 120089 120197 "RTN","C0CSNOA",174,0) 120090 S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST120198 D AINIT 120091 120199 "RTN","C0CSNOA",175,0) 120092 ;120200 N SNOI,SNOJ,SNOK,SNOSNO,SNOSEC,SNOIEN,SNOOLD,SNOSRCH 120093 120201 "RTN","C0CSNOA",176,0) 120094 Q120202 S SAVBASE=$NA(^TMP("C0CSAV","VARS")) 120095 120203 "RTN","C0CSNOA",177,0) 120096 ;120204 S SNOI="" 120097 120205 "RTN","C0CSNOA",178,0) 120098 REUSE ; GET SAVED VALUES FROM ^TMP("C0CSAV") AND PUT THEM IN A DATABASE 120206 F D Q:$O(@SAVBASE@(SNOI))="" ;THE WHOLE LIST 120099 120207 "RTN","C0CSNOA",179,0) 120100 ;120208 . S SNOI=$O(@SAVBASE@(SNOI)) 120101 120209 "RTN","C0CSNOA",180,0) 120102 D ASETUP120210 . S SNOJ=@SAVBASE@(SNOI) 120103 120211 "RTN","C0CSNOA",181,0) 120104 D AINIT120212 . S SNOK=$P($P(SNOJ,"^",1)," ALLERGY",1) 120105 120213 "RTN","C0CSNOA",182,0) 120106 N SNOI,SNOJ,SNOK,SNOSNO,SNOSEC,SNOIEN,SNOOLD,SNOSRCH120214 . S SNOSRCH=$P(SNOJ,"^",1) ;SEARCH TERM USED TO OBTAIN SNOMED CODE 120107 120215 "RTN","C0CSNOA",183,0) 120108 S SAVBASE=$NA(^TMP("C0CSAV","VARS"))120216 . S SNOIEN=$P(SNOJ,"^",3) ; IEN OF ELEMENT IN LEXICON 120109 120217 "RTN","C0CSNOA",184,0) 120110 S SNOI=""120218 . S SNOSNO=$P(SNOJ,"^",4) ; SNOMED CODE 120111 120219 "RTN","C0CSNOA",185,0) 120112 F D Q:$O(@SAVBASE@(SNOI))="" ;THE WHOLE LIST120220 . S SNOSEC=$P(SNOJ,"^",5) ; SECTION OF SNOMED FOR THIS CODE 120113 120221 "RTN","C0CSNOA",186,0) 120114 . S SNO I=$O(@SAVBASE@(SNOI))120222 . S SNOOLD=$P(SNOJ,"^",7) ; OLD NUMBER FOR THIS CODE 120115 120223 "RTN","C0CSNOA",187,0) 120116 . S SNOJ=@SAVBASE@(SNOI)120224 . W "SEARCH:",SNOSRCH," IEN:",SNOIEN," CODE:",SNOSNO," SEC:",SNOSEC," OLD:",SNOOLD,! 120117 120225 "RTN","C0CSNOA",188,0) 120118 . S SNOK=$P($P(SNOJ,"^",1)," ALLERGY",1)120226 . W SNOK,! 120119 120227 "RTN","C0CSNOA",189,0) 120120 . S SNOSRCH=$P(SNOJ,"^",1) ;SEARCH TERM USED TO OBTAIN SNOMED CODE120228 . W SNOJ,! 120121 120229 "RTN","C0CSNOA",190,0) 120122 . S SNOIEN=$P(SNOJ,"^",3) ; IEN OF ELEMENT IN LEXICON120230 Q 120123 120231 "RTN","C0CSNOA",191,0) 120124 . S SNOSNO=$P(SNOJ,"^",4) ; SNOMED CODE120125 "RTN","C0CSNOA",192,0)120126 . S SNOSEC=$P(SNOJ,"^",5) ; SECTION OF SNOMED FOR THIS CODE120127 "RTN","C0CSNOA",193,0)120128 . S SNOOLD=$P(SNOJ,"^",7) ; OLD NUMBER FOR THIS CODE120129 "RTN","C0CSNOA",194,0)120130 . W "SEARCH:",SNOSRCH," IEN:",SNOIEN," CODE:",SNOSNO," SEC:",SNOSEC," OLD:",SNOOLD,!120131 "RTN","C0CSNOA",195,0)120132 . W SNOK,!120133 "RTN","C0CSNOA",196,0)120134 . W SNOJ,!120135 "RTN","C0CSNOA",197,0)120136 Q120137 "RTN","C0CSNOA",198,0)120138 120232 ; 120139 120233 "RTN","C0CSOAP") 120140 0^69^B79 899662120234 0^69^B79012960 120141 120235 "RTN","C0CSOAP",1,0) 120142 120236 C0CSOAP ; CCDCCR/GPL - SOAP WEB SERVICE utilities; 8/25/09 120143 120237 "RTN","C0CSOAP",2,0) 120144 ;;1.2;C 0C;;May 11, 2012;Build 50120238 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 120145 120239 "RTN","C0CSOAP",3,0) 120146 ;Copyright 2008 George Lilly. Licensed under the terms of the GNU120240 ;Copyright 2008 George Lilly. 120147 120241 "RTN","C0CSOAP",4,0) 120148 ; General Public License See attached copy of the License.120242 ; 120149 120243 "RTN","C0CSOAP",5,0) 120150 ; 120244 ; This program is free software: you can redistribute it and/or modify 120151 120245 "RTN","C0CSOAP",6,0) 120152 ; This program is free software; you can redistribute it and/or modify120246 ; it under the terms of the GNU Affero General Public License as 120153 120247 "RTN","C0CSOAP",7,0) 120154 ; it under the terms of the GNU General Public License as published by120248 ; published by the Free Software Foundation, either version 3 of the 120155 120249 "RTN","C0CSOAP",8,0) 120156 ; the Free Software Foundation; either version 2 of the License, or120250 ; License, or (at your option) any later version. 120157 120251 "RTN","C0CSOAP",9,0) 120158 ; (at your option) any later version.120252 ; 120159 120253 "RTN","C0CSOAP",10,0) 120160 ; 120254 ; This program is distributed in the hope that it will be useful, 120161 120255 "RTN","C0CSOAP",11,0) 120162 ; This program is distributed in the hope that it will be useful,120256 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 120163 120257 "RTN","C0CSOAP",12,0) 120164 ; but WITHOUT ANY WARRANTY; without even the implied warranty of120258 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 120165 120259 "RTN","C0CSOAP",13,0) 120166 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the120260 ; GNU Affero General Public License for more details. 120167 120261 "RTN","C0CSOAP",14,0) 120168 ; GNU General Public License for more details.120262 ; 120169 120263 "RTN","C0CSOAP",15,0) 120170 ; 120264 ; You should have received a copy of the GNU Affero General Public License 120171 120265 "RTN","C0CSOAP",16,0) 120172 ; You should have received a copy of the GNU General Public License along120266 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 120173 120267 "RTN","C0CSOAP",17,0) 120174 ; with this program; if not, write to the Free Software Foundation, Inc.,120268 ; 120175 120269 "RTN","C0CSOAP",18,0) 120176 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.120270 W "This is an SOAP utility library",! 120177 120271 "RTN","C0CSOAP",19,0) 120178 ;120272 W ! 120179 120273 "RTN","C0CSOAP",20,0) 120180 W "This is an SOAP utility library",!120274 Q 120181 120275 "RTN","C0CSOAP",21,0) 120276 ; 120277 "RTN","C0CSOAP",22,0) 120278 TEST1 120279 "RTN","C0CSOAP",23,0) 120280 S url="https://ec2-75-101-247-83.compute-1.amazonaws.com:8181/ccr/CCRService?wsdl" 120281 "RTN","C0CSOAP",24,0) 120282 D GET1URL^C0CEWD2(url) 120283 "RTN","C0CSOAP",25,0) 120284 Q 120285 "RTN","C0CSOAP",26,0) 120286 ; 120287 "RTN","C0CSOAP",27,0) 120288 INITFARY(ARY) ;initialize the Fileman Field array for SOAP processing 120289 "RTN","C0CSOAP",28,0) 120290 ; ARY is passed by name 120291 "RTN","C0CSOAP",29,0) 120292 S @ARY@("XML FILE NUMBER")="178.301" 120293 "RTN","C0CSOAP",30,0) 120294 S @ARY@("BINDING SUBFILE NUMBER")="178.3014" 120295 "RTN","C0CSOAP",31,0) 120296 S @ARY@("MIME TYPE")="2.3" 120297 "RTN","C0CSOAP",32,0) 120298 S @ARY@("PROXY SERVER")="2.4" 120299 "RTN","C0CSOAP",33,0) 120300 S @ARY@("REPLY TEMPLATE")=".03" 120301 "RTN","C0CSOAP",34,0) 120302 S @ARY@("TEMPLATE NAME")=".01" 120303 "RTN","C0CSOAP",35,0) 120304 S @ARY@("TEMPLATE XML")="3" 120305 "RTN","C0CSOAP",36,0) 120306 S @ARY@("URL")="1" 120307 "RTN","C0CSOAP",37,0) 120308 S @ARY@("WSDL URL")="2" 120309 "RTN","C0CSOAP",38,0) 120310 S @ARY@("XML")="2.1" 120311 "RTN","C0CSOAP",39,0) 120312 S @ARY@("XML HEADER")="2.2" 120313 "RTN","C0CSOAP",40,0) 120314 S @ARY@("XPATH REDUCTION STRING")="2.5" 120315 "RTN","C0CSOAP",41,0) 120316 S @ARY@("CCR VARIABLE")="4" 120317 "RTN","C0CSOAP",42,0) 120318 S @ARY@("FILEMAN FIELD NAME")="1" 120319 "RTN","C0CSOAP",43,0) 120320 S @ARY@("FILEMAN FIELD NUMBER")="1.2" 120321 "RTN","C0CSOAP",44,0) 120322 S @ARY@("FILEMAN FILE POINTER")="1.1" 120323 "RTN","C0CSOAP",45,0) 120324 S @ARY@("INDEXED BY")=".05" 120325 "RTN","C0CSOAP",46,0) 120326 S @ARY@("SQLI FIELD NAME")="3" 120327 "RTN","C0CSOAP",47,0) 120328 S @ARY@("VARIABLE NAME")="2" 120329 "RTN","C0CSOAP",48,0) 120330 Q 120331 "RTN","C0CSOAP",49,0) 120332 ; 120333 "RTN","C0CSOAP",50,0) 120334 RESTID(INNAM,INFARY) ;EXTRINSIC TO RESOLVE TEMPLATE PASSED BY NAME 120335 "RTN","C0CSOAP",51,0) 120336 ; FILE IS IDENTIFIED IN FARY, PASSED BY NAME 120337 "RTN","C0CSOAP",52,0) 120338 I '$D(INFARY) D ; NO FILE ARRAY PASSED 120339 "RTN","C0CSOAP",53,0) 120340 . S INFARY="FARY" 120341 "RTN","C0CSOAP",54,0) 120342 . D INITFARY(INFARY) 120343 "RTN","C0CSOAP",55,0) 120344 N ZN,ZREF,ZR 120345 "RTN","C0CSOAP",56,0) 120346 S ZN=@INFARY@("XML FILE NUMBER") 120347 "RTN","C0CSOAP",57,0) 120348 S ZREF=$$FILEREF^C0CRNF(ZN) 120349 "RTN","C0CSOAP",58,0) 120350 S ZR=$O(@ZREF@("B",INNAM,"")) 120351 "RTN","C0CSOAP",59,0) 120352 Q ZR 120353 "RTN","C0CSOAP",60,0) 120354 ; 120355 "RTN","C0CSOAP",61,0) 120356 TESTSOAP ; 120357 "RTN","C0CSOAP",62,0) 120358 ; USING ICD9 WEB SERVICE TO TEST SOAP 120359 "RTN","C0CSOAP",63,0) 120360 S G("CODE")="E*" 120361 "RTN","C0CSOAP",64,0) 120362 S G("CODELN")=3 120363 "RTN","C0CSOAP",65,0) 120364 D SOAP("GPL","ICD9","G") 120365 "RTN","C0CSOAP",66,0) 120366 Q 120367 "RTN","C0CSOAP",67,0) 120368 ; 120369 "RTN","C0CSOAP",68,0) 120370 SOAP(C0CRTN,C0CTID,C0CVA,C0CVOR,ALTXML,IFARY) ; MAKES A SOAP CALL FOR 120371 "RTN","C0CSOAP",69,0) 120372 ; TEMPLATE ID C0CTID 120373 "RTN","C0CSOAP",70,0) 120374 ; RETURNS THE XML RESULT IN C0CRTN, PASSED BY NAME 120375 "RTN","C0CSOAP",71,0) 120376 ; C0CVA IS PASSED BY NAME AND IS THE VARIABLE ARRAY TO PASS TO BIND 120377 "RTN","C0CSOAP",72,0) 120378 ; C0CVOR IS THE NAME OF A VARIABLE OVERRIDE ARRAY, WHICH IS APPLIED 120379 "RTN","C0CSOAP",73,0) 120380 ; BEFORE MAPPING 120381 "RTN","C0CSOAP",74,0) 120382 ; IF ALTXML IS PASSED, BIND AND MAP WILL BE SKIPPED AND 120383 "RTN","C0CSOAP",75,0) 120384 ; ALTXML WILL BE USED INSTEAD 120385 "RTN","C0CSOAP",76,0) 120386 ; 120387 "RTN","C0CSOAP",77,0) 120388 ; ARTIFACTS SECTION 120389 "RTN","C0CSOAP",78,0) 120390 ; THE FOLLOWING WILL SET UP DEBUGGING ARTIFACTS FOR A POSSIBLE FUTURE 120391 "RTN","C0CSOAP",79,0) 120392 ; ONLINE DEBUGGER. IF DEBUG=1, VARIABLES CONTAINING INTERMEDIATE RESULTS 120393 "RTN","C0CSOAP",80,0) 120394 ; WILL NOT BE NEWED. 120395 "RTN","C0CSOAP",81,0) 120396 I $G(WSDEBUG)="" N C0CV ; CATALOG OF ARTIFACT VARIABLES AND ARRAYS 120397 "RTN","C0CSOAP",82,0) 120398 S C0CV(100,"C0CXF","XML TEMPLATE FILE NUMBER")="" 120399 "RTN","C0CSOAP",83,0) 120400 S C0CV(200,"C0CHEAD","SOAP HEADER VARIABLE NAME")="" 120401 "RTN","C0CSOAP",84,0) 120402 S C0CV(300,"HEADER","SOAP HEADER")="" 120403 "RTN","C0CSOAP",85,0) 120404 S C0CV(400,"C0CMIME","MIME TYPE")="" 120405 "RTN","C0CSOAP",86,0) 120406 S C0CV(500,"C0CURL","WS URL")="" 120407 "RTN","C0CSOAP",87,0) 120408 S C0CV(550,"C0CPURL","PROXY URL")="" 120409 "RTN","C0CSOAP",88,0) 120410 S C0CV(600,"C0CXML","XML VARIABLE NAME")="" 120411 "RTN","C0CSOAP",89,0) 120412 S C0CV(700,"XML","OUTBOUND XML")="" 120413 "RTN","C0CSOAP",90,0) 120414 S C0CV(800,"C0CRSLT","RAW XML RESULT RETURNED FROM WEB SERVICE")="" 120415 "RTN","C0CSOAP",91,0) 120416 S C0CV(900,"C0CRHDR","RETURNED HEADER")="" 120417 "RTN","C0CSOAP",92,0) 120418 S C0CV(1000,"C0CRXML","XML RESULT NORMALIZED")="" 120419 "RTN","C0CSOAP",93,0) 120420 S C0CV(1100,"C0CR","REPLY TEMPLATE")="" 120421 "RTN","C0CSOAP",94,0) 120422 S C0CV(1200,"C0CREDUX","REDUX STRING")="" 120423 "RTN","C0CSOAP",95,0) 120424 S C0CV(1300,"C0CIDX","RESULT XPATH INDEX")="" 120425 "RTN","C0CSOAP",96,0) 120426 S C0CV(1400,"C0CARY","RESULT XPATH ARRAY")="" 120427 "RTN","C0CSOAP",97,0) 120428 S C0CV(1500,"C0CNOM","RESULT DOM DOCUMENT NAME")="" 120429 "RTN","C0CSOAP",98,0) 120430 S C0CV(1600,"C0CID","RESULT DOM ID")="" 120431 "RTN","C0CSOAP",99,0) 120432 I $G(DEBUG)'="" G NOTNEW ; SKIP NEWING THE VARIABLES IF IN DEBUG 120433 "RTN","C0CSOAP",100,0) 120434 N ZI,ZJ S ZI="" 120435 "RTN","C0CSOAP",101,0) 120436 NEW 120437 "RTN","C0CSOAP",102,0) 120438 S ZI=$O(C0CV(ZI)) 120439 "RTN","C0CSOAP",103,0) 120440 S ZJ=$O(C0CV(ZI,"")) ; SET UP NEW COMMAND 120441 "RTN","C0CSOAP",104,0) 120442 ;W ZJ,! 120443 "RTN","C0CSOAP",105,0) 120444 N @ZJ ; NEW THE VARIABLE 120445 "RTN","C0CSOAP",106,0) 120446 I $O(C0CV(ZI))'="" G NEW ;LOOP TO GET NEW IN CONTEXT 120447 "RTN","C0CSOAP",107,0) 120448 NOTNEW 120449 "RTN","C0CSOAP",108,0) 120450 ; END ARTIFACTS 120451 "RTN","C0CSOAP",109,0) 120452 ; 120453 "RTN","C0CSOAP",110,0) 120454 I '$D(IFARY) D INITFARY("C0CF") ; SET FILE NUMBER AND PARAMATERS 120455 "RTN","C0CSOAP",111,0) 120456 E D ; 120457 "RTN","C0CSOAP",112,0) 120458 . K C0CF 120459 "RTN","C0CSOAP",113,0) 120460 . M C0CF=@IFARY 120461 "RTN","C0CSOAP",114,0) 120462 S C0CXF=C0CF("XML FILE NUMBER") ; FILE NUMBER FOR THE XML TEMPLATE FILE 120463 "RTN","C0CSOAP",115,0) 120464 I +C0CTID=0 D ; A STRING WAS PASSED FOR THE TEMPLATE NAME 120465 "RTN","C0CSOAP",116,0) 120466 . S C0CUTID=$$RESTID(C0CTID,"C0CF") ;RESOLVE TEMPLATE IEN FROM NAME 120467 "RTN","C0CSOAP",117,0) 120468 E S C0CUTID=C0CTID ; AN IEN WAS PASSED 120469 "RTN","C0CSOAP",118,0) 120470 N XML,TEMPLATE,HEADER 120471 "RTN","C0CSOAP",119,0) 120472 N C0CFH S C0CFH=C0CF("XML HEADER") 120473 "RTN","C0CSOAP",120,0) 120474 S C0CHEAD=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFH,,"HEADER") 120475 "RTN","C0CSOAP",121,0) 120476 N C0CFM S C0CFM=C0CF("MIME TYPE") 120477 "RTN","C0CSOAP",122,0) 120478 S C0CMIME=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFM) 120479 "RTN","C0CSOAP",123,0) 120480 N C0CFP S C0CFP=C0CF("PROXY SERVER") 120481 "RTN","C0CSOAP",124,0) 120482 S C0CPURL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFP) 120483 "RTN","C0CSOAP",125,0) 120484 N C0CFU S C0CFU=C0CF("URL") 120485 "RTN","C0CSOAP",126,0) 120486 S C0CURL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFU) 120487 "RTN","C0CSOAP",127,0) 120488 N C0CFX S C0CFX=C0CF("XML") 120489 "RTN","C0CSOAP",128,0) 120490 S C0CXML=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFX,,"XML") 120491 "RTN","C0CSOAP",129,0) 120492 N C0CFT S C0CFT=C0CF("TEMPLATE XML") 120493 "RTN","C0CSOAP",130,0) 120494 S C0CTMPL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFT,,"TEMPLATE") 120495 "RTN","C0CSOAP",131,0) 120496 I C0CTMPL="TEMPLATE" D ; there is a template to process 120497 "RTN","C0CSOAP",132,0) 120498 . K XML ; going to replace the xml array 120499 "RTN","C0CSOAP",133,0) 120500 . N VARS 120501 "RTN","C0CSOAP",134,0) 120502 . I $D(C0CVOR) M @C0CVA=@C0CVOR ; merge in varible overrides 120503 "RTN","C0CSOAP",135,0) 120504 . I '$D(ALTXML) D ; if ALTXML is passed in, don't bind 120505 "RTN","C0CSOAP",136,0) 120506 . . D BIND("VARS",C0CVA,C0CUTID,"C0CF") 120507 "RTN","C0CSOAP",137,0) 120508 . . D MAP("XML","VARS",TPTR,"C0CF") 120509 "RTN","C0CSOAP",138,0) 120510 . . K XML(0) 120511 "RTN","C0CSOAP",139,0) 120512 . E M XML=@ALTXML ; use ALTXML instead 120513 "RTN","C0CSOAP",140,0) 120514 I $G(C0CPROXY) S C0CURL=C0CPURL 120515 "RTN","C0CSOAP",141,0) 120516 K C0CRSLT,C0CRHDR 120517 "RTN","C0CSOAP",142,0) 120518 B 120519 "RTN","C0CSOAP",143,0) 120520 S ok=$$httpPOST^%zewdGTM(C0CURL,.XML,C0CMIME,.C0CRSLT,.HEADER,"",.gpl5,.C0CRHDR) 120521 "RTN","C0CSOAP",144,0) 120522 K C0CRXML 120523 "RTN","C0CSOAP",145,0) 120524 D NORMAL("C0CRXML","C0CRSLT(1)") ;RETURN XML IN AN ARRAY 120525 "RTN","C0CSOAP",146,0) 120526 N C0CFR S C0CFR=$G(C0CF("REPLY TEMPLATE")) 120527 "RTN","C0CSOAP",147,0) 120528 S C0CR=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFR,"I") ; REPLY TEMPLATE 120529 "RTN","C0CSOAP",148,0) 120530 ; reply templates are optional and are specified by populating a 120531 "RTN","C0CSOAP",149,0) 120532 ; template pointer in field 2.5 of the request template 120533 "RTN","C0CSOAP",150,0) 120534 ; if specified, the reply template is the source of the REDUX string 120535 "RTN","C0CSOAP",151,0) 120536 ; used for XPath on the reply, and for UNBIND processing 120537 "RTN","C0CSOAP",152,0) 120538 ; if no reply template is specified, REDUX is obtained from the request 120539 "RTN","C0CSOAP",153,0) 120540 ; template and no UNBIND processing is performed. The XPath array is 120541 "RTN","C0CSOAP",154,0) 120542 ; returned without variable bindings 120543 "RTN","C0CSOAP",155,0) 120544 I C0CR'="" D ; REPLY TEMPLATE EXISTS 120545 "RTN","C0CSOAP",156,0) 120546 . I +$G(DEBUG)'=0 W "REPLY TEMPLATE:",C0CR,! 120547 "RTN","C0CSOAP",157,0) 120548 . S C0CTID=C0CR ; 120549 "RTN","C0CSOAP",158,0) 120550 N C0CFRDX S C0CFRDX=C0CF("XPATH REDUCTION STRING") 120551 "RTN","C0CSOAP",159,0) 120552 S C0CREDUX=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFRDX) ;XPATH REDUCTION STRING 120553 "RTN","C0CSOAP",160,0) 120554 K C0CIDX,C0CARY ; XPATH INDEX AND ARRAY VARS 120555 "RTN","C0CSOAP",161,0) 120556 S C0CNOM="C0CWS"_$J ; DOCUMENT NAME FOR THE DOM 120557 "RTN","C0CSOAP",162,0) 120558 S C0CID=$$PARSE^C0CXEWD("C0CRXML",C0CNOM) ;CALL THE PARSER 120559 "RTN","C0CSOAP",163,0) 120560 S C0CID=$$FIRST^C0CXEWD($$ID^C0CXEWD(C0CNOM)) ;ID OF FIRST NODE 120561 "RTN","C0CSOAP",164,0) 120562 D XPATH^C0CXEWD(C0CID,"/","C0CIDX","C0CARY","",C0CREDUX) ;XPATH GENERATOR 120563 "RTN","C0CSOAP",165,0) 120564 ; Next, call UNBIND to map the reply XPath array to variables 120565 "RTN","C0CSOAP",166,0) 120566 ; This is only done if a Reply Template is provided 120567 "RTN","C0CSOAP",167,0) 120568 D DEMUXARY(C0CRTN,"C0CARY") 120569 "RTN","C0CSOAP",168,0) 120570 ; M @C0CRTN=C0CARY 120571 "RTN","C0CSOAP",169,0) 120572 Q 120573 "RTN","C0CSOAP",170,0) 120574 ; 120575 "RTN","C0CSOAP",171,0) 120576 DEMUXARY(OARY,IARY) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO 120577 "RTN","C0CSOAP",172,0) 120578 ; FORMAT @OARY@(x,xpath) where x is the first multiple 120579 "RTN","C0CSOAP",173,0) 120580 N ZI,ZJ,ZK,ZL S ZI="" 120581 "RTN","C0CSOAP",174,0) 120582 F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; 120583 "RTN","C0CSOAP",175,0) 120584 . D DEMUX^C0CMXP("ZJ",ZI) 120585 "RTN","C0CSOAP",176,0) 120586 . S ZK=$P(ZJ,"^",3) 120587 "RTN","C0CSOAP",177,0) 120588 . S ZK=$RE($P($RE(ZK),"/",1)) 120589 "RTN","C0CSOAP",178,0) 120590 . S ZL=$P(ZJ,"^",1) 120591 "RTN","C0CSOAP",179,0) 120592 . I ZL="" S ZL=1 120593 "RTN","C0CSOAP",180,0) 120594 . S @OARY@(ZL,ZK)=@IARY@(ZI) 120595 "RTN","C0CSOAP",181,0) 120596 Q 120597 "RTN","C0CSOAP",182,0) 120598 ; 120599 "RTN","C0CSOAP",183,0) 120600 NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML 120601 "RTN","C0CSOAP",184,0) 120602 ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME 120603 "RTN","C0CSOAP",185,0) 120604 ; 120605 "RTN","C0CSOAP",186,0) 120606 N ZI,ZN,ZTMP 120607 "RTN","C0CSOAP",187,0) 120608 S ZN=1 120609 "RTN","C0CSOAP",188,0) 120610 S @OUTXML@(ZN)=$P(@INXML,"><",ZN)_">" 120611 "RTN","C0CSOAP",189,0) 120612 S ZN=ZN+1 120613 "RTN","C0CSOAP",190,0) 120614 F S @OUTXML@(ZN)="<"_$P(@INXML,"><",ZN) Q:$P(@INXML,"><",ZN+1)="" D ; 120615 "RTN","C0CSOAP",191,0) 120616 . S @OUTXML@(ZN)=@OUTXML@(ZN)_">" 120617 "RTN","C0CSOAP",192,0) 120618 . S ZN=ZN+1 120619 "RTN","C0CSOAP",193,0) 120620 Q 120621 "RTN","C0CSOAP",194,0) 120622 ; 120623 "RTN","C0CSOAP",195,0) 120624 MAP(RARY,IVARS,TPTR,INFARY) ;RETURNS MAPPED XML IN RARY PASSED BY NAME 120625 "RTN","C0CSOAP",196,0) 120626 ; IVARS IS AN XPATH ARRAY PASSED BY NAME 120627 "RTN","C0CSOAP",197,0) 120628 ; TPTR IS A POINT TO THE C0C XML TEMPLATE FILE USED TO RETRIEVE THE TEMPLATE 120629 "RTN","C0CSOAP",198,0) 120630 ; 120631 "RTN","C0CSOAP",199,0) 120632 N ZT ;THE TEMPLATE 120633 "RTN","C0CSOAP",200,0) 120634 K ZT,@RARY 120635 "RTN","C0CSOAP",201,0) 120636 I '$D(INFARY) D ; 120637 "RTN","C0CSOAP",202,0) 120638 . S INFARY="FARY" 120639 "RTN","C0CSOAP",203,0) 120640 . D INITFARY(INFARY) 120641 "RTN","C0CSOAP",204,0) 120642 N ZF,ZFT 120643 "RTN","C0CSOAP",205,0) 120644 S ZF=@INFARY@("XML FILE NUMBER") 120645 "RTN","C0CSOAP",206,0) 120646 S ZFT=@INFARY@("TEMPLATE XML") 120647 "RTN","C0CSOAP",207,0) 120648 I $$GET1^DIQ(ZF,TPTR_",",ZFT,,"ZT")'="ZT" D Q ; ERROR GETTING TEMPLATE 120649 "RTN","C0CSOAP",208,0) 120650 . W "ERROR RETRIEVING TEMPLATE",! 120651 "RTN","C0CSOAP",209,0) 120652 D MAP^C0CXPATH("ZT",IVARS,RARY) ;DO THE MAPPING 120653 "RTN","C0CSOAP",210,0) 120654 Q 120655 "RTN","C0CSOAP",211,0) 120656 ; 120657 "RTN","C0CSOAP",212,0) 120658 TESTBIND ; 120659 "RTN","C0CSOAP",213,0) 120660 S G1("TESTONE")=1 120661 "RTN","C0CSOAP",214,0) 120662 S G1("TESTTWO")=2 120663 "RTN","C0CSOAP",215,0) 120664 D BIND("G","G1","TEST") 120665 "RTN","C0CSOAP",216,0) 120182 120666 W ! 120183 "RTN","C0CSOAP",22,0) 120667 "RTN","C0CSOAP",217,0) 120668 ZWR G 120669 "RTN","C0CSOAP",218,0) 120184 120670 Q 120185 "RTN","C0CSOAP",23,0) 120186 ; 120187 "RTN","C0CSOAP",24,0) 120188 TEST1 120189 "RTN","C0CSOAP",25,0) 120190 S url="https://ec2-75-101-247-83.compute-1.amazonaws.com:8181/ccr/CCRService?wsdl" 120191 "RTN","C0CSOAP",26,0) 120192 D GET1URL^C0CEWD2(url) 120193 "RTN","C0CSOAP",27,0) 120671 "RTN","C0CSOAP",219,0) 120672 ; 120673 "RTN","C0CSOAP",220,0) 120674 BIND(RARY,IVARS,INTPTR,INFARY) ;RETURNS AN XPATH ARRAY IN RARY FOR USE WITH MAP 120675 "RTN","C0CSOAP",221,0) 120676 ; TO BUILD AN INSTANTIATED TEMPLATE 120677 "RTN","C0CSOAP",222,0) 120678 ; TPTR IS THE IEN OF THE XML TEMPATE IN THE C0C XML TEMPLATE FILE 120679 "RTN","C0CSOAP",223,0) 120680 ; LOOPS THROUGHT THE BINDING SUBFILE TO PULL OUT XPATHS AND 120681 "RTN","C0CSOAP",224,0) 120682 ; EITHER ASSIGNS VARIABLES OR DOES A FILEMAN CALL TO GET VALUES 120683 "RTN","C0CSOAP",225,0) 120684 ; VARIABLES ARE IN IVARS WHICH IS PASSED BY NAME 120685 "RTN","C0CSOAP",226,0) 120686 I '$D(INFARY) D ; 120687 "RTN","C0CSOAP",227,0) 120688 . S INFARY="FARY" 120689 "RTN","C0CSOAP",228,0) 120690 . D INITFARY(INFARY) ;INITIALIZE FILE ARRAY IF NOT PASSED 120691 "RTN","C0CSOAP",229,0) 120692 I +INTPTR>0 S TPTR=INTPTR 120693 "RTN","C0CSOAP",230,0) 120694 E S TPTR=$$RESTID(INTPTR,INFARY) 120695 "RTN","C0CSOAP",231,0) 120696 N C0CFF,C0CBF,C0CXI,C0CFREF,C0CXREF 120697 "RTN","C0CSOAP",232,0) 120698 S C0CFF=@INFARY@("XML FILE NUMBER") ;fileman file number of XML file 120699 "RTN","C0CSOAP",233,0) 120700 S C0CFREF=$$FILEREF^C0CRNF(C0CFF) ; closed file reference to the file 120701 "RTN","C0CSOAP",234,0) 120702 S C0CBF=@INFARY@("BINDING SUBFILE NUMBER") ; BINDING SUBFILE NUMBER 120703 "RTN","C0CSOAP",235,0) 120704 S C0CXI=$G(@INFARY@("XPATH INDEX")) ; index to the XPath bindings 120705 "RTN","C0CSOAP",236,0) 120706 I C0CXI="" S C0CXI="XPATH" ; default is the XPATH index 120707 "RTN","C0CSOAP",237,0) 120708 ; this needs to be a whole file index on the XPath subfile with 120709 "RTN","C0CSOAP",238,0) 120710 ; the Template IEN perceding the XPath in the index 120711 "RTN","C0CSOAP",239,0) 120712 N ZI 120713 "RTN","C0CSOAP",240,0) 120714 S ZI="" 120715 "RTN","C0CSOAP",241,0) 120716 S C0CXREF=$NA(@C0CFREF@(C0CXI,TPTR)) ; where the xref is 120717 "RTN","C0CSOAP",242,0) 120718 ;F S ZI=$O(^C0CX(TPTR,5,"B",ZI)) Q:ZI="" D ; FOR EACH XPATH 120719 "RTN","C0CSOAP",243,0) 120720 F S ZI=$O(@C0CXREF@(ZI)) Q:ZI="" D ; for each XPath in this template 120721 "RTN","C0CSOAP",244,0) 120722 . ;W !,ZI," ",$O(@C0CXREF@(ZI,TPTR,"")) 120723 "RTN","C0CSOAP",245,0) 120724 . N ZIEN,ZFILE,ZFIELD,ZVAR,ZIDX,ZINDEX ; 120725 "RTN","C0CSOAP",246,0) 120726 . S ZIEN=$O(@C0CXREF@(ZI,TPTR,"")) ; IEN OF THE BINDING RECORD 120727 "RTN","C0CSOAP",247,0) 120728 . N ZFF S ZFF=@INFARY@("FILEMAN FILE POINTER") 120729 "RTN","C0CSOAP",248,0) 120730 . S ZFILE=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFF,"I") 120731 "RTN","C0CSOAP",249,0) 120732 . N ZFFLD S ZFFLD=@INFARY@("FILEMAN FIELD NUMBER") 120733 "RTN","C0CSOAP",250,0) 120734 . S ZFIELD=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFFLD,"I") 120735 "RTN","C0CSOAP",251,0) 120736 . N ZFV S ZFV=@INFARY@("VARIABLE NAME") 120737 "RTN","C0CSOAP",252,0) 120738 . S ZVAR=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFV,"E") 120739 "RTN","C0CSOAP",253,0) 120740 . N ZFX S ZFX=("INDEXED BY") 120741 "RTN","C0CSOAP",254,0) 120742 . S ZIDX=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFX,"I") 120743 "RTN","C0CSOAP",255,0) 120744 . S ZINDEX="" 120745 "RTN","C0CSOAP",256,0) 120746 . I ZIDX="DUZ" S ZINDEX=$G(DUZ) ; FILE IS INDEXED BY DUZ 120747 "RTN","C0CSOAP",257,0) 120748 . I ZIDX="DFN" S ZINDEX=$G(DFN) ; BY DFN 120749 "RTN","C0CSOAP",258,0) 120750 . E I ZIDX'="" S ZINDEX=$G(@ZIDX) ; index variable 120751 "RTN","C0CSOAP",259,0) 120752 . ;I ZIDX="ACCT" S ZINDEX=C0CACCT ; BY ACCOUNT RECORD POINT TO C0C WS ACCT 120753 "RTN","C0CSOAP",260,0) 120754 . ;I ZIDX="LOC" S ZINDEX=C0CLOC ; BY LOCATION 120755 "RTN","C0CSOAP",261,0) 120756 . I ZVAR'="" D ; VARIABLES TAKE PRESCIDENCE OVER FILEMAN FIELDS 120757 "RTN","C0CSOAP",262,0) 120758 . . S @RARY@(ZI)=@IVARS@(ZVAR) ; 120759 "RTN","C0CSOAP",263,0) 120760 . E D ; IF NO VARIABLE, TRY ACCESSING FROM FILEMAN 120761 "RTN","C0CSOAP",264,0) 120762 . . I (ZFILE="")!(ZFIELD="") Q ;QUIT IF FILE OR FIELD NOT THERE 120763 "RTN","C0CSOAP",265,0) 120764 . . D CLEAN^DILF 120765 "RTN","C0CSOAP",266,0) 120766 . . S @RARY@(ZI)=$$GET1^DIQ(ZFILE,ZINDEX_",",ZFIELD) ;GET THE VALUE 120767 "RTN","C0CSOAP",267,0) 120768 . . I $D(^TMP("DIERR",$J,1)) D B ; 120769 "RTN","C0CSOAP",268,0) 120770 . . . W "ERROR!",! 120771 "RTN","C0CSOAP",269,0) 120772 . . . ZWR ^TMP("DIERR",$J,*) 120773 "RTN","C0CSOAP",270,0) 120194 120774 Q 120195 "RTN","C0CSOAP",28,0)120196 ;120197 "RTN","C0CSOAP",29,0)120198 INITFARY(ARY) ;initialize the Fileman Field array for SOAP processing120199 "RTN","C0CSOAP",30,0)120200 ; ARY is passed by name120201 "RTN","C0CSOAP",31,0)120202 S @ARY@("XML FILE NUMBER")="178.301"120203 "RTN","C0CSOAP",32,0)120204 S @ARY@("BINDING SUBFILE NUMBER")="178.3014"120205 "RTN","C0CSOAP",33,0)120206 S @ARY@("MIME TYPE")="2.3"120207 "RTN","C0CSOAP",34,0)120208 S @ARY@("PROXY SERVER")="2.4"120209 "RTN","C0CSOAP",35,0)120210 S @ARY@("REPLY TEMPLATE")=".03"120211 "RTN","C0CSOAP",36,0)120212 S @ARY@("TEMPLATE NAME")=".01"120213 "RTN","C0CSOAP",37,0)120214 S @ARY@("TEMPLATE XML")="3"120215 "RTN","C0CSOAP",38,0)120216 S @ARY@("URL")="1"120217 "RTN","C0CSOAP",39,0)120218 S @ARY@("WSDL URL")="2"120219 "RTN","C0CSOAP",40,0)120220 S @ARY@("XML")="2.1"120221 "RTN","C0CSOAP",41,0)120222 S @ARY@("XML HEADER")="2.2"120223 "RTN","C0CSOAP",42,0)120224 S @ARY@("XPATH REDUCTION STRING")="2.5"120225 "RTN","C0CSOAP",43,0)120226 S @ARY@("CCR VARIABLE")="4"120227 "RTN","C0CSOAP",44,0)120228 S @ARY@("FILEMAN FIELD NAME")="1"120229 "RTN","C0CSOAP",45,0)120230 S @ARY@("FILEMAN FIELD NUMBER")="1.2"120231 "RTN","C0CSOAP",46,0)120232 S @ARY@("FILEMAN FILE POINTER")="1.1"120233 "RTN","C0CSOAP",47,0)120234 S @ARY@("INDEXED BY")=".05"120235 "RTN","C0CSOAP",48,0)120236 S @ARY@("SQLI FIELD NAME")="3"120237 "RTN","C0CSOAP",49,0)120238 S @ARY@("VARIABLE NAME")="2"120239 "RTN","C0CSOAP",50,0)120240 Q120241 "RTN","C0CSOAP",51,0)120242 ;120243 "RTN","C0CSOAP",52,0)120244 RESTID(INNAM,INFARY) ;EXTRINSIC TO RESOLVE TEMPLATE PASSED BY NAME120245 "RTN","C0CSOAP",53,0)120246 ; FILE IS IDENTIFIED IN FARY, PASSED BY NAME120247 "RTN","C0CSOAP",54,0)120248 I '$D(INFARY) D ; NO FILE ARRAY PASSED120249 "RTN","C0CSOAP",55,0)120250 . S INFARY="FARY"120251 "RTN","C0CSOAP",56,0)120252 . D INITFARY(INFARY)120253 "RTN","C0CSOAP",57,0)120254 N ZN,ZREF,ZR120255 "RTN","C0CSOAP",58,0)120256 S ZN=@INFARY@("XML FILE NUMBER")120257 "RTN","C0CSOAP",59,0)120258 S ZREF=$$FILEREF^C0CRNF(ZN)120259 "RTN","C0CSOAP",60,0)120260 S ZR=$O(@ZREF@("B",INNAM,""))120261 "RTN","C0CSOAP",61,0)120262 Q ZR120263 "RTN","C0CSOAP",62,0)120264 ;120265 "RTN","C0CSOAP",63,0)120266 TESTSOAP ;120267 "RTN","C0CSOAP",64,0)120268 ; USING ICD9 WEB SERVICE TO TEST SOAP120269 "RTN","C0CSOAP",65,0)120270 S G("CODE")="E*"120271 "RTN","C0CSOAP",66,0)120272 S G("CODELN")=3120273 "RTN","C0CSOAP",67,0)120274 D SOAP("GPL","ICD9","G")120275 "RTN","C0CSOAP",68,0)120276 Q120277 "RTN","C0CSOAP",69,0)120278 ;120279 "RTN","C0CSOAP",70,0)120280 SOAP(C0CRTN,C0CTID,C0CVA,C0CVOR,ALTXML,IFARY) ; MAKES A SOAP CALL FOR120281 "RTN","C0CSOAP",71,0)120282 ; TEMPLATE ID C0CTID120283 "RTN","C0CSOAP",72,0)120284 ; RETURNS THE XML RESULT IN C0CRTN, PASSED BY NAME120285 "RTN","C0CSOAP",73,0)120286 ; C0CVA IS PASSED BY NAME AND IS THE VARIABLE ARRAY TO PASS TO BIND120287 "RTN","C0CSOAP",74,0)120288 ; C0CVOR IS THE NAME OF A VARIABLE OVERRIDE ARRAY, WHICH IS APPLIED120289 "RTN","C0CSOAP",75,0)120290 ; BEFORE MAPPING120291 "RTN","C0CSOAP",76,0)120292 ; IF ALTXML IS PASSED, BIND AND MAP WILL BE SKIPPED AND120293 "RTN","C0CSOAP",77,0)120294 ; ALTXML WILL BE USED INSTEAD120295 "RTN","C0CSOAP",78,0)120296 ;120297 "RTN","C0CSOAP",79,0)120298 ; ARTIFACTS SECTION120299 "RTN","C0CSOAP",80,0)120300 ; THE FOLLOWING WILL SET UP DEBUGGING ARTIFACTS FOR A POSSIBLE FUTURE120301 "RTN","C0CSOAP",81,0)120302 ; ONLINE DEBUGGER. IF DEBUG=1, VARIABLES CONTAINING INTERMEDIATE RESULTS120303 "RTN","C0CSOAP",82,0)120304 ; WILL NOT BE NEWED.120305 "RTN","C0CSOAP",83,0)120306 I $G(WSDEBUG)="" N C0CV ; CATALOG OF ARTIFACT VARIABLES AND ARRAYS120307 "RTN","C0CSOAP",84,0)120308 S C0CV(100,"C0CXF","XML TEMPLATE FILE NUMBER")=""120309 "RTN","C0CSOAP",85,0)120310 S C0CV(200,"C0CHEAD","SOAP HEADER VARIABLE NAME")=""120311 "RTN","C0CSOAP",86,0)120312 S C0CV(300,"HEADER","SOAP HEADER")=""120313 "RTN","C0CSOAP",87,0)120314 S C0CV(400,"C0CMIME","MIME TYPE")=""120315 "RTN","C0CSOAP",88,0)120316 S C0CV(500,"C0CURL","WS URL")=""120317 "RTN","C0CSOAP",89,0)120318 S C0CV(550,"C0CPURL","PROXY URL")=""120319 "RTN","C0CSOAP",90,0)120320 S C0CV(600,"C0CXML","XML VARIABLE NAME")=""120321 "RTN","C0CSOAP",91,0)120322 S C0CV(700,"XML","OUTBOUND XML")=""120323 "RTN","C0CSOAP",92,0)120324 S C0CV(800,"C0CRSLT","RAW XML RESULT RETURNED FROM WEB SERVICE")=""120325 "RTN","C0CSOAP",93,0)120326 S C0CV(900,"C0CRHDR","RETURNED HEADER")=""120327 "RTN","C0CSOAP",94,0)120328 S C0CV(1000,"C0CRXML","XML RESULT NORMALIZED")=""120329 "RTN","C0CSOAP",95,0)120330 S C0CV(1100,"C0CR","REPLY TEMPLATE")=""120331 "RTN","C0CSOAP",96,0)120332 S C0CV(1200,"C0CREDUX","REDUX STRING")=""120333 "RTN","C0CSOAP",97,0)120334 S C0CV(1300,"C0CIDX","RESULT XPATH INDEX")=""120335 "RTN","C0CSOAP",98,0)120336 S C0CV(1400,"C0CARY","RESULT XPATH ARRAY")=""120337 "RTN","C0CSOAP",99,0)120338 S C0CV(1500,"C0CNOM","RESULT DOM DOCUMENT NAME")=""120339 "RTN","C0CSOAP",100,0)120340 S C0CV(1600,"C0CID","RESULT DOM ID")=""120341 "RTN","C0CSOAP",101,0)120342 I $G(DEBUG)'="" G NOTNEW ; SKIP NEWING THE VARIABLES IF IN DEBUG120343 "RTN","C0CSOAP",102,0)120344 N ZI,ZJ S ZI=""120345 "RTN","C0CSOAP",103,0)120346 NEW120347 "RTN","C0CSOAP",104,0)120348 S ZI=$O(C0CV(ZI))120349 "RTN","C0CSOAP",105,0)120350 S ZJ=$O(C0CV(ZI,"")) ; SET UP NEW COMMAND120351 "RTN","C0CSOAP",106,0)120352 ;W ZJ,!120353 "RTN","C0CSOAP",107,0)120354 N @ZJ ; NEW THE VARIABLE120355 "RTN","C0CSOAP",108,0)120356 I $O(C0CV(ZI))'="" G NEW ;LOOP TO GET NEW IN CONTEXT120357 "RTN","C0CSOAP",109,0)120358 NOTNEW120359 "RTN","C0CSOAP",110,0)120360 ; END ARTIFACTS120361 "RTN","C0CSOAP",111,0)120362 ;120363 "RTN","C0CSOAP",112,0)120364 I '$D(IFARY) D INITFARY("C0CF") ; SET FILE NUMBER AND PARAMATERS120365 "RTN","C0CSOAP",113,0)120366 E D ;120367 "RTN","C0CSOAP",114,0)120368 . K C0CF120369 "RTN","C0CSOAP",115,0)120370 . M C0CF=@IFARY120371 "RTN","C0CSOAP",116,0)120372 S C0CXF=C0CF("XML FILE NUMBER") ; FILE NUMBER FOR THE XML TEMPLATE FILE120373 "RTN","C0CSOAP",117,0)120374 I +C0CTID=0 D ; A STRING WAS PASSED FOR THE TEMPLATE NAME120375 "RTN","C0CSOAP",118,0)120376 . S C0CUTID=$$RESTID(C0CTID,"C0CF") ;RESOLVE TEMPLATE IEN FROM NAME120377 "RTN","C0CSOAP",119,0)120378 E S C0CUTID=C0CTID ; AN IEN WAS PASSED120379 "RTN","C0CSOAP",120,0)120380 N XML,TEMPLATE,HEADER120381 "RTN","C0CSOAP",121,0)120382 N C0CFH S C0CFH=C0CF("XML HEADER")120383 "RTN","C0CSOAP",122,0)120384 S C0CHEAD=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFH,,"HEADER")120385 "RTN","C0CSOAP",123,0)120386 N C0CFM S C0CFM=C0CF("MIME TYPE")120387 "RTN","C0CSOAP",124,0)120388 S C0CMIME=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFM)120389 "RTN","C0CSOAP",125,0)120390 N C0CFP S C0CFP=C0CF("PROXY SERVER")120391 "RTN","C0CSOAP",126,0)120392 S C0CPURL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFP)120393 "RTN","C0CSOAP",127,0)120394 N C0CFU S C0CFU=C0CF("URL")120395 "RTN","C0CSOAP",128,0)120396 S C0CURL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFU)120397 "RTN","C0CSOAP",129,0)120398 N C0CFX S C0CFX=C0CF("XML")120399 "RTN","C0CSOAP",130,0)120400 S C0CXML=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFX,,"XML")120401 "RTN","C0CSOAP",131,0)120402 N C0CFT S C0CFT=C0CF("TEMPLATE XML")120403 "RTN","C0CSOAP",132,0)120404 S C0CTMPL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFT,,"TEMPLATE")120405 "RTN","C0CSOAP",133,0)120406 I C0CTMPL="TEMPLATE" D ; there is a template to process120407 "RTN","C0CSOAP",134,0)120408 . K XML ; going to replace the xml array120409 "RTN","C0CSOAP",135,0)120410 . N VARS120411 "RTN","C0CSOAP",136,0)120412 . I $D(C0CVOR) M @C0CVA=@C0CVOR ; merge in varible overrides120413 "RTN","C0CSOAP",137,0)120414 . I '$D(ALTXML) D ; if ALTXML is passed in, don't bind120415 "RTN","C0CSOAP",138,0)120416 . . D BIND("VARS",C0CVA,C0CUTID,"C0CF")120417 "RTN","C0CSOAP",139,0)120418 . . D MAP("XML","VARS",TPTR,"C0CF")120419 "RTN","C0CSOAP",140,0)120420 . . K XML(0)120421 "RTN","C0CSOAP",141,0)120422 . E M XML=@ALTXML ; use ALTXML instead120423 "RTN","C0CSOAP",142,0)120424 I $G(C0CPROXY) S C0CURL=C0CPURL120425 "RTN","C0CSOAP",143,0)120426 K C0CRSLT,C0CRHDR120427 "RTN","C0CSOAP",144,0)120428 B120429 "RTN","C0CSOAP",145,0)120430 S ok=$$httpPOST^%zewdGTM(C0CURL,.XML,C0CMIME,.C0CRSLT,.HEADER,"",.gpl5,.C0CRHDR)120431 "RTN","C0CSOAP",146,0)120432 K C0CRXML120433 "RTN","C0CSOAP",147,0)120434 D NORMAL("C0CRXML","C0CRSLT(1)") ;RETURN XML IN AN ARRAY120435 "RTN","C0CSOAP",148,0)120436 N C0CFR S C0CFR=$G(C0CF("REPLY TEMPLATE"))120437 "RTN","C0CSOAP",149,0)120438 S C0CR=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFR,"I") ; REPLY TEMPLATE120439 "RTN","C0CSOAP",150,0)120440 ; reply templates are optional and are specified by populating a120441 "RTN","C0CSOAP",151,0)120442 ; template pointer in field 2.5 of the request template120443 "RTN","C0CSOAP",152,0)120444 ; if specified, the reply template is the source of the REDUX string120445 "RTN","C0CSOAP",153,0)120446 ; used for XPath on the reply, and for UNBIND processing120447 "RTN","C0CSOAP",154,0)120448 ; if no reply template is specified, REDUX is obtained from the request120449 "RTN","C0CSOAP",155,0)120450 ; template and no UNBIND processing is performed. The XPath array is120451 "RTN","C0CSOAP",156,0)120452 ; returned without variable bindings120453 "RTN","C0CSOAP",157,0)120454 I C0CR'="" D ; REPLY TEMPLATE EXISTS120455 "RTN","C0CSOAP",158,0)120456 . I +$G(DEBUG)'=0 W "REPLY TEMPLATE:",C0CR,!120457 "RTN","C0CSOAP",159,0)120458 . S C0CTID=C0CR ;120459 "RTN","C0CSOAP",160,0)120460 N C0CFRDX S C0CFRDX=C0CF("XPATH REDUCTION STRING")120461 "RTN","C0CSOAP",161,0)120462 S C0CREDUX=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFRDX) ;XPATH REDUCTION STRING120463 "RTN","C0CSOAP",162,0)120464 K C0CIDX,C0CARY ; XPATH INDEX AND ARRAY VARS120465 "RTN","C0CSOAP",163,0)120466 S C0CNOM="C0CWS"_$J ; DOCUMENT NAME FOR THE DOM120467 "RTN","C0CSOAP",164,0)120468 S C0CID=$$PARSE^C0CXEWD("C0CRXML",C0CNOM) ;CALL THE PARSER120469 "RTN","C0CSOAP",165,0)120470 S C0CID=$$FIRST^C0CXEWD($$ID^C0CXEWD(C0CNOM)) ;ID OF FIRST NODE120471 "RTN","C0CSOAP",166,0)120472 D XPATH^C0CXEWD(C0CID,"/","C0CIDX","C0CARY","",C0CREDUX) ;XPATH GENERATOR120473 "RTN","C0CSOAP",167,0)120474 ; Next, call UNBIND to map the reply XPath array to variables120475 "RTN","C0CSOAP",168,0)120476 ; This is only done if a Reply Template is provided120477 "RTN","C0CSOAP",169,0)120478 D DEMUXARY(C0CRTN,"C0CARY")120479 "RTN","C0CSOAP",170,0)120480 ; M @C0CRTN=C0CARY120481 "RTN","C0CSOAP",171,0)120482 Q120483 "RTN","C0CSOAP",172,0)120484 ;120485 "RTN","C0CSOAP",173,0)120486 DEMUXARY(OARY,IARY) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO120487 "RTN","C0CSOAP",174,0)120488 ; FORMAT @OARY@(x,xpath) where x is the first multiple120489 "RTN","C0CSOAP",175,0)120490 N ZI,ZJ,ZK,ZL S ZI=""120491 "RTN","C0CSOAP",176,0)120492 F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ;120493 "RTN","C0CSOAP",177,0)120494 . D DEMUX^C0CMXP("ZJ",ZI)120495 "RTN","C0CSOAP",178,0)120496 . S ZK=$P(ZJ,"^",3)120497 "RTN","C0CSOAP",179,0)120498 . S ZK=$RE($P($RE(ZK),"/",1))120499 "RTN","C0CSOAP",180,0)120500 . S ZL=$P(ZJ,"^",1)120501 "RTN","C0CSOAP",181,0)120502 . I ZL="" S ZL=1120503 "RTN","C0CSOAP",182,0)120504 . S @OARY@(ZL,ZK)=@IARY@(ZI)120505 "RTN","C0CSOAP",183,0)120506 Q120507 "RTN","C0CSOAP",184,0)120508 ;120509 "RTN","C0CSOAP",185,0)120510 NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML120511 "RTN","C0CSOAP",186,0)120512 ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME120513 "RTN","C0CSOAP",187,0)120514 ;120515 "RTN","C0CSOAP",188,0)120516 N ZI,ZN,ZTMP120517 "RTN","C0CSOAP",189,0)120518 S ZN=1120519 "RTN","C0CSOAP",190,0)120520 S @OUTXML@(ZN)=$P(@INXML,"><",ZN)_">"120521 "RTN","C0CSOAP",191,0)120522 S ZN=ZN+1120523 "RTN","C0CSOAP",192,0)120524 F S @OUTXML@(ZN)="<"_$P(@INXML,"><",ZN) Q:$P(@INXML,"><",ZN+1)="" D ;120525 "RTN","C0CSOAP",193,0)120526 . S @OUTXML@(ZN)=@OUTXML@(ZN)_">"120527 "RTN","C0CSOAP",194,0)120528 . S ZN=ZN+1120529 "RTN","C0CSOAP",195,0)120530 Q120531 "RTN","C0CSOAP",196,0)120532 ;120533 "RTN","C0CSOAP",197,0)120534 MAP(RARY,IVARS,TPTR,INFARY) ;RETURNS MAPPED XML IN RARY PASSED BY NAME120535 "RTN","C0CSOAP",198,0)120536 ; IVARS IS AN XPATH ARRAY PASSED BY NAME120537 "RTN","C0CSOAP",199,0)120538 ; TPTR IS A POINT TO THE C0C XML TEMPLATE FILE USED TO RETRIEVE THE TEMPLATE120539 "RTN","C0CSOAP",200,0)120540 ;120541 "RTN","C0CSOAP",201,0)120542 N ZT ;THE TEMPLATE120543 "RTN","C0CSOAP",202,0)120544 K ZT,@RARY120545 "RTN","C0CSOAP",203,0)120546 I '$D(INFARY) D ;120547 "RTN","C0CSOAP",204,0)120548 . S INFARY="FARY"120549 "RTN","C0CSOAP",205,0)120550 . D INITFARY(INFARY)120551 "RTN","C0CSOAP",206,0)120552 N ZF,ZFT120553 "RTN","C0CSOAP",207,0)120554 S ZF=@INFARY@("XML FILE NUMBER")120555 "RTN","C0CSOAP",208,0)120556 S ZFT=@INFARY@("TEMPLATE XML")120557 "RTN","C0CSOAP",209,0)120558 I $$GET1^DIQ(ZF,TPTR_",",ZFT,,"ZT")'="ZT" D Q ; ERROR GETTING TEMPLATE120559 "RTN","C0CSOAP",210,0)120560 . W "ERROR RETRIEVING TEMPLATE",!120561 "RTN","C0CSOAP",211,0)120562 D MAP^C0CXPATH("ZT",IVARS,RARY) ;DO THE MAPPING120563 "RTN","C0CSOAP",212,0)120564 Q120565 "RTN","C0CSOAP",213,0)120566 ;120567 "RTN","C0CSOAP",214,0)120568 TESTBIND ;120569 "RTN","C0CSOAP",215,0)120570 S G1("TESTONE")=1120571 "RTN","C0CSOAP",216,0)120572 S G1("TESTTWO")=2120573 "RTN","C0CSOAP",217,0)120574 D BIND("G","G1","TEST")120575 "RTN","C0CSOAP",218,0)120576 W !120577 "RTN","C0CSOAP",219,0)120578 ZWR G120579 "RTN","C0CSOAP",220,0)120580 Q120581 "RTN","C0CSOAP",221,0)120582 ;120583 "RTN","C0CSOAP",222,0)120584 BIND(RARY,IVARS,INTPTR,INFARY) ;RETURNS AN XPATH ARRAY IN RARY FOR USE WITH MAP120585 "RTN","C0CSOAP",223,0)120586 ; TO BUILD AN INSTANTIATED TEMPLATE120587 "RTN","C0CSOAP",224,0)120588 ; TPTR IS THE IEN OF THE XML TEMPATE IN THE C0C XML TEMPLATE FILE120589 "RTN","C0CSOAP",225,0)120590 ; LOOPS THROUGHT THE BINDING SUBFILE TO PULL OUT XPATHS AND120591 "RTN","C0CSOAP",226,0)120592 ; EITHER ASSIGNS VARIABLES OR DOES A FILEMAN CALL TO GET VALUES120593 "RTN","C0CSOAP",227,0)120594 ; VARIABLES ARE IN IVARS WHICH IS PASSED BY NAME120595 "RTN","C0CSOAP",228,0)120596 I '$D(INFARY) D ;120597 "RTN","C0CSOAP",229,0)120598 . S INFARY="FARY"120599 "RTN","C0CSOAP",230,0)120600 . D INITFARY(INFARY) ;INITIALIZE FILE ARRAY IF NOT PASSED120601 "RTN","C0CSOAP",231,0)120602 I +INTPTR>0 S TPTR=INTPTR120603 "RTN","C0CSOAP",232,0)120604 E S TPTR=$$RESTID(INTPTR,INFARY)120605 "RTN","C0CSOAP",233,0)120606 N C0CFF,C0CBF,C0CXI,C0CFREF,C0CXREF120607 "RTN","C0CSOAP",234,0)120608 S C0CFF=@INFARY@("XML FILE NUMBER") ;fileman file number of XML file120609 "RTN","C0CSOAP",235,0)120610 S C0CFREF=$$FILEREF^C0CRNF(C0CFF) ; closed file reference to the file120611 "RTN","C0CSOAP",236,0)120612 S C0CBF=@INFARY@("BINDING SUBFILE NUMBER") ; BINDING SUBFILE NUMBER120613 "RTN","C0CSOAP",237,0)120614 S C0CXI=$G(@INFARY@("XPATH INDEX")) ; index to the XPath bindings120615 "RTN","C0CSOAP",238,0)120616 I C0CXI="" S C0CXI="XPATH" ; default is the XPATH index120617 "RTN","C0CSOAP",239,0)120618 ; this needs to be a whole file index on the XPath subfile with120619 "RTN","C0CSOAP",240,0)120620 ; the Template IEN perceding the XPath in the index120621 "RTN","C0CSOAP",241,0)120622 N ZI120623 "RTN","C0CSOAP",242,0)120624 S ZI=""120625 "RTN","C0CSOAP",243,0)120626 S C0CXREF=$NA(@C0CFREF@(C0CXI,TPTR)) ; where the xref is120627 "RTN","C0CSOAP",244,0)120628 ;F S ZI=$O(^C0CX(TPTR,5,"B",ZI)) Q:ZI="" D ; FOR EACH XPATH120629 "RTN","C0CSOAP",245,0)120630 F S ZI=$O(@C0CXREF@(ZI)) Q:ZI="" D ; for each XPath in this template120631 "RTN","C0CSOAP",246,0)120632 . ;W !,ZI," ",$O(@C0CXREF@(ZI,TPTR,""))120633 "RTN","C0CSOAP",247,0)120634 . N ZIEN,ZFILE,ZFIELD,ZVAR,ZIDX,ZINDEX ;120635 "RTN","C0CSOAP",248,0)120636 . S ZIEN=$O(@C0CXREF@(ZI,TPTR,"")) ; IEN OF THE BINDING RECORD120637 "RTN","C0CSOAP",249,0)120638 . N ZFF S ZFF=@INFARY@("FILEMAN FILE POINTER")120639 "RTN","C0CSOAP",250,0)120640 . S ZFILE=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFF,"I")120641 "RTN","C0CSOAP",251,0)120642 . N ZFFLD S ZFFLD=@INFARY@("FILEMAN FIELD NUMBER")120643 "RTN","C0CSOAP",252,0)120644 . S ZFIELD=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFFLD,"I")120645 "RTN","C0CSOAP",253,0)120646 . N ZFV S ZFV=@INFARY@("VARIABLE NAME")120647 "RTN","C0CSOAP",254,0)120648 . S ZVAR=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFV,"E")120649 "RTN","C0CSOAP",255,0)120650 . N ZFX S ZFX=("INDEXED BY")120651 "RTN","C0CSOAP",256,0)120652 . S ZIDX=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFX,"I")120653 "RTN","C0CSOAP",257,0)120654 . S ZINDEX=""120655 "RTN","C0CSOAP",258,0)120656 . I ZIDX="DUZ" S ZINDEX=$G(DUZ) ; FILE IS INDEXED BY DUZ120657 "RTN","C0CSOAP",259,0)120658 . I ZIDX="DFN" S ZINDEX=$G(DFN) ; BY DFN120659 "RTN","C0CSOAP",260,0)120660 . E I ZIDX'="" S ZINDEX=$G(@ZIDX) ; index variable120661 "RTN","C0CSOAP",261,0)120662 . ;I ZIDX="ACCT" S ZINDEX=C0CACCT ; BY ACCOUNT RECORD POINT TO C0C WS ACCT120663 "RTN","C0CSOAP",262,0)120664 . ;I ZIDX="LOC" S ZINDEX=C0CLOC ; BY LOCATION120665 "RTN","C0CSOAP",263,0)120666 . I ZVAR'="" D ; VARIABLES TAKE PRESCIDENCE OVER FILEMAN FIELDS120667 "RTN","C0CSOAP",264,0)120668 . . S @RARY@(ZI)=@IVARS@(ZVAR) ;120669 "RTN","C0CSOAP",265,0)120670 . E D ; IF NO VARIABLE, TRY ACCESSING FROM FILEMAN120671 "RTN","C0CSOAP",266,0)120672 . . I (ZFILE="")!(ZFIELD="") Q ;QUIT IF FILE OR FIELD NOT THERE120673 "RTN","C0CSOAP",267,0)120674 . . D CLEAN^DILF120675 "RTN","C0CSOAP",268,0)120676 . . S @RARY@(ZI)=$$GET1^DIQ(ZFILE,ZINDEX_",",ZFIELD) ;GET THE VALUE120677 "RTN","C0CSOAP",269,0)120678 . . I $D(^TMP("DIERR",$J,1)) D B ;120679 "RTN","C0CSOAP",270,0)120680 . . . W "ERROR!",!120681 120775 "RTN","C0CSOAP",271,0) 120682 . . . ZWR ^TMP("DIERR",$J,*)120683 "RTN","C0CSOAP",272,0)120684 Q120685 "RTN","C0CSOAP",273,0)120686 120776 ; 120687 120777 "RTN","C0CSQMB") 120688 0^107^B 545540120778 0^107^B779536 120689 120779 "RTN","C0CSQMB",1,0) 120690 120780 C0CSQMB ; SQMCCR/ELN - BATCH PROGRAM ;16/11/2010 120691 120781 "RTN","C0CSQMB",2,0) 120692 ;;1.2;C 0C;;May 11, 2012;Build 50120782 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 120693 120783 "RTN","C0CSQMB",3,0) 120694 ; 120784 ; (C) 2010 ELN 120695 120785 "RTN","C0CSQMB",4,0) 120786 ; 120787 "RTN","C0CSQMB",5,0) 120788 ; This program is free software: you can redistribute it and/or modify 120789 "RTN","C0CSQMB",6,0) 120790 ; it under the terms of the GNU Affero General Public License as 120791 "RTN","C0CSQMB",7,0) 120792 ; published by the Free Software Foundation, either version 3 of the 120793 "RTN","C0CSQMB",8,0) 120794 ; License, or (at your option) any later version. 120795 "RTN","C0CSQMB",9,0) 120796 ; 120797 "RTN","C0CSQMB",10,0) 120798 ; This program is distributed in the hope that it will be useful, 120799 "RTN","C0CSQMB",11,0) 120800 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 120801 "RTN","C0CSQMB",12,0) 120802 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 120803 "RTN","C0CSQMB",13,0) 120804 ; GNU Affero General Public License for more details. 120805 "RTN","C0CSQMB",14,0) 120806 ; 120807 "RTN","C0CSQMB",15,0) 120808 ; You should have received a copy of the GNU Affero General Public License 120809 "RTN","C0CSQMB",16,0) 120810 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 120811 "RTN","C0CSQMB",17,0) 120812 ; 120813 "RTN","C0CSQMB",18,0) 120696 120814 EN ;Traverse the DPT global and export CCR xml for each DFN 120697 "RTN","C0CSQMB", 5,0)120815 "RTN","C0CSQMB",19,0) 120698 120816 ;and write to directory set in ^TMP("C0CCCR","ODIR")= 120699 "RTN","C0CSQMB", 6,0)120700 ; 120701 "RTN","C0CSQMB", 7,0)120817 "RTN","C0CSQMB",20,0) 120818 ; 120819 "RTN","C0CSQMB",21,0) 120702 120820 I '$D(DUZ) Q 120703 "RTN","C0CSQMB", 8,0)120821 "RTN","C0CSQMB",22,0) 120704 120822 S U="^",DT=$$DT^XLFDT 120705 "RTN","C0CSQMB", 9,0)120823 "RTN","C0CSQMB",23,0) 120706 120824 D DUZ^XUP(DUZ) 120707 "RTN","C0CSQMB", 10,0)120825 "RTN","C0CSQMB",24,0) 120708 120826 ; Get the output directory and filename prefix from env 120709 "RTN","C0CSQMB", 11,0)120827 "RTN","C0CSQMB",25,0) 120710 120828 S ^TMP("C0CCCR","ODIR")=$ZTRNLNM("ccrodir") 120711 "RTN","C0CSQMB", 12,0)120829 "RTN","C0CSQMB",26,0) 120712 120830 S ^TMP("C0CCCR","OFNP")=$ZTRNLNM("ccrofnprefix") 120713 "RTN","C0CSQMB", 13,0)120831 "RTN","C0CSQMB",27,0) 120714 120832 N ZDFN 120715 "RTN","C0CSQMB", 14,0)120833 "RTN","C0CSQMB",28,0) 120716 120834 ;F ZDFN=0:0 S ZDFN=$O(^DPT(ZDFN)) Q:'ZDFN!((ZDFN="+1,")!(ZDFN>10)) D 120717 "RTN","C0CSQMB", 15,0)120835 "RTN","C0CSQMB",29,0) 120718 120836 F ZDFN=0:0 S ZDFN=$O(^DPT(ZDFN)) Q:'ZDFN!(ZDFN="+1,") D 120719 "RTN","C0CSQMB", 16,0)120837 "RTN","C0CSQMB",30,0) 120720 120838 . ;I ZDFN<350 S ZDFN=349 120721 "RTN","C0CSQMB", 17,0)120839 "RTN","C0CSQMB",31,0) 120722 120840 . D XPAT^C0CCCR(ZDFN) 120723 "RTN","C0CSQMB", 18,0)120841 "RTN","C0CSQMB",32,0) 120724 120842 Q 120725 "RTN","C0CSQMB", 19,0)120843 "RTN","C0CSQMB",33,0) 120726 120844 ; 120727 120845 "RTN","C0CSUB1") 120728 0^61^B1 6280924120846 0^61^B15609029 120729 120847 "RTN","C0CSUB1",1,0) 120730 120848 C0CSUB1 ; CCDCCR/GPL - CCR SUBSCRIPTION utilities; 12/6/08 120731 120849 "RTN","C0CSUB1",2,0) 120732 ;;1.2;C 0C;;May 11, 2012;Build 50120850 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 120733 120851 "RTN","C0CSUB1",3,0) 120734 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU120852 ;Copyright 2009 George Lilly. 120735 120853 "RTN","C0CSUB1",4,0) 120736 ; General Public License See attached copy of the License.120854 ; 120737 120855 "RTN","C0CSUB1",5,0) 120738 ; 120856 ; This program is free software: you can redistribute it and/or modify 120739 120857 "RTN","C0CSUB1",6,0) 120740 ; This program is free software; you can redistribute it and/or modify120858 ; it under the terms of the GNU Affero General Public License as 120741 120859 "RTN","C0CSUB1",7,0) 120742 ; it under the terms of the GNU General Public License as published by120860 ; published by the Free Software Foundation, either version 3 of the 120743 120861 "RTN","C0CSUB1",8,0) 120744 ; the Free Software Foundation; either version 2 of the License, or120862 ; License, or (at your option) any later version. 120745 120863 "RTN","C0CSUB1",9,0) 120746 ; (at your option) any later version.120864 ; 120747 120865 "RTN","C0CSUB1",10,0) 120748 ; 120866 ; This program is distributed in the hope that it will be useful, 120749 120867 "RTN","C0CSUB1",11,0) 120750 ; This program is distributed in the hope that it will be useful,120868 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 120751 120869 "RTN","C0CSUB1",12,0) 120752 ; but WITHOUT ANY WARRANTY; without even the implied warranty of120870 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 120753 120871 "RTN","C0CSUB1",13,0) 120754 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the120872 ; GNU Affero General Public License for more details. 120755 120873 "RTN","C0CSUB1",14,0) 120756 ; GNU General Public License for more details.120874 ; 120757 120875 "RTN","C0CSUB1",15,0) 120758 ; 120876 ; You should have received a copy of the GNU Affero General Public License 120759 120877 "RTN","C0CSUB1",16,0) 120760 ; You should have received a copy of the GNU General Public License along120878 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 120761 120879 "RTN","C0CSUB1",17,0) 120762 ; with this program; if not, write to the Free Software Foundation, Inc.,120880 ; 120763 120881 "RTN","C0CSUB1",18,0) 120764 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.120882 W "This is the CCR SUBSCRIPTIONN Utility Library ",! 120765 120883 "RTN","C0CSUB1",19,0) 120766 ;120884 Q 120767 120885 "RTN","C0CSUB1",20,0) 120768 W "This is the CCR SUBSCRIPTIONN Utility Library ",!120886 ; 120769 120887 "RTN","C0CSUB1",21,0) 120888 CHK1(DFN) ; ADD THE CHECKSUM FOR ONE PATIENT 120889 "RTN","C0CSUB1",22,0) 120890 ; 120891 "RTN","C0CSUB1",23,0) 120892 S C0CCHK=$NA(^TMP("C0CRIM","CHKSUM")) 120893 "RTN","C0CSUB1",24,0) 120894 S C0CSF=177.101 ; FILE NUMBER FOR SUBSCRIPTION FILE 120895 "RTN","C0CSUB1",25,0) 120896 S C0CSFS=177.1011 ; FILE NUMBER FOR SUBSCRIPTION SUBFILE 120897 "RTN","C0CSUB1",26,0) 120898 S C0CSFC=177.1012 ; FILE NUMBER FOR CHECKSUM SUBFILE 120899 "RTN","C0CSUB1",27,0) 120900 S C0CSFDC=177.10121 ; FILE NUMBER FOR DOMAIN CHECKSUMS 120901 "RTN","C0CSUB1",28,0) 120902 S C0CPAT=$O(^C0CS("B",DFN,"")) ; IEN OF PAT 120903 "RTN","C0CSUB1",29,0) 120904 K C0CFDA 120905 "RTN","C0CSUB1",30,0) 120906 S C0CALL=$G(@C0CCHK@(DFN,"ALL")) 120907 "RTN","C0CSUB1",31,0) 120908 I C0CALL'="" S C0CFDA(C0CSFC,"?+1,"_C0CPAT_",",.01)=C0CALL 120909 "RTN","C0CSUB1",32,0) 120910 E Q ; NO CHECKSUMS FOR THISPATIENT 120911 "RTN","C0CSUB1",33,0) 120912 D UPDIE 120913 "RTN","C0CSUB1",34,0) 120914 N C0CJ S C0CJ="" 120915 "RTN","C0CSUB1",35,0) 120916 F S C0CJ=$O(@C0CCHK@(DFN,"DOMAIN",C0CJ)) Q:C0CJ="" D ; FOR EACH DOMAIN 120917 "RTN","C0CSUB1",36,0) 120918 . S C0CD=$O(^C0CDIC(170.101,"B",C0CJ,"")) 120919 "RTN","C0CSUB1",37,0) 120920 . W C0CJ," ",C0CD,! 120921 "RTN","C0CSUB1",38,0) 120922 . S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",.01)=C0CD 120923 "RTN","C0CSUB1",39,0) 120924 . S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",1)=@C0CCHK@(DFN,"DOMAIN",C0CJ) 120925 "RTN","C0CSUB1",40,0) 120926 . D UPDIE 120927 "RTN","C0CSUB1",41,0) 120770 120928 Q 120771 "RTN","C0CSUB1",22,0) 120772 ; 120773 "RTN","C0CSUB1",23,0) 120774 CHK1(DFN) ; ADD THE CHECKSUM FOR ONE PATIENT 120775 "RTN","C0CSUB1",24,0) 120776 ; 120777 "RTN","C0CSUB1",25,0) 120778 S C0CCHK=$NA(^TMP("C0CRIM","CHKSUM")) 120779 "RTN","C0CSUB1",26,0) 120929 "RTN","C0CSUB1",42,0) 120930 ; 120931 "RTN","C0CSUB1",43,0) 120932 SUBALL ; SUBSCRIBE ALL PATIENTS IN CCR GLOBALS TO SUBCRIBER 1 120933 "RTN","C0CSUB1",44,0) 120934 ; 120935 "RTN","C0CSUB1",45,0) 120936 S C0CGLB=$NA(^TMP("C0CRIM","VARS")) 120937 "RTN","C0CSUB1",46,0) 120938 S C0CI="" 120939 "RTN","C0CSUB1",47,0) 120940 F S C0CI=$O(@C0CGLB@(C0CI)) Q:C0CI="" D ; FOR EACH PATIENT 120941 "RTN","C0CSUB1",48,0) 120942 . D SUB1(C0CI,1) ;SUBSCIRBE THEM TO EPCRN 120943 "RTN","C0CSUB1",49,0) 120944 Q 120945 "RTN","C0CSUB1",50,0) 120946 ; 120947 "RTN","C0CSUB1",51,0) 120948 SUB1(DFN,C0CSS) ; SUBSCRIBE ONE PATIENT TO SUBSCRIBER C0CSS 120949 "RTN","C0CSUB1",52,0) 120950 ; 120951 "RTN","C0CSUB1",53,0) 120780 120952 S C0CSF=177.101 ; FILE NUMBER FOR SUBSCRIPTION FILE 120781 "RTN","C0CSUB1", 27,0)120953 "RTN","C0CSUB1",54,0) 120782 120954 S C0CSFS=177.1011 ; FILE NUMBER FOR SUBSCRIPTION SUBFILE 120783 "RTN","C0CSUB1",28,0) 120784 S C0CSFC=177.1012 ; FILE NUMBER FOR CHECKSUM SUBFILE 120785 "RTN","C0CSUB1",29,0) 120786 S C0CSFDC=177.10121 ; FILE NUMBER FOR DOMAIN CHECKSUMS 120787 "RTN","C0CSUB1",30,0) 120955 "RTN","C0CSUB1",55,0) 120956 S C0CSFC=177.10121 ; FILE NUMBER FOR CHECKSUMS 120957 "RTN","C0CSUB1",56,0) 120958 S C0CSSF=177.201 ; FILE NUMBER FOR SUBSCRIBER FILE 120959 "RTN","C0CSUB1",57,0) 120960 K C0CFDA 120961 "RTN","C0CSUB1",58,0) 120962 S C0CFDA(C0CSF,"+1,",.01)=DFN 120963 "RTN","C0CSUB1",59,0) 120964 D UPDIE ; ADD THE PATIENT 120965 "RTN","C0CSUB1",60,0) 120788 120966 S C0CPAT=$O(^C0CS("B",DFN,"")) ; IEN OF PAT 120789 "RTN","C0CSUB1",31,0) 120790 K C0CFDA 120791 "RTN","C0CSUB1",32,0) 120792 S C0CALL=$G(@C0CCHK@(DFN,"ALL")) 120793 "RTN","C0CSUB1",33,0) 120794 I C0CALL'="" S C0CFDA(C0CSFC,"?+1,"_C0CPAT_",",.01)=C0CALL 120795 "RTN","C0CSUB1",34,0) 120796 E Q ; NO CHECKSUMS FOR THISPATIENT 120797 "RTN","C0CSUB1",35,0) 120798 D UPDIE 120799 "RTN","C0CSUB1",36,0) 120800 N C0CJ S C0CJ="" 120801 "RTN","C0CSUB1",37,0) 120802 F S C0CJ=$O(@C0CCHK@(DFN,"DOMAIN",C0CJ)) Q:C0CJ="" D ; FOR EACH DOMAIN 120803 "RTN","C0CSUB1",38,0) 120804 . S C0CD=$O(^C0CDIC(170.101,"B",C0CJ,"")) 120805 "RTN","C0CSUB1",39,0) 120806 . W C0CJ," ",C0CD,! 120807 "RTN","C0CSUB1",40,0) 120808 . S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",.01)=C0CD 120809 "RTN","C0CSUB1",41,0) 120810 . S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",1)=@C0CCHK@(DFN,"DOMAIN",C0CJ) 120811 "RTN","C0CSUB1",42,0) 120812 . D UPDIE 120813 "RTN","C0CSUB1",43,0) 120967 "RTN","C0CSUB1",61,0) 120968 S C0CFDA(C0CSFS,"+1,"_C0CPAT_",",.01)=C0CSS ; C0CSS IS A POINTER 120969 "RTN","C0CSUB1",62,0) 120970 D UPDIE ; ADD THE SUBSCRIPTION 120971 "RTN","C0CSUB1",63,0) 120972 D CHK1(DFN) ; ADD THE CHECKSUMS 120973 "RTN","C0CSUB1",64,0) 120814 120974 Q 120815 "RTN","C0CSUB1", 44,0)120816 ; 120817 "RTN","C0CSUB1", 45,0)120818 SUBALL ; SUBSCRIBE ALL PATIENTS IN CCR GLOBALS TO SUBCRIBER 1 120819 "RTN","C0CSUB1", 46,0)120820 ;120821 "RTN","C0CSUB1", 47,0)120822 S C0CGLB=$NA(^TMP("C0CRIM","VARS"))120823 "RTN","C0CSUB1", 48,0)120824 S C0CI=""120825 "RTN","C0CSUB1", 49,0)120826 F S C0CI=$O(@C0CGLB@(C0CI)) Q:C0CI="" D ; FOR EACH PATIENT120827 "RTN","C0CSUB1", 50,0)120828 . D SUB1(C0CI,1) ;SUBSCIRBE THEM TO EPCRN120829 "RTN","C0CSUB1", 51,0)120975 "RTN","C0CSUB1",65,0) 120976 ; 120977 "RTN","C0CSUB1",66,0) 120978 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 120979 "RTN","C0CSUB1",67,0) 120980 K ZERR 120981 "RTN","C0CSUB1",68,0) 120982 D CLEAN^DILF 120983 "RTN","C0CSUB1",69,0) 120984 D UPDATE^DIE("","C0CFDA","","ZERR") 120985 "RTN","C0CSUB1",70,0) 120986 I $D(ZERR) S $EC=",U1," 120987 "RTN","C0CSUB1",71,0) 120988 K C0CFDA 120989 "RTN","C0CSUB1",72,0) 120830 120990 Q 120831 "RTN","C0CSUB1",52,0) 120832 ; 120833 "RTN","C0CSUB1",53,0) 120834 SUB1(DFN,C0CSS) ; SUBSCRIBE ONE PATIENT TO SUBSCRIBER C0CSS 120835 "RTN","C0CSUB1",54,0) 120836 ; 120837 "RTN","C0CSUB1",55,0) 120838 S C0CSF=177.101 ; FILE NUMBER FOR SUBSCRIPTION FILE 120839 "RTN","C0CSUB1",56,0) 120840 S C0CSFS=177.1011 ; FILE NUMBER FOR SUBSCRIPTION SUBFILE 120841 "RTN","C0CSUB1",57,0) 120842 S C0CSFC=177.10121 ; FILE NUMBER FOR CHECKSUMS 120843 "RTN","C0CSUB1",58,0) 120844 S C0CSSF=177.201 ; FILE NUMBER FOR SUBSCRIBER FILE 120845 "RTN","C0CSUB1",59,0) 120846 K C0CFDA 120847 "RTN","C0CSUB1",60,0) 120848 S C0CFDA(C0CSF,"+1,",.01)=DFN 120849 "RTN","C0CSUB1",61,0) 120850 D UPDIE ; ADD THE PATIENT 120851 "RTN","C0CSUB1",62,0) 120852 S C0CPAT=$O(^C0CS("B",DFN,"")) ; IEN OF PAT 120853 "RTN","C0CSUB1",63,0) 120854 S C0CFDA(C0CSFS,"+1,"_C0CPAT_",",.01)=C0CSS ; C0CSS IS A POINTER 120855 "RTN","C0CSUB1",64,0) 120856 D UPDIE ; ADD THE SUBSCRIPTION 120857 "RTN","C0CSUB1",65,0) 120858 D CHK1(DFN) ; ADD THE CHECKSUMS 120859 "RTN","C0CSUB1",66,0) 120991 "RTN","C0CSUB1",73,0) 120992 ; 120993 "RTN","C0CSUB1",74,0) 120994 VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE 120995 "RTN","C0CSUB1",75,0) 120996 ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO 120997 "RTN","C0CSUB1",76,0) 120998 ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO 120999 "RTN","C0CSUB1",77,0) 121000 ; 121001 "RTN","C0CSUB1",78,0) 121002 N ZCCRD,ZVARN,C0CFDA2 121003 "RTN","C0CSUB1",79,0) 121004 S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY 121005 "RTN","C0CSUB1",80,0) 121006 S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE 121007 "RTN","C0CSUB1",81,0) 121008 I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT 121009 "RTN","C0CSUB1",82,0) 121010 . I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE 121011 "RTN","C0CSUB1",83,0) 121012 . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,! 121013 "RTN","C0CSUB1",84,0) 121014 . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE 121015 "RTN","C0CSUB1",85,0) 121016 . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE 121017 "RTN","C0CSUB1",86,0) 121018 . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN 121019 "RTN","C0CSUB1",87,0) 121020 . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY 121021 "RTN","C0CSUB1",88,0) 121022 . I $D(ZERR) D ; LAYGO ERROR 121023 "RTN","C0CSUB1",89,0) 121024 . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",! 121025 "RTN","C0CSUB1",90,0) 121026 . E D ; 121027 "RTN","C0CSUB1",91,0) 121028 . . D CLEAN^DILF ; CLEAN UP 121029 "RTN","C0CSUB1",92,0) 121030 . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE 121031 "RTN","C0CSUB1",93,0) 121032 . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,! 121033 "RTN","C0CSUB1",94,0) 121034 Q ZVARN 121035 "RTN","C0CSUB1",95,0) 121036 ; 121037 "RTN","C0CSUB1",96,0) 121038 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN 121039 "RTN","C0CSUB1",97,0) 121040 ; TO SET TO VALUE C0CSV. 121041 "RTN","C0CSUB1",98,0) 121042 ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE 121043 "RTN","C0CSUB1",99,0) 121044 ; C0CSN,C0CSV ARE PASSED BY VALUE 121045 "RTN","C0CSUB1",100,0) 121046 ; 121047 "RTN","C0CSUB1",101,0) 121048 N C0CSI,C0CSJ 121049 "RTN","C0CSUB1",102,0) 121050 S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER 121051 "RTN","C0CSUB1",103,0) 121052 S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER 121053 "RTN","C0CSUB1",104,0) 121054 S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV 121055 "RTN","C0CSUB1",105,0) 120860 121056 Q 120861 "RTN","C0CSUB1",67,0)120862 ;120863 "RTN","C0CSUB1",68,0)120864 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS120865 "RTN","C0CSUB1",69,0)120866 K ZERR120867 "RTN","C0CSUB1",70,0)120868 D CLEAN^DILF120869 "RTN","C0CSUB1",71,0)120870 D UPDATE^DIE("","C0CFDA","","ZERR")120871 "RTN","C0CSUB1",72,0)120872 I $D(ZERR) D ;120873 "RTN","C0CSUB1",73,0)120874 . W "ERROR",!120875 "RTN","C0CSUB1",74,0)120876 . ZWR ZERR120877 "RTN","C0CSUB1",75,0)120878 . B120879 "RTN","C0CSUB1",76,0)120880 K C0CFDA120881 "RTN","C0CSUB1",77,0)120882 Q120883 "RTN","C0CSUB1",78,0)120884 ;120885 "RTN","C0CSUB1",79,0)120886 VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE120887 "RTN","C0CSUB1",80,0)120888 ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO120889 "RTN","C0CSUB1",81,0)120890 ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO120891 "RTN","C0CSUB1",82,0)120892 ;120893 "RTN","C0CSUB1",83,0)120894 N ZCCRD,ZVARN,C0CFDA2120895 "RTN","C0CSUB1",84,0)120896 S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY120897 "RTN","C0CSUB1",85,0)120898 S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE120899 "RTN","C0CSUB1",86,0)120900 I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT120901 "RTN","C0CSUB1",87,0)120902 . I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE120903 "RTN","C0CSUB1",88,0)120904 . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!120905 "RTN","C0CSUB1",89,0)120906 . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE120907 "RTN","C0CSUB1",90,0)120908 . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE120909 "RTN","C0CSUB1",91,0)120910 . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN120911 "RTN","C0CSUB1",92,0)120912 . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY120913 "RTN","C0CSUB1",93,0)120914 . I $D(ZERR) D ; LAYGO ERROR120915 "RTN","C0CSUB1",94,0)120916 . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!120917 "RTN","C0CSUB1",95,0)120918 . E D ;120919 "RTN","C0CSUB1",96,0)120920 . . D CLEAN^DILF ; CLEAN UP120921 "RTN","C0CSUB1",97,0)120922 . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE120923 "RTN","C0CSUB1",98,0)120924 . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!120925 "RTN","C0CSUB1",99,0)120926 Q ZVARN120927 "RTN","C0CSUB1",100,0)120928 ;120929 "RTN","C0CSUB1",101,0)120930 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN120931 "RTN","C0CSUB1",102,0)120932 ; TO SET TO VALUE C0CSV.120933 "RTN","C0CSUB1",103,0)120934 ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE120935 "RTN","C0CSUB1",104,0)120936 ; C0CSN,C0CSV ARE PASSED BY VALUE120937 "RTN","C0CSUB1",105,0)120938 ;120939 121057 "RTN","C0CSUB1",106,0) 120940 N C0CSI,C0CSJ 121058 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 120941 121059 "RTN","C0CSUB1",107,0) 120942 S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER121060 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN) 120943 121061 "RTN","C0CSUB1",108,0) 120944 S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER121062 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 120945 121063 "RTN","C0CSUB1",109,0) 120946 S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV121064 I '$D(ZTAB) S ZTAB="C0CA" 120947 121065 "RTN","C0CSUB1",110,0) 120948 Q121066 N ZR 120949 121067 "RTN","C0CSUB1",111,0) 120950 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 121068 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1) 120951 121069 "RTN","C0CSUB1",112,0) 120952 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)121070 E S ZR="" 120953 121071 "RTN","C0CSUB1",113,0) 121072 Q ZR 121073 "RTN","C0CSUB1",114,0) 121074 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED 121075 "RTN","C0CSUB1",115,0) 121076 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN) 121077 "RTN","C0CSUB1",116,0) 120954 121078 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 120955 "RTN","C0CSUB1",11 4,0)121079 "RTN","C0CSUB1",117,0) 120956 121080 I '$D(ZTAB) S ZTAB="C0CA" 120957 "RTN","C0CSUB1",11 5,0)121081 "RTN","C0CSUB1",118,0) 120958 121082 N ZR 120959 "RTN","C0CSUB1",11 6,0)120960 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^", 1)120961 "RTN","C0CSUB1",1 17,0)121083 "RTN","C0CSUB1",119,0) 121084 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2) 121085 "RTN","C0CSUB1",120,0) 120962 121086 E S ZR="" 120963 "RTN","C0CSUB1",1 18,0)121087 "RTN","C0CSUB1",121,0) 120964 121088 Q ZR 120965 "RTN","C0CSUB1",119,0) 120966 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED 120967 "RTN","C0CSUB1",120,0) 120968 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN) 120969 "RTN","C0CSUB1",121,0) 121089 "RTN","C0CSUB1",122,0) 121090 ; 121091 "RTN","C0CSUB1",123,0) 121092 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED 121093 "RTN","C0CSUB1",124,0) 121094 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN) 121095 "RTN","C0CSUB1",125,0) 120970 121096 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 120971 "RTN","C0CSUB1",12 2,0)121097 "RTN","C0CSUB1",126,0) 120972 121098 I '$D(ZTAB) S ZTAB="C0CA" 120973 "RTN","C0CSUB1",12 3,0)121099 "RTN","C0CSUB1",127,0) 120974 121100 N ZR 120975 "RTN","C0CSUB1",12 4,0)120976 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^", 2)120977 "RTN","C0CSUB1",12 5,0)121101 "RTN","C0CSUB1",128,0) 121102 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3) 121103 "RTN","C0CSUB1",129,0) 120978 121104 E S ZR="" 120979 "RTN","C0CSUB1",1 26,0)121105 "RTN","C0CSUB1",130,0) 120980 121106 Q ZR 120981 "RTN","C0CSUB1",127,0)120982 ;120983 "RTN","C0CSUB1",128,0)120984 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED120985 "RTN","C0CSUB1",129,0)120986 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)120987 "RTN","C0CSUB1",130,0)120988 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA120989 121107 "RTN","C0CSUB1",131,0) 120990 I '$D(ZTAB) S ZTAB="C0CA"120991 "RTN","C0CSUB1",132,0)120992 N ZR120993 "RTN","C0CSUB1",133,0)120994 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)120995 "RTN","C0CSUB1",134,0)120996 E S ZR=""120997 "RTN","C0CSUB1",135,0)120998 Q ZR120999 "RTN","C0CSUB1",136,0)121000 121108 ; 121001 121109 "RTN","C0CSYS") 121002 0^56^B3 933593121110 0^56^B3817459 121003 121111 "RTN","C0CSYS",1,0) 121004 121112 C0CSYS ;WV/C0C/SMH - Routine to Get EHR System Information;6JUL2008 121005 121113 "RTN","C0CSYS",2,0) 121006 ;;1.2;C 0C;;May 11, 2012;Build 50121114 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 121007 121115 "RTN","C0CSYS",3,0) 121008 ; Copyright 2008 WorldVistA. Licensed under the terms of the GNU121116 ; Copyright 2008 WorldVistA. 121009 121117 "RTN","C0CSYS",4,0) 121010 ; General Public License See attached copy of the License.121118 ; 121011 121119 "RTN","C0CSYS",5,0) 121012 ; 121120 ; This program is free software: you can redistribute it and/or modify 121013 121121 "RTN","C0CSYS",6,0) 121014 ; This program is free software; you can redistribute it and/or modify121122 ; it under the terms of the GNU Affero General Public License as 121015 121123 "RTN","C0CSYS",7,0) 121016 ; it under the terms of the GNU General Public License as published by121124 ; published by the Free Software Foundation, either version 3 of the 121017 121125 "RTN","C0CSYS",8,0) 121018 ; the Free Software Foundation; either version 2 of the License, or121126 ; License, or (at your option) any later version. 121019 121127 "RTN","C0CSYS",9,0) 121020 ; (at your option) any later version.121128 ; 121021 121129 "RTN","C0CSYS",10,0) 121022 ; 121130 ; This program is distributed in the hope that it will be useful, 121023 121131 "RTN","C0CSYS",11,0) 121024 ; This program is distributed in the hope that it will be useful,121132 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 121025 121133 "RTN","C0CSYS",12,0) 121026 ; but WITHOUT ANY WARRANTY; without even the implied warranty of121134 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 121027 121135 "RTN","C0CSYS",13,0) 121028 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the121136 ; GNU Affero General Public License for more details. 121029 121137 "RTN","C0CSYS",14,0) 121030 ; GNU General Public License for more details.121138 ; 121031 121139 "RTN","C0CSYS",15,0) 121032 ; 121140 ; You should have received a copy of the GNU Affero General Public License 121033 121141 "RTN","C0CSYS",16,0) 121034 ; You should have received a copy of the GNU General Public License along121142 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 121035 121143 "RTN","C0CSYS",17,0) 121036 ; with this program; if not, write to the Free Software Foundation, Inc.,121144 ; 121037 121145 "RTN","C0CSYS",18,0) 121038 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.121146 W "Enter at appropriate points." Q 121039 121147 "RTN","C0CSYS",19,0) 121040 121148 ; 121041 121149 "RTN","C0CSYS",20,0) 121042 W "Enter at appropriate points." Q121150 ; Originally, I was going to use VEPERVER, but VEPERVER 121043 121151 "RTN","C0CSYS",21,0) 121044 ; 121152 ; actually kills ^TMP($J), outputs it to the screen in a user-friendly 121045 121153 "RTN","C0CSYS",22,0) 121046 ; Originally, I was going to use VEPERVER, but VEPERVER121154 ; manner (press any key to continue), 121047 121155 "RTN","C0CSYS",23,0) 121048 ; a ctually kills ^TMP($J), outputs it to the screen in a user-friendly121156 ; and is really a very half finished routine 121049 121157 "RTN","C0CSYS",24,0) 121050 ; manner (press any key to continue),121158 ; 121051 121159 "RTN","C0CSYS",25,0) 121052 ; and is really a very half finished routine121160 ; So for now, I am hard-coding the values. 121053 121161 "RTN","C0CSYS",26,0) 121054 121162 ; 121055 121163 "RTN","C0CSYS",27,0) 121056 ; So for now, I am hard-coding the values. 121164 SYSNAME() ;Get EHR System Name; PUBLIC; Extrinsic 121057 121165 "RTN","C0CSYS",28,0) 121058 ;121166 Q:$G(DUZ("AG"))="I" "RPMS" 121059 121167 "RTN","C0CSYS",29,0) 121060 SYSNAME() ;Get EHR System Name; PUBLIC; Extrinsic 121168 Q "WorldVistA EHR/VOE" 121061 121169 "RTN","C0CSYS",30,0) 121062 Q:$G(DUZ("AG"))="I" "RPMS"121170 ; 121063 121171 "RTN","C0CSYS",31,0) 121064 Q "WorldVistA EHR/VOE" 121172 SYSVER() ;Get EHR System Version; PUBLIC; Extrinsic 121065 121173 "RTN","C0CSYS",32,0) 121066 ;121174 Q "1.0" 121067 121175 "RTN","C0CSYS",33,0) 121068 SYSVER() ;Get EHR System Version; PUBLIC; Extrinsic 121176 ; 121069 121177 "RTN","C0CSYS",34,0) 121070 Q "1.0" 121178 PTST(DFN) ;TEST TO SEE IF PATIENT MERGED OR A TEST PATIENT 121071 121179 "RTN","C0CSYS",35,0) 121072 ;121180 ; DFN = IEN of the Patient to be tested 121073 121181 "RTN","C0CSYS",36,0) 121074 PTST(DFN) ;TEST TO SEE IF PATIENT MERGED OR A TEST PATIENT 121182 ; 1 = Merged or Test Patient 121075 121183 "RTN","C0CSYS",37,0) 121076 ; DFN = IEN of the Patient to be tested121184 ; 0 = Non-test Patient 121077 121185 "RTN","C0CSYS",38,0) 121078 ; 1 = Merged or Test Patient121186 ; 121079 121187 "RTN","C0CSYS",39,0) 121188 I DFN="" Q 0 ; BAD DFN PASSED 121189 "RTN","C0CSYS",40,0) 121190 I $D(^DPT(DFN,-9)) Q 1 ;This patient has been merged 121191 "RTN","C0CSYS",41,0) 121192 I $G(^DPT(DFN,0))="" Q 1 ;Missing zeroth node <---add 121193 "RTN","C0CSYS",42,0) 121194 ; 121195 "RTN","C0CSYS",43,0) 121196 I '$D(CCRTEST) S CCRTEST=1 ; DEFAULT IS THAT WE ARE TESTING 121197 "RTN","C0CSYS",44,0) 121198 I CCRTEST Q 0 ; IF WE ARE TESTING, DON'T REJECT TEST PATIENTS 121199 "RTN","C0CSYS",45,0) 121200 N DIERR,DATA 121201 "RTN","C0CSYS",46,0) 121202 I $$TESTPAT^VADPT(DFN) Q 1 ; QUIT IF IT'S A VA TEST PATIENT 121203 "RTN","C0CSYS",47,0) 121204 S DATA=+$$GET1^DIQ(2,DFN_",",.6,"I") ;Test Patient Indicator 121205 "RTN","C0CSYS",48,0) 121206 ; 1 = Test Patient 121207 "RTN","C0CSYS",49,0) 121080 121208 ; 0 = Non-test Patient 121081 "RTN","C0CSYS",40,0)121082 ;121083 "RTN","C0CSYS",41,0)121084 I DFN="" Q 0 ; BAD DFN PASSED121085 "RTN","C0CSYS",42,0)121086 I $D(^DPT(DFN,-9)) Q 1 ;This patient has been merged121087 "RTN","C0CSYS",43,0)121088 I $G(^DPT(DFN,0))="" Q 1 ;Missing zeroth node <---add121089 "RTN","C0CSYS",44,0)121090 ;121091 "RTN","C0CSYS",45,0)121092 I '$D(CCRTEST) S CCRTEST=1 ; DEFAULT IS THAT WE ARE TESTING121093 "RTN","C0CSYS",46,0)121094 I CCRTEST Q 0 ; IF WE ARE TESTING, DON'T REJECT TEST PATIENTS121095 "RTN","C0CSYS",47,0)121096 N DIERR,DATA121097 "RTN","C0CSYS",48,0)121098 I $$TESTPAT^VADPT(DFN) Q 1 ; QUIT IF IT'S A VA TEST PATIENT121099 "RTN","C0CSYS",49,0)121100 S DATA=+$$GET1^DIQ(2,DFN_",",.6,"I") ;Test Patient Indicator121101 121209 "RTN","C0CSYS",50,0) 121102 ; 1 = Test Patient121210 I DATA Q DATA 121103 121211 "RTN","C0CSYS",51,0) 121104 ; 0 = Non-test Patient121212 S DATA=$$GET1^DIQ(2,DFN_",",.09,"I") ;SSN test 121105 121213 "RTN","C0CSYS",52,0) 121106 I DATA Q DATA121214 D CLEAN^DILF 121107 121215 "RTN","C0CSYS",53,0) 121108 S DATA=$$GET1^DIQ(2,DFN_",",.09,"I") ;SSN test121216 I "Pp"[$E(DATA,$L(DATA),$L(DATA)) Q 0 ;Allow Pseudo SSN 121109 121217 "RTN","C0CSYS",54,0) 121110 D CLEAN^DILF121218 I $E(DATA,1,3)="000" Q 1 121111 121219 "RTN","C0CSYS",55,0) 121112 I "Pp"[$E(DATA,$L(DATA),$L(DATA)) Q 0 ;Allow Pseudo SSN121220 I $E(DATA,1,3)="666" Q 1 121113 121221 "RTN","C0CSYS",56,0) 121114 I $E(DATA,1,3)="000" Q 1121222 Q 0 121115 121223 "RTN","C0CSYS",57,0) 121116 I $E(DATA,1,3)="666" Q 1121117 "RTN","C0CSYS",58,0)121118 Q 0121119 "RTN","C0CSYS",59,0)121120 121224 ; 121121 121225 "RTN","C0CTIU") 121122 0^108^B6 2323461121226 0^108^B68529284 121123 121227 "RTN","C0CTIU",1,0) 121124 121228 C0CTIU ; C0C/ELN - PROCESSING FOR TIU NOTES ; 19/10/2010 121125 121229 "RTN","C0CTIU",2,0) 121126 ;;1.2;C 0C;;May 11, 2012;Build 50121230 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 121127 121231 "RTN","C0CTIU",3,0) 121128 ; 121232 ; (C) ELN 2010 121129 121233 "RTN","C0CTIU",4,0) 121130 121234 ; 121131 121235 "RTN","C0CTIU",5,0) 121236 ; This program is free software: you can redistribute it and/or modify 121237 "RTN","C0CTIU",6,0) 121238 ; it under the terms of the GNU Affero General Public License as 121239 "RTN","C0CTIU",7,0) 121240 ; published by the Free Software Foundation, either version 3 of the 121241 "RTN","C0CTIU",8,0) 121242 ; License, or (at your option) any later version. 121243 "RTN","C0CTIU",9,0) 121244 ; 121245 "RTN","C0CTIU",10,0) 121246 ; This program is distributed in the hope that it will be useful, 121247 "RTN","C0CTIU",11,0) 121248 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 121249 "RTN","C0CTIU",12,0) 121250 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 121251 "RTN","C0CTIU",13,0) 121252 ; GNU Affero General Public License for more details. 121253 "RTN","C0CTIU",14,0) 121254 ; 121255 "RTN","C0CTIU",15,0) 121256 ; You should have received a copy of the GNU Affero General Public License 121257 "RTN","C0CTIU",16,0) 121258 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 121259 "RTN","C0CTIU",17,0) 121260 ; 121261 "RTN","C0CTIU",18,0) 121132 121262 ;ELN - Modified Routine of C0CLABS 121133 "RTN","C0CTIU", 6,0)121263 "RTN","C0CTIU",19,0) 121134 121264 MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT 121135 "RTN","C0CTIU", 7,0)121265 "RTN","C0CTIU",20,0) 121136 121266 ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR 121137 "RTN","C0CTIU", 8,0)121267 "RTN","C0CTIU",21,0) 121138 121268 ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME 121139 "RTN","C0CTIU", 9,0)121269 "RTN","C0CTIU",22,0) 121140 121270 ; MIXML IS THE TEMPLATE TO USE 121141 "RTN","C0CTIU", 10,0)121271 "RTN","C0CTIU",23,0) 121142 121272 ; MOXML IS THE OUTPUT XML ARRAY 121143 "RTN","C0CTIU", 11,0)121273 "RTN","C0CTIU",24,0) 121144 121274 ; DFN IS THE PATIENT RECORD NUMBER 121145 "RTN","C0CTIU", 12,0)121275 "RTN","C0CTIU",25,0) 121146 121276 N C0COXML,C0CO,C0CV,C0CIXML 121147 "RTN","C0CTIU", 13,0)121277 "RTN","C0CTIU",26,0) 121148 121278 I '$D(MIVAR) S C0CV="" ;DEFAULT 121149 "RTN","C0CTIU", 14,0)121279 "RTN","C0CTIU",27,0) 121150 121280 E S C0CV=MIVAR ;PASSED VARIABLE ARRAY 121151 "RTN","C0CTIU", 15,0)121281 "RTN","C0CTIU",28,0) 121152 121282 I '$D(MIXML) S C0CIXML="" ;DEFAULT 121153 "RTN","C0CTIU", 16,0)121283 "RTN","C0CTIU",29,0) 121154 121284 E S C0CIXML=MIXML ;PASSED INPUT XML 121155 "RTN","C0CTIU", 17,0)121285 "RTN","C0CTIU",30,0) 121156 121286 D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK 121157 "RTN","C0CTIU", 18,0)121287 "RTN","C0CTIU",31,0) 121158 121288 I '$D(MOXML) D Q 121159 "RTN","C0CTIU", 19,0)121289 "RTN","C0CTIU",32,0) 121160 121290 . S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT 121161 "RTN","C0CTIU", 20,0)121291 "RTN","C0CTIU",33,0) 121162 121292 . M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT 121163 "RTN","C0CTIU", 21,0)121293 "RTN","C0CTIU",34,0) 121164 121294 E D 121165 "RTN","C0CTIU", 22,0)121295 "RTN","C0CTIU",35,0) 121166 121296 . N C0COOXML 121167 "RTN","C0CTIU", 23,0)121297 "RTN","C0CTIU",36,0) 121168 121298 . S CCRGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) 121169 "RTN","C0CTIU", 24,0)121299 "RTN","C0CTIU",37,0) 121170 121300 . D QUERY^C0CXPATH(CCRGLO,"//ContinuityOfCareRecord/Body/Results","C0CRSXML") 121171 "RTN","C0CTIU", 25,0)121301 "RTN","C0CTIU",38,0) 121172 121302 . S C0COCNT=$O(C0CRSXML(""),-1) 121173 "RTN","C0CTIU", 26,0)121303 "RTN","C0CTIU",39,0) 121174 121304 . S C0CRES=0 121175 "RTN","C0CTIU", 27,0)121305 "RTN","C0CTIU",40,0) 121176 121306 . F S C0CRES=$O(C0COXML(C0CRES)) Q:C0CRES="" D 121177 "RTN","C0CTIU", 28,0)121307 "RTN","C0CTIU",41,0) 121178 121308 . . Q:$G(C0COXML(C0CRES))="<Results>"!($G(C0COXML(C0CRES))="</Results>") 121179 "RTN","C0CTIU", 29,0)121309 "RTN","C0CTIU",42,0) 121180 121310 . . S C0CRSXML(C0COCNT)=$G(C0COXML(C0CRES)) 121181 "RTN","C0CTIU", 30,0)121311 "RTN","C0CTIU",43,0) 121182 121312 . . S C0COCNT=C0COCNT+1 121183 "RTN","C0CTIU", 31,0)121313 "RTN","C0CTIU",44,0) 121184 121314 . S C0CRSXML(C0COCNT)="</Results>" 121185 "RTN","C0CTIU", 32,0)121315 "RTN","C0CTIU",45,0) 121186 121316 . S C0CRSXML(0)=C0COCNT 121187 "RTN","C0CTIU", 33,0)121317 "RTN","C0CTIU",46,0) 121188 121318 . D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") 121189 "RTN","C0CTIU", 34,0)121319 "RTN","C0CTIU",47,0) 121190 121320 . D INSERT^C0CXPATH(CCRGLO,"C0CRSXML","//ContinuityOfCareRecord/Body") 121191 "RTN","C0CTIU", 35,0)121192 ; 121193 "RTN","C0CTIU", 36,0)121321 "RTN","C0CTIU",48,0) 121322 ; 121323 "RTN","C0CTIU",49,0) 121194 121324 S C0CO=MOXML,@C0CO@(0)=0 121195 "RTN","C0CTIU", 37,0)121325 "RTN","C0CTIU",50,0) 121196 121326 K C0CRSXML,C0COCNT,C0COXML,C0CRES 121197 "RTN","C0CTIU", 38,0)121327 "RTN","C0CTIU",51,0) 121198 121328 K C0CCNT 121199 "RTN","C0CTIU", 39,0)121329 "RTN","C0CTIU",52,0) 121200 121330 Q 121201 "RTN","C0CTIU", 40,0)121331 "RTN","C0CTIU",53,0) 121202 121332 RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS 121203 "RTN","C0CTIU", 41,0)121333 "RTN","C0CTIU",54,0) 121204 121334 ; RTN IS PASSED BY REFERENCE 121205 "RTN","C0CTIU", 42,0)121335 "RTN","C0CTIU",55,0) 121206 121336 N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES 121207 "RTN","C0CTIU", 43,0)121337 "RTN","C0CTIU",56,0) 121208 121338 N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE 121209 "RTN","C0CTIU", 44,0)121339 "RTN","C0CTIU",57,0) 121210 121340 I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING 121211 "RTN","C0CTIU", 45,0)121341 "RTN","C0CTIU",58,0) 121212 121342 I RMIXML="" D ; INPUT XML NOT PASSED 121213 "RTN","C0CTIU", 46,0)121343 "RTN","C0CTIU",59,0) 121214 121344 . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE 121215 "RTN","C0CTIU", 47,0)121345 "RTN","C0CTIU",60,0) 121216 121346 . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R") 121217 "RTN","C0CTIU", 48,0)121347 "RTN","C0CTIU",61,0) 121218 121348 . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE 121219 "RTN","C0CTIU", 49,0)121349 "RTN","C0CTIU",62,0) 121220 121350 E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE 121221 "RTN","C0CTIU", 50,0)121351 "RTN","C0CTIU",63,0) 121222 121352 I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED 121223 "RTN","C0CTIU", 51,0)121353 "RTN","C0CTIU",64,0) 121224 121354 . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION 121225 "RTN","C0CTIU", 52,0)121355 "RTN","C0CTIU",65,0) 121226 121356 E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS 121227 "RTN","C0CTIU", 53,0)121357 "RTN","C0CTIU",66,0) 121228 121358 D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE 121229 "RTN","C0CTIU", 54,0)121359 "RTN","C0CTIU",67,0) 121230 121360 D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ 121231 "RTN","C0CTIU", 55,0)121361 "RTN","C0CTIU",68,0) 121232 121362 D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE 121233 "RTN","C0CTIU", 56,0)121363 "RTN","C0CTIU",69,0) 121234 121364 D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT 121235 "RTN","C0CTIU", 57,0)121365 "RTN","C0CTIU",70,0) 121236 121366 I '$D(@C0CV@(0)) D Q ; NO VARS THERE 121237 "RTN","C0CTIU", 58,0)121367 "RTN","C0CTIU",71,0) 121238 121368 . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR 121239 "RTN","C0CTIU", 59,0)121369 "RTN","C0CTIU",72,0) 121240 121370 ; NO RESULTS QUIT 121241 "RTN","C0CTIU", 60,0)121371 "RTN","C0CTIU",73,0) 121242 121372 I @C0CV@(0)=0 S RTN(0)=0 Q 121243 "RTN","C0CTIU", 61,0)121373 "RTN","C0CTIU",74,0) 121244 121374 S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS")) 121245 "RTN","C0CTIU", 62,0)121375 "RTN","C0CTIU",75,0) 121246 121376 K @RIMVARS 121247 "RTN","C0CTIU", 63,0)121377 "RTN","C0CTIU",76,0) 121248 121378 M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH 121249 "RTN","C0CTIU", 64,0)121379 "RTN","C0CTIU",77,0) 121250 121380 N C0CI,C0CIN,C0CJ,C0CJS,C0CJE,C0CJN,C0CMAP,C0CTMAP,C0CTMP 121251 "RTN","C0CTIU", 65,0)121381 "RTN","C0CTIU",78,0) 121252 121382 S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR) 121253 "RTN","C0CTIU", 66,0)121383 "RTN","C0CTIU",79,0) 121254 121384 N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT 121255 "RTN","C0CTIU", 67,0)121385 "RTN","C0CTIU",80,0) 121256 121386 N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA 121257 "RTN","C0CTIU", 68,0)121387 "RTN","C0CTIU",81,0) 121258 121388 N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END 121259 "RTN","C0CTIU", 69,0)121389 "RTN","C0CTIU",82,0) 121260 121390 ; TO IMPROVE PERFORMANCE 121261 "RTN","C0CTIU", 70,0)121391 "RTN","C0CTIU",83,0) 121262 121392 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results> 121263 "RTN","C0CTIU", 71,0)121393 "RTN","C0CTIU",84,0) 121264 121394 F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES 121265 "RTN","C0CTIU", 72,0)121395 "RTN","C0CTIU",85,0) 121266 121396 . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES 121267 "RTN","C0CTIU", 73,0)121397 "RTN","C0CTIU",86,0) 121268 121398 . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST 121269 "RTN","C0CTIU", 74,0)121399 "RTN","C0CTIU",87,0) 121270 121400 . S C0CMAP=$NA(@C0CV@(C0CI)) ; 121271 "RTN","C0CTIU", 75,0)121401 "RTN","C0CTIU",88,0) 121272 121402 . ;MAPPING FOR TEST REQUEST GOES HERE 121273 "RTN","C0CTIU", 76,0)121403 "RTN","C0CTIU",89,0) 121274 121404 . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA 121275 "RTN","C0CTIU", 77,0)121405 "RTN","C0CTIU",90,0) 121276 121406 . ;D QOPEN^C0CXPATH("C0CRBLD",C0CRTMP,C0CIS) ;1ST PART OF XML 121277 "RTN","C0CTIU", 78,0)121407 "RTN","C0CTIU",91,0) 121278 121408 . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test> 121279 "RTN","C0CTIU", 79,0)121409 "RTN","C0CTIU",92,0) 121280 121410 . I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST 121281 "RTN","C0CTIU", 80,0)121411 "RTN","C0CTIU",93,0) 121282 121412 . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS 121283 "RTN","C0CTIU", 81,0)121413 "RTN","C0CTIU",94,0) 121284 121414 . . K C0CTO ; CLEAR OUTPUT VARIABLE 121285 "RTN","C0CTIU", 82,0)121415 "RTN","C0CTIU",95,0) 121286 121416 . . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT 121287 "RTN","C0CTIU", 83,0)121417 "RTN","C0CTIU",96,0) 121288 121418 . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS 121289 "RTN","C0CTIU", 84,0)121419 "RTN","C0CTIU",97,0) 121290 121420 . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS 121291 "RTN","C0CTIU", 85,0)121421 "RTN","C0CTIU",98,0) 121292 121422 . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ; 121293 "RTN","C0CTIU", 86,0)121423 "RTN","C0CTIU",99,0) 121294 121424 . . . D XMAP^C0CTIU1("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP 121295 "RTN","C0CTIU", 87,0)121425 "RTN","C0CTIU",100,0) 121296 121426 . . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE <Test> 121297 "RTN","C0CTIU", 88,0)121427 "RTN","C0CTIU",101,0) 121298 121428 . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;</Test> 121299 "RTN","C0CTIU", 89,0)121429 "RTN","C0CTIU",102,0) 121300 121430 . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML 121301 "RTN","C0CTIU", 90,0)121431 "RTN","C0CTIU",103,0) 121302 121432 . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST 121303 "RTN","C0CTIU", 91,0)121433 "RTN","C0CTIU",104,0) 121304 121434 . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result> 121305 "RTN","C0CTIU", 92,0)121435 "RTN","C0CTIU",105,0) 121306 121436 D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results> 121307 "RTN","C0CTIU", 93,0)121437 "RTN","C0CTIU",106,0) 121308 121438 D BUILD^C0CTIU1("C0CRBLD","RTN") ;RENDER THE XML 121309 "RTN","C0CTIU", 94,0)121439 "RTN","C0CTIU",107,0) 121310 121440 K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE 121311 "RTN","C0CTIU", 95,0)121441 "RTN","C0CTIU",108,0) 121312 121442 Q 121313 "RTN","C0CTIU", 96,0)121314 ; 121315 "RTN","C0CTIU", 97,0)121316 ; 121317 "RTN","C0CTIU", 98,0)121443 "RTN","C0CTIU",109,0) 121444 ; 121445 "RTN","C0CTIU",110,0) 121446 ; 121447 "RTN","C0CTIU",111,0) 121318 121448 EXTRACT(ILXML,DFN,OLXML) ; EXTRACT TIU NOTES INTO THE C0CLVAR GLOBAL 121319 "RTN","C0CTIU", 99,0)121320 ; 121321 "RTN","C0CTIU",1 00,0)121449 "RTN","C0CTIU",112,0) 121450 ; 121451 "RTN","C0CTIU",113,0) 121322 121452 S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS 121323 "RTN","C0CTIU",1 01,0)121453 "RTN","C0CTIU",114,0) 121324 121454 D DT^DILF(,$$GET^C0CPARMS("TIULIMIT"),.C0CTSDT) 121325 "RTN","C0CTIU",1 02,0)121455 "RTN","C0CTIU",115,0) 121326 121456 D DT^DILF(,$$GET^C0CPARMS("TIUSTART"),.C0CTEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM 121327 "RTN","C0CTIU",1 03,0)121328 ; 121329 "RTN","C0CTIU",1 04,0)121457 "RTN","C0CTIU",116,0) 121458 ; 121459 "RTN","C0CTIU",117,0) 121330 121460 S TIUIEN=0,TIUCNT=1 121331 "RTN","C0CTIU",1 05,0)121461 "RTN","C0CTIU",118,0) 121332 121462 F S TIUIEN=$O(^TIU(8925,"C",DFN,TIUIEN)) Q:TIUIEN="" D 121333 "RTN","C0CTIU",1 06,0)121463 "RTN","C0CTIU",119,0) 121334 121464 . S TIUY="",TIUDA=TIUIEN,ACTION="VIEW",U="^" 121335 "RTN","C0CTIU",1 07,0)121465 "RTN","C0CTIU",120,0) 121336 121466 . ;SELECT ONLY COMPLETED NOTES 121337 "RTN","C0CTIU",1 08,0)121467 "RTN","C0CTIU",121,0) 121338 121468 . Q:$P(^TIU(8925,TIUIEN,0),U,5)="" 121339 "RTN","C0CTIU",1 09,0)121469 "RTN","C0CTIU",122,0) 121340 121470 . Q:$P(^TIU(8925.6,$P(^TIU(8925,TIUIEN,0),U,5),0),U)'="COMPLETED" 121341 "RTN","C0CTIU",1 10,0)121471 "RTN","C0CTIU",123,0) 121342 121472 . ;VALIDATE ON SIGNATURE DATE #1501 121343 "RTN","C0CTIU",1 11,0)121473 "RTN","C0CTIU",124,0) 121344 121474 . Q:$P(^TIU(8925,TIUIEN,15),U)<C0CTSDT!($P(^TIU(8925,TIUIEN,15),U)>C0CTEDT) 121345 "RTN","C0CTIU",1 12,0)121475 "RTN","C0CTIU",125,0) 121346 121476 . D TGET(TIUY,TIUIEN,ACTION,TIUCNT) 121347 "RTN","C0CTIU",1 13,0)121477 "RTN","C0CTIU",126,0) 121348 121478 . S TIUCNT=TIUCNT+1 121349 "RTN","C0CTIU",1 14,0)121479 "RTN","C0CTIU",127,0) 121350 121480 ;ELN K @C0CLB ; CLEAR OUT OLD VARS IF ANY 121351 "RTN","C0CTIU",1 15,0)121481 "RTN","C0CTIU",128,0) 121352 121482 N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG 121353 "RTN","C0CTIU",1 16,0)121483 "RTN","C0CTIU",129,0) 121354 121484 S C0CQT=1 ; SURPRESS LISTING 121355 "RTN","C0CTIU",1 17,0)121485 "RTN","C0CTIU",130,0) 121356 121486 D LIST ; EXTRACT THE VARIABLES 121357 "RTN","C0CTIU",1 18,0)121487 "RTN","C0CTIU",131,0) 121358 121488 K ^TMP("C0CTIU",$J),TIUIEN,TIUCNT,TIUDA,TIUY,C0CLB,C0CTSDT,C0CTEDT 121359 "RTN","C0CTIU",1 19,0)121489 "RTN","C0CTIU",132,0) 121360 121490 S C0CQT=QTSAV ; RESET SILENT FLAG 121361 "RTN","C0CTIU",1 20,0)121491 "RTN","C0CTIU",133,0) 121362 121492 I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS 121363 "RTN","C0CTIU",1 21,0)121493 "RTN","C0CTIU",134,0) 121364 121494 Q 121365 "RTN","C0CTIU",1 22,0)121495 "RTN","C0CTIU",135,0) 121366 121496 ;REUSING from ^TIUSRVR2 121367 "RTN","C0CTIU",1 23,0)121497 "RTN","C0CTIU",136,0) 121368 121498 TGET(TIUY,TIUDA,ACTION,TIUCNT) ; Build ^TMP("TIUVIEW",$J, 121369 "RTN","C0CTIU",1 24,0)121499 "RTN","C0CTIU",137,0) 121370 121500 N TIUL,TIUREC,TIUARR,TIUGDATA,TIUNAME,TIUPRM0,TIUPRM1,X,Y,TIUCPF,ONBROWSE 121371 "RTN","C0CTIU",1 25,0)121501 "RTN","C0CTIU",138,0) 121372 121502 K ^TMP("TIUVIEW",$J),^TMP("TIU FOCUS",$J) 121373 "RTN","C0CTIU",1 26,0)121503 "RTN","C0CTIU",139,0) 121374 121504 S C0CTIU=$NA(^TMP("C0CTIU",$J,TIUCNT)) 121375 "RTN","C0CTIU",1 27,0)121505 "RTN","C0CTIU",140,0) 121376 121506 S ACTION=$G(ACTION,"VIEW"),TIUL=0 121377 "RTN","C0CTIU",1 28,0)121507 "RTN","C0CTIU",141,0) 121378 121508 D SETPARM^TIULE 121379 "RTN","C0CTIU",1 29,0)121509 "RTN","C0CTIU",142,0) 121380 121510 S TIUGDATA=$$SETGDATA^TIUSRVR1(TIUDA) 121381 "RTN","C0CTIU",1 30,0)121511 "RTN","C0CTIU",143,0) 121382 121512 S TIUY=$NA(^TMP("TIUVIEW",$J)) 121383 "RTN","C0CTIU",1 31,0)121513 "RTN","C0CTIU",144,0) 121384 121514 S TIUARR="^TMP(""TIUVIEW"",$J)" 121385 "RTN","C0CTIU",1 32,0)121515 "RTN","C0CTIU",145,0) 121386 121516 I '$D(^TIU(8925,+TIUDA,0)) Q 121387 "RTN","C0CTIU",1 33,0)121517 "RTN","C0CTIU",146,0) 121388 121518 ; Initialize ^TMP("TIU FOCUS",$J) to the entry that has focus 121389 "RTN","C0CTIU",1 34,0)121519 "RTN","C0CTIU",147,0) 121390 121520 S ^TMP("TIU FOCUS",$J)=TIUDA 121391 "RTN","C0CTIU",1 35,0)121521 "RTN","C0CTIU",148,0) 121392 121522 ; Call INQUIRE to get record 121393 "RTN","C0CTIU",1 36,0)121523 "RTN","C0CTIU",149,0) 121394 121524 ;Set a flag to indicate whether or not a Title is a memer of the 121395 "RTN","C0CTIU",1 37,0)121525 "RTN","C0CTIU",150,0) 121396 121526 ;Clinical Procedures Class (1=Yes and 0=No) 121397 "RTN","C0CTIU",1 38,0)121527 "RTN","C0CTIU",151,0) 121398 121528 S TIUCPF=+$$ISA^TIULX(+$G(^TIU(8925,TIUDA,0)),+$$CLASS^TIUCP) 121399 "RTN","C0CTIU",1 39,0)121529 "RTN","C0CTIU",152,0) 121400 121530 ; Call INQUIRE to get record 121401 "RTN","C0CTIU",1 40,0)121531 "RTN","C0CTIU",153,0) 121402 121532 D INQUIRE^TIUSRVR2(TIUDA,.TIUREC,TIUCPF) 121403 "RTN","C0CTIU",1 41,0)121533 "RTN","C0CTIU",154,0) 121404 121534 ; First, load dictation, transcription data, etc. 121405 "RTN","C0CTIU",1 42,0)121535 "RTN","C0CTIU",155,0) 121406 121536 ;D LOADTOP^TIUSRVR1(.TIUREC,TIUDA,.TIUL,TIUGDATA,TIUCPF) 121407 "RTN","C0CTIU",1 43,0)121537 "RTN","C0CTIU",156,0) 121408 121538 ; Next, load the remainder of the record 121409 "RTN","C0CTIU",1 44,0)121539 "RTN","C0CTIU",157,0) 121410 121540 D LOADREC^TIUSRVR2(TIUDA,.TIUL,TIUGDATA,0,ACTION) 121411 "RTN","C0CTIU",1 45,0)121541 "RTN","C0CTIU",158,0) 121412 121542 K ^TMP("TIU FOCUS",$J) 121413 "RTN","C0CTIU",1 46,0)121543 "RTN","C0CTIU",159,0) 121414 121544 ;S VALMCNT=+$G(TIUL) 121415 "RTN","C0CTIU",1 47,0)121545 "RTN","C0CTIU",160,0) 121416 121546 M @C0CTIU@("TIUREC")=TIUREC(8925,TIUDA) 121417 "RTN","C0CTIU",1 48,0)121547 "RTN","C0CTIU",161,0) 121418 121548 M @C0CTIU@("TIUTEXT")=@TIUY 121419 "RTN","C0CTIU",1 49,0)121549 "RTN","C0CTIU",162,0) 121420 121550 K ^TMP("TIUVEW",$J) 121421 "RTN","C0CTIU",150,0)121422 Q121423 "RTN","C0CTIU",151,0)121424 LIST ;EXTRACT THE RESULT VARIABLES TO C0CLB121425 "RTN","C0CTIU",152,0)121426 ;121427 "RTN","C0CTIU",153,0)121428 ;N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR121429 "RTN","C0CTIU",154,0)121430 I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS121431 "RTN","C0CTIU",155,0)121432 I '$D(C0CQT) S C0CQT=0121433 "RTN","C0CTIU",156,0)121434 I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT121435 "RTN","C0CTIU",157,0)121436 S C0CI=""121437 "RTN","C0CTIU",158,0)121438 S @C0CLB@(0)=$O(^TMP("C0CCCR",$J,"RESULTS",""),-1) ; INITALIZE RESULTS VARS COUNT121439 "RTN","C0CTIU",159,0)121440 S C0CCNT=0,C0CTIU=$NA(^TMP("C0CTIU",$J))121441 "RTN","C0CTIU",160,0)121442 F S C0CCNT=$O(@C0CTIU@(C0CCNT)) Q:C0CCNT="" D121443 "RTN","C0CTIU",161,0)121444 . D C0CRES,C0CTRES121445 "RTN","C0CTIU",162,0)121446 K C0CCNT,C0CTIU,C0CI,C0CLI,C0CX1121447 121551 "RTN","C0CTIU",163,0) 121448 121552 Q 121449 121553 "RTN","C0CTIU",164,0) 121554 LIST ;EXTRACT THE RESULT VARIABLES TO C0CLB 121555 "RTN","C0CTIU",165,0) 121556 ; 121557 "RTN","C0CTIU",166,0) 121558 ;N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR 121559 "RTN","C0CTIU",167,0) 121560 I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS 121561 "RTN","C0CTIU",168,0) 121562 I '$D(C0CQT) S C0CQT=0 121563 "RTN","C0CTIU",169,0) 121564 I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT 121565 "RTN","C0CTIU",170,0) 121566 S C0CI="" 121567 "RTN","C0CTIU",171,0) 121568 S @C0CLB@(0)=$O(^TMP("C0CCCR",$J,"RESULTS",""),-1) ; INITALIZE RESULTS VARS COUNT 121569 "RTN","C0CTIU",172,0) 121570 S C0CCNT=0,C0CTIU=$NA(^TMP("C0CTIU",$J)) 121571 "RTN","C0CTIU",173,0) 121572 F S C0CCNT=$O(@C0CTIU@(C0CCNT)) Q:C0CCNT="" D 121573 "RTN","C0CTIU",174,0) 121574 . D C0CRES,C0CTRES 121575 "RTN","C0CTIU",175,0) 121576 K C0CCNT,C0CTIU,C0CI,C0CLI,C0CX1 121577 "RTN","C0CTIU",176,0) 121578 Q 121579 "RTN","C0CTIU",177,0) 121450 121580 C0CRES ;SET TITLE NAME PART EQUIVALENT TO TEST NAME PART 121451 "RTN","C0CTIU",1 65,0)121581 "RTN","C0CTIU",178,0) 121452 121582 N XV 121453 "RTN","C0CTIU",1 66,0)121583 "RTN","C0CTIU",179,0) 121454 121584 S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT 121455 "RTN","C0CTIU",1 67,0)121585 "RTN","C0CTIU",180,0) 121456 121586 S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT 121457 "RTN","C0CTIU",1 68,0)121587 "RTN","C0CTIU",181,0) 121458 121588 S XV("RESULTOBJECTID")="RESULT_"_C0CLI 121459 "RTN","C0CTIU",1 69,0)121589 "RTN","C0CTIU",182,0) 121460 121590 S C0CX1=$G(@C0CTIU@(C0CCNT,"TIUREC",1502)) 121461 "RTN","C0CTIU",1 70,0)121591 "RTN","C0CTIU",183,0) 121462 121592 S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$O(^VA(200,"B",$G(C0CX1),0)) 121463 "RTN","C0CTIU",1 71,0)121593 "RTN","C0CTIU",184,0) 121464 121594 S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL($$C0CDATE^C0CTIU1($G(@C0CTIU@(C0CCNT,"TIUREC",1501))),"DT") 121465 "RTN","C0CTIU",1 72,0)121595 "RTN","C0CTIU",185,0) 121466 121596 S XV("RESULTCODE")="" 121467 "RTN","C0CTIU",1 73,0)121597 "RTN","C0CTIU",186,0) 121468 121598 S XV("RESULTCODINGSYSTEM")="" 121469 "RTN","C0CTIU",1 74,0)121599 "RTN","C0CTIU",187,0) 121470 121600 S XV("RESULTSTATUS")="COMPLETED" 121471 "RTN","C0CTIU",1 75,0)121601 "RTN","C0CTIU",188,0) 121472 121602 S XV("RESULTDESCRIPTIONTEXT")="Progress Notes" 121473 "RTN","C0CTIU",1 76,0)121603 "RTN","C0CTIU",189,0) 121474 121604 M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS 121475 "RTN","C0CTIU",1 77,0)121605 "RTN","C0CTIU",190,0) 121476 121606 Q 121477 "RTN","C0CTIU",1 78,0)121607 "RTN","C0CTIU",191,0) 121478 121608 C0CTRES ;SET REPORT TEXT PART EQUIVALENT TO RESULT 121479 "RTN","C0CTIU",1 79,0)121609 "RTN","C0CTIU",192,0) 121480 121610 N XV,C0CLOBX,C0CZG,C0CLB2 121481 "RTN","C0CTIU",1 80,0)121611 "RTN","C0CTIU",193,0) 121482 121612 S C0CLOBX=0 121483 "RTN","C0CTIU",1 81,0)121613 "RTN","C0CTIU",194,0) 121484 121614 S XV("RESULTTESTCODEVALUE")=$G(@C0CTIU@(C0CCNT,"TIUREC",.01)) 121485 "RTN","C0CTIU",1 82,0)121615 "RTN","C0CTIU",195,0) 121486 121616 S XV("RESULTTESTCODINGSYSTEM")="" 121487 "RTN","C0CTIU",1 83,0)121617 "RTN","C0CTIU",196,0) 121488 121618 S XV("RESULTTESTDESCRIPTIONTEXT")=$G(@C0CTIU@(C0CCNT,"TIUREC",.01)) ; DESCRIPTION TEXT 121489 "RTN","C0CTIU",1 84,0)121619 "RTN","C0CTIU",197,0) 121490 121620 S C0CZG="" 121491 "RTN","C0CTIU",1 85,0)121621 "RTN","C0CTIU",198,0) 121492 121622 S XV("RESULTTESTVALUE")="Notes" 121493 "RTN","C0CTIU",1 86,0)121623 "RTN","C0CTIU",199,0) 121494 121624 M XV("RESULTTESTVALUE","WP")=@C0CTIU@(C0CCNT,"TIUTEXT") 121495 "RTN","C0CTIU", 187,0)121625 "RTN","C0CTIU",200,0) 121496 121626 S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS 121497 "RTN","C0CTIU", 188,0)121627 "RTN","C0CTIU",201,0) 121498 121628 S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT 121499 "RTN","C0CTIU", 189,0)121629 "RTN","C0CTIU",202,0) 121500 121630 S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT 121501 "RTN","C0CTIU", 190,0)121631 "RTN","C0CTIU",203,0) 121502 121632 S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX 121503 "RTN","C0CTIU", 191,0)121633 "RTN","C0CTIU",204,0) 121504 121634 S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_$O(^VA(200,$O(^VA(200,"B",$G(C0CX1),0)),2,0)) 121505 "RTN","C0CTIU", 192,0)121635 "RTN","C0CTIU",205,0) 121506 121636 S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID") 121507 "RTN","C0CTIU", 193,0)121637 "RTN","C0CTIU",206,0) 121508 121638 S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL($$C0CDATE^C0CTIU1($G(@C0CTIU@(C0CCNT,"TIUREC",1501))),"DT") 121509 "RTN","C0CTIU", 194,0)121639 "RTN","C0CTIU",207,0) 121510 121640 S XV("RESULTTESTUNITS")="" 121511 "RTN","C0CTIU", 195,0)121641 "RTN","C0CTIU",208,0) 121512 121642 S XV("RESULTTESTFLAG")="" 121513 "RTN","C0CTIU", 196,0)121643 "RTN","C0CTIU",209,0) 121514 121644 S XV("RESULTTESTSTATUSTEXT")="" 121515 "RTN","C0CTIU", 197,0)121645 "RTN","C0CTIU",210,0) 121516 121646 S XV("RESULTTESTNORMALDESCTEXT")="" 121517 "RTN","C0CTIU", 198,0)121647 "RTN","C0CTIU",211,0) 121518 121648 M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES 121519 "RTN","C0CTIU", 199,0)121649 "RTN","C0CTIU",212,0) 121520 121650 Q 121521 121651 "RTN","C0CTIU1") 121522 0^109^B1 0596577121652 0^109^B12758077 121523 121653 "RTN","C0CTIU1",1,0) 121524 121654 C0CTIU1 ; C0C/ELN - PROCESSING FOR TIU NOTES Contd. ; 19/10/2010 121525 121655 "RTN","C0CTIU1",2,0) 121526 ;;1.2;C 0C;;May 11, 2012;Build 50121656 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 121527 121657 "RTN","C0CTIU1",3,0) 121528 121658 ;ELN UTILITY PROGRAM TO SUPPORT C0CTIU 121529 121659 "RTN","C0CTIU1",4,0) 121660 ; (C) ELN 2010. 121661 "RTN","C0CTIU1",5,0) 121662 ; 121663 "RTN","C0CTIU1",6,0) 121664 ; This program is free software: you can redistribute it and/or modify 121665 "RTN","C0CTIU1",7,0) 121666 ; it under the terms of the GNU Affero General Public License as 121667 "RTN","C0CTIU1",8,0) 121668 ; published by the Free Software Foundation, either version 3 of the 121669 "RTN","C0CTIU1",9,0) 121670 ; License, or (at your option) any later version. 121671 "RTN","C0CTIU1",10,0) 121672 ; 121673 "RTN","C0CTIU1",11,0) 121674 ; This program is distributed in the hope that it will be useful, 121675 "RTN","C0CTIU1",12,0) 121676 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 121677 "RTN","C0CTIU1",13,0) 121678 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 121679 "RTN","C0CTIU1",14,0) 121680 ; GNU Affero General Public License for more details. 121681 "RTN","C0CTIU1",15,0) 121682 ; 121683 "RTN","C0CTIU1",16,0) 121684 ; You should have received a copy of the GNU Affero General Public License 121685 "RTN","C0CTIU1",17,0) 121686 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 121687 "RTN","C0CTIU1",18,0) 121688 ; 121689 "RTN","C0CTIU1",19,0) 121530 121690 C0CDATE(EDTE) ; Converts external date to internal date format 121531 "RTN","C0CTIU1", 5,0)121691 "RTN","C0CTIU1",20,0) 121532 121692 ; INPUT : EXTERNAL DATE (TIME IS OPTIONAL) 121533 "RTN","C0CTIU1", 6,0)121693 "RTN","C0CTIU1",21,0) 121534 121694 ; OUTOUT: INTERNAL DATE, STORAGE FORMAT YYYMMMDD 121535 "RTN","C0CTIU1", 7,0)121695 "RTN","C0CTIU1",22,0) 121536 121696 ; (TIME WILL BE RETURNED IF INCLUDED WITH INPUT) 121537 "RTN","C0CTIU1", 8,0)121538 ; 121539 "RTN","C0CTIU1", 9,0)121697 "RTN","C0CTIU1",23,0) 121698 ; 121699 "RTN","C0CTIU1",24,0) 121540 121700 Q:'$D(EDTE) -1 121541 "RTN","C0CTIU1", 10,0)121701 "RTN","C0CTIU1",25,0) 121542 121702 N X,%DT,Y 121543 "RTN","C0CTIU1", 11,0)121703 "RTN","C0CTIU1",26,0) 121544 121704 S X=EDTE 121545 "RTN","C0CTIU1", 12,0)121705 "RTN","C0CTIU1",27,0) 121546 121706 S %DT="TS" 121547 "RTN","C0CTIU1", 13,0)121707 "RTN","C0CTIU1",28,0) 121548 121708 D ^%DT 121549 "RTN","C0CTIU1", 14,0)121709 "RTN","C0CTIU1",29,0) 121550 121710 Q Y 121551 "RTN","C0CTIU1", 15,0)121552 ; 121553 "RTN","C0CTIU1", 16,0)121711 "RTN","C0CTIU1",30,0) 121712 ; 121713 "RTN","C0CTIU1",31,0) 121554 121714 XMAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY 121555 "RTN","C0CTIU1", 17,0)121715 "RTN","C0CTIU1",32,0) 121556 121716 ; AND PUT THE RESULTS IN OXML 121557 "RTN","C0CTIU1", 18,0)121717 "RTN","C0CTIU1",33,0) 121558 121718 N XCNT 121559 "RTN","C0CTIU1", 19,0)121719 "RTN","C0CTIU1",34,0) 121560 121720 I '$D(DEBUG) S DEBUG=0 121561 "RTN","C0CTIU1", 20,0)121721 "RTN","C0CTIU1",35,0) 121562 121722 I '$D(IXML) W "MALFORMED XML PASSED TO MAP",! Q 121563 "RTN","C0CTIU1", 21,0)121723 "RTN","C0CTIU1",36,0) 121564 121724 I '$D(@IXML@(0)) D ; INITIALIZE COUNT 121565 "RTN","C0CTIU1", 22,0)121725 "RTN","C0CTIU1",37,0) 121566 121726 . S XCNT=$O(@IXML@(""),-1) 121567 "RTN","C0CTIU1", 23,0)121727 "RTN","C0CTIU1",38,0) 121568 121728 E S XCNT=@IXML@(0) ;COUNT 121569 "RTN","C0CTIU1", 24,0)121729 "RTN","C0CTIU1",39,0) 121570 121730 I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q 121571 "RTN","C0CTIU1", 25,0)121572 ; 121573 "RTN","C0CTIU1", 26,0)121731 "RTN","C0CTIU1",40,0) 121732 ; 121733 "RTN","C0CTIU1",41,0) 121574 121734 N I,J,TNAM,TVAL,TSTR 121575 "RTN","C0CTIU1", 27,0)121735 "RTN","C0CTIU1",42,0) 121576 121736 S @OXML@(0)=XCNT ; TOTAL LINES IN OUTPUT 121577 "RTN","C0CTIU1", 28,0)121737 "RTN","C0CTIU1",43,0) 121578 121738 F I=1:1:XCNT D ; LOOP THROUGH WHOLE ARRAY 121579 "RTN","C0CTIU1", 29,0)121739 "RTN","C0CTIU1",44,0) 121580 121740 . S @OXML@(I)=@IXML@(I),C0CSLFLG=0 ; COPY THE LINE TO OUTPUT 121581 "RTN","C0CTIU1", 30,0)121741 "RTN","C0CTIU1",45,0) 121582 121742 . I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE? 121583 "RTN","C0CTIU1", 31,0)121743 "RTN","C0CTIU1",46,0) 121584 121744 . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS 121585 "RTN","C0CTIU1", 32,0)121745 "RTN","C0CTIU1",47,0) 121586 121746 . . F J=2:2:10 D Q:$P(@IXML@(I),"@@",J+2)="" ; QUIT IF NO MORE VARS 121587 "RTN","C0CTIU1", 33,0)121747 "RTN","C0CTIU1",48,0) 121588 121748 . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,! H 1 121589 "RTN","C0CTIU1", 34,0)121749 "RTN","C0CTIU1",49,0) 121590 121750 . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME 121591 "RTN","C0CTIU1", 35,0)121751 "RTN","C0CTIU1",50,0) 121592 121752 . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED 121593 "RTN","C0CTIU1", 36,0)121753 "RTN","C0CTIU1",51,0) 121594 121754 . . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP? 121595 "RTN","C0CTIU1", 37,0)121755 "RTN","C0CTIU1",52,0) 121596 121756 . . . . I $D(@INARY@(TNAM,"WP")) D Q 121597 "RTN","C0CTIU1", 38,0)121757 "RTN","C0CTIU1",53,0) 121598 121758 . . . . . D DOWPFLD(I,J) 121599 "RTN","C0CTIU1", 39,0)121759 "RTN","C0CTIU1",54,0) 121600 121760 . . . . I '$D(@INARY@(TNAM,"F")) D ; NOT A SPECIAL FIELD 121601 "RTN","C0CTIU1", 40,0)121761 "RTN","C0CTIU1",55,0) 121602 121762 . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE 121603 "RTN","C0CTIU1", 41,0)121763 "RTN","C0CTIU1",56,0) 121604 121764 . . . . E D DOFLD() ; PROCESS A FIELD ELAN 121605 "RTN","C0CTIU1", 42,0)121765 "RTN","C0CTIU1",57,0) 121606 121766 . . . S TVAL=$$SYMENC^MXMLUTL(TVAL) ;MAKE SURE THE VALUE IS XML SAFE 121607 "RTN","C0CTIU1", 43,0)121767 "RTN","C0CTIU1",58,0) 121608 121768 . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER 121609 "RTN","C0CTIU1", 44,0)121769 "RTN","C0CTIU1",59,0) 121610 121770 . . I $G(C0CSLFLG)=1 M @OXML@(I)=TSTR Q 121611 "RTN","C0CTIU1", 45,0)121771 "RTN","C0CTIU1",60,0) 121612 121772 . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES 121613 "RTN","C0CTIU1", 46,0)121773 "RTN","C0CTIU1",61,0) 121614 121774 . . I DEBUG W TSTR H 1 121615 "RTN","C0CTIU1", 47,0)121775 "RTN","C0CTIU1",62,0) 121616 121776 I DEBUG W "MAPPED",! 121617 "RTN","C0CTIU1", 48,0)121777 "RTN","C0CTIU1",63,0) 121618 121778 K C0CSLFLG 121619 "RTN","C0CTIU1", 49,0)121779 "RTN","C0CTIU1",64,0) 121620 121780 Q 121621 "RTN","C0CTIU1", 50,0)121781 "RTN","C0CTIU1",65,0) 121622 121782 DOWPFLD(I,J) ;WORDPROCESSING FIELD MANIPULATION 121623 "RTN","C0CTIU1", 51,0)121783 "RTN","C0CTIU1",66,0) 121624 121784 N C0CTXCNT 121625 "RTN","C0CTIU1", 52,0)121785 "RTN","C0CTIU1",67,0) 121626 121786 S C0CTXCNT=0 121627 "RTN","C0CTIU1", 53,0)121787 "RTN","C0CTIU1",68,0) 121628 121788 F S C0CTXCNT=$O(@INARY@(TNAM,"WP",C0CTXCNT)) Q:C0CTXCNT="" D 121629 "RTN","C0CTIU1", 54,0)121789 "RTN","C0CTIU1",69,0) 121630 121790 . S TSTR(C0CTXCNT)=TSTR_$G(@INARY@(TNAM,"WP",C0CTXCNT))_$P(@IXML@(I),"@@",J+1) 121631 "RTN","C0CTIU1", 55,0)121791 "RTN","C0CTIU1",70,0) 121632 121792 S C0CSLFLG=1 121633 "RTN","C0CTIU1", 56,0)121793 "RTN","C0CTIU1",71,0) 121634 121794 Q 121635 "RTN","C0CTIU1", 57,0)121795 "RTN","C0CTIU1",72,0) 121636 121796 DOFLD() ;QUIT 121637 "RTN","C0CTIU1", 58,0)121797 "RTN","C0CTIU1",73,0) 121638 121798 Q 121639 "RTN","C0CTIU1", 59,0)121799 "RTN","C0CTIU1",74,0) 121640 121800 BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST 121641 "RTN","C0CTIU1", 60,0)121801 "RTN","C0CTIU1",75,0) 121642 121802 ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST 121643 "RTN","C0CTIU1", 61,0)121803 "RTN","C0CTIU1",76,0) 121644 121804 ; DEST IS CLEARED TO START 121645 "RTN","C0CTIU1", 62,0)121805 "RTN","C0CTIU1",77,0) 121646 121806 ; USES PUSH TO DO THE COPY 121647 "RTN","C0CTIU1", 63,0)121807 "RTN","C0CTIU1",78,0) 121648 121808 N I,WPSEQ 121649 "RTN","C0CTIU1", 64,0)121809 "RTN","C0CTIU1",79,0) 121650 121810 K @BDEST 121651 "RTN","C0CTIU1", 65,0)121811 "RTN","C0CTIU1",80,0) 121652 121812 F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST 121653 "RTN","C0CTIU1", 66,0)121813 "RTN","C0CTIU1",81,0) 121654 121814 . N J,ATMP 121655 "RTN","C0CTIU1", 67,0)121815 "RTN","C0CTIU1",82,0) 121656 121816 . S ATMP=$$ARRAY^C0CXPATH(@BLIST@(I)) 121657 "RTN","C0CTIU1", 68,0)121817 "RTN","C0CTIU1",83,0) 121658 121818 . I $G(DEBUG) W "ATMP=",ATMP,! 121659 "RTN","C0CTIU1", 69,0)121819 "RTN","C0CTIU1",84,0) 121660 121820 . I $G(DEBUG) W @BLIST@(I),! 121661 "RTN","C0CTIU1", 70,0)121821 "RTN","C0CTIU1",85,0) 121662 121822 . F J=$$START^C0CXPATH(@BLIST@(I)):1:$$FINISH^C0CXPATH(@BLIST@(I)) D ; 121663 "RTN","C0CTIU1", 71,0)121823 "RTN","C0CTIU1",86,0) 121664 121824 . . ; FOR EACH LINE IN THIS INSTR 121665 "RTN","C0CTIU1", 72,0)121825 "RTN","C0CTIU1",87,0) 121666 121826 . . I $G(DEBUG) W "BDEST= ",BDEST,! 121667 "RTN","C0CTIU1", 73,0)121827 "RTN","C0CTIU1",88,0) 121668 121828 . . I $G(DEBUG) W "ATMP= ",@ATMP@(J),! 121669 "RTN","C0CTIU1", 74,0)121829 "RTN","C0CTIU1",89,0) 121670 121830 . . I $D(@ATMP@(J,1)),$G(@ATMP@(J))="<Value>@@RESULTTESTVALUE@@</Value>" D Q 121671 "RTN","C0CTIU1", 75,0)121831 "RTN","C0CTIU1",90,0) 121672 121832 . . . S WPSEQ=0 121673 "RTN","C0CTIU1", 76,0)121833 "RTN","C0CTIU1",91,0) 121674 121834 . . . D PUSH^C0CXPATH(BDEST,"<Value>") 121675 "RTN","C0CTIU1", 77,0)121835 "RTN","C0CTIU1",92,0) 121676 121836 . . . F S WPSEQ=$O(@ATMP@(J,WPSEQ)) Q:WPSEQ="" D 121677 "RTN","C0CTIU1", 78,0)121837 "RTN","C0CTIU1",93,0) 121678 121838 . . . . D PUSH^C0CXPATH(BDEST,$$SYMENC^MXMLUTL($$XVAL^C0CXPATH(@ATMP@(J,WPSEQ)))_"
") 121679 "RTN","C0CTIU1", 79,0)121839 "RTN","C0CTIU1",94,0) 121680 121840 . . . D PUSH^C0CXPATH(BDEST,"</Value>") 121681 "RTN","C0CTIU1", 80,0)121841 "RTN","C0CTIU1",95,0) 121682 121842 . . D PUSH^C0CXPATH(BDEST,@ATMP@(J)) 121683 "RTN","C0CTIU1", 81,0)121843 "RTN","C0CTIU1",96,0) 121684 121844 Q 121685 121845 "RTN","C0CUNIT") 121686 0^37^B 43465566121846 0^37^B33370246 121687 121847 "RTN","C0CUNIT",1,0) 121688 121848 C0CUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08 121689 121849 "RTN","C0CUNIT",2,0) 121690 ;;1.2;C 0C;;May 11, 2012;Build 50121850 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 121691 121851 "RTN","C0CUNIT",3,0) 121692 ;Copyright 2008 George Lilly. Licensed under the terms of the GNU121852 ;Copyright 2008 George Lilly. 121693 121853 "RTN","C0CUNIT",4,0) 121694 ; General Public License See attached copy of the License.121854 ; 121695 121855 "RTN","C0CUNIT",5,0) 121696 ; 121856 ; This program is free software: you can redistribute it and/or modify 121697 121857 "RTN","C0CUNIT",6,0) 121698 ; This program is free software; you can redistribute it and/or modify121858 ; it under the terms of the GNU Affero General Public License as 121699 121859 "RTN","C0CUNIT",7,0) 121700 ; it under the terms of the GNU General Public License as published by121860 ; published by the Free Software Foundation, either version 3 of the 121701 121861 "RTN","C0CUNIT",8,0) 121702 ; the Free Software Foundation; either version 2 of the License, or121862 ; License, or (at your option) any later version. 121703 121863 "RTN","C0CUNIT",9,0) 121704 ; (at your option) any later version.121864 ; 121705 121865 "RTN","C0CUNIT",10,0) 121706 ; 121866 ; This program is distributed in the hope that it will be useful, 121707 121867 "RTN","C0CUNIT",11,0) 121708 ; This program is distributed in the hope that it will be useful,121868 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 121709 121869 "RTN","C0CUNIT",12,0) 121710 ; but WITHOUT ANY WARRANTY; without even the implied warranty of121870 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 121711 121871 "RTN","C0CUNIT",13,0) 121712 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the121872 ; GNU Affero General Public License for more details. 121713 121873 "RTN","C0CUNIT",14,0) 121714 ; GNU General Public License for more details.121874 ; 121715 121875 "RTN","C0CUNIT",15,0) 121716 ; 121876 ; You should have received a copy of the GNU Affero General Public License 121717 121877 "RTN","C0CUNIT",16,0) 121718 ; You should have received a copy of the GNU General Public License along121878 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 121719 121879 "RTN","C0CUNIT",17,0) 121720 ; with this program; if not, write to the Free Software Foundation, Inc.,121880 ; 121721 121881 "RTN","C0CUNIT",18,0) 121722 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.121882 W "This is a unit testing library",! 121723 121883 "RTN","C0CUNIT",19,0) 121724 ;121884 W ! 121725 121885 "RTN","C0CUNIT",20,0) 121726 W "This is a unit testing library",!121886 Q 121727 121887 "RTN","C0CUNIT",21,0) 121728 W !121888 ; 121729 121889 "RTN","C0CUNIT",22,0) 121730 Q 121890 ZT(ZARY,BAT,TST) ; private routine to add a test case to the ZARY array 121731 121891 "RTN","C0CUNIT",23,0) 121732 ;121892 ; ZARY IS PASSED BY REFERENCE 121733 121893 "RTN","C0CUNIT",24,0) 121734 ZT(ZARY,BAT,TST) ; private routine to add a test case to the ZARY array121894 ; BAT is a string identifying the test battery 121735 121895 "RTN","C0CUNIT",25,0) 121736 ; ZARY IS PASSED BY REFERENCE121896 ; TST is a test which will evaluate to true or false 121737 121897 "RTN","C0CUNIT",26,0) 121738 ; BAT is a string identifying the test battery121898 ; I '$G(ZARY) D 121739 121899 "RTN","C0CUNIT",27,0) 121740 ; TST is a test which will evaluate to true or false121900 ; . S ZARY(0)=0 ; initially there are no elements 121741 121901 "RTN","C0CUNIT",28,0) 121742 ; I '$G(ZARY) D121902 ; W "GOT HERE LOADING "_TST,! 121743 121903 "RTN","C0CUNIT",29,0) 121744 ; . S ZARY(0)=0 ; initially there are noelements121904 N CNT ; count of array elements 121745 121905 "RTN","C0CUNIT",30,0) 121746 ; W "GOT HERE LOADING "_TST,!121906 S CNT=ZARY(0) ; contains array count 121747 121907 "RTN","C0CUNIT",31,0) 121748 N CNT ; count of array elements121908 S CNT=CNT+1 ; increment count 121749 121909 "RTN","C0CUNIT",32,0) 121750 S CNT=ZARY(0) ; contains array count121910 S ZARY(CNT)=TST ; put the test in the array 121751 121911 "RTN","C0CUNIT",33,0) 121752 S CNT=CNT+1 ; increment count121912 I $D(ZARY(BAT)) D ; NOT THE FIRST TEST IN BATTERY 121753 121913 "RTN","C0CUNIT",34,0) 121754 S ZARY(CNT)=TST ; put the test in the array121914 . N II,TN ; TEMP FOR ENDING TEST IN BATTERY 121755 121915 "RTN","C0CUNIT",35,0) 121756 I $D(ZARY(BAT)) D ; NOT THE FIRST TEST IN BATTERY121916 . S II=$P(ZARY(BAT),"^",2) 121757 121917 "RTN","C0CUNIT",36,0) 121758 . N II,TN ; TEMP FOR ENDING TEST IN BATTERY121918 . S $P(ZARY(BAT),"^",2)=II+1 121759 121919 "RTN","C0CUNIT",37,0) 121760 . S II=$P(ZARY(BAT),"^",2)121920 I '$D(ZARY(BAT)) D ; FIRST TEST IN THIS BATTERY 121761 121921 "RTN","C0CUNIT",38,0) 121762 . S $P(ZARY(BAT),"^",2)=II+1121922 . S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY 121763 121923 "RTN","C0CUNIT",39,0) 121764 I '$D(ZARY(BAT)) D ; FIRST TEST IN THIS BATTERY121924 . S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX 121765 121925 "RTN","C0CUNIT",40,0) 121766 . S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY121926 . ; S TN=$NA(ZARY("TESTS")) 121767 121927 "RTN","C0CUNIT",41,0) 121768 . S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX121928 . ; D PUSH^C0CXPATH(TN,BAT) 121769 121929 "RTN","C0CUNIT",42,0) 121770 . ; S TN=$NA(ZARY("TESTS"))121930 S ZARY(0)=CNT ; update the array counter 121771 121931 "RTN","C0CUNIT",43,0) 121772 . ; D PUSH^C0CXPATH(TN,BAT)121932 Q 121773 121933 "RTN","C0CUNIT",44,0) 121774 S ZARY(0)=CNT ; update the array counter121934 ; 121775 121935 "RTN","C0CUNIT",45,0) 121776 Q 121936 ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference 121777 121937 "RTN","C0CUNIT",46,0) 121778 ;121938 ; ZARY IS PASSED BY NAME 121779 121939 "RTN","C0CUNIT",47,0) 121780 ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference 121940 ; ZARY = name of the root, closed array format (e.g., "^TMP($J)") 121781 121941 "RTN","C0CUNIT",48,0) 121782 ; ZARY IS PASSED BY NAME121942 ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE 121783 121943 "RTN","C0CUNIT",49,0) 121784 ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")121944 K @ZARY 121785 121945 "RTN","C0CUNIT",50,0) 121786 ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE121946 S @ZARY@(0)=0 ; initialize array count 121787 121947 "RTN","C0CUNIT",51,0) 121788 K @ZARY121948 N LINE,LABEL,BODY 121789 121949 "RTN","C0CUNIT",52,0) 121790 S @ZARY@(0)=0 ; initialize array count121950 N INTEST S INTEST=0 ; switch for in the test case section 121791 121951 "RTN","C0CUNIT",53,0) 121792 N LINE,LABEL,BODY121952 N SECTION S SECTION="[anonymous]" ; test case section 121793 121953 "RTN","C0CUNIT",54,0) 121794 N INTEST S INTEST=0 ; switch for in the test case section121954 ; 121795 121955 "RTN","C0CUNIT",55,0) 121796 N SECTION S SECTION="[anonymous]" ; test case section121956 N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D 121797 121957 "RTN","C0CUNIT",56,0) 121798 ;121958 . I LINE?." "1";;><TEST>".E S INTEST=1 ; entering test section 121799 121959 "RTN","C0CUNIT",57,0) 121800 N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D121960 . I LINE?." "1";;><TEMPLATE>".E S INTEST=1 ; entering TEMPLATE section 121801 121961 "RTN","C0CUNIT",58,0) 121802 . I LINE?." "1";;><TEST>".E S INTEST=1 ; entering test section121962 . I LINE?." "1";;></TEST>".E S INTEST=0 ; leaving test section 121803 121963 "RTN","C0CUNIT",59,0) 121804 . I LINE?." "1";;><TEMPLATE>".E S INTEST=1 ; entering TEMPLATE section121964 . I LINE?." "1";;></TEMPLATE>".E S INTEST=0 ; leaving TEMPLATE section 121805 121965 "RTN","C0CUNIT",60,0) 121806 . I LINE?." "1";;></TEST>".E S INTEST=0 ; leaving testsection121966 . I INTEST D ; within the testing section 121807 121967 "RTN","C0CUNIT",61,0) 121808 . I LINE?." "1";;></TEMPLATE>".E S INTEST=0 ; leaving TEMPLATE section121968 . . I LINE?." "1";;><".E D ; section name found 121809 121969 "RTN","C0CUNIT",62,0) 121810 . I INTEST D ; within the testing section121970 . . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name 121811 121971 "RTN","C0CUNIT",63,0) 121812 . . I LINE?." "1";;><".E D ; section name found121972 . . I LINE?." "1";;>>".E D ; test case found 121813 121973 "RTN","C0CUNIT",64,0) 121814 . . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name121974 . . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array 121815 121975 "RTN","C0CUNIT",65,0) 121816 . . I LINE?." "1";;>>".E D ; test case found121976 S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL 121817 121977 "RTN","C0CUNIT",66,0) 121818 . . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array121978 Q 121819 121979 "RTN","C0CUNIT",67,0) 121820 S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL121980 ; 121821 121981 "RTN","C0CUNIT",68,0) 121822 Q 121982 ZTEST(ZARY,WHICH) ; try out the tests using a passed array ZTEST 121823 121983 "RTN","C0CUNIT",69,0) 121824 ;121984 N ZI,ZX,ZR,ZP 121825 121985 "RTN","C0CUNIT",70,0) 121826 ZTEST(ZARY,WHICH) ; try out the tests using a passed array ZTEST 121986 S DEBUG=0 121827 121987 "RTN","C0CUNIT",71,0) 121828 N ZI,ZX,ZR,ZP121988 ; I WHICH="ALL" D Q ; RUN ALL THE TESTS 121829 121989 "RTN","C0CUNIT",72,0) 121830 S DEBUG=0121990 ; . W "DOING ALL",! 121831 121991 "RTN","C0CUNIT",73,0) 121832 ; I WHICH="ALL" D Q ; RUN ALL THE TESTS121992 ; . N J,NT 121833 121993 "RTN","C0CUNIT",74,0) 121834 ; . W "DOING ALL",!121994 ; . S NT=$NA(ZARY("TESTS")) 121835 121995 "RTN","C0CUNIT",75,0) 121836 ; . N J,NT121996 ; . W NT,@NT@(0),! 121837 121997 "RTN","C0CUNIT",76,0) 121838 ; . S NT=$NA(ZARY("TESTS"))121998 ; . F J=1:1:@NT@(0) D ; 121839 121999 "RTN","C0CUNIT",77,0) 121840 ; . W NT,@NT@(0),!122000 ; . . W @NT@(J),! 121841 122001 "RTN","C0CUNIT",78,0) 121842 ; . F J=1:1:@NT@(0) D ;122002 ; . . D ZTEST^C0CUNIT(@ZARY,@NT@(J)) 121843 122003 "RTN","C0CUNIT",79,0) 121844 ; . . W @NT@(J),!122004 I '$D(ZARY(WHICH)) D Q ; TEST SECTION DOESN'T EXIST 121845 122005 "RTN","C0CUNIT",80,0) 121846 ; . . D ZTEST^C0CUNIT(@ZARY,@NT@(J))122006 . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,! 121847 122007 "RTN","C0CUNIT",81,0) 121848 I '$D(ZARY(WHICH)) D Q ; TEST SECTION DOESN'T EXIST122008 N FIRST,LAST 121849 122009 "RTN","C0CUNIT",82,0) 121850 . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!122010 S FIRST=$P(ZARY(WHICH),"^",1) 121851 122011 "RTN","C0CUNIT",83,0) 121852 N FIRST,LAST122012 S LAST=$P(ZARY(WHICH),"^",2) 121853 122013 "RTN","C0CUNIT",84,0) 121854 S FIRST=$P(ZARY(WHICH),"^",1)122014 F ZI=FIRST:1:LAST D 121855 122015 "RTN","C0CUNIT",85,0) 121856 S LAST=$P(ZARY(WHICH),"^",2)122016 . I ZARY(ZI)?1">"1.E D ; NOT A TEST, JUST RUN THE STATEMENT 121857 122017 "RTN","C0CUNIT",86,0) 121858 F ZI=FIRST:1:LAST D122018 . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI))) 121859 122019 "RTN","C0CUNIT",87,0) 121860 . I ZARY(ZI)?1">"1.E D ; NOT A TEST, JUST RUN THE STATEMENT122020 . . ; W ZP,! 121861 122021 "RTN","C0CUNIT",88,0) 121862 . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))122022 . . S ZX=ZP 121863 122023 "RTN","C0CUNIT",89,0) 121864 . . ; W ZP,!122024 . . W "RUNNING: "_ZP 121865 122025 "RTN","C0CUNIT",90,0) 121866 . . S ZX=ZP122026 . . X ZX 121867 122027 "RTN","C0CUNIT",91,0) 121868 . . W "RUNNING: "_ZP122028 . . W "..SUCCESS: ",WHICH,! 121869 122029 "RTN","C0CUNIT",92,0) 121870 . . X ZX122030 . I ZARY(ZI)?1"?"1.E D ; THIS IS A TEST 121871 122031 "RTN","C0CUNIT",93,0) 121872 . . W "..SUCCESS: ",WHICH,!122032 . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI))) 121873 122033 "RTN","C0CUNIT",94,0) 121874 . I ZARY(ZI)?1"?"1.E D ; THIS IS A TEST122034 . . S ZX="S ZR="_ZP 121875 122035 "RTN","C0CUNIT",95,0) 121876 . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))122036 . . W "TRYING: "_ZP 121877 122037 "RTN","C0CUNIT",96,0) 121878 . . S ZX="S ZR="_ZP122038 . . X ZX 121879 122039 "RTN","C0CUNIT",97,0) 121880 . . W "TRYING: "_ZP122040 . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),! 121881 122041 "RTN","C0CUNIT",98,0) 121882 . . X ZX122042 . . I '$D(TPASSED) D ; NOT INITIALIZED YET 121883 122043 "RTN","C0CUNIT",99,0) 121884 . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!122044 . . . S TPASSED=0 S TFAILED=0 121885 122045 "RTN","C0CUNIT",100,0) 121886 . . I '$D(TPASSED) D ; NOT INITIALIZED YET122046 . . I ZR S TPASSED=TPASSED+1 121887 122047 "RTN","C0CUNIT",101,0) 121888 . . . S TPASSED=0 S TFAILED=0122048 . . I 'ZR S TFAILED=TFAILED+1 121889 122049 "RTN","C0CUNIT",102,0) 121890 . . I ZR S TPASSED=TPASSED+1122050 Q 121891 122051 "RTN","C0CUNIT",103,0) 121892 . . I 'ZR S TFAILED=TFAILED+1122052 ; 121893 122053 "RTN","C0CUNIT",104,0) 121894 Q 122054 TEST ; RUN ALL THE TEST CASES 121895 122055 "RTN","C0CUNIT",105,0) 121896 ;122056 N ZTMP 121897 122057 "RTN","C0CUNIT",106,0) 121898 TEST ; RUN ALL THE TEST CASES 122058 D ZLOAD(.ZTMP) 121899 122059 "RTN","C0CUNIT",107,0) 121900 N ZTMP122060 D ZTEST(.ZTMP,"ALL") 121901 122061 "RTN","C0CUNIT",108,0) 121902 D ZLOAD(.ZTMP)122062 W "PASSED: ",TPASSED,! 121903 122063 "RTN","C0CUNIT",109,0) 121904 D ZTEST(.ZTMP,"ALL")122064 W "FAILED: ",TFAILED,! 121905 122065 "RTN","C0CUNIT",110,0) 121906 W "PASSED: ",TPASSED,!122066 W ! 121907 122067 "RTN","C0CUNIT",111,0) 121908 W "FAILED: ",TFAILED,!122068 W "THE TESTS!",! 121909 122069 "RTN","C0CUNIT",112,0) 121910 W !122070 ; I DEBUG ZWR ZTMP 121911 122071 "RTN","C0CUNIT",113,0) 121912 W "THE TESTS!",!122072 Q 121913 122073 "RTN","C0CUNIT",114,0) 121914 ; I DEBUG ZWR ZTMP122074 ; 121915 122075 "RTN","C0CUNIT",115,0) 121916 Q 122076 GTSTS(GTZARY,RTN) ; return an array of test names 121917 122077 "RTN","C0CUNIT",116,0) 121918 ;122078 N I,J S I="" S I=$O(GTZARY("TESTS",I)) 121919 122079 "RTN","C0CUNIT",117,0) 121920 GTSTS(GTZARY,RTN) ; return an array of test names 122080 F J=0:0 Q:I="" D 121921 122081 "RTN","C0CUNIT",118,0) 121922 N I,J S I="" S I=$O(GTZARY("TESTS",I))122082 . D PUSH^C0CXPATH(RTN,I) 121923 122083 "RTN","C0CUNIT",119,0) 121924 F J=0:0 Q:I="" D122084 . S I=$O(GTZARY("TESTS",I)) 121925 122085 "RTN","C0CUNIT",120,0) 121926 . D PUSH^C0CXPATH(RTN,I)122086 Q 121927 122087 "RTN","C0CUNIT",121,0) 121928 . S I=$O(GTZARY("TESTS",I))122088 ; 121929 122089 "RTN","C0CUNIT",122,0) 121930 Q 122090 TESTALL(RNM) ; RUN ALL THE TESTS 121931 122091 "RTN","C0CUNIT",123,0) 121932 ;122092 N ZI,J,TZTMP,TSTS,TOTP,TOTF 121933 122093 "RTN","C0CUNIT",124,0) 121934 TESTALL(RNM) ; RUN ALL THE TESTS 122094 S TOTP=0 S TOTF=0 121935 122095 "RTN","C0CUNIT",125,0) 121936 N ZI,J,TZTMP,TSTS,TOTP,TOTF122096 D ZLOAD^C0CUNIT("TZTMP",RNM) 121937 122097 "RTN","C0CUNIT",126,0) 121938 S TOTP=0 S TOTF=0122098 D GTSTS(.TZTMP,"TSTS") 121939 122099 "RTN","C0CUNIT",127,0) 121940 D ZLOAD^C0CUNIT("TZTMP",RNM)122100 F ZI=1:1:TSTS(0) D ; 121941 122101 "RTN","C0CUNIT",128,0) 121942 D GTSTS(.TZTMP,"TSTS")122102 . S TPASSED=0 S TFAILED=0 121943 122103 "RTN","C0CUNIT",129,0) 121944 F ZI=1:1:TSTS(0) D ;122104 . D ZTEST^C0CUNIT(.TZTMP,TSTS(ZI)) 121945 122105 "RTN","C0CUNIT",130,0) 121946 . S TPASSED=0 S TFAILED=0122106 . S TOTP=TOTP+TPASSED 121947 122107 "RTN","C0CUNIT",131,0) 121948 . D ZTEST^C0CUNIT(.TZTMP,TSTS(ZI))122108 . S TOTF=TOTF+TFAILED 121949 122109 "RTN","C0CUNIT",132,0) 121950 . S TOTP=TOTP+TPASSED122110 . S $P(TSTS(ZI),"^",2)=TPASSED 121951 122111 "RTN","C0CUNIT",133,0) 121952 . S TOTF=TOTF+TFAILED122112 . S $P(TSTS(ZI),"^",3)=TFAILED 121953 122113 "RTN","C0CUNIT",134,0) 121954 . S $P(TSTS(ZI),"^",2)=TPASSED122114 F ZI=1:1:TSTS(0) D ; 121955 122115 "RTN","C0CUNIT",135,0) 121956 . S $P(TSTS(ZI),"^",3)=TFAILED122116 . W "TEST=> ",$P(TSTS(ZI),"^",1) 121957 122117 "RTN","C0CUNIT",136,0) 121958 F ZI=1:1:TSTS(0) D ;122118 . W " PASSED=>",$P(TSTS(ZI),"^",2) 121959 122119 "RTN","C0CUNIT",137,0) 121960 . W "TEST=> ",$P(TSTS(ZI),"^",1)122120 . W " FAILED=>",$P(TSTS(ZI),"^",3),! 121961 122121 "RTN","C0CUNIT",138,0) 121962 . W " PASSED=>",$P(TSTS(ZI),"^",2)122122 W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,! 121963 122123 "RTN","C0CUNIT",139,0) 121964 . W " FAILED=>",$P(TSTS(ZI),"^",3),!122124 Q 121965 122125 "RTN","C0CUNIT",140,0) 121966 W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!122126 ; 121967 122127 "RTN","C0CUNIT",141,0) 121968 Q 122128 TLIST(ZARY) ; LIST ALL THE TESTS 121969 122129 "RTN","C0CUNIT",142,0) 121970 ;122130 ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES 121971 122131 "RTN","C0CUNIT",143,0) 121972 TLIST(ZARY) ; LIST ALL THE TESTS 122132 ; ZARY IS PASSED BY REFERENCE 121973 122133 "RTN","C0CUNIT",144,0) 121974 ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES122134 N I,J,K S I="" S I=$O(ZARY("TESTS",I)) 121975 122135 "RTN","C0CUNIT",145,0) 121976 ; ZARY IS PASSED BY REFERENCE122136 S K=1 121977 122137 "RTN","C0CUNIT",146,0) 121978 N I,J,K S I="" S I=$O(ZARY("TESTS",I))122138 F J=0:0 Q:I="" D 121979 122139 "RTN","C0CUNIT",147,0) 121980 S K=1122140 . ; W "I IS NOW=",I,! 121981 122141 "RTN","C0CUNIT",148,0) 121982 F J=0:0 Q:I="" D122142 . W I," " 121983 122143 "RTN","C0CUNIT",149,0) 121984 . ; W "I IS NOW=",I,!122144 . S I=$O(ZARY("TESTS",I)) 121985 122145 "RTN","C0CUNIT",150,0) 121986 . W I," "122146 . S K=K+1 I K=6 D 121987 122147 "RTN","C0CUNIT",151,0) 121988 . S I=$O(ZARY("TESTS",I))122148 . . W ! 121989 122149 "RTN","C0CUNIT",152,0) 121990 . S K=K+1 I K=6 D122150 . . S K=1 121991 122151 "RTN","C0CUNIT",153,0) 121992 . . W !122152 Q 121993 122153 "RTN","C0CUNIT",154,0) 121994 . . S K=1122154 ; 121995 122155 "RTN","C0CUNIT",155,0) 121996 Q 122156 MEDS ; 121997 122157 "RTN","C0CUNIT",156,0) 121998 ;122158 N DEBUG S DEBUG=0 121999 122159 "RTN","C0CUNIT",157,0) 122000 MEDS 122160 N DFN S DFN=5685 122001 122161 "RTN","C0CUNIT",158,0) 122002 N DEBUG S DEBUG=0122162 K ^TMP($J) 122003 122163 "RTN","C0CUNIT",159,0) 122004 N DFN S DFN=5685122164 W "Loading CCR Template into T using LOAD^GPLCCR0($NA(^TMP($J,""CCR"")))",!! 122005 122165 "RTN","C0CUNIT",160,0) 122006 K ^TMP($J)122166 N T S T=$NA(^TMP($J,"CCR")) D LOAD^GPLCCR0(T) 122007 122167 "RTN","C0CUNIT",161,0) 122008 W "Loading CCR Template into T using LOAD^GPLCCR0($NA(^TMP($J,""CCR"")))",!!122168 N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications" 122009 122169 "RTN","C0CUNIT",162,0) 122010 N T S T=$NA(^TMP($J,"CCR")) D LOAD^GPLCCR0(T)122170 W "XPATH is: "_XPATH,! 122011 122171 "RTN","C0CUNIT",163,0) 122012 N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"122172 W "Getting Med Template into INXML using",! 122013 122173 "RTN","C0CUNIT",164,0) 122014 W " XPATH is: "_XPATH,!122174 W "QUERY^GPLXPATH(T,XPATH,""INXML"")",!! 122015 122175 "RTN","C0CUNIT",165,0) 122016 W "Getting Med Template into INXML using",!122176 D QUERY^GPLXPATH(T,XPATH,"INXML") 122017 122177 "RTN","C0CUNIT",166,0) 122018 W " QUERY^GPLXPATH(T,XPATH,""INXML"")",!!122178 W "Executing EXTRACT^C0CMED(INXML,DFN,OUTXML)",! 122019 122179 "RTN","C0CUNIT",167,0) 122020 D QUERY^GPLXPATH(T,XPATH,"INXML")122180 W "OUTXML will be ^TMP($J,""OUT"")",! 122021 122181 "RTN","C0CUNIT",168,0) 122022 W "Executing EXTRACT^C0CMED(INXML,DFN,OUTXML)",!122182 N OUTXML S OUTXML=$NA(^TMP($J,"OUT")) 122023 122183 "RTN","C0CUNIT",169,0) 122024 W "OUTXML will be ^TMP($J,""OUT"")",!122184 D EXTRACT^C0CMED6("INXML",DFN,OUTXML) 122025 122185 "RTN","C0CUNIT",170,0) 122026 N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))122186 D FILEOUT^C0CRNF(OUTXML,"TESTMEDS.xml") 122027 122187 "RTN","C0CUNIT",171,0) 122028 D EXTRACT^C0CMED6("INXML",DFN,OUTXML)122188 Q 122029 122189 "RTN","C0CUNIT",172,0) 122030 D FILEOUT^C0CRNF(OUTXML,"TESTMEDS.xml") 122190 PAT ; 122031 122191 "RTN","C0CUNIT",173,0) 122032 Q122192 D ANALYZE^ARJTXRD("C0CDPT",.OUT) ; Analyze a routine in the directory 122033 122193 "RTN","C0CUNIT",174,0) 122034 PAT 122194 N X,Y 122035 122195 "RTN","C0CUNIT",175,0) 122036 D ANALYZE^ARJTXRD("C0CDPT",.OUT) ; Analyze a routine in the directory122196 ; Select Patient 122037 122197 "RTN","C0CUNIT",176,0) 122038 N X,Y122198 S DIC=2,DIC(0)="AEMQ" D ^DIC 122039 122199 "RTN","C0CUNIT",177,0) 122040 ; Select Patient122200 ; 122041 122201 "RTN","C0CUNIT",178,0) 122042 S DIC=2,DIC(0)="AEMQ" D ^DIC122202 W "You have selected patient "_Y,!! 122043 122203 "RTN","C0CUNIT",179,0) 122044 ;122204 N I S I=89 F S I=$O(OUT(I)) Q:I="ALINE" D 122045 122205 "RTN","C0CUNIT",180,0) 122046 W "You have selected patient "_Y,!!122206 . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" " 122047 122207 "RTN","C0CUNIT",181,0) 122048 N I S I=89 F S I=$O(OUT(I)) Q:I="ALINE" D122208 . W "valued at " 122049 122209 "RTN","C0CUNIT",182,0) 122050 . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "122210 . W @("$$"_$P(OUT(I,0),"(DFN)")_"^"_"C0CDPT"_"("_$P(Y,"^")_")") 122051 122211 "RTN","C0CUNIT",183,0) 122052 . W "valued at "122212 . W ! 122053 122213 "RTN","C0CUNIT",184,0) 122054 . W @("$$"_$P(OUT(I,0),"(DFN)")_"^"_"C0CDPT"_"("_$P(Y,"^")_")")122055 "RTN","C0CUNIT",185,0)122056 . W !122057 "RTN","C0CUNIT",186,0)122058 122214 Q 122059 122215 "RTN","C0CUTIL") 122060 0^54^B2 7079469122216 0^54^B26410609 122061 122217 "RTN","C0CUTIL",1,0) 122062 122218 C0CUTIL ;WV/C0C/SMH - Various Utilites for generating the CCR/CCD;06/15/08 122063 122219 "RTN","C0CUTIL",2,0) 122064 ;;1.2;C 0C;;May 11, 2012;Build 50122220 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 122065 122221 "RTN","C0CUTIL",3,0) 122066 122222 ;Copyright 2008-2009 Sam Habiel & George Lilly. 122067 122223 "RTN","C0CUTIL",4,0) 122068 ; Licensed under the terms of the GNU122224 ; 122069 122225 "RTN","C0CUTIL",5,0) 122070 ; General Public License See attached copy of the License.122226 ; This program is free software: you can redistribute it and/or modify 122071 122227 "RTN","C0CUTIL",6,0) 122072 ; 122228 ; it under the terms of the GNU Affero General Public License as 122073 122229 "RTN","C0CUTIL",7,0) 122074 ; This program is free software; you can redistribute it and/or modify122230 ; published by the Free Software Foundation, either version 3 of the 122075 122231 "RTN","C0CUTIL",8,0) 122076 ; it under the terms of the GNU General Public License as published by122232 ; License, or (at your option) any later version. 122077 122233 "RTN","C0CUTIL",9,0) 122078 ; the Free Software Foundation; either version 2 of the License, or122234 ; 122079 122235 "RTN","C0CUTIL",10,0) 122080 ; (at your option) any later version.122236 ; This program is distributed in the hope that it will be useful, 122081 122237 "RTN","C0CUTIL",11,0) 122082 ; 122238 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 122083 122239 "RTN","C0CUTIL",12,0) 122084 ; This program is distributed in the hope that it will be useful,122240 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 122085 122241 "RTN","C0CUTIL",13,0) 122086 ; but WITHOUT ANY WARRANTY; without even the implied warranty of122242 ; GNU Affero General Public License for more details. 122087 122243 "RTN","C0CUTIL",14,0) 122088 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the122244 ; 122089 122245 "RTN","C0CUTIL",15,0) 122090 ; GNU General Public License for more details.122246 ; You should have received a copy of the GNU Affero General Public License 122091 122247 "RTN","C0CUTIL",16,0) 122092 ; 122248 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 122093 122249 "RTN","C0CUTIL",17,0) 122094 ; You should have received a copy of the GNU General Public License along122250 ; 122095 122251 "RTN","C0CUTIL",18,0) 122096 ;with this program; if not, write to the Free Software Foundation, Inc.,122252 W "No Entry at Top!" 122097 122253 "RTN","C0CUTIL",19,0) 122098 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.122254 Q 122099 122255 "RTN","C0CUTIL",20,0) 122100 122256 ; 122101 122257 "RTN","C0CUTIL",21,0) 122102 W "No Entry at Top!" 122258 UUID() ; thanks to Wally for this. 122103 122259 "RTN","C0CUTIL",22,0) 122260 N R,I,J,N 122261 "RTN","C0CUTIL",23,0) 122262 S N="",R="" F S N=N_$R(100000) Q:$L(N)>64 122263 "RTN","C0CUTIL",24,0) 122264 F I=1:2:64 S R=R_$E("0123456789abcdef",($E(N,I,I+1)#16+1)) 122265 "RTN","C0CUTIL",25,0) 122266 Q $E(R,1,8)_"-"_$E(R,9,12)_"-4"_$E(R,14,16)_"-"_$E("89ab",$E(N,17)#4+1)_$E(R,18,20)_"-"_$E(R,21,32) 122267 "RTN","C0CUTIL",26,0) 122268 ; 122269 "RTN","C0CUTIL",27,0) 122270 OLDUUID() ; GENERATE A RANDOM UUID (Version 4) 122271 "RTN","C0CUTIL",28,0) 122272 N I,J,ZS 122273 "RTN","C0CUTIL",29,0) 122274 S ZS="0123456789abcdef" S J="" 122275 "RTN","C0CUTIL",30,0) 122276 F I=1:1:36 S J=J_$S((I=9)!(I=14)!(I=19)!(I=24):"-",I=15:4,I=20:"a",1:$E(ZS,$R(16)+1)) 122277 "RTN","C0CUTIL",31,0) 122278 Q J 122279 "RTN","C0CUTIL",32,0) 122280 ; 122281 "RTN","C0CUTIL",33,0) 122282 FMDTOUTC(DATE,FORMAT) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrinsic 122283 "RTN","C0CUTIL",34,0) 122284 ; FORMAT is Format of Date. Can be either D (Day) or DT (Date and Time) 122285 "RTN","C0CUTIL",35,0) 122286 ; If not passed, or passed incorrectly, it's assumed that it is D. 122287 "RTN","C0CUTIL",36,0) 122288 ; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied. 122289 "RTN","C0CUTIL",37,0) 122290 ; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC 122291 "RTN","C0CUTIL",38,0) 122292 ; UTC, Year, Month, Day, Hours, Minutes, Seconds, Time offset (obtained from Mailman Site Parameters) 122293 "RTN","C0CUTIL",39,0) 122294 N UTC,Y,M,D,H,MM,S,OFF,OFFS,OFF0,OFF1,OFF2 122295 "RTN","C0CUTIL",40,0) 122296 S Y=1700+$E(DATE,1,3) 122297 "RTN","C0CUTIL",41,0) 122298 S M=$E(DATE,4,5) 122299 "RTN","C0CUTIL",42,0) 122300 S D=$E(DATE,6,7) 122301 "RTN","C0CUTIL",43,0) 122302 S H=$E(DATE,9,10) 122303 "RTN","C0CUTIL",44,0) 122304 I $L(H)=1 S H="0"_H 122305 "RTN","C0CUTIL",45,0) 122306 S MM=$E(DATE,11,12) 122307 "RTN","C0CUTIL",46,0) 122308 I $L(MM)=1 S MM="0"_MM 122309 "RTN","C0CUTIL",47,0) 122310 S S=$E(DATE,13,14) 122311 "RTN","C0CUTIL",48,0) 122312 I $L(S)=1 S S="0"_S 122313 "RTN","C0CUTIL",49,0) 122314 S OFF=$$TZ^XLFDT ; See Kernel Manual for documentation. 122315 "RTN","C0CUTIL",50,0) 122316 S OFFS=$E(OFF,1,1) 122317 "RTN","C0CUTIL",51,0) 122318 S OFF0=$TR(OFF,"+-") 122319 "RTN","C0CUTIL",52,0) 122320 S OFF1=$E(OFF0+10000,2,3) 122321 "RTN","C0CUTIL",53,0) 122322 S OFF2=$E(OFF0+10000,4,5) 122323 "RTN","C0CUTIL",54,0) 122324 S OFF=OFFS_OFF1_":"_OFF2 122325 "RTN","C0CUTIL",55,0) 122326 ;S OFF2=$E(OFF,1,2) ; 122327 "RTN","C0CUTIL",56,0) 122328 ;S OFF2=$E(100+OFF2,2,3) ; GPL 11/08 CHANGED TO -05:00 FORMAT 122329 "RTN","C0CUTIL",57,0) 122330 ;S OFF3=$E(OFF,3,4) ;MINUTES 122331 "RTN","C0CUTIL",58,0) 122332 ;S OFF=$S(OFF2="":"00",0:"00",1:OFF2)_"."_$S(OFF3="":"00",1:OFF3) 122333 "RTN","C0CUTIL",59,0) 122334 ; If H, MM and S are empty, it means that the FM date didn't supply the time. 122335 "RTN","C0CUTIL",60,0) 122336 ; In this case, set H, MM and S to "00" 122337 "RTN","C0CUTIL",61,0) 122338 ; S:('$L(H)&'$L(MM)&'$L(S)) (H,MM,S)="00" ; IF ONLY SOME ARE MISSING? 122339 "RTN","C0CUTIL",62,0) 122340 S:'$L(H) H="00" 122341 "RTN","C0CUTIL",63,0) 122342 S:'$L(MM) MM="00" 122343 "RTN","C0CUTIL",64,0) 122344 S:'$L(S) S="00" 122345 "RTN","C0CUTIL",65,0) 122346 S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_$S(S="":":00",1:":"_S)_OFF ; Skip's code to fix hanging colon if no seconds 122347 "RTN","C0CUTIL",66,0) 122348 I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time. 122349 "RTN","C0CUTIL",67,0) 122350 E Q $P(UTC,"T") 122351 "RTN","C0CUTIL",68,0) 122352 ; 122353 "RTN","C0CUTIL",69,0) 122354 SORTDT(V1,V2,ORDR) ; DATE SORT ARRAY AND RETURN INDEX IN V1 AND COUNT 122355 "RTN","C0CUTIL",70,0) 122356 ; AS EXTRINSIC ORDR IS 1 OR -1 FOR FORWARD OR REVERSE 122357 "RTN","C0CUTIL",71,0) 122358 ; DATE AND TIME ORDER. DEFAULT IS FORWARD 122359 "RTN","C0CUTIL",72,0) 122360 ; V2 IS AN ARRAY OF DATES IN FILEMAN FORMAT 122361 "RTN","C0CUTIL",73,0) 122362 ; V1 IS RETURNS INDIRECT INDEXES OF V2 IN REVERSE DATE ORDER 122363 "RTN","C0CUTIL",74,0) 122364 ; SO V2(V1(X)) WILL RETURN THE DATES IN DATE/TIME ORDER 122365 "RTN","C0CUTIL",75,0) 122366 ; THE COUNT OF THE DATES IS RETURNED AS AN EXTRINSIC 122367 "RTN","C0CUTIL",76,0) 122368 ; BOTH V1 AND V2 ARE PASSED BY REFERENCE 122369 "RTN","C0CUTIL",77,0) 122370 N VSRT ; TEMP FOR HASHING DATES 122371 "RTN","C0CUTIL",78,0) 122372 N ZI,ZJ,ZTMP,ZCNT,ZP1,ZP2 122373 "RTN","C0CUTIL",79,0) 122374 S ZCNT=V2(0) ; COUNTING NUMBER OF DATES 122375 "RTN","C0CUTIL",80,0) 122376 F ZI=1:1:ZCNT D ; FOR EACH DATE IN THE ARRAY 122377 "RTN","C0CUTIL",81,0) 122378 . I $D(V2(ZI)) D ; IF THE DATE EXISTS 122379 "RTN","C0CUTIL",82,0) 122380 . . S ZP1=$P(V2(ZI),".",1) ; THE DATE PIECE 122381 "RTN","C0CUTIL",83,0) 122382 . . S ZP2=$P(V2(ZI),".",2) ; THE TIME PIECE 122383 "RTN","C0CUTIL",84,0) 122384 . . ; W "DATE: ",ZP1," TIME: ",ZP2,! 122385 "RTN","C0CUTIL",85,0) 122386 . . S VSRT(ZP1,ZP2,ZI)=ZI ; INDEX OF DATE, TIME AND COUNT 122387 "RTN","C0CUTIL",86,0) 122388 N ZG 122389 "RTN","C0CUTIL",87,0) 122390 S ZG=$Q(VSRT("")) 122391 "RTN","C0CUTIL",88,0) 122392 F D Q:ZG="" ; 122393 "RTN","C0CUTIL",89,0) 122394 . ; W ZG,! 122395 "RTN","C0CUTIL",90,0) 122396 . D PUSH^C0CXPATH("V1",@ZG) 122397 "RTN","C0CUTIL",91,0) 122398 . S ZG=$Q(@ZG) 122399 "RTN","C0CUTIL",92,0) 122400 I ORDR=-1 D ; HAVE TO REVERSE ORDER 122401 "RTN","C0CUTIL",93,0) 122402 . N ZG2 122403 "RTN","C0CUTIL",94,0) 122404 . F ZI=1:1:V1(0) D ; FOR EACH ELELMENT 122405 "RTN","C0CUTIL",95,0) 122406 . . S ZG2(V1(0)-ZI+1)=V1(ZI) ; SET IN REVERSE ORDER 122407 "RTN","C0CUTIL",96,0) 122408 . S ZG2(0)=V1(0) 122409 "RTN","C0CUTIL",97,0) 122410 . D CP^C0CXPATH("ZG2","V1") ; COPY OVER THE NEW ARRAY 122411 "RTN","C0CUTIL",98,0) 122412 Q ZCNT 122413 "RTN","C0CUTIL",99,0) 122414 ; 122415 "RTN","C0CUTIL",100,0) 122416 DA2SNO(RTN,DNAME) ; LOOK UP DRUG ALLERGY CODE IN ^LEX 122417 "RTN","C0CUTIL",101,0) 122418 ; RETURNS AN ARRAY RTN PASSED BY REFERENCE 122419 "RTN","C0CUTIL",102,0) 122420 ; THIS ROUTINE CAN BE USED AS AN RPC 122421 "RTN","C0CUTIL",103,0) 122422 ; RTN(0) IS THE NUMBER OF ELEMENTS IN THE ARRAY 122423 "RTN","C0CUTIL",104,0) 122424 ; RTN(1) IS THE SNOMED CODE FOR THE DRUG ALLERGY 122425 "RTN","C0CUTIL",105,0) 122426 ; 122427 "RTN","C0CUTIL",106,0) 122428 N LEXIEN 122429 "RTN","C0CUTIL",107,0) 122430 I $O(^LEX(757.21,"ADIS",DNAME,""))'="" D ; IEN FOUND FOR THIS DRUG 122431 "RTN","C0CUTIL",108,0) 122432 . S LEXIEN=$O(^LEX(757.21,"ADIS",DNAME,"")) ; GET THE IEN IN THE LEXICON 122433 "RTN","C0CUTIL",109,0) 122434 . W LEXIEN,! 122435 "RTN","C0CUTIL",110,0) 122436 . S RTN(1)=$P(^LEX(757.02,LEXIEN,0),"^",2) ; SNOMED CODE IN P2 122437 "RTN","C0CUTIL",111,0) 122438 . S RTN(0)=1 ; ONE THING RETURNED 122439 "RTN","C0CUTIL",112,0) 122440 E S RTN(0)=0 ; NOT FOUND 122441 "RTN","C0CUTIL",113,0) 122104 122442 Q 122105 "RTN","C0CUTIL",23,0)122106 ;122107 "RTN","C0CUTIL",24,0)122108 UUID() ; thanks to Wally for this.122109 "RTN","C0CUTIL",25,0)122110 N R,I,J,N122111 "RTN","C0CUTIL",26,0)122112 S N="",R="" F S N=N_$R(100000) Q:$L(N)>64122113 "RTN","C0CUTIL",27,0)122114 F I=1:2:64 S R=R_$E("0123456789abcdef",($E(N,I,I+1)#16+1))122115 "RTN","C0CUTIL",28,0)122116 Q $E(R,1,8)_"-"_$E(R,9,12)_"-4"_$E(R,14,16)_"-"_$E("89ab",$E(N,17)#4+1)_$E(R,18,20)_"-"_$E(R,21,32)122117 "RTN","C0CUTIL",29,0)122118 ;122119 "RTN","C0CUTIL",30,0)122120 OLDUUID() ; GENERATE A RANDOM UUID (Version 4)122121 "RTN","C0CUTIL",31,0)122122 N I,J,ZS122123 "RTN","C0CUTIL",32,0)122124 S ZS="0123456789abcdef" S J=""122125 "RTN","C0CUTIL",33,0)122126 F I=1:1:36 S J=J_$S((I=9)!(I=14)!(I=19)!(I=24):"-",I=15:4,I=20:"a",1:$E(ZS,$R(16)+1))122127 "RTN","C0CUTIL",34,0)122128 Q J122129 "RTN","C0CUTIL",35,0)122130 ;122131 "RTN","C0CUTIL",36,0)122132 FMDTOUTC(DATE,FORMAT) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrinsic122133 "RTN","C0CUTIL",37,0)122134 ; FORMAT is Format of Date. Can be either D (Day) or DT (Date and Time)122135 "RTN","C0CUTIL",38,0)122136 ; If not passed, or passed incorrectly, it's assumed that it is D.122137 "RTN","C0CUTIL",39,0)122138 ; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied.122139 "RTN","C0CUTIL",40,0)122140 ; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC122141 "RTN","C0CUTIL",41,0)122142 ; UTC, Year, Month, Day, Hours, Minutes, Seconds, Time offset (obtained from Mailman Site Parameters)122143 "RTN","C0CUTIL",42,0)122144 N UTC,Y,M,D,H,MM,S,OFF122145 "RTN","C0CUTIL",43,0)122146 S Y=1700+$E(DATE,1,3)122147 "RTN","C0CUTIL",44,0)122148 S M=$E(DATE,4,5)122149 "RTN","C0CUTIL",45,0)122150 S D=$E(DATE,6,7)122151 "RTN","C0CUTIL",46,0)122152 S H=$E(DATE,9,10)122153 "RTN","C0CUTIL",47,0)122154 I $L(H)=1 S H="0"_H122155 "RTN","C0CUTIL",48,0)122156 S MM=$E(DATE,11,12)122157 "RTN","C0CUTIL",49,0)122158 I $L(MM)=1 S MM="0"_MM122159 "RTN","C0CUTIL",50,0)122160 S S=$E(DATE,13,14)122161 "RTN","C0CUTIL",51,0)122162 I $L(S)=1 S S="0"_S122163 "RTN","C0CUTIL",52,0)122164 S OFF=$$TZ^XLFDT ; See Kernel Manual for documentation.122165 "RTN","C0CUTIL",53,0)122166 S OFFS=$E(OFF,1,1)122167 "RTN","C0CUTIL",54,0)122168 S OFF0=$TR(OFF,"+-")122169 "RTN","C0CUTIL",55,0)122170 S OFF1=$E(OFF0+10000,2,3)122171 "RTN","C0CUTIL",56,0)122172 S OFF2=$E(OFF0+10000,4,5)122173 "RTN","C0CUTIL",57,0)122174 S OFF=OFFS_OFF1_":"_OFF2122175 "RTN","C0CUTIL",58,0)122176 ;S OFF2=$E(OFF,1,2) ;122177 "RTN","C0CUTIL",59,0)122178 ;S OFF2=$E(100+OFF2,2,3) ; GPL 11/08 CHANGED TO -05:00 FORMAT122179 "RTN","C0CUTIL",60,0)122180 ;S OFF3=$E(OFF,3,4) ;MINUTES122181 "RTN","C0CUTIL",61,0)122182 ;S OFF=$S(OFF2="":"00",0:"00",1:OFF2)_"."_$S(OFF3="":"00",1:OFF3)122183 "RTN","C0CUTIL",62,0)122184 ; If H, MM and S are empty, it means that the FM date didn't supply the time.122185 "RTN","C0CUTIL",63,0)122186 ; In this case, set H, MM and S to "00"122187 "RTN","C0CUTIL",64,0)122188 ; S:('$L(H)&'$L(MM)&'$L(S)) (H,MM,S)="00" ; IF ONLY SOME ARE MISSING?122189 "RTN","C0CUTIL",65,0)122190 S:'$L(H) H="00"122191 "RTN","C0CUTIL",66,0)122192 S:'$L(MM) MM="00"122193 "RTN","C0CUTIL",67,0)122194 S:'$L(S) S="00"122195 "RTN","C0CUTIL",68,0)122196 S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_$S(S="":":00",1:":"_S)_OFF ; Skip's code to fix hanging colon if no seconds122197 "RTN","C0CUTIL",69,0)122198 I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time.122199 "RTN","C0CUTIL",70,0)122200 E Q $P(UTC,"T")122201 "RTN","C0CUTIL",71,0)122202 ;122203 "RTN","C0CUTIL",72,0)122204 SORTDT(V1,V2,ORDR) ; DATE SORT ARRAY AND RETURN INDEX IN V1 AND COUNT122205 "RTN","C0CUTIL",73,0)122206 ; AS EXTRINSIC ORDR IS 1 OR -1 FOR FORWARD OR REVERSE122207 "RTN","C0CUTIL",74,0)122208 ; DATE AND TIME ORDER. DEFAULT IS FORWARD122209 "RTN","C0CUTIL",75,0)122210 ; V2 IS AN ARRAY OF DATES IN FILEMAN FORMAT122211 "RTN","C0CUTIL",76,0)122212 ; V1 IS RETURNS INDIRECT INDEXES OF V2 IN REVERSE DATE ORDER122213 "RTN","C0CUTIL",77,0)122214 ; SO V2(V1(X)) WILL RETURN THE DATES IN DATE/TIME ORDER122215 "RTN","C0CUTIL",78,0)122216 ; THE COUNT OF THE DATES IS RETURNED AS AN EXTRINSIC122217 "RTN","C0CUTIL",79,0)122218 ; BOTH V1 AND V2 ARE PASSED BY REFERENCE122219 "RTN","C0CUTIL",80,0)122220 N VSRT ; TEMP FOR HASHING DATES122221 "RTN","C0CUTIL",81,0)122222 N ZI,ZJ,ZTMP,ZCNT,ZP1,ZP2122223 "RTN","C0CUTIL",82,0)122224 S ZCNT=V2(0) ; COUNTING NUMBER OF DATES122225 "RTN","C0CUTIL",83,0)122226 F ZI=1:1:ZCNT D ; FOR EACH DATE IN THE ARRAY122227 "RTN","C0CUTIL",84,0)122228 . I $D(V2(ZI)) D ; IF THE DATE EXISTS122229 "RTN","C0CUTIL",85,0)122230 . . S ZP1=$P(V2(ZI),".",1) ; THE DATE PIECE122231 "RTN","C0CUTIL",86,0)122232 . . S ZP2=$P(V2(ZI),".",2) ; THE TIME PIECE122233 "RTN","C0CUTIL",87,0)122234 . . ; W "DATE: ",ZP1," TIME: ",ZP2,!122235 "RTN","C0CUTIL",88,0)122236 . . S VSRT(ZP1,ZP2,ZI)=ZI ; INDEX OF DATE, TIME AND COUNT122237 "RTN","C0CUTIL",89,0)122238 N ZG122239 "RTN","C0CUTIL",90,0)122240 S ZG=$Q(VSRT(""))122241 "RTN","C0CUTIL",91,0)122242 F D Q:ZG="" ;122243 "RTN","C0CUTIL",92,0)122244 . ; W ZG,!122245 "RTN","C0CUTIL",93,0)122246 . D PUSH^C0CXPATH("V1",@ZG)122247 "RTN","C0CUTIL",94,0)122248 . S ZG=$Q(@ZG)122249 "RTN","C0CUTIL",95,0)122250 I ORDR=-1 D ; HAVE TO REVERSE ORDER122251 "RTN","C0CUTIL",96,0)122252 . N ZG2122253 "RTN","C0CUTIL",97,0)122254 . F ZI=1:1:V1(0) D ; FOR EACH ELELMENT122255 "RTN","C0CUTIL",98,0)122256 . . S ZG2(V1(0)-ZI+1)=V1(ZI) ; SET IN REVERSE ORDER122257 "RTN","C0CUTIL",99,0)122258 . S ZG2(0)=V1(0)122259 "RTN","C0CUTIL",100,0)122260 . D CP^C0CXPATH("ZG2","V1") ; COPY OVER THE NEW ARRAY122261 "RTN","C0CUTIL",101,0)122262 Q ZCNT122263 "RTN","C0CUTIL",102,0)122264 ;122265 "RTN","C0CUTIL",103,0)122266 DA2SNO(RTN,DNAME) ; LOOK UP DRUG ALLERGY CODE IN ^LEX122267 "RTN","C0CUTIL",104,0)122268 ; RETURNS AN ARRAY RTN PASSED BY REFERENCE122269 "RTN","C0CUTIL",105,0)122270 ; THIS ROUTINE CAN BE USED AS AN RPC122271 "RTN","C0CUTIL",106,0)122272 ; RTN(0) IS THE NUMBER OF ELEMENTS IN THE ARRAY122273 "RTN","C0CUTIL",107,0)122274 ; RTN(1) IS THE SNOMED CODE FOR THE DRUG ALLERGY122275 "RTN","C0CUTIL",108,0)122276 ;122277 "RTN","C0CUTIL",109,0)122278 N LEXIEN122279 "RTN","C0CUTIL",110,0)122280 I $O(^LEX(757.21,"ADIS",DNAME,""))'="" D ; IEN FOUND FOR THIS DRUG122281 "RTN","C0CUTIL",111,0)122282 . S LEXIEN=$O(^LEX(757.21,"ADIS",DNAME,"")) ; GET THE IEN IN THE LEXICON122283 "RTN","C0CUTIL",112,0)122284 . W LEXIEN,!122285 "RTN","C0CUTIL",113,0)122286 . S RTN(1)=$P(^LEX(757.02,LEXIEN,0),"^",2) ; SNOMED CODE IN P2122287 122443 "RTN","C0CUTIL",114,0) 122288 . S RTN(0)=1 ; ONE THING RETURNED122444 ; 122289 122445 "RTN","C0CUTIL",115,0) 122290 E S RTN(0)=0 ; NOT FOUND 122446 DASNO(DANAME) ; PRINTS THE SNOMED CODE FOR ALLERGY TO DRUG DANAME 122291 122447 "RTN","C0CUTIL",116,0) 122448 ; 122449 "RTN","C0CUTIL",117,0) 122450 N DARTN 122451 "RTN","C0CUTIL",118,0) 122452 D DA2SNO(.DARTN,DANAME) ; CALL THE LOOKUP ROUTINE 122453 "RTN","C0CUTIL",119,0) 122454 I DARTN(0)>0 D ; GOT RESULTS 122455 "RTN","C0CUTIL",120,0) 122456 . W !,DARTN(1) ;PRINT THE SNOMED CODE 122457 "RTN","C0CUTIL",121,0) 122458 E W !,"NOT FOUND",! 122459 "RTN","C0CUTIL",122,0) 122292 122460 Q 122293 "RTN","C0CUTIL",117,0)122294 ;122295 "RTN","C0CUTIL",118,0)122296 DASNO(DANAME) ; PRINTS THE SNOMED CODE FOR ALLERGY TO DRUG DANAME122297 "RTN","C0CUTIL",119,0)122298 ;122299 "RTN","C0CUTIL",120,0)122300 N DARTN122301 "RTN","C0CUTIL",121,0)122302 D DA2SNO(.DARTN,DANAME) ; CALL THE LOOKUP ROUTINE122303 "RTN","C0CUTIL",122,0)122304 I DARTN(0)>0 D ; GOT RESULTS122305 122461 "RTN","C0CUTIL",123,0) 122306 . W !,DARTN(1) ;PRINT THE SNOMED CODE122462 ; 122307 122463 "RTN","C0CUTIL",124,0) 122308 E W !,"NOT FOUND",! 122464 DASNALL(WHICH) ; ROUTINE TO EXAMINE THE ADIS INDEX IN LEX AND RETRIEVE ALL 122309 122465 "RTN","C0CUTIL",125,0) 122466 ; ASSOCIATED SNOMED CODES 122467 "RTN","C0CUTIL",126,0) 122468 N DASTMP,DASIEN,DASNO 122469 "RTN","C0CUTIL",127,0) 122470 S DASTMP="" 122471 "RTN","C0CUTIL",128,0) 122472 F S DASTMP=$O(^LEX(757.21,WHICH,DASTMP)) Q:DASTMP="" D ; NAME OF MED 122473 "RTN","C0CUTIL",129,0) 122474 . S DASIEN=$O(^LEX(757.21,WHICH,DASTMP,"")) ; IEN OF MED 122475 "RTN","C0CUTIL",130,0) 122476 . S DASNO=$P(^LEX(757.02,DASIEN,0),"^",2) ; SNOMED CODE FOR ENTRY 122477 "RTN","C0CUTIL",131,0) 122478 . W DASTMP,"=",DASNO,! ; PRINT IT OUT 122479 "RTN","C0CUTIL",132,0) 122310 122480 Q 122311 "RTN","C0CUTIL",126,0)122312 ;122313 "RTN","C0CUTIL",127,0)122314 DASNALL(WHICH) ; ROUTINE TO EXAMINE THE ADIS INDEX IN LEX AND RETRIEVE ALL122315 "RTN","C0CUTIL",128,0)122316 ; ASSOCIATED SNOMED CODES122317 "RTN","C0CUTIL",129,0)122318 N DASTMP,DASIEN,DASNO122319 "RTN","C0CUTIL",130,0)122320 S DASTMP=""122321 "RTN","C0CUTIL",131,0)122322 F S DASTMP=$O(^LEX(757.21,WHICH,DASTMP)) Q:DASTMP="" D ; NAME OF MED122323 "RTN","C0CUTIL",132,0)122324 . S DASIEN=$O(^LEX(757.21,WHICH,DASTMP,"")) ; IEN OF MED122325 122481 "RTN","C0CUTIL",133,0) 122326 . S DASNO=$P(^LEX(757.02,DASIEN,0),"^",2) ; SNOMED CODE FOR ENTRY122482 ; 122327 122483 "RTN","C0CUTIL",134,0) 122328 . W DASTMP,"=",DASNO,! ; PRINT IT OUT 122484 RXNFN() Q 1130590011.001 ; RxNorm Concepts file number 122329 122485 "RTN","C0CUTIL",135,0) 122330 Q122486 ; 122331 122487 "RTN","C0CUTIL",136,0) 122332 ; 122488 CODE(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF 122333 122489 "RTN","C0CUTIL",137,0) 122334 RXNFN() Q 1130590011.001 ; RxNorm Concepts file number 122490 ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR 122335 122491 "RTN","C0CUTIL",138,0) 122336 ;122492 N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT 122337 122493 "RTN","C0CUTIL",139,0) 122338 CODE(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF 122494 I $G(ZVUID)="" Q "" 122339 122495 "RTN","C0CUTIL",140,0) 122340 ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR122496 I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED 122341 122497 "RTN","C0CUTIL",141,0) 122342 N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT122498 N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID") 122343 122499 "RTN","C0CUTIL",142,0) 122344 I $G(ZVUID)="" Q ""122500 S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES 122345 122501 "RTN","C0CUTIL",143,0) 122346 I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED122502 N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01) 122347 122503 "RTN","C0CUTIL",144,0) 122348 N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID")122504 S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED 122349 122505 "RTN","C0CUTIL",145,0) 122350 S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES122506 I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F" 122351 122507 "RTN","C0CUTIL",146,0) 122352 N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01)122508 Q ZRSLT 122353 122509 "RTN","C0CUTIL",147,0) 122354 S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED122510 ; 122355 122511 "RTN","C0CUTIL",148,0) 122356 I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F" 122512 NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO 122357 122513 "RTN","C0CUTIL",149,0) 122358 Q ZRSLT122514 ; CONFORM TO NIST REQUIREMENTS 122359 122515 "RTN","C0CUTIL",150,0) 122360 ; 122516 ;INPATIENT CERTIFICATION 122361 122517 "RTN","C0CUTIL",151,0) 122362 NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO 122518 I ZRXN=309362 S ZRXN=213169 122363 122519 "RTN","C0CUTIL",152,0) 122364 ; CONFORM TO NIST REQUIREMENTS122520 I ZRXN=855318 S ZRXN=855320 122365 122521 "RTN","C0CUTIL",153,0) 122366 ;INPATIENT CERTIFICATION122522 I ZRXN=197361 S ZRXN=212549 122367 122523 "RTN","C0CUTIL",154,0) 122368 I ZRXN=309362 S ZRXN=213169122524 ;OUTPATIENT CERTIFICATION 122369 122525 "RTN","C0CUTIL",155,0) 122370 I ZRXN= 855318 S ZRXN=855320122526 I ZRXN=310534 S ZRXN=205875 122371 122527 "RTN","C0CUTIL",156,0) 122372 I ZRXN= 197361 S ZRXN=212549122528 I ZRXN=617312 S ZRXN=617314 122373 122529 "RTN","C0CUTIL",157,0) 122374 ;OUTPATIENT CERTIFICATION122530 I ZRXN=310429 S ZRXN=200801 122375 122531 "RTN","C0CUTIL",158,0) 122376 I ZRXN= 310534 S ZRXN=205875122532 I ZRXN=628953 S ZRXN=628958 122377 122533 "RTN","C0CUTIL",159,0) 122378 I ZRXN= 617312 S ZRXN=617314122534 I ZRXN=745679 S ZRXN=630208 122379 122535 "RTN","C0CUTIL",160,0) 122380 I ZRXN=31 0429 S ZRXN=200801122536 I ZRXN=311564 S ZRXN=979334 122381 122537 "RTN","C0CUTIL",161,0) 122382 I ZRXN= 628953 S ZRXN=628958122538 I ZRXN=836343 S ZRXN=836370 122383 122539 "RTN","C0CUTIL",162,0) 122384 I ZRXN=745679 S ZRXN=630208122540 Q ZRXN 122385 122541 "RTN","C0CUTIL",163,0) 122386 I ZRXN=311564 S ZRXN=979334122542 ; 122387 122543 "RTN","C0CUTIL",164,0) 122388 I ZRXN=836343 S ZRXN=836370 122544 RPMS() ; Are we running on an RPMS system rather than Vista? 122389 122545 "RTN","C0CUTIL",165,0) 122390 Q ZRXN122546 Q $G(DUZ("AG"))="I" ; If User Agency is Indian Health Service 122391 122547 "RTN","C0CUTIL",166,0) 122392 ; 122548 VISTA() ; Are we running on Vanilla Vista? 122393 122549 "RTN","C0CUTIL",167,0) 122394 RPMS() ; Are we running on an RPMS system rather than Vista? 122550 Q $G(DUZ("AG"))="V" ; If User Agency is VA 122395 122551 "RTN","C0CUTIL",168,0) 122396 Q $G(DUZ("AG"))="I" ; If User Agency is Indian Health Service 122552 WV() ; Are we running on WorldVista? 122397 122553 "RTN","C0CUTIL",169,0) 122398 VISTA() ; Are we running on Vanilla Vista? 122554 Q $G(DUZ("AG"))="E" ; Code for WV. 122399 122555 "RTN","C0CUTIL",170,0) 122400 Q $G(DUZ("AG"))="V" ; If User Agency is VA 122556 OV() ; Are we running on OpenVista? 122401 122557 "RTN","C0CUTIL",171,0) 122402 WV() ; Are we running on WorldVista?122403 "RTN","C0CUTIL",172,0)122404 Q $G(DUZ("AG"))="E" ; Code for WV.122405 "RTN","C0CUTIL",173,0)122406 OV() ; Are we running on OpenVista?122407 "RTN","C0CUTIL",174,0)122408 122558 Q $G(DUZ("AG"))="O" ; Code for OpenVista 122409 "RTN","C0CUTIL",175,0)122410 122411 122559 "RTN","C0CVA200") 122412 0^55^B3 2092477122560 0^55^B31814686 122413 122561 "RTN","C0CVA200",1,0) 122414 122562 C0CVA200 ;WV/C0C/SMH - Routine to get Provider Data;07/13/2008 122415 122563 "RTN","C0CVA200",2,0) 122416 ;;1.2;C 0C;;May 11, 2012;Build 50122564 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 122417 122565 "RTN","C0CVA200",3,0) 122418 ;Copyright 2008 Sam Habiel. Licensed under the terms of the GNU122566 ;Copyright 2008 Sam Habiel. 122419 122567 "RTN","C0CVA200",4,0) 122420 ; General Public License See attached copy of the License.122568 ; 122421 122569 "RTN","C0CVA200",5,0) 122422 ; 122570 ; This program is free software: you can redistribute it and/or modify 122423 122571 "RTN","C0CVA200",6,0) 122424 ; This program is free software; you can redistribute it and/or modify122572 ; it under the terms of the GNU Affero General Public License as 122425 122573 "RTN","C0CVA200",7,0) 122426 ; it under the terms of the GNU General Public License as published by122574 ; published by the Free Software Foundation, either version 3 of the 122427 122575 "RTN","C0CVA200",8,0) 122428 ; the Free Software Foundation; either version 2 of the License, or122576 ; License, or (at your option) any later version. 122429 122577 "RTN","C0CVA200",9,0) 122430 ; (at your option) any later version.122578 ; 122431 122579 "RTN","C0CVA200",10,0) 122432 ; 122580 ; This program is distributed in the hope that it will be useful, 122433 122581 "RTN","C0CVA200",11,0) 122434 ; This program is distributed in the hope that it will be useful,122582 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 122435 122583 "RTN","C0CVA200",12,0) 122436 ; but WITHOUT ANY WARRANTY; without even the implied warranty of122584 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 122437 122585 "RTN","C0CVA200",13,0) 122438 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the122586 ; GNU Affero General Public License for more details. 122439 122587 "RTN","C0CVA200",14,0) 122440 ; GNU General Public License for more details.122588 ; 122441 122589 "RTN","C0CVA200",15,0) 122442 ; 122590 ; You should have received a copy of the GNU Affero General Public License 122443 122591 "RTN","C0CVA200",16,0) 122444 ; You should have received a copy of the GNU General Public License along122592 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 122445 122593 "RTN","C0CVA200",17,0) 122446 ; with this program; if not, write to the Free Software Foundation, Inc.,122594 ; 122447 122595 "RTN","C0CVA200",18,0) 122448 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.122596 Q 122449 122597 "RTN","C0CVA200",19,0) 122450 Q122598 ; This routine uses Kernel APIs and Direct Global Access to get 122451 122599 "RTN","C0CVA200",20,0) 122452 ; This routine uses Kernel APIs and Direct Global Access to get122600 ; Proivder Data from File 200. 122453 122601 "RTN","C0CVA200",21,0) 122454 ; Proivder Data from File 200.122602 ; 122455 122603 "RTN","C0CVA200",22,0) 122456 ;122604 ; The Global is VA(200,*) 122457 122605 "RTN","C0CVA200",23,0) 122458 ; The Global is VA(200,*)122606 ; 122459 122607 "RTN","C0CVA200",24,0) 122608 FAMILY(DUZ) ; Get Family Name; PUBLIC; EXTRINSIC 122609 "RTN","C0CVA200",25,0) 122610 ; INPUT: DUZ (i.e. File 200 IEN) ByVal 122611 "RTN","C0CVA200",26,0) 122612 ; OUTPUT: String 122613 "RTN","C0CVA200",27,0) 122614 N NAME S NAME=$P(^VA(200,DUZ,0),U) 122615 "RTN","C0CVA200",28,0) 122616 D NAMECOMP^XLFNAME(.NAME) 122617 "RTN","C0CVA200",29,0) 122618 Q NAME("FAMILY") 122619 "RTN","C0CVA200",30,0) 122460 122620 ; 122461 "RTN","C0CVA200", 25,0)122462 FAMILY(DUZ) ; Get FamilyName; PUBLIC; EXTRINSIC122463 "RTN","C0CVA200", 26,0)122464 ; INPUT: DUZ (i.e. File 200 IEN)ByVal122465 "RTN","C0CVA200", 27,0)122621 "RTN","C0CVA200",31,0) 122622 GIVEN(DUZ) ; Get Given Name; PUBLIC; EXTRINSIC 122623 "RTN","C0CVA200",32,0) 122624 ; INPUT: DUZ ByVal 122625 "RTN","C0CVA200",33,0) 122466 122626 ; OUTPUT: String 122467 "RTN","C0CVA200", 28,0)122627 "RTN","C0CVA200",34,0) 122468 122628 N NAME S NAME=$P(^VA(200,DUZ,0),U) 122469 "RTN","C0CVA200", 29,0)122629 "RTN","C0CVA200",35,0) 122470 122630 D NAMECOMP^XLFNAME(.NAME) 122471 "RTN","C0CVA200",3 0,0)122472 Q NAME(" FAMILY")122473 "RTN","C0CVA200",3 1,0)122631 "RTN","C0CVA200",36,0) 122632 Q NAME("GIVEN") 122633 "RTN","C0CVA200",37,0) 122474 122634 ; 122475 "RTN","C0CVA200",3 2,0)122476 GIVEN(DUZ) ; Get Given Name;PUBLIC; EXTRINSIC122477 "RTN","C0CVA200",3 3,0)122635 "RTN","C0CVA200",38,0) 122636 MIDDLE(DUZ) ; Get Middle Name, PUBLIC; EXTRINSIC 122637 "RTN","C0CVA200",39,0) 122478 122638 ; INPUT: DUZ ByVal 122479 "RTN","C0CVA200", 34,0)122639 "RTN","C0CVA200",40,0) 122480 122640 ; OUTPUT: String 122481 "RTN","C0CVA200", 35,0)122641 "RTN","C0CVA200",41,0) 122482 122642 N NAME S NAME=$P(^VA(200,DUZ,0),U) 122483 "RTN","C0CVA200", 36,0)122643 "RTN","C0CVA200",42,0) 122484 122644 D NAMECOMP^XLFNAME(.NAME) 122485 "RTN","C0CVA200", 37,0)122486 Q NAME(" GIVEN")122487 "RTN","C0CVA200", 38,0)122645 "RTN","C0CVA200",43,0) 122646 Q NAME("MIDDLE") 122647 "RTN","C0CVA200",44,0) 122488 122648 ; 122489 "RTN","C0CVA200", 39,0)122490 MIDDLE(DUZ) ; Get MiddleName, PUBLIC; EXTRINSIC122491 "RTN","C0CVA200",4 0,0)122649 "RTN","C0CVA200",45,0) 122650 SUFFIX(DUZ) ; Get Suffix Name, PUBLIC; EXTRINSIC 122651 "RTN","C0CVA200",46,0) 122492 122652 ; INPUT: DUZ ByVal 122493 "RTN","C0CVA200",4 1,0)122653 "RTN","C0CVA200",47,0) 122494 122654 ; OUTPUT: String 122495 "RTN","C0CVA200",4 2,0)122655 "RTN","C0CVA200",48,0) 122496 122656 N NAME S NAME=$P(^VA(200,DUZ,0),U) 122497 "RTN","C0CVA200",4 3,0)122657 "RTN","C0CVA200",49,0) 122498 122658 D NAMECOMP^XLFNAME(.NAME) 122499 "RTN","C0CVA200", 44,0)122500 Q NAME(" MIDDLE")122501 "RTN","C0CVA200", 45,0)122659 "RTN","C0CVA200",50,0) 122660 Q NAME("SUFFIX") 122661 "RTN","C0CVA200",51,0) 122502 122662 ; 122503 "RTN","C0CVA200", 46,0)122504 SUFFIX(DUZ) ; Get Suffix Name, PUBLIC; EXTRINSIC122505 "RTN","C0CVA200", 47,0)122663 "RTN","C0CVA200",52,0) 122664 TITLE(DUZ) ; Get Title for Proivder, PUBLIC; EXTRINSIC 122665 "RTN","C0CVA200",53,0) 122506 122666 ; INPUT: DUZ ByVal 122507 "RTN","C0CVA200", 48,0)122667 "RTN","C0CVA200",54,0) 122508 122668 ; OUTPUT: String 122509 "RTN","C0CVA200",49,0) 122510 N NAME S NAME=$P(^VA(200,DUZ,0),U) 122511 "RTN","C0CVA200",50,0) 122512 D NAMECOMP^XLFNAME(.NAME) 122513 "RTN","C0CVA200",51,0) 122514 Q NAME("SUFFIX") 122515 "RTN","C0CVA200",52,0) 122669 "RTN","C0CVA200",55,0) 122670 ; Gets External Value of Title field in New Person File. 122671 "RTN","C0CVA200",56,0) 122672 ; It's actually a pointer to file 3.1 122673 "RTN","C0CVA200",57,0) 122674 ; 200=New Person File; 8 is Title Field 122675 "RTN","C0CVA200",58,0) 122676 Q $$GET1^DIQ(200,DUZ_",",8) 122677 "RTN","C0CVA200",59,0) 122516 122678 ; 122517 "RTN","C0CVA200", 53,0)122518 TITLE(DUZ) ; Get Title for Proivder, PUBLIC; EXTRINSIC122519 "RTN","C0CVA200", 54,0)122679 "RTN","C0CVA200",60,0) 122680 NPI(DUZ) ; Get NPI Number, PUBLIC; EXTRINSIC 122681 "RTN","C0CVA200",61,0) 122520 122682 ; INPUT: DUZ ByVal 122521 "RTN","C0CVA200",55,0) 122683 "RTN","C0CVA200",62,0) 122684 ; OUTPUT: Delimited String in format: 122685 "RTN","C0CVA200",63,0) 122686 ; IDType^ID^IDDescription 122687 "RTN","C0CVA200",64,0) 122688 ; If the NPI doesn't exist, "" is returned. 122689 "RTN","C0CVA200",65,0) 122690 ; This routine uses a call documented in the Kernel dev guide 122691 "RTN","C0CVA200",66,0) 122692 ; This call returns as "NPI^TimeEntered^ActiveInactive" 122693 "RTN","C0CVA200",67,0) 122694 ; It returns -1 for NPI if NPI doesn't exist. 122695 "RTN","C0CVA200",68,0) 122696 N NPI S NPI=$P($$NPI^XUSNPI("Individual_ID",DUZ),U) 122697 "RTN","C0CVA200",69,0) 122698 Q:NPI=-1 "" 122699 "RTN","C0CVA200",70,0) 122700 Q "NPI^"_NPI_"^HHS" 122701 "RTN","C0CVA200",71,0) 122702 ; 122703 "RTN","C0CVA200",72,0) 122704 SPEC(DUZ) ; Get Provider Specialty, PUBLIC; EXTRINSIC 122705 "RTN","C0CVA200",73,0) 122706 ; INPUT: DUZ ByVal 122707 "RTN","C0CVA200",74,0) 122708 ; OUTPUT: String: ProviderType/Specialty/Subspecialty OR "" 122709 "RTN","C0CVA200",75,0) 122710 ; Uses a Kernel API. Returns -1 if a specialty is not specified 122711 "RTN","C0CVA200",76,0) 122712 ; in file 200. 122713 "RTN","C0CVA200",77,0) 122714 ; Otherwise, returns IEN^Profession^Specialty^Subspecialty^Effect date^Expired date^VA code 122715 "RTN","C0CVA200",78,0) 122716 N STR S STR=$$GET^XUA4A72(DUZ) 122717 "RTN","C0CVA200",79,0) 122718 Q:+STR<0 "" 122719 "RTN","C0CVA200",80,0) 122720 ; Sometimes we have 3 pieces, or 2. Deal with that. 122721 "RTN","C0CVA200",81,0) 122722 Q:$L($P(STR,U,4)) $P(STR,U,2)_"-"_$P(STR,U,3)_"-"_$P(STR,U,4) 122723 "RTN","C0CVA200",82,0) 122724 Q $P(STR,U,2)_"-"_$P(STR,U,3) 122725 "RTN","C0CVA200",83,0) 122726 ; 122727 "RTN","C0CVA200",84,0) 122728 ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC 122729 "RTN","C0CVA200",85,0) 122730 ; INPUT: DUZ, but not needed really... here for future expansion 122731 "RTN","C0CVA200",86,0) 122732 ; OUTPUT: At this point "Work" 122733 "RTN","C0CVA200",87,0) 122734 Q "Work" 122735 "RTN","C0CVA200",88,0) 122736 ; 122737 "RTN","C0CVA200",89,0) 122738 ADDLINE1(ADUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC ; CHANGED PARAMETER TO ADUZ TO KEEP FROM CRASHING GPL 1/09 122739 "RTN","C0CVA200",90,0) 122740 ; INPUT: DUZ ByVal 122741 "RTN","C0CVA200",91,0) 122742 ; Output: String. 122743 "RTN","C0CVA200",92,0) 122744 ; 122745 "RTN","C0CVA200",93,0) 122746 ; First, get site number from the institution file. 122747 "RTN","C0CVA200",94,0) 122748 ; 1st piece returned by $$SITE^VASITE, which gets the system institution 122749 "RTN","C0CVA200",95,0) 122750 N INST S INST=$P($$SITE^VASITE(),U) 122751 "RTN","C0CVA200",96,0) 122752 ; 122753 "RTN","C0CVA200",97,0) 122754 ; Second, get mailing address 122755 "RTN","C0CVA200",98,0) 122756 ; There are two APIs to get the address, one for physical and one for 122757 "RTN","C0CVA200",99,0) 122758 ; mailing. We will check if mailing exists first, since that's the 122759 "RTN","C0CVA200",100,0) 122760 ; one we want to use; then check for physical. If neither exists, 122761 "RTN","C0CVA200",101,0) 122762 ; then we return nothing. We check for the existence of an address 122763 "RTN","C0CVA200",102,0) 122764 ; by the length of the returned string. 122765 "RTN","C0CVA200",103,0) 122766 ; NOTE: API doesn't support Address 2, so I won't even include it 122767 "RTN","C0CVA200",104,0) 122768 ; in the template. 122769 "RTN","C0CVA200",105,0) 122770 N ADD 122771 "RTN","C0CVA200",106,0) 122772 S ADD=$$MADD^XUAF4(INST) ; mailing address 122773 "RTN","C0CVA200",107,0) 122774 Q:$L(ADD) $P(ADD,U) 122775 "RTN","C0CVA200",108,0) 122776 S ADD=$$PADD^XUAF4(INST) ; physical address 122777 "RTN","C0CVA200",109,0) 122778 Q:$L(ADD) $P(ADD,U) 122779 "RTN","C0CVA200",110,0) 122780 Q "" 122781 "RTN","C0CVA200",111,0) 122782 ; 122783 "RTN","C0CVA200",112,0) 122784 CITY(ADUZ) ; Get City for Institution. PUBLIC; EXTRINSIC 122785 "RTN","C0CVA200",113,0) 122786 ;GPL CHANGED PARAMETER TO ADUZ TO KEEP $$SITE^VASITE FROM CRASHING 122787 "RTN","C0CVA200",114,0) 122788 ; INPUT: DUZ ByVal 122789 "RTN","C0CVA200",115,0) 122790 ; Output: String. 122791 "RTN","C0CVA200",116,0) 122792 ; See ADD1 for comments 122793 "RTN","C0CVA200",117,0) 122794 N INST S INST=$P($$SITE^VASITE(),U) 122795 "RTN","C0CVA200",118,0) 122796 N ADD 122797 "RTN","C0CVA200",119,0) 122798 S ADD=$$MADD^XUAF4(INST) ; mailing address 122799 "RTN","C0CVA200",120,0) 122800 Q:$L(ADD) $P(ADD,U,2) 122801 "RTN","C0CVA200",121,0) 122802 S ADD=$$PADD^XUAF4(INST) ; physical address 122803 "RTN","C0CVA200",122,0) 122804 Q:$L(ADD) $P(ADD,U,2) 122805 "RTN","C0CVA200",123,0) 122806 Q "" 122807 "RTN","C0CVA200",124,0) 122808 ; 122809 "RTN","C0CVA200",125,0) 122810 STATE(ADUZ) ; Get State for Institution. PUBLIC; EXTRINSIC 122811 "RTN","C0CVA200",126,0) 122812 ; INPUT: DUZ ByVal 122813 "RTN","C0CVA200",127,0) 122814 ; Output: String. 122815 "RTN","C0CVA200",128,0) 122816 ; See ADD1 for comments 122817 "RTN","C0CVA200",129,0) 122818 N INST S INST=$P($$SITE^VASITE(),U) 122819 "RTN","C0CVA200",130,0) 122820 N ADD 122821 "RTN","C0CVA200",131,0) 122822 S ADD=$$MADD^XUAF4(INST) ; mailing address 122823 "RTN","C0CVA200",132,0) 122824 Q:$L(ADD) $P(ADD,U,3) 122825 "RTN","C0CVA200",133,0) 122826 S ADD=$$PADD^XUAF4(INST) ; physical address 122827 "RTN","C0CVA200",134,0) 122828 Q:$L(ADD) $P(ADD,U,3) 122829 "RTN","C0CVA200",135,0) 122830 Q "" 122831 "RTN","C0CVA200",136,0) 122832 ; 122833 "RTN","C0CVA200",137,0) 122834 POSTCODE(ADUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC 122835 "RTN","C0CVA200",138,0) 122836 ; INPUT: DUZ ByVal 122837 "RTN","C0CVA200",139,0) 122838 ; OUTPUT: String. 122839 "RTN","C0CVA200",140,0) 122840 ; See ADD1 for comments 122841 "RTN","C0CVA200",141,0) 122842 N INST S INST=$P($$SITE^VASITE(),U) 122843 "RTN","C0CVA200",142,0) 122844 N ADD 122845 "RTN","C0CVA200",143,0) 122846 S ADD=$$MADD^XUAF4(INST) ; mailing address 122847 "RTN","C0CVA200",144,0) 122848 Q:$L(ADD) $P(ADD,U,4) 122849 "RTN","C0CVA200",145,0) 122850 S ADD=$$PADD^XUAF4(INST) ; physical address 122851 "RTN","C0CVA200",146,0) 122852 Q:$L(ADD) $P(ADD,U,4) 122853 "RTN","C0CVA200",147,0) 122854 Q "" 122855 "RTN","C0CVA200",148,0) 122856 ; 122857 "RTN","C0CVA200",149,0) 122858 TEL(DUZ) ; Get Office Phone number. PUBLIC; EXTRINSIC 122859 "RTN","C0CVA200",150,0) 122860 ; INPUT: DUZ ByVal 122861 "RTN","C0CVA200",151,0) 122862 ; OUTPUT: String. 122863 "RTN","C0CVA200",152,0) 122864 ; Direct global access 122865 "RTN","C0CVA200",153,0) 122866 N TEL S TEL=$G(^VA(200,DUZ,.13)) 122867 "RTN","C0CVA200",154,0) 122868 Q $P(TEL,U,2) 122869 "RTN","C0CVA200",155,0) 122870 ; 122871 "RTN","C0CVA200",156,0) 122872 TELTYPE(DUZ) ; Get Telephone Type. PUBLIC; EXTRINSIC 122873 "RTN","C0CVA200",157,0) 122874 ; INPUT: DUZ ByVal 122875 "RTN","C0CVA200",158,0) 122876 ; OUTPUT: String. 122877 "RTN","C0CVA200",159,0) 122878 Q "Office" 122879 "RTN","C0CVA200",160,0) 122880 ; 122881 "RTN","C0CVA200",161,0) 122882 EMAIL(DUZ) ; Get Provider's Email. PUBLIC; EXTRINSIC 122883 "RTN","C0CVA200",162,0) 122884 ; INPUT: DUZ ByVal 122885 "RTN","C0CVA200",163,0) 122522 122886 ; OUTPUT: String 122523 "RTN","C0CVA200",56,0) 122524 ; Gets External Value of Title field in New Person File. 122525 "RTN","C0CVA200",57,0) 122526 ; It's actually a pointer to file 3.1 122527 "RTN","C0CVA200",58,0) 122528 ; 200=New Person File; 8 is Title Field 122529 "RTN","C0CVA200",59,0) 122530 Q $$GET1^DIQ(200,DUZ_",",8) 122531 "RTN","C0CVA200",60,0) 122532 ; 122533 "RTN","C0CVA200",61,0) 122534 NPI(DUZ) ; Get NPI Number, PUBLIC; EXTRINSIC 122535 "RTN","C0CVA200",62,0) 122536 ; INPUT: DUZ ByVal 122537 "RTN","C0CVA200",63,0) 122538 ; OUTPUT: Delimited String in format: 122539 "RTN","C0CVA200",64,0) 122540 ; IDType^ID^IDDescription 122541 "RTN","C0CVA200",65,0) 122542 ; If the NPI doesn't exist, "" is returned. 122543 "RTN","C0CVA200",66,0) 122544 ; This routine uses a call documented in the Kernel dev guide 122545 "RTN","C0CVA200",67,0) 122546 ; This call returns as "NPI^TimeEntered^ActiveInactive" 122547 "RTN","C0CVA200",68,0) 122548 ; It returns -1 for NPI if NPI doesn't exist. 122549 "RTN","C0CVA200",69,0) 122550 N NPI S NPI=$P($$NPI^XUSNPI("Individual_ID",DUZ),U) 122551 "RTN","C0CVA200",70,0) 122552 Q:NPI=-1 "" 122553 "RTN","C0CVA200",71,0) 122554 Q "NPI^"_NPI_"^HHS" 122555 "RTN","C0CVA200",72,0) 122556 ; 122557 "RTN","C0CVA200",73,0) 122558 SPEC(DUZ) ; Get Provider Specialty, PUBLIC; EXTRINSIC 122559 "RTN","C0CVA200",74,0) 122560 ; INPUT: DUZ ByVal 122561 "RTN","C0CVA200",75,0) 122562 ; OUTPUT: String: ProviderType/Specialty/Subspecialty OR "" 122563 "RTN","C0CVA200",76,0) 122564 ; Uses a Kernel API. Returns -1 if a specialty is not specified 122565 "RTN","C0CVA200",77,0) 122566 ; in file 200. 122567 "RTN","C0CVA200",78,0) 122568 ; Otherwise, returns IEN^Profession^Specialty^Subspecialty^Effect date^Expired date^VA code 122569 "RTN","C0CVA200",79,0) 122570 N STR S STR=$$GET^XUA4A72(DUZ) 122571 "RTN","C0CVA200",80,0) 122572 Q:+STR<0 "" 122573 "RTN","C0CVA200",81,0) 122574 ; Sometimes we have 3 pieces, or 2. Deal with that. 122575 "RTN","C0CVA200",82,0) 122576 Q:$L($P(STR,U,4)) $P(STR,U,2)_"-"_$P(STR,U,3)_"-"_$P(STR,U,4) 122577 "RTN","C0CVA200",83,0) 122578 Q $P(STR,U,2)_"-"_$P(STR,U,3) 122579 "RTN","C0CVA200",84,0) 122580 ; 122581 "RTN","C0CVA200",85,0) 122582 ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC 122583 "RTN","C0CVA200",86,0) 122584 ; INPUT: DUZ, but not needed really... here for future expansion 122585 "RTN","C0CVA200",87,0) 122586 ; OUTPUT: At this point "Work" 122587 "RTN","C0CVA200",88,0) 122588 Q "Work" 122589 "RTN","C0CVA200",89,0) 122590 ; 122591 "RTN","C0CVA200",90,0) 122592 ADDLINE1(ADUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC ; CHANGED PARAMETER TO ADUZ TO KEEP FROM CRASHING GPL 1/09 122593 "RTN","C0CVA200",91,0) 122594 ; INPUT: DUZ ByVal 122595 "RTN","C0CVA200",92,0) 122596 ; Output: String. 122597 "RTN","C0CVA200",93,0) 122598 ; 122599 "RTN","C0CVA200",94,0) 122600 ; First, get site number from the institution file. 122601 "RTN","C0CVA200",95,0) 122602 ; 1st piece returned by $$SITE^VASITE, which gets the system institution 122603 "RTN","C0CVA200",96,0) 122604 N INST S INST=$P($$SITE^VASITE(),U) 122605 "RTN","C0CVA200",97,0) 122606 ; 122607 "RTN","C0CVA200",98,0) 122608 ; Second, get mailing address 122609 "RTN","C0CVA200",99,0) 122610 ; There are two APIs to get the address, one for physical and one for 122611 "RTN","C0CVA200",100,0) 122612 ; mailing. We will check if mailing exists first, since that's the 122613 "RTN","C0CVA200",101,0) 122614 ; one we want to use; then check for physical. If neither exists, 122615 "RTN","C0CVA200",102,0) 122616 ; then we return nothing. We check for the existence of an address 122617 "RTN","C0CVA200",103,0) 122618 ; by the length of the returned string. 122619 "RTN","C0CVA200",104,0) 122620 ; NOTE: API doesn't support Address 2, so I won't even include it 122621 "RTN","C0CVA200",105,0) 122622 ; in the template. 122623 "RTN","C0CVA200",106,0) 122624 N ADD 122625 "RTN","C0CVA200",107,0) 122626 S ADD=$$MADD^XUAF4(INST) ; mailing address 122627 "RTN","C0CVA200",108,0) 122628 Q:$L(ADD) $P(ADD,U) 122629 "RTN","C0CVA200",109,0) 122630 S ADD=$$PADD^XUAF4(INST) ; physical address 122631 "RTN","C0CVA200",110,0) 122632 Q:$L(ADD) $P(ADD,U) 122633 "RTN","C0CVA200",111,0) 122634 Q "" 122635 "RTN","C0CVA200",112,0) 122636 ; 122637 "RTN","C0CVA200",113,0) 122638 CITY(ADUZ) ; Get City for Institution. PUBLIC; EXTRINSIC 122639 "RTN","C0CVA200",114,0) 122640 ;GPL CHANGED PARAMETER TO ADUZ TO KEEP $$SITE^VASITE FROM CRASHING 122641 "RTN","C0CVA200",115,0) 122642 ; INPUT: DUZ ByVal 122643 "RTN","C0CVA200",116,0) 122644 ; Output: String. 122645 "RTN","C0CVA200",117,0) 122646 ; See ADD1 for comments 122647 "RTN","C0CVA200",118,0) 122648 N INST S INST=$P($$SITE^VASITE(),U) 122649 "RTN","C0CVA200",119,0) 122650 N ADD 122651 "RTN","C0CVA200",120,0) 122652 S ADD=$$MADD^XUAF4(INST) ; mailing address 122653 "RTN","C0CVA200",121,0) 122654 Q:$L(ADD) $P(ADD,U,2) 122655 "RTN","C0CVA200",122,0) 122656 S ADD=$$PADD^XUAF4(INST) ; physical address 122657 "RTN","C0CVA200",123,0) 122658 Q:$L(ADD) $P(ADD,U,2) 122659 "RTN","C0CVA200",124,0) 122660 Q "" 122661 "RTN","C0CVA200",125,0) 122662 ; 122663 "RTN","C0CVA200",126,0) 122664 STATE(ADUZ) ; Get State for Institution. PUBLIC; EXTRINSIC 122665 "RTN","C0CVA200",127,0) 122666 ; INPUT: DUZ ByVal 122667 "RTN","C0CVA200",128,0) 122668 ; Output: String. 122669 "RTN","C0CVA200",129,0) 122670 ; See ADD1 for comments 122671 "RTN","C0CVA200",130,0) 122672 N INST S INST=$P($$SITE^VASITE(),U) 122673 "RTN","C0CVA200",131,0) 122674 N ADD 122675 "RTN","C0CVA200",132,0) 122676 S ADD=$$MADD^XUAF4(INST) ; mailing address 122677 "RTN","C0CVA200",133,0) 122678 Q:$L(ADD) $P(ADD,U,3) 122679 "RTN","C0CVA200",134,0) 122680 S ADD=$$PADD^XUAF4(INST) ; physical address 122681 "RTN","C0CVA200",135,0) 122682 Q:$L(ADD) $P(ADD,U,3) 122683 "RTN","C0CVA200",136,0) 122684 Q "" 122685 "RTN","C0CVA200",137,0) 122686 ; 122687 "RTN","C0CVA200",138,0) 122688 POSTCODE(ADUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC 122689 "RTN","C0CVA200",139,0) 122690 ; INPUT: DUZ ByVal 122691 "RTN","C0CVA200",140,0) 122692 ; OUTPUT: String. 122693 "RTN","C0CVA200",141,0) 122694 ; See ADD1 for comments 122695 "RTN","C0CVA200",142,0) 122696 N INST S INST=$P($$SITE^VASITE(),U) 122697 "RTN","C0CVA200",143,0) 122698 N ADD 122699 "RTN","C0CVA200",144,0) 122700 S ADD=$$MADD^XUAF4(INST) ; mailing address 122701 "RTN","C0CVA200",145,0) 122702 Q:$L(ADD) $P(ADD,U,4) 122703 "RTN","C0CVA200",146,0) 122704 S ADD=$$PADD^XUAF4(INST) ; physical address 122705 "RTN","C0CVA200",147,0) 122706 Q:$L(ADD) $P(ADD,U,4) 122707 "RTN","C0CVA200",148,0) 122708 Q "" 122709 "RTN","C0CVA200",149,0) 122710 ; 122711 "RTN","C0CVA200",150,0) 122712 TEL(DUZ) ; Get Office Phone number. PUBLIC; EXTRINSIC 122713 "RTN","C0CVA200",151,0) 122714 ; INPUT: DUZ ByVal 122715 "RTN","C0CVA200",152,0) 122716 ; OUTPUT: String. 122717 "RTN","C0CVA200",153,0) 122887 "RTN","C0CVA200",164,0) 122718 122888 ; Direct global access 122719 "RTN","C0CVA200",154,0)122720 N TEL S TEL=$G(^VA(200,DUZ,.13))122721 "RTN","C0CVA200",155,0)122722 Q $P(TEL,U,2)122723 "RTN","C0CVA200",156,0)122724 ;122725 "RTN","C0CVA200",157,0)122726 TELTYPE(DUZ) ; Get Telephone Type. PUBLIC; EXTRINSIC122727 "RTN","C0CVA200",158,0)122728 ; INPUT: DUZ ByVal122729 "RTN","C0CVA200",159,0)122730 ; OUTPUT: String.122731 "RTN","C0CVA200",160,0)122732 Q "Office"122733 "RTN","C0CVA200",161,0)122734 ;122735 "RTN","C0CVA200",162,0)122736 EMAIL(DUZ) ; Get Provider's Email. PUBLIC; EXTRINSIC122737 "RTN","C0CVA200",163,0)122738 ; INPUT: DUZ ByVal122739 "RTN","C0CVA200",164,0)122740 ; OUTPUT: String122741 122889 "RTN","C0CVA200",165,0) 122742 ; Direct global access122890 N EMAIL S EMAIL=$G(^VA(200,DUZ,.15)) 122743 122891 "RTN","C0CVA200",166,0) 122744 N EMAIL S EMAIL=$G(^VA(200,DUZ,.15))122892 Q $P(EMAIL,U) 122745 122893 "RTN","C0CVA200",167,0) 122746 Q $P(EMAIL,U)122747 "RTN","C0CVA200",168,0)122748 122894 ; 122749 122895 "RTN","C0CVALID") 122750 0^110^B 2856461122896 0^110^B3624866 122751 122897 "RTN","C0CVALID",1,0) 122752 122898 C0CVALID ; C0C/OHUM/RUT - PROCESSING FOR DATE LIMITS, NOTES ; 22/12/2011 122753 122899 "RTN","C0CVALID",2,0) 122754 ;;1.2;C 0C;;May 11, 2012;Build 50;Build 2122900 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51;Build 2 122755 122901 "RTN","C0CVALID",3,0) 122902 ; (C) RUT 2011. 122903 "RTN","C0CVALID",4,0) 122904 ; 122905 "RTN","C0CVALID",5,0) 122906 ; This program is free software: you can redistribute it and/or modify 122907 "RTN","C0CVALID",6,0) 122908 ; it under the terms of the GNU Affero General Public License as 122909 "RTN","C0CVALID",7,0) 122910 ; published by the Free Software Foundation, either version 3 of the 122911 "RTN","C0CVALID",8,0) 122912 ; License, or (at your option) any later version. 122913 "RTN","C0CVALID",9,0) 122914 ; 122915 "RTN","C0CVALID",10,0) 122916 ; This program is distributed in the hope that it will be useful, 122917 "RTN","C0CVALID",11,0) 122918 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 122919 "RTN","C0CVALID",12,0) 122920 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 122921 "RTN","C0CVALID",13,0) 122922 ; GNU Affero General Public License for more details. 122923 "RTN","C0CVALID",14,0) 122924 ; 122925 "RTN","C0CVALID",15,0) 122926 ; You should have received a copy of the GNU Affero General Public License 122927 "RTN","C0CVALID",16,0) 122928 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 122929 "RTN","C0CVALID",17,0) 122930 ; 122931 "RTN","C0CVALID",18,0) 122756 122932 S ^TMP("C0CCCR","LABLIMIT")="",^TMP("C0CCCR","VITLIMIT")="",^TMP("C0CCCR","MEDLIMIT")="",^TMP("C0CCCR","TIULIMIT")="" 122757 "RTN","C0CVALID", 4,0)122933 "RTN","C0CVALID",19,0) 122758 122934 S %DT="AEX",%DT("A")="LAB Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","LABLIMIT")=Y 122759 "RTN","C0CVALID", 5,0)122935 "RTN","C0CVALID",20,0) 122760 122936 S %DT="AEX",%DT("A")="VITAL Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","VITLIMIT")=Y 122761 "RTN","C0CVALID", 6,0)122937 "RTN","C0CVALID",21,0) 122762 122938 S %DT="AEX",%DT("A")="MEDICATION Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","MEDLIMIT")=Y 122763 "RTN","C0CVALID", 7,0)122939 "RTN","C0CVALID",22,0) 122764 122940 ;S ^TMP("C0CCCR","RALIMIT")="",%DT="AEX",%DT("A")="RADIOLOGY Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","RALIMIT")=Y 122765 "RTN","C0CVALID", 8,0)122941 "RTN","C0CVALID",23,0) 122766 122942 W !,"Do you want to include Notes: YES/NO? //NO" D YN^DICN I %=1 S %DT="AEX",%DT("A")="NOTE Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","TIULIMIT")=Y 122767 "RTN","C0CVALID", 9,0)122943 "RTN","C0CVALID",24,0) 122768 122944 Q 122769 "RTN","C0CVALID", 10,0)122945 "RTN","C0CVALID",25,0) 122770 122946 HTOF(FLAGS) ;Changing DATE in FILMAN's FORMAT 122771 "RTN","C0CVALID", 11,0)122947 "RTN","C0CVALID",26,0) 122772 122948 N HORLOGDATECUR,COVDATE,HORLOGDATE,FDATE 122773 "RTN","C0CVALID", 12,0)122949 "RTN","C0CVALID",27,0) 122774 122950 S HORLOGDATECUR=$P($H,",",1) 122775 "RTN","C0CVALID", 13,0)122951 "RTN","C0CVALID",28,0) 122776 122952 S COVDATE=$P(FLAGS,"-",2) 122777 "RTN","C0CVALID", 14,0)122953 "RTN","C0CVALID",29,0) 122778 122954 S HORLOGDATE=HORLOGDATECUR-COVDATE 122779 "RTN","C0CVALID", 15,0)122955 "RTN","C0CVALID",30,0) 122780 122956 S (FDATE)=$$H2F^XLFDT(HORLOGDATE) 122781 "RTN","C0CVALID", 16,0)122957 "RTN","C0CVALID",31,0) 122782 122958 K HORLOGDATECUR,COVDATE,HORLOGDATE 122783 "RTN","C0CVALID", 17,0)122959 "RTN","C0CVALID",32,0) 122784 122960 Q FDATE 122785 122961 "RTN","C0CVIT2") 122786 0^66^B3 20700684122962 0^66^B317310035 122787 122963 "RTN","C0CVIT2",1,0) 122788 122964 C0CVIT2 ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08 122789 122965 "RTN","C0CVIT2",2,0) 122790 ;;1.2;C 0C;;May 11, 2012;Build 50122966 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 122791 122967 "RTN","C0CVIT2",3,0) 122792 122968 ;Copyright 2008,2009 George Lilly, University of Minnesota and others. 122793 122969 "RTN","C0CVIT2",4,0) 122794 ; Licensed under the terms of the GNU General Public License.122970 ; 122795 122971 "RTN","C0CVIT2",5,0) 122796 ; See attached copy of the License.122972 ; This program is free software: you can redistribute it and/or modify 122797 122973 "RTN","C0CVIT2",6,0) 122798 ; 122974 ; it under the terms of the GNU Affero General Public License as 122799 122975 "RTN","C0CVIT2",7,0) 122800 ; This program is free software; you can redistribute it and/or modify122976 ; published by the Free Software Foundation, either version 3 of the 122801 122977 "RTN","C0CVIT2",8,0) 122802 ; it under the terms of the GNU General Public License as published by122978 ; License, or (at your option) any later version. 122803 122979 "RTN","C0CVIT2",9,0) 122804 ; the Free Software Foundation; either version 2 of the License, or122980 ; 122805 122981 "RTN","C0CVIT2",10,0) 122806 ; (at your option) any later version.122982 ; This program is distributed in the hope that it will be useful, 122807 122983 "RTN","C0CVIT2",11,0) 122808 ; 122984 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 122809 122985 "RTN","C0CVIT2",12,0) 122810 ; This program is distributed in the hope that it will be useful,122986 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 122811 122987 "RTN","C0CVIT2",13,0) 122812 ; but WITHOUT ANY WARRANTY; without even the implied warranty of122988 ; GNU Affero General Public License for more details. 122813 122989 "RTN","C0CVIT2",14,0) 122814 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the122990 ; 122815 122991 "RTN","C0CVIT2",15,0) 122816 ; GNU General Public License for more details.122992 ; You should have received a copy of the GNU Affero General Public License 122817 122993 "RTN","C0CVIT2",16,0) 122818 ; 122994 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 122819 122995 "RTN","C0CVIT2",17,0) 122820 ; You should have received a copy of the GNU General Public License along122996 ; 122821 122997 "RTN","C0CVIT2",18,0) 122822 ;with this program; if not, write to the Free Software Foundation, Inc.,122998 W "NO ENTRY FROM TOP",! 122823 122999 "RTN","C0CVIT2",19,0) 122824 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.123000 Q 122825 123001 "RTN","C0CVIT2",20,0) 122826 123002 ; 122827 123003 "RTN","C0CVIT2",21,0) 122828 W "NO ENTRY FROM TOP",! 123004 EXTRACT(VITXML,DFN,VITOUT) ; EXTRACT VITAL SIGNS INTO XML TEMPLATE 122829 123005 "RTN","C0CVIT2",22,0) 123006 ; VITXML AND VITOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED 123007 "RTN","C0CVIT2",23,0) 123008 ; 123009 "RTN","C0CVIT2",24,0) 123010 ; USE THE FOLLOWING TEMPLATE FOR THE RNF2 ARRAYS 123011 "RTN","C0CVIT2",25,0) 123012 ; THAT GET PASSED TO *GET ROUTINES 123013 "RTN","C0CVIT2",26,0) 123014 ;C0C[NAME]=$NA(^TMP("C0CCCR",$J,DFN,"C0C(NAME)) 123015 "RTN","C0CVIT2",27,0) 123016 N C0CVIT 123017 "RTN","C0CVIT2",28,0) 123018 S C0CVIT=$NA(^TMP("C0CCCR",$J,DFN,"C0CVIT")) 123019 "RTN","C0CVIT2",29,0) 123020 ; USE THE FOLLOWING TEMPLATE FOR GETTING/GENERATING THE RNF2 ARRAYS 123021 "RTN","C0CVIT2",30,0) 123022 ; THAT GET INSERTED INTO THE XML TEMPLATE 123023 "RTN","C0CVIT2",31,0) 123024 ; D GET[VISTA/RPMS](DFN,C0CIMM) ; GET VARS 123025 "RTN","C0CVIT2",32,0) 123026 I $$RPMS^C0CUTIL() D GETRPMS(DFN,C0CVIT) ; GET VARS 123027 "RTN","C0CVIT2",33,0) 123028 I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D GETVISTA(DFN,C0CVIT) 123029 "RTN","C0CVIT2",34,0) 123030 ; USE THE FOLLOWING TEMPATE FOR MAPPING RNF2 ARRAYS TO XML TEMPLATE 123031 "RTN","C0CVIT2",35,0) 123032 ; D MAP([NAME]XML,C0C[NAME],[NAME]OUT) ;MAP RESULTS FOR PROCEDURES 123033 "RTN","C0CVIT2",36,0) 123034 D MAP(VITXML,C0CVIT,VITOUT) ;MAP RESULTS FOR PROCEDURES 123035 "RTN","C0CVIT2",37,0) 122830 123036 Q 122831 "RTN","C0CVIT2",23,0)122832 ;122833 "RTN","C0CVIT2",24,0)122834 EXTRACT(VITXML,DFN,VITOUT) ; EXTRACT VITAL SIGNS INTO XML TEMPLATE122835 "RTN","C0CVIT2",25,0)122836 ; VITXML AND VITOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED122837 "RTN","C0CVIT2",26,0)122838 ;122839 "RTN","C0CVIT2",27,0)122840 ; USE THE FOLLOWING TEMPLATE FOR THE RNF2 ARRAYS122841 "RTN","C0CVIT2",28,0)122842 ; THAT GET PASSED TO *GET ROUTINES122843 "RTN","C0CVIT2",29,0)122844 ;C0C[NAME]=$NA(^TMP("C0CCCR",$J,DFN,"C0C(NAME))122845 "RTN","C0CVIT2",30,0)122846 N C0CVIT122847 "RTN","C0CVIT2",31,0)122848 S C0CVIT=$NA(^TMP("C0CCCR",$J,DFN,"C0CVIT"))122849 "RTN","C0CVIT2",32,0)122850 ; USE THE FOLLOWING TEMPLATE FOR GETTING/GENERATING THE RNF2 ARRAYS122851 "RTN","C0CVIT2",33,0)122852 ; THAT GET INSERTED INTO THE XML TEMPLATE122853 "RTN","C0CVIT2",34,0)122854 ; D GET[VISTA/RPMS](DFN,C0CIMM) ; GET VARS122855 "RTN","C0CVIT2",35,0)122856 I $$RPMS^C0CUTIL() D GETRPMS(DFN,C0CVIT) ; GET VARS122857 "RTN","C0CVIT2",36,0)122858 I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D GETVISTA(DFN,C0CVIT)122859 "RTN","C0CVIT2",37,0)122860 ; USE THE FOLLOWING TEMPATE FOR MAPPING RNF2 ARRAYS TO XML TEMPLATE122861 123037 "RTN","C0CVIT2",38,0) 122862 ; D MAP([NAME]XML,C0C[NAME],[NAME]OUT) ;MAP RESULTS FOR PROCEDURES123038 ; 122863 123039 "RTN","C0CVIT2",39,0) 122864 D MAP(VITXML,C0CVIT,VITOUT) ;MAP RESULTS FOR PROCEDURES 123040 GETVISTA(DFN,C0CVIT) ; CALLS VITALS^ORQQVI TO GET VITAL SIGNS. 122865 123041 "RTN","C0CVIT2",40,0) 123042 ; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME 123043 "RTN","C0CVIT2",41,0) 123044 ; C0CVIT: VITAL SIGNS 123045 "RTN","C0CVIT2",42,0) 123046 ; READY TO BE MAPPED TO XML BY MAP^C0CVIT2 123047 "RTN","C0CVIT2",43,0) 123048 ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY 123049 "RTN","C0CVIT2",44,0) 123050 ; EXIST. 123051 "RTN","C0CVIT2",45,0) 123052 ; 123053 "RTN","C0CVIT2",46,0) 123054 ; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J)) 123055 "RTN","C0CVIT2",47,0) 123056 ; 123057 "RTN","C0CVIT2",48,0) 123058 ; SETUP RPC/API CALL HERE 123059 "RTN","C0CVIT2",49,0) 123060 ; USE START AND END DATES FROM PARAMETERS IF REQUIRED 123061 "RTN","C0CVIT2",50,0) 123062 ; 123063 "RTN","C0CVIT2",51,0) 123064 N VIT,DATA,START,END 123065 "RTN","C0CVIT2",52,0) 123066 ; RPC REQUIRES FM DATES NOT T-* DATES 123067 "RTN","C0CVIT2",53,0) 123068 D DT^DILF(,$$GET^C0CPARMS("VITLIMIT"),.END) ; GET THE LIMIT PARM 123069 "RTN","C0CVIT2",54,0) 123070 D DT^DILF(,$$GET^C0CPARMS("VITSTART"),.START) ; GET START PARM 123071 "RTN","C0CVIT2",55,0) 123072 ; RPC CALL (ORY,DFN,ORSDT,OREDT): 123073 "RTN","C0CVIT2",56,0) 123074 ;ORY: return variable 123075 "RTN","C0CVIT2",57,0) 123076 ;DFN: patient identifier from Patient File [#2] 123077 "RTN","C0CVIT2",58,0) 123078 ;ORSDT: start date/time in Fileman format 123079 "RTN","C0CVIT2",59,0) 123080 ;OREDT: end date/time in Fileman format 123081 "RTN","C0CVIT2",60,0) 123082 ; OUTPUT FORMAT: 123083 "RTN","C0CVIT2",61,0) 123084 ;vital measurement ien^vital type^rate^date/time taken 123085 "RTN","C0CVIT2",62,0) 123086 D VITALS^ORQQVI(.VIT,DFN,START,END) ; RUN QUERY VITALS CALL 123087 "RTN","C0CVIT2",63,0) 123088 I '$D(VIT) S @VITOUT@(0)=0 K VIT Q ; RETURN NOT FOUND, KILL ARRAY AND QUIT 123089 "RTN","C0CVIT2",64,0) 123090 I $P(VIT(1),U,2)="No vitals found." D Q ; signal no vitals and quit 123091 "RTN","C0CVIT2",65,0) 123092 . I $D(VITOUT) S @VITOUT@(0)=0 123093 "RTN","C0CVIT2",66,0) 123094 . K VIT 123095 "RTN","C0CVIT2",67,0) 123096 ; 123097 "RTN","C0CVIT2",68,0) 123098 ; PREFORM SORT HERE IF NEEDED 123099 "RTN","C0CVIT2",69,0) 123100 ; 123101 "RTN","C0CVIT2",70,0) 123102 ; SORT IS REQUIRED FOR VITAL SIGNS - LATEST VITALS NEED TO BE LISTED FIRST 123103 "RTN","C0CVIT2",71,0) 123104 ; COPIED SORT LOGIC: 123105 "RTN","C0CVIT2",72,0) 123106 N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX 123107 "RTN","C0CVIT2",73,0) 123108 D VITSORT(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY 123109 "RTN","C0CVIT2",74,0) 123110 S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE 123111 "RTN","C0CVIT2",75,0) 123112 ; VSORT IS VITALS IN REVERSE ORDER 123113 "RTN","C0CVIT2",76,0) 123114 ; 123115 "RTN","C0CVIT2",77,0) 123116 ; MAP EACH ROW OF RPC/API TO RNF1 ARRAY 123117 "RTN","C0CVIT2",78,0) 123118 ; RNF1 ARRAY FORMAT: 123119 "RTN","C0CVIT2",79,0) 123120 ; VAR("NAME_OF_RIM_VARIABLE")=VALUE 123121 "RTN","C0CVIT2",80,0) 123122 ; 123123 "RTN","C0CVIT2",81,0) 123124 ; VITAL SIGNS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF VITAL SIGNS 123125 "RTN","C0CVIT2",82,0) 123126 ; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD 123127 "RTN","C0CVIT2",83,0) 123128 ; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS 123129 "RTN","C0CVIT2",84,0) 123130 N C0CVI,C0CC,ZRNF 123131 "RTN","C0CVIT2",85,0) 123132 ;S C0CVI="" ; INITIALIZE FOR $O 123133 "RTN","C0CVIT2",86,0) 123134 F C0CC=1:1:VSORT(0) S C0CVI=VSORT(C0CC) D ; FOR EACH VITAL SIGN IN THE LIST 123135 "RTN","C0CVIT2",87,0) 123136 . I DEBUG W VIT(C0CVI),! 123137 "RTN","C0CVIT2",88,0) 123138 . ; FIGURE OUT WHICH TYPE OF VITAL SIGN IT IS (HEIGHT, WEIGHT, BLOOD PRESSURE, TEMPERATURE, RESPIRATION, PULSE, PAIN, OTHER) 123139 "RTN","C0CVIT2",89,0) 123140 . D:$P(VIT(C0CVI),U,3)="HT" HEIGHT1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"in") 123141 "RTN","C0CVIT2",90,0) 123142 . D:$P(VIT(C0CVI),U,3)="WT" WEIGHT1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"lbs") 123143 "RTN","C0CVIT2",91,0) 123144 . D:$P(VIT(C0CVI),U,3)="BP" BP1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"") 123145 "RTN","C0CVIT2",92,0) 123146 . D:$P(VIT(C0CVI),U,3)="T" TMP1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"F") 123147 "RTN","C0CVIT2",93,0) 123148 . D:$P(VIT(C0CVI),U,3)="R" RESP1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"") 123149 "RTN","C0CVIT2",94,0) 123150 . D:$P(VIT(C0CVI),U,3)="P" PULSE1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"") 123151 "RTN","C0CVIT2",95,0) 123152 . D:$P(VIT(C0CVI),U,3)="PN" PAIN1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"") 123153 "RTN","C0CVIT2",96,0) 123154 . D:'$D(ZRNF) OTHER1($$FMDTOUTC^C0CUTIL($P(C0CVI,U,4),"DT"),"OTHER VITAL",$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"UNKNOWN") ;IF THE VITAL ISN'T DEFINED IT IS OTHER 123155 "RTN","C0CVIT2",97,0) 123156 . D RNF1TO2^C0CRNF(C0CVIT,"ZRNF") ;ADD THIS ROW TO THE ARRAY 123157 "RTN","C0CVIT2",98,0) 123158 . K ZRNF 123159 "RTN","C0CVIT2",99,0) 123160 ; SAVE RIM VARIABLES SEE C0CRIMA 123161 "RTN","C0CVIT2",100,0) 123162 N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"VITALS")) 123163 "RTN","C0CVIT2",101,0) 123164 M @ZRIM=@C0CVIT@("V") 123165 "RTN","C0CVIT2",102,0) 122866 123166 Q 122867 "RTN","C0CVIT2", 41,0)122868 ; 122869 "RTN","C0CVIT2", 42,0)122870 GET VISTA(DFN,C0CVIT) ; CALLS VITALS^ORQQVITO GET VITAL SIGNS.122871 "RTN","C0CVIT2", 43,0)123167 "RTN","C0CVIT2",103,0) 123168 ; 123169 "RTN","C0CVIT2",104,0) 123170 GETRPMS(DFN,C0CVIT) ; CALLS QUERY^BEHOVM TO GET VITAL SIGNS. 123171 "RTN","C0CVIT2",105,0) 122872 123172 ; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME 122873 "RTN","C0CVIT2", 44,0)123173 "RTN","C0CVIT2",106,0) 122874 123174 ; C0CVIT: VITAL SIGNS 122875 "RTN","C0CVIT2", 45,0)123175 "RTN","C0CVIT2",107,0) 122876 123176 ; READY TO BE MAPPED TO XML BY MAP^C0CVIT2 122877 "RTN","C0CVIT2", 46,0)123177 "RTN","C0CVIT2",108,0) 122878 123178 ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY 122879 "RTN","C0CVIT2", 47,0)123179 "RTN","C0CVIT2",109,0) 122880 123180 ; EXIST. 122881 "RTN","C0CVIT2", 48,0)122882 ; 122883 "RTN","C0CVIT2", 49,0)123181 "RTN","C0CVIT2",110,0) 123182 ; 123183 "RTN","C0CVIT2",111,0) 122884 123184 ; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J)) 122885 "RTN","C0CVIT2", 50,0)122886 ; 122887 "RTN","C0CVIT2", 51,0)123185 "RTN","C0CVIT2",112,0) 123186 ; 123187 "RTN","C0CVIT2",113,0) 122888 123188 ; SETUP RPC/API CALL HERE 122889 "RTN","C0CVIT2", 52,0)123189 "RTN","C0CVIT2",114,0) 122890 123190 ; USE START AND END DATES FROM PARAMETERS IF REQUIRED 122891 "RTN","C0CVIT2",53,0) 122892 ; 122893 "RTN","C0CVIT2",54,0) 122894 N VIT,DATA,START,END 122895 "RTN","C0CVIT2",55,0) 123191 "RTN","C0CVIT2",115,0) 123192 ; 123193 "RTN","C0CVIT2",116,0) 123194 ; RPMS VITAL RPC ONLY RETURNS LATEST VITAL IN SPECIFIED DATE RANGE NOT ALL VITALS IN DATE RANGE 123195 "RTN","C0CVIT2",117,0) 123196 ; WE NEED TO SETUP THE VARIABLES THE INTERNAL CALL NEEDS TO BYPASS A HARD CODE OF ONE VITAL FOR DATE RANGE 123197 "RTN","C0CVIT2",118,0) 123198 N C0CEDT,C0CSDT,VIT,DATA,START,END 123199 "RTN","C0CVIT2",119,0) 122896 123200 ; RPC REQUIRES FM DATES NOT T-* DATES 122897 "RTN","C0CVIT2", 56,0)123201 "RTN","C0CVIT2",120,0) 122898 123202 D DT^DILF(,$$GET^C0CPARMS("VITLIMIT"),.END) ; GET THE LIMIT PARM 122899 "RTN","C0CVIT2", 57,0)123203 "RTN","C0CVIT2",121,0) 122900 123204 D DT^DILF(,$$GET^C0CPARMS("VITSTART"),.START) ; GET START PARM 122901 "RTN","C0CVIT2",58,0) 122902 ; RPC CALL (ORY,DFN,ORSDT,OREDT): 122903 "RTN","C0CVIT2",59,0) 122904 ;ORY: return variable 122905 "RTN","C0CVIT2",60,0) 122906 ;DFN: patient identifier from Patient File [#2] 122907 "RTN","C0CVIT2",61,0) 122908 ;ORSDT: start date/time in Fileman format 122909 "RTN","C0CVIT2",62,0) 122910 ;OREDT: end date/time in Fileman format 122911 "RTN","C0CVIT2",63,0) 122912 ; OUTPUT FORMAT: 122913 "RTN","C0CVIT2",64,0) 122914 ;vital measurement ien^vital type^rate^date/time taken 122915 "RTN","C0CVIT2",65,0) 122916 D VITALS^ORQQVI(.VIT,DFN,START,END) ; RUN QUERY VITALS CALL 122917 "RTN","C0CVIT2",66,0) 122918 I '$D(VIT) S @VITOUT@(0)=0 K VIT Q ; RETURN NOT FOUND, KILL ARRAY AND QUIT 122919 "RTN","C0CVIT2",67,0) 122920 I $P(VIT(1),U,2)="No vitals found." D Q ; signal no vitals and quit 122921 "RTN","C0CVIT2",68,0) 122922 . I $D(VITOUT) S @VITOUT@(0)=0 122923 "RTN","C0CVIT2",69,0) 122924 . K VIT 122925 "RTN","C0CVIT2",70,0) 122926 ; 122927 "RTN","C0CVIT2",71,0) 123205 "RTN","C0CVIT2",122,0) 123206 ; RPC OUTPUT FORMAT: 123207 "RTN","C0CVIT2",123,0) 123208 ; vfile ien^vital name^vital abbr^date/time taken(FM FORMAT)^value+units (US & metric) 123209 "RTN","C0CVIT2",124,0) 123210 D QUERY^BEHOVM("LISTX") ; RUN QUERY VITALS CALL 123211 "RTN","C0CVIT2",125,0) 123212 I '$D(^TMP("CIAVMRPC",$J)) S @VITOUT@(0)=0 K ^TMP("CIAVMRPC",$J) Q ; RETURN NOT FOUND, KILL ARRAY AND QUIT 123213 "RTN","C0CVIT2",126,0) 123214 ; MOVE THE ARRAY TO LOCAL VARIABLE 123215 "RTN","C0CVIT2",127,0) 123216 M VIT=^TMP("CIAVMRPC",$J,0) 123217 "RTN","C0CVIT2",128,0) 123218 ; RPC CLEANUP 123219 "RTN","C0CVIT2",129,0) 123220 K ^TMP("CIAVMRPC",$J),VITS,RMAX,START,END,DATA,METRIC,VSTR,VUNT 123221 "RTN","C0CVIT2",130,0) 123222 ; 123223 "RTN","C0CVIT2",131,0) 122928 123224 ; PREFORM SORT HERE IF NEEDED 122929 "RTN","C0CVIT2", 72,0)122930 ; 122931 "RTN","C0CVIT2", 73,0)123225 "RTN","C0CVIT2",132,0) 123226 ; 123227 "RTN","C0CVIT2",133,0) 122932 123228 ; SORT IS REQUIRED FOR VITAL SIGNS - LATEST VITALS NEED TO BE LISTED FIRST 122933 "RTN","C0CVIT2", 74,0)123229 "RTN","C0CVIT2",134,0) 122934 123230 ; COPIED SORT LOGIC: 122935 "RTN","C0CVIT2", 75,0)123231 "RTN","C0CVIT2",135,0) 122936 123232 N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX 122937 "RTN","C0CVIT2", 76,0)123233 "RTN","C0CVIT2",136,0) 122938 123234 D VITSORT(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY 122939 "RTN","C0CVIT2", 77,0)123235 "RTN","C0CVIT2",137,0) 122940 123236 S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE 122941 "RTN","C0CVIT2", 78,0)123237 "RTN","C0CVIT2",138,0) 122942 123238 ; VSORT IS VITALS IN REVERSE ORDER 122943 "RTN","C0CVIT2", 79,0)122944 ; 122945 "RTN","C0CVIT2", 80,0)123239 "RTN","C0CVIT2",139,0) 123240 ; 123241 "RTN","C0CVIT2",140,0) 122946 123242 ; MAP EACH ROW OF RPC/API TO RNF1 ARRAY 122947 "RTN","C0CVIT2", 81,0)123243 "RTN","C0CVIT2",141,0) 122948 123244 ; RNF1 ARRAY FORMAT: 122949 "RTN","C0CVIT2", 82,0)123245 "RTN","C0CVIT2",142,0) 122950 123246 ; VAR("NAME_OF_RIM_VARIABLE")=VALUE 122951 "RTN","C0CVIT2", 83,0)122952 ; 122953 "RTN","C0CVIT2", 84,0)123247 "RTN","C0CVIT2",143,0) 123248 ; 123249 "RTN","C0CVIT2",144,0) 122954 123250 ; VITAL SIGNS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF VITAL SIGNS 122955 "RTN","C0CVIT2", 85,0)123251 "RTN","C0CVIT2",145,0) 122956 123252 ; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD 122957 "RTN","C0CVIT2", 86,0)123253 "RTN","C0CVIT2",146,0) 122958 123254 ; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS 122959 "RTN","C0CVIT2", 87,0)123255 "RTN","C0CVIT2",147,0) 122960 123256 N C0CVI,C0CC,ZRNF 122961 "RTN","C0CVIT2", 88,0)123257 "RTN","C0CVIT2",148,0) 122962 123258 ;S C0CVI="" ; INITIALIZE FOR $O 122963 "RTN","C0CVIT2", 89,0)123259 "RTN","C0CVIT2",149,0) 122964 123260 F C0CC=1:1:VSORT(0) S C0CVI=VSORT(C0CC) D ; FOR EACH VITAL SIGN IN THE LIST 122965 "RTN","C0CVIT2", 90,0)123261 "RTN","C0CVIT2",150,0) 122966 123262 . I DEBUG W VIT(C0CVI),! 122967 "RTN","C0CVIT2", 91,0)123263 "RTN","C0CVIT2",151,0) 122968 123264 . ; FIGURE OUT WHICH TYPE OF VITAL SIGN IT IS (HEIGHT, WEIGHT, BLOOD PRESSURE, TEMPERATURE, RESPIRATION, PULSE, PAIN, OTHER) 122969 "RTN","C0CVIT2", 92,0)122970 . D:$P(VIT(C0CVI),U,3)="HT" HEIGHT 1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"in")122971 "RTN","C0CVIT2", 93,0)122972 . D:$P(VIT(C0CVI),U,3)="WT" WEIGHT 1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"lbs")122973 "RTN","C0CVIT2", 94,0)122974 . D:$P(VIT(C0CVI),U,3)="BP" BP 1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"")122975 "RTN","C0CVIT2", 95,0)122976 . D:$P(VIT(C0CVI),U,3)="T " TMP1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"F")122977 "RTN","C0CVIT2", 96,0)122978 . D:$P(VIT(C0CVI),U,3)="R " RESP1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"")122979 "RTN","C0CVIT2", 97,0)122980 . D:$P(VIT(C0CVI),U,3)="P " PULSE1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"")122981 "RTN","C0CVIT2", 98,0)122982 . D:$P(VIT(C0CVI),U,3)="P N" PAIN1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"")122983 "RTN","C0CVIT2", 99,0)122984 . D:'$D(ZRNF) OTHER 1($$FMDTOUTC^C0CUTIL($P(C0CVI,U,4),"DT"),"OTHER VITAL",$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"UNKNOWN");IF THE VITAL ISN'T DEFINED IT IS OTHER122985 "RTN","C0CVIT2",1 00,0)123265 "RTN","C0CVIT2",152,0) 123266 . D:$P(VIT(C0CVI),U,3)="HT" HEIGHT 123267 "RTN","C0CVIT2",153,0) 123268 . D:$P(VIT(C0CVI),U,3)="WT" WEIGHT 123269 "RTN","C0CVIT2",154,0) 123270 . D:$P(VIT(C0CVI),U,3)="BP" BP 123271 "RTN","C0CVIT2",155,0) 123272 . D:$P(VIT(C0CVI),U,3)="TMP" TMP 123273 "RTN","C0CVIT2",156,0) 123274 . D:$P(VIT(C0CVI),U,3)="RS" RESP 123275 "RTN","C0CVIT2",157,0) 123276 . D:$P(VIT(C0CVI),U,3)="PU" PULSE 123277 "RTN","C0CVIT2",158,0) 123278 . D:$P(VIT(C0CVI),U,3)="PA" PAIN 123279 "RTN","C0CVIT2",159,0) 123280 . D:'$D(ZRNF) OTHER ;IF THE VITAL ISN'T DEFINED IT IS OTHER 123281 "RTN","C0CVIT2",160,0) 122986 123282 . D RNF1TO2^C0CRNF(C0CVIT,"ZRNF") ;ADD THIS ROW TO THE ARRAY 122987 "RTN","C0CVIT2",1 01,0)123283 "RTN","C0CVIT2",161,0) 122988 123284 . K ZRNF 122989 "RTN","C0CVIT2",1 02,0)123285 "RTN","C0CVIT2",162,0) 122990 123286 ; SAVE RIM VARIABLES SEE C0CRIMA 122991 "RTN","C0CVIT2",1 03,0)123287 "RTN","C0CVIT2",163,0) 122992 123288 N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"VITALS")) 122993 "RTN","C0CVIT2",1 04,0)123289 "RTN","C0CVIT2",164,0) 122994 123290 M @ZRIM=@C0CVIT@("V") 122995 "RTN","C0CVIT2",1 05,0)123291 "RTN","C0CVIT2",165,0) 122996 123292 Q 122997 "RTN","C0CVIT2",106,0)122998 ;122999 "RTN","C0CVIT2",107,0)123000 GETRPMS(DFN,C0CVIT) ; CALLS QUERY^BEHOVM TO GET VITAL SIGNS.123001 "RTN","C0CVIT2",108,0)123002 ; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME123003 "RTN","C0CVIT2",109,0)123004 ; C0CVIT: VITAL SIGNS123005 "RTN","C0CVIT2",110,0)123006 ; READY TO BE MAPPED TO XML BY MAP^C0CVIT2123007 "RTN","C0CVIT2",111,0)123008 ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY123009 "RTN","C0CVIT2",112,0)123010 ; EXIST.123011 "RTN","C0CVIT2",113,0)123012 ;123013 "RTN","C0CVIT2",114,0)123014 ; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J))123015 "RTN","C0CVIT2",115,0)123016 ;123017 "RTN","C0CVIT2",116,0)123018 ; SETUP RPC/API CALL HERE123019 "RTN","C0CVIT2",117,0)123020 ; USE START AND END DATES FROM PARAMETERS IF REQUIRED123021 "RTN","C0CVIT2",118,0)123022 ;123023 "RTN","C0CVIT2",119,0)123024 ; RPMS VITAL RPC ONLY RETURNS LATEST VITAL IN SPECIFIED DATE RANGE NOT ALL VITALS IN DATE RANGE123025 "RTN","C0CVIT2",120,0)123026 ; WE NEED TO SETUP THE VARIABLES THE INTERNAL CALL NEEDS TO BYPASS A HARD CODE OF ONE VITAL FOR DATE RANGE123027 "RTN","C0CVIT2",121,0)123028 N C0CEDT,C0CSDT,VIT,DATA,START,END123029 "RTN","C0CVIT2",122,0)123030 ; RPC REQUIRES FM DATES NOT T-* DATES123031 "RTN","C0CVIT2",123,0)123032 D DT^DILF(,$$GET^C0CPARMS("VITLIMIT"),.END) ; GET THE LIMIT PARM123033 "RTN","C0CVIT2",124,0)123034 D DT^DILF(,$$GET^C0CPARMS("VITSTART"),.START) ; GET START PARM123035 "RTN","C0CVIT2",125,0)123036 ; RPC OUTPUT FORMAT:123037 "RTN","C0CVIT2",126,0)123038 ; vfile ien^vital name^vital abbr^date/time taken(FM FORMAT)^value+units (US & metric)123039 "RTN","C0CVIT2",127,0)123040 D QUERY^BEHOVM("LISTX") ; RUN QUERY VITALS CALL123041 "RTN","C0CVIT2",128,0)123042 I '$D(^TMP("CIAVMRPC",$J)) S @VITOUT@(0)=0 K ^TMP("CIAVMRPC",$J) Q ; RETURN NOT FOUND, KILL ARRAY AND QUIT123043 "RTN","C0CVIT2",129,0)123044 ; MOVE THE ARRAY TO LOCAL VARIABLE123045 "RTN","C0CVIT2",130,0)123046 M VIT=^TMP("CIAVMRPC",$J,0)123047 "RTN","C0CVIT2",131,0)123048 ; RPC CLEANUP123049 "RTN","C0CVIT2",132,0)123050 K ^TMP("CIAVMRPC",$J),VITS,RMAX,START,END,DATA,METRIC,VSTR,VUNT123051 "RTN","C0CVIT2",133,0)123052 ;123053 "RTN","C0CVIT2",134,0)123054 ; PREFORM SORT HERE IF NEEDED123055 "RTN","C0CVIT2",135,0)123056 ;123057 "RTN","C0CVIT2",136,0)123058 ; SORT IS REQUIRED FOR VITAL SIGNS - LATEST VITALS NEED TO BE LISTED FIRST123059 "RTN","C0CVIT2",137,0)123060 ; COPIED SORT LOGIC:123061 "RTN","C0CVIT2",138,0)123062 N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX123063 "RTN","C0CVIT2",139,0)123064 D VITSORT(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY123065 "RTN","C0CVIT2",140,0)123066 S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE123067 "RTN","C0CVIT2",141,0)123068 ; VSORT IS VITALS IN REVERSE ORDER123069 "RTN","C0CVIT2",142,0)123070 ;123071 "RTN","C0CVIT2",143,0)123072 ; MAP EACH ROW OF RPC/API TO RNF1 ARRAY123073 "RTN","C0CVIT2",144,0)123074 ; RNF1 ARRAY FORMAT:123075 "RTN","C0CVIT2",145,0)123076 ; VAR("NAME_OF_RIM_VARIABLE")=VALUE123077 "RTN","C0CVIT2",146,0)123078 ;123079 "RTN","C0CVIT2",147,0)123080 ; VITAL SIGNS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF VITAL SIGNS123081 "RTN","C0CVIT2",148,0)123082 ; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD123083 "RTN","C0CVIT2",149,0)123084 ; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS123085 "RTN","C0CVIT2",150,0)123086 N C0CVI,C0CC,ZRNF123087 "RTN","C0CVIT2",151,0)123088 ;S C0CVI="" ; INITIALIZE FOR $O123089 "RTN","C0CVIT2",152,0)123090 F C0CC=1:1:VSORT(0) S C0CVI=VSORT(C0CC) D ; FOR EACH VITAL SIGN IN THE LIST123091 "RTN","C0CVIT2",153,0)123092 . I DEBUG W VIT(C0CVI),!123093 "RTN","C0CVIT2",154,0)123094 . ; FIGURE OUT WHICH TYPE OF VITAL SIGN IT IS (HEIGHT, WEIGHT, BLOOD PRESSURE, TEMPERATURE, RESPIRATION, PULSE, PAIN, OTHER)123095 "RTN","C0CVIT2",155,0)123096 . D:$P(VIT(C0CVI),U,3)="HT" HEIGHT123097 "RTN","C0CVIT2",156,0)123098 . D:$P(VIT(C0CVI),U,3)="WT" WEIGHT123099 "RTN","C0CVIT2",157,0)123100 . D:$P(VIT(C0CVI),U,3)="BP" BP123101 "RTN","C0CVIT2",158,0)123102 . D:$P(VIT(C0CVI),U,3)="TMP" TMP123103 "RTN","C0CVIT2",159,0)123104 . D:$P(VIT(C0CVI),U,3)="RS" RESP123105 "RTN","C0CVIT2",160,0)123106 . D:$P(VIT(C0CVI),U,3)="PU" PULSE123107 "RTN","C0CVIT2",161,0)123108 . D:$P(VIT(C0CVI),U,3)="PA" PAIN123109 "RTN","C0CVIT2",162,0)123110 . D:'$D(ZRNF) OTHER ;IF THE VITAL ISN'T DEFINED IT IS OTHER123111 "RTN","C0CVIT2",163,0)123112 . D RNF1TO2^C0CRNF(C0CVIT,"ZRNF") ;ADD THIS ROW TO THE ARRAY123113 "RTN","C0CVIT2",164,0)123114 . K ZRNF123115 "RTN","C0CVIT2",165,0)123116 ; SAVE RIM VARIABLES SEE C0CRIMA123117 123293 "RTN","C0CVIT2",166,0) 123118 N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"VITALS"))123294 ; 123119 123295 "RTN","C0CVIT2",167,0) 123120 M @ZRIM=@C0CVIT@("V") 123296 HEIGHT ; 123121 123297 "RTN","C0CVIT2",168,0) 123298 I DEBUG W "IN VITAL: HEIGHT",! 123299 "RTN","C0CVIT2",169,0) 123300 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID 123301 "RTN","C0CVIT2",170,0) 123302 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 123303 "RTN","C0CVIT2",171,0) 123304 S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT") 123305 "RTN","C0CVIT2",172,0) 123306 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT" 123307 "RTN","C0CVIT2",173,0) 123308 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123309 "RTN","C0CVIT2",174,0) 123310 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC 123311 "RTN","C0CVIT2",175,0) 123312 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123313 "RTN","C0CVIT2",176,0) 123314 S ZRNF("VITALSIGNSDESCCODEVALUE")="248327008" 123315 "RTN","C0CVIT2",177,0) 123316 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 123317 "RTN","C0CVIT2",178,0) 123318 S ZRNF("VITALSIGNSCODEVERSION")="" 123319 "RTN","C0CVIT2",179,0) 123320 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4) 123321 "RTN","C0CVIT2",180,0) 123322 S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1) 123323 "RTN","C0CVIT2",181,0) 123324 S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2) 123325 "RTN","C0CVIT2",182,0) 123122 123326 Q 123123 "RTN","C0CVIT2",169,0) 123124 ; 123125 "RTN","C0CVIT2",170,0) 123126 HEIGHT 123127 "RTN","C0CVIT2",171,0) 123327 "RTN","C0CVIT2",183,0) 123328 ; 123329 "RTN","C0CVIT2",184,0) 123330 WEIGHT ; 123331 "RTN","C0CVIT2",185,0) 123332 I DEBUG W "IN VITAL: WEIGHT",! 123333 "RTN","C0CVIT2",186,0) 123334 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC 123335 "RTN","C0CVIT2",187,0) 123336 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 123337 "RTN","C0CVIT2",188,0) 123338 S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT") 123339 "RTN","C0CVIT2",189,0) 123340 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT" 123341 "RTN","C0CVIT2",190,0) 123342 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123343 "RTN","C0CVIT2",191,0) 123344 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC 123345 "RTN","C0CVIT2",192,0) 123346 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123347 "RTN","C0CVIT2",193,0) 123348 S ZRNF("VITALSIGNSDESCCODEVALUE")="107647005" 123349 "RTN","C0CVIT2",194,0) 123350 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 123351 "RTN","C0CVIT2",195,0) 123352 S ZRNF("VITALSIGNSCODEVERSION")="" 123353 "RTN","C0CVIT2",196,0) 123354 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4) 123355 "RTN","C0CVIT2",197,0) 123356 S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1) 123357 "RTN","C0CVIT2",198,0) 123358 S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2) 123359 "RTN","C0CVIT2",199,0) 123360 Q 123361 "RTN","C0CVIT2",200,0) 123362 ; 123363 "RTN","C0CVIT2",201,0) 123364 BP ; 123365 "RTN","C0CVIT2",202,0) 123366 I DEBUG W "IN VITAL: BLOOD PRESSURE",! 123367 "RTN","C0CVIT2",203,0) 123368 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC 123369 "RTN","C0CVIT2",204,0) 123370 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 123371 "RTN","C0CVIT2",205,0) 123372 S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT") 123373 "RTN","C0CVIT2",206,0) 123374 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE" 123375 "RTN","C0CVIT2",207,0) 123376 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123377 "RTN","C0CVIT2",208,0) 123378 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC 123379 "RTN","C0CVIT2",209,0) 123380 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123381 "RTN","C0CVIT2",210,0) 123382 S ZRNF("VITALSIGNSDESCCODEVALUE")="392570002" 123383 "RTN","C0CVIT2",211,0) 123384 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 123385 "RTN","C0CVIT2",212,0) 123386 S ZRNF("VITALSIGNSCODEVERSION")="" 123387 "RTN","C0CVIT2",213,0) 123388 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4) 123389 "RTN","C0CVIT2",214,0) 123390 S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1) 123391 "RTN","C0CVIT2",215,0) 123392 S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2) 123393 "RTN","C0CVIT2",216,0) 123394 Q 123395 "RTN","C0CVIT2",217,0) 123396 ; 123397 "RTN","C0CVIT2",218,0) 123398 TMP ; 123399 "RTN","C0CVIT2",219,0) 123400 I DEBUG W "IN VITAL: TEMPERATURE",! 123401 "RTN","C0CVIT2",220,0) 123402 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC 123403 "RTN","C0CVIT2",221,0) 123404 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 123405 "RTN","C0CVIT2",222,0) 123406 S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT") 123407 "RTN","C0CVIT2",223,0) 123408 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE" 123409 "RTN","C0CVIT2",224,0) 123410 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123411 "RTN","C0CVIT2",225,0) 123412 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC 123413 "RTN","C0CVIT2",226,0) 123414 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123415 "RTN","C0CVIT2",227,0) 123416 S ZRNF("VITALSIGNSDESCCODEVALUE")="309646008" 123417 "RTN","C0CVIT2",228,0) 123418 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 123419 "RTN","C0CVIT2",229,0) 123420 S ZRNF("VITALSIGNSCODEVERSION")="" 123421 "RTN","C0CVIT2",230,0) 123422 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4) 123423 "RTN","C0CVIT2",231,0) 123424 S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1) 123425 "RTN","C0CVIT2",232,0) 123426 S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2) 123427 "RTN","C0CVIT2",233,0) 123428 Q 123429 "RTN","C0CVIT2",234,0) 123430 ; 123431 "RTN","C0CVIT2",235,0) 123432 RESP ; 123433 "RTN","C0CVIT2",236,0) 123434 I DEBUG W "IN VITAL: RESPIRATION",! 123435 "RTN","C0CVIT2",237,0) 123436 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC 123437 "RTN","C0CVIT2",238,0) 123438 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 123439 "RTN","C0CVIT2",239,0) 123440 S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT") 123441 "RTN","C0CVIT2",240,0) 123442 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION" 123443 "RTN","C0CVIT2",241,0) 123444 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123445 "RTN","C0CVIT2",242,0) 123446 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC 123447 "RTN","C0CVIT2",243,0) 123448 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123449 "RTN","C0CVIT2",244,0) 123450 S ZRNF("VITALSIGNSDESCCODEVALUE")="366147009" 123451 "RTN","C0CVIT2",245,0) 123452 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 123453 "RTN","C0CVIT2",246,0) 123454 S ZRNF("VITALSIGNSCODEVERSION")="" 123455 "RTN","C0CVIT2",247,0) 123456 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4) 123457 "RTN","C0CVIT2",248,0) 123458 S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1) 123459 "RTN","C0CVIT2",249,0) 123460 S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2) 123461 "RTN","C0CVIT2",250,0) 123462 Q 123463 "RTN","C0CVIT2",251,0) 123464 ; 123465 "RTN","C0CVIT2",252,0) 123466 PULSE ; 123467 "RTN","C0CVIT2",253,0) 123468 I DEBUG W "IN VITAL: PULSE",! 123469 "RTN","C0CVIT2",254,0) 123470 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC 123471 "RTN","C0CVIT2",255,0) 123472 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 123473 "RTN","C0CVIT2",256,0) 123474 S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT") 123475 "RTN","C0CVIT2",257,0) 123476 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PULSE" 123477 "RTN","C0CVIT2",258,0) 123478 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123479 "RTN","C0CVIT2",259,0) 123480 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC 123481 "RTN","C0CVIT2",260,0) 123482 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123483 "RTN","C0CVIT2",261,0) 123484 S ZRNF("VITALSIGNSDESCCODEVALUE")="366199006" 123485 "RTN","C0CVIT2",262,0) 123486 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 123487 "RTN","C0CVIT2",263,0) 123488 S ZRNF("VITALSIGNSCODEVERSION")="" 123489 "RTN","C0CVIT2",264,0) 123490 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4) 123491 "RTN","C0CVIT2",265,0) 123492 S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1) 123493 "RTN","C0CVIT2",266,0) 123494 S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2) 123495 "RTN","C0CVIT2",267,0) 123496 Q 123497 "RTN","C0CVIT2",268,0) 123498 ; 123499 "RTN","C0CVIT2",269,0) 123500 PAIN ; 123501 "RTN","C0CVIT2",270,0) 123502 I DEBUG W "IN VITAL: PAIN",! 123503 "RTN","C0CVIT2",271,0) 123504 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC 123505 "RTN","C0CVIT2",272,0) 123506 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 123507 "RTN","C0CVIT2",273,0) 123508 S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT") 123509 "RTN","C0CVIT2",274,0) 123510 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PAIN" 123511 "RTN","C0CVIT2",275,0) 123512 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123513 "RTN","C0CVIT2",276,0) 123514 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC 123515 "RTN","C0CVIT2",277,0) 123516 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123517 "RTN","C0CVIT2",278,0) 123518 S ZRNF("VITALSIGNSDESCCODEVALUE")="22253000" 123519 "RTN","C0CVIT2",279,0) 123520 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 123521 "RTN","C0CVIT2",280,0) 123522 S ZRNF("VITALSIGNSCODEVERSION")="" 123523 "RTN","C0CVIT2",281,0) 123524 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4) 123525 "RTN","C0CVIT2",282,0) 123526 S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1) 123527 "RTN","C0CVIT2",283,0) 123528 S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2) 123529 "RTN","C0CVIT2",284,0) 123530 Q 123531 "RTN","C0CVIT2",285,0) 123532 ; 123533 "RTN","C0CVIT2",286,0) 123534 OTHER ; 123535 "RTN","C0CVIT2",287,0) 123536 I DEBUG W "IN VITAL: OTHER",! 123537 "RTN","C0CVIT2",288,0) 123538 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC 123539 "RTN","C0CVIT2",289,0) 123540 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 123541 "RTN","C0CVIT2",290,0) 123542 S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT") 123543 "RTN","C0CVIT2",291,0) 123544 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")=$P(VIT(C0CVI),U,2) 123545 "RTN","C0CVIT2",292,0) 123546 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123547 "RTN","C0CVIT2",293,0) 123548 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC 123549 "RTN","C0CVIT2",294,0) 123550 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123551 "RTN","C0CVIT2",295,0) 123552 S ZRNF("VITALSIGNSDESCCODEVALUE")="" 123553 "RTN","C0CVIT2",296,0) 123554 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="" 123555 "RTN","C0CVIT2",297,0) 123556 S ZRNF("VITALSIGNSCODEVERSION")="" 123557 "RTN","C0CVIT2",298,0) 123558 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4) 123559 "RTN","C0CVIT2",299,0) 123560 S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1) 123561 "RTN","C0CVIT2",300,0) 123562 S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2) 123563 "RTN","C0CVIT2",301,0) 123564 Q 123565 "RTN","C0CVIT2",302,0) 123566 ; 123567 "RTN","C0CVIT2",303,0) 123568 ;TEMPORARY, THINKING ON HOW TO REFACTOR (CJE) 123569 "RTN","C0CVIT2",304,0) 123570 HEIGHT1(DT,ACTOR,VALUE,UNIT) ; 123571 "RTN","C0CVIT2",305,0) 123128 123572 I DEBUG W "IN VITAL: HEIGHT",! 123129 "RTN","C0CVIT2", 172,0)123573 "RTN","C0CVIT2",306,0) 123130 123574 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID 123131 "RTN","C0CVIT2", 173,0)123575 "RTN","C0CVIT2",307,0) 123132 123576 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 123133 "RTN","C0CVIT2", 174,0)123134 S ZRNF("VITALSIGNSEXACTDATETIME")= $$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")123135 "RTN","C0CVIT2", 175,0)123577 "RTN","C0CVIT2",308,0) 123578 S ZRNF("VITALSIGNSEXACTDATETIME")=DT 123579 "RTN","C0CVIT2",309,0) 123136 123580 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT" 123137 "RTN","C0CVIT2", 176,0)123581 "RTN","C0CVIT2",310,0) 123138 123582 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123139 "RTN","C0CVIT2", 177,0)123583 "RTN","C0CVIT2",311,0) 123140 123584 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC 123141 "RTN","C0CVIT2", 178,0)123585 "RTN","C0CVIT2",312,0) 123142 123586 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123143 "RTN","C0CVIT2", 179,0)123587 "RTN","C0CVIT2",313,0) 123144 123588 S ZRNF("VITALSIGNSDESCCODEVALUE")="248327008" 123145 "RTN","C0CVIT2", 180,0)123589 "RTN","C0CVIT2",314,0) 123146 123590 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 123147 "RTN","C0CVIT2", 181,0)123591 "RTN","C0CVIT2",315,0) 123148 123592 S ZRNF("VITALSIGNSCODEVERSION")="" 123149 "RTN","C0CVIT2", 182,0)123150 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ $P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)123151 "RTN","C0CVIT2", 183,0)123152 S ZRNF("VITALSIGNSTESTRESULTVALUE")= $P($P(VIT(C0CVI),U,5)," ",1)123153 "RTN","C0CVIT2", 184,0)123154 S ZRNF("VITALSIGNSTESTRESULTUNIT")= $P($P(VIT(C0CVI),U,5)," ",2)123155 "RTN","C0CVIT2", 185,0)123593 "RTN","C0CVIT2",316,0) 123594 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR 123595 "RTN","C0CVIT2",317,0) 123596 S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE 123597 "RTN","C0CVIT2",318,0) 123598 S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT 123599 "RTN","C0CVIT2",319,0) 123156 123600 Q 123157 "RTN","C0CVIT2", 186,0)123158 ; 123159 "RTN","C0CVIT2", 187,0)123160 WEIGHT 123161 "RTN","C0CVIT2", 188,0)123601 "RTN","C0CVIT2",320,0) 123602 ; 123603 "RTN","C0CVIT2",321,0) 123604 WEIGHT1(DT,ACTOR,VALUE,UNIT) ; 123605 "RTN","C0CVIT2",322,0) 123162 123606 I DEBUG W "IN VITAL: WEIGHT",! 123163 "RTN","C0CVIT2", 189,0)123607 "RTN","C0CVIT2",323,0) 123164 123608 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC 123165 "RTN","C0CVIT2", 190,0)123609 "RTN","C0CVIT2",324,0) 123166 123610 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 123167 "RTN","C0CVIT2", 191,0)123168 S ZRNF("VITALSIGNSEXACTDATETIME")= $$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")123169 "RTN","C0CVIT2", 192,0)123611 "RTN","C0CVIT2",325,0) 123612 S ZRNF("VITALSIGNSEXACTDATETIME")=DT 123613 "RTN","C0CVIT2",326,0) 123170 123614 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT" 123171 "RTN","C0CVIT2", 193,0)123615 "RTN","C0CVIT2",327,0) 123172 123616 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123173 "RTN","C0CVIT2", 194,0)123617 "RTN","C0CVIT2",328,0) 123174 123618 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC 123175 "RTN","C0CVIT2", 195,0)123619 "RTN","C0CVIT2",329,0) 123176 123620 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123177 "RTN","C0CVIT2", 196,0)123621 "RTN","C0CVIT2",330,0) 123178 123622 S ZRNF("VITALSIGNSDESCCODEVALUE")="107647005" 123179 "RTN","C0CVIT2", 197,0)123623 "RTN","C0CVIT2",331,0) 123180 123624 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 123181 "RTN","C0CVIT2", 198,0)123625 "RTN","C0CVIT2",332,0) 123182 123626 S ZRNF("VITALSIGNSCODEVERSION")="" 123183 "RTN","C0CVIT2", 199,0)123184 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ $P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)123185 "RTN","C0CVIT2", 200,0)123186 S ZRNF("VITALSIGNSTESTRESULTVALUE")= $P($P(VIT(C0CVI),U,5)," ",1)123187 "RTN","C0CVIT2", 201,0)123188 S ZRNF("VITALSIGNSTESTRESULTUNIT")= $P($P(VIT(C0CVI),U,5)," ",2)123189 "RTN","C0CVIT2", 202,0)123627 "RTN","C0CVIT2",333,0) 123628 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR 123629 "RTN","C0CVIT2",334,0) 123630 S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE 123631 "RTN","C0CVIT2",335,0) 123632 S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT 123633 "RTN","C0CVIT2",336,0) 123190 123634 Q 123191 "RTN","C0CVIT2", 203,0)123192 ; 123193 "RTN","C0CVIT2", 204,0)123194 BP 123195 "RTN","C0CVIT2", 205,0)123635 "RTN","C0CVIT2",337,0) 123636 ; 123637 "RTN","C0CVIT2",338,0) 123638 BP1(DT,ACTOR,VALUE,UNIT) ; 123639 "RTN","C0CVIT2",339,0) 123196 123640 I DEBUG W "IN VITAL: BLOOD PRESSURE",! 123197 "RTN","C0CVIT2", 206,0)123641 "RTN","C0CVIT2",340,0) 123198 123642 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC 123199 "RTN","C0CVIT2", 207,0)123643 "RTN","C0CVIT2",341,0) 123200 123644 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 123201 "RTN","C0CVIT2", 208,0)123202 S ZRNF("VITALSIGNSEXACTDATETIME")= $$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")123203 "RTN","C0CVIT2", 209,0)123645 "RTN","C0CVIT2",342,0) 123646 S ZRNF("VITALSIGNSEXACTDATETIME")=DT 123647 "RTN","C0CVIT2",343,0) 123204 123648 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE" 123205 "RTN","C0CVIT2", 210,0)123649 "RTN","C0CVIT2",344,0) 123206 123650 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123207 "RTN","C0CVIT2", 211,0)123651 "RTN","C0CVIT2",345,0) 123208 123652 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC 123209 "RTN","C0CVIT2", 212,0)123653 "RTN","C0CVIT2",346,0) 123210 123654 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123211 "RTN","C0CVIT2", 213,0)123655 "RTN","C0CVIT2",347,0) 123212 123656 S ZRNF("VITALSIGNSDESCCODEVALUE")="392570002" 123213 "RTN","C0CVIT2", 214,0)123657 "RTN","C0CVIT2",348,0) 123214 123658 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 123215 "RTN","C0CVIT2", 215,0)123659 "RTN","C0CVIT2",349,0) 123216 123660 S ZRNF("VITALSIGNSCODEVERSION")="" 123217 "RTN","C0CVIT2", 216,0)123218 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ $P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)123219 "RTN","C0CVIT2", 217,0)123220 S ZRNF("VITALSIGNSTESTRESULTVALUE")= $P($P(VIT(C0CVI),U,5)," ",1)123221 "RTN","C0CVIT2", 218,0)123222 S ZRNF("VITALSIGNSTESTRESULTUNIT")= $P($P(VIT(C0CVI),U,5)," ",2)123223 "RTN","C0CVIT2", 219,0)123661 "RTN","C0CVIT2",350,0) 123662 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR 123663 "RTN","C0CVIT2",351,0) 123664 S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE 123665 "RTN","C0CVIT2",352,0) 123666 S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT 123667 "RTN","C0CVIT2",353,0) 123224 123668 Q 123225 "RTN","C0CVIT2", 220,0)123226 ; 123227 "RTN","C0CVIT2", 221,0)123228 TMP 123229 "RTN","C0CVIT2", 222,0)123669 "RTN","C0CVIT2",354,0) 123670 ; 123671 "RTN","C0CVIT2",355,0) 123672 TMP1(DT,ACTOR,VALUE,UNIT) ; 123673 "RTN","C0CVIT2",356,0) 123230 123674 I DEBUG W "IN VITAL: TEMPERATURE",! 123231 "RTN","C0CVIT2", 223,0)123675 "RTN","C0CVIT2",357,0) 123232 123676 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC 123233 "RTN","C0CVIT2", 224,0)123677 "RTN","C0CVIT2",358,0) 123234 123678 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 123235 "RTN","C0CVIT2", 225,0)123236 S ZRNF("VITALSIGNSEXACTDATETIME")= $$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")123237 "RTN","C0CVIT2", 226,0)123679 "RTN","C0CVIT2",359,0) 123680 S ZRNF("VITALSIGNSEXACTDATETIME")=DT 123681 "RTN","C0CVIT2",360,0) 123238 123682 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE" 123239 "RTN","C0CVIT2", 227,0)123683 "RTN","C0CVIT2",361,0) 123240 123684 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123241 "RTN","C0CVIT2", 228,0)123685 "RTN","C0CVIT2",362,0) 123242 123686 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC 123243 "RTN","C0CVIT2", 229,0)123687 "RTN","C0CVIT2",363,0) 123244 123688 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123245 "RTN","C0CVIT2", 230,0)123689 "RTN","C0CVIT2",364,0) 123246 123690 S ZRNF("VITALSIGNSDESCCODEVALUE")="309646008" 123247 "RTN","C0CVIT2", 231,0)123691 "RTN","C0CVIT2",365,0) 123248 123692 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 123249 "RTN","C0CVIT2", 232,0)123693 "RTN","C0CVIT2",366,0) 123250 123694 S ZRNF("VITALSIGNSCODEVERSION")="" 123251 "RTN","C0CVIT2", 233,0)123252 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ $P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)123253 "RTN","C0CVIT2", 234,0)123254 S ZRNF("VITALSIGNSTESTRESULTVALUE")= $P($P(VIT(C0CVI),U,5)," ",1)123255 "RTN","C0CVIT2", 235,0)123256 S ZRNF("VITALSIGNSTESTRESULTUNIT")= $P($P(VIT(C0CVI),U,5)," ",2)123257 "RTN","C0CVIT2", 236,0)123695 "RTN","C0CVIT2",367,0) 123696 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR 123697 "RTN","C0CVIT2",368,0) 123698 S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE 123699 "RTN","C0CVIT2",369,0) 123700 S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT 123701 "RTN","C0CVIT2",370,0) 123258 123702 Q 123259 "RTN","C0CVIT2", 237,0)123260 ; 123261 "RTN","C0CVIT2", 238,0)123262 RESP 123263 "RTN","C0CVIT2", 239,0)123703 "RTN","C0CVIT2",371,0) 123704 ; 123705 "RTN","C0CVIT2",372,0) 123706 RESP1(DT,ACTOR,VALUE,UNIT) ; 123707 "RTN","C0CVIT2",373,0) 123264 123708 I DEBUG W "IN VITAL: RESPIRATION",! 123265 "RTN","C0CVIT2", 240,0)123709 "RTN","C0CVIT2",374,0) 123266 123710 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC 123267 "RTN","C0CVIT2", 241,0)123711 "RTN","C0CVIT2",375,0) 123268 123712 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 123269 "RTN","C0CVIT2", 242,0)123270 S ZRNF("VITALSIGNSEXACTDATETIME")= $$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")123271 "RTN","C0CVIT2", 243,0)123713 "RTN","C0CVIT2",376,0) 123714 S ZRNF("VITALSIGNSEXACTDATETIME")=DT 123715 "RTN","C0CVIT2",377,0) 123272 123716 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION" 123273 "RTN","C0CVIT2", 244,0)123717 "RTN","C0CVIT2",378,0) 123274 123718 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123275 "RTN","C0CVIT2", 245,0)123719 "RTN","C0CVIT2",379,0) 123276 123720 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC 123277 "RTN","C0CVIT2", 246,0)123721 "RTN","C0CVIT2",380,0) 123278 123722 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123279 "RTN","C0CVIT2", 247,0)123723 "RTN","C0CVIT2",381,0) 123280 123724 S ZRNF("VITALSIGNSDESCCODEVALUE")="366147009" 123281 "RTN","C0CVIT2", 248,0)123725 "RTN","C0CVIT2",382,0) 123282 123726 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 123283 "RTN","C0CVIT2", 249,0)123727 "RTN","C0CVIT2",383,0) 123284 123728 S ZRNF("VITALSIGNSCODEVERSION")="" 123285 "RTN","C0CVIT2", 250,0)123286 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ $P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)123287 "RTN","C0CVIT2", 251,0)123288 S ZRNF("VITALSIGNSTESTRESULTVALUE")= $P($P(VIT(C0CVI),U,5)," ",1)123289 "RTN","C0CVIT2", 252,0)123290 S ZRNF("VITALSIGNSTESTRESULTUNIT")= $P($P(VIT(C0CVI),U,5)," ",2)123291 "RTN","C0CVIT2", 253,0)123729 "RTN","C0CVIT2",384,0) 123730 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR 123731 "RTN","C0CVIT2",385,0) 123732 S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE 123733 "RTN","C0CVIT2",386,0) 123734 S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT 123735 "RTN","C0CVIT2",387,0) 123292 123736 Q 123293 "RTN","C0CVIT2", 254,0)123294 ; 123295 "RTN","C0CVIT2", 255,0)123296 PULSE 123297 "RTN","C0CVIT2", 256,0)123737 "RTN","C0CVIT2",388,0) 123738 ; 123739 "RTN","C0CVIT2",389,0) 123740 PULSE1(DT,ACTOR,VALUE,UNIT) ; 123741 "RTN","C0CVIT2",390,0) 123298 123742 I DEBUG W "IN VITAL: PULSE",! 123299 "RTN","C0CVIT2", 257,0)123743 "RTN","C0CVIT2",391,0) 123300 123744 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC 123301 "RTN","C0CVIT2", 258,0)123745 "RTN","C0CVIT2",392,0) 123302 123746 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 123303 "RTN","C0CVIT2", 259,0)123304 S ZRNF("VITALSIGNSEXACTDATETIME")= $$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")123305 "RTN","C0CVIT2", 260,0)123747 "RTN","C0CVIT2",393,0) 123748 S ZRNF("VITALSIGNSEXACTDATETIME")=DT 123749 "RTN","C0CVIT2",394,0) 123306 123750 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PULSE" 123307 "RTN","C0CVIT2", 261,0)123751 "RTN","C0CVIT2",395,0) 123308 123752 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123309 "RTN","C0CVIT2", 262,0)123753 "RTN","C0CVIT2",396,0) 123310 123754 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC 123311 "RTN","C0CVIT2", 263,0)123755 "RTN","C0CVIT2",397,0) 123312 123756 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123313 "RTN","C0CVIT2", 264,0)123757 "RTN","C0CVIT2",398,0) 123314 123758 S ZRNF("VITALSIGNSDESCCODEVALUE")="366199006" 123315 "RTN","C0CVIT2", 265,0)123759 "RTN","C0CVIT2",399,0) 123316 123760 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 123317 "RTN","C0CVIT2", 266,0)123761 "RTN","C0CVIT2",400,0) 123318 123762 S ZRNF("VITALSIGNSCODEVERSION")="" 123319 "RTN","C0CVIT2", 267,0)123320 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ $P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)123321 "RTN","C0CVIT2", 268,0)123322 S ZRNF("VITALSIGNSTESTRESULTVALUE")= $P($P(VIT(C0CVI),U,5)," ",1)123323 "RTN","C0CVIT2", 269,0)123324 S ZRNF("VITALSIGNSTESTRESULTUNIT")= $P($P(VIT(C0CVI),U,5)," ",2)123325 "RTN","C0CVIT2", 270,0)123763 "RTN","C0CVIT2",401,0) 123764 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR 123765 "RTN","C0CVIT2",402,0) 123766 S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE 123767 "RTN","C0CVIT2",403,0) 123768 S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT 123769 "RTN","C0CVIT2",404,0) 123326 123770 Q 123327 "RTN","C0CVIT2", 271,0)123328 ; 123329 "RTN","C0CVIT2", 272,0)123330 PAIN 123331 "RTN","C0CVIT2", 273,0)123771 "RTN","C0CVIT2",405,0) 123772 ; 123773 "RTN","C0CVIT2",406,0) 123774 PAIN1(DT,ACTOR,VALUE,UNIT) ; 123775 "RTN","C0CVIT2",407,0) 123332 123776 I DEBUG W "IN VITAL: PAIN",! 123333 "RTN","C0CVIT2", 274,0)123777 "RTN","C0CVIT2",408,0) 123334 123778 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC 123335 "RTN","C0CVIT2", 275,0)123779 "RTN","C0CVIT2",409,0) 123336 123780 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 123337 "RTN","C0CVIT2", 276,0)123338 S ZRNF("VITALSIGNSEXACTDATETIME")= $$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")123339 "RTN","C0CVIT2", 277,0)123781 "RTN","C0CVIT2",410,0) 123782 S ZRNF("VITALSIGNSEXACTDATETIME")=DT 123783 "RTN","C0CVIT2",411,0) 123340 123784 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PAIN" 123341 "RTN","C0CVIT2", 278,0)123785 "RTN","C0CVIT2",412,0) 123342 123786 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123343 "RTN","C0CVIT2", 279,0)123787 "RTN","C0CVIT2",413,0) 123344 123788 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC 123345 "RTN","C0CVIT2", 280,0)123789 "RTN","C0CVIT2",414,0) 123346 123790 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123347 "RTN","C0CVIT2", 281,0)123791 "RTN","C0CVIT2",415,0) 123348 123792 S ZRNF("VITALSIGNSDESCCODEVALUE")="22253000" 123349 "RTN","C0CVIT2", 282,0)123793 "RTN","C0CVIT2",416,0) 123350 123794 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 123351 "RTN","C0CVIT2", 283,0)123795 "RTN","C0CVIT2",417,0) 123352 123796 S ZRNF("VITALSIGNSCODEVERSION")="" 123353 "RTN","C0CVIT2", 284,0)123354 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ $P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)123355 "RTN","C0CVIT2", 285,0)123356 S ZRNF("VITALSIGNSTESTRESULTVALUE")= $P($P(VIT(C0CVI),U,5)," ",1)123357 "RTN","C0CVIT2", 286,0)123358 S ZRNF("VITALSIGNSTESTRESULTUNIT")= $P($P(VIT(C0CVI),U,5)," ",2)123359 "RTN","C0CVIT2", 287,0)123797 "RTN","C0CVIT2",418,0) 123798 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR 123799 "RTN","C0CVIT2",419,0) 123800 S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE 123801 "RTN","C0CVIT2",420,0) 123802 S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT 123803 "RTN","C0CVIT2",421,0) 123360 123804 Q 123361 "RTN","C0CVIT2", 288,0)123362 ; 123363 "RTN","C0CVIT2", 289,0)123364 OTHER 123365 "RTN","C0CVIT2", 290,0)123805 "RTN","C0CVIT2",422,0) 123806 ; 123807 "RTN","C0CVIT2",423,0) 123808 OTHER1(DT,TEXT,ACTOR,VALUE,UNIT) ; 123809 "RTN","C0CVIT2",424,0) 123366 123810 I DEBUG W "IN VITAL: OTHER",! 123367 "RTN","C0CVIT2", 291,0)123811 "RTN","C0CVIT2",425,0) 123368 123812 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC 123369 "RTN","C0CVIT2", 292,0)123813 "RTN","C0CVIT2",426,0) 123370 123814 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 123371 "RTN","C0CVIT2", 293,0)123372 S ZRNF("VITALSIGNSEXACTDATETIME")= $$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")123373 "RTN","C0CVIT2", 294,0)123374 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")= $P(VIT(C0CVI),U,2)123375 "RTN","C0CVIT2", 295,0)123815 "RTN","C0CVIT2",427,0) 123816 S ZRNF("VITALSIGNSEXACTDATETIME")=DT 123817 "RTN","C0CVIT2",428,0) 123818 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")=TEXT 123819 "RTN","C0CVIT2",429,0) 123376 123820 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123377 "RTN","C0CVIT2", 296,0)123821 "RTN","C0CVIT2",430,0) 123378 123822 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC 123379 "RTN","C0CVIT2", 297,0)123823 "RTN","C0CVIT2",431,0) 123380 123824 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123381 "RTN","C0CVIT2", 298,0)123825 "RTN","C0CVIT2",432,0) 123382 123826 S ZRNF("VITALSIGNSDESCCODEVALUE")="" 123383 "RTN","C0CVIT2", 299,0)123827 "RTN","C0CVIT2",433,0) 123384 123828 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="" 123385 "RTN","C0CVIT2", 300,0)123829 "RTN","C0CVIT2",434,0) 123386 123830 S ZRNF("VITALSIGNSCODEVERSION")="" 123387 "RTN","C0CVIT2", 301,0)123388 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ $P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)123389 "RTN","C0CVIT2", 302,0)123390 S ZRNF("VITALSIGNSTESTRESULTVALUE")= $P($P(VIT(C0CVI),U,5)," ",1)123391 "RTN","C0CVIT2", 303,0)123392 S ZRNF("VITALSIGNSTESTRESULTUNIT")= $P($P(VIT(C0CVI),U,5)," ",2)123393 "RTN","C0CVIT2", 304,0)123831 "RTN","C0CVIT2",435,0) 123832 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR 123833 "RTN","C0CVIT2",436,0) 123834 S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE 123835 "RTN","C0CVIT2",437,0) 123836 S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT 123837 "RTN","C0CVIT2",438,0) 123394 123838 Q 123395 "RTN","C0CVIT2",305,0) 123396 ; 123397 "RTN","C0CVIT2",306,0) 123398 ;TEMPORARY, THINKING ON HOW TO REFACTOR (CJE) 123399 "RTN","C0CVIT2",307,0) 123400 HEIGHT1(DT,ACTOR,VALUE,UNIT) 123401 "RTN","C0CVIT2",308,0) 123402 I DEBUG W "IN VITAL: HEIGHT",! 123403 "RTN","C0CVIT2",309,0) 123404 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID 123405 "RTN","C0CVIT2",310,0) 123406 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 123407 "RTN","C0CVIT2",311,0) 123408 S ZRNF("VITALSIGNSEXACTDATETIME")=DT 123409 "RTN","C0CVIT2",312,0) 123410 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT" 123411 "RTN","C0CVIT2",313,0) 123412 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123413 "RTN","C0CVIT2",314,0) 123414 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC 123415 "RTN","C0CVIT2",315,0) 123416 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123417 "RTN","C0CVIT2",316,0) 123418 S ZRNF("VITALSIGNSDESCCODEVALUE")="248327008" 123419 "RTN","C0CVIT2",317,0) 123420 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 123421 "RTN","C0CVIT2",318,0) 123422 S ZRNF("VITALSIGNSCODEVERSION")="" 123423 "RTN","C0CVIT2",319,0) 123424 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR 123425 "RTN","C0CVIT2",320,0) 123426 S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE 123427 "RTN","C0CVIT2",321,0) 123428 S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT 123429 "RTN","C0CVIT2",322,0) 123839 "RTN","C0CVIT2",439,0) 123840 ; 123841 "RTN","C0CVIT2",440,0) 123842 VITSORT(VDT) ; RUN DATE SORTING ALGORITHM 123843 "RTN","C0CVIT2",441,0) 123844 ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY 123845 "RTN","C0CVIT2",442,0) 123846 ; OF DATES IN THE VITALS RESULTS 123847 "RTN","C0CVIT2",443,0) 123848 N VDTI,VDTJ,VTDCNT 123849 "RTN","C0CVIT2",444,0) 123850 S VTDCNT=0 ; COUNT TO BUILD ARRAY 123851 "RTN","C0CVIT2",445,0) 123852 S VDTJ="" ; USED TO VISIT THE RESULTS 123853 "RTN","C0CVIT2",446,0) 123854 F VDTI=0:0 D Q:$O(VIT(VDTJ))="" ; VISIT ALL RESULTS 123855 "RTN","C0CVIT2",447,0) 123856 . S VDTJ=$O(VIT(VDTJ)) ; NEXT RESULT 123857 "RTN","C0CVIT2",448,0) 123858 . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER 123859 "RTN","C0CVIT2",449,0) 123860 . S VDT(VTDCNT)=$P(VIT(VDTJ),U,4) ; PULL OUT THE DATE 123861 "RTN","C0CVIT2",450,0) 123862 S VDT(0)=VTDCNT 123863 "RTN","C0CVIT2",451,0) 123430 123864 Q 123431 "RTN","C0CVIT2",323,0) 123432 ; 123433 "RTN","C0CVIT2",324,0) 123434 WEIGHT1(DT,ACTOR,VALUE,UNIT) 123435 "RTN","C0CVIT2",325,0) 123436 I DEBUG W "IN VITAL: WEIGHT",! 123437 "RTN","C0CVIT2",326,0) 123438 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC 123439 "RTN","C0CVIT2",327,0) 123440 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 123441 "RTN","C0CVIT2",328,0) 123442 S ZRNF("VITALSIGNSEXACTDATETIME")=DT 123443 "RTN","C0CVIT2",329,0) 123444 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT" 123445 "RTN","C0CVIT2",330,0) 123446 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123447 "RTN","C0CVIT2",331,0) 123448 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC 123449 "RTN","C0CVIT2",332,0) 123450 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123451 "RTN","C0CVIT2",333,0) 123452 S ZRNF("VITALSIGNSDESCCODEVALUE")="107647005" 123453 "RTN","C0CVIT2",334,0) 123454 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 123455 "RTN","C0CVIT2",335,0) 123456 S ZRNF("VITALSIGNSCODEVERSION")="" 123457 "RTN","C0CVIT2",336,0) 123458 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR 123459 "RTN","C0CVIT2",337,0) 123460 S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE 123461 "RTN","C0CVIT2",338,0) 123462 S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT 123463 "RTN","C0CVIT2",339,0) 123865 "RTN","C0CVIT2",452,0) 123866 ; 123867 "RTN","C0CVIT2",453,0) 123868 MAP(VITXML,C0CVIT,VITOUT) ; MAP VITAL SIGNS XML 123869 "RTN","C0CVIT2",454,0) 123870 ; 123871 "RTN","C0CVIT2",455,0) 123872 N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"VITTEMP")) ;WORK AREA FOR TEMPLATE 123873 "RTN","C0CVIT2",456,0) 123874 K @ZTEMP 123875 "RTN","C0CVIT2",457,0) 123876 N ZBLD 123877 "RTN","C0CVIT2",458,0) 123878 S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"VITBLD")) ; BUILD LIST AREA 123879 "RTN","C0CVIT2",459,0) 123880 D QUEUE^C0CXPATH(ZBLD,VITXML,1,1) ; FIRST LINE 123881 "RTN","C0CVIT2",460,0) 123882 N ZINNER 123883 "RTN","C0CVIT2",461,0) 123884 ; XPATH NEEDS TO MATCH YOUR SECTION 123885 "RTN","C0CVIT2",462,0) 123886 D QUERY^C0CXPATH(VITXML,"//VitalSigns/Result","ZINNER") ;ONE VITAL SIGN 123887 "RTN","C0CVIT2",463,0) 123888 N ZTMP,ZVAR,ZI 123889 "RTN","C0CVIT2",464,0) 123890 S ZI="" 123891 "RTN","C0CVIT2",465,0) 123892 F S ZI=$O(@C0CVIT@("V",ZI)) Q:ZI="" D ;FOR EACH VITAL SIGN 123893 "RTN","C0CVIT2",466,0) 123894 . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS VITAL SIGN XML 123895 "RTN","C0CVIT2",467,0) 123896 . S ZVAR=$NA(@C0CVIT@("V",ZI)) ;THIS VITAL SIGN VARIABLES 123897 "RTN","C0CVIT2",468,0) 123898 . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE VITAL SIGN 123899 "RTN","C0CVIT2",469,0) 123900 . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUEUE FOR BUILD 123901 "RTN","C0CVIT2",470,0) 123902 D QUEUE^C0CXPATH(ZBLD,VITXML,@VITXML@(0),@VITXML@(0)) 123903 "RTN","C0CVIT2",471,0) 123904 N ZZTMP ; IS THIS NEEDED? 123905 "RTN","C0CVIT2",472,0) 123906 D BUILD^C0CXPATH(ZBLD,VITOUT) ;BUILD FINAL XML 123907 "RTN","C0CVIT2",473,0) 123908 K @ZTEMP,@ZBLD 123909 "RTN","C0CVIT2",474,0) 123464 123910 Q 123465 "RTN","C0CVIT2",340,0)123466 ;123467 "RTN","C0CVIT2",341,0)123468 BP1(DT,ACTOR,VALUE,UNIT)123469 "RTN","C0CVIT2",342,0)123470 I DEBUG W "IN VITAL: BLOOD PRESSURE",!123471 "RTN","C0CVIT2",343,0)123472 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC123473 "RTN","C0CVIT2",344,0)123474 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"123475 "RTN","C0CVIT2",345,0)123476 S ZRNF("VITALSIGNSEXACTDATETIME")=DT123477 "RTN","C0CVIT2",346,0)123478 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"123479 "RTN","C0CVIT2",347,0)123480 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"123481 "RTN","C0CVIT2",348,0)123482 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC123483 "RTN","C0CVIT2",349,0)123484 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"123485 "RTN","C0CVIT2",350,0)123486 S ZRNF("VITALSIGNSDESCCODEVALUE")="392570002"123487 "RTN","C0CVIT2",351,0)123488 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"123489 "RTN","C0CVIT2",352,0)123490 S ZRNF("VITALSIGNSCODEVERSION")=""123491 "RTN","C0CVIT2",353,0)123492 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR123493 "RTN","C0CVIT2",354,0)123494 S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE123495 "RTN","C0CVIT2",355,0)123496 S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT123497 "RTN","C0CVIT2",356,0)123498 Q123499 "RTN","C0CVIT2",357,0)123500 ;123501 "RTN","C0CVIT2",358,0)123502 TMP1(DT,ACTOR,VALUE,UNIT)123503 "RTN","C0CVIT2",359,0)123504 I DEBUG W "IN VITAL: TEMPERATURE",!123505 "RTN","C0CVIT2",360,0)123506 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC123507 "RTN","C0CVIT2",361,0)123508 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"123509 "RTN","C0CVIT2",362,0)123510 S ZRNF("VITALSIGNSEXACTDATETIME")=DT123511 "RTN","C0CVIT2",363,0)123512 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"123513 "RTN","C0CVIT2",364,0)123514 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"123515 "RTN","C0CVIT2",365,0)123516 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC123517 "RTN","C0CVIT2",366,0)123518 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"123519 "RTN","C0CVIT2",367,0)123520 S ZRNF("VITALSIGNSDESCCODEVALUE")="309646008"123521 "RTN","C0CVIT2",368,0)123522 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"123523 "RTN","C0CVIT2",369,0)123524 S ZRNF("VITALSIGNSCODEVERSION")=""123525 "RTN","C0CVIT2",370,0)123526 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR123527 "RTN","C0CVIT2",371,0)123528 S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE123529 "RTN","C0CVIT2",372,0)123530 S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT123531 "RTN","C0CVIT2",373,0)123532 Q123533 "RTN","C0CVIT2",374,0)123534 ;123535 "RTN","C0CVIT2",375,0)123536 RESP1(DT,ACTOR,VALUE,UNIT)123537 "RTN","C0CVIT2",376,0)123538 I DEBUG W "IN VITAL: RESPIRATION",!123539 "RTN","C0CVIT2",377,0)123540 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC123541 "RTN","C0CVIT2",378,0)123542 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"123543 "RTN","C0CVIT2",379,0)123544 S ZRNF("VITALSIGNSEXACTDATETIME")=DT123545 "RTN","C0CVIT2",380,0)123546 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"123547 "RTN","C0CVIT2",381,0)123548 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"123549 "RTN","C0CVIT2",382,0)123550 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC123551 "RTN","C0CVIT2",383,0)123552 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"123553 "RTN","C0CVIT2",384,0)123554 S ZRNF("VITALSIGNSDESCCODEVALUE")="366147009"123555 "RTN","C0CVIT2",385,0)123556 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"123557 "RTN","C0CVIT2",386,0)123558 S ZRNF("VITALSIGNSCODEVERSION")=""123559 "RTN","C0CVIT2",387,0)123560 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR123561 "RTN","C0CVIT2",388,0)123562 S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE123563 "RTN","C0CVIT2",389,0)123564 S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT123565 "RTN","C0CVIT2",390,0)123566 Q123567 "RTN","C0CVIT2",391,0)123568 ;123569 "RTN","C0CVIT2",392,0)123570 PULSE1(DT,ACTOR,VALUE,UNIT)123571 "RTN","C0CVIT2",393,0)123572 I DEBUG W "IN VITAL: PULSE",!123573 "RTN","C0CVIT2",394,0)123574 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC123575 "RTN","C0CVIT2",395,0)123576 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"123577 "RTN","C0CVIT2",396,0)123578 S ZRNF("VITALSIGNSEXACTDATETIME")=DT123579 "RTN","C0CVIT2",397,0)123580 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PULSE"123581 "RTN","C0CVIT2",398,0)123582 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"123583 "RTN","C0CVIT2",399,0)123584 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC123585 "RTN","C0CVIT2",400,0)123586 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"123587 "RTN","C0CVIT2",401,0)123588 S ZRNF("VITALSIGNSDESCCODEVALUE")="366199006"123589 "RTN","C0CVIT2",402,0)123590 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"123591 "RTN","C0CVIT2",403,0)123592 S ZRNF("VITALSIGNSCODEVERSION")=""123593 "RTN","C0CVIT2",404,0)123594 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR123595 "RTN","C0CVIT2",405,0)123596 S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE123597 "RTN","C0CVIT2",406,0)123598 S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT123599 "RTN","C0CVIT2",407,0)123600 Q123601 "RTN","C0CVIT2",408,0)123602 ;123603 "RTN","C0CVIT2",409,0)123604 PAIN1(DT,ACTOR,VALUE,UNIT)123605 "RTN","C0CVIT2",410,0)123606 I DEBUG W "IN VITAL: PAIN",!123607 "RTN","C0CVIT2",411,0)123608 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC123609 "RTN","C0CVIT2",412,0)123610 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"123611 "RTN","C0CVIT2",413,0)123612 S ZRNF("VITALSIGNSEXACTDATETIME")=DT123613 "RTN","C0CVIT2",414,0)123614 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PAIN"123615 "RTN","C0CVIT2",415,0)123616 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"123617 "RTN","C0CVIT2",416,0)123618 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC123619 "RTN","C0CVIT2",417,0)123620 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"123621 "RTN","C0CVIT2",418,0)123622 S ZRNF("VITALSIGNSDESCCODEVALUE")="22253000"123623 "RTN","C0CVIT2",419,0)123624 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"123625 "RTN","C0CVIT2",420,0)123626 S ZRNF("VITALSIGNSCODEVERSION")=""123627 "RTN","C0CVIT2",421,0)123628 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR123629 "RTN","C0CVIT2",422,0)123630 S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE123631 "RTN","C0CVIT2",423,0)123632 S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT123633 "RTN","C0CVIT2",424,0)123634 Q123635 "RTN","C0CVIT2",425,0)123636 ;123637 "RTN","C0CVIT2",426,0)123638 OTHER1(DT,TEXT,ACTOR,VALUE,UNIT)123639 "RTN","C0CVIT2",427,0)123640 I DEBUG W "IN VITAL: OTHER",!123641 "RTN","C0CVIT2",428,0)123642 S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC123643 "RTN","C0CVIT2",429,0)123644 S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"123645 "RTN","C0CVIT2",430,0)123646 S ZRNF("VITALSIGNSEXACTDATETIME")=DT123647 "RTN","C0CVIT2",431,0)123648 S ZRNF("VITALSIGNSDESCRIPTIONTEXT")=TEXT123649 "RTN","C0CVIT2",432,0)123650 S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"123651 "RTN","C0CVIT2",433,0)123652 S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC123653 "RTN","C0CVIT2",434,0)123654 S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"123655 "RTN","C0CVIT2",435,0)123656 S ZRNF("VITALSIGNSDESCCODEVALUE")=""123657 "RTN","C0CVIT2",436,0)123658 S ZRNF("VITALSIGNSDESCCODINGSYSTEM")=""123659 "RTN","C0CVIT2",437,0)123660 S ZRNF("VITALSIGNSCODEVERSION")=""123661 "RTN","C0CVIT2",438,0)123662 S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR123663 "RTN","C0CVIT2",439,0)123664 S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE123665 "RTN","C0CVIT2",440,0)123666 S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT123667 "RTN","C0CVIT2",441,0)123668 Q123669 "RTN","C0CVIT2",442,0)123670 ;123671 "RTN","C0CVIT2",443,0)123672 VITSORT(VDT) ; RUN DATE SORTING ALGORITHM123673 "RTN","C0CVIT2",444,0)123674 ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY123675 "RTN","C0CVIT2",445,0)123676 ; OF DATES IN THE VITALS RESULTS123677 "RTN","C0CVIT2",446,0)123678 N VDTI,VDTJ,VTDCNT123679 "RTN","C0CVIT2",447,0)123680 S VTDCNT=0 ; COUNT TO BUILD ARRAY123681 "RTN","C0CVIT2",448,0)123682 S VDTJ="" ; USED TO VISIT THE RESULTS123683 "RTN","C0CVIT2",449,0)123684 F VDTI=0:0 D Q:$O(VIT(VDTJ))="" ; VISIT ALL RESULTS123685 "RTN","C0CVIT2",450,0)123686 . S VDTJ=$O(VIT(VDTJ)) ; NEXT RESULT123687 "RTN","C0CVIT2",451,0)123688 . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER123689 "RTN","C0CVIT2",452,0)123690 . S VDT(VTDCNT)=$P(VIT(VDTJ),U,4) ; PULL OUT THE DATE123691 "RTN","C0CVIT2",453,0)123692 S VDT(0)=VTDCNT123693 "RTN","C0CVIT2",454,0)123694 Q123695 "RTN","C0CVIT2",455,0)123696 ;123697 "RTN","C0CVIT2",456,0)123698 MAP(VITXML,C0CVIT,VITOUT) ; MAP VITAL SIGNS XML123699 "RTN","C0CVIT2",457,0)123700 ;123701 "RTN","C0CVIT2",458,0)123702 N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"VITTEMP")) ;WORK AREA FOR TEMPLATE123703 "RTN","C0CVIT2",459,0)123704 K @ZTEMP123705 "RTN","C0CVIT2",460,0)123706 N ZBLD123707 "RTN","C0CVIT2",461,0)123708 S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"VITBLD")) ; BUILD LIST AREA123709 "RTN","C0CVIT2",462,0)123710 D QUEUE^C0CXPATH(ZBLD,VITXML,1,1) ; FIRST LINE123711 "RTN","C0CVIT2",463,0)123712 N ZINNER123713 "RTN","C0CVIT2",464,0)123714 ; XPATH NEEDS TO MATCH YOUR SECTION123715 "RTN","C0CVIT2",465,0)123716 D QUERY^C0CXPATH(VITXML,"//VitalSigns/Result","ZINNER") ;ONE VITAL SIGN123717 "RTN","C0CVIT2",466,0)123718 N ZTMP,ZVAR,ZI123719 "RTN","C0CVIT2",467,0)123720 S ZI=""123721 "RTN","C0CVIT2",468,0)123722 F S ZI=$O(@C0CVIT@("V",ZI)) Q:ZI="" D ;FOR EACH VITAL SIGN123723 "RTN","C0CVIT2",469,0)123724 . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS VITAL SIGN XML123725 "RTN","C0CVIT2",470,0)123726 . S ZVAR=$NA(@C0CVIT@("V",ZI)) ;THIS VITAL SIGN VARIABLES123727 "RTN","C0CVIT2",471,0)123728 . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE VITAL SIGN123729 "RTN","C0CVIT2",472,0)123730 . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUEUE FOR BUILD123731 "RTN","C0CVIT2",473,0)123732 D QUEUE^C0CXPATH(ZBLD,VITXML,@VITXML@(0),@VITXML@(0))123733 "RTN","C0CVIT2",474,0)123734 N ZZTMP ; IS THIS NEEDED?123735 123911 "RTN","C0CVIT2",475,0) 123736 D BUILD^C0CXPATH(ZBLD,VITOUT) ;BUILD FINAL XML123737 "RTN","C0CVIT2",476,0)123738 K @ZTEMP,@ZBLD123739 "RTN","C0CVIT2",477,0)123740 Q123741 "RTN","C0CVIT2",478,0)123742 123912 ; 123743 123913 "RTN","C0CVITAL") 123744 0^36^B31 9933080123914 0^36^B314693716 123745 123915 "RTN","C0CVITAL",1,0) 123746 123916 C0CVITAL ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08 123747 123917 "RTN","C0CVITAL",2,0) 123748 ;;1.2;C 0C;;May 11, 2012;Build 50123918 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 123749 123919 "RTN","C0CVITAL",3,0) 123750 ; Copyright 2008,2009 George Lilly, University of Minnesota and others.123920 ; 123751 123921 "RTN","C0CVITAL",4,0) 123752 ; Licensed under the terms of the GNU General Public License.123922 ; This program is free software: you can redistribute it and/or modify 123753 123923 "RTN","C0CVITAL",5,0) 123754 ; See attached copy of the License.123924 ; it under the terms of the GNU Affero General Public License as 123755 123925 "RTN","C0CVITAL",6,0) 123756 ; 123926 ; published by the Free Software Foundation, either version 3 of the 123757 123927 "RTN","C0CVITAL",7,0) 123758 ; This program is free software; you can redistribute it and/or modify123928 ; License, or (at your option) any later version. 123759 123929 "RTN","C0CVITAL",8,0) 123760 ; it under the terms of the GNU General Public License as published by123930 ; 123761 123931 "RTN","C0CVITAL",9,0) 123762 ; the Free Software Foundation; either version 2 of the License, or123932 ; This program is distributed in the hope that it will be useful, 123763 123933 "RTN","C0CVITAL",10,0) 123764 ; (at your option) any later version.123934 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 123765 123935 "RTN","C0CVITAL",11,0) 123766 ; 123936 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 123767 123937 "RTN","C0CVITAL",12,0) 123768 ; This program is distributed in the hope that it will be useful,123938 ; GNU Affero General Public License for more details. 123769 123939 "RTN","C0CVITAL",13,0) 123770 ; but WITHOUT ANY WARRANTY; without even the implied warranty of123940 ; 123771 123941 "RTN","C0CVITAL",14,0) 123772 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the123942 ; You should have received a copy of the GNU Affero General Public License 123773 123943 "RTN","C0CVITAL",15,0) 123774 ; GNU General Public License for more details.123944 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 123775 123945 "RTN","C0CVITAL",16,0) 123776 123946 ; 123777 123947 "RTN","C0CVITAL",17,0) 123778 ;You should have received a copy of the GNU General Public License along123948 W "NO ENTRY FROM TOP",! 123779 123949 "RTN","C0CVITAL",18,0) 123780 ;with this program; if not, write to the Free Software Foundation, Inc.,123950 Q 123781 123951 "RTN","C0CVITAL",19,0) 123782 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.123952 ; 123783 123953 "RTN","C0CVITAL",20,0) 123784 ; 123954 EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE 123785 123955 "RTN","C0CVITAL",21,0) 123786 W "NO ENTRY FROM TOP",!123956 ; 123787 123957 "RTN","C0CVITAL",22,0) 123958 ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED 123959 "RTN","C0CVITAL",23,0) 123960 ; IVITXML CONTAINS ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE 123961 "RTN","C0CVITAL",24,0) 123962 ; 123963 "RTN","C0CVITAL",25,0) 123964 N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF,VORDR 123965 "RTN","C0CVITAL",26,0) 123966 S C0CVLMT=$$GET^C0CPARMS("VITLIMIT") ; GET THE LIMIT PARM 123967 "RTN","C0CVITAL",27,0) 123968 S C0CVSTRT=$$GET^C0CPARMS("VITSTART") ; GET START PARM 123969 "RTN","C0CVITAL",28,0) 123970 D DT^DILF(,C0CVLMT,.C0CEDT) ; 123971 "RTN","C0CVITAL",29,0) 123972 D DT^DILF(,C0CVSTRT,.C0CSDT) ; 123973 "RTN","C0CVITAL",30,0) 123974 ;D DT^DILF(,C0CVLMT,.C0CSDT) ; GPL TESTING 123975 "RTN","C0CVITAL",31,0) 123976 ;D DT^DILF(,C0CVSTRT,.C0CEDT) ; 123977 "RTN","C0CVITAL",32,0) 123978 W "VITALS START: ",C0CVSTRT," LIMIT: ",C0CVLMT,! 123979 "RTN","C0CVITAL",33,0) 123980 I $$RPMS^C0CUTIL() D VITRPMS QUIT 123981 "RTN","C0CVITAL",34,0) 123982 I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VITVISTA QUIT 123983 "RTN","C0CVITAL",35,0) 123984 ;I $$SYSNAME^C0CSYS()="RPMS" D VITRPMS 123985 "RTN","C0CVITAL",36,0) 123986 ;E D VITVISTA 123987 "RTN","C0CVITAL",37,0) 123788 123988 Q 123789 "RTN","C0CVITAL",23,0)123790 ;123791 "RTN","C0CVITAL",24,0)123792 EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE123793 "RTN","C0CVITAL",25,0)123794 ;123795 "RTN","C0CVITAL",26,0)123796 ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED123797 "RTN","C0CVITAL",27,0)123798 ; IVITXML CONTAINS ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE123799 "RTN","C0CVITAL",28,0)123800 ;123801 "RTN","C0CVITAL",29,0)123802 N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF,VORDR123803 "RTN","C0CVITAL",30,0)123804 S C0CVLMT=$$GET^C0CPARMS("VITLIMIT") ; GET THE LIMIT PARM123805 "RTN","C0CVITAL",31,0)123806 S C0CVSTRT=$$GET^C0CPARMS("VITSTART") ; GET START PARM123807 "RTN","C0CVITAL",32,0)123808 D DT^DILF(,C0CVLMT,.C0CEDT) ;123809 "RTN","C0CVITAL",33,0)123810 D DT^DILF(,C0CVSTRT,.C0CSDT) ;123811 "RTN","C0CVITAL",34,0)123812 ;D DT^DILF(,C0CVLMT,.C0CSDT) ; GPL TESTING123813 "RTN","C0CVITAL",35,0)123814 ;D DT^DILF(,C0CVSTRT,.C0CEDT) ;123815 "RTN","C0CVITAL",36,0)123816 W "VITALS START: ",C0CVSTRT," LIMIT: ",C0CVLMT,!123817 "RTN","C0CVITAL",37,0)123818 I $$RPMS^C0CUTIL() D VITRPMS QUIT123819 123989 "RTN","C0CVITAL",38,0) 123820 I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VITVISTA QUIT123990 ; 123821 123991 "RTN","C0CVITAL",39,0) 123822 ;I $$SYSNAME^C0CSYS()="RPMS" D VITRPMS 123992 VITVISTA ; EXTRACT VITALS FROM VISTA INTO PROVIDED XML TEMPLATE 123823 123993 "RTN","C0CVITAL",40,0) 123824 ;E D VITVISTA123994 D FASTVIT^ORQQVI(.VITRSLT,DFN,C0CEDT,C0CSDT) ; GPL THIS ONE WORKS FOR AT 123825 123995 "RTN","C0CVITAL",41,0) 123826 Q123996 ; LEAST ONE SET OF VITALS - TO DO, CALL IT REPETIVELY TO GET EARLIER VITALS 123827 123997 "RTN","C0CVITAL",42,0) 123828 ; 123998 ;D VITALS^ORQQVI(.VITRSLT,DFN,C0CEDT,C0CSDT) 123829 123999 "RTN","C0CVITAL",43,0) 123830 VITVISTA ; EXTRACT VITALS FROM VISTA INTO PROVIDED XML TEMPLATE 124000 ;D VITALS^ORQQVI(.VITRSLT,DFN,C0CSDT,C0CEDT) 123831 124001 "RTN","C0CVITAL",44,0) 123832 D FASTVIT^ORQQVI(.VITRSLT,DFN,C0CEDT,C0CSDT) ; GPL THIS ONE WORKS FOR AT124002 ;D VITALS^ORQQVI(.VITRSLT,DFN,C0CVSTRT,C0CVLMT) ; GPL LET GMR HANDLE THE DATES 123833 124003 "RTN","C0CVITAL",45,0) 123834 ; LEAST ONE SET OF VITALS - TO DO, CALL IT REPETIVELY TO GET EARLIER VITALS124004 I '$D(VITRSLT(1)) S @VITOUTXML@(0)=0 Q ; RETURN NOT FOUND AND QUIT 123835 124005 "RTN","C0CVITAL",46,0) 123836 ;D VITALS^ORQQVI(.VITRSLT,DFN,C0CEDT,C0CSDT)124006 I $P(VITRSLT(1),U,2)="No vitals found." D Q ; NULL RESULT FROM RPC 123837 124007 "RTN","C0CVITAL",47,0) 123838 ;D VITALS^ORQQVI(.VITRSLT,DFN,C0CSDT,C0CEDT)124008 . I DEBUG W "NO VITALS FOUND FROM VITALS RPC",! 123839 124009 "RTN","C0CVITAL",48,0) 123840 ;D VITALS^ORQQVI(.VITRSLT,DFN,C0CVSTRT,C0CVLMT) ; GPL LET GMR HANDLE THE DATES124010 . S @VITOUTXML@(0)=0 123841 124011 "RTN","C0CVITAL",49,0) 123842 I '$D(VITRSLT(1)) S @VITOUTXML@(0)=0 Q ; RETURN NOT FOUND ANDQUIT124012 I $P(VITRSLT(1),U,2)="No vitals found." Q ; QUIT 123843 124013 "RTN","C0CVITAL",50,0) 123844 I $P(VITRSLT(1),U,2)="No vitals found." D Q ; NULL RESULT FROM RPC124014 ; ZWR RPCRSLT 123845 124015 "RTN","C0CVITAL",51,0) 123846 . I DEBUG W "NO VITALS FOUND FROM VITALS RPC",!124016 S VITTVMAP=$NA(^TMP("C0CCCR",$J,"VITALS")) 123847 124017 "RTN","C0CVITAL",52,0) 123848 . S @VITOUTXML@(0)=0124018 S VITTARYTMP=$NA(^TMP("C0CCCR",$J,"VITALARYTMP")) 123849 124019 "RTN","C0CVITAL",53,0) 123850 I $P(VITRSLT(1),U,2)="No vitals found." Q ; QUIT124020 K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES 123851 124021 "RTN","C0CVITAL",54,0) 123852 ; ZWR RPCRSLT124022 N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX 123853 124023 "RTN","C0CVITAL",55,0) 123854 S VITTVMAP=$NA(^TMP("C0CCCR",$J,"VITALS"))124024 D SORTVIST(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY 123855 124025 "RTN","C0CVITAL",56,0) 123856 S VITTARYTMP=$NA(^TMP("C0CCCR",$J,"VITALARYTMP"))124026 ; I DEBUG ZWR VDATES ;DEBUG 123857 124027 "RTN","C0CVITAL",57,0) 123858 K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES124028 S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE 123859 124029 "RTN","C0CVITAL",58,0) 123860 N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX124030 ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY 123861 124031 "RTN","C0CVITAL",59,0) 123862 D VITDVISTA(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY124032 S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS 123863 124033 "RTN","C0CVITAL",60,0) 123864 I DEBUG ZWR VDATES ;DEBUG124034 F J=1:1:VCNT D ; FOR EACH VITAL IN THE LIST 123865 124035 "RTN","C0CVITAL",61,0) 123866 S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE124036 . I $D(VITRSLT(VSORT(J))) D 123867 124037 "RTN","C0CVITAL",62,0) 123868 ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY124038 . . S VITVMAP=$NA(@VITTVMAP@(J)) 123869 124039 "RTN","C0CVITAL",63,0) 123870 S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS124040 . . K @VITVMAP 123871 124041 "RTN","C0CVITAL",64,0) 123872 F J=1:1:VCNT D ; FOR EACH VITAL IN THE LIST124042 . . I DEBUG W "VMAP= ",VITVMAP,! 123873 124043 "RTN","C0CVITAL",65,0) 123874 . I $D(VITRSLT(VSORT(J))) D124044 . . S VITPTMP=VITRSLT(VSORT(J)) ; DATE SORTED VITAL FROM RETURN ARRAY 123875 124045 "RTN","C0CVITAL",66,0) 123876 . . S VITVMAP=$NA(@VITTVMAP@(J))124046 . . I DEBUG W "VITAL ",VSORT(J),! 123877 124047 "RTN","C0CVITAL",67,0) 123878 . . K @VITVMAP124048 . . I DEBUG W VITRSLT(VSORT(J))," ",$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT"),! 123879 124049 "RTN","C0CVITAL",68,0) 123880 . . I DEBUG W "VMAP= ",VITVMAP,!124050 . . I DEBUG W $P(VITPTMP,U,4),! 123881 124051 "RTN","C0CVITAL",69,0) 123882 . . S VITPTMP=VITRSLT(VSORT(J)) ; DATE SORTED VITAL FROM RETURN ARRAY124052 . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID 123883 124053 "RTN","C0CVITAL",70,0) 123884 . . I DEBUG W "VITAL ",VSORT(J),!124054 . . ;B ;gpl 123885 124055 "RTN","C0CVITAL",71,0) 123886 . . I DEBUG W VITRSLT(VSORT(J))," ",$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT"),!124056 . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^GMR(120.5,$P(VITPTMP,U,1),0)),U,6) 123887 124057 "RTN","C0CVITAL",72,0) 123888 . . I DEBUG W $P(VITPTMP,U,4),!124058 . . I @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_" D ; 123889 124059 "RTN","C0CVITAL",73,0) 123890 . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID124060 . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORSYSTEM_1" 123891 124061 "RTN","C0CVITAL",74,0) 123892 . . ;B ;gpl124062 . . I $P(VITPTMP,U,2)="HT" D 123893 124063 "RTN","C0CVITAL",75,0) 123894 . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^GMR(120.5,$P(VITPTMP,U,1),0)),U,6)124064 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 123895 124065 "RTN","C0CVITAL",76,0) 123896 . . I @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_" D ;124066 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT") 123897 124067 "RTN","C0CVITAL",77,0) 123898 . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORSYSTEM_1"124068 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT" 123899 124069 "RTN","C0CVITAL",78,0) 123900 . . I $P(VITPTMP,U,2)="HT" D124070 . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123901 124071 "RTN","C0CVITAL",79,0) 123902 . . . S @VITVMAP@("VITALSIGNS DATETIMETYPETEXT")="OBSERVED"124072 . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J 123903 124073 "RTN","C0CVITAL",80,0) 123904 . . . S @VITVMAP@("VITALSIGNS EXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")124074 . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123905 124075 "RTN","C0CVITAL",81,0) 123906 124076 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT" 123907 124077 "RTN","C0CVITAL",82,0) 124078 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="248327008" 124079 "RTN","C0CVITAL",83,0) 124080 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 124081 "RTN","C0CVITAL",84,0) 124082 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")="" 124083 "RTN","C0CVITAL",85,0) 124084 . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6) 124085 "RTN","C0CVITAL",86,0) 124086 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3) 124087 "RTN","C0CVITAL",87,0) 124088 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in" 124089 "RTN","C0CVITAL",88,0) 124090 . . E I $P(VITPTMP,U,2)="WT" D 124091 "RTN","C0CVITAL",89,0) 124092 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 124093 "RTN","C0CVITAL",90,0) 124094 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT") 124095 "RTN","C0CVITAL",91,0) 124096 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT" 124097 "RTN","C0CVITAL",92,0) 123908 124098 . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123909 "RTN","C0CVITAL", 83,0)124099 "RTN","C0CVITAL",93,0) 123910 124100 . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J 123911 "RTN","C0CVITAL", 84,0)124101 "RTN","C0CVITAL",94,0) 123912 124102 . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123913 "RTN","C0CVITAL",85,0)123914 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"123915 "RTN","C0CVITAL",86,0)123916 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="248327008"123917 "RTN","C0CVITAL",87,0)123918 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"123919 "RTN","C0CVITAL",88,0)123920 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""123921 "RTN","C0CVITAL",89,0)123922 . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)123923 "RTN","C0CVITAL",90,0)123924 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)123925 "RTN","C0CVITAL",91,0)123926 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"123927 "RTN","C0CVITAL",92,0)123928 . . E I $P(VITPTMP,U,2)="WT" D123929 "RTN","C0CVITAL",93,0)123930 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"123931 "RTN","C0CVITAL",94,0)123932 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")123933 124103 "RTN","C0CVITAL",95,0) 123934 124104 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT" 123935 124105 "RTN","C0CVITAL",96,0) 124106 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="107647005" 124107 "RTN","C0CVITAL",97,0) 124108 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 124109 "RTN","C0CVITAL",98,0) 124110 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")="" 124111 "RTN","C0CVITAL",99,0) 124112 . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6) 124113 "RTN","C0CVITAL",100,0) 124114 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3) 124115 "RTN","C0CVITAL",101,0) 124116 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs" 124117 "RTN","C0CVITAL",102,0) 124118 . . E I $P(VITPTMP,U,2)="BP" D 124119 "RTN","C0CVITAL",103,0) 124120 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 124121 "RTN","C0CVITAL",104,0) 124122 . . . ;S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT") 124123 "RTN","C0CVITAL",105,0) 124124 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE" 124125 "RTN","C0CVITAL",106,0) 123936 124126 . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123937 "RTN","C0CVITAL", 97,0)124127 "RTN","C0CVITAL",107,0) 123938 124128 . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J 123939 "RTN","C0CVITAL", 98,0)124129 "RTN","C0CVITAL",108,0) 123940 124130 . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123941 "RTN","C0CVITAL",99,0)123942 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"123943 "RTN","C0CVITAL",100,0)123944 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="107647005"123945 "RTN","C0CVITAL",101,0)123946 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"123947 "RTN","C0CVITAL",102,0)123948 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""123949 "RTN","C0CVITAL",103,0)123950 . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)123951 "RTN","C0CVITAL",104,0)123952 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)123953 "RTN","C0CVITAL",105,0)123954 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"123955 "RTN","C0CVITAL",106,0)123956 . . E I $P(VITPTMP,U,2)="BP" D123957 "RTN","C0CVITAL",107,0)123958 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"123959 "RTN","C0CVITAL",108,0)123960 . . . ;S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")123961 124131 "RTN","C0CVITAL",109,0) 123962 124132 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE" 123963 124133 "RTN","C0CVITAL",110,0) 124134 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="392570002" 124135 "RTN","C0CVITAL",111,0) 124136 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 124137 "RTN","C0CVITAL",112,0) 124138 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")="" 124139 "RTN","C0CVITAL",113,0) 124140 . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6) 124141 "RTN","C0CVITAL",114,0) 124142 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3) 124143 "RTN","C0CVITAL",115,0) 124144 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="" 124145 "RTN","C0CVITAL",116,0) 124146 . . E I $P(VITPTMP,U,2)="T" D 124147 "RTN","C0CVITAL",117,0) 124148 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 124149 "RTN","C0CVITAL",118,0) 124150 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT") 124151 "RTN","C0CVITAL",119,0) 124152 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE" 124153 "RTN","C0CVITAL",120,0) 123964 124154 . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123965 "RTN","C0CVITAL",1 11,0)124155 "RTN","C0CVITAL",121,0) 123966 124156 . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J 123967 "RTN","C0CVITAL",1 12,0)124157 "RTN","C0CVITAL",122,0) 123968 124158 . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123969 "RTN","C0CVITAL",113,0)123970 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"123971 "RTN","C0CVITAL",114,0)123972 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="392570002"123973 "RTN","C0CVITAL",115,0)123974 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"123975 "RTN","C0CVITAL",116,0)123976 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""123977 "RTN","C0CVITAL",117,0)123978 . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)123979 "RTN","C0CVITAL",118,0)123980 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)123981 "RTN","C0CVITAL",119,0)123982 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""123983 "RTN","C0CVITAL",120,0)123984 . . E I $P(VITPTMP,U,2)="T" D123985 "RTN","C0CVITAL",121,0)123986 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"123987 "RTN","C0CVITAL",122,0)123988 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")123989 124159 "RTN","C0CVITAL",123,0) 123990 124160 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE" 123991 124161 "RTN","C0CVITAL",124,0) 124162 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="309646008" 124163 "RTN","C0CVITAL",125,0) 124164 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 124165 "RTN","C0CVITAL",126,0) 124166 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")="" 124167 "RTN","C0CVITAL",127,0) 124168 . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6) 124169 "RTN","C0CVITAL",128,0) 124170 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3) 124171 "RTN","C0CVITAL",129,0) 124172 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F" 124173 "RTN","C0CVITAL",130,0) 124174 . . E I $P(VITPTMP,U,2)="R" D 124175 "RTN","C0CVITAL",131,0) 124176 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 124177 "RTN","C0CVITAL",132,0) 124178 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT") 124179 "RTN","C0CVITAL",133,0) 124180 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION" 124181 "RTN","C0CVITAL",134,0) 123992 124182 . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 123993 "RTN","C0CVITAL",1 25,0)124183 "RTN","C0CVITAL",135,0) 123994 124184 . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J 123995 "RTN","C0CVITAL",1 26,0)124185 "RTN","C0CVITAL",136,0) 123996 124186 . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED" 123997 "RTN","C0CVITAL",127,0)123998 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"123999 "RTN","C0CVITAL",128,0)124000 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="309646008"124001 "RTN","C0CVITAL",129,0)124002 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"124003 "RTN","C0CVITAL",130,0)124004 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""124005 "RTN","C0CVITAL",131,0)124006 . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)124007 "RTN","C0CVITAL",132,0)124008 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)124009 "RTN","C0CVITAL",133,0)124010 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F"124011 "RTN","C0CVITAL",134,0)124012 . . E I $P(VITPTMP,U,2)="R" D124013 "RTN","C0CVITAL",135,0)124014 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"124015 "RTN","C0CVITAL",136,0)124016 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")124017 124187 "RTN","C0CVITAL",137,0) 124018 124188 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION" 124019 124189 "RTN","C0CVITAL",138,0) 124190 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="366147009" 124191 "RTN","C0CVITAL",139,0) 124192 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 124193 "RTN","C0CVITAL",140,0) 124194 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")="" 124195 "RTN","C0CVITAL",141,0) 124196 . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6) 124197 "RTN","C0CVITAL",142,0) 124198 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3) 124199 "RTN","C0CVITAL",143,0) 124200 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="" 124201 "RTN","C0CVITAL",144,0) 124202 . . E I $P(VITPTMP,U,2)="P" D 124203 "RTN","C0CVITAL",145,0) 124204 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 124205 "RTN","C0CVITAL",146,0) 124206 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT") 124207 "RTN","C0CVITAL",147,0) 124208 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE" 124209 "RTN","C0CVITAL",148,0) 124020 124210 . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 124021 "RTN","C0CVITAL",1 39,0)124211 "RTN","C0CVITAL",149,0) 124022 124212 . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J 124023 "RTN","C0CVITAL",1 40,0)124213 "RTN","C0CVITAL",150,0) 124024 124214 . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED" 124025 "RTN","C0CVITAL",141,0)124026 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"124027 "RTN","C0CVITAL",142,0)124028 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="366147009"124029 "RTN","C0CVITAL",143,0)124030 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"124031 "RTN","C0CVITAL",144,0)124032 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""124033 "RTN","C0CVITAL",145,0)124034 . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)124035 "RTN","C0CVITAL",146,0)124036 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)124037 "RTN","C0CVITAL",147,0)124038 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""124039 "RTN","C0CVITAL",148,0)124040 . . E I $P(VITPTMP,U,2)="P" D124041 "RTN","C0CVITAL",149,0)124042 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"124043 "RTN","C0CVITAL",150,0)124044 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")124045 124215 "RTN","C0CVITAL",151,0) 124046 124216 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE" 124047 124217 "RTN","C0CVITAL",152,0) 124218 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="366199006" 124219 "RTN","C0CVITAL",153,0) 124220 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 124221 "RTN","C0CVITAL",154,0) 124222 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")="" 124223 "RTN","C0CVITAL",155,0) 124224 . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6) 124225 "RTN","C0CVITAL",156,0) 124226 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3) 124227 "RTN","C0CVITAL",157,0) 124228 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="" 124229 "RTN","C0CVITAL",158,0) 124230 . . E I $P(VITPTMP,U,2)="PN" D 124231 "RTN","C0CVITAL",159,0) 124232 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 124233 "RTN","C0CVITAL",160,0) 124234 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT") 124235 "RTN","C0CVITAL",161,0) 124236 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN" 124237 "RTN","C0CVITAL",162,0) 124048 124238 . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 124049 "RTN","C0CVITAL",1 53,0)124239 "RTN","C0CVITAL",163,0) 124050 124240 . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J 124051 "RTN","C0CVITAL",1 54,0)124241 "RTN","C0CVITAL",164,0) 124052 124242 . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED" 124053 "RTN","C0CVITAL",155,0)124054 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"124055 "RTN","C0CVITAL",156,0)124056 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="366199006"124057 "RTN","C0CVITAL",157,0)124058 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"124059 "RTN","C0CVITAL",158,0)124060 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""124061 "RTN","C0CVITAL",159,0)124062 . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)124063 "RTN","C0CVITAL",160,0)124064 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)124065 "RTN","C0CVITAL",161,0)124066 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""124067 "RTN","C0CVITAL",162,0)124068 . . E I $P(VITPTMP,U,2)="PN" D124069 "RTN","C0CVITAL",163,0)124070 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"124071 "RTN","C0CVITAL",164,0)124072 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")124073 124243 "RTN","C0CVITAL",165,0) 124074 124244 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN" 124075 124245 "RTN","C0CVITAL",166,0) 124246 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="22253000" 124247 "RTN","C0CVITAL",167,0) 124248 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 124249 "RTN","C0CVITAL",168,0) 124250 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")="" 124251 "RTN","C0CVITAL",169,0) 124252 . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6) 124253 "RTN","C0CVITAL",170,0) 124254 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3) 124255 "RTN","C0CVITAL",171,0) 124256 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="" 124257 "RTN","C0CVITAL",172,0) 124258 . . E I $P(VITPTMP,U,2)="BMI" D 124259 "RTN","C0CVITAL",173,0) 124260 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 124261 "RTN","C0CVITAL",174,0) 124262 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT") 124263 "RTN","C0CVITAL",175,0) 124264 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BMI" 124265 "RTN","C0CVITAL",176,0) 124076 124266 . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 124077 "RTN","C0CVITAL",1 67,0)124267 "RTN","C0CVITAL",177,0) 124078 124268 . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J 124079 "RTN","C0CVITAL",1 68,0)124269 "RTN","C0CVITAL",178,0) 124080 124270 . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED" 124081 "RTN","C0CVITAL",169,0)124082 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"124083 "RTN","C0CVITAL",170,0)124084 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="22253000"124085 "RTN","C0CVITAL",171,0)124086 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"124087 "RTN","C0CVITAL",172,0)124088 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""124089 "RTN","C0CVITAL",173,0)124090 . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)124091 "RTN","C0CVITAL",174,0)124092 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)124093 "RTN","C0CVITAL",175,0)124094 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""124095 "RTN","C0CVITAL",176,0)124096 . . E I $P(VITPTMP,U,2)="BMI" D124097 "RTN","C0CVITAL",177,0)124098 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"124099 "RTN","C0CVITAL",178,0)124100 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")124101 124271 "RTN","C0CVITAL",179,0) 124102 124272 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BMI" 124103 124273 "RTN","C0CVITAL",180,0) 124274 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="60621009" 124275 "RTN","C0CVITAL",181,0) 124276 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 124277 "RTN","C0CVITAL",182,0) 124278 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")="" 124279 "RTN","C0CVITAL",183,0) 124280 . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6) 124281 "RTN","C0CVITAL",184,0) 124282 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3) 124283 "RTN","C0CVITAL",185,0) 124284 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="" 124285 "RTN","C0CVITAL",186,0) 124286 . . E D 124287 "RTN","C0CVITAL",187,0) 124288 . . . ;W "IN VITAL: OTHER",! 124289 "RTN","C0CVITAL",188,0) 124290 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 124291 "RTN","C0CVITAL",189,0) 124292 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT") 124293 "RTN","C0CVITAL",190,0) 124294 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL" 124295 "RTN","C0CVITAL",191,0) 124104 124296 . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 124105 "RTN","C0CVITAL",1 81,0)124297 "RTN","C0CVITAL",192,0) 124106 124298 . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J 124107 "RTN","C0CVITAL",182,0) 124299 "RTN","C0CVITAL",193,0) 124300 . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="UNKNOWN" 124301 "RTN","C0CVITAL",194,0) 124302 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER" 124303 "RTN","C0CVITAL",195,0) 124304 . . . ;S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="" 124305 "RTN","C0CVITAL",196,0) 124306 . . . ;S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="" 124307 "RTN","C0CVITAL",197,0) 124308 . . . ;S @VITVMAP@("VITALSIGNSCODEVERSION")="" 124309 "RTN","C0CVITAL",198,0) 124310 . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^GMR(120.5,$P(VITPTMP,U,1),0)),U,6) 124311 "RTN","C0CVITAL",199,0) 124312 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3) 124313 "RTN","C0CVITAL",200,0) 124314 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN" 124315 "RTN","C0CVITAL",201,0) 124316 . . I @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_" D ; 124317 "RTN","C0CVITAL",202,0) 124318 . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORSYSTEM_1" ; 124319 "RTN","C0CVITAL",203,0) 124320 . . S VITARYTMP=$NA(@VITTARYTMP@(J)) 124321 "RTN","C0CVITAL",204,0) 124322 . . K @VITARYTMP 124323 "RTN","C0CVITAL",205,0) 124324 . . D MAP^C0CXPATH(VITXML,VITVMAP,VITARYTMP) 124325 "RTN","C0CVITAL",206,0) 124326 . . I J=1 D ; FIRST ONE IS JUST A COPY 124327 "RTN","C0CVITAL",207,0) 124328 . . . ; W "FIRST ONE",! 124329 "RTN","C0CVITAL",208,0) 124330 . . . D CP^C0CXPATH(VITARYTMP,VITOUTXML) 124331 "RTN","C0CVITAL",209,0) 124332 . . . I DEBUG W "VITOUTXML ",VITOUTXML,! 124333 "RTN","C0CVITAL",210,0) 124334 . . I J>1 D ; AFTER THE FIRST, INSERT INNER XML 124335 "RTN","C0CVITAL",211,0) 124336 . . . D INSINNER^C0CXPATH(VITOUTXML,VITARYTMP) 124337 "RTN","C0CVITAL",212,0) 124338 ; ZWR ^TMP($J,"VITALS",*) 124339 "RTN","C0CVITAL",213,0) 124340 ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS 124341 "RTN","C0CVITAL",214,0) 124342 I DEBUG D PARY^C0CXPATH(VITOUTXML) 124343 "RTN","C0CVITAL",215,0) 124344 N VITTMP,I 124345 "RTN","C0CVITAL",216,0) 124346 D MISSING^C0CXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS 124347 "RTN","C0CVITAL",217,0) 124348 I VITTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 124349 "RTN","C0CVITAL",218,0) 124350 . W "VITALS MISSING ",! 124351 "RTN","C0CVITAL",219,0) 124352 . F I=1:1:VITTMP(0) W VITTMP(I),! 124353 "RTN","C0CVITAL",220,0) 124354 Q 124355 "RTN","C0CVITAL",221,0) 124356 ; 124357 "RTN","C0CVITAL",222,0) 124358 VITRPMS ; EXTRACT VITALS FROM RPMS INTO PROVIDED XML TEMPLATE 124359 "RTN","C0CVITAL",223,0) 124360 ; RPMS VITAL RPC ONLY RETURNS LATEST VITAL IN SPECIFIED DATE RANGE NOT ALL VITALS IN DATE RANGE 124361 "RTN","C0CVITAL",224,0) 124362 ; WE NEED TO SETUP THE VARIABLES THE INTERNAL CALL NEEDS TO BYPASS A HARD CODE OF ONE VITAL FOR DATE RANGE 124363 "RTN","C0CVITAL",225,0) 124364 N END,START,DATA 124365 "RTN","C0CVITAL",226,0) 124366 D DT^DILF("",C0CVLMT,.END) 124367 "RTN","C0CVITAL",227,0) 124368 D DT^DILF("",C0CVSTRT,.START) 124369 "RTN","C0CVITAL",228,0) 124370 ; RPC OUTPUT FORMAT: 124371 "RTN","C0CVITAL",229,0) 124372 ; vfile ien^vital name^vital abbr^date/time taken(FM FORMAT)^value+units (US & metric) 124373 "RTN","C0CVITAL",230,0) 124374 D QUERY^BEHOVM("LISTX") ; RUN QUERY VITALS CALL 124375 "RTN","C0CVITAL",231,0) 124376 I '$D(^TMP("CIAVMRPC",$J)) S @VITOUTXML@(0)=0 Q ; RETURN NOT FOUND AND QUIT 124377 "RTN","C0CVITAL",232,0) 124378 ;ZW ^TMP("CIAVMRPC",$J) 124379 "RTN","C0CVITAL",233,0) 124380 S VITTVMAP=$NA(^TMP("C0CCCR",$J,"VITALS")) 124381 "RTN","C0CVITAL",234,0) 124382 S VITTARYTMP=$NA(^TMP("C0CCCR",$J,"VITALARYTMP")) 124383 "RTN","C0CVITAL",235,0) 124384 K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES 124385 "RTN","C0CVITAL",236,0) 124386 N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX 124387 "RTN","C0CVITAL",237,0) 124388 D SORTRPMS(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY 124389 "RTN","C0CVITAL",238,0) 124390 S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE 124391 "RTN","C0CVITAL",239,0) 124392 ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY 124393 "RTN","C0CVITAL",240,0) 124394 S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS 124395 "RTN","C0CVITAL",241,0) 124396 F J=1:1:VCNT D ; FOR EACH VITAL IN THE LIST 124397 "RTN","C0CVITAL",242,0) 124398 . I $D(^TMP("CIAVMRPC",$J,0,(VSORT(J)))) D 124399 "RTN","C0CVITAL",243,0) 124400 . . S VITVMAP=$NA(@VITTVMAP@(J)) 124401 "RTN","C0CVITAL",244,0) 124402 . . K @VITVMAP 124403 "RTN","C0CVITAL",245,0) 124404 . . I DEBUG W "VMAP= ",VITVMAP,! 124405 "RTN","C0CVITAL",246,0) 124406 . . S VITPTMP=^TMP("CIAVMRPC",$J,0,(VSORT(J))) ; DATE SORTED VITAL FROM RETURN ARRAY 124407 "RTN","C0CVITAL",247,0) 124408 . . I DEBUG W "VITAL ",VSORT(J),! 124409 "RTN","C0CVITAL",248,0) 124410 . . I DEBUG W ^TMP("CIAVMRPC",$J,0,(VSORT(J)))," ",$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT"),! 124411 "RTN","C0CVITAL",249,0) 124412 . . I DEBUG W $P(VITPTMP,U,4),! 124413 "RTN","C0CVITAL",250,0) 124414 . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID 124415 "RTN","C0CVITAL",251,0) 124416 . . I $P(VITPTMP,U,3)="HT" D 124417 "RTN","C0CVITAL",252,0) 124418 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 124419 "RTN","C0CVITAL",253,0) 124420 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT") 124421 "RTN","C0CVITAL",254,0) 124422 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT" 124423 "RTN","C0CVITAL",255,0) 124424 . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 124425 "RTN","C0CVITAL",256,0) 124426 . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J 124427 "RTN","C0CVITAL",257,0) 124108 124428 . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED" 124109 "RTN","C0CVITAL",183,0)124110 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BMI"124111 "RTN","C0CVITAL",184,0)124112 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="60621009"124113 "RTN","C0CVITAL",185,0)124114 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"124115 "RTN","C0CVITAL",186,0)124116 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""124117 "RTN","C0CVITAL",187,0)124118 . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)124119 "RTN","C0CVITAL",188,0)124120 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)124121 "RTN","C0CVITAL",189,0)124122 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""124123 "RTN","C0CVITAL",190,0)124124 . . E D124125 "RTN","C0CVITAL",191,0)124126 . . . ;W "IN VITAL: OTHER",!124127 "RTN","C0CVITAL",192,0)124128 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"124129 "RTN","C0CVITAL",193,0)124130 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")124131 "RTN","C0CVITAL",194,0)124132 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"124133 "RTN","C0CVITAL",195,0)124134 . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"124135 "RTN","C0CVITAL",196,0)124136 . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J124137 "RTN","C0CVITAL",197,0)124138 . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="UNKNOWN"124139 "RTN","C0CVITAL",198,0)124140 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"124141 "RTN","C0CVITAL",199,0)124142 . . . ;S @VITVMAP@("VITALSIGNSDESCCODEVALUE")=""124143 "RTN","C0CVITAL",200,0)124144 . . . ;S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")=""124145 "RTN","C0CVITAL",201,0)124146 . . . ;S @VITVMAP@("VITALSIGNSCODEVERSION")=""124147 "RTN","C0CVITAL",202,0)124148 . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^GMR(120.5,$P(VITPTMP,U,1),0)),U,6)124149 "RTN","C0CVITAL",203,0)124150 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)124151 "RTN","C0CVITAL",204,0)124152 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"124153 "RTN","C0CVITAL",205,0)124154 . . I @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_" D ;124155 "RTN","C0CVITAL",206,0)124156 . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORSYSTEM_1" ;124157 "RTN","C0CVITAL",207,0)124158 . . S VITARYTMP=$NA(@VITTARYTMP@(J))124159 "RTN","C0CVITAL",208,0)124160 . . K @VITARYTMP124161 "RTN","C0CVITAL",209,0)124162 . . D MAP^C0CXPATH(VITXML,VITVMAP,VITARYTMP)124163 "RTN","C0CVITAL",210,0)124164 . . I J=1 D ; FIRST ONE IS JUST A COPY124165 "RTN","C0CVITAL",211,0)124166 . . . ; W "FIRST ONE",!124167 "RTN","C0CVITAL",212,0)124168 . . . D CP^C0CXPATH(VITARYTMP,VITOUTXML)124169 "RTN","C0CVITAL",213,0)124170 . . . I DEBUG W "VITOUTXML ",VITOUTXML,!124171 "RTN","C0CVITAL",214,0)124172 . . I J>1 D ; AFTER THE FIRST, INSERT INNER XML124173 "RTN","C0CVITAL",215,0)124174 . . . D INSINNER^C0CXPATH(VITOUTXML,VITARYTMP)124175 "RTN","C0CVITAL",216,0)124176 ; ZWR ^TMP($J,"VITALS",*)124177 "RTN","C0CVITAL",217,0)124178 ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS124179 "RTN","C0CVITAL",218,0)124180 I DEBUG D PARY^C0CXPATH(VITOUTXML)124181 "RTN","C0CVITAL",219,0)124182 N VITTMP,I124183 "RTN","C0CVITAL",220,0)124184 D MISSING^C0CXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS124185 "RTN","C0CVITAL",221,0)124186 I VITTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@124187 "RTN","C0CVITAL",222,0)124188 . W "VITALS MISSING ",!124189 "RTN","C0CVITAL",223,0)124190 . F I=1:1:VITTMP(0) W VITTMP(I),!124191 "RTN","C0CVITAL",224,0)124192 Q124193 "RTN","C0CVITAL",225,0)124194 ;124195 "RTN","C0CVITAL",226,0)124196 VITRPMS ; EXTRACT VITALS FROM RPMS INTO PROVIDED XML TEMPLATE124197 "RTN","C0CVITAL",227,0)124198 ; RPMS VITAL RPC ONLY RETURNS LATEST VITAL IN SPECIFIED DATE RANGE NOT ALL VITALS IN DATE RANGE124199 "RTN","C0CVITAL",228,0)124200 ; WE NEED TO SETUP THE VARIABLES THE INTERNAL CALL NEEDS TO BYPASS A HARD CODE OF ONE VITAL FOR DATE RANGE124201 "RTN","C0CVITAL",229,0)124202 N END,START,DATA124203 "RTN","C0CVITAL",230,0)124204 D DT^DILF("",C0CVLMT,.END)124205 "RTN","C0CVITAL",231,0)124206 D DT^DILF("",C0CVSTRT,.START)124207 "RTN","C0CVITAL",232,0)124208 ; RPC OUTPUT FORMAT:124209 "RTN","C0CVITAL",233,0)124210 ; vfile ien^vital name^vital abbr^date/time taken(FM FORMAT)^value+units (US & metric)124211 "RTN","C0CVITAL",234,0)124212 D QUERY^BEHOVM("LISTX") ; RUN QUERY VITALS CALL124213 "RTN","C0CVITAL",235,0)124214 I '$D(^TMP("CIAVMRPC",$J)) S @VITOUTXML@(0)=0 Q ; RETURN NOT FOUND AND QUIT124215 "RTN","C0CVITAL",236,0)124216 ;ZW ^TMP("CIAVMRPC",$J)124217 "RTN","C0CVITAL",237,0)124218 S VITTVMAP=$NA(^TMP("C0CCCR",$J,"VITALS"))124219 "RTN","C0CVITAL",238,0)124220 S VITTARYTMP=$NA(^TMP("C0CCCR",$J,"VITALARYTMP"))124221 "RTN","C0CVITAL",239,0)124222 K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES124223 "RTN","C0CVITAL",240,0)124224 N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX124225 "RTN","C0CVITAL",241,0)124226 D VITDRPMS(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY124227 "RTN","C0CVITAL",242,0)124228 S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE124229 "RTN","C0CVITAL",243,0)124230 ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY124231 "RTN","C0CVITAL",244,0)124232 S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS124233 "RTN","C0CVITAL",245,0)124234 F J=1:1:VCNT D ; FOR EACH VITAL IN THE LIST124235 "RTN","C0CVITAL",246,0)124236 . I $D(^TMP("CIAVMRPC",$J,0,(VSORT(J)))) D124237 "RTN","C0CVITAL",247,0)124238 . . S VITVMAP=$NA(@VITTVMAP@(J))124239 "RTN","C0CVITAL",248,0)124240 . . K @VITVMAP124241 "RTN","C0CVITAL",249,0)124242 . . I DEBUG W "VMAP= ",VITVMAP,!124243 "RTN","C0CVITAL",250,0)124244 . . S VITPTMP=^TMP("CIAVMRPC",$J,0,(VSORT(J))) ; DATE SORTED VITAL FROM RETURN ARRAY124245 "RTN","C0CVITAL",251,0)124246 . . I DEBUG W "VITAL ",VSORT(J),!124247 "RTN","C0CVITAL",252,0)124248 . . I DEBUG W ^TMP("CIAVMRPC",$J,0,(VSORT(J)))," ",$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT"),!124249 "RTN","C0CVITAL",253,0)124250 . . I DEBUG W $P(VITPTMP,U,4),!124251 "RTN","C0CVITAL",254,0)124252 . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID124253 "RTN","C0CVITAL",255,0)124254 . . I $P(VITPTMP,U,3)="HT" D124255 "RTN","C0CVITAL",256,0)124256 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"124257 "RTN","C0CVITAL",257,0)124258 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")124259 124429 "RTN","C0CVITAL",258,0) 124260 124430 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT" 124261 124431 "RTN","C0CVITAL",259,0) 124432 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="248327008" 124433 "RTN","C0CVITAL",260,0) 124434 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 124435 "RTN","C0CVITAL",261,0) 124436 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")="" 124437 "RTN","C0CVITAL",262,0) 124438 . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4) 124439 "RTN","C0CVITAL",263,0) 124440 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1) 124441 "RTN","C0CVITAL",264,0) 124442 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2) 124443 "RTN","C0CVITAL",265,0) 124444 . . E I $P(VITPTMP,U,3)="WT" D 124445 "RTN","C0CVITAL",266,0) 124446 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 124447 "RTN","C0CVITAL",267,0) 124448 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT") 124449 "RTN","C0CVITAL",268,0) 124450 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT" 124451 "RTN","C0CVITAL",269,0) 124262 124452 . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 124263 "RTN","C0CVITAL",2 60,0)124453 "RTN","C0CVITAL",270,0) 124264 124454 . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J 124265 "RTN","C0CVITAL",2 61,0)124455 "RTN","C0CVITAL",271,0) 124266 124456 . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED" 124267 "RTN","C0CVITAL",262,0)124268 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"124269 "RTN","C0CVITAL",263,0)124270 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="248327008"124271 "RTN","C0CVITAL",264,0)124272 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"124273 "RTN","C0CVITAL",265,0)124274 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""124275 "RTN","C0CVITAL",266,0)124276 . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)124277 "RTN","C0CVITAL",267,0)124278 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)124279 "RTN","C0CVITAL",268,0)124280 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)124281 "RTN","C0CVITAL",269,0)124282 . . E I $P(VITPTMP,U,3)="WT" D124283 "RTN","C0CVITAL",270,0)124284 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"124285 "RTN","C0CVITAL",271,0)124286 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")124287 124457 "RTN","C0CVITAL",272,0) 124288 124458 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT" 124289 124459 "RTN","C0CVITAL",273,0) 124460 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="107647005" 124461 "RTN","C0CVITAL",274,0) 124462 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 124463 "RTN","C0CVITAL",275,0) 124464 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")="" 124465 "RTN","C0CVITAL",276,0) 124466 . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4) 124467 "RTN","C0CVITAL",277,0) 124468 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1) 124469 "RTN","C0CVITAL",278,0) 124470 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2) 124471 "RTN","C0CVITAL",279,0) 124472 . . E I $P(VITPTMP,U,3)="BP" D 124473 "RTN","C0CVITAL",280,0) 124474 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 124475 "RTN","C0CVITAL",281,0) 124476 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT") 124477 "RTN","C0CVITAL",282,0) 124478 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE" 124479 "RTN","C0CVITAL",283,0) 124290 124480 . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 124291 "RTN","C0CVITAL",2 74,0)124481 "RTN","C0CVITAL",284,0) 124292 124482 . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J 124293 "RTN","C0CVITAL",2 75,0)124483 "RTN","C0CVITAL",285,0) 124294 124484 . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED" 124295 "RTN","C0CVITAL",276,0)124296 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"124297 "RTN","C0CVITAL",277,0)124298 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="107647005"124299 "RTN","C0CVITAL",278,0)124300 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"124301 "RTN","C0CVITAL",279,0)124302 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""124303 "RTN","C0CVITAL",280,0)124304 . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)124305 "RTN","C0CVITAL",281,0)124306 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)124307 "RTN","C0CVITAL",282,0)124308 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)124309 "RTN","C0CVITAL",283,0)124310 . . E I $P(VITPTMP,U,3)="BP" D124311 "RTN","C0CVITAL",284,0)124312 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"124313 "RTN","C0CVITAL",285,0)124314 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")124315 124485 "RTN","C0CVITAL",286,0) 124316 124486 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE" 124317 124487 "RTN","C0CVITAL",287,0) 124488 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="392570002" 124489 "RTN","C0CVITAL",288,0) 124490 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 124491 "RTN","C0CVITAL",289,0) 124492 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")="" 124493 "RTN","C0CVITAL",290,0) 124494 . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4) 124495 "RTN","C0CVITAL",291,0) 124496 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1) 124497 "RTN","C0CVITAL",292,0) 124498 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2) 124499 "RTN","C0CVITAL",293,0) 124500 . . E I $P(VITPTMP,U,3)="TMP" D 124501 "RTN","C0CVITAL",294,0) 124502 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 124503 "RTN","C0CVITAL",295,0) 124504 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT") 124505 "RTN","C0CVITAL",296,0) 124506 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE" 124507 "RTN","C0CVITAL",297,0) 124318 124508 . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 124319 "RTN","C0CVITAL",2 88,0)124509 "RTN","C0CVITAL",298,0) 124320 124510 . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J 124321 "RTN","C0CVITAL",2 89,0)124511 "RTN","C0CVITAL",299,0) 124322 124512 . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED" 124323 "RTN","C0CVITAL",290,0)124324 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"124325 "RTN","C0CVITAL",291,0)124326 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="392570002"124327 "RTN","C0CVITAL",292,0)124328 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"124329 "RTN","C0CVITAL",293,0)124330 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""124331 "RTN","C0CVITAL",294,0)124332 . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)124333 "RTN","C0CVITAL",295,0)124334 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)124335 "RTN","C0CVITAL",296,0)124336 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)124337 "RTN","C0CVITAL",297,0)124338 . . E I $P(VITPTMP,U,3)="TMP" D124339 "RTN","C0CVITAL",298,0)124340 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"124341 "RTN","C0CVITAL",299,0)124342 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")124343 124513 "RTN","C0CVITAL",300,0) 124344 124514 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE" 124345 124515 "RTN","C0CVITAL",301,0) 124516 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="309646008" 124517 "RTN","C0CVITAL",302,0) 124518 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 124519 "RTN","C0CVITAL",303,0) 124520 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")="" 124521 "RTN","C0CVITAL",304,0) 124522 . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4) 124523 "RTN","C0CVITAL",305,0) 124524 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1) 124525 "RTN","C0CVITAL",306,0) 124526 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2) 124527 "RTN","C0CVITAL",307,0) 124528 . . E I $P(VITPTMP,U,3)="RS" D 124529 "RTN","C0CVITAL",308,0) 124530 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 124531 "RTN","C0CVITAL",309,0) 124532 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT") 124533 "RTN","C0CVITAL",310,0) 124534 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION" 124535 "RTN","C0CVITAL",311,0) 124346 124536 . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 124347 "RTN","C0CVITAL",3 02,0)124537 "RTN","C0CVITAL",312,0) 124348 124538 . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J 124349 "RTN","C0CVITAL",3 03,0)124539 "RTN","C0CVITAL",313,0) 124350 124540 . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED" 124351 "RTN","C0CVITAL",304,0)124352 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"124353 "RTN","C0CVITAL",305,0)124354 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="309646008"124355 "RTN","C0CVITAL",306,0)124356 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"124357 "RTN","C0CVITAL",307,0)124358 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""124359 "RTN","C0CVITAL",308,0)124360 . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)124361 "RTN","C0CVITAL",309,0)124362 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)124363 "RTN","C0CVITAL",310,0)124364 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)124365 "RTN","C0CVITAL",311,0)124366 . . E I $P(VITPTMP,U,3)="RS" D124367 "RTN","C0CVITAL",312,0)124368 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"124369 "RTN","C0CVITAL",313,0)124370 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")124371 124541 "RTN","C0CVITAL",314,0) 124372 124542 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION" 124373 124543 "RTN","C0CVITAL",315,0) 124544 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="366147009" 124545 "RTN","C0CVITAL",316,0) 124546 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 124547 "RTN","C0CVITAL",317,0) 124548 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")="" 124549 "RTN","C0CVITAL",318,0) 124550 . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4) 124551 "RTN","C0CVITAL",319,0) 124552 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1) 124553 "RTN","C0CVITAL",320,0) 124554 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2) 124555 "RTN","C0CVITAL",321,0) 124556 . . E I $P(VITPTMP,U,3)="PU" D 124557 "RTN","C0CVITAL",322,0) 124558 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 124559 "RTN","C0CVITAL",323,0) 124560 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT") 124561 "RTN","C0CVITAL",324,0) 124562 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE" 124563 "RTN","C0CVITAL",325,0) 124374 124564 . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 124375 "RTN","C0CVITAL",3 16,0)124565 "RTN","C0CVITAL",326,0) 124376 124566 . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J 124377 "RTN","C0CVITAL",3 17,0)124567 "RTN","C0CVITAL",327,0) 124378 124568 . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED" 124379 "RTN","C0CVITAL",318,0)124380 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"124381 "RTN","C0CVITAL",319,0)124382 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="366147009"124383 "RTN","C0CVITAL",320,0)124384 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"124385 "RTN","C0CVITAL",321,0)124386 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""124387 "RTN","C0CVITAL",322,0)124388 . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)124389 "RTN","C0CVITAL",323,0)124390 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)124391 "RTN","C0CVITAL",324,0)124392 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)124393 "RTN","C0CVITAL",325,0)124394 . . E I $P(VITPTMP,U,3)="PU" D124395 "RTN","C0CVITAL",326,0)124396 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"124397 "RTN","C0CVITAL",327,0)124398 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")124399 124569 "RTN","C0CVITAL",328,0) 124400 124570 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE" 124401 124571 "RTN","C0CVITAL",329,0) 124572 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="366199006" 124573 "RTN","C0CVITAL",330,0) 124574 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 124575 "RTN","C0CVITAL",331,0) 124576 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")="" 124577 "RTN","C0CVITAL",332,0) 124578 . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4) 124579 "RTN","C0CVITAL",333,0) 124580 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1) 124581 "RTN","C0CVITAL",334,0) 124582 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2) 124583 "RTN","C0CVITAL",335,0) 124584 . . E I $P(VITPTMP,U,3)="PA" D 124585 "RTN","C0CVITAL",336,0) 124586 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 124587 "RTN","C0CVITAL",337,0) 124588 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT") 124589 "RTN","C0CVITAL",338,0) 124590 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN" 124591 "RTN","C0CVITAL",339,0) 124402 124592 . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 124403 "RTN","C0CVITAL",3 30,0)124593 "RTN","C0CVITAL",340,0) 124404 124594 . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J 124405 "RTN","C0CVITAL",3 31,0)124595 "RTN","C0CVITAL",341,0) 124406 124596 . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED" 124407 "RTN","C0CVITAL",332,0)124408 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"124409 "RTN","C0CVITAL",333,0)124410 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="366199006"124411 "RTN","C0CVITAL",334,0)124412 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"124413 "RTN","C0CVITAL",335,0)124414 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""124415 "RTN","C0CVITAL",336,0)124416 . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)124417 "RTN","C0CVITAL",337,0)124418 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)124419 "RTN","C0CVITAL",338,0)124420 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)124421 "RTN","C0CVITAL",339,0)124422 . . E I $P(VITPTMP,U,3)="PA" D124423 "RTN","C0CVITAL",340,0)124424 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"124425 "RTN","C0CVITAL",341,0)124426 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")124427 124597 "RTN","C0CVITAL",342,0) 124428 124598 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN" 124429 124599 "RTN","C0CVITAL",343,0) 124600 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="22253000" 124601 "RTN","C0CVITAL",344,0) 124602 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED" 124603 "RTN","C0CVITAL",345,0) 124604 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")="" 124605 "RTN","C0CVITAL",346,0) 124606 . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4) 124607 "RTN","C0CVITAL",347,0) 124608 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1) 124609 "RTN","C0CVITAL",348,0) 124610 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2) 124611 "RTN","C0CVITAL",349,0) 124612 . . E D 124613 "RTN","C0CVITAL",350,0) 124614 . . . ;W "IN VITAL: OTHER",! 124615 "RTN","C0CVITAL",351,0) 124616 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED" 124617 "RTN","C0CVITAL",352,0) 124618 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT") 124619 "RTN","C0CVITAL",353,0) 124620 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")=$P(VITPTMP,U,2) 124621 "RTN","C0CVITAL",354,0) 124430 124622 . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1" 124431 "RTN","C0CVITAL",3 44,0)124623 "RTN","C0CVITAL",355,0) 124432 124624 . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J 124433 "RTN","C0CVITAL",3 45,0)124625 "RTN","C0CVITAL",356,0) 124434 124626 . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED" 124435 "RTN","C0CVITAL",346,0)124436 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"124437 "RTN","C0CVITAL",347,0)124438 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="22253000"124439 "RTN","C0CVITAL",348,0)124440 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"124441 "RTN","C0CVITAL",349,0)124442 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""124443 "RTN","C0CVITAL",350,0)124444 . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)124445 "RTN","C0CVITAL",351,0)124446 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)124447 "RTN","C0CVITAL",352,0)124448 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)124449 "RTN","C0CVITAL",353,0)124450 . . E D124451 "RTN","C0CVITAL",354,0)124452 . . . ;W "IN VITAL: OTHER",!124453 "RTN","C0CVITAL",355,0)124454 . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"124455 "RTN","C0CVITAL",356,0)124456 . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")124457 124627 "RTN","C0CVITAL",357,0) 124458 124628 . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")=$P(VITPTMP,U,2) 124459 124629 "RTN","C0CVITAL",358,0) 124460 . . . S @VITVMAP@("VITALSIGNS SOURCEACTORID")="ACTORSYSTEM_1"124630 . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="" 124461 124631 "RTN","C0CVITAL",359,0) 124462 . . . S @VITVMAP@("VITALSIGNS TESTOBJECTID")="VITALTEST"_J124632 . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="" 124463 124633 "RTN","C0CVITAL",360,0) 124464 . . . S @VITVMAP@("VITALSIGNS TESTTYPETEXT")="OBSERVED"124634 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")="" 124465 124635 "RTN","C0CVITAL",361,0) 124466 . . . S @VITVMAP@("VITALSIGNS DESCRIPTIONTEXT")=$P(VITPTMP,U,2)124636 . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4) 124467 124637 "RTN","C0CVITAL",362,0) 124468 . . . S @VITVMAP@("VITALSIGNS DESCCODEVALUE")=""124638 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1) 124469 124639 "RTN","C0CVITAL",363,0) 124470 . . . S @VITVMAP@("VITALSIGNS DESCCODINGSYSTEM")=""124640 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2) 124471 124641 "RTN","C0CVITAL",364,0) 124472 . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""124642 . . S VITARYTMP=$NA(@VITTARYTMP@(J)) 124473 124643 "RTN","C0CVITAL",365,0) 124474 . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)124644 . . K @VITARYTMP 124475 124645 "RTN","C0CVITAL",366,0) 124476 . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)124646 . . D MAP^C0CXPATH(VITXML,VITVMAP,VITARYTMP) 124477 124647 "RTN","C0CVITAL",367,0) 124478 . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)124648 . . I J=1 D ; FIRST ONE IS JUST A COPY 124479 124649 "RTN","C0CVITAL",368,0) 124480 . . S VITARYTMP=$NA(@VITTARYTMP@(J))124650 . . . ; W "FIRST ONE",! 124481 124651 "RTN","C0CVITAL",369,0) 124482 . . K @VITARYTMP124652 . . . D CP^C0CXPATH(VITARYTMP,VITOUTXML) 124483 124653 "RTN","C0CVITAL",370,0) 124484 . . D MAP^C0CXPATH(VITXML,VITVMAP,VITARYTMP)124654 . . . I DEBUG W "VITOUTXML ",VITOUTXML,! 124485 124655 "RTN","C0CVITAL",371,0) 124486 . . I J =1 D ; FIRST ONE IS JUST A COPY124656 . . I J>1 D ; AFTER THE FIRST, INSERT INNER XML 124487 124657 "RTN","C0CVITAL",372,0) 124488 . . . ; W "FIRST ONE",!124658 . . . D INSINNER^C0CXPATH(VITOUTXML,VITARYTMP) 124489 124659 "RTN","C0CVITAL",373,0) 124490 . . . D CP^C0CXPATH(VITARYTMP,VITOUTXML)124660 ; ZWR ^TMP($J,"VITALS",*) 124491 124661 "RTN","C0CVITAL",374,0) 124492 . . . I DEBUG W "VITOUTXML ",VITOUTXML,!124662 ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS 124493 124663 "RTN","C0CVITAL",375,0) 124494 . . I J>1 D ; AFTER THE FIRST, INSERT INNER XML124664 I DEBUG D PARY^C0CXPATH(VITOUTXML) 124495 124665 "RTN","C0CVITAL",376,0) 124496 . . . D INSINNER^C0CXPATH(VITOUTXML,VITARYTMP)124666 N VITTMP,I 124497 124667 "RTN","C0CVITAL",377,0) 124498 ; ZWR ^TMP($J,"VITALS",*)124668 D MISSING^C0CXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS 124499 124669 "RTN","C0CVITAL",378,0) 124500 ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS124670 I VITTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 124501 124671 "RTN","C0CVITAL",379,0) 124502 I DEBUG D PARY^C0CXPATH(VITOUTXML)124672 . W "VITALS MISSING ",! 124503 124673 "RTN","C0CVITAL",380,0) 124504 N VITTMP,I124674 . F I=1:1:VITTMP(0) W VITTMP(I),! 124505 124675 "RTN","C0CVITAL",381,0) 124506 D MISSING^C0CXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS124676 K ^TMP("CIAVMRPC",$J) 124507 124677 "RTN","C0CVITAL",382,0) 124508 I VITTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@124678 Q 124509 124679 "RTN","C0CVITAL",383,0) 124510 . W "VITALS MISSING ",!124680 ; 124511 124681 "RTN","C0CVITAL",384,0) 124512 . F I=1:1:VITTMP(0) W VITTMP(I),! 124682 SORTRPMS(VDT) ; RUN DATE SORTING ALGORITHM FOR RPMS 124513 124683 "RTN","C0CVITAL",385,0) 124514 K ^TMP("CIAVMRPC",$J)124684 ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY 124515 124685 "RTN","C0CVITAL",386,0) 124686 ; OF DATES IN THE VITALS RESULTS 124687 "RTN","C0CVITAL",387,0) 124688 N VDTI,VDTJ,VTDCNT 124689 "RTN","C0CVITAL",388,0) 124690 S VTDCNT=0 ; COUNT TO BUILD ARRAY 124691 "RTN","C0CVITAL",389,0) 124692 S VDTJ="" ; USED TO VISIT THE RESULTS 124693 "RTN","C0CVITAL",390,0) 124694 F VDTI=0:0 D Q:$O(^TMP("CIAVMRPC",$J,0,VDTJ))="" ; VISIT ALL RESULTS 124695 "RTN","C0CVITAL",391,0) 124696 . S VDTJ=$O(^TMP("CIAVMRPC",$J,0,VDTJ)) ; NEXT RESULT 124697 "RTN","C0CVITAL",392,0) 124698 . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER 124699 "RTN","C0CVITAL",393,0) 124700 . S VDT(VTDCNT)=$P(^TMP("CIAVMRPC",$J,0,VDTJ),U,4) ; PULL OUT THE DATE 124701 "RTN","C0CVITAL",394,0) 124702 S VDT(0)=VTDCNT 124703 "RTN","C0CVITAL",395,0) 124516 124704 Q 124517 "RTN","C0CVITAL",3 87,0)124518 ; 124519 "RTN","C0CVITAL",3 88,0)124520 VITDRPMS(VDT) ; RUN DATE SORTING ALGORITHM FOR RPMS 124521 "RTN","C0CVITAL",3 89,0)124705 "RTN","C0CVITAL",396,0) 124706 ; 124707 "RTN","C0CVITAL",397,0) 124708 SORTVIST(VDT) ; RUN DATE SORTING ALGORITHM FOR VISTA 124709 "RTN","C0CVITAL",398,0) 124522 124710 ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY 124523 "RTN","C0CVITAL",39 0,0)124711 "RTN","C0CVITAL",399,0) 124524 124712 ; OF DATES IN THE VITALS RESULTS 124525 "RTN","C0CVITAL", 391,0)124713 "RTN","C0CVITAL",400,0) 124526 124714 N VDTI,VDTJ,VTDCNT 124527 "RTN","C0CVITAL", 392,0)124715 "RTN","C0CVITAL",401,0) 124528 124716 S VTDCNT=0 ; COUNT TO BUILD ARRAY 124529 "RTN","C0CVITAL", 393,0)124717 "RTN","C0CVITAL",402,0) 124530 124718 S VDTJ="" ; USED TO VISIT THE RESULTS 124531 "RTN","C0CVITAL", 394,0)124532 F VDTI=0:0 D Q:$O( ^TMP("CIAVMRPC",$J,0,VDTJ))="" ; VISIT ALL RESULTS124533 "RTN","C0CVITAL", 395,0)124534 . S VDTJ=$O( ^TMP("CIAVMRPC",$J,0,VDTJ)) ; NEXT RESULT124535 "RTN","C0CVITAL", 396,0)124719 "RTN","C0CVITAL",403,0) 124720 F VDTI=0:0 D Q:$O(VITRSLT(VDTJ))="" ; VISIT ALL RESULTS 124721 "RTN","C0CVITAL",404,0) 124722 . S VDTJ=$O(VITRSLT(VDTJ)) ; NEXT RESULT 124723 "RTN","C0CVITAL",405,0) 124536 124724 . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER 124537 "RTN","C0CVITAL", 397,0)124538 . S VDT(VTDCNT)=$P( ^TMP("CIAVMRPC",$J,0,VDTJ),U,4) ; PULL OUT THE DATE124539 "RTN","C0CVITAL", 398,0)124725 "RTN","C0CVITAL",406,0) 124726 . S VDT(VTDCNT)=$P(VITRSLT(VDTJ),U,4) ; PULL OUT THE DATE 124727 "RTN","C0CVITAL",407,0) 124540 124728 S VDT(0)=VTDCNT 124541 "RTN","C0CVITAL", 399,0)124729 "RTN","C0CVITAL",408,0) 124542 124730 Q 124543 "RTN","C0CVITAL",400,0)124544 ;124545 "RTN","C0CVITAL",401,0)124546 VITDVISTA(VDT) ; RUN DATE SORTING ALGORITHM FOR VISTA124547 "RTN","C0CVITAL",402,0)124548 ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY124549 "RTN","C0CVITAL",403,0)124550 ; OF DATES IN THE VITALS RESULTS124551 "RTN","C0CVITAL",404,0)124552 N VDTI,VDTJ,VTDCNT124553 "RTN","C0CVITAL",405,0)124554 S VTDCNT=0 ; COUNT TO BUILD ARRAY124555 "RTN","C0CVITAL",406,0)124556 S VDTJ="" ; USED TO VISIT THE RESULTS124557 "RTN","C0CVITAL",407,0)124558 F VDTI=0:0 D Q:$O(VITRSLT(VDTJ))="" ; VISIT ALL RESULTS124559 "RTN","C0CVITAL",408,0)124560 . S VDTJ=$O(VITRSLT(VDTJ)) ; NEXT RESULT124561 124731 "RTN","C0CVITAL",409,0) 124562 . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER124563 "RTN","C0CVITAL",410,0)124564 . S VDT(VTDCNT)=$P(VITRSLT(VDTJ),U,4) ; PULL OUT THE DATE124565 "RTN","C0CVITAL",411,0)124566 S VDT(0)=VTDCNT124567 "RTN","C0CVITAL",412,0)124568 Q124569 "RTN","C0CVITAL",413,0)124570 124732 ; 124571 124733 "RTN","C0CVOBX1") 124572 0^99^B1 2947698124734 0^99^B14909630 124573 124735 "RTN","C0CVOBX1",1,0) 124574 124736 LA7VOBX1 ;DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd; 04/21/09 124575 124737 "RTN","C0CVOBX1",2,0) 124576 ;;1.2;C 0C;;May 11, 2012;Build 50124738 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 124577 124739 "RTN","C0CVOBX1",3,0) 124578 124740 ; JMC - mods to check for IHS V LAB file … … 124580 124742 ; 124581 124743 "RTN","C0CVOBX1",5,0) 124744 ; (C) 2009 John McCormack 124745 "RTN","C0CVOBX1",6,0) 124746 ; This program is free software: you can redistribute it and/or modify 124747 "RTN","C0CVOBX1",7,0) 124748 ; it under the terms of the GNU Affero General Public License as 124749 "RTN","C0CVOBX1",8,0) 124750 ; published by the Free Software Foundation, either version 3 of the 124751 "RTN","C0CVOBX1",9,0) 124752 ; License, or (at your option) any later version. 124753 "RTN","C0CVOBX1",10,0) 124754 ; 124755 "RTN","C0CVOBX1",11,0) 124756 ; This program is distributed in the hope that it will be useful, 124757 "RTN","C0CVOBX1",12,0) 124758 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 124759 "RTN","C0CVOBX1",13,0) 124760 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 124761 "RTN","C0CVOBX1",14,0) 124762 ; GNU Affero General Public License for more details. 124763 "RTN","C0CVOBX1",15,0) 124764 ; 124765 "RTN","C0CVOBX1",16,0) 124766 ; You should have received a copy of the GNU Affero General Public License 124767 "RTN","C0CVOBX1",17,0) 124768 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 124769 "RTN","C0CVOBX1",18,0) 124770 ; 124771 "RTN","C0CVOBX1",19,0) 124582 124772 CH ; Observation/Result segment for "CH" subscript results. 124583 "RTN","C0CVOBX1", 6,0)124773 "RTN","C0CVOBX1",20,0) 124584 124774 ; Called by LA7VOBX 124585 "RTN","C0CVOBX1", 7,0)124586 ; 124587 "RTN","C0CVOBX1", 8,0)124775 "RTN","C0CVOBX1",21,0) 124776 ; 124777 "RTN","C0CVOBX1",22,0) 124588 124778 N LA76304,LA7ALT,LA7DIV,LA7I,LA7X,LA7Y,X 124589 "RTN","C0CVOBX1", 9,0)124590 ; 124591 "RTN","C0CVOBX1", 10,0)124779 "RTN","C0CVOBX1",23,0) 124780 ; 124781 "RTN","C0CVOBX1",24,0) 124592 124782 ; "CH" subscript requires a dataname 124593 "RTN","C0CVOBX1", 11,0)124783 "RTN","C0CVOBX1",25,0) 124594 124784 I '$G(LRSB) Q 124595 "RTN","C0CVOBX1", 12,0)124596 ; 124597 "RTN","C0CVOBX1", 13,0)124785 "RTN","C0CVOBX1",26,0) 124786 ; 124787 "RTN","C0CVOBX1",27,0) 124598 124788 ; get result node from LR global. 124599 "RTN","C0CVOBX1", 14,0)124789 "RTN","C0CVOBX1",28,0) 124600 124790 S LA76304(0)=$G(^LR(LRDFN,LRSS,LRIDT,0)) 124601 "RTN","C0CVOBX1", 15,0)124791 "RTN","C0CVOBX1",29,0) 124602 124792 S LA7VAL=$G(^LR(LRDFN,LRSS,LRIDT,LRSB)) 124603 "RTN","C0CVOBX1", 16,0)124604 ; 124605 "RTN","C0CVOBX1", 17,0)124793 "RTN","C0CVOBX1",30,0) 124794 ; 124795 "RTN","C0CVOBX1",31,0) 124606 124796 ; Check if test is OK to send - (O)utput or (B)oth 124607 "RTN","C0CVOBX1", 18,0)124797 "RTN","C0CVOBX1",32,0) 124608 124798 S LA7X=$P(LA7VAL,"^",12) 124609 "RTN","C0CVOBX1", 19,0)124799 "RTN","C0CVOBX1",33,0) 124610 124800 I LA7X]"","BO"'[LA7X Q 124611 "RTN","C0CVOBX1", 20,0)124801 "RTN","C0CVOBX1",34,0) 124612 124802 I LA7X="",'$$OKTOSND^LA7VHLU1(LRSS,LRSB,+$P($P(LA7VAL,"^",3),"!",5)) Q 124613 "RTN","C0CVOBX1", 21,0)124614 ; 124615 "RTN","C0CVOBX1", 22,0)124803 "RTN","C0CVOBX1",35,0) 124804 ; 124805 "RTN","C0CVOBX1",36,0) 124616 124806 ; If no result NLT or LOINC try to determine from file #60 124617 "RTN","C0CVOBX1", 23,0)124807 "RTN","C0CVOBX1",37,0) 124618 124808 S LA7X=$P(LA7VAL,"^",3) 124619 "RTN","C0CVOBX1", 24,0)124809 "RTN","C0CVOBX1",38,0) 124620 124810 ; WV check for IHS - NLT/LN codes from V LAB file 124621 "RTN","C0CVOBX1", 25,0)124811 "RTN","C0CVOBX1",39,0) 124622 124812 I $D(^AUPNVLAB) D TMPCHK^C0CLA7Q 124623 "RTN","C0CVOBX1", 26,0)124624 ; 124625 "RTN","C0CVOBX1", 27,0)124813 "RTN","C0CVOBX1",40,0) 124814 ; 124815 "RTN","C0CVOBX1",41,0) 124626 124816 I $P(LA7X,"!",2)=""!($P(LA7X,"!",3)="") S $P(LA7VAL,"^",3)=$$DEFCODE^LA7VHLU5(LRSS,LRSB,LA7X,$P(LA76304(0),"^",5)) 124627 "RTN","C0CVOBX1", 28,0)124817 "RTN","C0CVOBX1",42,0) 124628 124818 ; No result NLT code - log error 124629 "RTN","C0CVOBX1", 29,0)124819 "RTN","C0CVOBX1",43,0) 124630 124820 I $P($P(LA7VAL,"^",3),"!",2)="" D 124631 "RTN","C0CVOBX1", 30,0)124821 "RTN","C0CVOBX1",44,0) 124632 124822 . N LA7X 124633 "RTN","C0CVOBX1", 31,0)124823 "RTN","C0CVOBX1",45,0) 124634 124824 . S LA7X="["_LRSB_"]"_$$GET1^DID(63.04,LRSB,"","LABEL") 124635 "RTN","C0CVOBX1", 32,0)124825 "RTN","C0CVOBX1",46,0) 124636 124826 . D CREATE^LA7LOG(36) 124637 "RTN","C0CVOBX1", 33,0)124638 ; 124639 "RTN","C0CVOBX1", 34,0)124827 "RTN","C0CVOBX1",47,0) 124828 ; 124829 "RTN","C0CVOBX1",48,0) 124640 124830 ; something missing - No NLT code, etc. 124641 "RTN","C0CVOBX1", 35,0)124831 "RTN","C0CVOBX1",49,0) 124642 124832 I LA7VAL="" Q 124643 "RTN","C0CVOBX1", 36,0)124644 ; 124645 "RTN","C0CVOBX1", 37,0)124833 "RTN","C0CVOBX1",50,0) 124834 ; 124835 "RTN","C0CVOBX1",51,0) 124646 124836 ; Check for missing units/reference ranges 124647 "RTN","C0CVOBX1", 38,0)124837 "RTN","C0CVOBX1",52,0) 124648 124838 S LA7X=$P(LA7VAL,"^",5) 124649 "RTN","C0CVOBX1", 39,0)124650 ; 124651 "RTN","C0CVOBX1", 40,0)124839 "RTN","C0CVOBX1",53,0) 124840 ; 124841 "RTN","C0CVOBX1",54,0) 124652 124842 ; Results missing units, lookup in file #60 124653 "RTN","C0CVOBX1", 41,0)124843 "RTN","C0CVOBX1",55,0) 124654 124844 I $P(LA7X,"!",7)="" S $P(LA7X,"!",7)=$P($$REFUNIT^LA7VHLU1(LRSB,$P(LA76304(0),"^",5)),"^",3) 124655 "RTN","C0CVOBX1", 42,0)124656 ; 124657 "RTN","C0CVOBX1", 43,0)124845 "RTN","C0CVOBX1",56,0) 124846 ; 124847 "RTN","C0CVOBX1",57,0) 124658 124848 ; If results missing reference ranges, use values from file #60. 124659 "RTN","C0CVOBX1", 44,0)124849 "RTN","C0CVOBX1",58,0) 124660 124850 I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="",$P(LA7X,"!",11)="",$P(LA7X,"!",12)="" D 124661 "RTN","C0CVOBX1", 45,0)124851 "RTN","C0CVOBX1",59,0) 124662 124852 . S LA7Y=$$REFUNIT^LA7VHLU1(LRSB,$P(LA76304(0),"^",5)) 124663 "RTN","C0CVOBX1", 46,0)124853 "RTN","C0CVOBX1",60,0) 124664 124854 . S $P(LA7X,"!",2)=$P(LA7Y,"^") 124665 "RTN","C0CVOBX1", 47,0)124855 "RTN","C0CVOBX1",61,0) 124666 124856 . S $P(LA7X,"!",3)=$P(LA7Y,"^",2) 124667 "RTN","C0CVOBX1", 48,0)124857 "RTN","C0CVOBX1",62,0) 124668 124858 . S $P(LA7X,"!",11)=$P(LA7Y,"^",6) 124669 "RTN","C0CVOBX1", 49,0)124859 "RTN","C0CVOBX1",63,0) 124670 124860 . S $P(LA7X,"!",12)=$P(LA7Y,"^",7) 124671 "RTN","C0CVOBX1", 50,0)124861 "RTN","C0CVOBX1",64,0) 124672 124862 ; Use therapeutic low/high if low/high missing. 124673 "RTN","C0CVOBX1", 51,0)124863 "RTN","C0CVOBX1",65,0) 124674 124864 I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="" D 124675 "RTN","C0CVOBX1", 52,0)124865 "RTN","C0CVOBX1",66,0) 124676 124866 . S $P(LA7X,"!",2)=$P(LA7X,"!",11) 124677 "RTN","C0CVOBX1", 53,0)124867 "RTN","C0CVOBX1",67,0) 124678 124868 . S $P(LA7X,"!",3)=$P(LA7X,"!",12) 124679 "RTN","C0CVOBX1", 54,0)124680 ; 124681 "RTN","C0CVOBX1", 55,0)124869 "RTN","C0CVOBX1",68,0) 124870 ; 124871 "RTN","C0CVOBX1",69,0) 124682 124872 ; Evaluate low/high reference ranges in case M code in these fields. 124683 "RTN","C0CVOBX1", 56,0)124873 "RTN","C0CVOBX1",70,0) 124684 124874 S:$G(SEX)="" SEX="M" S:$G(AGE)="" AGE=99 124685 "RTN","C0CVOBX1", 57,0)124875 "RTN","C0CVOBX1",71,0) 124686 124876 F LA7I=2,3 I $E($P(LA7X,"!",LA7I),1,3)="$S(" D 124687 "RTN","C0CVOBX1", 58,0)124877 "RTN","C0CVOBX1",72,0) 124688 124878 . S @("X="_$P(LA7X,"!",LA7I)) 124689 "RTN","C0CVOBX1", 59,0)124879 "RTN","C0CVOBX1",73,0) 124690 124880 . S $P(LA7X,"!",LA7I)=X 124691 "RTN","C0CVOBX1", 60,0)124692 ; 124693 "RTN","C0CVOBX1", 61,0)124881 "RTN","C0CVOBX1",74,0) 124882 ; 124883 "RTN","C0CVOBX1",75,0) 124694 124884 ; Put units/reference ranges back in variable LA7VAL 124695 "RTN","C0CVOBX1", 62,0)124885 "RTN","C0CVOBX1",76,0) 124696 124886 S $P(LA7VAL,"^",5)=LA7X 124697 "RTN","C0CVOBX1", 63,0)124698 ; 124699 "RTN","C0CVOBX1", 64,0)124887 "RTN","C0CVOBX1",77,0) 124888 ; 124889 "RTN","C0CVOBX1",78,0) 124700 124890 ; Initialize OBX segment 124701 "RTN","C0CVOBX1", 65,0)124891 "RTN","C0CVOBX1",79,0) 124702 124892 S LA7OBX(0)="OBX" 124703 "RTN","C0CVOBX1", 66,0)124893 "RTN","C0CVOBX1",80,0) 124704 124894 S LA7OBX(1)=$$OBX1^LA7VOBX(.LA7OBXSN) 124705 "RTN","C0CVOBX1", 67,0)124706 ; 124707 "RTN","C0CVOBX1", 68,0)124895 "RTN","C0CVOBX1",81,0) 124896 ; 124897 "RTN","C0CVOBX1",82,0) 124708 124898 ; Value type 124709 "RTN","C0CVOBX1", 69,0)124899 "RTN","C0CVOBX1",83,0) 124710 124900 S LA7OBX(2)=$$OBX2^LA7VOBX(63.04,LRSB) 124711 "RTN","C0CVOBX1", 70,0)124712 ; 124713 "RTN","C0CVOBX1", 71,0)124901 "RTN","C0CVOBX1",84,0) 124902 ; 124903 "RTN","C0CVOBX1",85,0) 124714 124904 ; Observation identifer 124715 "RTN","C0CVOBX1", 72,0)124905 "RTN","C0CVOBX1",86,0) 124716 124906 ; build alternate code based on dataname from file #63 in case it's needed 124717 "RTN","C0CVOBX1", 73,0)124907 "RTN","C0CVOBX1",87,0) 124718 124908 S LA7X=$P(LA7VAL,"^",3) 124719 "RTN","C0CVOBX1", 74,0)124909 "RTN","C0CVOBX1",88,0) 124720 124910 S LA7ALT="CH"_LRSB_"^"_$$GET1^DID(63.04,LRSB,"","LABEL")_"^"_"99VA63" 124721 "RTN","C0CVOBX1", 75,0)124911 "RTN","C0CVOBX1",89,0) 124722 124912 S LA7OBX(3)=$$OBX3^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7ALT,LA7FS,LA7ECH) 124723 "RTN","C0CVOBX1", 76,0)124724 ; 124725 "RTN","C0CVOBX1", 77,0)124913 "RTN","C0CVOBX1",90,0) 124914 ; 124915 "RTN","C0CVOBX1",91,0) 124726 124916 ; Test value 124727 "RTN","C0CVOBX1", 78,0)124917 "RTN","C0CVOBX1",92,0) 124728 124918 S LA7OBX(5)=$$OBX5^LA7VOBX($P(LA7VAL,"^"),LA7OBX(2),LA7FS,LA7ECH) 124729 "RTN","C0CVOBX1", 79,0)124730 ; 124731 "RTN","C0CVOBX1", 80,0)124919 "RTN","C0CVOBX1",93,0) 124920 ; 124921 "RTN","C0CVOBX1",94,0) 124732 124922 ; Units - remove leading and trailing spaces 124733 "RTN","C0CVOBX1", 81,0)124923 "RTN","C0CVOBX1",95,0) 124734 124924 S LA7X=$P(LA7VAL,"^",5),LA7X=$$TRIM^XLFSTR(LA7X,"LR"," ") 124735 "RTN","C0CVOBX1", 82,0)124925 "RTN","C0CVOBX1",96,0) 124736 124926 S LA7OBX(6)=$$OBX6^LA7VOBX($P(LA7X,"!",7),"",LA7FS,LA7ECH) 124737 "RTN","C0CVOBX1", 83,0)124738 ; 124739 "RTN","C0CVOBX1", 84,0)124927 "RTN","C0CVOBX1",97,0) 124928 ; 124929 "RTN","C0CVOBX1",98,0) 124740 124930 ; Reference range 124741 "RTN","C0CVOBX1", 85,0)124931 "RTN","C0CVOBX1",99,0) 124742 124932 S LA7OBX(7)=$$OBX7^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7FS,LA7ECH) 124743 "RTN","C0CVOBX1", 86,0)124744 ; 124745 "RTN","C0CVOBX1", 87,0)124933 "RTN","C0CVOBX1",100,0) 124934 ; 124935 "RTN","C0CVOBX1",101,0) 124746 124936 ; Abnormal flags 124747 "RTN","C0CVOBX1", 88,0)124937 "RTN","C0CVOBX1",102,0) 124748 124938 S LA7OBX(8)=$$OBX8^LA7VOBX($P(LA7VAL,U,2)) 124749 "RTN","C0CVOBX1", 89,0)124750 ; 124751 "RTN","C0CVOBX1", 90,0)124939 "RTN","C0CVOBX1",103,0) 124940 ; 124941 "RTN","C0CVOBX1",104,0) 124752 124942 ; "P"artial or "F"inal results 124753 "RTN","C0CVOBX1", 91,0)124943 "RTN","C0CVOBX1",105,0) 124754 124944 S LA7OBX(11)=$$OBX11^LA7VOBX($S("canccommentpending"[$P(LA7VAL,"^"):$P(LA7VAL,"^"),1:"F")) 124755 "RTN","C0CVOBX1", 92,0)124756 ; 124757 "RTN","C0CVOBX1", 93,0)124945 "RTN","C0CVOBX1",106,0) 124946 ; 124947 "RTN","C0CVOBX1",107,0) 124758 124948 ; Observation date/time - collection date/time per HL7 standard 124759 "RTN","C0CVOBX1", 94,0)124949 "RTN","C0CVOBX1",108,0) 124760 124950 I $P(LA76304(0),"^") S LA7OBX(14)=$$OBX14^LA7VOBX($P(LA76304(0),"^")) 124761 "RTN","C0CVOBX1", 95,0)124762 ; 124763 "RTN","C0CVOBX1", 96,0)124951 "RTN","C0CVOBX1",109,0) 124952 ; 124953 "RTN","C0CVOBX1",110,0) 124764 124954 S LA7DIV=$P(LA7VAL,"^",9) 124765 "RTN","C0CVOBX1", 97,0)124955 "RTN","C0CVOBX1",111,0) 124766 124956 I LA7DIV="",$$DIV4^XUSER(.LA7DIV,$P(LA7VAL,"^",4)) S LA7DIV=$O(LA7DIV(0)) 124767 "RTN","C0CVOBX1", 98,0)124768 ; 124769 "RTN","C0CVOBX1", 99,0)124957 "RTN","C0CVOBX1",112,0) 124958 ; 124959 "RTN","C0CVOBX1",113,0) 124770 124960 ; Facility that performed the testing 124771 "RTN","C0CVOBX1",1 00,0)124961 "RTN","C0CVOBX1",114,0) 124772 124962 S LA7OBX(15)=$$OBX15^LA7VOBX(LA7DIV,LA7FS,LA7ECH) 124773 "RTN","C0CVOBX1",1 01,0)124774 ; 124775 "RTN","C0CVOBX1",1 02,0)124963 "RTN","C0CVOBX1",115,0) 124964 ; 124965 "RTN","C0CVOBX1",116,0) 124776 124966 ; Person that verified the test 124777 "RTN","C0CVOBX1",1 03,0)124967 "RTN","C0CVOBX1",117,0) 124778 124968 S LA7OBX(16)=$$OBX16^LA7VOBX($P(LA7VAL,"^",4),LA7DIV,LA7FS,LA7ECH) 124779 "RTN","C0CVOBX1",1 04,0)124780 ; 124781 "RTN","C0CVOBX1",1 05,0)124969 "RTN","C0CVOBX1",118,0) 124970 ; 124971 "RTN","C0CVOBX1",119,0) 124782 124972 ; Observation method 124783 "RTN","C0CVOBX1",1 06,0)124973 "RTN","C0CVOBX1",120,0) 124784 124974 S LA7X=$P($P(LA7VAL,"^",3),"!",4) 124785 "RTN","C0CVOBX1",1 07,0)124975 "RTN","C0CVOBX1",121,0) 124786 124976 I LA7X S LA7OBX(17)=$$OBX17^LA7VOBX(LA7X,LA7FS,LA7ECH) 124787 "RTN","C0CVOBX1",1 08,0)124788 ; 124789 "RTN","C0CVOBX1",1 09,0)124977 "RTN","C0CVOBX1",122,0) 124978 ; 124979 "RTN","C0CVOBX1",123,0) 124790 124980 ; Equipment entity identifier 124791 "RTN","C0CVOBX1",1 10,0)124981 "RTN","C0CVOBX1",124,0) 124792 124982 I $L($P(LA7VAL,"^",11)) S LA7OBX(18)=$$OBX18^LA7VOBX($P(LA7VAL,"^",11),LA7FS,LA7ECH) 124793 "RTN","C0CVOBX1",1 11,0)124794 ; 124795 "RTN","C0CVOBX1",1 12,0)124983 "RTN","C0CVOBX1",125,0) 124984 ; 124985 "RTN","C0CVOBX1",126,0) 124796 124986 D BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS) 124797 "RTN","C0CVOBX1",1 13,0)124798 ; 124799 "RTN","C0CVOBX1",1 14,0)124987 "RTN","C0CVOBX1",127,0) 124988 ; 124989 "RTN","C0CVOBX1",128,0) 124800 124990 Q 124801 124991 "RTN","C0CVORU") 124802 0^100^B 58596883124992 0^100^B63096791 124803 124993 "RTN","C0CVORU",1,0) 124804 124994 C0C7VORU ;WV/JMC - Builder of HL7 Lab Results OBR/OBX/NTE based on RPMS V LAB file ;Jun 16, 2009 ; 5/10/12 5:19pm 124805 124995 "RTN","C0CVORU",2,0) 124806 ;;1.2;C 0C;;May 11, 2012;Build 50124996 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 124807 124997 "RTN","C0CVORU",3,0) 124808 124998 ; 124809 124999 "RTN","C0CVORU",4,0) 125000 ; (C) 2009 John McCormack 125001 "RTN","C0CVORU",5,0) 125002 ; This program is free software: you can redistribute it and/or modify 125003 "RTN","C0CVORU",6,0) 125004 ; it under the terms of the GNU Affero General Public License as 125005 "RTN","C0CVORU",7,0) 125006 ; published by the Free Software Foundation, either version 3 of the 125007 "RTN","C0CVORU",8,0) 125008 ; License, or (at your option) any later version. 125009 "RTN","C0CVORU",9,0) 125010 ; 125011 "RTN","C0CVORU",10,0) 125012 ; This program is distributed in the hope that it will be useful, 125013 "RTN","C0CVORU",11,0) 125014 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 125015 "RTN","C0CVORU",12,0) 125016 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 125017 "RTN","C0CVORU",13,0) 125018 ; GNU Affero General Public License for more details. 125019 "RTN","C0CVORU",14,0) 125020 ; 125021 "RTN","C0CVORU",15,0) 125022 ; You should have received a copy of the GNU Affero General Public License 125023 "RTN","C0CVORU",16,0) 125024 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 125025 "RTN","C0CVORU",17,0) 125026 ; 125027 "RTN","C0CVORU",18,0) 124810 125028 EN(LA) ; called from C0CVLAB 124811 "RTN","C0CVORU", 5,0)125029 "RTN","C0CVORU",19,0) 124812 125030 ; variables 124813 "RTN","C0CVORU", 6,0)125031 "RTN","C0CVORU",20,0) 124814 125032 ; LA("HUID") - Host Unique ID from the local ACCESSION file (#68) 124815 "RTN","C0CVORU", 7,0)125033 "RTN","C0CVORU",21,0) 124816 125034 ; LA("SITE") - Ordering site IEN in the INSTITUTION file (#4) 124817 "RTN","C0CVORU", 8,0)125035 "RTN","C0CVORU",22,0) 124818 125036 ; LA("RUID") - Remote sites Unique ID from ACCESSION file (#68) 124819 "RTN","C0CVORU", 9,0)125037 "RTN","C0CVORU",23,0) 124820 125038 ; LA("ORD") - Free text ordered test name from WKLD CODE file (#64) 124821 "RTN","C0CVORU", 10,0)125039 "RTN","C0CVORU",24,0) 124822 125040 ; LA("NLT") - National Laboratory test code from WKLD CODE file (#64) 124823 "RTN","C0CVORU", 11,0)125041 "RTN","C0CVORU",25,0) 124824 125042 ; LA("LRIDT") - Inverse date/time the lab arrival time (accession date/time) 124825 "RTN","C0CVORU", 12,0)125043 "RTN","C0CVORU",26,0) 124826 125044 ; LA("SUB") - test subscript defined in LABORATORY TEST file (#60) 124827 "RTN","C0CVORU", 13,0)125045 "RTN","C0CVORU",27,0) 124828 125046 ; LA("LRDFN") - IEN in LAB DATA file (#63) 124829 "RTN","C0CVORU", 14,0)125047 "RTN","C0CVORU",28,0) 124830 125048 ; LA("ORD"), LA("NLT"), and LA("SUB") are sent for specific lab results. 124831 "RTN","C0CVORU", 15,0)125049 "RTN","C0CVORU",29,0) 124832 125050 ; LA("AUTO-INST") - Auto-Instrument 124833 "RTN","C0CVORU", 16,0)124834 ; 124835 "RTN","C0CVORU", 17,0)125051 "RTN","C0CVORU",30,0) 125052 ; 125053 "RTN","C0CVORU",31,0) 124836 125054 N LA763,LA7NLT,LA7NVAF,LA7X,PRIMARY 124837 "RTN","C0CVORU", 18,0)124838 ; 124839 "RTN","C0CVORU", 19,0)125055 "RTN","C0CVORU",32,0) 125056 ; 125057 "RTN","C0CVORU",33,0) 124840 125058 S PRIMARY=$$PRIM^VASITE(DT),LA("AUTO-INST")="" 124841 "RTN","C0CVORU", 20,0)125059 "RTN","C0CVORU",34,0) 124842 125060 I $G(PRIMARY)'="" D 124843 "RTN","C0CVORU", 21,0)125061 "RTN","C0CVORU",35,0) 124844 125062 . S PRIMARY=$$SITE^VASITE(DT,PRIMARY) 124845 "RTN","C0CVORU", 22,0)125063 "RTN","C0CVORU",36,0) 124846 125064 . S PRIMARY=$P(PRIMARY,U,3) 124847 "RTN","C0CVORU", 23,0)125065 "RTN","C0CVORU",37,0) 124848 125066 . S LA("AUTO-INST")="LA7V HOST "_PRIMARY 124849 "RTN","C0CVORU", 24,0)124850 ; 124851 "RTN","C0CVORU", 25,0)125067 "RTN","C0CVORU",38,0) 125068 ; 125069 "RTN","C0CVORU",39,0) 124852 125070 I '$O(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0)) D Q 124853 "RTN","C0CVORU", 26,0)125071 "RTN","C0CVORU",40,0) 124854 125072 . ; need to add error logging when no entry in 63. 124855 "RTN","C0CVORU", 27,0)124856 ; 124857 "RTN","C0CVORU", 28,0)125073 "RTN","C0CVORU",41,0) 125074 ; 125075 "RTN","C0CVORU",42,0) 124858 125076 ; Get zeroth node of entry in #63. 124859 "RTN","C0CVORU", 29,0)125077 "RTN","C0CVORU",43,0) 124860 125078 S LA763(0)=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0)) 124861 "RTN","C0CVORU", 30,0)125079 "RTN","C0CVORU",44,0) 124862 125080 S LA7NLT=$G(LA("NLT")) 124863 "RTN","C0CVORU", 31,0)124864 ; 124865 "RTN","C0CVORU", 32,0)125081 "RTN","C0CVORU",45,0) 125082 ; 125083 "RTN","C0CVORU",46,0) 124866 125084 S LA7NVAF=$$NVAF^LA7VHLU2(+LA("SITE")) 124867 "RTN","C0CVORU", 33,0)125085 "RTN","C0CVORU",47,0) 124868 125086 S LA7NTESN=0 124869 "RTN","C0CVORU", 34,0)125087 "RTN","C0CVORU",48,0) 124870 125088 D ORC 124871 "RTN","C0CVORU", 35,0)124872 ; 124873 "RTN","C0CVORU", 36,0)125089 "RTN","C0CVORU",49,0) 125090 ; 125091 "RTN","C0CVORU",50,0) 124874 125092 I $G(LA("SUB"))="CH" D CH 124875 "RTN","C0CVORU", 37,0)125093 "RTN","C0CVORU",51,0) 124876 125094 ;I $G(LA("SUB"))="MI" D MI^LA7VORU1 124877 "RTN","C0CVORU", 38,0)125095 "RTN","C0CVORU",52,0) 124878 125096 ;I "SPCYEM"[$G(LA("SUB")) D AP^LA7VORU2 124879 "RTN","C0CVORU", 39,0)125097 "RTN","C0CVORU",53,0) 124880 125098 Q 124881 "RTN","C0CVORU", 40,0)124882 ; 124883 "RTN","C0CVORU", 41,0)124884 ; 124885 "RTN","C0CVORU", 42,0)125099 "RTN","C0CVORU",54,0) 125100 ; 125101 "RTN","C0CVORU",55,0) 125102 ; 125103 "RTN","C0CVORU",56,0) 124886 125104 CH ; Build segments for "CH" subscript 124887 "RTN","C0CVORU", 43,0)124888 ; 124889 "RTN","C0CVORU", 44,0)125105 "RTN","C0CVORU",57,0) 125106 ; 125107 "RTN","C0CVORU",58,0) 124890 125108 D OBR 124891 "RTN","C0CVORU", 45,0)125109 "RTN","C0CVORU",59,0) 124892 125110 D NTE 124893 "RTN","C0CVORU", 46,0)125111 "RTN","C0CVORU",60,0) 124894 125112 S LA7OBXSN=0 124895 "RTN","C0CVORU", 47,0)125113 "RTN","C0CVORU",61,0) 124896 125114 D OBX 124897 "RTN","C0CVORU", 48,0)124898 ; 124899 "RTN","C0CVORU", 49,0)125115 "RTN","C0CVORU",62,0) 125116 ; 125117 "RTN","C0CVORU",63,0) 124900 125118 Q 124901 "RTN","C0CVORU", 50,0)124902 ; 124903 "RTN","C0CVORU", 51,0)124904 ; 124905 "RTN","C0CVORU", 52,0)125119 "RTN","C0CVORU",64,0) 125120 ; 125121 "RTN","C0CVORU",65,0) 125122 ; 125123 "RTN","C0CVORU",66,0) 124906 125124 ORC ; Build ORC segment 124907 "RTN","C0CVORU", 53,0)124908 ; 124909 "RTN","C0CVORU", 54,0)125125 "RTN","C0CVORU",67,0) 125126 ; 125127 "RTN","C0CVORU",68,0) 124910 125128 N LA763,LA7696,LA7DATA,LA7SM,LA7X,LA7Y,ORC 124911 "RTN","C0CVORU", 55,0)124912 ; 124913 "RTN","C0CVORU", 56,0)125129 "RTN","C0CVORU",69,0) 125130 ; 125131 "RTN","C0CVORU",70,0) 124914 125132 S LA763(0)=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0)) 124915 "RTN","C0CVORU", 57,0)124916 ; 124917 "RTN","C0CVORU", 58,0)125133 "RTN","C0CVORU",71,0) 125134 ; 125135 "RTN","C0CVORU",72,0) 124918 125136 S ORC(0)="ORC" 124919 "RTN","C0CVORU", 59,0)124920 ; 124921 "RTN","C0CVORU", 60,0)125137 "RTN","C0CVORU",73,0) 125138 ; 125139 "RTN","C0CVORU",74,0) 124922 125140 ; Order control 124923 "RTN","C0CVORU", 61,0)125141 "RTN","C0CVORU",75,0) 124924 125142 S ORC(1)=$$ORC1^LA7VORC("RE") 124925 "RTN","C0CVORU", 62,0)124926 ; 124927 "RTN","C0CVORU", 63,0)125143 "RTN","C0CVORU",76,0) 125144 ; 125145 "RTN","C0CVORU",77,0) 124928 125146 ; Remote UID 124929 "RTN","C0CVORU", 64,0)125147 "RTN","C0CVORU",78,0) 124930 125148 S ORC(2)=$$ORC2^LA7VORC(LA("RUID"),LA7FS,LA7ECH) 124931 "RTN","C0CVORU", 65,0)124932 ; 124933 "RTN","C0CVORU", 66,0)125149 "RTN","C0CVORU",79,0) 125150 ; 125151 "RTN","C0CVORU",80,0) 124934 125152 ; Host UID 124935 "RTN","C0CVORU", 67,0)125153 "RTN","C0CVORU",81,0) 124936 125154 S ORC(3)=$$ORC3^LA7VORC(LA("HUID"),LA7FS,LA7ECH) 124937 "RTN","C0CVORU", 68,0)124938 ; 124939 "RTN","C0CVORU", 69,0)125155 "RTN","C0CVORU",82,0) 125156 ; 125157 "RTN","C0CVORU",83,0) 124940 125158 ; Return shipping manifest if found 124941 "RTN","C0CVORU", 70,0)125159 "RTN","C0CVORU",84,0) 124942 125160 S LA7SM="",LA7696=0 124943 "RTN","C0CVORU", 71,0)125161 "RTN","C0CVORU",85,0) 124944 125162 I LA("SITE")'="",LA("RUID")'="" S LA7696=$O(^LRO(69.6,"RST",LA("SITE"),LA("RUID"),0)) 124945 "RTN","C0CVORU", 72,0)125163 "RTN","C0CVORU",86,0) 124946 125164 I LA7696 S LA7SM=$P($G(^LRO(69.6,LA7696,0)),U,14) 124947 "RTN","C0CVORU", 73,0)125165 "RTN","C0CVORU",87,0) 124948 125166 I LA7SM'="" S ORC(4)=$$ORC4^LA7VORC(LA7SM,LA7FS,LA7ECH) 124949 "RTN","C0CVORU", 74,0)124950 ; 124951 "RTN","C0CVORU", 75,0)125167 "RTN","C0CVORU",88,0) 125168 ; 125169 "RTN","C0CVORU",89,0) 124952 125170 ; Order status 124953 "RTN","C0CVORU", 76,0)125171 "RTN","C0CVORU",90,0) 124954 125172 ; DoD/CHCS requires ORC-5 valued otherwise will not process message 124955 "RTN","C0CVORU", 77,0)125173 "RTN","C0CVORU",91,0) 124956 125174 I LA7NVAF=1 S ORC(5)=$$ORC5^LA7VORC("CM",LA7FS,LA7ECH) 124957 "RTN","C0CVORU", 78,0)124958 ; 124959 "RTN","C0CVORU", 79,0)125175 "RTN","C0CVORU",92,0) 125176 ; 125177 "RTN","C0CVORU",93,0) 124960 125178 ; Ordering provider 124961 "RTN","C0CVORU", 80,0)125179 "RTN","C0CVORU",94,0) 124962 125180 S (LA7X,LA7Y)="" 124963 "RTN","C0CVORU", 81,0)125181 "RTN","C0CVORU",95,0) 124964 125182 ; "CH" subscript stores requesting provider and requesting div/location. 124965 "RTN","C0CVORU", 82,0)125183 "RTN","C0CVORU",96,0) 124966 125184 I LA("SUB")="CH" D 124967 "RTN","C0CVORU", 83,0)125185 "RTN","C0CVORU",97,0) 124968 125186 . N LA7J 124969 "RTN","C0CVORU", 84,0)125187 "RTN","C0CVORU",98,0) 124970 125188 . S LA7J=$P(LA763(0),"^",13) 124971 "RTN","C0CVORU", 85,0)125189 "RTN","C0CVORU",99,0) 124972 125190 . I $P(LA7J,";",2)="SC(" S LA7Y=$$GET1^DIQ(44,$P(LA7J,";")_",",3,"I") 124973 "RTN","C0CVORU", 86,0)125191 "RTN","C0CVORU",100,0) 124974 125192 . I $P(LA7J,";",2)="DIC(4," S LA7Y=$P(LA7J,";") 124975 "RTN","C0CVORU", 87,0)125193 "RTN","C0CVORU",101,0) 124976 125194 . S LA7X=$P(LA763(0),"^",10) 124977 "RTN","C0CVORU", 88,0)124978 ; 124979 "RTN","C0CVORU", 89,0)125195 "RTN","C0CVORU",102,0) 125196 ; 125197 "RTN","C0CVORU",103,0) 124980 125198 ; Other subscripts only store requesting provider 124981 "RTN","C0CVORU", 90,0)125199 "RTN","C0CVORU",104,0) 124982 125200 I "CYEMMISP"[LA("SUB") S LA7X=$P(LA763(0),"^",7) 124983 "RTN","C0CVORU", 91,0)125201 "RTN","C0CVORU",105,0) 124984 125202 ; Get default institution from MailMan Site Parameters file 124985 "RTN","C0CVORU", 92,0)125203 "RTN","C0CVORU",106,0) 124986 125204 I LA7Y="" S LA7Y=$$GET1^DIQ(4.3,"1,",217,"I") 124987 "RTN","C0CVORU", 93,0)125205 "RTN","C0CVORU",107,0) 124988 125206 S ORC(12)=$$ORC12^LA7VORC(LA7X,LA7Y,LA7FS,LA7ECH) 124989 "RTN","C0CVORU", 94,0)124990 ; 124991 "RTN","C0CVORU", 95,0)125207 "RTN","C0CVORU",108,0) 125208 ; 125209 "RTN","C0CVORU",109,0) 124992 125210 ; Entering organization 124993 "RTN","C0CVORU", 96,0)125211 "RTN","C0CVORU",110,0) 124994 125212 S ORC(17)=$$ORC17^LA7VORC(LA7Y,LA7FS,LA7ECH) 124995 "RTN","C0CVORU", 97,0)124996 ; 124997 "RTN","C0CVORU", 98,0)125213 "RTN","C0CVORU",111,0) 125214 ; 125215 "RTN","C0CVORU",112,0) 124998 125216 D BUILDSEG^LA7VHLU(.ORC,.LA7DATA,LA7FS) 124999 "RTN","C0CVORU", 99,0)125217 "RTN","C0CVORU",113,0) 125000 125218 D FILESEG^LA7VHLU(GBL,.LA7DATA) 125001 "RTN","C0CVORU",1 00,0)125002 ; 125003 "RTN","C0CVORU",1 01,0)125219 "RTN","C0CVORU",114,0) 125220 ; 125221 "RTN","C0CVORU",115,0) 125004 125222 ; Check for flag to only build message but do not file 125005 "RTN","C0CVORU",1 02,0)125223 "RTN","C0CVORU",116,0) 125006 125224 I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249P,.LA7DATA) 125007 "RTN","C0CVORU",1 03,0)125008 ; 125009 "RTN","C0CVORU",1 04,0)125225 "RTN","C0CVORU",117,0) 125226 ; 125227 "RTN","C0CVORU",118,0) 125010 125228 Q 125011 "RTN","C0CVORU",1 05,0)125012 ; 125013 "RTN","C0CVORU",1 06,0)125014 ; 125015 "RTN","C0CVORU",1 07,0)125229 "RTN","C0CVORU",119,0) 125230 ; 125231 "RTN","C0CVORU",120,0) 125232 ; 125233 "RTN","C0CVORU",121,0) 125016 125234 OBR ;Observation Request segment for Lab Order 125017 "RTN","C0CVORU",1 08,0)125018 ; 125019 "RTN","C0CVORU",1 09,0)125235 "RTN","C0CVORU",122,0) 125236 ; 125237 "RTN","C0CVORU",123,0) 125020 125238 N LA761,LA762,LA7DATA,LA7PLOBR,LA7X,LA7Y,OBR 125021 "RTN","C0CVORU",1 10,0)125022 ; 125023 "RTN","C0CVORU",1 11,0)125239 "RTN","C0CVORU",124,0) 125240 ; 125241 "RTN","C0CVORU",125,0) 125024 125242 ; Retrieve placer's OBR information stored in #69.6 125025 "RTN","C0CVORU",1 12,0)125243 "RTN","C0CVORU",126,0) 125026 125244 D RETOBR^LA7VHLU(LA("SITE"),LA("RUID"),LA("NLT"),.LA7PLOBR) 125027 "RTN","C0CVORU",1 13,0)125028 ; 125029 "RTN","C0CVORU",1 14,0)125245 "RTN","C0CVORU",127,0) 125246 ; 125247 "RTN","C0CVORU",128,0) 125030 125248 ; Initialize OBR segment 125031 "RTN","C0CVORU",1 15,0)125249 "RTN","C0CVORU",129,0) 125032 125250 S OBR(0)="OBR" 125033 "RTN","C0CVORU",1 16,0)125251 "RTN","C0CVORU",130,0) 125034 125252 S OBR(1)=$$OBR1^LA7VOBR(.LA7OBRSN) 125035 "RTN","C0CVORU",1 17,0)125036 ; 125037 "RTN","C0CVORU",1 18,0)125253 "RTN","C0CVORU",131,0) 125254 ; 125255 "RTN","C0CVORU",132,0) 125038 125256 ; Remote UID 125039 "RTN","C0CVORU",1 19,0)125257 "RTN","C0CVORU",133,0) 125040 125258 S OBR(2)=$$OBR2^LA7VOBR(LA("RUID"),LA7FS,LA7ECH) 125041 "RTN","C0CVORU",1 20,0)125042 ; 125043 "RTN","C0CVORU",1 21,0)125259 "RTN","C0CVORU",134,0) 125260 ; 125261 "RTN","C0CVORU",135,0) 125044 125262 ; Host UID 125045 "RTN","C0CVORU",1 22,0)125263 "RTN","C0CVORU",136,0) 125046 125264 S OBR(3)=$$OBR3^LA7VOBR(LA("HUID"),LA7FS,LA7ECH) 125047 "RTN","C0CVORU",1 23,0)125048 ; 125049 "RTN","C0CVORU",1 24,0)125265 "RTN","C0CVORU",137,0) 125266 ; 125267 "RTN","C0CVORU",138,0) 125050 125268 ; Universal service ID, build from info stored in #69.6 125051 "RTN","C0CVORU",1 25,0)125269 "RTN","C0CVORU",139,0) 125052 125270 S LA7X="" 125053 "RTN","C0CVORU",1 26,0)125271 "RTN","C0CVORU",140,0) 125054 125272 I $G(LA7PLOBR("OBR-4"))'="" S OBR(4)=$$CNVFLD^LA7VHLU3(LA7PLOBR("OBR-4"),LA7PLOBR("ECH"),LA7ECH) 125055 "RTN","C0CVORU",1 27,0)125273 "RTN","C0CVORU",141,0) 125056 125274 E S OBR(4)=$$OBR4^LA7VOBR(LA7NLT,"",LA7X,LA7FS,LA7ECH) 125057 "RTN","C0CVORU",1 28,0)125058 ; 125059 "RTN","C0CVORU",1 29,0)125275 "RTN","C0CVORU",142,0) 125276 ; 125277 "RTN","C0CVORU",143,0) 125060 125278 ; Collection D/T 125061 "RTN","C0CVORU",1 30,0)125279 "RTN","C0CVORU",144,0) 125062 125280 S OBR(7)=$$OBR7^LA7VOBR($P(LA763(0),U)) 125063 "RTN","C0CVORU",1 31,0)125064 ; 125065 "RTN","C0CVORU",1 32,0)125281 "RTN","C0CVORU",145,0) 125282 ; 125283 "RTN","C0CVORU",146,0) 125066 125284 ; Specimen action code 125067 "RTN","C0CVORU",1 33,0)125285 "RTN","C0CVORU",147,0) 125068 125286 ; If no OBR from PENDING ORDER file (#69.6) then assume added test. 125069 "RTN","C0CVORU",1 34,0)125287 "RTN","C0CVORU",148,0) 125070 125288 I $G(LA7INTYP)=10,$G(LA7PLOBR("OBR-4"))="" S OBR(11)=$$OBR11^LA7VOBR("A") 125071 "RTN","C0CVORU",1 35,0)125072 ; 125073 "RTN","C0CVORU",1 36,0)125289 "RTN","C0CVORU",149,0) 125290 ; 125291 "RTN","C0CVORU",150,0) 125074 125292 ; Infection Warning 125075 "RTN","C0CVORU",1 37,0)125293 "RTN","C0CVORU",151,0) 125076 125294 S OBR(12)=$$OBR12^LA7VOBR(LRDFN,LA7FS,LA7ECH) 125077 "RTN","C0CVORU",1 38,0)125078 ; 125079 "RTN","C0CVORU",1 39,0)125295 "RTN","C0CVORU",152,0) 125296 ; 125297 "RTN","C0CVORU",153,0) 125080 125298 ; Lab Arrival Time 125081 "RTN","C0CVORU",1 40,0)125299 "RTN","C0CVORU",154,0) 125082 125300 ; "CH" subscript does not store lab arrival time, use collection time. 125083 "RTN","C0CVORU",1 41,0)125301 "RTN","C0CVORU",155,0) 125084 125302 ; Other subscripts do store lab arrival time (date/time received). 125085 "RTN","C0CVORU",1 42,0)125303 "RTN","C0CVORU",156,0) 125086 125304 I "CYEMMISP"[LA("SUB") S OBR(14)=$$OBR14^LA7VOBR($P(LA763(0),"^",10)) 125087 "RTN","C0CVORU",1 43,0)125305 "RTN","C0CVORU",157,0) 125088 125306 I LA("SUB")="CH" S OBR(14)=$$OBR14^LA7VOBR($P(LA763(0),"^")) 125089 "RTN","C0CVORU",1 44,0)125090 ; 125091 "RTN","C0CVORU",1 45,0)125307 "RTN","C0CVORU",158,0) 125308 ; 125309 "RTN","C0CVORU",159,0) 125092 125310 ; Specimen source 125093 "RTN","C0CVORU",1 46,0)125311 "RTN","C0CVORU",160,0) 125094 125312 S (LA761,LA762)="" 125095 "RTN","C0CVORU",1 47,0)125313 "RTN","C0CVORU",161,0) 125096 125314 I "CHMI"[LA("SUB") D 125097 "RTN","C0CVORU",1 48,0)125315 "RTN","C0CVORU",162,0) 125098 125316 . S LA761=$P(LA763(0),U,5) 125099 "RTN","C0CVORU",1 49,0)125317 "RTN","C0CVORU",163,0) 125100 125318 . I LA761="" D CREATE^LA7LOG(27) 125101 "RTN","C0CVORU",1 50,0)125319 "RTN","C0CVORU",164,0) 125102 125320 . I LA("SUB")="MI" S LA762=$P(LA763(0),U,11) 125103 "RTN","C0CVORU",1 51,0)125321 "RTN","C0CVORU",165,0) 125104 125322 S OBR(15)=$$OBR15^LA7VOBR(LA761,LA762,"",LA7FS,LA7ECH) 125105 "RTN","C0CVORU",1 52,0)125106 ; 125107 "RTN","C0CVORU",1 53,0)125323 "RTN","C0CVORU",166,0) 125324 ; 125325 "RTN","C0CVORU",167,0) 125108 125326 ; Ordering provider 125109 "RTN","C0CVORU",1 54,0)125327 "RTN","C0CVORU",168,0) 125110 125328 S (LA7X,LA7Y)="" 125111 "RTN","C0CVORU",1 55,0)125329 "RTN","C0CVORU",169,0) 125112 125330 ; "CH" subscript stores requesting provider and requesting div/location. 125113 "RTN","C0CVORU",1 56,0)125331 "RTN","C0CVORU",170,0) 125114 125332 I LA("SUB")="CH" D 125115 "RTN","C0CVORU",1 57,0)125333 "RTN","C0CVORU",171,0) 125116 125334 . N LA7J 125117 "RTN","C0CVORU",1 58,0)125335 "RTN","C0CVORU",172,0) 125118 125336 . S LA7J=$P(LA763(0),"^",13) 125119 "RTN","C0CVORU",1 59,0)125337 "RTN","C0CVORU",173,0) 125120 125338 . I $P(LA7J,";",2)="SC(" S LA7Y=$$GET1^DIQ(44,$P(LA7J,";")_",",3,"I") 125121 "RTN","C0CVORU",1 60,0)125339 "RTN","C0CVORU",174,0) 125122 125340 . I $P(LA7J,";",2)="DIC(4," S LA7Y=$P(LA7J,";") 125123 "RTN","C0CVORU",1 61,0)125341 "RTN","C0CVORU",175,0) 125124 125342 . S LA7X=$P(LA763(0),"^",10) 125125 "RTN","C0CVORU",1 62,0)125126 ; 125127 "RTN","C0CVORU",1 63,0)125343 "RTN","C0CVORU",176,0) 125344 ; 125345 "RTN","C0CVORU",177,0) 125128 125346 ; Other subscripts only store requesting provider 125129 "RTN","C0CVORU",1 64,0)125347 "RTN","C0CVORU",178,0) 125130 125348 I "CYEMMISP"[LA("SUB") S LA7X=$P(LA763(0),"^",7) 125131 "RTN","C0CVORU",1 65,0)125349 "RTN","C0CVORU",179,0) 125132 125350 ; Get default institution from MailMan Site Parameters file 125133 "RTN","C0CVORU",1 66,0)125351 "RTN","C0CVORU",180,0) 125134 125352 I LA7Y="" S LA7Y=$$GET1^DIQ(4.3,"1,",217,"I") 125135 "RTN","C0CVORU",1 67,0)125353 "RTN","C0CVORU",181,0) 125136 125354 S OBR(16)=$$ORC12^LA7VORC(LA7X,LA7Y,LA7FS,LA7ECH) 125137 "RTN","C0CVORU",1 68,0)125138 ; 125139 "RTN","C0CVORU",1 69,0)125355 "RTN","C0CVORU",182,0) 125356 ; 125357 "RTN","C0CVORU",183,0) 125140 125358 ; Placer Field #1 (remote auto-inst) 125141 "RTN","C0CVORU",1 70,0)125359 "RTN","C0CVORU",184,0) 125142 125360 ; Build from info stored in #69.6 125143 "RTN","C0CVORU",1 71,0)125361 "RTN","C0CVORU",185,0) 125144 125362 I $G(LA7PLOBR("OBR-18"))'="" D 125145 "RTN","C0CVORU",1 72,0)125363 "RTN","C0CVORU",186,0) 125146 125364 . S OBR(18)=$$CHKDATA^LA7VHLU3(LA7PLOBR("OBR-18"),LA7FS_LA7ECH) 125147 "RTN","C0CVORU",1 73,0)125365 "RTN","C0CVORU",187,0) 125148 125366 ; Else build "auto instrument" if sending to VA facility 125149 "RTN","C0CVORU",1 74,0)125367 "RTN","C0CVORU",188,0) 125150 125368 I $G(LA7PLOBR("OBR-18"))="",'LA7NVAF D 125151 "RTN","C0CVORU",1 75,0)125369 "RTN","C0CVORU",189,0) 125152 125370 . N LA7X 125153 "RTN","C0CVORU",1 76,0)125371 "RTN","C0CVORU",190,0) 125154 125372 . S LA7X(1)=LA("AUTO-INST") 125155 "RTN","C0CVORU",1 77,0)125373 "RTN","C0CVORU",191,0) 125156 125374 . S OBR(18)=$$OBR18^LA7VOBR(.LA7X,LA7FS,LA7ECH) 125157 "RTN","C0CVORU",1 78,0)125158 ; 125159 "RTN","C0CVORU",1 79,0)125375 "RTN","C0CVORU",192,0) 125376 ; 125377 "RTN","C0CVORU",193,0) 125160 125378 ; Placer Field #2 125161 "RTN","C0CVORU",1 80,0)125379 "RTN","C0CVORU",194,0) 125162 125380 I $G(LA7PLOBR("OBR-19"))'="" D 125163 "RTN","C0CVORU",1 81,0)125381 "RTN","C0CVORU",195,0) 125164 125382 . S OBR(19)=$$CHKDATA^LA7VHLU3(LA7PLOBR("OBR-19"),LA7FS_LA7ECH) 125165 "RTN","C0CVORU",1 82,0)125383 "RTN","C0CVORU",196,0) 125166 125384 ; Else build collecting UID if sending to VA facility 125167 "RTN","C0CVORU",1 83,0)125385 "RTN","C0CVORU",197,0) 125168 125386 I $G(LA7PLOBR("OBR-19"))="",'LA7NVAF,LA("RUID")'="" D 125169 "RTN","C0CVORU",1 84,0)125387 "RTN","C0CVORU",198,0) 125170 125388 . K LA7X 125171 "RTN","C0CVORU",1 85,0)125389 "RTN","C0CVORU",199,0) 125172 125390 . S LA7X(7)=LA("RUID") 125173 "RTN","C0CVORU", 186,0)125391 "RTN","C0CVORU",200,0) 125174 125392 . S OBR(19)=$$OBR19^LA7VOBR(.LA7X,LA7FS,LA7ECH) 125175 "RTN","C0CVORU", 187,0)125176 ; 125177 "RTN","C0CVORU", 188,0)125393 "RTN","C0CVORU",201,0) 125394 ; 125395 "RTN","C0CVORU",202,0) 125178 125396 ; Filler Field #1 125179 "RTN","C0CVORU", 189,0)125397 "RTN","C0CVORU",203,0) 125180 125398 ; Send file #63 ien info - used by HDR to track patient/specimen 125181 "RTN","C0CVORU", 190,0)125399 "RTN","C0CVORU",204,0) 125182 125400 K LA7X 125183 "RTN","C0CVORU", 191,0)125401 "RTN","C0CVORU",205,0) 125184 125402 S LA7X(1)=LA("LRDFN") 125185 "RTN","C0CVORU", 192,0)125403 "RTN","C0CVORU",206,0) 125186 125404 S LA7X(2)=LA("SUB") 125187 "RTN","C0CVORU", 193,0)125405 "RTN","C0CVORU",207,0) 125188 125406 S LA7X(3)=LA("LRIDT") 125189 "RTN","C0CVORU", 194,0)125407 "RTN","C0CVORU",208,0) 125190 125408 S OBR(20)=$$OBR20^LA7VOBR(.LA7X,LA7FS,LA7ECH) 125191 "RTN","C0CVORU", 195,0)125192 ; 125193 "RTN","C0CVORU", 196,0)125409 "RTN","C0CVORU",209,0) 125410 ; 125411 "RTN","C0CVORU",210,0) 125194 125412 ; Date Report Completed 125195 "RTN","C0CVORU", 197,0)125413 "RTN","C0CVORU",211,0) 125196 125414 I $P(LA763(0),"^",3) S OBR(22)=$$OBR22^LA7VOBR($P(LA763(0),"^",3)) 125197 "RTN","C0CVORU", 198,0)125198 ; 125199 "RTN","C0CVORU", 199,0)125415 "RTN","C0CVORU",212,0) 125416 ; 125417 "RTN","C0CVORU",213,0) 125200 125418 ; Diagnostic service id 125201 "RTN","C0CVORU",2 00,0)125419 "RTN","C0CVORU",214,0) 125202 125420 S OBR(24)=$$OBR24^LA7VOBR(LA("SUB")_"^"_$G(LRSB)) 125203 "RTN","C0CVORU",2 01,0)125204 ; 125205 "RTN","C0CVORU",2 02,0)125421 "RTN","C0CVORU",215,0) 125422 ; 125423 "RTN","C0CVORU",216,0) 125206 125424 ; Parent Result and Parent 125207 "RTN","C0CVORU",2 03,0)125425 "RTN","C0CVORU",217,0) 125208 125426 I $D(LA7PARNT) D 125209 "RTN","C0CVORU",2 04,0)125427 "RTN","C0CVORU",218,0) 125210 125428 . S OBR(26)=$$OBR26^LA7VOBR(LA7PARNT(1),LA7PARNT(2),LA7PARNT(3),LA7FS,LA7ECH) 125211 "RTN","C0CVORU",2 05,0)125429 "RTN","C0CVORU",219,0) 125212 125430 . S OBR(29)=$$OBR29^LA7VOBR(LA("RUID"),LA("HUID"),LA7FS,LA7ECH) 125213 "RTN","C0CVORU",2 06,0)125214 ; 125215 "RTN","C0CVORU",2 07,0)125431 "RTN","C0CVORU",220,0) 125432 ; 125433 "RTN","C0CVORU",221,0) 125216 125434 ; Principle result interpreter 125217 "RTN","C0CVORU",208,0)125218 ; Get default institution from MailMan Site Parameters file125219 "RTN","C0CVORU",209,0)125220 I "CYEMMISP"[LA("SUB") D125221 "RTN","C0CVORU",210,0)125222 . I LA("SUB")="MI" S LA7X=$P(LA763(0),"^",4)125223 "RTN","C0CVORU",211,0)125224 . E S LA7X=$P(LA763(0),"^",2)125225 "RTN","C0CVORU",212,0)125226 . S LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")125227 "RTN","C0CVORU",213,0)125228 . S OBR(32)=$$OBR32^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)125229 "RTN","C0CVORU",214,0)125230 ;125231 "RTN","C0CVORU",215,0)125232 ; Assistant result interpreter125233 "RTN","C0CVORU",216,0)125234 ; Get default institution from MailMan Site Parameters file125235 "RTN","C0CVORU",217,0)125236 I "EMSP"[LA("SUB") D125237 "RTN","C0CVORU",218,0)125238 . S LA7X=$P(LA763(0),"^",4),LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")125239 "RTN","C0CVORU",219,0)125240 . S OBR(33)=$$OBR33^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)125241 "RTN","C0CVORU",220,0)125242 ;125243 "RTN","C0CVORU",221,0)125244 ; Technician125245 125435 "RTN","C0CVORU",222,0) 125246 125436 ; Get default institution from MailMan Site Parameters file 125247 125437 "RTN","C0CVORU",223,0) 125438 I "CYEMMISP"[LA("SUB") D 125439 "RTN","C0CVORU",224,0) 125440 . I LA("SUB")="MI" S LA7X=$P(LA763(0),"^",4) 125441 "RTN","C0CVORU",225,0) 125442 . E S LA7X=$P(LA763(0),"^",2) 125443 "RTN","C0CVORU",226,0) 125444 . S LA7Y=$$GET1^DIQ(4.3,"1,",217,"I") 125445 "RTN","C0CVORU",227,0) 125446 . S OBR(32)=$$OBR32^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH) 125447 "RTN","C0CVORU",228,0) 125448 ; 125449 "RTN","C0CVORU",229,0) 125450 ; Assistant result interpreter 125451 "RTN","C0CVORU",230,0) 125452 ; Get default institution from MailMan Site Parameters file 125453 "RTN","C0CVORU",231,0) 125454 I "EMSP"[LA("SUB") D 125455 "RTN","C0CVORU",232,0) 125456 . S LA7X=$P(LA763(0),"^",4),LA7Y=$$GET1^DIQ(4.3,"1,",217,"I") 125457 "RTN","C0CVORU",233,0) 125458 . S OBR(33)=$$OBR33^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH) 125459 "RTN","C0CVORU",234,0) 125460 ; 125461 "RTN","C0CVORU",235,0) 125462 ; Technician 125463 "RTN","C0CVORU",236,0) 125464 ; Get default institution from MailMan Site Parameters file 125465 "RTN","C0CVORU",237,0) 125248 125466 I "CYEM"[LA("SUB") D 125249 "RTN","C0CVORU",2 24,0)125467 "RTN","C0CVORU",238,0) 125250 125468 . S LA7X=$P(LA763(0),"^",4),LA7Y=$$GET1^DIQ(4.3,"1,",217,"I") 125251 "RTN","C0CVORU",2 25,0)125469 "RTN","C0CVORU",239,0) 125252 125470 . S OBR(34)=$$OBR34^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH) 125253 "RTN","C0CVORU",2 26,0)125471 "RTN","C0CVORU",240,0) 125254 125472 ; 125255 "RTN","C0CVORU",2 27,0)125473 "RTN","C0CVORU",241,0) 125256 125474 ; Typist - VistA stores as free text 125257 "RTN","C0CVORU",2 28,0)125475 "RTN","C0CVORU",242,0) 125258 125476 ; Get default institution from MailMan Site Parameters file 125259 "RTN","C0CVORU",2 29,0)125477 "RTN","C0CVORU",243,0) 125260 125478 I "CYEMSP"[LA("SUB") D 125261 "RTN","C0CVORU",2 30,0)125479 "RTN","C0CVORU",244,0) 125262 125480 . S LA7X=$P(LA763(0),"^",9),LA7Y=$$GET1^DIQ(4.3,"1,",217,"I") 125263 "RTN","C0CVORU",2 31,0)125481 "RTN","C0CVORU",245,0) 125264 125482 . S OBR(35)=$$OBR35^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH) 125265 "RTN","C0CVORU",2 32,0)125483 "RTN","C0CVORU",246,0) 125266 125484 ; 125267 "RTN","C0CVORU",2 33,0)125485 "RTN","C0CVORU",247,0) 125268 125486 D BUILDSEG^LA7VHLU(.OBR,.LA7DATA,LA7FS) 125269 "RTN","C0CVORU",2 34,0)125487 "RTN","C0CVORU",248,0) 125270 125488 D FILESEG^LA7VHLU(GBL,.LA7DATA) 125271 "RTN","C0CVORU",2 35,0)125272 ; 125273 "RTN","C0CVORU",2 36,0)125489 "RTN","C0CVORU",249,0) 125490 ; 125491 "RTN","C0CVORU",250,0) 125274 125492 ; Check for flag to only build message but do not file 125275 "RTN","C0CVORU",2 37,0)125493 "RTN","C0CVORU",251,0) 125276 125494 I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA) 125277 "RTN","C0CVORU",2 38,0)125278 ; 125279 "RTN","C0CVORU",2 39,0)125495 "RTN","C0CVORU",252,0) 125496 ; 125497 "RTN","C0CVORU",253,0) 125280 125498 Q 125281 "RTN","C0CVORU",2 40,0)125282 ; 125283 "RTN","C0CVORU",2 41,0)125284 ; 125285 "RTN","C0CVORU",2 42,0)125499 "RTN","C0CVORU",254,0) 125500 ; 125501 "RTN","C0CVORU",255,0) 125502 ; 125503 "RTN","C0CVORU",256,0) 125286 125504 OBX ;Observation/Result segment for Lab Results 125287 "RTN","C0CVORU",2 43,0)125288 ; 125289 "RTN","C0CVORU",2 44,0)125505 "RTN","C0CVORU",257,0) 125506 ; 125507 "RTN","C0CVORU",258,0) 125290 125508 N LA7953,LA7DATA,LA7VT,LA7VTIEN,LA7X 125291 "RTN","C0CVORU",2 45,0)125292 ; 125293 "RTN","C0CVORU",2 46,0)125509 "RTN","C0CVORU",259,0) 125510 ; 125511 "RTN","C0CVORU",260,0) 125294 125512 S LA7VTIEN=0 125295 "RTN","C0CVORU",2 47,0)125513 "RTN","C0CVORU",261,0) 125296 125514 F S LA7VTIEN=$O(^LAHM(62.49,LA(62.49),1,LA7VTIEN)) Q:'LA7VTIEN D 125297 "RTN","C0CVORU",2 48,0)125515 "RTN","C0CVORU",262,0) 125298 125516 . S LA7VT=$P(^LAHM(62.49,LA(62.49),1,LA7VTIEN,0),"^",1,2) 125299 "RTN","C0CVORU",2 49,0)125517 "RTN","C0CVORU",263,0) 125300 125518 . ; Build OBX segment 125301 "RTN","C0CVORU",2 50,0)125519 "RTN","C0CVORU",264,0) 125302 125520 . K LA7DATA 125303 "RTN","C0CVORU",2 51,0)125521 "RTN","C0CVORU",265,0) 125304 125522 . D OBX^LA7VOBX(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^",1,2),.LA7DATA,.LA7OBXSN,LA7FS,LA7ECH,$G(LA7NVAF)) 125305 "RTN","C0CVORU",2 52,0)125523 "RTN","C0CVORU",266,0) 125306 125524 . ; If OBX failed to build then don't store 125307 "RTN","C0CVORU",2 53,0)125525 "RTN","C0CVORU",267,0) 125308 125526 . I '$D(LA7DATA) Q 125309 "RTN","C0CVORU",2 54,0)125527 "RTN","C0CVORU",268,0) 125310 125528 . ; 125311 "RTN","C0CVORU",2 55,0)125529 "RTN","C0CVORU",269,0) 125312 125530 . D FILESEG^LA7VHLU(GBL,.LA7DATA) 125313 "RTN","C0CVORU",2 56,0)125531 "RTN","C0CVORU",270,0) 125314 125532 . I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA) 125315 "RTN","C0CVORU",2 57,0)125533 "RTN","C0CVORU",271,0) 125316 125534 . ; 125317 "RTN","C0CVORU",2 58,0)125535 "RTN","C0CVORU",272,0) 125318 125536 . ; Send performing lab comment and interpretation from file #60 125319 "RTN","C0CVORU",2 59,0)125537 "RTN","C0CVORU",273,0) 125320 125538 . S LA7NTESN=0 125321 "RTN","C0CVORU",2 60,0)125539 "RTN","C0CVORU",274,0) 125322 125540 . I LA7NVAF=1 D PLC^LA7VORUA 125323 "RTN","C0CVORU",2 61,0)125541 "RTN","C0CVORU",275,0) 125324 125542 . D INTRP^LA7VORUA 125325 "RTN","C0CVORU",2 62,0)125543 "RTN","C0CVORU",276,0) 125326 125544 . ; 125327 "RTN","C0CVORU",2 63,0)125545 "RTN","C0CVORU",277,0) 125328 125546 . ; Mark result as sent - set to 1, if corrected results set to 2 125329 "RTN","C0CVORU",2 64,0)125547 "RTN","C0CVORU",278,0) 125330 125548 . I LA("SUB")="CH" D 125331 "RTN","C0CVORU",2 65,0)125549 "RTN","C0CVORU",279,0) 125332 125550 . . I $P(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^")),"^",10)>1 Q 125333 "RTN","C0CVORU",2 66,0)125551 "RTN","C0CVORU",280,0) 125334 125552 . . S $P(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^")),"^",10)=$S($P(LA7VT,"^",2)="C":2,1:1) 125335 "RTN","C0CVORU",2 67,0)125336 ; 125337 "RTN","C0CVORU",2 68,0)125553 "RTN","C0CVORU",281,0) 125554 ; 125555 "RTN","C0CVORU",282,0) 125338 125556 Q 125339 "RTN","C0CVORU",2 69,0)125340 ; 125341 "RTN","C0CVORU",2 70,0)125342 ; 125343 "RTN","C0CVORU",2 71,0)125557 "RTN","C0CVORU",283,0) 125558 ; 125559 "RTN","C0CVORU",284,0) 125560 ; 125561 "RTN","C0CVORU",285,0) 125344 125562 NTE ; Build NTE segment 125345 "RTN","C0CVORU",2 72,0)125346 ; 125347 "RTN","C0CVORU",2 73,0)125563 "RTN","C0CVORU",286,0) 125564 ; 125565 "RTN","C0CVORU",287,0) 125348 125566 D NTE^LA7VORUA 125349 "RTN","C0CVORU",2 74,0)125567 "RTN","C0CVORU",288,0) 125350 125568 Q 125351 125569 "RTN","C0CXEWD") 125352 0^101^B15 380480125570 0^101^B15053974 125353 125571 "RTN","C0CXEWD",1,0) 125354 125572 C0CXEWD ; C0C/GPL - EWD based XPath utilities; 10/11/09 125355 125573 "RTN","C0CXEWD",2,0) 125356 ;;1.2;C 0C;;May 11, 2012;Build 50125574 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 125357 125575 "RTN","C0CXEWD",3,0) 125358 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU125576 ;Copyright 2009 George Lilly. 125359 125577 "RTN","C0CXEWD",4,0) 125360 ; General Public License See attached copy of the License.125578 ; 125361 125579 "RTN","C0CXEWD",5,0) 125362 ; 125580 ; This program is free software: you can redistribute it and/or modify 125363 125581 "RTN","C0CXEWD",6,0) 125364 ; This program is free software; you can redistribute it and/or modify125582 ; it under the terms of the GNU Affero General Public License as 125365 125583 "RTN","C0CXEWD",7,0) 125366 ; it under the terms of the GNU General Public License as published by125584 ; published by the Free Software Foundation, either version 3 of the 125367 125585 "RTN","C0CXEWD",8,0) 125368 ; the Free Software Foundation; either version 2 of the License, or125586 ; License, or (at your option) any later version. 125369 125587 "RTN","C0CXEWD",9,0) 125370 ; (at your option) any later version.125588 ; 125371 125589 "RTN","C0CXEWD",10,0) 125372 ; 125590 ; This program is distributed in the hope that it will be useful, 125373 125591 "RTN","C0CXEWD",11,0) 125374 ; This program is distributed in the hope that it will be useful,125592 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 125375 125593 "RTN","C0CXEWD",12,0) 125376 ; but WITHOUT ANY WARRANTY; without even the implied warranty of125594 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 125377 125595 "RTN","C0CXEWD",13,0) 125378 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the125596 ; GNU Affero General Public License for more details. 125379 125597 "RTN","C0CXEWD",14,0) 125380 ; GNU General Public License for more details.125598 ; 125381 125599 "RTN","C0CXEWD",15,0) 125382 ; 125600 ; You should have received a copy of the GNU Affero General Public License 125383 125601 "RTN","C0CXEWD",16,0) 125384 ; You should have received a copy of the GNU General Public License along125602 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 125385 125603 "RTN","C0CXEWD",17,0) 125386 ; with this program; if not, write to the Free Software Foundation, Inc.,125604 ; 125387 125605 "RTN","C0CXEWD",18,0) 125388 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.125606 Q 125389 125607 "RTN","C0CXEWD",19,0) 125390 125608 ; 125391 125609 "RTN","C0CXEWD",20,0) 125610 TEST ; 125611 "RTN","C0CXEWD",21,0) 125612 D XPATH($$FIRST($$ID("CCR1")),"/","GIDX","GARY") 125613 "RTN","C0CXEWD",22,0) 125392 125614 Q 125393 "RTN","C0CXEWD",21,0)125394 ;125395 "RTN","C0CXEWD",22,0)125396 TEST ;125397 125615 "RTN","C0CXEWD",23,0) 125398 D XPATH($$FIRST($$ID("CCR1")),"/","GIDX","GARY")125616 ; 125399 125617 "RTN","C0CXEWD",24,0) 125618 TEST2 ; 125619 "RTN","C0CXEWD",25,0) 125620 S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail" 125621 "RTN","C0CXEWD",26,0) 125622 D XPATH($$FIRST($$ID("gpl")),"/","GIDX","GARY","",REDUX) 125623 "RTN","C0CXEWD",27,0) 125400 125624 Q 125401 "RTN","C0CXEWD",25,0)125402 ;125403 "RTN","C0CXEWD",26,0)125404 TEST2 ;125405 "RTN","C0CXEWD",27,0)125406 S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail"125407 125625 "RTN","C0CXEWD",28,0) 125408 D XPATH($$FIRST($$ID("gpl")),"/","GIDX","GARY","",REDUX)125626 ; 125409 125627 "RTN","C0CXEWD",29,0) 125628 XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE 125629 "RTN","C0CXEWD",30,0) 125630 ; THE XPATH INDEX ZXIDX, PASSED BY NAME 125631 "RTN","C0CXEWD",31,0) 125632 ; THE XPATH ARRAY XPARY, PASSED BY NAME 125633 "RTN","C0CXEWD",32,0) 125634 ; ZOID IS THE STARTING OID 125635 "RTN","C0CXEWD",33,0) 125636 ; ZPATH IS THE STARTING XPATH, USUALLY "/" 125637 "RTN","C0CXEWD",34,0) 125638 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE 125639 "RTN","C0CXEWD",35,0) 125640 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT 125641 "RTN","C0CXEWD",36,0) 125642 I '$D(ZREDUX) S ZREDUX="" 125643 "RTN","C0CXEWD",37,0) 125644 N NEWPATH 125645 "RTN","C0CXEWD",38,0) 125646 N NEWNUM S NEWNUM="" 125647 "RTN","C0CXEWD",39,0) 125648 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" 125649 "RTN","C0CXEWD",40,0) 125650 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE 125651 "RTN","C0CXEWD",41,0) 125652 I $G(ZREDUX)'="" D ; REDUX PROVIDED? 125653 "RTN","C0CXEWD",42,0) 125654 . N GT S GT=$P(NEWPATH,ZREDUX,2) 125655 "RTN","C0CXEWD",43,0) 125656 . I GT'="" S NEWPATH=GT 125657 "RTN","C0CXEWD",44,0) 125658 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX 125659 "RTN","C0CXEWD",45,0) 125660 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE 125661 "RTN","C0CXEWD",46,0) 125662 I $D(GD(2)) M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY 125663 "RTN","C0CXEWD",47,0) 125664 E I $D(GD(1)) S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY 125665 "RTN","C0CXEWD",48,0) 125666 I GD'="" S @ZXPARY@(NEWPATH)=GD ; IF YES, ADD IT TO THE XPATH ARRAY 125667 "RTN","C0CXEWD",49,0) 125668 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD 125669 "RTN","C0CXEWD",50,0) 125670 I ZFRST'="" D ; THERE IS A CHILD 125671 "RTN","C0CXEWD",51,0) 125672 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE 125673 "RTN","C0CXEWD",52,0) 125674 . D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD 125675 "RTN","C0CXEWD",53,0) 125676 N GNXT S GNXT=$$NXTSIB(ZOID) 125677 "RTN","C0CXEWD",54,0) 125678 I GNXT'="" D ; MOVE ON TO THE NEXT SIBLING 125679 "RTN","C0CXEWD",55,0) 125680 . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB 125681 "RTN","C0CXEWD",56,0) 125410 125682 Q 125411 "RTN","C0CXEWD",30,0)125412 ;125413 "RTN","C0CXEWD",31,0)125414 XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE125415 "RTN","C0CXEWD",32,0)125416 ; THE XPATH INDEX ZXIDX, PASSED BY NAME125417 "RTN","C0CXEWD",33,0)125418 ; THE XPATH ARRAY XPARY, PASSED BY NAME125419 "RTN","C0CXEWD",34,0)125420 ; ZOID IS THE STARTING OID125421 "RTN","C0CXEWD",35,0)125422 ; ZPATH IS THE STARTING XPATH, USUALLY "/"125423 "RTN","C0CXEWD",36,0)125424 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE125425 "RTN","C0CXEWD",37,0)125426 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT125427 "RTN","C0CXEWD",38,0)125428 I '$D(ZREDUX) S ZREDUX=""125429 "RTN","C0CXEWD",39,0)125430 N NEWPATH125431 "RTN","C0CXEWD",40,0)125432 N NEWNUM S NEWNUM=""125433 "RTN","C0CXEWD",41,0)125434 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"125435 "RTN","C0CXEWD",42,0)125436 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE125437 "RTN","C0CXEWD",43,0)125438 I $G(ZREDUX)'="" D ; REDUX PROVIDED?125439 "RTN","C0CXEWD",44,0)125440 . N GT S GT=$P(NEWPATH,ZREDUX,2)125441 "RTN","C0CXEWD",45,0)125442 . I GT'="" S NEWPATH=GT125443 "RTN","C0CXEWD",46,0)125444 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX125445 "RTN","C0CXEWD",47,0)125446 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE125447 "RTN","C0CXEWD",48,0)125448 I $D(GD(2)) M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY125449 "RTN","C0CXEWD",49,0)125450 E I $D(GD(1)) S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY125451 "RTN","C0CXEWD",50,0)125452 I GD'="" S @ZXPARY@(NEWPATH)=GD ; IF YES, ADD IT TO THE XPATH ARRAY125453 "RTN","C0CXEWD",51,0)125454 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD125455 "RTN","C0CXEWD",52,0)125456 I ZFRST'="" D ; THERE IS A CHILD125457 "RTN","C0CXEWD",53,0)125458 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE125459 "RTN","C0CXEWD",54,0)125460 . D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD125461 "RTN","C0CXEWD",55,0)125462 N GNXT S GNXT=$$NXTSIB(ZOID)125463 "RTN","C0CXEWD",56,0)125464 I GNXT'="" D ; MOVE ON TO THE NEXT SIBLING125465 125683 "RTN","C0CXEWD",57,0) 125466 . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB125684 ; 125467 125685 "RTN","C0CXEWD",58,0) 125686 PARSE(INXML,INDOC) ;CALL THE EWD PARSER ON INXML, PASSED BY NAME 125687 "RTN","C0CXEWD",59,0) 125688 ; INDOC IS PASSED AS THE DOCUMENT NAME TO EWD 125689 "RTN","C0CXEWD",60,0) 125690 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY EWD 125691 "RTN","C0CXEWD",61,0) 125692 N ZR 125693 "RTN","C0CXEWD",62,0) 125694 M ^CacheTempEWD($j)=@INXML ; 125695 "RTN","C0CXEWD",63,0) 125696 S ZR=$$parseDocument^%zewdHTMLParser(INDOC) 125697 "RTN","C0CXEWD",64,0) 125698 Q ZR 125699 "RTN","C0CXEWD",65,0) 125700 ; 125701 "RTN","C0CXEWD",66,0) 125702 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE 125703 "RTN","C0CXEWD",67,0) 125704 N ZN 125705 "RTN","C0CXEWD",68,0) 125706 S ZN=$$NXTSIB(ZOID) 125707 "RTN","C0CXEWD",69,0) 125708 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG 125709 "RTN","C0CXEWD",70,0) 125710 Q 0 125711 "RTN","C0CXEWD",71,0) 125712 ; 125713 "RTN","C0CXEWD",72,0) 125714 DETAIL(ZRTN,ZOID) ; RETURNS DETAIL FOR NODE ZOID IN ZRTN, PASSED BY NAME 125715 "RTN","C0CXEWD",73,0) 125716 N DET 125717 "RTN","C0CXEWD",74,0) 125718 D getElementDetails^%zewdXPath(ZOID,.DET) 125719 "RTN","C0CXEWD",75,0) 125720 M @ZRTN=DET 125721 "RTN","C0CXEWD",76,0) 125468 125722 Q 125469 "RTN","C0CXEWD",59,0)125470 ;125471 "RTN","C0CXEWD",60,0)125472 PARSE(INXML,INDOC) ;CALL THE EWD PARSER ON INXML, PASSED BY NAME125473 "RTN","C0CXEWD",61,0)125474 ; INDOC IS PASSED AS THE DOCUMENT NAME TO EWD125475 "RTN","C0CXEWD",62,0)125476 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY EWD125477 "RTN","C0CXEWD",63,0)125478 N ZR125479 "RTN","C0CXEWD",64,0)125480 M ^CacheTempEWD($j)=@INXML ;125481 "RTN","C0CXEWD",65,0)125482 S ZR=$$parseDocument^%zewdHTMLParser(INDOC)125483 "RTN","C0CXEWD",66,0)125484 Q ZR125485 "RTN","C0CXEWD",67,0)125486 ;125487 "RTN","C0CXEWD",68,0)125488 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE125489 "RTN","C0CXEWD",69,0)125490 N ZN125491 "RTN","C0CXEWD",70,0)125492 S ZN=$$NXTSIB(ZOID)125493 "RTN","C0CXEWD",71,0)125494 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG125495 "RTN","C0CXEWD",72,0)125496 Q 0125497 "RTN","C0CXEWD",73,0)125498 ;125499 "RTN","C0CXEWD",74,0)125500 DETAIL(ZRTN,ZOID) ; RETURNS DETAIL FOR NODE ZOID IN ZRTN, PASSED BY NAME125501 "RTN","C0CXEWD",75,0)125502 N DET125503 "RTN","C0CXEWD",76,0)125504 D getElementDetails^%zewdXPath(ZOID,.DET)125505 125723 "RTN","C0CXEWD",77,0) 125506 M @ZRTN=DET125724 ; 125507 125725 "RTN","C0CXEWD",78,0) 125726 ID(ZNAME) ;RETURNS THE docOID OF THE DOCUMENT NAMED ZNAME 125727 "RTN","C0CXEWD",79,0) 125728 Q $$getDocumentNode^%zewdDOM(ZNAME) 125729 "RTN","C0CXEWD",80,0) 125730 ; 125731 "RTN","C0CXEWD",81,0) 125732 NAME(ZOID) ;RETURNS THE NAME OF THE DOCUMENAT WITH docOID ZOID 125733 "RTN","C0CXEWD",82,0) 125734 Q $$getDocumentName^%zewdDOM(ZOID) 125735 "RTN","C0CXEWD",83,0) 125736 ; 125737 "RTN","C0CXEWD",84,0) 125738 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID 125739 "RTN","C0CXEWD",85,0) 125740 N GOID 125741 "RTN","C0CXEWD",86,0) 125742 S GOID=ZOID 125743 "RTN","C0CXEWD",87,0) 125744 S GOID=$$getFirstChild^%zewdDOM(GOID) 125745 "RTN","C0CXEWD",88,0) 125746 I GOID="" Q "" 125747 "RTN","C0CXEWD",89,0) 125748 I $$getNodeType^%zewdDOM(GOID)'=1 S GOID=$$NXTCHLD(GOID) 125749 "RTN","C0CXEWD",90,0) 125750 Q GOID 125751 "RTN","C0CXEWD",91,0) 125752 ; 125753 "RTN","C0CXEWD",92,0) 125754 HASCHILD(ZOID) ; RETURNS TRUE IF ZOID HAS CHILD NODES 125755 "RTN","C0CXEWD",93,0) 125756 Q $$hasChildNodes^%zewdDOM(ZOID) 125757 "RTN","C0CXEWD",94,0) 125758 ; 125759 "RTN","C0CXEWD",95,0) 125760 CHILDREN(ZRTN,ZOID) ;RETURNS CHILDREN OF ZOID IN ARRAY ZRTN, PASSED BY NAME 125761 "RTN","C0CXEWD",96,0) 125762 N childArray 125763 "RTN","C0CXEWD",97,0) 125764 d getChildrenInOrder^%zewdDOM(ZOID,.childArray) 125765 "RTN","C0CXEWD",98,0) 125766 m @ZRTN=childArray 125767 "RTN","C0CXEWD",99,0) 125768 q 125769 "RTN","C0CXEWD",100,0) 125770 ; 125771 "RTN","C0CXEWD",101,0) 125772 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE 125773 "RTN","C0CXEWD",102,0) 125774 Q $$getName^%zewdDOM(ZOID) 125775 "RTN","C0CXEWD",103,0) 125776 ; 125777 "RTN","C0CXEWD",104,0) 125778 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING 125779 "RTN","C0CXEWD",105,0) 125780 Q $$getNextSibling^%zewdDOM(ZOID) 125781 "RTN","C0CXEWD",106,0) 125782 ; 125783 "RTN","C0CXEWD",107,0) 125784 NXTCHLD(ZOID) ; RETURNS THE NEXT CHILD IN PARENT ZPAR 125785 "RTN","C0CXEWD",108,0) 125786 N GOID 125787 "RTN","C0CXEWD",109,0) 125788 S GOID=$$getNextChild^%zewdDOM($$PARENT(ZOID),ZOID) 125789 "RTN","C0CXEWD",110,0) 125790 I GOID="" Q "" 125791 "RTN","C0CXEWD",111,0) 125792 I $$getNodeType^%zewdDOM(GOID)'=1 S GOID=$$NXTCHLD(GOID) 125793 "RTN","C0CXEWD",112,0) 125794 Q GOID 125795 "RTN","C0CXEWD",113,0) 125796 ; 125797 "RTN","C0CXEWD",114,0) 125798 PARENT(ZOID) ; RETURNS PARENT OF ZOID 125799 "RTN","C0CXEWD",115,0) 125800 Q $$getParentNode^%zewdDOM(ZOID) 125801 "RTN","C0CXEWD",116,0) 125802 ; 125803 "RTN","C0CXEWD",117,0) 125804 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE 125805 "RTN","C0CXEWD",118,0) 125806 N ZT2 125807 "RTN","C0CXEWD",119,0) 125808 S ZT2=$$getElementText^%zewdDOM(ZOID,.ZT2) 125809 "RTN","C0CXEWD",120,0) 125810 M @ZT=ZT2 125811 "RTN","C0CXEWD",121,0) 125508 125812 Q 125509 "RTN","C0CXEWD",79,0)125510 ;125511 "RTN","C0CXEWD",80,0)125512 ID(ZNAME) ;RETURNS THE docOID OF THE DOCUMENT NAMED ZNAME125513 "RTN","C0CXEWD",81,0)125514 Q $$getDocumentNode^%zewdDOM(ZNAME)125515 "RTN","C0CXEWD",82,0)125516 ;125517 "RTN","C0CXEWD",83,0)125518 NAME(ZOID) ;RETURNS THE NAME OF THE DOCUMENAT WITH docOID ZOID125519 "RTN","C0CXEWD",84,0)125520 Q $$getDocumentName^%zewdDOM(ZOID)125521 "RTN","C0CXEWD",85,0)125522 ;125523 "RTN","C0CXEWD",86,0)125524 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID125525 "RTN","C0CXEWD",87,0)125526 N GOID125527 "RTN","C0CXEWD",88,0)125528 S GOID=ZOID125529 "RTN","C0CXEWD",89,0)125530 S GOID=$$getFirstChild^%zewdDOM(GOID)125531 "RTN","C0CXEWD",90,0)125532 I GOID="" Q ""125533 "RTN","C0CXEWD",91,0)125534 I $$getNodeType^%zewdDOM(GOID)'=1 S GOID=$$NXTCHLD(GOID)125535 "RTN","C0CXEWD",92,0)125536 Q GOID125537 "RTN","C0CXEWD",93,0)125538 ;125539 "RTN","C0CXEWD",94,0)125540 HASCHILD(ZOID) ; RETURNS TRUE IF ZOID HAS CHILD NODES125541 "RTN","C0CXEWD",95,0)125542 Q $$hasChildNodes^%zewdDOM(ZOID)125543 "RTN","C0CXEWD",96,0)125544 ;125545 "RTN","C0CXEWD",97,0)125546 CHILDREN(ZRTN,ZOID) ;RETURNS CHILDREN OF ZOID IN ARRAY ZRTN, PASSED BY NAME125547 "RTN","C0CXEWD",98,0)125548 N childArray125549 "RTN","C0CXEWD",99,0)125550 d getChildrenInOrder^%zewdDOM(ZOID,.childArray)125551 "RTN","C0CXEWD",100,0)125552 m @ZRTN=childArray125553 "RTN","C0CXEWD",101,0)125554 q125555 "RTN","C0CXEWD",102,0)125556 ;125557 "RTN","C0CXEWD",103,0)125558 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE125559 "RTN","C0CXEWD",104,0)125560 Q $$getName^%zewdDOM(ZOID)125561 "RTN","C0CXEWD",105,0)125562 ;125563 "RTN","C0CXEWD",106,0)125564 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING125565 "RTN","C0CXEWD",107,0)125566 Q $$getNextSibling^%zewdDOM(ZOID)125567 "RTN","C0CXEWD",108,0)125568 ;125569 "RTN","C0CXEWD",109,0)125570 NXTCHLD(ZOID) ; RETURNS THE NEXT CHILD IN PARENT ZPAR125571 "RTN","C0CXEWD",110,0)125572 N GOID125573 "RTN","C0CXEWD",111,0)125574 S GOID=$$getNextChild^%zewdDOM($$PARENT(ZOID),ZOID)125575 "RTN","C0CXEWD",112,0)125576 I GOID="" Q ""125577 "RTN","C0CXEWD",113,0)125578 I $$getNodeType^%zewdDOM(GOID)'=1 S GOID=$$NXTCHLD(GOID)125579 "RTN","C0CXEWD",114,0)125580 Q GOID125581 "RTN","C0CXEWD",115,0)125582 ;125583 "RTN","C0CXEWD",116,0)125584 PARENT(ZOID) ; RETURNS PARENT OF ZOID125585 "RTN","C0CXEWD",117,0)125586 Q $$getParentNode^%zewdDOM(ZOID)125587 "RTN","C0CXEWD",118,0)125588 ;125589 "RTN","C0CXEWD",119,0)125590 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE125591 "RTN","C0CXEWD",120,0)125592 N ZT2125593 "RTN","C0CXEWD",121,0)125594 S ZT2=$$getElementText^%zewdDOM(ZOID,.ZT2)125595 125813 "RTN","C0CXEWD",122,0) 125596 M @ZT=ZT2125814 ;Q $$getTextValue^%zewdXPath(ZOID) 125597 125815 "RTN","C0CXEWD",123,0) 125598 Q125816 ;Q $$getData^%zewdDOM(ZOID,.ZT) 125599 125817 "RTN","C0CXEWD",124,0) 125600 ;Q $$getTextValue^%zewdXPath(ZOID)125601 "RTN","C0CXEWD",125,0)125602 ;Q $$getData^%zewdDOM(ZOID,.ZT)125603 "RTN","C0CXEWD",126,0)125604 125818 ; 125605 125819 "RTN","C0CXPAT0") 125606 0^35^B 50736852125820 0^35^B49945143 125607 125821 "RTN","C0CXPAT0",1,0) 125608 125822 C0CXPAT0 ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08 125609 125823 "RTN","C0CXPAT0",2,0) 125610 ;;1.2;C 0C;;May 11, 2012;Build 50125824 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 125611 125825 "RTN","C0CXPAT0",3,0) 125612 ;Copyright 2008 George Lilly. Licensed under the terms of the GNU125826 ;Copyright 2008 George Lilly. 125613 125827 "RTN","C0CXPAT0",4,0) 125614 ; General Public License See attached copy of the License.125828 ; 125615 125829 "RTN","C0CXPAT0",5,0) 125616 ; 125830 ; This program is free software: you can redistribute it and/or modify 125617 125831 "RTN","C0CXPAT0",6,0) 125618 ; This program is free software; you can redistribute it and/or modify125832 ; it under the terms of the GNU Affero General Public License as 125619 125833 "RTN","C0CXPAT0",7,0) 125620 ; it under the terms of the GNU General Public License as published by125834 ; published by the Free Software Foundation, either version 3 of the 125621 125835 "RTN","C0CXPAT0",8,0) 125622 ; the Free Software Foundation; either version 2 of the License, or125836 ; License, or (at your option) any later version. 125623 125837 "RTN","C0CXPAT0",9,0) 125624 ; (at your option) any later version.125838 ; 125625 125839 "RTN","C0CXPAT0",10,0) 125626 ; 125840 ; This program is distributed in the hope that it will be useful, 125627 125841 "RTN","C0CXPAT0",11,0) 125628 ; This program is distributed in the hope that it will be useful,125842 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 125629 125843 "RTN","C0CXPAT0",12,0) 125630 ; but WITHOUT ANY WARRANTY; without even the implied warranty of125844 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 125631 125845 "RTN","C0CXPAT0",13,0) 125632 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the125846 ; GNU Affero General Public License for more details. 125633 125847 "RTN","C0CXPAT0",14,0) 125634 ; GNU General Public License for more details.125848 ; 125635 125849 "RTN","C0CXPAT0",15,0) 125636 ; 125850 ; You should have received a copy of the GNU Affero General Public License 125637 125851 "RTN","C0CXPAT0",16,0) 125638 ; You should have received a copy of the GNU General Public License along125852 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 125639 125853 "RTN","C0CXPAT0",17,0) 125640 ; with this program; if not, write to the Free Software Foundation, Inc.,125854 ; 125641 125855 "RTN","C0CXPAT0",18,0) 125642 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.125856 W "NO ENTRY",! 125643 125857 "RTN","C0CXPAT0",19,0) 125644 ;125858 Q 125645 125859 "RTN","C0CXPAT0",20,0) 125646 W "NO ENTRY",!125860 ; 125647 125861 "RTN","C0CXPAT0",21,0) 125648 Q125862 ;;><TEST> 125649 125863 "RTN","C0CXPAT0",22,0) 125650 ;125864 ;;><INIT> 125651 125865 "RTN","C0CXPAT0",23,0) 125652 ;;> <TEST>125866 ;;>>>K C0C S C0C="" 125653 125867 "RTN","C0CXPAT0",24,0) 125654 ;;> <INIT>125868 ;;>>>D PUSH^C0CXPATH("C0C","FIRST") 125655 125869 "RTN","C0CXPAT0",25,0) 125656 ;;>>> K C0C S C0C=""125870 ;;>>>D PUSH^C0CXPATH("C0C","SECOND") 125657 125871 "RTN","C0CXPAT0",26,0) 125658 ;;>>>D PUSH^C0CXPATH("C0C"," FIRST")125872 ;;>>>D PUSH^C0CXPATH("C0C","THIRD") 125659 125873 "RTN","C0CXPAT0",27,0) 125660 ;;>>>D PUSH^C0CXPATH("C0C"," SECOND")125874 ;;>>>D PUSH^C0CXPATH("C0C","FOURTH") 125661 125875 "RTN","C0CXPAT0",28,0) 125662 ;;>> >D PUSH^C0CXPATH("C0C","THIRD")125876 ;;>>?C0C(0)=4 125663 125877 "RTN","C0CXPAT0",29,0) 125664 ;;> >>D PUSH^C0CXPATH("C0C","FOURTH")125878 ;;><INITXML> 125665 125879 "RTN","C0CXPAT0",30,0) 125666 ;;>> ?C0C(0)=4125880 ;;>>>K GXML S GXML="" 125667 125881 "RTN","C0CXPAT0",31,0) 125668 ;;> <INITXML>125882 ;;>>>D PUSH^C0CXPATH("GXML","<FIRST>") 125669 125883 "RTN","C0CXPAT0",32,0) 125884 ;;>>>D PUSH^C0CXPATH("GXML","<SECOND>") 125885 "RTN","C0CXPAT0",33,0) 125886 ;;>>>D PUSH^C0CXPATH("GXML","<THIRD>") 125887 "RTN","C0CXPAT0",34,0) 125888 ;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>") 125889 "RTN","C0CXPAT0",35,0) 125890 ;;>>>D PUSH^C0CXPATH("GXML","<FIFTH>") 125891 "RTN","C0CXPAT0",36,0) 125892 ;;>>>D PUSH^C0CXPATH("GXML","@@DATA2@@") 125893 "RTN","C0CXPAT0",37,0) 125894 ;;>>>D PUSH^C0CXPATH("GXML","</FIFTH>") 125895 "RTN","C0CXPAT0",38,0) 125896 ;;>>>D PUSH^C0CXPATH("GXML","<SIXTH ID=""SELF"" />") 125897 "RTN","C0CXPAT0",39,0) 125898 ;;>>>D PUSH^C0CXPATH("GXML","</THIRD>") 125899 "RTN","C0CXPAT0",40,0) 125900 ;;>>>D PUSH^C0CXPATH("GXML","<SECOND>") 125901 "RTN","C0CXPAT0",41,0) 125902 ;;>>>D PUSH^C0CXPATH("GXML","</SECOND>") 125903 "RTN","C0CXPAT0",42,0) 125904 ;;>>>D PUSH^C0CXPATH("GXML","</SECOND>") 125905 "RTN","C0CXPAT0",43,0) 125906 ;;>>>D PUSH^C0CXPATH("GXML","</FIRST>") 125907 "RTN","C0CXPAT0",44,0) 125908 ;;><INITXML2> 125909 "RTN","C0CXPAT0",45,0) 125670 125910 ;;>>>K GXML S GXML="" 125671 "RTN","C0CXPAT0", 33,0)125911 "RTN","C0CXPAT0",46,0) 125672 125912 ;;>>>D PUSH^C0CXPATH("GXML","<FIRST>") 125673 "RTN","C0CXPAT0", 34,0)125913 "RTN","C0CXPAT0",47,0) 125674 125914 ;;>>>D PUSH^C0CXPATH("GXML","<SECOND>") 125675 "RTN","C0CXPAT0", 35,0)125915 "RTN","C0CXPAT0",48,0) 125676 125916 ;;>>>D PUSH^C0CXPATH("GXML","<THIRD>") 125677 "RTN","C0CXPAT0",36,0) 125678 ;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>") 125679 "RTN","C0CXPAT0",37,0) 125680 ;;>>>D PUSH^C0CXPATH("GXML","<FIFTH>") 125681 "RTN","C0CXPAT0",38,0) 125682 ;;>>>D PUSH^C0CXPATH("GXML","@@DATA2@@") 125683 "RTN","C0CXPAT0",39,0) 125684 ;;>>>D PUSH^C0CXPATH("GXML","</FIFTH>") 125685 "RTN","C0CXPAT0",40,0) 125686 ;;>>>D PUSH^C0CXPATH("GXML","<SIXTH ID=""SELF"" />") 125687 "RTN","C0CXPAT0",41,0) 125917 "RTN","C0CXPAT0",49,0) 125918 ;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>DATA1</FOURTH>") 125919 "RTN","C0CXPAT0",50,0) 125920 ;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>") 125921 "RTN","C0CXPAT0",51,0) 125922 ;;>>>D PUSH^C0CXPATH("GXML","DATA2") 125923 "RTN","C0CXPAT0",52,0) 125924 ;;>>>D PUSH^C0CXPATH("GXML","</FOURTH>") 125925 "RTN","C0CXPAT0",53,0) 125688 125926 ;;>>>D PUSH^C0CXPATH("GXML","</THIRD>") 125689 "RTN","C0CXPAT0",42,0) 125690 ;;>>>D PUSH^C0CXPATH("GXML","<SECOND>") 125691 "RTN","C0CXPAT0",43,0) 125927 "RTN","C0CXPAT0",54,0) 125928 ;;>>>D PUSH^C0CXPATH("GXML","<_SECOND>") 125929 "RTN","C0CXPAT0",55,0) 125930 ;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>DATA3</FOURTH>") 125931 "RTN","C0CXPAT0",56,0) 125932 ;;>>>D PUSH^C0CXPATH("GXML","</_SECOND>") 125933 "RTN","C0CXPAT0",57,0) 125692 125934 ;;>>>D PUSH^C0CXPATH("GXML","</SECOND>") 125693 "RTN","C0CXPAT0",44,0) 125694 ;;>>>D PUSH^C0CXPATH("GXML","</SECOND>") 125695 "RTN","C0CXPAT0",45,0) 125935 "RTN","C0CXPAT0",58,0) 125696 125936 ;;>>>D PUSH^C0CXPATH("GXML","</FIRST>") 125697 "RTN","C0CXPAT0",46,0)125698 ;;><INITXML2>125699 "RTN","C0CXPAT0",47,0)125700 ;;>>>K GXML S GXML=""125701 "RTN","C0CXPAT0",48,0)125702 ;;>>>D PUSH^C0CXPATH("GXML","<FIRST>")125703 "RTN","C0CXPAT0",49,0)125704 ;;>>>D PUSH^C0CXPATH("GXML","<SECOND>")125705 "RTN","C0CXPAT0",50,0)125706 ;;>>>D PUSH^C0CXPATH("GXML","<THIRD>")125707 "RTN","C0CXPAT0",51,0)125708 ;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>DATA1</FOURTH>")125709 "RTN","C0CXPAT0",52,0)125710 ;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>")125711 "RTN","C0CXPAT0",53,0)125712 ;;>>>D PUSH^C0CXPATH("GXML","DATA2")125713 "RTN","C0CXPAT0",54,0)125714 ;;>>>D PUSH^C0CXPATH("GXML","</FOURTH>")125715 "RTN","C0CXPAT0",55,0)125716 ;;>>>D PUSH^C0CXPATH("GXML","</THIRD>")125717 "RTN","C0CXPAT0",56,0)125718 ;;>>>D PUSH^C0CXPATH("GXML","<_SECOND>")125719 "RTN","C0CXPAT0",57,0)125720 ;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>DATA3</FOURTH>")125721 "RTN","C0CXPAT0",58,0)125722 ;;>>>D PUSH^C0CXPATH("GXML","</_SECOND>")125723 125937 "RTN","C0CXPAT0",59,0) 125724 ;;> >>D PUSH^C0CXPATH("GXML","</SECOND>")125938 ;;><PUSHPOP> 125725 125939 "RTN","C0CXPAT0",60,0) 125726 ;;>>>D PUSH^C0CXPATH("GXML","</FIRST>")125940 ;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0") 125727 125941 "RTN","C0CXPAT0",61,0) 125728 ;;> <PUSHPOP>125942 ;;>>>D ZTEST^C0CUNIT(.ZTMP,"INIT") 125729 125943 "RTN","C0CXPAT0",62,0) 125944 ;;>>?C0C(C0C(0))="FOURTH" 125945 "RTN","C0CXPAT0",63,0) 125946 ;;>>>D POP^C0CXPATH("C0C",.GX) 125947 "RTN","C0CXPAT0",64,0) 125948 ;;>>?GX="FOURTH" 125949 "RTN","C0CXPAT0",65,0) 125950 ;;>>?C0C(C0C(0))="THIRD" 125951 "RTN","C0CXPAT0",66,0) 125952 ;;>>>D POP^C0CXPATH("C0C",.GX) 125953 "RTN","C0CXPAT0",67,0) 125954 ;;>>?GX="THIRD" 125955 "RTN","C0CXPAT0",68,0) 125956 ;;>>?C0C(C0C(0))="SECOND" 125957 "RTN","C0CXPAT0",69,0) 125958 ;;><MKMDX> 125959 "RTN","C0CXPAT0",70,0) 125730 125960 ;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0") 125731 "RTN","C0CXPAT0", 63,0)125961 "RTN","C0CXPAT0",71,0) 125732 125962 ;;>>>D ZTEST^C0CUNIT(.ZTMP,"INIT") 125733 "RTN","C0CXPAT0",64,0)125734 ;;>>?C0C(C0C(0))="FOURTH"125735 "RTN","C0CXPAT0",65,0)125736 ;;>>>D POP^C0CXPATH("C0C",.GX)125737 "RTN","C0CXPAT0",66,0)125738 ;;>>?GX="FOURTH"125739 "RTN","C0CXPAT0",67,0)125740 ;;>>?C0C(C0C(0))="THIRD"125741 "RTN","C0CXPAT0",68,0)125742 ;;>>>D POP^C0CXPATH("C0C",.GX)125743 "RTN","C0CXPAT0",69,0)125744 ;;>>?GX="THIRD"125745 "RTN","C0CXPAT0",70,0)125746 ;;>>?C0C(C0C(0))="SECOND"125747 "RTN","C0CXPAT0",71,0)125748 ;;><MKMDX>125749 125963 "RTN","C0CXPAT0",72,0) 125964 ;;>>>S GX="" 125965 "RTN","C0CXPAT0",73,0) 125966 ;;>>>D MKMDX^C0CXPATH("C0C",.GX) 125967 "RTN","C0CXPAT0",74,0) 125968 ;;>>?GX="//FIRST/SECOND/THIRD/FOURTH" 125969 "RTN","C0CXPAT0",75,0) 125970 ;;><XNAME> 125971 "RTN","C0CXPAT0",76,0) 125972 ;;>>?$$XNAME^C0CXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH" 125973 "RTN","C0CXPAT0",77,0) 125974 ;;>>?$$XNAME^C0CXPATH("<SIXTH ID=""SELF"" />")="SIXTH" 125975 "RTN","C0CXPAT0",78,0) 125976 ;;>>?$$XNAME^C0CXPATH("</THIRD>")="THIRD" 125977 "RTN","C0CXPAT0",79,0) 125978 ;;><INDEX> 125979 "RTN","C0CXPAT0",80,0) 125750 125980 ;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0") 125751 "RTN","C0CXPAT0",73,0)125752 ;;>>>D ZTEST^C0CUNIT(.ZTMP,"INIT")125753 "RTN","C0CXPAT0",74,0)125754 ;;>>>S GX=""125755 "RTN","C0CXPAT0",75,0)125756 ;;>>>D MKMDX^C0CXPATH("C0C",.GX)125757 "RTN","C0CXPAT0",76,0)125758 ;;>>?GX="//FIRST/SECOND/THIRD/FOURTH"125759 "RTN","C0CXPAT0",77,0)125760 ;;><XNAME>125761 "RTN","C0CXPAT0",78,0)125762 ;;>>?$$XNAME^C0CXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH"125763 "RTN","C0CXPAT0",79,0)125764 ;;>>?$$XNAME^C0CXPATH("<SIXTH ID=""SELF"" />")="SIXTH"125765 "RTN","C0CXPAT0",80,0)125766 ;;>>?$$XNAME^C0CXPATH("</THIRD>")="THIRD"125767 125981 "RTN","C0CXPAT0",81,0) 125768 ;;> <INDEX>125982 ;;>>>D ZTEST^C0CUNIT(.ZTMP,"INITXML") 125769 125983 "RTN","C0CXPAT0",82,0) 125770 ;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")125984 ;;>>>D INDEX^C0CXPATH("GXML") 125771 125985 "RTN","C0CXPAT0",83,0) 125772 ;;>> >D ZTEST^C0CUNIT(.ZTMP,"INITXML")125986 ;;>>?GXML("//FIRST/SECOND")="2^12" 125773 125987 "RTN","C0CXPAT0",84,0) 125988 ;;>>?GXML("//FIRST/SECOND/THIRD")="3^9" 125989 "RTN","C0CXPAT0",85,0) 125990 ;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7" 125991 "RTN","C0CXPAT0",86,0) 125992 ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4^@@DATA1@@" 125993 "RTN","C0CXPAT0",87,0) 125994 ;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8^" 125995 "RTN","C0CXPAT0",88,0) 125996 ;;>>?GXML("//FIRST/SECOND")="2^12" 125997 "RTN","C0CXPAT0",89,0) 125998 ;;>>?GXML("//FIRST")="1^13" 125999 "RTN","C0CXPAT0",90,0) 126000 ;;><INDEX2> 126001 "RTN","C0CXPAT0",91,0) 126002 ;;>>>D ZTEST^C0CXPATH("INITXML2") 126003 "RTN","C0CXPAT0",92,0) 125774 126004 ;;>>>D INDEX^C0CXPATH("GXML") 125775 "RTN","C0CXPAT0", 85,0)126005 "RTN","C0CXPAT0",93,0) 125776 126006 ;;>>?GXML("//FIRST/SECOND")="2^12" 125777 "RTN","C0CXPAT0",86,0) 125778 ;;>>?GXML("//FIRST/SECOND/THIRD")="3^9" 125779 "RTN","C0CXPAT0",87,0) 125780 ;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7" 125781 "RTN","C0CXPAT0",88,0) 125782 ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4^@@DATA1@@" 125783 "RTN","C0CXPAT0",89,0) 125784 ;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8^" 125785 "RTN","C0CXPAT0",90,0) 125786 ;;>>?GXML("//FIRST/SECOND")="2^12" 125787 "RTN","C0CXPAT0",91,0) 126007 "RTN","C0CXPAT0",94,0) 126008 ;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11" 126009 "RTN","C0CXPAT0",95,0) 126010 ;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10^DATA3" 126011 "RTN","C0CXPAT0",96,0) 126012 ;;>>?GXML("//FIRST/SECOND/THIRD")="3^8" 126013 "RTN","C0CXPAT0",97,0) 126014 ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH[1]")="4^4^DATA1" 126015 "RTN","C0CXPAT0",98,0) 125788 126016 ;;>>?GXML("//FIRST")="1^13" 125789 "RTN","C0CXPAT0",92,0)125790 ;;><INDEX2>125791 "RTN","C0CXPAT0",93,0)125792 ;;>>>D ZTEST^C0CXPATH("INITXML2")125793 "RTN","C0CXPAT0",94,0)125794 ;;>>>D INDEX^C0CXPATH("GXML")125795 "RTN","C0CXPAT0",95,0)125796 ;;>>?GXML("//FIRST/SECOND")="2^12"125797 "RTN","C0CXPAT0",96,0)125798 ;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11"125799 "RTN","C0CXPAT0",97,0)125800 ;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10^DATA3"125801 "RTN","C0CXPAT0",98,0)125802 ;;>>?GXML("//FIRST/SECOND/THIRD")="3^8"125803 126017 "RTN","C0CXPAT0",99,0) 125804 ;;> >?GXML("//FIRST/SECOND/THIRD/FOURTH[1]")="4^4^DATA1"126018 ;;><MISSING> 125805 126019 "RTN","C0CXPAT0",100,0) 125806 ;;>> ?GXML("//FIRST")="1^13"126020 ;;>>>D ZTEST^C0CXPATH("INITXML") 125807 126021 "RTN","C0CXPAT0",101,0) 125808 ;;> <MISSING>126022 ;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")" 125809 126023 "RTN","C0CXPAT0",102,0) 126024 ;;>>>D MISSING^C0CXPATH("GXML",OUTARY) 126025 "RTN","C0CXPAT0",103,0) 126026 ;;>>?@OUTARY@(1)="DATA1" 126027 "RTN","C0CXPAT0",104,0) 126028 ;;>>?@OUTARY@(2)="DATA2" 126029 "RTN","C0CXPAT0",105,0) 126030 ;;><MAP> 126031 "RTN","C0CXPAT0",106,0) 125810 126032 ;;>>>D ZTEST^C0CXPATH("INITXML") 125811 "RTN","C0CXPAT0",103,0)125812 ;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")"125813 "RTN","C0CXPAT0",104,0)125814 ;;>>>D MISSING^C0CXPATH("GXML",OUTARY)125815 "RTN","C0CXPAT0",105,0)125816 ;;>>?@OUTARY@(1)="DATA1"125817 "RTN","C0CXPAT0",106,0)125818 ;;>>?@OUTARY@(2)="DATA2"125819 126033 "RTN","C0CXPAT0",107,0) 125820 ;;> <MAP>126034 ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")" 125821 126035 "RTN","C0CXPAT0",108,0) 126036 ;;>>>S OUTARY="^TMP($J,""MAPTEST"")" 126037 "RTN","C0CXPAT0",109,0) 126038 ;;>>>S @MAPARY@("DATA2")="VALUE2" 126039 "RTN","C0CXPAT0",110,0) 126040 ;;>>>D MAP^C0CXPATH("GXML",MAPARY,OUTARY) 126041 "RTN","C0CXPAT0",111,0) 126042 ;;>>?@OUTARY@(6)="VALUE2" 126043 "RTN","C0CXPAT0",112,0) 126044 ;;><MAP2> 126045 "RTN","C0CXPAT0",113,0) 125822 126046 ;;>>>D ZTEST^C0CXPATH("INITXML") 125823 "RTN","C0CXPAT0",1 09,0)126047 "RTN","C0CXPAT0",114,0) 125824 126048 ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")" 125825 "RTN","C0CXPAT0",11 0,0)126049 "RTN","C0CXPAT0",115,0) 125826 126050 ;;>>>S OUTARY="^TMP($J,""MAPTEST"")" 125827 "RTN","C0CXPAT0",111,0) 126051 "RTN","C0CXPAT0",116,0) 126052 ;;>>>S @MAPARY@("DATA1")="VALUE1" 126053 "RTN","C0CXPAT0",117,0) 125828 126054 ;;>>>S @MAPARY@("DATA2")="VALUE2" 125829 "RTN","C0CXPAT0",112,0) 126055 "RTN","C0CXPAT0",118,0) 126056 ;;>>>S @MAPARY@("DATA3")="VALUE3" 126057 "RTN","C0CXPAT0",119,0) 126058 ;;>>>S GXML(4)="<FOURTH>@@DATA1@@ AND @@DATA3@@</FOURTH>" 126059 "RTN","C0CXPAT0",120,0) 125830 126060 ;;>>>D MAP^C0CXPATH("GXML",MAPARY,OUTARY) 125831 "RTN","C0CXPAT0",113,0) 125832 ;;>>?@OUTARY@(6)="VALUE2" 125833 "RTN","C0CXPAT0",114,0) 125834 ;;><MAP2> 125835 "RTN","C0CXPAT0",115,0) 126061 "RTN","C0CXPAT0",121,0) 126062 ;;>>>D PARY^C0CXPATH(OUTARY) 126063 "RTN","C0CXPAT0",122,0) 126064 ;;>>?@OUTARY@(4)="<FOURTH>VALUE1 AND VALUE3</FOURTH>" 126065 "RTN","C0CXPAT0",123,0) 126066 ;;><QUEUE> 126067 "RTN","C0CXPAT0",124,0) 126068 ;;>>>D QUEUE^C0CXPATH("BTLIST","GXML",2,3) 126069 "RTN","C0CXPAT0",125,0) 126070 ;;>>>D QUEUE^C0CXPATH("BTLIST","GXML",4,5) 126071 "RTN","C0CXPAT0",126,0) 126072 ;;>>?$P(BTLIST(2),";",2)=4 126073 "RTN","C0CXPAT0",127,0) 126074 ;;><BUILD> 126075 "RTN","C0CXPAT0",128,0) 125836 126076 ;;>>>D ZTEST^C0CXPATH("INITXML") 125837 "RTN","C0CXPAT0",116,0)125838 ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"125839 "RTN","C0CXPAT0",117,0)125840 ;;>>>S OUTARY="^TMP($J,""MAPTEST"")"125841 "RTN","C0CXPAT0",118,0)125842 ;;>>>S @MAPARY@("DATA1")="VALUE1"125843 "RTN","C0CXPAT0",119,0)125844 ;;>>>S @MAPARY@("DATA2")="VALUE2"125845 "RTN","C0CXPAT0",120,0)125846 ;;>>>S @MAPARY@("DATA3")="VALUE3"125847 "RTN","C0CXPAT0",121,0)125848 ;;>>>S GXML(4)="<FOURTH>@@DATA1@@ AND @@DATA3@@</FOURTH>"125849 "RTN","C0CXPAT0",122,0)125850 ;;>>>D MAP^C0CXPATH("GXML",MAPARY,OUTARY)125851 "RTN","C0CXPAT0",123,0)125852 ;;>>>D PARY^C0CXPATH(OUTARY)125853 "RTN","C0CXPAT0",124,0)125854 ;;>>?@OUTARY@(4)="<FOURTH>VALUE1 AND VALUE3</FOURTH>"125855 "RTN","C0CXPAT0",125,0)125856 ;;><QUEUE>125857 "RTN","C0CXPAT0",126,0)125858 ;;>>>D QUEUE^C0CXPATH("BTLIST","GXML",2,3)125859 "RTN","C0CXPAT0",127,0)125860 ;;>>>D QUEUE^C0CXPATH("BTLIST","GXML",4,5)125861 "RTN","C0CXPAT0",128,0)125862 ;;>>?$P(BTLIST(2),";",2)=4125863 126077 "RTN","C0CXPAT0",129,0) 125864 ;;> <BUILD>126078 ;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2") 125865 126079 "RTN","C0CXPAT0",130,0) 126080 ;;>>>D ZTEST^C0CXPATH("QUEUE") 126081 "RTN","C0CXPAT0",131,0) 126082 ;;>>>D BUILD^C0CXPATH("BTLIST","G3") 126083 "RTN","C0CXPAT0",132,0) 126084 ;;><CP> 126085 "RTN","C0CXPAT0",133,0) 125866 126086 ;;>>>D ZTEST^C0CXPATH("INITXML") 125867 "RTN","C0CXPAT0",131,0)125868 ;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2")125869 "RTN","C0CXPAT0",132,0)125870 ;;>>>D ZTEST^C0CXPATH("QUEUE")125871 "RTN","C0CXPAT0",133,0)125872 ;;>>>D BUILD^C0CXPATH("BTLIST","G3")125873 126087 "RTN","C0CXPAT0",134,0) 125874 ;;> <CP>126088 ;;>>>D CP^C0CXPATH("GXML","G2") 125875 126089 "RTN","C0CXPAT0",135,0) 126090 ;;>>?G2(0)=13 126091 "RTN","C0CXPAT0",136,0) 126092 ;;><QOPEN> 126093 "RTN","C0CXPAT0",137,0) 126094 ;;>>>K G2,GBL 126095 "RTN","C0CXPAT0",138,0) 125876 126096 ;;>>>D ZTEST^C0CXPATH("INITXML") 125877 "RTN","C0CXPAT0",136,0)125878 ;;>>>D CP^C0CXPATH("GXML","G2")125879 "RTN","C0CXPAT0",137,0)125880 ;;>>?G2(0)=13125881 "RTN","C0CXPAT0",138,0)125882 ;;><QOPEN>125883 126097 "RTN","C0CXPAT0",139,0) 126098 ;;>>>D QOPEN^C0CXPATH("GBL","GXML") 126099 "RTN","C0CXPAT0",140,0) 126100 ;;>>?$P(GBL(1),";",3)=12 126101 "RTN","C0CXPAT0",141,0) 126102 ;;>>>D BUILD^C0CXPATH("GBL","G2") 126103 "RTN","C0CXPAT0",142,0) 126104 ;;>>?G2(G2(0))="</SECOND>" 126105 "RTN","C0CXPAT0",143,0) 126106 ;;><QOPEN2> 126107 "RTN","C0CXPAT0",144,0) 125884 126108 ;;>>>K G2,GBL 125885 "RTN","C0CXPAT0",14 0,0)126109 "RTN","C0CXPAT0",145,0) 125886 126110 ;;>>>D ZTEST^C0CXPATH("INITXML") 125887 "RTN","C0CXPAT0",14 1,0)125888 ;;>>>D QOPEN^C0CXPATH("GBL","GXML" )125889 "RTN","C0CXPAT0",14 2,0)125890 ;;>>?$P(GBL(1),";",3)=1 2125891 "RTN","C0CXPAT0",14 3,0)126111 "RTN","C0CXPAT0",146,0) 126112 ;;>>>D QOPEN^C0CXPATH("GBL","GXML","//FIRST/SECOND") 126113 "RTN","C0CXPAT0",147,0) 126114 ;;>>?$P(GBL(1),";",3)=11 126115 "RTN","C0CXPAT0",148,0) 125892 126116 ;;>>>D BUILD^C0CXPATH("GBL","G2") 125893 "RTN","C0CXPAT0",14 4,0)126117 "RTN","C0CXPAT0",149,0) 125894 126118 ;;>>?G2(G2(0))="</SECOND>" 125895 "RTN","C0CXPAT0",1 45,0)125896 ;;><Q OPEN2>125897 "RTN","C0CXPAT0",1 46,0)126119 "RTN","C0CXPAT0",150,0) 126120 ;;><QCLOSE> 126121 "RTN","C0CXPAT0",151,0) 125898 126122 ;;>>>K G2,GBL 125899 "RTN","C0CXPAT0",1 47,0)126123 "RTN","C0CXPAT0",152,0) 125900 126124 ;;>>>D ZTEST^C0CXPATH("INITXML") 125901 "RTN","C0CXPAT0",1 48,0)125902 ;;>>>D Q OPEN^C0CXPATH("GBL","GXML","//FIRST/SECOND")125903 "RTN","C0CXPAT0",1 49,0)125904 ;;>>?$P(GBL(1),";",3)=1 1125905 "RTN","C0CXPAT0",15 0,0)126125 "RTN","C0CXPAT0",153,0) 126126 ;;>>>D QCLOSE^C0CXPATH("GBL","GXML") 126127 "RTN","C0CXPAT0",154,0) 126128 ;;>>?$P(GBL(1),";",3)=13 126129 "RTN","C0CXPAT0",155,0) 125906 126130 ;;>>>D BUILD^C0CXPATH("GBL","G2") 125907 "RTN","C0CXPAT0",15 1,0)125908 ;;>>?G2(G2(0))="</ SECOND>"125909 "RTN","C0CXPAT0",15 2,0)125910 ;;><QCLOSE >125911 "RTN","C0CXPAT0",15 3,0)126131 "RTN","C0CXPAT0",156,0) 126132 ;;>>?G2(G2(0))="</FIRST>" 126133 "RTN","C0CXPAT0",157,0) 126134 ;;><QCLOSE2> 126135 "RTN","C0CXPAT0",158,0) 125912 126136 ;;>>>K G2,GBL 125913 "RTN","C0CXPAT0",15 4,0)126137 "RTN","C0CXPAT0",159,0) 125914 126138 ;;>>>D ZTEST^C0CXPATH("INITXML") 125915 "RTN","C0CXPAT0",1 55,0)125916 ;;>>>D QCLOSE^C0CXPATH("GBL","GXML" )125917 "RTN","C0CXPAT0",1 56,0)126139 "RTN","C0CXPAT0",160,0) 126140 ;;>>>D QCLOSE^C0CXPATH("GBL","GXML","//FIRST/SECOND/THIRD") 126141 "RTN","C0CXPAT0",161,0) 125918 126142 ;;>>?$P(GBL(1),";",3)=13 125919 "RTN","C0CXPAT0",1 57,0)126143 "RTN","C0CXPAT0",162,0) 125920 126144 ;;>>>D BUILD^C0CXPATH("GBL","G2") 125921 "RTN","C0CXPAT0",1 58,0)126145 "RTN","C0CXPAT0",163,0) 125922 126146 ;;>>?G2(G2(0))="</FIRST>" 125923 "RTN","C0CXPAT0",159,0) 125924 ;;><QCLOSE2> 125925 "RTN","C0CXPAT0",160,0) 125926 ;;>>>K G2,GBL 125927 "RTN","C0CXPAT0",161,0) 126147 "RTN","C0CXPAT0",164,0) 126148 ;;>>?G2(1)="</THIRD>" 126149 "RTN","C0CXPAT0",165,0) 126150 ;;><INSERT> 126151 "RTN","C0CXPAT0",166,0) 126152 ;;>>>K G2,GBL,G3,G4 126153 "RTN","C0CXPAT0",167,0) 125928 126154 ;;>>>D ZTEST^C0CXPATH("INITXML") 125929 "RTN","C0CXPAT0",162,0)125930 ;;>>>D QCLOSE^C0CXPATH("GBL","GXML","//FIRST/SECOND/THIRD")125931 "RTN","C0CXPAT0",163,0)125932 ;;>>?$P(GBL(1),";",3)=13125933 "RTN","C0CXPAT0",164,0)125934 ;;>>>D BUILD^C0CXPATH("GBL","G2")125935 "RTN","C0CXPAT0",165,0)125936 ;;>>?G2(G2(0))="</FIRST>"125937 "RTN","C0CXPAT0",166,0)125938 ;;>>?G2(1)="</THIRD>"125939 "RTN","C0CXPAT0",167,0)125940 ;;><INSERT>125941 126155 "RTN","C0CXPAT0",168,0) 125942 ;;>>> K G2,GBL,G3,G4126156 ;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2") 125943 126157 "RTN","C0CXPAT0",169,0) 126158 ;;>>>D INSERT^C0CXPATH("GXML","G2","//FIRST/SECOND/THIRD") 126159 "RTN","C0CXPAT0",170,0) 126160 ;;>>>D INSERT^C0CXPATH("G3","G2","//") 126161 "RTN","C0CXPAT0",171,0) 126162 ;;>>?G2(1)=GXML(9) 126163 "RTN","C0CXPAT0",172,0) 126164 ;;><REPLACE> 126165 "RTN","C0CXPAT0",173,0) 126166 ;;>>>K G2,GBL,G3 126167 "RTN","C0CXPAT0",174,0) 125944 126168 ;;>>>D ZTEST^C0CXPATH("INITXML") 125945 "RTN","C0CXPAT0",17 0,0)126169 "RTN","C0CXPAT0",175,0) 125946 126170 ;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2") 125947 "RTN","C0CXPAT0",171,0)125948 ;;>>>D INSERT^C0CXPATH("GXML","G2","//FIRST/SECOND/THIRD")125949 "RTN","C0CXPAT0",172,0)125950 ;;>>>D INSERT^C0CXPATH("G3","G2","//")125951 "RTN","C0CXPAT0",173,0)125952 ;;>>?G2(1)=GXML(9)125953 "RTN","C0CXPAT0",174,0)125954 ;;><REPLACE>125955 "RTN","C0CXPAT0",175,0)125956 ;;>>>K G2,GBL,G3125957 126171 "RTN","C0CXPAT0",176,0) 126172 ;;>>>D REPLACE^C0CXPATH("GXML","G2","//FIRST/SECOND") 126173 "RTN","C0CXPAT0",177,0) 126174 ;;>>?GXML(2)="<FIFTH>" 126175 "RTN","C0CXPAT0",178,0) 126176 ;;><INSINNER> 126177 "RTN","C0CXPAT0",179,0) 126178 ;;>>>K GXML,G2,GBL,G3 126179 "RTN","C0CXPAT0",180,0) 125958 126180 ;;>>>D ZTEST^C0CXPATH("INITXML") 125959 "RTN","C0CXPAT0",177,0)125960 ;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")125961 "RTN","C0CXPAT0",178,0)125962 ;;>>>D REPLACE^C0CXPATH("GXML","G2","//FIRST/SECOND")125963 "RTN","C0CXPAT0",179,0)125964 ;;>>?GXML(2)="<FIFTH>"125965 "RTN","C0CXPAT0",180,0)125966 ;;><INSINNER>125967 126181 "RTN","C0CXPAT0",181,0) 126182 ;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD","G2") 126183 "RTN","C0CXPAT0",182,0) 126184 ;;>>>D INSINNER^C0CXPATH("GXML","G2","//FIRST/SECOND/THIRD") 126185 "RTN","C0CXPAT0",183,0) 126186 ;;>>?GXML(10)="<FIFTH>" 126187 "RTN","C0CXPAT0",184,0) 126188 ;;><INSINNER2> 126189 "RTN","C0CXPAT0",185,0) 125968 126190 ;;>>>K GXML,G2,GBL,G3 125969 "RTN","C0CXPAT0",18 2,0)126191 "RTN","C0CXPAT0",186,0) 125970 126192 ;;>>>D ZTEST^C0CXPATH("INITXML") 125971 "RTN","C0CXPAT0",18 3,0)126193 "RTN","C0CXPAT0",187,0) 125972 126194 ;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD","G2") 125973 "RTN","C0CXPAT0",184,0)125974 ;;>>>D INSINNER^C0CXPATH("GXML","G2","//FIRST/SECOND/THIRD")125975 "RTN","C0CXPAT0",185,0)125976 ;;>>?GXML(10)="<FIFTH>"125977 "RTN","C0CXPAT0",186,0)125978 ;;><INSINNER2>125979 "RTN","C0CXPAT0",187,0)125980 ;;>>>K GXML,G2,GBL,G3125981 126195 "RTN","C0CXPAT0",188,0) 125982 ;;>>>D ZTEST^C0CXPATH("INITXML")126196 ;;>>>D INSINNER^C0CXPATH("G2","G2") 125983 126197 "RTN","C0CXPAT0",189,0) 125984 ;;>> >D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD","G2")126198 ;;>>?G2(8)="<FIFTH>" 125985 126199 "RTN","C0CXPAT0",190,0) 125986 ;;> >>D INSINNER^C0CXPATH("G2","G2")126200 ;;><PUSHA> 125987 126201 "RTN","C0CXPAT0",191,0) 125988 ;;>> ?G2(8)="<FIFTH>"126202 ;;>>>K GTMP,GTMP2 125989 126203 "RTN","C0CXPAT0",192,0) 125990 ;;> <PUSHA>126204 ;;>>>N GTMP,GTMP2 125991 126205 "RTN","C0CXPAT0",193,0) 126206 ;;>>>D PUSH^C0CXPATH("GTMP","A") 126207 "RTN","C0CXPAT0",194,0) 126208 ;;>>>D PUSH^C0CXPATH("GTMP2","B") 126209 "RTN","C0CXPAT0",195,0) 126210 ;;>>>D PUSH^C0CXPATH("GTMP2","C") 126211 "RTN","C0CXPAT0",196,0) 126212 ;;>>>D PUSHA^C0CXPATH("GTMP","GTMP2") 126213 "RTN","C0CXPAT0",197,0) 126214 ;;>>?GTMP(3)="C" 126215 "RTN","C0CXPAT0",198,0) 126216 ;;>>?GTMP(0)=3 126217 "RTN","C0CXPAT0",199,0) 126218 ;;><H2ARY> 126219 "RTN","C0CXPAT0",200,0) 125992 126220 ;;>>>K GTMP,GTMP2 125993 "RTN","C0CXPAT0",194,0)125994 ;;>>>N GTMP,GTMP2125995 "RTN","C0CXPAT0",195,0)125996 ;;>>>D PUSH^C0CXPATH("GTMP","A")125997 "RTN","C0CXPAT0",196,0)125998 ;;>>>D PUSH^C0CXPATH("GTMP2","B")125999 "RTN","C0CXPAT0",197,0)126000 ;;>>>D PUSH^C0CXPATH("GTMP2","C")126001 "RTN","C0CXPAT0",198,0)126002 ;;>>>D PUSHA^C0CXPATH("GTMP","GTMP2")126003 "RTN","C0CXPAT0",199,0)126004 ;;>>?GTMP(3)="C"126005 "RTN","C0CXPAT0",200,0)126006 ;;>>?GTMP(0)=3126007 126221 "RTN","C0CXPAT0",201,0) 126008 ;;> <H2ARY>126222 ;;>>>S GTMP("TEST1")=1 126009 126223 "RTN","C0CXPAT0",202,0) 126224 ;;>>>D H2ARY^C0CXPATH("GTMP2","GTMP") 126225 "RTN","C0CXPAT0",203,0) 126226 ;;>>?GTMP2(0)=1 126227 "RTN","C0CXPAT0",204,0) 126228 ;;>>?GTMP2(1)="^TEST1^1" 126229 "RTN","C0CXPAT0",205,0) 126230 ;;><XVARS> 126231 "RTN","C0CXPAT0",206,0) 126010 126232 ;;>>>K GTMP,GTMP2 126011 "RTN","C0CXPAT0",203,0)126012 ;;>>>S GTMP("TEST1")=1126013 "RTN","C0CXPAT0",204,0)126014 ;;>>>D H2ARY^C0CXPATH("GTMP2","GTMP")126015 "RTN","C0CXPAT0",205,0)126016 ;;>>?GTMP2(0)=1126017 "RTN","C0CXPAT0",206,0)126018 ;;>>?GTMP2(1)="^TEST1^1"126019 126233 "RTN","C0CXPAT0",207,0) 126020 ;;> <XVARS>126234 ;;>>>D PUSH^C0CXPATH("GTMP","<VALUE>@@VAR1@@</VALUE>") 126021 126235 "RTN","C0CXPAT0",208,0) 126022 ;;>>> K GTMP,GTMP2126236 ;;>>>D XVARS^C0CXPATH("GTMP2","GTMP") 126023 126237 "RTN","C0CXPAT0",209,0) 126024 ;;>> >D PUSH^C0CXPATH("GTMP","<VALUE>@@VAR1@@</VALUE>")126238 ;;>>?GTMP2(1)="^VAR1^1" 126025 126239 "RTN","C0CXPAT0",210,0) 126026 ;;>>>D XVARS^C0CXPATH("GTMP2","GTMP")126027 "RTN","C0CXPAT0",211,0)126028 ;;>>?GTMP2(1)="^VAR1^1"126029 "RTN","C0CXPAT0",212,0)126030 126240 ;;></TEST> 126031 126241 "RTN","C0CXPATH") 126032 0^34^B5 21207435126242 0^34^B518646177 126033 126243 "RTN","C0CXPATH",1,0) 126034 126244 C0CXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08 126035 126245 "RTN","C0CXPATH",2,0) 126036 ;;1.2;C 0C;;May 11, 2012;Build 50126246 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51 126037 126247 "RTN","C0CXPATH",3,0) 126038 ;Copyright 2008 George Lilly. Licensed under the terms of the GNU126248 ;Copyright 2008 George Lilly. 126039 126249 "RTN","C0CXPATH",4,0) 126040 ; General Public License See attached copy of the License.126250 ; 126041 126251 "RTN","C0CXPATH",5,0) 126042 ; 126252 ; This program is free software: you can redistribute it and/or modify 126043 126253 "RTN","C0CXPATH",6,0) 126044 ; This program is free software; you can redistribute it and/or modify126254 ; it under the terms of the GNU Affero General Public License as 126045 126255 "RTN","C0CXPATH",7,0) 126046 ; it under the terms of the GNU General Public License as published by126256 ; published by the Free Software Foundation, either version 3 of the 126047 126257 "RTN","C0CXPATH",8,0) 126048 ; the Free Software Foundation; either version 2 of the License, or126258 ; License, or (at your option) any later version. 126049 126259 "RTN","C0CXPATH",9,0) 126050 ; (at your option) any later version.126260 ; 126051 126261 "RTN","C0CXPATH",10,0) 126052 ; 126262 ; This program is distributed in the hope that it will be useful, 126053 126263 "RTN","C0CXPATH",11,0) 126054 ; This program is distributed in the hope that it will be useful,126264 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 126055 126265 "RTN","C0CXPATH",12,0) 126056 ; but WITHOUT ANY WARRANTY; without even the implied warranty of126266 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 126057 126267 "RTN","C0CXPATH",13,0) 126058 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the126268 ; GNU Affero General Public License for more details. 126059 126269 "RTN","C0CXPATH",14,0) 126060 ; GNU General Public License for more details.126270 ; 126061 126271 "RTN","C0CXPATH",15,0) 126062 ; 126272 ; You should have received a copy of the GNU Affero General Public License 126063 126273 "RTN","C0CXPATH",16,0) 126064 ; You should have received a copy of the GNU General Public License along126274 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 126065 126275 "RTN","C0CXPATH",17,0) 126066 ; with this program; if not, write to the Free Software Foundation, Inc.,126276 ; 126067 126277 "RTN","C0CXPATH",18,0) 126068 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.126278 W "This is an XML XPATH utility library",! 126069 126279 "RTN","C0CXPATH",19,0) 126070 ;126280 W ! 126071 126281 "RTN","C0CXPATH",20,0) 126072 W "This is an XML XPATH utility library",!126282 Q 126073 126283 "RTN","C0CXPATH",21,0) 126074 W !126284 ; 126075 126285 "RTN","C0CXPATH",22,0) 126286 OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE 126287 "RTN","C0CXPATH",23,0) 126288 ; 126289 "RTN","C0CXPATH",24,0) 126290 N Y 126291 "RTN","C0CXPATH",25,0) 126292 S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME) 126293 "RTN","C0CXPATH",26,0) 126294 I Y Q 1_U_"WROTE FILE: "_OUTNAME_" TO "_OUTDIR 126295 "RTN","C0CXPATH",27,0) 126296 I 'Y Q 0_U_"ERROR WRITING FILE"_OUTNAME_" TO "_OUTDIR 126297 "RTN","C0CXPATH",28,0) 126076 126298 Q 126077 "RTN","C0CXPATH",23,0)126078 ;126079 "RTN","C0CXPATH",24,0)126080 OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE126081 "RTN","C0CXPATH",25,0)126082 ;126083 "RTN","C0CXPATH",26,0)126084 N Y126085 "RTN","C0CXPATH",27,0)126086 S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)126087 "RTN","C0CXPATH",28,0)126088 I Y Q 1_U_"WROTE FILE: "_OUTNAME_" TO "_OUTDIR126089 126299 "RTN","C0CXPATH",29,0) 126090 I 'Y Q 0_U_"ERROR WRITING FILE"_OUTNAME_" TO "_OUTDIR126300 ; 126091 126301 "RTN","C0CXPATH",30,0) 126302 PUSH(STK,VAL) ; pushs VAL onto STK and updates STK(0) 126303 "RTN","C0CXPATH",31,0) 126304 ; VAL IS A STRING AND STK IS PASSED BY NAME 126305 "RTN","C0CXPATH",32,0) 126306 ; 126307 "RTN","C0CXPATH",33,0) 126308 I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE 126309 "RTN","C0CXPATH",34,0) 126310 S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH 126311 "RTN","C0CXPATH",35,0) 126312 S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY 126313 "RTN","C0CXPATH",36,0) 126092 126314 Q 126093 "RTN","C0CXPATH",31,0)126094 ;126095 "RTN","C0CXPATH",32,0)126096 PUSH(STK,VAL) ; pushs VAL onto STK and updates STK(0)126097 "RTN","C0CXPATH",33,0)126098 ; VAL IS A STRING AND STK IS PASSED BY NAME126099 "RTN","C0CXPATH",34,0)126100 ;126101 "RTN","C0CXPATH",35,0)126102 I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE126103 "RTN","C0CXPATH",36,0)126104 S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH126105 126315 "RTN","C0CXPATH",37,0) 126106 S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY126316 ; 126107 126317 "RTN","C0CXPATH",38,0) 126318 POP(STK,VAL) ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL 126319 "RTN","C0CXPATH",39,0) 126320 ; VAL AND STK ARE PASSED BY REFERENCE 126321 "RTN","C0CXPATH",40,0) 126322 ; 126323 "RTN","C0CXPATH",41,0) 126324 I @STK@(0)<1 D ; IF ARRAY IS EMPTY 126325 "RTN","C0CXPATH",42,0) 126326 . S VAL="" 126327 "RTN","C0CXPATH",43,0) 126328 . S @STK@(0)=0 126329 "RTN","C0CXPATH",44,0) 126330 I @STK@(0)>0 D ; 126331 "RTN","C0CXPATH",45,0) 126332 . S VAL=@STK@(@STK@(0)) 126333 "RTN","C0CXPATH",46,0) 126334 . K @STK@(@STK@(0)) 126335 "RTN","C0CXPATH",47,0) 126336 . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY 126337 "RTN","C0CXPATH",48,0) 126108 126338 Q 126109 "RTN","C0CXPATH",39,0)126110 ;126111 "RTN","C0CXPATH",40,0)126112 POP(STK,VAL) ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL126113 "RTN","C0CXPATH",41,0)126114 ; VAL AND STK ARE PASSED BY REFERENCE126115 "RTN","C0CXPATH",42,0)126116 ;126117 "RTN","C0CXPATH",43,0)126118 I @STK@(0)<1 D ; IF ARRAY IS EMPTY126119 "RTN","C0CXPATH",44,0)126120 . S VAL=""126121 "RTN","C0CXPATH",45,0)126122 . S @STK@(0)=0126123 "RTN","C0CXPATH",46,0)126124 I @STK@(0)>0 D ;126125 "RTN","C0CXPATH",47,0)126126 . S VAL=@STK@(@STK@(0))126127 "RTN","C0CXPATH",48,0)126128 . K @STK@(@STK@(0))126129 126339 "RTN","C0CXPATH",49,0) 126130 . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY126340 ; 126131 126341 "RTN","C0CXPATH",50,0) 126342 PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME 126343 "RTN","C0CXPATH",51,0) 126344 ; 126345 "RTN","C0CXPATH",52,0) 126346 N ZGI 126347 "RTN","C0CXPATH",53,0) 126348 F ZGI=1:1:@ASRC@(0) D ; FOR ALL OF THE SOURCE ARRAY 126349 "RTN","C0CXPATH",54,0) 126350 . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT 126351 "RTN","C0CXPATH",55,0) 126132 126352 Q 126133 "RTN","C0CXPATH",51,0)126134 ;126135 "RTN","C0CXPATH",52,0)126136 PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME126137 "RTN","C0CXPATH",53,0)126138 ;126139 "RTN","C0CXPATH",54,0)126140 N ZGI126141 "RTN","C0CXPATH",55,0)126142 F ZGI=1:1:@ASRC@(0) D ; FOR ALL OF THE SOURCE ARRAY126143 126353 "RTN","C0CXPATH",56,0) 126144 . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT126354 ; 126145 126355 "RTN","C0CXPATH",57,0) 126356 MKMDX(STK,RTN,INREDUX) ; MAKES A MUMPS INDEX FROM THE ARRAY STK 126357 "RTN","C0CXPATH",58,0) 126358 ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS 126359 "RTN","C0CXPATH",59,0) 126360 ; REDUX IS A STRING TO REMOVE FROM THE RESULT 126361 "RTN","C0CXPATH",60,0) 126362 S RTN="" 126363 "RTN","C0CXPATH",61,0) 126364 N I 126365 "RTN","C0CXPATH",62,0) 126366 ; W "STK= ",STK,! 126367 "RTN","C0CXPATH",63,0) 126368 I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY 126369 "RTN","C0CXPATH",64,0) 126370 . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON 126371 "RTN","C0CXPATH",65,0) 126372 . I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON 126373 "RTN","C0CXPATH",66,0) 126374 . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I) 126375 "RTN","C0CXPATH",67,0) 126376 I $G(INREDUX)'="" S RTN=$P(RTN,INREDUX,1)_$P(RTN,INREDUX,2) 126377 "RTN","C0CXPATH",68,0) 126146 126378 Q 126147 "RTN","C0CXPATH",58,0) 126148 ; 126149 "RTN","C0CXPATH",59,0) 126150 MKMDX(STK,RTN,INREDUX) ; MAKES A MUMPS INDEX FROM THE ARRAY STK 126151 "RTN","C0CXPATH",60,0) 126152 ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS 126153 "RTN","C0CXPATH",61,0) 126154 ; REDUX IS A STRING TO REMOVE FROM THE RESULT 126155 "RTN","C0CXPATH",62,0) 126156 S RTN="" 126157 "RTN","C0CXPATH",63,0) 126379 "RTN","C0CXPATH",69,0) 126380 ; 126381 "RTN","C0CXPATH",70,0) 126382 XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG 126383 "RTN","C0CXPATH",71,0) 126384 ; </NAME> AND <NAME ID=XNAME> WILL RETURN NAME 126385 "RTN","C0CXPATH",72,0) 126386 ; ISTR IS PASSED BY VALUE 126387 "RTN","C0CXPATH",73,0) 126388 N CUR,TMP 126389 "RTN","C0CXPATH",74,0) 126390 I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET 126391 "RTN","C0CXPATH",75,0) 126392 . S TMP=$P(ISTR,"<",2) 126393 "RTN","C0CXPATH",76,0) 126394 I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME> 126395 "RTN","C0CXPATH",77,0) 126396 . S TMP=$P(TMP,"/",2) 126397 "RTN","C0CXPATH",78,0) 126398 S CUR=$P(TMP,">",1) ; EXTRACT THE NAME 126399 "RTN","C0CXPATH",79,0) 126400 ; W "CUR= ",CUR,! 126401 "RTN","C0CXPATH",80,0) 126402 I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST> 126403 "RTN","C0CXPATH",81,0) 126404 . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER 126405 "RTN","C0CXPATH",82,0) 126406 ; W "CUR2= ",CUR,! 126407 "RTN","C0CXPATH",83,0) 126408 Q CUR 126409 "RTN","C0CXPATH",84,0) 126410 ; 126411 "RTN","C0CXPATH",85,0) 126412 XVAL(ISTR) ; EXTRACTS THE VALUE FROM A FRAGMENT OF XML 126413 "RTN","C0CXPATH",86,0) 126414 ; <NAME>VALUE</NAME> WILL RETURN VALUE 126415 "RTN","C0CXPATH",87,0) 126416 N G 126417 "RTN","C0CXPATH",88,0) 126418 S G=$P(ISTR,">",2) ;STRIP OFF <NAME> 126419 "RTN","C0CXPATH",89,0) 126420 Q $P(G,"<",1) ; STRIP OFF </NAME> LEAVING VALUE 126421 "RTN","C0CXPATH",90,0) 126422 ; 126423 "RTN","C0CXPATH",91,0) 126424 VDX2VDV(OUTVDV,INVDX) ; CONVERT AN VDX ARRAY TO VDV 126425 "RTN","C0CXPATH",92,0) 126426 ; VDX: @INVDX@(XPATH)=VALUE 126427 "RTN","C0CXPATH",93,0) 126428 ; VDV: @OUTVDV@(X1X2X3X4)=VALUE 126429 "RTN","C0CXPATH",94,0) 126430 ; THE VDV DATANAMES MIGHT BE MORE CONVENIENT FOR USE IN CODE 126431 "RTN","C0CXPATH",95,0) 126432 ; AN INDEX IS PROVIDED TO GO BACK TO VDX FOR CONVERSIONS 126433 "RTN","C0CXPATH",96,0) 126434 ; @VDV@("XPATH",X1X2X3X4)="XPATH" 126435 "RTN","C0CXPATH",97,0) 126436 N ZA,ZI,ZW 126437 "RTN","C0CXPATH",98,0) 126438 S ZI="" 126439 "RTN","C0CXPATH",99,0) 126440 F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ; 126441 "RTN","C0CXPATH",100,0) 126442 . S ZW=$TR(ZI,"/","") ; ELIMINATE ALL SLASHES - CAMEL CASE VARIABLE NAME 126443 "RTN","C0CXPATH",101,0) 126444 . W ZW,! 126445 "RTN","C0CXPATH",102,0) 126446 . S @OUTVDV@(ZW)=@INVDX@(ZI) 126447 "RTN","C0CXPATH",103,0) 126448 . S @OUTVDV@("XPATH",ZW)=ZI 126449 "RTN","C0CXPATH",104,0) 126450 Q 126451 "RTN","C0CXPATH",105,0) 126452 ; 126453 "RTN","C0CXPATH",106,0) 126454 VDX2XPG(OUTXPG,INVDX) ; CONVERT AN VDX ARRAY TO XPG 126455 "RTN","C0CXPATH",107,0) 126456 ; VDX: @VDX@(XPATH)=VALUE 126457 "RTN","C0CXPATH",108,0) 126458 ; XPG: @(VDX(X1,X2,X3,X4))@=VALUE 126459 "RTN","C0CXPATH",109,0) 126460 ; THIS IS A STEP TOWARD GENERATING XML FROM A VDX 126461 "RTN","C0CXPATH",110,0) 126462 N ZA,ZI,ZW 126463 "RTN","C0CXPATH",111,0) 126464 S ZI="" 126465 "RTN","C0CXPATH",112,0) 126466 F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ; 126467 "RTN","C0CXPATH",113,0) 126468 . S ZW=$E(ZI,3,$L(ZI)) ; STRIP OFF INITIAL // 126469 "RTN","C0CXPATH",114,0) 126470 . S ZW2=$P(ZW,"/",1) 126471 "RTN","C0CXPATH",115,0) 126472 . F ZK=1:1:$L(ZW,"/") D PUSH("ZA",$P(ZW,"/",ZK)) 126473 "RTN","C0CXPATH",116,0) 126474 . ;ZWR ZA 126475 "RTN","C0CXPATH",117,0) 126476 . S ZW2=ZA(1) 126477 "RTN","C0CXPATH",118,0) 126478 . F ZK=2:1:ZA(0) D ; 126479 "RTN","C0CXPATH",119,0) 126480 . . S ZW2=ZW2_""","""_ZA(ZK) 126481 "RTN","C0CXPATH",120,0) 126482 . K ZA 126483 "RTN","C0CXPATH",121,0) 126484 . S ZW2=""""_ZW2_"""" 126485 "RTN","C0CXPATH",122,0) 126486 . W ZW2,! 126487 "RTN","C0CXPATH",123,0) 126488 . S ZN=OUTXPG_"("_ZW2_")" 126489 "RTN","C0CXPATH",124,0) 126490 . S @ZN=@INVDX@(ZI) 126491 "RTN","C0CXPATH",125,0) 126492 Q 126493 "RTN","C0CXPATH",126,0) 126494 ; 126495 "RTN","C0CXPATH",127,0) 126496 XML2XPG(OUTXPG,INXML) ; CONVERT AN XML ARRAY, PASSED BY NAME TO AN XPG ARRAY 126497 "RTN","C0CXPATH",128,0) 126498 ; XPG MEANS XPATH GLOBAL AND HAS THE FORM @OUTXPG@("X1","X2","X3")=VALUE 126499 "RTN","C0CXPATH",129,0) 126500 ; 126501 "RTN","C0CXPATH",130,0) 126502 ;N G1 126503 "RTN","C0CXPATH",131,0) 126504 D INDEX(INXML,"G1",1) ; PRODUCES A VDX ARRAY IN G1, NO INDEX IS PRODUCED 126505 "RTN","C0CXPATH",132,0) 126506 D VDX2XPG(OUTXPG,"G1") ; CONVERTS THE VDX ARRAY TO XPG FORM 126507 "RTN","C0CXPATH",133,0) 126508 Q 126509 "RTN","C0CXPATH",134,0) 126510 ; 126511 "RTN","C0CXPATH",135,0) 126512 DO ; 126513 "RTN","C0CXPATH",136,0) 126514 D XPG2XML("^GPL2B","^GPL2A") 126515 "RTN","C0CXPATH",137,0) 126516 Q 126517 "RTN","C0CXPATH",138,0) 126518 ; 126519 "RTN","C0CXPATH",139,0) 126520 T1 ; TEST OUT THESE ROUTINES 126521 "RTN","C0CXPATH",140,0) 126522 D XML2XPG("G2","^GPL") 126523 "RTN","C0CXPATH",141,0) 126524 D XPG2XML("G3","G2") 126525 "RTN","C0CXPATH",142,0) 126526 K ^GPLOUT 126527 "RTN","C0CXPATH",143,0) 126528 M ^GPLOUT=G3 126529 "RTN","C0CXPATH",144,0) 126530 W $$OUTPUT^C0CXPATH("^GPLOUT(1)","GPLTEST.xml","/home/vademo2/EHR/p") 126531 "RTN","C0CXPATH",145,0) 126532 Q 126533 "RTN","C0CXPATH",146,0) 126534 ; 126535 "RTN","C0CXPATH",147,0) 126536 XPG2XML(OUTXML,INXPG) ; 126537 "RTN","C0CXPATH",148,0) 126538 N C0CN,FWD,ZA,G,GA,ZQ 126539 "RTN","C0CXPATH",149,0) 126540 S ZQ=0 ; QUIT FLAG 126541 "RTN","C0CXPATH",150,0) 126542 F Q:ZQ=1 D ; LOOP THROUGH EVERYTHING 126543 "RTN","C0CXPATH",151,0) 126544 . I '$D(C0CN) D ; FIRST TIME THROUGH 126545 "RTN","C0CXPATH",152,0) 126546 . . K @OUTXML ; MAKE SURE OUTPUT ARRAY IS CLEAR 126547 "RTN","C0CXPATH",153,0) 126548 . . S FWD=1 ; START OUT GOING FORWARD THROUGH SUBSCRIPTS 126549 "RTN","C0CXPATH",154,0) 126550 . . S G=$Q(@INXPG) ; THIS ONE 126551 "RTN","C0CXPATH",155,0) 126552 . . S GN=$Q(@G) ; NEXT ONE 126553 "RTN","C0CXPATH",156,0) 126554 . . S C0CN=1 ; SUBSCRIPT COUNT 126555 "RTN","C0CXPATH",157,0) 126556 . . S ZQ=0 ; QUIT FLAG 126557 "RTN","C0CXPATH",158,0) 126558 . . D ZXO("?xml version=""1.0"" encoding=""UTF-8""?") ;MAKE IT REAL XML 126559 "RTN","C0CXPATH",159,0) 126560 . . I $QS(G,1)="ContinuityOfCareRecord" D ; 126561 "RTN","C0CXPATH",160,0) 126562 . . . D ZXO("?xml-stylesheet type=""text/xsl"" href=""ccr.xsl""?") ; HACK TO MAKE THE CCR STYLESHEET WORK 126563 "RTN","C0CXPATH",161,0) 126564 . I FWD D ; GOING FORWARDS 126565 "RTN","C0CXPATH",162,0) 126566 . . I C0CN<$QL(G) D ; NOT A DATA NODE 126567 "RTN","C0CXPATH",163,0) 126568 . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT 126569 "RTN","C0CXPATH",164,0) 126570 . . . D ZXO(ZA) ; AND OPEN AN XML ELEMENT 126571 "RTN","C0CXPATH",165,0) 126572 . . . I @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord>" D ; 126573 "RTN","C0CXPATH",166,0) 126574 . . . . S @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord xmlns=""urn:astm-org:CCR"">" 126575 "RTN","C0CXPATH",167,0) 126576 . . . S C0CN=C0CN+1 ; MOVE TO THE NEXT ONE 126577 "RTN","C0CXPATH",168,0) 126578 . . E D ; AT THE DATA NODE 126579 "RTN","C0CXPATH",169,0) 126580 . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT 126581 "RTN","C0CXPATH",170,0) 126582 . . . D ZXVAL(ZA,@G) ; OUTPUT <X>VAL</X> FOR DATA NODE 126583 "RTN","C0CXPATH",171,0) 126584 . . . S FWD=0 ; GO BACKWARDS 126585 "RTN","C0CXPATH",172,0) 126586 . I 'FWD D ;GOING BACKWARDS 126587 "RTN","C0CXPATH",173,0) 126588 . . S GN=$Q(@G) ;NEXT XPATH 126589 "RTN","C0CXPATH",174,0) 126590 . . ;W "NEXT!",GN,! 126591 "RTN","C0CXPATH",175,0) 126592 . . S C0CN=C0CN-1 ; PREVIOUS SUBSCRIPT 126593 "RTN","C0CXPATH",176,0) 126594 . . I GN'="" D ; 126595 "RTN","C0CXPATH",177,0) 126596 . . . I $QS(G,C0CN)'=$QS(GN,C0CN) D ; NEED TO CLOSE OFF ELEMENT 126597 "RTN","C0CXPATH",178,0) 126598 . . . . D ZXC($QS(G,C0CN)) ; 126599 "RTN","C0CXPATH",179,0) 126600 . . . E I GN'="" D ; MORE ELEMENTS AT THIS LEVEL 126601 "RTN","C0CXPATH",180,0) 126602 . . . . S G=$Q(@G) ; ADVANCE TO NEW XPATH 126603 "RTN","C0CXPATH",181,0) 126604 . . . . S C0CN=C0CN+1 ; GET READY TO PROCESS NEXT SUBSCRIPT 126605 "RTN","C0CXPATH",182,0) 126606 . . . . S FWD=1 ; GOING FORWARD NOW 126607 "RTN","C0CXPATH",183,0) 126608 . I (GN="")&(C0CN=1) D Q ; WHEN WE ARE ALL DONE 126609 "RTN","C0CXPATH",184,0) 126610 . . D ZXC($QS(G,C0CN)) ; LAST ONE 126611 "RTN","C0CXPATH",185,0) 126612 . . S ZQ=1 ; QUIT NOW 126613 "RTN","C0CXPATH",186,0) 126614 Q 126615 "RTN","C0CXPATH",187,0) 126616 ; 126617 "RTN","C0CXPATH",188,0) 126618 ZXO(WHAT) ; 126619 "RTN","C0CXPATH",189,0) 126620 D PUSH("GA",WHAT) 126621 "RTN","C0CXPATH",190,0) 126622 D PUSH(OUTXML,"<"_WHAT_">") 126623 "RTN","C0CXPATH",191,0) 126624 Q 126625 "RTN","C0CXPATH",192,0) 126626 ; 126627 "RTN","C0CXPATH",193,0) 126628 ZXC(WHAT) ; 126629 "RTN","C0CXPATH",194,0) 126630 D POP("GA",.TMP) 126631 "RTN","C0CXPATH",195,0) 126632 D PUSH(OUTXML,"</"_WHAT_">") 126633 "RTN","C0CXPATH",196,0) 126634 Q 126635 "RTN","C0CXPATH",197,0) 126636 ; 126637 "RTN","C0CXPATH",198,0) 126638 ZXVAL(WHAT,VAL) ; 126639 "RTN","C0CXPATH",199,0) 126640 D PUSH(OUTXML,"<"_WHAT_">"_VAL_"</"_WHAT_">") 126641 "RTN","C0CXPATH",200,0) 126642 Q 126643 "RTN","C0CXPATH",201,0) 126644 ; 126645 "RTN","C0CXPATH",202,0) 126646 INDEX(IZXML,VDX,NOINX,TEMPLATE,REDUX) ; parse XML in IZXML and produce 126647 "RTN","C0CXPATH",203,0) 126648 ; an XPATH index; REDUX is a string to be removed from each xpath 126649 "RTN","C0CXPATH",204,0) 126650 ; GPL 7/14/09 OPTIONALLY GENERATE AN XML TEMPLATE IF PASSED BY NAME 126651 "RTN","C0CXPATH",205,0) 126652 ; TEMPLATE IS IDENTICAL TO THE PARSED XML LINE BY LINE 126653 "RTN","C0CXPATH",206,0) 126654 ; EXCEPT THAT DATA VALUES ARE REPLACED WITH @@XPATH@@ FOR THE XPATH OF THE TAG 126655 "RTN","C0CXPATH",207,0) 126656 ; GPL 5/24/09 AND OPTIONALLY PRODUCE THE VDX ARRAY PASSED BY NAME 126657 "RTN","C0CXPATH",208,0) 126658 ; @VDX@("XPATH")=VALUE 126659 "RTN","C0CXPATH",209,0) 126660 ; ex. @IZXML@("XPATH")=FIRSTLINE^LASTLINE 126661 "RTN","C0CXPATH",210,0) 126662 ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE 126663 "RTN","C0CXPATH",211,0) 126664 ; XML SECTION 126665 "RTN","C0CXPATH",212,0) 126666 ; IZXML IS PASSED BY NAME 126667 "RTN","C0CXPATH",213,0) 126668 ; IF NOINX IS SET TO 1, NO INDEX WILL BE GENERATED, BUT THE VDX WILL BE 126669 "RTN","C0CXPATH",214,0) 126670 N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND,CURVAL,DVDX,LCNT 126671 "RTN","C0CXPATH",215,0) 126672 N C0CSTK ; LEAVE OUT FOR DEBUGGING 126673 "RTN","C0CXPATH",216,0) 126674 I '$D(REDUX) S REDUX="" 126675 "RTN","C0CXPATH",217,0) 126676 I '$D(NOINX) S NOINX=0 ; IF NOT PASSED, GENERATE AN INDEX 126677 "RTN","C0CXPATH",218,0) 126678 N ZXML 126679 "RTN","C0CXPATH",219,0) 126680 I NOINX S ZXML=$NA(^TMP("C0CINDEX",$J)) ; TEMP PLACE FOR INDEX TO DISCARD 126681 "RTN","C0CXPATH",220,0) 126682 E S ZXML=IZXML ; PLACE FOR INDEX TO KEEP 126683 "RTN","C0CXPATH",221,0) 126684 I '$D(@IZXML@(0)) D ; IF COUNT NOT IN NODE 0 COUNT THEM 126685 "RTN","C0CXPATH",222,0) 126686 . S I="",LCNT=0 126687 "RTN","C0CXPATH",223,0) 126688 . F S I=$O(@IZXML@(I)) Q:I="" S LCNT=LCNT+1 126689 "RTN","C0CXPATH",224,0) 126690 E S LCNT=@IZXML@(0) ; LINE COUNT PASSED IN ARRAY 126691 "RTN","C0CXPATH",225,0) 126692 I LCNT=0 D Q ; NO XML PASSED 126693 "RTN","C0CXPATH",226,0) 126694 . W "ERROR IN XML FILE",! 126695 "RTN","C0CXPATH",227,0) 126696 S DVDX=0 ; DEFAULT DO NOT PRODUCE VDX INDEX 126697 "RTN","C0CXPATH",228,0) 126698 I $D(VDX) S DVDX=1 ; IF NAME PASSED, DO VDX 126699 "RTN","C0CXPATH",229,0) 126700 S C0CSTK(0)=0 ; INITIALIZE STACK 126701 "RTN","C0CXPATH",230,0) 126702 K LKASD ; KILL LOOKASIDE ARRAY 126703 "RTN","C0CXPATH",231,0) 126704 D MKLASD(.LKASD,IZXML) ;MAKE LOOK ASIDE BUFFER FOR MULTIPLES 126705 "RTN","C0CXPATH",232,0) 126706 F I=1:1:LCNT D ; PROCESS THE ENTIRE ARRAY 126707 "RTN","C0CXPATH",233,0) 126708 . S LINE=@IZXML@(I) 126709 "RTN","C0CXPATH",234,0) 126710 . I $D(TEMPLATE) D ;IF TEMPLATE IS REQUESTED 126711 "RTN","C0CXPATH",235,0) 126712 . . S @TEMPLATE@(I)=$$CLEAN(LINE) 126713 "RTN","C0CXPATH",236,0) 126714 . ;W LINE,! 126715 "RTN","C0CXPATH",237,0) 126716 . S FOUND=0 ; INTIALIZED FOUND FLAG 126717 "RTN","C0CXPATH",238,0) 126718 . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS 126719 "RTN","C0CXPATH",239,0) 126720 . I FOUND'=1 D 126721 "RTN","C0CXPATH",240,0) 126722 . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E) D 126723 "RTN","C0CXPATH",241,0) 126724 . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS 126725 "RTN","C0CXPATH",242,0) 126726 . . . ; ON THE SAME LINE 126727 "RTN","C0CXPATH",243,0) 126728 . . . ; W "FOUND ",LINE,! 126729 "RTN","C0CXPATH",244,0) 126730 . . . S FOUND=1 ; SET FOUND FLAG 126731 "RTN","C0CXPATH",245,0) 126732 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME 126733 "RTN","C0CXPATH",246,0) 126734 . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES 126735 "RTN","C0CXPATH",247,0) 126736 . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK 126737 "RTN","C0CXPATH",248,0) 126738 . . . D MKMDX("C0CSTK",.MDX,REDUX) ; GENERATE THE M INDEX 126739 "RTN","C0CXPATH",249,0) 126740 . . . ; W "MDX=",MDX,! 126741 "RTN","C0CXPATH",250,0) 126742 . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE 126743 "RTN","C0CXPATH",251,0) 126744 . . . . ;I '$D(ZDUP(MDX)) S ZDUP(MDX)=2 126745 "RTN","C0CXPATH",252,0) 126746 . . . . ;E S ZDUP(MDX)=ZDUP(MDX)+1 126747 "RTN","C0CXPATH",253,0) 126748 . . . . ;W "DUP:",MDX,! 126749 "RTN","C0CXPATH",254,0) 126750 . . . . ;I '$D(CURVAL) S CURVAL="" 126751 "RTN","C0CXPATH",255,0) 126752 . . . . ;I DVDX S @VDX@(MDX_"["_ZDUP(MDX)_"]")=CURVAL 126753 "RTN","C0CXPATH",256,0) 126754 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER 126755 "RTN","C0CXPATH",257,0) 126756 . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE 126757 "RTN","C0CXPATH",258,0) 126758 . . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST 126759 "RTN","C0CXPATH",259,0) 126760 . . . . S CURVAL=$$XVAL(LINE) ; VALUE 126761 "RTN","C0CXPATH",260,0) 126762 . . . . S $P(@ZXML@(MDX),"^",3)=CURVAL ; THIRD PIECE 126763 "RTN","C0CXPATH",261,0) 126764 . . . . I DVDX S @VDX@(MDX)=CURVAL ; FILL IN VDX ARRAY IF REQUESTED 126765 "RTN","C0CXPATH",262,0) 126766 . . . . I $D(TEMPLATE) D ; IF TEMPLATE IS REQUESTED 126767 "RTN","C0CXPATH",263,0) 126768 . . . . . S LINE=$$CLEAN(LINE) ; CLEAN OUT CONTROL CHARACTERS 126769 "RTN","C0CXPATH",264,0) 126770 . . . . . S @TEMPLATE@(I)=$P(LINE,">",1)_">@@"_MDX_"@@</"_$P(LINE,"</",2) 126771 "RTN","C0CXPATH",265,0) 126772 . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK 126773 "RTN","C0CXPATH",266,0) 126774 . I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END 126775 "RTN","C0CXPATH",267,0) 126776 . . I LINE?.E1"</"1.E D ; LINE CONTAINS END OF A SECTION 126777 "RTN","C0CXPATH",268,0) 126778 . . . ; W "FOUND ",LINE,! 126779 "RTN","C0CXPATH",269,0) 126780 . . . S FOUND=1 ; SET FOUND FLAG 126781 "RTN","C0CXPATH",270,0) 126782 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME 126783 "RTN","C0CXPATH",271,0) 126784 . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX 126785 "RTN","C0CXPATH",272,0) 126786 . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER 126787 "RTN","C0CXPATH",273,0) 126788 . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK 126789 "RTN","C0CXPATH",274,0) 126790 . . . S TMP=$P(TMP,"[",1) ; REMOVE [X] FROM MULTIPLE 126791 "RTN","C0CXPATH",275,0) 126792 . . . I TMP'=CUR D ; MALFORMED XML, END MUST MATCH START 126793 "RTN","C0CXPATH",276,0) 126794 . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,! 126795 "RTN","C0CXPATH",277,0) 126796 . . . . D PARY("C0CSTK") ; PRINT OUT THE STACK FOR DEBUGING 126797 "RTN","C0CXPATH",278,0) 126798 . . . . Q 126799 "RTN","C0CXPATH",279,0) 126800 . I FOUND'=1 D ; THE LINE MIGHT CONTAIN A SECTION BEGINNING 126801 "RTN","C0CXPATH",280,0) 126802 . . I (LINE?.E1"<"1.E)&(LINE'["?>") D ; BEGINNING OF A SECTION 126803 "RTN","C0CXPATH",281,0) 126804 . . . ; W "FOUND ",LINE,! 126805 "RTN","C0CXPATH",282,0) 126806 . . . S FOUND=1 ; SET FOUND FLAG 126807 "RTN","C0CXPATH",283,0) 126808 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME 126809 "RTN","C0CXPATH",284,0) 126810 . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES 126811 "RTN","C0CXPATH",285,0) 126812 . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK 126813 "RTN","C0CXPATH",286,0) 126814 . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX 126815 "RTN","C0CXPATH",287,0) 126816 . . . ; W "MDX=",MDX,! 126817 "RTN","C0CXPATH",288,0) 126818 . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE 126819 "RTN","C0CXPATH",289,0) 126820 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER 126821 "RTN","C0CXPATH",290,0) 126822 . . . . ;B 126823 "RTN","C0CXPATH",291,0) 126824 . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE 126825 "RTN","C0CXPATH",292,0) 126826 . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX 126827 "RTN","C0CXPATH",293,0) 126828 S @ZXML@("INDEXED")="" 126829 "RTN","C0CXPATH",294,0) 126830 S @ZXML@("//")="1^"_LCNT ; ROOT XPATH 126831 "RTN","C0CXPATH",295,0) 126832 I NOINX K @ZXML ; DELETE UNWANTED INDEX 126833 "RTN","C0CXPATH",296,0) 126834 Q 126835 "RTN","C0CXPATH",297,0) 126836 ; 126837 "RTN","C0CXPATH",298,0) 126838 MKLASD(OUTBUF,INARY) ; CREATE A LOOKASIDE BUFFER FOR MULTILPLES 126839 "RTN","C0CXPATH",299,0) 126840 ; 126841 "RTN","C0CXPATH",300,0) 126842 N ZI,ZN,ZA,ZLINE,ZLINE2,CUR,CUR2 126843 "RTN","C0CXPATH",301,0) 126844 F ZI=1:1:LCNT-1 D ; PROCESS THE ENTIRE ARRAY 126845 "RTN","C0CXPATH",302,0) 126846 . S ZLINE=@IZXML@(ZI) 126847 "RTN","C0CXPATH",303,0) 126848 . I ZI<LCNT S ZLINE2=@IZXML@(ZI+1) 126849 "RTN","C0CXPATH",304,0) 126850 . I ZLINE?.E1"</"1.E D ; NEXT LINE CONTAINS END OF A SECTION 126851 "RTN","C0CXPATH",305,0) 126852 . . S CUR=$$XNAME(ZLINE) ; EXTRACT THE NAME 126853 "RTN","C0CXPATH",306,0) 126854 . . I (ZLINE2?.E1"<"1.E)&(ZLINE'["?>") D ; BEGINNING OF A SECTION 126855 "RTN","C0CXPATH",307,0) 126856 . . . S CUR2=$$XNAME(ZLINE2) ; EXTRACT THE NAME 126857 "RTN","C0CXPATH",308,0) 126858 . . . I CUR=CUR2 D ; IF THIS IS A MULTIPLE 126859 "RTN","C0CXPATH",309,0) 126860 . . . . S OUTBUF(CUR,ZI+1)="" 126861 "RTN","C0CXPATH",310,0) 126862 ;ZWR OUTBUF 126863 "RTN","C0CXPATH",311,0) 126864 S ZI="" 126865 "RTN","C0CXPATH",312,0) 126866 F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; FOR EACH KIND OF MULTIPLE 126867 "RTN","C0CXPATH",313,0) 126868 . S ZN=$O(OUTBUF(ZI,"")) ; LINE NUMBER OF SECOND MULTIPLE 126869 "RTN","C0CXPATH",314,0) 126870 . F S ZN=$O(@IZXML@(ZN),-1) Q:ZN="" I $E($P(@IZXML@(ZN),"<"_ZI,2),1,1)=">" Q ; 126871 "RTN","C0CXPATH",315,0) 126872 . S OUTBUF(ZI,ZN)="" 126873 "RTN","C0CXPATH",316,0) 126874 S ZA=1,ZI="",ZN="" 126875 "RTN","C0CXPATH",317,0) 126876 F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; ADDING THE COUNT FOR THE MULIPLES [x] 126877 "RTN","C0CXPATH",318,0) 126878 . S ZN="",ZA=1 126879 "RTN","C0CXPATH",319,0) 126880 . F S ZN=$O(OUTBUF(ZI,ZN)) Q:ZN="" D ; 126881 "RTN","C0CXPATH",320,0) 126882 . . S OUTBUF(ZI,ZN)="["_ZA_"]" 126883 "RTN","C0CXPATH",321,0) 126884 . . S ZA=ZA+1 126885 "RTN","C0CXPATH",322,0) 126886 Q 126887 "RTN","C0CXPATH",323,0) 126888 ; 126889 "RTN","C0CXPATH",324,0) 126890 CLEAN(STR,TR) ; extrinsic function; returns string 126891 "RTN","C0CXPATH",325,0) 126892 ;; Removes all non printable characters from a string. 126893 "RTN","C0CXPATH",326,0) 126894 ;; STR by Value 126895 "RTN","C0CXPATH",327,0) 126896 ;; TR IS OPTIONAL TO IMPROVE PERFORMANCE 126897 "RTN","C0CXPATH",328,0) 126898 N TR,I 126899 "RTN","C0CXPATH",329,0) 126900 I '$D(TR) D ; 126901 "RTN","C0CXPATH",330,0) 126902 . F I=0:1:31 S TR=$G(TR)_$C(I) 126903 "RTN","C0CXPATH",331,0) 126904 . S TR=TR_$C(127) 126905 "RTN","C0CXPATH",332,0) 126906 QUIT $TR(STR,TR) 126907 "RTN","C0CXPATH",333,0) 126908 ; 126909 "RTN","C0CXPATH",334,0) 126910 QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION 126911 "RTN","C0CXPATH",335,0) 126912 ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD" 126913 "RTN","C0CXPATH",336,0) 126914 ; IARY AND OARY ARE PASSED BY NAME 126915 "RTN","C0CXPATH",337,0) 126916 I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY 126917 "RTN","C0CXPATH",338,0) 126918 . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML 126919 "RTN","C0CXPATH",339,0) 126920 N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN 126921 "RTN","C0CXPATH",340,0) 126922 N TMP,I,J,QXPATH 126923 "RTN","C0CXPATH",341,0) 126924 S FIRST=1 126925 "RTN","C0CXPATH",342,0) 126926 I '$D(@IARY@(0)) D ; LINE COUNT NOT IN ZERO NODE 126927 "RTN","C0CXPATH",343,0) 126928 . S @IARY@(0)=$O(@IARY@("//"),-1) ; THIS SHOULD USUALLY WORK 126929 "RTN","C0CXPATH",344,0) 126930 S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT 126931 "RTN","C0CXPATH",345,0) 126932 I XPATH'="//" D ; NOT A ROOT QUERY 126933 "RTN","C0CXPATH",346,0) 126934 . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES 126935 "RTN","C0CXPATH",347,0) 126936 . S FIRST=$P(TMP,"^",1) 126937 "RTN","C0CXPATH",348,0) 126938 . S LAST=$P(TMP,"^",2) 126939 "RTN","C0CXPATH",349,0) 126940 K @OARY 126941 "RTN","C0CXPATH",350,0) 126942 S @OARY@(0)=+LAST-FIRST+1 126943 "RTN","C0CXPATH",351,0) 126944 S J=1 126945 "RTN","C0CXPATH",352,0) 126946 FOR I=FIRST:1:LAST D 126947 "RTN","C0CXPATH",353,0) 126948 . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY 126949 "RTN","C0CXPATH",354,0) 126950 . S J=J+1 126951 "RTN","C0CXPATH",355,0) 126952 ; ZWR OARY 126953 "RTN","C0CXPATH",356,0) 126954 Q 126955 "RTN","C0CXPATH",357,0) 126956 ; 126957 "RTN","C0CXPATH",358,0) 126958 XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH 126959 "RTN","C0CXPATH",359,0) 126960 ; INDEX WITH TWO PIECES START^FINISH 126961 "RTN","C0CXPATH",360,0) 126962 ; IDX IS PASSED BY NAME 126963 "RTN","C0CXPATH",361,0) 126964 Q $P(@IDX@(XPATH),"^",1) 126965 "RTN","C0CXPATH",362,0) 126966 ; 126967 "RTN","C0CXPATH",363,0) 126968 XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH 126969 "RTN","C0CXPATH",364,0) 126970 ; INDEX WITH TWO PIECES START^FINISH 126971 "RTN","C0CXPATH",365,0) 126972 ; IDX IS PASSED BY NAME 126973 "RTN","C0CXPATH",366,0) 126974 Q $P(@IDX@(XPATH),"^",2) 126975 "RTN","C0CXPATH",367,0) 126976 ; 126977 "RTN","C0CXPATH",368,0) 126978 START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX 126979 "RTN","C0CXPATH",369,0) 126980 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH 126981 "RTN","C0CXPATH",370,0) 126982 ; COMPANION TO FINISH ; IDX IS PASSED BY NAME 126983 "RTN","C0CXPATH",371,0) 126984 Q $P(ISTR,";",2) 126985 "RTN","C0CXPATH",372,0) 126986 ; 126987 "RTN","C0CXPATH",373,0) 126988 FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX 126989 "RTN","C0CXPATH",374,0) 126990 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH 126991 "RTN","C0CXPATH",375,0) 126992 Q $P(ISTR,";",3) 126993 "RTN","C0CXPATH",376,0) 126994 ; 126995 "RTN","C0CXPATH",377,0) 126996 ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX 126997 "RTN","C0CXPATH",378,0) 126998 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH 126999 "RTN","C0CXPATH",379,0) 127000 Q $P(ISTR,";",1) 127001 "RTN","C0CXPATH",380,0) 127002 ; 127003 "RTN","C0CXPATH",381,0) 127004 BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST 127005 "RTN","C0CXPATH",382,0) 127006 ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST 127007 "RTN","C0CXPATH",383,0) 127008 ; DEST IS CLEARED TO START 127009 "RTN","C0CXPATH",384,0) 127010 ; USES PUSH TO DO THE COPY 127011 "RTN","C0CXPATH",385,0) 126158 127012 N I 126159 "RTN","C0CXPATH",64,0) 126160 ; W "STK= ",STK,! 126161 "RTN","C0CXPATH",65,0) 126162 I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY 126163 "RTN","C0CXPATH",66,0) 126164 . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON 126165 "RTN","C0CXPATH",67,0) 126166 . I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON 126167 "RTN","C0CXPATH",68,0) 126168 . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I) 126169 "RTN","C0CXPATH",69,0) 126170 I $G(INREDUX)'="" S RTN=$P(RTN,INREDUX,1)_$P(RTN,INREDUX,2) 126171 "RTN","C0CXPATH",70,0) 127013 "RTN","C0CXPATH",386,0) 127014 K @BDEST 127015 "RTN","C0CXPATH",387,0) 127016 F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST 127017 "RTN","C0CXPATH",388,0) 127018 . N J,ATMP 127019 "RTN","C0CXPATH",389,0) 127020 . S ATMP=$$ARRAY(@BLIST@(I)) 127021 "RTN","C0CXPATH",390,0) 127022 . I $G(DEBUG) W "ATMP=",ATMP,! 127023 "RTN","C0CXPATH",391,0) 127024 . I $G(DEBUG) W @BLIST@(I),! 127025 "RTN","C0CXPATH",392,0) 127026 . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ; 127027 "RTN","C0CXPATH",393,0) 127028 . . ; FOR EACH LINE IN THIS INSTR 127029 "RTN","C0CXPATH",394,0) 127030 . . I $G(DEBUG) W "BDEST= ",BDEST,! 127031 "RTN","C0CXPATH",395,0) 127032 . . I $G(DEBUG) W "ATMP= ",@ATMP@(J),! 127033 "RTN","C0CXPATH",396,0) 127034 . . D PUSH(BDEST,@ATMP@(J)) 127035 "RTN","C0CXPATH",397,0) 126172 127036 Q 126173 "RTN","C0CXPATH",71,0) 126174 ; 126175 "RTN","C0CXPATH",72,0) 126176 XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG 126177 "RTN","C0CXPATH",73,0) 126178 ; </NAME> AND <NAME ID=XNAME> WILL RETURN NAME 126179 "RTN","C0CXPATH",74,0) 126180 ; ISTR IS PASSED BY VALUE 126181 "RTN","C0CXPATH",75,0) 126182 N CUR,TMP 126183 "RTN","C0CXPATH",76,0) 126184 I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET 126185 "RTN","C0CXPATH",77,0) 126186 . S TMP=$P(ISTR,"<",2) 126187 "RTN","C0CXPATH",78,0) 126188 I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME> 126189 "RTN","C0CXPATH",79,0) 126190 . S TMP=$P(TMP,"/",2) 126191 "RTN","C0CXPATH",80,0) 126192 S CUR=$P(TMP,">",1) ; EXTRACT THE NAME 126193 "RTN","C0CXPATH",81,0) 126194 ; W "CUR= ",CUR,! 126195 "RTN","C0CXPATH",82,0) 126196 I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST> 126197 "RTN","C0CXPATH",83,0) 126198 . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER 126199 "RTN","C0CXPATH",84,0) 126200 ; W "CUR2= ",CUR,! 126201 "RTN","C0CXPATH",85,0) 126202 Q CUR 126203 "RTN","C0CXPATH",86,0) 126204 ; 126205 "RTN","C0CXPATH",87,0) 126206 XVAL(ISTR) ; EXTRACTS THE VALUE FROM A FRAGMENT OF XML 126207 "RTN","C0CXPATH",88,0) 126208 ; <NAME>VALUE</NAME> WILL RETURN VALUE 126209 "RTN","C0CXPATH",89,0) 126210 N G 126211 "RTN","C0CXPATH",90,0) 126212 S G=$P(ISTR,">",2) ;STRIP OFF <NAME> 126213 "RTN","C0CXPATH",91,0) 126214 Q $P(G,"<",1) ; STRIP OFF </NAME> LEAVING VALUE 126215 "RTN","C0CXPATH",92,0) 126216 ; 126217 "RTN","C0CXPATH",93,0) 126218 VDX2VDV(OUTVDV,INVDX) ; CONVERT AN VDX ARRAY TO VDV 126219 "RTN","C0CXPATH",94,0) 126220 ; VDX: @INVDX@(XPATH)=VALUE 126221 "RTN","C0CXPATH",95,0) 126222 ; VDV: @OUTVDV@(X1X2X3X4)=VALUE 126223 "RTN","C0CXPATH",96,0) 126224 ; THE VDV DATANAMES MIGHT BE MORE CONVENIENT FOR USE IN CODE 126225 "RTN","C0CXPATH",97,0) 126226 ; AN INDEX IS PROVIDED TO GO BACK TO VDX FOR CONVERSIONS 126227 "RTN","C0CXPATH",98,0) 126228 ; @VDV@("XPATH",X1X2X3X4)="XPATH" 126229 "RTN","C0CXPATH",99,0) 126230 N ZA,ZI,ZW 126231 "RTN","C0CXPATH",100,0) 126232 S ZI="" 126233 "RTN","C0CXPATH",101,0) 126234 F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ; 126235 "RTN","C0CXPATH",102,0) 126236 . S ZW=$TR(ZI,"/","") ; ELIMINATE ALL SLASHES - CAMEL CASE VARIABLE NAME 126237 "RTN","C0CXPATH",103,0) 126238 . W ZW,! 126239 "RTN","C0CXPATH",104,0) 126240 . S @OUTVDV@(ZW)=@INVDX@(ZI) 126241 "RTN","C0CXPATH",105,0) 126242 . S @OUTVDV@("XPATH",ZW)=ZI 126243 "RTN","C0CXPATH",106,0) 127037 "RTN","C0CXPATH",398,0) 127038 ; 127039 "RTN","C0CXPATH",399,0) 127040 QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST 127041 "RTN","C0CXPATH",400,0) 127042 ; 127043 "RTN","C0CXPATH",401,0) 127044 I $G(DEBUG) W "QUEUEING ",BLST,! 127045 "RTN","C0CXPATH",402,0) 127046 D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST) 127047 "RTN","C0CXPATH",403,0) 126244 127048 Q 126245 "RTN","C0CXPATH",107,0) 126246 ; 126247 "RTN","C0CXPATH",108,0) 126248 VDX2XPG(OUTXPG,INVDX) ; CONVERT AN VDX ARRAY TO XPG 126249 "RTN","C0CXPATH",109,0) 126250 ; VDX: @VDX@(XPATH)=VALUE 126251 "RTN","C0CXPATH",110,0) 126252 ; XPG: @(VDX(X1,X2,X3,X4))@=VALUE 126253 "RTN","C0CXPATH",111,0) 126254 ; THIS IS A STEP TOWARD GENERATING XML FROM A VDX 126255 "RTN","C0CXPATH",112,0) 126256 N ZA,ZI,ZW 126257 "RTN","C0CXPATH",113,0) 126258 S ZI="" 126259 "RTN","C0CXPATH",114,0) 126260 F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ; 126261 "RTN","C0CXPATH",115,0) 126262 . S ZW=$E(ZI,3,$L(ZI)) ; STRIP OFF INITIAL // 126263 "RTN","C0CXPATH",116,0) 126264 . S ZW2=$P(ZW,"/",1) 126265 "RTN","C0CXPATH",117,0) 126266 . F ZK=1:1:$L(ZW,"/") D PUSH("ZA",$P(ZW,"/",ZK)) 126267 "RTN","C0CXPATH",118,0) 126268 . ;ZWR ZA 126269 "RTN","C0CXPATH",119,0) 126270 . S ZW2=ZA(1) 126271 "RTN","C0CXPATH",120,0) 126272 . F ZK=2:1:ZA(0) D ; 126273 "RTN","C0CXPATH",121,0) 126274 . . S ZW2=ZW2_""","""_ZA(ZK) 126275 "RTN","C0CXPATH",122,0) 126276 . K ZA 126277 "RTN","C0CXPATH",123,0) 126278 . S ZW2=""""_ZW2_"""" 126279 "RTN","C0CXPATH",124,0) 126280 . W ZW2,! 126281 "RTN","C0CXPATH",125,0) 126282 . S ZN=OUTXPG_"("_ZW2_")" 126283 "RTN","C0CXPATH",126,0) 126284 . S @ZN=@INVDX@(ZI) 126285 "RTN","C0CXPATH",127,0) 127049 "RTN","C0CXPATH",404,0) 127050 ; 127051 "RTN","C0CXPATH",405,0) 127052 CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME 127053 "RTN","C0CXPATH",406,0) 127054 ; KILLS CPDEST FIRST 127055 "RTN","C0CXPATH",407,0) 127056 N CPINSTR 127057 "RTN","C0CXPATH",408,0) 127058 I $G(DEBUG) W "MADE IT TO COPY",CPSRC,CPDEST,! 127059 "RTN","C0CXPATH",409,0) 127060 I @CPSRC@(0)<1 D ; BAD LENGTH 127061 "RTN","C0CXPATH",410,0) 127062 . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,! 127063 "RTN","C0CXPATH",411,0) 127064 . Q 127065 "RTN","C0CXPATH",412,0) 127066 ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT 127067 "RTN","C0CXPATH",413,0) 127068 D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY 127069 "RTN","C0CXPATH",414,0) 127070 D BUILD("CPINSTR",CPDEST) 127071 "RTN","C0CXPATH",415,0) 126286 127072 Q 126287 "RTN","C0CXPATH",128,0) 126288 ; 126289 "RTN","C0CXPATH",129,0) 126290 XML2XPG(OUTXPG,INXML) ; CONVERT AN XML ARRAY, PASSED BY NAME TO AN XPG ARRAY 126291 "RTN","C0CXPATH",130,0) 126292 ; XPG MEANS XPATH GLOBAL AND HAS THE FORM @OUTXPG@("X1","X2","X3")=VALUE 126293 "RTN","C0CXPATH",131,0) 126294 ; 126295 "RTN","C0CXPATH",132,0) 126296 ;N G1 126297 "RTN","C0CXPATH",133,0) 126298 D INDEX(INXML,"G1",1) ; PRODUCES A VDX ARRAY IN G1, NO INDEX IS PRODUCED 126299 "RTN","C0CXPATH",134,0) 126300 D VDX2XPG(OUTXPG,"G1") ; CONVERTS THE VDX ARRAY TO XPG FORM 126301 "RTN","C0CXPATH",135,0) 127073 "RTN","C0CXPATH",416,0) 127074 ; 127075 "RTN","C0CXPATH",417,0) 127076 QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST 127077 "RTN","C0CXPATH",418,0) 127078 ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD 127079 "RTN","C0CXPATH",419,0) 127080 ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT 127081 "RTN","C0CXPATH",420,0) 127082 ; USED TO INSERT CHILDREN NODES 127083 "RTN","C0CXPATH",421,0) 127084 I @QOXML@(0)<1 D ; MALFORMED XML 127085 "RTN","C0CXPATH",422,0) 127086 . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,! 127087 "RTN","C0CXPATH",423,0) 127088 . Q 127089 "RTN","C0CXPATH",424,0) 127090 I $G(DEBUG) W "DOING QOPEN",! 127091 "RTN","C0CXPATH",425,0) 127092 N S1,E1,QOT,QOTMP 127093 "RTN","C0CXPATH",426,0) 127094 S S1=1 ; OPEN FROM THE BEGINNING OF THE XML 127095 "RTN","C0CXPATH",427,0) 127096 I $D(QOXPATH) D ; XPATH PROVIDED 127097 "RTN","C0CXPATH",428,0) 127098 . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX 127099 "RTN","C0CXPATH",429,0) 127100 . S E1=$P(@QOXML@(QOXPATH),"^",2)-1 127101 "RTN","C0CXPATH",430,0) 127102 I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT 127103 "RTN","C0CXPATH",431,0) 127104 . S E1=@QOXML@(0)-1 127105 "RTN","C0CXPATH",432,0) 127106 D QUEUE(QOBLIST,QOXML,S1,E1) 127107 "RTN","C0CXPATH",433,0) 127108 ; S QOTMP=QOXML_"^"_S1_"^"_E1 127109 "RTN","C0CXPATH",434,0) 127110 ; D PUSH(QOBLIST,QOTMP) 127111 "RTN","C0CXPATH",435,0) 126302 127112 Q 126303 "RTN","C0CXPATH",136,0) 126304 ; 126305 "RTN","C0CXPATH",137,0) 126306 DO 126307 "RTN","C0CXPATH",138,0) 126308 D XPG2XML("^GPL2B","^GPL2A") 126309 "RTN","C0CXPATH",139,0) 127113 "RTN","C0CXPATH",436,0) 127114 ; 127115 "RTN","C0CXPATH",437,0) 127116 QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN 127117 "RTN","C0CXPATH",438,0) 127118 ; ADDS THE LIST LINE OF QCXML TO QCBLIST 127119 "RTN","C0CXPATH",439,0) 127120 ; USED TO FINISH INSERTING CHILDERN NODES 127121 "RTN","C0CXPATH",440,0) 127122 ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END 127123 "RTN","C0CXPATH",441,0) 127124 ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO 127125 "RTN","C0CXPATH",442,0) 127126 I @QCXML@(0)<1 D ; MALFORMED XML 127127 "RTN","C0CXPATH",443,0) 127128 . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,! 127129 "RTN","C0CXPATH",444,0) 127130 I $G(DEBUG) W "GOING TO CLOSE",! 127131 "RTN","C0CXPATH",445,0) 127132 N S1,E1,QCT,QCTMP 127133 "RTN","C0CXPATH",446,0) 127134 S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML 127135 "RTN","C0CXPATH",447,0) 127136 I $D(QCXPATH) D ; XPATH PROVIDED 127137 "RTN","C0CXPATH",448,0) 127138 . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX 127139 "RTN","C0CXPATH",449,0) 127140 . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML 127141 "RTN","C0CXPATH",450,0) 127142 I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT 127143 "RTN","C0CXPATH",451,0) 127144 . S S1=@QCXML@(0) 127145 "RTN","C0CXPATH",452,0) 127146 D QUEUE(QCBLIST,QCXML,S1,E1) 127147 "RTN","C0CXPATH",453,0) 127148 ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1) 127149 "RTN","C0CXPATH",454,0) 126310 127150 Q 126311 "RTN","C0CXPATH",140,0) 126312 ; 126313 "RTN","C0CXPATH",141,0) 126314 T1 ; TEST OUT THESE ROUTINES 126315 "RTN","C0CXPATH",142,0) 126316 D XML2XPG("G2","^GPL") 126317 "RTN","C0CXPATH",143,0) 126318 D XPG2XML("G3","G2") 126319 "RTN","C0CXPATH",144,0) 126320 K ^GPLOUT 126321 "RTN","C0CXPATH",145,0) 126322 M ^GPLOUT=G3 126323 "RTN","C0CXPATH",146,0) 126324 W $$OUTPUT^C0CXPATH("^GPLOUT(1)","GPLTEST.xml","/home/vademo2/EHR/p") 126325 "RTN","C0CXPATH",147,0) 127151 "RTN","C0CXPATH",455,0) 127152 ; 127153 "RTN","C0CXPATH",456,0) 127154 INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE 127155 "RTN","C0CXPATH",457,0) 127156 ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS 127157 "RTN","C0CXPATH",458,0) 127158 ; OMITTED, INSERTION WILL BE AT THE ROOT 127159 "RTN","C0CXPATH",459,0) 127160 ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW 127161 "RTN","C0CXPATH",460,0) 127162 ; XML AT THE END OF THE XPATH POINT 127163 "RTN","C0CXPATH",461,0) 127164 ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE 127165 "RTN","C0CXPATH",462,0) 127166 N INSBLD,INSTMP 127167 "RTN","C0CXPATH",463,0) 127168 I $G(DEBUG) W "DOING INSERT ",INSXML,INSNEW,INSXPATH,! 127169 "RTN","C0CXPATH",464,0) 127170 I $G(DEBUG) F G1=1:1:@INSXML@(0) W @INSXML@(G1),! 127171 "RTN","C0CXPATH",465,0) 127172 I '$D(@INSXML@(1)) D ; INSERT INTO AN EMPTY ARRAY 127173 "RTN","C0CXPATH",466,0) 127174 . D CP^C0CXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT 127175 "RTN","C0CXPATH",467,0) 127176 I $D(@INSXML@(1)) D ; IF ORIGINAL ARRAY IS NOT EMPTY 127177 "RTN","C0CXPATH",468,0) 127178 . I '$D(@INSXML@(0)) S @INSXML@(0)=$O(@INSXML@(""),-1) ;SET LENGTH 127179 "RTN","C0CXPATH",469,0) 127180 . I $D(INSXPATH) D ; XPATH PROVIDED 127181 "RTN","C0CXPATH",470,0) 127182 . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE 127183 "RTN","C0CXPATH",471,0) 127184 . . I $G(DEBUG) D PARY^C0CXPATH("INSBLD") 127185 "RTN","C0CXPATH",472,0) 127186 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT 127187 "RTN","C0CXPATH",473,0) 127188 . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH 127189 "RTN","C0CXPATH",474,0) 127190 . I '$D(@INSNEW@(0)) S @INSNEW@(0)=$O(@INSNEW@(""),-1) ;SIZE OF XML 127191 "RTN","C0CXPATH",475,0) 127192 . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML 127193 "RTN","C0CXPATH",476,0) 127194 . I $D(INSXPATH) D ; XPATH PROVIDED 127195 "RTN","C0CXPATH",477,0) 127196 . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH 127197 "RTN","C0CXPATH",478,0) 127198 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT 127199 "RTN","C0CXPATH",479,0) 127200 . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH 127201 "RTN","C0CXPATH",480,0) 127202 . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST 127203 "RTN","C0CXPATH",481,0) 127204 . D CP^C0CXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE 127205 "RTN","C0CXPATH",482,0) 126326 127206 Q 126327 "RTN","C0CXPATH",148,0) 126328 ; 126329 "RTN","C0CXPATH",149,0) 126330 XPG2XML(OUTXML,INXPG) ; 126331 "RTN","C0CXPATH",150,0) 126332 N C0CN,FWD,ZA,G,GA,ZQ 126333 "RTN","C0CXPATH",151,0) 126334 S ZQ=0 ; QUIT FLAG 126335 "RTN","C0CXPATH",152,0) 126336 F Q:ZQ=1 D ; LOOP THROUGH EVERYTHING 126337 "RTN","C0CXPATH",153,0) 126338 . I '$D(C0CN) D ; FIRST TIME THROUGH 126339 "RTN","C0CXPATH",154,0) 126340 . . K @OUTXML ; MAKE SURE OUTPUT ARRAY IS CLEAR 126341 "RTN","C0CXPATH",155,0) 126342 . . S FWD=1 ; START OUT GOING FORWARD THROUGH SUBSCRIPTS 126343 "RTN","C0CXPATH",156,0) 126344 . . S G=$Q(@INXPG) ; THIS ONE 126345 "RTN","C0CXPATH",157,0) 126346 . . S GN=$Q(@G) ; NEXT ONE 126347 "RTN","C0CXPATH",158,0) 126348 . . S C0CN=1 ; SUBSCRIPT COUNT 126349 "RTN","C0CXPATH",159,0) 126350 . . S ZQ=0 ; QUIT FLAG 126351 "RTN","C0CXPATH",160,0) 126352 . . D ZXO("?xml version=""1.0"" encoding=""UTF-8""?") ;MAKE IT REAL XML 126353 "RTN","C0CXPATH",161,0) 126354 . . I $QS(G,1)="ContinuityOfCareRecord" D ; 126355 "RTN","C0CXPATH",162,0) 126356 . . . D ZXO("?xml-stylesheet type=""text/xsl"" href=""ccr.xsl""?") ; HACK TO MAKE THE CCR STYLESHEET WORK 126357 "RTN","C0CXPATH",163,0) 126358 . I FWD D ; GOING FORWARDS 126359 "RTN","C0CXPATH",164,0) 126360 . . I C0CN<$QL(G) D ; NOT A DATA NODE 126361 "RTN","C0CXPATH",165,0) 126362 . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT 126363 "RTN","C0CXPATH",166,0) 126364 . . . D ZXO(ZA) ; AND OPEN AN XML ELEMENT 126365 "RTN","C0CXPATH",167,0) 126366 . . . I @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord>" D ; 126367 "RTN","C0CXPATH",168,0) 126368 . . . . S @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord xmlns=""urn:astm-org:CCR"">" 126369 "RTN","C0CXPATH",169,0) 126370 . . . S C0CN=C0CN+1 ; MOVE TO THE NEXT ONE 126371 "RTN","C0CXPATH",170,0) 126372 . . E D ; AT THE DATA NODE 126373 "RTN","C0CXPATH",171,0) 126374 . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT 126375 "RTN","C0CXPATH",172,0) 126376 . . . D ZXVAL(ZA,@G) ; OUTPUT <X>VAL</X> FOR DATA NODE 126377 "RTN","C0CXPATH",173,0) 126378 . . . S FWD=0 ; GO BACKWARDS 126379 "RTN","C0CXPATH",174,0) 126380 . I 'FWD D ;GOING BACKWARDS 126381 "RTN","C0CXPATH",175,0) 126382 . . S GN=$Q(@G) ;NEXT XPATH 126383 "RTN","C0CXPATH",176,0) 126384 . . ;W "NEXT!",GN,! 126385 "RTN","C0CXPATH",177,0) 126386 . . S C0CN=C0CN-1 ; PREVIOUS SUBSCRIPT 126387 "RTN","C0CXPATH",178,0) 126388 . . I GN'="" D ; 126389 "RTN","C0CXPATH",179,0) 126390 . . . I $QS(G,C0CN)'=$QS(GN,C0CN) D ; NEED TO CLOSE OFF ELEMENT 126391 "RTN","C0CXPATH",180,0) 126392 . . . . D ZXC($QS(G,C0CN)) ; 126393 "RTN","C0CXPATH",181,0) 126394 . . . E I GN'="" D ; MORE ELEMENTS AT THIS LEVEL 126395 "RTN","C0CXPATH",182,0) 126396 . . . . S G=$Q(@G) ; ADVANCE TO NEW XPATH 126397 "RTN","C0CXPATH",183,0) 126398 . . . . S C0CN=C0CN+1 ; GET READY TO PROCESS NEXT SUBSCRIPT 126399 "RTN","C0CXPATH",184,0) 126400 . . . . S FWD=1 ; GOING FORWARD NOW 126401 "RTN","C0CXPATH",185,0) 126402 . I (GN="")&(C0CN=1) D Q ; WHEN WE ARE ALL DONE 126403 "RTN","C0CXPATH",186,0) 126404 . . D ZXC($QS(G,C0CN)) ; LAST ONE 126405 "RTN","C0CXPATH",187,0) 126406 . . S ZQ=1 ; QUIT NOW 126407 "RTN","C0CXPATH",188,0) 127207 "RTN","C0CXPATH",483,0) 127208 ; 127209 "RTN","C0CXPATH",484,0) 127210 INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW 127211 "RTN","C0CXPATH",485,0) 127212 ; INTO INNXML AT THE INNXPATH XPATH POINT 127213 "RTN","C0CXPATH",486,0) 127214 ; 127215 "RTN","C0CXPATH",487,0) 127216 N INNBLD,UXPATH 127217 "RTN","C0CXPATH",488,0) 127218 N INNTBUF 127219 "RTN","C0CXPATH",489,0) 127220 S INNTBUF=$NA(^TMP($J,"INNTBUF")) 127221 "RTN","C0CXPATH",490,0) 127222 I '$D(INNXPATH) D ; XPATH NOT PASSED 127223 "RTN","C0CXPATH",491,0) 127224 . S UXPATH="//" ; USE ROOT XPATH 127225 "RTN","C0CXPATH",492,0) 127226 I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED 127227 "RTN","C0CXPATH",493,0) 127228 I '$D(@INNXML@(0)) D ; INNXML IS EMPTY 127229 "RTN","C0CXPATH",494,0) 127230 . D QUEUE^C0CXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER 127231 "RTN","C0CXPATH",495,0) 127232 . D BUILD("INNBLD",INNXML) 127233 "RTN","C0CXPATH",496,0) 127234 I @INNXML@(0)>0 D ; NOT EMPTY 127235 "RTN","C0CXPATH",497,0) 127236 . D QOPEN("INNBLD",INNXML,UXPATH) ; 127237 "RTN","C0CXPATH",498,0) 127238 . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML 127239 "RTN","C0CXPATH",499,0) 127240 . D QCLOSE("INNBLD",INNXML,UXPATH) 127241 "RTN","C0CXPATH",500,0) 127242 . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER 127243 "RTN","C0CXPATH",501,0) 127244 . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST 127245 "RTN","C0CXPATH",502,0) 126408 127246 Q 126409 "RTN","C0CXPATH",189,0) 126410 ; 126411 "RTN","C0CXPATH",190,0) 126412 ZXO(WHAT) 126413 "RTN","C0CXPATH",191,0) 126414 D PUSH("GA",WHAT) 126415 "RTN","C0CXPATH",192,0) 126416 D PUSH(OUTXML,"<"_WHAT_">") 126417 "RTN","C0CXPATH",193,0) 127247 "RTN","C0CXPATH",503,0) 127248 ; 127249 "RTN","C0CXPATH",504,0) 127250 INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST 127251 "RTN","C0CXPATH",505,0) 127252 ; BUT XDEST AN XNEW ARE PASSED BY NAME 127253 "RTN","C0CXPATH",506,0) 127254 N XBLD,XTMP 127255 "RTN","C0CXPATH",507,0) 127256 D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT 127257 "RTN","C0CXPATH",508,0) 127258 D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST 127259 "RTN","C0CXPATH",509,0) 127260 D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION 127261 "RTN","C0CXPATH",510,0) 127262 D BUILD("XBLD","XTMP") ; BUILD THE RESULT 127263 "RTN","C0CXPATH",511,0) 127264 D CP("XTMP",XDEST) ; COPY TO THE DESTINATION 127265 "RTN","C0CXPATH",512,0) 127266 I $G(DEBUG) D PARY("XDEST") 127267 "RTN","C0CXPATH",513,0) 126418 127268 Q 126419 "RTN","C0CXPATH",194,0) 126420 ; 126421 "RTN","C0CXPATH",195,0) 126422 ZXC(WHAT) 126423 "RTN","C0CXPATH",196,0) 126424 D POP("GA",.TMP) 126425 "RTN","C0CXPATH",197,0) 126426 D PUSH(OUTXML,"</"_WHAT_">") 126427 "RTN","C0CXPATH",198,0) 127269 "RTN","C0CXPATH",514,0) 127270 ; 127271 "RTN","C0CXPATH",515,0) 127272 REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT 127273 "RTN","C0CXPATH",516,0) 127274 ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE 127275 "RTN","C0CXPATH",517,0) 127276 ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE 127277 "RTN","C0CXPATH",518,0) 127278 ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD") 127279 "RTN","C0CXPATH",519,0) 127280 N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP 127281 "RTN","C0CXPATH",520,0) 127282 S OLD=$NA(^TMP($J,"REPLACE_OLD")) 127283 "RTN","C0CXPATH",521,0) 127284 D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD 127285 "RTN","C0CXPATH",522,0) 127286 S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS 127287 "RTN","C0CXPATH",523,0) 127288 S XFIRST=$P(XNODE,"^",1) 127289 "RTN","C0CXPATH",524,0) 127290 S XLAST=$P(XNODE,"^",2) 127291 "RTN","C0CXPATH",525,0) 127292 I RENEW="" D ; WE ARE DELETING A SECTION, MUST SAVE THE TAG 127293 "RTN","C0CXPATH",526,0) 127294 . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE 127295 "RTN","C0CXPATH",527,0) 127296 . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST 127297 "RTN","C0CXPATH",528,0) 127298 I RENEW'="" D ; NEW XML IS NOT NULL 127299 "RTN","C0CXPATH",529,0) 127300 . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE 127301 "RTN","C0CXPATH",530,0) 127302 . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW 127303 "RTN","C0CXPATH",531,0) 127304 . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST 127305 "RTN","C0CXPATH",532,0) 127306 I $G(DEBUG) W "REPLACE PREBUILD",! 127307 "RTN","C0CXPATH",533,0) 127308 I $G(DEBUG) D PARY("REBLD") 127309 "RTN","C0CXPATH",534,0) 127310 D BUILD("REBLD","RTMP") 127311 "RTN","C0CXPATH",535,0) 127312 K @REXML ; KILL WHAT WAS THERE 127313 "RTN","C0CXPATH",536,0) 127314 D CP("RTMP",REXML) ; COPY IN THE RESULT 127315 "RTN","C0CXPATH",537,0) 126428 127316 Q 126429 "RTN","C0CXPATH",199,0) 126430 ; 126431 "RTN","C0CXPATH",200,0) 126432 ZXVAL(WHAT,VAL) 126433 "RTN","C0CXPATH",201,0) 126434 D PUSH(OUTXML,"<"_WHAT_">"_VAL_"</"_WHAT_">") 126435 "RTN","C0CXPATH",202,0) 127317 "RTN","C0CXPATH",538,0) 127318 ; 127319 "RTN","C0CXPATH",539,0) 127320 DELETE(REXML,REXPATH) ; DELETE THE XML AT THE XPATH POINT 127321 "RTN","C0CXPATH",540,0) 127322 ; REXML IS PASSED BY NAME XPATH IS A VALUE 127323 "RTN","C0CXPATH",541,0) 127324 N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP 127325 "RTN","C0CXPATH",542,0) 127326 S OLD=$NA(^TMP($J,"REPLACE_OLD")) 127327 "RTN","C0CXPATH",543,0) 127328 D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD 127329 "RTN","C0CXPATH",544,0) 127330 S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS 127331 "RTN","C0CXPATH",545,0) 127332 S XFIRST=$P(XNODE,"^",1) 127333 "RTN","C0CXPATH",546,0) 127334 S XLAST=$P(XNODE,"^",2) 127335 "RTN","C0CXPATH",547,0) 127336 D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE 127337 "RTN","C0CXPATH",548,0) 127338 D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST 127339 "RTN","C0CXPATH",549,0) 127340 I $G(DEBUG) D PARY("REBLD") 127341 "RTN","C0CXPATH",550,0) 127342 D BUILD("REBLD","RTMP") 127343 "RTN","C0CXPATH",551,0) 127344 K @REXML ; KILL WHAT WAS THERE 127345 "RTN","C0CXPATH",552,0) 127346 D CP("RTMP",REXML) ; COPY IN THE RESULT 127347 "RTN","C0CXPATH",553,0) 126436 127348 Q 126437 "RTN","C0CXPATH",203,0) 126438 ; 126439 "RTN","C0CXPATH",204,0) 126440 INDEX(IZXML,VDX,NOINX,TEMPLATE,REDUX) ; parse XML in IZXML and produce 126441 "RTN","C0CXPATH",205,0) 126442 ; an XPATH index; REDUX is a string to be removed from each xpath 126443 "RTN","C0CXPATH",206,0) 126444 ; GPL 7/14/09 OPTIONALLY GENERATE AN XML TEMPLATE IF PASSED BY NAME 126445 "RTN","C0CXPATH",207,0) 126446 ; TEMPLATE IS IDENTICAL TO THE PARSED XML LINE BY LINE 126447 "RTN","C0CXPATH",208,0) 126448 ; EXCEPT THAT DATA VALUES ARE REPLACED WITH @@XPATH@@ FOR THE XPATH OF THE TAG 126449 "RTN","C0CXPATH",209,0) 126450 ; GPL 5/24/09 AND OPTIONALLY PRODUCE THE VDX ARRAY PASSED BY NAME 126451 "RTN","C0CXPATH",210,0) 126452 ; @VDX@("XPATH")=VALUE 126453 "RTN","C0CXPATH",211,0) 126454 ; ex. @IZXML@("XPATH")=FIRSTLINE^LASTLINE 126455 "RTN","C0CXPATH",212,0) 126456 ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE 126457 "RTN","C0CXPATH",213,0) 126458 ; XML SECTION 126459 "RTN","C0CXPATH",214,0) 126460 ; IZXML IS PASSED BY NAME 126461 "RTN","C0CXPATH",215,0) 126462 ; IF NOINX IS SET TO 1, NO INDEX WILL BE GENERATED, BUT THE VDX WILL BE 126463 "RTN","C0CXPATH",216,0) 126464 N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND,CURVAL,DVDX,LCNT 126465 "RTN","C0CXPATH",217,0) 126466 N C0CSTK ; LEAVE OUT FOR DEBUGGING 126467 "RTN","C0CXPATH",218,0) 126468 I '$D(REDUX) S REDUX="" 126469 "RTN","C0CXPATH",219,0) 126470 I '$D(NOINX) S NOINX=0 ; IF NOT PASSED, GENERATE AN INDEX 126471 "RTN","C0CXPATH",220,0) 126472 N ZXML 126473 "RTN","C0CXPATH",221,0) 126474 I NOINX S ZXML=$NA(^TMP("C0CINDEX",$J)) ; TEMP PLACE FOR INDEX TO DISCARD 126475 "RTN","C0CXPATH",222,0) 126476 E S ZXML=IZXML ; PLACE FOR INDEX TO KEEP 126477 "RTN","C0CXPATH",223,0) 126478 I '$D(@IZXML@(0)) D ; IF COUNT NOT IN NODE 0 COUNT THEM 126479 "RTN","C0CXPATH",224,0) 126480 . S I="",LCNT=0 126481 "RTN","C0CXPATH",225,0) 126482 . F S I=$O(@IZXML@(I)) Q:I="" S LCNT=LCNT+1 126483 "RTN","C0CXPATH",226,0) 126484 E S LCNT=@IZXML@(0) ; LINE COUNT PASSED IN ARRAY 126485 "RTN","C0CXPATH",227,0) 126486 I LCNT=0 D Q ; NO XML PASSED 126487 "RTN","C0CXPATH",228,0) 126488 . W "ERROR IN XML FILE",! 126489 "RTN","C0CXPATH",229,0) 126490 S DVDX=0 ; DEFAULT DO NOT PRODUCE VDX INDEX 126491 "RTN","C0CXPATH",230,0) 126492 I $D(VDX) S DVDX=1 ; IF NAME PASSED, DO VDX 126493 "RTN","C0CXPATH",231,0) 126494 S C0CSTK(0)=0 ; INITIALIZE STACK 126495 "RTN","C0CXPATH",232,0) 126496 K LKASD ; KILL LOOKASIDE ARRAY 126497 "RTN","C0CXPATH",233,0) 126498 D MKLASD(.LKASD,IZXML) ;MAKE LOOK ASIDE BUFFER FOR MULTIPLES 126499 "RTN","C0CXPATH",234,0) 126500 F I=1:1:LCNT D ; PROCESS THE ENTIRE ARRAY 126501 "RTN","C0CXPATH",235,0) 126502 . S LINE=@IZXML@(I) 126503 "RTN","C0CXPATH",236,0) 126504 . I $D(TEMPLATE) D ;IF TEMPLATE IS REQUESTED 126505 "RTN","C0CXPATH",237,0) 126506 . . S @TEMPLATE@(I)=$$CLEAN(LINE) 126507 "RTN","C0CXPATH",238,0) 126508 . ;W LINE,! 126509 "RTN","C0CXPATH",239,0) 126510 . S FOUND=0 ; INTIALIZED FOUND FLAG 126511 "RTN","C0CXPATH",240,0) 126512 . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS 126513 "RTN","C0CXPATH",241,0) 126514 . I FOUND'=1 D 126515 "RTN","C0CXPATH",242,0) 126516 . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E) D 126517 "RTN","C0CXPATH",243,0) 126518 . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS 126519 "RTN","C0CXPATH",244,0) 126520 . . . ; ON THE SAME LINE 126521 "RTN","C0CXPATH",245,0) 126522 . . . ; W "FOUND ",LINE,! 126523 "RTN","C0CXPATH",246,0) 126524 . . . S FOUND=1 ; SET FOUND FLAG 126525 "RTN","C0CXPATH",247,0) 126526 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME 126527 "RTN","C0CXPATH",248,0) 126528 . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES 126529 "RTN","C0CXPATH",249,0) 126530 . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK 126531 "RTN","C0CXPATH",250,0) 126532 . . . D MKMDX("C0CSTK",.MDX,REDUX) ; GENERATE THE M INDEX 126533 "RTN","C0CXPATH",251,0) 126534 . . . ; W "MDX=",MDX,! 126535 "RTN","C0CXPATH",252,0) 126536 . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE 126537 "RTN","C0CXPATH",253,0) 126538 . . . . ;I '$D(ZDUP(MDX)) S ZDUP(MDX)=2 126539 "RTN","C0CXPATH",254,0) 126540 . . . . ;E S ZDUP(MDX)=ZDUP(MDX)+1 126541 "RTN","C0CXPATH",255,0) 126542 . . . . ;W "DUP:",MDX,! 126543 "RTN","C0CXPATH",256,0) 126544 . . . . ;I '$D(CURVAL) S CURVAL="" 126545 "RTN","C0CXPATH",257,0) 126546 . . . . ;I DVDX S @VDX@(MDX_"["_ZDUP(MDX)_"]")=CURVAL 126547 "RTN","C0CXPATH",258,0) 126548 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER 126549 "RTN","C0CXPATH",259,0) 126550 . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE 126551 "RTN","C0CXPATH",260,0) 126552 . . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST 126553 "RTN","C0CXPATH",261,0) 126554 . . . . S CURVAL=$$XVAL(LINE) ; VALUE 126555 "RTN","C0CXPATH",262,0) 126556 . . . . S $P(@ZXML@(MDX),"^",3)=CURVAL ; THIRD PIECE 126557 "RTN","C0CXPATH",263,0) 126558 . . . . I DVDX S @VDX@(MDX)=CURVAL ; FILL IN VDX ARRAY IF REQUESTED 126559 "RTN","C0CXPATH",264,0) 126560 . . . . I $D(TEMPLATE) D ; IF TEMPLATE IS REQUESTED 126561 "RTN","C0CXPATH",265,0) 126562 . . . . . S LINE=$$CLEAN(LINE) ; CLEAN OUT CONTROL CHARACTERS 126563 "RTN","C0CXPATH",266,0) 126564 . . . . . S @TEMPLATE@(I)=$P(LINE,">",1)_">@@"_MDX_"@@</"_$P(LINE,"</",2) 126565 "RTN","C0CXPATH",267,0) 126566 . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK 126567 "RTN","C0CXPATH",268,0) 126568 . I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END 126569 "RTN","C0CXPATH",269,0) 126570 . . I LINE?.E1"</"1.E D ; LINE CONTAINS END OF A SECTION 126571 "RTN","C0CXPATH",270,0) 126572 . . . ; W "FOUND ",LINE,! 126573 "RTN","C0CXPATH",271,0) 126574 . . . S FOUND=1 ; SET FOUND FLAG 126575 "RTN","C0CXPATH",272,0) 126576 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME 126577 "RTN","C0CXPATH",273,0) 126578 . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX 126579 "RTN","C0CXPATH",274,0) 126580 . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER 126581 "RTN","C0CXPATH",275,0) 126582 . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK 126583 "RTN","C0CXPATH",276,0) 126584 . . . S TMP=$P(TMP,"[",1) ; REMOVE [X] FROM MULTIPLE 126585 "RTN","C0CXPATH",277,0) 126586 . . . I TMP'=CUR D ; MALFORMED XML, END MUST MATCH START 126587 "RTN","C0CXPATH",278,0) 126588 . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,! 126589 "RTN","C0CXPATH",279,0) 126590 . . . . D PARY("C0CSTK") ; PRINT OUT THE STACK FOR DEBUGING 126591 "RTN","C0CXPATH",280,0) 126592 . . . . Q 126593 "RTN","C0CXPATH",281,0) 126594 . I FOUND'=1 D ; THE LINE MIGHT CONTAIN A SECTION BEGINNING 126595 "RTN","C0CXPATH",282,0) 126596 . . I (LINE?.E1"<"1.E)&(LINE'["?>") D ; BEGINNING OF A SECTION 126597 "RTN","C0CXPATH",283,0) 126598 . . . ; W "FOUND ",LINE,! 126599 "RTN","C0CXPATH",284,0) 126600 . . . S FOUND=1 ; SET FOUND FLAG 126601 "RTN","C0CXPATH",285,0) 126602 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME 126603 "RTN","C0CXPATH",286,0) 126604 . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES 126605 "RTN","C0CXPATH",287,0) 126606 . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK 126607 "RTN","C0CXPATH",288,0) 126608 . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX 126609 "RTN","C0CXPATH",289,0) 126610 . . . ; W "MDX=",MDX,! 126611 "RTN","C0CXPATH",290,0) 126612 . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE 126613 "RTN","C0CXPATH",291,0) 126614 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER 126615 "RTN","C0CXPATH",292,0) 126616 . . . . ;B 126617 "RTN","C0CXPATH",293,0) 126618 . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE 126619 "RTN","C0CXPATH",294,0) 126620 . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX 126621 "RTN","C0CXPATH",295,0) 126622 S @ZXML@("INDEXED")="" 126623 "RTN","C0CXPATH",296,0) 126624 S @ZXML@("//")="1^"_LCNT ; ROOT XPATH 126625 "RTN","C0CXPATH",297,0) 126626 I NOINX K @ZXML ; DELETE UNWANTED INDEX 126627 "RTN","C0CXPATH",298,0) 127349 "RTN","C0CXPATH",554,0) 127350 ; 127351 "RTN","C0CXPATH",555,0) 127352 MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY 127353 "RTN","C0CXPATH",556,0) 127354 ; W "Reporting on the missing",! 127355 "RTN","C0CXPATH",557,0) 127356 ; W OARY 127357 "RTN","C0CXPATH",558,0) 127358 I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q 127359 "RTN","C0CXPATH",559,0) 127360 N I 127361 "RTN","C0CXPATH",560,0) 127362 S @OARY@(0)=0 ; INITIALIZED MISSING COUNT 127363 "RTN","C0CXPATH",561,0) 127364 F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY 127365 "RTN","C0CXPATH",562,0) 127366 . I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE 127367 "RTN","C0CXPATH",563,0) 127368 . . D PUSH^C0CXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY 127369 "RTN","C0CXPATH",564,0) 127370 . . Q 127371 "RTN","C0CXPATH",565,0) 126628 127372 Q 126629 "RTN","C0CXPATH",299,0) 126630 ; 126631 "RTN","C0CXPATH",300,0) 126632 MKLASD(OUTBUF,INARY) ; CREATE A LOOKASIDE BUFFER FOR MULTILPLES 126633 "RTN","C0CXPATH",301,0) 126634 ; 126635 "RTN","C0CXPATH",302,0) 126636 N ZI,ZN,ZA,ZLINE,ZLINE2,CUR,CUR2 126637 "RTN","C0CXPATH",303,0) 126638 F ZI=1:1:LCNT-1 D ; PROCESS THE ENTIRE ARRAY 126639 "RTN","C0CXPATH",304,0) 126640 . S ZLINE=@IZXML@(ZI) 126641 "RTN","C0CXPATH",305,0) 126642 . I ZI<LCNT S ZLINE2=@IZXML@(ZI+1) 126643 "RTN","C0CXPATH",306,0) 126644 . I ZLINE?.E1"</"1.E D ; NEXT LINE CONTAINS END OF A SECTION 126645 "RTN","C0CXPATH",307,0) 126646 . . S CUR=$$XNAME(ZLINE) ; EXTRACT THE NAME 126647 "RTN","C0CXPATH",308,0) 126648 . . I (ZLINE2?.E1"<"1.E)&(ZLINE'["?>") D ; BEGINNING OF A SECTION 126649 "RTN","C0CXPATH",309,0) 126650 . . . S CUR2=$$XNAME(ZLINE2) ; EXTRACT THE NAME 126651 "RTN","C0CXPATH",310,0) 126652 . . . I CUR=CUR2 D ; IF THIS IS A MULTIPLE 126653 "RTN","C0CXPATH",311,0) 126654 . . . . S OUTBUF(CUR,ZI+1)="" 126655 "RTN","C0CXPATH",312,0) 126656 ;ZWR OUTBUF 126657 "RTN","C0CXPATH",313,0) 126658 S ZI="" 126659 "RTN","C0CXPATH",314,0) 126660 F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; FOR EACH KIND OF MULTIPLE 126661 "RTN","C0CXPATH",315,0) 126662 . S ZN=$O(OUTBUF(ZI,"")) ; LINE NUMBER OF SECOND MULTIPLE 126663 "RTN","C0CXPATH",316,0) 126664 . F S ZN=$O(@IZXML@(ZN),-1) Q:ZN="" I $E($P(@IZXML@(ZN),"<"_ZI,2),1,1)=">" Q ; 126665 "RTN","C0CXPATH",317,0) 126666 . S OUTBUF(ZI,ZN)="" 126667 "RTN","C0CXPATH",318,0) 126668 S ZA=1,ZI="",ZN="" 126669 "RTN","C0CXPATH",319,0) 126670 F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; ADDING THE COUNT FOR THE MULIPLES [x] 126671 "RTN","C0CXPATH",320,0) 126672 . S ZN="",ZA=1 126673 "RTN","C0CXPATH",321,0) 126674 . F S ZN=$O(OUTBUF(ZI,ZN)) Q:ZN="" D ; 126675 "RTN","C0CXPATH",322,0) 126676 . . S OUTBUF(ZI,ZN)="["_ZA_"]" 126677 "RTN","C0CXPATH",323,0) 126678 . . S ZA=ZA+1 126679 "RTN","C0CXPATH",324,0) 127373 "RTN","C0CXPATH",566,0) 127374 ; 127375 "RTN","C0CXPATH",567,0) 127376 MAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY 127377 "RTN","C0CXPATH",568,0) 127378 ; AND PUT THE RESULTS IN OXML 127379 "RTN","C0CXPATH",569,0) 127380 N XCNT 127381 "RTN","C0CXPATH",570,0) 127382 I '$D(DEBUG) S DEBUG=0 127383 "RTN","C0CXPATH",571,0) 127384 I '$D(IXML) W "MALFORMED XML PASSED TO MAP",! Q 127385 "RTN","C0CXPATH",572,0) 127386 I '$D(@IXML@(0)) D ; INITIALIZE COUNT 127387 "RTN","C0CXPATH",573,0) 127388 . S XCNT=$O(@IXML@(""),-1) 127389 "RTN","C0CXPATH",574,0) 127390 E S XCNT=@IXML@(0) ;COUNT 127391 "RTN","C0CXPATH",575,0) 127392 I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q 127393 "RTN","C0CXPATH",576,0) 127394 N I,J,TNAM,TVAL,TSTR 127395 "RTN","C0CXPATH",577,0) 127396 S @OXML@(0)=XCNT ; TOTAL LINES IN OUTPUT 127397 "RTN","C0CXPATH",578,0) 127398 F I=1:1:XCNT D ; LOOP THROUGH WHOLE ARRAY 127399 "RTN","C0CXPATH",579,0) 127400 . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT 127401 "RTN","C0CXPATH",580,0) 127402 . I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE? 127403 "RTN","C0CXPATH",581,0) 127404 . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS 127405 "RTN","C0CXPATH",582,0) 127406 . . F J=2:2:10 D Q:$P(@IXML@(I),"@@",J+2)="" ; QUIT IF NO MORE VARS 127407 "RTN","C0CXPATH",583,0) 127408 . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,! 127409 "RTN","C0CXPATH",584,0) 127410 . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME 127411 "RTN","C0CXPATH",585,0) 127412 . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED 127413 "RTN","C0CXPATH",586,0) 127414 . . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP? 127415 "RTN","C0CXPATH",587,0) 127416 . . . . I '$D(@INARY@(TNAM,"F")) D ; NOT A SPECIAL FIELD 127417 "RTN","C0CXPATH",588,0) 127418 . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE 127419 "RTN","C0CXPATH",589,0) 127420 . . . . E D DOFLD ; PROCESS A FIELD 127421 "RTN","C0CXPATH",590,0) 127422 . . . S TVAL=$$SYMENC^MXMLUTL(TVAL) ;MAKE SURE THE VALUE IS XML SAFE 127423 "RTN","C0CXPATH",591,0) 127424 . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER 127425 "RTN","C0CXPATH",592,0) 127426 . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES 127427 "RTN","C0CXPATH",593,0) 127428 . . I DEBUG W TSTR 127429 "RTN","C0CXPATH",594,0) 127430 I DEBUG W "MAPPED",! 127431 "RTN","C0CXPATH",595,0) 126680 127432 Q 126681 "RTN","C0CXPATH",325,0) 126682 ; 126683 "RTN","C0CXPATH",326,0) 126684 CLEAN(STR,TR) ; extrinsic function; returns string 126685 "RTN","C0CXPATH",327,0) 126686 ;; Removes all non printable characters from a string. 126687 "RTN","C0CXPATH",328,0) 126688 ;; STR by Value 126689 "RTN","C0CXPATH",329,0) 126690 ;; TR IS OPTIONAL TO IMPROVE PERFORMANCE 126691 "RTN","C0CXPATH",330,0) 126692 N TR,I 126693 "RTN","C0CXPATH",331,0) 126694 I '$D(TR) D ; 126695 "RTN","C0CXPATH",332,0) 126696 . F I=0:1:31 S TR=$G(TR)_$C(I) 126697 "RTN","C0CXPATH",333,0) 126698 . S TR=TR_$C(127) 126699 "RTN","C0CXPATH",334,0) 126700 QUIT $TR(STR,TR) 126701 "RTN","C0CXPATH",335,0) 126702 ; 126703 "RTN","C0CXPATH",336,0) 126704 QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION 126705 "RTN","C0CXPATH",337,0) 126706 ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD" 126707 "RTN","C0CXPATH",338,0) 126708 ; IARY AND OARY ARE PASSED BY NAME 126709 "RTN","C0CXPATH",339,0) 126710 I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY 126711 "RTN","C0CXPATH",340,0) 126712 . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML 126713 "RTN","C0CXPATH",341,0) 126714 N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN 126715 "RTN","C0CXPATH",342,0) 126716 N TMP,I,J,QXPATH 126717 "RTN","C0CXPATH",343,0) 126718 S FIRST=1 126719 "RTN","C0CXPATH",344,0) 126720 I '$D(@IARY@(0)) D ; LINE COUNT NOT IN ZERO NODE 126721 "RTN","C0CXPATH",345,0) 126722 . S @IARY@(0)=$O(@IARY@("//"),-1) ; THIS SHOULD USUALLY WORK 126723 "RTN","C0CXPATH",346,0) 126724 S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT 126725 "RTN","C0CXPATH",347,0) 126726 I XPATH'="//" D ; NOT A ROOT QUERY 126727 "RTN","C0CXPATH",348,0) 126728 . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES 126729 "RTN","C0CXPATH",349,0) 126730 . S FIRST=$P(TMP,"^",1) 126731 "RTN","C0CXPATH",350,0) 126732 . S LAST=$P(TMP,"^",2) 126733 "RTN","C0CXPATH",351,0) 126734 K @OARY 126735 "RTN","C0CXPATH",352,0) 126736 S @OARY@(0)=+LAST-FIRST+1 126737 "RTN","C0CXPATH",353,0) 126738 S J=1 126739 "RTN","C0CXPATH",354,0) 126740 FOR I=FIRST:1:LAST D 126741 "RTN","C0CXPATH",355,0) 126742 . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY 126743 "RTN","C0CXPATH",356,0) 126744 . S J=J+1 126745 "RTN","C0CXPATH",357,0) 126746 ; ZWR OARY 126747 "RTN","C0CXPATH",358,0) 127433 "RTN","C0CXPATH",596,0) 127434 ; 127435 "RTN","C0CXPATH",597,0) 127436 DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE 127437 "RTN","C0CXPATH",598,0) 127438 ; 127439 "RTN","C0CXPATH",599,0) 126748 127440 Q 126749 "RTN","C0CXPATH",359,0) 126750 ; 126751 "RTN","C0CXPATH",360,0) 126752 XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH 126753 "RTN","C0CXPATH",361,0) 126754 ; INDEX WITH TWO PIECES START^FINISH 126755 "RTN","C0CXPATH",362,0) 126756 ; IDX IS PASSED BY NAME 126757 "RTN","C0CXPATH",363,0) 126758 Q $P(@IDX@(XPATH),"^",1) 126759 "RTN","C0CXPATH",364,0) 126760 ; 126761 "RTN","C0CXPATH",365,0) 126762 XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH 126763 "RTN","C0CXPATH",366,0) 126764 ; INDEX WITH TWO PIECES START^FINISH 126765 "RTN","C0CXPATH",367,0) 126766 ; IDX IS PASSED BY NAME 126767 "RTN","C0CXPATH",368,0) 126768 Q $P(@IDX@(XPATH),"^",2) 126769 "RTN","C0CXPATH",369,0) 126770 ; 126771 "RTN","C0CXPATH",370,0) 126772 START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX 126773 "RTN","C0CXPATH",371,0) 126774 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH 126775 "RTN","C0CXPATH",372,0) 126776 ; COMPANION TO FINISH ; IDX IS PASSED BY NAME 126777 "RTN","C0CXPATH",373,0) 126778 Q $P(ISTR,";",2) 126779 "RTN","C0CXPATH",374,0) 126780 ; 126781 "RTN","C0CXPATH",375,0) 126782 FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX 126783 "RTN","C0CXPATH",376,0) 126784 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH 126785 "RTN","C0CXPATH",377,0) 126786 Q $P(ISTR,";",3) 126787 "RTN","C0CXPATH",378,0) 126788 ; 126789 "RTN","C0CXPATH",379,0) 126790 ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX 126791 "RTN","C0CXPATH",380,0) 126792 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH 126793 "RTN","C0CXPATH",381,0) 126794 Q $P(ISTR,";",1) 126795 "RTN","C0CXPATH",382,0) 126796 ; 126797 "RTN","C0CXPATH",383,0) 126798 BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST 126799 "RTN","C0CXPATH",384,0) 126800 ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST 126801 "RTN","C0CXPATH",385,0) 126802 ; DEST IS CLEARED TO START 126803 "RTN","C0CXPATH",386,0) 126804 ; USES PUSH TO DO THE COPY 126805 "RTN","C0CXPATH",387,0) 127441 "RTN","C0CXPATH",600,0) 127442 ; 127443 "RTN","C0CXPATH",601,0) 127444 TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS 127445 "RTN","C0CXPATH",602,0) 127446 ; THEXML IS PASSED BY NAME 127447 "RTN","C0CXPATH",603,0) 127448 N I,J,TMPXML,DEL,FOUND,INTXT 127449 "RTN","C0CXPATH",604,0) 127450 S FOUND=0 127451 "RTN","C0CXPATH",605,0) 127452 S INTXT=0 127453 "RTN","C0CXPATH",606,0) 127454 I $G(DEBUG) W "DELETING EMPTY ELEMENTS",! 127455 "RTN","C0CXPATH",607,0) 127456 F I=1:1:(@THEXML@(0)-1) D ; LOOP THROUGH ENTIRE ARRAY 127457 "RTN","C0CXPATH",608,0) 127458 . S J=@THEXML@(I) 127459 "RTN","C0CXPATH",609,0) 127460 . I J["<text>" D 127461 "RTN","C0CXPATH",610,0) 127462 . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM 127463 "RTN","C0CXPATH",611,0) 127464 . . I $G(DEBUG) W "IN HTML SECTION",! 127465 "RTN","C0CXPATH",612,0) 127466 . N JM,JP,JPX ; JMINUS AND JPLUS 127467 "RTN","C0CXPATH",613,0) 127468 . S JM=@THEXML@(I-1) ; LINE BEFORE 127469 "RTN","C0CXPATH",614,0) 127470 . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM 127471 "RTN","C0CXPATH",615,0) 127472 . S JP=@THEXML@(I+1) ; LINE AFTER 127473 "RTN","C0CXPATH",616,0) 127474 . I INTXT=0 D ; IF NOT IN AN HTML SECTION 127475 "RTN","C0CXPATH",617,0) 127476 . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH 127477 "RTN","C0CXPATH",618,0) 127478 . . I J=JPX D ; AN EMPTY ELEMENT ON TWO LINES 127479 "RTN","C0CXPATH",619,0) 127480 . . . I $G(DEBUG) W I,J,JP,! 127481 "RTN","C0CXPATH",620,0) 127482 . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED 127483 "RTN","C0CXPATH",621,0) 127484 . . . S DEL(I)="" ; SET LINE TO DELETE 127485 "RTN","C0CXPATH",622,0) 127486 . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE 127487 "RTN","C0CXPATH",623,0) 127488 . . I J["><" D ; AN EMPTY ELEMENT ON ONE LINE 127489 "RTN","C0CXPATH",624,0) 127490 . . . I $G(DEBUG) W I,J,! 127491 "RTN","C0CXPATH",625,0) 127492 . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED 127493 "RTN","C0CXPATH",626,0) 127494 . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED 127495 "RTN","C0CXPATH",627,0) 127496 . . . I JM=JPX D ; 127497 "RTN","C0CXPATH",628,0) 127498 . . . . I $G(DEBUG) W I,JM_J_JPX,! 127499 "RTN","C0CXPATH",629,0) 127500 . . . . S DEL(I-1)="" 127501 "RTN","C0CXPATH",630,0) 127502 . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL 127503 "RTN","C0CXPATH",631,0) 127504 ; . I J'["><" D PUSH("TMPXML",J) 127505 "RTN","C0CXPATH",632,0) 127506 I FOUND D ; NEED TO DELETE THINGS 127507 "RTN","C0CXPATH",633,0) 127508 . F I=1:1:@THEXML@(0) D ; COPY ARRAY LEAVING OUT DELELTED LINES 127509 "RTN","C0CXPATH",634,0) 127510 . . I '$D(DEL(I)) D ; IF THE LINE IS NOT DELETED 127511 "RTN","C0CXPATH",635,0) 127512 . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY 127513 "RTN","C0CXPATH",636,0) 127514 . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY 127515 "RTN","C0CXPATH",637,0) 127516 Q FOUND 127517 "RTN","C0CXPATH",638,0) 127518 ; 127519 "RTN","C0CXPATH",639,0) 127520 UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML 127521 "RTN","C0CXPATH",640,0) 127522 ; XSEC IS A SECTION PASSED BY NAME 127523 "RTN","C0CXPATH",641,0) 127524 N XBLD,XTMP 127525 "RTN","C0CXPATH",642,0) 127526 D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML 127527 "RTN","C0CXPATH",643,0) 127528 D BUILD("XBLD","XTMP") ; BUILD THE RESULT 127529 "RTN","C0CXPATH",644,0) 127530 D CP("XTMP",XSEC) ; REPLACE PASSED XML 127531 "RTN","C0CXPATH",645,0) 127532 Q 127533 "RTN","C0CXPATH",646,0) 127534 ; 127535 "RTN","C0CXPATH",647,0) 127536 PARY(GLO,ZN) ;PRINT AN ARRAY 127537 "RTN","C0CXPATH",648,0) 127538 ; IF ZN=-1 NO LINE NUMBERS 127539 "RTN","C0CXPATH",649,0) 126806 127540 N I 126807 "RTN","C0CXPATH",388,0) 126808 K @BDEST 126809 "RTN","C0CXPATH",389,0) 126810 F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST 126811 "RTN","C0CXPATH",390,0) 126812 . N J,ATMP 126813 "RTN","C0CXPATH",391,0) 126814 . S ATMP=$$ARRAY(@BLIST@(I)) 126815 "RTN","C0CXPATH",392,0) 126816 . I $G(DEBUG) W "ATMP=",ATMP,! 126817 "RTN","C0CXPATH",393,0) 126818 . I $G(DEBUG) W @BLIST@(I),! 126819 "RTN","C0CXPATH",394,0) 126820 . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ; 126821 "RTN","C0CXPATH",395,0) 126822 . . ; FOR EACH LINE IN THIS INSTR 126823 "RTN","C0CXPATH",396,0) 126824 . . I $G(DEBUG) W "BDEST= ",BDEST,! 126825 "RTN","C0CXPATH",397,0) 126826 . . I $G(DEBUG) W "ATMP= ",@ATMP@(J),! 126827 "RTN","C0CXPATH",398,0) 126828 . . D PUSH(BDEST,@ATMP@(J)) 126829 "RTN","C0CXPATH",399,0) 127541 "RTN","C0CXPATH",650,0) 127542 F I=1:1:@GLO@(0) D ; 127543 "RTN","C0CXPATH",651,0) 127544 . I $G(ZN)=-1 W @GLO@(I),! 127545 "RTN","C0CXPATH",652,0) 127546 . E W I_" "_@GLO@(I),! 127547 "RTN","C0CXPATH",653,0) 126830 127548 Q 126831 "RTN","C0CXPATH",400,0) 126832 ; 126833 "RTN","C0CXPATH",401,0) 126834 QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST 126835 "RTN","C0CXPATH",402,0) 126836 ; 126837 "RTN","C0CXPATH",403,0) 126838 I $G(DEBUG) W "QUEUEING ",BLST,! 126839 "RTN","C0CXPATH",404,0) 126840 D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST) 126841 "RTN","C0CXPATH",405,0) 127549 "RTN","C0CXPATH",654,0) 127550 ; 127551 "RTN","C0CXPATH",655,0) 127552 H2ARY(IARYRTN,IHASH,IPRE) ; CONVERT IHASH TO RETURN ARRAY 127553 "RTN","C0CXPATH",656,0) 127554 ; IPRE IS OPTIONAL PREFIX FOR THE ELEMENTS. USED FOR MUPTIPLES 1^"VAR"^VALUE 127555 "RTN","C0CXPATH",657,0) 127556 I '$D(IPRE) S IPRE="" 127557 "RTN","C0CXPATH",658,0) 127558 N H2I S H2I="" 127559 "RTN","C0CXPATH",659,0) 127560 ; W $O(@IHASH@(H2I)),! 127561 "RTN","C0CXPATH",660,0) 127562 F S H2I=$O(@IHASH@(H2I)) Q:H2I="" D ; FOR EACH ELEMENT OF THE HASH 127563 "RTN","C0CXPATH",661,0) 127564 . I $QS(H2I,$QL(H2I))="M" D Q ; SPECIAL CASE FOR MULTIPLES 127565 "RTN","C0CXPATH",662,0) 127566 . . ;W H2I_"^"_@IHASH@(H2I),! 127567 "RTN","C0CXPATH",663,0) 127568 . . N IH,IHI 127569 "RTN","C0CXPATH",664,0) 127570 . . S IH=$NA(@IHASH@(H2I)) ; 127571 "RTN","C0CXPATH",665,0) 127572 . . S IH2A=$O(@IH@("")) ; SKIP OVER MULTIPLE DISCRIPTOR 127573 "RTN","C0CXPATH",666,0) 127574 . . S IH2=$NA(@IH@(IH2A)) ; PAST THE "M","DIRETIONS" FOR EXAMPLE 127575 "RTN","C0CXPATH",667,0) 127576 . . S IHI="" ; INDEX INTO "M" MULTIPLES 127577 "RTN","C0CXPATH",668,0) 127578 . . F S IHI=$O(@IH2@(IHI)) Q:IHI="" D ; FOR EACH SUB-MULTIPLE 127579 "RTN","C0CXPATH",669,0) 127580 . . . ; W @IH@(IHI) 127581 "RTN","C0CXPATH",670,0) 127582 . . . S IH3=$NA(@IH2@(IHI)) 127583 "RTN","C0CXPATH",671,0) 127584 . . . ; W "HEY",IH3,! 127585 "RTN","C0CXPATH",672,0) 127586 . . . D H2ARY(.IARYRTN,IH3,IPRE_";"_IHI) ; RECURSIVE CALL - INDENTED ELEMENTS 127587 "RTN","C0CXPATH",673,0) 127588 . . ; W IH,! 127589 "RTN","C0CXPATH",674,0) 127590 . . ; W "C0CZZ",! 127591 "RTN","C0CXPATH",675,0) 127592 . . ; W $NA(@IHASH@(H2I)),! 127593 "RTN","C0CXPATH",676,0) 127594 . . Q ; 127595 "RTN","C0CXPATH",677,0) 127596 . D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I)) 127597 "RTN","C0CXPATH",678,0) 127598 . ; W @IARYRTN@(0),! 127599 "RTN","C0CXPATH",679,0) 126842 127600 Q 126843 "RTN","C0CXPATH",406,0) 126844 ; 126845 "RTN","C0CXPATH",407,0) 126846 CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME 126847 "RTN","C0CXPATH",408,0) 126848 ; KILLS CPDEST FIRST 126849 "RTN","C0CXPATH",409,0) 126850 N CPINSTR 126851 "RTN","C0CXPATH",410,0) 126852 I $G(DEBUG) W "MADE IT TO COPY",CPSRC,CPDEST,! 126853 "RTN","C0CXPATH",411,0) 126854 I @CPSRC@(0)<1 D ; BAD LENGTH 126855 "RTN","C0CXPATH",412,0) 126856 . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,! 126857 "RTN","C0CXPATH",413,0) 126858 . Q 126859 "RTN","C0CXPATH",414,0) 126860 ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT 126861 "RTN","C0CXPATH",415,0) 126862 D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY 126863 "RTN","C0CXPATH",416,0) 126864 D BUILD("CPINSTR",CPDEST) 126865 "RTN","C0CXPATH",417,0) 127601 "RTN","C0CXPATH",680,0) 127602 ; 127603 "RTN","C0CXPATH",681,0) 127604 XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES 127605 "RTN","C0CXPATH",682,0) 127606 ; DEFINED IN INPUT XML XVIXML BY @@VAR@@ 127607 "RTN","C0CXPATH",683,0) 127608 ; XVRTN AND XVIXML ARE PASSED BY NAME 127609 "RTN","C0CXPATH",684,0) 127610 ; 127611 "RTN","C0CXPATH",685,0) 127612 N XVI,XVTMP,XVT 127613 "RTN","C0CXPATH",686,0) 127614 F XVI=1:1:@XVIXML@(0) D ; FOR ALL LINES OF THE XML 127615 "RTN","C0CXPATH",687,0) 127616 . S XVT=@XVIXML@(XVI) 127617 "RTN","C0CXPATH",688,0) 127618 . I XVT["@@" S XVTMP($P(XVT,"@@",2))=XVI 127619 "RTN","C0CXPATH",689,0) 127620 D H2ARY(XVRTN,"XVTMP") 127621 "RTN","C0CXPATH",690,0) 126866 127622 Q 126867 "RTN","C0CXPATH",418,0) 126868 ; 126869 "RTN","C0CXPATH",419,0) 126870 QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST 126871 "RTN","C0CXPATH",420,0) 126872 ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD 126873 "RTN","C0CXPATH",421,0) 126874 ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT 126875 "RTN","C0CXPATH",422,0) 126876 ; USED TO INSERT CHILDREN NODES 126877 "RTN","C0CXPATH",423,0) 126878 I @QOXML@(0)<1 D ; MALFORMED XML 126879 "RTN","C0CXPATH",424,0) 126880 . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,! 126881 "RTN","C0CXPATH",425,0) 126882 . Q 126883 "RTN","C0CXPATH",426,0) 126884 I $G(DEBUG) W "DOING QOPEN",! 126885 "RTN","C0CXPATH",427,0) 126886 N S1,E1,QOT,QOTMP 126887 "RTN","C0CXPATH",428,0) 126888 S S1=1 ; OPEN FROM THE BEGINNING OF THE XML 126889 "RTN","C0CXPATH",429,0) 126890 I $D(QOXPATH) D ; XPATH PROVIDED 126891 "RTN","C0CXPATH",430,0) 126892 . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX 126893 "RTN","C0CXPATH",431,0) 126894 . S E1=$P(@QOXML@(QOXPATH),"^",2)-1 126895 "RTN","C0CXPATH",432,0) 126896 I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT 126897 "RTN","C0CXPATH",433,0) 126898 . S E1=@QOXML@(0)-1 126899 "RTN","C0CXPATH",434,0) 126900 D QUEUE(QOBLIST,QOXML,S1,E1) 126901 "RTN","C0CXPATH",435,0) 126902 ; S QOTMP=QOXML_"^"_S1_"^"_E1 126903 "RTN","C0CXPATH",436,0) 126904 ; D PUSH(QOBLIST,QOTMP) 126905 "RTN","C0CXPATH",437,0) 127623 "RTN","C0CXPATH",691,0) 127624 ; 127625 "RTN","C0CXPATH",692,0) 127626 DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE 127627 "RTN","C0CXPATH",693,0) 127628 ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE 127629 "RTN","C0CXPATH",694,0) 127630 ; 127631 "RTN","C0CXPATH",695,0) 127632 N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED 127633 "RTN","C0CXPATH",696,0) 127634 I DXIN="CCR" D ; NEED TO GO GET CCR TEMPLATE 127635 "RTN","C0CXPATH",697,0) 127636 . D LOAD^C0CCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP 127637 "RTN","C0CXPATH",698,0) 127638 . S DXUSE="DTMP" ; DXUSE IS NAME 127639 "RTN","C0CXPATH",699,0) 127640 E I DXIN="CCD" D ; NEED TO GO GET CCD TEMPLATE 127641 "RTN","C0CXPATH",700,0) 127642 . D LOAD^C0CCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP 127643 "RTN","C0CXPATH",701,0) 127644 . S DXUSE="DTMP" ; DXUSE IS NAME 127645 "RTN","C0CXPATH",702,0) 127646 E S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE 127647 "RTN","C0CXPATH",703,0) 127648 N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE 127649 "RTN","C0CXPATH",704,0) 127650 D XVARS("DVARS",DXUSE) ; PULL OUT VARS 127651 "RTN","C0CXPATH",705,0) 127652 D PARY^C0CXPATH("DVARS") ;AND DISPLAY THEM 127653 "RTN","C0CXPATH",706,0) 126906 127654 Q 126907 "RTN","C0CXPATH",438,0) 126908 ; 126909 "RTN","C0CXPATH",439,0) 126910 QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN 126911 "RTN","C0CXPATH",440,0) 126912 ; ADDS THE LIST LINE OF QCXML TO QCBLIST 126913 "RTN","C0CXPATH",441,0) 126914 ; USED TO FINISH INSERTING CHILDERN NODES 126915 "RTN","C0CXPATH",442,0) 126916 ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END 126917 "RTN","C0CXPATH",443,0) 126918 ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO 126919 "RTN","C0CXPATH",444,0) 126920 I @QCXML@(0)<1 D ; MALFORMED XML 126921 "RTN","C0CXPATH",445,0) 126922 . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,! 126923 "RTN","C0CXPATH",446,0) 126924 I $G(DEBUG) W "GOING TO CLOSE",! 126925 "RTN","C0CXPATH",447,0) 126926 N S1,E1,QCT,QCTMP 126927 "RTN","C0CXPATH",448,0) 126928 S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML 126929 "RTN","C0CXPATH",449,0) 126930 I $D(QCXPATH) D ; XPATH PROVIDED 126931 "RTN","C0CXPATH",450,0) 126932 . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX 126933 "RTN","C0CXPATH",451,0) 126934 . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML 126935 "RTN","C0CXPATH",452,0) 126936 I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT 126937 "RTN","C0CXPATH",453,0) 126938 . S S1=@QCXML@(0) 126939 "RTN","C0CXPATH",454,0) 126940 D QUEUE(QCBLIST,QCXML,S1,E1) 126941 "RTN","C0CXPATH",455,0) 126942 ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1) 126943 "RTN","C0CXPATH",456,0) 127655 "RTN","C0CXPATH",707,0) 127656 ; 127657 "RTN","C0CXPATH",708,0) 127658 TEST ; Run all the test cases 127659 "RTN","C0CXPATH",709,0) 127660 D TESTALL^C0CUNIT("C0CXPAT0") 127661 "RTN","C0CXPATH",710,0) 126944 127662 Q 126945 "RTN","C0CXPATH",457,0) 126946 ; 126947 "RTN","C0CXPATH",458,0) 126948 INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE 126949 "RTN","C0CXPATH",459,0) 126950 ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS 126951 "RTN","C0CXPATH",460,0) 126952 ; OMITTED, INSERTION WILL BE AT THE ROOT 126953 "RTN","C0CXPATH",461,0) 126954 ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW 126955 "RTN","C0CXPATH",462,0) 126956 ; XML AT THE END OF THE XPATH POINT 126957 "RTN","C0CXPATH",463,0) 126958 ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE 126959 "RTN","C0CXPATH",464,0) 126960 N INSBLD,INSTMP 126961 "RTN","C0CXPATH",465,0) 126962 I $G(DEBUG) W "DOING INSERT ",INSXML,INSNEW,INSXPATH,! 126963 "RTN","C0CXPATH",466,0) 126964 I $G(DEBUG) F G1=1:1:@INSXML@(0) W @INSXML@(G1),! 126965 "RTN","C0CXPATH",467,0) 126966 I '$D(@INSXML@(1)) D ; INSERT INTO AN EMPTY ARRAY 126967 "RTN","C0CXPATH",468,0) 126968 . D CP^C0CXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT 126969 "RTN","C0CXPATH",469,0) 126970 I $D(@INSXML@(1)) D ; IF ORIGINAL ARRAY IS NOT EMPTY 126971 "RTN","C0CXPATH",470,0) 126972 . I '$D(@INSXML@(0)) S @INSXML@(0)=$O(@INSXML@(""),-1) ;SET LENGTH 126973 "RTN","C0CXPATH",471,0) 126974 . I $D(INSXPATH) D ; XPATH PROVIDED 126975 "RTN","C0CXPATH",472,0) 126976 . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE 126977 "RTN","C0CXPATH",473,0) 126978 . . I $G(DEBUG) D PARY^C0CXPATH("INSBLD") 126979 "RTN","C0CXPATH",474,0) 126980 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT 126981 "RTN","C0CXPATH",475,0) 126982 . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH 126983 "RTN","C0CXPATH",476,0) 126984 . I '$D(@INSNEW@(0)) S @INSNEW@(0)=$O(@INSNEW@(""),-1) ;SIZE OF XML 126985 "RTN","C0CXPATH",477,0) 126986 . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML 126987 "RTN","C0CXPATH",478,0) 126988 . I $D(INSXPATH) D ; XPATH PROVIDED 126989 "RTN","C0CXPATH",479,0) 126990 . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH 126991 "RTN","C0CXPATH",480,0) 126992 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT 126993 "RTN","C0CXPATH",481,0) 126994 . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH 126995 "RTN","C0CXPATH",482,0) 126996 . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST 126997 "RTN","C0CXPATH",483,0) 126998 . D CP^C0CXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE 126999 "RTN","C0CXPATH",484,0) 127663 "RTN","C0CXPATH",711,0) 127664 ; 127665 "RTN","C0CXPATH",712,0) 127666 ZTEST(WHICH) ; RUN ONE SET OF TESTS 127667 "RTN","C0CXPATH",713,0) 127668 N ZTMP 127669 "RTN","C0CXPATH",714,0) 127670 S DEBUG=1 127671 "RTN","C0CXPATH",715,0) 127672 D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0") 127673 "RTN","C0CXPATH",716,0) 127674 D ZTEST^C0CUNIT(.ZTMP,WHICH) 127675 "RTN","C0CXPATH",717,0) 127000 127676 Q 127001 "RTN","C0CXPATH",485,0) 127002 ; 127003 "RTN","C0CXPATH",486,0) 127004 INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW 127005 "RTN","C0CXPATH",487,0) 127006 ; INTO INNXML AT THE INNXPATH XPATH POINT 127007 "RTN","C0CXPATH",488,0) 127008 ; 127009 "RTN","C0CXPATH",489,0) 127010 N INNBLD,UXPATH 127011 "RTN","C0CXPATH",490,0) 127012 N INNTBUF 127013 "RTN","C0CXPATH",491,0) 127014 S INNTBUF=$NA(^TMP($J,"INNTBUF")) 127015 "RTN","C0CXPATH",492,0) 127016 I '$D(INNXPATH) D ; XPATH NOT PASSED 127017 "RTN","C0CXPATH",493,0) 127018 . S UXPATH="//" ; USE ROOT XPATH 127019 "RTN","C0CXPATH",494,0) 127020 I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED 127021 "RTN","C0CXPATH",495,0) 127022 I '$D(@INNXML@(0)) D ; INNXML IS EMPTY 127023 "RTN","C0CXPATH",496,0) 127024 . D QUEUE^C0CXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER 127025 "RTN","C0CXPATH",497,0) 127026 . D BUILD("INNBLD",INNXML) 127027 "RTN","C0CXPATH",498,0) 127028 I @INNXML@(0)>0 D ; NOT EMPTY 127029 "RTN","C0CXPATH",499,0) 127030 . D QOPEN("INNBLD",INNXML,UXPATH) ; 127031 "RTN","C0CXPATH",500,0) 127032 . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML 127033 "RTN","C0CXPATH",501,0) 127034 . D QCLOSE("INNBLD",INNXML,UXPATH) 127035 "RTN","C0CXPATH",502,0) 127036 . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER 127037 "RTN","C0CXPATH",503,0) 127038 . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST 127039 "RTN","C0CXPATH",504,0) 127677 "RTN","C0CXPATH",718,0) 127678 ; 127679 "RTN","C0CXPATH",719,0) 127680 TLIST ; LIST THE TESTS 127681 "RTN","C0CXPATH",720,0) 127682 N ZTMP 127683 "RTN","C0CXPATH",721,0) 127684 D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0") 127685 "RTN","C0CXPATH",722,0) 127686 D TLIST^C0CUNIT(.ZTMP) 127687 "RTN","C0CXPATH",723,0) 127040 127688 Q 127041 "RTN","C0CXPATH",505,0)127042 ;127043 "RTN","C0CXPATH",506,0)127044 INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST127045 "RTN","C0CXPATH",507,0)127046 ; BUT XDEST AN XNEW ARE PASSED BY NAME127047 "RTN","C0CXPATH",508,0)127048 N XBLD,XTMP127049 "RTN","C0CXPATH",509,0)127050 D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT127051 "RTN","C0CXPATH",510,0)127052 D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST127053 "RTN","C0CXPATH",511,0)127054 D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION127055 "RTN","C0CXPATH",512,0)127056 D BUILD("XBLD","XTMP") ; BUILD THE RESULT127057 "RTN","C0CXPATH",513,0)127058 D CP("XTMP",XDEST) ; COPY TO THE DESTINATION127059 "RTN","C0CXPATH",514,0)127060 I $G(DEBUG) D PARY("XDEST")127061 "RTN","C0CXPATH",515,0)127062 Q127063 "RTN","C0CXPATH",516,0)127064 ;127065 "RTN","C0CXPATH",517,0)127066 REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT127067 "RTN","C0CXPATH",518,0)127068 ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE127069 "RTN","C0CXPATH",519,0)127070 ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE127071 "RTN","C0CXPATH",520,0)127072 ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")127073 "RTN","C0CXPATH",521,0)127074 N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP127075 "RTN","C0CXPATH",522,0)127076 S OLD=$NA(^TMP($J,"REPLACE_OLD"))127077 "RTN","C0CXPATH",523,0)127078 D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD127079 "RTN","C0CXPATH",524,0)127080 S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS127081 "RTN","C0CXPATH",525,0)127082 S XFIRST=$P(XNODE,"^",1)127083 "RTN","C0CXPATH",526,0)127084 S XLAST=$P(XNODE,"^",2)127085 "RTN","C0CXPATH",527,0)127086 I RENEW="" D ; WE ARE DELETING A SECTION, MUST SAVE THE TAG127087 "RTN","C0CXPATH",528,0)127088 . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE127089 "RTN","C0CXPATH",529,0)127090 . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST127091 "RTN","C0CXPATH",530,0)127092 I RENEW'="" D ; NEW XML IS NOT NULL127093 "RTN","C0CXPATH",531,0)127094 . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE127095 "RTN","C0CXPATH",532,0)127096 . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW127097 "RTN","C0CXPATH",533,0)127098 . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST127099 "RTN","C0CXPATH",534,0)127100 I $G(DEBUG) W "REPLACE PREBUILD",!127101 "RTN","C0CXPATH",535,0)127102 I $G(DEBUG) D PARY("REBLD")127103 "RTN","C0CXPATH",536,0)127104 D BUILD("REBLD","RTMP")127105 "RTN","C0CXPATH",537,0)127106 K @REXML ; KILL WHAT WAS THERE127107 "RTN","C0CXPATH",538,0)127108 D CP("RTMP",REXML) ; COPY IN THE RESULT127109 "RTN","C0CXPATH",539,0)127110 Q127111 "RTN","C0CXPATH",540,0)127112 ;127113 "RTN","C0CXPATH",541,0)127114 DELETE(REXML,REXPATH) ; DELETE THE XML AT THE XPATH POINT127115 "RTN","C0CXPATH",542,0)127116 ; REXML IS PASSED BY NAME XPATH IS A VALUE127117 "RTN","C0CXPATH",543,0)127118 N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP127119 "RTN","C0CXPATH",544,0)127120 S OLD=$NA(^TMP($J,"REPLACE_OLD"))127121 "RTN","C0CXPATH",545,0)127122 D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD127123 "RTN","C0CXPATH",546,0)127124 S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS127125 "RTN","C0CXPATH",547,0)127126 S XFIRST=$P(XNODE,"^",1)127127 "RTN","C0CXPATH",548,0)127128 S XLAST=$P(XNODE,"^",2)127129 "RTN","C0CXPATH",549,0)127130 D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE127131 "RTN","C0CXPATH",550,0)127132 D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST127133 "RTN","C0CXPATH",551,0)127134 I $G(DEBUG) D PARY("REBLD")127135 "RTN","C0CXPATH",552,0)127136 D BUILD("REBLD","RTMP")127137 "RTN","C0CXPATH",553,0)127138 K @REXML ; KILL WHAT WAS THERE127139 "RTN","C0CXPATH",554,0)127140 D CP("RTMP",REXML) ; COPY IN THE RESULT127141 "RTN","C0CXPATH",555,0)127142 Q127143 "RTN","C0CXPATH",556,0)127144 ;127145 "RTN","C0CXPATH",557,0)127146 MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY127147 "RTN","C0CXPATH",558,0)127148 ; W "Reporting on the missing",!127149 "RTN","C0CXPATH",559,0)127150 ; W OARY127151 "RTN","C0CXPATH",560,0)127152 I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q127153 "RTN","C0CXPATH",561,0)127154 N I127155 "RTN","C0CXPATH",562,0)127156 S @OARY@(0)=0 ; INITIALIZED MISSING COUNT127157 "RTN","C0CXPATH",563,0)127158 F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY127159 "RTN","C0CXPATH",564,0)127160 . I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE127161 "RTN","C0CXPATH",565,0)127162 . . D PUSH^C0CXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY127163 "RTN","C0CXPATH",566,0)127164 . . Q127165 "RTN","C0CXPATH",567,0)127166 Q127167 "RTN","C0CXPATH",568,0)127168 ;127169 "RTN","C0CXPATH",569,0)127170 MAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY127171 "RTN","C0CXPATH",570,0)127172 ; AND PUT THE RESULTS IN OXML127173 "RTN","C0CXPATH",571,0)127174 N XCNT127175 "RTN","C0CXPATH",572,0)127176 I '$D(DEBUG) S DEBUG=0127177 "RTN","C0CXPATH",573,0)127178 I '$D(IXML) W "MALFORMED XML PASSED TO MAP",! Q127179 "RTN","C0CXPATH",574,0)127180 I '$D(@IXML@(0)) D ; INITIALIZE COUNT127181 "RTN","C0CXPATH",575,0)127182 . S XCNT=$O(@IXML@(""),-1)127183 "RTN","C0CXPATH",576,0)127184 E S XCNT=@IXML@(0) ;COUNT127185 "RTN","C0CXPATH",577,0)127186 I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q127187 "RTN","C0CXPATH",578,0)127188 N I,J,TNAM,TVAL,TSTR127189 "RTN","C0CXPATH",579,0)127190 S @OXML@(0)=XCNT ; TOTAL LINES IN OUTPUT127191 "RTN","C0CXPATH",580,0)127192 F I=1:1:XCNT D ; LOOP THROUGH WHOLE ARRAY127193 "RTN","C0CXPATH",581,0)127194 . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT127195 "RTN","C0CXPATH",582,0)127196 . I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE?127197 "RTN","C0CXPATH",583,0)127198 . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS127199 "RTN","C0CXPATH",584,0)127200 . . F J=2:2:10 D Q:$P(@IXML@(I),"@@",J+2)="" ; QUIT IF NO MORE VARS127201 "RTN","C0CXPATH",585,0)127202 . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!127203 "RTN","C0CXPATH",586,0)127204 . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME127205 "RTN","C0CXPATH",587,0)127206 . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED127207 "RTN","C0CXPATH",588,0)127208 . . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP?127209 "RTN","C0CXPATH",589,0)127210 . . . . I '$D(@INARY@(TNAM,"F")) D ; NOT A SPECIAL FIELD127211 "RTN","C0CXPATH",590,0)127212 . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE127213 "RTN","C0CXPATH",591,0)127214 . . . . E D DOFLD ; PROCESS A FIELD127215 "RTN","C0CXPATH",592,0)127216 . . . S TVAL=$$SYMENC^MXMLUTL(TVAL) ;MAKE SURE THE VALUE IS XML SAFE127217 "RTN","C0CXPATH",593,0)127218 . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER127219 "RTN","C0CXPATH",594,0)127220 . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES127221 "RTN","C0CXPATH",595,0)127222 . . I DEBUG W TSTR127223 "RTN","C0CXPATH",596,0)127224 I DEBUG W "MAPPED",!127225 "RTN","C0CXPATH",597,0)127226 Q127227 "RTN","C0CXPATH",598,0)127228 ;127229 "RTN","C0CXPATH",599,0)127230 DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE127231 "RTN","C0CXPATH",600,0)127232 ;127233 "RTN","C0CXPATH",601,0)127234 Q127235 "RTN","C0CXPATH",602,0)127236 ;127237 "RTN","C0CXPATH",603,0)127238 TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS127239 "RTN","C0CXPATH",604,0)127240 ; THEXML IS PASSED BY NAME127241 "RTN","C0CXPATH",605,0)127242 N I,J,TMPXML,DEL,FOUND,INTXT127243 "RTN","C0CXPATH",606,0)127244 S FOUND=0127245 "RTN","C0CXPATH",607,0)127246 S INTXT=0127247 "RTN","C0CXPATH",608,0)127248 I $G(DEBUG) W "DELETING EMPTY ELEMENTS",!127249 "RTN","C0CXPATH",609,0)127250 F I=1:1:(@THEXML@(0)-1) D ; LOOP THROUGH ENTIRE ARRAY127251 "RTN","C0CXPATH",610,0)127252 . S J=@THEXML@(I)127253 "RTN","C0CXPATH",611,0)127254 . I J["<text>" D127255 "RTN","C0CXPATH",612,0)127256 . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM127257 "RTN","C0CXPATH",613,0)127258 . . I $G(DEBUG) W "IN HTML SECTION",!127259 "RTN","C0CXPATH",614,0)127260 . N JM,JP,JPX ; JMINUS AND JPLUS127261 "RTN","C0CXPATH",615,0)127262 . S JM=@THEXML@(I-1) ; LINE BEFORE127263 "RTN","C0CXPATH",616,0)127264 . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM127265 "RTN","C0CXPATH",617,0)127266 . S JP=@THEXML@(I+1) ; LINE AFTER127267 "RTN","C0CXPATH",618,0)127268 . I INTXT=0 D ; IF NOT IN AN HTML SECTION127269 "RTN","C0CXPATH",619,0)127270 . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH127271 "RTN","C0CXPATH",620,0)127272 . . I J=JPX D ; AN EMPTY ELEMENT ON TWO LINES127273 "RTN","C0CXPATH",621,0)127274 . . . I $G(DEBUG) W I,J,JP,!127275 "RTN","C0CXPATH",622,0)127276 . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED127277 "RTN","C0CXPATH",623,0)127278 . . . S DEL(I)="" ; SET LINE TO DELETE127279 "RTN","C0CXPATH",624,0)127280 . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE127281 "RTN","C0CXPATH",625,0)127282 . . I J["><" D ; AN EMPTY ELEMENT ON ONE LINE127283 "RTN","C0CXPATH",626,0)127284 . . . I $G(DEBUG) W I,J,!127285 "RTN","C0CXPATH",627,0)127286 . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED127287 "RTN","C0CXPATH",628,0)127288 . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED127289 "RTN","C0CXPATH",629,0)127290 . . . I JM=JPX D ;127291 "RTN","C0CXPATH",630,0)127292 . . . . I $G(DEBUG) W I,JM_J_JPX,!127293 "RTN","C0CXPATH",631,0)127294 . . . . S DEL(I-1)=""127295 "RTN","C0CXPATH",632,0)127296 . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL127297 "RTN","C0CXPATH",633,0)127298 ; . I J'["><" D PUSH("TMPXML",J)127299 "RTN","C0CXPATH",634,0)127300 I FOUND D ; NEED TO DELETE THINGS127301 "RTN","C0CXPATH",635,0)127302 . F I=1:1:@THEXML@(0) D ; COPY ARRAY LEAVING OUT DELELTED LINES127303 "RTN","C0CXPATH",636,0)127304 . . I '$D(DEL(I)) D ; IF THE LINE IS NOT DELETED127305 "RTN","C0CXPATH",637,0)127306 . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY127307 "RTN","C0CXPATH",638,0)127308 . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY127309 "RTN","C0CXPATH",639,0)127310 Q FOUND127311 "RTN","C0CXPATH",640,0)127312 ;127313 "RTN","C0CXPATH",641,0)127314 UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML127315 "RTN","C0CXPATH",642,0)127316 ; XSEC IS A SECTION PASSED BY NAME127317 "RTN","C0CXPATH",643,0)127318 N XBLD,XTMP127319 "RTN","C0CXPATH",644,0)127320 D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML127321 "RTN","C0CXPATH",645,0)127322 D BUILD("XBLD","XTMP") ; BUILD THE RESULT127323 "RTN","C0CXPATH",646,0)127324 D CP("XTMP",XSEC) ; REPLACE PASSED XML127325 "RTN","C0CXPATH",647,0)127326 Q127327 "RTN","C0CXPATH",648,0)127328 ;127329 "RTN","C0CXPATH",649,0)127330 PARY(GLO,ZN) ;PRINT AN ARRAY127331 "RTN","C0CXPATH",650,0)127332 ; IF ZN=-1 NO LINE NUMBERS127333 "RTN","C0CXPATH",651,0)127334 N I127335 "RTN","C0CXPATH",652,0)127336 F I=1:1:@GLO@(0) D ;127337 "RTN","C0CXPATH",653,0)127338 . I $G(ZN)=-1 W @GLO@(I),!127339 "RTN","C0CXPATH",654,0)127340 . E W I_" "_@GLO@(I),!127341 "RTN","C0CXPATH",655,0)127342 Q127343 "RTN","C0CXPATH",656,0)127344 ;127345 "RTN","C0CXPATH",657,0)127346 H2ARY(IARYRTN,IHASH,IPRE) ; CONVERT IHASH TO RETURN ARRAY127347 "RTN","C0CXPATH",658,0)127348 ; IPRE IS OPTIONAL PREFIX FOR THE ELEMENTS. USED FOR MUPTIPLES 1^"VAR"^VALUE127349 "RTN","C0CXPATH",659,0)127350 I '$D(IPRE) S IPRE=""127351 "RTN","C0CXPATH",660,0)127352 N H2I S H2I=""127353 "RTN","C0CXPATH",661,0)127354 ; W $O(@IHASH@(H2I)),!127355 "RTN","C0CXPATH",662,0)127356 F S H2I=$O(@IHASH@(H2I)) Q:H2I="" D ; FOR EACH ELEMENT OF THE HASH127357 "RTN","C0CXPATH",663,0)127358 . I $QS(H2I,$QL(H2I))="M" D Q ; SPECIAL CASE FOR MULTIPLES127359 "RTN","C0CXPATH",664,0)127360 . . ;W H2I_"^"_@IHASH@(H2I),!127361 "RTN","C0CXPATH",665,0)127362 . . N IH,IHI127363 "RTN","C0CXPATH",666,0)127364 . . S IH=$NA(@IHASH@(H2I)) ;127365 "RTN","C0CXPATH",667,0)127366 . . S IH2A=$O(@IH@("")) ; SKIP OVER MULTIPLE DISCRIPTOR127367 "RTN","C0CXPATH",668,0)127368 . . S IH2=$NA(@IH@(IH2A)) ; PAST THE "M","DIRETIONS" FOR EXAMPLE127369 "RTN","C0CXPATH",669,0)127370 . . S IHI="" ; INDEX INTO "M" MULTIPLES127371 "RTN","C0CXPATH",670,0)127372 . . F S IHI=$O(@IH2@(IHI)) Q:IHI="" D ; FOR EACH SUB-MULTIPLE127373 "RTN","C0CXPATH",671,0)127374 . . . ; W @IH@(IHI)127375 "RTN","C0CXPATH",672,0)127376 . . . S IH3=$NA(@IH2@(IHI))127377 "RTN","C0CXPATH",673,0)127378 . . . ; W "HEY",IH3,!127379 "RTN","C0CXPATH",674,0)127380 . . . D H2ARY(.IARYRTN,IH3,IPRE_";"_IHI) ; RECURSIVE CALL - INDENTED ELEMENTS127381 "RTN","C0CXPATH",675,0)127382 . . ; W IH,!127383 "RTN","C0CXPATH",676,0)127384 . . ; W "C0CZZ",!127385 "RTN","C0CXPATH",677,0)127386 . . ; W $NA(@IHASH@(H2I)),!127387 "RTN","C0CXPATH",678,0)127388 . . Q ;127389 "RTN","C0CXPATH",679,0)127390 . D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I))127391 "RTN","C0CXPATH",680,0)127392 . ; W @IARYRTN@(0),!127393 "RTN","C0CXPATH",681,0)127394 Q127395 "RTN","C0CXPATH",682,0)127396 ;127397 "RTN","C0CXPATH",683,0)127398 XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES127399 "RTN","C0CXPATH",684,0)127400 ; DEFINED IN INPUT XML XVIXML BY @@VAR@@127401 "RTN","C0CXPATH",685,0)127402 ; XVRTN AND XVIXML ARE PASSED BY NAME127403 "RTN","C0CXPATH",686,0)127404 ;127405 "RTN","C0CXPATH",687,0)127406 N XVI,XVTMP,XVT127407 "RTN","C0CXPATH",688,0)127408 F XVI=1:1:@XVIXML@(0) D ; FOR ALL LINES OF THE XML127409 "RTN","C0CXPATH",689,0)127410 . S XVT=@XVIXML@(XVI)127411 "RTN","C0CXPATH",690,0)127412 . I XVT["@@" S XVTMP($P(XVT,"@@",2))=XVI127413 "RTN","C0CXPATH",691,0)127414 D H2ARY(XVRTN,"XVTMP")127415 "RTN","C0CXPATH",692,0)127416 Q127417 "RTN","C0CXPATH",693,0)127418 ;127419 "RTN","C0CXPATH",694,0)127420 DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE127421 "RTN","C0CXPATH",695,0)127422 ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE127423 "RTN","C0CXPATH",696,0)127424 ;127425 "RTN","C0CXPATH",697,0)127426 N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED127427 "RTN","C0CXPATH",698,0)127428 I DXIN="CCR" D ; NEED TO GO GET CCR TEMPLATE127429 "RTN","C0CXPATH",699,0)127430 . D LOAD^C0CCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP127431 "RTN","C0CXPATH",700,0)127432 . S DXUSE="DTMP" ; DXUSE IS NAME127433 "RTN","C0CXPATH",701,0)127434 E I DXIN="CCD" D ; NEED TO GO GET CCD TEMPLATE127435 "RTN","C0CXPATH",702,0)127436 . D LOAD^C0CCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP127437 "RTN","C0CXPATH",703,0)127438 . S DXUSE="DTMP" ; DXUSE IS NAME127439 "RTN","C0CXPATH",704,0)127440 E S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE127441 "RTN","C0CXPATH",705,0)127442 N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE127443 "RTN","C0CXPATH",706,0)127444 D XVARS("DVARS",DXUSE) ; PULL OUT VARS127445 "RTN","C0CXPATH",707,0)127446 D PARY^C0CXPATH("DVARS") ;AND DISPLAY THEM127447 "RTN","C0CXPATH",708,0)127448 Q127449 "RTN","C0CXPATH",709,0)127450 ;127451 "RTN","C0CXPATH",710,0)127452 TEST ; Run all the test cases127453 "RTN","C0CXPATH",711,0)127454 D TESTALL^C0CUNIT("C0CXPAT0")127455 "RTN","C0CXPATH",712,0)127456 Q127457 "RTN","C0CXPATH",713,0)127458 ;127459 "RTN","C0CXPATH",714,0)127460 ZTEST(WHICH) ; RUN ONE SET OF TESTS127461 "RTN","C0CXPATH",715,0)127462 N ZTMP127463 "RTN","C0CXPATH",716,0)127464 S DEBUG=1127465 "RTN","C0CXPATH",717,0)127466 D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")127467 "RTN","C0CXPATH",718,0)127468 D ZTEST^C0CUNIT(.ZTMP,WHICH)127469 "RTN","C0CXPATH",719,0)127470 Q127471 "RTN","C0CXPATH",720,0)127472 ;127473 "RTN","C0CXPATH",721,0)127474 TLIST ; LIST THE TESTS127475 "RTN","C0CXPATH",722,0)127476 N ZTMP127477 "RTN","C0CXPATH",723,0)127478 D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")127479 127689 "RTN","C0CXPATH",724,0) 127480 D TLIST^C0CUNIT(.ZTMP)127481 "RTN","C0CXPATH",725,0)127482 Q127483 "RTN","C0CXPATH",726,0)127484 127690 ; 127485 127691 "SEC","^DIC",170,170,0,"AUDIT") … … 127660 127866 127661 127867 "^DD",170,170,0,"VRPK") 127662 C 0C127868 CCD/CCR GENERATION UTILITIES 127663 127869 "^DD",170,170,.01,0) 127664 127870 AVARIABLE^RF^^0;1^K:$L(X)>30!($L(X)<2)!'(X'?1P.E) X … … 127838 128044 127839 128045 "^DD",170.101,170.101,0,"VRPK") 127840 C 0C128046 CCD/CCR GENERATION UTILITIES 127841 128047 "^DD",170.101,170.101,.01,0) 127842 128048 NODE TYPE^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X … … 127930 128136 127931 128137 "^DD",170.9,170.9,0,"VRPK") 127932 C 0C128138 CCD/CCR GENERATION UTILITIES 127933 128139 "^DD",170.9,170.9,.01,0) 127934 128140 NAME^RF^^0;1^K:$L(X)>30!(X?.N)!($L(X)<3)!'(X'?1P.E) X … … 128032 128238 128033 128239 "^DD",171.101,171.101,0,"VRPK") 128034 C 0C128240 CCD/CCR GENERATION UTILITIES 128035 128241 "^DD",171.101,171.101,.01,0) 128036 128242 PATIENT^RP2'^DPT(^0;1^Q … … 128192 128398 128193 128399 "^DD",171.401,171.401,0,"VRPK") 128194 C 0C128400 CCD/CCR GENERATION UTILITIES 128195 128401 "^DD",171.401,171.401,.01,0) 128196 128402 NAME^RF^^0;1^K:$L(X)>30!(X?.N)!($L(X)<3)!'(X'?1P.E) X … … 128278 128484 128279 128485 "^DD",175,175,0,"VRPK") 128280 C 0C128486 CCD/CCR GENERATION UTILITIES 128281 128487 "^DD",175,175,.01,0) 128282 128488 PATIENT^RP2'^DPT(^0;1^Q … … 128542 128748 128543 128749 "^DD",176.112,176.112,0,"VRPK") 128544 C 0C128750 CCD/CCR GENERATION UTILITIES 128545 128751 "^DD",176.112,176.112,.01,0) 128546 128752 VUID^RF^^0;1^K:$L(X)>30!(X?.N)!($L(X)<3)!'(X'?1P.E) X … … 128614 128820 128615 128821 "^DD",177.101,177.101,0,"VRPK") 128616 C 0C128822 CCD/CCR GENERATION UTILITIES 128617 128823 "^DD",177.101,177.101,.01,0) 128618 128824 PATIENT^RP2'^DPT(^0;1^Q … … 128736 128942 128737 128943 "^DD",177.201,177.201,0,"VRPK") 128738 C 0C128944 CCD/CCR GENERATION UTILITIES 128739 128945 "^DD",177.201,177.201,.01,0) 128740 128946 SUBSCRIBER NAME^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X … … 128788 128994 128789 128995 "^DD",177.301,177.301,0,"VRPK") 128790 C 0C128996 CCD/CCR GENERATION UTILITIES 128791 128997 "^DD",177.301,177.301,.01,0) 128792 128998 CCR BATCH RUN DATE/TIME^RD^^0;1^S %DT="ESTXR" D ^%DT S X=Y K:X<1 X … … 128942 129148 128943 129149 "^DD",178.101,178.101,0,"VRPK") 128944 C 0C129150 CCD/CCR GENERATION UTILITIES 128945 129151 "^DD",178.101,178.101,.01,0) 128946 129152 NAME^RF^^0;1^K:$L(X)>80!($L(X)<3)!'(X'?1P.E) X … … 129150 129356 129151 129357 "^DD",178.301,178.301,0,"VRPK") 129152 C 0C129358 CCD/CCR GENERATION UTILITIES 129153 129359 "^DD",178.301,178.301,.01,0) 129154 129360 TEMPLATE NAME^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X -
ccr/tags/CCD-CCR_GENERATION_UTILITIES_1P2/README.txt
r1553 r1588 1 1 CCR Package version 1.2 2 3 License: AGPL v3. 4 http://www.gnu.org/licenses/agpl-3.0.html 2 5 3 6 The purpose of the CCR package is to provide support for exporting and eventually importing patient information from/to VistA in XML documents conforming to the Continuity of Care Record (CCR - ASTM) and Continuity of Care Document (CCD - HL7) standards.
Note:
See TracChangeset
for help on using the changeset viewer.
