Changeset 1587 for ccr/trunk/kids/CCD-CCR_GENERATION_UTILITIES_1P2.KID
- Timestamp:
- Oct 30, 2012, 1:14:48 PM (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/kids/CCD-CCR_GENERATION_UTILITIES_1P2.KID
r1550 r1587 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 &n