Index: /ccr/trunk/kids/CCD-CCR_GENERATION_UTILITIES_1P2.KID
===================================================================
--- /ccr/trunk/kids/CCD-CCR_GENERATION_UTILITIES_1P2.KID	(revision 1586)
+++ /ccr/trunk/kids/CCD-CCR_GENERATION_UTILITIES_1P2.KID	(revision 1587)
@@ -1,927 +1,933 @@
-KIDS Distribution saved on Jun 25, 2012@10:01:50
-Changed name to full Package Name rather than nmsp
+KIDS Distribution saved on Oct 30, 2012@10:27:50
+CCD/CCR Generation Package Version 1.2
 **KIDS**:CCD/CCR GENERATION UTILITIES 1.2^
 
 **INSTALL NAME**
 CCD/CCR GENERATION UTILITIES 1.2
-"BLD",7891,0)
-CCD/CCR GENERATION UTILITIES 1.2^CCD/CCR GENERATION UTILITIES^0^3120625^n
-"BLD",7891,1,0)
-^^185^185^3120511^^^^
-"BLD",7891,1,1,0)
+"BLD",7883,0)
+CCD/CCR GENERATION UTILITIES 1.2^CCD/CCR GENERATION UTILITIES^0^3121030^n
+"BLD",7883,1,0)
+^^188^188^3121029^
+"BLD",7883,1,1,0)
+Licensed under AGPL v3. For complete license text, see
+"BLD",7883,1,2,0)
+http://www.gnu.org/licenses/agpl-3.0.html
+"BLD",7883,1,3,0)
+ 
+"BLD",7883,1,4,0)
 CCR Project release v1.2
-"BLD",7891,1,2,0)
+"BLD",7883,1,5,0)
  
-"BLD",7891,1,3,0)
+"BLD",7883,1,6,0)
 The purpose of the CCR package is to provide support for exporting and 
-"BLD",7891,1,4,0)
+"BLD",7883,1,7,0)
 eventually importing patient information from/to VistA in XML documents 
-"BLD",7891,1,5,0)
+"BLD",7883,1,8,0)
 conforming to the Continuity of Care Record (CCR - ASTM) and Continuity 
-"BLD",7891,1,6,0)
+"BLD",7883,1,9,0)
 of Care Document (CCD - HL7) standards.
-"BLD",7891,1,7,0)
+"BLD",7883,1,10,0)
  
-"BLD",7891,1,8,0)
+"BLD",7883,1,11,0)
 This version of the CCR package provides:
-"BLD",7891,1,9,0)
+"BLD",7883,1,12,0)
  
-"BLD",7891,1,10,0)
+"BLD",7883,1,13,0)
 EXPORT^C0CCCR
-"BLD",7891,1,11,0)
+"BLD",7883,1,14,0)
 A command line interface to export a single patient's CCR to a host 
-"BLD",7891,1,12,0)
+"BLD",7883,1,15,0)
 directory by specifying the patient by name.
-"BLD",7891,1,13,0)
+"BLD",7883,1,16,0)
  
-"BLD",7891,1,14,0)
+"BLD",7883,1,17,0)
 EXPORT^C0CCCD
-"BLD",7891,1,15,0)
+"BLD",7883,1,18,0)
 A command line interface to export a single patient's CCD to a host 
-"BLD",7891,1,16,0)
+"BLD",7883,1,19,0)
 directory by specifying the patient by name. As an alternative to 
-"BLD",7891,1,17,0)
+"BLD",7883,1,20,0)
 generating the CCD directly, an XSLT transformation is available to 
-"BLD",7891,1,18,0)
+"BLD",7883,1,21,0)
 translate a CCR into a level 2 CCD. This tranformation has been tested 
-"BLD",7891,1,19,0)
+"BLD",7883,1,22,0)
 and produces a CCD with all currently supported sections of the CCR. The 
-"BLD",7891,1,20,0)
+"BLD",7883,1,23,0)
 EXPORT^C0CCCD only extracts the PROBLEMS section into a CCD.
-"BLD",7891,1,21,0)
+"BLD",7883,1,24,0)
  
-"BLD",7891,1,22,0)
+"BLD",7883,1,25,0)
 XPAT^C0CCCR(DFN,OUTDIR,OUTFILE)
-"BLD",7891,1,23,0)
+"BLD",7883,1,26,0)
 A command line and program interface to export a single patient's CCR 
-"BLD",7891,1,24,0)
+"BLD",7883,1,27,0)
 using the IEN of the patient in the ^DPT file (DFN).
-"BLD",7891,1,25,0)
+"BLD",7883,1,28,0)
 OUTDIR specifies an existing directory on the Host system into which the 
-"BLD",7891,1,26,0)
+"BLD",7883,1,29,0)
 CCR XML document will be written. If OUTDIR is null (""), the output 
-"BLD",7891,1,27,0)
+"BLD",7883,1,30,0)
 directory name will be taken from ^TMP("C0CCCR","ODIR").
-"BLD",7891,1,28,0)
+"BLD",7883,1,31,0)
 OUFILE specifies the host file name of the CCR XML document that will be 
-"BLD",7891,1,29,0)
+"BLD",7883,1,32,0)
 written for this patient. If OUTFILE is null ("") the document name will 
-"BLD",7891,1,30,0)
+"BLD",7883,1,33,0)
 default to PAT_x_CCR_V1.xml where x is the DFN of the patient.
-"BLD",7891,1,31,0)
+"BLD",7883,1,34,0)
  
-"BLD",7891,1,32,0)
+"BLD",7883,1,35,0)
 CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART)
-"BLD",7891,1,33,0)
+"BLD",7883,1,36,0)
 An RPC and program interface to return in return array CCRGRTN (passed by 
-"BLD",7891,1,34,0)
+"BLD",7883,1,37,0)
 reference) a single patient's CCR.
-"BLD",7891,1,35,0)
+"BLD",7883,1,38,0)
 DFN is the patient's IEN
-"BLD",7891,1,36,0)
+"BLD",7883,1,39,0)
 CCRPART is what portion of the CCR should be returned. If "CCR" is 
-"BLD",7891,1,37,0)
+"BLD",7883,1,40,0)
 specified, the entire CCR will be returned. If "PROBLEMS", "VITALS", or 
-"BLD",7891,1,38,0)
+"BLD",7883,1,41,0)
 "MEDICATIONS" is specified, only that section of the CCR will be returned.
-"BLD",7891,1,39,0)
+"BLD",7883,1,42,0)
 CCRPARMS ARE PARAMETERS THAT AFFECT THE EXTRACTION
-"BLD",7891,1,40,0)
+"BLD",7883,1,43,0)
 IN THE FORM "PARM1:VALUE1^PARM2:VALUE2"
-"BLD",7891,1,41,0)
+"BLD",7883,1,44,0)
 EXAMPLE: "LABLIMIT:T-60" TO LIMIT LAB EXTRACTION TO THE LAST 60 DAYS
-"BLD",7891,1,42,0)
+"BLD",7883,1,45,0)
 SEE C0CPARMS FOR A COMPLETE LIST OF SUPPORTED PARAMETERS
-"BLD",7891,1,43,0)
+"BLD",7883,1,46,0)
  
-"BLD",7891,1,44,0)
+"BLD",7883,1,47,0)
 ANALYZE^C0CRIMA(BGNDFN,DFNCNT,CCRPARMS)
-"BLD",7891,1,45,0)
+"BLD",7883,1,48,0)
 A command line and program interface to analyze the data from multiple 
-"BLD",7891,1,46,0)
+"BLD",7883,1,49,0)
 patients into categories that can be batch extracted.
-"BLD",7891,1,47,0)
+"BLD",7883,1,50,0)
 BGNDFN is the beginning DFN to be analyzed. If BGNDFN is null ("") its 
-"BLD",7891,1,48,0)
+"BLD",7883,1,51,0)
 value will be taken from ^TMP("C0CRIM","RESUME"). If this variable does 
-"BLD",7891,1,49,0)
+"BLD",7883,1,52,0)
 not exist, the routine will start with the first IEN in the patient file 
-"BLD",7891,1,50,0)
+"BLD",7883,1,53,0)
 ^DPT. ^TMP("C0CRIM","RESUME") is updated to the "next" patient to be 
-"BLD",7891,1,51,0)
+"BLD",7883,1,54,0)
 analyzed on successful completion.
-"BLD",7891,1,52,0)
+"BLD",7883,1,55,0)
 DFNCNT is the count of how many patient records will be analyzed in this 
-"BLD",7891,1,53,0)
+"BLD",7883,1,56,0)
 execution.
-"BLD",7891,1,54,0)
+"BLD",7883,1,57,0)
 For example ANALYZE^C0CRIMA(1000,1000) would start at patient DFN 1000 
-"BLD",7891,1,55,0)
+"BLD",7883,1,58,0)
 and analyzes 1000 patient records. ANALYZE^C0CRIMA("",1000) would then 
-"BLD",7891,1,56,0)
+"BLD",7883,1,59,0)
 analyze the next 1000 patients. When the end of the patient file is 
-"BLD",7891,1,57,0)
+"BLD",7883,1,60,0)
 reached, the routine terminates with a message that RESET^C0CRIMA would 
-"BLD",7891,1,58,0)
+"BLD",7883,1,61,0)
 need to be called to restart the analysis.
-"BLD",7891,1,59,0)
+"BLD",7883,1,62,0)
  
-"BLD",7891,1,60,0)
+"BLD",7883,1,63,0)
 The categories into which the records are analyzed consist of attribute 
-"BLD",7891,1,61,0)
+"BLD",7883,1,64,0)
 strings. The attributes represent characteristics of the variables that 
-"BLD",7891,1,62,0)
+"BLD",7883,1,65,0)
 can be extracted for a given patient into the CCR or the CCD. This 
-"BLD",7891,1,63,0)
+"BLD",7883,1,66,0)
 version supports the following attributes:
-"BLD",7891,1,64,0)
+"BLD",7883,1,67,0)
 VITALS : the patient has variables for the VITALS section of the CCR/CCD
-"BLD",7891,1,65,0)
+"BLD",7883,1,68,0)
 PROBLEMS : the patient has variables for the PROBLEMS section of the 
-"BLD",7891,1,66,0)
+"BLD",7883,1,69,0)
 CCR/CCD
-"BLD",7891,1,67,0)
+"BLD",7883,1,70,0)
 MEDS : the patient has variables for the MEDICATIONS section of the 
-"BLD",7891,1,68,0)
+"BLD",7883,1,71,0)
 CCR/CCD
-"BLD",7891,1,69,0)
+"BLD",7883,1,72,0)
 HEADER : the patient has variables for the HEADER section of the CCR/CCD. 
-"BLD",7891,1,70,0)
+"BLD",7883,1,73,0)
 All patients are marked with the HEADER attribute in this version.
-"BLD",7891,1,71,0)
+"BLD",7883,1,74,0)
 NOTEXTRACTED : the CCR or CCD has not yet been produced/extracted for 
-"BLD",7891,1,72,0)
+"BLD",7883,1,75,0)
 this patient. All patient records are marked with the NOTEXTRACTED 
-"BLD",7891,1,73,0)
+"BLD",7883,1,76,0)
 attribute in this version for batch control processing (not implemented 
-"BLD",7891,1,74,0)
+"BLD",7883,1,77,0)
 in this version).
-"BLD",7891,1,75,0)
+"BLD",7883,1,78,0)
  
-"BLD",7891,1,76,0)
+"BLD",7883,1,79,0)
 ANAZYZE^C0CRIMA calls the variable extraction routines that would be used 
-"BLD",7891,1,77,0)
+"BLD",7883,1,80,0)
 to produce a CCR or a CCD and saves the results to ^TMP("C0CRIM",DFN) for 
-"BLD",7891,1,78,0)
+"BLD",7883,1,81,0)
 each patient. In addition, the attribute string for each patient is saved 
-"BLD",7891,1,79,0)
+"BLD",7883,1,82,0)
 in ^TMP("C0CRIM","ATTR")
-"BLD",7891,1,80,0)
+"BLD",7883,1,83,0)
  
-"BLD",7891,1,81,0)
+"BLD",7883,1,84,0)
 Categories are created as they first occur based on each unique 
-"BLD",7891,1,82,0)
+"BLD",7883,1,85,0)
 combination of attributes that is encountered. They are named after the 
-"BLD",7891,1,83,0)
+"BLD",7883,1,86,0)
 attribute table that is used for the analysis. This version supports only 
-"BLD",7891,1,84,0)
+"BLD",7883,1,87,0)
 the attribute table .RIMTBL. and the categories are named "RIMTBL_x". An 
-"BLD",7891,1,85,0)
+"BLD",7883,1,88,0)
 example set of categories from a demo systems is:
-"BLD",7891,1,86,0)
+"BLD",7883,1,89,0)
  
-"BLD",7891,1,87,0)
+"BLD",7883,1,90,0)
 GTM>D CLIST^C0CRIMA
-"BLD",7891,1,88,0)
+"BLD",7883,1,91,0)
 (RIMTBL_1:105) ^NOTEXTRACTED^HEADER^^^PROBLEMS^^^^^VITALS^^^^^MEDS
-"BLD",7891,1,89,0)
+"BLD",7883,1,92,0)
 (RIMTBL_2:596) ^NOTEXTRACTED^HEADER^^^^^^^^VITALS
-"BLD",7891,1,90,0)
+"BLD",7883,1,93,0)
 (RIMTBL_3:44) ^NOTEXTRACTED^HEADER^^^PROBLEMS^^^^^VITALS
-"BLD",7891,1,91,0)
+"BLD",7883,1,94,0)
 (RIMTBL_4:821) ^NOTEXTRACTED^HEADER
-"BLD",7891,1,92,0)
+"BLD",7883,1,95,0)
 (RIMTBL_5:18) ^NOTEXTRACTED^HEADER^^^^^^^^VITALS^^^^^MEDS
-"BLD",7891,1,93,0)
+"BLD",7883,1,96,0)
 (RIMTBL_6:14) ^NOTEXTRACTED^HEADER^^^PROBLEMS
-"BLD",7891,1,94,0)
+"BLD",7883,1,97,0)
 (RIMTBL_7:15) ^NOTEXTRACTED^HEADER^^^^^^^^^^^^^MEDS
-"BLD",7891,1,95,0)
+"BLD",7883,1,98,0)
 (RIMTBL_8:5) ^NOTEXTRACTED^HEADER^^^PROBLEMS^^^^^^^^^^MEDS
-"BLD",7891,1,96,0)
+"BLD",7883,1,99,0)
  
-"BLD",7891,1,97,0)
+"BLD",7883,1,100,0)
 for RIMTBL_1 in this example, 105 is the record count of patients who 
-"BLD",7891,1,98,0)
+"BLD",7883,1,101,0)
 have this combination of attributes. The list of patients for each 
-"BLD",7891,1,99,0)
+"BLD",7883,1,102,0)
 category is also maintained for batch extraction.
-"BLD",7891,1,100,0)
+"BLD",7883,1,103,0)
  
-"BLD",7891,1,101,0)
+"BLD",7883,1,104,0)
 CLIST^C0CRIMA
-"BLD",7891,1,102,0)
+"BLD",7883,1,105,0)
 A command line interface to show a summary of the categories, record 
-"BLD",7891,1,103,0)
+"BLD",7883,1,106,0)
 counts, and attributes that have been analyzed so far. It produces the 
-"BLD",7891,1,104,0)
+"BLD",7883,1,107,0)
 listing in the example above from information stored in 
-"BLD",7891,1,105,0)
+"BLD",7883,1,108,0)
 ^TMP("C0CRIM","CATS","RIMTBL"). It is intended for future versions that 
-"BLD",7891,1,106,0)
+"BLD",7883,1,109,0)
 attribute tables be supported in addition to the default "RIMTBL".
-"BLD",7891,1,107,0)
+"BLD",7883,1,110,0)
  
-"BLD",7891,1,108,0)
+"BLD",7883,1,111,0)
 CPAT^C0CRIMA(CPATCAT)
-"BLD",7891,1,109,0)
+"BLD",7883,1,112,0)
 A command line interface which shows the DFN numbers of the patients 
-"BLD",7891,1,110,0)
+"BLD",7883,1,113,0)
 represented by the category CPATCAT. DFNs are listed 10 per line. For 
-"BLD",7891,1,111,0)
+"BLD",7883,1,114,0)
 example:
-"BLD",7891,1,112,0)
+"BLD",7883,1,115,0)
  
-"BLD",7891,1,113,0)
+"BLD",7883,1,116,0)
 GTM>D CPAT^C0CRIMA("RIMTBL_1")
-"BLD",7891,1,114,0)
+"BLD",7883,1,117,0)
 1 3 8 25 42 69 123 140 146 149
-"BLD",7891,1,115,0)
+"BLD",7883,1,118,0)
 151 168 204 205 217 218 224 228 229 231
-"BLD",7891,1,116,0)
+"BLD",7883,1,119,0)
 236 237 240 253 260 267 271 301 347 350
-"BLD",7891,1,117,0)
+"BLD",7883,1,120,0)
 366 379 384 391 407 418 419 420 428 433
-"BLD",7891,1,118,0)
+"BLD",7883,1,121,0)
 442 520 569 600 620 692 706 715 722 723
-"BLD",7891,1,119,0)
+"BLD",7883,1,122,0)
 724 728 730 744 745 746 747 748 749 750
-"BLD",7891,1,120,0)
+"BLD",7883,1,123,0)
 751 752 753 754 755 756 757 758 759 760
-"BLD",7891,1,121,0)
+"BLD",7883,1,124,0)
 761 762 763 764 765 766 767 768 769 770
-"BLD",7891,1,122,0)
+"BLD",7883,1,125,0)
 771 772 773 774 775 776 777 778 779 780
-"BLD",7891,1,123,0)
+"BLD",7883,1,126,0)
 100000 100001 100002 100003 100004 100005 100006 100007 100008 100009
-"BLD",7891,1,124,0)
+"BLD",7883,1,127,0)
 100010 100011 100012 100013 100014
-"BLD",7891,1,125,0)
+"BLD",7883,1,128,0)
  
-"BLD",7891,1,126,0)
+"BLD",7883,1,129,0)
 These are the 105 patient records included in category "RIMTBL_1" from 
-"BLD",7891,1,127,0)
+"BLD",7883,1,130,0)
 the above example.
-"BLD",7891,1,128,0)
+"BLD",7883,1,131,0)
  
-"BLD",7891,1,129,0)
+"BLD",7883,1,132,0)
 DPATV^C0CRIMA(DFN,"SECTION")
-"BLD",7891,1,130,0)
+"BLD",7883,1,133,0)
 A command line interface to display the values of variables for a 
-"BLD",7891,1,131,0)
+"BLD",7883,1,134,0)
 patient. "SECTION" can be any of the CCR sections. ie 
-"BLD",7891,1,132,0)
+"BLD",7883,1,135,0)
 "ALERTS","RESULTS","MEDS". If SECTION is ommitted, all sections will be 
-"BLD",7891,1,133,0)
+"BLD",7883,1,136,0)
 shown. An example:
-"BLD",7891,1,134,0)
+"BLD",7883,1,137,0)
  
-"BLD",7891,1,135,0)
+"BLD",7883,1,138,0)
 GTM>D DPATV^C0CRIMA(2,"PROBLEMS")
-"BLD",7891,1,136,0)
+"BLD",7883,1,139,0)
 1 1^PROBLEMCODEVALUE^V18.0
-"BLD",7891,1,137,0)
+"BLD",7883,1,140,0)
 2 1^PROBLEMCODINGVERSION^
-"BLD",7891,1,138,0)
+"BLD",7883,1,141,0)
 3 1^PROBLEMCONDITION^P
-"BLD",7891,1,139,0)
+"BLD",7883,1,142,0)
 4 1^PROBLEMDATEMOD^2005-07-19T00:00:00-05:00
-"BLD",7891,1,140,0)
+"BLD",7883,1,143,0)
 5 1^PROBLEMDATEOFONSET^1700--T00:00:00-05:00
-"BLD",7891,1,141,0)
+"BLD",7883,1,144,0)
 6 1^PROBLEMDESCRIPTION^Family History of Diabetes Mellitus (ICD-9-CM 
-"BLD",7891,1,142,0)
+"BLD",7883,1,145,0)
 V18.0)
-"BLD",7891,1,143,0)
+"BLD",7883,1,146,0)
 7 1^PROBLEMDTREC^1701--T00:00:00-05:00
-"BLD",7891,1,144,0)
+"BLD",7883,1,147,0)
 8 1^PROBLEMHASCMT^
-"BLD",7891,1,145,0)
+"BLD",7883,1,148,0)
 9 1^PROBLEMIEN^8
-"BLD",7891,1,146,0)
+"BLD",7883,1,149,0)
 10 1^PROBLEMINACT^1700--T00:00:00-05:00
-"BLD",7891,1,147,0)
+"BLD",7883,1,150,0)
  
-"BLD",7891,1,148,0)
+"BLD",7883,1,151,0)
 DCCR^C0CCCR(DFN)
-"BLD",7891,1,149,0)
+"BLD",7883,1,152,0)
 This will display the XML of a CCR that has been generated for a patient. 
-"BLD",7891,1,150,0)
+"BLD",7883,1,153,0)
 It is run after generating the CCR with XPAT^C0CCCR or XCPAT^C0CRIMA.
-"BLD",7891,1,151,0)
+"BLD",7883,1,154,0)
  
-"BLD",7891,1,152,0)
+"BLD",7883,1,155,0)
 XCPAT^C0CRIMA(CPATCAT)
-"BLD",7891,1,153,0)
+"BLD",7883,1,156,0)
 A command line interface to extract a batch of patient CCR documents that 
-"BLD",7891,1,154,0)
+"BLD",7883,1,157,0)
 are associated with the category CPATCAT. For example,
-"BLD",7891,1,155,0)
+"BLD",7883,1,158,0)
  
-"BLD",7891,1,156,0)
+"BLD",7883,1,159,0)
 XCPAT^C0CRIMA("RIMTBL_1") to extract the CCR documents for the 105 
-"BLD",7891,1,157,0)
+"BLD",7883,1,160,0)
 patients in the above example.
-"BLD",7891,1,158,0)
+"BLD",7883,1,161,0)
  
-"BLD",7891,1,159,0)
+"BLD",7883,1,162,0)
 RESET^C0CRIMA
-"BLD",7891,1,160,0)
+"BLD",7883,1,163,0)
 A command line interface to kill all ANALYZE^C0CRIMA results stored so 
-"BLD",7891,1,161,0)
+"BLD",7883,1,164,0)
 far so that the analysis can be done again. It kills 
-"BLD",7891,1,162,0)
+"BLD",7883,1,165,0)
 ^TMP("C0CRIM","RESUME") and all extraction variables that have been saved 
-"BLD",7891,1,163,0)
+"BLD",7883,1,166,0)
 in ^TMP("C0CRIM")
-"BLD",7891,1,164,0)
+"BLD",7883,1,167,0)
  
-"BLD",7891,1,165,0)
+"BLD",7883,1,168,0)
 NOTES:
-"BLD",7891,1,166,0)
+"BLD",7883,1,169,0)
 This version of the package is a prototype, and does not yet make use of 
-"BLD",7891,1,167,0)
+"BLD",7883,1,170,0)
 the standard VistA features that are appropriate for it to use.
-"BLD",7891,1,168,0)
+"BLD",7883,1,171,0)
  
-"BLD",7891,1,169,0)
+"BLD",7883,1,172,0)
 ^TMP("C0CCCR","ODIR") must be set manually to the output directory on the 
-"BLD",7891,1,170,0)
+"BLD",7883,1,173,0)
 Host System. It is intended that this be maintainable in a parameter file.
-"BLD",7891,1,171,0)
+"BLD",7883,1,174,0)
  
-"BLD",7891,1,172,0)
+"BLD",7883,1,175,0)
 CCRRPC^C0CCCR and CCDRPC^C0CCCD are intended to be RPC interfaces to the 
-"BLD",7891,1,173,0)
+"BLD",7883,1,176,0)
 package but there is no entry for them in the RPC table and the RPC 
-"BLD",7891,1,174,0)
+"BLD",7883,1,177,0)
 method of access has not been tested.
-"BLD",7891,1,175,0)
+"BLD",7883,1,178,0)
  
-"BLD",7891,1,176,0)
+"BLD",7883,1,179,0)
 Most of the command line interface functions in the package are intended 
-"BLD",7891,1,177,0)
+"BLD",7883,1,180,0)
 to also be made available as RPC calls. This will provide the ability to 
-"BLD",7891,1,178,0)
+"BLD",7883,1,181,0)
 invoke and control batch extraction and analysis via RPCs
-"BLD",7891,1,179,0)
+"BLD",7883,1,182,0)
  
-"BLD",7891,1,180,0)
+"BLD",7883,1,183,0)
 The "RIM" variables and attributes that are now being stored in 
-"BLD",7891,1,181,0)
+"BLD",7883,1,184,0)
 ^TMP("C0CRIM") are intended to be maintained in a standard FILEMAN 
-"BLD",7891,1,182,0)
+"BLD",7883,1,185,0)
 global, and to take advantage of FILEMAN indexing for efficient batch 
-"BLD",7891,1,183,0)
+"BLD",7883,1,186,0)
 analysis and processing.
-"BLD",7891,1,184,0)
+"BLD",7883,1,187,0)
  
-"BLD",7891,1,185,0)
+"BLD",7883,1,188,0)
 It is intended that menu interfaces be provided in addition to command 
-"BLD",7891,4,0)
+"BLD",7883,4,0)
 ^9.64PA^170.9^12
-"BLD",7891,4,170,0)
+"BLD",7883,4,170,0)
 170
-"BLD",7891,4,170,222)
+"BLD",7883,4,170,222)
 y^y^f^^n^^y^o^n
-"BLD",7891,4,170.101,0)
+"BLD",7883,4,170.101,0)
 170.101
-"BLD",7891,4,170.101,222)
+"BLD",7883,4,170.101,222)
 y^y^f^^n^^y^o^n
-"BLD",7891,4,170.9,0)
+"BLD",7883,4,170.9,0)
 170.9
-"BLD",7891,4,170.9,222)
+"BLD",7883,4,170.9,222)
 y^y^f^^n^^y^o^n
-"BLD",7891,4,171.101,0)
+"BLD",7883,4,171.101,0)
 171.101
-"BLD",7891,4,171.101,222)
+"BLD",7883,4,171.101,222)
 y^y^f^^^^n
-"BLD",7891,4,171.401,0)
+"BLD",7883,4,171.401,0)
 171.401
-"BLD",7891,4,171.401,222)
+"BLD",7883,4,171.401,222)
 y^y^f^^^^n
-"BLD",7891,4,175,0)
+"BLD",7883,4,175,0)
 175
-"BLD",7891,4,175,222)
+"BLD",7883,4,175,222)
 y^y^f^^^^n
-"BLD",7891,4,176.112,0)
+"BLD",7883,4,176.112,0)
 176.112
-"BLD",7891,4,176.112,222)
+"BLD",7883,4,176.112,222)
 y^y^f^^n^^y^o^n
-"BLD",7891,4,177.101,0)
+"BLD",7883,4,177.101,0)
 177.101
-"BLD",7891,4,177.101,222)
+"BLD",7883,4,177.101,222)
 y^y^f^^^^n
-"BLD",7891,4,177.201,0)
+"BLD",7883,4,177.201,0)
 177.201
-"BLD",7891,4,177.201,222)
+"BLD",7883,4,177.201,222)
 y^y^f^^n^^y^o^n
-"BLD",7891,4,177.301,0)
+"BLD",7883,4,177.301,0)
 177.301
-"BLD",7891,4,177.301,222)
+"BLD",7883,4,177.301,222)
 y^y^f^^^^n
-"BLD",7891,4,178.101,0)
+"BLD",7883,4,178.101,0)
 178.101
-"BLD",7891,4,178.101,222)
+"BLD",7883,4,178.101,222)
 y^y^f^^n^^y^o^n
-"BLD",7891,4,178.301,0)
+"BLD",7883,4,178.301,0)
 178.301
-"BLD",7891,4,178.301,222)
+"BLD",7883,4,178.301,222)
 y^y^f^^n^^y^o^n
-"BLD",7891,4,"B",170,170)
+"BLD",7883,4,"B",170,170)
 
-"BLD",7891,4,"B",170.101,170.101)
+"BLD",7883,4,"B",170.101,170.101)
 
-"BLD",7891,4,"B",170.9,170.9)
+"BLD",7883,4,"B",170.9,170.9)
 
-"BLD",7891,4,"B",171.101,171.101)
+"BLD",7883,4,"B",171.101,171.101)
 
-"BLD",7891,4,"B",171.401,171.401)
+"BLD",7883,4,"B",171.401,171.401)
 
-"BLD",7891,4,"B",175,175)
+"BLD",7883,4,"B",175,175)
 
-"BLD",7891,4,"B",176.112,176.112)
+"BLD",7883,4,"B",176.112,176.112)
 
-"BLD",7891,4,"B",177.101,177.101)
+"BLD",7883,4,"B",177.101,177.101)
 
-"BLD",7891,4,"B",177.201,177.201)
+"BLD",7883,4,"B",177.201,177.201)
 
-"BLD",7891,4,"B",177.301,177.301)
+"BLD",7883,4,"B",177.301,177.301)
 
-"BLD",7891,4,"B",178.101,178.101)
+"BLD",7883,4,"B",178.101,178.101)
 
-"BLD",7891,4,"B",178.301,178.301)
+"BLD",7883,4,"B",178.301,178.301)
 
-"BLD",7891,6.3)
-50
-"BLD",7891,"ABNS",0)
+"BLD",7883,6.3)
+51
+"BLD",7883,"ABNS",0)
 ^9.66A^^
-"BLD",7891,"ABPKG")
+"BLD",7883,"ABPKG")
 n^n
-"BLD",7891,"INI")
+"BLD",7883,"INI")
 PRE^C0CENV
-"BLD",7891,"INIT")
+"BLD",7883,"INIT")
 POST^C0CENV
-"BLD",7891,"KRN",0)
+"BLD",7883,"KRN",0)
 ^9.67PA^779.2^20
-"BLD",7891,"KRN",.4,0)
+"BLD",7883,"KRN",.4,0)
 .4
-"BLD",7891,"KRN",.401,0)
+"BLD",7883,"KRN",.401,0)
 .401
-"BLD",7891,"KRN",.402,0)
+"BLD",7883,"KRN",.402,0)
 .402
-"BLD",7891,"KRN",.403,0)
+"BLD",7883,"KRN",.403,0)
 .403
-"BLD",7891,"KRN",.5,0)
+"BLD",7883,"KRN",.5,0)
 .5
-"BLD",7891,"KRN",.84,0)
+"BLD",7883,"KRN",.84,0)
 .84
-"BLD",7891,"KRN",3.6,0)
+"BLD",7883,"KRN",3.6,0)
 3.6
-"BLD",7891,"KRN",3.8,0)
+"BLD",7883,"KRN",3.8,0)
 3.8
-"BLD",7891,"KRN",9.2,0)
+"BLD",7883,"KRN",9.2,0)
 9.2
-"BLD",7891,"KRN",9.8,0)
+"BLD",7883,"KRN",9.8,0)
 9.8
-"BLD",7891,"KRN",9.8,"NM",0)
+"BLD",7883,"KRN",9.8,"NM",0)
 ^9.68A^110^79
-"BLD",7891,"KRN",9.8,"NM",22,0)
-C0CRXN^^0^B103277157
-"BLD",7891,"KRN",9.8,"NM",23,0)
-C0CRNF^^0^B195772222
-"BLD",7891,"KRN",9.8,"NM",24,0)
-C0CFM1^^0^B27048099
-"BLD",7891,"KRN",9.8,"NM",29,0)
-C0CPARMS^^0^B10161575
-"BLD",7891,"KRN",9.8,"NM",31,0)
-C0CFM2^^0^B102195978
-"BLD",7891,"KRN",9.8,"NM",34,0)
-C0CXPATH^^0^B521207435
-"BLD",7891,"KRN",9.8,"NM",35,0)
-C0CXPAT0^^0^B50736852
-"BLD",7891,"KRN",9.8,"NM",36,0)
-C0CVITAL^^0^B319933080
-"BLD",7891,"KRN",9.8,"NM",37,0)
-C0CUNIT^^0^B43465566
-"BLD",7891,"KRN",9.8,"NM",38,0)
-C0CRIMA^^0^B331901748
-"BLD",7891,"KRN",9.8,"NM",39,0)
-C0CPROBS^^0^B53281308
-"BLD",7891,"KRN",9.8,"NM",40,0)
-C0CLABS^^0^B282604886
-"BLD",7891,"KRN",9.8,"NM",41,0)
-C0CIMMU^^0^B20441765
-"BLD",7891,"KRN",9.8,"NM",42,0)
-C0CCCR0^^0^B790419172
-"BLD",7891,"KRN",9.8,"NM",43,0)
-C0CCCR^^0^B111682825
-"BLD",7891,"KRN",9.8,"NM",44,0)
-C0CCCD1^^0^B100634737
-"BLD",7891,"KRN",9.8,"NM",45,0)
-C0CCCD^^0^B114134049
-"BLD",7891,"KRN",9.8,"NM",46,0)
-C0CALERT^^0^B31627309
-"BLD",7891,"KRN",9.8,"NM",47,0)
-C0CACTOR^^0^B99733742
-"BLD",7891,"KRN",9.8,"NM",48,0)
-C0CMED^^0^B18939705
-"BLD",7891,"KRN",9.8,"NM",49,0)
-C0CMED1^^0^B113570971
-"BLD",7891,"KRN",9.8,"NM",50,0)
-C0CMED2^^0^B147041837
-"BLD",7891,"KRN",9.8,"NM",51,0)
-C0CMED3^^0^B172422279
-"BLD",7891,"KRN",9.8,"NM",52,0)
-C0CMED6^^0^B194349409
-"BLD",7891,"KRN",9.8,"NM",53,0)
-C0CDPT^^0^B45873061
-"BLD",7891,"KRN",9.8,"NM",54,0)
-C0CUTIL^^0^B27079469
-"BLD",7891,"KRN",9.8,"NM",55,0)
-C0CVA200^^0^B32092477
-"BLD",7891,"KRN",9.8,"NM",56,0)
-C0CSYS^^0^B3933593
-"BLD",7891,"KRN",9.8,"NM",57,0)
-C0CBAT^^0^B56971574
-"BLD",7891,"KRN",9.8,"NM",61,0)
-C0CSUB1^^0^B16280924
-"BLD",7891,"KRN",9.8,"NM",62,0)
-C0CLA7Q^^0^B21818572
-"BLD",7891,"KRN",9.8,"NM",63,0)
-C0CPROC^^0^B27869918
-"BLD",7891,"KRN",9.8,"NM",64,0)
-C0CMXP^^0^B77680190
-"BLD",7891,"KRN",9.8,"NM",65,0)
-C0CMXML^^0^B56456416
-"BLD",7891,"KRN",9.8,"NM",66,0)
-C0CVIT2^^0^B320700684
-"BLD",7891,"KRN",9.8,"NM",67,0)
-C0CIM2^^0^B20157375
-"BLD",7891,"KRN",9.8,"NM",68,0)
-C0CCPT^^0^B16531537
-"BLD",7891,"KRN",9.8,"NM",69,0)
-C0CSOAP^^0^B79899662
-"BLD",7891,"KRN",9.8,"NM",70,0)
-C0CENC^^0^B46321144
-"BLD",7891,"KRN",9.8,"NM",71,0)
-C0CCMT^^0^B6740701
-"BLD",7891,"KRN",9.8,"NM",72,0)
-C0CIN^^0^B30946883
-"BLD",7891,"KRN",9.8,"NM",73,0)
-C0CDIC^^0^B43527636
-"BLD",7891,"KRN",9.8,"NM",74,0)
-C0CDOM^^0^B86773980
-"BLD",7891,"KRN",9.8,"NM",75,0)
-C0CENV^^0^B25371113
-"BLD",7891,"KRN",9.8,"NM",76,0)
-C0CEVC^^0^B18388545
-"BLD",7891,"KRN",9.8,"NM",77,0)
-C0CEWD^^0^B5607678
-"BLD",7891,"KRN",9.8,"NM",78,0)
-C0CEWD1^^0^B6563070
-"BLD",7891,"KRN",9.8,"NM",79,0)
-C0CFM3^^0^B68203631
-"BLD",7891,"KRN",9.8,"NM",80,0)
-C0CLA7DD^^0^B66668579
-"BLD",7891,"KRN",9.8,"NM",81,0)
-C0CMAIL^^0^B92791623
-"BLD",7891,"KRN",9.8,"NM",82,0)
-C0CMAIL2^^0^B166788518
-"BLD",7891,"KRN",9.8,"NM",83,0)
-C0CMAIL3^^0^B224733815
-"BLD",7891,"KRN",9.8,"NM",84,0)
-C0CMCCD^^0^B73168233
-"BLD",7891,"KRN",9.8,"NM",85,0)
-C0CMED4^^0^B61058927
-"BLD",7891,"KRN",9.8,"NM",86,0)
-C0CMIME^^0^B99031395
-"BLD",7891,"KRN",9.8,"NM",87,0)
-C0CMXMLB^^0^B12065941
-"BLD",7891,"KRN",9.8,"NM",88,0)
-C0CNHIN^^0^B87973392
-"BLD",7891,"KRN",9.8,"NM",89,0)
-C0CNMED2^^0^B33217786
-"BLD",7891,"KRN",9.8,"NM",90,0)
-C0CNMED4^^0^B99762510
-"BLD",7891,"KRN",9.8,"NM",91,0)
-C0CORSLT^^0^B9647157
-"BLD",7891,"KRN",9.8,"NM",92,0)
-C0CPXRM^^0^B14904056
-"BLD",7891,"KRN",9.8,"NM",93,0)
+"BLD",7883,"KRN",9.8,"NM",22,0)
+C0CRXN^^0^B102255510
+"BLD",7883,"KRN",9.8,"NM",23,0)
+C0CRNF^^0^B194328331
+"BLD",7883,"KRN",9.8,"NM",24,0)
+C0CFM1^^0^B26826658
+"BLD",7883,"KRN",9.8,"NM",29,0)
+C0CPARMS^^0^B9948429
+"BLD",7883,"KRN",9.8,"NM",31,0)
+C0CFM2^^0^B99587435
+"BLD",7883,"KRN",9.8,"NM",34,0)
+C0CXPATH^^0^B518646177
+"BLD",7883,"KRN",9.8,"NM",35,0)
+C0CXPAT0^^0^B49945143
+"BLD",7883,"KRN",9.8,"NM",36,0)
+C0CVITAL^^0^B314693716
+"BLD",7883,"KRN",9.8,"NM",37,0)
+C0CUNIT^^0^B33370246
+"BLD",7883,"KRN",9.8,"NM",38,0)
+C0CRIMA^^0^B328577528
+"BLD",7883,"KRN",9.8,"NM",39,0)
+C0CPROBS^^0^B51600314
+"BLD",7883,"KRN",9.8,"NM",40,0)
+C0CLABS^^0^B279276475
+"BLD",7883,"KRN",9.8,"NM",41,0)
+C0CIMMU^^0^B19603373
+"BLD",7883,"KRN",9.8,"NM",42,0)
+C0CCCR0^^0^B785598655
+"BLD",7883,"KRN",9.8,"NM",43,0)
+C0CCCR^^0^B109879694
+"BLD",7883,"KRN",9.8,"NM",44,0)
+C0CCCD1^^0^B96013153
+"BLD",7883,"KRN",9.8,"NM",45,0)
+C0CCCD^^0^B89035344
+"BLD",7883,"KRN",9.8,"NM",46,0)
+C0CALERT^^0^B31119471
+"BLD",7883,"KRN",9.8,"NM",47,0)
+C0CACTOR^^0^B98169360
+"BLD",7883,"KRN",9.8,"NM",48,0)
+C0CMED^^0^B18524779
+"BLD",7883,"KRN",9.8,"NM",49,0)
+C0CMED1^^0^B112207077
+"BLD",7883,"KRN",9.8,"NM",50,0)
+C0CMED2^^0^B145401668
+"BLD",7883,"KRN",9.8,"NM",51,0)
+C0CMED3^^0^B170674827
+"BLD",7883,"KRN",9.8,"NM",52,0)
+C0CMED6^^0^B192343303
+"BLD",7883,"KRN",9.8,"NM",53,0)
+C0CDPT^^0^B46820265
+"BLD",7883,"KRN",9.8,"NM",54,0)
+C0CUTIL^^0^B26410609
+"BLD",7883,"KRN",9.8,"NM",55,0)
+C0CVA200^^0^B31814686
+"BLD",7883,"KRN",9.8,"NM",56,0)
+C0CSYS^^0^B3817459
+"BLD",7883,"KRN",9.8,"NM",57,0)
+C0CBAT^^0^B56229594
+"BLD",7883,"KRN",9.8,"NM",61,0)
+C0CSUB1^^0^B15609029
+"BLD",7883,"KRN",9.8,"NM",62,0)
+C0CLA7Q^^0^B24672517
+"BLD",7883,"KRN",9.8,"NM",63,0)
+C0CPROC^^0^B26886546
+"BLD",7883,"KRN",9.8,"NM",64,0)
+C0CMXP^^0^B76428333
+"BLD",7883,"KRN",9.8,"NM",65,0)
+C0CMXML^^0^B55227178
+"BLD",7883,"KRN",9.8,"NM",66,0)
+C0CVIT2^^0^B317310035
+"BLD",7883,"KRN",9.8,"NM",67,0)
+C0CIM2^^0^B19669149
+"BLD",7883,"KRN",9.8,"NM",68,0)
+C0CCPT^^0^B17485471
+"BLD",7883,"KRN",9.8,"NM",69,0)
+C0CSOAP^^0^B79012960
+"BLD",7883,"KRN",9.8,"NM",70,0)
+C0CENC^^0^B45258660
+"BLD",7883,"KRN",9.8,"NM",71,0)
+C0CCMT^^0^B6559679
+"BLD",7883,"KRN",9.8,"NM",72,0)
+C0CIN^^0^B30222275
+"BLD",7883,"KRN",9.8,"NM",73,0)
+C0CDIC^^0^B42907516
+"BLD",7883,"KRN",9.8,"NM",74,0)
+C0CDOM^^0^B86328529
+"BLD",7883,"KRN",9.8,"NM",75,0)
+C0CENV^^0^B28427348
+"BLD",7883,"KRN",9.8,"NM",76,0)
+C0CEVC^^0^B21455969
+"BLD",7883,"KRN",9.8,"NM",77,0)
+C0CEWD^^0^B5530676
+"BLD",7883,"KRN",9.8,"NM",78,0)
+C0CEWD1^^0^B6276162
+"BLD",7883,"KRN",9.8,"NM",79,0)
+C0CFM3^^0^B66472582
+"BLD",7883,"KRN",9.8,"NM",80,0)
+C0CLA7DD^^0^B72588185
+"BLD",7883,"KRN",9.8,"NM",81,0)
+C0CMAIL^^0^B91585320
+"BLD",7883,"KRN",9.8,"NM",82,0)
+C0CMAIL2^^0^B165067910
+"BLD",7883,"KRN",9.8,"NM",83,0)
+C0CMAIL3^^0^B222669398
+"BLD",7883,"KRN",9.8,"NM",84,0)
+C0CMCCD^^0^B71988241
+"BLD",7883,"KRN",9.8,"NM",85,0)
+C0CMED4^^0^B60079150
+"BLD",7883,"KRN",9.8,"NM",86,0)
+C0CMIME^^0^B97918768
+"BLD",7883,"KRN",9.8,"NM",87,0)
+C0CMXMLB^^0^B12346525
+"BLD",7883,"KRN",9.8,"NM",88,0)
+C0CNHIN^^0^B87084020
+"BLD",7883,"KRN",9.8,"NM",89,0)
+C0CNMED2^^0^B32627824
+"BLD",7883,"KRN",9.8,"NM",90,0)
+C0CNMED4^^0^B98251317
+"BLD",7883,"KRN",9.8,"NM",91,0)
+C0CORSLT^^0^B9272901
+"BLD",7883,"KRN",9.8,"NM",92,0)
+C0CPXRM^^0^B4357
+"BLD",7883,"KRN",9.8,"NM",93,0)
 C0CQRY1^^0^B18992765
-"BLD",7891,"KRN",9.8,"NM",94,0)
-C0CQRY2^^0^B20465060
-"BLD",7891,"KRN",9.8,"NM",95,0)
-C0CRNFRP^^0^B91701220
-"BLD",7891,"KRN",9.8,"NM",96,0)
-C0CRPMS^^0^B16300714
-"BLD",7891,"KRN",9.8,"NM",97,0)
-C0CRXNRD^^0^B31474664
-"BLD",7891,"KRN",9.8,"NM",98,0)
-C0CSNOA^^0^B56032588
-"BLD",7891,"KRN",9.8,"NM",99,0)
-C0CVOBX1^^0^B12947698
-"BLD",7891,"KRN",9.8,"NM",100,0)
-C0CVORU^^0^B58596883
-"BLD",7891,"KRN",9.8,"NM",101,0)
-C0CXEWD^^0^B15380480
-"BLD",7891,"KRN",9.8,"NM",102,0)
-C0COVREL^^0^B18541513
-"BLD",7891,"KRN",9.8,"NM",103,0)
-C0COVRES^^0^B24677897
-"BLD",7891,"KRN",9.8,"NM",104,0)
-C0COVREU^^0^B79442187
-"BLD",7891,"KRN",9.8,"NM",105,0)
-C0CRAHL7^^0^B54192731
-"BLD",7891,"KRN",9.8,"NM",106,0)
-C0CRARPT^^0^B68379544
-"BLD",7891,"KRN",9.8,"NM",107,0)
-C0CSQMB^^0^B545540
-"BLD",7891,"KRN",9.8,"NM",108,0)
-C0CTIU^^0^B62323461
-"BLD",7891,"KRN",9.8,"NM",109,0)
-C0CTIU1^^0^B10596577
-"BLD",7891,"KRN",9.8,"NM",110,0)
-C0CVALID^^0^B2856461
-"BLD",7891,"KRN",9.8,"NM","B","C0CACTOR",47)
+"BLD",7883,"KRN",9.8,"NM",94,0)
+C0CQRY2^^0^B23443412
+"BLD",7883,"KRN",9.8,"NM",95,0)
+C0CRNFRP^^0^B90905910
+"BLD",7883,"KRN",9.8,"NM",96,0)
+C0CRPMS^^0^B15891746
+"BLD",7883,"KRN",9.8,"NM",97,0)
+C0CRXNRD^^0^B36296842
+"BLD",7883,"KRN",9.8,"NM",98,0)
+C0CSNOA^^0^B40683034
+"BLD",7883,"KRN",9.8,"NM",99,0)
+C0CVOBX1^^0^B14909630
+"BLD",7883,"KRN",9.8,"NM",100,0)
+C0CVORU^^0^B63096791
+"BLD",7883,"KRN",9.8,"NM",101,0)
+C0CXEWD^^0^B15053974
+"BLD",7883,"KRN",9.8,"NM",102,0)
+C0COVREL^^0^B19589538
+"BLD",7883,"KRN",9.8,"NM",103,0)
+C0COVRES^^0^B23183700
+"BLD",7883,"KRN",9.8,"NM",104,0)
+C0COVREU^^0^B78173648
+"BLD",7883,"KRN",9.8,"NM",105,0)
+C0CRAHL7^^0^B46426582
+"BLD",7883,"KRN",9.8,"NM",106,0)
+C0CRARPT^^0^B66576750
+"BLD",7883,"KRN",9.8,"NM",107,0)
+C0CSQMB^^0^B779536
+"BLD",7883,"KRN",9.8,"NM",108,0)
+C0CTIU^^0^B68529284
+"BLD",7883,"KRN",9.8,"NM",109,0)
+C0CTIU1^^0^B12758077
+"BLD",7883,"KRN",9.8,"NM",110,0)
+C0CVALID^^0^B3624866
+"BLD",7883,"KRN",9.8,"NM","B","C0CACTOR",47)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CALERT",46)
+"BLD",7883,"KRN",9.8,"NM","B","C0CALERT",46)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CBAT",57)
+"BLD",7883,"KRN",9.8,"NM","B","C0CBAT",57)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CCCD",45)
+"BLD",7883,"KRN",9.8,"NM","B","C0CCCD",45)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CCCD1",44)
+"BLD",7883,"KRN",9.8,"NM","B","C0CCCD1",44)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CCCR",43)
+"BLD",7883,"KRN",9.8,"NM","B","C0CCCR",43)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CCCR0",42)
+"BLD",7883,"KRN",9.8,"NM","B","C0CCCR0",42)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CCMT",71)
+"BLD",7883,"KRN",9.8,"NM","B","C0CCMT",71)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CCPT",68)
+"BLD",7883,"KRN",9.8,"NM","B","C0CCPT",68)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CDIC",73)
+"BLD",7883,"KRN",9.8,"NM","B","C0CDIC",73)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CDOM",74)
+"BLD",7883,"KRN",9.8,"NM","B","C0CDOM",74)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CDPT",53)
+"BLD",7883,"KRN",9.8,"NM","B","C0CDPT",53)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CENC",70)
+"BLD",7883,"KRN",9.8,"NM","B","C0CENC",70)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CENV",75)
+"BLD",7883,"KRN",9.8,"NM","B","C0CENV",75)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CEVC",76)
+"BLD",7883,"KRN",9.8,"NM","B","C0CEVC",76)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CEWD",77)
+"BLD",7883,"KRN",9.8,"NM","B","C0CEWD",77)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CEWD1",78)
+"BLD",7883,"KRN",9.8,"NM","B","C0CEWD1",78)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CFM1",24)
+"BLD",7883,"KRN",9.8,"NM","B","C0CFM1",24)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CFM2",31)
+"BLD",7883,"KRN",9.8,"NM","B","C0CFM2",31)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CFM3",79)
+"BLD",7883,"KRN",9.8,"NM","B","C0CFM3",79)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CIM2",67)
+"BLD",7883,"KRN",9.8,"NM","B","C0CIM2",67)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CIMMU",41)
+"BLD",7883,"KRN",9.8,"NM","B","C0CIMMU",41)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CIN",72)
+"BLD",7883,"KRN",9.8,"NM","B","C0CIN",72)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CLA7DD",80)
+"BLD",7883,"KRN",9.8,"NM","B","C0CLA7DD",80)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CLA7Q",62)
+"BLD",7883,"KRN",9.8,"NM","B","C0CLA7Q",62)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CLABS",40)
+"BLD",7883,"KRN",9.8,"NM","B","C0CLABS",40)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CMAIL",81)
+"BLD",7883,"KRN",9.8,"NM","B","C0CMAIL",81)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CMAIL2",82)
+"BLD",7883,"KRN",9.8,"NM","B","C0CMAIL2",82)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CMAIL3",83)
+"BLD",7883,"KRN",9.8,"NM","B","C0CMAIL3",83)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CMCCD",84)
+"BLD",7883,"KRN",9.8,"NM","B","C0CMCCD",84)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CMED",48)
+"BLD",7883,"KRN",9.8,"NM","B","C0CMED",48)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CMED1",49)
+"BLD",7883,"KRN",9.8,"NM","B","C0CMED1",49)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CMED2",50)
+"BLD",7883,"KRN",9.8,"NM","B","C0CMED2",50)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CMED3",51)
+"BLD",7883,"KRN",9.8,"NM","B","C0CMED3",51)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CMED4",85)
+"BLD",7883,"KRN",9.8,"NM","B","C0CMED4",85)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CMED6",52)
+"BLD",7883,"KRN",9.8,"NM","B","C0CMED6",52)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CMIME",86)
+"BLD",7883,"KRN",9.8,"NM","B","C0CMIME",86)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CMXML",65)
+"BLD",7883,"KRN",9.8,"NM","B","C0CMXML",65)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CMXMLB",87)
+"BLD",7883,"KRN",9.8,"NM","B","C0CMXMLB",87)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CMXP",64)
+"BLD",7883,"KRN",9.8,"NM","B","C0CMXP",64)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CNHIN",88)
+"BLD",7883,"KRN",9.8,"NM","B","C0CNHIN",88)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CNMED2",89)
+"BLD",7883,"KRN",9.8,"NM","B","C0CNMED2",89)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CNMED4",90)
+"BLD",7883,"KRN",9.8,"NM","B","C0CNMED4",90)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CORSLT",91)
+"BLD",7883,"KRN",9.8,"NM","B","C0CORSLT",91)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0COVREL",102)
+"BLD",7883,"KRN",9.8,"NM","B","C0COVREL",102)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0COVRES",103)
+"BLD",7883,"KRN",9.8,"NM","B","C0COVRES",103)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0COVREU",104)
+"BLD",7883,"KRN",9.8,"NM","B","C0COVREU",104)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CPARMS",29)
+"BLD",7883,"KRN",9.8,"NM","B","C0CPARMS",29)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CPROBS",39)
+"BLD",7883,"KRN",9.8,"NM","B","C0CPROBS",39)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CPROC",63)
+"BLD",7883,"KRN",9.8,"NM","B","C0CPROC",63)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CPXRM",92)
+"BLD",7883,"KRN",9.8,"NM","B","C0CPXRM",92)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CQRY1",93)
+"BLD",7883,"KRN",9.8,"NM","B","C0CQRY1",93)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CQRY2",94)
+"BLD",7883,"KRN",9.8,"NM","B","C0CQRY2",94)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CRAHL7",105)
+"BLD",7883,"KRN",9.8,"NM","B","C0CRAHL7",105)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CRARPT",106)
+"BLD",7883,"KRN",9.8,"NM","B","C0CRARPT",106)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CRIMA",38)
+"BLD",7883,"KRN",9.8,"NM","B","C0CRIMA",38)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CRNF",23)
+"BLD",7883,"KRN",9.8,"NM","B","C0CRNF",23)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CRNFRP",95)
+"BLD",7883,"KRN",9.8,"NM","B","C0CRNFRP",95)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CRPMS",96)
+"BLD",7883,"KRN",9.8,"NM","B","C0CRPMS",96)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CRXN",22)
+"BLD",7883,"KRN",9.8,"NM","B","C0CRXN",22)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CRXNRD",97)
+"BLD",7883,"KRN",9.8,"NM","B","C0CRXNRD",97)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CSNOA",98)
+"BLD",7883,"KRN",9.8,"NM","B","C0CSNOA",98)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CSOAP",69)
+"BLD",7883,"KRN",9.8,"NM","B","C0CSOAP",69)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CSQMB",107)
+"BLD",7883,"KRN",9.8,"NM","B","C0CSQMB",107)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CSUB1",61)
+"BLD",7883,"KRN",9.8,"NM","B","C0CSUB1",61)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CSYS",56)
+"BLD",7883,"KRN",9.8,"NM","B","C0CSYS",56)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CTIU",108)
+"BLD",7883,"KRN",9.8,"NM","B","C0CTIU",108)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CTIU1",109)
+"BLD",7883,"KRN",9.8,"NM","B","C0CTIU1",109)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CUNIT",37)
+"BLD",7883,"KRN",9.8,"NM","B","C0CUNIT",37)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CUTIL",54)
+"BLD",7883,"KRN",9.8,"NM","B","C0CUTIL",54)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CVA200",55)
+"BLD",7883,"KRN",9.8,"NM","B","C0CVA200",55)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CVALID",110)
+"BLD",7883,"KRN",9.8,"NM","B","C0CVALID",110)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CVIT2",66)
+"BLD",7883,"KRN",9.8,"NM","B","C0CVIT2",66)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CVITAL",36)
+"BLD",7883,"KRN",9.8,"NM","B","C0CVITAL",36)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CVOBX1",99)
+"BLD",7883,"KRN",9.8,"NM","B","C0CVOBX1",99)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CVORU",100)
+"BLD",7883,"KRN",9.8,"NM","B","C0CVORU",100)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CXEWD",101)
+"BLD",7883,"KRN",9.8,"NM","B","C0CXEWD",101)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CXPAT0",35)
+"BLD",7883,"KRN",9.8,"NM","B","C0CXPAT0",35)
 
-"BLD",7891,"KRN",9.8,"NM","B","C0CXPATH",34)
+"BLD",7883,"KRN",9.8,"NM","B","C0CXPATH",34)
 
-"BLD",7891,"KRN",19,0)
+"BLD",7883,"KRN",19,0)
 19
-"BLD",7891,"KRN",19,"NM",0)
+"BLD",7883,"KRN",19,"NM",0)
 ^9.68A^10^10
-"BLD",7891,"KRN",19,"NM",1,0)
+"BLD",7883,"KRN",19,"NM",1,0)
 C0C BATCH OPTIONS^^0
-"BLD",7891,"KRN",19,"NM",2,0)
+"BLD",7883,"KRN",19,"NM",2,0)
 C0C CCR EXPORT BY PATIENT NAME^^0
-"BLD",7891,"KRN",19,"NM",3,0)
+"BLD",7883,"KRN",19,"NM",3,0)
 C0C CCR MENU^^0
-"BLD",7891,"KRN",19,"NM",4,0)
+"BLD",7883,"KRN",19,"NM",4,0)
 C0C DISPLAY ELEMENTS^^0
-"BLD",7891,"KRN",19,"NM",5,0)
+"BLD",7883,"KRN",19,"NM",5,0)
 C0C DISPLAY PATIENT VARIABLES^^0
-"BLD",7891,"KRN",19,"NM",6,0)
+"BLD",7883,"KRN",19,"NM",6,0)
 C0C KILL BATCH JOB^^0
-"BLD",7891,"KRN",19,"NM",7,0)
+"BLD",7883,"KRN",19,"NM",7,0)
 C0C LIST RIM CATEGORIES^^0
-"BLD",7891,"KRN",19,"NM",8,0)
+"BLD",7883,"KRN",19,"NM",8,0)
 C0C START CCR BATCH PROCESSING^^0
-"BLD",7891,"KRN",19,"NM",9,0)
+"BLD",7883,"KRN",19,"NM",9,0)
 C0C STATUS OF CCR BATCH^^0
-"BLD",7891,"KRN",19,"NM",10,0)
+"BLD",7883,"KRN",19,"NM",10,0)
 C0C CCR RPC^^0
-"BLD",7891,"KRN",19,"NM","B","C0C BATCH OPTIONS",1)
+"BLD",7883,"KRN",19,"NM","B","C0C BATCH OPTIONS",1)
 
-"BLD",7891,"KRN",19,"NM","B","C0C CCR EXPORT BY PATIENT NAME",2)
+"BLD",7883,"KRN",19,"NM","B","C0C CCR EXPORT BY PATIENT NAME",2)
 
-"BLD",7891,"KRN",19,"NM","B","C0C CCR MENU",3)
+"BLD",7883,"KRN",19,"NM","B","C0C CCR MENU",3)
 
-"BLD",7891,"KRN",19,"NM","B","C0C CCR RPC",10)
+"BLD",7883,"KRN",19,"NM","B","C0C CCR RPC",10)
 
-"BLD",7891,"KRN",19,"NM","B","C0C DISPLAY ELEMENTS",4)
+"BLD",7883,"KRN",19,"NM","B","C0C DISPLAY ELEMENTS",4)
 
-"BLD",7891,"KRN",19,"NM","B","C0C DISPLAY PATIENT VARIABLES",5)
+"BLD",7883,"KRN",19,"NM","B","C0C DISPLAY PATIENT VARIABLES",5)
 
-"BLD",7891,"KRN",19,"NM","B","C0C KILL BATCH JOB",6)
+"BLD",7883,"KRN",19,"NM","B","C0C KILL BATCH JOB",6)
 
-"BLD",7891,"KRN",19,"NM","B","C0C LIST RIM CATEGORIES",7)
+"BLD",7883,"KRN",19,"NM","B","C0C LIST RIM CATEGORIES",7)
 
-"BLD",7891,"KRN",19,"NM","B","C0C START CCR BATCH PROCESSING",8)
+"BLD",7883,"KRN",19,"NM","B","C0C START CCR BATCH PROCESSING",8)
 
-"BLD",7891,"KRN",19,"NM","B","C0C STATUS OF CCR BATCH",9)
+"BLD",7883,"KRN",19,"NM","B","C0C STATUS OF CCR BATCH",9)
 
-"BLD",7891,"KRN",19.1,0)
+"BLD",7883,"KRN",19.1,0)
 19.1
-"BLD",7891,"KRN",101,0)
+"BLD",7883,"KRN",101,0)
 101
-"BLD",7891,"KRN",409.61,0)
+"BLD",7883,"KRN",409.61,0)
 409.61
-"BLD",7891,"KRN",771,0)
+"BLD",7883,"KRN",771,0)
 771
-"BLD",7891,"KRN",779.2,0)
+"BLD",7883,"KRN",779.2,0)
 779.2
-"BLD",7891,"KRN",870,0)
+"BLD",7883,"KRN",870,0)
 870
-"BLD",7891,"KRN",8989.51,0)
+"BLD",7883,"KRN",8989.51,0)
 8989.51
-"BLD",7891,"KRN",8989.52,0)
+"BLD",7883,"KRN",8989.52,0)
 8989.52
-"BLD",7891,"KRN",8994,0)
+"BLD",7883,"KRN",8994,0)
 8994
-"BLD",7891,"KRN",8994,"NM",0)
+"BLD",7883,"KRN",8994,"NM",0)
 ^9.68A^1^1
-"BLD",7891,"KRN",8994,"NM",1,0)
+"BLD",7883,"KRN",8994,"NM",1,0)
 C0C CCR RPC^^0
-"BLD",7891,"KRN",8994,"NM","B","C0C CCR RPC",1)
+"BLD",7883,"KRN",8994,"NM","B","C0C CCR RPC",1)
 
-"BLD",7891,"KRN","B",.4,.4)
+"BLD",7883,"KRN","B",.4,.4)
 
-"BLD",7891,"KRN","B",.401,.401)
+"BLD",7883,"KRN","B",.401,.401)
 
-"BLD",7891,"KRN","B",.402,.402)
+"BLD",7883,"KRN","B",.402,.402)
 
-"BLD",7891,"KRN","B",.403,.403)
+"BLD",7883,"KRN","B",.403,.403)
 
-"BLD",7891,"KRN","B",.5,.5)
+"BLD",7883,"KRN","B",.5,.5)
 
-"BLD",7891,"KRN","B",.84,.84)
+"BLD",7883,"KRN","B",.84,.84)
 
-"BLD",7891,"KRN","B",3.6,3.6)
+"BLD",7883,"KRN","B",3.6,3.6)
 
-"BLD",7891,"KRN","B",3.8,3.8)
+"BLD",7883,"KRN","B",3.8,3.8)
 
-"BLD",7891,"KRN","B",9.2,9.2)
+"BLD",7883,"KRN","B",9.2,9.2)
 
-"BLD",7891,"KRN","B",9.8,9.8)
+"BLD",7883,"KRN","B",9.8,9.8)
 
-"BLD",7891,"KRN","B",19,19)
+"BLD",7883,"KRN","B",19,19)
 
-"BLD",7891,"KRN","B",19.1,19.1)
+"BLD",7883,"KRN","B",19.1,19.1)
 
-"BLD",7891,"KRN","B",101,101)
+"BLD",7883,"KRN","B",101,101)
 
-"BLD",7891,"KRN","B",409.61,409.61)
+"BLD",7883,"KRN","B",409.61,409.61)
 
-"BLD",7891,"KRN","B",771,771)
+"BLD",7883,"KRN","B",771,771)
 
-"BLD",7891,"KRN","B",779.2,779.2)
+"BLD",7883,"KRN","B",779.2,779.2)
 
-"BLD",7891,"KRN","B",870,870)
+"BLD",7883,"KRN","B",870,870)
 
-"BLD",7891,"KRN","B",8989.51,8989.51)
+"BLD",7883,"KRN","B",8989.51,8989.51)
 
-"BLD",7891,"KRN","B",8989.52,8989.52)
+"BLD",7883,"KRN","B",8989.52,8989.52)
 
-"BLD",7891,"KRN","B",8994,8994)
+"BLD",7883,"KRN","B",8994,8994)
 
-"BLD",7891,"PRE")
+"BLD",7883,"PRE")
 C0CENV
-"BLD",7891,"QUES",0)
+"BLD",7883,"QUES",0)
 ^9.62^^
-"BLD",7891,"REQB",0)
+"BLD",7883,"REQB",0)
 ^9.611^2^2
-"BLD",7891,"REQB",1,0)
+"BLD",7883,"REQB",1,0)
 NHIN 1.0^2
-"BLD",7891,"REQB",2,0)
+"BLD",7883,"REQB",2,0)
 NHIN*1.0*1^2
-"BLD",7891,"REQB","B","NHIN 1.0",1)
+"BLD",7883,"REQB","B","NHIN 1.0",1)
 
-"BLD",7891,"REQB","B","NHIN*1.0*1",2)
+"BLD",7883,"REQB","B","NHIN*1.0*1",2)
 
 "DATA",170,1,0)
@@ -90348,5 +90354,5 @@
 S X=DA(1)
 "KEY",178.101,178.101,"A",0)
-178.101^A^P^558
+178.101^A^P^554
 "KEY",178.101,178.101,"A",2,0)
 ^.312IA^2^2
@@ -90357,177 +90363,177 @@
 "KEYPTR",178.101,178.101,"A")
 178.101^C
-"KRN",19,10999,-1)
+"KRN",19,10988,-1)
 0^9
-"KRN",19,10999,0)
+"KRN",19,10988,0)
 C0C STATUS OF CCR BATCH^STATUS OF CCR BATCH^^I^^^^^^^^
-"KRN",19,10999,30)
+"KRN",19,10988,30)
 C0CB(
-"KRN",19,10999,31)
+"KRN",19,10988,31)
 AEMQ
-"KRN",19,10999,63)
+"KRN",19,10988,63)
 [C
-"KRN",19,10999,80)
+"KRN",19,10988,80)
 C0CB(
-"KRN",19,10999,"U")
+"KRN",19,10988,"U")
 STATUS OF CCR BATCH
-"KRN",19,11000,-1)
+"KRN",19,10989,-1)
 0^8
-"KRN",19,11000,0)
+"KRN",19,10989,0)
 C0C START CCR BATCH PROCESSING^BEGIN CCR BATCH PROCESSING^^A^^^^^^^^^^1
-"KRN",19,11000,20)
+"KRN",19,10989,20)
 D START^C0CBAT
-"KRN",19,11000,"U")
+"KRN",19,10989,"U")
 BEGIN CCR BATCH PROCESSING
-"KRN",19,11001,-1)
+"KRN",19,10990,-1)
 0^1
-"KRN",19,11001,0)
+"KRN",19,10990,0)
 C0C BATCH OPTIONS^BATCH CCR OPTIONS^^M^^^^^^^^
-"KRN",19,11001,10,0)
+"KRN",19,10990,10,0)
 ^19.01IP^3^3
-"KRN",19,11001,10,1,0)
-11000
-"KRN",19,11001,10,1,"^")
+"KRN",19,10990,10,1,0)
+10989
+"KRN",19,10990,10,1,"^")
 C0C START CCR BATCH PROCESSING
-"KRN",19,11001,10,2,0)
-10999
-"KRN",19,11001,10,2,"^")
+"KRN",19,10990,10,2,0)
+10988
+"KRN",19,10990,10,2,"^")
 C0C STATUS OF CCR BATCH
-"KRN",19,11001,10,3,0)
-11007
-"KRN",19,11001,10,3,"^")
+"KRN",19,10990,10,3,0)
+10996
+"KRN",19,10990,10,3,"^")
 C0C KILL BATCH JOB
-"KRN",19,11001,99)
-62633,35113
-"KRN",19,11001,"U")
+"KRN",19,10990,99)
+62759,57174
+"KRN",19,10990,"U")
 BATCH CCR OPTIONS
-"KRN",19,11002,-1)
+"KRN",19,10991,-1)
 0^3
-"KRN",19,11002,0)
+"KRN",19,10991,0)
 C0C CCR MENU^CCR MENU^^M^^^^^^^^
-"KRN",19,11002,10,0)
+"KRN",19,10991,10,0)
 ^19.01IP^5^5
-"KRN",19,11002,10,1,0)
-11001
-"KRN",19,11002,10,1,"^")
+"KRN",19,10991,10,1,0)
+10990
+"KRN",19,10991,10,1,"^")
 C0C BATCH OPTIONS
-"KRN",19,11002,10,2,0)
-11003
-"KRN",19,11002,10,2,"^")
+"KRN",19,10991,10,2,0)
+10992
+"KRN",19,10991,10,2,"^")
 C0C CCR EXPORT BY PATIENT NAME
-"KRN",19,11002,10,3,0)
-11005
-"KRN",19,11002,10,3,"^")
+"KRN",19,10991,10,3,0)
+10994
+"KRN",19,10991,10,3,"^")
 C0C DISPLAY ELEMENTS
-"KRN",19,11002,10,4,0)
-11004
-"KRN",19,11002,10,4,"^")
+"KRN",19,10991,10,4,0)
+10993
+"KRN",19,10991,10,4,"^")
 C0C DISPLAY PATIENT VARIABLES
-"KRN",19,11002,10,5,0)
-11006
-"KRN",19,11002,10,5,"^")
+"KRN",19,10991,10,5,0)
+10995
+"KRN",19,10991,10,5,"^")
 C0C LIST RIM CATEGORIES
-"KRN",19,11002,99)
-62633,35113
-"KRN",19,11002,"U")
+"KRN",19,10991,99)
+62759,57174
+"KRN",19,10991,"U")
 CCR MENU
-"KRN",19,11003,-1)
+"KRN",19,10992,-1)
 0^2
-"KRN",19,11003,0)
+"KRN",19,10992,0)
 C0C CCR EXPORT BY PATIENT NAME^CCR EXPORT BY PATIENT NAME^^A^^^^^^^^^^1
-"KRN",19,11003,20)
+"KRN",19,10992,20)
 D EXPORT^C0CCCR
-"KRN",19,11003,"U")
+"KRN",19,10992,"U")
 CCR EXPORT BY PATIENT NAME
-"KRN",19,11004,-1)
+"KRN",19,10993,-1)
 0^5
-"KRN",19,11004,0)
+"KRN",19,10993,0)
 C0C DISPLAY PATIENT VARIABLES^VARIABLES DISPLAY^^A^^^^^^^^^^1^1^^
-"KRN",19,11004,15)
+"KRN",19,10993,15)
 D DPATV^C0CRIMA($P(Y,U,1))
-"KRN",19,11004,20)
+"KRN",19,10993,20)
 S DIC=2,DIC(0)="AEMQ" D ^DIC I Y<1 Q
-"KRN",19,11004,26)
+"KRN",19,10993,26)
 
-"KRN",19,11004,"U")
+"KRN",19,10993,"U")
 VARIABLES DISPLAY
-"KRN",19,11005,-1)
+"KRN",19,10994,-1)
 0^4
-"KRN",19,11005,0)
+"KRN",19,10994,0)
 C0C DISPLAY ELEMENTS^ELEMENT DISPLAY^^I^^^^^^^^^^
-"KRN",19,11005,20)
+"KRN",19,10994,20)
 
-"KRN",19,11005,30)
+"KRN",19,10994,30)
 C0CE(
-"KRN",19,11005,31)
+"KRN",19,10994,31)
 AEMQ
-"KRN",19,11005,63)
+"KRN",19,10994,63)
 [C
-"KRN",19,11005,80)
+"KRN",19,10994,80)
 C0CE(
-"KRN",19,11005,"U")
+"KRN",19,10994,"U")
 ELEMENT DISPLAY
-"KRN",19,11006,-1)
+"KRN",19,10995,-1)
 0^7
-"KRN",19,11006,0)
+"KRN",19,10995,0)
 C0C LIST RIM CATEGORIES^LIST RIM CATEGORIES^^A^^^^^^^^^^1
-"KRN",19,11006,20)
+"KRN",19,10995,20)
 D CLIST^C0CRIMA
-"KRN",19,11006,"U")
+"KRN",19,10995,"U")
 LIST RIM CATEGORIES
-"KRN",19,11007,-1)
+"KRN",19,10996,-1)
 0^6
-"KRN",19,11007,0)
+"KRN",19,10996,0)
 C0C KILL BATCH JOB^KILL CCR BATCH PROCESSING^^A^^^^^^^^^^1
-"KRN",19,11007,20)
+"KRN",19,10996,20)
 D STOP^C0CBAT
-"KRN",19,11007,"U")
+"KRN",19,10996,"U")
 KILL CCR BATCH PROCESSING
-"KRN",19,11008,-1)
+"KRN",19,10997,-1)
 0^10
-"KRN",19,11008,0)
+"KRN",19,10997,0)
 C0C CCR RPC^CCR RPC^^B^^^^^^^^^y
-"KRN",19,11008,"RPC",0)
+"KRN",19,10997,"RPC",0)
 ^19.05P^1^1
-"KRN",19,11008,"RPC",1,0)
+"KRN",19,10997,"RPC",1,0)
 C0C CCR RPC
-"KRN",19,11008,"U")
+"KRN",19,10997,"U")
 CCR RPC
-"KRN",8994,2518,-1)
+"KRN",8994,2411,-1)
 0^1
-"KRN",8994,2518,0)
+"KRN",8994,2411,0)
 C0C CCR RPC^CCRRPC^C0CCCR^2^P
-"KRN",8994,2518,1,0)
+"KRN",8994,2411,1,0)
 ^8994.01^1^1^3090717^^
-"KRN",8994,2518,1,1,0)
+"KRN",8994,2411,1,1,0)
 RPC TO RETURN A PATIENT'S CCR
-"KRN",8994,2518,2,0)
+"KRN",8994,2411,2,0)
 ^8994.02A^3^3
-"KRN",8994,2518,2,1,0)
+"KRN",8994,2411,2,1,0)
 DFN^1^30^1^1
-"KRN",8994,2518,2,1,1,0)
+"KRN",8994,2411,2,1,1,0)
 ^^1^1^3090707^
-"KRN",8994,2518,2,1,1,1,0)
+"KRN",8994,2411,2,1,1,1,0)
 PATIENT RECORD NUMBER
-"KRN",8994,2518,2,2,0)
+"KRN",8994,2411,2,2,0)
 CCRPARMS^1^200^0^2
-"KRN",8994,2518,2,2,1,0)
+"KRN",8994,2411,2,2,1,0)
 ^^1^1^3090707^
-"KRN",8994,2518,2,2,1,1,0)
+"KRN",8994,2411,2,2,1,1,0)
 PARAMETERS TO OVERRIDE DEFAULTS FOR EXTRACTING THE CCR
-"KRN",8994,2518,2,3,0)
+"KRN",8994,2411,2,3,0)
 CCRPART^1^20^^3
-"KRN",8994,2518,2,"B","CCRPARM",2)
+"KRN",8994,2411,2,"B","CCRPARM",2)
 
-"KRN",8994,2518,2,"B","CCRPARMS",2)
+"KRN",8994,2411,2,"B","CCRPARMS",2)
 
-"KRN",8994,2518,2,"B","CCRPART",3)
+"KRN",8994,2411,2,"B","CCRPART",3)
 
-"KRN",8994,2518,2,"B","DFN",1)
+"KRN",8994,2411,2,"B","DFN",1)
 
-"KRN",8994,2518,2,"PARAMSEQ",1,1)
+"KRN",8994,2411,2,"PARAMSEQ",1,1)
 
-"KRN",8994,2518,2,"PARAMSEQ",2,2)
+"KRN",8994,2411,2,"PARAMSEQ",2,2)
 
-"KRN",8994,2518,2,"PARAMSEQ",3,3)
+"KRN",8994,2411,2,"PARAMSEQ",3,3)
 
 "MBREQ")
@@ -90541,387 +90547,393 @@
 "ORD",18,19,0)
 OPTION
-"PKG",213,-1)
+"PKG",210,-1)
 1^1
-"PKG",213,0)
+"PKG",210,0)
 CCD/CCR GENERATION UTILITIES^C0C^Utilities for the Generation of the CCD/C32/CCR
-"PKG",213,20,0)
+"PKG",210,20,0)
 ^9.402P^^
-"PKG",213,22,0)
+"PKG",210,22,0)
 ^9.49I^1^1
-"PKG",213,22,1,0)
-1.2^3120625^3120625^8
-"PKG",213,22,1,1,0)
-^^185^185^3120625
-"PKG",213,22,1,1,1,0)
+"PKG",210,22,1,0)
+1.2^3121030^3121029^8
+"PKG",210,22,1,1,0)
+^^188^188^3121030
+"PKG",210,22,1,1,1,0)
+Licensed under AGPL v3. For complete license text, see
+"PKG",210,22,1,1,2,0)
+http://www.gnu.org/licenses/agpl-3.0.html
+"PKG",210,22,1,1,3,0)
+ 
+"PKG",210,22,1,1,4,0)
 CCR Project release v1.2
-"PKG",213,22,1,1,2,0)
+"PKG",210,22,1,1,5,0)
  
-"PKG",213,22,1,1,3,0)
+"PKG",210,22,1,1,6,0)
 The purpose of the CCR package is to provide support for exporting and 
-"PKG",213,22,1,1,4,0)
+"PKG",210,22,1,1,7,0)
 eventually importing patient information from/to VistA in XML documents 
-"PKG",213,22,1,1,5,0)
+"PKG",210,22,1,1,8,0)
 conforming to the Continuity of Care Record (CCR - ASTM) and Continuity 
-"PKG",213,22,1,1,6,0)
+"PKG",210,22,1,1,9,0)
 of Care Document (CCD - HL7) standards.
-"PKG",213,22,1,1,7,0)
+"PKG",210,22,1,1,10,0)
  
-"PKG",213,22,1,1,8,0)
+"PKG",210,22,1,1,11,0)
 This version of the CCR package provides:
-"PKG",213,22,1,1,9,0)
+"PKG",210,22,1,1,12,0)
  
-"PKG",213,22,1,1,10,0)
+"PKG",210,22,1,1,13,0)
 EXPORT^C0CCCR
-"PKG",213,22,1,1,11,0)
+"PKG",210,22,1,1,14,0)
 A command line interface to export a single patient's CCR to a host 
-"PKG",213,22,1,1,12,0)
+"PKG",210,22,1,1,15,0)
 directory by specifying the patient by name.
-"PKG",213,22,1,1,13,0)
+"PKG",210,22,1,1,16,0)
  
-"PKG",213,22,1,1,14,0)
+"PKG",210,22,1,1,17,0)
 EXPORT^C0CCCD
-"PKG",213,22,1,1,15,0)
+"PKG",210,22,1,1,18,0)
 A command line interface to export a single patient's CCD to a host 
-"PKG",213,22,1,1,16,0)
+"PKG",210,22,1,1,19,0)
 directory by specifying the patient by name. As an alternative to 
-"PKG",213,22,1,1,17,0)
+"PKG",210,22,1,1,20,0)
 generating the CCD directly, an XSLT transformation is available to 
-"PKG",213,22,1,1,18,0)
+"PKG",210,22,1,1,21,0)
 translate a CCR into a level 2 CCD. This tranformation has been tested 
-"PKG",213,22,1,1,19,0)
+"PKG",210,22,1,1,22,0)
 and produces a CCD with all currently supported sections of the CCR. The 
-"PKG",213,22,1,1,20,0)
+"PKG",210,22,1,1,23,0)
 EXPORT^C0CCCD only extracts the PROBLEMS section into a CCD.
-"PKG",213,22,1,1,21,0)
+"PKG",210,22,1,1,24,0)
  
-"PKG",213,22,1,1,22,0)
+"PKG",210,22,1,1,25,0)
 XPAT^C0CCCR(DFN,OUTDIR,OUTFILE)
-"PKG",213,22,1,1,23,0)
+"PKG",210,22,1,1,26,0)
 A command line and program interface to export a single patient's CCR 
-"PKG",213,22,1,1,24,0)
+"PKG",210,22,1,1,27,0)
 using the IEN of the patient in the ^DPT file (DFN).
-"PKG",213,22,1,1,25,0)
+"PKG",210,22,1,1,28,0)
 OUTDIR specifies an existing directory on the Host system into which the 
-"PKG",213,22,1,1,26,0)
+"PKG",210,22,1,1,29,0)
 CCR XML document will be written. If OUTDIR is null (""), the output 
-"PKG",213,22,1,1,27,0)
+"PKG",210,22,1,1,30,0)
 directory name will be taken from ^TMP("C0CCCR","ODIR").
-"PKG",213,22,1,1,28,0)
+"PKG",210,22,1,1,31,0)
 OUFILE specifies the host file name of the CCR XML document that will be 
-"PKG",213,22,1,1,29,0)
+"PKG",210,22,1,1,32,0)
 written for this patient. If OUTFILE is null ("") the document name will 
-"PKG",213,22,1,1,30,0)
+"PKG",210,22,1,1,33,0)
 default to PAT_x_CCR_V1.xml where x is the DFN of the patient.
-"PKG",213,22,1,1,31,0)
+"PKG",210,22,1,1,34,0)
  
-"PKG",213,22,1,1,32,0)
+"PKG",210,22,1,1,35,0)
 CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART)
-"PKG",213,22,1,1,33,0)
+"PKG",210,22,1,1,36,0)
 An RPC and program interface to return in return array CCRGRTN (passed by 
-"PKG",213,22,1,1,34,0)
+"PKG",210,22,1,1,37,0)
 reference) a single patient's CCR.
-"PKG",213,22,1,1,35,0)
+"PKG",210,22,1,1,38,0)
 DFN is the patient's IEN
-"PKG",213,22,1,1,36,0)
+"PKG",210,22,1,1,39,0)
 CCRPART is what portion of the CCR should be returned. If "CCR" is 
-"PKG",213,22,1,1,37,0)
+"PKG",210,22,1,1,40,0)
 specified, the entire CCR will be returned. If "PROBLEMS", "VITALS", or 
-"PKG",213,22,1,1,38,0)
+"PKG",210,22,1,1,41,0)
 "MEDICATIONS" is specified, only that section of the CCR will be returned.
-"PKG",213,22,1,1,39,0)
+"PKG",210,22,1,1,42,0)
 CCRPARMS ARE PARAMETERS THAT AFFECT THE EXTRACTION
-"PKG",213,22,1,1,40,0)
+"PKG",210,22,1,1,43,0)
 IN THE FORM "PARM1:VALUE1^PARM2:VALUE2"
-"PKG",213,22,1,1,41,0)
+"PKG",210,22,1,1,44,0)
 EXAMPLE: "LABLIMIT:T-60" TO LIMIT LAB EXTRACTION TO THE LAST 60 DAYS
-"PKG",213,22,1,1,42,0)
+"PKG",210,22,1,1,45,0)
 SEE C0CPARMS FOR A COMPLETE LIST OF SUPPORTED PARAMETERS
-"PKG",213,22,1,1,43,0)
+"PKG",210,22,1,1,46,0)
  
-"PKG",213,22,1,1,44,0)
+"PKG",210,22,1,1,47,0)
 ANALYZE^C0CRIMA(BGNDFN,DFNCNT,CCRPARMS)
-"PKG",213,22,1,1,45,0)
+"PKG",210,22,1,1,48,0)
 A command line and program interface to analyze the data from multiple 
-"PKG",213,22,1,1,46,0)
+"PKG",210,22,1,1,49,0)
 patients into categories that can be batch extracted.
-"PKG",213,22,1,1,47,0)
+"PKG",210,22,1,1,50,0)
 BGNDFN is the beginning DFN to be analyzed. If BGNDFN is null ("") its 
-"PKG",213,22,1,1,48,0)
+"PKG",210,22,1,1,51,0)
 value will be taken from ^TMP("C0CRIM","RESUME"). If this variable does 
-"PKG",213,22,1,1,49,0)
+"PKG",210,22,1,1,52,0)
 not exist, the routine will start with the first IEN in the patient file 
-"PKG",213,22,1,1,50,0)
+"PKG",210,22,1,1,53,0)
 ^DPT. ^TMP("C0CRIM","RESUME") is updated to the "next" patient to be 
-"PKG",213,22,1,1,51,0)
+"PKG",210,22,1,1,54,0)
 analyzed on successful completion.
-"PKG",213,22,1,1,52,0)
+"PKG",210,22,1,1,55,0)
 DFNCNT is the count of how many patient records will be analyzed in this 
-"PKG",213,22,1,1,53,0)
+"PKG",210,22,1,1,56,0)
 execution.
-"PKG",213,22,1,1,54,0)
+"PKG",210,22,1,1,57,0)
 For example ANALYZE^C0CRIMA(1000,1000) would start at patient DFN 1000 
-"PKG",213,22,1,1,55,0)
+"PKG",210,22,1,1,58,0)
 and analyzes 1000 patient records. ANALYZE^C0CRIMA("",1000) would then 
-"PKG",213,22,1,1,56,0)
+"PKG",210,22,1,1,59,0)
 analyze the next 1000 patients. When the end of the patient file is 
-"PKG",213,22,1,1,57,0)
+"PKG",210,22,1,1,60,0)
 reached, the routine terminates with a message that RESET^C0CRIMA would 
-"PKG",213,22,1,1,58,0)
+"PKG",210,22,1,1,61,0)
 need to be called to restart the analysis.
-"PKG",213,22,1,1,59,0)
+"PKG",210,22,1,1,62,0)
  
-"PKG",213,22,1,1,60,0)
+"PKG",210,22,1,1,63,0)
 The categories into which the records are analyzed consist of attribute 
-"PKG",213,22,1,1,61,0)
+"PKG",210,22,1,1,64,0)
 strings. The attributes represent characteristics of the variables that 
-"PKG",213,22,1,1,62,0)
+"PKG",210,22,1,1,65,0)
 can be extracted for a given patient into the CCR or the CCD. This 
-"PKG",213,22,1,1,63,0)
+"PKG",210,22,1,1,66,0)
 version supports the following attributes:
-"PKG",213,22,1,1,64,0)
+"PKG",210,22,1,1,67,0)
 VITALS : the patient has variables for the VITALS section of the CCR/CCD
-"PKG",213,22,1,1,65,0)
+"PKG",210,22,1,1,68,0)
 PROBLEMS : the patient has variables for the PROBLEMS section of the 
-"PKG",213,22,1,1,66,0)
+"PKG",210,22,1,1,69,0)
 CCR/CCD
-"PKG",213,22,1,1,67,0)
+"PKG",210,22,1,1,70,0)
 MEDS : the patient has variables for the MEDICATIONS section of the 
-"PKG",213,22,1,1,68,0)
+"PKG",210,22,1,1,71,0)
 CCR/CCD
-"PKG",213,22,1,1,69,0)
+"PKG",210,22,1,1,72,0)
 HEADER : the patient has variables for the HEADER section of the CCR/CCD. 
-"PKG",213,22,1,1,70,0)
+"PKG",210,22,1,1,73,0)
 All patients are marked with the HEADER attribute in this version.
-"PKG",213,22,1,1,71,0)
+"PKG",210,22,1,1,74,0)
 NOTEXTRACTED : the CCR or CCD has not yet been produced/extracted for 
-"PKG",213,22,1,1,72,0)
+"PKG",210,22,1,1,75,0)
 this patient. All patient records are marked with the NOTEXTRACTED 
-"PKG",213,22,1,1,73,0)
+"PKG",210,22,1,1,76,0)
 attribute in this version for batch control processing (not implemented 
-"PKG",213,22,1,1,74,0)
+"PKG",210,22,1,1,77,0)
 in this version).
-"PKG",213,22,1,1,75,0)
+"PKG",210,22,1,1,78,0)
  
-"PKG",213,22,1,1,76,0)
+"PKG",210,22,1,1,79,0)
 ANAZYZE^C0CRIMA calls the variable extraction routines that would be used 
-"PKG",213,22,1,1,77,0)
+"PKG",210,22,1,1,80,0)
 to produce a CCR or a CCD and saves the results to ^TMP("C0CRIM",DFN) for 
-"PKG",213,22,1,1,78,0)
+"PKG",210,22,1,1,81,0)
 each patient. In addition, the attribute string for each patient is saved 
-"PKG",213,22,1,1,79,0)
+"PKG",210,22,1,1,82,0)
 in ^TMP("C0CRIM","ATTR")
-"PKG",213,22,1,1,80,0)
+"PKG",210,22,1,1,83,0)
  
-"PKG",213,22,1,1,81,0)
+"PKG",210,22,1,1,84,0)
 Categories are created as they first occur based on each unique 
-"PKG",213,22,1,1,82,0)
+"PKG",210,22,1,1,85,0)
 combination of attributes that is encountered. They are named after the 
-"PKG",213,22,1,1,83,0)
+"PKG",210,22,1,1,86,0)
 attribute table that is used for the analysis. This version supports only 
-"PKG",213,22,1,1,84,0)
+"PKG",210,22,1,1,87,0)
 the attribute table .RIMTBL. and the categories are named "RIMTBL_x". An 
-"PKG",213,22,1,1,85,0)
+"PKG",210,22,1,1,88,0)
 example set of categories from a demo systems is:
-"PKG",213,22,1,1,86,0)
+"PKG",210,22,1,1,89,0)
  
-"PKG",213,22,1,1,87,0)
+"PKG",210,22,1,1,90,0)
 GTM>D CLIST^C0CRIMA
-"PKG",213,22,1,1,88,0)
+"PKG",210,22,1,1,91,0)
 (RIMTBL_1:105) ^NOTEXTRACTED^HEADER^^^PROBLEMS^^^^^VITALS^^^^^MEDS
-"PKG",213,22,1,1,89,0)
+"PKG",210,22,1,1,92,0)
 (RIMTBL_2:596) ^NOTEXTRACTED^HEADER^^^^^^^^VITALS
-"PKG",213,22,1,1,90,0)
+"PKG",210,22,1,1,93,0)
 (RIMTBL_3:44) ^NOTEXTRACTED^HEADER^^^PROBLEMS^^^^^VITALS
-"PKG",213,22,1,1,91,0)
+"PKG",210,22,1,1,94,0)
 (RIMTBL_4:821) ^NOTEXTRACTED^HEADER
-"PKG",213,22,1,1,92,0)
+"PKG",210,22,1,1,95,0)
 (RIMTBL_5:18) ^NOTEXTRACTED^HEADER^^^^^^^^VITALS^^^^^MEDS
-"PKG",213,22,1,1,93,0)
+"PKG",210,22,1,1,96,0)
 (RIMTBL_6:14) ^NOTEXTRACTED^HEADER^^^PROBLEMS
-"PKG",213,22,1,1,94,0)
+"PKG",210,22,1,1,97,0)
 (RIMTBL_7:15) ^NOTEXTRACTED^HEADER^^^^^^^^^^^^^MEDS
-"PKG",213,22,1,1,95,0)
+"PKG",210,22,1,1,98,0)
 (RIMTBL_8:5) ^NOTEXTRACTED^HEADER^^^PROBLEMS^^^^^^^^^^MEDS
-"PKG",213,22,1,1,96,0)
+"PKG",210,22,1,1,99,0)
  
-"PKG",213,22,1,1,97,0)
+"PKG",210,22,1,1,100,0)
 for RIMTBL_1 in this example, 105 is the record count of patients who 
-"PKG",213,22,1,1,98,0)
+"PKG",210,22,1,1,101,0)
 have this combination of attributes. The list of patients for each 
-"PKG",213,22,1,1,99,0)
+"PKG",210,22,1,1,102,0)
 category is also maintained for batch extraction.
-"PKG",213,22,1,1,100,0)
+"PKG",210,22,1,1,103,0)
  
-"PKG",213,22,1,1,101,0)
+"PKG",210,22,1,1,104,0)
 CLIST^C0CRIMA
-"PKG",213,22,1,1,102,0)
+"PKG",210,22,1,1,105,0)
 A command line interface to show a summary of the categories, record 
-"PKG",213,22,1,1,103,0)
+"PKG",210,22,1,1,106,0)
 counts, and attributes that have been analyzed so far. It produces the 
-"PKG",213,22,1,1,104,0)
+"PKG",210,22,1,1,107,0)
 listing in the example above from information stored in 
-"PKG",213,22,1,1,105,0)
+"PKG",210,22,1,1,108,0)
 ^TMP("C0CRIM","CATS","RIMTBL"). It is intended for future versions that 
-"PKG",213,22,1,1,106,0)
+"PKG",210,22,1,1,109,0)
 attribute tables be supported in addition to the default "RIMTBL".
-"PKG",213,22,1,1,107,0)
+"PKG",210,22,1,1,110,0)
  
-"PKG",213,22,1,1,108,0)
+"PKG",210,22,1,1,111,0)
 CPAT^C0CRIMA(CPATCAT)
-"PKG",213,22,1,1,109,0)
+"PKG",210,22,1,1,112,0)
 A command line interface which shows the DFN numbers of the patients 
-"PKG",213,22,1,1,110,0)
+"PKG",210,22,1,1,113,0)
 represented by the category CPATCAT. DFNs are listed 10 per line. For 
-"PKG",213,22,1,1,111,0)
+"PKG",210,22,1,1,114,0)
 example:
-"PKG",213,22,1,1,112,0)
+"PKG",210,22,1,1,115,0)
  
-"PKG",213,22,1,1,113,0)
+"PKG",210,22,1,1,116,0)
 GTM>D CPAT^C0CRIMA("RIMTBL_1")
-"PKG",213,22,1,1,114,0)
+"PKG",210,22,1,1,117,0)
 1 3 8 25 42 69 123 140 146 149
-"PKG",213,22,1,1,115,0)
+"PKG",210,22,1,1,118,0)
 151 168 204 205 217 218 224 228 229 231
-"PKG",213,22,1,1,116,0)
+"PKG",210,22,1,1,119,0)
 236 237 240 253 260 267 271 301 347 350
-"PKG",213,22,1,1,117,0)
+"PKG",210,22,1,1,120,0)
 366 379 384 391 407 418 419 420 428 433
-"PKG",213,22,1,1,118,0)
+"PKG",210,22,1,1,121,0)
 442 520 569 600 620 692 706 715 722 723
-"PKG",213,22,1,1,119,0)
+"PKG",210,22,1,1,122,0)
 724 728 730 744 745 746 747 748 749 750
-"PKG",213,22,1,1,120,0)
+"PKG",210,22,1,1,123,0)
 751 752 753 754 755 756 757 758 759 760
-"PKG",213,22,1,1,121,0)
+"PKG",210,22,1,1,124,0)
 761 762 763 764 765 766 767 768 769 770
-"PKG",213,22,1,1,122,0)
+"PKG",210,22,1,1,125,0)
 771 772 773 774 775 776 777 778 779 780
-"PKG",213,22,1,1,123,0)
+"PKG",210,22,1,1,126,0)
 100000 100001 100002 100003 100004 100005 100006 100007 100008 100009
-"PKG",213,22,1,1,124,0)
+"PKG",210,22,1,1,127,0)
 100010 100011 100012 100013 100014
-"PKG",213,22,1,1,125,0)
+"PKG",210,22,1,1,128,0)
  
-"PKG",213,22,1,1,126,0)
+"PKG",210,22,1,1,129,0)
 These are the 105 patient records included in category "RIMTBL_1" from 
-"PKG",213,22,1,1,127,0)
+"PKG",210,22,1,1,130,0)
 the above example.
-"PKG",213,22,1,1,128,0)
+"PKG",210,22,1,1,131,0)
  
-"PKG",213,22,1,1,129,0)
+"PKG",210,22,1,1,132,0)
 DPATV^C0CRIMA(DFN,"SECTION")
-"PKG",213,22,1,1,130,0)
+"PKG",210,22,1,1,133,0)
 A command line interface to display the values of variables for a 
-"PKG",213,22,1,1,131,0)
+"PKG",210,22,1,1,134,0)
 patient. "SECTION" can be any of the CCR sections. ie 
-"PKG",213,22,1,1,132,0)
+"PKG",210,22,1,1,135,0)
 "ALERTS","RESULTS","MEDS". If SECTION is ommitted, all sections will be 
-"PKG",213,22,1,1,133,0)
+"PKG",210,22,1,1,136,0)
 shown. An example:
-"PKG",213,22,1,1,134,0)
+"PKG",210,22,1,1,137,0)
  
-"PKG",213,22,1,1,135,0)
+"PKG",210,22,1,1,138,0)
 GTM>D DPATV^C0CRIMA(2,"PROBLEMS")
-"PKG",213,22,1,1,136,0)
+"PKG",210,22,1,1,139,0)
 1 1^PROBLEMCODEVALUE^V18.0
-"PKG",213,22,1,1,137,0)
+"PKG",210,22,1,1,140,0)
 2 1^PROBLEMCODINGVERSION^
-"PKG",213,22,1,1,138,0)
+"PKG",210,22,1,1,141,0)
 3 1^PROBLEMCONDITION^P
-"PKG",213,22,1,1,139,0)
+"PKG",210,22,1,1,142,0)
 4 1^PROBLEMDATEMOD^2005-07-19T00:00:00-05:00
-"PKG",213,22,1,1,140,0)
+"PKG",210,22,1,1,143,0)
 5 1^PROBLEMDATEOFONSET^1700--T00:00:00-05:00
-"PKG",213,22,1,1,141,0)
+"PKG",210,22,1,1,144,0)
 6 1^PROBLEMDESCRIPTION^Family History of Diabetes Mellitus (ICD-9-CM 
-"PKG",213,22,1,1,142,0)
+"PKG",210,22,1,1,145,0)
 V18.0)
-"PKG",213,22,1,1,143,0)
+"PKG",210,22,1,1,146,0)
 7 1^PROBLEMDTREC^1701--T00:00:00-05:00
-"PKG",213,22,1,1,144,0)
+"PKG",210,22,1,1,147,0)
 8 1^PROBLEMHASCMT^
-"PKG",213,22,1,1,145,0)
+"PKG",210,22,1,1,148,0)
 9 1^PROBLEMIEN^8
-"PKG",213,22,1,1,146,0)
+"PKG",210,22,1,1,149,0)
 10 1^PROBLEMINACT^1700--T00:00:00-05:00
-"PKG",213,22,1,1,147,0)
+"PKG",210,22,1,1,150,0)
  
-"PKG",213,22,1,1,148,0)
+"PKG",210,22,1,1,151,0)
 DCCR^C0CCCR(DFN)
-"PKG",213,22,1,1,149,0)
+"PKG",210,22,1,1,152,0)
 This will display the XML of a CCR that has been generated for a patient. 
-"PKG",213,22,1,1,150,0)
+"PKG",210,22,1,1,153,0)
 It is run after generating the CCR with XPAT^C0CCCR or XCPAT^C0CRIMA.
-"PKG",213,22,1,1,151,0)
+"PKG",210,22,1,1,154,0)
  
-"PKG",213,22,1,1,152,0)
+"PKG",210,22,1,1,155,0)
 XCPAT^C0CRIMA(CPATCAT)
-"PKG",213,22,1,1,153,0)
+"PKG",210,22,1,1,156,0)
 A command line interface to extract a batch of patient CCR documents that 
-"PKG",213,22,1,1,154,0)
+"PKG",210,22,1,1,157,0)
 are associated with the category CPATCAT. For example,
-"PKG",213,22,1,1,155,0)
+"PKG",210,22,1,1,158,0)
  
-"PKG",213,22,1,1,156,0)
+"PKG",210,22,1,1,159,0)
 XCPAT^C0CRIMA("RIMTBL_1") to extract the CCR documents for the 105 
-"PKG",213,22,1,1,157,0)
+"PKG",210,22,1,1,160,0)
 patients in the above example.
-"PKG",213,22,1,1,158,0)
+"PKG",210,22,1,1,161,0)
  
-"PKG",213,22,1,1,159,0)
+"PKG",210,22,1,1,162,0)
 RESET^C0CRIMA
-"PKG",213,22,1,1,160,0)
+"PKG",210,22,1,1,163,0)
 A command line interface to kill all ANALYZE^C0CRIMA results stored so 
-"PKG",213,22,1,1,161,0)
+"PKG",210,22,1,1,164,0)
 far so that the analysis can be done again. It kills 
-"PKG",213,22,1,1,162,0)
+"PKG",210,22,1,1,165,0)
 ^TMP("C0CRIM","RESUME") and all extraction variables that have been saved 
-"PKG",213,22,1,1,163,0)
+"PKG",210,22,1,1,166,0)
 in ^TMP("C0CRIM")
-"PKG",213,22,1,1,164,0)
+"PKG",210,22,1,1,167,0)
  
-"PKG",213,22,1,1,165,0)
+"PKG",210,22,1,1,168,0)
 NOTES:
-"PKG",213,22,1,1,166,0)
+"PKG",210,22,1,1,169,0)
 This version of the package is a prototype, and does not yet make use of 
-"PKG",213,22,1,1,167,0)
+"PKG",210,22,1,1,170,0)
 the standard VistA features that are appropriate for it to use.
-"PKG",213,22,1,1,168,0)
+"PKG",210,22,1,1,171,0)
  
-"PKG",213,22,1,1,169,0)
+"PKG",210,22,1,1,172,0)
 ^TMP("C0CCCR","ODIR") must be set manually to the output directory on the 
-"PKG",213,22,1,1,170,0)
+"PKG",210,22,1,1,173,0)
 Host System. It is intended that this be maintainable in a parameter file.
-"PKG",213,22,1,1,171,0)
+"PKG",210,22,1,1,174,0)
  
-"PKG",213,22,1,1,172,0)
+"PKG",210,22,1,1,175,0)
 CCRRPC^C0CCCR and CCDRPC^C0CCCD are intended to be RPC interfaces to the 
-"PKG",213,22,1,1,173,0)
+"PKG",210,22,1,1,176,0)
 package but there is no entry for them in the RPC table and the RPC 
-"PKG",213,22,1,1,174,0)
+"PKG",210,22,1,1,177,0)
 method of access has not been tested.
-"PKG",213,22,1,1,175,0)
+"PKG",210,22,1,1,178,0)
  
-"PKG",213,22,1,1,176,0)
+"PKG",210,22,1,1,179,0)
 Most of the command line interface functions in the package are intended 
-"PKG",213,22,1,1,177,0)
+"PKG",210,22,1,1,180,0)
 to also be made available as RPC calls. This will provide the ability to 
-"PKG",213,22,1,1,178,0)
+"PKG",210,22,1,1,181,0)
 invoke and control batch extraction and analysis via RPCs
-"PKG",213,22,1,1,179,0)
+"PKG",210,22,1,1,182,0)
  
-"PKG",213,22,1,1,180,0)
+"PKG",210,22,1,1,183,0)
 The "RIM" variables and attributes that are now being stored in 
-"PKG",213,22,1,1,181,0)
+"PKG",210,22,1,1,184,0)
 ^TMP("C0CRIM") are intended to be maintained in a standard FILEMAN 
-"PKG",213,22,1,1,182,0)
+"PKG",210,22,1,1,185,0)
 global, and to take advantage of FILEMAN indexing for efficient batch 
-"PKG",213,22,1,1,183,0)
+"PKG",210,22,1,1,186,0)
 analysis and processing.
-"PKG",213,22,1,1,184,0)
+"PKG",210,22,1,1,187,0)
  
-"PKG",213,22,1,1,185,0)
+"PKG",210,22,1,1,188,0)
 It is intended that menu interfaces be provided in addition to command 
-"PKG",213,"VERSION")
+"PKG",210,"VERSION")
 1.2
 "PRE")
@@ -91000,2323 +91012,2299 @@
 79
 "RTN","C0CACTOR")
-0^47^B99733742
+0^47^B98169360
 "RTN","C0CACTOR",1,0)
-C0CACTOR  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
+C0CACTOR  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08 ; 10/29/12 4:04pm
 "RTN","C0CACTOR",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CACTOR",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
 "RTN","C0CACTOR",4,0)
- ;Licensed under the terms of the GNU General Public License.
+ ;
 "RTN","C0CACTOR",5,0)
- ;See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CACTOR",6,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CACTOR",7,0)
- ; This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CACTOR",8,0)
- ; it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CACTOR",9,0)
- ; the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CACTOR",10,0)
- ; (at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CACTOR",11,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CACTOR",12,0)
- ; This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CACTOR",13,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CACTOR",14,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CACTOR",15,0)
- ; GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CACTOR",16,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CACTOR",17,0)
- ; You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CACTOR",18,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
+ ;  PROCESS THE ACTORS SECTION OF THE CCR
 "RTN","C0CACTOR",19,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
 "RTN","C0CACTOR",20,0)
- ;
+ ; ===Revision History===
 "RTN","C0CACTOR",21,0)
- ;  PROCESS THE ACTORS SECTION OF THE CCR
+ ; 0.1 Initial Writing of Skeleton--GPL
 "RTN","C0CACTOR",22,0)
- ;
+ ; 0.2 Patient Data Extraction--SMH
 "RTN","C0CACTOR",23,0)
- ; ===Revision History===
+ ; 0.3 Information System Info Extraction--SMH
 "RTN","C0CACTOR",24,0)
- ; 0.1 Initial Writing of Skeleton--GPL
+ ; 0.4 Patient data rouine refactored; adjustments here--SMH
 "RTN","C0CACTOR",25,0)
- ; 0.2 Patient Data Extraction--SMH
+ ;
 "RTN","C0CACTOR",26,0)
- ; 0.3 Information System Info Extraction--SMH
+EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
 "RTN","C0CACTOR",27,0)
- ; 0.4 Patient data rouine refactored; adjustments here--SMH
+ ; IPXML is the Input Actor Template into which we  substitute values
 "RTN","C0CACTOR",28,0)
- ;
+ ; This is straight XML. Values to be substituted are in @@VAL@@ format.
 "RTN","C0CACTOR",29,0)
-EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
+ ; ALST is the actor list global generated by ACTLST^C0CCCR and has format:
 "RTN","C0CACTOR",30,0)
- ; IPXML is the Input Actor Template into which we  substitute values
+ ; ^TMP(7542,1,"ACTORS",0)=Count
 "RTN","C0CACTOR",31,0)
- ; This is straight XML. Values to be substituted are in @@VAL@@ format.
+ ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
 "RTN","C0CACTOR",32,0)
- ; ALST is the actor list global generated by ACTLST^C0CCCR and has format:
+ ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
 "RTN","C0CACTOR",33,0)
- ; ^TMP(7542,1,"ACTORS",0)=Count
+ ; AXML is the output arrary, to contain XML.
 "RTN","C0CACTOR",34,0)
- ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
+ ;
 "RTN","C0CACTOR",35,0)
- ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
+ N I,J,AMAP,AOID,ATYP,AIEN
 "RTN","C0CACTOR",36,0)
- ; AXML is the output arrary, to contain XML.
+ D CP^C0CXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
 "RTN","C0CACTOR",37,0)
- ;
+ D REPLACE^C0CXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
 "RTN","C0CACTOR",38,0)
- N I,J,AMAP,AOID,ATYP,AIEN
+ I DEBUG W "PROCESSING ACTORS ",!
 "RTN","C0CACTOR",39,0)
- D CP^C0CXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
+ F I=1:1:@ALST@(0) D  ; PROCESS ALL ACTORS IN THE LIST
 "RTN","C0CACTOR",40,0)
- D REPLACE^C0CXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
+ . I @ALST@(I)["@@" Q  ; NOT A VALID ACTOR
 "RTN","C0CACTOR",41,0)
- I DEBUG W "PROCESSING ACTORS ",!
+ . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
 "RTN","C0CACTOR",42,0)
- F I=1:1:@ALST@(0) D  ; PROCESS ALL ACTORS IN THE LIST
+ . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
 "RTN","C0CACTOR",43,0)
- . I @ALST@(I)["@@" Q  ; NOT A VALID ACTOR
+ . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
 "RTN","C0CACTOR",44,0)
- . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
+ . I AIEN="" D  Q  ; IEN CAN'T BE NULL
 "RTN","C0CACTOR",45,0)
- . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
+ . . W "WARING NUL ACTOR: ",ATYP,!
 "RTN","C0CACTOR",46,0)
- . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
+ . I ATYP="" Q  ; NOT A VALID ACTOR
 "RTN","C0CACTOR",47,0)
- . I AIEN="" D  Q  ; IEN CAN'T BE NULL
+ . ;
 "RTN","C0CACTOR",48,0)
- . . W "WARING NUL ACTOR: ",ATYP,!
+ . I DEBUG W AOID_" "_ATYP_" "_AIEN,!
 "RTN","C0CACTOR",49,0)
- . I ATYP="" Q  ; NOT A VALID ACTOR
+ . I ATYP="PATIENT" D  ; PATIENT ACTOR TYPE
 "RTN","C0CACTOR",50,0)
+ . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
+"RTN","C0CACTOR",51,0)
+ . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
+"RTN","C0CACTOR",52,0)
  . ;
-"RTN","C0CACTOR",51,0)
- . I DEBUG W AOID_" "_ATYP_" "_AIEN,!
-"RTN","C0CACTOR",52,0)
- . I ATYP="PATIENT" D  ; PATIENT ACTOR TYPE
 "RTN","C0CACTOR",53,0)
- . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
+ . I ATYP="SYSTEM" D  ; SYSTEM ACTOR TYPE
 "RTN","C0CACTOR",54,0)
- . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
+ . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
 "RTN","C0CACTOR",55,0)
+ . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
+"RTN","C0CACTOR",56,0)
  . ;
-"RTN","C0CACTOR",56,0)
- . I ATYP="SYSTEM" D  ; SYSTEM ACTOR TYPE
 "RTN","C0CACTOR",57,0)
- . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
+ . I ATYP="NOK" D  ; NOK ACTOR TYPE
 "RTN","C0CACTOR",58,0)
- . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
+ . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
 "RTN","C0CACTOR",59,0)
+ . . D NOK("ATMP",AIEN,AOID,"ATMP2")
+"RTN","C0CACTOR",60,0)
  . ;
-"RTN","C0CACTOR",60,0)
- . I ATYP="NOK" D  ; NOK ACTOR TYPE
 "RTN","C0CACTOR",61,0)
- . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
+ . I ATYP="PROVIDER" D  ; PROVIDER ACTOR TYPE
 "RTN","C0CACTOR",62,0)
- . . D NOK("ATMP",AIEN,AOID,"ATMP2")
+ . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
 "RTN","C0CACTOR",63,0)
+ . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
+"RTN","C0CACTOR",64,0)
  . ;
-"RTN","C0CACTOR",64,0)
- . I ATYP="PROVIDER" D  ; PROVIDER ACTOR TYPE
 "RTN","C0CACTOR",65,0)
- . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
+ . I ATYP="ORGANIZATION" D  ; PROVIDER ACTOR TYPE
 "RTN","C0CACTOR",66,0)
- . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
+ . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
 "RTN","C0CACTOR",67,0)
+ . . D ORG("ATMP",AIEN,AOID,"ATMP2")
+"RTN","C0CACTOR",68,0)
  . ;
-"RTN","C0CACTOR",68,0)
- . I ATYP="ORGANIZATION" D  ; PROVIDER ACTOR TYPE
 "RTN","C0CACTOR",69,0)
- . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
+ . W "PROCESSING:",ATYP," ",AIEN,!
 "RTN","C0CACTOR",70,0)
- . . D ORG("ATMP",AIEN,AOID,"ATMP2")
+ . ;I @ATMP2@(0)=0 Q  ; NOTHING RETURNED, SKIP THIS ONE
 "RTN","C0CACTOR",71,0)
- . ;
+ . D INSINNER^C0CXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
 "RTN","C0CACTOR",72,0)
- . W "PROCESSING:",ATYP," ",AIEN,!
+ . K ATYP,AIEN,AOID,ATMP,ATMP2 ; BE SURE TO GET THE NEXT ONE
 "RTN","C0CACTOR",73,0)
- . ;I @ATMP2@(0)=0 Q  ; NOTHING RETURNED, SKIP THIS ONE
+ ;
 "RTN","C0CACTOR",74,0)
- . D INSINNER^C0CXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
+ N ACTTMP
 "RTN","C0CACTOR",75,0)
- . K ATYP,AIEN,AOID,ATMP,ATMP2 ; BE SURE TO GET THE NEXT ONE
+ D MISSING^C0CXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
 "RTN","C0CACTOR",76,0)
- ;
+ I ACTTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
 "RTN","C0CACTOR",77,0)
- N ACTTMP
+ . ; STRINGS MARKED AS @@X@@
 "RTN","C0CACTOR",78,0)
- D MISSING^C0CXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
+ . W "ACTORS Missing list: ",!
 "RTN","C0CACTOR",79,0)
- I ACTTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
+ . F I=1:1:ACTTMP(0) W ACTTMP(I),!
 "RTN","C0CACTOR",80,0)
- . ; STRINGS MARKED AS @@X@@
+ Q
 "RTN","C0CACTOR",81,0)
- . W "ACTORS Missing list: ",!
+ ;
 "RTN","C0CACTOR",82,0)
- . F I=1:1:ACTTMP(0) W ACTTMP(I),!
+PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
 "RTN","C0CACTOR",83,0)
+ I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
+"RTN","C0CACTOR",84,0)
+ ;GPL SEPARATED EXTRACT FROM MAP FOR PROCESSING PATIENTS - TO MAKE
+"RTN","C0CACTOR",85,0)
+ ; CODE REUSABLE FROM ERX
+"RTN","C0CACTOR",86,0)
+ N AMAP
+"RTN","C0CACTOR",87,0)
+ S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","C0CACTOR",88,0)
+ K @AMAP
+"RTN","C0CACTOR",89,0)
+ D PEXTRACT(AMAP,AIEN,AOID) ;EXTRACT THE PATIENT ACTOR
+"RTN","C0CACTOR",90,0)
+ I $P($$SITE^VASITE(),U,2)="OROVILLE HOSPITAL" S C0CDE=1
+"RTN","C0CACTOR",91,0)
+ I $G(C0CDE)'="" D DEIDENT(AMAP,AIEN) ; DEIDENTIFY THE CCR
+"RTN","C0CACTOR",92,0)
+ D MAP(INXML,AMAP,OUTXML) ;MAP TO XML
+"RTN","C0CACTOR",93,0)
+ K @AMAP ; CLEAN UP BEHIND US
+"RTN","C0CACTOR",94,0)
  Q
-"RTN","C0CACTOR",84,0)
- ;
-"RTN","C0CACTOR",85,0)
-PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
-"RTN","C0CACTOR",86,0)
- I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
-"RTN","C0CACTOR",87,0)
- ;GPL SEPARATED EXTRACT FROM MAP FOR PROCESSING PATIENTS - TO MAKE
-"RTN","C0CACTOR",88,0)
- ; CODE REUSABLE FROM ERX
-"RTN","C0CACTOR",89,0)
- N AMAP
-"RTN","C0CACTOR",90,0)
- S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","C0CACTOR",91,0)
- K @AMAP
-"RTN","C0CACTOR",92,0)
- D PEXTRACT(AMAP,AIEN,AOID) ;EXTRACT THE PATIENT ACTOR
-"RTN","C0CACTOR",93,0)
- I $P($$SITE^VASITE(),U,2)="OROVILLE HOSPITAL" S C0CDE=1
-"RTN","C0CACTOR",94,0)
- I $G(C0CDE)'="" D DEIDENT(AMAP,AIEN) ; DEIDENTIFY THE CCR
 "RTN","C0CACTOR",95,0)
- D MAP(INXML,AMAP,OUTXML) ;MAP TO XML
+ ;
 "RTN","C0CACTOR",96,0)
- K @AMAP ; CLEAN UP BEHIND US
+DEIDENT(GPL,ZDFN) ; QUICK WAY TO DEIDENTIFY THE CCR
 "RTN","C0CACTOR",97,0)
+ S @GPL@("ACTORADDRESSCITY")="ALTON"
+"RTN","C0CACTOR",98,0)
+ S @GPL@("ACTORADDRESSLINE1")="1234 Somewhere Lane"
+"RTN","C0CACTOR",99,0)
+ S @GPL@("ACTORADDRESSLINE2")=""
+"RTN","C0CACTOR",100,0)
+ S @GPL@("ACTORADDRESSSOURCEID")="ACTORPATIENT_"_ZDFN
+"RTN","C0CACTOR",101,0)
+ S @GPL@("ACTORADDRESSSTATE")="KANSAS"
+"RTN","C0CACTOR",102,0)
+ S @GPL@("ACTORADDRESSTYPE")="Home"
+"RTN","C0CACTOR",103,0)
+ S @GPL@("ACTORADDRESSZIPCODE")=67623
+"RTN","C0CACTOR",104,0)
+ S @GPL@("ACTORCELLTEL")=""
+"RTN","C0CACTOR",105,0)
+ S @GPL@("ACTORCELLTELTEXT")=""
+"RTN","C0CACTOR",106,0)
+ S @GPL@("ACTORDATEOFBIRTH")="1957-12-25"
+"RTN","C0CACTOR",107,0)
+ S @GPL@("ACTOREMAIL")=""
+"RTN","C0CACTOR",108,0)
+ S @GPL@("ACTORFAMILYNAME")="ZZ PATIENT"_ZDFN
+"RTN","C0CACTOR",109,0)
+ ;S @GPL@("ACTORGENDER")="MALE"
+"RTN","C0CACTOR",110,0)
+ S @GPL@("ACTORGIVENNAME")="TEST"_ZDFN
+"RTN","C0CACTOR",111,0)
+ S @GPL@("ACTORIEN")=2
+"RTN","C0CACTOR",112,0)
+ S @GPL@("ACTORMIDDLENAME")="TWO"
+"RTN","C0CACTOR",113,0)
+ S @GPL@("ACTOROBJECTID")="ACTORPATIENT_"_ZDFN
+"RTN","C0CACTOR",114,0)
+ S @GPL@("ACTORRESTEL")="888-555-1212"
+"RTN","C0CACTOR",115,0)
+ S @GPL@("ACTORRESTELTEXT")="Residential Telephone"
+"RTN","C0CACTOR",116,0)
+ S @GPL@("ACTORSOURCEID")="ACTORSYSTEM_1"
+"RTN","C0CACTOR",117,0)
+ S @GPL@("ACTORSSN")="769122557P"
+"RTN","C0CACTOR",118,0)
+ S @GPL@("ACTORSSNSOURCEID")="ACTORPATIENT_"_ZDFN
+"RTN","C0CACTOR",119,0)
+ S @GPL@("ACTORSSNTEXT")="SSN"
+"RTN","C0CACTOR",120,0)
+ S @GPL@("ACTORSUFFIXNAME")=""
+"RTN","C0CACTOR",121,0)
+ S @GPL@("ACTORWORKTEL")="888-121-1212"
+"RTN","C0CACTOR",122,0)
+ S @GPL@("ACTORWORKTELTEXT")="Work Telephone"
+"RTN","C0CACTOR",123,0)
  Q
-"RTN","C0CACTOR",98,0)
- ;
-"RTN","C0CACTOR",99,0)
-DEIDENT(GPL,ZDFN) ; QUICK WAY TO DEIDENTIFY THE CCR
-"RTN","C0CACTOR",100,0)
- S @GPL@("ACTORADDRESSCITY")="ALTON"
-"RTN","C0CACTOR",101,0)
- S @GPL@("ACTORADDRESSLINE1")="1234 Somewhere Lane"
-"RTN","C0CACTOR",102,0)
- S @GPL@("ACTORADDRESSLINE2")=""
-"RTN","C0CACTOR",103,0)
- S @GPL@("ACTORADDRESSSOURCEID")="ACTORPATIENT_"_ZDFN
-"RTN","C0CACTOR",104,0)
- S @GPL@("ACTORADDRESSSTATE")="KANSAS"
-"RTN","C0CACTOR",105,0)
- S @GPL@("ACTORADDRESSTYPE")="Home"
-"RTN","C0CACTOR",106,0)
- S @GPL@("ACTORADDRESSZIPCODE")=67623
-"RTN","C0CACTOR",107,0)
- S @GPL@("ACTORCELLTEL")=""
-"RTN","C0CACTOR",108,0)
- S @GPL@("ACTORCELLTELTEXT")=""
-"RTN","C0CACTOR",109,0)
- S @GPL@("ACTORDATEOFBIRTH")="1957-12-25"
-"RTN","C0CACTOR",110,0)
- S @GPL@("ACTOREMAIL")=""
-"RTN","C0CACTOR",111,0)
- S @GPL@("ACTORFAMILYNAME")="ZZ PATIENT"_ZDFN
-"RTN","C0CACTOR",112,0)
- ;S @GPL@("ACTORGENDER")="MALE"
-"RTN","C0CACTOR",113,0)
- S @GPL@("ACTORGIVENNAME")="TEST"_ZDFN
-"RTN","C0CACTOR",114,0)
- S @GPL@("ACTORIEN")=2
-"RTN","C0CACTOR",115,0)
- S @GPL@("ACTORMIDDLENAME")="TWO"
-"RTN","C0CACTOR",116,0)
- S @GPL@("ACTOROBJECTID")="ACTORPATIENT_"_ZDFN
-"RTN","C0CACTOR",117,0)
- S @GPL@("ACTORRESTEL")="888-555-1212"
-"RTN","C0CACTOR",118,0)
- S @GPL@("ACTORRESTELTEXT")="Residential Telephone"
-"RTN","C0CACTOR",119,0)
- S @GPL@("ACTORSOURCEID")="ACTORSYSTEM_1"
-"RTN","C0CACTOR",120,0)
- S @GPL@("ACTORSSN")="769122557P"
-"RTN","C0CACTOR",121,0)
- S @GPL@("ACTORSSNSOURCEID")="ACTORPATIENT_"_ZDFN
-"RTN","C0CACTOR",122,0)
- S @GPL@("ACTORSSNTEXT")="SSN"
-"RTN","C0CACTOR",123,0)
- S @GPL@("ACTORSUFFIXNAME")=""
 "RTN","C0CACTOR",124,0)
- S @GPL@("ACTORWORKTEL")="888-121-1212"
+ ;
 "RTN","C0CACTOR",125,0)
- S @GPL@("ACTORWORKTELTEXT")="Work Telephone"
+PEXTRACT(AMAP,AIEN,AOID) ; EXTRACT TO RETURN ARRAY RARY PASSED BY NAME
 "RTN","C0CACTOR",126,0)
+ N ZX
+"RTN","C0CACTOR",127,0)
+ S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","C0CACTOR",128,0)
+ S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CDPT(AIEN)
+"RTN","C0CACTOR",129,0)
+ S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CDPT(AIEN)
+"RTN","C0CACTOR",130,0)
+ S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CDPT(AIEN)
+"RTN","C0CACTOR",131,0)
+ S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^C0CDPT(AIEN)
+"RTN","C0CACTOR",132,0)
+ S @AMAP@("ACTORGENDER")=$P($$GENDER^C0CDPT(AIEN),U,2)
+"RTN","C0CACTOR",133,0)
+ S @AMAP@("ACTORGENDERCODE")=$P($$GENDER^C0CDPT(AIEN),U,1)
+"RTN","C0CACTOR",134,0)
+ S @AMAP@("ACTORSSN")=""
+"RTN","C0CACTOR",135,0)
+ S @AMAP@("ACTORSSNTEXT")=""
+"RTN","C0CACTOR",136,0)
+ S @AMAP@("ACTORSSNSOURCEID")=""
+"RTN","C0CACTOR",137,0)
+ S X="MSCDPTID" ; ROUTINE TO TEST FOR MRN ON OPENVISTA
+"RTN","C0CACTOR",138,0)
+ X ^%ZOSF("TEST") ; TEST TO SEE IF THE ROUTINE EXISTS
+"RTN","C0CACTOR",139,0)
+ I $T S MRN=$$^MSCDPTID(DFN) ;TEST FOR MRN ON OPENVISTA ;GPL
+"RTN","C0CACTOR",140,0)
+ I $G(MRN)'="" D  ; IF MRN IS PRESENT
+"RTN","C0CACTOR",141,0)
+ . S @AMAP@("ACTORSSN")=MRN
+"RTN","C0CACTOR",142,0)
+ . S @AMAP@("ACTORSSNTEXT")="MRN"
+"RTN","C0CACTOR",143,0)
+ . S @AMAP@("ACTORSSNSOURCEID")=AOID
+"RTN","C0CACTOR",144,0)
+ E  D  ; NO MRN, USE SSN
+"RTN","C0CACTOR",145,0)
+ . S ZX=$$SSN^C0CDPT(AIEN)
+"RTN","C0CACTOR",146,0)
+ . I ZX'="" D  ; IF THERE IS A SSN IN THE RECORD
+"RTN","C0CACTOR",147,0)
+ . . S @AMAP@("ACTORSSN")=ZX
+"RTN","C0CACTOR",148,0)
+ . . S @AMAP@("ACTORSSNTEXT")="SSN"
+"RTN","C0CACTOR",149,0)
+ . . S @AMAP@("ACTORSSNSOURCEID")=AOID
+"RTN","C0CACTOR",150,0)
+ S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^C0CDPT(AIEN)
+"RTN","C0CACTOR",151,0)
+ S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^C0CDPT(AIEN)
+"RTN","C0CACTOR",152,0)
+ S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^C0CDPT(AIEN)
+"RTN","C0CACTOR",153,0)
+ S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CDPT(AIEN)
+"RTN","C0CACTOR",154,0)
+ S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CDPT(AIEN)
+"RTN","C0CACTOR",155,0)
+ S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^C0CDPT(AIEN)
+"RTN","C0CACTOR",156,0)
+ S @AMAP@("ACTORRESTEL")=""
+"RTN","C0CACTOR",157,0)
+ S @AMAP@("ACTORRESTELTEXT")=""
+"RTN","C0CACTOR",158,0)
+ S ZX=$$RESTEL^C0CDPT(AIEN)
+"RTN","C0CACTOR",159,0)
+ I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
+"RTN","C0CACTOR",160,0)
+ . S @AMAP@("ACTORRESTEL")=ZX
+"RTN","C0CACTOR",161,0)
+ . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
+"RTN","C0CACTOR",162,0)
+ S @AMAP@("ACTORWORKTEL")=""
+"RTN","C0CACTOR",163,0)
+ S @AMAP@("ACTORWORKTELTEXT")=""
+"RTN","C0CACTOR",164,0)
+ S ZX=$$WORKTEL^C0CDPT(AIEN)
+"RTN","C0CACTOR",165,0)
+ I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
+"RTN","C0CACTOR",166,0)
+ . S @AMAP@("ACTORWORKTEL")=ZX
+"RTN","C0CACTOR",167,0)
+ . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
+"RTN","C0CACTOR",168,0)
+ S @AMAP@("ACTORCELLTEL")=""
+"RTN","C0CACTOR",169,0)
+ S @AMAP@("ACTORCELLTELTEXT")=""
+"RTN","C0CACTOR",170,0)
+ S ZX=$$CELLTEL^C0CDPT(AIEN)
+"RTN","C0CACTOR",171,0)
+ I ZX'="" D  ; IF THERE IS A CELL PHONE IN THE RECORD
+"RTN","C0CACTOR",172,0)
+ . S @AMAP@("ACTORCELLTEL")=ZX
+"RTN","C0CACTOR",173,0)
+ . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
+"RTN","C0CACTOR",174,0)
+ S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CDPT(AIEN)
+"RTN","C0CACTOR",175,0)
+ S @AMAP@("ACTORADDRESSSOURCEID")=AOID
+"RTN","C0CACTOR",176,0)
+ S @AMAP@("ACTORIEN")=AIEN
+"RTN","C0CACTOR",177,0)
+ S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
+"RTN","C0CACTOR",178,0)
+ S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+"RTN","C0CACTOR",179,0)
  Q
-"RTN","C0CACTOR",127,0)
- ;
-"RTN","C0CACTOR",128,0)
-PEXTRACT(AMAP,AIEN,AOID) ; EXTRACT TO RETURN ARRAY RARY PASSED BY NAME
-"RTN","C0CACTOR",129,0)
- N ZX
-"RTN","C0CACTOR",130,0)
- S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","C0CACTOR",131,0)
- S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CDPT(AIEN)
-"RTN","C0CACTOR",132,0)
- S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CDPT(AIEN)
-"RTN","C0CACTOR",133,0)
- S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CDPT(AIEN)
-"RTN","C0CACTOR",134,0)
- S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^C0CDPT(AIEN)
-"RTN","C0CACTOR",135,0)
- S @AMAP@("ACTORGENDER")=$P($$GENDER^C0CDPT(AIEN),U,2)
-"RTN","C0CACTOR",136,0)
- S @AMAP@("ACTORGENDERCODE")=$P($$GENDER^C0CDPT(AIEN),U,1)
-"RTN","C0CACTOR",137,0)
- S @AMAP@("ACTORSSN")=""
-"RTN","C0CACTOR",138,0)
- S @AMAP@("ACTORSSNTEXT")=""
-"RTN","C0CACTOR",139,0)
- S @AMAP@("ACTORSSNSOURCEID")=""
-"RTN","C0CACTOR",140,0)
- S X="MSCDPTID" ; ROUTINE TO TEST FOR MRN ON OPENVISTA
-"RTN","C0CACTOR",141,0)
- X ^%ZOSF("TEST") ; TEST TO SEE IF THE ROUTINE EXISTS
-"RTN","C0CACTOR",142,0)
- I $T S MRN=$$^MSCDPTID(DFN) ;TEST FOR MRN ON OPENVISTA ;GPL
-"RTN","C0CACTOR",143,0)
- I $G(MRN)'="" D  ; IF MRN IS PRESENT
-"RTN","C0CACTOR",144,0)
- . S @AMAP@("ACTORSSN")=MRN
-"RTN","C0CACTOR",145,0)
- . S @AMAP@("ACTORSSNTEXT")="MRN"
-"RTN","C0CACTOR",146,0)
- . S @AMAP@("ACTORSSNSOURCEID")=AOID
-"RTN","C0CACTOR",147,0)
- E  D  ; NO MRN, USE SSN
-"RTN","C0CACTOR",148,0)
- . S ZX=$$SSN^C0CDPT(AIEN)
-"RTN","C0CACTOR",149,0)
- . I ZX'="" D  ; IF THERE IS A SSN IN THE RECORD
-"RTN","C0CACTOR",150,0)
- . . S @AMAP@("ACTORSSN")=ZX
-"RTN","C0CACTOR",151,0)
- . . S @AMAP@("ACTORSSNTEXT")="SSN"
-"RTN","C0CACTOR",152,0)
- . . S @AMAP@("ACTORSSNSOURCEID")=AOID
-"RTN","C0CACTOR",153,0)
- S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^C0CDPT(AIEN)
-"RTN","C0CACTOR",154,0)
- S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^C0CDPT(AIEN)
-"RTN","C0CACTOR",155,0)
- S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^C0CDPT(AIEN)
-"RTN","C0CACTOR",156,0)
- S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CDPT(AIEN)
-"RTN","C0CACTOR",157,0)
- S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CDPT(AIEN)
-"RTN","C0CACTOR",158,0)
- S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^C0CDPT(AIEN)
-"RTN","C0CACTOR",159,0)
- S @AMAP@("ACTORRESTEL")=""
-"RTN","C0CACTOR",160,0)
- S @AMAP@("ACTORRESTELTEXT")=""
-"RTN","C0CACTOR",161,0)
- S ZX=$$RESTEL^C0CDPT(AIEN)
-"RTN","C0CACTOR",162,0)
- I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
-"RTN","C0CACTOR",163,0)
- . S @AMAP@("ACTORRESTEL")=ZX
-"RTN","C0CACTOR",164,0)
- . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
-"RTN","C0CACTOR",165,0)
- S @AMAP@("ACTORWORKTEL")=""
-"RTN","C0CACTOR",166,0)
- S @AMAP@("ACTORWORKTELTEXT")=""
-"RTN","C0CACTOR",167,0)
- S ZX=$$WORKTEL^C0CDPT(AIEN)
-"RTN","C0CACTOR",168,0)
- I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
-"RTN","C0CACTOR",169,0)
- . S @AMAP@("ACTORWORKTEL")=ZX
-"RTN","C0CACTOR",170,0)
- . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
-"RTN","C0CACTOR",171,0)
- S @AMAP@("ACTORCELLTEL")=""
-"RTN","C0CACTOR",172,0)
- S @AMAP@("ACTORCELLTELTEXT")=""
-"RTN","C0CACTOR",173,0)
- S ZX=$$CELLTEL^C0CDPT(AIEN)
-"RTN","C0CACTOR",174,0)
- I ZX'="" D  ; IF THERE IS A CELL PHONE IN THE RECORD
-"RTN","C0CACTOR",175,0)
- . S @AMAP@("ACTORCELLTEL")=ZX
-"RTN","C0CACTOR",176,0)
- . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
-"RTN","C0CACTOR",177,0)
- S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CDPT(AIEN)
-"RTN","C0CACTOR",178,0)
- S @AMAP@("ACTORADDRESSSOURCEID")=AOID
-"RTN","C0CACTOR",179,0)
- S @AMAP@("ACTORIEN")=AIEN
 "RTN","C0CACTOR",180,0)
- S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
+ ;
 "RTN","C0CACTOR",181,0)
- S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+MAP(INXML,AMAP,OUTXML) ;MAP ANY ACTOR TO XML
 "RTN","C0CACTOR",182,0)
+ D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","C0CACTOR",183,0)
  Q
-"RTN","C0CACTOR",183,0)
- ;
 "RTN","C0CACTOR",184,0)
-MAP(INXML,AMAP,OUTXML) ;MAP ANY ACTOR TO XML
+ ;
 "RTN","C0CACTOR",185,0)
- D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
 "RTN","C0CACTOR",186,0)
- Q
+     ;
 "RTN","C0CACTOR",187,0)
- ;
+     ; N AMAP
 "RTN","C0CACTOR",188,0)
-SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
+     S AMAP=$NA(^TMP($J,"AMAP"))
 "RTN","C0CACTOR",189,0)
+     K @AMAP
+"RTN","C0CACTOR",190,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","C0CACTOR",191,0)
+     S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^C0CSYS
+"RTN","C0CACTOR",192,0)
+     S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^C0CSYS
+"RTN","C0CACTOR",193,0)
+     S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
+"RTN","C0CACTOR",194,0)
+     D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","C0CACTOR",195,0)
+     Q
+"RTN","C0CACTOR",196,0)
      ;
-"RTN","C0CACTOR",190,0)
+"RTN","C0CACTOR",197,0)
+NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
+"RTN","C0CACTOR",198,0)
+     ;
+"RTN","C0CACTOR",199,0)
      ; N AMAP
-"RTN","C0CACTOR",191,0)
+"RTN","C0CACTOR",200,0)
      S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","C0CACTOR",192,0)
+"RTN","C0CACTOR",201,0)
      K @AMAP
-"RTN","C0CACTOR",193,0)
+"RTN","C0CACTOR",202,0)
      S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","C0CACTOR",194,0)
-     S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^C0CSYS
-"RTN","C0CACTOR",195,0)
-     S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^C0CSYS
-"RTN","C0CACTOR",196,0)
-     S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
-"RTN","C0CACTOR",197,0)
+"RTN","C0CACTOR",203,0)
+     S @AMAP@("ACTORDISPLAYNAME")=""
+"RTN","C0CACTOR",204,0)
+     S @AMAP@("ACTORRELATION")=""
+"RTN","C0CACTOR",205,0)
+     S @AMAP@("ACTORRELATIONSOURCEID")=""
+"RTN","C0CACTOR",206,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+"RTN","C0CACTOR",207,0)
      D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","C0CACTOR",198,0)
+"RTN","C0CACTOR",208,0)
      Q
-"RTN","C0CACTOR",199,0)
+"RTN","C0CACTOR",209,0)
      ;
-"RTN","C0CACTOR",200,0)
-NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
-"RTN","C0CACTOR",201,0)
+"RTN","C0CACTOR",210,0)
+ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
+"RTN","C0CACTOR",211,0)
      ;
-"RTN","C0CACTOR",202,0)
+"RTN","C0CACTOR",212,0)
+     N AMAP,ZIEN,ZSITE
+"RTN","C0CACTOR",213,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","C0CACTOR",214,0)
+     K @AMAP
+"RTN","C0CACTOR",215,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","C0CACTOR",216,0)
+     S ZSITE=$$SITE^VASITE ; SITE FORMAT IEN^NAME^DATE
+"RTN","C0CACTOR",217,0)
+     S ZIEN=$P(ZSITE,"^",1)
+"RTN","C0CACTOR",218,0)
+     S @AMAP@("ORGANIZATIONNAME")=$P(ZSITE,U,2)
+"RTN","C0CACTOR",219,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
+"RTN","C0CACTOR",220,0)
+     S @AMAP@("ACTORADDRESSTYPE")="Office"
+"RTN","C0CACTOR",221,0)
+     S @AMAP@("ACTORADDRESSLINE1")=$$GET1^DIQ(4,ZIEN_",",1.01)
+"RTN","C0CACTOR",222,0)
+     S @AMAP@("ACTORADDRESSLINE2")=$$GET1^DIQ(4,ZIEN_",",1.02)
+"RTN","C0CACTOR",223,0)
+     S @AMAP@("ACTORADDRESSCITY")=$$GET1^DIQ(4,ZIEN_",",1.03)
+"RTN","C0CACTOR",224,0)
+     S @AMAP@("ACTORADDRESSSTATE")=$$GET1^DIQ(4,ZIEN_",",.02)
+"RTN","C0CACTOR",225,0)
+     S @AMAP@("ACTORPOSTALCODE")=$$GET1^DIQ(4,ZIEN_",",1.04)
+"RTN","C0CACTOR",226,0)
+     S @AMAP@("ACTORTELEPHONE")=""
+"RTN","C0CACTOR",227,0)
+     S @AMAP@("ACTORTELEPHONETYPE")=""
+"RTN","C0CACTOR",228,0)
+     S ZX=$$GET1^DIQ(4.03,"1,"_ZIEN_",",.03)
+"RTN","C0CACTOR",229,0)
+     I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
+"RTN","C0CACTOR",230,0)
+     . S @AMAP@("ACTORTELEPHONE")=ZX
+"RTN","C0CACTOR",231,0)
+     . S @AMAP@("ACTORTELEPHONETYPE")="Office"
+"RTN","C0CACTOR",232,0)
+     D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","C0CACTOR",233,0)
+     K @AMAP
+"RTN","C0CACTOR",234,0)
+     Q
+"RTN","C0CACTOR",235,0)
+     ;
+"RTN","C0CACTOR",236,0)
+PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
+"RTN","C0CACTOR",237,0)
+     ;
+"RTN","C0CACTOR",238,0)
      ; N AMAP
-"RTN","C0CACTOR",203,0)
+"RTN","C0CACTOR",239,0)
      S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","C0CACTOR",204,0)
+"RTN","C0CACTOR",240,0)
      K @AMAP
-"RTN","C0CACTOR",205,0)
+"RTN","C0CACTOR",241,0)
+     I '$D(^VA(200,AIEN,0)) D  Q  ; IF NO PROVIDER RECORD (SHOULDN'T HAPPEN)
+"RTN","C0CACTOR",242,0)
+     . W "WARNING - MISSING PROVIDER: ",AIEN,!
+"RTN","C0CACTOR",243,0)
+     . S @OUTXML@(0)=0 ; SIGNAL NO OUTPUT
+"RTN","C0CACTOR",244,0)
      S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","C0CACTOR",206,0)
-     S @AMAP@("ACTORDISPLAYNAME")=""
-"RTN","C0CACTOR",207,0)
-     S @AMAP@("ACTORRELATION")=""
-"RTN","C0CACTOR",208,0)
-     S @AMAP@("ACTORRELATIONSOURCEID")=""
-"RTN","C0CACTOR",209,0)
+"RTN","C0CACTOR",245,0)
+     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CVA200(AIEN)
+"RTN","C0CACTOR",246,0)
+     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CVA200(AIEN)
+"RTN","C0CACTOR",247,0)
+     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CVA200(AIEN)
+"RTN","C0CACTOR",248,0)
+     S @AMAP@("ACTORTITLE")=$$TITLE^C0CVA200(AIEN)
+"RTN","C0CACTOR",249,0)
+     S @AMAP@("IDTYPE")=$P($$NPI^C0CVA200(AIEN),U,1)
+"RTN","C0CACTOR",250,0)
+     S @AMAP@("ID")=$P($$NPI^C0CVA200(AIEN),U,2)
+"RTN","C0CACTOR",251,0)
+     S @AMAP@("IDDESC")=$P($$NPI^C0CVA200(AIEN),U,3)
+"RTN","C0CACTOR",252,0)
+     S @AMAP@("ACTORSPECIALITY")=$$SPEC^C0CVA200(AIEN)
+"RTN","C0CACTOR",253,0)
+     S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^C0CVA200(AIEN)
+"RTN","C0CACTOR",254,0)
+     S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^C0CVA200(AIEN)
+"RTN","C0CACTOR",255,0)
+     S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CVA200(AIEN)
+"RTN","C0CACTOR",256,0)
+     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CVA200(AIEN)
+"RTN","C0CACTOR",257,0)
+     S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^C0CVA200(AIEN)
+"RTN","C0CACTOR",258,0)
+     S @AMAP@("ACTORTELEPHONE")=""
+"RTN","C0CACTOR",259,0)
+     S @AMAP@("ACTORTELEPHONETYPE")=""
+"RTN","C0CACTOR",260,0)
+     S ZX=$$TEL^C0CVA200(AIEN)
+"RTN","C0CACTOR",261,0)
+     I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
+"RTN","C0CACTOR",262,0)
+     . S @AMAP@("ACTORTELEPHONE")=ZX
+"RTN","C0CACTOR",263,0)
+     . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^C0CVA200(AIEN)
+"RTN","C0CACTOR",264,0)
+     S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CVA200(AIEN)
+"RTN","C0CACTOR",265,0)
+     S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
+"RTN","C0CACTOR",266,0)
      S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-"RTN","C0CACTOR",210,0)
+"RTN","C0CACTOR",267,0)
+     S @AMAP@("ACTORORGLINK")="ACTORORGANIZATION_1"
+"RTN","C0CACTOR",268,0)
      D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","C0CACTOR",211,0)
+"RTN","C0CACTOR",269,0)
      Q
-"RTN","C0CACTOR",212,0)
-     ;
-"RTN","C0CACTOR",213,0)
-ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
-"RTN","C0CACTOR",214,0)
-     ;
-"RTN","C0CACTOR",215,0)
-     N AMAP,ZIEN,ZSITE
-"RTN","C0CACTOR",216,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","C0CACTOR",217,0)
-     K @AMAP
-"RTN","C0CACTOR",218,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","C0CACTOR",219,0)
-     S ZSITE=$$SITE^VASITE ; SITE FORMAT IEN^NAME^DATE
-"RTN","C0CACTOR",220,0)
-     S ZIEN=$P(ZSITE,"^",1)
-"RTN","C0CACTOR",221,0)
-     S @AMAP@("ORGANIZATIONNAME")=$P(ZSITE,U,2)
-"RTN","C0CACTOR",222,0)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
-"RTN","C0CACTOR",223,0)
-     S @AMAP@("ACTORADDRESSTYPE")="Office"
-"RTN","C0CACTOR",224,0)
-     S @AMAP@("ACTORADDRESSLINE1")=$$GET1^DIQ(4,ZIEN_",",1.01)
-"RTN","C0CACTOR",225,0)
-     S @AMAP@("ACTORADDRESSLINE2")=$$GET1^DIQ(4,ZIEN_",",1.02)
-"RTN","C0CACTOR",226,0)
-     S @AMAP@("ACTORADDRESSCITY")=$$GET1^DIQ(4,ZIEN_",",1.03)
-"RTN","C0CACTOR",227,0)
-     S @AMAP@("ACTORADDRESSSTATE")=$$GET1^DIQ(4,ZIEN_",",.02)
-"RTN","C0CACTOR",228,0)
-     S @AMAP@("ACTORPOSTALCODE")=$$GET1^DIQ(4,ZIEN_",",1.04)
-"RTN","C0CACTOR",229,0)
-     S @AMAP@("ACTORTELEPHONE")=""
-"RTN","C0CACTOR",230,0)
-     S @AMAP@("ACTORTELEPHONETYPE")=""
-"RTN","C0CACTOR",231,0)
-     S ZX=$$GET1^DIQ(4.03,"1,"_ZIEN_",",.03)
-"RTN","C0CACTOR",232,0)
-     I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
-"RTN","C0CACTOR",233,0)
-     . S @AMAP@("ACTORTELEPHONE")=ZX
-"RTN","C0CACTOR",234,0)
-     . S @AMAP@("ACTORTELEPHONETYPE")="Office"
-"RTN","C0CACTOR",235,0)
-     D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","C0CACTOR",236,0)
-     K @AMAP
-"RTN","C0CACTOR",237,0)
-     Q
-"RTN","C0CACTOR",238,0)
-     ;
-"RTN","C0CACTOR",239,0)
-PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
-"RTN","C0CACTOR",240,0)
-     ;
-"RTN","C0CACTOR",241,0)
-     ; N AMAP
-"RTN","C0CACTOR",242,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","C0CACTOR",243,0)
-     K @AMAP
-"RTN","C0CACTOR",244,0)
-     I '$D(^VA(200,AIEN,0)) D  Q  ; IF NO PROVIDER RECORD (SHOULDN'T HAPPEN)
-"RTN","C0CACTOR",245,0)
-     . W "WARNING - MISSING PROVIDER: ",AIEN,!
-"RTN","C0CACTOR",246,0)
-     . S @OUTXML@(0)=0 ; SIGNAL NO OUTPUT
-"RTN","C0CACTOR",247,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","C0CACTOR",248,0)
-     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CVA200(AIEN)
-"RTN","C0CACTOR",249,0)
-     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CVA200(AIEN)
-"RTN","C0CACTOR",250,0)
-     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CVA200(AIEN)
-"RTN","C0CACTOR",251,0)
-     S @AMAP@("ACTORTITLE")=$$TITLE^C0CVA200(AIEN)
-"RTN","C0CACTOR",252,0)
-     S @AMAP@("IDTYPE")=$P($$NPI^C0CVA200(AIEN),U,1)
-"RTN","C0CACTOR",253,0)
-     S @AMAP@("ID")=$P($$NPI^C0CVA200(AIEN),U,2)
-"RTN","C0CACTOR",254,0)
-     S @AMAP@("IDDESC")=$P($$NPI^C0CVA200(AIEN),U,3)
-"RTN","C0CACTOR",255,0)
-     S @AMAP@("ACTORSPECIALITY")=$$SPEC^C0CVA200(AIEN)
-"RTN","C0CACTOR",256,0)
-     S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^C0CVA200(AIEN)
-"RTN","C0CACTOR",257,0)
-     S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^C0CVA200(AIEN)
-"RTN","C0CACTOR",258,0)
-     S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CVA200(AIEN)
-"RTN","C0CACTOR",259,0)
-     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CVA200(AIEN)
-"RTN","C0CACTOR",260,0)
-     S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^C0CVA200(AIEN)
-"RTN","C0CACTOR",261,0)
-     S @AMAP@("ACTORTELEPHONE")=""
-"RTN","C0CACTOR",262,0)
-     S @AMAP@("ACTORTELEPHONETYPE")=""
-"RTN","C0CACTOR",263,0)
-     S ZX=$$TEL^C0CVA200(AIEN)
-"RTN","C0CACTOR",264,0)
-     I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
-"RTN","C0CACTOR",265,0)
-     . S @AMAP@("ACTORTELEPHONE")=ZX
-"RTN","C0CACTOR",266,0)
-     . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^C0CVA200(AIEN)
-"RTN","C0CACTOR",267,0)
-     S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CVA200(AIEN)
-"RTN","C0CACTOR",268,0)
-     S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
-"RTN","C0CACTOR",269,0)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
 "RTN","C0CACTOR",270,0)
-     S @AMAP@("ACTORORGLINK")="ACTORORGANIZATION_1"
-"RTN","C0CACTOR",271,0)
-     D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","C0CACTOR",272,0)
-     Q
-"RTN","C0CACTOR",273,0)
      ;
 "RTN","C0CALERT")
-0^46^B31627309
+0^46^B31119471
 "RTN","C0CALERT",1,0)
-C0CALERT  ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08
+C0CALERT  ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08 ; 10/29/12 4:04pm
 "RTN","C0CALERT",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CALERT",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota and others.
 "RTN","C0CALERT",4,0)
- ;Licensed under the terms of the GNU General Public License.
+ ;
 "RTN","C0CALERT",5,0)
- ;See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CALERT",6,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CALERT",7,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CALERT",8,0)
- ;it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CALERT",9,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CALERT",10,0)
- ;(at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CALERT",11,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CALERT",12,0)
- ;This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CALERT",13,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CALERT",14,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CALERT",15,0)
- ;GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CALERT",16,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CALERT",17,0)
- ;You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CALERT",18,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CALERT",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ W "NO ENTRY FROM TOP",!
 "RTN","C0CALERT",20,0)
- ;
+ Q
 "RTN","C0CALERT",21,0)
- W "NO ENTRY FROM TOP",!
+ ;
 "RTN","C0CALERT",22,0)
+EXTRACT(ALTXML,DFN,ALTOUTXML,CALLBK) ; EXTRACT ALERTS INTO  XML TEMPLATE
+"RTN","C0CALERT",23,0)
+ ; CALLBACK IF PROVIDED IS CALLED FOR EACH ALLERGY BEFORE MAPPING
+"RTN","C0CALERT",24,0)
+ ; ALTXML AND ALTOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","C0CALERT",25,0)
+ ;
+"RTN","C0CALERT",26,0)
+ ; GET ADVERSE REACTIONS AND ALLERGIES
+"RTN","C0CALERT",27,0)
+ ; N GMRA,GMRAL ; FOR DEBUGGING, DON'T NEW THESE VARIABLES
+"RTN","C0CALERT",28,0)
+ S GMRA="0^0^111"
+"RTN","C0CALERT",29,0)
+ D EN1^GMRADPT
+"RTN","C0CALERT",30,0)
+ I $G(GMRAL)'=1 D  Q  ; NO ALLERGIES FOUND THUS *QUIT*
+"RTN","C0CALERT",31,0)
+ . S @ALTOUTXML@(0)=0
+"RTN","C0CALERT",32,0)
+ ; DEFINE MAPPING
+"RTN","C0CALERT",33,0)
+ N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP
+"RTN","C0CALERT",34,0)
+ S ALTTVMAP=$NA(^TMP("C0CCCR",$J,"ALERTS"))
+"RTN","C0CALERT",35,0)
+ S ALTTARYTMP=$NA(^TMP("C0CCCR",$J,"ALERTSARYTMP"))
+"RTN","C0CALERT",36,0)
+ K @ALTTVMAP,@ALTTARYTMP
+"RTN","C0CALERT",37,0)
+ N ALTTMP,ALTCNT S ALTG=$NA(GMRAL),ALTCNT=1
+"RTN","C0CALERT",38,0)
+ S ALTTMP="" ;
+"RTN","C0CALERT",39,0)
+ F  S ALTTMP=$O(@ALTG@(ALTTMP)) Q:ALTTMP=""  D  ; CHANGED TO $O BY GPL
+"RTN","C0CALERT",40,0)
+ . W "ALTTMP="_ALTTMP,!
+"RTN","C0CALERT",41,0)
+ . ; I $QS(ALTTMP,2)="S" W !,"S FOUND",! Q
+"RTN","C0CALERT",42,0)
+ . S ALTVMAP=$NA(@ALTTVMAP@(ALTCNT))
+"RTN","C0CALERT",43,0)
+ . K @ALTVMAP
+"RTN","C0CALERT",44,0)
+ . S @ALTVMAP@("ALERTOBJECTID")="ALERT"_ALTCNT
+"RTN","C0CALERT",45,0)
+ . N A1 S A1=@ALTG@(ALTTMP) ; ALL THE PIECES
+"RTN","C0CALERT",46,0)
+ . I $D(CALLBK) D @CALLBK ;CALLBACK FOR EPRESCRIBING
+"RTN","C0CALERT",47,0)
+ . N A2 S A2=$$GET1^DIQ(120.8,ALTTMP,"MECHANISM","I") ; MECHANISM
+"RTN","C0CALERT",48,0)
+ . N A3 S A3=$P(A1,U,5) ; ADVERSE FLAG
+"RTN","C0CALERT",49,0)
+ . N ADT S ADT="Patient has an " ; X $ZINT H 5
+"RTN","C0CALERT",50,0)
+ . S ADT=ADT_$S(A2="P":"ADVERSE",A2="A":"ALLERGIC",1:"UNKNOWN")
+"RTN","C0CALERT",51,0)
+ . S ADT=ADT_" reaction to "_$P(@ALTG@(ALTTMP),U,2)_"."
+"RTN","C0CALERT",52,0)
+ . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT
+"RTN","C0CALERT",53,0)
+ . N ADTY S ADTY=$S(A2="P":"Adverse Reaction",A2="A":"Allergy",1:"") ;
+"RTN","C0CALERT",54,0)
+ . S @ALTVMAP@("ALERTTYPE")=ADTY ; type of allergy
+"RTN","C0CALERT",55,0)
+ . N ALTCDE ; SNOMED CODE THE THE ALERT
+"RTN","C0CALERT",56,0)
+ . S ALTCDE=$S(A2="P":"282100009",A2="A":"416098002",1:"") ; IF NOT ADVERSE, IT IS ALLERGIC
+"RTN","C0CALERT",57,0)
+ . S @ALTVMAP@("ALERTCODEVALUE")=ALTCDE ;
+"RTN","C0CALERT",58,0)
+ . ; WILL USE 418634005 FOR ALLERGIC REACTION TO A SUBSTANCE
+"RTN","C0CALERT",59,0)
+ . ; AND  282100009 FOR ADVERSE REACTION TO A SUBSTANCE
+"RTN","C0CALERT",60,0)
+ . I ALTCDE'="" D  ; IF THERE IS A CODE
+"RTN","C0CALERT",61,0)
+ . . S @ALTVMAP@("ALERTCODESYSTEM")="SNOMED CT"
+"RTN","C0CALERT",62,0)
+ . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")="2008"
+"RTN","C0CALERT",63,0)
+ . E  D  ; SET TO NULL
+"RTN","C0CALERT",64,0)
+ . . S @ALTVMAP@("ALERTCODESYSTEM")=""
+"RTN","C0CALERT",65,0)
+ . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")=""
+"RTN","C0CALERT",66,0)
+ . S @ALTVMAP@("ALERTSTATUSTEXT")="" ; WHERE DO WE GET THIS?
+"RTN","C0CALERT",67,0)
+ . N ALTPROV S ALTPROV=$P(^GMR(120.8,ALTTMP,0),U,5) ; SOURCE PROVIDER IEN
+"RTN","C0CALERT",68,0)
+ . I ALTPROV'="" D  ; PROVIDER PROVIDEED
+"RTN","C0CALERT",69,0)
+ . . S @ALTVMAP@("ALERTSOURCEID")="ACTORPROVIDER_"_ALTPROV
+"RTN","C0CALERT",70,0)
+ . E  S @ALTVMAP@("ALERTSOURCEID")="" ; SOURCE NULL - SHOULD NOT HAPPEN
+"RTN","C0CALERT",71,0)
+ . W "RUNNING ALERTS, PROVIDER: ",@ALTVMAP@("ALERTSOURCEID"),!
+"RTN","C0CALERT",72,0)
+ . N ACGL1,ACGFI,ACIEN,ACVUID,ACNM,ACTMP
+"RTN","C0CALERT",73,0)
+ . S ACGL1=$P(@ALTG@(ALTTMP),U,9) ; ADDRESS OF THE REACTANT XX;GLB(YY.Z,
+"RTN","C0CALERT",74,0)
+ . S ACGFI=$$PRSGLB($P(ACGL1,";",2)) ; FILE NUMBER
+"RTN","C0CALERT",75,0)
+ . S ACIEN=$P(ACGL1,";",1) ; IEN OF REACTANT
+"RTN","C0CALERT",76,0)
+ . S ACVUID=$$GET1^DIQ(ACGFI,ACIEN,"VUID") ; VUID OF THE REACTANT
+"RTN","C0CALERT",77,0)
+ . S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="PRODUCT_"_ACIEN ; IE OF REACTANT
+"RTN","C0CALERT",78,0)
+ . S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="" ; WHERE DO WE GET THIS?
+"RTN","C0CALERT",79,0)
+ . S ACNM=$P(@ALTG@(ALTTMP),U,2) ; REACTANT
+"RTN","C0CALERT",80,0)
+ . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM
+"RTN","C0CALERT",81,0)
+ . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION
+"RTN","C0CALERT",82,0)
+ . S (ZC,ZCD,ZCDS,ZCDSV)="" ; INITIALIZE
+"RTN","C0CALERT",83,0)
+ . I ACVUID'="" D  ; IF VUID IS NOT NULL
+"RTN","C0CALERT",84,0)
+ . . S ZC=$$CODE^C0CUTIL(ACVUID)
+"RTN","C0CALERT",85,0)
+ . . S ZCD=$P(ZC,"^",1) ; CODE TO USE
+"RTN","C0CALERT",86,0)
+ . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID
+"RTN","C0CALERT",87,0)
+ . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION
+"RTN","C0CALERT",88,0)
+ . E  D  ; IF REACTANT CODE VALUE IS NULL
+"RTN","C0CALERT",89,0)
+ . . I $G(DUZ("AG"))="I" D  ; IF WE ARE RUNNING ON RPMS
+"RTN","C0CALERT",90,0)
+ . . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ;
+"RTN","C0CALERT",91,0)
+ . . . W "RPMS NAME FOUND",ACNM," ",ACTMP,!
+"RTN","C0CALERT",92,0)
+ . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=""
+"RTN","C0CALERT",93,0)
+ . . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=""
+"RTN","C0CALERT",94,0)
+ . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ZCD
+"RTN","C0CALERT",95,0)
+ . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=ZCDS
+"RTN","C0CALERT",96,0)
+ . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM_" "_ZCDS_": "_ZCD
+"RTN","C0CALERT",97,0)
+ . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT_" "_ZCDS_": "_ZCD
+"RTN","C0CALERT",98,0)
+ . ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW
+"RTN","C0CALERT",99,0)
+ . N ARTMP,ARIEN,ARDES,ARVUID
+"RTN","C0CALERT",100,0)
+ . S (ARTMP,ARDES,ARVUID)=""
+"RTN","C0CALERT",101,0)
+ . I $D(@ALTG@(ALTTMP,"S",1)) D  ; IF REACTION EXISTS
+"RTN","C0CALERT",102,0)
+ . . S ARTMP=@ALTG@(ALTTMP,"S",1)
+"RTN","C0CALERT",103,0)
+ . . W "REACTION:",ARTMP,!
+"RTN","C0CALERT",104,0)
+ . . S ARIEN=$P(ARTMP,";",2)
+"RTN","C0CALERT",105,0)
+ . . S ARDES=$P(ARTMP,";",1)
+"RTN","C0CALERT",106,0)
+ . . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID")
+"RTN","C0CALERT",107,0)
+ . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES
+"RTN","C0CALERT",108,0)
+ . I ARVUID'="" D  ; IF REACTION VUID IS NOT NULL
+"RTN","C0CALERT",109,0)
+ . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID
+"RTN","C0CALERT",110,0)
+ . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID"
+"RTN","C0CALERT",111,0)
+ . E  D  ; IF IT IS NULL DON'T SET CODE SYSTEM
+"RTN","C0CALERT",112,0)
+ . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=""
+"RTN","C0CALERT",113,0)
+ . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")=""
+"RTN","C0CALERT",114,0)
+ . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))
+"RTN","C0CALERT",115,0)
+ . ; NOW GO TO THE GLOBAL TO GET THE DATE/TIME AND BETTER DESCRIPTION
+"RTN","C0CALERT",116,0)
+ . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL
+"RTN","C0CALERT",117,0)
+ . D GETN1^C0CRNF("C0CG1",120.8,ALTTMP,"") ;GET VALUES BY NAME
+"RTN","C0CALERT",118,0)
+ . S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1")
+"RTN","C0CALERT",119,0)
+ . S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT,"DT")
+"RTN","C0CALERT",120,0)
+ . K @ALTARYTMP
+"RTN","C0CALERT",121,0)
+ . D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP)
+"RTN","C0CALERT",122,0)
+ . I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML)
+"RTN","C0CALERT",123,0)
+ . I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP)
+"RTN","C0CALERT",124,0)
+ . S ALTCNT=ALTCNT+1
+"RTN","C0CALERT",125,0)
+ S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS
+"RTN","C0CALERT",126,0)
  Q
-"RTN","C0CALERT",23,0)
- ;
-"RTN","C0CALERT",24,0)
-EXTRACT(ALTXML,DFN,ALTOUTXML,CALLBK) ; EXTRACT ALERTS INTO  XML TEMPLATE
-"RTN","C0CALERT",25,0)
- ; CALLBACK IF PROVIDED IS CALLED FOR EACH ALLERGY BEFORE MAPPING
-"RTN","C0CALERT",26,0)
- ; ALTXML AND ALTOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","C0CALERT",27,0)
- ;
-"RTN","C0CALERT",28,0)
- ; GET ADVERSE REACTIONS AND ALLERGIES
-"RTN","C0CALERT",29,0)
- ; N GMRA,GMRAL ; FOR DEBUGGING, DON'T NEW THESE VARIABLES
-"RTN","C0CALERT",30,0)
- S GMRA="0^0^111"
-"RTN","C0CALERT",31,0)
- D EN1^GMRADPT
-"RTN","C0CALERT",32,0)
- I $G(GMRAL)'=1 D  Q ; NO ALLERGIES FOUND THUS *QUIT*
-"RTN","C0CALERT",33,0)
- . S @ALTOUTXML@(0)=0
-"RTN","C0CALERT",34,0)
- ; DEFINE MAPPING
-"RTN","C0CALERT",35,0)
- N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP
-"RTN","C0CALERT",36,0)
- S ALTTVMAP=$NA(^TMP("C0CCCR",$J,"ALERTS"))
-"RTN","C0CALERT",37,0)
- S ALTTARYTMP=$NA(^TMP("C0CCCR",$J,"ALERTSARYTMP"))
-"RTN","C0CALERT",38,0)
- K @ALTTVMAP,@ALTTARYTMP
-"RTN","C0CALERT",39,0)
- N ALTTMP,ALTCNT S ALTG=$NA(GMRAL),ALTCNT=1
-"RTN","C0CALERT",40,0)
- S ALTTMP="" ;
-"RTN","C0CALERT",41,0)
- F  S ALTTMP=$O(@ALTG@(ALTTMP)) Q:ALTTMP=""  D  ; CHANGED TO $O BY GPL
-"RTN","C0CALERT",42,0)
- . W "ALTTMP="_ALTTMP,!
-"RTN","C0CALERT",43,0)
- . ; I $QS(ALTTMP,2)="S" W !,"S FOUND",! Q
-"RTN","C0CALERT",44,0)
- . S ALTVMAP=$NA(@ALTTVMAP@(ALTCNT))
-"RTN","C0CALERT",45,0)
- . K @ALTVMAP
-"RTN","C0CALERT",46,0)
- . S @ALTVMAP@("ALERTOBJECTID")="ALERT"_ALTCNT
-"RTN","C0CALERT",47,0)
- . N A1 S A1=@ALTG@(ALTTMP) ; ALL THE PIECES
-"RTN","C0CALERT",48,0)
- . I $D(CALLBK) D @CALLBK ;CALLBACK FOR EPRESCRIBING
-"RTN","C0CALERT",49,0)
- . N A2 S A2=$$GET1^DIQ(120.8,ALTTMP,"MECHANISM","I") ; MECHANISM
-"RTN","C0CALERT",50,0)
- . N A3 S A3=$P(A1,U,5) ; ADVERSE FLAG
-"RTN","C0CALERT",51,0)
- . N ADT S ADT="Patient has an " ; X $ZINT H 5
-"RTN","C0CALERT",52,0)
- . S ADT=ADT_$S(A2="P":"ADVERSE",A2="A":"ALLERGIC",1:"UNKNOWN")
-"RTN","C0CALERT",53,0)
- . S ADT=ADT_" reaction to "_$P(@ALTG@(ALTTMP),U,2)_"."
-"RTN","C0CALERT",54,0)
- . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT
-"RTN","C0CALERT",55,0)
- . N ADTY S ADTY=$S(A2="P":"Adverse Reaction",A2="A":"Allergy",1:"") ;
-"RTN","C0CALERT",56,0)
- . S @ALTVMAP@("ALERTTYPE")=ADTY ; type of allergy
-"RTN","C0CALERT",57,0)
- . N ALTCDE ; SNOMED CODE THE THE ALERT
-"RTN","C0CALERT",58,0)
- . S ALTCDE=$S(A2="P":"282100009",A2="A":"416098002",1:"") ; IF NOT ADVERSE, IT IS ALLERGIC
-"RTN","C0CALERT",59,0)
- . S @ALTVMAP@("ALERTCODEVALUE")=ALTCDE ;
-"RTN","C0CALERT",60,0)
- . ; WILL USE 418634005 FOR ALLERGIC REACTION TO A SUBSTANCE
-"RTN","C0CALERT",61,0)
- . ; AND  282100009 FOR ADVERSE REACTION TO A SUBSTANCE
-"RTN","C0CALERT",62,0)
- . I ALTCDE'="" D  ; IF THERE IS A CODE
-"RTN","C0CALERT",63,0)
- . . S @ALTVMAP@("ALERTCODESYSTEM")="SNOMED CT"
-"RTN","C0CALERT",64,0)
- . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")="2008"
-"RTN","C0CALERT",65,0)
- . E  D  ; SET TO NULL
-"RTN","C0CALERT",66,0)
- . . S @ALTVMAP@("ALERTCODESYSTEM")=""
-"RTN","C0CALERT",67,0)
- . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")=""
-"RTN","C0CALERT",68,0)
- . S @ALTVMAP@("ALERTSTATUSTEXT")="" ; WHERE DO WE GET THIS?
-"RTN","C0CALERT",69,0)
- . N ALTPROV S ALTPROV=$P(^GMR(120.8,ALTTMP,0),U,5) ; SOURCE PROVIDER IEN
-"RTN","C0CALERT",70,0)
- . I ALTPROV'="" D  ; PROVIDER PROVIDEED
-"RTN","C0CALERT",71,0)
- . . S @ALTVMAP@("ALERTSOURCEID")="ACTORPROVIDER_"_ALTPROV
-"RTN","C0CALERT",72,0)
- . E  S @ALTVMAP@("ALERTSOURCEID")="" ; SOURCE NULL - SHOULD NOT HAPPEN
-"RTN","C0CALERT",73,0)
- . W "RUNNING ALERTS, PROVIDER: ",@ALTVMAP@("ALERTSOURCEID"),!
-"RTN","C0CALERT",74,0)
- . N ACGL1,ACGFI,ACIEN,ACVUID,ACNM,ACTMP
-"RTN","C0CALERT",75,0)
- . S ACGL1=$P(@ALTG@(ALTTMP),U,9) ; ADDRESS OF THE REACTANT XX;GLB(YY.Z,
-"RTN","C0CALERT",76,0)
- . S ACGFI=$$PRSGLB($P(ACGL1,";",2)) ; FILE NUMBER
-"RTN","C0CALERT",77,0)
- . S ACIEN=$P(ACGL1,";",1) ; IEN OF REACTANT
-"RTN","C0CALERT",78,0)
- . S ACVUID=$$GET1^DIQ(ACGFI,ACIEN,"VUID") ; VUID OF THE REACTANT
-"RTN","C0CALERT",79,0)
- . S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="PRODUCT_"_ACIEN ; IE OF REACTANT
-"RTN","C0CALERT",80,0)
- . S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="" ; WHERE DO WE GET THIS?
-"RTN","C0CALERT",81,0)
- . S ACNM=$P(@ALTG@(ALTTMP),U,2) ; REACTANT
-"RTN","C0CALERT",82,0)
- . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM
-"RTN","C0CALERT",83,0)
- . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION
-"RTN","C0CALERT",84,0)
- . S (ZC,ZCD,ZCDS,ZCDSV)="" ; INITIALIZE
-"RTN","C0CALERT",85,0)
- . I ACVUID'="" D  ; IF VUID IS NOT NULL
-"RTN","C0CALERT",86,0)
- . . S ZC=$$CODE^C0CUTIL(ACVUID)
-"RTN","C0CALERT",87,0)
- . . S ZCD=$P(ZC,"^",1) ; CODE TO USE
-"RTN","C0CALERT",88,0)
- . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID
-"RTN","C0CALERT",89,0)
- . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION
-"RTN","C0CALERT",90,0)
- . E  D  ; IF REACTANT CODE VALUE IS NULL
-"RTN","C0CALERT",91,0)
- . . I $G(DUZ("AG"))="I" D  ; IF WE ARE RUNNING ON RPMS
-"RTN","C0CALERT",92,0)
- . . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ;
-"RTN","C0CALERT",93,0)
- . . . W "RPMS NAME FOUND",ACNM," ",ACTMP,!
-"RTN","C0CALERT",94,0)
- . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=""
-"RTN","C0CALERT",95,0)
- . . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=""
-"RTN","C0CALERT",96,0)
- . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ZCD
-"RTN","C0CALERT",97,0)
- . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=ZCDS
-"RTN","C0CALERT",98,0)
- . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM_" "_ZCDS_": "_ZCD
-"RTN","C0CALERT",99,0)
- . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT_" "_ZCDS_": "_ZCD
-"RTN","C0CALERT",100,0)
- . ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW
-"RTN","C0CALERT",101,0)
- . N ARTMP,ARIEN,ARDES,ARVUID
-"RTN","C0CALERT",102,0)
- . S (ARTMP,ARDES,ARVUID)=""
-"RTN","C0CALERT",103,0)
- . I $D(@ALTG@(ALTTMP,"S",1)) D  ; IF REACTION EXISTS
-"RTN","C0CALERT",104,0)
- . . S ARTMP=@ALTG@(ALTTMP,"S",1)
-"RTN","C0CALERT",105,0)
- . . W "REACTION:",ARTMP,!
-"RTN","C0CALERT",106,0)
- . . S ARIEN=$P(ARTMP,";",2)
-"RTN","C0CALERT",107,0)
- . . S ARDES=$P(ARTMP,";",1)
-"RTN","C0CALERT",108,0)
- . . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID")
-"RTN","C0CALERT",109,0)
- . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES
-"RTN","C0CALERT",110,0)
- . I ARVUID'="" D  ; IF REACTION VUID IS NOT NULL
-"RTN","C0CALERT",111,0)
- . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID
-"RTN","C0CALERT",112,0)
- . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID"
-"RTN","C0CALERT",113,0)
- . E  D  ; IF IT IS NULL DON'T SET CODE SYSTEM
-"RTN","C0CALERT",114,0)
- . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=""
-"RTN","C0CALERT",115,0)
- . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")=""
-"RTN","C0CALERT",116,0)
- . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))
-"RTN","C0CALERT",117,0)
- . ; NOW GO TO THE GLOBAL TO GET THE DATE/TIME AND BETTER DESCRIPTION
-"RTN","C0CALERT",118,0)
- . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL
-"RTN","C0CALERT",119,0)
- . D GETN1^C0CRNF("C0CG1",120.8,ALTTMP,"") ;GET VALUES BY NAME
-"RTN","C0CALERT",120,0)
- . S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1")
-"RTN","C0CALERT",121,0)
- . S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT,"DT")
-"RTN","C0CALERT",122,0)
- . K @ALTARYTMP
-"RTN","C0CALERT",123,0)
- . D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP)
-"RTN","C0CALERT",124,0)
- . I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML)
-"RTN","C0CALERT",125,0)
- . I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP)
-"RTN","C0CALERT",126,0)
- . S ALTCNT=ALTCNT+1
 "RTN","C0CALERT",127,0)
- S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS
+PRSGLB(INGLB) ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER
 "RTN","C0CALERT",128,0)
- Q
+ ; INGLB IS OF THE FORM: PSNDF(50.6,
 "RTN","C0CALERT",129,0)
-PRSGLB(INGLB) ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER
+ ; RETURN 50.6
 "RTN","C0CALERT",130,0)
- ; INGLB IS OF THE FORM: PSNDF(50.6,
-"RTN","C0CALERT",131,0)
- ; RETURN 50.6
-"RTN","C0CALERT",132,0)
  Q $P($P(INGLB,"(",2),",",1)  ;
 "RTN","C0CBAT")
-0^57^B56971574
+0^57^B56229594
 "RTN","C0CBAT",1,0)
 C0CBAT   ; CCDCCR/GPL - CCR Batch utilities; 4/21/09
 "RTN","C0CBAT",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CBAT",3,0)
- ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
+ ;Copyright 2009 George Lilly.  
 "RTN","C0CBAT",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CBAT",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CBAT",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CBAT",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CBAT",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CBAT",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CBAT",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CBAT",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CBAT",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CBAT",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CBAT",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CBAT",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CBAT",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CBAT",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CBAT",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
 "RTN","C0CBAT",19,0)
- ;
+ W "This is the CCR Batch Utility Library ",!
 "RTN","C0CBAT",20,0)
- W "This is the CCR Batch Utility Library ",!
+ Q
 "RTN","C0CBAT",21,0)
+ ;
+"RTN","C0CBAT",22,0)
+STOP ; STOP A CURRENTLY RUNNING BATCH JOB
+"RTN","C0CBAT",23,0)
+ I '$D(^TMP("C0CBAT","RUNNING")) Q  ;
+"RTN","C0CBAT",24,0)
+ W !,!,"HALTING CCR BATCH",!
+"RTN","C0CBAT",25,0)
+ S ^TMP("C0CBAT","STOP")="" ; SIGNAL JOB TO TERMINATE
+"RTN","C0CBAT",26,0)
+ H 10 ; WAIT TEN SECONDS FOR SIGNAL TO BE RECEIVED
+"RTN","C0CBAT",27,0)
+ I '$D(^TMP("C0CBAT","STOP")) D  ; SIGNAL RECEIVED
+"RTN","C0CBAT",28,0)
+ . W "CCR BATCH JOB TERMINATING",!
+"RTN","C0CBAT",29,0)
+ E  D  ;
+"RTN","C0CBAT",30,0)
+ . K ^TMP("C0CBAT","STOP") ; STOP SIGNALING
+"RTN","C0CBAT",31,0)
+ . W !,"BATCH PROCESSING APPARENTLY NOT RUNNING",!
+"RTN","C0CBAT",32,0)
  Q
-"RTN","C0CBAT",22,0)
- ;
-"RTN","C0CBAT",23,0)
-STOP ; STOP A CURRENTLY RUNNING BATCH JOB
-"RTN","C0CBAT",24,0)
- I '$D(^TMP("C0CBAT","RUNNING")) Q  ;
-"RTN","C0CBAT",25,0)
- W !,!,"HALTING CCR BATCH",!
-"RTN","C0CBAT",26,0)
- S ^TMP("C0CBAT","STOP")="" ; SIGNAL JOB TO TERMINATE
-"RTN","C0CBAT",27,0)
- H 10 ; WAIT TEN SECONDS FOR SIGNAL TO BE RECEIVED
-"RTN","C0CBAT",28,0)
- I '$D(^TMP("C0CBAT","STOP")) D  ; SIGNAL RECEIVED
-"RTN","C0CBAT",29,0)
- . W "CCR BATCH JOB TERMINATING",!
-"RTN","C0CBAT",30,0)
- E  D  ;
-"RTN","C0CBAT",31,0)
- . K ^TMP("C0CBAT","STOP") ; STOP SIGNALING
-"RTN","C0CBAT",32,0)
- . W !,"BATCH PROCESSING APPARENTLY NOT RUNNING",!
 "RTN","C0CBAT",33,0)
+ ;
+"RTN","C0CBAT",34,0)
+START ; STARTS A TAKSMAN CCR BATCH JOB - FOR USE IN A MENU OPTION
+"RTN","C0CBAT",35,0)
+ ;
+"RTN","C0CBAT",36,0)
+ I $D(^TMP("C0CBAT","RUNNING")) D  Q  ; ONLY ONE ALLOWED AT A TIME
+"RTN","C0CBAT",37,0)
+ . W !,"CCR BATCH ALREADY RUNNING",!
+"RTN","C0CBAT",38,0)
+ . W !,"STOP FIRST WITH STOP^C0CBAT",!
+"RTN","C0CBAT",39,0)
+ N ZTRTN,ZTDESC,ZTDTH,ZTSAVE,ZTSK,ZTIO
+"RTN","C0CBAT",40,0)
+ S ZTRTN="EN^C0CBAT",ZTDESC="CCR Batch"
+"RTN","C0CBAT",41,0)
+ S ZTDTH=$H ; 
+"RTN","C0CBAT",42,0)
+ ;S ZTDTH=$S(($P(ZTDTH,",",2)+10)\86400:(1+ZTDTH)_","_((($P(ZTDTH,",",2)+10)#86400)/100000),1:(+ZTDTH)_","_($P(ZTDTH,",",2)+10))
+"RTN","C0CBAT",43,0)
+ S ZTSAVE("C0C")="",ZTSAVE("C0C*")=""
+"RTN","C0CBAT",44,0)
+ S ZTIO="NULL" ;
+"RTN","C0CBAT",45,0)
+ W !,!,"CCR BATCH JOB STARTED",!
+"RTN","C0CBAT",46,0)
+ D ^%ZTLOAD
+"RTN","C0CBAT",47,0)
  Q
-"RTN","C0CBAT",34,0)
- ;
-"RTN","C0CBAT",35,0)
-START ; STARTS A TAKSMAN CCR BATCH JOB - FOR USE IN A MENU OPTION
-"RTN","C0CBAT",36,0)
- ;
-"RTN","C0CBAT",37,0)
- I $D(^TMP("C0CBAT","RUNNING")) D  Q  ; ONLY ONE ALLOWED AT A TIME
-"RTN","C0CBAT",38,0)
- . W !,"CCR BATCH ALREADY RUNNING",!
-"RTN","C0CBAT",39,0)
- . W !,"STOP FIRST WITH STOP^C0CBAT",!
-"RTN","C0CBAT",40,0)
- N ZTRTN,ZTDESC,ZTDTH,ZTSAVE,ZTSK,ZTIO
-"RTN","C0CBAT",41,0)
- S ZTRTN="EN^C0CBAT",ZTDESC="CCR Batch"
-"RTN","C0CBAT",42,0)
- S ZTDTH=$H ; 
-"RTN","C0CBAT",43,0)
- ;S ZTDTH=$S(($P(ZTDTH,",",2)+10)\86400:(1+ZTDTH)_","_((($P(ZTDTH,",",2)+10)#86400)/100000),1:(+ZTDTH)_","_($P(ZTDTH,",",2)+10))
-"RTN","C0CBAT",44,0)
- S ZTSAVE("C0C")="",ZTSAVE("C0C*")=""
-"RTN","C0CBAT",45,0)
- S ZTIO="NULL" ;
-"RTN","C0CBAT",46,0)
- W !,!,"CCR BATCH JOB STARTED",!
-"RTN","C0CBAT",47,0)
- D ^%ZTLOAD
 "RTN","C0CBAT",48,0)
+ ;
+"RTN","C0CBAT",49,0)
+EN ; BATCH ENTRY POINT
+"RTN","C0CBAT",50,0)
+ ; PROCESSES THE SUBSCRIPTION FILE, EXTRACTING CCR VARIABLES FOR EACH
+"RTN","C0CBAT",51,0)
+ ; PATIENT WITH AN ACTIVE SUBSCRIPTION, AND IF CHECKSUMS INDICATE A CHANGE,
+"RTN","C0CBAT",52,0)
+ ; GENERATES A NEW CCR FOR THE PATIENT
+"RTN","C0CBAT",53,0)
+ ; UPDATES THE E2 CCR ELEMENTS FILE
+"RTN","C0CBAT",54,0)
+ ;
+"RTN","C0CBAT",55,0)
+ S C0CQT=1 ; QUIET MODE
+"RTN","C0CBAT",56,0)
+ I $D(^TMP("C0CBAT","RUNNING")) Q  ; ONLY ONE AT A TIME
+"RTN","C0CBAT",57,0)
+ S ^TMP("C0CBAT","RUNNING")="" ; RUNNING SIGNAL
+"RTN","C0CBAT",58,0)
+ S C0CBDT=$$NOW^XLFDT ; DATE OF THIS RUN
+"RTN","C0CBAT",59,0)
+ S C0CBF=177.301 ; FILE NUMBER OF C0C BATCH CONTROL FILE
+"RTN","C0CBAT",60,0)
+ S C0CBFR=177.3013 ; FILE NUMBER OF UPDATE SUBFILE
+"RTN","C0CBAT",61,0)
+ S C0CBB=$NA(^TMP("C0CBATCH",C0CBDT)) ; BATCH WORK AREA
+"RTN","C0CBAT",62,0)
+ I $D(@C0CBB@(0)) D  ; ERROR SHOULDN'T EXIST
+"RTN","C0CBAT",63,0)
+ . W "WORK AREA ERROR",!
+"RTN","C0CBAT",64,0)
+ . S $EC=",U1,"
+"RTN","C0CBAT",65,0)
+ S @C0CBB@(0)="V22" ; VERSION USED TO CREATE THIS WORK AREA
+"RTN","C0CBAT",66,0)
+ S C0CBH=$NA(@C0CBB@("HOTLIST")) ; BASE FOR HOT LIST
+"RTN","C0CBAT",67,0)
+ S C0CBS=$NA(^C0CS("B")) ; SUBSCRIPTION LIST BASE
+"RTN","C0CBAT",68,0)
+ ;I $D(^C0CB("B",C0CDT)) D  ; BATCH RECORD EXISTS
+"RTN","C0CBAT",69,0)
+ ;. H 10 ; HANG 10 SECONDS
+"RTN","C0CBAT",70,0)
+ ;. S C0CBDT=$$NOW^XLFDT ; NEW DATE FOR THIS RUN
+"RTN","C0CBAT",71,0)
+ ;. I $D(^C0CB("B",C0CDT)) B ;DIDN'T WORK
+"RTN","C0CBAT",72,0)
+ D BLDHOT(C0CBH) ; BUILD THE HOT LIST
+"RTN","C0CBAT",73,0)
+ S C0CHN=$$COUNT(C0CBH) ;COUNT NUMBER IN HOT LIST
+"RTN","C0CBAT",74,0)
+ S C0CSN=$$COUNT(C0CBS) ;COUNT NUMBER OF PATIENTS WITH SUBSCRIPTIONS
+"RTN","C0CBAT",75,0)
+ S C0CFDA(C0CBF,"+1,",.01)=C0CBDT ; DATE KEY OF BATCH CONTROL
+"RTN","C0CBAT",76,0)
+ S C0CFDA(C0CBF,"+1,",.02)=C0CBDT ; BATCH ID IS DATE IN STRING FORM
+"RTN","C0CBAT",77,0)
+ S C0CFDA(C0CBF,"+1,",1)=C0CSN ; TOTAL SUBSCRIPTIONS
+"RTN","C0CBAT",78,0)
+ S C0CFDA(C0CBF,"+1,",2)=C0CHN ; TOTAL HOT LIST
+"RTN","C0CBAT",79,0)
+ D UPDIE ; CREATE THE BATCH RECORD
+"RTN","C0CBAT",80,0)
+ S C0CIEN=$O(^C0CB("B",C0CBDT,""))
+"RTN","C0CBAT",81,0)
+ S (C0CN,C0CNH)=0 ; COUNTERS FOR TOTAL AND HOT LIST
+"RTN","C0CBAT",82,0)
+ S C0CBCUR="" ; CURRENT PATIENT
+"RTN","C0CBAT",83,0)
+ S C0CSTOP=0 ; STOP FLAG FOR HALTING BATCH SET ^TMP("C0CBAT","STOP")=""
+"RTN","C0CBAT",84,0)
+ ;F  S C0CBCUR=$O(@C0CBH@(C0CBCUR),-1) Q:C0CBCUR=""  D  ; HOT LIST LATEST FIRST
+"RTN","C0CBAT",85,0)
+ F  S C0CBCUR=$O(@C0CBH@(C0CBCUR)) Q:(C0CSTOP)!(C0CBCUR="")  D  ; HOT LIST FIRST
+"RTN","C0CBAT",86,0)
+ . D ANALYZE^C0CRIMA(C0CBCUR,1,"LABLIMIT:T-900^VITLIMIT:T-900")
+"RTN","C0CBAT",87,0)
+ . I $G(C0CCHK) D  ;
+"RTN","C0CBAT",88,0)
+ . . D PUTRIM^C0CFM2(C0CBCUR)
+"RTN","C0CBAT",89,0)
+ . . D XPAT^C0CCCR(C0CBCUR) ; IF VARIABLES HAVE CHANGED GENERATE CCR
+"RTN","C0CBAT",90,0)
+ . . K C0CFDA
+"RTN","C0CBAT",91,0)
+ . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",.01)=C0CBCUR
+"RTN","C0CBAT",92,0)
+ . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",1)="Y"
+"RTN","C0CBAT",93,0)
+ . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",2)=$G(^TMP("C0CCCR","FNAME",C0CBCUR))
+"RTN","C0CBAT",94,0)
+ . . D UPDIE ; CREATE UPDATE SUBFILE 
+"RTN","C0CBAT",95,0)
+ . S C0CN=C0CN+1 ; INCREMENT NUMBER IN TOTAL
+"RTN","C0CBAT",96,0)
+ . S C0CNH=C0CNH+1 ; INCREMENT HOT LIST TOTAL
+"RTN","C0CBAT",97,0)
+ . S C0CFDA(C0CBF,C0CIEN_",",1.1)=C0CN ;UPDATE TOTAL PROGRESS
+"RTN","C0CBAT",98,0)
+ . S C0CFDA(C0CBF,C0CIEN_",",2.1)=C0CNH ; UPDATE HOT LIST PROGRESS
+"RTN","C0CBAT",99,0)
+ . S C0CNOW=$$NOW^XLFDT
+"RTN","C0CBAT",100,0)
+ . S C0CFDA(C0CBF,C0CIEN_",",4)=C0CNOW ; LAST UPDATED FIELD
+"RTN","C0CBAT",101,0)
+ . S C0CELPS=$$FMDIFF^XLFDT(C0CNOW,C0CBDT,2) ; DIFFERENCE IN SECONDS
+"RTN","C0CBAT",102,0)
+ . S C0CAVG=C0CELPS/C0CN ; AVERAGE ELAPSED TIME
+"RTN","C0CBAT",103,0)
+ . S C0CFDA(C0CBF,C0CIEN_",",4.1)=C0CAVG ; AVERAGE ELAPSED TIME
+"RTN","C0CBAT",104,0)
+ . S C0CETOT=C0CAVG*C0CSN ; EST TOT ELASPSED TIME 
+"RTN","C0CBAT",105,0)
+ . S C0CEST=$$FMADD^XLFDT(C0CBDT,0,0,0,C0CETOT) ; ADD SECONDS TO BATCH START
+"RTN","C0CBAT",106,0)
+ . S C0CFDA(C0CBF,C0CIEN_",",4.2)=C0CEST ;ESTIMATED COMPLETION TIME
+"RTN","C0CBAT",107,0)
+ . S C0CFDA(C0CBF,C0CIEN_",",5)=C0CBCUR ; LAST RECORD PROCESSED
+"RTN","C0CBAT",108,0)
+ . D UPDIE ;
+"RTN","C0CBAT",109,0)
+ . I $D(^TMP("C0CBAT","STOP")) D  ; IF STOP SIGNAL DETECTED
+"RTN","C0CBAT",110,0)
+ . . S C0CSTOP=1
+"RTN","C0CBAT",111,0)
+ . . K ^TMP("C0CBAT","STOP") ; SIGNAL RECEIVED 
+"RTN","C0CBAT",112,0)
+ . H 1 ; GIVE OTHERS A CHANCE 
+"RTN","C0CBAT",113,0)
+ F  S C0CBCUR=$O(@C0CBS@(C0CBCUR)) Q:(C0CSTOP)!(C0CBCUR="")  D  ; SUBS LIST
+"RTN","C0CBAT",114,0)
+ . I $D(@C0CBH@(C0CBCUR)) Q  ; SKIP IF IN HOT LIST - ALREADY DONE
+"RTN","C0CBAT",115,0)
+ . D ANALYZE^C0CRIMA(C0CBCUR,1,"LABLIMIT:T-760^VITLIMIT:T-760")
+"RTN","C0CBAT",116,0)
+ . I $G(C0CCHK) D  ; IF CHECKSUMS HAVE CHANGED
+"RTN","C0CBAT",117,0)
+ . . D PUTRIM^C0CFM2(C0CBCUR)
+"RTN","C0CBAT",118,0)
+ . . D XPAT^C0CCCR(C0CBCUR) ; IF VARIABLES HAVE CHANGED GENERATE CCR
+"RTN","C0CBAT",119,0)
+ . . K C0CFDA
+"RTN","C0CBAT",120,0)
+ . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",.01)=C0CBCUR
+"RTN","C0CBAT",121,0)
+ . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",1)="Y"
+"RTN","C0CBAT",122,0)
+ . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",2)=$G(^TMP("C0CCCR","FNAME",C0CBCUR))
+"RTN","C0CBAT",123,0)
+ . . D UPDIE ; CREATE UPDATE SUBFILE 
+"RTN","C0CBAT",124,0)
+ . S C0CN=C0CN+1 ; INCREMENT NUMBER IN TOTAL
+"RTN","C0CBAT",125,0)
+ . S C0CFDA(C0CBF,C0CIEN_",",1.1)=C0CN ;UPDATE TOTAL PROGRESS
+"RTN","C0CBAT",126,0)
+ . S C0CNOW=$$NOW^XLFDT
+"RTN","C0CBAT",127,0)
+ . S C0CFDA(C0CBF,C0CIEN_",",4)=C0CNOW ; LAST UPDATED FIELD
+"RTN","C0CBAT",128,0)
+ . S C0CELPS=$$FMDIFF^XLFDT(C0CNOW,C0CBDT,2) ; DIFFERENCE IN SECONDS
+"RTN","C0CBAT",129,0)
+ . S C0CAVG=C0CELPS/C0CN ; AVERAGE ELAPSED TIME
+"RTN","C0CBAT",130,0)
+ . S C0CFDA(C0CBF,C0CIEN_",",4.1)=C0CAVG ; AVERAGE ELAPSED TIME
+"RTN","C0CBAT",131,0)
+ . S C0CETOT=C0CAVG*C0CSN ; EST TOT ELASPSED TIME 
+"RTN","C0CBAT",132,0)
+ . S C0CEST=$$FMADD^XLFDT(C0CBDT,0,0,0,C0CETOT) ; ADD SECONDS TO BATCH START
+"RTN","C0CBAT",133,0)
+ . S C0CFDA(C0CBF,C0CIEN_",",4.2)=C0CEST ;ESTIMATED COMPLETION TIME
+"RTN","C0CBAT",134,0)
+ . S C0CFDA(C0CBF,C0CIEN_",",5)=C0CBCUR ; 
+"RTN","C0CBAT",135,0)
+ . D UPDIE ; 
+"RTN","C0CBAT",136,0)
+ . I $D(^TMP("C0CBAT","STOP")) D  ; IF STOP SIGNAL DETECTED
+"RTN","C0CBAT",137,0)
+ . . S C0CSTOP=1
+"RTN","C0CBAT",138,0)
+ . . K ^TMP("C0CBAT","STOP") ; SIGNAL RECEIVED 
+"RTN","C0CBAT",139,0)
+ . H 1 ; GIVE IT A BREAK
+"RTN","C0CBAT",140,0)
+ I (C0CSTOP) S C0CDISP="KILLED"
+"RTN","C0CBAT",141,0)
+ E  S C0CDISP="FINISHED"
+"RTN","C0CBAT",142,0)
+ S C0CFDA(C0CBF,C0CIEN_",",6)=C0CDISP
+"RTN","C0CBAT",143,0)
+ D UPDIE ; SET DISPOSITION FIELD
+"RTN","C0CBAT",144,0)
+ K ^TMP("C0CBAT","RUNNING")
+"RTN","C0CBAT",145,0)
  Q
-"RTN","C0CBAT",49,0)
- ;
-"RTN","C0CBAT",50,0)
-EN ; BATCH ENTRY POINT
-"RTN","C0CBAT",51,0)
- ; PROCESSES THE SUBSCRIPTION FILE, EXTRACTING CCR VARIABLES FOR EACH
-"RTN","C0CBAT",52,0)
- ; PATIENT WITH AN ACTIVE SUBSCRIPTION, AND IF CHECKSUMS INDICATE A CHANGE,
-"RTN","C0CBAT",53,0)
- ; GENERATES A NEW CCR FOR THE PATIENT
-"RTN","C0CBAT",54,0)
- ; UPDATES THE E2 CCR ELEMENTS FILE
-"RTN","C0CBAT",55,0)
- ;
-"RTN","C0CBAT",56,0)
- S C0CQT=1 ; QUIET MODE
-"RTN","C0CBAT",57,0)
- I $D(^TMP("C0CBAT","RUNNING")) Q  ; ONLY ONE AT A TIME
-"RTN","C0CBAT",58,0)
- S ^TMP("C0CBAT","RUNNING")="" ; RUNNING SIGNAL
-"RTN","C0CBAT",59,0)
- S C0CBDT=$$NOW^XLFDT ; DATE OF THIS RUN
-"RTN","C0CBAT",60,0)
- S C0CBF=177.301 ; FILE NUMBER OF C0C BATCH CONTROL FILE
-"RTN","C0CBAT",61,0)
- S C0CBFR=177.3013 ; FILE NUMBER OF UPDATE SUBFILE
-"RTN","C0CBAT",62,0)
- S C0CBB=$NA(^TMP("C0CBATCH",C0CBDT)) ; BATCH WORK AREA
-"RTN","C0CBAT",63,0)
- I $D(@C0CBB@(0)) D  ; ERROR SHOULDN'T EXIST
-"RTN","C0CBAT",64,0)
- . W "WORK AREA ERROR",!
-"RTN","C0CBAT",65,0)
- . B
-"RTN","C0CBAT",66,0)
- S @C0CBB@(0)="V22" ; VERSION USED TO CREATE THIS WORK AREA
-"RTN","C0CBAT",67,0)
- S C0CBH=$NA(@C0CBB@("HOTLIST")) ; BASE FOR HOT LIST
-"RTN","C0CBAT",68,0)
- S C0CBS=$NA(^C0CS("B")) ; SUBSCRIPTION LIST BASE
-"RTN","C0CBAT",69,0)
- ;I $D(^C0CB("B",C0CDT)) D  ; BATCH RECORD EXISTS
-"RTN","C0CBAT",70,0)
- ;. H 10 ; HANG 10 SECONDS
-"RTN","C0CBAT",71,0)
- ;. S C0CBDT=$$NOW^XLFDT ; NEW DATE FOR THIS RUN
-"RTN","C0CBAT",72,0)
- ;. I $D(^C0CB("B",C0CDT)) B ;DIDN'T WORK
-"RTN","C0CBAT",73,0)
- D BLDHOT(C0CBH) ; BUILD THE HOT LIST
-"RTN","C0CBAT",74,0)
- S C0CHN=$$COUNT(C0CBH) ;COUNT NUMBER IN HOT LIST
-"RTN","C0CBAT",75,0)
- S C0CSN=$$COUNT(C0CBS) ;COUNT NUMBER OF PATIENTS WITH SUBSCRIPTIONS
-"RTN","C0CBAT",76,0)
- S C0CFDA(C0CBF,"+1,",.01)=C0CBDT ; DATE KEY OF BATCH CONTROL
-"RTN","C0CBAT",77,0)
- S C0CFDA(C0CBF,"+1,",.02)=C0CBDT ; BATCH ID IS DATE IN STRING FORM
-"RTN","C0CBAT",78,0)
- S C0CFDA(C0CBF,"+1,",1)=C0CSN ; TOTAL SUBSCRIPTIONS
-"RTN","C0CBAT",79,0)
- S C0CFDA(C0CBF,"+1,",2)=C0CHN ; TOTAL HOT LIST
-"RTN","C0CBAT",80,0)
- D UPDIE ; CREATE THE BATCH RECORD
-"RTN","C0CBAT",81,0)
- S C0CIEN=$O(^C0CB("B",C0CBDT,""))
-"RTN","C0CBAT",82,0)
- S (C0CN,C0CNH)=0 ; COUNTERS FOR TOTAL AND HOT LIST
-"RTN","C0CBAT",83,0)
- S C0CBCUR="" ; CURRENT PATIENT
-"RTN","C0CBAT",84,0)
- S C0CSTOP=0 ; STOP FLAG FOR HALTING BATCH SET ^TMP("C0CBAT","STOP")=""
-"RTN","C0CBAT",85,0)
- ;F  S C0CBCUR=$O(@C0CBH@(C0CBCUR),-1) Q:C0CBCUR=""  D  ; HOT LIST LATEST FIRST
-"RTN","C0CBAT",86,0)
- F  S C0CBCUR=$O(@C0CBH@(C0CBCUR)) Q:(C0CSTOP)!(C0CBCUR="")  D  ; HOT LIST FIRST
-"RTN","C0CBAT",87,0)
- . D ANALYZE^C0CRIMA(C0CBCUR,1,"LABLIMIT:T-900^VITLIMIT:T-900")
-"RTN","C0CBAT",88,0)
- . I $G(C0CCHK) D  ;
-"RTN","C0CBAT",89,0)
- . . D PUTRIM^C0CFM2(C0CBCUR)
-"RTN","C0CBAT",90,0)
- . . D XPAT^C0CCCR(C0CBCUR) ; IF VARIABLES HAVE CHANGED GENERATE CCR
-"RTN","C0CBAT",91,0)
- . . K C0CFDA
-"RTN","C0CBAT",92,0)
- . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",.01)=C0CBCUR
-"RTN","C0CBAT",93,0)
- . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",1)="Y"
-"RTN","C0CBAT",94,0)
- . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",2)=$G(^TMP("C0CCCR","FNAME",C0CBCUR))
-"RTN","C0CBAT",95,0)
- . . D UPDIE ; CREATE UPDATE SUBFILE 
-"RTN","C0CBAT",96,0)
- . S C0CN=C0CN+1 ; INCREMENT NUMBER IN TOTAL
-"RTN","C0CBAT",97,0)
- . S C0CNH=C0CNH+1 ; INCREMENT HOT LIST TOTAL
-"RTN","C0CBAT",98,0)
- . S C0CFDA(C0CBF,C0CIEN_",",1.1)=C0CN ;UPDATE TOTAL PROGRESS
-"RTN","C0CBAT",99,0)
- . S C0CFDA(C0CBF,C0CIEN_",",2.1)=C0CNH ; UPDATE HOT LIST PROGRESS
-"RTN","C0CBAT",100,0)
- . S C0CNOW=$$NOW^XLFDT
-"RTN","C0CBAT",101,0)
- . S C0CFDA(C0CBF,C0CIEN_",",4)=C0CNOW ; LAST UPDATED FIELD
-"RTN","C0CBAT",102,0)
- . S C0CELPS=$$FMDIFF^XLFDT(C0CNOW,C0CBDT,2) ; DIFFERENCE IN SECONDS
-"RTN","C0CBAT",103,0)
- . S C0CAVG=C0CELPS/C0CN ; AVERAGE ELAPSED TIME
-"RTN","C0CBAT",104,0)
- . S C0CFDA(C0CBF,C0CIEN_",",4.1)=C0CAVG ; AVERAGE ELAPSED TIME
-"RTN","C0CBAT",105,0)
- . S C0CETOT=C0CAVG*C0CSN ; EST TOT ELASPSED TIME 
-"RTN","C0CBAT",106,0)
- . S C0CEST=$$FMADD^XLFDT(C0CBDT,0,0,0,C0CETOT) ; ADD SECONDS TO BATCH START
-"RTN","C0CBAT",107,0)
- . S C0CFDA(C0CBF,C0CIEN_",",4.2)=C0CEST ;ESTIMATED COMPLETION TIME
-"RTN","C0CBAT",108,0)
- . S C0CFDA(C0CBF,C0CIEN_",",5)=C0CBCUR ; LAST RECORD PROCESSED
-"RTN","C0CBAT",109,0)
- . D UPDIE ;
-"RTN","C0CBAT",110,0)
- . I $D(^TMP("C0CBAT","STOP")) D  ; IF STOP SIGNAL DETECTED
-"RTN","C0CBAT",111,0)
- . . S C0CSTOP=1
-"RTN","C0CBAT",112,0)
- . . K ^TMP("C0CBAT","STOP") ; SIGNAL RECEIVED 
-"RTN","C0CBAT",113,0)
- . H 1 ; GIVE OTHERS A CHANCE 
-"RTN","C0CBAT",114,0)
- F  S C0CBCUR=$O(@C0CBS@(C0CBCUR)) Q:(C0CSTOP)!(C0CBCUR="")  D  ; SUBS LIST
-"RTN","C0CBAT",115,0)
- . I $D(@C0CBH@(C0CBCUR)) Q  ; SKIP IF IN HOT LIST - ALREADY DONE
-"RTN","C0CBAT",116,0)
- . D ANALYZE^C0CRIMA(C0CBCUR,1,"LABLIMIT:T-760^VITLIMIT:T-760")
-"RTN","C0CBAT",117,0)
- . I $G(C0CCHK) D  ; IF CHECKSUMS HAVE CHANGED
-"RTN","C0CBAT",118,0)
- . . D PUTRIM^C0CFM2(C0CBCUR)
-"RTN","C0CBAT",119,0)
- . . D XPAT^C0CCCR(C0CBCUR) ; IF VARIABLES HAVE CHANGED GENERATE CCR
-"RTN","C0CBAT",120,0)
- . . K C0CFDA
-"RTN","C0CBAT",121,0)
- . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",.01)=C0CBCUR
-"RTN","C0CBAT",122,0)
- . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",1)="Y"
-"RTN","C0CBAT",123,0)
- . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",2)=$G(^TMP("C0CCCR","FNAME",C0CBCUR))
-"RTN","C0CBAT",124,0)
- . . D UPDIE ; CREATE UPDATE SUBFILE 
-"RTN","C0CBAT",125,0)
- . S C0CN=C0CN+1 ; INCREMENT NUMBER IN TOTAL
-"RTN","C0CBAT",126,0)
- . S C0CFDA(C0CBF,C0CIEN_",",1.1)=C0CN ;UPDATE TOTAL PROGRESS
-"RTN","C0CBAT",127,0)
- . S C0CNOW=$$NOW^XLFDT
-"RTN","C0CBAT",128,0)
- . S C0CFDA(C0CBF,C0CIEN_",",4)=C0CNOW ; LAST UPDATED FIELD
-"RTN","C0CBAT",129,0)
- . S C0CELPS=$$FMDIFF^XLFDT(C0CNOW,C0CBDT,2) ; DIFFERENCE IN SECONDS
-"RTN","C0CBAT",130,0)
- . S C0CAVG=C0CELPS/C0CN ; AVERAGE ELAPSED TIME
-"RTN","C0CBAT",131,0)
- . S C0CFDA(C0CBF,C0CIEN_",",4.1)=C0CAVG ; AVERAGE ELAPSED TIME
-"RTN","C0CBAT",132,0)
- . S C0CETOT=C0CAVG*C0CSN ; EST TOT ELASPSED TIME 
-"RTN","C0CBAT",133,0)
- . S C0CEST=$$FMADD^XLFDT(C0CBDT,0,0,0,C0CETOT) ; ADD SECONDS TO BATCH START
-"RTN","C0CBAT",134,0)
- . S C0CFDA(C0CBF,C0CIEN_",",4.2)=C0CEST ;ESTIMATED COMPLETION TIME
-"RTN","C0CBAT",135,0)
- . S C0CFDA(C0CBF,C0CIEN_",",5)=C0CBCUR ; 
-"RTN","C0CBAT",136,0)
- . D UPDIE ; 
-"RTN","C0CBAT",137,0)
- . I $D(^TMP("C0CBAT","STOP")) D  ; IF STOP SIGNAL DETECTED
-"RTN","C0CBAT",138,0)
- . . S C0CSTOP=1
-"RTN","C0CBAT",139,0)
- . . K ^TMP("C0CBAT","STOP") ; SIGNAL RECEIVED 
-"RTN","C0CBAT",140,0)
- . H 1 ; GIVE IT A BREAK
-"RTN","C0CBAT",141,0)
- I (C0CSTOP) S C0CDISP="KILLED"
-"RTN","C0CBAT",142,0)
- E  S C0CDISP="FINISHED"
-"RTN","C0CBAT",143,0)
- S C0CFDA(C0CBF,C0CIEN_",",6)=C0CDISP
-"RTN","C0CBAT",144,0)
- D UPDIE ; SET DISPOSITION FIELD
-"RTN","C0CBAT",145,0)
- K ^TMP("C0CBAT","RUNNING")
 "RTN","C0CBAT",146,0)
+ ;
+"RTN","C0CBAT",147,0)
+BLDHOT(ZHB) ; BUILD HOT LIST AT GLOBAL ZHB, PASSED BY NAME
+"RTN","C0CBAT",148,0)
+ ; SEARCHS FOR PATIENTS IN THE "AC" INDEX OF THE ORDER FILE
+"RTN","C0CBAT",149,0)
+ N ZDFN
+"RTN","C0CBAT",150,0)
+ S ZDFN=""
+"RTN","C0CBAT",151,0)
+ F  S ZDFN=$O(^OR(100,"AC",ZDFN)) Q:ZDFN=""  D  ; ALL PATIENTS IN THE AC INDX
+"RTN","C0CBAT",152,0)
+ . S ZZDFN=$P(ZDFN,";",1) ; FORMAT IS "N;DPT("
+"RTN","C0CBAT",153,0)
+ . I '$D(@C0CBS@(ZZDFN)) Q  ; SKIP IF NOT IN SUBSCRIPTION LIST
+"RTN","C0CBAT",154,0)
+ . S @ZHB@(ZZDFN)="" ;ADD PATIENT TO THE HOT LIST
+"RTN","C0CBAT",155,0)
  Q
-"RTN","C0CBAT",147,0)
- ;
-"RTN","C0CBAT",148,0)
-BLDHOT(ZHB) ; BUILD HOT LIST AT GLOBAL ZHB, PASSED BY NAME
-"RTN","C0CBAT",149,0)
- ; SEARCHS FOR PATIENTS IN THE "AC" INDEX OF THE ORDER FILE
-"RTN","C0CBAT",150,0)
- N ZDFN
-"RTN","C0CBAT",151,0)
- S ZDFN=""
-"RTN","C0CBAT",152,0)
- F  S ZDFN=$O(^OR(100,"AC",ZDFN)) Q:ZDFN=""  D  ; ALL PATIENTS IN THE AC INDX
-"RTN","C0CBAT",153,0)
- . S ZZDFN=$P(ZDFN,";",1) ; FORMAT IS "N;DPT("
-"RTN","C0CBAT",154,0)
- . I '$D(@C0CBS@(ZZDFN)) Q  ; SKIP IF NOT IN SUBSCRIPTION LIST
-"RTN","C0CBAT",155,0)
- . S @ZHB@(ZZDFN)="" ;ADD PATIENT TO THE HOT LIST
 "RTN","C0CBAT",156,0)
+ ;
+"RTN","C0CBAT",157,0)
+COUNT(ZB) ; EXTRINSIC THAT RETURNS THE NUMBER OF ARRAY ELEMENTS
+"RTN","C0CBAT",158,0)
+ N ZI,ZN
+"RTN","C0CBAT",159,0)
+ S ZN=0
+"RTN","C0CBAT",160,0)
+ S ZI=""
+"RTN","C0CBAT",161,0)
+ F  S ZI=$O(@ZB@(ZI)) Q:ZI=""  D  ;
+"RTN","C0CBAT",162,0)
+ . S ZN=ZN+1
+"RTN","C0CBAT",163,0)
+ Q ZN
+"RTN","C0CBAT",164,0)
+ ;
+"RTN","C0CBAT",165,0)
+UVARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
+"RTN","C0CBAT",166,0)
+ ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
+"RTN","C0CBAT",167,0)
+ ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
+"RTN","C0CBAT",168,0)
+ ;
+"RTN","C0CBAT",169,0)
+ N ZCCRD,ZVARN,C0CFDA2
+"RTN","C0CBAT",170,0)
+ S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
+"RTN","C0CBAT",171,0)
+ S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
+"RTN","C0CBAT",172,0)
+ I ZVARN="" D  ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
+"RTN","C0CBAT",173,0)
+ . I '$D(ZTYP) D  Q  ; WON'T ADD A VARIABLE WITHOUT A TYPE
+"RTN","C0CBAT",174,0)
+ . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
+"RTN","C0CBAT",175,0)
+ . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
+"RTN","C0CBAT",176,0)
+ . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
+"RTN","C0CBAT",177,0)
+ . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
+"RTN","C0CBAT",178,0)
+ . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
+"RTN","C0CBAT",179,0)
+ . I $D(ZERR) D  ; LAYGO ERROR
+"RTN","C0CBAT",180,0)
+ . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
+"RTN","C0CBAT",181,0)
+ . E  D  ;
+"RTN","C0CBAT",182,0)
+ . . D CLEAN^DILF ; CLEAN UP
+"RTN","C0CBAT",183,0)
+ . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
+"RTN","C0CBAT",184,0)
+ . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
+"RTN","C0CBAT",185,0)
+ Q ZVARN
+"RTN","C0CBAT",186,0)
+ ;
+"RTN","C0CBAT",187,0)
+UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+"RTN","C0CBAT",188,0)
+ K ZERR
+"RTN","C0CBAT",189,0)
+ D CLEAN^DILF
+"RTN","C0CBAT",190,0)
+ D UPDATE^DIE("","C0CFDA","","ZERR")
+"RTN","C0CBAT",191,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CBAT",192,0)
+ K C0CFDA
+"RTN","C0CBAT",193,0)
  Q
-"RTN","C0CBAT",157,0)
- ;
-"RTN","C0CBAT",158,0)
-COUNT(ZB) ; EXTRINSIC THAT RETURNS THE NUMBER OF ARRAY ELEMENTS
-"RTN","C0CBAT",159,0)
- N ZI,ZN
-"RTN","C0CBAT",160,0)
- S ZN=0
-"RTN","C0CBAT",161,0)
- S ZI=""
-"RTN","C0CBAT",162,0)
- F  S ZI=$O(@ZB@(ZI)) Q:ZI=""  D  ;
-"RTN","C0CBAT",163,0)
- . S ZN=ZN+1
-"RTN","C0CBAT",164,0)
- Q ZN
-"RTN","C0CBAT",165,0)
- ;
-"RTN","C0CBAT",166,0)
-UPDIEVARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
-"RTN","C0CBAT",167,0)
- ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
-"RTN","C0CBAT",168,0)
- ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
-"RTN","C0CBAT",169,0)
- ;
-"RTN","C0CBAT",170,0)
- N ZCCRD,ZVARN,C0CFDA2
-"RTN","C0CBAT",171,0)
- S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
-"RTN","C0CBAT",172,0)
- S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
-"RTN","C0CBAT",173,0)
- I ZVARN="" D  ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
-"RTN","C0CBAT",174,0)
- . I '$D(ZTYP) D  Q  ; WON'T ADD A VARIABLE WITHOUT A TYPE
-"RTN","C0CBAT",175,0)
- . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
-"RTN","C0CBAT",176,0)
- . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
-"RTN","C0CBAT",177,0)
- . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
-"RTN","C0CBAT",178,0)
- . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
-"RTN","C0CBAT",179,0)
- . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
-"RTN","C0CBAT",180,0)
- . I $D(ZERR) D  ; LAYGO ERROR
-"RTN","C0CBAT",181,0)
- . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
-"RTN","C0CBAT",182,0)
- . E  D  ;
-"RTN","C0CBAT",183,0)
- . . D CLEAN^DILF ; CLEAN UP
-"RTN","C0CBAT",184,0)
- . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
-"RTN","C0CBAT",185,0)
- . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
-"RTN","C0CBAT",186,0)
- Q ZVARN
-"RTN","C0CBAT",187,0)
- ;
-"RTN","C0CBAT",188,0)
-UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
-"RTN","C0CBAT",189,0)
- K ZERR
-"RTN","C0CBAT",190,0)
- D CLEAN^DILF
-"RTN","C0CBAT",191,0)
- D UPDATE^DIE("","C0CFDA","","ZERR")
-"RTN","C0CBAT",192,0)
- I $D(ZERR) D  ;
-"RTN","C0CBAT",193,0)
- . W "ERROR",!
 "RTN","C0CBAT",194,0)
- . ZWR ZERR
+ ;
 "RTN","C0CBAT",195,0)
- . B
+SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
 "RTN","C0CBAT",196,0)
- K C0CFDA
+ ; TO SET TO VALUE C0CSV.
 "RTN","C0CBAT",197,0)
+ ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
+"RTN","C0CBAT",198,0)
+ ; C0CSN,C0CSV ARE PASSED BY VALUE
+"RTN","C0CBAT",199,0)
+ ;
+"RTN","C0CBAT",200,0)
+ N C0CSI,C0CSJ
+"RTN","C0CBAT",201,0)
+ S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
+"RTN","C0CBAT",202,0)
+ S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
+"RTN","C0CBAT",203,0)
+ S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
+"RTN","C0CBAT",204,0)
  Q
-"RTN","C0CBAT",198,0)
- ;
-"RTN","C0CBAT",199,0)
-SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
-"RTN","C0CBAT",200,0)
- ; TO SET TO VALUE C0CSV.
-"RTN","C0CBAT",201,0)
- ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
-"RTN","C0CBAT",202,0)
- ; C0CSN,C0CSV ARE PASSED BY VALUE
-"RTN","C0CBAT",203,0)
- ;
-"RTN","C0CBAT",204,0)
- N C0CSI,C0CSJ
 "RTN","C0CBAT",205,0)
- S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
+ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
 "RTN","C0CBAT",206,0)
- S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
 "RTN","C0CBAT",207,0)
- S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
+ ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
 "RTN","C0CBAT",208,0)
- Q
+ I '$D(ZTAB) S ZTAB="C0CA"
 "RTN","C0CBAT",209,0)
-ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
+ N ZR
 "RTN","C0CBAT",210,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
+ I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
 "RTN","C0CBAT",211,0)
+ E  S ZR=""
+"RTN","C0CBAT",212,0)
+ Q ZR
+"RTN","C0CBAT",213,0)
+ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
+"RTN","C0CBAT",214,0)
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
+"RTN","C0CBAT",215,0)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CBAT",212,0)
+"RTN","C0CBAT",216,0)
  I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CBAT",213,0)
+"RTN","C0CBAT",217,0)
  N ZR
-"RTN","C0CBAT",214,0)
- I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
-"RTN","C0CBAT",215,0)
+"RTN","C0CBAT",218,0)
+ I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
+"RTN","C0CBAT",219,0)
  E  S ZR=""
-"RTN","C0CBAT",216,0)
+"RTN","C0CBAT",220,0)
  Q ZR
-"RTN","C0CBAT",217,0)
-ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
-"RTN","C0CBAT",218,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
-"RTN","C0CBAT",219,0)
+"RTN","C0CBAT",221,0)
+ ;
+"RTN","C0CBAT",222,0)
+ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
+"RTN","C0CBAT",223,0)
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
+"RTN","C0CBAT",224,0)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CBAT",220,0)
+"RTN","C0CBAT",225,0)
  I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CBAT",221,0)
+"RTN","C0CBAT",226,0)
  N ZR
-"RTN","C0CBAT",222,0)
- I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
-"RTN","C0CBAT",223,0)
+"RTN","C0CBAT",227,0)
+ I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
+"RTN","C0CBAT",228,0)
  E  S ZR=""
-"RTN","C0CBAT",224,0)
+"RTN","C0CBAT",229,0)
  Q ZR
-"RTN","C0CBAT",225,0)
- ;
-"RTN","C0CBAT",226,0)
-ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
-"RTN","C0CBAT",227,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
-"RTN","C0CBAT",228,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CBAT",229,0)
- I '$D(ZTAB) S ZTAB="C0CA"
 "RTN","C0CBAT",230,0)
- N ZR
-"RTN","C0CBAT",231,0)
- I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
-"RTN","C0CBAT",232,0)
- E  S ZR=""
-"RTN","C0CBAT",233,0)
- Q ZR
-"RTN","C0CBAT",234,0)
  ;
 "RTN","C0CCCD")
-0^45^B114134049
+0^45^B89035344
 "RTN","C0CCCD",1,0)
 C0CCCD   ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
 "RTN","C0CCCD",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CCCD",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
 "RTN","C0CCCD",4,0)
- ;Licensed under the terms of the GNU General Public License.
+ ;
 "RTN","C0CCCD",5,0)
- ;See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CCCD",6,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CCCD",7,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CCCD",8,0)
- ;it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CCCD",9,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CCCD",10,0)
- ;(at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CCCD",11,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CCCD",12,0)
- ;This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CCCD",13,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CCCD",14,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CCCD",15,0)
- ;GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CCCD",16,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CCCD",17,0)
- ;You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CCCD",18,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ; EXPORT A CCR
 "RTN","C0CCCD",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
 "RTN","C0CCCD",20,0)
- ;
+EXPORT   ; EXPORT ENTRY POINT FOR CCR
 "RTN","C0CCCD",21,0)
- ; EXPORT A CCR
+ ; Select a patient.
 "RTN","C0CCCD",22,0)
- ;
+ S DIC=2,DIC(0)="AEMQ" D ^DIC
 "RTN","C0CCCD",23,0)
-EXPORT   ; EXPORT ENTRY POINT FOR CCR
+ I Y<1 Q  ; EXIT
 "RTN","C0CCCD",24,0)
-       ; Select a patient.
+ S DFN=$P(Y,U,1) ; SET THE PATIENT
 "RTN","C0CCCD",25,0)
-       S DIC=2,DIC(0)="AEMQ" D ^DIC
+ D XPAT(DFN,"","") ; EXPORT TO A FILE
 "RTN","C0CCCD",26,0)
-       I Y<1 Q  ; EXIT
+ Q
 "RTN","C0CCCD",27,0)
-       S DFN=$P(Y,U,1) ; SET THE PATIENT
+ ;
 "RTN","C0CCCD",28,0)
-       D XPAT(DFN,"","") ; EXPORT TO A FILE
+XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
 "RTN","C0CCCD",29,0)
-       Q
+ ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR")
 "RTN","C0CCCD",30,0)
-       ;
+ ; FN IS FILE NAME, DEFAULTS IF NULL
 "RTN","C0CCCD",31,0)
-XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
+ ; N CCDGLO
 "RTN","C0CCCD",32,0)
-       ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR")
+ D CCDRPC(.CCDGLO,DFN,"CCD","","","")
 "RTN","C0CCCD",33,0)
-       ; FN IS FILE NAME, DEFAULTS IF NULL
+ S OARY=$NA(^TMP("C0CCCR",$J,DFN,"CCD",1))
 "RTN","C0CCCD",34,0)
-       ; N CCDGLO
+ S ONAM=FN
 "RTN","C0CCCD",35,0)
-       D CCDRPC(.CCDGLO,DFN,"CCD","","","")
+ I FN="" S ONAM="PAT_"_DFN_"_CCD_V1.xml"
 "RTN","C0CCCD",36,0)
-       S OARY=$NA(^TMP("C0CCCR",$J,DFN,"CCD",1))
+ S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))
 "RTN","C0CCCD",37,0)
-       S ONAM=FN
+ I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
 "RTN","C0CCCD",38,0)
-       I FN="" S ONAM="PAT_"_DFN_"_CCD_V1.xml"
+ . S @ODIRGLB="/home/glilly/CCROUT"
 "RTN","C0CCCD",39,0)
-       S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))
+ . ;S @ODIRGLB="/home/cedwards/"
 "RTN","C0CCCD",40,0)
-       I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
+ . ;S @ODIRGLB="/opt/wv/p/"
 "RTN","C0CCCD",41,0)
-       . S @ODIRGLB="/home/glilly/CCROUT"
+ S ODIR=DIR
 "RTN","C0CCCD",42,0)
-       . ;S @ODIRGLB="/home/cedwards/"
+ I DIR="" S ODIR=@ODIRGLB
 "RTN","C0CCCD",43,0)
-       . ;S @ODIRGLB="/opt/wv/p/"
+ N ZY
 "RTN","C0CCCD",44,0)
-       S ODIR=DIR
+ S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR)
 "RTN","C0CCCD",45,0)
-       I DIR="" S ODIR=@ODIRGLB
+ W $P(ZY,U,2)
 "RTN","C0CCCD",46,0)
-       N ZY
+ Q
 "RTN","C0CCCD",47,0)
-       S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR)
+ ;
 "RTN","C0CCCD",48,0)
-       W $P(ZY,U,2)
+CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
 "RTN","C0CCCD",49,0)
-       Q
+ ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
 "RTN","C0CCCD",50,0)
-       ;
+ ; DFN IS PATIENT IEN
 "RTN","C0CCCD",51,0)
-CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
+ ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
 "RTN","C0CCCD",52,0)
-    ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
+ ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
 "RTN","C0CCCD",53,0)
-    ; DFN IS PATIENT IEN
+ ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
 "RTN","C0CCCD",54,0)
-    ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
+ ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
 "RTN","C0CCCD",55,0)
-    ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
+ ; - NULL MEANS NOW
 "RTN","C0CCCD",56,0)
-    ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
+ ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
 "RTN","C0CCCD",57,0)
-    ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
+ ;    "TO" VARIABLES
 "RTN","C0CCCD",58,0)
-    ; - NULL MEANS NOW
+ ;    IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN
 "RTN","C0CCCD",59,0)
-    ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
+ I '$D(DEBUG) S DEBUG=0
 "RTN","C0CCCD",60,0)
-    ;    "TO" VARIABLES
+ N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD
 "RTN","C0CCCD",61,0)
-    ;    IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN
+ I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD
 "RTN","C0CCCD",62,0)
-    I '$D(DEBUG) S DEBUG=0
+ S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
 "RTN","C0CCCD",63,0)
-    N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD
+ I CCD S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD
 "RTN","C0CCCD",64,0)
-    I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD
+ E  S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
 "RTN","C0CCCD",65,0)
-    S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
+ S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
 "RTN","C0CCCD",66,0)
-    I CCD S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD
+ ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
 "RTN","C0CCCD",67,0)
-    E  S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
+ S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
 "RTN","C0CCCD",68,0)
-    S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
+ I CCD D LOAD^C0CCCD1(TGLOBAL)  ; LOAD THE CCR TEMPLATE
 "RTN","C0CCCD",69,0)
-    ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
+ E  D LOAD^C0CCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
 "RTN","C0CCCD",70,0)
-    S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
+ D CP^C0CXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
 "RTN","C0CCCD",71,0)
-    I CCD D LOAD^C0CCCD1(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+ N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES
 "RTN","C0CCCD",72,0)
-    E  D LOAD^C0CCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+ S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT
 "RTN","C0CCCD",73,0)
-    D CP^C0CXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
+ S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD
 "RTN","C0CCCD",74,0)
-    N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES
+ S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT
 "RTN","C0CCCD",75,0)
-    S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT
+ S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO
 "RTN","C0CCCD",76,0)
-    S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD
+ S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP
 "RTN","C0CCCD",77,0)
-    S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT
+ S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP
 "RTN","C0CCCD",78,0)
-    S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO
+ ;
 "RTN","C0CCCD",79,0)
-    S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP
+ ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
 "RTN","C0CCCD",80,0)
-    S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP
+ ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
 "RTN","C0CCCD",81,0)
-    ;
+ D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body")
 "RTN","C0CCCD",82,0)
-    ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
+ D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors")
 "RTN","C0CCCD",83,0)
-    ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
+ I 'CCD D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures")
 "RTN","C0CCCD",84,0)
-    D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body")
+ I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),!
 "RTN","C0CCCD",85,0)
-    D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors")
+ ;
 "RTN","C0CCCD",86,0)
-    I 'CCD D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures")
+ I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
 "RTN","C0CCCD",87,0)
-    I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),!
+ ; MAPPING THE PATIENT PORTION OF THE CDA HEADER
 "RTN","C0CCCD",88,0)
-    ;
+ S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"
 "RTN","C0CCCD",89,0)
-    I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
+ D QUERY^C0CXPATH(CCDGLO,ZZX,"ACTT1")
 "RTN","C0CCCD",90,0)
-    ; MAPPING THE PATIENT PORTION OF THE CDA HEADER
+ D PATIENT^C0CACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
 "RTN","C0CCCD",91,0)
-    S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"
+ I DEBUG D PARY^C0CXPATH("ACTT2")
 "RTN","C0CCCD",92,0)
-    D QUERY^C0CXPATH(CCDGLO,ZZX,"ACTT1")
+ D REPLACE^C0CXPATH(CCDGLO,"ACTT2",ZZX)
 "RTN","C0CCCD",93,0)
-    D PATIENT^C0CACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
+ I DEBUG D PARY^C0CXPATH(CCDGLO)
 "RTN","C0CCCD",94,0)
-    I DEBUG D PARY^C0CXPATH("ACTT2")
+ K ACTT1 K ACCT2
 "RTN","C0CCCD",95,0)
-    D REPLACE^C0CXPATH(CCDGLO,"ACTT2",ZZX)
+ ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
 "RTN","C0CCCD",96,0)
-    I DEBUG D PARY^C0CXPATH(CCDGLO)
+ ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
 "RTN","C0CCCD",97,0)
-    K ACTT1 K ACCT2
+ D ORG^C0CACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
 "RTN","C0CCCD",98,0)
-    ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
+ D CP^C0CXPATH("ACTT2",CCDGLO)
 "RTN","C0CCCD",99,0)
-    ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
+ ;
 "RTN","C0CCCD",100,0)
-    D ORG^C0CACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
+ K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
 "RTN","C0CCCD",101,0)
-    D CP^C0CXPATH("ACTT2",CCDGLO)
+ S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
 "RTN","C0CCCD",102,0)
-    ;
+ D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
 "RTN","C0CCCD",103,0)
-    K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
+ N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
 "RTN","C0CCCD",104,0)
-    S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
+ F I=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
 "RTN","C0CCCD",105,0)
-    D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
+ . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
 "RTN","C0CCCD",106,0)
-    N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
+ . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
 "RTN","C0CCCD",107,0)
-    F I=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
+ . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
 "RTN","C0CCCD",108,0)
-    . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
+ . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
 "RTN","C0CCCD",109,0)
-    . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
+ . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
 "RTN","C0CCCD",110,0)
-    . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
+ . S IXML="INXML"
 "RTN","C0CCCD",111,0)
-    . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
+ . I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION
 "RTN","C0CCCD",112,0)
-    . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
+ . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
 "RTN","C0CCCD",113,0)
-    . S IXML="INXML"
+ . ; W OXML,!
 "RTN","C0CCCD",114,0)
-    . I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION
+ . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
 "RTN","C0CCCD",115,0)
-    . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
+ . W "RUNNING ",CALL,!
 "RTN","C0CCCD",116,0)
-    . ; W OXML,!
+ . X CALL
 "RTN","C0CCCD",117,0)
-    . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
+ . I @OXML@(0)'=0 D  ; THERE IS A RESULT
 "RTN","C0CCCD",118,0)
-    . W "RUNNING ",CALL,!
+ . . I CCD D QUERY^C0CXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH
 "RTN","C0CCCD",119,0)
-    . X CALL
+ . . I CCD D UNSHAVE("ITMP",OXML)
 "RTN","C0CCCD",120,0)
-    . I @OXML@(0)'=0 D  ; THERE IS A RESULT
+ . . I CCD D UNMARK^C0CXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION
 "RTN","C0CCCD",121,0)
-    . . I CCD D QUERY^C0CXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH
+ . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
 "RTN","C0CCCD",122,0)
-    . . I CCD D UNSHAVE("ITMP",OXML)
+ . D INSERT^C0CXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body")
 "RTN","C0CCCD",123,0)
-    . . I CCD D UNMARK^C0CXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION
+ . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
 "RTN","C0CCCD",124,0)
-    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
+ ; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE
 "RTN","C0CCCD",125,0)
-    . D INSERT^C0CXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body")
+ ; D ACTLST^C0CCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST
 "RTN","C0CCCD",126,0)
-    . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
+ ; D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
 "RTN","C0CCCD",127,0)
-    ; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE
+ ; D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
 "RTN","C0CCCD",128,0)
-    ; D ACTLST^C0CCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST
+ ; D INSINNER^C0CXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
 "RTN","C0CCCD",129,0)
-    ; D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
+ N I,J,DONE S DONE=0
 "RTN","C0CCCD",130,0)
-    ; D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
+ F I=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
 "RTN","C0CCCD",131,0)
-    ; D INSINNER^C0CXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
+ . S J=$$TRIM^C0CXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS
 "RTN","C0CCCD",132,0)
-    N I,J,DONE S DONE=0
+ . W "TRIMMED",J,!
 "RTN","C0CCCD",133,0)
-    F I=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
+ . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
 "RTN","C0CCCD",134,0)
-    . S J=$$TRIM^C0CXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS
+ I CCD D  ; TURN THE BODY INTO A CCD COMPONENT
 "RTN","C0CCCD",135,0)
-    . W "TRIMMED",J,!
+ . N I
 "RTN","C0CCCD",136,0)
-    . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
+ . F I=1:1:@CCDGLO@(0) D  ; SEARCH THROUGH THE ENTIRE ARRAY
 "RTN","C0CCCD",137,0)
-    I CCD D  ; TURN THE BODY INTO A CCD COMPONENT
+ . . I @CCDGLO@(I)["<Body>" D  ; REPLACE BODY MARKUP
 "RTN","C0CCCD",138,0)
-    . N I
+ . . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ
 "RTN","C0CCCD",139,0)
-    . F I=1:1:@CCDGLO@(0) D  ; SEARCH THROUGH THE ENTIRE ARRAY
+ . . I @CCDGLO@(I)["</Body>" D  ; REPLACE BODY MARKUP
 "RTN","C0CCCD",140,0)
-    . . I @CCDGLO@(I)["<Body>" D  ; REPLACE BODY MARKUP
+ . . . S @CCDGLO@(I)="</structuredBody></component>"
 "RTN","C0CCCD",141,0)
-    . . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ
+ S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD
 "RTN","C0CCCD",142,0)
-    . . I @CCDGLO@(I)["</Body>" D  ; REPLACE BODY MARKUP
+ S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE
 "RTN","C0CCCD",143,0)
-    . . . S @CCDGLO@(I)="</structuredBody></component>"
+ Q
 "RTN","C0CCCD",144,0)
-    S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD
+ ;
 "RTN","C0CCCD",145,0)
-    S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE
+INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
 "RTN","C0CCCD",146,0)
-    Q
+ ; TAB IS PASSED BY NAME
 "RTN","C0CCCD",147,0)
-    ;
+ W "TAB= ",TAB,!
 "RTN","C0CCCD",148,0)
-INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
+ ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
 "RTN","C0CCCD",149,0)
-    ; TAB IS PASSED BY NAME
+ D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")")
 "RTN","C0CCCD",150,0)
-    W "TAB= ",TAB,!
+ ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
 "RTN","C0CCCD",151,0)
-    ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
+ I 'CCD D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
 "RTN","C0CCCD",152,0)
-    D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")")
+ Q
 "RTN","C0CCCD",153,0)
-    ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
+ ;
 "RTN","C0CCCD",154,0)
-    I 'CCD D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
+SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT
 "RTN","C0CCCD",155,0)
-    Q
+ ; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION
 "RTN","C0CCCD",156,0)
-    ;
+ N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
 "RTN","C0CCCD",157,0)
-SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT
+ W SHXML,!
 "RTN","C0CCCD",158,0)
-    ; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION
+ W @SHXML@(1),!
 "RTN","C0CCCD",159,0)
-    N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
+ D QUEUE^C0CXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED
 "RTN","C0CCCD",160,0)
-    W SHXML,!
+ D QUEUE^C0CXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART
 "RTN","C0CCCD",161,0)
-    W @SHXML@(1),!
+ D QUEUE^C0CXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE
 "RTN","C0CCCD",162,0)
-    D QUEUE^C0CXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED
+ D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
 "RTN","C0CCCD",163,0)
-    D QUEUE^C0CXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART
+ D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
 "RTN","C0CCCD",164,0)
-    D QUEUE^C0CXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE
+ D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
 "RTN","C0CCCD",165,0)
-    D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
+ Q
 "RTN","C0CCCD",166,0)
-    D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
+ ;
 "RTN","C0CCCD",167,0)
-    D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
+UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE
 "RTN","C0CCCD",168,0)
-    Q
+ ; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML
 "RTN","C0CCCD",169,0)
-    ;
+ N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
 "RTN","C0CCCD",170,0)
-UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE
+ W SHXML,!
 "RTN","C0CCCD",171,0)
-    ; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML
+ W @SHXML@(1),!
 "RTN","C0CCCD",172,0)
-    N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
+ D QUEUE^C0CXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE
 "RTN","C0CCCD",173,0)
-    W SHXML,!
+ D QUEUE^C0CXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST
 "RTN","C0CCCD",174,0)
-    W @SHXML@(1),!
+ D QUEUE^C0CXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP
 "RTN","C0CCCD",175,0)
-    D QUEUE^C0CXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE
+ D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
 "RTN","C0CCCD",176,0)
-    D QUEUE^C0CXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST
+ D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
 "RTN","C0CCCD",177,0)
-    D QUEUE^C0CXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP
+ D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
 "RTN","C0CCCD",178,0)
-    D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
+ Q
 "RTN","C0CCCD",179,0)
-    D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
+ ;
 "RTN","C0CCCD",180,0)
-    D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
+HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
 "RTN","C0CCCD",181,0)
-    Q
+ N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
 "RTN","C0CCCD",182,0)
-    ;
+ ; K @VMAP
 "RTN","C0CCCD",183,0)
-HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
+ S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
 "RTN","C0CCCD",184,0)
-    N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
+ I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
 "RTN","C0CCCD",185,0)
-    ; K @VMAP
+ . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
 "RTN","C0CCCD",186,0)
-    S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
+ . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
 "RTN","C0CCCD",187,0)
-    I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
+ . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
 "RTN","C0CCCD",188,0)
-    . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
+ . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
 "RTN","C0CCCD",189,0)
-    . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
+ . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
 "RTN","C0CCCD",190,0)
-    . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
+ . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
 "RTN","C0CCCD",191,0)
-    . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
+ . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
 "RTN","C0CCCD",192,0)
-    . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
+ I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
 "RTN","C0CCCD",193,0)
-    . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
+ . D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
 "RTN","C0CCCD",194,0)
-    . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
+ N CTMP
 "RTN","C0CCCD",195,0)
-    I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
+ D MAP^C0CXPATH(CXML,VMAP,"CTMP")
 "RTN","C0CCCD",196,0)
-    . D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
+ D CP^C0CXPATH("CTMP",CXML)
 "RTN","C0CCCD",197,0)
-    N CTMP
+ Q
 "RTN","C0CCCD",198,0)
-    D MAP^C0CXPATH(CXML,VMAP,"CTMP")
+ ;
 "RTN","C0CCCD",199,0)
-    D CP^C0CXPATH("CTMP",CXML)
+ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
 "RTN","C0CCCD",200,0)
-    Q
+ ; AXML AND ACTRTN ARE PASSED BY NAME
 "RTN","C0CCCD",201,0)
-    ;
+ ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
 "RTN","C0CCCD",202,0)
-ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
+ ; P1= OBJECTID - ACTORPATIENT_2
 "RTN","C0CCCD",203,0)
-    ; AXML AND ACTRTN ARE PASSED BY NAME
+ ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
 "RTN","C0CCCD",204,0)
-    ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
+ ;OR INSTITUTION
 "RTN","C0CCCD",205,0)
-    ; P1= OBJECTID - ACTORPATIENT_2
+ ;  OR PERSON(IN PATIENT FILE IE NOK)
 "RTN","C0CCCD",206,0)
-    ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
+ ; P3= IEN RECORD NUMBER FOR ACTOR - 2
 "RTN","C0CCCD",207,0)
-    ;OR INSTITUTION
+ N I,J,K,L
 "RTN","C0CCCD",208,0)
-    ;  OR PERSON(IN PATIENT FILE IE NOK)
+ K @ACTRTN ; CLEAR RETURN ARRAY
 "RTN","C0CCCD",209,0)
-    ; P3= IEN RECORD NUMBER FOR ACTOR - 2
+ F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
 "RTN","C0CCCD",210,0)
-    N I,J,K,L
+ . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
 "RTN","C0CCCD",211,0)
-    K @ACTRTN ; CLEAR RETURN ARRAY
+ . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
 "RTN","C0CCCD",212,0)
-    F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
+ . . W "<ActorID>=>",J,!
 "RTN","C0CCCD",213,0)
-    . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
+ . . I J'="" S K(J)="" ; HASHING ACTOR
 "RTN","C0CCCD",214,0)
-    . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
+ . . ;  TO GET RID OF DUPLICATES
 "RTN","C0CCCD",215,0)
-    . . W "<ActorID>=>",J,!
+ S I="" ; GOING TO $O THROUGH THE HASH
 "RTN","C0CCCD",216,0)
-    . . I J'="" S K(J)="" ; HASHING ACTOR
+ F J=0:0 D  Q:$O(K(I))=""  ;
 "RTN","C0CCCD",217,0)
-    . . ;  TO GET RID OF DUPLICATES
+ . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
 "RTN","C0CCCD",218,0)
-    S I="" ; GOING TO $O THROUGH THE HASH
+ . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
 "RTN","C0CCCD",219,0)
-    F J=0:0 D  Q:$O(K(I))=""  ;
+ . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
 "RTN","C0CCCD",220,0)
-    . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
+ . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
 "RTN","C0CCCD",221,0)
-    . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
+ . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
 "RTN","C0CCCD",222,0)
-    . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
+ Q
 "RTN","C0CCCD",223,0)
-    . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
+ ;
 "RTN","C0CCCD",224,0)
-    . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
+TEST ; RUN ALL THE TEST CASES
 "RTN","C0CCCD",225,0)
-    Q
+ D TESTALL^C0CUNIT("C0CCCR")
 "RTN","C0CCCD",226,0)
-    ;
+ Q
 "RTN","C0CCCD",227,0)
-TEST ; RUN ALL THE TEST CASES
+ ;
 "RTN","C0CCCD",228,0)
-  D TESTALL^C0CUNIT("C0CCCR")
+ZTEST(WHICH)  ; RUN ONE SET OF TESTS
 "RTN","C0CCCD",229,0)
-  Q
+ N ZTMP
 "RTN","C0CCCD",230,0)
-  ;
+ D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
 "RTN","C0CCCD",231,0)
-ZTEST(WHICH)  ; RUN ONE SET OF TESTS
+ D ZTEST^C0CUNIT(.ZTMP,WHICH)
 "RTN","C0CCCD",232,0)
-  N ZTMP
+ Q
 "RTN","C0CCCD",233,0)
-  D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
+ ;
 "RTN","C0CCCD",234,0)
-  D ZTEST^C0CUNIT(.ZTMP,WHICH)
+TLIST  ; LIST THE TESTS
 "RTN","C0CCCD",235,0)
-  Q
+ N ZTMP
 "RTN","C0CCCD",236,0)
-  ;
+ D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
 "RTN","C0CCCD",237,0)
-TLIST  ; LIST THE TESTS
+ D TLIST^C0CUNIT(.ZTMP)
 "RTN","C0CCCD",238,0)
-  N ZTMP
+ Q
 "RTN","C0CCCD",239,0)
-  D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
+ ;
 "RTN","C0CCCD",240,0)
-  D TLIST^C0CUNIT(.ZTMP)
+ ;;><TEST>
 "RTN","C0CCCD",241,0)
-  Q
+ ;;><PROBLEMS>
 "RTN","C0CCCD",242,0)
-  ;
+ ;;>>>K C0C S C0C=""
 "RTN","C0CCCD",243,0)
- ;;><TEST>
+ ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","","","")
 "RTN","C0CCCD",244,0)
- ;;><PROBLEMS>
+ ;;>>?@C0C@(@C0C@(0))["</Problems>"
 "RTN","C0CCCD",245,0)
+ ;;><VITALS>
+"RTN","C0CCCD",246,0)
  ;;>>>K C0C S C0C=""
-"RTN","C0CCCD",246,0)
- ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","","","")
 "RTN","C0CCCD",247,0)
- ;;>>?@C0C@(@C0C@(0))["</Problems>"
+ ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","","","")
 "RTN","C0CCCD",248,0)
- ;;><VITALS>
+ ;;>>?@C0C@(@C0C@(0))["</VitalSigns>"
 "RTN","C0CCCD",249,0)
+ ;;><CCR>
+"RTN","C0CCCD",250,0)
  ;;>>>K C0C S C0C=""
-"RTN","C0CCCD",250,0)
- ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","","","")
 "RTN","C0CCCD",251,0)
- ;;>>?@C0C@(@C0C@(0))["</VitalSigns>"
+ ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","")
 "RTN","C0CCCD",252,0)
- ;;><CCR>
+ ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
 "RTN","C0CCCD",253,0)
+ ;;><ACTLST>
+"RTN","C0CCCD",254,0)
  ;;>>>K C0C S C0C=""
-"RTN","C0CCCD",254,0)
+"RTN","C0CCCD",255,0)
  ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","")
-"RTN","C0CCCD",255,0)
+"RTN","C0CCCD",256,0)
+ ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST")
+"RTN","C0CCCD",257,0)
+ ;;><ACTORS>
+"RTN","C0CCCD",258,0)
+ ;;>>>D ZTEST^C0CCCR("ACTLST")
+"RTN","C0CCCD",259,0)
+ ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
+"RTN","C0CCCD",260,0)
+ ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3")
+"RTN","C0CCCD",261,0)
+ ;;>>?G3(G3(0))["</Actors>"
+"RTN","C0CCCD",262,0)
+ ;;><TRIM>
+"RTN","C0CCCD",263,0)
+ ;;>>>D ZTEST^C0CCCR("CCR")
+"RTN","C0CCCD",264,0)
+ ;;>>>W $$TRIM^C0CXPATH(CCDGLO)
+"RTN","C0CCCD",265,0)
+ ;;><CCD>
+"RTN","C0CCCD",266,0)
+ ;;>>>K C0C S C0C=""
+"RTN","C0CCCD",267,0)
+ ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCD","","","")
+"RTN","C0CCCD",268,0)
  ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
-"RTN","C0CCCD",256,0)
- ;;><ACTLST>
-"RTN","C0CCCD",257,0)
- ;;>>>K C0C S C0C=""
-"RTN","C0CCCD",258,0)
- ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","")
-"RTN","C0CCCD",259,0)
- ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST")
-"RTN","C0CCCD",260,0)
- ;;><ACTORS>
-"RTN","C0CCCD",261,0)
- ;;>>>D ZTEST^C0CCCR("ACTLST")
-"RTN","C0CCCD",262,0)
- ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
-"RTN","C0CCCD",263,0)
- ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3")
-"RTN","C0CCCD",264,0)
- ;;>>?G3(G3(0))["</Actors>"
-"RTN","C0CCCD",265,0)
- ;;><TRIM>
-"RTN","C0CCCD",266,0)
- ;;>>>D ZTEST^C0CCCR("CCR")
-"RTN","C0CCCD",267,0)
- ;;>>>W $$TRIM^C0CXPATH(CCDGLO)
-"RTN","C0CCCD",268,0)
- ;;><CCD>
 "RTN","C0CCCD",269,0)
- ;;>>>K C0C S C0C=""
-"RTN","C0CCCD",270,0)
- ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCD","","","")
-"RTN","C0CCCD",271,0)
- ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
-"RTN","C0CCCD",272,0)
  ;;></TEST>
 "RTN","C0CCCD1")
-0^44^B100634737
+0^44^B96013153
 "RTN","C0CCCD1",1,0)
 C0CCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
 "RTN","C0CCCD1",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CCCD1",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
 "RTN","C0CCCD1",4,0)
- ;Licensed under the terms of the GNU General Public License.
+ ;
 "RTN","C0CCCD1",5,0)
- ;See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CCCD1",6,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CCCD1",7,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CCCD1",8,0)
- ;it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CCCD1",9,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CCCD1",10,0)
- ;(at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CCCD1",11,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CCCD1",12,0)
- ;This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CCCD1",13,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CCCD1",14,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CCCD1",15,0)
- ;GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CCCD1",16,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CCCD1",17,0)
- ;You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CCCD1",18,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CCCD1",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ W "This is a CCD TEMPLATE with processing routines",!
 "RTN","C0CCCD1",20,0)
- ;
+ W !
 "RTN","C0CCCD1",21,0)
-          W "This is a CCD TEMPLATE with processing routines",!
+ Q
 "RTN","C0CCCD1",22,0)
-          W !
+ ;
 "RTN","C0CCCD1",23,0)
-          Q
+ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
 "RTN","C0CCCD1",24,0)
-          ;
+ ; ZARY IS PASSED BY NAME
 "RTN","C0CCCD1",25,0)
-ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
+ ; BAT is a string identifying the section
 "RTN","C0CCCD1",26,0)
-          ; ZARY IS PASSED BY NAME
+ ; LINE is a test which will evaluate to true or false
 "RTN","C0CCCD1",27,0)
-          ; BAT is a string identifying the section
+ ; I '$G(@ZARY) D  ; IF ZARY DOES NOT EXIST '
 "RTN","C0CCCD1",28,0)
-          ; LINE is a test which will evaluate to true or false
+ ; . S @ZARY@(0)=0 ; initially there are no elements
 "RTN","C0CCCD1",29,0)
-          ; I '$G(@ZARY) D  ; IF ZARY DOES NOT EXIST '
+ ; . W "GOT HERE LOADING "_LINE,!
 "RTN","C0CCCD1",30,0)
-          ; . S @ZARY@(0)=0 ; initially there are no elements
+ N CNT ; count of array elements
 "RTN","C0CCCD1",31,0)
-          ; . W "GOT HERE LOADING "_LINE,!
+ S CNT=@ZARY@(0) ; contains array count
 "RTN","C0CCCD1",32,0)
-          N CNT ; count of array elements
+ S CNT=CNT+1 ; increment count
 "RTN","C0CCCD1",33,0)
-          S CNT=@ZARY@(0) ; contains array count
+ S @ZARY@(CNT)=LINE ; put the line in the array
 "RTN","C0CCCD1",34,0)
-          S CNT=CNT+1 ; increment count
+ ; S @ZARY@(BAT,CNT)="" ; index the test by battery
 "RTN","C0CCCD1",35,0)
-          S @ZARY@(CNT)=LINE ; put the line in the array
+ S @ZARY@(0)=CNT ; update the array counter
 "RTN","C0CCCD1",36,0)
-          ; S @ZARY@(BAT,CNT)="" ; index the test by battery
+ Q
 "RTN","C0CCCD1",37,0)
-          S @ZARY@(0)=CNT ; update the array counter
+ ;
 "RTN","C0CCCD1",38,0)
-          Q
+ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
 "RTN","C0CCCD1",39,0)
-          ;
+ ; ZARY IS PASSED BY NAME
 "RTN","C0CCCD1",40,0)
-ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
+ ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
 "RTN","C0CCCD1",41,0)
-          ; ZARY IS PASSED BY NAME
+ ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
 "RTN","C0CCCD1",42,0)
-          ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+ K @ZARY S @ZARY=""
 "RTN","C0CCCD1",43,0)
-          ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+ S @ZARY@(0)=0 ; initialize array count
 "RTN","C0CCCD1",44,0)
-          K @ZARY S @ZARY=""
+ N LINE,LABEL,BODY
 "RTN","C0CCCD1",45,0)
-          S @ZARY@(0)=0 ; initialize array count
+ N INTEST S INTEST=0 ; switch for in the TEMPLATE section
 "RTN","C0CCCD1",46,0)
-          N LINE,LABEL,BODY
+ N SECTION S SECTION="[anonymous]" ; NO section LABEL
 "RTN","C0CCCD1",47,0)
-          N INTEST S INTEST=0 ; switch for in the TEMPLATE section
+ ;
 "RTN","C0CCCD1",48,0)
-          N SECTION S SECTION="[anonymous]" ; NO section LABEL
+ N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
 "RTN","C0CCCD1",49,0)
-          ;
+ . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
 "RTN","C0CCCD1",50,0)
-          N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
+ . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
 "RTN","C0CCCD1",51,0)
-          . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
+ . I INTEST  D  ; within the section
 "RTN","C0CCCD1",52,0)
-          . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
+ . . I LINE?." "1";><".E  D  ; sub-section name found
 "RTN","C0CCCD1",53,0)
-          . I INTEST  D  ; within the section
+ . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
 "RTN","C0CCCD1",54,0)
-          . . I LINE?." "1";><".E  D  ; sub-section name found
+ . . I LINE?." "1";;".E  D  ; line found
 "RTN","C0CCCD1",55,0)
-          . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
+ . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
 "RTN","C0CCCD1",56,0)
-          . . I LINE?." "1";;".E  D  ; line found
+ Q
 "RTN","C0CCCD1",57,0)
-          . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
+ ;
 "RTN","C0CCCD1",58,0)
-          Q
+LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
 "RTN","C0CCCD1",59,0)
-          ;
+ D ZLOAD(ARY,"C0CCCD1")
 "RTN","C0CCCD1",60,0)
-LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
+ ; ZWR @ARY
 "RTN","C0CCCD1",61,0)
-          D ZLOAD(ARY,"C0CCCD1")
+ Q
 "RTN","C0CCCD1",62,0)
-          ; ZWR @ARY
+ ;
 "RTN","C0CCCD1",63,0)
-          Q
+TRMCCD    ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD
 "RTN","C0CCCD1",64,0)
-          ;
+ Q
 "RTN","C0CCCD1",65,0)
-TRMCCD    ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD
+MARKUP ;<MARKUP>
 "RTN","C0CCCD1",66,0)
-          Q
+ ;;<Body>
 "RTN","C0CCCD1",67,0)
-MARKUP ;<MARKUP>
+ ;;<Problems>
 "RTN","C0CCCD1",68,0)
+ ;;</Problems>
+"RTN","C0CCCD1",69,0)
+ ;;<FamilyHistory>
+"RTN","C0CCCD1",70,0)
+ ;;</FamilyHistory>
+"RTN","C0CCCD1",71,0)
+ ;;<SocialHistory>
+"RTN","C0CCCD1",72,0)
+ ;;</SocialHistory>
+"RTN","C0CCCD1",73,0)
+ ;;<Alerts>
+"RTN","C0CCCD1",74,0)
+ ;;</Alerts>
+"RTN","C0CCCD1",75,0)
+ ;;<Medications>
+"RTN","C0CCCD1",76,0)
+ ;;</Medications>
+"RTN","C0CCCD1",77,0)
+ ;;<VitalSigns>
+"RTN","C0CCCD1",78,0)
+ ;;</VitalSigns>
+"RTN","C0CCCD1",79,0)
+ ;;<Results>
+"RTN","C0CCCD1",80,0)
+ ;;</Results>
+"RTN","C0CCCD1",81,0)
+ ;;</Body>
+"RTN","C0CCCD1",82,0)
+ ;;</ContinuityOfCareRecord>
+"RTN","C0CCCD1",83,0)
+ ;</MARKUP>
+"RTN","C0CCCD1",84,0)
+ ;;<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">
+"RTN","C0CCCD1",85,0)
+ ;;</ClinicalDocument>
+"RTN","C0CCCD1",86,0)
+ Q
+"RTN","C0CCCD1",87,0)
+ ;
+"RTN","C0CCCD1",88,0)
+ ;<TEMPLATE>
+"RTN","C0CCCD1",89,0)
+ ;;<?xml version="1.0"?>
+"RTN","C0CCCD1",90,0)
+ ;;<?xml-stylesheet type="text/xsl" href="CCD.xsl"?>
+"RTN","C0CCCD1",91,0)
+ ;;<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">
+"RTN","C0CCCD1",92,0)
+ ;;<typeId root="2.16.840.1.113883.1.3" extension="POCD_HD000040"/>
+"RTN","C0CCCD1",93,0)
+ ;;<templateId root="2.16.840.1.113883.10.20.1"/>
+"RTN","C0CCCD1",94,0)
+ ;;<id root="db734647-fc99-424c-a864-7e3cda82e703"/>
+"RTN","C0CCCD1",95,0)
+ ;;<code code="34133-9" codeSystem="2.16.840.1.113883.6.1" displayName="Summarization of episode note"/>
+"RTN","C0CCCD1",96,0)
+ ;;<title>Continuity of Care Document</title>
+"RTN","C0CCCD1",97,0)
+ ;;<effectiveTime value="20000407130000+0500"/>
+"RTN","C0CCCD1",98,0)
+ ;;<confidentialityCode code="N" codeSystem="2.16.840.1.113883.5.25"/>
+"RTN","C0CCCD1",99,0)
+ ;;<languageCode code="en-US"/>
+"RTN","C0CCCD1",100,0)
+ ;;<recordTarget>
+"RTN","C0CCCD1",101,0)
+ ;;<patientRole>
+"RTN","C0CCCD1",102,0)
+ ;;<id extension="@@ACTORIEN@@" root="2.16.840.1.113883.19.5"/>
+"RTN","C0CCCD1",103,0)
+ ;;<patient>
+"RTN","C0CCCD1",104,0)
+ ;;<name>
+"RTN","C0CCCD1",105,0)
+ ;;<given>@@ACTORGIVENNAME@@</given>
+"RTN","C0CCCD1",106,0)
+ ;;<family>@@ACTORFAMILYNAME@@</family>
+"RTN","C0CCCD1",107,0)
+ ;;<suffix>@@ACTORSUFFIXNAME@@</suffix>
+"RTN","C0CCCD1",108,0)
+ ;;</name>
+"RTN","C0CCCD1",109,0)
+ ;;<administrativeGenderCode code="@@ACTORGENDER@@" codeSystem="2.16.840.1.113883.5.1"/>
+"RTN","C0CCCD1",110,0)
+ ;;<birthTime value="@@ACTORDATEOFBIRTH@@"/>
+"RTN","C0CCCD1",111,0)
+ ;;</patient>
+"RTN","C0CCCD1",112,0)
+ ;;<providerOrganization>
+"RTN","C0CCCD1",113,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","C0CCCD1",114,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","C0CCCD1",115,0)
+ ;;</providerOrganization>
+"RTN","C0CCCD1",116,0)
+ ;;</patientRole>
+"RTN","C0CCCD1",117,0)
+ ;;</recordTarget>
+"RTN","C0CCCD1",118,0)
+ ;;<author>
+"RTN","C0CCCD1",119,0)
+ ;;<time value="20000407130000+0500"/>
+"RTN","C0CCCD1",120,0)
+ ;;<assignedAuthor>
+"RTN","C0CCCD1",121,0)
+ ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
+"RTN","C0CCCD1",122,0)
+ ;;<assignedPerson>
+"RTN","C0CCCD1",123,0)
+ ;;<name>
+"RTN","C0CCCD1",124,0)
+ ;;<prefix>@@ACTORNAMEPREFIX@@</prefix>
+"RTN","C0CCCD1",125,0)
+ ;;<given>@@ACTORGIVENNAME@@</given>
+"RTN","C0CCCD1",126,0)
+ ;;<family>@@ACTORFAMILYNAME@@</family>
+"RTN","C0CCCD1",127,0)
+ ;;</name>
+"RTN","C0CCCD1",128,0)
+ ;;</assignedPerson>
+"RTN","C0CCCD1",129,0)
+ ;;<representedOrganization>
+"RTN","C0CCCD1",130,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","C0CCCD1",131,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","C0CCCD1",132,0)
+ ;;</representedOrganization>
+"RTN","C0CCCD1",133,0)
+ ;;</assignedAuthor>
+"RTN","C0CCCD1",134,0)
+ ;;</author>
+"RTN","C0CCCD1",135,0)
+ ;;<informant>
+"RTN","C0CCCD1",136,0)
+ ;;<assignedEntity>
+"RTN","C0CCCD1",137,0)
+ ;;<id nullFlavor="NI"/>
+"RTN","C0CCCD1",138,0)
+ ;;<representedOrganization>
+"RTN","C0CCCD1",139,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","C0CCCD1",140,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","C0CCCD1",141,0)
+ ;;</representedOrganization>
+"RTN","C0CCCD1",142,0)
+ ;;</assignedEntity>
+"RTN","C0CCCD1",143,0)
+ ;;</informant>
+"RTN","C0CCCD1",144,0)
+ ;;<custodian>
+"RTN","C0CCCD1",145,0)
+ ;;<assignedCustodian>
+"RTN","C0CCCD1",146,0)
+ ;;<representedCustodianOrganization>
+"RTN","C0CCCD1",147,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","C0CCCD1",148,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","C0CCCD1",149,0)
+ ;;</representedCustodianOrganization>
+"RTN","C0CCCD1",150,0)
+ ;;</assignedCustodian>
+"RTN","C0CCCD1",151,0)
+ ;;</custodian>
+"RTN","C0CCCD1",152,0)
+ ;;<legalAuthenticator>
+"RTN","C0CCCD1",153,0)
+ ;;<time value="20000407130000+0500"/>
+"RTN","C0CCCD1",154,0)
+ ;;<signatureCode code="S"/>
+"RTN","C0CCCD1",155,0)
+ ;;<assignedEntity>
+"RTN","C0CCCD1",156,0)
+ ;;<id nullFlavor="NI"/>
+"RTN","C0CCCD1",157,0)
+ ;;<representedOrganization>
+"RTN","C0CCCD1",158,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","C0CCCD1",159,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","C0CCCD1",160,0)
+ ;;</representedOrganization>
+"RTN","C0CCCD1",161,0)
+ ;;</assignedEntity>
+"RTN","C0CCCD1",162,0)
+ ;;</legalAuthenticator>
+"RTN","C0CCCD1",163,0)
+ ;;<Actors>
+"RTN","C0CCCD1",164,0)
+ ;;<ACTOR-NOK>
+"RTN","C0CCCD1",165,0)
+ ;;<participant typeCode="IND">
+"RTN","C0CCCD1",166,0)
+ ;;<associatedEntity classCode="NOK">
+"RTN","C0CCCD1",167,0)
+ ;;<id root="4ac71514-6a10-4164-9715-f8d96af48e6d"/>
+"RTN","C0CCCD1",168,0)
+ ;;<code code="65656005" codeSystem="2.16.840.1.113883.6.96" displayName="Biiological mother"/>
+"RTN","C0CCCD1",169,0)
+ ;;<telecom value="tel:(999)555-1212"/>
+"RTN","C0CCCD1",170,0)
+ ;;<associatedPerson>
+"RTN","C0CCCD1",171,0)
+ ;;<name>
+"RTN","C0CCCD1",172,0)
+ ;;<given>Henrietta</given>
+"RTN","C0CCCD1",173,0)
+ ;;<family>Levin</family>
+"RTN","C0CCCD1",174,0)
+ ;;</name>
+"RTN","C0CCCD1",175,0)
+ ;;</associatedPerson>
+"RTN","C0CCCD1",176,0)
+ ;;</associatedEntity>
+"RTN","C0CCCD1",177,0)
+ ;;</participant>
+"RTN","C0CCCD1",178,0)
+ ;;</ACTOR-NOK>
+"RTN","C0CCCD1",179,0)
+ ;;</Actors>
+"RTN","C0CCCD1",180,0)
+ ;;<documentationOf>
+"RTN","C0CCCD1",181,0)
+ ;;<serviceEvent classCode="PCPR">
+"RTN","C0CCCD1",182,0)
+ ;;<effectiveTime>
+"RTN","C0CCCD1",183,0)
+ ;;<high value="@@DATETIME@@"/>
+"RTN","C0CCCD1",184,0)
+ ;;</effectiveTime>
+"RTN","C0CCCD1",185,0)
+ ;;<performer typeCode="PRF">
+"RTN","C0CCCD1",186,0)
+ ;;<functionCode code="PCP" codeSystem="2.16.840.1.113883.5.88"/>
+"RTN","C0CCCD1",187,0)
+ ;;<time>
+"RTN","C0CCCD1",188,0)
+ ;;<low value="1990"/>
+"RTN","C0CCCD1",189,0)
+ ;;<high value='20000407'/>
+"RTN","C0CCCD1",190,0)
+ ;;</time>
+"RTN","C0CCCD1",191,0)
+ ;;<assignedEntity>
+"RTN","C0CCCD1",192,0)
+ ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
+"RTN","C0CCCD1",193,0)
+ ;;<assignedPerson>
+"RTN","C0CCCD1",194,0)
+ ;;<name>
+"RTN","C0CCCD1",195,0)
+ ;;<prefix>@@ACTORPREFIXNAME@@</prefix>
+"RTN","C0CCCD1",196,0)
+ ;;<given>@@ACTORGIVENNAME@@</given>
+"RTN","C0CCCD1",197,0)
+ ;;<family>@@ACTORFAMILYNAME@@</family>
+"RTN","C0CCCD1",198,0)
+ ;;</name>
+"RTN","C0CCCD1",199,0)
+ ;;</assignedPerson>
+"RTN","C0CCCD1",200,0)
+ ;;<representedOrganization>
+"RTN","C0CCCD1",201,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","C0CCCD1",202,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","C0CCCD1",203,0)
+ ;;</representedOrganization>
+"RTN","C0CCCD1",204,0)
+ ;;</assignedEntity>
+"RTN","C0CCCD1",205,0)
+ ;;</performer>
+"RTN","C0CCCD1",206,0)
+ ;;</serviceEvent>
+"RTN","C0CCCD1",207,0)
+ ;;</documentationOf>
+"RTN","C0CCCD1",208,0)
  ;;<Body>
-"RTN","C0CCCD1",69,0)
+"RTN","C0CCCD1",209,0)
+ ;;<PROBLEMS-HTML>
+"RTN","C0CCCD1",210,0)
+ ;;<text><table border="1" width="100%"><thead><tr><th>Condition</th><th>Effective Dates</th><th>Condition Status</th></tr></thead><tbody>
+"RTN","C0CCCD1",211,0)
+ ;;<tr><td>@@PROBLEMDESCRIPTION@@</td>
+"RTN","C0CCCD1",212,0)
+ ;;<td>@@PROBLEMDATEOFONSET@@</td>
+"RTN","C0CCCD1",213,0)
+ ;;<td>Active</td></tr>
+"RTN","C0CCCD1",214,0)
+ ;;</tbody></table></text>
+"RTN","C0CCCD1",215,0)
+ ;;</PROBLEMS-HTML>
+"RTN","C0CCCD1",216,0)
  ;;<Problems>
-"RTN","C0CCCD1",70,0)
- ;;</Problems>
-"RTN","C0CCCD1",71,0)
- ;;<FamilyHistory>
-"RTN","C0CCCD1",72,0)
- ;;</FamilyHistory>
-"RTN","C0CCCD1",73,0)
- ;;<SocialHistory>
-"RTN","C0CCCD1",74,0)
- ;;</SocialHistory>
-"RTN","C0CCCD1",75,0)
- ;;<Alerts>
-"RTN","C0CCCD1",76,0)
- ;;</Alerts>
-"RTN","C0CCCD1",77,0)
- ;;<Medications>
-"RTN","C0CCCD1",78,0)
- ;;</Medications>
-"RTN","C0CCCD1",79,0)
- ;;<VitalSigns>
-"RTN","C0CCCD1",80,0)
- ;;</VitalSigns>
-"RTN","C0CCCD1",81,0)
- ;;<Results>
-"RTN","C0CCCD1",82,0)
- ;;</Results>
-"RTN","C0CCCD1",83,0)
- ;;</Body>
-"RTN","C0CCCD1",84,0)
- ;;</ContinuityOfCareRecord>
-"RTN","C0CCCD1",85,0)
- ;</MARKUP>
-"RTN","C0CCCD1",86,0)
- ;;<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">
-"RTN","C0CCCD1",87,0)
- ;;</ClinicalDocument>
-"RTN","C0CCCD1",88,0)
- Q
-"RTN","C0CCCD1",89,0)
- ;
-"RTN","C0CCCD1",90,0)
- ;<TEMPLATE>
-"RTN","C0CCCD1",91,0)
- ;;<?xml version="1.0"?>
-"RTN","C0CCCD1",92,0)
- ;;<?xml-stylesheet type="text/xsl" href="CCD.xsl"?>
-"RTN","C0CCCD1",93,0)
- ;;<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">
-"RTN","C0CCCD1",94,0)
- ;;<typeId root="2.16.840.1.113883.1.3" extension="POCD_HD000040"/>
-"RTN","C0CCCD1",95,0)
- ;;<templateId root="2.16.840.1.113883.10.20.1"/>
-"RTN","C0CCCD1",96,0)
- ;;<id root="db734647-fc99-424c-a864-7e3cda82e703"/>
-"RTN","C0CCCD1",97,0)
- ;;<code code="34133-9" codeSystem="2.16.840.1.113883.6.1" displayName="Summarization of episode note"/>
-"RTN","C0CCCD1",98,0)
- ;;<title>Continuity of Care Document</title>
-"RTN","C0CCCD1",99,0)
- ;;<effectiveTime value="20000407130000+0500"/>
-"RTN","C0CCCD1",100,0)
- ;;<confidentialityCode code="N" codeSystem="2.16.840.1.113883.5.25"/>
-"RTN","C0CCCD1",101,0)
- ;;<languageCode code="en-US"/>
-"RTN","C0CCCD1",102,0)
- ;;<recordTarget>
-"RTN","C0CCCD1",103,0)
- ;;<patientRole>
-"RTN","C0CCCD1",104,0)
- ;;<id extension="@@ACTORIEN@@" root="2.16.840.1.113883.19.5"/>
-"RTN","C0CCCD1",105,0)
- ;;<patient>
-"RTN","C0CCCD1",106,0)
- ;;<name>
-"RTN","C0CCCD1",107,0)
- ;;<given>@@ACTORGIVENNAME@@</given>
-"RTN","C0CCCD1",108,0)
- ;;<family>@@ACTORFAMILYNAME@@</family>
-"RTN","C0CCCD1",109,0)
- ;;<suffix>@@ACTORSUFFIXNAME@@</suffix>
-"RTN","C0CCCD1",110,0)
- ;;</name>
-"RTN","C0CCCD1",111,0)
- ;;<administrativeGenderCode code="@@ACTORGENDER@@" codeSystem="2.16.840.1.113883.5.1"/>
-"RTN","C0CCCD1",112,0)
- ;;<birthTime value="@@ACTORDATEOFBIRTH@@"/>
-"RTN","C0CCCD1",113,0)
- ;;</patient>
-"RTN","C0CCCD1",114,0)
- ;;<providerOrganization>
-"RTN","C0CCCD1",115,0)
- ;;<id root="2.16.840.1.113883.19.5"/>
-"RTN","C0CCCD1",116,0)
- ;;<name>@@ORGANIZATIONNAME@@</name>
-"RTN","C0CCCD1",117,0)
- ;;</providerOrganization>
-"RTN","C0CCCD1",118,0)
- ;;</patientRole>
-"RTN","C0CCCD1",119,0)
- ;;</recordTarget>
-"RTN","C0CCCD1",120,0)
- ;;<author>
-"RTN","C0CCCD1",121,0)
- ;;<time value="20000407130000+0500"/>
-"RTN","C0CCCD1",122,0)
- ;;<assignedAuthor>
-"RTN","C0CCCD1",123,0)
- ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
-"RTN","C0CCCD1",124,0)
- ;;<assignedPerson>
-"RTN","C0CCCD1",125,0)
- ;;<name>
-"RTN","C0CCCD1",126,0)
- ;;<prefix>@@ACTORNAMEPREFIX@@</prefix>
-"RTN","C0CCCD1",127,0)
- ;;<given>@@ACTORGIVENNAME@@</given>
-"RTN","C0CCCD1",128,0)
- ;;<family>@@ACTORFAMILYNAME@@</family>
-"RTN","C0CCCD1",129,0)
- ;;</name>
-"RTN","C0CCCD1",130,0)
- ;;</assignedPerson>
-"RTN","C0CCCD1",131,0)
- ;;<representedOrganization>
-"RTN","C0CCCD1",132,0)
- ;;<id root="2.16.840.1.113883.19.5"/>
-"RTN","C0CCCD1",133,0)
- ;;<name>@@ORGANIZATIONNAME@@</name>
-"RTN","C0CCCD1",134,0)
- ;;</representedOrganization>
-"RTN","C0CCCD1",135,0)
- ;;</assignedAuthor>
-"RTN","C0CCCD1",136,0)
- ;;</author>
-"RTN","C0CCCD1",137,0)
- ;;<informant>
-"RTN","C0CCCD1",138,0)
- ;;<assignedEntity>
-"RTN","C0CCCD1",139,0)
- ;;<id nullFlavor="NI"/>
-"RTN","C0CCCD1",140,0)
- ;;<representedOrganization>
-"RTN","C0CCCD1",141,0)
- ;;<id root="2.16.840.1.113883.19.5"/>
-"RTN","C0CCCD1",142,0)
- ;;<name>@@ORGANIZATIONNAME@@</name>
-"RTN","C0CCCD1",143,0)
- ;;</representedOrganization>
-"RTN","C0CCCD1",144,0)
- ;;</assignedEntity>
-"RTN","C0CCCD1",145,0)
- ;;</informant>
-"RTN","C0CCCD1",146,0)
- ;;<custodian>
-"RTN","C0CCCD1",147,0)
- ;;<assignedCustodian>
-"RTN","C0CCCD1",148,0)
- ;;<representedCustodianOrganization>
-"RTN","C0CCCD1",149,0)
- ;;<id root="2.16.840.1.113883.19.5"/>
-"RTN","C0CCCD1",150,0)
- ;;<name>@@ORGANIZATIONNAME@@</name>
-"RTN","C0CCCD1",151,0)
- ;;</representedCustodianOrganization>
-"RTN","C0CCCD1",152,0)
- ;;</assignedCustodian>
-"RTN","C0CCCD1",153,0)
- ;;</custodian>
-"RTN","C0CCCD1",154,0)
- ;;<legalAuthenticator>
-"RTN","C0CCCD1",155,0)
- ;;<time value="20000407130000+0500"/>
-"RTN","C0CCCD1",156,0)
- ;;<signatureCode code="S"/>
-"RTN","C0CCCD1",157,0)
- ;;<assignedEntity>
-"RTN","C0CCCD1",158,0)
- ;;<id nullFlavor="NI"/>
-"RTN","C0CCCD1",159,0)
- ;;<representedOrganization>
-"RTN","C0CCCD1",160,0)
- ;;<id root="2.16.840.1.113883.19.5"/>
-"RTN","C0CCCD1",161,0)
- ;;<name>@@ORGANIZATIONNAME@@</name>
-"RTN","C0CCCD1",162,0)
- ;;</representedOrganization>
-"RTN","C0CCCD1",163,0)
- ;;</assignedEntity>
-"RTN","C0CCCD1",164,0)
- ;;</legalAuthenticator>
-"RTN","C0CCCD1",165,0)
- ;;<Actors>
-"RTN","C0CCCD1",166,0)
- ;;<ACTOR-NOK>
-"RTN","C0CCCD1",167,0)
- ;;<participant typeCode="IND">
-"RTN","C0CCCD1",168,0)
- ;;<associatedEntity classCode="NOK">
-"RTN","C0CCCD1",169,0)
- ;;<id root="4ac71514-6a10-4164-9715-f8d96af48e6d"/>
-"RTN","C0CCCD1",170,0)
- ;;<code code="65656005" codeSystem="2.16.840.1.113883.6.96" displayName="Biiological mother"/>
-"RTN","C0CCCD1",171,0)
- ;;<telecom value="tel:(999)555-1212"/>
-"RTN","C0CCCD1",172,0)
- ;;<associatedPerson>
-"RTN","C0CCCD1",173,0)
- ;;<name>
-"RTN","C0CCCD1",174,0)
- ;;<given>Henrietta</given>
-"RTN","C0CCCD1",175,0)
- ;;<family>Levin</family>
-"RTN","C0CCCD1",176,0)
- ;;</name>
-"RTN","C0CCCD1",177,0)
- ;;</associatedPerson>
-"RTN","C0CCCD1",178,0)
- ;;</associatedEntity>
-"RTN","C0CCCD1",179,0)
- ;;</participant>
-"RTN","C0CCCD1",180,0)
- ;;</ACTOR-NOK>
-"RTN","C0CCCD1",181,0)
- ;;</Actors>
-"RTN","C0CCCD1",182,0)
- ;;<documentationOf>
-"RTN","C0CCCD1",183,0)
- ;;<serviceEvent classCode="PCPR">
-"RTN","C0CCCD1",184,0)
+"RTN","C0CCCD1",217,0)
+ ;;<component>
+"RTN","C0CCCD1",218,0)
+ ;;<section>
+"RTN","C0CCCD1",219,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.11'/>
+"RTN","C0CCCD1",220,0)
+ ;;<code code="11450-4" codeSystem="2.16.840.1.113883.6.1"/>
+"RTN","C0CCCD1",221,0)
+ ;;<title>Problems</title>
+"RTN","C0CCCD1",222,0)
+ ;;<entry typeCode="DRIV">
+"RTN","C0CCCD1",223,0)
+ ;;<act classCode="ACT" moodCode="EVN">
+"RTN","C0CCCD1",224,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.27'/>
+"RTN","C0CCCD1",225,0)
+ ;;<id root="6a2fa88d-4174-4909-aece-db44b60a3abb"/>
+"RTN","C0CCCD1",226,0)
+ ;;<code nullFlavor="NA"/>
+"RTN","C0CCCD1",227,0)
+ ;;<entryRelationship typeCode="SUBJ">
+"RTN","C0CCCD1",228,0)
+ ;;<observation classCode="OBS" moodCode="EVN">
+"RTN","C0CCCD1",229,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.28'/>
+"RTN","C0CCCD1",230,0)
+ ;;<id root="d11275e7-67ae-11db-bd13-0800200c9a66"/>
+"RTN","C0CCCD1",231,0)
+ ;;<code code="ASSERTION" codeSystem="2.16.840.1.113883.5.4"/>
+"RTN","C0CCCD1",232,0)
+ ;;<statusCode code="completed"/>
+"RTN","C0CCCD1",233,0)
  ;;<effectiveTime>
-"RTN","C0CCCD1",185,0)
- ;;<high value="@@DATETIME@@"/>
-"RTN","C0CCCD1",186,0)
+"RTN","C0CCCD1",234,0)
+ ;;<low value="@@PROBLEMDATEOFONSET@@"/>
+"RTN","C0CCCD1",235,0)
  ;;</effectiveTime>
-"RTN","C0CCCD1",187,0)
- ;;<performer typeCode="PRF">
-"RTN","C0CCCD1",188,0)
- ;;<functionCode code="PCP" codeSystem="2.16.840.1.113883.5.88"/>
-"RTN","C0CCCD1",189,0)
- ;;<time>
-"RTN","C0CCCD1",190,0)
- ;;<low value="1990"/>
-"RTN","C0CCCD1",191,0)
- ;;<high value='20000407'/>
-"RTN","C0CCCD1",192,0)
- ;;</time>
-"RTN","C0CCCD1",193,0)
- ;;<assignedEntity>
-"RTN","C0CCCD1",194,0)
- ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
-"RTN","C0CCCD1",195,0)
- ;;<assignedPerson>
-"RTN","C0CCCD1",196,0)
- ;;<name>
-"RTN","C0CCCD1",197,0)
- ;;<prefix>@@ACTORPREFIXNAME@@</prefix>
-"RTN","C0CCCD1",198,0)
- ;;<given>@@ACTORGIVENNAME@@</given>
-"RTN","C0CCCD1",199,0)
- ;;<family>@@ACTORFAMILYNAME@@</family>
-"RTN","C0CCCD1",200,0)
- ;;</name>
-"RTN","C0CCCD1",201,0)
- ;;</assignedPerson>
-"RTN","C0CCCD1",202,0)
- ;;<representedOrganization>
-"RTN","C0CCCD1",203,0)
- ;;<id root="2.16.840.1.113883.19.5"/>
-"RTN","C0CCCD1",204,0)
- ;;<name>@@ORGANIZATIONNAME@@</name>
-"RTN","C0CCCD1",205,0)
- ;;</representedOrganization>
-"RTN","C0CCCD1",206,0)
- ;;</assignedEntity>
-"RTN","C0CCCD1",207,0)
- ;;</performer>
-"RTN","C0CCCD1",208,0)
- ;;</serviceEvent>
-"RTN","C0CCCD1",209,0)
- ;;</documentationOf>
-"RTN","C0CCCD1",210,0)
- ;;<Body>
-"RTN","C0CCCD1",211,0)
- ;;<PROBLEMS-HTML>
-"RTN","C0CCCD1",212,0)
- ;;<text><table border="1" width="100%"><thead><tr><th>Condition</th><th>Effective Dates</th><th>Condition Status</th></tr></thead><tbody>
-"RTN","C0CCCD1",213,0)
- ;;<tr><td>@@PROBLEMDESCRIPTION@@</td>
-"RTN","C0CCCD1",214,0)
- ;;<td>@@PROBLEMDATEOFONSET@@</td>
-"RTN","C0CCCD1",215,0)
- ;;<td>Active</td></tr>
-"RTN","C0CCCD1",216,0)
- ;;</tbody></table></text>
-"RTN","C0CCCD1",217,0)
- ;;</PROBLEMS-HTML>
-"RTN","C0CCCD1",218,0)
- ;;<Problems>
-"RTN","C0CCCD1",219,0)
- ;;<component>
-"RTN","C0CCCD1",220,0)
- ;;<section>
-"RTN","C0CCCD1",221,0)
- ;;<templateId root='2.16.840.1.113883.10.20.1.11'/>
-"RTN","C0CCCD1",222,0)
- ;;<code code="11450-4" codeSystem="2.16.840.1.113883.6.1"/>
-"RTN","C0CCCD1",223,0)
- ;;<title>Problems</title>
-"RTN","C0CCCD1",224,0)
- ;;<entry typeCode="DRIV">
-"RTN","C0CCCD1",225,0)
- ;;<act classCode="ACT" moodCode="EVN">
-"RTN","C0CCCD1",226,0)
- ;;<templateId root='2.16.840.1.113883.10.20.1.27'/>
-"RTN","C0CCCD1",227,0)
- ;;<id root="6a2fa88d-4174-4909-aece-db44b60a3abb"/>
-"RTN","C0CCCD1",228,0)
- ;;<code nullFlavor="NA"/>
-"RTN","C0CCCD1",229,0)
- ;;<entryRelationship typeCode="SUBJ">
-"RTN","C0CCCD1",230,0)
+"RTN","C0CCCD1",236,0)
+ ;;<value xsi:type="CD" code="@@PROBLEMCODEVALUE@@" codeSystem="2.16.840.1.113883.6.96" displayName="@@PROBLEMDESCRIPTION@@"/>
+"RTN","C0CCCD1",237,0)
+ ;;<entryRelationship typeCode="REFR">
+"RTN","C0CCCD1",238,0)
  ;;<observation classCode="OBS" moodCode="EVN">
-"RTN","C0CCCD1",231,0)
- ;;<templateId root='2.16.840.1.113883.10.20.1.28'/>
-"RTN","C0CCCD1",232,0)
- ;;<id root="d11275e7-67ae-11db-bd13-0800200c9a66"/>
-"RTN","C0CCCD1",233,0)
- ;;<code code="ASSERTION" codeSystem="2.16.840.1.113883.5.4"/>
-"RTN","C0CCCD1",234,0)
+"RTN","C0CCCD1",239,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.50'/>
+"RTN","C0CCCD1",240,0)
+ ;;<code code="33999-4" codeSystem="2.16.840.1.113883.6.1" displayName="Status"/>
+"RTN","C0CCCD1",241,0)
  ;;<statusCode code="completed"/>
-"RTN","C0CCCD1",235,0)
- ;;<effectiveTime>
-"RTN","C0CCCD1",236,0)
- ;;<low value="@@PROBLEMDATEOFONSET@@"/>
-"RTN","C0CCCD1",237,0)
- ;;</effectiveTime>
-"RTN","C0CCCD1",238,0)
- ;;<value xsi:type="CD" code="@@PROBLEMCODEVALUE@@" codeSystem="2.16.840.1.113883.6.96" displayName="@@PROBLEMDESCRIPTION@@"/>
-"RTN","C0CCCD1",239,0)
- ;;<entryRelationship typeCode="REFR">
-"RTN","C0CCCD1",240,0)
- ;;<observation classCode="OBS" moodCode="EVN">
-"RTN","C0CCCD1",241,0)
- ;;<templateId root='2.16.840.1.113883.10.20.1.50'/>
 "RTN","C0CCCD1",242,0)
- ;;<code code="33999-4" codeSystem="2.16.840.1.113883.6.1" displayName="Status"/>
+ ;;<value xsi:type="CE" code="55561003" codeSystem="2.16.840.1.113883.6.96" displayName="Active"/>
 "RTN","C0CCCD1",243,0)
- ;;<statusCode code="completed"/>
+ ;;</observation>
 "RTN","C0CCCD1",244,0)
- ;;<value xsi:type="CE" code="55561003" codeSystem="2.16.840.1.113883.6.96" displayName="Active"/>
+ ;;</entryRelationship>
 "RTN","C0CCCD1",245,0)
  ;;</observation>
@@ -93324,4027 +93312,4021 @@
  ;;</entryRelationship>
 "RTN","C0CCCD1",247,0)
- ;;</observation>
+ ;;</act>
 "RTN","C0CCCD1",248,0)
- ;;</entryRelationship>
+ ;;</entry>
 "RTN","C0CCCD1",249,0)
- ;;</act>
+ ;;</section>
 "RTN","C0CCCD1",250,0)
- ;;</entry>
+ ;;</component>
 "RTN","C0CCCD1",251,0)
- ;;</section>
+ ;;</Problems>
 "RTN","C0CCCD1",252,0)
- ;;</component>
+ ;;<FamilyHistory>
 "RTN","C0CCCD1",253,0)
- ;;</Problems>
+ ;;</FamilyHistory>
 "RTN","C0CCCD1",254,0)
- ;;<FamilyHistory>
+ ;;<SocialHistory>
 "RTN","C0CCCD1",255,0)
- ;;</FamilyHistory>
+ ;;</SocialHistory>
 "RTN","C0CCCD1",256,0)
- ;;<SocialHistory>
+ ;;<Alerts>
 "RTN","C0CCCD1",257,0)
- ;;</SocialHistory>
+ ;;</Alerts>
 "RTN","C0CCCD1",258,0)
- ;;<Alerts>
+ ;;<Medications>
 "RTN","C0CCCD1",259,0)
- ;;</Alerts>
+ ;;</Medications>
 "RTN","C0CCCD1",260,0)
- ;;<Medications>
+ ;;<VitalSigns>
 "RTN","C0CCCD1",261,0)
- ;;</Medications>
+ ;;</VitalSigns>
 "RTN","C0CCCD1",262,0)
- ;;<VitalSigns>
+ ;;<Results>
 "RTN","C0CCCD1",263,0)
- ;;</VitalSigns>
+ ;;</Results>
 "RTN","C0CCCD1",264,0)
- ;;<Results>
+ ;;</Body>
 "RTN","C0CCCD1",265,0)
- ;;</Results>
+ ;;</ClinicalDocument>
 "RTN","C0CCCD1",266,0)
- ;;</Body>
-"RTN","C0CCCD1",267,0)
- ;;</ClinicalDocument>
-"RTN","C0CCCD1",268,0)
  ;</TEMPLATE>
 "RTN","C0CCCR")
-0^43^B111682825
+0^43^B109879694
 "RTN","C0CCCR",1,0)
 C0CCCR   ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
 "RTN","C0CCCR",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CCCR",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
 "RTN","C0CCCR",4,0)
- ;Licensed under the terms of the GNU General Public License.
+ ;
 "RTN","C0CCCR",5,0)
- ;See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CCCR",6,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CCCR",7,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CCCR",8,0)
- ;it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CCCR",9,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CCCR",10,0)
- ;(at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CCCR",11,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CCCR",12,0)
- ;This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CCCR",13,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CCCR",14,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CCCR",15,0)
- ;GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CCCR",16,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CCCR",17,0)
- ;You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CCCR",18,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ; EXPORT A CCR
 "RTN","C0CCCR",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
 "RTN","C0CCCR",20,0)
- ;
+EXPORT   ; EXPORT ENTRY POINT FOR CCR
 "RTN","C0CCCR",21,0)
- ; EXPORT A CCR
+ ; Select a patient.
 "RTN","C0CCCR",22,0)
- ;
+ S DIC=2,DIC(0)="AEMQ" D ^DIC
 "RTN","C0CCCR",23,0)
-EXPORT   ; EXPORT ENTRY POINT FOR CCR
+ I Y<1 Q  ; EXIT
 "RTN","C0CCCR",24,0)
- ; Select a patient.
+ S DFN=$P(Y,U,1) ; SET THE PATIENT
 "RTN","C0CCCR",25,0)
- S DIC=2,DIC(0)="AEMQ" D ^DIC
+ ;OHUM/RUT 3120109 commented
 "RTN","C0CCCR",26,0)
- I Y<1 Q  ; EXIT
+ ;;OHUM/RUT 3120102 To take inputs from user for date limits and notes
 "RTN","C0CCCR",27,0)
- S DFN=$P(Y,U,1) ; SET THE PATIENT
+ ;D ^C0CVALID
 "RTN","C0CCCR",28,0)
- ;OHUM/RUT 3120109 commented
+ ;;OHUM/RUT
 "RTN","C0CCCR",29,0)
- ;;OHUM/RUT 3120102 To take inputs from user for date limits and notes
+ ;OHUM/RUT
 "RTN","C0CCCR",30,0)
- ;D ^C0CVALID
+ D XPAT(DFN) ; EXPORT TO A FILE
 "RTN","C0CCCR",31,0)
+ Q
+"RTN","C0CCCR",32,0)
+ ;
+"RTN","C0CCCR",33,0)
+XPAT(DFN,XPARMS,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
+"RTN","C0CCCR",34,0)
+ ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR")
+"RTN","C0CCCR",35,0)
+ ; FN IS FILE NAME, DEFAULTS IF NULL
+"RTN","C0CCCR",36,0)
+ N CCRGLO,UDIR,UFN
+"RTN","C0CCCR",37,0)
+ S C0CNRPC=1 ; FLAG FOR NOT AN RPC CALL - FOR DEBUGGING THE RPC
+"RTN","C0CCCR",38,0)
+ I '$D(DIR) S UDIR=""
+"RTN","C0CCCR",39,0)
+ E  S UDIR=DIR
+"RTN","C0CCCR",40,0)
+ I '$D(FN) S UFN="" ; IF FILENAME IS NOT PASSED
+"RTN","C0CCCR",41,0)
+ E  S UFN=FN
+"RTN","C0CCCR",42,0)
+ I '$D(XPARMS) S XPARMS=""
+"RTN","C0CCCR",43,0)
+ N C0CRTN  ; RETURN ARRAY
+"RTN","C0CCCR",44,0)
+ D CCRRPC(.C0CRTN,DFN,XPARMS,"CCR")
+"RTN","C0CCCR",45,0)
+ S OARY=$NA(^TMP("C0CCUR",$J,DFN,"CCR",1))
+"RTN","C0CCCR",46,0)
+ S ONAM=UFN
+"RTN","C0CCCR",47,0)
+ I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_0.xml"
+"RTN","C0CCCR",48,0)
+ S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))
+"RTN","C0CCCR",49,0)
+ S ^TMP("C0CCCR","FNAME",DFN)=ONAM ; FILE NAME FOR BATCH USE
+"RTN","C0CCCR",50,0)
+ I $D(^TMP("GPLCCR","ODIR")) S @ODIRGLB=^TMP("GPLCCR","ODIR")
+"RTN","C0CCCR",51,0)
+ I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
+"RTN","C0CCCR",52,0)
+ . W "Warning.. please set ^TMP(""C0CCCR"",""ODIR"")=""output path""",! Q
+"RTN","C0CCCR",53,0)
+ . ;S @ODIRGLB="/home/glilly/CCROUT"
+"RTN","C0CCCR",54,0)
+ . ;S @ODIRGLB="/home/cedwards/"
+"RTN","C0CCCR",55,0)
+ . S @ODIRGLB="/opt/wv/p/"
+"RTN","C0CCCR",56,0)
+ S ODIR=UDIR
+"RTN","C0CCCR",57,0)
+ I UDIR="" S ODIR=@ODIRGLB
+"RTN","C0CCCR",58,0)
+ N ZY
+"RTN","C0CCCR",59,0)
+ S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR)
+"RTN","C0CCCR",60,0)
+ W !,$P(ZY,U,2),!
+"RTN","C0CCCR",61,0)
+ Q
+"RTN","C0CCCR",62,0)
+ ;
+"RTN","C0CCCR",63,0)
+DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED
+"RTN","C0CCCR",64,0)
+ ;
+"RTN","C0CCCR",65,0)
+ N G1
+"RTN","C0CCCR",66,0)
+ S G1=$NA(^TMP("C0CCUR",$J,DFN,"CCR"))
+"RTN","C0CCCR",67,0)
+ I $D(@G1@(0)) D  ; CCR EXISTS
+"RTN","C0CCCR",68,0)
+ . D PARY^C0CXPATH(G1)
+"RTN","C0CCCR",69,0)
+ E  W "CCR NOT CREATED, RUN D XPAT^C0CCCR(DFN,"""","""") FIRST",!
+"RTN","C0CCCR",70,0)
+ Q
+"RTN","C0CCCR",71,0)
+ ;
+"RTN","C0CCCR",72,0)
+CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART)  ;RPC ENTRY POINT FOR CCR OUTPUT
+"RTN","C0CCCR",73,0)
+ ; CCRGRTN IS RETURN ARRAY PASSED BY REFERENCE
+"RTN","C0CCCR",74,0)
+ ; DFN IS PATIENT IEN
+"RTN","C0CCCR",75,0)
+ ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
+"RTN","C0CCCR",76,0)
+ ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
+"RTN","C0CCCR",77,0)
+ ; CCRPARMS ARE PARAMETERS THAT AFFECT THE EXTRACTION
+"RTN","C0CCCR",78,0)
+ ; IN THE FORM "PARM1:VALUE1^PARM2:VALUE2"
+"RTN","C0CCCR",79,0)
+ ; EXAMPLE: "LABLIMIT:T-60" TO LIMIT LAB EXTRACTION TO THE LAST 60 DAYS
+"RTN","C0CCCR",80,0)
+ ; SEE C0CPARMS FOR A COMPLETE LIST OF SUPPORTED PARAMETERS
+"RTN","C0CCCR",81,0)
+ K ^TMP("C0CCCR",$J) ; CLEAN UP THE GLOBAL BEFORE WE USE IT
+"RTN","C0CCCR",82,0)
+ M ^TMP("C0CSAV",$J)=^TMP($J) ; SAVING CALLER'S TMP SETTINGS
+"RTN","C0CCCR",83,0)
+ K ^TMP($J) ; START CLEAN
+"RTN","C0CCCR",84,0)
+ I '$D(DEBUG) S DEBUG=0
+"RTN","C0CCCR",85,0)
+ S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
+"RTN","C0CCCR",86,0)
+ I '$D(CCRPARMS) S CCRPARMS=""
+"RTN","C0CCCR",87,0)
+ I '$D(CCRPART) S CCRPART="CCR"
+"RTN","C0CCCR",88,0)
+ I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"CALL",DFN)=""
+"RTN","C0CCCR",89,0)
+ D SET^C0CPARMS(CCRPARMS) ;SET PARAMETERS WITH CCRPARMS AS OVERRIDES
+"RTN","C0CCCR",90,0)
+ I '$D(TESTVIT) S TESTVIT=0 ; FLAG FOR TESTING VITALS
+"RTN","C0CCCR",91,0)
+ I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
+"RTN","C0CCCR",92,0)
+ I '$D(TESTALERT) S TESTALERT=1 ; FLAG FOR TESTING ALERTS SECTION
+"RTN","C0CCCR",93,0)
+ I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING C0CMED SECTION
+"RTN","C0CCCR",94,0)
+ S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
+"RTN","C0CCCR",95,0)
+ S CCRGLO=$NA(^TMP("C0CCUR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
+"RTN","C0CCCR",96,0)
+ S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
+"RTN","C0CCCR",97,0)
+ ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
+"RTN","C0CCCR",98,0)
+ ;M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART OR ALL
+"RTN","C0CCCR",99,0)
+ D LOAD^C0CCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+"RTN","C0CCCR",100,0)
+ D CP^C0CXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
+"RTN","C0CCCR",101,0)
+ ;
+"RTN","C0CCCR",102,0)
+ ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
+"RTN","C0CCCR",103,0)
+ ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
+"RTN","C0CCCR",104,0)
+ D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
+"RTN","C0CCCR",105,0)
+ D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
+"RTN","C0CCCR",106,0)
+ D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
+"RTN","C0CCCR",107,0)
+ D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Comments")
+"RTN","C0CCCR",108,0)
+ I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
+"RTN","C0CCCR",109,0)
+ ;
+"RTN","C0CCCR",110,0)
+ D HDRMAP(CCRGLO,DFN) ; MAP HEADER VARIABLES
+"RTN","C0CCCR",111,0)
+ ;
+"RTN","C0CCCR",112,0)
+ K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
+"RTN","C0CCCR",113,0)
+ S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
+"RTN","C0CCCR",114,0)
+ D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
+"RTN","C0CCCR",115,0)
+ N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
+"RTN","C0CCCR",116,0)
+ F PROCI=1:1:@CCRXTAB@(0) D  ; PROCESS THE CCR BODY SECTIONS
+"RTN","C0CCCR",117,0)
+ . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
+"RTN","C0CCCR",118,0)
+ . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
+"RTN","C0CCCR",119,0)
+ . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
+"RTN","C0CCCR",120,0)
+ . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
+"RTN","C0CCCR",121,0)
+ . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
+"RTN","C0CCCR",122,0)
+ . S IXML="INXML"
+"RTN","C0CCCR",123,0)
+ . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
+"RTN","C0CCCR",124,0)
+ . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
+"RTN","C0CCCR",125,0)
+ . ; W OXML,!
+"RTN","C0CCCR",126,0)
+ . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
+"RTN","C0CCCR",127,0)
+ . W "RUNNING ",CALL,!
+"RTN","C0CCCR",128,0)
+ . X CALL
+"RTN","C0CCCR",129,0)
+ . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
+"RTN","C0CCCR",130,0)
+ . I $G(@OXML@(0))>0 D  ; THERE IS A RESULT
+"RTN","C0CCCR",131,0)
+ . . D INSERT^C0CXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
+"RTN","C0CCCR",132,0)
+ . . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
+"RTN","C0CCCR",133,0)
+ N ACTT,ATMP,ACTT2,ATMP2 ; TEMPORARY ARRAY SYMBOLS FOR ACTOR PROCESSING
+"RTN","C0CCCR",134,0)
+ D ACTLST^C0CCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
+"RTN","C0CCCR",135,0)
+ D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
+"RTN","C0CCCR",136,0)
+ D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
+"RTN","C0CCCR",137,0)
+ D INSINNER^C0CXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
+"RTN","C0CCCR",138,0)
+ K ACTT,ACTT2
+"RTN","C0CCCR",139,0)
+ ;D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Comments","CMTT")
+"RTN","C0CCCR",140,0)
+ ;D EXTRACT^C0CCMT("CMTT",DFN,"CMTT2")
+"RTN","C0CCCR",141,0)
+ ;D INSINNER^C0CXPATH(CCRGLO,"CMTT2","//ContinuityOfCareRecord/Comments")
+"RTN","C0CCCR",142,0)
+ ; gpl - turned off Comments for Certification
+"RTN","C0CCCR",143,0)
+ K CMTT,CMTT2
+"RTN","C0CCCR",144,0)
+ N TRIMI,J,DONE S DONE=0
+"RTN","C0CCCR",145,0)
+ F TRIMI=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
+"RTN","C0CCCR",146,0)
+ . S J=$$TRIM^C0CXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
+"RTN","C0CCCR",147,0)
+ . I DEBUG W "TRIMMED",J,!
+"RTN","C0CCCR",148,0)
+ . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
+"RTN","C0CCCR",149,0)
+ ;S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLOBAL OF PART OR ALL
+"RTN","C0CCCR",150,0)
+ I CCRPART="CCR" M CCRGRTN=@CCRGLO ; ENTIRE CCR
+"RTN","C0CCCR",151,0)
+ E  M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART
+"RTN","C0CCCR",152,0)
+ I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"RESULT",CCRGRTN(0))=""
+"RTN","C0CCCR",153,0)
+ K ^TMP("C0CCCR",$J) ; BEGIN TO CLEAN UP
+"RTN","C0CCCR",154,0)
+ K ^TMP($J) ; REALLY CLEAN UP
+"RTN","C0CCCR",155,0)
+ M ^TMP($J)=^TMP("C0CSAV",$J) ; RESTORE CALLER'S $J
+"RTN","C0CCCR",156,0)
+ Q
+"RTN","C0CCCR",157,0)
+ ;
+"RTN","C0CCCR",158,0)
+INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
+"RTN","C0CCCR",159,0)
+ ; TAB IS PASSED BY NAME
+"RTN","C0CCCR",160,0)
+ I DEBUG W "TAB= ",TAB,!
+"RTN","C0CCCR",161,0)
+ ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
+"RTN","C0CCCR",162,0)
+ D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")")
+"RTN","C0CCCR",163,0)
+ I TESTALERT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""C0CCCR"",$J,DFN,""ALERTS"")")
+"RTN","C0CCCR",164,0)
+ D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
+"RTN","C0CCCR",165,0)
+ D PUSH^C0CXPATH(TAB,"MAP;C0CIMMU;//ContinuityOfCareRecord/Body/Immunizations;^TMP(""C0CCCR"",$J,DFN,""IMMUNE"")")
+"RTN","C0CCCR",166,0)
+ I TESTVIT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVIT2;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
+"RTN","C0CCCR",167,0)
+ E  D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
+"RTN","C0CCCR",168,0)
+ D PUSH^C0CXPATH(TAB,"MAP;C0CLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""C0CCCR"",$J,DFN,""RESULTS"")")
+"RTN","C0CCCR",169,0)
+ D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROC;//ContinuityOfCareRecord/Body/Procedures;^TMP(""C0CCCR"",$J,DFN,""PROCEDURES"")")
+"RTN","C0CCCR",170,0)
+ ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")")
+"RTN","C0CCCR",171,0)
+ ; gpl - turned off Encounters for Certification
+"RTN","C0CCCR",172,0)
+ ;OHUM/RUT 3120109 Changed the condition
+"RTN","C0CCCR",173,0)
+ ;;OHUM/RUT 3111228 Condition for Notes ; It should be included or not
+"RTN","C0CCCR",174,0)
+ ;;I ^TMP("C0CCCR","TIULIMIT")'="" D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")")
+"RTN","C0CCCR",175,0)
+ I $P(^C0CPARM(1,2),"^",3)=1 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")")
+"RTN","C0CCCR",176,0)
  ;;OHUM/RUT
-"RTN","C0CCCR",32,0)
+"RTN","C0CCCR",177,0)
  ;OHUM/RUT
-"RTN","C0CCCR",33,0)
- D XPAT(DFN) ; EXPORT TO A FILE
-"RTN","C0CCCR",34,0)
+"RTN","C0CCCR",178,0)
  Q
-"RTN","C0CCCR",35,0)
- ;
-"RTN","C0CCCR",36,0)
-XPAT(DFN,XPARMS,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
-"RTN","C0CCCR",37,0)
- ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR")
-"RTN","C0CCCR",38,0)
- ; FN IS FILE NAME, DEFAULTS IF NULL
-"RTN","C0CCCR",39,0)
- N CCRGLO,UDIR,UFN
-"RTN","C0CCCR",40,0)
- S C0CNRPC=1 ; FLAG FOR NOT AN RPC CALL - FOR DEBUGGING THE RPC
-"RTN","C0CCCR",41,0)
- I '$D(DIR) S UDIR=""
-"RTN","C0CCCR",42,0)
- E  S UDIR=DIR
-"RTN","C0CCCR",43,0)
- I '$D(FN) S UFN="" ; IF FILENAME IS NOT PASSED
-"RTN","C0CCCR",44,0)
- E  S UFN=FN
-"RTN","C0CCCR",45,0)
- I '$D(XPARMS) S XPARMS=""
-"RTN","C0CCCR",46,0)
- N C0CRTN  ; RETURN ARRAY
-"RTN","C0CCCR",47,0)
- D CCRRPC(.C0CRTN,DFN,XPARMS,"CCR")
-"RTN","C0CCCR",48,0)
- S OARY=$NA(^TMP("C0CCUR",$J,DFN,"CCR",1))
-"RTN","C0CCCR",49,0)
- S ONAM=UFN
-"RTN","C0CCCR",50,0)
- I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_0.xml"
-"RTN","C0CCCR",51,0)
- S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))
-"RTN","C0CCCR",52,0)
- S ^TMP("C0CCCR","FNAME",DFN)=ONAM ; FILE NAME FOR BATCH USE
-"RTN","C0CCCR",53,0)
- I $D(^TMP("GPLCCR","ODIR")) S @ODIRGLB=^TMP("GPLCCR","ODIR")
-"RTN","C0CCCR",54,0)
- I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
-"RTN","C0CCCR",55,0)
- . W "Warning.. please set ^TMP(""C0CCCR"",""ODIR"")=""output path""",! Q
-"RTN","C0CCCR",56,0)
- . ;S @ODIRGLB="/home/glilly/CCROUT"
-"RTN","C0CCCR",57,0)
- . ;S @ODIRGLB="/home/cedwards/"
-"RTN","C0CCCR",58,0)
- . S @ODIRGLB="/opt/wv/p/"
-"RTN","C0CCCR",59,0)
- S ODIR=UDIR
-"RTN","C0CCCR",60,0)
- I UDIR="" S ODIR=@ODIRGLB
-"RTN","C0CCCR",61,0)
- N ZY
-"RTN","C0CCCR",62,0)
- S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR)
-"RTN","C0CCCR",63,0)
- W !,$P(ZY,U,2),!
-"RTN","C0CCCR",64,0)
+"RTN","C0CCCR",179,0)
+ ;
+"RTN","C0CCCR",180,0)
+HDRMAP(CXML,DFN) ; MAP HEADER VARIABLES: FROM, TO ECT
+"RTN","C0CCCR",181,0)
+ N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
+"RTN","C0CCCR",182,0)
+ ; K @VMAP
+"RTN","C0CCCR",183,0)
+ S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
+"RTN","C0CCCR",184,0)
+ ; I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
+"RTN","C0CCCR",185,0)
+ D  ; ALWAYS MAP THESE VARIABLES
+"RTN","C0CCCR",186,0)
+ . S @VMAP@("CCRDOCOBJECTID")=$$UUID^C0CUTIL ; UUID FOR THIS CCR
+"RTN","C0CCCR",187,0)
+ . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
+"RTN","C0CCCR",188,0)
+ . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - FROM PROVIDER
+"RTN","C0CCCR",189,0)
+ . ;S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
+"RTN","C0CCCR",190,0)
+ . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
+"RTN","C0CCCR",191,0)
+ . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES
+"RTN","C0CCCR",192,0)
+ . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
+"RTN","C0CCCR",193,0)
+ . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
+"RTN","C0CCCR",194,0)
+ . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
+"RTN","C0CCCR",195,0)
+ ;I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
+"RTN","C0CCCR",196,0)
+ ;. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
+"RTN","C0CCCR",197,0)
+ N CTMP
+"RTN","C0CCCR",198,0)
+ D MAP^C0CXPATH(CXML,VMAP,"CTMP")
+"RTN","C0CCCR",199,0)
+ D CP^C0CXPATH("CTMP",CXML)
+"RTN","C0CCCR",200,0)
+ N HRIMVARS ;
+"RTN","C0CCCR",201,0)
+ S HRIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"HEADER")) ; TO PERSIST VARS
+"RTN","C0CCCR",202,0)
+ M @HRIMVARS@(1)=@VMAP ; PERSIST THE HEADER VARIABLES IN RIM TABLE
+"RTN","C0CCCR",203,0)
+ S @HRIMVARS@(0)=1 ; ONLY ONE SET OF HEADERS PER PATIENT
+"RTN","C0CCCR",204,0)
  Q
-"RTN","C0CCCR",65,0)
- ;
-"RTN","C0CCCR",66,0)
-DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED
-"RTN","C0CCCR",67,0)
- ;
-"RTN","C0CCCR",68,0)
- N G1
-"RTN","C0CCCR",69,0)
- S G1=$NA(^TMP("C0CCUR",$J,DFN,"CCR"))
-"RTN","C0CCCR",70,0)
- I $D(@G1@(0)) D  ; CCR EXISTS
-"RTN","C0CCCR",71,0)
- . D PARY^C0CXPATH(G1)
-"RTN","C0CCCR",72,0)
- E  W "CCR NOT CREATED, RUN D XPAT^C0CCCR(DFN,"""","""") FIRST",!
-"RTN","C0CCCR",73,0)
+"RTN","C0CCCR",205,0)
+ ;
+"RTN","C0CCCR",206,0)
+ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
+"RTN","C0CCCR",207,0)
+ ; AXML AND ACTRTN ARE PASSED BY NAME
+"RTN","C0CCCR",208,0)
+ ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
+"RTN","C0CCCR",209,0)
+ ; P1= OBJECTID - ACTORPATIENT_2
+"RTN","C0CCCR",210,0)
+ ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
+"RTN","C0CCCR",211,0)
+ ;OR INSTITUTION
+"RTN","C0CCCR",212,0)
+ ;  OR PERSON(IN PATIENT FILE IE NOK)
+"RTN","C0CCCR",213,0)
+ ; P3= IEN RECORD NUMBER FOR ACTOR - 2
+"RTN","C0CCCR",214,0)
+ N I,J,K,L
+"RTN","C0CCCR",215,0)
+ K @ACTRTN ; CLEAR RETURN ARRAY
+"RTN","C0CCCR",216,0)
+ F I=1:1:@AXML@(0) D  ; FIRST FIX MISSING LINKS
+"RTN","C0CCCR",217,0)
+ . I @AXML@(I)?.E1"_<".E D  ;
+"RTN","C0CCCR",218,0)
+ . . N ZA,ZB
+"RTN","C0CCCR",219,0)
+ . . S ZA=$P(@AXML@(I),">",1)_">"
+"RTN","C0CCCR",220,0)
+ . . S ZB="<"_$P(@AXML@(I),"<",3)
+"RTN","C0CCCR",221,0)
+ . . S @AXML@(I)=ZA_"ACTORORGANIZATION_1"_ZB
+"RTN","C0CCCR",222,0)
+ F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
+"RTN","C0CCCR",223,0)
+ . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
+"RTN","C0CCCR",224,0)
+ . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
+"RTN","C0CCCR",225,0)
+ . . I $G(LINKDEBUG) W "<ActorID>=>",J,!
+"RTN","C0CCCR",226,0)
+ . . I J'="" S K(J)="" ; HASHING ACTOR
+"RTN","C0CCCR",227,0)
+ . I @AXML@(I)?.E1"<LinkID>".E D  ; THERE IS AN ACTOR THIS LINE
+"RTN","C0CCCR",228,0)
+ . . S J=$P($P(@AXML@(I),"<LinkID>",2),"</LinkID>",1)
+"RTN","C0CCCR",229,0)
+ . . I $G(LINKDEBUG) W "<LinkID>=>",J,!
+"RTN","C0CCCR",230,0)
+ . . I J'="" S K(J)="" ; HASHING ACTOR
+"RTN","C0CCCR",231,0)
+ . . ;  TO GET RID OF DUPLICATES
+"RTN","C0CCCR",232,0)
+ S I="" ; GOING TO $O THROUGH THE HASH
+"RTN","C0CCCR",233,0)
+ F J=0:0 D  Q:$O(K(I))=""
+"RTN","C0CCCR",234,0)
+ . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
+"RTN","C0CCCR",235,0)
+ . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
+"RTN","C0CCCR",236,0)
+ . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
+"RTN","C0CCCR",237,0)
+ . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
+"RTN","C0CCCR",238,0)
+ . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
+"RTN","C0CCCR",239,0)
  Q
-"RTN","C0CCCR",74,0)
- ;
-"RTN","C0CCCR",75,0)
-CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART)  ;RPC ENTRY POINT FOR CCR OUTPUT
-"RTN","C0CCCR",76,0)
- ; CCRGRTN IS RETURN ARRAY PASSED BY REFERENCE
-"RTN","C0CCCR",77,0)
- ; DFN IS PATIENT IEN
-"RTN","C0CCCR",78,0)
- ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
-"RTN","C0CCCR",79,0)
- ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
-"RTN","C0CCCR",80,0)
- ; CCRPARMS ARE PARAMETERS THAT AFFECT THE EXTRACTION
-"RTN","C0CCCR",81,0)
- ; IN THE FORM "PARM1:VALUE1^PARM2:VALUE2"
-"RTN","C0CCCR",82,0)
- ; EXAMPLE: "LABLIMIT:T-60" TO LIMIT LAB EXTRACTION TO THE LAST 60 DAYS
-"RTN","C0CCCR",83,0)
- ; SEE C0CPARMS FOR A COMPLETE LIST OF SUPPORTED PARAMETERS
-"RTN","C0CCCR",84,0)
- K ^TMP("C0CCCR",$J) ; CLEAN UP THE GLOBAL BEFORE WE USE IT
-"RTN","C0CCCR",85,0)
- M ^TMP("C0CSAV",$J)=^TMP($J) ; SAVING CALLER'S TMP SETTINGS
-"RTN","C0CCCR",86,0)
- K ^TMP($J) ; START CLEAN
-"RTN","C0CCCR",87,0)
- I '$D(DEBUG) S DEBUG=0
-"RTN","C0CCCR",88,0)
- S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
-"RTN","C0CCCR",89,0)
- I '$D(CCRPARMS) S CCRPARMS=""
-"RTN","C0CCCR",90,0)
- I '$D(CCRPART) S CCRPART="CCR"
-"RTN","C0CCCR",91,0)
- I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"CALL",DFN)=""
-"RTN","C0CCCR",92,0)
- D SET^C0CPARMS(CCRPARMS) ;SET PARAMETERS WITH CCRPARMS AS OVERRIDES
-"RTN","C0CCCR",93,0)
- I '$D(TESTVIT) S TESTVIT=0 ; FLAG FOR TESTING VITALS
-"RTN","C0CCCR",94,0)
- I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
-"RTN","C0CCCR",95,0)
- I '$D(TESTALERT) S TESTALERT=1 ; FLAG FOR TESTING ALERTS SECTION
-"RTN","C0CCCR",96,0)
- I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING C0CMED SECTION
-"RTN","C0CCCR",97,0)
- S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
-"RTN","C0CCCR",98,0)
- S CCRGLO=$NA(^TMP("C0CCUR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
-"RTN","C0CCCR",99,0)
- S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
-"RTN","C0CCCR",100,0)
- ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
-"RTN","C0CCCR",101,0)
- ;M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART OR ALL
-"RTN","C0CCCR",102,0)
- D LOAD^C0CCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
-"RTN","C0CCCR",103,0)
- D CP^C0CXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
-"RTN","C0CCCR",104,0)
- ;
-"RTN","C0CCCR",105,0)
- ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
-"RTN","C0CCCR",106,0)
- ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
-"RTN","C0CCCR",107,0)
- D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
-"RTN","C0CCCR",108,0)
- D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
-"RTN","C0CCCR",109,0)
- D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
-"RTN","C0CCCR",110,0)
- D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Comments")
-"RTN","C0CCCR",111,0)
- I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
-"RTN","C0CCCR",112,0)
- ;
-"RTN","C0CCCR",113,0)
- D HDRMAP(CCRGLO,DFN) ; MAP HEADER VARIABLES
-"RTN","C0CCCR",114,0)
- ;
-"RTN","C0CCCR",115,0)
- K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
-"RTN","C0CCCR",116,0)
- S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
-"RTN","C0CCCR",117,0)
- D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
-"RTN","C0CCCR",118,0)
- N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
-"RTN","C0CCCR",119,0)
- F PROCI=1:1:@CCRXTAB@(0) D  ; PROCESS THE CCR BODY SECTIONS
-"RTN","C0CCCR",120,0)
- . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
-"RTN","C0CCCR",121,0)
- . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
-"RTN","C0CCCR",122,0)
- . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
-"RTN","C0CCCR",123,0)
- . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
-"RTN","C0CCCR",124,0)
- . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
-"RTN","C0CCCR",125,0)
- . S IXML="INXML"
-"RTN","C0CCCR",126,0)
- . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
-"RTN","C0CCCR",127,0)
- . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
-"RTN","C0CCCR",128,0)
- . ; W OXML,!
-"RTN","C0CCCR",129,0)
- . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
-"RTN","C0CCCR",130,0)
- . W "RUNNING ",CALL,!
-"RTN","C0CCCR",131,0)
- . X CALL
-"RTN","C0CCCR",132,0)
- . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
-"RTN","C0CCCR",133,0)
- . I $G(@OXML@(0))>0 D  ; THERE IS A RESULT
-"RTN","C0CCCR",134,0)
- . . D INSERT^C0CXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
-"RTN","C0CCCR",135,0)
- . . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
-"RTN","C0CCCR",136,0)
- N ACTT,ATMP,ACTT2,ATMP2 ; TEMPORARY ARRAY SYMBOLS FOR ACTOR PROCESSING
-"RTN","C0CCCR",137,0)
- D ACTLST^C0CCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
-"RTN","C0CCCR",138,0)
- D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
-"RTN","C0CCCR",139,0)
- D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
-"RTN","C0CCCR",140,0)
- D INSINNER^C0CXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
-"RTN","C0CCCR",141,0)
- K ACTT,ACTT2
-"RTN","C0CCCR",142,0)
- ;D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Comments","CMTT")
-"RTN","C0CCCR",143,0)
- ;D EXTRACT^C0CCMT("CMTT",DFN,"CMTT2")
-"RTN","C0CCCR",144,0)
- ;D INSINNER^C0CXPATH(CCRGLO,"CMTT2","//ContinuityOfCareRecord/Comments")
-"RTN","C0CCCR",145,0)
- ; gpl - turned off Comments for Certification
-"RTN","C0CCCR",146,0)
- K CMTT,CMTT2
-"RTN","C0CCCR",147,0)
- N TRIMI,J,DONE S DONE=0
-"RTN","C0CCCR",148,0)
- F TRIMI=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
-"RTN","C0CCCR",149,0)
- . S J=$$TRIM^C0CXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
-"RTN","C0CCCR",150,0)
- . I DEBUG W "TRIMMED",J,!
-"RTN","C0CCCR",151,0)
- . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
-"RTN","C0CCCR",152,0)
- ;S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLOBAL OF PART OR ALL
-"RTN","C0CCCR",153,0)
- I CCRPART="CCR" M CCRGRTN=@CCRGLO ; ENTIRE CCR
-"RTN","C0CCCR",154,0)
- E  M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART
-"RTN","C0CCCR",155,0)
- I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"RESULT",CCRGRTN(0))=""
-"RTN","C0CCCR",156,0)
- K ^TMP("C0CCCR",$J) ; BEGIN TO CLEAN UP
-"RTN","C0CCCR",157,0)
- K ^TMP($J) ; REALLY CLEAN UP
-"RTN","C0CCCR",158,0)
- M ^TMP($J)=^TMP("C0CSAV",$J) ; RESTORE CALLER'S $J
-"RTN","C0CCCR",159,0)
+"RTN","C0CCCR",240,0)
+ ;
+"RTN","C0CCCR",241,0)
+TEST ; RUN ALL THE TEST CASES
+"RTN","C0CCCR",242,0)
+ D TESTALL^C0CUNIT("C0CCCR")
+"RTN","C0CCCR",243,0)
  Q
-"RTN","C0CCCR",160,0)
- ;
-"RTN","C0CCCR",161,0)
-INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
-"RTN","C0CCCR",162,0)
- ; TAB IS PASSED BY NAME
-"RTN","C0CCCR",163,0)
- I DEBUG W "TAB= ",TAB,!
-"RTN","C0CCCR",164,0)
- ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
-"RTN","C0CCCR",165,0)
- D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")")
-"RTN","C0CCCR",166,0)
- I TESTALERT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""C0CCCR"",$J,DFN,""ALERTS"")")
-"RTN","C0CCCR",167,0)
- D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
-"RTN","C0CCCR",168,0)
- D PUSH^C0CXPATH(TAB,"MAP;C0CIMMU;//ContinuityOfCareRecord/Body/Immunizations;^TMP(""C0CCCR"",$J,DFN,""IMMUNE"")")
-"RTN","C0CCCR",169,0)
- I TESTVIT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVIT2;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
-"RTN","C0CCCR",170,0)
- E  D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
-"RTN","C0CCCR",171,0)
- D PUSH^C0CXPATH(TAB,"MAP;C0CLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""C0CCCR"",$J,DFN,""RESULTS"")")
-"RTN","C0CCCR",172,0)
- D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROC;//ContinuityOfCareRecord/Body/Procedures;^TMP(""C0CCCR"",$J,DFN,""PROCEDURES"")")
-"RTN","C0CCCR",173,0)
- ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")")
-"RTN","C0CCCR",174,0)
- ; gpl - turned off Encounters for Certification
-"RTN","C0CCCR",175,0)
- ;OHUM/RUT 3120109 Changed the condition
-"RTN","C0CCCR",176,0)
- ;;OHUM/RUT 3111228 Condition for Notes ; It should be included or not
-"RTN","C0CCCR",177,0)
- ;;I ^TMP("C0CCCR","TIULIMIT")'="" D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")")
-"RTN","C0CCCR",178,0)
- I $P(^C0CPARM(1,2),"^",3)=1 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")")
-"RTN","C0CCCR",179,0)
- ;;OHUM/RUT
-"RTN","C0CCCR",180,0)
- ;OHUM/RUT
-"RTN","C0CCCR",181,0)
+"RTN","C0CCCR",244,0)
+ ;
+"RTN","C0CCCR",245,0)
+ZTEST(WHICH)  ; RUN ONE SET OF TESTS
+"RTN","C0CCCR",246,0)
+ N ZTMP
+"RTN","C0CCCR",247,0)
+ D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
+"RTN","C0CCCR",248,0)
+ D ZTEST^C0CUNIT(.ZTMP,WHICH)
+"RTN","C0CCCR",249,0)
  Q
-"RTN","C0CCCR",182,0)
- ;
-"RTN","C0CCCR",183,0)
-HDRMAP(CXML,DFN) ; MAP HEADER VARIABLES: FROM, TO ECT
-"RTN","C0CCCR",184,0)
- N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
-"RTN","C0CCCR",185,0)
- ; K @VMAP
-"RTN","C0CCCR",186,0)
- S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
-"RTN","C0CCCR",187,0)
- ; I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
-"RTN","C0CCCR",188,0)
- D  ; ALWAYS MAP THESE VARIABLES
-"RTN","C0CCCR",189,0)
- . S @VMAP@("CCRDOCOBJECTID")=$$UUID^C0CUTIL ; UUID FOR THIS CCR
-"RTN","C0CCCR",190,0)
- . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
-"RTN","C0CCCR",191,0)
- . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - FROM PROVIDER
-"RTN","C0CCCR",192,0)
- . ;S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
-"RTN","C0CCCR",193,0)
- . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
-"RTN","C0CCCR",194,0)
- . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES
-"RTN","C0CCCR",195,0)
- . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
-"RTN","C0CCCR",196,0)
- . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
-"RTN","C0CCCR",197,0)
- . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
-"RTN","C0CCCR",198,0)
- ;I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
-"RTN","C0CCCR",199,0)
- ;. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
-"RTN","C0CCCR",200,0)
- N CTMP
-"RTN","C0CCCR",201,0)
- D MAP^C0CXPATH(CXML,VMAP,"CTMP")
-"RTN","C0CCCR",202,0)
- D CP^C0CXPATH("CTMP",CXML)
-"RTN","C0CCCR",203,0)
- N HRIMVARS ;
-"RTN","C0CCCR",204,0)
- S HRIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"HEADER")) ; TO PERSIST VARS
-"RTN","C0CCCR",205,0)
- M @HRIMVARS@(1)=@VMAP ; PERSIST THE HEADER VARIABLES IN RIM TABLE
-"RTN","C0CCCR",206,0)
- S @HRIMVARS@(0)=1 ; ONLY ONE SET OF HEADERS PER PATIENT
-"RTN","C0CCCR",207,0)
+"RTN","C0CCCR",250,0)
+ ;
+"RTN","C0CCCR",251,0)
+TLIST  ; LIST THE TESTS
+"RTN","C0CCCR",252,0)
+ N ZTMP
+"RTN","C0CCCR",253,0)
+ D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
+"RTN","C0CCCR",254,0)
+ D TLIST^C0CUNIT(.ZTMP)
+"RTN","C0CCCR",255,0)
  Q
-"RTN","C0CCCR",208,0)
- ;
-"RTN","C0CCCR",209,0)
-ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
-"RTN","C0CCCR",210,0)
- ; AXML AND ACTRTN ARE PASSED BY NAME
-"RTN","C0CCCR",211,0)
- ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
-"RTN","C0CCCR",212,0)
- ; P1= OBJECTID - ACTORPATIENT_2
-"RTN","C0CCCR",213,0)
- ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
-"RTN","C0CCCR",214,0)
- ;OR INSTITUTION
-"RTN","C0CCCR",215,0)
- ;  OR PERSON(IN PATIENT FILE IE NOK)
-"RTN","C0CCCR",216,0)
- ; P3= IEN RECORD NUMBER FOR ACTOR - 2
-"RTN","C0CCCR",217,0)
- N I,J,K,L
-"RTN","C0CCCR",218,0)
- K @ACTRTN ; CLEAR RETURN ARRAY
-"RTN","C0CCCR",219,0)
- F I=1:1:@AXML@(0) D  ; FIRST FIX MISSING LINKS
-"RTN","C0CCCR",220,0)
- . I @AXML@(I)?.E1"_<".E D  ;
-"RTN","C0CCCR",221,0)
- . . N ZA,ZB
-"RTN","C0CCCR",222,0)
- . . S ZA=$P(@AXML@(I),">",1)_">"
-"RTN","C0CCCR",223,0)
- . . S ZB="<"_$P(@AXML@(I),"<",3)
-"RTN","C0CCCR",224,0)
- . . S @AXML@(I)=ZA_"ACTORORGANIZATION_1"_ZB
-"RTN","C0CCCR",225,0)
- F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
-"RTN","C0CCCR",226,0)
- . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
-"RTN","C0CCCR",227,0)
- . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
-"RTN","C0CCCR",228,0)
- . . I $G(LINKDEBUG) W "<ActorID>=>",J,!
-"RTN","C0CCCR",229,0)
- . . I J'="" S K(J)="" ; HASHING ACTOR
-"RTN","C0CCCR",230,0)
- . I @AXML@(I)?.E1"<LinkID>".E D  ; THERE IS AN ACTOR THIS LINE
-"RTN","C0CCCR",231,0)
- . . S J=$P($P(@AXML@(I),"<LinkID>",2),"</LinkID>",1)
-"RTN","C0CCCR",232,0)
- . . I $G(LINKDEBUG) W "<LinkID>=>",J,!
-"RTN","C0CCCR",233,0)
- . . I J'="" S K(J)="" ; HASHING ACTOR
-"RTN","C0CCCR",234,0)
- . . ;  TO GET RID OF DUPLICATES
-"RTN","C0CCCR",235,0)
- S I="" ; GOING TO $O THROUGH THE HASH
-"RTN","C0CCCR",236,0)
- F J=0:0 D  Q:$O(K(I))=""
-"RTN","C0CCCR",237,0)
- . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
-"RTN","C0CCCR",238,0)
- . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
-"RTN","C0CCCR",239,0)
- . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
-"RTN","C0CCCR",240,0)
- . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
-"RTN","C0CCCR",241,0)
- . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
-"RTN","C0CCCR",242,0)
- Q
-"RTN","C0CCCR",243,0)
- ;
-"RTN","C0CCCR",244,0)
-TEST ; RUN ALL THE TEST CASES
-"RTN","C0CCCR",245,0)
- D TESTALL^C0CUNIT("C0CCCR")
-"RTN","C0CCCR",246,0)
- Q
-"RTN","C0CCCR",247,0)
- ;
-"RTN","C0CCCR",248,0)
-ZTEST(WHICH)  ; RUN ONE SET OF TESTS
-"RTN","C0CCCR",249,0)
- N ZTMP
-"RTN","C0CCCR",250,0)
- D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
-"RTN","C0CCCR",251,0)
- D ZTEST^C0CUNIT(.ZTMP,WHICH)
-"RTN","C0CCCR",252,0)
- Q
-"RTN","C0CCCR",253,0)
- ;
-"RTN","C0CCCR",254,0)
-TLIST  ; LIST THE TESTS
-"RTN","C0CCCR",255,0)
- N ZTMP
 "RTN","C0CCCR",256,0)
- D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
+ ;
 "RTN","C0CCCR",257,0)
- D TLIST^C0CUNIT(.ZTMP)
+ ;;><TEST>
 "RTN","C0CCCR",258,0)
- Q
+ ;;><PROBLEMS>
 "RTN","C0CCCR",259,0)
- ;
+ ;;>>>K C0C S C0C=""
 "RTN","C0CCCR",260,0)
- ;;><TEST>
+ ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","")
 "RTN","C0CCCR",261,0)
- ;;><PROBLEMS>
+ ;;>>?@C0C@(@C0C@(0))["</Problems>"
 "RTN","C0CCCR",262,0)
+ ;;><VITALS>
+"RTN","C0CCCR",263,0)
  ;;>>>K C0C S C0C=""
-"RTN","C0CCCR",263,0)
- ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","")
 "RTN","C0CCCR",264,0)
- ;;>>?@C0C@(@C0C@(0))["</Problems>"
+ ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","")
 "RTN","C0CCCR",265,0)
- ;;><VITALS>
+ ;;>>?@C0C@(@C0C@(0))["</VitalSigns>"
 "RTN","C0CCCR",266,0)
+ ;;><CCR>
+"RTN","C0CCCR",267,0)
  ;;>>>K C0C S C0C=""
-"RTN","C0CCCR",267,0)
- ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","")
 "RTN","C0CCCR",268,0)
- ;;>>?@C0C@(@C0C@(0))["</VitalSigns>"
+ ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
 "RTN","C0CCCR",269,0)
- ;;><CCR>
+ ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
 "RTN","C0CCCR",270,0)
+ ;;><ACTLST>
+"RTN","C0CCCR",271,0)
  ;;>>>K C0C S C0C=""
-"RTN","C0CCCR",271,0)
+"RTN","C0CCCR",272,0)
  ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
-"RTN","C0CCCR",272,0)
- ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
 "RTN","C0CCCR",273,0)
- ;;><ACTLST>
+ ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST")
 "RTN","C0CCCR",274,0)
+ ;;><ACTORS>
+"RTN","C0CCCR",275,0)
+ ;;>>>D ZTEST^C0CCCR("ACTLST")
+"RTN","C0CCCR",276,0)
+ ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
+"RTN","C0CCCR",277,0)
+ ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3")
+"RTN","C0CCCR",278,0)
+ ;;>>?G3(G3(0))["</Actors>"
+"RTN","C0CCCR",279,0)
+ ;;><TRIM>
+"RTN","C0CCCR",280,0)
+ ;;>>>D ZTEST^C0CCCR("CCR")
+"RTN","C0CCCR",281,0)
+ ;;>>>W $$TRIM^C0CXPATH(CCRGLO)
+"RTN","C0CCCR",282,0)
+ ;;><ALERTS>
+"RTN","C0CCCR",283,0)
+ ;;>>>S TESTALERT=1
+"RTN","C0CCCR",284,0)
  ;;>>>K C0C S C0C=""
-"RTN","C0CCCR",275,0)
- ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
-"RTN","C0CCCR",276,0)
- ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST")
-"RTN","C0CCCR",277,0)
- ;;><ACTORS>
-"RTN","C0CCCR",278,0)
- ;;>>>D ZTEST^C0CCCR("ACTLST")
-"RTN","C0CCCR",279,0)
- ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
-"RTN","C0CCCR",280,0)
- ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3")
-"RTN","C0CCCR",281,0)
- ;;>>?G3(G3(0))["</Actors>"
-"RTN","C0CCCR",282,0)
- ;;><TRIM>
-"RTN","C0CCCR",283,0)
- ;;>>>D ZTEST^C0CCCR("CCR")
-"RTN","C0CCCR",284,0)
- ;;>>>W $$TRIM^C0CXPATH(CCRGLO)
 "RTN","C0CCCR",285,0)
- ;;><ALERTS>
+ ;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","")
 "RTN","C0CCCR",286,0)
- ;;>>>S TESTALERT=1
-"RTN","C0CCCR",287,0)
- ;;>>>K C0C S C0C=""
-"RTN","C0CCCR",288,0)
- ;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","")
-"RTN","C0CCCR",289,0)
  ;;>>?@C0C@(@C0C@(0))["</Alerts>"
-"RTN","C0CCCR",290,0)
- 
-"RTN","C0CCCR",291,0)
- 
 "RTN","C0CCCR0")
-0^42^B790419172
+0^42^B785598655
 "RTN","C0CCCR0",1,0)
 C0CCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
 "RTN","C0CCCR0",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CCCR0",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
 "RTN","C0CCCR0",4,0)
- ;Licensed under the terms of the GNU General Public License.
+ ;
 "RTN","C0CCCR0",5,0)
- ;See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CCCR0",6,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CCCR0",7,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CCCR0",8,0)
- ;it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CCCR0",9,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CCCR0",10,0)
- ;(at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CCCR0",11,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CCCR0",12,0)
- ;This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CCCR0",13,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CCCR0",14,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CCCR0",15,0)
- ;GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CCCR0",16,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CCCR0",17,0)
- ;You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CCCR0",18,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ W "This is a CCR TEMPLATE with processing routines",!
 "RTN","C0CCCR0",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ W !
 "RTN","C0CCCR0",20,0)
- ;
+ Q
 "RTN","C0CCCR0",21,0)
- W "This is a CCR TEMPLATE with processing routines",!
+ ;
 "RTN","C0CCCR0",22,0)
- W !
+ZT(ZARY,BAT,LINE)       ; private routine to add a line to the ZARY array
 "RTN","C0CCCR0",23,0)
+ ; ZARY IS PASSED BY NAME
+"RTN","C0CCCR0",24,0)
+ ; BAT is a string identifying the section
+"RTN","C0CCCR0",25,0)
+ ; LINE is a test which will evaluate to true or false
+"RTN","C0CCCR0",26,0)
+ ; I '$G(@ZARY) D  ;
+"RTN","C0CCCR0",27,0)
+ ; . S @ZARY@(0)=0 ; initially there are no elements
+"RTN","C0CCCR0",28,0)
+ ; . W "GOT HERE LOADING "_LINE,!
+"RTN","C0CCCR0",29,0)
+ N CNT ; count of array elements
+"RTN","C0CCCR0",30,0)
+ S CNT=@ZARY@(0) ; contains array count
+"RTN","C0CCCR0",31,0)
+ S CNT=CNT+1 ; increment count
+"RTN","C0CCCR0",32,0)
+ S @ZARY@(CNT)=LINE ; put the line in the array
+"RTN","C0CCCR0",33,0)
+ ; S @ZARY@(BAT,CNT)="" ; index the test by battery
+"RTN","C0CCCR0",34,0)
+ S @ZARY@(0)=CNT ; update the array counter
+"RTN","C0CCCR0",35,0)
  Q
-"RTN","C0CCCR0",24,0)
- ;
-"RTN","C0CCCR0",25,0)
-ZT(ZARY,BAT,LINE)       ; private routine to add a line to the ZARY array
-"RTN","C0CCCR0",26,0)
+"RTN","C0CCCR0",36,0)
+ ;
+"RTN","C0CCCR0",37,0)
+ZLOAD(ZARY,ROUTINE)      ; load tests into ZARY which is passed by reference
+"RTN","C0CCCR0",38,0)
  ; ZARY IS PASSED BY NAME
-"RTN","C0CCCR0",27,0)
- ; BAT is a string identifying the section
-"RTN","C0CCCR0",28,0)
- ; LINE is a test which will evaluate to true or false
-"RTN","C0CCCR0",29,0)
- ; I '$G(@ZARY) D  ;
-"RTN","C0CCCR0",30,0)
- ; . S @ZARY@(0)=0 ; initially there are no elements
-"RTN","C0CCCR0",31,0)
- ; . W "GOT HERE LOADING "_LINE,!
-"RTN","C0CCCR0",32,0)
- N CNT ; count of array elements
-"RTN","C0CCCR0",33,0)
- S CNT=@ZARY@(0) ; contains array count
-"RTN","C0CCCR0",34,0)
- S CNT=CNT+1 ; increment count
-"RTN","C0CCCR0",35,0)
- S @ZARY@(CNT)=LINE ; put the line in the array
-"RTN","C0CCCR0",36,0)
- ; S @ZARY@(BAT,CNT)="" ; index the test by battery
-"RTN","C0CCCR0",37,0)
- S @ZARY@(0)=CNT ; update the array counter
-"RTN","C0CCCR0",38,0)
+"RTN","C0CCCR0",39,0)
+ ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+"RTN","C0CCCR0",40,0)
+ ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+"RTN","C0CCCR0",41,0)
+ K @ZARY S @ZARY=""
+"RTN","C0CCCR0",42,0)
+ S @ZARY@(0)=0 ; initialize array count
+"RTN","C0CCCR0",43,0)
+ N LINE,LABEL,BODY
+"RTN","C0CCCR0",44,0)
+ N INTEST S INTEST=0 ; switch for in the TEMPLATE section
+"RTN","C0CCCR0",45,0)
+ N SECTION S SECTION="[anonymous]" ; NO section LABEL
+"RTN","C0CCCR0",46,0)
+ ;
+"RTN","C0CCCR0",47,0)
+ N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
+"RTN","C0CCCR0",48,0)
+ . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
+"RTN","C0CCCR0",49,0)
+ . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
+"RTN","C0CCCR0",50,0)
+ . I INTEST  D  ; within the section
+"RTN","C0CCCR0",51,0)
+ . . I LINE?." "1";><".E  D  ; sub-section name found
+"RTN","C0CCCR0",52,0)
+ . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
+"RTN","C0CCCR0",53,0)
+ . . I LINE?." "1";;".E  D  ; line found
+"RTN","C0CCCR0",54,0)
+ . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
+"RTN","C0CCCR0",55,0)
  Q
-"RTN","C0CCCR0",39,0)
- ;
-"RTN","C0CCCR0",40,0)
-ZLOAD(ZARY,ROUTINE)      ; load tests into ZARY which is passed by reference
-"RTN","C0CCCR0",41,0)
- ; ZARY IS PASSED BY NAME
-"RTN","C0CCCR0",42,0)
- ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
-"RTN","C0CCCR0",43,0)
- ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
-"RTN","C0CCCR0",44,0)
- K @ZARY S @ZARY=""
-"RTN","C0CCCR0",45,0)
- S @ZARY@(0)=0 ; initialize array count
-"RTN","C0CCCR0",46,0)
- N LINE,LABEL,BODY
-"RTN","C0CCCR0",47,0)
- N INTEST S INTEST=0 ; switch for in the TEMPLATE section
-"RTN","C0CCCR0",48,0)
- N SECTION S SECTION="[anonymous]" ; NO section LABEL
-"RTN","C0CCCR0",49,0)
- ;
-"RTN","C0CCCR0",50,0)
- N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
-"RTN","C0CCCR0",51,0)
- . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
-"RTN","C0CCCR0",52,0)
- . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
-"RTN","C0CCCR0",53,0)
- . I INTEST  D  ; within the section
-"RTN","C0CCCR0",54,0)
- . . I LINE?." "1";><".E  D  ; sub-section name found
-"RTN","C0CCCR0",55,0)
- . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
 "RTN","C0CCCR0",56,0)
- . . I LINE?." "1";;".E  D  ; line found
+ ;
 "RTN","C0CCCR0",57,0)
- . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
+LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
 "RTN","C0CCCR0",58,0)
+ D ZLOAD(ARY,"C0CCCR0")
+"RTN","C0CCCR0",59,0)
+ ; ZWR @ARY
+"RTN","C0CCCR0",60,0)
  Q
-"RTN","C0CCCR0",59,0)
- ;
-"RTN","C0CCCR0",60,0)
-LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
 "RTN","C0CCCR0",61,0)
- D ZLOAD(ARY,"C0CCCR0")
+ ;
 "RTN","C0CCCR0",62,0)
- ; ZWR @ARY
+ ;<TEMPLATE>
 "RTN","C0CCCR0",63,0)
- Q
+ ;;<?xml version="1.0" encoding="UTF-8"?>
 "RTN","C0CCCR0",64,0)
- ;
+ ;;<?xml-stylesheet type="text/xsl" href="ccr.xsl"?>
 "RTN","C0CCCR0",65,0)
- ;<TEMPLATE>
+ ;;<ContinuityOfCareRecord xmlns="urn:astm-org:CCR">
 "RTN","C0CCCR0",66,0)
- ;;<?xml version="1.0" encoding="UTF-8"?>
+ ;;<CCRDocumentObjectID>@@CCRDOCOBJECTID@@</CCRDocumentObjectID>
 "RTN","C0CCCR0",67,0)
- ;;<?xml-stylesheet type="text/xsl" href="ccr.xsl"?>
+ ;;<Language>
 "RTN","C0CCCR0",68,0)
- ;;<ContinuityOfCareRecord xmlns="urn:astm-org:CCR">
+ ;;<Text>English</Text>
 "RTN","C0CCCR0",69,0)
- ;;<CCRDocumentObjectID>@@CCRDOCOBJECTID@@</CCRDocumentObjectID>
+ ;;</Language>
 "RTN","C0CCCR0",70,0)
- ;;<Language>
+ ;;<Version>V1.0</Version>
 "RTN","C0CCCR0",71,0)
- ;;<Text>English</Text>
+ ;;<DateTime>
 "RTN","C0CCCR0",72,0)
- ;;</Language>
+ ;;<ExactDateTime>@@DATETIME@@</ExactDateTime>
 "RTN","C0CCCR0",73,0)
- ;;<Version>V1.0</Version>
+ ;;</DateTime>
 "RTN","C0CCCR0",74,0)
- ;;<DateTime>
+ ;;<Patient>
 "RTN","C0CCCR0",75,0)
- ;;<ExactDateTime>@@DATETIME@@</ExactDateTime>
+ ;;<ActorID>@@ACTORPATIENT@@</ActorID>
 "RTN","C0CCCR0",76,0)
- ;;</DateTime>
+ ;;</Patient>
 "RTN","C0CCCR0",77,0)
- ;;<Patient>
+ ;;<From>
 "RTN","C0CCCR0",78,0)
- ;;<ActorID>@@ACTORPATIENT@@</ActorID>
+ ;;<ActorLink>
 "RTN","C0CCCR0",79,0)
- ;;</Patient>
+ ;;<ActorID>@@ACTORFROM@@</ActorID>
 "RTN","C0CCCR0",80,0)
- ;;<From>
+ ;;</ActorLink>
 "RTN","C0CCCR0",81,0)
  ;;<ActorLink>
 "RTN","C0CCCR0",82,0)
- ;;<ActorID>@@ACTORFROM@@</ActorID>
+ ;;<ActorID>@@ACTORFROM2@@</ActorID>
 "RTN","C0CCCR0",83,0)
  ;;</ActorLink>
 "RTN","C0CCCR0",84,0)
+ ;;</From>
+"RTN","C0CCCR0",85,0)
+ ;;<To>
+"RTN","C0CCCR0",86,0)
  ;;<ActorLink>
-"RTN","C0CCCR0",85,0)
- ;;<ActorID>@@ACTORFROM2@@</ActorID>
-"RTN","C0CCCR0",86,0)
+"RTN","C0CCCR0",87,0)
+ ;;<ActorID>@@ACTORTO@@</ActorID>
+"RTN","C0CCCR0",88,0)
+ ;;<ActorRole>
+"RTN","C0CCCR0",89,0)
+ ;;<Text>@@ACTORTOTEXT@@</Text>
+"RTN","C0CCCR0",90,0)
+ ;;</ActorRole>
+"RTN","C0CCCR0",91,0)
  ;;</ActorLink>
-"RTN","C0CCCR0",87,0)
- ;;</From>
-"RTN","C0CCCR0",88,0)
- ;;<To>
-"RTN","C0CCCR0",89,0)
- ;;<ActorLink>
-"RTN","C0CCCR0",90,0)
- ;;<ActorID>@@ACTORTO@@</ActorID>
-"RTN","C0CCCR0",91,0)
+"RTN","C0CCCR0",92,0)
+ ;;</To>
+"RTN","C0CCCR0",93,0)
+ ;;<Purpose>
+"RTN","C0CCCR0",94,0)
+ ;;<Description>
+"RTN","C0CCCR0",95,0)
+ ;;<Text>@@PURPOSEDESCRIPTION@@</Text>
+"RTN","C0CCCR0",96,0)
+ ;;</Description>
+"RTN","C0CCCR0",97,0)
+ ;;</Purpose>
+"RTN","C0CCCR0",98,0)
+ ;;<Body>
+"RTN","C0CCCR0",99,0)
+ ;;<Problems>
+"RTN","C0CCCR0",100,0)
+ ;;<Problem>
+"RTN","C0CCCR0",101,0)
+ ;;<CCRDataObjectID>@@PROBLEMOBJECTID@@</CCRDataObjectID>
+"RTN","C0CCCR0",102,0)
+ ;;<DateTime>
+"RTN","C0CCCR0",103,0)
+ ;;<ExactDateTime>@@PROBLEMDATEMOD@@</ExactDateTime>
+"RTN","C0CCCR0",104,0)
+ ;;</DateTime>
+"RTN","C0CCCR0",105,0)
+ ;;<Type>
+"RTN","C0CCCR0",106,0)
+ ;;<Text>Problem</Text>
+"RTN","C0CCCR0",107,0)
+ ;;</Type>
+"RTN","C0CCCR0",108,0)
+ ;;<Description>
+"RTN","C0CCCR0",109,0)
+ ;;<Text>@@PROBLEMDESCRIPTION@@</Text>
+"RTN","C0CCCR0",110,0)
+ ;;<Code>
+"RTN","C0CCCR0",111,0)
+ ;;<Value>@@PROBLEMCODEVALUE@@</Value>
+"RTN","C0CCCR0",112,0)
+ ;;<CodingSystem>ICD9CM</CodingSystem>
+"RTN","C0CCCR0",113,0)
+ ;;<Version>@@PROBLEMCODINGVERSION@@</Version>
+"RTN","C0CCCR0",114,0)
+ ;;</Code>
+"RTN","C0CCCR0",115,0)
+ ;;</Description>
+"RTN","C0CCCR0",116,0)
+ ;;<Status>
+"RTN","C0CCCR0",117,0)
+ ;;<Text>@@PROBLEMSTATUS@@</Text>
+"RTN","C0CCCR0",118,0)
+ ;;</Status>
+"RTN","C0CCCR0",119,0)
+ ;;<Source>
+"RTN","C0CCCR0",120,0)
+ ;;<Actor>
+"RTN","C0CCCR0",121,0)
+ ;;<ActorID>@@PROBLEMSOURCEACTORID@@</ActorID>
+"RTN","C0CCCR0",122,0)
+ ;;</Actor>
+"RTN","C0CCCR0",123,0)
+ ;;</Source>
+"RTN","C0CCCR0",124,0)
+ ;;</Problem>
+"RTN","C0CCCR0",125,0)
+ ;;</Problems>
+"RTN","C0CCCR0",126,0)
+ ;;<Immunizations>
+"RTN","C0CCCR0",127,0)
+ ;;<Immunization>
+"RTN","C0CCCR0",128,0)
+ ;;<CCRDataObjectID>@@IMMUNEOBJECTID@@</CCRDataObjectID>
+"RTN","C0CCCR0",129,0)
+ ;;<DateTime>
+"RTN","C0CCCR0",130,0)
+ ;;<Type>
+"RTN","C0CCCR0",131,0)
+ ;;<Text>@@IMMUNEDATETIMETYPETEXT@@</Text>
+"RTN","C0CCCR0",132,0)
+ ;;</Type>
+"RTN","C0CCCR0",133,0)
+ ;;<ExactDateTime>@@IMMUNEDATETIME@@</ExactDateTime>
+"RTN","C0CCCR0",134,0)
+ ;;</DateTime>
+"RTN","C0CCCR0",135,0)
+ ;;<Source>
+"RTN","C0CCCR0",136,0)
+ ;;<Actor>
+"RTN","C0CCCR0",137,0)
+ ;;<ActorID>@@IMMUNESOURCEACTORID@@</ActorID>
+"RTN","C0CCCR0",138,0)
+ ;;</Actor>
+"RTN","C0CCCR0",139,0)
+ ;;</Source>
+"RTN","C0CCCR0",140,0)
+ ;;<Product>
+"RTN","C0CCCR0",141,0)
+ ;;<ProductName>
+"RTN","C0CCCR0",142,0)
+ ;;<Text>@@IMMUNEPRODUCTNAMETEXT@@</Text>
+"RTN","C0CCCR0",143,0)
+ ;;<Code>
+"RTN","C0CCCR0",144,0)
+ ;;<Value>@@IMMUNEPRODUCTCODE@@</Value>
+"RTN","C0CCCR0",145,0)
+ ;;<CodingSystem>@@IMMUNEPRODUCTCODESYSTEM@@</CodingSystem>
+"RTN","C0CCCR0",146,0)
+ ;;</Code>
+"RTN","C0CCCR0",147,0)
+ ;;</ProductName>
+"RTN","C0CCCR0",148,0)
+ ;;</Product>
+"RTN","C0CCCR0",149,0)
+ ;;</Immunization>
+"RTN","C0CCCR0",150,0)
+ ;;</Immunizations>
+"RTN","C0CCCR0",151,0)
+ ;;<FamilyHistory>
+"RTN","C0CCCR0",152,0)
+ ;;<FamilyProblemHistory>
+"RTN","C0CCCR0",153,0)
+ ;;<CCRDataObjectID>@@FAMILYHISTORYOBJECTID@@</CCRDataObjectID>
+"RTN","C0CCCR0",154,0)
+ ;;<Source>
+"RTN","C0CCCR0",155,0)
+ ;;<Actor>
+"RTN","C0CCCR0",156,0)
+ ;;<ActorID>@@FAMILYHISTORYACTORID@@</ActorID>
+"RTN","C0CCCR0",157,0)
+ ;;</Actor>
+"RTN","C0CCCR0",158,0)
+ ;;</Source>
+"RTN","C0CCCR0",159,0)
+ ;;<FamilyMember>
+"RTN","C0CCCR0",160,0)
+ ;;<ActorID>@@FAMILYMEMBERACTORID@@</ActorID>
+"RTN","C0CCCR0",161,0)
  ;;<ActorRole>
-"RTN","C0CCCR0",92,0)
- ;;<Text>@@ACTORTOTEXT@@</Text>
-"RTN","C0CCCR0",93,0)
+"RTN","C0CCCR0",162,0)
+ ;;<Text>@@FAMILYMEMBERACTORROLETEXT@@</Text>
+"RTN","C0CCCR0",163,0)
  ;;</ActorRole>
-"RTN","C0CCCR0",94,0)
- ;;</ActorLink>
-"RTN","C0CCCR0",95,0)
- ;;</To>
-"RTN","C0CCCR0",96,0)
- ;;<Purpose>
-"RTN","C0CCCR0",97,0)
+"RTN","C0CCCR0",164,0)
+ ;;<Source>
+"RTN","C0CCCR0",165,0)
+ ;;<Actor>
+"RTN","C0CCCR0",166,0)
+ ;;<ActorID>@@FAMILYMEMBERSOURCACTORID@@</ActorID>
+"RTN","C0CCCR0",167,0)
+ ;;</Actor>
+"RTN","C0CCCR0",168,0)
+ ;;</Source>
+"RTN","C0CCCR0",169,0)
+ ;;</FamilyMember>
+"RTN","C0CCCR0",170,0)
+ ;;<Problem>
+"RTN","C0CCCR0",171,0)
+ ;;<Type>
+"RTN","C0CCCR0",172,0)
+ ;;<Text>Problem</Text>
+"RTN","C0CCCR0",173,0)
+ ;;</Type>
+"RTN","C0CCCR0",174,0)
  ;;<Description>
-"RTN","C0CCCR0",98,0)
- ;;<Text>@@PURPOSEDESCRIPTION@@</Text>
-"RTN","C0CCCR0",99,0)
+"RTN","C0CCCR0",175,0)
+ ;;<Text>@@FAMILYMEMBERPROBLEMDESCRIPTION@@</Text>
+"RTN","C0CCCR0",176,0)
+ ;;<Code>
+"RTN","C0CCCR0",177,0)
+ ;;<Value>@@FAMILYMEMBERPROBLEMCODE@@</Value>
+"RTN","C0CCCR0",178,0)
+ ;;<CodingSystem>@@FAMILYMEMBERCODESYSTEM@@</CodingSystem>
+"RTN","C0CCCR0",179,0)
+ ;;<Version>@@FAMILYMEMBERCODEVERSION@@</Version>
+"RTN","C0CCCR0",180,0)
+ ;;</Code>
+"RTN","C0CCCR0",181,0)
  ;;</Description>
-"RTN","C0CCCR0",100,0)
- ;;</Purpose>
-"RTN","C0CCCR0",101,0)
- ;;<Body>
-"RTN","C0CCCR0",102,0)
- ;;<Problems>
-"RTN","C0CCCR0",103,0)
+"RTN","C0CCCR0",182,0)
+ ;;<Source>
+"RTN","C0CCCR0",183,0)
+ ;;<Actor>
+"RTN","C0CCCR0",184,0)
+ ;;<ActorID>@@FAMILYMEMBERPROBLEMSOURCEID@@</ActorID>
+"RTN","C0CCCR0",185,0)
+ ;;</Actor>
+"RTN","C0CCCR0",186,0)
+ ;;</Source>
+"RTN","C0CCCR0",187,0)
+ ;;</Problem>
+"RTN","C0CCCR0",188,0)
+ ;;</FamilyProblemHistory>
+"RTN","C0CCCR0",189,0)
+ ;;</FamilyHistory>
+"RTN","C0CCCR0",190,0)
+ ;;<SocialHistory>
+"RTN","C0CCCR0",191,0)
+ ;;<SocialHistoryElement>
+"RTN","C0CCCR0",192,0)
+ ;;<CCRDataObjectID>@@SOCIALHISTORYOBJECTID@@</CCRDataObjectID>
+"RTN","C0CCCR0",193,0)
+ ;;<Type>
+"RTN","C0CCCR0",194,0)
+ ;;<Text>@@SOCIALHISTORYTYPETEXT@@</Text>
+"RTN","C0CCCR0",195,0)
+ ;;</Type>
+"RTN","C0CCCR0",196,0)
+ ;;<Description>
+"RTN","C0CCCR0",197,0)
+ ;;<Text>@@SOCIALHISTORYDESCRIPTIONTEXT@@</Text>
+"RTN","C0CCCR0",198,0)
+ ;;</Description>
+"RTN","C0CCCR0",199,0)
+ ;;<Source>
+"RTN","C0CCCR0",200,0)
+ ;;<Actor>
+"RTN","C0CCCR0",201,0)
+ ;;<ActorID>@@SOCIALHISTORYSOURCACTORID@@</ActorID>
+"RTN","C0CCCR0",202,0)
+ ;;</Actor>
+"RTN","C0CCCR0",203,0)
+ ;;</Source>
+"RTN","C0CCCR0",204,0)
+ ;;</SocialHistoryElement>
+"RTN","C0CCCR0",205,0)
+ ;;<SocialHistoryElement>
+"RTN","C0CCCR0",206,0)
+ ;;<CCRDataObjectID>BB0005</CCRDataObjectID>
+"RTN","C0CCCR0",207,0)
+ ;;<Type>
+"RTN","C0CCCR0",208,0)
+ ;;<Text>Ethnic Origin</Text>
+"RTN","C0CCCR0",209,0)
+ ;;</Type>
+"RTN","C0CCCR0",210,0)
+ ;;<Description>
+"RTN","C0CCCR0",211,0)
+ ;;<Text>Not Hispanic or Latino</Text>
+"RTN","C0CCCR0",212,0)
+ ;;</Description>
+"RTN","C0CCCR0",213,0)
+ ;;<Source>
+"RTN","C0CCCR0",214,0)
+ ;;<Actor>
+"RTN","C0CCCR0",215,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","C0CCCR0",216,0)
+ ;;</Actor>
+"RTN","C0CCCR0",217,0)
+ ;;</Source>
+"RTN","C0CCCR0",218,0)
+ ;;</SocialHistoryElement>
+"RTN","C0CCCR0",219,0)
+ ;;<SocialHistoryElement>
+"RTN","C0CCCR0",220,0)
+ ;;<CCRDataObjectID>BB0006</CCRDataObjectID>
+"RTN","C0CCCR0",221,0)
+ ;;<Type>
+"RTN","C0CCCR0",222,0)
+ ;;<Text>Race</Text>
+"RTN","C0CCCR0",223,0)
+ ;;</Type>
+"RTN","C0CCCR0",224,0)
+ ;;<Description>
+"RTN","C0CCCR0",225,0)
+ ;;<Text>White</Text>
+"RTN","C0CCCR0",226,0)
+ ;;</Description>
+"RTN","C0CCCR0",227,0)
+ ;;<Source>
+"RTN","C0CCCR0",228,0)
+ ;;<Actor>
+"RTN","C0CCCR0",229,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","C0CCCR0",230,0)
+ ;;</Actor>
+"RTN","C0CCCR0",231,0)
+ ;;</Source>
+"RTN","C0CCCR0",232,0)
+ ;;</SocialHistoryElement>
+"RTN","C0CCCR0",233,0)
+ ;;<SocialHistoryElement>
+"RTN","C0CCCR0",234,0)
+ ;;<CCRDataObjectID>BB0007</CCRDataObjectID>
+"RTN","C0CCCR0",235,0)
+ ;;<Type>
+"RTN","C0CCCR0",236,0)
+ ;;<Text>Occupation</Text>
+"RTN","C0CCCR0",237,0)
+ ;;</Type>
+"RTN","C0CCCR0",238,0)
+ ;;<Description>
+"RTN","C0CCCR0",239,0)
+ ;;<Text>Physician</Text>
+"RTN","C0CCCR0",240,0)
+ ;;</Description>
+"RTN","C0CCCR0",241,0)
+ ;;<Source>
+"RTN","C0CCCR0",242,0)
+ ;;<Actor>
+"RTN","C0CCCR0",243,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","C0CCCR0",244,0)
+ ;;</Actor>
+"RTN","C0CCCR0",245,0)
+ ;;</Source>
+"RTN","C0CCCR0",246,0)
+ ;;</SocialHistoryElement>
+"RTN","C0CCCR0",247,0)
+ ;;</SocialHistory>
+"RTN","C0CCCR0",248,0)
+ ;;<Alerts>
+"RTN","C0CCCR0",249,0)
+ ;;<Alert>
+"RTN","C0CCCR0",250,0)
+ ;;<CCRDataObjectID>@@ALERTOBJECTID@@</CCRDataObjectID>
+"RTN","C0CCCR0",251,0)
+ ;;<DateTime>
+"RTN","C0CCCR0",252,0)
+ ;;<ExactDateTime>@@ALERTDATETIME@@</ExactDateTime>
+"RTN","C0CCCR0",253,0)
+ ;;</DateTime>
+"RTN","C0CCCR0",254,0)
+ ;;<Type>
+"RTN","C0CCCR0",255,0)
+ ;;<Text>@@ALERTTYPE@@</Text>
+"RTN","C0CCCR0",256,0)
+ ;;</Type>
+"RTN","C0CCCR0",257,0)
+ ;;<Status>
+"RTN","C0CCCR0",258,0)
+ ;;<Text>@@ALERTSTATUSTEXT@@</Text>
+"RTN","C0CCCR0",259,0)
+ ;;</Status>
+"RTN","C0CCCR0",260,0)
+ ;;<Description>
+"RTN","C0CCCR0",261,0)
+ ;;<Text>@@ALERTDESCRIPTIONTEXT@@</Text>
+"RTN","C0CCCR0",262,0)
+ ;;<Code>
+"RTN","C0CCCR0",263,0)
+ ;;<Value>@@ALERTCODEVALUE@@</Value>
+"RTN","C0CCCR0",264,0)
+ ;;<CodingSystem>@@ALERTCODESYSTEM@@</CodingSystem>
+"RTN","C0CCCR0",265,0)
+ ;;</Code>
+"RTN","C0CCCR0",266,0)
+ ;;</Description>
+"RTN","C0CCCR0",267,0)
+ ;;<Source>
+"RTN","C0CCCR0",268,0)
+ ;;<Actor>
+"RTN","C0CCCR0",269,0)
+ ;;<ActorID>@@ALERTSOURCEID@@</ActorID>
+"RTN","C0CCCR0",270,0)
+ ;;</Actor>
+"RTN","C0CCCR0",271,0)
+ ;;</Source>
+"RTN","C0CCCR0",272,0)
+ ;;<Agent>
+"RTN","C0CCCR0",273,0)
+ ;;<Products>
+"RTN","C0CCCR0",274,0)
+ ;;<Product>
+"RTN","C0CCCR0",275,0)
+ ;;<CCRDataObjectID>@@ALERTAGENTPRODUCTOBJECTID@@</CCRDataObjectID>
+"RTN","C0CCCR0",276,0)
+ ;;<Source>
+"RTN","C0CCCR0",277,0)
+ ;;<Actor>
+"RTN","C0CCCR0",278,0)
+ ;;<ActorID>@@ALERTSOURCEID@@</ActorID>
+"RTN","C0CCCR0",279,0)
+ ;;</Actor>
+"RTN","C0CCCR0",280,0)
+ ;;</Source>
+"RTN","C0CCCR0",281,0)
+ ;;<Product>
+"RTN","C0CCCR0",282,0)
+ ;;<ProductName>
+"RTN","C0CCCR0",283,0)
+ ;;<Text>@@ALERTAGENTPRODUCTNAMETEXT@@</Text>
+"RTN","C0CCCR0",284,0)
+ ;;<Code>
+"RTN","C0CCCR0",285,0)
+ ;;<Value>@@ALERTAGENTPRODUCTCODEVALUE@@</Value>
+"RTN","C0CCCR0",286,0)
+ ;;<CodingSystem>@@ALERTAGENTPRODUCTCODESYSTEM@@</CodingSystem>
+"RTN","C0CCCR0",287,0)
+ ;;</Code>
+"RTN","C0CCCR0",288,0)
+ ;;</ProductName>
+"RTN","C0CCCR0",289,0)
+ ;;</Product>
+"RTN","C0CCCR0",290,0)
+ ;;</Product>
+"RTN","C0CCCR0",291,0)
+ ;;</Products>
+"RTN","C0CCCR0",292,0)
+ ;;</Agent>
+"RTN","C0CCCR0",293,0)
+ ;;<Reaction>
+"RTN","C0CCCR0",294,0)
+ ;;<Description>
+"RTN","C0CCCR0",295,0)
+ ;;<Text>@@ALERTREACTIOINDESCRIPTIONTEXT@@</Text>
+"RTN","C0CCCR0",296,0)
+ ;;<Code>
+"RTN","C0CCCR0",297,0)
+ ;;<Value>@@ALERTREACTIONCODEVALUE@@</Value>
+"RTN","C0CCCR0",298,0)
+ ;;<CodingSystem>@@ALERTREACTIONCODESYSTEM@@</CodingSystem>
+"RTN","C0CCCR0",299,0)
+ ;;</Code>
+"RTN","C0CCCR0",300,0)
+ ;;</Description>
+"RTN","C0CCCR0",301,0)
+ ;;</Reaction>
+"RTN","C0CCCR0",302,0)
+ ;;</Alert>
+"RTN","C0CCCR0",303,0)
+ ;;</Alerts>
+"RTN","C0CCCR0",304,0)
+ ;;<Medications>
+"RTN","C0CCCR0",305,0)
+ ;;<Medication>
+"RTN","C0CCCR0",306,0)
+ ;;<CCRDataObjectID>@@MEDOBJECTID@@</CCRDataObjectID>
+"RTN","C0CCCR0",307,0)
+ ;;<DateTime>
+"RTN","C0CCCR0",308,0)
+ ;;<Type>
+"RTN","C0CCCR0",309,0)
+ ;;<Text>@@MEDISSUEDATETXT@@</Text>
+"RTN","C0CCCR0",310,0)
+ ;;</Type>
+"RTN","C0CCCR0",311,0)
+ ;;<ExactDateTime>@@MEDISSUEDATE@@</ExactDateTime>
+"RTN","C0CCCR0",312,0)
+ ;;</DateTime>
+"RTN","C0CCCR0",313,0)
+ ;;<DateTime>
+"RTN","C0CCCR0",314,0)
+ ;;<Type>
+"RTN","C0CCCR0",315,0)
+ ;;<Text>@@MEDLASTFILLDATETXT@@</Text>
+"RTN","C0CCCR0",316,0)
+ ;;</Type>
+"RTN","C0CCCR0",317,0)
+ ;;<ExactDateTime>@@MEDLASTFILLDATE@@</ExactDateTime>
+"RTN","C0CCCR0",318,0)
+ ;;</DateTime>
+"RTN","C0CCCR0",319,0)
+ ;;<IDs>
+"RTN","C0CCCR0",320,0)
+ ;;<Type>
+"RTN","C0CCCR0",321,0)
+ ;;<Text>@@MEDRXNOTXT@@</Text>
+"RTN","C0CCCR0",322,0)
+ ;;</Type>
+"RTN","C0CCCR0",323,0)
+ ;;<ID>@@MEDRXNO@@</ID>
+"RTN","C0CCCR0",324,0)
+ ;;</IDs>
+"RTN","C0CCCR0",325,0)
+ ;;<Type>
+"RTN","C0CCCR0",326,0)
+ ;;<Text>@@MEDTYPETEXT@@</Text>
+"RTN","C0CCCR0",327,0)
+ ;;</Type>
+"RTN","C0CCCR0",328,0)
+ ;;<Description>
+"RTN","C0CCCR0",329,0)
+ ;;<Text>@@MEDDETAILUNADORNED@@</Text>
+"RTN","C0CCCR0",330,0)
+ ;;</Description>
+"RTN","C0CCCR0",331,0)
+ ;;<Status>
+"RTN","C0CCCR0",332,0)
+ ;;<Text>@@MEDSTATUSTEXT@@</Text>
+"RTN","C0CCCR0",333,0)
+ ;;</Status>
+"RTN","C0CCCR0",334,0)
+ ;;<Source>
+"RTN","C0CCCR0",335,0)
+ ;;<Actor>
+"RTN","C0CCCR0",336,0)
+ ;;<ActorID>@@MEDSOURCEACTORID@@</ActorID>
+"RTN","C0CCCR0",337,0)
+ ;;</Actor>
+"RTN","C0CCCR0",338,0)
+ ;;</Source>
+"RTN","C0CCCR0",339,0)
+ ;;<Product>
+"RTN","C0CCCR0",340,0)
+ ;;<ProductName>
+"RTN","C0CCCR0",341,0)
+ ;;<Text>@@MEDPRODUCTNAMETEXT@@</Text>
+"RTN","C0CCCR0",342,0)
+ ;;<Code>
+"RTN","C0CCCR0",343,0)
+ ;;<Value>@@MEDPRODUCTNAMECODEVALUE@@</Value>
+"RTN","C0CCCR0",344,0)
+ ;;<CodingSystem>@@MEDPRODUCTNAMECODINGINGSYSTEM@@</CodingSystem>
+"RTN","C0CCCR0",345,0)
+ ;;<Version>@@MEDPRODUCTNAMECODEVERSION@@</Version>
+"RTN","C0CCCR0",346,0)
+ ;;</Code>
+"RTN","C0CCCR0",347,0)
+ ;;</ProductName>
+"RTN","C0CCCR0",348,0)
+ ;;<BrandName>
+"RTN","C0CCCR0",349,0)
+ ;;<Text>@@MEDBRANDNAMETEXT@@</Text>
+"RTN","C0CCCR0",350,0)
+ ;;</BrandName>
+"RTN","C0CCCR0",351,0)
+ ;;<Strength>
+"RTN","C0CCCR0",352,0)
+ ;;<Value>@@MEDSTRENGTHVALUE@@</Value>
+"RTN","C0CCCR0",353,0)
+ ;;<Units>
+"RTN","C0CCCR0",354,0)
+ ;;<Unit>@@MEDSTRENGTHUNIT@@</Unit>
+"RTN","C0CCCR0",355,0)
+ ;;</Units>
+"RTN","C0CCCR0",356,0)
+ ;;</Strength>
+"RTN","C0CCCR0",357,0)
+ ;;<Form>
+"RTN","C0CCCR0",358,0)
+ ;;<Text>@@MEDFORMTEXT@@</Text>
+"RTN","C0CCCR0",359,0)
+ ;;</Form>
+"RTN","C0CCCR0",360,0)
+ ;;<Concentration>
+"RTN","C0CCCR0",361,0)
+ ;;<Value>@@MEDCONCVALUE@@</Value>
+"RTN","C0CCCR0",362,0)
+ ;;<Units>
+"RTN","C0CCCR0",363,0)
+ ;;<Unit>@@MEDCONCUNIT@@</Unit>
+"RTN","C0CCCR0",364,0)
+ ;;</Units>
+"RTN","C0CCCR0",365,0)
+ ;;</Concentration>
+"RTN","C0CCCR0",366,0)
+ ;;</Product>
+"RTN","C0CCCR0",367,0)
+ ;;<Quantity>
+"RTN","C0CCCR0",368,0)
+ ;;<Value>@@MEDQUANTITYVALUE@@</Value>
+"RTN","C0CCCR0",369,0)
+ ;;<Units>
+"RTN","C0CCCR0",370,0)
+ ;;<Unit>@@MEDQUANTITYUNIT@@</Unit>
+"RTN","C0CCCR0",371,0)
+ ;;</Units>
+"RTN","C0CCCR0",372,0)
+ ;;</Quantity>
+"RTN","C0CCCR0",373,0)
+ ;;<Directions>
+"RTN","C0CCCR0",374,0)
+ ;;<Direction>
+"RTN","C0CCCR0",375,0)
+ ;;<Description>
+"RTN","C0CCCR0",376,0)
+ ;;<Text>@@MEDDIRECTIONDESCRIPTIONTEXT@@</Text>
+"RTN","C0CCCR0",377,0)
+ ;;</Description>
+"RTN","C0CCCR0",378,0)
+ ;;<DoseIndicator>
+"RTN","C0CCCR0",379,0)
+ ;;<Text>@@MEDDOSEINDICATOR@@</Text>
+"RTN","C0CCCR0",380,0)
+ ;;</DoseIndicator>
+"RTN","C0CCCR0",381,0)
+ ;;<DeliveryMethod>
+"RTN","C0CCCR0",382,0)
+ ;;<Text>@@MEDDELIVERYMETHOD@@</Text>
+"RTN","C0CCCR0",383,0)
+ ;;</DeliveryMethod>
+"RTN","C0CCCR0",384,0)
+ ;;<Dose>
+"RTN","C0CCCR0",385,0)
+ ;;<Value>@@MEDDOSEVALUE@@</Value>
+"RTN","C0CCCR0",386,0)
+ ;;<Units>
+"RTN","C0CCCR0",387,0)
+ ;;<Unit>@@MEDDOSEUNIT@@</Unit>
+"RTN","C0CCCR0",388,0)
+ ;;</Units>
+"RTN","C0CCCR0",389,0)
+ ;;<Rate>
+"RTN","C0CCCR0",390,0)
+ ;;<Value>@@MEDRATEVALUE@@</Value>
+"RTN","C0CCCR0",391,0)
+ ;;<Units>
+"RTN","C0CCCR0",392,0)
+ ;;<Unit>@@MEDRATEUNIT@@</Unit>
+"RTN","C0CCCR0",393,0)
+ ;;</Units>
+"RTN","C0CCCR0",394,0)
+ ;;</Rate>
+"RTN","C0CCCR0",395,0)
+ ;;</Dose>
+"RTN","C0CCCR0",396,0)
+ ;;<Vehicle>
+"RTN","C0CCCR0",397,0)
+ ;;<Text>@@MEDVEHICLETEXT@@</Text>
+"RTN","C0CCCR0",398,0)
+ ;;</Vehicle>
+"RTN","C0CCCR0",399,0)
+ ;;<Route>
+"RTN","C0CCCR0",400,0)
+ ;;<Text>@@MEDDIRECTIONROUTETEXT@@</Text>
+"RTN","C0CCCR0",401,0)
+ ;;</Route>
+"RTN","C0CCCR0",402,0)
+ ;;<Frequency>
+"RTN","C0CCCR0",403,0)
+ ;;<Value>@@MEDFREQUENCYVALUE@@</Value>
+"RTN","C0CCCR0",404,0)
+ ;;</Frequency>
+"RTN","C0CCCR0",405,0)
+ ;;<Interval>
+"RTN","C0CCCR0",406,0)
+ ;;<Value>@@MEDINTERVALVALUE@@</Value>
+"RTN","C0CCCR0",407,0)
+ ;;<Units>
+"RTN","C0CCCR0",408,0)
+ ;;<Unit>@@MEDINTERVALUNIT@@</Unit>
+"RTN","C0CCCR0",409,0)
+ ;;</Units>
+"RTN","C0CCCR0",410,0)
+ ;;</Interval>
+"RTN","C0CCCR0",411,0)
+ ;;<Duration>
+"RTN","C0CCCR0",412,0)
+ ;;<Value>@@MEDDURATIONVALUE@@</Value>
+"RTN","C0CCCR0",413,0)
+ ;;<Units>
+"RTN","C0CCCR0",414,0)
+ ;;<Unit>@@MEDDURATIONUNIT@@</Unit>
+"RTN","C0CCCR0",415,0)
+ ;;</Units>
+"RTN","C0CCCR0",416,0)
+ ;;</Duration>
+"RTN","C0CCCR0",417,0)
+ ;;<Indication>
+"RTN","C0CCCR0",418,0)
+ ;;<PRNFlag>
+"RTN","C0CCCR0",419,0)
+ ;;<Text>@@MEDPRNFLAG@@</Text>
+"RTN","C0CCCR0",420,0)
+ ;;</PRNFlag>
+"RTN","C0CCCR0",421,0)
  ;;<Problem>
-"RTN","C0CCCR0",104,0)
- ;;<CCRDataObjectID>@@PROBLEMOBJECTID@@</CCRDataObjectID>
-"RTN","C0CCCR0",105,0)
+"RTN","C0CCCR0",422,0)
+ ;;<CCRDataObjectID>@@MEDPROBLEMOBJECTID@@</CCRDataObjectID>
+"RTN","C0CCCR0",423,0)
+ ;;<Type>
+"RTN","C0CCCR0",424,0)
+ ;;<Text>@@MEDPROBLEMTYPETXT@@</Text>
+"RTN","C0CCCR0",425,0)
+ ;;</Type>
+"RTN","C0CCCR0",426,0)
+ ;;<Description>
+"RTN","C0CCCR0",427,0)
+ ;;<Text>@@MEDPROBLEMDESCRIPTION@@</Text>
+"RTN","C0CCCR0",428,0)
+ ;;<Code>
+"RTN","C0CCCR0",429,0)
+ ;;<Value>@@MEDPROBLEMCODEVALUE@@</Value>
+"RTN","C0CCCR0",430,0)
+ ;;<CodingSystem>@@MEDPROBLEMCODINGSYSTEM@@</CodingSystem>
+"RTN","C0CCCR0",431,0)
+ ;;<Version>@@MEDPROBLEMCODINGVERSION@@</Version>
+"RTN","C0CCCR0",432,0)
+ ;;</Code>
+"RTN","C0CCCR0",433,0)
+ ;;</Description>
+"RTN","C0CCCR0",434,0)
+ ;;<Source>
+"RTN","C0CCCR0",435,0)
+ ;;<Actor>
+"RTN","C0CCCR0",436,0)
+ ;;<ActorID>@@MEDPROBLEMSOURCEACTORID@@</ActorID>
+"RTN","C0CCCR0",437,0)
+ ;;</Actor>
+"RTN","C0CCCR0",438,0)
+ ;;</Source>
+"RTN","C0CCCR0",439,0)
+ ;;</Problem>
+"RTN","C0CCCR0",440,0)
+ ;;</Indication>
+"RTN","C0CCCR0",441,0)
+ ;;<StopIndicator>
+"RTN","C0CCCR0",442,0)
+ ;;<Text>@@MEDSTOPINDICATOR@@</Text>
+"RTN","C0CCCR0",443,0)
+ ;;</StopIndicator>
+"RTN","C0CCCR0",444,0)
+ ;;<DirectionSequenceModifier>@@MEDDIRSEQ@@</DirectionSequenceModifier>
+"RTN","C0CCCR0",445,0)
+ ;;<MultipleDirectionModifier>
+"RTN","C0CCCR0",446,0)
+ ;;<Text>@@MEDMULDIRMOD@@</Text>
+"RTN","C0CCCR0",447,0)
+ ;;</MultipleDirectionModifier>
+"RTN","C0CCCR0",448,0)
+ ;;</Direction>
+"RTN","C0CCCR0",449,0)
+ ;;</Directions>
+"RTN","C0CCCR0",450,0)
+ ;;<PatientInstructions>
+"RTN","C0CCCR0",451,0)
+ ;;<Instruction>
+"RTN","C0CCCR0",452,0)
+ ;;<Text>@@MEDPTINSTRUCTIONS@@</Text>
+"RTN","C0CCCR0",453,0)
+ ;;</Instruction>
+"RTN","C0CCCR0",454,0)
+ ;;</PatientInstructions>
+"RTN","C0CCCR0",455,0)
+ ;;<FullfillmentInstructions>
+"RTN","C0CCCR0",456,0)
+ ;;<Text>@@MEDFULLFILLMENTINSTRUCTIONS@@</Text>
+"RTN","C0CCCR0",457,0)
+ ;;</FullfillmentInstructions>
+"RTN","C0CCCR0",458,0)
+ ;;<Refills>
+"RTN","C0CCCR0",459,0)
+ ;;<Refill>
+"RTN","C0CCCR0",460,0)
+ ;;<Number>@@MEDRFNO@@</Number>
+"RTN","C0CCCR0",461,0)
+ ;;</Refill>
+"RTN","C0CCCR0",462,0)
+ ;;</Refills>
+"RTN","C0CCCR0",463,0)
+ ;;</Medication>
+"RTN","C0CCCR0",464,0)
+ ;;</Medications>
+"RTN","C0CCCR0",465,0)
+ ;;<VitalSigns>
+"RTN","C0CCCR0",466,0)
+ ;;<Result>
+"RTN","C0CCCR0",467,0)
+ ;;<CCRDataObjectID>@@VITALSIGNSDATAOBJECTID@@</CCRDataObjectID>
+"RTN","C0CCCR0",468,0)
  ;;<DateTime>
-"RTN","C0CCCR0",106,0)
- ;;<ExactDateTime>@@PROBLEMDATEMOD@@</ExactDateTime>
-"RTN","C0CCCR0",107,0)
+"RTN","C0CCCR0",469,0)
+ ;;<Type>
+"RTN","C0CCCR0",470,0)
+ ;;<Text>@@VITALSIGNSDATETIMETYPETEXT@@</Text>
+"RTN","C0CCCR0",471,0)
+ ;;</Type>
+"RTN","C0CCCR0",472,0)
+ ;;<ExactDateTime>@@VITALSIGNSEXACTDATETIME@@</ExactDateTime>
+"RTN","C0CCCR0",473,0)
  ;;</DateTime>
-"RTN","C0CCCR0",108,0)
+"RTN","C0CCCR0",474,0)
+ ;;<Description>
+"RTN","C0CCCR0",475,0)
+ ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
+"RTN","C0CCCR0",476,0)
+ ;;</Description>
+"RTN","C0CCCR0",477,0)
+ ;;<Source>
+"RTN","C0CCCR0",478,0)
+ ;;<Actor>
+"RTN","C0CCCR0",479,0)
+ ;;<ActorID>@@VITALSIGNSSOURCEACTORID@@</ActorID>
+"RTN","C0CCCR0",480,0)
+ ;;</Actor>
+"RTN","C0CCCR0",481,0)
+ ;;</Source>
+"RTN","C0CCCR0",482,0)
+ ;;<Test>
+"RTN","C0CCCR0",483,0)
+ ;;<CCRDataObjectID>@@VITALSIGNSTESTOBJECTID@@</CCRDataObjectID>
+"RTN","C0CCCR0",484,0)
  ;;<Type>
-"RTN","C0CCCR0",109,0)
- ;;<Text>Problem</Text>
-"RTN","C0CCCR0",110,0)
+"RTN","C0CCCR0",485,0)
+ ;;<Text>@@VITALSIGNSTESTTYPETEXT@@</Text>
+"RTN","C0CCCR0",486,0)
  ;;</Type>
-"RTN","C0CCCR0",111,0)
+"RTN","C0CCCR0",487,0)
  ;;<Description>
-"RTN","C0CCCR0",112,0)
- ;;<Text>@@PROBLEMDESCRIPTION@@</Text>
-"RTN","C0CCCR0",113,0)
+"RTN","C0CCCR0",488,0)
+ ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
+"RTN","C0CCCR0",489,0)
  ;;<Code>
-"RTN","C0CCCR0",114,0)
- ;;<Value>@@PROBLEMCODEVALUE@@</Value>
-"RTN","C0CCCR0",115,0)
- ;;<CodingSystem>ICD9CM</CodingSystem>
-"RTN","C0CCCR0",116,0)
- ;;<Version>@@PROBLEMCODINGVERSION@@</Version>
-"RTN","C0CCCR0",117,0)
+"RTN","C0CCCR0",490,0)
+ ;;<Value>@@VITALSIGNSDESCCODEVALUE@@</Value>
+"RTN","C0CCCR0",491,0)
+ ;;<CodingSystem>@@VITALSIGNSDESCCODINGSYSTEM@@</CodingSystem>
+"RTN","C0CCCR0",492,0)
+ ;;<Version>@@VITALSIGNSCODEVERSION@@</Version>
+"RTN","C0CCCR0",493,0)
  ;;</Code>
-"RTN","C0CCCR0",118,0)
+"RTN","C0CCCR0",494,0)
  ;;</Description>
-"RTN","C0CCCR0",119,0)
+"RTN","C0CCCR0",495,0)
+ ;;<Source>
+"RTN","C0CCCR0",496,0)
+ ;;<Actor>
+"RTN","C0CCCR0",497,0)
+ ;;<ActorID>@@VITALSIGNSTESTSOURCEACTORID@@</ActorID>
+"RTN","C0CCCR0",498,0)
+ ;;</Actor>
+"RTN","C0CCCR0",499,0)
+ ;;</Source>
+"RTN","C0CCCR0",500,0)
+ ;;<TestResult>
+"RTN","C0CCCR0",501,0)
+ ;;<Value>@@VITALSIGNSTESTRESULTVALUE@@</Value>
+"RTN","C0CCCR0",502,0)
+ ;;<Units>
+"RTN","C0CCCR0",503,0)
+ ;;<Unit>@@VITALSIGNSTESTRESULTUNIT@@</Unit>
+"RTN","C0CCCR0",504,0)
+ ;;</Units>
+"RTN","C0CCCR0",505,0)
+ ;;</TestResult>
+"RTN","C0CCCR0",506,0)
+ ;;</Test>
+"RTN","C0CCCR0",507,0)
+ ;;</Result>
+"RTN","C0CCCR0",508,0)
+ ;;</VitalSigns>
+"RTN","C0CCCR0",509,0)
+ ;;<Results>
+"RTN","C0CCCR0",510,0)
+ ;;<Result>
+"RTN","C0CCCR0",511,0)
+ ;;<CCRDataObjectID>@@RESULTOBJECTID@@</CCRDataObjectID>
+"RTN","C0CCCR0",512,0)
+ ;;<DateTime>
+"RTN","C0CCCR0",513,0)
+ ;;<Type>
+"RTN","C0CCCR0",514,0)
+ ;;<Text>Assessment Time</Text>
+"RTN","C0CCCR0",515,0)
+ ;;</Type>
+"RTN","C0CCCR0",516,0)
+ ;;<ExactDateTime>@@RESULTASSESSMENTDATETIME@@</ExactDateTime>
+"RTN","C0CCCR0",517,0)
+ ;;</DateTime>
+"RTN","C0CCCR0",518,0)
+ ;;<Description>
+"RTN","C0CCCR0",519,0)
+ ;;<Text>@@RESULTDESCRIPTIONTEXT@@</Text>
+"RTN","C0CCCR0",520,0)
+ ;;<Code>
+"RTN","C0CCCR0",521,0)
+ ;;<Value>@@RESULTCODE@@</Value>
+"RTN","C0CCCR0",522,0)
+ ;;<CodingSystem>@@RESULTCODINGSYSTEM@@</CodingSystem>
+"RTN","C0CCCR0",523,0)
+ ;;</Code>
+"RTN","C0CCCR0",524,0)
+ ;;</Description>
+"RTN","C0CCCR0",525,0)
  ;;<Status>
-"RTN","C0CCCR0",120,0)
- ;;<Text>@@PROBLEMSTATUS@@</Text>
-"RTN","C0CCCR0",121,0)
+"RTN","C0CCCR0",526,0)
+ ;;<Text>@@RESULTSTATUS@@</Text>
+"RTN","C0CCCR0",527,0)
  ;;</Status>
-"RTN","C0CCCR0",122,0)
+"RTN","C0CCCR0",528,0)
  ;;<Source>
-"RTN","C0CCCR0",123,0)
+"RTN","C0CCCR0",529,0)
  ;;<Actor>
-"RTN","C0CCCR0",124,0)
- ;;<ActorID>@@PROBLEMSOURCEACTORID@@</ActorID>
-"RTN","C0CCCR0",125,0)
+"RTN","C0CCCR0",530,0)
+ ;;<ActorID>@@RESULTSOURCEACTORID@@</ActorID>
+"RTN","C0CCCR0",531,0)
  ;;</Actor>
-"RTN","C0CCCR0",126,0)
+"RTN","C0CCCR0",532,0)
  ;;</Source>
-"RTN","C0CCCR0",127,0)
- ;;</Problem>
-"RTN","C0CCCR0",128,0)
- ;;</Problems>
-"RTN","C0CCCR0",129,0)
- ;;<Immunizations>
-"RTN","C0CCCR0",130,0)
- ;;<Immunization>
-"RTN","C0CCCR0",131,0)
- ;;<CCRDataObjectID>@@IMMUNEOBJECTID@@</CCRDataObjectID>
-"RTN","C0CCCR0",132,0)
+"RTN","C0CCCR0",533,0)
+ ;;<Test>
+"RTN","C0CCCR0",534,0)
+ ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
+"RTN","C0CCCR0",535,0)
  ;;<DateTime>
-"RTN","C0CCCR0",133,0)
+"RTN","C0CCCR0",536,0)
  ;;<Type>
-"RTN","C0CCCR0",134,0)
- ;;<Text>@@IMMUNEDATETIMETYPETEXT@@</Text>
-"RTN","C0CCCR0",135,0)
+"RTN","C0CCCR0",537,0)
+ ;;<Text>Assessment Time</Text>
+"RTN","C0CCCR0",538,0)
  ;;</Type>
-"RTN","C0CCCR0",136,0)
- ;;<ExactDateTime>@@IMMUNEDATETIME@@</ExactDateTime>
-"RTN","C0CCCR0",137,0)
+"RTN","C0CCCR0",539,0)
+ ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
+"RTN","C0CCCR0",540,0)
  ;;</DateTime>
-"RTN","C0CCCR0",138,0)
+"RTN","C0CCCR0",541,0)
+ ;;<Description>
+"RTN","C0CCCR0",542,0)
+ ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
+"RTN","C0CCCR0",543,0)
+ ;;<Code>
+"RTN","C0CCCR0",544,0)
+ ;;<Value>@@RESULTTESTCODEVALUE@@</Value>
+"RTN","C0CCCR0",545,0)
+ ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
+"RTN","C0CCCR0",546,0)
+ ;;</Code>
+"RTN","C0CCCR0",547,0)
+ ;;</Description>
+"RTN","C0CCCR0",548,0)
+ ;;<Status>
+"RTN","C0CCCR0",549,0)
+ ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
+"RTN","C0CCCR0",550,0)
+ ;;</Status>
+"RTN","C0CCCR0",551,0)
  ;;<Source>
-"RTN","C0CCCR0",139,0)
+"RTN","C0CCCR0",552,0)
  ;;<Actor>
-"RTN","C0CCCR0",140,0)
- ;;<ActorID>@@IMMUNESOURCEACTORID@@</ActorID>
-"RTN","C0CCCR0",141,0)
+"RTN","C0CCCR0",553,0)
+ ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
+"RTN","C0CCCR0",554,0)
  ;;</Actor>
-"RTN","C0CCCR0",142,0)
+"RTN","C0CCCR0",555,0)
  ;;</Source>
-"RTN","C0CCCR0",143,0)
- ;;<Product>
-"RTN","C0CCCR0",144,0)
- ;;<ProductName>
-"RTN","C0CCCR0",145,0)
- ;;<Text>@@IMMUNEPRODUCTNAMETEXT@@</Text>
-"RTN","C0CCCR0",146,0)
+"RTN","C0CCCR0",556,0)
+ ;;<TestResult>
+"RTN","C0CCCR0",557,0)
+ ;;<Value>@@RESULTTESTVALUE@@</Value>
+"RTN","C0CCCR0",558,0)
+ ;;<Units>
+"RTN","C0CCCR0",559,0)
+ ;;<Unit>@@RESULTTESTUNITS@@</Unit>
+"RTN","C0CCCR0",560,0)
+ ;;</Units>
+"RTN","C0CCCR0",561,0)
+ ;;</TestResult>
+"RTN","C0CCCR0",562,0)
+ ;;<NormalResult>
+"RTN","C0CCCR0",563,0)
+ ;;<Normal>
+"RTN","C0CCCR0",564,0)
+ ;;<Description>
+"RTN","C0CCCR0",565,0)
+ ;;<Text>@@RESULTTESTNORMALDESCTEXT@@</Text>
+"RTN","C0CCCR0",566,0)
+ ;;</Description>
+"RTN","C0CCCR0",567,0)
+ ;;<Source>
+"RTN","C0CCCR0",568,0)
+ ;;<Actor>
+"RTN","C0CCCR0",569,0)
+ ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
+"RTN","C0CCCR0",570,0)
+ ;;</Actor>
+"RTN","C0CCCR0",571,0)
+ ;;</Source>
+"RTN","C0CCCR0",572,0)
+ ;;</Normal>
+"RTN","C0CCCR0",573,0)
+ ;;</NormalResult>
+"RTN","C0CCCR0",574,0)
+ ;;<Flag>
+"RTN","C0CCCR0",575,0)
+ ;;<Text>@@RESULTTESTFLAG@@</Text>
+"RTN","C0CCCR0",576,0)
+ ;;</Flag>
+"RTN","C0CCCR0",577,0)
+ ;;</Test>
+"RTN","C0CCCR0",578,0)
+ ;;</Result>
+"RTN","C0CCCR0",579,0)
+ ;;</Results>
+"RTN","C0CCCR0",580,0)
+ ;;<Procedures>
+"RTN","C0CCCR0",581,0)
+ ;;<Procedure>
+"RTN","C0CCCR0",582,0)
+ ;;<CCRDataObjectID>@@PROCOBJECTID@@</CCRDataObjectID>
+"RTN","C0CCCR0",583,0)
+ ;;<DateTime>
+"RTN","C0CCCR0",584,0)
+ ;;<Type>
+"RTN","C0CCCR0",585,0)
+ ;;<Text>@@PROCDATETEXT@@</Text>
+"RTN","C0CCCR0",586,0)
+ ;;</Type>
+"RTN","C0CCCR0",587,0)
+ ;;<ExactDateTime>@@PROCDATETIME@@</ExactDateTime>
+"RTN","C0CCCR0",588,0)
+ ;;</DateTime>
+"RTN","C0CCCR0",589,0)
+ ;;<Description>
+"RTN","C0CCCR0",590,0)
+ ;;<Text>@@PROCDESCTEXT@@</Text>
+"RTN","C0CCCR0",591,0)
+ ;;<ObjectAttribute>
+"RTN","C0CCCR0",592,0)
+ ;;<Attribute>@@PROCDESCOBJATTR@@</Attribute>
+"RTN","C0CCCR0",593,0)
+ ;;<AttributeValue>
+"RTN","C0CCCR0",594,0)
+ ;;<Value>@@PROCDESCOBJATTRVAL@@</Value>
+"RTN","C0CCCR0",595,0)
  ;;<Code>
-"RTN","C0CCCR0",147,0)
- ;;<Value>@@IMMUNEPRODUCTCODE@@</Value>
-"RTN","C0CCCR0",148,0)
- ;;<CodingSystem>@@IMMUNEPRODUCTCODESYSTEM@@</CodingSystem>
-"RTN","C0CCCR0",149,0)
+"RTN","C0CCCR0",596,0)
+ ;;<Value>@@PROCDESCOBJATTRCODE@@</Value>
+"RTN","C0CCCR0",597,0)
+ ;;<CodingSystem>@@PROCDESCOBJATTRCODESYS@@</CodingSystem>
+"RTN","C0CCCR0",598,0)
  ;;</Code>
-"RTN","C0CCCR0",150,0)
- ;;</ProductName>
-"RTN","C0CCCR0",151,0)
- ;;</Product>
-"RTN","C0CCCR0",152,0)
- ;;</Immunization>
-"RTN","C0CCCR0",153,0)
- ;;</Immunizations>
-"RTN","C0CCCR0",154,0)
- ;;<FamilyHistory>
-"RTN","C0CCCR0",155,0)
- ;;<FamilyProblemHistory>
-"RTN","C0CCCR0",156,0)
- ;;<CCRDataObjectID>@@FAMILYHISTORYOBJECTID@@</CCRDataObjectID>
-"RTN","C0CCCR0",157,0)
+"RTN","C0CCCR0",599,0)
+ ;;</AttributeValue>
+"RTN","C0CCCR0",600,0)
+ ;;</ObjectAttribute>
+"RTN","C0CCCR0",601,0)
+ ;;<Code>
+"RTN","C0CCCR0",602,0)
+ ;;<Value>@@PROCCODE@@</Value>
+"RTN","C0CCCR0",603,0)
+ ;;<CodingSystem>@@PROCCODESYS@@</CodingSystem>
+"RTN","C0CCCR0",604,0)
+ ;;</Code>
+"RTN","C0CCCR0",605,0)
+ ;;</Description>
+"RTN","C0CCCR0",606,0)
+ ;;<Status>
+"RTN","C0CCCR0",607,0)
+ ;;<Text>@@PROCSTATUS@@</Text>
+"RTN","C0CCCR0",608,0)
+ ;;</Status>
+"RTN","C0CCCR0",609,0)
  ;;<Source>
-"RTN","C0CCCR0",158,0)
+"RTN","C0CCCR0",610,0)
  ;;<Actor>
-"RTN","C0CCCR0",159,0)
- ;;<ActorID>@@FAMILYHISTORYACTORID@@</ActorID>
-"RTN","C0CCCR0",160,0)
+"RTN","C0CCCR0",611,0)
+ ;;<ActorID>@@PROCACTOROBJID@@</ActorID>
+"RTN","C0CCCR0",612,0)
  ;;</Actor>
-"RTN","C0CCCR0",161,0)
+"RTN","C0CCCR0",613,0)
  ;;</Source>
-"RTN","C0CCCR0",162,0)
- ;;<FamilyMember>
-"RTN","C0CCCR0",163,0)
- ;;<ActorID>@@FAMILYMEMBERACTORID@@</ActorID>
-"RTN","C0CCCR0",164,0)
+"RTN","C0CCCR0",614,0)
+ ;;<InternalCCRLink>
+"RTN","C0CCCR0",615,0)
+ ;;<LinkID>@@PROCLINKID@@</LinkID>
+"RTN","C0CCCR0",616,0)
+ ;;<LinkRelationship>@@PROCLINKREL@@</LinkRelationship>
+"RTN","C0CCCR0",617,0)
+ ;;</InternalCCRLink>
+"RTN","C0CCCR0",618,0)
+ ;;</Procedure>
+"RTN","C0CCCR0",619,0)
+ ;;</Procedures>
+"RTN","C0CCCR0",620,0)
+ ;;<Encounters>
+"RTN","C0CCCR0",621,0)
+ ;;<Encounter>
+"RTN","C0CCCR0",622,0)
+ ;;<CCRDataObjectID>@@ENCOBJECTID@@</CCRDataObjectID>
+"RTN","C0CCCR0",623,0)
+ ;;<DateTime>
+"RTN","C0CCCR0",624,0)
+ ;;<ExactDateTime>@@ENCDATETIME@@</ExactDateTime>
+"RTN","C0CCCR0",625,0)
+ ;;</DateTime>
+"RTN","C0CCCR0",626,0)
+ ;;<Type>
+"RTN","C0CCCR0",627,0)
+ ;;<Text>@@ENCTYPETXT@@</Text>
+"RTN","C0CCCR0",628,0)
+ ;;<Code>
+"RTN","C0CCCR0",629,0)
+ ;;<Value>@@ENCTYPECODE@@</Value>
+"RTN","C0CCCR0",630,0)
+ ;;<CodingSystem>@@ENCTYPECODESYS@@</CodingSystem>
+"RTN","C0CCCR0",631,0)
+ ;;</Code>
+"RTN","C0CCCR0",632,0)
+ ;;</Type>
+"RTN","C0CCCR0",633,0)
+ ;;<Description>
+"RTN","C0CCCR0",634,0)
+ ;;<Text>@@ENCDESCTXT@@</Text>
+"RTN","C0CCCR0",635,0)
+ ;;<Code>
+"RTN","C0CCCR0",636,0)
+ ;;<Value>@@ENCDESCCODE@@</Value>
+"RTN","C0CCCR0",637,0)
+ ;;<CodingSystem>@@ENCDESCCODESYS@@</CodingSystem>
+"RTN","C0CCCR0",638,0)
+ ;;</Code>
+"RTN","C0CCCR0",639,0)
+ ;;</Description>
+"RTN","C0CCCR0",640,0)
+ ;;<Location>
+"RTN","C0CCCR0",641,0)
+ ;;<Actor>
+"RTN","C0CCCR0",642,0)
+ ;;<ActorID>@@ENCLOCACTORID@@</ActorID>
+"RTN","C0CCCR0",643,0)
+ ;;</Actor>
+"RTN","C0CCCR0",644,0)
+ ;;</Location>
+"RTN","C0CCCR0",645,0)
+ ;;<Practioner>
+"RTN","C0CCCR0",646,0)
+ ;;<Actor>
+"RTN","C0CCCR0",647,0)
+ ;;<ActorID>@@ENCPRVACTORID@@</ActorID>
+"RTN","C0CCCR0",648,0)
+ ;;</Actor>
+"RTN","C0CCCR0",649,0)
+ ;;</Practioner>
+"RTN","C0CCCR0",650,0)
+ ;;<Indication>
+"RTN","C0CCCR0",651,0)
+ ;;<Text>@@ENCINDTXT@@</Text>
+"RTN","C0CCCR0",652,0)
+ ;;<Code>
+"RTN","C0CCCR0",653,0)
+ ;;<Value>@@ENCINDCODE@@</Value>
+"RTN","C0CCCR0",654,0)
+ ;;<CodingSystem>@@ENCINDCODESYS@@</CodingSystem>
+"RTN","C0CCCR0",655,0)
+ ;;</Code>
+"RTN","C0CCCR0",656,0)
+ ;;</Indication>
+"RTN","C0CCCR0",657,0)
+ ;;<Source>
+"RTN","C0CCCR0",658,0)
+ ;;<Actor>
+"RTN","C0CCCR0",659,0)
+ ;;<ActorID>@@ENCACTORID@@</ActorID>
+"RTN","C0CCCR0",660,0)
+ ;;</Actor>
+"RTN","C0CCCR0",661,0)
+ ;;</Source>
+"RTN","C0CCCR0",662,0)
+ ;;<CommentID>@@ENCCOMMENTID@@</CommentID>
+"RTN","C0CCCR0",663,0)
+ ;;</Encounter>
+"RTN","C0CCCR0",664,0)
+ ;;</Encounters>
+"RTN","C0CCCR0",665,0)
+ ;;<HealthCareProviders>
+"RTN","C0CCCR0",666,0)
+ ;;<Provider>
+"RTN","C0CCCR0",667,0)
+ ;;<ActorID>AA0005</ActorID>
+"RTN","C0CCCR0",668,0)
  ;;<ActorRole>
-"RTN","C0CCCR0",165,0)
- ;;<Text>@@FAMILYMEMBERACTORROLETEXT@@</Text>
-"RTN","C0CCCR0",166,0)
+"RTN","C0CCCR0",669,0)
+ ;;<Text>Primary Provider</Text>
+"RTN","C0CCCR0",670,0)
  ;;</ActorRole>
-"RTN","C0CCCR0",167,0)
+"RTN","C0CCCR0",671,0)
+ ;;</Provider>
+"RTN","C0CCCR0",672,0)
+ ;;</HealthCareProviders>
+"RTN","C0CCCR0",673,0)
+ ;;</Body>
+"RTN","C0CCCR0",674,0)
+ ;;<Actors>
+"RTN","C0CCCR0",675,0)
+ ;;<ACTOR-PATIENT>
+"RTN","C0CCCR0",676,0)
+ ;;<Actor>
+"RTN","C0CCCR0",677,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","C0CCCR0",678,0)
+ ;;<Person>
+"RTN","C0CCCR0",679,0)
+ ;;<Name>
+"RTN","C0CCCR0",680,0)
+ ;;<CurrentName>
+"RTN","C0CCCR0",681,0)
+ ;;<Given>@@ACTORGIVENNAME@@</Given>
+"RTN","C0CCCR0",682,0)
+ ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
+"RTN","C0CCCR0",683,0)
+ ;;<Family>@@ACTORFAMILYNAME@@</Family>
+"RTN","C0CCCR0",684,0)
+ ;;</CurrentName>
+"RTN","C0CCCR0",685,0)
+ ;;</Name>
+"RTN","C0CCCR0",686,0)
+ ;;<DateOfBirth>
+"RTN","C0CCCR0",687,0)
+ ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime>
+"RTN","C0CCCR0",688,0)
+ ;;</DateOfBirth>
+"RTN","C0CCCR0",689,0)
+ ;;<Gender>
+"RTN","C0CCCR0",690,0)
+ ;;<Text>@@ACTORGENDER@@</Text>
+"RTN","C0CCCR0",691,0)
+ ;;<Code>
+"RTN","C0CCCR0",692,0)
+ ;;<Value>@@ACTORGENDERCODE@@</Value>
+"RTN","C0CCCR0",693,0)
+ ;;<CodingSystem>HL7 AdministrativeGender</CodingSystem>
+"RTN","C0CCCR0",694,0)
+ ;;</Code>
+"RTN","C0CCCR0",695,0)
+ ;;</Gender>
+"RTN","C0CCCR0",696,0)
+ ;;</Person>
+"RTN","C0CCCR0",697,0)
+ ;;<IDs>
+"RTN","C0CCCR0",698,0)
+ ;;<Type>
+"RTN","C0CCCR0",699,0)
+ ;;<Text>@@ACTORSSNTEXT@@</Text>
+"RTN","C0CCCR0",700,0)
+ ;;</Type>
+"RTN","C0CCCR0",701,0)
+ ;;<ID>@@ACTORSSN@@</ID>
+"RTN","C0CCCR0",702,0)
  ;;<Source>
-"RTN","C0CCCR0",168,0)
+"RTN","C0CCCR0",703,0)
  ;;<Actor>
-"RTN","C0CCCR0",169,0)
- ;;<ActorID>@@FAMILYMEMBERSOURCACTORID@@</ActorID>
-"RTN","C0CCCR0",170,0)
+"RTN","C0CCCR0",704,0)
+ ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID>
+"RTN","C0CCCR0",705,0)
  ;;</Actor>
-"RTN","C0CCCR0",171,0)
+"RTN","C0CCCR0",706,0)
  ;;</Source>
-"RTN","C0CCCR0",172,0)
- ;;</FamilyMember>
-"RTN","C0CCCR0",173,0)
- ;;<Problem>
-"RTN","C0CCCR0",174,0)
+"RTN","C0CCCR0",707,0)
+ ;;</IDs>
+"RTN","C0CCCR0",708,0)
+ ;;<Address>
+"RTN","C0CCCR0",709,0)
  ;;<Type>
-"RTN","C0CCCR0",175,0)
- ;;<Text>Problem</Text>
-"RTN","C0CCCR0",176,0)
+"RTN","C0CCCR0",710,0)
+ ;;<Text>@@ACTORADDRESSTYPE@@</Text>
+"RTN","C0CCCR0",711,0)
  ;;</Type>
-"RTN","C0CCCR0",177,0)
+"RTN","C0CCCR0",712,0)
+ ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
+"RTN","C0CCCR0",713,0)
+ ;;<Line2>@@ACTORADDRESSLINE2@@</Line2>
+"RTN","C0CCCR0",714,0)
+ ;;<City>@@ACTORADDRESSCITY@@</City>
+"RTN","C0CCCR0",715,0)
+ ;;<State>@@ACTORADDRESSSTATE@@</State>
+"RTN","C0CCCR0",716,0)
+ ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode>
+"RTN","C0CCCR0",717,0)
+ ;;</Address>
+"RTN","C0CCCR0",718,0)
+ ;;<Telephone>
+"RTN","C0CCCR0",719,0)
+ ;;<Value>@@ACTORRESTEL@@</Value>
+"RTN","C0CCCR0",720,0)
+ ;;<Type>
+"RTN","C0CCCR0",721,0)
+ ;;<Text>@@ACTORRESTELTEXT@@</Text>
+"RTN","C0CCCR0",722,0)
+ ;;</Type>
+"RTN","C0CCCR0",723,0)
+ ;;</Telephone>
+"RTN","C0CCCR0",724,0)
+ ;;<Telephone>
+"RTN","C0CCCR0",725,0)
+ ;;<Value>@@ACTORWORKTEL@@</Value>
+"RTN","C0CCCR0",726,0)
+ ;;<Type>
+"RTN","C0CCCR0",727,0)
+ ;;<Text>@@ACTORWORKTELTEXT@@</Text>
+"RTN","C0CCCR0",728,0)
+ ;;</Type>
+"RTN","C0CCCR0",729,0)
+ ;;</Telephone>
+"RTN","C0CCCR0",730,0)
+ ;;<Telephone>
+"RTN","C0CCCR0",731,0)
+ ;;<Value>@@ACTORCELLTEL@@</Value>
+"RTN","C0CCCR0",732,0)
+ ;;<Type>
+"RTN","C0CCCR0",733,0)
+ ;;<Text>@@ACTORCELLTELTEXT@@</Text>
+"RTN","C0CCCR0",734,0)
+ ;;</Type>
+"RTN","C0CCCR0",735,0)
+ ;;</Telephone>
+"RTN","C0CCCR0",736,0)
+ ;;<EMail>
+"RTN","C0CCCR0",737,0)
+ ;;<Value>@@ACTOREMAIL@@</Value>
+"RTN","C0CCCR0",738,0)
+ ;;</EMail>
+"RTN","C0CCCR0",739,0)
+ ;;<Source>
+"RTN","C0CCCR0",740,0)
+ ;;<Actor>
+"RTN","C0CCCR0",741,0)
+ ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID>
+"RTN","C0CCCR0",742,0)
+ ;;</Actor>
+"RTN","C0CCCR0",743,0)
+ ;;</Source>
+"RTN","C0CCCR0",744,0)
+ ;;</Actor>
+"RTN","C0CCCR0",745,0)
+ ;;</ACTOR-PATIENT>
+"RTN","C0CCCR0",746,0)
+ ;;<ACTOR-SYSTEM>
+"RTN","C0CCCR0",747,0)
+ ;;<Actor>
+"RTN","C0CCCR0",748,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","C0CCCR0",749,0)
+ ;;<InformationSystem>
+"RTN","C0CCCR0",750,0)
+ ;;<Name>@@ACTORINFOSYSNAME@@</Name>
+"RTN","C0CCCR0",751,0)
+ ;;<Version>@@ACTORINFOSYSVER@@</Version>
+"RTN","C0CCCR0",752,0)
+ ;;</InformationSystem>
+"RTN","C0CCCR0",753,0)
+ ;;<Source>
+"RTN","C0CCCR0",754,0)
+ ;;<Actor>
+"RTN","C0CCCR0",755,0)
+ ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID>
+"RTN","C0CCCR0",756,0)
+ ;;</Actor>
+"RTN","C0CCCR0",757,0)
+ ;;</Source>
+"RTN","C0CCCR0",758,0)
+ ;;</Actor>
+"RTN","C0CCCR0",759,0)
+ ;;</ACTOR-SYSTEM>
+"RTN","C0CCCR0",760,0)
+ ;;<ACTOR-NOK>
+"RTN","C0CCCR0",761,0)
+ ;;<Actor>
+"RTN","C0CCCR0",762,0)
+ ;;<ActorObjectID>AA0003</ActorObjectID>
+"RTN","C0CCCR0",763,0)
+ ;;<Person>
+"RTN","C0CCCR0",764,0)
+ ;;<Name>
+"RTN","C0CCCR0",765,0)
+ ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName>
+"RTN","C0CCCR0",766,0)
+ ;;</Name>
+"RTN","C0CCCR0",767,0)
+ ;;</Person>
+"RTN","C0CCCR0",768,0)
+ ;;<Relation>
+"RTN","C0CCCR0",769,0)
+ ;;<Text>@@ACTORRELATION@@</Text>
+"RTN","C0CCCR0",770,0)
+ ;;</Relation>
+"RTN","C0CCCR0",771,0)
+ ;;<Source>
+"RTN","C0CCCR0",772,0)
+ ;;<Actor>
+"RTN","C0CCCR0",773,0)
+ ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID>
+"RTN","C0CCCR0",774,0)
+ ;;</Actor>
+"RTN","C0CCCR0",775,0)
+ ;;</Source>
+"RTN","C0CCCR0",776,0)
+ ;;</Actor>
+"RTN","C0CCCR0",777,0)
+ ;;</ACTOR-NOK>
+"RTN","C0CCCR0",778,0)
+ ;;<ACTOR-PROVIDER>
+"RTN","C0CCCR0",779,0)
+ ;;<Actor>
+"RTN","C0CCCR0",780,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","C0CCCR0",781,0)
+ ;;<Person>
+"RTN","C0CCCR0",782,0)
+ ;;<Name>
+"RTN","C0CCCR0",783,0)
+ ;;<CurrentName>
+"RTN","C0CCCR0",784,0)
+ ;;<Given>@@ACTORGIVENNAME@@</Given>
+"RTN","C0CCCR0",785,0)
+ ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
+"RTN","C0CCCR0",786,0)
+ ;;<Family>@@ACTORFAMILYNAME@@</Family>
+"RTN","C0CCCR0",787,0)
+ ;;<Title>@@ACTORTITLE@@</Title>
+"RTN","C0CCCR0",788,0)
+ ;;</CurrentName>
+"RTN","C0CCCR0",789,0)
+ ;;</Name>
+"RTN","C0CCCR0",790,0)
+ ;;</Person>
+"RTN","C0CCCR0",791,0)
+ ;;<Specialty>
+"RTN","C0CCCR0",792,0)
+ ;;<Text>@@ACTORSPECIALITY@@</Text>
+"RTN","C0CCCR0",793,0)
+ ;;</Specialty>
+"RTN","C0CCCR0",794,0)
+ ;;<Address>
+"RTN","C0CCCR0",795,0)
+ ;;<Type>
+"RTN","C0CCCR0",796,0)
+ ;;<Text>@@ACTORADDRESSTYPE@@</Text>
+"RTN","C0CCCR0",797,0)
+ ;;</Type>
+"RTN","C0CCCR0",798,0)
+ ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
+"RTN","C0CCCR0",799,0)
+ ;;<City>@@ACTORADDRESSCITY@@</City>
+"RTN","C0CCCR0",800,0)
+ ;;<State>@@ACTORADDRESSSTATE@@</State>
+"RTN","C0CCCR0",801,0)
+ ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
+"RTN","C0CCCR0",802,0)
+ ;;</Address>
+"RTN","C0CCCR0",803,0)
+ ;;<Telephone>
+"RTN","C0CCCR0",804,0)
+ ;;<Value>@@ACTORTELEPHONE@@</Value>
+"RTN","C0CCCR0",805,0)
+ ;;<Type>
+"RTN","C0CCCR0",806,0)
+ ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
+"RTN","C0CCCR0",807,0)
+ ;;</Type>
+"RTN","C0CCCR0",808,0)
+ ;;</Telephone>
+"RTN","C0CCCR0",809,0)
+ ;;<Email>
+"RTN","C0CCCR0",810,0)
+ ;;<Value>@@ACTOREMAIL@@</Value>
+"RTN","C0CCCR0",811,0)
+ ;;</Email>
+"RTN","C0CCCR0",812,0)
+ ;;<Source>
+"RTN","C0CCCR0",813,0)
+ ;;<Actor>
+"RTN","C0CCCR0",814,0)
+ ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
+"RTN","C0CCCR0",815,0)
+ ;;</Actor>
+"RTN","C0CCCR0",816,0)
+ ;;</Source>
+"RTN","C0CCCR0",817,0)
+ ;;<InternalCCRLink>
+"RTN","C0CCCR0",818,0)
+ ;;<LinkID>@@ACTORORGLINK@@</LinkID>
+"RTN","C0CCCR0",819,0)
+ ;;<LinkRelationship>representedOrganization</LinkRelationship>
+"RTN","C0CCCR0",820,0)
+ ;;</InternalCCRLink>
+"RTN","C0CCCR0",821,0)
+ ;;</Actor>
+"RTN","C0CCCR0",822,0)
+ ;;</ACTOR-PROVIDER>
+"RTN","C0CCCR0",823,0)
+ ;;<ACTOR-ORG>
+"RTN","C0CCCR0",824,0)
+ ;;<Actor>
+"RTN","C0CCCR0",825,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","C0CCCR0",826,0)
+ ;;<Organization>
+"RTN","C0CCCR0",827,0)
+ ;;<Name>@@ORGANIZATIONNAME@@</Name>
+"RTN","C0CCCR0",828,0)
+ ;;</Organization>
+"RTN","C0CCCR0",829,0)
+ ;;<Address>
+"RTN","C0CCCR0",830,0)
+ ;;<Type>
+"RTN","C0CCCR0",831,0)
+ ;;<Text>@@ACTORADDRESSTYPE@@</Text>
+"RTN","C0CCCR0",832,0)
+ ;;</Type>
+"RTN","C0CCCR0",833,0)
+ ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
+"RTN","C0CCCR0",834,0)
+ ;;<City>@@ACTORADDRESSCITY@@</City>
+"RTN","C0CCCR0",835,0)
+ ;;<State>@@ACTORADDRESSSTATE@@</State>
+"RTN","C0CCCR0",836,0)
+ ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
+"RTN","C0CCCR0",837,0)
+ ;;</Address>
+"RTN","C0CCCR0",838,0)
+ ;;<Telephone>
+"RTN","C0CCCR0",839,0)
+ ;;<Value>@@ACTORTELEPHONE@@</Value>
+"RTN","C0CCCR0",840,0)
+ ;;<Type>
+"RTN","C0CCCR0",841,0)
+ ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
+"RTN","C0CCCR0",842,0)
+ ;;</Type>
+"RTN","C0CCCR0",843,0)
+ ;;</Telephone>
+"RTN","C0CCCR0",844,0)
+ ;;<Source>
+"RTN","C0CCCR0",845,0)
+ ;;<Actor>
+"RTN","C0CCCR0",846,0)
+ ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
+"RTN","C0CCCR0",847,0)
+ ;;</Actor>
+"RTN","C0CCCR0",848,0)
+ ;;</Source>
+"RTN","C0CCCR0",849,0)
+ ;;</Actor>
+"RTN","C0CCCR0",850,0)
+ ;;</ACTOR-ORG>
+"RTN","C0CCCR0",851,0)
+ ;;</Actors>
+"RTN","C0CCCR0",852,0)
+ ;;<Signatures>
+"RTN","C0CCCR0",853,0)
+ ;;<CCRSignature>
+"RTN","C0CCCR0",854,0)
+ ;;<SignatureObjectID>S0001</SignatureObjectID>
+"RTN","C0CCCR0",855,0)
+ ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>
+"RTN","C0CCCR0",856,0)
+ ;;<Source>
+"RTN","C0CCCR0",857,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","C0CCCR0",858,0)
+ ;;</Source>
+"RTN","C0CCCR0",859,0)
+ ;;<Signature>
+"RTN","C0CCCR0",860,0)
+ ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
+"RTN","C0CCCR0",861,0)
+ ;;<SignedInfo>
+"RTN","C0CCCR0",862,0)
+ ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>
+"RTN","C0CCCR0",863,0)
+ ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>
+"RTN","C0CCCR0",864,0)
+ ;;<Reference URI="">
+"RTN","C0CCCR0",865,0)
+ ;;<Transforms>
+"RTN","C0CCCR0",866,0)
+ ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>
+"RTN","C0CCCR0",867,0)
+ ;;</Transforms>
+"RTN","C0CCCR0",868,0)
+ ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>
+"RTN","C0CCCR0",869,0)
+ ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
+"RTN","C0CCCR0",870,0)
+ ;;</Reference>
+"RTN","C0CCCR0",871,0)
+ ;;</SignedInfo>
+"RTN","C0CCCR0",872,0)
+ ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>
+"RTN","C0CCCR0",873,0)
+ ;;<KeyInfo>
+"RTN","C0CCCR0",874,0)
+ ;;<KeyValue>
+"RTN","C0CCCR0",875,0)
+ ;;<RSAKeyValue>
+"RTN","C0CCCR0",876,0)
+ ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>
+"RTN","C0CCCR0",877,0)
+ ;;<Exponent>AQAB</Exponent>
+"RTN","C0CCCR0",878,0)
+ ;;</RSAKeyValue>
+"RTN","C0CCCR0",879,0)
+ ;;</KeyValue>
+"RTN","C0CCCR0",880,0)
+ ;;</KeyInfo>
+"RTN","C0CCCR0",881,0)
+ ;;</Signature>
+"RTN","C0CCCR0",882,0)
+ ;;</Signature>
+"RTN","C0CCCR0",883,0)
+ ;;</CCRSignature>
+"RTN","C0CCCR0",884,0)
+ ;;</Signatures>
+"RTN","C0CCCR0",885,0)
+ ;;<Comments>
+"RTN","C0CCCR0",886,0)
+ ;;<Comment>
+"RTN","C0CCCR0",887,0)
+ ;;<CommentObjectID>@@COMMENTOBJECTID@@</CommentObjectID>
+"RTN","C0CCCR0",888,0)
+ ;;<DateTime>
+"RTN","C0CCCR0",889,0)
+ ;;<ExactDateTime>@@CMTDATETIME@@</ExactDateTime>
+"RTN","C0CCCR0",890,0)
+ ;;</DateTime>
+"RTN","C0CCCR0",891,0)
  ;;<Description>
-"RTN","C0CCCR0",178,0)
- ;;<Text>@@FAMILYMEMBERPROBLEMDESCRIPTION@@</Text>
-"RTN","C0CCCR0",179,0)
- ;;<Code>
-"RTN","C0CCCR0",180,0)
- ;;<Value>@@FAMILYMEMBERPROBLEMCODE@@</Value>
-"RTN","C0CCCR0",181,0)
- ;;<CodingSystem>@@FAMILYMEMBERCODESYSTEM@@</CodingSystem>
-"RTN","C0CCCR0",182,0)
- ;;<Version>@@FAMILYMEMBERCODEVERSION@@</Version>
-"RTN","C0CCCR0",183,0)
- ;;</Code>
-"RTN","C0CCCR0",184,0)
+"RTN","C0CCCR0",892,0)
+ ;;<Text>
+"RTN","C0CCCR0",893,0)
+ ;;</Text>
+"RTN","C0CCCR0",894,0)
  ;;</Description>
-"RTN","C0CCCR0",185,0)
+"RTN","C0CCCR0",895,0)
  ;;<Source>
-"RTN","C0CCCR0",186,0)
+"RTN","C0CCCR0",896,0)
  ;;<Actor>
-"RTN","C0CCCR0",187,0)
- ;;<ActorID>@@FAMILYMEMBERPROBLEMSOURCEID@@</ActorID>
-"RTN","C0CCCR0",188,0)
+"RTN","C0CCCR0",897,0)
+ ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
+"RTN","C0CCCR0",898,0)
  ;;</Actor>
-"RTN","C0CCCR0",189,0)
+"RTN","C0CCCR0",899,0)
  ;;</Source>
-"RTN","C0CCCR0",190,0)
- ;;</Problem>
-"RTN","C0CCCR0",191,0)
- ;;</FamilyProblemHistory>
-"RTN","C0CCCR0",192,0)
- ;;</FamilyHistory>
-"RTN","C0CCCR0",193,0)
- ;;<SocialHistory>
-"RTN","C0CCCR0",194,0)
- ;;<SocialHistoryElement>
-"RTN","C0CCCR0",195,0)
- ;;<CCRDataObjectID>@@SOCIALHISTORYOBJECTID@@</CCRDataObjectID>
-"RTN","C0CCCR0",196,0)
- ;;<Type>
-"RTN","C0CCCR0",197,0)
- ;;<Text>@@SOCIALHISTORYTYPETEXT@@</Text>
-"RTN","C0CCCR0",198,0)
- ;;</Type>
-"RTN","C0CCCR0",199,0)
- ;;<Description>
-"RTN","C0CCCR0",200,0)
- ;;<Text>@@SOCIALHISTORYDESCRIPTIONTEXT@@</Text>
-"RTN","C0CCCR0",201,0)
- ;;</Description>
-"RTN","C0CCCR0",202,0)
- ;;<Source>
-"RTN","C0CCCR0",203,0)
- ;;<Actor>
-"RTN","C0CCCR0",204,0)
- ;;<ActorID>@@SOCIALHISTORYSOURCACTORID@@</ActorID>
-"RTN","C0CCCR0",205,0)
- ;;</Actor>
-"RTN","C0CCCR0",206,0)
- ;;</Source>
-"RTN","C0CCCR0",207,0)
- ;;</SocialHistoryElement>
-"RTN","C0CCCR0",208,0)
- ;;<SocialHistoryElement>
-"RTN","C0CCCR0",209,0)
- ;;<CCRDataObjectID>BB0005</CCRDataObjectID>
-"RTN","C0CCCR0",210,0)
- ;;<Type>
-"RTN","C0CCCR0",211,0)
- ;;<Text>Ethnic Origin</Text>
-"RTN","C0CCCR0",212,0)
- ;;</Type>
-"RTN","C0CCCR0",213,0)
- ;;<Description>
-"RTN","C0CCCR0",214,0)
- ;;<Text>Not Hispanic or Latino</Text>
-"RTN","C0CCCR0",215,0)
- ;;</Description>
-"RTN","C0CCCR0",216,0)
- ;;<Source>
-"RTN","C0CCCR0",217,0)
- ;;<Actor>
-"RTN","C0CCCR0",218,0)
- ;;<ActorID>AA0001</ActorID>
-"RTN","C0CCCR0",219,0)
- ;;</Actor>
-"RTN","C0CCCR0",220,0)
- ;;</Source>
-"RTN","C0CCCR0",221,0)
- ;;</SocialHistoryElement>
-"RTN","C0CCCR0",222,0)
- ;;<SocialHistoryElement>
-"RTN","C0CCCR0",223,0)
- ;;<CCRDataObjectID>BB0006</CCRDataObjectID>
-"RTN","C0CCCR0",224,0)
- ;;<Type>
-"RTN","C0CCCR0",225,0)
- ;;<Text>Race</Text>
-"RTN","C0CCCR0",226,0)
- ;;</Type>
-"RTN","C0CCCR0",227,0)
- ;;<Description>
-"RTN","C0CCCR0",228,0)
- ;;<Text>White</Text>
-"RTN","C0CCCR0",229,0)
- ;;</Description>
-"RTN","C0CCCR0",230,0)
- ;;<Source>
-"RTN","C0CCCR0",231,0)
- ;;<Actor>
-"RTN","C0CCCR0",232,0)
- ;;<ActorID>AA0001</ActorID>
-"RTN","C0CCCR0",233,0)
- ;;</Actor>
-"RTN","C0CCCR0",234,0)
- ;;</Source>
-"RTN","C0CCCR0",235,0)
- ;;</SocialHistoryElement>
-"RTN","C0CCCR0",236,0)
- ;;<SocialHistoryElement>
-"RTN","C0CCCR0",237,0)
- ;;<CCRDataObjectID>BB0007</CCRDataObjectID>
-"RTN","C0CCCR0",238,0)
- ;;<Type>
-"RTN","C0CCCR0",239,0)
- ;;<Text>Occupation</Text>
-"RTN","C0CCCR0",240,0)
- ;;</Type>
-"RTN","C0CCCR0",241,0)
- ;;<Description>
-"RTN","C0CCCR0",242,0)
- ;;<Text>Physician</Text>
-"RTN","C0CCCR0",243,0)
- ;;</Description>
-"RTN","C0CCCR0",244,0)
- ;;<Source>
-"RTN","C0CCCR0",245,0)
- ;;<Actor>
-"RTN","C0CCCR0",246,0)
- ;;<ActorID>AA0001</ActorID>
-"RTN","C0CCCR0",247,0)
- ;;</Actor>
-"RTN","C0CCCR0",248,0)
- ;;</Source>
-"RTN","C0CCCR0",249,0)
- ;;</SocialHistoryElement>
-"RTN","C0CCCR0",250,0)
- ;;</SocialHistory>
-"RTN","C0CCCR0",251,0)
- ;;<Alerts>
-"RTN","C0CCCR0",252,0)
- ;;<Alert>
-"RTN","C0CCCR0",253,0)
- ;;<CCRDataObjectID>@@ALERTOBJECTID@@</CCRDataObjectID>
-"RTN","C0CCCR0",254,0)
- ;;<DateTime>
-"RTN","C0CCCR0",255,0)
- ;;<ExactDateTime>@@ALERTDATETIME@@</ExactDateTime>
-"RTN","C0CCCR0",256,0)
- ;;</DateTime>
-"RTN","C0CCCR0",257,0)
- ;;<Type>
-"RTN","C0CCCR0",258,0)
- ;;<Text>@@ALERTTYPE@@</Text>
-"RTN","C0CCCR0",259,0)
- ;;</Type>
-"RTN","C0CCCR0",260,0)
- ;;<Status>
-"RTN","C0CCCR0",261,0)
- ;;<Text>@@ALERTSTATUSTEXT@@</Text>
-"RTN","C0CCCR0",262,0)
- ;;</Status>
-"RTN","C0CCCR0",263,0)
- ;;<Description>
-"RTN","C0CCCR0",264,0)
- ;;<Text>@@ALERTDESCRIPTIONTEXT@@</Text>
-"RTN","C0CCCR0",265,0)
- ;;<Code>
-"RTN","C0CCCR0",266,0)
- ;;<Value>@@ALERTCODEVALUE@@</Value>
-"RTN","C0CCCR0",267,0)
- ;;<CodingSystem>@@ALERTCODESYSTEM@@</CodingSystem>
-"RTN","C0CCCR0",268,0)
- ;;</Code>
-"RTN","C0CCCR0",269,0)
- ;;</Description>
-"RTN","C0CCCR0",270,0)
- ;;<Source>
-"RTN","C0CCCR0",271,0)
- ;;<Actor>
-"RTN","C0CCCR0",272,0)
- ;;<ActorID>@@ALERTSOURCEID@@</ActorID>
-"RTN","C0CCCR0",273,0)
- ;;</Actor>
-"RTN","C0CCCR0",274,0)
- ;;</Source>
-"RTN","C0CCCR0",275,0)
- ;;<Agent>
-"RTN","C0CCCR0",276,0)
- ;;<Products>
-"RTN","C0CCCR0",277,0)
- ;;<Product>
-"RTN","C0CCCR0",278,0)
- ;;<CCRDataObjectID>@@ALERTAGENTPRODUCTOBJECTID@@</CCRDataObjectID>
-"RTN","C0CCCR0",279,0)
- ;;<Source>
-"RTN","C0CCCR0",280,0)
- ;;<Actor>
-"RTN","C0CCCR0",281,0)
- ;;<ActorID>@@ALERTSOURCEID@@</ActorID>
-"RTN","C0CCCR0",282,0)
- ;;</Actor>
-"RTN","C0CCCR0",283,0)
- ;;</Source>
-"RTN","C0CCCR0",284,0)
- ;;<Product>
-"RTN","C0CCCR0",285,0)
- ;;<ProductName>
-"RTN","C0CCCR0",286,0)
- ;;<Text>@@ALERTAGENTPRODUCTNAMETEXT@@</Text>
-"RTN","C0CCCR0",287,0)
- ;;<Code>
-"RTN","C0CCCR0",288,0)
- ;;<Value>@@ALERTAGENTPRODUCTCODEVALUE@@</Value>
-"RTN","C0CCCR0",289,0)
- ;;<CodingSystem>@@ALERTAGENTPRODUCTCODESYSTEM@@</CodingSystem>
-"RTN","C0CCCR0",290,0)
- ;;</Code>
-"RTN","C0CCCR0",291,0)
- ;;</ProductName>
-"RTN","C0CCCR0",292,0)
- ;;</Product>
-"RTN","C0CCCR0",293,0)
- ;;</Product>
-"RTN","C0CCCR0",294,0)
- ;;</Products>
-"RTN","C0CCCR0",295,0)
- ;;</Agent>
-"RTN","C0CCCR0",296,0)
- ;;<Reaction>
-"RTN","C0CCCR0",297,0)
- ;;<Description>
-"RTN","C0CCCR0",298,0)
- ;;<Text>@@ALERTREACTIOINDESCRIPTIONTEXT@@</Text>
-"RTN","C0CCCR0",299,0)
- ;;<Code>
-"RTN","C0CCCR0",300,0)
- ;;<Value>@@ALERTREACTIONCODEVALUE@@</Value>
-"RTN","C0CCCR0",301,0)
- ;;<CodingSystem>@@ALERTREACTIONCODESYSTEM@@</CodingSystem>
-"RTN","C0CCCR0",302,0)
- ;;</Code>
-"RTN","C0CCCR0",303,0)
- ;;</Description>
-"RTN","C0CCCR0",304,0)
- ;;</Reaction>
-"RTN","C0CCCR0",305,0)
- ;;</Alert>
-"RTN","C0CCCR0",306,0)
- ;;</Alerts>
-"RTN","C0CCCR0",307,0)
- ;;<Medications>
-"RTN","C0CCCR0",308,0)
- ;;<Medication>
-"RTN","C0CCCR0",309,0)
- ;;<CCRDataObjectID>@@MEDOBJECTID@@</CCRDataObjectID>
-"RTN","C0CCCR0",310,0)
- ;;<DateTime>
-"RTN","C0CCCR0",311,0)
- ;;<Type>
-"RTN","C0CCCR0",312,0)
- ;;<Text>@@MEDISSUEDATETXT@@</Text>
-"RTN","C0CCCR0",313,0)
- ;;</Type>
-"RTN","C0CCCR0",314,0)
- ;;<ExactDateTime>@@MEDISSUEDATE@@</ExactDateTime>
-"RTN","C0CCCR0",315,0)
- ;;</DateTime>
-"RTN","C0CCCR0",316,0)
- ;;<DateTime>
-"RTN","C0CCCR0",317,0)
- ;;<Type>
-"RTN","C0CCCR0",318,0)
- ;;<Text>@@MEDLASTFILLDATETXT@@</Text>
-"RTN","C0CCCR0",319,0)
- ;;</Type>
-"RTN","C0CCCR0",320,0)
- ;;<ExactDateTime>@@MEDLASTFILLDATE@@</ExactDateTime>
-"RTN","C0CCCR0",321,0)
- ;;</DateTime>
-"RTN","C0CCCR0",322,0)
- ;;<IDs>
-"RTN","C0CCCR0",323,0)
- ;;<Type>
-"RTN","C0CCCR0",324,0)
- ;;<Text>@@MEDRXNOTXT@@</Text>
-"RTN","C0CCCR0",325,0)
- ;;</Type>
-"RTN","C0CCCR0",326,0)
- ;;<ID>@@MEDRXNO@@</ID>
-"RTN","C0CCCR0",327,0)
- ;;</IDs>
-"RTN","C0CCCR0",328,0)
- ;;<Type>
-"RTN","C0CCCR0",329,0)
- ;;<Text>@@MEDTYPETEXT@@</Text>
-"RTN","C0CCCR0",330,0)
- ;;</Type>
-"RTN","C0CCCR0",331,0)
- ;;<Description>
-"RTN","C0CCCR0",332,0)
- ;;<Text>@@MEDDETAILUNADORNED@@</Text>
-"RTN","C0CCCR0",333,0)
- ;;</Description>
-"RTN","C0CCCR0",334,0)
- ;;<Status>
-"RTN","C0CCCR0",335,0)
- ;;<Text>@@MEDSTATUSTEXT@@</Text>
-"RTN","C0CCCR0",336,0)
- ;;</Status>
-"RTN","C0CCCR0",337,0)
- ;;<Source>
-"RTN","C0CCCR0",338,0)
- ;;<Actor>
-"RTN","C0CCCR0",339,0)
- ;;<ActorID>@@MEDSOURCEACTORID@@</ActorID>
-"RTN","C0CCCR0",340,0)
- ;;</Actor>
-"RTN","C0CCCR0",341,0)
- ;;</Source>
-"RTN","C0CCCR0",342,0)
- ;;<Product>
-"RTN","C0CCCR0",343,0)
- ;;<ProductName>
-"RTN","C0CCCR0",344,0)
- ;;<Text>@@MEDPRODUCTNAMETEXT@@</Text>
-"RTN","C0CCCR0",345,0)
- ;;<Code>
-"RTN","C0CCCR0",346,0)
- ;;<Value>@@MEDPRODUCTNAMECODEVALUE@@</Value>
-"RTN","C0CCCR0",347,0)
- ;;<CodingSystem>@@MEDPRODUCTNAMECODINGINGSYSTEM@@</CodingSystem>
-"RTN","C0CCCR0",348,0)
- ;;<Version>@@MEDPRODUCTNAMECODEVERSION@@</Version>
-"RTN","C0CCCR0",349,0)
- ;;</Code>
-"RTN","C0CCCR0",350,0)
- ;;</ProductName>
-"RTN","C0CCCR0",351,0)
- ;;<BrandName>
-"RTN","C0CCCR0",352,0)
- ;;<Text>@@MEDBRANDNAMETEXT@@</Text>
-"RTN","C0CCCR0",353,0)
- ;;</BrandName>
-"RTN","C0CCCR0",354,0)
- ;;<Strength>
-"RTN","C0CCCR0",355,0)
- ;;<Value>@@MEDSTRENGTHVALUE@@</Value>
-"RTN","C0CCCR0",356,0)
- ;;<Units>
-"RTN","C0CCCR0",357,0)
- ;;<Unit>@@MEDSTRENGTHUNIT@@</Unit>
-"RTN","C0CCCR0",358,0)
- ;;</Units>
-"RTN","C0CCCR0",359,0)
- ;;</Strength>
-"RTN","C0CCCR0",360,0)
- ;;<Form>
-"RTN","C0CCCR0",361,0)
- ;;<Text>@@MEDFORMTEXT@@</Text>
-"RTN","C0CCCR0",362,0)
- ;;</Form>
-"RTN","C0CCCR0",363,0)
- ;;<Concentration>
-"RTN","C0CCCR0",364,0)
- ;;<Value>@@MEDCONCVALUE@@</Value>
-"RTN","C0CCCR0",365,0)
- ;;<Units>
-"RTN","C0CCCR0",366,0)
- ;;<Unit>@@MEDCONCUNIT@@</Unit>
-"RTN","C0CCCR0",367,0)
- ;;</Units>
-"RTN","C0CCCR0",368,0)
- ;;</Concentration>
-"RTN","C0CCCR0",369,0)
- ;;</Product>
-"RTN","C0CCCR0",370,0)
- ;;<Quantity>
-"RTN","C0CCCR0",371,0)
- ;;<Value>@@MEDQUANTITYVALUE@@</Value>
-"RTN","C0CCCR0",372,0)
- ;;<Units>
-"RTN","C0CCCR0",373,0)
- ;;<Unit>@@MEDQUANTITYUNIT@@</Unit>
-"RTN","C0CCCR0",374,0)
- ;;</Units>
-"RTN","C0CCCR0",375,0)
- ;;</Quantity>
-"RTN","C0CCCR0",376,0)
- ;;<Directions>
-"RTN","C0CCCR0",377,0)
- ;;<Direction>
-"RTN","C0CCCR0",378,0)
- ;;<Description>
-"RTN","C0CCCR0",379,0)
- ;;<Text>@@MEDDIRECTIONDESCRIPTIONTEXT@@</Text>
-"RTN","C0CCCR0",380,0)
- ;;</Description>
-"RTN","C0CCCR0",381,0)
- ;;<DoseIndicator>
-"RTN","C0CCCR0",382,0)
- ;;<Text>@@MEDDOSEINDICATOR@@</Text>
-"RTN","C0CCCR0",383,0)
- ;;</DoseIndicator>
-"RTN","C0CCCR0",384,0)
- ;;<DeliveryMethod>
-"RTN","C0CCCR0",385,0)
- ;;<Text>@@MEDDELIVERYMETHOD@@</Text>
-"RTN","C0CCCR0",386,0)
- ;;</DeliveryMethod>
-"RTN","C0CCCR0",387,0)
- ;;<Dose>
-"RTN","C0CCCR0",388,0)
- ;;<Value>@@MEDDOSEVALUE@@</Value>
-"RTN","C0CCCR0",389,0)
- ;;<Units>
-"RTN","C0CCCR0",390,0)
- ;;<Unit>@@MEDDOSEUNIT@@</Unit>
-"RTN","C0CCCR0",391,0)
- ;;</Units>
-"RTN","C0CCCR0",392,0)
- ;;<Rate>
-"RTN","C0CCCR0",393,0)
- ;;<Value>@@MEDRATEVALUE@@</Value>
-"RTN","C0CCCR0",394,0)
- ;;<Units>
-"RTN","C0CCCR0",395,0)
- ;;<Unit>@@MEDRATEUNIT@@</Unit>
-"RTN","C0CCCR0",396,0)
- ;;</Units>
-"RTN","C0CCCR0",397,0)
- ;;</Rate>
-"RTN","C0CCCR0",398,0)
- ;;</Dose>
-"RTN","C0CCCR0",399,0)
- ;;<Vehicle>
-"RTN","C0CCCR0",400,0)
- ;;<Text>@@MEDVEHICLETEXT@@</Text>
-"RTN","C0CCCR0",401,0)
- ;;</Vehicle>
-"RTN","C0CCCR0",402,0)
- ;;<Route>
-"RTN","C0CCCR0",403,0)
- ;;<Text>@@MEDDIRECTIONROUTETEXT@@</Text>
-"RTN","C0CCCR0",404,0)
- ;;</Route>
-"RTN","C0CCCR0",405,0)
- ;;<Frequency>
-"RTN","C0CCCR0",406,0)
- ;;<Value>@@MEDFREQUENCYVALUE@@</Value>
-"RTN","C0CCCR0",407,0)
- ;;</Frequency>
-"RTN","C0CCCR0",408,0)
- ;;<Interval>
-"RTN","C0CCCR0",409,0)
- ;;<Value>@@MEDINTERVALVALUE@@</Value>
-"RTN","C0CCCR0",410,0)
- ;;<Units>
-"RTN","C0CCCR0",411,0)
- ;;<Unit>@@MEDINTERVALUNIT@@</Unit>
-"RTN","C0CCCR0",412,0)
- ;;</Units>
-"RTN","C0CCCR0",413,0)
- ;;</Interval>
-"RTN","C0CCCR0",414,0)
- ;;<Duration>
-"RTN","C0CCCR0",415,0)
- ;;<Value>@@MEDDURATIONVALUE@@</Value>
-"RTN","C0CCCR0",416,0)
- ;;<Units>
-"RTN","C0CCCR0",417,0)
- ;;<Unit>@@MEDDURATIONUNIT@@</Unit>
-"RTN","C0CCCR0",418,0)
- ;;</Units>
-"RTN","C0CCCR0",419,0)
- ;;</Duration>
-"RTN","C0CCCR0",420,0)
- ;;<Indication>
-"RTN","C0CCCR0",421,0)
- ;;<PRNFlag>
-"RTN","C0CCCR0",422,0)
- ;;<Text>@@MEDPRNFLAG@@</Text>
-"RTN","C0CCCR0",423,0)
- ;;</PRNFlag>
-"RTN","C0CCCR0",424,0)
- ;;<Problem>
-"RTN","C0CCCR0",425,0)
- ;;<CCRDataObjectID>@@MEDPROBLEMOBJECTID@@</CCRDataObjectID>
-"RTN","C0CCCR0",426,0)
- ;;<Type>
-"RTN","C0CCCR0",427,0)
- ;;<Text>@@MEDPROBLEMTYPETXT@@</Text>
-"RTN","C0CCCR0",428,0)
- ;;</Type>
-"RTN","C0CCCR0",429,0)
- ;;<Description>
-"RTN","C0CCCR0",430,0)
- ;;<Text>@@MEDPROBLEMDESCRIPTION@@</Text>
-"RTN","C0CCCR0",431,0)
- ;;<Code>
-"RTN","C0CCCR0",432,0)
- ;;<Value>@@MEDPROBLEMCODEVALUE@@</Value>
-"RTN","C0CCCR0",433,0)
- ;;<CodingSystem>@@MEDPROBLEMCODINGSYSTEM@@</CodingSystem>
-"RTN","C0CCCR0",434,0)
- ;;<Version>@@MEDPROBLEMCODINGVERSION@@</Version>
-"RTN","C0CCCR0",435,0)
- ;;</Code>
-"RTN","C0CCCR0",436,0)
- ;;</Description>
-"RTN","C0CCCR0",437,0)
- ;;<Source>
-"RTN","C0CCCR0",438,0)
- ;;<Actor>
-"RTN","C0CCCR0",439,0)
- ;;<ActorID>@@MEDPROBLEMSOURCEACTORID@@</ActorID>
-"RTN","C0CCCR0",440,0)
- ;;</Actor>
-"RTN","C0CCCR0",441,0)
- ;;</Source>
-"RTN","C0CCCR0",442,0)
- ;;</Problem>
-"RTN","C0CCCR0",443,0)
- ;;</Indication>
-"RTN","C0CCCR0",444,0)
- ;;<StopIndicator>
-"RTN","C0CCCR0",445,0)
- ;;<Text>@@MEDSTOPINDICATOR@@</Text>
-"RTN","C0CCCR0",446,0)
- ;;</StopIndicator>
-"RTN","C0CCCR0",447,0)
- ;;<DirectionSequenceModifier>@@MEDDIRSEQ@@</DirectionSequenceModifier>
-"RTN","C0CCCR0",448,0)
- ;;<MultipleDirectionModifier>
-"RTN","C0CCCR0",449,0)
- ;;<Text>@@MEDMULDIRMOD@@</Text>
-"RTN","C0CCCR0",450,0)
- ;;</MultipleDirectionModifier>
-"RTN","C0CCCR0",451,0)
- ;;</Direction>
-"RTN","C0CCCR0",452,0)
- ;;</Directions>
-"RTN","C0CCCR0",453,0)
- ;;<PatientInstructions>
-"RTN","C0CCCR0",454,0)
- ;;<Instruction>
-"RTN","C0CCCR0",455,0)
- ;;<Text>@@MEDPTINSTRUCTIONS@@</Text>
-"RTN","C0CCCR0",456,0)
- ;;</Instruction>
-"RTN","C0CCCR0",457,0)
- ;;</PatientInstructions>
-"RTN","C0CCCR0",458,0)
- ;;<FullfillmentInstructions>
-"RTN","C0CCCR0",459,0)
- ;;<Text>@@MEDFULLFILLMENTINSTRUCTIONS@@</Text>
-"RTN","C0CCCR0",460,0)
- ;;</FullfillmentInstructions>
-"RTN","C0CCCR0",461,0)
- ;;<Refills>
-"RTN","C0CCCR0",462,0)
- ;;<Refill>
-"RTN","C0CCCR0",463,0)
- ;;<Number>@@MEDRFNO@@</Number>
-"RTN","C0CCCR0",464,0)
- ;;</Refill>
-"RTN","C0CCCR0",465,0)
- ;;</Refills>
-"RTN","C0CCCR0",466,0)
- ;;</Medication>
-"RTN","C0CCCR0",467,0)
- ;;</Medications>
-"RTN","C0CCCR0",468,0)
- ;;<VitalSigns>
-"RTN","C0CCCR0",469,0)
- ;;<Result>
-"RTN","C0CCCR0",470,0)
- ;;<CCRDataObjectID>@@VITALSIGNSDATAOBJECTID@@</CCRDataObjectID>
-"RTN","C0CCCR0",471,0)
- ;;<DateTime>
-"RTN","C0CCCR0",472,0)
- ;;<Type>
-"RTN","C0CCCR0",473,0)
- ;;<Text>@@VITALSIGNSDATETIMETYPETEXT@@</Text>
-"RTN","C0CCCR0",474,0)
- ;;</Type>
-"RTN","C0CCCR0",475,0)
- ;;<ExactDateTime>@@VITALSIGNSEXACTDATETIME@@</ExactDateTime>
-"RTN","C0CCCR0",476,0)
- ;;</DateTime>
-"RTN","C0CCCR0",477,0)
- ;;<Description>
-"RTN","C0CCCR0",478,0)
- ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
-"RTN","C0CCCR0",479,0)
- ;;</Description>
-"RTN","C0CCCR0",480,0)
- ;;<Source>
-"RTN","C0CCCR0",481,0)
- ;;<Actor>
-"RTN","C0CCCR0",482,0)
- ;;<ActorID>@@VITALSIGNSSOURCEACTORID@@</ActorID>
-"RTN","C0CCCR0",483,0)
- ;;</Actor>
-"RTN","C0CCCR0",484,0)
- ;;</Source>
-"RTN","C0CCCR0",485,0)
- ;;<Test>
-"RTN","C0CCCR0",486,0)
- ;;<CCRDataObjectID>@@VITALSIGNSTESTOBJECTID@@</CCRDataObjectID>
-"RTN","C0CCCR0",487,0)
- ;;<Type>
-"RTN","C0CCCR0",488,0)
- ;;<Text>@@VITALSIGNSTESTTYPETEXT@@</Text>
-"RTN","C0CCCR0",489,0)
- ;;</Type>
-"RTN","C0CCCR0",490,0)
- ;;<Description>
-"RTN","C0CCCR0",491,0)
- ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
-"RTN","C0CCCR0",492,0)
- ;;<Code>
-"RTN","C0CCCR0",493,0)
- ;;<Value>@@VITALSIGNSDESCCODEVALUE@@</Value>
-"RTN","C0CCCR0",494,0)
- ;;<CodingSystem>@@VITALSIGNSDESCCODINGSYSTEM@@</CodingSystem>
-"RTN","C0CCCR0",495,0)
- ;;<Version>@@VITALSIGNSCODEVERSION@@</Version>
-"RTN","C0CCCR0",496,0)
- ;;</Code>
-"RTN","C0CCCR0",497,0)
- ;;</Description>
-"RTN","C0CCCR0",498,0)
- ;;<Source>
-"RTN","C0CCCR0",499,0)
- ;;<Actor>
-"RTN","C0CCCR0",500,0)
- ;;<ActorID>@@VITALSIGNSTESTSOURCEACTORID@@</ActorID>
-"RTN","C0CCCR0",501,0)
- ;;</Actor>
-"RTN","C0CCCR0",502,0)
- ;;</Source>
-"RTN","C0CCCR0",503,0)
- ;;<TestResult>
-"RTN","C0CCCR0",504,0)
- ;;<Value>@@VITALSIGNSTESTRESULTVALUE@@</Value>
-"RTN","C0CCCR0",505,0)
- ;;<Units>
-"RTN","C0CCCR0",506,0)
- ;;<Unit>@@VITALSIGNSTESTRESULTUNIT@@</Unit>
-"RTN","C0CCCR0",507,0)
- ;;</Units>
-"RTN","C0CCCR0",508,0)
- ;;</TestResult>
-"RTN","C0CCCR0",509,0)
- ;;</Test>
-"RTN","C0CCCR0",510,0)
- ;;</Result>
-"RTN","C0CCCR0",511,0)
- ;;</VitalSigns>
-"RTN","C0CCCR0",512,0)
- ;;<Results>
-"RTN","C0CCCR0",513,0)
- ;;<Result>
-"RTN","C0CCCR0",514,0)
- ;;<CCRDataObjectID>@@RESULTOBJECTID@@</CCRDataObjectID>
-"RTN","C0CCCR0",515,0)
- ;;<DateTime>
-"RTN","C0CCCR0",516,0)
- ;;<Type>
-"RTN","C0CCCR0",517,0)
- ;;<Text>Assessment Time</Text>
-"RTN","C0CCCR0",518,0)
- ;;</Type>
-"RTN","C0CCCR0",519,0)
- ;;<ExactDateTime>@@RESULTASSESSMENTDATETIME@@</ExactDateTime>
-"RTN","C0CCCR0",520,0)
- ;;</DateTime>
-"RTN","C0CCCR0",521,0)
- ;;<Description>
-"RTN","C0CCCR0",522,0)
- ;;<Text>@@RESULTDESCRIPTIONTEXT@@</Text>
-"RTN","C0CCCR0",523,0)
- ;;<Code>
-"RTN","C0CCCR0",524,0)
- ;;<Value>@@RESULTCODE@@</Value>
-"RTN","C0CCCR0",525,0)
- ;;<CodingSystem>@@RESULTCODINGSYSTEM@@</CodingSystem>
-"RTN","C0CCCR0",526,0)
- ;;</Code>
-"RTN","C0CCCR0",527,0)
- ;;</Description>
-"RTN","C0CCCR0",528,0)
- ;;<Status>
-"RTN","C0CCCR0",529,0)
- ;;<Text>@@RESULTSTATUS@@</Text>
-"RTN","C0CCCR0",530,0)
- ;;</Status>
-"RTN","C0CCCR0",531,0)
- ;;<Source>
-"RTN","C0CCCR0",532,0)
- ;;<Actor>
-"RTN","C0CCCR0",533,0)
- ;;<ActorID>@@RESULTSOURCEACTORID@@</ActorID>
-"RTN","C0CCCR0",534,0)
- ;;</Actor>
-"RTN","C0CCCR0",535,0)
- ;;</Source>
-"RTN","C0CCCR0",536,0)
- ;;<Test>
-"RTN","C0CCCR0",537,0)
- ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
-"RTN","C0CCCR0",538,0)
- ;;<DateTime>
-"RTN","C0CCCR0",539,0)
- ;;<Type>
-"RTN","C0CCCR0",540,0)
- ;;<Text>Assessment Time</Text>
-"RTN","C0CCCR0",541,0)
- ;;</Type>
-"RTN","C0CCCR0",542,0)
- ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
-"RTN","C0CCCR0",543,0)
- ;;</DateTime>
-"RTN","C0CCCR0",544,0)
- ;;<Description>
-"RTN","C0CCCR0",545,0)
- ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
-"RTN","C0CCCR0",546,0)
- ;;<Code>
-"RTN","C0CCCR0",547,0)
- ;;<Value>@@RESULTTESTCODEVALUE@@</Value>
-"RTN","C0CCCR0",548,0)
- ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
-"RTN","C0CCCR0",549,0)
- ;;</Code>
-"RTN","C0CCCR0",550,0)
- ;;</Description>
-"RTN","C0CCCR0",551,0)
- ;;<Status>
-"RTN","C0CCCR0",552,0)
- ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
-"RTN","C0CCCR0",553,0)
- ;;</Status>
-"RTN","C0CCCR0",554,0)
- ;;<Source>
-"RTN","C0CCCR0",555,0)
- ;;<Actor>
-"RTN","C0CCCR0",556,0)
- ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
-"RTN","C0CCCR0",557,0)
- ;;</Actor>
-"RTN","C0CCCR0",558,0)
- ;;</Source>
-"RTN","C0CCCR0",559,0)
- ;;<TestResult>
-"RTN","C0CCCR0",560,0)
- ;;<Value>@@RESULTTESTVALUE@@</Value>
-"RTN","C0CCCR0",561,0)
- ;;<Units>
-"RTN","C0CCCR0",562,0)
- ;;<Unit>@@RESULTTESTUNITS@@</Unit>
-"RTN","C0CCCR0",563,0)
- ;;</Units>
-"RTN","C0CCCR0",564,0)
- ;;</TestResult>
-"RTN","C0CCCR0",565,0)
- ;;<NormalResult>
-"RTN","C0CCCR0",566,0)
- ;;<Normal>
-"RTN","C0CCCR0",567,0)
- ;;<Description>
-"RTN","C0CCCR0",568,0)
- ;;<Text>@@RESULTTESTNORMALDESCTEXT@@</Text>
-"RTN","C0CCCR0",569,0)
- ;;</Description>
-"RTN","C0CCCR0",570,0)
- ;;<Source>
-"RTN","C0CCCR0",571,0)
- ;;<Actor>
-"RTN","C0CCCR0",572,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","C0CCCR0",573,0)
- ;;</Actor>
-"RTN","C0CCCR0",574,0)
- ;;</Source>
-"RTN","C0CCCR0",575,0)
- ;;</Normal>
-"RTN","C0CCCR0",576,0)
- ;;</NormalResult>
-"RTN","C0CCCR0",577,0)
- ;;<Flag>
-"RTN","C0CCCR0",578,0)
- ;;<Text>@@RESULTTESTFLAG@@</Text>
-"RTN","C0CCCR0",579,0)
- ;;</Flag>
-"RTN","C0CCCR0",580,0)
- ;;</Test>
-"RTN","C0CCCR0",581,0)
- ;;</Result>
-"RTN","C0CCCR0",582,0)
- ;;</Results>
-"RTN","C0CCCR0",583,0)
- ;;<Procedures>
-"RTN","C0CCCR0",584,0)
- ;;<Procedure>
-"RTN","C0CCCR0",585,0)
- ;;<CCRDataObjectID>@@PROCOBJECTID@@</CCRDataObjectID>
-"RTN","C0CCCR0",586,0)
- ;;<DateTime>
-"RTN","C0CCCR0",587,0)
- ;;<Type>
-"RTN","C0CCCR0",588,0)
- ;;<Text>@@PROCDATETEXT@@</Text>
-"RTN","C0CCCR0",589,0)
- ;;</Type>
-"RTN","C0CCCR0",590,0)
- ;;<ExactDateTime>@@PROCDATETIME@@</ExactDateTime>
-"RTN","C0CCCR0",591,0)
- ;;</DateTime>
-"RTN","C0CCCR0",592,0)
- ;;<Description>
-"RTN","C0CCCR0",593,0)
- ;;<Text>@@PROCDESCTEXT@@</Text>
-"RTN","C0CCCR0",594,0)
- ;;<ObjectAttribute>
-"RTN","C0CCCR0",595,0)
- ;;<Attribute>@@PROCDESCOBJATTR@@</Attribute>
-"RTN","C0CCCR0",596,0)
- ;;<AttributeValue>
-"RTN","C0CCCR0",597,0)
- ;;<Value>@@PROCDESCOBJATTRVAL@@</Value>
-"RTN","C0CCCR0",598,0)
- ;;<Code>
-"RTN","C0CCCR0",599,0)
- ;;<Value>@@PROCDESCOBJATTRCODE@@</Value>
-"RTN","C0CCCR0",600,0)
- ;;<CodingSystem>@@PROCDESCOBJATTRCODESYS@@</CodingSystem>
-"RTN","C0CCCR0",601,0)
- ;;</Code>
-"RTN","C0CCCR0",602,0)
- ;;</AttributeValue>
-"RTN","C0CCCR0",603,0)
- ;;</ObjectAttribute>
-"RTN","C0CCCR0",604,0)
- ;;<Code>
-"RTN","C0CCCR0",605,0)
- ;;<Value>@@PROCCODE@@</Value>
-"RTN","C0CCCR0",606,0)
- ;;<CodingSystem>@@PROCCODESYS@@</CodingSystem>
-"RTN","C0CCCR0",607,0)
- ;;</Code>
-"RTN","C0CCCR0",608,0)
- ;;</Description>
-"RTN","C0CCCR0",609,0)
- ;;<Status>
-"RTN","C0CCCR0",610,0)
- ;;<Text>@@PROCSTATUS@@</Text>
-"RTN","C0CCCR0",611,0)
- ;;</Status>
-"RTN","C0CCCR0",612,0)
- ;;<Source>
-"RTN","C0CCCR0",613,0)
- ;;<Actor>
-"RTN","C0CCCR0",614,0)
- ;;<ActorID>@@PROCACTOROBJID@@</ActorID>
-"RTN","C0CCCR0",615,0)
- ;;</Actor>
-"RTN","C0CCCR0",616,0)
- ;;</Source>
-"RTN","C0CCCR0",617,0)
- ;;<InternalCCRLink>
-"RTN","C0CCCR0",618,0)
- ;;<LinkID>@@PROCLINKID@@</LinkID>
-"RTN","C0CCCR0",619,0)
- ;;<LinkRelationship>@@PROCLINKREL@@</LinkRelationship>
-"RTN","C0CCCR0",620,0)
- ;;</InternalCCRLink>
-"RTN","C0CCCR0",621,0)
- ;;</Procedure>
-"RTN","C0CCCR0",622,0)
- ;;</Procedures>
-"RTN","C0CCCR0",623,0)
- ;;<Encounters>
-"RTN","C0CCCR0",624,0)
- ;;<Encounter>
-"RTN","C0CCCR0",625,0)
- ;;<CCRDataObjectID>@@ENCOBJECTID@@</CCRDataObjectID>
-"RTN","C0CCCR0",626,0)
- ;;<DateTime>
-"RTN","C0CCCR0",627,0)
- ;;<ExactDateTime>@@ENCDATETIME@@</ExactDateTime>
-"RTN","C0CCCR0",628,0)
- ;;</DateTime>
-"RTN","C0CCCR0",629,0)
- ;;<Type>
-"RTN","C0CCCR0",630,0)
- ;;<Text>@@ENCTYPETXT@@</Text>
-"RTN","C0CCCR0",631,0)
- ;;<Code>
-"RTN","C0CCCR0",632,0)
- ;;<Value>@@ENCTYPECODE@@</Value>
-"RTN","C0CCCR0",633,0)
- ;;<CodingSystem>@@ENCTYPECODESYS@@</CodingSystem>
-"RTN","C0CCCR0",634,0)
- ;;</Code>
-"RTN","C0CCCR0",635,0)
- ;;</Type>
-"RTN","C0CCCR0",636,0)
- ;;<Description>
-"RTN","C0CCCR0",637,0)
- ;;<Text>@@ENCDESCTXT@@</Text>
-"RTN","C0CCCR0",638,0)
- ;;<Code>
-"RTN","C0CCCR0",639,0)
- ;;<Value>@@ENCDESCCODE@@</Value>
-"RTN","C0CCCR0",640,0)
- ;;<CodingSystem>@@ENCDESCCODESYS@@</CodingSystem>
-"RTN","C0CCCR0",641,0)
- ;;</Code>
-"RTN","C0CCCR0",642,0)
- ;;</Description>
-"RTN","C0CCCR0",643,0)
- ;;<Location>
-"RTN","C0CCCR0",644,0)
- ;;<Actor>
-"RTN","C0CCCR0",645,0)
- ;;<ActorID>@@ENCLOCACTORID@@</ActorID>
-"RTN","C0CCCR0",646,0)
- ;;</Actor>
-"RTN","C0CCCR0",647,0)
- ;;</Location>
-"RTN","C0CCCR0",648,0)
- ;;<Practioner>
-"RTN","C0CCCR0",649,0)
- ;;<Actor>
-"RTN","C0CCCR0",650,0)
- ;;<ActorID>@@ENCPRVACTORID@@</ActorID>
-"RTN","C0CCCR0",651,0)
- ;;</Actor>
-"RTN","C0CCCR0",652,0)
- ;;</Practioner>
-"RTN","C0CCCR0",653,0)
- ;;<Indication>
-"RTN","C0CCCR0",654,0)
- ;;<Text>@@ENCINDTXT@@</Text>
-"RTN","C0CCCR0",655,0)
- ;;<Code>
-"RTN","C0CCCR0",656,0)
- ;;<Value>@@ENCINDCODE@@</Value>
-"RTN","C0CCCR0",657,0)
- ;;<CodingSystem>@@ENCINDCODESYS@@</CodingSystem>
-"RTN","C0CCCR0",658,0)
- ;;</Code>
-"RTN","C0CCCR0",659,0)
- ;;</Indication>
-"RTN","C0CCCR0",660,0)
- ;;<Source>
-"RTN","C0CCCR0",661,0)
- ;;<Actor>
-"RTN","C0CCCR0",662,0)
- ;;<ActorID>@@ENCACTORID@@</ActorID>
-"RTN","C0CCCR0",663,0)
- ;;</Actor>
-"RTN","C0CCCR0",664,0)
- ;;</Source>
-"RTN","C0CCCR0",665,0)
- ;;<CommentID>@@ENCCOMMENTID@@</CommentID>
-"RTN","C0CCCR0",666,0)
- ;;</Encounter>
-"RTN","C0CCCR0",667,0)
- ;;</Encounters>
-"RTN","C0CCCR0",668,0)
- ;;<HealthCareProviders>
-"RTN","C0CCCR0",669,0)
- ;;<Provider>
-"RTN","C0CCCR0",670,0)
- ;;<ActorID>AA0005</ActorID>
-"RTN","C0CCCR0",671,0)
- ;;<ActorRole>
-"RTN","C0CCCR0",672,0)
- ;;<Text>Primary Provider</Text>
-"RTN","C0CCCR0",673,0)
- ;;</ActorRole>
-"RTN","C0CCCR0",674,0)
- ;;</Provider>
-"RTN","C0CCCR0",675,0)
- ;;</HealthCareProviders>
-"RTN","C0CCCR0",676,0)
- ;;</Body>
-"RTN","C0CCCR0",677,0)
- ;;<Actors>
-"RTN","C0CCCR0",678,0)
- ;;<ACTOR-PATIENT>
-"RTN","C0CCCR0",679,0)
- ;;<Actor>
-"RTN","C0CCCR0",680,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","C0CCCR0",681,0)
- ;;<Person>
-"RTN","C0CCCR0",682,0)
- ;;<Name>
-"RTN","C0CCCR0",683,0)
- ;;<CurrentName>
-"RTN","C0CCCR0",684,0)
- ;;<Given>@@ACTORGIVENNAME@@</Given>
-"RTN","C0CCCR0",685,0)
- ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
-"RTN","C0CCCR0",686,0)
- ;;<Family>@@ACTORFAMILYNAME@@</Family>
-"RTN","C0CCCR0",687,0)
- ;;</CurrentName>
-"RTN","C0CCCR0",688,0)
- ;;</Name>
-"RTN","C0CCCR0",689,0)
- ;;<DateOfBirth>
-"RTN","C0CCCR0",690,0)
- ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime>
-"RTN","C0CCCR0",691,0)
- ;;</DateOfBirth>
-"RTN","C0CCCR0",692,0)
- ;;<Gender>
-"RTN","C0CCCR0",693,0)
- ;;<Text>@@ACTORGENDER@@</Text>
-"RTN","C0CCCR0",694,0)
- ;;<Code>
-"RTN","C0CCCR0",695,0)
- ;;<Value>@@ACTORGENDERCODE@@</Value>
-"RTN","C0CCCR0",696,0)
- ;;<CodingSystem>HL7 AdministrativeGender</CodingSystem>
-"RTN","C0CCCR0",697,0)
- ;;</Code>
-"RTN","C0CCCR0",698,0)
- ;;</Gender>
-"RTN","C0CCCR0",699,0)
- ;;</Person>
-"RTN","C0CCCR0",700,0)
- ;;<IDs>
-"RTN","C0CCCR0",701,0)
- ;;<Type>
-"RTN","C0CCCR0",702,0)
- ;;<Text>@@ACTORSSNTEXT@@</Text>
-"RTN","C0CCCR0",703,0)
- ;;</Type>
-"RTN","C0CCCR0",704,0)
- ;;<ID>@@ACTORSSN@@</ID>
-"RTN","C0CCCR0",705,0)
- ;;<Source>
-"RTN","C0CCCR0",706,0)
- ;;<Actor>
-"RTN","C0CCCR0",707,0)
- ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID>
-"RTN","C0CCCR0",708,0)
- ;;</Actor>
-"RTN","C0CCCR0",709,0)
- ;;</Source>
-"RTN","C0CCCR0",710,0)
- ;;</IDs>
-"RTN","C0CCCR0",711,0)
- ;;<Address>
-"RTN","C0CCCR0",712,0)
- ;;<Type>
-"RTN","C0CCCR0",713,0)
- ;;<Text>@@ACTORADDRESSTYPE@@</Text>
-"RTN","C0CCCR0",714,0)
- ;;</Type>
-"RTN","C0CCCR0",715,0)
- ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
-"RTN","C0CCCR0",716,0)
- ;;<Line2>@@ACTORADDRESSLINE2@@</Line2>
-"RTN","C0CCCR0",717,0)
- ;;<City>@@ACTORADDRESSCITY@@</City>
-"RTN","C0CCCR0",718,0)
- ;;<State>@@ACTORADDRESSSTATE@@</State>
-"RTN","C0CCCR0",719,0)
- ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode>
-"RTN","C0CCCR0",720,0)
- ;;</Address>
-"RTN","C0CCCR0",721,0)
- ;;<Telephone>
-"RTN","C0CCCR0",722,0)
- ;;<Value>@@ACTORRESTEL@@</Value>
-"RTN","C0CCCR0",723,0)
- ;;<Type>
-"RTN","C0CCCR0",724,0)
- ;;<Text>@@ACTORRESTELTEXT@@</Text>
-"RTN","C0CCCR0",725,0)
- ;;</Type>
-"RTN","C0CCCR0",726,0)
- ;;</Telephone>
-"RTN","C0CCCR0",727,0)
- ;;<Telephone>
-"RTN","C0CCCR0",728,0)
- ;;<Value>@@ACTORWORKTEL@@</Value>
-"RTN","C0CCCR0",729,0)
- ;;<Type>
-"RTN","C0CCCR0",730,0)
- ;;<Text>@@ACTORWORKTELTEXT@@</Text>
-"RTN","C0CCCR0",731,0)
- ;;</Type>
-"RTN","C0CCCR0",732,0)
- ;;</Telephone>
-"RTN","C0CCCR0",733,0)
- ;;<Telephone>
-"RTN","C0CCCR0",734,0)
- ;;<Value>@@ACTORCELLTEL@@</Value>
-"RTN","C0CCCR0",735,0)
- ;;<Type>
-"RTN","C0CCCR0",736,0)
- ;;<Text>@@ACTORCELLTELTEXT@@</Text>
-"RTN","C0CCCR0",737,0)
- ;;</Type>
-"RTN","C0CCCR0",738,0)
- ;;</Telephone>
-"RTN","C0CCCR0",739,0)
- ;;<EMail>
-"RTN","C0CCCR0",740,0)
- ;;<Value>@@ACTOREMAIL@@</Value>
-"RTN","C0CCCR0",741,0)
- ;;</EMail>
-"RTN","C0CCCR0",742,0)
- ;;<Source>
-"RTN","C0CCCR0",743,0)
- ;;<Actor>
-"RTN","C0CCCR0",744,0)
- ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID>
-"RTN","C0CCCR0",745,0)
- ;;</Actor>
-"RTN","C0CCCR0",746,0)
- ;;</Source>
-"RTN","C0CCCR0",747,0)
- ;;</Actor>
-"RTN","C0CCCR0",748,0)
- ;;</ACTOR-PATIENT>
-"RTN","C0CCCR0",749,0)
- ;;<ACTOR-SYSTEM>
-"RTN","C0CCCR0",750,0)
- ;;<Actor>
-"RTN","C0CCCR0",751,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","C0CCCR0",752,0)
- ;;<InformationSystem>
-"RTN","C0CCCR0",753,0)
- ;;<Name>@@ACTORINFOSYSNAME@@</Name>
-"RTN","C0CCCR0",754,0)
- ;;<Version>@@ACTORINFOSYSVER@@</Version>
-"RTN","C0CCCR0",755,0)
- ;;</InformationSystem>
-"RTN","C0CCCR0",756,0)
- ;;<Source>
-"RTN","C0CCCR0",757,0)
- ;;<Actor>
-"RTN","C0CCCR0",758,0)
- ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID>
-"RTN","C0CCCR0",759,0)
- ;;</Actor>
-"RTN","C0CCCR0",760,0)
- ;;</Source>
-"RTN","C0CCCR0",761,0)
- ;;</Actor>
-"RTN","C0CCCR0",762,0)
- ;;</ACTOR-SYSTEM>
-"RTN","C0CCCR0",763,0)
- ;;<ACTOR-NOK>
-"RTN","C0CCCR0",764,0)
- ;;<Actor>
-"RTN","C0CCCR0",765,0)
- ;;<ActorObjectID>AA0003</ActorObjectID>
-"RTN","C0CCCR0",766,0)
- ;;<Person>
-"RTN","C0CCCR0",767,0)
- ;;<Name>
-"RTN","C0CCCR0",768,0)
- ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName>
-"RTN","C0CCCR0",769,0)
- ;;</Name>
-"RTN","C0CCCR0",770,0)
- ;;</Person>
-"RTN","C0CCCR0",771,0)
- ;;<Relation>
-"RTN","C0CCCR0",772,0)
- ;;<Text>@@ACTORRELATION@@</Text>
-"RTN","C0CCCR0",773,0)
- ;;</Relation>
-"RTN","C0CCCR0",774,0)
- ;;<Source>
-"RTN","C0CCCR0",775,0)
- ;;<Actor>
-"RTN","C0CCCR0",776,0)
- ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID>
-"RTN","C0CCCR0",777,0)
- ;;</Actor>
-"RTN","C0CCCR0",778,0)
- ;;</Source>
-"RTN","C0CCCR0",779,0)
- ;;</Actor>
-"RTN","C0CCCR0",780,0)
- ;;</ACTOR-NOK>
-"RTN","C0CCCR0",781,0)
- ;;<ACTOR-PROVIDER>
-"RTN","C0CCCR0",782,0)
- ;;<Actor>
-"RTN","C0CCCR0",783,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","C0CCCR0",784,0)
- ;;<Person>
-"RTN","C0CCCR0",785,0)
- ;;<Name>
-"RTN","C0CCCR0",786,0)
- ;;<CurrentName>
-"RTN","C0CCCR0",787,0)
- ;;<Given>@@ACTORGIVENNAME@@</Given>
-"RTN","C0CCCR0",788,0)
- ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
-"RTN","C0CCCR0",789,0)
- ;;<Family>@@ACTORFAMILYNAME@@</Family>
-"RTN","C0CCCR0",790,0)
- ;;<Title>@@ACTORTITLE@@</Title>
-"RTN","C0CCCR0",791,0)
- ;;</CurrentName>
-"RTN","C0CCCR0",792,0)
- ;;</Name>
-"RTN","C0CCCR0",793,0)
- ;;</Person>
-"RTN","C0CCCR0",794,0)
- ;;<Specialty>
-"RTN","C0CCCR0",795,0)
- ;;<Text>@@ACTORSPECIALITY@@</Text>
-"RTN","C0CCCR0",796,0)
- ;;</Specialty>
-"RTN","C0CCCR0",797,0)
- ;;<Address>
-"RTN","C0CCCR0",798,0)
- ;;<Type>
-"RTN","C0CCCR0",799,0)
- ;;<Text>@@ACTORADDRESSTYPE@@</Text>
-"RTN","C0CCCR0",800,0)
- ;;</Type>
-"RTN","C0CCCR0",801,0)
- ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
-"RTN","C0CCCR0",802,0)
- ;;<City>@@ACTORADDRESSCITY@@</City>
-"RTN","C0CCCR0",803,0)
- ;;<State>@@ACTORADDRESSSTATE@@</State>
-"RTN","C0CCCR0",804,0)
- ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
-"RTN","C0CCCR0",805,0)
- ;;</Address>
-"RTN","C0CCCR0",806,0)
- ;;<Telephone>
-"RTN","C0CCCR0",807,0)
- ;;<Value>@@ACTORTELEPHONE@@</Value>
-"RTN","C0CCCR0",808,0)
- ;;<Type>
-"RTN","C0CCCR0",809,0)
- ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
-"RTN","C0CCCR0",810,0)
- ;;</Type>
-"RTN","C0CCCR0",811,0)
- ;;</Telephone>
-"RTN","C0CCCR0",812,0)
- ;;<Email>
-"RTN","C0CCCR0",813,0)
- ;;<Value>@@ACTOREMAIL@@</Value>
-"RTN","C0CCCR0",814,0)
- ;;</Email>
-"RTN","C0CCCR0",815,0)
- ;;<Source>
-"RTN","C0CCCR0",816,0)
- ;;<Actor>
-"RTN","C0CCCR0",817,0)
- ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
-"RTN","C0CCCR0",818,0)
- ;;</Actor>
-"RTN","C0CCCR0",819,0)
- ;;</Source>
-"RTN","C0CCCR0",820,0)
- ;;<InternalCCRLink>
-"RTN","C0CCCR0",821,0)
- ;;<LinkID>@@ACTORORGLINK@@</LinkID>
-"RTN","C0CCCR0",822,0)
- ;;<LinkRelationship>representedOrganization</LinkRelationship>
-"RTN","C0CCCR0",823,0)
- ;;</InternalCCRLink>
-"RTN","C0CCCR0",824,0)
- ;;</Actor>
-"RTN","C0CCCR0",825,0)
- ;;</ACTOR-PROVIDER>
-"RTN","C0CCCR0",826,0)
- ;;<ACTOR-ORG>
-"RTN","C0CCCR0",827,0)
- ;;<Actor>
-"RTN","C0CCCR0",828,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","C0CCCR0",829,0)
- ;;<Organization>
-"RTN","C0CCCR0",830,0)
- ;;<Name>@@ORGANIZATIONNAME@@</Name>
-"RTN","C0CCCR0",831,0)
- ;;</Organization>
-"RTN","C0CCCR0",832,0)
- ;;<Address>
-"RTN","C0CCCR0",833,0)
- ;;<Type>
-"RTN","C0CCCR0",834,0)
- ;;<Text>@@ACTORADDRESSTYPE@@</Text>
-"RTN","C0CCCR0",835,0)
- ;;</Type>
-"RTN","C0CCCR0",836,0)
- ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
-"RTN","C0CCCR0",837,0)
- ;;<City>@@ACTORADDRESSCITY@@</City>
-"RTN","C0CCCR0",838,0)
- ;;<State>@@ACTORADDRESSSTATE@@</State>
-"RTN","C0CCCR0",839,0)
- ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
-"RTN","C0CCCR0",840,0)
- ;;</Address>
-"RTN","C0CCCR0",841,0)
- ;;<Telephone>
-"RTN","C0CCCR0",842,0)
- ;;<Value>@@ACTORTELEPHONE@@</Value>
-"RTN","C0CCCR0",843,0)
- ;;<Type>
-"RTN","C0CCCR0",844,0)
- ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
-"RTN","C0CCCR0",845,0)
- ;;</Type>
-"RTN","C0CCCR0",846,0)
- ;;</Telephone>
-"RTN","C0CCCR0",847,0)
- ;;<Source>
-"RTN","C0CCCR0",848,0)
- ;;<Actor>
-"RTN","C0CCCR0",849,0)
- ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
-"RTN","C0CCCR0",850,0)
- ;;</Actor>
-"RTN","C0CCCR0",851,0)
- ;;</Source>
-"RTN","C0CCCR0",852,0)
- ;;</Actor>
-"RTN","C0CCCR0",853,0)
- ;;</ACTOR-ORG>
-"RTN","C0CCCR0",854,0)
- ;;</Actors>
-"RTN","C0CCCR0",855,0)
- ;;<Signatures>
-"RTN","C0CCCR0",856,0)
- ;;<CCRSignature>
-"RTN","C0CCCR0",857,0)
- ;;<SignatureObjectID>S0001</SignatureObjectID>
-"RTN","C0CCCR0",858,0)
- ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>
-"RTN","C0CCCR0",859,0)
- ;;<Source>
-"RTN","C0CCCR0",860,0)
- ;;<ActorID>AA0001</ActorID>
-"RTN","C0CCCR0",861,0)
- ;;</Source>
-"RTN","C0CCCR0",862,0)
- ;;<Signature>
-"RTN","C0CCCR0",863,0)
- ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
-"RTN","C0CCCR0",864,0)
- ;;<SignedInfo>
-"RTN","C0CCCR0",865,0)
- ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>
-"RTN","C0CCCR0",866,0)
- ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>
-"RTN","C0CCCR0",867,0)
- ;;<Reference URI="">
-"RTN","C0CCCR0",868,0)
- ;;<Transforms>
-"RTN","C0CCCR0",869,0)
- ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>
-"RTN","C0CCCR0",870,0)
- ;;</Transforms>
-"RTN","C0CCCR0",871,0)
- ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>
-"RTN","C0CCCR0",872,0)
- ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
-"RTN","C0CCCR0",873,0)
- ;;</Reference>
-"RTN","C0CCCR0",874,0)
- ;;</SignedInfo>
-"RTN","C0CCCR0",875,0)
- ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>
-"RTN","C0CCCR0",876,0)
- ;;<KeyInfo>
-"RTN","C0CCCR0",877,0)
- ;;<KeyValue>
-"RTN","C0CCCR0",878,0)
- ;;<RSAKeyValue>
-"RTN","C0CCCR0",879,0)
- ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>
-"RTN","C0CCCR0",880,0)
- ;;<Exponent>AQAB</Exponent>
-"RTN","C0CCCR0",881,0)
- ;;</RSAKeyValue>
-"RTN","C0CCCR0",882,0)
- ;;</KeyValue>
-"RTN","C0CCCR0",883,0)
- ;;</KeyInfo>
-"RTN","C0CCCR0",884,0)
- ;;</Signature>
-"RTN","C0CCCR0",885,0)
- ;;</Signature>
-"RTN","C0CCCR0",886,0)
- ;;</CCRSignature>
-"RTN","C0CCCR0",887,0)
- ;;</Signatures>
-"RTN","C0CCCR0",888,0)
- ;;<Comments>
-"RTN","C0CCCR0",889,0)
- ;;<Comment>
-"RTN","C0CCCR0",890,0)
- ;;<CommentObjectID>@@COMMENTOBJECTID@@</CommentObjectID>
-"RTN","C0CCCR0",891,0)
- ;;<DateTime>
-"RTN","C0CCCR0",892,0)
- ;;<ExactDateTime>@@CMTDATETIME@@</ExactDateTime>
-"RTN","C0CCCR0",893,0)
- ;;</DateTime>
-"RTN","C0CCCR0",894,0)
- ;;<Description>
-"RTN","C0CCCR0",895,0)
- ;;<Text>
-"RTN","C0CCCR0",896,0)
- ;;</Text>
-"RTN","C0CCCR0",897,0)
- ;;</Description>
-"RTN","C0CCCR0",898,0)
- ;;<Source>
-"RTN","C0CCCR0",899,0)
- ;;<Actor>
 "RTN","C0CCCR0",900,0)
- ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
+ ;;</Comment>
 "RTN","C0CCCR0",901,0)
- ;;</Actor>
+ ;;</Comments>
 "RTN","C0CCCR0",902,0)
- ;;</Source>
+ ;;</ContinuityOfCareRecord>
 "RTN","C0CCCR0",903,0)
- ;;</Comment>
-"RTN","C0CCCR0",904,0)
- ;;</Comments>
-"RTN","C0CCCR0",905,0)
- ;;</ContinuityOfCareRecord>
-"RTN","C0CCCR0",906,0)
  ;</TEMPLATE>
 "RTN","C0CCMT")
-0^71^B6740701
+0^71^B6559679
 "RTN","C0CCMT",1,0)
 C0CCMT  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR COMMENTS ; 05/21/10
 "RTN","C0CCMT",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CCMT",3,0)
  ;Copyright 2010 George Lilly, University of Minnesota and others.
 "RTN","C0CCMT",4,0)
- ;Licensed under the terms of the GNU General Public License.
+ ;
 "RTN","C0CCMT",5,0)
- ;See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CCMT",6,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CCMT",7,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CCMT",8,0)
- ;it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CCMT",9,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CCMT",10,0)
- ;(at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CCMT",11,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CCMT",12,0)
- ;This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CCMT",13,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CCMT",14,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CCMT",15,0)
- ;GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CCMT",16,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CCMT",17,0)
- ;You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CCMT",18,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CCMT",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ W "NO ENTRY FROM TOP",!
 "RTN","C0CCMT",20,0)
- ;
+ Q
 "RTN","C0CCMT",21,0)
- W "NO ENTRY FROM TOP",!
+ ;
 "RTN","C0CCMT",22,0)
+EXTRACT(NOTEXML,DFN,NOTEOUT) ; EXTRACT NOTES INTO  XML TEMPLATE
+"RTN","C0CCMT",23,0)
+ ; NOTEXML AND NOTEOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","C0CCMT",24,0)
+ ;
+"RTN","C0CCMT",25,0)
+ D SETVARS^C0CPROC ; SET UP VARIABLES FOR PROCEDUCRES, ENCOUNTERS, AND NOTES
+"RTN","C0CCMT",26,0)
+ ;I '$D(@C0CNTE) Q  ; NO NOTES AVAILABLE
+"RTN","C0CCMT",27,0)
+ D MAP(NOTEXML,C0CNTE,NOTEOUT) ;MAP RESULTS FOR NOTES
+"RTN","C0CCMT",28,0)
  Q
-"RTN","C0CCMT",23,0)
- ;
-"RTN","C0CCMT",24,0)
-EXTRACT(NOTEXML,DFN,NOTEOUT) ; EXTRACT NOTES INTO  XML TEMPLATE
-"RTN","C0CCMT",25,0)
- ; NOTEXML AND NOTEOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","C0CCMT",26,0)
- ;
-"RTN","C0CCMT",27,0)
- D SETVARS^C0CPROC ; SET UP VARIABLES FOR PROCEDUCRES, ENCOUNTERS, AND NOTES
-"RTN","C0CCMT",28,0)
- ;I '$D(@C0CNTE) Q  ; NO NOTES AVAILABLE
 "RTN","C0CCMT",29,0)
- D MAP(NOTEXML,C0CNTE,NOTEOUT) ;MAP RESULTS FOR NOTES
+ ;
 "RTN","C0CCMT",30,0)
+MAP(NOTEXML,C0CNTE,NOTEOUT) ; MAP PROCEDURES XML 
+"RTN","C0CCMT",31,0)
+ ;
+"RTN","C0CCMT",32,0)
+ N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"NOTETEMP")) ;WORK AREA FOR TEMPLATE
+"RTN","C0CCMT",33,0)
+ K @ZTEMP
+"RTN","C0CCMT",34,0)
+ N ZBLD
+"RTN","C0CCMT",35,0)
+ S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"NOTEBLD")) ; BUILD LIST AREA
+"RTN","C0CCMT",36,0)
+ D QUEUE^C0CXPATH(ZBLD,NOTEXML,1,1) ; FIRST LINE
+"RTN","C0CCMT",37,0)
+ N ZINNER
+"RTN","C0CCMT",38,0)
+ D QUERY^C0CXPATH(NOTEXML,"//Comments/Comment","ZINNER") ;ONE NOTE
+"RTN","C0CCMT",39,0)
+ N ZTMP,ZVAR,ZI
+"RTN","C0CCMT",40,0)
+ S ZI=""
+"RTN","C0CCMT",41,0)
+ F  S ZI=$O(@C0CNTE@(ZI)) Q:ZI=""  D  ;FOR EACH NOTE
+"RTN","C0CCMT",42,0)
+ . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS NOTE XML
+"RTN","C0CCMT",43,0)
+ . S ZVAR=$NA(@C0CNTE@(ZI)) ;THIS NOTE VARIABLES
+"RTN","C0CCMT",44,0)
+ . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
+"RTN","C0CCMT",45,0)
+ . N ZNOTE,ZN
+"RTN","C0CCMT",46,0)
+ . D CLEAN($NA(@C0CNTE@(ZI,"TEXT"))) ;REMOVE CONTROL CHARS AND XML RESERVED
+"RTN","C0CCMT",47,0)
+ . M ZNOTE=@C0CNTE@(ZI,"TEXT") ;THE NOTE TO ADD TO THE BUILD
+"RTN","C0CCMT",48,0)
+ . S ZNOTE(0)=$O(ZNOTE(""),-1) ;LENGTH OF THE NOTE
+"RTN","C0CCMT",49,0)
+ . D INSERT^C0CXPATH(ZTMP,"ZNOTE","//Comment/Description/Text")
+"RTN","C0CCMT",50,0)
+ . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
+"RTN","C0CCMT",51,0)
+ D QUEUE^C0CXPATH(ZBLD,NOTEXML,@NOTEXML@(0),@NOTEXML@(0))
+"RTN","C0CCMT",52,0)
+ N ZZTMP
+"RTN","C0CCMT",53,0)
+ D BUILD^C0CXPATH(ZBLD,NOTEOUT) ;BUILD FINAL XML
+"RTN","C0CCMT",54,0)
+ K @ZTEMP,@ZBLD,@C0CNTE
+"RTN","C0CCMT",55,0)
  Q
-"RTN","C0CCMT",31,0)
- ;
-"RTN","C0CCMT",32,0)
-MAP(NOTEXML,C0CNTE,NOTEOUT) ; MAP PROCEDURES XML 
-"RTN","C0CCMT",33,0)
- ;
-"RTN","C0CCMT",34,0)
- N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"NOTETEMP")) ;WORK AREA FOR TEMPLATE
-"RTN","C0CCMT",35,0)
- K @ZTEMP
-"RTN","C0CCMT",36,0)
- N ZBLD
-"RTN","C0CCMT",37,0)
- S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"NOTEBLD")) ; BUILD LIST AREA
-"RTN","C0CCMT",38,0)
- D QUEUE^C0CXPATH(ZBLD,NOTEXML,1,1) ; FIRST LINE
-"RTN","C0CCMT",39,0)
- N ZINNER
-"RTN","C0CCMT",40,0)
- D QUERY^C0CXPATH(NOTEXML,"//Comments/Comment","ZINNER") ;ONE NOTE
-"RTN","C0CCMT",41,0)
- N ZTMP,ZVAR,ZI
-"RTN","C0CCMT",42,0)
- S ZI=""
-"RTN","C0CCMT",43,0)
- F  S ZI=$O(@C0CNTE@(ZI)) Q:ZI=""  D  ;FOR EACH NOTE
-"RTN","C0CCMT",44,0)
- . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS NOTE XML
-"RTN","C0CCMT",45,0)
- . S ZVAR=$NA(@C0CNTE@(ZI)) ;THIS NOTE VARIABLES
-"RTN","C0CCMT",46,0)
- . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
-"RTN","C0CCMT",47,0)
- . N ZNOTE,ZN
-"RTN","C0CCMT",48,0)
- . D CLEAN($NA(@C0CNTE@(ZI,"TEXT"))) ;REMOVE CONTROL CHARS AND XML RESERVED
-"RTN","C0CCMT",49,0)
- . M ZNOTE=@C0CNTE@(ZI,"TEXT") ;THE NOTE TO ADD TO THE BUILD
-"RTN","C0CCMT",50,0)
- . S ZNOTE(0)=$O(ZNOTE(""),-1) ;LENGTH OF THE NOTE
-"RTN","C0CCMT",51,0)
- . D INSERT^C0CXPATH(ZTMP,"ZNOTE","//Comment/Description/Text")
-"RTN","C0CCMT",52,0)
- . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
-"RTN","C0CCMT",53,0)
- D QUEUE^C0CXPATH(ZBLD,NOTEXML,@NOTEXML@(0),@NOTEXML@(0))
-"RTN","C0CCMT",54,0)
- N ZZTMP
-"RTN","C0CCMT",55,0)
- D BUILD^C0CXPATH(ZBLD,NOTEOUT) ;BUILD FINAL XML
 "RTN","C0CCMT",56,0)
- K @ZTEMP,@ZBLD,@C0CNTE
+ ;  
 "RTN","C0CCMT",57,0)
+CLEAN(INARY) ; INARY IS PASSED BY NAME
+"RTN","C0CCMT",58,0)
+ ; REMOVE CONTROL CHARACTERS AND XML RESERVED SYMBOLS FROM THE ARRAY
+"RTN","C0CCMT",59,0)
+ N ZI,ZJ S ZI=""
+"RTN","C0CCMT",60,0)
+ F  S ZI=$O(@INARY@(ZI)) Q:ZI=""  D  ;
+"RTN","C0CCMT",61,0)
+ . S @INARY@(ZI)=$$CLEAN^C0CXPATH(@INARY@(ZI)) ; CONTROL CHARS
+"RTN","C0CCMT",62,0)
+ . S @INARY@(ZI)=$$SYMENC^MXMLUTL(@INARY@(ZI)) ; XML RESERVED SYMBOLS
+"RTN","C0CCMT",63,0)
  Q
-"RTN","C0CCMT",58,0)
- ;  
-"RTN","C0CCMT",59,0)
-CLEAN(INARY) ; INARY IS PASSED BY NAME
-"RTN","C0CCMT",60,0)
- ; REMOVE CONTROL CHARACTERS AND XML RESERVED SYMBOLS FROM THE ARRAY
-"RTN","C0CCMT",61,0)
- N ZI,ZJ S ZI=""
-"RTN","C0CCMT",62,0)
- F  S ZI=$O(@INARY@(ZI)) Q:ZI=""  D  ;
-"RTN","C0CCMT",63,0)
- . S @INARY@(ZI)=$$CLEAN^C0CXPATH(@INARY@(ZI)) ; CONTROL CHARS
 "RTN","C0CCMT",64,0)
- . S @INARY@(ZI)=$$SYMENC^MXMLUTL(@INARY@(ZI)) ; XML RESERVED SYMBOLS
-"RTN","C0CCMT",65,0)
- Q
-"RTN","C0CCMT",66,0)
  ;
 "RTN","C0CCPT")
-0^68^B16531537
+0^68^B17485471
 "RTN","C0CCPT",1,0)
 C0CCPT ;;BSL;RETURN CPT DATA;
 "RTN","C0CCPT",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CCPT",3,0)
- ;Sequence Managers Software GPL;;;;;Build 2
+ ; (C) George Lilly 2010
 "RTN","C0CCPT",4,0)
- ;Copied into C0C namespace from SQMCPT with permission from
+ ;
 "RTN","C0CCPT",5,0)
- ;Brian Lord - and with our thanks. gpl 01/20/2010
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CCPT",6,0)
+ ; it under the terms of the GNU Affero General Public License as
+"RTN","C0CCPT",7,0)
+ ; published by the Free Software Foundation, either version 3 of the
+"RTN","C0CCPT",8,0)
+ ; License, or (at your option) any later version.
+"RTN","C0CCPT",9,0)
+ ;
+"RTN","C0CCPT",10,0)
+ ; This program is distributed in the hope that it will be useful,
+"RTN","C0CCPT",11,0)
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","C0CCPT",12,0)
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","C0CCPT",13,0)
+ ; GNU Affero General Public License for more details.
+"RTN","C0CCPT",14,0)
+ ;
+"RTN","C0CCPT",15,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CCPT",16,0)
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+"RTN","C0CCPT",17,0)
+ ;
+"RTN","C0CCPT",18,0)
 ENTRY(DFN,STDT,ENDDT,TXT) ;BUILD TOTAL ARRAY OF ALL IEN'S FOR TIU NOTES
-"RTN","C0CCPT",7,0)
+"RTN","C0CCPT",19,0)
  ;DFN=PATIENT IEN
-"RTN","C0CCPT",8,0)
+"RTN","C0CCPT",20,0)
  ;STDT=START DATE IN 3100101 FORMAT (VA YEAR YYYMMDD)
-"RTN","C0CCPT",9,0)
+"RTN","C0CCPT",21,0)
  ;ENDDT=END DATE IN 3100101 FORMAT
-"RTN","C0CCPT",10,0)
+"RTN","C0CCPT",22,0)
  ;TXT=INCLUDE TEXT FROM ENCOUNTER NOTE
-"RTN","C0CCPT",11,0)
+"RTN","C0CCPT",23,0)
  ;THAT FALL INSIDE DATA RANGE. IF NO STDT OR ENDDT ASSUME 
-"RTN","C0CCPT",12,0)
-        ;ALL INCLUSIVE IN THAT DIRECTION
-"RTN","C0CCPT",13,0)
-        ;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN)
-"RTN","C0CCPT",14,0)
-        ;BUILD INTO NOTE(Y)=""
-"RTN","C0CCPT",15,0)
-        S U="^",X=""
-"RTN","C0CCPT",16,0)
-        F  S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X=""  D
-"RTN","C0CCPT",17,0)
-        . S Y=""
-"RTN","C0CCPT",18,0)
-        . F  S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y=""  D
-"RTN","C0CCPT",19,0)
-        .. S NOTE(Y)=""
-"RTN","C0CCPT",20,0)
-        ;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE
-"RTN","C0CCPT",21,0)
-        ;GET DATE OF NOTE
-"RTN","C0CCPT",22,0)
+"RTN","C0CCPT",24,0)
+ ;ALL INCLUSIVE IN THAT DIRECTION
+"RTN","C0CCPT",25,0)
+ ;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN)
+"RTN","C0CCPT",26,0)
+ ;BUILD INTO NOTE(Y)=""
+"RTN","C0CCPT",27,0)
+ S U="^",X=""
+"RTN","C0CCPT",28,0)
+ F  S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X=""  D
+"RTN","C0CCPT",29,0)
+ . S Y=""
+"RTN","C0CCPT",30,0)
+ . F  S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y=""  D
+"RTN","C0CCPT",31,0)
+ .. S NOTE(Y)=""
+"RTN","C0CCPT",32,0)
+ ;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE
+"RTN","C0CCPT",33,0)
+ ;GET DATE OF NOTE
+"RTN","C0CCPT",34,0)
  ;RUT 3120109 Changing DATE in FILMAN's FORMAT
-"RTN","C0CCPT",23,0)
- ;;OHUM/RUT 3111228 Date Range for Notes
-"RTN","C0CCPT",24,0)
-        ;S STDT=^TMP("C0CCCR","TIULIMIT") D NOW^%DTC S ENDDT=X
-"RTN","C0CCPT",25,0)
+"RTN","C0CCPT",35,0)
+ ;OHUM/RUT 3111228 Date Range for Notes
+"RTN","C0CCPT",36,0)
+ ;S STDT=^TMP("C0CCCR","TIULIMIT") D NOW^%DTC S ENDDT=X
+"RTN","C0CCPT",37,0)
  N FLAGS1,FLAGS2
-"RTN","C0CCPT",26,0)
+"RTN","C0CCPT",38,0)
  S FLAGS1=$P(^C0CPARM(1,2),"^",1) S STDT=$$HTOF^C0CVALID(FLAGS1)
-"RTN","C0CCPT",27,0)
+"RTN","C0CCPT",39,0)
  S FLAGS2=$P(^C0CPARM(1,2),"^",2) S ENDDT=$$HTOF^C0CVALID(FLAGS2)
-"RTN","C0CCPT",28,0)
+"RTN","C0CCPT",40,0)
  ;S STDT=^TMP("C0CCCR","TIULIMIT"),ENDDT=^TMP("C0CCCR","TIUSTART")
-"RTN","C0CCPT",29,0)
-        ;;OHUM/RUT
-"RTN","C0CCPT",30,0)
+"RTN","C0CCPT",41,0)
+ ;OHUM/RUT
+"RTN","C0CCPT",42,0)
  ;RUT
-"RTN","C0CCPT",31,0)
-        S Z=""
-"RTN","C0CCPT",32,0)
-        F  S Z=$O(NOTE(Z)) Q:Z=""  D
-"RTN","C0CCPT",33,0)
-        . S DT=$P(^TIU(8925,Z,0),U,7)
-"RTN","C0CCPT",34,0)
-        . I $G(STDT)]"" D
-"RTN","C0CCPT",35,0)
-        .. I STDT>DT S NOTE(Z)="D"  ;SET NOTE TO BE DELETED
-"RTN","C0CCPT",36,0)
-        . I $G(ENDDT)]"" D
-"RTN","C0CCPT",37,0)
-        .. I ENDDT<DT S NOTE(Z)="D"
-"RTN","C0CCPT",38,0)
-        . I NOTE(Z)="D" K NOTE(Z)
-"RTN","C0CCPT",39,0)
+"RTN","C0CCPT",43,0)
+ S Z=""
+"RTN","C0CCPT",44,0)
+ F  S Z=$O(NOTE(Z)) Q:Z=""  D
+"RTN","C0CCPT",45,0)
+ . S DT=$P(^TIU(8925,Z,0),U,7)
+"RTN","C0CCPT",46,0)
+ . I $G(STDT)]"" D
+"RTN","C0CCPT",47,0)
+ .. I STDT>DT S NOTE(Z)="D"  ;SET NOTE TO BE DELETED
+"RTN","C0CCPT",48,0)
+ . I $G(ENDDT)]"" D
+"RTN","C0CCPT",49,0)
+ .. I ENDDT<DT S NOTE(Z)="D"
+"RTN","C0CCPT",50,0)
+ . I NOTE(Z)="D" K NOTE(Z)
+"RTN","C0CCPT",51,0)
  D VISIT
-"RTN","C0CCPT",40,0)
-        Q
-"RTN","C0CCPT",41,0)
+"RTN","C0CCPT",52,0)
+ Q
+"RTN","C0CCPT",53,0)
 VISIT   ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT
-"RTN","C0CCPT",42,0)
+"RTN","C0CCPT",54,0)
  S ILST=1,X0="",X12="",VISIT="",LST="",X811=""
-"RTN","C0CCPT",43,0)
+"RTN","C0CCPT",55,0)
  S IEN=""  F  S IEN=$O(NOTE(IEN)) Q:IEN=""  D
-"RTN","C0CCPT",44,0)
+"RTN","C0CCPT",56,0)
  . S X0=^TIU(8925,IEN,0),X12=$G(^(12))
-"RTN","C0CCPT",45,0)
+"RTN","C0CCPT",57,0)
  . S VISIT=$P(X12,U,7)
-"RTN","C0CCPT",46,0)
+"RTN","C0CCPT",58,0)
  . I 'VISIT S VISIT=$P(X0,U,3)
-"RTN","C0CCPT",47,0)
+"RTN","C0CCPT",59,0)
  . K ^TMP("PXKENC",$J)
-"RTN","C0CCPT",48,0)
+"RTN","C0CCPT",60,0)
  . Q:VISIT=""!(VISIT'>0)
-"RTN","C0CCPT",49,0)
+"RTN","C0CCPT",61,0)
  . D ENCEVENT^PXKENC(VISIT,1)
-"RTN","C0CCPT",50,0)
+"RTN","C0CCPT",62,0)
  . I '$D(^TMP("PXKENC",$J,VISIT,"VST",VISIT,0)) Q
-"RTN","C0CCPT",51,0)
+"RTN","C0CCPT",63,0)
  . S IPRV=0 F  S IPRV=$O(^TMP("PXKENC",$J,VISIT,"PRV",IPRV)) Q:'IPRV  D
-"RTN","C0CCPT",52,0)
+"RTN","C0CCPT",64,0)
  .. S X0=^TMP("PXKENC",$J,VISIT,"PRV",IPRV,0)
-"RTN","C0CCPT",53,0)
+"RTN","C0CCPT",65,0)
  .. ;Q:$P(X0,U,4)'="P"
-"RTN","C0CCPT",54,0)
+"RTN","C0CCPT",66,0)
  .. S CODE=$P(X0,U),NARR=$P($G(^VA(200,CODE,0)),U)
-"RTN","C0CCPT",55,0)
+"RTN","C0CCPT",67,0)
  .. S PRIM=($P(X0,U,4)="P")
-"RTN","C0CCPT",56,0)
+"RTN","C0CCPT",68,0)
  .. S ILST=ILST+1
-"RTN","C0CCPT",57,0)
+"RTN","C0CCPT",69,0)
  .. S LST(ILST)="PRV"_U_CODE_"^^^"_NARR_"^"_PRIM
-"RTN","C0CCPT",58,0)
+"RTN","C0CCPT",70,0)
  .. S VISIT(IEN,"PRV",ILST)=CODE_"^^^"_NARR_"^"_PRIM
-"RTN","C0CCPT",59,0)
+"RTN","C0CCPT",71,0)
  . S IPOV=0 F  S IPOV=$O(^TMP("PXKENC",$J,VISIT,"POV",IPOV)) Q:'IPOV  D
-"RTN","C0CCPT",60,0)
+"RTN","C0CCPT",72,0)
  .. S X0=^TMP("PXKENC",$J,VISIT,"POV",IPOV,0),X802=$G(^(802)),X811=$G(^(811))
-"RTN","C0CCPT",61,0)
+"RTN","C0CCPT",73,0)
  .. S CODE=$P(X0,U)
-"RTN","C0CCPT",62,0)
+"RTN","C0CCPT",74,0)
  .. S:CODE CODE=$P(^ICD9(CODE,0),U)
-"RTN","C0CCPT",63,0)
+"RTN","C0CCPT",75,0)
  .. S CAT=$P(X802,U)
-"RTN","C0CCPT",64,0)
+"RTN","C0CCPT",76,0)
  .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
-"RTN","C0CCPT",65,0)
+"RTN","C0CCPT",77,0)
  .. S NARR=$P(X0,U,4)
-"RTN","C0CCPT",66,0)
+"RTN","C0CCPT",78,0)
  .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
-"RTN","C0CCPT",67,0)
+"RTN","C0CCPT",79,0)
  .. S PRIM=($P(X0,U,12)="P")
-"RTN","C0CCPT",68,0)
+"RTN","C0CCPT",80,0)
  .. S PRV=$P(X12,U,4)
-"RTN","C0CCPT",69,0)
+"RTN","C0CCPT",81,0)
  .. S ILST=ILST+1
-"RTN","C0CCPT",70,0)
+"RTN","C0CCPT",82,0)
  .. S LST(ILST)="POV"_U_CODE_U_CAT_U_NARR_U_PRIM_U_PRV
-"RTN","C0CCPT",71,0)
+"RTN","C0CCPT",83,0)
  .. S VISIT(IEN,"POV",ILST)=CODE_U_CAT_U_NARR_U_PRIM_U_PRV
-"RTN","C0CCPT",72,0)
+"RTN","C0CCPT",84,0)
  . S ICPT=0 F  S ICPT=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT)) Q:'ICPT  D
-"RTN","C0CCPT",73,0)
+"RTN","C0CCPT",85,0)
  .. S X0=^TMP("PXKENC",$J,VISIT,"CPT",ICPT,0),X802=$G(^(802)),X12=$G(^(12)),X811=$G(^(811))
-"RTN","C0CCPT",74,0)
+"RTN","C0CCPT",86,0)
  .. ;S CODE=$P(X0,U)
-"RTN","C0CCPT",75,0)
+"RTN","C0CCPT",87,0)
  .. S CODE=$O(^ICPT("B",$P(X0,U),0))
-"RTN","C0CCPT",76,0)
+"RTN","C0CCPT",88,0)
  .. S:CODE CODE=$P(^ICPT(CODE,0),U)
-"RTN","C0CCPT",77,0)
+"RTN","C0CCPT",89,0)
  .. S CAT=$P(X802,U)
-"RTN","C0CCPT",78,0)
+"RTN","C0CCPT",90,0)
  .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
-"RTN","C0CCPT",79,0)
+"RTN","C0CCPT",91,0)
  .. S NARR=$P(X0,U,4)
-"RTN","C0CCPT",80,0)
+"RTN","C0CCPT",92,0)
  .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
-"RTN","C0CCPT",81,0)
+"RTN","C0CCPT",93,0)
  .. S QTY=$P(X0,U,16)
-"RTN","C0CCPT",82,0)
+"RTN","C0CCPT",94,0)
  .. S PRV=$P(X12,U,4)
-"RTN","C0CCPT",83,0)
+"RTN","C0CCPT",95,0)
  .. S MCNT=0,MIDX=0,MODS=""
-"RTN","C0CCPT",84,0)
+"RTN","C0CCPT",96,0)
  .. F  S MIDX=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX)) Q:'MIDX  D
-"RTN","C0CCPT",85,0)
+"RTN","C0CCPT",97,0)
  ... S MIEN=$G(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX,0))
-"RTN","C0CCPT",86,0)
+"RTN","C0CCPT",98,0)
  ... I +MIEN S MCNT=MCNT+1,MODS=MODS_";/"_MIEN
-"RTN","C0CCPT",87,0)
+"RTN","C0CCPT",99,0)
  .. I +MCNT S MODS=MCNT_MODS
-"RTN","C0CCPT",88,0)
+"RTN","C0CCPT",100,0)
  .. S ILST=ILST+1
-"RTN","C0CCPT",89,0)
+"RTN","C0CCPT",101,0)
  .. S LST(ILST)="CPT"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS
-"RTN","C0CCPT",90,0)
+"RTN","C0CCPT",102,0)
  .. S VISIT(IEN,"CPT",ILST)=CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS
-"RTN","C0CCPT",91,0)
+"RTN","C0CCPT",103,0)
  . S VISIT(IEN,"DATE",0)=$P($P(^TIU(8925,IEN,0),U,7),".")
-"RTN","C0CCPT",92,0)
+"RTN","C0CCPT",104,0)
  . S VISIT(IEN,"CLASS")=$$GET1^DIQ(8925,IEN_",",.04) ;GPL 5/21/10
-"RTN","C0CCPT",93,0)
+"RTN","C0CCPT",105,0)
  . I $G(TXT)=1 D GETNOTE(IEN)
-"RTN","C0CCPT",94,0)
+"RTN","C0CCPT",106,0)
  Q
-"RTN","C0CCPT",95,0)
+"RTN","C0CCPT",107,0)
 GETNOTE(IEN) ;GET THE TEXT THAT GOES WITH VISIT
-"RTN","C0CCPT",96,0)
+"RTN","C0CCPT",108,0)
  ;EXTRACT NOTE TEXT FROM ^TIU(8925,IEN,"TEXT"
-"RTN","C0CCPT",97,0)
+"RTN","C0CCPT",109,0)
  Q:'$D(VISIT(IEN,"CPT"))
-"RTN","C0CCPT",98,0)
+"RTN","C0CCPT",110,0)
  S TXTCNT=0
-"RTN","C0CCPT",99,0)
+"RTN","C0CCPT",111,0)
  F  S TXTCNT=TXTCNT+1 Q:'$D(^TIU(8925,IEN,"TEXT",TXTCNT,0))  D
-"RTN","C0CCPT",100,0)
+"RTN","C0CCPT",112,0)
  . S VISIT(IEN,"TEXT",TXTCNT)=^TIU(8925,IEN,"TEXT",TXTCNT,0)
-"RTN","C0CCPT",101,0)
+"RTN","C0CCPT",113,0)
  Q
 "RTN","C0CDIC")
-0^73^B43527636
+0^73^B42907516
 "RTN","C0CDIC",1,0)
 C0CDIC   ; CCDCCR/GPL - CCR Dictionary utilities; 6/1/08
 "RTN","C0CDIC",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CDIC",3,0)
- ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;Copyright 2008 WorldVistA.  
 "RTN","C0CDIC",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CDIC",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CDIC",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CDIC",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CDIC",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CDIC",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CDIC",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CDIC",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CDIC",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CDIC",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CDIC",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CDIC",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CDIC",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CDIC",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CDIC",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ W "This is the CCR Dictionary Utility Library ",!
 "RTN","C0CDIC",19,0)
- ;
+ W !
 "RTN","C0CDIC",20,0)
- W "This is the CCR Dictionary Utility Library ",!
+ Q
 "RTN","C0CDIC",21,0)
- W !
+ ;
 "RTN","C0CDIC",22,0)
+DIC2CSV ;OUTPUT THE CCR DICTIONARY TO A CSV FILE
+"RTN","C0CDIC",23,0)
+ ;
+"RTN","C0CDIC",24,0)
+ N ZI
+"RTN","C0CDIC",25,0)
+ S ZI=""
+"RTN","C0CDIC",26,0)
+ S G1=$NA(^TMP($J,"C0CCSV",1))
+"RTN","C0CDIC",27,0)
+ S G1A=$NA(@G1@("V"))
+"RTN","C0CDIC",28,0)
+ S G2=$NA(^TMP($J,"C0CCSV",2))
+"RTN","C0CDIC",29,0)
+ D GETN2^C0CRNF(G1,170) ; GET THE MATRIX
+"RTN","C0CDIC",30,0)
+ F  S ZI=$O(@G1A@(ZI)) Q:ZI=""  D  ;FOR EACH ROW IN THE MATRIX
+"RTN","C0CDIC",31,0)
+ . I $G(@G1A@(ZI,"MAPPING METHOD",1))'="" D  ;
+"RTN","C0CDIC",32,0)
+ . . W @G1A@(ZI,"MAPPING METHOD",1),!
+"RTN","C0CDIC",33,0)
+ . . ;K @G1A@(ZI,"MAPPING METHOD")
+"RTN","C0CDIC",34,0)
+ . ;W !,ZI,$G(@G1A@(ZI,"MAPPING METHOD",1))
+"RTN","C0CDIC",35,0)
+ D RNF2CSV^C0CRNF(G2,G1,"VN") ; PREPARE THE CVS FILE
+"RTN","C0CDIC",36,0)
+ K @G1
+"RTN","C0CDIC",37,0)
+ D FILEOUT^C0CRNF(G2,"FILE_"_170_".csv")
+"RTN","C0CDIC",38,0)
+ K @G2
+"RTN","C0CDIC",39,0)
  Q
-"RTN","C0CDIC",23,0)
- ;
-"RTN","C0CDIC",24,0)
-DIC2CSV ;OUTPUT THE CCR DICTIONARY TO A CSV FILE
-"RTN","C0CDIC",25,0)
- ;
-"RTN","C0CDIC",26,0)
- N ZI
-"RTN","C0CDIC",27,0)
- S ZI=""
-"RTN","C0CDIC",28,0)
- S G1=$NA(^TMP($J,"C0CCSV",1))
-"RTN","C0CDIC",29,0)
- S G1A=$NA(@G1@("V"))
-"RTN","C0CDIC",30,0)
- S G2=$NA(^TMP($J,"C0CCSV",2))
-"RTN","C0CDIC",31,0)
- D GETN2^C0CRNF(G1,170) ; GET THE MATRIX
-"RTN","C0CDIC",32,0)
- F  S ZI=$O(@G1A@(ZI)) Q:ZI=""  D  ;FOR EACH ROW IN THE MATRIX
-"RTN","C0CDIC",33,0)
- . I $G(@G1A@(ZI,"MAPPING METHOD",1))'="" D  ;
-"RTN","C0CDIC",34,0)
- . . W @G1A@(ZI,"MAPPING METHOD",1),!
-"RTN","C0CDIC",35,0)
- . . ;K @G1A@(ZI,"MAPPING METHOD")
-"RTN","C0CDIC",36,0)
- . ;W !,ZI,$G(@G1A@(ZI,"MAPPING METHOD",1))
-"RTN","C0CDIC",37,0)
- D RNF2CSV^C0CRNF(G2,G1,"VN") ; PREPARE THE CVS FILE
-"RTN","C0CDIC",38,0)
- K @G1
-"RTN","C0CDIC",39,0)
- D FILEOUT^C0CRNF(G2,"FILE_"_170_".csv")
 "RTN","C0CDIC",40,0)
- K @G2
+ ;
 "RTN","C0CDIC",41,0)
+GVARS(C0CVARS,C0CT) ; Get the CCR variables from the CCR template
+"RTN","C0CDIC",42,0)
+ ; and return them in C0CVARS, which is passed by name
+"RTN","C0CDIC",43,0)
+ ; FIRST PIECE OF C0CVARS(x) IS THE VARIABLE NAME, SECOND PIECE
+"RTN","C0CDIC",44,0)
+ ; IS THE LINE NUMBER OF THE VARIABLE IN THE TEMPLATE
+"RTN","C0CDIC",45,0)
+ ; C0CT IS RETURNED AS THE CCR TEMPLATE
+"RTN","C0CDIC",46,0)
+ N C0CTVARS ; ARRAY FOR THE TEMPLATE AND ARRAY FOR THE VARS
+"RTN","C0CDIC",47,0)
+ D LOAD^GPLCCR0(C0CT) ; LOAD THE CCR TEMPLATE
+"RTN","C0CDIC",48,0)
+ D XVARS^GPLXPATH("C0CTVARS",C0CT) ; PULL OUT THE VARS
+"RTN","C0CDIC",49,0)
+ N C0CI,C0CX
+"RTN","C0CDIC",50,0)
+ S @C0CVARS@(0)=C0CTVARS(0) ; SAME COUNT
+"RTN","C0CDIC",51,0)
+ F C0CI=1:1:C0CTVARS(0) D  ; FOR EVERY LINE IN THE ARRAY
+"RTN","C0CDIC",52,0)
+ . S C0CX=C0CTVARS(C0CI) ; THE VARIABLE - 3 PIECES, FIRST ONE NULL
+"RTN","C0CDIC",53,0)
+ . S @C0CVARS@(C0CI)=$P(C0CX,"^",2)_"^"_$P(C0CX,"^",3) ; VAR NAME^LINE NUMBER
+"RTN","C0CDIC",54,0)
+ ;D PARY^GPLXPATH("C0CVARS")
+"RTN","C0CDIC",55,0)
  Q
-"RTN","C0CDIC",42,0)
- ;
-"RTN","C0CDIC",43,0)
-GVARS(C0CVARS,C0CT) ; Get the CCR variables from the CCR template
-"RTN","C0CDIC",44,0)
- ; and return them in C0CVARS, which is passed by name
-"RTN","C0CDIC",45,0)
- ; FIRST PIECE OF C0CVARS(x) IS THE VARIABLE NAME, SECOND PIECE
-"RTN","C0CDIC",46,0)
- ; IS THE LINE NUMBER OF THE VARIABLE IN THE TEMPLATE
-"RTN","C0CDIC",47,0)
- ; C0CT IS RETURNED AS THE CCR TEMPLATE
-"RTN","C0CDIC",48,0)
- N C0CTVARS ; ARRAY FOR THE TEMPLATE AND ARRAY FOR THE VARS
-"RTN","C0CDIC",49,0)
- D LOAD^GPLCCR0(C0CT) ; LOAD THE CCR TEMPLATE
-"RTN","C0CDIC",50,0)
- D XVARS^GPLXPATH("C0CTVARS",C0CT) ; PULL OUT THE VARS
-"RTN","C0CDIC",51,0)
- N C0CI,C0CX
-"RTN","C0CDIC",52,0)
- S @C0CVARS@(0)=C0CTVARS(0) ; SAME COUNT
-"RTN","C0CDIC",53,0)
- F C0CI=1:1:C0CTVARS(0) D  ; FOR EVERY LINE IN THE ARRAY
-"RTN","C0CDIC",54,0)
- . S C0CX=C0CTVARS(C0CI) ; THE VARIABLE - 3 PIECES, FIRST ONE NULL
-"RTN","C0CDIC",55,0)
- . S @C0CVARS@(C0CI)=$P(C0CX,"^",2)_"^"_$P(C0CX,"^",3) ; VAR NAME^LINE NUMBER
 "RTN","C0CDIC",56,0)
- ;D PARY^GPLXPATH("C0CVARS")
+ ;
 "RTN","C0CDIC",57,0)
+GXPATH(C0CPVARS,C0CPT) ; LOAD THE CCR TEMPLATE INTO C0CPT, PULL OUT VARIABLES
+"RTN","C0CDIC",58,0)
+ ; AND THE XPATH TO THE VARIABLES INTO C0CPVARS
+"RTN","C0CDIC",59,0)
+ ; BY INDEXING THE TEMPLATE C0CT AND MATCHING THE XPATH TO THE VARIABLE
+"RTN","C0CDIC",60,0)
+ ; BOTH ARE PASSED BY NAME
+"RTN","C0CDIC",61,0)
+ ; C0CPVARS(x) IS VAR^LINENUM^XPATH SORTED BY LINENUM
+"RTN","C0CDIC",62,0)
+ ; C0CPVARS(0) IS NUMBER OF VARIABLES
+"RTN","C0CDIC",63,0)
+ ; C0CPT(0) IS NUMBER OF LINES IN THE TEMPLATE
+"RTN","C0CDIC",64,0)
+ D GVARS(C0CPVARS,C0CPT) ; GET THE VARIABLES AND LINE NUMBERS
+"RTN","C0CDIC",65,0)
+ ;N C0CTVARS ; HASH TABLE FOR VARIABLE BY LINE NUMBER
+"RTN","C0CDIC",66,0)
+ D HASHV ; PUT THE VARIABLES IN A LINE NUMBER HASH FOR MATCHING TO XPATHS
+"RTN","C0CDIC",67,0)
+ ; NOW GO GET THE XPATH INDEXES
+"RTN","C0CDIC",68,0)
+ D INDEX^GPLXPATH(C0CPT) ; ADD THE XPATH INDEXES TO THE TEMPLATE ARRAY
+"RTN","C0CDIC",69,0)
+ S C0CI="" ; GOING TO LOOP THROUGH THE WHOLE ARRAY LOOKING AT XPATHS
+"RTN","C0CDIC",70,0)
+ F  S C0CI=$O(@C0CPT@(C0CI)) Q:C0CI=""  D  ; VISIT EVERY LINE
+"RTN","C0CDIC",71,0)
+ . I +C0CI'=0 Q  ; SKIP EVERYTHING BUT THE XPATH INDEX
+"RTN","C0CDIC",72,0)
+ . I C0CI=0 Q  ; SKIP THE ZERO NODE
+"RTN","C0CDIC",73,0)
+ . S C0CX=@C0CPT@(C0CI) ; PULL OUT THE LINE NUMBERS X^Y
+"RTN","C0CDIC",74,0)
+ . S C0CY=$P(C0CX,"^",1) ; STARTING LINE NUMBER
+"RTN","C0CDIC",75,0)
+ . S C0CZ=$P(C0CX,"^",2) ; ENDING LINE NUMBER
+"RTN","C0CDIC",76,0)
+ . I C0CY=C0CZ D  ; THIS IS AN XPATH END NODE, HAS A VARIABLE (WE HOPE)
+"RTN","C0CDIC",77,0)
+ . . ; W "FOUND ",C0CI,!
+"RTN","C0CDIC",78,0)
+ . . I $D(C0CTVARS(C0CY)) D  ; IF THERE IS A VARIABLE THERE
+"RTN","C0CDIC",79,0)
+ . . . S $P(C0CTVARS(C0CY),"^",3)=C0CI ; INSERT THE XPATH FOR THE VAR
+"RTN","C0CDIC",80,0)
+ D SORTV ; SORT THE ARRAY BY LINE NUMBER
+"RTN","C0CDIC",81,0)
  Q
-"RTN","C0CDIC",58,0)
- ;
-"RTN","C0CDIC",59,0)
-GXPATH(C0CPVARS,C0CPT) ; LOAD THE CCR TEMPLATE INTO C0CPT, PULL OUT VARIABLES
-"RTN","C0CDIC",60,0)
- ; AND THE XPATH TO THE VARIABLES INTO C0CPVARS
-"RTN","C0CDIC",61,0)
- ; BY INDEXING THE TEMPLATE C0CT AND MATCHING THE XPATH TO THE VARIABLE
-"RTN","C0CDIC",62,0)
- ; BOTH ARE PASSED BY NAME
-"RTN","C0CDIC",63,0)
- ; C0CPVARS(x) IS VAR^LINENUM^XPATH SORTED BY LINENUM
-"RTN","C0CDIC",64,0)
- ; C0CPVARS(0) IS NUMBER OF VARIABLES
-"RTN","C0CDIC",65,0)
- ; C0CPT(0) IS NUMBER OF LINES IN THE TEMPLATE
-"RTN","C0CDIC",66,0)
- D GVARS(C0CPVARS,C0CPT) ; GET THE VARIABLES AND LINE NUMBERS
-"RTN","C0CDIC",67,0)
- ;N C0CTVARS ; HASH TABLE FOR VARIABLE BY LINE NUMBER
-"RTN","C0CDIC",68,0)
- D HASHV ; PUT THE VARIABLES IN A LINE NUMBER HASH FOR MATCHING TO XPATHS
-"RTN","C0CDIC",69,0)
- ; NOW GO GET THE XPATH INDEXES
-"RTN","C0CDIC",70,0)
- D INDEX^GPLXPATH(C0CPT) ; ADD THE XPATH INDEXES TO THE TEMPLATE ARRAY
-"RTN","C0CDIC",71,0)
- S C0CI="" ; GOING TO LOOP THROUGH THE WHOLE ARRAY LOOKING AT XPATHS
-"RTN","C0CDIC",72,0)
- F  S C0CI=$O(@C0CPT@(C0CI)) Q:C0CI=""  D  ; VISIT EVERY LINE
-"RTN","C0CDIC",73,0)
- . I +C0CI'=0 Q  ; SKIP EVERYTHING BUT THE XPATH INDEX
-"RTN","C0CDIC",74,0)
- . I C0CI=0 Q  ; SKIP THE ZERO NODE
-"RTN","C0CDIC",75,0)
- . S C0CX=@C0CPT@(C0CI) ; PULL OUT THE LINE NUMBERS X^Y
-"RTN","C0CDIC",76,0)
- . S C0CY=$P(C0CX,"^",1) ; STARTING LINE NUMBER
-"RTN","C0CDIC",77,0)
- . S C0CZ=$P(C0CX,"^",2) ; ENDING LINE NUMBER
-"RTN","C0CDIC",78,0)
- . I C0CY=C0CZ D  ; THIS IS AN XPATH END NODE, HAS A VARIABLE (WE HOPE)
-"RTN","C0CDIC",79,0)
- . . ; W "FOUND ",C0CI,!
-"RTN","C0CDIC",80,0)
- . . I $D(C0CTVARS(C0CY)) D  ; IF THERE IS A VARIABLE THERE
-"RTN","C0CDIC",81,0)
- . . . S $P(C0CTVARS(C0CY),"^",3)=C0CI ; INSERT THE XPATH FOR THE VAR
 "RTN","C0CDIC",82,0)
- D SORTV ; SORT THE ARRAY BY LINE NUMBER
+ ;
 "RTN","C0CDIC",83,0)
+HASHV ; INTERNAL ROUTINE TO PUT VARIABLE NAMES IN A LINE NUMBER HASH
+"RTN","C0CDIC",84,0)
+ ;N C0CI,C0CTVARS,C0CX,C0CY
+"RTN","C0CDIC",85,0)
+ F C0CI=1:1:@C0CPVARS@(0) D  ; FOR THE ENTIRE ARRAY
+"RTN","C0CDIC",86,0)
+ . S C0CX=$P(@C0CPVARS@(C0CI),"^",2) ; LINE NUMBER
+"RTN","C0CDIC",87,0)
+ . S C0CY=$P(@C0CPVARS@(C0CI),"^",1) ; VARIABLE NAME
+"RTN","C0CDIC",88,0)
+ . S C0CTVARS(C0CX)=C0CY ; BUILD HASH OF VARIABLES BY LINE NUMBER
+"RTN","C0CDIC",89,0)
  Q
-"RTN","C0CDIC",84,0)
- ;
-"RTN","C0CDIC",85,0)
-HASHV ; INTERNAL ROUTINE TO PUT VARIABLE NAMES IN A LINE NUMBER HASH
-"RTN","C0CDIC",86,0)
- ;N C0CI,C0CTVARS,C0CX,C0CY
-"RTN","C0CDIC",87,0)
- F C0CI=1:1:@C0CPVARS@(0) D  ; FOR THE ENTIRE ARRAY
-"RTN","C0CDIC",88,0)
- . S C0CX=$P(@C0CPVARS@(C0CI),"^",2) ; LINE NUMBER
-"RTN","C0CDIC",89,0)
- . S C0CY=$P(@C0CPVARS@(C0CI),"^",1) ; VARIABLE NAME
 "RTN","C0CDIC",90,0)
- . S C0CTVARS(C0CX)=C0CY ; BUILD HASH OF VARIABLES BY LINE NUMBER
+ ;
 "RTN","C0CDIC",91,0)
+SORTV ; INTERNAL ROUTINE TO OUTPUT VARIABLES (AND XPATHS) IN LINE NUMBER ORDER
+"RTN","C0CDIC",92,0)
+ ;N C0CV2 ; SCRACTH SPACE FOR BUILDING SORTED ARRAY
+"RTN","C0CDIC",93,0)
+ S C0CI="" ;
+"RTN","C0CDIC",94,0)
+ F  S C0CI=$O(C0CTVARS(C0CI)) Q:C0CI=""  D  ; BY LINE NUMBER
+"RTN","C0CDIC",95,0)
+ . S C0CX=C0CTVARS(C0CI) ;VARIABLE NAME
+"RTN","C0CDIC",96,0)
+ . S $P(C0CX,"^",2)=C0CI ; LINE NUMBER IS SECOND PIECE
+"RTN","C0CDIC",97,0)
+ . D PUSH^GPLXPATH("C0C2",C0CX) ; PUT ONTO ARRAY
+"RTN","C0CDIC",98,0)
+ K @C0CPVARS
+"RTN","C0CDIC",99,0)
+ M @C0CPVARS=C0C2
+"RTN","C0CDIC",100,0)
  Q
-"RTN","C0CDIC",92,0)
- ;
-"RTN","C0CDIC",93,0)
-SORTV ; INTERNAL ROUTINE TO OUTPUT VARIABLES (AND XPATHS) IN LINE NUMBER ORDER
-"RTN","C0CDIC",94,0)
- ;N C0CV2 ; SCRACTH SPACE FOR BUILDING SORTED ARRAY
-"RTN","C0CDIC",95,0)
- S C0CI="" ;
-"RTN","C0CDIC",96,0)
- F  S C0CI=$O(C0CTVARS(C0CI)) Q:C0CI=""  D  ; BY LINE NUMBER
-"RTN","C0CDIC",97,0)
- . S C0CX=C0CTVARS(C0CI) ;VARIABLE NAME
-"RTN","C0CDIC",98,0)
- . S $P(C0CX,"^",2)=C0CI ; LINE NUMBER IS SECOND PIECE
-"RTN","C0CDIC",99,0)
- . D PUSH^GPLXPATH("C0C2",C0CX) ; PUT ONTO ARRAY
-"RTN","C0CDIC",100,0)
- K @C0CPVARS
 "RTN","C0CDIC",101,0)
- M @C0CPVARS=C0C2
+ ;
 "RTN","C0CDIC",102,0)
+LOAD ; LOAD VARIABLE NAMES AND XPATH IN ^C0CDIC(170
+"RTN","C0CDIC",103,0)
+ ; INITIAL LOAD OF THE CCR DICTIONARY
+"RTN","C0CDIC",104,0)
+ ;
+"RTN","C0CDIC",105,0)
+ N C0CDIC,C0CARY,C0CXML,C0CFDA,C0CI
+"RTN","C0CDIC",106,0)
+ S C0CDIC="^C0CDIC(170," ; ROOT OF THE CCR DICTIONARY
+"RTN","C0CDIC",107,0)
+ D GXPATH("C0CARY","C0CXML") ; FETCH THE VARIABLES AND XPATH INTO C0CARY
+"RTN","C0CDIC",108,0)
+ ; C0CXML WILL CONTAIN THE TEMPLATE - NOT NEEDED FOR LOAD
+"RTN","C0CDIC",109,0)
+ D PARY^GPLXPATH("C0CARY") ;TEST
+"RTN","C0CDIC",110,0)
+ F C0CI=1:1:C0CARY(0) D  ; LOAD EACH VARIABLE
+"RTN","C0CDIC",111,0)
+ . S C0CFDA(170,"+"_C0CI_",",.01)=$P(C0CARY(C0CI),"^",1) ; VAR NAME
+"RTN","C0CDIC",112,0)
+ . S C0CFDA(170,"+"_C0CI_",",2)=$P(C0CARY(C0CI),"^",3) ; XPATH
+"RTN","C0CDIC",113,0)
+ . D UPDATE^DIE("","C0CFDA")
+"RTN","C0CDIC",114,0)
+ . I $D(^TMP("DIERR",$J)) U $P BREAK
+"RTN","C0CDIC",115,0)
+ . W "LOADING:",C0CI," ",C0CARY(C0CI),!
+"RTN","C0CDIC",116,0)
  Q
-"RTN","C0CDIC",103,0)
- ;
-"RTN","C0CDIC",104,0)
-LOAD ; LOAD VARIABLE NAMES AND XPATH IN ^C0CDIC(170
-"RTN","C0CDIC",105,0)
- ; INITIAL LOAD OF THE CCR DICTIONARY
-"RTN","C0CDIC",106,0)
- ;
-"RTN","C0CDIC",107,0)
- N C0CDIC,C0CARY,C0CXML,C0CFDA,C0CI
-"RTN","C0CDIC",108,0)
- S C0CDIC="^C0CDIC(170," ; ROOT OF THE CCR DICTIONARY
-"RTN","C0CDIC",109,0)
- D GXPATH("C0CARY","C0CXML") ; FETCH THE VARIABLES AND XPATH INTO C0CARY
-"RTN","C0CDIC",110,0)
- ; C0CXML WILL CONTAIN THE TEMPLATE - NOT NEEDED FOR LOAD
-"RTN","C0CDIC",111,0)
- D PARY^GPLXPATH("C0CARY") ;TEST
-"RTN","C0CDIC",112,0)
- F C0CI=1:1:C0CARY(0) D  ; LOAD EACH VARIABLE
-"RTN","C0CDIC",113,0)
- . S C0CFDA(170,"+"_C0CI_",",.01)=$P(C0CARY(C0CI),"^",1) ; VAR NAME
-"RTN","C0CDIC",114,0)
- . S C0CFDA(170,"+"_C0CI_",",2)=$P(C0CARY(C0CI),"^",3) ; XPATH
-"RTN","C0CDIC",115,0)
- . D UPDATE^DIE("","C0CFDA")
-"RTN","C0CDIC",116,0)
- . I $D(^TMP("DIERR",$J)) U $P BREAK
 "RTN","C0CDIC",117,0)
- . W "LOADING:",C0CI," ",C0CARY(C0CI),!
+ ;
 "RTN","C0CDIC",118,0)
+INIT ; INITIALIZE CCR DICTIONARY BASED ON VARIABLE NAMES
+"RTN","C0CDIC",119,0)
+ ;
+"RTN","C0CDIC",120,0)
+ ; CHEAT SHEET FOR VARIABLE NAMES IN ^C0CDIC(170.xx,
+"RTN","C0CDIC",121,0)
+ ; THIS IS WHAT WILL BE IN C0CA FOR EACH DICTIONARY ENTRY
+"RTN","C0CDIC",122,0)
+ ;G1("CODING")="170^8"
+"RTN","C0CDIC",123,0)
+ ;G1("DATA ELEMENT")="170^7"
+"RTN","C0CDIC",124,0)
+ ;G1("DESCRIPTION")="170^3"
+"RTN","C0CDIC",125,0)
+ ;G1("ID")="170^1"
+"RTN","C0CDIC",126,0)
+ ;G1("M","170^8","CODING")="170.08^.01"
+"RTN","C0CDIC",127,0)
+ ;G1("MAPPING METHOD")="170.08^1"
+"RTN","C0CDIC",128,0)
+ ;G1("SECTION")="170^10"
+"RTN","C0CDIC",129,0)
+ ;G1("SOURCE")="170^4"
+"RTN","C0CDIC",130,0)
+ ;G1("STATUS")="170^9"
+"RTN","C0CDIC",131,0)
+ ;G1("TYPE")="170^6"
+"RTN","C0CDIC",132,0)
+ ;G1("VARIABLE")="170^.01"
+"RTN","C0CDIC",133,0)
+ ;G1("XPATH")="170^2"
+"RTN","C0CDIC",134,0)
+ ;
+"RTN","C0CDIC",135,0)
+ N C0CZA,C0CZX,C0CN,C0CSTAT
+"RTN","C0CDIC",136,0)
+ S C0CZX=0
+"RTN","C0CDIC",137,0)
+ S C0CSTAT=0 ; INIT STATUS SET FLAG
+"RTN","C0CDIC",138,0)
+ F  S C0CZX=$O(^C0CDIC(170,C0CZX)) Q:+C0CZX=0  D  ; FOR EACH DICT ENTRY
+"RTN","C0CDIC",139,0)
+ . ;W C0CZX,!
+"RTN","C0CDIC",140,0)
+ . K C0CA,C0CN ; CLEAR OUT THE LAST ONE
+"RTN","C0CDIC",141,0)
+ . D GETN1^C0CRNF("C0CA",170,C0CZX,"","ALL") ; GET VARIABLE HASH
+"RTN","C0CDIC",142,0)
+ . ;ZWR C0CA B ;
+"RTN","C0CDIC",143,0)
+ . S C0CN=$$ZVALUE("VARIABLE") ;NAME OF THE VARIABLE
+"RTN","C0CDIC",144,0)
+ . W "VARIABLE: ",C0CN,!
+"RTN","C0CDIC",145,0)
+ . I $E(C0CN,1,5)="ACTOR" D SETFDA("SECTION","ACTORS") ;
+"RTN","C0CDIC",146,0)
+ . I $E(C0CN,1,6)="SOCIAL" D  ;
+"RTN","C0CDIC",147,0)
+ . . D SETFDA("SECTION","SOC") ;
+"RTN","C0CDIC",148,0)
+ . . D SETFDA("STATUS","X") ;SOCIAL HISTORY NOT IMPLEMENTED
+"RTN","C0CDIC",149,0)
+ . . S C0CSTAT=1
+"RTN","C0CDIC",150,0)
+ . I $E(C0CN,1,6)="FAMILY" D  ;
+"RTN","C0CDIC",151,0)
+ . . D SETFDA("SECTION","FAM") ;
+"RTN","C0CDIC",152,0)
+ . . D SETFDA("STATUS","X") ;FAMILY HISTORY NOT IMPLEMENTED
+"RTN","C0CDIC",153,0)
+ . . S C0CSTAT=1
+"RTN","C0CDIC",154,0)
+ . ;D SETFDA("TYPE","") ;CORRECT FOR TYPE ERRORS
+"RTN","C0CDIC",155,0)
+ . I $E(C0CN,1,5)="ALERT" D SETFDA("SECTION","ALERTS")
+"RTN","C0CDIC",156,0)
+ . I $E(C0CN,1,5)="VITAL" D SETFDA("SECTION","VITALS")
+"RTN","C0CDIC",157,0)
+ . I $E(C0CN,1,7)="PROBLEM" D SETFDA("SECTION","PROBLEMS")
+"RTN","C0CDIC",158,0)
+ . I $E(C0CN,1,10)="RESULTTEST" D SETFDA("SECTION","TEST")
+"RTN","C0CDIC",159,0)
+ . E  I $E(C0CN,1,6)="RESULT" D SETFDA("SECTION","LABS")
+"RTN","C0CDIC",160,0)
+ . I C0CN["CODEVALUE" D SETFDA("TYPE","CD") ;CODES
+"RTN","C0CDIC",161,0)
+ . I C0CN["CODEVERSION" D SETFDA("TYPE","CV") ; CODE VERSION
+"RTN","C0CDIC",162,0)
+ . I C0CN["CODINGSYSTEM" D SETFDA("TYPE","CS") ;CODING SYSTEM
+"RTN","C0CDIC",163,0)
+ . I $$ZVALUE("STATUS")=""!'C0CSTAT D SETFDA("STATUS","N") ;BLANK STATUS TO N
+"RTN","C0CDIC",164,0)
+ . I $$ZVALUE("XPATH")["/Medication/Directions/" D  ; MEDS DIRECTIONS VAR
+"RTN","C0CDIC",165,0)
+ . . D SETFDA("SECTION","DIR") ; SPECIAL SECTION FOR DIRECTIONS
+"RTN","C0CDIC",166,0)
+ . E  I $$ZVALUE("XPATH")["/Medications/Medication/" D  ; ALL OTHER MEDS
+"RTN","C0CDIC",167,0)
+ . . D SETFDA("SECTION","MEDS") ; A MEDS VAR
+"RTN","C0CDIC",168,0)
+ . I $E(C0CN,($L(C0CN)-1),$L(C0CN))="ID" D SETFDA("TYPE","ID") ;CATCH THE IDS
+"RTN","C0CDIC",169,0)
+ . I C0CN["DATETIME" D SETFDA("TYPE","DT") ; DATE/TIME VARIABLE
+"RTN","C0CDIC",170,0)
+ . W "VARIABLE: ",C0CZX," ",C0CA("VARIABLE"),!
+"RTN","C0CDIC",171,0)
+ . ;ZWR C0CFDA
+"RTN","C0CDIC",172,0)
+ . I $D(C0CFDA) D  ; WE HAVE CHANGES ON THIS VARIABLE
+"RTN","C0CDIC",173,0)
+ . . ;ZWR C0CFDA
+"RTN","C0CDIC",174,0)
+ . . D UPDATE^DIE("","C0CFDA(C0CZX)")
+"RTN","C0CDIC",175,0)
+ . . I $D(^TMP("DIERR",$J)) U $P BREAK
+"RTN","C0CDIC",176,0)
+ . . D CLEAN^DILF ; CLEAN UP
+"RTN","C0CDIC",177,0)
+ . ;ZWR C0CFDA
+"RTN","C0CDIC",178,0)
  Q
-"RTN","C0CDIC",119,0)
- ;
-"RTN","C0CDIC",120,0)
-INIT ; INITIALIZE CCR DICTIONARY BASED ON VARIABLE NAMES
-"RTN","C0CDIC",121,0)
- ;
-"RTN","C0CDIC",122,0)
- ; CHEAT SHEET FOR VARIABLE NAMES IN ^C0CDIC(170.xx,
-"RTN","C0CDIC",123,0)
- ; THIS IS WHAT WILL BE IN C0CA FOR EACH DICTIONARY ENTRY
-"RTN","C0CDIC",124,0)
- ;G1("CODING")="170^8"
-"RTN","C0CDIC",125,0)
- ;G1("DATA ELEMENT")="170^7"
-"RTN","C0CDIC",126,0)
- ;G1("DESCRIPTION")="170^3"
-"RTN","C0CDIC",127,0)
- ;G1("ID")="170^1"
-"RTN","C0CDIC",128,0)
- ;G1("M","170^8","CODING")="170.08^.01"
-"RTN","C0CDIC",129,0)
- ;G1("MAPPING METHOD")="170.08^1"
-"RTN","C0CDIC",130,0)
- ;G1("SECTION")="170^10"
-"RTN","C0CDIC",131,0)
- ;G1("SOURCE")="170^4"
-"RTN","C0CDIC",132,0)
- ;G1("STATUS")="170^9"
-"RTN","C0CDIC",133,0)
- ;G1("TYPE")="170^6"
-"RTN","C0CDIC",134,0)
- ;G1("VARIABLE")="170^.01"
-"RTN","C0CDIC",135,0)
- ;G1("XPATH")="170^2"
-"RTN","C0CDIC",136,0)
- ;
-"RTN","C0CDIC",137,0)
- N C0CZA,C0CZX,C0CN,C0CSTAT
-"RTN","C0CDIC",138,0)
- S C0CZX=0
-"RTN","C0CDIC",139,0)
- S C0CSTAT=0 ; INIT STATUS SET FLAG
-"RTN","C0CDIC",140,0)
- F  S C0CZX=$O(^C0CDIC(170,C0CZX)) Q:+C0CZX=0  D  ; FOR EACH DICT ENTRY
-"RTN","C0CDIC",141,0)
- . ;W C0CZX,!
-"RTN","C0CDIC",142,0)
- . K C0CA,C0CN ; CLEAR OUT THE LAST ONE
-"RTN","C0CDIC",143,0)
- . D GETN1^C0CRNF("C0CA",170,C0CZX,"","ALL") ; GET VARIABLE HASH
-"RTN","C0CDIC",144,0)
- . ;ZWR C0CA B ;
-"RTN","C0CDIC",145,0)
- . S C0CN=$$ZVALUE("VARIABLE") ;NAME OF THE VARIABLE
-"RTN","C0CDIC",146,0)
- . W "VARIABLE: ",C0CN,!
-"RTN","C0CDIC",147,0)
- . I $E(C0CN,1,5)="ACTOR" D SETFDA("SECTION","ACTORS") ;
-"RTN","C0CDIC",148,0)
- . I $E(C0CN,1,6)="SOCIAL" D  ;
-"RTN","C0CDIC",149,0)
- . . D SETFDA("SECTION","SOC") ;
-"RTN","C0CDIC",150,0)
- . . D SETFDA("STATUS","X") ;SOCIAL HISTORY NOT IMPLEMENTED
-"RTN","C0CDIC",151,0)
- . . S C0CSTAT=1
-"RTN","C0CDIC",152,0)
- . I $E(C0CN,1,6)="FAMILY" D  ;
-"RTN","C0CDIC",153,0)
- . . D SETFDA("SECTION","FAM") ;
-"RTN","C0CDIC",154,0)
- . . D SETFDA("STATUS","X") ;FAMILY HISTORY NOT IMPLEMENTED
-"RTN","C0CDIC",155,0)
- . . S C0CSTAT=1
-"RTN","C0CDIC",156,0)
- . ;D SETFDA("TYPE","") ;CORRECT FOR TYPE ERRORS
-"RTN","C0CDIC",157,0)
- . I $E(C0CN,1,5)="ALERT" D SETFDA("SECTION","ALERTS")
-"RTN","C0CDIC",158,0)
- . I $E(C0CN,1,5)="VITAL" D SETFDA("SECTION","VITALS")
-"RTN","C0CDIC",159,0)
- . I $E(C0CN,1,7)="PROBLEM" D SETFDA("SECTION","PROBLEMS")
-"RTN","C0CDIC",160,0)
- . I $E(C0CN,1,10)="RESULTTEST" D SETFDA("SECTION","TEST")
-"RTN","C0CDIC",161,0)
- . E  I $E(C0CN,1,6)="RESULT" D SETFDA("SECTION","LABS")
-"RTN","C0CDIC",162,0)
- . I C0CN["CODEVALUE" D SETFDA("TYPE","CD") ;CODES
-"RTN","C0CDIC",163,0)
- . I C0CN["CODEVERSION" D SETFDA("TYPE","CV") ; CODE VERSION
-"RTN","C0CDIC",164,0)
- . I C0CN["CODINGSYSTEM" D SETFDA("TYPE","CS") ;CODING SYSTEM
-"RTN","C0CDIC",165,0)
- . I $$ZVALUE("STATUS")=""!'C0CSTAT D SETFDA("STATUS","N") ;BLANK STATUS TO N
-"RTN","C0CDIC",166,0)
- . I $$ZVALUE("XPATH")["/Medication/Directions/" D  ; MEDS DIRECTIONS VAR
-"RTN","C0CDIC",167,0)
- . . D SETFDA("SECTION","DIR") ; SPECIAL SECTION FOR DIRECTIONS
-"RTN","C0CDIC",168,0)
- . E  I $$ZVALUE("XPATH")["/Medications/Medication/" D  ; ALL OTHER MEDS
-"RTN","C0CDIC",169,0)
- . . D SETFDA("SECTION","MEDS") ; A MEDS VAR
-"RTN","C0CDIC",170,0)
- . I $E(C0CN,($L(C0CN)-1),$L(C0CN))="ID" D SETFDA("TYPE","ID") ;CATCH THE IDS
-"RTN","C0CDIC",171,0)
- . I C0CN["DATETIME" D SETFDA("TYPE","DT") ; DATE/TIME VARIABLE
-"RTN","C0CDIC",172,0)
- . W "VARIABLE: ",C0CZX," ",C0CA("VARIABLE"),!
-"RTN","C0CDIC",173,0)
- . ;ZWR C0CFDA
-"RTN","C0CDIC",174,0)
- . I $D(C0CFDA) D  ; WE HAVE CHANGES ON THIS VARIABLE
-"RTN","C0CDIC",175,0)
- . . ;ZWR C0CFDA
-"RTN","C0CDIC",176,0)
- . . D UPDATE^DIE("","C0CFDA(C0CZX)")
-"RTN","C0CDIC",177,0)
- . . I $D(^TMP("DIERR",$J)) U $P BREAK
-"RTN","C0CDIC",178,0)
- . . D CLEAN^DILF ; CLEAN UP
 "RTN","C0CDIC",179,0)
- . ;ZWR C0CFDA
+ ;
 "RTN","C0CDIC",180,0)
+SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
+"RTN","C0CDIC",181,0)
+ ; TO SET TO VALUE C0CSV.
+"RTN","C0CDIC",182,0)
+ ; C0CFDA,C0CA,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
+"RTN","C0CDIC",183,0)
+ ; C0CSN,C0CSV ARE PASSED BY VALUE
+"RTN","C0CDIC",184,0)
+ ;
+"RTN","C0CDIC",185,0)
+ N C0CSI,C0CSJ
+"RTN","C0CDIC",186,0)
+ S C0CSI=$$ZFILE(C0CSN,"C0CA") ; FILE NUMBER
+"RTN","C0CDIC",187,0)
+ S C0CSJ=$$ZFIELD(C0CSN,"C0CA") ; FIELD NUMBER
+"RTN","C0CDIC",188,0)
+ S C0CFDA(C0CZX,C0CSI,C0CZX_",",C0CSJ)=C0CSV
+"RTN","C0CDIC",189,0)
  Q
-"RTN","C0CDIC",181,0)
- ;
-"RTN","C0CDIC",182,0)
-SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
-"RTN","C0CDIC",183,0)
- ; TO SET TO VALUE C0CSV.
-"RTN","C0CDIC",184,0)
- ; C0CFDA,C0CA,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
-"RTN","C0CDIC",185,0)
- ; C0CSN,C0CSV ARE PASSED BY VALUE
-"RTN","C0CDIC",186,0)
- ;
-"RTN","C0CDIC",187,0)
- N C0CSI,C0CSJ
-"RTN","C0CDIC",188,0)
- S C0CSI=$$ZFILE(C0CSN,"C0CA") ; FILE NUMBER
-"RTN","C0CDIC",189,0)
- S C0CSJ=$$ZFIELD(C0CSN,"C0CA") ; FIELD NUMBER
 "RTN","C0CDIC",190,0)
- S C0CFDA(C0CZX,C0CSI,C0CZX_",",C0CSJ)=C0CSV
+ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
 "RTN","C0CDIC",191,0)
- Q
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
 "RTN","C0CDIC",192,0)
-ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
+ ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
 "RTN","C0CDIC",193,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
+ I '$D(ZTAB) S ZTAB="C0CA"
 "RTN","C0CDIC",194,0)
+ Q $P(@ZTAB@(ZFN),"^",1)
+"RTN","C0CDIC",195,0)
+ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
+"RTN","C0CDIC",196,0)
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
+"RTN","C0CDIC",197,0)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CDIC",195,0)
+"RTN","C0CDIC",198,0)
  I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CDIC",196,0)
- Q $P(@ZTAB@(ZFN),"^",1)
-"RTN","C0CDIC",197,0)
-ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
-"RTN","C0CDIC",198,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
 "RTN","C0CDIC",199,0)
+ Q $P(@ZTAB@(ZFN),"^",2)
+"RTN","C0CDIC",200,0)
+ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
+"RTN","C0CDIC",201,0)
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
+"RTN","C0CDIC",202,0)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CDIC",200,0)
+"RTN","C0CDIC",203,0)
  I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CDIC",201,0)
- Q $P(@ZTAB@(ZFN),"^",2)
-"RTN","C0CDIC",202,0)
-ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
-"RTN","C0CDIC",203,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
 "RTN","C0CDIC",204,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
+ Q $P(@ZTAB@(ZFN),"^",3)
 "RTN","C0CDIC",205,0)
- I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CDIC",206,0)
- Q $P(@ZTAB@(ZFN),"^",3)
-"RTN","C0CDIC",207,0)
  ;
 "RTN","C0CDOM")
-0^74^B86773980
+0^74^B86328529
 "RTN","C0CDOM",1,0)
 C0CDOM   ; GPL - DOM PROCESSING ROUTINES ;6/6/11  17:05
 "RTN","C0CDOM",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CDOM",3,0)
- ;Copyright 2011 George Lilly.  Licensed under the terms of the GNU
+ ;Copyright 2011 George Lilly.  
 "RTN","C0CDOM",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CDOM",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CDOM",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CDOM",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CDOM",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CDOM",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CDOM",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CDOM",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CDOM",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CDOM",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CDOM",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CDOM",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CDOM",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CDOM",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CDOM",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
 "RTN","C0CDOM",19,0)
- ;
+ Q
 "RTN","C0CDOM",20,0)
+ ;
+"RTN","C0CDOM",21,0)
+DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
+"RTN","C0CDOM",22,0)
+ ; THE XPATH INDEX ZXIDX, PASSED BY NAME
+"RTN","C0CDOM",23,0)
+ ; THE XPATH ARRAY XPARY, PASSED BY NAME
+"RTN","C0CDOM",24,0)
+ ; ZOID IS THE STARTING OID
+"RTN","C0CDOM",25,0)
+ ; ZPATH IS THE STARTING XPATH, USUALLY "/"
+"RTN","C0CDOM",26,0)
+ ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
+"RTN","C0CDOM",27,0)
+ ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
+"RTN","C0CDOM",28,0)
+ I $G(ZREDUX)="" S ZREDUX=""
+"RTN","C0CDOM",29,0)
+ N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY
+"RTN","C0CDOM",30,0)
+ N NEWNUM S NEWNUM=""
+"RTN","C0CDOM",31,0)
+ I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
+"RTN","C0CDOM",32,0)
+ S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
+"RTN","C0CDOM",33,0)
+ I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
+"RTN","C0CDOM",34,0)
+ . N GT S GT=$P(NEWPATH,ZREDUX,2)
+"RTN","C0CDOM",35,0)
+ . I GT'="" S NEWPATH=GT
+"RTN","C0CDOM",36,0)
+ S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
+"RTN","C0CDOM",37,0)
+ N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE
+"RTN","C0CDOM",38,0)
+ I $D(GA) D  ; PROCESS THE ATTRIBUTES
+"RTN","C0CDOM",39,0)
+ . N ZI S ZI=""
+"RTN","C0CDOM",40,0)
+ . F  S ZI=$O(GA(ZI)) Q:ZI=""  D  ; FOR EACH ATTRIBUTE
+"RTN","C0CDOM",41,0)
+ . . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE
+"RTN","C0CDOM",42,0)
+ . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY
+"RTN","C0CDOM",43,0)
+ . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE
+"RTN","C0CDOM",44,0)
+ N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
+"RTN","C0CDOM",45,0)
+ I $D(GD(2)) D  ;
+"RTN","C0CDOM",46,0)
+ . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
+"RTN","C0CDOM",47,0)
+ E  I $D(GD(1)) D  ;
+"RTN","C0CDOM",48,0)
+ . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
+"RTN","C0CDOM",49,0)
+ . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY
+"RTN","C0CDOM",50,0)
+ N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
+"RTN","C0CDOM",51,0)
+ I ZFRST'=0 D  ; THERE IS A CHILD
+"RTN","C0CDOM",52,0)
+ . N ZNUM
+"RTN","C0CDOM",53,0)
+ . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
+"RTN","C0CDOM",54,0)
+ . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD
+"RTN","C0CDOM",55,0)
+ N GNXT S GNXT=$$NXTSIB(ZOID)
+"RTN","C0CDOM",56,0)
+ I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
+"RTN","C0CDOM",57,0)
+ I GNXT'=0 D  ;
+"RTN","C0CDOM",58,0)
+ . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
+"RTN","C0CDOM",59,0)
+ . I (ZNUM="")&(ZMULT) D  ; SIBLING IS FIRST OF MULTIPLES
+"RTN","C0CDOM",60,0)
+ . . N ZNUM S ZNUM=1 ;
+"RTN","C0CDOM",61,0)
+ . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
+"RTN","C0CDOM",62,0)
+ . E  D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB
+"RTN","C0CDOM",63,0)
  Q
-"RTN","C0CDOM",21,0)
- ;
-"RTN","C0CDOM",22,0)
-DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
-"RTN","C0CDOM",23,0)
- ; THE XPATH INDEX ZXIDX, PASSED BY NAME
-"RTN","C0CDOM",24,0)
- ; THE XPATH ARRAY XPARY, PASSED BY NAME
-"RTN","C0CDOM",25,0)
- ; ZOID IS THE STARTING OID
-"RTN","C0CDOM",26,0)
- ; ZPATH IS THE STARTING XPATH, USUALLY "/"
-"RTN","C0CDOM",27,0)
- ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
-"RTN","C0CDOM",28,0)
- ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
-"RTN","C0CDOM",29,0)
- I $G(ZREDUX)="" S ZREDUX=""
-"RTN","C0CDOM",30,0)
- N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY
-"RTN","C0CDOM",31,0)
- N NEWNUM S NEWNUM=""
-"RTN","C0CDOM",32,0)
- I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
-"RTN","C0CDOM",33,0)
- S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
-"RTN","C0CDOM",34,0)
- I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
-"RTN","C0CDOM",35,0)
- . N GT S GT=$P(NEWPATH,ZREDUX,2)
-"RTN","C0CDOM",36,0)
- . I GT'="" S NEWPATH=GT
-"RTN","C0CDOM",37,0)
- S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
-"RTN","C0CDOM",38,0)
- N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE
-"RTN","C0CDOM",39,0)
- I $D(GA) D  ; PROCESS THE ATTRIBUTES
-"RTN","C0CDOM",40,0)
- . N ZI S ZI=""
-"RTN","C0CDOM",41,0)
- . F  S ZI=$O(GA(ZI)) Q:ZI=""  D  ; FOR EACH ATTRIBUTE
-"RTN","C0CDOM",42,0)
- . . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE
-"RTN","C0CDOM",43,0)
- . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY
-"RTN","C0CDOM",44,0)
- . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE
-"RTN","C0CDOM",45,0)
- N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
-"RTN","C0CDOM",46,0)
- I $D(GD(2)) D  ;
-"RTN","C0CDOM",47,0)
- . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
-"RTN","C0CDOM",48,0)
- E  I $D(GD(1)) D  ;
-"RTN","C0CDOM",49,0)
- . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
-"RTN","C0CDOM",50,0)
- . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY
-"RTN","C0CDOM",51,0)
- N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
-"RTN","C0CDOM",52,0)
- I ZFRST'=0 D  ; THERE IS A CHILD
-"RTN","C0CDOM",53,0)
- . N ZNUM
-"RTN","C0CDOM",54,0)
- . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
-"RTN","C0CDOM",55,0)
- . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD
-"RTN","C0CDOM",56,0)
- N GNXT S GNXT=$$NXTSIB(ZOID)
-"RTN","C0CDOM",57,0)
- I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
-"RTN","C0CDOM",58,0)
- I GNXT'=0 D  ;
-"RTN","C0CDOM",59,0)
- . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
-"RTN","C0CDOM",60,0)
- . I (ZNUM="")&(ZMULT) D  ; SIBLING IS FIRST OF MULTIPLES
-"RTN","C0CDOM",61,0)
- . . N ZNUM S ZNUM=1 ;
-"RTN","C0CDOM",62,0)
- . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
-"RTN","C0CDOM",63,0)
- . E  D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB
 "RTN","C0CDOM",64,0)
+ ;
+"RTN","C0CDOM",65,0)
+ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY
+"RTN","C0CDOM",66,0)
+ ;
+"RTN","C0CDOM",67,0)
+ ; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES
+"RTN","C0CDOM",68,0)
+ ;
+"RTN","C0CDOM",69,0)
+ N ZZI,ZZJ,ZZN
+"RTN","C0CDOM",70,0)
+ S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY
+"RTN","C0CDOM",71,0)
+ I ZZI="" Q  ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE
+"RTN","C0CDOM",72,0)
+ S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY
+"RTN","C0CDOM",73,0)
+ S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .
+"RTN","C0CDOM",74,0)
+ I ZZI'["]" D  ; A SINGLETON
+"RTN","C0CDOM",75,0)
+ . S ZZN=1
+"RTN","C0CDOM",76,0)
+ E  D  ; THERE IS AN [x] OCCURANCE
+"RTN","C0CDOM",77,0)
+ . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE
+"RTN","C0CDOM",78,0)
+ . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]
+"RTN","C0CDOM",79,0)
+ I ZZJ'="" D  ; TIME TO ADD THE VALUE
+"RTN","C0CDOM",80,0)
+ . S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
+"RTN","C0CDOM",81,0)
  Q
-"RTN","C0CDOM",65,0)
- ;
-"RTN","C0CDOM",66,0)
-ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY
-"RTN","C0CDOM",67,0)
- ;
-"RTN","C0CDOM",68,0)
- ; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES
-"RTN","C0CDOM",69,0)
- ;
-"RTN","C0CDOM",70,0)
- N ZZI,ZZJ,ZZN
-"RTN","C0CDOM",71,0)
- S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY
-"RTN","C0CDOM",72,0)
- I ZZI="" Q  ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE
-"RTN","C0CDOM",73,0)
- S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY
-"RTN","C0CDOM",74,0)
- S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .
-"RTN","C0CDOM",75,0)
- I ZZI'["]" D  ; A SINGLETON
-"RTN","C0CDOM",76,0)
- . S ZZN=1
-"RTN","C0CDOM",77,0)
- E  D  ; THERE IS AN [x] OCCURANCE
-"RTN","C0CDOM",78,0)
- . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE
-"RTN","C0CDOM",79,0)
- . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]
-"RTN","C0CDOM",80,0)
- I ZZJ'="" D  ; TIME TO ADD THE VALUE
-"RTN","C0CDOM",81,0)
- . S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
 "RTN","C0CDOM",82,0)
+ ;
+"RTN","C0CDOM",83,0)
+PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
+"RTN","C0CDOM",84,0)
+ ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
+"RTN","C0CDOM",85,0)
+ ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
+"RTN","C0CDOM",86,0)
+ ;Q $$EN^MXMLDOM(INXML)
+"RTN","C0CDOM",87,0)
+ Q $$EN^MXMLDOM(INXML,"W")
+"RTN","C0CDOM",88,0)
+ ;
+"RTN","C0CDOM",89,0)
+ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
+"RTN","C0CDOM",90,0)
+ N ZN
+"RTN","C0CDOM",91,0)
+ ;I $$TAG(ZOID)["entry" B
+"RTN","C0CDOM",92,0)
+ S ZN=$$NXTSIB(ZOID)
+"RTN","C0CDOM",93,0)
+ I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
+"RTN","C0CDOM",94,0)
+ Q 0
+"RTN","C0CDOM",95,0)
+ ;
+"RTN","C0CDOM",96,0)
+FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
+"RTN","C0CDOM",97,0)
+ Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
+"RTN","C0CDOM",98,0)
+ ;
+"RTN","C0CDOM",99,0)
+PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
+"RTN","C0CDOM",100,0)
+ Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
+"RTN","C0CDOM",101,0)
+ ;
+"RTN","C0CDOM",102,0)
+ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
+"RTN","C0CDOM",103,0)
+ S HANDLE=C0CDOCID
+"RTN","C0CDOM",104,0)
+ K @RTN
+"RTN","C0CDOM",105,0)
+ D GETTXT^MXMLDOM("A")
+"RTN","C0CDOM",106,0)
  Q
-"RTN","C0CDOM",83,0)
- ;
-"RTN","C0CDOM",84,0)
-PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
-"RTN","C0CDOM",85,0)
- ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
-"RTN","C0CDOM",86,0)
- ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
-"RTN","C0CDOM",87,0)
- ;Q $$EN^MXMLDOM(INXML)
-"RTN","C0CDOM",88,0)
- Q $$EN^MXMLDOM(INXML,"W")
-"RTN","C0CDOM",89,0)
- ;
-"RTN","C0CDOM",90,0)
-ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
-"RTN","C0CDOM",91,0)
- N ZN
-"RTN","C0CDOM",92,0)
- ;I $$TAG(ZOID)["entry" B
-"RTN","C0CDOM",93,0)
- S ZN=$$NXTSIB(ZOID)
-"RTN","C0CDOM",94,0)
- I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
-"RTN","C0CDOM",95,0)
- Q 0
-"RTN","C0CDOM",96,0)
- ;
-"RTN","C0CDOM",97,0)
-FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
-"RTN","C0CDOM",98,0)
- Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CDOM",99,0)
- ;
-"RTN","C0CDOM",100,0)
-PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
-"RTN","C0CDOM",101,0)
- Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CDOM",102,0)
- ;
-"RTN","C0CDOM",103,0)
-ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
-"RTN","C0CDOM",104,0)
- S HANDLE=C0CDOCID
-"RTN","C0CDOM",105,0)
- K @RTN
-"RTN","C0CDOM",106,0)
- D GETTXT^MXMLDOM("A")
 "RTN","C0CDOM",107,0)
+ ;
+"RTN","C0CDOM",108,0)
+TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
+"RTN","C0CDOM",109,0)
+ ;I ZOID=149 B ;GPLTEST
+"RTN","C0CDOM",110,0)
+ N X,Y
+"RTN","C0CDOM",111,0)
+ S Y=""
+"RTN","C0CDOM",112,0)
+ S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
+"RTN","C0CDOM",113,0)
+ I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
+"RTN","C0CDOM",114,0)
+ I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
+"RTN","C0CDOM",115,0)
+ Q Y
+"RTN","C0CDOM",116,0)
+ ;
+"RTN","C0CDOM",117,0)
+NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
+"RTN","C0CDOM",118,0)
+ Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
+"RTN","C0CDOM",119,0)
+ ;
+"RTN","C0CDOM",120,0)
+DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
+"RTN","C0CDOM",121,0)
+ ;N ZT,ZN S ZT=""
+"RTN","C0CDOM",122,0)
+ ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
+"RTN","C0CDOM",123,0)
+ ;Q $G(@C0CDOM@(ZOID,"T",1))
+"RTN","C0CDOM",124,0)
+ S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
+"RTN","C0CDOM",125,0)
  Q
-"RTN","C0CDOM",108,0)
- ;
-"RTN","C0CDOM",109,0)
-TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
-"RTN","C0CDOM",110,0)
- ;I ZOID=149 B ;GPLTEST
-"RTN","C0CDOM",111,0)
- N X,Y
-"RTN","C0CDOM",112,0)
- S Y=""
-"RTN","C0CDOM",113,0)
- S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
-"RTN","C0CDOM",114,0)
- I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
-"RTN","C0CDOM",115,0)
- I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CDOM",116,0)
- Q Y
-"RTN","C0CDOM",117,0)
- ;
-"RTN","C0CDOM",118,0)
-NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
-"RTN","C0CDOM",119,0)
- Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CDOM",120,0)
- ;
-"RTN","C0CDOM",121,0)
-DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
-"RTN","C0CDOM",122,0)
- ;N ZT,ZN S ZT=""
-"RTN","C0CDOM",123,0)
- ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
-"RTN","C0CDOM",124,0)
- ;Q $G(@C0CDOM@(ZOID,"T",1))
-"RTN","C0CDOM",125,0)
- S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
 "RTN","C0CDOM",126,0)
+ ;
+"RTN","C0CDOM",127,0)
+OUTXML(ZRTN,INID,NO1ST) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
+"RTN","C0CDOM",128,0)
+ ;
+"RTN","C0CDOM",129,0)
+ S C0CDOCID=INID
+"RTN","C0CDOM",130,0)
+ I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE <?xml tag generation
+"RTN","C0CDOM",131,0)
+ D START^C0CMXMLB($$TAG(1),,"G",NO1ST)
+"RTN","C0CDOM",132,0)
+ D NDOUT($$FIRST(1))
+"RTN","C0CDOM",133,0)
+ D END^C0CMXMLB ;END THE DOCUMENT
+"RTN","C0CDOM",134,0)
+ M @ZRTN=^TMP("MXMLBLD",$J)
+"RTN","C0CDOM",135,0)
+ K ^TMP("MXMLBLD",$J)
+"RTN","C0CDOM",136,0)
  Q
-"RTN","C0CDOM",127,0)
- ;
-"RTN","C0CDOM",128,0)
-OUTXML(ZRTN,INID,NO1ST) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
-"RTN","C0CDOM",129,0)
- ;
-"RTN","C0CDOM",130,0)
- S C0CDOCID=INID
-"RTN","C0CDOM",131,0)
- I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE <?xml tag generation
-"RTN","C0CDOM",132,0)
- D START^C0CMXMLB($$TAG(1),,"G",NO1ST)
-"RTN","C0CDOM",133,0)
- D NDOUT($$FIRST(1))
-"RTN","C0CDOM",134,0)
- D END^C0CMXMLB ;END THE DOCUMENT
-"RTN","C0CDOM",135,0)
- M @ZRTN=^TMP("MXMLBLD",$J)
-"RTN","C0CDOM",136,0)
- K ^TMP("MXMLBLD",$J)
 "RTN","C0CDOM",137,0)
+ ;
+"RTN","C0CDOM",138,0)
+NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
+"RTN","C0CDOM",139,0)
+ N ZI S ZI=$$FIRST(ZOID)
+"RTN","C0CDOM",140,0)
+ I ZI'=0 D  ; THERE IS A CHILD
+"RTN","C0CDOM",141,0)
+ . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
+"RTN","C0CDOM",142,0)
+ . D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN
+"RTN","C0CDOM",143,0)
+ E  D  ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
+"RTN","C0CDOM",144,0)
+ . ;W "DOING",ZOID,!
+"RTN","C0CDOM",145,0)
+ . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
+"RTN","C0CDOM",146,0)
+ . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
+"RTN","C0CDOM",147,0)
+ . D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
+"RTN","C0CDOM",148,0)
+ I $$NXTSIB(ZOID)'=0 D  ; THERE IS A SIBLING
+"RTN","C0CDOM",149,0)
+ . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
+"RTN","C0CDOM",150,0)
  Q
-"RTN","C0CDOM",138,0)
- ;
-"RTN","C0CDOM",139,0)
-NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
-"RTN","C0CDOM",140,0)
- N ZI S ZI=$$FIRST(ZOID)
-"RTN","C0CDOM",141,0)
- I ZI'=0 D  ; THERE IS A CHILD
-"RTN","C0CDOM",142,0)
- . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
-"RTN","C0CDOM",143,0)
- . D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN
-"RTN","C0CDOM",144,0)
- E  D  ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
-"RTN","C0CDOM",145,0)
- . ;W "DOING",ZOID,!
-"RTN","C0CDOM",146,0)
- . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
-"RTN","C0CDOM",147,0)
- . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
-"RTN","C0CDOM",148,0)
- . D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
-"RTN","C0CDOM",149,0)
- I $$NXTSIB(ZOID)'=0 D  ; THERE IS A SIBLING
-"RTN","C0CDOM",150,0)
- . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
 "RTN","C0CDOM",151,0)
+ ;
+"RTN","C0CDOM",152,0)
+WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE
+"RTN","C0CDOM",153,0)
+ ;
+"RTN","C0CDOM",154,0)
+ N GN,GN2
+"RTN","C0CDOM",155,0)
+ D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML
+"RTN","C0CDOM",156,0)
+ S GN2=$NA(@GN@(1))
+"RTN","C0CDOM",157,0)
+ W $$OUTPUT^C0CXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")
+"RTN","C0CDOM",158,0)
  Q
-"RTN","C0CDOM",152,0)
- ;
-"RTN","C0CDOM",153,0)
-WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE
-"RTN","C0CDOM",154,0)
- ;
-"RTN","C0CDOM",155,0)
- N GN,GN2
-"RTN","C0CDOM",156,0)
- D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML
-"RTN","C0CDOM",157,0)
- S GN2=$NA(@GN@(1))
-"RTN","C0CDOM",158,0)
- W $$OUTPUT^C0CXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")
 "RTN","C0CDOM",159,0)
+ ;
+"RTN","C0CDOM",160,0)
+NARY2XML(ZGOUT,ZGIN) ; CREATE XML FROM AN NHIN ARRAY
+"RTN","C0CDOM",161,0)
+ ; ZGOUT AND ZGIN ARE PASSED BY NAME
+"RTN","C0CDOM",162,0)
+ N C0CDOCID
+"RTN","C0CDOM",163,0)
+ W !,ZGOUT," ",ZGIN
+"RTN","C0CDOM",164,0)
+ S C0CDOCID=$$DOMI(ZGIN) ; PUT IT INTO THE DOM
+"RTN","C0CDOM",165,0)
+ D OUTXML(ZGOUT,C0CDOCID)
+"RTN","C0CDOM",166,0)
  Q
-"RTN","C0CDOM",160,0)
- ;
-"RTN","C0CDOM",161,0)
-NARY2XML(ZGOUT,ZGIN) ; CREATE XML FROM AN NHIN ARRAY
-"RTN","C0CDOM",162,0)
- ; ZGOUT AND ZGIN ARE PASSED BY NAME
-"RTN","C0CDOM",163,0)
- N C0CDOCID
-"RTN","C0CDOM",164,0)
- W !,ZGOUT," ",ZGIN
-"RTN","C0CDOM",165,0)
- S C0CDOCID=$$DOMI(ZGIN) ; PUT IT INTO THE DOM
-"RTN","C0CDOM",166,0)
- D OUTXML(ZGOUT,C0CDOCID)
 "RTN","C0CDOM",167,0)
+ ;
+"RTN","C0CDOM",168,0)
+ ; EXAMPLE OF NHIN ARRAY FORMAT - THIS IS AN OUTPUT OF DOMO ABOVE WHEN RUN
+"RTN","C0CDOM",169,0)
+ ; AGAINST THE OUTPUT OF THE GET^NHINV ROUTINE. (THIS IS NOT REAL PATIENT DATA)
+"RTN","C0CDOM",170,0)
+ ;
+"RTN","C0CDOM",171,0)
+ ;GNARY("med",1,"doses.dose@dose")=10
+"RTN","C0CDOM",172,0)
+ ;GNARY("med",1,"doses.dose@noun")="TABLET"
+"RTN","C0CDOM",173,0)
+ ;GNARY("med",1,"doses.dose@route")="PO"
+"RTN","C0CDOM",174,0)
+ ;GNARY("med",1,"doses.dose@schedule")="QD"
+"RTN","C0CDOM",175,0)
+ ;GNARY("med",1,"doses.dose@units")="MG"
+"RTN","C0CDOM",176,0)
+ ;GNARY("med",1,"doses.dose@unitsPerDose")=1
+"RTN","C0CDOM",177,0)
+ ;GNARY("med",1,"facility@code")=100
+"RTN","C0CDOM",178,0)
+ ;GNARY("med",1,"facility@name")="VOE OFFICE INSTITUTION"
+"RTN","C0CDOM",179,0)
+ ;GNARY("med",1,"form@value")="TAB"
+"RTN","C0CDOM",180,0)
+ ;GNARY("med",1,"id@value")="1N;O"
+"RTN","C0CDOM",181,0)
+ ;GNARY("med",1,"location@code")=5
+"RTN","C0CDOM",182,0)
+ ;GNARY("med",1,"location@name")="3 WEST"
+"RTN","C0CDOM",183,0)
+ ;GNARY("med",1,"name@value")="LISINOPRIL TAB"
+"RTN","C0CDOM",184,0)
+ ;GNARY("med",1,"orderID@value")=294
+"RTN","C0CDOM",185,0)
+ ;GNARY("med",1,"ordered@value")=3110531.001233
+"RTN","C0CDOM",186,0)
+ ;GNARY("med",1,"orderingProvider@code")=63
+"RTN","C0CDOM",187,0)
+ ;GNARY("med",1,"orderingProvider@name")="KING,MATTHEW MICHAEL"
+"RTN","C0CDOM",188,0)
+ ;GNARY("med",1,"products.product.class@code")="ACE INHIBITORS"
+"RTN","C0CDOM",189,0)
+ ;GNARY("med",1,"products.product.vaGeneric@code")=1990
+"RTN","C0CDOM",190,0)
+ ;GNARY("med",1,"products.product.vaGeneric@name")="LISINOPRIL"
+"RTN","C0CDOM",191,0)
+ ;GNARY("med",1,"products.product.vaGeneric@vuid")=4019380
+"RTN","C0CDOM",192,0)
+ ;GNARY("med",1,"products.product.vaProduct@code")=8118
+"RTN","C0CDOM",193,0)
+ ;GNARY("med",1,"products.product.vaProduct@name")="LISINOPRIL 10MG TAB"
+"RTN","C0CDOM",194,0)
+ ;GNARY("med",1,"products.product.vaProduct@vuid")=4008593
+"RTN","C0CDOM",195,0)
+ ;GNARY("med",1,"products.product@code")=6174
+"RTN","C0CDOM",196,0)
+ ;GNARY("med",1,"products.product@name")="LISINOPRIL 10MG U/D"
+"RTN","C0CDOM",197,0)
+ ;GNARY("med",1,"products.product@role")="D"
+"RTN","C0CDOM",198,0)
+ ;GNARY("med",1,"sig")="10MG BY MOUTH EVERY DAY"
+"RTN","C0CDOM",199,0)
+ ;GNARY("med",1,"sig@xml:space")="preserve"
+"RTN","C0CDOM",200,0)
+ ;GNARY("med",1,"status@value")="active"
+"RTN","C0CDOM",201,0)
+ ;GNARY("med",1,"type@value")="OTC"
+"RTN","C0CDOM",202,0)
+ ;GNARY("med",1,"vaType@value")="N"
+"RTN","C0CDOM",203,0)
+ ;
+"RTN","C0CDOM",204,0)
+ ; DOMI is an extrinsic to insert NHIN ARRAY FORMAT arrays into the DOM
+"RTN","C0CDOM",205,0)
+ ; it returns 0 or 1 based on success.
+"RTN","C0CDOM",206,0)
+ ;
+"RTN","C0CDOM",207,0)
+ ; INARY is passed by name and has the format shown above
+"RTN","C0CDOM",208,0)
+ ; HANDLE is the document number in the DOM (both MXML and EWD DOMs will
+"RTN","C0CDOM",209,0)
+ ; be supported eventually - initial implementation is for MXML
+"RTN","C0CDOM",210,0)
+ ;
+"RTN","C0CDOM",211,0)
+ ; PARENT is the node id or tag of the parent under which the DOM will
+"RTN","C0CDOM",212,0)
+ ; be populated. If it is numeric, it is a node. If it is a string, the DOM
+"RTN","C0CDOM",213,0)
+ ; will be searched to find the tag. If not found and there is no root,
+"RTN","C0CDOM",214,0)
+ ; it will be inserted as the root. If not found and there is a root, it
+"RTN","C0CDOM",215,0)
+ ; will be inserted under the root.
+"RTN","C0CDOM",216,0)
+ ;
+"RTN","C0CDOM",217,0)
+ ; For the above example the call would be OK=$$DOMI("GNARY",0,"results")
+"RTN","C0CDOM",218,0)
+ ; because "results" is the root tag. Use OUTXML to render the xml from
+"RTN","C0CDOM",219,0)
+ ; the DOM.
+"RTN","C0CDOM",220,0)
+ ;
+"RTN","C0CDOM",221,0)
+DOMI(INARY,HANDLE,PARENT) ; EXTRINSIC TO INSERT NHIN ARRAYS TO A DOM
+"RTN","C0CDOM",222,0)
+ ;
+"RTN","C0CDOM",223,0)
+ N ZPARNODE
+"RTN","C0CDOM",224,0)
+ S (SUCCESS,LEVEL,LEVEL(0),NODE)=0
+"RTN","C0CDOM",225,0)
+ I '$D(INARY) Q 0 ; NO ARRAY PASSED
+"RTN","C0CDOM",226,0)
+ I '$D(HANDLE) S HANDLE=$$NEWDOM() ; MAKE A NEW DOM
+"RTN","C0CDOM",227,0)
+ ;I PARENT="" S PARENT="root"
+"RTN","C0CDOM",228,0)
+ I +$G(PARENT)>0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID
+"RTN","C0CDOM",229,0)
+ E  I $L($G(PARENT))>0 D  ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL
+"RTN","C0CDOM",230,0)
+ . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE
+"RTN","C0CDOM",231,0)
+ . S ZPARNODE=1 ;
+"RTN","C0CDOM",232,0)
+ ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET
+"RTN","C0CDOM",233,0)
+ N ZEXARY
+"RTN","C0CDOM",234,0)
+ D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY
+"RTN","C0CDOM",235,0)
+ D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED
+"RTN","C0CDOM",236,0)
+ I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE
+"RTN","C0CDOM",237,0)
+ Q HANDLE ; SUCCESS
+"RTN","C0CDOM",238,0)
+ ; 
+"RTN","C0CDOM",239,0)
+MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES
+"RTN","C0CDOM",240,0)
+ N ZI S ZI=""
+"RTN","C0CDOM",241,0)
+ N ZTAG
+"RTN","C0CDOM",242,0)
+ F  S ZI=$O(@ZARY@(ZI)) Q:ZI=""  D  ; FOR EACH SECTION
+"RTN","C0CDOM",243,0)
+ . N ZELEADD S ZELEADD=0
+"RTN","C0CDOM",244,0)
+ . I ZI["@" D  ; END NODE HAS NO VALUE, ONLY ATTRIBUTES
+"RTN","C0CDOM",245,0)
+ . . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG
+"RTN","C0CDOM",246,0)
+ . . K ZATT ; CLEAR OUT LAST ONE
+"RTN","C0CDOM",247,0)
+ . . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY
+"RTN","C0CDOM",248,0)
+ . . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE
+"RTN","C0CDOM",249,0)
+ . . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE
+"RTN","C0CDOM",250,0)
+ . I $O(@ZARY@(ZI,""))="" D  ;END NODE
+"RTN","C0CDOM",251,0)
+ . . S ZTAG=ZI ; USE ZI FOR THE TAG
+"RTN","C0CDOM",252,0)
+ . . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE
+"RTN","C0CDOM",253,0)
+ . . S ZELEADD=1 ; ADDED AN ELEMENT
+"RTN","C0CDOM",254,0)
+ . . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE
+"RTN","C0CDOM",255,0)
+ . I ZELEADD D  Q  ; NO MORE TO DO ON THIS LEVEL
+"RTN","C0CDOM",256,0)
+ . . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING
+"RTN","C0CDOM",257,0)
+ . N NEWARY ; INDENTED ARRAY
+"RTN","C0CDOM",258,0)
+ . N ZN S ZN=0
+"RTN","C0CDOM",259,0)
+ . F  S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN=""  D  ; FOR EACH MULTIPLE
+"RTN","C0CDOM",260,0)
+ . . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG
+"RTN","C0CDOM",261,0)
+ . . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY
+"RTN","C0CDOM",262,0)
+ . . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY
+"RTN","C0CDOM",263,0)
+ . . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG
+"RTN","C0CDOM",264,0)
  Q
-"RTN","C0CDOM",168,0)
- ;
-"RTN","C0CDOM",169,0)
- ; EXAMPLE OF NHIN ARRAY FORMAT - THIS IS AN OUTPUT OF DOMO ABOVE WHEN RUN
-"RTN","C0CDOM",170,0)
- ; AGAINST THE OUTPUT OF THE GET^NHINV ROUTINE. (THIS IS NOT REAL PATIENT DATA)
-"RTN","C0CDOM",171,0)
- ;
-"RTN","C0CDOM",172,0)
- ;GNARY("med",1,"doses.dose@dose")=10
-"RTN","C0CDOM",173,0)
- ;GNARY("med",1,"doses.dose@noun")="TABLET"
-"RTN","C0CDOM",174,0)
- ;GNARY("med",1,"doses.dose@route")="PO"
-"RTN","C0CDOM",175,0)
- ;GNARY("med",1,"doses.dose@schedule")="QD"
-"RTN","C0CDOM",176,0)
- ;GNARY("med",1,"doses.dose@units")="MG"
-"RTN","C0CDOM",177,0)
- ;GNARY("med",1,"doses.dose@unitsPerDose")=1
-"RTN","C0CDOM",178,0)
- ;GNARY("med",1,"facility@code")=100
-"RTN","C0CDOM",179,0)
- ;GNARY("med",1,"facility@name")="VOE OFFICE INSTITUTION"
-"RTN","C0CDOM",180,0)
- ;GNARY("med",1,"form@value")="TAB"
-"RTN","C0CDOM",181,0)
- ;GNARY("med",1,"id@value")="1N;O"
-"RTN","C0CDOM",182,0)
- ;GNARY("med",1,"location@code")=5
-"RTN","C0CDOM",183,0)
- ;GNARY("med",1,"location@name")="3 WEST"
-"RTN","C0CDOM",184,0)
- ;GNARY("med",1,"name@value")="LISINOPRIL TAB"
-"RTN","C0CDOM",185,0)
- ;GNARY("med",1,"orderID@value")=294
-"RTN","C0CDOM",186,0)
- ;GNARY("med",1,"ordered@value")=3110531.001233
-"RTN","C0CDOM",187,0)
- ;GNARY("med",1,"orderingProvider@code")=63
-"RTN","C0CDOM",188,0)
- ;GNARY("med",1,"orderingProvider@name")="KING,MATTHEW MICHAEL"
-"RTN","C0CDOM",189,0)
- ;GNARY("med",1,"products.product.class@code")="ACE INHIBITORS"
-"RTN","C0CDOM",190,0)
- ;GNARY("med",1,"products.product.vaGeneric@code")=1990
-"RTN","C0CDOM",191,0)
- ;GNARY("med",1,"products.product.vaGeneric@name")="LISINOPRIL"
-"RTN","C0CDOM",192,0)
- ;GNARY("med",1,"products.product.vaGeneric@vuid")=4019380
-"RTN","C0CDOM",193,0)
- ;GNARY("med",1,"products.product.vaProduct@code")=8118
-"RTN","C0CDOM",194,0)
- ;GNARY("med",1,"products.product.vaProduct@name")="LISINOPRIL 10MG TAB"
-"RTN","C0CDOM",195,0)
- ;GNARY("med",1,"products.product.vaProduct@vuid")=4008593
-"RTN","C0CDOM",196,0)
- ;GNARY("med",1,"products.product@code")=6174
-"RTN","C0CDOM",197,0)
- ;GNARY("med",1,"products.product@name")="LISINOPRIL 10MG U/D"
-"RTN","C0CDOM",198,0)
- ;GNARY("med",1,"products.product@role")="D"
-"RTN","C0CDOM",199,0)
- ;GNARY("med",1,"sig")="10MG BY MOUTH EVERY DAY"
-"RTN","C0CDOM",200,0)
- ;GNARY("med",1,"sig@xml:space")="preserve"
-"RTN","C0CDOM",201,0)
- ;GNARY("med",1,"status@value")="active"
-"RTN","C0CDOM",202,0)
- ;GNARY("med",1,"type@value")="OTC"
-"RTN","C0CDOM",203,0)
- ;GNARY("med",1,"vaType@value")="N"
-"RTN","C0CDOM",204,0)
- ;
-"RTN","C0CDOM",205,0)
- ; DOMI is an extrinsic to insert NHIN ARRAY FORMAT arrays into the DOM
-"RTN","C0CDOM",206,0)
- ; it returns 0 or 1 based on success.
-"RTN","C0CDOM",207,0)
- ;
-"RTN","C0CDOM",208,0)
- ; INARY is passed by name and has the format shown above
-"RTN","C0CDOM",209,0)
- ; HANDLE is the document number in the DOM (both MXML and EWD DOMs will
-"RTN","C0CDOM",210,0)
- ; be supported eventually - initial implementation is for MXML
-"RTN","C0CDOM",211,0)
- ;
-"RTN","C0CDOM",212,0)
- ; PARENT is the node id or tag of the parent under which the DOM will
-"RTN","C0CDOM",213,0)
- ; be populated. If it is numeric, it is a node. If it is a string, the DOM
-"RTN","C0CDOM",214,0)
- ; will be searched to find the tag. If not found and there is no root,
-"RTN","C0CDOM",215,0)
- ; it will be inserted as the root. If not found and there is a root, it
-"RTN","C0CDOM",216,0)
- ; will be inserted under the root.
-"RTN","C0CDOM",217,0)
- ;
-"RTN","C0CDOM",218,0)
- ; For the above example the call would be OK=$$DOMI("GNARY",0,"results")
-"RTN","C0CDOM",219,0)
- ; because "results" is the root tag. Use OUTXML to render the xml from
-"RTN","C0CDOM",220,0)
- ; the DOM.
-"RTN","C0CDOM",221,0)
- ;
-"RTN","C0CDOM",222,0)
-DOMI(INARY,HANDLE,PARENT) ; EXTRINSIC TO INSERT NHIN ARRAYS TO A DOM
-"RTN","C0CDOM",223,0)
- ;
-"RTN","C0CDOM",224,0)
- N ZPARNODE
-"RTN","C0CDOM",225,0)
- S (SUCCESS,LEVEL,LEVEL(0),NODE)=0
-"RTN","C0CDOM",226,0)
- I '$D(INARY) Q 0 ; NO ARRAY PASSED
-"RTN","C0CDOM",227,0)
- I '$D(HANDLE) S HANDLE=$$NEWDOM() ; MAKE A NEW DOM
-"RTN","C0CDOM",228,0)
- ;I PARENT="" S PARENT="root"
-"RTN","C0CDOM",229,0)
- I +$G(PARENT)>0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID
-"RTN","C0CDOM",230,0)
- E  I $L($G(PARENT))>0 D  ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL
-"RTN","C0CDOM",231,0)
- . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE
-"RTN","C0CDOM",232,0)
- . S ZPARNODE=1 ;
-"RTN","C0CDOM",233,0)
- ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET
-"RTN","C0CDOM",234,0)
- N ZEXARY
-"RTN","C0CDOM",235,0)
- D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY
-"RTN","C0CDOM",236,0)
- D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED
-"RTN","C0CDOM",237,0)
- I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE
-"RTN","C0CDOM",238,0)
- Q HANDLE ; SUCCESS
-"RTN","C0CDOM",239,0)
- ; 
-"RTN","C0CDOM",240,0)
-MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES
-"RTN","C0CDOM",241,0)
- N ZI S ZI=""
-"RTN","C0CDOM",242,0)
- N ZTAG
-"RTN","C0CDOM",243,0)
- F  S ZI=$O(@ZARY@(ZI)) Q:ZI=""  D  ; FOR EACH SECTION
-"RTN","C0CDOM",244,0)
- . N ZELEADD S ZELEADD=0
-"RTN","C0CDOM",245,0)
- . I ZI["@" D  ; END NODE HAS NO VALUE, ONLY ATTRIBUTES
-"RTN","C0CDOM",246,0)
- . . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG
-"RTN","C0CDOM",247,0)
- . . K ZATT ; CLEAR OUT LAST ONE
-"RTN","C0CDOM",248,0)
- . . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY
-"RTN","C0CDOM",249,0)
- . . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE
-"RTN","C0CDOM",250,0)
- . . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE
-"RTN","C0CDOM",251,0)
- . I $O(@ZARY@(ZI,""))="" D  ;END NODE
-"RTN","C0CDOM",252,0)
- . . S ZTAG=ZI ; USE ZI FOR THE TAG
-"RTN","C0CDOM",253,0)
- . . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE
-"RTN","C0CDOM",254,0)
- . . S ZELEADD=1 ; ADDED AN ELEMENT
-"RTN","C0CDOM",255,0)
- . . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE
-"RTN","C0CDOM",256,0)
- . I ZELEADD D  Q  ; NO MORE TO DO ON THIS LEVEL
-"RTN","C0CDOM",257,0)
- . . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING
-"RTN","C0CDOM",258,0)
- . N NEWARY ; INDENTED ARRAY
-"RTN","C0CDOM",259,0)
- . N ZN S ZN=0
-"RTN","C0CDOM",260,0)
- . F  S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN=""  D  ; FOR EACH MULTIPLE
-"RTN","C0CDOM",261,0)
- . . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG
-"RTN","C0CDOM",262,0)
- . . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY
-"RTN","C0CDOM",263,0)
- . . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY
-"RTN","C0CDOM",264,0)
- . . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG
 "RTN","C0CDOM",265,0)
+ ;
+"RTN","C0CDOM",266,0)
+EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED 
+"RTN","C0CDOM",267,0)
+ ; CONSISTENT FORMAT
+"RTN","C0CDOM",268,0)
+ ; GNARY("patient",1,"facilities[2].facility@code")="050"
+"RTN","C0CDOM",269,0)
+ ; becomes G2ARY("patient",1,"facilities",2,"facility@",1,"code")="050"
+"RTN","C0CDOM",270,0)
+ ; for easier processing (this is fileman format genius)
+"RTN","C0CDOM",271,0)
+ ; basically removes the dot notation from the strings
+"RTN","C0CDOM",272,0)
+ ;
+"RTN","C0CDOM",273,0)
+ N ZZI
+"RTN","C0CDOM",274,0)
+ S ZZI=""
+"RTN","C0CDOM",275,0)
+ F  S ZZI=$O(@ZZIN@(ZZI)) Q:ZZI=""  D  ;
+"RTN","C0CDOM",276,0)
+ . N ZZN S ZZN=0
+"RTN","C0CDOM",277,0)
+ . F  S ZZN=$O(@ZZIN@(ZZI,ZZN)) Q:ZZN=""  D  ;
+"RTN","C0CDOM",278,0)
+ . . N ZZS S ZZS=""
+"RTN","C0CDOM",279,0)
+ . . N GA ;PUSH STACK
+"RTN","C0CDOM",280,0)
+ . . F  S ZZS=$O(@ZZIN@(ZZI,ZZN,ZZS)) Q:ZZS=""  D  ;
+"RTN","C0CDOM",281,0)
+ . . . K GA ; NEW STACK
+"RTN","C0CDOM",282,0)
+ . . . D PUSH^C0CXPATH("GA",ZZI_"^"_ZZN) ; PUSH PARENT
+"RTN","C0CDOM",283,0)
+ . . . N ZZV ; PLACE TO STASH THE VALUE
+"RTN","C0CDOM",284,0)
+ . . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE
+"RTN","C0CDOM",285,0)
+ . . . W !,"VALUE:",ZZV
+"RTN","C0CDOM",286,0)
+ . . . N GK ; COUNTER
+"RTN","C0CDOM",287,0)
+ . . . F GK=1:1:$L(ZZS,".") D  ; FOR EACH INTERMEDIATE NODE
+"RTN","C0CDOM",288,0)
+ . . . . N ZZN2 S ZZN2=1 ; DEFAULT IF NO [X]
+"RTN","C0CDOM",289,0)
+ . . . . N GM S GM=$P(ZZS,".",GK) ; TAG
+"RTN","C0CDOM",290,0)
+ . . . . I GM["[" D  ; IT'S A MULTIPLE
+"RTN","C0CDOM",291,0)
+ . . . . . S ZZN2=$P($P(GM,"[",2),"]",1) ; PULL OUT THE NUMBER
+"RTN","C0CDOM",292,0)
+ . . . . . S GM=$P(GM,"[",1) ; PULL OUT THE TAG
+"RTN","C0CDOM",293,0)
+ . . . . I GM["@" D  ; IT'S GOT ATTRIBUTES
+"RTN","C0CDOM",294,0)
+ . . . . . N GM2 S GM2=$P(GM,"@",2) ; PULLOUT THE ATTRIBUTE NAME
+"RTN","C0CDOM",295,0)
+ . . . . . D PUSH^C0CXPATH("GA",$P(GM,"@",1)_"@"_"^"_ZZN2) ; PUSH THE TAG
+"RTN","C0CDOM",296,0)
+ . . . . . D PUSH^C0CXPATH("GA",GM2_"^"_ZZN2)
+"RTN","C0CDOM",297,0)
+ . . . . E  D PUSH^C0CXPATH("GA",GM_"^"_ZZN2) ;
+"RTN","C0CDOM",298,0)
+ . . . S GA(GA(0))=$P(GA(GA(0)),"^",1)_"^" ; GET RID OF THE LAST "1" 
+"RTN","C0CDOM",299,0)
+ . . . N GZI S GZI="" ; STRING FOR THE INDEX
+"RTN","C0CDOM",300,0)
+ . . . F GK=1:1:GA(0) D  ; TIME TO REVERSE POP THE TAGS
+"RTN","C0CDOM",301,0)
+ . . . . S GM=$P(GA(GK),"^",1) ; THE TAG
+"RTN","C0CDOM",302,0)
+ . . . . S ZZN2=$P(GA(GK),"^",2) ; THE NUMBER IF ANY
+"RTN","C0CDOM",303,0)
+ . . . . I ZZN2="" S GZI=GZI_""""_GM_"""" ; FOR THE LAST ONE
+"RTN","C0CDOM",304,0)
+ . . . . E  S GZI=GZI_""""_GM_""""_","_ZZN2_"," ; FOR THE REST
+"RTN","C0CDOM",305,0)
+ . . . S GZI2=ZZOUT_"("_GZI_")" ; INCLUDE THE ARRAY NAME
+"RTN","C0CDOM",306,0)
+ . . . W !,GZI
+"RTN","C0CDOM",307,0)
+ . . . S @GZI2=ZZV ; REMEMBER THE VALUE?
+"RTN","C0CDOM",308,0)
  Q
-"RTN","C0CDOM",266,0)
- ;
-"RTN","C0CDOM",267,0)
-EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED 
-"RTN","C0CDOM",268,0)
- ; CONSISTENT FORMAT
-"RTN","C0CDOM",269,0)
- ; GNARY("patient",1,"facilities[2].facility@code")="050"
-"RTN","C0CDOM",270,0)
- ; becomes G2ARY("patient",1,"facilities",2,"facility@",1,"code")="050"
-"RTN","C0CDOM",271,0)
- ; for easier processing (this is fileman format genius)
-"RTN","C0CDOM",272,0)
- ; basically removes the dot notation from the strings
-"RTN","C0CDOM",273,0)
- ;
-"RTN","C0CDOM",274,0)
- N ZZI
-"RTN","C0CDOM",275,0)
- S ZZI=""
-"RTN","C0CDOM",276,0)
- F  S ZZI=$O(@ZZIN@(ZZI)) Q:ZZI=""  D  ;
-"RTN","C0CDOM",277,0)
- . N ZZN S ZZN=0
-"RTN","C0CDOM",278,0)
- . F  S ZZN=$O(@ZZIN@(ZZI,ZZN)) Q:ZZN=""  D  ;
-"RTN","C0CDOM",279,0)
- . . N ZZS S ZZS=""
-"RTN","C0CDOM",280,0)
- . . N GA ;PUSH STACK
-"RTN","C0CDOM",281,0)
- . . F  S ZZS=$O(@ZZIN@(ZZI,ZZN,ZZS)) Q:ZZS=""  D  ;
-"RTN","C0CDOM",282,0)
- . . . K GA ; NEW STACK
-"RTN","C0CDOM",283,0)
- . . . D PUSH^C0CXPATH("GA",ZZI_"^"_ZZN) ; PUSH PARENT
-"RTN","C0CDOM",284,0)
- . . . N ZZV ; PLACE TO STASH THE VALUE
-"RTN","C0CDOM",285,0)
- . . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE
-"RTN","C0CDOM",286,0)
- . . . W !,"VALUE:",ZZV
-"RTN","C0CDOM",287,0)
- . . . N GK ; COUNTER
-"RTN","C0CDOM",288,0)
- . . . F GK=1:1:$L(ZZS,".") D  ; FOR EACH INTERMEDIATE NODE
-"RTN","C0CDOM",289,0)
- . . . . N ZZN2 S ZZN2=1 ; DEFAULT IF NO [X]
-"RTN","C0CDOM",290,0)
- . . . . N GM S GM=$P(ZZS,".",GK) ; TAG
-"RTN","C0CDOM",291,0)
- . . . . I GM["[" D  ; IT'S A MULTIPLE
-"RTN","C0CDOM",292,0)
- . . . . . S ZZN2=$P($P(GM,"[",2),"]",1) ; PULL OUT THE NUMBER
-"RTN","C0CDOM",293,0)
- . . . . . S GM=$P(GM,"[",1) ; PULL OUT THE TAG
-"RTN","C0CDOM",294,0)
- . . . . I GM["@" D  ; IT'S GOT ATTRIBUTES
-"RTN","C0CDOM",295,0)
- . . . . . N GM2 S GM2=$P(GM,"@",2) ; PULLOUT THE ATTRIBUTE NAME
-"RTN","C0CDOM",296,0)
- . . . . . D PUSH^C0CXPATH("GA",$P(GM,"@",1)_"@"_"^"_ZZN2) ; PUSH THE TAG
-"RTN","C0CDOM",297,0)
- . . . . . D PUSH^C0CXPATH("GA",GM2_"^"_ZZN2)
-"RTN","C0CDOM",298,0)
- . . . . E  D PUSH^C0CXPATH("GA",GM_"^"_ZZN2) ;
-"RTN","C0CDOM",299,0)
- . . . S GA(GA(0))=$P(GA(GA(0)),"^",1)_"^" ; GET RID OF THE LAST "1" 
-"RTN","C0CDOM",300,0)
- . . . N GZI S GZI="" ; STRING FOR THE INDEX
-"RTN","C0CDOM",301,0)
- . . . F GK=1:1:GA(0) D  ; TIME TO REVERSE POP THE TAGS
-"RTN","C0CDOM",302,0)
- . . . . S GM=$P(GA(GK),"^",1) ; THE TAG
-"RTN","C0CDOM",303,0)
- . . . . S ZZN2=$P(GA(GK),"^",2) ; THE NUMBER IF ANY
-"RTN","C0CDOM",304,0)
- . . . . I ZZN2="" S GZI=GZI_""""_GM_"""" ; FOR THE LAST ONE
-"RTN","C0CDOM",305,0)
- . . . . E  S GZI=GZI_""""_GM_""""_","_ZZN2_"," ; FOR THE REST
-"RTN","C0CDOM",306,0)
- . . . S GZI2=ZZOUT_"("_GZI_")" ; INCLUDE THE ARRAY NAME
-"RTN","C0CDOM",307,0)
- . . . W !,GZI
-"RTN","C0CDOM",308,0)
- . . . S @GZI2=ZZV ; REMEMBER THE VALUE?
 "RTN","C0CDOM",309,0)
- Q
+ ;
 "RTN","C0CDOM",310,0)
- ;
+NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE
 "RTN","C0CDOM",311,0)
-NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE
+ N CBK,SUCCESS,LEVEL,NODE,HANDLE
 "RTN","C0CDOM",312,0)
- N CBK,SUCCESS,LEVEL,NODE,HANDLE
+ K ^TMP("MXMLERR",$J)
 "RTN","C0CDOM",313,0)
- K ^TMP("MXMLERR",$J)
+ L +^TMP("MXMLDOM",$J):5
 "RTN","C0CDOM",314,0)
- L +^TMP("MXMLDOM",$J):5
+ E  Q 0
 "RTN","C0CDOM",315,0)
- E  Q 0
+ S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)=""
 "RTN","C0CDOM",316,0)
- S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)=""
+ L -^TMP("MXMLDOM",$J)
 "RTN","C0CDOM",317,0)
- L -^TMP("MXMLDOM",$J)
+ Q HANDLE
 "RTN","C0CDOM",318,0)
- Q HANDLE
-"RTN","C0CDOM",319,0)
  ;
 "RTN","C0CDPT")
-0^53^B45873061
+0^53^B46820265
 "RTN","C0CDPT",1,0)
 C0CDPT ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
 "RTN","C0CDPT",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CDPT",3,0)
  ;
 "RTN","C0CDPT",4,0)
- ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ; Copyright 2008 WorldVistA.  
 "RTN","C0CDPT",5,0)
- ; General Public License. 
+ ;
 "RTN","C0CDPT",6,0)
- ; 
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CDPT",7,0)
+ ; it under the terms of the GNU Affero General Public License as
+"RTN","C0CDPT",8,0)
+ ; published by the Free Software Foundation, either version 3 of the
+"RTN","C0CDPT",9,0)
+ ; License, or (at your option) any later version.
+"RTN","C0CDPT",10,0)
+ ;
+"RTN","C0CDPT",11,0)
  ; This program is distributed in the hope that it will be useful,
-"RTN","C0CDPT",8,0)
+"RTN","C0CDPT",12,0)
  ; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","C0CDPT",9,0)
+"RTN","C0CDPT",13,0)
  ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-"RTN","C0CDPT",10,0)
- ; GNU General Public License for more details.
-"RTN","C0CDPT",11,0)
- ; 
-"RTN","C0CDPT",12,0)
- ; You should have received a copy of the GNU General Public License along
-"RTN","C0CDPT",13,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
 "RTN","C0CDPT",14,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ; GNU Affero General Public License for more details.
 "RTN","C0CDPT",15,0)
  ;
 "RTN","C0CDPT",16,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CDPT",17,0)
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+"RTN","C0CDPT",18,0)
+ ;
+"RTN","C0CDPT",19,0)
+ ;
+"RTN","C0CDPT",20,0)
  ; FAMILY       Family Name
-"RTN","C0CDPT",17,0)
+"RTN","C0CDPT",21,0)
  ; GIVEN        Given Name
-"RTN","C0CDPT",18,0)
+"RTN","C0CDPT",22,0)
  ; MIDDLE       Middle Name
-"RTN","C0CDPT",19,0)
+"RTN","C0CDPT",23,0)
  ; SUFFIX       Suffix Name
-"RTN","C0CDPT",20,0)
+"RTN","C0CDPT",24,0)
  ; DISPNAME     Display Name
-"RTN","C0CDPT",21,0)
+"RTN","C0CDPT",25,0)
  ; DOB          Date of Birth
-"RTN","C0CDPT",22,0)
+"RTN","C0CDPT",26,0)
  ; GENDER       Get Gender
-"RTN","C0CDPT",23,0)
+"RTN","C0CDPT",27,0)
  ; SSN          Get SSN for ID
-"RTN","C0CDPT",24,0)
+"RTN","C0CDPT",28,0)
  ; ADDRTYPE     Get Home Address
-"RTN","C0CDPT",25,0)
+"RTN","C0CDPT",29,0)
  ; ADDR1        Get Home Address line 1
-"RTN","C0CDPT",26,0)
+"RTN","C0CDPT",30,0)
  ; ADDR2        Get Home Address line 2
-"RTN","C0CDPT",27,0)
+"RTN","C0CDPT",31,0)
  ; CITY         Get City for Home Address
-"RTN","C0CDPT",28,0)
+"RTN","C0CDPT",32,0)
  ; STATE        Get State for Home Address
-"RTN","C0CDPT",29,0)
+"RTN","C0CDPT",33,0)
  ; ZIP          Get Zip code for Home Address
-"RTN","C0CDPT",30,0)
+"RTN","C0CDPT",34,0)
  ; COUNTY       Get County for our Address
-"RTN","C0CDPT",31,0)
+"RTN","C0CDPT",35,0)
  ; COUNTRY      Get Country for our Address
-"RTN","C0CDPT",32,0)
+"RTN","C0CDPT",36,0)
  ; RESTEL       Residential Telephone
-"RTN","C0CDPT",33,0)
+"RTN","C0CDPT",37,0)
  ; WORKTEL      Work Telephone
-"RTN","C0CDPT",34,0)
+"RTN","C0CDPT",38,0)
  ; EMAIL        Email Adddress
-"RTN","C0CDPT",35,0)
+"RTN","C0CDPT",39,0)
  ; CELLTEL      Cell Phone
-"RTN","C0CDPT",36,0)
+"RTN","C0CDPT",40,0)
  ; NOK1FAM      Next of Kin 1 (NOK1) Family Name
-"RTN","C0CDPT",37,0)
+"RTN","C0CDPT",41,0)
  ; NOK1GIV      NOK1 Given Name
-"RTN","C0CDPT",38,0)
+"RTN","C0CDPT",42,0)
  ; NOK1MID      NOK1 Middle Name
-"RTN","C0CDPT",39,0)
+"RTN","C0CDPT",43,0)
  ; NOK1SUF      NOK1 Suffi Name
-"RTN","C0CDPT",40,0)
+"RTN","C0CDPT",44,0)
  ; NOK1DISP     NOK1 Display Name
-"RTN","C0CDPT",41,0)
+"RTN","C0CDPT",45,0)
  ; NOK1REL      NOK1 Relationship to the patient
-"RTN","C0CDPT",42,0)
+"RTN","C0CDPT",46,0)
  ; NOK1ADD1     NOK1 Address 1
-"RTN","C0CDPT",43,0)
+"RTN","C0CDPT",47,0)
  ; NOK1ADD2     NOK1 Address 2
-"RTN","C0CDPT",44,0)
+"RTN","C0CDPT",48,0)
  ; NOK1CITY     NOK1 City
-"RTN","C0CDPT",45,0)
+"RTN","C0CDPT",49,0)
  ; NOK1STAT     NOK1 State
-"RTN","C0CDPT",46,0)
+"RTN","C0CDPT",50,0)
  ; NOK1ZIP      NOK1 Zip Code
-"RTN","C0CDPT",47,0)
+"RTN","C0CDPT",51,0)
  ; NOK1HTEL     NOK1 Home Telephone
-"RTN","C0CDPT",48,0)
+"RTN","C0CDPT",52,0)
  ; NOK1WTEL     NOK1 Work Telephone
-"RTN","C0CDPT",49,0)
+"RTN","C0CDPT",53,0)
  ; NOK1SAME     Is NOK1's Address the same the patient?
-"RTN","C0CDPT",50,0)
+"RTN","C0CDPT",54,0)
  ; NOK2FAM      NOK2 Family Name
-"RTN","C0CDPT",51,0)
+"RTN","C0CDPT",55,0)
  ; NOK2GIV      NOK2 Given Name
-"RTN","C0CDPT",52,0)
+"RTN","C0CDPT",56,0)
  ; NOK2MID      NOK2 Middle Name
-"RTN","C0CDPT",53,0)
+"RTN","C0CDPT",57,0)
  ; NOK2SUF      NOK2 Suffi Name
-"RTN","C0CDPT",54,0)
+"RTN","C0CDPT",58,0)
  ; NOK2DISP     NOK2 Display Name
-"RTN","C0CDPT",55,0)
+"RTN","C0CDPT",59,0)
  ; NOK2REL      NOK2 Relationship to the patient
-"RTN","C0CDPT",56,0)
+"RTN","C0CDPT",60,0)
  ; NOK2ADD1     NOK2 Address 1
-"RTN","C0CDPT",57,0)
+"RTN","C0CDPT",61,0)
  ; NOK2ADD2     NOK2 Address 2
-"RTN","C0CDPT",58,0)
+"RTN","C0CDPT",62,0)
  ; NOK2CITY     NOK2 City
-"RTN","C0CDPT",59,0)
+"RTN","C0CDPT",63,0)
  ; NOK2STAT     NOK2 State
-"RTN","C0CDPT",60,0)
+"RTN","C0CDPT",64,0)
  ; NOK2ZIP      NOK2 Zip Code
-"RTN","C0CDPT",61,0)
+"RTN","C0CDPT",65,0)
  ; NOK2HTEL     NOK2 Home Telephone
-"RTN","C0CDPT",62,0)
+"RTN","C0CDPT",66,0)
  ; NOK2WTEL     NOK2 Work Telephone
-"RTN","C0CDPT",63,0)
+"RTN","C0CDPT",67,0)
  ; NOK2SAME     Is NOK2's Address the same the patient?
-"RTN","C0CDPT",64,0)
+"RTN","C0CDPT",68,0)
  ; EMERFAM      Emergency Contact (EMER) Family Name
-"RTN","C0CDPT",65,0)
+"RTN","C0CDPT",69,0)
  ; EMERGIV      EMER Given Name
-"RTN","C0CDPT",66,0)
+"RTN","C0CDPT",70,0)
  ; EMERMID      EMER Middle Name
-"RTN","C0CDPT",67,0)
+"RTN","C0CDPT",71,0)
  ; EMERSUF      EMER Suffi Name
-"RTN","C0CDPT",68,0)
+"RTN","C0CDPT",72,0)
  ; EMERDISP     EMER Display Name
-"RTN","C0CDPT",69,0)
+"RTN","C0CDPT",73,0)
  ; EMERREL      EMER Relationship to the patient
-"RTN","C0CDPT",70,0)
+"RTN","C0CDPT",74,0)
  ; EMERADD1     EMER Address 1
-"RTN","C0CDPT",71,0)
+"RTN","C0CDPT",75,0)
  ; EMERADD2     EMER Address 2
-"RTN","C0CDPT",72,0)
+"RTN","C0CDPT",76,0)
  ; EMERCITY     EMER City
-"RTN","C0CDPT",73,0)
+"RTN","C0CDPT",77,0)
  ; EMERSTAT     EMER State
-"RTN","C0CDPT",74,0)
+"RTN","C0CDPT",78,0)
  ; EMERZIP      EMER Zip Code
-"RTN","C0CDPT",75,0)
+"RTN","C0CDPT",79,0)
  ; EMERHTEL     EMER Home Telephone
-"RTN","C0CDPT",76,0)
+"RTN","C0CDPT",80,0)
  ; EMERWTEL     EMER Work Telephone
-"RTN","C0CDPT",77,0)
+"RTN","C0CDPT",81,0)
  ; EMERSAME     Is EMER's Address the same the NOK?
-"RTN","C0CDPT",78,0)
- ;
-"RTN","C0CDPT",79,0)
+"RTN","C0CDPT",82,0)
+ ;
+"RTN","C0CDPT",83,0)
  W "No Entry at top!" Q
-"RTN","C0CDPT",80,0)
- ;
-"RTN","C0CDPT",81,0)
+"RTN","C0CDPT",84,0)
+ ;
+"RTN","C0CDPT",85,0)
  ;**Revision History**
-"RTN","C0CDPT",82,0)
+"RTN","C0CDPT",86,0)
  ; - June 15, 08: v0.1 using merged global
-"RTN","C0CDPT",83,0)
+"RTN","C0CDPT",87,0)
  ; - Oct 3, 08: v0.2 using fileman calls, many formatting changes.
-"RTN","C0CDPT",84,0)
- ;
-"RTN","C0CDPT",85,0)
+"RTN","C0CDPT",88,0)
+ ;
+"RTN","C0CDPT",89,0)
  ; All methods are Public and Extrinsic
-"RTN","C0CDPT",86,0)
+"RTN","C0CDPT",90,0)
  ; All calls use Fileman file 2 (Patient).
-"RTN","C0CDPT",87,0)
+"RTN","C0CDPT",91,0)
  ; You can obtain field numbers using the data dictionary
-"RTN","C0CDPT",88,0)
- ;
-"RTN","C0CDPT",89,0)
+"RTN","C0CDPT",92,0)
+ ;
+"RTN","C0CDPT",93,0)
 FAMILY(DFN) ; Family Name
-"RTN","C0CDPT",90,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","C0CDPT",91,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","C0CDPT",92,0)
- Q NAME("FAMILY")
-"RTN","C0CDPT",93,0)
-GIVEN(DFN) ; Given Name
 "RTN","C0CDPT",94,0)
  N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
@@ -97352,7 +97334,7 @@
  D NAMECOMP^XLFNAME(.NAME)
 "RTN","C0CDPT",96,0)
- Q NAME("GIVEN")
+ Q NAME("FAMILY")
 "RTN","C0CDPT",97,0)
-MIDDLE(DFN) ; Middle Name
+GIVEN(DFN) ; Given Name
 "RTN","C0CDPT",98,0)
  N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
@@ -97360,7 +97342,7 @@
  D NAMECOMP^XLFNAME(.NAME)
 "RTN","C0CDPT",100,0)
- Q NAME("MIDDLE")
+ Q NAME("GIVEN")
 "RTN","C0CDPT",101,0)
-SUFFIX(DFN) ; Suffi Name
+MIDDLE(DFN) ; Middle Name
 "RTN","C0CDPT",102,0)
  N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
@@ -97368,99 +97350,99 @@
  D NAMECOMP^XLFNAME(.NAME)
 "RTN","C0CDPT",104,0)
- Q NAME("SUFFIX")
+ Q NAME("MIDDLE")
 "RTN","C0CDPT",105,0)
-DISPNAME(DFN) ; Display Name
+SUFFIX(DFN) ; Suffi Name
 "RTN","C0CDPT",106,0)
  N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
 "RTN","C0CDPT",107,0)
+ D NAMECOMP^XLFNAME(.NAME)
+"RTN","C0CDPT",108,0)
+ Q NAME("SUFFIX")
+"RTN","C0CDPT",109,0)
+DISPNAME(DFN) ; Display Name
+"RTN","C0CDPT",110,0)
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
+"RTN","C0CDPT",111,0)
  ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","C0CDPT",108,0)
+"RTN","C0CDPT",112,0)
  Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","C0CDPT",109,0)
+"RTN","C0CDPT",113,0)
 DOB(DFN) ; Date of Birth
-"RTN","C0CDPT",110,0)
+"RTN","C0CDPT",114,0)
  N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I")
-"RTN","C0CDPT",111,0)
+"RTN","C0CDPT",115,0)
  ; Date in FM Date Format. Convert to UTC/ISO 8601.
-"RTN","C0CDPT",112,0)
+"RTN","C0CDPT",116,0)
  Q $$FMDTOUTC^C0CUTIL(DOB,"D")
-"RTN","C0CDPT",113,0)
+"RTN","C0CDPT",117,0)
 GENDER(DFN) ; Gender/Sex
-"RTN","C0CDPT",114,0)
+"RTN","C0CDPT",118,0)
  Q $$GET1^DIQ(2,DFN,.02,"I")_"^"_$$GET1^DIQ(2,DFN,.02,"E") ;
-"RTN","C0CDPT",115,0)
+"RTN","C0CDPT",119,0)
 SSN(DFN) ; SSN
-"RTN","C0CDPT",116,0)
+"RTN","C0CDPT",120,0)
  Q $$GET1^DIQ(2,DFN,.09)
-"RTN","C0CDPT",117,0)
+"RTN","C0CDPT",121,0)
 ADDRTYPE(DFN) ; Address Type
-"RTN","C0CDPT",118,0)
+"RTN","C0CDPT",122,0)
  ; Vista only stores a home address for the patient.
-"RTN","C0CDPT",119,0)
+"RTN","C0CDPT",123,0)
  Q "Home"
-"RTN","C0CDPT",120,0)
+"RTN","C0CDPT",124,0)
 ADDR1(DFN) ; Get Home Address line 1
-"RTN","C0CDPT",121,0)
+"RTN","C0CDPT",125,0)
  Q $$GET1^DIQ(2,DFN,.111)
-"RTN","C0CDPT",122,0)
+"RTN","C0CDPT",126,0)
 ADDR2(DFN) ; Get Home Address line 2
-"RTN","C0CDPT",123,0)
+"RTN","C0CDPT",127,0)
  ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
-"RTN","C0CDPT",124,0)
+"RTN","C0CDPT",128,0)
  N ADDLN2,ADDLN3
-"RTN","C0CDPT",125,0)
+"RTN","C0CDPT",129,0)
  S ADDLN2=$$GET1^DIQ(2,DFN,.112),ADDLN3=$$GET1^DIQ(2,DFN,.113)
-"RTN","C0CDPT",126,0)
+"RTN","C0CDPT",130,0)
  Q:ADDLN3="" ADDLN2
-"RTN","C0CDPT",127,0)
+"RTN","C0CDPT",131,0)
  Q ADDLN2_", "_ADDLN3
-"RTN","C0CDPT",128,0)
+"RTN","C0CDPT",132,0)
 CITY(DFN) ; Get City for Home Address
-"RTN","C0CDPT",129,0)
+"RTN","C0CDPT",133,0)
  Q $$GET1^DIQ(2,DFN,.114)
-"RTN","C0CDPT",130,0)
+"RTN","C0CDPT",134,0)
 STATE(DFN) ; Get State for Home Address
-"RTN","C0CDPT",131,0)
+"RTN","C0CDPT",135,0)
  Q $$GET1^DIQ(2,DFN,.115)
-"RTN","C0CDPT",132,0)
+"RTN","C0CDPT",136,0)
 ZIP(DFN) ; Get Zip code for Home Address
-"RTN","C0CDPT",133,0)
+"RTN","C0CDPT",137,0)
  Q $$GET1^DIQ(2,DFN,.116)
-"RTN","C0CDPT",134,0)
+"RTN","C0CDPT",138,0)
 COUNTY(DFN) ; Get County for our Address
-"RTN","C0CDPT",135,0)
+"RTN","C0CDPT",139,0)
  Q $$GET1^DIQ(2,DFN,.117)
-"RTN","C0CDPT",136,0)
+"RTN","C0CDPT",140,0)
 COUNTRY(DFN) ; Get Country for our Address
-"RTN","C0CDPT",137,0)
+"RTN","C0CDPT",141,0)
  ; Unfortunately, it's not stored anywhere in Vista, so the inevitable...
-"RTN","C0CDPT",138,0)
+"RTN","C0CDPT",142,0)
  Q "USA"
-"RTN","C0CDPT",139,0)
+"RTN","C0CDPT",143,0)
 RESTEL(DFN) ; Residential Telephone
-"RTN","C0CDPT",140,0)
+"RTN","C0CDPT",144,0)
  Q $$GET1^DIQ(2,DFN,.131)
-"RTN","C0CDPT",141,0)
+"RTN","C0CDPT",145,0)
 WORKTEL(DFN) ; Work Telephone
-"RTN","C0CDPT",142,0)
+"RTN","C0CDPT",146,0)
  Q $$GET1^DIQ(2,DFN,.132)
-"RTN","C0CDPT",143,0)
+"RTN","C0CDPT",147,0)
 EMAIL(DFN) ; Email Adddress
-"RTN","C0CDPT",144,0)
+"RTN","C0CDPT",148,0)
  Q $$GET1^DIQ(2,DFN,.133)
-"RTN","C0CDPT",145,0)
+"RTN","C0CDPT",149,0)
 CELLTEL(DFN) ; Cell Phone
-"RTN","C0CDPT",146,0)
+"RTN","C0CDPT",150,0)
  Q $$GET1^DIQ(2,DFN,.134)
-"RTN","C0CDPT",147,0)
+"RTN","C0CDPT",151,0)
 NOK1FAM(DFN) ; Next of Kin 1 (NOK1) Family Name
-"RTN","C0CDPT",148,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","C0CDPT",149,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","C0CDPT",150,0)
- Q NAME("FAMILY")
-"RTN","C0CDPT",151,0)
-NOK1GIV(DFN) ; NOK1 Given Name
 "RTN","C0CDPT",152,0)
  N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
@@ -97468,7 +97450,7 @@
  D NAMECOMP^XLFNAME(.NAME)
 "RTN","C0CDPT",154,0)
- Q NAME("GIVEN")
+ Q NAME("FAMILY")
 "RTN","C0CDPT",155,0)
-NOK1MID(DFN) ; NOK1 Middle Name
+NOK1GIV(DFN) ; NOK1 Given Name
 "RTN","C0CDPT",156,0)
  N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
@@ -97476,7 +97458,7 @@
  D NAMECOMP^XLFNAME(.NAME)
 "RTN","C0CDPT",158,0)
- Q NAME("MIDDLE")
+ Q NAME("GIVEN")
 "RTN","C0CDPT",159,0)
-NOK1SUF(DFN) ; NOK1 Suffi Name
+NOK1MID(DFN) ; NOK1 Middle Name
 "RTN","C0CDPT",160,0)
  N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
@@ -97484,65 +97466,65 @@
  D NAMECOMP^XLFNAME(.NAME)
 "RTN","C0CDPT",162,0)
- Q NAME("SUFFIX")
+ Q NAME("MIDDLE")
 "RTN","C0CDPT",163,0)
-NOK1DISP(DFN) ; NOK1 Display Name
+NOK1SUF(DFN) ; NOK1 Suffi Name
 "RTN","C0CDPT",164,0)
  N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
 "RTN","C0CDPT",165,0)
+ D NAMECOMP^XLFNAME(.NAME)
+"RTN","C0CDPT",166,0)
+ Q NAME("SUFFIX")
+"RTN","C0CDPT",167,0)
+NOK1DISP(DFN) ; NOK1 Display Name
+"RTN","C0CDPT",168,0)
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
+"RTN","C0CDPT",169,0)
  ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","C0CDPT",166,0)
+"RTN","C0CDPT",170,0)
  Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","C0CDPT",167,0)
+"RTN","C0CDPT",171,0)
 NOK1REL(DFN) ; NOK1 Relationship to the patient
-"RTN","C0CDPT",168,0)
+"RTN","C0CDPT",172,0)
  Q $$GET1^DIQ(2,DFN,.212)
-"RTN","C0CDPT",169,0)
+"RTN","C0CDPT",173,0)
 NOK1ADD1(DFN) ; NOK1 Address 1
-"RTN","C0CDPT",170,0)
+"RTN","C0CDPT",174,0)
  Q $$GET1^DIQ(2,DFN,.213)
-"RTN","C0CDPT",171,0)
+"RTN","C0CDPT",175,0)
 NOK1ADD2(DFN) ; NOK1 Address 2 
-"RTN","C0CDPT",172,0)
+"RTN","C0CDPT",176,0)
  N ADDLN2,ADDLN3
-"RTN","C0CDPT",173,0)
+"RTN","C0CDPT",177,0)
  S ADDLN2=$$GET1^DIQ(2,DFN,.214),ADDLN3=$$GET1^DIQ(2,DFN,.215)
-"RTN","C0CDPT",174,0)
+"RTN","C0CDPT",178,0)
  Q:ADDLN3="" ADDLN2
-"RTN","C0CDPT",175,0)
+"RTN","C0CDPT",179,0)
  Q ADDLN2_", "_ADDLN3
-"RTN","C0CDPT",176,0)
+"RTN","C0CDPT",180,0)
 NOK1CITY(DFN) ; NOK1 City
-"RTN","C0CDPT",177,0)
+"RTN","C0CDPT",181,0)
  Q $$GET1^DIQ(2,DFN,.216)
-"RTN","C0CDPT",178,0)
+"RTN","C0CDPT",182,0)
 NOK1STAT(DFN) ; NOK1 State
-"RTN","C0CDPT",179,0)
+"RTN","C0CDPT",183,0)
  Q $$GET1^DIQ(2,DFN,.217)
-"RTN","C0CDPT",180,0)
+"RTN","C0CDPT",184,0)
 NOK1ZIP(DFN) ; NOK1 Zip Code
-"RTN","C0CDPT",181,0)
+"RTN","C0CDPT",185,0)
  Q $$GET1^DIQ(2,DFN,.218)
-"RTN","C0CDPT",182,0)
+"RTN","C0CDPT",186,0)
 NOK1HTEL(DFN) ; NOK1 Home Telephone
-"RTN","C0CDPT",183,0)
+"RTN","C0CDPT",187,0)
  Q $$GET1^DIQ(2,DFN,.219)
-"RTN","C0CDPT",184,0)
+"RTN","C0CDPT",188,0)
 NOK1WTEL(DFN) ; NOK1 Work Telephone
-"RTN","C0CDPT",185,0)
+"RTN","C0CDPT",189,0)
  Q $$GET1^DIQ(2,DFN,.21011)
-"RTN","C0CDPT",186,0)
+"RTN","C0CDPT",190,0)
 NOK1SAME(DFN) ; Is NOK1's Address the same the patient?
-"RTN","C0CDPT",187,0)
+"RTN","C0CDPT",191,0)
  Q $$GET1^DIQ(2,DFN,.2125)
-"RTN","C0CDPT",188,0)
+"RTN","C0CDPT",192,0)
 NOK2FAM(DFN) ; NOK2 Family Name
-"RTN","C0CDPT",189,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","C0CDPT",190,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","C0CDPT",191,0)
- Q NAME("FAMILY")
-"RTN","C0CDPT",192,0)
-NOK2GIV(DFN) ; NOK2 Given Name
 "RTN","C0CDPT",193,0)
  N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
@@ -97550,7 +97532,7 @@
  D NAMECOMP^XLFNAME(.NAME)
 "RTN","C0CDPT",195,0)
- Q NAME("GIVEN")
+ Q NAME("FAMILY")
 "RTN","C0CDPT",196,0)
-NOK2MID(DFN) ; NOK2 Middle Name
+NOK2GIV(DFN) ; NOK2 Given Name
 "RTN","C0CDPT",197,0)
  N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
@@ -97558,7 +97540,7 @@
  D NAMECOMP^XLFNAME(.NAME)
 "RTN","C0CDPT",199,0)
- Q NAME("MIDDLE")
+ Q NAME("GIVEN")
 "RTN","C0CDPT",200,0)
-NOK2SUF(DFN) ; NOK2 Suffi Name
+NOK2MID(DFN) ; NOK2 Middle Name
 "RTN","C0CDPT",201,0)
  N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
@@ -97566,65 +97548,65 @@
  D NAMECOMP^XLFNAME(.NAME)
 "RTN","C0CDPT",203,0)
- Q NAME("SUFFIX")
+ Q NAME("MIDDLE")
 "RTN","C0CDPT",204,0)
-NOK2DISP(DFN) ; NOK2 Display Name
+NOK2SUF(DFN) ; NOK2 Suffi Name
 "RTN","C0CDPT",205,0)
  N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
 "RTN","C0CDPT",206,0)
+ D NAMECOMP^XLFNAME(.NAME)
+"RTN","C0CDPT",207,0)
+ Q NAME("SUFFIX")
+"RTN","C0CDPT",208,0)
+NOK2DISP(DFN) ; NOK2 Display Name
+"RTN","C0CDPT",209,0)
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
+"RTN","C0CDPT",210,0)
  ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","C0CDPT",207,0)
+"RTN","C0CDPT",211,0)
  Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","C0CDPT",208,0)
+"RTN","C0CDPT",212,0)
 NOK2REL(DFN) ; NOK2 Relationship to the patient
-"RTN","C0CDPT",209,0)
+"RTN","C0CDPT",213,0)
  Q $$GET1^DIQ(2,DFN,.2192)
-"RTN","C0CDPT",210,0)
+"RTN","C0CDPT",214,0)
 NOK2ADD1(DFN) ; NOK2 Address 1
-"RTN","C0CDPT",211,0)
+"RTN","C0CDPT",215,0)
  Q $$GET1^DIQ(2,DFN,.2193)
-"RTN","C0CDPT",212,0)
+"RTN","C0CDPT",216,0)
 NOK2ADD2(DFN) ; NOK2 Address 2
-"RTN","C0CDPT",213,0)
+"RTN","C0CDPT",217,0)
  N ADDLN2,ADDLN3
-"RTN","C0CDPT",214,0)
+"RTN","C0CDPT",218,0)
  S ADDLN2=$$GET1^DIQ(2,DFN,.2194),ADDLN3=$$GET1^DIQ(2,DFN,.2195)
-"RTN","C0CDPT",215,0)
+"RTN","C0CDPT",219,0)
  Q:ADDLN3="" ADDLN2
-"RTN","C0CDPT",216,0)
+"RTN","C0CDPT",220,0)
  Q ADDLN2_", "_ADDLN3
-"RTN","C0CDPT",217,0)
+"RTN","C0CDPT",221,0)
 NOK2CITY(DFN) ; NOK2 City
-"RTN","C0CDPT",218,0)
+"RTN","C0CDPT",222,0)
  Q $$GET1^DIQ(2,DFN,.2196)
-"RTN","C0CDPT",219,0)
+"RTN","C0CDPT",223,0)
 NOK2STAT(DFN) ; NOK2 State
-"RTN","C0CDPT",220,0)
+"RTN","C0CDPT",224,0)
  Q $$GET1^DIQ(2,DFN,.2197)
-"RTN","C0CDPT",221,0)
+"RTN","C0CDPT",225,0)
 NOK2ZIP(DFN) ; NOK2 Zip Code
-"RTN","C0CDPT",222,0)
+"RTN","C0CDPT",226,0)
  Q $$GET1^DIQ(2,DFN,.2198)
-"RTN","C0CDPT",223,0)
+"RTN","C0CDPT",227,0)
 NOK2HTEL(DFN) ; NOK2 Home Telephone
-"RTN","C0CDPT",224,0)
+"RTN","C0CDPT",228,0)
  Q $$GET1^DIQ(2,DFN,.2199)
-"RTN","C0CDPT",225,0)
+"RTN","C0CDPT",229,0)
 NOK2WTEL(DFN) ; NOK2 Work Telephone
-"RTN","C0CDPT",226,0)
+"RTN","C0CDPT",230,0)
  Q $$GET1^DIQ(2,DFN,.211011)
-"RTN","C0CDPT",227,0)
+"RTN","C0CDPT",231,0)
 NOK2SAME(DFN) ; Is NOK2's Address the same the patient?
-"RTN","C0CDPT",228,0)
+"RTN","C0CDPT",232,0)
  Q $$GET1^DIQ(2,DFN,.21925)
-"RTN","C0CDPT",229,0)
+"RTN","C0CDPT",233,0)
 EMERFAM(DFN) ; Emergency Contact (EMER) Family Name
-"RTN","C0CDPT",230,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","C0CDPT",231,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","C0CDPT",232,0)
- Q NAME("FAMILY")
-"RTN","C0CDPT",233,0)
-EMERGIV(DFN) ; EMER Given Name
 "RTN","C0CDPT",234,0)
  N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
@@ -97632,7 +97614,7 @@
  D NAMECOMP^XLFNAME(.NAME)
 "RTN","C0CDPT",236,0)
- Q NAME("GIVEN")
+ Q NAME("FAMILY")
 "RTN","C0CDPT",237,0)
-EMERMID(DFN) ; EMER Middle Name
+EMERGIV(DFN) ; EMER Given Name
 "RTN","C0CDPT",238,0)
  N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
@@ -97640,7 +97622,7 @@
  D NAMECOMP^XLFNAME(.NAME)
 "RTN","C0CDPT",240,0)
- Q NAME("MIDDLE")
+ Q NAME("GIVEN")
 "RTN","C0CDPT",241,0)
-EMERSUF(DFN) ; EMER Suffi Name
+EMERMID(DFN) ; EMER Middle Name
 "RTN","C0CDPT",242,0)
  N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
@@ -97648,811 +97630,813 @@
  D NAMECOMP^XLFNAME(.NAME)
 "RTN","C0CDPT",244,0)
- Q NAME("SUFFIX")
+ Q NAME("MIDDLE")
 "RTN","C0CDPT",245,0)
-EMERDISP(DFN) ; EMER Display Name
+EMERSUF(DFN) ; EMER Suffi Name
 "RTN","C0CDPT",246,0)
  N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
 "RTN","C0CDPT",247,0)
+ D NAMECOMP^XLFNAME(.NAME)
+"RTN","C0CDPT",248,0)
+ Q NAME("SUFFIX")
+"RTN","C0CDPT",249,0)
+EMERDISP(DFN) ; EMER Display Name
+"RTN","C0CDPT",250,0)
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
+"RTN","C0CDPT",251,0)
  ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","C0CDPT",248,0)
+"RTN","C0CDPT",252,0)
  Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","C0CDPT",249,0)
+"RTN","C0CDPT",253,0)
 EMERREL(DFN) ; EMER Relationship to the patient
-"RTN","C0CDPT",250,0)
+"RTN","C0CDPT",254,0)
  Q $$GET1^DIQ(2,DFN,.331)
-"RTN","C0CDPT",251,0)
+"RTN","C0CDPT",255,0)
 EMERADD1(DFN) ; EMER Address 1
-"RTN","C0CDPT",252,0)
+"RTN","C0CDPT",256,0)
  Q $$GET1^DIQ(2,DFN,.333)
-"RTN","C0CDPT",253,0)
+"RTN","C0CDPT",257,0)
 EMERADD2(DFN) ; EMER Address 2
-"RTN","C0CDPT",254,0)
+"RTN","C0CDPT",258,0)
  N ADDLN2,ADDLN3
-"RTN","C0CDPT",255,0)
+"RTN","C0CDPT",259,0)
  S ADDLN2=$$GET1^DIQ(2,DFN,.334),ADDLN3=$$GET1^DIQ(2,DFN,.335)
-"RTN","C0CDPT",256,0)
+"RTN","C0CDPT",260,0)
  Q:ADDLN3="" ADDLN2
-"RTN","C0CDPT",257,0)
+"RTN","C0CDPT",261,0)
  Q ADDLN2_", "_ADDLN3
-"RTN","C0CDPT",258,0)
+"RTN","C0CDPT",262,0)
 EMERCITY(DFN) ; EMER City
-"RTN","C0CDPT",259,0)
+"RTN","C0CDPT",263,0)
  Q $$GET1^DIQ(2,DFN,.336)
-"RTN","C0CDPT",260,0)
+"RTN","C0CDPT",264,0)
 EMERSTAT(DFN) ; EMER State
-"RTN","C0CDPT",261,0)
+"RTN","C0CDPT",265,0)
  Q $$GET1^DIQ(2,DFN,.337)
-"RTN","C0CDPT",262,0)
+"RTN","C0CDPT",266,0)
 EMERZIP(DFN) ; EMER Zip Code
-"RTN","C0CDPT",263,0)
+"RTN","C0CDPT",267,0)
  Q $$GET1^DIQ(2,DFN,.338)
-"RTN","C0CDPT",264,0)
+"RTN","C0CDPT",268,0)
 EMERHTEL(DFN) ; EMER Home Telephone
-"RTN","C0CDPT",265,0)
+"RTN","C0CDPT",269,0)
  Q $$GET1^DIQ(2,DFN,.339)
-"RTN","C0CDPT",266,0)
+"RTN","C0CDPT",270,0)
 EMERWTEL(DFN) ; EMER Work Telephone
-"RTN","C0CDPT",267,0)
+"RTN","C0CDPT",271,0)
  Q $$GET1^DIQ(2,DFN,.33011)
-"RTN","C0CDPT",268,0)
+"RTN","C0CDPT",272,0)
 EMERSAME(DFN) ; Is EMER's Address the same the NOK?
-"RTN","C0CDPT",269,0)
+"RTN","C0CDPT",273,0)
  Q $$GET1^DIQ(2,DFN,.3305)
 "RTN","C0CENC")
-0^70^B46321144
+0^70^B45258660
 "RTN","C0CENC",1,0)
 C0CENC  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ENCOUNTERS ; 05/21/10
 "RTN","C0CENC",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CENC",3,0)
  ;Copyright 2010 George Lilly, University of Minnesota and others.
 "RTN","C0CENC",4,0)
- ;Licensed under the terms of the GNU General Public License.
+ ;
 "RTN","C0CENC",5,0)
- ;See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CENC",6,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CENC",7,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CENC",8,0)
- ;it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CENC",9,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CENC",10,0)
- ;(at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CENC",11,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CENC",12,0)
- ;This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CENC",13,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CENC",14,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CENC",15,0)
- ;GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CENC",16,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CENC",17,0)
- ;You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CENC",18,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ W "NO ENTRY FROM TOP",!
 "RTN","C0CENC",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ Q
 "RTN","C0CENC",20,0)
  ;
 "RTN","C0CENC",21,0)
- W "NO ENTRY FROM TOP",!
+EXTRACT(ENCXML,DFN,ENCOUT) ; EXTRACT ENCOUNTERS INTO  XML TEMPLATE
 "RTN","C0CENC",22,0)
+ ; ENCXML AND ENCOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","C0CENC",23,0)
+ ;
+"RTN","C0CENC",24,0)
+ D SETVARS^C0CPROC ; SET UP VARIABLES FOR PROCEDUCRES, ENCOUNTERS, AND NOTES
+"RTN","C0CENC",25,0)
+ ;I '$D(@C0CENC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE
+"RTN","C0CENC",26,0)
+ K @C0CENC
+"RTN","C0CENC",27,0)
+ D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET ENCOUNTERS
+"RTN","C0CENC",28,0)
+ D MAP(ENCXML,C0CENC,ENCOUT) ;MAP RESULTS FOR ENCOUNTERS
+"RTN","C0CENC",29,0)
  Q
-"RTN","C0CENC",23,0)
- ;
-"RTN","C0CENC",24,0)
-EXTRACT(ENCXML,DFN,ENCOUT) ; EXTRACT ENCOUNTERS INTO  XML TEMPLATE
-"RTN","C0CENC",25,0)
- ; ENCXML AND ENCOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","C0CENC",26,0)
- ;
-"RTN","C0CENC",27,0)
- D SETVARS^C0CPROC ; SET UP VARIABLES FOR PROCEDUCRES, ENCOUNTERS, AND NOTES
-"RTN","C0CENC",28,0)
- ;I '$D(@C0CENC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE
-"RTN","C0CENC",29,0)
- K @C0CENC
 "RTN","C0CENC",30,0)
- D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET ENCOUNTERS
+ ;
 "RTN","C0CENC",31,0)
- D MAP(ENCXML,C0CENC,ENCOUT) ;MAP RESULTS FOR ENCOUNTERS
+TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES, 
 "RTN","C0CENC",32,0)
+ ; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
+"RTN","C0CENC",33,0)
+ ; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES
+"RTN","C0CENC",34,0)
+ ; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT
+"RTN","C0CENC",35,0)
+ ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY 
+"RTN","C0CENC",36,0)
+ ; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM
+"RTN","C0CENC",37,0)
+ ; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS
+"RTN","C0CENC",38,0)
+ ;
+"RTN","C0CENC",39,0)
+ ;K VISIT,LST,NOTE
+"RTN","C0CENC",40,0)
+ I '$D(C0CPRC) D SETVARS^C0CPROC ; INITIALIZE WORK AREAS IF NOT ALREADY THERE
+"RTN","C0CENC",41,0)
+ I '$D(VISIT) D ENTRY^C0CCPT(DFN,,,1) ; RETURNS VISIT LOCAL VARIABLE
+"RTN","C0CENC",42,0)
+ ; NEED TO ADD START AND END DATES FROM PARAMETERS
+"RTN","C0CENC",43,0)
+ N ZI S ZI=""
+"RTN","C0CENC",44,0)
+ N PREVCPT,PREVDT S (PREVCPT,PREVDT)=""
+"RTN","C0CENC",45,0)
+ F  S ZI=$O(VISIT(ZI),-1) Q:ZI=""  D  ; REVERSE TIME ORDER - MOST RECENT FIRST
+"RTN","C0CENC",46,0)
+ . N ZDATE
+"RTN","C0CENC",47,0)
+ . S ZDATE=$$DATE(VISIT(ZI,"DATE",0))
+"RTN","C0CENC",48,0)
+ . S ZPRVARY=$NA(VISIT(ZI,"PRV"))
+"RTN","C0CENC",49,0)
+ . N ZPRV
+"RTN","C0CENC",50,0)
+ . S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM
+"RTN","C0CENC",51,0)
+ . ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON 
+"RTN","C0CENC",52,0)
+ . ; ENCOBJECTID - ENCOUNTER OBJECT ID
+"RTN","C0CENC",53,0)
+ . ; ENCDATETIME - ENCOUNTER DATE TIME
+"RTN","C0CENC",54,0)
+ . ; ENCTYPETXT - ENCOUNTER TYPE (PLANNING TO USE ADMINISTRATIVE CPT IF AVAIL)
+"RTN","C0CENC",55,0)
+ . ; ENCTYPECODE - CODE OF TYPE - PLANNING CPT CODE
+"RTN","C0CENC",56,0)
+ . ; ENCTYPECODESYS - CODING SYSTEM OF TYPE - CPT-4
+"RTN","C0CENC",57,0)
+ . ; ENCDESCTXT - ENCOUNTER DESCRIPTION TEXT
+"RTN","C0CENC",58,0)
+ . ; ENCDESCCODE - ENCOUNTER DESCRIPTION CODE
+"RTN","C0CENC",59,0)
+ . ; ENCDESCCODESYS - ENCOUNTER DESCRIPTION CODE SYSTEM
+"RTN","C0CENC",60,0)
+ . ; ENCLOCACTORID - ENCOUNTER LOCATION ACTOR ID
+"RTN","C0CENC",61,0)
+ . ; ENCPRVACTORID - ENCOUNTER PRACTIONER ACTOR ID
+"RTN","C0CENC",62,0)
+ . ; ENCINDTXT - ENCOUNTER INDICATION TEXT
+"RTN","C0CENC",63,0)
+ . ; ENCINDCODE - ENCOUNTER INDICATION CODE
+"RTN","C0CENC",64,0)
+ . ; ENCINDCODESYS - ENCOUNTER INDICATION CODE SYSTEM
+"RTN","C0CENC",65,0)
+ . ; ENCACTORID - ENCOUNTER SOURCE ACTOR ID
+"RTN","C0CENC",66,0)
+ . ; ENCCOMMENTID - ENCOUNTER COMMENT ID - POINTER TO NOTE IN COMMENT SECTION
+"RTN","C0CENC",67,0)
+ . S ZRNF("ENCOBJECTID")="ENCOUNTER_"_ZI
+"RTN","C0CENC",68,0)
+ . S ZRNF("ENCDATETIME")=ZDATE ; ENCOUNTER DATE TIME
+"RTN","C0CENC",69,0)
+ . S ZRNF("ENCTYPETXT")=""
+"RTN","C0CENC",70,0)
+ . S ZRNF("ENCTYPECODE")=""
+"RTN","C0CENC",71,0)
+ . S ZRNF("ENCTYPECODESYS")=""
+"RTN","C0CENC",72,0)
+ . S ZRNF("ENCDESCTXT")=""
+"RTN","C0CENC",73,0)
+ . S ZRNF("ENCDESCCODE")=""
+"RTN","C0CENC",74,0)
+ . S ZRNF("ENCDESCCODESYS")=""
+"RTN","C0CENC",75,0)
+ . N TYPTXT,TYPCDE,TYPSYS  ; WILL BE UPDATED BY GETTYPE CALL
+"RTN","C0CENC",76,0)
+ . I $$GETTYPE("VISIT(ZI)",.TYPTXT,.TYPCDE,.TYPSYS) D  ; RETURNS FALSE IF NO TYPE
+"RTN","C0CENC",77,0)
+ . . S ZRNF("ENCTYPETXT")=TYPTXT
+"RTN","C0CENC",78,0)
+ . . S ZRNF("ENCTYPECODE")=TYPCDE
+"RTN","C0CENC",79,0)
+ . . S ZRNF("ENCTYPECODESYS")=TYPSYS
+"RTN","C0CENC",80,0)
+ . . S ZRNF("ENCDESCTXT")=TYPTXT ; FOR NOW, DESCRIPTION IS SAME AS TYPE
+"RTN","C0CENC",81,0)
+ . . S ZRNF("ENCDESCCODE")=TYPCDE ; DESCRIPTION IS REQUIRED (TYPE IS NOT)
+"RTN","C0CENC",82,0)
+ . . S ZRNF("ENCDESCCODESYS")=TYPSYS ; NEED TO CLARIFY FOR VISTA
+"RTN","C0CENC",83,0)
+ . S ZRNF("ENCLOCACTORID")="ACTORORGANIZATION_1"
+"RTN","C0CENC",84,0)
+ . S ZRNF("ENCPRVACTORID")=ZPRV ; PRIMARY PROVIDER LISTED FOR THE ENCOUNTER
+"RTN","C0CENC",85,0)
+ . S ZRNF("ENCINDTXT")="" ; WE WILL PUT POINTERS TO PROBLEMS HERE
+"RTN","C0CENC",86,0)
+ . S ZRNF("ENCINDCODE")=""
+"RTN","C0CENC",87,0)
+ . S ZRNF("ENCINDCODESYS")=""
+"RTN","C0CENC",88,0)
+ . S ZRNF("ENCACTORID")=ZPRV ; SOURCE WILL BE PRIMARY PROVIDER
+"RTN","C0CENC",89,0)
+ . S ZRNF("ENCCOMMENTID")=""
+"RTN","C0CENC",90,0)
+ . I $G(VISIT(ZI,"TEXT",1))'="" D  ; THERE IS A NOTE
+"RTN","C0CENC",91,0)
+ . . M @C0CNTE@(ZI,"TEXT")=VISIT(ZI,"TEXT") ; COPY THE TEXT OF THE NOTE
+"RTN","C0CENC",92,0)
+ . . S @C0CNTE@(ZI,"COMMENTOBJECTID")="NOTE_"_ZI
+"RTN","C0CENC",93,0)
+ . . S @C0CNTE@(ZI,"CMTDATETIME")=ZDATE ; DATE OF THE NOTE
+"RTN","C0CENC",94,0)
+ . . S @C0CNTE@(ZI,"ACTORSOURCEID")=ZPRV ; SOURCE OF THE NOTE
+"RTN","C0CENC",95,0)
+ . . S ZRNF("ENCCOMMENTID")="NOTE_"_ZI ; POINT TO THE NOTE FROM THE ENCOUNTER
+"RTN","C0CENC",96,0)
+ . D RNF1TO2^C0CRNF(C0CENC,"ZRNF") ; ADD THIS ROW TO THE ARRAY
+"RTN","C0CENC",97,0)
+ . ;S PREVCPT=ZCPT
+"RTN","C0CENC",98,0)
+ . ;S PREVDT=ZDATE
+"RTN","C0CENC",99,0)
+ N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"ENCOUNTERS"))
+"RTN","C0CENC",100,0)
+ M @ZRIM=@C0CENC@("V")
+"RTN","C0CENC",101,0)
+ K VISIT,LST,NOTE
+"RTN","C0CENC",102,0)
  Q
-"RTN","C0CENC",33,0)
- ;
-"RTN","C0CENC",34,0)
-TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES, 
-"RTN","C0CENC",35,0)
- ; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
-"RTN","C0CENC",36,0)
- ; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES
-"RTN","C0CENC",37,0)
- ; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT
-"RTN","C0CENC",38,0)
- ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY 
-"RTN","C0CENC",39,0)
- ; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM
-"RTN","C0CENC",40,0)
- ; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS
-"RTN","C0CENC",41,0)
- ;
-"RTN","C0CENC",42,0)
- ;K VISIT,LST,NOTE
-"RTN","C0CENC",43,0)
- I '$D(C0CPRC) D SETVARS^C0CPROC ; INITIALIZE WORK AREAS IF NOT ALREADY THERE
-"RTN","C0CENC",44,0)
- I '$D(VISIT) D ENTRY^C0CCPT(DFN,,,1) ; RETURNS VISIT LOCAL VARIABLE
-"RTN","C0CENC",45,0)
- ; NEED TO ADD START AND END DATES FROM PARAMETERS
-"RTN","C0CENC",46,0)
- N ZI S ZI=""
-"RTN","C0CENC",47,0)
- N PREVCPT,PREVDT S (PREVCPT,PREVDT)=""
-"RTN","C0CENC",48,0)
- F  S ZI=$O(VISIT(ZI),-1) Q:ZI=""  D  ; REVERSE TIME ORDER - MOST RECENT FIRST
-"RTN","C0CENC",49,0)
- . N ZDATE
-"RTN","C0CENC",50,0)
- . S ZDATE=$$DATE(VISIT(ZI,"DATE",0))
-"RTN","C0CENC",51,0)
- . S ZPRVARY=$NA(VISIT(ZI,"PRV"))
-"RTN","C0CENC",52,0)
- . N ZPRV
-"RTN","C0CENC",53,0)
- . S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM
-"RTN","C0CENC",54,0)
- . ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON 
-"RTN","C0CENC",55,0)
- . ; ENCOBJECTID - ENCOUNTER OBJECT ID
-"RTN","C0CENC",56,0)
- . ; ENCDATETIME - ENCOUNTER DATE TIME
-"RTN","C0CENC",57,0)
- . ; ENCTYPETXT - ENCOUNTER TYPE (PLANNING TO USE ADMINISTRATIVE CPT IF AVAIL)
-"RTN","C0CENC",58,0)
- . ; ENCTYPECODE - CODE OF TYPE - PLANNING CPT CODE
-"RTN","C0CENC",59,0)
- . ; ENCTYPECODESYS - CODING SYSTEM OF TYPE - CPT-4
-"RTN","C0CENC",60,0)
- . ; ENCDESCTXT - ENCOUNTER DESCRIPTION TEXT
-"RTN","C0CENC",61,0)
- . ; ENCDESCCODE - ENCOUNTER DESCRIPTION CODE
-"RTN","C0CENC",62,0)
- . ; ENCDESCCODESYS - ENCOUNTER DESCRIPTION CODE SYSTEM
-"RTN","C0CENC",63,0)
- . ; ENCLOCACTORID - ENCOUNTER LOCATION ACTOR ID
-"RTN","C0CENC",64,0)
- . ; ENCPRVACTORID - ENCOUNTER PRACTIONER ACTOR ID
-"RTN","C0CENC",65,0)
- . ; ENCINDTXT - ENCOUNTER INDICATION TEXT
-"RTN","C0CENC",66,0)
- . ; ENCINDCODE - ENCOUNTER INDICATION CODE
-"RTN","C0CENC",67,0)
- . ; ENCINDCODESYS - ENCOUNTER INDICATION CODE SYSTEM
-"RTN","C0CENC",68,0)
- . ; ENCACTORID - ENCOUNTER SOURCE ACTOR ID
-"RTN","C0CENC",69,0)
- . ; ENCCOMMENTID - ENCOUNTER COMMENT ID - POINTER TO NOTE IN COMMENT SECTION
-"RTN","C0CENC",70,0)
- . S ZRNF("ENCOBJECTID")="ENCOUNTER_"_ZI
-"RTN","C0CENC",71,0)
- . S ZRNF("ENCDATETIME")=ZDATE ; ENCOUNTER DATE TIME
-"RTN","C0CENC",72,0)
- . S ZRNF("ENCTYPETXT")=""
-"RTN","C0CENC",73,0)
- . S ZRNF("ENCTYPECODE")=""
-"RTN","C0CENC",74,0)
- . S ZRNF("ENCTYPECODESYS")=""
-"RTN","C0CENC",75,0)
- . S ZRNF("ENCDESCTXT")=""
-"RTN","C0CENC",76,0)
- . S ZRNF("ENCDESCCODE")=""
-"RTN","C0CENC",77,0)
- . S ZRNF("ENCDESCCODESYS")=""
-"RTN","C0CENC",78,0)
- . N TYPTXT,TYPCDE,TYPSYS  ; WILL BE UPDATED BY GETTYPE CALL
-"RTN","C0CENC",79,0)
- . I $$GETTYPE("VISIT(ZI)",.TYPTXT,.TYPCDE,.TYPSYS) D  ; RETURNS FALSE IF NO TYPE
-"RTN","C0CENC",80,0)
- . . S ZRNF("ENCTYPETXT")=TYPTXT
-"RTN","C0CENC",81,0)
- . . S ZRNF("ENCTYPECODE")=TYPCDE
-"RTN","C0CENC",82,0)
- . . S ZRNF("ENCTYPECODESYS")=TYPSYS
-"RTN","C0CENC",83,0)
- . . S ZRNF("ENCDESCTXT")=TYPTXT ; FOR NOW, DESCRIPTION IS SAME AS TYPE
-"RTN","C0CENC",84,0)
- . . S ZRNF("ENCDESCCODE")=TYPCDE ; DESCRIPTION IS REQUIRED (TYPE IS NOT)
-"RTN","C0CENC",85,0)
- . . S ZRNF("ENCDESCCODESYS")=TYPSYS ; NEED TO CLARIFY FOR VISTA
-"RTN","C0CENC",86,0)
- . S ZRNF("ENCLOCACTORID")="ACTORORGANIZATION_1"
-"RTN","C0CENC",87,0)
- . S ZRNF("ENCPRVACTORID")=ZPRV ; PRIMARY PROVIDER LISTED FOR THE ENCOUNTER
-"RTN","C0CENC",88,0)
- . S ZRNF("ENCINDTXT")="" ; WE WILL PUT POINTERS TO PROBLEMS HERE
-"RTN","C0CENC",89,0)
- . S ZRNF("ENCINDCODE")=""
-"RTN","C0CENC",90,0)
- . S ZRNF("ENCINDCODESYS")=""
-"RTN","C0CENC",91,0)
- . S ZRNF("ENCACTORID")=ZPRV ; SOURCE WILL BE PRIMARY PROVIDER
-"RTN","C0CENC",92,0)
- . S ZRNF("ENCCOMMENTID")=""
-"RTN","C0CENC",93,0)
- . I $G(VISIT(ZI,"TEXT",1))'="" D  ; THERE IS A NOTE
-"RTN","C0CENC",94,0)
- . . M @C0CNTE@(ZI,"TEXT")=VISIT(ZI,"TEXT") ; COPY THE TEXT OF THE NOTE
-"RTN","C0CENC",95,0)
- . . S @C0CNTE@(ZI,"COMMENTOBJECTID")="NOTE_"_ZI
-"RTN","C0CENC",96,0)
- . . S @C0CNTE@(ZI,"CMTDATETIME")=ZDATE ; DATE OF THE NOTE
-"RTN","C0CENC",97,0)
- . . S @C0CNTE@(ZI,"ACTORSOURCEID")=ZPRV ; SOURCE OF THE NOTE
-"RTN","C0CENC",98,0)
- . . S ZRNF("ENCCOMMENTID")="NOTE_"_ZI ; POINT TO THE NOTE FROM THE ENCOUNTER
-"RTN","C0CENC",99,0)
- . D RNF1TO2^C0CRNF(C0CENC,"ZRNF") ; ADD THIS ROW TO THE ARRAY
-"RTN","C0CENC",100,0)
- . ;S PREVCPT=ZCPT
-"RTN","C0CENC",101,0)
- . ;S PREVDT=ZDATE
-"RTN","C0CENC",102,0)
- N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"ENCOUNTERS"))
 "RTN","C0CENC",103,0)
- M @ZRIM=@C0CENC@("V")
+ ;
 "RTN","C0CENC",104,0)
- K VISIT,LST,NOTE
+GETTYPE(ZARY,ZTXT,ZCDE,ZSYS) ; EXTRINSIC WHICH RETURNS FALSE IF NO ENCOUNTER TYPE
 "RTN","C0CENC",105,0)
+ ; UPDATES ZTXT WITH ENCOUNTER TYPE TEXT, ZCDE WITH ENCOUNTER TYPE CODE
+"RTN","C0CENC",106,0)
+ ; AND ZSYS WITH ENCOUNTER TYPE CODING SYSTEM
+"RTN","C0CENC",107,0)
+ ; THIS ROUTINE SHOULD BE UPDATED TO SEARCH FOR AN ADMINISTRATIVE CPT CODE
+"RTN","C0CENC",108,0)
+ ; INSTEAD OF JUST THE FIRST ONE IN THE LIST - GPL 1/23/10
+"RTN","C0CENC",109,0)
+ N ZS,ZC
+"RTN","C0CENC",110,0)
+ S ZC="" S ZS=""
+"RTN","C0CENC",111,0)
+ S (ZTXT,ZCDE,ZSYS)=""
+"RTN","C0CENC",112,0)
+ F  S ZC=$O(@ZARY@("CPT",ZC)) Q:ZC=""  D  ; TRY AND FIND A "99" CPT CODE
+"RTN","C0CENC",113,0)
+ . N ZT
+"RTN","C0CENC",114,0)
+ . S ZT=$$CPT^C0CPROC(@ZARY@("CPT",ZC)) ; VALUES IN A CPT MULTIPLE
+"RTN","C0CENC",115,0)
+ . I $E($P(ZT,U,1),1,2)="99" S ZS=ZT ; IS IT AN ADMIN CPT CODE?
+"RTN","C0CENC",116,0)
+ I ZS'="" D  ; CODED ENCOUNTER TYPE FOUND
+"RTN","C0CENC",117,0)
+ . S ZTXT=$P(ZS,U,2)_" "_$P(ZS,U,3) ; USE BOTH PIECES FOR THE TYPE
+"RTN","C0CENC",118,0)
+ . S ZCDE=$P($$CPT^C0CPROC(ZS),U,1) ; CPT CODE FOR ENCOUTER
+"RTN","C0CENC",119,0)
+ . S ZSYS=""
+"RTN","C0CENC",120,0)
+ . I ZCDE'="" S ZSYS="CPT-4" ; ONLY HAVE A CODING SYSTEM IF THERE IS A CODE
+"RTN","C0CENC",121,0)
+ I ZS="" S ZTXT=$$ANYTXT(ZARY) ; TRY AND GET FREE FORM TEXT FROM CPT MULTIPLES
+"RTN","C0CENC",122,0)
+ I ZTXT="" Q 0 ; FAILED
+"RTN","C0CENC",123,0)
+ W !,ZTXT
+"RTN","C0CENC",124,0)
+ Q 1 ; SUCCESS
+"RTN","C0CENC",125,0)
+ ;
+"RTN","C0CENC",126,0)
+ANYTXT(ZVST) ; EXTRINSIC WHICH RETURNS TEXT FROM THE CPT MULTIPLE
+"RTN","C0CENC",127,0)
+ ; OF A VISIT ARRAY WITHOUT CHECKING THE CPT CODE (THAT HAVING FAILED)
+"RTN","C0CENC",128,0)
+ ; ZVST IS THE VISIT ARRAY AND IS PASSED BY NAME
+"RTN","C0CENC",129,0)
+ ; RETURNS TEXT TO USE AS ENCOUNTER TYPE IF ANY
+"RTN","C0CENC",130,0)
+ N ZK,ZL
+"RTN","C0CENC",131,0)
+ S ZK="" S ZL=""
+"RTN","C0CENC",132,0)
+ F  S ZK=$O(@ZVST@("CPT",ZK)) Q:ZK=""  D  ; LOOK FOR SOME TEXT TO USE
+"RTN","C0CENC",133,0)
+ . N ZT
+"RTN","C0CENC",134,0)
+ . S ZT=$G(@ZVST@("CPT",ZK)) ; LOOK AT THIS CPT MULTIPLE
+"RTN","C0CENC",135,0)
+ . I $P(ZT,U,2)_" "_$P(ZT,U,3)'=" " S ZL=$P(ZT,U,2)_" "_$P(ZT,U,3)
+"RTN","C0CENC",136,0)
+ . ; CONCATENATE PIECE 2 AND 3 OF THE CPT MULTIPLE FOR A TYPE
+"RTN","C0CENC",137,0)
+ I ZL="" S ZL=$G(@ZVST@("CLASS")) ; USE THE NOTE DOCUMENT CLASS FOR ENCOUTNER TYPE
+"RTN","C0CENC",138,0)
+ Q ZL
+"RTN","C0CENC",139,0)
+ ;
+"RTN","C0CENC",140,0)
+PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME
+"RTN","C0CENC",141,0)
+ N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN=""
+"RTN","C0CENC",142,0)
+ F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ; FOR EACH PRV SEG
+"RTN","C0CENC",143,0)
+ . I ZR'="" Q  ;ONLY WANT THE FIRST PRIMARY PROVIDER
+"RTN","C0CENC",144,0)
+ . I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1)
+"RTN","C0CENC",145,0)
+ I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR
+"RTN","C0CENC",146,0)
+ Q ZRTN
+"RTN","C0CENC",147,0)
+ ;
+"RTN","C0CENC",148,0)
+DATE(ISTR) ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT
+"RTN","C0CENC",149,0)
+ Q $$FMDTOUTC^C0CUTIL(ISTR,"DT")
+"RTN","C0CENC",150,0)
+ ;
+"RTN","C0CENC",151,0)
+CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS
+"RTN","C0CENC",152,0)
+ ; CPT^CATEGORY^TEXT
+"RTN","C0CENC",153,0)
+ N Z1,Z2,Z3,ZRTN
+"RTN","C0CENC",154,0)
+ S Z1=$P(ISTR,U,1)
+"RTN","C0CENC",155,0)
+ I Z1="" D  ;
+"RTN","C0CENC",156,0)
+ . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)
+"RTN","C0CENC",157,0)
+ I Z1'="" D  ; IF THERE IS A CPT CODE IN THERE
+"RTN","C0CENC",158,0)
+ . ;S Z1=$P(ISTR,U,1)
+"RTN","C0CENC",159,0)
+ . S Z2=$P(ISTR,U,2)
+"RTN","C0CENC",160,0)
+ . S Z3=$P(ISTR,U,3)
+"RTN","C0CENC",161,0)
+ . S ZRTN=Z1_U_Z2_U_Z3
+"RTN","C0CENC",162,0)
+ E  S ZRTN=""
+"RTN","C0CENC",163,0)
+ Q ZRTN
+"RTN","C0CENC",164,0)
+ ;
+"RTN","C0CENC",165,0)
+MAP(ENCXML,C0CENC,ENCOUT) ; MAP PROCEDURES XML 
+"RTN","C0CENC",166,0)
+ ;
+"RTN","C0CENC",167,0)
+ N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"ENCTEMP")) ;WORK AREA FOR TEMPLATE
+"RTN","C0CENC",168,0)
+ K @ZTEMP
+"RTN","C0CENC",169,0)
+ N ZBLD
+"RTN","C0CENC",170,0)
+ S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"ENCBLD")) ; BUILD LIST AREA
+"RTN","C0CENC",171,0)
+ D QUEUE^C0CXPATH(ZBLD,ENCXML,1,1) ; FIRST LINE
+"RTN","C0CENC",172,0)
+ N ZINNER
+"RTN","C0CENC",173,0)
+ D QUERY^C0CXPATH(ENCXML,"//Encounters/Encounter","ZINNER") ;ONE ENCOUNTER
+"RTN","C0CENC",174,0)
+ N ZTMP,ZVAR,ZI
+"RTN","C0CENC",175,0)
+ S ZI=""
+"RTN","C0CENC",176,0)
+ F  S ZI=$O(@C0CENC@("V",ZI)) Q:ZI=""  D  ;FOR EACH ENCOUNTER
+"RTN","C0CENC",177,0)
+ . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS ENCOUNTER XML
+"RTN","C0CENC",178,0)
+ . S ZVAR=$NA(@C0CENC@("V",ZI)) ;THIS ENCOUNTER VARIABLES
+"RTN","C0CENC",179,0)
+ . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
+"RTN","C0CENC",180,0)
+ . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
+"RTN","C0CENC",181,0)
+ D QUEUE^C0CXPATH(ZBLD,ENCXML,@ENCXML@(0),@ENCXML@(0))
+"RTN","C0CENC",182,0)
+ N ZZTMP
+"RTN","C0CENC",183,0)
+ D BUILD^C0CXPATH(ZBLD,ENCOUT) ;BUILD FINAL XML
+"RTN","C0CENC",184,0)
+ K @ZTEMP,@ZBLD,@C0CENC
+"RTN","C0CENC",185,0)
  Q
-"RTN","C0CENC",106,0)
- ;
-"RTN","C0CENC",107,0)
-GETTYPE(ZARY,ZTXT,ZCDE,ZSYS) ; EXTRINSIC WHICH RETURNS FALSE IF NO ENCOUNTER TYPE
-"RTN","C0CENC",108,0)
- ; UPDATES ZTXT WITH ENCOUNTER TYPE TEXT, ZCDE WITH ENCOUNTER TYPE CODE
-"RTN","C0CENC",109,0)
- ; AND ZSYS WITH ENCOUNTER TYPE CODING SYSTEM
-"RTN","C0CENC",110,0)
- ; THIS ROUTINE SHOULD BE UPDATED TO SEARCH FOR AN ADMINISTRATIVE CPT CODE
-"RTN","C0CENC",111,0)
- ; INSTEAD OF JUST THE FIRST ONE IN THE LIST - GPL 1/23/10
-"RTN","C0CENC",112,0)
- N ZS,ZC
-"RTN","C0CENC",113,0)
- S ZC="" S ZS=""
-"RTN","C0CENC",114,0)
- S (ZTXT,ZCDE,ZSYS)=""
-"RTN","C0CENC",115,0)
- F  S ZC=$O(@ZARY@("CPT",ZC)) Q:ZC=""  D  ; TRY AND FIND A "99" CPT CODE
-"RTN","C0CENC",116,0)
- . N ZT
-"RTN","C0CENC",117,0)
- . S ZT=$$CPT^C0CPROC(@ZARY@("CPT",ZC)) ; VALUES IN A CPT MULTIPLE
-"RTN","C0CENC",118,0)
- . I $E($P(ZT,U,1),1,2)="99" S ZS=ZT ; IS IT AN ADMIN CPT CODE?
-"RTN","C0CENC",119,0)
- I ZS'="" D  ; CODED ENCOUNTER TYPE FOUND
-"RTN","C0CENC",120,0)
- . S ZTXT=$P(ZS,U,2)_" "_$P(ZS,U,3) ; USE BOTH PIECES FOR THE TYPE
-"RTN","C0CENC",121,0)
- . S ZCDE=$P($$CPT^C0CPROC(ZS),U,1) ; CPT CODE FOR ENCOUTER
-"RTN","C0CENC",122,0)
- . S ZSYS=""
-"RTN","C0CENC",123,0)
- . I ZCDE'="" S ZSYS="CPT-4" ; ONLY HAVE A CODING SYSTEM IF THERE IS A CODE
-"RTN","C0CENC",124,0)
- I ZS="" S ZTXT=$$ANYTXT(ZARY) ; TRY AND GET FREE FORM TEXT FROM CPT MULTIPLES
-"RTN","C0CENC",125,0)
- I ZTXT="" Q 0 ; FAILED
-"RTN","C0CENC",126,0)
- W !,ZTXT
-"RTN","C0CENC",127,0)
- Q 1 ; SUCCESS
-"RTN","C0CENC",128,0)
- ;
-"RTN","C0CENC",129,0)
-ANYTXT(ZVST) ; EXTRINSIC WHICH RETURNS TEXT FROM THE CPT MULTIPLE
-"RTN","C0CENC",130,0)
- ; OF A VISIT ARRAY WITHOUT CHECKING THE CPT CODE (THAT HAVING FAILED)
-"RTN","C0CENC",131,0)
- ; ZVST IS THE VISIT ARRAY AND IS PASSED BY NAME
-"RTN","C0CENC",132,0)
- ; RETURNS TEXT TO USE AS ENCOUNTER TYPE IF ANY
-"RTN","C0CENC",133,0)
- N ZK,ZL
-"RTN","C0CENC",134,0)
- S ZK="" S ZL=""
-"RTN","C0CENC",135,0)
- F  S ZK=$O(@ZVST@("CPT",ZK)) Q:ZK=""  D  ; LOOK FOR SOME TEXT TO USE
-"RTN","C0CENC",136,0)
- . N ZT
-"RTN","C0CENC",137,0)
- . S ZT=$G(@ZVST@("CPT",ZK)) ; LOOK AT THIS CPT MULTIPLE
-"RTN","C0CENC",138,0)
- . I $P(ZT,U,2)_" "_$P(ZT,U,3)'=" " S ZL=$P(ZT,U,2)_" "_$P(ZT,U,3)
-"RTN","C0CENC",139,0)
- . ; CONCATENATE PIECE 2 AND 3 OF THE CPT MULTIPLE FOR A TYPE
-"RTN","C0CENC",140,0)
- I ZL="" S ZL=$G(@ZVST@("CLASS")) ; USE THE NOTE DOCUMENT CLASS FOR ENCOUTNER TYPE
-"RTN","C0CENC",141,0)
- Q ZL
-"RTN","C0CENC",142,0)
- ;
-"RTN","C0CENC",143,0)
-PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME
-"RTN","C0CENC",144,0)
- N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN=""
-"RTN","C0CENC",145,0)
- F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ; FOR EACH PRV SEG
-"RTN","C0CENC",146,0)
- . I ZR'="" Q  ;ONLY WANT THE FIRST PRIMARY PROVIDER
-"RTN","C0CENC",147,0)
- . I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1)
-"RTN","C0CENC",148,0)
- I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR
-"RTN","C0CENC",149,0)
- Q ZRTN
-"RTN","C0CENC",150,0)
- ;
-"RTN","C0CENC",151,0)
-DATE(ISTR) ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT
-"RTN","C0CENC",152,0)
- Q $$FMDTOUTC^C0CUTIL(ISTR,"DT")
-"RTN","C0CENC",153,0)
- ;
-"RTN","C0CENC",154,0)
-CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS
-"RTN","C0CENC",155,0)
- ; CPT^CATEGORY^TEXT
-"RTN","C0CENC",156,0)
- N Z1,Z2,Z3,ZRTN
-"RTN","C0CENC",157,0)
- S Z1=$P(ISTR,U,1) 
-"RTN","C0CENC",158,0)
- I Z1="" D  ;
-"RTN","C0CENC",159,0)
- . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)
-"RTN","C0CENC",160,0)
- I Z1'="" D  ; IF THERE IS A CPT CODE IN THERE
-"RTN","C0CENC",161,0)
- . ;S Z1=$P(ISTR,U,1)
-"RTN","C0CENC",162,0)
- . S Z2=$P(ISTR,U,2)
-"RTN","C0CENC",163,0)
- . S Z3=$P(ISTR,U,3)
-"RTN","C0CENC",164,0)
- . S ZRTN=Z1_U_Z2_U_Z3
-"RTN","C0CENC",165,0)
- E  S ZRTN=""
-"RTN","C0CENC",166,0)
- Q ZRTN
-"RTN","C0CENC",167,0)
- ;
-"RTN","C0CENC",168,0)
-MAP(ENCXML,C0CENC,ENCOUT) ; MAP PROCEDURES XML 
-"RTN","C0CENC",169,0)
- ;
-"RTN","C0CENC",170,0)
- N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"ENCTEMP")) ;WORK AREA FOR TEMPLATE
-"RTN","C0CENC",171,0)
- K @ZTEMP
-"RTN","C0CENC",172,0)
- N ZBLD
-"RTN","C0CENC",173,0)
- S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"ENCBLD")) ; BUILD LIST AREA
-"RTN","C0CENC",174,0)
- D QUEUE^C0CXPATH(ZBLD,ENCXML,1,1) ; FIRST LINE
-"RTN","C0CENC",175,0)
- N ZINNER
-"RTN","C0CENC",176,0)
- D QUERY^C0CXPATH(ENCXML,"//Encounters/Encounter","ZINNER") ;ONE ENCOUNTER
-"RTN","C0CENC",177,0)
- N ZTMP,ZVAR,ZI
-"RTN","C0CENC",178,0)
- S ZI=""
-"RTN","C0CENC",179,0)
- F  S ZI=$O(@C0CENC@("V",ZI)) Q:ZI=""  D  ;FOR EACH ENCOUNTER
-"RTN","C0CENC",180,0)
- . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS ENCOUNTER XML
-"RTN","C0CENC",181,0)
- . S ZVAR=$NA(@C0CENC@("V",ZI)) ;THIS ENCOUNTER VARIABLES
-"RTN","C0CENC",182,0)
- . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
-"RTN","C0CENC",183,0)
- . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
-"RTN","C0CENC",184,0)
- D QUEUE^C0CXPATH(ZBLD,ENCXML,@ENCXML@(0),@ENCXML@(0))
-"RTN","C0CENC",185,0)
- N ZZTMP
 "RTN","C0CENC",186,0)
- D BUILD^C0CXPATH(ZBLD,ENCOUT) ;BUILD FINAL XML
-"RTN","C0CENC",187,0)
- K @ZTEMP,@ZBLD,@C0CENC
-"RTN","C0CENC",188,0)
- Q
-"RTN","C0CENC",189,0)
  ;  
 "RTN","C0CENV")
-0^75^B25371113
+0^75^B28427348
 "RTN","C0CENV",1,0)
 C0CENV ;WV/JMC - CCD/CCR Environment Check/Install Routine ; Aug 16, 2009
 "RTN","C0CENV",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CENV",3,0)
  ;
 "RTN","C0CENV",4,0)
- ;
+ ; (C) John McCormack 2009
 "RTN","C0CENV",5,0)
+ ;
+"RTN","C0CENV",6,0)
+ ; This program is free software: you can redistribute it and/or modify
+"RTN","C0CENV",7,0)
+ ; it under the terms of the GNU Affero General Public License as
+"RTN","C0CENV",8,0)
+ ; published by the Free Software Foundation, either version 3 of the
+"RTN","C0CENV",9,0)
+ ; License, or (at your option) any later version.
+"RTN","C0CENV",10,0)
+ ;
+"RTN","C0CENV",11,0)
+ ; This program is distributed in the hope that it will be useful,
+"RTN","C0CENV",12,0)
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","C0CENV",13,0)
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","C0CENV",14,0)
+ ; GNU Affero General Public License for more details.
+"RTN","C0CENV",15,0)
+ ;
+"RTN","C0CENV",16,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CENV",17,0)
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+"RTN","C0CENV",18,0)
+ ;
+"RTN","C0CENV",19,0)
+ ;
+"RTN","C0CENV",20,0)
 ENV ; Does not prevent loading of the transport global.
-"RTN","C0CENV",6,0)
+"RTN","C0CENV",21,0)
  ; Environment check is done only during the install.
-"RTN","C0CENV",7,0)
- ;
-"RTN","C0CENV",8,0)
+"RTN","C0CENV",22,0)
+ ;
+"RTN","C0CENV",23,0)
  N XQA,XQAMSG
-"RTN","C0CENV",9,0)
- ;
-"RTN","C0CENV",10,0)
- ;
-"RTN","C0CENV",11,0)
+"RTN","C0CENV",24,0)
+ ;
+"RTN","C0CENV",25,0)
+ ;
+"RTN","C0CENV",26,0)
  ; Make sure the patch name exist
-"RTN","C0CENV",12,0)
- ;
-"RTN","C0CENV",13,0)
+"RTN","C0CENV",27,0)
+ ;
+"RTN","C0CENV",28,0)
  I '$D(XPDNM) D  Q
-"RTN","C0CENV",14,0)
+"RTN","C0CENV",29,0)
  . D BMES("No valid patch name exist")
-"RTN","C0CENV",15,0)
+"RTN","C0CENV",30,0)
  . S XPDQUIT=2
-"RTN","C0CENV",16,0)
+"RTN","C0CENV",31,0)
  . D EXIT
-"RTN","C0CENV",17,0)
- ;
-"RTN","C0CENV",18,0)
+"RTN","C0CENV",32,0)
+ ;
+"RTN","C0CENV",33,0)
  D CHECK
-"RTN","C0CENV",19,0)
+"RTN","C0CENV",34,0)
  D EXIT
-"RTN","C0CENV",20,0)
+"RTN","C0CENV",35,0)
  Q
-"RTN","C0CENV",21,0)
- ;
-"RTN","C0CENV",22,0)
- ;
-"RTN","C0CENV",23,0)
+"RTN","C0CENV",36,0)
+ ;
+"RTN","C0CENV",37,0)
+ ;
+"RTN","C0CENV",38,0)
 CHECK ; Perform environment check
-"RTN","C0CENV",24,0)
- ;
-"RTN","C0CENV",25,0)
+"RTN","C0CENV",39,0)
+ ;
+"RTN","C0CENV",40,0)
  I $S('$G(IOM):1,'$G(IOSL):1,$G(U)'="^":1,1:0) D
-"RTN","C0CENV",26,0)
+"RTN","C0CENV",41,0)
  . D BMES("Terminal Device is not defined")
-"RTN","C0CENV",27,0)
+"RTN","C0CENV",42,0)
  . S XPDQUIT=2
-"RTN","C0CENV",28,0)
- ;
-"RTN","C0CENV",29,0)
+"RTN","C0CENV",43,0)
+ ;
+"RTN","C0CENV",44,0)
  I $S('$G(DUZ):1,$D(DUZ)[0:1,$D(DUZ(0))[0:1,1:0) D
-"RTN","C0CENV",30,0)
+"RTN","C0CENV",45,0)
  . D BMES("Please log in to set local DUZ... variables")
-"RTN","C0CENV",31,0)
+"RTN","C0CENV",46,0)
  . S XPDQUIT=2
-"RTN","C0CENV",32,0)
- ;
-"RTN","C0CENV",33,0)
+"RTN","C0CENV",47,0)
+ ;
+"RTN","C0CENV",48,0)
  I $P($$ACTIVE^XUSER(DUZ),"^")'=1 D
-"RTN","C0CENV",34,0)
+"RTN","C0CENV",49,0)
  . D BMES("You are not a valid user on this system")
-"RTN","C0CENV",35,0)
+"RTN","C0CENV",50,0)
  . S XPDQUIT=2
-"RTN","C0CENV",36,0)
+"RTN","C0CENV",51,0)
  Q
-"RTN","C0CENV",37,0)
- ;
-"RTN","C0CENV",38,0)
- ;
-"RTN","C0CENV",39,0)
+"RTN","C0CENV",52,0)
+ ;
+"RTN","C0CENV",53,0)
+ ;
+"RTN","C0CENV",54,0)
 EXIT ;
-"RTN","C0CENV",40,0)
- ;
-"RTN","C0CENV",41,0)
- ;
-"RTN","C0CENV",42,0)
+"RTN","C0CENV",55,0)
+ ;
+"RTN","C0CENV",56,0)
+ ;
+"RTN","C0CENV",57,0)
  I $G(XPDQUIT) D BMES("--- Install Environment Check FAILED ---") Q
-"RTN","C0CENV",43,0)
+"RTN","C0CENV",58,0)
  D BMES("--- Environment Check is Ok ---")
-"RTN","C0CENV",44,0)
- ;
-"RTN","C0CENV",45,0)
+"RTN","C0CENV",59,0)
+ ;
+"RTN","C0CENV",60,0)
  Q
-"RTN","C0CENV",46,0)
- ;
-"RTN","C0CENV",47,0)
- ;
-"RTN","C0CENV",48,0)
+"RTN","C0CENV",61,0)
+ ;
+"RTN","C0CENV",62,0)
+ ;
+"RTN","C0CENV",63,0)
 PRE ;Pre-install entry point
-"RTN","C0CENV",49,0)
- ;
-"RTN","C0CENV",50,0)
+"RTN","C0CENV",64,0)
+ ;
+"RTN","C0CENV",65,0)
  ; No action needed in pre-install
-"RTN","C0CENV",51,0)
+"RTN","C0CENV",66,0)
  D BMES("No action need for pre-install")
-"RTN","C0CENV",52,0)
- ;
-"RTN","C0CENV",53,0)
+"RTN","C0CENV",67,0)
+ ;
+"RTN","C0CENV",68,0)
  Q
-"RTN","C0CENV",54,0)
- ;
-"RTN","C0CENV",55,0)
- ;
-"RTN","C0CENV",56,0)
+"RTN","C0CENV",69,0)
+ ;
+"RTN","C0CENV",70,0)
+ ;
+"RTN","C0CENV",71,0)
 POST ;Post install
-"RTN","C0CENV",57,0)
- ;
-"RTN","C0CENV",58,0)
+"RTN","C0CENV",72,0)
+ ;
+"RTN","C0CENV",73,0)
  ; Check for RPMS system with V LAB file.
-"RTN","C0CENV",59,0)
- ;
-"RTN","C0CENV",60,0)
+"RTN","C0CENV",74,0)
+ ;
+"RTN","C0CENV",75,0)
  I $$VFILE^DILFD(9000010.09)'=1 Q
-"RTN","C0CENV",61,0)
- ;
-"RTN","C0CENV",62,0)
+"RTN","C0CENV",76,0)
+ ;
+"RTN","C0CENV",77,0)
  S %=$$NEWCP^XPDUTL("RPMS1","POST1^C0CENV")
-"RTN","C0CENV",63,0)
+"RTN","C0CENV",78,0)
  S %=$$NEWCP^XPDUTL("RPMS2","POST2^C0CENV")
-"RTN","C0CENV",64,0)
+"RTN","C0CENV",79,0)
  S %=$$NEWCP^XPDUTL("RPMS3","POST3^C0CENV")
-"RTN","C0CENV",65,0)
+"RTN","C0CENV",80,0)
  S %=$$NEWCP^XPDUTL("RPMS4","POST4^C0CENV")
-"RTN","C0CENV",66,0)
+"RTN","C0CENV",81,0)
  S %=$$NEWCP^XPDUTL("RPMS5","POST5^C0CENV")
-"RTN","C0CENV",67,0)
+"RTN","C0CENV",82,0)
  S %=$$NEWCP^XPDUTL("RPMS6","POST6^C0CENV")
-"RTN","C0CENV",68,0)
+"RTN","C0CENV",83,0)
  S %=$$NEWCP^XPDUTL("RPMS7","POST7^C0CENV")
-"RTN","C0CENV",69,0)
- ;
-"RTN","C0CENV",70,0)
+"RTN","C0CENV",84,0)
+ ;
+"RTN","C0CENV",85,0)
  Q
-"RTN","C0CENV",71,0)
- ;
-"RTN","C0CENV",72,0)
- ;
-"RTN","C0CENV",73,0)
+"RTN","C0CENV",86,0)
+ ;
+"RTN","C0CENV",87,0)
+ ;
+"RTN","C0CENV",88,0)
 POST1 ; Checkpoint call back entry point.
-"RTN","C0CENV",74,0)
+"RTN","C0CENV",89,0)
  ; Add new style ALR1 cross-reference to V LAB file.
-"RTN","C0CENV",75,0)
- ;
-"RTN","C0CENV",76,0)
+"RTN","C0CENV",90,0)
+ ;
+"RTN","C0CENV",91,0)
  N MSG
-"RTN","C0CENV",77,0)
+"RTN","C0CENV",92,0)
  S MSG="Starting installation of ALR1 cross-reference at "_$$HTE^XLFDT($H,"1Z")
-"RTN","C0CENV",78,0)
- D BMES(MSG)
-"RTN","C0CENV",79,0)
- D ALR1^C0CLA7DD
-"RTN","C0CENV",80,0)
- S MSG="Installation of ALR1 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
-"RTN","C0CENV",81,0)
- D BMES(MSG)
-"RTN","C0CENV",82,0)
- Q
-"RTN","C0CENV",83,0)
- ;
-"RTN","C0CENV",84,0)
- ;
-"RTN","C0CENV",85,0)
-POST2 ; Checkpoint call back entry point.
-"RTN","C0CENV",86,0)
- ; Add new style ALR2 cross-reference to V LAB file.
-"RTN","C0CENV",87,0)
- ;
-"RTN","C0CENV",88,0)
- N MSG
-"RTN","C0CENV",89,0)
- S MSG="Starting installation of ALR2 cross-reference at "_$$HTE^XLFDT($H,"1Z")
-"RTN","C0CENV",90,0)
- D BMES(MSG)
-"RTN","C0CENV",91,0)
- D ALR2^C0CLA7DD
-"RTN","C0CENV",92,0)
- S MSG="Installation of ALR2 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
 "RTN","C0CENV",93,0)
  D BMES(MSG)
 "RTN","C0CENV",94,0)
+ D ALR1^C0CLA7DD
+"RTN","C0CENV",95,0)
+ S MSG="Installation of ALR1 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
+"RTN","C0CENV",96,0)
+ D BMES(MSG)
+"RTN","C0CENV",97,0)
  Q
-"RTN","C0CENV",95,0)
- ;
-"RTN","C0CENV",96,0)
- ;
-"RTN","C0CENV",97,0)
-POST3 ; Checkpoint call back entry point.
 "RTN","C0CENV",98,0)
- ; Add new style ALR3 cross-reference to V LAB file.
+ ;
 "RTN","C0CENV",99,0)
  ;
 "RTN","C0CENV",100,0)
+POST2 ; Checkpoint call back entry point.
+"RTN","C0CENV",101,0)
+ ; Add new style ALR2 cross-reference to V LAB file.
+"RTN","C0CENV",102,0)
+ ;
+"RTN","C0CENV",103,0)
  N MSG
-"RTN","C0CENV",101,0)
- S MSG="Starting installation of ALR3 cross-reference at "_$$HTE^XLFDT($H,"1Z")
-"RTN","C0CENV",102,0)
- D BMES(MSG)
-"RTN","C0CENV",103,0)
- D ALR3^C0CLA7DD
 "RTN","C0CENV",104,0)
- S MSG="Installation of ALR3 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
+ S MSG="Starting installation of ALR2 cross-reference at "_$$HTE^XLFDT($H,"1Z")
 "RTN","C0CENV",105,0)
  D BMES(MSG)
 "RTN","C0CENV",106,0)
+ D ALR2^C0CLA7DD
+"RTN","C0CENV",107,0)
+ S MSG="Installation of ALR2 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
+"RTN","C0CENV",108,0)
+ D BMES(MSG)
+"RTN","C0CENV",109,0)
  Q
-"RTN","C0CENV",107,0)
- ;
-"RTN","C0CENV",108,0)
- ;
-"RTN","C0CENV",109,0)
-POST4 ; Checkpoint call back entry point.
 "RTN","C0CENV",110,0)
- ; Add new style ALR4 cross-reference to V LAB file.
+ ;
 "RTN","C0CENV",111,0)
  ;
 "RTN","C0CENV",112,0)
+POST3 ; Checkpoint call back entry point.
+"RTN","C0CENV",113,0)
+ ; Add new style ALR3 cross-reference to V LAB file.
+"RTN","C0CENV",114,0)
+ ;
+"RTN","C0CENV",115,0)
  N MSG
-"RTN","C0CENV",113,0)
- S MSG="Starting installation of ALR4 cross-reference at "_$$HTE^XLFDT($H,"1Z")
-"RTN","C0CENV",114,0)
- D BMES(MSG)
-"RTN","C0CENV",115,0)
- D ALR4^C0CLA7DD
 "RTN","C0CENV",116,0)
- S MSG="Installation of ALR4 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
+ S MSG="Starting installation of ALR3 cross-reference at "_$$HTE^XLFDT($H,"1Z")
 "RTN","C0CENV",117,0)
  D BMES(MSG)
 "RTN","C0CENV",118,0)
+ D ALR3^C0CLA7DD
+"RTN","C0CENV",119,0)
+ S MSG="Installation of ALR3 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
+"RTN","C0CENV",120,0)
+ D BMES(MSG)
+"RTN","C0CENV",121,0)
  Q
-"RTN","C0CENV",119,0)
- ;
-"RTN","C0CENV",120,0)
- ;
-"RTN","C0CENV",121,0)
-POST5 ; Checkpoint call back entry point.
 "RTN","C0CENV",122,0)
- ; Add new style ALR5 cross-reference to V LAB file.
+ ;
 "RTN","C0CENV",123,0)
  ;
 "RTN","C0CENV",124,0)
+POST4 ; Checkpoint call back entry point.
+"RTN","C0CENV",125,0)
+ ; Add new style ALR4 cross-reference to V LAB file.
+"RTN","C0CENV",126,0)
+ ;
+"RTN","C0CENV",127,0)
  N MSG
-"RTN","C0CENV",125,0)
- S MSG="Starting installation of ALR5 cross-reference at "_$$HTE^XLFDT($H,"1Z")
-"RTN","C0CENV",126,0)
- D BMES(MSG)
-"RTN","C0CENV",127,0)
- D ALR5^C0CLA7DD
 "RTN","C0CENV",128,0)
- S MSG="Installation of ALR5 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
+ S MSG="Starting installation of ALR4 cross-reference at "_$$HTE^XLFDT($H,"1Z")
 "RTN","C0CENV",129,0)
  D BMES(MSG)
 "RTN","C0CENV",130,0)
+ D ALR4^C0CLA7DD
+"RTN","C0CENV",131,0)
+ S MSG="Installation of ALR4 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
+"RTN","C0CENV",132,0)
+ D BMES(MSG)
+"RTN","C0CENV",133,0)
  Q
-"RTN","C0CENV",131,0)
- ;
-"RTN","C0CENV",132,0)
- ;
-"RTN","C0CENV",133,0)
+"RTN","C0CENV",134,0)
+ ;
+"RTN","C0CENV",135,0)
+ ;
+"RTN","C0CENV",136,0)
+POST5 ; Checkpoint call back entry point.
+"RTN","C0CENV",137,0)
+ ; Add new style ALR5 cross-reference to V LAB file.
+"RTN","C0CENV",138,0)
+ ;
+"RTN","C0CENV",139,0)
+ N MSG
+"RTN","C0CENV",140,0)
+ S MSG="Starting installation of ALR5 cross-reference at "_$$HTE^XLFDT($H,"1Z")
+"RTN","C0CENV",141,0)
+ D BMES(MSG)
+"RTN","C0CENV",142,0)
+ D ALR5^C0CLA7DD
+"RTN","C0CENV",143,0)
+ S MSG="Installation of ALR5 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
+"RTN","C0CENV",144,0)
+ D BMES(MSG)
+"RTN","C0CENV",145,0)
+ Q
+"RTN","C0CENV",146,0)
+ ;
+"RTN","C0CENV",147,0)
+ ;
+"RTN","C0CENV",148,0)
 POST6 ; Checkpoint call back entry point.
-"RTN","C0CENV",134,0)
+"RTN","C0CENV",149,0)
  ; Check for RPMS system and determine LAB patch level
-"RTN","C0CENV",135,0)
+"RTN","C0CENV",150,0)
  ;  and need to load in C0C version of LA7 routines.
-"RTN","C0CENV",136,0)
- ;
-"RTN","C0CENV",137,0)
+"RTN","C0CENV",151,0)
+ ;
+"RTN","C0CENV",152,0)
  N MSG
-"RTN","C0CENV",138,0)
- ;
-"RTN","C0CENV",139,0)
+"RTN","C0CENV",153,0)
+ ;
+"RTN","C0CENV",154,0)
  ; Load and rename C0CQRY2 to LA7QRY2 if LA*5.2*69 not installed
-"RTN","C0CENV",140,0)
+"RTN","C0CENV",155,0)
  I '$$PATCH^XPDUTL("LA*5.2*69") D
-"RTN","C0CENV",141,0)
+"RTN","C0CENV",156,0)
  . S MSG="This system missing LAB patch LA*5.2*69"
-"RTN","C0CENV",142,0)
+"RTN","C0CENV",157,0)
  . D BMES(MSG)
-"RTN","C0CENV",143,0)
+"RTN","C0CENV",158,0)
  . S MSG="Renaming routine C0CQRY2 to LA7QRY2"
-"RTN","C0CENV",144,0)
+"RTN","C0CENV",159,0)
  . D BMES(MSG)
-"RTN","C0CENV",145,0)
+"RTN","C0CENV",160,0)
  . D LOAD("C0CQRY2")
-"RTN","C0CENV",146,0)
+"RTN","C0CENV",161,0)
  . D SAVE("C0CQRY2","LA7QRY2")
-"RTN","C0CENV",147,0)
- ;
-"RTN","C0CENV",148,0)
+"RTN","C0CENV",162,0)
+ ;
+"RTN","C0CENV",163,0)
  ; Load and rename C0CVOBX1 to LA7VOBX1 if LA*5.2*64 not installed.
-"RTN","C0CENV",149,0)
+"RTN","C0CENV",164,0)
  I '$$PATCH^XPDUTL("LA*5.2*64") D
-"RTN","C0CENV",150,0)
+"RTN","C0CENV",165,0)
  . S MSG="This system missing LAB patch LA*5.2*64"
-"RTN","C0CENV",151,0)
+"RTN","C0CENV",166,0)
  . D BMES(MSG)
-"RTN","C0CENV",152,0)
+"RTN","C0CENV",167,0)
  . S MSG="Renaming routine C0CVOBX1 to LA7VOBX1"
-"RTN","C0CENV",153,0)
+"RTN","C0CENV",168,0)
  . D BMES(MSG)
-"RTN","C0CENV",154,0)
+"RTN","C0CENV",169,0)
  . D LOAD("C0CVOBX1")
-"RTN","C0CENV",155,0)
+"RTN","C0CENV",170,0)
  . D SAVE("C0CVOBX1","LA7VOBX1")
-"RTN","C0CENV",156,0)
- ;
-"RTN","C0CENV",157,0)
+"RTN","C0CENV",171,0)
+ ;
+"RTN","C0CENV",172,0)
  ; Load and rename C0CQRY1 to LA7QRY1 if LA*5.2*68 not installed.
-"RTN","C0CENV",158,0)
+"RTN","C0CENV",173,0)
  I '$$PATCH^XPDUTL("LA*5.2*68") D
-"RTN","C0CENV",159,0)
+"RTN","C0CENV",174,0)
  . S MSG="This system missing LAB patch LA*5.2*68"
-"RTN","C0CENV",160,0)
+"RTN","C0CENV",175,0)
  . D BMES(MSG)
-"RTN","C0CENV",161,0)
+"RTN","C0CENV",176,0)
  . S MSG="Renaming routine C0CQRY1 to LA7QRY1"
-"RTN","C0CENV",162,0)
+"RTN","C0CENV",177,0)
  . D BMES(MSG)
-"RTN","C0CENV",163,0)
+"RTN","C0CENV",178,0)
  . D LOAD("C0CQRY1")
-"RTN","C0CENV",164,0)
+"RTN","C0CENV",179,0)
  . D SAVE("C0CQRY1","LA7QRY1")
-"RTN","C0CENV",165,0)
- ;
-"RTN","C0CENV",166,0)
+"RTN","C0CENV",180,0)
+ ;
+"RTN","C0CENV",181,0)
  Q
-"RTN","C0CENV",167,0)
- ;
-"RTN","C0CENV",168,0)
- ;
-"RTN","C0CENV",169,0)
+"RTN","C0CENV",182,0)
+ ;
+"RTN","C0CENV",183,0)
+ ;
+"RTN","C0CENV",184,0)
 POST7 ; Checkpoint call back entry point.
-"RTN","C0CENV",170,0)
- ;
-"RTN","C0CENV",171,0)
+"RTN","C0CENV",185,0)
+ ;
+"RTN","C0CENV",186,0)
  D REINDEX^C0CLA7DD
-"RTN","C0CENV",172,0)
- ;
-"RTN","C0CENV",173,0)
- Q
-"RTN","C0CENV",174,0)
- ;
-"RTN","C0CENV",175,0)
- ;
-"RTN","C0CENV",176,0)
-BMES(STR) ; Write BMES^XPDUTL statements
-"RTN","C0CENV",177,0)
- ;
-"RTN","C0CENV",178,0)
- D BMES^XPDUTL($$CJ^XLFSTR(STR,IOM))
-"RTN","C0CENV",179,0)
- ;
-"RTN","C0CENV",180,0)
- Q
-"RTN","C0CENV",181,0)
- ;
-"RTN","C0CENV",182,0)
- ;
-"RTN","C0CENV",183,0)
-LOAD(X) ; load routine X
-"RTN","C0CENV",184,0)
- N %N,DIF,XCNP
-"RTN","C0CENV",185,0)
- K ^TMP($J,X)
-"RTN","C0CENV",186,0)
- S DIF="^TMP($J,X,",XCNP=0
 "RTN","C0CENV",187,0)
- X ^%ZOSF("LOAD")
+ ;
 "RTN","C0CENV",188,0)
  Q
@@ -98462,1683 +98446,1735 @@
  ;
 "RTN","C0CENV",191,0)
-SAVE(OLD,NEW) ; restore routine X
+BMES(STR) ; Write BMES^XPDUTL statements
 "RTN","C0CENV",192,0)
- N %,DIE,X,XCM,XCN,XCS
+ ;
 "RTN","C0CENV",193,0)
- S DIE="^TMP($J,"""_OLD_""",",XCN=0,X=NEW
+ D BMES^XPDUTL($$CJ^XLFSTR(STR,IOM))
 "RTN","C0CENV",194,0)
- X ^%ZOSF("SAVE")
+ ;
 "RTN","C0CENV",195,0)
  Q
+"RTN","C0CENV",196,0)
+ ;
+"RTN","C0CENV",197,0)
+ ;
+"RTN","C0CENV",198,0)
+LOAD(X) ; load routine X
+"RTN","C0CENV",199,0)
+ N %N,DIF,XCNP
+"RTN","C0CENV",200,0)
+ K ^TMP($J,X)
+"RTN","C0CENV",201,0)
+ S DIF="^TMP($J,X,",XCNP=0
+"RTN","C0CENV",202,0)
+ X ^%ZOSF("LOAD")
+"RTN","C0CENV",203,0)
+ Q
+"RTN","C0CENV",204,0)
+ ;
+"RTN","C0CENV",205,0)
+ ;
+"RTN","C0CENV",206,0)
+SAVE(OLD,NEW) ; restore routine X
+"RTN","C0CENV",207,0)
+ N %,DIE,X,XCM,XCN,XCS
+"RTN","C0CENV",208,0)
+ S DIE="^TMP($J,"""_OLD_""",",XCN=0,X=NEW
+"RTN","C0CENV",209,0)
+ X ^%ZOSF("SAVE")
+"RTN","C0CENV",210,0)
+ Q
 "RTN","C0CEVC")
-0^76^B18388545
+0^76^B21455969
 "RTN","C0CEVC",1,0)
 C0CEVC   ; CCDCCR/GPL - SUPPORT FOR EWD VISTCOM PAGES ; 3/1/2010
 "RTN","C0CEVC",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CEVC",3,0)
+ ;
+"RTN","C0CEVC",4,0)
+ ; (C) Geroge Lilly 2010.
+"RTN","C0CEVC",5,0)
+ ;
+"RTN","C0CEVC",6,0)
+ ; This program is free software: you can redistribute it and/or modify
+"RTN","C0CEVC",7,0)
+ ; it under the terms of the GNU Affero General Public License as
+"RTN","C0CEVC",8,0)
+ ; published by the Free Software Foundation, either version 3 of the
+"RTN","C0CEVC",9,0)
+ ; License, or (at your option) any later version.
+"RTN","C0CEVC",10,0)
+ ;
+"RTN","C0CEVC",11,0)
+ ; This program is distributed in the hope that it will be useful,
+"RTN","C0CEVC",12,0)
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","C0CEVC",13,0)
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","C0CEVC",14,0)
+ ; GNU Affero General Public License for more details.
+"RTN","C0CEVC",15,0)
+ ;
+"RTN","C0CEVC",16,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CEVC",17,0)
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+"RTN","C0CEVC",18,0)
+ ;
+"RTN","C0CEVC",19,0)
 gpltest2 ; experiment with sending a CCR to an ewd page
-"RTN","C0CEVC",4,0)
+"RTN","C0CEVC",20,0)
  N ZI
-"RTN","C0CEVC",5,0)
+"RTN","C0CEVC",21,0)
  S ZI=""
-"RTN","C0CEVC",6,0)
+"RTN","C0CEVC",22,0)
  D PSEUDO
-"RTN","C0CEVC",7,0)
+"RTN","C0CEVC",23,0)
  N ZIO
-"RTN","C0CEVC",8,0)
+"RTN","C0CEVC",24,0)
  S ZIO=IO
-"RTN","C0CEVC",9,0)
+"RTN","C0CEVC",25,0)
  S IO="/dev/null"
-"RTN","C0CEVC",10,0)
+"RTN","C0CEVC",26,0)
  OPEN IO
-"RTN","C0CEVC",11,0)
+"RTN","C0CEVC",27,0)
  U IO
-"RTN","C0CEVC",12,0)
+"RTN","C0CEVC",28,0)
  N G
-"RTN","C0CEVC",13,0)
+"RTN","C0CEVC",29,0)
  S G=$$URLTOKEN^C0CEWD
-"RTN","C0CEVC",14,0)
+"RTN","C0CEVC",30,0)
  D CCRRPC^C0CCCR(.GPL,2)
-"RTN","C0CEVC",15,0)
+"RTN","C0CEVC",31,0)
  S IO=ZIO
-"RTN","C0CEVC",16,0)
+"RTN","C0CEVC",32,0)
  OPEN IO
-"RTN","C0CEVC",17,0)
+"RTN","C0CEVC",33,0)
  U IO
-"RTN","C0CEVC",18,0)
+"RTN","C0CEVC",34,0)
  K GPL(0)
-"RTN","C0CEVC",19,0)
+"RTN","C0CEVC",35,0)
  F  S ZI=$O(GPL(ZI)) Q:ZI=""  W GPL(ZI),!
-"RTN","C0CEVC",20,0)
+"RTN","C0CEVC",36,0)
  Q
-"RTN","C0CEVC",21,0)
- ;
-"RTN","C0CEVC",22,0)
+"RTN","C0CEVC",37,0)
+ ;
+"RTN","C0CEVC",38,0)
 gpltest ; experiment with sending a CCR to an ewd page
-"RTN","C0CEVC",23,0)
+"RTN","C0CEVC",39,0)
  N ZI
-"RTN","C0CEVC",24,0)
+"RTN","C0CEVC",40,0)
  S ZI=""
-"RTN","C0CEVC",25,0)
+"RTN","C0CEVC",41,0)
  K ^GPL(0)
-"RTN","C0CEVC",26,0)
+"RTN","C0CEVC",42,0)
  S ^GPL(2)="<?xml-stylesheet type=""text/xsl"" href=""/resources/ccr.xsl""?>"
-"RTN","C0CEVC",27,0)
+"RTN","C0CEVC",43,0)
  F  S ZI=$O(^GPL(ZI)) Q:ZI=""  W ^GPL(ZI),!
-"RTN","C0CEVC",28,0)
+"RTN","C0CEVC",44,0)
  Q
-"RTN","C0CEVC",29,0)
- ;
-"RTN","C0CEVC",30,0)
+"RTN","C0CEVC",45,0)
+ ;
+"RTN","C0CEVC",46,0)
 TEST(sessid); 
-"RTN","C0CEVC",31,0)
+"RTN","C0CEVC",47,0)
  d setSessionValue^%zewdAPI("person.Name","Rob",sessid)
-"RTN","C0CEVC",32,0)
+"RTN","C0CEVC",48,0)
  d setSessionValue^%zewdAPI("person.DateOfBirth","13/06/55",sessid)
-"RTN","C0CEVC",33,0)
+"RTN","C0CEVC",49,0)
  d setSessionValue^%zewdAPI("person.Address.PostCode","SW1 3QA",sessid)
-"RTN","C0CEVC",34,0)
+"RTN","C0CEVC",50,0)
  d setSessionValue^%zewdAPI("person.Address.Line1","1 The Street",sessid)
-"RTN","C0CEVC",35,0)
+"RTN","C0CEVC",51,0)
  d setSessionValue^%zewdAPI("person.Address.2.hello","world",sessid)
-"RTN","C0CEVC",36,0)
+"RTN","C0CEVC",52,0)
  d setJSONValue^%zewdAPI("json","person",sessid)
-"RTN","C0CEVC",37,0)
+"RTN","C0CEVC",53,0)
  Q ""
-"RTN","C0CEVC",38,0)
+"RTN","C0CEVC",54,0)
  
-"RTN","C0CEVC",39,0)
+"RTN","C0CEVC",55,0)
 PARSE(INXML,INDOC) ;CALL THE EWD PARSER ON INXML, PASSED BY NAME
-"RTN","C0CEVC",40,0)
+"RTN","C0CEVC",56,0)
  ; INDOC IS PASSED AS THE DOCUMENT NAME TO EWD
-"RTN","C0CEVC",41,0)
+"RTN","C0CEVC",57,0)
  ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY EWD
-"RTN","C0CEVC",42,0)
+"RTN","C0CEVC",58,0)
  N ZR
-"RTN","C0CEVC",43,0)
+"RTN","C0CEVC",59,0)
  M ^CacheTempEWD($j)=@INXML ;
-"RTN","C0CEVC",44,0)
+"RTN","C0CEVC",60,0)
  S ZR=$$parseDocument^%zewdHTMLParser(INDOC)
-"RTN","C0CEVC",45,0)
+"RTN","C0CEVC",61,0)
  Q ZR
-"RTN","C0CEVC",46,0)
- ;
-"RTN","C0CEVC",47,0)
+"RTN","C0CEVC",62,0)
+ ;
+"RTN","C0CEVC",63,0)
 TEST2(sessid) ; try to put a ccr in the session
-"RTN","C0CEVC",48,0)
+"RTN","C0CEVC",64,0)
  S U="^"
-"RTN","C0CEVC",49,0)
+"RTN","C0CEVC",65,0)
  D PSEUDO ; FAKE LOGIN
-"RTN","C0CEVC",50,0)
+"RTN","C0CEVC",66,0)
  S ZIO=$IO
-"RTN","C0CEVC",51,0)
+"RTN","C0CEVC",67,0)
  S DEV="/dev/null"
-"RTN","C0CEVC",52,0)
+"RTN","C0CEVC",68,0)
  O DEV U DEV
-"RTN","C0CEVC",53,0)
+"RTN","C0CEVC",69,0)
  N G
-"RTN","C0CEVC",54,0)
+"RTN","C0CEVC",70,0)
  N ZDFN
-"RTN","C0CEVC",55,0)
+"RTN","C0CEVC",71,0)
  S ZDFN=$$getSessionValue^%zewdAPI("vista.dfn",sessid)
-"RTN","C0CEVC",56,0)
+"RTN","C0CEVC",72,0)
  I ZDFN="" S ZDFN=2
-"RTN","C0CEVC",57,0)
+"RTN","C0CEVC",73,0)
  ;K ^TMP("GPL")
-"RTN","C0CEVC",58,0)
+"RTN","C0CEVC",74,0)
  ;M ^TMP("GPL")=^%zewdSession("session",sessid)
-"RTN","C0CEVC",59,0)
+"RTN","C0CEVC",75,0)
  D CCRRPC^C0CCCR(.GPL,ZDFN)
-"RTN","C0CEVC",60,0)
+"RTN","C0CEVC",76,0)
  K GPL(0)   
-"RTN","C0CEVC",61,0)
+"RTN","C0CEVC",77,0)
  S GPL(2)="<?xml-stylesheet type=""text/xsl"" href=""/resources/ccr.xsl""?>"
-"RTN","C0CEVC",62,0)
+"RTN","C0CEVC",78,0)
  C DEV U ZIO
-"RTN","C0CEVC",63,0)
+"RTN","C0CEVC",79,0)
  ;M ^CacheTempEWD($j)=GPL
-"RTN","C0CEVC",64,0)
+"RTN","C0CEVC",80,0)
  S DOCNAME="CCR"
-"RTN","C0CEVC",65,0)
+"RTN","C0CEVC",81,0)
  ;ZWR GPL 
-"RTN","C0CEVC",66,0)
+"RTN","C0CEVC",82,0)
  ;S ZR=$$parseDocument^%zewdHTMLParser(DOCNAME)
-"RTN","C0CEVC",67,0)
+"RTN","C0CEVC",83,0)
  ;d setSessionValues^%zewdAPI(DOCNAME,GPL,sessid)
-"RTN","C0CEVC",68,0)
+"RTN","C0CEVC",84,0)
  d mergeArrayToSession^%zewdAPI(.GPL,DOCNAME,sessid)
-"RTN","C0CEVC",69,0)
+"RTN","C0CEVC",85,0)
  Q ""
-"RTN","C0CEVC",70,0)
- ;
-"RTN","C0CEVC",71,0)
+"RTN","C0CEVC",86,0)
+ ;
+"RTN","C0CEVC",87,0)
 INITSES(sessid) ;initialize an EWD/CPRS session
-"RTN","C0CEVC",72,0)
+"RTN","C0CEVC",88,0)
  K ^TMP("GPL")
-"RTN","C0CEVC",73,0)
+"RTN","C0CEVC",89,0)
  ;M ^TMP("GPL")=^%zewdSession("session",sessid)
-"RTN","C0CEVC",74,0)
+"RTN","C0CEVC",90,0)
  N ZT,ZDFN
-"RTN","C0CEVC",75,0)
+"RTN","C0CEVC",91,0)
  S ZT=$$URLTOKEN^C0CEWD(sessid)
-"RTN","C0CEVC",76,0)
+"RTN","C0CEVC",92,0)
  ;S ^TMP("GPL")=ZT
-"RTN","C0CEVC",77,0)
+"RTN","C0CEVC",93,0)
  d trace^%zewdAPI("*********************ZT="_ZT)
-"RTN","C0CEVC",78,0)
+"RTN","C0CEVC",94,0)
  S ZDFN=$$PRSEORTK(ZT) ; PARSE THE TOKEN AND LOOK UP THE DFN
-"RTN","C0CEVC",79,0)
+"RTN","C0CEVC",95,0)
  S ^TMP("GPL","DFN")=ZDFN
-"RTN","C0CEVC",80,0)
+"RTN","C0CEVC",96,0)
  I ZDFN=0 S DFN=2 ; DEFAULT TEST PATIENT
-"RTN","C0CEVC",81,0)
+"RTN","C0CEVC",97,0)
  D setSessionValue^%zewdAPI("vista.dfn",ZDFN,sessid)
-"RTN","C0CEVC",82,0)
+"RTN","C0CEVC",98,0)
  ;M ^TMP("GPL","request")=requestArray
-"RTN","C0CEVC",83,0)
+"RTN","C0CEVC",99,0)
  ;D PSEUDO
-"RTN","C0CEVC",84,0)
+"RTN","C0CEVC",100,0)
  ;D ^%ZTER
-"RTN","C0CEVC",85,0)
+"RTN","C0CEVC",101,0)
  q ""
-"RTN","C0CEVC",86,0)
- ;
-"RTN","C0CEVC",87,0)
+"RTN","C0CEVC",102,0)
+ ;
+"RTN","C0CEVC",103,0)
 PRSEORTK(ZTOKEN) ;PARSES THE TOKEN SENT BY CPRS AND RETURNS THE DFN 
-"RTN","C0CEVC",88,0)
+"RTN","C0CEVC",104,0)
  ; OF THE PATIENT ; HERE'S WHAT THE TOKEN LOOKS LIKE: 
-"RTN","C0CEVC",89,0)
+"RTN","C0CEVC",105,0)
  ; ^TMP('ORWCHART',6547,'192.168.169.8',002E0FE6)
-"RTN","C0CEVC",90,0)
+"RTN","C0CEVC",106,0)
  N ZX,ZN1,ZIP,ZN2,ZDFN,ZG
-"RTN","C0CEVC",91,0)
+"RTN","C0CEVC",107,0)
  S ZDFN=0 ; DEFAULT RETURN
-"RTN","C0CEVC",92,0)
+"RTN","C0CEVC",108,0)
  S ZN1=$P(ZTOKEN,",",2) ; FIRST NUMBER
-"RTN","C0CEVC",93,0)
+"RTN","C0CEVC",109,0)
  S ZIP=$P(ZTOKEN,",",3) ; IP NUMBER
-"RTN","C0CEVC",94,0)
+"RTN","C0CEVC",110,0)
  S ZIP=$P(ZIP,"'",2) ; GET RID OF '
-"RTN","C0CEVC",95,0)
+"RTN","C0CEVC",111,0)
  S ZN2=$P(ZTOKEN,",",4) ; SECOND NUMBER
-"RTN","C0CEVC",96,0)
+"RTN","C0CEVC",112,0)
  S ZN2=$P(ZN2,")",1) ; GET RID OF )
-"RTN","C0CEVC",97,0)
+"RTN","C0CEVC",113,0)
  S ZG=$NA(^TMP("ORWCHART",ZN1,ZIP,ZN2)) ; BUILD THE GLOBAL NAME
-"RTN","C0CEVC",98,0)
+"RTN","C0CEVC",114,0)
  I $G(@ZG)'="" S ZDFN=@ZG ; ACCESS THE GLOBAL
-"RTN","C0CEVC",99,0)
+"RTN","C0CEVC",115,0)
  S ^TMP("GPL","FIRSTDFN")=ZDFN
-"RTN","C0CEVC",100,0)
+"RTN","C0CEVC",116,0)
  S ^TMP("GPL","FIRSTGLB")=ZG
-"RTN","C0CEVC",101,0)
+"RTN","C0CEVC",117,0)
  Q ZDFN
-"RTN","C0CEVC",102,0)
- ;
-"RTN","C0CEVC",103,0)
+"RTN","C0CEVC",118,0)
+ ;
+"RTN","C0CEVC",119,0)
 GETPATIENTLIST(sessid) ;
-"RTN","C0CEVC",104,0)
+"RTN","C0CEVC",120,0)
  D PSEUDO
-"RTN","C0CEVC",105,0)
+"RTN","C0CEVC",121,0)
  D LISTALL^ORWPT(.RTN,"NAME","1")
-"RTN","C0CEVC",106,0)
+"RTN","C0CEVC",122,0)
  N ZI
-"RTN","C0CEVC",107,0)
+"RTN","C0CEVC",123,0)
  S ZI=""
-"RTN","C0CEVC",108,0)
+"RTN","C0CEVC",124,0)
  F  S ZI=$O(RTN(ZI)) Q:ZI=""  D  ;
-"RTN","C0CEVC",109,0)
+"RTN","C0CEVC",125,0)
  . S data(ZI,"DFN")=$P(RTN(ZI),"^",1)
-"RTN","C0CEVC",110,0)
+"RTN","C0CEVC",126,0)
  . S data(ZI,"Name")=$P(RTN(ZI),"^",2)
-"RTN","C0CEVC",111,0)
+"RTN","C0CEVC",127,0)
  ; ZWR data
-"RTN","C0CEVC",112,0)
+"RTN","C0CEVC",128,0)
  ;S data(1,"DFN")=$P(RTN(1),"^",1)
-"RTN","C0CEVC",113,0)
+"RTN","C0CEVC",129,0)
  ;S data(1,"Name")=$P(RTN(1),"^",2)
-"RTN","C0CEVC",114,0)
+"RTN","C0CEVC",130,0)
  d deleteFromSession^%zewdAPI("patients",sessid)
-"RTN","C0CEVC",115,0)
+"RTN","C0CEVC",131,0)
  d createDataTableStore^%zewdYUIRuntime(.data,"patients",sessid)
-"RTN","C0CEVC",116,0)
+"RTN","C0CEVC",132,0)
  ;d mergeArrayToSession^%zewdAPI(.data,"patients",sessid)
-"RTN","C0CEVC",117,0)
+"RTN","C0CEVC",133,0)
  Q ""
-"RTN","C0CEVC",118,0)
- ;
-"RTN","C0CEVC",119,0)
+"RTN","C0CEVC",134,0)
+ ;
+"RTN","C0CEVC",135,0)
 PSEUDO 
-"RTN","C0CEVC",120,0)
+"RTN","C0CEVC",136,0)
  S U="^"
-"RTN","C0CEVC",121,0)
+"RTN","C0CEVC",137,0)
  S DILOCKTM=3
-"RTN","C0CEVC",122,0)
+"RTN","C0CEVC",138,0)
  S DISYS=19
-"RTN","C0CEVC",123,0)
+"RTN","C0CEVC",139,0)
  S DT=3100219
-"RTN","C0CEVC",124,0)
+"RTN","C0CEVC",140,0)
  S DTIME=999
-"RTN","C0CEVC",125,0)
+"RTN","C0CEVC",141,0)
  S DUZ=10
-"RTN","C0CEVC",126,0)
+"RTN","C0CEVC",142,0)
  S DUZ(0)="@"
-"RTN","C0CEVC",127,0)
+"RTN","C0CEVC",143,0)
  S DUZ(1)=""
-"RTN","C0CEVC",128,0)
+"RTN","C0CEVC",144,0)
  S DUZ(2)=1
-"RTN","C0CEVC",129,0)
+"RTN","C0CEVC",145,0)
  S DUZ("AG")="V"
-"RTN","C0CEVC",130,0)
+"RTN","C0CEVC",146,0)
  S DUZ("BUF")=1
-"RTN","C0CEVC",131,0)
+"RTN","C0CEVC",147,0)
  S DUZ("LANG")=""
-"RTN","C0CEVC",132,0)
+"RTN","C0CEVC",148,0)
  ;S IO="/dev/pts/2"
-"RTN","C0CEVC",133,0)
+"RTN","C0CEVC",149,0)
  ;S IO(0)="/dev/pts/2"
-"RTN","C0CEVC",134,0)
+"RTN","C0CEVC",150,0)
  ;S IO(1,"/dev/pts/2")=""
-"RTN","C0CEVC",135,0)
+"RTN","C0CEVC",151,0)
  ;S IO("ERROR")=""
-"RTN","C0CEVC",136,0)
+"RTN","C0CEVC",152,0)
  ;S IO("HOME")="41^/dev/pts/2"
-"RTN","C0CEVC",137,0)
+"RTN","C0CEVC",153,0)
  ;S IO("ZIO")="/dev/pts/2"
-"RTN","C0CEVC",138,0)
+"RTN","C0CEVC",154,0)
  ;S IOBS="$C(8)"
-"RTN","C0CEVC",139,0)
+"RTN","C0CEVC",155,0)
  ;S IOF="#,$C(27,91,50,74,27,91,72)"
-"RTN","C0CEVC",140,0)
+"RTN","C0CEVC",156,0)
  ;S SIOM=80
-"RTN","C0CEVC",141,0)
+"RTN","C0CEVC",157,0)
  Q
-"RTN","C0CEVC",142,0)
- ;
-"RTN","C0CEVC",143,0)
+"RTN","C0CEVC",158,0)
+ ;
+"RTN","C0CEVC",159,0)
 PSEUDO2 ; FAKE LOGIN SETS SOME LOCAL VARIABLE TO FOOL FILEMAN
-"RTN","C0CEVC",144,0)
+"RTN","C0CEVC",160,0)
  S DILOCKTM=3
-"RTN","C0CEVC",145,0)
+"RTN","C0CEVC",161,0)
  S DISYS=19
-"RTN","C0CEVC",146,0)
+"RTN","C0CEVC",162,0)
  S DT=3100112
-"RTN","C0CEVC",147,0)
+"RTN","C0CEVC",163,0)
  S DTIME=9999
-"RTN","C0CEVC",148,0)
+"RTN","C0CEVC",164,0)
  S DUZ=10000000020
-"RTN","C0CEVC",149,0)
+"RTN","C0CEVC",165,0)
  S DUZ(0)="@"
-"RTN","C0CEVC",150,0)
+"RTN","C0CEVC",166,0)
  S DUZ(1)=""
-"RTN","C0CEVC",151,0)
+"RTN","C0CEVC",167,0)
  S DUZ(2)=67
-"RTN","C0CEVC",152,0)
+"RTN","C0CEVC",168,0)
  S DUZ("AG")="E"
-"RTN","C0CEVC",153,0)
+"RTN","C0CEVC",169,0)
  S DUZ("BUF")=1
-"RTN","C0CEVC",154,0)
+"RTN","C0CEVC",170,0)
  S DUZ("LANG")=1
-"RTN","C0CEVC",155,0)
+"RTN","C0CEVC",171,0)
  S IO="/dev/pts/0"
-"RTN","C0CEVC",156,0)
+"RTN","C0CEVC",172,0)
  ;S IO(0)="/dev/pts/0"
-"RTN","C0CEVC",157,0)
+"RTN","C0CEVC",173,0)
  ;S IO(1,"/dev/pts/0")=""
-"RTN","C0CEVC",158,0)
+"RTN","C0CEVC",174,0)
  ;S IO("ERROR")=""
-"RTN","C0CEVC",159,0)
+"RTN","C0CEVC",175,0)
  ;S IO("HOME")="50^/dev/pts/0"
-"RTN","C0CEVC",160,0)
+"RTN","C0CEVC",176,0)
  ;S IO("ZIO")="/dev/pts/0"
-"RTN","C0CEVC",161,0)
+"RTN","C0CEVC",177,0)
  ;S IOBS="$C(8)"
-"RTN","C0CEVC",162,0)
+"RTN","C0CEVC",178,0)
  ;S IOF="!!!!!!!!!!!!!!!!!!!!!!!!,#,$C(27,91,50,74,27,91,72)"
-"RTN","C0CEVC",163,0)
+"RTN","C0CEVC",179,0)
  ;S IOM=80
-"RTN","C0CEVC",164,0)
+"RTN","C0CEVC",180,0)
  ;S ION="GTM/UNIX TELNET"
-"RTN","C0CEVC",165,0)
+"RTN","C0CEVC",181,0)
  ;S IOS=50
-"RTN","C0CEVC",166,0)
+"RTN","C0CEVC",182,0)
  ;S IOSL=24
-"RTN","C0CEVC",167,0)
+"RTN","C0CEVC",183,0)
  ;S IOST="C-VT100"
-"RTN","C0CEVC",168,0)
+"RTN","C0CEVC",184,0)
  ;S IOST(0)=9
-"RTN","C0CEVC",169,0)
+"RTN","C0CEVC",185,0)
  ;S IOT="VTRM"
-"RTN","C0CEVC",170,0)
+"RTN","C0CEVC",186,0)
  ;S IOXY="W $C(27,91)_((DY+1))_$C(59)_((DX+1))_$C(72)"
-"RTN","C0CEVC",171,0)
+"RTN","C0CEVC",187,0)
  S U="^"
-"RTN","C0CEVC",172,0)
+"RTN","C0CEVC",188,0)
  S X="1;DIC(4.2,"
-"RTN","C0CEVC",173,0)
+"RTN","C0CEVC",189,0)
  S XPARSYS="1;DIC(4.2,"
-"RTN","C0CEVC",174,0)
+"RTN","C0CEVC",190,0)
  S XQXFLG="^^XUP"
-"RTN","C0CEVC",175,0)
+"RTN","C0CEVC",191,0)
  S Y="DEV^VISTA^hollywood^VISTA:hollywood"
-"RTN","C0CEVC",176,0)
+"RTN","C0CEVC",192,0)
  Q
-"RTN","C0CEVC",177,0)
+"RTN","C0CEVC",193,0)
  ;
 "RTN","C0CEWD")
-0^77^B5607678
+0^77^B5530676
 "RTN","C0CEWD",1,0)
 C0CEWD   ; CCDCCR/GPL - CCR EWD utilities; 1/6/11
 "RTN","C0CEWD",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CEWD",3,0)
- ;Copyright 2011 George Lilly.  Licensed under the terms of the GNU
+ ;
 "RTN","C0CEWD",4,0)
- ;General Public License See attached copy of the License.
+ ;Copyright 2011 George Lilly.  
 "RTN","C0CEWD",5,0)
  ;
 "RTN","C0CEWD",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CEWD",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CEWD",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CEWD",9,0)
- ;(at your option) any later version.
+ ; License, or (at your option) any later version.
 "RTN","C0CEWD",10,0)
  ;
 "RTN","C0CEWD",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CEWD",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CEWD",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CEWD",14,0)
- ;GNU General Public License for more details.
+ ; GNU Affero General Public License for more details.
 "RTN","C0CEWD",15,0)
  ;
 "RTN","C0CEWD",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CEWD",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CEWD",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
 "RTN","C0CEWD",19,0)
- ;
+ Q
 "RTN","C0CEWD",20,0)
+ ;
+"RTN","C0CEWD",21,0)
+TOKEN() ; EXTRINSIC WHICH RETURNS A NEW RANDOM TOKEN
+"RTN","C0CEWD",22,0)
+ Q $$UUID^C0CUTIL ; USE THE UUID FUNCTION IN THE CCR PACKAGE
+"RTN","C0CEWD",23,0)
+ ;
+"RTN","C0CEWD",24,0)
+STORE(ZARY) ; STORE AN ARRAY OF VALUES INDEXED BY A NEW TOKEN
+"RTN","C0CEWD",25,0)
+ ; IN ^TMP("C0E","TOKEN") FOR LATER RETRIEVAL FROM INSIDE AN EWD SESSION
+"RTN","C0CEWD",26,0)
+ ; RETURNS THE TOKEN. ZARY IS PASSED BY NAME
+"RTN","C0CEWD",27,0)
+ N ZT
+"RTN","C0CEWD",28,0)
+ S ZT=$$TOKEN ; GET A NEW TOKEN
+"RTN","C0CEWD",29,0)
+ M ^TMP("C0E","TOKEN",ZT)=@ZARY ;
+"RTN","C0CEWD",30,0)
+ Q ZT
+"RTN","C0CEWD",31,0)
+ ;
+"RTN","C0CEWD",32,0)
+GET(C0ERTN,C0ETOKEN,NOKILL) ; RETRIEVE A STORED ARRAY INDEXED BY ZTOKEN
+"RTN","C0CEWD",33,0)
+ ; KILL THE ARRAY AFTER RETRIEVAL UNLESS NOKILL=1
+"RTN","C0CEWD",34,0)
+ ; C0ERTN IS PASSED BY NAME
+"RTN","C0CEWD",35,0)
+ I '$D(^TMP("C0E","TOKEN",C0ETOKEN)) D  Q  ; DOESN'T EXIST
+"RTN","C0CEWD",36,0)
+ . S @C0ERTN="" ; PASS BACK NULL
+"RTN","C0CEWD",37,0)
+ M @C0ERTN=^TMP("C0E","TOKEN",C0ETOKEN) ; RETRIEVE
+"RTN","C0CEWD",38,0)
+ I $G(NOKILL)'=1 K ^TMP("C0E","TOKEN",C0ETOKEN) ; DELETE
+"RTN","C0CEWD",39,0)
  Q
-"RTN","C0CEWD",21,0)
- ;
-"RTN","C0CEWD",22,0)
-TOKEN() ; EXTRINSIC WHICH RETURNS A NEW RANDOM TOKEN
-"RTN","C0CEWD",23,0)
- Q $$UUID^C0CUTIL ; USE THE UUID FUNCTION IN THE CCR PACKAGE
-"RTN","C0CEWD",24,0)
- ;
-"RTN","C0CEWD",25,0)
-STORE(ZARY) ; STORE AN ARRAY OF VALUES INDEXED BY A NEW TOKEN
-"RTN","C0CEWD",26,0)
- ; IN ^TMP("C0E","TOKEN") FOR LATER RETRIEVAL FROM INSIDE AN EWD SESSION
-"RTN","C0CEWD",27,0)
- ; RETURNS THE TOKEN. ZARY IS PASSED BY NAME
-"RTN","C0CEWD",28,0)
- N ZT
-"RTN","C0CEWD",29,0)
- S ZT=$$TOKEN ; GET A NEW TOKEN
-"RTN","C0CEWD",30,0)
- M ^TMP("C0E","TOKEN",ZT)=@ZARY ;
-"RTN","C0CEWD",31,0)
- Q ZT
-"RTN","C0CEWD",32,0)
- ;
-"RTN","C0CEWD",33,0)
-GET(C0ERTN,C0ETOKEN,NOKILL) ; RETRIEVE A STORED ARRAY INDEXED BY ZTOKEN
-"RTN","C0CEWD",34,0)
- ; KILL THE ARRAY AFTER RETRIEVAL UNLESS NOKILL=1
-"RTN","C0CEWD",35,0)
- ; C0ERTN IS PASSED BY NAME
-"RTN","C0CEWD",36,0)
- I '$D(^TMP("C0E","TOKEN",C0ETOKEN)) D  Q  ; DOESN'T EXIST
-"RTN","C0CEWD",37,0)
- . S @C0ERTN="" ; PASS BACK NULL
-"RTN","C0CEWD",38,0)
- M @C0ERTN=^TMP("C0E","TOKEN",C0ETOKEN) ; RETRIEVE
-"RTN","C0CEWD",39,0)
- I $G(NOKILL)'=1 K ^TMP("C0E","TOKEN",C0ETOKEN) ; DELETE
 "RTN","C0CEWD",40,0)
- Q
+ ;
 "RTN","C0CEWD",41,0)
- ;
+URLTOKEN(sessid) ; EXTRINSIC WHICH RETRIEVES THE TOKEN PASSED ON THE URL
 "RTN","C0CEWD",42,0)
-URLTOKEN(sessid) ; EXTRINSIC WHICH RETRIEVES THE TOKEN PASSED ON THE URL
+ ; IN EWD EXAMPLE: https://example.com/ewd/myApp/index.ewd?token="12345"
 "RTN","C0CEWD",43,0)
- ; IN EWD EXAMPLE: https://example.com/ewd/myApp/index.ewd?token="12345"
+ N token
 "RTN","C0CEWD",44,0)
- N token
+ S token=""
 "RTN","C0CEWD",45,0)
- S token=""
+ s token=$$getRequestValue^%zewdAPI("token",sessid)
 "RTN","C0CEWD",46,0)
- s token=$$getRequestValue^%zewdAPI("token",sessid)
+ s token=$tr(token,"""") ; strip out quotes
 "RTN","C0CEWD",47,0)
- s token=$tr(token,"""") ; strip out quotes
+ Q token
 "RTN","C0CEWD",48,0)
- Q token
+ ;
 "RTN","C0CEWD",49,0)
- ;
+cbTestMethod(prefix,seedValue,lastSeedValue,optionNo,options) 
 "RTN","C0CEWD",50,0)
-cbTestMethod(prefix,seedValue,lastSeedValue,optionNo,options) 
+ ;
 "RTN","C0CEWD",51,0)
- ;
+ n maxNo,noFound
 "RTN","C0CEWD",52,0)
- n maxNo,noFound
+ ;
 "RTN","C0CEWD",53,0)
- ;
+ s maxNo=50
 "RTN","C0CEWD",54,0)
- s maxNo=50
+ s noFound=0
 "RTN","C0CEWD",55,0)
- s noFound=0
+ f  s seedValue=$o(^DPT("B",seedValue)) q:seedValue=""  q:noFound=maxNo  d
 "RTN","C0CEWD",56,0)
- f  s seedValue=$o(^DPT("B",seedValue)) q:seedValue=""  q:noFound=maxNo  d
+ . s lastSeedValue=seedValue
 "RTN","C0CEWD",57,0)
- . s lastSeedValue=seedValue
+ . i prefix'="",$e(seedValue,1,$l(prefix))'=prefix q
 "RTN","C0CEWD",58,0)
- . i prefix'="",$e(seedValue,1,$l(prefix))'=prefix q
+ . s optionNo=optionNo+1
 "RTN","C0CEWD",59,0)
- . s optionNo=optionNo+1
+ . s noFound=noFound+1
 "RTN","C0CEWD",60,0)
- . s noFound=noFound+1
+ . s options(optionNo)=seedValue
 "RTN","C0CEWD",61,0)
- . s options(optionNo)=seedValue
+ QUIT
 "RTN","C0CEWD",62,0)
- QUIT
+ ;
 "RTN","C0CEWD",63,0)
- ;
+set1 ;
 "RTN","C0CEWD",64,0)
-set1 ;
+ s ^zewd("comboPlus","methodMap","test")="cbTestMethod^C0PEREW"
 "RTN","C0CEWD",65,0)
- s ^zewd("comboPlus","methodMap","test")="cbTestMethod^C0PEREW"
+ q
 "RTN","C0CEWD",66,0)
- q
+ ;
 "RTN","C0CEWD",67,0)
- ;
+test1(sessid) ;
 "RTN","C0CEWD",68,0)
-test1(sessid) ;
+ d setSessionValue^%zewdAPI("testing","ZZ",sessid)
 "RTN","C0CEWD",69,0)
- d setSessionValue^%zewdAPI("testing","ZZ",sessid)
+ q 0
 "RTN","C0CEWD",70,0)
- q 0
-"RTN","C0CEWD",71,0)
  ;
 "RTN","C0CEWD1")
-0^78^B6563070
+0^78^B6276162
 "RTN","C0CEWD1",1,0)
 C0CEWD1   ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
 "RTN","C0CEWD1",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CEWD1",3,0)
- ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
+ ;
 "RTN","C0CEWD1",4,0)
- ;General Public License See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CEWD1",5,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CEWD1",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CEWD1",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CEWD1",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CEWD1",9,0)
- ;(at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CEWD1",10,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CEWD1",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CEWD1",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CEWD1",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CEWD1",14,0)
- ;GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CEWD1",15,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CEWD1",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CEWD1",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ Q
 "RTN","C0CEWD1",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
 "RTN","C0CEWD1",19,0)
- ;
+TEST(filepath) ; filepath IS THE PATH/FILE TO BE READ IN
 "RTN","C0CEWD1",20,0)
- Q
+ i $g(^%ZISH)["" d  ; if the VistA Kernal routine %ZISH exists
 "RTN","C0CEWD1",21,0)
- ;
+ . n zfile,zpath,ztmp s (zfile,zpath,ztmp)=""
 "RTN","C0CEWD1",22,0)
-TEST(filepath) ; filepath IS THE PATH/FILE TO BE READ IN
+ . s zfile=$re($p($re(filepath),"/",1)) ;file name
 "RTN","C0CEWD1",23,0)
- i $g(^%ZISH)["" d  ; if the VistA Kernal routine %ZISH exists
+ . s zpath=$p(filepath,zfile,1) ; file path
 "RTN","C0CEWD1",24,0)
- . n zfile,zpath,ztmp s (zfile,zpath,ztmp)=""
+ . s ztmp=$na(^CacheTempEWD($j,0))
 "RTN","C0CEWD1",25,0)
+ . s ok=$$FTG^%ZISH(zpath,zfile,ztmp,2) ; import the file incrementing subscr 2
+"RTN","C0CEWD1",26,0)
+ q
+"RTN","C0CEWD1",27,0)
+ ;
+"RTN","C0CEWD1",28,0)
+TEST2 ;
+"RTN","C0CEWD1",29,0)
+ s zfilepath="/home/vademo2/CCR/PAT_780_CCR_V1_0_17.xml"
+"RTN","C0CEWD1",30,0)
+ ;s ok=$$gtmImportFile^%zewdHTMLParser(zfilepath)
+"RTN","C0CEWD1",31,0)
+ s ok=$$LOAD(zfilepath) ;load the XML file to the EWD global
+"RTN","C0CEWD1",32,0)
+ s ok=$$parseDocument^%zewdHTMLParser("DerekDOM",0)
+"RTN","C0CEWD1",33,0)
+ ;s ok=$$parseXMLFile^%zewdAPI(zfilepath,"fourthDOM")
+"RTN","C0CEWD1",34,0)
+ w ok,!
+"RTN","C0CEWD1",35,0)
+ q
+"RTN","C0CEWD1",36,0)
+ ;
+"RTN","C0CEWD1",37,0)
+LOAD(filepath) ; load an xml file into the EWD global for DOM processing
+"RTN","C0CEWD1",38,0)
+ ; need to call s error=$$parseDocument^%zewdHTMLParser(docName,isHTML)
+"RTN","C0CEWD1",39,0)
+ ; after to process it to the DOM - isHTML=0 for XML files
+"RTN","C0CEWD1",40,0)
+ n i
+"RTN","C0CEWD1",41,0)
+ i $g(^%ZISH)["" d  QUIT i ; if VistA Kernal routine %ZISH exists - gpl 2/23/09
+"RTN","C0CEWD1",42,0)
+ . n zfile,zpath,ztmp,zok s (zfile,zpath,ztmp)=""
+"RTN","C0CEWD1",43,0)
  . s zfile=$re($p($re(filepath),"/",1)) ;file name
-"RTN","C0CEWD1",26,0)
+"RTN","C0CEWD1",44,0)
  . s zpath=$p(filepath,zfile,1) ; file path
-"RTN","C0CEWD1",27,0)
+"RTN","C0CEWD1",45,0)
  . s ztmp=$na(^CacheTempEWD($j,0))
-"RTN","C0CEWD1",28,0)
- . s ok=$$FTG^%ZISH(zpath,zfile,ztmp,2) ; import the file incrementing subscr 2
-"RTN","C0CEWD1",29,0)
+"RTN","C0CEWD1",46,0)
+ . s zok=$$FTG^%ZISH(zpath,zfile,ztmp,2) ; import the file increment subscr 2
+"RTN","C0CEWD1",47,0)
+ . s i=$o(^CacheTempEWD($j,""),-1) ; highest line number
+"RTN","C0CEWD1",48,0)
+ q i
+"RTN","C0CEWD1",49,0)
+ ;
+"RTN","C0CEWD1",50,0)
+Q(ZQ,ZD) ; SEND QUERY ZQ TO DOM ZD AND DIPLAY NODES RETURNED
+"RTN","C0CEWD1",51,0)
+ I '$D(ZD) S ZD="DerekDOM"
+"RTN","C0CEWD1",52,0)
+ s error=$$select^%zewdXPath(ZQ,ZD,.nodes) ;
+"RTN","C0CEWD1",53,0)
+ d displayNodes^%zewdXPath(.nodes)
+"RTN","C0CEWD1",54,0)
  q
-"RTN","C0CEWD1",30,0)
- ;
-"RTN","C0CEWD1",31,0)
-TEST2 ;
-"RTN","C0CEWD1",32,0)
- s zfilepath="/home/vademo2/CCR/PAT_780_CCR_V1_0_17.xml"
-"RTN","C0CEWD1",33,0)
- ;s ok=$$gtmImportFile^%zewdHTMLParser(zfilepath)
-"RTN","C0CEWD1",34,0)
- s ok=$$LOAD(zfilepath) ;load the XML file to the EWD global
-"RTN","C0CEWD1",35,0)
- s ok=$$parseDocument^%zewdHTMLParser("DerekDOM",0)
-"RTN","C0CEWD1",36,0)
- ;s ok=$$parseXMLFile^%zewdAPI(zfilepath,"fourthDOM")
-"RTN","C0CEWD1",37,0)
- w ok,!
-"RTN","C0CEWD1",38,0)
- q
-"RTN","C0CEWD1",39,0)
- ;
-"RTN","C0CEWD1",40,0)
-LOAD(filepath) ; load an xml file into the EWD global for DOM processing
-"RTN","C0CEWD1",41,0)
- ; need to call s error=$$parseDocument^%zewdHTMLParser(docName,isHTML)
-"RTN","C0CEWD1",42,0)
- ; after to process it to the DOM - isHTML=0 for XML files
-"RTN","C0CEWD1",43,0)
- n i
-"RTN","C0CEWD1",44,0)
- i $g(^%ZISH)["" d  QUIT i ; if VistA Kernal routine %ZISH exists - gpl 2/23/09
-"RTN","C0CEWD1",45,0)
- . n zfile,zpath,ztmp,zok s (zfile,zpath,ztmp)=""
-"RTN","C0CEWD1",46,0)
- . s zfile=$re($p($re(filepath),"/",1)) ;file name
-"RTN","C0CEWD1",47,0)
- . s zpath=$p(filepath,zfile,1) ; file path
-"RTN","C0CEWD1",48,0)
- . s ztmp=$na(^CacheTempEWD($j,0))
-"RTN","C0CEWD1",49,0)
- . s zok=$$FTG^%ZISH(zpath,zfile,ztmp,2) ; import the file increment subscr 2
-"RTN","C0CEWD1",50,0)
- . s i=$o(^CacheTempEWD($j,""),-1) ; highest line number
-"RTN","C0CEWD1",51,0)
- q i
-"RTN","C0CEWD1",52,0)
- ;
-"RTN","C0CEWD1",53,0)
-Q(ZQ,ZD) ; SEND QUERY ZQ TO DOM ZD AND DIPLAY NODES RETURNED
-"RTN","C0CEWD1",54,0)
- I '$D(ZD) S ZD="DerekDOM"
 "RTN","C0CEWD1",55,0)
- s error=$$select^%zewdXPath(ZQ,ZD,.nodes) ;
+ ;
 "RTN","C0CEWD1",56,0)
- d displayNodes^%zewdXPath(.nodes)
+GET1URL0(URL) ;
 "RTN","C0CEWD1",57,0)
- q
+ s ok=$$httpGET^%zewdGTM(URL,.gpl)
 "RTN","C0CEWD1",58,0)
- ;
+ D INDEX^C0CXPATH("gpl","gpl2")
 "RTN","C0CEWD1",59,0)
-GET1URL0(URL) ;
+ W !,"S URL=""",URL,"""",!
 "RTN","C0CEWD1",60,0)
- s ok=$$httpGET^%zewdGTM(URL,.gpl)
+ S G=""
 "RTN","C0CEWD1",61,0)
- D INDEX^C0CXPATH("gpl","gpl2")
+ F  S G=$O(gpl2(G)) Q:G=""  D  ;
 "RTN","C0CEWD1",62,0)
- W !,"S URL=""",URL,"""",!
+ . W " S VDX(""",G,""")=""",gpl2(G),"""",!
 "RTN","C0CEWD1",63,0)
- S G=""
+ W !
 "RTN","C0CEWD1",64,0)
- F  S G=$O(gpl2(G)) Q:G=""  D  ;
-"RTN","C0CEWD1",65,0)
- . W " S VDX(""",G,""")=""",gpl2(G),"""",!
-"RTN","C0CEWD1",66,0)
- W !
-"RTN","C0CEWD1",67,0)
  Q
 "RTN","C0CFM1")
-0^24^B27048099
+0^24^B26826658
 "RTN","C0CFM1",1,0)
 C0CFM1   ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
 "RTN","C0CFM1",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CFM1",3,0)
- ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
+ ;Copyright 2009 George Lilly.  
 "RTN","C0CFM1",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CFM1",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CFM1",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CFM1",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CFM1",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CFM1",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CFM1",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CFM1",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CFM1",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CFM1",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CFM1",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CFM1",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CFM1",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CFM1",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CFM1",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
 "RTN","C0CFM1",19,0)
- ;
+ W "This is the CCR FILEMAN Utility Library ",!
 "RTN","C0CFM1",20,0)
- W "This is the CCR FILEMAN Utility Library ",!
+ W !
 "RTN","C0CFM1",21,0)
- W !
+ Q
 "RTN","C0CFM1",22,0)
+ ;
+"RTN","C0CFM1",23,0)
+PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE
+"RTN","C0CFM1",24,0)
+ ;
+"RTN","C0CFM1",25,0)
+ S C0CGLB=$NA(^TMP("GPLRIM","VARS",DFN))
+"RTN","C0CFM1",26,0)
+ I '$D(ZWHICH) S ZWHICH="ALL"
+"RTN","C0CFM1",27,0)
+ I ZWHICH'="ALL" D  ; SINGLE SECTION REQUESTED
+"RTN","C0CFM1",28,0)
+ . S C0CVARS=$NA(@C0CGLB@(ZWHICH))
+"RTN","C0CFM1",29,0)
+ . D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION
+"RTN","C0CFM1",30,0)
+ E  D  ; MULTIPLE SECTIONS
+"RTN","C0CFM1",31,0)
+ . S C0CVARS=$NA(@C0CGLB)
+"RTN","C0CFM1",32,0)
+ . S C0CI=""
+"RTN","C0CFM1",33,0)
+ . F  S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI=""  D  ;FOR EACH SECTION
+"RTN","C0CFM1",34,0)
+ . . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION
+"RTN","C0CFM1",35,0)
+ . . D PUTRIM1(DFN,C0CI,C0CVARSN)
+"RTN","C0CFM1",36,0)
  Q
-"RTN","C0CFM1",23,0)
- ;
-"RTN","C0CFM1",24,0)
-PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE
-"RTN","C0CFM1",25,0)
- ;
-"RTN","C0CFM1",26,0)
- S C0CGLB=$NA(^TMP("GPLRIM","VARS",DFN))
-"RTN","C0CFM1",27,0)
- I '$D(ZWHICH) S ZWHICH="ALL"
-"RTN","C0CFM1",28,0)
- I ZWHICH'="ALL" D  ; SINGLE SECTION REQUESTED
-"RTN","C0CFM1",29,0)
- . S C0CVARS=$NA(@C0CGLB@(ZWHICH))
-"RTN","C0CFM1",30,0)
- . D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION
-"RTN","C0CFM1",31,0)
- E  D  ; MULTIPLE SECTIONS
-"RTN","C0CFM1",32,0)
- . S C0CVARS=$NA(@C0CGLB)
-"RTN","C0CFM1",33,0)
- . S C0CI=""
-"RTN","C0CFM1",34,0)
- . F  S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI=""  D  ;FOR EACH SECTION
-"RTN","C0CFM1",35,0)
- . . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION
-"RTN","C0CFM1",36,0)
- . . D PUTRIM1(DFN,C0CI,C0CVARSN)
 "RTN","C0CFM1",37,0)
+ ;
+"RTN","C0CFM1",38,0)
+PUTRIM1(DFN,ZZTYP,ZVARS) ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS
+"RTN","C0CFM1",39,0)
+ ; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1"
+"RTN","C0CFM1",40,0)
+ S C0CX=0
+"RTN","C0CFM1",41,0)
+ F  S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX=""  D  ; FOR EACH OCCURANCE
+"RTN","C0CFM1",42,0)
+ . W "ZOCC=",C0CX,!
+"RTN","C0CFM1",43,0)
+ . S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE
+"RTN","C0CFM1",44,0)
+ . D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE
+"RTN","C0CFM1",45,0)
  Q
-"RTN","C0CFM1",38,0)
- ;
-"RTN","C0CFM1",39,0)
-PUTRIM1(DFN,ZZTYP,ZVARS) ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS
-"RTN","C0CFM1",40,0)
- ; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1"
-"RTN","C0CFM1",41,0)
- S C0CX=0
-"RTN","C0CFM1",42,0)
- F  S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX=""  D  ; FOR EACH OCCURANCE
-"RTN","C0CFM1",43,0)
- . W "ZOCC=",C0CX,!
-"RTN","C0CFM1",44,0)
- . S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE
-"RTN","C0CFM1",45,0)
- . D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE
 "RTN","C0CFM1",46,0)
+ ;
+"RTN","C0CFM1",47,0)
+PUTELS(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
+"RTN","C0CFM1",48,0)
+ ; ^C0C(171.201,   DFN IS THE PATIENT IEN PASSED BY VALUE
+"RTN","C0CFM1",49,0)
+ ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
+"RTN","C0CFM1",50,0)
+ ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
+"RTN","C0CFM1",51,0)
+ ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
+"RTN","C0CFM1",52,0)
+ ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
+"RTN","C0CFM1",53,0)
+ ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
+"RTN","C0CFM1",54,0)
+ ;
+"RTN","C0CFM1",55,0)
+ S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1
+"RTN","C0CFM1",56,0)
+ ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
+"RTN","C0CFM1",57,0)
+ N ZF,ZFV S ZF=171.201 S ZFV=171.2012
+"RTN","C0CFM1",58,0)
+ S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS
+"RTN","C0CFM1",59,0)
+ N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER
+"RTN","C0CFM1",60,0)
+ N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
+"RTN","C0CFM1",61,0)
+ W "ZTYPE: ",ZTYPE," ",ZTYPN,!
+"RTN","C0CFM1",62,0)
+ N ZVARN ; IEN OF VARIABLE BEING PROCESSED
+"RTN","C0CFM1",63,0)
+ ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
+"RTN","C0CFM1",64,0)
+ S C0CFDA(ZF,"?+1,",.01)=DFN
+"RTN","C0CFM1",65,0)
+ S C0CFDA(ZF,"?+1,",.02)=ZSRC
+"RTN","C0CFM1",66,0)
+ S C0CFDA(ZF,"?+1,",.03)=ZTYPN
+"RTN","C0CFM1",67,0)
+ S C0CFDA(ZF,"?+1,",.04)=ZOCC ;CREATE OCCURANCE
+"RTN","C0CFM1",68,0)
+ K ZERR
+"RTN","C0CFM1",69,0)
+ D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
+"RTN","C0CFM1",70,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CFM1",71,0)
+ K C0CFDA
+"RTN","C0CFM1",72,0)
+ S ZD0=$O(^C0C(ZF,"C",DFN,ZSRC,ZTYPN,ZOCC,""))
+"RTN","C0CFM1",73,0)
+ W "RECORD NUMBER: ",ZD0,!
+"RTN","C0CFM1",74,0)
+ ;B
+"RTN","C0CFM1",75,0)
+ S ZCNT=0
+"RTN","C0CFM1",76,0)
+ S ZC0CI="" ;
+"RTN","C0CFM1",77,0)
+ F  S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI=""  D  ;
+"RTN","C0CFM1",78,0)
+ . I ZC0CI'="M" D  ; NOT A SUBVARIABLE
+"RTN","C0CFM1",79,0)
+ . . S ZCNT=ZCNT+1 ;INCREMENT COUNT
+"RTN","C0CFM1",80,0)
+ . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
+"RTN","C0CFM1",81,0)
+ . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
+"RTN","C0CFM1",82,0)
+ . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN
+"RTN","C0CFM1",83,0)
+ . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI)
+"RTN","C0CFM1",84,0)
+ . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN
+"RTN","C0CFM1",85,0)
+ . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI)
+"RTN","C0CFM1",86,0)
+ ;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT"
+"RTN","C0CFM1",87,0)
+ ;S GT1(170,"?+1,",12)="DIR"
+"RTN","C0CFM1",88,0)
+ ;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT"
+"RTN","C0CFM1",89,0)
+ ;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
+"RTN","C0CFM1",90,0)
+ D CLEAN^DILF
+"RTN","C0CFM1",91,0)
+ D UPDATE^DIE("","C0CFDA","","ZERR")
+"RTN","C0CFM1",92,0)
  Q
-"RTN","C0CFM1",47,0)
- ;
-"RTN","C0CFM1",48,0)
-PUTELS(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
-"RTN","C0CFM1",49,0)
- ; ^C0C(171.201,   DFN IS THE PATIENT IEN PASSED BY VALUE
-"RTN","C0CFM1",50,0)
- ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
-"RTN","C0CFM1",51,0)
- ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
-"RTN","C0CFM1",52,0)
- ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
-"RTN","C0CFM1",53,0)
- ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
-"RTN","C0CFM1",54,0)
- ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
-"RTN","C0CFM1",55,0)
- ;
-"RTN","C0CFM1",56,0)
- S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1
-"RTN","C0CFM1",57,0)
- ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
-"RTN","C0CFM1",58,0)
- N ZF,ZFV S ZF=171.201 S ZFV=171.2012
-"RTN","C0CFM1",59,0)
- S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS
-"RTN","C0CFM1",60,0)
- N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER
-"RTN","C0CFM1",61,0)
- N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
-"RTN","C0CFM1",62,0)
- W "ZTYPE: ",ZTYPE," ",ZTYPN,!
-"RTN","C0CFM1",63,0)
- N ZVARN ; IEN OF VARIABLE BEING PROCESSED
-"RTN","C0CFM1",64,0)
- ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
-"RTN","C0CFM1",65,0)
- S C0CFDA(ZF,"?+1,",.01)=DFN
-"RTN","C0CFM1",66,0)
- S C0CFDA(ZF,"?+1,",.02)=ZSRC
-"RTN","C0CFM1",67,0)
- S C0CFDA(ZF,"?+1,",.03)=ZTYPN
-"RTN","C0CFM1",68,0)
- S C0CFDA(ZF,"?+1,",.04)=ZOCC ;CREATE OCCURANCE
-"RTN","C0CFM1",69,0)
- K ZERR
-"RTN","C0CFM1",70,0)
- D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
-"RTN","C0CFM1",71,0)
- I $D(ZERR) B  ;OOPS
-"RTN","C0CFM1",72,0)
- K C0CFDA
-"RTN","C0CFM1",73,0)
- S ZD0=$O(^C0C(ZF,"C",DFN,ZSRC,ZTYPN,ZOCC,""))
-"RTN","C0CFM1",74,0)
- W "RECORD NUMBER: ",ZD0,!
-"RTN","C0CFM1",75,0)
- ;B
-"RTN","C0CFM1",76,0)
- S ZCNT=0
-"RTN","C0CFM1",77,0)
- S ZC0CI="" ;
-"RTN","C0CFM1",78,0)
- F  S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI=""  D  ;
-"RTN","C0CFM1",79,0)
- . I ZC0CI'="M" D  ; NOT A SUBVARIABLE
-"RTN","C0CFM1",80,0)
- . . S ZCNT=ZCNT+1 ;INCREMENT COUNT
-"RTN","C0CFM1",81,0)
- . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
-"RTN","C0CFM1",82,0)
- . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
-"RTN","C0CFM1",83,0)
- . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN
-"RTN","C0CFM1",84,0)
- . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI)
-"RTN","C0CFM1",85,0)
- . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN
-"RTN","C0CFM1",86,0)
- . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI)
-"RTN","C0CFM1",87,0)
- ;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT"
-"RTN","C0CFM1",88,0)
- ;S GT1(170,"?+1,",12)="DIR"
-"RTN","C0CFM1",89,0)
- ;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT"
-"RTN","C0CFM1",90,0)
- ;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
-"RTN","C0CFM1",91,0)
- D CLEAN^DILF
-"RTN","C0CFM1",92,0)
- D UPDATE^DIE("","C0CFDA","","ZERR")
 "RTN","C0CFM1",93,0)
+ ;
+"RTN","C0CFM1",94,0)
+VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
+"RTN","C0CFM1",95,0)
+ ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
+"RTN","C0CFM1",96,0)
+ ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
+"RTN","C0CFM1",97,0)
+ ;
+"RTN","C0CFM1",98,0)
+ N ZCCRD,ZVARN,C0CFDA2
+"RTN","C0CFM1",99,0)
+ S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
+"RTN","C0CFM1",100,0)
+ S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
+"RTN","C0CFM1",101,0)
+ I ZVARN="" D  ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
+"RTN","C0CFM1",102,0)
+ . I '$D(ZTYP) D  Q  ; WON'T ADD A VARIABLE WITHOUT A TYPE
+"RTN","C0CFM1",103,0)
+ . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
+"RTN","C0CFM1",104,0)
+ . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
+"RTN","C0CFM1",105,0)
+ . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
+"RTN","C0CFM1",106,0)
+ . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
+"RTN","C0CFM1",107,0)
+ . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
+"RTN","C0CFM1",108,0)
+ . I $D(ZERR) D  ; LAYGO ERROR
+"RTN","C0CFM1",109,0)
+ . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
+"RTN","C0CFM1",110,0)
+ . E  D  ;
+"RTN","C0CFM1",111,0)
+ . . D CLEAN^DILF ; CLEAN UP
+"RTN","C0CFM1",112,0)
+ . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
+"RTN","C0CFM1",113,0)
+ . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
+"RTN","C0CFM1",114,0)
+ Q ZVARN
+"RTN","C0CFM1",115,0)
+ ;
+"RTN","C0CFM1",116,0)
+BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,)
+"RTN","C0CFM1",117,0)
+ ; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED
+"RTN","C0CFM1",118,0)
+ ;
+"RTN","C0CFM1",119,0)
+ N C0CDIC,C0CNODE ;
+"RTN","C0CFM1",120,0)
+ S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY
+"RTN","C0CFM1",121,0)
+ S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE
+"RTN","C0CFM1",122,0)
  Q
-"RTN","C0CFM1",94,0)
- ;
-"RTN","C0CFM1",95,0)
-VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
-"RTN","C0CFM1",96,0)
- ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
-"RTN","C0CFM1",97,0)
- ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
-"RTN","C0CFM1",98,0)
- ;
-"RTN","C0CFM1",99,0)
- N ZCCRD,ZVARN,C0CFDA2
-"RTN","C0CFM1",100,0)
- S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
-"RTN","C0CFM1",101,0)
- S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
-"RTN","C0CFM1",102,0)
- I ZVARN="" D  ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
-"RTN","C0CFM1",103,0)
- . I '$D(ZTYP) D  Q  ; WON'T ADD A VARIABLE WITHOUT A TYPE
-"RTN","C0CFM1",104,0)
- . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
-"RTN","C0CFM1",105,0)
- . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
-"RTN","C0CFM1",106,0)
- . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
-"RTN","C0CFM1",107,0)
- . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
-"RTN","C0CFM1",108,0)
- . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
-"RTN","C0CFM1",109,0)
- . I $D(ZERR) D  ; LAYGO ERROR
-"RTN","C0CFM1",110,0)
- . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
-"RTN","C0CFM1",111,0)
- . E  D  ;
-"RTN","C0CFM1",112,0)
- . . D CLEAN^DILF ; CLEAN UP
-"RTN","C0CFM1",113,0)
- . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
-"RTN","C0CFM1",114,0)
- . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
-"RTN","C0CFM1",115,0)
- Q ZVARN
-"RTN","C0CFM1",116,0)
- ;
-"RTN","C0CFM1",117,0)
-BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,)
-"RTN","C0CFM1",118,0)
- ; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED
-"RTN","C0CFM1",119,0)
- ;
-"RTN","C0CFM1",120,0)
- N C0CDIC,C0CNODE ;
-"RTN","C0CFM1",121,0)
- S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY
-"RTN","C0CFM1",122,0)
- S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE
 "RTN","C0CFM1",123,0)
+ ;
+"RTN","C0CFM1",124,0)
+FIXSEC ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED
+"RTN","C0CFM1",125,0)
+ ; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET
+"RTN","C0CFM1",126,0)
+ ; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS
+"RTN","C0CFM1",127,0)
+ ; CONVERSION
+"RTN","C0CFM1",128,0)
+ ;N C0CC,C0CI,C0CJ,C0CN,C0CZX
+"RTN","C0CFM1",129,0)
+ D FIELDS^C0CRNF("C0CC",170)
+"RTN","C0CFM1",130,0)
+ S C0CI=""
+"RTN","C0CFM1",131,0)
+ F  S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI=""  D  ; EACH SECTION
+"RTN","C0CFM1",132,0)
+ . S C0CZX=""
+"RTN","C0CFM1",133,0)
+ . F  S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX=""  D  ; EACH VARIABLE
+"RTN","C0CFM1",134,0)
+ . . W "SECTION ",C0CI," VAR ",C0CZX
+"RTN","C0CFM1",135,0)
+ . . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,""))
+"RTN","C0CFM1",136,0)
+ . . W " TYPE: ",C0CV,!
+"RTN","C0CFM1",137,0)
+ . . D SETFDA("SECTION",C0CV)
+"RTN","C0CFM1",138,0)
+ . . ;ZWR C0CFDA
+"RTN","C0CFM1",139,0)
  Q
-"RTN","C0CFM1",124,0)
- ;
-"RTN","C0CFM1",125,0)
-FIXSEC ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED
-"RTN","C0CFM1",126,0)
- ; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET
-"RTN","C0CFM1",127,0)
- ; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS
-"RTN","C0CFM1",128,0)
- ; CONVERSION
-"RTN","C0CFM1",129,0)
- ;N C0CC,C0CI,C0CJ,C0CN,C0CZX
-"RTN","C0CFM1",130,0)
- D FIELDS^C0CRNF("C0CC",170)
-"RTN","C0CFM1",131,0)
- S C0CI=""
-"RTN","C0CFM1",132,0)
- F  S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI=""  D  ; EACH SECTION
-"RTN","C0CFM1",133,0)
- . S C0CZX=""
-"RTN","C0CFM1",134,0)
- . F  S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX=""  D  ; EACH VARIABLE
-"RTN","C0CFM1",135,0)
- . . W "SECTION ",C0CI," VAR ",C0CZX
-"RTN","C0CFM1",136,0)
- . . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,""))
-"RTN","C0CFM1",137,0)
- . . W " TYPE: ",C0CV,!
-"RTN","C0CFM1",138,0)
- . . D SETFDA("SECTION",C0CV)
-"RTN","C0CFM1",139,0)
- . . ;ZWR C0CFDA
 "RTN","C0CFM1",140,0)
+ ;
+"RTN","C0CFM1",141,0)
+SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
+"RTN","C0CFM1",142,0)
+ ; TO SET TO VALUE C0CSV.
+"RTN","C0CFM1",143,0)
+ ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
+"RTN","C0CFM1",144,0)
+ ; C0CSN,C0CSV ARE PASSED BY VALUE
+"RTN","C0CFM1",145,0)
+ ;
+"RTN","C0CFM1",146,0)
+ N C0CSI,C0CSJ
+"RTN","C0CFM1",147,0)
+ S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
+"RTN","C0CFM1",148,0)
+ S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
+"RTN","C0CFM1",149,0)
+ S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
+"RTN","C0CFM1",150,0)
  Q
-"RTN","C0CFM1",141,0)
- ;
-"RTN","C0CFM1",142,0)
-SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
-"RTN","C0CFM1",143,0)
- ; TO SET TO VALUE C0CSV.
-"RTN","C0CFM1",144,0)
- ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
-"RTN","C0CFM1",145,0)
- ; C0CSN,C0CSV ARE PASSED BY VALUE
-"RTN","C0CFM1",146,0)
- ;
-"RTN","C0CFM1",147,0)
- N C0CSI,C0CSJ
-"RTN","C0CFM1",148,0)
- S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
-"RTN","C0CFM1",149,0)
- S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
-"RTN","C0CFM1",150,0)
- S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
 "RTN","C0CFM1",151,0)
- Q
+ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
 "RTN","C0CFM1",152,0)
-ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
 "RTN","C0CFM1",153,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
+ ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
 "RTN","C0CFM1",154,0)
+ I '$D(ZTAB) S ZTAB="C0CA"
+"RTN","C0CFM1",155,0)
+ N ZR
+"RTN","C0CFM1",156,0)
+ I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
+"RTN","C0CFM1",157,0)
+ E  S ZR=""
+"RTN","C0CFM1",158,0)
+ Q ZR
+"RTN","C0CFM1",159,0)
+ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
+"RTN","C0CFM1",160,0)
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
+"RTN","C0CFM1",161,0)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CFM1",155,0)
+"RTN","C0CFM1",162,0)
  I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CFM1",156,0)
+"RTN","C0CFM1",163,0)
  N ZR
-"RTN","C0CFM1",157,0)
- I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
-"RTN","C0CFM1",158,0)
+"RTN","C0CFM1",164,0)
+ I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
+"RTN","C0CFM1",165,0)
  E  S ZR=""
-"RTN","C0CFM1",159,0)
+"RTN","C0CFM1",166,0)
  Q ZR
-"RTN","C0CFM1",160,0)
-ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
-"RTN","C0CFM1",161,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
-"RTN","C0CFM1",162,0)
+"RTN","C0CFM1",167,0)
+ ;
+"RTN","C0CFM1",168,0)
+ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
+"RTN","C0CFM1",169,0)
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
+"RTN","C0CFM1",170,0)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CFM1",163,0)
+"RTN","C0CFM1",171,0)
  I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CFM1",164,0)
+"RTN","C0CFM1",172,0)
  N ZR
-"RTN","C0CFM1",165,0)
- I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
-"RTN","C0CFM1",166,0)
+"RTN","C0CFM1",173,0)
+ I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
+"RTN","C0CFM1",174,0)
  E  S ZR=""
-"RTN","C0CFM1",167,0)
+"RTN","C0CFM1",175,0)
  Q ZR
-"RTN","C0CFM1",168,0)
- ;
-"RTN","C0CFM1",169,0)
-ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
-"RTN","C0CFM1",170,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
-"RTN","C0CFM1",171,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CFM1",172,0)
- I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CFM1",173,0)
- N ZR
-"RTN","C0CFM1",174,0)
- I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
-"RTN","C0CFM1",175,0)
- E  S ZR=""
 "RTN","C0CFM1",176,0)
- Q ZR
-"RTN","C0CFM1",177,0)
  ;
 "RTN","C0CFM2")
-0^31^B102195978
+0^31^B99587435
 "RTN","C0CFM2",1,0)
 C0CFM2   ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
 "RTN","C0CFM2",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CFM2",3,0)
- ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
+ ;Copyright 2009 George Lilly.  
 "RTN","C0CFM2",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CFM2",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CFM2",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CFM2",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CFM2",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CFM2",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CFM2",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CFM2",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CFM2",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CFM2",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CFM2",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CFM2",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CFM2",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CFM2",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CFM2",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
 "RTN","C0CFM2",19,0)
- ;
+ W "This is the CCR FILEMAN Utility Library ",!
 "RTN","C0CFM2",20,0)
- W "This is the CCR FILEMAN Utility Library ",!
+ ; THIS SET OF ROUTINES USE CCR E2 (^C0CE(, FILE 171.101) INSTEAD OF
 "RTN","C0CFM2",21,0)
- ; THIS SET OF ROUTINES USE CCR E2 (^C0CE(, FILE 171.101) INSTEAD OF
+ ; CCR ELEMENTS (^C0C(179.201,
 "RTN","C0CFM2",22,0)
- ; CCR ELEMENTS (^C0C(179.201,
+ ; E2 IS A SIMPLIFICATION OF CCR ELEMENTS WHERE SUB-ELEMENTS ARE
 "RTN","C0CFM2",23,0)
- ; E2 IS A SIMPLIFICATION OF CCR ELEMENTS WHERE SUB-ELEMENTS ARE
+ ; AT THE TOP LEVEL. OCCURANCE, THE 4TH PART OF THE KEY IS NOW FREE TEXT
 "RTN","C0CFM2",24,0)
- ; AT THE TOP LEVEL. OCCURANCE, THE 4TH PART OF THE KEY IS NOW FREE TEXT
+ ; AND HAS THE FORM X;Y FOR SUB-ELEMENTS
 "RTN","C0CFM2",25,0)
- ; AND HAS THE FORM X;Y FOR SUB-ELEMENTS
+ ; ALL SUB-VARIABLES HAVE BEEN REMOVED
 "RTN","C0CFM2",26,0)
- ; ALL SUB-VARIABLES HAVE BEEN REMOVED
+ W !
 "RTN","C0CFM2",27,0)
- W !
+ Q
 "RTN","C0CFM2",28,0)
+ ;
+"RTN","C0CFM2",29,0)
+RIMTBL(ZWHICH) ; PUT ALL PATIENT IN RIMTBL ZWHICH INTO THE CCR ELEMENTS FILE
+"RTN","C0CFM2",30,0)
+ ;
+"RTN","C0CFM2",31,0)
+ I '$D(RIMBASE) D ASETUP^C0CRIMA ; FOR COMMAND LINE CALLS
+"RTN","C0CFM2",32,0)
+ N ZI,ZJ,ZC,ZPATBASE
+"RTN","C0CFM2",33,0)
+ S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",ZWHICH))
+"RTN","C0CFM2",34,0)
+ S ZI=""
+"RTN","C0CFM2",35,0)
+ F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
+"RTN","C0CFM2",36,0)
+ . S ZI=$O(@ZPATBASE@(ZI))
+"RTN","C0CFM2",37,0)
+ . D PUTRIM(ZI) ; EXPORT THE PATIENT TO A FILE
+"RTN","C0CFM2",38,0)
  Q
-"RTN","C0CFM2",29,0)
- ;
-"RTN","C0CFM2",30,0)
-RIMTBL(ZWHICH) ; PUT ALL PATIENT IN RIMTBL ZWHICH INTO THE CCR ELEMENTS FILE
-"RTN","C0CFM2",31,0)
- ;
-"RTN","C0CFM2",32,0)
- I '$D(RIMBASE) D ASETUP^C0CRIMA ; FOR COMMAND LINE CALLS
-"RTN","C0CFM2",33,0)
- N ZI,ZJ,ZC,ZPATBASE
-"RTN","C0CFM2",34,0)
- S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",ZWHICH))
-"RTN","C0CFM2",35,0)
- S ZI=""
-"RTN","C0CFM2",36,0)
- F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
-"RTN","C0CFM2",37,0)
- . S ZI=$O(@ZPATBASE@(ZI))
-"RTN","C0CFM2",38,0)
- . D PUTRIM(ZI) ; EXPORT THE PATIENT TO A FILE
 "RTN","C0CFM2",39,0)
+ ;
+"RTN","C0CFM2",40,0)
+PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE
+"RTN","C0CFM2",41,0)
+ ;
+"RTN","C0CFM2",42,0)
+ S C0CGLB=$NA(^TMP("C0CRIM","VARS",DFN))
+"RTN","C0CFM2",43,0)
+ I '$D(ZWHICH) S ZWHICH="ALL"
+"RTN","C0CFM2",44,0)
+ I ZWHICH'="ALL" D  ; SINGLE SECTION REQUESTED
+"RTN","C0CFM2",45,0)
+ . S C0CVARS=$NA(@C0CGLB@(ZWHICH))
+"RTN","C0CFM2",46,0)
+ . D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION
+"RTN","C0CFM2",47,0)
+ E  D  ; MULTIPLE SECTIONS
+"RTN","C0CFM2",48,0)
+ . S C0CVARS=$NA(@C0CGLB)
+"RTN","C0CFM2",49,0)
+ . S C0CI=""
+"RTN","C0CFM2",50,0)
+ . F  S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI=""  D  ;FOR EACH SECTION
+"RTN","C0CFM2",51,0)
+ . . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION
+"RTN","C0CFM2",52,0)
+ . . D PUTRIM1(DFN,C0CI,C0CVARSN)
+"RTN","C0CFM2",53,0)
  Q
-"RTN","C0CFM2",40,0)
- ;
-"RTN","C0CFM2",41,0)
-PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE
-"RTN","C0CFM2",42,0)
- ;
-"RTN","C0CFM2",43,0)
- S C0CGLB=$NA(^TMP("C0CRIM","VARS",DFN))
-"RTN","C0CFM2",44,0)
- I '$D(ZWHICH) S ZWHICH="ALL"
-"RTN","C0CFM2",45,0)
- I ZWHICH'="ALL" D  ; SINGLE SECTION REQUESTED
-"RTN","C0CFM2",46,0)
- . S C0CVARS=$NA(@C0CGLB@(ZWHICH))
-"RTN","C0CFM2",47,0)
- . D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION
-"RTN","C0CFM2",48,0)
- E  D  ; MULTIPLE SECTIONS
-"RTN","C0CFM2",49,0)
- . S C0CVARS=$NA(@C0CGLB)
-"RTN","C0CFM2",50,0)
- . S C0CI=""
-"RTN","C0CFM2",51,0)
- . F  S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI=""  D  ;FOR EACH SECTION
-"RTN","C0CFM2",52,0)
- . . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION
-"RTN","C0CFM2",53,0)
- . . D PUTRIM1(DFN,C0CI,C0CVARSN)
 "RTN","C0CFM2",54,0)
+ ;
+"RTN","C0CFM2",55,0)
+PUTRIM1(DFN,ZZTYP,ZVARS) ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS
+"RTN","C0CFM2",56,0)
+ ; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1"
+"RTN","C0CFM2",57,0)
+ S C0CX=0
+"RTN","C0CFM2",58,0)
+ F  S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX=""  D  ; FOR EACH OCCURANCE
+"RTN","C0CFM2",59,0)
+ . W "ZOCC=",C0CX,!
+"RTN","C0CFM2",60,0)
+ . K C0CMDO ; MULTIPLE SUBELEMENTS FOR THIS OCCURANCE PASSED BY NAME
+"RTN","C0CFM2",61,0)
+ . S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE
+"RTN","C0CFM2",62,0)
+ . D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE
+"RTN","C0CFM2",63,0)
+ . I $D(C0CMDO) D  ; MULTIPLES TO HANDLE (THIS IS INSTEAD OF RECURSION :()
+"RTN","C0CFM2",64,0)
+ . . N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
+"RTN","C0CFM2",65,0)
+ . . S ZZCNT=0
+"RTN","C0CFM2",66,0)
+ . . S ZZC0CI=0
+"RTN","C0CFM2",67,0)
+ . . S ZZVALS=$NA(@C0CMDO@("M")) ; LOCATION OF THIS MULTILPE
+"RTN","C0CFM2",68,0)
+ . . S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
+"RTN","C0CFM2",69,0)
+ . . S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
+"RTN","C0CFM2",70,0)
+ . . W "MULTIPLE:",ZZVALS,!
+"RTN","C0CFM2",71,0)
+ . . ;B
+"RTN","C0CFM2",72,0)
+ . . F  S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI=""  D  ; EACH MULTIPLE
+"RTN","C0CFM2",73,0)
+ . . . S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
+"RTN","C0CFM2",74,0)
+ . . . W "COUNT:",ZZCNT,!
+"RTN","C0CFM2",75,0)
+ . . . S ZV=$NA(@ZZVALS@(ZZC0CI))
+"RTN","C0CFM2",76,0)
+ . . . D PUTELS(DFN,ZT,C0CX_";"_ZZCNT,ZV)
+"RTN","C0CFM2",77,0)
  Q
-"RTN","C0CFM2",55,0)
- ;
-"RTN","C0CFM2",56,0)
-PUTRIM1(DFN,ZZTYP,ZVARS) ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS
-"RTN","C0CFM2",57,0)
- ; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1"
-"RTN","C0CFM2",58,0)
- S C0CX=0
-"RTN","C0CFM2",59,0)
- F  S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX=""  D  ; FOR EACH OCCURANCE
-"RTN","C0CFM2",60,0)
- . W "ZOCC=",C0CX,!
-"RTN","C0CFM2",61,0)
- . K C0CMDO ; MULTIPLE SUBELEMENTS FOR THIS OCCURANCE PASSED BY NAME
-"RTN","C0CFM2",62,0)
- . S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE
-"RTN","C0CFM2",63,0)
- . D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE
-"RTN","C0CFM2",64,0)
- . I $D(C0CMDO) D  ; MULTIPLES TO HANDLE (THIS IS INSTEAD OF RECURSION :()
-"RTN","C0CFM2",65,0)
- . . N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
-"RTN","C0CFM2",66,0)
- . . S ZZCNT=0
-"RTN","C0CFM2",67,0)
- . . S ZZC0CI=0
-"RTN","C0CFM2",68,0)
- . . S ZZVALS=$NA(@C0CMDO@("M")) ; LOCATION OF THIS MULTILPE
-"RTN","C0CFM2",69,0)
- . . S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
-"RTN","C0CFM2",70,0)
- . . S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
-"RTN","C0CFM2",71,0)
- . . W "MULTIPLE:",ZZVALS,!
-"RTN","C0CFM2",72,0)
+"RTN","C0CFM2",78,0)
+ ;
+"RTN","C0CFM2",79,0)
+PUTELS(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
+"RTN","C0CFM2",80,0)
+ ; 171.101, ^C0CE  DFN IS THE PATIENT IEN PASSED BY VALUE
+"RTN","C0CFM2",81,0)
+ ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
+"RTN","C0CFM2",82,0)
+ ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
+"RTN","C0CFM2",83,0)
+ ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
+"RTN","C0CFM2",84,0)
+ ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
+"RTN","C0CFM2",85,0)
+ ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
+"RTN","C0CFM2",86,0)
+ ;
+"RTN","C0CFM2",87,0)
+ N PATN,ZTYPN,XD0,ZTYP
+"RTN","C0CFM2",88,0)
+ I '$D(ZSRC) S ZSRC=1 ; CCR SOURCE IS ASSUMED, 1 IF NOT SET
+"RTN","C0CFM2",89,0)
+ ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
+"RTN","C0CFM2",90,0)
+ N C0CFPAT S C0CFPAT=171.101 ; FILE AT PATIENT LEVEL
+"RTN","C0CFM2",91,0)
+ N C0CFSRC S C0CFSRC=171.111 ; FILE AT CCR SOURCE LVL
+"RTN","C0CFM2",92,0)
+ N C0CFTYP S C0CFTYP=171.121 ; FILE AT ELEMENT TYPE LVL
+"RTN","C0CFM2",93,0)
+ N C0CFOCC S C0CFOCC=171.131 ; FILE AT OCCURANCE LVL
+"RTN","C0CFM2",94,0)
+ N C0CFVAR S C0CFVAR=171.1311 ; FILE AT VARIABLE LVL
+"RTN","C0CFM2",95,0)
+ ;FILE IS ^C0CE(PAT,1,SCR,1,TYP,1,OCC,1,VAR,1, ...
+"RTN","C0CFM2",96,0)
+ ; AND WE HAVE TO ADD THEM LEVEL AT A TIME I THINK
+"RTN","C0CFM2",97,0)
+ N C0CFDA
+"RTN","C0CFM2",98,0)
+ S C0CFDA(C0CFPAT,"?+1,",.01)=DFN
+"RTN","C0CFM2",99,0)
+ D UPDIE ; ADD THE PATIENT
+"RTN","C0CFM2",100,0)
+ S PATN=$O(^C0CE("B",DFN,"")) ; IEN FOR THE PATIENT
+"RTN","C0CFM2",101,0)
+ S C0CFDA(C0CFSRC,"?+1,"_PATN_",",.01)=ZSRC
+"RTN","C0CFM2",102,0)
+ D UPDIE ; ADD THE CCR SOURCE
+"RTN","C0CFM2",103,0)
+ N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,"")) ; FIND THE ELE TYPE
+"RTN","C0CFM2",104,0)
+ S C0CFDA(C0CFTYP,"?+1,"_ZSRC_","_PATN_",",.01)=ZTYPN
+"RTN","C0CFM2",105,0)
+ D UPDIE ; ADD THE ELEMENT TYPE
+"RTN","C0CFM2",106,0)
+ S ZTYP=$O(^C0CE(PATN,1,ZSRC,1,"B",ZTYPN,"")) ; IEN OF ELEMENT TYPE
+"RTN","C0CFM2",107,0)
+ S C0CFDA(C0CFOCC,"?+1,"_ZTYP_","_ZSRC_","_PATN_",",.01)=ZOCC ; STRING OCC
+"RTN","C0CFM2",108,0)
+ ; OCC IS PRECEDED BY " " TO FORCE STRING STORAGE AND PRESERVE
+"RTN","C0CFM2",109,0)
+ ; STRING COLLATION ON THE INDEX
+"RTN","C0CFM2",110,0)
+ D UPDIE ; ADD THE OCCURANCE
+"RTN","C0CFM2",111,0)
+ S ZD0=$O(^C0CE(PATN,1,ZSRC,1,ZTYP,1,"B",ZOCC,""))
+"RTN","C0CFM2",112,0)
+ W "RECORD NUMBER: ",ZD0,!
+"RTN","C0CFM2",113,0)
+ ;I ZD0=32 B
+"RTN","C0CFM2",114,0)
+ ;I ZD0=31 B
+"RTN","C0CFM2",115,0)
+ N ZCNT,ZC0CI,ZVARN,C0CZ1
+"RTN","C0CFM2",116,0)
+ S ZCNT=0
+"RTN","C0CFM2",117,0)
+ S ZC0CI="" ;
+"RTN","C0CFM2",118,0)
+ F  S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI=""  D  ;
+"RTN","C0CFM2",119,0)
+ . I ZC0CI'="M" D  ; NOT A SUBVARIABLE
+"RTN","C0CFM2",120,0)
+ . . S ZCNT=ZCNT+1 ;INCREMENT COUNT
+"RTN","C0CFM2",121,0)
+ . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
+"RTN","C0CFM2",122,0)
+ . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
+"RTN","C0CFM2",123,0)
+ . . S C0CZ1=ZTYP_","_ZSRC_","_PATN_","
+"RTN","C0CFM2",124,0)
+ . . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,.01)=ZVARN
+"RTN","C0CFM2",125,0)
+ . . S ZZVAL=$TR(@ZVALS@(ZC0CI),"^","|")
+"RTN","C0CFM2",126,0)
+ . . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,1)=ZZVAL
+"RTN","C0CFM2",127,0)
+ . E  D  ; THIS IS A SUBELEMENT
+"RTN","C0CFM2",128,0)
+ . . ;PUT THE FOLLOWING BACK TO USE RECURSION
+"RTN","C0CFM2",129,0)
+ . . ;N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
+"RTN","C0CFM2",130,0)
+ . . ;S ZZCNT=0
+"RTN","C0CFM2",131,0)
+ . . ;S ZZC0CI=0
+"RTN","C0CFM2",132,0)
+ . . ;S ZZVALS=$NA(@ZVALS@("M")) ; LOCATION OF THIS MULTILPE
+"RTN","C0CFM2",133,0)
+ . . ;S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
+"RTN","C0CFM2",134,0)
+ . . ;S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
+"RTN","C0CFM2",135,0)
+ . . ;W "MULTIPLE:",ZZVALS,!
+"RTN","C0CFM2",136,0)
  . . ;B
-"RTN","C0CFM2",73,0)
- . . F  S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI=""  D  ; EACH MULTIPLE
-"RTN","C0CFM2",74,0)
- . . . S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
-"RTN","C0CFM2",75,0)
- . . . W "COUNT:",ZZCNT,!
-"RTN","C0CFM2",76,0)
- . . . S ZV=$NA(@ZZVALS@(ZZC0CI))
-"RTN","C0CFM2",77,0)
- . . . D PUTELS(DFN,ZT,C0CX_";"_ZZCNT,ZV)
-"RTN","C0CFM2",78,0)
+"RTN","C0CFM2",137,0)
+ . . ;F  S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI=""  D  ; EACH MULTIPLE
+"RTN","C0CFM2",138,0)
+ . . ;. S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
+"RTN","C0CFM2",139,0)
+ . . ;. W "COUNT:",ZZCNT,!
+"RTN","C0CFM2",140,0)
+ . . ;. S ZV=$NA(@ZZVALS@(ZZC0CI))
+"RTN","C0CFM2",141,0)
+ . . ;. D PUTELS(DFN,ZT,ZOCC_";"_ZZCNT,ZV) ; PUT THIS BACK TO DEBUG RECURSION
+"RTN","C0CFM2",142,0)
+ . . S C0CMDO=ZVALS ; FLAG TO HANDLE MULTIPLES (INSTEAD OF RECURSION)
+"RTN","C0CFM2",143,0)
+ D UPDIE ; UPDATE
+"RTN","C0CFM2",144,0)
  Q
-"RTN","C0CFM2",79,0)
- ;
-"RTN","C0CFM2",80,0)
-PUTELS(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
-"RTN","C0CFM2",81,0)
+"RTN","C0CFM2",145,0)
+ ;
+"RTN","C0CFM2",146,0)
+UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+"RTN","C0CFM2",147,0)
+ K ZERR
+"RTN","C0CFM2",148,0)
+ D CLEAN^DILF
+"RTN","C0CFM2",149,0)
+ D UPDATE^DIE("","C0CFDA","","ZERR")
+"RTN","C0CFM2",150,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CFM2",151,0)
+ K C0CFDA
+"RTN","C0CFM2",152,0)
+ Q
+"RTN","C0CFM2",153,0)
+ ;
+"RTN","C0CFM2",154,0)
+CHECK ; CHECKSUM EXPERIMENTS
+"RTN","C0CFM2",155,0)
+ ;
+"RTN","C0CFM2",156,0)
+ ;B
+"RTN","C0CFM2",157,0)
+ S ZG=$NA(^C0CE(DA(2),1,DA(1),1,DA))
+"RTN","C0CFM2",158,0)
+ ;S G2=$NA(^C0CE(8,1,1,1,2,1,6))
+"RTN","C0CFM2",159,0)
+ S X=$$CHKSUM^XUSESIG1(ZG)
+"RTN","C0CFM2",160,0)
+ W G1,!
+"RTN","C0CFM2",161,0)
+ Q
+"RTN","C0CFM2",162,0)
+ ;
+"RTN","C0CFM2",163,0)
+CHKELS(DFN) ; CHECKSUM ALL ELEMENTS FOR  A PATIENT
+"RTN","C0CFM2",164,0)
+ ;
+"RTN","C0CFM2",165,0)
+ S ZGLB=$NA(^TMP("C0CCHK"))
+"RTN","C0CFM2",166,0)
+ S ZPAT=$O(^C0CE("B",DFN,""))
+"RTN","C0CFM2",167,0)
+ K @ZGLB@(ZPAT) ; CLEAR PREVIOUS CHECKSUMS
+"RTN","C0CFM2",168,0)
+ S ZSRC=""
+"RTN","C0CFM2",169,0)
+ F  S ZSRC=$O(^C0CE(ZPAT,1,"B",ZSRC)) Q:ZSRC=""  D  ;
+"RTN","C0CFM2",170,0)
+ . W "PAT:",ZPAT," SRC:",ZSRC,!
+"RTN","C0CFM2",171,0)
+ . S ZEL=""
+"RTN","C0CFM2",172,0)
+ . F  S ZEL=$O(^C0CE(ZPAT,1,ZSRC,1,"B",ZEL)) Q:ZEL=""  D  ;ELEMENTS
+"RTN","C0CFM2",173,0)
+ . . W "ELEMENT:",ZEL," "
+"RTN","C0CFM2",174,0)
+ . . S ZELE=$$GET1^DIQ(170.101,ZEL,.01,"E") ;ELEMENT NAME
+"RTN","C0CFM2",175,0)
+ . . W ZELE," "
+"RTN","C0CFM2",176,0)
+ . . S ZELI=$O(^C0CE(ZPAT,1,ZSRC,1,"B",ZEL,""))
+"RTN","C0CFM2",177,0)
+ . . S ZG=$NA(^C0CE(ZPAT,1,ZSRC,1,ZELI))
+"RTN","C0CFM2",178,0)
+ . . S ZCHK=$$CHKSUM^XUSESIG1(ZG) ; CHECKSUM FOR THE ELEMENT
+"RTN","C0CFM2",179,0)
+ . . W ZCHK,!
+"RTN","C0CFM2",180,0)
+ . . S @ZGLB@(ZPAT,ZELE,ZSRC)=ZCHK
+"RTN","C0CFM2",181,0)
+ ; ZWR ^TMP("C0CCHK",ZPAT,*)
+"RTN","C0CFM2",182,0)
+ Q
+"RTN","C0CFM2",183,0)
+ ;
+"RTN","C0CFM2",184,0)
+DOIT(DFN) ; EXPERIMENT FOR TIMING CALLS USING mumps -dir DOIT^C0CFM2(DFN)
+"RTN","C0CFM2",185,0)
+ D SETXUP
+"RTN","C0CFM2",186,0)
+ D CHKELS(DFN)
+"RTN","C0CFM2",187,0)
+ Q
+"RTN","C0CFM2",188,0)
+ ;
+"RTN","C0CFM2",189,0)
+SETXUP ; SET UP ENVIRONMENT
+"RTN","C0CFM2",190,0)
+ S DISYS=19
+"RTN","C0CFM2",191,0)
+ S DT=3090325
+"RTN","C0CFM2",192,0)
+ S DTIME=300
+"RTN","C0CFM2",193,0)
+ S DUZ=1
+"RTN","C0CFM2",194,0)
+ S DUZ(0)="@"
+"RTN","C0CFM2",195,0)
+ S DUZ(1)=""
+"RTN","C0CFM2",196,0)
+ S DUZ(2)=7247
+"RTN","C0CFM2",197,0)
+ S DUZ("AG")="I"
+"RTN","C0CFM2",198,0)
+ S DUZ("BUF")=1
+"RTN","C0CFM2",199,0)
+ S DUZ("LANG")=""
+"RTN","C0CFM2",200,0)
+ S IO="/dev/pts/20"
+"RTN","C0CFM2",201,0)
+ S IO(0)="/dev/pts/20"
+"RTN","C0CFM2",202,0)
+ S IO(1,"/dev/pts/20")=""
+"RTN","C0CFM2",203,0)
+ S IO("ERROR")=""
+"RTN","C0CFM2",204,0)
+ S IO("HOME")="344^/dev/pts/20"
+"RTN","C0CFM2",205,0)
+ S IO("ZIO")="/dev/pts/20"
+"RTN","C0CFM2",206,0)
+ S IOBS="$C(8)"
+"RTN","C0CFM2",207,0)
+ S IOF="#,$C(27,91,50,74,27,91,72)"
+"RTN","C0CFM2",208,0)
+ S IOM=80
+"RTN","C0CFM2",209,0)
+ S ION="TELNET"
+"RTN","C0CFM2",210,0)
+ S IOS=344
+"RTN","C0CFM2",211,0)
+ S IOSL=24
+"RTN","C0CFM2",212,0)
+ S IOST="C-VT100"
+"RTN","C0CFM2",213,0)
+ S IOST(0)=9
+"RTN","C0CFM2",214,0)
+ S IOT="VTRM"
+"RTN","C0CFM2",215,0)
+ S IOXY="W $C(27,91)_((DY+1))_$C(59)_((DX+1))_$C(72)"
+"RTN","C0CFM2",216,0)
+ S U="^"
+"RTN","C0CFM2",217,0)
+ S X="216;DIC(4.2,"
+"RTN","C0CFM2",218,0)
+ S XPARSYS="216;DIC(4.2,"
+"RTN","C0CFM2",219,0)
+ S XQXFLG="^^XUP"
+"RTN","C0CFM2",220,0)
+ Q
+"RTN","C0CFM2",221,0)
+ ; 
+"RTN","C0CFM2",222,0)
+PUTELSO(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
+"RTN","C0CFM2",223,0)
  ; 171.101, ^C0CE  DFN IS THE PATIENT IEN PASSED BY VALUE
-"RTN","C0CFM2",82,0)
+"RTN","C0CFM2",224,0)
  ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
-"RTN","C0CFM2",83,0)
+"RTN","C0CFM2",225,0)
  ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
-"RTN","C0CFM2",84,0)
+"RTN","C0CFM2",226,0)
  ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
-"RTN","C0CFM2",85,0)
+"RTN","C0CFM2",227,0)
  ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
-"RTN","C0CFM2",86,0)
+"RTN","C0CFM2",228,0)
  ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
-"RTN","C0CFM2",87,0)
- ;
-"RTN","C0CFM2",88,0)
- N PATN,ZTYPN,XD0,ZTYP
-"RTN","C0CFM2",89,0)
- I '$D(ZSRC) S ZSRC=1 ; CCR SOURCE IS ASSUMED, 1 IF NOT SET
-"RTN","C0CFM2",90,0)
+"RTN","C0CFM2",229,0)
+ ;
+"RTN","C0CFM2",230,0)
+ S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1
+"RTN","C0CFM2",231,0)
  ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
-"RTN","C0CFM2",91,0)
- N C0CFPAT S C0CFPAT=171.101 ; FILE AT PATIENT LEVEL
-"RTN","C0CFM2",92,0)
- N C0CFSRC S C0CFSRC=171.111 ; FILE AT CCR SOURCE LVL
-"RTN","C0CFM2",93,0)
- N C0CFTYP S C0CFTYP=171.121 ; FILE AT ELEMENT TYPE LVL
-"RTN","C0CFM2",94,0)
- N C0CFOCC S C0CFOCC=171.131 ; FILE AT OCCURANCE LVL
-"RTN","C0CFM2",95,0)
- N C0CFVAR S C0CFVAR=171.1311 ; FILE AT VARIABLE LVL
-"RTN","C0CFM2",96,0)
- ;FILE IS ^C0CE(PAT,1,SCR,1,TYP,1,OCC,1,VAR,1, ...
-"RTN","C0CFM2",97,0)
- ; AND WE HAVE TO ADD THEM LEVEL AT A TIME I THINK
-"RTN","C0CFM2",98,0)
- N C0CFDA
-"RTN","C0CFM2",99,0)
- S C0CFDA(C0CFPAT,"?+1,",.01)=DFN
-"RTN","C0CFM2",100,0)
- D UPDIE ; ADD THE PATIENT
-"RTN","C0CFM2",101,0)
- S PATN=$O(^C0CE("B",DFN,"")) ; IEN FOR THE PATIENT
-"RTN","C0CFM2",102,0)
- S C0CFDA(C0CFSRC,"?+1,"_PATN_",",.01)=ZSRC
-"RTN","C0CFM2",103,0)
- D UPDIE ; ADD THE CCR SOURCE
-"RTN","C0CFM2",104,0)
- N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,"")) ; FIND THE ELE TYPE
-"RTN","C0CFM2",105,0)
- S C0CFDA(C0CFTYP,"?+1,"_ZSRC_","_PATN_",",.01)=ZTYPN
-"RTN","C0CFM2",106,0)
- D UPDIE ; ADD THE ELEMENT TYPE
-"RTN","C0CFM2",107,0)
- S ZTYP=$O(^C0CE(PATN,1,ZSRC,1,"B",ZTYPN,"")) ; IEN OF ELEMENT TYPE
-"RTN","C0CFM2",108,0)
- S C0CFDA(C0CFOCC,"?+1,"_ZTYP_","_ZSRC_","_PATN_",",.01)=ZOCC ; STRING OCC
-"RTN","C0CFM2",109,0)
- ; OCC IS PRECEDED BY " " TO FORCE STRING STORAGE AND PRESERVE
-"RTN","C0CFM2",110,0)
- ; STRING COLLATION ON THE INDEX
-"RTN","C0CFM2",111,0)
- D UPDIE ; ADD THE OCCURANCE
-"RTN","C0CFM2",112,0)
- S ZD0=$O(^C0CE(PATN,1,ZSRC,1,ZTYP,1,"B",ZOCC,""))
-"RTN","C0CFM2",113,0)
+"RTN","C0CFM2",232,0)
+ N ZF,ZFV S ZF=171.101 S ZFV=171.1011
+"RTN","C0CFM2",233,0)
+ ;S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS
+"RTN","C0CFM2",234,0)
+ ;N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER
+"RTN","C0CFM2",235,0)
+ N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
+"RTN","C0CFM2",236,0)
+ W "ZTYPE: ",ZTYPE," ",ZTYPN,!
+"RTN","C0CFM2",237,0)
+ N ZVARN ; IEN OF VARIABLE BEING PROCESSED
+"RTN","C0CFM2",238,0)
+ ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
+"RTN","C0CFM2",239,0)
+ K C0CFDA
+"RTN","C0CFM2",240,0)
+ S C0CFDA(ZF,"?+1,",.01)=DFN
+"RTN","C0CFM2",241,0)
+ S C0CFDA(ZF,"?+1,",.02)=ZSRC
+"RTN","C0CFM2",242,0)
+ S C0CFDA(ZF,"?+1,",.03)=ZTYPN
+"RTN","C0CFM2",243,0)
+ S C0CFDA(ZF,"?+1,",.04)=" "_ZOCC ;CREATE OCCURANCE
+"RTN","C0CFM2",244,0)
+ K ZERR
+"RTN","C0CFM2",245,0)
+ ;B
+"RTN","C0CFM2",246,0)
+ D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
+"RTN","C0CFM2",247,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CFM2",248,0)
+ K C0CFDA
+"RTN","C0CFM2",249,0)
+ S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,""))
+"RTN","C0CFM2",250,0)
  W "RECORD NUMBER: ",ZD0,!
-"RTN","C0CFM2",114,0)
- ;I ZD0=32 B
-"RTN","C0CFM2",115,0)
- ;I ZD0=31 B
-"RTN","C0CFM2",116,0)
- N ZCNT,ZC0CI,ZVARN,C0CZ1
-"RTN","C0CFM2",117,0)
+"RTN","C0CFM2",251,0)
  S ZCNT=0
-"RTN","C0CFM2",118,0)
+"RTN","C0CFM2",252,0)
  S ZC0CI="" ;
-"RTN","C0CFM2",119,0)
+"RTN","C0CFM2",253,0)
  F  S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI=""  D  ;
-"RTN","C0CFM2",120,0)
+"RTN","C0CFM2",254,0)
  . I ZC0CI'="M" D  ; NOT A SUBVARIABLE
-"RTN","C0CFM2",121,0)
+"RTN","C0CFM2",255,0)
  . . S ZCNT=ZCNT+1 ;INCREMENT COUNT
-"RTN","C0CFM2",122,0)
+"RTN","C0CFM2",256,0)
  . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
-"RTN","C0CFM2",123,0)
+"RTN","C0CFM2",257,0)
  . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
-"RTN","C0CFM2",124,0)
- . . S C0CZ1=ZTYP_","_ZSRC_","_PATN_","
-"RTN","C0CFM2",125,0)
- . . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,.01)=ZVARN
-"RTN","C0CFM2",126,0)
- . . S ZZVAL=$TR(@ZVALS@(ZC0CI),"^","|")
-"RTN","C0CFM2",127,0)
- . . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,1)=ZZVAL
-"RTN","C0CFM2",128,0)
- . E  D  ; THIS IS A SUBELEMENT
-"RTN","C0CFM2",129,0)
- . . ;PUT THE FOLLOWING BACK TO USE RECURSION
-"RTN","C0CFM2",130,0)
- . . ;N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
-"RTN","C0CFM2",131,0)
- . . ;S ZZCNT=0
-"RTN","C0CFM2",132,0)
- . . ;S ZZC0CI=0
-"RTN","C0CFM2",133,0)
- . . ;S ZZVALS=$NA(@ZVALS@("M")) ; LOCATION OF THIS MULTILPE
-"RTN","C0CFM2",134,0)
- . . ;S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
-"RTN","C0CFM2",135,0)
- . . ;S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
-"RTN","C0CFM2",136,0)
- . . ;W "MULTIPLE:",ZZVALS,!
-"RTN","C0CFM2",137,0)
- . . ;B
-"RTN","C0CFM2",138,0)
- . . ;F  S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI=""  D  ; EACH MULTIPLE
-"RTN","C0CFM2",139,0)
- . . ;. S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
-"RTN","C0CFM2",140,0)
- . . ;. W "COUNT:",ZZCNT,!
-"RTN","C0CFM2",141,0)
- . . ;. S ZV=$NA(@ZZVALS@(ZZC0CI))
-"RTN","C0CFM2",142,0)
- . . ;. D PUTELS(DFN,ZT,ZOCC_";"_ZZCNT,ZV) ; PUT THIS BACK TO DEBUG RECURSION
-"RTN","C0CFM2",143,0)
- . . S C0CMDO=ZVALS ; FLAG TO HANDLE MULTIPLES (INSTEAD OF RECURSION)
-"RTN","C0CFM2",144,0)
- D UPDIE ; UPDATE
-"RTN","C0CFM2",145,0)
+"RTN","C0CFM2",258,0)
+ . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN
+"RTN","C0CFM2",259,0)
+ . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI)
+"RTN","C0CFM2",260,0)
+ . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN
+"RTN","C0CFM2",261,0)
+ . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI)
+"RTN","C0CFM2",262,0)
+ ;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT"
+"RTN","C0CFM2",263,0)
+ ;S GT1(170,"?+1,",12)="DIR"
+"RTN","C0CFM2",264,0)
+ ;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT"
+"RTN","C0CFM2",265,0)
+ ;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
+"RTN","C0CFM2",266,0)
+ D CLEAN^DILF
+"RTN","C0CFM2",267,0)
+ D UPDATE^DIE("","C0CFDA","","ZERR")
+"RTN","C0CFM2",268,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CFM2",269,0)
+ K C0CFDA
+"RTN","C0CFM2",270,0)
  Q
-"RTN","C0CFM2",146,0)
- ;
-"RTN","C0CFM2",147,0)
-UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
-"RTN","C0CFM2",148,0)
- K ZERR
-"RTN","C0CFM2",149,0)
- D CLEAN^DILF
-"RTN","C0CFM2",150,0)
- D UPDATE^DIE("","C0CFDA","","ZERR")
-"RTN","C0CFM2",151,0)
- I $D(ZERR) D  ;
-"RTN","C0CFM2",152,0)
- . W "ERROR",!
-"RTN","C0CFM2",153,0)
- . ZWR ZERR
-"RTN","C0CFM2",154,0)
- . B
-"RTN","C0CFM2",155,0)
- K C0CFDA
-"RTN","C0CFM2",156,0)
+"RTN","C0CFM2",271,0)
+ ;
+"RTN","C0CFM2",272,0)
+VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
+"RTN","C0CFM2",273,0)
+ ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
+"RTN","C0CFM2",274,0)
+ ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
+"RTN","C0CFM2",275,0)
+ ;
+"RTN","C0CFM2",276,0)
+ N ZCCRD,ZVARN,C0CFDA2
+"RTN","C0CFM2",277,0)
+ S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
+"RTN","C0CFM2",278,0)
+ S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
+"RTN","C0CFM2",279,0)
+ I ZVARN="" D  ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
+"RTN","C0CFM2",280,0)
+ . I '$D(ZTYP) D  Q  ; WON'T ADD A VARIABLE WITHOUT A TYPE
+"RTN","C0CFM2",281,0)
+ . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
+"RTN","C0CFM2",282,0)
+ . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
+"RTN","C0CFM2",283,0)
+ . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
+"RTN","C0CFM2",284,0)
+ . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
+"RTN","C0CFM2",285,0)
+ . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
+"RTN","C0CFM2",286,0)
+ . I $D(ZERR) D  ; LAYGO ERROR
+"RTN","C0CFM2",287,0)
+ . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
+"RTN","C0CFM2",288,0)
+ . E  D  ;
+"RTN","C0CFM2",289,0)
+ . . D CLEAN^DILF ; CLEAN UP
+"RTN","C0CFM2",290,0)
+ . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
+"RTN","C0CFM2",291,0)
+ . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
+"RTN","C0CFM2",292,0)
+ Q ZVARN
+"RTN","C0CFM2",293,0)
+ ;
+"RTN","C0CFM2",294,0)
+BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,)
+"RTN","C0CFM2",295,0)
+ ; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED
+"RTN","C0CFM2",296,0)
+ ;
+"RTN","C0CFM2",297,0)
+ N C0CDIC,C0CNODE ;
+"RTN","C0CFM2",298,0)
+ S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY
+"RTN","C0CFM2",299,0)
+ S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE
+"RTN","C0CFM2",300,0)
  Q
-"RTN","C0CFM2",157,0)
- ;
-"RTN","C0CFM2",158,0)
-CHECK ; CHECKSUM EXPERIMENTS
-"RTN","C0CFM2",159,0)
- ;
-"RTN","C0CFM2",160,0)
- ;B
-"RTN","C0CFM2",161,0)
- S ZG=$NA(^C0CE(DA(2),1,DA(1),1,DA))
-"RTN","C0CFM2",162,0)
- ;S G2=$NA(^C0CE(8,1,1,1,2,1,6))
-"RTN","C0CFM2",163,0)
- S X=$$CHKSUM^XUSESIG1(ZG)
-"RTN","C0CFM2",164,0)
- W G1,!
-"RTN","C0CFM2",165,0)
+"RTN","C0CFM2",301,0)
+ ;
+"RTN","C0CFM2",302,0)
+FIXSEC ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED
+"RTN","C0CFM2",303,0)
+ ; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET
+"RTN","C0CFM2",304,0)
+ ; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS
+"RTN","C0CFM2",305,0)
+ ; CONVERSION
+"RTN","C0CFM2",306,0)
+ ;N C0CC,C0CI,C0CJ,C0CN,C0CZX
+"RTN","C0CFM2",307,0)
+ D FIELDS^C0CRNF("C0CC",170)
+"RTN","C0CFM2",308,0)
+ S C0CI=""
+"RTN","C0CFM2",309,0)
+ F  S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI=""  D  ; EACH SECTION
+"RTN","C0CFM2",310,0)
+ . S C0CZX=""
+"RTN","C0CFM2",311,0)
+ . F  S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX=""  D  ; EACH VARIABLE
+"RTN","C0CFM2",312,0)
+ . . W "SECTION ",C0CI," VAR ",C0CZX
+"RTN","C0CFM2",313,0)
+ . . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,""))
+"RTN","C0CFM2",314,0)
+ . . W " TYPE: ",C0CV,!
+"RTN","C0CFM2",315,0)
+ . . D SETFDA("SECTION",C0CV)
+"RTN","C0CFM2",316,0)
+ . . ;ZWR C0CFDA
+"RTN","C0CFM2",317,0)
  Q
-"RTN","C0CFM2",166,0)
- ;
-"RTN","C0CFM2",167,0)
-CHKELS(DFN) ; CHECKSUM ALL ELEMENTS FOR  A PATIENT
-"RTN","C0CFM2",168,0)
- ;
-"RTN","C0CFM2",169,0)
- S ZGLB=$NA(^TMP("C0CCHK"))
-"RTN","C0CFM2",170,0)
- S ZPAT=$O(^C0CE("B",DFN,""))
-"RTN","C0CFM2",171,0)
- K @ZGLB@(ZPAT) ; CLEAR PREVIOUS CHECKSUMS
-"RTN","C0CFM2",172,0)
- S ZSRC=""
-"RTN","C0CFM2",173,0)
- F  S ZSRC=$O(^C0CE(ZPAT,1,"B",ZSRC)) Q:ZSRC=""  D  ;
-"RTN","C0CFM2",174,0)
- . W "PAT:",ZPAT," SRC:",ZSRC,!
-"RTN","C0CFM2",175,0)
- . S ZEL=""
-"RTN","C0CFM2",176,0)
- . F  S ZEL=$O(^C0CE(ZPAT,1,ZSRC,1,"B",ZEL)) Q:ZEL=""  D  ;ELEMENTS
-"RTN","C0CFM2",177,0)
- . . W "ELEMENT:",ZEL," "
-"RTN","C0CFM2",178,0)
- . . S ZELE=$$GET1^DIQ(170.101,ZEL,.01,"E") ;ELEMENT NAME
-"RTN","C0CFM2",179,0)
- . . W ZELE," "
-"RTN","C0CFM2",180,0)
- . . S ZELI=$O(^C0CE(ZPAT,1,ZSRC,1,"B",ZEL,""))
-"RTN","C0CFM2",181,0)
- . . S ZG=$NA(^C0CE(ZPAT,1,ZSRC,1,ZELI))
-"RTN","C0CFM2",182,0)
- . . S ZCHK=$$CHKSUM^XUSESIG1(ZG) ; CHECKSUM FOR THE ELEMENT
-"RTN","C0CFM2",183,0)
- . . W ZCHK,!
-"RTN","C0CFM2",184,0)
- . . S @ZGLB@(ZPAT,ZELE,ZSRC)=ZCHK
-"RTN","C0CFM2",185,0)
- ZWR ^TMP("C0CCHK",ZPAT,*)
-"RTN","C0CFM2",186,0)
+"RTN","C0CFM2",318,0)
+ ;
+"RTN","C0CFM2",319,0)
+SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
+"RTN","C0CFM2",320,0)
+ ; TO SET TO VALUE C0CSV.
+"RTN","C0CFM2",321,0)
+ ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
+"RTN","C0CFM2",322,0)
+ ; C0CSN,C0CSV ARE PASSED BY VALUE
+"RTN","C0CFM2",323,0)
+ ;
+"RTN","C0CFM2",324,0)
+ N C0CSI,C0CSJ
+"RTN","C0CFM2",325,0)
+ S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
+"RTN","C0CFM2",326,0)
+ S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
+"RTN","C0CFM2",327,0)
+ S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
+"RTN","C0CFM2",328,0)
  Q
-"RTN","C0CFM2",187,0)
- ;
-"RTN","C0CFM2",188,0)
-DOIT(DFN) ; EXPERIMENT FOR TIMING CALLS USING mumps -dir DOIT^C0CFM2(DFN)
-"RTN","C0CFM2",189,0)
- D SETXUP
-"RTN","C0CFM2",190,0)
- D CHKELS(DFN)
-"RTN","C0CFM2",191,0)
- Q
-"RTN","C0CFM2",192,0)
- ;
-"RTN","C0CFM2",193,0)
-SETXUP ; SET UP ENVIRONMENT
-"RTN","C0CFM2",194,0)
- S DISYS=19
-"RTN","C0CFM2",195,0)
- S DT=3090325
-"RTN","C0CFM2",196,0)
- S DTIME=300
-"RTN","C0CFM2",197,0)
- S DUZ=1
-"RTN","C0CFM2",198,0)
- S DUZ(0)="@"
-"RTN","C0CFM2",199,0)
- S DUZ(1)=""
-"RTN","C0CFM2",200,0)
- S DUZ(2)=7247
-"RTN","C0CFM2",201,0)
- S DUZ("AG")="I"
-"RTN","C0CFM2",202,0)
- S DUZ("BUF")=1
-"RTN","C0CFM2",203,0)
- S DUZ("LANG")=""
-"RTN","C0CFM2",204,0)
- S IO="/dev/pts/20"
-"RTN","C0CFM2",205,0)
- S IO(0)="/dev/pts/20"
-"RTN","C0CFM2",206,0)
- S IO(1,"/dev/pts/20")=""
-"RTN","C0CFM2",207,0)
- S IO("ERROR")=""
-"RTN","C0CFM2",208,0)
- S IO("HOME")="344^/dev/pts/20"
-"RTN","C0CFM2",209,0)
- S IO("ZIO")="/dev/pts/20"
-"RTN","C0CFM2",210,0)
- S IOBS="$C(8)"
-"RTN","C0CFM2",211,0)
- S IOF="#,$C(27,91,50,74,27,91,72)"
-"RTN","C0CFM2",212,0)
- S IOM=80
-"RTN","C0CFM2",213,0)
- S ION="TELNET"
-"RTN","C0CFM2",214,0)
- S IOS=344
-"RTN","C0CFM2",215,0)
- S IOSL=24
-"RTN","C0CFM2",216,0)
- S IOST="C-VT100"
-"RTN","C0CFM2",217,0)
- S IOST(0)=9
-"RTN","C0CFM2",218,0)
- S IOT="VTRM"
-"RTN","C0CFM2",219,0)
- S IOXY="W $C(27,91)_((DY+1))_$C(59)_((DX+1))_$C(72)"
-"RTN","C0CFM2",220,0)
- S U="^"
-"RTN","C0CFM2",221,0)
- S X="216;DIC(4.2,"
-"RTN","C0CFM2",222,0)
- S XPARSYS="216;DIC(4.2,"
-"RTN","C0CFM2",223,0)
- S XQXFLG="^^XUP"
-"RTN","C0CFM2",224,0)
- Q
-"RTN","C0CFM2",225,0)
- ; 
-"RTN","C0CFM2",226,0)
-PUTELSOLD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
-"RTN","C0CFM2",227,0)
- ; 171.101, ^C0CE  DFN IS THE PATIENT IEN PASSED BY VALUE
-"RTN","C0CFM2",228,0)
- ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
-"RTN","C0CFM2",229,0)
- ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
-"RTN","C0CFM2",230,0)
- ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
-"RTN","C0CFM2",231,0)
- ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
-"RTN","C0CFM2",232,0)
- ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
-"RTN","C0CFM2",233,0)
- ;
-"RTN","C0CFM2",234,0)
- S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1
-"RTN","C0CFM2",235,0)
- ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
-"RTN","C0CFM2",236,0)
- N ZF,ZFV S ZF=171.101 S ZFV=171.1011
-"RTN","C0CFM2",237,0)
- ;S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS
-"RTN","C0CFM2",238,0)
- ;N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER
-"RTN","C0CFM2",239,0)
- N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
-"RTN","C0CFM2",240,0)
- W "ZTYPE: ",ZTYPE," ",ZTYPN,!
-"RTN","C0CFM2",241,0)
- N ZVARN ; IEN OF VARIABLE BEING PROCESSED
-"RTN","C0CFM2",242,0)
- ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
-"RTN","C0CFM2",243,0)
- K C0CFDA
-"RTN","C0CFM2",244,0)
- S C0CFDA(ZF,"?+1,",.01)=DFN
-"RTN","C0CFM2",245,0)
- S C0CFDA(ZF,"?+1,",.02)=ZSRC
-"RTN","C0CFM2",246,0)
- S C0CFDA(ZF,"?+1,",.03)=ZTYPN
-"RTN","C0CFM2",247,0)
- S C0CFDA(ZF,"?+1,",.04)=" "_ZOCC ;CREATE OCCURANCE
-"RTN","C0CFM2",248,0)
- K ZERR
-"RTN","C0CFM2",249,0)
- ;B
-"RTN","C0CFM2",250,0)
- D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
-"RTN","C0CFM2",251,0)
- I $D(ZERR) B  ;OOPS
-"RTN","C0CFM2",252,0)
- K C0CFDA
-"RTN","C0CFM2",253,0)
- S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,""))
-"RTN","C0CFM2",254,0)
- W "RECORD NUMBER: ",ZD0,!
-"RTN","C0CFM2",255,0)
- ;B
-"RTN","C0CFM2",256,0)
- S ZCNT=0
-"RTN","C0CFM2",257,0)
- S ZC0CI="" ;
-"RTN","C0CFM2",258,0)
- F  S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI=""  D  ;
-"RTN","C0CFM2",259,0)
- . I ZC0CI'="M" D  ; NOT A SUBVARIABLE
-"RTN","C0CFM2",260,0)
- . . S ZCNT=ZCNT+1 ;INCREMENT COUNT
-"RTN","C0CFM2",261,0)
- . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
-"RTN","C0CFM2",262,0)
- . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
-"RTN","C0CFM2",263,0)
- . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN
-"RTN","C0CFM2",264,0)
- . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI)
-"RTN","C0CFM2",265,0)
- . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN
-"RTN","C0CFM2",266,0)
- . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI)
-"RTN","C0CFM2",267,0)
- ;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT"
-"RTN","C0CFM2",268,0)
- ;S GT1(170,"?+1,",12)="DIR"
-"RTN","C0CFM2",269,0)
- ;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT"
-"RTN","C0CFM2",270,0)
- ;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
-"RTN","C0CFM2",271,0)
- D CLEAN^DILF
-"RTN","C0CFM2",272,0)
- D UPDATE^DIE("","C0CFDA","","ZERR")
-"RTN","C0CFM2",273,0)
- I $D(ZERR) D  ;
-"RTN","C0CFM2",274,0)
- . W "ERROR",!
-"RTN","C0CFM2",275,0)
- . ZWR ZERR
-"RTN","C0CFM2",276,0)
- . B
-"RTN","C0CFM2",277,0)
- K C0CFDA
-"RTN","C0CFM2",278,0)
- Q
-"RTN","C0CFM2",279,0)
- ;
-"RTN","C0CFM2",280,0)
-VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
-"RTN","C0CFM2",281,0)
- ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
-"RTN","C0CFM2",282,0)
- ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
-"RTN","C0CFM2",283,0)
- ;
-"RTN","C0CFM2",284,0)
- N ZCCRD,ZVARN,C0CFDA2
-"RTN","C0CFM2",285,0)
- S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
-"RTN","C0CFM2",286,0)
- S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
-"RTN","C0CFM2",287,0)
- I ZVARN="" D  ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
-"RTN","C0CFM2",288,0)
- . I '$D(ZTYP) D  Q  ; WON'T ADD A VARIABLE WITHOUT A TYPE
-"RTN","C0CFM2",289,0)
- . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
-"RTN","C0CFM2",290,0)
- . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
-"RTN","C0CFM2",291,0)
- . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
-"RTN","C0CFM2",292,0)
- . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
-"RTN","C0CFM2",293,0)
- . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
-"RTN","C0CFM2",294,0)
- . I $D(ZERR) D  ; LAYGO ERROR
-"RTN","C0CFM2",295,0)
- . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
-"RTN","C0CFM2",296,0)
- . E  D  ;
-"RTN","C0CFM2",297,0)
- . . D CLEAN^DILF ; CLEAN UP
-"RTN","C0CFM2",298,0)
- . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
-"RTN","C0CFM2",299,0)
- . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
-"RTN","C0CFM2",300,0)
- Q ZVARN
-"RTN","C0CFM2",301,0)
- ;
-"RTN","C0CFM2",302,0)
-BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,)
-"RTN","C0CFM2",303,0)
- ; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED
-"RTN","C0CFM2",304,0)
- ;
-"RTN","C0CFM2",305,0)
- N C0CDIC,C0CNODE ;
-"RTN","C0CFM2",306,0)
- S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY
-"RTN","C0CFM2",307,0)
- S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE
-"RTN","C0CFM2",308,0)
- Q
-"RTN","C0CFM2",309,0)
- ;
-"RTN","C0CFM2",310,0)
-FIXSEC ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED
-"RTN","C0CFM2",311,0)
- ; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET
-"RTN","C0CFM2",312,0)
- ; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS
-"RTN","C0CFM2",313,0)
- ; CONVERSION
-"RTN","C0CFM2",314,0)
- ;N C0CC,C0CI,C0CJ,C0CN,C0CZX
-"RTN","C0CFM2",315,0)
- D FIELDS^C0CRNF("C0CC",170)
-"RTN","C0CFM2",316,0)
- S C0CI=""
-"RTN","C0CFM2",317,0)
- F  S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI=""  D  ; EACH SECTION
-"RTN","C0CFM2",318,0)
- . S C0CZX=""
-"RTN","C0CFM2",319,0)
- . F  S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX=""  D  ; EACH VARIABLE
-"RTN","C0CFM2",320,0)
- . . W "SECTION ",C0CI," VAR ",C0CZX
-"RTN","C0CFM2",321,0)
- . . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,""))
-"RTN","C0CFM2",322,0)
- . . W " TYPE: ",C0CV,!
-"RTN","C0CFM2",323,0)
- . . D SETFDA("SECTION",C0CV)
-"RTN","C0CFM2",324,0)
- . . ;ZWR C0CFDA
-"RTN","C0CFM2",325,0)
- Q
-"RTN","C0CFM2",326,0)
- ;
-"RTN","C0CFM2",327,0)
-SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
-"RTN","C0CFM2",328,0)
- ; TO SET TO VALUE C0CSV.
 "RTN","C0CFM2",329,0)
- ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
+ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
 "RTN","C0CFM2",330,0)
- ; C0CSN,C0CSV ARE PASSED BY VALUE
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
 "RTN","C0CFM2",331,0)
- ;
+ ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
 "RTN","C0CFM2",332,0)
- N C0CSI,C0CSJ
+ I '$D(ZTAB) S ZTAB="C0CA"
 "RTN","C0CFM2",333,0)
- S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
+ N ZR
 "RTN","C0CFM2",334,0)
- S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
+ I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
 "RTN","C0CFM2",335,0)
- S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
+ E  S ZR=""
 "RTN","C0CFM2",336,0)
- Q
+ Q ZR
 "RTN","C0CFM2",337,0)
-ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
+ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
 "RTN","C0CFM2",338,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
 "RTN","C0CFM2",339,0)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
@@ -100148,5 +100184,5 @@
  N ZR
 "RTN","C0CFM2",342,0)
- I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
+ I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
 "RTN","C0CFM2",343,0)
  E  S ZR=""
@@ -100154,819 +100190,791 @@
  Q ZR
 "RTN","C0CFM2",345,0)
-ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
+ ;
 "RTN","C0CFM2",346,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
+ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
 "RTN","C0CFM2",347,0)
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
+"RTN","C0CFM2",348,0)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CFM2",348,0)
+"RTN","C0CFM2",349,0)
  I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CFM2",349,0)
+"RTN","C0CFM2",350,0)
  N ZR
-"RTN","C0CFM2",350,0)
- I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
 "RTN","C0CFM2",351,0)
+ I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
+"RTN","C0CFM2",352,0)
  E  S ZR=""
-"RTN","C0CFM2",352,0)
+"RTN","C0CFM2",353,0)
  Q ZR
-"RTN","C0CFM2",353,0)
- ;
 "RTN","C0CFM2",354,0)
-ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
-"RTN","C0CFM2",355,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
-"RTN","C0CFM2",356,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CFM2",357,0)
- I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CFM2",358,0)
- N ZR
-"RTN","C0CFM2",359,0)
- I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
-"RTN","C0CFM2",360,0)
- E  S ZR=""
-"RTN","C0CFM2",361,0)
- Q ZR
-"RTN","C0CFM2",362,0)
  ;
 "RTN","C0CFM3")
-0^79^B68203631
+0^79^B66472582
 "RTN","C0CFM3",1,0)
 C0CFM3   ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
 "RTN","C0CFM3",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CFM3",3,0)
- ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
+ ;Copyright 2009 George Lilly.
 "RTN","C0CFM3",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CFM3",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CFM3",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CFM3",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CFM3",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CFM3",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CFM3",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CFM3",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CFM3",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CFM3",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CFM3",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CFM3",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CFM3",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CFM3",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CFM3",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
 "RTN","C0CFM3",19,0)
- ;
+ W "This is the CCR FILEMAN Utility Library ",!
 "RTN","C0CFM3",20,0)
- W "This is the CCR FILEMAN Utility Library ",!
+ ; THIS SET OF ROUTINES USE CCR E2 (^C0CE(, FILE 171.101) INSTEAD OF
 "RTN","C0CFM3",21,0)
- ; THIS SET OF ROUTINES USE CCR E2 (^C0CE(, FILE 171.101) INSTEAD OF
+ ; CCR ELEMENTS (^C0C(179.201,
 "RTN","C0CFM3",22,0)
- ; CCR ELEMENTS (^C0C(179.201,
+ ; E2 IS A SIMPLIFICATION OF CCR ELEMENTS WHERE SUB-ELEMENTS ARE
 "RTN","C0CFM3",23,0)
- ; E2 IS A SIMPLIFICATION OF CCR ELEMENTS WHERE SUB-ELEMENTS ARE
+ ; AT THE TOP LEVEL. OCCURANCE, THE 4TH PART OF THE KEY IS NOW FREE TEXT
 "RTN","C0CFM3",24,0)
- ; AT THE TOP LEVEL. OCCURANCE, THE 4TH PART OF THE KEY IS NOW FREE TEXT
+ ; AND HAS THE FORM X;Y FOR SUB-ELEMENTS
 "RTN","C0CFM3",25,0)
- ; AND HAS THE FORM X;Y FOR SUB-ELEMENTS
+ ; ALL SUB-VARIABLES HAVE BEEN REMOVED
 "RTN","C0CFM3",26,0)
- ; ALL SUB-VARIABLES HAVE BEEN REMOVED
+ W !
 "RTN","C0CFM3",27,0)
- W !
+ Q
 "RTN","C0CFM3",28,0)
+ ;
+"RTN","C0CFM3",29,0)
+RIMTBL(ZWHICH) ; PUT ALL PATIENT IN RIMTBL ZWHICH INTO THE CCR ELEMENTS FILE
+"RTN","C0CFM3",30,0)
+ ; '
+"RTN","C0CFM3",31,0)
+ I '$D(RIMBASE) D ASETUP^GPLRIMA ; FOR COMMAND LINE CALLS
+"RTN","C0CFM3",32,0)
+ N ZI,ZJ,ZC,ZPATBASE
+"RTN","C0CFM3",33,0)
+ S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",ZWHICH))
+"RTN","C0CFM3",34,0)
+ S ZI=""
+"RTN","C0CFM3",35,0)
+ F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
+"RTN","C0CFM3",36,0)
+ . S ZI=$O(@ZPATBASE@(ZI))
+"RTN","C0CFM3",37,0)
+ . D PUTRIM(ZI) ; EXPORT THE PATIENT TO A FILE
+"RTN","C0CFM3",38,0)
  Q
-"RTN","C0CFM3",29,0)
- ;
-"RTN","C0CFM3",30,0)
-RIMTBL(ZWHICH) ; PUT ALL PATIENT IN RIMTBL ZWHICH INTO THE CCR ELEMENTS FILE
-"RTN","C0CFM3",31,0)
- ; '
-"RTN","C0CFM3",32,0)
- I '$D(RIMBASE) D ASETUP^GPLRIMA ; FOR COMMAND LINE CALLS
-"RTN","C0CFM3",33,0)
- N ZI,ZJ,ZC,ZPATBASE
-"RTN","C0CFM3",34,0)
- S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",ZWHICH))
-"RTN","C0CFM3",35,0)
- S ZI=""
-"RTN","C0CFM3",36,0)
- F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
-"RTN","C0CFM3",37,0)
- . S ZI=$O(@ZPATBASE@(ZI))
-"RTN","C0CFM3",38,0)
- . D PUTRIM(ZI) ; EXPORT THE PATIENT TO A FILE
 "RTN","C0CFM3",39,0)
+ ;
+"RTN","C0CFM3",40,0)
+PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE
+"RTN","C0CFM3",41,0)
+ ;
+"RTN","C0CFM3",42,0)
+ S C0CGLB=$NA(^TMP("C0CRIM","VARS",DFN))
+"RTN","C0CFM3",43,0)
+ I '$D(ZWHICH) S ZWHICH="ALL"
+"RTN","C0CFM3",44,0)
+ I ZWHICH'="ALL" D  ; SINGLE SECTION REQUESTED
+"RTN","C0CFM3",45,0)
+ . S C0CVARS=$NA(@C0CGLB@(ZWHICH))
+"RTN","C0CFM3",46,0)
+ . D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION
+"RTN","C0CFM3",47,0)
+ E  D  ; MULTIPLE SECTIONS
+"RTN","C0CFM3",48,0)
+ . S C0CVARS=$NA(@C0CGLB)
+"RTN","C0CFM3",49,0)
+ . S C0CI=""
+"RTN","C0CFM3",50,0)
+ . F  S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI=""  D  ;FOR EACH SECTION
+"RTN","C0CFM3",51,0)
+ . . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION
+"RTN","C0CFM3",52,0)
+ . . D PUTRIM1(DFN,C0CI,C0CVARSN)
+"RTN","C0CFM3",53,0)
  Q
-"RTN","C0CFM3",40,0)
- ;
-"RTN","C0CFM3",41,0)
-PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE
-"RTN","C0CFM3",42,0)
- ;
-"RTN","C0CFM3",43,0)
- S C0CGLB=$NA(^TMP("C0CRIM","VARS",DFN))
-"RTN","C0CFM3",44,0)
- I '$D(ZWHICH) S ZWHICH="ALL"
-"RTN","C0CFM3",45,0)
- I ZWHICH'="ALL" D  ; SINGLE SECTION REQUESTED
-"RTN","C0CFM3",46,0)
- . S C0CVARS=$NA(@C0CGLB@(ZWHICH))
-"RTN","C0CFM3",47,0)
- . D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION
-"RTN","C0CFM3",48,0)
- E  D  ; MULTIPLE SECTIONS
-"RTN","C0CFM3",49,0)
- . S C0CVARS=$NA(@C0CGLB)
-"RTN","C0CFM3",50,0)
- . S C0CI=""
-"RTN","C0CFM3",51,0)
- . F  S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI=""  D  ;FOR EACH SECTION
-"RTN","C0CFM3",52,0)
- . . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION
-"RTN","C0CFM3",53,0)
- . . D PUTRIM1(DFN,C0CI,C0CVARSN)
 "RTN","C0CFM3",54,0)
+ ;
+"RTN","C0CFM3",55,0)
+PUTRIM1(DFN,ZZTYP,ZVARS) ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS
+"RTN","C0CFM3",56,0)
+ ; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1"
+"RTN","C0CFM3",57,0)
+ S C0CX=0
+"RTN","C0CFM3",58,0)
+ F  S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX=""  D  ; FOR EACH OCCURANCE
+"RTN","C0CFM3",59,0)
+ . W "ZOCC=",C0CX,!
+"RTN","C0CFM3",60,0)
+ . K C0CMDO ; MULTIPLE SUBELEMENTS FOR THIS OCCURANCE PASSED BY NAME
+"RTN","C0CFM3",61,0)
+ . S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE
+"RTN","C0CFM3",62,0)
+ . D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE
+"RTN","C0CFM3",63,0)
+ . I $D(C0CMDO) D  ; MULTIPLES TO HANDLE (THIS IS INSTEAD OF RECURSION :()
+"RTN","C0CFM3",64,0)
+ . . N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
+"RTN","C0CFM3",65,0)
+ . . S ZZCNT=0
+"RTN","C0CFM3",66,0)
+ . . S ZZC0CI=0
+"RTN","C0CFM3",67,0)
+ . . S ZZVALS=$NA(@C0CMDO@("M")) ; LOCATION OF THIS MULTILPE
+"RTN","C0CFM3",68,0)
+ . . S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
+"RTN","C0CFM3",69,0)
+ . . S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
+"RTN","C0CFM3",70,0)
+ . . W "MULTIPLE:",ZZVALS,!
+"RTN","C0CFM3",71,0)
+ . . ;B
+"RTN","C0CFM3",72,0)
+ . . F  S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI=""  D  ; EACH MULTIPLE
+"RTN","C0CFM3",73,0)
+ . . . S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
+"RTN","C0CFM3",74,0)
+ . . . W "COUNT:",ZZCNT,!
+"RTN","C0CFM3",75,0)
+ . . . S ZV=$NA(@ZZVALS@(ZZC0CI))
+"RTN","C0CFM3",76,0)
+ . . . D PUTELS(DFN,ZT,C0CX_";"_ZZCNT,ZV)
+"RTN","C0CFM3",77,0)
  Q
-"RTN","C0CFM3",55,0)
- ;
-"RTN","C0CFM3",56,0)
-PUTRIM1(DFN,ZZTYP,ZVARS) ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS
-"RTN","C0CFM3",57,0)
- ; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1"
-"RTN","C0CFM3",58,0)
- S C0CX=0
-"RTN","C0CFM3",59,0)
- F  S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX=""  D  ; FOR EACH OCCURANCE
-"RTN","C0CFM3",60,0)
- . W "ZOCC=",C0CX,!
-"RTN","C0CFM3",61,0)
- . K C0CMDO ; MULTIPLE SUBELEMENTS FOR THIS OCCURANCE PASSED BY NAME
-"RTN","C0CFM3",62,0)
- . S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE
-"RTN","C0CFM3",63,0)
- . D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE
-"RTN","C0CFM3",64,0)
- . I $D(C0CMDO) D  ; MULTIPLES TO HANDLE (THIS IS INSTEAD OF RECURSION :()
-"RTN","C0CFM3",65,0)
- . . N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
-"RTN","C0CFM3",66,0)
- . . S ZZCNT=0
-"RTN","C0CFM3",67,0)
- . . S ZZC0CI=0
-"RTN","C0CFM3",68,0)
- . . S ZZVALS=$NA(@C0CMDO@("M")) ; LOCATION OF THIS MULTILPE
-"RTN","C0CFM3",69,0)
- . . S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
-"RTN","C0CFM3",70,0)
- . . S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
-"RTN","C0CFM3",71,0)
- . . W "MULTIPLE:",ZZVALS,!
-"RTN","C0CFM3",72,0)
+"RTN","C0CFM3",78,0)
+ ;
+"RTN","C0CFM3",79,0)
+PUTELS(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
+"RTN","C0CFM3",80,0)
+ ; 171.601, ^C0CE  DFN IS THE PATIENT IEN PASSED BY VALUE
+"RTN","C0CFM3",81,0)
+ ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
+"RTN","C0CFM3",82,0)
+ ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
+"RTN","C0CFM3",83,0)
+ ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
+"RTN","C0CFM3",84,0)
+ ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
+"RTN","C0CFM3",85,0)
+ ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
+"RTN","C0CFM3",86,0)
+ ;
+"RTN","C0CFM3",87,0)
+ N ZSRC,PATN,ZTYPN,XD0,ZTYP
+"RTN","C0CFM3",88,0)
+ S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1
+"RTN","C0CFM3",89,0)
+ ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
+"RTN","C0CFM3",90,0)
+ N C0CF S C0CF=171.601 ; FILE AT ELEMENT LEVEL
+"RTN","C0CFM3",91,0)
+ N C0CFV S C0CFV=171.6011 ; FILE AT VARIABLE LVL
+"RTN","C0CFM3",92,0)
+ N C0CFDA
+"RTN","C0CFM3",93,0)
+ N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
+"RTN","C0CFM3",94,0)
+ W "ZTYPE: ",ZTYPE," ",ZTYPN,!
+"RTN","C0CFM3",95,0)
+ N ZVARN ; IEN OF VARIABLE BEING PROCESSED
+"RTN","C0CFM3",96,0)
+ ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
+"RTN","C0CFM3",97,0)
+ S C0CFDA(C0CF,"+1,",.01)=ZTYPN
+"RTN","C0CFM3",98,0)
+ S C0CFDA(C0CF,"+1,",.02)=DFN
+"RTN","C0CFM3",99,0)
+ S C0CFDA(C0CF,"+1,",.03)=ZSRC
+"RTN","C0CFM3",100,0)
+ S C0CFDA(C0CF,"+1,",.04)=" "_ZOCC ;CREATE OCCURANCE with leading space
+"RTN","C0CFM3",101,0)
+ D UPDIE ; CREATE THE RECORD
+"RTN","C0CFM3",102,0)
+ S C0CIEN=$O(^C0CE4("C",DFN,ZSRC,ZTYPN," "_ZOCC,""))
+"RTN","C0CFM3",103,0)
+ N ZCNT,ZC0CI,ZVARN,C0CZ1
+"RTN","C0CFM3",104,0)
+ S ZCNT=0
+"RTN","C0CFM3",105,0)
+ S ZC0CI="" ;
+"RTN","C0CFM3",106,0)
+ F  S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI=""  D  ;
+"RTN","C0CFM3",107,0)
+ . I ZC0CI'="M" D  ; NOT A SUBVARIABLE
+"RTN","C0CFM3",108,0)
+ . . S ZCNT=ZCNT+1 ;INCREMENT COUNT
+"RTN","C0CFM3",109,0)
+ . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
+"RTN","C0CFM3",110,0)
+ . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
+"RTN","C0CFM3",111,0)
+ . . S C0CFDA(C0CFV,"+"_ZCNT_","_C0CIEN_",",.01)=ZVARN
+"RTN","C0CFM3",112,0)
+ . . S C0CFDA(C0CFV,"+"_ZCNT_","_C0CIEN_",",1)=@ZVALS@(ZC0CI)
+"RTN","C0CFM3",113,0)
+ . E  D  ; THIS IS A SUBELEMENT
+"RTN","C0CFM3",114,0)
+ . . ;PUT THE FOLLOWING BACK TO USE RECURSION
+"RTN","C0CFM3",115,0)
+ . . ;N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
+"RTN","C0CFM3",116,0)
+ . . ;S ZZCNT=0
+"RTN","C0CFM3",117,0)
+ . . ;S ZZC0CI=0
+"RTN","C0CFM3",118,0)
+ . . ;S ZZVALS=$NA(@ZVALS@("M")) ; LOCATION OF THIS MULTILPE
+"RTN","C0CFM3",119,0)
+ . . ;S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
+"RTN","C0CFM3",120,0)
+ . . ;S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
+"RTN","C0CFM3",121,0)
+ . . ;W "MULTIPLE:",ZZVALS,!
+"RTN","C0CFM3",122,0)
  . . ;B
-"RTN","C0CFM3",73,0)
- . . F  S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI=""  D  ; EACH MULTIPLE
-"RTN","C0CFM3",74,0)
- . . . S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
-"RTN","C0CFM3",75,0)
- . . . W "COUNT:",ZZCNT,!
-"RTN","C0CFM3",76,0)
- . . . S ZV=$NA(@ZZVALS@(ZZC0CI))
-"RTN","C0CFM3",77,0)
- . . . D PUTELS(DFN,ZT,C0CX_";"_ZZCNT,ZV)
-"RTN","C0CFM3",78,0)
+"RTN","C0CFM3",123,0)
+ . . ;F  S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI=""  D  ; EACH MULTIPLE
+"RTN","C0CFM3",124,0)
+ . . ;. S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
+"RTN","C0CFM3",125,0)
+ . . ;. W "COUNT:",ZZCNT,!
+"RTN","C0CFM3",126,0)
+ . . ;. S ZV=$NA(@ZZVALS@(ZZC0CI))
+"RTN","C0CFM3",127,0)
+ . . ;. D PUTELS(DFN,ZT,ZOCC_";"_ZZCNT,ZV) ; PUT THIS BACK TO DEBUG RECURSION
+"RTN","C0CFM3",128,0)
+ . . S C0CMDO=ZVALS ; FLAG TO HANDLE MULTIPLES (INSTEAD OF RECURSION)
+"RTN","C0CFM3",129,0)
+ D UPDIE ; UPDATE
+"RTN","C0CFM3",130,0)
  Q
-"RTN","C0CFM3",79,0)
- ;
-"RTN","C0CFM3",80,0)
-PUTELS(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
-"RTN","C0CFM3",81,0)
- ; 171.601, ^C0CE  DFN IS THE PATIENT IEN PASSED BY VALUE
-"RTN","C0CFM3",82,0)
+"RTN","C0CFM3",131,0)
+ ;
+"RTN","C0CFM3",132,0)
+UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+"RTN","C0CFM3",133,0)
+ K ZERR
+"RTN","C0CFM3",134,0)
+ D CLEAN^DILF
+"RTN","C0CFM3",135,0)
+ D UPDATE^DIE("","C0CFDA","","ZERR")
+"RTN","C0CFM3",136,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CFM3",137,0)
+ K C0CFDA
+"RTN","C0CFM3",138,0)
+ Q
+"RTN","C0CFM3",139,0)
+ ;
+"RTN","C0CFM3",140,0)
+PUTELSO(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
+"RTN","C0CFM3",141,0)
+ ; 171.101, ^C0CE  DFN IS THE PATIENT IEN PASSED BY VALUE
+"RTN","C0CFM3",142,0)
  ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
-"RTN","C0CFM3",83,0)
+"RTN","C0CFM3",143,0)
  ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
-"RTN","C0CFM3",84,0)
+"RTN","C0CFM3",144,0)
  ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
-"RTN","C0CFM3",85,0)
+"RTN","C0CFM3",145,0)
  ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
-"RTN","C0CFM3",86,0)
+"RTN","C0CFM3",146,0)
  ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
-"RTN","C0CFM3",87,0)
- ;
-"RTN","C0CFM3",88,0)
- N ZSRC,PATN,ZTYPN,XD0,ZTYP
-"RTN","C0CFM3",89,0)
+"RTN","C0CFM3",147,0)
+ ;
+"RTN","C0CFM3",148,0)
  S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1
-"RTN","C0CFM3",90,0)
+"RTN","C0CFM3",149,0)
  ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
-"RTN","C0CFM3",91,0)
- N C0CF S C0CF=171.601 ; FILE AT ELEMENT LEVEL
-"RTN","C0CFM3",92,0)
- N C0CFV S C0CFV=171.6011 ; FILE AT VARIABLE LVL
-"RTN","C0CFM3",93,0)
- N C0CFDA
-"RTN","C0CFM3",94,0)
+"RTN","C0CFM3",150,0)
+ N ZF,ZFV S ZF=171.101 S ZFV=171.1011
+"RTN","C0CFM3",151,0)
+ ;S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS
+"RTN","C0CFM3",152,0)
+ ;N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER
+"RTN","C0CFM3",153,0)
  N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
-"RTN","C0CFM3",95,0)
+"RTN","C0CFM3",154,0)
  W "ZTYPE: ",ZTYPE," ",ZTYPN,!
-"RTN","C0CFM3",96,0)
+"RTN","C0CFM3",155,0)
  N ZVARN ; IEN OF VARIABLE BEING PROCESSED
-"RTN","C0CFM3",97,0)
+"RTN","C0CFM3",156,0)
  ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
-"RTN","C0CFM3",98,0)
- S C0CFDA(C0CF,"+1,",.01)=ZTYPN
-"RTN","C0CFM3",99,0)
- S C0CFDA(C0CF,"+1,",.02)=DFN
-"RTN","C0CFM3",100,0)
- S C0CFDA(C0CF,"+1,",.03)=ZSRC
-"RTN","C0CFM3",101,0)
- S C0CFDA(C0CF,"+1,",.04)=" "_ZOCC ;CREATE OCCURANCE with leading space
-"RTN","C0CFM3",102,0)
- D UPDIE ; CREATE THE RECORD
-"RTN","C0CFM3",103,0)
- S C0CIEN=$O(^C0CE4("C",DFN,ZSRC,ZTYPN," "_ZOCC,""))
-"RTN","C0CFM3",104,0)
- N ZCNT,ZC0CI,ZVARN,C0CZ1
-"RTN","C0CFM3",105,0)
+"RTN","C0CFM3",157,0)
+ K C0CFDA
+"RTN","C0CFM3",158,0)
+ S C0CFDA(ZF,"?+1,",.01)=DFN
+"RTN","C0CFM3",159,0)
+ S C0CFDA(ZF,"?+1,",.02)=ZSRC
+"RTN","C0CFM3",160,0)
+ S C0CFDA(ZF,"?+1,",.03)=ZTYPN
+"RTN","C0CFM3",161,0)
+ S C0CFDA(ZF,"?+1,",.04)=" "_ZOCC ;CREATE OCCURANCE
+"RTN","C0CFM3",162,0)
+ K ZERR
+"RTN","C0CFM3",163,0)
+ ;B
+"RTN","C0CFM3",164,0)
+ D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
+"RTN","C0CFM3",165,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CFM3",166,0)
+ K C0CFDA
+"RTN","C0CFM3",167,0)
+ S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,""))
+"RTN","C0CFM3",168,0)
+ W "RECORD NUMBER: ",ZD0,!
+"RTN","C0CFM3",169,0)
+ ;B
+"RTN","C0CFM3",170,0)
  S ZCNT=0
-"RTN","C0CFM3",106,0)
+"RTN","C0CFM3",171,0)
  S ZC0CI="" ;
-"RTN","C0CFM3",107,0)
+"RTN","C0CFM3",172,0)
  F  S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI=""  D  ;
-"RTN","C0CFM3",108,0)
+"RTN","C0CFM3",173,0)
  . I ZC0CI'="M" D  ; NOT A SUBVARIABLE
-"RTN","C0CFM3",109,0)
+"RTN","C0CFM3",174,0)
  . . S ZCNT=ZCNT+1 ;INCREMENT COUNT
-"RTN","C0CFM3",110,0)
+"RTN","C0CFM3",175,0)
  . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
-"RTN","C0CFM3",111,0)
+"RTN","C0CFM3",176,0)
  . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
-"RTN","C0CFM3",112,0)
- . . S C0CFDA(C0CFV,"+"_ZCNT_","_C0CIEN_",",.01)=ZVARN
-"RTN","C0CFM3",113,0)
- . . S C0CFDA(C0CFV,"+"_ZCNT_","_C0CIEN_",",1)=@ZVALS@(ZC0CI)
-"RTN","C0CFM3",114,0)
- . E  D  ; THIS IS A SUBELEMENT
-"RTN","C0CFM3",115,0)
- . . ;PUT THE FOLLOWING BACK TO USE RECURSION
-"RTN","C0CFM3",116,0)
- . . ;N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
-"RTN","C0CFM3",117,0)
- . . ;S ZZCNT=0
-"RTN","C0CFM3",118,0)
- . . ;S ZZC0CI=0
-"RTN","C0CFM3",119,0)
- . . ;S ZZVALS=$NA(@ZVALS@("M")) ; LOCATION OF THIS MULTILPE
-"RTN","C0CFM3",120,0)
- . . ;S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
-"RTN","C0CFM3",121,0)
- . . ;S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
-"RTN","C0CFM3",122,0)
- . . ;W "MULTIPLE:",ZZVALS,!
-"RTN","C0CFM3",123,0)
- . . ;B
-"RTN","C0CFM3",124,0)
- . . ;F  S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI=""  D  ; EACH MULTIPLE
-"RTN","C0CFM3",125,0)
- . . ;. S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
-"RTN","C0CFM3",126,0)
- . . ;. W "COUNT:",ZZCNT,!
-"RTN","C0CFM3",127,0)
- . . ;. S ZV=$NA(@ZZVALS@(ZZC0CI))
-"RTN","C0CFM3",128,0)
- . . ;. D PUTELS(DFN,ZT,ZOCC_";"_ZZCNT,ZV) ; PUT THIS BACK TO DEBUG RECURSION
-"RTN","C0CFM3",129,0)
- . . S C0CMDO=ZVALS ; FLAG TO HANDLE MULTIPLES (INSTEAD OF RECURSION)
-"RTN","C0CFM3",130,0)
- D UPDIE ; UPDATE
-"RTN","C0CFM3",131,0)
+"RTN","C0CFM3",177,0)
+ . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN
+"RTN","C0CFM3",178,0)
+ . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI)
+"RTN","C0CFM3",179,0)
+ . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN
+"RTN","C0CFM3",180,0)
+ . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI)
+"RTN","C0CFM3",181,0)
+ ;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT"
+"RTN","C0CFM3",182,0)
+ ;S GT1(170,"?+1,",12)="DIR"
+"RTN","C0CFM3",183,0)
+ ;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT"
+"RTN","C0CFM3",184,0)
+ ;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
+"RTN","C0CFM3",185,0)
+ D CLEAN^DILF
+"RTN","C0CFM3",186,0)
+ D UPDATE^DIE("","C0CFDA","","ZERR")
+"RTN","C0CFM3",187,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CFM3",188,0)
+ K C0CFDA
+"RTN","C0CFM3",189,0)
  Q
-"RTN","C0CFM3",132,0)
- ;
-"RTN","C0CFM3",133,0)
-UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
-"RTN","C0CFM3",134,0)
- K ZERR
-"RTN","C0CFM3",135,0)
- D CLEAN^DILF
-"RTN","C0CFM3",136,0)
- D UPDATE^DIE("","C0CFDA","","ZERR")
-"RTN","C0CFM3",137,0)
- I $D(ZERR) D  ;
-"RTN","C0CFM3",138,0)
- . W "ERROR",!
-"RTN","C0CFM3",139,0)
- . ZWR ZERR
-"RTN","C0CFM3",140,0)
- . B
-"RTN","C0CFM3",141,0)
- K C0CFDA
-"RTN","C0CFM3",142,0)
+"RTN","C0CFM3",190,0)
+ ;
+"RTN","C0CFM3",191,0)
+VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
+"RTN","C0CFM3",192,0)
+ ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
+"RTN","C0CFM3",193,0)
+ ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
+"RTN","C0CFM3",194,0)
+ ;
+"RTN","C0CFM3",195,0)
+ N ZCCRD,ZVARN,C0CFDA2
+"RTN","C0CFM3",196,0)
+ S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
+"RTN","C0CFM3",197,0)
+ S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
+"RTN","C0CFM3",198,0)
+ I ZVARN="" D  ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
+"RTN","C0CFM3",199,0)
+ . I '$D(ZTYP) D  Q  ; WON'T ADD A VARIABLE WITHOUT A TYPE
+"RTN","C0CFM3",200,0)
+ . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
+"RTN","C0CFM3",201,0)
+ . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
+"RTN","C0CFM3",202,0)
+ . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
+"RTN","C0CFM3",203,0)
+ . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
+"RTN","C0CFM3",204,0)
+ . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
+"RTN","C0CFM3",205,0)
+ . I $D(ZERR) D  ; LAYGO ERROR
+"RTN","C0CFM3",206,0)
+ . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
+"RTN","C0CFM3",207,0)
+ . E  D  ;
+"RTN","C0CFM3",208,0)
+ . . D CLEAN^DILF ; CLEAN UP
+"RTN","C0CFM3",209,0)
+ . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
+"RTN","C0CFM3",210,0)
+ . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
+"RTN","C0CFM3",211,0)
+ Q ZVARN
+"RTN","C0CFM3",212,0)
+ ;
+"RTN","C0CFM3",213,0)
+BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,)
+"RTN","C0CFM3",214,0)
+ ; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED
+"RTN","C0CFM3",215,0)
+ ;
+"RTN","C0CFM3",216,0)
+ N C0CDIC,C0CNODE ;
+"RTN","C0CFM3",217,0)
+ S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY
+"RTN","C0CFM3",218,0)
+ S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE
+"RTN","C0CFM3",219,0)
  Q
-"RTN","C0CFM3",143,0)
- ;
-"RTN","C0CFM3",144,0)
-PUTELSOLD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
-"RTN","C0CFM3",145,0)
- ; 171.101, ^C0CE  DFN IS THE PATIENT IEN PASSED BY VALUE
-"RTN","C0CFM3",146,0)
- ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
-"RTN","C0CFM3",147,0)
- ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
-"RTN","C0CFM3",148,0)
- ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
-"RTN","C0CFM3",149,0)
- ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
-"RTN","C0CFM3",150,0)
- ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
-"RTN","C0CFM3",151,0)
- ;
-"RTN","C0CFM3",152,0)
- S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1
-"RTN","C0CFM3",153,0)
- ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
-"RTN","C0CFM3",154,0)
- N ZF,ZFV S ZF=171.101 S ZFV=171.1011
-"RTN","C0CFM3",155,0)
- ;S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS
-"RTN","C0CFM3",156,0)
- ;N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER
-"RTN","C0CFM3",157,0)
- N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
-"RTN","C0CFM3",158,0)
- W "ZTYPE: ",ZTYPE," ",ZTYPN,!
-"RTN","C0CFM3",159,0)
- N ZVARN ; IEN OF VARIABLE BEING PROCESSED
-"RTN","C0CFM3",160,0)
- ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
-"RTN","C0CFM3",161,0)
- K C0CFDA
-"RTN","C0CFM3",162,0)
- S C0CFDA(ZF,"?+1,",.01)=DFN
-"RTN","C0CFM3",163,0)
- S C0CFDA(ZF,"?+1,",.02)=ZSRC
-"RTN","C0CFM3",164,0)
- S C0CFDA(ZF,"?+1,",.03)=ZTYPN
-"RTN","C0CFM3",165,0)
- S C0CFDA(ZF,"?+1,",.04)=" "_ZOCC ;CREATE OCCURANCE
-"RTN","C0CFM3",166,0)
- K ZERR
-"RTN","C0CFM3",167,0)
- ;B
-"RTN","C0CFM3",168,0)
- D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
-"RTN","C0CFM3",169,0)
- I $D(ZERR) B  ;OOPS
-"RTN","C0CFM3",170,0)
- K C0CFDA
-"RTN","C0CFM3",171,0)
- S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,""))
-"RTN","C0CFM3",172,0)
- W "RECORD NUMBER: ",ZD0,!
-"RTN","C0CFM3",173,0)
- ;B
-"RTN","C0CFM3",174,0)
- S ZCNT=0
-"RTN","C0CFM3",175,0)
- S ZC0CI="" ;
-"RTN","C0CFM3",176,0)
- F  S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI=""  D  ;
-"RTN","C0CFM3",177,0)
- . I ZC0CI'="M" D  ; NOT A SUBVARIABLE
-"RTN","C0CFM3",178,0)
- . . S ZCNT=ZCNT+1 ;INCREMENT COUNT
-"RTN","C0CFM3",179,0)
- . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
-"RTN","C0CFM3",180,0)
- . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
-"RTN","C0CFM3",181,0)
- . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN
-"RTN","C0CFM3",182,0)
- . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI)
-"RTN","C0CFM3",183,0)
- . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN
-"RTN","C0CFM3",184,0)
- . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI)
-"RTN","C0CFM3",185,0)
- ;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT"
-"RTN","C0CFM3",186,0)
- ;S GT1(170,"?+1,",12)="DIR"
-"RTN","C0CFM3",187,0)
- ;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT"
-"RTN","C0CFM3",188,0)
- ;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
-"RTN","C0CFM3",189,0)
- D CLEAN^DILF
-"RTN","C0CFM3",190,0)
- D UPDATE^DIE("","C0CFDA","","ZERR")
-"RTN","C0CFM3",191,0)
- I $D(ZERR) D  ;
-"RTN","C0CFM3",192,0)
- . W "ERROR",!
-"RTN","C0CFM3",193,0)
- . ZWR ZERR
-"RTN","C0CFM3",194,0)
- . B
-"RTN","C0CFM3",195,0)
- K C0CFDA
-"RTN","C0CFM3",196,0)
+"RTN","C0CFM3",220,0)
+ ;
+"RTN","C0CFM3",221,0)
+FIXSEC ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED
+"RTN","C0CFM3",222,0)
+ ; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET
+"RTN","C0CFM3",223,0)
+ ; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS
+"RTN","C0CFM3",224,0)
+ ; CONVERSION
+"RTN","C0CFM3",225,0)
+ ;N C0CC,C0CI,C0CJ,C0CN,C0CZX
+"RTN","C0CFM3",226,0)
+ D FIELDS^C0CRNF("C0CC",170)
+"RTN","C0CFM3",227,0)
+ S C0CI=""
+"RTN","C0CFM3",228,0)
+ F  S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI=""  D  ; EACH SECTION
+"RTN","C0CFM3",229,0)
+ . S C0CZX=""
+"RTN","C0CFM3",230,0)
+ . F  S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX=""  D  ; EACH VARIABLE
+"RTN","C0CFM3",231,0)
+ . . W "SECTION ",C0CI," VAR ",C0CZX
+"RTN","C0CFM3",232,0)
+ . . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,""))
+"RTN","C0CFM3",233,0)
+ . . W " TYPE: ",C0CV,!
+"RTN","C0CFM3",234,0)
+ . . D SETFDA("SECTION",C0CV)
+"RTN","C0CFM3",235,0)
+ . . ;ZWR C0CFDA
+"RTN","C0CFM3",236,0)
  Q
-"RTN","C0CFM3",197,0)
- ;
-"RTN","C0CFM3",198,0)
-VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
-"RTN","C0CFM3",199,0)
- ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
-"RTN","C0CFM3",200,0)
- ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
-"RTN","C0CFM3",201,0)
- ;
-"RTN","C0CFM3",202,0)
- N ZCCRD,ZVARN,C0CFDA2
-"RTN","C0CFM3",203,0)
- S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
-"RTN","C0CFM3",204,0)
- S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
-"RTN","C0CFM3",205,0)
- I ZVARN="" D  ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
-"RTN","C0CFM3",206,0)
- . I '$D(ZTYP) D  Q  ; WON'T ADD A VARIABLE WITHOUT A TYPE
-"RTN","C0CFM3",207,0)
- . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
-"RTN","C0CFM3",208,0)
- . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
-"RTN","C0CFM3",209,0)
- . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
-"RTN","C0CFM3",210,0)
- . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
-"RTN","C0CFM3",211,0)
- . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
-"RTN","C0CFM3",212,0)
- . I $D(ZERR) D  ; LAYGO ERROR
-"RTN","C0CFM3",213,0)
- . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
-"RTN","C0CFM3",214,0)
- . E  D  ;
-"RTN","C0CFM3",215,0)
- . . D CLEAN^DILF ; CLEAN UP
-"RTN","C0CFM3",216,0)
- . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
-"RTN","C0CFM3",217,0)
- . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
-"RTN","C0CFM3",218,0)
- Q ZVARN
-"RTN","C0CFM3",219,0)
- ;
-"RTN","C0CFM3",220,0)
-BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,)
-"RTN","C0CFM3",221,0)
- ; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED
-"RTN","C0CFM3",222,0)
- ;
-"RTN","C0CFM3",223,0)
- N C0CDIC,C0CNODE ;
-"RTN","C0CFM3",224,0)
- S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY
-"RTN","C0CFM3",225,0)
- S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE
-"RTN","C0CFM3",226,0)
+"RTN","C0CFM3",237,0)
+ ;
+"RTN","C0CFM3",238,0)
+SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
+"RTN","C0CFM3",239,0)
+ ; TO SET TO VALUE C0CSV.
+"RTN","C0CFM3",240,0)
+ ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
+"RTN","C0CFM3",241,0)
+ ; C0CSN,C0CSV ARE PASSED BY VALUE
+"RTN","C0CFM3",242,0)
+ ;
+"RTN","C0CFM3",243,0)
+ N C0CSI,C0CSJ
+"RTN","C0CFM3",244,0)
+ S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
+"RTN","C0CFM3",245,0)
+ S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
+"RTN","C0CFM3",246,0)
+ S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
+"RTN","C0CFM3",247,0)
  Q
-"RTN","C0CFM3",227,0)
- ;
-"RTN","C0CFM3",228,0)
-FIXSEC ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED
-"RTN","C0CFM3",229,0)
- ; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET
-"RTN","C0CFM3",230,0)
- ; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS
-"RTN","C0CFM3",231,0)
- ; CONVERSION
-"RTN","C0CFM3",232,0)
- ;N C0CC,C0CI,C0CJ,C0CN,C0CZX
-"RTN","C0CFM3",233,0)
- D FIELDS^C0CRNF("C0CC",170)
-"RTN","C0CFM3",234,0)
- S C0CI=""
-"RTN","C0CFM3",235,0)
- F  S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI=""  D  ; EACH SECTION
-"RTN","C0CFM3",236,0)
- . S C0CZX=""
-"RTN","C0CFM3",237,0)
- . F  S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX=""  D  ; EACH VARIABLE
-"RTN","C0CFM3",238,0)
- . . W "SECTION ",C0CI," VAR ",C0CZX
-"RTN","C0CFM3",239,0)
- . . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,""))
-"RTN","C0CFM3",240,0)
- . . W " TYPE: ",C0CV,!
-"RTN","C0CFM3",241,0)
- . . D SETFDA("SECTION",C0CV)
-"RTN","C0CFM3",242,0)
- . . ;ZWR C0CFDA
-"RTN","C0CFM3",243,0)
+"RTN","C0CFM3",248,0)
+ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
+"RTN","C0CFM3",249,0)
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
+"RTN","C0CFM3",250,0)
+ ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
+"RTN","C0CFM3",251,0)
+ I '$D(ZTAB) S ZTAB="C0CA"
+"RTN","C0CFM3",252,0)
+ N ZR
+"RTN","C0CFM3",253,0)
+ I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
+"RTN","C0CFM3",254,0)
+ E  S ZR=""
+"RTN","C0CFM3",255,0)
+ Q ZR
+"RTN","C0CFM3",256,0)
+ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
+"RTN","C0CFM3",257,0)
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
+"RTN","C0CFM3",258,0)
+ ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
+"RTN","C0CFM3",259,0)
+ I '$D(ZTAB) S ZTAB="C0CA"
+"RTN","C0CFM3",260,0)
+ N ZR
+"RTN","C0CFM3",261,0)
+ I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
+"RTN","C0CFM3",262,0)
+ E  S ZR=""
+"RTN","C0CFM3",263,0)
+ Q ZR
+"RTN","C0CFM3",264,0)
+ ;
+"RTN","C0CFM3",265,0)
+ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
+"RTN","C0CFM3",266,0)
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
+"RTN","C0CFM3",267,0)
+ ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
+"RTN","C0CFM3",268,0)
+ I '$D(ZTAB) S ZTAB="C0CA"
+"RTN","C0CFM3",269,0)
+ N ZR
+"RTN","C0CFM3",270,0)
+ I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
+"RTN","C0CFM3",271,0)
+ E  S ZR=""
+"RTN","C0CFM3",272,0)
+ Q ZR
+"RTN","C0CFM3",273,0)
+ ;
+"RTN","C0CFM3",274,0)
+SHOWE4(DFN) ;
+"RTN","C0CFM3",275,0)
+ ;
+"RTN","C0CFM3",276,0)
+ N ZG
+"RTN","C0CFM3",277,0)
+ S ZG=""
+"RTN","C0CFM3",278,0)
+ F  S ZG=$O(^C0CE4("P",DFN,ZG)) Q:ZG=""  D
+"RTN","C0CFM3",279,0)
+ . ; ZWR ^C0CE4(ZG,*)
+"RTN","C0CFM3",280,0)
  Q
-"RTN","C0CFM3",244,0)
- ;
-"RTN","C0CFM3",245,0)
-SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
-"RTN","C0CFM3",246,0)
- ; TO SET TO VALUE C0CSV.
-"RTN","C0CFM3",247,0)
- ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
-"RTN","C0CFM3",248,0)
- ; C0CSN,C0CSV ARE PASSED BY VALUE
-"RTN","C0CFM3",249,0)
- ;
-"RTN","C0CFM3",250,0)
- N C0CSI,C0CSJ
-"RTN","C0CFM3",251,0)
- S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
-"RTN","C0CFM3",252,0)
- S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
-"RTN","C0CFM3",253,0)
- S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
-"RTN","C0CFM3",254,0)
- Q
-"RTN","C0CFM3",255,0)
-ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
-"RTN","C0CFM3",256,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
-"RTN","C0CFM3",257,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CFM3",258,0)
- I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CFM3",259,0)
- N ZR
-"RTN","C0CFM3",260,0)
- I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
-"RTN","C0CFM3",261,0)
- E  S ZR=""
-"RTN","C0CFM3",262,0)
- Q ZR
-"RTN","C0CFM3",263,0)
-ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
-"RTN","C0CFM3",264,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
-"RTN","C0CFM3",265,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CFM3",266,0)
- I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CFM3",267,0)
- N ZR
-"RTN","C0CFM3",268,0)
- I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
-"RTN","C0CFM3",269,0)
- E  S ZR=""
-"RTN","C0CFM3",270,0)
- Q ZR
-"RTN","C0CFM3",271,0)
- ;
-"RTN","C0CFM3",272,0)
-ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
-"RTN","C0CFM3",273,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
-"RTN","C0CFM3",274,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CFM3",275,0)
- I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CFM3",276,0)
- N ZR
-"RTN","C0CFM3",277,0)
- I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
-"RTN","C0CFM3",278,0)
- E  S ZR=""
-"RTN","C0CFM3",279,0)
- Q ZR
-"RTN","C0CFM3",280,0)
- ;
 "RTN","C0CFM3",281,0)
-SHOWE4(DFN) ;
-"RTN","C0CFM3",282,0)
- ;
-"RTN","C0CFM3",283,0)
- N ZG
-"RTN","C0CFM3",284,0)
- S ZG=""
-"RTN","C0CFM3",285,0)
- F  S ZG=$O(^C0CE4("P",DFN,ZG)) Q:ZG=""  D  ZWR ^C0CE4(ZG,*)
-"RTN","C0CFM3",286,0)
- Q
-"RTN","C0CFM3",287,0)
  ;
 "RTN","C0CIM2")
-0^67^B20157375
+0^67^B19669149
 "RTN","C0CIM2",1,0)
 C0CIM2  ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 01/27/10
 "RTN","C0CIM2",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CIM2",3,0)
  ;Copyright 2010 George Lilly, University of Minnesota and others.
 "RTN","C0CIM2",4,0)
- ;Licensed under the terms of the GNU General Public License.
+ ;
 "RTN","C0CIM2",5,0)
- ;See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CIM2",6,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CIM2",7,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CIM2",8,0)
- ;it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CIM2",9,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CIM2",10,0)
- ;(at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CIM2",11,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CIM2",12,0)
- ;This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CIM2",13,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CIM2",14,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CIM2",15,0)
- ;GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CIM2",16,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CIM2",17,0)
- ;You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CIM2",18,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ W "NO ENTRY FROM TOP",!
 "RTN","C0CIM2",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ Q
 "RTN","C0CIM2",20,0)
  ;
 "RTN","C0CIM2",21,0)
- W "NO ENTRY FROM TOP",!
+EXTRACT(IMMXML,DFN,IMMOUT) ; EXTRACT PROCEDURES INTO XML TEMPLATE
 "RTN","C0CIM2",22,0)
+ ; IMMXML AND IMMOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","C0CIM2",23,0)
+ ;
+"RTN","C0CIM2",24,0)
+ ; USE THE FOLLOWING TEMPLATE FOR THE RNF2 ARRAYS
+"RTN","C0CIM2",25,0)
+ ; THAT GET PASSED TO *GET ROUTINES
+"RTN","C0CIM2",26,0)
+ ;C0C[NAME]=$NA(^TMP("C0CCCR",$J,DFN,"C0C(NAME))
+"RTN","C0CIM2",27,0)
+ N C0CIMM
+"RTN","C0CIM2",28,0)
+ S C0CIMM=$NA(^TMP("C0CCCR",$J,DFN,"C0CIMM"))
+"RTN","C0CIM2",29,0)
+ ; USE THE FOLLOWING TEMPLATE FOR GETTING/GENERATING THE RNF2 ARRAYS
+"RTN","C0CIM2",30,0)
+ ; THAT GET INSERTED INTO THE XML TEMPLATE
+"RTN","C0CIM2",31,0)
+ ; I '$D(@C0CIMM) D GET[VISTA/RPMS](DFN,C0CIMM) ; GET VARS IF NOT THERE
+"RTN","C0CIM2",32,0)
+ D GETRPMS(DFN,C0CIMM) ; GET VARS IF NOT THERE
+"RTN","C0CIM2",33,0)
+ ; USE THE FOLLOWING TEMPATE FOR MAPPING RNF2 ARRAYS TO XML TEMPLATE
+"RTN","C0CIM2",34,0)
+ ; D MAP([NAME]XML,C0C[NAME],[NAME]OUT) ;MAP RESULTS FOR PROCEDURES
+"RTN","C0CIM2",35,0)
+ D MAP(IMMXML,C0CIMM,IMMOUT) ;MAP RESULTS FOR PROCEDURES
+"RTN","C0CIM2",36,0)
  Q
-"RTN","C0CIM2",23,0)
- ;
-"RTN","C0CIM2",24,0)
-EXTRACT(IMMXML,DFN,IMMOUT) ; EXTRACT PROCEDURES INTO XML TEMPLATE
-"RTN","C0CIM2",25,0)
- ; IMMXML AND IMMOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","C0CIM2",26,0)
- ;
-"RTN","C0CIM2",27,0)
- ; USE THE FOLLOWING TEMPLATE FOR THE RNF2 ARRAYS
-"RTN","C0CIM2",28,0)
- ; THAT GET PASSED TO *GET ROUTINES
-"RTN","C0CIM2",29,0)
- ;C0C[NAME]=$NA(^TMP("C0CCCR",$J,DFN,"C0C(NAME))
-"RTN","C0CIM2",30,0)
- N C0CIMM
-"RTN","C0CIM2",31,0)
- S C0CIMM=$NA(^TMP("C0CCCR",$J,DFN,"C0CIMM"))
-"RTN","C0CIM2",32,0)
- ; USE THE FOLLOWING TEMPLATE FOR GETTING/GENERATING THE RNF2 ARRAYS
-"RTN","C0CIM2",33,0)
- ; THAT GET INSERTED INTO THE XML TEMPLATE
-"RTN","C0CIM2",34,0)
- ; I '$D(@C0CIMM) D GET[VISTA/RPMS](DFN,C0CIMM) ; GET VARS IF NOT THERE
-"RTN","C0CIM2",35,0)
- D GETRPMS(DFN,C0CIMM) ; GET VARS IF NOT THERE
-"RTN","C0CIM2",36,0)
- ; USE THE FOLLOWING TEMPATE FOR MAPPING RNF2 ARRAYS TO XML TEMPLATE
 "RTN","C0CIM2",37,0)
- ; D MAP([NAME]XML,C0C[NAME],[NAME]OUT) ;MAP RESULTS FOR PROCEDURES
+ ;
 "RTN","C0CIM2",38,0)
- D MAP(IMMXML,C0CIMM,IMMOUT) ;MAP RESULTS FOR PROCEDURES
+GETRPMS(DFN,C0CIMM) ; CALLS GET^BGOVIMM TO GET IMMUNIZATIONS. 
 "RTN","C0CIM2",39,0)
+ ; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
+"RTN","C0CIM2",40,0)
+ ; C0CIMM: IMMUNIZATIONS
+"RTN","C0CIM2",41,0)
+ ; READY TO BE MAPPED TO XML BY MAP^C0CIMM
+"RTN","C0CIM2",42,0)
+ ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY 
+"RTN","C0CIM2",43,0)
+ ; EXIST.
+"RTN","C0CIM2",44,0)
+ ;
+"RTN","C0CIM2",45,0)
+ ; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J))
+"RTN","C0CIM2",46,0)
+ ;
+"RTN","C0CIM2",47,0)
+ ; SETUP RPC/API CALL HERE
+"RTN","C0CIM2",48,0)
+ ; USE START AND END DATES FROM PARAMETERS IF REQUIRED
+"RTN","C0CIM2",49,0)
+ N IMMA
+"RTN","C0CIM2",50,0)
+ D GET^BGOVIMM(.IMMA,DFN) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE
+"RTN","C0CIM2",51,0)
+ ; PREFORM SORT HERE IF NEEDED
+"RTN","C0CIM2",52,0)
+ ;
+"RTN","C0CIM2",53,0)
+ ; NO SORT REQUIRED FOR IMMUNIZATIONS
+"RTN","C0CIM2",54,0)
+ ;
+"RTN","C0CIM2",55,0)
+ ; MAP EACH ROW OF RPC/API TO RNF1 ARRAY
+"RTN","C0CIM2",56,0)
+ ; RNF1 ARRAY FORMAT:
+"RTN","C0CIM2",57,0)
+ ; VAR("NAME_OF_RIM_VARIABLE")=VALUE
+"RTN","C0CIM2",58,0)
+ ;
+"RTN","C0CIM2",59,0)
+ ; IMMUNIZATIONS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF IMMUNIZATION RESULTS
+"RTN","C0CIM2",60,0)
+ ; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD
+"RTN","C0CIM2",61,0)
+ ; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS
+"RTN","C0CIM2",62,0)
+ N C0CIM,C0CC,ZRNF
+"RTN","C0CIM2",63,0)
+ S C0CIM="" ; INITIALIZE FOR $O
+"RTN","C0CIM2",64,0)
+ F C0CC=1:1 S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM=""  D  ; FOR EACH IMMUNE TYPE IN THE LIST
+"RTN","C0CIM2",65,0)
+ . I DEBUG W @IMMA@(C0CIM),!
+"RTN","C0CIM2",66,0)
+ . ; FIGURE OUT WHICH TYPE OF IMMUNIZATION IT IS (IMMUNIZATION, FORECAST, CONTRAINDICATIONS, REFUSALS)
+"RTN","C0CIM2",67,0)
+ . D:$P(@IMMA@(C0CIM),U,1)="I" IMMUN
+"RTN","C0CIM2",68,0)
+ . D:$P(@IMMA@(C0CIM),U,1)="F" FORECAST
+"RTN","C0CIM2",69,0)
+ . D:$P(@IMMA@(C0CIM),U,1)="C" CONTRA
+"RTN","C0CIM2",70,0)
+ . D:$P(@IMMA@(C0CIM),U,1)="R" REFUSE
+"RTN","C0CIM2",71,0)
+ . D RNF1TO2^C0CRNF(C0CIMM,"ZRNF") ;ADD THIS ROW TO THE ARRAY
+"RTN","C0CIM2",72,0)
+ . K ZRNF
+"RTN","C0CIM2",73,0)
+ ; SAVE RIM VARIABLES SEE C0CRIMA
+"RTN","C0CIM2",74,0)
+ N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE"))
+"RTN","C0CIM2",75,0)
+ M @ZRIM=@C0CIMM@("V")
+"RTN","C0CIM2",76,0)
  Q
-"RTN","C0CIM2",40,0)
- ;
-"RTN","C0CIM2",41,0)
-GETRPMS(DFN,C0CIMM) ; CALLS GET^BGOVIMM TO GET IMMUNIZATIONS. 
-"RTN","C0CIM2",42,0)
- ; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
-"RTN","C0CIM2",43,0)
- ; C0CIMM: IMMUNIZATIONS
-"RTN","C0CIM2",44,0)
- ; READY TO BE MAPPED TO XML BY MAP^C0CIMM
-"RTN","C0CIM2",45,0)
- ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY 
-"RTN","C0CIM2",46,0)
- ; EXIST.
-"RTN","C0CIM2",47,0)
- ;
-"RTN","C0CIM2",48,0)
- ; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J))
-"RTN","C0CIM2",49,0)
- ;
-"RTN","C0CIM2",50,0)
- ; SETUP RPC/API CALL HERE
-"RTN","C0CIM2",51,0)
- ; USE START AND END DATES FROM PARAMETERS IF REQUIRED
-"RTN","C0CIM2",52,0)
- N IMMA
-"RTN","C0CIM2",53,0)
- D GET^BGOVIMM(.IMMA,DFN) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE
-"RTN","C0CIM2",54,0)
- ; PREFORM SORT HERE IF NEEDED
-"RTN","C0CIM2",55,0)
- ;
-"RTN","C0CIM2",56,0)
- ; NO SORT REQUIRED FOR IMMUNIZATIONS
-"RTN","C0CIM2",57,0)
- ;
-"RTN","C0CIM2",58,0)
- ; MAP EACH ROW OF RPC/API TO RNF1 ARRAY
-"RTN","C0CIM2",59,0)
- ; RNF1 ARRAY FORMAT:
-"RTN","C0CIM2",60,0)
- ; VAR("NAME_OF_RIM_VARIABLE")=VALUE
-"RTN","C0CIM2",61,0)
- ;
-"RTN","C0CIM2",62,0)
- ; IMMUNIZATIONS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF IMMUNIZATION RESULTS
-"RTN","C0CIM2",63,0)
- ; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD
-"RTN","C0CIM2",64,0)
- ; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS
-"RTN","C0CIM2",65,0)
- N C0CIM,C0CC,ZRNF
-"RTN","C0CIM2",66,0)
- S C0CIM="" ; INITIALIZE FOR $O
-"RTN","C0CIM2",67,0)
- F C0CC=1:1 S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM=""  D  ; FOR EACH IMMUNE TYPE IN THE LIST
-"RTN","C0CIM2",68,0)
- . I DEBUG W @IMMA@(C0CIM),!
-"RTN","C0CIM2",69,0)
- . ; FIGURE OUT WHICH TYPE OF IMMUNIZATION IT IS (IMMUNIZATION, FORECAST, CONTRAINDICATIONS, REFUSALS)
-"RTN","C0CIM2",70,0)
- . D:$P(@IMMA@(C0CIM),U,1)="I" IMMUN
-"RTN","C0CIM2",71,0)
- . D:$P(@IMMA@(C0CIM),U,1)="F" FORECAST
-"RTN","C0CIM2",72,0)
- . D:$P(@IMMA@(C0CIM),U,1)="C" CONTRA
-"RTN","C0CIM2",73,0)
- . D:$P(@IMMA@(C0CIM),U,1)="R" REFUSE
-"RTN","C0CIM2",74,0)
- . D RNF1TO2^C0CRNF(C0CIMM,"ZRNF") ;ADD THIS ROW TO THE ARRAY
-"RTN","C0CIM2",75,0)
- . K ZRNF
-"RTN","C0CIM2",76,0)
- ; SAVE RIM VARIABLES SEE C0CRIMA
 "RTN","C0CIM2",77,0)
- N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE"))
+ ;
 "RTN","C0CIM2",78,0)
- M @ZRIM=@C0CIMM@("V")
+IMMUN ; PARSES IMMUNIZATION TYPE ROWS FOR RPMS
 "RTN","C0CIM2",79,0)
+ ; RPC FORMAT
+"RTN","C0CIM2",80,0)
+ ;    I ^ Imm Name [2] ^ Visit Date [3] ^ V File IEN [4] ^ Other Location [5] ^ Group [6] ^ Imm IEN [7] ^ Lot [8] ^
+"RTN","C0CIM2",81,0)
+ ;     Reaction [9] ^ VIS Date [10] ^ Age [11] ^ Visit Date [12] ^ Provider IEN~Name [13] ^ Inj Site [14] ^
+"RTN","C0CIM2",82,0)
+ ;     Volume [15] ^ Visit IEN [16] ^ Visit Category [17] ^ Full Name [18] ^ Location IEN~Name [19] ^ Visit Locked [20]
+"RTN","C0CIM2",83,0)
+ ; RETRIEVE IMMUNIZATION RECORD FROM IMMUNIZATION FILE (9999999.14) FOR THIS IMMUNIZATION
+"RTN","C0CIM2",84,0)
+ D GETN^C0CRNF("C0CZIM",9999999.14,$P(@IMMA@(C0CIM),U,7)) ; GET IMMUNIZATION RECORD
+"RTN","C0CIM2",85,0)
+ ; RETIREVE IMMUNIZATION RECORD FROM V IMMUNIZATION FILE (9000010.11) FOR THIS IMMUNIZATION
+"RTN","C0CIM2",86,0)
+ D GETN^C0CRNF("C0CZVI",9000010.11,$P(@IMMA@(C0CIM),U,4)) ; GET V IMMUNIZATION RECORD
+"RTN","C0CIM2",87,0)
+ S ZRNF("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID
+"RTN","C0CIM2",88,0)
+ S ZRNF("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME
+"RTN","C0CIM2",89,0)
+ S ZRNF("IMMUNEDATETIME")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("EVENT DATE AND TIME","C0CZVI"),"DT")
+"RTN","C0CIM2",90,0)
+ S ZRNF("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_$P($P(@IMMA@(C0CIM),U,13),"~",1)
+"RTN","C0CIM2",91,0)
+ S ZRNF("IMMUNEPRODUCTNAMETEXT")=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD
+"RTN","C0CIM2",92,0)
+ S ZRNF("IMMUNEPRODUCTCODE")=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE
+"RTN","C0CIM2",93,0)
+ I $$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM")'="" S ZRNF("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code"
+"RTN","C0CIM2",94,0)
+ E  S ZRNF("IMMUNEPRODUCTCODESYSTEM")="" ;NULL
+"RTN","C0CIM2",95,0)
+ ;CLEANUP FROM C0CRNF CALLS
+"RTN","C0CIM2",96,0)
+ K C0CZIM,C0CZVI
+"RTN","C0CIM2",97,0)
  Q
-"RTN","C0CIM2",80,0)
- ;
-"RTN","C0CIM2",81,0)
-IMMUN ; PARSES IMMUNIZATION TYPE ROWS FOR RPMS
-"RTN","C0CIM2",82,0)
- ; RPC FORMAT
-"RTN","C0CIM2",83,0)
- ;    I ^ Imm Name [2] ^ Visit Date [3] ^ V File IEN [4] ^ Other Location [5] ^ Group [6] ^ Imm IEN [7] ^ Lot [8] ^
-"RTN","C0CIM2",84,0)
- ;     Reaction [9] ^ VIS Date [10] ^ Age [11] ^ Visit Date [12] ^ Provider IEN~Name [13] ^ Inj Site [14] ^
-"RTN","C0CIM2",85,0)
- ;     Volume [15] ^ Visit IEN [16] ^ Visit Category [17] ^ Full Name [18] ^ Location IEN~Name [19] ^ Visit Locked [20]
-"RTN","C0CIM2",86,0)
- ; RETRIEVE IMMUNIZATION RECORD FROM IMMUNIZATION FILE (9999999.14) FOR THIS IMMUNIZATION
-"RTN","C0CIM2",87,0)
- D GETN^C0CRNF("C0CZIM",9999999.14,$P(@IMMA@(C0CIM),U,7)) ; GET IMMUNIZATION RECORD
-"RTN","C0CIM2",88,0)
- ; RETIREVE IMMUNIZATION RECORD FROM V IMMUNIZATION FILE (9000010.11) FOR THIS IMMUNIZATION
-"RTN","C0CIM2",89,0)
- D GETN^C0CRNF("C0CZVI",9000010.11,$P(@IMMA@(C0CIM),U,4)) ; GET V IMMUNIZATION RECORD
-"RTN","C0CIM2",90,0)
- S ZRNF("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID
-"RTN","C0CIM2",91,0)
- S ZRNF("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME
-"RTN","C0CIM2",92,0)
- S ZRNF("IMMUNEDATETIME")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("EVENT DATE AND TIME","C0CZVI"),"DT")
-"RTN","C0CIM2",93,0)
- S ZRNF("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_$P($P(@IMMA@(C0CIM),U,13),"~",1)
-"RTN","C0CIM2",94,0)
- S ZRNF("IMMUNEPRODUCTNAMETEXT")=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD
-"RTN","C0CIM2",95,0)
- S ZRNF("IMMUNEPRODUCTCODE")=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE
-"RTN","C0CIM2",96,0)
- I $$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM")'="" S ZRNF("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code"
-"RTN","C0CIM2",97,0)
- E  S ZRNF("IMMUNEPRODUCTCODESYSTEM")="" ;NULL
 "RTN","C0CIM2",98,0)
- ;CLEANUP FROM C0CRNF CALLS
+FORECAST ; PARSES FORECAST TYPE ROWS FOR RPMS
 "RTN","C0CIM2",99,0)
- K C0CZIM,C0CZVI
+ ; CURRENTLY DISABLED
 "RTN","C0CIM2",100,0)
  Q
 "RTN","C0CIM2",101,0)
-FORECAST ; PARSES FORECAST TYPE ROWS FOR RPMS
+CONTRA ; PARSES FORECAST TYPE ROWS FOR RPMS
 "RTN","C0CIM2",102,0)
  ; CURRENTLY DISABLED
@@ -100974,5 +100982,5 @@
  Q
 "RTN","C0CIM2",104,0)
-CONTRA ; PARSES FORECAST TYPE ROWS FOR RPMS
+REFUSE ; PARSES FORECAST TYPE ROWS FOR RPMS
 "RTN","C0CIM2",105,0)
  ; CURRENTLY DISABLED
@@ -100980,2327 +100988,2355 @@
  Q
 "RTN","C0CIM2",107,0)
-REFUSE ; PARSES FORECAST TYPE ROWS FOR RPMS
+ ;
 "RTN","C0CIM2",108,0)
- ; CURRENTLY DISABLED
+MAP(IMMXML,C0CIMM,IMMOUT) ; MAP IMMUNIZATION XML 
 "RTN","C0CIM2",109,0)
+ ;
+"RTN","C0CIM2",110,0)
+ N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"IMMTEMP")) ;WORK AREA FOR TEMPLATE
+"RTN","C0CIM2",111,0)
+ K @ZTEMP
+"RTN","C0CIM2",112,0)
+ N ZBLD
+"RTN","C0CIM2",113,0)
+ S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"IMMBLD")) ; BUILD LIST AREA
+"RTN","C0CIM2",114,0)
+ D QUEUE^C0CXPATH(ZBLD,IMMXML,1,1) ; FIRST LINE
+"RTN","C0CIM2",115,0)
+ N ZINNER
+"RTN","C0CIM2",116,0)
+ ; XPATH NEEDS TO MATCH YOUR SECTION
+"RTN","C0CIM2",117,0)
+ D QUERY^C0CXPATH(IMMXML,"//Immunizations/Immunization","ZINNER") ;ONE PROC
+"RTN","C0CIM2",118,0)
+ N ZTMP,ZVAR,ZI
+"RTN","C0CIM2",119,0)
+ S ZI=""
+"RTN","C0CIM2",120,0)
+ F  S ZI=$O(@C0CIMM@("V",ZI)) Q:ZI=""  D  ;FOR EACH IMMUNIZATION
+"RTN","C0CIM2",121,0)
+ . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS IMMUNIZATION XML
+"RTN","C0CIM2",122,0)
+ . S ZVAR=$NA(@C0CIMM@("V",ZI)) ;THIS IMMUNIZATION VARIABLES
+"RTN","C0CIM2",123,0)
+ . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE IMMUNIZATION
+"RTN","C0CIM2",124,0)
+ . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUEUE FOR BUILD
+"RTN","C0CIM2",125,0)
+ D QUEUE^C0CXPATH(ZBLD,IMMXML,@IMMXML@(0),@IMMXML@(0))
+"RTN","C0CIM2",126,0)
+ N ZZTMP ; IS THIS NEEDED?
+"RTN","C0CIM2",127,0)
+ D BUILD^C0CXPATH(ZBLD,IMMOUT) ;BUILD FINAL XML
+"RTN","C0CIM2",128,0)
+ K @ZTEMP,@ZBLD
+"RTN","C0CIM2",129,0)
  Q
-"RTN","C0CIM2",110,0)
- ;
-"RTN","C0CIM2",111,0)
-MAP(IMMXML,C0CIMM,IMMOUT) ; MAP IMMUNIZATION XML 
-"RTN","C0CIM2",112,0)
- ;
-"RTN","C0CIM2",113,0)
- N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"IMMTEMP")) ;WORK AREA FOR TEMPLATE
-"RTN","C0CIM2",114,0)
- K @ZTEMP
-"RTN","C0CIM2",115,0)
- N ZBLD
-"RTN","C0CIM2",116,0)
- S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"IMMBLD")) ; BUILD LIST AREA
-"RTN","C0CIM2",117,0)
- D QUEUE^C0CXPATH(ZBLD,IMMXML,1,1) ; FIRST LINE
-"RTN","C0CIM2",118,0)
- N ZINNER
-"RTN","C0CIM2",119,0)
- ; XPATH NEEDS TO MATCH YOUR SECTION
-"RTN","C0CIM2",120,0)
- D QUERY^C0CXPATH(IMMXML,"//Immunizations/Immunization","ZINNER") ;ONE PROC
-"RTN","C0CIM2",121,0)
- N ZTMP,ZVAR,ZI
-"RTN","C0CIM2",122,0)
- S ZI=""
-"RTN","C0CIM2",123,0)
- F  S ZI=$O(@C0CIMM@("V",ZI)) Q:ZI=""  D  ;FOR EACH IMMUNIZATION
-"RTN","C0CIM2",124,0)
- . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS IMMUNIZATION XML
-"RTN","C0CIM2",125,0)
- . S ZVAR=$NA(@C0CIMM@("V",ZI)) ;THIS IMMUNIZATION VARIABLES
-"RTN","C0CIM2",126,0)
- . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE IMMUNIZATION
-"RTN","C0CIM2",127,0)
- . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUEUE FOR BUILD
-"RTN","C0CIM2",128,0)
- D QUEUE^C0CXPATH(ZBLD,IMMXML,@IMMXML@(0),@IMMXML@(0))
-"RTN","C0CIM2",129,0)
- N ZZTMP ; IS THIS NEEDED?
 "RTN","C0CIM2",130,0)
- D BUILD^C0CXPATH(ZBLD,IMMOUT) ;BUILD FINAL XML
-"RTN","C0CIM2",131,0)
- K @ZTEMP,@ZBLD
-"RTN","C0CIM2",132,0)
- Q
-"RTN","C0CIM2",133,0)
  ;  
 "RTN","C0CIMMU")
-0^41^B20441765
+0^41^B19603373
 "RTN","C0CIMMU",1,0)
 C0CIMMU ; CCDCCR/GPL - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 2/2/09
 "RTN","C0CIMMU",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CIMMU",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
 "RTN","C0CIMMU",4,0)
- ;Licensed under the terms of the GNU General Public License.
+ ;
 "RTN","C0CIMMU",5,0)
- ;See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CIMMU",6,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CIMMU",7,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CIMMU",8,0)
- ;it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CIMMU",9,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CIMMU",10,0)
- ;(at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CIMMU",11,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CIMMU",12,0)
- ;This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CIMMU",13,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CIMMU",14,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CIMMU",15,0)
- ;GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CIMMU",16,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CIMMU",17,0)
- ;You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CIMMU",18,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ; PROCESS THE IMMUNIZATIONS SECTION OF THE CCR
 "RTN","C0CIMMU",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
 "RTN","C0CIMMU",20,0)
- ;
+MAP(IPXML,DFN,OUTXML) ; MAP IMMUNIZATIONS
 "RTN","C0CIMMU",21,0)
  ;
 "RTN","C0CIMMU",22,0)
- ; PROCESS THE IMMUNIZATIONS SECTION OF THE CCR
+ N C0CZV,C0CZVI ; TO STORE MAPPED VARIABLES
 "RTN","C0CIMMU",23,0)
- ;
+ N C0CZT ; TMP ARRAY OF MAPPED XML
 "RTN","C0CIMMU",24,0)
-MAP(IPXML,DFN,OUTXML) ; MAP IMMUNIZATIONS
+ S C0CZV=$NA(^TMP("C0CCCR",$J,"IMMUNE")) ; TEMP STORAGE FOR VARIABLES
 "RTN","C0CIMMU",25,0)
- ;
+ D EXTRACT(IPXML,DFN,OUTXML) ;EXTRACT THE VARIABLES
 "RTN","C0CIMMU",26,0)
- N C0CZV,C0CZVI ; TO STORE MAPPED VARIABLES
+ N C0CZI,C0CZIC ; COUNT OF IMMUNIZATIONS
 "RTN","C0CIMMU",27,0)
- N C0CZT ; TMP ARRAY OF MAPPED XML
+ S C0CZIC=$G(@C0CZV@(0)) ; TOTAL FROM VARIABLE ARRAY
 "RTN","C0CIMMU",28,0)
- S C0CZV=$NA(^TMP("C0CCCR",$J,"IMMUNE")) ; TEMP STORAGE FOR VARIABLES
+ I C0CZIC>0 D  ;IMMUNIZATIONS FOUND
 "RTN","C0CIMMU",29,0)
- D EXTRACT(IPXML,DFN,OUTXML) ;EXTRACT THE VARIABLES
+ . F C0CZI=1:1:C0CZIC D  ;FOR EACH IMMUNIZATION
 "RTN","C0CIMMU",30,0)
- N C0CZI,C0CZIC ; COUNT OF IMMUNIZATIONS
+ . . S C0CZVI=$NA(@C0CZV@(C0CZI)) ;THIS IMMUNIZATION
 "RTN","C0CIMMU",31,0)
- S C0CZIC=$G(@C0CZV@(0)) ; TOTAL FROM VARIABLE ARRAY
+ . . D MAP^C0CXPATH(IPXML,C0CZVI,"C0CZT") ;MAP THE VARIABLES TO XML
 "RTN","C0CIMMU",32,0)
- I C0CZIC>0 D  ;IMMUNIZATIONS FOUND
+ . . I C0CZI=1 D  ; FIRST ONE
 "RTN","C0CIMMU",33,0)
- . F C0CZI=1:1:C0CZIC D  ;FOR EACH IMMUNIZATION
+ . . . D CP^C0CXPATH("C0CZT",OUTXML) ;JUST COPY RESULTS
 "RTN","C0CIMMU",34,0)
- . . S C0CZVI=$NA(@C0CZV@(C0CZI)) ;THIS IMMUNIZATION
+ . . E  D  ;NOT THE FIRST
 "RTN","C0CIMMU",35,0)
- . . D MAP^C0CXPATH(IPXML,C0CZVI,"C0CZT") ;MAP THE VARIABLES TO XML
+ . . . D INSINNER^C0CXPATH(OUTXML,"C0CZT")
 "RTN","C0CIMMU",36,0)
- . . I C0CZI=1 D  ; FIRST ONE
+ E  S @OUTXML@(0)=0 ; SIGNAL NO IMMUNIZATIONS
 "RTN","C0CIMMU",37,0)
- . . . D CP^C0CXPATH("C0CZT",OUTXML) ;JUST COPY RESULTS
+ N IMMUTMP,I
 "RTN","C0CIMMU",38,0)
- . . E  D  ;NOT THE FIRST
+ D MISSING^C0CXPATH(OUTXML,"IMMUTMP") ; SEARCH XML FOR MISSING VARS
 "RTN","C0CIMMU",39,0)
- . . . D INSINNER^C0CXPATH(OUTXML,"C0CZT")
+ I IMMUTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
 "RTN","C0CIMMU",40,0)
- E  S @OUTXML@(0)=0 ; SIGNAL NO IMMUNIZATIONS
+ . ; STRINGS MARKED AS @@X@@
 "RTN","C0CIMMU",41,0)
- N IMMUTMP,I
+ . W !,"IMMUNE Missing list: ",!
 "RTN","C0CIMMU",42,0)
- D MISSING^C0CXPATH(OUTXML,"IMMUTMP") ; SEARCH XML FOR MISSING VARS
+ . F I=1:1:IMMUTMP(0) W IMMUTMP(I),!
 "RTN","C0CIMMU",43,0)
- I IMMUTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
+ Q
 "RTN","C0CIMMU",44,0)
- . ; STRINGS MARKED AS @@X@@
+ ;
 "RTN","C0CIMMU",45,0)
- . W !,"IMMUNE Missing list: ",!
+EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT IMMUNIZATIONS INTO VARIABLES
 "RTN","C0CIMMU",46,0)
- . F I=1:1:IMMUTMP(0) W IMMUTMP(I),!
+ ;
 "RTN","C0CIMMU",47,0)
+ ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","C0CIMMU",48,0)
+ ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
+"RTN","C0CIMMU",49,0)
+ ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
+"RTN","C0CIMMU",50,0)
+ ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
+"RTN","C0CIMMU",51,0)
+ ; INSERT^C0CXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
+"RTN","C0CIMMU",52,0)
+ ;
+"RTN","C0CIMMU",53,0)
+ N RPCRSLT,J,K,PTMP,X,VMAP,TBU
+"RTN","C0CIMMU",54,0)
+ S TVMAP=$NA(^TMP("C0CCCR",$J,"IMMUNE"))
+"RTN","C0CIMMU",55,0)
+ S TARYTMP=$NA(^TMP("C0CCCR",$J,"IMMUARYTMP"))
+"RTN","C0CIMMU",56,0)
+ S IMMA=$NA(^TMP("PXI",$J)) ;
+"RTN","C0CIMMU",57,0)
+ K @IMMA ; CLEAR OUT PREVIOUS RESULTS
+"RTN","C0CIMMU",58,0)
+ K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
+"RTN","C0CIMMU",59,0)
+ D IMMUN^PXRHS03(DFN) ;
+"RTN","C0CIMMU",60,0)
+ I $O(@IMMA@(""))="" D  Q  ; RPC RETURNS NULL
+"RTN","C0CIMMU",61,0)
+ . W "NULL RESULT FROM IMMUN^PXRHS03 ",!
+"RTN","C0CIMMU",62,0)
+ . S @TVMAP@(0)=0
+"RTN","C0CIMMU",63,0)
+ N C0CIM,C0CC,C0CIMD,C0CIEN,C0CT ;
+"RTN","C0CIMMU",64,0)
+ S C0CIM=""
+"RTN","C0CIMMU",65,0)
+ S C0CC=0 ; COUNT
+"RTN","C0CIMMU",66,0)
+ F  S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM=""  D  ; FOR EACH IMMUNE TYPE IN THE LIST
+"RTN","C0CIMMU",67,0)
+ . S C0CC=C0CC+1 ;INCREMENT COUNT
+"RTN","C0CIMMU",68,0)
+ . S @TVMAP@(0)=C0CC ; SAVE NEW COUNT TO ARRAY
+"RTN","C0CIMMU",69,0)
+ . S VMAP=$NA(@TVMAP@(C0CC)) ; THIS IMMUNE ELEMENT
+"RTN","C0CIMMU",70,0)
+ . K @VMAP ; MAKE SURE IT IS CLEARED OUT
+"RTN","C0CIMMU",71,0)
+ . W C0CIM,!
+"RTN","C0CIMMU",72,0)
+ . S C0CIMD="" ; IMMUNE DATE
+"RTN","C0CIMMU",73,0)
+ . F  S C0CIMD=$O(@IMMA@(C0CIM,C0CIMD)) Q:C0CIMD=""  D  ; FOR EACH DATE
+"RTN","C0CIMMU",74,0)
+ . . S C0CIEN=$O(@IMMA@(C0CIM,C0CIMD,"")) ;IEN OF IMMUNE RECORD
+"RTN","C0CIMMU",75,0)
+ . . D GETN^C0CRNF("C0CI",9000010.11,C0CIEN) ; GET THE FILEMAN RECORD FOR IENS
+"RTN","C0CIMMU",76,0)
+ . . W C0CIEN,"_",C0CIMD
+"RTN","C0CIMMU",77,0)
+ . . S C0CT=$$FMDTOUTC^C0CUTIL(9999999-C0CIMD,"DT") ; FORMAT DATE/TIME
+"RTN","C0CIMMU",78,0)
+ . . W C0CT,!
+"RTN","C0CIMMU",79,0)
+ . . S @VMAP@("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID
+"RTN","C0CIMMU",80,0)
+ . . S @VMAP@("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME
+"RTN","C0CIMMU",81,0)
+ . . S @VMAP@("IMMUNEDATETIME")=C0CT ;FORMATTED DATE/TIME
+"RTN","C0CIMMU",82,0)
+ . . S C0CIP=$$ZVALUEI^C0CRNF("ENCOUNTER PROVIDER","C0CI") ;IEN OF PROVIDER
+"RTN","C0CIMMU",83,0)
+ . . S @VMAP@("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_C0CIP
+"RTN","C0CIMMU",84,0)
+ . . S C0CIIEN=$$ZVALUEI^C0CRNF("IMMUNIZATION","C0CI") ;IEN OF IMMUNIZATION
+"RTN","C0CIMMU",85,0)
+ . . I $G(DUZ("AG"))="I" D  ; RUNNING IN RPMS
+"RTN","C0CIMMU",86,0)
+ . . . D GETN^C0CRNF("C0CZIM",9999999.14,C0CIIEN) ;GET IMMUNE RECORD
+"RTN","C0CIMMU",87,0)
+ . . . S C0CIN=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD
+"RTN","C0CIMMU",88,0)
+ . . . ; FOR LOOKING UP THE CODE
+"RTN","C0CIMMU",89,0)
+ . . . ; GET IT FROM THE CODE FILE
+"RTN","C0CIMMU",90,0)
+ . . . S C0CICD=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE
+"RTN","C0CIMMU",91,0)
+ . . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME
+"RTN","C0CIMMU",92,0)
+ . . . S @VMAP@("IMMUNEPRODUCTCODE")=C0CICD ; CVX CODE
+"RTN","C0CIMMU",93,0)
+ . . . I C0CICD'="" S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code" ;
+"RTN","C0CIMMU",94,0)
+ . . . E  S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NULL
+"RTN","C0CIMMU",95,0)
+ . . E  D  ; NOT IN RPMS
+"RTN","C0CIMMU",96,0)
+ . . . S C0CIN=$$ZVALUE^C0CRNF("IMMUNIZATION","C0CI") ;NAME OF IMMUNIZATION
+"RTN","C0CIMMU",97,0)
+ . . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME
+"RTN","C0CIMMU",98,0)
+ . . . S @VMAP@("IMMUNEPRODUCTCODE")="" ; CVX CODE
+"RTN","C0CIMMU",99,0)
+ . . . S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NO CODE
+"RTN","C0CIMMU",100,0)
+ N C0CIRIM S C0CIRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE"))
+"RTN","C0CIMMU",101,0)
+ M @C0CIRIM=@TVMAP ; PERSIST RIM VARIABLES
+"RTN","C0CIMMU",102,0)
  Q
-"RTN","C0CIMMU",48,0)
- ;
-"RTN","C0CIMMU",49,0)
-EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT IMMUNIZATIONS INTO VARIABLES
-"RTN","C0CIMMU",50,0)
- ;
-"RTN","C0CIMMU",51,0)
- ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","C0CIMMU",52,0)
- ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
-"RTN","C0CIMMU",53,0)
- ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
-"RTN","C0CIMMU",54,0)
- ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
-"RTN","C0CIMMU",55,0)
- ; INSERT^C0CXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
-"RTN","C0CIMMU",56,0)
- ;
-"RTN","C0CIMMU",57,0)
- N RPCRSLT,J,K,PTMP,X,VMAP,TBU
-"RTN","C0CIMMU",58,0)
- S TVMAP=$NA(^TMP("C0CCCR",$J,"IMMUNE"))
-"RTN","C0CIMMU",59,0)
- S TARYTMP=$NA(^TMP("C0CCCR",$J,"IMMUARYTMP"))
-"RTN","C0CIMMU",60,0)
- S IMMA=$NA(^TMP("PXI",$J)) ;
-"RTN","C0CIMMU",61,0)
- K @IMMA ; CLEAR OUT PREVIOUS RESULTS
-"RTN","C0CIMMU",62,0)
- K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
-"RTN","C0CIMMU",63,0)
- D IMMUN^PXRHS03(DFN) ;
-"RTN","C0CIMMU",64,0)
- I $O(@IMMA@(""))="" D  Q  ; RPC RETURNS NULL
-"RTN","C0CIMMU",65,0)
- . W "NULL RESULT FROM IMMUN^PXRHS03 ",!
-"RTN","C0CIMMU",66,0)
- . S @TVMAP@(0)=0
-"RTN","C0CIMMU",67,0)
- N C0CIM,C0CC,C0CIMD,C0CIEN,C0CT ;
-"RTN","C0CIMMU",68,0)
- S C0CIM=""
-"RTN","C0CIMMU",69,0)
- S C0CC=0 ; COUNT
-"RTN","C0CIMMU",70,0)
- F  S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM=""  D  ; FOR EACH IMMUNE TYPE IN THE LIST
-"RTN","C0CIMMU",71,0)
- . S C0CC=C0CC+1 ;INCREMENT COUNT
-"RTN","C0CIMMU",72,0)
- . S @TVMAP@(0)=C0CC ; SAVE NEW COUNT TO ARRAY
-"RTN","C0CIMMU",73,0)
- . S VMAP=$NA(@TVMAP@(C0CC)) ; THIS IMMUNE ELEMENT
-"RTN","C0CIMMU",74,0)
- . K @VMAP ; MAKE SURE IT IS CLEARED OUT
-"RTN","C0CIMMU",75,0)
- . W C0CIM,!
-"RTN","C0CIMMU",76,0)
- . S C0CIMD="" ; IMMUNE DATE
-"RTN","C0CIMMU",77,0)
- . F  S C0CIMD=$O(@IMMA@(C0CIM,C0CIMD)) Q:C0CIMD=""  D  ; FOR EACH DATE
-"RTN","C0CIMMU",78,0)
- . . S C0CIEN=$O(@IMMA@(C0CIM,C0CIMD,"")) ;IEN OF IMMUNE RECORD
-"RTN","C0CIMMU",79,0)
- . . D GETN^C0CRNF("C0CI",9000010.11,C0CIEN) ; GET THE FILEMAN RECORD FOR IENS
-"RTN","C0CIMMU",80,0)
- . . W C0CIEN,"_",C0CIMD
-"RTN","C0CIMMU",81,0)
- . . S C0CT=$$FMDTOUTC^C0CUTIL(9999999-C0CIMD,"DT") ; FORMAT DATE/TIME
-"RTN","C0CIMMU",82,0)
- . . W C0CT,!
-"RTN","C0CIMMU",83,0)
- . . S @VMAP@("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID
-"RTN","C0CIMMU",84,0)
- . . S @VMAP@("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME
-"RTN","C0CIMMU",85,0)
- . . S @VMAP@("IMMUNEDATETIME")=C0CT ;FORMATTED DATE/TIME
-"RTN","C0CIMMU",86,0)
- . . S C0CIP=$$ZVALUEI^C0CRNF("ENCOUNTER PROVIDER","C0CI") ;IEN OF PROVIDER
-"RTN","C0CIMMU",87,0)
- . . S @VMAP@("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_C0CIP
-"RTN","C0CIMMU",88,0)
- . . S C0CIIEN=$$ZVALUEI^C0CRNF("IMMUNIZATION","C0CI") ;IEN OF IMMUNIZATION
-"RTN","C0CIMMU",89,0)
- . . I $G(DUZ("AG"))="I" D  ; RUNNING IN RPMS
-"RTN","C0CIMMU",90,0)
- . . . D GETN^C0CRNF("C0CZIM",9999999.14,C0CIIEN) ;GET IMMUNE RECORD
-"RTN","C0CIMMU",91,0)
- . . . S C0CIN=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD
-"RTN","C0CIMMU",92,0)
- . . . ; FOR LOOKING UP THE CODE
-"RTN","C0CIMMU",93,0)
- . . . ; GET IT FROM THE CODE FILE
-"RTN","C0CIMMU",94,0)
- . . . S C0CICD=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE
-"RTN","C0CIMMU",95,0)
- . . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME
-"RTN","C0CIMMU",96,0)
- . . . S @VMAP@("IMMUNEPRODUCTCODE")=C0CICD ; CVX CODE
-"RTN","C0CIMMU",97,0)
- . . . I C0CICD'="" S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code" ;
-"RTN","C0CIMMU",98,0)
- . . . E  S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NULL
-"RTN","C0CIMMU",99,0)
- . . E  D  ; NOT IN RPMS
-"RTN","C0CIMMU",100,0)
- . . . S C0CIN=$$ZVALUE^C0CRNF("IMMUNIZATION","C0CI") ;NAME OF IMMUNIZATION
-"RTN","C0CIMMU",101,0)
- . . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME
-"RTN","C0CIMMU",102,0)
- . . . S @VMAP@("IMMUNEPRODUCTCODE")="" ; CVX CODE
 "RTN","C0CIMMU",103,0)
- . . . S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NO CODE
-"RTN","C0CIMMU",104,0)
- N C0CIRIM S C0CIRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE"))
-"RTN","C0CIMMU",105,0)
- M @C0CIRIM=@TVMAP ; PERSIST RIM VARIABLES
-"RTN","C0CIMMU",106,0)
- Q
-"RTN","C0CIMMU",107,0)
  ;
 "RTN","C0CIN")
-0^72^B30946883
+0^72^B30222275
 "RTN","C0CIN",1,0)
 C0CIN   ; CCDCCR/GPL - CCR IMPORT utilities; 9/20/08
 "RTN","C0CIN",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CIN",3,0)
- ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
+ ;Copyright 2009 George Lilly.  
 "RTN","C0CIN",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CIN",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CIN",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CIN",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CIN",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CIN",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CIN",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CIN",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CIN",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CIN",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CIN",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CIN",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CIN",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CIN",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CIN",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ W "This is the CCR Import Utility Library ",!
 "RTN","C0CIN",19,0)
- ;
+ Q
 "RTN","C0CIN",20,0)
- W "This is the CCR Import Utility Library ",!
+ ;
 "RTN","C0CIN",21,0)
+TEST ; TESTS BOTH ROUTINES AT ONCE
+"RTN","C0CIN",22,0)
+ N ZI,ZJ
+"RTN","C0CIN",23,0)
+ S ZI="/home/vademo2/CCR" ;directory purposely leaving off the trailing /
+"RTN","C0CIN",24,0)
+ S ZJ="PAT_358_CCR_V1_0_21.xml" ; random test patient
+"RTN","C0CIN",25,0)
+ D RPCFIN(.GPL,358,135,"GPLTEST","CCR",ZJ,ZI)
+"RTN","C0CIN",26,0)
  Q
-"RTN","C0CIN",22,0)
- ;
-"RTN","C0CIN",23,0)
-TEST ; TESTS BOTH ROUTINES AT ONCE
-"RTN","C0CIN",24,0)
- N ZI,ZJ
-"RTN","C0CIN",25,0)
- S ZI="/home/vademo2/CCR" ;directory purposely leaving off the trailing /
-"RTN","C0CIN",26,0)
- S ZJ="PAT_358_CCR_V1_0_21.xml" ; random test patient
 "RTN","C0CIN",27,0)
- D RPCFIN(.GPL,358,135,"GPLTEST","CCR",ZJ,ZI)
+ ;
 "RTN","C0CIN",28,0)
+RPCAIN(RTN,DFN,DUZ,SOURCE,TYPE,ARY) ; ARRAY IN RPC - ACCEPT AN XML DOCUMENT
+"RTN","C0CIN",29,0)
+ ; AND STORE IT IN THE INCOMING XML FILE
+"RTN","C0CIN",30,0)
+ ; RETURNS THE IEN OF THE RECORD OR TEXT IF THERE IS AN ERROR
+"RTN","C0CIN",31,0)
+ I $G(DFN)="" S RTN="DFN NOT DEFINED" Q  ;
+"RTN","C0CIN",32,0)
+ N C0CXF S C0CXF=175 ; FILE NUMBER FOR INCOMING XML FILE
+"RTN","C0CIN",33,0)
+ N C0CFDA,ZX
+"RTN","C0CIN",34,0)
+ S C0CFDA(C0CXF,"+1,",.01)=DFN ; PATIENT
+"RTN","C0CIN",35,0)
+ S C0CFDA(C0CXF,"+1,",.02)=DUZ ; PROVIDER CREATING THE RECORD
+"RTN","C0CIN",36,0)
+ S C0CFDA(C0CXF,"+1,",1)=$$NOW^XLFDT ;DATE
+"RTN","C0CIN",37,0)
+ S C0CFDA(C0CXF,"+1,",2)=TYPE  ;TYPE
+"RTN","C0CIN",38,0)
+ S C0CFDA(C0CXF,"+1,",3)=$$ADDSRC(SOURCE) ;SOURCE
+"RTN","C0CIN",39,0)
+ S C0CFDA(C0CXF,"+1,",7)="NEW" ; STATUS OF NEW FOR NOT PROCESSED
+"RTN","C0CIN",40,0)
+ D UPDIE ; CREATE THE RECORD
+"RTN","C0CIN",41,0)
+ S ZX=C0CIEN(1) ; CAPTURE THE RECORD NUMBER
+"RTN","C0CIN",42,0)
+ D WP^DIE(C0CXF,ZX_",",4,,ARY,"ZERR")
+"RTN","C0CIN",43,0)
+ ;W "RECORD:",ZX,!
+"RTN","C0CIN",44,0)
+ S RTN=ZX ; RETURN IEN OF THE XML FILE
+"RTN","C0CIN",45,0)
  Q
-"RTN","C0CIN",29,0)
- ;
-"RTN","C0CIN",30,0)
-RPCAIN(RTN,DFN,DUZ,SOURCE,TYPE,ARY) ; ARRAY IN RPC - ACCEPT AN XML DOCUMENT
-"RTN","C0CIN",31,0)
- ; AND STORE IT IN THE INCOMING XML FILE
-"RTN","C0CIN",32,0)
- ; RETURNS THE IEN OF THE RECORD OR TEXT IF THERE IS AN ERROR
-"RTN","C0CIN",33,0)
- I $G(DFN)="" S RTN="DFN NOT DEFINED" Q  ;
-"RTN","C0CIN",34,0)
- N C0CXF S C0CXF=175 ; FILE NUMBER FOR INCOMING XML FILE
-"RTN","C0CIN",35,0)
- N C0CFDA,ZX
-"RTN","C0CIN",36,0)
- S C0CFDA(C0CXF,"+1,",.01)=DFN ; PATIENT
-"RTN","C0CIN",37,0)
- S C0CFDA(C0CXF,"+1,",.02)=DUZ ; PROVIDER CREATING THE RECORD
-"RTN","C0CIN",38,0)
- S C0CFDA(C0CXF,"+1,",1)=$$NOW^XLFDT ;DATE
-"RTN","C0CIN",39,0)
- S C0CFDA(C0CXF,"+1,",2)=TYPE  ;TYPE
-"RTN","C0CIN",40,0)
- S C0CFDA(C0CXF,"+1,",3)=$$ADDSRC(SOURCE) ;SOURCE
-"RTN","C0CIN",41,0)
- S C0CFDA(C0CXF,"+1,",7)="NEW" ; STATUS OF NEW FOR NOT PROCESSED
-"RTN","C0CIN",42,0)
- D UPDIE ; CREATE THE RECORD
-"RTN","C0CIN",43,0)
- S ZX=C0CIEN(1) ; CAPTURE THE RECORD NUMBER
-"RTN","C0CIN",44,0)
- D WP^DIE(C0CXF,ZX_",",4,,ARY,"ZERR")
-"RTN","C0CIN",45,0)
- ;W "RECORD:",ZX,!
 "RTN","C0CIN",46,0)
- S RTN=ZX ; RETURN IEN OF THE XML FILE
+ ;
 "RTN","C0CIN",47,0)
+ADDSRC(ZSRC) ;EXTRISIC TO ADD A SOURCE TO THE CCR SOURCE FILE
+"RTN","C0CIN",48,0)
+ ; RETURNS RECORD NUMBER. IF SOURCE EXISTS, JUST RETURNS IT'S RECORD NUMBER
+"RTN","C0CIN",49,0)
+ ;
+"RTN","C0CIN",50,0)
+ N ZX,ZF,C0CFDA
+"RTN","C0CIN",51,0)
+ S ZF=171.401 ; FILE NUMBER FOR CCR SOURCE FILE
+"RTN","C0CIN",52,0)
+ S C0CFDA(ZF,"?+1,",.01)=ZSRC
+"RTN","C0CIN",53,0)
+ D UPDIE
+"RTN","C0CIN",54,0)
+ Q $O(^C0C(171.401,"B",ZSRC,""))
+"RTN","C0CIN",55,0)
+ ;
+"RTN","C0CIN",56,0)
+RPCFIN(RTN,DFN,DUZ,SOURCE,TYPE,FN,FP) ; FILE IN RPC - READ AN XML DOCUMENT
+"RTN","C0CIN",57,0)
+ ; FROM A HOST FILE AND STORE IT IN THE INCOMING XML FILE
+"RTN","C0CIN",58,0)
+ N ZX,ZTMP
+"RTN","C0CIN",59,0)
+ I $E($RE(FP))'="/" S ZX=FP_"/"
+"RTN","C0CIN",60,0)
+ E  S ZX=FP
+"RTN","C0CIN",61,0)
+ S ZX=ZX_FN
+"RTN","C0CIN",62,0)
+ D LOAD("ZTMP",ZX)
+"RTN","C0CIN",63,0)
+ I '$D(ZTMP) D  Q  ; NO LUCK
+"RTN","C0CIN",64,0)
+ . W "FILE NOT LOADED",!
+"RTN","C0CIN",65,0)
+ D RPCAIN(.RTN,DFN,DUZ,SOURCE,TYPE,"ZTMP")
+"RTN","C0CIN",66,0)
+ N C0CFDA
+"RTN","C0CIN",67,0)
+ S C0CFDA(175,RTN_",",5)=FN ; FILE NAME
+"RTN","C0CIN",68,0)
+ S C0CFDA(175,RTN_",",6)=FP ; FILE PATH
+"RTN","C0CIN",69,0)
+ D UPDIE ; UPDATE WITH FILE NAME AND PATH
+"RTN","C0CIN",70,0)
  Q
-"RTN","C0CIN",48,0)
- ;
-"RTN","C0CIN",49,0)
-ADDSRC(ZSRC) ;EXTRISIC TO ADD A SOURCE TO THE CCR SOURCE FILE
-"RTN","C0CIN",50,0)
- ; RETURNS RECORD NUMBER. IF SOURCE EXISTS, JUST RETURNS IT'S RECORD NUMBER
-"RTN","C0CIN",51,0)
- ;
-"RTN","C0CIN",52,0)
- N ZX,ZF,C0CFDA
-"RTN","C0CIN",53,0)
- S ZF=171.401 ; FILE NUMBER FOR CCR SOURCE FILE
-"RTN","C0CIN",54,0)
- S C0CFDA(ZF,"?+1,",.01)=ZSRC
-"RTN","C0CIN",55,0)
- D UPDIE
-"RTN","C0CIN",56,0)
- Q $O(^C0C(171.401,"B",ZSRC,""))
-"RTN","C0CIN",57,0)
- ;
-"RTN","C0CIN",58,0)
-RPCFIN(RTN,DFN,DUZ,SOURCE,TYPE,FN,FP) ; FILE IN RPC - READ AN XML DOCUMENT
-"RTN","C0CIN",59,0)
- ; FROM A HOST FILE AND STORE IT IN THE INCOMING XML FILE
-"RTN","C0CIN",60,0)
- N ZX,ZTMP
-"RTN","C0CIN",61,0)
- I $E($RE(FP))'="/" S ZX=FP_"/"
-"RTN","C0CIN",62,0)
- E  S ZX=FP
-"RTN","C0CIN",63,0)
- S ZX=ZX_FN
-"RTN","C0CIN",64,0)
- D LOAD("ZTMP",ZX)
-"RTN","C0CIN",65,0)
- I '$D(ZTMP) D  Q  ; NO LUCK
-"RTN","C0CIN",66,0)
- . W "FILE NOT LOADED",!
-"RTN","C0CIN",67,0)
- D RPCAIN(.RTN,DFN,DUZ,SOURCE,TYPE,"ZTMP")
-"RTN","C0CIN",68,0)
- N C0CFDA
-"RTN","C0CIN",69,0)
- S C0CFDA(175,RTN_",",5)=FN ; FILE NAME
-"RTN","C0CIN",70,0)
- S C0CFDA(175,RTN_",",6)=FP ; FILE PATH
 "RTN","C0CIN",71,0)
- D UPDIE ; UPDATE WITH FILE NAME AND PATH
+ ;
 "RTN","C0CIN",72,0)
+RPCLIST(RTN,DFN) ; CCR LIST - LIST XML DOCUMENTS FOR PATIENT DFN
+"RTN","C0CIN",73,0)
+ ; THAT ARE STORED IN THE INCOMING XML FILE
+"RTN","C0CIN",74,0)
+ ; RETURNS AN ARRAY OF THE FORM 
+"RTN","C0CIN",75,0)
+ ; RTN(x)="IEN^DATE^TYPE^SOURCE^STATUS^CREATEDBY" WHERE
+"RTN","C0CIN",76,0)
+ ; IEN IS THE RECORD NUMBER OF THE XML DOCUMENT
+"RTN","C0CIN",77,0)
+ ; DATE IS THE DATE THE DOCUMENT WAS STORED IN THE FILE
+"RTN","C0CIN",78,0)
+ ; TYPE IS "CCD" OR "CCR" OR "OTHER"
+"RTN","C0CIN",79,0)
+ ; SOURCE IS THE NAME OF THE DOCUMENT SOURCE FROM THE CCR SOURCE FILE
+"RTN","C0CIN",80,0)
+ ; STATUS IS THE STATUS OF THE DOCUMENT (VALUES TO BE DEFINED)
+"RTN","C0CIN",81,0)
+ ; CREATEDBY IS THE NAME OF THE PROVIDER WHO UPLOADED THE XML
+"RTN","C0CIN",82,0)
+ N ZF S ZF=175 ; FILE NUMBER OF INCOMING XML FILE
+"RTN","C0CIN",83,0)
+ N ZI S ZI=""
+"RTN","C0CIN",84,0)
+ N ZN S ZN=0
+"RTN","C0CIN",85,0)
+ F  S ZI=$O(^C0CIN("B",DFN,ZI),-1) Q:ZI=""  D  ; FOR EACH RECORD FOR THIS PATIENT
+"RTN","C0CIN",86,0)
+ . S ZN=ZN+1 ;INCREMENT COUNT OF RETURN ARRAY
+"RTN","C0CIN",87,0)
+ . S $P(RTN(ZN),"^",1)=ZI ; IEN OF RECORD
+"RTN","C0CIN",88,0)
+ . S $P(RTN(ZN),"^",2)=$$GET1^DIQ(ZF,ZI_",",1,"E") ;DATE
+"RTN","C0CIN",89,0)
+ . S $P(RTN(ZN),"^",3)=$$GET1^DIQ(ZF,ZI_",",2,"E") ;TYPE
+"RTN","C0CIN",90,0)
+ . S $P(RTN(ZN),"^",4)=$$GET1^DIQ(ZF,ZI_",",3,"E") ;SOURCE
+"RTN","C0CIN",91,0)
+ . S $P(RTN(ZN),"^",5)=$$GET1^DIQ(ZF,ZI_",",7,"I") ; STATUS
+"RTN","C0CIN",92,0)
+ . S $P(RTN(ZN),"^",6)=$$GET1^DIQ(ZF,ZI_",",.02,"E") ; CREATED BY
+"RTN","C0CIN",93,0)
  Q
-"RTN","C0CIN",73,0)
- ;
-"RTN","C0CIN",74,0)
-RPCLIST(RTN,DFN) ; CCR LIST - LIST XML DOCUMENTS FOR PATIENT DFN
-"RTN","C0CIN",75,0)
- ; THAT ARE STORED IN THE INCOMING XML FILE
-"RTN","C0CIN",76,0)
- ; RETURNS AN ARRAY OF THE FORM 
-"RTN","C0CIN",77,0)
- ; RTN(x)="IEN^DATE^TYPE^SOURCE^STATUS^CREATEDBY" WHERE
-"RTN","C0CIN",78,0)
- ; IEN IS THE RECORD NUMBER OF THE XML DOCUMENT
-"RTN","C0CIN",79,0)
- ; DATE IS THE DATE THE DOCUMENT WAS STORED IN THE FILE
-"RTN","C0CIN",80,0)
- ; TYPE IS "CCD" OR "CCR" OR "OTHER"
-"RTN","C0CIN",81,0)
- ; SOURCE IS THE NAME OF THE DOCUMENT SOURCE FROM THE CCR SOURCE FILE
-"RTN","C0CIN",82,0)
- ; STATUS IS THE STATUS OF THE DOCUMENT (VALUES TO BE DEFINED)
-"RTN","C0CIN",83,0)
- ; CREATEDBY IS THE NAME OF THE PROVIDER WHO UPLOADED THE XML
-"RTN","C0CIN",84,0)
- N ZF S ZF=175 ; FILE NUMBER OF INCOMING XML FILE
-"RTN","C0CIN",85,0)
- N ZI S ZI=""
-"RTN","C0CIN",86,0)
- N ZN S ZN=0
-"RTN","C0CIN",87,0)
- F  S ZI=$O(^C0CIN("B",DFN,ZI),-1) Q:ZI=""  D  ; FOR EACH RECORD FOR THIS PATIENT
-"RTN","C0CIN",88,0)
- . S ZN=ZN+1 ;INCREMENT COUNT OF RETURN ARRAY
-"RTN","C0CIN",89,0)
- . S $P(RTN(ZN),"^",1)=ZI ; IEN OF RECORD
-"RTN","C0CIN",90,0)
- . S $P(RTN(ZN),"^",2)=$$GET1^DIQ(ZF,ZI_",",1,"E") ;DATE
-"RTN","C0CIN",91,0)
- . S $P(RTN(ZN),"^",3)=$$GET1^DIQ(ZF,ZI_",",2,"E") ;TYPE
-"RTN","C0CIN",92,0)
- . S $P(RTN(ZN),"^",4)=$$GET1^DIQ(ZF,ZI_",",3,"E") ;SOURCE
-"RTN","C0CIN",93,0)
- . S $P(RTN(ZN),"^",5)=$$GET1^DIQ(ZF,ZI_",",7,"I") ; STATUS
 "RTN","C0CIN",94,0)
- . S $P(RTN(ZN),"^",6)=$$GET1^DIQ(ZF,ZI_",",.02,"E") ; CREATED BY
+ ;
 "RTN","C0CIN",95,0)
+RPCDOC(RTN,IEN) ; RETRIEVE DOCUMENT NUMBER IEN FROM THE INCOMING XML FILE
+"RTN","C0CIN",96,0)
+ ; RETURNED IN ARRAY RTN
+"RTN","C0CIN",97,0)
+ N ZI
+"RTN","C0CIN",98,0)
+ S ZI=$$GET1^DIQ(175,IEN_",",4,,"RTN")
+"RTN","C0CIN",99,0)
  Q
-"RTN","C0CIN",96,0)
- ;
-"RTN","C0CIN",97,0)
-RPCDOC(RTN,IEN) ; RETRIEVE DOCUMENT NUMBER IEN FROM THE INCOMING XML FILE
-"RTN","C0CIN",98,0)
- ; RETURNED IN ARRAY RTN
-"RTN","C0CIN",99,0)
- N ZI
 "RTN","C0CIN",100,0)
- S ZI=$$GET1^DIQ(175,IEN_",",4,,"RTN")
+ ;
 "RTN","C0CIN",101,0)
+EN(INXML,SOURCE,C0CDFN) ; IMPORT A CCR, PASSED BY NAME INXML
+"RTN","C0CIN",102,0)
+ ; FILE UNDER SOURCE, WHICH IS A POINTER TO THE CCR SOURCE FILE
+"RTN","C0CIN",103,0)
+ ; FOR PATIENT C0CDFN
+"RTN","C0CIN",104,0)
+ ;N C0CXP
+"RTN","C0CIN",105,0)
+ S C0CINB=$NA(^TMP("C0CIN",$J,"VARS",C0CDFN))
+"RTN","C0CIN",106,0)
+ S C0CDOCID=$$PARSE^C0CMXML(INXML) ;W !,"DocID: ",C0CDOCID
+"RTN","C0CIN",107,0)
+ ;S REDUX="//ContinuityOfCareRecord/Body"
+"RTN","C0CIN",108,0)
+ S REDUX=""
+"RTN","C0CIN",109,0)
+ D XPATH^C0CMXML(1,"/","C0CIDX","C0CXP",,REDUX)
+"RTN","C0CIN",110,0)
+ ;D INDEX^C0CXPATH(INXML,"C0CXP",-1) ; GENERATE XPATHS FROM THE CCR
+"RTN","C0CIN",111,0)
+ ;N ZI,ZJ,ZK 
+"RTN","C0CIN",112,0)
+ S ZI=""
+"RTN","C0CIN",113,0)
+ F  S ZI=$O(C0CXP(ZI)) Q:ZI=""  D  ; FOR EACH XPATH
+"RTN","C0CIN",114,0)
+ . D DEMUX^C0CMXP("ZJ",ZI) ;
+"RTN","C0CIN",115,0)
+ . W ZJ,!
+"RTN","C0CIN",116,0)
+ . S ZK=$P(ZJ,"^",3) ; PULL OUT THE XPATH
+"RTN","C0CIN",117,0)
+ . S ZM=$P(ZJ,"^",1) ; PULL OUT THE MULTIPLE
+"RTN","C0CIN",118,0)
+ . S ZS=$P(ZJ,"^",2) ; PULL OUT THE SUBMULTIPLE
+"RTN","C0CIN",119,0)
+ . S C0CDICN=$O(^C0CDIC(170,"XPATH",ZK,""))
+"RTN","C0CIN",120,0)
+ . I C0CDICN="" D  Q  ;
+"RTN","C0CIN",121,0)
+ . . W "MISSING XPATH:",!,ZK,! ; OOPS, XPATH NOT IN C0CDIC
+"RTN","C0CIN",122,0)
+ . . S MISSING(ZK)=""
+"RTN","C0CIN",123,0)
+ . ;D GETS^DIQ(170,C0CDICN_",","*",,"C0CFDA")
+"RTN","C0CIN",124,0)
+ . S C0CVAR=$$GET1^DIQ(170,C0CDICN_",",.01) ; VARIABLE NAME
+"RTN","C0CIN",125,0)
+ . S C0CSEC=$$GET1^DIQ(170,C0CDICN_",",12) ;ELEMENT TYPE
+"RTN","C0CIN",126,0)
+ . W C0CSEC,":",C0CVAR,!
+"RTN","C0CIN",127,0)
  Q
-"RTN","C0CIN",102,0)
- ;
-"RTN","C0CIN",103,0)
-EN(INXML,SOURCE,C0CDFN) ; IMPORT A CCR, PASSED BY NAME INXML
-"RTN","C0CIN",104,0)
- ; FILE UNDER SOURCE, WHICH IS A POINTER TO THE CCR SOURCE FILE
-"RTN","C0CIN",105,0)
- ; FOR PATIENT C0CDFN
-"RTN","C0CIN",106,0)
- ;N C0CXP
-"RTN","C0CIN",107,0)
- S C0CINB=$NA(^TMP("C0CIN",$J,"VARS",C0CDFN))
-"RTN","C0CIN",108,0)
- S C0CDOCID=$$PARSE^C0CMXML(INXML) ;W !,"DocID: ",C0CDOCID
-"RTN","C0CIN",109,0)
- ;S REDUX="//ContinuityOfCareRecord/Body"
-"RTN","C0CIN",110,0)
- S REDUX=""
-"RTN","C0CIN",111,0)
- D XPATH^C0CMXML(1,"/","C0CIDX","C0CXP",,REDUX)
-"RTN","C0CIN",112,0)
- ;D INDEX^C0CXPATH(INXML,"C0CXP",-1) ; GENERATE XPATHS FROM THE CCR
-"RTN","C0CIN",113,0)
- ;N ZI,ZJ,ZK 
-"RTN","C0CIN",114,0)
+"RTN","C0CIN",128,0)
+ ; 
+"RTN","C0CIN",129,0)
+GETACCR(AOUT,C0CDFN) ; EXTRACT A CCR FOR PATIENT ADFN AND PUT IT IN ARRAY AOUT
+"RTN","C0CIN",130,0)
+ ;PASSED BY NAME
+"RTN","C0CIN",131,0)
+ N ZT
+"RTN","C0CIN",132,0)
+ D CCRRPC^C0CCCR(.ZT,C0CDFN,"LABLIMIT:T-1000")
+"RTN","C0CIN",133,0)
+ M @AOUT=ZT
+"RTN","C0CIN",134,0)
+ Q
+"RTN","C0CIN",135,0)
+ ;
+"RTN","C0CIN",136,0)
+TEST64 ;TEST BASE64 DECODING FOR IMPORTING CCR FROM THE NHIN
+"RTN","C0CIN",137,0)
+ W $$FTG^%ZISH("/tmp/","base64_encoded_ccr.txt","G64(1)",1)
+"RTN","C0CIN",138,0)
+ S G=G64(1)
+"RTN","C0CIN",139,0)
  S ZI=""
-"RTN","C0CIN",115,0)
- F  S ZI=$O(C0CXP(ZI)) Q:ZI=""  D  ; FOR EACH XPATH
-"RTN","C0CIN",116,0)
- . D DEMUX^C0CMXP("ZJ",ZI) ;
-"RTN","C0CIN",117,0)
- . W ZJ,!
-"RTN","C0CIN",118,0)
- . S ZK=$P(ZJ,"^",3) ; PULL OUT THE XPATH
-"RTN","C0CIN",119,0)
- . S ZM=$P(ZJ,"^",1) ; PULL OUT THE MULTIPLE
-"RTN","C0CIN",120,0)
- . S ZS=$P(ZJ,"^",2) ; PULL OUT THE SUBMULTIPLE
-"RTN","C0CIN",121,0)
- . S C0CDICN=$O(^C0CDIC(170,"XPATH",ZK,""))
-"RTN","C0CIN",122,0)
- . I C0CDICN="" D  Q  ;
-"RTN","C0CIN",123,0)
- . . W "MISSING XPATH:",!,ZK,! ; OOPS, XPATH NOT IN C0CDIC
-"RTN","C0CIN",124,0)
- . . S MISSING(ZK)=""
-"RTN","C0CIN",125,0)
- . ;D GETS^DIQ(170,C0CDICN_",","*",,"C0CFDA")
-"RTN","C0CIN",126,0)
- . S C0CVAR=$$GET1^DIQ(170,C0CDICN_",",.01) ; VARIABLE NAME
-"RTN","C0CIN",127,0)
- . S C0CSEC=$$GET1^DIQ(170,C0CDICN_",",12) ;ELEMENT TYPE
-"RTN","C0CIN",128,0)
- . W C0CSEC,":",C0CVAR,!
-"RTN","C0CIN",129,0)
+"RTN","C0CIN",140,0)
+ F  S ZI=$O(G64(1,"OVF",ZI)) Q:ZI=""  D  ; FOR EVERY OVERFLOW RECORD
+"RTN","C0CIN",141,0)
+ . S G=G_G64(1,"OVF",ZI) ;HOPE IT'S NOT TOO BIG
+"RTN","C0CIN",142,0)
+ S G2=$$DECODE^RGUTUU(G)
+"RTN","C0CIN",143,0)
  Q
-"RTN","C0CIN",130,0)
- ; 
-"RTN","C0CIN",131,0)
-GETACCR(AOUT,C0CDFN) ; EXTRACT A CCR FOR PATIENT ADFN AND PUT IT IN ARRAY AOUT
-"RTN","C0CIN",132,0)
- ;PASSED BY NAME
-"RTN","C0CIN",133,0)
- N ZT
-"RTN","C0CIN",134,0)
- D CCRRPC^C0CCCR(.ZT,C0CDFN,"LABLIMIT:T-1000")
-"RTN","C0CIN",135,0)
- M @AOUT=ZT
-"RTN","C0CIN",136,0)
+"RTN","C0CIN",144,0)
+ ;
+"RTN","C0CIN",145,0)
+NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
+"RTN","C0CIN",146,0)
+ ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
+"RTN","C0CIN",147,0)
+ ;
+"RTN","C0CIN",148,0)
+ N ZI,ZN,ZTMP
+"RTN","C0CIN",149,0)
+ S ZN=1
+"RTN","C0CIN",150,0)
+ S @OUTXML@(ZN)=$P(@INXML,"><",ZN)_">"
+"RTN","C0CIN",151,0)
+ S ZN=ZN+1
+"RTN","C0CIN",152,0)
+ F  S @OUTXML@(ZN)="<"_$P(@INXML,"><",ZN) Q:$P(@INXML,"><",ZN+1)=""  D  ;
+"RTN","C0CIN",153,0)
+ . S @OUTXML@(ZN)=@OUTXML@(ZN)_">"
+"RTN","C0CIN",154,0)
+ . S ZN=ZN+1
+"RTN","C0CIN",155,0)
  Q
-"RTN","C0CIN",137,0)
- ;
-"RTN","C0CIN",138,0)
-TEST64 ;TEST BASE64 DECODING FOR IMPORTING CCR FROM THE NHIN
-"RTN","C0CIN",139,0)
- W $$FTG^%ZISH("/tmp/","base64_encoded_ccr.txt","G64(1)",1)
-"RTN","C0CIN",140,0)
- S G=G64(1)
-"RTN","C0CIN",141,0)
- S ZI=""
-"RTN","C0CIN",142,0)
- F  S ZI=$O(G64(1,"OVF",ZI)) Q:ZI=""  D  ; FOR EVERY OVERFLOW RECORD
-"RTN","C0CIN",143,0)
- . S G=G_G64(1,"OVF",ZI) ;HOPE IT'S NOT TOO BIG
-"RTN","C0CIN",144,0)
- S G2=$$DECODE^RGUTUU(G)
-"RTN","C0CIN",145,0)
+"RTN","C0CIN",156,0)
+ ;
+"RTN","C0CIN",157,0)
+CLEANCR(OUTXML,INXML) ; USE $C(10) TO SEPARATE THE STRING INXML INTO
+"RTN","C0CIN",158,0)
+ ;AN ARRAY OUTXML(n) OUTXML AND INXML PASSED BY NAME
+"RTN","C0CIN",159,0)
+ N ZX,ZY,ZN
+"RTN","C0CIN",160,0)
+ S ZX=1,ZN=1
+"RTN","C0CIN",161,0)
+ F  S ZY=$F(@INXML,$C(10),ZX) Q:ZY=0  D  ;
+"RTN","C0CIN",162,0)
+ . S @OUTXML@(ZN)=$E(G2,ZX,ZY-2)
+"RTN","C0CIN",163,0)
+ . I @OUTXML@(ZN)'="" S ZN=ZN+1
+"RTN","C0CIN",164,0)
+ . S ZX=ZY
+"RTN","C0CIN",165,0)
  Q
-"RTN","C0CIN",146,0)
- ;
-"RTN","C0CIN",147,0)
-NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
-"RTN","C0CIN",148,0)
- ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
-"RTN","C0CIN",149,0)
- ;
-"RTN","C0CIN",150,0)
- N ZI,ZN,ZTMP
-"RTN","C0CIN",151,0)
- S ZN=1
-"RTN","C0CIN",152,0)
- S @OUTXML@(ZN)=$P(@INXML,"><",ZN)_">"
-"RTN","C0CIN",153,0)
- S ZN=ZN+1
-"RTN","C0CIN",154,0)
- F  S @OUTXML@(ZN)="<"_$P(@INXML,"><",ZN) Q:$P(@INXML,"><",ZN+1)=""  D  ;
-"RTN","C0CIN",155,0)
- . S @OUTXML@(ZN)=@OUTXML@(ZN)_">"
-"RTN","C0CIN",156,0)
- . S ZN=ZN+1
-"RTN","C0CIN",157,0)
+"RTN","C0CIN",166,0)
+ ;
+"RTN","C0CIN",167,0)
+LOAD(ZRTN,filepath) ; load an xml file into the ZRTN array, passed by name
+"RTN","C0CIN",168,0)
+ n i
+"RTN","C0CIN",169,0)
+ D  ;
+"RTN","C0CIN",170,0)
+ . n zfile,zpath,ztmp,zok s (zfile,zpath,ztmp)=""
+"RTN","C0CIN",171,0)
+ . s ztmp=$na(^TMP("C0CLOAD",$J))
+"RTN","C0CIN",172,0)
+ . k @ztmp
+"RTN","C0CIN",173,0)
+ . s zfile=$re($p($re(filepath),"/",1)) ;file name
+"RTN","C0CIN",174,0)
+ . s zpath=$p(filepath,zfile,1) ; file path
+"RTN","C0CIN",175,0)
+ . s zok=$$FTG^%ZISH(zpath,zfile,$NA(@ztmp@(1)),3) ; import the file incr sub 3
+"RTN","C0CIN",176,0)
+ . m @ZRTN=@ztmp
+"RTN","C0CIN",177,0)
+ . k @ztmp
+"RTN","C0CIN",178,0)
+ . s i=$o(@ZRTN@(""),-1) ; highest line number
+"RTN","C0CIN",179,0)
+ q
+"RTN","C0CIN",180,0)
+ ;
+"RTN","C0CIN",181,0)
+UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+"RTN","C0CIN",182,0)
+ K ZERR,C0CIEN
+"RTN","C0CIN",183,0)
+ D CLEAN^DILF
+"RTN","C0CIN",184,0)
+ D UPDATE^DIE("","C0CFDA","C0CIEN","ZERR")
+"RTN","C0CIN",185,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CIN",186,0)
+ K C0CFDA
+"RTN","C0CIN",187,0)
  Q
-"RTN","C0CIN",158,0)
- ;
-"RTN","C0CIN",159,0)
-CLEANCR(OUTXML,INXML) ; USE $C(10) TO SEPARATE THE STRING INXML INTO
-"RTN","C0CIN",160,0)
- ;AN ARRAY OUTXML(n) OUTXML AND INXML PASSED BY NAME
-"RTN","C0CIN",161,0)
- N ZX,ZY,ZN
-"RTN","C0CIN",162,0)
- S ZX=1,ZN=1
-"RTN","C0CIN",163,0)
- F  S ZY=$F(@INXML,$C(10),ZX) Q:ZY=0  D  ;
-"RTN","C0CIN",164,0)
- . S @OUTXML@(ZN)=$E(G2,ZX,ZY-2)
-"RTN","C0CIN",165,0)
- . I @OUTXML@(ZN)'="" S ZN=ZN+1
-"RTN","C0CIN",166,0)
- . S ZX=ZY
-"RTN","C0CIN",167,0)
- Q
-"RTN","C0CIN",168,0)
- ;
-"RTN","C0CIN",169,0)
-LOAD(ZRTN,filepath) ; load an xml file into the ZRTN array, passed by name
-"RTN","C0CIN",170,0)
- n i
-"RTN","C0CIN",171,0)
- D  ;
-"RTN","C0CIN",172,0)
- . n zfile,zpath,ztmp,zok s (zfile,zpath,ztmp)=""
-"RTN","C0CIN",173,0)
- . s ztmp=$na(^TMP("C0CLOAD",$J))
-"RTN","C0CIN",174,0)
- . k @ztmp
-"RTN","C0CIN",175,0)
- . s zfile=$re($p($re(filepath),"/",1)) ;file name
-"RTN","C0CIN",176,0)
- . s zpath=$p(filepath,zfile,1) ; file path
-"RTN","C0CIN",177,0)
- . s zok=$$FTG^%ZISH(zpath,zfile,$NA(@ztmp@(1)),3) ; import the file incr sub 3
-"RTN","C0CIN",178,0)
- . m @ZRTN=@ztmp
-"RTN","C0CIN",179,0)
- . k @ztmp
-"RTN","C0CIN",180,0)
- . s i=$o(@ZRTN@(""),-1) ; highest line number
-"RTN","C0CIN",181,0)
- q
-"RTN","C0CIN",182,0)
- ;
-"RTN","C0CIN",183,0)
-UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
-"RTN","C0CIN",184,0)
- K ZERR,C0CIEN
-"RTN","C0CIN",185,0)
- D CLEAN^DILF
-"RTN","C0CIN",186,0)
- D UPDATE^DIE("","C0CFDA","C0CIEN","ZERR")
-"RTN","C0CIN",187,0)
- I $D(ZERR) D  ;
 "RTN","C0CIN",188,0)
- . W "ERROR",!
-"RTN","C0CIN",189,0)
- . ZWR ZERR
-"RTN","C0CIN",190,0)
- . B
-"RTN","C0CIN",191,0)
- K C0CFDA
-"RTN","C0CIN",192,0)
- Q
-"RTN","C0CIN",193,0)
  ; 
 "RTN","C0CLA7DD")
-0^80^B66668579
+0^80^B72588185
 "RTN","C0CLA7DD",1,0)
-C0CLA7DD ;WV/JMC - CCD/CCR Post Install DD X-Ref Setup Routine ; Aug 31, 2009
+C0CLA7DD ;WV/JMC - CCD/CCR Post Install DD X-Ref Setup Routine ; Aug 31, 2009 ; 10/30/12 10:16am
 "RTN","C0CLA7DD",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CLA7DD",3,0)
- ;
+ ; (C) 2009 John McCormack
 "RTN","C0CLA7DD",4,0)
+ ;
+"RTN","C0CLA7DD",5,0)
+ ; This program is free software: you can redistribute it and/or modify
+"RTN","C0CLA7DD",6,0)
+ ; it under the terms of the GNU Affero General Public License as
+"RTN","C0CLA7DD",7,0)
+ ; published by the Free Software Foundation, either version 3 of the
+"RTN","C0CLA7DD",8,0)
+ ; License, or (at your option) any later version.
+"RTN","C0CLA7DD",9,0)
+ ;
+"RTN","C0CLA7DD",10,0)
+ ; This program is distributed in the hope that it will be useful,
+"RTN","C0CLA7DD",11,0)
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","C0CLA7DD",12,0)
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","C0CLA7DD",13,0)
+ ; GNU Affero General Public License for more details.
+"RTN","C0CLA7DD",14,0)
+ ;
+"RTN","C0CLA7DD",15,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CLA7DD",16,0)
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+"RTN","C0CLA7DD",17,0)
+ ;
+"RTN","C0CLA7DD",18,0)
  ; Tasked by C0C post-install routine C0CENV to create C0C cross-references on V LAB file.
-"RTN","C0CLA7DD",5,0)
- ;
-"RTN","C0CLA7DD",6,0)
+"RTN","C0CLA7DD",19,0)
+ ;
+"RTN","C0CLA7DD",20,0)
  Q
-"RTN","C0CLA7DD",7,0)
- ;
-"RTN","C0CLA7DD",8,0)
- ;
-"RTN","C0CLA7DD",9,0)
+"RTN","C0CLA7DD",21,0)
+ ;
+"RTN","C0CLA7DD",22,0)
+ ;
+"RTN","C0CLA7DD",23,0)
 EN ; Add new style cross-references to V LAB file if it exists.
-"RTN","C0CLA7DD",10,0)
+"RTN","C0CLA7DD",24,0)
  ; OLD entry point - see new KIDS check points in C0CENV.
-"RTN","C0CLA7DD",11,0)
- ;
-"RTN","C0CLA7DD",12,0)
- ;
-"RTN","C0CLA7DD",13,0)
+"RTN","C0CLA7DD",25,0)
+ ;
+"RTN","C0CLA7DD",26,0)
+ ;
+"RTN","C0CLA7DD",27,0)
  ; Quit if AUPNVLAB global does not exist.
-"RTN","C0CLA7DD",14,0)
+"RTN","C0CLA7DD",28,0)
  I $$VFILE^DILFD(9000010.09)'=1 Q
-"RTN","C0CLA7DD",15,0)
- ;
-"RTN","C0CLA7DD",16,0)
+"RTN","C0CLA7DD",29,0)
+ ;
+"RTN","C0CLA7DD",30,0)
  N MSG
-"RTN","C0CLA7DD",17,0)
- ;
-"RTN","C0CLA7DD",18,0)
+"RTN","C0CLA7DD",31,0)
+ ;
+"RTN","C0CLA7DD",32,0)
  S MSG="Starting installation of ALR1 cross-reference at "_$$HTE^XLFDT($H,"1Z")
-"RTN","C0CLA7DD",19,0)
+"RTN","C0CLA7DD",33,0)
  D BMES(MSG)
-"RTN","C0CLA7DD",20,0)
+"RTN","C0CLA7DD",34,0)
  D ALR1
-"RTN","C0CLA7DD",21,0)
+"RTN","C0CLA7DD",35,0)
  S MSG="Installation of ALR1 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
-"RTN","C0CLA7DD",22,0)
+"RTN","C0CLA7DD",36,0)
  D BMES(MSG)
-"RTN","C0CLA7DD",23,0)
- ;
-"RTN","C0CLA7DD",24,0)
+"RTN","C0CLA7DD",37,0)
+ ;
+"RTN","C0CLA7DD",38,0)
  S MSG="Starting installation of ALR2 cross-reference at "_$$HTE^XLFDT($H,"1Z")
-"RTN","C0CLA7DD",25,0)
+"RTN","C0CLA7DD",39,0)
  D BMES(MSG)
-"RTN","C0CLA7DD",26,0)
+"RTN","C0CLA7DD",40,0)
  D ALR2
-"RTN","C0CLA7DD",27,0)
+"RTN","C0CLA7DD",41,0)
  S MSG="Installation of ALR2 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
-"RTN","C0CLA7DD",28,0)
+"RTN","C0CLA7DD",42,0)
  D BMES(MSG)
-"RTN","C0CLA7DD",29,0)
- ;
-"RTN","C0CLA7DD",30,0)
+"RTN","C0CLA7DD",43,0)
+ ;
+"RTN","C0CLA7DD",44,0)
  S MSG="Starting installation of ALR3 cross-reference at "_$$HTE^XLFDT($H,"1Z")
-"RTN","C0CLA7DD",31,0)
+"RTN","C0CLA7DD",45,0)
  D BMES(MSG)
-"RTN","C0CLA7DD",32,0)
+"RTN","C0CLA7DD",46,0)
  D ALR3
-"RTN","C0CLA7DD",33,0)
+"RTN","C0CLA7DD",47,0)
  S MSG="Installation of ALR3 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
-"RTN","C0CLA7DD",34,0)
+"RTN","C0CLA7DD",48,0)
  D BMES(MSG)
-"RTN","C0CLA7DD",35,0)
- ;
-"RTN","C0CLA7DD",36,0)
+"RTN","C0CLA7DD",49,0)
+ ;
+"RTN","C0CLA7DD",50,0)
  S MSG="Starting installation of ALR4 cross-reference at "_$$HTE^XLFDT($H,"1Z")
-"RTN","C0CLA7DD",37,0)
+"RTN","C0CLA7DD",51,0)
  D BMES(MSG)
-"RTN","C0CLA7DD",38,0)
+"RTN","C0CLA7DD",52,0)
  D ALR4
-"RTN","C0CLA7DD",39,0)
+"RTN","C0CLA7DD",53,0)
  S MSG="Installation of ALR4 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
-"RTN","C0CLA7DD",40,0)
+"RTN","C0CLA7DD",54,0)
  D BMES(MSG)
-"RTN","C0CLA7DD",41,0)
- ;
-"RTN","C0CLA7DD",42,0)
+"RTN","C0CLA7DD",55,0)
+ ;
+"RTN","C0CLA7DD",56,0)
  S MSG="Starting installation of ALR5 cross-reference at "_$$HTE^XLFDT($H,"1Z")
-"RTN","C0CLA7DD",43,0)
+"RTN","C0CLA7DD",57,0)
  D BMES(MSG)
-"RTN","C0CLA7DD",44,0)
+"RTN","C0CLA7DD",58,0)
  D ALR5
-"RTN","C0CLA7DD",45,0)
+"RTN","C0CLA7DD",59,0)
  S MSG="Installation of ALR5 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
-"RTN","C0CLA7DD",46,0)
+"RTN","C0CLA7DD",60,0)
  D BMES(MSG)
-"RTN","C0CLA7DD",47,0)
- ;
-"RTN","C0CLA7DD",48,0)
+"RTN","C0CLA7DD",61,0)
+ ;
+"RTN","C0CLA7DD",62,0)
  Q
-"RTN","C0CLA7DD",49,0)
- ;
-"RTN","C0CLA7DD",50,0)
- ;
-"RTN","C0CLA7DD",51,0)
+"RTN","C0CLA7DD",63,0)
+ ;
+"RTN","C0CLA7DD",64,0)
+ ;
+"RTN","C0CLA7DD",65,0)
 ALR1 ; Installation of ALR1 cross-reference
-"RTN","C0CLA7DD",52,0)
- ;
-"RTN","C0CLA7DD",53,0)
+"RTN","C0CLA7DD",66,0)
+ ;
+"RTN","C0CLA7DD",67,0)
  N C0CFLAG,C0CXR,C0CRES,C0COUT
-"RTN","C0CLA7DD",54,0)
- ;
-"RTN","C0CLA7DD",55,0)
+"RTN","C0CLA7DD",68,0)
+ ;
+"RTN","C0CLA7DD",69,0)
  S C0CFLAG=""
-"RTN","C0CLA7DD",56,0)
- ;
-"RTN","C0CLA7DD",57,0)
+"RTN","C0CLA7DD",70,0)
+ ;
+"RTN","C0CLA7DD",71,0)
  S C0CXR("FILE")=9000010.09
-"RTN","C0CLA7DD",58,0)
+"RTN","C0CLA7DD",72,0)
  S C0CXR("NAME")="ALR1"
-"RTN","C0CLA7DD",59,0)
+"RTN","C0CLA7DD",73,0)
  S C0CXR("TYPE")="R"
-"RTN","C0CLA7DD",60,0)
+"RTN","C0CLA7DD",74,0)
  S C0CXR("USE")="S"
-"RTN","C0CLA7DD",61,0)
+"RTN","C0CLA7DD",75,0)
  S C0CXR("EXECUTION")="R"
-"RTN","C0CLA7DD",62,0)
+"RTN","C0CLA7DD",76,0)
  S C0CXR("ACTIVITY")="IR"
-"RTN","C0CLA7DD",63,0)
+"RTN","C0CLA7DD",77,0)
  S C0CXR("SHORT DESCR")="X-ref to link entry with parent in LAB DATA file (#63)"
-"RTN","C0CLA7DD",64,0)
+"RTN","C0CLA7DD",78,0)
  S C0CXR("VAL",1)=.02
-"RTN","C0CLA7DD",65,0)
+"RTN","C0CLA7DD",79,0)
  S C0CXR("VAL",1,"SUBSCRIPT")=1
-"RTN","C0CLA7DD",66,0)
+"RTN","C0CLA7DD",80,0)
  S C0CXR("VAL",1,"COLLATION")="F"
-"RTN","C0CLA7DD",67,0)
+"RTN","C0CLA7DD",81,0)
  S C0CXR("VAL",2)=.06
-"RTN","C0CLA7DD",68,0)
+"RTN","C0CLA7DD",82,0)
  S C0CXR("VAL",2,"SUBSCRIPT")=2
-"RTN","C0CLA7DD",69,0)
+"RTN","C0CLA7DD",83,0)
  S C0CXR("VAL",2,"LENGTH")=30
-"RTN","C0CLA7DD",70,0)
+"RTN","C0CLA7DD",84,0)
  S C0CXR("VAL",2,"COLLATION")="F"
-"RTN","C0CLA7DD",71,0)
+"RTN","C0CLA7DD",85,0)
  S C0CXR("VAL",3)=.01
-"RTN","C0CLA7DD",72,0)
+"RTN","C0CLA7DD",86,0)
  S C0CXR("VAL",3,"SUBSCRIPT")=3
-"RTN","C0CLA7DD",73,0)
+"RTN","C0CLA7DD",87,0)
  S C0CXR("VAL",3,"COLLATION")="F"
-"RTN","C0CLA7DD",74,0)
+"RTN","C0CLA7DD",88,0)
  S C0CXR("VAL",4)=1201
-"RTN","C0CLA7DD",75,0)
+"RTN","C0CLA7DD",89,0)
  S C0CXR("VAL",4,"SUBSCRIPT")=4
-"RTN","C0CLA7DD",76,0)
+"RTN","C0CLA7DD",90,0)
  S C0CXR("VAL",4,"COLLATION")="F"
-"RTN","C0CLA7DD",77,0)
+"RTN","C0CLA7DD",91,0)
  D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT")
-"RTN","C0CLA7DD",78,0)
- ;
-"RTN","C0CLA7DD",79,0)
+"RTN","C0CLA7DD",92,0)
+ ;
+"RTN","C0CLA7DD",93,0)
  Q
-"RTN","C0CLA7DD",80,0)
- ;
-"RTN","C0CLA7DD",81,0)
- ;
-"RTN","C0CLA7DD",82,0)
+"RTN","C0CLA7DD",94,0)
+ ;
+"RTN","C0CLA7DD",95,0)
+ ;
+"RTN","C0CLA7DD",96,0)
 ALR2 ; Installation of ALR2 cross-reference
-"RTN","C0CLA7DD",83,0)
- ;
-"RTN","C0CLA7DD",84,0)
+"RTN","C0CLA7DD",97,0)
+ ;
+"RTN","C0CLA7DD",98,0)
  N C0CFLAG,C0CXR,C0CRES,C0COUT
-"RTN","C0CLA7DD",85,0)
- ;
-"RTN","C0CLA7DD",86,0)
+"RTN","C0CLA7DD",99,0)
+ ;
+"RTN","C0CLA7DD",100,0)
  S C0CFLAG=""
-"RTN","C0CLA7DD",87,0)
- ;
-"RTN","C0CLA7DD",88,0)
+"RTN","C0CLA7DD",101,0)
+ ;
+"RTN","C0CLA7DD",102,0)
  S C0CXR("FILE")=9000010.09
-"RTN","C0CLA7DD",89,0)
+"RTN","C0CLA7DD",103,0)
  S C0CXR("NAME")="ALR2"
-"RTN","C0CLA7DD",90,0)
+"RTN","C0CLA7DD",104,0)
  S C0CXR("TYPE")="MU"
-"RTN","C0CLA7DD",91,0)
+"RTN","C0CLA7DD",105,0)
  S C0CXR("USE")="S"
-"RTN","C0CLA7DD",92,0)
+"RTN","C0CLA7DD",106,0)
  S C0CXR("EXECUTION")="R"
-"RTN","C0CLA7DD",93,0)
+"RTN","C0CLA7DD",107,0)
  S C0CXR("ACTIVITY")="IR"
-"RTN","C0CLA7DD",94,0)
+"RTN","C0CLA7DD",108,0)
  S C0CXR("SHORT DESCR")="X-ref for LOINC code related to test result."
-"RTN","C0CLA7DD",95,0)
+"RTN","C0CLA7DD",109,0)
  S C0CXR("DESCR",1)="This cross-reference is used to identify the LOINC codes"
-"RTN","C0CLA7DD",96,0)
+"RTN","C0CLA7DD",110,0)
  S C0CXR("DESCR",2)="that has been assigned to a lab result. Allows queries to"
-"RTN","C0CLA7DD",97,0)
+"RTN","C0CLA7DD",111,0)
  S C0CXR("DESCR",3)="retrieve the LOINC code associated with a specific test"
-"RTN","C0CLA7DD",98,0)
+"RTN","C0CLA7DD",112,0)
  S C0CXR("DESCR",4)="result."
-"RTN","C0CLA7DD",99,0)
+"RTN","C0CLA7DD",113,0)
  S C0CXR("SET")="S ^AUPNVLAB(""ALR2"",X(1),X(2),X(3),X(4),X(5),DA)="""""
-"RTN","C0CLA7DD",100,0)
+"RTN","C0CLA7DD",114,0)
  S C0CXR("KILL")="K ^AUPNVLAB(""ALR2"",X(1),X(2),X(3),X(4),X(5),DA)"
-"RTN","C0CLA7DD",101,0)
+"RTN","C0CLA7DD",115,0)
  S C0CXR("WHOLE KILL")="K ^AUPNVLAB(""ALR2"")"
-"RTN","C0CLA7DD",102,0)
+"RTN","C0CLA7DD",116,0)
  S C0CXR("VAL",1)=.02
-"RTN","C0CLA7DD",103,0)
+"RTN","C0CLA7DD",117,0)
  S C0CXR("VAL",1,"SUBSCRIPT")=1
-"RTN","C0CLA7DD",104,0)
+"RTN","C0CLA7DD",118,0)
  S C0CXR("VAL",1,"COLLATION")="F"
-"RTN","C0CLA7DD",105,0)
+"RTN","C0CLA7DD",119,0)
  S C0CXR("VAL",2)=1201
-"RTN","C0CLA7DD",106,0)
+"RTN","C0CLA7DD",120,0)
  S C0CXR("VAL",2,"SUBSCRIPT")=2
-"RTN","C0CLA7DD",107,0)
+"RTN","C0CLA7DD",121,0)
  S C0CXR("VAL",2,"COLLATION")="F"
-"RTN","C0CLA7DD",108,0)
+"RTN","C0CLA7DD",122,0)
  S C0CXR("VAL",3)=.06
-"RTN","C0CLA7DD",109,0)
+"RTN","C0CLA7DD",123,0)
  S C0CXR("VAL",3,"SUBSCRIPT")=3
-"RTN","C0CLA7DD",110,0)
+"RTN","C0CLA7DD",124,0)
  S C0CXR("VAL",3,"COLLATION")="F"
-"RTN","C0CLA7DD",111,0)
+"RTN","C0CLA7DD",125,0)
  S C0CXR("VAL",4)=.01
-"RTN","C0CLA7DD",112,0)
+"RTN","C0CLA7DD",126,0)
  S C0CXR("VAL",4,"SUBSCRIPT")=4
-"RTN","C0CLA7DD",113,0)
+"RTN","C0CLA7DD",127,0)
  S C0CXR("VAL",4,"COLLATION")="F"
-"RTN","C0CLA7DD",114,0)
+"RTN","C0CLA7DD",128,0)
  S C0CXR("VAL",5)=1113
-"RTN","C0CLA7DD",115,0)
+"RTN","C0CLA7DD",129,0)
  S C0CXR("VAL",5,"SUBSCRIPT")=5
-"RTN","C0CLA7DD",116,0)
+"RTN","C0CLA7DD",130,0)
  S C0CXR("VAL",5,"COLLATION")="F"
-"RTN","C0CLA7DD",117,0)
+"RTN","C0CLA7DD",131,0)
  D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT")
-"RTN","C0CLA7DD",118,0)
- ;
-"RTN","C0CLA7DD",119,0)
+"RTN","C0CLA7DD",132,0)
+ ;
+"RTN","C0CLA7DD",133,0)
  Q
-"RTN","C0CLA7DD",120,0)
- ;
-"RTN","C0CLA7DD",121,0)
- ;
-"RTN","C0CLA7DD",122,0)
+"RTN","C0CLA7DD",134,0)
+ ;
+"RTN","C0CLA7DD",135,0)
+ ;
+"RTN","C0CLA7DD",136,0)
 ALR3 ; Installation of ALR3 cross-reference
-"RTN","C0CLA7DD",123,0)
- ;
-"RTN","C0CLA7DD",124,0)
+"RTN","C0CLA7DD",137,0)
+ ;
+"RTN","C0CLA7DD",138,0)
  N C0CFLAG,C0CXR,C0CRES,C0COUT
-"RTN","C0CLA7DD",125,0)
- ;
-"RTN","C0CLA7DD",126,0)
+"RTN","C0CLA7DD",139,0)
+ ;
+"RTN","C0CLA7DD",140,0)
  S C0CFLAG=""
-"RTN","C0CLA7DD",127,0)
- ;
-"RTN","C0CLA7DD",128,0)
+"RTN","C0CLA7DD",141,0)
+ ;
+"RTN","C0CLA7DD",142,0)
  S C0CXR("FILE")=9000010.09
-"RTN","C0CLA7DD",129,0)
+"RTN","C0CLA7DD",143,0)
  S C0CXR("NAME")="ALR3"
-"RTN","C0CLA7DD",130,0)
+"RTN","C0CLA7DD",144,0)
  S C0CXR("TYPE")="R"
-"RTN","C0CLA7DD",131,0)
+"RTN","C0CLA7DD",145,0)
  S C0CXR("USE")="S"
-"RTN","C0CLA7DD",132,0)
+"RTN","C0CLA7DD",146,0)
  S C0CXR("EXECUTION")="F"
-"RTN","C0CLA7DD",133,0)
+"RTN","C0CLA7DD",147,0)
  S C0CXR("ACTIVITY")="IR"
-"RTN","C0CLA7DD",134,0)
+"RTN","C0CLA7DD",148,0)
  S C0CXR("SHORT DESCR")="X-ref for LOINC code related to test result - any patient"
-"RTN","C0CLA7DD",135,0)
+"RTN","C0CLA7DD",149,0)
  S C0CXR("DESCR",1)="This cross-reference is used to identify the LOINC codes that has been assigned to a lab result. Allows queries"
-"RTN","C0CLA7DD",136,0)
+"RTN","C0CLA7DD",150,0)
  S C0CXR("DESCR",2)="to retrieve the LOINC code associated with a specific test result. It allows any patient"
-"RTN","C0CLA7DD",137,0)
+"RTN","C0CLA7DD",151,0)
  S C0CXR("DESCR",3)="lab results to be identified by LOINC"
-"RTN","C0CLA7DD",138,0)
+"RTN","C0CLA7DD",152,0)
  S C0CXR("VAL",1)=1113
-"RTN","C0CLA7DD",139,0)
+"RTN","C0CLA7DD",153,0)
  S C0CXR("VAL",1,"SUBSCRIPT")=1
-"RTN","C0CLA7DD",140,0)
+"RTN","C0CLA7DD",154,0)
  S C0CXR("VAL",1,"COLLATION")="F"
-"RTN","C0CLA7DD",141,0)
- ;
-"RTN","C0CLA7DD",142,0)
+"RTN","C0CLA7DD",155,0)
+ ;
+"RTN","C0CLA7DD",156,0)
  D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT")
-"RTN","C0CLA7DD",143,0)
- ;
-"RTN","C0CLA7DD",144,0)
+"RTN","C0CLA7DD",157,0)
+ ;
+"RTN","C0CLA7DD",158,0)
  Q
-"RTN","C0CLA7DD",145,0)
- ;
-"RTN","C0CLA7DD",146,0)
- ;
-"RTN","C0CLA7DD",147,0)
+"RTN","C0CLA7DD",159,0)
+ ;
+"RTN","C0CLA7DD",160,0)
+ ;
+"RTN","C0CLA7DD",161,0)
 ALR4 ; Installation of ALR4 cross-reference
-"RTN","C0CLA7DD",148,0)
- ;
-"RTN","C0CLA7DD",149,0)
+"RTN","C0CLA7DD",162,0)
+ ;
+"RTN","C0CLA7DD",163,0)
  N C0CFLAG,C0CXR,C0CRES,C0COUT
-"RTN","C0CLA7DD",150,0)
- ;
-"RTN","C0CLA7DD",151,0)
+"RTN","C0CLA7DD",164,0)
+ ;
+"RTN","C0CLA7DD",165,0)
  S C0CFLAG=""
-"RTN","C0CLA7DD",152,0)
- ;
-"RTN","C0CLA7DD",153,0)
+"RTN","C0CLA7DD",166,0)
+ ;
+"RTN","C0CLA7DD",167,0)
  S C0CXR("FILE")=9000010.09
-"RTN","C0CLA7DD",154,0)
+"RTN","C0CLA7DD",168,0)
  S C0CXR("NAME")="ALR4"
-"RTN","C0CLA7DD",155,0)
+"RTN","C0CLA7DD",169,0)
  S C0CXR("TYPE")="R"
-"RTN","C0CLA7DD",156,0)
+"RTN","C0CLA7DD",170,0)
  S C0CXR("USE")="S"
-"RTN","C0CLA7DD",157,0)
+"RTN","C0CLA7DD",171,0)
  S C0CXR("EXECUTION")="R"
-"RTN","C0CLA7DD",158,0)
+"RTN","C0CLA7DD",172,0)
  S C0CXR("ACTIVITY")="IR"
-"RTN","C0CLA7DD",159,0)
+"RTN","C0CLA7DD",173,0)
  S C0CXR("SHORT DESCR")="X-ref by patient and collection date/time"
-"RTN","C0CLA7DD",160,0)
+"RTN","C0CLA7DD",174,0)
  S C0CXR("DESCR",1)="This cross-reference is used to identify all lab results for a"
-"RTN","C0CLA7DD",161,0)
+"RTN","C0CLA7DD",175,0)
  S C0CXR("DESCR",2)="patient by collection date/time. This includes results that are only in"
-"RTN","C0CLA7DD",162,0)
+"RTN","C0CLA7DD",176,0)
  S C0CXR("DESCR",3)="this file and therefore do not have a corresponding entry in LAB DATA"
-"RTN","C0CLA7DD",163,0)
+"RTN","C0CLA7DD",177,0)
  S C0CXR("DESCR",4)="file (#63)."
-"RTN","C0CLA7DD",164,0)
+"RTN","C0CLA7DD",178,0)
  S C0CXR("VAL",1)=.02
-"RTN","C0CLA7DD",165,0)
+"RTN","C0CLA7DD",179,0)
  S C0CXR("VAL",1,"SUBSCRIPT")=1
-"RTN","C0CLA7DD",166,0)
+"RTN","C0CLA7DD",180,0)
  S C0CXR("VAL",1,"COLLATION")="F"
-"RTN","C0CLA7DD",167,0)
+"RTN","C0CLA7DD",181,0)
  S C0CXR("VAL",2)=1201
-"RTN","C0CLA7DD",168,0)
+"RTN","C0CLA7DD",182,0)
  S C0CXR("VAL",2,"SUBSCRIPT")=2
-"RTN","C0CLA7DD",169,0)
+"RTN","C0CLA7DD",183,0)
  S C0CXR("VAL",2,"COLLATION")="F"
-"RTN","C0CLA7DD",170,0)
- ;
-"RTN","C0CLA7DD",171,0)
+"RTN","C0CLA7DD",184,0)
+ ;
+"RTN","C0CLA7DD",185,0)
  D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT")
-"RTN","C0CLA7DD",172,0)
- ;
-"RTN","C0CLA7DD",173,0)
+"RTN","C0CLA7DD",186,0)
+ ;
+"RTN","C0CLA7DD",187,0)
  Q
-"RTN","C0CLA7DD",174,0)
- ;
-"RTN","C0CLA7DD",175,0)
- ;
-"RTN","C0CLA7DD",176,0)
+"RTN","C0CLA7DD",188,0)
+ ;
+"RTN","C0CLA7DD",189,0)
+ ;
+"RTN","C0CLA7DD",190,0)
 ALR5 ; Installation of ALR5 cross-reference
-"RTN","C0CLA7DD",177,0)
- ;
-"RTN","C0CLA7DD",178,0)
+"RTN","C0CLA7DD",191,0)
+ ;
+"RTN","C0CLA7DD",192,0)
  N C0CFLAG,C0CXR,C0CRES,C0COUT
-"RTN","C0CLA7DD",179,0)
- ;
-"RTN","C0CLA7DD",180,0)
+"RTN","C0CLA7DD",193,0)
+ ;
+"RTN","C0CLA7DD",194,0)
  S C0CFLAG=""
-"RTN","C0CLA7DD",181,0)
- ;
-"RTN","C0CLA7DD",182,0)
+"RTN","C0CLA7DD",195,0)
+ ;
+"RTN","C0CLA7DD",196,0)
  S C0CXR("FILE")=9000010.09
-"RTN","C0CLA7DD",183,0)
+"RTN","C0CLA7DD",197,0)
  S C0CXR("NAME")="ALR5"
-"RTN","C0CLA7DD",184,0)
+"RTN","C0CLA7DD",198,0)
  S C0CXR("TYPE")="R"
-"RTN","C0CLA7DD",185,0)
+"RTN","C0CLA7DD",199,0)
  S C0CXR("USE")="S"
-"RTN","C0CLA7DD",186,0)
+"RTN","C0CLA7DD",200,0)
  S C0CXR("EXECUTION")="R"
-"RTN","C0CLA7DD",187,0)
+"RTN","C0CLA7DD",201,0)
  S C0CXR("ACTIVITY")="IR"
-"RTN","C0CLA7DD",188,0)
+"RTN","C0CLA7DD",202,0)
  S C0CXR("SHORT DESCR")="X-ref by patient and results availble date/time"
-"RTN","C0CLA7DD",189,0)
+"RTN","C0CLA7DD",203,0)
  S C0CXR("DESCR",1)="This cross-reference is used to identify all lab results for a"
-"RTN","C0CLA7DD",190,0)
+"RTN","C0CLA7DD",204,0)
  S C0CXR("DESCR",2)="patient by results available date/time. This includes results that are only in"
-"RTN","C0CLA7DD",191,0)
+"RTN","C0CLA7DD",205,0)
  S C0CXR("DESCR",3)="this file and therefore do not have a corresponding entry in LAB DATA"
-"RTN","C0CLA7DD",192,0)
+"RTN","C0CLA7DD",206,0)
  S C0CXR("DESCR",4)="file (#63)."
-"RTN","C0CLA7DD",193,0)
+"RTN","C0CLA7DD",207,0)
  S C0CXR("VAL",1)=.02
-"RTN","C0CLA7DD",194,0)
+"RTN","C0CLA7DD",208,0)
  S C0CXR("VAL",1,"SUBSCRIPT")=1
-"RTN","C0CLA7DD",195,0)
+"RTN","C0CLA7DD",209,0)
  S C0CXR("VAL",1,"COLLATION")="F"
-"RTN","C0CLA7DD",196,0)
+"RTN","C0CLA7DD",210,0)
  S C0CXR("VAL",2)=1212
-"RTN","C0CLA7DD",197,0)
+"RTN","C0CLA7DD",211,0)
  S C0CXR("VAL",2,"SUBSCRIPT")=2
-"RTN","C0CLA7DD",198,0)
+"RTN","C0CLA7DD",212,0)
  S C0CXR("VAL",2,"COLLATION")="F"
-"RTN","C0CLA7DD",199,0)
- ;
-"RTN","C0CLA7DD",200,0)
+"RTN","C0CLA7DD",213,0)
+ ;
+"RTN","C0CLA7DD",214,0)
  D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT")
-"RTN","C0CLA7DD",201,0)
- ;
-"RTN","C0CLA7DD",202,0)
+"RTN","C0CLA7DD",215,0)
+ ;
+"RTN","C0CLA7DD",216,0)
  Q
-"RTN","C0CLA7DD",203,0)
- ;
-"RTN","C0CLA7DD",204,0)
- ;
-"RTN","C0CLA7DD",205,0)
+"RTN","C0CLA7DD",217,0)
+ ;
+"RTN","C0CLA7DD",218,0)
+ ;
+"RTN","C0CLA7DD",219,0)
 REINDEX ; Set data into indexes for current entries.
-"RTN","C0CLA7DD",206,0)
- ;
-"RTN","C0CLA7DD",207,0)
- ;
-"RTN","C0CLA7DD",208,0)
+"RTN","C0CLA7DD",220,0)
+ ;
+"RTN","C0CLA7DD",221,0)
+ ;
+"RTN","C0CLA7DD",222,0)
  N C0CHLOG,DA,DIK,MSG
-"RTN","C0CLA7DD",209,0)
- ;
-"RTN","C0CLA7DD",210,0)
+"RTN","C0CLA7DD",223,0)
+ ;
+"RTN","C0CLA7DD",224,0)
  S C0CHLOG("START")=$H
-"RTN","C0CLA7DD",211,0)
+"RTN","C0CLA7DD",225,0)
  S MSG="Starting indexing of ALR1, ALR2, ALR4, ALR5 indexes - "_$$HTE^XLFDT(C0CHLOG("START"),"1Z")
-"RTN","C0CLA7DD",212,0)
+"RTN","C0CLA7DD",226,0)
  D BMES(MSG),SENDXQA(MSG)
-"RTN","C0CLA7DD",213,0)
- ;
-"RTN","C0CLA7DD",214,0)
+"RTN","C0CLA7DD",227,0)
+ ;
+"RTN","C0CLA7DD",228,0)
  S DIK="^AUPNVLAB("
-"RTN","C0CLA7DD",215,0)
+"RTN","C0CLA7DD",229,0)
  S DIK(1)=".02^ALR1^ALR2^ALR4^ALR5"
-"RTN","C0CLA7DD",216,0)
+"RTN","C0CLA7DD",230,0)
  D ENALL^DIK
-"RTN","C0CLA7DD",217,0)
- ;
-"RTN","C0CLA7DD",218,0)
+"RTN","C0CLA7DD",231,0)
+ ;
+"RTN","C0CLA7DD",232,0)
  S C0CHLOG("END")=$H
-"RTN","C0CLA7DD",219,0)
+"RTN","C0CLA7DD",233,0)
  S MSG="Finished indexing of ALR1, ALR2, ALR4, ALR5 indexes - "_$$HTE^XLFDT(C0CHLOG("END"),"1Z")
-"RTN","C0CLA7DD",220,0)
+"RTN","C0CLA7DD",234,0)
  D BMES(MSG),SENDXQA(MSG)
-"RTN","C0CLA7DD",221,0)
- ;
-"RTN","C0CLA7DD",222,0)
+"RTN","C0CLA7DD",235,0)
+ ;
+"RTN","C0CLA7DD",236,0)
  S MSG="Elapsed Time: "_$$HDIFF^XLFDT(C0CHLOG("END"),C0CHLOG("START"),3)
-"RTN","C0CLA7DD",223,0)
+"RTN","C0CLA7DD",237,0)
  D BMES(MSG)
-"RTN","C0CLA7DD",224,0)
- ;
-"RTN","C0CLA7DD",225,0)
+"RTN","C0CLA7DD",238,0)
+ ;
+"RTN","C0CLA7DD",239,0)
  S C0CHLOG("START")=$H
-"RTN","C0CLA7DD",226,0)
+"RTN","C0CLA7DD",240,0)
  S MSG="Starting indexing of ALR3 index - "_$$HTE^XLFDT(C0CHLOG("START"),"1Z")
-"RTN","C0CLA7DD",227,0)
+"RTN","C0CLA7DD",241,0)
  D BMES(MSG),SENDXQA(MSG)
-"RTN","C0CLA7DD",228,0)
- ;
-"RTN","C0CLA7DD",229,0)
+"RTN","C0CLA7DD",242,0)
+ ;
+"RTN","C0CLA7DD",243,0)
  K DA,DIK
-"RTN","C0CLA7DD",230,0)
+"RTN","C0CLA7DD",244,0)
  S DIK="^AUPNVLAB("
-"RTN","C0CLA7DD",231,0)
+"RTN","C0CLA7DD",245,0)
  S DIK(1)="1113^ALR3"
-"RTN","C0CLA7DD",232,0)
+"RTN","C0CLA7DD",246,0)
  D ENALL^DIK
-"RTN","C0CLA7DD",233,0)
- ;
-"RTN","C0CLA7DD",234,0)
+"RTN","C0CLA7DD",247,0)
+ ;
+"RTN","C0CLA7DD",248,0)
  S C0CHLOG("END")=$H
-"RTN","C0CLA7DD",235,0)
+"RTN","C0CLA7DD",249,0)
  S MSG="Finished indexing of ALR3 index - "_$$HTE^XLFDT(C0CHLOG("END"),"1Z")
-"RTN","C0CLA7DD",236,0)
+"RTN","C0CLA7DD",250,0)
  D BMES(MSG),SENDXQA(MSG)
-"RTN","C0CLA7DD",237,0)
- ;
-"RTN","C0CLA7DD",238,0)
+"RTN","C0CLA7DD",251,0)
+ ;
+"RTN","C0CLA7DD",252,0)
  S MSG="Elapsed Time: "_$$HDIFF^XLFDT(C0CHLOG("END"),C0CHLOG("START"),3)
-"RTN","C0CLA7DD",239,0)
+"RTN","C0CLA7DD",253,0)
  D BMES(MSG)
-"RTN","C0CLA7DD",240,0)
- ;
-"RTN","C0CLA7DD",241,0)
+"RTN","C0CLA7DD",254,0)
+ ;
+"RTN","C0CLA7DD",255,0)
  Q
-"RTN","C0CLA7DD",242,0)
- ;
-"RTN","C0CLA7DD",243,0)
- ;
-"RTN","C0CLA7DD",244,0)
+"RTN","C0CLA7DD",256,0)
+ ;
+"RTN","C0CLA7DD",257,0)
+ ;
+"RTN","C0CLA7DD",258,0)
 BMES(STR) ; Write BMES^XPDUTL statements
-"RTN","C0CLA7DD",245,0)
- ;
-"RTN","C0CLA7DD",246,0)
+"RTN","C0CLA7DD",259,0)
+ ;
+"RTN","C0CLA7DD",260,0)
  D BMES^XPDUTL($$CJ^XLFSTR(STR,IOM))
-"RTN","C0CLA7DD",247,0)
- ;
-"RTN","C0CLA7DD",248,0)
+"RTN","C0CLA7DD",261,0)
+ ;
+"RTN","C0CLA7DD",262,0)
  Q
-"RTN","C0CLA7DD",249,0)
- ;
-"RTN","C0CLA7DD",250,0)
- ;
-"RTN","C0CLA7DD",251,0)
+"RTN","C0CLA7DD",263,0)
+ ;
+"RTN","C0CLA7DD",264,0)
+ ;
+"RTN","C0CLA7DD",265,0)
 SENDXQA(MSG) ; Send alert for reindex status
-"RTN","C0CLA7DD",252,0)
- ;
-"RTN","C0CLA7DD",253,0)
+"RTN","C0CLA7DD",266,0)
+ ;
+"RTN","C0CLA7DD",267,0)
  N XQA,XQAMSG
-"RTN","C0CLA7DD",254,0)
- ;
-"RTN","C0CLA7DD",255,0)
+"RTN","C0CLA7DD",268,0)
+ ;
+"RTN","C0CLA7DD",269,0)
  S XQA(DUZ)=""
-"RTN","C0CLA7DD",256,0)
+"RTN","C0CLA7DD",270,0)
  S XQAMSG=MSG
-"RTN","C0CLA7DD",257,0)
+"RTN","C0CLA7DD",271,0)
  D SETUP^XQALERT
-"RTN","C0CLA7DD",258,0)
- ;
-"RTN","C0CLA7DD",259,0)
+"RTN","C0CLA7DD",272,0)
+ ;
+"RTN","C0CLA7DD",273,0)
  Q
 "RTN","C0CLA7Q")
-0^62^B21818572
+0^62^B24672517
 "RTN","C0CLA7Q",1,0)
-C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Jul 6, 2009
+C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Jul 6, 2009 ; 10/30/12 10:16am
 "RTN","C0CLA7Q",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CLA7Q",3,0)
  ;
 "RTN","C0CLA7Q",4,0)
- ;
+ ; (C) 2009 John McCormack
 "RTN","C0CLA7Q",5,0)
+ ;
+"RTN","C0CLA7Q",6,0)
+ ; This program is free software: you can redistribute it and/or modify
+"RTN","C0CLA7Q",7,0)
+ ; it under the terms of the GNU Affero General Public License as
+"RTN","C0CLA7Q",8,0)
+ ; published by the Free Software Foundation, either version 3 of the
+"RTN","C0CLA7Q",9,0)
+ ; License, or (at your option) any later version.
+"RTN","C0CLA7Q",10,0)
+ ;
+"RTN","C0CLA7Q",11,0)
+ ; This program is distributed in the hope that it will be useful,
+"RTN","C0CLA7Q",12,0)
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","C0CLA7Q",13,0)
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","C0CLA7Q",14,0)
+ ; GNU Affero General Public License for more details.
+"RTN","C0CLA7Q",15,0)
+ ;
+"RTN","C0CLA7Q",16,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CLA7Q",17,0)
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+"RTN","C0CLA7Q",18,0)
+ ;
+"RTN","C0CLA7Q",19,0)
+ ;
+"RTN","C0CLA7Q",20,0)
  Q
-"RTN","C0CLA7Q",6,0)
- ;
-"RTN","C0CLA7Q",7,0)
- ;
-"RTN","C0CLA7Q",8,0)
+"RTN","C0CLA7Q",21,0)
+ ;
+"RTN","C0CLA7Q",22,0)
+ ;
+"RTN","C0CLA7Q",23,0)
 LAB(C0CPTID,C0CSDT,C0CEDT,C0CSC,C0CSPEC,C0CERR,C0CDEST,C0CHL7) ; Entry point for Lab Result Query
-"RTN","C0CLA7Q",9,0)
- ;
-"RTN","C0CLA7Q",10,0)
- ;
-"RTN","C0CLA7Q",11,0)
+"RTN","C0CLA7Q",24,0)
+ ;
+"RTN","C0CLA7Q",25,0)
+ ;
+"RTN","C0CLA7Q",26,0)
  K ^TMP("C0C-VLAB",$J)
-"RTN","C0CLA7Q",12,0)
- ;
-"RTN","C0CLA7Q",13,0)
+"RTN","C0CLA7Q",27,0)
+ ;
+"RTN","C0CLA7Q",28,0)
  ; Check and retrieve lab results from LAB DATA file (#63)
-"RTN","C0CLA7Q",14,0)
+"RTN","C0CLA7Q",29,0)
  S C0CDEST=$$GCPR^LA7QRY($G(C0CPTID),$G(C0CSDT),$G(C0CEDT),.C0CSC,.C0CSPEC,.C0CERR,$G(C0CDEST),$G(C0CHL7))
-"RTN","C0CLA7Q",15,0)
- ;
-"RTN","C0CLA7Q",16,0)
+"RTN","C0CLA7Q",30,0)
+ ;
+"RTN","C0CLA7Q",31,0)
  ; If V LAB file present then check for lab results that are only in this file
-"RTN","C0CLA7Q",17,0)
+"RTN","C0CLA7Q",32,0)
  ; If results found in V Lab file then build results and add to above results.
-"RTN","C0CLA7Q",18,0)
+"RTN","C0CLA7Q",33,0)
  I $D(^AUPNVLAB) D
-"RTN","C0CLA7Q",19,0)
+"RTN","C0CLA7Q",34,0)
  . D VCHECK
-"RTN","C0CLA7Q",20,0)
+"RTN","C0CLA7Q",35,0)
  . I $D(^TMP("C0C-VLAB",$J,3)) D VBUILD
-"RTN","C0CLA7Q",21,0)
- ;
-"RTN","C0CLA7Q",22,0)
+"RTN","C0CLA7Q",36,0)
+ ;
+"RTN","C0CLA7Q",37,0)
  ;K ^TMP("C0C-VLAB",$J)
-"RTN","C0CLA7Q",23,0)
- ;
-"RTN","C0CLA7Q",24,0)
+"RTN","C0CLA7Q",38,0)
+ ;
+"RTN","C0CLA7Q",39,0)
  Q C0CDEST
-"RTN","C0CLA7Q",25,0)
- ;
-"RTN","C0CLA7Q",26,0)
- ;
-"RTN","C0CLA7Q",27,0)
+"RTN","C0CLA7Q",40,0)
+ ;
+"RTN","C0CLA7Q",41,0)
+ ;
+"RTN","C0CLA7Q",42,0)
 VCHECK ; If V LAB file present then check for lab results that are only in this file.
-"RTN","C0CLA7Q",28,0)
- ;
-"RTN","C0CLA7Q",29,0)
+"RTN","C0CLA7Q",43,0)
+ ;
+"RTN","C0CLA7Q",44,0)
  N C0CDA,C0CEND,C0CROOT,C0CVLAB,LA7PTID,LA7SC,LA7SCRC,LA7SPEC
-"RTN","C0CLA7Q",30,0)
- ;
-"RTN","C0CLA7Q",31,0)
+"RTN","C0CLA7Q",45,0)
+ ;
+"RTN","C0CLA7Q",46,0)
  S LA7PTID=C0CPTID
-"RTN","C0CLA7Q",32,0)
+"RTN","C0CLA7Q",47,0)
  D PATID^LA7QRY2
-"RTN","C0CLA7Q",33,0)
+"RTN","C0CLA7Q",48,0)
  I $D(LA7ERR) Q
-"RTN","C0CLA7Q",34,0)
- ;
-"RTN","C0CLA7Q",35,0)
+"RTN","C0CLA7Q",49,0)
+ ;
+"RTN","C0CLA7Q",50,0)
  ; Resolve search codes to lab datanames
-"RTN","C0CLA7Q",36,0)
+"RTN","C0CLA7Q",51,0)
  S LA7SC=$G(C0CSC)
-"RTN","C0CLA7Q",37,0)
+"RTN","C0CLA7Q",52,0)
  I $T(SCLIST^LA7QRY2)'="" D
-"RTN","C0CLA7Q",38,0)
+"RTN","C0CLA7Q",53,0)
  . N TMP
-"RTN","C0CLA7Q",39,0)
+"RTN","C0CLA7Q",54,0)
  . S LA7SCRC=$G(C0CSC)
-"RTN","C0CLA7Q",40,0)
+"RTN","C0CLA7Q",55,0)
  . S TMP=$$SCLIST^LA7QRY2(LA7SCRC)
-"RTN","C0CLA7Q",41,0)
+"RTN","C0CLA7Q",56,0)
  . S LA7SC=TMP
-"RTN","C0CLA7Q",42,0)
- ;
-"RTN","C0CLA7Q",43,0)
+"RTN","C0CLA7Q",57,0)
+ ;
+"RTN","C0CLA7Q",58,0)
  I LA7SC'="*" D CHKSC^LA7QRY1
-"RTN","C0CLA7Q",44,0)
- ;
-"RTN","C0CLA7Q",45,0)
+"RTN","C0CLA7Q",59,0)
+ ;
+"RTN","C0CLA7Q",60,0)
  ; Convert specimen codes to file #61 Topography entries
-"RTN","C0CLA7Q",46,0)
+"RTN","C0CLA7Q",61,0)
  S LA7SPEC=$G(C0CSPEC)
-"RTN","C0CLA7Q",47,0)
+"RTN","C0CLA7Q",62,0)
  I LA7SPEC'="*"  D SPEC^LA7QRY1
-"RTN","C0CLA7Q",48,0)
- ;
-"RTN","C0CLA7Q",49,0)
+"RTN","C0CLA7Q",63,0)
+ ;
+"RTN","C0CLA7Q",64,0)
  S C0CROOT="^AUPNVLAB(""ALR4"",DFN,C0CSDT)",C0CEND=0
-"RTN","C0CLA7Q",50,0)
- ;
-"RTN","C0CLA7Q",51,0)
+"RTN","C0CLA7Q",65,0)
+ ;
+"RTN","C0CLA7Q",66,0)
  F  S C0CROOT=$Q(@C0CROOT) Q:C0CROOT=""  D  Q:C0CEND
-"RTN","C0CLA7Q",52,0)
+"RTN","C0CLA7Q",67,0)
  . I $QS(C0CROOT,1)'="ALR4"!($QS(C0CROOT,2)'=DFN) S C0CEND=1 Q  ; Left x-ref or patient
-"RTN","C0CLA7Q",53,0)
+"RTN","C0CLA7Q",68,0)
  . I $QS(C0CROOT,3)>C0CEDT S C0CEND=1 Q  ; Exceeded end date/time
-"RTN","C0CLA7Q",54,0)
+"RTN","C0CLA7Q",69,0)
  . S C0CDA=$QS(C0CROOT,4)
-"RTN","C0CLA7Q",55,0)
+"RTN","C0CLA7Q",70,0)
  . I $D(^TMP("C0C-VLAB",$J,1,C0CDA)) Q  ; Already checked during scan of file #63
-"RTN","C0CLA7Q",56,0)
+"RTN","C0CLA7Q",71,0)
  . I $P($G(^AUPNVLAB(C0CDA,11)),"^",8)=1 Q  ; Source is LAB DATA file - skip
-"RTN","C0CLA7Q",57,0)
+"RTN","C0CLA7Q",72,0)
  . D VCHK1
-"RTN","C0CLA7Q",58,0)
- ;
-"RTN","C0CLA7Q",59,0)
- ;
-"RTN","C0CLA7Q",60,0)
+"RTN","C0CLA7Q",73,0)
+ ;
+"RTN","C0CLA7Q",74,0)
+ ;
+"RTN","C0CLA7Q",75,0)
  Q
-"RTN","C0CLA7Q",61,0)
- ;
-"RTN","C0CLA7Q",62,0)
- ;
-"RTN","C0CLA7Q",63,0)
+"RTN","C0CLA7Q",76,0)
+ ;
+"RTN","C0CLA7Q",77,0)
+ ;
+"RTN","C0CLA7Q",78,0)
 VBUILD ; Build results found only in V LAB file into HL7 structure.
-"RTN","C0CLA7Q",64,0)
- ;
-"RTN","C0CLA7Q",65,0)
- ;
-"RTN","C0CLA7Q",66,0)
+"RTN","C0CLA7Q",79,0)
+ ;
+"RTN","C0CLA7Q",80,0)
+ ;
+"RTN","C0CLA7Q",81,0)
  Q
-"RTN","C0CLA7Q",67,0)
- ;
-"RTN","C0CLA7Q",68,0)
- ;
-"RTN","C0CLA7Q",69,0)
+"RTN","C0CLA7Q",82,0)
+ ;
+"RTN","C0CLA7Q",83,0)
+ ;
+"RTN","C0CLA7Q",84,0)
 LNCHK ; Check for corresponding entry in V LAB file and related LOINC code for a result in file #63.
-"RTN","C0CLA7Q",70,0)
+"RTN","C0CLA7Q",85,0)
  ; Call from LA7QRY2
-"RTN","C0CLA7Q",71,0)
- ;
-"RTN","C0CLA7Q",72,0)
+"RTN","C0CLA7Q",86,0)
+ ;
+"RTN","C0CLA7Q",87,0)
  N DFN,C0C60,C0C63,C0CACC,C0CDA,C0CDT,C0CLN,C0CPDA,C0CPTEST,C0CSPEC,C0CTEST,X
-"RTN","C0CLA7Q",73,0)
- ;
-"RTN","C0CLA7Q",74,0)
+"RTN","C0CLA7Q",88,0)
+ ;
+"RTN","C0CLA7Q",89,0)
  S DFN=$P(^LR(LRDFN,0),"^",3)
-"RTN","C0CLA7Q",75,0)
+"RTN","C0CLA7Q",90,0)
  S C0C63(0)=^LR(LRDFN,LRSS,LRIDT,0)
-"RTN","C0CLA7Q",76,0)
+"RTN","C0CLA7Q",91,0)
  S C0CDT=$P(C0C63(0),"^"),C0CACC=$P(C0C63(0),"^",6),C0CSPEC=$P(C0C63(0),"^",5)
-"RTN","C0CLA7Q",77,0)
+"RTN","C0CLA7Q",92,0)
  S (C0CTEST,C0CTEST(64),C0CPTEST,C0CPTEST(64),C0CLN)=""
-"RTN","C0CLA7Q",78,0)
- ;
-"RTN","C0CLA7Q",79,0)
+"RTN","C0CLA7Q",93,0)
+ ;
+"RTN","C0CLA7Q",94,0)
  ; ^AUPNVLAB("ALR1",5380,"EKT 0307 48",173,3080307.211055,5427197)=""
-"RTN","C0CLA7Q",80,0)
- ;
-"RTN","C0CLA7Q",81,0)
+"RTN","C0CLA7Q",95,0)
+ ;
+"RTN","C0CLA7Q",96,0)
  S C0C60=""
-"RTN","C0CLA7Q",82,0)
+"RTN","C0CLA7Q",97,0)
  F  S C0C60=$O(^LAB(60,"C",LRSS_";"_LRSB_";1",C0C60)) Q:'C0C60  D  Q:C0CLN'=""
-"RTN","C0CLA7Q",83,0)
+"RTN","C0CLA7Q",98,0)
  . D FINDDT
-"RTN","C0CLA7Q",84,0)
+"RTN","C0CLA7Q",99,0)
  . I C0CDA<1 Q
-"RTN","C0CLA7Q",85,0)
+"RTN","C0CLA7Q",100,0)
  . I $P($G(^AUPNVLAB(C0CDA,11)),"^",8)'=1 Q  ; Source is not LAB DATA file - skip
-"RTN","C0CLA7Q",86,0)
+"RTN","C0CLA7Q",101,0)
  . S C0CLN=$P($G(^AUPNVLAB(C0CDA,11)),"^",13)
-"RTN","C0CLA7Q",87,0)
+"RTN","C0CLA7Q",102,0)
  . S C0CPDA=$P($G(^AUPNVLAB(C0CDA,12)),"^",8)
-"RTN","C0CLA7Q",88,0)
+"RTN","C0CLA7Q",103,0)
  . I C0CPDA,'$D(^AUPNVLAB(C0CPDA,0)) S C0CPDA="" ; Dangling pointer
-"RTN","C0CLA7Q",89,0)
+"RTN","C0CLA7Q",104,0)
  . I C0CPDA="" S C0CPDA=C0CDA
-"RTN","C0CLA7Q",90,0)
+"RTN","C0CLA7Q",105,0)
  . S C0CTEST=$P($G(^AUPNVLAB(C0CDA,0)),"^"),X=$P($G(^LAB(60,C0CTEST,64)),"^",2)
-"RTN","C0CLA7Q",91,0)
+"RTN","C0CLA7Q",106,0)
  . I X S C0CTEST(64)=$P($G(^LAM(X,0)),"^",2)
-"RTN","C0CLA7Q",92,0)
+"RTN","C0CLA7Q",107,0)
  . S C0CPTEST=$P($G(^AUPNVLAB(C0CPDA,0)),"^"),X=$P($G(^LAB(60,C0CPTEST,64)),"^")
-"RTN","C0CLA7Q",93,0)
+"RTN","C0CLA7Q",108,0)
  . I X S C0CPTEST(64)=$P($G(^LAM(X,0)),"^",2)
-"RTN","C0CLA7Q",94,0)
+"RTN","C0CLA7Q",109,0)
  . S ^TMP("C0C-VLAB",$J,1,C0CDA)=""
-"RTN","C0CLA7Q",95,0)
+"RTN","C0CLA7Q",110,0)
  . I C0CDA'=C0CPDA S ^TMP("C0C-VLAB",$J,1,C0CPDA)=""
-"RTN","C0CLA7Q",96,0)
+"RTN","C0CLA7Q",111,0)
  . S ^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB)=C0CPTEST(64)_"^"_C0CTEST(64)_"^"_C0CLN_"^"_C0CDA_"^"_C0CTEST_"^"_C0CPDA_"^"_C0CPTEST
-"RTN","C0CLA7Q",97,0)
- ;
-"RTN","C0CLA7Q",98,0)
+"RTN","C0CLA7Q",112,0)
+ ;
+"RTN","C0CLA7Q",113,0)
  S X=$P(LA7X,"^",3)
-"RTN","C0CLA7Q",99,0)
+"RTN","C0CLA7Q",114,0)
  ; If order NLT then update if no order NLT
-"RTN","C0CLA7Q",100,0)
+"RTN","C0CLA7Q",115,0)
  I C0CPTEST(64),$P(X,"!")="" S $P(X,"!")=C0CPTEST(64)
-"RTN","C0CLA7Q",101,0)
- ;
-"RTN","C0CLA7Q",102,0)
+"RTN","C0CLA7Q",116,0)
+ ;
+"RTN","C0CLA7Q",117,0)
  ; If result NLT then update if no result NLT
-"RTN","C0CLA7Q",103,0)
+"RTN","C0CLA7Q",118,0)
  I C0CTEST(64),$P(X,"!",2)="" S $P(X,"!",2)=C0CTEST(64)
-"RTN","C0CLA7Q",104,0)
- ;
-"RTN","C0CLA7Q",105,0)
+"RTN","C0CLA7Q",119,0)
+ ;
+"RTN","C0CLA7Q",120,0)
  ; If LOINC found then update variable with LN code
-"RTN","C0CLA7Q",106,0)
+"RTN","C0CLA7Q",121,0)
  I C0CLN'="",$P(X,"!",3)="" S $P(X,"!",3)=C0CLN
-"RTN","C0CLA7Q",107,0)
- ;
-"RTN","C0CLA7Q",108,0)
+"RTN","C0CLA7Q",122,0)
+ ;
+"RTN","C0CLA7Q",123,0)
  S $P(LA7X,"^",3)=X
-"RTN","C0CLA7Q",109,0)
- ;
-"RTN","C0CLA7Q",110,0)
+"RTN","C0CLA7Q",124,0)
+ ;
+"RTN","C0CLA7Q",125,0)
  Q
-"RTN","C0CLA7Q",111,0)
- ;
-"RTN","C0CLA7Q",112,0)
- ;
-"RTN","C0CLA7Q",113,0)
+"RTN","C0CLA7Q",126,0)
+ ;
+"RTN","C0CLA7Q",127,0)
+ ;
+"RTN","C0CLA7Q",128,0)
 TMPCHK ; Check if LN/NLT codes saved from V LAB file above and use when building OBR/OBX segments
-"RTN","C0CLA7Q",114,0)
+"RTN","C0CLA7Q",129,0)
  ; Called from LA7VOBX1
-"RTN","C0CLA7Q",115,0)
- ;
-"RTN","C0CLA7Q",116,0)
+"RTN","C0CLA7Q",130,0)
+ ;
+"RTN","C0CLA7Q",131,0)
  N I,X
-"RTN","C0CLA7Q",117,0)
- ;
-"RTN","C0CLA7Q",118,0)
+"RTN","C0CLA7Q",132,0)
+ ;
+"RTN","C0CLA7Q",133,0)
  S X=$G(^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB))
-"RTN","C0CLA7Q",119,0)
+"RTN","C0CLA7Q",134,0)
  I X="" Q
-"RTN","C0CLA7Q",120,0)
+"RTN","C0CLA7Q",135,0)
  F I=1:1:3 I $P(LA7X,"!",I)="",$P(X,"^",I)'="" S $P(LA7X,"!",I)=$P(X,"^",I)
-"RTN","C0CLA7Q",121,0)
+"RTN","C0CLA7Q",136,0)
  S $P(LA7VAL,"^",3)=LA7X
-"RTN","C0CLA7Q",122,0)
- ;
-"RTN","C0CLA7Q",123,0)
+"RTN","C0CLA7Q",137,0)
+ ;
+"RTN","C0CLA7Q",138,0)
  Q
-"RTN","C0CLA7Q",124,0)
- ;
-"RTN","C0CLA7Q",125,0)
- ;
-"RTN","C0CLA7Q",126,0)
+"RTN","C0CLA7Q",139,0)
+ ;
+"RTN","C0CLA7Q",140,0)
+ ;
+"RTN","C0CLA7Q",141,0)
 VCHK1 ; Check the entry in V Lab to determine if it meets criteria
-"RTN","C0CLA7Q",127,0)
- ;
-"RTN","C0CLA7Q",128,0)
+"RTN","C0CLA7Q",142,0)
+ ;
+"RTN","C0CLA7Q",143,0)
  N C0CVLAB,I
-"RTN","C0CLA7Q",129,0)
- ;
-"RTN","C0CLA7Q",130,0)
+"RTN","C0CLA7Q",144,0)
+ ;
+"RTN","C0CLA7Q",145,0)
  F I=0,12 S C0CVLAB(I)=$G(^AUPNVLAB(C0CDA,I))
-"RTN","C0CLA7Q",131,0)
- ;
-"RTN","C0CLA7Q",132,0)
+"RTN","C0CLA7Q",146,0)
+ ;
+"RTN","C0CLA7Q",147,0)
  ; JMC 04/13/09 - Store anything for now that meets date criteria.
-"RTN","C0CLA7Q",133,0)
+"RTN","C0CLA7Q",148,0)
  D VSTORE
-"RTN","C0CLA7Q",134,0)
- ;
-"RTN","C0CLA7Q",135,0)
+"RTN","C0CLA7Q",149,0)
+ ;
+"RTN","C0CLA7Q",150,0)
  Q
-"RTN","C0CLA7Q",136,0)
- ;
-"RTN","C0CLA7Q",137,0)
- ;
-"RTN","C0CLA7Q",138,0)
+"RTN","C0CLA7Q",151,0)
+ ;
+"RTN","C0CLA7Q",152,0)
+ ;
+"RTN","C0CLA7Q",153,0)
 VSTORE ; Store entry for building in HL7 message when parent is from V LAB file.
-"RTN","C0CLA7Q",139,0)
- ;
-"RTN","C0CLA7Q",140,0)
+"RTN","C0CLA7Q",154,0)
+ ;
+"RTN","C0CLA7Q",155,0)
  N C0CPDA,C0CPTEST
-"RTN","C0CLA7Q",141,0)
- ;
-"RTN","C0CLA7Q",142,0)
+"RTN","C0CLA7Q",156,0)
+ ;
+"RTN","C0CLA7Q",157,0)
  ; Determine parent test to use for OBR segment
-"RTN","C0CLA7Q",143,0)
+"RTN","C0CLA7Q",158,0)
  S C0CPDA=$P(C0CVLAB(12),"^",8)
-"RTN","C0CLA7Q",144,0)
+"RTN","C0CLA7Q",159,0)
  I C0CPDA="" S C0CPDA=C0CDA
-"RTN","C0CLA7Q",145,0)
- ;
-"RTN","C0CLA7Q",146,0)
+"RTN","C0CLA7Q",160,0)
+ ;
+"RTN","C0CLA7Q",161,0)
  ; Determine parent test
-"RTN","C0CLA7Q",147,0)
+"RTN","C0CLA7Q",162,0)
  S C0CPTEST=$P($G(^AUPNVLAB(C0CPDA,0)),"^")
-"RTN","C0CLA7Q",148,0)
- ;
-"RTN","C0CLA7Q",149,0)
+"RTN","C0CLA7Q",163,0)
+ ;
+"RTN","C0CLA7Q",164,0)
  S ^TMP("C0C-VLAB",$J,3,$P(C0CVLAB(0),"^",2),$P(C0CVLAB(12),"^"),C0CPTEST,C0CDA)=C0CPDA
-"RTN","C0CLA7Q",150,0)
- ;
-"RTN","C0CLA7Q",151,0)
+"RTN","C0CLA7Q",165,0)
+ ;
+"RTN","C0CLA7Q",166,0)
  Q
-"RTN","C0CLA7Q",152,0)
- ;
-"RTN","C0CLA7Q",153,0)
- ;
-"RTN","C0CLA7Q",154,0)
+"RTN","C0CLA7Q",167,0)
+ ;
+"RTN","C0CLA7Q",168,0)
+ ;
+"RTN","C0CLA7Q",169,0)
 FINDDT ; Find entry in V LAB for the date/time or one close to it.
-"RTN","C0CLA7Q",155,0)
+"RTN","C0CLA7Q",170,0)
  ; RPMS stores related specimen entries under the same date/time.
-"RTN","C0CLA7Q",156,0)
+"RTN","C0CLA7Q",171,0)
  ; Lab file #63 creates unique entries with slightly different times.
-"RTN","C0CLA7Q",157,0)
- ;
-"RTN","C0CLA7Q",158,0)
+"RTN","C0CLA7Q",172,0)
+ ;
+"RTN","C0CLA7Q",173,0)
  S C0CDA=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,C0CDT,0))
-"RTN","C0CLA7Q",159,0)
+"RTN","C0CLA7Q",174,0)
  I C0CDA>0 Q
-"RTN","C0CLA7Q",160,0)
- ;
-"RTN","C0CLA7Q",161,0)
+"RTN","C0CLA7Q",175,0)
+ ;
+"RTN","C0CLA7Q",176,0)
  ; If entry found then confirm that specimen type matches.
-"RTN","C0CLA7Q",162,0)
+"RTN","C0CLA7Q",177,0)
  N C0CDTY
-"RTN","C0CLA7Q",163,0)
+"RTN","C0CLA7Q",178,0)
  S C0CDTY=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,0))
-"RTN","C0CLA7Q",164,0)
+"RTN","C0CLA7Q",179,0)
  I C0CDTY D
-"RTN","C0CLA7Q",165,0)
+"RTN","C0CLA7Q",180,0)
  . I $P(C0CDT,".")'=$P(C0CDTY,".") Q
-"RTN","C0CLA7Q",166,0)
+"RTN","C0CLA7Q",181,0)
  . S C0CDA=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,C0CDTY,0))
-"RTN","C0CLA7Q",167,0)
+"RTN","C0CLA7Q",182,0)
  . I C0CSPEC'=$P($G(^AUPNVLAB(C0CDA,11)),"^",3) S C0CDA=""
-"RTN","C0CLA7Q",168,0)
- ;
-"RTN","C0CLA7Q",169,0)
+"RTN","C0CLA7Q",183,0)
+ ;
+"RTN","C0CLA7Q",184,0)
  Q
 "RTN","C0CLABS")
-0^40^B282604886
+0^40^B279276475
 "RTN","C0CLABS",1,0)
 C0CLABS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR LAB RESULTS ; 10/01/08 ; 5/10/12 2:49pm
 "RTN","C0CLABS",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CLABS",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
 "RTN","C0CLABS",4,0)
- ;Licensed under the terms of the GNU General Public License.
+ ;
 "RTN","C0CLABS",5,0)
- ;See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CLABS",6,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CLABS",7,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CLABS",8,0)
- ;it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CLABS",9,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CLABS",10,0)
- ;(at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CLABS",11,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CLABS",12,0)
- ;This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CLABS",13,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CLABS",14,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CLABS",15,0)
- ;GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CLABS",16,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CLABS",17,0)
- ;You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CLABS",18,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
 "RTN","C0CLABS",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
 "RTN","C0CLABS",20,0)
-           ;
+ ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
 "RTN","C0CLABS",21,0)
-MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
+ ; MIXML IS THE TEMPLATE TO USE
 "RTN","C0CLABS",22,0)
- ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
+ ; MOXML IS THE OUTPUT XML ARRAY
 "RTN","C0CLABS",23,0)
- ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
+ ; DFN IS THE PATIENT RECORD NUMBER
 "RTN","C0CLABS",24,0)
- ; MIXML IS THE TEMPLATE TO USE
+ N C0COXML,C0CO,C0CV,C0CIXML
 "RTN","C0CLABS",25,0)
- ; MOXML IS THE OUTPUT XML ARRAY
+ I '$D(MIVAR) S C0CV="" ;DEFAULT
 "RTN","C0CLABS",26,0)
- ; DFN IS THE PATIENT RECORD NUMBER
+ E  S C0CV=MIVAR ;PASSED VARIABLE ARRAY
 "RTN","C0CLABS",27,0)
- N C0COXML,C0CO,C0CV,C0CIXML
+ I '$D(MIXML) S C0CIXML="" ;DEFAULT
 "RTN","C0CLABS",28,0)
- I '$D(MIVAR) S C0CV="" ;DEFAULT
+ E  S C0CIXML=MIXML ;PASSED INPUT XML
 "RTN","C0CLABS",29,0)
- E  S C0CV=MIVAR ;PASSED VARIABLE ARRAY
+ D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
 "RTN","C0CLABS",30,0)
- I '$D(MIXML) S C0CIXML="" ;DEFAULT
+ I '$D(MOXML) S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
 "RTN","C0CLABS",31,0)
- E  S C0CIXML=MIXML ;PASSED INPUT XML
+ E  S C0CO=MOXML
 "RTN","C0CLABS",32,0)
- D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
+ ; ZWR C0COXML
 "RTN","C0CLABS",33,0)
- I '$D(MOXML) S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
+ M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
 "RTN","C0CLABS",34,0)
- E  S C0CO=MOXML
+ Q
 "RTN","C0CLABS",35,0)
- ; ZWR C0COXML
+ ;
 "RTN","C0CLABS",36,0)
- M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
+RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS
 "RTN","C0CLABS",37,0)
+ ; RTN IS PASSED BY REFERENCE
+"RTN","C0CLABS",38,0)
+ ;N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
+"RTN","C0CLABS",39,0)
+ ;N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
+"RTN","C0CLABS",40,0)
+ I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
+"RTN","C0CLABS",41,0)
+ I RMIXML="" D  ; INPUT XML NOT PASSED
+"RTN","C0CLABS",42,0)
+ . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
+"RTN","C0CLABS",43,0)
+ . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
+"RTN","C0CLABS",44,0)
+ . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
+"RTN","C0CLABS",45,0)
+ E  S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
+"RTN","C0CLABS",46,0)
+ I RMIVAR="" D  ; LOCATION OF VARIABLES NOT PASSED
+"RTN","C0CLABS",47,0)
+ . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
+"RTN","C0CLABS",48,0)
+ E  S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
+"RTN","C0CLABS",49,0)
+ D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
+"RTN","C0CLABS",50,0)
+ D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
+"RTN","C0CLABS",51,0)
+ D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
+"RTN","C0CLABS",52,0)
+ I '$D(C0CQT) S C0CQT=0 ; DEFAULT NOT SILENT
+"RTN","C0CLABS",53,0)
+ I 'C0CQT D  ; WE ARE DEBUGGING
+"RTN","C0CLABS",54,0)
+ . W "I MAPPED",!
+"RTN","C0CLABS",55,0)
+ . W "VARS:",C0CV,!
+"RTN","C0CLABS",56,0)
+ . W "DFN:",DFN,!
+"RTN","C0CLABS",57,0)
+ . ;D PARY^C0CXPATH("C0CT") ; SECTION TEMPLATE
+"RTN","C0CLABS",58,0)
+ . ;D PARY^C0CXPATH("C0CRT") ;REQUEST TEMPLATE (OCR)
+"RTN","C0CLABS",59,0)
+ . ;D PARY^C0CXPATH("C0CTT") ;TEST TEMPLATE (OCX)
+"RTN","C0CLABS",60,0)
+ D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT
+"RTN","C0CLABS",61,0)
+ I '$D(@C0CV@(0)) D  Q  ; NO VARS THERE
+"RTN","C0CLABS",62,0)
+ . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
+"RTN","C0CLABS",63,0)
+ I @C0CV@(0)=0 S RTN(0)=0 Q  ; NO RESULTS
+"RTN","C0CLABS",64,0)
+ S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
+"RTN","C0CLABS",65,0)
+ K @RIMVARS
+"RTN","C0CLABS",66,0)
+ M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
+"RTN","C0CLABS",67,0)
+ N C0CI,C0CJ,C0CMAP,C0CTMAP,C0CTMP
+"RTN","C0CLABS",68,0)
+ S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
+"RTN","C0CLABS",69,0)
+ N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
+"RTN","C0CLABS",70,0)
+ N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
+"RTN","C0CLABS",71,0)
+ N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
+"RTN","C0CLABS",72,0)
+ ; TO IMPROVE PERFORMANCE
+"RTN","C0CLABS",73,0)
+ D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
+"RTN","C0CLABS",74,0)
+ F C0CI=1:1:C0CIN D  ; LOOP THROUGH VARIABLES
+"RTN","C0CLABS",75,0)
+ . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
+"RTN","C0CLABS",76,0)
+ . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
+"RTN","C0CLABS",77,0)
+ . S C0CMAP=$NA(@C0CV@(C0CI)) ;
+"RTN","C0CLABS",78,0)
+ . I 'C0CQT W "MAPOBR:",C0CMAP,!
+"RTN","C0CLABS",79,0)
+ . ;MAPPING FOR TEST REQUEST GOES HERE
+"RTN","C0CLABS",80,0)
+ . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
+"RTN","C0CLABS",81,0)
+ . ;D QOPEN^C0CXPATH("C0CRBLD",C0CRTMP,C0CIS) ;1ST PART OF XML
+"RTN","C0CLABS",82,0)
+ . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
+"RTN","C0CLABS",83,0)
+ . I $D(@C0CMAP@("M","TEST",0)) D  ; TESTS EXIST
+"RTN","C0CLABS",84,0)
+ . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
+"RTN","C0CLABS",85,0)
+ . . K C0CTO ; CLEAR OUTPUT VARIABLE
+"RTN","C0CLABS",86,0)
+ . . F C0CJ=1:1:C0CJN D   ;FOR EACH TEST RESULT
+"RTN","C0CLABS",87,0)
+ . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
+"RTN","C0CLABS",88,0)
+ . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
+"RTN","C0CLABS",89,0)
+ . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
+"RTN","C0CLABS",90,0)
+ . . . I 'C0CQT W "MAPOBX:",C0CTMAP,!
+"RTN","C0CLABS",91,0)
+ . . . D MAP^C0CXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
+"RTN","C0CLABS",92,0)
+ . . . I C0CJ=1 S C0CJS=2 E  S C0CJS=1 ;FIRST TIME,SKIP THE <Test>
+"RTN","C0CLABS",93,0)
+ . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E  S C0CJE=@C0CTMP@(0) ;</Test>
+"RTN","C0CLABS",94,0)
+ . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
+"RTN","C0CLABS",95,0)
+ . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
+"RTN","C0CLABS",96,0)
+ . . . ;I C0CJ=1 D  ; FIRST TIME, JUST COPY
+"RTN","C0CLABS",97,0)
+ . . . ;. D CP^C0CXPATH("C0CTMP","C0CTO") ; START BUILDING TEST XML
+"RTN","C0CLABS",98,0)
+ . . . ;E  D INSINNER^C0CXPATH("C0CTO","C0CTMP")
+"RTN","C0CLABS",99,0)
+ . . . ;
+"RTN","C0CLABS",100,0)
+ . . . ;D PUSHA^C0CXPATH("C0CTO",C0CTMP) ;ADD THE TEST TO BUFFER
+"RTN","C0CLABS",101,0)
+ . . ; I 'C0CQT D PARY^C0CXPATH("C0CTO")
+"RTN","C0CLABS",102,0)
+ . . ;D INSINNER^C0CXPATH(C0CRTMP,"C0CTO","//Results/Result/Test") ;INSERT TST
+"RTN","C0CLABS",103,0)
+ . ;D QCLOSE^C0CXPATH("C0CRBLD",C0CRTMP,"//Results/Result/Test") ;END OF XML
+"RTN","C0CLABS",104,0)
+ . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
+"RTN","C0CLABS",105,0)
+ . ;I C0CI=1 D  ; FIRST TIME, COPY INSTEAD OF INSERT
+"RTN","C0CLABS",106,0)
+ . ;. D CP^C0CXPATH(C0CRTMP,"RTN") ;
+"RTN","C0CLABS",107,0)
+ . ;E  D INSINNER^C0CXPATH("RTN",C0CRTMP) ; INSERT THIS TEST REQUEST
+"RTN","C0CLABS",108,0)
+ D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
+"RTN","C0CLABS",109,0)
+ D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML
+"RTN","C0CLABS",110,0)
+ K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
+"RTN","C0CLABS",111,0)
  Q
-"RTN","C0CLABS",38,0)
- ;
-"RTN","C0CLABS",39,0)
-RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS
-"RTN","C0CLABS",40,0)
- ; RTN IS PASSED BY REFERENCE
-"RTN","C0CLABS",41,0)
- ;N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
-"RTN","C0CLABS",42,0)
- ;N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
-"RTN","C0CLABS",43,0)
- I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
-"RTN","C0CLABS",44,0)
- I RMIXML="" D  ; INPUT XML NOT PASSED
-"RTN","C0CLABS",45,0)
- . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
-"RTN","C0CLABS",46,0)
- . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
-"RTN","C0CLABS",47,0)
- . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
-"RTN","C0CLABS",48,0)
- E  S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
-"RTN","C0CLABS",49,0)
- I RMIVAR="" D  ; LOCATION OF VARIABLES NOT PASSED
-"RTN","C0CLABS",50,0)
- . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
-"RTN","C0CLABS",51,0)
- E  S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
-"RTN","C0CLABS",52,0)
- D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
-"RTN","C0CLABS",53,0)
- D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
-"RTN","C0CLABS",54,0)
- D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
-"RTN","C0CLABS",55,0)
- I '$D(C0CQT) S C0CQT=0 ; DEFAULT NOT SILENT
-"RTN","C0CLABS",56,0)
- I 'C0CQT D  ; WE ARE DEBUGGING
-"RTN","C0CLABS",57,0)
- . W "I MAPPED",!
-"RTN","C0CLABS",58,0)
- . W "VARS:",C0CV,!
-"RTN","C0CLABS",59,0)
- . W "DFN:",DFN,!
-"RTN","C0CLABS",60,0)
- . ;D PARY^C0CXPATH("C0CT") ; SECTION TEMPLATE
-"RTN","C0CLABS",61,0)
- . ;D PARY^C0CXPATH("C0CRT") ;REQUEST TEMPLATE (OCR)
-"RTN","C0CLABS",62,0)
- . ;D PARY^C0CXPATH("C0CTT") ;TEST TEMPLATE (OCX)
-"RTN","C0CLABS",63,0)
- D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT
-"RTN","C0CLABS",64,0)
- I '$D(@C0CV@(0)) D  Q  ; NO VARS THERE
-"RTN","C0CLABS",65,0)
- . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
-"RTN","C0CLABS",66,0)
- I @C0CV@(0)=0 S RTN(0)=0 Q ; NO RESULTS
-"RTN","C0CLABS",67,0)
- S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
-"RTN","C0CLABS",68,0)
- K @RIMVARS
-"RTN","C0CLABS",69,0)
- M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
-"RTN","C0CLABS",70,0)
- N C0CI,C0CJ,C0CMAP,C0CTMAP,C0CTMP
-"RTN","C0CLABS",71,0)
- S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
-"RTN","C0CLABS",72,0)
- N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
-"RTN","C0CLABS",73,0)
- N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
-"RTN","C0CLABS",74,0)
- N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
-"RTN","C0CLABS",75,0)
- ; TO IMPROVE PERFORMANCE
-"RTN","C0CLABS",76,0)
- D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
-"RTN","C0CLABS",77,0)
- F C0CI=1:1:C0CIN D  ; LOOP THROUGH VARIABLES
-"RTN","C0CLABS",78,0)
- . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
-"RTN","C0CLABS",79,0)
- . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
-"RTN","C0CLABS",80,0)
- . S C0CMAP=$NA(@C0CV@(C0CI)) ;
-"RTN","C0CLABS",81,0)
- . I 'C0CQT W "MAPOBR:",C0CMAP,!
-"RTN","C0CLABS",82,0)
- . ;MAPPING FOR TEST REQUEST GOES HERE
-"RTN","C0CLABS",83,0)
- . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
-"RTN","C0CLABS",84,0)
- . ;D QOPEN^C0CXPATH("C0CRBLD",C0CRTMP,C0CIS) ;1ST PART OF XML
-"RTN","C0CLABS",85,0)
- . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
-"RTN","C0CLABS",86,0)
- . I $D(@C0CMAP@("M","TEST",0)) D  ; TESTS EXIST
-"RTN","C0CLABS",87,0)
- . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
-"RTN","C0CLABS",88,0)
- . . K C0CTO ; CLEAR OUTPUT VARIABLE
-"RTN","C0CLABS",89,0)
- . . F C0CJ=1:1:C0CJN D   ;FOR EACH TEST RESULT
-"RTN","C0CLABS",90,0)
- . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
-"RTN","C0CLABS",91,0)
- . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
-"RTN","C0CLABS",92,0)
- . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
-"RTN","C0CLABS",93,0)
- . . . I 'C0CQT W "MAPOBX:",C0CTMAP,!
-"RTN","C0CLABS",94,0)
- . . . D MAP^C0CXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
-"RTN","C0CLABS",95,0)
- . . . I C0CJ=1 S C0CJS=2 E  S C0CJS=1 ;FIRST TIME,SKIP THE <Test>
-"RTN","C0CLABS",96,0)
- . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E  S C0CJE=@C0CTMP@(0) ;</Test>
-"RTN","C0CLABS",97,0)
- . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
-"RTN","C0CLABS",98,0)
- . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
-"RTN","C0CLABS",99,0)
- . . . ;I C0CJ=1 D  ; FIRST TIME, JUST COPY
-"RTN","C0CLABS",100,0)
- . . . ;. D CP^C0CXPATH("C0CTMP","C0CTO") ; START BUILDING TEST XML
-"RTN","C0CLABS",101,0)
- . . . ;E  D INSINNER^C0CXPATH("C0CTO","C0CTMP")
-"RTN","C0CLABS",102,0)
- . . . ;
-"RTN","C0CLABS",103,0)
- . . . ;D PUSHA^C0CXPATH("C0CTO",C0CTMP) ;ADD THE TEST TO BUFFER
-"RTN","C0CLABS",104,0)
- . . ; I 'C0CQT D PARY^C0CXPATH("C0CTO")
-"RTN","C0CLABS",105,0)
- . . ;D INSINNER^C0CXPATH(C0CRTMP,"C0CTO","//Results/Result/Test") ;INSERT TST
-"RTN","C0CLABS",106,0)
- . ;D QCLOSE^C0CXPATH("C0CRBLD",C0CRTMP,"//Results/Result/Test") ;END OF XML
-"RTN","C0CLABS",107,0)
- . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
-"RTN","C0CLABS",108,0)
- . ;I C0CI=1 D  ; FIRST TIME, COPY INSTEAD OF INSERT
-"RTN","C0CLABS",109,0)
- . . ;D CP^C0CXPATH(C0CRTMP,"RTN") ;
-"RTN","C0CLABS",110,0)
- . ;E  D INSINNER^C0CXPATH("RTN",C0CRTMP) ; INSERT THIS TEST REQUEST
-"RTN","C0CLABS",111,0)
- D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
 "RTN","C0CLABS",112,0)
- D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML
+ ;
 "RTN","C0CLABS",113,0)
- K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
+EXTRACT(ILXML,DFN,OLXML) ; EXTRACT LABS INTO THE C0CLVAR GLOBAL
 "RTN","C0CLABS",114,0)
+ ;
+"RTN","C0CLABS",115,0)
+ ; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","C0CLABS",116,0)
+ ;
+"RTN","C0CLABS",117,0)
+ ;
+"RTN","C0CLABS",118,0)
+ ;
+"RTN","C0CLABS",119,0)
+ N C0CNSSN ; IS THERE AN SSN FLAG
+"RTN","C0CLABS",120,0)
+ S C0CNSSN=0
+"RTN","C0CLABS",121,0)
+ S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
+"RTN","C0CLABS",122,0)
+ D GHL7 ; GET HL7 MESSAGE FOR THIS PATIENT
+"RTN","C0CLABS",123,0)
+ I C0CNSSN=1 D  Q  ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT
+"RTN","C0CLABS",124,0)
+ . S @C0CLB@(0)=0
+"RTN","C0CLABS",125,0)
+ K @C0CLB ; CLEAR OUT OLD VARS IF ANY
+"RTN","C0CLABS",126,0)
+ N QTSAV S QTSAV=C0CQT ;SAVE QUIET FLAG
+"RTN","C0CLABS",127,0)
+ S C0CQT=1 ; SURPRESS LISTING
+"RTN","C0CLABS",128,0)
+ D LIST ; EXTRACT THE VARIABLES
+"RTN","C0CLABS",129,0)
+ ; FOR CERTIFICATION, SEE IF THERE ARE OTHER RESULTS TO ADD
+"RTN","C0CLABS",130,0)
+ D EN^C0CORSLT(C0CLB,DFN) ; LOOKS FOR ECG TESTS
+"RTN","C0CLABS",131,0)
+ S C0CQT=QTSAV ; RESET SILENT FLAG
+"RTN","C0CLABS",132,0)
+ K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT
+"RTN","C0CLABS",133,0)
+ I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
+"RTN","C0CLABS",134,0)
  Q
-"RTN","C0CLABS",115,0)
- ;
-"RTN","C0CLABS",116,0)
-EXTRACT(ILXML,DFN,OLXML) ; EXTRACT LABS INTO THE C0CLVAR GLOBAL
-"RTN","C0CLABS",117,0)
- ;
-"RTN","C0CLABS",118,0)
- ; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","C0CLABS",119,0)
- ;
-"RTN","C0CLABS",120,0)
- ;
-"RTN","C0CLABS",121,0)
- ;
-"RTN","C0CLABS",122,0)
- N C0CNSSN ; IS THERE AN SSN FLAG
-"RTN","C0CLABS",123,0)
- S C0CNSSN=0
-"RTN","C0CLABS",124,0)
- S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
-"RTN","C0CLABS",125,0)
- D GHL7 ; GET HL7 MESSAGE FOR THIS PATIENT
-"RTN","C0CLABS",126,0)
- I C0CNSSN=1 D  Q  ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT
-"RTN","C0CLABS",127,0)
- . S @C0CLB@(0)=0
-"RTN","C0CLABS",128,0)
- K @C0CLB ; CLEAR OUT OLD VARS IF ANY
-"RTN","C0CLABS",129,0)
- N QTSAV S QTSAV=C0CQT ;SAVE QUIET FLAG
-"RTN","C0CLABS",130,0)
- S C0CQT=1 ; SURPRESS LISTING
-"RTN","C0CLABS",131,0)
- D LIST ; EXTRACT THE VARIABLES
-"RTN","C0CLABS",132,0)
- ; FOR CERTIFICATION, SEE IF THERE ARE OTHER RESULTS TO ADD
-"RTN","C0CLABS",133,0)
- D EN^C0CORSLT(C0CLB,DFN) ; LOOKS FOR ECG TESTS
-"RTN","C0CLABS",134,0)
- S C0CQT=QTSAV ; RESET SILENT FLAG
 "RTN","C0CLABS",135,0)
- K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT
+     ;
 "RTN","C0CLABS",136,0)
- I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
+GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT
 "RTN","C0CLABS",137,0)
+ ; N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR
+"RTN","C0CLABS",138,0)
+ ; SET UP FOR LAB API CALL
+"RTN","C0CLABS",139,0)
+ S C0CPTID=$$SSN^C0CDPT(DFN) ; GET THE SSN FOR THIS PATIENT
+"RTN","C0CLABS",140,0)
+ I C0CPTID="" D  Q  ; NO SSN, COMPLAIN AND QUIT
+"RTN","C0CLABS",141,0)
+ . W "LAB LOOKUP FAILED, NO SSN",!
+"RTN","C0CLABS",142,0)
+ . S C0CNSSN=1 ; SET NO SSN FLAG
+"RTN","C0CLABS",143,0)
+ S C0CSPC="*" ; LOOKING FOR ALL LABS
+"RTN","C0CLABS",144,0)
+ ;I $D(^TMP("C0CCCR","RPMS")) D  ; RUNNING RPMS
+"RTN","C0CLABS",145,0)
+ ;. D DT^DILF(,"T-365",.C0CSDT) ; START DATE ONE YEAR AGO TO LIMIT VOLUME
+"RTN","C0CLABS",146,0)
+ ;E  D DT^DILF(,"T-5000",.C0CSDT) ; START DATE LONG AGO TO GET EVERYTHING
+"RTN","C0CLABS",147,0)
+ ;D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY
+"RTN","C0CLABS",148,0)
+ S C0CLLMT=$$GET^C0CPARMS("LABLIMIT") ; GET THE LIMIT PARM
+"RTN","C0CLABS",149,0)
+ S C0CLSTRT=$$GET^C0CPARMS("LABSTART") ; GET START PARM
+"RTN","C0CLABS",150,0)
+ D DT^DILF(,C0CLLMT,.C0CSDT) ;
+"RTN","C0CLABS",151,0)
+ W "LAB LIMIT: ",C0CLLMT,!
+"RTN","C0CLABS",152,0)
+ D DT^DILF(,C0CLSTRT,.C0CEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
+"RTN","C0CLABS",153,0)
+ S C0CEDT=$$NOW^XLFDT ; PULL LABS STARTING NOW
+"RTN","C0CLABS",154,0)
+ S C0CR=$$LAB^C0CLA7Q(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP
+"RTN","C0CLABS",155,0)
  Q
-"RTN","C0CLABS",138,0)
-     ;
-"RTN","C0CLABS",139,0)
-GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT
-"RTN","C0CLABS",140,0)
- ; N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR
-"RTN","C0CLABS",141,0)
- ; SET UP FOR LAB API CALL
-"RTN","C0CLABS",142,0)
- S C0CPTID=$$SSN^C0CDPT(DFN) ; GET THE SSN FOR THIS PATIENT
-"RTN","C0CLABS",143,0)
- I C0CPTID="" D  Q  ; NO SSN, COMPLAIN AND QUIT
-"RTN","C0CLABS",144,0)
- . W "LAB LOOKUP FAILED, NO SSN",!
-"RTN","C0CLABS",145,0)
- . S C0CNSSN=1 ; SET NO SSN FLAG
-"RTN","C0CLABS",146,0)
- S C0CSPC="*" ; LOOKING FOR ALL LABS
-"RTN","C0CLABS",147,0)
- ;I $D(^TMP("C0CCCR","RPMS")) D  ; RUNNING RPMS
-"RTN","C0CLABS",148,0)
- ;. D DT^DILF(,"T-365",.C0CSDT) ; START DATE ONE YEAR AGO TO LIMIT VOLUME
-"RTN","C0CLABS",149,0)
- ;E  D DT^DILF(,"T-5000",.C0CSDT) ; START DATE LONG AGO TO GET EVERYTHING
-"RTN","C0CLABS",150,0)
- ;D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY
-"RTN","C0CLABS",151,0)
- S C0CLLMT=$$GET^C0CPARMS("LABLIMIT") ; GET THE LIMIT PARM
-"RTN","C0CLABS",152,0)
- S C0CLSTRT=$$GET^C0CPARMS("LABSTART") ; GET START PARM
-"RTN","C0CLABS",153,0)
- D DT^DILF(,C0CLLMT,.C0CSDT) ;
-"RTN","C0CLABS",154,0)
- W "LAB LIMIT: ",C0CLLMT,!
-"RTN","C0CLABS",155,0)
- D DT^DILF(,C0CLSTRT,.C0CEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
 "RTN","C0CLABS",156,0)
- S C0CEDT=$$NOW^XLFDT ; PULL LABS STARTING NOW
+ ;
 "RTN","C0CLABS",157,0)
- S C0CR=$$LAB^C0CLA7Q(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP
+LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
 "RTN","C0CLABS",158,0)
+ ;
+"RTN","C0CLABS",159,0)
+ ; N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR
+"RTN","C0CLABS",160,0)
+ I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
+"RTN","C0CLABS",161,0)
+ I '$D(C0CQT) S C0CQT=0
+"RTN","C0CLABS",162,0)
+ I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
+"RTN","C0CLABS",163,0)
+ I '$D(^TMP("C0CCCR","LABTBL",0)) D SETTBL ;INITIALIZE LAB TABLE
+"RTN","C0CLABS",164,0)
+ I ^TMP("C0CCCR","LABTBL",0)'="V3" D SETTBL ;NEED NEWEST VERSION
+"RTN","C0CLABS",165,0)
+ I '$D(^TMP("HLS",$J,1)) D GHL7 ; GET HL7 MGS IF NOT ALREADY DONE
+"RTN","C0CLABS",166,0)
+ S C0CTAB=$NA(^TMP("C0CCCR","LABTBL")) ; BASE OF OBX TABLE
+"RTN","C0CLABS",167,0)
+ S C0CHB=$NA(^TMP("HLS",$J))
+"RTN","C0CLABS",168,0)
+ S C0CI=""
+"RTN","C0CLABS",169,0)
+ S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT
+"RTN","C0CLABS",170,0)
+ F  S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI=""  D  ; FOR ALL RECORDS IN HL7 MSG
+"RTN","C0CLABS",171,0)
+ . K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES
+"RTN","C0CLABS",172,0)
+ . S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
+"RTN","C0CLABS",173,0)
+ . D LTYP(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
+"RTN","C0CLABS",174,0)
+ . I $G(C0CVAR("RESULTCODINGSYSTEM"))="LN" D  ; gpl - for certification
+"RTN","C0CLABS",175,0)
+ . . S C0CVAR("RESULTCODINGSYSTEM")="LOINC" ; NEED TO SPELL IT OUT
+"RTN","C0CLABS",176,0)
+ . . N C0CRDT S C0CRDT=C0CVAR("RESULTDESCRIPTIONTEXT") ; THE DESCRIPTION
+"RTN","C0CLABS",177,0)
+ . . N C0CRCD S C0CRCD=C0CVAR("RESULTCODE") ; THE LOINC CODE
+"RTN","C0CLABS",178,0)
+ . . S C0CVAR("RESULTDESCRIPTIONTEXT")=C0CRDT_" LOINC: "_C0CRCD
+"RTN","C0CLABS",179,0)
+ . M XV=C0CVAR ;
+"RTN","C0CLABS",180,0)
+ . I C0CTYP="OBR" D  ; BEGINNING OF NEW SECTION
+"RTN","C0CLABS",181,0)
+ . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
+"RTN","C0CLABS",182,0)
+ . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
+"RTN","C0CLABS",183,0)
+ . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
+"RTN","C0CLABS",184,0)
+ . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
+"RTN","C0CLABS",185,0)
+ . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
+"RTN","C0CLABS",186,0)
+ . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
+"RTN","C0CLABS",187,0)
+ . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
+"RTN","C0CLABS",188,0)
+ . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
+"RTN","C0CLABS",189,0)
+ . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
+"RTN","C0CLABS",190,0)
+ . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
+"RTN","C0CLABS",191,0)
+ . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
+"RTN","C0CLABS",192,0)
+ . I C0CTYP="OBX" D  ; SPECIAL CASE FOR OBX3
+"RTN","C0CLABS",193,0)
+ . . ; RESULTTESTCODEVALUE
+"RTN","C0CLABS",194,0)
+ . . ; RESULTTESTDESCRIPTIONTEXT
+"RTN","C0CLABS",195,0)
+ . . I C0CVAR("C3")="LN" D  ; PRIMARY CODE IS LOINC
+"RTN","C0CLABS",196,0)
+ . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE LOINC CODE VALUE
+"RTN","C0CLABS",197,0)
+ . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
+"RTN","C0CLABS",198,0)
+ . . . ;S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESC TXT
+"RTN","C0CLABS",199,0)
+ . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2")_" LOINC: "_C0CVAR("C1")
+"RTN","C0CLABS",200,0)
+ . . E  I C0CVAR("C6")="LN" D  ; SECONDARY CODE IS LOINC
+"RTN","C0CLABS",201,0)
+ . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; THE LOINC CODE VALUE
+"RTN","C0CLABS",202,0)
+ . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
+"RTN","C0CLABS",203,0)
+ . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; DESCRIPTION TEXT
+"RTN","C0CLABS",204,0)
+ . . E  I C0CVAR("C6")'="" D  ; NO LOINC CODES, USE SECONDARY IF PRESENT
+"RTN","C0CLABS",205,0)
+ . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
+"RTN","C0CLABS",206,0)
+ . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
+"RTN","C0CLABS",207,0)
+ . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
+"RTN","C0CLABS",208,0)
+ . . E  D  ; NO SECONDARY, USE PRIMARY
+"RTN","C0CLABS",209,0)
+ . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
+"RTN","C0CLABS",210,0)
+ . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
+"RTN","C0CLABS",211,0)
+ . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
+"RTN","C0CLABS",212,0)
+ . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;
+"RTN","C0CLABS",213,0)
+ . . ; mod to remove local XML escaping rely upon MAP^C0CXPATH
+"RTN","C0CLABS",214,0)
+ . . ;S XV("RESULTTESTNORMALDESCTEXT")=$$SYMENC^MXMLUTL(C0CZG) ;ESCAPE
+"RTN","C0CLABS",215,0)
+ . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG
+"RTN","C0CLABS",216,0)
+ . . S C0CZG=XV("RESULTTESTVALUE")
+"RTN","C0CLABS",217,0)
+  . . ; mod to remove local XML escaping rely upon MAP^C0CXPATH
+"RTN","C0CLABS",218,0)
+ . . ;S XV("RESULTTESTVALUE")=$$SYMENC^MXMLUTL(C0CZG) ;ESCAPE
+"RTN","C0CLABS",219,0)
+ . . S XV("RESULTTESTVALUE")=C0CZG
+"RTN","C0CLABS",220,0)
+ . I C0CTYP="OBX" D  ; PROCESS TEST RESULTS
+"RTN","C0CLABS",221,0)
+ . . I C0CLOBX=0 D  ; FIRST TEST RESULT FOR THIS SECTION
+"RTN","C0CLABS",222,0)
+ . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
+"RTN","C0CLABS",223,0)
+ . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
+"RTN","C0CLABS",224,0)
+ . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
+"RTN","C0CLABS",225,0)
+ . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
+"RTN","C0CLABS",226,0)
+ . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE
+"RTN","C0CLABS",227,0)
+ . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER
+"RTN","C0CLABS",228,0)
+ . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2
+"RTN","C0CLABS",229,0)
+ . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
+"RTN","C0CLABS",230,0)
+ . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT
+"RTN","C0CLABS",231,0)
+ . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
+"RTN","C0CLABS",232,0)
+ . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
+"RTN","C0CLABS",233,0)
+ . . ; I 'C0CQT ZWR XV
+"RTN","C0CLABS",234,0)
+ . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
+"RTN","C0CLABS",235,0)
+ . I 'C0CQT D  ;
+"RTN","C0CLABS",236,0)
+ . . W C0CI," ",C0CTYP,!
+"RTN","C0CLABS",237,0)
+ . ; S C0CI=$O(@C0CHB@(C0CI))
+"RTN","C0CLABS",238,0)
+ ;K ^TMP("C0CRIM","VARS",DFN,"RESULTS")
+"RTN","C0CLABS",239,0)
+ ;M ^TMP("C0CRIM","VARS",DFN,"RESULTS")=@C0CLB
+"RTN","C0CLABS",240,0)
  Q
-"RTN","C0CLABS",159,0)
- ;
-"RTN","C0CLABS",160,0)
-LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
-"RTN","C0CLABS",161,0)
- ;
-"RTN","C0CLABS",162,0)
- ; N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR
-"RTN","C0CLABS",163,0)
- I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
-"RTN","C0CLABS",164,0)
- I '$D(C0CQT) S C0CQT=0
-"RTN","C0CLABS",165,0)
- I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
-"RTN","C0CLABS",166,0)
- I '$D(^TMP("C0CCCR","LABTBL",0)) D SETTBL ;INITIALIZE LAB TABLE
-"RTN","C0CLABS",167,0)
- I ^TMP("C0CCCR","LABTBL",0)'="V3" D SETTBL ;NEED NEWEST VERSION
-"RTN","C0CLABS",168,0)
- I '$D(^TMP("HLS",$J,1)) D GHL7 ; GET HL7 MGS IF NOT ALREADY DONE
-"RTN","C0CLABS",169,0)
- S C0CTAB=$NA(^TMP("C0CCCR","LABTBL")) ; BASE OF OBX TABLE
-"RTN","C0CLABS",170,0)
- S C0CHB=$NA(^TMP("HLS",$J))
-"RTN","C0CLABS",171,0)
- S C0CI=""
-"RTN","C0CLABS",172,0)
- S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT
-"RTN","C0CLABS",173,0)
- F  S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI=""  D  ; FOR ALL RECORDS IN HL7 MSG
-"RTN","C0CLABS",174,0)
- . K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES
-"RTN","C0CLABS",175,0)
- . S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
-"RTN","C0CLABS",176,0)
- . D LTYP(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
-"RTN","C0CLABS",177,0)
- . I $G(C0CVAR("RESULTCODINGSYSTEM"))="LN" D  ; gpl - for certification
-"RTN","C0CLABS",178,0)
- . . S C0CVAR("RESULTCODINGSYSTEM")="LOINC" ; NEED TO SPELL IT OUT
-"RTN","C0CLABS",179,0)
- . . N C0CRDT S C0CRDT=C0CVAR("RESULTDESCRIPTIONTEXT") ; THE DESCRIPTION
-"RTN","C0CLABS",180,0)
- . . N C0CRCD S C0CRCD=C0CVAR("RESULTCODE") ; THE LOINC CODE
-"RTN","C0CLABS",181,0)
- . . S C0CVAR("RESULTDESCRIPTIONTEXT")=C0CRDT_" LOINC: "_C0CRCD
-"RTN","C0CLABS",182,0)
- . M XV=C0CVAR ;
-"RTN","C0CLABS",183,0)
- . I C0CTYP="OBR" D  ; BEGINNING OF NEW SECTION
-"RTN","C0CLABS",184,0)
- . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
-"RTN","C0CLABS",185,0)
- . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
-"RTN","C0CLABS",186,0)
- . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
-"RTN","C0CLABS",187,0)
- . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
-"RTN","C0CLABS",188,0)
- . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
-"RTN","C0CLABS",189,0)
- . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
-"RTN","C0CLABS",190,0)
- . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
-"RTN","C0CLABS",191,0)
- . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
-"RTN","C0CLABS",192,0)
- . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
-"RTN","C0CLABS",193,0)
- . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
-"RTN","C0CLABS",194,0)
- . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
-"RTN","C0CLABS",195,0)
- . I C0CTYP="OBX" D  ; SPECIAL CASE FOR OBX3
-"RTN","C0CLABS",196,0)
- . . ; RESULTTESTCODEVALUE
-"RTN","C0CLABS",197,0)
- . . ; RESULTTESTDESCRIPTIONTEXT
-"RTN","C0CLABS",198,0)
- . . I C0CVAR("C3")="LN" D  ; PRIMARY CODE IS LOINC
-"RTN","C0CLABS",199,0)
- . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE LOINC CODE VALUE
-"RTN","C0CLABS",200,0)
- . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
-"RTN","C0CLABS",201,0)
- . . . ;S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESC TXT
-"RTN","C0CLABS",202,0)
- . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2")_" LOINC: "_C0CVAR("C1")
-"RTN","C0CLABS",203,0)
- . . E  I C0CVAR("C6")="LN" D  ; SECONDARY CODE IS LOINC
-"RTN","C0CLABS",204,0)
- . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; THE LOINC CODE VALUE
-"RTN","C0CLABS",205,0)
- . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
-"RTN","C0CLABS",206,0)
- . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; DESCRIPTION TEXT
-"RTN","C0CLABS",207,0)
- . . E  I C0CVAR("C6")'="" D  ; NO LOINC CODES, USE SECONDARY IF PRESENT
-"RTN","C0CLABS",208,0)
- . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
-"RTN","C0CLABS",209,0)
- . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
-"RTN","C0CLABS",210,0)
- . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
-"RTN","C0CLABS",211,0)
- . . E  D  ; NO SECONDARY, USE PRIMARY
-"RTN","C0CLABS",212,0)
- . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
-"RTN","C0CLABS",213,0)
- . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
-"RTN","C0CLABS",214,0)
- . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
-"RTN","C0CLABS",215,0)
- . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;
-"RTN","C0CLABS",216,0)
- . . ; mod to remove local XML escaping rely upon MAP^C0CXPATH
-"RTN","C0CLABS",217,0)
- . . ;S XV("RESULTTESTNORMALDESCTEXT")=$$SYMENC^MXMLUTL(C0CZG) ;ESCAPE
-"RTN","C0CLABS",218,0)
- . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG
-"RTN","C0CLABS",219,0)
- . . S C0CZG=XV("RESULTTESTVALUE")
-"RTN","C0CLABS",220,0)
-  . . ; mod to remove local XML escaping rely upon MAP^C0CXPATH
-"RTN","C0CLABS",221,0)
- . . ;S XV("RESULTTESTVALUE")=$$SYMENC^MXMLUTL(C0CZG) ;ESCAPE
-"RTN","C0CLABS",222,0)
- . . S XV("RESULTTESTVALUE")=C0CZG
-"RTN","C0CLABS",223,0)
- . I C0CTYP="OBX" D  ; PROCESS TEST RESULTS
-"RTN","C0CLABS",224,0)
- . . I C0CLOBX=0 D  ; FIRST TEST RESULT FOR THIS SECTION
-"RTN","C0CLABS",225,0)
- . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
-"RTN","C0CLABS",226,0)
- . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
-"RTN","C0CLABS",227,0)
- . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
-"RTN","C0CLABS",228,0)
- . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
-"RTN","C0CLABS",229,0)
- . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE
-"RTN","C0CLABS",230,0)
- . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER
-"RTN","C0CLABS",231,0)
- . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2
-"RTN","C0CLABS",232,0)
- . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
-"RTN","C0CLABS",233,0)
- . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT
-"RTN","C0CLABS",234,0)
- . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
-"RTN","C0CLABS",235,0)
- . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
-"RTN","C0CLABS",236,0)
- . . ; I 'C0CQT ZWR XV
-"RTN","C0CLABS",237,0)
- . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
-"RTN","C0CLABS",238,0)
- . I 'C0CQT D  ;
-"RTN","C0CLABS",239,0)
- . . W C0CI," ",C0CTYP,!
-"RTN","C0CLABS",240,0)
- . ; S C0CI=$O(@C0CHB@(C0CI))
 "RTN","C0CLABS",241,0)
- ;K ^TMP("C0CRIM","VARS",DFN,"RESULTS")
+LTYP(OSEG,OTYP,OVARA,OC0CQT) ;
 "RTN","C0CLABS",242,0)
- ;M ^TMP("C0CRIM","VARS",DFN,"RESULTS")=@C0CLB
+ S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE
 "RTN","C0CLABS",243,0)
+ I '$D(OC0CQT) S C0CQT=0 ; NOT C0CQT IS DEFAULT
+"RTN","C0CLABS",244,0)
+ E  S C0CQT=OC0CQT ; ACCEPT C0CQT FLAG
+"RTN","C0CLABS",245,0)
+ I 1 D  ; FOR HL7 SEGMENT TYPE
+"RTN","C0CLABS",246,0)
+ . S OI="" ; INDEX INTO FIELDS IN SEG
+"RTN","C0CLABS",247,0)
+ . F  S OI=$O(@OTAB@(OI)) Q:OI=""  D  ; FOR EACH FIELD OF THE SEGMENT
+"RTN","C0CLABS",248,0)
+ . . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX
+"RTN","C0CLABS",249,0)
+ . . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED
+"RTN","C0CLABS",250,0)
+ . . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE
+"RTN","C0CLABS",251,0)
+ . . I $P(OI,";",2)'="" D  ; THIS IS DEFINING A SUB-VALUE
+"RTN","C0CLABS",252,0)
+ . . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX
+"RTN","C0CLABS",253,0)
+ . . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE
+"RTN","C0CLABS",254,0)
+ . . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE
+"RTN","C0CLABS",255,0)
+ . . I 'C0CQT D  ; PRINT OUTPUT IF C0CQT IS FALSE
+"RTN","C0CLABS",256,0)
+ . . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,!
+"RTN","C0CLABS",257,0)
  Q
-"RTN","C0CLABS",244,0)
-LTYP(OSEG,OTYP,OVARA,OC0CQT) ;
-"RTN","C0CLABS",245,0)
- S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE
-"RTN","C0CLABS",246,0)
- I '$D(OC0CQT) S C0CQT=0 ; NOT C0CQT IS DEFAULT
-"RTN","C0CLABS",247,0)
- E  S C0CQT=OC0CQT ; ACCEPT C0CQT FLAG
-"RTN","C0CLABS",248,0)
- I 1 D  ; FOR HL7 SEGMENT TYPE
-"RTN","C0CLABS",249,0)
- . S OI="" ; INDEX INTO FIELDS IN SEG
-"RTN","C0CLABS",250,0)
- . F  S OI=$O(@OTAB@(OI)) Q:OI=""  D  ; FOR EACH FIELD OF THE SEGMENT
-"RTN","C0CLABS",251,0)
- . . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX
-"RTN","C0CLABS",252,0)
- . . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED
-"RTN","C0CLABS",253,0)
- . . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE
-"RTN","C0CLABS",254,0)
- . . I $P(OI,";",2)'="" D  ; THIS IS DEFINING A SUB-VALUE
-"RTN","C0CLABS",255,0)
- . . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX
-"RTN","C0CLABS",256,0)
- . . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE
-"RTN","C0CLABS",257,0)
- . . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE
 "RTN","C0CLABS",258,0)
- . . I 'C0CQT D  ; PRINT OUTPUT IF C0CQT IS FALSE
+LOBX ;
 "RTN","C0CLABS",259,0)
- . . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,!
+ Q
 "RTN","C0CLABS",260,0)
+ ;
+"RTN","C0CLABS",261,0)
+OUT(DFN) ; WRITE OUT A CCR THAT HAS JUST BEEN PROCESSED (FOR TESTING)
+"RTN","C0CLABS",262,0)
+ N GA,GF,GD
+"RTN","C0CLABS",263,0)
+ S GA=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1))
+"RTN","C0CLABS",264,0)
+ S GF="RPMS_CCR_"_DFN_"_"_DT_".xml"
+"RTN","C0CLABS",265,0)
+ S GD=^TMP("C0CCCR","ODIR")
+"RTN","C0CLABS",266,0)
+ W $$OUTPUT^C0CXPATH(GA,GF,GD)
+"RTN","C0CLABS",267,0)
  Q
-"RTN","C0CLABS",261,0)
-LOBX ;
-"RTN","C0CLABS",262,0)
+"RTN","C0CLABS",268,0)
+ ;
+"RTN","C0CLABS",269,0)
+SETTBL ;
+"RTN","C0CLABS",270,0)
+ K X ; CLEAR X
+"RTN","C0CLABS",271,0)
+ S X("PID","PID1")="1^00104^Set ID - Patient ID"
+"RTN","C0CLABS",272,0)
+ S X("PID","PID2")="2^00105^Patient ID (External ID)"
+"RTN","C0CLABS",273,0)
+ S X("PID","PID3")="3^00106^Patient ID (Internal ID)"
+"RTN","C0CLABS",274,0)
+ S X("PID","PID4")="4^00107^Alternate Patient ID"
+"RTN","C0CLABS",275,0)
+ S X("PID","PID5")="5^00108^Patient's Name"
+"RTN","C0CLABS",276,0)
+ S X("PID","PID6")="6^00109^Mother's Maiden Name"
+"RTN","C0CLABS",277,0)
+ S X("PID","PID7")="7^00110^Date of Birth"
+"RTN","C0CLABS",278,0)
+ S X("PID","PID8")="8^00111^Sex"
+"RTN","C0CLABS",279,0)
+ S X("PID","PID9")="9^00112^Patient Alias"
+"RTN","C0CLABS",280,0)
+ S X("PID","PID10")="10^00113^Race"
+"RTN","C0CLABS",281,0)
+ S X("PID","PID11")="11^00114^Patient Address"
+"RTN","C0CLABS",282,0)
+ S X("PID","PID12")="12^00115^County Code"
+"RTN","C0CLABS",283,0)
+ S X("PID","PID13")="13^00116^Phone Number - Home"
+"RTN","C0CLABS",284,0)
+ S X("PID","PID14")="14^00117^Phone Number - Business"
+"RTN","C0CLABS",285,0)
+ S X("PID","PID15")="15^00118^Language - Patient"
+"RTN","C0CLABS",286,0)
+ S X("PID","PID16")="16^00119^Marital Status"
+"RTN","C0CLABS",287,0)
+ S X("PID","PID17")="17^00120^Religion"
+"RTN","C0CLABS",288,0)
+ S X("PID","PID18")="18^00121^Patient Account Number"
+"RTN","C0CLABS",289,0)
+ S X("PID","PID19")="19^00122^SSN Number - Patient"
+"RTN","C0CLABS",290,0)
+ S X("PID","PID20")="20^00123^Drivers License - Patient"
+"RTN","C0CLABS",291,0)
+ S X("PID","PID21")="21^00124^Mother's Identifier"
+"RTN","C0CLABS",292,0)
+ S X("PID","PID22")="22^00125^Ethnic Group"
+"RTN","C0CLABS",293,0)
+ S X("PID","PID23")="23^00126^Birth Place"
+"RTN","C0CLABS",294,0)
+ S X("PID","PID24")="24^00127^Multiple Birth Indicator"
+"RTN","C0CLABS",295,0)
+ S X("PID","PID25")="25^00128^Birth Order"
+"RTN","C0CLABS",296,0)
+ S X("PID","PID26")="26^00129^Citizenship"
+"RTN","C0CLABS",297,0)
+ S X("PID","PID27")="27^00130^Veteran.s Military Status"
+"RTN","C0CLABS",298,0)
+ S X("PID","PID28")="28^00739^Nationality"
+"RTN","C0CLABS",299,0)
+ S X("PID","PID29")="29^00740^Patient Death Date/Time"
+"RTN","C0CLABS",300,0)
+ S X("PID","PID30")="30^00741^Patient Death Indicator"
+"RTN","C0CLABS",301,0)
+ S X("NTE","NTE1")="1^00573^Set ID - NTE"
+"RTN","C0CLABS",302,0)
+ S X("NTE","NTE2")="2^00574^Source of Comment"
+"RTN","C0CLABS",303,0)
+ S X("NTE","NTE3")="3^00575^Comment"
+"RTN","C0CLABS",304,0)
+ S X("ORC","ORC1")="1^00215^Order Control"
+"RTN","C0CLABS",305,0)
+ S X("ORC","ORC2")="2^00216^Placer Order Number"
+"RTN","C0CLABS",306,0)
+ S X("ORC","ORC3")="3^00217^Filler Order Number"
+"RTN","C0CLABS",307,0)
+ S X("ORC","ORC4")="4^00218^Placer Order Number"
+"RTN","C0CLABS",308,0)
+ S X("ORC","ORC5")="5^00219^Order Status"
+"RTN","C0CLABS",309,0)
+ S X("ORC","ORC6")="6^00220^Response Flag"
+"RTN","C0CLABS",310,0)
+ S X("ORC","ORC7")="7^00221^Quantity/Timing"
+"RTN","C0CLABS",311,0)
+ S X("ORC","ORC8")="8^00222^Parent"
+"RTN","C0CLABS",312,0)
+ S X("ORC","ORC9")="9^00223^Date/Time of Transaction"
+"RTN","C0CLABS",313,0)
+ S X("ORC","ORC10")="10^00224^Entered By"
+"RTN","C0CLABS",314,0)
+ S X("ORC","ORC11")="11^00225^Verified By"
+"RTN","C0CLABS",315,0)
+ S X("ORC","ORC12")="12^00226^Ordering Provider"
+"RTN","C0CLABS",316,0)
+ S X("ORC","ORC13")="13^00227^Enterer's Location"
+"RTN","C0CLABS",317,0)
+ S X("ORC","ORC14")="14^00228^Call Back Phone Number"
+"RTN","C0CLABS",318,0)
+ S X("ORC","ORC15")="15^00229^Order Effective Date/Time"
+"RTN","C0CLABS",319,0)
+ S X("ORC","ORC16")="16^00230^Order Control Code Reason"
+"RTN","C0CLABS",320,0)
+ S X("ORC","ORC17")="17^00231^Entering Organization"
+"RTN","C0CLABS",321,0)
+ S X("ORC","ORC18")="18^00232^Entering Device"
+"RTN","C0CLABS",322,0)
+ S X("ORC","ORC19")="19^00233^Action By"
+"RTN","C0CLABS",323,0)
+ S X("OBR","OBR1")="1^00237^Set ID - Observation Request"
+"RTN","C0CLABS",324,0)
+ S X("OBR","OBR2")="2^00216^Placer Order Number"
+"RTN","C0CLABS",325,0)
+ S X("OBR","OBR3")="3^00217^Filler Order Number"
+"RTN","C0CLABS",326,0)
+ S X("OBR","OBR4")="4^00238^Universal Service ID"
+"RTN","C0CLABS",327,0)
+ S X("OBR","OBR4;LOINC")="4;1^00238^Universal Service ID - LOINC^RESULTCODE"
+"RTN","C0CLABS",328,0)
+ S X("OBR","OBR4;DESC")="4;2^00238^Universal Service ID - DESC^RESULTDESCRIPTIONTEXT"
+"RTN","C0CLABS",329,0)
+ S X("OBR","OBR4;VACODE")="4;3^00238^Universal Service ID - VACODE^RESULTCODINGSYSTEM"
+"RTN","C0CLABS",330,0)
+ S X("OBR","OBR5")="5^00239^Priority"
+"RTN","C0CLABS",331,0)
+ S X("OBR","OBR6")="6^00240^Requested Date/Time"
+"RTN","C0CLABS",332,0)
+ S X("OBR","OBR7")="7^00241^Observation Date/Time^RESULTASSESSMENTDATETIME"
+"RTN","C0CLABS",333,0)
+ S X("OBR","OBR8")="8^00242^Observation End Date/Time"
+"RTN","C0CLABS",334,0)
+ S X("OBR","OBR9")="9^00243^Collection Volume"
+"RTN","C0CLABS",335,0)
+ S X("OBR","OBR10")="10^00244^Collector Identifier"
+"RTN","C0CLABS",336,0)
+ S X("OBR","OBR11")="11^00245^Specimen Action Code"
+"RTN","C0CLABS",337,0)
+ S X("OBR","OBR12")="12^00246^Danger Code"
+"RTN","C0CLABS",338,0)
+ S X("OBR","OBR13")="13^00247^Relevant Clinical Info."
+"RTN","C0CLABS",339,0)
+ S X("OBR","OBR14")="14^00248^Specimen Rcv'd. Date/Time"
+"RTN","C0CLABS",340,0)
+ S X("OBR","OBR15")="15^00249^Specimen Source"
+"RTN","C0CLABS",341,0)
+ S X("OBR","OBR16")="16^00226^Ordering Provider XCN^RESULTSOURCEACTORID"
+"RTN","C0CLABS",342,0)
+ S X("OBR","OBR17")="17^00250^Order Callback Phone Number"
+"RTN","C0CLABS",343,0)
+ S X("OBR","OBR18")="18^00251^Placers Field 1"
+"RTN","C0CLABS",344,0)
+ S X("OBR","OBR19")="19^00252^Placers Field 2"
+"RTN","C0CLABS",345,0)
+ S X("OBR","OBR20")="20^00253^Filler Field 1"
+"RTN","C0CLABS",346,0)
+ S X("OBR","OBR21")="21^00254^Filler Field 2"
+"RTN","C0CLABS",347,0)
+ S X("OBR","OBR22")="22^00255^Results Rpt./Status Change"
+"RTN","C0CLABS",348,0)
+ S X("OBR","OBR23")="23^00256^Charge to Practice"
+"RTN","C0CLABS",349,0)
+ S X("OBR","OBR24")="24^00257^Diagnostic Service Sect"
+"RTN","C0CLABS",350,0)
+ S X("OBR","OBR25")="25^00258^Result Status^RESULTSTATUS"
+"RTN","C0CLABS",351,0)
+ S X("OBR","OBR26")="26^00259^Parent Result"
+"RTN","C0CLABS",352,0)
+ S X("OBR","OBR27")="27^00221^Quantity/Timing"
+"RTN","C0CLABS",353,0)
+ S X("OBR","OBR28")="28^00260^Result Copies to"
+"RTN","C0CLABS",354,0)
+ S X("OBR","OBR29")="29^00261^Parent Number"
+"RTN","C0CLABS",355,0)
+ S X("OBR","OBR30")="30^00262^Transportation Mode"
+"RTN","C0CLABS",356,0)
+ S X("OBR","OBR31")="31^00263^Reason for Study"
+"RTN","C0CLABS",357,0)
+ S X("OBR","OBR32")="32^00264^Principal Result Interpreter"
+"RTN","C0CLABS",358,0)
+ S X("OBR","OBR33")="33^00265^Assistant Result Interpreter"
+"RTN","C0CLABS",359,0)
+ S X("OBR","OBR34")="34^00266^Technician"
+"RTN","C0CLABS",360,0)
+ S X("OBR","OBR35")="35^00267^Transcriptionist"
+"RTN","C0CLABS",361,0)
+ S X("OBR","OBR36")="36^00268^Scheduled Date/Time"
+"RTN","C0CLABS",362,0)
+ S X("OBR","OBR37")="37^01028^Number of Sample Containers"
+"RTN","C0CLABS",363,0)
+ S X("OBR","OBR38")="38^38^01029 Transport Logistics of Collected Sample"
+"RTN","C0CLABS",364,0)
+ S X("OBR","OBR39")="39^01030^Collector.s Comment"
+"RTN","C0CLABS",365,0)
+ S X("OBR","OBR40")="40^01031^Transport Arrangement Responsibility"
+"RTN","C0CLABS",366,0)
+ S X("OBR","OBR41")="41^01032^Transport Arranged"
+"RTN","C0CLABS",367,0)
+ S X("OBR","OBR42")="42^01033^Escort Required"
+"RTN","C0CLABS",368,0)
+ S X("OBR","OBR43")="43^01034^Planned Patient Transport Comment"
+"RTN","C0CLABS",369,0)
+ S X("OBX","OBX1")="1^00559^Set ID - OBX"
+"RTN","C0CLABS",370,0)
+ S X("OBX","OBX2")="2^00676^Value Type"
+"RTN","C0CLABS",371,0)
+ S X("OBX","OBX3")="3^00560^Observation Identifier"
+"RTN","C0CLABS",372,0)
+ S X("OBX","OBX3;C1")="3;1^00560^Observation Identifier^C1"
+"RTN","C0CLABS",373,0)
+ S X("OBX","OBX3;C2")="3;2^00560^Observation Identifier^C2"
+"RTN","C0CLABS",374,0)
+ S X("OBX","OBX3;C3")="3;3^00560^Observation Identifier^C3"
+"RTN","C0CLABS",375,0)
+ S X("OBX","OBX3;C4")="3;4^00560^Observation Identifier^C4"
+"RTN","C0CLABS",376,0)
+ S X("OBX","OBX3;C5")="3;5^00560^Observation Identifier^C5"
+"RTN","C0CLABS",377,0)
+ S X("OBX","OBX3;C6")="3;6^00560^Observation Identifier^C6"
+"RTN","C0CLABS",378,0)
+ S X("OBX","OBX4")="4^00769^Observation Sub-Id"
+"RTN","C0CLABS",379,0)
+ S X("OBX","OBX5")="5^00561^Observation Results^RESULTTESTVALUE"
+"RTN","C0CLABS",380,0)
+ S X("OBX","OBX6")="6^00562^Units^RESULTTESTUNITS"
+"RTN","C0CLABS",381,0)
+ S X("OBX","OBX7")="7^00563^Reference Range^RESULTTESTNORMALDESCTEXT"
+"RTN","C0CLABS",382,0)
+ S X("OBX","OBX8")="8^00564^Abnormal Flags^RESULTTESTFLAG"
+"RTN","C0CLABS",383,0)
+ S X("OBX","OBX9")="9^00639^Probability"
+"RTN","C0CLABS",384,0)
+ S X("OBX","OBX10")="10^00565^Nature of Abnormal Test"
+"RTN","C0CLABS",385,0)
+ S X("OBX","OBX11")="11^00566^Observ. Result Status^RESULTTESTSTATUSTEXT"
+"RTN","C0CLABS",386,0)
+ S X("OBX","OBX12")="12^00567^Date Last Normal Value"
+"RTN","C0CLABS",387,0)
+ S X("OBX","OBX13")="13^00581^User Defined Access Checks"
+"RTN","C0CLABS",388,0)
+ S X("OBX","OBX14")="14^00582^Date/Time of Observation^RESULTTESTDATETIME"
+"RTN","C0CLABS",389,0)
+ S X("OBX","OBX15")="15^00583^Producer.s ID^RESULTTESTSOURCEACTORID"
+"RTN","C0CLABS",390,0)
+ S X("OBX","OBX16")="16^00584^Responsible Observer"
+"RTN","C0CLABS",391,0)
+ S X("OBX","OBX17")="17^00936^Observation Method"
+"RTN","C0CLABS",392,0)
+ K ^TMP("C0CCCR","LABTBL")
+"RTN","C0CLABS",393,0)
+ M ^TMP("C0CCCR","LABTBL")=X ; SET VALUES IN LAB TBL
+"RTN","C0CLABS",394,0)
+ S ^TMP("C0CCCR","LABTBL",0)="V3"
+"RTN","C0CLABS",395,0)
  Q
-"RTN","C0CLABS",263,0)
- ;
-"RTN","C0CLABS",264,0)
-OUT(DFN) ; WRITE OUT A CCR THAT HAS JUST BEEN PROCESSED (FOR TESTING)
-"RTN","C0CLABS",265,0)
- N GA,GF,GD
-"RTN","C0CLABS",266,0)
- S GA=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1))
-"RTN","C0CLABS",267,0)
- S GF="RPMS_CCR_"_DFN_"_"_DT_".xml"
-"RTN","C0CLABS",268,0)
- S GD=^TMP("C0CCCR","ODIR")
-"RTN","C0CLABS",269,0)
- W $$OUTPUT^C0CXPATH(GA,GF,GD)
-"RTN","C0CLABS",270,0)
- Q
-"RTN","C0CLABS",271,0)
- ;
-"RTN","C0CLABS",272,0)
-SETTBL ;
-"RTN","C0CLABS",273,0)
- K X ; CLEAR X
-"RTN","C0CLABS",274,0)
- S X("PID","PID1")="1^00104^Set ID - Patient ID"
-"RTN","C0CLABS",275,0)
- S X("PID","PID2")="2^00105^Patient ID (External ID)"
-"RTN","C0CLABS",276,0)
- S X("PID","PID3")="3^00106^Patient ID (Internal ID)"
-"RTN","C0CLABS",277,0)
- S X("PID","PID4")="4^00107^Alternate Patient ID"
-"RTN","C0CLABS",278,0)
- S X("PID","PID5")="5^00108^Patient's Name"
-"RTN","C0CLABS",279,0)
- S X("PID","PID6")="6^00109^Mother's Maiden Name"
-"RTN","C0CLABS",280,0)
- S X("PID","PID7")="7^00110^Date of Birth"
-"RTN","C0CLABS",281,0)
- S X("PID","PID8")="8^00111^Sex"
-"RTN","C0CLABS",282,0)
- S X("PID","PID9")="9^00112^Patient Alias"
-"RTN","C0CLABS",283,0)
- S X("PID","PID10")="10^00113^Race"
-"RTN","C0CLABS",284,0)
- S X("PID","PID11")="11^00114^Patient Address"
-"RTN","C0CLABS",285,0)
- S X("PID","PID12")="12^00115^County Code"
-"RTN","C0CLABS",286,0)
- S X("PID","PID13")="13^00116^Phone Number - Home"
-"RTN","C0CLABS",287,0)
- S X("PID","PID14")="14^00117^Phone Number - Business"
-"RTN","C0CLABS",288,0)
- S X("PID","PID15")="15^00118^Language - Patient"
-"RTN","C0CLABS",289,0)
- S X("PID","PID16")="16^00119^Marital Status"
-"RTN","C0CLABS",290,0)
- S X("PID","PID17")="17^00120^Religion"
-"RTN","C0CLABS",291,0)
- S X("PID","PID18")="18^00121^Patient Account Number"
-"RTN","C0CLABS",292,0)
- S X("PID","PID19")="19^00122^SSN Number - Patient"
-"RTN","C0CLABS",293,0)
- S X("PID","PID20")="20^00123^Drivers License - Patient"
-"RTN","C0CLABS",294,0)
- S X("PID","PID21")="21^00124^Mother's Identifier"
-"RTN","C0CLABS",295,0)
- S X("PID","PID22")="22^00125^Ethnic Group"
-"RTN","C0CLABS",296,0)
- S X("PID","PID23")="23^00126^Birth Place"
-"RTN","C0CLABS",297,0)
- S X("PID","PID24")="24^00127^Multiple Birth Indicator"
-"RTN","C0CLABS",298,0)
- S X("PID","PID25")="25^00128^Birth Order"
-"RTN","C0CLABS",299,0)
- S X("PID","PID26")="26^00129^Citizenship"
-"RTN","C0CLABS",300,0)
- S X("PID","PID27")="27^00130^Veteran.s Military Status"
-"RTN","C0CLABS",301,0)
- S X("PID","PID28")="28^00739^Nationality"
-"RTN","C0CLABS",302,0)
- S X("PID","PID29")="29^00740^Patient Death Date/Time"
-"RTN","C0CLABS",303,0)
- S X("PID","PID30")="30^00741^Patient Death Indicator"
-"RTN","C0CLABS",304,0)
- S X("NTE","NTE1")="1^00573^Set ID - NTE"
-"RTN","C0CLABS",305,0)
- S X("NTE","NTE2")="2^00574^Source of Comment"
-"RTN","C0CLABS",306,0)
- S X("NTE","NTE3")="3^00575^Comment"
-"RTN","C0CLABS",307,0)
- S X("ORC","ORC1")="1^00215^Order Control"
-"RTN","C0CLABS",308,0)
- S X("ORC","ORC2")="2^00216^Placer Order Number"
-"RTN","C0CLABS",309,0)
- S X("ORC","ORC3")="3^00217^Filler Order Number"
-"RTN","C0CLABS",310,0)
- S X("ORC","ORC4")="4^00218^Placer Order Number"
-"RTN","C0CLABS",311,0)
- S X("ORC","ORC5")="5^00219^Order Status"
-"RTN","C0CLABS",312,0)
- S X("ORC","ORC6")="6^00220^Response Flag"
-"RTN","C0CLABS",313,0)
- S X("ORC","ORC7")="7^00221^Quantity/Timing"
-"RTN","C0CLABS",314,0)
- S X("ORC","ORC8")="8^00222^Parent"
-"RTN","C0CLABS",315,0)
- S X("ORC","ORC9")="9^00223^Date/Time of Transaction"
-"RTN","C0CLABS",316,0)
- S X("ORC","ORC10")="10^00224^Entered By"
-"RTN","C0CLABS",317,0)
- S X("ORC","ORC11")="11^00225^Verified By"
-"RTN","C0CLABS",318,0)
- S X("ORC","ORC12")="12^00226^Ordering Provider"
-"RTN","C0CLABS",319,0)
- S X("ORC","ORC13")="13^00227^Enterer's Location"
-"RTN","C0CLABS",320,0)
- S X("ORC","ORC14")="14^00228^Call Back Phone Number"
-"RTN","C0CLABS",321,0)
- S X("ORC","ORC15")="15^00229^Order Effective Date/Time"
-"RTN","C0CLABS",322,0)
- S X("ORC","ORC16")="16^00230^Order Control Code Reason"
-"RTN","C0CLABS",323,0)
- S X("ORC","ORC17")="17^00231^Entering Organization"
-"RTN","C0CLABS",324,0)
- S X("ORC","ORC18")="18^00232^Entering Device"
-"RTN","C0CLABS",325,0)
- S X("ORC","ORC19")="19^00233^Action By"
-"RTN","C0CLABS",326,0)
- S X("OBR","OBR1")="1^00237^Set ID - Observation Request"
-"RTN","C0CLABS",327,0)
- S X("OBR","OBR2")="2^00216^Placer Order Number"
-"RTN","C0CLABS",328,0)
- S X("OBR","OBR3")="3^00217^Filler Order Number"
-"RTN","C0CLABS",329,0)
- S X("OBR","OBR4")="4^00238^Universal Service ID"
-"RTN","C0CLABS",330,0)
- S X("OBR","OBR4;LOINC")="4;1^00238^Universal Service ID - LOINC^RESULTCODE"
-"RTN","C0CLABS",331,0)
- S X("OBR","OBR4;DESC")="4;2^00238^Universal Service ID - DESC^RESULTDESCRIPTIONTEXT"
-"RTN","C0CLABS",332,0)
- S X("OBR","OBR4;VACODE")="4;3^00238^Universal Service ID - VACODE^RESULTCODINGSYSTEM"
-"RTN","C0CLABS",333,0)
- S X("OBR","OBR5")="5^00239^Priority"
-"RTN","C0CLABS",334,0)
- S X("OBR","OBR6")="6^00240^Requested Date/Time"
-"RTN","C0CLABS",335,0)
- S X("OBR","OBR7")="7^00241^Observation Date/Time^RESULTASSESSMENTDATETIME"
-"RTN","C0CLABS",336,0)
- S X("OBR","OBR8")="8^00242^Observation End Date/Time"
-"RTN","C0CLABS",337,0)
- S X("OBR","OBR9")="9^00243^Collection Volume"
-"RTN","C0CLABS",338,0)
- S X("OBR","OBR10")="10^00244^Collector Identifier"
-"RTN","C0CLABS",339,0)
- S X("OBR","OBR11")="11^00245^Specimen Action Code"
-"RTN","C0CLABS",340,0)
- S X("OBR","OBR12")="12^00246^Danger Code"
-"RTN","C0CLABS",341,0)
- S X("OBR","OBR13")="13^00247^Relevant Clinical Info."
-"RTN","C0CLABS",342,0)
- S X("OBR","OBR14")="14^00248^Specimen Rcv'd. Date/Time"
-"RTN","C0CLABS",343,0)
- S X("OBR","OBR15")="15^00249^Specimen Source"
-"RTN","C0CLABS",344,0)
- S X("OBR","OBR16")="16^00226^Ordering Provider XCN^RESULTSOURCEACTORID"
-"RTN","C0CLABS",345,0)
- S X("OBR","OBR17")="17^00250^Order Callback Phone Number"
-"RTN","C0CLABS",346,0)
- S X("OBR","OBR18")="18^00251^Placers Field 1"
-"RTN","C0CLABS",347,0)
- S X("OBR","OBR19")="19^00252^Placers Field 2"
-"RTN","C0CLABS",348,0)
- S X("OBR","OBR20")="20^00253^Filler Field 1"
-"RTN","C0CLABS",349,0)
- S X("OBR","OBR21")="21^00254^Filler Field 2"
-"RTN","C0CLABS",350,0)
- S X("OBR","OBR22")="22^00255^Results Rpt./Status Change"
-"RTN","C0CLABS",351,0)
- S X("OBR","OBR23")="23^00256^Charge to Practice"
-"RTN","C0CLABS",352,0)
- S X("OBR","OBR24")="24^00257^Diagnostic Service Sect"
-"RTN","C0CLABS",353,0)
- S X("OBR","OBR25")="25^00258^Result Status^RESULTSTATUS"
-"RTN","C0CLABS",354,0)
- S X("OBR","OBR26")="26^00259^Parent Result"
-"RTN","C0CLABS",355,0)
- S X("OBR","OBR27")="27^00221^Quantity/Timing"
-"RTN","C0CLABS",356,0)
- S X("OBR","OBR28")="28^00260^Result Copies to"
-"RTN","C0CLABS",357,0)
- S X("OBR","OBR29")="29^00261^Parent Number"
-"RTN","C0CLABS",358,0)
- S X("OBR","OBR30")="30^00262^Transportation Mode"
-"RTN","C0CLABS",359,0)
- S X("OBR","OBR31")="31^00263^Reason for Study"
-"RTN","C0CLABS",360,0)
- S X("OBR","OBR32")="32^00264^Principal Result Interpreter"
-"RTN","C0CLABS",361,0)
- S X("OBR","OBR33")="33^00265^Assistant Result Interpreter"
-"RTN","C0CLABS",362,0)
- S X("OBR","OBR34")="34^00266^Technician"
-"RTN","C0CLABS",363,0)
- S X("OBR","OBR35")="35^00267^Transcriptionist"
-"RTN","C0CLABS",364,0)
- S X("OBR","OBR36")="36^00268^Scheduled Date/Time"
-"RTN","C0CLABS",365,0)
- S X("OBR","OBR37")="37^01028^Number of Sample Containers"
-"RTN","C0CLABS",366,0)
- S X("OBR","OBR38")="38^38^01029 Transport Logistics of Collected Sample"
-"RTN","C0CLABS",367,0)
- S X("OBR","OBR39")="39^01030^Collector.s Comment"
-"RTN","C0CLABS",368,0)
- S X("OBR","OBR40")="40^01031^Transport Arrangement Responsibility"
-"RTN","C0CLABS",369,0)
- S X("OBR","OBR41")="41^01032^Transport Arranged"
-"RTN","C0CLABS",370,0)
- S X("OBR","OBR42")="42^01033^Escort Required"
-"RTN","C0CLABS",371,0)
- S X("OBR","OBR43")="43^01034^Planned Patient Transport Comment"
-"RTN","C0CLABS",372,0)
- S X("OBX","OBX1")="1^00559^Set ID - OBX"
-"RTN","C0CLABS",373,0)
- S X("OBX","OBX2")="2^00676^Value Type"
-"RTN","C0CLABS",374,0)
- S X("OBX","OBX3")="3^00560^Observation Identifier"
-"RTN","C0CLABS",375,0)
- S X("OBX","OBX3;C1")="3;1^00560^Observation Identifier^C1"
-"RTN","C0CLABS",376,0)
- S X("OBX","OBX3;C2")="3;2^00560^Observation Identifier^C2"
-"RTN","C0CLABS",377,0)
- S X("OBX","OBX3;C3")="3;3^00560^Observation Identifier^C3"
-"RTN","C0CLABS",378,0)
- S X("OBX","OBX3;C4")="3;4^00560^Observation Identifier^C4"
-"RTN","C0CLABS",379,0)
- S X("OBX","OBX3;C5")="3;5^00560^Observation Identifier^C5"
-"RTN","C0CLABS",380,0)
- S X("OBX","OBX3;C6")="3;6^00560^Observation Identifier^C6"
-"RTN","C0CLABS",381,0)
- S X("OBX","OBX4")="4^00769^Observation Sub-Id"
-"RTN","C0CLABS",382,0)
- S X("OBX","OBX5")="5^00561^Observation Results^RESULTTESTVALUE"
-"RTN","C0CLABS",383,0)
- S X("OBX","OBX6")="6^00562^Units^RESULTTESTUNITS"
-"RTN","C0CLABS",384,0)
- S X("OBX","OBX7")="7^00563^Reference Range^RESULTTESTNORMALDESCTEXT"
-"RTN","C0CLABS",385,0)
- S X("OBX","OBX8")="8^00564^Abnormal Flags^RESULTTESTFLAG"
-"RTN","C0CLABS",386,0)
- S X("OBX","OBX9")="9^00639^Probability"
-"RTN","C0CLABS",387,0)
- S X("OBX","OBX10")="10^00565^Nature of Abnormal Test"
-"RTN","C0CLABS",388,0)
- S X("OBX","OBX11")="11^00566^Observ. Result Status^RESULTTESTSTATUSTEXT"
-"RTN","C0CLABS",389,0)
- S X("OBX","OBX12")="12^00567^Date Last Normal Value"
-"RTN","C0CLABS",390,0)
- S X("OBX","OBX13")="13^00581^User Defined Access Checks"
-"RTN","C0CLABS",391,0)
- S X("OBX","OBX14")="14^00582^Date/Time of Observation^RESULTTESTDATETIME"
-"RTN","C0CLABS",392,0)
- S X("OBX","OBX15")="15^00583^Producer.s ID^RESULTTESTSOURCEACTORID"
-"RTN","C0CLABS",393,0)
- S X("OBX","OBX16")="16^00584^Responsible Observer"
-"RTN","C0CLABS",394,0)
- S X("OBX","OBX17")="17^00936^Observation Method"
-"RTN","C0CLABS",395,0)
- K ^TMP("C0CCCR","LABTBL")
 "RTN","C0CLABS",396,0)
- M ^TMP("C0CCCR","LABTBL")=X ; SET VALUES IN LAB TBL
-"RTN","C0CLABS",397,0)
- S ^TMP("C0CCCR","LABTBL",0)="V3"
-"RTN","C0CLABS",398,0)
- Q
-"RTN","C0CLABS",399,0)
  ;
 "RTN","C0CMAIL")
-0^81^B92791623
+0^81^B91585320
 "RTN","C0CMAIL",1,0)
 C0CMAIL ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr
 "RTN","C0CMAIL",2,0)
-V ;;1.2;C0C;;May 11, 2012;Build 50
+V ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CMAIL",3,0)
  ;Copyright 2011 Chris Richardson, Richardson Computer Research
@@ -103310,743 +103346,737 @@
  ;   rcr@rcresearch.us
 "RTN","C0CMAIL",6,0)
- ;  Licensed under the terms of the GNU
+ ;
 "RTN","C0CMAIL",7,0)
- ;General Public License See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CMAIL",8,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CMAIL",9,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CMAIL",10,0)
- ;it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CMAIL",11,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CMAIL",12,0)
- ;(at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CMAIL",13,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CMAIL",14,0)
- ;This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CMAIL",15,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CMAIL",16,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CMAIL",17,0)
- ;GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CMAIL",18,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CMAIL",19,0)
- ;You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CMAIL",20,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;  ------------------
 "RTN","C0CMAIL",21,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;Entry Points
 "RTN","C0CMAIL",22,0)
- ;
+ ; GETMSG^C0CMAIL(.C0CDATA,.C0CINPUT)
 "RTN","C0CMAIL",23,0)
- ;  ------------------
+ ;  Input:
 "RTN","C0CMAIL",24,0)
- ;Entry Points
+ ;    C0CINPUT = "DUZ;MAILBOX_Name[or IEN for box (comma Separated);MALL
 "RTN","C0CMAIL",25,0)
- ; GETMSG^C0CMAIL(.C0CDATA,.C0CINPUT)
+ ;                      or "*" for all boxes, default is "IN" if missing]"
 "RTN","C0CMAIL",26,0)
- ;  Input:
+ ;                $P(C0CINPUT,";",3)=MALL, default=NUL means "New only",
 "RTN","C0CMAIL",27,0)
- ;    C0CINPUT = "DUZ;MAILBOX_Name[or IEN for box (comma Separated);MALL
+ ;                                     "*" for All or 9,999 maximum
 "RTN","C0CMAIL",28,0)
- ;                      or "*" for all boxes, default is "IN" if missing]"
+ ;                    MALL?1.n = that number of the n most recent
 "RTN","C0CMAIL",29,0)
- ;                $P(C0CINPUT,";",3)=MALL, default=NUL means "New only",
+ ;  Internally:
 "RTN","C0CMAIL",30,0)
- ;                                     "*" for All or 9,999 maximum
+ ;    BNAM = Box Name
 "RTN","C0CMAIL",31,0)
- ;                    MALL?1.n = that number of the n most recent
+ ;  Output:
 "RTN","C0CMAIL",32,0)
- ;  Internally:
+ ;    C0CDATA
 "RTN","C0CMAIL",33,0)
- ;    BNAM = Box Name
+ ;      = (BNAM,"NUMBER") = Number of NEW Emails in Basket
 "RTN","C0CMAIL",34,0)
- ;  Output:
+ ;        (BNAM,"MSG",C0CIEN,"FROM")=Name
 "RTN","C0CMAIL",35,0)
- ;    C0CDATA
+ ;        (BNAM,"MSG",C0CIEN,"TO",n)=DUZ, or EMAIL Address
 "RTN","C0CMAIL",36,0)
- ;      = (BNAM,"NUMBER") = Number of NEW Emails in Basket
+ ;        (BNAM,"MSG",C0CIEN,"TO NAME",n)=Names or EMAIL Address
 "RTN","C0CMAIL",37,0)
- ;        (BNAM,"MSG",C0CIEN,"FROM")=Name
+ ;        (BNAM,"MSG",C0CIEN,"TITLE")=EMAIL Title
 "RTN","C0CMAIL",38,0)
- ;        (BNAM,"MSG",C0CIEN,"TO",n)=DUZ, or EMAIL Address
+ ;        (BNAM,"MSG",C0CIEN[for File 3.9])=Number of Attachments
 "RTN","C0CMAIL",39,0)
- ;        (BNAM,"MSG",C0CIEN,"TO NAME",n)=Names or EMAIL Address
+ ;        (BNAM,"MSG",C0CIEN,num,"CONT") = Free Text
 "RTN","C0CMAIL",40,0)
- ;        (BNAM,"MSG",C0CIEN,"TITLE")=EMAIL Title
+ ;        (BNAM,"MSG",C0CIEN,num,"LINES") = Number of Lines of Text
 "RTN","C0CMAIL",41,0)
- ;        (BNAM,"MSG",C0CIEN[for File 3.9])=Number of Attachments
+ ;        (BNAM,"MSG",C0CIEN,num,"SIZE") = Size of the Message in Bytes
 "RTN","C0CMAIL",42,0)
- ;        (BNAM,"MSG",C0CIEN,num,"CONT") = Free Text
+ ;        (BNAM,"MSG",C0CIEN,num,"TXT",LINE#) = Message Data (No Attachment)
 "RTN","C0CMAIL",43,0)
- ;        (BNAM,"MSG",C0CIEN,num,"LINES") = Number of Lines of Text
+ ;   (BNAM,"MSG",C0CIEN,"SEG",NUM) = First Line^Last Line
 "RTN","C0CMAIL",44,0)
- ;        (BNAM,"MSG",C0CIEN,num,"SIZE") = Size of the Message in Bytes
+ ;   (BNAM,"MSG",C0CIEN,"SEG",NUM,"CONT",type) = Message Details
 "RTN","C0CMAIL",45,0)
- ;        (BNAM,"MSG",C0CIEN,num,"TXT",LINE#) = Message Data (No Attachment)
+ ;   (BNAM,"MSG",C0CIEN,"SEG",NUM,LINE#) = Message Data
 "RTN","C0CMAIL",46,0)
- ;   (BNAM,"MSG",C0CIEN,"SEG",NUM) = First Line^Last Line
+ ; 
 "RTN","C0CMAIL",47,0)
- ;   (BNAM,"MSG",C0CIEN,"SEG",NUM,"CONT",type) = Message Details
+ ; DO DETAIL^C0CMAIL(.OUTBF,D0) ; For each Email Message and Attachments
 "RTN","C0CMAIL",48,0)
- ;   (BNAM,"MSG",C0CIEN,"SEG",NUM,LINE#) = Message Data
+ ;   Input;
 "RTN","C0CMAIL",49,0)
+ ;     D0     - The IEN for the message in file 3.9, MESSAGE global
+"RTN","C0CMAIL",50,0)
+ ;   Output
+"RTN","C0CMAIL",51,0)
+ ;     OUTBF  - The array of your choice to save the expanded and decoded message.
+"RTN","C0CMAIL",52,0)
  ; 
-"RTN","C0CMAIL",50,0)
- ; DO DETAIL^C0CMAIL(.OUTBF,D0) ; For each Email Message and Attachments
-"RTN","C0CMAIL",51,0)
- ;   Input;
-"RTN","C0CMAIL",52,0)
- ;     D0     - The IEN for the message in file 3.9, MESSAGE global
 "RTN","C0CMAIL",53,0)
- ;   Output
+GETMSG(C0CDATA,C0CINPUT) ; Common Entry Point for Mailbox Data
 "RTN","C0CMAIL",54,0)
- ;     OUTBF  - The array of your choice to save the expanded and decoded message.
+ K:'$G(C0CDATA("KEEP")) C0CDATA
 "RTN","C0CMAIL",55,0)
- ; 
+ N U
 "RTN","C0CMAIL",56,0)
-GETMSG(C0CDATA,C0CINPUT) ; Common Entry Point for Mailbox Data
+ S U="^"
 "RTN","C0CMAIL",57,0)
- K:'$G(C0CDATA("KEEP")) C0CDATA
+ D:$G(C0CINPUT)
 "RTN","C0CMAIL",58,0)
- N U
+ . N BF,DUZ,I,INPUT,J,L,LST,MBLST,MALL
 "RTN","C0CMAIL",59,0)
- S U="^"
+ . S INPUT=C0CINPUT
 "RTN","C0CMAIL",60,0)
- D:$G(C0CINPUT)
+ . S DUZ=+INPUT
 "RTN","C0CMAIL",61,0)
- . N BF,DUZ,I,INPUT,J,L,LST,MBLST,MALL
+ . D:$D(^XMB(3.7,DUZ,0))#2
 "RTN","C0CMAIL",62,0)
- . S INPUT=C0CINPUT
+ . . S MBLST=$P(INPUT,";",2)
 "RTN","C0CMAIL",63,0)
- . S DUZ=+INPUT
+ . . S MALL=$P(INPUT,";",3) ; New or All Mail Flag
 "RTN","C0CMAIL",64,0)
- . D:$D(^XMB(3.7,DUZ,0))#2
+ . . S:MALL["*" MALL=99999
 "RTN","C0CMAIL",65,0)
- . . S MBLST=$P(INPUT,";",2)
+ . . ; Only one of these can be correct
 "RTN","C0CMAIL",66,0)
- . . S MALL=$P(INPUT,";",3) ; New or All Mail Flag
+ . . D
 "RTN","C0CMAIL",67,0)
- . . S:MALL["*" MALL=99999
+ . . . ;  If nul, make it "IN" only
 "RTN","C0CMAIL",68,0)
- . . ; Only one of these can be correct
+ . . . I MBLST="" D  QUIT
 "RTN","C0CMAIL",69,0)
- . . D
+ . . . . S MBLST("IN")=0,I=0
 "RTN","C0CMAIL",70,0)
- . . . ;  If nul, make it "IN" only
+ . . . . D GATHER(DUZ,"IN",.LST)
 "RTN","C0CMAIL",71,0)
- . . . I MBLST="" D  QUIT
+ . . . .QUIT
 "RTN","C0CMAIL",72,0)
- . . . . S MBLST("IN")=0,I=0
+ . . . ;
 "RTN","C0CMAIL",73,0)
- . . . . D GATHER(DUZ,"IN",.LST)
+ . . . ;  If "*", Get all Mailboxes and look for New Messages
 "RTN","C0CMAIL",74,0)
+ . . . I MBLST["*" D  QUIT
+"RTN","C0CMAIL",75,0)
+ . . . . N NAM,NUM
+"RTN","C0CMAIL",76,0)
+ . . . . S NUM=0
+"RTN","C0CMAIL",77,0)
+ . . . . F  S NUM=$O(^XMB(3.7,DUZ,2,NUM)) Q:'NUM  D
+"RTN","C0CMAIL",78,0)
+ . . . . . S NAM=$P(^XMB(3.7,DUZ,2,NUM,0),U)
+"RTN","C0CMAIL",79,0)
+ . . . . . D GATHER(DUZ,NAM,.LST)
+"RTN","C0CMAIL",80,0)
+ . . . . .QUIT
+"RTN","C0CMAIL",81,0)
  . . . .QUIT
-"RTN","C0CMAIL",75,0)
+"RTN","C0CMAIL",82,0)
  . . . ;
-"RTN","C0CMAIL",76,0)
- . . . ;  If "*", Get all Mailboxes and look for New Messages
-"RTN","C0CMAIL",77,0)
- . . . I MBLST["*" D  QUIT
-"RTN","C0CMAIL",78,0)
- . . . . N NAM,NUM
-"RTN","C0CMAIL",79,0)
- . . . . S NUM=0
-"RTN","C0CMAIL",80,0)
- . . . . F  S NUM=$O(^XMB(3.7,DUZ,2,NUM)) Q:'NUM  D
-"RTN","C0CMAIL",81,0)
- . . . . . S NAM=$P(^XMB(3.7,DUZ,2,NUM,0),U)
-"RTN","C0CMAIL",82,0)
+"RTN","C0CMAIL",83,0)
+ . . . ;  If comma separated, look for mailboxes with new messages
+"RTN","C0CMAIL",84,0)
+ . . . I $L(MBLST,",")>1 D  QUIT
+"RTN","C0CMAIL",85,0)
+ . . . . S NAM=""
+"RTN","C0CMAIL",86,0)
+ . . . . N T,V
+"RTN","C0CMAIL",87,0)
+ . . . . F T=1:1:$L(MBLST,",")  S V=$P(MBLST,",",T)  I $L(V) D
+"RTN","C0CMAIL",88,0)
+ . . . . . I V S NAM=$P($G(^XMB(3.7,DUZ,2,V,0)),U)
+"RTN","C0CMAIL",89,0)
+ . . . . . S:NAM="" NAM=V
+"RTN","C0CMAIL",90,0)
  . . . . . D GATHER(DUZ,NAM,.LST)
-"RTN","C0CMAIL",83,0)
+"RTN","C0CMAIL",91,0)
  . . . . .QUIT
-"RTN","C0CMAIL",84,0)
+"RTN","C0CMAIL",92,0)
  . . . .QUIT
-"RTN","C0CMAIL",85,0)
+"RTN","C0CMAIL",93,0)
  . . . ;
-"RTN","C0CMAIL",86,0)
- . . . ;  If comma separated, look for mailboxes with new messages
-"RTN","C0CMAIL",87,0)
- . . . I $L(MBLST,",")>1 D  QUIT
-"RTN","C0CMAIL",88,0)
- . . . . S NAM=""
-"RTN","C0CMAIL",89,0)
- . . . . N T,V
-"RTN","C0CMAIL",90,0)
- . . . . F T=1:1:$L(MBLST,",")  S V=$P(MBLST,",",T)  I $L(V) D
-"RTN","C0CMAIL",91,0)
- . . . . . I V S NAM=$P($G(^XMB(3.7,DUZ,2,V,0)),U)
-"RTN","C0CMAIL",92,0)
- . . . . . S:NAM="" NAM=V
-"RTN","C0CMAIL",93,0)
- . . . . . D GATHER(DUZ,NAM,.LST)
 "RTN","C0CMAIL",94,0)
- . . . . .QUIT
+ . . . ;  If only 1 mailbox named, go get it
 "RTN","C0CMAIL",95,0)
- . . . .QUIT
+ . . . I $L(MBLST) D GATHER(DUZ,MBLST,.LST) QUIT
 "RTN","C0CMAIL",96,0)
- . . . ;
+ . . .QUIT
 "RTN","C0CMAIL",97,0)
- . . . ;  If only 1 mailbox named, go get it
+ . . MERGE C0CDATA=LST
 "RTN","C0CMAIL",98,0)
- . . . I $L(MBLST) D GATHER(DUZ,MBLST,.LST) QUIT
+ . .QUIT
 "RTN","C0CMAIL",99,0)
- . . .QUIT
+ .QUIT
 "RTN","C0CMAIL",100,0)
- . . MERGE C0CDATA=LST
+ QUIT
 "RTN","C0CMAIL",101,0)
+ ;  ===================
+"RTN","C0CMAIL",102,0)
+GATHER(DUZ,NAM,LST) ; Gather Data about the Baskets and their mail
+"RTN","C0CMAIL",103,0)
+ N I,J,K,L
+"RTN","C0CMAIL",104,0)
+ S (I,K)=0
+"RTN","C0CMAIL",105,0)
+ S J=$O(^XMB(3.7,DUZ,2,"B",NAM,""))
+"RTN","C0CMAIL",106,0)
+ F  S I=$O(^XMB(3.7,DUZ,2,J,1,I)) Q:'I  D
+"RTN","C0CMAIL",107,0)
+ . S L=$P(^XMB(3.7,DUZ,2,J,1,I,0),U,3)
+"RTN","C0CMAIL",108,0)
+ . D   ; :L
+"RTN","C0CMAIL",109,0)
+ . . S:L K=K+1,LST(NAM,"MSG",I,"NEW")=""  ; Flag NEW emails
+"RTN","C0CMAIL",110,0)
+ . . S LST(NAM,"MSG",I)=L
+"RTN","C0CMAIL",111,0)
+ . . D GETTYP(I)
+"RTN","C0CMAIL",112,0)
  . .QUIT
-"RTN","C0CMAIL",102,0)
+"RTN","C0CMAIL",113,0)
  .QUIT
-"RTN","C0CMAIL",103,0)
+"RTN","C0CMAIL",114,0)
+ S LST(NAM,"NUMBER")=K
+"RTN","C0CMAIL",115,0)
  QUIT
-"RTN","C0CMAIL",104,0)
+"RTN","C0CMAIL",116,0)
  ;  ===================
-"RTN","C0CMAIL",105,0)
-GATHER(DUZ,NAM,LST) ; Gather Data about the Baskets and their mail
-"RTN","C0CMAIL",106,0)
- N I,J,K,L
-"RTN","C0CMAIL",107,0)
- S (I,K)=0
-"RTN","C0CMAIL",108,0)
- S J=$O(^XMB(3.7,DUZ,2,"B",NAM,""))
-"RTN","C0CMAIL",109,0)
- F  S I=$O(^XMB(3.7,DUZ,2,J,1,I)) Q:'I  D
-"RTN","C0CMAIL",110,0)
- . S L=$P(^XMB(3.7,DUZ,2,J,1,I,0),U,3)
-"RTN","C0CMAIL",111,0)
- . D   ; :L
-"RTN","C0CMAIL",112,0)
- . . S:L K=K+1,LST(NAM,"MSG",I,"NEW")=""  ; Flag NEW emails
-"RTN","C0CMAIL",113,0)
- . . S LST(NAM,"MSG",I)=L
-"RTN","C0CMAIL",114,0)
- . . D GETTYP(I)
-"RTN","C0CMAIL",115,0)
- . .QUIT
-"RTN","C0CMAIL",116,0)
- .QUIT
 "RTN","C0CMAIL",117,0)
- S LST(NAM,"NUMBER")=K
+ ; D0 is the IEN into the Message Global ^XMB(3.9,D0)
 "RTN","C0CMAIL",118,0)
- QUIT
+ ; The products of these emails are scanned to identify
 "RTN","C0CMAIL",119,0)
- ;  ===================
+ ;  the number of documents stored in the MIME package.
 "RTN","C0CMAIL",120,0)
- ; D0 is the IEN into the Message Global ^XMB(3.9,D0)
+ ;  The protocol runs like this;
 "RTN","C0CMAIL",121,0)
- ; The products of these emails are scanned to identify
+ ; Line 1 is the --separator
 "RTN","C0CMAIL",122,0)
- ;  the number of documents stored in the MIME package.
+ ; Line 2 thru n >Look for Content-[detail type:]Description ; Next CMD
 "RTN","C0CMAIL",123,0)
- ;  The protocol runs like this;
+ ; Line n+2 thru t-1 where t does NOT have "Content-"
 "RTN","C0CMAIL",124,0)
- ; Line 1 is the --separator
+ ; Line t   is Next Section Terminator, or Message Terminator, --separator
 "RTN","C0CMAIL",125,0)
- ; Line 2 thru n >Look for Content-[detail type:]Description ; Next CMD
+ ; Line t+1 should not exist in the data set if Message Terminator
 "RTN","C0CMAIL",126,0)
- ; Line n+2 thru t-1 where t does NOT have "Content-"
+ ; CON = "Content-"
 "RTN","C0CMAIL",127,0)
- ; Line t   is Next Section Terminator, or Message Terminator, --separator
+ ; FLG = "--"
 "RTN","C0CMAIL",128,0)
- ; Line t+1 should not exist in the data set if Message Terminator
+ ; SEP = FLG+7 or more characters  ; Separator
 "RTN","C0CMAIL",129,0)
- ; CON = "Content-"
+ ; END = SEP+FLG
 "RTN","C0CMAIL",130,0)
- ; FLG = "--"
+ ; SGC = Segment Count
 "RTN","C0CMAIL",131,0)
- ; SEP = FLG+7 or more characters  ; Separator
+ ; Note: separator is a string of specific characters of
 "RTN","C0CMAIL",132,0)
- ; END = SEP+FLG
+ ;        indeterminate length  
 "RTN","C0CMAIL",133,0)
- ; SGC = Segment Count
+ ; LST() the transfer array
 "RTN","C0CMAIL",134,0)
- ; Note: separator is a string of specific characters of
+ ; LST(NAM,"MSG",C0CIEN,"SEG",SGN)=Starting Line^Ending Line
 "RTN","C0CMAIL",135,0)
- ;        indeterminate length  
+ ; LST(NAM,"MSG",C0CIEN,"SEG",SGN,1:n)=Decoded Message Data
 "RTN","C0CMAIL",136,0)
- ; LST() the transfer array
+ ;
 "RTN","C0CMAIL",137,0)
- ; LST(NAM,"MSG",C0CIEN,"SEG",SGN)=Starting Line^Ending Line
+GETTYP(D0) ; Look for the goodies in the Mail
 "RTN","C0CMAIL",138,0)
- ; LST(NAM,"MSG",C0CIEN,"SEG",SGN,1:n)=Decoded Message Data
+ N I,J,N,BCN,CON,CNT,D1,END,FLG,SEP,SGC,XX,XXNM
 "RTN","C0CMAIL",139,0)
- ;
+ S CON="Content-"
 "RTN","C0CMAIL",140,0)
-GETTYP(D0) ; Look for the goodies in the Mail
+ S FLG="--"
 "RTN","C0CMAIL",141,0)
- N I,J,N,BCN,CON,CNT,D1,END,FLG,SEP,SGC,XX,XXNM
+ S SEP=""  ; Start SEP as null, so we can use this to help identify the type
 "RTN","C0CMAIL",142,0)
- S CON="Content-"
+ S (BCN,CNT,D1,END,SGC)=0
 "RTN","C0CMAIL",143,0)
- S FLG="--"
+ S XX=$G(^XMB(3.9,D0,0))
 "RTN","C0CMAIL",144,0)
- S SEP=""  ; Start SEP as null, so we can use this to help identify the type
+ S LST(NAM,"MSG",D0,"TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
 "RTN","C0CMAIL",145,0)
- S (BCN,CNT,D1,END,SGC)=0
+ S LST(NAM,"MSG",D0,"CREATED")=$G(^XMB(3.9,D0,.6))
 "RTN","C0CMAIL",146,0)
- S XX=$G(^XMB(3.9,D0,0))
+ F I=4,2 S XXNM=$P(XX,U,I)  Q:$L(XXNM)
 "RTN","C0CMAIL",147,0)
- S LST(NAM,"MSG",D0,"TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
+ S LST(NAM,"MSG",D0,"FROM")=$$NAME(XXNM)
 "RTN","C0CMAIL",148,0)
- S LST(NAM,"MSG",D0,"CREATED")=$G(^XMB(3.9,D0,.6))
+ S LST(NAM,"MSG",D0,"SENT")=$$TIME($P(XX,U,3))
 "RTN","C0CMAIL",149,0)
- F I=4,2 S XXNM=$P(XX,U,I)  Q:$L(XXNM)
+ ; Get the folks the email is sent to.
 "RTN","C0CMAIL",150,0)
- S LST(NAM,"MSG",D0,"FROM")=$$NAME(XXNM)
+ S D1=0
 "RTN","C0CMAIL",151,0)
- S LST(NAM,"MSG",D0,"SENT")=$$TIME($P(XX,U,3))
+ F  S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1  D
 "RTN","C0CMAIL",152,0)
- ; Get the folks the email is sent to.
+ . N T
 "RTN","C0CMAIL",153,0)
- S D1=0
+ . S T=+$G(^XMB(3.9,D0,1,D1,0))
 "RTN","C0CMAIL",154,0)
- F  S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1  D
+ . S:T T=$P($G(^VA(200,+T,0)),"^")
 "RTN","C0CMAIL",155,0)
- . N T
+ . S LST("TO",D1)=T
 "RTN","C0CMAIL",156,0)
- . S T=+$G(^XMB(3.9,D0,1,D1,0))
+ . S T=$G(^XMB(3.9,D0,6,D1,0))
 "RTN","C0CMAIL",157,0)
  . S:T T=$P($G(^VA(200,+T,0)),"^")
 "RTN","C0CMAIL",158,0)
- . S LST("TO",D1)=T
+ . S:T="" T="<Unknown>"
 "RTN","C0CMAIL",159,0)
- . S T=$G(^XMB(3.9,D0,6,D1,0))
+ . S LST("TO NAME",D1)=T
 "RTN","C0CMAIL",160,0)
- . S:T T=$P($G(^VA(200,+T,0)),"^")
+ .QUIT
 "RTN","C0CMAIL",161,0)
+ ; Preload first Segment (0) with beginning on Line 1
+"RTN","C0CMAIL",162,0)
+ ;  if not a 64bit
+"RTN","C0CMAIL",163,0)
+ S LST(NAM,"MSG",D0,"SEG",0)=1
+"RTN","C0CMAIL",164,0)
+ S D1=.9999,SEP="--"
+"RTN","C0CMAIL",165,0)
+ F  S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1  D
+"RTN","C0CMAIL",166,0)
+ . ; Clear any control characters (cr/lf/ff) off
+"RTN","C0CMAIL",167,0)
+ . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
+"RTN","C0CMAIL",168,0)
+ . ; Enter once to set the SEP to capture the separator
+"RTN","C0CMAIL",169,0)
+ . I SEP=FLG&($E(X,1,2)=FLG)&($L(X,FLG)=2)&($L($P(X,FLG,2)>5))   D   Q
+"RTN","C0CMAIL",170,0)
+ . . S SEP=X,END=X_FLG
+"RTN","C0CMAIL",171,0)
+ . . S (CNT,SGC)=1,BCN=0
+"RTN","C0CMAIL",172,0)
+ . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
+"RTN","C0CMAIL",173,0)
+ . .QUIT
+"RTN","C0CMAIL",174,0)
+ . ;
+"RTN","C0CMAIL",175,0)
+ . ; A new separator is set, process original 
+"RTN","C0CMAIL",176,0)
+ . I X=SEP  D  QUIT
+"RTN","C0CMAIL",177,0)
+ . . S LST(NAM,"MSG",D0,SGC,"SIZE")=BCN
+"RTN","C0CMAIL",178,0)
+ . . S LST(NAM,"MSG",D0,"SEG",SGC)=$G(LST(NAM,"MSG",D0,"SEG",SGC))_"^"_(D1-1)
+"RTN","C0CMAIL",179,0)
+ . . S SGC=SGC+1,BCN=0
+"RTN","C0CMAIL",180,0)
+ . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
+"RTN","C0CMAIL",181,0)
+ . .QUIT
+"RTN","C0CMAIL",182,0)
+ . ;
+"RTN","C0CMAIL",183,0)
+ . S BCN=BCN+$L(X)
+"RTN","C0CMAIL",184,0)
+ . I X[CON D  Q
+"RTN","C0CMAIL",185,0)
+ . . S J=$P($P(X,";"),CON,2)
+"RTN","C0CMAIL",186,0)
+ . . S LST(NAM,"MSG",D0,"SEG",SGC,"CONT",CNT,$P(J,":"))=$P(J,":",2)
+"RTN","C0CMAIL",187,0)
+ . .QUIT
+"RTN","C0CMAIL",188,0)
+ . ;
+"RTN","C0CMAIL",189,0)
+ . ; S LST(NAM,"MSG",D0,"SEG",D1)=X
+"RTN","C0CMAIL",190,0)
+ .QUIT
+"RTN","C0CMAIL",191,0)
+ QUIT
+"RTN","C0CMAIL",192,0)
+ ;  ===================
+"RTN","C0CMAIL",193,0)
+NAME(NM) ; Return the name of the Sender
+"RTN","C0CMAIL",194,0)
+ N NAME
+"RTN","C0CMAIL",195,0)
+ S NAME="<Unknown Sender>"
+"RTN","C0CMAIL",196,0)
+ D
+"RTN","C0CMAIL",197,0)
+ . ; Look first for a value to use with the NEW PERSON file
+"RTN","C0CMAIL",198,0)
+ . ;
+"RTN","C0CMAIL",199,0)
+ . I NM=+NM S NAME=$P(^VA(200,NM,0),U,1) Q
+"RTN","C0CMAIL",200,0)
+ . ;
+"RTN","C0CMAIL",201,0)
+ . I $L(NM) S NAME=NM                    Q
+"RTN","C0CMAIL",202,0)
+ . ;
+"RTN","C0CMAIL",203,0)
+ . ; Else, pull the data from the message and display the foreign source
+"RTN","C0CMAIL",204,0)
+ . ;   of the message.
+"RTN","C0CMAIL",205,0)
+ . N T
+"RTN","C0CMAIL",206,0)
+ . S VAL=$G(^XMB(3.9,D0,.7))
+"RTN","C0CMAIL",207,0)
+ . S:VAL T=$P(^VA(200,VAL,0),U)
+"RTN","C0CMAIL",208,0)
+ . I $L($G(T)) S NAME=T                  Q
+"RTN","C0CMAIL",209,0)
+ . ;
+"RTN","C0CMAIL",210,0)
+ .QUIT
+"RTN","C0CMAIL",211,0)
+ QUIT NAME
+"RTN","C0CMAIL",212,0)
+ ;  ===================
+"RTN","C0CMAIL",213,0)
+TIME(Y) ; The time and date of the sending
+"RTN","C0CMAIL",214,0)
+ X ^DD("DD")
+"RTN","C0CMAIL",215,0)
+ QUIT Y
+"RTN","C0CMAIL",216,0)
+ ;  ===================
+"RTN","C0CMAIL",217,0)
+ ;  Segments in Message need to be identified and decoded properly
+"RTN","C0CMAIL",218,0)
+ ; D DETAIL^C0CMAIL(.ARRAY,D0) ;  Call One for each message
+"RTN","C0CMAIL",219,0)
+ ;   ARRAY will have the details of this one call
+"RTN","C0CMAIL",220,0)
+ ;    
+"RTN","C0CMAIL",221,0)
+ ; Inputs;
+"RTN","C0CMAIL",222,0)
+ ;   C0CINPUT    - The IEN of the message to expand
+"RTN","C0CMAIL",223,0)
+ ; Outputs;
+"RTN","C0CMAIL",224,0)
+ ;   C0CDATA     - Carrier for the returned structure of the Message
+"RTN","C0CMAIL",225,0)
+ ;  C0CDATA(D0,"SEG")=number of SEGMENTS
+"RTN","C0CMAIL",226,0)
+ ;  C0CDATA(D0,"SEG",0:n)=SEGMENT n details
+"RTN","C0CMAIL",227,0)
+ ;  C0CDATA(D0,"SEG",0:n,"CONTENT",type)=Content details
+"RTN","C0CMAIL",228,0)
+ ;  C0CDATA(D0,"SEG",0:n,"MSG",D3)=Content details
+"RTN","C0CMAIL",229,0)
+ ;  C0CDATA(D0,"SEG",0:n,"HTML",D3)=Content details
+"RTN","C0CMAIL",230,0)
+ ;
+"RTN","C0CMAIL",231,0)
+DETAIL(C0CDATA,C0CINPUT) ; Message Detail Delivery
+"RTN","C0CMAIL",232,0)
+ N LST,D0,D1,U
+"RTN","C0CMAIL",233,0)
+ S U="^"
+"RTN","C0CMAIL",234,0)
+ S D0=+$G(C0CINPUT)
+"RTN","C0CMAIL",235,0)
+ I D0   D    QUIT
+"RTN","C0CMAIL",236,0)
+ . D GETTYP2(D0)
+"RTN","C0CMAIL",237,0)
+ . I $D(LST)   M C0CDATA(D0)=LST
+"RTN","C0CMAIL",238,0)
+ .QUIT
+"RTN","C0CMAIL",239,0)
+ QUIT
+"RTN","C0CMAIL",240,0)
+ ;  ===================
+"RTN","C0CMAIL",241,0)
+ ;  End note if needed
+"RTN","C0CMAIL",242,0)
+ ; MSK   - Set of characters that do not exist in 64 bit encoding
+"RTN","C0CMAIL",243,0)
+GETTYP2(D0) ; Try to get the types and MSK for the 
+"RTN","C0CMAIL",244,0)
+ N I,J,K,N,BCN,BF,CON,CNT,D1,END,FLG,MSK,SEP,SGC,U,XX,ZN,XXNM
+"RTN","C0CMAIL",245,0)
+ S CON="Content-",U="^"
+"RTN","C0CMAIL",246,0)
+ S FLG="--"
+"RTN","C0CMAIL",247,0)
+ S MSK=" !""#$%&'()*,-.:;<>?@[\]^_`{|}~"
+"RTN","C0CMAIL",248,0)
+ S (BF,SEP)=""  ; Start SEP as null, so we can use this to help identify the type
+"RTN","C0CMAIL",249,0)
+ S (BCN,CNT,D1,END,SGC)=0
+"RTN","C0CMAIL",250,0)
+ S XX=$G(^XMB(3.9,D0,0))
+"RTN","C0CMAIL",251,0)
+ ; S K=$P(^XMB(3.9,D0,2,0),U,3)
+"RTN","C0CMAIL",252,0)
+ S LST("TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
+"RTN","C0CMAIL",253,0)
+ S LST("CREATED")=$$TIME($P(XX,U,3))
+"RTN","C0CMAIL",254,0)
+ F I=4,2 S XXNM=$P(XX,U,I)  Q:$L(XXNM)
+"RTN","C0CMAIL",255,0)
+ S LST("FROM")=$$NAME(XXNM)
+"RTN","C0CMAIL",256,0)
+ ; Get the folks the email is sent to.
+"RTN","C0CMAIL",257,0)
+ S D1=0
+"RTN","C0CMAIL",258,0)
+ F  S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1  D   Q:D1=""
+"RTN","C0CMAIL",259,0)
+ . N I,T
+"RTN","C0CMAIL",260,0)
+ . S T=$P($G(^XMB(3.9,D0,1,D1,0)),U)
+"RTN","C0CMAIL",261,0)
+ . S:T T=$P($G(^VA(200,T,0)),"^")
+"RTN","C0CMAIL",262,0)
+ . S LST("TO",+D1)=T
+"RTN","C0CMAIL",263,0)
+ . S T=$G(^XMB(3.9,D0,6,+D1,0))
+"RTN","C0CMAIL",264,0)
+ . S:T="" T=$P($G(^VA(200,+T,0)),"^")
+"RTN","C0CMAIL",265,0)
  . S:T="" T="<Unknown>"
-"RTN","C0CMAIL",162,0)
+"RTN","C0CMAIL",266,0)
  . S LST("TO NAME",D1)=T
-"RTN","C0CMAIL",163,0)
+"RTN","C0CMAIL",267,0)
  .QUIT
-"RTN","C0CMAIL",164,0)
- ; Preload first Segment (0) with beginning on Line 1
-"RTN","C0CMAIL",165,0)
- ;  if not a 64bit
-"RTN","C0CMAIL",166,0)
- S LST(NAM,"MSG",D0,"SEG",0)=1
-"RTN","C0CMAIL",167,0)
- S D1=.9999,SEP="--"
-"RTN","C0CMAIL",168,0)
+"RTN","C0CMAIL",268,0)
+ ; Get the Header for the message
+"RTN","C0CMAIL",269,0)
+ S D1=0
+"RTN","C0CMAIL",270,0)
+ F I=1:1 S D1=$O(^XMB(3.9,D0,2,D1)) Q:D1=""  Q:(D1>.99999)   D
+"RTN","C0CMAIL",271,0)
+ . S LST("HDR",I)=$G(^XMB(3.9,D0,2,D1,0))
+"RTN","C0CMAIL",272,0)
+ .QUIT
+"RTN","C0CMAIL",273,0)
+ ; Start walking the different sections
+"RTN","C0CMAIL",274,0)
+ S D1=.99999,SEP="--"
+"RTN","C0CMAIL",275,0)
  F  S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1  D
-"RTN","C0CMAIL",169,0)
+"RTN","C0CMAIL",276,0)
  . ; Clear any control characters (cr/lf/ff) off
-"RTN","C0CMAIL",170,0)
+"RTN","C0CMAIL",277,0)
  . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
-"RTN","C0CMAIL",171,0)
+"RTN","C0CMAIL",278,0)
  . ; Enter once to set the SEP to capture the separator
-"RTN","C0CMAIL",172,0)
- . I SEP=FLG&($E(X,1,2)=FLG)&($L(X,FLG)=2)&($L($P(X,FLG,2)>5))   D   Q
-"RTN","C0CMAIL",173,0)
+"RTN","C0CMAIL",279,0)
+ . I (SEP="--")&($E(X,1,2)=FLG)&($L(X,FLG)=2)  D   Q
+"RTN","C0CMAIL",280,0)
  . . S SEP=X,END=X_FLG
-"RTN","C0CMAIL",174,0)
+"RTN","C0CMAIL",281,0)
  . . S (CNT,SGC)=1,BCN=0
-"RTN","C0CMAIL",175,0)
- . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
-"RTN","C0CMAIL",176,0)
+"RTN","C0CMAIL",282,0)
+ . . S LST("SEG",SGC)=D1
+"RTN","C0CMAIL",283,0)
  . .QUIT
-"RTN","C0CMAIL",177,0)
+"RTN","C0CMAIL",284,0)
  . ;
-"RTN","C0CMAIL",178,0)
- . ; A new separator is set, process original 
-"RTN","C0CMAIL",179,0)
+"RTN","C0CMAIL",285,0)
+ . ; A new SEGMENT separator is set, process original 
+"RTN","C0CMAIL",286,0)
  . I X=SEP  D  QUIT
-"RTN","C0CMAIL",180,0)
- . . S LST(NAM,"MSG",D0,SGC,"SIZE")=BCN
-"RTN","C0CMAIL",181,0)
- . . S LST(NAM,"MSG",D0,"SEG",SGC)=$G(LST(NAM,"MSG",D0,"SEG",SGC))_"^"_(D1-1)
-"RTN","C0CMAIL",182,0)
+"RTN","C0CMAIL",287,0)
+ . . ; Save Current Values
+"RTN","C0CMAIL",288,0)
+ . . S LST("SEG",SGC,"SIZE")=BCN
+"RTN","C0CMAIL",289,0)
+ . . ;  Close this Segment and prepare to start a New Segment
+"RTN","C0CMAIL",290,0)
+ . . S LST("SEG",SGC)=$G(LST("SEG",SGC))_"^"_(D1-1)
+"RTN","C0CMAIL",291,0)
+ . . ;  Put the result in LST("SEG",SGC,"XML")
+"RTN","C0CMAIL",292,0)
+ . . I $L(BF) D
+"RTN","C0CMAIL",293,0)
+ . . . S ZN=1
+"RTN","C0CMAIL",294,0)
+ . . . N I,T,TBF
+"RTN","C0CMAIL",295,0)
+ . . . S TBF=BF
+"RTN","C0CMAIL",296,0)
+ . . . F I=1:1:($L(TBF,"="))  D
+"RTN","C0CMAIL",297,0)
+ . . . . S BF=$P(TBF,"=",I)_"="
+"RTN","C0CMAIL",298,0)
+ . . . . I BF'="="  D DECODER
+"RTN","C0CMAIL",299,0)
+ . . . .QUIT
+"RTN","C0CMAIL",300,0)
+ . . . S BF=""
+"RTN","C0CMAIL",301,0)
+ . . .QUIT
+"RTN","C0CMAIL",302,0)
  . . S SGC=SGC+1,BCN=0
-"RTN","C0CMAIL",183,0)
- . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
-"RTN","C0CMAIL",184,0)
+"RTN","C0CMAIL",303,0)
+ . . ; Incriment SGC to start a new Segment
+"RTN","C0CMAIL",304,0)
+ . . S LST("SEG",SGC)=D1
+"RTN","C0CMAIL",305,0)
  . .QUIT
-"RTN","C0CMAIL",185,0)
+"RTN","C0CMAIL",306,0)
  . ;
-"RTN","C0CMAIL",186,0)
+"RTN","C0CMAIL",307,0)
+ . ; Accumulate the 64 bit encoding
+"RTN","C0CMAIL",308,0)
+ . I X=$TR(X,MSK)&$L(X) D   Q
+"RTN","C0CMAIL",309,0)
+ . . S BF=BF_X
+"RTN","C0CMAIL",310,0)
+ . . S BCN=BCN+$L(X)
+"RTN","C0CMAIL",311,0)
+ . .QUIT 
+"RTN","C0CMAIL",312,0)
+ . ;
+"RTN","C0CMAIL",313,0)
+ . ; Ending Condition, close out the Segment
+"RTN","C0CMAIL",314,0)
+ . I X=END D  QUIT
+"RTN","C0CMAIL",315,0)
+ . . S LST("SEG",SGC)=$G(LST("SEG",SGC))_"^"_(D1-1)
+"RTN","C0CMAIL",316,0)
+ . . I $L(BF) S ZN=1 D DECODER  S BF="" Q
+"RTN","C0CMAIL",317,0)
+ . .QUIT
+"RTN","C0CMAIL",318,0)
+ . ;
+"RTN","C0CMAIL",319,0)
  . S BCN=BCN+$L(X)
-"RTN","C0CMAIL",187,0)
+"RTN","C0CMAIL",320,0)
+ . ; Split out the Content Info
+"RTN","C0CMAIL",321,0)
  . I X[CON D  Q
-"RTN","C0CMAIL",188,0)
- . . S J=$P($P(X,";"),CON,2)
-"RTN","C0CMAIL",189,0)
- . . S LST(NAM,"MSG",D0,"SEG",SGC,"CONT",CNT,$P(J,":"))=$P(J,":",2)
-"RTN","C0CMAIL",190,0)
+"RTN","C0CMAIL",322,0)
+ . . S J=$P(X,CON,2)
+"RTN","C0CMAIL",323,0)
+ . . S LST("SEG",SGC,"CONTENT",$P(J,":"))=$P(J,":",2,9)
+"RTN","C0CMAIL",324,0)
  . .QUIT
-"RTN","C0CMAIL",191,0)
+"RTN","C0CMAIL",325,0)
  . ;
-"RTN","C0CMAIL",192,0)
- . ; S LST(NAM,"MSG",D0,"SEG",D1)=X
-"RTN","C0CMAIL",193,0)
+"RTN","C0CMAIL",326,0)
+ . ; Everything else is Text
+"RTN","C0CMAIL",327,0)
+ . S LST("SEG",SGC,"TXT",D1)=X
+"RTN","C0CMAIL",328,0)
  .QUIT
-"RTN","C0CMAIL",194,0)
+"RTN","C0CMAIL",329,0)
  QUIT
-"RTN","C0CMAIL",195,0)
+"RTN","C0CMAIL",330,0)
  ;  ===================
-"RTN","C0CMAIL",196,0)
-NAME(NM) ; Return the name of the Sender
-"RTN","C0CMAIL",197,0)
- N NAME
-"RTN","C0CMAIL",198,0)
- S NAME="<Unknown Sender>"
-"RTN","C0CMAIL",199,0)
- D
-"RTN","C0CMAIL",200,0)
- . ; Look first for a value to use with the NEW PERSON file
-"RTN","C0CMAIL",201,0)
- . ;
-"RTN","C0CMAIL",202,0)
- . I NM=+NM S NAME=$P(^VA(200,NM,0),U,1) Q
-"RTN","C0CMAIL",203,0)
- . ;
-"RTN","C0CMAIL",204,0)
- . I $L(NM) S NAME=NM                    Q
-"RTN","C0CMAIL",205,0)
- . ;
-"RTN","C0CMAIL",206,0)
- . ; Else, pull the data from the message and display the foreign source
-"RTN","C0CMAIL",207,0)
- . ;   of the message.
-"RTN","C0CMAIL",208,0)
- . N T
-"RTN","C0CMAIL",209,0)
- . S VAL=$G(^XMB(3.9,D0,.7))
-"RTN","C0CMAIL",210,0)
- . S:VAL T=$P(^VA(200,VAL,0),U)
-"RTN","C0CMAIL",211,0)
- . I $L($G(T)) S NAME=T                  Q
-"RTN","C0CMAIL",212,0)
- . ;
-"RTN","C0CMAIL",213,0)
+"RTN","C0CMAIL",331,0)
+ ; Break down the Buffer Array so it can be saved.
+"RTN","C0CMAIL",332,0)
+ ;  BF is passed in.
+"RTN","C0CMAIL",333,0)
+DECODER ; 
+"RTN","C0CMAIL",334,0)
+ N RCNT,TBF,ZBF,ZI,ZJ,ZK,ZSIZE
+"RTN","C0CMAIL",335,0)
+ S ZBF=BF
+"RTN","C0CMAIL",336,0)
+ ;  Full Buffer, BF, now check for Encryption and Unpack
+"RTN","C0CMAIL",337,0)
+ F RCNT=1:1:$L(ZBF,"=")   D
+"RTN","C0CMAIL",338,0)
+ . N BF
+"RTN","C0CMAIL",339,0)
+ . S BF=$P(ZBF,"=",RCNT)
+"RTN","C0CMAIL",340,0)
+ . ;  Unpacking the 64 bit encoding
+"RTN","C0CMAIL",341,0)
+ . S TBF=$TR($$DECODE^RGUTUU(BF),$C(10,12,13))
+"RTN","C0CMAIL",342,0)
+ . D:$L(TBF)
+"RTN","C0CMAIL",343,0)
+ . . N XBF
+"RTN","C0CMAIL",344,0)
+ . . S BF=BF_"="
+"RTN","C0CMAIL",345,0)
+ . . D NORMAL(.XBF,.TBF)
+"RTN","C0CMAIL",346,0)
+ . . M LST("SEG",SGC,"XML",RCNT)=XBF
+"RTN","C0CMAIL",347,0)
+ . .QUIT
+"RTN","C0CMAIL",348,0)
  .QUIT
-"RTN","C0CMAIL",214,0)
- QUIT NAME
-"RTN","C0CMAIL",215,0)
+"RTN","C0CMAIL",349,0)
+ QUIT
+"RTN","C0CMAIL",350,0)
  ;  ===================
-"RTN","C0CMAIL",216,0)
-TIME(Y) ; The time and date of the sending
-"RTN","C0CMAIL",217,0)
- X ^DD("DD")
-"RTN","C0CMAIL",218,0)
- QUIT Y
-"RTN","C0CMAIL",219,0)
+"RTN","C0CMAIL",351,0)
+ ;  OUTXML = OUTBF  = OUT   = OUTPUT ARRAY TO BE BUILT
+"RTN","C0CMAIL",352,0)
+ ;  BF     = INXML = INPUT ARRAY TO PROVIDE INPUT
+"RTN","C0CMAIL",353,0)
+ ;   >D NORMAL^C0CMAIL(.OUT,BF)
+"RTN","C0CMAIL",354,0)
+NORMAL(OUTXML,INXML)    ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
+"RTN","C0CMAIL",355,0)
+ ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
+"RTN","C0CMAIL",356,0)
+ ;
+"RTN","C0CMAIL",357,0)
+ N ZN,OUTBF
+"RTN","C0CMAIL",358,0)
+ S ZN=1
+"RTN","C0CMAIL",359,0)
+ S OUTBF(ZN)=$P(INXML,"><",ZN)_">"
+"RTN","C0CMAIL",360,0)
+ F ZN=ZN+1:1 S OUTBF(ZN)="<"_$P(INXML,"><",ZN) Q:$P(INXML,"><",ZN+1)=""  D  ;
+"RTN","C0CMAIL",361,0)
+ . S OUTBF(ZN)=OUTBF(ZN)_">"
+"RTN","C0CMAIL",362,0)
+ .QUIT
+"RTN","C0CMAIL",363,0)
+ M OUTXML=OUTBF
+"RTN","C0CMAIL",364,0)
+ QUIT
+"RTN","C0CMAIL",365,0)
  ;  ===================
-"RTN","C0CMAIL",220,0)
- ;  Segments in Message need to be identified and decoded properly
-"RTN","C0CMAIL",221,0)
- ; D DETAIL^C0CMAIL(.ARRAY,D0) ;  Call One for each message
-"RTN","C0CMAIL",222,0)
- ;   ARRAY will have the details of this one call
-"RTN","C0CMAIL",223,0)
- ;    
-"RTN","C0CMAIL",224,0)
- ; Inputs;
-"RTN","C0CMAIL",225,0)
- ;   C0CINPUT    - The IEN of the message to expand
-"RTN","C0CMAIL",226,0)
- ; Outputs;
-"RTN","C0CMAIL",227,0)
- ;   C0CDATA     - Carrier for the returned structure of the Message
-"RTN","C0CMAIL",228,0)
- ;  C0CDATA(D0,"SEG")=number of SEGMENTS
-"RTN","C0CMAIL",229,0)
- ;  C0CDATA(D0,"SEG",0:n)=SEGMENT n details
-"RTN","C0CMAIL",230,0)
- ;  C0CDATA(D0,"SEG",0:n,"CONTENT",type)=Content details
-"RTN","C0CMAIL",231,0)
- ;  C0CDATA(D0,"SEG",0:n,"MSG",D3)=Content details
-"RTN","C0CMAIL",232,0)
- ;  C0CDATA(D0,"SEG",0:n,"HTML",D3)=Content details
-"RTN","C0CMAIL",233,0)
- ;
-"RTN","C0CMAIL",234,0)
-DETAIL(C0CDATA,C0CINPUT) ; Message Detail Delivery
-"RTN","C0CMAIL",235,0)
- N LST,D0,D1,U
-"RTN","C0CMAIL",236,0)
- S U="^"
-"RTN","C0CMAIL",237,0)
- S D0=+$G(C0CINPUT)
-"RTN","C0CMAIL",238,0)
- I D0   D    QUIT
-"RTN","C0CMAIL",239,0)
- . D GETTYP2(D0)
-"RTN","C0CMAIL",240,0)
- . I $D(LST)   M C0CDATA(D0)=LST
-"RTN","C0CMAIL",241,0)
- .QUIT
-"RTN","C0CMAIL",242,0)
+"RTN","C0CMAIL",366,0)
+ ;  vvvvvvvvvvvvvvv  Not Needed  vvvvvvvvvvvvvvvvvvvvvvvvvv
+"RTN","C0CMAIL",367,0)
+ ;  End note if needed
+"RTN","C0CMAIL",368,0)
  QUIT
-"RTN","C0CMAIL",243,0)
- ;  ===================
-"RTN","C0CMAIL",244,0)
- ;  End note if needed
-"RTN","C0CMAIL",245,0)
- ; MSK   - Set of characters that do not exist in 64 bit encoding
-"RTN","C0CMAIL",246,0)
-GETTYP2(D0) ; Try to get the types and MSK for the 
-"RTN","C0CMAIL",247,0)
- N I,J,K,N,BCN,BF,CON,CNT,D1,END,FLG,MSK,SEP,SGC,U,XX,ZN,XXNM
-"RTN","C0CMAIL",248,0)
- S CON="Content-",U="^"
-"RTN","C0CMAIL",249,0)
- S FLG="--"
-"RTN","C0CMAIL",250,0)
- S MSK=" !""#$%&'()*,-.:;<>?@[\]^_`{|}~"
-"RTN","C0CMAIL",251,0)
- S (BF,SEP)=""  ; Start SEP as null, so we can use this to help identify the type
-"RTN","C0CMAIL",252,0)
- S (BCN,CNT,D1,END,SGC)=0
-"RTN","C0CMAIL",253,0)
- S XX=$G(^XMB(3.9,D0,0))
-"RTN","C0CMAIL",254,0)
- ; S K=$P(^XMB(3.9,D0,2,0),U,3)
-"RTN","C0CMAIL",255,0)
- S LST("TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
-"RTN","C0CMAIL",256,0)
- S LST("CREATED")=$$TIME($P(XX,U,3))
-"RTN","C0CMAIL",257,0)
- F I=4,2 S XXNM=$P(XX,U,I)  Q:$L(XXNM)
-"RTN","C0CMAIL",258,0)
- S LST("FROM")=$$NAME(XXNM)
-"RTN","C0CMAIL",259,0)
- ; Get the folks the email is sent to.
-"RTN","C0CMAIL",260,0)
- S D1=0
-"RTN","C0CMAIL",261,0)
- F  S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1  D   Q:D1=""
-"RTN","C0CMAIL",262,0)
- . N I,T
-"RTN","C0CMAIL",263,0)
- . S T=$P($G(^XMB(3.9,D0,1,D1,0)),U)
-"RTN","C0CMAIL",264,0)
- . S:T T=$P($G(^VA(200,T,0)),"^")
-"RTN","C0CMAIL",265,0)
- . S LST("TO",+D1)=T
-"RTN","C0CMAIL",266,0)
- . S T=$G(^XMB(3.9,D0,6,+D1,0))
-"RTN","C0CMAIL",267,0)
- . S:T="" T=$P($G(^VA(200,+T,0)),"^")
-"RTN","C0CMAIL",268,0)
- . S:T="" T="<Unknown>"
-"RTN","C0CMAIL",269,0)
- . S LST("TO NAME",D1)=T
-"RTN","C0CMAIL",270,0)
- .QUIT
-"RTN","C0CMAIL",271,0)
- ; Get the Header for the message
-"RTN","C0CMAIL",272,0)
- S D1=0
-"RTN","C0CMAIL",273,0)
- F I=1:1 S D1=$O(^XMB(3.9,D0,2,D1)) Q:D1=""  Q:(D1>.99999)   D
-"RTN","C0CMAIL",274,0)
- . S LST("HDR",I)=$G(^XMB(3.9,D0,2,D1,0))
-"RTN","C0CMAIL",275,0)
- .QUIT
-"RTN","C0CMAIL",276,0)
- ; Start walking the different sections
-"RTN","C0CMAIL",277,0)
- S D1=.99999,SEP="--"
-"RTN","C0CMAIL",278,0)
- F  S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1  D
-"RTN","C0CMAIL",279,0)
- . ; Clear any control characters (cr/lf/ff) off
-"RTN","C0CMAIL",280,0)
- . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
-"RTN","C0CMAIL",281,0)
- . ; Enter once to set the SEP to capture the separator
-"RTN","C0CMAIL",282,0)
- . I (SEP="--")&($E(X,1,2)=FLG)&($L(X,FLG)=2)  D   Q
-"RTN","C0CMAIL",283,0)
- . . S SEP=X,END=X_FLG
-"RTN","C0CMAIL",284,0)
- . . S (CNT,SGC)=1,BCN=0
-"RTN","C0CMAIL",285,0)
- . . S LST("SEG",SGC)=D1
-"RTN","C0CMAIL",286,0)
- . .QUIT
-"RTN","C0CMAIL",287,0)
- . ;
-"RTN","C0CMAIL",288,0)
- . ; A new SEGMENT separator is set, process original 
-"RTN","C0CMAIL",289,0)
- . I X=SEP  D  QUIT
-"RTN","C0CMAIL",290,0)
- . . ; Save Current Values
-"RTN","C0CMAIL",291,0)
- . . S LST("SEG",SGC,"SIZE")=BCN
-"RTN","C0CMAIL",292,0)
- . . ;  Close this Segment and prepare to start a New Segment
-"RTN","C0CMAIL",293,0)
- . . S LST("SEG",SGC)=$G(LST("SEG",SGC))_"^"_(D1-1)
-"RTN","C0CMAIL",294,0)
- . . ;  Put the result in LST("SEG",SGC,"XML")
-"RTN","C0CMAIL",295,0)
- . . I $L(BF) D
-"RTN","C0CMAIL",296,0)
- . . . S ZN=1
-"RTN","C0CMAIL",297,0)
- . . . N I,T,TBF
-"RTN","C0CMAIL",298,0)
- . . . S TBF=BF
-"RTN","C0CMAIL",299,0)
- . . . F I=1:1:($L(TBF,"="))  D
-"RTN","C0CMAIL",300,0)
- . . . . S BF=$P(TBF,"=",I)_"="
-"RTN","C0CMAIL",301,0)
- . . . . I BF'="="  D DECODER
-"RTN","C0CMAIL",302,0)
- . . . .QUIT
-"RTN","C0CMAIL",303,0)
- . . . S BF=""
-"RTN","C0CMAIL",304,0)
- . . .QUIT
-"RTN","C0CMAIL",305,0)
- . . S SGC=SGC+1,BCN=0
-"RTN","C0CMAIL",306,0)
- . . ; Incriment SGC to start a new Segment
-"RTN","C0CMAIL",307,0)
- . . S LST("SEG",SGC)=D1
-"RTN","C0CMAIL",308,0)
- . .QUIT
-"RTN","C0CMAIL",309,0)
- . ;
-"RTN","C0CMAIL",310,0)
- . ; Accumulate the 64 bit encoding
-"RTN","C0CMAIL",311,0)
- . I X=$TR(X,MSK)&$L(X) D   Q
-"RTN","C0CMAIL",312,0)
- . . S BF=BF_X
-"RTN","C0CMAIL",313,0)
- . . S BCN=BCN+$L(X)
-"RTN","C0CMAIL",314,0)
- . .QUIT 
-"RTN","C0CMAIL",315,0)
- . ;
-"RTN","C0CMAIL",316,0)
- . ; Ending Condition, close out the Segment
-"RTN","C0CMAIL",317,0)
- . I X=END D  QUIT
-"RTN","C0CMAIL",318,0)
- . . S LST("SEG",SGC)=$G(LST("SEG",SGC))_"^"_(D1-1)
-"RTN","C0CMAIL",319,0)
- . . I $L(BF) S ZN=1 D DECODER  S BF="" Q
-"RTN","C0CMAIL",320,0)
- . .QUIT
-"RTN","C0CMAIL",321,0)
- . ;
-"RTN","C0CMAIL",322,0)
- . S BCN=BCN+$L(X)
-"RTN","C0CMAIL",323,0)
- . ; Split out the Content Info
-"RTN","C0CMAIL",324,0)
- . I X[CON D  Q
-"RTN","C0CMAIL",325,0)
- . . S J=$P(X,CON,2)
-"RTN","C0CMAIL",326,0)
- . . S LST("SEG",SGC,"CONTENT",$P(J,":"))=$P(J,":",2,9)
-"RTN","C0CMAIL",327,0)
- . .QUIT
-"RTN","C0CMAIL",328,0)
- . ;
-"RTN","C0CMAIL",329,0)
- . ; Everything else is Text
-"RTN","C0CMAIL",330,0)
- . S LST("SEG",SGC,"TXT",D1)=X
-"RTN","C0CMAIL",331,0)
- .QUIT
-"RTN","C0CMAIL",332,0)
- QUIT
-"RTN","C0CMAIL",333,0)
- ;  ===================
-"RTN","C0CMAIL",334,0)
- ; Break down the Buffer Array so it can be saved.
-"RTN","C0CMAIL",335,0)
- ;  BF is passed in.
-"RTN","C0CMAIL",336,0)
-DECODER ; 
-"RTN","C0CMAIL",337,0)
- N RCNT,TBF,ZBF,ZI,ZJ,ZK,ZSIZE
-"RTN","C0CMAIL",338,0)
- S ZBF=BF
-"RTN","C0CMAIL",339,0)
- ;  Full Buffer, BF, now check for Encryption and Unpack
-"RTN","C0CMAIL",340,0)
- F RCNT=1:1:$L(ZBF,"=")   D
-"RTN","C0CMAIL",341,0)
- . N BF
-"RTN","C0CMAIL",342,0)
- . S BF=$P(ZBF,"=",RCNT)
-"RTN","C0CMAIL",343,0)
- . ;  Unpacking the 64 bit encoding
-"RTN","C0CMAIL",344,0)
- . S TBF=$TR($$DECODE^RGUTUU(BF),$C(10,12,13))
-"RTN","C0CMAIL",345,0)
- . D:$L(TBF)
-"RTN","C0CMAIL",346,0)
- . . N XBF
-"RTN","C0CMAIL",347,0)
- . . S BF=BF_"="
-"RTN","C0CMAIL",348,0)
- . . D NORMAL(.XBF,.TBF)
-"RTN","C0CMAIL",349,0)
- . . M LST("SEG",SGC,"XML",RCNT)=XBF
-"RTN","C0CMAIL",350,0)
- . .QUIT
-"RTN","C0CMAIL",351,0)
- .QUIT
-"RTN","C0CMAIL",352,0)
- QUIT
-"RTN","C0CMAIL",353,0)
- ;  ===================
-"RTN","C0CMAIL",354,0)
- ;  OUTXML = OUTBF  = OUT   = OUTPUT ARRAY TO BE BUILT
-"RTN","C0CMAIL",355,0)
- ;  BF     = INXML = INPUT ARRAY TO PROVIDE INPUT
-"RTN","C0CMAIL",356,0)
- ;   >D NORMAL^C0CMAIL(.OUT,BF)
-"RTN","C0CMAIL",357,0)
-NORMAL(OUTXML,INXML)    ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
-"RTN","C0CMAIL",358,0)
- ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
-"RTN","C0CMAIL",359,0)
- ;
-"RTN","C0CMAIL",360,0)
- N ZN,OUTBF
-"RTN","C0CMAIL",361,0)
- S ZN=1
-"RTN","C0CMAIL",362,0)
- S OUTBF(ZN)=$P(INXML,"><",ZN)_">"
-"RTN","C0CMAIL",363,0)
- F ZN=ZN+1:1 S OUTBF(ZN)="<"_$P(INXML,"><",ZN) Q:$P(INXML,"><",ZN+1)=""  D  ;
-"RTN","C0CMAIL",364,0)
- . S OUTBF(ZN)=OUTBF(ZN)_">"
-"RTN","C0CMAIL",365,0)
- .QUIT
-"RTN","C0CMAIL",366,0)
- M OUTXML=OUTBF
-"RTN","C0CMAIL",367,0)
- QUIT
-"RTN","C0CMAIL",368,0)
- ;  ===================
 "RTN","C0CMAIL",369,0)
- ;  vvvvvvvvvvvvvvv  Not Needed  vvvvvvvvvvvvvvvvvvvvvvvvvv
-"RTN","C0CMAIL",370,0)
- ;  End note if needed
-"RTN","C0CMAIL",371,0)
- QUIT
-"RTN","C0CMAIL",372,0)
  ;  ===================
 "RTN","C0CMAIL2")
-0^82^B166788518
+0^82^B165067910
 "RTN","C0CMAIL2",1,0)
 C0CMAIL2 ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr  ; 5/10/12 2:50pm
 "RTN","C0CMAIL2",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CMAIL2",3,0)
  ;Copyright 2011 Chris Richardson, Richardson Computer Research
@@ -104056,927 +104086,921 @@
  ;   rcr@rcresearch.us
 "RTN","C0CMAIL2",6,0)
- ;  Licensed under the terms of the GNU
+ ;
 "RTN","C0CMAIL2",7,0)
- ;General Public License See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CMAIL2",8,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CMAIL2",9,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CMAIL2",10,0)
- ;it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CMAIL2",11,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CMAIL2",12,0)
- ;(at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CMAIL2",13,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CMAIL2",14,0)
- ;This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CMAIL2",15,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CMAIL2",16,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CMAIL2",17,0)
- ;GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CMAIL2",18,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CMAIL2",19,0)
- ;You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CMAIL2",20,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;  ------------------
 "RTN","C0CMAIL2",21,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;Entry Points
 "RTN","C0CMAIL2",22,0)
- ;
+ ; DETAIL^C0CMAIL(.C0CDATA,IEN) --> Get details of the Mail Message and Attachments
 "RTN","C0CMAIL2",23,0)
- ;  ------------------
+ ; GETMSG^C0CMAIL(.C0CDATA,.C0CINPUT)
 "RTN","C0CMAIL2",24,0)
- ;Entry Points
+ ;  Input:
 "RTN","C0CMAIL2",25,0)
- ; DETAIL^C0CMAIL(.C0CDATA,IEN) --> Get details of the Mail Message and Attachments
+ ;    C0CINPUT = "DUZ;MAILBOX_Name[or IEN for box (comma Separated);MALL
 "RTN","C0CMAIL2",26,0)
- ; GETMSG^C0CMAIL(.C0CDATA,.C0CINPUT)
+ ;                      or "*" for all boxes, default is "IN" if missing]"
 "RTN","C0CMAIL2",27,0)
- ;  Input:
+ ;                $P(C0CINPUT,";",3)=MALL, default=NUL means "New only",
 "RTN","C0CMAIL2",28,0)
- ;    C0CINPUT = "DUZ;MAILBOX_Name[or IEN for box (comma Separated);MALL
+ ;                                     "*" for All or 9,999 maximum
 "RTN","C0CMAIL2",29,0)
- ;                      or "*" for all boxes, default is "IN" if missing]"
+ ;                    MALL?1.n = that number of the n most recent
 "RTN","C0CMAIL2",30,0)
- ;                $P(C0CINPUT,";",3)=MALL, default=NUL means "New only",
+ ;  Internally:
 "RTN","C0CMAIL2",31,0)
- ;                                     "*" for All or 9,999 maximum
+ ;    BNAM = Box Name
 "RTN","C0CMAIL2",32,0)
- ;                    MALL?1.n = that number of the n most recent
+ ;  Output:
 "RTN","C0CMAIL2",33,0)
- ;  Internally:
+ ;    C0CDATA
 "RTN","C0CMAIL2",34,0)
- ;    BNAM = Box Name
+ ;      = (BNAM,"NUMBER") = Number of NEW Emails in Basket
 "RTN","C0CMAIL2",35,0)
- ;  Output:
+ ;        (BNAM,"MSG",C0CIEN,"FROM")=Name
 "RTN","C0CMAIL2",36,0)
- ;    C0CDATA
+ ;        (BNAM,"MSG",C0CIEN,"TO",n)=DUZ, or EMAIL Address
 "RTN","C0CMAIL2",37,0)
- ;      = (BNAM,"NUMBER") = Number of NEW Emails in Basket
+ ;        (BNAM,"MSG",C0CIEN,"TO NAME",n)=Names or EMAIL Address
 "RTN","C0CMAIL2",38,0)
- ;        (BNAM,"MSG",C0CIEN,"FROM")=Name
+ ;        (BNAM,"MSG",C0CIEN,"TITLE")=EMAIL Title
 "RTN","C0CMAIL2",39,0)
- ;        (BNAM,"MSG",C0CIEN,"TO",n)=DUZ, or EMAIL Address
+ ;        (BNAM,"MSG",C0CIEN[for File 3.9])=Number of Attachments
 "RTN","C0CMAIL2",40,0)
- ;        (BNAM,"MSG",C0CIEN,"TO NAME",n)=Names or EMAIL Address
+ ;        (BNAM,"MSG",C0CIEN,num,"CONT") = Free Text
 "RTN","C0CMAIL2",41,0)
- ;        (BNAM,"MSG",C0CIEN,"TITLE")=EMAIL Title
+ ;        (BNAM,"MSG",C0CIEN,num,"LINES") = Number of Lines of Text
 "RTN","C0CMAIL2",42,0)
- ;        (BNAM,"MSG",C0CIEN[for File 3.9])=Number of Attachments
+ ;        (BNAM,"MSG",C0CIEN,num,"SIZE") = Size of the Message in Bytes
 "RTN","C0CMAIL2",43,0)
- ;        (BNAM,"MSG",C0CIEN,num,"CONT") = Free Text
+ ;        (BNAM,"MSG",C0CIEN,num,"TXT",LINE#) = Message Data (No Attachment)
 "RTN","C0CMAIL2",44,0)
- ;        (BNAM,"MSG",C0CIEN,num,"LINES") = Number of Lines of Text
+ ;   (BNAM,"MSG",C0CIEN,"SEG",NUM) = First Line^Last Line
 "RTN","C0CMAIL2",45,0)
- ;        (BNAM,"MSG",C0CIEN,num,"SIZE") = Size of the Message in Bytes
+ ;   (BNAM,"MSG",C0CIEN,"SEG",NUM,"CONT",type) = Message Details
 "RTN","C0CMAIL2",46,0)
- ;        (BNAM,"MSG",C0CIEN,num,"TXT",LINE#) = Message Data (No Attachment)
+ ;   (BNAM,"MSG",C0CIEN,"SEG",NUM,LINE#) = Message Data
 "RTN","C0CMAIL2",47,0)
- ;   (BNAM,"MSG",C0CIEN,"SEG",NUM) = First Line^Last Line
+ ; 
 "RTN","C0CMAIL2",48,0)
- ;   (BNAM,"MSG",C0CIEN,"SEG",NUM,"CONT",type) = Message Details
+ ; DO DETAIL^C0CMAIL(.OUTBF,D0) ; For each Email Message and Attachments
 "RTN","C0CMAIL2",49,0)
- ;   (BNAM,"MSG",C0CIEN,"SEG",NUM,LINE#) = Message Data
+ ;   Input;
 "RTN","C0CMAIL2",50,0)
+ ;     D0     - The IEN for the message in file 3.9, MESSAGE global
+"RTN","C0CMAIL2",51,0)
+ ;   Output
+"RTN","C0CMAIL2",52,0)
+ ;     OUTBF  - The array of your choice to save the expanded and decoded message.
+"RTN","C0CMAIL2",53,0)
  ; 
-"RTN","C0CMAIL2",51,0)
- ; DO DETAIL^C0CMAIL(.OUTBF,D0) ; For each Email Message and Attachments
-"RTN","C0CMAIL2",52,0)
- ;   Input;
-"RTN","C0CMAIL2",53,0)
- ;     D0     - The IEN for the message in file 3.9, MESSAGE global
 "RTN","C0CMAIL2",54,0)
- ;   Output
+GETMSG(C0CDATA,C0CINPUT) ; Common Entry Point for Mailbox Data
 "RTN","C0CMAIL2",55,0)
- ;     OUTBF  - The array of your choice to save the expanded and decoded message.
+ K:'$G(C0CDATA("KEEP")) C0CDATA
 "RTN","C0CMAIL2",56,0)
- ; 
+ N U
 "RTN","C0CMAIL2",57,0)
-GETMSG(C0CDATA,C0CINPUT) ; Common Entry Point for Mailbox Data
+ S U="^"
 "RTN","C0CMAIL2",58,0)
- K:'$G(C0CDATA("KEEP")) C0CDATA
+ D:$G(C0CINPUT)
 "RTN","C0CMAIL2",59,0)
- N U
+ . N BF,DUZ,I,INPUT,J,L,LST,MBLST,MALL
 "RTN","C0CMAIL2",60,0)
- S U="^"
+ . S INPUT=C0CINPUT
 "RTN","C0CMAIL2",61,0)
- D:$G(C0CINPUT)
+ . S DUZ=+INPUT
 "RTN","C0CMAIL2",62,0)
- . N BF,DUZ,I,INPUT,J,L,LST,MBLST,MALL
+ . I $D(^VA(200,DUZ))=0!('$D(^VA(200,DUZ,0)))  D ERROR("ER06")  Q
 "RTN","C0CMAIL2",63,0)
- . S INPUT=C0CINPUT
+ . ;
 "RTN","C0CMAIL2",64,0)
- . S DUZ=+INPUT
+ . D:$D(^XMB(3.7,DUZ,0))#2
 "RTN","C0CMAIL2",65,0)
- . I $D(^VA(200,DUZ))=0!('$D(^VA(200,DUZ,0)))  D ERROR("ER06")  Q
+ . . S MBLST=$P(INPUT,";",2)
 "RTN","C0CMAIL2",66,0)
- . ;
+ . . S MALL=$P(INPUT,";",3) ; New or All Mail Flag
 "RTN","C0CMAIL2",67,0)
- . D:$D(^XMB(3.7,DUZ,0))#2
+ . . S:MALL["*" MALL=99999
 "RTN","C0CMAIL2",68,0)
- . . S MBLST=$P(INPUT,";",2)
+ . . ; Only one of these can be correct
 "RTN","C0CMAIL2",69,0)
- . . S MALL=$P(INPUT,";",3) ; New or All Mail Flag
+ . . D
 "RTN","C0CMAIL2",70,0)
- . . S:MALL["*" MALL=99999
+ . . . ;  If nul, make it "IN" only
 "RTN","C0CMAIL2",71,0)
- . . ; Only one of these can be correct
+ . . . I MBLST="" D  QUIT
 "RTN","C0CMAIL2",72,0)
- . . D
+ . . . . S MBLST("IN")=0,I=0
 "RTN","C0CMAIL2",73,0)
- . . . ;  If nul, make it "IN" only
+ . . . . D GATHER(DUZ,"IN",.LST)
 "RTN","C0CMAIL2",74,0)
- . . . I MBLST="" D  QUIT
+ . . . .QUIT
 "RTN","C0CMAIL2",75,0)
- . . . . S MBLST("IN")=0,I=0
+ . . . ;
 "RTN","C0CMAIL2",76,0)
- . . . . D GATHER(DUZ,"IN",.LST)
+ . . . ;  If "*", Get all Mailboxes and look for New Messages
 "RTN","C0CMAIL2",77,0)
+ . . . I MBLST["*" D  QUIT
+"RTN","C0CMAIL2",78,0)
+ . . . . N NAM,NUM
+"RTN","C0CMAIL2",79,0)
+ . . . . S NUM=0
+"RTN","C0CMAIL2",80,0)
+ . . . . F  S NUM=$O(^XMB(3.7,DUZ,2,NUM)) Q:'NUM  D
+"RTN","C0CMAIL2",81,0)
+ . . . . . S NAM=$P(^XMB(3.7,DUZ,2,NUM,0),U)
+"RTN","C0CMAIL2",82,0)
+ . . . . . D GATHER(DUZ,NAM,.LST)
+"RTN","C0CMAIL2",83,0)
+ . . . . .QUIT
+"RTN","C0CMAIL2",84,0)
  . . . .QUIT
-"RTN","C0CMAIL2",78,0)
+"RTN","C0CMAIL2",85,0)
  . . . ;
-"RTN","C0CMAIL2",79,0)
- . . . ;  If "*", Get all Mailboxes and look for New Messages
-"RTN","C0CMAIL2",80,0)
- . . . I MBLST["*" D  QUIT
-"RTN","C0CMAIL2",81,0)
- . . . . N NAM,NUM
-"RTN","C0CMAIL2",82,0)
- . . . . S NUM=0
-"RTN","C0CMAIL2",83,0)
- . . . . F  S NUM=$O(^XMB(3.7,DUZ,2,NUM)) Q:'NUM  D
-"RTN","C0CMAIL2",84,0)
- . . . . . S NAM=$P(^XMB(3.7,DUZ,2,NUM,0),U)
-"RTN","C0CMAIL2",85,0)
- . . . . . D GATHER(DUZ,NAM,.LST)
 "RTN","C0CMAIL2",86,0)
+ . . . ;  If comma separated, look for mailboxes with new messages
+"RTN","C0CMAIL2",87,0)
+ . . . I $L(MBLST,",")>1 D  QUIT
+"RTN","C0CMAIL2",88,0)
+ . . . . S NAM=""
+"RTN","C0CMAIL2",89,0)
+ . . . . N TN,V
+"RTN","C0CMAIL2",90,0)
+ . . . . F TN=1:1:$L(MBLST,",")  S V=$P(MBLST,",",TN)  D
+"RTN","C0CMAIL2",91,0)
+ . . . . . I $L(V) D   QUIT
+"RTN","C0CMAIL2",92,0)
+ . . . . . . I V S NAM=$P($G(^XMB(3.7,DUZ,2,V,0)),U)
+"RTN","C0CMAIL2",93,0)
+ . . . . . . S:NAM="" NAM=V
+"RTN","C0CMAIL2",94,0)
+ . . . . . . D GATHER(DUZ,NAM,.LST)
+"RTN","C0CMAIL2",95,0)
+ . . . . . .QUIT
+"RTN","C0CMAIL2",96,0)
+ . . . . . ;
+"RTN","C0CMAIL2",97,0)
+ . . . . . D ERROR("ER08")
+"RTN","C0CMAIL2",98,0)
  . . . . .QUIT
-"RTN","C0CMAIL2",87,0)
+"RTN","C0CMAIL2",99,0)
  . . . .QUIT
-"RTN","C0CMAIL2",88,0)
+"RTN","C0CMAIL2",100,0)
  . . . ;
-"RTN","C0CMAIL2",89,0)
- . . . ;  If comma separated, look for mailboxes with new messages
-"RTN","C0CMAIL2",90,0)
- . . . I $L(MBLST,",")>1 D  QUIT
-"RTN","C0CMAIL2",91,0)
- . . . . S NAM=""
-"RTN","C0CMAIL2",92,0)
- . . . . N TN,V
-"RTN","C0CMAIL2",93,0)
- . . . . F TN=1:1:$L(MBLST,",")  S V=$P(MBLST,",",TN)  D
-"RTN","C0CMAIL2",94,0)
- . . . . . I $L(V) D   QUIT
-"RTN","C0CMAIL2",95,0)
- . . . . . . I V S NAM=$P($G(^XMB(3.7,DUZ,2,V,0)),U)
-"RTN","C0CMAIL2",96,0)
- . . . . . . S:NAM="" NAM=V
-"RTN","C0CMAIL2",97,0)
- . . . . . . D GATHER(DUZ,NAM,.LST)
-"RTN","C0CMAIL2",98,0)
- . . . . . .QUIT
-"RTN","C0CMAIL2",99,0)
- . . . . . ;
-"RTN","C0CMAIL2",100,0)
- . . . . . D ERROR("ER08")
 "RTN","C0CMAIL2",101,0)
- . . . . .QUIT
+ . . . ;  If only 1 mailbox named, go get it
 "RTN","C0CMAIL2",102,0)
- . . . .QUIT
+ . . . I $L(MBLST)  D   QUIT
 "RTN","C0CMAIL2",103,0)
- . . . ;
+ . . . . I $D(^XMB(3.7,DUZ,2,"B",MBLST))    D GATHER(DUZ,MBLST,.LST) QUIT
 "RTN","C0CMAIL2",104,0)
- . . . ;  If only 1 mailbox named, go get it
+ . . . . ;
 "RTN","C0CMAIL2",105,0)
- . . . I $L(MBLST)  D   QUIT
+ . . . . D ERROR("ER07")
 "RTN","C0CMAIL2",106,0)
- . . . . I $D(^XMB(3.7,DUZ,2,"B",MBLST))    D GATHER(DUZ,MBLST,.LST) QUIT
+ . . .QUIT
 "RTN","C0CMAIL2",107,0)
- . . . . ;
+ . . MERGE C0CDATA=LST
 "RTN","C0CMAIL2",108,0)
- . . . . D ERROR("ER07")
+ . .QUIT
 "RTN","C0CMAIL2",109,0)
- . . .QUIT
+ .QUIT
 "RTN","C0CMAIL2",110,0)
- . . MERGE C0CDATA=LST
+ QUIT
 "RTN","C0CMAIL2",111,0)
+ ;  ===================
+"RTN","C0CMAIL2",112,0)
+GATHER(DUZ,NAM,LST) ; Gather Data about the Baskets and their mail
+"RTN","C0CMAIL2",113,0)
+ N I,J,K,L
+"RTN","C0CMAIL2",114,0)
+ S (I,K)=0
+"RTN","C0CMAIL2",115,0)
+ S J=$O(^XMB(3.7,DUZ,2,"B",NAM,""))
+"RTN","C0CMAIL2",116,0)
+ F  S I=$O(^XMB(3.7,DUZ,2,J,1,I)) Q:'I  D
+"RTN","C0CMAIL2",117,0)
+ . S L=$P(^XMB(3.7,DUZ,2,J,1,I,0),U,3)
+"RTN","C0CMAIL2",118,0)
+ . D   ; :L
+"RTN","C0CMAIL2",119,0)
+ . . S:L K=K+1,LST(NAM,"MSG",I,"NEW")=""  ; Flag NEW emails
+"RTN","C0CMAIL2",120,0)
+ . . S LST(NAM,"MSG",I)=L
+"RTN","C0CMAIL2",121,0)
+ . . D GETTYP(I)
+"RTN","C0CMAIL2",122,0)
  . .QUIT
-"RTN","C0CMAIL2",112,0)
+"RTN","C0CMAIL2",123,0)
  .QUIT
-"RTN","C0CMAIL2",113,0)
+"RTN","C0CMAIL2",124,0)
+ S LST(NAM,"NUMBER")=K
+"RTN","C0CMAIL2",125,0)
  QUIT
-"RTN","C0CMAIL2",114,0)
+"RTN","C0CMAIL2",126,0)
  ;  ===================
-"RTN","C0CMAIL2",115,0)
-GATHER(DUZ,NAM,LST) ; Gather Data about the Baskets and their mail
-"RTN","C0CMAIL2",116,0)
- N I,J,K,L
-"RTN","C0CMAIL2",117,0)
- S (I,K)=0
-"RTN","C0CMAIL2",118,0)
- S J=$O(^XMB(3.7,DUZ,2,"B",NAM,""))
-"RTN","C0CMAIL2",119,0)
- F  S I=$O(^XMB(3.7,DUZ,2,J,1,I)) Q:'I  D
-"RTN","C0CMAIL2",120,0)
- . S L=$P(^XMB(3.7,DUZ,2,J,1,I,0),U,3)
-"RTN","C0CMAIL2",121,0)
- . D   ; :L
-"RTN","C0CMAIL2",122,0)
- . . S:L K=K+1,LST(NAM,"MSG",I,"NEW")=""  ; Flag NEW emails
-"RTN","C0CMAIL2",123,0)
- . . S LST(NAM,"MSG",I)=L
-"RTN","C0CMAIL2",124,0)
- . . D GETTYP(I)
-"RTN","C0CMAIL2",125,0)
- . .QUIT
-"RTN","C0CMAIL2",126,0)
- .QUIT
 "RTN","C0CMAIL2",127,0)
- S LST(NAM,"NUMBER")=K
+ ; D0 is the IEN into the Message Global ^XMB(3.9,D0)
 "RTN","C0CMAIL2",128,0)
- QUIT
+ ; The products of these emails are scanned to identify
 "RTN","C0CMAIL2",129,0)
- ;  ===================
+ ;  the number of documents stored in the MIME package.
 "RTN","C0CMAIL2",130,0)
- ; D0 is the IEN into the Message Global ^XMB(3.9,D0)
+ ;  The protocol runs like this;
 "RTN","C0CMAIL2",131,0)
- ; The products of these emails are scanned to identify
+ ; Line 1 is the --separator
 "RTN","C0CMAIL2",132,0)
- ;  the number of documents stored in the MIME package.
+ ; Line 2 thru n >Look for Content-[detail type:]Description ; Next CMD
 "RTN","C0CMAIL2",133,0)
- ;  The protocol runs like this;
+ ; Line n+2 thru t-1 where t does NOT have "Content-"
 "RTN","C0CMAIL2",134,0)
- ; Line 1 is the --separator
+ ; Line t   is Next Section Terminator, or Message Terminator, --separator
 "RTN","C0CMAIL2",135,0)
- ; Line 2 thru n >Look for Content-[detail type:]Description ; Next CMD
+ ; Line t+1 should not exist in the data set if Message Terminator
 "RTN","C0CMAIL2",136,0)
- ; Line n+2 thru t-1 where t does NOT have "Content-"
+ ; CON = "Content-"
 "RTN","C0CMAIL2",137,0)
- ; Line t   is Next Section Terminator, or Message Terminator, --separator
+ ; FLG = "--"
 "RTN","C0CMAIL2",138,0)
- ; Line t+1 should not exist in the data set if Message Terminator
+ ; SEP = FLG+7 or more characters  ; Separator
 "RTN","C0CMAIL2",139,0)
- ; CON = "Content-"
+ ; END = SEP+FLG
 "RTN","C0CMAIL2",140,0)
- ; FLG = "--"
+ ; SGC = Segment Count
 "RTN","C0CMAIL2",141,0)
- ; SEP = FLG+7 or more characters  ; Separator
+ ; Note: separator is a string of specific characters of
 "RTN","C0CMAIL2",142,0)
- ; END = SEP+FLG
+ ;        indeterminate length  
 "RTN","C0CMAIL2",143,0)
- ; SGC = Segment Count
+ ; LST() the transfer array
 "RTN","C0CMAIL2",144,0)
- ; Note: separator is a string of specific characters of
+ ; LST(NAM,"MSG",C0CIEN,"SEG",SGN)=Starting Line^Ending Line
 "RTN","C0CMAIL2",145,0)
- ;        indeterminate length  
+ ; LST(NAM,"MSG",C0CIEN,"SEG",SGN,1:n)=Decoded Message Data
 "RTN","C0CMAIL2",146,0)
- ; LST() the transfer array
+ ;
 "RTN","C0CMAIL2",147,0)
- ; LST(NAM,"MSG",C0CIEN,"SEG",SGN)=Starting Line^Ending Line
+GETTYP(D0) ; Look for the goodies in the Mail
 "RTN","C0CMAIL2",148,0)
- ; LST(NAM,"MSG",C0CIEN,"SEG",SGN,1:n)=Decoded Message Data
+ N I,J,N,BCN,CON,CNT,D1,END,FLG,SEP,SGC,XX,XXNM
 "RTN","C0CMAIL2",149,0)
- ;
+ S CON="Content-"
 "RTN","C0CMAIL2",150,0)
-GETTYP(D0) ; Look for the goodies in the Mail
+ S FLG="--"
 "RTN","C0CMAIL2",151,0)
- N I,J,N,BCN,CON,CNT,D1,END,FLG,SEP,SGC,XX,XXNM
+ S SEP=""  ; Start SEP as null, so we can use this to help identify the type
 "RTN","C0CMAIL2",152,0)
- S CON="Content-"
+ S (BCN,CNT,D1,END,SGC)=0
 "RTN","C0CMAIL2",153,0)
- S FLG="--"
+ S XX=$G(^XMB(3.9,D0,0))
 "RTN","C0CMAIL2",154,0)
- S SEP=""  ; Start SEP as null, so we can use this to help identify the type
+ S LST(NAM,"MSG",D0,"TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
 "RTN","C0CMAIL2",155,0)
- S (BCN,CNT,D1,END,SGC)=0
+ S LST(NAM,"MSG",D0,"CREATED")=$G(^XMB(3.9,D0,.6))
 "RTN","C0CMAIL2",156,0)
- S XX=$G(^XMB(3.9,D0,0))
+ F I=4,2 S XXNM=$P(XX,U,I)  Q:$L(XXNM)
 "RTN","C0CMAIL2",157,0)
- S LST(NAM,"MSG",D0,"TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
+ S LST(NAM,"MSG",D0,"FROM")=$$NAME(XXNM)
 "RTN","C0CMAIL2",158,0)
- S LST(NAM,"MSG",D0,"CREATED")=$G(^XMB(3.9,D0,.6))
+ S LST(NAM,"MSG",D0,"SENT")=$$TIME($P(XX,U,3))
 "RTN","C0CMAIL2",159,0)
- F I=4,2 S XXNM=$P(XX,U,I)  Q:$L(XXNM)
+ ; Get the folks the email is sent to.
 "RTN","C0CMAIL2",160,0)
- S LST(NAM,"MSG",D0,"FROM")=$$NAME(XXNM)
+ S D1=0
 "RTN","C0CMAIL2",161,0)
- S LST(NAM,"MSG",D0,"SENT")=$$TIME($P(XX,U,3))
+ F  S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1  D
 "RTN","C0CMAIL2",162,0)
- ; Get the folks the email is sent to.
+ . N T
 "RTN","C0CMAIL2",163,0)
- S D1=0
+ . S T=+$G(^XMB(3.9,D0,1,D1,0))
 "RTN","C0CMAIL2",164,0)
- F  S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1  D
+ . S:T T=$P($G(^VA(200,+T,0)),"^")
 "RTN","C0CMAIL2",165,0)
- . N T
+ . S LST("TO",D1)=T
 "RTN","C0CMAIL2",166,0)
- . S T=+$G(^XMB(3.9,D0,1,D1,0))
+ . S T=$G(^XMB(3.9,D0,6,D1,0))
 "RTN","C0CMAIL2",167,0)
  . S:T T=$P($G(^VA(200,+T,0)),"^")
 "RTN","C0CMAIL2",168,0)
- . S LST("TO",D1)=T
+ . S:T="" T="<Unknown>"
 "RTN","C0CMAIL2",169,0)
- . S T=$G(^XMB(3.9,D0,6,D1,0))
+ . S LST("TO NAME",D1)=T
 "RTN","C0CMAIL2",170,0)
- . S:T T=$P($G(^VA(200,+T,0)),"^")
+ .QUIT
 "RTN","C0CMAIL2",171,0)
- . S:T="" T="<Unknown>"
+ ; Preload first Segment (0) with beginning on Line 1
 "RTN","C0CMAIL2",172,0)
- . S LST("TO NAME",D1)=T
+ ;  if not a 64bit
 "RTN","C0CMAIL2",173,0)
+ S LST(NAM,"MSG",D0,"SEG",0)=1
+"RTN","C0CMAIL2",174,0)
+ S D1=.9999,SEP="@@"
+"RTN","C0CMAIL2",175,0)
+ F  S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1  D
+"RTN","C0CMAIL2",176,0)
+ . ; Clear any control characters (cr/lf/ff) off
+"RTN","C0CMAIL2",177,0)
+ . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
+"RTN","C0CMAIL2",178,0)
+ . ; Enter once to set the SEP to capture the separator
+"RTN","C0CMAIL2",179,0)
+ . I SEP=FLG&($E(X,1,2)=FLG)&($L(X,FLG)=2)&($L($P(X,FLG,2)>5))   D   Q
+"RTN","C0CMAIL2",180,0)
+ . . S SEP=X,END=X_FLG
+"RTN","C0CMAIL2",181,0)
+ . . S (CNT,SGC)=1,BCN=0
+"RTN","C0CMAIL2",182,0)
+ . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
+"RTN","C0CMAIL2",183,0)
+ . .QUIT
+"RTN","C0CMAIL2",184,0)
+ . ;
+"RTN","C0CMAIL2",185,0)
+ . ; A new separator is set, process original 
+"RTN","C0CMAIL2",186,0)
+ . I X=SEP  D  QUIT
+"RTN","C0CMAIL2",187,0)
+ . . S LST(NAM,"MSG",D0,SGC,"SIZE")=BCN+$L(BF)
+"RTN","C0CMAIL2",188,0)
+ . . S LST(NAM,"MSG",D0,"SEG",SGC)=$G(LST(NAM,"MSG",D0,"SEG",SGC))_"^"_(D1-1)
+"RTN","C0CMAIL2",189,0)
+ . . S SGC=SGC+1,BCN=0
+"RTN","C0CMAIL2",190,0)
+ . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
+"RTN","C0CMAIL2",191,0)
+ . .QUIT
+"RTN","C0CMAIL2",192,0)
+ . ;
+"RTN","C0CMAIL2",193,0)
+ . S BCN=BCN+$L(X)
+"RTN","C0CMAIL2",194,0)
+ . I X[CON D  Q
+"RTN","C0CMAIL2",195,0)
+ . . S J=$P($P(X,";"),CON,2)
+"RTN","C0CMAIL2",196,0)
+ . . S LST(NAM,"MSG",D0,"SEG",SGC,"CONT",CNT,$P(J,":"))=$P(J,":",2)
+"RTN","C0CMAIL2",197,0)
+ . .QUIT
+"RTN","C0CMAIL2",198,0)
+ . ;
+"RTN","C0CMAIL2",199,0)
+ . ; S LST(NAM,"MSG",D0,"SEG",D1)=X
+"RTN","C0CMAIL2",200,0)
  .QUIT
-"RTN","C0CMAIL2",174,0)
- ; Preload first Segment (0) with beginning on Line 1
-"RTN","C0CMAIL2",175,0)
- ;  if not a 64bit
-"RTN","C0CMAIL2",176,0)
- S LST(NAM,"MSG",D0,"SEG",0)=1
-"RTN","C0CMAIL2",177,0)
- S D1=.9999,SEP="@@"
-"RTN","C0CMAIL2",178,0)
- F  S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1  D
-"RTN","C0CMAIL2",179,0)
- . ; Clear any control characters (cr/lf/ff) off
-"RTN","C0CMAIL2",180,0)
- . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
-"RTN","C0CMAIL2",181,0)
- . ; Enter once to set the SEP to capture the separator
-"RTN","C0CMAIL2",182,0)
- . I SEP=FLG&($E(X,1,2)=FLG)&($L(X,FLG)=2)&($L($P(X,FLG,2)>5))   D   Q
-"RTN","C0CMAIL2",183,0)
- . . S SEP=X,END=X_FLG
-"RTN","C0CMAIL2",184,0)
- . . S (CNT,SGC)=1,BCN=0
-"RTN","C0CMAIL2",185,0)
- . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
-"RTN","C0CMAIL2",186,0)
- . .QUIT
-"RTN","C0CMAIL2",187,0)
+"RTN","C0CMAIL2",201,0)
+ QUIT
+"RTN","C0CMAIL2",202,0)
+ ;  ===================
+"RTN","C0CMAIL2",203,0)
+NAME(NM) ; Return the name of the Sender
+"RTN","C0CMAIL2",204,0)
+ N NAME
+"RTN","C0CMAIL2",205,0)
+ S NAME="<Unknown Sender>"
+"RTN","C0CMAIL2",206,0)
+ D
+"RTN","C0CMAIL2",207,0)
+ . ; Look first for a value to use with the NEW PERSON file
+"RTN","C0CMAIL2",208,0)
  . ;
-"RTN","C0CMAIL2",188,0)
- . ; A new separator is set, process original 
-"RTN","C0CMAIL2",189,0)
- . I X=SEP  D  QUIT
-"RTN","C0CMAIL2",190,0)
- . . S LST(NAM,"MSG",D0,SGC,"SIZE")=BCN+$L(BF)
-"RTN","C0CMAIL2",191,0)
- . . S LST(NAM,"MSG",D0,"SEG",SGC)=$G(LST(NAM,"MSG",D0,"SEG",SGC))_"^"_(D1-1)
-"RTN","C0CMAIL2",192,0)
- . . S SGC=SGC+1,BCN=0
-"RTN","C0CMAIL2",193,0)
- . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
-"RTN","C0CMAIL2",194,0)
- . .QUIT
-"RTN","C0CMAIL2",195,0)
+"RTN","C0CMAIL2",209,0)
+ . I NM=+NM S NAME=$P(^VA(200,NM,0),U,1) Q
+"RTN","C0CMAIL2",210,0)
  . ;
-"RTN","C0CMAIL2",196,0)
- . S BCN=BCN+$L(X)
-"RTN","C0CMAIL2",197,0)
- . I X[CON D  Q
-"RTN","C0CMAIL2",198,0)
- . . S J=$P($P(X,";"),CON,2)
-"RTN","C0CMAIL2",199,0)
- . . S LST(NAM,"MSG",D0,"SEG",SGC,"CONT",CNT,$P(J,":"))=$P(J,":",2)
-"RTN","C0CMAIL2",200,0)
- . .QUIT
-"RTN","C0CMAIL2",201,0)
+"RTN","C0CMAIL2",211,0)
+ . I $L(NM) S NAME=NM                    Q
+"RTN","C0CMAIL2",212,0)
  . ;
-"RTN","C0CMAIL2",202,0)
- . ; S LST(NAM,"MSG",D0,"SEG",D1)=X
-"RTN","C0CMAIL2",203,0)
+"RTN","C0CMAIL2",213,0)
+ . ; Else, pull the data from the message and display the foreign source
+"RTN","C0CMAIL2",214,0)
+ . ;   of the message.
+"RTN","C0CMAIL2",215,0)
+ . N T
+"RTN","C0CMAIL2",216,0)
+ . S VAL=$G(^XMB(3.9,D0,.7))
+"RTN","C0CMAIL2",217,0)
+ . S:VAL T=$P(^VA(200,VAL,0),U)
+"RTN","C0CMAIL2",218,0)
+ . I $L($G(T)) S NAME=T                  Q
+"RTN","C0CMAIL2",219,0)
+ . ;
+"RTN","C0CMAIL2",220,0)
  .QUIT
-"RTN","C0CMAIL2",204,0)
- QUIT
-"RTN","C0CMAIL2",205,0)
+"RTN","C0CMAIL2",221,0)
+ QUIT NAME
+"RTN","C0CMAIL2",222,0)
  ;  ===================
-"RTN","C0CMAIL2",206,0)
-NAME(NM) ; Return the name of the Sender
-"RTN","C0CMAIL2",207,0)
- N NAME
-"RTN","C0CMAIL2",208,0)
- S NAME="<Unknown Sender>"
-"RTN","C0CMAIL2",209,0)
- D
-"RTN","C0CMAIL2",210,0)
- . ; Look first for a value to use with the NEW PERSON file
-"RTN","C0CMAIL2",211,0)
+"RTN","C0CMAIL2",223,0)
+TIME(Y) ; The time and date of the sending
+"RTN","C0CMAIL2",224,0)
+ X ^DD("DD")
+"RTN","C0CMAIL2",225,0)
+ QUIT Y
+"RTN","C0CMAIL2",226,0)
+ ;  ===================
+"RTN","C0CMAIL2",227,0)
+ ;  Segments in Message need to be identified and decoded properly
+"RTN","C0CMAIL2",228,0)
+ ; D DETAIL^C0CMAIL(.ARRAY,D0) ;  Call One for each message
+"RTN","C0CMAIL2",229,0)
+ ;   ARRAY will have the details of this one call
+"RTN","C0CMAIL2",230,0)
+ ;    
+"RTN","C0CMAIL2",231,0)
+ ; Inputs;
+"RTN","C0CMAIL2",232,0)
+ ;   C0CINPUT    - The IEN of the message to expand
+"RTN","C0CMAIL2",233,0)
+ ; Outputs;
+"RTN","C0CMAIL2",234,0)
+ ;   C0CDATA     - Carrier for the returned structure of the Message
+"RTN","C0CMAIL2",235,0)
+ ;  C0CDATA(D0,"SEG")=number of SEGMENTS
+"RTN","C0CMAIL2",236,0)
+ ;  C0CDATA(D0,"SEG",0:n)=SEGMENT n details; First;Last;Type
+"RTN","C0CMAIL2",237,0)
+ ;  C0CDATA(D0,"SEG",0:n,"CONTENT",type)=Content details
+"RTN","C0CMAIL2",238,0)
+ ;  C0CDATA(D0,"SEG",0:n,"MSG",D3)=Content details
+"RTN","C0CMAIL2",239,0)
+ ;  C0CDATA(D0,"SEG",0:n,"HTML",D3)=Content details
+"RTN","C0CMAIL2",240,0)
+ ;
+"RTN","C0CMAIL2",241,0)
+DETAIL(C0CDATA,C0CINPUT) ; Message Detail Delivery
+"RTN","C0CMAIL2",242,0)
+ N LST,D0,D1,U
+"RTN","C0CMAIL2",243,0)
+ S U="^"
+"RTN","C0CMAIL2",244,0)
+ S D0=+$G(C0CINPUT)
+"RTN","C0CMAIL2",245,0)
+ I D0   D    QUIT
+"RTN","C0CMAIL2",246,0)
+ . I $D(^XMB(3.9,D0))<10 D ERROR("ER01")  QUIT
+"RTN","C0CMAIL2",247,0)
  . ;
-"RTN","C0CMAIL2",212,0)
- . I NM=+NM S NAME=$P(^VA(200,NM,0),U,1) Q
-"RTN","C0CMAIL2",213,0)
- . ;
-"RTN","C0CMAIL2",214,0)
- . I $L(NM) S NAME=NM                    Q
-"RTN","C0CMAIL2",215,0)
- . ;
-"RTN","C0CMAIL2",216,0)
- . ; Else, pull the data from the message and display the foreign source
-"RTN","C0CMAIL2",217,0)
- . ;   of the message.
-"RTN","C0CMAIL2",218,0)
- . N T
-"RTN","C0CMAIL2",219,0)
- . S VAL=$G(^XMB(3.9,D0,.7))
-"RTN","C0CMAIL2",220,0)
- . S:VAL T=$P(^VA(200,VAL,0),U)
-"RTN","C0CMAIL2",221,0)
- . I $L($G(T)) S NAME=T                  Q
-"RTN","C0CMAIL2",222,0)
- . ;
-"RTN","C0CMAIL2",223,0)
- .QUIT
-"RTN","C0CMAIL2",224,0)
- QUIT NAME
-"RTN","C0CMAIL2",225,0)
- ;  ===================
-"RTN","C0CMAIL2",226,0)
-TIME(Y) ; The time and date of the sending
-"RTN","C0CMAIL2",227,0)
- X ^DD("DD")
-"RTN","C0CMAIL2",228,0)
- QUIT Y
-"RTN","C0CMAIL2",229,0)
- ;  ===================
-"RTN","C0CMAIL2",230,0)
- ;  Segments in Message need to be identified and decoded properly
-"RTN","C0CMAIL2",231,0)
- ; D DETAIL^C0CMAIL(.ARRAY,D0) ;  Call One for each message
-"RTN","C0CMAIL2",232,0)
- ;   ARRAY will have the details of this one call
-"RTN","C0CMAIL2",233,0)
- ;    
-"RTN","C0CMAIL2",234,0)
- ; Inputs;
-"RTN","C0CMAIL2",235,0)
- ;   C0CINPUT    - The IEN of the message to expand
-"RTN","C0CMAIL2",236,0)
- ; Outputs;
-"RTN","C0CMAIL2",237,0)
- ;   C0CDATA     - Carrier for the returned structure of the Message
-"RTN","C0CMAIL2",238,0)
- ;  C0CDATA(D0,"SEG")=number of SEGMENTS
-"RTN","C0CMAIL2",239,0)
- ;  C0CDATA(D0,"SEG",0:n)=SEGMENT n details; First;Last;Type
-"RTN","C0CMAIL2",240,0)
- ;  C0CDATA(D0,"SEG",0:n,"CONTENT",type)=Content details
-"RTN","C0CMAIL2",241,0)
- ;  C0CDATA(D0,"SEG",0:n,"MSG",D3)=Content details
-"RTN","C0CMAIL2",242,0)
- ;  C0CDATA(D0,"SEG",0:n,"HTML",D3)=Content details
-"RTN","C0CMAIL2",243,0)
- ;
-"RTN","C0CMAIL2",244,0)
-DETAIL(C0CDATA,C0CINPUT) ; Message Detail Delivery
-"RTN","C0CMAIL2",245,0)
- N LST,D0,D1,U
-"RTN","C0CMAIL2",246,0)
- S U="^"
-"RTN","C0CMAIL2",247,0)
- S D0=+$G(C0CINPUT)
 "RTN","C0CMAIL2",248,0)
- I D0   D    QUIT
+ . D GETTYP2(D0)
 "RTN","C0CMAIL2",249,0)
- . I $D(^XMB(3.9,D0))<10 D ERROR("ER01")  QUIT
+ . I $D(LST)   M C0CDATA(D0)=LST  Q
 "RTN","C0CMAIL2",250,0)
  . ;
 "RTN","C0CMAIL2",251,0)
- . D GETTYP2(D0)
+ . D ERROR("ER02")
 "RTN","C0CMAIL2",252,0)
- . I $D(LST)   M C0CDATA(D0)=LST  Q
+ .QUIT
 "RTN","C0CMAIL2",253,0)
+ QUIT
+"RTN","C0CMAIL2",254,0)
+ ;  ===================
+"RTN","C0CMAIL2",255,0)
+ ;  End note if needed
+"RTN","C0CMAIL2",256,0)
+ ; MSK   - Set of characters that do not exist in 64 bit encoding
+"RTN","C0CMAIL2",257,0)
+GETTYP2(D0) ; Try to get the types and MSK for the 
+"RTN","C0CMAIL2",258,0)
+ N I,J,K,N,BCN,BF,CON,CNT,D1,END,FLG,MSK,SEP,SGC,U,XX,ZN,XXNM
+"RTN","C0CMAIL2",259,0)
+ S CON="Content-",U="^"
+"RTN","C0CMAIL2",260,0)
+ S FLG="--"
+"RTN","C0CMAIL2",261,0)
+ S MSK=" !""#$%&'()*,-.:;<>?@[\]^_`{|}~"
+"RTN","C0CMAIL2",262,0)
+ S (BF,SEP)=""  ; Start SEP as null, so we can use this to help identify the type
+"RTN","C0CMAIL2",263,0)
+ S (BCN,CNT,D1,END,SGC)=0
+"RTN","C0CMAIL2",264,0)
+ S XX=$G(^XMB(3.9,D0,0))
+"RTN","C0CMAIL2",265,0)
+ ; S K=$P(^XMB(3.9,D0,2,0),U,3)
+"RTN","C0CMAIL2",266,0)
+ S LST("TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
+"RTN","C0CMAIL2",267,0)
+ S LST("CREATED")=$$TIME($P(XX,U,3))
+"RTN","C0CMAIL2",268,0)
+ F I=4,2 S XXNM=$P(XX,U,I)  Q:$L(XXNM)
+"RTN","C0CMAIL2",269,0)
+ S LST("FROM")=$$NAME(XXNM)
+"RTN","C0CMAIL2",270,0)
+ ; Get the folks the email is sent to.
+"RTN","C0CMAIL2",271,0)
+ S D1=0
+"RTN","C0CMAIL2",272,0)
+ F  S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1  D   Q:D1=""
+"RTN","C0CMAIL2",273,0)
+ . N I,T
+"RTN","C0CMAIL2",274,0)
+ . S T=$P($G(^XMB(3.9,D0,1,D1,0)),U)
+"RTN","C0CMAIL2",275,0)
+ . S:T T=$P($G(^VA(200,T,0)),"^")
+"RTN","C0CMAIL2",276,0)
+ . S LST("TO",+D1)=T
+"RTN","C0CMAIL2",277,0)
+ . S T=$G(^XMB(3.9,D0,6,+D1,0))
+"RTN","C0CMAIL2",278,0)
+ . S:T="" T=$P($G(^VA(200,+T,0)),"^")
+"RTN","C0CMAIL2",279,0)
+ . S:T="" T="<Unknown>"
+"RTN","C0CMAIL2",280,0)
+ . S LST("TO NAME",D1)=T
+"RTN","C0CMAIL2",281,0)
+ .QUIT
+"RTN","C0CMAIL2",282,0)
+ ; Get the Header for the message
+"RTN","C0CMAIL2",283,0)
+ S D1=0
+"RTN","C0CMAIL2",284,0)
+ F I=1:1 S D1=$O(^XMB(3.9,D0,2,D1)) Q:D1=""  Q:(D1>.99999)   D
+"RTN","C0CMAIL2",285,0)
+ . S LST("HDR",I)=$G(^XMB(3.9,D0,2,D1,0))
+"RTN","C0CMAIL2",286,0)
+ .QUIT
+"RTN","C0CMAIL2",287,0)
+ ; Start walking the different sections
+"RTN","C0CMAIL2",288,0)
+ S D1=.99999,SEP="@@",SGC=0
+"RTN","C0CMAIL2",289,0)
+ F  S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1  D
+"RTN","C0CMAIL2",290,0)
+ . ; Clear any control characters (cr/lf/ff) off
+"RTN","C0CMAIL2",291,0)
+ . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
+"RTN","C0CMAIL2",292,0)
+ . ; Enter once to set the SEP to capture the separator
+"RTN","C0CMAIL2",293,0)
+ . I (SEP="@@")&(X?2."--"5.AN.E)  D   Q
+"RTN","C0CMAIL2",294,0)
+ . . I $L(X,FLG)>2 D ERROR("ER10")
+"RTN","C0CMAIL2",295,0)
+ . . S SEP=X,END=X_FLG
+"RTN","C0CMAIL2",296,0)
+ . . S (CNT,SGC)=1,BCN=0
+"RTN","C0CMAIL2",297,0)
+ . . S LST("SEG",SGC)=D1
+"RTN","C0CMAIL2",298,0)
+ . .QUIT
+"RTN","C0CMAIL2",299,0)
  . ;
-"RTN","C0CMAIL2",254,0)
- . D ERROR("ER02")
-"RTN","C0CMAIL2",255,0)
- .QUIT
-"RTN","C0CMAIL2",256,0)
- QUIT
-"RTN","C0CMAIL2",257,0)
- ;  ===================
-"RTN","C0CMAIL2",258,0)
- ;  End note if needed
-"RTN","C0CMAIL2",259,0)
- ; MSK   - Set of characters that do not exist in 64 bit encoding
-"RTN","C0CMAIL2",260,0)
-GETTYP2(D0) ; Try to get the types and MSK for the 
-"RTN","C0CMAIL2",261,0)
- N I,J,K,N,BCN,BF,CON,CNT,D1,END,FLG,MSK,SEP,SGC,U,XX,ZN,XXNM
-"RTN","C0CMAIL2",262,0)
- S CON="Content-",U="^"
-"RTN","C0CMAIL2",263,0)
- S FLG="--"
-"RTN","C0CMAIL2",264,0)
- S MSK=" !""#$%&'()*,-.:;<>?@[\]^_`{|}~"
-"RTN","C0CMAIL2",265,0)
- S (BF,SEP)=""  ; Start SEP as null, so we can use this to help identify the type
-"RTN","C0CMAIL2",266,0)
- S (BCN,CNT,D1,END,SGC)=0
-"RTN","C0CMAIL2",267,0)
- S XX=$G(^XMB(3.9,D0,0))
-"RTN","C0CMAIL2",268,0)
- ; S K=$P(^XMB(3.9,D0,2,0),U,3)
-"RTN","C0CMAIL2",269,0)
- S LST("TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
-"RTN","C0CMAIL2",270,0)
- S LST("CREATED")=$$TIME($P(XX,U,3))
-"RTN","C0CMAIL2",271,0)
- F I=4,2 S XXNM=$P(XX,U,I)  Q:$L(XXNM)
-"RTN","C0CMAIL2",272,0)
- S LST("FROM")=$$NAME(XXNM)
-"RTN","C0CMAIL2",273,0)
- ; Get the folks the email is sent to.
-"RTN","C0CMAIL2",274,0)
- S D1=0
-"RTN","C0CMAIL2",275,0)
- F  S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1  D   Q:D1=""
-"RTN","C0CMAIL2",276,0)
- . N I,T
-"RTN","C0CMAIL2",277,0)
- . S T=$P($G(^XMB(3.9,D0,1,D1,0)),U)
-"RTN","C0CMAIL2",278,0)
- . S:T T=$P($G(^VA(200,T,0)),"^")
-"RTN","C0CMAIL2",279,0)
- . S LST("TO",+D1)=T
-"RTN","C0CMAIL2",280,0)
- . S T=$G(^XMB(3.9,D0,6,+D1,0))
-"RTN","C0CMAIL2",281,0)
- . S:T="" T=$P($G(^VA(200,+T,0)),"^")
-"RTN","C0CMAIL2",282,0)
- . S:T="" T="<Unknown>"
-"RTN","C0CMAIL2",283,0)
- . S LST("TO NAME",D1)=T
-"RTN","C0CMAIL2",284,0)
- .QUIT
-"RTN","C0CMAIL2",285,0)
- ; Get the Header for the message
-"RTN","C0CMAIL2",286,0)
- S D1=0
-"RTN","C0CMAIL2",287,0)
- F I=1:1 S D1=$O(^XMB(3.9,D0,2,D1)) Q:D1=""  Q:(D1>.99999)   D
-"RTN","C0CMAIL2",288,0)
- . S LST("HDR",I)=$G(^XMB(3.9,D0,2,D1,0))
-"RTN","C0CMAIL2",289,0)
- .QUIT
-"RTN","C0CMAIL2",290,0)
- ; Start walking the different sections
-"RTN","C0CMAIL2",291,0)
- S D1=.99999,SEP="@@",SGC=0
-"RTN","C0CMAIL2",292,0)
- F  S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1  D
-"RTN","C0CMAIL2",293,0)
- . ; Clear any control characters (cr/lf/ff) off
-"RTN","C0CMAIL2",294,0)
- . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
-"RTN","C0CMAIL2",295,0)
- . ; Enter once to set the SEP to capture the separator
-"RTN","C0CMAIL2",296,0)
- . I (SEP="@@")&(X?2."--"5.AN.E)  D   Q
-"RTN","C0CMAIL2",297,0)
- . . I $L(X,FLG)>2 D ERROR("ER10")
-"RTN","C0CMAIL2",298,0)
- . . S SEP=X,END=X_FLG
-"RTN","C0CMAIL2",299,0)
- . . S (CNT,SGC)=1,BCN=0
 "RTN","C0CMAIL2",300,0)
+ . ; A new SEGMENT separator is set, process original 
+"RTN","C0CMAIL2",301,0)
+ . I X=SEP  D  QUIT
+"RTN","C0CMAIL2",302,0)
+ . . ; Save Current Values
+"RTN","C0CMAIL2",303,0)
+ . . S LST("SEG",SGC,"SIZE")=BCN+$L(BF)
+"RTN","C0CMAIL2",304,0)
+ . . ;  Close this Segment and prepare to start a New Segment
+"RTN","C0CMAIL2",305,0)
+ . . S $P(LST("SEG",SGC),"^",1,2)=$P($G(LST("SEG",SGC)),"^",1)_"^"_(D1-1)
+"RTN","C0CMAIL2",306,0)
+ . . ;  Put the result in LST("SEG",SGC,"XML")
+"RTN","C0CMAIL2",307,0)
+ . . I $L(BF) D
+"RTN","C0CMAIL2",308,0)
+ . . . S ZN=1
+"RTN","C0CMAIL2",309,0)
+ . . . N I,T,TBF
+"RTN","C0CMAIL2",310,0)
+ . . . S TBF=BF
+"RTN","C0CMAIL2",311,0)
+ . . . F I=1:1:($L(TBF,"="))  D
+"RTN","C0CMAIL2",312,0)
+ . . . . S BF=$P(TBF,"=",I)_"="
+"RTN","C0CMAIL2",313,0)
+ . . . . I BF'="="  D DECODER
+"RTN","C0CMAIL2",314,0)
+ . . . .QUIT
+"RTN","C0CMAIL2",315,0)
+ . . . S BF=""
+"RTN","C0CMAIL2",316,0)
+ . . .QUIT
+"RTN","C0CMAIL2",317,0)
+ . . S SGC=SGC+1,BCN=0
+"RTN","C0CMAIL2",318,0)
+ . . ; Incriment SGC to start a new Segment
+"RTN","C0CMAIL2",319,0)
  . . S LST("SEG",SGC)=D1
-"RTN","C0CMAIL2",301,0)
+"RTN","C0CMAIL2",320,0)
  . .QUIT
-"RTN","C0CMAIL2",302,0)
+"RTN","C0CMAIL2",321,0)
  . ;
-"RTN","C0CMAIL2",303,0)
- . ; A new SEGMENT separator is set, process original 
-"RTN","C0CMAIL2",304,0)
- . I X=SEP  D  QUIT
-"RTN","C0CMAIL2",305,0)
- . . ; Save Current Values
-"RTN","C0CMAIL2",306,0)
- . . S LST("SEG",SGC,"SIZE")=BCN+$L(BF)
-"RTN","C0CMAIL2",307,0)
- . . ;  Close this Segment and prepare to start a New Segment
-"RTN","C0CMAIL2",308,0)
- . . S $P(LST("SEG",SGC),"^",1,2)=$P($G(LST("SEG",SGC)),"^",1)_"^"_(D1-1)
-"RTN","C0CMAIL2",309,0)
- . . ;  Put the result in LST("SEG",SGC,"XML")
-"RTN","C0CMAIL2",310,0)
- . . I $L(BF) D
-"RTN","C0CMAIL2",311,0)
- . . . S ZN=1
-"RTN","C0CMAIL2",312,0)
- . . . N I,T,TBF
-"RTN","C0CMAIL2",313,0)
- . . . S TBF=BF
-"RTN","C0CMAIL2",314,0)
- . . . F I=1:1:($L(TBF,"="))  D
-"RTN","C0CMAIL2",315,0)
- . . . . S BF=$P(TBF,"=",I)_"="
-"RTN","C0CMAIL2",316,0)
- . . . . I BF'="="  D DECODER
-"RTN","C0CMAIL2",317,0)
- . . . .QUIT
-"RTN","C0CMAIL2",318,0)
- . . . S BF=""
-"RTN","C0CMAIL2",319,0)
- . . .QUIT
-"RTN","C0CMAIL2",320,0)
- . . S SGC=SGC+1,BCN=0
-"RTN","C0CMAIL2",321,0)
- . . ; Incriment SGC to start a new Segment
 "RTN","C0CMAIL2",322,0)
- . . S LST("SEG",SGC)=D1
+ . ; Accumulate the 64 bit encoding
 "RTN","C0CMAIL2",323,0)
- . .QUIT
+ . I X=$TR(X,MSK)&$L(X)  S BF=BF_X  QUIT
 "RTN","C0CMAIL2",324,0)
  . ;
 "RTN","C0CMAIL2",325,0)
- . ; Accumulate the 64 bit encoding
+ . ; Ending Condition, close out the Segment
 "RTN","C0CMAIL2",326,0)
- . I X=$TR(X,MSK)&$L(X)  S BF=BF_X  QUIT
+ . I X=END D  QUIT
 "RTN","C0CMAIL2",327,0)
+ . . S LST("SEG",SGC)=$G(LST("SEG",SGC))_"^"_(D1-1)
+"RTN","C0CMAIL2",328,0)
+ . . I $L(BF) S ZN=1 D DECODER  S BF="" Q
+"RTN","C0CMAIL2",329,0)
+ . .QUIT
+"RTN","C0CMAIL2",330,0)
  . ;
-"RTN","C0CMAIL2",328,0)
- . ; Ending Condition, close out the Segment
-"RTN","C0CMAIL2",329,0)
- . I X=END D  QUIT
-"RTN","C0CMAIL2",330,0)
- . . S LST("SEG",SGC)=$G(LST("SEG",SGC))_"^"_(D1-1)
 "RTN","C0CMAIL2",331,0)
- . . I $L(BF) S ZN=1 D DECODER  S BF="" Q
+ . ; Accumulate the lengths of other lines of the message
 "RTN","C0CMAIL2",332,0)
- . .QUIT
+ . S BCN=BCN+$L(X)
 "RTN","C0CMAIL2",333,0)
- . ;
+ . ; Split out the Content Info
 "RTN","C0CMAIL2",334,0)
- . ; Accumulate the lengths of other lines of the message
+ . I X[CON D  Q
 "RTN","C0CMAIL2",335,0)
- . S BCN=BCN+$L(X)
+ . . S J=$P(X,CON,2)
 "RTN","C0CMAIL2",336,0)
- . ; Split out the Content Info
+ . . I J[" boundary=" D
 "RTN","C0CMAIL2",337,0)
- . I X[CON D  Q
+ . . . S SEP=$P($P(J," boundary=",2),"""",2),END=SEP_FLG
 "RTN","C0CMAIL2",338,0)
- . . S J=$P(X,CON,2)
+ . . . Q:SEP?2"-"5.ANP
 "RTN","C0CMAIL2",339,0)
- . . I J[" boundary=" D
+ . . . ;
 "RTN","C0CMAIL2",340,0)
- . . . S SEP=$P($P(J," boundary=",2),"""",2),END=SEP_FLG
+ . . . D ERROR("ER11")
 "RTN","C0CMAIL2",341,0)
- . . . Q:SEP?2"-"5.ANP
+ . . . Q:SEP'[" "
 "RTN","C0CMAIL2",342,0)
  . . . ;
 "RTN","C0CMAIL2",343,0)
- . . . D ERROR("ER11")
+ . . . D ERROR("ER12")
 "RTN","C0CMAIL2",344,0)
- . . . Q:SEP'[" "
+ . . .QUIT
 "RTN","C0CMAIL2",345,0)
+ . . S LST("SEG",SGC,"CONTENT",$P(J,":"))=$P(J,":",2,9)
+"RTN","C0CMAIL2",346,0)
+ . .QUIT
+"RTN","C0CMAIL2",347,0)
+ . ;
+"RTN","C0CMAIL2",348,0)
+ . ; Everything else is Text, Check for CCR/CCD.
+"RTN","C0CMAIL2",349,0)
+ . N KK,UBF
+"RTN","C0CMAIL2",350,0)
+ . D
+"RTN","C0CMAIL2",351,0)
+ . . S UBF=$$UPPER(X)
+"RTN","C0CMAIL2",352,0)
+ . . I UBF["<CONTINUITYOFCARERECORD"   S $P(LST("SEG",SGC),U,3)="CCR" Q
+"RTN","C0CMAIL2",353,0)
+ . . ;
+"RTN","C0CMAIL2",354,0)
+ . . I UBF["<CLINICALDOCUMENT"         S $P(LST("SEG",SGC),U,3)="CCD" Q
+"RTN","C0CMAIL2",355,0)
+ . .QUIT
+"RTN","C0CMAIL2",356,0)
+ . ; Look for directives in the text before it gets published
+"RTN","C0CMAIL2",357,0)
+ . ;  Look for "=3D" and replace it with a single "=".  I can do more parsing
+"RTN","C0CMAIL2",358,0)
+ . ;  but there may be situations where the line has been wrapped.
+"RTN","C0CMAIL2",359,0)
+ . D:X["=3D"
+"RTN","C0CMAIL2",360,0)
+ . . F KK=1:1 S X=$P(X,"=3D",1)_"="_$P(X,"=3D",2,999) Q:X'["=3D"
+"RTN","C0CMAIL2",361,0)
+ . .QUIT
+"RTN","C0CMAIL2",362,0)
+ . S LST("SEG",SGC,"TXT",D1)=X
+"RTN","C0CMAIL2",363,0)
+ .QUIT
+"RTN","C0CMAIL2",364,0)
+ QUIT
+"RTN","C0CMAIL2",365,0)
+ ;  ===================
+"RTN","C0CMAIL2",366,0)
+ ; Break down the Buffer Array so it can be saved.
+"RTN","C0CMAIL2",367,0)
+ ;  BF is passed in.
+"RTN","C0CMAIL2",368,0)
+DECODER ; 
+"RTN","C0CMAIL2",369,0)
+ N RCNT,TBF,UBF,ZBF,ZI,ZJ,ZK,ZSIZE
+"RTN","C0CMAIL2",370,0)
+ S ZBF=BF
+"RTN","C0CMAIL2",371,0)
+ ;  Full Buffer, BF, now check for Encryption and Unpack
+"RTN","C0CMAIL2",372,0)
+ F RCNT=1:1:$L(ZBF,"=")   D
+"RTN","C0CMAIL2",373,0)
+ . N BF
+"RTN","C0CMAIL2",374,0)
+ . S BF=$P(ZBF,"=",RCNT)
+"RTN","C0CMAIL2",375,0)
+ . ;  Unpacking the 64 bit encoding
+"RTN","C0CMAIL2",376,0)
+ . S TBF=$TR($$DECODE^RGUTUU(BF),$C(10,12,13))
+"RTN","C0CMAIL2",377,0)
+ . D:$L(TBF)
+"RTN","C0CMAIL2",378,0)
+ . . N C,OK,OKCNT,KK,XBF,UBF
+"RTN","C0CMAIL2",379,0)
+ . . D
+"RTN","C0CMAIL2",380,0)
+ . . . S UBF=$$UPPER(TBF)
+"RTN","C0CMAIL2",381,0)
+ . . . I UBF["<CONTINUITYOFCARERECORD XMLNS=" S $P(LST("SEG",SGC),U,3)="CCR" Q
+"RTN","C0CMAIL2",382,0)
  . . . ;
-"RTN","C0CMAIL2",346,0)
- . . . D ERROR("ER12")
-"RTN","C0CMAIL2",347,0)
+"RTN","C0CMAIL2",383,0)
+ . . . I UBF["<CLINICALDOCUMENT XMLNS="       S $P(LST("SEG",SGC),U,3)="CCD" Q
+"RTN","C0CMAIL2",384,0)
  . . .QUIT
-"RTN","C0CMAIL2",348,0)
- . . S LST("SEG",SGC,"CONTENT",$P(J,":"))=$P(J,":",2,9)
-"RTN","C0CMAIL2",349,0)
+"RTN","C0CMAIL2",385,0)
+ . . ; Check for Bad Signature Decoding, after 100 bad characters
+"RTN","C0CMAIL2",386,0)
+ . . S OK=1,OKCNT=0
+"RTN","C0CMAIL2",387,0)
+ . . F KK=1:1:$L(UBF) S C=$A(UBF,KK) S:C>126 OKCNT=OKCNT+1 I OKCNT>100 S OK=0 Q
+"RTN","C0CMAIL2",388,0)
+ . . ;
+"RTN","C0CMAIL2",389,0)
+ . . D
+"RTN","C0CMAIL2",390,0)
+ . . . I 'OK S (BF,UBF,TBF,XBF)="<Crypto-Signature redacted>" Q
+"RTN","C0CMAIL2",391,0)
+ . . . ;
+"RTN","C0CMAIL2",392,0)
+ . . . S BF=BF_"="
+"RTN","C0CMAIL2",393,0)
+ . . . D NORMAL(.XBF,.TBF)
+"RTN","C0CMAIL2",394,0)
+ . . .QUIT
+"RTN","C0CMAIL2",395,0)
+ . . M LST("SEG",SGC,"XML",RCNT)=XBF
+"RTN","C0CMAIL2",396,0)
  . .QUIT
-"RTN","C0CMAIL2",350,0)
+"RTN","C0CMAIL2",397,0)
+ .QUIT
+"RTN","C0CMAIL2",398,0)
+ QUIT
+"RTN","C0CMAIL2",399,0)
+ ;  ===================
+"RTN","C0CMAIL2",400,0)
+ ;  OUTXML = OUTBF  = OUT   = OUTPUT ARRAY TO BE BUILT
+"RTN","C0CMAIL2",401,0)
+ ;  BF     = INXML = INPUT ARRAY TO PROVIDE INPUT
+"RTN","C0CMAIL2",402,0)
+ ;   >D NORMAL^C0CMAIL(.OUT,BF)
+"RTN","C0CMAIL2",403,0)
+NORMAL(OUTXML,INXML)    ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
+"RTN","C0CMAIL2",404,0)
+ ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
+"RTN","C0CMAIL2",405,0)
+ ;
+"RTN","C0CMAIL2",406,0)
+ N ZN,OUTBF,XX,ZSEP
+"RTN","C0CMAIL2",407,0)
+ S INXML=$TR(INXML,$C(10,12,13))
+"RTN","C0CMAIL2",408,0)
+ S ZN=1,ZSEP=">"
+"RTN","C0CMAIL2",409,0)
+ S OUTBF(1)=$P(INXML,"><",1)_ZSEP,XX="<"_$P(INXML,"><",2)_ZSEP,ZN=2,ZL=1
+"RTN","C0CMAIL2",410,0)
+ F ZN=ZN+1:1:$L(INXML,"><")  D   Q:XX=""
+"RTN","C0CMAIL2",411,0)
+ . S XX=$P(INXML,"><",ZN)
+"RTN","C0CMAIL2",412,0)
+ . S:$E($RE(XX))=">" ZSEP=""
+"RTN","C0CMAIL2",413,0)
+ . Q:XX=""
+"RTN","C0CMAIL2",414,0)
  . ;
-"RTN","C0CMAIL2",351,0)
- . ; Everything else is Text, Check for CCR/CCD.
-"RTN","C0CMAIL2",352,0)
- . N KK,UBF
-"RTN","C0CMAIL2",353,0)
+"RTN","C0CMAIL2",415,0)
+ . S XX="<"_XX_ZSEP
+"RTN","C0CMAIL2",416,0)
  . D
-"RTN","C0CMAIL2",354,0)
- . . S UBF=$$UPPER(X)
-"RTN","C0CMAIL2",355,0)
- . . I UBF["<CONTINUITYOFCARERECORD"   S $P(LST("SEG",SGC),U,3)="CCR" Q
-"RTN","C0CMAIL2",356,0)
+"RTN","C0CMAIL2",417,0)
+ . . I $L(XX)<4000 S OUTBF(ZL)=XX,XX=$P(INXML,"><",ZN),ZL=ZL+1   Q
+"RTN","C0CMAIL2",418,0)
  . . ;
-"RTN","C0CMAIL2",357,0)
- . . I UBF["<CLINICALDOCUMENT"         S $P(LST("SEG",SGC),U,3)="CCD" Q
-"RTN","C0CMAIL2",358,0)
+"RTN","C0CMAIL2",419,0)
+ . . D ERROR("ER05")
+"RTN","C0CMAIL2",420,0)
+ . . F ZL=ZL+1:1 D   Q:XX=""
+"RTN","C0CMAIL2",421,0)
+ . . .  N XL
+"RTN","C0CMAIL2",422,0)
+ . . .  S XL=$E(XX,1,4000)
+"RTN","C0CMAIL2",423,0)
+ . . .  S $E(XX,1,4000)=""   ; S XX=$E(XX,4001,999999) ; Remove 4K characters
+"RTN","C0CMAIL2",424,0)
+ . . .  S OUTBF(ZL)=XL
+"RTN","C0CMAIL2",425,0)
+ . . .QUIT
+"RTN","C0CMAIL2",426,0)
  . .QUIT
-"RTN","C0CMAIL2",359,0)
- . ; Look for directives in the text before it gets published
-"RTN","C0CMAIL2",360,0)
- . ;  Look for "=3D" and replace it with a single "=".  I can do more parsing
-"RTN","C0CMAIL2",361,0)
- . ;  but there may be situations where the line has been wrapped.
-"RTN","C0CMAIL2",362,0)
- . D:X["=3D"
-"RTN","C0CMAIL2",363,0)
- . . F KK=1:1 S X=$P(X,"=3D",1)_"="_$P(X,"=3D",2,999) Q:X'["=3D"
-"RTN","C0CMAIL2",364,0)
- . .QUIT
-"RTN","C0CMAIL2",365,0)
- . S LST("SEG",SGC,"TXT",D1)=X
-"RTN","C0CMAIL2",366,0)
+"RTN","C0CMAIL2",427,0)
  .QUIT
-"RTN","C0CMAIL2",367,0)
+"RTN","C0CMAIL2",428,0)
+ M OUTXML=OUTBF
+"RTN","C0CMAIL2",429,0)
  QUIT
-"RTN","C0CMAIL2",368,0)
+"RTN","C0CMAIL2",430,0)
  ;  ===================
-"RTN","C0CMAIL2",369,0)
- ; Break down the Buffer Array so it can be saved.
-"RTN","C0CMAIL2",370,0)
- ;  BF is passed in.
-"RTN","C0CMAIL2",371,0)
-DECODER ; 
-"RTN","C0CMAIL2",372,0)
- N RCNT,TBF,UBF,ZBF,ZI,ZJ,ZK,ZSIZE
-"RTN","C0CMAIL2",373,0)
- S ZBF=BF
-"RTN","C0CMAIL2",374,0)
- ;  Full Buffer, BF, now check for Encryption and Unpack
-"RTN","C0CMAIL2",375,0)
- F RCNT=1:1:$L(ZBF,"=")   D
-"RTN","C0CMAIL2",376,0)
- . N BF
-"RTN","C0CMAIL2",377,0)
- . S BF=$P(ZBF,"=",RCNT)
-"RTN","C0CMAIL2",378,0)
- . ;  Unpacking the 64 bit encoding
-"RTN","C0CMAIL2",379,0)
- . S TBF=$TR($$DECODE^RGUTUU(BF),$C(10,12,13))
-"RTN","C0CMAIL2",380,0)
- . D:$L(TBF)
-"RTN","C0CMAIL2",381,0)
- . . N C,OK,OKCNT,KK,XBF,UBF
-"RTN","C0CMAIL2",382,0)
- . . D
-"RTN","C0CMAIL2",383,0)
- . . . S UBF=$$UPPER(TBF)
-"RTN","C0CMAIL2",384,0)
- . . . I UBF["<CONTINUITYOFCARERECORD XMLNS=" S $P(LST("SEG",SGC),U,3)="CCR" Q
-"RTN","C0CMAIL2",385,0)
- . . . ;
-"RTN","C0CMAIL2",386,0)
- . . . I UBF["<CLINICALDOCUMENT XMLNS="       S $P(LST("SEG",SGC),U,3)="CCD" Q
-"RTN","C0CMAIL2",387,0)
- . . .QUIT
-"RTN","C0CMAIL2",388,0)
- . . ; Check for Bad Signature Decoding, after 100 bad characters
-"RTN","C0CMAIL2",389,0)
- . . S OK=1,OKCNT=0
-"RTN","C0CMAIL2",390,0)
- . . F KK=1:1:$L(UBF) S C=$A(UBF,KK) S:C>126 OKCNT=OKCNT+1 I OKCNT>100 S OK=0 Q
-"RTN","C0CMAIL2",391,0)
- . . ;
-"RTN","C0CMAIL2",392,0)
- . . D
-"RTN","C0CMAIL2",393,0)
- . . . I 'OK S (BF,UBF,TBF,XBF)="<Crypto-Signature redacted>" Q
-"RTN","C0CMAIL2",394,0)
- . . . ;
-"RTN","C0CMAIL2",395,0)
- . . . S BF=BF_"="
-"RTN","C0CMAIL2",396,0)
- . . . D NORMAL(.XBF,.TBF)
-"RTN","C0CMAIL2",397,0)
- . . .QUIT
-"RTN","C0CMAIL2",398,0)
- . . M LST("SEG",SGC,"XML",RCNT)=XBF
-"RTN","C0CMAIL2",399,0)
- . .QUIT
-"RTN","C0CMAIL2",400,0)
- .QUIT
-"RTN","C0CMAIL2",401,0)
- QUIT
-"RTN","C0CMAIL2",402,0)
- ;  ===================
-"RTN","C0CMAIL2",403,0)
- ;  OUTXML = OUTBF  = OUT   = OUTPUT ARRAY TO BE BUILT
-"RTN","C0CMAIL2",404,0)
- ;  BF     = INXML = INPUT ARRAY TO PROVIDE INPUT
-"RTN","C0CMAIL2",405,0)
- ;   >D NORMAL^C0CMAIL(.OUT,BF)
-"RTN","C0CMAIL2",406,0)
-NORMAL(OUTXML,INXML)    ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
-"RTN","C0CMAIL2",407,0)
- ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
-"RTN","C0CMAIL2",408,0)
- ;
-"RTN","C0CMAIL2",409,0)
- N ZN,OUTBF,XX,ZSEP
-"RTN","C0CMAIL2",410,0)
- S INXML=$TR(INXML,$C(10,12,13))
-"RTN","C0CMAIL2",411,0)
- S ZN=1,ZSEP=">"
-"RTN","C0CMAIL2",412,0)
- S OUTBF(1)=$P(INXML,"><",1)_ZSEP,XX="<"_$P(INXML,"><",2)_ZSEP,ZN=2,ZL=1
-"RTN","C0CMAIL2",413,0)
- F ZN=ZN+1:1:$L(INXML,"><")  D   Q:XX=""
-"RTN","C0CMAIL2",414,0)
- . S XX=$P(INXML,"><",ZN)
-"RTN","C0CMAIL2",415,0)
- . S:$E($RE(XX))=">" ZSEP=""
-"RTN","C0CMAIL2",416,0)
- . Q:XX=""
-"RTN","C0CMAIL2",417,0)
- . ;
-"RTN","C0CMAIL2",418,0)
- . S XX="<"_XX_ZSEP
-"RTN","C0CMAIL2",419,0)
- . D
-"RTN","C0CMAIL2",420,0)
- . . I $L(XX)<4000 S OUTBF(ZL)=XX,XX=$P(INXML,"><",ZN),ZL=ZL+1   Q
-"RTN","C0CMAIL2",421,0)
- . . ;
-"RTN","C0CMAIL2",422,0)
- . . D ERROR("ER05")
-"RTN","C0CMAIL2",423,0)
- . . F ZL=ZL+1:1 D   Q:XX=""
-"RTN","C0CMAIL2",424,0)
- . . .  N XL
-"RTN","C0CMAIL2",425,0)
- . . .  S XL=$E(XX,1,4000)
-"RTN","C0CMAIL2",426,0)
- . . .  S $E(XX,1,4000)=""   ; S XX=$E(XX,4001,999999) ; Remove 4K characters
-"RTN","C0CMAIL2",427,0)
- . . .  S OUTBF(ZL)=XL
-"RTN","C0CMAIL2",428,0)
- . . .QUIT
-"RTN","C0CMAIL2",429,0)
- . .QUIT
-"RTN","C0CMAIL2",430,0)
- .QUIT
 "RTN","C0CMAIL2",431,0)
- M OUTXML=OUTBF
+UPPER(X) ; Convert any lowercase letters to Uppercase letters
 "RTN","C0CMAIL2",432,0)
- QUIT
+ QUIT $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
 "RTN","C0CMAIL2",433,0)
  ;  ===================
 "RTN","C0CMAIL2",434,0)
-UPPER(X) ; Convert any lowercase letters to Uppercase letters
+ ; EN is a counter that remains between error events
 "RTN","C0CMAIL2",435,0)
- QUIT $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+ERROR(ER) ; Error Handler
 "RTN","C0CMAIL2",436,0)
+ N TXXQ,XXXQ
+"RTN","C0CMAIL2",437,0)
+ S XXXQ="Unknown Error Encountered = "_ER
+"RTN","C0CMAIL2",438,0)
+ S TXXQ=$P($T(@(ER_"^"_$T(+0))),";;",2,99)
+"RTN","C0CMAIL2",439,0)
+ I TXXQ'=""  D
+"RTN","C0CMAIL2",440,0)
+ . I TXXQ["_" X "S TXXQ="_TXXQ
+"RTN","C0CMAIL2",441,0)
+ . S XXXQ=TXXQ
+"RTN","C0CMAIL2",442,0)
+ .QUIT
+"RTN","C0CMAIL2",443,0)
+ S EN(ER)=$G(EN(ER))+1
+"RTN","C0CMAIL2",444,0)
+ S LST("ERR",ER,EN(ER))=XXXQ
+"RTN","C0CMAIL2",445,0)
+ QUIT
+"RTN","C0CMAIL2",446,0)
  ;  ===================
-"RTN","C0CMAIL2",437,0)
- ; EN is a counter that remains between error events
-"RTN","C0CMAIL2",438,0)
-ERROR(ER) ; Error Handler
-"RTN","C0CMAIL2",439,0)
- N TXXQ,XXXQ
-"RTN","C0CMAIL2",440,0)
- S XXXQ="Unknown Error Encountered = "_ER
-"RTN","C0CMAIL2",441,0)
- S TXXQ=$P($T(@(ER_"^"_$T(+0))),";;",2,99)
-"RTN","C0CMAIL2",442,0)
- I TXXQ'=""  D
-"RTN","C0CMAIL2",443,0)
- . I TXXQ["_" X "S TXXQ="_TXXQ
-"RTN","C0CMAIL2",444,0)
- . S XXXQ=TXXQ
-"RTN","C0CMAIL2",445,0)
- .QUIT
-"RTN","C0CMAIL2",446,0)
- S EN(ER)=$G(EN(ER))+1
 "RTN","C0CMAIL2",447,0)
- S LST("ERR",ER,EN(ER))=XXXQ
+ER01 ;;Message Missing
 "RTN","C0CMAIL2",448,0)
+ER02 ;;Message Text Missing
+"RTN","C0CMAIL2",449,0)
+ER03 ;;Message Not Identifiable
+"RTN","C0CMAIL2",450,0)
+ER04 ;;Segment is too large
+"RTN","C0CMAIL2",451,0)
+ER05 ;;Mailbox Missing
+"RTN","C0CMAIL2",452,0)
+ER06 ;;"User Missing = "_$G(DUZ)
+"RTN","C0CMAIL2",453,0)
+ER07 ;;"Bad DUZ = "_DUZ
+"RTN","C0CMAIL2",454,0)
+ER08 ;;"Bad Basket ID = "_MBLST_" >> "_$G(TN)
+"RTN","C0CMAIL2",455,0)
+ER10 ;;"Bad Separator found = "_X
+"RTN","C0CMAIL2",456,0)
+ER11 ;;"Non-Standard Separator Found:>"_$G(J)
+"RTN","C0CMAIL2",457,0)
+ER12 ;;"Spaces are not allowed in Separators:>"_$G(J)
+"RTN","C0CMAIL2",458,0)
+ ;  vvvvvvvvvvvvvvv  Not Needed  vvvvvvvvvvvvvvvvvvvvvvvvvv
+"RTN","C0CMAIL2",459,0)
+ ;  End note if needed
+"RTN","C0CMAIL2",460,0)
  QUIT
-"RTN","C0CMAIL2",449,0)
- ;  ===================
-"RTN","C0CMAIL2",450,0)
-ER01 ;;Message Missing
-"RTN","C0CMAIL2",451,0)
-ER02 ;;Message Text Missing
-"RTN","C0CMAIL2",452,0)
-ER03 ;;Message Not Identifiable
-"RTN","C0CMAIL2",453,0)
-ER04 ;;Segment is too large
-"RTN","C0CMAIL2",454,0)
-ER05 ;;Mailbox Missing
-"RTN","C0CMAIL2",455,0)
-ER06 ;;"User Missing = "_$G(DUZ)
-"RTN","C0CMAIL2",456,0)
-ER07 ;;"Bad DUZ = "_DUZ
-"RTN","C0CMAIL2",457,0)
-ER08 ;;"Bad Basket ID = "_MBLST_" >> "_$G(TN)
-"RTN","C0CMAIL2",458,0)
-ER10 ;;"Bad Separator found = "_X
-"RTN","C0CMAIL2",459,0)
-ER11 ;;"Non-Standard Separator Found:>"_$G(J)
-"RTN","C0CMAIL2",460,0)
-ER12 ;;"Spaces are not allowed in Separators:>"_$G(J)
 "RTN","C0CMAIL2",461,0)
- ;  vvvvvvvvvvvvvvv  Not Needed  vvvvvvvvvvvvvvvvvvvvvvvvvv
-"RTN","C0CMAIL2",462,0)
- ;  End note if needed
-"RTN","C0CMAIL2",463,0)
- QUIT
-"RTN","C0CMAIL2",464,0)
  ;  ===================
 "RTN","C0CMAIL3")
-0^83^B224733815
+0^83^B222669398
 "RTN","C0CMAIL3",1,0)
 C0CMAIL3 ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr   ; 5/10/12 2:51pm
 "RTN","C0CMAIL3",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CMAIL3",3,0)
  ;Copyright 2011 Chris Richardson, Richardson Computer Research
@@ -104986,5739 +105010,5681 @@
  ;   rcr@rcresearch.us
 "RTN","C0CMAIL3",6,0)
- ;  Licensed under the terms of the GNU
+ ;
 "RTN","C0CMAIL3",7,0)
- ;General Public License See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CMAIL3",8,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CMAIL3",9,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CMAIL3",10,0)
- ;it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CMAIL3",11,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CMAIL3",12,0)
- ;(at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CMAIL3",13,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CMAIL3",14,0)
- ;This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CMAIL3",15,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CMAIL3",16,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CMAIL3",17,0)
- ;GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CMAIL3",18,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CMAIL3",19,0)
- ;You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CMAIL3",20,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;  ------------------
 "RTN","C0CMAIL3",21,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;Entry Points
 "RTN","C0CMAIL3",22,0)
- ;
+ ; DETAIL^C0CMAIL(.C0CDATA,IEN) --> Get details of the Mail Message and Attachments
 "RTN","C0CMAIL3",23,0)
- ;  ------------------
+ ; GETMSG^C0CMAIL(.C0CDATA,.C0CINPUT)
 "RTN","C0CMAIL3",24,0)
- ;Entry Points
+ ;  Input:
 "RTN","C0CMAIL3",25,0)
- ; DETAIL^C0CMAIL(.C0CDATA,IEN) --> Get details of the Mail Message and Attachments
+ ;    C0CINPUT = "DUZ;MAILBOX_Name[or IEN for box (comma Separated);MALL
 "RTN","C0CMAIL3",26,0)
- ; GETMSG^C0CMAIL(.C0CDATA,.C0CINPUT)
+ ;                      or "*" for all boxes, default is "IN" if missing]"
 "RTN","C0CMAIL3",27,0)
- ;  Input:
+ ;                $P(C0CINPUT,";",3)=MALL, default=NUL means "New only",
 "RTN","C0CMAIL3",28,0)
- ;    C0CINPUT = "DUZ;MAILBOX_Name[or IEN for box (comma Separated);MALL
+ ;                                     "*" for All or 9,999 maximum
 "RTN","C0CMAIL3",29,0)
- ;                      or "*" for all boxes, default is "IN" if missing]"
+ ;                    MALL?1.n = that number of the n most recent
 "RTN","C0CMAIL3",30,0)
- ;                $P(C0CINPUT,";",3)=MALL, default=NUL means "New only",
+ ;  Internally:
 "RTN","C0CMAIL3",31,0)
- ;                                     "*" for All or 9,999 maximum
+ ;    BNAM = Box Name
 "RTN","C0CMAIL3",32,0)
- ;                    MALL?1.n = that number of the n most recent
+ ;  Output:
 "RTN","C0CMAIL3",33,0)
- ;  Internally:
+ ;    C0CDATA
 "RTN","C0CMAIL3",34,0)
- ;    BNAM = Box Name
+ ;      = (BNAM,"NUMBER") = Number of NEW Emails in Basket
 "RTN","C0CMAIL3",35,0)
- ;  Output:
+ ;        (BNAM,"MSG",C0CIEN,"FROM")=Name
 "RTN","C0CMAIL3",36,0)
- ;    C0CDATA
+ ;        (BNAM,"MSG",C0CIEN,"TO",n)=DUZ, or EMAIL Address
 "RTN","C0CMAIL3",37,0)
- ;      = (BNAM,"NUMBER") = Number of NEW Emails in Basket
+ ;        (BNAM,"MSG",C0CIEN,"TO NAME",n)=Names or EMAIL Address
 "RTN","C0CMAIL3",38,0)
- ;        (BNAM,"MSG",C0CIEN,"FROM")=Name
+ ;        (BNAM,"MSG",C0CIEN,"TITLE")=EMAIL Title
 "RTN","C0CMAIL3",39,0)
- ;        (BNAM,"MSG",C0CIEN,"TO",n)=DUZ, or EMAIL Address
+ ;        (BNAM,"MSG",C0CIEN[for File 3.9])=Number of Attachments
 "RTN","C0CMAIL3",40,0)
- ;        (BNAM,"MSG",C0CIEN,"TO NAME",n)=Names or EMAIL Address
+ ;        (BNAM,"MSG",C0CIEN,num,"CONT") = Free Text
 "RTN","C0CMAIL3",41,0)
- ;        (BNAM,"MSG",C0CIEN,"TITLE")=EMAIL Title
+ ;        (BNAM,"MSG",C0CIEN,num,"LINES") = Number of Lines of Text
 "RTN","C0CMAIL3",42,0)
- ;        (BNAM,"MSG",C0CIEN[for File 3.9])=Number of Attachments
+ ;        (BNAM,"MSG",C0CIEN,num,"SIZE") = Size of the Message in Bytes
 "RTN","C0CMAIL3",43,0)
- ;        (BNAM,"MSG",C0CIEN,num,"CONT") = Free Text
+ ;        (BNAM,"MSG",C0CIEN,num,"TXT",LINE#) = Message Data (No Attachment)
 "RTN","C0CMAIL3",44,0)
- ;        (BNAM,"MSG",C0CIEN,num,"LINES") = Number of Lines of Text
+ ;   (BNAM,"MSG",C0CIEN,"SEG",NUM) = First Line^Last Line
 "RTN","C0CMAIL3",45,0)
- ;        (BNAM,"MSG",C0CIEN,num,"SIZE") = Size of the Message in Bytes
+ ;   (BNAM,"MSG",C0CIEN,"SEG",NUM,"CONT",type) = Message Details
 "RTN","C0CMAIL3",46,0)
- ;        (BNAM,"MSG",C0CIEN,num,"TXT",LINE#) = Message Data (No Attachment)
+ ;   (BNAM,"MSG",C0CIEN,"SEG",NUM,LINE#) = Message Data
 "RTN","C0CMAIL3",47,0)
- ;   (BNAM,"MSG",C0CIEN,"SEG",NUM) = First Line^Last Line
+ ; 
 "RTN","C0CMAIL3",48,0)
- ;   (BNAM,"MSG",C0CIEN,"SEG",NUM,"CONT",type) = Message Details
+ ; DO DETAIL^C0CMAIL(.OUTBF,D0) ; For each Email Message and Attachments
 "RTN","C0CMAIL3",49,0)
- ;   (BNAM,"MSG",C0CIEN,"SEG",NUM,LINE#) = Message Data
+ ;   Input;
 "RTN","C0CMAIL3",50,0)
+ ;     D0     - The IEN for the message in file 3.9, MESSAGE global
+"RTN","C0CMAIL3",51,0)
+ ;   Output
+"RTN","C0CMAIL3",52,0)
+ ;     OUTBF  - The array of your choice to save the expanded and decoded message.
+"RTN","C0CMAIL3",53,0)
  ; 
-"RTN","C0CMAIL3",51,0)
- ; DO DETAIL^C0CMAIL(.OUTBF,D0) ; For each Email Message and Attachments
-"RTN","C0CMAIL3",52,0)
- ;   Input;
-"RTN","C0CMAIL3",53,0)
- ;     D0     - The IEN for the message in file 3.9, MESSAGE global
 "RTN","C0CMAIL3",54,0)
- ;   Output
+GETMSG(C0CDATA,C0CINPUT) ; Common Entry Point for Mailbox Data
 "RTN","C0CMAIL3",55,0)
- ;     OUTBF  - The array of your choice to save the expanded and decoded message.
+ K:'$G(C0CDATA("KEEP")) C0CDATA
 "RTN","C0CMAIL3",56,0)
- ; 
+ N U
 "RTN","C0CMAIL3",57,0)
-GETMSG(C0CDATA,C0CINPUT) ; Common Entry Point for Mailbox Data
+ S U="^"
 "RTN","C0CMAIL3",58,0)
- K:'$G(C0CDATA("KEEP")) C0CDATA
+ D:$G(C0CINPUT)
 "RTN","C0CMAIL3",59,0)
- N U
+ . N BF,DUZ,I,INPUT,J,L,LST,MBLST,MALL
 "RTN","C0CMAIL3",60,0)
- S U="^"
+ . S INPUT=C0CINPUT
 "RTN","C0CMAIL3",61,0)
- D:$G(C0CINPUT)
+ . S DUZ=+INPUT
 "RTN","C0CMAIL3",62,0)
- . N BF,DUZ,I,INPUT,J,L,LST,MBLST,MALL
+ . I $D(^VA(200,DUZ))=0!('$D(^VA(200,DUZ,0)))  D ERROR("ER06")  Q
 "RTN","C0CMAIL3",63,0)
- . S INPUT=C0CINPUT
+ . ;
 "RTN","C0CMAIL3",64,0)
- . S DUZ=+INPUT
+ . D:$D(^XMB(3.7,DUZ,0))#2
 "RTN","C0CMAIL3",65,0)
- . I $D(^VA(200,DUZ))=0!('$D(^VA(200,DUZ,0)))  D ERROR("ER06")  Q
+ . . S MBLST=$P(INPUT,";",2)
 "RTN","C0CMAIL3",66,0)
- . ;
+ . . S MALL=$P(INPUT,";",3) ; New or All Mail Flag
 "RTN","C0CMAIL3",67,0)
- . D:$D(^XMB(3.7,DUZ,0))#2
+ . . S:MALL["*" MALL=99999
 "RTN","C0CMAIL3",68,0)
- . . S MBLST=$P(INPUT,";",2)
+ . . ; Only one of these can be correct
 "RTN","C0CMAIL3",69,0)
- . . S MALL=$P(INPUT,";",3) ; New or All Mail Flag
+ . . D
 "RTN","C0CMAIL3",70,0)
- . . S:MALL["*" MALL=99999
+ . . . ;  If nul, make it "IN" only
 "RTN","C0CMAIL3",71,0)
- . . ; Only one of these can be correct
+ . . . I MBLST="" D  QUIT
 "RTN","C0CMAIL3",72,0)
- . . D
+ . . . . S MBLST("IN")=0,I=0
 "RTN","C0CMAIL3",73,0)
- . . . ;  If nul, make it "IN" only
+ . . . . D GATHER(DUZ,"IN",.LST)
 "RTN","C0CMAIL3",74,0)
- . . . I MBLST="" D  QUIT
+ . . . .QUIT
 "RTN","C0CMAIL3",75,0)
- . . . . S MBLST("IN")=0,I=0
+ . . . ;
 "RTN","C0CMAIL3",76,0)
- . . . . D GATHER(DUZ,"IN",.LST)
+ . . . ;  If "*", Get all Mailboxes and look for New Messages
 "RTN","C0CMAIL3",77,0)
+ . . . I MBLST["*" D  QUIT
+"RTN","C0CMAIL3",78,0)
+ . . . . N NAM,NUM
+"RTN","C0CMAIL3",79,0)
+ . . . . S NUM=0
+"RTN","C0CMAIL3",80,0)
+ . . . . F  S NUM=$O(^XMB(3.7,DUZ,2,NUM)) Q:'NUM  D
+"RTN","C0CMAIL3",81,0)
+ . . . . . S NAM=$P(^XMB(3.7,DUZ,2,NUM,0),U)
+"RTN","C0CMAIL3",82,0)
+ . . . . . D GATHER(DUZ,NAM,.LST)
+"RTN","C0CMAIL3",83,0)
+ . . . . .QUIT
+"RTN","C0CMAIL3",84,0)
  . . . .QUIT
-"RTN","C0CMAIL3",78,0)
+"RTN","C0CMAIL3",85,0)
  . . . ;
-"RTN","C0CMAIL3",79,0)
- . . . ;  If "*", Get all Mailboxes and look for New Messages
-"RTN","C0CMAIL3",80,0)
- . . . I MBLST["*" D  QUIT
-"RTN","C0CMAIL3",81,0)
- . . . . N NAM,NUM
-"RTN","C0CMAIL3",82,0)
- . . . . S NUM=0
-"RTN","C0CMAIL3",83,0)
- . . . . F  S NUM=$O(^XMB(3.7,DUZ,2,NUM)) Q:'NUM  D
-"RTN","C0CMAIL3",84,0)
- . . . . . S NAM=$P(^XMB(3.7,DUZ,2,NUM,0),U)
-"RTN","C0CMAIL3",85,0)
- . . . . . D GATHER(DUZ,NAM,.LST)
 "RTN","C0CMAIL3",86,0)
+ . . . ;  If comma separated, look for mailboxes with new messages
+"RTN","C0CMAIL3",87,0)
+ . . . I $L(MBLST,",")>1 D  QUIT
+"RTN","C0CMAIL3",88,0)
+ . . . . S NAM=""
+"RTN","C0CMAIL3",89,0)
+ . . . . N TN,V
+"RTN","C0CMAIL3",90,0)
+ . . . . F TN=1:1:$L(MBLST,",")  S V=$P(MBLST,",",TN)  D
+"RTN","C0CMAIL3",91,0)
+ . . . . . I $L(V) D   QUIT
+"RTN","C0CMAIL3",92,0)
+ . . . . . . I V S NAM=$P($G(^XMB(3.7,DUZ,2,V,0)),U)
+"RTN","C0CMAIL3",93,0)
+ . . . . . . S:NAM="" NAM=V
+"RTN","C0CMAIL3",94,0)
+ . . . . . . D GATHER(DUZ,NAM,.LST)
+"RTN","C0CMAIL3",95,0)
+ . . . . . .QUIT
+"RTN","C0CMAIL3",96,0)
+ . . . . . ;
+"RTN","C0CMAIL3",97,0)
+ . . . . . D ERROR("ER08")
+"RTN","C0CMAIL3",98,0)
  . . . . .QUIT
-"RTN","C0CMAIL3",87,0)
+"RTN","C0CMAIL3",99,0)
  . . . .QUIT
-"RTN","C0CMAIL3",88,0)
+"RTN","C0CMAIL3",100,0)
  . . . ;
-"RTN","C0CMAIL3",89,0)
- . . . ;  If comma separated, look for mailboxes with new messages
-"RTN","C0CMAIL3",90,0)
- . . . I $L(MBLST,",")>1 D  QUIT
-"RTN","C0CMAIL3",91,0)
- . . . . S NAM=""
-"RTN","C0CMAIL3",92,0)
- . . . . N TN,V
-"RTN","C0CMAIL3",93,0)
- . . . . F TN=1:1:$L(MBLST,",")  S V=$P(MBLST,",",TN)  D
-"RTN","C0CMAIL3",94,0)
- . . . . . I $L(V) D   QUIT
-"RTN","C0CMAIL3",95,0)
- . . . . . . I V S NAM=$P($G(^XMB(3.7,DUZ,2,V,0)),U)
-"RTN","C0CMAIL3",96,0)
- . . . . . . S:NAM="" NAM=V
-"RTN","C0CMAIL3",97,0)
- . . . . . . D GATHER(DUZ,NAM,.LST)
-"RTN","C0CMAIL3",98,0)
- . . . . . .QUIT
-"RTN","C0CMAIL3",99,0)
- . . . . . ;
-"RTN","C0CMAIL3",100,0)
- . . . . . D ERROR("ER08")
 "RTN","C0CMAIL3",101,0)
- . . . . .QUIT
+ . . . ;  If only 1 mailbox named, go get it
 "RTN","C0CMAIL3",102,0)
- . . . .QUIT
+ . . . I $L(MBLST)  D   QUIT
 "RTN","C0CMAIL3",103,0)
- . . . ;
+ . . . . I $D(^XMB(3.7,DUZ,2,"B",MBLST))    D GATHER(DUZ,MBLST,.LST) QUIT
 "RTN","C0CMAIL3",104,0)
- . . . ;  If only 1 mailbox named, go get it
+ . . . . ;
 "RTN","C0CMAIL3",105,0)
- . . . I $L(MBLST)  D   QUIT
+ . . . . D ERROR("ER07")
 "RTN","C0CMAIL3",106,0)
- . . . . I $D(^XMB(3.7,DUZ,2,"B",MBLST))    D GATHER(DUZ,MBLST,.LST) QUIT
+ . . .QUIT
 "RTN","C0CMAIL3",107,0)
- . . . . ;
+ . . MERGE C0CDATA=LST
 "RTN","C0CMAIL3",108,0)
- . . . . D ERROR("ER07")
+ . .QUIT
 "RTN","C0CMAIL3",109,0)
- . . .QUIT
+ .QUIT
 "RTN","C0CMAIL3",110,0)
- . . MERGE C0CDATA=LST
+ QUIT
 "RTN","C0CMAIL3",111,0)
+ ;  ===================
+"RTN","C0CMAIL3",112,0)
+GATHER(DUZ,NAM,LST) ; Gather Data about the Baskets and their mail
+"RTN","C0CMAIL3",113,0)
+ N I,J,K,L
+"RTN","C0CMAIL3",114,0)
+ S (I,K)=0
+"RTN","C0CMAIL3",115,0)
+ S J=$O(^XMB(3.7,DUZ,2,"B",NAM,""))
+"RTN","C0CMAIL3",116,0)
+ F  S I=$O(^XMB(3.7,DUZ,2,J,1,I)) Q:'I  D
+"RTN","C0CMAIL3",117,0)
+ . S L=$P(^XMB(3.7,DUZ,2,J,1,I,0),U,3)
+"RTN","C0CMAIL3",118,0)
+ . D   ; :L
+"RTN","C0CMAIL3",119,0)
+ . . S:L K=K+1,LST(NAM,"MSG",I,"NEW")=""  ; Flag NEW emails
+"RTN","C0CMAIL3",120,0)
+ . . S LST(NAM,"MSG",I)=L
+"RTN","C0CMAIL3",121,0)
+ . . D GETTYP(I)
+"RTN","C0CMAIL3",122,0)
  . .QUIT
-"RTN","C0CMAIL3",112,0)
+"RTN","C0CMAIL3",123,0)
  .QUIT
-"RTN","C0CMAIL3",113,0)
+"RTN","C0CMAIL3",124,0)
+ S LST(NAM,"NUMBER")=K
+"RTN","C0CMAIL3",125,0)
  QUIT
-"RTN","C0CMAIL3",114,0)
+"RTN","C0CMAIL3",126,0)
  ;  ===================
-"RTN","C0CMAIL3",115,0)
-GATHER(DUZ,NAM,LST) ; Gather Data about the Baskets and their mail
-"RTN","C0CMAIL3",116,0)
- N I,J,K,L
-"RTN","C0CMAIL3",117,0)
- S (I,K)=0
-"RTN","C0CMAIL3",118,0)
- S J=$O(^XMB(3.7,DUZ,2,"B",NAM,""))
-"RTN","C0CMAIL3",119,0)
- F  S I=$O(^XMB(3.7,DUZ,2,J,1,I)) Q:'I  D
-"RTN","C0CMAIL3",120,0)
- . S L=$P(^XMB(3.7,DUZ,2,J,1,I,0),U,3)
-"RTN","C0CMAIL3",121,0)
- . D   ; :L
-"RTN","C0CMAIL3",122,0)
- . . S:L K=K+1,LST(NAM,"MSG",I,"NEW")=""  ; Flag NEW emails
-"RTN","C0CMAIL3",123,0)
- . . S LST(NAM,"MSG",I)=L
-"RTN","C0CMAIL3",124,0)
- . . D GETTYP(I)
-"RTN","C0CMAIL3",125,0)
- . .QUIT
-"RTN","C0CMAIL3",126,0)
- .QUIT
 "RTN","C0CMAIL3",127,0)
- S LST(NAM,"NUMBER")=K
+ ; D0 is the IEN into the Message Global ^XMB(3.9,D0)
 "RTN","C0CMAIL3",128,0)
- QUIT
+ ; The products of these emails are scanned to identify
 "RTN","C0CMAIL3",129,0)
- ;  ===================
+ ;  the number of documents stored in the MIME package.
 "RTN","C0CMAIL3",130,0)
- ; D0 is the IEN into the Message Global ^XMB(3.9,D0)
+ ;  The protocol runs like this;
 "RTN","C0CMAIL3",131,0)
- ; The products of these emails are scanned to identify
+ ; Line 1 is the --separator
 "RTN","C0CMAIL3",132,0)
- ;  the number of documents stored in the MIME package.
+ ; Line 2 thru n >Look for Content-[detail type:]Description ; Next CMD
 "RTN","C0CMAIL3",133,0)
- ;  The protocol runs like this;
+ ; Line n+2 thru t-1 where t does NOT have "Content-"
 "RTN","C0CMAIL3",134,0)
- ; Line 1 is the --separator
+ ; Line t   is Next Section Terminator, or Message Terminator, --separator
 "RTN","C0CMAIL3",135,0)
- ; Line 2 thru n >Look for Content-[detail type:]Description ; Next CMD
+ ; Line t+1 should not exist in the data set if Message Terminator
 "RTN","C0CMAIL3",136,0)
- ; Line n+2 thru t-1 where t does NOT have "Content-"
+ ; CON = "Content-"
 "RTN","C0CMAIL3",137,0)
- ; Line t   is Next Section Terminator, or Message Terminator, --separator
+ ; FLG = "--"
 "RTN","C0CMAIL3",138,0)
- ; Line t+1 should not exist in the data set if Message Terminator
+ ; SEP = FLG+7 or more characters  ; Separator
 "RTN","C0CMAIL3",139,0)
- ; CON = "Content-"
+ ; END = SEP+FLG
 "RTN","C0CMAIL3",140,0)
- ; FLG = "--"
+ ; SGC = Segment Count
 "RTN","C0CMAIL3",141,0)
- ; SEP = FLG+7 or more characters  ; Separator
+ ; Note: separator is a string of specific characters of
 "RTN","C0CMAIL3",142,0)
- ; END = SEP+FLG
+ ;        indeterminate length  
 "RTN","C0CMAIL3",143,0)
- ; SGC = Segment Count
+ ; LST() the transfer array
 "RTN","C0CMAIL3",144,0)
- ; Note: separator is a string of specific characters of
+ ; LST(NAM,"MSG",C0CIEN,"SEG",SGN)=Starting Line^Ending Line
 "RTN","C0CMAIL3",145,0)
- ;        indeterminate length  
+ ; LST(NAM,"MSG",C0CIEN,"SEG",SGN,1:n)=Decoded Message Data
 "RTN","C0CMAIL3",146,0)
- ; LST() the transfer array
+ ;
 "RTN","C0CMAIL3",147,0)
- ; LST(NAM,"MSG",C0CIEN,"SEG",SGN)=Starting Line^Ending Line
+GETTYP(D0) ; Look for the goodies in the Mail
 "RTN","C0CMAIL3",148,0)
- ; LST(NAM,"MSG",C0CIEN,"SEG",SGN,1:n)=Decoded Message Data
+ N I,J,N,BCN,CON,CNT,D1,END,FLG,SEP,SGC,XX,XXNM
 "RTN","C0CMAIL3",149,0)
- ;
+ S CON="Content-"
 "RTN","C0CMAIL3",150,0)
-GETTYP(D0) ; Look for the goodies in the Mail
+ S FLG="--"
 "RTN","C0CMAIL3",151,0)
- N I,J,N,BCN,CON,CNT,D1,END,FLG,SEP,SGC,XX,XXNM
+ S SEP=""  ; Start SEP as null, so we can use this to help identify the type
 "RTN","C0CMAIL3",152,0)
- S CON="Content-"
+ S (BCN,CNT,D1,END,SGC)=0
 "RTN","C0CMAIL3",153,0)
- S FLG="--"
+ S XX=$G(^XMB(3.9,D0,0))
 "RTN","C0CMAIL3",154,0)
- S SEP=""  ; Start SEP as null, so we can use this to help identify the type
+ S LST(NAM,"MSG",D0,"TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
 "RTN","C0CMAIL3",155,0)
- S (BCN,CNT,D1,END,SGC)=0
+ S LST(NAM,"MSG",D0,"CREATED")=$G(^XMB(3.9,D0,.6))
 "RTN","C0CMAIL3",156,0)
- S XX=$G(^XMB(3.9,D0,0))
+ F I=4,2 S XXNM=$P(XX,U,I)  Q:$L(XXNM)
 "RTN","C0CMAIL3",157,0)
- S LST(NAM,"MSG",D0,"TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
+ S LST(NAM,"MSG",D0,"FROM")=$$NAME(XXNM)
 "RTN","C0CMAIL3",158,0)
- S LST(NAM,"MSG",D0,"CREATED")=$G(^XMB(3.9,D0,.6))
+ S LST(NAM,"MSG",D0,"SENT")=$$TIME($P(XX,U,3))
 "RTN","C0CMAIL3",159,0)
- F I=4,2 S XXNM=$P(XX,U,I)  Q:$L(XXNM)
+ ; Get the folks the email is sent to.
 "RTN","C0CMAIL3",160,0)
- S LST(NAM,"MSG",D0,"FROM")=$$NAME(XXNM)
+ S D1=0
 "RTN","C0CMAIL3",161,0)
- S LST(NAM,"MSG",D0,"SENT")=$$TIME($P(XX,U,3))
+ F  S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1  D
 "RTN","C0CMAIL3",162,0)
- ; Get the folks the email is sent to.
+ . N T
 "RTN","C0CMAIL3",163,0)
- S D1=0
+ . S T=+$G(^XMB(3.9,D0,1,D1,0))
 "RTN","C0CMAIL3",164,0)
- F  S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1  D
+ . S:T T=$P($G(^VA(200,+T,0)),"^")
 "RTN","C0CMAIL3",165,0)
- . N T
+ . S LST("TO",D1)=T
 "RTN","C0CMAIL3",166,0)
- . S T=+$G(^XMB(3.9,D0,1,D1,0))
+ . S T=$G(^XMB(3.9,D0,6,D1,0))
 "RTN","C0CMAIL3",167,0)
  . S:T T=$P($G(^VA(200,+T,0)),"^")
 "RTN","C0CMAIL3",168,0)
- . S LST("TO",D1)=T
+ . S:T="" T="<Unknown>"
 "RTN","C0CMAIL3",169,0)
- . S T=$G(^XMB(3.9,D0,6,D1,0))
+ . S LST("TO NAME",D1)=T
 "RTN","C0CMAIL3",170,0)
- . S:T T=$P($G(^VA(200,+T,0)),"^")
+ .QUIT
 "RTN","C0CMAIL3",171,0)
- . S:T="" T="<Unknown>"
+ ; Preload first Segment (0) with beginning on Line 1
 "RTN","C0CMAIL3",172,0)
- . S LST("TO NAME",D1)=T
+ ;  if not a 64bit
 "RTN","C0CMAIL3",173,0)
+ S LST(NAM,"MSG",D0,"SEG",0)=1
+"RTN","C0CMAIL3",174,0)
+ S D1=.9999,SEP="@@"
+"RTN","C0CMAIL3",175,0)
+ F  S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1  D
+"RTN","C0CMAIL3",176,0)
+ . ; Clear any control characters (cr/lf/ff) off
+"RTN","C0CMAIL3",177,0)
+ . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
+"RTN","C0CMAIL3",178,0)
+ . ; Enter once to set the SEP to capture the separator
+"RTN","C0CMAIL3",179,0)
+ . I SEP=FLG&($E(X,1,2)=FLG)&($L(X,FLG)=2)&($L($P(X,FLG,2)>5))   D   Q
+"RTN","C0CMAIL3",180,0)
+ . . S SEP=X,END=X_FLG
+"RTN","C0CMAIL3",181,0)
+ . . S (CNT,SGC)=1,BCN=0
+"RTN","C0CMAIL3",182,0)
+ . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
+"RTN","C0CMAIL3",183,0)
+ . .QUIT
+"RTN","C0CMAIL3",184,0)
+ . ;
+"RTN","C0CMAIL3",185,0)
+ . ; A new separator is set, process original 
+"RTN","C0CMAIL3",186,0)
+ . I X=SEP  D  QUIT
+"RTN","C0CMAIL3",187,0)
+ . . S LST(NAM,"MSG",D0,SGC,"SIZE")=BCN+$L(BF)
+"RTN","C0CMAIL3",188,0)
+ . . S LST(NAM,"MSG",D0,"SEG",SGC)=$G(LST(NAM,"MSG",D0,"SEG",SGC))_"^"_(D1-1)
+"RTN","C0CMAIL3",189,0)
+ . . S SGC=SGC+1,BCN=0
+"RTN","C0CMAIL3",190,0)
+ . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
+"RTN","C0CMAIL3",191,0)
+ . .QUIT
+"RTN","C0CMAIL3",192,0)
+ . ;
+"RTN","C0CMAIL3",193,0)
+ . S BCN=BCN+$L(X)
+"RTN","C0CMAIL3",194,0)
+ . I X[CON D  Q
+"RTN","C0CMAIL3",195,0)
+ . . S J=$P($P(X,";"),CON,2)
+"RTN","C0CMAIL3",196,0)
+ . . S LST(NAM,"MSG",D0,"SEG",SGC,"CONT",CNT,$P(J,":"))=$P(J,":",2)
+"RTN","C0CMAIL3",197,0)
+ . .QUIT
+"RTN","C0CMAIL3",198,0)
+ . ;
+"RTN","C0CMAIL3",199,0)
+ . ; S LST(NAM,"MSG",D0,"SEG",D1)=X
+"RTN","C0CMAIL3",200,0)
  .QUIT
-"RTN","C0CMAIL3",174,0)
- ; Preload first Segment (0) with beginning on Line 1
-"RTN","C0CMAIL3",175,0)
- ;  if not a 64bit
-"RTN","C0CMAIL3",176,0)
- S LST(NAM,"MSG",D0,"SEG",0)=1
-"RTN","C0CMAIL3",177,0)
- S D1=.9999,SEP="@@"
-"RTN","C0CMAIL3",178,0)
- F  S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1  D
-"RTN","C0CMAIL3",179,0)
- . ; Clear any control characters (cr/lf/ff) off
-"RTN","C0CMAIL3",180,0)
- . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
-"RTN","C0CMAIL3",181,0)
- . ; Enter once to set the SEP to capture the separator
-"RTN","C0CMAIL3",182,0)
- . I SEP=FLG&($E(X,1,2)=FLG)&($L(X,FLG)=2)&($L($P(X,FLG,2)>5))   D   Q
-"RTN","C0CMAIL3",183,0)
- . . S SEP=X,END=X_FLG
-"RTN","C0CMAIL3",184,0)
- . . S (CNT,SGC)=1,BCN=0
-"RTN","C0CMAIL3",185,0)
- . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
-"RTN","C0CMAIL3",186,0)
- . .QUIT
-"RTN","C0CMAIL3",187,0)
+"RTN","C0CMAIL3",201,0)
+ QUIT
+"RTN","C0CMAIL3",202,0)
+ ;  ===================
+"RTN","C0CMAIL3",203,0)
+NAME(NM) ; Return the name of the Sender
+"RTN","C0CMAIL3",204,0)
+ N NAME
+"RTN","C0CMAIL3",205,0)
+ S NAME="<Unknown Sender>"
+"RTN","C0CMAIL3",206,0)
+ D
+"RTN","C0CMAIL3",207,0)
+ . ; Look first for a value to use with the NEW PERSON file
+"RTN","C0CMAIL3",208,0)
  . ;
-"RTN","C0CMAIL3",188,0)
- . ; A new separator is set, process original 
-"RTN","C0CMAIL3",189,0)
- . I X=SEP  D  QUIT
-"RTN","C0CMAIL3",190,0)
- . . S LST(NAM,"MSG",D0,SGC,"SIZE")=BCN+$L(BF)
-"RTN","C0CMAIL3",191,0)
- . . S LST(NAM,"MSG",D0,"SEG",SGC)=$G(LST(NAM,"MSG",D0,"SEG",SGC))_"^"_(D1-1)
-"RTN","C0CMAIL3",192,0)
- . . S SGC=SGC+1,BCN=0
-"RTN","C0CMAIL3",193,0)
- . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
-"RTN","C0CMAIL3",194,0)
- . .QUIT
-"RTN","C0CMAIL3",195,0)
+"RTN","C0CMAIL3",209,0)
+ . I NM=+NM S NAME=$P(^VA(200,NM,0),U,1) Q
+"RTN","C0CMAIL3",210,0)
  . ;
-"RTN","C0CMAIL3",196,0)
- . S BCN=BCN+$L(X)
-"RTN","C0CMAIL3",197,0)
- . I X[CON D  Q
-"RTN","C0CMAIL3",198,0)
- . . S J=$P($P(X,";"),CON,2)
-"RTN","C0CMAIL3",199,0)
- . . S LST(NAM,"MSG",D0,"SEG",SGC,"CONT",CNT,$P(J,":"))=$P(J,":",2)
-"RTN","C0CMAIL3",200,0)
- . .QUIT
-"RTN","C0CMAIL3",201,0)
+"RTN","C0CMAIL3",211,0)
+ . I $L(NM) S NAME=NM                    Q
+"RTN","C0CMAIL3",212,0)
  . ;
-"RTN","C0CMAIL3",202,0)
- . ; S LST(NAM,"MSG",D0,"SEG",D1)=X
-"RTN","C0CMAIL3",203,0)
+"RTN","C0CMAIL3",213,0)
+ . ; Else, pull the data from the message and display the foreign source
+"RTN","C0CMAIL3",214,0)
+ . ;   of the message.
+"RTN","C0CMAIL3",215,0)
+ . N T
+"RTN","C0CMAIL3",216,0)
+ . S VAL=$G(^XMB(3.9,D0,.7))
+"RTN","C0CMAIL3",217,0)
+ . S:VAL T=$P(^VA(200,VAL,0),U)
+"RTN","C0CMAIL3",218,0)
+ . I $L($G(T)) S NAME=T                  Q
+"RTN","C0CMAIL3",219,0)
+ . ;
+"RTN","C0CMAIL3",220,0)
  .QUIT
-"RTN","C0CMAIL3",204,0)
- QUIT
-"RTN","C0CMAIL3",205,0)
+"RTN","C0CMAIL3",221,0)
+ QUIT NAME
+"RTN","C0CMAIL3",222,0)
  ;  ===================
-"RTN","C0CMAIL3",206,0)
-NAME(NM) ; Return the name of the Sender
-"RTN","C0CMAIL3",207,0)
- N NAME
-"RTN","C0CMAIL3",208,0)
- S NAME="<Unknown Sender>"
-"RTN","C0CMAIL3",209,0)
- D
-"RTN","C0CMAIL3",210,0)
- . ; Look first for a value to use with the NEW PERSON file
-"RTN","C0CMAIL3",211,0)
+"RTN","C0CMAIL3",223,0)
+TIME(Y) ; The time and date of the sending
+"RTN","C0CMAIL3",224,0)
+ X ^DD("DD")
+"RTN","C0CMAIL3",225,0)
+ QUIT Y
+"RTN","C0CMAIL3",226,0)
+ ;  ===================
+"RTN","C0CMAIL3",227,0)
+ ;  Segments in Message need to be identified and decoded properly
+"RTN","C0CMAIL3",228,0)
+ ; D DETAIL^C0CMAIL(.ARRAY,D0) ;  Call One for each message
+"RTN","C0CMAIL3",229,0)
+ ;   ARRAY will have the details of this one call
+"RTN","C0CMAIL3",230,0)
+ ;    
+"RTN","C0CMAIL3",231,0)
+ ; Inputs;
+"RTN","C0CMAIL3",232,0)
+ ;   C0CINPUT    - The IEN of the message to expand
+"RTN","C0CMAIL3",233,0)
+ ; Outputs;
+"RTN","C0CMAIL3",234,0)
+ ;   C0CDATA     - Carrier for the returned structure of the Message
+"RTN","C0CMAIL3",235,0)
+ ;  C0CDATA(D0,"SEG")=number of SEGMENTS
+"RTN","C0CMAIL3",236,0)
+ ;  C0CDATA(D0,"SEG",0:n)=SEGMENT n details; First;Last;Type
+"RTN","C0CMAIL3",237,0)
+ ;  C0CDATA(D0,"SEG",0:n,"CONTENT",type)=Content details
+"RTN","C0CMAIL3",238,0)
+ ;  C0CDATA(D0,"SEG",0:n,"MSG",D3)=Content details
+"RTN","C0CMAIL3",239,0)
+ ;  C0CDATA(D0,"SEG",0:n,"HTML",D3)=Content details
+"RTN","C0CMAIL3",240,0)
+ ;
+"RTN","C0CMAIL3",241,0)
+DETAIL(C0CDATA,C0CINPUT) ; Message Detail Delivery
+"RTN","C0CMAIL3",242,0)
+ N LST,D0,D1,U
+"RTN","C0CMAIL3",243,0)
+ S U="^"
+"RTN","C0CMAIL3",244,0)
+ S D0=+$G(C0CINPUT)
+"RTN","C0CMAIL3",245,0)
+ I D0   D    QUIT
+"RTN","C0CMAIL3",246,0)
+ . I $D(^XMB(3.9,D0))<10 D ERROR("ER01")  QUIT
+"RTN","C0CMAIL3",247,0)
  . ;
-"RTN","C0CMAIL3",212,0)
- . I NM=+NM S NAME=$P(^VA(200,NM,0),U,1) Q
-"RTN","C0CMAIL3",213,0)
- . ;
-"RTN","C0CMAIL3",214,0)
- . I $L(NM) S NAME=NM                    Q
-"RTN","C0CMAIL3",215,0)
- . ;
-"RTN","C0CMAIL3",216,0)
- . ; Else, pull the data from the message and display the foreign source
-"RTN","C0CMAIL3",217,0)
- . ;   of the message.
-"RTN","C0CMAIL3",218,0)
- . N T
-"RTN","C0CMAIL3",219,0)
- . S VAL=$G(^XMB(3.9,D0,.7))
-"RTN","C0CMAIL3",220,0)
- . S:VAL T=$P(^VA(200,VAL,0),U)
-"RTN","C0CMAIL3",221,0)
- . I $L($G(T)) S NAME=T                  Q
-"RTN","C0CMAIL3",222,0)
- . ;
-"RTN","C0CMAIL3",223,0)
- .QUIT
-"RTN","C0CMAIL3",224,0)
- QUIT NAME
-"RTN","C0CMAIL3",225,0)
- ;  ===================
-"RTN","C0CMAIL3",226,0)
-TIME(Y) ; The time and date of the sending
-"RTN","C0CMAIL3",227,0)
- X ^DD("DD")
-"RTN","C0CMAIL3",228,0)
- QUIT Y
-"RTN","C0CMAIL3",229,0)
- ;  ===================
-"RTN","C0CMAIL3",230,0)
- ;  Segments in Message need to be identified and decoded properly
-"RTN","C0CMAIL3",231,0)
- ; D DETAIL^C0CMAIL(.ARRAY,D0) ;  Call One for each message
-"RTN","C0CMAIL3",232,0)
- ;   ARRAY will have the details of this one call
-"RTN","C0CMAIL3",233,0)
- ;    
-"RTN","C0CMAIL3",234,0)
- ; Inputs;
-"RTN","C0CMAIL3",235,0)
- ;   C0CINPUT    - The IEN of the message to expand
-"RTN","C0CMAIL3",236,0)
- ; Outputs;
-"RTN","C0CMAIL3",237,0)
- ;   C0CDATA     - Carrier for the returned structure of the Message
-"RTN","C0CMAIL3",238,0)
- ;  C0CDATA(D0,"SEG")=number of SEGMENTS
-"RTN","C0CMAIL3",239,0)
- ;  C0CDATA(D0,"SEG",0:n)=SEGMENT n details; First;Last;Type
-"RTN","C0CMAIL3",240,0)
- ;  C0CDATA(D0,"SEG",0:n,"CONTENT",type)=Content details
-"RTN","C0CMAIL3",241,0)
- ;  C0CDATA(D0,"SEG",0:n,"MSG",D3)=Content details
-"RTN","C0CMAIL3",242,0)
- ;  C0CDATA(D0,"SEG",0:n,"HTML",D3)=Content details
-"RTN","C0CMAIL3",243,0)
- ;
-"RTN","C0CMAIL3",244,0)
-DETAIL(C0CDATA,C0CINPUT) ; Message Detail Delivery
-"RTN","C0CMAIL3",245,0)
- N LST,D0,D1,U
-"RTN","C0CMAIL3",246,0)
- S U="^"
-"RTN","C0CMAIL3",247,0)
- S D0=+$G(C0CINPUT)
 "RTN","C0CMAIL3",248,0)
- I D0   D    QUIT
+ . D GETTYP2(D0)
 "RTN","C0CMAIL3",249,0)
- . I $D(^XMB(3.9,D0))<10 D ERROR("ER01")  QUIT
+ . I $D(LST)   M C0CDATA(D0)=LST  Q
 "RTN","C0CMAIL3",250,0)
  . ;
 "RTN","C0CMAIL3",251,0)
- . D GETTYP2(D0)
+ . D ERROR("ER02")
 "RTN","C0CMAIL3",252,0)
- . I $D(LST)   M C0CDATA(D0)=LST  Q
+ .QUIT
 "RTN","C0CMAIL3",253,0)
+ QUIT
+"RTN","C0CMAIL3",254,0)
+ ;  ===================
+"RTN","C0CMAIL3",255,0)
+ ;  End note if needed
+"RTN","C0CMAIL3",256,0)
+ ; MSK   - Set of characters that do not exist in 64 bit encoding
+"RTN","C0CMAIL3",257,0)
+GETTYP2(D0) ; Try to get the types and MSK for the 
+"RTN","C0CMAIL3",258,0)
+ N I,J,K,N,BCN,BF,CON,CNT,D1,END,FLG,MSK,SEP,SGC,U,XX,ZN,XXNM
+"RTN","C0CMAIL3",259,0)
+ S CON="Content-",U="^"
+"RTN","C0CMAIL3",260,0)
+ S FLG="--",MSK=" !""#$%&'()*,-.:;<>?@[\]^_`{|}~"
+"RTN","C0CMAIL3",261,0)
+ S (BF,SEP)=""  ; Start SEP as null, so we can use this to help identify the type
+"RTN","C0CMAIL3",262,0)
+ S (BCN,CNT,D1,END,SGC)=0
+"RTN","C0CMAIL3",263,0)
+ S XX=$G(^XMB(3.9,D0,0))
+"RTN","C0CMAIL3",264,0)
+ ; S K=$P(^XMB(3.9,D0,2,0),U,3)
+"RTN","C0CMAIL3",265,0)
+ S LST("TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
+"RTN","C0CMAIL3",266,0)
+ S LST("CREATED")=$$TIME($P(XX,U,3))
+"RTN","C0CMAIL3",267,0)
+ F I=4,2 S XXNM=$P(XX,U,I)  Q:$L(XXNM)
+"RTN","C0CMAIL3",268,0)
+ S LST("FROM")=$$NAME(XXNM)
+"RTN","C0CMAIL3",269,0)
+ ; Get the folks the email is sent to.
+"RTN","C0CMAIL3",270,0)
+ S D1=0
+"RTN","C0CMAIL3",271,0)
+ F  S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1  D   Q:D1=""
+"RTN","C0CMAIL3",272,0)
+ . N I,T
+"RTN","C0CMAIL3",273,0)
+ . S T=$P($G(^XMB(3.9,D0,1,D1,0)),U)
+"RTN","C0CMAIL3",274,0)
+ . S:T T=$P($G(^VA(200,T,0)),"^")
+"RTN","C0CMAIL3",275,0)
+ . S LST("TO",+D1)=T
+"RTN","C0CMAIL3",276,0)
+ . S T=$G(^XMB(3.9,D0,6,+D1,0))
+"RTN","C0CMAIL3",277,0)
+ . S:T="" T=$P($G(^VA(200,+T,0)),"^")
+"RTN","C0CMAIL3",278,0)
+ . S:T="" T="<Unknown>"
+"RTN","C0CMAIL3",279,0)
+ . S LST("TO NAME",D1)=T
+"RTN","C0CMAIL3",280,0)
+ .QUIT
+"RTN","C0CMAIL3",281,0)
+ ; Get the Header for the message and store as "HDR"
+"RTN","C0CMAIL3",282,0)
+ S D1=0,SGC=0
+"RTN","C0CMAIL3",283,0)
+ F I=1:1 S D1=$O(^XMB(3.9,D0,2,D1)) Q:D1=""  Q:(D1>.99999)   D
+"RTN","C0CMAIL3",284,0)
+ . S LST("HDR",I)=$G(^XMB(3.9,D0,2,D1,0))
+"RTN","C0CMAIL3",285,0)
+ .QUIT
+"RTN","C0CMAIL3",286,0)
+ N BNDRY,STKL,SEG
+"RTN","C0CMAIL3",287,0)
+ S STKL=0,SEG=0
+"RTN","C0CMAIL3",288,0)
+ ; Find boundaries and map them
+"RTN","C0CMAIL3",289,0)
+ S D1=0
+"RTN","C0CMAIL3",290,0)
+ F  S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1  D
+"RTN","C0CMAIL3",291,0)
+ . ; Clear any control characters (cr/lf/ff) off
+"RTN","C0CMAIL3",292,0)
+ . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
+"RTN","C0CMAIL3",293,0)
+ . ; Look for " boundary=" in the various parts.  Map the establishment and the 
+"RTN","C0CMAIL3",294,0)
+ . ;  terminator markers and the actual boundary markers.
+"RTN","C0CMAIL3",295,0)
+ . I X[" boundary=" D  Q
+"RTN","C0CMAIL3",296,0)
+ . . S SEP=$P(X," boundary=",2)
+"RTN","C0CMAIL3",297,0)
+ . . S:$E(SEP)="""" SEP=$TR(SEP,"""")
+"RTN","C0CMAIL3",298,0)
+ . . S STKL=STKL+1
+"RTN","C0CMAIL3",299,0)
+ . . S END=SEP_FLG
+"RTN","C0CMAIL3",300,0)
+ . . S BNDRY(STKL,SEP)=0
+"RTN","C0CMAIL3",301,0)
+ . . S BNDRX(SEP)=STKL,BNDRZ(END)=0
+"RTN","C0CMAIL3",302,0)
+ . .QUIT
+"RTN","C0CMAIL3",303,0)
  . ;
-"RTN","C0CMAIL3",254,0)
- . D ERROR("ER02")
-"RTN","C0CMAIL3",255,0)
+"RTN","C0CMAIL3",304,0)
+ . ; Look for information as to how amy boudaries are present and where
+"RTN","C0CMAIL3",305,0)
+ . ;   they terminate
+"RTN","C0CMAIL3",306,0)
+ . D:X'=""&($E(X,1,2)="--")&($E(X,$L(X)-1,9999)'="--")
+"RTN","C0CMAIL3",307,0)
+ . . ; Boundary Found
+"RTN","C0CMAIL3",308,0)
+ . . I $D(BNDRX(X)) D  Q
+"RTN","C0CMAIL3",309,0)
+ . . . S SEG=SEG+1
+"RTN","C0CMAIL3",310,0)
+ . . . S BNDRE(X)=$G(BNDRE(X))_D1_";"
+"RTN","C0CMAIL3",311,0)
+ . . . S BND1(D1)=STKL_";B;"_SEG_";"_X
+"RTN","C0CMAIL3",312,0)
+ . . . S BNDR(X,D1,"B")=STKL
+"RTN","C0CMAIL3",313,0)
+ . . . I BNDRX(X)=X  D ERROR("ER13")
+"RTN","C0CMAIL3",314,0)
+ . . .QUIT
+"RTN","C0CMAIL3",315,0)
+ . . ;
+"RTN","C0CMAIL3",316,0)
+ . . ; Boundary Terminator
+"RTN","C0CMAIL3",317,0)
+ . . I $D(BNDRZ(X)) D  Q
+"RTN","C0CMAIL3",318,0)
+ . . . S BNDR(X,D1,"E")=STKL
+"RTN","C0CMAIL3",319,0)
+ . . . S BNDRZ(X)=BNDRZ(X)+1
+"RTN","C0CMAIL3",320,0)
+ . . . S BND1(D1)=STKL_";E;"_SEG_";"_X
+"RTN","C0CMAIL3",321,0)
+ . . . S SEG=SEG+1
+"RTN","C0CMAIL3",322,0)
+ . . . I BNDRX(X)=X  D ERROR("ER14")
+"RTN","C0CMAIL3",323,0)
+ . . . S STKL=STKL-1
+"RTN","C0CMAIL3",324,0)
+ . . .QUIT
+"RTN","C0CMAIL3",325,0)
+ . .QUIT
+"RTN","C0CMAIL3",326,0)
  .QUIT
-"RTN","C0CMAIL3",256,0)
- QUIT
-"RTN","C0CMAIL3",257,0)
- ;  ===================
-"RTN","C0CMAIL3",258,0)
- ;  End note if needed
-"RTN","C0CMAIL3",259,0)
- ; MSK   - Set of characters that do not exist in 64 bit encoding
-"RTN","C0CMAIL3",260,0)
-GETTYP2(D0) ; Try to get the types and MSK for the 
-"RTN","C0CMAIL3",261,0)
- N I,J,K,N,BCN,BF,CON,CNT,D1,END,FLG,MSK,SEP,SGC,U,XX,ZN,XXNM
-"RTN","C0CMAIL3",262,0)
- S CON="Content-",U="^"
-"RTN","C0CMAIL3",263,0)
- S FLG="--",MSK=" !""#$%&'()*,-.:;<>?@[\]^_`{|}~"
-"RTN","C0CMAIL3",264,0)
- S (BF,SEP)=""  ; Start SEP as null, so we can use this to help identify the type
-"RTN","C0CMAIL3",265,0)
- S (BCN,CNT,D1,END,SGC)=0
-"RTN","C0CMAIL3",266,0)
- S XX=$G(^XMB(3.9,D0,0))
-"RTN","C0CMAIL3",267,0)
- ; S K=$P(^XMB(3.9,D0,2,0),U,3)
-"RTN","C0CMAIL3",268,0)
- S LST("TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
-"RTN","C0CMAIL3",269,0)
- S LST("CREATED")=$$TIME($P(XX,U,3))
-"RTN","C0CMAIL3",270,0)
- F I=4,2 S XXNM=$P(XX,U,I)  Q:$L(XXNM)
-"RTN","C0CMAIL3",271,0)
- S LST("FROM")=$$NAME(XXNM)
-"RTN","C0CMAIL3",272,0)
- ; Get the folks the email is sent to.
-"RTN","C0CMAIL3",273,0)
- S D1=0
-"RTN","C0CMAIL3",274,0)
- F  S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1  D   Q:D1=""
-"RTN","C0CMAIL3",275,0)
- . N I,T
-"RTN","C0CMAIL3",276,0)
- . S T=$P($G(^XMB(3.9,D0,1,D1,0)),U)
-"RTN","C0CMAIL3",277,0)
- . S:T T=$P($G(^VA(200,T,0)),"^")
-"RTN","C0CMAIL3",278,0)
- . S LST("TO",+D1)=T
-"RTN","C0CMAIL3",279,0)
- . S T=$G(^XMB(3.9,D0,6,+D1,0))
-"RTN","C0CMAIL3",280,0)
- . S:T="" T=$P($G(^VA(200,+T,0)),"^")
-"RTN","C0CMAIL3",281,0)
- . S:T="" T="<Unknown>"
-"RTN","C0CMAIL3",282,0)
- . S LST("TO NAME",D1)=T
-"RTN","C0CMAIL3",283,0)
- .QUIT
-"RTN","C0CMAIL3",284,0)
- ; Get the Header for the message and store as "HDR"
-"RTN","C0CMAIL3",285,0)
- S D1=0,SGC=0
-"RTN","C0CMAIL3",286,0)
- F I=1:1 S D1=$O(^XMB(3.9,D0,2,D1)) Q:D1=""  Q:(D1>.99999)   D
-"RTN","C0CMAIL3",287,0)
- . S LST("HDR",I)=$G(^XMB(3.9,D0,2,D1,0))
-"RTN","C0CMAIL3",288,0)
- .QUIT
-"RTN","C0CMAIL3",289,0)
- N BNDRY,STKL,SEG
-"RTN","C0CMAIL3",290,0)
- S STKL=0,SEG=0
-"RTN","C0CMAIL3",291,0)
- ; Find boundaries and map them
-"RTN","C0CMAIL3",292,0)
- S D1=0
-"RTN","C0CMAIL3",293,0)
+"RTN","C0CMAIL3",327,0)
+ ; Start walking the TEXT/XML/64-BIT ENCODING sections of the message
+"RTN","C0CMAIL3",328,0)
+ N A,B,C,STACK,STYP,SEG,AX
+"RTN","C0CMAIL3",329,0)
+ S D1=.99999,SGC=0
+"RTN","C0CMAIL3",330,0)
  F  S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1  D
-"RTN","C0CMAIL3",294,0)
+"RTN","C0CMAIL3",331,0)
  . ; Clear any control characters (cr/lf/ff) off
-"RTN","C0CMAIL3",295,0)
+"RTN","C0CMAIL3",332,0)
  . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
-"RTN","C0CMAIL3",296,0)
- . ; Look for " boundary=" in the various parts.  Map the establishment and the 
-"RTN","C0CMAIL3",297,0)
- . ;  terminator markers and the actual boundary markers.
-"RTN","C0CMAIL3",298,0)
- . I X[" boundary=" D  Q
-"RTN","C0CMAIL3",299,0)
- . . S SEP=$P(X," boundary=",2)
-"RTN","C0CMAIL3",300,0)
- . . S:$E(SEP)="""" SEP=$TR(SEP,"""")
-"RTN","C0CMAIL3",301,0)
- . . S STKL=STKL+1
-"RTN","C0CMAIL3",302,0)
- . . S END=SEP_FLG
-"RTN","C0CMAIL3",303,0)
- . . S BNDRY(STKL,SEP)=0
-"RTN","C0CMAIL3",304,0)
- . . S BNDRX(SEP)=STKL,BNDRZ(END)=0
-"RTN","C0CMAIL3",305,0)
- . .QUIT
-"RTN","C0CMAIL3",306,0)
+"RTN","C0CMAIL3",333,0)
  . ;
-"RTN","C0CMAIL3",307,0)
- . ; Look for information as to how amy boudaries are present and where
-"RTN","C0CMAIL3",308,0)
- . ;   they terminate
-"RTN","C0CMAIL3",309,0)
- . D:X'=""&($E(X,1,2)="--")&($E(X,$L(X)-1,9999)'="--")
-"RTN","C0CMAIL3",310,0)
- . . ; Boundary Found
-"RTN","C0CMAIL3",311,0)
- . . I $D(BNDRX(X)) D  Q
-"RTN","C0CMAIL3",312,0)
- . . . S SEG=SEG+1
-"RTN","C0CMAIL3",313,0)
- . . . S BNDRE(X)=$G(BNDRE(X))_D1_";"
-"RTN","C0CMAIL3",314,0)
- . . . S BND1(D1)=STKL_";B;"_SEG_";"_X
-"RTN","C0CMAIL3",315,0)
- . . . S BNDR(X,D1,"B")=STKL
-"RTN","C0CMAIL3",316,0)
- . . . I BNDRX(X)=X  D ERROR("ER13")
-"RTN","C0CMAIL3",317,0)
- . . .QUIT
-"RTN","C0CMAIL3",318,0)
+"RTN","C0CMAIL3",334,0)
+ . D
+"RTN","C0CMAIL3",335,0)
+ . . I $D(BND1(D1)) D BOUNDARY(X)    QUIT
+"RTN","C0CMAIL3",336,0)
  . . ;
-"RTN","C0CMAIL3",319,0)
- . . ; Boundary Terminator
-"RTN","C0CMAIL3",320,0)
- . . I $D(BNDRZ(X)) D  Q
-"RTN","C0CMAIL3",321,0)
- . . . S BNDR(X,D1,"E")=STKL
-"RTN","C0CMAIL3",322,0)
- . . . S BNDRZ(X)=BNDRZ(X)+1
-"RTN","C0CMAIL3",323,0)
- . . . S BND1(D1)=STKL_";E;"_SEG_";"_X
-"RTN","C0CMAIL3",324,0)
- . . . S SEG=SEG+1
-"RTN","C0CMAIL3",325,0)
- . . . I BNDRX(X)=X  D ERROR("ER14")
-"RTN","C0CMAIL3",326,0)
- . . . S STKL=STKL-1
-"RTN","C0CMAIL3",327,0)
- . . .QUIT
-"RTN","C0CMAIL3",328,0)
- . .QUIT
-"RTN","C0CMAIL3",329,0)
- .QUIT
-"RTN","C0CMAIL3",330,0)
- ; Start walking the TEXT/XML/64-BIT ENCODING sections of the message
-"RTN","C0CMAIL3",331,0)
- N A,B,C,STACK,STYP,SEG,AX
-"RTN","C0CMAIL3",332,0)
- S D1=.99999,SGC=0
-"RTN","C0CMAIL3",333,0)
- F  S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1  D
-"RTN","C0CMAIL3",334,0)
- . ; Clear any control characters (cr/lf/ff) off
-"RTN","C0CMAIL3",335,0)
- . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
-"RTN","C0CMAIL3",336,0)
- . ;
 "RTN","C0CMAIL3",337,0)
- . D
+ . . S DX=$O(BND1(D1))
 "RTN","C0CMAIL3",338,0)
- . . I $D(BND1(D1)) D BOUNDARY(X)    QUIT
+ . . I DX=""  D ERROR("ER15")   Q
 "RTN","C0CMAIL3",339,0)
  . . ;
 "RTN","C0CMAIL3",340,0)
- . . S DX=$O(BND1(D1))
+ . . ; Good situation, extract the parts for the section
 "RTN","C0CMAIL3",341,0)
- . . I DX=""  D ERROR("ER15")   Q
+ . . S A=$G(BND1(DX))
 "RTN","C0CMAIL3",342,0)
- . . ;
+ . . S STACK=+A,STYP=$P(A,";",2),SGC=$P(A,";",3),AX=$P(A,";",4,999)
 "RTN","C0CMAIL3",343,0)
- . . ; Good situation, extract the parts for the section
+ . .QUIT
 "RTN","C0CMAIL3",344,0)
- . . S A=$G(BND1(DX))
+ . ; Enter once to set the SEP to capture the separator
 "RTN","C0CMAIL3",345,0)
- . . S STACK=+A,STYP=$P(A,";",2),SGC=$P(A,";",3),AX=$P(A,";",4,999)
+ . ;
 "RTN","C0CMAIL3",346,0)
+ . ; A new SEGMENT separator is set, process original 
+"RTN","C0CMAIL3",347,0)
+ . I $D(BND1(X))  D  QUIT
+"RTN","C0CMAIL3",348,0)
+ . . ; Save Current Values
+"RTN","C0CMAIL3",349,0)
+ . . S LST("SEG",SGC,"SIZE")=BCN+$L(BF)
+"RTN","C0CMAIL3",350,0)
+ . . ;  Close this Segment and prepare to start a New Segment
+"RTN","C0CMAIL3",351,0)
+ . . S $P(LST("SEG",SGC),"^",1,2)=$P($G(LST("SEG",SGC)),"^",1)_"^"_(D1-1)
+"RTN","C0CMAIL3",352,0)
+ . . ;  Put the result in LST("SEG",SGC,"XML")
+"RTN","C0CMAIL3",353,0)
+ . . I $L(BF) D
+"RTN","C0CMAIL3",354,0)
+ . . . S ZN=1
+"RTN","C0CMAIL3",355,0)
+ . . . N I,T,TBF
+"RTN","C0CMAIL3",356,0)
+ . . . S TBF=BF
+"RTN","C0CMAIL3",357,0)
+ . . . F I=1:1:($L(TBF,"="))  D
+"RTN","C0CMAIL3",358,0)
+ . . . . S BF=$P(TBF,"=",I)_"="
+"RTN","C0CMAIL3",359,0)
+ . . . . I "="'[BF  D DECODER(.BF,.TYP)
+"RTN","C0CMAIL3",360,0)
+ . . . .QUIT
+"RTN","C0CMAIL3",361,0)
+ . . . S BF=""
+"RTN","C0CMAIL3",362,0)
+ . . .QUIT
+"RTN","C0CMAIL3",363,0)
+ . . S SGC=SGC+1,BCN=0
+"RTN","C0CMAIL3",364,0)
+ . . ; Incriment SGC to start a new Segment
+"RTN","C0CMAIL3",365,0)
+ . . S LST("SEG",SGC)=D1
+"RTN","C0CMAIL3",366,0)
  . .QUIT
-"RTN","C0CMAIL3",347,0)
- . ; Enter once to set the SEP to capture the separator
-"RTN","C0CMAIL3",348,0)
+"RTN","C0CMAIL3",367,0)
  . ;
-"RTN","C0CMAIL3",349,0)
- . ; A new SEGMENT separator is set, process original 
-"RTN","C0CMAIL3",350,0)
- . I $D(BND1(X))  D  QUIT
-"RTN","C0CMAIL3",351,0)
- . . ; Save Current Values
-"RTN","C0CMAIL3",352,0)
- . . S LST("SEG",SGC,"SIZE")=BCN+$L(BF)
-"RTN","C0CMAIL3",353,0)
- . . ;  Close this Segment and prepare to start a New Segment
-"RTN","C0CMAIL3",354,0)
- . . S $P(LST("SEG",SGC),"^",1,2)=$P($G(LST("SEG",SGC)),"^",1)_"^"_(D1-1)
-"RTN","C0CMAIL3",355,0)
- . . ;  Put the result in LST("SEG",SGC,"XML")
-"RTN","C0CMAIL3",356,0)
- . . I $L(BF) D
-"RTN","C0CMAIL3",357,0)
- . . . S ZN=1
-"RTN","C0CMAIL3",358,0)
- . . . N I,T,TBF
-"RTN","C0CMAIL3",359,0)
- . . . S TBF=BF
-"RTN","C0CMAIL3",360,0)
- . . . F I=1:1:($L(TBF,"="))  D
-"RTN","C0CMAIL3",361,0)
- . . . . S BF=$P(TBF,"=",I)_"="
-"RTN","C0CMAIL3",362,0)
- . . . . I "="'[BF  D DECODER(.BF,.TYP)
-"RTN","C0CMAIL3",363,0)
- . . . .QUIT
-"RTN","C0CMAIL3",364,0)
- . . . S BF=""
-"RTN","C0CMAIL3",365,0)
- . . .QUIT
-"RTN","C0CMAIL3",366,0)
- . . S SGC=SGC+1,BCN=0
-"RTN","C0CMAIL3",367,0)
- . . ; Incriment SGC to start a new Segment
 "RTN","C0CMAIL3",368,0)
- . . S LST("SEG",SGC)=D1
+ . ; Accumulate the 64 bit encoding, no spaces, or other non-64bit characters
 "RTN","C0CMAIL3",369,0)
- . .QUIT
+ . I X=$TR(X,MSK)&$L(X)  S BF=BF_X  QUIT
 "RTN","C0CMAIL3",370,0)
  . ;
 "RTN","C0CMAIL3",371,0)
- . ; Accumulate the 64 bit encoding, no spaces, or other non-64bit characters
+ . ; Ending Condition, close out the Segment
 "RTN","C0CMAIL3",372,0)
- . I X=$TR(X,MSK)&$L(X)  S BF=BF_X  QUIT
+ . I $D(BNDRZ(X)) D  QUIT
 "RTN","C0CMAIL3",373,0)
+ . . S $P(LST("SEG",SGC),"^",2)=D1-1
+"RTN","C0CMAIL3",374,0)
+ . . I $L(BF) S ZN=1 D DECODER(.BF,.TYP)  S BF="" Q
+"RTN","C0CMAIL3",375,0)
+ . .QUIT
+"RTN","C0CMAIL3",376,0)
  . ;
-"RTN","C0CMAIL3",374,0)
- . ; Ending Condition, close out the Segment
-"RTN","C0CMAIL3",375,0)
- . I $D(BNDRZ(X)) D  QUIT
-"RTN","C0CMAIL3",376,0)
- . . S $P(LST("SEG",SGC),"^",2)=D1-1
 "RTN","C0CMAIL3",377,0)
- . . I $L(BF) S ZN=1 D DECODER(.BF,.TYP)  S BF="" Q
+ . ; Accumulate the content lines of the message
 "RTN","C0CMAIL3",378,0)
+ . S BCN=BCN+$L(X)
+"RTN","C0CMAIL3",379,0)
+ . ; Split out the Content Info
+"RTN","C0CMAIL3",380,0)
+ . I X[CON D  Q
+"RTN","C0CMAIL3",381,0)
+ . . S J=$P(X,CON,2)
+"RTN","C0CMAIL3",382,0)
+ . . S TYP="CONTENT"
+"RTN","C0CMAIL3",383,0)
+ . . S LST("SEG",SGC,TYP,$P(J,":"))=$P(J,":",2,9)
+"RTN","C0CMAIL3",384,0)
+ . . D CONTENT(D1)
+"RTN","C0CMAIL3",385,0)
  . .QUIT
-"RTN","C0CMAIL3",379,0)
+"RTN","C0CMAIL3",386,0)
  . ;
-"RTN","C0CMAIL3",380,0)
- . ; Accumulate the content lines of the message
-"RTN","C0CMAIL3",381,0)
- . S BCN=BCN+$L(X)
-"RTN","C0CMAIL3",382,0)
- . ; Split out the Content Info
-"RTN","C0CMAIL3",383,0)
- . I X[CON D  Q
-"RTN","C0CMAIL3",384,0)
- . . S J=$P(X,CON,2)
-"RTN","C0CMAIL3",385,0)
- . . S TYP="CONTENT"
-"RTN","C0CMAIL3",386,0)
- . . S LST("SEG",SGC,TYP,$P(J,":"))=$P(J,":",2,9)
 "RTN","C0CMAIL3",387,0)
- . . D CONTENT(D1)
+ . ; Everything else is Text, Check for CCR/CCD.
 "RTN","C0CMAIL3",388,0)
+ . N KK,UBF
+"RTN","C0CMAIL3",389,0)
+ . D
+"RTN","C0CMAIL3",390,0)
+ . . S UBF=$$UPPER(X)
+"RTN","C0CMAIL3",391,0)
+ . . I UBF["<CONTINUITYOFCARERECORD"   S $P(LST("SEG",SGC),U,3)="CCR" Q
+"RTN","C0CMAIL3",392,0)
+ . . ;
+"RTN","C0CMAIL3",393,0)
+ . . I UBF["<CLINICALDOCUMENT"         S $P(LST("SEG",SGC),U,3)="CCD" Q
+"RTN","C0CMAIL3",394,0)
  . .QUIT
-"RTN","C0CMAIL3",389,0)
+"RTN","C0CMAIL3",395,0)
+ . ; Look for directives in the text before it gets published
+"RTN","C0CMAIL3",396,0)
+ . ;  Look for "=3D" and replace it with a single "=".  I can do more parsing
+"RTN","C0CMAIL3",397,0)
+ . ;  but there may be situations where the line has been wrapped.
+"RTN","C0CMAIL3",398,0)
+ . D:X["=3D"
+"RTN","C0CMAIL3",399,0)
+ . . F KK=1:1 S X=$P(X,"=3D",1)_"="_$P(X,"=3D",2,999) Q:X'["=3D"
+"RTN","C0CMAIL3",400,0)
+ . .QUIT
+"RTN","C0CMAIL3",401,0)
+ . S LST("SEG",SGC,TYP,D1)=X
+"RTN","C0CMAIL3",402,0)
+ .QUIT
+"RTN","C0CMAIL3",403,0)
+ QUIT
+"RTN","C0CMAIL3",404,0)
+ ;  ===================
+"RTN","C0CMAIL3",405,0)
+CONTENT(D1) ; Try pulling Content Statements
+"RTN","C0CMAIL3",406,0)
+ N J,UP,X
+"RTN","C0CMAIL3",407,0)
+ S X=$G(^XMB(3.9,D0,2,D1,0))
+"RTN","C0CMAIL3",408,0)
+ S J=$P(X,CON,2)
+"RTN","C0CMAIL3",409,0)
+ S UP=$TR($$UPPER(X),"""")
+"RTN","C0CMAIL3",410,0)
+ S:$G(TYP)="" TYP="TXT"
+"RTN","C0CMAIL3",411,0)
+ D
+"RTN","C0CMAIL3",412,0)
+ . I UP["NAME=",($L(UP,".")>1) S TYP=$P(UP,".",2) Q
+"RTN","C0CMAIL3",413,0)
+ . I UP["XML" S TYP="XML"                         Q
+"RTN","C0CMAIL3",414,0)
+ . I UP["P7S" S TYP="P7S"                         Q
+"RTN","C0CMAIL3",415,0)
+ . I J[" boundary=" D BOUNDARY(J)
+"RTN","C0CMAIL3",416,0)
+ .QUIT
+"RTN","C0CMAIL3",417,0)
+ S LIS("CON",SGC,D1)=X
+"RTN","C0CMAIL3",418,0)
+ S LIS("CON",SGC,D1,"TYP")=TYP
+"RTN","C0CMAIL3",419,0)
+ ; If there is a follow-on, look for another line after this.
+"RTN","C0CMAIL3",420,0)
+ I $E($RE(X),1)=";"   D CONTENT(D1+1)
+"RTN","C0CMAIL3",421,0)
+ QUIT
+"RTN","C0CMAIL3",422,0)
+ ;  ===================
+"RTN","C0CMAIL3",423,0)
+BOUNDARY(X) ; Set an additional BOUNDARY, and activate another stack level
+"RTN","C0CMAIL3",424,0)
+ S SEP=$P($P(X," boundary=",2),"""",2),END=SEP_FLG
+"RTN","C0CMAIL3",425,0)
+ Q:SEP?2"-".ANP
+"RTN","C0CMAIL3",426,0)
+ ;
+"RTN","C0CMAIL3",427,0)
+ D ERROR("ER11")
+"RTN","C0CMAIL3",428,0)
+ Q:SEP'[" "
+"RTN","C0CMAIL3",429,0)
+ ;
+"RTN","C0CMAIL3",430,0)
+ D ERROR("ER12")
+"RTN","C0CMAIL3",431,0)
+ QUIT
+"RTN","C0CMAIL3",432,0)
+ ;  ===================
+"RTN","C0CMAIL3",433,0)
+ ; Break down the Buffer Array so it can be saved.
+"RTN","C0CMAIL3",434,0)
+ ;  BF is passed in.
+"RTN","C0CMAIL3",435,0)
+ ;  TYP is the type of 
+"RTN","C0CMAIL3",436,0)
+DECODER(BF,TYP) ; 
+"RTN","C0CMAIL3",437,0)
+ N RCNT,TBF,UBF,ZBF,ZI,ZJ,ZK,ZSIZE
+"RTN","C0CMAIL3",438,0)
+ S:$G(TYP)="" TYP="XML"
+"RTN","C0CMAIL3",439,0)
+ S ZBF=BF
+"RTN","C0CMAIL3",440,0)
+ ;  Full Buffer, BF, now check for Encryption and Unpack
+"RTN","C0CMAIL3",441,0)
+ F RCNT=1:1:$L(ZBF,"=")   D
+"RTN","C0CMAIL3",442,0)
+ . N BF
+"RTN","C0CMAIL3",443,0)
+ . S BF=$P(ZBF,"=",RCNT)
+"RTN","C0CMAIL3",444,0)
+ . ;  Unpacking the 64 bit encoding
+"RTN","C0CMAIL3",445,0)
+ . S TBF=$TR($$DECODE^RGUTUU(BF),$C(10,12,13))
+"RTN","C0CMAIL3",446,0)
+ . D:$L(TBF)
+"RTN","C0CMAIL3",447,0)
+ . . N C,OK,OKCNT,KK,XBF,UBF
+"RTN","C0CMAIL3",448,0)
+ . . D
+"RTN","C0CMAIL3",449,0)
+ . . . S UBF=$$UPPER(TBF)
+"RTN","C0CMAIL3",450,0)
+ . . . I UBF["<CONTINUITYOFCARERECORD XMLNS=" S $P(LST("SEG",SGC),U,3)="CCR" Q
+"RTN","C0CMAIL3",451,0)
+ . . . ;
+"RTN","C0CMAIL3",452,0)
+ . . . I UBF["<CLINICALDOCUMENT XMLNS="       S $P(LST("SEG",SGC),U,3)="CCD" Q
+"RTN","C0CMAIL3",453,0)
+ . . .QUIT
+"RTN","C0CMAIL3",454,0)
+ . . ; Check for Bad Signature Decoding, after 100 bad characters
+"RTN","C0CMAIL3",455,0)
+ . . S OK=1,OKCNT=0
+"RTN","C0CMAIL3",456,0)
+ . . F KK=1:1:$L(UBF) S C=$A(UBF,KK) S:C>126 OKCNT=OKCNT+1 I OKCNT>100 S OK=0 Q
+"RTN","C0CMAIL3",457,0)
+ . . ;
+"RTN","C0CMAIL3",458,0)
+ . . D
+"RTN","C0CMAIL3",459,0)
+ . . . I 'OK S (BF,UBF,TBF,XBF)="<Crypto-Signature redacted>" Q
+"RTN","C0CMAIL3",460,0)
+ . . . ;
+"RTN","C0CMAIL3",461,0)
+ . . . S BF=BF_"="
+"RTN","C0CMAIL3",462,0)
+ . . . D NORMAL(.XBF,.TBF)
+"RTN","C0CMAIL3",463,0)
+ . . .QUIT
+"RTN","C0CMAIL3",464,0)
+ . . M LST("SEG",SGC,TYP,RCNT)=XBF
+"RTN","C0CMAIL3",465,0)
+ . .QUIT
+"RTN","C0CMAIL3",466,0)
+ .QUIT
+"RTN","C0CMAIL3",467,0)
+ QUIT
+"RTN","C0CMAIL3",468,0)
+ ;  ===================
+"RTN","C0CMAIL3",469,0)
+ ;  OUTXML = OUTBF  = OUT   = OUTPUT ARRAY TO BE BUILT
+"RTN","C0CMAIL3",470,0)
+ ;  BF     = INXML = INPUT ARRAY TO PROVIDE INPUT
+"RTN","C0CMAIL3",471,0)
+ ;   >D NORMAL^C0CMAIL(.OUT,BF)
+"RTN","C0CMAIL3",472,0)
+NORMAL(OUTXML,INXML)    ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
+"RTN","C0CMAIL3",473,0)
+ ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
+"RTN","C0CMAIL3",474,0)
+ ;
+"RTN","C0CMAIL3",475,0)
+ N ZN,OUTBF,XX,ZSEP
+"RTN","C0CMAIL3",476,0)
+ S INXML=$TR(INXML,$C(10,12,13))
+"RTN","C0CMAIL3",477,0)
+ S ZN=1,ZSEP=">"
+"RTN","C0CMAIL3",478,0)
+ S OUTBF(1)=$P(INXML,"><",1)_ZSEP,XX="<"_$P(INXML,"><",2)_ZSEP,ZN=2,ZL=1
+"RTN","C0CMAIL3",479,0)
+ F ZN=ZN+1:1:$L(INXML,"><")  D   Q:XX=""
+"RTN","C0CMAIL3",480,0)
+ . S XX=$P(INXML,"><",ZN)
+"RTN","C0CMAIL3",481,0)
+ . S:$E($RE(XX))=">" ZSEP=""
+"RTN","C0CMAIL3",482,0)
+ . Q:XX=""
+"RTN","C0CMAIL3",483,0)
  . ;
-"RTN","C0CMAIL3",390,0)
- . ; Everything else is Text, Check for CCR/CCD.
-"RTN","C0CMAIL3",391,0)
- . N KK,UBF
-"RTN","C0CMAIL3",392,0)
+"RTN","C0CMAIL3",484,0)
+ . S XX="<"_XX_ZSEP
+"RTN","C0CMAIL3",485,0)
  . D
-"RTN","C0CMAIL3",393,0)
- . . S UBF=$$UPPER(X)
-"RTN","C0CMAIL3",394,0)
- . . I UBF["<CONTINUITYOFCARERECORD"   S $P(LST("SEG",SGC),U,3)="CCR" Q
-"RTN","C0CMAIL3",395,0)
+"RTN","C0CMAIL3",486,0)
+ . . I $L(XX)<4000 S OUTBF(ZL)=XX,XX=$P(INXML,"><",ZN),ZL=ZL+1   Q
+"RTN","C0CMAIL3",487,0)
  . . ;
-"RTN","C0CMAIL3",396,0)
- . . I UBF["<CLINICALDOCUMENT"         S $P(LST("SEG",SGC),U,3)="CCD" Q
-"RTN","C0CMAIL3",397,0)
+"RTN","C0CMAIL3",488,0)
+ . . D ERROR("ER05")
+"RTN","C0CMAIL3",489,0)
+ . . F ZL=ZL+1:1 D   Q:XX=""
+"RTN","C0CMAIL3",490,0)
+ . . .  N XL
+"RTN","C0CMAIL3",491,0)
+ . . .  S XL=$E(XX,1,4000)
+"RTN","C0CMAIL3",492,0)
+ . . .  S $E(XX,1,4000)=""   ; S XX=$E(XX,4001,999999) ; Remove 4K characters
+"RTN","C0CMAIL3",493,0)
+ . . .  S OUTBF(ZL)=XL
+"RTN","C0CMAIL3",494,0)
+ . . .QUIT
+"RTN","C0CMAIL3",495,0)
  . .QUIT
-"RTN","C0CMAIL3",398,0)
- . ; Look for directives in the text before it gets published
-"RTN","C0CMAIL3",399,0)
- . ;  Look for "=3D" and replace it with a single "=".  I can do more parsing
-"RTN","C0CMAIL3",400,0)
- . ;  but there may be situations where the line has been wrapped.
-"RTN","C0CMAIL3",401,0)
- . D:X["=3D"
-"RTN","C0CMAIL3",402,0)
- . . F KK=1:1 S X=$P(X,"=3D",1)_"="_$P(X,"=3D",2,999) Q:X'["=3D"
-"RTN","C0CMAIL3",403,0)
- . .QUIT
-"RTN","C0CMAIL3",404,0)
- . S LST("SEG",SGC,TYP,D1)=X
-"RTN","C0CMAIL3",405,0)
+"RTN","C0CMAIL3",496,0)
  .QUIT
-"RTN","C0CMAIL3",406,0)
+"RTN","C0CMAIL3",497,0)
+ M OUTXML=OUTBF
+"RTN","C0CMAIL3",498,0)
  QUIT
-"RTN","C0CMAIL3",407,0)
+"RTN","C0CMAIL3",499,0)
  ;  ===================
-"RTN","C0CMAIL3",408,0)
-CONTENT(D1) ; Try pulling Content Statements
-"RTN","C0CMAIL3",409,0)
- N J,UP,X
-"RTN","C0CMAIL3",410,0)
- S X=$G(^XMB(3.9,D0,2,D1,0))
-"RTN","C0CMAIL3",411,0)
- S J=$P(X,CON,2)
-"RTN","C0CMAIL3",412,0)
- S UP=$TR($$UPPER(X),"""")
-"RTN","C0CMAIL3",413,0)
- S:$G(TYP)="" TYP="TXT"
-"RTN","C0CMAIL3",414,0)
- D
-"RTN","C0CMAIL3",415,0)
- . I UP["NAME=",($L(UP,".")>1) S TYP=$P(UP,".",2) Q
-"RTN","C0CMAIL3",416,0)
- . I UP["XML" S TYP="XML"                         Q
-"RTN","C0CMAIL3",417,0)
- . I UP["P7S" S TYP="P7S"                         Q
-"RTN","C0CMAIL3",418,0)
- . I J[" boundary=" D BOUNDARY(J)
-"RTN","C0CMAIL3",419,0)
- .QUIT
-"RTN","C0CMAIL3",420,0)
- S LIS("CON",SGC,D1)=X
-"RTN","C0CMAIL3",421,0)
- S LIS("CON",SGC,D1,"TYP")=TYP
-"RTN","C0CMAIL3",422,0)
- ; If there is a follow-on, look for another line after this.
-"RTN","C0CMAIL3",423,0)
- I $E($RE(X),1)=";"   D CONTENT(D1+1)
-"RTN","C0CMAIL3",424,0)
- QUIT
-"RTN","C0CMAIL3",425,0)
- ;  ===================
-"RTN","C0CMAIL3",426,0)
-BOUNDARY(X) ; Set an additional BOUNDARY, and activate another stack level
-"RTN","C0CMAIL3",427,0)
- S SEP=$P($P(X," boundary=",2),"""",2),END=SEP_FLG
-"RTN","C0CMAIL3",428,0)
- Q:SEP?2"-".ANP
-"RTN","C0CMAIL3",429,0)
- ;
-"RTN","C0CMAIL3",430,0)
- D ERROR("ER11")
-"RTN","C0CMAIL3",431,0)
- Q:SEP'[" "
-"RTN","C0CMAIL3",432,0)
- ;
-"RTN","C0CMAIL3",433,0)
- D ERROR("ER12")
-"RTN","C0CMAIL3",434,0)
- QUIT
-"RTN","C0CMAIL3",435,0)
- ;  ===================
-"RTN","C0CMAIL3",436,0)
- ; Break down the Buffer Array so it can be saved.
-"RTN","C0CMAIL3",437,0)
- ;  BF is passed in.
-"RTN","C0CMAIL3",438,0)
- ;  TYP is the type of 
-"RTN","C0CMAIL3",439,0)
-DECODER(BF,TYP) ; 
-"RTN","C0CMAIL3",440,0)
- N RCNT,TBF,UBF,ZBF,ZI,ZJ,ZK,ZSIZE
-"RTN","C0CMAIL3",441,0)
- S:$G(TYP)="" TYP="XML"
-"RTN","C0CMAIL3",442,0)
- S ZBF=BF
-"RTN","C0CMAIL3",443,0)
- ;  Full Buffer, BF, now check for Encryption and Unpack
-"RTN","C0CMAIL3",444,0)
- F RCNT=1:1:$L(ZBF,"=")   D
-"RTN","C0CMAIL3",445,0)
- . N BF
-"RTN","C0CMAIL3",446,0)
- . S BF=$P(ZBF,"=",RCNT)
-"RTN","C0CMAIL3",447,0)
- . ;  Unpacking the 64 bit encoding
-"RTN","C0CMAIL3",448,0)
- . S TBF=$TR($$DECODE^RGUTUU(BF),$C(10,12,13))
-"RTN","C0CMAIL3",449,0)
- . D:$L(TBF)
-"RTN","C0CMAIL3",450,0)
- . . N C,OK,OKCNT,KK,XBF,UBF
-"RTN","C0CMAIL3",451,0)
- . . D
-"RTN","C0CMAIL3",452,0)
- . . . S UBF=$$UPPER(TBF)
-"RTN","C0CMAIL3",453,0)
- . . . I UBF["<CONTINUITYOFCARERECORD XMLNS=" S $P(LST("SEG",SGC),U,3)="CCR" Q
-"RTN","C0CMAIL3",454,0)
- . . . ;
-"RTN","C0CMAIL3",455,0)
- . . . I UBF["<CLINICALDOCUMENT XMLNS="       S $P(LST("SEG",SGC),U,3)="CCD" Q
-"RTN","C0CMAIL3",456,0)
- . . .QUIT
-"RTN","C0CMAIL3",457,0)
- . . ; Check for Bad Signature Decoding, after 100 bad characters
-"RTN","C0CMAIL3",458,0)
- . . S OK=1,OKCNT=0
-"RTN","C0CMAIL3",459,0)
- . . F KK=1:1:$L(UBF) S C=$A(UBF,KK) S:C>126 OKCNT=OKCNT+1 I OKCNT>100 S OK=0 Q
-"RTN","C0CMAIL3",460,0)
- . . ;
-"RTN","C0CMAIL3",461,0)
- . . D
-"RTN","C0CMAIL3",462,0)
- . . . I 'OK S (BF,UBF,TBF,XBF)="<Crypto-Signature redacted>" Q
-"RTN","C0CMAIL3",463,0)
- . . . ;
-"RTN","C0CMAIL3",464,0)
- . . . S BF=BF_"="
-"RTN","C0CMAIL3",465,0)
- . . . D NORMAL(.XBF,.TBF)
-"RTN","C0CMAIL3",466,0)
- . . .QUIT
-"RTN","C0CMAIL3",467,0)
- . . M LST("SEG",SGC,TYP,RCNT)=XBF
-"RTN","C0CMAIL3",468,0)
- . .QUIT
-"RTN","C0CMAIL3",469,0)
- .QUIT
-"RTN","C0CMAIL3",470,0)
- QUIT
-"RTN","C0CMAIL3",471,0)
- ;  ===================
-"RTN","C0CMAIL3",472,0)
- ;  OUTXML = OUTBF  = OUT   = OUTPUT ARRAY TO BE BUILT
-"RTN","C0CMAIL3",473,0)
- ;  BF     = INXML = INPUT ARRAY TO PROVIDE INPUT
-"RTN","C0CMAIL3",474,0)
- ;   >D NORMAL^C0CMAIL(.OUT,BF)
-"RTN","C0CMAIL3",475,0)
-NORMAL(OUTXML,INXML)    ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
-"RTN","C0CMAIL3",476,0)
- ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
-"RTN","C0CMAIL3",477,0)
- ;
-"RTN","C0CMAIL3",478,0)
- N ZN,OUTBF,XX,ZSEP
-"RTN","C0CMAIL3",479,0)
- S INXML=$TR(INXML,$C(10,12,13))
-"RTN","C0CMAIL3",480,0)
- S ZN=1,ZSEP=">"
-"RTN","C0CMAIL3",481,0)
- S OUTBF(1)=$P(INXML,"><",1)_ZSEP,XX="<"_$P(INXML,"><",2)_ZSEP,ZN=2,ZL=1
-"RTN","C0CMAIL3",482,0)
- F ZN=ZN+1:1:$L(INXML,"><")  D   Q:XX=""
-"RTN","C0CMAIL3",483,0)
- . S XX=$P(INXML,"><",ZN)
-"RTN","C0CMAIL3",484,0)
- . S:$E($RE(XX))=">" ZSEP=""
-"RTN","C0CMAIL3",485,0)
- . Q:XX=""
-"RTN","C0CMAIL3",486,0)
- . ;
-"RTN","C0CMAIL3",487,0)
- . S XX="<"_XX_ZSEP
-"RTN","C0CMAIL3",488,0)
- . D
-"RTN","C0CMAIL3",489,0)
- . . I $L(XX)<4000 S OUTBF(ZL)=XX,XX=$P(INXML,"><",ZN),ZL=ZL+1   Q
-"RTN","C0CMAIL3",490,0)
- . . ;
-"RTN","C0CMAIL3",491,0)
- . . D ERROR("ER05")
-"RTN","C0CMAIL3",492,0)
- . . F ZL=ZL+1:1 D   Q:XX=""
-"RTN","C0CMAIL3",493,0)
- . . .  N XL
-"RTN","C0CMAIL3",494,0)
- . . .  S XL=$E(XX,1,4000)
-"RTN","C0CMAIL3",495,0)
- . . .  S $E(XX,1,4000)=""   ; S XX=$E(XX,4001,999999) ; Remove 4K characters
-"RTN","C0CMAIL3",496,0)
- . . .  S OUTBF(ZL)=XL
-"RTN","C0CMAIL3",497,0)
- . . .QUIT
-"RTN","C0CMAIL3",498,0)
- . .QUIT
-"RTN","C0CMAIL3",499,0)
- .QUIT
 "RTN","C0CMAIL3",500,0)
- M OUTXML=OUTBF
+UPPER(X) ; Convert any lowercase letters to Uppercase letters
 "RTN","C0CMAIL3",501,0)
- QUIT
+ QUIT $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
 "RTN","C0CMAIL3",502,0)
  ;  ===================
 "RTN","C0CMAIL3",503,0)
-UPPER(X) ; Convert any lowercase letters to Uppercase letters
+ ; EN is a counter that remains between error events
 "RTN","C0CMAIL3",504,0)
- QUIT $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+ERROR(ER) ; Error Handler
 "RTN","C0CMAIL3",505,0)
+ N TXXQ,XXXQ
+"RTN","C0CMAIL3",506,0)
+ S XXXQ="Unknown Error Encountered = "_ER
+"RTN","C0CMAIL3",507,0)
+ S TXXQ=$P($T(@(ER_"^"_$T(+0))),";;",2,99)
+"RTN","C0CMAIL3",508,0)
+ I TXXQ'=""  D
+"RTN","C0CMAIL3",509,0)
+ . I TXXQ["_" X "S TXXQ="_TXXQ
+"RTN","C0CMAIL3",510,0)
+ . S XXXQ=TXXQ
+"RTN","C0CMAIL3",511,0)
+ .QUIT
+"RTN","C0CMAIL3",512,0)
+ S EN(ER)=$G(EN(ER))+1
+"RTN","C0CMAIL3",513,0)
+ S LST("ERR",ER,EN(ER))=XXXQ
+"RTN","C0CMAIL3",514,0)
+ QUIT
+"RTN","C0CMAIL3",515,0)
  ;  ===================
-"RTN","C0CMAIL3",506,0)
- ; EN is a counter that remains between error events
-"RTN","C0CMAIL3",507,0)
-ERROR(ER) ; Error Handler
-"RTN","C0CMAIL3",508,0)
- N TXXQ,XXXQ
-"RTN","C0CMAIL3",509,0)
- S XXXQ="Unknown Error Encountered = "_ER
-"RTN","C0CMAIL3",510,0)
- S TXXQ=$P($T(@(ER_"^"_$T(+0))),";;",2,99)
-"RTN","C0CMAIL3",511,0)
- I TXXQ'=""  D
-"RTN","C0CMAIL3",512,0)
- . I TXXQ["_" X "S TXXQ="_TXXQ
-"RTN","C0CMAIL3",513,0)
- . S XXXQ=TXXQ
-"RTN","C0CMAIL3",514,0)
- .QUIT
-"RTN","C0CMAIL3",515,0)
- S EN(ER)=$G(EN(ER))+1
 "RTN","C0CMAIL3",516,0)
- S LST("ERR",ER,EN(ER))=XXXQ
+ER01 ;;Message Missing
 "RTN","C0CMAIL3",517,0)
+ER02 ;;Message Text Missing
+"RTN","C0CMAIL3",518,0)
+ER03 ;;Message Not Identifiable
+"RTN","C0CMAIL3",519,0)
+ER04 ;;Segment is too large
+"RTN","C0CMAIL3",520,0)
+ER05 ;;Mailbox Missing
+"RTN","C0CMAIL3",521,0)
+ER06 ;;"User Missing = "_$G(DUZ)
+"RTN","C0CMAIL3",522,0)
+ER07 ;;"Bad DUZ = "_DUZ
+"RTN","C0CMAIL3",523,0)
+ER08 ;;"Bad Basket ID = "_MBLST_" >> "_$G(TN)
+"RTN","C0CMAIL3",524,0)
+ER10 ;;"Bad Separator found = "_X
+"RTN","C0CMAIL3",525,0)
+ER11 ;;"Non-Standard Separator Found:>"_$G(J)
+"RTN","C0CMAIL3",526,0)
+ER12 ;;"Spaces are not allowed in Separators:>"_$G(J)
+"RTN","C0CMAIL3",527,0)
+ER13 ;;"Bad Stack Level Detected >"_STKL_":"_BNDRY(X)_":"_X
+"RTN","C0CMAIL3",528,0)
+ ;  vvvvvvvvvvvvvvv  Not Needed  vvvvvvvvvvvvvvvvvvvvvvvvvv
+"RTN","C0CMAIL3",529,0)
+ ;  End note if needed
+"RTN","C0CMAIL3",530,0)
  QUIT
-"RTN","C0CMAIL3",518,0)
- ;  ===================
-"RTN","C0CMAIL3",519,0)
-ER01 ;;Message Missing
-"RTN","C0CMAIL3",520,0)
-ER02 ;;Message Text Missing
-"RTN","C0CMAIL3",521,0)
-ER03 ;;Message Not Identifiable
-"RTN","C0CMAIL3",522,0)
-ER04 ;;Segment is too large
-"RTN","C0CMAIL3",523,0)
-ER05 ;;Mailbox Missing
-"RTN","C0CMAIL3",524,0)
-ER06 ;;"User Missing = "_$G(DUZ)
-"RTN","C0CMAIL3",525,0)
-ER07 ;;"Bad DUZ = "_DUZ
-"RTN","C0CMAIL3",526,0)
-ER08 ;;"Bad Basket ID = "_MBLST_" >> "_$G(TN)
-"RTN","C0CMAIL3",527,0)
-ER10 ;;"Bad Separator found = "_X
-"RTN","C0CMAIL3",528,0)
-ER11 ;;"Non-Standard Separator Found:>"_$G(J)
-"RTN","C0CMAIL3",529,0)
-ER12 ;;"Spaces are not allowed in Separators:>"_$G(J)
-"RTN","C0CMAIL3",530,0)
-ER13 ;;"Bad Stack Level Detected >"_STKL_":"_BNDRY(X)_":"_X
 "RTN","C0CMAIL3",531,0)
- ;  vvvvvvvvvvvvvvv  Not Needed  vvvvvvvvvvvvvvvvvvvvvvvvvv
-"RTN","C0CMAIL3",532,0)
- ;  End note if needed
-"RTN","C0CMAIL3",533,0)
- QUIT
-"RTN","C0CMAIL3",534,0)
  ;  ===================
 "RTN","C0CMCCD")
-0^84^B73168233
+0^84^B71988241
 "RTN","C0CMCCD",1,0)
 C0CMCCD   ; GPL - MXML based CCD utilities;12/04/09  17:05
 "RTN","C0CMCCD",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CMCCD",3,0)
- ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
+ ;Copyright 2009 George Lilly.  
 "RTN","C0CMCCD",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CMCCD",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CMCCD",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CMCCD",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CMCCD",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CMCCD",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CMCCD",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CMCCD",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CMCCD",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CMCCD",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CMCCD",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CMCCD",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CMCCD",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CMCCD",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CMCCD",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ Q
 "RTN","C0CMCCD",19,0)
  ;
 "RTN","C0CMCCD",20,0)
+PARSCCD(DOC,OPTION) ; THIS WAS COPIED FROM EN^MXMLDOM TO CUSTIMIZE FOR 
+"RTN","C0CMCCD",21,0)
+ ; PROCESSING CCDS 
+"RTN","C0CMCCD",22,0)
+ N CBK,SUCCESS,LEVEL,NODE,HANDLE
+"RTN","C0CMCCD",23,0)
+ K ^TMP("MXMLERR",$J)
+"RTN","C0CMCCD",24,0)
+ L +^TMP("MXMLDOM",$J):5
+"RTN","C0CMCCD",25,0)
+ E  Q 0
+"RTN","C0CMCCD",26,0)
+ S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)=""
+"RTN","C0CMCCD",27,0)
+ L -^TMP("MXMLDOM",$J)
+"RTN","C0CMCCD",28,0)
+ S CBK("STARTELEMENT")="STARTELE^C0CMCCD" ; ONLY THIS ONE IS CHANGED ;GPL
+"RTN","C0CMCCD",29,0)
+ S CBK("ENDELEMENT")="ENDELE^MXMLDOM"
+"RTN","C0CMCCD",30,0)
+ S CBK("COMMENT")="COMMENT^MXMLDOM"
+"RTN","C0CMCCD",31,0)
+ S CBK("CHARACTERS")="CHAR^MXMLDOM"
+"RTN","C0CMCCD",32,0)
+ S CBK("ENDDOCUMENT")="ENDDOC^MXMLDOM"
+"RTN","C0CMCCD",33,0)
+ S CBK("ERROR")="ERROR^MXMLDOM"
+"RTN","C0CMCCD",34,0)
+ S (SUCCESS,LEVEL,LEVEL(0),NODE)=0,OPTION=$G(OPTION,"V1")
+"RTN","C0CMCCD",35,0)
+ D EN^MXMLPRSE(DOC,.CBK,OPTION)
+"RTN","C0CMCCD",36,0)
+ D:'SUCCESS DELETE^MXMLDOM(HANDLE)
+"RTN","C0CMCCD",37,0)
+ Q $S(SUCCESS:HANDLE,1:0)
+"RTN","C0CMCCD",38,0)
+ ; Start element
+"RTN","C0CMCCD",39,0)
+ ; Create new child node and push info on stack
+"RTN","C0CMCCD",40,0)
+STARTELE(ELE,ATTR) ; COPIED FROM STARTELE^MXMLDOM AND MODIFIED TO TREAT
+"RTN","C0CMCCD",41,0)
+ ; ATTRIBUTES AS SUBELEMENTS TO MAKE CCD XPATH PROCESSING EASIER
+"RTN","C0CMCCD",42,0)
+ N PARENT
+"RTN","C0CMCCD",43,0)
+ S PARENT=LEVEL(LEVEL),NODE=NODE+1
+"RTN","C0CMCCD",44,0)
+ S:PARENT ^TMP("MXMLDOM",$J,HANDLE,PARENT,"C",NODE)=ELE
+"RTN","C0CMCCD",45,0)
+ S LEVEL=LEVEL+1,LEVEL(LEVEL)=NODE,LEVEL(LEVEL,0)=ELE
+"RTN","C0CMCCD",46,0)
+ S ^TMP("MXMLDOM",$J,HANDLE,NODE)=ELE,^(NODE,"P")=PARENT
+"RTN","C0CMCCD",47,0)
+ ;M ^("A")=ATTR
+"RTN","C0CMCCD",48,0)
+ N ZI S ZI="" ; INDEX FOR ATTR
+"RTN","C0CMCCD",49,0)
+ F  S ZI=$O(ATTR(ZI)) Q:ZI=""  D  ; FOR EACH ATTRIBUTE
+"RTN","C0CMCCD",50,0)
+ . N ELE,TXT ; ABOUT TO RECURSE
+"RTN","C0CMCCD",51,0)
+ . S ELE=ZI ; TAG
+"RTN","C0CMCCD",52,0)
+ . S TXT=ATTR(ZI) ; DATA
+"RTN","C0CMCCD",53,0)
+ . D STARTELE(ELE,"") ; CREATE A NEW SUBNODE
+"RTN","C0CMCCD",54,0)
+ . D TXT^MXMLDOM("T") ; INSERT DATA TO TAG
+"RTN","C0CMCCD",55,0)
+ . D ENDELE^MXMLDOM(ELE) ; POP BACK UP A LEVEL
+"RTN","C0CMCCD",56,0)
  Q
-"RTN","C0CMCCD",21,0)
- ;
-"RTN","C0CMCCD",22,0)
-PARSCCD(DOC,OPTION) ; THIS WAS COPIED FROM EN^MXMLDOM TO CUSTIMIZE FOR 
-"RTN","C0CMCCD",23,0)
- ; PROCESSING CCDS 
-"RTN","C0CMCCD",24,0)
- N CBK,SUCCESS,LEVEL,NODE,HANDLE
-"RTN","C0CMCCD",25,0)
- K ^TMP("MXMLERR",$J)
-"RTN","C0CMCCD",26,0)
- L +^TMP("MXMLDOM",$J):5
-"RTN","C0CMCCD",27,0)
- E  Q 0
-"RTN","C0CMCCD",28,0)
- S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)=""
-"RTN","C0CMCCD",29,0)
- L -^TMP("MXMLDOM",$J)
-"RTN","C0CMCCD",30,0)
- S CBK("STARTELEMENT")="STARTELE^C0CMCCD" ; ONLY THIS ONE IS CHANGED ;GPL
-"RTN","C0CMCCD",31,0)
- S CBK("ENDELEMENT")="ENDELE^MXMLDOM"
-"RTN","C0CMCCD",32,0)
- S CBK("COMMENT")="COMMENT^MXMLDOM"
-"RTN","C0CMCCD",33,0)
- S CBK("CHARACTERS")="CHAR^MXMLDOM"
-"RTN","C0CMCCD",34,0)
- S CBK("ENDDOCUMENT")="ENDDOC^MXMLDOM"
-"RTN","C0CMCCD",35,0)
- S CBK("ERROR")="ERROR^MXMLDOM"
-"RTN","C0CMCCD",36,0)
- S (SUCCESS,LEVEL,LEVEL(0),NODE)=0,OPTION=$G(OPTION,"V1")
-"RTN","C0CMCCD",37,0)
- D EN^MXMLPRSE(DOC,.CBK,OPTION)
-"RTN","C0CMCCD",38,0)
- D:'SUCCESS DELETE^MXMLDOM(HANDLE)
-"RTN","C0CMCCD",39,0)
- Q $S(SUCCESS:HANDLE,1:0)
-"RTN","C0CMCCD",40,0)
- ; Start element
-"RTN","C0CMCCD",41,0)
- ; Create new child node and push info on stack
-"RTN","C0CMCCD",42,0)
-STARTELE(ELE,ATTR) ; COPIED FROM STARTELE^MXMLDOM AND MODIFIED TO TREAT
-"RTN","C0CMCCD",43,0)
- ; ATTRIBUTES AS SUBELEMENTS TO MAKE CCD XPATH PROCESSING EASIER
-"RTN","C0CMCCD",44,0)
- N PARENT
-"RTN","C0CMCCD",45,0)
- S PARENT=LEVEL(LEVEL),NODE=NODE+1
-"RTN","C0CMCCD",46,0)
- S:PARENT ^TMP("MXMLDOM",$J,HANDLE,PARENT,"C",NODE)=ELE
-"RTN","C0CMCCD",47,0)
- S LEVEL=LEVEL+1,LEVEL(LEVEL)=NODE,LEVEL(LEVEL,0)=ELE
-"RTN","C0CMCCD",48,0)
- S ^TMP("MXMLDOM",$J,HANDLE,NODE)=ELE,^(NODE,"P")=PARENT
-"RTN","C0CMCCD",49,0)
- ;M ^("A")=ATTR
-"RTN","C0CMCCD",50,0)
- N ZI S ZI="" ; INDEX FOR ATTR
-"RTN","C0CMCCD",51,0)
- F  S ZI=$O(ATTR(ZI)) Q:ZI=""  D  ; FOR EACH ATTRIBUTE
-"RTN","C0CMCCD",52,0)
- . N ELE,TXT ; ABOUT TO RECURSE
-"RTN","C0CMCCD",53,0)
- . S ELE=ZI ; TAG
-"RTN","C0CMCCD",54,0)
- . S TXT=ATTR(ZI) ; DATA
-"RTN","C0CMCCD",55,0)
- . D STARTELE(ELE,"") ; CREATE A NEW SUBNODE
-"RTN","C0CMCCD",56,0)
- . D TXT^MXMLDOM("T") ; INSERT DATA TO TAG
 "RTN","C0CMCCD",57,0)
- . D ENDELE^MXMLDOM(ELE) ; POP BACK UP A LEVEL
+ ;
 "RTN","C0CMCCD",58,0)
+ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
+"RTN","C0CMCCD",59,0)
+ N ZN
+"RTN","C0CMCCD",60,0)
+ ;I $$TAG(ZOID)["entry" B
+"RTN","C0CMCCD",61,0)
+ S ZN=$$NXTSIB(ZOID)
+"RTN","C0CMCCD",62,0)
+ I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
+"RTN","C0CMCCD",63,0)
+ Q 0
+"RTN","C0CMCCD",64,0)
+ ;
+"RTN","C0CMCCD",65,0)
+FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
+"RTN","C0CMCCD",66,0)
+ Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
+"RTN","C0CMCCD",67,0)
+ ;
+"RTN","C0CMCCD",68,0)
+PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
+"RTN","C0CMCCD",69,0)
+ Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
+"RTN","C0CMCCD",70,0)
+ ;
+"RTN","C0CMCCD",71,0)
+ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
+"RTN","C0CMCCD",72,0)
+ S HANDLE=C0CDOCID
+"RTN","C0CMCCD",73,0)
+ K @RTN
+"RTN","C0CMCCD",74,0)
+ D GETTXT^MXMLDOM("A")
+"RTN","C0CMCCD",75,0)
  Q
-"RTN","C0CMCCD",59,0)
- ;
-"RTN","C0CMCCD",60,0)
-ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
-"RTN","C0CMCCD",61,0)
- N ZN
-"RTN","C0CMCCD",62,0)
- ;I $$TAG(ZOID)["entry" B
-"RTN","C0CMCCD",63,0)
- S ZN=$$NXTSIB(ZOID)
-"RTN","C0CMCCD",64,0)
- I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
-"RTN","C0CMCCD",65,0)
- Q 0
-"RTN","C0CMCCD",66,0)
- ;
-"RTN","C0CMCCD",67,0)
-FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
-"RTN","C0CMCCD",68,0)
- Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CMCCD",69,0)
- ;
-"RTN","C0CMCCD",70,0)
-PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
-"RTN","C0CMCCD",71,0)
- Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CMCCD",72,0)
- ;
-"RTN","C0CMCCD",73,0)
-ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
-"RTN","C0CMCCD",74,0)
- S HANDLE=C0CDOCID
-"RTN","C0CMCCD",75,0)
- K @RTN
 "RTN","C0CMCCD",76,0)
- D GETTXT^MXMLDOM("A")
+ ;
 "RTN","C0CMCCD",77,0)
+TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
+"RTN","C0CMCCD",78,0)
+ ;I ZOID=149 B ;GPLTEST
+"RTN","C0CMCCD",79,0)
+ N X,Y
+"RTN","C0CMCCD",80,0)
+ S Y=""
+"RTN","C0CMCCD",81,0)
+ S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
+"RTN","C0CMCCD",82,0)
+ I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
+"RTN","C0CMCCD",83,0)
+ I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
+"RTN","C0CMCCD",84,0)
+ Q Y
+"RTN","C0CMCCD",85,0)
+ ;
+"RTN","C0CMCCD",86,0)
+NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
+"RTN","C0CMCCD",87,0)
+ Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
+"RTN","C0CMCCD",88,0)
+ ;
+"RTN","C0CMCCD",89,0)
+DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
+"RTN","C0CMCCD",90,0)
+ ;N ZT,ZN S ZT=""
+"RTN","C0CMCCD",91,0)
+ ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
+"RTN","C0CMCCD",92,0)
+ ;Q $G(@C0CDOM@(ZOID,"T",1))
+"RTN","C0CMCCD",93,0)
+ S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
+"RTN","C0CMCCD",94,0)
  Q
-"RTN","C0CMCCD",78,0)
- ;
-"RTN","C0CMCCD",79,0)
-TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
-"RTN","C0CMCCD",80,0)
- ;I ZOID=149 B ;GPLTEST
-"RTN","C0CMCCD",81,0)
- N X,Y
-"RTN","C0CMCCD",82,0)
- S Y=""
-"RTN","C0CMCCD",83,0)
- S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
-"RTN","C0CMCCD",84,0)
- I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
-"RTN","C0CMCCD",85,0)
- I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CMCCD",86,0)
- Q Y
-"RTN","C0CMCCD",87,0)
- ;
-"RTN","C0CMCCD",88,0)
-NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
-"RTN","C0CMCCD",89,0)
- Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CMCCD",90,0)
- ;
-"RTN","C0CMCCD",91,0)
-DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
-"RTN","C0CMCCD",92,0)
- ;N ZT,ZN S ZT=""
-"RTN","C0CMCCD",93,0)
- ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
-"RTN","C0CMCCD",94,0)
- ;Q $G(@C0CDOM@(ZOID,"T",1))
 "RTN","C0CMCCD",95,0)
- S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
+ ;
 "RTN","C0CMCCD",96,0)
+CLEANARY(OUTARY,INARY) ; GOES THROUGH AN ARRAY AND CALLS CLEAN ON EACH NODE
+"RTN","C0CMCCD",97,0)
+ ; INARY AND OUTARY PASSED BY NAME
+"RTN","C0CMCCD",98,0)
+ N ZI S ZI=""
+"RTN","C0CMCCD",99,0)
+ F  S ZI=$O(@INARY@(ZI)) Q:ZI=""  D  ; FOR EACH NODE
+"RTN","C0CMCCD",100,0)
+ . S @OUTARY@(ZI)=$$CLEAN(@INARY@(ZI)) ; CLEAN THE NODE
+"RTN","C0CMCCD",101,0)
  Q
-"RTN","C0CMCCD",97,0)
- ;
-"RTN","C0CMCCD",98,0)
-CLEANARY(OUTARY,INARY) ; GOES THROUGH AN ARRAY AND CALLS CLEAN ON EACH NODE
-"RTN","C0CMCCD",99,0)
- ; INARY AND OUTARY PASSED BY NAME
-"RTN","C0CMCCD",100,0)
- N ZI S ZI=""
-"RTN","C0CMCCD",101,0)
- F  S ZI=$O(@INARY@(ZI)) Q:ZI=""  D  ; FOR EACH NODE
 "RTN","C0CMCCD",102,0)
- . S @OUTARY@(ZI)=$$CLEAN(@INARY@(ZI)) ; CLEAN THE NODE
+ ;
 "RTN","C0CMCCD",103,0)
+CLEAN(STR) ; extrinsic function; returns string
+"RTN","C0CMCCD",104,0)
+ ;; Removes all non printable characters from a string.
+"RTN","C0CMCCD",105,0)
+ ;; STR by Value
+"RTN","C0CMCCD",106,0)
+ N TR,I
+"RTN","C0CMCCD",107,0)
+ F I=0:1:31 S TR=$G(TR)_$C(I)
+"RTN","C0CMCCD",108,0)
+ S TR=TR_$C(127)
+"RTN","C0CMCCD",109,0)
+ QUIT $TR(STR,TR)
+"RTN","C0CMCCD",110,0)
+ ;
+"RTN","C0CMCCD",111,0)
+STRIPTXT(OUTARY,ZARY) ; STRIPS THE "TEXT" PORTION OUT OF AN XML FILE
+"RTN","C0CMCCD",112,0)
+ ; THIS IS USED TO DELETE THE NARATIVE HTML OUT OF THE CCD XML FILES BECAUSE
+"RTN","C0CMCCD",113,0)
+ ; THEY DO NOT WORK RIGHT WITH THE PARSER
+"RTN","C0CMCCD",114,0)
+ ;N ZWRK,ZBLD,ZI ; WORK ARRAY,BUILD ARRAY, AND COUNTER
+"RTN","C0CMCCD",115,0)
+ S ZI=$O(@ZARY@("")) ; GET FIRST LINE NUMBER
+"RTN","C0CMCCD",116,0)
+ D C0CBEGIN("ZWRK",ZI) ; INSERT FIRST LINE IN WORK ARRAY
+"RTN","C0CMCCD",117,0)
+ F  S ZI=$O(@ZARY@(ZI)) Q:ZI=""  D  ; FOR EACH LINE OF THE ARRAY
+"RTN","C0CMCCD",118,0)
+ . I $O(@ZARY@(ZI))="" D  Q  ; AT THE END 
+"RTN","C0CMCCD",119,0)
+ . . D C0CEND("ZWRK",ZI) ; INCLUDE LAST LINE IN WORK ARRAY
+"RTN","C0CMCCD",120,0)
+ . I ZI=1 D C0CBEGIN("ZWRK",ZI) ; START WITH FIRST LINE
+"RTN","C0CMCCD",121,0)
+ . I @ZARY@(ZI)["<text" D C0CEND("ZWRK",ZI-1) ;PREV LINE IS AN END
+"RTN","C0CMCCD",122,0)
+ . I @ZARY@(ZI)["</text>" D C0CBEGIN("ZWRK",ZI+1) ;NEXT LINE IS A BEGIN
+"RTN","C0CMCCD",123,0)
+ S ZI=""
+"RTN","C0CMCCD",124,0)
+ F  S ZI=$O(ZWRK(ZI)) Q:ZI=""  D  ; MAKE A BUILD LIST FROM THE WORK ARRAY
+"RTN","C0CMCCD",125,0)
+ . D QUEUE^C0CXPATH("ZBLD",ZARY,$P(ZWRK(ZI),"^",1),$P(ZWRK(ZI),"^",2))
+"RTN","C0CMCCD",126,0)
+ D BUILD^C0CXPATH("ZBLD",OUTARY) ; BUILD NEW ARRAY WITHOUT TEXT SECTIONS
+"RTN","C0CMCCD",127,0)
+ K @OUTARY@(0) ; GET RID OF THE LINE COUNT
+"RTN","C0CMCCD",128,0)
  Q
-"RTN","C0CMCCD",104,0)
- ;
-"RTN","C0CMCCD",105,0)
-CLEAN(STR) ; extrinsic function; returns string
-"RTN","C0CMCCD",106,0)
- ;; Removes all non printable characters from a string.
-"RTN","C0CMCCD",107,0)
- ;; STR by Value
-"RTN","C0CMCCD",108,0)
- N TR,I
-"RTN","C0CMCCD",109,0)
- F I=0:1:31 S TR=$G(TR)_$C(I)
-"RTN","C0CMCCD",110,0)
- S TR=TR_$C(127)
-"RTN","C0CMCCD",111,0)
- QUIT $TR(STR,TR)
-"RTN","C0CMCCD",112,0)
- ;
-"RTN","C0CMCCD",113,0)
-STRIPTXT(OUTARY,ZARY) ; STRIPS THE "TEXT" PORTION OUT OF AN XML FILE
-"RTN","C0CMCCD",114,0)
- ; THIS IS USED TO DELETE THE NARATIVE HTML OUT OF THE CCD XML FILES BECAUSE
-"RTN","C0CMCCD",115,0)
- ; THEY DO NOT WORK RIGHT WITH THE PARSER
-"RTN","C0CMCCD",116,0)
- ;N ZWRK,ZBLD,ZI ; WORK ARRAY,BUILD ARRAY, AND COUNTER
-"RTN","C0CMCCD",117,0)
- S ZI=$O(@ZARY@("")) ; GET FIRST LINE NUMBER
-"RTN","C0CMCCD",118,0)
- D C0CBEGIN("ZWRK",ZI) ; INSERT FIRST LINE IN WORK ARRAY
-"RTN","C0CMCCD",119,0)
- F  S ZI=$O(@ZARY@(ZI)) Q:ZI=""  D  ; FOR EACH LINE OF THE ARRAY
-"RTN","C0CMCCD",120,0)
- . I $O(@ZARY@(ZI))="" D  Q  ; AT THE END 
-"RTN","C0CMCCD",121,0)
- . . D C0CEND("ZWRK",ZI) ; INCLUDE LAST LINE IN WORK ARRAY
-"RTN","C0CMCCD",122,0)
- . I ZI=1 D C0CBEGIN("ZWRK",ZI) ; START WITH FIRST LINE
-"RTN","C0CMCCD",123,0)
- . I @ZARY@(ZI)["<text" D C0CEND("ZWRK",ZI-1) ;PREV LINE IS AN END
-"RTN","C0CMCCD",124,0)
- . I @ZARY@(ZI)["</text>" D C0CBEGIN("ZWRK",ZI+1) ;NEXT LINE IS A BEGIN
-"RTN","C0CMCCD",125,0)
+"RTN","C0CMCCD",129,0)
+ ;
+"RTN","C0CMCCD",130,0)
+C0CBEGIN(ZA,LN) ; INSERTS A BEGIN LINE LN INTO ARRAY ZWRK, PASSED BY NAME
+"RTN","C0CMCCD",131,0)
+ N ZI
+"RTN","C0CMCCD",132,0)
+ S ZI=$O(@ZA@(""),-1)
+"RTN","C0CMCCD",133,0)
+ I ZI="" S ZI=1
+"RTN","C0CMCCD",134,0)
+ E  S ZI=ZI+1 ; INCREMENT COUNT IN WORK ARRAY
+"RTN","C0CMCCD",135,0)
+ S $P(@ZA@(ZI),"^",1)=LN
+"RTN","C0CMCCD",136,0)
+ Q
+"RTN","C0CMCCD",137,0)
+ ;
+"RTN","C0CMCCD",138,0)
+C0CEND(ZB,LN) ; INSERTS AN END LINE LN INTO ARRAY ZWRK, PASSED BY NAME
+"RTN","C0CMCCD",139,0)
+ N ZI
+"RTN","C0CMCCD",140,0)
+ S ZI=$O(@ZB@(""),-1)
+"RTN","C0CMCCD",141,0)
+ I ZI="" S ZI=1
+"RTN","C0CMCCD",142,0)
+ S $P(@ZB@(ZI),"^",2)=LN
+"RTN","C0CMCCD",143,0)
+ Q
+"RTN","C0CMCCD",144,0)
+ ;
+"RTN","C0CMCCD",145,0)
+SEPARATE(OUTARY,INARY) ; SEPARATES XPATH VARIABLES ACCORDING TO THEIR
+"RTN","C0CMCCD",146,0)
+ ; ROOT ; /Problems/etc/etc goes to @OUTARY@("Problems","/Problems/etc/etc")
+"RTN","C0CMCCD",147,0)
  S ZI=""
-"RTN","C0CMCCD",126,0)
- F  S ZI=$O(ZWRK(ZI)) Q:ZI=""  D  ; MAKE A BUILD LIST FROM THE WORK ARRAY
-"RTN","C0CMCCD",127,0)
- . D QUEUE^C0CXPATH("ZBLD",ZARY,$P(ZWRK(ZI),"^",1),$P(ZWRK(ZI),"^",2))
-"RTN","C0CMCCD",128,0)
- D BUILD^C0CXPATH("ZBLD",OUTARY) ; BUILD NEW ARRAY WITHOUT TEXT SECTIONS
-"RTN","C0CMCCD",129,0)
- K @OUTARY@(0) ; GET RID OF THE LINE COUNT
-"RTN","C0CMCCD",130,0)
+"RTN","C0CMCCD",148,0)
+ F  S ZI=$O(@INARY@(ZI)) Q:ZI=""  D  ; FOR EACH ELEMENT OF THE ARRAY
+"RTN","C0CMCCD",149,0)
+ . I $P(ZI,"//",2)'="" D  ; FOR NON-BODY ENTRIES
+"RTN","C0CMCCD",150,0)
+ . . S ZJ=$P(ZI,"/",4) ; things like From Patient Actor
+"RTN","C0CMCCD",151,0)
+ . E  D  ; FOR BODY PARTS
+"RTN","C0CMCCD",152,0)
+ . . S ZJ=$P(ZI,"/",2) ;
+"RTN","C0CMCCD",153,0)
+ . . I ZJ="" S ZJ=$P(ZI,"/",3) ;
+"RTN","C0CMCCD",154,0)
+ . S @OUTARY@(ZJ,ZI)=$G(@INARY@(ZI)) ;FIX THIS FOR MULTILINE COMMENTS
+"RTN","C0CMCCD",155,0)
  Q
-"RTN","C0CMCCD",131,0)
- ;
-"RTN","C0CMCCD",132,0)
-C0CBEGIN(ZA,LN) ; INSERTS A BEGIN LINE LN INTO ARRAY ZWRK, PASSED BY NAME
-"RTN","C0CMCCD",133,0)
- N ZI
-"RTN","C0CMCCD",134,0)
- S ZI=$O(@ZA@(""),-1)
-"RTN","C0CMCCD",135,0)
- I ZI="" S ZI=1
-"RTN","C0CMCCD",136,0)
- E  S ZI=ZI+1 ; INCREMENT COUNT IN WORK ARRAY
-"RTN","C0CMCCD",137,0)
- S $P(@ZA@(ZI),"^",1)=LN
-"RTN","C0CMCCD",138,0)
+"RTN","C0CMCCD",156,0)
+ ;
+"RTN","C0CMCCD",157,0)
+FINDTID ; FIND TEMPLATE IDS IN DOM 1
+"RTN","C0CMCCD",158,0)
+ S C0CDOCID=1
+"RTN","C0CMCCD",159,0)
+ S ZD=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
+"RTN","C0CMCCD",160,0)
+ S ZN=""
+"RTN","C0CMCCD",161,0)
+ S CURSEC=""
+"RTN","C0CMCCD",162,0)
+ S TID=""
+"RTN","C0CMCCD",163,0)
+ F  S ZN=$O(@ZD@(ZN)) Q:ZN=""  D  ;
+"RTN","C0CMCCD",164,0)
+ . I $$TAG(ZN)="root" D  ;
+"RTN","C0CMCCD",165,0)
+ . . I $$TAG($$PARENT(ZN))="templateId" D  ; ONLY LOOKING FOR TEMPLATES
+"RTN","C0CMCCD",166,0)
+ . . . S ZG=$$PARENT($$PARENT(ZN))
+"RTN","C0CMCCD",167,0)
+ . . . S ZG2=$$PARENT(ZG) ;COMPONENT THAT HOLDS THIS SECTION
+"RTN","C0CMCCD",168,0)
+ . . . S CMT=$G(@ZD@(ZG,"X",1))
+"RTN","C0CMCCD",169,0)
+ . . . I CMT="" S CMT="?"
+"RTN","C0CMCCD",170,0)
+ . . . I $$TAG(ZG)="section" D  ;START OF A SECTION
+"RTN","C0CMCCD",171,0)
+ . . . . S CURSEC=$$PARENT(ZG)
+"RTN","C0CMCCD",172,0)
+ . . . . S SECCMT=$G(@ZD@(CURSEC,"X",1))
+"RTN","C0CMCCD",173,0)
+ . . . . I SECCMT="" S SECCMT="?"
+"RTN","C0CMCCD",174,0)
+ . . . . S SECTID=$G(@ZD@(ZN,"T",1)) ;SECTION TEMPLATE ID
+"RTN","C0CMCCD",175,0)
+ . . . S TID=$G(@ZD@(ZN,"T",1)) ;TEMPLATE ID
+"RTN","C0CMCCD",176,0)
+ . . . I CURSEC'="" D  ; IF WE ARE IN A SECTION
+"RTN","C0CMCCD",177,0)
+ . . . . S CCDDIR(ZG2,CURSEC,$$TAG(ZG2),CMT,SECCMT)=TID
+"RTN","C0CMCCD",178,0)
+ . . . . S DOMMAP(ZG2)=CURSEC_U_$$TAG(ZG2)_U_TID_U_SECTID
+"RTN","C0CMCCD",179,0)
+ . . . W !,$$TAG(ZG2)," ",$G(@ZD@(ZG,"X",1))
+"RTN","C0CMCCD",180,0)
+ . . . W " root ",ZN," ",@ZD@(ZN,"T",1)
+"RTN","C0CMCCD",181,0)
  Q
-"RTN","C0CMCCD",139,0)
- ;
-"RTN","C0CMCCD",140,0)
-C0CEND(ZB,LN) ; INSERTS AN END LINE LN INTO ARRAY ZWRK, PASSED BY NAME
-"RTN","C0CMCCD",141,0)
- N ZI
-"RTN","C0CMCCD",142,0)
- S ZI=$O(@ZB@(""),-1)
-"RTN","C0CMCCD",143,0)
- I ZI="" S ZI=1
-"RTN","C0CMCCD",144,0)
- S $P(@ZB@(ZI),"^",2)=LN
-"RTN","C0CMCCD",145,0)
+"RTN","C0CMCCD",182,0)
+ ;
+"RTN","C0CMCCD",183,0)
+FINDALT ; PROCESS THE DOMMAP AND FIND THE ALT TAGS FOR COMPONENTS
+"RTN","C0CMCCD",184,0)
+ ;
+"RTN","C0CMCCD",185,0)
+ S ZI=""
+"RTN","C0CMCCD",186,0)
+ F  S ZI=$O(DOMMAP(ZI)) Q:ZI=""  D  ; FOR EACH NODE IN THE MAP
+"RTN","C0CMCCD",187,0)
+ . S ZJ=DOMMAP(ZI) ;
+"RTN","C0CMCCD",188,0)
+ . S PARNODE=$P(ZJ,U,1) ;PARENT NODE
+"RTN","C0CMCCD",189,0)
+ . S TAG=$P(ZJ,U,2) ;THIS TAG
+"RTN","C0CMCCD",190,0)
+ . S TID=$P(ZJ,U,3) ;THIS TEMPLATE ID
+"RTN","C0CMCCD",191,0)
+ . S PARTID=$P(ZJ,U,4) ;PARENT TEMPLATE ID
+"RTN","C0CMCCD",192,0)
+ . S ZIEN=$O(^C0CXDS(178.101,"TID",TID,"")) ;THIS NODE IEN
+"RTN","C0CMCCD",193,0)
+ . S PARIEN=$O(^C0CXDS(178.101,"TID",PARTID,"")) ;PARENT NODE IEN
+"RTN","C0CMCCD",194,0)
+ . I ZI=PARNODE D  ; IF THIS IS A SECTION NODE
+"RTN","C0CMCCD",195,0)
+ . . S ALTTAG=$$GET1^DIQ(178.101,PARIEN_",",.03) ;ALT TAG FIELD FOR PARENT
+"RTN","C0CMCCD",196,0)
+ . . S NAME=$$GET1^DIQ(178.101,ZIEN_",",.01) ;NAME OF THIS NODE'S TEMPLATE
+"RTN","C0CMCCD",197,0)
+ . . W ZI," ",TAG," ",ALTTAG," ",NAME,!
+"RTN","C0CMCCD",198,0)
+ . . S C0CTAGS(ZI)=ALTTAG
+"RTN","C0CMCCD",199,0)
+ . E  D  ; NOT A SECTION NODE
+"RTN","C0CMCCD",200,0)
+ . . N ZJ S ZJ=""
+"RTN","C0CMCCD",201,0)
+ . . S ZJ=$O(^C0CXDS(178.101,"D",PARIEN,ZIEN,"")) ;A WHEREUSED POINTER?
+"RTN","C0CMCCD",202,0)
+ . . I ZJ'="" D  ; THERE IS A NEW LABEL FOR THIS NODE
+"RTN","C0CMCCD",203,0)
+ . . . N ZK
+"RTN","C0CMCCD",204,0)
+ . . . S ZK=$$GET1^DIQ(178.111,ZJ_","_ZIEN_",",2)
+"RTN","C0CMCCD",205,0)
+ . . . I ZK'="" D  ;
+"RTN","C0CMCCD",206,0)
+ . . . . W "FOUND ",ZK,!
+"RTN","C0CMCCD",207,0)
+ . . . . S C0CTAGS(ZI)=ZK ; NEW TAG FOR INTERSECTION
+"RTN","C0CMCCD",208,0)
  Q
-"RTN","C0CMCCD",146,0)
- ;
-"RTN","C0CMCCD",147,0)
-SEPARATE(OUTARY,INARY) ; SEPARATES XPATH VARIABLES ACCORDING TO THEIR
-"RTN","C0CMCCD",148,0)
- ; ROOT ; /Problems/etc/etc goes to @OUTARY@("Problems","/Problems/etc/etc")
-"RTN","C0CMCCD",149,0)
- S ZI=""
-"RTN","C0CMCCD",150,0)
- F  S ZI=$O(@INARY@(ZI)) Q:ZI=""  D  ; FOR EACH ELEMENT OF THE ARRAY
-"RTN","C0CMCCD",151,0)
- . I $P(ZI,"//",2)'="" D  ; FOR NON-BODY ENTRIES
-"RTN","C0CMCCD",152,0)
- . . S ZJ=$P(ZI,"/",4) ; things like From Patient Actor
-"RTN","C0CMCCD",153,0)
- . E  D  ; FOR BODY PARTS
-"RTN","C0CMCCD",154,0)
- . . S ZJ=$P(ZI,"/",2) ;
-"RTN","C0CMCCD",155,0)
- . . I ZJ="" S ZJ=$P(ZI,"/",3) ;
-"RTN","C0CMCCD",156,0)
- . S @OUTARY@(ZJ,ZI)=$G(@INARY@(ZI)) ;FIX THIS FOR MULTILINE COMMENTS
-"RTN","C0CMCCD",157,0)
+"RTN","C0CMCCD",209,0)
+ ;
+"RTN","C0CMCCD",210,0)
+ALTTAG(NODE) ; SET Y EQUAL TO THE ALT TAG FOUND IN C0CTAGS IF NODE IF FOUND
+"RTN","C0CMCCD",211,0)
+ ;
+"RTN","C0CMCCD",212,0)
+ S Y=$G(C0CTAGS(NODE))
+"RTN","C0CMCCD",213,0)
  Q
-"RTN","C0CMCCD",158,0)
- ;
-"RTN","C0CMCCD",159,0)
-FINDTID ; FIND TEMPLATE IDS IN DOM 1
-"RTN","C0CMCCD",160,0)
- S C0CDOCID=1
-"RTN","C0CMCCD",161,0)
- S ZD=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
-"RTN","C0CMCCD",162,0)
- S ZN=""
-"RTN","C0CMCCD",163,0)
- S CURSEC=""
-"RTN","C0CMCCD",164,0)
- S TID=""
-"RTN","C0CMCCD",165,0)
- F  S ZN=$O(@ZD@(ZN)) Q:ZN=""  D  ;
-"RTN","C0CMCCD",166,0)
- . I $$TAG(ZN)="root" D  ;
-"RTN","C0CMCCD",167,0)
- . . I $$TAG($$PARENT(ZN))="templateId" D  ; ONLY LOOKING FOR TEMPLATES
-"RTN","C0CMCCD",168,0)
- . . . S ZG=$$PARENT($$PARENT(ZN))
-"RTN","C0CMCCD",169,0)
- . . . S ZG2=$$PARENT(ZG) ;COMPONENT THAT HOLDS THIS SECTION
-"RTN","C0CMCCD",170,0)
- . . . S CMT=$G(@ZD@(ZG,"X",1))
-"RTN","C0CMCCD",171,0)
- . . . I CMT="" S CMT="?"
-"RTN","C0CMCCD",172,0)
- . . . I $$TAG(ZG)="section" D  ;START OF A SECTION
-"RTN","C0CMCCD",173,0)
- . . . . S CURSEC=$$PARENT(ZG)
-"RTN","C0CMCCD",174,0)
- . . . . S SECCMT=$G(@ZD@(CURSEC,"X",1))
-"RTN","C0CMCCD",175,0)
- . . . . I SECCMT="" S SECCMT="?"
-"RTN","C0CMCCD",176,0)
- . . . . S SECTID=$G(@ZD@(ZN,"T",1)) ;SECTION TEMPLATE ID
-"RTN","C0CMCCD",177,0)
- . . . S TID=$G(@ZD@(ZN,"T",1)) ;TEMPLATE ID
-"RTN","C0CMCCD",178,0)
- . . . I CURSEC'="" D  ; IF WE ARE IN A SECTION
-"RTN","C0CMCCD",179,0)
- . . . . S CCDDIR(ZG2,CURSEC,$$TAG(ZG2),CMT,SECCMT)=TID
-"RTN","C0CMCCD",180,0)
- . . . . S DOMMAP(ZG2)=CURSEC_U_$$TAG(ZG2)_U_TID_U_SECTID
-"RTN","C0CMCCD",181,0)
- . . . W !,$$TAG(ZG2)," ",$G(@ZD@(ZG,"X",1))
-"RTN","C0CMCCD",182,0)
- . . . W " root ",ZN," ",@ZD@(ZN,"T",1)
-"RTN","C0CMCCD",183,0)
+"RTN","C0CMCCD",214,0)
+ ;
+"RTN","C0CMCCD",215,0)
+SETCBK ; SET THE TAG CALLBACK FOR XPATH PROCESSSING OF THE CCD
+"RTN","C0CMCCD",216,0)
+ S C0CCBK("TAG")="D ALTTAG^C0CMCCD(ZOID)"
+"RTN","C0CMCCD",217,0)
  Q
-"RTN","C0CMCCD",184,0)
- ;
-"RTN","C0CMCCD",185,0)
-FINDALT ; PROCESS THE DOMMAP AND FIND THE ALT TAGS FOR COMPONENTS
-"RTN","C0CMCCD",186,0)
- ;
-"RTN","C0CMCCD",187,0)
- S ZI=""
-"RTN","C0CMCCD",188,0)
- F  S ZI=$O(DOMMAP(ZI)) Q:ZI=""  D  ; FOR EACH NODE IN THE MAP
-"RTN","C0CMCCD",189,0)
- . S ZJ=DOMMAP(ZI) ;
-"RTN","C0CMCCD",190,0)
- . S PARNODE=$P(ZJ,U,1) ;PARENT NODE
-"RTN","C0CMCCD",191,0)
- . S TAG=$P(ZJ,U,2) ;THIS TAG
-"RTN","C0CMCCD",192,0)
- . S TID=$P(ZJ,U,3) ;THIS TEMPLATE ID
-"RTN","C0CMCCD",193,0)
- . S PARTID=$P(ZJ,U,4) ;PARENT TEMPLATE ID
-"RTN","C0CMCCD",194,0)
- . S ZIEN=$O(^C0CXDS(178.101,"TID",TID,"")) ;THIS NODE IEN
-"RTN","C0CMCCD",195,0)
- . S PARIEN=$O(^C0CXDS(178.101,"TID",PARTID,"")) ;PARENT NODE IEN
-"RTN","C0CMCCD",196,0)
- . I ZI=PARNODE D  ; IF THIS IS A SECTION NODE
-"RTN","C0CMCCD",197,0)
- . . S ALTTAG=$$GET1^DIQ(178.101,PARIEN_",",.03) ;ALT TAG FIELD FOR PARENT
-"RTN","C0CMCCD",198,0)
- . . S NAME=$$GET1^DIQ(178.101,ZIEN_",",.01) ;NAME OF THIS NODE'S TEMPLATE
-"RTN","C0CMCCD",199,0)
- . . W ZI," ",TAG," ",ALTTAG," ",NAME,!
-"RTN","C0CMCCD",200,0)
- . . S C0CTAGS(ZI)=ALTTAG
-"RTN","C0CMCCD",201,0)
- . E  D  ; NOT A SECTION NODE
-"RTN","C0CMCCD",202,0)
- . . N ZJ S ZJ=""
-"RTN","C0CMCCD",203,0)
- . . S ZJ=$O(^C0CXDS(178.101,"D",PARIEN,ZIEN,"")) ;A WHEREUSED POINTER?
-"RTN","C0CMCCD",204,0)
- . . I ZJ'="" D  ; THERE IS A NEW LABEL FOR THIS NODE
-"RTN","C0CMCCD",205,0)
- . . . N ZK
-"RTN","C0CMCCD",206,0)
- . . . S ZK=$$GET1^DIQ(178.111,ZJ_","_ZIEN_",",2)
-"RTN","C0CMCCD",207,0)
- . . . I ZK'="" D  ;
-"RTN","C0CMCCD",208,0)
- . . . . W "FOUND ",ZK,!
-"RTN","C0CMCCD",209,0)
- . . . . S C0CTAGS(ZI)=ZK ; NEW TAG FOR INTERSECTION
-"RTN","C0CMCCD",210,0)
+"RTN","C0CMCCD",218,0)
+ ;
+"RTN","C0CMCCD",219,0)
+OUTCCD(GARYIN) ; OUTPUT THE PARSED CCD TO A TEXT FILE
+"RTN","C0CMCCD",220,0)
+ ;D TEST3^C0CMXML
+"RTN","C0CMCCD",221,0)
+ N ZT S ZT=$NA(^TMP("CCDOUT",$J))
+"RTN","C0CMCCD",222,0)
+ N ZI,ZJ
+"RTN","C0CMCCD",223,0)
+ S ZI=1 S ZJ=""
+"RTN","C0CMCCD",224,0)
+ K @ZT
+"RTN","C0CMCCD",225,0)
+ F  S ZJ=$O(GARYIN(ZJ)) Q:ZJ=""  D  ;
+"RTN","C0CMCCD",226,0)
+ . S @ZT@(ZI)=ZJ_"^"_GARYIN(ZJ)
+"RTN","C0CMCCD",227,0)
+ . S ZI=ZI+1
+"RTN","C0CMCCD",228,0)
+ S ONAME=$NA(@ZT@(1))
+"RTN","C0CMCCD",229,0)
+ W $$OUTPUT^C0CXPATH(ONAME,"CCDOUT.txt","/home/vademo2/CCR")
+"RTN","C0CMCCD",230,0)
+ K @ZT
+"RTN","C0CMCCD",231,0)
  Q
-"RTN","C0CMCCD",211,0)
- ;
-"RTN","C0CMCCD",212,0)
-ALTTAG(NODE) ; SET Y EQUAL TO THE ALT TAG FOUND IN C0CTAGS IF NODE IF FOUND
-"RTN","C0CMCCD",213,0)
- ;
-"RTN","C0CMCCD",214,0)
- S Y=$G(C0CTAGS(NODE))
-"RTN","C0CMCCD",215,0)
+"RTN","C0CMCCD",232,0)
+ ;
+"RTN","C0CMCCD",233,0)
+GENXDS(ZD) ; GENERATE THE XDS PROTOTYPE RECORDS FROM A CCDDIR ARRAY
+"RTN","C0CMCCD",234,0)
+ ; ARRAY ELEMENTS LOOK LIKE:
+"RTN","C0CMCCD",235,0)
+ ; CCDDIR(1659,1634,"observation"," Result observaion template "," Vital signs section template ")="2.16.840.1.113883.10.20.1.31"
+"RTN","C0CMCCD",236,0)
+ ;or CCDDIR(cur node,section node,cur tag,cur name,sec name)=templateId
+"RTN","C0CMCCD",237,0)
+ S ZF=178.101 ; FILE NUMBER FOR THE C0C XDS PROTOTYPE FILE
+"RTN","C0CMCCD",238,0)
+ S ZI=$Q(@ZD@("")) ;FIRST ARRAY ELEMENT
+"RTN","C0CMCCD",239,0)
+ S DONE=0
+"RTN","C0CMCCD",240,0)
+ F  Q:DONE  D  ;
+"RTN","C0CMCCD",241,0)
+ . W @ZI,!
+"RTN","C0CMCCD",242,0)
+ . S ZJ=$QS(ZI,5)
+"RTN","C0CMCCD",243,0)
+ . S ZJ=$E(ZJ,2,$L(ZJ)) ;STRIP THE LEADING SPACE
+"RTN","C0CMCCD",244,0)
+ . S C0CFDA(ZF,"?+1,",.01)=ZJ
+"RTN","C0CMCCD",245,0)
+ . S C0CFDA(ZF,"?+1,",.02)=$QS(ZI,4) ; TAG FOR THIS TEMPLATE
+"RTN","C0CMCCD",246,0)
+ . S C0CFDA(ZF,"?+1,",1)=@ZI
+"RTN","C0CMCCD",247,0)
+ . D UPDIE
+"RTN","C0CMCCD",248,0)
+ . S ZI=$Q(@ZI)
+"RTN","C0CMCCD",249,0)
+ . I ZI="" S DONE=1
+"RTN","C0CMCCD",250,0)
  Q
-"RTN","C0CMCCD",216,0)
- ;
-"RTN","C0CMCCD",217,0)
-SETCBK ; SET THE TAG CALLBACK FOR XPATH PROCESSSING OF THE CCD
-"RTN","C0CMCCD",218,0)
- S C0CCBK("TAG")="D ALTTAG^C0CMCCD(ZOID)"
-"RTN","C0CMCCD",219,0)
+"RTN","C0CMCCD",251,0)
+ ;
+"RTN","C0CMCCD",252,0)
+WHRUSD(ZD) ; UPDATE THE C0C XDS FILE WITH WHERE USED DATA FROM
+"RTN","C0CMCCD",253,0)
+ ; CCDDIR PASS BY NAME
+"RTN","C0CMCCD",254,0)
+ ; ARRAY ELEMENTS LOOK LIKE:
+"RTN","C0CMCCD",255,0)
+ ; CCDDIR(1634," Vital signs section template ",1659,"observation"," Result observaion template ")="2.16.840.1.113883.10.20.1.31"
+"RTN","C0CMCCD",256,0)
+ ;or CCDDIR(section node,sec name, cur node,cur tag,cur name)=templateId
+"RTN","C0CMCCD",257,0)
+ S ZF=178.101 ; FILE NUMBER FOR THE C0C XDS PROTOTYPE FILE
+"RTN","C0CMCCD",258,0)
+ S ZSF=178.111 ; WHERE USED SUBFILE OF C0C XDS PROTOTYPE FILE
+"RTN","C0CMCCD",259,0)
+ S ZI=$Q(@ZD@("")) ;FIRST ARRAY ELEMENT
+"RTN","C0CMCCD",260,0)
+ S DONE=0
+"RTN","C0CMCCD",261,0)
+ F  Q:DONE  D  ;
+"RTN","C0CMCCD",262,0)
+ . W @ZI
+"RTN","C0CMCCD",263,0)
+ . S ZIEN=$O(^C0CXDS(178.101,"TID",@ZI,"")) ; IEN FOR THIS NODE'S TEMPLATE
+"RTN","C0CMCCD",264,0)
+ . W " IEN:",ZIEN
+"RTN","C0CMCCD",265,0)
+ . S ZJ=$QS(ZI,2)
+"RTN","C0CMCCD",266,0)
+ . S ZJ=$E(ZJ,2,$L(ZJ)) ;STRIP THE LEADING SPACE
+"RTN","C0CMCCD",267,0)
+ . S ZPIEN=$O(^C0CXDS(178.101,"B",ZJ,"")) ; PARENT IEN
+"RTN","C0CMCCD",268,0)
+ . W " PARENT IEN:",ZPIEN
+"RTN","C0CMCCD",269,0)
+ . S ZTAG=$QS(ZI,4) ; TAG FOR THIS TEMPLATE
+"RTN","C0CMCCD",270,0)
+ . W " TAG:",ZTAG,!
+"RTN","C0CMCCD",271,0)
+ . I ZIEN'=ZPIEN D  ; ONLY FOR CHILD TEMPLATES
+"RTN","C0CMCCD",272,0)
+ . . S C0CFDA(ZSF,"?+1,"_ZIEN_",",.01)=ZPIEN ; NEW SUBFILE ENTRY WITH PAR PTR
+"RTN","C0CMCCD",273,0)
+ . . S C0CFDA(ZSF,"?+1,"_ZIEN_",",1)=ZTAG ; TAG FOR NEW ENTRY
+"RTN","C0CMCCD",274,0)
+ . . D UPDIE
+"RTN","C0CMCCD",275,0)
+ . ;S C0CFDA(ZF,"?+1,",1)=@ZI
+"RTN","C0CMCCD",276,0)
+ . ;D UPDIE
+"RTN","C0CMCCD",277,0)
+ . S ZI=$Q(@ZI)
+"RTN","C0CMCCD",278,0)
+ . I ZI="" S DONE=1
+"RTN","C0CMCCD",279,0)
  Q
-"RTN","C0CMCCD",220,0)
- ;
-"RTN","C0CMCCD",221,0)
-OUTCCD(GARYIN) ; OUTPUT THE PARSED CCD TO A TEXT FILE
-"RTN","C0CMCCD",222,0)
- ;D TEST3^C0CMXML
-"RTN","C0CMCCD",223,0)
- N ZT S ZT=$NA(^TMP("CCDOUT",$J))
-"RTN","C0CMCCD",224,0)
- N ZI,ZJ
-"RTN","C0CMCCD",225,0)
- S ZI=1 S ZJ=""
-"RTN","C0CMCCD",226,0)
- K @ZT
-"RTN","C0CMCCD",227,0)
- F  S ZJ=$O(GARYIN(ZJ)) Q:ZJ=""  D  ;
-"RTN","C0CMCCD",228,0)
- . S @ZT@(ZI)=ZJ_"^"_GARYIN(ZJ)
-"RTN","C0CMCCD",229,0)
- . S ZI=ZI+1
-"RTN","C0CMCCD",230,0)
- S ONAME=$NA(@ZT@(1))
-"RTN","C0CMCCD",231,0)
- W $$OUTPUT^C0CXPATH(ONAME,"CCDOUT.txt","/home/vademo2/CCR")
-"RTN","C0CMCCD",232,0)
- K @ZT
-"RTN","C0CMCCD",233,0)
+"RTN","C0CMCCD",280,0)
+ ; 
+"RTN","C0CMCCD",281,0)
+UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+"RTN","C0CMCCD",282,0)
+ K ZERR
+"RTN","C0CMCCD",283,0)
+ D CLEAN^DILF
+"RTN","C0CMCCD",284,0)
+ D UPDATE^DIE("","C0CFDA","","ZERR")
+"RTN","C0CMCCD",285,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CMCCD",286,0)
+ K C0CFDA
+"RTN","C0CMCCD",287,0)
  Q
-"RTN","C0CMCCD",234,0)
- ;
-"RTN","C0CMCCD",235,0)
-GENXDS(ZD) ; GENERATE THE XDS PROTOTYPE RECORDS FROM A CCDDIR ARRAY
-"RTN","C0CMCCD",236,0)
- ; ARRAY ELEMENTS LOOK LIKE:
-"RTN","C0CMCCD",237,0)
- ; CCDDIR(1659,1634,"observation"," Result observaion template "," Vital signs section template ")="2.16.840.1.113883.10.20.1.31"
-"RTN","C0CMCCD",238,0)
- ;or CCDDIR(cur node,section node,cur tag,cur name,sec name)=templateId
-"RTN","C0CMCCD",239,0)
- S ZF=178.101 ; FILE NUMBER FOR THE C0C XDS PROTOTYPE FILE
-"RTN","C0CMCCD",240,0)
- S ZI=$Q(@ZD@("")) ;FIRST ARRAY ELEMENT
-"RTN","C0CMCCD",241,0)
- S DONE=0
-"RTN","C0CMCCD",242,0)
- F  Q:DONE  D  ;
-"RTN","C0CMCCD",243,0)
- . W @ZI,!
-"RTN","C0CMCCD",244,0)
- . S ZJ=$QS(ZI,5)
-"RTN","C0CMCCD",245,0)
- . S ZJ=$E(ZJ,2,$L(ZJ)) ;STRIP THE LEADING SPACE
-"RTN","C0CMCCD",246,0)
- . S C0CFDA(ZF,"?+1,",.01)=ZJ
-"RTN","C0CMCCD",247,0)
- . S C0CFDA(ZF,"?+1,",.02)=$QS(ZI,4) ; TAG FOR THIS TEMPLATE
-"RTN","C0CMCCD",248,0)
- . S C0CFDA(ZF,"?+1,",1)=@ZI
-"RTN","C0CMCCD",249,0)
- . D UPDIE
-"RTN","C0CMCCD",250,0)
- . S ZI=$Q(@ZI)
-"RTN","C0CMCCD",251,0)
- . I ZI="" S DONE=1
-"RTN","C0CMCCD",252,0)
- Q
-"RTN","C0CMCCD",253,0)
- ;
-"RTN","C0CMCCD",254,0)
-WHRUSD(ZD) ; UPDATE THE C0C XDS FILE WITH WHERE USED DATA FROM
-"RTN","C0CMCCD",255,0)
- ; CCDDIR PASS BY NAME
-"RTN","C0CMCCD",256,0)
- ; ARRAY ELEMENTS LOOK LIKE:
-"RTN","C0CMCCD",257,0)
- ; CCDDIR(1634," Vital signs section template ",1659,"observation"," Result observaion template ")="2.16.840.1.113883.10.20.1.31"
-"RTN","C0CMCCD",258,0)
- ;or CCDDIR(section node,sec name, cur node,cur tag,cur name)=templateId
-"RTN","C0CMCCD",259,0)
- S ZF=178.101 ; FILE NUMBER FOR THE C0C XDS PROTOTYPE FILE
-"RTN","C0CMCCD",260,0)
- S ZSF=178.111 ; WHERE USED SUBFILE OF C0C XDS PROTOTYPE FILE
-"RTN","C0CMCCD",261,0)
- S ZI=$Q(@ZD@("")) ;FIRST ARRAY ELEMENT
-"RTN","C0CMCCD",262,0)
- S DONE=0
-"RTN","C0CMCCD",263,0)
- F  Q:DONE  D  ;
-"RTN","C0CMCCD",264,0)
- . W @ZI
-"RTN","C0CMCCD",265,0)
- . S ZIEN=$O(^C0CXDS(178.101,"TID",@ZI,"")) ; IEN FOR THIS NODE'S TEMPLATE
-"RTN","C0CMCCD",266,0)
- . W " IEN:",ZIEN
-"RTN","C0CMCCD",267,0)
- . S ZJ=$QS(ZI,2)
-"RTN","C0CMCCD",268,0)
- . S ZJ=$E(ZJ,2,$L(ZJ)) ;STRIP THE LEADING SPACE
-"RTN","C0CMCCD",269,0)
- . S ZPIEN=$O(^C0CXDS(178.101,"B",ZJ,"")) ; PARENT IEN
-"RTN","C0CMCCD",270,0)
- . W " PARENT IEN:",ZPIEN
-"RTN","C0CMCCD",271,0)
- . S ZTAG=$QS(ZI,4) ; TAG FOR THIS TEMPLATE
-"RTN","C0CMCCD",272,0)
- . W " TAG:",ZTAG,!
-"RTN","C0CMCCD",273,0)
- . I ZIEN'=ZPIEN D  ; ONLY FOR CHILD TEMPLATES
-"RTN","C0CMCCD",274,0)
- . . S C0CFDA(ZSF,"?+1,"_ZIEN_",",.01)=ZPIEN ; NEW SUBFILE ENTRY WITH PAR PTR
-"RTN","C0CMCCD",275,0)
- . . S C0CFDA(ZSF,"?+1,"_ZIEN_",",1)=ZTAG ; TAG FOR NEW ENTRY
-"RTN","C0CMCCD",276,0)
- . . D UPDIE
-"RTN","C0CMCCD",277,0)
- . ;S C0CFDA(ZF,"?+1,",1)=@ZI
-"RTN","C0CMCCD",278,0)
- . ;D UPDIE
-"RTN","C0CMCCD",279,0)
- . S ZI=$Q(@ZI)
-"RTN","C0CMCCD",280,0)
- . I ZI="" S DONE=1
-"RTN","C0CMCCD",281,0)
- Q
-"RTN","C0CMCCD",282,0)
- ; 
-"RTN","C0CMCCD",283,0)
-UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
-"RTN","C0CMCCD",284,0)
- K ZERR
-"RTN","C0CMCCD",285,0)
- D CLEAN^DILF
-"RTN","C0CMCCD",286,0)
- D UPDATE^DIE("","C0CFDA","","ZERR")
-"RTN","C0CMCCD",287,0)
- I $D(ZERR) D  ;
 "RTN","C0CMCCD",288,0)
- . W "ERROR",!
-"RTN","C0CMCCD",289,0)
- . ZWR ZERR
-"RTN","C0CMCCD",290,0)
- . B
-"RTN","C0CMCCD",291,0)
- K C0CFDA
-"RTN","C0CMCCD",292,0)
- Q
-"RTN","C0CMCCD",293,0)
  ;
 "RTN","C0CMED")
-0^48^B18939705
+0^48^B18524779
 "RTN","C0CMED",1,0)
 C0CMED ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009
 "RTN","C0CMED",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CMED",3,0)
  ; Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel.
 "RTN","C0CMED",4,0)
- ; Licensed under the terms of the GNU General Public License.
+ ;
 "RTN","C0CMED",5,0)
- ; See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CMED",6,0)
+ ; it under the terms of the GNU Affero General Public License as
+"RTN","C0CMED",7,0)
+ ; published by the Free Software Foundation, either version 3 of the
+"RTN","C0CMED",8,0)
+ ; License, or (at your option) any later version.
+"RTN","C0CMED",9,0)
+ ;
+"RTN","C0CMED",10,0)
+ ; This program is distributed in the hope that it will be useful,
+"RTN","C0CMED",11,0)
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","C0CMED",12,0)
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","C0CMED",13,0)
+ ; GNU Affero General Public License for more details.
+"RTN","C0CMED",14,0)
+ ;
+"RTN","C0CMED",15,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CMED",16,0)
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+"RTN","C0CMED",17,0)
+ ;
+"RTN","C0CMED",18,0)
+ ;
+"RTN","C0CMED",19,0)
+ ; --Revision History
+"RTN","C0CMED",20,0)
+ ; July 2008 - Initial Version/GPL
+"RTN","C0CMED",21,0)
+ ; July 2008 - March 2009 various revisions
+"RTN","C0CMED",22,0)
+ ; March 2009 - Reconstruction of routine as driver for other med routines/SMH
+"RTN","C0CMED",23,0)
+ ;
+"RTN","C0CMED",24,0)
+ Q
+"RTN","C0CMED",25,0)
+EXTRACT(MEDXML,DFN,MEDOUTXML) ; Private; Extract medications into provided XML template
+"RTN","C0CMED",26,0)
+ ; DFN passed by reference
+"RTN","C0CMED",27,0)
+ ; MEDXML and MEDOUTXML are passed by Name
+"RTN","C0CMED",28,0)
+ ; MEDXML is the input template
+"RTN","C0CMED",29,0)
+ ; MEDOUTXML is the output template
+"RTN","C0CMED",30,0)
+ ; Both of them refer to ^TMP globals where the XML documents are stored
+"RTN","C0CMED",31,0)
  ; 
-"RTN","C0CMED",7,0)
- ; This program is free software; you can redistribute it and/or modify
-"RTN","C0CMED",8,0)
- ; it under the terms of the GNU General Public License as published by
-"RTN","C0CMED",9,0)
- ; the Free Software Foundation; either version 2 of the License, or
-"RTN","C0CMED",10,0)
- ; (at your option) any later version.
-"RTN","C0CMED",11,0)
- ; 
-"RTN","C0CMED",12,0)
- ; This program is distributed in the hope that it will be useful,
-"RTN","C0CMED",13,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","C0CMED",14,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-"RTN","C0CMED",15,0)
- ; GNU General Public License for more details.
-"RTN","C0CMED",16,0)
- ; 
-"RTN","C0CMED",17,0)
- ; You should have received a copy of the GNU General Public License along
-"RTN","C0CMED",18,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
-"RTN","C0CMED",19,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","C0CMED",20,0)
- ;
-"RTN","C0CMED",21,0)
- ; --Revision History
-"RTN","C0CMED",22,0)
- ; July 2008 - Initial Version/GPL
-"RTN","C0CMED",23,0)
- ; July 2008 - March 2009 various revisions
-"RTN","C0CMED",24,0)
- ; March 2009 - Reconstruction of routine as driver for other med routines/SMH
-"RTN","C0CMED",25,0)
- ;
-"RTN","C0CMED",26,0)
+"RTN","C0CMED",32,0)
+ ; -- This ep is the driver for extracting medications into the provided XML template
+"RTN","C0CMED",33,0)
+ ; 1. VA Outpatient Meds are in C0CMED1
+"RTN","C0CMED",34,0)
+ ; 2. VA Pending Meds are in C0CMED2
+"RTN","C0CMED",35,0)
+ ; 3. VA non-VA Meds are in C0CMED3
+"RTN","C0CMED",36,0)
+ ; 4. VA Inpatient IV Meds are in C0CMED4 (not functional)
+"RTN","C0CMED",37,0)
+ ; 5. VA Inpatient UD Meds are in C0CMED5 (doesn't exist yet)--March 2009
+"RTN","C0CMED",38,0)
+ ; 6. RPMS Meds are in C0CMED6. Need to create other routines for subdivisions of RPMS Meds is not known at this time.
+"RTN","C0CMED",39,0)
+ ;
+"RTN","C0CMED",40,0)
+ ; --Get parameters for meds
+"RTN","C0CMED",41,0)
+ S @MEDOUTXML@(0)=0 ; By default, empty.
+"RTN","C0CMED",42,0)
+ N C0CMFLAG
+"RTN","C0CMED",43,0)
+ S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING")
+"RTN","C0CMED",44,0)
+ W:$G(DEBUG) "Med Parameters: ",!
+"RTN","C0CMED",45,0)
+ W:$G(DEBUG) "ALL: ",+C0CMFLAG,!
+"RTN","C0CMED",46,0)
+ W:$G(DEBUG) "LIMIT: ",$P(C0CMFLAG,U,2),!
+"RTN","C0CMED",47,0)
+ W:$G(DEBUG) "ACTIVE: ",$P(C0CMFLAG,U,3),!
+"RTN","C0CMED",48,0)
+ W:$G(DEBUG) "PEND: ",$P(C0CMFLAG,U,4),!
+"RTN","C0CMED",49,0)
+ ; --Find out what system we are on and branch out...
+"RTN","C0CMED",50,0)
+ W:$G(DEBUG) "Agenecy: ",$G(DUZ("AG"))
+"RTN","C0CMED",51,0)
+ I $$RPMS^C0CUTIL() D RPMS QUIT
+"RTN","C0CMED",52,0)
+ I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT
+"RTN","C0CMED",53,0)
+RPMS ;
+"RTN","C0CMED",54,0)
+ ;D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML,C0CMFLAG) QUIT
+"RTN","C0CMED",55,0)
+ N MEDCOUNT S MEDCOUNT=0
+"RTN","C0CMED",56,0)
+ K ^TMP($J,"MED")
+"RTN","C0CMED",57,0)
+ N HIST S HIST=$NA(^TMP($J,"MED","HIST")) ; Meds already dispensed
+"RTN","C0CMED",58,0)
+ N NVA S NVA=$NA(^TMP($J,"MED","NVA")) ; non-VA Meds
+"RTN","C0CMED",59,0)
+ S @HIST@(0)=0,@NVA@(0)=0 ; At first, they are all empty... (prevent undefined errors)
+"RTN","C0CMED",60,0)
+ D EXTRACT^C0CMED6(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds
+"RTN","C0CMED",61,0)
+ D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds 
+"RTN","C0CMED",62,0)
+ I @HIST@(0)>0 D
+"RTN","C0CMED",63,0)
+ . D CP^C0CXPATH(HIST,MEDOUTXML)
+"RTN","C0CMED",64,0)
+ . W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
+"RTN","C0CMED",65,0)
+ I @NVA@(0)>0 D
+"RTN","C0CMED",66,0)
+ . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,NVA)
+"RTN","C0CMED",67,0)
+ . ;E  D CP^C0CXPATH(NVA,MEDOUTXML) 
+"RTN","C0CMED",68,0)
+ . W:$G(DEBUG) "HAS NON-VA MEDS",!
+"RTN","C0CMED",69,0)
  Q
-"RTN","C0CMED",27,0)
-EXTRACT(MEDXML,DFN,MEDOUTXML) ; Private; Extract medications into provided XML template
-"RTN","C0CMED",28,0)
- ; DFN passed by reference
-"RTN","C0CMED",29,0)
- ; MEDXML and MEDOUTXML are passed by Name
-"RTN","C0CMED",30,0)
- ; MEDXML is the input template
-"RTN","C0CMED",31,0)
- ; MEDOUTXML is the output template
-"RTN","C0CMED",32,0)
- ; Both of them refer to ^TMP globals where the XML documents are stored
-"RTN","C0CMED",33,0)
- ; 
-"RTN","C0CMED",34,0)
- ; -- This ep is the driver for extracting medications into the provided XML template
-"RTN","C0CMED",35,0)
- ; 1. VA Outpatient Meds are in C0CMED1
-"RTN","C0CMED",36,0)
- ; 2. VA Pending Meds are in C0CMED2
-"RTN","C0CMED",37,0)
- ; 3. VA non-VA Meds are in C0CMED3
-"RTN","C0CMED",38,0)
- ; 4. VA Inpatient IV Meds are in C0CMED4 (not functional)
-"RTN","C0CMED",39,0)
- ; 5. VA Inpatient UD Meds are in C0CMED5 (doesn't exist yet)--March 2009
-"RTN","C0CMED",40,0)
- ; 6. RPMS Meds are in C0CMED6. Need to create other routines for subdivisions of RPMS Meds is not known at this time.
-"RTN","C0CMED",41,0)
- ;
-"RTN","C0CMED",42,0)
- ; --Get parameters for meds
-"RTN","C0CMED",43,0)
- S @MEDOUTXML@(0)=0 ; By default, empty.
-"RTN","C0CMED",44,0)
- N C0CMFLAG
-"RTN","C0CMED",45,0)
- S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING")
-"RTN","C0CMED",46,0)
- W:$G(DEBUG) "Med Parameters: ",!
-"RTN","C0CMED",47,0)
- W:$G(DEBUG) "ALL: ",+C0CMFLAG,!
-"RTN","C0CMED",48,0)
- W:$G(DEBUG) "LIMIT: ",$P(C0CMFLAG,U,2),!
-"RTN","C0CMED",49,0)
- W:$G(DEBUG) "ACTIVE: ",$P(C0CMFLAG,U,3),!
-"RTN","C0CMED",50,0)
- W:$G(DEBUG) "PEND: ",$P(C0CMFLAG,U,4),!
-"RTN","C0CMED",51,0)
- ; --Find out what system we are on and branch out...
-"RTN","C0CMED",52,0)
- W:$G(DEBUG) "Agenecy: ",$G(DUZ("AG"))
-"RTN","C0CMED",53,0)
- I $$RPMS^C0CUTIL() D RPMS QUIT
-"RTN","C0CMED",54,0)
- I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT
-"RTN","C0CMED",55,0)
-RPMS 
-"RTN","C0CMED",56,0)
- ;D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML,C0CMFLAG) QUIT
-"RTN","C0CMED",57,0)
+"RTN","C0CMED",70,0)
+VISTA ; 
+"RTN","C0CMED",71,0)
  N MEDCOUNT S MEDCOUNT=0
-"RTN","C0CMED",58,0)
+"RTN","C0CMED",72,0)
  K ^TMP($J,"MED")
-"RTN","C0CMED",59,0)
+"RTN","C0CMED",73,0)
  N HIST S HIST=$NA(^TMP($J,"MED","HIST")) ; Meds already dispensed
-"RTN","C0CMED",60,0)
+"RTN","C0CMED",74,0)
+ N PEND S PEND=$NA(^TMP($J,"MED","PEND")) ; Pending Meds
+"RTN","C0CMED",75,0)
  N NVA S NVA=$NA(^TMP($J,"MED","NVA")) ; non-VA Meds
-"RTN","C0CMED",61,0)
- S @HIST@(0)=0,@NVA@(0)=0 ; At first, they are all empty... (prevent undefined errors)
-"RTN","C0CMED",62,0)
- D EXTRACT^C0CMED6(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds
-"RTN","C0CMED",63,0)
- D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds 
-"RTN","C0CMED",64,0)
- I @HIST@(0)>0 D  
-"RTN","C0CMED",65,0)
+"RTN","C0CMED",76,0)
+ K @HIST K @PEND K @NVA ; MAKE SURE THEY ARE EMPTY
+"RTN","C0CMED",77,0)
+ S @HIST@(0)=0,@PEND@(0)=0,@NVA@(0)=0 ; At first, they are all empty... (prevent undefined errors)
+"RTN","C0CMED",78,0)
+ ; N IPIV ; Inpatient IV Meds
+"RTN","C0CMED",79,0)
+ N IPUD S IPUD=$NA(^TMP($J,"MED","IPUD")) ; Inpatient UD Meds
+"RTN","C0CMED",80,0)
+ K @IPUD
+"RTN","C0CMED",81,0)
+ S @IPUD@(0)=0
+"RTN","C0CMED",82,0)
+ ;
+"RTN","C0CMED",83,0)
+ D EXTRACT^C0CMED1(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds
+"RTN","C0CMED",84,0)
+ D:$P(C0CMFLAG,U,4) EXTRACT^C0CMED2(MEDXML,DFN,PEND,.MEDCOUNT) ; Pending Meds
+"RTN","C0CMED",85,0)
+ ;D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds 
+"RTN","C0CMED",86,0)
+ D EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds GPL
+"RTN","C0CMED",87,0)
+ D EXTRACT^C0CNMED4(MEDXML,DFN,IPUD,.MEDCOUNT) ; inpatient gpl
+"RTN","C0CMED",88,0)
+ I @HIST@(0)>0 D
+"RTN","C0CMED",89,0)
  . D CP^C0CXPATH(HIST,MEDOUTXML)
-"RTN","C0CMED",66,0)
+"RTN","C0CMED",90,0)
  . W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
-"RTN","C0CMED",67,0)
- I @NVA@(0)>0 D 
-"RTN","C0CMED",68,0)
- . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,NVA) 
-"RTN","C0CMED",69,0)
- . ;E  D CP^C0CXPATH(NVA,MEDOUTXML) 
-"RTN","C0CMED",70,0)
+"RTN","C0CMED",91,0)
+ I @PEND@(0)>0 D
+"RTN","C0CMED",92,0)
+ . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,PEND) ;Add Pending to Historical
+"RTN","C0CMED",93,0)
+ . E  D CP^C0CXPATH(PEND,MEDOUTXML) ; No historical, just copy
+"RTN","C0CMED",94,0)
+ . W:$G(DEBUG) "HAS OP PENDING MEDS",!
+"RTN","C0CMED",95,0)
+ I @NVA@(0)>0 D
+"RTN","C0CMED",96,0)
+ . I @HIST@(0)>0!(@PEND@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,NVA)
+"RTN","C0CMED",97,0)
+ . E  D CP^C0CXPATH(NVA,MEDOUTXML)
+"RTN","C0CMED",98,0)
  . W:$G(DEBUG) "HAS NON-VA MEDS",!
-"RTN","C0CMED",71,0)
+"RTN","C0CMED",99,0)
+ I @IPUD@(0)>0 D
+"RTN","C0CMED",100,0)
+ . I @HIST@(0)>0!(@PEND@(0)>0)!(@NVA@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,IPUD)
+"RTN","C0CMED",101,0)
+ . E  D CP^C0CXPATH(IPUD,MEDOUTXML)
+"RTN","C0CMED",102,0)
+ . W:$G(DEBUG) "HAS INPATIENT MEDS",!
+"RTN","C0CMED",103,0)
+ N ZI
+"RTN","C0CMED",104,0)
+ S ZI=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
+"RTN","C0CMED",105,0)
+ M ^TMP("C0CRIM","VARS",DFN,"MEDS")=@ZI ; PERSIST MEDS VARIABLES
+"RTN","C0CMED",106,0)
+ K @ZI ; CLEAN UP MED MAP AFTER - GPL 10/10
+"RTN","C0CMED",107,0)
+ K @PEND
+"RTN","C0CMED",108,0)
+ K @HIST
+"RTN","C0CMED",109,0)
+ K @NVA
+"RTN","C0CMED",110,0)
+ K @IPUD
+"RTN","C0CMED",111,0)
  Q
-"RTN","C0CMED",72,0)
-VISTA 
-"RTN","C0CMED",73,0)
- N MEDCOUNT S MEDCOUNT=0
-"RTN","C0CMED",74,0)
- K ^TMP($J,"MED")
-"RTN","C0CMED",75,0)
- N HIST S HIST=$NA(^TMP($J,"MED","HIST")) ; Meds already dispensed
-"RTN","C0CMED",76,0)
- N PEND S PEND=$NA(^TMP($J,"MED","PEND")) ; Pending Meds
-"RTN","C0CMED",77,0)
- N NVA S NVA=$NA(^TMP($J,"MED","NVA")) ; non-VA Meds
-"RTN","C0CMED",78,0)
- K @HIST K @PEND K @NVA ; MAKE SURE THEY ARE EMPTY
-"RTN","C0CMED",79,0)
- S @HIST@(0)=0,@PEND@(0)=0,@NVA@(0)=0 ; At first, they are all empty... (prevent undefined errors)
-"RTN","C0CMED",80,0)
- ; N IPIV ; Inpatient IV Meds
-"RTN","C0CMED",81,0)
- N IPUD S IPUD=$NA(^TMP($J,"MED","IPUD")) ; Inpatient UD Meds
-"RTN","C0CMED",82,0)
- K @IPUD
-"RTN","C0CMED",83,0)
- S @IPUD@(0)=0
-"RTN","C0CMED",84,0)
- ;
-"RTN","C0CMED",85,0)
- D EXTRACT^C0CMED1(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds
-"RTN","C0CMED",86,0)
- D:$P(C0CMFLAG,U,4) EXTRACT^C0CMED2(MEDXML,DFN,PEND,.MEDCOUNT) ; Pending Meds
-"RTN","C0CMED",87,0)
- ;D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds 
-"RTN","C0CMED",88,0)
- D EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds GPL
-"RTN","C0CMED",89,0)
- D EXTRACT^C0CNMED4(MEDXML,DFN,IPUD,.MEDCOUNT) ; inpatient gpl
-"RTN","C0CMED",90,0)
- I @HIST@(0)>0 D  
-"RTN","C0CMED",91,0)
- . D CP^C0CXPATH(HIST,MEDOUTXML)
-"RTN","C0CMED",92,0)
- . W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
-"RTN","C0CMED",93,0)
- I @PEND@(0)>0 D  
-"RTN","C0CMED",94,0)
- . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,PEND) ;Add Pending to Historical
-"RTN","C0CMED",95,0)
- . E  D CP^C0CXPATH(PEND,MEDOUTXML) ; No historical, just copy
-"RTN","C0CMED",96,0)
- . W:$G(DEBUG) "HAS OP PENDING MEDS",!
-"RTN","C0CMED",97,0)
- I @NVA@(0)>0 D 
-"RTN","C0CMED",98,0)
- . I @HIST@(0)>0!(@PEND@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,NVA) 
-"RTN","C0CMED",99,0)
- . E  D CP^C0CXPATH(NVA,MEDOUTXML) 
-"RTN","C0CMED",100,0)
- . W:$G(DEBUG) "HAS NON-VA MEDS",!
-"RTN","C0CMED",101,0)
- I @IPUD@(0)>0 D 
-"RTN","C0CMED",102,0)
- . I @HIST@(0)>0!(@PEND@(0)>0)!(@NVA@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,IPUD) 
-"RTN","C0CMED",103,0)
- . E  D CP^C0CXPATH(IPUD,MEDOUTXML) 
-"RTN","C0CMED",104,0)
- . W:$G(DEBUG) "HAS INPATIENT MEDS",!
-"RTN","C0CMED",105,0)
- N ZI
-"RTN","C0CMED",106,0)
- S ZI=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
-"RTN","C0CMED",107,0)
- M ^TMP("C0CRIM","VARS",DFN,"MEDS")=@ZI ; PERSIST MEDS VARIABLES
-"RTN","C0CMED",108,0)
- K @ZI ; CLEAN UP MED MAP AFTER - GPL 10/10
-"RTN","C0CMED",109,0)
- K @PEND
-"RTN","C0CMED",110,0)
- K @HIST
-"RTN","C0CMED",111,0)
- K @NVA
-"RTN","C0CMED",112,0)
- K @IPUD
-"RTN","C0CMED",113,0)
- Q
-"RTN","C0CMED",114,0)
- 
 "RTN","C0CMED1")
-0^49^B113570971
+0^49^B112207077
 "RTN","C0CMED1",1,0)
 C0CMED1 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;01/10/09
 "RTN","C0CMED1",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CMED1",3,0)
  ;;Last modified Sat Jan 10 21:42:27 PST 2009
 "RTN","C0CMED1",4,0)
- ; Copyright 2009 WorldVistA.  Licensed under the terms of the GNU
+ ; Copyright 2009 WorldVistA.  
 "RTN","C0CMED1",5,0)
- ; General Public License See attached copy of the License.
+ ;
 "RTN","C0CMED1",6,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CMED1",7,0)
- ; This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CMED1",8,0)
- ; it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CMED1",9,0)
- ; the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CMED1",10,0)
- ; (at your option) any later version.
+ ;
 "RTN","C0CMED1",11,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CMED1",12,0)
- ; This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CMED1",13,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CMED1",14,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CMED1",15,0)
- ; GNU General Public License for more details.
+ ;
 "RTN","C0CMED1",16,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CMED1",17,0)
- ; You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CMED1",18,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CMED1",19,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ W "NO ENTRY FROM TOP",!
 "RTN","C0CMED1",20,0)
- ;
+ Q
 "RTN","C0CMED1",21,0)
- W "NO ENTRY FROM TOP",!
+ ;
 "RTN","C0CMED1",22,0)
- Q
+EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT,FLAGS) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
 "RTN","C0CMED1",23,0)
  ;
 "RTN","C0CMED1",24,0)
-EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT,FLAGS) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
+ ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
 "RTN","C0CMED1",25,0)
- ;
+ ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
 "RTN","C0CMED1",26,0)
- ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+ ;
 "RTN","C0CMED1",27,0)
- ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
+ ; MEDS is return array from RPC.
 "RTN","C0CMED1",28,0)
- ;
+ ; MAP is a mapping variable map (store result) for each med
 "RTN","C0CMED1",29,0)
- ; MEDS is return array from RPC.
+ ; MED is holds each array element from MEDS(J), one medicine
 "RTN","C0CMED1",30,0)
- ; MAP is a mapping variable map (store result) for each med
+ ; MEDCOUNT is a counter passed by Reference.
 "RTN","C0CMED1",31,0)
- ; MED is holds each array element from MEDS(J), one medicine
+ ; FLAGS are: MEDALL(bool)^MEDLIMIT(int)^MEDACTIVE(bool)^MEDPENDING(bool)
 "RTN","C0CMED1",32,0)
- ; MEDCOUNT is a counter passed by Reference.
+ ; FLAGS are set-up in C0CMED.
 "RTN","C0CMED1",33,0)
- ; FLAGS are: MEDALL(bool)^MEDLIMIT(int)^MEDACTIVE(bool)^MEDPENDING(bool)
+ ;
 "RTN","C0CMED1",34,0)
- ; FLAGS are set-up in C0CMED.
+ ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
 "RTN","C0CMED1",35,0)
- ;
+ ; med data available.
 "RTN","C0CMED1",36,0)
- ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
+ ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
 "RTN","C0CMED1",37,0)
- ; med data available.
+ ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
 "RTN","C0CMED1",38,0)
- ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
+ ; D PARY^C0CXPATH(MINXML)
 "RTN","C0CMED1",39,0)
- ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
+ N MEDS,MAP
 "RTN","C0CMED1",40,0)
- ; D PARY^C0CXPATH(MINXML)
+ K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
 "RTN","C0CMED1",41,0)
- N MEDS,MAP
+ N ALL S ALL=+FLAGS
 "RTN","C0CMED1",42,0)
- K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
+ N ACTIVE S ACTIVE=$P(FLAGS,U,3)
 "RTN","C0CMED1",43,0)
- N ALL S ALL=+FLAGS
+ N PENDING S PENDING=$P(FLAGS,U,4) ;OHUM/RUT 3120504 ADDED FOR VALIDATION OF PENDING MEDICATIONS
 "RTN","C0CMED1",44,0)
- N ACTIVE S ACTIVE=$P(FLAGS,U,3)
+ ; Below, X1 is today; X2 is the number of days we want to go back
 "RTN","C0CMED1",45,0)
- N PENDING S PENDING=$P(FLAGS,U,4) ;OHUM/RUT 3120504 ADDED FOR VALIDATION OF PENDING MEDICATIONS
+ ; X is the result of this calculation using C^%DTC.
 "RTN","C0CMED1",46,0)
- ; Below, X1 is today; X2 is the number of days we want to go back
+ N X,X1,X2
 "RTN","C0CMED1",47,0)
- ; X is the result of this calculation using C^%DTC.
+ S X1=DT
 "RTN","C0CMED1",48,0)
- N X,X1,X2
+ S X2=-$P($P(FLAGS,U,2),"-",2)
 "RTN","C0CMED1",49,0)
- S X1=DT
+ D C^%DTC
 "RTN","C0CMED1",50,0)
- S X2=-$P($P(FLAGS,U,2),"-",2)
+ ; I discovered that I shouldn't put an ending date (last parameter)
 "RTN","C0CMED1",51,0)
- D C^%DTC
+ ; because it seems that it will get meds whose beginning is after X but
 "RTN","C0CMED1",52,0)
- ; I discovered that I shouldn't put an ending date (last parameter)
+ ; whose exipriation is before the ending date.
 "RTN","C0CMED1",53,0)
- ; because it seems that it will get meds whose beginning is after X but
+ D RX^PSO52API(DFN,"CCDCCR","","","",X,"")
 "RTN","C0CMED1",54,0)
- ; whose exipriation is before the ending date.
+ M MEDS=^TMP($J,"CCDCCR",DFN)
 "RTN","C0CMED1",55,0)
- D RX^PSO52API(DFN,"CCDCCR","","","",X,"")
+ ; @(0) contains the number of meds or -1^NO DATA FOUND
 "RTN","C0CMED1",56,0)
- M MEDS=^TMP($J,"CCDCCR",DFN)
+ ; If it is -1, we quit.
 "RTN","C0CMED1",57,0)
- ; @(0) contains the number of meds or -1^NO DATA FOUND
+ I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 Q
 "RTN","C0CMED1",58,0)
- ; If it is -1, we quit.
+ ; ZWRITE:$G(DEBUG) MEDS
 "RTN","C0CMED1",59,0)
- I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 Q
+ N RXIEN S RXIEN=0
 "RTN","C0CMED1",60,0)
- ZWRITE:$G(DEBUG) MEDS
+ F  S RXIEN=$O(MEDS(RXIEN)) Q:$G(RXIEN)=""  D  ; FOR EACH MEDICATION IN THE LIST
 "RTN","C0CMED1",61,0)
- N RXIEN S RXIEN=0
+ . N MED M MED=MEDS(RXIEN)
 "RTN","C0CMED1",62,0)
- F  S RXIEN=$O(MEDS(RXIEN)) Q:$G(RXIEN)=""  D  ; FOR EACH MEDICATION IN THE LIST
+ . I 'ALL,ACTIVE,$P(MED(100),U,2)'="ACTIVE" QUIT
 "RTN","C0CMED1",63,0)
- . N MED M MED=MEDS(RXIEN)
+ . I 'ALL,PENDING,$P(MED(100),U,2)'="PENDING" QUIT  ;OHUM/RUT 3120504 ADDED FOR VALIDATION OF PENDING MEDICATIONS
 "RTN","C0CMED1",64,0)
- . I 'ALL,ACTIVE,$P(MED(100),U,2)'="ACTIVE" QUIT
+ . S MEDCOUNT=MEDCOUNT+1
 "RTN","C0CMED1",65,0)
- . I 'ALL,PENDING,$P(MED(100),U,2)'="PENDING" QUIT ;OHUM/RUT 3120504 ADDED FOR VALIDATION OF PENDING MEDICATIONS
+ . W:$G(DEBUG) "RXIEN IS ",RXIEN,!
 "RTN","C0CMED1",66,0)
- . S MEDCOUNT=MEDCOUNT+1
+ . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
 "RTN","C0CMED1",67,0)
- . W:$G(DEBUG) "RXIEN IS ",RXIEN,!
+ . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED
 "RTN","C0CMED1",68,0)
- . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
+ . W:$G(DEBUG) "MAP= ",MAP,!
 "RTN","C0CMED1",69,0)
- . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED
+ . S @MAP@("MEDOBJECTID")="MED"_MEDCOUNT ; MEDCOUNT FOR ID
 "RTN","C0CMED1",70,0)
- . W:$G(DEBUG) "MAP= ",MAP,!
+ . ; S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
 "RTN","C0CMED1",71,0)
- . S @MAP@("MEDOBJECTID")="MED"_MEDCOUNT ; MEDCOUNT FOR ID
+ . S @MAP@("MEDISSUEDATETXT")="Issue Date"
 "RTN","C0CMED1",72,0)
- . ; S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
+ . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(1),U))
 "RTN","C0CMED1",73,0)
- . S @MAP@("MEDISSUEDATETXT")="Issue Date"
+ . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
 "RTN","C0CMED1",74,0)
- . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(1),U))
+ . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P($G(MED(101)),U))
 "RTN","C0CMED1",75,0)
- . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
+ . S @MAP@("MEDRXNOTXT")="Prescription Number"
 "RTN","C0CMED1",76,0)
- . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P($G(MED(101)),U))
+ . S @MAP@("MEDRXNO")=MED(.01)
 "RTN","C0CMED1",77,0)
- . S @MAP@("MEDRXNOTXT")="Prescription Number"
+ . S @MAP@("MEDTYPETEXT")="Medication"
 "RTN","C0CMED1",78,0)
- . S @MAP@("MEDRXNO")=MED(.01)
+ . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
 "RTN","C0CMED1",79,0)
- . S @MAP@("MEDTYPETEXT")="Medication"
+ . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
 "RTN","C0CMED1",80,0)
- . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
+ . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
 "RTN","C0CMED1",81,0)
- . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
+ . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
 "RTN","C0CMED1",82,0)
- . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
+ . ; 12/30/08: I will be using RxNorm for coding...
 "RTN","C0CMED1",83,0)
- . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
+ . ; 176.001 is the file for Concepts; 176.003 is the file for
 "RTN","C0CMED1",84,0)
- . ; 12/30/08: I will be using RxNorm for coding...
+ . ; sources (i.e. for RxNorm Version)
 "RTN","C0CMED1",85,0)
- . ; 176.001 is the file for Concepts; 176.003 is the file for
+ . ;
 "RTN","C0CMED1",86,0)
- . ; sources (i.e. for RxNorm Version)
+ . ; We need the VUID first for the National Drug File entry first
 "RTN","C0CMED1",87,0)
+ . ; We get the VUID of the drug, by looking up the VA Product entry
+"RTN","C0CMED1",88,0)
+ . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
+"RTN","C0CMED1",89,0)
+ . ; Field 99.99 is the VUID.
+"RTN","C0CMED1",90,0)
  . ;
-"RTN","C0CMED1",88,0)
- . ; We need the VUID first for the National Drug File entry first
-"RTN","C0CMED1",89,0)
- . ; We get the VUID of the drug, by looking up the VA Product entry
-"RTN","C0CMED1",90,0)
- . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
 "RTN","C0CMED1",91,0)
- . ; Field 99.99 is the VUID.
+ . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
 "RTN","C0CMED1",92,0)
+ . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
+"RTN","C0CMED1",93,0)
+ . ; $$GET1^DIQ.
+"RTN","C0CMED1",94,0)
  . ;
-"RTN","C0CMED1",93,0)
- . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
-"RTN","C0CMED1",94,0)
- . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
 "RTN","C0CMED1",95,0)
- . ; $$GET1^DIQ.
+ . ; I get the RxNorm name and version from the RxNorm Sources (file
 "RTN","C0CMED1",96,0)
+ . ; 176.003), by searching for "RXNORM", then get the data.
+"RTN","C0CMED1",97,0)
+ . N MEDIEN S MEDIEN=$P(MED(6),U)
+"RTN","C0CMED1",98,0)
+ . D NDF^PSS50(MEDIEN,,,,,"NDF")
+"RTN","C0CMED1",99,0)
+ . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
+"RTN","C0CMED1",100,0)
+ . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
+"RTN","C0CMED1",101,0)
+ . N VAPROD S VAPROD=$P(NDFDATA(22),U)
+"RTN","C0CMED1",102,0)
  . ;
-"RTN","C0CMED1",97,0)
- . ; I get the RxNorm name and version from the RxNorm Sources (file
-"RTN","C0CMED1",98,0)
- . ; 176.003), by searching for "RXNORM", then get the data.
-"RTN","C0CMED1",99,0)
- . N MEDIEN S MEDIEN=$P(MED(6),U)
-"RTN","C0CMED1",100,0)
- . D NDF^PSS50(MEDIEN,,,,,"NDF")
-"RTN","C0CMED1",101,0)
- . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
-"RTN","C0CMED1",102,0)
- . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
 "RTN","C0CMED1",103,0)
- . N VAPROD S VAPROD=$P(NDFDATA(22),U)
+ . ; NDFIEN is not necessarily defined; it won't be if the drug
 "RTN","C0CMED1",104,0)
+ . ; is not matched to the national drug file (e.g. if the drug is
+"RTN","C0CMED1",105,0)
+ . ; new on the market, compounded, or is a fake drug [blue pill].
+"RTN","C0CMED1",106,0)
+ . ; To protect against failure, I will put an if/else block
+"RTN","C0CMED1",107,0)
  . ;
-"RTN","C0CMED1",105,0)
- . ; NDFIEN is not necessarily defined; it won't be if the drug
-"RTN","C0CMED1",106,0)
- . ; is not matched to the national drug file (e.g. if the drug is
-"RTN","C0CMED1",107,0)
- . ; new on the market, compounded, or is a fake drug [blue pill].
 "RTN","C0CMED1",108,0)
- . ; To protect against failure, I will put an if/else block
+ . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
 "RTN","C0CMED1",109,0)
+ . I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
+"RTN","C0CMED1",110,0)
+ . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
+"RTN","C0CMED1",111,0)
+ . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
+"RTN","C0CMED1",112,0)
+ . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
+"RTN","C0CMED1",113,0)
+ . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
+"RTN","C0CMED1",114,0)
+ . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
+"RTN","C0CMED1",115,0)
+ . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
+"RTN","C0CMED1",116,0)
  . ;
-"RTN","C0CMED1",110,0)
- . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
-"RTN","C0CMED1",111,0)
- . I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
-"RTN","C0CMED1",112,0)
- . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
-"RTN","C0CMED1",113,0)
- . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
-"RTN","C0CMED1",114,0)
- . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
-"RTN","C0CMED1",115,0)
- . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
-"RTN","C0CMED1",116,0)
- . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
 "RTN","C0CMED1",117,0)
- . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
+ . E  S (RXNORM,RXNNAME,RXNVER)=""
 "RTN","C0CMED1",118,0)
+ . ; End if/else block
+"RTN","C0CMED1",119,0)
+ . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
+"RTN","C0CMED1",120,0)
+ . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
+"RTN","C0CMED1",121,0)
+ . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
+"RTN","C0CMED1",122,0)
  . ;
-"RTN","C0CMED1",119,0)
- . E  S (RXNORM,RXNNAME,RXNVER)=""
-"RTN","C0CMED1",120,0)
- . ; End if/else block
-"RTN","C0CMED1",121,0)
- . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
-"RTN","C0CMED1",122,0)
- . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
 "RTN","C0CMED1",123,0)
- . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
+ . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
 "RTN","C0CMED1",124,0)
+ . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
+"RTN","C0CMED1",125,0)
+ . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
+"RTN","C0CMED1",126,0)
+ . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
+"RTN","C0CMED1",127,0)
+ . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
+"RTN","C0CMED1",128,0)
+ . ; Units, concentration, etc, come from another call
+"RTN","C0CMED1",129,0)
+ . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
+"RTN","C0CMED1",130,0)
+ . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
+"RTN","C0CMED1",131,0)
+ . ; NDF Entry IEN, and VA Product IEN
+"RTN","C0CMED1",132,0)
+ . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
+"RTN","C0CMED1",133,0)
+ . ; These have been collected above.
+"RTN","C0CMED1",134,0)
+ . N CONCDATA
+"RTN","C0CMED1",135,0)
+ . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
+"RTN","C0CMED1",136,0)
+ . ; and this will crash the call. So...
+"RTN","C0CMED1",137,0)
+ . I NDFIEN="" S CONCDATA=""
+"RTN","C0CMED1",138,0)
+ . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
+"RTN","C0CMED1",139,0)
+ . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
+"RTN","C0CMED1",140,0)
+ . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
+"RTN","C0CMED1",141,0)
+ . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
+"RTN","C0CMED1",142,0)
+ . S @MAP@("MEDQUANTITYVALUE")=MED(7)
+"RTN","C0CMED1",143,0)
+ . ; Oddly, there is no easy place to find the dispense unit.
+"RTN","C0CMED1",144,0)
+ . ; It's not included in the original call, so we have to go to the drug file.
+"RTN","C0CMED1",145,0)
+ . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
+"RTN","C0CMED1",146,0)
+ . ; Node 14.5 is the Dispense Unit
+"RTN","C0CMED1",147,0)
+ . D DATA^PSS50(MEDIEN,,,,,"QTY")
+"RTN","C0CMED1",148,0)
+ . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
+"RTN","C0CMED1",149,0)
+ . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
+"RTN","C0CMED1",150,0)
  . ;
-"RTN","C0CMED1",125,0)
- . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
-"RTN","C0CMED1",126,0)
- . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
-"RTN","C0CMED1",127,0)
- . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
-"RTN","C0CMED1",128,0)
- . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
-"RTN","C0CMED1",129,0)
- . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
-"RTN","C0CMED1",130,0)
- . ; Units, concentration, etc, come from another call
-"RTN","C0CMED1",131,0)
- . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
-"RTN","C0CMED1",132,0)
- . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
-"RTN","C0CMED1",133,0)
- . ; NDF Entry IEN, and VA Product IEN
-"RTN","C0CMED1",134,0)
- . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
-"RTN","C0CMED1",135,0)
- . ; These have been collected above.
-"RTN","C0CMED1",136,0)
- . N CONCDATA
-"RTN","C0CMED1",137,0)
- . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
-"RTN","C0CMED1",138,0)
- . ; and this will crash the call. So...
-"RTN","C0CMED1",139,0)
- . I NDFIEN="" S CONCDATA=""
-"RTN","C0CMED1",140,0)
- . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
-"RTN","C0CMED1",141,0)
- . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
-"RTN","C0CMED1",142,0)
- . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
-"RTN","C0CMED1",143,0)
- . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
-"RTN","C0CMED1",144,0)
- . S @MAP@("MEDQUANTITYVALUE")=MED(7)
-"RTN","C0CMED1",145,0)
- . ; Oddly, there is no easy place to find the dispense unit.
-"RTN","C0CMED1",146,0)
- . ; It's not included in the original call, so we have to go to the drug file.
-"RTN","C0CMED1",147,0)
- . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
-"RTN","C0CMED1",148,0)
- . ; Node 14.5 is the Dispense Unit
-"RTN","C0CMED1",149,0)
- . D DATA^PSS50(MEDIEN,,,,,"QTY")
-"RTN","C0CMED1",150,0)
- . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
 "RTN","C0CMED1",151,0)
- . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
+ . ; --- START OF DIRECTIONS ---
 "RTN","C0CMED1",152,0)
+ . ; Sig data not in any API :-(  Oh yes, you can get the whole thing, but...
+"RTN","C0CMED1",153,0)
+ . ; we want the compoenents.
+"RTN","C0CMED1",154,0)
+ . ; It's in node 6 of ^PSRX(IEN)
+"RTN","C0CMED1",155,0)
+ . ; So, here we go again
+"RTN","C0CMED1",156,0)
+ . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE
+"RTN","C0CMED1",157,0)
+ . ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)
+"RTN","C0CMED1",158,0)
+ . ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE
+"RTN","C0CMED1",159,0)
+ . ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^
+"RTN","C0CMED1",160,0)
  . ;
-"RTN","C0CMED1",153,0)
- . ; --- START OF DIRECTIONS ---
-"RTN","C0CMED1",154,0)
- . ; Sig data not in any API :-(  Oh yes, you can get the whole thing, but...
-"RTN","C0CMED1",155,0)
- . ; we want the compoenents.
-"RTN","C0CMED1",156,0)
- . ; It's in node 6 of ^PSRX(IEN)
-"RTN","C0CMED1",157,0)
- . ; So, here we go again
-"RTN","C0CMED1",158,0)
- . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE
-"RTN","C0CMED1",159,0)
- . ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)
-"RTN","C0CMED1",160,0)
- . ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE
 "RTN","C0CMED1",161,0)
- . ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^
+ . N DIRNUM S DIRNUM=0 ; Sigline number
 "RTN","C0CMED1",162,0)
+ . S DIRCNT=0 ; COUNT OF MULTIPLE DIRECTIONS
+"RTN","C0CMED1",163,0)
+ . F  S DIRNUM=$O(^PSRX(RXIEN,6,DIRNUM)) Q:DIRNUM=""  D
+"RTN","C0CMED1",164,0)
+ . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
+"RTN","C0CMED1",165,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
+"RTN","C0CMED1",166,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
+"RTN","C0CMED1",167,0)
+ . . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,DIRNUM,0)
+"RTN","C0CMED1",168,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$P(SIGDATA,U,9)
+"RTN","C0CMED1",169,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$P(SIGDATA,U,1)
+"RTN","C0CMED1",170,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
+"RTN","C0CMED1",171,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
+"RTN","C0CMED1",172,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
+"RTN","C0CMED1",173,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
+"RTN","C0CMED1",174,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)
+"RTN","C0CMED1",175,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)
+"RTN","C0CMED1",176,0)
+ . . ; Invervals... again another call.
+"RTN","C0CMED1",177,0)
+ . . ; In the wisdom of the original programmers, the schedule is a free text field
+"RTN","C0CMED1",178,0)
+ . . ; However, it gets translated by a call to the administration schedule file
+"RTN","C0CMED1",179,0)
+ . . ; to see if that schedule exists.
+"RTN","C0CMED1",180,0)
+ . . ; That's the same thing I am going to do.
+"RTN","C0CMED1",181,0)
+ . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
+"RTN","C0CMED1",182,0)
+ . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
+"RTN","C0CMED1",183,0)
+ . . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in.
+"RTN","C0CMED1",184,0)
+ . . ; So...
+"RTN","C0CMED1",185,0)
+ . . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE")
+"RTN","C0CMED1",186,0)
+ . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
+"RTN","C0CMED1",187,0)
+ . . N INTERVAL
+"RTN","C0CMED1",188,0)
+ . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
+"RTN","C0CMED1",189,0)
+ . . E  D
+"RTN","C0CMED1",190,0)
+ . . . N SUB S SUB=$O(SCHEDATA(0))
+"RTN","C0CMED1",191,0)
+ . . . S INTERVAL=SCHEDATA(SUB,2)
+"RTN","C0CMED1",192,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
+"RTN","C0CMED1",193,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
+"RTN","C0CMED1",194,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$P(SIGDATA,U,5)
+"RTN","C0CMED1",195,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
+"RTN","C0CMED1",196,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN"
+"RTN","C0CMED1",197,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
+"RTN","C0CMED1",198,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
+"RTN","C0CMED1",199,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
+"RTN","C0CMED1",200,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
+"RTN","C0CMED1",201,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
+"RTN","C0CMED1",202,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
+"RTN","C0CMED1",203,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
+"RTN","C0CMED1",204,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")=""
+"RTN","C0CMED1",205,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
+"RTN","C0CMED1",206,0)
+ . . N DIRMOD S DIRMOD=$P(SIGDATA,U,6)
+"RTN","C0CMED1",207,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$S(DIRMOD="T":"THEN",DIRMOD="A":"AND",DIRMOD="X":"EXCEPT",1:"")
+"RTN","C0CMED1",208,0)
  . ;
-"RTN","C0CMED1",163,0)
- . N DIRNUM S DIRNUM=0 ; Sigline number
-"RTN","C0CMED1",164,0)
- . S DIRCNT=0 ; COUNT OF MULTIPLE DIRECTIONS
-"RTN","C0CMED1",165,0)
- . F  S DIRNUM=$O(^PSRX(RXIEN,6,DIRNUM)) Q:DIRNUM=""  D
-"RTN","C0CMED1",166,0)
- . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
-"RTN","C0CMED1",167,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
-"RTN","C0CMED1",168,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
-"RTN","C0CMED1",169,0)
- . . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,DIRNUM,0)
-"RTN","C0CMED1",170,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$P(SIGDATA,U,9)
-"RTN","C0CMED1",171,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$P(SIGDATA,U,1)
-"RTN","C0CMED1",172,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
-"RTN","C0CMED1",173,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
-"RTN","C0CMED1",174,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
-"RTN","C0CMED1",175,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
-"RTN","C0CMED1",176,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)
-"RTN","C0CMED1",177,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)
-"RTN","C0CMED1",178,0)
- . . ; Invervals... again another call.
-"RTN","C0CMED1",179,0)
- . . ; In the wisdom of the original programmers, the schedule is a free text field
-"RTN","C0CMED1",180,0)
- . . ; However, it gets translated by a call to the administration schedule file
-"RTN","C0CMED1",181,0)
- . . ; to see if that schedule exists.
-"RTN","C0CMED1",182,0)
- . . ; That's the same thing I am going to do.
-"RTN","C0CMED1",183,0)
- . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
-"RTN","C0CMED1",184,0)
- . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
-"RTN","C0CMED1",185,0)
- . . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in.
-"RTN","C0CMED1",186,0)
- . . ; So...
-"RTN","C0CMED1",187,0)
- . . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE")
-"RTN","C0CMED1",188,0)
- . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
-"RTN","C0CMED1",189,0)
- . . N INTERVAL
-"RTN","C0CMED1",190,0)
- . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
-"RTN","C0CMED1",191,0)
- . . E  D
-"RTN","C0CMED1",192,0)
- . . . N SUB S SUB=$O(SCHEDATA(0))
-"RTN","C0CMED1",193,0)
- . . . S INTERVAL=SCHEDATA(SUB,2)
-"RTN","C0CMED1",194,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
-"RTN","C0CMED1",195,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
-"RTN","C0CMED1",196,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$P(SIGDATA,U,5)
-"RTN","C0CMED1",197,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
-"RTN","C0CMED1",198,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN"
-"RTN","C0CMED1",199,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
-"RTN","C0CMED1",200,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
-"RTN","C0CMED1",201,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
-"RTN","C0CMED1",202,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
-"RTN","C0CMED1",203,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
-"RTN","C0CMED1",204,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
-"RTN","C0CMED1",205,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
-"RTN","C0CMED1",206,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")=""
-"RTN","C0CMED1",207,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
-"RTN","C0CMED1",208,0)
- . . N DIRMOD S DIRMOD=$P(SIGDATA,U,6)
 "RTN","C0CMED1",209,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$S(DIRMOD="T":"THEN",DIRMOD="A":"AND",DIRMOD="X":"EXCEPT",1:"")
+ . ; --- END OF DIRECTIONS ---
 "RTN","C0CMED1",210,0)
  . ;
 "RTN","C0CMED1",211,0)
- . ; --- END OF DIRECTIONS ---
+ . ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE"
 "RTN","C0CMED1",212,0)
- . ;
+ . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0))
 "RTN","C0CMED1",213,0)
- . ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE"
+ . ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command"
 "RTN","C0CMED1",214,0)
- . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0))
+ . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0))
 "RTN","C0CMED1",215,0)
- . ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command"
+ . S @MAP@("MEDRFNO")=MED(9)
 "RTN","C0CMED1",216,0)
- . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0))
+ . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
 "RTN","C0CMED1",217,0)
- . S @MAP@("MEDRFNO")=MED(9)
+ . K @RESULT
 "RTN","C0CMED1",218,0)
- . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
+ . D MAP^C0CXPATH(MINXML,MAP,RESULT)
 "RTN","C0CMED1",219,0)
- . K @RESULT
+ . ; MAPPING DIRECTIONS
 "RTN","C0CMED1",220,0)
- . D MAP^C0CXPATH(MINXML,MAP,RESULT)
+ . N DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
 "RTN","C0CMED1",221,0)
- . ; MAPPING DIRECTIONS
+ . N DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
 "RTN","C0CMED1",222,0)
- . N DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
+ . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
 "RTN","C0CMED1",223,0)
- . N DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
+ . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
 "RTN","C0CMED1",224,0)
- . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
+ . ; N MDZ1,MDZNA
 "RTN","C0CMED1",225,0)
- . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
+ . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
 "RTN","C0CMED1",226,0)
- . ; N MDZ1,MDZNA
+ . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
 "RTN","C0CMED1",227,0)
- . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
+ . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
 "RTN","C0CMED1",228,0)
- . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
+ . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
 "RTN","C0CMED1",229,0)
- . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
+ . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
 "RTN","C0CMED1",230,0)
- . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
+ . I MEDCOUNT=1 D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
 "RTN","C0CMED1",231,0)
- . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
+ . E  D INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
 "RTN","C0CMED1",232,0)
- . I MEDCOUNT=1 D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
+ N MEDTMP,MEDI
 "RTN","C0CMED1",233,0)
- . E  D INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
+ D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
 "RTN","C0CMED1",234,0)
- N MEDTMP,MEDI
+ I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
 "RTN","C0CMED1",235,0)
- D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+ . W "MEDICATION MISSING ",!
 "RTN","C0CMED1",236,0)
- I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+ . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
 "RTN","C0CMED1",237,0)
- . W "MEDICATION MISSING ",!
+ Q
 "RTN","C0CMED1",238,0)
- . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","C0CMED1",239,0)
- Q
-"RTN","C0CMED1",240,0)
  ;
 "RTN","C0CMED2")
-0^50^B147041837
+0^50^B145401668
 "RTN","C0CMED2",1,0)
 C0CMED2 ; WV/CCDCCR/SMH - CCR/CCD Meds - Pending for Vista
 "RTN","C0CMED2",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CMED2",3,0)
  ;;Last Modified Sat Jan 10 21:41:14 PST 2009
 "RTN","C0CMED2",4,0)
- ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ; Copyright 2008 WorldVistA.  
 "RTN","C0CMED2",5,0)
- ; General Public License See attached copy of the License.
+ ;
 "RTN","C0CMED2",6,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CMED2",7,0)
- ; This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CMED2",8,0)
- ; it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CMED2",9,0)
- ; the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CMED2",10,0)
- ; (at your option) any later version.
+ ;
 "RTN","C0CMED2",11,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CMED2",12,0)
- ; This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CMED2",13,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CMED2",14,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CMED2",15,0)
- ; GNU General Public License for more details.
+ ;
 "RTN","C0CMED2",16,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CMED2",17,0)
- ; You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CMED2",18,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CMED2",19,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ W "NO ENTRY FROM TOP",!
 "RTN","C0CMED2",20,0)
- ;
+ Q
 "RTN","C0CMED2",21,0)
- W "NO ENTRY FROM TOP",!
+ ;
 "RTN","C0CMED2",22,0)
- Q
+EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT)           ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
 "RTN","C0CMED2",23,0)
  ;
 "RTN","C0CMED2",24,0)
-EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT)           ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
+ ; MINXML is the Input XML Template, passed by name
 "RTN","C0CMED2",25,0)
- ;
+ ; DFN is Patient IEN (by Value)
 "RTN","C0CMED2",26,0)
- ; MINXML is the Input XML Template, passed by name
+ ; OUTXML is the resultant XML (by Name)
 "RTN","C0CMED2",27,0)
- ; DFN is Patient IEN (by Value)
+ ; MEDCOUNT is the current count of extracted meds, passed by Reference
 "RTN","C0CMED2",28,0)
- ; OUTXML is the resultant XML (by Name)
+ ;
 "RTN","C0CMED2",29,0)
- ; MEDCOUNT is the current count of extracted meds, passed by Reference
+ ; MEDS is return array from RPC.
 "RTN","C0CMED2",30,0)
- ;
+ ; MAP is a mapping variable map (store result) for each med
 "RTN","C0CMED2",31,0)
- ; MEDS is return array from RPC.
+ ; MED is holds each array element from MEDS, one medicine
 "RTN","C0CMED2",32,0)
- ; MAP is a mapping variable map (store result) for each med
+ ;
 "RTN","C0CMED2",33,0)
- ; MED is holds each array element from MEDS, one medicine
+ ; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending
 "RTN","C0CMED2",34,0)
- ;
+ ; meds data available.
 "RTN","C0CMED2",35,0)
- ; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending
+ ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
 "RTN","C0CMED2",36,0)
- ; meds data available.
+ ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
 "RTN","C0CMED2",37,0)
- ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
+ ; File for pending meds is 52.41
 "RTN","C0CMED2",38,0)
- ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
+ ; Unfortuantely, API does not supply us with any useful info beyond
 "RTN","C0CMED2",39,0)
- ; File for pending meds is 52.41
+ ; the IEN in 52.41, and the Med Name, and route.
 "RTN","C0CMED2",40,0)
- ; Unfortuantely, API does not supply us with any useful info beyond
+ ; So, most of the info is going to get pulled from 52.41.
 "RTN","C0CMED2",41,0)
- ; the IEN in 52.41, and the Med Name, and route.
+ N MEDS,MAP
 "RTN","C0CMED2",42,0)
- ; So, most of the info is going to get pulled from 52.41.
+ K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
 "RTN","C0CMED2",43,0)
- N MEDS,MAP
+ D PEN^PSO5241(DFN,"CCDCCR")
 "RTN","C0CMED2",44,0)
- K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
+ M MEDS=^TMP($J,"CCDCCR",DFN)
 "RTN","C0CMED2",45,0)
- D PEN^PSO5241(DFN,"CCDCCR")
+ ; @(0) contains the number of meds or -1^NO DATA FOUND
 "RTN","C0CMED2",46,0)
- M MEDS=^TMP($J,"CCDCCR",DFN)
+ ; If it is -1, we quit.
 "RTN","C0CMED2",47,0)
- ; @(0) contains the number of meds or -1^NO DATA FOUND
+ I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
 "RTN","C0CMED2",48,0)
- ; If it is -1, we quit.
+ ; ZWRITE:$G(DEBUG) MEDS
 "RTN","C0CMED2",49,0)
- I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
+ N RXIEN S RXIEN=0
 "RTN","C0CMED2",50,0)
- ZWRITE:$G(DEBUG) MEDS
+ N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED IN THIS SECTION FOR MERGING
 "RTN","C0CMED2",51,0)
- N RXIEN S RXIEN=0
+ F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B"  D  ; FOR EACH MEDICATION IN THE LIST
 "RTN","C0CMED2",52,0)
- N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED IN THIS SECTION FOR MERGING
+ . I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT  ; Dont' want refill request as a "pending" order
 "RTN","C0CMED2",53,0)
- F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B"  D  ; FOR EACH MEDICATION IN THE LIST
+ . S MEDCOUNT=MEDCOUNT+1
 "RTN","C0CMED2",54,0)
- . I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT  ; Dont' want refill request as a "pending" order
+ . I DEBUG W "RXIEN IS ",RXIEN,!
 "RTN","C0CMED2",55,0)
- . S MEDCOUNT=MEDCOUNT+1
+ . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
 "RTN","C0CMED2",56,0)
- . I DEBUG W "RXIEN IS ",RXIEN,!
+ . ; K @MAP DON'T KILL MAP HERE, IT IS DONE IN C0CMED
 "RTN","C0CMED2",57,0)
- . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
+ . I DEBUG W "MAP= ",MAP,!
 "RTN","C0CMED2",58,0)
- . ; K @MAP DON'T KILL MAP HERE, IT IS DONE IN C0CMED
+ . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
 "RTN","C0CMED2",59,0)
- . I DEBUG W "MAP= ",MAP,!
+ . S @MAP@("MEDOBJECTID")="MED_PENDING"_MEDCOUNT ; MEDCOUNT FOR ID
 "RTN","C0CMED2",60,0)
- . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
+ . ; S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN
 "RTN","C0CMED2",61,0)
- . S @MAP@("MEDOBJECTID")="MED_PENDING"_MEDCOUNT ; MEDCOUNT FOR ID
+ . S @MAP@("MEDISSUEDATETXT")="Issue Date"
 "RTN","C0CMED2",62,0)
- . ; S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN
+ . ; Field 6 is "Effective date", and we pull it in timson format w/ I
 "RTN","C0CMED2",63,0)
- . S @MAP@("MEDISSUEDATETXT")="Issue Date"
+ . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($$GET1^DIQ(52.41,RXIEN,6,"I"),"DT")
 "RTN","C0CMED2",64,0)
- . ; Field 6 is "Effective date", and we pull it in timson format w/ I
+ . ; Med never filled; next 4 fields are not applicable.
 "RTN","C0CMED2",65,0)
- . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($$GET1^DIQ(52.41,RXIEN,6,"I"),"DT")
+ . S @MAP@("MEDLASTFILLDATETXT")=""
 "RTN","C0CMED2",66,0)
- . ; Med never filled; next 4 fields are not applicable.
+ . S @MAP@("MEDLASTFILLDATE")=""
 "RTN","C0CMED2",67,0)
- . S @MAP@("MEDLASTFILLDATETXT")=""
+ . S @MAP@("MEDRXNOTXT")=""
 "RTN","C0CMED2",68,0)
- . S @MAP@("MEDLASTFILLDATE")=""
+ . S @MAP@("MEDRXNO")=""
 "RTN","C0CMED2",69,0)
- . S @MAP@("MEDRXNOTXT")=""
+ . S @MAP@("MEDTYPETEXT")="Medication"
 "RTN","C0CMED2",70,0)
- . S @MAP@("MEDRXNO")=""
+ . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
 "RTN","C0CMED2",71,0)
- . S @MAP@("MEDTYPETEXT")="Medication"
+ . S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds
 "RTN","C0CMED2",72,0)
- . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
+ . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I")
 "RTN","C0CMED2",73,0)
- . S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds
+ . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2)
 "RTN","C0CMED2",74,0)
- . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I")
+ . ; NDC not supplied in API, but is rather trivial to obtain
 "RTN","C0CMED2",75,0)
- . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2)
+ . ; MED(11) piece 1 has the IEN of the drug (file 50)
 "RTN","C0CMED2",76,0)
- . ; NDC not supplied in API, but is rather trivial to obtain
+ . ; IEN is field 31 in the drug file.
 "RTN","C0CMED2",77,0)
- . ; MED(11) piece 1 has the IEN of the drug (file 50)
+ . ;
 "RTN","C0CMED2",78,0)
- . ; IEN is field 31 in the drug file.
+ . ; MEDIEN (node 11 in the returned output) might not necessarily be defined
 "RTN","C0CMED2",79,0)
+ . ; It is not defined when a dose in not chosen in CPRS. There is a long
+"RTN","C0CMED2",80,0)
+ . ; series of fields that depend on it. We will use If and Else to deal
+"RTN","C0CMED2",81,0)
+ . ; with that
+"RTN","C0CMED2",82,0)
+ . N MEDIEN S MEDIEN=$P(MED(11),U)
+"RTN","C0CMED2",83,0)
+ . I +MEDIEN>0 D  ; start of if/else block
+"RTN","C0CMED2",84,0)
+ . . ; 12/30/08: I will be using RxNorm for coding...
+"RTN","C0CMED2",85,0)
+ . . ; 176.001 is the file for Concepts; 176.003 is the file for
+"RTN","C0CMED2",86,0)
+ . . ; sources (i.e. for RxNorm Version)
+"RTN","C0CMED2",87,0)
+ . . ;
+"RTN","C0CMED2",88,0)
+ . . ; We need the VUID first for the National Drug File entry first
+"RTN","C0CMED2",89,0)
+ . . ; We get the VUID of the drug, by looking up the VA Product entry
+"RTN","C0CMED2",90,0)
+ . . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
+"RTN","C0CMED2",91,0)
+ . . ; Field 99.99 is the VUID.
+"RTN","C0CMED2",92,0)
+ . . ;
+"RTN","C0CMED2",93,0)
+ . . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
+"RTN","C0CMED2",94,0)
+ . . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
+"RTN","C0CMED2",95,0)
+ . . ; $$GET1^DIQ.
+"RTN","C0CMED2",96,0)
+ . . ;
+"RTN","C0CMED2",97,0)
+ . . ; I get the RxNorm name and version from the RxNorm Sources (file
+"RTN","C0CMED2",98,0)
+ . . ; 176.003), by searching for "RXNORM", then get the data.
+"RTN","C0CMED2",99,0)
+ . . D NDF^PSS50(MEDIEN,,,,,"NDF")
+"RTN","C0CMED2",100,0)
+ . . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
+"RTN","C0CMED2",101,0)
+ . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
+"RTN","C0CMED2",102,0)
+ . . N VAPROD S VAPROD=$P(NDFDATA(22),U)
+"RTN","C0CMED2",103,0)
+ . . ;
+"RTN","C0CMED2",104,0)
+ . . ; NDFIEN is not necessarily defined; it won't be if the drug
+"RTN","C0CMED2",105,0)
+ . . ; is not matched to the national drug file (e.g. if the drug is
+"RTN","C0CMED2",106,0)
+ . . ; new on the market, compounded, or is a fake drug [blue pill].
+"RTN","C0CMED2",107,0)
+ . . ; To protect against failure, I will put an if/else block
+"RTN","C0CMED2",108,0)
+ . . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
+"RTN","C0CMED2",109,0)
+ . . I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
+"RTN","C0CMED2",110,0)
+ . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
+"RTN","C0CMED2",111,0)
+ . . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
+"RTN","C0CMED2",112,0)
+ . . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
+"RTN","C0CMED2",113,0)
+ . . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
+"RTN","C0CMED2",114,0)
+ . . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
+"RTN","C0CMED2",115,0)
+ . . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
+"RTN","C0CMED2",116,0)
+ . . ;
+"RTN","C0CMED2",117,0)
+ . . E  S (RXNORM,RXNNAME,RXNVER)=""
+"RTN","C0CMED2",118,0)
+ . . ; End if/else block
+"RTN","C0CMED2",119,0)
+ . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
+"RTN","C0CMED2",120,0)
+ . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
+"RTN","C0CMED2",121,0)
+ . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
+"RTN","C0CMED2",122,0)
+ . . ;
+"RTN","C0CMED2",123,0)
+ . . S @MAP@("MEDBRANDNAMETEXT")=""
+"RTN","C0CMED2",124,0)
+ . . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
+"RTN","C0CMED2",125,0)
+ . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
+"RTN","C0CMED2",126,0)
+ . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
+"RTN","C0CMED2",127,0)
+ . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
+"RTN","C0CMED2",128,0)
+ . . ; Units, concentration, etc, come from another call
+"RTN","C0CMED2",129,0)
+ . . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
+"RTN","C0CMED2",130,0)
+ . . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
+"RTN","C0CMED2",131,0)
+ . . ; NDF Entry IEN, and VA Product Name
+"RTN","C0CMED2",132,0)
+ . . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
+"RTN","C0CMED2",133,0)
+ . . ; Documented in the same manual; executed above.
+"RTN","C0CMED2",134,0)
+ . . N CONCDATA
+"RTN","C0CMED2",135,0)
+ . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
+"RTN","C0CMED2",136,0)
+ . . ; and this will crash the call. So...
+"RTN","C0CMED2",137,0)
+ . . I NDFIEN="" S CONCDATA=""
+"RTN","C0CMED2",138,0)
+ . . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
+"RTN","C0CMED2",139,0)
+ . . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
+"RTN","C0CMED2",140,0)
+ . . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
+"RTN","C0CMED2",141,0)
+ . . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
+"RTN","C0CMED2",142,0)
+ . . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12)
+"RTN","C0CMED2",143,0)
+ . . ; Oddly, there is no easy place to find the dispense unit.
+"RTN","C0CMED2",144,0)
+ . . ; It's not included in the original call, so we have to go to the drug file.
+"RTN","C0CMED2",145,0)
+ . . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
+"RTN","C0CMED2",146,0)
+ . . ; Node 14.5 is the Dispense Unit
+"RTN","C0CMED2",147,0)
+ . . D DATA^PSS50(MEDIEN,,,,,"QTY")
+"RTN","C0CMED2",148,0)
+ . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
+"RTN","C0CMED2",149,0)
+ . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
+"RTN","C0CMED2",150,0)
+ . E  D
+"RTN","C0CMED2",151,0)
+ . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
+"RTN","C0CMED2",152,0)
+ . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
+"RTN","C0CMED2",153,0)
+ . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""
+"RTN","C0CMED2",154,0)
+ . . S @MAP@("MEDBRANDNAMETEXT")=""
+"RTN","C0CMED2",155,0)
+ . . S @MAP@("MEDSTRENGTHVALUE")=""
+"RTN","C0CMED2",156,0)
+ . . S @MAP@("MEDSTRENGTHUNIT")=""
+"RTN","C0CMED2",157,0)
+ . . S @MAP@("MEDFORMTEXT")=""
+"RTN","C0CMED2",158,0)
+ . . S @MAP@("MEDCONCVALUE")=""
+"RTN","C0CMED2",159,0)
+ . . S @MAP@("MEDCONCUNIT")=""
+"RTN","C0CMED2",160,0)
+ . . S @MAP@("MEDSIZETEXT")=""
+"RTN","C0CMED2",161,0)
+ . . S @MAP@("MEDQUANTITYVALUE")=""
+"RTN","C0CMED2",162,0)
+ . . S @MAP@("MEDQUANTITYUNIT")=""
+"RTN","C0CMED2",163,0)
+ . ; end of if/else block
+"RTN","C0CMED2",164,0)
  . ;
-"RTN","C0CMED2",80,0)
- . ; MEDIEN (node 11 in the returned output) might not necessarily be defined
-"RTN","C0CMED2",81,0)
- . ; It is not defined when a dose in not chosen in CPRS. There is a long
-"RTN","C0CMED2",82,0)
- . ; series of fields that depend on it. We will use If and Else to deal
-"RTN","C0CMED2",83,0)
- . ; with that
-"RTN","C0CMED2",84,0)
- . N MEDIEN S MEDIEN=$P(MED(11),U)
-"RTN","C0CMED2",85,0)
- . I +MEDIEN>0 D  ; start of if/else block
-"RTN","C0CMED2",86,0)
- . . ; 12/30/08: I will be using RxNorm for coding...
-"RTN","C0CMED2",87,0)
- . . ; 176.001 is the file for Concepts; 176.003 is the file for
-"RTN","C0CMED2",88,0)
- . . ; sources (i.e. for RxNorm Version)
-"RTN","C0CMED2",89,0)
- . . ;
-"RTN","C0CMED2",90,0)
- . . ; We need the VUID first for the National Drug File entry first
-"RTN","C0CMED2",91,0)
- . . ; We get the VUID of the drug, by looking up the VA Product entry
-"RTN","C0CMED2",92,0)
- . . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
-"RTN","C0CMED2",93,0)
- . . ; Field 99.99 is the VUID.
-"RTN","C0CMED2",94,0)
- . . ;
-"RTN","C0CMED2",95,0)
- . . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
-"RTN","C0CMED2",96,0)
- . . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
-"RTN","C0CMED2",97,0)
- . . ; $$GET1^DIQ.
-"RTN","C0CMED2",98,0)
- . . ;
-"RTN","C0CMED2",99,0)
- . . ; I get the RxNorm name and version from the RxNorm Sources (file
-"RTN","C0CMED2",100,0)
- . . ; 176.003), by searching for "RXNORM", then get the data.
-"RTN","C0CMED2",101,0)
- . . D NDF^PSS50(MEDIEN,,,,,"NDF")
-"RTN","C0CMED2",102,0)
- . . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
-"RTN","C0CMED2",103,0)
- . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
-"RTN","C0CMED2",104,0)
- . . N VAPROD S VAPROD=$P(NDFDATA(22),U)
-"RTN","C0CMED2",105,0)
- . . ;
-"RTN","C0CMED2",106,0)
- . . ; NDFIEN is not necessarily defined; it won't be if the drug
-"RTN","C0CMED2",107,0)
- . . ; is not matched to the national drug file (e.g. if the drug is
-"RTN","C0CMED2",108,0)
- . . ; new on the market, compounded, or is a fake drug [blue pill].
-"RTN","C0CMED2",109,0)
- . . ; To protect against failure, I will put an if/else block
-"RTN","C0CMED2",110,0)
- . . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
-"RTN","C0CMED2",111,0)
- . . I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
-"RTN","C0CMED2",112,0)
- . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
-"RTN","C0CMED2",113,0)
- . . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
-"RTN","C0CMED2",114,0)
- . . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
-"RTN","C0CMED2",115,0)
- . . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
-"RTN","C0CMED2",116,0)
- . . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
-"RTN","C0CMED2",117,0)
- . . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
-"RTN","C0CMED2",118,0)
- . . ;
-"RTN","C0CMED2",119,0)
- . . E  S (RXNORM,RXNNAME,RXNVER)=""
-"RTN","C0CMED2",120,0)
- . . ; End if/else block
-"RTN","C0CMED2",121,0)
- . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
-"RTN","C0CMED2",122,0)
- . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
-"RTN","C0CMED2",123,0)
- . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
-"RTN","C0CMED2",124,0)
- . . ;
-"RTN","C0CMED2",125,0)
- . . S @MAP@("MEDBRANDNAMETEXT")=""
-"RTN","C0CMED2",126,0)
- . . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
-"RTN","C0CMED2",127,0)
- . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
-"RTN","C0CMED2",128,0)
- . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
-"RTN","C0CMED2",129,0)
- . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
-"RTN","C0CMED2",130,0)
- . . ; Units, concentration, etc, come from another call
-"RTN","C0CMED2",131,0)
- . . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
-"RTN","C0CMED2",132,0)
- . . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
-"RTN","C0CMED2",133,0)
- . . ; NDF Entry IEN, and VA Product Name
-"RTN","C0CMED2",134,0)
- . . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
-"RTN","C0CMED2",135,0)
- . . ; Documented in the same manual; executed above.
-"RTN","C0CMED2",136,0)
- . . N CONCDATA
-"RTN","C0CMED2",137,0)
- . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
-"RTN","C0CMED2",138,0)
- . . ; and this will crash the call. So...
-"RTN","C0CMED2",139,0)
- . . I NDFIEN="" S CONCDATA=""
-"RTN","C0CMED2",140,0)
- . . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
-"RTN","C0CMED2",141,0)
- . . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
-"RTN","C0CMED2",142,0)
- . . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
-"RTN","C0CMED2",143,0)
- . . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
-"RTN","C0CMED2",144,0)
- . . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12)
-"RTN","C0CMED2",145,0)
- . . ; Oddly, there is no easy place to find the dispense unit.
-"RTN","C0CMED2",146,0)
- . . ; It's not included in the original call, so we have to go to the drug file.
-"RTN","C0CMED2",147,0)
- . . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
-"RTN","C0CMED2",148,0)
- . . ; Node 14.5 is the Dispense Unit
-"RTN","C0CMED2",149,0)
- . . D DATA^PSS50(MEDIEN,,,,,"QTY")
-"RTN","C0CMED2",150,0)
- . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
-"RTN","C0CMED2",151,0)
- . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
-"RTN","C0CMED2",152,0)
- . E  D
-"RTN","C0CMED2",153,0)
- . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
-"RTN","C0CMED2",154,0)
- . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
-"RTN","C0CMED2",155,0)
- . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""
-"RTN","C0CMED2",156,0)
- . . S @MAP@("MEDBRANDNAMETEXT")=""
-"RTN","C0CMED2",157,0)
- . . S @MAP@("MEDSTRENGTHVALUE")=""
-"RTN","C0CMED2",158,0)
- . . S @MAP@("MEDSTRENGTHUNIT")=""
-"RTN","C0CMED2",159,0)
- . . S @MAP@("MEDFORMTEXT")=""
-"RTN","C0CMED2",160,0)
- . . S @MAP@("MEDCONCVALUE")=""
-"RTN","C0CMED2",161,0)
- . . S @MAP@("MEDCONCUNIT")=""
-"RTN","C0CMED2",162,0)
- . . S @MAP@("MEDSIZETEXT")=""
-"RTN","C0CMED2",163,0)
- . . S @MAP@("MEDQUANTITYVALUE")=""
-"RTN","C0CMED2",164,0)
- . . S @MAP@("MEDQUANTITYUNIT")=""
 "RTN","C0CMED2",165,0)
- . ; end of if/else block
+ . ; --- START OF DIRECTIONS ---
 "RTN","C0CMED2",166,0)
+ . ; Sig data is not in any API. We obtain it using the IEN from
+"RTN","C0CMED2",167,0)
+ . ; the PEN API to file 52.41. It's in field 3, which is a multiple.
+"RTN","C0CMED2",168,0)
+ . ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT)
+"RTN","C0CMED2",169,0)
+ . K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call
+"RTN","C0CMED2",170,0)
+ . D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG")
+"RTN","C0CMED2",171,0)
+ . N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman.
+"RTN","C0CMED2",172,0)
+ . ; FMSIGNUM gets outputted as "IEN,RXIEN,".
+"RTN","C0CMED2",173,0)
+ . ; DIRNUM will be first piece for IEN.
+"RTN","C0CMED2",174,0)
+ . ; DIRNUM is the proper Sigline numer.
+"RTN","C0CMED2",175,0)
+ . ; SIGDATA is the simplfied array. Subscripts are really field numbers
+"RTN","C0CMED2",176,0)
+ . ; in subfile 52.413.
+"RTN","C0CMED2",177,0)
+ . N DIRCNT S DIRCNT=0 ; COUNT OF DIRECTIONS
+"RTN","C0CMED2",178,0)
+ . F  S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM=""  D
+"RTN","C0CMED2",179,0)
+ . . N DIRNUM S DIRNUM=$P(FMSIGNUM,",")
+"RTN","C0CMED2",180,0)
+ . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
+"RTN","C0CMED2",181,0)
+ . . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM)
+"RTN","C0CMED2",182,0)
+ . . ; If this is an order for a refill; it's not really a new order; move on to next
+"RTN","C0CMED2",183,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
+"RTN","C0CMED2",184,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
+"RTN","C0CMED2",185,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=SIGDATA(13)
+"RTN","C0CMED2",186,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=SIGDATA(8)
+"RTN","C0CMED2",187,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
+"RTN","C0CMED2",188,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
+"RTN","C0CMED2",189,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
+"RTN","C0CMED2",190,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
+"RTN","C0CMED2",191,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=SIGDATA(10)
+"RTN","C0CMED2",192,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=SIGDATA(1)
+"RTN","C0CMED2",193,0)
+ . . ; Invervals... again another call.
+"RTN","C0CMED2",194,0)
+ . . ; The schedule is a free text field
+"RTN","C0CMED2",195,0)
+ . . ; However, it gets translated by a call to the administration
+"RTN","C0CMED2",196,0)
+ . . ; schedule file to see if that schedule exists.
+"RTN","C0CMED2",197,0)
+ . . ; That's the same thing I am going to do.
+"RTN","C0CMED2",198,0)
+ . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
+"RTN","C0CMED2",199,0)
+ . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
+"RTN","C0CMED2",200,0)
+ . . ; I looked), PSSFT is the name,
+"RTN","C0CMED2",201,0)
+ . . ; and list is the ^TMP name to store the data in.
+"RTN","C0CMED2",202,0)
+ . . ; Also, freqency may have "PRN" in it, so strip that out
+"RTN","C0CMED2",203,0)
+ . . N FREQ S FREQ=SIGDATA(1)
+"RTN","C0CMED2",204,0)
+ . . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp
+"RTN","C0CMED2",205,0)
+ . . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE")
+"RTN","C0CMED2",206,0)
+ . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
+"RTN","C0CMED2",207,0)
+ . . N INTERVAL
+"RTN","C0CMED2",208,0)
+ . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
+"RTN","C0CMED2",209,0)
+ . . E  D
+"RTN","C0CMED2",210,0)
+ . . . N SUB S SUB=$O(SCHEDATA(0))
+"RTN","C0CMED2",211,0)
+ . . . S INTERVAL=SCHEDATA(SUB,2)
+"RTN","C0CMED2",212,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
+"RTN","C0CMED2",213,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
+"RTN","C0CMED2",214,0)
+ . . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months
+"RTN","C0CMED2",215,0)
+ . . N DUR S DUR=SIGDATA(2)
+"RTN","C0CMED2",216,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR))
+"RTN","C0CMED2",217,0)
+ . . N DURUNIT S DURUNIT=$E(DUR)
+"RTN","C0CMED2",218,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"")
+"RTN","C0CMED2",219,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=SIGDATA(1)["PRN"
+"RTN","C0CMED2",220,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
+"RTN","C0CMED2",221,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
+"RTN","C0CMED2",222,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
+"RTN","C0CMED2",223,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
+"RTN","C0CMED2",224,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
+"RTN","C0CMED2",225,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
+"RTN","C0CMED2",226,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
+"RTN","C0CMED2",227,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field
+"RTN","C0CMED2",228,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
+"RTN","C0CMED2",229,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=SIGDATA(6)
+"RTN","C0CMED2",230,0)
  . ;
-"RTN","C0CMED2",167,0)
- . ; --- START OF DIRECTIONS ---
-"RTN","C0CMED2",168,0)
- . ; Sig data is not in any API. We obtain it using the IEN from
-"RTN","C0CMED2",169,0)
- . ; the PEN API to file 52.41. It's in field 3, which is a multiple.
-"RTN","C0CMED2",170,0)
- . ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT)
-"RTN","C0CMED2",171,0)
- . K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call
-"RTN","C0CMED2",172,0)
- . D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG")
-"RTN","C0CMED2",173,0)
- . N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman.
-"RTN","C0CMED2",174,0)
- . ; FMSIGNUM gets outputted as "IEN,RXIEN,".
-"RTN","C0CMED2",175,0)
- . ; DIRNUM will be first piece for IEN.
-"RTN","C0CMED2",176,0)
- . ; DIRNUM is the proper Sigline numer.
-"RTN","C0CMED2",177,0)
- . ; SIGDATA is the simplfied array. Subscripts are really field numbers
-"RTN","C0CMED2",178,0)
- . ; in subfile 52.413.
-"RTN","C0CMED2",179,0)
- . N DIRCNT S DIRCNT=0 ; COUNT OF DIRECTIONS
-"RTN","C0CMED2",180,0)
- . F  S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM=""  D
-"RTN","C0CMED2",181,0)
- . . N DIRNUM S DIRNUM=$P(FMSIGNUM,",")
-"RTN","C0CMED2",182,0)
- . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
-"RTN","C0CMED2",183,0)
- . . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM)
-"RTN","C0CMED2",184,0)
- . . ; If this is an order for a refill; it's not really a new order; move on to next
-"RTN","C0CMED2",185,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
-"RTN","C0CMED2",186,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
-"RTN","C0CMED2",187,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=SIGDATA(13)
-"RTN","C0CMED2",188,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=SIGDATA(8)
-"RTN","C0CMED2",189,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
-"RTN","C0CMED2",190,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
-"RTN","C0CMED2",191,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
-"RTN","C0CMED2",192,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
-"RTN","C0CMED2",193,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=SIGDATA(10)
-"RTN","C0CMED2",194,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=SIGDATA(1)
-"RTN","C0CMED2",195,0)
- . . ; Invervals... again another call.
-"RTN","C0CMED2",196,0)
- . . ; The schedule is a free text field
-"RTN","C0CMED2",197,0)
- . . ; However, it gets translated by a call to the administration
-"RTN","C0CMED2",198,0)
- . . ; schedule file to see if that schedule exists.
-"RTN","C0CMED2",199,0)
- . . ; That's the same thing I am going to do.
-"RTN","C0CMED2",200,0)
- . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
-"RTN","C0CMED2",201,0)
- . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
-"RTN","C0CMED2",202,0)
- . . ; I looked), PSSFT is the name,
-"RTN","C0CMED2",203,0)
- . . ; and list is the ^TMP name to store the data in.
-"RTN","C0CMED2",204,0)
- . . ; Also, freqency may have "PRN" in it, so strip that out
-"RTN","C0CMED2",205,0)
- . . N FREQ S FREQ=SIGDATA(1)
-"RTN","C0CMED2",206,0)
- . . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp
-"RTN","C0CMED2",207,0)
- . . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE")
-"RTN","C0CMED2",208,0)
- . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
-"RTN","C0CMED2",209,0)
- . . N INTERVAL
-"RTN","C0CMED2",210,0)
- . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
-"RTN","C0CMED2",211,0)
- . . E  D
-"RTN","C0CMED2",212,0)
- . . . N SUB S SUB=$O(SCHEDATA(0))
-"RTN","C0CMED2",213,0)
- . . . S INTERVAL=SCHEDATA(SUB,2)
-"RTN","C0CMED2",214,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
-"RTN","C0CMED2",215,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
-"RTN","C0CMED2",216,0)
- . . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months
-"RTN","C0CMED2",217,0)
- . . N DUR S DUR=SIGDATA(2)
-"RTN","C0CMED2",218,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR))
-"RTN","C0CMED2",219,0)
- . . N DURUNIT S DURUNIT=$E(DUR)
-"RTN","C0CMED2",220,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"")
-"RTN","C0CMED2",221,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=SIGDATA(1)["PRN"
-"RTN","C0CMED2",222,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
-"RTN","C0CMED2",223,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
-"RTN","C0CMED2",224,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
-"RTN","C0CMED2",225,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
-"RTN","C0CMED2",226,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
-"RTN","C0CMED2",227,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
-"RTN","C0CMED2",228,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
-"RTN","C0CMED2",229,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field
-"RTN","C0CMED2",230,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
 "RTN","C0CMED2",231,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=SIGDATA(6)
+ . ; --- END OF DIRECTIONS ---
 "RTN","C0CMED2",232,0)
  . ;
 "RTN","C0CMED2",233,0)
- . ; --- END OF DIRECTIONS ---
+ . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
 "RTN","C0CMED2",234,0)
- . ;
+ . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PI",1,0)) ;GPL
 "RTN","C0CMED2",235,0)
- . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
+ . ; W @MAP@("MEDPTINSTRUCTIONS"),!
 "RTN","C0CMED2",236,0)
- . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PI",1,0)) ;GPL
+ . ; S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9"
 "RTN","C0CMED2",237,0)
- . ; W @MAP@("MEDPTINSTRUCTIONS"),!
+ . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"SIG1",1,0)) ;GPL
 "RTN","C0CMED2",238,0)
- . ; S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9"
+ . ; W @MAP@("MEDFULLFILLMENTINSTRUCTIONS"),!
 "RTN","C0CMED2",239,0)
- . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"SIG1",1,0)) ;GPL
+ . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13)
 "RTN","C0CMED2",240,0)
- . ; W @MAP@("MEDFULLFILLMENTINSTRUCTIONS"),!
+ . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
 "RTN","C0CMED2",241,0)
- . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13)
+ . K @RESULT
 "RTN","C0CMED2",242,0)
- . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
+ . D MAP^C0CXPATH(MINXML,MAP,RESULT)
 "RTN","C0CMED2",243,0)
- . K @RESULT
+ . ; D PARY^C0CXPATH(RESULT)
 "RTN","C0CMED2",244,0)
- . D MAP^C0CXPATH(MINXML,MAP,RESULT)
+ . ; MAPPING DIRECTIONS
 "RTN","C0CMED2",245,0)
- . ; D PARY^C0CXPATH(RESULT)
+ . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
 "RTN","C0CMED2",246,0)
- . ; MAPPING DIRECTIONS
+ . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
 "RTN","C0CMED2",247,0)
- . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
+ . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
 "RTN","C0CMED2",248,0)
- . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
+ . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
 "RTN","C0CMED2",249,0)
- . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
+ . ; N MDZ1,MDZNA
 "RTN","C0CMED2",250,0)
- . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
+ . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
 "RTN","C0CMED2",251,0)
- . ; N MDZ1,MDZNA
+ . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
 "RTN","C0CMED2",252,0)
- . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
+ . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
 "RTN","C0CMED2",253,0)
- . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
+ . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
 "RTN","C0CMED2",254,0)
- . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
+ . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
 "RTN","C0CMED2",255,0)
- . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
+ . I MEDFIRST D  ;
 "RTN","C0CMED2",256,0)
- . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
+ . . ;S MEDFIRST=0 ; RESET FIRST FLAG ;OHUM/RUT COMMENTED (1ST PENDING MEDICATION WAS GETTING DUPLICATED)
 "RTN","C0CMED2",257,0)
- . I MEDFIRST D  ;
+ . . D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
 "RTN","C0CMED2",258,0)
- . . ;S MEDFIRST=0 ; RESET FIRST FLAG ;OHUM/RUT COMMENTED (1ST PENDING MEDICATION WAS GETTING DUPLICATED)
+ . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER
 "RTN","C0CMED2",259,0)
- . . D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
+ . I MEDFIRST S MEDFIRST=0 ;OHUM/RUT ADDED
 "RTN","C0CMED2",260,0)
- . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER
+ N MEDTMP,MEDI
 "RTN","C0CMED2",261,0)
- . I MEDFIRST S MEDFIRST=0 ;OHUM/RUT ADDED
+ D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
 "RTN","C0CMED2",262,0)
- N MEDTMP,MEDI
+ I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
 "RTN","C0CMED2",263,0)
- D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+ . W "Pending Medication MISSING ",!
 "RTN","C0CMED2",264,0)
- I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+ . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
 "RTN","C0CMED2",265,0)
- . W "Pending Medication MISSING ",!
+ Q
 "RTN","C0CMED2",266,0)
- . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","C0CMED2",267,0)
- Q
-"RTN","C0CMED2",268,0)
  ;
 "RTN","C0CMED3")
-0^51^B172422279
+0^51^B170674827
 "RTN","C0CMED3",1,0)
 C0CMED3 ; WV/CCDCCR/SMH - Meds: Non-VA/Outside Meds for Vista
 "RTN","C0CMED3",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CMED3",3,0)
  ;;Last Modified: Sun Jan 11 05:45:03 UTC 2009
 "RTN","C0CMED3",4,0)
- ; Copyright 2009 WorldVistA.  Licensed under the terms of the GNU
+ ; Copyright 2009 WorldVistA.  
 "RTN","C0CMED3",5,0)
- ; General Public License See attached copy of the License.
+ ;
 "RTN","C0CMED3",6,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CMED3",7,0)
- ; This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CMED3",8,0)
- ; it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CMED3",9,0)
- ; the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CMED3",10,0)
- ; (at your option) any later version.
+ ;
 "RTN","C0CMED3",11,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CMED3",12,0)
- ; This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CMED3",13,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CMED3",14,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CMED3",15,0)
- ; GNU General Public License for more details.
+ ;
 "RTN","C0CMED3",16,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CMED3",17,0)
- ; You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CMED3",18,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CMED3",19,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ W "NO ENTRY FROM TOP",!
 "RTN","C0CMED3",20,0)
- ;
+ Q
 "RTN","C0CMED3",21,0)
- W "NO ENTRY FROM TOP",!
+ ;
 "RTN","C0CMED3",22,0)
- Q
+EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; Extract medications into provided xml template
 "RTN","C0CMED3",23,0)
  ;
 "RTN","C0CMED3",24,0)
-EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; Extract medications into provided xml template
+ ; MINXML is the Input XML Template, (passed by name)
 "RTN","C0CMED3",25,0)
- ;
+ ; DFN is Patient IEN (passed by value)
 "RTN","C0CMED3",26,0)
- ; MINXML is the Input XML Template, (passed by name)
+ ; OUTXML is the resultant XML (passed by name)
 "RTN","C0CMED3",27,0)
- ; DFN is Patient IEN (passed by value)
+ ; MEDCOUNT is the number of Meds extracted so far (passed by reference)
 "RTN","C0CMED3",28,0)
- ; OUTXML is the resultant XML (passed by name)
+ ;
 "RTN","C0CMED3",29,0)
- ; MEDCOUNT is the number of Meds extracted so far (passed by reference)
+ ; MEDS is return array from RPC.
 "RTN","C0CMED3",30,0)
- ;
+ ; MAP is a mapping variable map (store result) for each med
 "RTN","C0CMED3",31,0)
- ; MEDS is return array from RPC.
+ ; MED is holds each array element from MEDS, one medicine
 "RTN","C0CMED3",32,0)
- ; MAP is a mapping variable map (store result) for each med
+ ;
 "RTN","C0CMED3",33,0)
- ; MED is holds each array element from MEDS, one medicine
+ ; Non-VA meds don't have an API. They are stored in file 55, subfile 52.2
 "RTN","C0CMED3",34,0)
- ;
+ ; Discontinued meds are indicated by the presence of a value in fields
 "RTN","C0CMED3",35,0)
- ; Non-VA meds don't have an API. They are stored in file 55, subfile 52.2
+ ; 5 or 6 (STATUS 1 or 2, and DISCONTINUED DATE)
 "RTN","C0CMED3",36,0)
- ; Discontinued meds are indicated by the presence of a value in fields
+ ; Will use Fileman API GETS^DIQ
 "RTN","C0CMED3",37,0)
- ; 5 or 6 (STATUS 1 or 2, and DISCONTINUED DATE)
+ ;
 "RTN","C0CMED3",38,0)
- ; Will use Fileman API GETS^DIQ
+ N MEDS,MAP
 "RTN","C0CMED3",39,0)
- ;
+ K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
 "RTN","C0CMED3",40,0)
- N MEDS,MAP
+ N NVA
 "RTN","C0CMED3",41,0)
- K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
+ D GETS^DIQ(55,DFN,"52.2*","IE","NVA") ; Output in NVA in FDA array format.
 "RTN","C0CMED3",42,0)
- N NVA
+ ; If NVA does not exist, then patient has no non-VA meds
 "RTN","C0CMED3",43,0)
- D GETS^DIQ(55,DFN,"52.2*","IE","NVA") ; Output in NVA in FDA array format.
+ I $D(NVA)=0 S @OUTXML@(0)=0 QUIT
 "RTN","C0CMED3",44,0)
- ; If NVA does not exist, then patient has no non-VA meds
+ ; Otherwise, we go on...
 "RTN","C0CMED3",45,0)
- I $D(NVA)=0 S @OUTXML@(0)=0 QUIT
+ M MEDS=NVA(55.05)
 "RTN","C0CMED3",46,0)
- ; Otherwise, we go on...
+ ; We are done with NVA
 "RTN","C0CMED3",47,0)
- M MEDS=NVA(55.05)
+ K NVA
 "RTN","C0CMED3",48,0)
- ; We are done with NVA
+ ;
 "RTN","C0CMED3",49,0)
- K NVA
+ ; I DEBUG ZWRITE MEDS
 "RTN","C0CMED3",50,0)
- ;
+ N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array.
 "RTN","C0CMED3",51,0)
- I DEBUG ZWRITE MEDS
+ N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED PROCESSED HERE
 "RTN","C0CMED3",52,0)
- N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array.
+ F  S FDAIEN=$O(MEDS(FDAIEN)) Q:FDAIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
 "RTN","C0CMED3",53,0)
- N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED PROCESSED HERE
+ . N MED M MED=MEDS(FDAIEN)
 "RTN","C0CMED3",54,0)
- F  S FDAIEN=$O(MEDS(FDAIEN)) Q:FDAIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
+ . I MED(5,"I")!MED(6,"I") QUIT  ; If disconinued, we don't want to pull it.
 "RTN","C0CMED3",55,0)
- . N MED M MED=MEDS(FDAIEN)
+ . S MEDCOUNT=MEDCOUNT+1
 "RTN","C0CMED3",56,0)
- . I MED(5,"I")!MED(6,"I") QUIT  ; If disconinued, we don't want to pull it.
+ . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
 "RTN","C0CMED3",57,0)
- . S MEDCOUNT=MEDCOUNT+1
+ . N RXIEN S RXIEN=$P(FDAIEN,",") ; First piece of FDAIEN is the number of the med for this patient
 "RTN","C0CMED3",58,0)
- . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
+ . I DEBUG W "RXIEN IS ",RXIEN,!
 "RTN","C0CMED3",59,0)
- . N RXIEN S RXIEN=$P(FDAIEN,",") ; First piece of FDAIEN is the number of the med for this patient
+ . I DEBUG W "MAP= ",MAP,!
 "RTN","C0CMED3",60,0)
- . I DEBUG W "RXIEN IS ",RXIEN,!
+ . S @MAP@("MEDOBJECTID")="MED_OUTSIDE"_MEDCOUNT ; MEDCOUNT FOR ID
 "RTN","C0CMED3",61,0)
- . I DEBUG W "MAP= ",MAP,!
+ . S @MAP@("MEDISSUEDATETXT")="Documented Date"
 "RTN","C0CMED3",62,0)
- . S @MAP@("MEDOBJECTID")="MED_OUTSIDE"_MEDCOUNT ; MEDCOUNT FOR ID
+ . ; Field 6 is "Effective date", and we pull it in timson format w/ I
 "RTN","C0CMED3",63,0)
- . S @MAP@("MEDISSUEDATETXT")="Documented Date"
+ . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL(MED(11,"I"),"DT")
 "RTN","C0CMED3",64,0)
- . ; Field 6 is "Effective date", and we pull it in timson format w/ I
+ . ; Med never filled; next 4 fields are not applicable.
 "RTN","C0CMED3",65,0)
- . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL(MED(11,"I"),"DT")
+ . S @MAP@("MEDLASTFILLDATETXT")=""
 "RTN","C0CMED3",66,0)
- . ; Med never filled; next 4 fields are not applicable.
+ . S @MAP@("MEDLASTFILLDATE")=""
 "RTN","C0CMED3",67,0)
- . S @MAP@("MEDLASTFILLDATETXT")=""
+ . S @MAP@("MEDRXNOTXT")=""
 "RTN","C0CMED3",68,0)
- . S @MAP@("MEDLASTFILLDATE")=""
+ . S @MAP@("MEDRXNO")=""
 "RTN","C0CMED3",69,0)
- . S @MAP@("MEDRXNOTXT")=""
+ . S @MAP@("MEDTYPETEXT")="Medication"
 "RTN","C0CMED3",70,0)
- . S @MAP@("MEDRXNO")=""
+ . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
 "RTN","C0CMED3",71,0)
- . S @MAP@("MEDTYPETEXT")="Medication"
+ . S @MAP@("MEDSTATUSTEXT")="Active" ; nearest status for pending meds
 "RTN","C0CMED3",72,0)
- . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
+ . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_MED(12,"I")
 "RTN","C0CMED3",73,0)
- . S @MAP@("MEDSTATUSTEXT")="Active" ; nearest status for pending meds
+ . S @MAP@("MEDPRODUCTNAMETEXT")=MED(.01,"E")
 "RTN","C0CMED3",74,0)
- . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_MED(12,"I")
+ . ; NDC is field 31 in the drug file.
 "RTN","C0CMED3",75,0)
- . S @MAP@("MEDPRODUCTNAMETEXT")=MED(.01,"E")
+ . ; The actual drug entry in the drug file (MEDIEN) is not necessarily supplied.
 "RTN","C0CMED3",76,0)
- . ; NDC is field 31 in the drug file.
+ . ; It' node 1, internal form.
 "RTN","C0CMED3",77,0)
- . ; The actual drug entry in the drug file (MEDIEN) is not necessarily supplied.
+ . N MEDIEN S MEDIEN=MED(1,"I")
 "RTN","C0CMED3",78,0)
- . ; It' node 1, internal form.
+ . I +MEDIEN D  ; start of if/else block
 "RTN","C0CMED3",79,0)
- . N MEDIEN S MEDIEN=MED(1,"I")
+ . . ; 12/30/08: I will be using RxNorm for coding...
 "RTN","C0CMED3",80,0)
- . I +MEDIEN D  ; start of if/else block
+ . . ; 176.001 is the file for Concepts; 176.003 is the file for
 "RTN","C0CMED3",81,0)
- . . ; 12/30/08: I will be using RxNorm for coding...
+ . . ; sources (i.e. for RxNorm Version)
 "RTN","C0CMED3",82,0)
- . . ; 176.001 is the file for Concepts; 176.003 is the file for
+ . . ;
 "RTN","C0CMED3",83,0)
- . . ; sources (i.e. for RxNorm Version)
+ . . ; We need the VUID first for the National Drug File entry first
 "RTN","C0CMED3",84,0)
+ . . ; We get the VUID of the drug, by looking up the VA Product entry
+"RTN","C0CMED3",85,0)
+ . . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
+"RTN","C0CMED3",86,0)
+ . . ; Field 99.99 is the VUID.
+"RTN","C0CMED3",87,0)
  . . ;
-"RTN","C0CMED3",85,0)
- . . ; We need the VUID first for the National Drug File entry first
-"RTN","C0CMED3",86,0)
- . . ; We get the VUID of the drug, by looking up the VA Product entry
-"RTN","C0CMED3",87,0)
- . . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
 "RTN","C0CMED3",88,0)
- . . ; Field 99.99 is the VUID.
+ . . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
 "RTN","C0CMED3",89,0)
+ . . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
+"RTN","C0CMED3",90,0)
+ . . ; $$GET1^DIQ.
+"RTN","C0CMED3",91,0)
  . . ;
-"RTN","C0CMED3",90,0)
- . . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
-"RTN","C0CMED3",91,0)
- . . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
 "RTN","C0CMED3",92,0)
- . . ; $$GET1^DIQ.
+ . . ; I get the RxNorm name and version from the RxNorm Sources (file
 "RTN","C0CMED3",93,0)
+ . . ; 176.003), by searching for "RXNORM", then get the data.
+"RTN","C0CMED3",94,0)
+ . . ; NDF^PSS50 ONLY EXISTS ON VISTA
+"RTN","C0CMED3",95,0)
+ . . N NDFDATA,NDFIEN,VAPROD
+"RTN","C0CMED3",96,0)
+ . . S NDFIEN=""
+"RTN","C0CMED3",97,0)
+ . . I '$$RPMS^C0CUTIL() D
+"RTN","C0CMED3",98,0)
+ . . . D NDF^PSS50(MEDIEN,,,,,"NDF")
+"RTN","C0CMED3",99,0)
+ . . . ;N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
+"RTN","C0CMED3",100,0)
+ . . . ;N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
+"RTN","C0CMED3",101,0)
+ . . . ;N VAPROD S VAPROD=$P(NDFDATA(22),U)
+"RTN","C0CMED3",102,0)
+ . . . M NDFDATA=^TMP($J,"NDF",MEDIEN)
+"RTN","C0CMED3",103,0)
+ . . . S NDFIEN=$P(NDFDATA(20),U)
+"RTN","C0CMED3",104,0)
+ . . . S VAPROD=$P(NDFDATA(22),U)
+"RTN","C0CMED3",105,0)
+ . . . S @MAP@("MEDPRODUCTNAMETEXT")=$$GET1^DIQ(50.68,VAPROD,.01) ;
+"RTN","C0CMED3",106,0)
+ . . ; GPL - RESET THE NAME TO THE REAL NAME OF THE DRUG NOW THAT WE
+"RTN","C0CMED3",107,0)
+ . . ;   HAVE IT. 
+"RTN","C0CMED3",108,0)
  . . ;
-"RTN","C0CMED3",94,0)
- . . ; I get the RxNorm name and version from the RxNorm Sources (file
-"RTN","C0CMED3",95,0)
- . . ; 176.003), by searching for "RXNORM", then get the data.
-"RTN","C0CMED3",96,0)
- . . ; NDF^PSS50 ONLY EXISTS ON VISTA
-"RTN","C0CMED3",97,0)
- . . N NDFDATA,NDFIEN,VAPROD
-"RTN","C0CMED3",98,0)
- . . S NDFIEN=""
-"RTN","C0CMED3",99,0)
+"RTN","C0CMED3",109,0)
+ . . ; NDFIEN is not necessarily defined; it won't be if the drug
+"RTN","C0CMED3",110,0)
+ . . ; is not matched to the national drug file (e.g. if the drug is
+"RTN","C0CMED3",111,0)
+ . . ; new on the market, compounded, or is a fake drug [blue pill].
+"RTN","C0CMED3",112,0)
+ . . ; To protect against failure, I will put an if/else block
+"RTN","C0CMED3",113,0)
+ . . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
+"RTN","C0CMED3",114,0)
+ . . ; 
+"RTN","C0CMED3",115,0)
+ . . ; begin changes for systems that have eRx installed
+"RTN","C0CMED3",116,0)
+ . . ; RxNorm is found in the ^C0P("RXN") global - gpl
+"RTN","C0CMED3",117,0)
+ . . ;
+"RTN","C0CMED3",118,0)
+ . . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION
+"RTN","C0CMED3",119,0)
+ . . S (ZC,ZCD,ZCDS,ZCDSV)="" ; INITIALIZE
+"RTN","C0CMED3",120,0)
+ . . S (RXNORM,RXNNAME,RXNVER)="" ;INITIALIZE
+"RTN","C0CMED3",121,0)
+ . . I NDFIEN,$D(^C0P("RXN")) D  ; 
+"RTN","C0CMED3",122,0)
+ . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
+"RTN","C0CMED3",123,0)
+ . . . S ZC=$$CODE^C0CUTIL(VUID)
+"RTN","C0CMED3",124,0)
+ . . . S ZCD=$P(ZC,"^",1) ; CODE TO USE
+"RTN","C0CMED3",125,0)
+ . . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID
+"RTN","C0CMED3",126,0)
+ . . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION
+"RTN","C0CMED3",127,0)
+ . . . S RXNORM=ZCD ; THE CODE
+"RTN","C0CMED3",128,0)
+ . . . S RXNNAME=ZCDS ; THE CODING SYSTEM
+"RTN","C0CMED3",129,0)
+ . . . S RXNVER=ZCDSV ; THE CODING SYSTEM VERSION
+"RTN","C0CMED3",130,0)
+ . . . N ZGMED S ZGMED=@MAP@("MEDPRODUCTNAMETEXT")
+"RTN","C0CMED3",131,0)
+ . . . S @MAP@("MEDPRODUCTNAMETEXT")=ZGMED_" "_ZCDS_": "_ZCD
+"RTN","C0CMED3",132,0)
+ . . E  I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
+"RTN","C0CMED3",133,0)
+ . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
+"RTN","C0CMED3",134,0)
+ . . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
+"RTN","C0CMED3",135,0)
+ . . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
+"RTN","C0CMED3",136,0)
+ . . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
+"RTN","C0CMED3",137,0)
+ . . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
+"RTN","C0CMED3",138,0)
+ . . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
+"RTN","C0CMED3",139,0)
+ . . ;
+"RTN","C0CMED3",140,0)
+ . . ;E  S (RXNORM,RXNNAME,RXNVER)=""
+"RTN","C0CMED3",141,0)
+ . . ; End if/else block
+"RTN","C0CMED3",142,0)
+ . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
+"RTN","C0CMED3",143,0)
+ . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
+"RTN","C0CMED3",144,0)
+ . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
+"RTN","C0CMED3",145,0)
+ . . ;
+"RTN","C0CMED3",146,0)
+ . . S @MAP@("MEDBRANDNAMETEXT")=""
+"RTN","C0CMED3",147,0)
+ . . ; DOSE^PSS50 ONLY ESISTS ON VISTA
+"RTN","C0CMED3",148,0)
  . . I '$$RPMS^C0CUTIL() D
-"RTN","C0CMED3",100,0)
- . . . D NDF^PSS50(MEDIEN,,,,,"NDF")
-"RTN","C0CMED3",101,0)
- . . . ;N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
-"RTN","C0CMED3",102,0)
- . . . ;N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
-"RTN","C0CMED3",103,0)
- . . . ;N VAPROD S VAPROD=$P(NDFDATA(22),U)
-"RTN","C0CMED3",104,0)
- . . . M NDFDATA=^TMP($J,"NDF",MEDIEN)
-"RTN","C0CMED3",105,0)
- . . . S NDFIEN=$P(NDFDATA(20),U)
-"RTN","C0CMED3",106,0)
- . . . S VAPROD=$P(NDFDATA(22),U)
-"RTN","C0CMED3",107,0)
- . . . S @MAP@("MEDPRODUCTNAMETEXT")=$$GET1^DIQ(50.68,VAPROD,.01) ;
-"RTN","C0CMED3",108,0)
- . . ; GPL - RESET THE NAME TO THE REAL NAME OF THE DRUG NOW THAT WE
-"RTN","C0CMED3",109,0)
- . . ;   HAVE IT. 
-"RTN","C0CMED3",110,0)
+"RTN","C0CMED3",149,0)
+ . . . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
+"RTN","C0CMED3",150,0)
+ . . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
+"RTN","C0CMED3",151,0)
+ . . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
+"RTN","C0CMED3",152,0)
+ . . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
+"RTN","C0CMED3",153,0)
+ . . E  S @MAP@("MEDSTRENGTHVALUE")="" S @MAP@("MEDSTRENGTHUNIT")=""
+"RTN","C0CMED3",154,0)
+ . . ; Units, concentration, etc, come from another call
+"RTN","C0CMED3",155,0)
+ . . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
+"RTN","C0CMED3",156,0)
+ . . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
+"RTN","C0CMED3",157,0)
+ . . ; NDF Entry IEN, and VA Product Name
+"RTN","C0CMED3",158,0)
+ . . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
+"RTN","C0CMED3",159,0)
+ . . ; Documented in the same manual; executed above.
+"RTN","C0CMED3",160,0)
  . . ;
-"RTN","C0CMED3",111,0)
- . . ; NDFIEN is not necessarily defined; it won't be if the drug
-"RTN","C0CMED3",112,0)
- . . ; is not matched to the national drug file (e.g. if the drug is
-"RTN","C0CMED3",113,0)
- . . ; new on the market, compounded, or is a fake drug [blue pill].
-"RTN","C0CMED3",114,0)
- . . ; To protect against failure, I will put an if/else block
-"RTN","C0CMED3",115,0)
- . . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
-"RTN","C0CMED3",116,0)
- . . ; 
-"RTN","C0CMED3",117,0)
- . . ; begin changes for systems that have eRx installed
-"RTN","C0CMED3",118,0)
- . . ; RxNorm is found in the ^C0P("RXN") global - gpl
-"RTN","C0CMED3",119,0)
- . . ;
-"RTN","C0CMED3",120,0)
- . . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION
-"RTN","C0CMED3",121,0)
- . . S (ZC,ZCD,ZCDS,ZCDSV)="" ; INITIALIZE
-"RTN","C0CMED3",122,0)
- . . S (RXNORM,RXNNAME,RXNVER)="" ;INITIALIZE
-"RTN","C0CMED3",123,0)
- . . I NDFIEN,$D(^C0P("RXN")) D  ; 
-"RTN","C0CMED3",124,0)
- . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
-"RTN","C0CMED3",125,0)
- . . . S ZC=$$CODE^C0CUTIL(VUID)
-"RTN","C0CMED3",126,0)
- . . . S ZCD=$P(ZC,"^",1) ; CODE TO USE
-"RTN","C0CMED3",127,0)
- . . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID
-"RTN","C0CMED3",128,0)
- . . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION
-"RTN","C0CMED3",129,0)
- . . . S RXNORM=ZCD ; THE CODE
-"RTN","C0CMED3",130,0)
- . . . S RXNNAME=ZCDS ; THE CODING SYSTEM
-"RTN","C0CMED3",131,0)
- . . . S RXNVER=ZCDSV ; THE CODING SYSTEM VERSION
-"RTN","C0CMED3",132,0)
- . . . N ZGMED S ZGMED=@MAP@("MEDPRODUCTNAMETEXT")
-"RTN","C0CMED3",133,0)
- . . . S @MAP@("MEDPRODUCTNAMETEXT")=ZGMED_" "_ZCDS_": "_ZCD
-"RTN","C0CMED3",134,0)
- . . E  I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
-"RTN","C0CMED3",135,0)
- . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
-"RTN","C0CMED3",136,0)
- . . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
-"RTN","C0CMED3",137,0)
- . . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
-"RTN","C0CMED3",138,0)
- . . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
-"RTN","C0CMED3",139,0)
- . . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
-"RTN","C0CMED3",140,0)
- . . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
-"RTN","C0CMED3",141,0)
- . . ;
-"RTN","C0CMED3",142,0)
- . . ;E  S (RXNORM,RXNNAME,RXNVER)=""
-"RTN","C0CMED3",143,0)
- . . ; End if/else block
-"RTN","C0CMED3",144,0)
- . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
-"RTN","C0CMED3",145,0)
- . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
-"RTN","C0CMED3",146,0)
- . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
-"RTN","C0CMED3",147,0)
- . . ;
-"RTN","C0CMED3",148,0)
+"RTN","C0CMED3",161,0)
+ . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
+"RTN","C0CMED3",162,0)
+ . . ; and this will crash the call. So...
+"RTN","C0CMED3",163,0)
+ . . I NDFIEN="" S CONCDATA=""
+"RTN","C0CMED3",164,0)
+ . . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
+"RTN","C0CMED3",165,0)
+ . . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
+"RTN","C0CMED3",166,0)
+ . . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
+"RTN","C0CMED3",167,0)
+ . . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
+"RTN","C0CMED3",168,0)
+ . . S @MAP@("MEDQUANTITYVALUE")=""  ; not provided for in Non-VA meds.
+"RTN","C0CMED3",169,0)
+ . . ; Oddly, there is no easy place to find the dispense unit.
+"RTN","C0CMED3",170,0)
+ . . ; It's not included in the original call, so we have to go to the drug file.
+"RTN","C0CMED3",171,0)
+ . . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
+"RTN","C0CMED3",172,0)
+ . . ; Node 14.5 is the Dispense Unit
+"RTN","C0CMED3",173,0)
+ . . ; PSS50 ONLY EXISTS ON VISTA
+"RTN","C0CMED3",174,0)
+ . . I '$$RPMS^C0CUTIL() D
+"RTN","C0CMED3",175,0)
+ . . . D DATA^PSS50(MEDIEN,,,,,"QTY")
+"RTN","C0CMED3",176,0)
+ . . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
+"RTN","C0CMED3",177,0)
+ . . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
+"RTN","C0CMED3",178,0)
+ . . E  S @MAP@("MEDQUANTITYUNIT")=""
+"RTN","C0CMED3",179,0)
+ . . S @MAP@("MEDQUANTITYUNIT")="" ; don't show these
+"RTN","C0CMED3",180,0)
+ . E  D
+"RTN","C0CMED3",181,0)
+ . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
+"RTN","C0CMED3",182,0)
+ . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
+"RTN","C0CMED3",183,0)
+ . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""
+"RTN","C0CMED3",184,0)
  . . S @MAP@("MEDBRANDNAMETEXT")=""
-"RTN","C0CMED3",149,0)
- . . ; DOSE^PSS50 ONLY ESISTS ON VISTA
-"RTN","C0CMED3",150,0)
- . . I '$$RPMS^C0CUTIL() D
-"RTN","C0CMED3",151,0)
- . . . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
-"RTN","C0CMED3",152,0)
- . . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
-"RTN","C0CMED3",153,0)
- . . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
-"RTN","C0CMED3",154,0)
- . . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
-"RTN","C0CMED3",155,0)
- . . E  S @MAP@("MEDSTRENGTHVALUE")="" S @MAP@("MEDSTRENGTHUNIT")=""
-"RTN","C0CMED3",156,0)
- . . ; Units, concentration, etc, come from another call
-"RTN","C0CMED3",157,0)
- . . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
-"RTN","C0CMED3",158,0)
- . . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
-"RTN","C0CMED3",159,0)
- . . ; NDF Entry IEN, and VA Product Name
-"RTN","C0CMED3",160,0)
- . . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
-"RTN","C0CMED3",161,0)
- . . ; Documented in the same manual; executed above.
-"RTN","C0CMED3",162,0)
- . . ;
-"RTN","C0CMED3",163,0)
- . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
-"RTN","C0CMED3",164,0)
- . . ; and this will crash the call. So...
-"RTN","C0CMED3",165,0)
- . . I NDFIEN="" S CONCDATA=""
-"RTN","C0CMED3",166,0)
- . . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
-"RTN","C0CMED3",167,0)
- . . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
-"RTN","C0CMED3",168,0)
- . . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
-"RTN","C0CMED3",169,0)
- . . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
-"RTN","C0CMED3",170,0)
- . . S @MAP@("MEDQUANTITYVALUE")=""  ; not provided for in Non-VA meds.
-"RTN","C0CMED3",171,0)
- . . ; Oddly, there is no easy place to find the dispense unit.
-"RTN","C0CMED3",172,0)
- . . ; It's not included in the original call, so we have to go to the drug file.
-"RTN","C0CMED3",173,0)
- . . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
-"RTN","C0CMED3",174,0)
- . . ; Node 14.5 is the Dispense Unit
-"RTN","C0CMED3",175,0)
- . . ; PSS50 ONLY EXISTS ON VISTA
-"RTN","C0CMED3",176,0)
- . . I '$$RPMS^C0CUTIL() D
-"RTN","C0CMED3",177,0)
- . . . D DATA^PSS50(MEDIEN,,,,,"QTY")
-"RTN","C0CMED3",178,0)
- . . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
-"RTN","C0CMED3",179,0)
- . . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
-"RTN","C0CMED3",180,0)
- . . E  S @MAP@("MEDQUANTITYUNIT")=""
-"RTN","C0CMED3",181,0)
- . . S @MAP@("MEDQUANTITYUNIT")="" ; don't show these
-"RTN","C0CMED3",182,0)
- . E  D
-"RTN","C0CMED3",183,0)
- . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
-"RTN","C0CMED3",184,0)
- . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
 "RTN","C0CMED3",185,0)
- . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""
+ . . S @MAP@("MEDSTRENGTHVALUE")=""
 "RTN","C0CMED3",186,0)
- . . S @MAP@("MEDBRANDNAMETEXT")=""
+ . . S @MAP@("MEDSTRENGTHUNIT")=""
 "RTN","C0CMED3",187,0)
- . . S @MAP@("MEDSTRENGTHVALUE")=""
+ . . S @MAP@("MEDFORMTEXT")=""
 "RTN","C0CMED3",188,0)
- . . S @MAP@("MEDSTRENGTHUNIT")=""
+ . . S @MAP@("MEDCONCVALUE")=""
 "RTN","C0CMED3",189,0)
- . . S @MAP@("MEDFORMTEXT")=""
+ . . S @MAP@("MEDCONCUNIT")=""
 "RTN","C0CMED3",190,0)
- . . S @MAP@("MEDCONCVALUE")=""
+ . . S @MAP@("MEDSIZETEXT")=""
 "RTN","C0CMED3",191,0)
- . . S @MAP@("MEDCONCUNIT")=""
+ . . S @MAP@("MEDQUANTITYVALUE")=""
 "RTN","C0CMED3",192,0)
- . . S @MAP@("MEDSIZETEXT")=""
+ . . S @MAP@("MEDQUANTITYUNIT")=""
 "RTN","C0CMED3",193,0)
- . . S @MAP@("MEDQUANTITYVALUE")=""
+ . ; End If/Else
 "RTN","C0CMED3",194,0)
- . . S @MAP@("MEDQUANTITYUNIT")=""
+ . ; --- START OF DIRECTIONS ---
 "RTN","C0CMED3",195,0)
- . ; End If/Else
+ . ; Dosage is field 2, route is 3, schedule is 4
 "RTN","C0CMED3",196,0)
- . ; --- START OF DIRECTIONS ---
+ . ; These are all free text fields, and don't point to any files
 "RTN","C0CMED3",197,0)
- . ; Dosage is field 2, route is 3, schedule is 4
+ . ; For that reason, I will use the field I never used before:
 "RTN","C0CMED3",198,0)
- . ; These are all free text fields, and don't point to any files
+ . ; MEDDIRECTIONDESCRIPTIONTEXT
 "RTN","C0CMED3",199,0)
- . ; For that reason, I will use the field I never used before:
+ . S DIRCNT=1 ; THERE IS ONLY ONE DIRECTION FOR OUTSIDE MEDS
 "RTN","C0CMED3",200,0)
- . ; MEDDIRECTIONDESCRIPTIONTEXT
+ . ;
 "RTN","C0CMED3",201,0)
- . S DIRCNT=1 ; THERE IS ONLY ONE DIRECTION FOR OUTSIDE MEDS
+ . ; change for eRx meds - gpl 6/25/2011
 "RTN","C0CMED3",202,0)
  . ;
 "RTN","C0CMED3",203,0)
- . ; change for eRx meds - gpl 6/25/2011
+ . N ZERX S ZERX=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
 "RTN","C0CMED3",204,0)
+ . I ZERX["|" S ZERX=$P(ZERX,"|",2) ; GET RID OF MED NAME
+"RTN","C0CMED3",205,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=ZERX
+"RTN","C0CMED3",206,0)
+ . N ZERX2 S ZERX2=$P(MED(2,"E"),"|",2) ; sig for quantity
+"RTN","C0CMED3",207,0)
+ . N ZFDBDRUG S ZFDBDRUG=$P(MED(2,"E"),"|",1) ; FDB DRUG NAME
+"RTN","C0CMED3",208,0)
+ . I @MAP@("MEDPRODUCTNAMETEXT")["FREE TXT" D  ; FIX THE DRUG NAME
+"RTN","C0CMED3",209,0)
+ . . S @MAP@("MEDPRODUCTNAMETEXT")=ZFDBDRUG ; USE FDB NAME
+"RTN","C0CMED3",210,0)
+ . . S RXNORM=$P($P($G(MED(14,7)),"RXNORM:",2)," ",1) ; THE RXNORM
+"RTN","C0CMED3",211,0)
+ . . S RXNORM=$$NISTMAP^C0CUTIL(RXNORM) ; CHANGE IF NECESSARY
+"RTN","C0CMED3",212,0)
+ . . I RXNORM'="" D  ;
+"RTN","C0CMED3",213,0)
+ . . . W !,"FOUND FREE TEXT RXNORM:",RXNORM
+"RTN","C0CMED3",214,0)
+ . . . S RXNNAME="RXNORM" ; THE CODING SYSTEM
+"RTN","C0CMED3",215,0)
+ . . . S RXNVER="" ; THE CODING SYSTEM VERSION
+"RTN","C0CMED3",216,0)
+ . . . N ZGMED S ZGMED=@MAP@("MEDPRODUCTNAMETEXT")
+"RTN","C0CMED3",217,0)
+ . . . S @MAP@("MEDPRODUCTNAMETEXT")=ZGMED_" "_RXNNAME_": "_RXNORM
+"RTN","C0CMED3",218,0)
+ . . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
+"RTN","C0CMED3",219,0)
+ . . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
+"RTN","C0CMED3",220,0)
+ . . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
+"RTN","C0CMED3",221,0)
+ . . . I RXNORM["979334" D  ; PATCH FOR CERTIFICATION
+"RTN","C0CMED3",222,0)
+ . . . . S @MAP@("MEDSTRENGTHVALUE")=650
+"RTN","C0CMED3",223,0)
+ . . . . S @MAP@("MEDSTRENGTHUNIT")="mcg"
+"RTN","C0CMED3",224,0)
+ . . . . S @MAP@("MEDFORMTEXT")="INHALER"
+"RTN","C0CMED3",225,0)
+ . S @MAP@("MEDQUANTITYUNIT")=$P(ZERX2," ",3) ; THE UNITS
+"RTN","C0CMED3",226,0)
+ . S @MAP@("MEDQUANTITYVALUE")=$P(ZERX2," ",2) ; THE QUANTITY
+"RTN","C0CMED3",227,0)
+ . I @MAP@("MEDFORMTEXT")="" S @MAP@("MEDFORMTEXT")=$P(ZERX2," ",3) ;
+"RTN","C0CMED3",228,0)
+ . ;S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
+"RTN","C0CMED3",229,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4"  ; means look in description text. See E2369-05.
+"RTN","C0CMED3",230,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
+"RTN","C0CMED3",231,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
+"RTN","C0CMED3",232,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
+"RTN","C0CMED3",233,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
+"RTN","C0CMED3",234,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
+"RTN","C0CMED3",235,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
+"RTN","C0CMED3",236,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
+"RTN","C0CMED3",237,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
+"RTN","C0CMED3",238,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
+"RTN","C0CMED3",239,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""
+"RTN","C0CMED3",240,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""
+"RTN","C0CMED3",241,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""
+"RTN","C0CMED3",242,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""
+"RTN","C0CMED3",243,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""
+"RTN","C0CMED3",244,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""
+"RTN","C0CMED3",245,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""
+"RTN","C0CMED3",246,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""
+"RTN","C0CMED3",247,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
+"RTN","C0CMED3",248,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
+"RTN","C0CMED3",249,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
+"RTN","C0CMED3",250,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
+"RTN","C0CMED3",251,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
+"RTN","C0CMED3",252,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
+"RTN","C0CMED3",253,0)
  . ;
-"RTN","C0CMED3",205,0)
- . N ZERX S ZERX=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
-"RTN","C0CMED3",206,0)
- . I ZERX["|" S ZERX=$P(ZERX,"|",2) ; GET RID OF MED NAME
-"RTN","C0CMED3",207,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=ZERX
-"RTN","C0CMED3",208,0)
- . N ZERX2 S ZERX2=$P(MED(2,"E"),"|",2) ; sig for quantity
-"RTN","C0CMED3",209,0)
- . N ZFDBDRUG S ZFDBDRUG=$P(MED(2,"E"),"|",1) ; FDB DRUG NAME
-"RTN","C0CMED3",210,0)
- . I @MAP@("MEDPRODUCTNAMETEXT")["FREE TXT" D  ; FIX THE DRUG NAME
-"RTN","C0CMED3",211,0)
- . . S @MAP@("MEDPRODUCTNAMETEXT")=ZFDBDRUG ; USE FDB NAME
-"RTN","C0CMED3",212,0)
- . . S RXNORM=$P($P($G(MED(14,7)),"RXNORM:",2)," ",1) ; THE RXNORM
-"RTN","C0CMED3",213,0)
- . . S RXNORM=$$NISTMAP^C0CUTIL(RXNORM) ; CHANGE IF NECESSARY
-"RTN","C0CMED3",214,0)
- . . I RXNORM'="" D  ;
-"RTN","C0CMED3",215,0)
- . . . W !,"FOUND FREE TEXT RXNORM:",RXNORM
-"RTN","C0CMED3",216,0)
- . . . S RXNNAME="RXNORM" ; THE CODING SYSTEM
-"RTN","C0CMED3",217,0)
- . . . S RXNVER="" ; THE CODING SYSTEM VERSION
-"RTN","C0CMED3",218,0)
- . . . N ZGMED S ZGMED=@MAP@("MEDPRODUCTNAMETEXT")
-"RTN","C0CMED3",219,0)
- . . . S @MAP@("MEDPRODUCTNAMETEXT")=ZGMED_" "_RXNNAME_": "_RXNORM
-"RTN","C0CMED3",220,0)
- . . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
-"RTN","C0CMED3",221,0)
- . . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
-"RTN","C0CMED3",222,0)
- . . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
-"RTN","C0CMED3",223,0)
- . . . I RXNORM["979334" D  ; PATCH FOR CERTIFICATION
-"RTN","C0CMED3",224,0)
- . . . . S @MAP@("MEDSTRENGTHVALUE")=650
-"RTN","C0CMED3",225,0)
- . . . . S @MAP@("MEDSTRENGTHUNIT")="mcg"
-"RTN","C0CMED3",226,0)
- . . . . S @MAP@("MEDFORMTEXT")="INHALER"
-"RTN","C0CMED3",227,0)
- . S @MAP@("MEDQUANTITYUNIT")=$P(ZERX2," ",3) ; THE UNITS
-"RTN","C0CMED3",228,0)
- . S @MAP@("MEDQUANTITYVALUE")=$P(ZERX2," ",2) ; THE QUANTITY
-"RTN","C0CMED3",229,0)
- . I @MAP@("MEDFORMTEXT")="" S @MAP@("MEDFORMTEXT")=$P(ZERX2," ",3) ;
-"RTN","C0CMED3",230,0)
- . ;S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
-"RTN","C0CMED3",231,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4"  ; means look in description text. See E2369-05.
-"RTN","C0CMED3",232,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
-"RTN","C0CMED3",233,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
-"RTN","C0CMED3",234,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
-"RTN","C0CMED3",235,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
-"RTN","C0CMED3",236,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
-"RTN","C0CMED3",237,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
-"RTN","C0CMED3",238,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
-"RTN","C0CMED3",239,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
-"RTN","C0CMED3",240,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
-"RTN","C0CMED3",241,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""
-"RTN","C0CMED3",242,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""
-"RTN","C0CMED3",243,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""
-"RTN","C0CMED3",244,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""
-"RTN","C0CMED3",245,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""
-"RTN","C0CMED3",246,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""
-"RTN","C0CMED3",247,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""
-"RTN","C0CMED3",248,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""
-"RTN","C0CMED3",249,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
-"RTN","C0CMED3",250,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
-"RTN","C0CMED3",251,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
-"RTN","C0CMED3",252,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
-"RTN","C0CMED3",253,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
 "RTN","C0CMED3",254,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
+ . ; --- END OF DIRECTIONS ---
 "RTN","C0CMED3",255,0)
  . ;
 "RTN","C0CMED3",256,0)
- . ; --- END OF DIRECTIONS ---
+ . S @MAP@("MEDRFNO")=""
 "RTN","C0CMED3",257,0)
+ . I $D(MED(14,1)) D  ;
+"RTN","C0CMED3",258,0)
+ . . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
+"RTN","C0CMED3",259,0)
+ . E  S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
+"RTN","C0CMED3",260,0)
+ . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")="" ; don't put in these - gpl
+"RTN","C0CMED3",261,0)
+ . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
+"RTN","C0CMED3",262,0)
+ . K @RESULT
+"RTN","C0CMED3",263,0)
+ . D MAP^C0CXPATH(MINXML,MAP,RESULT)
+"RTN","C0CMED3",264,0)
+ . ; D PARY^C0CXPATH(RESULT)
+"RTN","C0CMED3",265,0)
+ . ; MAPPING DIRECTIONS
+"RTN","C0CMED3",266,0)
+ . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
+"RTN","C0CMED3",267,0)
+ . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
+"RTN","C0CMED3",268,0)
+ . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
+"RTN","C0CMED3",269,0)
+ . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
+"RTN","C0CMED3",270,0)
+ . N MDZ1,MDZNA
+"RTN","C0CMED3",271,0)
+ . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
+"RTN","C0CMED3",272,0)
+ . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
+"RTN","C0CMED3",273,0)
+ . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
+"RTN","C0CMED3",274,0)
+ . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
+"RTN","C0CMED3",275,0)
+ . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
+"RTN","C0CMED3",276,0)
  . ;
-"RTN","C0CMED3",258,0)
- . S @MAP@("MEDRFNO")=""
-"RTN","C0CMED3",259,0)
- . I $D(MED(14,1)) D  ;
-"RTN","C0CMED3",260,0)
- . . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
-"RTN","C0CMED3",261,0)
- . E  S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
-"RTN","C0CMED3",262,0)
- . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")="" ; don't put in these - gpl
-"RTN","C0CMED3",263,0)
- . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
-"RTN","C0CMED3",264,0)
- . K @RESULT
-"RTN","C0CMED3",265,0)
- . D MAP^C0CXPATH(MINXML,MAP,RESULT)
-"RTN","C0CMED3",266,0)
- . ; D PARY^C0CXPATH(RESULT)
-"RTN","C0CMED3",267,0)
- . ; MAPPING DIRECTIONS
-"RTN","C0CMED3",268,0)
- . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
-"RTN","C0CMED3",269,0)
- . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
-"RTN","C0CMED3",270,0)
- . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
-"RTN","C0CMED3",271,0)
- . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
-"RTN","C0CMED3",272,0)
- . N MDZ1,MDZNA
-"RTN","C0CMED3",273,0)
- . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
-"RTN","C0CMED3",274,0)
- . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
-"RTN","C0CMED3",275,0)
- . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
-"RTN","C0CMED3",276,0)
- . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
 "RTN","C0CMED3",277,0)
- . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
+ . ; MAP PATIENT INSTRUCTIONS - HAVE TO DO THIS AFTER MAPPING DIRECTIONS DUE TO XML SCHEMA VALIDATION
 "RTN","C0CMED3",278,0)
+ . N MEDINT1,INTXML1 S INTXML1="MENINT1" ; VARIABLE AND NAME VARIABLE TEMPLATE
+"RTN","C0CMED3",279,0)
+ . N MEDINT2,INTXML2 S INTXML2="MEDINT2" ; VARIABLE AND NAME VARIABLE RESULT
+"RTN","C0CMED3",280,0)
+ . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/PatientInstructions",INTXML1)
+"RTN","C0CMED3",281,0)
+ . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/PatientInstructions")
+"RTN","C0CMED3",282,0)
+ . ;N MDI1 ; removing the "I" which is not in the protocol gpl 1/2010
+"RTN","C0CMED3",283,0)
+ . ;S MDI1=$NA(@MAP@("I"))
+"RTN","C0CMED3",284,0)
+ . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
+"RTN","C0CMED3",285,0)
+ . I $D(MED(10,1)) D  ;
+"RTN","C0CMED3",286,0)
+ . . ;S @MAP@("I","MEDPTINSTRUCTIONS")=$P(MED(10,1),"  ",1) ; WP Field
+"RTN","C0CMED3",287,0)
+ . . S @MAP@("MEDPTINSTRUCTIONS")=$P(MED(10,1),"  ",1) ; WP Field
+"RTN","C0CMED3",288,0)
+ . E  S @MAP@("MEDPTINSTRUCTIONS")=""
+"RTN","C0CMED3",289,0)
+ . ;E  S @MAP@("I","MEDPTINSTRUCTIONS")=""
+"RTN","C0CMED3",290,0)
+ . ;D MAP^C0CXPATH(INTXML1,MDI1,INTXML2)
+"RTN","C0CMED3",291,0)
+ . D MAP^C0CXPATH(INTXML1,MAP,INTXML2) ; JUST MAP WORKS.. GPL
+"RTN","C0CMED3",292,0)
+ . D INSERT^C0CXPATH(RESULT,INTXML2,"//Medications/Medication")
+"RTN","C0CMED3",293,0)
  . ;
-"RTN","C0CMED3",279,0)
- . ; MAP PATIENT INSTRUCTIONS - HAVE TO DO THIS AFTER MAPPING DIRECTIONS DUE TO XML SCHEMA VALIDATION
-"RTN","C0CMED3",280,0)
- . N MEDINT1,INTXML1 S INTXML1="MENINT1" ; VARIABLE AND NAME VARIABLE TEMPLATE
-"RTN","C0CMED3",281,0)
- . N MEDINT2,INTXML2 S INTXML2="MEDINT2" ; VARIABLE AND NAME VARIABLE RESULT
-"RTN","C0CMED3",282,0)
- . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/PatientInstructions",INTXML1)
-"RTN","C0CMED3",283,0)
- . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/PatientInstructions")
-"RTN","C0CMED3",284,0)
- . ;N MDI1 ; removing the "I" which is not in the protocol gpl 1/2010
-"RTN","C0CMED3",285,0)
- . ;S MDI1=$NA(@MAP@("I"))
-"RTN","C0CMED3",286,0)
- . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
-"RTN","C0CMED3",287,0)
- . I $D(MED(10,1)) D  ;
-"RTN","C0CMED3",288,0)
- . . ;S @MAP@("I","MEDPTINSTRUCTIONS")=$P(MED(10,1),"  ",1) ; WP Field
-"RTN","C0CMED3",289,0)
- . . S @MAP@("MEDPTINSTRUCTIONS")=$P(MED(10,1),"  ",1) ; WP Field
-"RTN","C0CMED3",290,0)
- . E  S @MAP@("MEDPTINSTRUCTIONS")=""
-"RTN","C0CMED3",291,0)
- . ;E  S @MAP@("I","MEDPTINSTRUCTIONS")=""
-"RTN","C0CMED3",292,0)
- . ;D MAP^C0CXPATH(INTXML1,MDI1,INTXML2)
-"RTN","C0CMED3",293,0)
- . D MAP^C0CXPATH(INTXML1,MAP,INTXML2) ; JUST MAP WORKS.. GPL
 "RTN","C0CMED3",294,0)
- . D INSERT^C0CXPATH(RESULT,INTXML2,"//Medications/Medication")
+ . ; FLAG HAS TO BE RESET OUTSIDE THE IF STATMENT.
 "RTN","C0CMED3",295,0)
- . ;
+ . ;I MEDFIRST D  ;
 "RTN","C0CMED3",296,0)
- . ; FLAG HAS TO BE RESET OUTSIDE THE IF STATMENT.
+ . ;. S MEDFIRST=0 ; RESET FIRST FLAG
 "RTN","C0CMED3",297,0)
- . ;I MEDFIRST D  ;
+ . ;. D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
 "RTN","C0CMED3",298,0)
- . ;. S MEDFIRST=0 ; RESET FIRST FLAG
+ . ;D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
 "RTN","C0CMED3",299,0)
- . ;. D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
+ . D:MEDFIRST CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
 "RTN","C0CMED3",300,0)
- . ;D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
+ . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
 "RTN","C0CMED3",301,0)
- . D:MEDFIRST CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
+ . I MEDFIRST S MEDFIRST=0
 "RTN","C0CMED3",302,0)
- . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
+ N MEDTMP,MEDI
 "RTN","C0CMED3",303,0)
- . I MEDFIRST S MEDFIRST=0
+ D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
 "RTN","C0CMED3",304,0)
- N MEDTMP,MEDI
+ I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
 "RTN","C0CMED3",305,0)
- D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+ . W "MEDICATION MISSING ",!
 "RTN","C0CMED3",306,0)
- I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+ . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
 "RTN","C0CMED3",307,0)
- . W "MEDICATION MISSING ",!
+ Q
 "RTN","C0CMED3",308,0)
- . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","C0CMED3",309,0)
- Q
-"RTN","C0CMED3",310,0)
  ;
 "RTN","C0CMED4")
-0^85^B61058927
+0^85^B60079150
 "RTN","C0CMED4",1,0)
 C0CMED4         ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS - Inpatient Meds/Unit Dose ;10/13/08 ; 5/10/12 2:38pm
 "RTN","C0CMED4",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CMED4",3,0)
- ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ; Copyright 2008 WorldVistA.  
 "RTN","C0CMED4",4,0)
- ; General Public License See attached copy of the License.
+ ;
 "RTN","C0CMED4",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CMED4",6,0)
- ; This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CMED4",7,0)
- ; it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CMED4",8,0)
- ; the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CMED4",9,0)
- ; (at your option) any later version.
+ ;
 "RTN","C0CMED4",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CMED4",11,0)
- ; This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CMED4",12,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CMED4",13,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CMED4",14,0)
- ; GNU General Public License for more details.
+ ;
 "RTN","C0CMED4",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CMED4",16,0)
- ; You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CMED4",17,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CMED4",18,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ W "NO ENTRY FROM TOP",!
 "RTN","C0CMED4",19,0)
- ;
+ Q
 "RTN","C0CMED4",20,0)
- W "NO ENTRY FROM TOP",!
+ ;
 "RTN","C0CMED4",21,0)
- Q
+EXTRACT(MINXML,DFN,OUTXML)           ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
 "RTN","C0CMED4",22,0)
  ;
 "RTN","C0CMED4",23,0)
-EXTRACT(MINXML,DFN,OUTXML)           ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
+ ; MINXML is the Input XML Template, passed by name
 "RTN","C0CMED4",24,0)
- ;
+ ; DFN is Patient IEN
 "RTN","C0CMED4",25,0)
- ; MINXML is the Input XML Template, passed by name
+ ; OUTXML is the resultant XML.
 "RTN","C0CMED4",26,0)
- ; DFN is Patient IEN
+ ;
 "RTN","C0CMED4",27,0)
- ; OUTXML is the resultant XML.
+ ; MEDS is return array from API.
 "RTN","C0CMED4",28,0)
- ;
+ ; MED is holds each array element from MEDS, one medicine
 "RTN","C0CMED4",29,0)
- ; MEDS is return array from API.
+ ; MAP is a mapping variable map (store result) for each med
 "RTN","C0CMED4",30,0)
- ; MED is holds each array element from MEDS, one medicine
+ ;
 "RTN","C0CMED4",31,0)
- ; MAP is a mapping variable map (store result) for each med
+ ; Inpatient Meds will be extracted using this routine and and the one following.
 "RTN","C0CMED4",32,0)
- ;
+ ; Inpatient Meds Unit Dose is going to be C0CMED4
 "RTN","C0CMED4",33,0)
- ; Inpatient Meds will be extracted using this routine and and the one following.
+ ; Inpatient Meds IVs is going to be C0CMED5
 "RTN","C0CMED4",34,0)
- ; Inpatient Meds Unit Dose is going to be C0CMED4
+ ;
 "RTN","C0CMED4",35,0)
- ; Inpatient Meds IVs is going to be C0CMED5
+ ; We will use two Pharmacy ReEnginnering API's:
 "RTN","C0CMED4",36,0)
- ;
+ ; PSS431^PSS55(DFN,PO,PSDATE,PEDATE,LIST) - provides most info
 "RTN","C0CMED4",37,0)
- ; We will use two Pharmacy ReEnginnering API's:
+ ; PSS432^PSS55(DFN,PO,LIST) - provides schedule info
 "RTN","C0CMED4",38,0)
- ; PSS431^PSS55(DFN,PO,PSDATE,PEDATE,LIST) - provides most info
+ ; For more information, see the PRE documentation at:
 "RTN","C0CMED4",39,0)
- ; PSS432^PSS55(DFN,PO,LIST) - provides schedule info
+ ; http://www.va.gov/vdl/documents/Clinical/Pharm-Inpatient_Med/phar_1_api_r0807.pdf
 "RTN","C0CMED4",40,0)
- ; For more information, see the PRE documentation at:
+ ; 
 "RTN","C0CMED4",41,0)
- ; http://www.va.gov/vdl/documents/Clinical/Pharm-Inpatient_Med/phar_1_api_r0807.pdf
+ ; Med data is stored in Unit Dose multiple of file 55, pharmacy patient
 "RTN","C0CMED4",42,0)
- ; 
+ ;
 "RTN","C0CMED4",43,0)
- ; Med data is stored in Unit Dose multiple of file 55, pharmacy patient
+ N MEDS,MAP
 "RTN","C0CMED4",44,0)
- ;
+ K ^TMP($J)
 "RTN","C0CMED4",45,0)
- N MEDS,MAP
+ D PSS431^PSS55(DFN,,,,"UD") ; Output is in ^TMP($J,"UD",*)
 "RTN","C0CMED4",46,0)
- K ^TMP($J)
+ I ^TMP($J,"UD",0)'>0 S @OUTXML@(0)=0 QUIT  ; No Meds - Quit
 "RTN","C0CMED4",47,0)
- D PSS431^PSS55(DFN,,,,"UD") ; Output is in ^TMP($J,"UD",*)
+ ; Otherwise, we go on...
 "RTN","C0CMED4",48,0)
- I ^TMP($J,"UD",0)'>0 S @OUTXML@(0)=0 QUIT  ; No Meds - Quit
+ M MEDS=^TMP($J,"UD")
 "RTN","C0CMED4",49,0)
- ; Otherwise, we go on...
+ ; I DEBUG ZWR MEDS
 "RTN","C0CMED4",50,0)
- M MEDS=^TMP($J,"UD")
+ S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
 "RTN","C0CMED4",51,0)
- I DEBUG ZWR MEDS
+ N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
 "RTN","C0CMED4",52,0)
- S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP")) 
+ N I S I=0
 "RTN","C0CMED4",53,0)
- N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
+ F  S I=$O(MEDS("B",I)) Q:'I  D  ; For each medication in B index
 "RTN","C0CMED4",54,0)
- N I S I=0 
+ . N MED M MED=MEDS(I)
 "RTN","C0CMED4",55,0)
- F  S I=$O(MEDS("B",I)) Q:'I  D  ; For each medication in B index
+ . S MEDCOUNT=MEDCOUNT+1
 "RTN","C0CMED4",56,0)
- . N MED M MED=MEDS(I)
+ . S @MEDMAP@(0)=MEDCOUNT ; Update MedMap array counter
 "RTN","C0CMED4",57,0)
- . S MEDCOUNT=MEDCOUNT+1
+ . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
 "RTN","C0CMED4",58,0)
- . S @MEDMAP@(0)=MEDCOUNT ; Update MedMap array counter
+ . N RXIEN S RXIEN=MED(.01) ; Order Number
 "RTN","C0CMED4",59,0)
- . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
+ . I DEBUG W "RXIEN IS ",RXIEN,!
 "RTN","C0CMED4",60,0)
- . N RXIEN S RXIEN=MED(.01) ; Order Number
+ . I DEBUG W "MAP= ",MAP,!
 "RTN","C0CMED4",61,0)
- . I DEBUG W "RXIEN IS ",RXIEN,!
+ . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN
 "RTN","C0CMED4",62,0)
- . I DEBUG W "MAP= ",MAP,!
+ . S @MAP@("MEDISSUEDATETXT")="Order Date"
 "RTN","C0CMED4",63,0)
- . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN 
+ . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT")
 "RTN","C0CMED4",64,0)
- . S @MAP@("MEDISSUEDATETXT")="Order Date"
+ . S @MAP@("MEDLASTFILLDATETXT")="" ; For Outpatient
 "RTN","C0CMED4",65,0)
- . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT")
+ . S @MAP@("MEDLASTFILLDATE")="" ; For Outpatient
 "RTN","C0CMED4",66,0)
- . S @MAP@("MEDLASTFILLDATETXT")="" ; For Outpatient
+ . S @MAP@("MEDRXNOTXT")="" ; For Outpatient
 "RTN","C0CMED4",67,0)
- . S @MAP@("MEDLASTFILLDATE")="" ; For Outpatient
+ . S @MAP@("MEDRXNO")="" ; For Outpatient
 "RTN","C0CMED4",68,0)
- . S @MAP@("MEDRXNOTXT")="" ; For Outpatient
+ . S @MAP@("MEDTYPETEXT")="Medication"
 "RTN","C0CMED4",69,0)
- . S @MAP@("MEDRXNO")="" ; For Outpatient
+ . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
 "RTN","C0CMED4",70,0)
- . S @MAP@("MEDTYPETEXT")="Medication"
+ . S @MAP@("MEDSTATUSTEXT")="ACTIVE"
 "RTN","C0CMED4",71,0)
- . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
+ . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U)
 "RTN","C0CMED4",72,0)
- . S @MAP@("MEDSTATUSTEXT")="ACTIVE" 
+ . S @MAP@("MEDPRODUCTNAMETEXT")=MED("DDRUG",1,.01)
 "RTN","C0CMED4",73,0)
- . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U)
+ . ; NDC is field 31 in the drug file.
 "RTN","C0CMED4",74,0)
- . S @MAP@("MEDPRODUCTNAMETEXT")=MED("DDRUG",1,.01)
+ . ; The actual drug entry in the drug file is not necessarily supplied.
 "RTN","C0CMED4",75,0)
- . ; NDC is field 31 in the drug file.
+ . ; It' node 1, internal form.
 "RTN","C0CMED4",76,0)
- . ; The actual drug entry in the drug file is not necessarily supplied.
+ . N MEDIEN S MEDIEN=MED(1,"I")
 "RTN","C0CMED4",77,0)
- . ; It' node 1, internal form.
+ . S @MAP@("MEDPRODUCTNAMECODEVALUE")=$S($L(MEDIEN):$$GET1^DIQ(50,MEDIEN,31,"E"),1:"")
 "RTN","C0CMED4",78,0)
- . N MEDIEN S MEDIEN=MED(1,"I")
+ . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=$S($L(MEDIEN):"NDC",1:"")
 "RTN","C0CMED4",79,0)
- . S @MAP@("MEDPRODUCTNAMECODEVALUE")=$S($L(MEDIEN):$$GET1^DIQ(50,MEDIEN,31,"E"),1:"")
+ . S @MAP@("MEDPRODUCTNAMECODEVERSION")=$S($L(MEDIEN):"none",1:"")
 "RTN","C0CMED4",80,0)
- . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=$S($L(MEDIEN):"NDC",1:"")
+ . S @MAP@("MEDBRANDNAMETEXT")=""
 "RTN","C0CMED4",81,0)
- . S @MAP@("MEDPRODUCTNAMECODEVERSION")=$S($L(MEDIEN):"none",1:"")
+ . I $L(MEDIEN) D DOSE^PSS50(MEDIEN,,,,,"DOSE")
 "RTN","C0CMED4",82,0)
- . S @MAP@("MEDBRANDNAMETEXT")=""
+ . I $L(MEDIEN) N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
 "RTN","C0CMED4",83,0)
- . I $L(MEDIEN) D DOSE^PSS50(MEDIEN,,,,,"DOSE")
+ . S @MAP@("MEDSTRENGTHVALUE")=$S($L(MEDIEN):DOSEDATA(901),1:"")
 "RTN","C0CMED4",84,0)
- . I $L(MEDIEN) N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
+ . S @MAP@("MEDSTRENGTHUNIT")=$S($L(MEDIEN):$P(DOSEDATA(902),U,2),1:"")
 "RTN","C0CMED4",85,0)
- . S @MAP@("MEDSTRENGTHVALUE")=$S($L(MEDIEN):DOSEDATA(901),1:"")
+ . ; Units, concentration, etc, come from another call
 "RTN","C0CMED4",86,0)
- . S @MAP@("MEDSTRENGTHUNIT")=$S($L(MEDIEN):$P(DOSEDATA(902),U,2),1:"")
+ . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
 "RTN","C0CMED4",87,0)
- . ; Units, concentration, etc, come from another call
+ . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
 "RTN","C0CMED4",88,0)
- . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
+ . ; NDF Entry IEN, and VA Product Name
 "RTN","C0CMED4",89,0)
- . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
+ . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
 "RTN","C0CMED4",90,0)
- . ; NDF Entry IEN, and VA Product Name
+ . ; Documented in the same manual.
 "RTN","C0CMED4",91,0)
- . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
+ . N NDFDATA,CONCDATA
 "RTN","C0CMED4",92,0)
- . ; Documented in the same manual.
+ . I $L(MEDIEN) D
 "RTN","C0CMED4",93,0)
- . N NDFDATA,CONCDATA
+ . . D NDF^PSS50(MEDIEN,,,,,"CONC")
 "RTN","C0CMED4",94,0)
+ . . M NDFDATA=^TMP($J,"CONC",MEDIEN)
+"RTN","C0CMED4",95,0)
+ . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
+"RTN","C0CMED4",96,0)
+ . . N VAPROD S VAPROD=$P(NDFDATA(22),U)
+"RTN","C0CMED4",97,0)
+ . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
+"RTN","C0CMED4",98,0)
+ . . ; and this will crash the call. So...
+"RTN","C0CMED4",99,0)
+ . . I NDFIEN="" S CONCDATA=""
+"RTN","C0CMED4",100,0)
+ . . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
+"RTN","C0CMED4",101,0)
+ . E  S (NDFDATA,CONCDATA)="" ; This line is defensive programming to prevent undef errors.
+"RTN","C0CMED4",102,0)
+ . S @MAP@("MEDFORMTEXT")=$S($L(MEDIEN):$P(CONCDATA,U,1),1:"")
+"RTN","C0CMED4",103,0)
+ . S @MAP@("MEDCONCVALUE")=$S($L(MEDIEN):$P(CONCDATA,U,3),1:"")
+"RTN","C0CMED4",104,0)
+ . S @MAP@("MEDCONCUNIT")=$S($L(MEDIEN):$P(CONCDATA,U,4),1:"")
+"RTN","C0CMED4",105,0)
+ . S @MAP@("MEDQUANTITYVALUE")=""  ; not provided for in Non-VA meds.
+"RTN","C0CMED4",106,0)
+ . ; Oddly, there is no easy place to find the dispense unit.
+"RTN","C0CMED4",107,0)
+ . ; It's not included in the original call, so we have to go to the drug file.
+"RTN","C0CMED4",108,0)
+ . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
+"RTN","C0CMED4",109,0)
+ . ; Node 14.5 is the Dispense Unit
+"RTN","C0CMED4",110,0)
  . I $L(MEDIEN) D
-"RTN","C0CMED4",95,0)
- . . D NDF^PSS50(MEDIEN,,,,,"CONC")
-"RTN","C0CMED4",96,0)
- . . M NDFDATA=^TMP($J,"CONC",MEDIEN)
-"RTN","C0CMED4",97,0)
- . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
-"RTN","C0CMED4",98,0)
- . . N VAPROD S VAPROD=$P(NDFDATA(22),U)
-"RTN","C0CMED4",99,0)
- . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
-"RTN","C0CMED4",100,0)
- . . ; and this will crash the call. So...
-"RTN","C0CMED4",101,0)
- . . I NDFIEN="" S CONCDATA=""
-"RTN","C0CMED4",102,0)
- . . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
-"RTN","C0CMED4",103,0)
- . E  S (NDFDATA,CONCDATA)="" ; This line is defensive programming to prevent undef errors.
-"RTN","C0CMED4",104,0)
- . S @MAP@("MEDFORMTEXT")=$S($L(MEDIEN):$P(CONCDATA,U,1),1:"")
-"RTN","C0CMED4",105,0)
- . S @MAP@("MEDCONCVALUE")=$S($L(MEDIEN):$P(CONCDATA,U,3),1:"")
-"RTN","C0CMED4",106,0)
- . S @MAP@("MEDCONCUNIT")=$S($L(MEDIEN):$P(CONCDATA,U,4),1:"")
-"RTN","C0CMED4",107,0)
- . S @MAP@("MEDQUANTITYVALUE")=""  ; not provided for in Non-VA meds.
-"RTN","C0CMED4",108,0)
- . ; Oddly, there is no easy place to find the dispense unit.
-"RTN","C0CMED4",109,0)
- . ; It's not included in the original call, so we have to go to the drug file.
-"RTN","C0CMED4",110,0)
- . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
 "RTN","C0CMED4",111,0)
- . ; Node 14.5 is the Dispense Unit
+ . . D DATA^PSS50(MEDIEN,,,,,"QTY")
 "RTN","C0CMED4",112,0)
- . I $L(MEDIEN) D
+ . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
 "RTN","C0CMED4",113,0)
- . . D DATA^PSS50(MEDIEN,,,,,"QTY")
+ . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
 "RTN","C0CMED4",114,0)
- . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
+ . E  S @MAP@("MEDQUANTITYUNIT")=""
 "RTN","C0CMED4",115,0)
- . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
+ . ;
 "RTN","C0CMED4",116,0)
-   E  S @MAP@("MEDQUANTITYUNIT")=""
+ . ; --- START OF DIRECTIONS ---
 "RTN","C0CMED4",117,0)
+ . ; Dosage is field 2, route is 3, schedule is 4
+"RTN","C0CMED4",118,0)
+ . ; These are all free text fields, and don't point to any files
+"RTN","C0CMED4",119,0)
+ . ; For that reason, I will use the field I never used before:
+"RTN","C0CMED4",120,0)
+ . ; MEDDIRECTIONDESCRIPTIONTEXT
+"RTN","C0CMED4",121,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
+"RTN","C0CMED4",122,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4"  ; means look in description text. See E2369-05.
+"RTN","C0CMED4",123,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
+"RTN","C0CMED4",124,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
+"RTN","C0CMED4",125,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
+"RTN","C0CMED4",126,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
+"RTN","C0CMED4",127,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
+"RTN","C0CMED4",128,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
+"RTN","C0CMED4",129,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
+"RTN","C0CMED4",130,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
+"RTN","C0CMED4",131,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
+"RTN","C0CMED4",132,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""
+"RTN","C0CMED4",133,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""
+"RTN","C0CMED4",134,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""
+"RTN","C0CMED4",135,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""
+"RTN","C0CMED4",136,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""
+"RTN","C0CMED4",137,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""
+"RTN","C0CMED4",138,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""
+"RTN","C0CMED4",139,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""
+"RTN","C0CMED4",140,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
+"RTN","C0CMED4",141,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
+"RTN","C0CMED4",142,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
+"RTN","C0CMED4",143,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
+"RTN","C0CMED4",144,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
+"RTN","C0CMED4",145,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
+"RTN","C0CMED4",146,0)
  . ;
-"RTN","C0CMED4",118,0)
- . ; --- START OF DIRECTIONS ---
-"RTN","C0CMED4",119,0)
- . ; Dosage is field 2, route is 3, schedule is 4
-"RTN","C0CMED4",120,0)
- . ; These are all free text fields, and don't point to any files
-"RTN","C0CMED4",121,0)
- . ; For that reason, I will use the field I never used before:
-"RTN","C0CMED4",122,0)
- . ; MEDDIRECTIONDESCRIPTIONTEXT
-"RTN","C0CMED4",123,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
-"RTN","C0CMED4",124,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4"  ; means look in description text. See E2369-05.
-"RTN","C0CMED4",125,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
-"RTN","C0CMED4",126,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
-"RTN","C0CMED4",127,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
-"RTN","C0CMED4",128,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""  
-"RTN","C0CMED4",129,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""  
-"RTN","C0CMED4",130,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""  
-"RTN","C0CMED4",131,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
-"RTN","C0CMED4",132,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
-"RTN","C0CMED4",133,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
-"RTN","C0CMED4",134,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""
-"RTN","C0CMED4",135,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""
-"RTN","C0CMED4",136,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""
-"RTN","C0CMED4",137,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""
-"RTN","C0CMED4",138,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""
-"RTN","C0CMED4",139,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""
-"RTN","C0CMED4",140,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""
-"RTN","C0CMED4",141,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""
-"RTN","C0CMED4",142,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
-"RTN","C0CMED4",143,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
-"RTN","C0CMED4",144,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
-"RTN","C0CMED4",145,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")="" 
-"RTN","C0CMED4",146,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
 "RTN","C0CMED4",147,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
+ . ; --- END OF DIRECTIONS ---
 "RTN","C0CMED4",148,0)
  . ;
 "RTN","C0CMED4",149,0)
- . ; --- END OF DIRECTIONS ---
+ . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
 "RTN","C0CMED4",150,0)
- . ;
+ . S @MAP@("MEDPTINSTRUCTIONS")=MED(10,1) ; WP Field
 "RTN","C0CMED4",151,0)
- . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
+ . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
 "RTN","C0CMED4",152,0)
- . S @MAP@("MEDPTINSTRUCTIONS")=MED(10,1) ; WP Field
+ . S @MAP@("MEDRFNO")=""
 "RTN","C0CMED4",153,0)
- . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
+ . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))
 "RTN","C0CMED4",154,0)
- . S @MAP@("MEDRFNO")=""
+ . K @RESULT
 "RTN","C0CMED4",155,0)
- . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))
+ . D MAP^GPLXPATH(MINXML,MAP,RESULT)
 "RTN","C0CMED4",156,0)
- . K @RESULT
+ . ; D PARY^GPLXPATH(RESULT)
 "RTN","C0CMED4",157,0)
- . D MAP^GPLXPATH(MINXML,MAP,RESULT)
+ . ; MAPPING DIRECTIONS
 "RTN","C0CMED4",158,0)
- . ; D PARY^GPLXPATH(RESULT)
+ . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
 "RTN","C0CMED4",159,0)
- . ; MAPPING DIRECTIONS
+ . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
 "RTN","C0CMED4",160,0)
- . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
+ . D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
 "RTN","C0CMED4",161,0)
- . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
+ . D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions")
 "RTN","C0CMED4",162,0)
- . D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
+ . ; N MDZ1,MDZNA
 "RTN","C0CMED4",163,0)
- . D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions")
+ . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
 "RTN","C0CMED4",164,0)
- . ; N MDZ1,MDZNA
+ . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
 "RTN","C0CMED4",165,0)
- . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
+ . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
 "RTN","C0CMED4",166,0)
- . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
+ . . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2)
 "RTN","C0CMED4",167,0)
- . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
+ . . . D INSERT^GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")
 "RTN","C0CMED4",168,0)
- . . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2)
+ . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
 "RTN","C0CMED4",169,0)
- . . . D INSERT^GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")
+ . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
 "RTN","C0CMED4",170,0)
- . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
+ N MEDTMP,MEDI
 "RTN","C0CMED4",171,0)
- . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
+ D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
 "RTN","C0CMED4",172,0)
- N MEDTMP,MEDI
+ I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
 "RTN","C0CMED4",173,0)
- D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+ . W "MEDICATION MISSING ",!
 "RTN","C0CMED4",174,0)
- I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+ . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
 "RTN","C0CMED4",175,0)
- . W "MEDICATION MISSING ",!
+ Q
 "RTN","C0CMED4",176,0)
- . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","C0CMED4",177,0)
- Q
-"RTN","C0CMED4",178,0)
  ;
 "RTN","C0CMED6")
-0^52^B194349409
+0^52^B192343303
 "RTN","C0CMED6",1,0)
 C0CMED6 ; WV/CCDCCR/SMH - Meds from RPMS: Outpatient Meds;01/10/09
 "RTN","C0CMED6",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CMED6",3,0)
- ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ; Copyright 2008 WorldVistA.  
 "RTN","C0CMED6",4,0)
- ; General Public License See attached copy of the License.
+ ;
 "RTN","C0CMED6",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CMED6",6,0)
- ; This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CMED6",7,0)
- ; it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CMED6",8,0)
- ; the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CMED6",9,0)
- ; (at your option) any later version.
+ ;
 "RTN","C0CMED6",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CMED6",11,0)
- ; This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CMED6",12,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CMED6",13,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CMED6",14,0)
- ; GNU General Public License for more details.
+ ;
 "RTN","C0CMED6",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CMED6",16,0)
- ; You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CMED6",17,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CMED6",18,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ W "NO ENTRY FROM TOP",!
 "RTN","C0CMED6",19,0)
- ;
+ Q
 "RTN","C0CMED6",20,0)
- W "NO ENTRY FROM TOP",!
+ ;
 "RTN","C0CMED6",21,0)
- Q
+EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT,FLAGS)  ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
 "RTN","C0CMED6",22,0)
  ;
 "RTN","C0CMED6",23,0)
-EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT,FLAGS)  ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
+ ; MINXML and OUTXML are passed by name so globals can be used
 "RTN","C0CMED6",24,0)
- ;
+ ; MINXML will contain only the medications skeleton of the overall template
 "RTN","C0CMED6",25,0)
- ; MINXML and OUTXML are passed by name so globals can be used
+ ; MEDCOUNT is a counter passed by Reference.
 "RTN","C0CMED6",26,0)
- ; MINXML will contain only the medications skeleton of the overall template
+ ; FLAGS are: MEDALL(bool)^MEDLIMIT(int)^MEDACTIVE(bool)^MEDPENDING(bool)
 "RTN","C0CMED6",27,0)
- ; MEDCOUNT is a counter passed by Reference.
+ ; FLAGS are set-up in C0CMED.
 "RTN","C0CMED6",28,0)
- ; FLAGS are: MEDALL(bool)^MEDLIMIT(int)^MEDACTIVE(bool)^MEDPENDING(bool)
+ ;
 "RTN","C0CMED6",29,0)
- ; FLAGS are set-up in C0CMED.
+ ; MEDS is return array from RPC.
 "RTN","C0CMED6",30,0)
- ;
+ ; MAP is a mapping variable map (store result) for each med
 "RTN","C0CMED6",31,0)
- ; MEDS is return array from RPC.
+ ; MED is holds each array element from MEDS(J), one medicine
 "RTN","C0CMED6",32,0)
- ; MAP is a mapping variable map (store result) for each med
+ ; J is a counter.
 "RTN","C0CMED6",33,0)
- ; MED is holds each array element from MEDS(J), one medicine
+ ;
 "RTN","C0CMED6",34,0)
- ; J is a counter.
+ ; GETRXS^BEHORXFN(ARRAYNAME,DFN,DAYS) will be the the API used.
 "RTN","C0CMED6",35,0)
- ;
+ ; This API has been developed by Medsphere for IHS for getting
 "RTN","C0CMED6",36,0)
- ; GETRXS^BEHORXFN(ARRAYNAME,DFN,DAYS) will be the the API used.
+ ; Medications from RPMS. It has most of what we need.
 "RTN","C0CMED6",37,0)
- ; This API has been developed by Medsphere for IHS for getting
+ ; API written by Doug Martin when he worked for Medsphere (thanks Doug!)
 "RTN","C0CMED6",38,0)
- ; Medications from RPMS. It has most of what we need.
+ ; -- ARRAYNAME is passed by name (required)
 "RTN","C0CMED6",39,0)
- ; API written by Doug Martin when he worked for Medsphere (thanks Doug!)
+ ; -- DFN is passed by value (required)
 "RTN","C0CMED6",40,0)
- ; -- ARRAYNAME is passed by name (required)
+ ; -- DAYS is passed by value (optional; if not passed defaults to 365)
 "RTN","C0CMED6",41,0)
- ; -- DFN is passed by value (required)
+ ; 
 "RTN","C0CMED6",42,0)
- ; -- DAYS is passed by value (optional; if not passed defaults to 365)
+ ; Return:
 "RTN","C0CMED6",43,0)
+ ; ~Type^PharmID^Drug^InfRate^StopDt^RefRem^TotDose^UnitDose^OrderID 
+"RTN","C0CMED6",44,0)
+ ; ^Status^LastFill^Chronic^Issued^Rx #^Provider^ 
+"RTN","C0CMED6",45,0)
+ ; Status Reason^DEA Handling
+"RTN","C0CMED6",46,0)
  ; 
-"RTN","C0CMED6",44,0)
- ; Return:
-"RTN","C0CMED6",45,0)
- ; ~Type^PharmID^Drug^InfRate^StopDt^RefRem^TotDose^UnitDose^OrderID 
-"RTN","C0CMED6",46,0)
- ; ^Status^LastFill^Chronic^Issued^Rx #^Provider^ 
 "RTN","C0CMED6",47,0)
- ; Status Reason^DEA Handling
+ N MEDS,MEDS1,MAP
 "RTN","C0CMED6",48,0)
- ; 
+ D GETRXS^BEHORXFN("MEDS1",DFN,$P($P(FLAGS,U,2),"-",2)) ; 2nd piece of FLAGS is # of days to retrieve, which comes in the form "T-360"
 "RTN","C0CMED6",49,0)
- N MEDS,MEDS1,MAP
+ N ALL S ALL=+FLAGS
 "RTN","C0CMED6",50,0)
- D GETRXS^BEHORXFN("MEDS1",DFN,$P($P(FLAGS,U,2),"-",2)) ; 2nd piece of FLAGS is # of days to retrieve, which comes in the form "T-360"
+ N ACTIVE S ACTIVE=$P(FLAGS,U,3)
 "RTN","C0CMED6",51,0)
- N ALL S ALL=+FLAGS
+ N PENDING S PENDING=$P(FLAGS,U,4)
 "RTN","C0CMED6",52,0)
- N ACTIVE S ACTIVE=$P(FLAGS,U,3)
+ S @OUTXML@(0)=0  ;By default, no meds
 "RTN","C0CMED6",53,0)
- N PENDING S PENDING=$P(FLAGS,U,4)
+ ; If MEDS1 is not defined, then no meds
 "RTN","C0CMED6",54,0)
- S @OUTXML@(0)=0  ;By default, no meds
+ I '$D(MEDS1) QUIT
 "RTN","C0CMED6",55,0)
- ; If MEDS1 is not defined, then no meds
+ ;I DEBUG ZWR MEDS1,MINXML
 "RTN","C0CMED6",56,0)
- I '$D(MEDS1) QUIT
+ N MEDCNT S MEDCNT=0 ; Med Count
 "RTN","C0CMED6",57,0)
- I DEBUG ZWR MEDS1,MINXML
+ ; The next line is a super line. It goes through the array return
 "RTN","C0CMED6",58,0)
- N MEDCNT S MEDCNT=0 ; Med Count
+ ; and if the first characters are ~OP, it grabs the line.
 "RTN","C0CMED6",59,0)
- ; The next line is a super line. It goes through the array return
+ ; This means that line is for a dispensed Outpatient Med.
 "RTN","C0CMED6",60,0)
- ; and if the first characters are ~OP, it grabs the line.
+ ; That line has the metadata about the med that I need.
 "RTN","C0CMED6",61,0)
- ; This means that line is for a dispensed Outpatient Med.
+ ; The next lines, however many, are the med and the sig.
 "RTN","C0CMED6",62,0)
- ; That line has the metadata about the med that I need.
+ ; I won't be using those because I have to get the sig parsed exactly.
 "RTN","C0CMED6",63,0)
- ; The next lines, however many, are the med and the sig.
+ N J S J="" F  S J=$O(MEDS1(J)) Q:J=""  I $E(MEDS1(J),1,3)="~OP" S MEDCNT=MEDCNT+1 S MEDS(MEDCNT)=MEDS1(J)
 "RTN","C0CMED6",64,0)
- ; I won't be using those because I have to get the sig parsed exactly.
+ K MEDS1
 "RTN","C0CMED6",65,0)
- N J S J="" F  S J=$O(MEDS1(J)) Q:J=""  I $E(MEDS1(J),1,3)="~OP" S MEDCNT=MEDCNT+1 S MEDS(MEDCNT)=MEDS1(J)
+ S MEDCNT="" ; Initialize for $Order
 "RTN","C0CMED6",66,0)
- K MEDS1
+ F  S MEDCNT=$O(MEDS(MEDCNT)) Q:MEDCNT=""  D  ; for each medication in the list
 "RTN","C0CMED6",67,0)
- S MEDCNT="" ; Initialize for $Order
+ . I 'ALL,ACTIVE,$P(MEDS(MEDCNT),U,10)'="ACTIVE" QUIT
 "RTN","C0CMED6",68,0)
- F  S MEDCNT=$O(MEDS(MEDCNT)) Q:MEDCNT=""  D  ; for each medication in the list
+ . I 'ALL,PENDING,$P(MEDS(MEDCNT),U,10)'="PENDING" QUIT
 "RTN","C0CMED6",69,0)
- . I 'ALL,ACTIVE,$P(MEDS(MEDCNT),U,10)'="ACTIVE" QUIT
+ . I DEBUG W "MEDCNT IS ",MEDCNT,!
 "RTN","C0CMED6",70,0)
- . I 'ALL,PENDING,$P(MEDS(MEDCNT),U,10)'="PENDING" QUIT
+ . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCNT))
 "RTN","C0CMED6",71,0)
- . I DEBUG W "MEDCNT IS ",MEDCNT,!
+ . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED
 "RTN","C0CMED6",72,0)
- . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCNT))
+ . I DEBUG W "MAP= ",MAP,!
 "RTN","C0CMED6",73,0)
- . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED
+ . S @MAP@("MEDOBJECTID")="MED"_MEDCNT ; MEDCNT FOR ID
 "RTN","C0CMED6",74,0)
- . I DEBUG W "MAP= ",MAP,!
+ . S @MAP@("MEDISSUEDATETXT")="Issue Date"
 "RTN","C0CMED6",75,0)
- . S @MAP@("MEDOBJECTID")="MED"_MEDCNT ; MEDCNT FOR ID
+ . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,15),"DT")
 "RTN","C0CMED6",76,0)
- . S @MAP@("MEDISSUEDATETXT")="Issue Date"
+ . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
 "RTN","C0CMED6",77,0)
- . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,15),"DT")
+ . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,11),"DT")
 "RTN","C0CMED6",78,0)
- . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
+ . S @MAP@("MEDRXNOTXT")="Prescription Number"
 "RTN","C0CMED6",79,0)
- . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,11),"DT")
+ . S @MAP@("MEDRXNO")=$P(MEDS(MEDCNT),U,14)
 "RTN","C0CMED6",80,0)
- . S @MAP@("MEDRXNOTXT")="Prescription Number"
+ . S @MAP@("MEDTYPETEXT")="Medication"
 "RTN","C0CMED6",81,0)
- . S @MAP@("MEDRXNO")=$P(MEDS(MEDCNT),U,14)
+ . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
 "RTN","C0CMED6",82,0)
- . S @MAP@("MEDTYPETEXT")="Medication"
+ . S @MAP@("MEDSTATUSTEXT")=$P(MEDS(MEDCNT),U,10)
 "RTN","C0CMED6",83,0)
- . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
+ . ; Provider only provided in API as text, not DUZ.
 "RTN","C0CMED6",84,0)
- . S @MAP@("MEDSTATUSTEXT")=$P(MEDS(MEDCNT),U,10)
+ . ; We need to get DUZ from filman file 52 (Prescription)
 "RTN","C0CMED6",85,0)
- . ; Provider only provided in API as text, not DUZ.
+ . ; Field 4; IEN is Piece 2 of Meds stripped of trailing characters.
 "RTN","C0CMED6",86,0)
- . ; We need to get DUZ from filman file 52 (Prescription)
+ . ; Note that I will use RXIEN several times later
 "RTN","C0CMED6",87,0)
- . ; Field 4; IEN is Piece 2 of Meds stripped of trailing characters.
+ . N RXIEN S RXIEN=+$P(MEDS(MEDCNT),U,2)
 "RTN","C0CMED6",88,0)
- . ; Note that I will use RXIEN several times later
+ . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52,RXIEN,4,"I")
 "RTN","C0CMED6",89,0)
- . N RXIEN S RXIEN=+$P(MEDS(MEDCNT),U,2)
+ . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MEDS(MEDCNT),U,3)
 "RTN","C0CMED6",90,0)
- . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52,RXIEN,4,"I")
+ . ; --- RxNorm Stuff 
 "RTN","C0CMED6",91,0)
- . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MEDS(MEDCNT),U,3)
+ . ; 176.001 is the file for Concepts; 176.003 is the file for
 "RTN","C0CMED6",92,0)
- . ; --- RxNorm Stuff 
+ . ; sources (i.e. for RxNorm Version)
 "RTN","C0CMED6",93,0)
- . ; 176.001 is the file for Concepts; 176.003 is the file for
+ . ; 
 "RTN","C0CMED6",94,0)
- . ; sources (i.e. for RxNorm Version)
+ . ; I use 176.001 for the Vista version of this routine (files 1-3)
 "RTN","C0CMED6",95,0)
+ . ; Since IHS does not have VUID's, I will be getting RxNorm codes
+"RTN","C0CMED6",96,0)
+ . ; using NDCs. My specially crafted index (sounds evil) named "NDC"
+"RTN","C0CMED6",97,0)
+ . ; is in file 176.002. The file is called RxNorm NDC to VUID.
+"RTN","C0CMED6",98,0)
+ . ; Except that I don't need the VUID, but it's there if I need it.
+"RTN","C0CMED6",99,0)
  . ; 
-"RTN","C0CMED6",96,0)
- . ; I use 176.001 for the Vista version of this routine (files 1-3)
-"RTN","C0CMED6",97,0)
- . ; Since IHS does not have VUID's, I will be getting RxNorm codes
-"RTN","C0CMED6",98,0)
- . ; using NDCs. My specially crafted index (sounds evil) named "NDC"
-"RTN","C0CMED6",99,0)
- . ; is in file 176.002. The file is called RxNorm NDC to VUID.
 "RTN","C0CMED6",100,0)
- . ; Except that I don't need the VUID, but it's there if I need it.
+ . ; We obviously need the NDC. That is easily obtained from the prescription.
 "RTN","C0CMED6",101,0)
+ . ; Field 27 in file 52
+"RTN","C0CMED6",102,0)
+ . N NDC S NDC=$$GET1^DIQ(52,RXIEN,27,"I")
+"RTN","C0CMED6",103,0)
+ . ; I discovered that file 176.002 might give you two codes for the NDC
+"RTN","C0CMED6",104,0)
+ . ; One for the Clinical Drug, and one for the ingredient.
+"RTN","C0CMED6",105,0)
+ . ; So the plan is to get the two RxNorm codes, and then find from
+"RTN","C0CMED6",106,0)
+ . ; file 176.001 which one is the Clinical Drug.
+"RTN","C0CMED6",107,0)
+ . ; ... I refactored this into GETRXN
+"RTN","C0CMED6",108,0)
+ . N RXNORM,SRCIEN,RXNNAME,RXNVER
+"RTN","C0CMED6",109,0)
+ . I +NDC,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
+"RTN","C0CMED6",110,0)
+ . . S RXNORM=$$GETRXN(NDC)
+"RTN","C0CMED6",111,0)
+ . . S SRCIEN=$$FIND1^DIC(176.003,,,"RXNORM","B")
+"RTN","C0CMED6",112,0)
+ . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
+"RTN","C0CMED6",113,0)
+ . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
+"RTN","C0CMED6",114,0)
+ . ;
+"RTN","C0CMED6",115,0)
+ . E  S (RXNORM,RXNNAME,RXNVER)=""
+"RTN","C0CMED6",116,0)
+ . ; End if/else block
+"RTN","C0CMED6",117,0)
+ . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
+"RTN","C0CMED6",118,0)
+ . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
+"RTN","C0CMED6",119,0)
+ . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
+"RTN","C0CMED6",120,0)
+ . ; --- End RxNorm section
+"RTN","C0CMED6",121,0)
+ . ;
+"RTN","C0CMED6",122,0)
+ . ; Brand name is 52 field 6.5
+"RTN","C0CMED6",123,0)
+ . S @MAP@("MEDBRANDNAMETEXT")=$$GET1^DIQ(52,RXIEN,6.5)
+"RTN","C0CMED6",124,0)
+ . ;
+"RTN","C0CMED6",125,0)
+ . ; Next I need Med Form (tab, cap etc), strength (250mg)
+"RTN","C0CMED6",126,0)
+ . ; concentration for liquids (250mg/mL)
+"RTN","C0CMED6",127,0)
+ . ; Since IHS does not have any of the new calls that 
+"RTN","C0CMED6",128,0)
+ . ; Vista has, I will be doing a crosswalk:
+"RTN","C0CMED6",129,0)
+ . ; File 52, field 6 is Drug IEN in file 50
+"RTN","C0CMED6",130,0)
+ . ; File 50, field 22 is VA Product IEN in file 50.68
+"RTN","C0CMED6",131,0)
+ . ; In file 50.68, I will get the following:
+"RTN","C0CMED6",132,0)
+ . ; -- 1: Dosage Form
+"RTN","C0CMED6",133,0)
+ . ; -- 2: Strength
+"RTN","C0CMED6",134,0)
+ . ; -- 3: Units
+"RTN","C0CMED6",135,0)
+ . ; -- 8: Dispense Units
+"RTN","C0CMED6",136,0)
+ . ; -- Conc is 2 concatenated with 3
+"RTN","C0CMED6",137,0)
  . ; 
-"RTN","C0CMED6",102,0)
- . ; We obviously need the NDC. That is easily obtained from the prescription.
-"RTN","C0CMED6",103,0)
- . ; Field 27 in file 52
-"RTN","C0CMED6",104,0)
- . N NDC S NDC=$$GET1^DIQ(52,RXIEN,27,"I")
-"RTN","C0CMED6",105,0)
- . ; I discovered that file 176.002 might give you two codes for the NDC
-"RTN","C0CMED6",106,0)
- . ; One for the Clinical Drug, and one for the ingredient.
-"RTN","C0CMED6",107,0)
- . ; So the plan is to get the two RxNorm codes, and then find from
-"RTN","C0CMED6",108,0)
- . ; file 176.001 which one is the Clinical Drug.
-"RTN","C0CMED6",109,0)
- . ; ... I refactored this into GETRXN
-"RTN","C0CMED6",110,0)
- . N RXNORM,SRCIEN,RXNNAME,RXNVER
-"RTN","C0CMED6",111,0)
- . I +NDC,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
-"RTN","C0CMED6",112,0)
- . . S RXNORM=$$GETRXN(NDC)
-"RTN","C0CMED6",113,0)
- . . S SRCIEN=$$FIND1^DIC(176.003,,,"RXNORM","B")
-"RTN","C0CMED6",114,0)
- . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
-"RTN","C0CMED6",115,0)
- . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
-"RTN","C0CMED6",116,0)
+"RTN","C0CMED6",138,0)
+ . ; *** If Drug is not matched to NDF, then VA Product will be "" ***
+"RTN","C0CMED6",139,0)
  . ;
-"RTN","C0CMED6",117,0)
- . E  S (RXNORM,RXNNAME,RXNVER)=""
-"RTN","C0CMED6",118,0)
- . ; End if/else block
-"RTN","C0CMED6",119,0)
- . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
-"RTN","C0CMED6",120,0)
- . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
-"RTN","C0CMED6",121,0)
- . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
-"RTN","C0CMED6",122,0)
- . ; --- End RxNorm section
-"RTN","C0CMED6",123,0)
+"RTN","C0CMED6",140,0)
+ . N MEDIEN S MEDIEN=$$GET1^DIQ(52,RXIEN,6,"I") ; Drug IEN in 50
+"RTN","C0CMED6",141,0)
+ . N VAPROD S VAPROD=$$GET1^DIQ(50,MEDIEN,22,"I") ; VA Product in file 50.68
+"RTN","C0CMED6",142,0)
+ . I +VAPROD D
+"RTN","C0CMED6",143,0)
+ . . S @MAP@("MEDSTRENGTHVALUE")=$$GET1^DIQ(50.68,VAPROD,2)
+"RTN","C0CMED6",144,0)
+ . . S @MAP@("MEDSTRENGTHUNIT")=$$GET1^DIQ(50.68,VAPROD,3)
+"RTN","C0CMED6",145,0)
+ . . S @MAP@("MEDFORMTEXT")=$$GET1^DIQ(50.68,VAPROD,1)
+"RTN","C0CMED6",146,0)
+ . . S @MAP@("MEDCONCVALUE")=@MAP@("MEDSTRENGTHVALUE")
+"RTN","C0CMED6",147,0)
+ . . S @MAP@("MEDCONCUNIT")=@MAP@("MEDSTRENGTHUNIT")
+"RTN","C0CMED6",148,0)
+ . E  D
+"RTN","C0CMED6",149,0)
+ . . S @MAP@("MEDSTRENGTHVALUE")=""
+"RTN","C0CMED6",150,0)
+ . . S @MAP@("MEDSTRENGTHUNIT")=""
+"RTN","C0CMED6",151,0)
+ . . S @MAP@("MEDFORMTEXT")=""
+"RTN","C0CMED6",152,0)
+ . . S @MAP@("MEDCONCVALUE")=""
+"RTN","C0CMED6",153,0)
+ . . S @MAP@("MEDCONCUNIT")=""
+"RTN","C0CMED6",154,0)
+ . ; End Strengh/Conc stuff
+"RTN","C0CMED6",155,0)
  . ;
-"RTN","C0CMED6",124,0)
- . ; Brand name is 52 field 6.5
-"RTN","C0CMED6",125,0)
- . S @MAP@("MEDBRANDNAMETEXT")=$$GET1^DIQ(52,RXIEN,6.5)
-"RTN","C0CMED6",126,0)
+"RTN","C0CMED6",156,0)
+ . ; Quantity is in the prescription, field 7
+"RTN","C0CMED6",157,0)
+ . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52,RXIEN,7)
+"RTN","C0CMED6",158,0)
+ . ; Dispense unit is in the drug file, field 14.5
+"RTN","C0CMED6",159,0)
+ . S @MAP@("MEDQUANTITYUNIT")=$$GET1^DIQ(50,MEDIEN,14.5)
+"RTN","C0CMED6",160,0)
  . ;
-"RTN","C0CMED6",127,0)
- . ; Next I need Med Form (tab, cap etc), strength (250mg)
-"RTN","C0CMED6",128,0)
- . ; concentration for liquids (250mg/mL)
-"RTN","C0CMED6",129,0)
- . ; Since IHS does not have any of the new calls that 
-"RTN","C0CMED6",130,0)
- . ; Vista has, I will be doing a crosswalk:
-"RTN","C0CMED6",131,0)
- . ; File 52, field 6 is Drug IEN in file 50
-"RTN","C0CMED6",132,0)
- . ; File 50, field 22 is VA Product IEN in file 50.68
-"RTN","C0CMED6",133,0)
- . ; In file 50.68, I will get the following:
-"RTN","C0CMED6",134,0)
- . ; -- 1: Dosage Form
-"RTN","C0CMED6",135,0)
- . ; -- 2: Strength
-"RTN","C0CMED6",136,0)
- . ; -- 3: Units
-"RTN","C0CMED6",137,0)
- . ; -- 8: Dispense Units
-"RTN","C0CMED6",138,0)
- . ; -- Conc is 2 concatenated with 3
-"RTN","C0CMED6",139,0)
- . ; 
-"RTN","C0CMED6",140,0)
- . ; *** If Drug is not matched to NDF, then VA Product will be "" ***
-"RTN","C0CMED6",141,0)
+"RTN","C0CMED6",161,0)
+ . ; --- START OF DIRECTIONS ---
+"RTN","C0CMED6",162,0)
+ . ; Sig data not in any API :-(  Oh yes, you can get the whole thing, but...
+"RTN","C0CMED6",163,0)
+ . ; we want the components.
+"RTN","C0CMED6",164,0)
+ . ; It's in multiple 113 in the Prescription File (52)
+"RTN","C0CMED6",165,0)
+ . ; #.01 DOSAGE ORDERED [1F]    "20"
+"RTN","C0CMED6",166,0)
+ . ; #1 DISPENSE UNITS PER DOSE [2N]  "1"
+"RTN","C0CMED6",167,0)
+ . ; #2 UNITS [3P:50.607]     "MG"
+"RTN","C0CMED6",168,0)
+ . ; #3 NOUN [4F]      "TABLET"
+"RTN","C0CMED6",169,0)
+ . ; #4 DURATION [5F]      "10D"
+"RTN","C0CMED6",170,0)
+ . ; #5 CONJUNCTION [6S]     "AND"
+"RTN","C0CMED6",171,0)
+ . ; #6 ROUTE [7P:51.2]     "ORAL"
+"RTN","C0CMED6",172,0)
+ . ; #7 SCHEDULE [8F]      "BID"
+"RTN","C0CMED6",173,0)
+ . ; #8 VERB [9F]       "TAKE"
+"RTN","C0CMED6",174,0)
  . ;
-"RTN","C0CMED6",142,0)
- . N MEDIEN S MEDIEN=$$GET1^DIQ(52,RXIEN,6,"I") ; Drug IEN in 50
-"RTN","C0CMED6",143,0)
- . N VAPROD S VAPROD=$$GET1^DIQ(50,MEDIEN,22,"I") ; VA Product in file 50.68
-"RTN","C0CMED6",144,0)
- . I +VAPROD D
-"RTN","C0CMED6",145,0)
- . . S @MAP@("MEDSTRENGTHVALUE")=$$GET1^DIQ(50.68,VAPROD,2)
-"RTN","C0CMED6",146,0)
- . . S @MAP@("MEDSTRENGTHUNIT")=$$GET1^DIQ(50.68,VAPROD,3)
-"RTN","C0CMED6",147,0)
- . . S @MAP@("MEDFORMTEXT")=$$GET1^DIQ(50.68,VAPROD,1)
-"RTN","C0CMED6",148,0)
- . . S @MAP@("MEDCONCVALUE")=@MAP@("MEDSTRENGTHVALUE")
-"RTN","C0CMED6",149,0)
- . . S @MAP@("MEDCONCUNIT")=@MAP@("MEDSTRENGTHUNIT")
-"RTN","C0CMED6",150,0)
- . E  D
-"RTN","C0CMED6",151,0)
- . . S @MAP@("MEDSTRENGTHVALUE")=""
-"RTN","C0CMED6",152,0)
- . . S @MAP@("MEDSTRENGTHUNIT")=""
-"RTN","C0CMED6",153,0)
- . . S @MAP@("MEDFORMTEXT")=""
-"RTN","C0CMED6",154,0)
- . . S @MAP@("MEDCONCVALUE")=""
-"RTN","C0CMED6",155,0)
- . . S @MAP@("MEDCONCUNIT")=""
-"RTN","C0CMED6",156,0)
- . ; End Strengh/Conc stuff
-"RTN","C0CMED6",157,0)
+"RTN","C0CMED6",175,0)
+ . ; Will use GETS^DIQ to get fields.
+"RTN","C0CMED6",176,0)
+ . ; Data comes out like this:
+"RTN","C0CMED6",177,0)
+ . ; SAMINS(52.0113,"1,23,",.01)=20
+"RTN","C0CMED6",178,0)
+ . ; SAMINS(52.0113,"1,23,",1)=1
+"RTN","C0CMED6",179,0)
+ . ; SAMINS(52.0113,"1,23,",2)="MG"
+"RTN","C0CMED6",180,0)
+ . ; SAMINS(52.0113,"1,23,",3)="TABLET"
+"RTN","C0CMED6",181,0)
+ . ; SAMINS(52.0113,"1,23,",4)="5D"
+"RTN","C0CMED6",182,0)
+ . ; SAMINS(52.0113,"1,23,",5)="THEN"
+"RTN","C0CMED6",183,0)
  . ;
-"RTN","C0CMED6",158,0)
- . ; Quantity is in the prescription, field 7
-"RTN","C0CMED6",159,0)
- . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52,RXIEN,7)
-"RTN","C0CMED6",160,0)
- . ; Dispense unit is in the drug file, field 14.5
-"RTN","C0CMED6",161,0)
- . S @MAP@("MEDQUANTITYUNIT")=$$GET1^DIQ(50,MEDIEN,14.5)
-"RTN","C0CMED6",162,0)
+"RTN","C0CMED6",184,0)
+ . N RAWDATA
+"RTN","C0CMED6",185,0)
+ . D GETS^DIQ(52,RXIEN,"113*",,"RAWDATA","DIERR")
+"RTN","C0CMED6",186,0)
+ . D:$D(DIERR) ^%ZTER  ; Log if there's an error in retrieving sig field
+"RTN","C0CMED6",187,0)
+ . ; none the less, continue; some parts are retrievable.
+"RTN","C0CMED6",188,0)
+ . N FMSIG M FMSIG=RAWDATA(52.0113) ; Merge into subfile...
+"RTN","C0CMED6",189,0)
+ . K RAWDATA
+"RTN","C0CMED6",190,0)
+ . N FMSIGNUM S FMSIGNUM="" ; Sigline number in fileman.
+"RTN","C0CMED6",191,0)
+ . ; FMSIGNUM gets outputted as "IEN,RXIEN,".
+"RTN","C0CMED6",192,0)
+ . ; DIRCNT is the proper Sigline numer.
+"RTN","C0CMED6",193,0)
+ . ; SIGDATA is the simplfied array. 
+"RTN","C0CMED6",194,0)
+ . F  S FMSIGNUM=$O(FMSIG(FMSIGNUM)) Q:FMSIGNUM=""  D
+"RTN","C0CMED6",195,0)
+ . . N DIRCNT S DIRCNT=$P(FMSIGNUM,",")
+"RTN","C0CMED6",196,0)
+ . . N SIGDATA M SIGDATA=FMSIG(FMSIGNUM)
+"RTN","C0CMED6",197,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
+"RTN","C0CMED6",198,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
+"RTN","C0CMED6",199,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$G(SIGDATA(8))
+"RTN","C0CMED6",200,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$G(SIGDATA(.01))
+"RTN","C0CMED6",201,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=$G(SIGDATA(2))
+"RTN","C0CMED6",202,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
+"RTN","C0CMED6",203,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
+"RTN","C0CMED6",204,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
+"RTN","C0CMED6",205,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$G(SIGDATA(6))
+"RTN","C0CMED6",206,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$G(SIGDATA(7))
+"RTN","C0CMED6",207,0)
+ . . ; Invervals... again another call.
+"RTN","C0CMED6",208,0)
+ . . ; In the wisdom of the original programmers, the schedule is a free text field
+"RTN","C0CMED6",209,0)
+ . . ; However, it gets translated by a call to the administration schedule file
+"RTN","C0CMED6",210,0)
+ . . ; to see if that schedule exists.
+"RTN","C0CMED6",211,0)
+ . . ; That's the same thing I am going to do.
+"RTN","C0CMED6",212,0)
+ . . ; Search B index of 51.1 (Admin Schedule) with schedule
+"RTN","C0CMED6",213,0)
+ . . ; First, remove "PRN" if it exists (don't ask, that's how the file
+"RTN","C0CMED6",214,0)
+ . . ; works; I wouldn't do it that way).
+"RTN","C0CMED6",215,0)
+ . . N SCHNOPRN S SCHNOPRN=$G(SIGDATA(7))
+"RTN","C0CMED6",216,0)
+ . . I SCHNOPRN["PRN" S SCHNOPRN=$E(SCHNOPRN,1,$F(SCHNOPRN,"PRN")-5)
+"RTN","C0CMED6",217,0)
+ . . ; Super call below:
+"RTN","C0CMED6",218,0)
+ . . ; 1=File 51.1 3=Field 2 (Frequency in Minutes)
+"RTN","C0CMED6",219,0)
+ . . ; 4=Packed format, Exact Match 5=Lookup Value
+"RTN","C0CMED6",220,0)
+ . . ; 6=# of entries to return 7=Index 10=Return Array
+"RTN","C0CMED6",221,0)
+ . . ; 
+"RTN","C0CMED6",222,0)
+ . . ; I do not account for the fact that two schedules can be
+"RTN","C0CMED6",223,0)
+ . . ; spelled identically (ie duplicate entry). In that case,
+"RTN","C0CMED6",224,0)
+ . . ; I get the first. That's just a bad pharmacy pkg maintainer.
+"RTN","C0CMED6",225,0)
+ . . N C0C515
+"RTN","C0CMED6",226,0)
+ . . D FIND^DIC(51.1,,"@;2","PX",SCHNOPRN,1,"B",,,"C0C515")
+"RTN","C0CMED6",227,0)
+ . . N INTERVAL S INTERVAL="" ; Default
+"RTN","C0CMED6",228,0)
+ . . ; If there are entries found, get it
+"RTN","C0CMED6",229,0)
+ . . I +$G(C0C515("DILIST",0)) S INTERVAL=$P(C0C515("DILIST",1,0),U,2)
+"RTN","C0CMED6",230,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
+"RTN","C0CMED6",231,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
+"RTN","C0CMED6",232,0)
+ . . ; Duration is 10M minutes, 10H hours, 10D for Days
+"RTN","C0CMED6",233,0)
+ . . ; 10W for weeks, 10L for months. I smell $Select
+"RTN","C0CMED6",234,0)
+ . . ; But we don't need to do that if there isn't a duration
+"RTN","C0CMED6",235,0)
+ . . I +$G(SIGDATA(4)) D
+"RTN","C0CMED6",236,0)
+ . . . N DURUNIT S DURUNIT=$E(SIGDATA(4),$L(SIGDATA(4))) ; get last char
+"RTN","C0CMED6",237,0)
+ . . . N DURTXT S DURTXT=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"Days")
+"RTN","C0CMED6",238,0)
+ . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=+SIGDATA(4)
+"RTN","C0CMED6",239,0)
+ . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=DURTXT
+"RTN","C0CMED6",240,0)
+ . . E  D
+"RTN","C0CMED6",241,0)
+ . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=""
+"RTN","C0CMED6",242,0)
+ . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
+"RTN","C0CMED6",243,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$G(SIGDATA(4))["PRN"
+"RTN","C0CMED6",244,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")="" ; when avail
+"RTN","C0CMED6",245,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
+"RTN","C0CMED6",246,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
+"RTN","C0CMED6",247,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
+"RTN","C0CMED6",248,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
+"RTN","C0CMED6",249,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
+"RTN","C0CMED6",250,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
+"RTN","C0CMED6",251,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; not stored
+"RTN","C0CMED6",252,0)
+ . . ; Another confusing line; I am pretty bad:
+"RTN","C0CMED6",253,0)
+ . . ; If there is another entry in the FMSIG array (i.e. another line
+"RTN","C0CMED6",254,0)
+ . . ; in the sig), set the direction count indicator.
+"RTN","C0CMED6",255,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=""  ; Default
+"RTN","C0CMED6",256,0)
+ . . S:+$O(FMSIG(FMSIGNUM)) @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRCNT
+"RTN","C0CMED6",257,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$G(SIGDATA(5))
+"RTN","C0CMED6",258,0)
  . ;
-"RTN","C0CMED6",163,0)
- . ; --- START OF DIRECTIONS ---
-"RTN","C0CMED6",164,0)
- . ; Sig data not in any API :-(  Oh yes, you can get the whole thing, but...
-"RTN","C0CMED6",165,0)
- . ; we want the components.
-"RTN","C0CMED6",166,0)
- . ; It's in multiple 113 in the Prescription File (52)
-"RTN","C0CMED6",167,0)
- . ; #.01 DOSAGE ORDERED [1F]    "20"
-"RTN","C0CMED6",168,0)
- . ; #1 DISPENSE UNITS PER DOSE [2N]  "1"
-"RTN","C0CMED6",169,0)
- . ; #2 UNITS [3P:50.607]     "MG"
-"RTN","C0CMED6",170,0)
- . ; #3 NOUN [4F]      "TABLET"
-"RTN","C0CMED6",171,0)
- . ; #4 DURATION [5F]      "10D"
-"RTN","C0CMED6",172,0)
- . ; #5 CONJUNCTION [6S]     "AND"
-"RTN","C0CMED6",173,0)
- . ; #6 ROUTE [7P:51.2]     "ORAL"
-"RTN","C0CMED6",174,0)
- . ; #7 SCHEDULE [8F]      "BID"
-"RTN","C0CMED6",175,0)
- . ; #8 VERB [9F]       "TAKE"
-"RTN","C0CMED6",176,0)
- . ;
-"RTN","C0CMED6",177,0)
- . ; Will use GETS^DIQ to get fields.
-"RTN","C0CMED6",178,0)
- . ; Data comes out like this:
-"RTN","C0CMED6",179,0)
- . ; SAMINS(52.0113,"1,23,",.01)=20
-"RTN","C0CMED6",180,0)
- . ; SAMINS(52.0113,"1,23,",1)=1
-"RTN","C0CMED6",181,0)
- . ; SAMINS(52.0113,"1,23,",2)="MG"
-"RTN","C0CMED6",182,0)
- . ; SAMINS(52.0113,"1,23,",3)="TABLET"
-"RTN","C0CMED6",183,0)
- . ; SAMINS(52.0113,"1,23,",4)="5D"
-"RTN","C0CMED6",184,0)
- . ; SAMINS(52.0113,"1,23,",5)="THEN"
-"RTN","C0CMED6",185,0)
- . ;
-"RTN","C0CMED6",186,0)
- . N RAWDATA
-"RTN","C0CMED6",187,0)
- . D GETS^DIQ(52,RXIEN,"113*",,"RAWDATA","DIERR")
-"RTN","C0CMED6",188,0)
- . D:$D(DIERR) ^%ZTER  ; Log if there's an error in retrieving sig field
-"RTN","C0CMED6",189,0)
- . ; none the less, continue; some parts are retrievable.
-"RTN","C0CMED6",190,0)
- . N FMSIG M FMSIG=RAWDATA(52.0113) ; Merge into subfile...
-"RTN","C0CMED6",191,0)
- . K RAWDATA
-"RTN","C0CMED6",192,0)
- . N FMSIGNUM S FMSIGNUM="" ; Sigline number in fileman.
-"RTN","C0CMED6",193,0)
- . ; FMSIGNUM gets outputted as "IEN,RXIEN,".
-"RTN","C0CMED6",194,0)
- . ; DIRCNT is the proper Sigline numer.
-"RTN","C0CMED6",195,0)
- . ; SIGDATA is the simplfied array. 
-"RTN","C0CMED6",196,0)
- . F  S FMSIGNUM=$O(FMSIG(FMSIGNUM)) Q:FMSIGNUM=""  D
-"RTN","C0CMED6",197,0)
- . . N DIRCNT S DIRCNT=$P(FMSIGNUM,",")
-"RTN","C0CMED6",198,0)
- . . N SIGDATA M SIGDATA=FMSIG(FMSIGNUM)
-"RTN","C0CMED6",199,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
-"RTN","C0CMED6",200,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
-"RTN","C0CMED6",201,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$G(SIGDATA(8))
-"RTN","C0CMED6",202,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$G(SIGDATA(.01))
-"RTN","C0CMED6",203,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=$G(SIGDATA(2))
-"RTN","C0CMED6",204,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
-"RTN","C0CMED6",205,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
-"RTN","C0CMED6",206,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
-"RTN","C0CMED6",207,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$G(SIGDATA(6))
-"RTN","C0CMED6",208,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$G(SIGDATA(7))
-"RTN","C0CMED6",209,0)
- . . ; Invervals... again another call.
-"RTN","C0CMED6",210,0)
- . . ; In the wisdom of the original programmers, the schedule is a free text field
-"RTN","C0CMED6",211,0)
- . . ; However, it gets translated by a call to the administration schedule file
-"RTN","C0CMED6",212,0)
- . . ; to see if that schedule exists.
-"RTN","C0CMED6",213,0)
- . . ; That's the same thing I am going to do.
-"RTN","C0CMED6",214,0)
- . . ; Search B index of 51.1 (Admin Schedule) with schedule
-"RTN","C0CMED6",215,0)
- . . ; First, remove "PRN" if it exists (don't ask, that's how the file
-"RTN","C0CMED6",216,0)
- . . ; works; I wouldn't do it that way).
-"RTN","C0CMED6",217,0)
- . . N SCHNOPRN S SCHNOPRN=$G(SIGDATA(7))
-"RTN","C0CMED6",218,0)
- . . I SCHNOPRN["PRN" S SCHNOPRN=$E(SCHNOPRN,1,$F(SCHNOPRN,"PRN")-5)
-"RTN","C0CMED6",219,0)
- . . ; Super call below:
-"RTN","C0CMED6",220,0)
- . . ; 1=File 51.1 3=Field 2 (Frequency in Minutes)
-"RTN","C0CMED6",221,0)
- . . ; 4=Packed format, Exact Match 5=Lookup Value
-"RTN","C0CMED6",222,0)
- . . ; 6=# of entries to return 7=Index 10=Return Array
-"RTN","C0CMED6",223,0)
- . . ; 
-"RTN","C0CMED6",224,0)
- . . ; I do not account for the fact that two schedules can be
-"RTN","C0CMED6",225,0)
- . . ; spelled identically (ie duplicate entry). In that case,
-"RTN","C0CMED6",226,0)
- . . ; I get the first. That's just a bad pharmacy pkg maintainer.
-"RTN","C0CMED6",227,0)
- . . N C0C515
-"RTN","C0CMED6",228,0)
- . . D FIND^DIC(51.1,,"@;2","PX",SCHNOPRN,1,"B",,,"C0C515")
-"RTN","C0CMED6",229,0)
- . . N INTERVAL S INTERVAL="" ; Default
-"RTN","C0CMED6",230,0)
- . . ; If there are entries found, get it
-"RTN","C0CMED6",231,0)
- . . I +$G(C0C515("DILIST",0)) S INTERVAL=$P(C0C515("DILIST",1,0),U,2) 
-"RTN","C0CMED6",232,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
-"RTN","C0CMED6",233,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
-"RTN","C0CMED6",234,0)
- . . ; Duration is 10M minutes, 10H hours, 10D for Days
-"RTN","C0CMED6",235,0)
- . . ; 10W for weeks, 10L for months. I smell $Select
-"RTN","C0CMED6",236,0)
- . . ; But we don't need to do that if there isn't a duration
-"RTN","C0CMED6",237,0)
- . . I +$G(SIGDATA(4)) D
-"RTN","C0CMED6",238,0)
- . . . N DURUNIT S DURUNIT=$E(SIGDATA(4),$L(SIGDATA(4))) ; get last char
-"RTN","C0CMED6",239,0)
- . . . N DURTXT S DURTXT=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"Days")
-"RTN","C0CMED6",240,0)
- . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=+SIGDATA(4)
-"RTN","C0CMED6",241,0)
- . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=DURTXT
-"RTN","C0CMED6",242,0)
- . . E  D
-"RTN","C0CMED6",243,0)
- . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=""
-"RTN","C0CMED6",244,0)
- . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
-"RTN","C0CMED6",245,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$G(SIGDATA(4))["PRN"
-"RTN","C0CMED6",246,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")="" ; when avail
-"RTN","C0CMED6",247,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
-"RTN","C0CMED6",248,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
-"RTN","C0CMED6",249,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
-"RTN","C0CMED6",250,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
-"RTN","C0CMED6",251,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
-"RTN","C0CMED6",252,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
-"RTN","C0CMED6",253,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; not stored
-"RTN","C0CMED6",254,0)
- . . ; Another confusing line; I am pretty bad:
-"RTN","C0CMED6",255,0)
- . . ; If there is another entry in the FMSIG array (i.e. another line
-"RTN","C0CMED6",256,0)
- . . ; in the sig), set the direction count indicator.
-"RTN","C0CMED6",257,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=""  ; Default
-"RTN","C0CMED6",258,0)
- . . S:+$O(FMSIG(FMSIGNUM)) @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRCNT
 "RTN","C0CMED6",259,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$G(SIGDATA(5))
+ . ; --- END OF DIRECTIONS ---
 "RTN","C0CMED6",260,0)
  . ;
 "RTN","C0CMED6",261,0)
- . ; --- END OF DIRECTIONS ---
+ . ; Med instructions is a WP field, thus the acrobatics
 "RTN","C0CMED6",262,0)
+ . ; Notice buffer overflow protection set at 10,000 chars
+"RTN","C0CMED6",263,0)
+ . ; -- 1. Med Patient Instructions
+"RTN","C0CMED6",264,0)
+ . N MEDPTIN1 S MEDPTIN1=$$GET1^DIQ(52,RXIEN,115,,"MEDPTIN1")
+"RTN","C0CMED6",265,0)
+ . N MEDPTIN2,J  S (MEDPTIN2,J)=""
+"RTN","C0CMED6",266,0)
+ . I $L(MEDPTIN1) F  S J=$O(@MEDPTIN1@(J)) Q:J=""  Q:$L(MEDPTIN2)>10000  S MEDPTIN2=MEDPTIN2_@MEDPTIN1@(J)_" "
+"RTN","C0CMED6",267,0)
+ . S @MAP@("MEDPTINSTRUCTIONS")=MEDPTIN2
+"RTN","C0CMED6",268,0)
+ . K J
+"RTN","C0CMED6",269,0)
+ . ; -- 2. Med Provider Instructions
+"RTN","C0CMED6",270,0)
+ . N MEDPVIN1 S MEDPVIN1=$$GET1^DIQ(52,RXIEN,39,,"MEDPVIN1")
+"RTN","C0CMED6",271,0)
+ . N MEDPVIN2,J S (MEDPVIN2,J)=""
+"RTN","C0CMED6",272,0)
+ . I $L(MEDPVIN1) F  S J=$O(@MEDPVIN1@(J)) Q:J=""  Q:$L(MEDPVIN2)>10000  S MEDPVIN2=MEDPVIN2_@MEDPVIN1@(J)_" "
+"RTN","C0CMED6",273,0)
+ . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MEDPVIN2
+"RTN","C0CMED6",274,0)
  . ;
-"RTN","C0CMED6",263,0)
- . ; Med instructions is a WP field, thus the acrobatics
-"RTN","C0CMED6",264,0)
- . ; Notice buffer overflow protection set at 10,000 chars
-"RTN","C0CMED6",265,0)
- . ; -- 1. Med Patient Instructions
-"RTN","C0CMED6",266,0)
- . N MEDPTIN1 S MEDPTIN1=$$GET1^DIQ(52,RXIEN,115,,"MEDPTIN1")
-"RTN","C0CMED6",267,0)
- . N MEDPTIN2,J  S (MEDPTIN2,J)="" 
-"RTN","C0CMED6",268,0)
- . I $L(MEDPTIN1) F  S J=$O(@MEDPTIN1@(J)) Q:J=""  Q:$L(MEDPTIN2)>10000  S MEDPTIN2=MEDPTIN2_@MEDPTIN1@(J)_" "
-"RTN","C0CMED6",269,0)
- . S @MAP@("MEDPTINSTRUCTIONS")=MEDPTIN2
-"RTN","C0CMED6",270,0)
- . K J
-"RTN","C0CMED6",271,0)
- . ; -- 2. Med Provider Instructions
-"RTN","C0CMED6",272,0)
- . N MEDPVIN1 S MEDPVIN1=$$GET1^DIQ(52,RXIEN,39,,"MEDPVIN1")
-"RTN","C0CMED6",273,0)
- . N MEDPVIN2,J S (MEDPVIN2,J)=""
-"RTN","C0CMED6",274,0)
- . I $L(MEDPVIN1) F  S J=$O(@MEDPVIN1@(J)) Q:J=""  Q:$L(MEDPVIN2)>10000  S MEDPVIN2=MEDPVIN2_@MEDPVIN1@(J)_" "
 "RTN","C0CMED6",275,0)
- . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MEDPVIN2
+ . ; Remaining refills
 "RTN","C0CMED6",276,0)
+ . S @MAP@("MEDRFNO")=$P(MEDS(MEDCNT),U,6)
+"RTN","C0CMED6",277,0)
+ . ; ------ END OF MAPPING
+"RTN","C0CMED6",278,0)
  . ;
-"RTN","C0CMED6",277,0)
- . ; Remaining refills
-"RTN","C0CMED6",278,0)
- . S @MAP@("MEDRFNO")=$P(MEDS(MEDCNT),U,6)
 "RTN","C0CMED6",279,0)
- . ; ------ END OF MAPPING
+ . ; ------ BEGIN XML INSERTION
 "RTN","C0CMED6",280,0)
- . ;
+ . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
 "RTN","C0CMED6",281,0)
- . ; ------ BEGIN XML INSERTION
+ . K @RESULT
 "RTN","C0CMED6",282,0)
- . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
+ . D MAP^C0CXPATH(MINXML,MAP,RESULT)
 "RTN","C0CMED6",283,0)
- . K @RESULT
+ . ; D PARY^C0CXPATH(RESULT)
 "RTN","C0CMED6",284,0)
- . D MAP^C0CXPATH(MINXML,MAP,RESULT)
+ . ; MAPPING DIRECTIONS
 "RTN","C0CMED6",285,0)
- . ; D PARY^C0CXPATH(RESULT)
+ . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
 "RTN","C0CMED6",286,0)
- . ; MAPPING DIRECTIONS
+ . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
 "RTN","C0CMED6",287,0)
- . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
+ . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
 "RTN","C0CMED6",288,0)
- . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
+ . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
 "RTN","C0CMED6",289,0)
- . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
+ . ; N MDZ1,MDZNA
 "RTN","C0CMED6",290,0)
- . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
+ . N DIRCNT S DIRCNT=""
 "RTN","C0CMED6",291,0)
- . ; N MDZ1,MDZNA
+ . I +$O(@MAP@("M","DIRECTIONS",DIRCNT)) D  ; IF THERE ARE DIRCTIONS
 "RTN","C0CMED6",292,0)
- . N DIRCNT S DIRCNT=""
+ . . F DIRCNT=$O(@MAP@("M","DIRECTIONS",DIRCNT)) D  ; FOR EACH DIRECTION
 "RTN","C0CMED6",293,0)
- . I +$O(@MAP@("M","DIRECTIONS",DIRCNT)) D  ; IF THERE ARE DIRCTIONS
+ . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",DIRCNT))
 "RTN","C0CMED6",294,0)
- . . F DIRCNT=$O(@MAP@("M","DIRECTIONS",DIRCNT)) D  ; FOR EACH DIRECTION
+ . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
 "RTN","C0CMED6",295,0)
- . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",DIRCNT))
+ . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
 "RTN","C0CMED6",296,0)
- . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
+ . D:MEDCNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
 "RTN","C0CMED6",297,0)
- . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
+ . D:MEDCNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
 "RTN","C0CMED6",298,0)
- . D:MEDCNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
+ . S MEDCOUNT=MEDCNT
 "RTN","C0CMED6",299,0)
- . D:MEDCNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
+ N MEDTMP,MEDI
 "RTN","C0CMED6",300,0)
- . S MEDCOUNT=MEDCNT
+ D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
 "RTN","C0CMED6",301,0)
- N MEDTMP,MEDI
+ I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
 "RTN","C0CMED6",302,0)
- D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+ . W "MEDICATION MISSING ",!
 "RTN","C0CMED6",303,0)
- I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+ . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
 "RTN","C0CMED6",304,0)
- . W "MEDICATION MISSING ",!
+ Q
 "RTN","C0CMED6",305,0)
- . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
+ ;
 "RTN","C0CMED6",306,0)
- Q
+GETRXN(NDC) ; Extrinsic Function; PUBLIC; NDC to RxNorm
 "RTN","C0CMED6",307,0)
- ;
+ ;; Get RxNorm Concept Number for a Given NDC
 "RTN","C0CMED6",308,0)
-GETRXN(NDC) ; Extrinsic Function; PUBLIC; NDC to RxNorm
+ ;
 "RTN","C0CMED6",309,0)
- ;; Get RxNorm Concept Number for a Given NDC
+ S NDC=$TR(NDC,"-")  ; Remove dashes
 "RTN","C0CMED6",310,0)
- ;
+ N RXNORM,C0CZRXN,DIERR
 "RTN","C0CMED6",311,0)
- S NDC=$TR(NDC,"-")  ; Remove dashes
+ D FIND^DIC(176.002,,"@;.01","PX",NDC,"*","NDC",,,"C0CZRXN","DIERR")
 "RTN","C0CMED6",312,0)
- N RXNORM,C0CZRXN,DIERR
+ I $D(DIERR) S $EC=",U1,"
 "RTN","C0CMED6",313,0)
- D FIND^DIC(176.002,,"@;.01","PX",NDC,"*","NDC",,,"C0CZRXN","DIERR")
+ S RXNORM(0)=+C0CZRXN("DILIST",0) ; RxNorm(0) will be # of entries
 "RTN","C0CMED6",314,0)
- I $D(DIERR) D ^%ZTER BREAK
+ N I S I=0
 "RTN","C0CMED6",315,0)
- S RXNORM(0)=+C0CZRXN("DILIST",0) ; RxNorm(0) will be # of entries
+ F  S I=$O(C0CZRXN("DILIST",I)) Q:I=""  S RXNORM(I)=$P(C0CZRXN("DILIST",I,0),U,2)
 "RTN","C0CMED6",316,0)
- N I S I=0
+ ; At this point, RxNorm(0) is # of entries; RxNorm(1...) are the entries
 "RTN","C0CMED6",317,0)
- F  S I=$O(C0CZRXN("DILIST",I)) Q:I=""  S RXNORM(I)=$P(C0CZRXN("DILIST",I,0),U,2)
+ ; If RxNorm(0) is 1, then we only have one entry, and that's it.
 "RTN","C0CMED6",318,0)
- ; At this point, RxNorm(0) is # of entries; RxNorm(1...) are the entries
+ I RXNORM(0)=1 QUIT RXNORM(1)  ; RETURN RXNORM(1)
 "RTN","C0CMED6",319,0)
- ; If RxNorm(0) is 1, then we only have one entry, and that's it.
+ ; Otherwise, we need to find out which one is the semantic
 "RTN","C0CMED6",320,0)
- I RXNORM(0)=1 QUIT RXNORM(1)  ; RETURN RXNORM(1)
+ ; clinical drug. I built an index on 176.001 (RxNorm Concepts)
 "RTN","C0CMED6",321,0)
- ; Otherwise, we need to find out which one is the semantic
+ ; for that purpose.
 "RTN","C0CMED6",322,0)
- ; clinical drug. I built an index on 176.001 (RxNorm Concepts)
+ I RXNORM(0)>1 D
 "RTN","C0CMED6",323,0)
- ; for that purpose.
+ . S I=0
 "RTN","C0CMED6",324,0)
- I RXNORM(0)>1 D
+ . F  S I=$O(RXNORM(I)) Q:I=""  D  Q:$G(RXNORM)
 "RTN","C0CMED6",325,0)
- . S I=0
+ . . N RXNIEN S RXNIEN=$$FIND1^DIC(176.001,,,RXNORM(I),"SCD")
 "RTN","C0CMED6",326,0)
- . F  S I=$O(RXNORM(I)) Q:I=""  D  Q:$G(RXNORM)
+ . . I +$G(RXNIEN)=0 QUIT  ; try the next entry... 
 "RTN","C0CMED6",327,0)
- . . N RXNIEN S RXNIEN=$$FIND1^DIC(176.001,,,RXNORM(I),"SCD")
+ . . E  S RXNORM=RXNORM(I) QUIT  ; We found the right code
 "RTN","C0CMED6",328,0)
- . . I +$G(RXNIEN)=0 QUIT  ; try the next entry... 
-"RTN","C0CMED6",329,0)
- . . E  S RXNORM=RXNORM(I) QUIT  ; We found the right code
-"RTN","C0CMED6",330,0)
  QUIT +$G(RXNORM)  ; RETURN RXNORM; if we couldn't find a clnical drug, return with 0
-"RTN","C0CMED6",331,0)
- 
 "RTN","C0CMIME")
-0^86^B99031395
+0^86^B97918768
 "RTN","C0CMIME",1,0)
 C0CMIME ; CCDCCR/GPL - MIME manipulation utilities; 3/8/11 ; 5/16/11 2:32pm
 "RTN","C0CMIME",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CMIME",3,0)
- ;Copyright 2008 George Lilly.  Licensed under the terms of the GNU
+ ;Copyright 2008 George Lilly.  
 "RTN","C0CMIME",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CMIME",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CMIME",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CMIME",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CMIME",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CMIME",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CMIME",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CMIME",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CMIME",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CMIME",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CMIME",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CMIME",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CMIME",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CMIME",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CMIME",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ Q
 "RTN","C0CMIME",19,0)
  ;
 "RTN","C0CMIME",20,0)
+TEST(ZDFN) ;
+"RTN","C0CMIME",21,0)
+ D CCRRPC^C0CCCR(.ZCCR,ZDFN) ; GET A CCR TO WORK WITH
+"RTN","C0CMIME",22,0)
+ ;M ZCOPY=ZCCR
+"RTN","C0CMIME",23,0)
+ S ZCOPY(1)=""
+"RTN","C0CMIME",24,0)
+ N ZI S ZI=0
+"RTN","C0CMIME",25,0)
+ F  S ZI=$O(ZCCR(ZI)) Q:ZI=""  D  ; FOR EACH LINE
+"RTN","C0CMIME",26,0)
+ . S ZCOPY(1)=ZCOPY(1)_ZCCR(ZI)
+"RTN","C0CMIME",27,0)
+ ;D ENCODE("ZCOPY",1,ZCOPY(1))
+"RTN","C0CMIME",28,0)
+ S G(1)=$$ENCODE^RGUTUU(ZCOPY(1))
+"RTN","C0CMIME",29,0)
+ D CHUNK("G2","G",45)
+"RTN","C0CMIME",30,0)
  Q
-"RTN","C0CMIME",21,0)
- ;
-"RTN","C0CMIME",22,0)
-TEST(ZDFN) ;
-"RTN","C0CMIME",23,0)
- D CCRRPC^C0CCCR(.ZCCR,ZDFN) ; GET A CCR TO WORK WITH
-"RTN","C0CMIME",24,0)
- ;M ZCOPY=ZCCR
-"RTN","C0CMIME",25,0)
+"RTN","C0CMIME",31,0)
+ENCODE(ZRTN,ZARY) ;
+"RTN","C0CMIME",32,0)
+ ; ROUTINE TO ENCODE AN XML DOCUMENT FOR SENDING
+"RTN","C0CMIME",33,0)
+ ; ZARY IS PASSED BY NAME
+"RTN","C0CMIME",34,0)
+ ; ZRTN IS PASSED BY REFERENCE AND IS THE RETURN
+"RTN","C0CMIME",35,0)
+ ;
+"RTN","C0CMIME",36,0)
  S ZCOPY(1)=""
-"RTN","C0CMIME",26,0)
+"RTN","C0CMIME",37,0)
  N ZI S ZI=0
-"RTN","C0CMIME",27,0)
- F  S ZI=$O(ZCCR(ZI)) Q:ZI=""  D  ; FOR EACH LINE
-"RTN","C0CMIME",28,0)
- . S ZCOPY(1)=ZCOPY(1)_ZCCR(ZI)
-"RTN","C0CMIME",29,0)
- ;D ENCODE("ZCOPY",1,ZCOPY(1))
-"RTN","C0CMIME",30,0)
+"RTN","C0CMIME",38,0)
+ F  S ZI=$O(@ZARY@(ZI)) Q:ZI=""  D  ; FOR EACH LINE
+"RTN","C0CMIME",39,0)
+ . S ZCOPY(1)=ZCOPY(1)_@ZARY@(ZI)
+"RTN","C0CMIME",40,0)
+ N G
+"RTN","C0CMIME",41,0)
  S G(1)=$$ENCODE^RGUTUU(ZCOPY(1))
-"RTN","C0CMIME",31,0)
- D CHUNK("G2","G",45)
-"RTN","C0CMIME",32,0)
+"RTN","C0CMIME",42,0)
+ D CHUNK(ZRTN,"G",45)
+"RTN","C0CMIME",43,0)
  Q
-"RTN","C0CMIME",33,0)
-ENCODE(ZRTN,ZARY) ;
-"RTN","C0CMIME",34,0)
- ; ROUTINE TO ENCODE AN XML DOCUMENT FOR SENDING
-"RTN","C0CMIME",35,0)
- ; ZARY IS PASSED BY NAME
-"RTN","C0CMIME",36,0)
- ; ZRTN IS PASSED BY REFERENCE AND IS THE RETURN
-"RTN","C0CMIME",37,0)
- ;
-"RTN","C0CMIME",38,0)
- S ZCOPY(1)=""
-"RTN","C0CMIME",39,0)
+"RTN","C0CMIME",44,0)
+ ; THIS ROUTINE WAS COPIED FROM LRSRVR4 AND THEN MODIFIED . THANKS JOHN
+"RTN","C0CMIME",45,0)
+ENCODEO(IARY,LRNODE,LRSTR) ; Encode a string, keep remainder for next line
+"RTN","C0CMIME",46,0)
+ ; Call with LRSTR by reference, Remainder returned in LRSTR
+"RTN","C0CMIME",47,0)
+ ; IARY IS PASSED BY NAME
+"RTN","C0CMIME",48,0)
+ S LRQUIT=0,LRLEN=$L(LRSTR)
+"RTN","C0CMIME",49,0)
+ F  D  Q:LRQUIT
+"RTN","C0CMIME",50,0)
+ . I $L(LRSTR)<45 S LRQUIT=1 Q
+"RTN","C0CMIME",51,0)
+ . S LRX=$E(LRSTR,1,45)
+"RTN","C0CMIME",52,0)
+ . S LRNODE=LRNODE+1,@IARY@(LRNODE)=$$UUEN^LRSRVR4(LRX)
+"RTN","C0CMIME",53,0)
+ . S LRSTR=$E(LRSTR,46,LRLEN)
+"RTN","C0CMIME",54,0)
+ Q
+"RTN","C0CMIME",55,0)
+ ;
+"RTN","C0CMIME",56,0)
+TESTMAIL ;
+"RTN","C0CMIME",57,0)
+ ; TEST OF MAILSEND
+"RTN","C0CMIME",58,0)
+ ;S ZTO("glilly@glilly.net")=""
+"RTN","C0CMIME",59,0)
+ S ZTO("mish@nhin.openforum.opensourcevista.net")=""
+"RTN","C0CMIME",60,0)
+ ;S ZTO("martijn@djigzo.com")=""
+"RTN","C0CMIME",61,0)
+ ;S ZTO("profmish@gmail.com")=""
+"RTN","C0CMIME",62,0)
+ ;S ZTO("nanthracite@earthlink.net")=""
+"RTN","C0CMIME",63,0)
+ S ZFROM="ANTHRACITE.NANCY"
+"RTN","C0CMIME",64,0)
+ S ZATTACH=$NA(^GPL("CCR"))
+"RTN","C0CMIME",65,0)
+ I $G(@ZATTACH@(1))="" D  ; NO CCR THERE
+"RTN","C0CMIME",66,0)
+ . D CCRRPC^C0CCCR(.GPL,2) ; GET ONE FROM PATIENT 2
+"RTN","C0CMIME",67,0)
+ . M @ZATTACH=GPL ; PUT IT IN THERE FOR NEXT TIME
+"RTN","C0CMIME",68,0)
+ S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE"
+"RTN","C0CMIME",69,0)
+ D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,,ZATTACH)
+"RTN","C0CMIME",70,0)
+ ; ZWR GR
+"RTN","C0CMIME",71,0)
+ Q
+"RTN","C0CMIME",72,0)
+ ;
+"RTN","C0CMIME",73,0)
+TESTMAI2 ;
+"RTN","C0CMIME",74,0)
+ ; TEST OF MAILSEND TO gpl.mdc-crew.net
+"RTN","C0CMIME",75,0)
+ N C0CGM
+"RTN","C0CMIME",76,0)
+ S C0CGM(1)="This is a test message."
+"RTN","C0CMIME",77,0)
+ S C0CGM(2)="A Continuity of Care record is attached"
+"RTN","C0CMIME",78,0)
+ S C0CGM(3)="It contains no Protected Health Information (PHI)"
+"RTN","C0CMIME",79,0)
+ S C0CGM(4)="It is purely test data used for software development"
+"RTN","C0CMIME",80,0)
+ S C0CGM(5)="It does not represent information about any person living or dead"
+"RTN","C0CMIME",81,0)
+ ;S ZTO("glilly@glilly.net")=""
+"RTN","C0CMIME",82,0)
+ ;S ZTO("george.lilly@pobox.com")=""
+"RTN","C0CMIME",83,0)
+ ;S ZTO("george@nhin.openforum.opensourcevista.net")=""
+"RTN","C0CMIME",84,0)
+ ;S ZTO("mish@nhin.openforum.opensourcevista.net")="" 
+"RTN","C0CMIME",85,0)
+ S ZTO("brooks.richard@securemail.opensourcevista.net")=""
+"RTN","C0CMIME",86,0)
+ ;S ZTO("LILLY.GEORGE@mdc-crew.net")=""
+"RTN","C0CMIME",87,0)
+ ;S ZTO("ncoal@live.com")=""
+"RTN","C0CMIME",88,0)
+ ;S ZTO("martijn@djigzo.com")=""
+"RTN","C0CMIME",89,0)
+ ;S ZTO("profmish@gmail.com")=""
+"RTN","C0CMIME",90,0)
+ ;S ZTO("nanthracite@earthlink.net")=""
+"RTN","C0CMIME",91,0)
+ S ZTO("gpl.doctortest@gmail.com")=""
+"RTN","C0CMIME",92,0)
+ S ZFROM="LILLY.GEORGE"
+"RTN","C0CMIME",93,0)
+ S ZATTACH=$NA(^GPL("CCR"))
+"RTN","C0CMIME",94,0)
+ I $G(@ZATTACH@(1))="" D  ; NO CCR THERE
+"RTN","C0CMIME",95,0)
+ . D CCRRPC^C0CCCR(.GPL,2) ; GET ONE FROM PATIENT 2
+"RTN","C0CMIME",96,0)
+ . M @ZATTACH=GPL ; PUT IT IN THERE FOR NEXT TIME
+"RTN","C0CMIME",97,0)
+ S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE"
+"RTN","C0CMIME",98,0)
+ D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,"C0CGM",ZATTACH,"CCR.xml")
+"RTN","C0CMIME",99,0)
+ ; ZWR GR
+"RTN","C0CMIME",100,0)
+ Q
+"RTN","C0CMIME",101,0)
+ ;
+"RTN","C0CMIME",102,0)
+LINE(C0CFILE,C0CTO) ; read a file name passed in C0CFILE and send it to
+"RTN","C0CMIME",103,0)
+ ; the email address in C0CTO 
+"RTN","C0CMIME",104,0)
+ ; the directory and the "from" are all hard coded
+"RTN","C0CMIME",105,0)
+ ;
+"RTN","C0CMIME",106,0)
+ N ZZFROM S ZZFROM="LILLY.GEORGE"
+"RTN","C0CMIME",107,0)
+ N GN S GN=$NA(^TMP("C0CMIME2",$J))
+"RTN","C0CMIME",108,0)
+ N GN1 S GN1=$NA(@GN@(1))
+"RTN","C0CMIME",109,0)
+ K @GN
+"RTN","C0CMIME",110,0)
+ I '$D(C0CFILE) Q  ; NO FILENAME PASSED
+"RTN","C0CMIME",111,0)
+ I '$D(C0CTO) S C0CTO="brooks.richard@securemail.opensourcevista.net"
+"RTN","C0CMIME",112,0)
+ S ZZTO(C0CTO)=""
+"RTN","C0CMIME",113,0)
+ N ZMESS S ZMESS(1)="file transmission from wvehr3-09"
+"RTN","C0CMIME",114,0)
+ N GD S GD="/home/wvehr3-09/EHR/" ; directory
+"RTN","C0CMIME",115,0)
+ I '$$FTG^%ZISH(GD,C0CFILE,GN1,3) Q  D  ;
+"RTN","C0CMIME",116,0)
+ . W !,"error reading file",C0CFILE
+"RTN","C0CMIME",117,0)
+ D MAILSEND(.ZRTN,ZZFROM,"ZZTO",,"file transmission","ZMESS",GN,C0CFILE)
+"RTN","C0CMIME",118,0)
+ K @GN ; CLEAN UP
+"RTN","C0CMIME",119,0)
+ ;ZWR ZRTN
+"RTN","C0CMIME",120,0)
+ W !,$G(ZRTN(1))
+"RTN","C0CMIME",121,0)
+ Q
+"RTN","C0CMIME",122,0)
+ ;
+"RTN","C0CMIME",123,0)
+MAILSEND(RTN,FROM,TO,CC,SUBJECT,MESSAGE,ATTACH,FNAME,FLAGS) ; MAIL SENDING INTERFACE
+"RTN","C0CMIME",124,0)
+ ; RTN IS THE RETURN ARRAY PASSED BY REFERENCE
+"RTN","C0CMIME",125,0)
+ ; FROM IS PASSED BY VALUE AND IS THE EMAIL ADDRESS OF THE SENDER
+"RTN","C0CMIME",126,0)
+ ;  IF NULL, WILL SEND FROM THE CURRENT DUZ
+"RTN","C0CMIME",127,0)
+ ; TO AND CC ARE RECIEPIENT EMAIL ADDRESSES PASSED BY NAME
+"RTN","C0CMIME",128,0)
+ ;  @TO@("addr1@domain1.net") 
+"RTN","C0CMIME",129,0)
+ ;  @CC@("addr2@domain2.com")  both can be multiples
+"RTN","C0CMIME",130,0)
+ ; SUBJECT IS PASSED BY VALUE AND WILL GO IN THE SUBJECT LINE
+"RTN","C0CMIME",131,0)
+ ; MESSAGE IS PASSED BY NAME AND IS AN ARRAY OF TEXT
+"RTN","C0CMIME",132,0)
+ ; ATTACH IS PASSED BY NAME AND IS AN XML OR HTML FILE TO BE ATTACHED
+"RTN","C0CMIME",133,0)
+ ; FNAME IS THE FILENAME OF THE ATTACHMENT, DEFAULT IS ccr.xml
+"RTN","C0CMIME",134,0)
+ ;
+"RTN","C0CMIME",135,0)
+ I '$D(FNAME) S FNAME="ccr.xml" ; default filename
+"RTN","C0CMIME",136,0)
+ N GN
+"RTN","C0CMIME",137,0)
+ S GN=$NA(^TMP($J,"C0CMIME"))
+"RTN","C0CMIME",138,0)
+ K @GN
+"RTN","C0CMIME",139,0)
+ S GM(1)="MIME-Version: 1.0"
+"RTN","C0CMIME",140,0)
+ S GM(2)="Content-Type: multipart/mixed; boudary=""1234567"""
+"RTN","C0CMIME",141,0)
+ S GM(3)=""
+"RTN","C0CMIME",142,0)
+ S GM(4)=""
+"RTN","C0CMIME",143,0)
+ ;S GM(5)="--123456788888"
+"RTN","C0CMIME",144,0)
+ ;S GM(5)=$$REPEAT^XLFSTR("-",$L(X))
+"RTN","C0CMIME",145,0)
+ S GM(5)="--123456899999"
+"RTN","C0CMIME",146,0)
+ S GM(6)="Content-Type: text/xml; name="_FNAME
+"RTN","C0CMIME",147,0)
+ S GM(7)="Content-Transfer-Encoding: base64"
+"RTN","C0CMIME",148,0)
+ S GM(8)="Content-Disposition: attachment; filename="_FNAME
+"RTN","C0CMIME",149,0)
+ S GM(9)=""
+"RTN","C0CMIME",150,0)
+ S GM(10)="" ; FOR THE END
+"RTN","C0CMIME",151,0)
+ ;S GM(11)="--123456788888--"
+"RTN","C0CMIME",152,0)
+ S GM(11)="--123456899999--"
+"RTN","C0CMIME",153,0)
+ S GM(12)=""
+"RTN","C0CMIME",154,0)
+ S GM(13)=""
+"RTN","C0CMIME",155,0)
+ S GG(1)="--123456899999"
+"RTN","C0CMIME",156,0)
+ S GG(2)="Content-Type: text/plain; charset=ISO-8859-1; format=flowed"
+"RTN","C0CMIME",157,0)
+ S GG(3)="Content-Transfer-Encoding: 7bit"
+"RTN","C0CMIME",158,0)
+ S GG(4)=""
+"RTN","C0CMIME",159,0)
+ S GG(5)="This is a test message."
+"RTN","C0CMIME",160,0)
+ S GG(6)="A Continuity of Care record is attached"
+"RTN","C0CMIME",161,0)
+ S GG(7)="It contains no Protected Health Information (PHI)"
+"RTN","C0CMIME",162,0)
+ S GG(8)="It is purely test data used for software development"
+"RTN","C0CMIME",163,0)
+ S GG(9)="It does not represent information about any person living or dead"
+"RTN","C0CMIME",164,0)
+ S GG(10)=""
+"RTN","C0CMIME",165,0)
+ S GG(11)="--123456899999--"
+"RTN","C0CMIME",166,0)
+ ;S GG(11)="Content-Type: text/plain; charset=""us-ascii"""
+"RTN","C0CMIME",167,0)
+ S GG(12)=""
+"RTN","C0CMIME",168,0)
+ ;S GG(13)="This is a test message."
+"RTN","C0CMIME",169,0)
+ S GG(14)="A Continuity of Care record is attached"
+"RTN","C0CMIME",170,0)
+ S GG(15)="It contains no Protected Health Information (PHI)"
+"RTN","C0CMIME",171,0)
+ S GG(16)="It is purely test data used for software development"
+"RTN","C0CMIME",172,0)
+ S GG(17)="It does not represent information about any person living or dead"
+"RTN","C0CMIME",173,0)
+ S GG(18)=""
+"RTN","C0CMIME",174,0)
+ S GG(19)="--123456899999"
+"RTN","C0CMIME",175,0)
+ S GG(20)="--987654321--"
+"RTN","C0CMIME",176,0)
+ K GBLD
+"RTN","C0CMIME",177,0)
+ ;D QUEUE^C0CXPATH("GBLD","GGG",1,3) ; THE MESSAGE
+"RTN","C0CMIME",178,0)
+ ;D QUEUE^C0CXPATH("GBLD","GG",1,10) ; THE MESSAGE
+"RTN","C0CMIME",179,0)
+ I $D(MESSAGE)'="" D  ; THERE IS A MESSAGE
+"RTN","C0CMIME",180,0)
+ . D QUEUE^C0CXPATH("GBLD","GG",1,4) ; THE MIME BOUNDARY
+"RTN","C0CMIME",181,0)
+ . D QUEUE^C0CXPATH("GBLD",MESSAGE,1,$O(@MESSAGE@(""),-1)) ;THE MESSAGE
+"RTN","C0CMIME",182,0)
+ . D QUEUE^C0CXPATH("GBLD","GG",10,10) ;A BLANK LINE
+"RTN","C0CMIME",183,0)
+ D QUEUE^C0CXPATH("GBLD","GM",5,9)
+"RTN","C0CMIME",184,0)
+ I $D(ATTACH)'="" D  ; IF WE HAVE AN ATTACHMENT
+"RTN","C0CMIME",185,0)
+ . D ENCODE("G2",ATTACH) ; ENCODE FOR SENDING
+"RTN","C0CMIME",186,0)
+ . D QUEUE^C0CXPATH("GBLD","G2",1,$O(G2(""),-1))
+"RTN","C0CMIME",187,0)
+ D QUEUE^C0CXPATH("GBLD","GM",11,12)
+"RTN","C0CMIME",188,0)
+ D BUILD^C0CXPATH("GBLD",GN)
+"RTN","C0CMIME",189,0)
+ ;S GGG=$NA(^GPL("MIME2"))
+"RTN","C0CMIME",190,0)
+ K @GN@(0) ; KILL THE LINE COUNT
+"RTN","C0CMIME",191,0)
+ K LRINSTR,LRTASK,LRTO,XMERR,XMZ
+"RTN","C0CMIME",192,0)
+ M LRTO=@TO
+"RTN","C0CMIME",193,0)
+ I $D(CC) M LRTO=@CC
+"RTN","C0CMIME",194,0)
+ S LRINSTR("ADDR FLAGS")="R"
+"RTN","C0CMIME",195,0)
+ S LRINSTR("FROM")=$G(FROM)
+"RTN","C0CMIME",196,0)
+ S LRMSUBJ=$G(SUBJECT)
+"RTN","C0CMIME",197,0)
+ S LRMSUBJ=$E(LRMSUBJ,1,65)
+"RTN","C0CMIME",198,0)
+ D SENDMSG^XMXAPI(DUZ,LRMSUBJ,GN,.LRTO,.LRINSTR,.LRTASK)
+"RTN","C0CMIME",199,0)
+ I $G(XMERR)=1 S RTN(1)="ERROR SENDING MESSAGE" Q  ;
+"RTN","C0CMIME",200,0)
+ S RTN(1)="OK"
+"RTN","C0CMIME",201,0)
+ Q
+"RTN","C0CMIME",202,0)
+ ;
+"RTN","C0CMIME",203,0)
+MAILSEN0(LRMSUBJ) ; Send extract back to requestor.
+"RTN","C0CMIME",204,0)
+ ;
+"RTN","C0CMIME",205,0)
+ ;D TEST
+"RTN","C0CMIME",206,0)
+ S GN=$NA(^TMP($J,"C0CMIME"))
+"RTN","C0CMIME",207,0)
+ K @GN
+"RTN","C0CMIME",208,0)
+ ;M @GN=G2
+"RTN","C0CMIME",209,0)
+ S GM(1)="MIME-Version: 1.0"
+"RTN","C0CMIME",210,0)
+ S GM(2)="Content-Type: multipart/mixed; boudary=""1234567"""
+"RTN","C0CMIME",211,0)
+ S GM(3)=""
+"RTN","C0CMIME",212,0)
+ S GM(4)=""
+"RTN","C0CMIME",213,0)
+ S GM(5)="--1234567"
+"RTN","C0CMIME",214,0)
+ ;S GM(5)=$$REPEAT^XLFSTR("-",$L(X))
+"RTN","C0CMIME",215,0)
+ S GM(6)="Content-Type: text/xml; name=""ccr.xml"""
+"RTN","C0CMIME",216,0)
+ S GM(7)="Content-Transfer-Encoding: base64"
+"RTN","C0CMIME",217,0)
+ S GM(8)="Content-Disposition: attachment; filename=""ccr.xml"""
+"RTN","C0CMIME",218,0)
+ ;S GM(6)=$$UUBEGFN^LRSRVR2A("CCR.xml")
+"RTN","C0CMIME",219,0)
+ S GM(9)=""
+"RTN","C0CMIME",220,0)
+ S GM(10)="" ; FOR THE END
+"RTN","C0CMIME",221,0)
+ S GM(11)="--frontier--"
+"RTN","C0CMIME",222,0)
+ S GM(12)="."
+"RTN","C0CMIME",223,0)
+ S GM(13)=""
+"RTN","C0CMIME",224,0)
+ K GBLD
+"RTN","C0CMIME",225,0)
+ ;D QUEUE^C0CXPATH("GBLD","GM",1,9)
+"RTN","C0CMIME",226,0)
+ ;D QUEUE^C0CXPATH("GBLD","G2",1,$O(G2(""),-1))
+"RTN","C0CMIME",227,0)
+ ;D QUEUE^C0CXPATH("GBLD","GM",10,13)
+"RTN","C0CMIME",228,0)
+ ;D BUILD^C0CXPATH("GBLD",GN)
+"RTN","C0CMIME",229,0)
+ S GGG=$NA(^GPL("MIME2"))
+"RTN","C0CMIME",230,0)
+ ;D QUEUE^C0CXPATH("GBLD","GM",1,1)
+"RTN","C0CMIME",231,0)
+ D QUEUE^C0CXPATH("GBLD",GGG,21,159)
+"RTN","C0CMIME",232,0)
+ D BUILD^C0CXPATH("GBLD",GN)
+"RTN","C0CMIME",233,0)
+ K @GN@(0) ; KILL THE LINE COUNT
+"RTN","C0CMIME",234,0)
+ K LRINSTR,LRTASK,LRTO,XMERR,XMZ
+"RTN","C0CMIME",235,0)
+ S XQSND="glilly@glilly.net"
+"RTN","C0CMIME",236,0)
+ ;S XQSND="nanthracite@earthlink.net"
+"RTN","C0CMIME",237,0)
+ ;S XQSND="dlefevre@orohosp.com"
+"RTN","C0CMIME",238,0)
+ ;S XQSND="gregwoodhouse@me.com"
+"RTN","C0CMIME",239,0)
+ ;S XQSND="rick.marshall@vistaexpertise.net"
+"RTN","C0CMIME",240,0)
+ S LRTO(XQSND)=""
+"RTN","C0CMIME",241,0)
+ S LRINSTR("ADDR FLAGS")="R"
+"RTN","C0CMIME",242,0)
+ S LRINSTR("FROM")="CCR_PACKAGE"
+"RTN","C0CMIME",243,0)
+ S LRMSUBJ="A SAMPLE CCR"
+"RTN","C0CMIME",244,0)
+ S LRMSUBJ=$E(LRMSUBJ,1,65)
+"RTN","C0CMIME",245,0)
+ D SENDMSG^XMXAPI(9,LRMSUBJ,GN,.LRTO,.LRINSTR,.LRTASK)
+"RTN","C0CMIME",246,0)
+ I $G(XMERR)=1 W !,"ERROR SENDING MESSAGE" Q  ;
+"RTN","C0CMIME",247,0)
+ ;S ^XMB(3.9,LRTASK,1,.1130590,0)="MIME-Version: 1.0"
+"RTN","C0CMIME",248,0)
+ ;S ^XMB(3.9,LRTASK,1,.1130591,0)="Content-type: multipart/mixed; boundary=000e0cd6ae026c3d4b049e7befe9"
+"RTN","C0CMIME",249,0)
+ Q
+"RTN","C0CMIME",250,0)
+ ;
+"RTN","C0CMIME",251,0)
+MAILSEN2(UDFN,ADDR) ; Send extract back to requestor.
+"RTN","C0CMIME",252,0)
+ ;
+"RTN","C0CMIME",253,0)
+ I +$G(UDFN)=0 S UDFN=2 ;
+"RTN","C0CMIME",254,0)
+ D TEST(UDFN)
+"RTN","C0CMIME",255,0)
+ S GN=$NA(^TMP($J,"C0CMIME"))
+"RTN","C0CMIME",256,0)
+ K @GN
+"RTN","C0CMIME",257,0)
+ ;M @GN=G2
+"RTN","C0CMIME",258,0)
+ S GM(1)="MIME-Version: 1.0"
+"RTN","C0CMIME",259,0)
+ S GM(2)="Content-Type: multipart/mixed; boudary=""1234567"""
+"RTN","C0CMIME",260,0)
+ S GM(3)=""
+"RTN","C0CMIME",261,0)
+ S GM(4)=""
+"RTN","C0CMIME",262,0)
+ S GM(5)="--1234567"
+"RTN","C0CMIME",263,0)
+ ;S GM(5)=$$REPEAT^XLFSTR("-",$L(X))
+"RTN","C0CMIME",264,0)
+ S GM(6)="Content-Type: text/xml; name=""ccr.xml"""
+"RTN","C0CMIME",265,0)
+ S GM(7)="Content-Transfer-Encoding: base64"
+"RTN","C0CMIME",266,0)
+ S GM(8)="Content-Disposition: attachment; filename=""ccr.xml"""
+"RTN","C0CMIME",267,0)
+ ;S GM(6)=$$UUBEGFN^LRSRVR2A("CCR.xml")
+"RTN","C0CMIME",268,0)
+ S GM(9)=""
+"RTN","C0CMIME",269,0)
+ S GM(10)="" ; FOR THE END
+"RTN","C0CMIME",270,0)
+ S GM(11)="--1234567--"
+"RTN","C0CMIME",271,0)
+ S GM(12)=""
+"RTN","C0CMIME",272,0)
+ S GM(13)=""
+"RTN","C0CMIME",273,0)
+ K GBLD
+"RTN","C0CMIME",274,0)
+ D QUEUE^C0CXPATH("GBLD","GM",5,9)
+"RTN","C0CMIME",275,0)
+ D QUEUE^C0CXPATH("GBLD","G2",1,$O(G2(""),-1))
+"RTN","C0CMIME",276,0)
+ D QUEUE^C0CXPATH("GBLD","GM",10,12)
+"RTN","C0CMIME",277,0)
+ D BUILD^C0CXPATH("GBLD",GN)
+"RTN","C0CMIME",278,0)
+ S GGG=$NA(^GPL("MIME2"))
+"RTN","C0CMIME",279,0)
+ ;D QUEUE^C0CXPATH("GBLD","GM",1,1)
+"RTN","C0CMIME",280,0)
+ ;D QUEUE^C0CXPATH("GBLD",GGG,21,159)
+"RTN","C0CMIME",281,0)
+ ;D BUILD^C0CXPATH("GBLD",GN)
+"RTN","C0CMIME",282,0)
+ K @GN@(0) ; KILL THE LINE COUNT
+"RTN","C0CMIME",283,0)
+ K LRINSTR,LRTASK,LRTO,XMERR,XMZ
+"RTN","C0CMIME",284,0)
+ I $G(ADDR)'="" S XQSND=ADDR
+"RTN","C0CMIME",285,0)
+ E  S XQSND="glilly@glilly.net"
+"RTN","C0CMIME",286,0)
+ ;S XQSND="nanthracite@earthlink.net"
+"RTN","C0CMIME",287,0)
+ ;S XQSND="dlefevre@orohosp.com"
+"RTN","C0CMIME",288,0)
+ ;S XQSND="gregwoodhouse@me.com"
+"RTN","C0CMIME",289,0)
+ ;S XQSND="rick.marshall@vistaexpertise.net"
+"RTN","C0CMIME",290,0)
+ S LRTO(XQSND)=""
+"RTN","C0CMIME",291,0)
+ ;S LRTO("glilly@glilly.net")=""
+"RTN","C0CMIME",292,0)
+ S LRINSTR("ADDR FLAGS")="R"
+"RTN","C0CMIME",293,0)
+ S LRINSTR("FROM")="ANTHRACITE.NANCY"
+"RTN","C0CMIME",294,0)
+ S LRMSUBJ="Sending a CCR with Mailman"
+"RTN","C0CMIME",295,0)
+ S LRMSUBJ=$E(LRMSUBJ,1,65)
+"RTN","C0CMIME",296,0)
+ D SENDMSG^XMXAPI(9,LRMSUBJ,GN,.LRTO,.LRINSTR,.LRTASK)
+"RTN","C0CMIME",297,0)
+ I $G(XMERR)=1 W !,"ERROR SENDING MESSAGE" Q  ;
+"RTN","C0CMIME",298,0)
+ ;S ^XMB(3.9,LRTASK,1,.1130590,0)="MIME-Version: 1.0"
+"RTN","C0CMIME",299,0)
+ ;S ^XMB(3.9,LRTASK,1,.1130591,0)="Content-type: multipart/mixed; boundary=000e0cd6ae026c3d4b049e7befe9"
+"RTN","C0CMIME",300,0)
+ Q
+"RTN","C0CMIME",301,0)
+ ;
+"RTN","C0CMIME",302,0)
+SIMPLE ;
+"RTN","C0CMIME",303,0)
+ S GN(1)="SIMPLE TEST MESSAGE"
+"RTN","C0CMIME",304,0)
+ K LRINSTR,LRTASK,LRTO,XMERR,XMZ
+"RTN","C0CMIME",305,0)
+ S XQSND="glilly@glilly.net"
+"RTN","C0CMIME",306,0)
+ S LRTO(XQSND)=""
+"RTN","C0CMIME",307,0)
+ S LRINSTR("ADDR FLAGS")="R"
+"RTN","C0CMIME",308,0)
+ S LRINSTR("FROM")="CCR_PACKAGE"
+"RTN","C0CMIME",309,0)
+ S LRMSUBJ="A SAMPLE CCR"
+"RTN","C0CMIME",310,0)
+ S LRMSUBJ=$E(LRMSUBJ,1,65)
+"RTN","C0CMIME",311,0)
+ D SENDMSG^XMXAPI(9,LRMSUBJ,"GN",.LRTO,.LRINSTR,.LRTASK)
+"RTN","C0CMIME",312,0)
+ Q
+"RTN","C0CMIME",313,0)
+CHUNK(OUTXML,INXML,ZSIZE) ; BREAKS INXML INTO ZSIZE BLOCKS
+"RTN","C0CMIME",314,0)
+ ; INXML IS AN ARRAY PASSED BY NAME OF STRINGS
+"RTN","C0CMIME",315,0)
+ ; OUTXML IS ALSO PASSED BY NAME
+"RTN","C0CMIME",316,0)
+ ; IF ZSIZE IS NOT PASSED, 1000 IS USED
+"RTN","C0CMIME",317,0)
+ I '$D(ZSIZE) S ZSIZE=1000 ; DEFAULT BLOCK SIZE
+"RTN","C0CMIME",318,0)
+ N ZB,ZI,ZJ,ZK,ZL,ZN
+"RTN","C0CMIME",319,0)
+ S ZB=ZSIZE-1
+"RTN","C0CMIME",320,0)
+ S ZN=1
+"RTN","C0CMIME",321,0)
+ S ZI=0 ; BEGINNING OF INDEX TO INXML
+"RTN","C0CMIME",322,0)
+ F  S ZI=$O(@INXML@(ZI)) Q:+ZI=0  D  ; FOR EACH STRING IN INXML
+"RTN","C0CMIME",323,0)
+ . S ZL=$L(@INXML@(ZI)) ; LENGTH OF THE STRING
+"RTN","C0CMIME",324,0)
+ . F ZJ=1:ZSIZE:ZL D  ;
+"RTN","C0CMIME",325,0)
+ . . S ZK=$S(ZJ+ZB<ZL:ZJ+ZB,1:ZL) ; END FOR EXTRACT
+"RTN","C0CMIME",326,0)
+ . . S @OUTXML@(ZN)=$E(@INXML@(ZI),ZJ,ZK) ; PULL OUT THE PIECE
+"RTN","C0CMIME",327,0)
+ . . S ZN=ZN+1 ; INCREMENT OUT ARRAY INDEX
+"RTN","C0CMIME",328,0)
+ Q
+"RTN","C0CMIME",329,0)
+ ;
+"RTN","C0CMIME",330,0)
+CLEAN(IARY) ; RUNS THROUGH AN ARRAY PASSED BY NAME AND STRIPS OUT $C(13)
+"RTN","C0CMIME",331,0)
+ ;
+"RTN","C0CMIME",332,0)
  N ZI S ZI=0
-"RTN","C0CMIME",40,0)
- F  S ZI=$O(@ZARY@(ZI)) Q:ZI=""  D  ; FOR EACH LINE
-"RTN","C0CMIME",41,0)
- . S ZCOPY(1)=ZCOPY(1)_@ZARY@(ZI)
-"RTN","C0CMIME",42,0)
- N G
-"RTN","C0CMIME",43,0)
- S G(1)=$$ENCODE^RGUTUU(ZCOPY(1))
-"RTN","C0CMIME",44,0)
- D CHUNK(ZRTN,"G",45)
-"RTN","C0CMIME",45,0)
+"RTN","C0CMIME",333,0)
+ F  S ZI=$O(@IARY@(ZI)) Q:+ZI=0  D  ;
+"RTN","C0CMIME",334,0)
+ . S @IARY@(ZI)=$TR(@IARY@(ZI),$C(13)) ;
+"RTN","C0CMIME",335,0)
+ . I $F(@IARY@(ZI)," <") S @IARY@(ZI)="<"_$P(@IARY@(ZI)," <",2) ; RM BLNKS
+"RTN","C0CMIME",336,0)
  Q
-"RTN","C0CMIME",46,0)
- ; THIS ROUTINE WAS COPIED FROM LRSRVR4 AND THEN MODIFIED . THANKS JOHN
-"RTN","C0CMIME",47,0)
-ENCODEOLD(IARY,LRNODE,LRSTR) ; Encode a string, keep remainder for next line
-"RTN","C0CMIME",48,0)
- ; Call with LRSTR by reference, Remainder returned in LRSTR
-"RTN","C0CMIME",49,0)
- ; IARY IS PASSED BY NAME
-"RTN","C0CMIME",50,0)
- S LRQUIT=0,LRLEN=$L(LRSTR)
-"RTN","C0CMIME",51,0)
- F  D  Q:LRQUIT
-"RTN","C0CMIME",52,0)
- . I $L(LRSTR)<45 S LRQUIT=1 Q
-"RTN","C0CMIME",53,0)
- . S LRX=$E(LRSTR,1,45)
-"RTN","C0CMIME",54,0)
- . S LRNODE=LRNODE+1,@IARY@(LRNODE)=$$UUEN^LRSRVR4(LRX)
-"RTN","C0CMIME",55,0)
- . S LRSTR=$E(LRSTR,46,LRLEN)
-"RTN","C0CMIME",56,0)
- Q
-"RTN","C0CMIME",57,0)
- ;
-"RTN","C0CMIME",58,0)
-TESTMAIL ;
-"RTN","C0CMIME",59,0)
- ; TEST OF MAILSEND
-"RTN","C0CMIME",60,0)
- ;S ZTO("glilly@glilly.net")=""
-"RTN","C0CMIME",61,0)
- S ZTO("mish@nhin.openforum.opensourcevista.net")=""
-"RTN","C0CMIME",62,0)
- ;S ZTO("martijn@djigzo.com")=""
-"RTN","C0CMIME",63,0)
- ;S ZTO("profmish@gmail.com")=""
-"RTN","C0CMIME",64,0)
- ;S ZTO("nanthracite@earthlink.net")=""
-"RTN","C0CMIME",65,0)
- S ZFROM="ANTHRACITE.NANCY"
-"RTN","C0CMIME",66,0)
- S ZATTACH=$NA(^GPL("CCR"))
-"RTN","C0CMIME",67,0)
- I $G(@ZATTACH@(1))="" D  ; NO CCR THERE
-"RTN","C0CMIME",68,0)
- . D CCRRPC^C0CCCR(.GPL,2) ; GET ONE FROM PATIENT 2
-"RTN","C0CMIME",69,0)
- . M @ZATTACH=GPL ; PUT IT IN THERE FOR NEXT TIME
-"RTN","C0CMIME",70,0)
- S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE"
-"RTN","C0CMIME",71,0)
- D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,,ZATTACH)
-"RTN","C0CMIME",72,0)
- ZWR GR
-"RTN","C0CMIME",73,0)
- Q
-"RTN","C0CMIME",74,0)
- ;
-"RTN","C0CMIME",75,0)
-TESTMAIL2 ;
-"RTN","C0CMIME",76,0)
- ; TEST OF MAILSEND TO gpl.mdc-crew.net
-"RTN","C0CMIME",77,0)
- N C0CGM
-"RTN","C0CMIME",78,0)
- S C0CGM(1)="This is a test message."
-"RTN","C0CMIME",79,0)
- S C0CGM(2)="A Continuity of Care record is attached"
-"RTN","C0CMIME",80,0)
- S C0CGM(3)="It contains no Protected Health Information (PHI)"
-"RTN","C0CMIME",81,0)
- S C0CGM(4)="It is purely test data used for software development"
-"RTN","C0CMIME",82,0)
- S C0CGM(5)="It does not represent information about any person living or dead"
-"RTN","C0CMIME",83,0)
- ;S ZTO("glilly@glilly.net")=""
-"RTN","C0CMIME",84,0)
- ;S ZTO("george.lilly@pobox.com")=""
-"RTN","C0CMIME",85,0)
- ;S ZTO("george@nhin.openforum.opensourcevista.net")=""
-"RTN","C0CMIME",86,0)
- ;S ZTO("mish@nhin.openforum.opensourcevista.net")="" 
-"RTN","C0CMIME",87,0)
- S ZTO("brooks.richard@securemail.opensourcevista.net")="" 
-"RTN","C0CMIME",88,0)
- ;S ZTO("LILLY.GEORGE@mdc-crew.net")=""
-"RTN","C0CMIME",89,0)
- ;S ZTO("ncoal@live.com")=""
-"RTN","C0CMIME",90,0)
- ;S ZTO("martijn@djigzo.com")=""
-"RTN","C0CMIME",91,0)
- ;S ZTO("profmish@gmail.com")=""
-"RTN","C0CMIME",92,0)
- ;S ZTO("nanthracite@earthlink.net")=""
-"RTN","C0CMIME",93,0)
- S ZTO("gpl.doctortest@gmail.com")=""
-"RTN","C0CMIME",94,0)
- S ZFROM="LILLY.GEORGE"
-"RTN","C0CMIME",95,0)
- S ZATTACH=$NA(^GPL("CCR"))
-"RTN","C0CMIME",96,0)
- I $G(@ZATTACH@(1))="" D  ; NO CCR THERE
-"RTN","C0CMIME",97,0)
- . D CCRRPC^C0CCCR(.GPL,2) ; GET ONE FROM PATIENT 2
-"RTN","C0CMIME",98,0)
- . M @ZATTACH=GPL ; PUT IT IN THERE FOR NEXT TIME
-"RTN","C0CMIME",99,0)
- S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE"
-"RTN","C0CMIME",100,0)
- D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,"C0CGM",ZATTACH,"CCR.xml")
-"RTN","C0CMIME",101,0)
- ZWR GR
-"RTN","C0CMIME",102,0)
- Q
-"RTN","C0CMIME",103,0)
- ;
-"RTN","C0CMIME",104,0)
-LINE(C0CFILE,C0CTO) ; read a file name passed in C0CFILE and send it to
-"RTN","C0CMIME",105,0)
- ; the email address in C0CTO 
-"RTN","C0CMIME",106,0)
- ; the directory and the "from" are all hard coded
-"RTN","C0CMIME",107,0)
- ;
-"RTN","C0CMIME",108,0)
- N ZZFROM S ZZFROM="LILLY.GEORGE"
-"RTN","C0CMIME",109,0)
- N GN S GN=$NA(^TMP("C0CMIME2",$J))
-"RTN","C0CMIME",110,0)
- N GN1 S GN1=$NA(@GN@(1))
-"RTN","C0CMIME",111,0)
- K @GN
-"RTN","C0CMIME",112,0)
- I '$D(C0CFILE) Q  ; NO FILENAME PASSED
-"RTN","C0CMIME",113,0)
- I '$D(C0CTO) S C0CTO="brooks.richard@securemail.opensourcevista.net"
-"RTN","C0CMIME",114,0)
- S ZZTO(C0CTO)=""
-"RTN","C0CMIME",115,0)
- N ZMESS S ZMESS(1)="file transmission from wvehr3-09"
-"RTN","C0CMIME",116,0)
- N GD S GD="/home/wvehr3-09/EHR/" ; directory
-"RTN","C0CMIME",117,0)
- I '$$FTG^%ZISH(GD,C0CFILE,GN1,3) Q  D  ;
-"RTN","C0CMIME",118,0)
- . W !,"error reading file",C0CFILE
-"RTN","C0CMIME",119,0)
- D MAILSEND(.ZRTN,ZZFROM,"ZZTO",,"file transmission","ZMESS",GN,C0CFILE)
-"RTN","C0CMIME",120,0)
- K @GN ; CLEAN UP
-"RTN","C0CMIME",121,0)
- ;ZWR ZRTN
-"RTN","C0CMIME",122,0)
- W !,$G(ZRTN(1))
-"RTN","C0CMIME",123,0)
- Q
-"RTN","C0CMIME",124,0)
- ;
-"RTN","C0CMIME",125,0)
-MAILSEND(RTN,FROM,TO,CC,SUBJECT,MESSAGE,ATTACH,FNAME,FLAGS) ; MAIL SENDING INTERFACE
-"RTN","C0CMIME",126,0)
- ; RTN IS THE RETURN ARRAY PASSED BY REFERENCE
-"RTN","C0CMIME",127,0)
- ; FROM IS PASSED BY VALUE AND IS THE EMAIL ADDRESS OF THE SENDER
-"RTN","C0CMIME",128,0)
- ;  IF NULL, WILL SEND FROM THE CURRENT DUZ
-"RTN","C0CMIME",129,0)
- ; TO AND CC ARE RECIEPIENT EMAIL ADDRESSES PASSED BY NAME
-"RTN","C0CMIME",130,0)
- ;  @TO@("addr1@domain1.net") 
-"RTN","C0CMIME",131,0)
- ;  @CC@("addr2@domain2.com")  both can be multiples
-"RTN","C0CMIME",132,0)
- ; SUBJECT IS PASSED BY VALUE AND WILL GO IN THE SUBJECT LINE
-"RTN","C0CMIME",133,0)
- ; MESSAGE IS PASSED BY NAME AND IS AN ARRAY OF TEXT
-"RTN","C0CMIME",134,0)
- ; ATTACH IS PASSED BY NAME AND IS AN XML OR HTML FILE TO BE ATTACHED
-"RTN","C0CMIME",135,0)
- ; FNAME IS THE FILENAME OF THE ATTACHMENT, DEFAULT IS ccr.xml
-"RTN","C0CMIME",136,0)
- ;
-"RTN","C0CMIME",137,0)
- I '$D(FNAME) S FNAME="ccr.xml" ; default filename
-"RTN","C0CMIME",138,0)
- N GN
-"RTN","C0CMIME",139,0)
- S GN=$NA(^TMP($J,"C0CMIME"))
-"RTN","C0CMIME",140,0)
- K @GN
-"RTN","C0CMIME",141,0)
- S GM(1)="MIME-Version: 1.0"
-"RTN","C0CMIME",142,0)
- S GM(2)="Content-Type: multipart/mixed; boudary=""1234567"""
-"RTN","C0CMIME",143,0)
- S GM(3)=""
-"RTN","C0CMIME",144,0)
- S GM(4)=""
-"RTN","C0CMIME",145,0)
- ;S GM(5)="--123456788888"
-"RTN","C0CMIME",146,0)
- ;S GM(5)=$$REPEAT^XLFSTR("-",$L(X))
-"RTN","C0CMIME",147,0)
- S GM(5)="--123456899999"
-"RTN","C0CMIME",148,0)
- S GM(6)="Content-Type: text/xml; name="_FNAME
-"RTN","C0CMIME",149,0)
- S GM(7)="Content-Transfer-Encoding: base64"
-"RTN","C0CMIME",150,0)
- S GM(8)="Content-Disposition: attachment; filename="_FNAME
-"RTN","C0CMIME",151,0)
- S GM(9)=""
-"RTN","C0CMIME",152,0)
- S GM(10)="" ; FOR THE END
-"RTN","C0CMIME",153,0)
- ;S GM(11)="--123456788888--"
-"RTN","C0CMIME",154,0)
- S GM(11)="--123456899999--"
-"RTN","C0CMIME",155,0)
- S GM(12)=""
-"RTN","C0CMIME",156,0)
- S GM(13)=""
-"RTN","C0CMIME",157,0)
- S GG(1)="--123456899999"
-"RTN","C0CMIME",158,0)
- S GG(2)="Content-Type: text/plain; charset=ISO-8859-1; format=flowed"
-"RTN","C0CMIME",159,0)
- S GG(3)="Content-Transfer-Encoding: 7bit"
-"RTN","C0CMIME",160,0)
- S GG(4)=""
-"RTN","C0CMIME",161,0)
- S GG(5)="This is a test message."
-"RTN","C0CMIME",162,0)
- S GG(6)="A Continuity of Care record is attached"
-"RTN","C0CMIME",163,0)
- S GG(7)="It contains no Protected Health Information (PHI)"
-"RTN","C0CMIME",164,0)
- S GG(8)="It is purely test data used for software development"
-"RTN","C0CMIME",165,0)
- S GG(9)="It does not represent information about any person living or dead"
-"RTN","C0CMIME",166,0)
- S GG(10)=""
-"RTN","C0CMIME",167,0)
- S GG(11)="--123456899999--"
-"RTN","C0CMIME",168,0)
- ;S GG(11)="Content-Type: text/plain; charset=""us-ascii"""
-"RTN","C0CMIME",169,0)
- S GG(12)=""
-"RTN","C0CMIME",170,0)
- ;S GG(13)="This is a test message."
-"RTN","C0CMIME",171,0)
- S GG(14)="A Continuity of Care record is attached"
-"RTN","C0CMIME",172,0)
- S GG(15)="It contains no Protected Health Information (PHI)"
-"RTN","C0CMIME",173,0)
- S GG(16)="It is purely test data used for software development"
-"RTN","C0CMIME",174,0)
- S GG(17)="It does not represent information about any person living or dead"
-"RTN","C0CMIME",175,0)
- S GG(18)=""
-"RTN","C0CMIME",176,0)
- S GG(19)="--123456899999"
-"RTN","C0CMIME",177,0)
- S GG(20)="--987654321--"
-"RTN","C0CMIME",178,0)
- K GBLD
-"RTN","C0CMIME",179,0)
- ;D QUEUE^C0CXPATH("GBLD","GGG",1,3) ; THE MESSAGE
-"RTN","C0CMIME",180,0)
- ;D QUEUE^C0CXPATH("GBLD","GG",1,10) ; THE MESSAGE
-"RTN","C0CMIME",181,0)
- I $D(MESSAGE)'="" D  ; THERE IS A MESSAGE
-"RTN","C0CMIME",182,0)
- . D QUEUE^C0CXPATH("GBLD","GG",1,4) ; THE MIME BOUNDARY
-"RTN","C0CMIME",183,0)
- . D QUEUE^C0CXPATH("GBLD",MESSAGE,1,$O(@MESSAGE@(""),-1)) ;THE MESSAGE
-"RTN","C0CMIME",184,0)
- . D QUEUE^C0CXPATH("GBLD","GG",10,10) ;A BLANK LINE
-"RTN","C0CMIME",185,0)
- D QUEUE^C0CXPATH("GBLD","GM",5,9)
-"RTN","C0CMIME",186,0)
- I $D(ATTACH)'="" D  ; IF WE HAVE AN ATTACHMENT
-"RTN","C0CMIME",187,0)
- . D ENCODE("G2",ATTACH) ; ENCODE FOR SENDING
-"RTN","C0CMIME",188,0)
- . D QUEUE^C0CXPATH("GBLD","G2",1,$O(G2(""),-1))
-"RTN","C0CMIME",189,0)
- D QUEUE^C0CXPATH("GBLD","GM",11,12)
-"RTN","C0CMIME",190,0)
- D BUILD^C0CXPATH("GBLD",GN)
-"RTN","C0CMIME",191,0)
- ;S GGG=$NA(^GPL("MIME2"))
-"RTN","C0CMIME",192,0)
- K @GN@(0) ; KILL THE LINE COUNT
-"RTN","C0CMIME",193,0)
- K LRINSTR,LRTASK,LRTO,XMERR,XMZ
-"RTN","C0CMIME",194,0)
- M LRTO=@TO
-"RTN","C0CMIME",195,0)
- I $D(CC) M LRTO=@CC
-"RTN","C0CMIME",196,0)
- S LRINSTR("ADDR FLAGS")="R"
-"RTN","C0CMIME",197,0)
- S LRINSTR("FROM")=$G(FROM)
-"RTN","C0CMIME",198,0)
- S LRMSUBJ=$G(SUBJECT)
-"RTN","C0CMIME",199,0)
- S LRMSUBJ=$E(LRMSUBJ,1,65)
-"RTN","C0CMIME",200,0)
- D SENDMSG^XMXAPI(DUZ,LRMSUBJ,GN,.LRTO,.LRINSTR,.LRTASK)
-"RTN","C0CMIME",201,0)
- I $G(XMERR)=1 S RTN(1)="ERROR SENDING MESSAGE" Q  ;
-"RTN","C0CMIME",202,0)
- S RTN(1)="OK"
-"RTN","C0CMIME",203,0)
- Q
-"RTN","C0CMIME",204,0)
- ;
-"RTN","C0CMIME",205,0)
-MAILSEND0(LRMSUBJ) ; Send extract back to requestor.
-"RTN","C0CMIME",206,0)
- ;
-"RTN","C0CMIME",207,0)
- ;D TEST
-"RTN","C0CMIME",208,0)
- S GN=$NA(^TMP($J,"C0CMIME"))
-"RTN","C0CMIME",209,0)
- K @GN
-"RTN","C0CMIME",210,0)
- ;M @GN=G2
-"RTN","C0CMIME",211,0)
- S GM(1)="MIME-Version: 1.0"
-"RTN","C0CMIME",212,0)
- S GM(2)="Content-Type: multipart/mixed; boudary=""1234567"""
-"RTN","C0CMIME",213,0)
- S GM(3)=""
-"RTN","C0CMIME",214,0)
- S GM(4)=""
-"RTN","C0CMIME",215,0)
- S GM(5)="--1234567"
-"RTN","C0CMIME",216,0)
- ;S GM(5)=$$REPEAT^XLFSTR("-",$L(X))
-"RTN","C0CMIME",217,0)
- S GM(6)="Content-Type: text/xml; name=""ccr.xml"""
-"RTN","C0CMIME",218,0)
- S GM(7)="Content-Transfer-Encoding: base64"
-"RTN","C0CMIME",219,0)
- S GM(8)="Content-Disposition: attachment; filename=""ccr.xml"""
-"RTN","C0CMIME",220,0)
- ;S GM(6)=$$UUBEGFN^LRSRVR2A("CCR.xml")
-"RTN","C0CMIME",221,0)
- S GM(9)=""
-"RTN","C0CMIME",222,0)
- S GM(10)="" ; FOR THE END
-"RTN","C0CMIME",223,0)
- S GM(11)="--frontier--"
-"RTN","C0CMIME",224,0)
- S GM(12)="."
-"RTN","C0CMIME",225,0)
- S GM(13)=""
-"RTN","C0CMIME",226,0)
- K GBLD
-"RTN","C0CMIME",227,0)
- ;D QUEUE^C0CXPATH("GBLD","GM",1,9)
-"RTN","C0CMIME",228,0)
- ;D QUEUE^C0CXPATH("GBLD","G2",1,$O(G2(""),-1))
-"RTN","C0CMIME",229,0)
- ;D QUEUE^C0CXPATH("GBLD","GM",10,13)
-"RTN","C0CMIME",230,0)
- ;D BUILD^C0CXPATH("GBLD",GN)
-"RTN","C0CMIME",231,0)
- S GGG=$NA(^GPL("MIME2"))
-"RTN","C0CMIME",232,0)
- ;D QUEUE^C0CXPATH("GBLD","GM",1,1)
-"RTN","C0CMIME",233,0)
- D QUEUE^C0CXPATH("GBLD",GGG,21,159)
-"RTN","C0CMIME",234,0)
- D BUILD^C0CXPATH("GBLD",GN)
-"RTN","C0CMIME",235,0)
- K @GN@(0) ; KILL THE LINE COUNT
-"RTN","C0CMIME",236,0)
- K LRINSTR,LRTASK,LRTO,XMERR,XMZ
-"RTN","C0CMIME",237,0)
- S XQSND="glilly@glilly.net"
-"RTN","C0CMIME",238,0)
- ;S XQSND="nanthracite@earthlink.net"
-"RTN","C0CMIME",239,0)
- ;S XQSND="dlefevre@orohosp.com"
-"RTN","C0CMIME",240,0)
- ;S XQSND="gregwoodhouse@me.com"
-"RTN","C0CMIME",241,0)
- ;S XQSND="rick.marshall@vistaexpertise.net"
-"RTN","C0CMIME",242,0)
- S LRTO(XQSND)=""
-"RTN","C0CMIME",243,0)
- S LRINSTR("ADDR FLAGS")="R"
-"RTN","C0CMIME",244,0)
- S LRINSTR("FROM")="CCR_PACKAGE"
-"RTN","C0CMIME",245,0)
- S LRMSUBJ="A SAMPLE CCR"
-"RTN","C0CMIME",246,0)
- S LRMSUBJ=$E(LRMSUBJ,1,65)
-"RTN","C0CMIME",247,0)
- D SENDMSG^XMXAPI(9,LRMSUBJ,GN,.LRTO,.LRINSTR,.LRTASK)
-"RTN","C0CMIME",248,0)
- I $G(XMERR)=1 W !,"ERROR SENDING MESSAGE" Q  ;
-"RTN","C0CMIME",249,0)
- ;S ^XMB(3.9,LRTASK,1,.1130590,0)="MIME-Version: 1.0"
-"RTN","C0CMIME",250,0)
- ;S ^XMB(3.9,LRTASK,1,.1130591,0)="Content-type: multipart/mixed; boundary=000e0cd6ae026c3d4b049e7befe9"
-"RTN","C0CMIME",251,0)
- Q
-"RTN","C0CMIME",252,0)
- ;
-"RTN","C0CMIME",253,0)
-MAILSEND2(UDFN,ADDR) ; Send extract back to requestor.
-"RTN","C0CMIME",254,0)
- ;
-"RTN","C0CMIME",255,0)
- I +$G(UDFN)=0 S UDFN=2 ;
-"RTN","C0CMIME",256,0)
- D TEST(UDFN)
-"RTN","C0CMIME",257,0)
- S GN=$NA(^TMP($J,"C0CMIME"))
-"RTN","C0CMIME",258,0)
- K @GN
-"RTN","C0CMIME",259,0)
- ;M @GN=G2
-"RTN","C0CMIME",260,0)
- S GM(1)="MIME-Version: 1.0"
-"RTN","C0CMIME",261,0)
- S GM(2)="Content-Type: multipart/mixed; boudary=""1234567"""
-"RTN","C0CMIME",262,0)
- S GM(3)=""
-"RTN","C0CMIME",263,0)
- S GM(4)=""
-"RTN","C0CMIME",264,0)
- S GM(5)="--1234567"
-"RTN","C0CMIME",265,0)
- ;S GM(5)=$$REPEAT^XLFSTR("-",$L(X))
-"RTN","C0CMIME",266,0)
- S GM(6)="Content-Type: text/xml; name=""ccr.xml"""
-"RTN","C0CMIME",267,0)
- S GM(7)="Content-Transfer-Encoding: base64"
-"RTN","C0CMIME",268,0)
- S GM(8)="Content-Disposition: attachment; filename=""ccr.xml"""
-"RTN","C0CMIME",269,0)
- ;S GM(6)=$$UUBEGFN^LRSRVR2A("CCR.xml")
-"RTN","C0CMIME",270,0)
- S GM(9)=""
-"RTN","C0CMIME",271,0)
- S GM(10)="" ; FOR THE END
-"RTN","C0CMIME",272,0)
- S GM(11)="--1234567--"
-"RTN","C0CMIME",273,0)
- S GM(12)=""
-"RTN","C0CMIME",274,0)
- S GM(13)=""
-"RTN","C0CMIME",275,0)
- K GBLD
-"RTN","C0CMIME",276,0)
- D QUEUE^C0CXPATH("GBLD","GM",5,9)
-"RTN","C0CMIME",277,0)
- D QUEUE^C0CXPATH("GBLD","G2",1,$O(G2(""),-1))
-"RTN","C0CMIME",278,0)
- D QUEUE^C0CXPATH("GBLD","GM",10,12)
-"RTN","C0CMIME",279,0)
- D BUILD^C0CXPATH("GBLD",GN)
-"RTN","C0CMIME",280,0)
- S GGG=$NA(^GPL("MIME2"))
-"RTN","C0CMIME",281,0)
- ;D QUEUE^C0CXPATH("GBLD","GM",1,1)
-"RTN","C0CMIME",282,0)
- ;D QUEUE^C0CXPATH("GBLD",GGG,21,159)
-"RTN","C0CMIME",283,0)
- ;D BUILD^C0CXPATH("GBLD",GN)
-"RTN","C0CMIME",284,0)
- K @GN@(0) ; KILL THE LINE COUNT
-"RTN","C0CMIME",285,0)
- K LRINSTR,LRTASK,LRTO,XMERR,XMZ
-"RTN","C0CMIME",286,0)
- I $G(ADDR)'="" S XQSND=ADDR
-"RTN","C0CMIME",287,0)
- E  S XQSND="glilly@glilly.net"
-"RTN","C0CMIME",288,0)
- ;S XQSND="nanthracite@earthlink.net"
-"RTN","C0CMIME",289,0)
- ;S XQSND="dlefevre@orohosp.com"
-"RTN","C0CMIME",290,0)
- ;S XQSND="gregwoodhouse@me.com"
-"RTN","C0CMIME",291,0)
- ;S XQSND="rick.marshall@vistaexpertise.net"
-"RTN","C0CMIME",292,0)
- S LRTO(XQSND)=""
-"RTN","C0CMIME",293,0)
- ;S LRTO("glilly@glilly.net")=""
-"RTN","C0CMIME",294,0)
- S LRINSTR("ADDR FLAGS")="R"
-"RTN","C0CMIME",295,0)
- S LRINSTR("FROM")="ANTHRACITE.NANCY"
-"RTN","C0CMIME",296,0)
- S LRMSUBJ="Sending a CCR with Mailman"
-"RTN","C0CMIME",297,0)
- S LRMSUBJ=$E(LRMSUBJ,1,65)
-"RTN","C0CMIME",298,0)
- D SENDMSG^XMXAPI(9,LRMSUBJ,GN,.LRTO,.LRINSTR,.LRTASK)
-"RTN","C0CMIME",299,0)
- I $G(XMERR)=1 W !,"ERROR SENDING MESSAGE" Q  ;
-"RTN","C0CMIME",300,0)
- ;S ^XMB(3.9,LRTASK,1,.1130590,0)="MIME-Version: 1.0"
-"RTN","C0CMIME",301,0)
- ;S ^XMB(3.9,LRTASK,1,.1130591,0)="Content-type: multipart/mixed; boundary=000e0cd6ae026c3d4b049e7befe9"
-"RTN","C0CMIME",302,0)
- Q
-"RTN","C0CMIME",303,0)
- ;
-"RTN","C0CMIME",304,0)
-SIMPLE ;
-"RTN","C0CMIME",305,0)
- S GN(1)="SIMPLE TEST MESSAGE"
-"RTN","C0CMIME",306,0)
- K LRINSTR,LRTASK,LRTO,XMERR,XMZ
-"RTN","C0CMIME",307,0)
- S XQSND="glilly@glilly.net"
-"RTN","C0CMIME",308,0)
- S LRTO(XQSND)=""
-"RTN","C0CMIME",309,0)
- S LRINSTR("ADDR FLAGS")="R"
-"RTN","C0CMIME",310,0)
- S LRINSTR("FROM")="CCR_PACKAGE"
-"RTN","C0CMIME",311,0)
- S LRMSUBJ="A SAMPLE CCR"
-"RTN","C0CMIME",312,0)
- S LRMSUBJ=$E(LRMSUBJ,1,65)
-"RTN","C0CMIME",313,0)
- D SENDMSG^XMXAPI(9,LRMSUBJ,"GN",.LRTO,.LRINSTR,.LRTASK)
-"RTN","C0CMIME",314,0)
- Q
-"RTN","C0CMIME",315,0)
-CHUNK(OUTXML,INXML,ZSIZE) ; BREAKS INXML INTO ZSIZE BLOCKS
-"RTN","C0CMIME",316,0)
- ; INXML IS AN ARRAY PASSED BY NAME OF STRINGS
-"RTN","C0CMIME",317,0)
- ; OUTXML IS ALSO PASSED BY NAME
-"RTN","C0CMIME",318,0)
- ; IF ZSIZE IS NOT PASSED, 1000 IS USED
-"RTN","C0CMIME",319,0)
- I '$D(ZSIZE) S ZSIZE=1000 ; DEFAULT BLOCK SIZE
-"RTN","C0CMIME",320,0)
- N ZB,ZI,ZJ,ZK,ZL,ZN
-"RTN","C0CMIME",321,0)
- S ZB=ZSIZE-1
-"RTN","C0CMIME",322,0)
- S ZN=1
-"RTN","C0CMIME",323,0)
- S ZI=0 ; BEGINNING OF INDEX TO INXML
-"RTN","C0CMIME",324,0)
- F  S ZI=$O(@INXML@(ZI)) Q:+ZI=0  D  ; FOR EACH STRING IN INXML
-"RTN","C0CMIME",325,0)
- . S ZL=$L(@INXML@(ZI)) ; LENGTH OF THE STRING
-"RTN","C0CMIME",326,0)
- . F ZJ=1:ZSIZE:ZL D  ;
-"RTN","C0CMIME",327,0)
- . . S ZK=$S(ZJ+ZB<ZL:ZJ+ZB,1:ZL) ; END FOR EXTRACT
-"RTN","C0CMIME",328,0)
- . . S @OUTXML@(ZN)=$E(@INXML@(ZI),ZJ,ZK) ; PULL OUT THE PIECE
-"RTN","C0CMIME",329,0)
- . . S ZN=ZN+1 ; INCREMENT OUT ARRAY INDEX
-"RTN","C0CMIME",330,0)
- Q
-"RTN","C0CMIME",331,0)
- ;
-"RTN","C0CMIME",332,0)
-CLEAN(IARY) ; RUNS THROUGH AN ARRAY PASSED BY NAME AND STRIPS OUT $C(13)
-"RTN","C0CMIME",333,0)
- ;
-"RTN","C0CMIME",334,0)
- N ZI S ZI=0
-"RTN","C0CMIME",335,0)
- F  S ZI=$O(@IARY@(ZI)) Q:+ZI=0  D  ;
-"RTN","C0CMIME",336,0)
- . S @IARY@(ZI)=$TR(@IARY@(ZI),$C(13)) ;
 "RTN","C0CMIME",337,0)
- . I $F(@IARY@(ZI)," <") S @IARY@(ZI)="<"_$P(@IARY@(ZI)," <",2) ; RM BLNKS
-"RTN","C0CMIME",338,0)
- Q
-"RTN","C0CMIME",339,0)
  ;
 "RTN","C0CMXML")
-0^65^B56456416
+0^65^B55227178
 "RTN","C0CMXML",1,0)
 C0CMXML   ; GPL - MXML based XPath utilities;10/13/09  17:05
 "RTN","C0CMXML",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CMXML",3,0)
- ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
+ ;Copyright 2009 George Lilly.  
 "RTN","C0CMXML",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CMXML",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CMXML",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CMXML",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CMXML",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CMXML",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CMXML",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CMXML",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CMXML",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CMXML",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CMXML",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CMXML",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CMXML",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CMXML",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CMXML",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ Q
 "RTN","C0CMXML",19,0)
- ;
+ ; THIS FILE CONTAINS THE XPATH CREATOR, THE PARSE CALL TO THE MXML PARSER
 "RTN","C0CMXML",20,0)
+ ; AND THE OUTXML XML GENERATOR THAT OUTPUTS XML FROM AN MXML DOM
+"RTN","C0CMXML",21,0)
+ ; FOR CCD SPECIFIC ROUTINES, SEE C0CMCCD
+"RTN","C0CMXML",22,0)
+ ; FOR TEMPLATE FILE RELATED ROUTINES, SEE C0CMXP
+"RTN","C0CMXML",23,0)
+ ;
+"RTN","C0CMXML",24,0)
+TEST ;
+"RTN","C0CMXML",25,0)
+ S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
+"RTN","C0CMXML",26,0)
+ K GARY
+"RTN","C0CMXML",27,0)
+ W $$FTG^%ZISH("/home/vademo2/EHR/p/","mxml-test.xml",$NA(@C0CXMLIN@(1)),3)
+"RTN","C0CMXML",28,0)
+ S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DocID: ",C0CDOCID
+"RTN","C0CMXML",29,0)
+ S REDUX="//ContinuityOfCareRecord/Body"
+"RTN","C0CMXML",30,0)
+ D XPATH(1,"/","GIDX","GARY",,REDUX)
+"RTN","C0CMXML",31,0)
+ D SEPARATE^C0CMCCD("GARY2","GARY")
+"RTN","C0CMXML",32,0)
+ S ZI=""
+"RTN","C0CMXML",33,0)
+ F  S ZI=$O(GARY2(ZI)) Q:ZI=""  D  ;
+"RTN","C0CMXML",34,0)
+ . N GTMP,G2
+"RTN","C0CMXML",35,0)
+ . M G2=GARY2(ZI)
+"RTN","C0CMXML",36,0)
+ . D DEMUX2^C0CMXP("GTMP","G2",2)
+"RTN","C0CMXML",37,0)
+ . M GARY3(ZI)=GTMP
+"RTN","C0CMXML",38,0)
  Q
-"RTN","C0CMXML",21,0)
- ; THIS FILE CONTAINS THE XPATH CREATOR, THE PARSE CALL TO THE MXML PARSER
-"RTN","C0CMXML",22,0)
- ; AND THE OUTXML XML GENERATOR THAT OUTPUTS XML FROM AN MXML DOM
-"RTN","C0CMXML",23,0)
- ; FOR CCD SPECIFIC ROUTINES, SEE C0CMCCD
-"RTN","C0CMXML",24,0)
- ; FOR TEMPLATE FILE RELATED ROUTINES, SEE C0CMXP
-"RTN","C0CMXML",25,0)
- ;
-"RTN","C0CMXML",26,0)
-TEST ;
-"RTN","C0CMXML",27,0)
+"RTN","C0CMXML",39,0)
+ ;
+"RTN","C0CMXML",40,0)
+TEST2 ;
+"RTN","C0CMXML",41,0)
+ S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail"
+"RTN","C0CMXML",42,0)
+ D XPATH(1,"/","GIDX","GARY","",REDUX)
+"RTN","C0CMXML",43,0)
+ Q
+"RTN","C0CMXML",44,0)
+ ;
+"RTN","C0CMXML",45,0)
+TEST3 ;
+"RTN","C0CMXML",46,0)
  S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
-"RTN","C0CMXML",28,0)
- K GARY
-"RTN","C0CMXML",29,0)
- W $$FTG^%ZISH("/home/vademo2/EHR/p/","mxml-test.xml",$NA(@C0CXMLIN@(1)),3)
-"RTN","C0CMXML",30,0)
- S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DocID: ",C0CDOCID
-"RTN","C0CMXML",31,0)
- S REDUX="//ContinuityOfCareRecord/Body"
-"RTN","C0CMXML",32,0)
+"RTN","C0CMXML",47,0)
+ K GARY,GTMP,GIDX
+"RTN","C0CMXML",48,0)
+ K @C0CXMLIN
+"RTN","C0CMXML",49,0)
+ W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3)
+"RTN","C0CMXML",50,0)
+ D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
+"RTN","C0CMXML",51,0)
+ K @C0CXMLIN
+"RTN","C0CMXML",52,0)
+ M @C0CXMLIN=GTMP
+"RTN","C0CMXML",53,0)
+ K GTMP
+"RTN","C0CMXML",54,0)
+ D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN)
+"RTN","C0CMXML",55,0)
+ K @C0CXMLIN
+"RTN","C0CMXML",56,0)
+ M @C0CXMLIN=GTMP
+"RTN","C0CMXML",57,0)
+ K GTMP
+"RTN","C0CMXML",58,0)
+ S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID
+"RTN","C0CMXML",59,0)
+ S REDUX="//ClinicalDocument/component/structuredBody"
+"RTN","C0CMXML",60,0)
+ D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS
+"RTN","C0CMXML",61,0)
+ D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS
+"RTN","C0CMXML",62,0)
+ D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS
+"RTN","C0CMXML",63,0)
  D XPATH(1,"/","GIDX","GARY",,REDUX)
-"RTN","C0CMXML",33,0)
- D SEPARATE^C0CMCCD("GARY2","GARY")
-"RTN","C0CMXML",34,0)
+"RTN","C0CMXML",64,0)
+ K C0CCBK("TAG")
+"RTN","C0CMXML",65,0)
+ D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING
+"RTN","C0CMXML",66,0)
+ D TEST3A
+"RTN","C0CMXML",67,0)
+ Q
+"RTN","C0CMXML",68,0)
+ ;
+"RTN","C0CMXML",69,0)
+TEST3A ; INTERNAL ROUTINE
+"RTN","C0CMXML",70,0)
  S ZI=""
-"RTN","C0CMXML",35,0)
+"RTN","C0CMXML",71,0)
  F  S ZI=$O(GARY2(ZI)) Q:ZI=""  D  ;
-"RTN","C0CMXML",36,0)
+"RTN","C0CMXML",72,0)
  . N GTMP,G2
-"RTN","C0CMXML",37,0)
+"RTN","C0CMXML",73,0)
  . M G2=GARY2(ZI)
-"RTN","C0CMXML",38,0)
+"RTN","C0CMXML",74,0)
  . D DEMUX2^C0CMXP("GTMP","G2",2)
-"RTN","C0CMXML",39,0)
- . M GARY3(ZI)=GTMP
-"RTN","C0CMXML",40,0)
+"RTN","C0CMXML",75,0)
+ . M GARY4(ZI)=GTMP
+"RTN","C0CMXML",76,0)
  Q
-"RTN","C0CMXML",41,0)
- ;
-"RTN","C0CMXML",42,0)
-TEST2 ;
-"RTN","C0CMXML",43,0)
- S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail"
-"RTN","C0CMXML",44,0)
- D XPATH(1,"/","GIDX","GARY","",REDUX)
-"RTN","C0CMXML",45,0)
+"RTN","C0CMXML",77,0)
+ ;
+"RTN","C0CMXML",78,0)
+TESTQ ; TEST OF THE QRDA TEMPLATE GPL 7/8/2010
+"RTN","C0CMXML",79,0)
+ S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
+"RTN","C0CMXML",80,0)
+ K GARY,GTMP,GIDX
+"RTN","C0CMXML",81,0)
+ K @C0CXMLIN
+"RTN","C0CMXML",82,0)
+ W $$FTG^%ZISH("/home/vademo2/","QRDA_CategoryI_WorldVistA1.xml",$NA(@C0CXMLIN@(1)),3)
+"RTN","C0CMXML",83,0)
+ D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
+"RTN","C0CMXML",84,0)
+ K @C0CXMLIN
+"RTN","C0CMXML",85,0)
+ S GTMP(1)="<"_$P(GTMP(1),"<",2)
+"RTN","C0CMXML",86,0)
+ M @C0CXMLIN=GTMP
+"RTN","C0CMXML",87,0)
+ K GTMP
+"RTN","C0CMXML",88,0)
+ D TESTQ2
+"RTN","C0CMXML",89,0)
  Q
-"RTN","C0CMXML",46,0)
- ;
-"RTN","C0CMXML",47,0)
-TEST3 
-"RTN","C0CMXML",48,0)
+"RTN","C0CMXML",90,0)
+ ;
+"RTN","C0CMXML",91,0)
+TESTQ2 ; SECOND PART OF TESTQ
+"RTN","C0CMXML",92,0)
+ D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN)
+"RTN","C0CMXML",93,0)
+ K @C0CXMLIN
+"RTN","C0CMXML",94,0)
+ M @C0CXMLIN=GTMP
+"RTN","C0CMXML",95,0)
+ K GTMP
+"RTN","C0CMXML",96,0)
+ S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID
+"RTN","C0CMXML",97,0)
+ S REDUX="//ClinicalDocument/component/structuredBody"
+"RTN","C0CMXML",98,0)
+ D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS
+"RTN","C0CMXML",99,0)
+ D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS
+"RTN","C0CMXML",100,0)
+ D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS
+"RTN","C0CMXML",101,0)
+ D XPATH(1,"/","GIDX","GARY",,REDUX)
+"RTN","C0CMXML",102,0)
+ K C0CCBK("TAG")
+"RTN","C0CMXML",103,0)
+ D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING
+"RTN","C0CMXML",104,0)
+ D TEST3A
+"RTN","C0CMXML",105,0)
+ Q
+"RTN","C0CMXML",106,0)
+ ;
+"RTN","C0CMXML",107,0)
+TEST4 ; TEST OF OUTPUTING AN XML FILE FROM THE DOM .. this one is the CCR
+"RTN","C0CMXML",108,0)
+ ;
+"RTN","C0CMXML",109,0)
+ D TEST ; SET UP THE DOM
+"RTN","C0CMXML",110,0)
+ D START^C0CMXMLB($$TAG(1),,"G")
+"RTN","C0CMXML",111,0)
+ D NDOUT($$FIRST(1))
+"RTN","C0CMXML",112,0)
+ D END^C0CMXMLB ;END THE DOCUMENT
+"RTN","C0CMXML",113,0)
+ M ZCCR=^TMP("MXMLBLD",$J)
+"RTN","C0CMXML",114,0)
+ ; ZWR ZCCR
+"RTN","C0CMXML",115,0)
+ Q
+"RTN","C0CMXML",116,0)
+ ;
+"RTN","C0CMXML",117,0)
+TEST5 ; SAME AS TEST4, BUT THIS TIME THE CCD
+"RTN","C0CMXML",118,0)
  S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
-"RTN","C0CMXML",49,0)
+"RTN","C0CMXML",119,0)
  K GARY,GTMP,GIDX
-"RTN","C0CMXML",50,0)
+"RTN","C0CMXML",120,0)
  K @C0CXMLIN
-"RTN","C0CMXML",51,0)
+"RTN","C0CMXML",121,0)
  W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3)
-"RTN","C0CMXML",52,0)
+"RTN","C0CMXML",122,0)
  D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
-"RTN","C0CMXML",53,0)
+"RTN","C0CMXML",123,0)
  K @C0CXMLIN
-"RTN","C0CMXML",54,0)
+"RTN","C0CMXML",124,0)
  M @C0CXMLIN=GTMP
-"RTN","C0CMXML",55,0)
+"RTN","C0CMXML",125,0)
  K GTMP
-"RTN","C0CMXML",56,0)
+"RTN","C0CMXML",126,0)
  D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN)
-"RTN","C0CMXML",57,0)
+"RTN","C0CMXML",127,0)
  K @C0CXMLIN
-"RTN","C0CMXML",58,0)
+"RTN","C0CMXML",128,0)
  M @C0CXMLIN=GTMP
-"RTN","C0CMXML",59,0)
+"RTN","C0CMXML",129,0)
  K GTMP
-"RTN","C0CMXML",60,0)
- S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID
-"RTN","C0CMXML",61,0)
- S REDUX="//ClinicalDocument/component/structuredBody"
-"RTN","C0CMXML",62,0)
- D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS
-"RTN","C0CMXML",63,0)
- D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS
-"RTN","C0CMXML",64,0)
- D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS
-"RTN","C0CMXML",65,0)
- D XPATH(1,"/","GIDX","GARY",,REDUX)
-"RTN","C0CMXML",66,0)
- K C0CCBK("TAG")
-"RTN","C0CMXML",67,0)
- D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING
-"RTN","C0CMXML",68,0)
- D TEST3A
-"RTN","C0CMXML",69,0)
+"RTN","C0CMXML",130,0)
+ S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DOCID: ",C0CDOCID  ;CALL REGULAR PARSER
+"RTN","C0CMXML",131,0)
+ ;D XPATH(1,"/","GIDX2","GARY2",,REDUX)
+"RTN","C0CMXML",132,0)
+ D OUTXML("ZCCD",C0CDOCID)
+"RTN","C0CMXML",133,0)
+ ;D START^C0CMXMLB($$TAG(1),,"G")
+"RTN","C0CMXML",134,0)
+ ;D NDOUT($$FIRST(1))
+"RTN","C0CMXML",135,0)
+ ;D END^C0CMXMLB ;EOND THE DOCUMENT
+"RTN","C0CMXML",136,0)
+ ;M ZCCD=^TMP("MXMLBLD",$J)
+"RTN","C0CMXML",137,0)
+ ; ZWR ZCCD(1:30)
+"RTN","C0CMXML",138,0)
  Q
-"RTN","C0CMXML",70,0)
- ;
-"RTN","C0CMXML",71,0)
-TEST3A ; INTERNAL ROUTINE
-"RTN","C0CMXML",72,0)
- S ZI=""
-"RTN","C0CMXML",73,0)
- F  S ZI=$O(GARY2(ZI)) Q:ZI=""  D  ;
-"RTN","C0CMXML",74,0)
- . N GTMP,G2
-"RTN","C0CMXML",75,0)
- . M G2=GARY2(ZI)
-"RTN","C0CMXML",76,0)
- . D DEMUX2^C0CMXP("GTMP","G2",2)
-"RTN","C0CMXML",77,0)
- . M GARY4(ZI)=GTMP
-"RTN","C0CMXML",78,0)
+"RTN","C0CMXML",139,0)
+ ; 
+"RTN","C0CMXML",140,0)
+XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
+"RTN","C0CMXML",141,0)
+ ; THE XPATH INDEX ZXIDX, PASSED BY NAME
+"RTN","C0CMXML",142,0)
+ ; THE XPATH ARRAY XPARY, PASSED BY NAME
+"RTN","C0CMXML",143,0)
+ ; ZOID IS THE STARTING OID
+"RTN","C0CMXML",144,0)
+ ; ZPATH IS THE STARTING XPATH, USUALLY "/"
+"RTN","C0CMXML",145,0)
+ ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
+"RTN","C0CMXML",146,0)
+ ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
+"RTN","C0CMXML",147,0)
+ I $G(ZREDUX)="" S ZREDUX=""
+"RTN","C0CMXML",148,0)
+ N NEWPATH
+"RTN","C0CMXML",149,0)
+ N NEWNUM S NEWNUM=""
+"RTN","C0CMXML",150,0)
+ I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
+"RTN","C0CMXML",151,0)
+ S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
+"RTN","C0CMXML",152,0)
+ I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
+"RTN","C0CMXML",153,0)
+ . N GT S GT=$P(NEWPATH,ZREDUX,2)
+"RTN","C0CMXML",154,0)
+ . I GT'="" S NEWPATH=GT
+"RTN","C0CMXML",155,0)
+ S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
+"RTN","C0CMXML",156,0)
+ N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
+"RTN","C0CMXML",157,0)
+ I $D(GD(2)) M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
+"RTN","C0CMXML",158,0)
+ E  I $D(GD(1)) S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
+"RTN","C0CMXML",159,0)
+ N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
+"RTN","C0CMXML",160,0)
+ I ZFRST'=0 D  ; THERE IS A CHILD
+"RTN","C0CMXML",161,0)
+ . N ZNUM
+"RTN","C0CMXML",162,0)
+ . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
+"RTN","C0CMXML",163,0)
+ . D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD
+"RTN","C0CMXML",164,0)
+ N GNXT S GNXT=$$NXTSIB(ZOID)
+"RTN","C0CMXML",165,0)
+ I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
+"RTN","C0CMXML",166,0)
+ I GNXT'=0 D  ;
+"RTN","C0CMXML",167,0)
+ . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
+"RTN","C0CMXML",168,0)
+ . I (ZNUM="")&(ZMULT) D  ; SIBLING IS FIRST OF MULTIPLES
+"RTN","C0CMXML",169,0)
+ . . N ZNUM S ZNUM=1 ;
+"RTN","C0CMXML",170,0)
+ . . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
+"RTN","C0CMXML",171,0)
+ . E  D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB
+"RTN","C0CMXML",172,0)
  Q
-"RTN","C0CMXML",79,0)
- ;
-"RTN","C0CMXML",80,0)
-TESTQ ; TEST OF THE QRDA TEMPLATE GPL 7/8/2010
-"RTN","C0CMXML",81,0)
- S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
-"RTN","C0CMXML",82,0)
- K GARY,GTMP,GIDX
-"RTN","C0CMXML",83,0)
- K @C0CXMLIN
-"RTN","C0CMXML",84,0)
- W $$FTG^%ZISH("/home/vademo2/","QRDA_CategoryI_WorldVistA1.xml",$NA(@C0CXMLIN@(1)),3)
-"RTN","C0CMXML",85,0)
- D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
-"RTN","C0CMXML",86,0)
- K @C0CXMLIN
-"RTN","C0CMXML",87,0)
- S GTMP(1)="<"_$P(GTMP(1),"<",2)
-"RTN","C0CMXML",88,0)
- M @C0CXMLIN=GTMP
-"RTN","C0CMXML",89,0)
- K GTMP
-"RTN","C0CMXML",90,0)
- D TESTQ2
-"RTN","C0CMXML",91,0)
+"RTN","C0CMXML",173,0)
+ ;
+"RTN","C0CMXML",174,0)
+PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
+"RTN","C0CMXML",175,0)
+ ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
+"RTN","C0CMXML",176,0)
+ ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
+"RTN","C0CMXML",177,0)
+ ;Q $$EN^MXMLDOM(INXML)
+"RTN","C0CMXML",178,0)
+ Q $$EN^MXMLDOM(INXML,"W")
+"RTN","C0CMXML",179,0)
+ ;
+"RTN","C0CMXML",180,0)
+ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
+"RTN","C0CMXML",181,0)
+ N ZN
+"RTN","C0CMXML",182,0)
+ ;I $$TAG(ZOID)["entry" B
+"RTN","C0CMXML",183,0)
+ S ZN=$$NXTSIB(ZOID)
+"RTN","C0CMXML",184,0)
+ I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
+"RTN","C0CMXML",185,0)
+ Q 0
+"RTN","C0CMXML",186,0)
+ ;
+"RTN","C0CMXML",187,0)
+FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
+"RTN","C0CMXML",188,0)
+ Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
+"RTN","C0CMXML",189,0)
+ ;
+"RTN","C0CMXML",190,0)
+PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
+"RTN","C0CMXML",191,0)
+ Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
+"RTN","C0CMXML",192,0)
+ ;
+"RTN","C0CMXML",193,0)
+ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
+"RTN","C0CMXML",194,0)
+ S HANDLE=C0CDOCID
+"RTN","C0CMXML",195,0)
+ K @RTN
+"RTN","C0CMXML",196,0)
+ D GETTXT^MXMLDOM("A")
+"RTN","C0CMXML",197,0)
  Q
-"RTN","C0CMXML",92,0)
- ;
-"RTN","C0CMXML",93,0)
-TESTQ2 ; SECOND PART OF TESTQ
-"RTN","C0CMXML",94,0)
- D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN)
-"RTN","C0CMXML",95,0)
- K @C0CXMLIN
-"RTN","C0CMXML",96,0)
- M @C0CXMLIN=GTMP
-"RTN","C0CMXML",97,0)
- K GTMP
-"RTN","C0CMXML",98,0)
- S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID
-"RTN","C0CMXML",99,0)
- S REDUX="//ClinicalDocument/component/structuredBody"
-"RTN","C0CMXML",100,0)
- D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS
-"RTN","C0CMXML",101,0)
- D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS
-"RTN","C0CMXML",102,0)
- D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS
-"RTN","C0CMXML",103,0)
- D XPATH(1,"/","GIDX","GARY",,REDUX)
-"RTN","C0CMXML",104,0)
- K C0CCBK("TAG")
-"RTN","C0CMXML",105,0)
- D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING
-"RTN","C0CMXML",106,0)
- D TEST3A
-"RTN","C0CMXML",107,0)
+"RTN","C0CMXML",198,0)
+ ;
+"RTN","C0CMXML",199,0)
+TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
+"RTN","C0CMXML",200,0)
+ ;I ZOID=149 B ;GPLTEST
+"RTN","C0CMXML",201,0)
+ N X,Y
+"RTN","C0CMXML",202,0)
+ S Y=""
+"RTN","C0CMXML",203,0)
+ S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
+"RTN","C0CMXML",204,0)
+ I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
+"RTN","C0CMXML",205,0)
+ I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
+"RTN","C0CMXML",206,0)
+ Q Y
+"RTN","C0CMXML",207,0)
+ ;
+"RTN","C0CMXML",208,0)
+NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
+"RTN","C0CMXML",209,0)
+ Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
+"RTN","C0CMXML",210,0)
+ ;
+"RTN","C0CMXML",211,0)
+DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
+"RTN","C0CMXML",212,0)
+ ;N ZT,ZN S ZT=""
+"RTN","C0CMXML",213,0)
+ ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
+"RTN","C0CMXML",214,0)
+ ;Q $G(@C0CDOM@(ZOID,"T",1))
+"RTN","C0CMXML",215,0)
+ S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
+"RTN","C0CMXML",216,0)
  Q
-"RTN","C0CMXML",108,0)
- ;
-"RTN","C0CMXML",109,0)
-TEST4 ; TEST OF OUTPUTING AN XML FILE FROM THE DOM .. this one is the CCR
-"RTN","C0CMXML",110,0)
- ;
-"RTN","C0CMXML",111,0)
- D TEST ; SET UP THE DOM
-"RTN","C0CMXML",112,0)
+"RTN","C0CMXML",217,0)
+ ;
+"RTN","C0CMXML",218,0)
+OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
+"RTN","C0CMXML",219,0)
+ ;
+"RTN","C0CMXML",220,0)
+ S C0CDOCID=INID
+"RTN","C0CMXML",221,0)
  D START^C0CMXMLB($$TAG(1),,"G")
-"RTN","C0CMXML",113,0)
+"RTN","C0CMXML",222,0)
  D NDOUT($$FIRST(1))
-"RTN","C0CMXML",114,0)
+"RTN","C0CMXML",223,0)
  D END^C0CMXMLB ;END THE DOCUMENT
-"RTN","C0CMXML",115,0)
- M ZCCR=^TMP("MXMLBLD",$J)
-"RTN","C0CMXML",116,0)
- ZWR ZCCR
-"RTN","C0CMXML",117,0)
+"RTN","C0CMXML",224,0)
+ M @ZRTN=^TMP("MXMLBLD",$J)
+"RTN","C0CMXML",225,0)
+ K ^TMP("MXMLBLD",$J)
+"RTN","C0CMXML",226,0)
  Q
-"RTN","C0CMXML",118,0)
- ;
-"RTN","C0CMXML",119,0)
-TEST5 ; SAME AS TEST4, BUT THIS TIME THE CCD
-"RTN","C0CMXML",120,0)
- S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
-"RTN","C0CMXML",121,0)
- K GARY,GTMP,GIDX
-"RTN","C0CMXML",122,0)
- K @C0CXMLIN
-"RTN","C0CMXML",123,0)
- W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3)
-"RTN","C0CMXML",124,0)
- D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
-"RTN","C0CMXML",125,0)
- K @C0CXMLIN
-"RTN","C0CMXML",126,0)
- M @C0CXMLIN=GTMP
-"RTN","C0CMXML",127,0)
- K GTMP
-"RTN","C0CMXML",128,0)
- D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN)
-"RTN","C0CMXML",129,0)
- K @C0CXMLIN
-"RTN","C0CMXML",130,0)
- M @C0CXMLIN=GTMP
-"RTN","C0CMXML",131,0)
- K GTMP
-"RTN","C0CMXML",132,0)
- S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DOCID: ",C0CDOCID  ;CALL REGULAR PARSER
-"RTN","C0CMXML",133,0)
- ;D XPATH(1,"/","GIDX2","GARY2",,REDUX)
-"RTN","C0CMXML",134,0)
- D OUTXML("ZCCD",C0CDOCID)
-"RTN","C0CMXML",135,0)
- ;D START^C0CMXMLB($$TAG(1),,"G")
-"RTN","C0CMXML",136,0)
- ;D NDOUT($$FIRST(1))
-"RTN","C0CMXML",137,0)
- ;D END^C0CMXMLB ;EOND THE DOCUMENT
-"RTN","C0CMXML",138,0)
- ;M ZCCD=^TMP("MXMLBLD",$J)
-"RTN","C0CMXML",139,0)
- ZWR ZCCD(1:30)
-"RTN","C0CMXML",140,0)
+"RTN","C0CMXML",227,0)
+ ;
+"RTN","C0CMXML",228,0)
+NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
+"RTN","C0CMXML",229,0)
+ N ZI S ZI=$$FIRST(ZOID)
+"RTN","C0CMXML",230,0)
+ I ZI'=0 D  ; THERE IS A CHILD
+"RTN","C0CMXML",231,0)
+ . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
+"RTN","C0CMXML",232,0)
+ . D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN
+"RTN","C0CMXML",233,0)
+ E  D  ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
+"RTN","C0CMXML",234,0)
+ . ;W "DOING",ZOID,!
+"RTN","C0CMXML",235,0)
+ . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
+"RTN","C0CMXML",236,0)
+ . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
+"RTN","C0CMXML",237,0)
+ . D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
+"RTN","C0CMXML",238,0)
+ I $$NXTSIB(ZOID)'=0 D  ; THERE IS A SIBLING
+"RTN","C0CMXML",239,0)
+ . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
+"RTN","C0CMXML",240,0)
  Q
-"RTN","C0CMXML",141,0)
- ; 
-"RTN","C0CMXML",142,0)
-XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
-"RTN","C0CMXML",143,0)
- ; THE XPATH INDEX ZXIDX, PASSED BY NAME
-"RTN","C0CMXML",144,0)
- ; THE XPATH ARRAY XPARY, PASSED BY NAME
-"RTN","C0CMXML",145,0)
- ; ZOID IS THE STARTING OID
-"RTN","C0CMXML",146,0)
- ; ZPATH IS THE STARTING XPATH, USUALLY "/"
-"RTN","C0CMXML",147,0)
- ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
-"RTN","C0CMXML",148,0)
- ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
-"RTN","C0CMXML",149,0)
- I $G(ZREDUX)="" S ZREDUX=""
-"RTN","C0CMXML",150,0)
- N NEWPATH
-"RTN","C0CMXML",151,0)
- N NEWNUM S NEWNUM=""
-"RTN","C0CMXML",152,0)
- I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
-"RTN","C0CMXML",153,0)
- S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
-"RTN","C0CMXML",154,0)
- I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
-"RTN","C0CMXML",155,0)
- . N GT S GT=$P(NEWPATH,ZREDUX,2)
-"RTN","C0CMXML",156,0)
- . I GT'="" S NEWPATH=GT
-"RTN","C0CMXML",157,0)
- S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
-"RTN","C0CMXML",158,0)
- N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
-"RTN","C0CMXML",159,0)
- I $D(GD(2)) M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
-"RTN","C0CMXML",160,0)
- E  I $D(GD(1)) S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
-"RTN","C0CMXML",161,0)
- N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
-"RTN","C0CMXML",162,0)
- I ZFRST'=0 D  ; THERE IS A CHILD
-"RTN","C0CMXML",163,0)
- . N ZNUM
-"RTN","C0CMXML",164,0)
- . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
-"RTN","C0CMXML",165,0)
- . D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD
-"RTN","C0CMXML",166,0)
- N GNXT S GNXT=$$NXTSIB(ZOID)
-"RTN","C0CMXML",167,0)
- I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
-"RTN","C0CMXML",168,0)
- I GNXT'=0 D  ;
-"RTN","C0CMXML",169,0)
- . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
-"RTN","C0CMXML",170,0)
- . I (ZNUM="")&(ZMULT) D  ; SIBLING IS FIRST OF MULTIPLES
-"RTN","C0CMXML",171,0)
- . . N ZNUM S ZNUM=1 ;
-"RTN","C0CMXML",172,0)
- . . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
-"RTN","C0CMXML",173,0)
- . E  D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB
-"RTN","C0CMXML",174,0)
+"RTN","C0CMXML",241,0)
+ ;
+"RTN","C0CMXML",242,0)
+UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+"RTN","C0CMXML",243,0)
+ K ZERR
+"RTN","C0CMXML",244,0)
+ D CLEAN^DILF
+"RTN","C0CMXML",245,0)
+ D UPDATE^DIE("","C0CFDA","","ZERR")
+"RTN","C0CMXML",246,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CMXML",247,0)
+ K C0CFDA
+"RTN","C0CMXML",248,0)
  Q
-"RTN","C0CMXML",175,0)
- ;
-"RTN","C0CMXML",176,0)
-PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
-"RTN","C0CMXML",177,0)
- ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
-"RTN","C0CMXML",178,0)
- ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
-"RTN","C0CMXML",179,0)
- ;Q $$EN^MXMLDOM(INXML)
-"RTN","C0CMXML",180,0)
- Q $$EN^MXMLDOM(INXML,"W")
-"RTN","C0CMXML",181,0)
- ;
-"RTN","C0CMXML",182,0)
-ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
-"RTN","C0CMXML",183,0)
- N ZN
-"RTN","C0CMXML",184,0)
- ;I $$TAG(ZOID)["entry" B
-"RTN","C0CMXML",185,0)
- S ZN=$$NXTSIB(ZOID)
-"RTN","C0CMXML",186,0)
- I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
-"RTN","C0CMXML",187,0)
- Q 0
-"RTN","C0CMXML",188,0)
- ;
-"RTN","C0CMXML",189,0)
-FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
-"RTN","C0CMXML",190,0)
- Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CMXML",191,0)
- ;
-"RTN","C0CMXML",192,0)
-PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
-"RTN","C0CMXML",193,0)
- Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CMXML",194,0)
- ;
-"RTN","C0CMXML",195,0)
-ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
-"RTN","C0CMXML",196,0)
- S HANDLE=C0CDOCID
-"RTN","C0CMXML",197,0)
- K @RTN
-"RTN","C0CMXML",198,0)
- D GETTXT^MXMLDOM("A")
-"RTN","C0CMXML",199,0)
- Q
-"RTN","C0CMXML",200,0)
- ;
-"RTN","C0CMXML",201,0)
-TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
-"RTN","C0CMXML",202,0)
- ;I ZOID=149 B ;GPLTEST
-"RTN","C0CMXML",203,0)
- N X,Y
-"RTN","C0CMXML",204,0)
- S Y=""
-"RTN","C0CMXML",205,0)
- S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
-"RTN","C0CMXML",206,0)
- I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
-"RTN","C0CMXML",207,0)
- I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CMXML",208,0)
- Q Y
-"RTN","C0CMXML",209,0)
- ;
-"RTN","C0CMXML",210,0)
-NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
-"RTN","C0CMXML",211,0)
- Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CMXML",212,0)
- ;
-"RTN","C0CMXML",213,0)
-DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
-"RTN","C0CMXML",214,0)
- ;N ZT,ZN S ZT=""
-"RTN","C0CMXML",215,0)
- ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
-"RTN","C0CMXML",216,0)
- ;Q $G(@C0CDOM@(ZOID,"T",1))
-"RTN","C0CMXML",217,0)
- S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
-"RTN","C0CMXML",218,0)
- Q
-"RTN","C0CMXML",219,0)
- ;
-"RTN","C0CMXML",220,0)
-OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
-"RTN","C0CMXML",221,0)
- ;
-"RTN","C0CMXML",222,0)
- S C0CDOCID=INID
-"RTN","C0CMXML",223,0)
- D START^C0CMXMLB($$TAG(1),,"G")
-"RTN","C0CMXML",224,0)
- D NDOUT($$FIRST(1))
-"RTN","C0CMXML",225,0)
- D END^C0CMXMLB ;END THE DOCUMENT
-"RTN","C0CMXML",226,0)
- M @ZRTN=^TMP("MXMLBLD",$J)
-"RTN","C0CMXML",227,0)
- K ^TMP("MXMLBLD",$J)
-"RTN","C0CMXML",228,0)
- Q
-"RTN","C0CMXML",229,0)
- ;
-"RTN","C0CMXML",230,0)
-NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
-"RTN","C0CMXML",231,0)
- N ZI S ZI=$$FIRST(ZOID)
-"RTN","C0CMXML",232,0)
- I ZI'=0 D  ; THERE IS A CHILD
-"RTN","C0CMXML",233,0)
- . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
-"RTN","C0CMXML",234,0)
- . D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN
-"RTN","C0CMXML",235,0)
- E  D  ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
-"RTN","C0CMXML",236,0)
- . ;W "DOING",ZOID,!
-"RTN","C0CMXML",237,0)
- . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
-"RTN","C0CMXML",238,0)
- . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
-"RTN","C0CMXML",239,0)
- . D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
-"RTN","C0CMXML",240,0)
- I $$NXTSIB(ZOID)'=0 D  ; THERE IS A SIBLING
-"RTN","C0CMXML",241,0)
- . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
-"RTN","C0CMXML",242,0)
- Q
-"RTN","C0CMXML",243,0)
- ;
-"RTN","C0CMXML",244,0)
-UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
-"RTN","C0CMXML",245,0)
- K ZERR
-"RTN","C0CMXML",246,0)
- D CLEAN^DILF
-"RTN","C0CMXML",247,0)
- D UPDATE^DIE("","C0CFDA","","ZERR")
-"RTN","C0CMXML",248,0)
- I $D(ZERR) D  ;
 "RTN","C0CMXML",249,0)
- . W "ERROR",!
-"RTN","C0CMXML",250,0)
- . ZWR ZERR
-"RTN","C0CMXML",251,0)
- . B
-"RTN","C0CMXML",252,0)
- K C0CFDA
-"RTN","C0CMXML",253,0)
- Q
-"RTN","C0CMXML",254,0)
  ;
 "RTN","C0CMXMLB")
-0^87^B12065941
+0^87^B12346525
 "RTN","C0CMXMLB",1,0)
 C0CMXMLB ;;ISF/RWF - Tool to build XML ; 5/10/12 2:51pm
 "RTN","C0CMXMLB",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CMXMLB",3,0)
  QUIT
@@ -110726,3971 +110692,4011 @@
  ;
 "RTN","C0CMXMLB",5,0)
+ ; FOIA Routine - Public Domain
+"RTN","C0CMXMLB",6,0)
+ ;
+"RTN","C0CMXMLB",7,0)
  ;DOC - The top level tag
-"RTN","C0CMXMLB",6,0)
+"RTN","C0CMXMLB",8,0)
  ;DOCTYPE - Want to include a DOCTYPE node
-"RTN","C0CMXMLB",7,0)
+"RTN","C0CMXMLB",9,0)
  ;FLAG - Set to 'G' to store the output in the global ^TMP("MXMLBLD",$J,
-"RTN","C0CMXMLB",8,0)
+"RTN","C0CMXMLB",10,0)
 START(DOC,DOCTYPE,FLAG,NO1ST) ;Call this once at the begining.
-"RTN","C0CMXMLB",9,0)
+"RTN","C0CMXMLB",11,0)
  K ^TMP("MXMLBLD",$J)
-"RTN","C0CMXMLB",10,0)
+"RTN","C0CMXMLB",12,0)
  S ^TMP("MXMLBLD",$J,"DOC")=DOC,^TMP("MXMLBLD",$J,"STK")=0
-"RTN","C0CMXMLB",11,0)
+"RTN","C0CMXMLB",13,0)
  I $G(FLAG)["G" S ^TMP("MXMLBLD",$J,"CNT")=1
-"RTN","C0CMXMLB",12,0)
- I $G(NO1ST)'=1 D OUTPUT($$XMLHDR) 
-"RTN","C0CMXMLB",13,0)
+"RTN","C0CMXMLB",14,0)
+ I $G(NO1ST)'=1 D OUTPUT($$XMLHDR)
+"RTN","C0CMXMLB",15,0)
  D:$L($G(DOCTYPE)) OUTPUT("<!DOCTYPE "_DOCTYPE_">") D OUTPUT("<"_DOC_">")
-"RTN","C0CMXMLB",14,0)
+"RTN","C0CMXMLB",16,0)
  Q
-"RTN","C0CMXMLB",15,0)
- ;
-"RTN","C0CMXMLB",16,0)
+"RTN","C0CMXMLB",17,0)
+ ;
+"RTN","C0CMXMLB",18,0)
 END ;Call this once to close out the document
-"RTN","C0CMXMLB",17,0)
+"RTN","C0CMXMLB",19,0)
  D OUTPUT("</"_$G(^TMP("MXMLBLD",$J,"DOC"))_">")
-"RTN","C0CMXMLB",18,0)
+"RTN","C0CMXMLB",20,0)
  I '$G(^TMP("MXMLBLD",$J,"CNT")) K ^TMP("MXMLBLD",$J)
-"RTN","C0CMXMLB",19,0)
+"RTN","C0CMXMLB",21,0)
  K ^TMP("MXMLBLD",$J,"DOC"),^("CNT"),^("STK")
-"RTN","C0CMXMLB",20,0)
+"RTN","C0CMXMLB",22,0)
  Q
-"RTN","C0CMXMLB",21,0)
- ;
-"RTN","C0CMXMLB",22,0)
+"RTN","C0CMXMLB",23,0)
+ ;
+"RTN","C0CMXMLB",24,0)
 ITEM(INDENT,TAG,ATT,VALUE) ;Output a Item
-"RTN","C0CMXMLB",23,0)
+"RTN","C0CMXMLB",25,0)
  N I,X
-"RTN","C0CMXMLB",24,0)
+"RTN","C0CMXMLB",26,0)
  S ATT=$G(ATT)
-"RTN","C0CMXMLB",25,0)
+"RTN","C0CMXMLB",27,0)
  I '$D(VALUE) D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_" />") Q
-"RTN","C0CMXMLB",26,0)
+"RTN","C0CMXMLB",28,0)
  D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">"_$$CHARCHK(VALUE)_"</"_TAG_">")
-"RTN","C0CMXMLB",27,0)
+"RTN","C0CMXMLB",29,0)
  Q
-"RTN","C0CMXMLB",28,0)
+"RTN","C0CMXMLB",30,0)
  ;DOITEM is a callback to output the lower level.
-"RTN","C0CMXMLB",29,0)
+"RTN","C0CMXMLB",31,0)
 MULTI(INDENT,TAG,ATT,DOITEM) ;Output a Multipule
-"RTN","C0CMXMLB",30,0)
+"RTN","C0CMXMLB",32,0)
  N I,X,S
-"RTN","C0CMXMLB",31,0)
+"RTN","C0CMXMLB",33,0)
  S ATT=$G(ATT)
-"RTN","C0CMXMLB",32,0)
+"RTN","C0CMXMLB",34,0)
  D PUSH($G(INDENT),TAG,.ATT)
-"RTN","C0CMXMLB",33,0)
+"RTN","C0CMXMLB",35,0)
  D @DOITEM
-"RTN","C0CMXMLB",34,0)
+"RTN","C0CMXMLB",36,0)
  D POP
-"RTN","C0CMXMLB",35,0)
+"RTN","C0CMXMLB",37,0)
  Q
-"RTN","C0CMXMLB",36,0)
- ;
-"RTN","C0CMXMLB",37,0)
+"RTN","C0CMXMLB",38,0)
+ ;
+"RTN","C0CMXMLB",39,0)
 ATT(ATT) ;Output a string of attributes
-"RTN","C0CMXMLB",38,0)
+"RTN","C0CMXMLB",40,0)
  I $D(ATT)<9 Q ""
-"RTN","C0CMXMLB",39,0)
+"RTN","C0CMXMLB",41,0)
  N I,S,V
-"RTN","C0CMXMLB",40,0)
+"RTN","C0CMXMLB",42,0)
  S S="",I=""
-"RTN","C0CMXMLB",41,0)
+"RTN","C0CMXMLB",43,0)
  F  S I=$O(ATT(I)) Q:I=""  S S=S_" "_I_"="_$$Q(ATT(I))
-"RTN","C0CMXMLB",42,0)
+"RTN","C0CMXMLB",44,0)
  Q S
-"RTN","C0CMXMLB",43,0)
- ;
-"RTN","C0CMXMLB",44,0)
+"RTN","C0CMXMLB",45,0)
+ ;
+"RTN","C0CMXMLB",46,0)
 Q(X) ;Add Quotes - Changed by gpl to use single instead of double quotes 6/11
-"RTN","C0CMXMLB",45,0)
+"RTN","C0CMXMLB",47,0)
  ;I X'[$C(34) Q $C(34)_X_$C(34)
-"RTN","C0CMXMLB",46,0)
+"RTN","C0CMXMLB",48,0)
  I X'[$C(39) Q $C(39)_X_$C(39)
-"RTN","C0CMXMLB",47,0)
+"RTN","C0CMXMLB",49,0)
  ;N Q,Y,I,Z S Q=$C(34),(Y,Z)=""
-"RTN","C0CMXMLB",48,0)
+"RTN","C0CMXMLB",50,0)
  N Q,Y,I,Z S Q=$C(39),(Y,Z)=""
-"RTN","C0CMXMLB",49,0)
+"RTN","C0CMXMLB",51,0)
  F I=1:1:$L(X,Q)-1 S Y=Y_$P(X,Q,I)_Q_Q
-"RTN","C0CMXMLB",50,0)
+"RTN","C0CMXMLB",52,0)
  S Y=Y_$P(X,Q,$L(X,Q))
-"RTN","C0CMXMLB",51,0)
+"RTN","C0CMXMLB",53,0)
  ;Q $C(34)_Y_$C(34)
-"RTN","C0CMXMLB",52,0)
+"RTN","C0CMXMLB",54,0)
  Q $C(39)_Y_$C(39)
-"RTN","C0CMXMLB",53,0)
- ;
-"RTN","C0CMXMLB",54,0)
+"RTN","C0CMXMLB",55,0)
+ ;
+"RTN","C0CMXMLB",56,0)
 XMLHDR() ; -- provides current XML standard header
-"RTN","C0CMXMLB",55,0)
+"RTN","C0CMXMLB",57,0)
  Q "<?xml version=""1.0"" encoding=""utf-8"" ?>"
-"RTN","C0CMXMLB",56,0)
- ;
-"RTN","C0CMXMLB",57,0)
+"RTN","C0CMXMLB",58,0)
+ ;
+"RTN","C0CMXMLB",59,0)
 OUTPUT(S) ;Output
-"RTN","C0CMXMLB",58,0)
+"RTN","C0CMXMLB",60,0)
  N C S C=$G(^TMP("MXMLBLD",$J,"CNT"))
-"RTN","C0CMXMLB",59,0)
+"RTN","C0CMXMLB",61,0)
  I C S ^TMP("MXMLBLD",$J,C)=S,^TMP("MXMLBLD",$J,"CNT")=C+1 Q
-"RTN","C0CMXMLB",60,0)
+"RTN","C0CMXMLB",62,0)
  W S,!
-"RTN","C0CMXMLB",61,0)
+"RTN","C0CMXMLB",63,0)
  Q
-"RTN","C0CMXMLB",62,0)
- ;
-"RTN","C0CMXMLB",63,0)
+"RTN","C0CMXMLB",64,0)
+ ;
+"RTN","C0CMXMLB",65,0)
 CHARCHK(STR) ; -- replace xml character limits with entities
-"RTN","C0CMXMLB",64,0)
+"RTN","C0CMXMLB",66,0)
  N A,I,X,Y,Z,NEWSTR
-"RTN","C0CMXMLB",65,0)
+"RTN","C0CMXMLB",67,0)
  S (Y,Z)=""
-"RTN","C0CMXMLB",66,0)
+"RTN","C0CMXMLB",68,0)
  ;IF STR["&" SET NEWSTR=STR DO  SET STR=Y_Z
-"RTN","C0CMXMLB",67,0)
+"RTN","C0CMXMLB",69,0)
  ;. FOR X=1:1  SET Y=Y_$PIECE(NEWSTR,"&",X)_"&amp;",Z=$PIECE(STR,"&",X+1,999) QUIT:Z'["&"
-"RTN","C0CMXMLB",68,0)
+"RTN","C0CMXMLB",70,0)
  I STR["&" F I=1:1:$L(STR,"&")-1 S STR=$P(STR,"&",1,I)_"&amp;"_$P(STR,"&",I+1,999)
-"RTN","C0CMXMLB",69,0)
+"RTN","C0CMXMLB",71,0)
  I STR["<" F  S STR=$PIECE(STR,"<",1)_"&lt;"_$PIECE(STR,"<",2,99) Q:STR'["<"
-"RTN","C0CMXMLB",70,0)
+"RTN","C0CMXMLB",72,0)
  I STR[">" F  S STR=$PIECE(STR,">",1)_"&gt;"_$PIECE(STR,">",2,99) Q:STR'[">"
-"RTN","C0CMXMLB",71,0)
+"RTN","C0CMXMLB",73,0)
  I STR["'" F  S STR=$PIECE(STR,"'",1)_"&apos;"_$PIECE(STR,"'",2,99) Q:STR'["'"
-"RTN","C0CMXMLB",72,0)
+"RTN","C0CMXMLB",74,0)
  I STR["""" F  S STR=$PIECE(STR,"""",1)_"&quot;"_$PIECE(STR,"""",2,99) Q:STR'[""""
-"RTN","C0CMXMLB",73,0)
- ;
-"RTN","C0CMXMLB",74,0)
+"RTN","C0CMXMLB",75,0)
+ ;
+"RTN","C0CMXMLB",76,0)
  S STR=$TR(STR,$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31))
-"RTN","C0CMXMLB",75,0)
+"RTN","C0CMXMLB",77,0)
  QUIT STR
-"RTN","C0CMXMLB",76,0)
- ;
-"RTN","C0CMXMLB",77,0)
+"RTN","C0CMXMLB",78,0)
+ ;
+"RTN","C0CMXMLB",79,0)
 COMMENT(VAL) ;Add Comments
-"RTN","C0CMXMLB",78,0)
+"RTN","C0CMXMLB",80,0)
  N I,L
-"RTN","C0CMXMLB",79,0)
+"RTN","C0CMXMLB",81,0)
  ;I $D($G(VAL))=1 D OUTPUT("<!-- "_ATT_" -->") Q
-"RTN","C0CMXMLB",80,0)
+"RTN","C0CMXMLB",82,0)
  I $D(VAL) D OUTPUT("<!-- "_ATT_" -->") Q  ;CHANGED BY GPL FOR GTM
-"RTN","C0CMXMLB",81,0)
+"RTN","C0CMXMLB",83,0)
  S I="",L="<!--"
-"RTN","C0CMXMLB",82,0)
+"RTN","C0CMXMLB",84,0)
  F  S I=$O(ATT(I)) Q:I=""  D OUTPUT(L_ATT(I)) S L=""
-"RTN","C0CMXMLB",83,0)
+"RTN","C0CMXMLB",85,0)
  D OUTPUT("-->")
-"RTN","C0CMXMLB",84,0)
+"RTN","C0CMXMLB",86,0)
  Q
-"RTN","C0CMXMLB",85,0)
- ;
-"RTN","C0CMXMLB",86,0)
+"RTN","C0CMXMLB",87,0)
+ ;
+"RTN","C0CMXMLB",88,0)
 PUSH(INDENT,TAG,ATT) ;Write a TAG and save.
-"RTN","C0CMXMLB",87,0)
+"RTN","C0CMXMLB",89,0)
  N CNT
-"RTN","C0CMXMLB",88,0)
+"RTN","C0CMXMLB",90,0)
  S ATT=$G(ATT)
-"RTN","C0CMXMLB",89,0)
+"RTN","C0CMXMLB",91,0)
  D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">")
-"RTN","C0CMXMLB",90,0)
+"RTN","C0CMXMLB",92,0)
  S CNT=$G(^TMP("MXMLBLD",$J,"STK"))+1,^TMP("MXMLBLD",$J,"STK")=CNT,^TMP("MXMLBLD",$J,"STK",CNT)=INDENT_"^"_TAG
-"RTN","C0CMXMLB",91,0)
+"RTN","C0CMXMLB",93,0)
  Q
-"RTN","C0CMXMLB",92,0)
- ;
-"RTN","C0CMXMLB",93,0)
+"RTN","C0CMXMLB",94,0)
+ ;
+"RTN","C0CMXMLB",95,0)
 POP ;Write last pushed tag and pop
-"RTN","C0CMXMLB",94,0)
+"RTN","C0CMXMLB",96,0)
  N CNT,TAG,INDENT,X
-"RTN","C0CMXMLB",95,0)
+"RTN","C0CMXMLB",97,0)
  S CNT=$G(^TMP("MXMLBLD",$J,"STK")),X=^TMP("MXMLBLD",$J,"STK",CNT),^TMP("MXMLBLD",$J,"STK")=CNT-1
-"RTN","C0CMXMLB",96,0)
+"RTN","C0CMXMLB",98,0)
  S INDENT=+X,TAG=$P(X,"^",2)
-"RTN","C0CMXMLB",97,0)
+"RTN","C0CMXMLB",99,0)
  D OUTPUT($$BLS(INDENT)_"</"_TAG_">")
-"RTN","C0CMXMLB",98,0)
+"RTN","C0CMXMLB",100,0)
  Q
-"RTN","C0CMXMLB",99,0)
- ;
-"RTN","C0CMXMLB",100,0)
+"RTN","C0CMXMLB",101,0)
+ ;
+"RTN","C0CMXMLB",102,0)
 BLS(I) ;Return INDENT string
-"RTN","C0CMXMLB",101,0)
+"RTN","C0CMXMLB",103,0)
  N S
-"RTN","C0CMXMLB",102,0)
+"RTN","C0CMXMLB",104,0)
  S S="",I=$G(I) S:I>0 $P(S," ",I)=" "
-"RTN","C0CMXMLB",103,0)
+"RTN","C0CMXMLB",105,0)
  Q S
-"RTN","C0CMXMLB",104,0)
- ;
-"RTN","C0CMXMLB",105,0)
+"RTN","C0CMXMLB",106,0)
+ ;
+"RTN","C0CMXMLB",107,0)
 INDENT() ;Renturn indent level
-"RTN","C0CMXMLB",106,0)
+"RTN","C0CMXMLB",108,0)
  Q +$G(^TMP("MXMLBLD",$J,"STK"))
 "RTN","C0CMXP")
-0^64^B77680190
+0^64^B76428333
 "RTN","C0CMXP",1,0)
 C0CMXP   ; GPL - MXML based XPath utilities;12/04/09  17:05
 "RTN","C0CMXP",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CMXP",3,0)
- ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
+ ;Copyright 2009 George Lilly.  
 "RTN","C0CMXP",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CMXP",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CMXP",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CMXP",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CMXP",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CMXP",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CMXP",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CMXP",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CMXP",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CMXP",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CMXP",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CMXP",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CMXP",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CMXP",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CMXP",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ Q
 "RTN","C0CMXP",19,0)
  ;
 "RTN","C0CMXP",20,0)
+INITXPF(ARY) ;INITIAL XML/XPATH FILE ARRAY
+"RTN","C0CMXP",21,0)
+ ; DON'T USE THIS ONE ... USE INITFARY^C0CSOAP("FARY") INSTEAD
+"RTN","C0CMXP",22,0)
+ D INITFARY^C0CSOAP(ARY) ;
+"RTN","C0CMXP",23,0)
  Q
-"RTN","C0CMXP",21,0)
- ;
-"RTN","C0CMXP",22,0)
-INITXPF(ARY) ;INITIAL XML/XPATH FILE ARRAY
-"RTN","C0CMXP",23,0)
- ; DON'T USE THIS ONE ... USE INITFARY^C0CSOAP("FARY") INSTEAD
 "RTN","C0CMXP",24,0)
- D INITFARY^C0CSOAP(ARY) ;
+ S @ARY@("XML FILE NUMBER")=178.101
 "RTN","C0CMXP",25,0)
+ S @ARY@("XML SOURCE FIELD")=2.1
+"RTN","C0CMXP",26,0)
+ S @ARY@("XML TEMPLATE FIELD")=3
+"RTN","C0CMXP",27,0)
+ S @ARY@("XPATH BINDING SUBFILE")=178.1014
+"RTN","C0CMXP",28,0)
+ S @ARY@("REDUX FIELD")=2.5
+"RTN","C0CMXP",29,0)
  Q
-"RTN","C0CMXP",26,0)
- S @ARY@("XML FILE NUMBER")=178.101
-"RTN","C0CMXP",27,0)
- S @ARY@("XML SOURCE FIELD")=2.1
-"RTN","C0CMXP",28,0)
- S @ARY@("XML TEMPLATE FIELD")=3
-"RTN","C0CMXP",29,0)
- S @ARY@("XPATH BINDING SUBFILE")=178.1014
 "RTN","C0CMXP",30,0)
- S @ARY@("REDUX FIELD")=2.5
+ ;
 "RTN","C0CMXP",31,0)
+SETXPF(ARY) ; SET FILE AND FIELD VARIABLES FROM XPF ARRAY
+"RTN","C0CMXP",32,0)
+ ;
+"RTN","C0CMXP",33,0)
+ S C0CXPF=@ARY@("XML FILE NUMBER")
+"RTN","C0CMXP",34,0)
+ S C0CXFLD=@ARY@("XML")
+"RTN","C0CMXP",35,0)
+ S C0CXTFLD=@ARY@("TEMPLATE XML")
+"RTN","C0CMXP",36,0)
+ S C0CXPBF=@ARY@("BINDING SUBFILE NUMBER")
+"RTN","C0CMXP",37,0)
+ S C0CRDUXF=@ARY@("XPATH REDUCTION STRING")
+"RTN","C0CMXP",38,0)
  Q
-"RTN","C0CMXP",32,0)
- ;
-"RTN","C0CMXP",33,0)
-SETXPF(ARY) ; SET FILE AND FIELD VARIABLES FROM XPF ARRAY
-"RTN","C0CMXP",34,0)
- ;
-"RTN","C0CMXP",35,0)
- S C0CXPF=@ARY@("XML FILE NUMBER")
-"RTN","C0CMXP",36,0)
- S C0CXFLD=@ARY@("XML")
-"RTN","C0CMXP",37,0)
- S C0CXTFLD=@ARY@("TEMPLATE XML")
-"RTN","C0CMXP",38,0)
- S C0CXPBF=@ARY@("BINDING SUBFILE NUMBER")
 "RTN","C0CMXP",39,0)
- S C0CRDUXF=@ARY@("XPATH REDUCTION STRING")
+ ;
 "RTN","C0CMXP",40,0)
+ADDXP(INARY,TID,FARY) ;ADD XPATH .01 FIELD TO BINDING SUBFILE OF TEMPLATE TID
+"RTN","C0CMXP",41,0)
+ I '$D(FARY) D  ;
+"RTN","C0CMXP",42,0)
+ . S FARY="FARY" ; FILE ARRAY
+"RTN","C0CMXP",43,0)
+ . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
+"RTN","C0CMXP",44,0)
+ D SETXPF(FARY) ;SET FILE VARIABLES
+"RTN","C0CMXP",45,0)
+ N C0CA,C0CB
+"RTN","C0CMXP",46,0)
+ S C0CA="" S C0CB=0
+"RTN","C0CMXP",47,0)
+ F  S C0CA=$O(@INARY@(C0CA)) Q:C0CA=""  D  ; FOR EACH XPATH
+"RTN","C0CMXP",48,0)
+ . S C0CB=C0CB+1 ; COUNT OF XPATHS
+"RTN","C0CMXP",49,0)
+ . S C0CFDA(C0CXPBF,"?+"_C0CB_","_TID_",",.01)=C0CA
+"RTN","C0CMXP",50,0)
+ . D UPDIE ; CREATE THE BINDING SUBFILE FOR THIS XPATH
+"RTN","C0CMXP",51,0)
  Q
-"RTN","C0CMXP",41,0)
- ;
-"RTN","C0CMXP",42,0)
-ADDXP(INARY,TID,FARY) ;ADD XPATH .01 FIELD TO BINDING SUBFILE OF TEMPLATE TID
-"RTN","C0CMXP",43,0)
+"RTN","C0CMXP",52,0)
+ ;
+"RTN","C0CMXP",53,0)
+FIXICD9 ; FIX THE ICD9RESULT XML 
+"RTN","C0CMXP",54,0)
+ D GETXML("GPL","ICD9RESULT") ; GET SOME BAD XML OUT OF THE FILE
+"RTN","C0CMXP",55,0)
+ S ZI=""
+"RTN","C0CMXP",56,0)
+ S G=""
+"RTN","C0CMXP",57,0)
+ F  S ZI=$O(GPL(ZI)) Q:ZI=""  D  ; FOR EACH LINE
+"RTN","C0CMXP",58,0)
+ . S G=G_GPL(ZI) ; MAKE ONE BIG STRING OF XML
+"RTN","C0CMXP",59,0)
+ D NORMAL^C0CSOAP("G2","G") ;NO NORMALIZE IT BACK INTO AN ARRAY
+"RTN","C0CMXP",60,0)
+ D ADDXML("G2","ICD9RESULT") ; AND PUT IT BACK
+"RTN","C0CMXP",61,0)
+ Q
+"RTN","C0CMXP",62,0)
+ADDXML(INXML,TEMPID,INFARY) ;ADD XML TO A TEMPLATE ID TEMPID
+"RTN","C0CMXP",63,0)
+ ; INXML IS PASSED BY NAME
+"RTN","C0CMXP",64,0)
+ I '$D(INFARY) D  ;
+"RTN","C0CMXP",65,0)
+ . S INFARY="FARY" ; FILE ARRAY
+"RTN","C0CMXP",66,0)
+ . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
+"RTN","C0CMXP",67,0)
+ I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME
+"RTN","C0CMXP",68,0)
+ D SETXPF(INFARY) ;SET FILE VARIABLES
+"RTN","C0CMXP",69,0)
+ D WP^DIE(C0CXPF,TEMPID_",",C0CXFLD,,INXML)
+"RTN","C0CMXP",70,0)
+ Q
+"RTN","C0CMXP",71,0)
+ ;
+"RTN","C0CMXP",72,0)
+ADDTEMP(INXML,TEMPID,INFARY) ;ADD XML TEMPLATE TO TEMPLATE RECORD TEMPID
+"RTN","C0CMXP",73,0)
+ ;
+"RTN","C0CMXP",74,0)
+ I '$D(INFARY) D  ;
+"RTN","C0CMXP",75,0)
+ . S INFARY="FARY" ; FILE ARRAY
+"RTN","C0CMXP",76,0)
+ . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
+"RTN","C0CMXP",77,0)
+ I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME
+"RTN","C0CMXP",78,0)
+ D SETXPF(INFARY) ;SET FILE VARIABLES
+"RTN","C0CMXP",79,0)
+ D WP^DIE(C0CXPF,TEMPID_",",C0CXTFLD,,INXML)
+"RTN","C0CMXP",80,0)
+ Q
+"RTN","C0CMXP",81,0)
+ ;
+"RTN","C0CMXP",82,0)
+GETXML(OUTXML,TEMPID,INFARY) ;GET THE XML FROM TEMPLATE TEMPID
+"RTN","C0CMXP",83,0)
+ ;
+"RTN","C0CMXP",84,0)
+ I '$D(INFARY) D  ;
+"RTN","C0CMXP",85,0)
+ . S INFARY="FARY" ; FILE ARRAY
+"RTN","C0CMXP",86,0)
+ . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
+"RTN","C0CMXP",87,0)
+ D SETXPF(INFARY) ;SET FILE VARIABLES
+"RTN","C0CMXP",88,0)
+ I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME
+"RTN","C0CMXP",89,0)
+ I $$GET1^DIQ(C0CXPF,TEMPID_",",C0CXFLD,,OUTXML)'=OUTXML D  Q  ;
+"RTN","C0CMXP",90,0)
+ . W "ERROR RETRIEVING TEMPLATE",!
+"RTN","C0CMXP",91,0)
+ Q
+"RTN","C0CMXP",92,0)
+ ;
+"RTN","C0CMXP",93,0)
+GETTEMP(OUTXML,TEMPID,FARY) ;GET THE TEMPLATE XML FROM TEMPLATE TEMPID
+"RTN","C0CMXP",94,0)
+ ;
+"RTN","C0CMXP",95,0)
  I '$D(FARY) D  ;
-"RTN","C0CMXP",44,0)
+"RTN","C0CMXP",96,0)
  . S FARY="FARY" ; FILE ARRAY
-"RTN","C0CMXP",45,0)
+"RTN","C0CMXP",97,0)
  . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
-"RTN","C0CMXP",46,0)
+"RTN","C0CMXP",98,0)
  D SETXPF(FARY) ;SET FILE VARIABLES
-"RTN","C0CMXP",47,0)
- N C0CA,C0CB
-"RTN","C0CMXP",48,0)
- S C0CA="" S C0CB=0
-"RTN","C0CMXP",49,0)
- F  S C0CA=$O(@INARY@(C0CA)) Q:C0CA=""  D  ; FOR EACH XPATH
-"RTN","C0CMXP",50,0)
- . S C0CB=C0CB+1 ; COUNT OF XPATHS
-"RTN","C0CMXP",51,0)
- . S C0CFDA(C0CXPBF,"?+"_C0CB_","_TID_",",.01)=C0CA
-"RTN","C0CMXP",52,0)
- . D UPDIE ; CREATE THE BINDING SUBFILE FOR THIS XPATH
-"RTN","C0CMXP",53,0)
+"RTN","C0CMXP",99,0)
+ I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,FARY) ;RESOLVE TEMPLATE NAME
+"RTN","C0CMXP",100,0)
+ I $$GET1^DIQ(C0CXPF,TEMPID_",",C0CXTFLD,,OUTXML)'=OUTXML D  Q  ;
+"RTN","C0CMXP",101,0)
+ . W "ERROR RETRIEVING TEMPLATE",!
+"RTN","C0CMXP",102,0)
  Q
-"RTN","C0CMXP",54,0)
- ;
-"RTN","C0CMXP",55,0)
-FIXICD9 ; FIX THE ICD9RESULT XML 
-"RTN","C0CMXP",56,0)
- D GETXML("GPL","ICD9RESULT") ; GET SOME BAD XML OUT OF THE FILE
-"RTN","C0CMXP",57,0)
+"RTN","C0CMXP",103,0)
+ ;
+"RTN","C0CMXP",104,0)
+COPYWP(ZFLD,ZSRCREC,ZDESTREC,ZSRCF,ZDESTF) ; COPIES A WORD PROCESSING FIELD
+"RTN","C0CMXP",105,0)
+ ; FROM ONE RECORD TO ANOTHER RECORD 
+"RTN","C0CMXP",106,0)
+ ; ZFLD IS EITHER A NUMBERIC FIELD OR A NAME IN ZSRCF
+"RTN","C0CMXP",107,0)
+ ; ZSRCF IS THE SOURCE FILE, IN FILE REDIRECT FORMAT
+"RTN","C0CMXP",108,0)
+ ; IF ZSRCF IS OMMITED, THE DEFAULT C0C XML MISC FILE WILL BE ASSUMED
+"RTN","C0CMXP",109,0)
+ ; ZDESTF IS DESTINATION FILE. IF OMMITED, IS ASSUMED TO BE THE SAME
+"RTN","C0CMXP",110,0)
+ ; A ZSRCF
+"RTN","C0CMXP",111,0)
+ I '$D(ZSRCF) D  ;
+"RTN","C0CMXP",112,0)
+ . S ZSRCF="ZSRCF"
+"RTN","C0CMXP",113,0)
+ . D INITFARY^C0CSOAP(ZSRCF)
+"RTN","C0CMXP",114,0)
+ I '$D(ZDESTF) D  ;
+"RTN","C0CMXP",115,0)
+ . S ZDESTF="ZDESTF"
+"RTN","C0CMXP",116,0)
+ . M @ZDESTF=@ZSRCF
+"RTN","C0CMXP",117,0)
+ N ZSF,ZDF,ZSFREF,ZDFREF
+"RTN","C0CMXP",118,0)
+ S ZSF=@ZSRCF@("XML FILE NUMBER")
+"RTN","C0CMXP",119,0)
+ S ZSFREF=$$FILEREF^C0CRNF(ZSF)
+"RTN","C0CMXP",120,0)
+ S ZDF=@ZDESTF@("XML FILE NUMBER")
+"RTN","C0CMXP",121,0)
+ S ZDFREF=$$FILEREF^C0CRNF(ZDF)
+"RTN","C0CMXP",122,0)
+ N ZSIEN,ZDIEN
+"RTN","C0CMXP",123,0)
+ S ZSIEN=$O(@ZSFREF@("B",ZSRCREC,""))
+"RTN","C0CMXP",124,0)
+ I ZSIEN="" W !,"ERROR SOURCE RECORD NOT FOUND" Q  ;
+"RTN","C0CMXP",125,0)
+ S ZDIEN=$O(@ZDFREF@("B",ZDESTREC,""))
+"RTN","C0CMXP",126,0)
+ I ZDIEN="" W !,"ERROR DESTINATION RECORD NOT FOUND" Q  ;
+"RTN","C0CMXP",127,0)
+ N ZFLDNUM
+"RTN","C0CMXP",128,0)
+ I +ZFLD=0 S ZFLDNUM=@ZSRCF@(ZFLD) ; IF FIELD IS PASSED BY NAME
+"RTN","C0CMXP",129,0)
+ E  S ZFLDNUM=ZFLD ; IF FIELD IS PASSED BY NUMBER
+"RTN","C0CMXP",130,0)
+ N ZWP,ZWPN
+"RTN","C0CMXP",131,0)
+ S ZWPN=$$GET1^DIQ(ZSF,ZSIEN_",",ZFLDNUM,,"ZWP") ; GET WP FROM SOURCE
+"RTN","C0CMXP",132,0)
+ I ZWPN'="ZWP" W !,"ERROR SOURCE FIELD EMPTY" Q  ;
+"RTN","C0CMXP",133,0)
+ D WP^DIE(ZDF,ZDIEN_",",ZFLDNUM,,"ZWP") ; PUT WP FIELD TO DEST
+"RTN","C0CMXP",134,0)
+ Q
+"RTN","C0CMXP",135,0)
+ ;
+"RTN","C0CMXP",136,0)
+COMPILE(TID,UFARY) ; COMPILES AN XML TEMPLATE AND GENERATES XPATH BINDINGS
+"RTN","C0CMXP",137,0)
+ ; UFARY IF SPECIFIED WILL REDIRECT THE XML FILE TO USE
+"RTN","C0CMXP",138,0)
+ ; INTID IS THE IEN OF THE RECORD TO USE IN THE XML FILE
+"RTN","C0CMXP",139,0)
+ ; XML IS PULLED FROM THE "XML" FIELD AND THE COMPILED RESULT PUT
+"RTN","C0CMXP",140,0)
+ ; IN THE "XML TEMPLATE" FIELD. ALL XPATHS USED IN THE TEMPLATE
+"RTN","C0CMXP",141,0)
+ ; WILL BE POPULATED TO THE XPATH BINDINGS SUBFILE AS .01
+"RTN","C0CMXP",142,0)
+ I '$D(UFARY) D  ;
+"RTN","C0CMXP",143,0)
+ . S UFARY="DEFFARY" ; FILE ARRAY
+"RTN","C0CMXP",144,0)
+ . ;D INITXPF("UFARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
+"RTN","C0CMXP",145,0)
+ . D INITFARY^C0CSOAP(UFARY)
+"RTN","C0CMXP",146,0)
+ D SETXPF(UFARY) ;SET FILE VARIABLES
+"RTN","C0CMXP",147,0)
+ I +TID=0 S INTID=$$RESTID^C0CSOAP(TID,UFARY)
+"RTN","C0CMXP",148,0)
+ E  S INTID=TID
+"RTN","C0CMXP",149,0)
+ ;B
+"RTN","C0CMXP",150,0)
+ ;N C0CXML,C0CREDUX,C0CTEMP,C0CIDX
+"RTN","C0CMXP",151,0)
+ D GETXML("C0CXML",INTID,UFARY)
+"RTN","C0CMXP",152,0)
+ S C0CREDUX=$$GET1^DIQ(C0CXPF,INTID_",",C0CRDUXF,"E") ;XPATH REDUCTION STRING
+"RTN","C0CMXP",153,0)
+ D MKTPLATE("C0CTEMP","C0CIDX","C0CXML",C0CREDUX) ; CREATE TEMPLATE AND IDX
+"RTN","C0CMXP",154,0)
+ D ADDTEMP("C0CTEMP",INTID,UFARY) ; WRITE THE TEMPLATE TO FILE
+"RTN","C0CMXP",155,0)
+ D ADDXP("C0CIDX",INTID,UFARY) ;CREATE XPATH SUBFILE ENTRIES FOR EVERY XPATH
+"RTN","C0CMXP",156,0)
+ Q
+"RTN","C0CMXP",157,0)
+ ;
+"RTN","C0CMXP",158,0)
+MKTPLATE(OUTT,OUTIDX,INXML,REDUX) ;MAKE A TEMPLATE FROM INXML, RETURNED IN OUTT
+"RTN","C0CMXP",159,0)
+ ; BOTH PASSED BY NAME. THE REDUX XPATH REDUCTION STRING IS USED IF PASSED
+"RTN","C0CMXP",160,0)
+ ; OUTIDX IS AN ARRAY OF THE XPATHS USED IN MAKING THE TEMPLATE
+"RTN","C0CMXP",161,0)
+ ;
+"RTN","C0CMXP",162,0)
+ S C0CXLOC=$NA(^TMP("C0CXML",$J))
+"RTN","C0CMXP",163,0)
+ K @C0CXLOC
+"RTN","C0CMXP",164,0)
+ M @C0CXLOC=@INXML
+"RTN","C0CMXP",165,0)
+ S C0CDOCID=$$PARSE^C0CMXML(C0CXLOC,"C0CMKT")
+"RTN","C0CMXP",166,0)
+ K @C0CXLOC
+"RTN","C0CMXP",167,0)
+ S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
+"RTN","C0CMXP",168,0)
+ ;N GIDX,GIDX2,GARY,GARY2
+"RTN","C0CMXP",169,0)
+ I '$D(REDUX) S REDUX=""
+"RTN","C0CMXP",170,0)
+ D XPATH^C0CMXML(1,"/","GIDX","GARY",,REDUX)
+"RTN","C0CMXP",171,0)
+ D INVERT("GIDX2","GIDX") ;MAKE ARRAY TO LOOK UP XPATH BY NODE
+"RTN","C0CMXP",172,0)
+ N ZI,ZD S ZI=""
+"RTN","C0CMXP",173,0)
+ F  S ZI=$O(@C0CDOM@(ZI)) Q:ZI=""  D  ; FOR EACH NODE IN THE DOM
+"RTN","C0CMXP",174,0)
+ . K ZD ;FOR DATA
+"RTN","C0CMXP",175,0)
+ . D DATA^C0CMXML("ZD",ZI) ;SEE IF THERE IS DATA FOR THIS NODE
+"RTN","C0CMXP",176,0)
+ . ;I $D(ZD(1)) D  ; IF YES
+"RTN","C0CMXP",177,0)
+ . I $$FIRST^C0CMXML(ZI)=0 D  ; IF THERE ARE NO CHILDREN TO THIS NODE
+"RTN","C0CMXP",178,0)
+ . . ;I ZI<3 B  ;W !,ZD(1)
+"RTN","C0CMXP",179,0)
+ . . K @C0CDOM@(ZI,"T") ; KILL THE DATA
+"RTN","C0CMXP",180,0)
+ . . N ZXPATH
+"RTN","C0CMXP",181,0)
+ . . S ZXPATH=$G(GIDX2(ZI)) ;FIND AN XPATH FOR THIS NODE
+"RTN","C0CMXP",182,0)
+ . . S @C0CDOM@(ZI,"T",1)="@@"_ZXPATH_"@@"
+"RTN","C0CMXP",183,0)
+ . . I ZXPATH'="" S @OUTIDX@(ZXPATH)="" ; PASS BACK XPATH USED IN IDX
+"RTN","C0CMXP",184,0)
+ D OUTXML^C0CMXML(OUTT,C0CDOCID)
+"RTN","C0CMXP",185,0)
+ Q
+"RTN","C0CMXP",186,0)
+ ;
+"RTN","C0CMXP",187,0)
+INVERT(OUTX,INX) ;INVERTS AN XPATH INDEX RETURNING @OUTX@(x)=XPath from
+"RTN","C0CMXP",188,0)
+ ; @INX@(XPath)=x
+"RTN","C0CMXP",189,0)
+ N ZI S ZI=""
+"RTN","C0CMXP",190,0)
+ F  S ZI=$O(@INX@(ZI)) Q:ZI=""  D  ;FOR EACH XPATH IN THE INPUT
+"RTN","C0CMXP",191,0)
+ . S @OUTX@(@INX@(ZI))=ZI ; SET INVERTED ENTRY
+"RTN","C0CMXP",192,0)
+ Q
+"RTN","C0CMXP",193,0)
+ ;
+"RTN","C0CMXP",194,0)
+DEMUX(OUTX,INX) ;PARSES XPATH PASSED BY VALUE IN INX TO REMOVE [x] MULTIPLES
+"RTN","C0CMXP",195,0)
+ ; RETURNS OUTX: MULTIPLE^SUBMULTIPLE^XPATH 
+"RTN","C0CMXP",196,0)
+ N ZX,ZY,ZZ,ZZ1,ZMULT,ZSUB
+"RTN","C0CMXP",197,0)
+ S (ZMULT,ZSUB)=""
+"RTN","C0CMXP",198,0)
+ S ZX=$P(INX,"[",2)
+"RTN","C0CMXP",199,0)
+ I ZX'="" D  ; THERE IS A [x] MULTIPLE
+"RTN","C0CMXP",200,0)
+ . S ZY=$P(INX,"[",1) ;FIRST PART OF XPATH
+"RTN","C0CMXP",201,0)
+ . S ZMULT=$P(ZX,"]",1) ; NUMBER OF THE MULTIPLE
+"RTN","C0CMXP",202,0)
+ . S ZX=ZY_$P(ZX,"]",2) ; REST OF THE XPATH
+"RTN","C0CMXP",203,0)
+ . I $P(ZX,"[",2)'="" D  ; A SUB MULTIPLE EXISTS
+"RTN","C0CMXP",204,0)
+ . . S ZZ=$P(ZX,"[",1) ; FIRST PART OF XPATH
+"RTN","C0CMXP",205,0)
+ . . S ZX=$P(ZX,"[",2) ; DELETE THE [
+"RTN","C0CMXP",206,0)
+ . . S ZSUB=$P(ZX,"]",1) ; NUMBER OF THE SUBMULTIPLE
+"RTN","C0CMXP",207,0)
+ . . S ZX=ZZ_$P(ZX,"]",2) ; REST OF THE XPATH
+"RTN","C0CMXP",208,0)
+ E  S ZX=INX ;NO MULTIPLE HERE
+"RTN","C0CMXP",209,0)
+ S @OUTX=ZMULT_"^"_ZSUB_"^"_ZX ;RETURN MULTIPLE^SUBMULTIPLE^XPATH
+"RTN","C0CMXP",210,0)
+ Q
+"RTN","C0CMXP",211,0)
+ ;
+"RTN","C0CMXP",212,0)
+DEMUXARY(OARY,IARY,DEPTH) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO
+"RTN","C0CMXP",213,0)
+ ; FORMAT @OARY@(x,variablename) where x is the first multiple
+"RTN","C0CMXP",214,0)
+ ; IF DEPTH=2, THE LAST 2 PARTS OF THE XPATH WILL BE USED
+"RTN","C0CMXP",215,0)
+ N ZI,ZJ,ZK,ZL,ZM S ZI=""
+"RTN","C0CMXP",216,0)
+ F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ;
+"RTN","C0CMXP",217,0)
+ . D DEMUX^C0CMXP("ZJ",ZI)
+"RTN","C0CMXP",218,0)
+ . S ZK=$P(ZJ,"^",3)
+"RTN","C0CMXP",219,0)
+ . S ZM=$RE($P($RE(ZK),"/",1))
+"RTN","C0CMXP",220,0)
+ . I $G(DEPTH)=2 D  ;LAST TWO PARTS OF XPATH USED FOR THE VARIABLE NAME
+"RTN","C0CMXP",221,0)
+ . . S ZM=$RE($P($RE(ZK),"/",2))_ZM
+"RTN","C0CMXP",222,0)
+ . S ZL=$P(ZJ,"^",1)
+"RTN","C0CMXP",223,0)
+ . I ZL="" S ZL=1
+"RTN","C0CMXP",224,0)
+ . I $D(@OARY@(ZL,ZM)) D  ;IT'S A DUP
+"RTN","C0CMXP",225,0)
+ . . S @OARY@(ZL,ZM_"[2]")=@IARY@(ZI)
+"RTN","C0CMXP",226,0)
+ . E  S @OARY@(ZL,ZM)=@IARY@(ZI)
+"RTN","C0CMXP",227,0)
+ Q
+"RTN","C0CMXP",228,0)
+ ;
+"RTN","C0CMXP",229,0)
+DEMUX2(OARY,IARY,DEPTH) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO
+"RTN","C0CMXP",230,0)
+ ; FORMAT @OARY@(x,variablename) where x is the first multiple
+"RTN","C0CMXP",231,0)
+ ; IF DEPTH=2, THE LAST 2 PARTS OF THE XPATH WILL BE USED
+"RTN","C0CMXP",232,0)
+ N ZI,ZJ,ZK,ZL,ZM S ZI=""
+"RTN","C0CMXP",233,0)
+ F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ;
+"RTN","C0CMXP",234,0)
+ . D DEMUX^C0CMXP("ZJ",ZI)
+"RTN","C0CMXP",235,0)
+ . S ZK=$P(ZJ,"^",3)
+"RTN","C0CMXP",236,0)
+ . S ZM=$RE($P($RE(ZK),"/",1))
+"RTN","C0CMXP",237,0)
+ . I $G(DEPTH)=2 D  ;LAST TWO PARTS OF XPATH USED FOR THE VARIABLE NAME
+"RTN","C0CMXP",238,0)
+ . . S ZM=$RE($P($RE(ZK),"/",2))_"."_ZM
+"RTN","C0CMXP",239,0)
+ . S ZL=$P(ZJ,"^",1)
+"RTN","C0CMXP",240,0)
+ . I ZL="" S ZL=1
+"RTN","C0CMXP",241,0)
+ . I $D(@OARY@(ZL,ZM)) D  ;IT'S A DUP
+"RTN","C0CMXP",242,0)
+ . . S @OARY@(ZL,ZM_"[2]")=@IARY@(ZI)
+"RTN","C0CMXP",243,0)
+ . E  S @OARY@(ZL,ZM)=@IARY@(ZI)
+"RTN","C0CMXP",244,0)
+ Q
+"RTN","C0CMXP",245,0)
+ ;
+"RTN","C0CMXP",246,0)
+DEMUXXP1(OARY,IARY) ;IARY IS INCOMING XPATH ARRAY
+"RTN","C0CMXP",247,0)
+ ; BOTH IARY AND OARY ARE PASSED BY NAME
+"RTN","C0CMXP",248,0)
+ ; RETURNS A SIMPLE XPATH ARRAY WITHOUT MULTIPLES. DUPLICATES ARE REMOVED
+"RTN","C0CMXP",249,0)
+ N ZI,ZJ,ZK
+"RTN","C0CMXP",250,0)
  S ZI=""
-"RTN","C0CMXP",58,0)
- S G=""
-"RTN","C0CMXP",59,0)
- F  S ZI=$O(GPL(ZI)) Q:ZI=""  D  ; FOR EACH LINE
-"RTN","C0CMXP",60,0)
- . S G=G_GPL(ZI) ; MAKE ONE BIG STRING OF XML
-"RTN","C0CMXP",61,0)
- D NORMAL^C0CSOAP("G2","G") ;NO NORMALIZE IT BACK INTO AN ARRAY
-"RTN","C0CMXP",62,0)
- D ADDXML("G2","ICD9RESULT") ; AND PUT IT BACK
-"RTN","C0CMXP",63,0)
+"RTN","C0CMXP",251,0)
+ F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ; FOR EACH XPATH IN IARY
+"RTN","C0CMXP",252,0)
+ . D DEMUX^C0CMXP("ZJ",ZI)
+"RTN","C0CMXP",253,0)
+ . S ZK=$P(ZJ,"^",3) ;THE XPATH
+"RTN","C0CMXP",254,0)
+ . S @OARY@(ZK)=@IARY@(ZI) ;THE RESULT. DUPLICATES WILL NOT SHOW
+"RTN","C0CMXP",255,0)
+ . ; CAUTION, IF THERE ARE MULTIPLES, ONLY THE DATA FOR THE LAST
+"RTN","C0CMXP",256,0)
+ . ; MULTIPLE WILL BE INCLUDED IN THE OUTPUT ARRAY, ASSIGNED TO THE
+"RTN","C0CMXP",257,0)
+ . ; COMMON XPATH
+"RTN","C0CMXP",258,0)
  Q
-"RTN","C0CMXP",64,0)
-ADDXML(INXML,TEMPID,INFARY) ;ADD XML TO A TEMPLATE ID TEMPID
-"RTN","C0CMXP",65,0)
- ; INXML IS PASSED BY NAME
-"RTN","C0CMXP",66,0)
- I '$D(INFARY) D  ;
-"RTN","C0CMXP",67,0)
- . S INFARY="FARY" ; FILE ARRAY
-"RTN","C0CMXP",68,0)
- . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
-"RTN","C0CMXP",69,0)
- I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME
-"RTN","C0CMXP",70,0)
- D SETXPF(INFARY) ;SET FILE VARIABLES
-"RTN","C0CMXP",71,0)
- D WP^DIE(C0CXPF,TEMPID_",",C0CXFLD,,INXML)
-"RTN","C0CMXP",72,0)
+"RTN","C0CMXP",259,0)
+ ;
+"RTN","C0CMXP",260,0)
+DEMUXXP2(OARY,IARY) ; IARY AND OARY ARE PASSED BY NAME
+"RTN","C0CMXP",261,0)
+ ; IARY IS AN XPATH ARRAY THAT MAY CONTAIN MULTIPLES
+"RTN","C0CMXP",262,0)
+ ; OARY IS THE OUTPUT ARRAY WHERE MULTIPLES ARE RETURNED IN THE FORM
+"RTN","C0CMXP",263,0)
+ ; @OARY@(x,Xpath)=data or @OARY@(x,y,Xpath)=data WHERE x AND y ARE
+"RTN","C0CMXP",264,0)
+ ; THE MULTIPLES AND Xpath IS THE BASE XPATH WITHOUT [x] AND [y]
+"RTN","C0CMXP",265,0)
+ ; 
+"RTN","C0CMXP",266,0)
+ N ZI,ZJ,ZK,ZX,ZY,ZP
+"RTN","C0CMXP",267,0)
+ S ZI=""
+"RTN","C0CMXP",268,0)
+ F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ; FOR EACH INPUT XPATH
+"RTN","C0CMXP",269,0)
+ . D DEMUX("ZJ",ZI) ; PULL OUT THE MULTIPLES
+"RTN","C0CMXP",270,0)
+ . S ZX=$P(ZJ,"^",1) ;x
+"RTN","C0CMXP",271,0)
+ . S ZY=$P(ZJ,"^",2) ;y
+"RTN","C0CMXP",272,0)
+ . S ZP=$P(ZJ,"^",3) ;Xpath
+"RTN","C0CMXP",273,0)
+ . I ZX="" S ZX=1 ; NO MULTIPLE WILL STORE IN x=1
+"RTN","C0CMXP",274,0)
+ . I ZY'="" D  ;IS THERE A y?
+"RTN","C0CMXP",275,0)
+ . . S @OARY@(ZX,ZY,ZP)=@IARY@(ZI)
+"RTN","C0CMXP",276,0)
+ . E  D  ;NO y
+"RTN","C0CMXP",277,0)
+ . . S @OARY@(ZX,ZP)=@IARY@(ZI)
+"RTN","C0CMXP",278,0)
  Q
-"RTN","C0CMXP",73,0)
- ;
-"RTN","C0CMXP",74,0)
-ADDTEMP(INXML,TEMPID,INFARY) ;ADD XML TEMPLATE TO TEMPLATE RECORD TEMPID
-"RTN","C0CMXP",75,0)
- ;
-"RTN","C0CMXP",76,0)
- I '$D(INFARY) D  ;
-"RTN","C0CMXP",77,0)
- . S INFARY="FARY" ; FILE ARRAY
-"RTN","C0CMXP",78,0)
- . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
-"RTN","C0CMXP",79,0)
- I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME
-"RTN","C0CMXP",80,0)
- D SETXPF(INFARY) ;SET FILE VARIABLES
-"RTN","C0CMXP",81,0)
- D WP^DIE(C0CXPF,TEMPID_",",C0CXTFLD,,INXML)
-"RTN","C0CMXP",82,0)
+"RTN","C0CMXP",279,0)
+ ;
+"RTN","C0CMXP",280,0)
+UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+"RTN","C0CMXP",281,0)
+ K ZERR
+"RTN","C0CMXP",282,0)
+ D CLEAN^DILF
+"RTN","C0CMXP",283,0)
+ D UPDATE^DIE("","C0CFDA","","ZERR")
+"RTN","C0CMXP",284,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CMXP",285,0)
+ K C0CFDA
+"RTN","C0CMXP",286,0)
  Q
-"RTN","C0CMXP",83,0)
- ;
-"RTN","C0CMXP",84,0)
-GETXML(OUTXML,TEMPID,INFARY) ;GET THE XML FROM TEMPLATE TEMPID
-"RTN","C0CMXP",85,0)
- ;
-"RTN","C0CMXP",86,0)
- I '$D(INFARY) D  ;
-"RTN","C0CMXP",87,0)
- . S INFARY="FARY" ; FILE ARRAY
-"RTN","C0CMXP",88,0)
- . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
-"RTN","C0CMXP",89,0)
- D SETXPF(INFARY) ;SET FILE VARIABLES
-"RTN","C0CMXP",90,0)
- I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME
-"RTN","C0CMXP",91,0)
- I $$GET1^DIQ(C0CXPF,TEMPID_",",C0CXFLD,,OUTXML)'=OUTXML D  Q  ;
-"RTN","C0CMXP",92,0)
- . W "ERROR RETRIEVING TEMPLATE",!
-"RTN","C0CMXP",93,0)
- Q
-"RTN","C0CMXP",94,0)
- ;
-"RTN","C0CMXP",95,0)
-GETTEMP(OUTXML,TEMPID,FARY) ;GET THE TEMPLATE XML FROM TEMPLATE TEMPID
-"RTN","C0CMXP",96,0)
- ;
-"RTN","C0CMXP",97,0)
- I '$D(FARY) D  ;
-"RTN","C0CMXP",98,0)
- . S FARY="FARY" ; FILE ARRAY
-"RTN","C0CMXP",99,0)
- . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
-"RTN","C0CMXP",100,0)
- D SETXPF(FARY) ;SET FILE VARIABLES
-"RTN","C0CMXP",101,0)
- I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,FARY) ;RESOLVE TEMPLATE NAME
-"RTN","C0CMXP",102,0)
- I $$GET1^DIQ(C0CXPF,TEMPID_",",C0CXTFLD,,OUTXML)'=OUTXML D  Q  ;
-"RTN","C0CMXP",103,0)
- . W "ERROR RETRIEVING TEMPLATE",!
-"RTN","C0CMXP",104,0)
- Q
-"RTN","C0CMXP",105,0)
- ;
-"RTN","C0CMXP",106,0)
-COPYWP(ZFLD,ZSRCREC,ZDESTREC,ZSRCF,ZDESTF) ; COPIES A WORD PROCESSING FIELD
-"RTN","C0CMXP",107,0)
- ; FROM ONE RECORD TO ANOTHER RECORD 
-"RTN","C0CMXP",108,0)
- ; ZFLD IS EITHER A NUMBERIC FIELD OR A NAME IN ZSRCF
-"RTN","C0CMXP",109,0)
- ; ZSRCF IS THE SOURCE FILE, IN FILE REDIRECT FORMAT
-"RTN","C0CMXP",110,0)
- ; IF ZSRCF IS OMMITED, THE DEFAULT C0C XML MISC FILE WILL BE ASSUMED
-"RTN","C0CMXP",111,0)
- ; ZDESTF IS DESTINATION FILE. IF OMMITED, IS ASSUMED TO BE THE SAME
-"RTN","C0CMXP",112,0)
- ; A ZSRCF
-"RTN","C0CMXP",113,0)
- I '$D(ZSRCF) D  ;
-"RTN","C0CMXP",114,0)
- . S ZSRCF="ZSRCF"
-"RTN","C0CMXP",115,0)
- . D INITFARY^C0CSOAP(ZSRCF)
-"RTN","C0CMXP",116,0)
- I '$D(ZDESTF) D  ;
-"RTN","C0CMXP",117,0)
- . S ZDESTF="ZDESTF"
-"RTN","C0CMXP",118,0)
- . M @ZDESTF=@ZSRCF
-"RTN","C0CMXP",119,0)
- N ZSF,ZDF,ZSFREF,ZDFREF
-"RTN","C0CMXP",120,0)
- S ZSF=@ZSRCF@("XML FILE NUMBER")
-"RTN","C0CMXP",121,0)
- S ZSFREF=$$FILEREF^C0CRNF(ZSF)
-"RTN","C0CMXP",122,0)
- S ZDF=@ZDESTF@("XML FILE NUMBER")
-"RTN","C0CMXP",123,0)
- S ZDFREF=$$FILEREF^C0CRNF(ZDF)
-"RTN","C0CMXP",124,0)
- N ZSIEN,ZDIEN
-"RTN","C0CMXP",125,0)
- S ZSIEN=$O(@ZSFREF@("B",ZSRCREC,""))
-"RTN","C0CMXP",126,0)
- I ZSIEN="" W !,"ERROR SOURCE RECORD NOT FOUND" Q  ;
-"RTN","C0CMXP",127,0)
- S ZDIEN=$O(@ZDFREF@("B",ZDESTREC,""))
-"RTN","C0CMXP",128,0)
- I ZDIEN="" W !,"ERROR DESTINATION RECORD NOT FOUND" Q  ;
-"RTN","C0CMXP",129,0)
- N ZFLDNUM
-"RTN","C0CMXP",130,0)
- I +ZFLD=0 S ZFLDNUM=@ZSRCF@(ZFLD) ; IF FIELD IS PASSED BY NAME
-"RTN","C0CMXP",131,0)
- E  S ZFLDNUM=ZFLD ; IF FIELD IS PASSED BY NUMBER
-"RTN","C0CMXP",132,0)
- N ZWP,ZWPN
-"RTN","C0CMXP",133,0)
- S ZWPN=$$GET1^DIQ(ZSF,ZSIEN_",",ZFLDNUM,,"ZWP") ; GET WP FROM SOURCE
-"RTN","C0CMXP",134,0)
- I ZWPN'="ZWP" W !,"ERROR SOURCE FIELD EMPTY" Q  ;
-"RTN","C0CMXP",135,0)
- D WP^DIE(ZDF,ZDIEN_",",ZFLDNUM,,"ZWP") ; PUT WP FIELD TO DEST
-"RTN","C0CMXP",136,0)
- Q
-"RTN","C0CMXP",137,0)
- ;
-"RTN","C0CMXP",138,0)
-COMPILE(TID,UFARY) ; COMPILES AN XML TEMPLATE AND GENERATES XPATH BINDINGS
-"RTN","C0CMXP",139,0)
- ; UFARY IF SPECIFIED WILL REDIRECT THE XML FILE TO USE
-"RTN","C0CMXP",140,0)
- ; INTID IS THE IEN OF THE RECORD TO USE IN THE XML FILE
-"RTN","C0CMXP",141,0)
- ; XML IS PULLED FROM THE "XML" FIELD AND THE COMPILED RESULT PUT
-"RTN","C0CMXP",142,0)
- ; IN THE "XML TEMPLATE" FIELD. ALL XPATHS USED IN THE TEMPLATE
-"RTN","C0CMXP",143,0)
- ; WILL BE POPULATED TO THE XPATH BINDINGS SUBFILE AS .01
-"RTN","C0CMXP",144,0)
- I '$D(UFARY) D  ;
-"RTN","C0CMXP",145,0)
- . S UFARY="DEFFARY" ; FILE ARRAY
-"RTN","C0CMXP",146,0)
- . ;D INITXPF("UFARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
-"RTN","C0CMXP",147,0)
- . D INITFARY^C0CSOAP(UFARY)
-"RTN","C0CMXP",148,0)
- D SETXPF(UFARY) ;SET FILE VARIABLES
-"RTN","C0CMXP",149,0)
- I +TID=0 S INTID=$$RESTID^C0CSOAP(TID,UFARY)
-"RTN","C0CMXP",150,0)
- E  S INTID=TID
-"RTN","C0CMXP",151,0)
- ;B
-"RTN","C0CMXP",152,0)
- ;N C0CXML,C0CREDUX,C0CTEMP,C0CIDX
-"RTN","C0CMXP",153,0)
- D GETXML("C0CXML",INTID,UFARY)
-"RTN","C0CMXP",154,0)
- S C0CREDUX=$$GET1^DIQ(C0CXPF,INTID_",",C0CRDUXF,"E") ;XPATH REDUCTION STRING
-"RTN","C0CMXP",155,0)
- D MKTPLATE("C0CTEMP","C0CIDX","C0CXML",C0CREDUX) ; CREATE TEMPLATE AND IDX
-"RTN","C0CMXP",156,0)
- D ADDTEMP("C0CTEMP",INTID,UFARY) ; WRITE THE TEMPLATE TO FILE
-"RTN","C0CMXP",157,0)
- D ADDXP("C0CIDX",INTID,UFARY) ;CREATE XPATH SUBFILE ENTRIES FOR EVERY XPATH
-"RTN","C0CMXP",158,0)
- Q
-"RTN","C0CMXP",159,0)
- ;
-"RTN","C0CMXP",160,0)
-MKTPLATE(OUTT,OUTIDX,INXML,REDUX) ;MAKE A TEMPLATE FROM INXML, RETURNED IN OUTT
-"RTN","C0CMXP",161,0)
- ; BOTH PASSED BY NAME. THE REDUX XPATH REDUCTION STRING IS USED IF PASSED
-"RTN","C0CMXP",162,0)
- ; OUTIDX IS AN ARRAY OF THE XPATHS USED IN MAKING THE TEMPLATE
-"RTN","C0CMXP",163,0)
- ;
-"RTN","C0CMXP",164,0)
- S C0CXLOC=$NA(^TMP("C0CXML",$J))
-"RTN","C0CMXP",165,0)
- K @C0CXLOC
-"RTN","C0CMXP",166,0)
- M @C0CXLOC=@INXML
-"RTN","C0CMXP",167,0)
- S C0CDOCID=$$PARSE^C0CMXML(C0CXLOC,"C0CMKT")
-"RTN","C0CMXP",168,0)
- K @C0CXLOC
-"RTN","C0CMXP",169,0)
- S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 
-"RTN","C0CMXP",170,0)
- ;N GIDX,GIDX2,GARY,GARY2
-"RTN","C0CMXP",171,0)
- I '$D(REDUX) S REDUX=""
-"RTN","C0CMXP",172,0)
- D XPATH^C0CMXML(1,"/","GIDX","GARY",,REDUX)
-"RTN","C0CMXP",173,0)
- D INVERT("GIDX2","GIDX") ;MAKE ARRAY TO LOOK UP XPATH BY NODE
-"RTN","C0CMXP",174,0)
- N ZI,ZD S ZI=""
-"RTN","C0CMXP",175,0)
- F  S ZI=$O(@C0CDOM@(ZI)) Q:ZI=""  D  ; FOR EACH NODE IN THE DOM
-"RTN","C0CMXP",176,0)
- . K ZD ;FOR DATA
-"RTN","C0CMXP",177,0)
- . D DATA^C0CMXML("ZD",ZI) ;SEE IF THERE IS DATA FOR THIS NODE
-"RTN","C0CMXP",178,0)
- . ;I $D(ZD(1)) D  ; IF YES
-"RTN","C0CMXP",179,0)
- . I $$FIRST^C0CMXML(ZI)=0 D  ; IF THERE ARE NO CHILDREN TO THIS NODE
-"RTN","C0CMXP",180,0)
- . . ;I ZI<3 B  ;W !,ZD(1)
-"RTN","C0CMXP",181,0)
- . . K @C0CDOM@(ZI,"T") ; KILL THE DATA
-"RTN","C0CMXP",182,0)
- . . N ZXPATH
-"RTN","C0CMXP",183,0)
- . . S ZXPATH=$G(GIDX2(ZI)) ;FIND AN XPATH FOR THIS NODE
-"RTN","C0CMXP",184,0)
- . . S @C0CDOM@(ZI,"T",1)="@@"_ZXPATH_"@@"
-"RTN","C0CMXP",185,0)
- . . I ZXPATH'="" S @OUTIDX@(ZXPATH)="" ; PASS BACK XPATH USED IN IDX
-"RTN","C0CMXP",186,0)
- D OUTXML^C0CMXML(OUTT,C0CDOCID)
-"RTN","C0CMXP",187,0)
- Q
-"RTN","C0CMXP",188,0)
- ;
-"RTN","C0CMXP",189,0)
-INVERT(OUTX,INX) ;INVERTS AN XPATH INDEX RETURNING @OUTX@(x)=XPath from
-"RTN","C0CMXP",190,0)
- ; @INX@(XPath)=x
-"RTN","C0CMXP",191,0)
- N ZI S ZI=""
-"RTN","C0CMXP",192,0)
- F  S ZI=$O(@INX@(ZI)) Q:ZI=""  D  ;FOR EACH XPATH IN THE INPUT
-"RTN","C0CMXP",193,0)
- . S @OUTX@(@INX@(ZI))=ZI ; SET INVERTED ENTRY
-"RTN","C0CMXP",194,0)
- Q
-"RTN","C0CMXP",195,0)
- ;
-"RTN","C0CMXP",196,0)
-DEMUX(OUTX,INX) ;PARSES XPATH PASSED BY VALUE IN INX TO REMOVE [x] MULTIPLES
-"RTN","C0CMXP",197,0)
- ; RETURNS OUTX: MULTIPLE^SUBMULTIPLE^XPATH 
-"RTN","C0CMXP",198,0)
- N ZX,ZY,ZZ,ZZ1,ZMULT,ZSUB
-"RTN","C0CMXP",199,0)
- S (ZMULT,ZSUB)=""
-"RTN","C0CMXP",200,0)
- S ZX=$P(INX,"[",2)
-"RTN","C0CMXP",201,0)
- I ZX'="" D  ; THERE IS A [x] MULTIPLE
-"RTN","C0CMXP",202,0)
- . S ZY=$P(INX,"[",1) ;FIRST PART OF XPATH
-"RTN","C0CMXP",203,0)
- . S ZMULT=$P(ZX,"]",1) ; NUMBER OF THE MULTIPLE
-"RTN","C0CMXP",204,0)
- . S ZX=ZY_$P(ZX,"]",2) ; REST OF THE XPATH
-"RTN","C0CMXP",205,0)
- . I $P(ZX,"[",2)'="" D  ; A SUB MULTIPLE EXISTS
-"RTN","C0CMXP",206,0)
- . . S ZZ=$P(ZX,"[",1) ; FIRST PART OF XPATH
-"RTN","C0CMXP",207,0)
- . . S ZX=$P(ZX,"[",2) ; DELETE THE [
-"RTN","C0CMXP",208,0)
- . . S ZSUB=$P(ZX,"]",1) ; NUMBER OF THE SUBMULTIPLE
-"RTN","C0CMXP",209,0)
- . . S ZX=ZZ_$P(ZX,"]",2) ; REST OF THE XPATH
-"RTN","C0CMXP",210,0)
- E  S ZX=INX ;NO MULTIPLE HERE
-"RTN","C0CMXP",211,0)
- S @OUTX=ZMULT_"^"_ZSUB_"^"_ZX ;RETURN MULTIPLE^SUBMULTIPLE^XPATH
-"RTN","C0CMXP",212,0)
- Q
-"RTN","C0CMXP",213,0)
- ;
-"RTN","C0CMXP",214,0)
-DEMUXARY(OARY,IARY,DEPTH) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO
-"RTN","C0CMXP",215,0)
- ; FORMAT @OARY@(x,variablename) where x is the first multiple
-"RTN","C0CMXP",216,0)
- ; IF DEPTH=2, THE LAST 2 PARTS OF THE XPATH WILL BE USED
-"RTN","C0CMXP",217,0)
- N ZI,ZJ,ZK,ZL,ZM S ZI=""
-"RTN","C0CMXP",218,0)
- F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ;
-"RTN","C0CMXP",219,0)
- . D DEMUX^C0CMXP("ZJ",ZI)
-"RTN","C0CMXP",220,0)
- . S ZK=$P(ZJ,"^",3)
-"RTN","C0CMXP",221,0)
- . S ZM=$RE($P($RE(ZK),"/",1))
-"RTN","C0CMXP",222,0)
- . I $G(DEPTH)=2 D  ;LAST TWO PARTS OF XPATH USED FOR THE VARIABLE NAME
-"RTN","C0CMXP",223,0)
- . . S ZM=$RE($P($RE(ZK),"/",2))_ZM
-"RTN","C0CMXP",224,0)
- . S ZL=$P(ZJ,"^",1)
-"RTN","C0CMXP",225,0)
- . I ZL="" S ZL=1
-"RTN","C0CMXP",226,0)
- . I $D(@OARY@(ZL,ZM)) D  ;IT'S A DUP
-"RTN","C0CMXP",227,0)
- . . S @OARY@(ZL,ZM_"[2]")=@IARY@(ZI)
-"RTN","C0CMXP",228,0)
- . E  S @OARY@(ZL,ZM)=@IARY@(ZI)
-"RTN","C0CMXP",229,0)
- Q
-"RTN","C0CMXP",230,0)
- ;
-"RTN","C0CMXP",231,0)
-DEMUX2(OARY,IARY,DEPTH) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO
-"RTN","C0CMXP",232,0)
- ; FORMAT @OARY@(x,variablename) where x is the first multiple
-"RTN","C0CMXP",233,0)
- ; IF DEPTH=2, THE LAST 2 PARTS OF THE XPATH WILL BE USED
-"RTN","C0CMXP",234,0)
- N ZI,ZJ,ZK,ZL,ZM S ZI=""
-"RTN","C0CMXP",235,0)
- F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ;
-"RTN","C0CMXP",236,0)
- . D DEMUX^C0CMXP("ZJ",ZI)
-"RTN","C0CMXP",237,0)
- . S ZK=$P(ZJ,"^",3)
-"RTN","C0CMXP",238,0)
- . S ZM=$RE($P($RE(ZK),"/",1))
-"RTN","C0CMXP",239,0)
- . I $G(DEPTH)=2 D  ;LAST TWO PARTS OF XPATH USED FOR THE VARIABLE NAME
-"RTN","C0CMXP",240,0)
- . . S ZM=$RE($P($RE(ZK),"/",2))_"."_ZM
-"RTN","C0CMXP",241,0)
- . S ZL=$P(ZJ,"^",1)
-"RTN","C0CMXP",242,0)
- . I ZL="" S ZL=1
-"RTN","C0CMXP",243,0)
- . I $D(@OARY@(ZL,ZM)) D  ;IT'S A DUP
-"RTN","C0CMXP",244,0)
- . . S @OARY@(ZL,ZM_"[2]")=@IARY@(ZI)
-"RTN","C0CMXP",245,0)
- . E  S @OARY@(ZL,ZM)=@IARY@(ZI)
-"RTN","C0CMXP",246,0)
- Q
-"RTN","C0CMXP",247,0)
- ;
-"RTN","C0CMXP",248,0)
-DEMUXXP1(OARY,IARY) ;IARY IS INCOMING XPATH ARRAY
-"RTN","C0CMXP",249,0)
- ; BOTH IARY AND OARY ARE PASSED BY NAME
-"RTN","C0CMXP",250,0)
- ; RETURNS A SIMPLE XPATH ARRAY WITHOUT MULTIPLES. DUPLICATES ARE REMOVED
-"RTN","C0CMXP",251,0)
- N ZI,ZJ,ZK
-"RTN","C0CMXP",252,0)
- S ZI=""
-"RTN","C0CMXP",253,0)
- F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ; FOR EACH XPATH IN IARY
-"RTN","C0CMXP",254,0)
- . D DEMUX^C0CMXP("ZJ",ZI)
-"RTN","C0CMXP",255,0)
- . S ZK=$P(ZJ,"^",3) ;THE XPATH
-"RTN","C0CMXP",256,0)
- . S @OARY@(ZK)=@IARY@(ZI) ;THE RESULT. DUPLICATES WILL NOT SHOW
-"RTN","C0CMXP",257,0)
- . ; CAUTION, IF THERE ARE MULTIPLES, ONLY THE DATA FOR THE LAST
-"RTN","C0CMXP",258,0)
- . ; MULTIPLE WILL BE INCLUDED IN THE OUTPUT ARRAY, ASSIGNED TO THE
-"RTN","C0CMXP",259,0)
- . ; COMMON XPATH
-"RTN","C0CMXP",260,0)
- Q
-"RTN","C0CMXP",261,0)
- ;
-"RTN","C0CMXP",262,0)
-DEMUXXP2(OARY,IARY) ; IARY AND OARY ARE PASSED BY NAME
-"RTN","C0CMXP",263,0)
- ; IARY IS AN XPATH ARRAY THAT MAY CONTAIN MULTIPLES
-"RTN","C0CMXP",264,0)
- ; OARY IS THE OUTPUT ARRAY WHERE MULTIPLES ARE RETURNED IN THE FORM
-"RTN","C0CMXP",265,0)
- ; @OARY@(x,Xpath)=data or @OARY@(x,y,Xpath)=data WHERE x AND y ARE
-"RTN","C0CMXP",266,0)
- ; THE MULTIPLES AND Xpath IS THE BASE XPATH WITHOUT [x] AND [y]
-"RTN","C0CMXP",267,0)
- ; 
-"RTN","C0CMXP",268,0)
- N ZI,ZJ,ZK,ZX,ZY,ZP
-"RTN","C0CMXP",269,0)
- S ZI=""
-"RTN","C0CMXP",270,0)
- F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ; FOR EACH INPUT XPATH
-"RTN","C0CMXP",271,0)
- . D DEMUX("ZJ",ZI) ; PULL OUT THE MULTIPLES
-"RTN","C0CMXP",272,0)
- . S ZX=$P(ZJ,"^",1) ;x
-"RTN","C0CMXP",273,0)
- . S ZY=$P(ZJ,"^",2) ;y
-"RTN","C0CMXP",274,0)
- . S ZP=$P(ZJ,"^",3) ;Xpath
-"RTN","C0CMXP",275,0)
- . I ZX="" S ZX=1 ; NO MULTIPLE WILL STORE IN x=1
-"RTN","C0CMXP",276,0)
- . I ZY'="" D  ;IS THERE A y?
-"RTN","C0CMXP",277,0)
- . . S @OARY@(ZX,ZY,ZP)=@IARY@(ZI)
-"RTN","C0CMXP",278,0)
- . E  D  ;NO y
-"RTN","C0CMXP",279,0)
- . . S @OARY@(ZX,ZP)=@IARY@(ZI)
-"RTN","C0CMXP",280,0)
- Q
-"RTN","C0CMXP",281,0)
- ;
-"RTN","C0CMXP",282,0)
-UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
-"RTN","C0CMXP",283,0)
- K ZERR
-"RTN","C0CMXP",284,0)
- D CLEAN^DILF
-"RTN","C0CMXP",285,0)
- D UPDATE^DIE("","C0CFDA","","ZERR")
-"RTN","C0CMXP",286,0)
- I $D(ZERR) D  ;
 "RTN","C0CMXP",287,0)
- . W "ERROR",!
-"RTN","C0CMXP",288,0)
- . ZWR ZERR
-"RTN","C0CMXP",289,0)
- . B
-"RTN","C0CMXP",290,0)
- K C0CFDA
-"RTN","C0CMXP",291,0)
- Q
-"RTN","C0CMXP",292,0)
  ;
 "RTN","C0CNHIN")
-0^88^B87973392
+0^88^B87084020
 "RTN","C0CNHIN",1,0)
 C0CNHIN   ; GPL - PROCESSING FOR OUTPUT OF NHINV ROUTINES;6/3/11  17:05
 "RTN","C0CNHIN",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CNHIN",3,0)
- ;Copyright 2011 George Lilly.  Licensed under the terms of the GNU
+ ;Copyright 2011 George Lilly.  
 "RTN","C0CNHIN",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CNHIN",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CNHIN",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CNHIN",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CNHIN",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CNHIN",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CNHIN",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CNHIN",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CNHIN",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CNHIN",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CNHIN",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CNHIN",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CNHIN",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CNHIN",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CNHIN",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ Q
 "RTN","C0CNHIN",19,0)
- ;
+EN(ZRTN,ZDFN,ZPART,KEEP) ; GENERATE AN NHIN ARRAY FOR A PATIENT
 "RTN","C0CNHIN",20,0)
+ ;
+"RTN","C0CNHIN",21,0)
+ K GARY,GNARY,GIDX,C0CDOCID
+"RTN","C0CNHIN",22,0)
+ N GN
+"RTN","C0CNHIN",23,0)
+ K ^TMP("NHINV",$J) ; CLEAN UP FROM LAST CALL
+"RTN","C0CNHIN",24,0)
+ K ^TMP("MXMLDOM",$J) ; CLEAN UP DOM
+"RTN","C0CNHIN",25,0)
+ K ^TMP("MXMLERR",$J) ; CLEAN UP MXML ERRORS
+"RTN","C0CNHIN",26,0)
+ D GET^NHINV(.GN,ZDFN,ZPART) ; CALL NHINV ROUTINES TO PULL XML
+"RTN","C0CNHIN",27,0)
+ S GN=$P(GN,")",1)_")" ; CUT OFF THE REST OF LINE PROTOCOL
+"RTN","C0CNHIN",28,0)
+ S C0CDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML
+"RTN","C0CNHIN",29,0)
+ D DOMO^C0CDOM(C0CDOCID,"/","ZRTN","GIDX","GARY",,"/results/") ; BLD ARRAYS
+"RTN","C0CNHIN",30,0)
+ I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
+"RTN","C0CNHIN",31,0)
+ ;D PROCESS("ZRTN",GN,"/result/",$G(KEEP))
+"RTN","C0CNHIN",32,0)
  Q
-"RTN","C0CNHIN",21,0)
-EN(ZRTN,ZDFN,ZPART,KEEP) ; GENERATE AN NHIN ARRAY FOR A PATIENT
-"RTN","C0CNHIN",22,0)
- ;
-"RTN","C0CNHIN",23,0)
- K GARY,GNARY,GIDX,C0CDOCID
-"RTN","C0CNHIN",24,0)
+"RTN","C0CNHIN",33,0)
+ ;
+"RTN","C0CNHIN",34,0)
+PQRI(ZOUT,KEEP) ; RETURN THE NHIN ARRAY FOR THE PQRI XML TEMPLATE
+"RTN","C0CNHIN",35,0)
+ ;
+"RTN","C0CNHIN",36,0)
+ N ZG
+"RTN","C0CNHIN",37,0)
+ S ZG=$NA(^TMP("PQRIXML",$J))
+"RTN","C0CNHIN",38,0)
+ K @ZG
+"RTN","C0CNHIN",39,0)
+ D GETXML^C0CMXP(ZG,"PQRIXML") ; GET THE XML FROM C0C MISC XML
+"RTN","C0CNHIN",40,0)
+ N C0CDOCID
+"RTN","C0CNHIN",41,0)
+ S C0CDOCID=$$PARSE^C0CDOM(ZG,"PQRIXML") ; PARSE THE XML
+"RTN","C0CNHIN",42,0)
+ D DOMO^C0CDOM(C0CDOCID,"/","ZOUT","GIDX","GARY",,"//submission") ; BLD ARRAYS
+"RTN","C0CNHIN",43,0)
+ I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
+"RTN","C0CNHIN",44,0)
+ Q
+"RTN","C0CNHIN",45,0)
+ ;
+"RTN","C0CNHIN",46,0)
+PQRI2(ZRTN) ; RETURN THE NHIN ARRAY FOR PQRI ONE MEASURE
+"RTN","C0CNHIN",47,0)
+ ;
+"RTN","C0CNHIN",48,0)
+ ;N GG
+"RTN","C0CNHIN",49,0)
+ D GETXML^C0CMXP("GG","PQRI ONE MEASURE")
+"RTN","C0CNHIN",50,0)
+ D PROCESS(ZRTN,"GG","root",1)
+"RTN","C0CNHIN",51,0)
+ Q
+"RTN","C0CNHIN",52,0)
+ ;
+"RTN","C0CNHIN",53,0)
+PROCESS(ZRSLT,ZXML,ZREDUCE,KEEP) ; PARSE AND RUN DOMO ON XML
+"RTN","C0CNHIN",54,0)
+ ; ZRTN IS PASSED BY REFERENCE
+"RTN","C0CNHIN",55,0)
+ ; ZXML IS PASSED BY NAME
+"RTN","C0CNHIN",56,0)
+ ; IF KEEP IS 1, GARY AND GIDX ARE NOT KILLED
+"RTN","C0CNHIN",57,0)
+ ;
+"RTN","C0CNHIN",58,0)
  N GN
-"RTN","C0CNHIN",25,0)
- K ^TMP("NHINV",$J) ; CLEAN UP FROM LAST CALL
-"RTN","C0CNHIN",26,0)
- K ^TMP("MXMLDOM",$J) ; CLEAN UP DOM
-"RTN","C0CNHIN",27,0)
- K ^TMP("MXMLERR",$J) ; CLEAN UP MXML ERRORS
-"RTN","C0CNHIN",28,0)
- D GET^NHINV(.GN,ZDFN,ZPART) ; CALL NHINV ROUTINES TO PULL XML
-"RTN","C0CNHIN",29,0)
- S GN=$P(GN,")",1)_")" ; CUT OFF THE REST OF LINE PROTOCOL
-"RTN","C0CNHIN",30,0)
+"RTN","C0CNHIN",59,0)
+ S GN=$NA(^TMP("C0CPROCESS",$J))
+"RTN","C0CNHIN",60,0)
+ K @GN
+"RTN","C0CNHIN",61,0)
+ M @GN=@ZXML
+"RTN","C0CNHIN",62,0)
  S C0CDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML
-"RTN","C0CNHIN",31,0)
- D DOMO^C0CDOM(C0CDOCID,"/","ZRTN","GIDX","GARY",,"/results/") ; BLD ARRAYS
-"RTN","C0CNHIN",32,0)
+"RTN","C0CNHIN",63,0)
+ K @GN
+"RTN","C0CNHIN",64,0)
+ D DOMO^C0CDOM(C0CDOCID,"/","ZRSLT","GIDX","GARY",,$G(ZREDUCE)) ; BLD ARRAYS
+"RTN","C0CNHIN",65,0)
  I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
-"RTN","C0CNHIN",33,0)
- ;D PROCESS("ZRTN",GN,"/result/",$G(KEEP))
-"RTN","C0CNHIN",34,0)
+"RTN","C0CNHIN",66,0)
  Q
-"RTN","C0CNHIN",35,0)
- ;
-"RTN","C0CNHIN",36,0)
-PQRI(ZOUT,KEEP) ; RETURN THE NHIN ARRAY FOR THE PQRI XML TEMPLATE
-"RTN","C0CNHIN",37,0)
- ;
-"RTN","C0CNHIN",38,0)
- N ZG
-"RTN","C0CNHIN",39,0)
- S ZG=$NA(^TMP("PQRIXML",$J))
-"RTN","C0CNHIN",40,0)
- K @ZG
-"RTN","C0CNHIN",41,0)
- D GETXML^C0CMXP(ZG,"PQRIXML") ; GET THE XML FROM C0C MISC XML
-"RTN","C0CNHIN",42,0)
- N C0CDOCID
-"RTN","C0CNHIN",43,0)
- S C0CDOCID=$$PARSE^C0CDOM(ZG,"PQRIXML") ; PARSE THE XML
-"RTN","C0CNHIN",44,0)
- D DOMO^C0CDOM(C0CDOCID,"/","ZOUT","GIDX","GARY",,"//submission") ; BLD ARRAYS
-"RTN","C0CNHIN",45,0)
- I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
-"RTN","C0CNHIN",46,0)
+"RTN","C0CNHIN",67,0)
+ ;
+"RTN","C0CNHIN",68,0)
+LOADSMRT ; 
+"RTN","C0CNHIN",69,0)
+ ;
+"RTN","C0CNHIN",70,0)
+ K ^GPL("SMART")
+"RTN","C0CNHIN",71,0)
+ S GN=$NA(^GPL("SMART",1))
+"RTN","C0CNHIN",72,0)
+ I $$FTG^%ZISH("/home/george/","alex-lewis2.xml",GN,2) W !,"SMART FILE LOADED"
+"RTN","C0CNHIN",73,0)
  Q
-"RTN","C0CNHIN",47,0)
- ;
-"RTN","C0CNHIN",48,0)
-PQRI2(ZRTN) ; RETURN THE NHIN ARRAY FOR PQRI ONE MEASURE
-"RTN","C0CNHIN",49,0)
- ;
-"RTN","C0CNHIN",50,0)
- ;N GG
-"RTN","C0CNHIN",51,0)
- D GETXML^C0CMXP("GG","PQRI ONE MEASURE")
-"RTN","C0CNHIN",52,0)
- D PROCESS(ZRTN,"GG","root",1)
-"RTN","C0CNHIN",53,0)
+"RTN","C0CNHIN",74,0)
+ ;
+"RTN","C0CNHIN",75,0)
+SMART ; TRY IT WITH SMART
+"RTN","C0CNHIN",76,0)
+ ;
+"RTN","C0CNHIN",77,0)
+ S GN=$NA(^GPL("SMART"))
+"RTN","C0CNHIN",78,0)
+ ;K ^TMP("MXMLDOM",$J)
+"RTN","C0CNHIN",79,0)
+ K ^TMP("MXMLERR",$J)
+"RTN","C0CNHIN",80,0)
+ S C0CDOCID=$$PARSE(GN,"SMART")
+"RTN","C0CNHIN",81,0)
+ D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//rdf:RDF/")
+"RTN","C0CNHIN",82,0)
+ ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
+"RTN","C0CNHIN",83,0)
  Q
-"RTN","C0CNHIN",54,0)
- ;
-"RTN","C0CNHIN",55,0)
-PROCESS(ZRSLT,ZXML,ZREDUCE,KEEP) ; PARSE AND RUN DOMO ON XML
-"RTN","C0CNHIN",56,0)
- ; ZRTN IS PASSED BY REFERENCE
-"RTN","C0CNHIN",57,0)
- ; ZXML IS PASSED BY NAME
-"RTN","C0CNHIN",58,0)
- ; IF KEEP IS 1, GARY AND GIDX ARE NOT KILLED
-"RTN","C0CNHIN",59,0)
- ;
-"RTN","C0CNHIN",60,0)
- N GN
-"RTN","C0CNHIN",61,0)
- S GN=$NA(^TMP("C0CPROCESS",$J))
-"RTN","C0CNHIN",62,0)
- K @GN
-"RTN","C0CNHIN",63,0)
- M @GN=@ZXML
-"RTN","C0CNHIN",64,0)
- S C0CDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML
-"RTN","C0CNHIN",65,0)
- K @GN
-"RTN","C0CNHIN",66,0)
- D DOMO^C0CDOM(C0CDOCID,"/","ZRSLT","GIDX","GARY",,$G(ZREDUCE)) ; BLD ARRAYS
-"RTN","C0CNHIN",67,0)
- I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
-"RTN","C0CNHIN",68,0)
+"RTN","C0CNHIN",84,0)
+ ;
+"RTN","C0CNHIN",85,0)
+CCR ; TRY IT WITH A CCR
+"RTN","C0CNHIN",86,0)
+ ;
+"RTN","C0CNHIN",87,0)
+ S GN=$NA(^GPL("CCR"))
+"RTN","C0CNHIN",88,0)
+ ;K ^TMP("MXMLDOM",$J)
+"RTN","C0CNHIN",89,0)
+ K ^TMP("MXMLERR",$J)
+"RTN","C0CNHIN",90,0)
+ S C0CDOCID=$$PARSE(GN,"CCR")
+"RTN","C0CNHIN",91,0)
+ D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//ContinuityOfCareRecord/Body/")
+"RTN","C0CNHIN",92,0)
+ ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
+"RTN","C0CNHIN",93,0)
  Q
-"RTN","C0CNHIN",69,0)
- ;
-"RTN","C0CNHIN",70,0)
-LOADSMRT ; 
-"RTN","C0CNHIN",71,0)
- ;
-"RTN","C0CNHIN",72,0)
- K ^GPL("SMART")
-"RTN","C0CNHIN",73,0)
- S GN=$NA(^GPL("SMART",1))
-"RTN","C0CNHIN",74,0)
- I $$FTG^%ZISH("/home/george/","alex-lewis2.xml",GN,2) W !,"SMART FILE LOADED"
-"RTN","C0CNHIN",75,0)
+"RTN","C0CNHIN",94,0)
+ ;
+"RTN","C0CNHIN",95,0)
+MED ; TRY IT WITH A CCR MED SECTION
+"RTN","C0CNHIN",96,0)
+ ;
+"RTN","C0CNHIN",97,0)
+ S GN=$NA(^GPL("MED"))
+"RTN","C0CNHIN",98,0)
+ K ^TMP("MXMLDOM",$J)
+"RTN","C0CNHIN",99,0)
+ K ^TMP("MXMLERR",$J)
+"RTN","C0CNHIN",100,0)
+ S C0CDOCID=$$PARSE(GN,"MED")
+"RTN","C0CNHIN",101,0)
+ D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//Medications/")
+"RTN","C0CNHIN",102,0)
+ ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
+"RTN","C0CNHIN",103,0)
  Q
-"RTN","C0CNHIN",76,0)
- ;
-"RTN","C0CNHIN",77,0)
-SMART ; TRY IT WITH SMART
-"RTN","C0CNHIN",78,0)
- ;
-"RTN","C0CNHIN",79,0)
- S GN=$NA(^GPL("SMART"))
-"RTN","C0CNHIN",80,0)
+"RTN","C0CNHIN",104,0)
+ ;
+"RTN","C0CNHIN",105,0)
+CCD ; TRY IT WITH A CCD
+"RTN","C0CNHIN",106,0)
+ ;
+"RTN","C0CNHIN",107,0)
+ S GN=$NA(^GPL("CCD"))
+"RTN","C0CNHIN",108,0)
  ;K ^TMP("MXMLDOM",$J)
-"RTN","C0CNHIN",81,0)
+"RTN","C0CNHIN",109,0)
  K ^TMP("MXMLERR",$J)
-"RTN","C0CNHIN",82,0)
- S C0CDOCID=$$PARSE(GN,"SMART")
-"RTN","C0CNHIN",83,0)
- D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//rdf:RDF/")
-"RTN","C0CNHIN",84,0)
+"RTN","C0CNHIN",110,0)
+ S C0CDOCID=$$PARSE(GN,"CCD")
+"RTN","C0CNHIN",111,0)
+ D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//ClinicalDocument/component/structuredBody/")
+"RTN","C0CNHIN",112,0)
  ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
-"RTN","C0CNHIN",85,0)
+"RTN","C0CNHIN",113,0)
  Q
-"RTN","C0CNHIN",86,0)
- ;
-"RTN","C0CNHIN",87,0)
-CCR ; TRY IT WITH A CCR
-"RTN","C0CNHIN",88,0)
- ;
-"RTN","C0CNHIN",89,0)
- S GN=$NA(^GPL("CCR"))
-"RTN","C0CNHIN",90,0)
- ;K ^TMP("MXMLDOM",$J)
-"RTN","C0CNHIN",91,0)
- K ^TMP("MXMLERR",$J)
-"RTN","C0CNHIN",92,0)
- S C0CDOCID=$$PARSE(GN,"CCR")
-"RTN","C0CNHIN",93,0)
- D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//ContinuityOfCareRecord/Body/")
-"RTN","C0CNHIN",94,0)
- ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
-"RTN","C0CNHIN",95,0)
+"RTN","C0CNHIN",114,0)
+ ;
+"RTN","C0CNHIN",115,0)
+TEST1 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") 
+"RTN","C0CNHIN",116,0)
+ ; PARSED WITH MXML
+"RTN","C0CNHIN",117,0)
+ ; RUN THROUGH XPATH
+"RTN","C0CNHIN",118,0)
+ K GARY,GIDX,C0CDOCID
+"RTN","C0CNHIN",119,0)
+ S GN=$NA(^GPL("NHIN"))
+"RTN","C0CNHIN",120,0)
+ ;S GN=$NA(^GPL("DOMI"))
+"RTN","C0CNHIN",121,0)
+ S C0CDOCID=$$PARSE(GN,"GPLTEST")
+"RTN","C0CNHIN",122,0)
+ D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"/results/")
+"RTN","C0CNHIN",123,0)
+ K ^GPL("GNARY")
+"RTN","C0CNHIN",124,0)
+ M ^GPL("GNARY")=GNARY
+"RTN","C0CNHIN",125,0)
  Q
-"RTN","C0CNHIN",96,0)
- ;
-"RTN","C0CNHIN",97,0)
-MED ; TRY IT WITH A CCR MED SECTION
-"RTN","C0CNHIN",98,0)
- ;
-"RTN","C0CNHIN",99,0)
- S GN=$NA(^GPL("MED"))
-"RTN","C0CNHIN",100,0)
- K ^TMP("MXMLDOM",$J)
-"RTN","C0CNHIN",101,0)
- K ^TMP("MXMLERR",$J)
-"RTN","C0CNHIN",102,0)
- S C0CDOCID=$$PARSE(GN,"MED")
-"RTN","C0CNHIN",103,0)
- D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//Medications/")
-"RTN","C0CNHIN",104,0)
- ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
-"RTN","C0CNHIN",105,0)
+"RTN","C0CNHIN",126,0)
+ ;
+"RTN","C0CNHIN",127,0)
+TEST2 ; PUT GNARY THROUGH DOMI AND STORE XML IN ^GPL("DOMI")
+"RTN","C0CNHIN",128,0)
+ ;
+"RTN","C0CNHIN",129,0)
+ S GN=$NA(^GPL("GNARY"))
+"RTN","C0CNHIN",130,0)
+ S C0CDOCID=$$DOMI^C0CDOM(GN,,"results")
+"RTN","C0CNHIN",131,0)
+ D OUTXML^C0CDOM("G",C0CDOCID)
+"RTN","C0CNHIN",132,0)
+ K ^GPL("DOMI")
+"RTN","C0CNHIN",133,0)
+ M ^GPL("DOMI")=G
+"RTN","C0CNHIN",134,0)
  Q
-"RTN","C0CNHIN",106,0)
- ;
-"RTN","C0CNHIN",107,0)
-CCD ; TRY IT WITH A CCD
-"RTN","C0CNHIN",108,0)
- ;
-"RTN","C0CNHIN",109,0)
- S GN=$NA(^GPL("CCD"))
-"RTN","C0CNHIN",110,0)
- ;K ^TMP("MXMLDOM",$J)
-"RTN","C0CNHIN",111,0)
- K ^TMP("MXMLERR",$J)
-"RTN","C0CNHIN",112,0)
- S C0CDOCID=$$PARSE(GN,"CCD")
-"RTN","C0CNHIN",113,0)
- D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//ClinicalDocument/component/structuredBody/")
-"RTN","C0CNHIN",114,0)
- ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
-"RTN","C0CNHIN",115,0)
+"RTN","C0CNHIN",135,0)
+ ;
+"RTN","C0CNHIN",136,0)
+TEST3 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") 
+"RTN","C0CNHIN",137,0)
+ ; PARSED WITH MXML
+"RTN","C0CNHIN",138,0)
+ ; RUN THROUGH XPATH
+"RTN","C0CNHIN",139,0)
+ K GARY,GIDX,C0CDOCID
+"RTN","C0CNHIN",140,0)
+ ;S GN=$NA(^GPL("NHIN"))
+"RTN","C0CNHIN",141,0)
+ S GN=$NA(^GPL("DOMI"))
+"RTN","C0CNHIN",142,0)
+ S C0CDOCID=$$PARSE(GN,"GPLTEST")
+"RTN","C0CNHIN",143,0)
+ D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"/results/")
+"RTN","C0CNHIN",144,0)
  Q
-"RTN","C0CNHIN",116,0)
- ;
-"RTN","C0CNHIN",117,0)
-TEST1 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") 
-"RTN","C0CNHIN",118,0)
- ; PARSED WITH MXML
-"RTN","C0CNHIN",119,0)
- ; RUN THROUGH XPATH
-"RTN","C0CNHIN",120,0)
- K GARY,GIDX,C0CDOCID
-"RTN","C0CNHIN",121,0)
- S GN=$NA(^GPL("NHIN"))
-"RTN","C0CNHIN",122,0)
- ;S GN=$NA(^GPL("DOMI"))
-"RTN","C0CNHIN",123,0)
- S C0CDOCID=$$PARSE(GN,"GPLTEST")
-"RTN","C0CNHIN",124,0)
- D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"/results/")
-"RTN","C0CNHIN",125,0)
- K ^GPL("GNARY")
-"RTN","C0CNHIN",126,0)
- M ^GPL("GNARY")=GNARY
-"RTN","C0CNHIN",127,0)
+"RTN","C0CNHIN",145,0)
+ ;
+"RTN","C0CNHIN",146,0)
+DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
+"RTN","C0CNHIN",147,0)
+ ; THE XPATH INDEX ZXIDX, PASSED BY NAME
+"RTN","C0CNHIN",148,0)
+ ; THE XPATH ARRAY XPARY, PASSED BY NAME
+"RTN","C0CNHIN",149,0)
+ ; ZOID IS THE STARTING OID
+"RTN","C0CNHIN",150,0)
+ ; ZPATH IS THE STARTING XPATH, USUALLY "/"
+"RTN","C0CNHIN",151,0)
+ ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
+"RTN","C0CNHIN",152,0)
+ ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
+"RTN","C0CNHIN",153,0)
+ I $G(ZREDUX)="" S ZREDUX=""
+"RTN","C0CNHIN",154,0)
+ N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY
+"RTN","C0CNHIN",155,0)
+ N NEWNUM S NEWNUM=""
+"RTN","C0CNHIN",156,0)
+ I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
+"RTN","C0CNHIN",157,0)
+ S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
+"RTN","C0CNHIN",158,0)
+ I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
+"RTN","C0CNHIN",159,0)
+ . N GT S GT=$P(NEWPATH,ZREDUX,2)
+"RTN","C0CNHIN",160,0)
+ . I GT'="" S NEWPATH=GT
+"RTN","C0CNHIN",161,0)
+ S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
+"RTN","C0CNHIN",162,0)
+ N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE
+"RTN","C0CNHIN",163,0)
+ I $D(GA) D  ; PROCESS THE ATTRIBUTES
+"RTN","C0CNHIN",164,0)
+ . N ZI S ZI=""
+"RTN","C0CNHIN",165,0)
+ . F  S ZI=$O(GA(ZI)) Q:ZI=""  D  ; FOR EACH ATTRIBUTE
+"RTN","C0CNHIN",166,0)
+ . . N ZP S ZP=NEWPATH_"/"_ZI ; PATH FOR ATTRIBUTE
+"RTN","C0CNHIN",167,0)
+ . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY
+"RTN","C0CNHIN",168,0)
+ . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE
+"RTN","C0CNHIN",169,0)
+ N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
+"RTN","C0CNHIN",170,0)
+ I $D(GD(2)) D  ;
+"RTN","C0CNHIN",171,0)
+ . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
+"RTN","C0CNHIN",172,0)
+ E  I $D(GD(1)) D  ;
+"RTN","C0CNHIN",173,0)
+ . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
+"RTN","C0CNHIN",174,0)
+ . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY
+"RTN","C0CNHIN",175,0)
+ N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
+"RTN","C0CNHIN",176,0)
+ I ZFRST'=0 D  ; THERE IS A CHILD
+"RTN","C0CNHIN",177,0)
+ . N ZNUM
+"RTN","C0CNHIN",178,0)
+ . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
+"RTN","C0CNHIN",179,0)
+ . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD
+"RTN","C0CNHIN",180,0)
+ N GNXT S GNXT=$$NXTSIB(ZOID)
+"RTN","C0CNHIN",181,0)
+ I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
+"RTN","C0CNHIN",182,0)
+ I GNXT'=0 D  ;
+"RTN","C0CNHIN",183,0)
+ . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
+"RTN","C0CNHIN",184,0)
+ . I (ZNUM="")&(ZMULT) D  ; SIBLING IS FIRST OF MULTIPLES
+"RTN","C0CNHIN",185,0)
+ . . N ZNUM S ZNUM=1 ;
+"RTN","C0CNHIN",186,0)
+ . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
+"RTN","C0CNHIN",187,0)
+ . E  D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB
+"RTN","C0CNHIN",188,0)
  Q
-"RTN","C0CNHIN",128,0)
- ;
-"RTN","C0CNHIN",129,0)
-TEST2 ; PUT GNARY THROUGH DOMI AND STORE XML IN ^GPL("DOMI")
-"RTN","C0CNHIN",130,0)
- ;
-"RTN","C0CNHIN",131,0)
- S GN=$NA(^GPL("GNARY"))
-"RTN","C0CNHIN",132,0)
- S C0CDOCID=$$DOMI^C0CDOM(GN,,"results")
-"RTN","C0CNHIN",133,0)
- D OUTXML^C0CDOM("G",C0CDOCID)
-"RTN","C0CNHIN",134,0)
- K ^GPL("DOMI")
-"RTN","C0CNHIN",135,0)
- M ^GPL("DOMI")=G
-"RTN","C0CNHIN",136,0)
+"RTN","C0CNHIN",189,0)
+ ;
+"RTN","C0CNHIN",190,0)
+ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY
+"RTN","C0CNHIN",191,0)
+ ;
+"RTN","C0CNHIN",192,0)
+ N ZZI,ZZJ,ZZN
+"RTN","C0CNHIN",193,0)
+ S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY
+"RTN","C0CNHIN",194,0)
+ I ZZI="" Q  ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE
+"RTN","C0CNHIN",195,0)
+ S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY
+"RTN","C0CNHIN",196,0)
+ S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .
+"RTN","C0CNHIN",197,0)
+ I ZZI'["]" D  ; A SINGLETON
+"RTN","C0CNHIN",198,0)
+ . S ZZN=1
+"RTN","C0CNHIN",199,0)
+ E  D  ; THERE IS AN [x] OCCURANCE
+"RTN","C0CNHIN",200,0)
+ . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE
+"RTN","C0CNHIN",201,0)
+ . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]
+"RTN","C0CNHIN",202,0)
+ I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
+"RTN","C0CNHIN",203,0)
  Q
-"RTN","C0CNHIN",137,0)
- ;
-"RTN","C0CNHIN",138,0)
-TEST3 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") 
-"RTN","C0CNHIN",139,0)
- ; PARSED WITH MXML
-"RTN","C0CNHIN",140,0)
- ; RUN THROUGH XPATH
-"RTN","C0CNHIN",141,0)
- K GARY,GIDX,C0CDOCID
-"RTN","C0CNHIN",142,0)
- ;S GN=$NA(^GPL("NHIN"))
-"RTN","C0CNHIN",143,0)
- S GN=$NA(^GPL("DOMI"))
-"RTN","C0CNHIN",144,0)
- S C0CDOCID=$$PARSE(GN,"GPLTEST")
-"RTN","C0CNHIN",145,0)
- D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"/results/")
-"RTN","C0CNHIN",146,0)
+"RTN","C0CNHIN",204,0)
+ ;
+"RTN","C0CNHIN",205,0)
+PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
+"RTN","C0CNHIN",206,0)
+ ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
+"RTN","C0CNHIN",207,0)
+ ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
+"RTN","C0CNHIN",208,0)
+ ;Q $$EN^MXMLDOM(INXML)
+"RTN","C0CNHIN",209,0)
+ Q $$EN^MXMLDOM(INXML,"W")
+"RTN","C0CNHIN",210,0)
+ ;
+"RTN","C0CNHIN",211,0)
+ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
+"RTN","C0CNHIN",212,0)
+ N ZN
+"RTN","C0CNHIN",213,0)
+ ;I $$TAG(ZOID)["entry" B
+"RTN","C0CNHIN",214,0)
+ S ZN=$$NXTSIB(ZOID)
+"RTN","C0CNHIN",215,0)
+ I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
+"RTN","C0CNHIN",216,0)
+ Q 0
+"RTN","C0CNHIN",217,0)
+ ;
+"RTN","C0CNHIN",218,0)
+FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
+"RTN","C0CNHIN",219,0)
+ Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
+"RTN","C0CNHIN",220,0)
+ ;
+"RTN","C0CNHIN",221,0)
+PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
+"RTN","C0CNHIN",222,0)
+ Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
+"RTN","C0CNHIN",223,0)
+ ;
+"RTN","C0CNHIN",224,0)
+ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
+"RTN","C0CNHIN",225,0)
+ S HANDLE=C0CDOCID
+"RTN","C0CNHIN",226,0)
+ K @RTN
+"RTN","C0CNHIN",227,0)
+ D GETTXT^MXMLDOM("A")
+"RTN","C0CNHIN",228,0)
  Q
-"RTN","C0CNHIN",147,0)
- ;
-"RTN","C0CNHIN",148,0)
-DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
-"RTN","C0CNHIN",149,0)
- ; THE XPATH INDEX ZXIDX, PASSED BY NAME
-"RTN","C0CNHIN",150,0)
- ; THE XPATH ARRAY XPARY, PASSED BY NAME
-"RTN","C0CNHIN",151,0)
- ; ZOID IS THE STARTING OID
-"RTN","C0CNHIN",152,0)
- ; ZPATH IS THE STARTING XPATH, USUALLY "/"
-"RTN","C0CNHIN",153,0)
- ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
-"RTN","C0CNHIN",154,0)
- ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
-"RTN","C0CNHIN",155,0)
- I $G(ZREDUX)="" S ZREDUX=""
-"RTN","C0CNHIN",156,0)
- N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY
-"RTN","C0CNHIN",157,0)
- N NEWNUM S NEWNUM=""
-"RTN","C0CNHIN",158,0)
- I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
-"RTN","C0CNHIN",159,0)
- S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
-"RTN","C0CNHIN",160,0)
- I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
-"RTN","C0CNHIN",161,0)
- . N GT S GT=$P(NEWPATH,ZREDUX,2)
-"RTN","C0CNHIN",162,0)
- . I GT'="" S NEWPATH=GT
-"RTN","C0CNHIN",163,0)
- S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
-"RTN","C0CNHIN",164,0)
- N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE
-"RTN","C0CNHIN",165,0)
- I $D(GA) D  ; PROCESS THE ATTRIBUTES
-"RTN","C0CNHIN",166,0)
- . N ZI S ZI=""
-"RTN","C0CNHIN",167,0)
- . F  S ZI=$O(GA(ZI)) Q:ZI=""  D  ; FOR EACH ATTRIBUTE
-"RTN","C0CNHIN",168,0)
- . . N ZP S ZP=NEWPATH_"/"_ZI ; PATH FOR ATTRIBUTE
-"RTN","C0CNHIN",169,0)
- . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY
-"RTN","C0CNHIN",170,0)
- . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE
-"RTN","C0CNHIN",171,0)
- N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
-"RTN","C0CNHIN",172,0)
- I $D(GD(2)) D  ;
-"RTN","C0CNHIN",173,0)
- . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
-"RTN","C0CNHIN",174,0)
- E  I $D(GD(1)) D  ;
-"RTN","C0CNHIN",175,0)
- . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
-"RTN","C0CNHIN",176,0)
- . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY
-"RTN","C0CNHIN",177,0)
- N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
-"RTN","C0CNHIN",178,0)
- I ZFRST'=0 D  ; THERE IS A CHILD
-"RTN","C0CNHIN",179,0)
- . N ZNUM
-"RTN","C0CNHIN",180,0)
- . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
-"RTN","C0CNHIN",181,0)
- . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD
-"RTN","C0CNHIN",182,0)
- N GNXT S GNXT=$$NXTSIB(ZOID)
-"RTN","C0CNHIN",183,0)
- I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
-"RTN","C0CNHIN",184,0)
- I GNXT'=0 D  ;
-"RTN","C0CNHIN",185,0)
- . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
-"RTN","C0CNHIN",186,0)
- . I (ZNUM="")&(ZMULT) D  ; SIBLING IS FIRST OF MULTIPLES
-"RTN","C0CNHIN",187,0)
- . . N ZNUM S ZNUM=1 ;
-"RTN","C0CNHIN",188,0)
- . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
-"RTN","C0CNHIN",189,0)
- . E  D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB
-"RTN","C0CNHIN",190,0)
+"RTN","C0CNHIN",229,0)
+ ;
+"RTN","C0CNHIN",230,0)
+TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
+"RTN","C0CNHIN",231,0)
+ ;I ZOID=149 B ;GPLTEST
+"RTN","C0CNHIN",232,0)
+ N X,Y
+"RTN","C0CNHIN",233,0)
+ S Y=""
+"RTN","C0CNHIN",234,0)
+ S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
+"RTN","C0CNHIN",235,0)
+ I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
+"RTN","C0CNHIN",236,0)
+ I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
+"RTN","C0CNHIN",237,0)
+ Q Y
+"RTN","C0CNHIN",238,0)
+ ;
+"RTN","C0CNHIN",239,0)
+NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
+"RTN","C0CNHIN",240,0)
+ Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
+"RTN","C0CNHIN",241,0)
+ ;
+"RTN","C0CNHIN",242,0)
+DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
+"RTN","C0CNHIN",243,0)
+ ;N ZT,ZN S ZT=""
+"RTN","C0CNHIN",244,0)
+ ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
+"RTN","C0CNHIN",245,0)
+ ;Q $G(@C0CDOM@(ZOID,"T",1))
+"RTN","C0CNHIN",246,0)
+ S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
+"RTN","C0CNHIN",247,0)
  Q
-"RTN","C0CNHIN",191,0)
- ;
-"RTN","C0CNHIN",192,0)
-ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY
-"RTN","C0CNHIN",193,0)
- ;
-"RTN","C0CNHIN",194,0)
- N ZZI,ZZJ,ZZN
-"RTN","C0CNHIN",195,0)
- S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY
-"RTN","C0CNHIN",196,0)
- I ZZI="" Q  ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE
-"RTN","C0CNHIN",197,0)
- S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY
-"RTN","C0CNHIN",198,0)
- S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .
-"RTN","C0CNHIN",199,0)
- I ZZI'["]" D  ; A SINGLETON
-"RTN","C0CNHIN",200,0)
- . S ZZN=1
-"RTN","C0CNHIN",201,0)
- E  D  ; THERE IS AN [x] OCCURANCE
-"RTN","C0CNHIN",202,0)
- . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE
-"RTN","C0CNHIN",203,0)
- . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]
-"RTN","C0CNHIN",204,0)
- I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
-"RTN","C0CNHIN",205,0)
+"RTN","C0CNHIN",248,0)
+ ;
+"RTN","C0CNHIN",249,0)
+OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
+"RTN","C0CNHIN",250,0)
+ ;
+"RTN","C0CNHIN",251,0)
+ S C0CDOCID=INID
+"RTN","C0CNHIN",252,0)
+ D START^C0CMXMLB($$TAG(1),,"G")
+"RTN","C0CNHIN",253,0)
+ D NDOUT($$FIRST(1))
+"RTN","C0CNHIN",254,0)
+ D END^C0CMXMLB ;END THE DOCUMENT
+"RTN","C0CNHIN",255,0)
+ M @ZRTN=^TMP("MXMLBLD",$J)
+"RTN","C0CNHIN",256,0)
+ K ^TMP("MXMLBLD",$J)
+"RTN","C0CNHIN",257,0)
  Q
-"RTN","C0CNHIN",206,0)
- ;
-"RTN","C0CNHIN",207,0)
-PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
-"RTN","C0CNHIN",208,0)
- ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
-"RTN","C0CNHIN",209,0)
- ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
-"RTN","C0CNHIN",210,0)
- ;Q $$EN^MXMLDOM(INXML)
-"RTN","C0CNHIN",211,0)
- Q $$EN^MXMLDOM(INXML,"W")
-"RTN","C0CNHIN",212,0)
- ;
-"RTN","C0CNHIN",213,0)
-ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
-"RTN","C0CNHIN",214,0)
- N ZN
-"RTN","C0CNHIN",215,0)
- ;I $$TAG(ZOID)["entry" B
-"RTN","C0CNHIN",216,0)
- S ZN=$$NXTSIB(ZOID)
-"RTN","C0CNHIN",217,0)
- I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
-"RTN","C0CNHIN",218,0)
- Q 0
-"RTN","C0CNHIN",219,0)
- ;
-"RTN","C0CNHIN",220,0)
-FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
-"RTN","C0CNHIN",221,0)
- Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CNHIN",222,0)
- ;
-"RTN","C0CNHIN",223,0)
-PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
-"RTN","C0CNHIN",224,0)
- Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CNHIN",225,0)
- ;
-"RTN","C0CNHIN",226,0)
-ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
-"RTN","C0CNHIN",227,0)
- S HANDLE=C0CDOCID
-"RTN","C0CNHIN",228,0)
- K @RTN
-"RTN","C0CNHIN",229,0)
- D GETTXT^MXMLDOM("A")
-"RTN","C0CNHIN",230,0)
+"RTN","C0CNHIN",258,0)
+ ;
+"RTN","C0CNHIN",259,0)
+NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
+"RTN","C0CNHIN",260,0)
+ N ZI S ZI=$$FIRST(ZOID)
+"RTN","C0CNHIN",261,0)
+ I ZI'=0 D  ; THERE IS A CHILD
+"RTN","C0CNHIN",262,0)
+ . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
+"RTN","C0CNHIN",263,0)
+ . D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN
+"RTN","C0CNHIN",264,0)
+ E  D  ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
+"RTN","C0CNHIN",265,0)
+ . ;W "DOING",ZOID,!
+"RTN","C0CNHIN",266,0)
+ . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
+"RTN","C0CNHIN",267,0)
+ . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
+"RTN","C0CNHIN",268,0)
+ . D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
+"RTN","C0CNHIN",269,0)
+ I $$NXTSIB(ZOID)'=0 D  ; THERE IS A SIBLING
+"RTN","C0CNHIN",270,0)
+ . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
+"RTN","C0CNHIN",271,0)
  Q
-"RTN","C0CNHIN",231,0)
- ;
-"RTN","C0CNHIN",232,0)
-TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
-"RTN","C0CNHIN",233,0)
- ;I ZOID=149 B ;GPLTEST
-"RTN","C0CNHIN",234,0)
- N X,Y
-"RTN","C0CNHIN",235,0)
- S Y=""
-"RTN","C0CNHIN",236,0)
- S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
-"RTN","C0CNHIN",237,0)
- I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
-"RTN","C0CNHIN",238,0)
- I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CNHIN",239,0)
- Q Y
-"RTN","C0CNHIN",240,0)
- ;
-"RTN","C0CNHIN",241,0)
-NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
-"RTN","C0CNHIN",242,0)
- Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CNHIN",243,0)
- ;
-"RTN","C0CNHIN",244,0)
-DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
-"RTN","C0CNHIN",245,0)
- ;N ZT,ZN S ZT=""
-"RTN","C0CNHIN",246,0)
- ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
-"RTN","C0CNHIN",247,0)
- ;Q $G(@C0CDOM@(ZOID,"T",1))
-"RTN","C0CNHIN",248,0)
- S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
-"RTN","C0CNHIN",249,0)
+"RTN","C0CNHIN",272,0)
+ ;
+"RTN","C0CNHIN",273,0)
+WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE
+"RTN","C0CNHIN",274,0)
+ ;
+"RTN","C0CNHIN",275,0)
+ N GN,GN2
+"RTN","C0CNHIN",276,0)
+ D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML
+"RTN","C0CNHIN",277,0)
+ S GN2=$NA(@GN@(1))
+"RTN","C0CNHIN",278,0)
+ W $$OUTPUT^C0CXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")
+"RTN","C0CNHIN",279,0)
  Q
-"RTN","C0CNHIN",250,0)
- ;
-"RTN","C0CNHIN",251,0)
-OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
-"RTN","C0CNHIN",252,0)
- ;
-"RTN","C0CNHIN",253,0)
- S C0CDOCID=INID
-"RTN","C0CNHIN",254,0)
- D START^C0CMXMLB($$TAG(1),,"G")
-"RTN","C0CNHIN",255,0)
- D NDOUT($$FIRST(1))
-"RTN","C0CNHIN",256,0)
- D END^C0CMXMLB ;END THE DOCUMENT
-"RTN","C0CNHIN",257,0)
- M @ZRTN=^TMP("MXMLBLD",$J)
-"RTN","C0CNHIN",258,0)
- K ^TMP("MXMLBLD",$J)
-"RTN","C0CNHIN",259,0)
+"RTN","C0CNHIN",280,0)
+ ;
+"RTN","C0CNHIN",281,0)
+TESTNARY ; TEST MAKING A NHIN ARRAY
+"RTN","C0CNHIN",282,0)
+ N ZI S ZI=""
+"RTN","C0CNHIN",283,0)
+ N ZH ; DOM HANDLE
+"RTN","C0CNHIN",284,0)
+ D TEST1 ; PARSE AN NHIN RESULT INTO THE DOM
+"RTN","C0CNHIN",285,0)
+ S ZH=C0CDOCID ; SET THE HANDLE
+"RTN","C0CNHIN",286,0)
+ N ZD S ZD=$NA(^TMP("MXMLDOM",$J,ZH))
+"RTN","C0CNHIN",287,0)
+ F  S ZI=$O(@ZD@(ZI)) Q:ZI=""  D  ; FOR EACH NODE
+"RTN","C0CNHIN",288,0)
+ . N ZATT
+"RTN","C0CNHIN",289,0)
+ . D MNARY(.ZATT,ZH,ZI)
+"RTN","C0CNHIN",290,0)
+ . N ZPRE,ZN
+"RTN","C0CNHIN",291,0)
+ . S ZPRE=$$PRE(ZI)
+"RTN","C0CNHIN",292,0)
+ . S ZN=$P(ZPRE,",",2)
+"RTN","C0CNHIN",293,0)
+ . S ZPRE=$P(ZPRE,",",1)
+"RTN","C0CNHIN",294,0)
+ . ;I $D(ZATT) ZWR ZATT
+"RTN","C0CNHIN",295,0)
+ . N ZJ S ZJ=""
+"RTN","C0CNHIN",296,0)
+ . F  S ZJ=$O(ZATT(ZJ)) Q:ZJ=""  D  ; FOR EACH ATTRIBUTE
+"RTN","C0CNHIN",297,0)
+ . . W ZPRE_"["_ZN_"]"_$$TAG(ZI)_"."_ZJ_"="_ZATT(ZJ),!
+"RTN","C0CNHIN",298,0)
+ . . S GOUT(ZPRE,ZN,$$TAG(ZI)_"."_ZJ)=ZATT(ZJ)
+"RTN","C0CNHIN",299,0)
  Q
-"RTN","C0CNHIN",260,0)
- ;
-"RTN","C0CNHIN",261,0)
-NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
-"RTN","C0CNHIN",262,0)
- N ZI S ZI=$$FIRST(ZOID)
-"RTN","C0CNHIN",263,0)
- I ZI'=0 D  ; THERE IS A CHILD
-"RTN","C0CNHIN",264,0)
- . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
-"RTN","C0CNHIN",265,0)
- . D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN
-"RTN","C0CNHIN",266,0)
- E  D  ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
-"RTN","C0CNHIN",267,0)
- . ;W "DOING",ZOID,!
-"RTN","C0CNHIN",268,0)
- . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
-"RTN","C0CNHIN",269,0)
- . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
-"RTN","C0CNHIN",270,0)
- . D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
-"RTN","C0CNHIN",271,0)
- I $$NXTSIB(ZOID)'=0 D  ; THERE IS A SIBLING
-"RTN","C0CNHIN",272,0)
- . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
-"RTN","C0CNHIN",273,0)
+"RTN","C0CNHIN",300,0)
+ ;
+"RTN","C0CNHIN",301,0)
+PRE(ZNODE) ; EXTRINSIC WHICH RETURNS THE PREFIX FOR A NODE
+"RTN","C0CNHIN",302,0)
+ ;
+"RTN","C0CNHIN",303,0)
+ N GI,GI2,GPT,GJ,GN
+"RTN","C0CNHIN",304,0)
+ S GI=$$PARENT(ZNODE) ; PARENT NODE
+"RTN","C0CNHIN",305,0)
+ I GI=0 Q ""  ; NO PARENT
+"RTN","C0CNHIN",306,0)
+ S GPT=$$TAG(GI) ; TAG OF PARENT
+"RTN","C0CNHIN",307,0)
+ S GI2=$$PARENT(GI) ; PARENT OF PARENT
+"RTN","C0CNHIN",308,0)
+ I (GI2'=0)&($$TAG(GI2)'="results") S GPT=$$TAG(GI2)_"."_GPT
+"RTN","C0CNHIN",309,0)
+ S GJ=$$FIRST(GI) ; NODE OF FIRST SIB
+"RTN","C0CNHIN",310,0)
+ I GJ=ZNODE Q:$$TAG(GI)_",1"
+"RTN","C0CNHIN",311,0)
+ F GN=2:1 Q:GJ=ZNODE  D  ;
+"RTN","C0CNHIN",312,0)
+ . S GJ=$$NXTSIB(GJ) ; NEXT SIBLING 
+"RTN","C0CNHIN",313,0)
+ Q GPT_","_GN
+"RTN","C0CNHIN",314,0)
+ ;
+"RTN","C0CNHIN",315,0)
+MNARY(ZRTN,ZHANDLE,ZOID) ; MAKE A NHIN ARRAY FROM A DOM NODE
+"RTN","C0CNHIN",316,0)
+ ; RETURNED IN ZRTN, PASSED BY REFERENCE
+"RTN","C0CNHIN",317,0)
+ ; ZHANDLE IS THE DOM DOCUMENT ID
+"RTN","C0CNHIN",318,0)
+ ; ZOID IS THE DOM NODE
+"RTN","C0CNHIN",319,0)
+ D ATT("ZRTN",ZOID)
+"RTN","C0CNHIN",320,0)
  Q
-"RTN","C0CNHIN",274,0)
- ;
-"RTN","C0CNHIN",275,0)
-WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE
-"RTN","C0CNHIN",276,0)
- ;
-"RTN","C0CNHIN",277,0)
- N GN,GN2
-"RTN","C0CNHIN",278,0)
- D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML
-"RTN","C0CNHIN",279,0)
- S GN2=$NA(@GN@(1))
-"RTN","C0CNHIN",280,0)
- W $$OUTPUT^C0CXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")
-"RTN","C0CNHIN",281,0)
- Q
-"RTN","C0CNHIN",282,0)
- ;
-"RTN","C0CNHIN",283,0)
-TESTNARY ; TEST MAKING A NHIN ARRAY
-"RTN","C0CNHIN",284,0)
- N ZI S ZI=""
-"RTN","C0CNHIN",285,0)
- N ZH ; DOM HANDLE
-"RTN","C0CNHIN",286,0)
- D TEST1 ; PARSE AN NHIN RESULT INTO THE DOM
-"RTN","C0CNHIN",287,0)
- S ZH=C0CDOCID ; SET THE HANDLE
-"RTN","C0CNHIN",288,0)
- N ZD S ZD=$NA(^TMP("MXMLDOM",$J,ZH))
-"RTN","C0CNHIN",289,0)
- F  S ZI=$O(@ZD@(ZI)) Q:ZI=""  D  ; FOR EACH NODE
-"RTN","C0CNHIN",290,0)
- . N ZATT
-"RTN","C0CNHIN",291,0)
- . D MNARY(.ZATT,ZH,ZI)
-"RTN","C0CNHIN",292,0)
- . N ZPRE,ZN
-"RTN","C0CNHIN",293,0)
- . S ZPRE=$$PRE(ZI)
-"RTN","C0CNHIN",294,0)
- . S ZN=$P(ZPRE,",",2)
-"RTN","C0CNHIN",295,0)
- . S ZPRE=$P(ZPRE,",",1)
-"RTN","C0CNHIN",296,0)
- . ;I $D(ZATT) ZWR ZATT
-"RTN","C0CNHIN",297,0)
- . N ZJ S ZJ=""
-"RTN","C0CNHIN",298,0)
- . F  S ZJ=$O(ZATT(ZJ)) Q:ZJ=""  D  ; FOR EACH ATTRIBUTE
-"RTN","C0CNHIN",299,0)
- . . W ZPRE_"["_ZN_"]"_$$TAG(ZI)_"."_ZJ_"="_ZATT(ZJ),!
-"RTN","C0CNHIN",300,0)
- . . S GOUT(ZPRE,ZN,$$TAG(ZI)_"."_ZJ)=ZATT(ZJ)
-"RTN","C0CNHIN",301,0)
- Q
-"RTN","C0CNHIN",302,0)
- ;
-"RTN","C0CNHIN",303,0)
-PRE(ZNODE) ; EXTRINSIC WHICH RETURNS THE PREFIX FOR A NODE
-"RTN","C0CNHIN",304,0)
- ;
-"RTN","C0CNHIN",305,0)
- N GI,GI2,GPT,GJ,GN
-"RTN","C0CNHIN",306,0)
- S GI=$$PARENT(ZNODE) ; PARENT NODE
-"RTN","C0CNHIN",307,0)
- I GI=0 Q ""  ; NO PARENT
-"RTN","C0CNHIN",308,0)
- S GPT=$$TAG(GI) ; TAG OF PARENT
-"RTN","C0CNHIN",309,0)
- S GI2=$$PARENT(GI) ; PARENT OF PARENT
-"RTN","C0CNHIN",310,0)
- I (GI2'=0)&($$TAG(GI2)'="results") S GPT=$$TAG(GI2)_"."_GPT
-"RTN","C0CNHIN",311,0)
- S GJ=$$FIRST(GI) ; NODE OF FIRST SIB
-"RTN","C0CNHIN",312,0)
- I GJ=ZNODE Q:$$TAG(GI)_",1"
-"RTN","C0CNHIN",313,0)
- F GN=2:1 Q:GJ=ZNODE  D  ;
-"RTN","C0CNHIN",314,0)
- . S GJ=$$NXTSIB(GJ) ; NEXT SIBLING 
-"RTN","C0CNHIN",315,0)
- Q GPT_","_GN
-"RTN","C0CNHIN",316,0)
- ;
-"RTN","C0CNHIN",317,0)
-MNARY(ZRTN,ZHANDLE,ZOID) ; MAKE A NHIN ARRAY FROM A DOM NODE
-"RTN","C0CNHIN",318,0)
- ; RETURNED IN ZRTN, PASSED BY REFERENCE
-"RTN","C0CNHIN",319,0)
- ; ZHANDLE IS THE DOM DOCUMENT ID
-"RTN","C0CNHIN",320,0)
- ; ZOID IS THE DOM NODE
 "RTN","C0CNHIN",321,0)
- D ATT("ZRTN",ZOID)
-"RTN","C0CNHIN",322,0)
- Q
-"RTN","C0CNHIN",323,0)
  ;
 "RTN","C0CNMED2")
-0^89^B33217786
+0^89^B32627824
 "RTN","C0CNMED2",1,0)
 C0CNMED2 ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009 ; 5/10/12 2:53pm
 "RTN","C0CNMED2",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CNMED2",3,0)
  ; Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel.
 "RTN","C0CNMED2",4,0)
- ; Licensed under the terms of the GNU General Public License.
+ ;
 "RTN","C0CNMED2",5,0)
- ; See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CNMED2",6,0)
- ; 
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CNMED2",7,0)
- ; This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CNMED2",8,0)
- ; it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CNMED2",9,0)
- ; the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CNMED2",10,0)
- ; (at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CNMED2",11,0)
- ; 
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CNMED2",12,0)
- ; This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CNMED2",13,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CNMED2",14,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CNMED2",15,0)
- ; GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CNMED2",16,0)
- ; 
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CNMED2",17,0)
- ; You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CNMED2",18,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CNMED2",19,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ; --Revision History
 "RTN","C0CNMED2",20,0)
- ;
+ ; July 2008 - Initial Version/GPL
 "RTN","C0CNMED2",21,0)
- ; --Revision History
+ ; July 2008 - March 2009 various revisions
 "RTN","C0CNMED2",22,0)
- ; July 2008 - Initial Version/GPL
+ ; March 2009 - Reconstruction of routine as driver for other med routines/SMH
 "RTN","C0CNMED2",23,0)
- ; July 2008 - March 2009 various revisions
+ ; June 2011 - Redone to support all meds using the FOIA NHIN routines/gpl
 "RTN","C0CNMED2",24,0)
- ; March 2009 - Reconstruction of routine as driver for other med routines/SMH
+ ;
 "RTN","C0CNMED2",25,0)
- ; June 2011 - Redone to support all meds using the FOIA NHIN routines/gpl
+ Q
 "RTN","C0CNMED2",26,0)
  ;
 "RTN","C0CNMED2",27,0)
+ ; THIS VERSION IS DEPRECATED BECAUSE IT DOES NOT GENEREATE XML IN
+"RTN","C0CNMED2",28,0)
+ ; THE RIGHT ORDER... AND IT HAS TO BE IN THE RIGHT ORDER... :(
+"RTN","C0CNMED2",29,0)
+ ; GPL
+"RTN","C0CNMED2",30,0)
+ ;
+"RTN","C0CNMED2",31,0)
+EXTRACT(MEDXML,DFN,MEDOUTXML) ; Private; Extract medications into provided XML template
+"RTN","C0CNMED2",32,0)
+ ; DFN passed by reference
+"RTN","C0CNMED2",33,0)
+ ; MEDXML and MEDOUTXML are passed by Name
+"RTN","C0CNMED2",34,0)
+ ; MEDXML is the input template
+"RTN","C0CNMED2",35,0)
+ ; MEDOUTXML is the output template
+"RTN","C0CNMED2",36,0)
+ ; Both of them refer to ^TMP globals where the XML documents are stored
+"RTN","C0CNMED2",37,0)
+ ;
+"RTN","C0CNMED2",38,0)
+ N GN
+"RTN","C0CNMED2",39,0)
+ D EN^C0CNHIN(.GN,DFN,"MED;",1) ; RETRIEVE NHIN ARRAY OF MEDS
+"RTN","C0CNMED2",40,0)
+ ; this call uses GET^NHINV to retrieve xml of the meds and then
+"RTN","C0CNMED2",41,0)
+ ; parses with MXML and uses DOMO^C0CDOM to extract an NHIN array
+"RTN","C0CNMED2",42,0)
+ ;
+"RTN","C0CNMED2",43,0)
+ ; we now create an NHIN Array of the Meds section of the CCR
+"RTN","C0CNMED2",44,0)
+ ;
+"RTN","C0CNMED2",45,0)
+ N ZI S ZI=""
+"RTN","C0CNMED2",46,0)
+ F  S ZI=$O(GN("med",ZI)) Q:ZI=""  D  ; for each med
+"RTN","C0CNMED2",47,0)
+ . N GA S GA=$NA(GN("med",ZI))
+"RTN","C0CNMED2",48,0)
+ . N GM S GM="Medication" ; to keep the lines shorter
+"RTN","C0CNMED2",49,0)
+ . S GC(GM,ZI,"CCRDataObjectID")="MED_"_ZI
+"RTN","C0CNMED2",50,0)
+ . N ZD,ZD2 S ZD=$G(@GA@("ordered@value")) ; FILEMAN DATE
+"RTN","C0CNMED2",51,0)
+ . I ZD="" S ZD=$G(@GA@("start@value")) ; for inpatient meds
+"RTN","C0CNMED2",52,0)
+ . S ZD2=$$FMDTOUTC^C0CUTIL(ZD,"DT")
+"RTN","C0CNMED2",53,0)
+ . S GC(GM,ZI,"DateTime[1].ExactDateTime")=ZD2
+"RTN","C0CNMED2",54,0)
+ . S GC(GM,ZI,"DateTime[1].Type.Text")="Documented Date"
+"RTN","C0CNMED2",55,0)
+ . ;S GC(GM,ZI,"DateTime[2].ExactDateTime")=""
+"RTN","C0CNMED2",56,0)
+ . ;S GC(GM,ZI,"DateTime[2].Type.Text")=""
+"RTN","C0CNMED2",57,0)
+ . N GSIG S GSIG=$G(@GA@("sig"))
+"RTN","C0CNMED2",58,0)
+ . I GSIG["|" S GSIG=$P(GSIG,"|",2) ; eRx has name of drug separated by |
+"RTN","C0CNMED2",59,0)
+ . S GC(GM,ZI,"Description.Text")=GSIG
+"RTN","C0CNMED2",60,0)
+ . N GD S GD="Directions.Direction" ; MAKING THE STRINGS SHORTER
+"RTN","C0CNMED2",61,0)
+ . ;S GC(GM,ZI,GD_".DeliveryMethod.Text")="@@MEDDELIVERYMETHOD@@"
+"RTN","C0CNMED2",62,0)
+ . ;S GC(GM,ZI,GD_".Description.Text")=""
+"RTN","C0CNMED2",63,0)
+ . ;S GC(GM,ZI,GD_".DirectionSequenceModifier")="@@MEDDIRSEQ@@"
+"RTN","C0CNMED2",64,0)
+ . ;S GC(GM,ZI,GD_".Dose.Rate.Units.Unit")="@@MEDRATEUNIT@@"
+"RTN","C0CNMED2",65,0)
+ . ;S GC(GM,ZI,GD_".Dose.Rate.Value")="@@MEDRATEVALUE@@"
+"RTN","C0CNMED2",66,0)
+ . ;S GC(GM,ZI,GD_".Dose.Units.Unit")="@@MEDDOSEUNIT@@"
+"RTN","C0CNMED2",67,0)
+ . ;S GC(GM,ZI,GD_".Dose.Value")="@@MEDDOSEVALUE@@"
+"RTN","C0CNMED2",68,0)
+ . ;S GC(GM,ZI,GD_".DoseIndicator.Text")="@@MEDDOSEINDICATOR@@"
+"RTN","C0CNMED2",69,0)
+ . ;S GC(GM,ZI,GD_".Duration.Units.Unit")="@@MEDDURATIONUNIT@@"
+"RTN","C0CNMED2",70,0)
+ . ;S GC(GM,ZI,GD_".Duration.Value")="@@MEDDURATIONVALUE@@"
+"RTN","C0CNMED2",71,0)
+ . ;S GC(GM,ZI,GD_".Frequency.Value")="@@MEDFREQUENCYVALUE@@"
+"RTN","C0CNMED2",72,0)
+ . ;S GC(GM,ZI,GD_".Indication.PRNFlag.Text")="@@MEDPRNFLAG@@"
+"RTN","C0CNMED2",73,0)
+ . ;S GC(GM,ZI,GD_".Indication.Problem.CCRDataObjectID")=""
+"RTN","C0CNMED2",74,0)
+ . ;S GC(GM,ZI,GD_".Indication.Problem.Description.Code.CodingSystem")=""
+"RTN","C0CNMED2",75,0)
+ . ;S GC(GM,ZI,GD_".Indication.Problem.Description.Code.Value")=""
+"RTN","C0CNMED2",76,0)
+ . ;S GC(GM,ZI,GD_".Indication.Problem.Description.Code.Version")=""
+"RTN","C0CNMED2",77,0)
+ . ;S GC(GM,ZI,GD_".Indication.Problem.Description.Text")=""
+"RTN","C0CNMED2",78,0)
+ . ;S GC(GM,ZI,GD_".Indication.Problem.Source.Actor.ActorID")=""
+"RTN","C0CNMED2",79,0)
+ . ;S GC(GM,ZI,GD_".Indication.Problem.Type.Text")=""
+"RTN","C0CNMED2",80,0)
+ . ;S GC(GM,ZI,GD_".Interval.Units.Unit")="@@MEDINTERVALUNIT@@"
+"RTN","C0CNMED2",81,0)
+ . ;S GC(GM,ZI,GD_".Interval.Value")="@@MEDINTERVALVALUE@@"
+"RTN","C0CNMED2",82,0)
+ . ;S GC(GM,ZI,GD_".MultipleDirectionModifier.Text")="@@MEDMULDIRMOD@@"
+"RTN","C0CNMED2",83,0)
+ . S GC(GM,ZI,GD_".Route.Text")=$G(@GA@("doses.dose@route"))
+"RTN","C0CNMED2",84,0)
+ . ;S GC(GM,ZI,GD_".StopIndicator.Text")="@@MEDSTOPINDICATOR@@"
+"RTN","C0CNMED2",85,0)
+ . ;S GC(GM,ZI,GD_".Vehicle.Text")="@@MEDVEHICLETEXT@@"
+"RTN","C0CNMED2",86,0)
+ . ;S GC(GM,ZI,"FullfillmentInstructions.Text")=""
+"RTN","C0CNMED2",87,0)
+ . ;S GC(GM,ZI,"IDs.ID")="@@MEDRXNO@@"
+"RTN","C0CNMED2",88,0)
+ . ;S GC(GM,ZI,"IDs.Type.Text")="@@MEDRXNOTXT@@"
+"RTN","C0CNMED2",89,0)
+ . ;S GC(GM,ZI,"PatientInstructions.Instruction.Text")="@@MEDPTINSTRUCTIONS@@"
+"RTN","C0CNMED2",90,0)
+ . ;S GC(GM,ZI,"Product.BrandName.Text")="@@MEDBRANDNAMETEXT@@"
+"RTN","C0CNMED2",91,0)
+ . S GC(GM,ZI,"Product.Concentration.Units.Unit")=$G(@GA@("doses.dose@units"))
+"RTN","C0CNMED2",92,0)
+ . S GC(GM,ZI,"Product.Concentration.Value")=$G(@GA@("doses.dose@dose"))
+"RTN","C0CNMED2",93,0)
+ . S GC(GM,ZI,"Product.Form.Text")=$G(@GA@("form@value"))
+"RTN","C0CNMED2",94,0)
+ . N GV S GV=$G(@GA@("products.product.vaProduct@vuid"))
+"RTN","C0CNMED2",95,0)
+ . N GR S GR=$$RXNCUI3^C0PLKUP(GV)
+"RTN","C0CNMED2",96,0)
+ . S GC(GM,ZI,"Product.ProductName.Code.CodingSystem")=$S(GR:"RxNorm",1:"VUID")
+"RTN","C0CNMED2",97,0)
+ . S GC(GM,ZI,"Product.ProductName.Code.Value")=$S(GR:GR,1:GV)
+"RTN","C0CNMED2",98,0)
+ . S GC(GM,ZI,"Product.ProductName.Code.Version")="08AB_081201F"
+"RTN","C0CNMED2",99,0)
+ . S GC(GM,ZI,"Product.ProductName.Text")=$G(@GA@("name@value"))
+"RTN","C0CNMED2",100,0)
+ . S GC(GM,ZI,"Product.Strength.Units.Unit")=$G(@GA@("doses.dose@units"))
+"RTN","C0CNMED2",101,0)
+ . S GC(GM,ZI,"Product.Strength.Value")=$G(@GA@("doses.dose@dose"))
+"RTN","C0CNMED2",102,0)
+ . ;S GC(GM,ZI,"Quantity.Units.Unit")="@@MEDQUANTITYUNIT@@"
+"RTN","C0CNMED2",103,0)
+ . ;S GC(GM,ZI,"Quantity.Value")="@@MEDQUANTITYVALUE@@"
+"RTN","C0CNMED2",104,0)
+ . ;S GC(GM,ZI,"Refills.Refill.Number")="@@MEDRFNO@@"
+"RTN","C0CNMED2",105,0)
+ . N GDUZ S GDUZ=$G(@GA@("orderingProvider@code")) ;PROVIDER DUZ
+"RTN","C0CNMED2",106,0)
+ . S GC(GM,ZI,"Source.Actor.ActorID")="PROVIDER_"_GDUZ
+"RTN","C0CNMED2",107,0)
+ . S GC(GM,ZI,"Status.Text")=$G(@GA@("status@value"))
+"RTN","C0CNMED2",108,0)
+ . S GC(GM,ZI,"Type.Text")="Medication"
+"RTN","C0CNMED2",109,0)
+ N C0CDOCID
+"RTN","C0CNMED2",110,0)
+ S C0CDOCID=$$DOMI^C0CDOM("GC",,"Medications") ; insert to dom
+"RTN","C0CNMED2",111,0)
+ D OUTXML^C0CDOM(MEDOUTXML,C0CDOCID,1) ; render the xml
+"RTN","C0CNMED2",112,0)
+ N ZSIZE S ZSIZE=$O(@MEDOUTXML@(""),-1)
+"RTN","C0CNMED2",113,0)
+ S @MEDOUTXML@(0)=ZSIZE ; RETURN STATUS IS NUMBER OF LINES OF XML
+"RTN","C0CNMED2",114,0)
+ W !,MEDOUTXML
+"RTN","C0CNMED2",115,0)
+ ;ZWR GN
+"RTN","C0CNMED2",116,0)
+ ;ZWR GC
+"RTN","C0CNMED2",117,0)
+ ;B
+"RTN","C0CNMED2",118,0)
  Q
-"RTN","C0CNMED2",28,0)
- ;
-"RTN","C0CNMED2",29,0)
- ; THIS VERSION IS DEPRECATED BECAUSE IT DOES NOT GENEREATE XML IN
-"RTN","C0CNMED2",30,0)
- ; THE RIGHT ORDER... AND IT HAS TO BE IN THE RIGHT ORDER... :(
-"RTN","C0CNMED2",31,0)
- ; GPL
-"RTN","C0CNMED2",32,0)
- ;
-"RTN","C0CNMED2",33,0)
-EXTRACT(MEDXML,DFN,MEDOUTXML) ; Private; Extract medications into provided XML template
-"RTN","C0CNMED2",34,0)
- ; DFN passed by reference
-"RTN","C0CNMED2",35,0)
- ; MEDXML and MEDOUTXML are passed by Name
-"RTN","C0CNMED2",36,0)
- ; MEDXML is the input template
-"RTN","C0CNMED2",37,0)
- ; MEDOUTXML is the output template
-"RTN","C0CNMED2",38,0)
- ; Both of them refer to ^TMP globals where the XML documents are stored
-"RTN","C0CNMED2",39,0)
- ;
-"RTN","C0CNMED2",40,0)
- N GN
-"RTN","C0CNMED2",41,0)
- D EN^C0CNHIN(.GN,DFN,"MED;",1) ; RETRIEVE NHIN ARRAY OF MEDS
-"RTN","C0CNMED2",42,0)
- ; this call uses GET^NHINV to retrieve xml of the meds and then
-"RTN","C0CNMED2",43,0)
- ; parses with MXML and uses DOMO^C0CDOM to extract an NHIN array
-"RTN","C0CNMED2",44,0)
- ;
-"RTN","C0CNMED2",45,0)
- ; we now create an NHIN Array of the Meds section of the CCR
-"RTN","C0CNMED2",46,0)
- ;
-"RTN","C0CNMED2",47,0)
- N ZI S ZI=""
-"RTN","C0CNMED2",48,0)
- F  S ZI=$O(GN("med",ZI)) Q:ZI=""  D  ; for each med
-"RTN","C0CNMED2",49,0)
- . N GA S GA=$NA(GN("med",ZI))
-"RTN","C0CNMED2",50,0)
- . N GM S GM="Medication" ; to keep the lines shorter
-"RTN","C0CNMED2",51,0)
- . S GC(GM,ZI,"CCRDataObjectID")="MED_"_ZI
-"RTN","C0CNMED2",52,0)
- . N ZD,ZD2 S ZD=$G(@GA@("ordered@value")) ; FILEMAN DATE
-"RTN","C0CNMED2",53,0)
- . I ZD="" S ZD=$G(@GA@("start@value")) ; for inpatient meds
-"RTN","C0CNMED2",54,0)
- . S ZD2=$$FMDTOUTC^C0CUTIL(ZD,"DT")
-"RTN","C0CNMED2",55,0)
- . S GC(GM,ZI,"DateTime[1].ExactDateTime")=ZD2
-"RTN","C0CNMED2",56,0)
- . S GC(GM,ZI,"DateTime[1].Type.Text")="Documented Date"
-"RTN","C0CNMED2",57,0)
- . ;S GC(GM,ZI,"DateTime[2].ExactDateTime")=""
-"RTN","C0CNMED2",58,0)
- . ;S GC(GM,ZI,"DateTime[2].Type.Text")=""
-"RTN","C0CNMED2",59,0)
- . N GSIG S GSIG=$G(@GA@("sig"))
-"RTN","C0CNMED2",60,0)
- . I GSIG["|" S GSIG=$P(GSIG,"|",2) ; eRx has name of drug separated by |
-"RTN","C0CNMED2",61,0)
- . S GC(GM,ZI,"Description.Text")=GSIG
-"RTN","C0CNMED2",62,0)
- . N GD S GD="Directions.Direction" ; MAKING THE STRINGS SHORTER
-"RTN","C0CNMED2",63,0)
- . ;S GC(GM,ZI,GD_".DeliveryMethod.Text")="@@MEDDELIVERYMETHOD@@"
-"RTN","C0CNMED2",64,0)
- . ;S GC(GM,ZI,GD_".Description.Text")=""
-"RTN","C0CNMED2",65,0)
- . ;S GC(GM,ZI,GD_".DirectionSequenceModifier")="@@MEDDIRSEQ@@"
-"RTN","C0CNMED2",66,0)
- . ;S GC(GM,ZI,GD_".Dose.Rate.Units.Unit")="@@MEDRATEUNIT@@"
-"RTN","C0CNMED2",67,0)
- . ;S GC(GM,ZI,GD_".Dose.Rate.Value")="@@MEDRATEVALUE@@"
-"RTN","C0CNMED2",68,0)
- . ;S GC(GM,ZI,GD_".Dose.Units.Unit")="@@MEDDOSEUNIT@@"
-"RTN","C0CNMED2",69,0)
- . ;S GC(GM,ZI,GD_".Dose.Value")="@@MEDDOSEVALUE@@"
-"RTN","C0CNMED2",70,0)
- . ;S GC(GM,ZI,GD_".DoseIndicator.Text")="@@MEDDOSEINDICATOR@@"
-"RTN","C0CNMED2",71,0)
- . ;S GC(GM,ZI,GD_".Duration.Units.Unit")="@@MEDDURATIONUNIT@@"
-"RTN","C0CNMED2",72,0)
- . ;S GC(GM,ZI,GD_".Duration.Value")="@@MEDDURATIONVALUE@@"
-"RTN","C0CNMED2",73,0)
- . ;S GC(GM,ZI,GD_".Frequency.Value")="@@MEDFREQUENCYVALUE@@"
-"RTN","C0CNMED2",74,0)
- . ;S GC(GM,ZI,GD_".Indication.PRNFlag.Text")="@@MEDPRNFLAG@@"
-"RTN","C0CNMED2",75,0)
- . ;S GC(GM,ZI,GD_".Indication.Problem.CCRDataObjectID")=""
-"RTN","C0CNMED2",76,0)
- . ;S GC(GM,ZI,GD_".Indication.Problem.Description.Code.CodingSystem")=""
-"RTN","C0CNMED2",77,0)
- . ;S GC(GM,ZI,GD_".Indication.Problem.Description.Code.Value")=""
-"RTN","C0CNMED2",78,0)
- . ;S GC(GM,ZI,GD_".Indication.Problem.Description.Code.Version")=""
-"RTN","C0CNMED2",79,0)
- . ;S GC(GM,ZI,GD_".Indication.Problem.Description.Text")=""
-"RTN","C0CNMED2",80,0)
- . ;S GC(GM,ZI,GD_".Indication.Problem.Source.Actor.ActorID")=""
-"RTN","C0CNMED2",81,0)
- . ;S GC(GM,ZI,GD_".Indication.Problem.Type.Text")=""
-"RTN","C0CNMED2",82,0)
- . ;S GC(GM,ZI,GD_".Interval.Units.Unit")="@@MEDINTERVALUNIT@@"
-"RTN","C0CNMED2",83,0)
- . ;S GC(GM,ZI,GD_".Interval.Value")="@@MEDINTERVALVALUE@@"
-"RTN","C0CNMED2",84,0)
- . ;S GC(GM,ZI,GD_".MultipleDirectionModifier.Text")="@@MEDMULDIRMOD@@"
-"RTN","C0CNMED2",85,0)
- . S GC(GM,ZI,GD_".Route.Text")=$G(@GA@("doses.dose@route"))
-"RTN","C0CNMED2",86,0)
- . ;S GC(GM,ZI,GD_".StopIndicator.Text")="@@MEDSTOPINDICATOR@@"
-"RTN","C0CNMED2",87,0)
- . ;S GC(GM,ZI,GD_".Vehicle.Text")="@@MEDVEHICLETEXT@@"
-"RTN","C0CNMED2",88,0)
- . ;S GC(GM,ZI,"FullfillmentInstructions.Text")=""
-"RTN","C0CNMED2",89,0)
- . ;S GC(GM,ZI,"IDs.ID")="@@MEDRXNO@@"
-"RTN","C0CNMED2",90,0)
- . ;S GC(GM,ZI,"IDs.Type.Text")="@@MEDRXNOTXT@@"
-"RTN","C0CNMED2",91,0)
- . ;S GC(GM,ZI,"PatientInstructions.Instruction.Text")="@@MEDPTINSTRUCTIONS@@"
-"RTN","C0CNMED2",92,0)
- . ;S GC(GM,ZI,"Product.BrandName.Text")="@@MEDBRANDNAMETEXT@@"
-"RTN","C0CNMED2",93,0)
- . S GC(GM,ZI,"Product.Concentration.Units.Unit")=$G(@GA@("doses.dose@units"))
-"RTN","C0CNMED2",94,0)
- . S GC(GM,ZI,"Product.Concentration.Value")=$G(@GA@("doses.dose@dose"))
-"RTN","C0CNMED2",95,0)
- . S GC(GM,ZI,"Product.Form.Text")=$G(@GA@("form@value"))
-"RTN","C0CNMED2",96,0)
- . N GV S GV=$G(@GA@("products.product.vaProduct@vuid"))
-"RTN","C0CNMED2",97,0)
- . N GR S GR=$$RXNCUI3^C0PLKUP(GV)
-"RTN","C0CNMED2",98,0)
- . S GC(GM,ZI,"Product.ProductName.Code.CodingSystem")=$S(GR:"RxNorm",1:"VUID")
-"RTN","C0CNMED2",99,0)
- . S GC(GM,ZI,"Product.ProductName.Code.Value")=$S(GR:GR,1:GV)
-"RTN","C0CNMED2",100,0)
- . S GC(GM,ZI,"Product.ProductName.Code.Version")="08AB_081201F"
-"RTN","C0CNMED2",101,0)
- . S GC(GM,ZI,"Product.ProductName.Text")=$G(@GA@("name@value"))
-"RTN","C0CNMED2",102,0)
- . S GC(GM,ZI,"Product.Strength.Units.Unit")=$G(@GA@("doses.dose@units"))
-"RTN","C0CNMED2",103,0)
- . S GC(GM,ZI,"Product.Strength.Value")=$G(@GA@("doses.dose@dose"))
-"RTN","C0CNMED2",104,0)
- . ;S GC(GM,ZI,"Quantity.Units.Unit")="@@MEDQUANTITYUNIT@@"
-"RTN","C0CNMED2",105,0)
- . ;S GC(GM,ZI,"Quantity.Value")="@@MEDQUANTITYVALUE@@"
-"RTN","C0CNMED2",106,0)
- . ;S GC(GM,ZI,"Refills.Refill.Number")="@@MEDRFNO@@"
-"RTN","C0CNMED2",107,0)
- . N GDUZ S GDUZ=$G(@GA@("orderingProvider@code")) ;PROVIDER DUZ
-"RTN","C0CNMED2",108,0)
- . S GC(GM,ZI,"Source.Actor.ActorID")="PROVIDER_"_GDUZ
-"RTN","C0CNMED2",109,0)
- . S GC(GM,ZI,"Status.Text")=$G(@GA@("status@value"))
-"RTN","C0CNMED2",110,0)
- . S GC(GM,ZI,"Type.Text")="Medication"
-"RTN","C0CNMED2",111,0)
- N C0CDOCID
-"RTN","C0CNMED2",112,0)
- S C0CDOCID=$$DOMI^C0CDOM("GC",,"Medications") ; insert to dom
-"RTN","C0CNMED2",113,0)
- D OUTXML^C0CDOM(MEDOUTXML,C0CDOCID,1) ; render the xml
-"RTN","C0CNMED2",114,0)
- N ZSIZE S ZSIZE=$O(@MEDOUTXML@(""),-1)
-"RTN","C0CNMED2",115,0)
- S @MEDOUTXML@(0)=ZSIZE ; RETURN STATUS IS NUMBER OF LINES OF XML
-"RTN","C0CNMED2",116,0)
- W !,MEDOUTXML
-"RTN","C0CNMED2",117,0)
- ;ZWR GN
-"RTN","C0CNMED2",118,0)
- ;ZWR GC
 "RTN","C0CNMED2",119,0)
- ;B
-"RTN","C0CNMED2",120,0)
- Q
-"RTN","C0CNMED2",121,0)
  ;
 "RTN","C0CNMED4")
-0^90^B99762510
+0^90^B98251317
 "RTN","C0CNMED4",1,0)
 C0CNMED4 ; WV/CCDCCR/SMH/gpl - CCR/CCD PROCESSING FOR MEDICATIONS - Inpatient Meds/Unit Dose ;10/13/08 ; 5/10/12 2:54pm
 "RTN","C0CNMED4",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CNMED4",3,0)
- ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ; Copyright 2008 WorldVistA.  
 "RTN","C0CNMED4",4,0)
- ; General Public License See attached copy of the License.
+ ;
 "RTN","C0CNMED4",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CNMED4",6,0)
- ; This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CNMED4",7,0)
- ; it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CNMED4",8,0)
- ; the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CNMED4",9,0)
- ; (at your option) any later version.
+ ;
 "RTN","C0CNMED4",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CNMED4",11,0)
- ; This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CNMED4",12,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CNMED4",13,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CNMED4",14,0)
- ; GNU General Public License for more details.
+ ;
 "RTN","C0CNMED4",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CNMED4",16,0)
- ; You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CNMED4",17,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CNMED4",18,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ W "NO ENTRY FROM TOP",!
 "RTN","C0CNMED4",19,0)
- ;
+ Q
 "RTN","C0CNMED4",20,0)
- W "NO ENTRY FROM TOP",!
+ ;
 "RTN","C0CNMED4",21,0)
- Q
+EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
 "RTN","C0CNMED4",22,0)
  ;
 "RTN","C0CNMED4",23,0)
-EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
+ ; this routine has be adapted to retrieve meds from GET^NHINV by gpl 6/2011
 "RTN","C0CNMED4",24,0)
  ;
 "RTN","C0CNMED4",25,0)
- ; this routine has be adapted to retrieve meds from GET^NHINV by gpl 6/2011
+ ; MINXML is the Input XML Template, passed by name
 "RTN","C0CNMED4",26,0)
- ;
+ ; DFN is Patient IEN
 "RTN","C0CNMED4",27,0)
- ; MINXML is the Input XML Template, passed by name
+ ; OUTXML is the resultant XML.
 "RTN","C0CNMED4",28,0)
- ; DFN is Patient IEN
+ ;
 "RTN","C0CNMED4",29,0)
- ; OUTXML is the resultant XML.
+ ; MEDS is return array from API.
 "RTN","C0CNMED4",30,0)
- ;
+ ; MED is holds each array element from MEDS, one medicine
 "RTN","C0CNMED4",31,0)
- ; MEDS is return array from API.
+ ; MAP is a mapping variable map (store result) for each med
 "RTN","C0CNMED4",32,0)
- ; MED is holds each array element from MEDS, one medicine
+ ;
 "RTN","C0CNMED4",33,0)
- ; MAP is a mapping variable map (store result) for each med
+ ; Inpatient Meds will be extracted using this routine and and the one following.
 "RTN","C0CNMED4",34,0)
- ;
+ ; Inpatient Meds Unit Dose is going to be C0CMED4
 "RTN","C0CNMED4",35,0)
- ; Inpatient Meds will be extracted using this routine and and the one following.
+ ; Inpatient Meds IVs is going to be C0CMED5
 "RTN","C0CNMED4",36,0)
- ; Inpatient Meds Unit Dose is going to be C0CMED4
+ ;
 "RTN","C0CNMED4",37,0)
- ; Inpatient Meds IVs is going to be C0CMED5
+ ; We will use two Pharmacy ReEnginnering API's:
 "RTN","C0CNMED4",38,0)
- ;
+ ; PSS431^PSS55(DFN,PO,PSDATE,PEDATE,LIST) - provides most info
 "RTN","C0CNMED4",39,0)
- ; We will use two Pharmacy ReEnginnering API's:
+ ; PSS432^PSS55(DFN,PO,LIST) - provides schedule info
 "RTN","C0CNMED4",40,0)
- ; PSS431^PSS55(DFN,PO,PSDATE,PEDATE,LIST) - provides most info
+ ; For more information, see the PRE documentation at:
 "RTN","C0CNMED4",41,0)
- ; PSS432^PSS55(DFN,PO,LIST) - provides schedule info
+ ; http://www.va.gov/vdl/documents/Clinical/Pharm-Inpatient_Med/phar_1_api_r0807.pdf
 "RTN","C0CNMED4",42,0)
- ; For more information, see the PRE documentation at:
+ ; 
 "RTN","C0CNMED4",43,0)
- ; http://www.va.gov/vdl/documents/Clinical/Pharm-Inpatient_Med/phar_1_api_r0807.pdf
+ ; Med data is stored in Unit Dose multiple of file 55, pharmacy patient
 "RTN","C0CNMED4",44,0)
- ; 
+ ;
 "RTN","C0CNMED4",45,0)
- ; Med data is stored in Unit Dose multiple of file 55, pharmacy patient
+ N MEDS,MAP
 "RTN","C0CNMED4",46,0)
- ;
+ ;K ^TMP($J)
 "RTN","C0CNMED4",47,0)
- N MEDS,MAP
+ ;D PSS431^PSS55(DFN,,,,"UD") ; Output is in ^TMP($J,"UD",*)
 "RTN","C0CNMED4",48,0)
- ;K ^TMP($J)
+ ;I ^TMP($J,"UD",0)'>0 S @OUTXML@(0)=0 QUIT  ; No Meds - Quit
 "RTN","C0CNMED4",49,0)
- ;D PSS431^PSS55(DFN,,,,"UD") ; Output is in ^TMP($J,"UD",*)
+ ;; Otherwise, we go on...
 "RTN","C0CNMED4",50,0)
- ;I ^TMP($J,"UD",0)'>0 S @OUTXML@(0)=0 QUIT  ; No Meds - Quit
+ D EN^C0CNHIN(.MEDS,DFN,"MED;") ; gpl get the NHIN Array of meds
 "RTN","C0CNMED4",51,0)
- ;; Otherwise, we go on...
+ I '$D(MEDS) Q  ; no meds
 "RTN","C0CNMED4",52,0)
- D EN^C0CNHIN(.MEDS,DFN,"MED;") ; gpl get the NHIN Array of meds
+ N ZI S ZI=""
 "RTN","C0CNMED4",53,0)
- I '$D(MEDS) Q  ; no meds
+ N ZCOUNT S ZCOUNT=0
 "RTN","C0CNMED4",54,0)
- N ZI S ZI=""
+ F  S ZI=$O(MEDS("med",ZI)) Q:ZI=""  D  ; for each returned med
 "RTN","C0CNMED4",55,0)
- N ZCOUNT S ZCOUNT=0
+ . I $G(MEDS("med",ZI,"vaType@value"))="I" S ZCOUNT=ZCOUNT+1
 "RTN","C0CNMED4",56,0)
- F  S ZI=$O(MEDS("med",ZI)) Q:ZI=""  D  ; for each returned med
+ IF ZCOUNT=0 Q  ; no inpatient meds
 "RTN","C0CNMED4",57,0)
- . I $G(MEDS("med",ZI,"vaType@value"))="I" S ZCOUNT=ZCOUNT+1
+ ;M MEDS=^TMP($J,"UD")
 "RTN","C0CNMED4",58,0)
- IF ZCOUNT=0 Q  ; no inpatient meds
+ ;I DEBUG ZWR MEDS
 "RTN","C0CNMED4",59,0)
- ;M MEDS=^TMP($J,"UD")
+ S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
 "RTN","C0CNMED4",60,0)
- I DEBUG ZWR MEDS
+ ;N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
 "RTN","C0CNMED4",61,0)
- S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) 
+ S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING") ;SETTING FLAG
 "RTN","C0CNMED4",62,0)
- ;N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
+ N I S I=0
 "RTN","C0CNMED4",63,0)
- S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING") ;SETTING FLAG
+ F  S I=$O(MEDS("med",I)) Q:'I  D  ; For each medication
 "RTN","C0CNMED4",64,0)
- N I S I=0 
+ . ;OHUM/RUT 3120507 ;STATUS VALIDATION FOR INPATIENT
 "RTN","C0CNMED4",65,0)
- F  S I=$O(MEDS("med",I)) Q:'I  D  ; For each medication
+ . I ($P(C0CMFLAG,"^",1)'=1) D
 "RTN","C0CNMED4",66,0)
- . ;OHUM/RUT 3120507 ;STATUS VALIDATION FOR INPATIENT
+ . . I ($P(C0CMFLAG,"^",3)=1)&(MEDS("med",I,"vaStatus@value")'="ACTIVE") D
 "RTN","C0CNMED4",67,0)
-        . I ($P(C0CMFLAG,"^",1)'=1) D
+ . . . K MEDS("med",I) Q
 "RTN","C0CNMED4",68,0)
-        . . I ($P(C0CMFLAG,"^",3)=1)&(MEDS("med",I,"vaStatus@value")'="ACTIVE") D
+ . . I ($P(C0CMFLAG,"^",4)=1)&(MEDS("med",I,"vaStatus@value")'="PENDING") D
 "RTN","C0CNMED4",69,0)
-        . . . K MEDS("med",I) Q
+ . . . K MEDS("med",I) Q
 "RTN","C0CNMED4",70,0)
-        . . I ($P(C0CMFLAG,"^",4)=1)&(MEDS("med",I,"vaStatus@value")'="PENDING") D
+ . ;OHUM/RUT
 "RTN","C0CNMED4",71,0)
-        . . . K MEDS("med",I) Q
+ . N MED M MED=MEDS("med",I)
 "RTN","C0CNMED4",72,0)
-        . ;OHUM/RUT
+ . I $G(MED("vaType@value"))'="I" Q  ; not inpatient
 "RTN","C0CNMED4",73,0)
- . N MED M MED=MEDS("med",I)
+ . S MEDCOUNT=MEDCOUNT+1
 "RTN","C0CNMED4",74,0)
- . I $G(MED("vaType@value"))'="I" Q  ; not inpatient
+ . S @MEDMAP@(0)=MEDCOUNT ; Update MedMap array counter
 "RTN","C0CNMED4",75,0)
- . S MEDCOUNT=MEDCOUNT+1
+ . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
 "RTN","C0CNMED4",76,0)
- . S @MEDMAP@(0)=MEDCOUNT ; Update MedMap array counter
+ . ;N RXIEN S RXIEN=MED(.01) ; Order Number
 "RTN","C0CNMED4",77,0)
- . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
+ . N RXIEN S RXIEN=$G(MED("orderID@value")) ; ien of the med
 "RTN","C0CNMED4",78,0)
- . ;N RXIEN S RXIEN=MED(.01) ; Order Number
+ . I DEBUG W "RXIEN IS ",RXIEN,!
 "RTN","C0CNMED4",79,0)
- . N RXIEN S RXIEN=$G(MED("orderID@value")) ; ien of the med
+ . I DEBUG W "MAP= ",MAP,!
 "RTN","C0CNMED4",80,0)
- . I DEBUG W "RXIEN IS ",RXIEN,!
+ . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN
 "RTN","C0CNMED4",81,0)
- . I DEBUG W "MAP= ",MAP,!
+ . S @MAP@("MEDISSUEDATETXT")="Order Date"
 "RTN","C0CNMED4",82,0)
- . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN 
+ . ;S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT")
 "RTN","C0CNMED4",83,0)
- . S @MAP@("MEDISSUEDATETXT")="Order Date"
+ . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($G(MED("start@value")),"DT")
 "RTN","C0CNMED4",84,0)
- . ;S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT")
+ . S @MAP@("MEDLASTFILLDATETXT")="" ; For Outpatient
 "RTN","C0CNMED4",85,0)
- . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($G(MED("start@value")),"DT")
+ . S @MAP@("MEDLASTFILLDATE")="" ; For Outpatient
 "RTN","C0CNMED4",86,0)
- . S @MAP@("MEDLASTFILLDATETXT")="" ; For Outpatient
+ . S @MAP@("MEDRXNOTXT")="" ; For Outpatient
 "RTN","C0CNMED4",87,0)
- . S @MAP@("MEDLASTFILLDATE")="" ; For Outpatient
+ . S @MAP@("MEDRXNO")="" ; For Outpatient
 "RTN","C0CNMED4",88,0)
- . S @MAP@("MEDRXNOTXT")="" ; For Outpatient
+ . S @MAP@("MEDTYPETEXT")="Medication"
 "RTN","C0CNMED4",89,0)
- . S @MAP@("MEDRXNO")="" ; For Outpatient
+ . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
 "RTN","C0CNMED4",90,0)
- . S @MAP@("MEDTYPETEXT")="Medication"
+ . ;S @MAP@("MEDSTATUSTEXT")="ACTIVE" 
 "RTN","C0CNMED4",91,0)
- . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
+ . N C0CMST S C0CMST=$G(MED("vaStatus@value")) ; need to filter status
 "RTN","C0CNMED4",92,0)
- . ;S @MAP@("MEDSTATUSTEXT")="ACTIVE" 
+ . I C0CMST="EXPIRED" S C0CMST="Prior History No Longer Active"
 "RTN","C0CNMED4",93,0)
- . N C0CMST S C0CMST=$G(MED("vaStatus@value")) ; need to filter status
+ . I C0CMST="ACTIVE" S C0CMST="Active" ;
 "RTN","C0CNMED4",94,0)
- . I C0CMST="EXPIRED" S C0CMST="Prior History No Longer Active"
+ . S @MAP@("MEDSTATUSTEXT")=C0CMST
 "RTN","C0CNMED4",95,0)
- . I C0CMST="ACTIVE" S C0CMST="Active" ;
+ . ;S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U)
 "RTN","C0CNMED4",96,0)
- . S @MAP@("MEDSTATUSTEXT")=C0CMST
+ . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$G(MED("orderingProvider@code"))
 "RTN","C0CNMED4",97,0)
- . ;S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U)
+ . ;S @MAP@("MEDPRODUCTNAMETEXT")=MED("DDRUG",1,.01)
 "RTN","C0CNMED4",98,0)
- . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$G(MED("orderingProvider@code"))
+ . S @MAP@("MEDPRODUCTNAMETEXT")=$G(MED("name@value"))
 "RTN","C0CNMED4",99,0)
- . ;S @MAP@("MEDPRODUCTNAMETEXT")=MED("DDRUG",1,.01)
+ . ; NDC is field 31 in the drug file.
 "RTN","C0CNMED4",100,0)
- . S @MAP@("MEDPRODUCTNAMETEXT")=$G(MED("name@value"))
+ . ; The actual drug entry in the drug file is not necessarily supplied.
 "RTN","C0CNMED4",101,0)
- . ; NDC is field 31 in the drug file.
+ . ; It' node 1, internal form.
 "RTN","C0CNMED4",102,0)
- . ; The actual drug entry in the drug file is not necessarily supplied.
+ . ;N MEDIEN S MEDIEN=MED(1,"I")
 "RTN","C0CNMED4",103,0)
- . ; It' node 1, internal form.
+ . ;S @MAP@("MEDPRODUCTNAMECODEVALUE")=$S($L(MEDIEN):$$GET1^DIQ(50,MEDIEN,31,"E"),1:"")
 "RTN","C0CNMED4",104,0)
- . ;N MEDIEN S MEDIEN=MED(1,"I")
+ . N ZVUID S ZVUID=$G(MED("products.product.vaProduct@vuid")) ; VUID
 "RTN","C0CNMED4",105,0)
- . ;S @MAP@("MEDPRODUCTNAMECODEVALUE")=$S($L(MEDIEN):$$GET1^DIQ(50,MEDIEN,31,"E"),1:"")
+ . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION
 "RTN","C0CNMED4",106,0)
- . N ZVUID S ZVUID=$G(MED("products.product.vaProduct@vuid")) ; VUID
+ . D  ;
 "RTN","C0CNMED4",107,0)
- . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION
+ . . S ZC=$$CODE^C0CUTIL(ZVUID)
 "RTN","C0CNMED4",108,0)
- . D  ;
+ . . S ZCD=$P(ZC,"^",1) ; CODE TO USE
 "RTN","C0CNMED4",109,0)
- . . S ZC=$$CODE^C0CUTIL(ZVUID)
+ . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID
 "RTN","C0CNMED4",110,0)
- . . S ZCD=$P(ZC,"^",1) ; CODE TO USE
+ . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION
 "RTN","C0CNMED4",111,0)
- . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID
+ . ;N ZRXNORM S ZRXNORM=""
 "RTN","C0CNMED4",112,0)
- . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION
+ . ;S ZRXNORM=$$RXNCUI3^C0PLKUP(ZVUID)
 "RTN","C0CNMED4",113,0)
- . ;N ZRXNORM S ZRXNORM=""
+ . S @MAP@("MEDPRODUCTNAMECODEVALUE")=ZCD
 "RTN","C0CNMED4",114,0)
- . ;S ZRXNORM=$$RXNCUI3^C0PLKUP(ZVUID)
+ . ;S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=$S($L(MEDIEN):"NDC",1:"")
 "RTN","C0CNMED4",115,0)
- . S @MAP@("MEDPRODUCTNAMECODEVALUE")=ZCD
+ . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=ZCDS
 "RTN","C0CNMED4",116,0)
- . ;S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=$S($L(MEDIEN):"NDC",1:"")
+ . ;S @MAP@("MEDPRODUCTNAMECODEVERSION")=$S($L(MEDIEN):"none",1:"")
 "RTN","C0CNMED4",117,0)
- . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=ZCDS
+ . S @MAP@("MEDPRODUCTNAMECODEVERSION")=ZCDSV
 "RTN","C0CNMED4",118,0)
- . ;S @MAP@("MEDPRODUCTNAMECODEVERSION")=$S($L(MEDIEN):"none",1:"")
+ . S @MAP@("MEDBRANDNAMETEXT")=""
 "RTN","C0CNMED4",119,0)
- . S @MAP@("MEDPRODUCTNAMECODEVERSION")=ZCDSV
+ . S @MAP@("MEDPRODUCTNAMETEXT")=$G(MED("name@value"))_" "_ZCDS_": "_ZCD
 "RTN","C0CNMED4",120,0)
- . S @MAP@("MEDBRANDNAMETEXT")=""
+ . ;I $L(MEDIEN) D DOSE^PSS50(MEDIEN,,,,,"DOSE")
 "RTN","C0CNMED4",121,0)
- . S @MAP@("MEDPRODUCTNAMETEXT")=$G(MED("name@value"))_" "_ZCDS_": "_ZCD
+ . ;I $L(MEDIEN) N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
 "RTN","C0CNMED4",122,0)
- . ;I $L(MEDIEN) D DOSE^PSS50(MEDIEN,,,,,"DOSE")
+ . ;S @MAP@("MEDSTRENGTHVALUE")=$S($L(MEDIEN):DOSEDATA(901),1:"")
 "RTN","C0CNMED4",123,0)
- . ;I $L(MEDIEN) N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
+ . S @MAP@("MEDSTRENGTHVALUE")=$G(MED("doses.dose@dose"))
 "RTN","C0CNMED4",124,0)
- . ;S @MAP@("MEDSTRENGTHVALUE")=$S($L(MEDIEN):DOSEDATA(901),1:"")
+ . ;S @MAP@("MEDSTRENGTHUNIT")=$S($P(DOSEDATA(902),U,2),1:"")
 "RTN","C0CNMED4",125,0)
- . S @MAP@("MEDSTRENGTHVALUE")=$G(MED("doses.dose@dose"))
+ . S @MAP@("MEDSTRENGTHUNIT")=$G(MED("doses.dose@units"))
 "RTN","C0CNMED4",126,0)
- . ;S @MAP@("MEDSTRENGTHUNIT")=$S($P(DOSEDATA(902),U,2),1:"")
+ . ; Units, concentration, etc, come from another call
 "RTN","C0CNMED4",127,0)
- . S @MAP@("MEDSTRENGTHUNIT")=$G(MED("doses.dose@units"))
+ . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
 "RTN","C0CNMED4",128,0)
- . ; Units, concentration, etc, come from another call
+ . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
 "RTN","C0CNMED4",129,0)
- . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
+ . ; NDF Entry IEN, and VA Product Name
 "RTN","C0CNMED4",130,0)
- . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
+ . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
 "RTN","C0CNMED4",131,0)
- . ; NDF Entry IEN, and VA Product Name
+ . ; Documented in the same manual.
 "RTN","C0CNMED4",132,0)
- . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
+ . ;N NDFDATA,CONCDATA
 "RTN","C0CNMED4",133,0)
- . ; Documented in the same manual.
+ . ;I $L(MEDIEN) D
 "RTN","C0CNMED4",134,0)
- . ;N NDFDATA,CONCDATA
+ . ;. D NDF^PSS50(MEDIEN,,,,,"CONC")
 "RTN","C0CNMED4",135,0)
+ . ;. M NDFDATA=^TMP($J,"CONC",MEDIEN)
+"RTN","C0CNMED4",136,0)
+ . ;. N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
+"RTN","C0CNMED4",137,0)
+ . ;. N VAPROD S VAPROD=$P(NDFDATA(22),U)
+"RTN","C0CNMED4",138,0)
+ . ;. ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
+"RTN","C0CNMED4",139,0)
+ . ;. ; and this will crash the call. So...
+"RTN","C0CNMED4",140,0)
+ . ;. I NDFIEN="" S CONCDATA=""
+"RTN","C0CNMED4",141,0)
+ . ;. E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
+"RTN","C0CNMED4",142,0)
+ . ;E  S (NDFDATA,CONCDATA)="" ; This line is defensive programming to prevent undef errors.
+"RTN","C0CNMED4",143,0)
+ . ;S @MAP@("MEDFORMTEXT")=$S($L(MEDIEN):$P(CONCDATA,U,1),1:"")
+"RTN","C0CNMED4",144,0)
+ . S @MAP@("MEDFORMTEXT")=$G(MED("form@value"))
+"RTN","C0CNMED4",145,0)
+ . ;S @MAP@("MEDCONCVALUE")=$S($L(MEDIEN):$P(CONCDATA,U,3),1:"")
+"RTN","C0CNMED4",146,0)
+ . S @MAP@("MEDCONCVALUE")=$G(MED("doses.dose@dose"))
+"RTN","C0CNMED4",147,0)
+ . ;S @MAP@("MEDCONCUNIT")=$S($L(MEDIEN):$P(CONCDATA,U,4),1:"")
+"RTN","C0CNMED4",148,0)
+ . S @MAP@("MEDCONCUNIT")=$G(MED("doses.does@units"))
+"RTN","C0CNMED4",149,0)
+ . ;S @MAP@("MEDQUANTITYVALUE")=""  ; not provided for in Non-VA meds.
+"RTN","C0CNMED4",150,0)
+ . S @MAP@("MEDQUANTITYVALUE")=$G(MED("doses.dose@unitsPerDose")) ;
+"RTN","C0CNMED4",151,0)
+ . ; Oddly, there is no easy place to find the dispense unit.
+"RTN","C0CNMED4",152,0)
+ . ; It's not included in the original call, so we have to go to the drug file.
+"RTN","C0CNMED4",153,0)
+ . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
+"RTN","C0CNMED4",154,0)
+ . ; Node 14.5 is the Dispense Unit
+"RTN","C0CNMED4",155,0)
  . ;I $L(MEDIEN) D
-"RTN","C0CNMED4",136,0)
- . ;. D NDF^PSS50(MEDIEN,,,,,"CONC")
-"RTN","C0CNMED4",137,0)
- . ;. M NDFDATA=^TMP($J,"CONC",MEDIEN)
-"RTN","C0CNMED4",138,0)
- . ;. N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
-"RTN","C0CNMED4",139,0)
- . ;. N VAPROD S VAPROD=$P(NDFDATA(22),U)
-"RTN","C0CNMED4",140,0)
- . ;. ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
-"RTN","C0CNMED4",141,0)
- . ;. ; and this will crash the call. So...
-"RTN","C0CNMED4",142,0)
- . ;. I NDFIEN="" S CONCDATA=""
-"RTN","C0CNMED4",143,0)
- . ;. E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
-"RTN","C0CNMED4",144,0)
- . ;E  S (NDFDATA,CONCDATA)="" ; This line is defensive programming to prevent undef errors.
-"RTN","C0CNMED4",145,0)
- . ;S @MAP@("MEDFORMTEXT")=$S($L(MEDIEN):$P(CONCDATA,U,1),1:"")
-"RTN","C0CNMED4",146,0)
- . S @MAP@("MEDFORMTEXT")=$G(MED("form@value"))
-"RTN","C0CNMED4",147,0)
- . ;S @MAP@("MEDCONCVALUE")=$S($L(MEDIEN):$P(CONCDATA,U,3),1:"")
-"RTN","C0CNMED4",148,0)
- . S @MAP@("MEDCONCVALUE")=$G(MED("doses.dose@dose"))
-"RTN","C0CNMED4",149,0)
- . ;S @MAP@("MEDCONCUNIT")=$S($L(MEDIEN):$P(CONCDATA,U,4),1:"")
-"RTN","C0CNMED4",150,0)
- . S @MAP@("MEDCONCUNIT")=$G(MED("doses.does@units"))
-"RTN","C0CNMED4",151,0)
- . ;S @MAP@("MEDQUANTITYVALUE")=""  ; not provided for in Non-VA meds.
-"RTN","C0CNMED4",152,0)
- . S @MAP@("MEDQUANTITYVALUE")=$G(MED("doses.dose@unitsPerDose")) ;
-"RTN","C0CNMED4",153,0)
- . ; Oddly, there is no easy place to find the dispense unit.
-"RTN","C0CNMED4",154,0)
- . ; It's not included in the original call, so we have to go to the drug file.
-"RTN","C0CNMED4",155,0)
- . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
 "RTN","C0CNMED4",156,0)
- . ; Node 14.5 is the Dispense Unit
+ . ;. D DATA^PSS50(MEDIEN,,,,,"QTY")
 "RTN","C0CNMED4",157,0)
- . ;I $L(MEDIEN) D
+ . ;. N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
 "RTN","C0CNMED4",158,0)
- . ;. D DATA^PSS50(MEDIEN,,,,,"QTY")
+ . ;. S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
 "RTN","C0CNMED4",159,0)
- . ;. N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
+ . ;E  S @MAP@("MEDQUANTITYUNIT")=""
 "RTN","C0CNMED4",160,0)
- . ;. S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
+ . S @MAP@("MEDQUANTITYUNIT")=$G(MED("dose.dose@unitsPerDose"))
 "RTN","C0CNMED4",161,0)
- . ;E  S @MAP@("MEDQUANTITYUNIT")=""
+ . ;
 "RTN","C0CNMED4",162,0)
- . S @MAP@("MEDQUANTITYUNIT")=$G(MED("dose.dose@unitsPerDose"))
+ . ; --- START OF DIRECTIONS ---
 "RTN","C0CNMED4",163,0)
+ . ; Dosage is field 2, route is 3, schedule is 4
+"RTN","C0CNMED4",164,0)
+ . ; These are all free text fields, and don't point to any files
+"RTN","C0CNMED4",165,0)
+ . ; For that reason, I will use the field I never used before:
+"RTN","C0CNMED4",166,0)
+ . ; MEDDIRECTIONDESCRIPTIONTEXT
+"RTN","C0CNMED4",167,0)
+ . ;S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
+"RTN","C0CNMED4",168,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=$G(MED("sig"))
+"RTN","C0CNMED4",169,0)
+ . ; $G(MED("products.product.vaProduct@name"))
+"RTN","C0CNMED4",170,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4"  ; means look in description text. See E2369-05.
+"RTN","C0CNMED4",171,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
+"RTN","C0CNMED4",172,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
+"RTN","C0CNMED4",173,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
+"RTN","C0CNMED4",174,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
+"RTN","C0CNMED4",175,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
+"RTN","C0CNMED4",176,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
+"RTN","C0CNMED4",177,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
+"RTN","C0CNMED4",178,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
+"RTN","C0CNMED4",179,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
+"RTN","C0CNMED4",180,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""
+"RTN","C0CNMED4",181,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""
+"RTN","C0CNMED4",182,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""
+"RTN","C0CNMED4",183,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""
+"RTN","C0CNMED4",184,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""
+"RTN","C0CNMED4",185,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""
+"RTN","C0CNMED4",186,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""
+"RTN","C0CNMED4",187,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""
+"RTN","C0CNMED4",188,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
+"RTN","C0CNMED4",189,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
+"RTN","C0CNMED4",190,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
+"RTN","C0CNMED4",191,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
+"RTN","C0CNMED4",192,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
+"RTN","C0CNMED4",193,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
+"RTN","C0CNMED4",194,0)
  . ;
-"RTN","C0CNMED4",164,0)
- . ; --- START OF DIRECTIONS ---
-"RTN","C0CNMED4",165,0)
- . ; Dosage is field 2, route is 3, schedule is 4
-"RTN","C0CNMED4",166,0)
- . ; These are all free text fields, and don't point to any files
-"RTN","C0CNMED4",167,0)
- . ; For that reason, I will use the field I never used before:
-"RTN","C0CNMED4",168,0)
- . ; MEDDIRECTIONDESCRIPTIONTEXT
-"RTN","C0CNMED4",169,0)
- . ;S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
-"RTN","C0CNMED4",170,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=$G(MED("sig"))
-"RTN","C0CNMED4",171,0)
- . ; $G(MED("products.product.vaProduct@name"))
-"RTN","C0CNMED4",172,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4"  ; means look in description text. See E2369-05.
-"RTN","C0CNMED4",173,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
-"RTN","C0CNMED4",174,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
-"RTN","C0CNMED4",175,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
-"RTN","C0CNMED4",176,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""  
-"RTN","C0CNMED4",177,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""  
-"RTN","C0CNMED4",178,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""  
-"RTN","C0CNMED4",179,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
-"RTN","C0CNMED4",180,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
-"RTN","C0CNMED4",181,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
-"RTN","C0CNMED4",182,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""
-"RTN","C0CNMED4",183,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""
-"RTN","C0CNMED4",184,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""
-"RTN","C0CNMED4",185,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""
-"RTN","C0CNMED4",186,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""
-"RTN","C0CNMED4",187,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""
-"RTN","C0CNMED4",188,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""
-"RTN","C0CNMED4",189,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""
-"RTN","C0CNMED4",190,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
-"RTN","C0CNMED4",191,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
-"RTN","C0CNMED4",192,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
-"RTN","C0CNMED4",193,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")="" 
-"RTN","C0CNMED4",194,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
 "RTN","C0CNMED4",195,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
+ . ; --- END OF DIRECTIONS ---
 "RTN","C0CNMED4",196,0)
  . ;
 "RTN","C0CNMED4",197,0)
- . ; --- END OF DIRECTIONS ---
+ . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
 "RTN","C0CNMED4",198,0)
- . ;
+ . ;S @MAP@("MEDPTINSTRUCTIONS")=MED(10,1) ; WP Field
 "RTN","C0CNMED4",199,0)
- . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
+ . S @MAP@("MEDPTINSTRUCTIONS")=""
 "RTN","C0CNMED4",200,0)
- . ;S @MAP@("MEDPTINSTRUCTIONS")=MED(10,1) ; WP Field
+ . ;S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
 "RTN","C0CNMED4",201,0)
- . S @MAP@("MEDPTINSTRUCTIONS")=""
+ . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
 "RTN","C0CNMED4",202,0)
- . ;S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
+ . S @MAP@("MEDRFNO")=""
 "RTN","C0CNMED4",203,0)
- . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
+ . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
 "RTN","C0CNMED4",204,0)
- . S @MAP@("MEDRFNO")=""
+ . K @RESULT
 "RTN","C0CNMED4",205,0)
- . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
+ . D MAP^C0CXPATH(MINXML,MAP,RESULT)
 "RTN","C0CNMED4",206,0)
- . K @RESULT
+ . ; D PARY^C0CXPATH(RESULT)
 "RTN","C0CNMED4",207,0)
- . D MAP^C0CXPATH(MINXML,MAP,RESULT)
+ . ; MAPPING DIRECTIONS
 "RTN","C0CNMED4",208,0)
- . ; D PARY^C0CXPATH(RESULT)
+ . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
 "RTN","C0CNMED4",209,0)
- . ; MAPPING DIRECTIONS
+ . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
 "RTN","C0CNMED4",210,0)
- . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
+ . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
 "RTN","C0CNMED4",211,0)
- . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
+ . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
 "RTN","C0CNMED4",212,0)
- . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
+ . ; N MDZ1,MDZNA
 "RTN","C0CNMED4",213,0)
- . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
+ . N DIRCNT S DIRCNT=1 ; THERE ARE ALWAYS DIRECTIONS
 "RTN","C0CNMED4",214,0)
- . ; N MDZ1,MDZNA
+ . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
 "RTN","C0CNMED4",215,0)
- . N DIRCNT S DIRCNT=1 ; THERE ARE ALWAYS DIRECTIONS
+ . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
 "RTN","C0CNMED4",216,0)
- . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
+ . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
 "RTN","C0CNMED4",217,0)
- . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
+ . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
 "RTN","C0CNMED4",218,0)
- . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
+ . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
 "RTN","C0CNMED4",219,0)
- . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
+ . D:MEDCOUNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
 "RTN","C0CNMED4",220,0)
- . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
+ . D:MEDCOUNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
 "RTN","C0CNMED4",221,0)
- . D:MEDCOUNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
+ N MEDTMP,MEDI
 "RTN","C0CNMED4",222,0)
- . D:MEDCOUNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
+ D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
 "RTN","C0CNMED4",223,0)
- N MEDTMP,MEDI
+ I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
 "RTN","C0CNMED4",224,0)
- D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+ . W "MEDICATION MISSING ",!
 "RTN","C0CNMED4",225,0)
- I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+ . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
 "RTN","C0CNMED4",226,0)
- . W "MEDICATION MISSING ",!
+ Q
 "RTN","C0CNMED4",227,0)
- . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","C0CNMED4",228,0)
- Q
-"RTN","C0CNMED4",229,0)
  ;
 "RTN","C0CORSLT")
-0^91^B9647157
+0^91^B9272901
 "RTN","C0CORSLT",1,0)
 C0CORSLT ; CCDCCR/GPL - CCR/CCD PROCESSING ADDITIONAL RESULTS ; 06/27/11
 "RTN","C0CORSLT",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CORSLT",3,0)
  ;Copyright 2011 George Lilly.
 "RTN","C0CORSLT",4,0)
- ;Licensed under the terms of the GNU General Public License.
+ ;
 "RTN","C0CORSLT",5,0)
- ;See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CORSLT",6,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CORSLT",7,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CORSLT",8,0)
- ;it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CORSLT",9,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CORSLT",10,0)
- ;(at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CORSLT",11,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CORSLT",12,0)
- ;This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CORSLT",13,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CORSLT",14,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CORSLT",15,0)
- ;GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CORSLT",16,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CORSLT",17,0)
- ;You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CORSLT",18,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ W "NO ENTRY FROM TOP",!
 "RTN","C0CORSLT",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ Q
 "RTN","C0CORSLT",20,0)
  ;
 "RTN","C0CORSLT",21,0)
- W "NO ENTRY FROM TOP",!
+EN(ZVARS,DFN) ; LOOKS FOR CCR RESULTS THAT ARE NOT LAB RESULTS AND ADDS
 "RTN","C0CORSLT",22,0)
+ ; THEM TO THE LAB VARIABLES ZVARS IS PASSED BY REFERENCE
+"RTN","C0CORSLT",23,0)
+ ; AN EXAMPLE IS EKG RESULTS THAT ARE FOUND IN NOTES AND CONSULTS
+"RTN","C0CORSLT",24,0)
+ ; THIS IS CREATED FOR MU CERTIFICATION BY GPL
+"RTN","C0CORSLT",25,0)
+ D ENTRY^C0CCPT(DFN,,,1) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE
+"RTN","C0CORSLT",26,0)
+ N ZN ; RESULT NUMBER
+"RTN","C0CORSLT",27,0)
+ S ZN=$O(@ZVARS@(""),-1) ; NEXT RESULT
+"RTN","C0CORSLT",28,0)
+ N ZI S ZI=""
+"RTN","C0CORSLT",29,0)
+ F  S ZI=$O(VISIT(ZI)) Q:ZI=""  D  ; FOR EACH VISIT
+"RTN","C0CORSLT",30,0)
+ . I $G(VISIT(ZI,"TEXT",1))["ECG DONE" D  ; GOT AN ECG
+"RTN","C0CORSLT",31,0)
+ . . S ZN=ZN+1 ; INCREMENT RESULT COUNT
+"RTN","C0CORSLT",32,0)
+ . . N ZDATE,ZPRV,ZTXT
+"RTN","C0CORSLT",33,0)
+ . . S ZDATE=$G(VISIT(ZI,"DATE",0)) ; DATE OF PROCEDURE
+"RTN","C0CORSLT",34,0)
+ . . S ZPRV=$P($G(VISIT(ZI,"PRV",2)),"^",1) ;PROVIDER
+"RTN","C0CORSLT",35,0)
+ . . S ZTXT=$P($G(VISIT(ZI,"TEXT",4)),"ECG RESULTS: ",2)
+"RTN","C0CORSLT",36,0)
+ . . S @ZVARS@(ZN,"RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(ZDATE,"DT")
+"RTN","C0CORSLT",37,0)
+ . . S @ZVARS@(ZN,"RESULTCODE")="34534-8"
+"RTN","C0CORSLT",38,0)
+ . . S @ZVARS@(ZN,"RESULTCODINGSYSTEM")="LOINC"
+"RTN","C0CORSLT",39,0)
+ . . S @ZVARS@(ZN,"RESULTDESCRIPTIONTEXT")="Electrocardiogram LOINC:34534-8"
+"RTN","C0CORSLT",40,0)
+ . . S @ZVARS@(ZN,"RESULTOBJECTID")="RESULT"_ZN
+"RTN","C0CORSLT",41,0)
+ . . S @ZVARS@(ZN,"RESULTSOURCEACTORID")="ACTORPROVIDER_"_ZPRV
+"RTN","C0CORSLT",42,0)
+ . . S @ZVARS@(ZN,"RESULTSTATUS")=""
+"RTN","C0CORSLT",43,0)
+ . . S @ZVARS@(ZN,"M","TEST",0)=1
+"RTN","C0CORSLT",44,0)
+ . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTCODEVALUE")="34534-8"
+"RTN","C0CORSLT",45,0)
+ . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTCODINGSYSTEM")="LOINC"
+"RTN","C0CORSLT",46,0)
+ . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(ZDATE,"DT")
+"RTN","C0CORSLT",47,0)
+ . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTDESCRIPTIONTEXT")="Electrocardiogram LOINC:34534-8"
+"RTN","C0CORSLT",48,0)
+ . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTFLAG")=""
+"RTN","C0CORSLT",49,0)
+ . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTNORMALDESCTEXT")=""
+"RTN","C0CORSLT",50,0)
+ . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTNORMALSOURCEACTORID")="ACTORORGANIZATION_VASTANUM"
+"RTN","C0CORSLT",51,0)
+ . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTOBJECTID")="RESULTTEST_ECG_"_ZN
+"RTN","C0CORSLT",52,0)
+ . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTSOURCEACTORID")="ACTORPROVIDER"_ZPRV
+"RTN","C0CORSLT",53,0)
+ . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTSTATUSTEXT")="F"
+"RTN","C0CORSLT",54,0)
+ . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTUNITS")=""
+"RTN","C0CORSLT",55,0)
+ . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTVALUE")=ZTXT
+"RTN","C0CORSLT",56,0)
+ . . S @ZVARS@(0)=ZN ; UPDATE RESULTS COUNT
+"RTN","C0CORSLT",57,0)
  Q
-"RTN","C0CORSLT",23,0)
- ;
-"RTN","C0CORSLT",24,0)
-EN(ZVARS,DFN) ; LOOKS FOR CCR RESULTS THAT ARE NOT LAB RESULTS AND ADDS
-"RTN","C0CORSLT",25,0)
- ; THEM TO THE LAB VARIABLES ZVARS IS PASSED BY REFERENCE
-"RTN","C0CORSLT",26,0)
- ; AN EXAMPLE IS EKG RESULTS THAT ARE FOUND IN NOTES AND CONSULTS
-"RTN","C0CORSLT",27,0)
- ; THIS IS CREATED FOR MU CERTIFICATION BY GPL
-"RTN","C0CORSLT",28,0)
- D ENTRY^C0CCPT(DFN,,,1) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE
-"RTN","C0CORSLT",29,0)
- N ZN ; RESULT NUMBER
-"RTN","C0CORSLT",30,0)
- S ZN=$O(@ZVARS@(""),-1) ; NEXT RESULT
-"RTN","C0CORSLT",31,0)
- N ZI S ZI=""
-"RTN","C0CORSLT",32,0)
- F  S ZI=$O(VISIT(ZI)) Q:ZI=""  D  ; FOR EACH VISIT
-"RTN","C0CORSLT",33,0)
- . I $G(VISIT(ZI,"TEXT",1))["ECG DONE" D  ; GOT AN ECG
-"RTN","C0CORSLT",34,0)
- . . S ZN=ZN+1 ; INCREMENT RESULT COUNT
-"RTN","C0CORSLT",35,0)
- . . N ZDATE,ZPRV,ZTXT
-"RTN","C0CORSLT",36,0)
- . . S ZDATE=$G(VISIT(ZI,"DATE",0)) ; DATE OF PROCEDURE
-"RTN","C0CORSLT",37,0)
- . . S ZPRV=$P($G(VISIT(ZI,"PRV",2)),"^",1) ;PROVIDER
-"RTN","C0CORSLT",38,0)
- . . S ZTXT=$P($G(VISIT(ZI,"TEXT",4)),"ECG RESULTS: ",2)
-"RTN","C0CORSLT",39,0)
- . . S @ZVARS@(ZN,"RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(ZDATE,"DT")
-"RTN","C0CORSLT",40,0)
- . . S @ZVARS@(ZN,"RESULTCODE")="34534-8"
-"RTN","C0CORSLT",41,0)
- . . S @ZVARS@(ZN,"RESULTCODINGSYSTEM")="LOINC"
-"RTN","C0CORSLT",42,0)
- . . S @ZVARS@(ZN,"RESULTDESCRIPTIONTEXT")="Electrocardiogram LOINC:34534-8"
-"RTN","C0CORSLT",43,0)
- . . S @ZVARS@(ZN,"RESULTOBJECTID")="RESULT"_ZN
-"RTN","C0CORSLT",44,0)
- . . S @ZVARS@(ZN,"RESULTSOURCEACTORID")="ACTORPROVIDER_"_ZPRV
-"RTN","C0CORSLT",45,0)
- . . S @ZVARS@(ZN,"RESULTSTATUS")=""
-"RTN","C0CORSLT",46,0)
- . . S @ZVARS@(ZN,"M","TEST",0)=1
-"RTN","C0CORSLT",47,0)
- . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTCODEVALUE")="34534-8"
-"RTN","C0CORSLT",48,0)
- . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTCODINGSYSTEM")="LOINC"
-"RTN","C0CORSLT",49,0)
- . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(ZDATE,"DT")
-"RTN","C0CORSLT",50,0)
- . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTDESCRIPTIONTEXT")="Electrocardiogram LOINC:34534-8"
-"RTN","C0CORSLT",51,0)
- . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTFLAG")=""
-"RTN","C0CORSLT",52,0)
- . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTNORMALDESCTEXT")=""
-"RTN","C0CORSLT",53,0)
- . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTNORMALSOURCEACTORID")="ACTORORGANIZATION_VASTANUM"
-"RTN","C0CORSLT",54,0)
- . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTOBJECTID")="RESULTTEST_ECG_"_ZN
-"RTN","C0CORSLT",55,0)
- . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTSOURCEACTORID")="ACTORPROVIDER"_ZPRV
-"RTN","C0CORSLT",56,0)
- . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTSTATUSTEXT")="F"
-"RTN","C0CORSLT",57,0)
- . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTUNITS")=""
 "RTN","C0CORSLT",58,0)
- . . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTVALUE")=ZTXT
+ ;
 "RTN","C0CORSLT",59,0)
- . . S @ZVARS@(0)=ZN ; UPDATE RESULTS COUNT
+OLD ; OLD CODE FOR OTHER WAYS OF DOING THE ECG
 "RTN","C0CORSLT",60,0)
+ ; FOR CERTIFICATION - SAVE EKG RESULTS gpl
+"RTN","C0CORSLT",61,0)
+ W !,"CPT=",ZCPT
+"RTN","C0CORSLT",62,0)
+ I ZCPT["93000" D  ; THIS IS AN EKG
+"RTN","C0CORSLT",63,0)
+ . D RNF1TO2^C0CRNF(C0CPRSLT,"ZRNF") ; SAVE FOR LABS
+"RTN","C0CORSLT",64,0)
+ . M ^GPL("RNF2")=@C0CPRSLT
+"RTN","C0CORSLT",65,0)
  Q
-"RTN","C0CORSLT",61,0)
- ;
-"RTN","C0CORSLT",62,0)
-OLD ; OLD CODE FOR OTHER WAYS OF DOING THE ECG
-"RTN","C0CORSLT",63,0)
- ; FOR CERTIFICATION - SAVE EKG RESULTS gpl
-"RTN","C0CORSLT",64,0)
- W !,"CPT=",ZCPT
-"RTN","C0CORSLT",65,0)
- I ZCPT["93000" D  ; THIS IS AN EKG
 "RTN","C0CORSLT",66,0)
- . D RNF1TO2^C0CRNF(C0CPRSLT,"ZRNF") ; SAVE FOR LABS
-"RTN","C0CORSLT",67,0)
- . M ^GPL("RNF2")=@C0CPRSLT
-"RTN","C0CORSLT",68,0)
- Q
-"RTN","C0CORSLT",69,0)
  ;
 "RTN","C0COVREL")
-0^102^B18541513
+0^102^B19589538
 "RTN","C0COVREL",1,0)
 C0COVREL ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15
 "RTN","C0COVREL",2,0)
-        ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0COVREL",3,0)
-LIST    ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
+ ; (C) ELN 2012
 "RTN","C0COVREL",4,0)
-        N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CLB2,C0CLB,C0CLI,C0CLOBX,C0CTAB,C0CTYP
+ ;
 "RTN","C0COVREL",5,0)
-        I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0COVREL",6,0)
-        I '$D(C0CQT) S C0CQT=0
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0COVREL",7,0)
-        I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0COVREL",8,0)
-        I '$D(^TMP("C0CCCR","LABTBL",0)) D SETTBL^C0COVREU ;INITIALIZE LAB TABLE
+ ; License, or (at your option) any later version.
 "RTN","C0COVREL",9,0)
-        I ^TMP("C0CCCR","LABTBL",0)'="V3" D SETTBL^C0COVREU ;NEED NEWEST VERSION
+ ;
 "RTN","C0COVREL",10,0)
-        I '$D(^TMP("HLS",$J,1)) D GHL7^C0COVREU ; GET HL7 MGS IF NOT ALREADY DONE
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0COVREL",11,0)
-        S C0CTAB=$NA(^TMP("C0CCCR","LABTBL")) ; BASE OF OBX TABLE
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0COVREL",12,0)
-        S C0CHB=$NA(^TMP("HLS",$J))
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0COVREL",13,0)
-        S C0CI=""
+ ; GNU Affero General Public License for more details.
 "RTN","C0COVREL",14,0)
-        S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT
+ ;
 "RTN","C0COVREL",15,0)
-        F  S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI=""  D  ; FOR ALL RECORDS IN HL7 MSG
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0COVREL",16,0)
-        . K C0CVAR,XV,C0CX1,C0CX2 ; CLEAR OUT VARIABLE VALUES
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0COVREL",17,0)
-        . S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
+ ;
 "RTN","C0COVREL",18,0)
-        . D LTYP^C0COVREU(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
+LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
 "RTN","C0COVREL",19,0)
-        . M XV=C0CVAR ;
+ N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CLB2,C0CLB,C0CLI,C0CLOBX,C0CTAB,C0CTYP
 "RTN","C0COVREL",20,0)
-        . I C0CTYP="OBR" D  ; BEGINNING OF NEW SECTION
+ I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
 "RTN","C0COVREL",21,0)
-        . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
+ I '$D(C0CQT) S C0CQT=0
 "RTN","C0COVREL",22,0)
-        . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
+ I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
 "RTN","C0COVREL",23,0)
-        . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
+ I '$D(^TMP("C0CCCR","LABTBL",0)) D SETTBL^C0COVREU ;INITIALIZE LAB TABLE
 "RTN","C0COVREL",24,0)
-        . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
+ I ^TMP("C0CCCR","LABTBL",0)'="V3" D SETTBL^C0COVREU ;NEED NEWEST VERSION
 "RTN","C0COVREL",25,0)
-        . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
+ I '$D(^TMP("HLS",$J,1)) D GHL7^C0COVREU ; GET HL7 MGS IF NOT ALREADY DONE
 "RTN","C0COVREL",26,0)
-        . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
+ S C0CTAB=$NA(^TMP("C0CCCR","LABTBL")) ; BASE OF OBX TABLE
 "RTN","C0COVREL",27,0)
-        . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
+ S C0CHB=$NA(^TMP("HLS",$J))
 "RTN","C0COVREL",28,0)
-        . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
+ S C0CI=""
 "RTN","C0COVREL",29,0)
-        . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
+ S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT
 "RTN","C0COVREL",30,0)
-        . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
+ F  S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI=""  D  ; FOR ALL RECORDS IN HL7 MSG
 "RTN","C0COVREL",31,0)
-        . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
+ . K C0CVAR,XV,C0CX1,C0CX2 ; CLEAR OUT VARIABLE VALUES
 "RTN","C0COVREL",32,0)
-        . I C0CTYP="OBX" D  ; SPECIAL CASE FOR OBX
+ . S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
 "RTN","C0COVREL",33,0)
-        . . ; RESULTTESTCODEVALUE AND RESULTTESTDESCRIPTIONTEXT
+ . D LTYP^C0COVREU(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
 "RTN","C0COVREL",34,0)
-        . . I C0CVAR("C3")="LN" D  ; PRIMARY CODE IS LOINC
+ . M XV=C0CVAR ;
 "RTN","C0COVREL",35,0)
-        . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE LOINC CODE VALUE
+ . I C0CTYP="OBR" D  ; BEGINNING OF NEW SECTION
 "RTN","C0COVREL",36,0)
-        . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
+ . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
 "RTN","C0COVREL",37,0)
-        . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT
+ . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
 "RTN","C0COVREL",38,0)
-        . . E  I C0CVAR("C6")="LN" D  ; SECONDARY CODE IS LOINC
+ . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
 "RTN","C0COVREL",39,0)
-        . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; THE LOINC CODE VALUE
+ . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
 "RTN","C0COVREL",40,0)
-        . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
+ . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
 "RTN","C0COVREL",41,0)
-        . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; DESCRIPTION TEXT
+ . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
 "RTN","C0COVREL",42,0)
-        . . E  I C0CVAR("C6")'="" D  ; NO LOINC CODES, USE SECONDARY IF PRESENT
+ . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
 "RTN","C0COVREL",43,0)
-        . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
+ . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
 "RTN","C0COVREL",44,0)
-        . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
+ . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
 "RTN","C0COVREL",45,0)
-        . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
+ . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
 "RTN","C0COVREL",46,0)
-        . . E  D  ; NO SECONDARY, USE PRIMARY
+ . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
 "RTN","C0COVREL",47,0)
-        . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
+ . I C0CTYP="OBX" D  ; SPECIAL CASE FOR OBX
 "RTN","C0COVREL",48,0)
-        . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
+ . . ; RESULTTESTCODEVALUE AND RESULTTESTDESCRIPTIONTEXT
 "RTN","C0COVREL",49,0)
-        . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
+ . . I C0CVAR("C3")="LN" D  ; PRIMARY CODE IS LOINC
 "RTN","C0COVREL",50,0)
-        . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;
+ . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE LOINC CODE VALUE
 "RTN","C0COVREL",51,0)
-        . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG
+ . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
 "RTN","C0COVREL",52,0)
-        . . S C0CZG=XV("RESULTTESTVALUE")
+ . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT
 "RTN","C0COVREL",53,0)
-        . . S XV("RESULTTESTVALUE")=C0CZG
+ . . E  I C0CVAR("C6")="LN" D  ; SECONDARY CODE IS LOINC
 "RTN","C0COVREL",54,0)
-        . I C0CTYP="OBX" D  ; PROCESS TEST RESULTS
+ . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; THE LOINC CODE VALUE
 "RTN","C0COVREL",55,0)
-        . . I C0CLOBX=0 D  ; FIRST TEST RESULT FOR THIS SECTION
+ . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
 "RTN","C0COVREL",56,0)
-        . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
+ . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; DESCRIPTION TEXT
 "RTN","C0COVREL",57,0)
-        . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
+ . . E  I C0CVAR("C6")'="" D  ; NO LOINC CODES, USE SECONDARY IF PRESENT
 "RTN","C0COVREL",58,0)
-        . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
+ . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
 "RTN","C0COVREL",59,0)
-        . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
+ . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
 "RTN","C0COVREL",60,0)
-        . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE
+ . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
 "RTN","C0COVREL",61,0)
-        . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER
+ . . E  D  ; NO SECONDARY, USE PRIMARY
 "RTN","C0COVREL",62,0)
-        . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2
+ . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
 "RTN","C0COVREL",63,0)
-        . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
+ . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
 "RTN","C0COVREL",64,0)
-        . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT
+ . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
 "RTN","C0COVREL",65,0)
-        . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
+ . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;
 "RTN","C0COVREL",66,0)
-        . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
+ . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG
 "RTN","C0COVREL",67,0)
-        . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
+ . . S C0CZG=XV("RESULTTESTVALUE")
 "RTN","C0COVREL",68,0)
-        . I 'C0CQT D  ;
+ . . S XV("RESULTTESTVALUE")=C0CZG
 "RTN","C0COVREL",69,0)
-        . . W C0CI," ",C0CTYP,!
+ . I C0CTYP="OBX" D  ; PROCESS TEST RESULTS
 "RTN","C0COVREL",70,0)
-        Q
+ . . I C0CLOBX=0 D  ; FIRST TEST RESULT FOR THIS SECTION
+"RTN","C0COVREL",71,0)
+ . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
+"RTN","C0COVREL",72,0)
+ . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
+"RTN","C0COVREL",73,0)
+ . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
+"RTN","C0COVREL",74,0)
+ . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
+"RTN","C0COVREL",75,0)
+ . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE
+"RTN","C0COVREL",76,0)
+ . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER
+"RTN","C0COVREL",77,0)
+ . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2
+"RTN","C0COVREL",78,0)
+ . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
+"RTN","C0COVREL",79,0)
+ . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT
+"RTN","C0COVREL",80,0)
+ . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
+"RTN","C0COVREL",81,0)
+ . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
+"RTN","C0COVREL",82,0)
+ . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
+"RTN","C0COVREL",83,0)
+ . I 'C0CQT D  ;
+"RTN","C0COVREL",84,0)
+ . . W C0CI," ",C0CTYP,!
+"RTN","C0COVREL",85,0)
+ Q
 "RTN","C0COVRES")
-0^103^B24677897
+0^103^B23183700
 "RTN","C0COVRES",1,0)
 C0COVRES ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15
 "RTN","C0COVRES",2,0)
-        ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0COVRES",3,0)
-        ;
+ ; (C) ELN 2012
 "RTN","C0COVRES",4,0)
+ ;
+"RTN","C0COVRES",5,0)
+ ; This program is free software: you can redistribute it and/or modify
+"RTN","C0COVRES",6,0)
+ ; it under the terms of the GNU Affero General Public License as
+"RTN","C0COVRES",7,0)
+ ; published by the Free Software Foundation, either version 3 of the
+"RTN","C0COVRES",8,0)
+ ; License, or (at your option) any later version.
+"RTN","C0COVRES",9,0)
+ ;
+"RTN","C0COVRES",10,0)
+ ; This program is distributed in the hope that it will be useful,
+"RTN","C0COVRES",11,0)
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","C0COVRES",12,0)
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","C0COVRES",13,0)
+ ; GNU Affero General Public License for more details.
+"RTN","C0COVRES",14,0)
+ ;
+"RTN","C0COVRES",15,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0COVRES",16,0)
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+"RTN","C0COVRES",17,0)
+ ;
+"RTN","C0COVRES",18,0)
 MAP(MIXML,DFN,MOXML)    ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
-"RTN","C0COVRES",5,0)
-        ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
-"RTN","C0COVRES",6,0)
-        ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
-"RTN","C0COVRES",7,0)
-        ; MIXML IS THE TEMPLATE TO USE
-"RTN","C0COVRES",8,0)
-        ; MOXML IS THE OUTPUT XML ARRAY
-"RTN","C0COVRES",9,0)
-        ; DFN IS THE PATIENT RECORD NUMBER
-"RTN","C0COVRES",10,0)
-        N C0COXML,C0CO,C0CV,C0CIXML
-"RTN","C0COVRES",11,0)
-        I '$D(MIVAR) S C0CV="" ;DEFAULT
-"RTN","C0COVRES",12,0)
-        E  S C0CV=MIVAR ;PASSED VARIABLE ARRAY
-"RTN","C0COVRES",13,0)
-        I '$D(MIXML) S C0CIXML="" ;DEFAULT
-"RTN","C0COVRES",14,0)
-        E  S C0CIXML=MIXML ;PASSED INPUT XML
-"RTN","C0COVRES",15,0)
-        D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
-"RTN","C0COVRES",16,0)
-        I '$D(MOXML) S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
-"RTN","C0COVRES",17,0)
-        E  S C0CO=MOXML
-"RTN","C0COVRES",18,0)
-        M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
 "RTN","C0COVRES",19,0)
-        Q
+ ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
 "RTN","C0COVRES",20,0)
+ ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
+"RTN","C0COVRES",21,0)
+ ; MIXML IS THE TEMPLATE TO USE
+"RTN","C0COVRES",22,0)
+ ; MOXML IS THE OUTPUT XML ARRAY
+"RTN","C0COVRES",23,0)
+ ; DFN IS THE PATIENT RECORD NUMBER
+"RTN","C0COVRES",24,0)
+ N C0COXML,C0CO,C0CV,C0CIXML
+"RTN","C0COVRES",25,0)
+ I '$D(MIVAR) S C0CV="" ;DEFAULT
+"RTN","C0COVRES",26,0)
+ E  S C0CV=MIVAR ;PASSED VARIABLE ARRAY
+"RTN","C0COVRES",27,0)
+ I '$D(MIXML) S C0CIXML="" ;DEFAULT
+"RTN","C0COVRES",28,0)
+ E  S C0CIXML=MIXML ;PASSED INPUT XML
+"RTN","C0COVRES",29,0)
+ D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
+"RTN","C0COVRES",30,0)
+ I '$D(MOXML) S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
+"RTN","C0COVRES",31,0)
+ E  S C0CO=MOXML
+"RTN","C0COVRES",32,0)
+ M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
+"RTN","C0COVRES",33,0)
+ Q
+"RTN","C0COVRES",34,0)
 RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS
-"RTN","C0COVRES",21,0)
-        ; RTN IS PASSED BY REFERENCE
-"RTN","C0COVRES",22,0)
-        N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
-"RTN","C0COVRES",23,0)
-        N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
-"RTN","C0COVRES",24,0)
-        I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
-"RTN","C0COVRES",25,0)
-        I RMIXML="" D  ; INPUT XML NOT PASSED
-"RTN","C0COVRES",26,0)
-        . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
-"RTN","C0COVRES",27,0)
-        . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
-"RTN","C0COVRES",28,0)
-        . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
-"RTN","C0COVRES",29,0)
-        E  S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
-"RTN","C0COVRES",30,0)
-        I RMIVAR="" D  ; LOCATION OF VARIABLES NOT PASSED
-"RTN","C0COVRES",31,0)
-        . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
-"RTN","C0COVRES",32,0)
-        E  S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
-"RTN","C0COVRES",33,0)
-        D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
-"RTN","C0COVRES",34,0)
-        D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
 "RTN","C0COVRES",35,0)
-        D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
+ ; RTN IS PASSED BY REFERENCE
 "RTN","C0COVRES",36,0)
-        D EXTRACT("C0CT",DFN,) ; LAB EXTRACT
+ N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
 "RTN","C0COVRES",37,0)
-        D EXTRACT^C0CRARPT("C0CT",DFN,) ; RAD REPORT EXTRACT
+ N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
 "RTN","C0COVRES",38,0)
-        ;OHUM/RUT 3111221
+ I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
 "RTN","C0COVRES",39,0)
-        ;D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT
+ I RMIXML="" D  ; INPUT XML NOT PASSED
 "RTN","C0COVRES",40,0)
-        I ^TMP("C0CCCR","TIULIMIT")'="" D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT
+ . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
 "RTN","C0COVRES",41,0)
-        ;OHUM/RUT
+ . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
 "RTN","C0COVRES",42,0)
-        I '$D(@C0CV@(0)) D  Q  ; NO VARS THERE
+ . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
 "RTN","C0COVRES",43,0)
-        . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
+ E  S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
 "RTN","C0COVRES",44,0)
-        ; NO RESULTS
+ I RMIVAR="" D  ; LOCATION OF VARIABLES NOT PASSED
 "RTN","C0COVRES",45,0)
-        I @C0CV@(0)=0 S RTN(0)=0 Q
+ . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
 "RTN","C0COVRES",46,0)
-        S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
+ E  S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
 "RTN","C0COVRES",47,0)
-        K @RIMVARS
+ D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
 "RTN","C0COVRES",48,0)
-        ;M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
+ D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
 "RTN","C0COVRES",49,0)
-        N C0CI,C0CIN,C0CJ,C0CJN,C0CJE,C0CJS,C0CMAP,C0CTMAP,C0CTMP
+ D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
 "RTN","C0COVRES",50,0)
-        S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
+ D EXTRACT("C0CT",DFN,) ; LAB EXTRACT
 "RTN","C0COVRES",51,0)
-        N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
+ D EXTRACT^C0CRARPT("C0CT",DFN,) ; RAD REPORT EXTRACT
 "RTN","C0COVRES",52,0)
-        N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
+ ;OHUM/RUT 3111221
 "RTN","C0COVRES",53,0)
-        N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
+ ;D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT
 "RTN","C0COVRES",54,0)
-        ; TO IMPROVE PERFORMANCE
+ I ^TMP("C0CCCR","TIULIMIT")'="" D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT
 "RTN","C0COVRES",55,0)
-        D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
+ ;OHUM/RUT
 "RTN","C0COVRES",56,0)
-        F C0CI=1:1:C0CIN D  ; LOOP THROUGH VARIABLES
+ I '$D(@C0CV@(0)) D  Q  ; NO VARS THERE
 "RTN","C0COVRES",57,0)
-        . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
+ . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
 "RTN","C0COVRES",58,0)
-        . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
+ ; NO RESULTS
 "RTN","C0COVRES",59,0)
-        . S C0CMAP=$NA(@C0CV@(C0CI)) ;MAPPING FOR TEST REQUEST GOES HERE
+ I @C0CV@(0)=0 S RTN(0)=0 Q
 "RTN","C0COVRES",60,0)
-        . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
+ S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
 "RTN","C0COVRES",61,0)
-        . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
+ K @RIMVARS
 "RTN","C0COVRES",62,0)
-        . I $D(@C0CMAP@("M","TEST",0)) D  ; TESTS EXIST
+ ;M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
 "RTN","C0COVRES",63,0)
-        . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
+ N C0CI,C0CIN,C0CJ,C0CJN,C0CJE,C0CJS,C0CMAP,C0CTMAP,C0CTMP
 "RTN","C0COVRES",64,0)
-        . . K C0CTO ; CLEAR OUTPUT VARIABLE
+ S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
 "RTN","C0COVRES",65,0)
-        . . F C0CJ=1:1:C0CJN D   ;FOR EACH TEST RESULT
+ N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
 "RTN","C0COVRES",66,0)
-        . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
+ N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
 "RTN","C0COVRES",67,0)
-        . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
+ N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
 "RTN","C0COVRES",68,0)
-        . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
+ ; TO IMPROVE PERFORMANCE
 "RTN","C0COVRES",69,0)
-        . . . D XMAP^C0CTIU1("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
+ D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
 "RTN","C0COVRES",70,0)
-        . . . I C0CJ=1 S C0CJS=2 E  S C0CJS=1 ;FIRST TIME,SKIP THE <Test>
+ F C0CI=1:1:C0CIN D  ; LOOP THROUGH VARIABLES
 "RTN","C0COVRES",71,0)
-        . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E  S C0CJE=@C0CTMP@(0) ;</Test>
+ . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
 "RTN","C0COVRES",72,0)
-        . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
+ . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
 "RTN","C0COVRES",73,0)
-        . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
+ . S C0CMAP=$NA(@C0CV@(C0CI)) ;MAPPING FOR TEST REQUEST GOES HERE
 "RTN","C0COVRES",74,0)
-        . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
+ . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
 "RTN","C0COVRES",75,0)
-        D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
+ . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
 "RTN","C0COVRES",76,0)
-        D BUILD^C0CTIU1("C0CRBLD","RTN") ;RENDER THE XML
+ . I $D(@C0CMAP@("M","TEST",0)) D  ; TESTS EXIST
 "RTN","C0COVRES",77,0)
-        K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
+ . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
 "RTN","C0COVRES",78,0)
-        Q
+ . . K C0CTO ; CLEAR OUTPUT VARIABLE
 "RTN","C0COVRES",79,0)
+ . . F C0CJ=1:1:C0CJN D   ;FOR EACH TEST RESULT
+"RTN","C0COVRES",80,0)
+ . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
+"RTN","C0COVRES",81,0)
+ . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
+"RTN","C0COVRES",82,0)
+ . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
+"RTN","C0COVRES",83,0)
+ . . . D XMAP^C0CTIU1("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
+"RTN","C0COVRES",84,0)
+ . . . I C0CJ=1 S C0CJS=2 E  S C0CJS=1 ;FIRST TIME,SKIP THE <Test>
+"RTN","C0COVRES",85,0)
+ . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E  S C0CJE=@C0CTMP@(0) ;</Test>
+"RTN","C0COVRES",86,0)
+ . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
+"RTN","C0COVRES",87,0)
+ . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
+"RTN","C0COVRES",88,0)
+ . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
+"RTN","C0COVRES",89,0)
+ D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
+"RTN","C0COVRES",90,0)
+ D BUILD^C0CTIU1("C0CRBLD","RTN") ;RENDER THE XML
+"RTN","C0COVRES",91,0)
+ K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
+"RTN","C0COVRES",92,0)
+ Q
+"RTN","C0COVRES",93,0)
 EXTRACT(ILXML,DFN,OLXML) ; EXTRACT LABS INTO THE C0CLVAR GLOBAL
-"RTN","C0COVRES",80,0)
-        ; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","C0COVRES",81,0)
-        N C0CNSSN,C0CLB ; IS THERE AN SSN FLAG
-"RTN","C0COVRES",82,0)
-        S C0CNSSN=0
-"RTN","C0COVRES",83,0)
-        S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
-"RTN","C0COVRES",84,0)
-        D GHL7^C0COVREU ; GET HL7 MESSAGE FOR THIS PATIENT
-"RTN","C0COVRES",85,0)
-        I C0CNSSN=1 D  Q  ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT
-"RTN","C0COVRES",86,0)
-        . S @C0CLB@(0)=0
-"RTN","C0COVRES",87,0)
-        ;K @C0CLB ; CLEAR OUT OLD VARS IF ANY
-"RTN","C0COVRES",88,0)
-        N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG
-"RTN","C0COVRES",89,0)
-        S C0CQT=1 ; SURPRESS LISTING
-"RTN","C0COVRES",90,0)
-        D LIST^C0COVREL ; EXTRACT THE VARIABLES
-"RTN","C0COVRES",91,0)
-        S C0CQT=QTSAV ; RESET SILENT FLAG
-"RTN","C0COVRES",92,0)
-        K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT
-"RTN","C0COVRES",93,0)
-        I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
 "RTN","C0COVRES",94,0)
-        Q
+ ; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","C0COVRES",95,0)
+ N C0CNSSN,C0CLB ; IS THERE AN SSN FLAG
+"RTN","C0COVRES",96,0)
+ S C0CNSSN=0
+"RTN","C0COVRES",97,0)
+ S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
+"RTN","C0COVRES",98,0)
+ D GHL7^C0COVREU ; GET HL7 MESSAGE FOR THIS PATIENT
+"RTN","C0COVRES",99,0)
+ I C0CNSSN=1 D  Q  ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT
+"RTN","C0COVRES",100,0)
+ . S @C0CLB@(0)=0
+"RTN","C0COVRES",101,0)
+ ;K @C0CLB ; CLEAR OUT OLD VARS IF ANY
+"RTN","C0COVRES",102,0)
+ N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG
+"RTN","C0COVRES",103,0)
+ S C0CQT=1 ; SURPRESS LISTING
+"RTN","C0COVRES",104,0)
+ D LIST^C0COVREL ; EXTRACT THE VARIABLES
+"RTN","C0COVRES",105,0)
+ S C0CQT=QTSAV ; RESET SILENT FLAG
+"RTN","C0COVRES",106,0)
+ K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT
+"RTN","C0COVRES",107,0)
+ I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
+"RTN","C0COVRES",108,0)
+ Q
 "RTN","C0COVREU")
-0^104^B79442187
+0^104^B78173648
 "RTN","C0COVREU",1,0)
 C0COVREU ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15
 "RTN","C0COVREU",2,0)
-        ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0COVREU",3,0)
-        ;
+ ;
 "RTN","C0COVREU",4,0)
-        ;
+ ;
 "RTN","C0COVREU",5,0)
-GHL7    ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0COVREU",6,0)
-        N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR,C0CLLMT,C0CLSTRT
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0COVREU",7,0)
-        ; SET UP FOR LAB API CALL
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0COVREU",8,0)
-        S C0CPTID=$$SSN^C0CDPT(DFN) ; GET THE SSN FOR THIS PATIENT
+ ; License, or (at your option) any later version.
 "RTN","C0COVREU",9,0)
-        I C0CPTID="" D  Q  ; NO SSN, COMPLAIN AND QUIT
+ ;
 "RTN","C0COVREU",10,0)
-        . W "LAB LOOKUP FAILED, NO SSN",!
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0COVREU",11,0)
-        . S C0CNSSN=1 ; SET NO SSN FLAG
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0COVREU",12,0)
-        S C0CSPC="*" ; LOOKING FOR ALL LABS
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0COVREU",13,0)
-        ;I $D(^TMP("C0CCCR","RPMS")) D  ; RUNNING RPMS
+ ; GNU Affero General Public License for more details.
 "RTN","C0COVREU",14,0)
-        ;. D DT^DILF(,"T-365",.C0CSDT) ; START DATE ONE YEAR AGO TO LIMIT VOLUME
+ ;
 "RTN","C0COVREU",15,0)
-        ;E  D DT^DILF(,"T-5000",.C0CSDT) ; START DATE LONG AGO TO GET EVERYTHING
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0COVREU",16,0)
-        ;D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0COVREU",17,0)
-        S C0CLLMT=$$GET^C0CPARMS("LABLIMIT") ; GET THE LIMIT PARM
+ ;
 "RTN","C0COVREU",18,0)
-        S C0CLSTRT=$$GET^C0CPARMS("LABSTART") ; GET START PARM
+ ;
 "RTN","C0COVREU",19,0)
-        D DT^DILF(,C0CLLMT,.C0CSDT) ;
+GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT
 "RTN","C0COVREU",20,0)
-        W "LAB LIMIT: ",C0CLLMT,!
+ N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR,C0CLLMT,C0CLSTRT
 "RTN","C0COVREU",21,0)
-        D DT^DILF(,C0CLSTRT,.C0CEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
+ ; SET UP FOR LAB API CALL
 "RTN","C0COVREU",22,0)
-        S C0CR=$$LAB^C0CLA7Q(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP
+ S C0CPTID=$$SSN^C0CDPT(DFN) ; GET THE SSN FOR THIS PATIENT
 "RTN","C0COVREU",23,0)
-        Q
+ I C0CPTID="" D  Q  ; NO SSN, COMPLAIN AND QUIT
 "RTN","C0COVREU",24,0)
+ . W "LAB LOOKUP FAILED, NO SSN",!
+"RTN","C0COVREU",25,0)
+ . S C0CNSSN=1 ; SET NO SSN FLAG
+"RTN","C0COVREU",26,0)
+ S C0CSPC="*" ; LOOKING FOR ALL LABS
+"RTN","C0COVREU",27,0)
+ ;I $D(^TMP("C0CCCR","RPMS")) D  ; RUNNING RPMS
+"RTN","C0COVREU",28,0)
+ ;. D DT^DILF(,"T-365",.C0CSDT) ; START DATE ONE YEAR AGO TO LIMIT VOLUME
+"RTN","C0COVREU",29,0)
+ ;E  D DT^DILF(,"T-5000",.C0CSDT) ; START DATE LONG AGO TO GET EVERYTHING
+"RTN","C0COVREU",30,0)
+ ;D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY
+"RTN","C0COVREU",31,0)
+ S C0CLLMT=$$GET^C0CPARMS("LABLIMIT") ; GET THE LIMIT PARM
+"RTN","C0COVREU",32,0)
+ S C0CLSTRT=$$GET^C0CPARMS("LABSTART") ; GET START PARM
+"RTN","C0COVREU",33,0)
+ D DT^DILF(,C0CLLMT,.C0CSDT) ;
+"RTN","C0COVREU",34,0)
+ W "LAB LIMIT: ",C0CLLMT,!
+"RTN","C0COVREU",35,0)
+ D DT^DILF(,C0CLSTRT,.C0CEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
+"RTN","C0COVREU",36,0)
+ S C0CR=$$LAB^C0CLA7Q(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP
+"RTN","C0COVREU",37,0)
+ Q
+"RTN","C0COVREU",38,0)
 LTYP(OSEG,OTYP,OVARA,OC0CQT)    ;
-"RTN","C0COVREU",25,0)
-        N OI,OI2,OTAB,OTI,OV,OVAR
-"RTN","C0COVREU",26,0)
-        S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE
-"RTN","C0COVREU",27,0)
-        I '$D(OC0CQT) S C0CQT=0 ; NOT C0CQT IS DEFAULT
-"RTN","C0COVREU",28,0)
-        E  S C0CQT=OC0CQT ; ACCEPT C0CQT FLAG
-"RTN","C0COVREU",29,0)
-        I 1 D  ; FOR HL7 SEGMENT TYPE
-"RTN","C0COVREU",30,0)
-        . S OI="" ; INDEX INTO FIELDS IN SEG
-"RTN","C0COVREU",31,0)
-        . F  S OI=$O(@OTAB@(OI)) Q:OI=""  D  ; FOR EACH FIELD OF THE SEGMENT
-"RTN","C0COVREU",32,0)
-        . . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX
-"RTN","C0COVREU",33,0)
-        . . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED
-"RTN","C0COVREU",34,0)
-        . . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE
-"RTN","C0COVREU",35,0)
-        . . I $P(OI,";",2)'="" D  ; THIS IS DEFINING A SUB-VALUE
-"RTN","C0COVREU",36,0)
-        . . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX
-"RTN","C0COVREU",37,0)
-        . . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE
-"RTN","C0COVREU",38,0)
-        . . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE
 "RTN","C0COVREU",39,0)
-        . . I 'C0CQT D  ; PRINT OUTPUT IF C0CQT IS FALSE
+ N OI,OI2,OTAB,OTI,OV,OVAR
 "RTN","C0COVREU",40,0)
-        . . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,!
+ S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE
 "RTN","C0COVREU",41,0)
-        Q
+ I '$D(OC0CQT) S C0CQT=0 ; NOT C0CQT IS DEFAULT
 "RTN","C0COVREU",42,0)
+ E  S C0CQT=OC0CQT ; ACCEPT C0CQT FLAG
+"RTN","C0COVREU",43,0)
+ I 1 D  ; FOR HL7 SEGMENT TYPE
+"RTN","C0COVREU",44,0)
+ . S OI="" ; INDEX INTO FIELDS IN SEG
+"RTN","C0COVREU",45,0)
+ . F  S OI=$O(@OTAB@(OI)) Q:OI=""  D  ; FOR EACH FIELD OF THE SEGMENT
+"RTN","C0COVREU",46,0)
+ . . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX
+"RTN","C0COVREU",47,0)
+ . . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED
+"RTN","C0COVREU",48,0)
+ . . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE
+"RTN","C0COVREU",49,0)
+ . . I $P(OI,";",2)'="" D  ; THIS IS DEFINING A SUB-VALUE
+"RTN","C0COVREU",50,0)
+ . . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX
+"RTN","C0COVREU",51,0)
+ . . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE
+"RTN","C0COVREU",52,0)
+ . . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE
+"RTN","C0COVREU",53,0)
+ . . I 'C0CQT D  ; PRINT OUTPUT IF C0CQT IS FALSE
+"RTN","C0COVREU",54,0)
+ . . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,!
+"RTN","C0COVREU",55,0)
+ Q
+"RTN","C0COVREU",56,0)
 LOBX    ;
-"RTN","C0COVREU",43,0)
-        Q
-"RTN","C0COVREU",44,0)
-        ;
-"RTN","C0COVREU",45,0)
+"RTN","C0COVREU",57,0)
+ Q
+"RTN","C0COVREU",58,0)
 OUT(DFN) ; WRITE OUT A CCR THAT HAS JUST BEEN PROCESSED (FOR TESTING)
-"RTN","C0COVREU",46,0)
-        N GA,GF,GD
-"RTN","C0COVREU",47,0)
-        S GA=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1))
-"RTN","C0COVREU",48,0)
-        S GF="RPMS_CCR_"_DFN_"_"_DT_".xml"
-"RTN","C0COVREU",49,0)
-        S GD=^TMP("C0CCCR","ODIR")
-"RTN","C0COVREU",50,0)
-        W $$OUTPUT^C0CXPATH(GA,GF,GD)
-"RTN","C0COVREU",51,0)
-        Q
-"RTN","C0COVREU",52,0)
+"RTN","C0COVREU",59,0)
+ N GA,GF,GD
+"RTN","C0COVREU",60,0)
+ S GA=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1))
+"RTN","C0COVREU",61,0)
+ S GF="RPMS_CCR_"_DFN_"_"_DT_".xml"
+"RTN","C0COVREU",62,0)
+ S GD=^TMP("C0CCCR","ODIR")
+"RTN","C0COVREU",63,0)
+ W $$OUTPUT^C0CXPATH(GA,GF,GD)
+"RTN","C0COVREU",64,0)
+ Q
+"RTN","C0COVREU",65,0)
 SETTBL  ;
-"RTN","C0COVREU",53,0)
-        K X ; CLEAR X
-"RTN","C0COVREU",54,0)
-        S X("PID","PID1")="1^00104^Set ID - Patient ID"
-"RTN","C0COVREU",55,0)
-        S X("PID","PID2")="2^00105^Patient ID (External ID)"
-"RTN","C0COVREU",56,0)
-        S X("PID","PID3")="3^00106^Patient ID (Internal ID)"
-"RTN","C0COVREU",57,0)
-        S X("PID","PID4")="4^00107^Alternate Patient ID"
-"RTN","C0COVREU",58,0)
-        S X("PID","PID5")="5^00108^Patient's Name"
-"RTN","C0COVREU",59,0)
-        S X("PID","PID6")="6^00109^Mother's Maiden Name"
-"RTN","C0COVREU",60,0)
-        S X("PID","PID7")="7^00110^Date of Birth"
-"RTN","C0COVREU",61,0)
-        S X("PID","PID8")="8^00111^Sex"
-"RTN","C0COVREU",62,0)
-        S X("PID","PID9")="9^00112^Patient Alias"
-"RTN","C0COVREU",63,0)
-        S X("PID","PID10")="10^00113^Race"
-"RTN","C0COVREU",64,0)
-        S X("PID","PID11")="11^00114^Patient Address"
-"RTN","C0COVREU",65,0)
-        S X("PID","PID12")="12^00115^County Code"
 "RTN","C0COVREU",66,0)
-        S X("PID","PID13")="13^00116^Phone Number - Home"
+ K X ; CLEAR X
 "RTN","C0COVREU",67,0)
-        S X("PID","PID14")="14^00117^Phone Number - Business"
+ S X("PID","PID1")="1^00104^Set ID - Patient ID"
 "RTN","C0COVREU",68,0)
-        S X("PID","PID15")="15^00118^Language - Patient"
+ S X("PID","PID2")="2^00105^Patient ID (External ID)"
 "RTN","C0COVREU",69,0)
-        S X("PID","PID16")="16^00119^Marital Status"
+ S X("PID","PID3")="3^00106^Patient ID (Internal ID)"
 "RTN","C0COVREU",70,0)
-        S X("PID","PID17")="17^00120^Religion"
+ S X("PID","PID4")="4^00107^Alternate Patient ID"
 "RTN","C0COVREU",71,0)
-        S X("PID","PID18")="18^00121^Patient Account Number"
+ S X("PID","PID5")="5^00108^Patient's Name"
 "RTN","C0COVREU",72,0)
-        S X("PID","PID19")="19^00122^SSN Number - Patient"
+ S X("PID","PID6")="6^00109^Mother's Maiden Name"
 "RTN","C0COVREU",73,0)
-        S X("PID","PID20")="20^00123^Drivers License - Patient"
+ S X("PID","PID7")="7^00110^Date of Birth"
 "RTN","C0COVREU",74,0)
-        S X("PID","PID21")="21^00124^Mother's Identifier"
+ S X("PID","PID8")="8^00111^Sex"
 "RTN","C0COVREU",75,0)
-        S X("PID","PID22")="22^00125^Ethnic Group"
+ S X("PID","PID9")="9^00112^Patient Alias"
 "RTN","C0COVREU",76,0)
-        S X("PID","PID23")="23^00126^Birth Place"
+ S X("PID","PID10")="10^00113^Race"
 "RTN","C0COVREU",77,0)
-        S X("PID","PID24")="24^00127^Multiple Birth Indicator"
+ S X("PID","PID11")="11^00114^Patient Address"
 "RTN","C0COVREU",78,0)
-        S X("PID","PID25")="25^00128^Birth Order"
+ S X("PID","PID12")="12^00115^County Code"
 "RTN","C0COVREU",79,0)
-        S X("PID","PID26")="26^00129^Citizenship"
+ S X("PID","PID13")="13^00116^Phone Number - Home"
 "RTN","C0COVREU",80,0)
-        S X("PID","PID27")="27^00130^Veteran.s Military Status"
+ S X("PID","PID14")="14^00117^Phone Number - Business"
 "RTN","C0COVREU",81,0)
-        S X("PID","PID28")="28^00739^Nationality"
+ S X("PID","PID15")="15^00118^Language - Patient"
 "RTN","C0COVREU",82,0)
-        S X("PID","PID29")="29^00740^Patient Death Date/Time"
+ S X("PID","PID16")="16^00119^Marital Status"
 "RTN","C0COVREU",83,0)
-        S X("PID","PID30")="30^00741^Patient Death Indicator"
+ S X("PID","PID17")="17^00120^Religion"
 "RTN","C0COVREU",84,0)
-        S X("NTE","NTE1")="1^00573^Set ID - NTE"
+ S X("PID","PID18")="18^00121^Patient Account Number"
 "RTN","C0COVREU",85,0)
-        S X("NTE","NTE2")="2^00574^Source of Comment"
+ S X("PID","PID19")="19^00122^SSN Number - Patient"
 "RTN","C0COVREU",86,0)
-        S X("NTE","NTE3")="3^00575^Comment"
+ S X("PID","PID20")="20^00123^Drivers License - Patient"
 "RTN","C0COVREU",87,0)
-        S X("ORC","ORC1")="1^00215^Order Control"
+ S X("PID","PID21")="21^00124^Mother's Identifier"
 "RTN","C0COVREU",88,0)
-        S X("ORC","ORC2")="2^00216^Placer Order Number"
+ S X("PID","PID22")="22^00125^Ethnic Group"
 "RTN","C0COVREU",89,0)
-        S X("ORC","ORC3")="3^00217^Filler Order Number"
+ S X("PID","PID23")="23^00126^Birth Place"
 "RTN","C0COVREU",90,0)
-        S X("ORC","ORC4")="4^00218^Placer Order Number"
+ S X("PID","PID24")="24^00127^Multiple Birth Indicator"
 "RTN","C0COVREU",91,0)
-        S X("ORC","ORC5")="5^00219^Order Status"
+ S X("PID","PID25")="25^00128^Birth Order"
 "RTN","C0COVREU",92,0)
-        S X("ORC","ORC6")="6^00220^Response Flag"
+ S X("PID","PID26")="26^00129^Citizenship"
 "RTN","C0COVREU",93,0)
-        S X("ORC","ORC7")="7^00221^Quantity/Timing"
+ S X("PID","PID27")="27^00130^Veteran.s Military Status"
 "RTN","C0COVREU",94,0)
-        S X("ORC","ORC8")="8^00222^Parent"
+ S X("PID","PID28")="28^00739^Nationality"
 "RTN","C0COVREU",95,0)
-        S X("ORC","ORC9")="9^00223^Date/Time of Transaction"
+ S X("PID","PID29")="29^00740^Patient Death Date/Time"
 "RTN","C0COVREU",96,0)
-        S X("ORC","ORC10")="10^00224^Entered By"
+ S X("PID","PID30")="30^00741^Patient Death Indicator"
 "RTN","C0COVREU",97,0)
-        S X("ORC","ORC11")="11^00225^Verified By"
+ S X("NTE","NTE1")="1^00573^Set ID - NTE"
 "RTN","C0COVREU",98,0)
-        S X("ORC","ORC12")="12^00226^Ordering Provider"
+ S X("NTE","NTE2")="2^00574^Source of Comment"
 "RTN","C0COVREU",99,0)
-        S X("ORC","ORC13")="13^00227^Enterer's Location"
+ S X("NTE","NTE3")="3^00575^Comment"
 "RTN","C0COVREU",100,0)
-        S X("ORC","ORC14")="14^00228^Call Back Phone Number"
+ S X("ORC","ORC1")="1^00215^Order Control"
 "RTN","C0COVREU",101,0)
-        S X("ORC","ORC15")="15^00229^Order Effective Date/Time"
+ S X("ORC","ORC2")="2^00216^Placer Order Number"
 "RTN","C0COVREU",102,0)
-        S X("ORC","ORC16")="16^00230^Order Control Code Reason"
+ S X("ORC","ORC3")="3^00217^Filler Order Number"
 "RTN","C0COVREU",103,0)
-        S X("ORC","ORC17")="17^00231^Entering Organization"
+ S X("ORC","ORC4")="4^00218^Placer Order Number"
 "RTN","C0COVREU",104,0)
-        S X("ORC","ORC18")="18^00232^Entering Device"
+ S X("ORC","ORC5")="5^00219^Order Status"
 "RTN","C0COVREU",105,0)
-        S X("ORC","ORC19")="19^00233^Action By"
+ S X("ORC","ORC6")="6^00220^Response Flag"
 "RTN","C0COVREU",106,0)
-        S X("OBR","OBR1")="1^00237^Set ID - Observation Request"
+ S X("ORC","ORC7")="7^00221^Quantity/Timing"
 "RTN","C0COVREU",107,0)
-        S X("OBR","OBR2")="2^00216^Placer Order Number"
+ S X("ORC","ORC8")="8^00222^Parent"
 "RTN","C0COVREU",108,0)
-        S X("OBR","OBR3")="3^00217^Filler Order Number"
+ S X("ORC","ORC9")="9^00223^Date/Time of Transaction"
 "RTN","C0COVREU",109,0)
-        S X("OBR","OBR4")="4^00238^Universal Service ID"
+ S X("ORC","ORC10")="10^00224^Entered By"
 "RTN","C0COVREU",110,0)
-        S X("OBR","OBR4;LOINC")="4;1^00238^Universal Service ID - LOINC^RESULTCODE"
+ S X("ORC","ORC11")="11^00225^Verified By"
 "RTN","C0COVREU",111,0)
-        S X("OBR","OBR4;DESC")="4;2^00238^Universal Service ID - DESC^RESULTDESCRIPTIONTEXT"
+ S X("ORC","ORC12")="12^00226^Ordering Provider"
 "RTN","C0COVREU",112,0)
-        S X("OBR","OBR4;VACODE")="4;3^00238^Universal Service ID - VACODE^RESULTCODINGSYSTEM"
+ S X("ORC","ORC13")="13^00227^Enterer's Location"
 "RTN","C0COVREU",113,0)
-        S X("OBR","OBR5")="5^00239^Priority"
+ S X("ORC","ORC14")="14^00228^Call Back Phone Number"
 "RTN","C0COVREU",114,0)
-        S X("OBR","OBR6")="6^00240^Requested Date/Time"
+ S X("ORC","ORC15")="15^00229^Order Effective Date/Time"
 "RTN","C0COVREU",115,0)
-        S X("OBR","OBR7")="7^00241^Observation Date/Time^RESULTASSESSMENTDATETIME"
+ S X("ORC","ORC16")="16^00230^Order Control Code Reason"
 "RTN","C0COVREU",116,0)
-        S X("OBR","OBR8")="8^00242^Observation End Date/Time"
+ S X("ORC","ORC17")="17^00231^Entering Organization"
 "RTN","C0COVREU",117,0)
-        S X("OBR","OBR9")="9^00243^Collection Volume"
+ S X("ORC","ORC18")="18^00232^Entering Device"
 "RTN","C0COVREU",118,0)
-        S X("OBR","OBR10")="10^00244^Collector Identifier"
+ S X("ORC","ORC19")="19^00233^Action By"
 "RTN","C0COVREU",119,0)
-        S X("OBR","OBR11")="11^00245^Specimen Action Code"
+ S X("OBR","OBR1")="1^00237^Set ID - Observation Request"
 "RTN","C0COVREU",120,0)
-        S X("OBR","OBR12")="12^00246^Danger Code"
+ S X("OBR","OBR2")="2^00216^Placer Order Number"
 "RTN","C0COVREU",121,0)
-        S X("OBR","OBR13")="13^00247^Relevant Clinical Info."
+ S X("OBR","OBR3")="3^00217^Filler Order Number"
 "RTN","C0COVREU",122,0)
-        S X("OBR","OBR14")="14^00248^Specimen Rcv'd. Date/Time"
+ S X("OBR","OBR4")="4^00238^Universal Service ID"
 "RTN","C0COVREU",123,0)
-        S X("OBR","OBR15")="15^00249^Specimen Source"
+ S X("OBR","OBR4;LOINC")="4;1^00238^Universal Service ID - LOINC^RESULTCODE"
 "RTN","C0COVREU",124,0)
-        S X("OBR","OBR16")="16^00226^Ordering Provider XCN^RESULTSOURCEACTORID"
+ S X("OBR","OBR4;DESC")="4;2^00238^Universal Service ID - DESC^RESULTDESCRIPTIONTEXT"
 "RTN","C0COVREU",125,0)
-        S X("OBR","OBR17")="17^00250^Order Callback Phone Number"
+ S X("OBR","OBR4;VACODE")="4;3^00238^Universal Service ID - VACODE^RESULTCODINGSYSTEM"
 "RTN","C0COVREU",126,0)
-        S X("OBR","OBR18")="18^00251^Placers Field 1"
+ S X("OBR","OBR5")="5^00239^Priority"
 "RTN","C0COVREU",127,0)
-        S X("OBR","OBR19")="19^00252^Placers Field 2"
+ S X("OBR","OBR6")="6^00240^Requested Date/Time"
 "RTN","C0COVREU",128,0)
-        S X("OBR","OBR20")="20^00253^Filler Field 1"
+ S X("OBR","OBR7")="7^00241^Observation Date/Time^RESULTASSESSMENTDATETIME"
 "RTN","C0COVREU",129,0)
-        S X("OBR","OBR21")="21^00254^Filler Field 2"
+ S X("OBR","OBR8")="8^00242^Observation End Date/Time"
 "RTN","C0COVREU",130,0)
-        S X("OBR","OBR22")="22^00255^Results Rpt./Status Change"
+ S X("OBR","OBR9")="9^00243^Collection Volume"
 "RTN","C0COVREU",131,0)
-        S X("OBR","OBR23")="23^00256^Charge to Practice"
+ S X("OBR","OBR10")="10^00244^Collector Identifier"
 "RTN","C0COVREU",132,0)
-        S X("OBR","OBR24")="24^00257^Diagnostic Service Sect"
+ S X("OBR","OBR11")="11^00245^Specimen Action Code"
 "RTN","C0COVREU",133,0)
-        S X("OBR","OBR25")="25^00258^Result Status^RESULTSTATUS"
+ S X("OBR","OBR12")="12^00246^Danger Code"
 "RTN","C0COVREU",134,0)
-        S X("OBR","OBR26")="26^00259^Parent Result"
+ S X("OBR","OBR13")="13^00247^Relevant Clinical Info."
 "RTN","C0COVREU",135,0)
-        S X("OBR","OBR27")="27^00221^Quantity/Timing"
+ S X("OBR","OBR14")="14^00248^Specimen Rcv'd. Date/Time"
 "RTN","C0COVREU",136,0)
-        S X("OBR","OBR28")="28^00260^Result Copies to"
+ S X("OBR","OBR15")="15^00249^Specimen Source"
 "RTN","C0COVREU",137,0)
-        S X("OBR","OBR29")="29^00261^Parent Number"
+ S X("OBR","OBR16")="16^00226^Ordering Provider XCN^RESULTSOURCEACTORID"
 "RTN","C0COVREU",138,0)
-        S X("OBR","OBR30")="30^00262^Transportation Mode"
+ S X("OBR","OBR17")="17^00250^Order Callback Phone Number"
 "RTN","C0COVREU",139,0)
-        S X("OBR","OBR31")="31^00263^Reason for Study"
+ S X("OBR","OBR18")="18^00251^Placers Field 1"
 "RTN","C0COVREU",140,0)
-        S X("OBR","OBR32")="32^00264^Principal Result Interpreter"
+ S X("OBR","OBR19")="19^00252^Placers Field 2"
 "RTN","C0COVREU",141,0)
-        S X("OBR","OBR33")="33^00265^Assistant Result Interpreter"
+ S X("OBR","OBR20")="20^00253^Filler Field 1"
 "RTN","C0COVREU",142,0)
-        S X("OBR","OBR34")="34^00266^Technician"
+ S X("OBR","OBR21")="21^00254^Filler Field 2"
 "RTN","C0COVREU",143,0)
-        S X("OBR","OBR35")="35^00267^Transcriptionist"
+ S X("OBR","OBR22")="22^00255^Results Rpt./Status Change"
 "RTN","C0COVREU",144,0)
-        S X("OBR","OBR36")="36^00268^Scheduled Date/Time"
+ S X("OBR","OBR23")="23^00256^Charge to Practice"
 "RTN","C0COVREU",145,0)
-        S X("OBR","OBR37")="37^01028^Number of Sample Containers"
+ S X("OBR","OBR24")="24^00257^Diagnostic Service Sect"
 "RTN","C0COVREU",146,0)
-        S X("OBR","OBR38")="38^38^01029 Transport Logistics of Collected Sample"
+ S X("OBR","OBR25")="25^00258^Result Status^RESULTSTATUS"
 "RTN","C0COVREU",147,0)
-        S X("OBR","OBR39")="39^01030^Collector.s Comment"
+ S X("OBR","OBR26")="26^00259^Parent Result"
 "RTN","C0COVREU",148,0)
-        S X("OBR","OBR40")="40^01031^Transport Arrangement Responsibility"
+ S X("OBR","OBR27")="27^00221^Quantity/Timing"
 "RTN","C0COVREU",149,0)
-        S X("OBR","OBR41")="41^01032^Transport Arranged"
+ S X("OBR","OBR28")="28^00260^Result Copies to"
 "RTN","C0COVREU",150,0)
-        S X("OBR","OBR42")="42^01033^Escort Required"
+ S X("OBR","OBR29")="29^00261^Parent Number"
 "RTN","C0COVREU",151,0)
-        S X("OBR","OBR43")="43^01034^Planned Patient Transport Comment"
+ S X("OBR","OBR30")="30^00262^Transportation Mode"
 "RTN","C0COVREU",152,0)
-        S X("OBX","OBX1")="1^00559^Set ID - OBX"
+ S X("OBR","OBR31")="31^00263^Reason for Study"
 "RTN","C0COVREU",153,0)
-        S X("OBX","OBX2")="2^00676^Value Type"
+ S X("OBR","OBR32")="32^00264^Principal Result Interpreter"
 "RTN","C0COVREU",154,0)
-        S X("OBX","OBX3")="3^00560^Observation Identifier"
+ S X("OBR","OBR33")="33^00265^Assistant Result Interpreter"
 "RTN","C0COVREU",155,0)
-        S X("OBX","OBX3;C1")="3;1^00560^Observation Identifier^C1"
+ S X("OBR","OBR34")="34^00266^Technician"
 "RTN","C0COVREU",156,0)
-        S X("OBX","OBX3;C2")="3;2^00560^Observation Identifier^C2"
+ S X("OBR","OBR35")="35^00267^Transcriptionist"
 "RTN","C0COVREU",157,0)
-        S X("OBX","OBX3;C3")="3;3^00560^Observation Identifier^C3"
+ S X("OBR","OBR36")="36^00268^Scheduled Date/Time"
 "RTN","C0COVREU",158,0)
-        S X("OBX","OBX3;C4")="3;4^00560^Observation Identifier^C4"
+ S X("OBR","OBR37")="37^01028^Number of Sample Containers"
 "RTN","C0COVREU",159,0)
-        S X("OBX","OBX3;C5")="3;5^00560^Observation Identifier^C5"
+ S X("OBR","OBR38")="38^38^01029 Transport Logistics of Collected Sample"
 "RTN","C0COVREU",160,0)
-        S X("OBX","OBX3;C6")="3;6^00560^Observation Identifier^C6"
+ S X("OBR","OBR39")="39^01030^Collector.s Comment"
 "RTN","C0COVREU",161,0)
-        S X("OBX","OBX4")="4^00769^Observation Sub-Id"
+ S X("OBR","OBR40")="40^01031^Transport Arrangement Responsibility"
 "RTN","C0COVREU",162,0)
-        S X("OBX","OBX5")="5^00561^Observation Results^RESULTTESTVALUE"
+ S X("OBR","OBR41")="41^01032^Transport Arranged"
 "RTN","C0COVREU",163,0)
-        S X("OBX","OBX6")="6^00562^Units^RESULTTESTUNITS"
+ S X("OBR","OBR42")="42^01033^Escort Required"
 "RTN","C0COVREU",164,0)
-        S X("OBX","OBX7")="7^00563^Reference Range^RESULTTESTNORMALDESCTEXT"
+ S X("OBR","OBR43")="43^01034^Planned Patient Transport Comment"
 "RTN","C0COVREU",165,0)
-        S X("OBX","OBX8")="8^00564^Abnormal Flags^RESULTTESTFLAG"
+ S X("OBX","OBX1")="1^00559^Set ID - OBX"
 "RTN","C0COVREU",166,0)
-        S X("OBX","OBX9")="9^00639^Probability"
+ S X("OBX","OBX2")="2^00676^Value Type"
 "RTN","C0COVREU",167,0)
-        S X("OBX","OBX10")="10^00565^Nature of Abnormal Test"
+ S X("OBX","OBX3")="3^00560^Observation Identifier"
 "RTN","C0COVREU",168,0)
-        S X("OBX","OBX11")="11^00566^Observ. Result Status^RESULTTESTSTATUSTEXT"
+ S X("OBX","OBX3;C1")="3;1^00560^Observation Identifier^C1"
 "RTN","C0COVREU",169,0)
-        S X("OBX","OBX12")="12^00567^Date Last Normal Value"
+ S X("OBX","OBX3;C2")="3;2^00560^Observation Identifier^C2"
 "RTN","C0COVREU",170,0)
-        S X("OBX","OBX13")="13^00581^User Defined Access Checks"
+ S X("OBX","OBX3;C3")="3;3^00560^Observation Identifier^C3"
 "RTN","C0COVREU",171,0)
-        S X("OBX","OBX14")="14^00582^Date/Time of Observation^RESULTTESTDATETIME"
+ S X("OBX","OBX3;C4")="3;4^00560^Observation Identifier^C4"
 "RTN","C0COVREU",172,0)
-        S X("OBX","OBX15")="15^00583^Producer.s ID^RESULTTESTSOURCEACTORID"
+ S X("OBX","OBX3;C5")="3;5^00560^Observation Identifier^C5"
 "RTN","C0COVREU",173,0)
-        S X("OBX","OBX16")="16^00584^Responsible Observer"
+ S X("OBX","OBX3;C6")="3;6^00560^Observation Identifier^C6"
 "RTN","C0COVREU",174,0)
-        S X("OBX","OBX17")="17^00936^Observation Method"
+ S X("OBX","OBX4")="4^00769^Observation Sub-Id"
 "RTN","C0COVREU",175,0)
-        K ^TMP("C0CCCR","LABTBL")
+ S X("OBX","OBX5")="5^00561^Observation Results^RESULTTESTVALUE"
 "RTN","C0COVREU",176,0)
-        M ^TMP("C0CCCR","LABTBL")=X ; SET VALUES IN LAB TBL
+ S X("OBX","OBX6")="6^00562^Units^RESULTTESTUNITS"
 "RTN","C0COVREU",177,0)
-        S ^TMP("C0CCCR","LABTBL",0)="V3"
+ S X("OBX","OBX7")="7^00563^Reference Range^RESULTTESTNORMALDESCTEXT"
 "RTN","C0COVREU",178,0)
-        Q
+ S X("OBX","OBX8")="8^00564^Abnormal Flags^RESULTTESTFLAG"
+"RTN","C0COVREU",179,0)
+ S X("OBX","OBX9")="9^00639^Probability"
+"RTN","C0COVREU",180,0)
+ S X("OBX","OBX10")="10^00565^Nature of Abnormal Test"
+"RTN","C0COVREU",181,0)
+ S X("OBX","OBX11")="11^00566^Observ. Result Status^RESULTTESTSTATUSTEXT"
+"RTN","C0COVREU",182,0)
+ S X("OBX","OBX12")="12^00567^Date Last Normal Value"
+"RTN","C0COVREU",183,0)
+ S X("OBX","OBX13")="13^00581^User Defined Access Checks"
+"RTN","C0COVREU",184,0)
+ S X("OBX","OBX14")="14^00582^Date/Time of Observation^RESULTTESTDATETIME"
+"RTN","C0COVREU",185,0)
+ S X("OBX","OBX15")="15^00583^Producer.s ID^RESULTTESTSOURCEACTORID"
+"RTN","C0COVREU",186,0)
+ S X("OBX","OBX16")="16^00584^Responsible Observer"
+"RTN","C0COVREU",187,0)
+ S X("OBX","OBX17")="17^00936^Observation Method"
+"RTN","C0COVREU",188,0)
+ K ^TMP("C0CCCR","LABTBL")
+"RTN","C0COVREU",189,0)
+ M ^TMP("C0CCCR","LABTBL")=X ; SET VALUES IN LAB TBL
+"RTN","C0COVREU",190,0)
+ S ^TMP("C0CCCR","LABTBL",0)="V3"
+"RTN","C0COVREU",191,0)
+ Q
 "RTN","C0CPARMS")
-0^29^B10161575
+0^29^B9948429
 "RTN","C0CPARMS",1,0)
 C0CPARMS ; CCDCCR/GPL - CCR/CCD PARAMETER PROCESSING ; 1/29/09 ; 6/15/12 3:46pm
 "RTN","C0CPARMS",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CPARMS",3,0)
- ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;Copyright 2008 WorldVistA.  
 "RTN","C0CPARMS",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CPARMS",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CPARMS",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CPARMS",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CPARMS",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CPARMS",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CPARMS",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CPARMS",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CPARMS",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CPARMS",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CPARMS",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CPARMS",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CPARMS",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CPARMS",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CPARMS",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+SET(INPARMS) ;INITIALIZE RUNTIME PARMS USING INPARMS TO OVERRIDE DEFAULTS
 "RTN","C0CPARMS",19,0)
- ;
+ ; PARAMETERS ARE PASSED AS A STRING: "PARM1:VALUE1^PARM2:VALUE2^ETC"
 "RTN","C0CPARMS",20,0)
-SET(INPARMS) ;INITIALIZE RUNTIME PARMS USING INPARMS TO OVERRIDE DEFAULTS
+ ; THE SAME FORMAT IS USED BY RPC AND COMMAND LINE ENTRY POINTS
 "RTN","C0CPARMS",21,0)
- ; PARAMETERS ARE PASSED AS A STRING: "PARM1:VALUE1^PARM2:VALUE2^ETC"
+ ;
 "RTN","C0CPARMS",22,0)
- ; THE SAME FORMAT IS USED BY RPC AND COMMAND LINE ENTRY POINTS
+ N PTMP ;
 "RTN","C0CPARMS",23,0)
- ;
+ S C0CPARMS=$NA(^TMP("C0CPARMS",$J)) ;BASE FOR THIS RUN
 "RTN","C0CPARMS",24,0)
- N PTMP ;
+ K @C0CPARMS ;START WITH EMPTY PARMS; MAY NOT WANT TO DO THIS KILL
 "RTN","C0CPARMS",25,0)
- S C0CPARMS=$NA(^TMP("C0CPARMS",$J)) ;BASE FOR THIS RUN
+ I $G(INPARMS)'="" D  ; OVERRIDES PROVIDED
 "RTN","C0CPARMS",26,0)
- K @C0CPARMS ;START WITH EMPTY PARMS; MAY NOT WANT TO DO THIS KILL
+ . N C0CI S C0CI=""
 "RTN","C0CPARMS",27,0)
- I $G(INPARMS)'="" D  ; OVERRIDES PROVIDED
+ . N C0CN S C0CN=1
 "RTN","C0CPARMS",28,0)
- . N C0CI S C0CI=""
+ . F  S C0CI=$P(INPARMS,"^",C0CN) Q:C0CI=""  D  ;
 "RTN","C0CPARMS",29,0)
- . N C0CN S C0CN=1
+ . . S C0CN=C0CN+1 ;NEXT PARM
 "RTN","C0CPARMS",30,0)
- . F  S C0CI=$P(INPARMS,"^",C0CN) Q:C0CI=""  D  ;
+ . . N C1,C2
 "RTN","C0CPARMS",31,0)
- . . S C0CN=C0CN+1 ;NEXT PARM
+ . . S C1=$P(C0CI,":",1) ; PARAMETER
 "RTN","C0CPARMS",32,0)
- . . N C1,C2
+ . . S C2=$P(C0CI,":",2) ; VALUE
 "RTN","C0CPARMS",33,0)
- . . S C1=$P(C0CI,":",1) ; PARAMETER
+ . . I C2="" S C2=1
 "RTN","C0CPARMS",34,0)
- . . S C2=$P(C0CI,":",2) ; VALUE
+ . . S @C0CPARMS@(C1)=C2
 "RTN","C0CPARMS",35,0)
- . . I C2="" S C2=1
+ . I C0CN=1 S @C0CPARMS@($P(INPARMS,":",1))=$P(C0CI,":",2) ; ONLY ONE
 "RTN","C0CPARMS",36,0)
- . . S @C0CPARMS@(C1)=C2
+ ; THIS IS WHERE WE WILL INSERT CALLS TO THE PARAMETER FILE FOR DEFAULTS
 "RTN","C0CPARMS",37,0)
- . I C0CN=1 S @C0CPARMS@($P(INPARMS,":",1))=$P(C0CI,":",2) ; ONLY ONE
+ ; IF THEY FAIL, THE FOLLOWING WILL BE HARDCODED DEFAULTS
 "RTN","C0CPARMS",38,0)
- ; THIS IS WHERE WE WILL INSERT CALLS TO THE PARAMETER FILE FOR DEFAULTS
+ ;OHUM/RUT commented the hardcoded limits
 "RTN","C0CPARMS",39,0)
- ; IF THEY FAIL, THE FOLLOWING WILL BE HARDCODED DEFAULTS
+ ;I '$D(@C0CPARMS@("LABLIMIT")) S @C0CPARMS@("LABLIMIT")="T-360" ;ONE YR WORTH
 "RTN","C0CPARMS",40,0)
- ;OHUM/RUT commented the hardcoded limits
+ ;I '$D(@C0CPARMS@("LABSTART")) S @C0CPARMS@("LABSTART")="T" ;TODAY
 "RTN","C0CPARMS",41,0)
- ;I '$D(@C0CPARMS@("LABLIMIT")) S @C0CPARMS@("LABLIMIT")="T-360" ;ONE YR WORTH
+ ;I '$D(@C0CPARMS@("VITLIMIT")) S @C0CPARMS@("VITLIMIT")="T-360" ;ONE YR VITALS
 "RTN","C0CPARMS",42,0)
+ ;I '$D(@C0CPARMS@("VITSTART")) S @C0CPARMS@("VITSTART")="T" ;TODAY
+"RTN","C0CPARMS",43,0)
+ ;I '$D(@C0CPARMS@("MEDSTART")) S @C0CPARMS@("MEDSTART")="T" ; TODAY
+"RTN","C0CPARMS",44,0)
+ ;I '$D(@C0CPARMS@("MEDSLIMIT")) S @C0CPARMS@("MEDLIMIT")="T-360" ; ONE YR MEDS
+"RTN","C0CPARMS",45,0)
+ ;I '$D(@C0CPARMS@("MEDACTIVE")) S @C0CPARMS@("MEDACTIVE")=1 ; YES
+"RTN","C0CPARMS",46,0)
+ ;I '$D(@C0CPARMS@("MEDPENDING")) S @C0CPARMS@("MEDPENDING")=0 ; NO
+"RTN","C0CPARMS",47,0)
+ ;I '$D(@C0CPARMS@("MEDALL")) S @C0CPARMS@("MEDALL")=0 ; NON-PENDING NON-ACTIVE
+"RTN","C0CPARMS",48,0)
+ ;OHUM/RUT 3120109 ; commented all limits
+"RTN","C0CPARMS",49,0)
+ ;S @C0CPARMS@("LABLIMIT")=^TMP("C0CCCR","LABLIMIT"),@C0CPARMS@("VITLIMIT")=^TMP("C0CCCR","VITLIMIT"),@C0CPARMS@("TIULIMIT")=^TMP("C0CCCR","TIULIMIT"),@C0CPARMS@("MEDLIMIT")=^TMP("C0CCCR","MEDLIMIT")
+"RTN","C0CPARMS",50,0)
  ;I '$D(@C0CPARMS@("LABSTART")) S @C0CPARMS@("LABSTART")="T" ;TODAY
-"RTN","C0CPARMS",43,0)
- ;I '$D(@C0CPARMS@("VITLIMIT")) S @C0CPARMS@("VITLIMIT")="T-360" ;ONE YR VITALS
-"RTN","C0CPARMS",44,0)
+"RTN","C0CPARMS",51,0)
  ;I '$D(@C0CPARMS@("VITSTART")) S @C0CPARMS@("VITSTART")="T" ;TODAY
-"RTN","C0CPARMS",45,0)
+"RTN","C0CPARMS",52,0)
  ;I '$D(@C0CPARMS@("MEDSTART")) S @C0CPARMS@("MEDSTART")="T" ; TODAY
-"RTN","C0CPARMS",46,0)
- ;I '$D(@C0CPARMS@("MEDSLIMIT")) S @C0CPARMS@("MEDLIMIT")="T-360" ; ONE YR MEDS
-"RTN","C0CPARMS",47,0)
+"RTN","C0CPARMS",53,0)
  ;I '$D(@C0CPARMS@("MEDACTIVE")) S @C0CPARMS@("MEDACTIVE")=1 ; YES
-"RTN","C0CPARMS",48,0)
+"RTN","C0CPARMS",54,0)
  ;I '$D(@C0CPARMS@("MEDPENDING")) S @C0CPARMS@("MEDPENDING")=0 ; NO
-"RTN","C0CPARMS",49,0)
- ;I '$D(@C0CPARMS@("MEDALL")) S @C0CPARMS@("MEDALL")=0 ; NON-PENDING NON-ACTIVE
-"RTN","C0CPARMS",50,0)
- ;OHUM/RUT 3120109 ; commented all limits
-"RTN","C0CPARMS",51,0)
- ;S @C0CPARMS@("LABLIMIT")=^TMP("C0CCCR","LABLIMIT"),@C0CPARMS@("VITLIMIT")=^TMP("C0CCCR","VITLIMIT"),@C0CPARMS@("TIULIMIT")=^TMP("C0CCCR","TIULIMIT"),@C0CPARMS@("MEDLIMIT")=^TMP("C0CCCR","MEDLIMIT")
-"RTN","C0CPARMS",52,0)
- ;I '$D(@C0CPARMS@("LABSTART")) S @C0CPARMS@("LABSTART")="T" ;TODAY
-"RTN","C0CPARMS",53,0)
- ;I '$D(@C0CPARMS@("VITSTART")) S @C0CPARMS@("VITSTART")="T" ;TODAY
-"RTN","C0CPARMS",54,0)
- ;I '$D(@C0CPARMS@("MEDSTART")) S @C0CPARMS@("MEDSTART")="T" ; TODAY
 "RTN","C0CPARMS",55,0)
- ;I '$D(@C0CPARMS@("MEDACTIVE")) S @C0CPARMS@("MEDACTIVE")=1 ; YES
+ ;I '$D(@C0CPARMS@("MEDALL")) S @C0CPARMS@("MEDALL")=1 ; NON-PENDING NON-ACTIVE
 "RTN","C0CPARMS",56,0)
- ;I '$D(@C0CPARMS@("MEDPENDING")) S @C0CPARMS@("MEDPENDING")=0 ; NO
+ ;;I '$D(@C0CPARMS@("RALIMIT")) S @C0CPARMS@("RALIMIT")="T-36500" ;ONE YR WORTH
 "RTN","C0CPARMS",57,0)
- ;I '$D(@C0CPARMS@("MEDALL")) S @C0CPARMS@("MEDALL")=1 ; NON-PENDING NON-ACTIVE
+ ;;I '$D(@C0CPARMS@("RASTART")) S @C0CPARMS@("RASTART")="T" ;TODAY
 "RTN","C0CPARMS",58,0)
- ;;I '$D(@C0CPARMS@("RALIMIT")) S @C0CPARMS@("RALIMIT")="T-36500" ;ONE YR WORTH
+ ;I '$D(@C0CPARMS@("TIUSTART")) S @C0CPARMS@("TIUSTART")="T" ;TODAY
 "RTN","C0CPARMS",59,0)
- ;;I '$D(@C0CPARMS@("RASTART")) S @C0CPARMS@("RASTART")="T" ;TODAY
+ ;;OHUM/RUT
 "RTN","C0CPARMS",60,0)
- ;I '$D(@C0CPARMS@("TIUSTART")) S @C0CPARMS@("TIUSTART")="T" ;TODAY
+ S @C0CPARMS@("LABLIMIT")=$P(^C0CPARM(1,0),"^",2)
 "RTN","C0CPARMS",61,0)
- ;;OHUM/RUT
+    S @C0CPARMS@("LABSTART")=$P(^C0CPARM(1,0),"^",3)
 "RTN","C0CPARMS",62,0)
- S @C0CPARMS@("LABLIMIT")=$P(^C0CPARM(1,0),"^",2)
+    S @C0CPARMS@("VITLIMIT")=$P(^C0CPARM(1,0),"^",4)
 "RTN","C0CPARMS",63,0)
-    S @C0CPARMS@("LABSTART")=$P(^C0CPARM(1,0),"^",3)
+    S @C0CPARMS@("VITSTART")=$P(^C0CPARM(1,1),"^",1)
 "RTN","C0CPARMS",64,0)
-    S @C0CPARMS@("VITLIMIT")=$P(^C0CPARM(1,0),"^",4)
+    S @C0CPARMS@("MEDLIMIT")=$P(^C0CPARM(1,1),"^",2)
 "RTN","C0CPARMS",65,0)
-    S @C0CPARMS@("VITSTART")=$P(^C0CPARM(1,1),"^",1)
+    S @C0CPARMS@("MEDSTART")=$P(^C0CPARM(1,1),"^",3)
 "RTN","C0CPARMS",66,0)
-    S @C0CPARMS@("MEDLIMIT")=$P(^C0CPARM(1,1),"^",2)
+    S @C0CPARMS@("MEDACTIVE")=0
 "RTN","C0CPARMS",67,0)
-    S @C0CPARMS@("MEDSTART")=$P(^C0CPARM(1,1),"^",3)
+    S @C0CPARMS@("MEDPENDING")=0
 "RTN","C0CPARMS",68,0)
-    S @C0CPARMS@("MEDACTIVE")=0
+    S @C0CPARMS@("MEDALL")=0 ;OHUM/RUT 3120504 INITIALISING MEDICATION STATUS VARIABLES WITH ZERO
 "RTN","C0CPARMS",69,0)
-    S @C0CPARMS@("MEDPENDING")=0
+ I $P(^C0CPARM(1,1),"^",4)="ACT" S @C0CPARMS@("MEDACTIVE")=1
 "RTN","C0CPARMS",70,0)
-    S @C0CPARMS@("MEDALL")=0 ;OHUM/RUT 3120504 INITIALISING MEDICATION STATUS VARIABLES WITH ZERO
+ I $P(^C0CPARM(1,1),"^",4)="PEN" S @C0CPARMS@("MEDPENDING")=1
 "RTN","C0CPARMS",71,0)
- I $P(^C0CPARM(1,1),"^",4)="ACT" S @C0CPARMS@("MEDACTIVE")=1
+ I $P(^C0CPARM(1,1),"^",4)="ALL" S @C0CPARMS@("MEDALL")=1,@C0CPARMS@("MEDPENDING")=1 ;OHUM/RUT 3120504 ADDED FOR INCLUDING PENDING MEDICATIONS FOR STATUS "ALL"
 "RTN","C0CPARMS",72,0)
- I $P(^C0CPARM(1,1),"^",4)="PEN" S @C0CPARMS@("MEDPENDING")=1
+ ;S ^TMP("C0CCCR","TIULIMIT")="",^TMP("C0CCCR","TIUSTART")=""
 "RTN","C0CPARMS",73,0)
- I $P(^C0CPARM(1,1),"^",4)="ALL" S @C0CPARMS@("MEDALL")=1,@C0CPARMS@("MEDPENDING")=1 ;OHUM/RUT 3120504 ADDED FOR INCLUDING PENDING MEDICATIONS FOR STATUS "ALL"
+ I $P(^C0CPARM(1,2),"^",3)=1 S @C0CPARMS@("TIULIMIT")=$P(^C0CPARM(1,2),"^",1),@C0CPARMS@("TIUSTART")=$P(^C0CPARM(1,2),"^",2)
 "RTN","C0CPARMS",74,0)
- ;S ^TMP("C0CCCR","TIULIMIT")="",^TMP("C0CCCR","TIUSTART")=""
+ ;OHUM/RUT
 "RTN","C0CPARMS",75,0)
- I $P(^C0CPARM(1,2),"^",3)=1 S @C0CPARMS@("TIULIMIT")=$P(^C0CPARM(1,2),"^",1),@C0CPARMS@("TIUSTART")=$P(^C0CPARM(1,2),"^",2)
+ Q
 "RTN","C0CPARMS",76,0)
- ;OHUM/RUT
+ ;
 "RTN","C0CPARMS",77,0)
+CHECK ; CHECK TO SEE IF PARMS ARE PRESENT, ELSE RUN SET
+"RTN","C0CPARMS",78,0)
+ ;
+"RTN","C0CPARMS",79,0)
+ I '$D(C0CPARMS) S C0CPARMS=$NA(^TMP("C0CPARMS",$J)) ;SHOULDN'T HAPPEN
+"RTN","C0CPARMS",80,0)
+ I '$D(@C0CPARMS) D SET("SETWITHCHECK:1")
+"RTN","C0CPARMS",81,0)
  Q
-"RTN","C0CPARMS",78,0)
- ;
-"RTN","C0CPARMS",79,0)
-CHECK ; CHECK TO SEE IF PARMS ARE PRESENT, ELSE RUN SET
-"RTN","C0CPARMS",80,0)
- ;
-"RTN","C0CPARMS",81,0)
- I '$D(C0CPARMS) S C0CPARMS=$NA(^TMP("C0CPARMS",$J)) ;SHOULDN'T HAPPEN
 "RTN","C0CPARMS",82,0)
- I '$D(@C0CPARMS) D SET("SETWITHCHECK:1")
+ ;
 "RTN","C0CPARMS",83,0)
- Q
+GET(WHICHP) ;EXTRINSIC TO RETURN THE VALUE OF PARAMETER WHICHP
 "RTN","C0CPARMS",84,0)
  ;
 "RTN","C0CPARMS",85,0)
-GET(WHICHP) ;EXTRINSIC TO RETURN THE VALUE OF PARAMETER WHICHP
+ D CHECK ; SHOULDN'T HAPPEN BUT TO BE SAFE
 "RTN","C0CPARMS",86,0)
- ;
+ N GTMP
 "RTN","C0CPARMS",87,0)
- D CHECK ; SHOULDN'T HAPPEN BUT TO BE SAFE
+ Q $G(@C0CPARMS@(WHICHP)) ;PULL THE PARM FROM THE TABLE
 "RTN","C0CPARMS",88,0)
- N GTMP
-"RTN","C0CPARMS",89,0)
- Q $G(@C0CPARMS@(WHICHP)) ;PULL THE PARM FROM THE TABLE
-"RTN","C0CPARMS",90,0)
  ;
 "RTN","C0CPROBS")
-0^39^B53281308
+0^39^B51600314
 "RTN","C0CPROBS",1,0)
 C0CPROBS ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08
 "RTN","C0CPROBS",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CPROBS",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
 "RTN","C0CPROBS",4,0)
- ;Licensed under the terms of the GNU General Public License.
+ ;
 "RTN","C0CPROBS",5,0)
- ;See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CPROBS",6,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CPROBS",7,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CPROBS",8,0)
- ;it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CPROBS",9,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CPROBS",10,0)
- ;(at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CPROBS",11,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CPROBS",12,0)
- ;This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CPROBS",13,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CPROBS",14,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CPROBS",15,0)
- ;GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CPROBS",16,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CPROBS",17,0)
- ;You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CPROBS",18,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ; PROCESS THE PROBLEMS SECTION OF THE CCR
 "RTN","C0CPROBS",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
 "RTN","C0CPROBS",20,0)
- ;
+EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
 "RTN","C0CPROBS",21,0)
  ;
 "RTN","C0CPROBS",22,0)
- ; PROCESS THE PROBLEMS SECTION OF THE CCR
+ ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
 "RTN","C0CPROBS",23,0)
- ;
+ ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
 "RTN","C0CPROBS",24,0)
-EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
+ ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
 "RTN","C0CPROBS",25,0)
- ;
+ ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
 "RTN","C0CPROBS",26,0)
- ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+ ; INSERT^C0CXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
 "RTN","C0CPROBS",27,0)
- ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
+ ;
 "RTN","C0CPROBS",28,0)
- ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
+ N RPCRSLT,J,K,PTMP,X,VMAP,TBU
 "RTN","C0CPROBS",29,0)
- ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
+ S TVMAP=$NA(^TMP("C0CCCR",$J,"PROBVALS"))
 "RTN","C0CPROBS",30,0)
- ; INSERT^C0CXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
+ S TARYTMP=$NA(^TMP("C0CCCR",$J,"PROBARYTMP"))
 "RTN","C0CPROBS",31,0)
- ;
+ K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
 "RTN","C0CPROBS",32,0)
- N RPCRSLT,J,K,PTMP,X,VMAP,TBU
+ I $$RPMS^C0CUTIL() D RPMS ; IF BGOPRB ROUTINE IS MISSING (IE RPMS)
 "RTN","C0CPROBS",33,0)
- S TVMAP=$NA(^TMP("C0CCCR",$J,"PROBVALS"))
+ I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT
 "RTN","C0CPROBS",34,0)
- S TARYTMP=$NA(^TMP("C0CCCR",$J,"PROBARYTMP"))
+ Q
 "RTN","C0CPROBS",35,0)
- K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
+ ;
 "RTN","C0CPROBS",36,0)
- I $$RPMS^C0CUTIL() D RPMS ; IF BGOPRB ROUTINE IS MISSING (IE RPMS)
+RPMS ; GETS THE PROBLEM LIST FOR RPMS
 "RTN","C0CPROBS",37,0)
- I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT
+ S RPCGLO=$NA(^TMP("BGO",$J))
 "RTN","C0CPROBS",38,0)
+ D GET^BGOPROB(.RPCRSLT,DFN) ; CALL THE PROBLEM LIST RPC
+"RTN","C0CPROBS",39,0)
+ ; FORMAT OF RPC:
+"RTN","C0CPROBS",40,0)
+ ;   Number Code [1] ^ Patient IEN [2] ^ ICD Code [3] ^ Modify Date [4] ^ Class [5] ^ Provider Narrative [6] ^
+"RTN","C0CPROBS",41,0)
+ ;   Date Entered [7] ^ Status [8] ^ Date Onset [9] ^ Problem IEN [10] ^ Notes [11] ^ ICD9 IEN [12] ^
+"RTN","C0CPROBS",42,0)
+ ;   ICD9 Short Name [13] ^ Provider [14] ^ Facility IEN [15] ^ Priority [16]
+"RTN","C0CPROBS",43,0)
+ I '$D(@RPCGLO) W "NULL RESULT FROM GET^BGOPROB ",! S @OUTXML@(0)=0 Q
+"RTN","C0CPROBS",44,0)
+ S J=""
+"RTN","C0CPROBS",45,0)
+ F  S J=$O(@RPCGLO@(J)) Q:J=""  D  ; FOR EACH PROBLEM IN THE LIST
+"RTN","C0CPROBS",46,0)
+ . S VMAP=$NA(@TVMAP@(J))
+"RTN","C0CPROBS",47,0)
+ . K @VMAP
+"RTN","C0CPROBS",48,0)
+ . I DEBUG W "VMAP= ",VMAP,!
+"RTN","C0CPROBS",49,0)
+ . S PTMP=@RPCRSLT@(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
+"RTN","C0CPROBS",50,0)
+ . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL
+"RTN","C0CPROBS",51,0)
+ . D GETN1^C0CRNF("C0CG1",9000011,$P(PTMP,U,10),"") ;GET VALUES BY NAME
+"RTN","C0CPROBS",52,0)
+ . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
+"RTN","C0CPROBS",53,0)
+ . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,10)
+"RTN","C0CPROBS",54,0)
+ . S @VMAP@("PROBLEMSTATUS")=$S($P(PTMP,U,8)="A":"Active",$P(PTMP,U,8)="I":"Inactive",1:"")
+"RTN","C0CPROBS",55,0)
+ . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,6)
+"RTN","C0CPROBS",56,0)
+ . S @VMAP@("PROBLEMCODINGVERSION")=""
+"RTN","C0CPROBS",57,0)
+ . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,3)
+"RTN","C0CPROBS",58,0)
+ . ; FOR CERTIFICATION - GPL
+"RTN","C0CPROBS",59,0)
+ . I @VMAP@("PROBLEMCODEVALUE")=493.90 S @VMAP@("PROBLEMCODEVALUE")=493
+"RTN","C0CPROBS",60,0)
+ . S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("DATE OF ONSET","C0CG1"),"DT")
+"RTN","C0CPROBS",61,0)
+ . S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("DATE LAST MODIFIED","C0CG1"),"DT")
+"RTN","C0CPROBS",62,0)
+ . ;S @VMAP@("PROBLEMSC")=$P(PTMP,U,7) ;UNKNOWN NOT MAPPED IN C0CCCR0
+"RTN","C0CPROBS",63,0)
+ . ;S @VMAP@("PROBLEMSE")=$P(PTMP,U,8) ;UNKNOWN NOT MAPPED IN C0CCCR0
+"RTN","C0CPROBS",64,0)
+ . ;S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9) ;NOT MAPPED IN C0CCCR0
+"RTN","C0CPROBS",65,0)
+ . ;S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10) ;NOT MAPPED IN C0CCCR0
+"RTN","C0CPROBS",66,0)
+ . ;S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11) ;NOT MAPPED IN C0CCCR0
+"RTN","C0CPROBS",67,0)
+ . ;S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12) ;NOT MAPPED IN C0CCCR0
+"RTN","C0CPROBS",68,0)
+ . ;S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
+"RTN","C0CPROBS",69,0)
+ . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$$ZVALUEI^C0CRNF("RECORDING PROVIDER","C0CG1")
+"RTN","C0CPROBS",70,0)
+ . ;S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13) ;NOT MAPPED IN C0CCCR0
+"RTN","C0CPROBS",71,0)
+ . ;S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14) ;NOT MAPPED IN C0CCCR0
+"RTN","C0CPROBS",72,0)
+ . ;S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,15),"DT") ;NOT MAPPED IN C0CCCR0
+"RTN","C0CPROBS",73,0)
+ . ;S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,16),"DT") ;NOT MAPPED IN C0CCCR0
+"RTN","C0CPROBS",74,0)
+ . S ARYTMP=$NA(@TARYTMP@(J))
+"RTN","C0CPROBS",75,0)
+ . ; W "ARYTMP= ",ARYTMP,!
+"RTN","C0CPROBS",76,0)
+ . K @ARYTMP
+"RTN","C0CPROBS",77,0)
+ . D MAP^C0CXPATH(IPXML,VMAP,ARYTMP) ;
+"RTN","C0CPROBS",78,0)
+ . I J=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","C0CPROBS",79,0)
+ . . ; W "FIRST ONE",!
+"RTN","C0CPROBS",80,0)
+ . . D CP^C0CXPATH(ARYTMP,OUTXML)
+"RTN","C0CPROBS",81,0)
+ . . ; W "OUTXML ",OUTXML,!
+"RTN","C0CPROBS",82,0)
+ . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
+"RTN","C0CPROBS",83,0)
+ . . D INSINNER^C0CXPATH(OUTXML,ARYTMP)
+"RTN","C0CPROBS",84,0)
+ ; ZWR ^TMP("C0CCCR",$J,"PROBVALS",*)
+"RTN","C0CPROBS",85,0)
+ ; ZWR ^TMP("C0CCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
+"RTN","C0CPROBS",86,0)
+ ; ZWR @OUTXML
+"RTN","C0CPROBS",87,0)
+ ; $$HTML^DILF(
+"RTN","C0CPROBS",88,0)
+ ; GENERATE THE NARITIVE HTML FOR THE CCD
+"RTN","C0CPROBS",89,0)
+ I CCD D CCD ; IF THIS IS FOR A CCD
+"RTN","C0CPROBS",90,0)
+ D MISSVARS
+"RTN","C0CPROBS",91,0)
  Q
-"RTN","C0CPROBS",39,0)
- ;
-"RTN","C0CPROBS",40,0)
-RPMS ; GETS THE PROBLEM LIST FOR RPMS
-"RTN","C0CPROBS",41,0)
- S RPCGLO=$NA(^TMP("BGO",$J))
-"RTN","C0CPROBS",42,0)
- D GET^BGOPROB(.RPCRSLT,DFN) ; CALL THE PROBLEM LIST RPC
-"RTN","C0CPROBS",43,0)
- ; FORMAT OF RPC:
-"RTN","C0CPROBS",44,0)
- ;   Number Code [1] ^ Patient IEN [2] ^ ICD Code [3] ^ Modify Date [4] ^ Class [5] ^ Provider Narrative [6] ^
-"RTN","C0CPROBS",45,0)
- ;   Date Entered [7] ^ Status [8] ^ Date Onset [9] ^ Problem IEN [10] ^ Notes [11] ^ ICD9 IEN [12] ^
-"RTN","C0CPROBS",46,0)
- ;   ICD9 Short Name [13] ^ Provider [14] ^ Facility IEN [15] ^ Priority [16]
-"RTN","C0CPROBS",47,0)
- I '$D(@RPCGLO) W "NULL RESULT FROM GET^BGOPROB ",! S @OUTXML@(0)=0 Q
-"RTN","C0CPROBS",48,0)
- S J=""
-"RTN","C0CPROBS",49,0)
- F  S J=$O(@RPCGLO@(J)) Q:J=""  D  ; FOR EACH PROBLEM IN THE LIST
-"RTN","C0CPROBS",50,0)
+"RTN","C0CPROBS",92,0)
+ ;
+"RTN","C0CPROBS",93,0)
+VISTA ; GETS THE PROBLEM LIST FOR VISTA
+"RTN","C0CPROBS",94,0)
+ D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC
+"RTN","C0CPROBS",95,0)
+ I '$D(RPCRSLT(1)) D  Q  ; RPC RETURNS NULL
+"RTN","C0CPROBS",96,0)
+ . W "NULL RESULT FROM LIST^ORQQPL3 ",!
+"RTN","C0CPROBS",97,0)
+ . S @OUTXML@(0)=0
+"RTN","C0CPROBS",98,0)
+ . ; Q
+"RTN","C0CPROBS",99,0)
+ ; I DEBUG ZWR RPCRSLT
+"RTN","C0CPROBS",100,0)
+ S @TVMAP@(0)=RPCRSLT(0) ; SAVE NUMBER OF PROBLEMS
+"RTN","C0CPROBS",101,0)
+ F J=1:1:RPCRSLT(0)  D  ; FOR EACH PROBLEM IN THE LIST
+"RTN","C0CPROBS",102,0)
  . S VMAP=$NA(@TVMAP@(J))
-"RTN","C0CPROBS",51,0)
+"RTN","C0CPROBS",103,0)
  . K @VMAP
-"RTN","C0CPROBS",52,0)
+"RTN","C0CPROBS",104,0)
  . I DEBUG W "VMAP= ",VMAP,!
-"RTN","C0CPROBS",53,0)
- . S PTMP=@RPCRSLT@(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
-"RTN","C0CPROBS",54,0)
- . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL
-"RTN","C0CPROBS",55,0)
- . D GETN1^C0CRNF("C0CG1",9000011,$P(PTMP,U,10),"") ;GET VALUES BY NAME
-"RTN","C0CPROBS",56,0)
+"RTN","C0CPROBS",105,0)
+ . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
+"RTN","C0CPROBS",106,0)
  . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
-"RTN","C0CPROBS",57,0)
- . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,10)
-"RTN","C0CPROBS",58,0)
- . S @VMAP@("PROBLEMSTATUS")=$S($P(PTMP,U,8)="A":"Active",$P(PTMP,U,8)="I":"Inactive",1:"")
-"RTN","C0CPROBS",59,0)
- . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,6)
-"RTN","C0CPROBS",60,0)
+"RTN","C0CPROBS",107,0)
+ . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
+"RTN","C0CPROBS",108,0)
+ . S @VMAP@("PROBLEMSTATUS")=$S($P(PTMP,U,2)="A":"Active",$P(PTMP,U,2)="I":"Inactive",1:"")
+"RTN","C0CPROBS",109,0)
+ . N ZPRIOR S ZPRIOR=$P(PTMP,U,14) ;PRIORITY FLAG
+"RTN","C0CPROBS",110,0)
+ . ; turn off acute/chronic for certification gpl
+"RTN","C0CPROBS",111,0)
+ . ;S @VMAP@("PROBLEMSTATUS")=@VMAP@("PROBLEMSTATUS")_$S(ZPRIOR="A":"/Acute",ZPRIOR="C":"/Chronic",1:"") ; append Chronic and Accute to Status
+"RTN","C0CPROBS",112,0)
+ . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
+"RTN","C0CPROBS",113,0)
  . S @VMAP@("PROBLEMCODINGVERSION")=""
-"RTN","C0CPROBS",61,0)
- . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,3)
-"RTN","C0CPROBS",62,0)
+"RTN","C0CPROBS",114,0)
+ . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
+"RTN","C0CPROBS",115,0)
  . ; FOR CERTIFICATION - GPL
-"RTN","C0CPROBS",63,0)
- . I @VMAP@("PROBLEMCODEVALUE")=493.90 S @VMAP@("PROBLEMCODEVALUE")=493
-"RTN","C0CPROBS",64,0)
- . S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("DATE OF ONSET","C0CG1"),"DT")
-"RTN","C0CPROBS",65,0)
- . S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("DATE LAST MODIFIED","C0CG1"),"DT")
-"RTN","C0CPROBS",66,0)
- . ;S @VMAP@("PROBLEMSC")=$P(PTMP,U,7) ;UNKNOWN NOT MAPPED IN C0CCCR0
-"RTN","C0CPROBS",67,0)
- . ;S @VMAP@("PROBLEMSE")=$P(PTMP,U,8) ;UNKNOWN NOT MAPPED IN C0CCCR0
-"RTN","C0CPROBS",68,0)
- . ;S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9) ;NOT MAPPED IN C0CCCR0
-"RTN","C0CPROBS",69,0)
- . ;S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10) ;NOT MAPPED IN C0CCCR0
-"RTN","C0CPROBS",70,0)
- . ;S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11) ;NOT MAPPED IN C0CCCR0
-"RTN","C0CPROBS",71,0)
- . ;S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12) ;NOT MAPPED IN C0CCCR0
-"RTN","C0CPROBS",72,0)
- . ;S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
-"RTN","C0CPROBS",73,0)
- . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$$ZVALUEI^C0CRNF("RECORDING PROVIDER","C0CG1")
-"RTN","C0CPROBS",74,0)
- . ;S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13) ;NOT MAPPED IN C0CCCR0
-"RTN","C0CPROBS",75,0)
- . ;S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14) ;NOT MAPPED IN C0CCCR0
-"RTN","C0CPROBS",76,0)
- . ;S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,15),"DT") ;NOT MAPPED IN C0CCCR0
-"RTN","C0CPROBS",77,0)
- . ;S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,16),"DT") ;NOT MAPPED IN C0CCCR0
-"RTN","C0CPROBS",78,0)
+"RTN","C0CPROBS",116,0)
+ . I @VMAP@("PROBLEMCODEVALUE")["493.90" S @VMAP@("PROBLEMCODEVALUE")=493
+"RTN","C0CPROBS",117,0)
+ . S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,5),"DT")
+"RTN","C0CPROBS",118,0)
+ . S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,6),"DT")
+"RTN","C0CPROBS",119,0)
+ . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
+"RTN","C0CPROBS",120,0)
+ . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
+"RTN","C0CPROBS",121,0)
+ . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
+"RTN","C0CPROBS",122,0)
+ . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
+"RTN","C0CPROBS",123,0)
+ . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
+"RTN","C0CPROBS",124,0)
+ . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
+"RTN","C0CPROBS",125,0)
+ . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
+"RTN","C0CPROBS",126,0)
+ . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
+"RTN","C0CPROBS",127,0)
+ . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
+"RTN","C0CPROBS",128,0)
+ . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
+"RTN","C0CPROBS",129,0)
+ . S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,15),"DT")
+"RTN","C0CPROBS",130,0)
+ . S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,16),"DT")
+"RTN","C0CPROBS",131,0)
  . S ARYTMP=$NA(@TARYTMP@(J))
-"RTN","C0CPROBS",79,0)
+"RTN","C0CPROBS",132,0)
  . ; W "ARYTMP= ",ARYTMP,!
-"RTN","C0CPROBS",80,0)
+"RTN","C0CPROBS",133,0)
  . K @ARYTMP
-"RTN","C0CPROBS",81,0)
+"RTN","C0CPROBS",134,0)
  . D MAP^C0CXPATH(IPXML,VMAP,ARYTMP) ;
-"RTN","C0CPROBS",82,0)
+"RTN","C0CPROBS",135,0)
  . I J=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","C0CPROBS",83,0)
+"RTN","C0CPROBS",136,0)
  . . ; W "FIRST ONE",!
-"RTN","C0CPROBS",84,0)
+"RTN","C0CPROBS",137,0)
  . . D CP^C0CXPATH(ARYTMP,OUTXML)
-"RTN","C0CPROBS",85,0)
+"RTN","C0CPROBS",138,0)
  . . ; W "OUTXML ",OUTXML,!
-"RTN","C0CPROBS",86,0)
+"RTN","C0CPROBS",139,0)
  . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
-"RTN","C0CPROBS",87,0)
+"RTN","C0CPROBS",140,0)
  . . D INSINNER^C0CXPATH(OUTXML,ARYTMP)
-"RTN","C0CPROBS",88,0)
+"RTN","C0CPROBS",141,0)
  ; ZWR ^TMP("C0CCCR",$J,"PROBVALS",*)
-"RTN","C0CPROBS",89,0)
+"RTN","C0CPROBS",142,0)
  ; ZWR ^TMP("C0CCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
-"RTN","C0CPROBS",90,0)
+"RTN","C0CPROBS",143,0)
  ; ZWR @OUTXML
-"RTN","C0CPROBS",91,0)
+"RTN","C0CPROBS",144,0)
  ; $$HTML^DILF(
-"RTN","C0CPROBS",92,0)
+"RTN","C0CPROBS",145,0)
  ; GENERATE THE NARITIVE HTML FOR THE CCD
-"RTN","C0CPROBS",93,0)
+"RTN","C0CPROBS",146,0)
  I CCD D CCD ; IF THIS IS FOR A CCD
-"RTN","C0CPROBS",94,0)
- D MISSINGVARS
-"RTN","C0CPROBS",95,0)
+"RTN","C0CPROBS",147,0)
+ D MISSVARS
+"RTN","C0CPROBS",148,0)
  Q
-"RTN","C0CPROBS",96,0)
- ;
-"RTN","C0CPROBS",97,0)
-VISTA ; GETS THE PROBLEM LIST FOR VISTA
-"RTN","C0CPROBS",98,0)
- D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC
-"RTN","C0CPROBS",99,0)
- I '$D(RPCRSLT(1)) D  Q  ; RPC RETURNS NULL
-"RTN","C0CPROBS",100,0)
- . W "NULL RESULT FROM LIST^ORQQPL3 ",!
-"RTN","C0CPROBS",101,0)
- . S @OUTXML@(0)=0
-"RTN","C0CPROBS",102,0)
- . ; Q
-"RTN","C0CPROBS",103,0)
- ; I DEBUG ZWR RPCRSLT
-"RTN","C0CPROBS",104,0)
- S @TVMAP@(0)=RPCRSLT(0) ; SAVE NUMBER OF PROBLEMS
-"RTN","C0CPROBS",105,0)
- F J=1:1:RPCRSLT(0)  D  ; FOR EACH PROBLEM IN THE LIST
-"RTN","C0CPROBS",106,0)
- . S VMAP=$NA(@TVMAP@(J))
-"RTN","C0CPROBS",107,0)
- . K @VMAP
-"RTN","C0CPROBS",108,0)
- . I DEBUG W "VMAP= ",VMAP,!
-"RTN","C0CPROBS",109,0)
- . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
-"RTN","C0CPROBS",110,0)
- . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
-"RTN","C0CPROBS",111,0)
- . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
-"RTN","C0CPROBS",112,0)
- . S @VMAP@("PROBLEMSTATUS")=$S($P(PTMP,U,2)="A":"Active",$P(PTMP,U,2)="I":"Inactive",1:"")
-"RTN","C0CPROBS",113,0)
- . N ZPRIOR S ZPRIOR=$P(PTMP,U,14) ;PRIORITY FLAG
-"RTN","C0CPROBS",114,0)
- . ; turn off acute/chronic for certification gpl
-"RTN","C0CPROBS",115,0)
- . ;S @VMAP@("PROBLEMSTATUS")=@VMAP@("PROBLEMSTATUS")_$S(ZPRIOR="A":"/Acute",ZPRIOR="C":"/Chronic",1:"") ; append Chronic and Accute to Status
-"RTN","C0CPROBS",116,0)
- . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
-"RTN","C0CPROBS",117,0)
- . S @VMAP@("PROBLEMCODINGVERSION")=""
-"RTN","C0CPROBS",118,0)
- . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
-"RTN","C0CPROBS",119,0)
- . ; FOR CERTIFICATION - GPL
-"RTN","C0CPROBS",120,0)
- . I @VMAP@("PROBLEMCODEVALUE")["493.90" S @VMAP@("PROBLEMCODEVALUE")=493
-"RTN","C0CPROBS",121,0)
- . S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,5),"DT")
-"RTN","C0CPROBS",122,0)
- . S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,6),"DT")
-"RTN","C0CPROBS",123,0)
- . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
-"RTN","C0CPROBS",124,0)
- . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
-"RTN","C0CPROBS",125,0)
- . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
-"RTN","C0CPROBS",126,0)
- . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
-"RTN","C0CPROBS",127,0)
- . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
-"RTN","C0CPROBS",128,0)
- . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
-"RTN","C0CPROBS",129,0)
- . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
-"RTN","C0CPROBS",130,0)
- . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
-"RTN","C0CPROBS",131,0)
- . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
-"RTN","C0CPROBS",132,0)
- . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
-"RTN","C0CPROBS",133,0)
- . S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,15),"DT")
-"RTN","C0CPROBS",134,0)
- . S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,16),"DT")
-"RTN","C0CPROBS",135,0)
- . S ARYTMP=$NA(@TARYTMP@(J))
-"RTN","C0CPROBS",136,0)
- . ; W "ARYTMP= ",ARYTMP,!
-"RTN","C0CPROBS",137,0)
- . K @ARYTMP
-"RTN","C0CPROBS",138,0)
- . D MAP^C0CXPATH(IPXML,VMAP,ARYTMP) ;
-"RTN","C0CPROBS",139,0)
- . I J=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","C0CPROBS",140,0)
- . . ; W "FIRST ONE",!
-"RTN","C0CPROBS",141,0)
- . . D CP^C0CXPATH(ARYTMP,OUTXML)
-"RTN","C0CPROBS",142,0)
- . . ; W "OUTXML ",OUTXML,!
-"RTN","C0CPROBS",143,0)
- . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
-"RTN","C0CPROBS",144,0)
- . . D INSINNER^C0CXPATH(OUTXML,ARYTMP)
-"RTN","C0CPROBS",145,0)
- ; ZWR ^TMP("C0CCCR",$J,"PROBVALS",*)
-"RTN","C0CPROBS",146,0)
- ; ZWR ^TMP("C0CCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
-"RTN","C0CPROBS",147,0)
- ; ZWR @OUTXML
-"RTN","C0CPROBS",148,0)
- ; $$HTML^DILF(
 "RTN","C0CPROBS",149,0)
- ; GENERATE THE NARITIVE HTML FOR THE CCD
+CCD ;
 "RTN","C0CPROBS",150,0)
- I CCD D CCD ; IF THIS IS FOR A CCD
+ N HTMP,HOUT,HTMLO,C0CPROBI,ZX
 "RTN","C0CPROBS",151,0)
- D MISSINGVARS
+ F C0CPROBI=1:1:RPCRSLT(0) D  ; FOR EACH PROBLEM
 "RTN","C0CPROBS",152,0)
+ . S VMAP=$NA(@TVMAP@(C0CPROBI))
+"RTN","C0CPROBS",153,0)
+ . I DEBUG W "VMAP =",VMAP,!
+"RTN","C0CPROBS",154,0)
+ . D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
+"RTN","C0CPROBS",155,0)
+ . D UNMARK^C0CXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP
+"RTN","C0CPROBS",156,0)
+ . ; D PARY^C0CXPATH("HTMP") ; PRINT IT
+"RTN","C0CPROBS",157,0)
+ . D MAP^C0CXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES
+"RTN","C0CPROBS",158,0)
+ . ; D PARY^C0CXPATH("HOUT") ; PRINT IT AGAIN
+"RTN","C0CPROBS",159,0)
+ . I C0CPROBI=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","C0CPROBS",160,0)
+ . . D CP^C0CXPATH("HOUT","HTMLO")
+"RTN","C0CPROBS",161,0)
+ . I C0CPROBI>1 D  ; AFTER THE FIRST, INSERT INNER HTML
+"RTN","C0CPROBS",162,0)
+ . . I DEBUG W "DOING INNER",!
+"RTN","C0CPROBS",163,0)
+ . . N HTMLBLD,HTMLTMP
+"RTN","C0CPROBS",164,0)
+ . . D QUEUE^C0CXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
+"RTN","C0CPROBS",165,0)
+ . . D QUEUE^C0CXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
+"RTN","C0CPROBS",166,0)
+ . . D QUEUE^C0CXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))
+"RTN","C0CPROBS",167,0)
+ . . D BUILD^C0CXPATH("HTMLBLD","HTMLTMP")
+"RTN","C0CPROBS",168,0)
+ . . D CP^C0CXPATH("HTMLTMP","HTMLO")
+"RTN","C0CPROBS",169,0)
+ . . ; D INSINNER^C0CXPATH("HOUT","HTMLO","//")
+"RTN","C0CPROBS",170,0)
+ I DEBUG D PARY^C0CXPATH("HTMLO")
+"RTN","C0CPROBS",171,0)
+ D INSB4^C0CXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
+"RTN","C0CPROBS",172,0)
  Q
-"RTN","C0CPROBS",153,0)
-CCD 
-"RTN","C0CPROBS",154,0)
- N HTMP,HOUT,HTMLO,C0CPROBI,ZX
-"RTN","C0CPROBS",155,0)
- F C0CPROBI=1:1:RPCRSLT(0) D  ; FOR EACH PROBLEM
-"RTN","C0CPROBS",156,0)
- . S VMAP=$NA(@TVMAP@(C0CPROBI))
-"RTN","C0CPROBS",157,0)
- . I DEBUG W "VMAP =",VMAP,!
-"RTN","C0CPROBS",158,0)
- . D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
-"RTN","C0CPROBS",159,0)
- . D UNMARK^C0CXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP
-"RTN","C0CPROBS",160,0)
- . ; D PARY^C0CXPATH("HTMP") ; PRINT IT
-"RTN","C0CPROBS",161,0)
- . D MAP^C0CXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES
-"RTN","C0CPROBS",162,0)
- . ; D PARY^C0CXPATH("HOUT") ; PRINT IT AGAIN
-"RTN","C0CPROBS",163,0)
- . I C0CPROBI=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","C0CPROBS",164,0)
- . . D CP^C0CXPATH("HOUT","HTMLO")
-"RTN","C0CPROBS",165,0)
- . I C0CPROBI>1 D  ; AFTER THE FIRST, INSERT INNER HTML
-"RTN","C0CPROBS",166,0)
- . . I DEBUG W "DOING INNER",!
-"RTN","C0CPROBS",167,0)
- . . N HTMLBLD,HTMLTMP
-"RTN","C0CPROBS",168,0)
- . . D QUEUE^C0CXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
-"RTN","C0CPROBS",169,0)
- . . D QUEUE^C0CXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
-"RTN","C0CPROBS",170,0)
- . . D QUEUE^C0CXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))
-"RTN","C0CPROBS",171,0)
- . . D BUILD^C0CXPATH("HTMLBLD","HTMLTMP")
-"RTN","C0CPROBS",172,0)
- . . D CP^C0CXPATH("HTMLTMP","HTMLO")
 "RTN","C0CPROBS",173,0)
- . . ; D INSINNER^C0CXPATH("HOUT","HTMLO","//")
+MISSVARS ; Missing Variables
 "RTN","C0CPROBS",174,0)
- I DEBUG D PARY^C0CXPATH("HTMLO")
+ N PROBSTMP,I
 "RTN","C0CPROBS",175,0)
- D INSB4^C0CXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
+ D MISSING^C0CXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
 "RTN","C0CPROBS",176,0)
+ I PROBSTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
+"RTN","C0CPROBS",177,0)
+ . ; STRINGS MARKED AS @@X@@
+"RTN","C0CPROBS",178,0)
+ . W !,"PROBLEMS Missing list: ",!
+"RTN","C0CPROBS",179,0)
+ . F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
+"RTN","C0CPROBS",180,0)
  Q
-"RTN","C0CPROBS",177,0)
-MISSINGVARS 
-"RTN","C0CPROBS",178,0)
- N PROBSTMP,I
-"RTN","C0CPROBS",179,0)
- D MISSING^C0CXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","C0CPROBS",180,0)
- I PROBSTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
 "RTN","C0CPROBS",181,0)
- . ; STRINGS MARKED AS @@X@@
-"RTN","C0CPROBS",182,0)
- . W !,"PROBLEMS Missing list: ",!
-"RTN","C0CPROBS",183,0)
- . F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
-"RTN","C0CPROBS",184,0)
- Q
-"RTN","C0CPROBS",185,0)
  ;
 "RTN","C0CPROC")
-0^63^B27869918
+0^63^B26886546
 "RTN","C0CPROC",1,0)
 C0CPROC  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROCEDURES ; 01/21/10
 "RTN","C0CPROC",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CPROC",3,0)
- ;Copyright 2010 George Lilly, University of Minnesota and others.
+ ;
 "RTN","C0CPROC",4,0)
- ;Licensed under the terms of the GNU General Public License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CPROC",5,0)
- ;See attached copy of the License.
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CPROC",6,0)
- ;
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CPROC",7,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; License, or (at your option) any later version.
 "RTN","C0CPROC",8,0)
- ;it under the terms of the GNU General Public License as published by
+ ;
 "RTN","C0CPROC",9,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CPROC",10,0)
- ;(at your option) any later version.
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CPROC",11,0)
- ;
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CPROC",12,0)
- ;This program is distributed in the hope that it will be useful,
+ ; GNU Affero General Public License for more details.
 "RTN","C0CPROC",13,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;
 "RTN","C0CPROC",14,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CPROC",15,0)
- ;GNU General Public License for more details.
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CPROC",16,0)
  ;
 "RTN","C0CPROC",17,0)
- ;You should have received a copy of the GNU General Public License along
+ W "NO ENTRY FROM TOP",!
 "RTN","C0CPROC",18,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ Q
 "RTN","C0CPROC",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
 "RTN","C0CPROC",20,0)
- ;
+SETVARS ; SET UP VARIABLES FOR PROCEDURES, ENCOUNTERS, AND NOTES
 "RTN","C0CPROC",21,0)
- W "NO ENTRY FROM TOP",!
+ S C0CENC=$NA(^TMP("C0CCCR",$J,"C0CENC",DFN))
 "RTN","C0CPROC",22,0)
+ S C0CPRC=$NA(^TMP("C0CCCR",$J,"C0CPRC",DFN))
+"RTN","C0CPROC",23,0)
+ S C0CNTE=$NA(^TMP("C0CCCR",$J,"C0CNTE",DFN))
+"RTN","C0CPROC",24,0)
+ ; ADDITION FOR CERTIFICATION
+"RTN","C0CPROC",25,0)
+ S C0CPRSLT=$NA(^TMP("C0CCCR",$J,"C0CPRSLT",DFN))
+"RTN","C0CPROC",26,0)
  Q
-"RTN","C0CPROC",23,0)
- ;
-"RTN","C0CPROC",24,0)
-SETVARS ; SET UP VARIABLES FOR PROCEDURES, ENCOUNTERS, AND NOTES
-"RTN","C0CPROC",25,0)
- S C0CENC=$NA(^TMP("C0CCCR",$J,"C0CENC",DFN))
-"RTN","C0CPROC",26,0)
- S C0CPRC=$NA(^TMP("C0CCCR",$J,"C0CPRC",DFN))
 "RTN","C0CPROC",27,0)
- S C0CNTE=$NA(^TMP("C0CCCR",$J,"C0CNTE",DFN))
+ ;
 "RTN","C0CPROC",28,0)
- ; ADDITION FOR CERTIFICATION
+EXTRACT(PROCXML,DFN,PROCOUT) ; EXTRACT PROCEDURES INTO  XML TEMPLATE
 "RTN","C0CPROC",29,0)
- S C0CPRSLT=$NA(^TMP("C0CCCR",$J,"C0CPRSLT",DFN))
+ ; PROCXML AND PROCOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
 "RTN","C0CPROC",30,0)
+ ;
+"RTN","C0CPROC",31,0)
+ D SETVARS ; SET UP VARIABLES
+"RTN","C0CPROC",32,0)
+ I '$D(@C0CPRC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE
+"RTN","C0CPROC",33,0)
+ D MAP(PROCXML,C0CPRC,PROCOUT) ;MAP RESULTS FOR PROCEDURES
+"RTN","C0CPROC",34,0)
  Q
-"RTN","C0CPROC",31,0)
- ;
-"RTN","C0CPROC",32,0)
-EXTRACT(PROCXML,DFN,PROCOUT) ; EXTRACT PROCEDURES INTO  XML TEMPLATE
-"RTN","C0CPROC",33,0)
- ; PROCXML AND PROCOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","C0CPROC",34,0)
- ;
 "RTN","C0CPROC",35,0)
- D SETVARS ; SET UP VARIABLES
+ ;
 "RTN","C0CPROC",36,0)
- I '$D(@C0CPRC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE
+TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES, 
 "RTN","C0CPROC",37,0)
- D MAP(PROCXML,C0CPRC,PROCOUT) ;MAP RESULTS FOR PROCEDURES
+ ; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
 "RTN","C0CPROC",38,0)
+ ; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES
+"RTN","C0CPROC",39,0)
+ ; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT
+"RTN","C0CPROC",40,0)
+ ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY 
+"RTN","C0CPROC",41,0)
+ ; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM
+"RTN","C0CPROC",42,0)
+ ; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS
+"RTN","C0CPROC",43,0)
+ ;
+"RTN","C0CPROC",44,0)
+ K VISIT,LST,NOTE,C0CLPRC
+"RTN","C0CPROC",45,0)
+ ; C0CLPRC IS A LOOKUP TABLE FOR USE IN BUILDING ENCOUNTERS
+"RTN","C0CPROC",46,0)
+ ; FORMAT C0CLPRC(VISITIEN,CPT)=PROCOBJECTID FOR BUILDING LINKS TO PROCEDURES
+"RTN","C0CPROC",47,0)
+ D ENTRY^C0CCPT(DFN,,,1) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE
+"RTN","C0CPROC",48,0)
+ ; NEED TO ADD START AND END DATES FROM PARAMETERS
+"RTN","C0CPROC",49,0)
+ N ZI S ZI=""
+"RTN","C0CPROC",50,0)
+ N PREVCPT,PREVDT S (PREVCPT,PREVDT)=""
+"RTN","C0CPROC",51,0)
+ F  S ZI=$O(VISIT(ZI),-1) Q:ZI=""  D  ; REVERSE TIME ORDER - MOST RECENT FIRST
+"RTN","C0CPROC",52,0)
+ . N ZDATE
+"RTN","C0CPROC",53,0)
+ . S ZDATE=$$DATE(VISIT(ZI,"DATE",0))
+"RTN","C0CPROC",54,0)
+ . S ZPRVARY=$NA(VISIT(ZI,"PRV"))
+"RTN","C0CPROC",55,0)
+ . N ZPRV
+"RTN","C0CPROC",56,0)
+ . S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM
+"RTN","C0CPROC",57,0)
+ . ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON 
+"RTN","C0CPROC",58,0)
+ . N ZJ S ZJ=""
+"RTN","C0CPROC",59,0)
+ . F  S ZJ=$O(VISIT(ZI,"CPT",ZJ)) Q:ZJ=""  D  ;FOR EACH CPT SEG
+"RTN","C0CPROC",60,0)
+ . . N ZRNF
+"RTN","C0CPROC",61,0)
+ . . N ZCPT S ZCPT=$$CPT(VISIT(ZI,"CPT",ZJ)) ;GET CPT CODE AND TEXT
+"RTN","C0CPROC",62,0)
+ . . I ZCPT'="" D  ;IF CPT CODE IS PRESENT
+"RTN","C0CPROC",63,0)
+ . . . I (ZCPT=PREVCPT)&(ZDATE=PREVDT) Q  ; NO DUPS ALLOWED
+"RTN","C0CPROC",64,0)
+ . . . W !,ZCPT," ",ZDATE," ",ZPRV
+"RTN","C0CPROC",65,0)
+ . . . S ZRNF("PROCACTOROBJID")=ZPRV
+"RTN","C0CPROC",66,0)
+ . . . N PROCCODE S PROCCODE=$P(ZCPT,U,1)
+"RTN","C0CPROC",67,0)
+ . . . S ZRNF("PROCCODE")=PROCCODE
+"RTN","C0CPROC",68,0)
+ . . . S ZRNF("PROCCODESYS")="CPT-4"
+"RTN","C0CPROC",69,0)
+ . . . S ZRNF("PROCDATETEXT")="Procedure Date"
+"RTN","C0CPROC",70,0)
+ . . . S ZRNF("PROCDATETIME")=ZDATE
+"RTN","C0CPROC",71,0)
+ . . . S ZRNF("PROCDESCOBJATTRCODE")="" ;NO PROC ATTRIBUTES YET
+"RTN","C0CPROC",72,0)
+ . . . S ZRNF("PROCDESCOBJATTR")=""
+"RTN","C0CPROC",73,0)
+ . . . S ZRNF("PROCDESCOBJATTRCODESYS")="" ;WE DON'T HAVE PROC ATTRIBUTES
+"RTN","C0CPROC",74,0)
+ . . . S ZRNF("PROCDESCOBJATTRVAL")=""
+"RTN","C0CPROC",75,0)
+ . . . S ZRNF("PROCDESCTEXT")=$P(ZCPT,U,3)
+"RTN","C0CPROC",76,0)
+ . . . S ZRNF("PROCLINKID")="" ; NO LINKS YET
+"RTN","C0CPROC",77,0)
+ . . . S ZRNF("PROCLINKREL")="" ; NO LINKS YET
+"RTN","C0CPROC",78,0)
+ . . . ; additions for Certification - need to have EKG in Results
+"RTN","C0CPROC",79,0)
+ . . . S ZRNF("PROCTEXT")=$G(VISIT(ZI,"TEXT",1)) ; POTENTIAL RESULT
+"RTN","C0CPROC",80,0)
+ . . . S ZRNF("PROCOBJECTID")="PROCEDURE_"_ZI_"_"_ZJ
+"RTN","C0CPROC",81,0)
+ . . . S C0CLPRC(ZI,PROCCODE)=ZRNF("PROCOBJECTID") ; LOOKUP TABLE FOR ENCOUNTERS
+"RTN","C0CPROC",82,0)
+ . . . S ZRNF("PROCSTATUS")="Completed" ; Is this right?
+"RTN","C0CPROC",83,0)
+ . . . S ZRNF("PROCTYPE")=$P(ZCPT,U,2) ; NEED TO ADD THIS TO TEMPLATE
+"RTN","C0CPROC",84,0)
+ . . . D RNF1TO2^C0CRNF(C0CPRC,"ZRNF") ; ADD THIS ROW TO THE ARRAY
+"RTN","C0CPROC",85,0)
+ . . . ; FOR CERTIFICATION - SAVE EKG RESULTS gpl
+"RTN","C0CPROC",86,0)
+ . . . W !,"CPT=",ZCPT
+"RTN","C0CPROC",87,0)
+ . . . I ZCPT["93000" D  ; THIS IS AN EKG
+"RTN","C0CPROC",88,0)
+ . . . . D RNF1TO2^C0CRNF(C0CPRSLT,"ZRNF") ; SAVE FOR LABS
+"RTN","C0CPROC",89,0)
+ . . . . M ^GPL("RNF2")=@C0CPRSLT
+"RTN","C0CPROC",90,0)
+ . . . S PREVCPT=ZCPT
+"RTN","C0CPROC",91,0)
+ . . . S PREVDT=ZDATE
+"RTN","C0CPROC",92,0)
+ N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"PROCEDURES"))
+"RTN","C0CPROC",93,0)
+ M @ZRIM=@C0CPRC@("V")
+"RTN","C0CPROC",94,0)
  Q
-"RTN","C0CPROC",39,0)
- ;
-"RTN","C0CPROC",40,0)
-TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES, 
-"RTN","C0CPROC",41,0)
- ; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
-"RTN","C0CPROC",42,0)
- ; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES
-"RTN","C0CPROC",43,0)
- ; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT
-"RTN","C0CPROC",44,0)
- ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY 
-"RTN","C0CPROC",45,0)
- ; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM
-"RTN","C0CPROC",46,0)
- ; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS
-"RTN","C0CPROC",47,0)
- ;
-"RTN","C0CPROC",48,0)
- K VISIT,LST,NOTE,C0CLPRC
-"RTN","C0CPROC",49,0)
- ; C0CLPRC IS A LOOKUP TABLE FOR USE IN BUILDING ENCOUNTERS
-"RTN","C0CPROC",50,0)
- ; FORMAT C0CLPRC(VISITIEN,CPT)=PROCOBJECTID FOR BUILDING LINKS TO PROCEDURES
-"RTN","C0CPROC",51,0)
- D ENTRY^C0CCPT(DFN,,,1) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE
-"RTN","C0CPROC",52,0)
- ; NEED TO ADD START AND END DATES FROM PARAMETERS
-"RTN","C0CPROC",53,0)
- N ZI S ZI=""
-"RTN","C0CPROC",54,0)
- N PREVCPT,PREVDT S (PREVCPT,PREVDT)=""
-"RTN","C0CPROC",55,0)
- F  S ZI=$O(VISIT(ZI),-1) Q:ZI=""  D  ; REVERSE TIME ORDER - MOST RECENT FIRST
-"RTN","C0CPROC",56,0)
- . N ZDATE
-"RTN","C0CPROC",57,0)
- . S ZDATE=$$DATE(VISIT(ZI,"DATE",0))
-"RTN","C0CPROC",58,0)
- . S ZPRVARY=$NA(VISIT(ZI,"PRV"))
-"RTN","C0CPROC",59,0)
- . N ZPRV
-"RTN","C0CPROC",60,0)
- . S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM
-"RTN","C0CPROC",61,0)
- . ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON 
-"RTN","C0CPROC",62,0)
- . N ZJ S ZJ=""
-"RTN","C0CPROC",63,0)
- . F  S ZJ=$O(VISIT(ZI,"CPT",ZJ)) Q:ZJ=""  D  ;FOR EACH CPT SEG
-"RTN","C0CPROC",64,0)
- . . N ZRNF
-"RTN","C0CPROC",65,0)
- . . N ZCPT S ZCPT=$$CPT(VISIT(ZI,"CPT",ZJ)) ;GET CPT CODE AND TEXT
-"RTN","C0CPROC",66,0)
- . . I ZCPT'="" D  ;IF CPT CODE IS PRESENT
-"RTN","C0CPROC",67,0)
- . . . I (ZCPT=PREVCPT)&(ZDATE=PREVDT) Q  ; NO DUPS ALLOWED
-"RTN","C0CPROC",68,0)
- . . . W !,ZCPT," ",ZDATE," ",ZPRV
-"RTN","C0CPROC",69,0)
- . . . S ZRNF("PROCACTOROBJID")=ZPRV
-"RTN","C0CPROC",70,0)
- . . . N PROCCODE S PROCCODE=$P(ZCPT,U,1)
-"RTN","C0CPROC",71,0)
- . . . S ZRNF("PROCCODE")=PROCCODE
-"RTN","C0CPROC",72,0)
- . . . S ZRNF("PROCCODESYS")="CPT-4"
-"RTN","C0CPROC",73,0)
- . . . S ZRNF("PROCDATETEXT")="Procedure Date"
-"RTN","C0CPROC",74,0)
- . . . S ZRNF("PROCDATETIME")=ZDATE
-"RTN","C0CPROC",75,0)
- . . . S ZRNF("PROCDESCOBJATTRCODE")="" ;NO PROC ATTRIBUTES YET
-"RTN","C0CPROC",76,0)
- . . . S ZRNF("PROCDESCOBJATTR")=""
-"RTN","C0CPROC",77,0)
- . . . S ZRNF("PROCDESCOBJATTRCODESYS")="" ;WE DON'T HAVE PROC ATTRIBUTES
-"RTN","C0CPROC",78,0)
- . . . S ZRNF("PROCDESCOBJATTRVAL")=""
-"RTN","C0CPROC",79,0)
- . . . S ZRNF("PROCDESCTEXT")=$P(ZCPT,U,3)
-"RTN","C0CPROC",80,0)
- . . . S ZRNF("PROCLINKID")="" ; NO LINKS YET
-"RTN","C0CPROC",81,0)
- . . . S ZRNF("PROCLINKREL")="" ; NO LINKS YET
-"RTN","C0CPROC",82,0)
- . . . ; additions for Certification - need to have EKG in Results
-"RTN","C0CPROC",83,0)
- . . . S ZRNF("PROCTEXT")=$G(VISIT(ZI,"TEXT",1)) ; POTENTIAL RESULT
-"RTN","C0CPROC",84,0)
- . . . S ZRNF("PROCOBJECTID")="PROCEDURE_"_ZI_"_"_ZJ
-"RTN","C0CPROC",85,0)
- . . . S C0CLPRC(ZI,PROCCODE)=ZRNF("PROCOBJECTID") ; LOOKUP TABLE FOR ENCOUNTERS
-"RTN","C0CPROC",86,0)
- . . . S ZRNF("PROCSTATUS")="Completed" ; Is this right?
-"RTN","C0CPROC",87,0)
- . . . S ZRNF("PROCTYPE")=$P(ZCPT,U,2) ; NEED TO ADD THIS TO TEMPLATE
-"RTN","C0CPROC",88,0)
- . . . D RNF1TO2^C0CRNF(C0CPRC,"ZRNF") ; ADD THIS ROW TO THE ARRAY
-"RTN","C0CPROC",89,0)
- . . . ; FOR CERTIFICATION - SAVE EKG RESULTS gpl
-"RTN","C0CPROC",90,0)
- . . . W !,"CPT=",ZCPT
-"RTN","C0CPROC",91,0)
- . . . I ZCPT["93000" D  ; THIS IS AN EKG
-"RTN","C0CPROC",92,0)
- . . . . D RNF1TO2^C0CRNF(C0CPRSLT,"ZRNF") ; SAVE FOR LABS
-"RTN","C0CPROC",93,0)
- . . . . M ^GPL("RNF2")=@C0CPRSLT
-"RTN","C0CPROC",94,0)
- . . . S PREVCPT=ZCPT
 "RTN","C0CPROC",95,0)
- . . . S PREVDT=ZDATE
+ ;
 "RTN","C0CPROC",96,0)
- N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"PROCEDURES"))
+PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME
 "RTN","C0CPROC",97,0)
- M @ZRIM=@C0CPRC@("V")
+ N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN=""
 "RTN","C0CPROC",98,0)
+ F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ; FOR EACH PRV SEG
+"RTN","C0CPROC",99,0)
+ . I ZR'="" Q  ;ONLY WANT THE FIRST PRIMARY PROVIDER
+"RTN","C0CPROC",100,0)
+ . I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1)
+"RTN","C0CPROC",101,0)
+ I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR
+"RTN","C0CPROC",102,0)
+ Q ZRTN
+"RTN","C0CPROC",103,0)
+ ;
+"RTN","C0CPROC",104,0)
+DATE(ISTR) ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT
+"RTN","C0CPROC",105,0)
+ Q $$FMDTOUTC^C0CUTIL(ISTR,"DT")
+"RTN","C0CPROC",106,0)
+ ;
+"RTN","C0CPROC",107,0)
+CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS
+"RTN","C0CPROC",108,0)
+ ; CPT^CATEGORY^TEXT
+"RTN","C0CPROC",109,0)
+ N Z1,Z2,Z3,ZRTN
+"RTN","C0CPROC",110,0)
+ S Z1=$P(ISTR,U,1)
+"RTN","C0CPROC",111,0)
+ I Z1="" D  ;
+"RTN","C0CPROC",112,0)
+ . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)
+"RTN","C0CPROC",113,0)
+ I Z1'="" D  ; IF THERE IS A CPT CODE IN THERE
+"RTN","C0CPROC",114,0)
+ . ;S Z1=$P(ISTR,U,1)
+"RTN","C0CPROC",115,0)
+ . S Z2=$P(ISTR,U,2)
+"RTN","C0CPROC",116,0)
+ . S Z3=$P(ISTR,U,3)
+"RTN","C0CPROC",117,0)
+ . S ZRTN=Z1_U_Z2_U_Z3
+"RTN","C0CPROC",118,0)
+ E  S ZRTN=""
+"RTN","C0CPROC",119,0)
+ Q ZRTN
+"RTN","C0CPROC",120,0)
+ ;
+"RTN","C0CPROC",121,0)
+MAP(PROCXML,C0CPRC,PROCOUT) ; MAP PROCEDURES XML 
+"RTN","C0CPROC",122,0)
+ ;
+"RTN","C0CPROC",123,0)
+ N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"PROCTEMP")) ;WORK AREA FOR TEMPLATE
+"RTN","C0CPROC",124,0)
+ K @ZTEMP
+"RTN","C0CPROC",125,0)
+ N ZBLD
+"RTN","C0CPROC",126,0)
+ S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"PROCBLD")) ; BUILD LIST AREA
+"RTN","C0CPROC",127,0)
+ D QUEUE^C0CXPATH(ZBLD,PROCXML,1,1) ; FIRST LINE
+"RTN","C0CPROC",128,0)
+ N ZINNER
+"RTN","C0CPROC",129,0)
+ D QUERY^C0CXPATH(PROCXML,"//Procedures/Procedure","ZINNER") ;ONE PROC
+"RTN","C0CPROC",130,0)
+ N ZTMP,ZVAR,ZI
+"RTN","C0CPROC",131,0)
+ S ZI=""
+"RTN","C0CPROC",132,0)
+ F  S ZI=$O(@C0CPRC@("V",ZI)) Q:ZI=""  D  ;FOR EACH PROCEDURE
+"RTN","C0CPROC",133,0)
+ . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS PROCEDURE XML
+"RTN","C0CPROC",134,0)
+ . S ZVAR=$NA(@C0CPRC@("V",ZI)) ;THIS PROCEDURE VARIABLES
+"RTN","C0CPROC",135,0)
+ . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
+"RTN","C0CPROC",136,0)
+ . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
+"RTN","C0CPROC",137,0)
+ D QUEUE^C0CXPATH(ZBLD,PROCXML,@PROCXML@(0),@PROCXML@(0))
+"RTN","C0CPROC",138,0)
+ N ZZTMP
+"RTN","C0CPROC",139,0)
+ D BUILD^C0CXPATH(ZBLD,PROCOUT) ;BUILD FINAL XML
+"RTN","C0CPROC",140,0)
+ K @ZTEMP,@ZBLD,@C0CPRC
+"RTN","C0CPROC",141,0)
  Q
-"RTN","C0CPROC",99,0)
- ;
-"RTN","C0CPROC",100,0)
-PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME
-"RTN","C0CPROC",101,0)
- N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN=""
-"RTN","C0CPROC",102,0)
- F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ; FOR EACH PRV SEG
-"RTN","C0CPROC",103,0)
- . I ZR'="" Q  ;ONLY WANT THE FIRST PRIMARY PROVIDER
-"RTN","C0CPROC",104,0)
- . I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1)
-"RTN","C0CPROC",105,0)
- I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR
-"RTN","C0CPROC",106,0)
- Q ZRTN
-"RTN","C0CPROC",107,0)
- ;
-"RTN","C0CPROC",108,0)
-DATE(ISTR) ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT
-"RTN","C0CPROC",109,0)
- Q $$FMDTOUTC^C0CUTIL(ISTR,"DT")
-"RTN","C0CPROC",110,0)
- ;
-"RTN","C0CPROC",111,0)
-CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS
-"RTN","C0CPROC",112,0)
- ; CPT^CATEGORY^TEXT
-"RTN","C0CPROC",113,0)
- N Z1,Z2,Z3,ZRTN
-"RTN","C0CPROC",114,0)
- S Z1=$P(ISTR,U,1) 
-"RTN","C0CPROC",115,0)
- I Z1="" D  ;
-"RTN","C0CPROC",116,0)
- . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)
-"RTN","C0CPROC",117,0)
- I Z1'="" D  ; IF THERE IS A CPT CODE IN THERE
-"RTN","C0CPROC",118,0)
- . ;S Z1=$P(ISTR,U,1)
-"RTN","C0CPROC",119,0)
- . S Z2=$P(ISTR,U,2)
-"RTN","C0CPROC",120,0)
- . S Z3=$P(ISTR,U,3)
-"RTN","C0CPROC",121,0)
- . S ZRTN=Z1_U_Z2_U_Z3
-"RTN","C0CPROC",122,0)
- E  S ZRTN=""
-"RTN","C0CPROC",123,0)
- Q ZRTN
-"RTN","C0CPROC",124,0)
- ;
-"RTN","C0CPROC",125,0)
-MAP(PROCXML,C0CPRC,PROCOUT) ; MAP PROCEDURES XML 
-"RTN","C0CPROC",126,0)
- ;
-"RTN","C0CPROC",127,0)
- N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"PROCTEMP")) ;WORK AREA FOR TEMPLATE
-"RTN","C0CPROC",128,0)
- K @ZTEMP
-"RTN","C0CPROC",129,0)
- N ZBLD
-"RTN","C0CPROC",130,0)
- S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"PROCBLD")) ; BUILD LIST AREA
-"RTN","C0CPROC",131,0)
- D QUEUE^C0CXPATH(ZBLD,PROCXML,1,1) ; FIRST LINE
-"RTN","C0CPROC",132,0)
- N ZINNER
-"RTN","C0CPROC",133,0)
- D QUERY^C0CXPATH(PROCXML,"//Procedures/Procedure","ZINNER") ;ONE PROC
-"RTN","C0CPROC",134,0)
- N ZTMP,ZVAR,ZI
-"RTN","C0CPROC",135,0)
- S ZI=""
-"RTN","C0CPROC",136,0)
- F  S ZI=$O(@C0CPRC@("V",ZI)) Q:ZI=""  D  ;FOR EACH PROCEDURE
-"RTN","C0CPROC",137,0)
- . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS PROCEDURE XML
-"RTN","C0CPROC",138,0)
- . S ZVAR=$NA(@C0CPRC@("V",ZI)) ;THIS PROCEDURE VARIABLES
-"RTN","C0CPROC",139,0)
- . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
-"RTN","C0CPROC",140,0)
- . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
-"RTN","C0CPROC",141,0)
- D QUEUE^C0CXPATH(ZBLD,PROCXML,@PROCXML@(0),@PROCXML@(0))
 "RTN","C0CPROC",142,0)
- N ZZTMP
-"RTN","C0CPROC",143,0)
- D BUILD^C0CXPATH(ZBLD,PROCOUT) ;BUILD FINAL XML
-"RTN","C0CPROC",144,0)
- K @ZTEMP,@ZBLD,@C0CPRC
-"RTN","C0CPROC",145,0)
- Q
-"RTN","C0CPROC",146,0)
  ;  
 "RTN","C0CPXRM")
-0^92^B14904056
+0^92^B4357
 "RTN","C0CPXRM",1,0)
 C0CPXRM ; 
 "RTN","C0CPXRM",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CPXRM",3,0)
 DOIT ;
 "RTN","C0CPXRM",4,0)
- S G="PXRMXSEPCLINIC3110302.224804" ZWR ^XTMP(G,*)
+ ; S G="PXRMXSEPCLINIC3110302.224804" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",5,0)
- S G="PXRMXSEPCLINIC3110302.223957" ZWR ^XTMP(G,*)
+ ; S G="PXRMXSEPCLINIC3110302.223957" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",6,0)
- S G="PXRMXSEPCLINIC3110302.223738" ZWR ^XTMP(G,*)
+ ; S G="PXRMXSEPCLINIC3110302.223738" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",7,0)
- S G="PXRMXSEPCLINIC3110302.223516" ZWR ^XTMP(G,*)
+ ; S G="PXRMXSEPCLINIC3110302.223516" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",8,0)
- S G="PXRMXSEPCLINIC3110302.222158" ZWR ^XTMP(G,*)
+ ; S G="PXRMXSEPCLINIC3110302.222158" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",9,0)
- S G="PXRMXSEPCLINIC3110302.213944" ZWR ^XTMP(G,*)
+ ; S G="PXRMXSEPCLINIC3110302.213944" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",10,0)
- S G="PXRMXSEPCLINIC3110302.212219" ZWR ^XTMP(G,*)
+ ; S G="PXRMXSEPCLINIC3110302.212219" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",11,0)
- S G="PXRMXSEPCLINIC3110302.211506" ZWR ^XTMP(G,*)
+ ; S G="PXRMXSEPCLINIC3110302.211506" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",12,0)
- S G="PXRMXSEPCLINIC3110302.002714" ZWR ^XTMP(G,*)
+ ; S G="PXRMXSEPCLINIC3110302.002714" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",13,0)
- S G="PXRMXSEPCLINIC3110302.001841" ZWR ^XTMP(G,*)
+ ; S G="PXRMXSEPCLINIC3110302.001841" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",14,0)
- S G="PXRMXSEPCLINIC3110302.000846" ZWR ^XTMP(G,*)
+ ; S G="PXRMXSEPCLINIC3110302.000846" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",15,0)
- S G="PXRMXSEPCLINIC3110115.141918" ZWR ^XTMP(G,*)
+ ; S G="PXRMXSEPCLINIC3110115.141918" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",16,0)
- S G="PXRMXSEPCLINIC3110115.132312" ZWR ^XTMP(G,*)
+ ; S G="PXRMXSEPCLINIC3110115.132312" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",17,0)
- S G="PXRMXSEPCLINIC3110115.131653" ZWR ^XTMP(G,*)
+ ; S G="PXRMXSEPCLINIC3110115.131653" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",18,0)
- S G="PXRMXSEPCLINIC3110115.131008" ZWR ^XTMP(G,*)
+ ; S G="PXRMXSEPCLINIC3110115.131008" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",19,0)
- S G="PXRM PXK EVENT988 3110224.210456" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT988 3110224.210456" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",20,0)
- S G="PXRM PXK EVENT986 3110224.210456" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT986 3110224.210456" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",21,0)
- S G="PXRM PXK EVENT932 3110224.210456" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT932 3110224.210456" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",22,0)
- S G="PXRM PXK EVENT932 3110224.210455" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT932 3110224.210455" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",23,0)
- S G="PXRM PXK EVENT8015 3110301.215142" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT8015 3110301.215142" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",24,0)
- S G="PXRM PXK EVENT8015 3110301.215141" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT8015 3110301.215141" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",25,0)
- S G="PXRM PXK EVENT5265 3110309.124047" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT5265 3110309.124047" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",26,0)
- S G="PXRM PXK EVENT5265 3110309.124046" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT5265 3110309.124046" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",27,0)
- S G="PXRM PXK EVENT4742 3101129.221201" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT4742 3101129.221201" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",28,0)
- S G="PXRM PXK EVENT4742 3101129.215741" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT4742 3101129.215741" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",29,0)
- S G="PXRM PXK EVENT4710 3101129.215701" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT4710 3101129.215701" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",30,0)
- S G="PXRM PXK EVENT3297 3101127.123134" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT3297 3101127.123134" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",31,0)
- S G="PXRM PXK EVENT32495 3110224.194246" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT32495 3110224.194246" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",32,0)
- S G="PXRM PXK EVENT32493 3110224.194246" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT32493 3110224.194246" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",33,0)
- S G="PXRM PXK EVENT32354 3110224.194246" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT32354 3110224.194246" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",34,0)
- S G="PXRM PXK EVENT32354 3110224.194245" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT32354 3110224.194245" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",35,0)
- S G="PXRM PXK EVENT31106 3110224.175105" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT31106 3110224.175105" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",36,0)
- S G="PXRM PXK EVENT31090 3110224.175105" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT31090 3110224.175105" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",37,0)
- S G="PXRM PXK EVENT30339 3110224.175105" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT30339 3110224.175105" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",38,0)
- S G="PXRM PXK EVENT30339 3110224.175103" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT30339 3110224.175103" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",39,0)
- S G="PXRM PXK EVENT2761 3110115.174109" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT2761 3110115.174109" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",40,0)
- S G="PXRM PXK EVENT2761 3110115.174108" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT2761 3110115.174108" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",41,0)
- S G="PXRM PXK EVENT27327 3110227.013658" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT27327 3110227.013658" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",42,0)
- S G="PXRM PXK EVENT27327 3110227.013657" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT27327 3110227.013657" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",43,0)
- S G="PXRM PXK EVENT27327 3110227.013523" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT27327 3110227.013523" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",44,0)
- S G="PXRM PXK EVENT27327 3110227.013522" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT27327 3110227.013522" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",45,0)
- S G="PXRM PXK EVENT27253 3110227.012747" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT27253 3110227.012747" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",46,0)
- S G="PXRM PXK EVENT27253 3110227.012746" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT27253 3110227.012746" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",47,0)
- S G="PXRM PXK EVENT2559 3110115.170835" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT2559 3110115.170835" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",48,0)
- S G="PXRM PXK EVENT25549 3110228.231135" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT25549 3110228.231135" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",49,0)
- S G="PXRM PXK EVENT25549 3110228.231134" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT25549 3110228.231134" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",50,0)
- S G="PXRM PXK EVENT2205 3101129.215343" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT2205 3101129.215343" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",51,0)
- S G="PXRM PXK EVENT21092 3110114.195621" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT21092 3110114.195621" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",52,0)
- S G="PXRM PXK EVENT21092 3110114.193803" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT21092 3110114.193803" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",53,0)
- S G="PXRM PXK EVENT19640 3110226.032943" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT19640 3110226.032943" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",54,0)
- S G="PXRM PXK EVENT19640 3110226.032941" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT19640 3110226.032941" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",55,0)
- S G="PXRM PXK EVENT19353 3101212.162833" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT19353 3101212.162833" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",56,0)
- S G="PXRM PXK EVENT18780 3110221.215603" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT18780 3110221.215603" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",57,0)
- S G="PXRM PXK EVENT18156 3101212.152654" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT18156 3101212.152654" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",58,0)
- S G="PXRM PXK EVENT17800 3110315.202432" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT17800 3110315.202432" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",59,0)
- S G="PXRM PXK EVENT1650 3110220.192925" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT1650 3110220.192925" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",60,0)
- S G="PXRM PXK EVENT16110 3110313.224636" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT16110 3110313.224636" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",61,0)
- S G="PXRM PXK EVENT16004 3110317.151215" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT16004 3110317.151215" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",62,0)
- S G="PXRM PXK EVENT16004 3110317.150834" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT16004 3110317.150834" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",63,0)
- S G="PXRM PXK EVENT14955 3110315.165018" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT14955 3110315.165018" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",64,0)
- S G="PXRM PXK EVENT14816 3110315.164839" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT14816 3110315.164839" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",65,0)
- S G="PXRM PXK EVENT14816 3110315.164512" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT14816 3110315.164512" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",66,0)
- S G="PXRM PXK EVENT12415 3110315.135514" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT12415 3110315.135514" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",67,0)
- S G="PXRM PXK EVENT11797 3110315.131141" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT11797 3110315.131141" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",68,0)
- S G="PXRM PXK EVENT11573 3110315.131811" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT11573 3110315.131811" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",69,0)
- S G="PXRM PXK EVENT10728 3110114.025022" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT10728 3110114.025022" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",70,0)
- S G="PXRM PXK EVENT10578 3110114.021524" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT10578 3110114.021524" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",71,0)
- S G="PXRM PXK EVENT10243 3110114.020338" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT10243 3110114.020338" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",72,0)
- S G="PXRM PXK EVENT10105 3101204.230554" ZWR ^XTMP(G,*)
+ ; S G="PXRM PXK EVENT10105 3101204.230554" ZWR ^XTMP(G,*)
 "RTN","C0CPXRM",73,0)
- Q
+ ; Q
 "RTN","C0CPXRM",74,0)
  ;
@@ -114700,5 +114706,5 @@
 LA7QRY1 ;DALOI/JMC - Lab HL7 Query Utility ;01/19/99  13:48
 "RTN","C0CQRY1",2,0)
-        ;;1.2;C0C;;May 11, 2012;Build 50
+        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CQRY1",3,0)
         ;
@@ -114944,9 +114950,9 @@
         Q
 "RTN","C0CQRY2")
-0^94^B20465060
+0^94^B23443412
 "RTN","C0CQRY2",1,0)
-LA7QRY2 ;DALOI/JMC - Lab HL7 Query Utility ; 04/13/09
+LA7QRY2 ;DALOI/JMC - Lab HL7 Query Utility ; 04/13/09 ; 10/30/12 10:16am
 "RTN","C0CQRY2",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CQRY2",3,0)
  ; JMC - mods to check for IHS V LAB file
@@ -114954,9625 +114960,9781 @@
  ;
 "RTN","C0CQRY2",5,0)
+ ; (C) John McCormack 2009
+"RTN","C0CQRY2",6,0)
+ ;
+"RTN","C0CQRY2",7,0)
+ ; This program is free software: you can redistribute it and/or modify
+"RTN","C0CQRY2",8,0)
+ ; it under the terms of the GNU Affero General Public License as
+"RTN","C0CQRY2",9,0)
+ ; published by the Free Software Foundation, either version 3 of the
+"RTN","C0CQRY2",10,0)
+ ; License, or (at your option) any later version.
+"RTN","C0CQRY2",11,0)
+ ;
+"RTN","C0CQRY2",12,0)
+ ; This program is distributed in the hope that it will be useful,
+"RTN","C0CQRY2",13,0)
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","C0CQRY2",14,0)
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","C0CQRY2",15,0)
+ ; GNU Affero General Public License for more details.
+"RTN","C0CQRY2",16,0)
+ ;
+"RTN","C0CQRY2",17,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CQRY2",18,0)
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+"RTN","C0CQRY2",19,0)
+ ;
+"RTN","C0CQRY2",20,0)
+ ;
+"RTN","C0CQRY2",21,0)
  Q
-"RTN","C0CQRY2",6,0)
- ;
-"RTN","C0CQRY2",7,0)
+"RTN","C0CQRY2",22,0)
+ ;
+"RTN","C0CQRY2",23,0)
 PATID ; Resolve patient id and establish patient environment
-"RTN","C0CQRY2",8,0)
- ;
-"RTN","C0CQRY2",9,0)
+"RTN","C0CQRY2",24,0)
+ ;
+"RTN","C0CQRY2",25,0)
  N LA7X
-"RTN","C0CQRY2",10,0)
- ;
-"RTN","C0CQRY2",11,0)
+"RTN","C0CQRY2",26,0)
+ ;
+"RTN","C0CQRY2",27,0)
  S (DFN,LRDFN)="",LA7PTYP=0
-"RTN","C0CQRY2",12,0)
- ;
-"RTN","C0CQRY2",13,0)
+"RTN","C0CQRY2",28,0)
+ ;
+"RTN","C0CQRY2",29,0)
  ; SSN passed as patient identifier
-"RTN","C0CQRY2",14,0)
+"RTN","C0CQRY2",30,0)
  I LA7PTID?9N.1A D
-"RTN","C0CQRY2",15,0)
+"RTN","C0CQRY2",31,0)
  . S LA7PTYP=1
-"RTN","C0CQRY2",16,0)
+"RTN","C0CQRY2",32,0)
  . S LA7X=$O(^DPT("SSN",LA7PTID,0))
-"RTN","C0CQRY2",17,0)
+"RTN","C0CQRY2",33,0)
  . I LA7X>0 D SETDFN(LA7X)
-"RTN","C0CQRY2",18,0)
- ;
-"RTN","C0CQRY2",19,0)
+"RTN","C0CQRY2",34,0)
+ ;
+"RTN","C0CQRY2",35,0)
  ; MPI/ICN (integration control number) passed as patient identifier
-"RTN","C0CQRY2",20,0)
+"RTN","C0CQRY2",36,0)
  I LA7PTID?10N1"V"6N D
-"RTN","C0CQRY2",21,0)
+"RTN","C0CQRY2",37,0)
  . S LA7PTYP=2
-"RTN","C0CQRY2",22,0)
+"RTN","C0CQRY2",38,0)
  . S LA7X=$$GETDFN^MPIF001($P(LA7PTID,"V"))
-"RTN","C0CQRY2",23,0)
+"RTN","C0CQRY2",39,0)
  . I LA7X>0 D SETDFN(LA7X)
-"RTN","C0CQRY2",24,0)
- ;
-"RTN","C0CQRY2",25,0)
+"RTN","C0CQRY2",40,0)
+ ;
+"RTN","C0CQRY2",41,0)
  ; If no patient identified/no laboratory record - return exception message
-"RTN","C0CQRY2",26,0)
+"RTN","C0CQRY2",42,0)
  I 'LA7PTYP S LA7ERR(1)="Invalid patient identifier passed"
-"RTN","C0CQRY2",27,0)
+"RTN","C0CQRY2",43,0)
  I 'DFN S LA7ERR(2)="No patient found with requested identifier"
-"RTN","C0CQRY2",28,0)
+"RTN","C0CQRY2",44,0)
  I DFN,'LRDFN S LA7ERR(3)="No laboratory record for requested patient"
-"RTN","C0CQRY2",29,0)
+"RTN","C0CQRY2",45,0)
  I LRDFN,'$D(^LR(LRDFN)) S LA7ERR(4)="Database error - missing laboratory record for requested patient"
-"RTN","C0CQRY2",30,0)
+"RTN","C0CQRY2",46,0)
  Q
-"RTN","C0CQRY2",31,0)
- ;
-"RTN","C0CQRY2",32,0)
- ;
-"RTN","C0CQRY2",33,0)
+"RTN","C0CQRY2",47,0)
+ ;
+"RTN","C0CQRY2",48,0)
+ ;
+"RTN","C0CQRY2",49,0)
 BCD ; Search by specimen collection date.
-"RTN","C0CQRY2",34,0)
- ;
-"RTN","C0CQRY2",35,0)
+"RTN","C0CQRY2",50,0)
+ ;
+"RTN","C0CQRY2",51,0)
  N LA763,LA7QUIT
-"RTN","C0CQRY2",36,0)
- ;
-"RTN","C0CQRY2",37,0)
+"RTN","C0CQRY2",52,0)
+ ;
+"RTN","C0CQRY2",53,0)
  S (LA7SDT(0),LA7EDT(0))=0
-"RTN","C0CQRY2",38,0)
+"RTN","C0CQRY2",54,0)
  I LA7SDT S LA7SDT(0)=9999999-LA7SDT
-"RTN","C0CQRY2",39,0)
+"RTN","C0CQRY2",55,0)
  I LA7EDT S LA7EDT(0)=9999999-LA7EDT
-"RTN","C0CQRY2",40,0)
- ;
-"RTN","C0CQRY2",41,0)
+"RTN","C0CQRY2",56,0)
+ ;
+"RTN","C0CQRY2",57,0)
  F LRSS="CH","MI","SP" D
-"RTN","C0CQRY2",42,0)
+"RTN","C0CQRY2",58,0)
  . S (LA7QUIT,LRIDT)=0
-"RTN","C0CQRY2",43,0)
+"RTN","C0CQRY2",59,0)
  . I LA7EDT(0) S LRIDT=$O(^LR(LRDFN,LRSS,LA7EDT(0)),-1)
-"RTN","C0CQRY2",44,0)
+"RTN","C0CQRY2",60,0)
  . F  S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) Q:LA7QUIT  D
-"RTN","C0CQRY2",45,0)
+"RTN","C0CQRY2",61,0)
  . . ; Quit if reached end of data or outside date criteria
-"RTN","C0CQRY2",46,0)
+"RTN","C0CQRY2",62,0)
  . . I 'LRIDT!(LRIDT>LA7SDT(0)) S LA7QUIT=1 Q
-"RTN","C0CQRY2",47,0)
+"RTN","C0CQRY2",63,0)
  . . D SEARCH
-"RTN","C0CQRY2",48,0)
- ;
-"RTN","C0CQRY2",49,0)
+"RTN","C0CQRY2",64,0)
+ ;
+"RTN","C0CQRY2",65,0)
  Q
-"RTN","C0CQRY2",50,0)
- ;
-"RTN","C0CQRY2",51,0)
- ;
-"RTN","C0CQRY2",52,0)
+"RTN","C0CQRY2",66,0)
+ ;
+"RTN","C0CQRY2",67,0)
+ ;
+"RTN","C0CQRY2",68,0)
 BRAD ; Search by results available date (completion date).
-"RTN","C0CQRY2",53,0)
+"RTN","C0CQRY2",69,0)
  ; Assumes cross-references still exist for dates in LRO(69) global.
-"RTN","C0CQRY2",54,0)
+"RTN","C0CQRY2",70,0)
  ; Collects specimen date/time values for a given LRDFN and completion date.
-"RTN","C0CQRY2",55,0)
+"RTN","C0CQRY2",71,0)
  ; Cross-reference is by date only, time stripped from start date.
-"RTN","C0CQRY2",56,0)
+"RTN","C0CQRY2",72,0)
  ; Uses cross-reference ^LRO(69,DT,1,"AN",'LOCATION',LRDFN,LRIDT)=""
-"RTN","C0CQRY2",57,0)
- ;
-"RTN","C0CQRY2",58,0)
+"RTN","C0CQRY2",73,0)
+ ;
+"RTN","C0CQRY2",74,0)
  N LA763,LA7DT,LA7ROOT,LA7SRC,X
-"RTN","C0CQRY2",59,0)
- ;
-"RTN","C0CQRY2",60,0)
+"RTN","C0CQRY2",75,0)
+ ;
+"RTN","C0CQRY2",76,0)
  ; Check if orders still exist Iin file #69 for search range
-"RTN","C0CQRY2",61,0)
+"RTN","C0CQRY2",77,0)
  S LA7SDT(1)=(LA7SDT\1)-.0000000001,LA7EDT(1)=(LA7EDT\1)+.24,LA7SRC=0
-"RTN","C0CQRY2",62,0)
+"RTN","C0CQRY2",78,0)
  S X=$O(^LRO(69,LA7SDT(1)))
-"RTN","C0CQRY2",63,0)
+"RTN","C0CQRY2",79,0)
  I X,X<LA7EDT(1) S LA7SRC=1
-"RTN","C0CQRY2",64,0)
- ;
-"RTN","C0CQRY2",65,0)
+"RTN","C0CQRY2",80,0)
+ ;
+"RTN","C0CQRY2",81,0)
  ; Search "AN" cross-reference in file #69.
-"RTN","C0CQRY2",66,0)
+"RTN","C0CQRY2",82,0)
  I LA7SRC D
-"RTN","C0CQRY2",67,0)
+"RTN","C0CQRY2",83,0)
  . S LA7DT=LA7SDT(1)
-"RTN","C0CQRY2",68,0)
+"RTN","C0CQRY2",84,0)
  . F  S LA7DT=$O(^LRO(69,LA7DT)) Q:'LA7DT!(LA7DT>LA7EDT(1))  D
-"RTN","C0CQRY2",69,0)
+"RTN","C0CQRY2",85,0)
  . . S LA7ROOT="^LRO(69,LA7DT,1,""AN"")"
-"RTN","C0CQRY2",70,0)
+"RTN","C0CQRY2",86,0)
  . . F  S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT=""!($QS(LA7ROOT,2)'=LA7DT)!($QS(LA7ROOT,4)'="AN")  D
-"RTN","C0CQRY2",71,0)
+"RTN","C0CQRY2",87,0)
  . . . I $QS(LA7ROOT,6)'=LRDFN Q
-"RTN","C0CQRY2",72,0)
+"RTN","C0CQRY2",88,0)
  . . . S LRIDT=$QS(LA7ROOT,7)
-"RTN","C0CQRY2",73,0)
+"RTN","C0CQRY2",89,0)
  . . . F LRSS="CH","MI","SP" D SEARCH
-"RTN","C0CQRY2",74,0)
- ;
-"RTN","C0CQRY2",75,0)
+"RTN","C0CQRY2",90,0)
+ ;
+"RTN","C0CQRY2",91,0)
  ; If no orders in #69 then do long search through file #63.
-"RTN","C0CQRY2",76,0)
+"RTN","C0CQRY2",92,0)
  I 'LA7SRC D
-"RTN","C0CQRY2",77,0)
+"RTN","C0CQRY2",93,0)
  . F LRSS="CH","MI","SP" D
-"RTN","C0CQRY2",78,0)
+"RTN","C0CQRY2",94,0)
  . . S LRIDT=0
-"RTN","C0CQRY2",79,0)
+"RTN","C0CQRY2",95,0)
  . . F  S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) Q:'LRIDT  D
-"RTN","C0CQRY2",80,0)
+"RTN","C0CQRY2",96,0)
  . . . S LA763(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
-"RTN","C0CQRY2",81,0)
+"RTN","C0CQRY2",97,0)
  . . . I $P(LA763(0),"^",3)>LA7SDT(1),$P(LA763(0),"^",3)<LA7EDT(1) D SEARCH
-"RTN","C0CQRY2",82,0)
- ;
-"RTN","C0CQRY2",83,0)
+"RTN","C0CQRY2",98,0)
+ ;
+"RTN","C0CQRY2",99,0)
  Q
-"RTN","C0CQRY2",84,0)
- ;
-"RTN","C0CQRY2",85,0)
- ;
-"RTN","C0CQRY2",86,0)
+"RTN","C0CQRY2",100,0)
+ ;
+"RTN","C0CQRY2",101,0)
+ ;
+"RTN","C0CQRY2",102,0)
 SEARCH ; Search subscript for a specific collection date/time
-"RTN","C0CQRY2",87,0)
- ;
-"RTN","C0CQRY2",88,0)
+"RTN","C0CQRY2",103,0)
+ ;
+"RTN","C0CQRY2",104,0)
  K LA763
-"RTN","C0CQRY2",89,0)
+"RTN","C0CQRY2",105,0)
  S LA763(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
-"RTN","C0CQRY2",90,0)
- ;
-"RTN","C0CQRY2",91,0)
+"RTN","C0CQRY2",106,0)
+ ;
+"RTN","C0CQRY2",107,0)
  ; Only CH, MI, and BB subscripts store pointer to file #61 in 5th piece of zeroth node.
-"RTN","C0CQRY2",92,0)
+"RTN","C0CQRY2",108,0)
  ; Quit if specific specimen codes and they do not match
-"RTN","C0CQRY2",93,0)
+"RTN","C0CQRY2",109,0)
  I "CHMIBB"[LRSS S LA761=+$P(LA763(0),"^",5)
-"RTN","C0CQRY2",94,0)
+"RTN","C0CQRY2",110,0)
  E  S LA761=0
-"RTN","C0CQRY2",95,0)
+"RTN","C0CQRY2",111,0)
  I LA761,$D(^TMP("LA7-61",$J)),'$D(^TMP("LA7-61",$J,LA761)) Q
-"RTN","C0CQRY2",96,0)
- ;
-"RTN","C0CQRY2",97,0)
+"RTN","C0CQRY2",112,0)
+ ;
+"RTN","C0CQRY2",113,0)
  ; --- Chemistry
-"RTN","C0CQRY2",98,0)
+"RTN","C0CQRY2",114,0)
  I LRSS="CH" D CHSS Q
-"RTN","C0CQRY2",99,0)
+"RTN","C0CQRY2",115,0)
  ; --- Microbiology
-"RTN","C0CQRY2",100,0)
+"RTN","C0CQRY2",116,0)
  I LRSS="MI" D MISS Q
-"RTN","C0CQRY2",101,0)
+"RTN","C0CQRY2",117,0)
  ; --- Surgical pathology
-"RTN","C0CQRY2",102,0)
+"RTN","C0CQRY2",118,0)
  I LRSS="SP" D APSS Q
-"RTN","C0CQRY2",103,0)
+"RTN","C0CQRY2",119,0)
  ; --- Cytology
-"RTN","C0CQRY2",104,0)
+"RTN","C0CQRY2",120,0)
  I LRSS="CY" D APSS Q
-"RTN","C0CQRY2",105,0)
+"RTN","C0CQRY2",121,0)
  ; --- Electron Micrscopsy
-"RTN","C0CQRY2",106,0)
+"RTN","C0CQRY2",122,0)
  I LRSS="EM" D APSS Q
-"RTN","C0CQRY2",107,0)
+"RTN","C0CQRY2",123,0)
  ; --- Autopsy
-"RTN","C0CQRY2",108,0)
+"RTN","C0CQRY2",124,0)
  I LRSS="AU" D APSS Q
-"RTN","C0CQRY2",109,0)
+"RTN","C0CQRY2",125,0)
  ; --- Blood Bank
-"RTN","C0CQRY2",110,0)
+"RTN","C0CQRY2",126,0)
  I LRSS="BB" D BBSS Q
-"RTN","C0CQRY2",111,0)
+"RTN","C0CQRY2",127,0)
  Q
-"RTN","C0CQRY2",112,0)
- ;
-"RTN","C0CQRY2",113,0)
- ;
-"RTN","C0CQRY2",114,0)
+"RTN","C0CQRY2",128,0)
+ ;
+"RTN","C0CQRY2",129,0)
+ ;
+"RTN","C0CQRY2",130,0)
 CHSS ; Search "CH" datanames for matching codes
-"RTN","C0CQRY2",115,0)
- ;
-"RTN","C0CQRY2",116,0)
+"RTN","C0CQRY2",131,0)
+ ;
+"RTN","C0CQRY2",132,0)
  N LA7X,LRSB
-"RTN","C0CQRY2",117,0)
- ;
-"RTN","C0CQRY2",118,0)
+"RTN","C0CQRY2",133,0)
+ ;
+"RTN","C0CQRY2",134,0)
  S LRSB=1
-"RTN","C0CQRY2",119,0)
+"RTN","C0CQRY2",135,0)
  F  S LRSB=$O(^LR(LRDFN,LRSS,LRIDT,LRSB)) Q:'LRSB  D
-"RTN","C0CQRY2",120,0)
+"RTN","C0CQRY2",136,0)
  . S LA7X=$G(^LR(LRDFN,LRSS,LRIDT,LRSB))
-"RTN","C0CQRY2",121,0)
+"RTN","C0CQRY2",137,0)
  . I $D(^AUPNVLAB) D LNCHK^C0CLA7Q ; WV check for IHS.
-"RTN","C0CQRY2",122,0)
+"RTN","C0CQRY2",138,0)
  . S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,$P(LA7X,"^",3),LA761)
-"RTN","C0CQRY2",123,0)
+"RTN","C0CQRY2",139,0)
  . D CHECK
-"RTN","C0CQRY2",124,0)
- ;
-"RTN","C0CQRY2",125,0)
+"RTN","C0CQRY2",140,0)
+ ;
+"RTN","C0CQRY2",141,0)
  Q
-"RTN","C0CQRY2",126,0)
- ;
-"RTN","C0CQRY2",127,0)
- ;
-"RTN","C0CQRY2",128,0)
+"RTN","C0CQRY2",142,0)
+ ;
+"RTN","C0CQRY2",143,0)
+ ;
+"RTN","C0CQRY2",144,0)
 MISS ; Search "MI" subscripts for matching codes
-"RTN","C0CQRY2",129,0)
- ;
-"RTN","C0CQRY2",130,0)
+"RTN","C0CQRY2",145,0)
+ ;
+"RTN","C0CQRY2",146,0)
  N LA7ND,LRSB
-"RTN","C0CQRY2",131,0)
- ;
-"RTN","C0CQRY2",132,0)
+"RTN","C0CQRY2",147,0)
+ ;
+"RTN","C0CQRY2",148,0)
  S LA7ND=0
-"RTN","C0CQRY2",133,0)
+"RTN","C0CQRY2",149,0)
  F LA7ND=1,5,8,11,16 I $D(^LR(LRDFN,LRSS,LRIDT,LA7ND)) D
-"RTN","C0CQRY2",134,0)
+"RTN","C0CQRY2",150,0)
  . S LRSB=$S(LA7ND=1:11,LA7ND=5:14,LA7ND=8:18,LA7ND=11:22,LA7ND=16:33,1:11)
-"RTN","C0CQRY2",135,0)
+"RTN","C0CQRY2",151,0)
  . S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,"",LA761)
-"RTN","C0CQRY2",136,0)
+"RTN","C0CQRY2",152,0)
  . D CHECK
-"RTN","C0CQRY2",137,0)
+"RTN","C0CQRY2",153,0)
  Q
-"RTN","C0CQRY2",138,0)
- ;
-"RTN","C0CQRY2",139,0)
- ;
-"RTN","C0CQRY2",140,0)
+"RTN","C0CQRY2",154,0)
+ ;
+"RTN","C0CQRY2",155,0)
+ ;
+"RTN","C0CQRY2",156,0)
 APSS ; Search AP subscripts for matching codes
-"RTN","C0CQRY2",141,0)
+"RTN","C0CQRY2",157,0)
  ; AP results are currently not coded - use defaults
-"RTN","C0CQRY2",142,0)
- ;
-"RTN","C0CQRY2",143,0)
+"RTN","C0CQRY2",158,0)
+ ;
+"RTN","C0CQRY2",159,0)
  N LA7CODE,LRSB
-"RTN","C0CQRY2",144,0)
- ;
-"RTN","C0CQRY2",145,0)
+"RTN","C0CQRY2",160,0)
+ ;
+"RTN","C0CQRY2",161,0)
  S LRSB=.012
-"RTN","C0CQRY2",146,0)
+"RTN","C0CQRY2",162,0)
  S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,"","")
-"RTN","C0CQRY2",147,0)
+"RTN","C0CQRY2",163,0)
  D CHECK
-"RTN","C0CQRY2",148,0)
- ;
-"RTN","C0CQRY2",149,0)
+"RTN","C0CQRY2",164,0)
+ ;
+"RTN","C0CQRY2",165,0)
  Q
-"RTN","C0CQRY2",150,0)
- ;
-"RTN","C0CQRY2",151,0)
- ;
-"RTN","C0CQRY2",152,0)
+"RTN","C0CQRY2",166,0)
+ ;
+"RTN","C0CQRY2",167,0)
+ ;
+"RTN","C0CQRY2",168,0)
 BBSS ; Search BB subscript for matching codes
-"RTN","C0CQRY2",153,0)
+"RTN","C0CQRY2",169,0)
  ; *** This subscript currently not supported ***
-"RTN","C0CQRY2",154,0)
+"RTN","C0CQRY2",170,0)
  Q
-"RTN","C0CQRY2",155,0)
- ;
-"RTN","C0CQRY2",156,0)
- ;
-"RTN","C0CQRY2",157,0)
+"RTN","C0CQRY2",171,0)
+ ;
+"RTN","C0CQRY2",172,0)
+ ;
+"RTN","C0CQRY2",173,0)
 CHECK ; Check NLT order/result and LOINC codes.
-"RTN","C0CQRY2",158,0)
- ;
-"RTN","C0CQRY2",159,0)
+"RTN","C0CQRY2",174,0)
+ ;
+"RTN","C0CQRY2",175,0)
  N LA7QUIT
-"RTN","C0CQRY2",160,0)
- ;
-"RTN","C0CQRY2",161,0)
+"RTN","C0CQRY2",176,0)
+ ;
+"RTN","C0CQRY2",177,0)
  ; If wildcard then store
-"RTN","C0CQRY2",162,0)
+"RTN","C0CQRY2",178,0)
  ; Otherwise check for specific NLT order/result and LOINC codes
-"RTN","C0CQRY2",163,0)
+"RTN","C0CQRY2",179,0)
  I LA7SC="*" D STORE Q
-"RTN","C0CQRY2",164,0)
+"RTN","C0CQRY2",180,0)
  S LA7QUIT=0
-"RTN","C0CQRY2",165,0)
+"RTN","C0CQRY2",181,0)
  F I=1:1:3 D  Q:LA7QUIT
-"RTN","C0CQRY2",166,0)
+"RTN","C0CQRY2",182,0)
  . ; If no test code then skip
-"RTN","C0CQRY2",167,0)
+"RTN","C0CQRY2",183,0)
  . I '$L($P(LA7CODE,"!",I)) Q
-"RTN","C0CQRY2",168,0)
+"RTN","C0CQRY2",184,0)
  . ; If test code does not match a search code then quit
-"RTN","C0CQRY2",169,0)
+"RTN","C0CQRY2",185,0)
  . I '$D(^TMP($S(I=3:"LA7-LN",1:"LA7-NLT"),$J,$P(LA7CODE,"!",I))) Q
-"RTN","C0CQRY2",170,0)
+"RTN","C0CQRY2",186,0)
  . D STORE S LA7QUIT=1
-"RTN","C0CQRY2",171,0)
- ;
-"RTN","C0CQRY2",172,0)
+"RTN","C0CQRY2",187,0)
+ ;
+"RTN","C0CQRY2",188,0)
  Q
-"RTN","C0CQRY2",173,0)
- ;
-"RTN","C0CQRY2",174,0)
- ;
-"RTN","C0CQRY2",175,0)
+"RTN","C0CQRY2",189,0)
+ ;
+"RTN","C0CQRY2",190,0)
+ ;
+"RTN","C0CQRY2",191,0)
 STORE ; Store entry for building in HL7 message
-"RTN","C0CQRY2",176,0)
- ;
-"RTN","C0CQRY2",177,0)
+"RTN","C0CQRY2",192,0)
+ ;
+"RTN","C0CQRY2",193,0)
  S ^TMP("LA7-QRY",$J,LRDFN,LRIDT,LRSS,LA7CODE,LRSB)=""
-"RTN","C0CQRY2",178,0)
+"RTN","C0CQRY2",194,0)
  Q
-"RTN","C0CQRY2",179,0)
- ;
-"RTN","C0CQRY2",180,0)
- ;
-"RTN","C0CQRY2",181,0)
+"RTN","C0CQRY2",195,0)
+ ;
+"RTN","C0CQRY2",196,0)
+ ;
+"RTN","C0CQRY2",197,0)
 SETDFN(LA7X) ; Setup DFN and other lab variables.
-"RTN","C0CQRY2",182,0)
- ;
-"RTN","C0CQRY2",183,0)
+"RTN","C0CQRY2",198,0)
+ ;
+"RTN","C0CQRY2",199,0)
  S DFN=LA7X,LRDFN=$P($G(^DPT(DFN,"LR")),"^")
-"RTN","C0CQRY2",184,0)
+"RTN","C0CQRY2",200,0)
  Q
 "RTN","C0CRAHL7")
-0^105^B54192731
+0^105^B46426582
 "RTN","C0CRAHL7",1,0)
 C0CRAHL7 ; C0C/ELN - CCR/CCD PROCESSING FOR RAD REPORT ; 25/10/2010
 "RTN","C0CRAHL7",2,0)
-        ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CRAHL7",3,0)
-        ;;
+ ;
 "RTN","C0CRAHL7",4,0)
-        Q
+ ; (C) ELN 2010.
 "RTN","C0CRAHL7",5,0)
-        ;LENGTH OF SEGMENTS COMPROMISED
+ ;
 "RTN","C0CRAHL7",6,0)
-GHL7    ; Loop through ^RADPT with RADFN
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CRAHL7",7,0)
-        ; Get Case Number and Reprot Information
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CRAHL7",8,0)
-        ; Extract RAD Report as HL7 Message
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CRAHL7",9,0)
-        ; HL7 Message Set In Sequence as ^TMP("HLS",$J,SEQ)
+ ; License, or (at your option) any later version.
 "RTN","C0CRAHL7",10,0)
-        ;
+ ;
 "RTN","C0CRAHL7",11,0)
-        D DT^DILF(,$$GET^C0CPARMS("RASTART"),.C0CRASDT)
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CRAHL7",12,0)
-        D DT^DILF(,$$GET^C0CPARMS("RALIMIT"),.C0CRAEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CRAHL7",13,0)
-        S C0CCNT=0
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CRAHL7",14,0)
-        F  S C0CRAEDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT)) Q:C0CRAEDT'>0!(C0CRAEDT>C0CRASDT)  D
+ ; GNU Affero General Public License for more details.
 "RTN","C0CRAHL7",15,0)
-        . S C0CRAIDT=0
+ ;
 "RTN","C0CRAHL7",16,0)
-        . F  S C0CRAIDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT,C0CRAIDT)) Q:C0CRAIDT'>0  D
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CRAHL7",17,0)
-        . . S C0CRANO=0
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CRAHL7",18,0)
-        . . F  S C0CRANO=$O(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO)) Q:C0CRANO'>0  D
+ ;
 "RTN","C0CRAHL7",19,0)
-        . . . S C0CRAXAM(0)=$G(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO,0))
+ ;
 "RTN","C0CRAHL7",20,0)
-        . . . Q:C0CRAXAM(0)=""
+ Q
 "RTN","C0CRAHL7",21,0)
-        . . . S RARPT=+$P(C0CRAXAM(0),"^",17),RACNI=C0CRANO,RADTI=C0CRAIDT
+ ;LENGTH OF SEGMENTS COMPROMISED
 "RTN","C0CRAHL7",22,0)
-        . . . Q:RARPT=""!(RARPT=0)
+GHL7 ; Loop through ^RADPT with RADFN
 "RTN","C0CRAHL7",23,0)
-        . . . ;Quit if no report information present
+ ; Get Case Number and Reprot Information
 "RTN","C0CRAHL7",24,0)
-        . . . D SETHL7
+ ; Extract RAD Report as HL7 Message
 "RTN","C0CRAHL7",25,0)
-        . . . S C0CSBCNT=0
+ ; HL7 Message Set In Sequence as ^TMP("HLS",$J,SEQ)
 "RTN","C0CRAHL7",26,0)
-        . . . F  S C0CSBCNT=$O(HLA("HLS",C0CSBCNT)) Q:C0CSBCNT=""  D
+ ;
 "RTN","C0CRAHL7",27,0)
-        . . . . S ^TMP("HLS",$J,C0CCNT)=$G(HLA("HLS",C0CSBCNT))
+ D DT^DILF(,$$GET^C0CPARMS("RASTART"),.C0CRASDT)
 "RTN","C0CRAHL7",28,0)
-        . . . . S C0CCNT=C0CCNT+1
+ D DT^DILF(,$$GET^C0CPARMS("RALIMIT"),.C0CRAEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
 "RTN","C0CRAHL7",29,0)
-        ;
+ S C0CCNT=0
 "RTN","C0CRAHL7",30,0)
-        K HLA("HLS"),RARPT,C0CSBCNT,C0CRANO,C0CRAIDT,C0CRASDT,C0CRLMT,C0CSTRT
+ F  S C0CRAEDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT)) Q:C0CRAEDT'>0!(C0CRAEDT>C0CRASDT)  D
 "RTN","C0CRAHL7",31,0)
-        K C0CRAXAM,C0CCNT,C0CRAEDT
+ . S C0CRAIDT=0
 "RTN","C0CRAHL7",32,0)
-        Q
+ . F  S C0CRAIDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT,C0CRAIDT)) Q:C0CRAIDT'>0  D
 "RTN","C0CRAHL7",33,0)
-        ;
+ . . S C0CRANO=0
 "RTN","C0CRAHL7",34,0)
-SETHL7  ;SETHL7 SEGMENTS
+ . . F  S C0CRANO=$O(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO)) Q:C0CRANO'>0  D
 "RTN","C0CRAHL7",35,0)
-        N RASET,RACN0
+ . . . S C0CRAXAM(0)=$G(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO,0))
 "RTN","C0CRAHL7",36,0)
-        S RASET=0
+ . . . Q:C0CRAXAM(0)=""
 "RTN","C0CRAHL7",37,0)
-        S RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
+ . . . S RARPT=+$P(C0CRAXAM(0),"^",17),RACNI=C0CRANO,RADTI=C0CRAIDT
 "RTN","C0CRAHL7",38,0)
-        I +$P(RACN0,U,25)=2 D  Q  ; printset
+ . . . Q:RARPT=""!(RARPT=0)
 "RTN","C0CRAHL7",39,0)
-        . ; loop through all cases in set and create message
+ . . . ;Quit if no report information present
 "RTN","C0CRAHL7",40,0)
-        . S RASET=1
+ . . . D SETHL7
 "RTN","C0CRAHL7",41,0)
-        . N RACNI,RAII S RAII=0
+ . . . S C0CSBCNT=0
 "RTN","C0CRAHL7",42,0)
-        . F  S RAII=$O(^RADPT(RADFN,"DT",RADTI,"P",RAII)) Q:RAII'>0  D
+ . . . F  S C0CSBCNT=$O(HLA("HLS",C0CSBCNT)) Q:C0CSBCNT=""  D
 "RTN","C0CRAHL7",43,0)
-        . . Q:$P(^RADPT(RADFN,"DT",RADTI,"P",RAII,0),U,25)'=2
+ . . . . S ^TMP("HLS",$J,C0CCNT)=$G(HLA("HLS",C0CSBCNT))
 "RTN","C0CRAHL7",44,0)
-        . . S RACNI=RAII
+ . . . . S C0CCNT=C0CCNT+1
 "RTN","C0CRAHL7",45,0)
-        . . D NEW
+ ;
 "RTN","C0CRAHL7",46,0)
-NEW     ; new variables
+ K HLA("HLS"),RARPT,C0CSBCNT,C0CRANO,C0CRAIDT,C0CRASDT,C0CRLMT,C0CSTRT
 "RTN","C0CRAHL7",47,0)
-        ;S:$D(ZTQUEUED) ZTREQ="@" ; delete task from task global
+ K C0CRAXAM,C0CCNT,C0CRAEDT
 "RTN","C0CRAHL7",48,0)
-        N DIWF,DIWL,DIWR,RACPT,RACPTNDE,RADTECN,RADTE0,RADTV,RAI,RAN,RAOBR4,RAPRCNDE,RAPROC,RAPROCIT,RAPRV,RARPT0,VADM,VAERR,X,X1,X2,XX2,Y,X0,OBR36,DFN
+ Q
 "RTN","C0CRAHL7",49,0)
-        N EID,HL,INT,HLQ,HLFS,HLECH,RAN K RAVADM
+ ;
 "RTN","C0CRAHL7",50,0)
-        S HLDT=$$NOW^XLFDT(),HLDT1=$$HLDATE^HLFNC(HLDT)
+SETHL7 ;SETHL7 SEGMENTS
 "RTN","C0CRAHL7",51,0)
-        S (HLECH,HL("ECH"))="^~\&"
+ N RASET,RACN0
 "RTN","C0CRAHL7",52,0)
-        S (HLFS,HL("FS"))="|"
+ S RASET=0
 "RTN","C0CRAHL7",53,0)
-        S (HLQ,HL("Q"))=""""
+ S RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
 "RTN","C0CRAHL7",54,0)
-        S DFN=RADFN D DEM^VADPT
+ I +$P(RACN0,U,25)=2 D  Q  ; printset
 "RTN","C0CRAHL7",55,0)
-        I VADM(1)']"" S HLP("ERRTEXT")="Invalid Patient Identifier" G EXIT
+ . ; loop through all cases in set and create message
 "RTN","C0CRAHL7",56,0)
-        S RAN=0
+ . S RASET=1
 "RTN","C0CRAHL7",57,0)
-        S RAVADM(3)=$S($E(+VADM(3),6,7)="00":"",1:+VADM(3))
+ . N RACNI,RAII S RAII=0
 "RTN","C0CRAHL7",58,0)
-        D SETUP,PID,OBR,OBXRPT
+ . F  S RAII=$O(^RADPT(RADFN,"DT",RADTI,"P",RAII)) Q:RAII'>0  D
 "RTN","C0CRAHL7",59,0)
-EXIT    ;EXIT FROM NEW
+ . . Q:$P(^RADPT(RADFN,"DT",RADTI,"P",RAII,0),U,25)'=2
 "RTN","C0CRAHL7",60,0)
-        K HL,HLDT,HLDT1,VADM,VA("PID"),C0COBRFR,RADTI
+ . . S RACNI=RAII
 "RTN","C0CRAHL7",61,0)
-        Q
+ . . D NEW
 "RTN","C0CRAHL7",62,0)
-        ;
+NEW ; new variables
 "RTN","C0CRAHL7",63,0)
-OBR     ;Compile 'OBR' Segment
+ ;S:$D(ZTQUEUED) ZTREQ="@" ; delete task from task global
 "RTN","C0CRAHL7",64,0)
-                S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$P(RACPTNDE,U,2)_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP"
+ N DIWF,DIWL,DIWR,RACPT,RACPTNDE,RADTECN,RADTE0,RADTV,RAI,RAN,RAOBR4,RAPRCNDE,RAPROC,RAPROCIT,RAPRV,RARPT0,VADM,VAERR,X,X1,X2,XX2,Y,X0,OBR36,DFN
 "RTN","C0CRAHL7",65,0)
-        S C0COBRFR=$P(RACPTNDE,U)_$E(HLECH)_"RAD Procedure"_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP"
+ N EID,HL,INT,HLQ,HLFS,HLECH,RAN K RAVADM
 "RTN","C0CRAHL7",66,0)
-        ; Replace above with following when Imaging can cope with ESC chars
+ S HLDT=$$NOW^XLFDT(),HLDT1=$$HLDATE^HLFNC(HLDT)
 "RTN","C0CRAHL7",67,0)
-        ; S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$$ESCAPE^RAHLRU($P(RACPTNDE,U,2))_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$$ESCAPE^RAHLRU($P(RAPRCNDE,U))_$E(HLECH)_"99RAP"
+ S (HLECH,HL("ECH"))="^~\&"
 "RTN","C0CRAHL7",68,0)
-        ; Have to use LOCAL code if Broad Procedure - no CPT code
+ S (HLFS,HL("FS"))="|"
 "RTN","C0CRAHL7",69,0)
-        I $P(RAOBR4,$E(HLECH))=""!($P(RAOBR4,$E(HLECH),2)="") S $P(RAOBR4,$E(HLECH),1,3)=$P(RAOBR4,$E(HLECH),4,5)_$E(HLECH)_"LOCAL"
+ S (HLQ,HL("Q"))=""""
 "RTN","C0CRAHL7",70,0)
-        S X1="OBR"_HLFS_HLFS_HLFS_RADTI_"-"_RACNI_$E(HLECH)_RADTECN_$E(HLECH)_"L"_HLFS_C0COBRFR_HLFS_HLFS_HLFS_RADTE0_HLFS_HLQ_HLFS_HLQ_HLFS_HLFS_HLFS_HLFS_HLFS,Y=$$HLDATE^HLFNC($P(RARPT0,"^",6)) S X1=X1_Y_HLFS_HLFS
+ S DFN=RADFN D DEM^VADPT
 "RTN","C0CRAHL7",71,0)
-        S RAPRV=$$GET1^DIQ(200,+$P(RACN0,"^",14),.01)
+ I VADM(1)']"" S HLP("ERRTEXT")="Invalid Patient Identifier" G EXIT
 "RTN","C0CRAHL7",72,0)
-        S Y=$$HLNAME^HLFNC(RAPRV) S X1=X1_$S(Y]"":+$P(RACN0,"^",14)_$E(HLECH)_Y,1:"")
+ S RAN=0
 "RTN","C0CRAHL7",73,0)
-        S $P(X1,HLFS,19)=$S($D(^DIC(42,+$P(RACN0,"^",6),0)):$P(^(0),"^"),$D(^SC(+$P(RACN0,"^",8),0)):$P(^(0),"^"),1:"Unknown")
+ S RAVADM(3)=$S($E(+VADM(3),6,7)="00":"",1:+VADM(3))
 "RTN","C0CRAHL7",74,0)
-        ; PCE 21 -> ien file #79.1~name of img loc~stn #~stn name
+ D SETUP,PID,OBR,OBXRPT
 "RTN","C0CRAHL7",75,0)
-        N RACN00,RA20 S RACN00=$G(^RADPT(RADFN,"DT",RADTI,0))
+EXIT ;EXIT FROM NEW
 "RTN","C0CRAHL7",76,0)
-        S RA20=+$G(^RA(79.1,+$P(RACN00,U,4),0))
+ K HL,HLDT,HLDT1,VADM,VA("PID"),C0COBRFR,RADTI
 "RTN","C0CRAHL7",77,0)
-        S $P(X1,HLFS,21)=$P(RACN00,"^",4)_$E(HLECH)_$P($G(^SC(RA20,0)),"^")_$E(HLECH)_$P(RACN00,"^",3)_$E(HLECH)_$P($G(^DIC(4,$P(RACN00,U,3),0)),"^")
+ Q
 "RTN","C0CRAHL7",78,0)
-        S $P(X1,HLFS,21)=$P(X1,HLFS,21)
+ ;
 "RTN","C0CRAHL7",79,0)
-        ; Replace above with following when Imaging can cope with ESC chars
+OBR ;Compile 'OBR' Segment
 "RTN","C0CRAHL7",80,0)
-        ; S $P(X1,HLFS,21)=$$ESCAPE^RAHLRU($P(X1,HLFS,21))
+ S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$P(RACPTNDE,U,2)_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP"
 "RTN","C0CRAHL7",81,0)
-        ;
+ S C0COBRFR=$P(RACPTNDE,U)_$E(HLECH)_"RAD Procedure"_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP"
 "RTN","C0CRAHL7",82,0)
-        S OBR36=9999999.9999-RADTI
+ ; Replace above with following when Imaging can cope with ESC chars
 "RTN","C0CRAHL7",83,0)
-        S $P(X1,HLFS,37)=$$FMTHL7^XLFDT(OBR36)
+ ; S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$$ESCAPE^RAHLRU($P(RACPTNDE,U,2))_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$$ESCAPE^RAHLRU($P(RAPRCNDE,U))_$E(HLECH)_"99RAP"
 "RTN","C0CRAHL7",84,0)
-        ;
+ ; Have to use LOCAL code if Broad Procedure - no CPT code
 "RTN","C0CRAHL7",85,0)
-        S RADTV=HLDT1 I $P(RARPT0,"^",5)="V",$P(RARPT0,"^",7) K RADTV S RADTV=$$HLDATE^HLFNC($P(RARPT0,"^",7))
+ I $P(RAOBR4,$E(HLECH))=""!($P(RAOBR4,$E(HLECH),2)="") S $P(RAOBR4,$E(HLECH),1,3)=$P(RAOBR4,$E(HLECH),4,5)_$E(HLECH)_"LOCAL"
 "RTN","C0CRAHL7",86,0)
-        S $P(X1,HLFS,23)=RADTV,$P(X1,HLFS,26)=$S($P(RARPT0,"^",5)="V":"F",1:"R")
+ S X1="OBR"_HLFS_HLFS_HLFS_RADTI_"-"_RACNI_$E(HLECH)_RADTECN_$E(HLECH)_"L"_HLFS_C0COBRFR_HLFS_HLFS_HLFS_RADTE0_HLFS_HLQ_HLFS_HLQ_HLFS_HLFS_HLFS_HLFS_HLFS,Y=$$HLDATE^HLFNC($P(RARPT0,"^",6)) S X1=X1_Y_HLFS_HLFS
 "RTN","C0CRAHL7",87,0)
-        ;Principal Result Interpreter = Verifying Physician
+ S RAPRV=$$GET1^DIQ(200,+$P(RACN0,"^",14),.01)
 "RTN","C0CRAHL7",88,0)
-        S $P(X1,HLFS,33)="" I $P(RARPT0,"^",9) D
+ S Y=$$HLNAME^HLFNC(RAPRV) S X1=X1_$S(Y]"":+$P(RACN0,"^",14)_$E(HLECH)_Y,1:"")
 "RTN","C0CRAHL7",89,0)
-        .S X2=$$GET1^DIQ(200,$P(RARPT0,"^",9),.01) Q:X2']""
+ S $P(X1,HLFS,19)=$S($D(^DIC(42,+$P(RACN0,"^",6),0)):$P(^(0),"^"),$D(^SC(+$P(RACN0,"^",8),0)):$P(^(0),"^"),1:"Unknown")
 "RTN","C0CRAHL7",90,0)
-        .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
+ ; PCE 21 -> ien file #79.1~name of img loc~stn #~stn name
 "RTN","C0CRAHL7",91,0)
-        .S $P(X1,HLFS,33)=$P(RARPT0,"^",9)_$E(HLECH)_Y
+ N RACN00,RA20 S RACN00=$G(^RADPT(RADFN,"DT",RADTI,0))
 "RTN","C0CRAHL7",92,0)
-        ;Assistant Result Interpreter = Primary Interpreting Staff OR Resident
+ S RA20=+$G(^RA(79.1,+$P(RACN00,U,4),0))
 "RTN","C0CRAHL7",93,0)
-        S $P(X1,HLFS,34)="" I $P(RACN0,"^",15) D
+ S $P(X1,HLFS,21)=$P(RACN00,"^",4)_$E(HLECH)_$P($G(^SC(RA20,0)),"^")_$E(HLECH)_$P(RACN00,"^",3)_$E(HLECH)_$P($G(^DIC(4,$P(RACN00,U,3),0)),"^")
 "RTN","C0CRAHL7",94,0)
-        .S X2=$$GET1^DIQ(200,$P(RACN0,"^",15),.01) Q:X2']""
+ S $P(X1,HLFS,21)=$P(X1,HLFS,21)
 "RTN","C0CRAHL7",95,0)
-        .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
+ ; Replace above with following when Imaging can cope with ESC chars
 "RTN","C0CRAHL7",96,0)
-        .S $P(X1,HLFS,34)=$P(RACN0,"^",15)_$E(HLECH)_Y
+ ; S $P(X1,HLFS,21)=$$ESCAPE^RAHLRU($P(X1,HLFS,21))
 "RTN","C0CRAHL7",97,0)
-        I $P(RACN0,"^",12) D
+ ;
 "RTN","C0CRAHL7",98,0)
-        .S X2=$$GET1^DIQ(200,$P(RACN0,"^",12),.01) Q:X2']""
+ S OBR36=9999999.9999-RADTI
 "RTN","C0CRAHL7",99,0)
-        .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
+ S $P(X1,HLFS,37)=$$FMTHL7^XLFDT(OBR36)
 "RTN","C0CRAHL7",100,0)
-        .S $P(X1,HLFS,34)=$P(RACN0,"^",12)_$E(HLECH)_Y
+ ;
 "RTN","C0CRAHL7",101,0)
-        ;Technician = Technologist
+ S RADTV=HLDT1 I $P(RARPT0,"^",5)="V",$P(RARPT0,"^",7) K RADTV S RADTV=$$HLDATE^HLFNC($P(RARPT0,"^",7))
 "RTN","C0CRAHL7",102,0)
-        S $P(X1,HLFS,35)="" I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) D
+ S $P(X1,HLFS,23)=RADTV,$P(X1,HLFS,26)=$S($P(RARPT0,"^",5)="V":"F",1:"R")
 "RTN","C0CRAHL7",103,0)
-        .S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) I X2']"" Q
+ ;Principal Result Interpreter = Verifying Physician
 "RTN","C0CRAHL7",104,0)
-        .S X2=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",X2,0)) I X2']"" Q
+ S $P(X1,HLFS,33)="" I $P(RARPT0,"^",9) D
 "RTN","C0CRAHL7",105,0)
-        .S XX2=$$GET1^DIQ(200,X2,.01) Q:XX2']""
+ .S X2=$$GET1^DIQ(200,$P(RARPT0,"^",9),.01) Q:X2']""
 "RTN","C0CRAHL7",106,0)
-        .S Y=$$HLNAME^HLFNC(XX2) I Y']"" Q
+ .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
 "RTN","C0CRAHL7",107,0)
-        .S $P(X1,HLFS,35)=X2_$E(HLECH)_Y
+ .S $P(X1,HLFS,33)=$P(RARPT0,"^",9)_$E(HLECH)_Y
 "RTN","C0CRAHL7",108,0)
-        ;Transcriptionist
+ ;Assistant Result Interpreter = Primary Interpreting Staff OR Resident
 "RTN","C0CRAHL7",109,0)
-        S $P(X1,HLFS,36)="" I $G(^RARPT(RARPT,"T")) D
+ S $P(X1,HLFS,34)="" I $P(RACN0,"^",15) D
 "RTN","C0CRAHL7",110,0)
-        .S X2=$$GET1^DIQ(200,^RARPT(RARPT,"T"),.01) I X2']"" Q
+ .S X2=$$GET1^DIQ(200,$P(RACN0,"^",15),.01) Q:X2']""
 "RTN","C0CRAHL7",111,0)
-        .S Y=$$HLNAME^HLFNC(X2) I Y']"" Q
+ .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
 "RTN","C0CRAHL7",112,0)
-        .S $P(X1,HLFS,36)=^RARPT(RARPT,"T")_$E(HLECH)_Y
+ .S $P(X1,HLFS,34)=$P(RACN0,"^",15)_$E(HLECH)_Y
 "RTN","C0CRAHL7",113,0)
-        ;
+ I $P(RACN0,"^",12) D
 "RTN","C0CRAHL7",114,0)
-        S RAN=RAN+1
+ .S X2=$$GET1^DIQ(200,$P(RACN0,"^",12),.01) Q:X2']""
 "RTN","C0CRAHL7",115,0)
-        I $D(RAPART) S HLA("HLS",RAN)=$P(RAPART(1),HLFS)_HLFS,HLA("HLS",RAN,1)=$P(RAPART(1),HLFS,2,99)_HLFS,HLA("HLS",RAN,2)=RAPART(2) K RAPART Q
+ .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
 "RTN","C0CRAHL7",116,0)
-        S HLA("HLS",RAN)=X1
+ .S $P(X1,HLFS,34)=$P(RACN0,"^",12)_$E(HLECH)_Y
 "RTN","C0CRAHL7",117,0)
-        Q
+ ;Technician = Technologist
 "RTN","C0CRAHL7",118,0)
+ S $P(X1,HLFS,35)="" I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) D
+"RTN","C0CRAHL7",119,0)
+ .S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) I X2']"" Q
+"RTN","C0CRAHL7",120,0)
+ .S X2=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",X2,0)) I X2']"" Q
+"RTN","C0CRAHL7",121,0)
+ .S XX2=$$GET1^DIQ(200,X2,.01) Q:XX2']""
+"RTN","C0CRAHL7",122,0)
+ .S Y=$$HLNAME^HLFNC(XX2) I Y']"" Q
+"RTN","C0CRAHL7",123,0)
+ .S $P(X1,HLFS,35)=X2_$E(HLECH)_Y
+"RTN","C0CRAHL7",124,0)
+ ;Transcriptionist
+"RTN","C0CRAHL7",125,0)
+ S $P(X1,HLFS,36)="" I $G(^RARPT(RARPT,"T")) D
+"RTN","C0CRAHL7",126,0)
+ .S X2=$$GET1^DIQ(200,^RARPT(RARPT,"T"),.01) I X2']"" Q
+"RTN","C0CRAHL7",127,0)
+ .S Y=$$HLNAME^HLFNC(X2) I Y']"" Q
+"RTN","C0CRAHL7",128,0)
+ .S $P(X1,HLFS,36)=^RARPT(RARPT,"T")_$E(HLECH)_Y
+"RTN","C0CRAHL7",129,0)
+ ;
+"RTN","C0CRAHL7",130,0)
+ S RAN=RAN+1
+"RTN","C0CRAHL7",131,0)
+ I $D(RAPART) S HLA("HLS",RAN)=$P(RAPART(1),HLFS)_HLFS,HLA("HLS",RAN,1)=$P(RAPART(1),HLFS,2,99)_HLFS,HLA("HLS",RAN,2)=RAPART(2) K RAPART Q
+"RTN","C0CRAHL7",132,0)
+ S HLA("HLS",RAN)=X1
+"RTN","C0CRAHL7",133,0)
+ Q
+"RTN","C0CRAHL7",134,0)
 OBXRPT  ;Compile 'OBX' Segment for Radiology Report Text
-"RTN","C0CRAHL7",119,0)
-        N RATX
-"RTN","C0CRAHL7",120,0)
-        I '$O(^RARPT(RARPT,"R",0)) S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_"None Entered" D OBX11^RAHLRU Q
-"RTN","C0CRAHL7",121,0)
-        S RATX="" F RAI=0:0 S RAI=$O(^RARPT(RARPT,"R",RAI)) Q:'RAI  I $D(^(RAI,0)) S RATX=RATX_^(0)
-"RTN","C0CRAHL7",122,0)
-        S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_$G(RATX) D OBX11^RAHLRU
-"RTN","C0CRAHL7",123,0)
-        Q
-"RTN","C0CRAHL7",124,0)
-PID     ;Compile 'PID' Segment
-"RTN","C0CRAHL7",125,0)
-        ;
-"RTN","C0CRAHL7",126,0)
-        S X1="",X1="PID"_HLFS_HLFS_$G(VA("PID"))_HLFS_Y_HLFS_HLFS S X=VADM(1),Y=$$HLNAME^HLFNC(X) S X1=X1_Y_HLFS_HLFS
-"RTN","C0CRAHL7",127,0)
-        S X=RAVADM(3),Y=$$HLDATE^HLFNC(X) S X1=X1_Y_HLFS_$S(VADM(5)]"":$S("MF"[$P(VADM(5),"^"):$P(VADM(5),"^"),1:"O"))  S:$P(VADM(2),"^")]"" $P(X1,HLFS,20)=$P(VADM(2),"^") S RAN=RAN+1,HLA("HLS",RAN)=X1
-"RTN","C0CRAHL7",128,0)
-        Q
-"RTN","C0CRAHL7",129,0)
-SETUP   ; Setup basic examination information
-"RTN","C0CRAHL7",130,0)
-        S:RASET RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
-"RTN","C0CRAHL7",131,0)
-        S RADTE0=9999999.9999-RADTI,RADTECN=$E(RADTE0,4,7)_$E(RADTE0,2,3)_"-"_+RACN0,RARPT0=^RARPT(RARPT,0)
-"RTN","C0CRAHL7",132,0)
-        S RAPROC=+$P(RACN0,U,2),RAPROCIT=+$P($G(^RAMIS(71,RAPROC,0)),U,12),RAPROCIT=$P(^RA(79.2,RAPROCIT,0),U,1)
-"RTN","C0CRAHL7",133,0)
-        S RAPRCNDE=$G(^RAMIS(71,+RAPROC,0)),RACPT=+$P(RAPRCNDE,U,9)
-"RTN","C0CRAHL7",134,0)
-        S RACPTNDE=$$NAMCODE^RACPTMSC(RACPT,DT)
 "RTN","C0CRAHL7",135,0)
-        S Y=$$HLDATE^HLFNC(RADTE0) S RADTE0=$S(Y:Y,1:HLQ),Y=$$M11^HLFNC(RADFN)
+ N RATX
 "RTN","C0CRAHL7",136,0)
-        Q
+ I '$O(^RARPT(RARPT,"R",0)) S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_"None Entered" D OBX11^RAHLRU Q
+"RTN","C0CRAHL7",137,0)
+ S RATX="" F RAI=0:0 S RAI=$O(^RARPT(RARPT,"R",RAI)) Q:'RAI  I $D(^(RAI,0)) S RATX=RATX_^(0)
+"RTN","C0CRAHL7",138,0)
+ S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_$G(RATX) D OBX11^RAHLRU
+"RTN","C0CRAHL7",139,0)
+ Q
+"RTN","C0CRAHL7",140,0)
+PID ;Compile 'PID' Segment
+"RTN","C0CRAHL7",141,0)
+ ;
+"RTN","C0CRAHL7",142,0)
+ S X1="",X1="PID"_HLFS_HLFS_$G(VA("PID"))_HLFS_Y_HLFS_HLFS S X=VADM(1),Y=$$HLNAME^HLFNC(X) S X1=X1_Y_HLFS_HLFS
+"RTN","C0CRAHL7",143,0)
+ S X=RAVADM(3),Y=$$HLDATE^HLFNC(X) S X1=X1_Y_HLFS_$S(VADM(5)]"":$S("MF"[$P(VADM(5),"^"):$P(VADM(5),"^"),1:"O"))  S:$P(VADM(2),"^")]"" $P(X1,HLFS,20)=$P(VADM(2),"^") S RAN=RAN+1,HLA("HLS",RAN)=X1
+"RTN","C0CRAHL7",144,0)
+ Q
+"RTN","C0CRAHL7",145,0)
+SETUP ; Setup basic examination information
+"RTN","C0CRAHL7",146,0)
+ S:RASET RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
+"RTN","C0CRAHL7",147,0)
+ S RADTE0=9999999.9999-RADTI,RADTECN=$E(RADTE0,4,7)_$E(RADTE0,2,3)_"-"_+RACN0,RARPT0=^RARPT(RARPT,0)
+"RTN","C0CRAHL7",148,0)
+ S RAPROC=+$P(RACN0,U,2),RAPROCIT=+$P($G(^RAMIS(71,RAPROC,0)),U,12),RAPROCIT=$P(^RA(79.2,RAPROCIT,0),U,1)
+"RTN","C0CRAHL7",149,0)
+ S RAPRCNDE=$G(^RAMIS(71,+RAPROC,0)),RACPT=+$P(RAPRCNDE,U,9)
+"RTN","C0CRAHL7",150,0)
+ S RACPTNDE=$$NAMCODE^RACPTMSC(RACPT,DT)
+"RTN","C0CRAHL7",151,0)
+ S Y=$$HLDATE^HLFNC(RADTE0) S RADTE0=$S(Y:Y,1:HLQ),Y=$$M11^HLFNC(RADFN)
+"RTN","C0CRAHL7",152,0)
+ Q
 "RTN","C0CRARPT")
-0^106^B68379544
+0^106^B66576750
 "RTN","C0CRARPT",1,0)
-C0CRARPT        ; C0C/ELN - CCR/CCD PROCESSING FOR RAD REPORT ; 19/10/2010
+C0CRARPT ; C0C/ELN - CCR/CCD PROCESSING FOR RAD REPORT ; 19/10/2010
 "RTN","C0CRARPT",2,0)
-        ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CRARPT",3,0)
-MAP(MIXML,DFN,MOXML)    ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
+ ;
 "RTN","C0CRARPT",4,0)
-        ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
+ ; (C) ELN 2010
 "RTN","C0CRARPT",5,0)
-        ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
+ ;
 "RTN","C0CRARPT",6,0)
-        ; MIXML IS THE TEMPLATE TO USE
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CRARPT",7,0)
-        ; MOXML IS THE OUTPUT XML ARRAY
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CRARPT",8,0)
-        ; DFN IS THE PATIENT RECORD NUMBER
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CRARPT",9,0)
-        N C0COXML,C0CO,C0CV,C0CIXML
+ ; License, or (at your option) any later version.
 "RTN","C0CRARPT",10,0)
-        I '$D(MIVAR) S C0CV="" ;DEFAULT
+ ;
 "RTN","C0CRARPT",11,0)
-        E  S C0CV=MIVAR ;PASSED VARIABLE ARRAY
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CRARPT",12,0)
-        I '$D(MIXML) S C0CIXML="" ;DEFAULT
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CRARPT",13,0)
-        E  S C0CIXML=MIXML ;PASSED INPUT XML
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CRARPT",14,0)
-        D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
+ ; GNU Affero General Public License for more details.
 "RTN","C0CRARPT",15,0)
-        I '$D(MOXML) D  Q
+ ;
 "RTN","C0CRARPT",16,0)
-        . S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CRARPT",17,0)
-        . M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CRARPT",18,0)
-        E  D
+ ;
 "RTN","C0CRARPT",19,0)
-        . N C0COOXML
+MAP(MIXML,DFN,MOXML)   ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
 "RTN","C0CRARPT",20,0)
-        . S CCRGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR"))
+ ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
 "RTN","C0CRARPT",21,0)
-        . D QUERY^C0CXPATH(CCRGLO,"//ContinuityOfCareRecord/Body/Results","C0CRSXML")
+ ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
 "RTN","C0CRARPT",22,0)
-        . S C0COCNT=$O(C0CRSXML(""),-1)
+ ; MIXML IS THE TEMPLATE TO USE
 "RTN","C0CRARPT",23,0)
-        . S C0CRES=0
+ ; MOXML IS THE OUTPUT XML ARRAY
 "RTN","C0CRARPT",24,0)
-        . F  S C0CRES=$O(C0COXML(C0CRES)) Q:C0CRES=""  D
+ ; DFN IS THE PATIENT RECORD NUMBER
 "RTN","C0CRARPT",25,0)
-        . . Q:$G(C0COXML(C0CRES))="<Results>"!($G(C0COXML(C0CRES))="</Results>")
+ N C0COXML,C0CO,C0CV,C0CIXML
 "RTN","C0CRARPT",26,0)
-        . . S C0CRSXML(C0COCNT)=$G(C0COXML(C0CRES))
+ I '$D(MIVAR) S C0CV="" ;DEFAULT
 "RTN","C0CRARPT",27,0)
-        . . S C0COCNT=C0COCNT+1
+ E  S C0CV=MIVAR ;PASSED VARIABLE ARRAY
 "RTN","C0CRARPT",28,0)
-        . S C0CRSXML(C0COCNT)="</Results>"
+ I '$D(MIXML) S C0CIXML="" ;DEFAULT
 "RTN","C0CRARPT",29,0)
-        . S C0CRSXML(0)=C0COCNT
+ E  S C0CIXML=MIXML ;PASSED INPUT XML
 "RTN","C0CRARPT",30,0)
-        . D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
+ D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
 "RTN","C0CRARPT",31,0)
-        . D INSERT^C0CXPATH(CCRGLO,"C0CRSXML","//ContinuityOfCareRecord/Body")
+ I '$D(MOXML) D  Q
 "RTN","C0CRARPT",32,0)
-        S C0CO=MOXML,@C0CO@(0)=0
+ . S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
 "RTN","C0CRARPT",33,0)
-        K C0CRSXML,C0COCNT,C0COXML,C0CRES
+ . M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
 "RTN","C0CRARPT",34,0)
-        Q
+ E  D
 "RTN","C0CRARPT",35,0)
-RPCMAP(RTN,DFN,RMIVAR,RMIXML)   ; RPC ENTRY POINT FOR MAPPING RESULTS
+ . N C0COOXML
 "RTN","C0CRARPT",36,0)
-        ; RTN IS PASSED BY REFERENCE
+ . S CCRGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR"))
 "RTN","C0CRARPT",37,0)
-        N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
+ . D QUERY^C0CXPATH(CCRGLO,"//ContinuityOfCareRecord/Body/Results","C0CRSXML")
 "RTN","C0CRARPT",38,0)
-        N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
+ . S C0COCNT=$O(C0CRSXML(""),-1)
 "RTN","C0CRARPT",39,0)
-        I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
+ . S C0CRES=0
 "RTN","C0CRARPT",40,0)
-        I RMIXML="" D  ; INPUT XML NOT PASSED
+ . F  S C0CRES=$O(C0COXML(C0CRES)) Q:C0CRES=""  D
 "RTN","C0CRARPT",41,0)
-        . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
+ . . Q:$G(C0COXML(C0CRES))="<Results>"!($G(C0COXML(C0CRES))="</Results>")
 "RTN","C0CRARPT",42,0)
-        . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
+ . . S C0CRSXML(C0COCNT)=$G(C0COXML(C0CRES))
 "RTN","C0CRARPT",43,0)
-        . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
+ . . S C0COCNT=C0COCNT+1
 "RTN","C0CRARPT",44,0)
-        E  S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
+ . S C0CRSXML(C0COCNT)="</Results>"
 "RTN","C0CRARPT",45,0)
-        I RMIVAR="" D  ; LOCATION OF VARIABLES NOT PASSED
+ . S C0CRSXML(0)=C0COCNT
 "RTN","C0CRARPT",46,0)
-        . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
+ . D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
 "RTN","C0CRARPT",47,0)
-        E  S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
+ . D INSERT^C0CXPATH(CCRGLO,"C0CRSXML","//ContinuityOfCareRecord/Body")
 "RTN","C0CRARPT",48,0)
-        D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
+ S C0CO=MOXML,@C0CO@(0)=0
 "RTN","C0CRARPT",49,0)
-        D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
+ K C0CRSXML,C0COCNT,C0COXML,C0CRES
 "RTN","C0CRARPT",50,0)
-        D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
+ Q
 "RTN","C0CRARPT",51,0)
-        D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT
+RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS
 "RTN","C0CRARPT",52,0)
-        I '$D(@C0CV@(0)) D  Q  ; NO VARS THERE
+ ; RTN IS PASSED BY REFERENCE
 "RTN","C0CRARPT",53,0)
-        . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
+ N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
 "RTN","C0CRARPT",54,0)
-        ; NO RESULTS
+ N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
 "RTN","C0CRARPT",55,0)
-        I @C0CV@(0)=0 S RTN(0)=0 Q
+ I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
 "RTN","C0CRARPT",56,0)
-        S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
+ I RMIXML="" D  ; INPUT XML NOT PASSED
 "RTN","C0CRARPT",57,0)
-        K @RIMVARS
+ . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
 "RTN","C0CRARPT",58,0)
-        M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
+ . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
 "RTN","C0CRARPT",59,0)
-        N C0CI,C0CIN,C0CJ,C0CJE,C0CJS,C0CJN,C0CMAP,C0CTMAP,C0CTMP
+ . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
 "RTN","C0CRARPT",60,0)
-        S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
+ E  S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
 "RTN","C0CRARPT",61,0)
-        N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
+ I RMIVAR="" D  ; LOCATION OF VARIABLES NOT PASSED
 "RTN","C0CRARPT",62,0)
-        N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
+ . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
 "RTN","C0CRARPT",63,0)
-        N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
+ E  S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
 "RTN","C0CRARPT",64,0)
-        ; TO IMPROVE PERFORMANCE
+ D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
 "RTN","C0CRARPT",65,0)
-        D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
+ D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
 "RTN","C0CRARPT",66,0)
-        F C0CI=1:1:C0CIN D  ; LOOP THROUGH VARIABLES
+ D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
 "RTN","C0CRARPT",67,0)
-        . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
+ D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT
 "RTN","C0CRARPT",68,0)
-        . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
+ I '$D(@C0CV@(0)) D  Q  ; NO VARS THERE
 "RTN","C0CRARPT",69,0)
-        . S C0CMAP=$NA(@C0CV@(C0CI)) ;
+ . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
 "RTN","C0CRARPT",70,0)
-        . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
+ ; NO RESULTS
 "RTN","C0CRARPT",71,0)
-        . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
+ I @C0CV@(0)=0 S RTN(0)=0 Q
 "RTN","C0CRARPT",72,0)
-        . I $D(@C0CMAP@("M","TEST",0)) D  ; TESTS EXIST
+ S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
 "RTN","C0CRARPT",73,0)
-        . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
+ K @RIMVARS
 "RTN","C0CRARPT",74,0)
-        . . K C0CTO ; CLEAR OUTPUT VARIABLE
+ M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
 "RTN","C0CRARPT",75,0)
-        . . F C0CJ=1:1:C0CJN D   ;FOR EACH TEST RESULT
+ N C0CI,C0CIN,C0CJ,C0CJE,C0CJS,C0CJN,C0CMAP,C0CTMAP,C0CTMP
 "RTN","C0CRARPT",76,0)
-        . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
+ S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
 "RTN","C0CRARPT",77,0)
-        . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
+ N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
 "RTN","C0CRARPT",78,0)
-        . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
+ N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
 "RTN","C0CRARPT",79,0)
-        . . . D MAP^C0CXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
+ N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
 "RTN","C0CRARPT",80,0)
-        . . . I C0CJ=1 S C0CJS=2 E  S C0CJS=1 ;FIRST TIME,SKIP THE <Test>
+ ; TO IMPROVE PERFORMANCE
 "RTN","C0CRARPT",81,0)
-        . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E  S C0CJE=@C0CTMP@(0) ;</Test>
+ D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
 "RTN","C0CRARPT",82,0)
-        . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
+ F C0CI=1:1:C0CIN D  ; LOOP THROUGH VARIABLES
 "RTN","C0CRARPT",83,0)
-        . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
+ . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
 "RTN","C0CRARPT",84,0)
-        . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
+ . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
 "RTN","C0CRARPT",85,0)
-        D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
+ . S C0CMAP=$NA(@C0CV@(C0CI)) ;
 "RTN","C0CRARPT",86,0)
-        D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML
+ . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
 "RTN","C0CRARPT",87,0)
-        K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
+ . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
 "RTN","C0CRARPT",88,0)
-        Q
+ . I $D(@C0CMAP@("M","TEST",0)) D  ; TESTS EXIST
 "RTN","C0CRARPT",89,0)
-EXTRACT(ILXML,DFN,OLXML)        ; EXTRACT RADIOLOGY REPORTS INTO THE C0CLVAR GLOBAL
+ . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
 "RTN","C0CRARPT",90,0)
-        S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR RADS VARS
+ . . K C0CTO ; CLEAR OUTPUT VARIABLE
 "RTN","C0CRARPT",91,0)
-        S RADFN=DFN
+ . . F C0CJ=1:1:C0CJN D   ;FOR EACH TEST RESULT
 "RTN","C0CRARPT",92,0)
-        D GHL7^C0CRAHL7 ; GET HL7 MESSAGE FOR THIS PATIENT
+ . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
 "RTN","C0CRARPT",93,0)
-        ;ELN K @C0CLB ; CLEAR OUT OLD VARS IF ANY
+ . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
 "RTN","C0CRARPT",94,0)
-        N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG
+ . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
 "RTN","C0CRARPT",95,0)
-        S C0CQT=1 ; SURPRESS LISTING
+ . . . D MAP^C0CXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
 "RTN","C0CRARPT",96,0)
-        D LIST ; EXTRACT THE VARIABLES
+ . . . I C0CJ=1 S C0CJS=2 E  S C0CJS=1 ;FIRST TIME,SKIP THE <Test>
 "RTN","C0CRARPT",97,0)
-        ;S C0CQT=QTSAV ; RESET SILENT FLAG
+ . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E  S C0CJE=@C0CTMP@(0) ;</Test>
 "RTN","C0CRARPT",98,0)
-        K ^TMP("HLS",$J),^TMP("C0CCCR","RATBL") ; KILL HL7 MESSAGE OUTPUT
+ . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
 "RTN","C0CRARPT",99,0)
-        K C0CLB,C0CLB2,C0CLI,C0CLOBX,RADFN
+ . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
 "RTN","C0CRARPT",100,0)
-        I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
+ . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
 "RTN","C0CRARPT",101,0)
-        Q
+ D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
 "RTN","C0CRARPT",102,0)
-LIST    ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
+ D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML
 "RTN","C0CRARPT",103,0)
-        N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CTAB,C0CTYP
+ K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
 "RTN","C0CRARPT",104,0)
-        I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
+ Q
 "RTN","C0CRARPT",105,0)
-        I '$D(C0CQT) S C0CQT=0
+EXTRACT(ILXML,DFN,OLXML) ; EXTRACT RADIOLOGY REPORTS INTO THE C0CLVAR GLOBAL
 "RTN","C0CRARPT",106,0)
-        I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
+ S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR RADS VARS
 "RTN","C0CRARPT",107,0)
-        I '$D(^TMP("C0CCCR","RATBL",0))!($G(^TMP("C0CCCR","RATBL",0))'="V3") D
+ S RADFN=DFN
 "RTN","C0CRARPT",108,0)
-        . D SETTBL^C0CLABS ;INITIALIZE LAB TABLE
+ D GHL7^C0CRAHL7 ; GET HL7 MESSAGE FOR THIS PATIENT
 "RTN","C0CRARPT",109,0)
-        . K ^TMP("C0CCCR","RATBL")
+ ;ELN K @C0CLB ; CLEAR OUT OLD VARS IF ANY
 "RTN","C0CRARPT",110,0)
-        . M ^TMP("C0CCCR","RATBL")=^TMP("C0CCCR","LABTBL")
+ N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG
 "RTN","C0CRARPT",111,0)
-        I '$D(^TMP("HLS",$J,1)) D GHL7^C0CRAHL7 ; GET HL7 MGS IF NOT ALREADY DONE
+ S C0CQT=1 ; SURPRESS LISTING
 "RTN","C0CRARPT",112,0)
-        S C0CTAB=$NA(^TMP("C0CCCR","RATBL")) ; BASE OF OBX TABLE
+ D LIST ; EXTRACT THE VARIABLES
 "RTN","C0CRARPT",113,0)
-        S C0CHB=$NA(^TMP("HLS",$J))
+ ;S C0CQT=QTSAV ; RESET SILENT FLAG
 "RTN","C0CRARPT",114,0)
-        S C0CI=""
+ K ^TMP("HLS",$J),^TMP("C0CCCR","RATBL") ; KILL HL7 MESSAGE OUTPUT
 "RTN","C0CRARPT",115,0)
-        S @C0CLB@(0)=$O(^TMP("C0CCCR",$J,"RESULTS",""),-1) ; INITALIZE RESULTS VARS COUNT
+ K C0CLB,C0CLB2,C0CLI,C0CLOBX,RADFN
 "RTN","C0CRARPT",116,0)
-        F  S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI=""  D  ; FOR ALL RECORDS IN HL7 MSG
+ I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
 "RTN","C0CRARPT",117,0)
-        . K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES
+ Q
 "RTN","C0CRARPT",118,0)
-        . S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
+LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
 "RTN","C0CRARPT",119,0)
-        . D LTYP^C0CLABS(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
+ N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CTAB,C0CTYP
 "RTN","C0CRARPT",120,0)
-        . M XV=C0CVAR ;
+ I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
 "RTN","C0CRARPT",121,0)
-        . I C0CTYP="OBR" D  ; BEGINNING OF NEW SECTION
+ I '$D(C0CQT) S C0CQT=0
 "RTN","C0CRARPT",122,0)
-        . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
+ I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
 "RTN","C0CRARPT",123,0)
-        . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
+ I '$D(^TMP("C0CCCR","RATBL",0))!($G(^TMP("C0CCCR","RATBL",0))'="V3") D
 "RTN","C0CRARPT",124,0)
-        . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
+ . D SETTBL^C0CLABS ;INITIALIZE LAB TABLE
 "RTN","C0CRARPT",125,0)
-        . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
+ . K ^TMP("C0CCCR","RATBL")
 "RTN","C0CRARPT",126,0)
-        . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
+ . M ^TMP("C0CCCR","RATBL")=^TMP("C0CCCR","LABTBL")
 "RTN","C0CRARPT",127,0)
-        . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
+ I '$D(^TMP("HLS",$J,1)) D GHL7^C0CRAHL7 ; GET HL7 MGS IF NOT ALREADY DONE
 "RTN","C0CRARPT",128,0)
-        . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
+ S C0CTAB=$NA(^TMP("C0CCCR","RATBL")) ; BASE OF OBX TABLE
 "RTN","C0CRARPT",129,0)
-        . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
+ S C0CHB=$NA(^TMP("HLS",$J))
 "RTN","C0CRARPT",130,0)
-        . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
+ S C0CI=""
 "RTN","C0CRARPT",131,0)
-        . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
+ S @C0CLB@(0)=$O(^TMP("C0CCCR",$J,"RESULTS",""),-1) ; INITALIZE RESULTS VARS COUNT
 "RTN","C0CRARPT",132,0)
-        . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
+ F  S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI=""  D  ; FOR ALL RECORDS IN HL7 MSG
 "RTN","C0CRARPT",133,0)
-        . I C0CTYP="OBX" D  ; SPECIAL CASE FOR OBX3
+ . K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES
 "RTN","C0CRARPT",134,0)
-        . . ; RESULTTESTCODEVALUE
+ . S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
 "RTN","C0CRARPT",135,0)
-        . . ; RESULTTESTDESCRIPTIONTEXT
+ . D LTYP^C0CLABS(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
 "RTN","C0CRARPT",136,0)
-        . . I C0CVAR("C3")="C4" D  ; PRIMARY CODE "CPT"
+ . M XV=C0CVAR ;
 "RTN","C0CRARPT",137,0)
-        . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE CPT CODE VALUE
+ . I C0CTYP="OBR" D  ; BEGINNING OF NEW SECTION
 "RTN","C0CRARPT",138,0)
-        . . . S XV("RESULTTESTCODINGSYSTEM")="CPT" ; DISPLAY NAME FOR CPT
+ . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
 "RTN","C0CRARPT",139,0)
-        . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT
+ . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
 "RTN","C0CRARPT",140,0)
-        . . E  I C0CVAR("C6")'="" D  ; NO CPT CODES, USE SECONDARY IF PRESENT
+ . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
 "RTN","C0CRARPT",141,0)
-        . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
+ . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
 "RTN","C0CRARPT",142,0)
-        . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
+ . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
 "RTN","C0CRARPT",143,0)
-        . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
+ . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
 "RTN","C0CRARPT",144,0)
-        . . E  D  ; NO SECONDARY, USE PRIMARY
+ . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
 "RTN","C0CRARPT",145,0)
-        . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
+ . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
 "RTN","C0CRARPT",146,0)
-        . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
+ . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
 "RTN","C0CRARPT",147,0)
-        . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
+ . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
 "RTN","C0CRARPT",148,0)
-        . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;
+ . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
 "RTN","C0CRARPT",149,0)
-        . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG
+ . I C0CTYP="OBX" D  ; SPECIAL CASE FOR OBX3
 "RTN","C0CRARPT",150,0)
-        . . S C0CZG=XV("RESULTTESTVALUE")
+ . . ; RESULTTESTCODEVALUE
 "RTN","C0CRARPT",151,0)
-        . . S XV("RESULTTESTVALUE")=C0CZG
+ . . ; RESULTTESTDESCRIPTIONTEXT
 "RTN","C0CRARPT",152,0)
-        . . I C0CLOBX=0 D  ; FIRST TEST RESULT FOR THIS SECTION
+ . . I C0CVAR("C3")="C4" D  ; PRIMARY CODE "CPT"
 "RTN","C0CRARPT",153,0)
-        . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
+ . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE CPT CODE VALUE
 "RTN","C0CRARPT",154,0)
-        . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
+ . . . S XV("RESULTTESTCODINGSYSTEM")="CPT" ; DISPLAY NAME FOR CPT
 "RTN","C0CRARPT",155,0)
-        . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
+ . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT
 "RTN","C0CRARPT",156,0)
-        . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
+ . . E  I C0CVAR("C6")'="" D  ; NO CPT CODES, USE SECONDARY IF PRESENT
 "RTN","C0CRARPT",157,0)
-        . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE
+ . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
 "RTN","C0CRARPT",158,0)
-        . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER
+ . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
 "RTN","C0CRARPT",159,0)
-        . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2
+ . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
 "RTN","C0CRARPT",160,0)
-        . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
+ . . E  D  ; NO SECONDARY, USE PRIMARY
 "RTN","C0CRARPT",161,0)
-        . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT
+ . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
 "RTN","C0CRARPT",162,0)
-        . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
+ . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
 "RTN","C0CRARPT",163,0)
-        . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
+ . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
 "RTN","C0CRARPT",164,0)
-        . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
+ . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;
 "RTN","C0CRARPT",165,0)
-        K XV,C0CZG,C0CX1,C0CX2,C0CVAR
+ . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG
 "RTN","C0CRARPT",166,0)
-        Q
+ . . S C0CZG=XV("RESULTTESTVALUE")
+"RTN","C0CRARPT",167,0)
+ . . S XV("RESULTTESTVALUE")=C0CZG
+"RTN","C0CRARPT",168,0)
+ . . I C0CLOBX=0 D  ; FIRST TEST RESULT FOR THIS SECTION
+"RTN","C0CRARPT",169,0)
+ . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
+"RTN","C0CRARPT",170,0)
+ . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
+"RTN","C0CRARPT",171,0)
+ . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
+"RTN","C0CRARPT",172,0)
+ . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
+"RTN","C0CRARPT",173,0)
+ . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE
+"RTN","C0CRARPT",174,0)
+ . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER
+"RTN","C0CRARPT",175,0)
+ . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2
+"RTN","C0CRARPT",176,0)
+ . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
+"RTN","C0CRARPT",177,0)
+ . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT
+"RTN","C0CRARPT",178,0)
+ . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
+"RTN","C0CRARPT",179,0)
+ . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
+"RTN","C0CRARPT",180,0)
+ . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
+"RTN","C0CRARPT",181,0)
+ K XV,C0CZG,C0CX1,C0CX2,C0CVAR
+"RTN","C0CRARPT",182,0)
+ Q
 "RTN","C0CRIMA")
-0^38^B331901748
+0^38^B328577528
 "RTN","C0CRIMA",1,0)
 C0CRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
 "RTN","C0CRIMA",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CRIMA",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
 "RTN","C0CRIMA",4,0)
- ;Licensed under the terms of the GNU General Public License.
+ ;
 "RTN","C0CRIMA",5,0)
- ;See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CRIMA",6,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CRIMA",7,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CRIMA",8,0)
- ;it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CRIMA",9,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CRIMA",10,0)
- ;(at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CRIMA",11,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CRIMA",12,0)
- ;This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CRIMA",13,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CRIMA",14,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CRIMA",15,0)
- ;GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CRIMA",16,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CRIMA",17,0)
- ;You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CRIMA",18,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ; THESE ROUTINES EXAMINE ONE OR MORE, UP TO ALL, OF THE PATIENTS ON THE
 "RTN","C0CRIMA",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ; SYSTEM TO DETERMINE HOW COMPLETE THE RESULTING CCR OR CCD WOULD BE FOR
 "RTN","C0CRIMA",20,0)
- ;
+ ; THESE PATIENTS. IT BEGINS TO MEASURE "HL7 RIM COHERENCE" WHICH IS HOW USEFUL
 "RTN","C0CRIMA",21,0)
- ; THESE ROUTINES EXAMINE ONE OR MORE, UP TO ALL, OF THE PATIENTS ON THE
+ ; THE VARIABLES WILL BE TO A RIM-MODELED APPLICATION AFTER THEY ARE
 "RTN","C0CRIMA",22,0)
- ; SYSTEM TO DETERMINE HOW COMPLETE THE RESULTING CCR OR CCD WOULD BE FOR
+ ; CONVEYED VIA THE CCR OR CCD.
 "RTN","C0CRIMA",23,0)
- ; THESE PATIENTS. IT BEGINS TO MEASURE "HL7 RIM COHERENCE" WHICH IS HOW USEFUL
+ ; FACTORS THAT AFFECT RIM COHERENCE INCLUDE:
 "RTN","C0CRIMA",24,0)
- ; THE VARIABLES WILL BE TO A RIM-MODELED APPLICATION AFTER THEY ARE
+ ;    1. THE PRESENSE OF CLINICAL DATA IN A SECTION
 "RTN","C0CRIMA",25,0)
- ; CONVEYED VIA THE CCR OR CCD.
+ ;    2. ARE THE DATA ELEMENTS TIME-BOUND
 "RTN","C0CRIMA",26,0)
- ; FACTORS THAT AFFECT RIM COHERENCE INCLUDE:
+ ;    3. ARE THE DATA ELEMENTS CODED WITH SNOMED OR LOINC ETC
 "RTN","C0CRIMA",27,0)
- ;    1. THE PRESENSE OF CLINICAL DATA IN A SECTION
+ ;    4. ARE SOURCE ACTORS ASSOCIATED WITH THE DATA ELEMENTS
 "RTN","C0CRIMA",28,0)
- ;    2. ARE THE DATA ELEMENTS TIME-BOUND
+ ;    5. ARE ACTORS IDENTIFIED REGARDING THEIR ROLE
 "RTN","C0CRIMA",29,0)
- ;    3. ARE THE DATA ELEMENTS CODED WITH SNOMED OR LOINC ETC
+ ;    .. AND OTHER FACTORS YET TO BE DETERMINED
 "RTN","C0CRIMA",30,0)
- ;    4. ARE SOURCE ACTORS ASSOCIATED WITH THE DATA ELEMENTS
+ ;
 "RTN","C0CRIMA",31,0)
- ;    5. ARE ACTORS IDENTIFIED REGARDING THEIR ROLE
+ ;    SINCE THESE MEASUREMENTS ARE DONE AT THE VARIABLE LEVEL, THEY
 "RTN","C0CRIMA",32,0)
- ;    .. AND OTHER FACTORS YET TO BE DETERMINED
+ ;    REFLECT ON RIM COHERENCE WHETHER THE CCR OR THE CCD IS USED FOR
 "RTN","C0CRIMA",33,0)
- ;
+ ;    CONVEYANCE TO THE RIM APPLICATION.
 "RTN","C0CRIMA",34,0)
- ;    SINCE THESE MEASUREMENTS ARE DONE AT THE VARIABLE LEVEL, THEY
+ ;
 "RTN","C0CRIMA",35,0)
- ;    REFLECT ON RIM COHERENCE WHETHER THE CCR OR THE CCD IS USED FOR
+ ;
 "RTN","C0CRIMA",36,0)
- ;    CONVEYANCE TO THE RIM APPLICATION.
+ANALYZE(BEGDFN,DFNCNT,APARMS) ; RIM COHERANCE ANALYSIS ROUTINE
 "RTN","C0CRIMA",37,0)
- ;
+    ; BEGINS AT BEGDFN AND GOES FOR DFNCNT PATIENTS
 "RTN","C0CRIMA",38,0)
- ;
+    ; TO RESUME AT NEXT PATIENT, USE BEGDFN=""
 "RTN","C0CRIMA",39,0)
-ANALYZE(BEGDFN,DFNCNT,APARMS) ; RIM COHERANCE ANALYSIS ROUTINE
+    ; USE RESET^C0CRIMA TO RESET TO TOP OF PATIENT LIST
 "RTN","C0CRIMA",40,0)
-    ; BEGINS AT BEGDFN AND GOES FOR DFNCNT PATIENTS
+    ; APARMS ARE PARAMETERS TO BE USED IN THE EXTRACTION
 "RTN","C0CRIMA",41,0)
-    ; TO RESUME AT NEXT PATIENT, USE BEGDFN=""
+    ; SEE C0CPARMS FOR SUPPORTED PARAMTERS
 "RTN","C0CRIMA",42,0)
-    ; USE RESET^C0CRIMA TO RESET TO TOP OF PATIENT LIST
+    ;
 "RTN","C0CRIMA",43,0)
-    ; APARMS ARE PARAMETERS TO BE USED IN THE EXTRACTION
+    N RIMARY,RIMTMP,RIMI,RIMDFN,RATTR
 "RTN","C0CRIMA",44,0)
-    ; SEE C0CPARMS FOR SUPPORTED PARAMTERS
+    N CCRGLO
 "RTN","C0CRIMA",45,0)
-    ;
+    S C0CCHK=0 ; CHECKSUM FLAG
 "RTN","C0CRIMA",46,0)
-    N RIMARY,RIMTMP,RIMI,RIMDFN,RATTR
+    D ASETUP ; SET UP VARIABLES AND GLOBALS
 "RTN","C0CRIMA",47,0)
-    N CCRGLO
+    D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
 "RTN","C0CRIMA",48,0)
-    S C0CCHK=0 ; CHECKSUM FLAG
+    I '$D(@RIMBASE@("RESUME")) S @RIMBASE@("RESUME")=$O(^DPT(0)) ; FIRST TIME
 "RTN","C0CRIMA",49,0)
-    D ASETUP ; SET UP VARIABLES AND GLOBALS
+    S RESUME=@RIMBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
 "RTN","C0CRIMA",50,0)
-    D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
+    S RIMDFN=BEGDFN ; BEGIN WITH THE BEGDFN PATIENT
 "RTN","C0CRIMA",51,0)
-    I '$D(@RIMBASE@("RESUME")) S @RIMBASE@("RESUME")=$O(^DPT(0)) ; FIRST TIME
+    I RIMDFN="" S RIMDFN=RESUME
 "RTN","C0CRIMA",52,0)
-    S RESUME=@RIMBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
+    I +RIMDFN=0 D  Q  ; AT THE END OF THE PATIENTS
 "RTN","C0CRIMA",53,0)
-    S RIMDFN=BEGDFN ; BEGIN WITH THE BEGDFN PATIENT
+    . W "END OF PATIENT LIST, CALL RESET^C0CRIMA",!
 "RTN","C0CRIMA",54,0)
-    I RIMDFN="" S RIMDFN=RESUME
+    I '$D(APARMS) S APARMS="" ; DEFAULT NO OVERRIDE PARMS
 "RTN","C0CRIMA",55,0)
-    I +RIMDFN=0 D  Q  ; AT THE END OF THE PATIENTS
+    F RIMI=1:1:DFNCNT  D  Q:+RIMDFN=0  ; FOR DFNCNT NUMBER OF PATIENTS OR END
 "RTN","C0CRIMA",56,0)
-    . W "END OF PATIENT LIST, CALL RESET^C0CRIMA",!
+    . K @RIMBASE@("VARS",RIMDFN) ; CLEAR OUT OLD VARS
 "RTN","C0CRIMA",57,0)
-    I '$D(APARMS) S APARMS="" ; DEFAULT NO OVERRIDE PARMS
+    . D CCRRPC^C0CCCR(.CCRGLO,RIMDFN,APARMS,"CCR") ;PROCESS THE CCR
 "RTN","C0CRIMA",58,0)
-    F RIMI=1:1:DFNCNT  D  Q:+RIMDFN=0  ; FOR DFNCNT NUMBER OF PATIENTS OR END
+    . W RIMDFN,!
 "RTN","C0CRIMA",59,0)
-    . K @RIMBASE@("VARS",RIMDFN) ; CLEAR OUT OLD VARS
+    . ;
 "RTN","C0CRIMA",60,0)
-    . D CCRRPC^C0CCCR(.CCRGLO,RIMDFN,APARMS,"CCR") ;PROCESS THE CCR
+    . ; COPY ALL THE VARIABLES TO THE RIM MAP AREA INDEXED BY PATIENT
 "RTN","C0CRIMA",61,0)
-    . W RIMDFN,!
+    . ;
 "RTN","C0CRIMA",62,0)
+    . I $D(^TMP("C0CCCR",$J,"PROBVALS",1)) D  ; PROBLEM VARS EXISTS
+"RTN","C0CRIMA",63,0)
+    . . M @RIMBASE@("VARS",RIMDFN,"PROBLEMS")=^TMP("C0CCCR",$J,"PROBVALS")
+"RTN","C0CRIMA",64,0)
+    . . S @RIMBASE@("VARS",RIMDFN,"PROBLEMS",0)=$O(^TMP("C0CCCR",$J,"PROBVALS",""),-1)
+"RTN","C0CRIMA",65,0)
+    . I $D(^TMP("C0CCCR",$J,"VITALS",1)) D  ; VITALS VARS EXISTS
+"RTN","C0CRIMA",66,0)
+    . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("C0CCCR",$J,"VITALS")
+"RTN","C0CRIMA",67,0)
+    . I $D(^TMP("C0CCCR",$J,"MEDMAP",1)) D  ; MEDS VARS EXISTS
+"RTN","C0CRIMA",68,0)
+    . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("C0CCCR",$J,"MEDMAP")
+"RTN","C0CRIMA",69,0)
+    . I $D(^TMP("C0CCCR",$J,"ALERTS",1,"ALERTOBJECTID")) D  ; ALERTS EXIST
+"RTN","C0CRIMA",70,0)
+    . . W "FOUND ALERT VARS",!
+"RTN","C0CRIMA",71,0)
+    . . M @RIMBASE@("VARS",RIMDFN,"ALERTS")=^TMP("C0CCCR",$J,"ALERTS")
+"RTN","C0CRIMA",72,0)
+    . I $D(^TMP("C0CCCR",$J,"RESULTS",0)) D  ; RESULTS EXIST
+"RTN","C0CRIMA",73,0)
+    . . W "FOUND RESULTS VARS",!
+"RTN","C0CRIMA",74,0)
+    . . M @RIMBASE@("VARS",RIMDFN,"RESULTS")=^TMP("C0CCCR",$J,"RESULTS")
+"RTN","C0CRIMA",75,0)
+    . S C0CCHK=0
+"RTN","C0CRIMA",76,0)
+    . I $$CHKSUM(RIMDFN) D  ; CHECKSUM HAS CHANGED
+"RTN","C0CRIMA",77,0)
+    . . W "CHECKSUM IS NEW OR HAS CHANGED",!
+"RTN","C0CRIMA",78,0)
+    . . ;ZWR ^TMP("C0CRIM","CHKSUM",RIMDFN,*)
+"RTN","C0CRIMA",79,0)
+    . . S C0CCHK=1
+"RTN","C0CRIMA",80,0)
+    . K ^TMP("C0CCCR",$J) ; KILL WORK AREA FOR CCR BUILDING
+"RTN","C0CRIMA",81,0)
     . ;
-"RTN","C0CRIMA",63,0)
-    . ; COPY ALL THE VARIABLES TO THE RIM MAP AREA INDEXED BY PATIENT
-"RTN","C0CRIMA",64,0)
+"RTN","C0CRIMA",82,0)
+    . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
+"RTN","C0CRIMA",83,0)
     . ;
-"RTN","C0CRIMA",65,0)
-    . I $D(^TMP("C0CCCR",$J,"PROBVALS",1)) D  ; PROBLEM VARS EXISTS
-"RTN","C0CRIMA",66,0)
-    . . M @RIMBASE@("VARS",RIMDFN,"PROBLEMS")=^TMP("C0CCCR",$J,"PROBVALS")
-"RTN","C0CRIMA",67,0)
-    . . S @RIMBASE@("VARS",RIMDFN,"PROBLEMS",0)=$O(^TMP("C0CCCR",$J,"PROBVALS",""),-1)
-"RTN","C0CRIMA",68,0)
-    . I $D(^TMP("C0CCCR",$J,"VITALS",1)) D  ; VITALS VARS EXISTS
-"RTN","C0CRIMA",69,0)
-    . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("C0CCCR",$J,"VITALS")
-"RTN","C0CRIMA",70,0)
-    . I $D(^TMP("C0CCCR",$J,"MEDMAP",1)) D  ; MEDS VARS EXISTS
-"RTN","C0CRIMA",71,0)
-    . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("C0CCCR",$J,"MEDMAP")
-"RTN","C0CRIMA",72,0)
-    . I $D(^TMP("C0CCCR",$J,"ALERTS",1,"ALERTOBJECTID")) D  ; ALERTS EXIST
-"RTN","C0CRIMA",73,0)
-    . . W "FOUND ALERT VARS",!
-"RTN","C0CRIMA",74,0)
-    . . M @RIMBASE@("VARS",RIMDFN,"ALERTS")=^TMP("C0CCCR",$J,"ALERTS")
-"RTN","C0CRIMA",75,0)
-    . I $D(^TMP("C0CCCR",$J,"RESULTS",0)) D  ; RESULTS EXIST
-"RTN","C0CRIMA",76,0)
-    . . W "FOUND RESULTS VARS",!
-"RTN","C0CRIMA",77,0)
-    . . M @RIMBASE@("VARS",RIMDFN,"RESULTS")=^TMP("C0CCCR",$J,"RESULTS")
-"RTN","C0CRIMA",78,0)
-    . S C0CCHK=0
-"RTN","C0CRIMA",79,0)
-    . I $$CHKSUM(RIMDFN) D  ; CHECKSUM HAS CHANGED
-"RTN","C0CRIMA",80,0)
-    . . W "CHECKSUM IS NEW OR HAS CHANGED",!
-"RTN","C0CRIMA",81,0)
-    . . ;ZWR ^TMP("C0CRIM","CHKSUM",RIMDFN,*)
-"RTN","C0CRIMA",82,0)
-    . . S C0CCHK=1
-"RTN","C0CRIMA",83,0)
-    . K ^TMP("C0CCCR",$J) ; KILL WORK AREA FOR CCR BUILDING
 "RTN","C0CRIMA",84,0)
-    . ;
+    . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
 "RTN","C0CRIMA",85,0)
-    . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
+    . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT
 "RTN","C0CRIMA",86,0)
     . ;
 "RTN","C0CRIMA",87,0)
-    . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
+    . ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL
 "RTN","C0CRIMA",88,0)
-    . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT
+    . ;
 "RTN","C0CRIMA",89,0)
+    . ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D  ; IF FIRST PAT WITH THESE ATTRS
+"RTN","C0CRIMA",90,0)
+    . ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED
+"RTN","C0CRIMA",91,0)
+    . ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT
+"RTN","C0CRIMA",92,0)
     . ;
-"RTN","C0CRIMA",90,0)
-    . ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL
-"RTN","C0CRIMA",91,0)
+"RTN","C0CRIMA",93,0)
+    . N CATNAME,CATTBL
+"RTN","C0CRIMA",94,0)
+    . ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))
+"RTN","C0CRIMA",95,0)
+    . S CATNAME=""
+"RTN","C0CRIMA",96,0)
+    . D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
+"RTN","C0CRIMA",97,0)
+    . W "CATEGORY NAME: ",CATNAME,!
+"RTN","C0CRIMA",98,0)
     . ;
-"RTN","C0CRIMA",92,0)
-    . ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D  ; IF FIRST PAT WITH THESE ATTRS
-"RTN","C0CRIMA",93,0)
-    . ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED
-"RTN","C0CRIMA",94,0)
-    . ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT
-"RTN","C0CRIMA",95,0)
-    . ;
-"RTN","C0CRIMA",96,0)
-    . N CATNAME,CATTBL
-"RTN","C0CRIMA",97,0)
-    . ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))
-"RTN","C0CRIMA",98,0)
-    . S CATNAME=""
 "RTN","C0CRIMA",99,0)
-    . D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
+    . F  S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^C0CSYS(RIMDFN)  ; NEXT PATIENT
 "RTN","C0CRIMA",100,0)
-    . W "CATEGORY NAME: ",CATNAME,!
+    . ; PTST TESTS TO SEE IF PATIENT WAS MERGED
 "RTN","C0CRIMA",101,0)
-    . ;
+    . ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT
 "RTN","C0CRIMA",102,0)
-    . F  S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^C0CSYS(RIMDFN) ; NEXT PATIENT
+    . ; AND WE SKIP IT
 "RTN","C0CRIMA",103,0)
-    . ; PTST TESTS TO SEE IF PATIENT WAS MERGED
+    . S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN
 "RTN","C0CRIMA",104,0)
-    . ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT
+    ; D PARY^C0CXPATH(@RIMBASE@("ATTRTBL"))
 "RTN","C0CRIMA",105,0)
-    . ; AND WE SKIP IT
+    Q
 "RTN","C0CRIMA",106,0)
-    . S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN
+    ;
 "RTN","C0CRIMA",107,0)
-    ; D PARY^C0CXPATH(@RIMBASE@("ATTRTBL"))
+SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
 "RTN","C0CRIMA",108,0)
+    N SBASE,SATTR
+"RTN","C0CRIMA",109,0)
+    S SBASE=$NA(@RIMBASE@("VARS",SDFN))
+"RTN","C0CRIMA",110,0)
+    D APOST("SATTR","RIMTBL","HEADER")
+"RTN","C0CRIMA",111,0)
+    I $D(@SBASE@("PROBLEMS",1)) D  ;
+"RTN","C0CRIMA",112,0)
+    . D APOST("SATTR","RIMTBL","PROBLEMS")
+"RTN","C0CRIMA",113,0)
+    . ; W "POSTING PROBLEMS",!
+"RTN","C0CRIMA",114,0)
+    I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
+"RTN","C0CRIMA",115,0)
+    I $D(@SBASE@("IMMUNE",1)) D  ;IMMUNIZATIONS PRESENT
+"RTN","C0CRIMA",116,0)
+    . D APOST("SATTR","RIMTBL","IMMUNE")
+"RTN","C0CRIMA",117,0)
+    . N ZR,ZI
+"RTN","C0CRIMA",118,0)
+    . D GETPA(.ZR,SDFN,"IMMUNE","IMMUNEPRODUCTCODE")
+"RTN","C0CRIMA",119,0)
+    . I ZR(0)>0 D APOST("SATTR","RIMTBL","IMMUNECODE") ;IMMUNIZATION CODES
+"RTN","C0CRIMA",120,0)
+    I $D(@SBASE@("MEDS",1)) D  ; IF THE PATIENT HAS MEDS VARIABLES
+"RTN","C0CRIMA",121,0)
+    . D APOST("SATTR","RIMTBL","MEDS")
+"RTN","C0CRIMA",122,0)
+    . N ZR,ZI
+"RTN","C0CRIMA",123,0)
+    . D GETPA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
+"RTN","C0CRIMA",124,0)
+    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
+"RTN","C0CRIMA",125,0)
+    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
+"RTN","C0CRIMA",126,0)
+    . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","MEDSCODE") ;CODES
+"RTN","C0CRIMA",127,0)
+    . ; D PATD^C0CRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
+"RTN","C0CRIMA",128,0)
+    I $D(@SBASE@("ALERTS",1)) D  ; IF THE PATIENT HAS ALERTS
+"RTN","C0CRIMA",129,0)
+    . D APOST("SATTR","RIMTBL","ALERTS")
+"RTN","C0CRIMA",130,0)
+    . N ZR,ZI
+"RTN","C0CRIMA",131,0)
+    . D GETPA(.ZR,SDFN,"ALERTS","ALERTAGENTPRODUCTCODEVALUE") ;REACTANT CODES
+"RTN","C0CRIMA",132,0)
+    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
+"RTN","C0CRIMA",133,0)
+    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
+"RTN","C0CRIMA",134,0)
+    . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","ALERTSCODE") ;CODES
+"RTN","C0CRIMA",135,0)
+    I $D(@SBASE@("RESULTS",1)) D  ; IF THE PATIENT HAS LABS VARIABLES
+"RTN","C0CRIMA",136,0)
+    . D APOST("SATTR","RIMTBL","RESULTS")
+"RTN","C0CRIMA",137,0)
+    . N ZR,ZI
+"RTN","C0CRIMA",138,0)
+    . S ZR(0)=0 ; INITIALIZE TO NONE
+"RTN","C0CRIMA",139,0)
+    . D RPCGV(.ZR,SDFN,"RESULTS") ;CHECK FOR LABS CODES
+"RTN","C0CRIMA",140,0)
+    . ; D PARY^C0CXPATH("ZR") ;
+"RTN","C0CRIMA",141,0)
+    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
+"RTN","C0CRIMA",142,0)
+    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
+"RTN","C0CRIMA",143,0)
+    . . . I $P(ZR(ZI),"^",2)="RESULTTESTCODINGSYSTEM" D  ; LOINC CODE CHECK
+"RTN","C0CRIMA",144,0)
+    . . . . I $P(ZR(ZI),"^",3)="LOINC" D APOST("SATTR","RIMTBL","RESULTSLN") ;
+"RTN","C0CRIMA",145,0)
+    ; D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
+"RTN","C0CRIMA",146,0)
+    I $D(@SBASE@("PROCEDURES",1)) D  ;
+"RTN","C0CRIMA",147,0)
+    . D APOST("SATTR","RIMTBL","PROCEDURES")
+"RTN","C0CRIMA",148,0)
+    W "ATTRIBUTES: ",SATTR,!
+"RTN","C0CRIMA",149,0)
+    Q SATTR
+"RTN","C0CRIMA",150,0)
+    ;
+"RTN","C0CRIMA",151,0)
+RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
+"RTN","C0CRIMA",152,0)
+    K ^TMP("C0CRIM","RESUME")
+"RTN","C0CRIMA",153,0)
+    K ^TMP("C0CRIM")
+"RTN","C0CRIMA",154,0)
     Q
-"RTN","C0CRIMA",109,0)
+"RTN","C0CRIMA",155,0)
     ;
-"RTN","C0CRIMA",110,0)
-SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
-"RTN","C0CRIMA",111,0)
-    N SBASE,SATTR
-"RTN","C0CRIMA",112,0)
-    S SBASE=$NA(@RIMBASE@("VARS",SDFN))
-"RTN","C0CRIMA",113,0)
-    D APOST("SATTR","RIMTBL","HEADER")
-"RTN","C0CRIMA",114,0)
-    I $D(@SBASE@("PROBLEMS",1)) D  ;
-"RTN","C0CRIMA",115,0)
-    . D APOST("SATTR","RIMTBL","PROBLEMS")
-"RTN","C0CRIMA",116,0)
-    . ; W "POSTING PROBLEMS",!
-"RTN","C0CRIMA",117,0)
-    I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
-"RTN","C0CRIMA",118,0)
-    I $D(@SBASE@("IMMUNE",1)) D  ;IMMUNIZATIONS PRESENT
-"RTN","C0CRIMA",119,0)
-    . D APOST("SATTR","RIMTBL","IMMUNE")
-"RTN","C0CRIMA",120,0)
-    . N ZR,ZI
-"RTN","C0CRIMA",121,0)
-    . D GETPA(.ZR,SDFN,"IMMUNE","IMMUNEPRODUCTCODE")
-"RTN","C0CRIMA",122,0)
-    . I ZR(0)>0 D APOST("SATTR","RIMTBL","IMMUNECODE") ;IMMUNIZATION CODES
-"RTN","C0CRIMA",123,0)
-    I $D(@SBASE@("MEDS",1)) D  ; IF THE PATIENT HAS MEDS VARIABLES
-"RTN","C0CRIMA",124,0)
-    . D APOST("SATTR","RIMTBL","MEDS")
-"RTN","C0CRIMA",125,0)
-    . N ZR,ZI
-"RTN","C0CRIMA",126,0)
-    . D GETPA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
-"RTN","C0CRIMA",127,0)
-    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
-"RTN","C0CRIMA",128,0)
-    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
-"RTN","C0CRIMA",129,0)
-    . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","MEDSCODE") ;CODES
-"RTN","C0CRIMA",130,0)
-    . ; D PATD^C0CRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
-"RTN","C0CRIMA",131,0)
-    I $D(@SBASE@("ALERTS",1)) D  ; IF THE PATIENT HAS ALERTS
-"RTN","C0CRIMA",132,0)
-    . D APOST("SATTR","RIMTBL","ALERTS")
-"RTN","C0CRIMA",133,0)
-    . N ZR,ZI
-"RTN","C0CRIMA",134,0)
-    . D GETPA(.ZR,SDFN,"ALERTS","ALERTAGENTPRODUCTCODEVALUE") ;REACTANT CODES
-"RTN","C0CRIMA",135,0)
-    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
-"RTN","C0CRIMA",136,0)
-    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
-"RTN","C0CRIMA",137,0)
-    . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","ALERTSCODE") ;CODES
-"RTN","C0CRIMA",138,0)
-    I $D(@SBASE@("RESULTS",1)) D  ; IF THE PATIENT HAS LABS VARIABLES
-"RTN","C0CRIMA",139,0)
-    . D APOST("SATTR","RIMTBL","RESULTS")
-"RTN","C0CRIMA",140,0)
-    . N ZR,ZI
-"RTN","C0CRIMA",141,0)
-    . S ZR(0)=0 ; INITIALIZE TO NONE
-"RTN","C0CRIMA",142,0)
-    . D RPCGV(.ZR,SDFN,"RESULTS") ;CHECK FOR LABS CODES
-"RTN","C0CRIMA",143,0)
-    . ; D PARY^C0CXPATH("ZR") ;
-"RTN","C0CRIMA",144,0)
-    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
-"RTN","C0CRIMA",145,0)
-    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
-"RTN","C0CRIMA",146,0)
-    . . . I $P(ZR(ZI),"^",2)="RESULTTESTCODINGSYSTEM" D  ; LOINC CODE CHECK
-"RTN","C0CRIMA",147,0)
-    . . . . I $P(ZR(ZI),"^",3)="LOINC" D APOST("SATTR","RIMTBL","RESULTSLN") ;
-"RTN","C0CRIMA",148,0)
-    ; D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
-"RTN","C0CRIMA",149,0)
-    I $D(@SBASE@("PROCEDURES",1)) D  ;
-"RTN","C0CRIMA",150,0)
-    . D APOST("SATTR","RIMTBL","PROCEDURES")
-"RTN","C0CRIMA",151,0)
-    W "ATTRIBUTES: ",SATTR,!
-"RTN","C0CRIMA",152,0)
-    Q SATTR
-"RTN","C0CRIMA",153,0)
+"RTN","C0CRIMA",156,0)
+CLIST ; LIST THE CATEGORIES
+"RTN","C0CRIMA",157,0)
     ;
-"RTN","C0CRIMA",154,0)
-RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
-"RTN","C0CRIMA",155,0)
-    K ^TMP("C0CRIM","RESUME")
-"RTN","C0CRIMA",156,0)
-    K ^TMP("C0CRIM")
-"RTN","C0CRIMA",157,0)
+"RTN","C0CRIMA",158,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","C0CRIMA",159,0)
+    N CLBASE,CLNUM,ZI,CLIDX
+"RTN","C0CRIMA",160,0)
+    S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
+"RTN","C0CRIMA",161,0)
+    S CLNUM=@CLBASE@(0)
+"RTN","C0CRIMA",162,0)
+    F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
+"RTN","C0CRIMA",163,0)
+    . S CLIDX=@CLBASE@(ZI)
+"RTN","C0CRIMA",164,0)
+    . W "(",$P(@CLBASE@(CLIDX),"^",1)
+"RTN","C0CRIMA",165,0)
+    . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
+"RTN","C0CRIMA",166,0)
+    . W CLIDX,!
+"RTN","C0CRIMA",167,0)
+    ; D PARY^C0CXPATH(CLBASE)
+"RTN","C0CRIMA",168,0)
     Q
-"RTN","C0CRIMA",158,0)
+"RTN","C0CRIMA",169,0)
     ;
-"RTN","C0CRIMA",159,0)
-CLIST ; LIST THE CATEGORIES
-"RTN","C0CRIMA",160,0)
+"RTN","C0CRIMA",170,0)
+CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
+"RTN","C0CRIMA",171,0)
+    ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
+"RTN","C0CRIMA",172,0)
+    ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
+"RTN","C0CRIMA",173,0)
+    ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
+"RTN","C0CRIMA",174,0)
+    ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
+"RTN","C0CRIMA",175,0)
+    ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
+"RTN","C0CRIMA",176,0)
+    ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
+"RTN","C0CRIMA",177,0)
+    ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
+"RTN","C0CRIMA",178,0)
+    ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
+"RTN","C0CRIMA",179,0)
+    ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
+"RTN","C0CRIMA",180,0)
+    ; NUMBER IE CTBL_X(CDFN)=""
+"RTN","C0CRIMA",181,0)
     ;
-"RTN","C0CRIMA",161,0)
+"RTN","C0CRIMA",182,0)
+    ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
+"RTN","C0CRIMA",183,0)
+    S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
+"RTN","C0CRIMA",184,0)
+    W "CBASE: ",CCTBL,!
+"RTN","C0CRIMA",185,0)
+    ;
+"RTN","C0CRIMA",186,0)
+    I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
+"RTN","C0CRIMA",187,0)
+    . D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
+"RTN","C0CRIMA",188,0)
+    . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
+"RTN","C0CRIMA",189,0)
+    . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
+"RTN","C0CRIMA",190,0)
+    . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
+"RTN","C0CRIMA",191,0)
+    . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
+"RTN","C0CRIMA",192,0)
+    . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
+"RTN","C0CRIMA",193,0)
+    ;
+"RTN","C0CRIMA",194,0)
+    S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
+"RTN","C0CRIMA",195,0)
+    S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
+"RTN","C0CRIMA",196,0)
+    S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
+"RTN","C0CRIMA",197,0)
+    ;
+"RTN","C0CRIMA",198,0)
+    S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
+"RTN","C0CRIMA",199,0)
+    ;
+"RTN","C0CRIMA",200,0)
+    S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
+"RTN","C0CRIMA",201,0)
+    W "PATS BASE: ",CPATLIST,!
+"RTN","C0CRIMA",202,0)
+    S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
+"RTN","C0CRIMA",203,0)
+    ;
+"RTN","C0CRIMA",204,0)
+    Q
+"RTN","C0CRIMA",205,0)
+    ;
+"RTN","C0CRIMA",206,0)
+CHKSUM(CKDFN) ; DOES A CHECKSUM AND STORES IT IN MUMPS GLOBALS
+"RTN","C0CRIMA",207,0)
+ ; 
+"RTN","C0CRIMA",208,0)
+ S C0CCKB=$NA(^TMP("C0CRIM","CHKSUM")) ;CHECKSUM BASE
+"RTN","C0CRIMA",209,0)
+ S C0CGLB=$NA(^TMP("C0CRIM","VARS")) ;CCR VARIABLE BASE
+"RTN","C0CRIMA",210,0)
+ S C0CI=""
+"RTN","C0CRIMA",211,0)
+ F  S C0CI=$O(@C0CGLB@(CKDFN,C0CI)) Q:C0CI=""  D  ;FOR EACH DOMAIN
+"RTN","C0CRIMA",212,0)
+ . ;W "DFN:",CKDFN," DOMAIN:",C0CI,!
+"RTN","C0CRIMA",213,0)
+ . S C0CJ=$NA(@C0CGLB@(CKDFN,C0CI))
+"RTN","C0CRIMA",214,0)
+ . I C0CI="HEADER" D  ; HAVE TO TAKE OUT THE "DATE GENERATED"
+"RTN","C0CRIMA",215,0)
+ . . S C0CDT=@C0CGLB@(CKDFN,C0CI,1,"DATETIME")
+"RTN","C0CRIMA",216,0)
+ . . K @C0CGLB@(CKDFN,C0CI,1,"DATETIME")
+"RTN","C0CRIMA",217,0)
+ . S C0CCK(C0CI)=$$CHKSUM^XUSESIG1(C0CJ)
+"RTN","C0CRIMA",218,0)
+ . I C0CI="HEADER" D  ; PUT IT BACK
+"RTN","C0CRIMA",219,0)
+ . . S @C0CGLB@(CKDFN,C0CI,1,"DATETIME")=C0CDT
+"RTN","C0CRIMA",220,0)
+ S C0CK="C0CCK" ;
+"RTN","C0CRIMA",221,0)
+ S C0CALL=$$CHKSUM^XUSESIG1(C0CK) ;CHECKSUM OF ALL DOMAIN CHECKSUMS
+"RTN","C0CRIMA",222,0)
+ S CHKR=0 ; RESULT DEFAULT
+"RTN","C0CRIMA",223,0)
+ I $D(^TMP("C0CRIM","CHKSUM",CKDFN,"ALL")) D  ; OLD CHECKSUM EXISTS
+"RTN","C0CRIMA",224,0)
+ . I @C0CCKB@(CKDFN,"ALL")'=C0CALL S CHKR=1
+"RTN","C0CRIMA",225,0)
+ E  S CHKR=1 ;CHECKSUM IS NEW
+"RTN","C0CRIMA",226,0)
+ S @C0CCKB@(CKDFN,"ALL")=C0CALL
+"RTN","C0CRIMA",227,0)
+ M @C0CCKB@(CKDFN,"DOMAIN")=C0CCK
+"RTN","C0CRIMA",228,0)
+ ;ZWR ^TMP("C0CRIM","CHKSUM",CKDFN,*)
+"RTN","C0CRIMA",229,0)
+ Q CHKR
+"RTN","C0CRIMA",230,0)
+ ;
+"RTN","C0CRIMA",231,0)
+CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
+"RTN","C0CRIMA",232,0)
+    ;
+"RTN","C0CRIMA",233,0)
     I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","C0CRIMA",162,0)
-    N CLBASE,CLNUM,ZI,CLIDX
-"RTN","C0CRIMA",163,0)
-    S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
-"RTN","C0CRIMA",164,0)
-    S CLNUM=@CLBASE@(0)
-"RTN","C0CRIMA",165,0)
-    F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
-"RTN","C0CRIMA",166,0)
-    . S CLIDX=@CLBASE@(ZI)
-"RTN","C0CRIMA",167,0)
-    . W "(",$P(@CLBASE@(CLIDX),"^",1)
-"RTN","C0CRIMA",168,0)
-    . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
-"RTN","C0CRIMA",169,0)
-    . W CLIDX,!
-"RTN","C0CRIMA",170,0)
-    ; D PARY^C0CXPATH(CLBASE)
-"RTN","C0CRIMA",171,0)
+"RTN","C0CRIMA",234,0)
+    N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
+"RTN","C0CRIMA",235,0)
+    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
+"RTN","C0CRIMA",236,0)
+    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
+"RTN","C0CRIMA",237,0)
+    S ZTOT=0 ; INITIALIZE OVERALL TOTAL
+"RTN","C0CRIMA",238,0)
+    F ZI=1:1:@ZCBASE@(0) D  ; FOR ALL CATS
+"RTN","C0CRIMA",239,0)
+    . S ZCNT=0
+"RTN","C0CRIMA",240,0)
+    . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
+"RTN","C0CRIMA",241,0)
+    . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
+"RTN","C0CRIMA",242,0)
+    . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
+"RTN","C0CRIMA",243,0)
+    . ; F ZJ=0:0 D  Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
+"RTN","C0CRIMA",244,0)
+    . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
+"RTN","C0CRIMA",245,0)
+    . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
+"RTN","C0CRIMA",246,0)
+    . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
+"RTN","C0CRIMA",247,0)
+    . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
+"RTN","C0CRIMA",248,0)
+    . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
+"RTN","C0CRIMA",249,0)
+    . S ZTOT=ZTOT+ZCNT
+"RTN","C0CRIMA",250,0)
+    W "TOTAL: ",ZTOT,!
+"RTN","C0CRIMA",251,0)
     Q
-"RTN","C0CRIMA",172,0)
+"RTN","C0CRIMA",252,0)
     ;
-"RTN","C0CRIMA",173,0)
-CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
-"RTN","C0CRIMA",174,0)
-    ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
-"RTN","C0CRIMA",175,0)
-    ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
-"RTN","C0CRIMA",176,0)
-    ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
-"RTN","C0CRIMA",177,0)
-    ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
-"RTN","C0CRIMA",178,0)
-    ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
-"RTN","C0CRIMA",179,0)
-    ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
-"RTN","C0CRIMA",180,0)
-    ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
-"RTN","C0CRIMA",181,0)
-    ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
-"RTN","C0CRIMA",182,0)
-    ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
-"RTN","C0CRIMA",183,0)
-    ; NUMBER IE CTBL_X(CDFN)=""
-"RTN","C0CRIMA",184,0)
+"RTN","C0CRIMA",253,0)
+CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
+"RTN","C0CRIMA",254,0)
+    ; INLST IS PASSED BY NAME
+"RTN","C0CRIMA",255,0)
+    N ZI,ZDX,ZCOUNT
+"RTN","C0CRIMA",256,0)
+    W INLST,!
+"RTN","C0CRIMA",257,0)
+    S ZCOUNT=0
+"RTN","C0CRIMA",258,0)
+    S ZDX=""
+"RTN","C0CRIMA",259,0)
+    F ZI=$O(@INLST@(ZDX)):0 D  Q:$O(@INLST@(ZDX))=""  ; LOOP UNTIL THE END
+"RTN","C0CRIMA",260,0)
+    . S ZCOUNT=ZCOUNT+1
+"RTN","C0CRIMA",261,0)
+    . S ZDX=$O(@INLST@(ZDX))
+"RTN","C0CRIMA",262,0)
+    . W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
+"RTN","C0CRIMA",263,0)
+    Q ZCOUNT
+"RTN","C0CRIMA",264,0)
     ;
-"RTN","C0CRIMA",185,0)
-    ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
-"RTN","C0CRIMA",186,0)
-    S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
-"RTN","C0CRIMA",187,0)
-    W "CBASE: ",CCTBL,!
-"RTN","C0CRIMA",188,0)
+"RTN","C0CRIMA",265,0)
+XCPAT(CPATCAT,CPATPARM) ; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT
+"RTN","C0CRIMA",266,0)
     ;
-"RTN","C0CRIMA",189,0)
-    I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
-"RTN","C0CRIMA",190,0)
-    . D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
-"RTN","C0CRIMA",191,0)
-    . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
-"RTN","C0CRIMA",192,0)
-    . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
-"RTN","C0CRIMA",193,0)
-    . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
-"RTN","C0CRIMA",194,0)
-    . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
-"RTN","C0CRIMA",195,0)
-    . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
-"RTN","C0CRIMA",196,0)
+"RTN","C0CRIMA",267,0)
+    I '$D(CPATPARM) S CPATPARM=""
+"RTN","C0CRIMA",268,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","C0CRIMA",269,0)
+    N ZI,ZJ,ZC,ZPATBASE
+"RTN","C0CRIMA",270,0)
+    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
+"RTN","C0CRIMA",271,0)
+    S ZI=""
+"RTN","C0CRIMA",272,0)
+    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
+"RTN","C0CRIMA",273,0)
+    . S ZI=$O(@ZPATBASE@(ZI))
+"RTN","C0CRIMA",274,0)
+    . D XPAT^C0CCCR(ZI,CPATPARM) ; EXPORT THE PATIENT TO A FILE
+"RTN","C0CRIMA",275,0)
+    Q
+"RTN","C0CRIMA",276,0)
     ;
-"RTN","C0CRIMA",197,0)
-    S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
-"RTN","C0CRIMA",198,0)
-    S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
-"RTN","C0CRIMA",199,0)
-    S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
-"RTN","C0CRIMA",200,0)
+"RTN","C0CRIMA",277,0)
+CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
+"RTN","C0CRIMA",278,0)
     ;
-"RTN","C0CRIMA",201,0)
-    S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
-"RTN","C0CRIMA",202,0)
+"RTN","C0CRIMA",279,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","C0CRIMA",280,0)
+    N ZI,ZJ,ZC,ZPATBASE
+"RTN","C0CRIMA",281,0)
+    S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
+"RTN","C0CRIMA",282,0)
+    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
+"RTN","C0CRIMA",283,0)
+    S ZI=""
+"RTN","C0CRIMA",284,0)
+    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
+"RTN","C0CRIMA",285,0)
+    . S ZI=$O(@ZPATBASE@(ZI))
+"RTN","C0CRIMA",286,0)
+    . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
+"RTN","C0CRIMA",287,0)
+    . W ZI," "
+"RTN","C0CRIMA",288,0)
+    . I ZC=10 D  ; NEW LINE
+"RTN","C0CRIMA",289,0)
+    . . S ZC=0
+"RTN","C0CRIMA",290,0)
+    . . W !
+"RTN","C0CRIMA",291,0)
+    Q
+"RTN","C0CRIMA",292,0)
     ;
-"RTN","C0CRIMA",203,0)
-    S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
-"RTN","C0CRIMA",204,0)
-    W "PATS BASE: ",CPATLIST,!
-"RTN","C0CRIMA",205,0)
-    S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
-"RTN","C0CRIMA",206,0)
+"RTN","C0CRIMA",293,0)
+PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT
+"RTN","C0CRIMA",294,0)
     ;
-"RTN","C0CRIMA",207,0)
+"RTN","C0CRIMA",295,0)
+    N ATTR S ATTR=""
+"RTN","C0CRIMA",296,0)
+    I '$D(^TMP("C0CRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
+"RTN","C0CRIMA",297,0)
+    . D ANALYZE(DFN,1) ; EXTRACT THE RIM VARIABLE FOR THIS PATIENT
+"RTN","C0CRIMA",298,0)
+    S ATTR=^TMP("C0CRIM","ATTR",DFN)
+"RTN","C0CRIMA",299,0)
+    I ATTR="" W "THIS PATIENT NOT ANALYZED.",! Q  ;NO ATTRIBUTES FOUND
+"RTN","C0CRIMA",300,0)
+    I $D(^TMP("C0CRIM","RIMTBL","CATS",ATTR)) D  ; FOUND A CAT
+"RTN","C0CRIMA",301,0)
+    . N CAT
+"RTN","C0CRIMA",302,0)
+    . S CAT=$P(^TMP("C0CRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT
+"RTN","C0CRIMA",303,0)
+    . W CAT,": ",ATTR,!
+"RTN","C0CRIMA",304,0)
     Q
-"RTN","C0CRIMA",208,0)
+"RTN","C0CRIMA",305,0)
     ;
-"RTN","C0CRIMA",209,0)
-CHKSUM(CKDFN) ; DOES A CHECKSUM AND STORES IT IN MUMPS GLOBALS
-"RTN","C0CRIMA",210,0)
- ; 
-"RTN","C0CRIMA",211,0)
- S C0CCKB=$NA(^TMP("C0CRIM","CHKSUM")) ;CHECKSUM BASE
-"RTN","C0CRIMA",212,0)
- S C0CGLB=$NA(^TMP("C0CRIM","VARS")) ;CCR VARIABLE BASE
-"RTN","C0CRIMA",213,0)
- S C0CI=""
-"RTN","C0CRIMA",214,0)
- F  S C0CI=$O(@C0CGLB@(CKDFN,C0CI)) Q:C0CI=""  D  ;FOR EACH DOMAIN
-"RTN","C0CRIMA",215,0)
- . ;W "DFN:",CKDFN," DOMAIN:",C0CI,!
-"RTN","C0CRIMA",216,0)
- . S C0CJ=$NA(@C0CGLB@(CKDFN,C0CI))
-"RTN","C0CRIMA",217,0)
- . I C0CI="HEADER" D  ; HAVE TO TAKE OUT THE "DATE GENERATED"
-"RTN","C0CRIMA",218,0)
- . . S C0CDT=@C0CGLB@(CKDFN,C0CI,1,"DATETIME")
-"RTN","C0CRIMA",219,0)
- . . K @C0CGLB@(CKDFN,C0CI,1,"DATETIME")
-"RTN","C0CRIMA",220,0)
- . S C0CCK(C0CI)=$$CHKSUM^XUSESIG1(C0CJ)
-"RTN","C0CRIMA",221,0)
- . I C0CI="HEADER" D  ; PUT IT BACK
-"RTN","C0CRIMA",222,0)
- . . S @C0CGLB@(CKDFN,C0CI,1,"DATETIME")=C0CDT
-"RTN","C0CRIMA",223,0)
- S C0CK="C0CCK" ;
-"RTN","C0CRIMA",224,0)
- S C0CALL=$$CHKSUM^XUSESIG1(C0CK) ;CHECKSUM OF ALL DOMAIN CHECKSUMS
-"RTN","C0CRIMA",225,0)
- S CHKR=0 ; RESULT DEFAULT
-"RTN","C0CRIMA",226,0)
- I $D(^TMP("C0CRIM","CHKSUM",CKDFN,"ALL")) D  ; OLD CHECKSUM EXISTS
-"RTN","C0CRIMA",227,0)
- . I @C0CCKB@(CKDFN,"ALL")'=C0CALL S CHKR=1
-"RTN","C0CRIMA",228,0)
- E  S CHKR=1 ;CHECKSUM IS NEW
-"RTN","C0CRIMA",229,0)
- S @C0CCKB@(CKDFN,"ALL")=C0CALL
-"RTN","C0CRIMA",230,0)
- M @C0CCKB@(CKDFN,"DOMAIN")=C0CCK
-"RTN","C0CRIMA",231,0)
- ;ZWR ^TMP("C0CRIM","CHKSUM",CKDFN,*)
-"RTN","C0CRIMA",232,0)
- Q CHKR
-"RTN","C0CRIMA",233,0)
- ;
-"RTN","C0CRIMA",234,0)
-CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
-"RTN","C0CRIMA",235,0)
+"RTN","C0CRIMA",306,0)
+APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
+"RTN","C0CRIMA",307,0)
+    ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
+"RTN","C0CRIMA",308,0)
+    ; AND AMAP(N)=AVAL IS THE NTH AVAL
+"RTN","C0CRIMA",309,0)
+    ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
+"RTN","C0CRIMA",310,0)
+    ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
+"RTN","C0CRIMA",311,0)
+    ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
+"RTN","C0CRIMA",312,0)
+    ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
+"RTN","C0CRIMA",313,0)
     ;
-"RTN","C0CRIMA",236,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","C0CRIMA",237,0)
-    N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
-"RTN","C0CRIMA",238,0)
+"RTN","C0CRIMA",314,0)
+    I '$D(@AMAP) D  ; IF THE MAP DOES NOT EXIST
+"RTN","C0CRIMA",315,0)
+    . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
+"RTN","C0CRIMA",316,0)
+    S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
+"RTN","C0CRIMA",317,0)
+    S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
+"RTN","C0CRIMA",318,0)
+    S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
+"RTN","C0CRIMA",319,0)
+    Q
+"RTN","C0CRIMA",320,0)
+    ;
+"RTN","C0CRIMA",321,0)
+ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
+"RTN","C0CRIMA",322,0)
+      I '$D(RIMBASE) S RIMBASE=$NA(^TMP("C0CRIM"))
+"RTN","C0CRIMA",323,0)
+      I '$D(@RIMBASE) S @RIMBASE=""
+"RTN","C0CRIMA",324,0)
+      I '$D(RIMTBL) S RIMTBL=$NA(^TMP("C0CRIM","RIMTBL","TABLE")) ; ATTR TABLE
+"RTN","C0CRIMA",325,0)
+      S ^TMP("C0CRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
+"RTN","C0CRIMA",326,0)
+      Q
+"RTN","C0CRIMA",327,0)
+      ;
+"RTN","C0CRIMA",328,0)
+AINIT ; INITIALIZE ATTRIBUTE TABLE
+"RTN","C0CRIMA",329,0)
+      I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","C0CRIMA",330,0)
+      K @RIMTBL
+"RTN","C0CRIMA",331,0)
+      D APUSH(RIMTBL,"EXTRACTED")
+"RTN","C0CRIMA",332,0)
+      D APUSH(RIMTBL,"NOTEXTRACTED")
+"RTN","C0CRIMA",333,0)
+      D APUSH(RIMTBL,"HEADER")
+"RTN","C0CRIMA",334,0)
+      D APUSH(RIMTBL,"NOPCP")
+"RTN","C0CRIMA",335,0)
+      D APUSH(RIMTBL,"PCP")
+"RTN","C0CRIMA",336,0)
+      D APUSH(RIMTBL,"PROBLEMS")
+"RTN","C0CRIMA",337,0)
+      D APUSH(RIMTBL,"PROBCODE")
+"RTN","C0CRIMA",338,0)
+      D APUSH(RIMTBL,"PROBNOCODE")
+"RTN","C0CRIMA",339,0)
+      D APUSH(RIMTBL,"PROBDATE")
+"RTN","C0CRIMA",340,0)
+      D APUSH(RIMTBL,"PROBNODATE")
+"RTN","C0CRIMA",341,0)
+      D APUSH(RIMTBL,"VITALS")
+"RTN","C0CRIMA",342,0)
+      D APUSH(RIMTBL,"VITALSCODE")
+"RTN","C0CRIMA",343,0)
+      D APUSH(RIMTBL,"VITALSNOCODE")
+"RTN","C0CRIMA",344,0)
+      D APUSH(RIMTBL,"VITALSDATE")
+"RTN","C0CRIMA",345,0)
+      D APUSH(RIMTBL,"VITALSNODATE")
+"RTN","C0CRIMA",346,0)
+      D APUSH(RIMTBL,"IMMUNE")
+"RTN","C0CRIMA",347,0)
+      D APUSH(RIMTBL,"IMMUNECODE")
+"RTN","C0CRIMA",348,0)
+      D APUSH(RIMTBL,"MEDS")
+"RTN","C0CRIMA",349,0)
+      D APUSH(RIMTBL,"MEDSCODE")
+"RTN","C0CRIMA",350,0)
+      D APUSH(RIMTBL,"MEDSNOCODE")
+"RTN","C0CRIMA",351,0)
+      D APUSH(RIMTBL,"MEDSDATE")
+"RTN","C0CRIMA",352,0)
+      D APUSH(RIMTBL,"MEDSNODATE")
+"RTN","C0CRIMA",353,0)
+      D APUSH(RIMTBL,"ALERTS")
+"RTN","C0CRIMA",354,0)
+      D APUSH(RIMTBL,"ALERTSCODE")
+"RTN","C0CRIMA",355,0)
+      D APUSH(RIMTBL,"RESULTS")
+"RTN","C0CRIMA",356,0)
+      D APUSH(RIMTBL,"RESULTSLN")
+"RTN","C0CRIMA",357,0)
+      D APUSH(RIMTBL,"PROCEDURES")
+"RTN","C0CRIMA",358,0)
+      D APUSH(RIMTBL,"ENCOUNTERS")
+"RTN","C0CRIMA",359,0)
+      D APUSH(RIMTBL,"NOTES")
+"RTN","C0CRIMA",360,0)
+      Q
+"RTN","C0CRIMA",361,0)
+      ;
+"RTN","C0CRIMA",362,0)
+APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
+"RTN","C0CRIMA",363,0)
+    ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
+"RTN","C0CRIMA",364,0)
+    ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
+"RTN","C0CRIMA",365,0)
+    ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
+"RTN","C0CRIMA",366,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
+"RTN","C0CRIMA",367,0)
+    N USETBL
+"RTN","C0CRIMA",368,0)
+    I '$D(@RIMBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
+"RTN","C0CRIMA",369,0)
+    . W "ERROR NO SUCH TABLE",!
+"RTN","C0CRIMA",370,0)
+    S USETBL=@RIMBASE@("TABLES",PTBL)
+"RTN","C0CRIMA",371,0)
+    S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
+"RTN","C0CRIMA",372,0)
+    Q
+"RTN","C0CRIMA",373,0)
+GETPA(RTN,DFN,ISEC,IVAR) ; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN
+"RTN","C0CRIMA",374,0)
+    ; EXAMPLE: D GETPA(.RT,2,"MEDS","MEDSSTATUSTEXT")
+"RTN","C0CRIMA",375,0)
+    ; RETURNS AN ARRAY RT OF VALUES OF MEDSTATUSTEXT FOR PATIENT 2 IN P2
+"RTN","C0CRIMA",376,0)
+    ; IN SECTION "MEDS"
+"RTN","C0CRIMA",377,0)
+    ; P1 IS THE IEN OF THE MED WITH THE VALUE IE 2^PENDING WOULD BE STATUS
+"RTN","C0CRIMA",378,0)
+    ; PENDING FOR MED 2 FOR PATIENT 2
+"RTN","C0CRIMA",379,0)
+    ; RT(0) IS THE COUNT OF HOW MANY IN THE ARRAY. NULL VALUES ARE
+"RTN","C0CRIMA",380,0)
+    ; RETURNED. RTN IS PASSED BY REFERENCE
+"RTN","C0CRIMA",381,0)
+    ;
+"RTN","C0CRIMA",382,0)
+    S RTN(0)=0 ; SET NULL DEFAULT RETURN VALUE
+"RTN","C0CRIMA",383,0)
+    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
+"RTN","C0CRIMA",384,0)
+    S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
+"RTN","C0CRIMA",385,0)
+    I '$D(@ZVBASE@(DFN,ISEC,0)) D  Q  ; NO VARIABLES IN SECTION
+"RTN","C0CRIMA",386,0)
+    . W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,!
+"RTN","C0CRIMA",387,0)
+    N ZZI,ZZS
+"RTN","C0CRIMA",388,0)
+    S ZZS=$NA(@ZVBASE@(DFN,ISEC)) ; SECTION VARIABLE ARRAY FOR THIS PATIENT
+"RTN","C0CRIMA",389,0)
+    ; ZWR @ZZS@(1)
+"RTN","C0CRIMA",390,0)
+    S RTN(0)=@ZZS@(0)
+"RTN","C0CRIMA",391,0)
+    F ZZI=1:1:RTN(0) D  ; FOR ALL PARTS OF THIS SECTION ( IE FOR ALL MEDS)
+"RTN","C0CRIMA",392,0)
+    . S $P(RTN(ZZI),"^",1)=ZZI ; INDEX FOR VARIABLE
+"RTN","C0CRIMA",393,0)
+    . S $P(RTN(ZZI),"^",2)=@ZZS@(ZZI,IVAR) ; THE VALUE OF THE VARIABLE
+"RTN","C0CRIMA",394,0)
+    Q
+"RTN","C0CRIMA",395,0)
+    ;
+"RTN","C0CRIMA",396,0)
+PATD(DFN,ISEC,IVAR) ; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR
+"RTN","C0CRIMA",397,0)
+    ;
+"RTN","C0CRIMA",398,0)
+    N ZR
+"RTN","C0CRIMA",399,0)
+    D GETPA(.ZR,DFN,ISEC,IVAR)
+"RTN","C0CRIMA",400,0)
+    I $D(ZR(0)) D PARY^C0CXPATH("ZR")
+"RTN","C0CRIMA",401,0)
+    E  W "NOTHING RETURNED",!
+"RTN","C0CRIMA",402,0)
+    Q
+"RTN","C0CRIMA",403,0)
+    ;
+"RTN","C0CRIMA",404,0)
+CAGET(RTN,IATTR) ;
+"RTN","C0CRIMA",405,0)
+    ; GETPA LOOKS AT RIMTBL TO FIND PATIENTS WITH ATTRIBUTE IATTR
+"RTN","C0CRIMA",406,0)
+    ; IT DOES NOT SEARCH ALL PATIENTS, ONLY THE ONES WITH THE ATTRIBUTE
+"RTN","C0CRIMA",407,0)
+    ; IT RETURNS AN ARRAY OF THE VALUES OF VARIABLE IVAR IN SECTION ISEC
+"RTN","C0CRIMA",408,0)
+    Q
+"RTN","C0CRIMA",409,0)
+    ;
+"RTN","C0CRIMA",410,0)
+PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
+"RTN","C0CRIMA",411,0)
+    ;
+"RTN","C0CRIMA",412,0)
+    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
+"RTN","C0CRIMA",413,0)
+    N ZLST
+"RTN","C0CRIMA",414,0)
+    S @LSTRTN@(0)=0 ; DEFAULT RETURN NONE
+"RTN","C0CRIMA",415,0)
     S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
-"RTN","C0CRIMA",239,0)
+"RTN","C0CRIMA",416,0)
     S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
-"RTN","C0CRIMA",240,0)
-    S ZTOT=0 ; INITIALIZE OVERALL TOTAL
-"RTN","C0CRIMA",241,0)
-    F ZI=1:1:@ZCBASE@(0) D  ; FOR ALL CATS
-"RTN","C0CRIMA",242,0)
-    . S ZCNT=0
-"RTN","C0CRIMA",243,0)
-    . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
-"RTN","C0CRIMA",244,0)
-    . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
-"RTN","C0CRIMA",245,0)
-    . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
-"RTN","C0CRIMA",246,0)
-    . ; F ZJ=0:0 D  Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
-"RTN","C0CRIMA",247,0)
-    . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
-"RTN","C0CRIMA",248,0)
-    . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
-"RTN","C0CRIMA",249,0)
-    . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
-"RTN","C0CRIMA",250,0)
-    . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
-"RTN","C0CRIMA",251,0)
-    . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
-"RTN","C0CRIMA",252,0)
-    . S ZTOT=ZTOT+ZCNT
-"RTN","C0CRIMA",253,0)
-    W "TOTAL: ",ZTOT,!
-"RTN","C0CRIMA",254,0)
+"RTN","C0CRIMA",417,0)
+    N ZNC  ; ZNC IS NUMBER OF CATEGORIES
+"RTN","C0CRIMA",418,0)
+    S ZNC=@ZCBASE@(0)
+"RTN","C0CRIMA",419,0)
+    I ZNC=0 Q  ; NO CATEGORIES TO SEARCH
+"RTN","C0CRIMA",420,0)
+    N ZAP  ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE
+"RTN","C0CRIMA",421,0)
+    S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR)
+"RTN","C0CRIMA",422,0)
+    N ZI,ZCATTBL,ZATBL,ZCNT,ZPAT
+"RTN","C0CRIMA",423,0)
+    F ZI=1:1:ZNC D  ; FOR ALL CATEGORIES
+"RTN","C0CRIMA",424,0)
+    . S ZATBL=@ZCBASE@(ZI) ; PULL OUT ATTR TBL FOR CAT
+"RTN","C0CRIMA",425,0)
+    . I $P(ZATBL,"^",ZAP)'="" D  ; CAT HAS ATTR
+"RTN","C0CRIMA",426,0)
+    . . S ZCATTBL=$P(@ZCBASE@(ZATBL),"^",1) ; NAME OF TBL
+"RTN","C0CRIMA",427,0)
+    . . M @LSTRTN=@ZPBASE@(ZCATTBL) ; MERGE PATS FROM CAT
+"RTN","C0CRIMA",428,0)
+    S ZCNT=0 ; INITIALIZE COUNT OF PATIENTS
+"RTN","C0CRIMA",429,0)
+    S ZPAT=0 ; START AT FIRST PATIENT IN LIST
+"RTN","C0CRIMA",430,0)
+    F  S ZPAT=$O(@LSTRTN@(ZPAT)) Q:ZPAT=""  D  ;
+"RTN","C0CRIMA",431,0)
+    . S ZCNT=ZCNT+1
+"RTN","C0CRIMA",432,0)
+    S @LSTRTN@(0)=ZCNT ; COUNT OF PATIENTS IN ARRAY
+"RTN","C0CRIMA",433,0)
     Q
-"RTN","C0CRIMA",255,0)
+"RTN","C0CRIMA",434,0)
     ;
-"RTN","C0CRIMA",256,0)
-CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
-"RTN","C0CRIMA",257,0)
-    ; INLST IS PASSED BY NAME
-"RTN","C0CRIMA",258,0)
-    N ZI,ZDX,ZCOUNT
-"RTN","C0CRIMA",259,0)
-    W INLST,!
-"RTN","C0CRIMA",260,0)
-    S ZCOUNT=0
-"RTN","C0CRIMA",261,0)
-    S ZDX=""
-"RTN","C0CRIMA",262,0)
-    F ZI=$O(@INLST@(ZDX)):0 D  Q:$O(@INLST@(ZDX))=""  ; LOOP UNTIL THE END
-"RTN","C0CRIMA",263,0)
-    . S ZCOUNT=ZCOUNT+1
-"RTN","C0CRIMA",264,0)
-    . S ZDX=$O(@INLST@(ZDX))
-"RTN","C0CRIMA",265,0)
-    . W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
-"RTN","C0CRIMA",266,0)
-    Q ZCOUNT
-"RTN","C0CRIMA",267,0)
+"RTN","C0CRIMA",435,0)
+DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
+"RTN","C0CRIMA",436,0)
     ;
-"RTN","C0CRIMA",268,0)
-XCPAT(CPATCAT,CPATPARM) ; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT
-"RTN","C0CRIMA",269,0)
+"RTN","C0CRIMA",437,0)
+    ;N ZR
+"RTN","C0CRIMA",438,0)
+    D PCLST("ZR",CATTR)
+"RTN","C0CRIMA",439,0)
+    I ZR(0)=0 D  Q  ;
+"RTN","C0CRIMA",440,0)
+    . W "NO PATIENTS RETURNED",!
+"RTN","C0CRIMA",441,0)
+    E  D  ;
+"RTN","C0CRIMA",442,0)
+    . N ZI S ZI=0
+"RTN","C0CRIMA",443,0)
+    . F  S ZI=$O(ZR(ZI)) Q:ZI=""  D  ;
+"RTN","C0CRIMA",444,0)
+    . . W !,ZI
+"RTN","C0CRIMA",445,0)
+    . ;D PARY^C0CXPATH("ZR") ; PRINT ARRAY
+"RTN","C0CRIMA",446,0)
+    . W !,"COUNT=",ZR(0)
+"RTN","C0CRIMA",447,0)
+    Q
+"RTN","C0CRIMA",448,0)
     ;
-"RTN","C0CRIMA",270,0)
-    I '$D(CPATPARM) S CPATPARM=""
-"RTN","C0CRIMA",271,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","C0CRIMA",272,0)
-    N ZI,ZJ,ZC,ZPATBASE
-"RTN","C0CRIMA",273,0)
-    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
-"RTN","C0CRIMA",274,0)
-    S ZI=""
-"RTN","C0CRIMA",275,0)
-    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
-"RTN","C0CRIMA",276,0)
-    . S ZI=$O(@ZPATBASE@(ZI))
-"RTN","C0CRIMA",277,0)
-    . D XPAT^C0CCCR(ZI,CPATPARM) ; EXPORT THE PATIENT TO A FILE
-"RTN","C0CRIMA",278,0)
+"RTN","C0CRIMA",449,0)
+RPCGV(RTN,DFN,WHICH) ; RPC GET VARS
+"RTN","C0CRIMA",450,0)
+ ; RETURNS IN RTN (PASSED BY REFERENCE) THE VARS AND VALUES
+"RTN","C0CRIMA",451,0)
+ ; FOUND AT INARY RTN(X)="VAR^VALUE" RTN(0) IS THE COUNT
+"RTN","C0CRIMA",452,0)
+ ; DFN IS THE PATIENT NUMBER.
+"RTN","C0CRIMA",453,0)
+ ; WHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS","IMMUNE"
+"RTN","C0CRIMA",454,0)
+ ; OR OTHER SECTIONS AS THEY ARE ADDED
+"RTN","C0CRIMA",455,0)
+ ; THIS IS MEANT TO BE AVAILABLE AS AN RPC
+"RTN","C0CRIMA",456,0)
+ I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","C0CRIMA",457,0)
+ S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
+"RTN","C0CRIMA",458,0)
+ S RTN(0)=0 ; DEFAULT NOTHING IS RETURNED
+"RTN","C0CRIMA",459,0)
+ N ZZGI
+"RTN","C0CRIMA",460,0)
+ I WHICH="ALL" D  ; VARIABLES FROM ALL SECTIONS
+"RTN","C0CRIMA",461,0)
+ . F ZZGI="HEADER","PROBLEMS","VITALS","MEDS","ALERTS","RESULTS","IMMUNE","PROCEDURES" D  ;
+"RTN","C0CRIMA",462,0)
+ . . D ZGVWRK(ZZGI) ; DO EACH SECTION
+"RTN","C0CRIMA",463,0)
+ . . I $G(DEBUG)'="" W "DID ",ZZGI,!
+"RTN","C0CRIMA",464,0)
+ E  D ZGVWRK(WHICH) ; ONLY ONE SECTION ASKED FOR
+"RTN","C0CRIMA",465,0)
+ Q
+"RTN","C0CRIMA",466,0)
+ ;
+"RTN","C0CRIMA",467,0)
+ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV
+"RTN","C0CRIMA",468,0)
+    ;
+"RTN","C0CRIMA",469,0)
+    N ZZGN ; NAME FOR SECTION VARIABLES
+"RTN","C0CRIMA",470,0)
+    S ZZGN=$NA(@ZVBASE@(DFN,ZWHICH)) ; BASE OF VARS FOR SECTION
+"RTN","C0CRIMA",471,0)
+    ;I '$D(@ZZGN@(0)) Q ; NO VARS FOR THIS SECTION
+"RTN","C0CRIMA",472,0)
+    I $O(@ZZGN@(""),-1)=""  D  ;
+"RTN","C0CRIMA",473,0)
+    E  D  ; VARS EXIST
+"RTN","C0CRIMA",474,0)
+    . N ZGVI,ZGVN
+"RTN","C0CRIMA",475,0)
+    . S ZGVN=$O(@ZZGN@(""),-1) ;COUNT OF VARS
+"RTN","C0CRIMA",476,0)
+    . F ZGVI=1:1:ZGVN D  ; FOR EACH MULTIPLE IN SECTION
+"RTN","C0CRIMA",477,0)
+    . . K ZZGA N ZZGA ; TEMP ARRAY FOR SECTION VARS
+"RTN","C0CRIMA",478,0)
+    . . K ZZGN2 N ZZGN2 ; NAME FOR MULTIPLE
+"RTN","C0CRIMA",479,0)
+    . . S ZZGN2=$NA(@ZZGN@(ZGVI))
+"RTN","C0CRIMA",480,0)
+    . . I $G(DEBUG)'="" W ZZGN2,!,$O(@ZZGN2@("")),!
+"RTN","C0CRIMA",481,0)
+    . . D H2ARY^C0CXPATH("ZZGA",ZZGN2,ZGVI) ; CONVERT HASH TO ARRAY
+"RTN","C0CRIMA",482,0)
+    . . ; D PARY^C0CXPATH("ZZGA")
+"RTN","C0CRIMA",483,0)
+    . . D PUSHA^C0CXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN
+"RTN","C0CRIMA",484,0)
     Q
-"RTN","C0CRIMA",279,0)
+"RTN","C0CRIMA",485,0)
     ;
-"RTN","C0CRIMA",280,0)
-CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
-"RTN","C0CRIMA",281,0)
+"RTN","C0CRIMA",486,0)
+DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN C0CRIM
+"RTN","C0CRIMA",487,0)
+    ; ALONG WITH SAMPLE VALUES.
+"RTN","C0CRIMA",488,0)
+    ; IWHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS","HEADER"
+"RTN","C0CRIMA",489,0)
+    N GTMP
+"RTN","C0CRIMA",490,0)
+    I '$D(^TMP("C0CRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
+"RTN","C0CRIMA",491,0)
+    . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
+"RTN","C0CRIMA",492,0)
+    I '$D(IWHICH) S IWHICH="ALL"
+"RTN","C0CRIMA",493,0)
+    D RPCGV(.GTMP,DFN,IWHICH)
+"RTN","C0CRIMA",494,0)
+    D PARY^C0CXPATH("GTMP")
+"RTN","C0CRIMA",495,0)
+    Q
+"RTN","C0CRIMA",496,0)
     ;
-"RTN","C0CRIMA",282,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","C0CRIMA",283,0)
-    N ZI,ZJ,ZC,ZPATBASE
-"RTN","C0CRIMA",284,0)
-    S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
-"RTN","C0CRIMA",285,0)
-    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
-"RTN","C0CRIMA",286,0)
-    S ZI=""
-"RTN","C0CRIMA",287,0)
-    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
-"RTN","C0CRIMA",288,0)
-    . S ZI=$O(@ZPATBASE@(ZI))
-"RTN","C0CRIMA",289,0)
-    . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
-"RTN","C0CRIMA",290,0)
-    . W ZI," "
-"RTN","C0CRIMA",291,0)
-    . I ZC=10 D  ; NEW LINE
-"RTN","C0CRIMA",292,0)
-    . . S ZC=0
-"RTN","C0CRIMA",293,0)
-    . . W !
-"RTN","C0CRIMA",294,0)
-    Q
-"RTN","C0CRIMA",295,0)
-    ;
-"RTN","C0CRIMA",296,0)
-PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT
-"RTN","C0CRIMA",297,0)
-    ;
-"RTN","C0CRIMA",298,0)
-    N ATTR S ATTR=""
-"RTN","C0CRIMA",299,0)
-    I '$D(^TMP("C0CRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
-"RTN","C0CRIMA",300,0)
-    . D ANALYZE(DFN,1) ; EXTRACT THE RIM VARIABLE FOR THIS PATIENT
-"RTN","C0CRIMA",301,0)
-    S ATTR=^TMP("C0CRIM","ATTR",DFN)
-"RTN","C0CRIMA",302,0)
-    I ATTR="" W "THIS PATIENT NOT ANALYZED.",! Q  ;NO ATTRIBUTES FOUND
-"RTN","C0CRIMA",303,0)
-    I $D(^TMP("C0CRIM","RIMTBL","CATS",ATTR)) D  ; FOUND A CAT
-"RTN","C0CRIMA",304,0)
-    . N CAT
-"RTN","C0CRIMA",305,0)
-    . S CAT=$P(^TMP("C0CRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT
-"RTN","C0CRIMA",306,0)
-    . W CAT,": ",ATTR,!
-"RTN","C0CRIMA",307,0)
-    Q
-"RTN","C0CRIMA",308,0)
-    ;
-"RTN","C0CRIMA",309,0)
-APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
-"RTN","C0CRIMA",310,0)
-    ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
-"RTN","C0CRIMA",311,0)
-    ; AND AMAP(N)=AVAL IS THE NTH AVAL
-"RTN","C0CRIMA",312,0)
-    ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
-"RTN","C0CRIMA",313,0)
-    ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
-"RTN","C0CRIMA",314,0)
-    ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
-"RTN","C0CRIMA",315,0)
-    ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
-"RTN","C0CRIMA",316,0)
-    ;
-"RTN","C0CRIMA",317,0)
-    I '$D(@AMAP) D  ; IF THE MAP DOES NOT EXIST
-"RTN","C0CRIMA",318,0)
-    . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
-"RTN","C0CRIMA",319,0)
-    S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
-"RTN","C0CRIMA",320,0)
-    S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
-"RTN","C0CRIMA",321,0)
-    S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
-"RTN","C0CRIMA",322,0)
-    Q
-"RTN","C0CRIMA",323,0)
-    ;
-"RTN","C0CRIMA",324,0)
-ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
-"RTN","C0CRIMA",325,0)
-      I '$D(RIMBASE) S RIMBASE=$NA(^TMP("C0CRIM"))
-"RTN","C0CRIMA",326,0)
-      I '$D(@RIMBASE) S @RIMBASE=""
-"RTN","C0CRIMA",327,0)
-      I '$D(RIMTBL) S RIMTBL=$NA(^TMP("C0CRIM","RIMTBL","TABLE")) ; ATTR TABLE
-"RTN","C0CRIMA",328,0)
-      S ^TMP("C0CRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
-"RTN","C0CRIMA",329,0)
-      Q
-"RTN","C0CRIMA",330,0)
-      ;
-"RTN","C0CRIMA",331,0)
-AINIT ; INITIALIZE ATTRIBUTE TABLE
-"RTN","C0CRIMA",332,0)
-      I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","C0CRIMA",333,0)
-      K @RIMTBL
-"RTN","C0CRIMA",334,0)
-      D APUSH(RIMTBL,"EXTRACTED")
-"RTN","C0CRIMA",335,0)
-      D APUSH(RIMTBL,"NOTEXTRACTED")
-"RTN","C0CRIMA",336,0)
-      D APUSH(RIMTBL,"HEADER")
-"RTN","C0CRIMA",337,0)
-      D APUSH(RIMTBL,"NOPCP")
-"RTN","C0CRIMA",338,0)
-      D APUSH(RIMTBL,"PCP")
-"RTN","C0CRIMA",339,0)
-      D APUSH(RIMTBL,"PROBLEMS")
-"RTN","C0CRIMA",340,0)
-      D APUSH(RIMTBL,"PROBCODE")
-"RTN","C0CRIMA",341,0)
-      D APUSH(RIMTBL,"PROBNOCODE")
-"RTN","C0CRIMA",342,0)
-      D APUSH(RIMTBL,"PROBDATE")
-"RTN","C0CRIMA",343,0)
-      D APUSH(RIMTBL,"PROBNODATE")
-"RTN","C0CRIMA",344,0)
-      D APUSH(RIMTBL,"VITALS")
-"RTN","C0CRIMA",345,0)
-      D APUSH(RIMTBL,"VITALSCODE")
-"RTN","C0CRIMA",346,0)
-      D APUSH(RIMTBL,"VITALSNOCODE")
-"RTN","C0CRIMA",347,0)
-      D APUSH(RIMTBL,"VITALSDATE")
-"RTN","C0CRIMA",348,0)
-      D APUSH(RIMTBL,"VITALSNODATE")
-"RTN","C0CRIMA",349,0)
-      D APUSH(RIMTBL,"IMMUNE")
-"RTN","C0CRIMA",350,0)
-      D APUSH(RIMTBL,"IMMUNECODE")
-"RTN","C0CRIMA",351,0)
-      D APUSH(RIMTBL,"MEDS")
-"RTN","C0CRIMA",352,0)
-      D APUSH(RIMTBL,"MEDSCODE")
-"RTN","C0CRIMA",353,0)
-      D APUSH(RIMTBL,"MEDSNOCODE")
-"RTN","C0CRIMA",354,0)
-      D APUSH(RIMTBL,"MEDSDATE")
-"RTN","C0CRIMA",355,0)
-      D APUSH(RIMTBL,"MEDSNODATE")
-"RTN","C0CRIMA",356,0)
-      D APUSH(RIMTBL,"ALERTS")
-"RTN","C0CRIMA",357,0)
-      D APUSH(RIMTBL,"ALERTSCODE")
-"RTN","C0CRIMA",358,0)
-      D APUSH(RIMTBL,"RESULTS")
-"RTN","C0CRIMA",359,0)
-      D APUSH(RIMTBL,"RESULTSLN")
-"RTN","C0CRIMA",360,0)
-      D APUSH(RIMTBL,"PROCEDURES")
-"RTN","C0CRIMA",361,0)
-      D APUSH(RIMTBL,"ENCOUNTERS")
-"RTN","C0CRIMA",362,0)
-      D APUSH(RIMTBL,"NOTES")
-"RTN","C0CRIMA",363,0)
-      Q
-"RTN","C0CRIMA",364,0)
-      ;
-"RTN","C0CRIMA",365,0)
-APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
-"RTN","C0CRIMA",366,0)
-    ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
-"RTN","C0CRIMA",367,0)
-    ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
-"RTN","C0CRIMA",368,0)
-    ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
-"RTN","C0CRIMA",369,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
-"RTN","C0CRIMA",370,0)
-    N USETBL
-"RTN","C0CRIMA",371,0)
-    I '$D(@RIMBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
-"RTN","C0CRIMA",372,0)
-    . W "ERROR NO SUCH TABLE",!
-"RTN","C0CRIMA",373,0)
-    S USETBL=@RIMBASE@("TABLES",PTBL)
-"RTN","C0CRIMA",374,0)
-    S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
-"RTN","C0CRIMA",375,0)
-    Q
-"RTN","C0CRIMA",376,0)
-GETPA(RTN,DFN,ISEC,IVAR) ; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN
-"RTN","C0CRIMA",377,0)
-    ; EXAMPLE: D GETPA(.RT,2,"MEDS","MEDSSTATUSTEXT")
-"RTN","C0CRIMA",378,0)
-    ; RETURNS AN ARRAY RT OF VALUES OF MEDSTATUSTEXT FOR PATIENT 2 IN P2
-"RTN","C0CRIMA",379,0)
-    ; IN SECTION "MEDS"
-"RTN","C0CRIMA",380,0)
-    ; P1 IS THE IEN OF THE MED WITH THE VALUE IE 2^PENDING WOULD BE STATUS
-"RTN","C0CRIMA",381,0)
-    ; PENDING FOR MED 2 FOR PATIENT 2
-"RTN","C0CRIMA",382,0)
-    ; RT(0) IS THE COUNT OF HOW MANY IN THE ARRAY. NULL VALUES ARE
-"RTN","C0CRIMA",383,0)
-    ; RETURNED. RTN IS PASSED BY REFERENCE
-"RTN","C0CRIMA",384,0)
-    ;
-"RTN","C0CRIMA",385,0)
-    S RTN(0)=0 ; SET NULL DEFAULT RETURN VALUE
-"RTN","C0CRIMA",386,0)
-    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
-"RTN","C0CRIMA",387,0)
-    S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
-"RTN","C0CRIMA",388,0)
-    I '$D(@ZVBASE@(DFN,ISEC,0)) D  Q ; NO VARIABLES IN SECTION
-"RTN","C0CRIMA",389,0)
-    . W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,!
-"RTN","C0CRIMA",390,0)
-    N ZZI,ZZS
-"RTN","C0CRIMA",391,0)
-    S ZZS=$NA(@ZVBASE@(DFN,ISEC)) ; SECTION VARIABLE ARRAY FOR THIS PATIENT
-"RTN","C0CRIMA",392,0)
-    ; ZWR @ZZS@(1)
-"RTN","C0CRIMA",393,0)
-    S RTN(0)=@ZZS@(0)
-"RTN","C0CRIMA",394,0)
-    F ZZI=1:1:RTN(0) D  ; FOR ALL PARTS OF THIS SECTION ( IE FOR ALL MEDS)
-"RTN","C0CRIMA",395,0)
-    . S $P(RTN(ZZI),"^",1)=ZZI ; INDEX FOR VARIABLE
-"RTN","C0CRIMA",396,0)
-    . S $P(RTN(ZZI),"^",2)=@ZZS@(ZZI,IVAR) ; THE VALUE OF THE VARIABLE
-"RTN","C0CRIMA",397,0)
-    Q
-"RTN","C0CRIMA",398,0)
-    ;
-"RTN","C0CRIMA",399,0)
-PATD(DFN,ISEC,IVAR) ; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR
-"RTN","C0CRIMA",400,0)
-    ;
-"RTN","C0CRIMA",401,0)
-    N ZR
-"RTN","C0CRIMA",402,0)
-    D GETPA(.ZR,DFN,ISEC,IVAR)
-"RTN","C0CRIMA",403,0)
-    I $D(ZR(0)) D PARY^C0CXPATH("ZR")
-"RTN","C0CRIMA",404,0)
-    E  W "NOTHING RETURNED",!
-"RTN","C0CRIMA",405,0)
-    Q
-"RTN","C0CRIMA",406,0)
-    ;
-"RTN","C0CRIMA",407,0)
-CAGET(RTN,IATTR) ;
-"RTN","C0CRIMA",408,0)
-    ; GETPA LOOKS AT RIMTBL TO FIND PATIENTS WITH ATTRIBUTE IATTR
-"RTN","C0CRIMA",409,0)
-    ; IT DOES NOT SEARCH ALL PATIENTS, ONLY THE ONES WITH THE ATTRIBUTE
-"RTN","C0CRIMA",410,0)
-    ; IT RETURNS AN ARRAY OF THE VALUES OF VARIABLE IVAR IN SECTION ISEC
-"RTN","C0CRIMA",411,0)
-    Q
-"RTN","C0CRIMA",412,0)
-    ;
-"RTN","C0CRIMA",413,0)
-PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
-"RTN","C0CRIMA",414,0)
-    ;
-"RTN","C0CRIMA",415,0)
-    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
-"RTN","C0CRIMA",416,0)
-    N ZLST
-"RTN","C0CRIMA",417,0)
-    S @LSTRTN@(0)=0 ; DEFAULT RETURN NONE
-"RTN","C0CRIMA",418,0)
-    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
-"RTN","C0CRIMA",419,0)
-    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
-"RTN","C0CRIMA",420,0)
-    N ZNC  ; ZNC IS NUMBER OF CATEGORIES
-"RTN","C0CRIMA",421,0)
-    S ZNC=@ZCBASE@(0)
-"RTN","C0CRIMA",422,0)
-    I ZNC=0 Q ; NO CATEGORIES TO SEARCH
-"RTN","C0CRIMA",423,0)
-    N ZAP  ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE
-"RTN","C0CRIMA",424,0)
-    S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR)
-"RTN","C0CRIMA",425,0)
-    N ZI,ZCATTBL,ZATBL,ZCNT,ZPAT
-"RTN","C0CRIMA",426,0)
-    F ZI=1:1:ZNC D  ; FOR ALL CATEGORIES
-"RTN","C0CRIMA",427,0)
-    . S ZATBL=@ZCBASE@(ZI) ; PULL OUT ATTR TBL FOR CAT
-"RTN","C0CRIMA",428,0)
-    . I $P(ZATBL,"^",ZAP)'="" D  ; CAT HAS ATTR
-"RTN","C0CRIMA",429,0)
-    . . S ZCATTBL=$P(@ZCBASE@(ZATBL),"^",1) ; NAME OF TBL
-"RTN","C0CRIMA",430,0)
-    . . M @LSTRTN=@ZPBASE@(ZCATTBL) ; MERGE PATS FROM CAT
-"RTN","C0CRIMA",431,0)
-    S ZCNT=0 ; INITIALIZE COUNT OF PATIENTS
-"RTN","C0CRIMA",432,0)
-    S ZPAT=0 ; START AT FIRST PATIENT IN LIST
-"RTN","C0CRIMA",433,0)
-    F  S ZPAT=$O(@LSTRTN@(ZPAT)) Q:ZPAT=""  D  ;
-"RTN","C0CRIMA",434,0)
-    . S ZCNT=ZCNT+1
-"RTN","C0CRIMA",435,0)
-    S @LSTRTN@(0)=ZCNT ; COUNT OF PATIENTS IN ARRAY
-"RTN","C0CRIMA",436,0)
-    Q
-"RTN","C0CRIMA",437,0)
-    ;
-"RTN","C0CRIMA",438,0)
-DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
-"RTN","C0CRIMA",439,0)
-    ;
-"RTN","C0CRIMA",440,0)
-    ;N ZR
-"RTN","C0CRIMA",441,0)
-    D PCLST("ZR",CATTR)
-"RTN","C0CRIMA",442,0)
-    I ZR(0)=0 D  Q  ;
-"RTN","C0CRIMA",443,0)
-    . W "NO PATIENTS RETURNED",!
-"RTN","C0CRIMA",444,0)
-    E  D  ;
-"RTN","C0CRIMA",445,0)
-    . N ZI S ZI=0
-"RTN","C0CRIMA",446,0)
-    . F  S ZI=$O(ZR(ZI)) Q:ZI=""  D  ;
-"RTN","C0CRIMA",447,0)
-    . . W !,ZI
-"RTN","C0CRIMA",448,0)
-    . ;D PARY^C0CXPATH("ZR") ; PRINT ARRAY
-"RTN","C0CRIMA",449,0)
-    . W !,"COUNT=",ZR(0)
-"RTN","C0CRIMA",450,0)
-    Q
-"RTN","C0CRIMA",451,0)
-    ;
-"RTN","C0CRIMA",452,0)
-RPCGV(RTN,DFN,WHICH) ; RPC GET VARS
-"RTN","C0CRIMA",453,0)
- ; RETURNS IN RTN (PASSED BY REFERENCE) THE VARS AND VALUES
-"RTN","C0CRIMA",454,0)
- ; FOUND AT INARY RTN(X)="VAR^VALUE" RTN(0) IS THE COUNT
-"RTN","C0CRIMA",455,0)
- ; DFN IS THE PATIENT NUMBER.
-"RTN","C0CRIMA",456,0)
- ; WHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS","IMMUNE"
-"RTN","C0CRIMA",457,0)
- ; OR OTHER SECTIONS AS THEY ARE ADDED
-"RTN","C0CRIMA",458,0)
- ; THIS IS MEANT TO BE AVAILABLE AS AN RPC
-"RTN","C0CRIMA",459,0)
- I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","C0CRIMA",460,0)
- S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
-"RTN","C0CRIMA",461,0)
- S RTN(0)=0 ; DEFAULT NOTHING IS RETURNED
-"RTN","C0CRIMA",462,0)
- N ZZGI
-"RTN","C0CRIMA",463,0)
- I WHICH="ALL" D  ; VARIABLES FROM ALL SECTIONS
-"RTN","C0CRIMA",464,0)
- . F ZZGI="HEADER","PROBLEMS","VITALS","MEDS","ALERTS","RESULTS","IMMUNE","PROCEDURES" D  ;
-"RTN","C0CRIMA",465,0)
- . . D ZGVWRK(ZZGI) ; DO EACH SECTION
-"RTN","C0CRIMA",466,0)
- . . I $G(DEBUG)'="" W "DID ",ZZGI,!
-"RTN","C0CRIMA",467,0)
- E  D ZGVWRK(WHICH) ; ONLY ONE SECTION ASKED FOR
-"RTN","C0CRIMA",468,0)
+"RTN","C0CRIMA",497,0)
+RIM2RNF(R2RTN,DFN,RWHICH) ; CONVERTS RIM VARIABLES TO RNF2 FORMAT
+"RTN","C0CRIMA",498,0)
+ ; RETURN IN R2RTN, WHICH IS PASSED BY NAME
+"RTN","C0CRIMA",499,0)
+ ; RWHICH IS RIM SECTION TO RETURN, DEFAULTS TO "ALL"
+"RTN","C0CRIMA",500,0)
+ ;
+"RTN","C0CRIMA",501,0)
+ I '$D(RWHICH) S RWHICH="ALL"
+"RTN","C0CRIMA",502,0)
+ ;N R2TMP
+"RTN","C0CRIMA",503,0)
+ I '$D(^TMP("C0CRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
+"RTN","C0CRIMA",504,0)
+ . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
+"RTN","C0CRIMA",505,0)
+ D RPCGV(.R2TMP,DFN,RWHICH) ; RETRIEVE ALL THE VARIABLES I AN ARRAY
+"RTN","C0CRIMA",506,0)
+ N R2I,R2J,R2X,R2X1,R2X2,R2Y,R2Z
+"RTN","C0CRIMA",507,0)
+ F R2I=1:1:R2TMP(0) D  ; FOR EVERY LINE OF THE ARRAY
+"RTN","C0CRIMA",508,0)
+ . S R2X=$P(R2TMP(R2I),"^",1) ; OCCURANCE
+"RTN","C0CRIMA",509,0)
+ . S R2Y=$P(R2TMP(R2I),"^",2) ; VARIABLE NAME
+"RTN","C0CRIMA",510,0)
+ . I $L(R2Y)<4 Q  ; SKIP SHORT VARIABLES (THEY ARE FOR DEBUGGING)
+"RTN","C0CRIMA",511,0)
+ . S R2Z=$P(R2TMP(R2I),"^",3) ; VALUE
+"RTN","C0CRIMA",512,0)
+ . I R2X[";" D  ; THERES MULTIPLES
+"RTN","C0CRIMA",513,0)
+ . . S R2X1=$P(R2X,";",1) ; FIRST INDEX
+"RTN","C0CRIMA",514,0)
+ . . S R2X2=$P(R2X,";",2) ; SECOND INDEX
+"RTN","C0CRIMA",515,0)
+ . . S R2J=R2Y_"["_R2X2_"]" ; BUILD THE VARIABLE NAME
+"RTN","C0CRIMA",516,0)
+ . . S @R2RTN@("F",R2J,1)="" ; PUT VARIABLE NAME IN FIELD MAP
+"RTN","C0CRIMA",517,0)
+ . . S @R2RTN@("V",R2X1,R2J,1)=R2Z ; PUT THE VALUE IN THE ARRAY
+"RTN","C0CRIMA",518,0)
+ . E  D  ; NO SUB-MULTIPLES
+"RTN","C0CRIMA",519,0)
+ . . S @R2RTN@("F",R2Y,1)="" ; PUT VARIABLE NAME IN FIELD MAP
+"RTN","C0CRIMA",520,0)
+ . . S @R2RTN@("V",R2X,R2Y,1)=R2Z ; PUT THE VALUE IN THE ARRAY
+"RTN","C0CRIMA",521,0)
  Q
-"RTN","C0CRIMA",469,0)
- ;
-"RTN","C0CRIMA",470,0)
-ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV
-"RTN","C0CRIMA",471,0)
-    ;
-"RTN","C0CRIMA",472,0)
-    N ZZGN ; NAME FOR SECTION VARIABLES
-"RTN","C0CRIMA",473,0)
-    S ZZGN=$NA(@ZVBASE@(DFN,ZWHICH)) ; BASE OF VARS FOR SECTION
-"RTN","C0CRIMA",474,0)
-    ;I '$D(@ZZGN@(0)) Q ; NO VARS FOR THIS SECTION
-"RTN","C0CRIMA",475,0)
-    I $O(@ZZGN@(""),-1)=""  D  ;
-"RTN","C0CRIMA",476,0)
-    E  D  ; VARS EXIST
-"RTN","C0CRIMA",477,0)
-    . N ZGVI,ZGVN
-"RTN","C0CRIMA",478,0)
-    . S ZGVN=$O(@ZZGN@(""),-1) ;COUNT OF VARS
-"RTN","C0CRIMA",479,0)
-    . F ZGVI=1:1:ZGVN D  ; FOR EACH MULTIPLE IN SECTION
-"RTN","C0CRIMA",480,0)
-    . . K ZZGA N ZZGA ; TEMP ARRAY FOR SECTION VARS
-"RTN","C0CRIMA",481,0)
-    . . K ZZGN2 N ZZGN2 ; NAME FOR MULTIPLE
-"RTN","C0CRIMA",482,0)
-    . . S ZZGN2=$NA(@ZZGN@(ZGVI))
-"RTN","C0CRIMA",483,0)
-    . . I $G(DEBUG)'="" W ZZGN2,!,$O(@ZZGN2@("")),!
-"RTN","C0CRIMA",484,0)
-    . . D H2ARY^C0CXPATH("ZZGA",ZZGN2,ZGVI) ; CONVERT HASH TO ARRAY
-"RTN","C0CRIMA",485,0)
-    . . ; D PARY^C0CXPATH("ZZGA")
-"RTN","C0CRIMA",486,0)
-    . . D PUSHA^C0CXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN
-"RTN","C0CRIMA",487,0)
-    Q
-"RTN","C0CRIMA",488,0)
-    ;
-"RTN","C0CRIMA",489,0)
-DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN C0CRIM
-"RTN","C0CRIMA",490,0)
-    ; ALONG WITH SAMPLE VALUES.
-"RTN","C0CRIMA",491,0)
-    ; IWHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS","HEADER"
-"RTN","C0CRIMA",492,0)
-    N GTMP
-"RTN","C0CRIMA",493,0)
-    I '$D(^TMP("C0CRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
-"RTN","C0CRIMA",494,0)
-    . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
-"RTN","C0CRIMA",495,0)
-    I '$D(IWHICH) S IWHICH="ALL"
-"RTN","C0CRIMA",496,0)
-    D RPCGV(.GTMP,DFN,IWHICH)
-"RTN","C0CRIMA",497,0)
-    D PARY^C0CXPATH("GTMP")
-"RTN","C0CRIMA",498,0)
-    Q
-"RTN","C0CRIMA",499,0)
-    ;
-"RTN","C0CRIMA",500,0)
-RIM2RNF(R2RTN,DFN,RWHICH) ; CONVERTS RIM VARIABLES TO RNF2 FORMAT
-"RTN","C0CRIMA",501,0)
- ; RETURN IN R2RTN, WHICH IS PASSED BY NAME
-"RTN","C0CRIMA",502,0)
- ; RWHICH IS RIM SECTION TO RETURN, DEFAULTS TO "ALL"
-"RTN","C0CRIMA",503,0)
- ;
-"RTN","C0CRIMA",504,0)
- I '$D(RWHICH) S RWHICH="ALL"
-"RTN","C0CRIMA",505,0)
- ;N R2TMP
-"RTN","C0CRIMA",506,0)
- I '$D(^TMP("C0CRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
-"RTN","C0CRIMA",507,0)
- . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
-"RTN","C0CRIMA",508,0)
- D RPCGV(.R2TMP,DFN,RWHICH) ; RETRIEVE ALL THE VARIABLES I AN ARRAY
-"RTN","C0CRIMA",509,0)
- N R2I,R2J,R2X,R2X1,R2X2,R2Y,R2Z
-"RTN","C0CRIMA",510,0)
- F R2I=1:1:R2TMP(0) D  ; FOR EVERY LINE OF THE ARRAY
-"RTN","C0CRIMA",511,0)
- . S R2X=$P(R2TMP(R2I),"^",1) ; OCCURANCE
-"RTN","C0CRIMA",512,0)
- . S R2Y=$P(R2TMP(R2I),"^",2) ; VARIABLE NAME
-"RTN","C0CRIMA",513,0)
- . I $L(R2Y)<4 Q  ; SKIP SHORT VARIABLES (THEY ARE FOR DEBUGGING)
-"RTN","C0CRIMA",514,0)
- . S R2Z=$P(R2TMP(R2I),"^",3) ; VALUE
-"RTN","C0CRIMA",515,0)
- . I R2X[";" D  ; THERES MULTIPLES
-"RTN","C0CRIMA",516,0)
- . . S R2X1=$P(R2X,";",1) ; FIRST INDEX
-"RTN","C0CRIMA",517,0)
- . . S R2X2=$P(R2X,";",2) ; SECOND INDEX
-"RTN","C0CRIMA",518,0)
- . . S R2J=R2Y_"["_R2X2_"]" ; BUILD THE VARIABLE NAME
-"RTN","C0CRIMA",519,0)
- . . S @R2RTN@("F",R2J,1)="" ; PUT VARIABLE NAME IN FIELD MAP
-"RTN","C0CRIMA",520,0)
- . . S @R2RTN@("V",R2X1,R2J,1)=R2Z ; PUT THE VALUE IN THE ARRAY
-"RTN","C0CRIMA",521,0)
- . E  D  ; NO SUB-MULTIPLES
 "RTN","C0CRIMA",522,0)
- . . S @R2RTN@("F",R2Y,1)="" ; PUT VARIABLE NAME IN FIELD MAP
+ ;
 "RTN","C0CRIMA",523,0)
- . . S @R2RTN@("V",R2X,R2Y,1)=R2Z ; PUT THE VALUE IN THE ARRAY
+RIM2CSV(DFN) ; WRITE THE RIM VARIABLES FOR A PATIENT TO A CSV FILE
 "RTN","C0CRIMA",524,0)
+ ;
+"RTN","C0CRIMA",525,0)
+ N R2CTMP,R2CARY
+"RTN","C0CRIMA",526,0)
+ D RIM2RNF("R2CTMP",DFN) ; CONVERT VARIABLES TO RNF FORMAT
+"RTN","C0CRIMA",527,0)
+ D RNF2CSV^C0CRNF("R2CARY","R2CTMP","NV") ; CONVERT RNF TO CSV FORMAT
+"RTN","C0CRIMA",528,0)
+ D FILEOUT^C0CRNF("R2CARY","VARS-"_DFN_".csv")
+"RTN","C0CRIMA",529,0)
  Q
-"RTN","C0CRIMA",525,0)
- ;
-"RTN","C0CRIMA",526,0)
-RIM2CSV(DFN) ; WRITE THE RIM VARIABLES FOR A PATIENT TO A CSV FILE
-"RTN","C0CRIMA",527,0)
- ;
-"RTN","C0CRIMA",528,0)
- N R2CTMP,R2CARY
-"RTN","C0CRIMA",529,0)
- D RIM2RNF("R2CTMP",DFN) ; CONVERT VARIABLES TO RNF FORMAT
 "RTN","C0CRIMA",530,0)
- D RNF2CSV^C0CRNF("R2CARY","R2CTMP","NV") ; CONVERT RNF TO CSV FORMAT
-"RTN","C0CRIMA",531,0)
- D FILEOUT^C0CRNF("R2CARY","VARS-"_DFN_".csv")
-"RTN","C0CRIMA",532,0)
- Q
-"RTN","C0CRIMA",533,0)
  ;
 "RTN","C0CRNF")
-0^23^B195772222
+0^23^B194328331
 "RTN","C0CRNF",1,0)
 C0CRNF   ; CCDCCR/GPL - Reference Name Format (RNF) utilities; 12/6/08
 "RTN","C0CRNF",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CRNF",3,0)
- ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
+ ;Copyright 2009 George Lilly.  
 "RTN","C0CRNF",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CRNF",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CRNF",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CRNF",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CRNF",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CRNF",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CRNF",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CRNF",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CRNF",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CRNF",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CRNF",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CRNF",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CRNF",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CRNF",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CRNF",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ W "This is the Reference Name Format (RNF) Utility Library ",!
 "RTN","C0CRNF",19,0)
- ;
+ W !
 "RTN","C0CRNF",20,0)
- W "This is the Reference Name Format (RNF) Utility Library ",!
+ Q
 "RTN","C0CRNF",21,0)
- W !
+ ;
 "RTN","C0CRNF",22,0)
+FIELDS(C0CFRTN,C0CF) ; RETURNS AN ARRAY OF THE FIELDS IN FILE C0CF,
+"RTN","C0CRNF",23,0)
+ ; C0CFRTN IS PASSED BY NAME, C0CF IS PASSED BY VALUE
+"RTN","C0CRNF",24,0)
+ ;
+"RTN","C0CRNF",25,0)
+ N C0CFI,C0CFJ ;INNER LOOP, OUTER LOOP
+"RTN","C0CRNF",26,0)
+ N C0CFN ; FIELD NAME
+"RTN","C0CRNF",27,0)
+ S C0CFI=0 S C0CFJ=C0CF
+"RTN","C0CRNF",28,0)
+ K @C0CFRTN ; CLEAR THE RETURN ARRAY
+"RTN","C0CRNF",29,0)
+ F  Q:C0CFJ'[C0CF  D  ; FOR THE C0CF FILE AND ALL SUBFILES INCLUSIVE
+"RTN","C0CRNF",30,0)
+ . ;W "1: "_C0CFJ," ",C0CFI,!
+"RTN","C0CRNF",31,0)
+ . F  S C0CFI=$O(^DD(C0CFJ,C0CFI)) Q:+C0CFI=0  D  ; EVERY FIELD
+"RTN","C0CRNF",32,0)
+ . . ;W "2: "_C0CFJ," ",C0CFI,!
+"RTN","C0CRNF",33,0)
+ . . S C0CFN=$P($G(^DD(C0CFJ,C0CFI,0)),"^",1) ;PULL FIELD NAME FROM ^DD
+"RTN","C0CRNF",34,0)
+ . . ;W "N: ",C0CFN,!
+"RTN","C0CRNF",35,0)
+ . . ;I C0CFN="STR" W C0CFN," ",C0CFJ,!
+"RTN","C0CRNF",36,0)
+ . . I $D(@C0CFRTN@(C0CFN)) D  ; IS THIS A DUPLICATE?
+"RTN","C0CRNF",37,0)
+ . . . I $G(DEBUG) D  ;
+"RTN","C0CRNF",38,0)
+ . . . . W "DUPLICATE FOUND! ",C0CFJ," ",C0CFI," ",C0CFN,!,@C0CFRTN@(C0CFN),!
+"RTN","C0CRNF",39,0)
+ . . . S @C0CFRTN@(C0CFN_"_"_C0CFJ)=C0CFJ_"^"_C0CFI
+"RTN","C0CRNF",40,0)
+ . . E  S @C0CFRTN@(C0CFN)=C0CFJ_"^"_C0CFI
+"RTN","C0CRNF",41,0)
+ . S C0CFJ=$O(^DD(C0CFJ)) ; NEXT SUBFILE
+"RTN","C0CRNF",42,0)
  Q
-"RTN","C0CRNF",23,0)
- ;
-"RTN","C0CRNF",24,0)
-FIELDS(C0CFRTN,C0CF) ; RETURNS AN ARRAY OF THE FIELDS IN FILE C0CF,
-"RTN","C0CRNF",25,0)
- ; C0CFRTN IS PASSED BY NAME, C0CF IS PASSED BY VALUE
-"RTN","C0CRNF",26,0)
- ;
-"RTN","C0CRNF",27,0)
- N C0CFI,C0CFJ ;INNER LOOP, OUTER LOOP
-"RTN","C0CRNF",28,0)
- N C0CFN ; FIELD NAME
-"RTN","C0CRNF",29,0)
- S C0CFI=0 S C0CFJ=C0CF
-"RTN","C0CRNF",30,0)
- K @C0CFRTN ; CLEAR THE RETURN ARRAY
-"RTN","C0CRNF",31,0)
- F  Q:C0CFJ'[C0CF  D ; FOR THE C0CF FILE AND ALL SUBFILES INCLUSIVE
-"RTN","C0CRNF",32,0)
- . ;W "1: "_C0CFJ," ",C0CFI,!
-"RTN","C0CRNF",33,0)
- . F  S C0CFI=$O(^DD(C0CFJ,C0CFI)) Q:+C0CFI=0  D  ; EVERY FIELD
-"RTN","C0CRNF",34,0)
- . . ;W "2: "_C0CFJ," ",C0CFI,!
-"RTN","C0CRNF",35,0)
- . . S C0CFN=$P($G(^DD(C0CFJ,C0CFI,0)),"^",1) ;PULL FIELD NAME FROM ^DD
-"RTN","C0CRNF",36,0)
- . . ;W "N: ",C0CFN,!
-"RTN","C0CRNF",37,0)
- . . ;I C0CFN="STR" W C0CFN," ",C0CFJ,!
-"RTN","C0CRNF",38,0)
- . . I $D(@C0CFRTN@(C0CFN)) D  ; IS THIS A DUPLICATE?
-"RTN","C0CRNF",39,0)
- . . . I $G(DEBUG) D  ;
-"RTN","C0CRNF",40,0)
- . . . . W "DUPLICATE FOUND! ",C0CFJ," ",C0CFI," ",C0CFN,!,@C0CFRTN@(C0CFN),!
-"RTN","C0CRNF",41,0)
- . . . S @C0CFRTN@(C0CFN_"_"_C0CFJ)=C0CFJ_"^"_C0CFI
-"RTN","C0CRNF",42,0)
- . . E  S @C0CFRTN@(C0CFN)=C0CFJ_"^"_C0CFI
 "RTN","C0CRNF",43,0)
- . S C0CFJ=$O(^DD(C0CFJ)) ; NEXT SUBFILE
+ ;
 "RTN","C0CRNF",44,0)
+TESTRNF ; TEST THE RNF1TO2 ROUTINE
+"RTN","C0CRNF",45,0)
+ S G1("ONE")=1
+"RTN","C0CRNF",46,0)
+ S G1("TWO")=2
+"RTN","C0CRNF",47,0)
+ S G1("THREE")=3
+"RTN","C0CRNF",48,0)
+ D RNF1TO2("GPL","G1")
+"RTN","C0CRNF",49,0)
+ S G1("ONE")="NOT1"
+"RTN","C0CRNF",50,0)
+ S G1("TWO")="STILL2"
+"RTN","C0CRNF",51,0)
+ S G1("THREE")=3
+"RTN","C0CRNF",52,0)
+ D RNF1TO2("GPL","G1")
+"RTN","C0CRNF",53,0)
+ ; ZWR GPL
+"RTN","C0CRNF",54,0)
  Q
-"RTN","C0CRNF",45,0)
- ;
-"RTN","C0CRNF",46,0)
-TESTRNF ; TEST THE RNF1TO2 ROUTINE
-"RTN","C0CRNF",47,0)
- S G1("ONE")=1
-"RTN","C0CRNF",48,0)
- S G1("TWO")=2
-"RTN","C0CRNF",49,0)
- S G1("THREE")=3
-"RTN","C0CRNF",50,0)
- D RNF1TO2("GPL","G1")
-"RTN","C0CRNF",51,0)
- S G1("ONE")="NOT1"
-"RTN","C0CRNF",52,0)
- S G1("TWO")="STILL2"
-"RTN","C0CRNF",53,0)
- S G1("THREE")=3
-"RTN","C0CRNF",54,0)
- D RNF1TO2("GPL","G1")
 "RTN","C0CRNF",55,0)
- ZWR GPL
+ ;
 "RTN","C0CRNF",56,0)
+RNF1TO2(ZOUT,ZIN) ; ADDS AN RNF1 ARRAY (ZIN) TO THE END OF AN RNF2 ARRAY 
+"RTN","C0CRNF",57,0)
+ ; (ZOUT) BOTH ARE PASSED BY NAME
+"RTN","C0CRNF",58,0)
+ ; RNF1 IS OF THE FORM:
+"RTN","C0CRNF",59,0)
+ ; @ZIN@("VAR1")=VAL1 
+"RTN","C0CRNF",60,0)
+ ; @ZIN@("VAR2")=VAL2 
+"RTN","C0CRNF",61,0)
+ ; RNF2 IS OF THE FORM:
+"RTN","C0CRNF",62,0)
+ ; @ZOUT@("F","VAR1")=""
+"RTN","C0CRNF",63,0)
+ ; @ZOUT@("F","VAR2")=""
+"RTN","C0CRNF",64,0)
+ ; @ZOUT@("V",n,"VAR1")=VAL1
+"RTN","C0CRNF",65,0)
+ ; @ZOUT@("V",n,"VAR2")=VAL2
+"RTN","C0CRNF",66,0)
+ ; WHERE n IS THE "ROW" OF THE ARRAY
+"RTN","C0CRNF",67,0)
+ N ZI S ZI=""
+"RTN","C0CRNF",68,0)
+ N ZN
+"RTN","C0CRNF",69,0)
+ I '$D(@ZOUT@("V",1)) S ZN=1
+"RTN","C0CRNF",70,0)
+ E  S ZN=$O(@ZOUT@("V",""),-1)+1
+"RTN","C0CRNF",71,0)
+ F  S ZI=$O(@ZIN@(ZI)) Q:ZI=""  D  ;
+"RTN","C0CRNF",72,0)
+ . S @ZOUT@("F",ZI)=""
+"RTN","C0CRNF",73,0)
+ . S @ZOUT@("V",ZN,ZI)=@ZIN@(ZI)
+"RTN","C0CRNF",74,0)
  Q
-"RTN","C0CRNF",57,0)
- ;
-"RTN","C0CRNF",58,0)
-RNF1TO2(ZOUT,ZIN) ; ADDS AN RNF1 ARRAY (ZIN) TO THE END OF AN RNF2 ARRAY 
-"RTN","C0CRNF",59,0)
+"RTN","C0CRNF",75,0)
+ ;
+"RTN","C0CRNF",76,0)
+RNF1TO2B(ZOUT,ZIN) ; ADDS AN RNF1 ARRAY (ZIN) TO THE END OF AN RNF2 ARRAY 
+"RTN","C0CRNF",77,0)
+ ; THE "B" ROUTINE SUPPORTS WP FIELDS IN THE ARRAY
+"RTN","C0CRNF",78,0)
+ ; EVERY "V" VARIABLE IS FOLLOWED BY A "1"
+"RTN","C0CRNF",79,0)
+ ; FOR EXAMPLE @G@("V",n,"VAR1",1)="VALUE1"
+"RTN","C0CRNF",80,0)
+ ; USE THIS ROUTINE IF YOU WANT TO CONVERT THE RESULT TO A CSV 
+"RTN","C0CRNF",81,0)
+ ; WITH RNF2CSV 
+"RTN","C0CRNF",82,0)
  ; (ZOUT) BOTH ARE PASSED BY NAME
-"RTN","C0CRNF",60,0)
+"RTN","C0CRNF",83,0)
  ; RNF1 IS OF THE FORM:
-"RTN","C0CRNF",61,0)
+"RTN","C0CRNF",84,0)
  ; @ZIN@("VAR1")=VAL1 
-"RTN","C0CRNF",62,0)
+"RTN","C0CRNF",85,0)
  ; @ZIN@("VAR2")=VAL2 
-"RTN","C0CRNF",63,0)
+"RTN","C0CRNF",86,0)
  ; RNF2 IS OF THE FORM:
-"RTN","C0CRNF",64,0)
+"RTN","C0CRNF",87,0)
  ; @ZOUT@("F","VAR1")=""
-"RTN","C0CRNF",65,0)
+"RTN","C0CRNF",88,0)
  ; @ZOUT@("F","VAR2")=""
-"RTN","C0CRNF",66,0)
- ; @ZOUT@("V",n,"VAR1")=VAL1
-"RTN","C0CRNF",67,0)
- ; @ZOUT@("V",n,"VAR2")=VAL2
-"RTN","C0CRNF",68,0)
+"RTN","C0CRNF",89,0)
+ ; @ZOUT@("V",n,"VAR1",1)=VAL1
+"RTN","C0CRNF",90,0)
+ ; @ZOUT@("V",n,"VAR2",1)=VAL2
+"RTN","C0CRNF",91,0)
  ; WHERE n IS THE "ROW" OF THE ARRAY
-"RTN","C0CRNF",69,0)
+"RTN","C0CRNF",92,0)
  N ZI S ZI=""
-"RTN","C0CRNF",70,0)
+"RTN","C0CRNF",93,0)
  N ZN
-"RTN","C0CRNF",71,0)
+"RTN","C0CRNF",94,0)
  I '$D(@ZOUT@("V",1)) S ZN=1
-"RTN","C0CRNF",72,0)
+"RTN","C0CRNF",95,0)
  E  S ZN=$O(@ZOUT@("V",""),-1)+1
-"RTN","C0CRNF",73,0)
+"RTN","C0CRNF",96,0)
  F  S ZI=$O(@ZIN@(ZI)) Q:ZI=""  D  ;
-"RTN","C0CRNF",74,0)
+"RTN","C0CRNF",97,0)
  . S @ZOUT@("F",ZI)=""
-"RTN","C0CRNF",75,0)
- . S @ZOUT@("V",ZN,ZI)=@ZIN@(ZI)
-"RTN","C0CRNF",76,0)
+"RTN","C0CRNF",98,0)
+ . S @ZOUT@("V",ZN,ZI,1)=@ZIN@(ZI)
+"RTN","C0CRNF",99,0)
  Q
-"RTN","C0CRNF",77,0)
- ;
-"RTN","C0CRNF",78,0)
-RNF1TO2B(ZOUT,ZIN) ; ADDS AN RNF1 ARRAY (ZIN) TO THE END OF AN RNF2 ARRAY 
-"RTN","C0CRNF",79,0)
- ; THE "B" ROUTINE SUPPORTS WP FIELDS IN THE ARRAY
-"RTN","C0CRNF",80,0)
- ; EVERY "V" VARIABLE IS FOLLOWED BY A "1"
-"RTN","C0CRNF",81,0)
- ; FOR EXAMPLE @G@("V",n,"VAR1",1)="VALUE1"
-"RTN","C0CRNF",82,0)
- ; USE THIS ROUTINE IF YOU WANT TO CONVERT THE RESULT TO A CSV 
-"RTN","C0CRNF",83,0)
- ; WITH RNF2CSV 
-"RTN","C0CRNF",84,0)
- ; (ZOUT) BOTH ARE PASSED BY NAME
-"RTN","C0CRNF",85,0)
- ; RNF1 IS OF THE FORM:
-"RTN","C0CRNF",86,0)
- ; @ZIN@("VAR1")=VAL1 
-"RTN","C0CRNF",87,0)
- ; @ZIN@("VAR2")=VAL2 
-"RTN","C0CRNF",88,0)
- ; RNF2 IS OF THE FORM:
-"RTN","C0CRNF",89,0)
- ; @ZOUT@("F","VAR1")=""
-"RTN","C0CRNF",90,0)
- ; @ZOUT@("F","VAR2")=""
-"RTN","C0CRNF",91,0)
- ; @ZOUT@("V",n,"VAR1",1)=VAL1
-"RTN","C0CRNF",92,0)
- ; @ZOUT@("V",n,"VAR2",1)=VAL2
-"RTN","C0CRNF",93,0)
- ; WHERE n IS THE "ROW" OF THE ARRAY
-"RTN","C0CRNF",94,0)
- N ZI S ZI=""
-"RTN","C0CRNF",95,0)
- N ZN
-"RTN","C0CRNF",96,0)
- I '$D(@ZOUT@("V",1)) S ZN=1
-"RTN","C0CRNF",97,0)
- E  S ZN=$O(@ZOUT@("V",""),-1)+1
-"RTN","C0CRNF",98,0)
- F  S ZI=$O(@ZIN@(ZI)) Q:ZI=""  D  ;
-"RTN","C0CRNF",99,0)
- . S @ZOUT@("F",ZI)=""
 "RTN","C0CRNF",100,0)
- . S @ZOUT@("V",ZN,ZI,1)=@ZIN@(ZI)
+ ;
 "RTN","C0CRNF",101,0)
+GETNOLD(GRTN,GFILE,GIEN,GNN) ; GET FIELDS FOR ACCESS BY NAME
+"RTN","C0CRNF",102,0)
+ ; GRTN IS PASSED BY NAME
+"RTN","C0CRNF",103,0)
+ ;
+"RTN","C0CRNF",104,0)
+ N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
+"RTN","C0CRNF",105,0)
+ I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
+"RTN","C0CRNF",106,0)
+ E  S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
+"RTN","C0CRNF",107,0)
+ S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
+"RTN","C0CRNF",108,0)
+ D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
+"RTN","C0CRNF",109,0)
+ D GETS^DIQ(GFILE,C0CREF,"**","I","C0CTMP")
+"RTN","C0CRNF",110,0)
+ D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
+"RTN","C0CRNF",111,0)
+ S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J ; STRUCTURE SIGNATURE
+"RTN","C0CRNF",112,0)
+ S (C0CI,C0CJ)=""
+"RTN","C0CRNF",113,0)
+ F  S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ=""  D  ; FOR ALL SUBFILES
+"RTN","C0CRNF",114,0)
+ . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
+"RTN","C0CRNF",115,0)
+ . F  S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI=""  D  ; ARRAY OF FIELDS
+"RTN","C0CRNF",116,0)
+ . . ;W C0CJ," ",C0CI,!
+"RTN","C0CRNF",117,0)
+ . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
+"RTN","C0CRNF",118,0)
+ . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI) ;
+"RTN","C0CRNF",119,0)
+ . . I C0CVALUE["C0CTMP" S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,1) ;1ST LINE OF WP
+"RTN","C0CRNF",120,0)
+ . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
+"RTN","C0CRNF",121,0)
+ I C0CNN D  ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
+"RTN","C0CRNF",122,0)
+ . S C0CI=""
+"RTN","C0CRNF",123,0)
+ . F  S C0CI=$O(@GRTN@(C0CI)) Q:C0CI=""  D  ; GO THROUGH THE WHOLE ARRAY
+"RTN","C0CRNF",124,0)
+ . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
+"RTN","C0CRNF",125,0)
  Q
-"RTN","C0CRNF",102,0)
- ;
-"RTN","C0CRNF",103,0)
-GETNOLD(GRTN,GFILE,GIEN,GNN) ; GET FIELDS FOR ACCESS BY NAME
-"RTN","C0CRNF",104,0)
- ; GRTN IS PASSED BY NAME
-"RTN","C0CRNF",105,0)
- ;
-"RTN","C0CRNF",106,0)
- N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
-"RTN","C0CRNF",107,0)
+"RTN","C0CRNF",126,0)
+ ;
+"RTN","C0CRNF",127,0)
+GETN(GRTN,GFILE,GREF,GNDX,GNN) ; GET BY NAME ; RETURN A FIELD VALUE MAP
+"RTN","C0CRNF",128,0)
+ ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
+"RTN","C0CRNF",129,0)
+ ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
+"RTN","C0CRNF",130,0)
+ ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
+"RTN","C0CRNF",131,0)
+ ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
+"RTN","C0CRNF",132,0)
+ ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
+"RTN","C0CRNF",133,0)
+ ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
+"RTN","C0CRNF",134,0)
+ ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
+"RTN","C0CRNF",135,0)
+ ; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
+"RTN","C0CRNF",136,0)
+ ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
+"RTN","C0CRNF",137,0)
+ ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
+"RTN","C0CRNF",138,0)
+ ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
+"RTN","C0CRNF",139,0)
+ ; IF GREF IS "" THE FIRST RECORD IS OBTAINED
+"RTN","C0CRNF",140,0)
+ ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
+"RTN","C0CRNF",141,0)
+ ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
+"RTN","C0CRNF",142,0)
+ ; GREF IS THE VALUE FOR THE INDEX
+"RTN","C0CRNF",143,0)
+ ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
+"RTN","C0CRNF",144,0)
+ ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
+"RTN","C0CRNF",145,0)
+ ;
+"RTN","C0CRNF",146,0)
+ ;
+"RTN","C0CRNF",147,0)
+ N GIEN,GF
+"RTN","C0CRNF",148,0)
+ S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE
+"RTN","C0CRNF",149,0)
+ I ('$D(GNDX))!($G(GNDX)="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN
+"RTN","C0CRNF",150,0)
+ E  D  ; WE ARE USING AN INDEX
+"RTN","C0CRNF",151,0)
+ . ;N ZG
+"RTN","C0CRNF",152,0)
+ . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX
+"RTN","C0CRNF",153,0)
+ . I ZG'="" D  ;
+"RTN","C0CRNF",154,0)
+ . . I $QS(ZG,3)=GREF D  ; IS GREF IN INDEX?
+"RTN","C0CRNF",155,0)
+ . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN
+"RTN","C0CRNF",156,0)
+ . . E  S GIEN="" ; NOT FOUND IN INDEX
+"RTN","C0CRNF",157,0)
+ . E  S GIEN="" ;
+"RTN","C0CRNF",158,0)
+ ;W "IEN: ",GIEN,!
+"RTN","C0CRNF",159,0)
+ ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
+"RTN","C0CRNF",160,0)
  I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
-"RTN","C0CRNF",108,0)
+"RTN","C0CRNF",161,0)
  E  S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
-"RTN","C0CRNF",109,0)
+"RTN","C0CRNF",162,0)
  S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
-"RTN","C0CRNF",110,0)
+"RTN","C0CRNF",163,0)
  D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
-"RTN","C0CRNF",111,0)
- D GETS^DIQ(GFILE,C0CREF,"**","I","C0CTMP")
-"RTN","C0CRNF",112,0)
+"RTN","C0CRNF",164,0)
+ K C0CTMP
+"RTN","C0CRNF",165,0)
+ D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
+"RTN","C0CRNF",166,0)
  D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
-"RTN","C0CRNF",113,0)
- S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J ; STRUCTURE SIGNATURE
-"RTN","C0CRNF",114,0)
+"RTN","C0CRNF",167,0)
+ S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
+"RTN","C0CRNF",168,0)
  S (C0CI,C0CJ)=""
-"RTN","C0CRNF",115,0)
+"RTN","C0CRNF",169,0)
  F  S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ=""  D  ; FOR ALL SUBFILES
-"RTN","C0CRNF",116,0)
+"RTN","C0CRNF",170,0)
  . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
-"RTN","C0CRNF",117,0)
+"RTN","C0CRNF",171,0)
  . F  S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI=""  D  ; ARRAY OF FIELDS
-"RTN","C0CRNF",118,0)
+"RTN","C0CRNF",172,0)
  . . ;W C0CJ," ",C0CI,!
-"RTN","C0CRNF",119,0)
+"RTN","C0CRNF",173,0)
  . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
-"RTN","C0CRNF",120,0)
- . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI) ;
-"RTN","C0CRNF",121,0)
- . . I C0CVALUE["C0CTMP" S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,1) ;1ST LINE OF WP
-"RTN","C0CRNF",122,0)
+"RTN","C0CRNF",174,0)
+ . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
+"RTN","C0CRNF",175,0)
+ . . I C0CVALUE["C0CTMP" D  ; WP FIELD
+"RTN","C0CRNF",176,0)
+ . . . N ZT,ZWP S ZWP=0 ;ITERATOR
+"RTN","C0CRNF",177,0)
+ . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
+"RTN","C0CRNF",178,0)
+ . . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE
+"RTN","C0CRNF",179,0)
+ . . . F  S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP  D  ;
+"RTN","C0CRNF",180,0)
+ . . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP
+"RTN","C0CRNF",181,0)
+ . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
+"RTN","C0CRNF",182,0)
+ . . . . S C0CVALUE=C0CVALUE_ZT ;
+"RTN","C0CRNF",183,0)
  . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
-"RTN","C0CRNF",123,0)
+"RTN","C0CRNF",184,0)
+ . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I"))
+"RTN","C0CRNF",185,0)
  I C0CNN D  ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
-"RTN","C0CRNF",124,0)
+"RTN","C0CRNF",186,0)
  . S C0CI=""
-"RTN","C0CRNF",125,0)
+"RTN","C0CRNF",187,0)
  . F  S C0CI=$O(@GRTN@(C0CI)) Q:C0CI=""  D  ; GO THROUGH THE WHOLE ARRAY
-"RTN","C0CRNF",126,0)
+"RTN","C0CRNF",188,0)
  . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
-"RTN","C0CRNF",127,0)
+"RTN","C0CRNF",189,0)
  Q
-"RTN","C0CRNF",128,0)
- ;
-"RTN","C0CRNF",129,0)
-GETN(GRTN,GFILE,GREF,GNDX,GNN) ; GET BY NAME ; RETURN A FIELD VALUE MAP
-"RTN","C0CRNF",130,0)
+"RTN","C0CRNF",190,0)
+ ;
+"RTN","C0CRNF",191,0)
+GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP
+"RTN","C0CRNF",192,0)
  ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
-"RTN","C0CRNF",131,0)
+"RTN","C0CRNF",193,0)
  ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
-"RTN","C0CRNF",132,0)
+"RTN","C0CRNF",194,0)
  ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
-"RTN","C0CRNF",133,0)
+"RTN","C0CRNF",195,0)
  ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
-"RTN","C0CRNF",134,0)
+"RTN","C0CRNF",196,0)
  ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
-"RTN","C0CRNF",135,0)
+"RTN","C0CRNF",197,0)
  ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
-"RTN","C0CRNF",136,0)
+"RTN","C0CRNF",198,0)
  ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
-"RTN","C0CRNF",137,0)
+"RTN","C0CRNF",199,0)
  ; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
-"RTN","C0CRNF",138,0)
+"RTN","C0CRNF",200,0)
  ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
-"RTN","C0CRNF",139,0)
+"RTN","C0CRNF",201,0)
  ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
-"RTN","C0CRNF",140,0)
+"RTN","C0CRNF",202,0)
  ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
-"RTN","C0CRNF",141,0)
+"RTN","C0CRNF",203,0)
  ; IF GREF IS "" THE FIRST RECORD IS OBTAINED
-"RTN","C0CRNF",142,0)
+"RTN","C0CRNF",204,0)
  ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
-"RTN","C0CRNF",143,0)
+"RTN","C0CRNF",205,0)
  ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
-"RTN","C0CRNF",144,0)
+"RTN","C0CRNF",206,0)
  ; GREF IS THE VALUE FOR THE INDEX
-"RTN","C0CRNF",145,0)
+"RTN","C0CRNF",207,0)
  ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
-"RTN","C0CRNF",146,0)
+"RTN","C0CRNF",208,0)
  ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
-"RTN","C0CRNF",147,0)
- ;
-"RTN","C0CRNF",148,0)
- ;
-"RTN","C0CRNF",149,0)
+"RTN","C0CRNF",209,0)
+ ;
+"RTN","C0CRNF",210,0)
+ ;
+"RTN","C0CRNF",211,0)
  N GIEN,GF
-"RTN","C0CRNF",150,0)
+"RTN","C0CRNF",212,0)
  S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE
-"RTN","C0CRNF",151,0)
- I ('$D(GNDX))!($G(GNDX)="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN
-"RTN","C0CRNF",152,0)
+"RTN","C0CRNF",213,0)
+ I ('$D(GNDX))!(GNDX="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN
+"RTN","C0CRNF",214,0)
  E  D  ; WE ARE USING AN INDEX
-"RTN","C0CRNF",153,0)
+"RTN","C0CRNF",215,0)
  . ;N ZG
-"RTN","C0CRNF",154,0)
+"RTN","C0CRNF",216,0)
  . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX
-"RTN","C0CRNF",155,0)
+"RTN","C0CRNF",217,0)
  . I ZG'="" D  ;
-"RTN","C0CRNF",156,0)
+"RTN","C0CRNF",218,0)
  . . I $QS(ZG,3)=GREF D  ; IS GREF IN INDEX?
-"RTN","C0CRNF",157,0)
+"RTN","C0CRNF",219,0)
  . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN
-"RTN","C0CRNF",158,0)
+"RTN","C0CRNF",220,0)
  . . E  S GIEN="" ; NOT FOUND IN INDEX
-"RTN","C0CRNF",159,0)
+"RTN","C0CRNF",221,0)
  . E  S GIEN="" ;
-"RTN","C0CRNF",160,0)
+"RTN","C0CRNF",222,0)
  ;W "IEN: ",GIEN,!
-"RTN","C0CRNF",161,0)
+"RTN","C0CRNF",223,0)
  ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
-"RTN","C0CRNF",162,0)
+"RTN","C0CRNF",224,0)
  I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
-"RTN","C0CRNF",163,0)
+"RTN","C0CRNF",225,0)
  E  S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
-"RTN","C0CRNF",164,0)
+"RTN","C0CRNF",226,0)
  S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
-"RTN","C0CRNF",165,0)
+"RTN","C0CRNF",227,0)
  D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
-"RTN","C0CRNF",166,0)
+"RTN","C0CRNF",228,0)
  K C0CTMP
-"RTN","C0CRNF",167,0)
+"RTN","C0CRNF",229,0)
  D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
-"RTN","C0CRNF",168,0)
+"RTN","C0CRNF",230,0)
  D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
-"RTN","C0CRNF",169,0)
+"RTN","C0CRNF",231,0)
  S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
-"RTN","C0CRNF",170,0)
+"RTN","C0CRNF",232,0)
  S (C0CI,C0CJ)=""
-"RTN","C0CRNF",171,0)
+"RTN","C0CRNF",233,0)
  F  S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ=""  D  ; FOR ALL SUBFILES
-"RTN","C0CRNF",172,0)
+"RTN","C0CRNF",234,0)
  . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
-"RTN","C0CRNF",173,0)
+"RTN","C0CRNF",235,0)
  . F  S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI=""  D  ; ARRAY OF FIELDS
-"RTN","C0CRNF",174,0)
+"RTN","C0CRNF",236,0)
  . . ;W C0CJ," ",C0CI,!
-"RTN","C0CRNF",175,0)
+"RTN","C0CRNF",237,0)
  . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
-"RTN","C0CRNF",176,0)
+"RTN","C0CRNF",238,0)
  . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
-"RTN","C0CRNF",177,0)
+"RTN","C0CRNF",239,0)
  . . I C0CVALUE["C0CTMP" D  ; WP FIELD
-"RTN","C0CRNF",178,0)
+"RTN","C0CRNF",240,0)
  . . . N ZT,ZWP S ZWP=0 ;ITERATOR
-"RTN","C0CRNF",179,0)
+"RTN","C0CRNF",241,0)
  . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
-"RTN","C0CRNF",180,0)
+"RTN","C0CRNF",242,0)
  . . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE
-"RTN","C0CRNF",181,0)
+"RTN","C0CRNF",243,0)
  . . . F  S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP  D  ;
-"RTN","C0CRNF",182,0)
+"RTN","C0CRNF",244,0)
  . . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP
-"RTN","C0CRNF",183,0)
+"RTN","C0CRNF",245,0)
  . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
-"RTN","C0CRNF",184,0)
+"RTN","C0CRNF",246,0)
  . . . . S C0CVALUE=C0CVALUE_ZT ;
-"RTN","C0CRNF",185,0)
+"RTN","C0CRNF",247,0)
  . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
-"RTN","C0CRNF",186,0)
+"RTN","C0CRNF",248,0)
  . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I"))
-"RTN","C0CRNF",187,0)
+"RTN","C0CRNF",249,0)
  I C0CNN D  ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
-"RTN","C0CRNF",188,0)
+"RTN","C0CRNF",250,0)
  . S C0CI=""
-"RTN","C0CRNF",189,0)
+"RTN","C0CRNF",251,0)
  . F  S C0CI=$O(@GRTN@(C0CI)) Q:C0CI=""  D  ; GO THROUGH THE WHOLE ARRAY
-"RTN","C0CRNF",190,0)
+"RTN","C0CRNF",252,0)
  . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
-"RTN","C0CRNF",191,0)
+"RTN","C0CRNF",253,0)
  Q
-"RTN","C0CRNF",192,0)
- ;
-"RTN","C0CRNF",193,0)
-GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP
-"RTN","C0CRNF",194,0)
- ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
-"RTN","C0CRNF",195,0)
- ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
-"RTN","C0CRNF",196,0)
- ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
-"RTN","C0CRNF",197,0)
- ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
-"RTN","C0CRNF",198,0)
- ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
-"RTN","C0CRNF",199,0)
+"RTN","C0CRNF",254,0)
+ ;
+"RTN","C0CRNF",255,0)
+GETN2(GARTN,GAFILE,GAIDX,GACNT,GASTRT,GANN) ; RETURN FIELD MAP AND VALUES
+"RTN","C0CRNF",256,0)
+ ; GARTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
+"RTN","C0CRNF",257,0)
+ ; .. FIELD MAP @GARTN@("F","FIELDNAME")="FILE;FIELD#"
+"RTN","C0CRNF",258,0)
  ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
-"RTN","C0CRNF",200,0)
- ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
-"RTN","C0CRNF",201,0)
- ; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
-"RTN","C0CRNF",202,0)
- ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
-"RTN","C0CRNF",203,0)
- ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
-"RTN","C0CRNF",204,0)
+"RTN","C0CRNF",259,0)
+ ; .. VALUE MAP @GARTN@("V","IEN","FIELDNAME","N")=VALUE
+"RTN","C0CRNF",260,0)
+ ; .. WHERE N IS THE INDEX FOR MULTIPLES.. 1 FOR SINGLE VALUES
+"RTN","C0CRNF",261,0)
+ ; .. GARTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
+"RTN","C0CRNF",262,0)
+ ; .. IF GANN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
+"RTN","C0CRNF",263,0)
+ ; .. EVEN IF GANN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
+"RTN","C0CRNF",264,0)
  ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
-"RTN","C0CRNF",205,0)
- ; IF GREF IS "" THE FIRST RECORD IS OBTAINED
-"RTN","C0CRNF",206,0)
- ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
-"RTN","C0CRNF",207,0)
- ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
-"RTN","C0CRNF",208,0)
- ; GREF IS THE VALUE FOR THE INDEX
-"RTN","C0CRNF",209,0)
+"RTN","C0CRNF",265,0)
+ ; GAFILE IS THE FILE NUMBER TO BE PROCESSED. IT IS PASSED BY VALUE
+"RTN","C0CRNF",266,0)
+ ; GAIDX IS THE OPTIONAL INDEX TO USE IN THE FILE. IF GAIDX IS "" THE IEN
+"RTN","C0CRNF",267,0)
+ ; .. OF THE FILE WILL BE USED
+"RTN","C0CRNF",268,0)
+ ; GACNT IS THE NUMBER OF RECORDS TO PROCESS. IT IS PASSED BY VALUE
+"RTN","C0CRNF",269,0)
+ ; .. IF GARCNT IS NULL, ALL RECORDS ARE PROCESSED
+"RTN","C0CRNF",270,0)
+ ; GASTRT IS THE IEN OF THE FIRST RECORD TO PROCESS. IT IS PASSED BY VALUE
+"RTN","C0CRNF",271,0)
+ ; .. IF GARSTART IS NULL, PROCESSING STARTS AT THE FIRST RECORD
+"RTN","C0CRNF",272,0)
  ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
-"RTN","C0CRNF",210,0)
- ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
-"RTN","C0CRNF",211,0)
- ;
-"RTN","C0CRNF",212,0)
- ;
-"RTN","C0CRNF",213,0)
- N GIEN,GF
-"RTN","C0CRNF",214,0)
- S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE
-"RTN","C0CRNF",215,0)
- I ('$D(GNDX))!(GNDX="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN
-"RTN","C0CRNF",216,0)
- E  D  ; WE ARE USING AN INDEX
-"RTN","C0CRNF",217,0)
- . ;N ZG
-"RTN","C0CRNF",218,0)
- . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX
-"RTN","C0CRNF",219,0)
- . I ZG'="" D  ;
-"RTN","C0CRNF",220,0)
- . . I $QS(ZG,3)=GREF D  ; IS GREF IN INDEX?
-"RTN","C0CRNF",221,0)
- . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN
-"RTN","C0CRNF",222,0)
- . . E  S GIEN="" ; NOT FOUND IN INDEX
-"RTN","C0CRNF",223,0)
- . E  S GIEN="" ;
-"RTN","C0CRNF",224,0)
- ;W "IEN: ",GIEN,!
-"RTN","C0CRNF",225,0)
- ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
-"RTN","C0CRNF",226,0)
- I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
-"RTN","C0CRNF",227,0)
- E  S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
-"RTN","C0CRNF",228,0)
- S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
-"RTN","C0CRNF",229,0)
- D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
-"RTN","C0CRNF",230,0)
- K C0CTMP
-"RTN","C0CRNF",231,0)
- D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
-"RTN","C0CRNF",232,0)
- D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
-"RTN","C0CRNF",233,0)
- S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
-"RTN","C0CRNF",234,0)
- S (C0CI,C0CJ)=""
-"RTN","C0CRNF",235,0)
- F  S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ=""  D  ; FOR ALL SUBFILES
-"RTN","C0CRNF",236,0)
- . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
-"RTN","C0CRNF",237,0)
- . F  S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI=""  D  ; ARRAY OF FIELDS
-"RTN","C0CRNF",238,0)
- . . ;W C0CJ," ",C0CI,!
-"RTN","C0CRNF",239,0)
- . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
-"RTN","C0CRNF",240,0)
- . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
-"RTN","C0CRNF",241,0)
- . . I C0CVALUE["C0CTMP" D  ; WP FIELD
-"RTN","C0CRNF",242,0)
- . . . N ZT,ZWP S ZWP=0 ;ITERATOR
-"RTN","C0CRNF",243,0)
- . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
-"RTN","C0CRNF",244,0)
- . . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE
-"RTN","C0CRNF",245,0)
- . . . F  S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP  D  ;
-"RTN","C0CRNF",246,0)
- . . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP
-"RTN","C0CRNF",247,0)
- . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
-"RTN","C0CRNF",248,0)
- . . . . S C0CVALUE=C0CVALUE_ZT ;
-"RTN","C0CRNF",249,0)
- . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
-"RTN","C0CRNF",250,0)
- . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I"))
-"RTN","C0CRNF",251,0)
- I C0CNN D  ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
-"RTN","C0CRNF",252,0)
- . S C0CI=""
-"RTN","C0CRNF",253,0)
- . F  S C0CI=$O(@GRTN@(C0CI)) Q:C0CI=""  D  ; GO THROUGH THE WHOLE ARRAY
-"RTN","C0CRNF",254,0)
- . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
-"RTN","C0CRNF",255,0)
+"RTN","C0CRNF",273,0)
+ ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GARFLD AND GARVAL
+"RTN","C0CRNF",274,0)
+ ;N GATMP,GAI,GAF
+"RTN","C0CRNF",275,0)
+ S GAF=$$FILEREF(GAFILE) ; GET CLOSED ROOT FOR THE FILE NUMBER GAFILE
+"RTN","C0CRNF",276,0)
+ I '$D(GAIDX) S GAIDX="" ;DEFAULT
+"RTN","C0CRNF",277,0)
+ I '$D(GANN) S GANN="" ;DEFAULT ONLY POPULATED FIELDS RETURNED
+"RTN","C0CRNF",278,0)
+ I GAIDX'="" S GAF=$NA(@GAF@(GAIDX)) ; IF WE ARE USING AN INDEX
+"RTN","C0CRNF",279,0)
+ W GAF,!
+"RTN","C0CRNF",280,0)
+ W $O(@GAF@(0)) ;
+"RTN","C0CRNF",281,0)
+ S GAI=0 ;ITERATOR
+"RTN","C0CRNF",282,0)
+ F  S GAI=$O(@GAF@(GAI)) Q:GAI=""  D  ;
+"RTN","C0CRNF",283,0)
+ . D GETN1("GATMP",GAFILE,GAI,GAIDX,GANN) ;GET ONE RECORD
+"RTN","C0CRNF",284,0)
+ . N GAX S GAX=0
+"RTN","C0CRNF",285,0)
+ . F  S GAX=$O(GATMP(GAX)) Q:GAX=""  D  ;PULL OUT THE FIELDS
+"RTN","C0CRNF",286,0)
+ . . D ADDNV(GARTN,GAI,GAX,GATMP(GAX)) ;INSERT THE NAME/VALUE INTO GARTN
+"RTN","C0CRNF",287,0)
  Q
-"RTN","C0CRNF",256,0)
- ;
-"RTN","C0CRNF",257,0)
-GETN2(GARTN,GAFILE,GAIDX,GACNT,GASTRT,GANN) ; RETURN FIELD MAP AND VALUES
-"RTN","C0CRNF",258,0)
- ; GARTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
-"RTN","C0CRNF",259,0)
- ; .. FIELD MAP @GARTN@("F","FIELDNAME")="FILE;FIELD#"
-"RTN","C0CRNF",260,0)
- ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
-"RTN","C0CRNF",261,0)
- ; .. VALUE MAP @GARTN@("V","IEN","FIELDNAME","N")=VALUE
-"RTN","C0CRNF",262,0)
- ; .. WHERE N IS THE INDEX FOR MULTIPLES.. 1 FOR SINGLE VALUES
-"RTN","C0CRNF",263,0)
- ; .. GARTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
-"RTN","C0CRNF",264,0)
- ; .. IF GANN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
-"RTN","C0CRNF",265,0)
- ; .. EVEN IF GANN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
-"RTN","C0CRNF",266,0)
- ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
-"RTN","C0CRNF",267,0)
- ; GAFILE IS THE FILE NUMBER TO BE PROCESSED. IT IS PASSED BY VALUE
-"RTN","C0CRNF",268,0)
- ; GAIDX IS THE OPTIONAL INDEX TO USE IN THE FILE. IF GAIDX IS "" THE IEN
-"RTN","C0CRNF",269,0)
- ; .. OF THE FILE WILL BE USED
-"RTN","C0CRNF",270,0)
- ; GACNT IS THE NUMBER OF RECORDS TO PROCESS. IT IS PASSED BY VALUE
-"RTN","C0CRNF",271,0)
- ; .. IF GARCNT IS NULL, ALL RECORDS ARE PROCESSED
-"RTN","C0CRNF",272,0)
- ; GASTRT IS THE IEN OF THE FIRST RECORD TO PROCESS. IT IS PASSED BY VALUE
-"RTN","C0CRNF",273,0)
- ; .. IF GARSTART IS NULL, PROCESSING STARTS AT THE FIRST RECORD
-"RTN","C0CRNF",274,0)
- ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
-"RTN","C0CRNF",275,0)
- ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GARFLD AND GARVAL
-"RTN","C0CRNF",276,0)
- ;N GATMP,GAI,GAF
-"RTN","C0CRNF",277,0)
- S GAF=$$FILEREF(GAFILE) ; GET CLOSED ROOT FOR THE FILE NUMBER GAFILE
-"RTN","C0CRNF",278,0)
- I '$D(GAIDX) S GAIDX="" ;DEFAULT
-"RTN","C0CRNF",279,0)
- I '$D(GANN) S GANN="" ;DEFAULT ONLY POPULATED FIELDS RETURNED
-"RTN","C0CRNF",280,0)
- I GAIDX'="" S GAF=$NA(@GAF@(GAIDX)) ; IF WE ARE USING AN INDEX
-"RTN","C0CRNF",281,0)
- W GAF,!
-"RTN","C0CRNF",282,0)
- W $O(@GAF@(0)) ;
-"RTN","C0CRNF",283,0)
- S GAI=0 ;ITERATOR
-"RTN","C0CRNF",284,0)
- F  S GAI=$O(@GAF@(GAI)) Q:GAI=""  D  ;
-"RTN","C0CRNF",285,0)
- . D GETN1("GATMP",GAFILE,GAI,GAIDX,GANN) ;GET ONE RECORD
-"RTN","C0CRNF",286,0)
- . N GAX S GAX=0
-"RTN","C0CRNF",287,0)
- . F  S GAX=$O(GATMP(GAX)) Q:GAX=""  D  ;PULL OUT THE FIELDS
 "RTN","C0CRNF",288,0)
- . . D ADDNV(GARTN,GAI,GAX,GATMP(GAX)) ;INSERT THE NAME/VALUE INTO GARTN
+ ;
 "RTN","C0CRNF",289,0)
+ADDNV(GNV,GNVN,GNVF,GNVV) ; CREATE AN ELEMENT OF THE MATRIX
+"RTN","C0CRNF",290,0)
+ ;
+"RTN","C0CRNF",291,0)
+ S @GNV@("F",GNVF)=$P(GNVV,"^",1)_"^"_$P(GNVV,"^",2) ;NAME=FILE^FIELD#
+"RTN","C0CRNF",292,0)
+ S @GNV@("V",GNVN,GNVF,1)=$P(GNVV,"^",3) ;SET THE VALUE
+"RTN","C0CRNF",293,0)
  Q
-"RTN","C0CRNF",290,0)
- ;
-"RTN","C0CRNF",291,0)
-ADDNV(GNV,GNVN,GNVF,GNVV) ; CREATE AN ELEMENT OF THE MATRIX
-"RTN","C0CRNF",292,0)
- ;
-"RTN","C0CRNF",293,0)
- S @GNV@("F",GNVF)=$P(GNVV,"^",1)_"^"_$P(GNVV,"^",2) ;NAME=FILE^FIELD#
 "RTN","C0CRNF",294,0)
- S @GNV@("V",GNVN,GNVF,1)=$P(GNVV,"^",3) ;SET THE VALUE
+ ;
 "RTN","C0CRNF",295,0)
+RNF2CSV(RNRTN,RNIN,RNSTY) ;CONVERTS AN RFN2 GLOBAL TO A CSV FORMAT
+"RTN","C0CRNF",296,0)
+ ; READY TO WRITE FOR USE WITH EXCEL @RNRTN@(0) IS NUMBER OF LINES
+"RTN","C0CRNF",297,0)
+ ; RNSTY IS STYLE OF THE OUTPUT -
+"RTN","C0CRNF",298,0)
+ ; .. "NV"= ROWS ARE NAMES, COLUMNS ARE VALUES
+"RTN","C0CRNF",299,0)
+ ; .. "VN"= ROWS ARE VALUES, COLUMNS ARE NAMES
+"RTN","C0CRNF",300,0)
+ ; .. DEFAULT IS "NV" BECAUSE MANY MATRICES HAVE MORE FIELDS THAN VALUES
+"RTN","C0CRNF",301,0)
+ N RNR,RNC ;ROW ROOT,COL ROOT
+"RTN","C0CRNF",302,0)
+ N RNI,RNJ,RNX
+"RTN","C0CRNF",303,0)
+ I '$D(RNSTY) S RNSTY="NV" ;DEFAULT
+"RTN","C0CRNF",304,0)
+ I RNSTY="NV" D NV(RNRTN,RNIN)  ; INTERNAL SUBROUTINES DEPENDING ON ORIENTATION
+"RTN","C0CRNF",305,0)
+ E  D VN(RNRTN,RNIN) ;
+"RTN","C0CRNF",306,0)
  Q
-"RTN","C0CRNF",296,0)
- ;
-"RTN","C0CRNF",297,0)
-RNF2CSV(RNRTN,RNIN,RNSTY) ;CONVERTS AN RFN2 GLOBAL TO A CSV FORMAT
-"RTN","C0CRNF",298,0)
- ; READY TO WRITE FOR USE WITH EXCEL @RNRTN@(0) IS NUMBER OF LINES
-"RTN","C0CRNF",299,0)
- ; RNSTY IS STYLE OF THE OUTPUT -
-"RTN","C0CRNF",300,0)
- ; .. "NV"= ROWS ARE NAMES, COLUMNS ARE VALUES
-"RTN","C0CRNF",301,0)
- ; .. "VN"= ROWS ARE VALUES, COLUMNS ARE NAMES
-"RTN","C0CRNF",302,0)
- ; .. DEFAULT IS "NV" BECAUSE MANY MATRICES HAVE MORE FIELDS THAN VALUES
-"RTN","C0CRNF",303,0)
- N RNR,RNC ;ROW ROOT,COL ROOT
-"RTN","C0CRNF",304,0)
- N RNI,RNJ,RNX
-"RTN","C0CRNF",305,0)
- I '$D(RNSTY) S RNSTY="NV" ;DEFAULT
-"RTN","C0CRNF",306,0)
- I RNSTY="NV" D NV(RNRTN,RNIN)  ; INTERNAL SUBROUTINES DEPENDING ON ORIENTATION
 "RTN","C0CRNF",307,0)
- E  D VN(RNRTN,RNIN) ;
+ ;
 "RTN","C0CRNF",308,0)
+NV(RNRTN,RNIN) ;
+"RTN","C0CRNF",309,0)
+ S RNR=$NA(@RNIN@("F"))
+"RTN","C0CRNF",310,0)
+ S RNC=$NA(@RNIN@("V"))
+"RTN","C0CRNF",311,0)
+ ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
+"RTN","C0CRNF",312,0)
+ S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD"
+"RTN","C0CRNF",313,0)
+ S RNI=""
+"RTN","C0CRNF",314,0)
+ F  S RNI=$O(@RNC@(RNI)) Q:RNI=""  D  ; FOR EACH COLUMN
+"RTN","C0CRNF",315,0)
+ . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
+"RTN","C0CRNF",316,0)
+ S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
+"RTN","C0CRNF",317,0)
+ D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
+"RTN","C0CRNF",318,0)
+ S RNI=""
+"RTN","C0CRNF",319,0)
+ F  S RNI=$O(@RNR@(RNI)) Q:RNI=""  D  ; FOR EACH ROW
+"RTN","C0CRNF",320,0)
+ . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
+"RTN","C0CRNF",321,0)
+ . S RNJ=""
+"RTN","C0CRNF",322,0)
+ . F  S RNJ=$O(@RNC@(RNJ)) Q:RNJ=""  D  ; FOR EACH COL
+"RTN","C0CRNF",323,0)
+ . . I $D(@RNC@(RNJ,RNI,1)) D  ; THIS ROW HAS THIS COLUMN
+"RTN","C0CRNF",324,0)
+ . . . S RNX=RNX_""""_@RNC@(RNJ,RNI,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA
+"RTN","C0CRNF",325,0)
+ . . E  S RNX=RNX_"," ; NUL COLUMN
+"RTN","C0CRNF",326,0)
+ . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
+"RTN","C0CRNF",327,0)
+ . D PUSH^C0CXPATH(RNRTN,RNX)
+"RTN","C0CRNF",328,0)
  Q
-"RTN","C0CRNF",309,0)
- ;
-"RTN","C0CRNF",310,0)
-NV(RNRTN,RNIN) ;
-"RTN","C0CRNF",311,0)
- S RNR=$NA(@RNIN@("F"))
-"RTN","C0CRNF",312,0)
- S RNC=$NA(@RNIN@("V"))
-"RTN","C0CRNF",313,0)
+"RTN","C0CRNF",329,0)
+ ;
+"RTN","C0CRNF",330,0)
+VN(RNRTN,RNIN) ;
+"RTN","C0CRNF",331,0)
+ S RNR=$NA(@RNIN@("V"))
+"RTN","C0CRNF",332,0)
+ S RNC=$NA(@RNIN@("F"))
+"RTN","C0CRNF",333,0)
  ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
-"RTN","C0CRNF",314,0)
- S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD"
-"RTN","C0CRNF",315,0)
+"RTN","C0CRNF",334,0)
+ S RNX="""ROW"""_"," ; FIRST COLUMN NAME IS "ROW"
+"RTN","C0CRNF",335,0)
  S RNI=""
-"RTN","C0CRNF",316,0)
+"RTN","C0CRNF",336,0)
  F  S RNI=$O(@RNC@(RNI)) Q:RNI=""  D  ; FOR EACH COLUMN
-"RTN","C0CRNF",317,0)
+"RTN","C0CRNF",337,0)
  . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
-"RTN","C0CRNF",318,0)
+"RTN","C0CRNF",338,0)
  S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
-"RTN","C0CRNF",319,0)
+"RTN","C0CRNF",339,0)
  D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
-"RTN","C0CRNF",320,0)
+"RTN","C0CRNF",340,0)
  S RNI=""
-"RTN","C0CRNF",321,0)
+"RTN","C0CRNF",341,0)
  F  S RNI=$O(@RNR@(RNI)) Q:RNI=""  D  ; FOR EACH ROW
-"RTN","C0CRNF",322,0)
+"RTN","C0CRNF",342,0)
  . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
-"RTN","C0CRNF",323,0)
+"RTN","C0CRNF",343,0)
  . S RNJ=""
-"RTN","C0CRNF",324,0)
+"RTN","C0CRNF",344,0)
  . F  S RNJ=$O(@RNC@(RNJ)) Q:RNJ=""  D  ; FOR EACH COL
-"RTN","C0CRNF",325,0)
- . . I $D(@RNC@(RNJ,RNI,1)) D  ; THIS ROW HAS THIS COLUMN
-"RTN","C0CRNF",326,0)
- . . . S RNX=RNX_""""_@RNC@(RNJ,RNI,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA
-"RTN","C0CRNF",327,0)
+"RTN","C0CRNF",345,0)
+ . . I $D(@RNR@(RNI,RNJ,1)) D  ; THIS ROW HAS THIS COLUMN
+"RTN","C0CRNF",346,0)
+ . . . S RNV=$TR(@RNR@(RNI,RNJ,1),"""","")
+"RTN","C0CRNF",347,0)
+ . . . S RNV=$TR(RNV,",","")
+"RTN","C0CRNF",348,0)
+ . . . S RNX=RNX_""""_RNV_""""_"," ; ADD THE ELEMENT PLUS A COMMA
+"RTN","C0CRNF",349,0)
  . . E  S RNX=RNX_"," ; NUL COLUMN
-"RTN","C0CRNF",328,0)
+"RTN","C0CRNF",350,0)
  . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
-"RTN","C0CRNF",329,0)
+"RTN","C0CRNF",351,0)
  . D PUSH^C0CXPATH(RNRTN,RNX)
-"RTN","C0CRNF",330,0)
+"RTN","C0CRNF",352,0)
  Q
-"RTN","C0CRNF",331,0)
- ;
-"RTN","C0CRNF",332,0)
-VN(RNRTN,RNIN) ;
-"RTN","C0CRNF",333,0)
- S RNR=$NA(@RNIN@("V"))
-"RTN","C0CRNF",334,0)
- S RNC=$NA(@RNIN@("F"))
-"RTN","C0CRNF",335,0)
- ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
-"RTN","C0CRNF",336,0)
- S RNX="""ROW"""_"," ; FIRST COLUMN NAME IS "ROW"
-"RTN","C0CRNF",337,0)
- S RNI=""
-"RTN","C0CRNF",338,0)
- F  S RNI=$O(@RNC@(RNI)) Q:RNI=""  D  ; FOR EACH COLUMN
-"RTN","C0CRNF",339,0)
- . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
-"RTN","C0CRNF",340,0)
- S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
-"RTN","C0CRNF",341,0)
- D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
-"RTN","C0CRNF",342,0)
- S RNI=""
-"RTN","C0CRNF",343,0)
- F  S RNI=$O(@RNR@(RNI)) Q:RNI=""  D  ; FOR EACH ROW
-"RTN","C0CRNF",344,0)
- . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
-"RTN","C0CRNF",345,0)
- . S RNJ=""
-"RTN","C0CRNF",346,0)
- . F  S RNJ=$O(@RNC@(RNJ)) Q:RNJ=""  D  ; FOR EACH COL
-"RTN","C0CRNF",347,0)
- . . I $D(@RNR@(RNI,RNJ,1)) D  ; THIS ROW HAS THIS COLUMN
-"RTN","C0CRNF",348,0)
- . . . S RNV=$TR(@RNR@(RNI,RNJ,1),"""","")
-"RTN","C0CRNF",349,0)
- . . . S RNV=$TR(RNV,",","")
-"RTN","C0CRNF",350,0)
- . . . S RNX=RNX_""""_RNV_""""_"," ; ADD THE ELEMENT PLUS A COMMA
-"RTN","C0CRNF",351,0)
- . . E  S RNX=RNX_"," ; NUL COLUMN
-"RTN","C0CRNF",352,0)
- . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
 "RTN","C0CRNF",353,0)
- . D PUSH^C0CXPATH(RNRTN,RNX)
+ ;
 "RTN","C0CRNF",354,0)
+READCSV(PATH,NAME,GLB) ; READ A CSV FILE IN FROM UNIX TO GLB, PASSED BY NAME
+"RTN","C0CRNF",355,0)
+ ;
+"RTN","C0CRNF",356,0)
+ Q $$FTG^%ZISH(PATH,NAME,GLB,1)
+"RTN","C0CRNF",357,0)
+ ;
+"RTN","C0CRNF",358,0)
+FILE2CSV(FNUM,FVN) ; WRITES OUT A FILEMAN FILE TO CSV
+"RTN","C0CRNF",359,0)
+ ;
+"RTN","C0CRNF",360,0)
+ ;N G1,G2
+"RTN","C0CRNF",361,0)
+ I '$D(FVN) S FVN="NV" ; DEFAULT ORIENTATION OF CVS FILE
+"RTN","C0CRNF",362,0)
+ S G1=$NA(^TMP($J,"C0CCSV",1))
+"RTN","C0CRNF",363,0)
+ S G2=$NA(^TMP($J,"C0CCSV",2))
+"RTN","C0CRNF",364,0)
+ D GETN2(G1,FNUM) ; GET THE MATRIX
+"RTN","C0CRNF",365,0)
+ D RNF2CSV(G2,G1,FVN) ; PREPARE THE CVS FILE
+"RTN","C0CRNF",366,0)
+ K @G1
+"RTN","C0CRNF",367,0)
+ D FILEOUT(G2,"FILE_"_FNUM_".csv")
+"RTN","C0CRNF",368,0)
+ K @G2
+"RTN","C0CRNF",369,0)
  Q
-"RTN","C0CRNF",355,0)
- ;
-"RTN","C0CRNF",356,0)
-READCSV(PATH,NAME,GLB) ; READ A CSV FILE IN FROM UNIX TO GLB, PASSED BY NAME
-"RTN","C0CRNF",357,0)
- ;
-"RTN","C0CRNF",358,0)
- Q $$FTG^%ZISH(PATH,NAME,GLB,1)
-"RTN","C0CRNF",359,0)
- ;
-"RTN","C0CRNF",360,0)
-FILE2CSV(FNUM,FVN) ; WRITES OUT A FILEMAN FILE TO CSV
-"RTN","C0CRNF",361,0)
- ;
-"RTN","C0CRNF",362,0)
- ;N G1,G2
-"RTN","C0CRNF",363,0)
- I '$D(FVN) S FVN="NV" ; DEFAULT ORIENTATION OF CVS FILE
-"RTN","C0CRNF",364,0)
- S G1=$NA(^TMP($J,"C0CCSV",1))
-"RTN","C0CRNF",365,0)
- S G2=$NA(^TMP($J,"C0CCSV",2))
-"RTN","C0CRNF",366,0)
- D GETN2(G1,FNUM) ; GET THE MATRIX
-"RTN","C0CRNF",367,0)
- D RNF2CSV(G2,G1,FVN) ; PREPARE THE CVS FILE
-"RTN","C0CRNF",368,0)
- K @G1
-"RTN","C0CRNF",369,0)
- D FILEOUT(G2,"FILE_"_FNUM_".csv")
 "RTN","C0CRNF",370,0)
- K @G2
+ ;
 "RTN","C0CRNF",371,0)
+FILEOUT(FOARY,FONAM) ; WRITE OUT A FILE
+"RTN","C0CRNF",372,0)
+ ;
+"RTN","C0CRNF",373,0)
+ W $$OUTPUT^C0CXPATH($NA(@FOARY@(1)),FONAM,^TMP("C0CCCR","ODIR"))
+"RTN","C0CRNF",374,0)
  Q
-"RTN","C0CRNF",372,0)
- ;
-"RTN","C0CRNF",373,0)
-FILEOUT(FOARY,FONAM) ; WRITE OUT A FILE
-"RTN","C0CRNF",374,0)
- ;
 "RTN","C0CRNF",375,0)
- W $$OUTPUT^C0CXPATH($NA(@FOARY@(1)),FONAM,^TMP("C0CCCR","ODIR"))
+ ;
 "RTN","C0CRNF",376,0)
+FILEREF(FNUM) ; EXTRINSIC THAT RETURNS A CLOSED ROOT FOR FILE NUMBER FNUM
+"RTN","C0CRNF",377,0)
+ ;
+"RTN","C0CRNF",378,0)
+ N C0CF
+"RTN","C0CRNF",379,0)
+ S C0CF=^DIC(FNUM,0,"GL") ;OPEN ROOT TO FILE
+"RTN","C0CRNF",380,0)
+ S C0CF=$P(C0CF,",",1)_")" ; CLOSE THE ROOT
+"RTN","C0CRNF",381,0)
+ I C0CF["()" S C0CF=$P(C0CF,"()",1)
+"RTN","C0CRNF",382,0)
+ Q C0CF
+"RTN","C0CRNF",383,0)
+ ;
+"RTN","C0CRNF",384,0)
+SKIP ;
+"RTN","C0CRNF",385,0)
+ N TXT,DIERR
+"RTN","C0CRNF",386,0)
+ S TXT=$$GET1^DIQ(8925,TIUIEN,"2","","TXT")
+"RTN","C0CRNF",387,0)
+ I $D(DIERR) D CLEAN^DILF Q
+"RTN","C0CRNF",388,0)
+ W "  report_text:",!  ;Progress Note Text
+"RTN","C0CRNF",389,0)
+ N LN S LN=0
+"RTN","C0CRNF",390,0)
+ F  S LN=$O(TXT(LN)) Q:'LN  D
+"RTN","C0CRNF",391,0)
+ . W "    text"_LN_": "_TXT(LN),!
+"RTN","C0CRNF",392,0)
+ . Q
+"RTN","C0CRNF",393,0)
  Q
-"RTN","C0CRNF",377,0)
- ;
-"RTN","C0CRNF",378,0)
-FILEREF(FNUM) ; EXTRINSIC THAT RETURNS A CLOSED ROOT FOR FILE NUMBER FNUM
-"RTN","C0CRNF",379,0)
- ;
-"RTN","C0CRNF",380,0)
- N C0CF
-"RTN","C0CRNF",381,0)
- S C0CF=^DIC(FNUM,0,"GL") ;OPEN ROOT TO FILE
-"RTN","C0CRNF",382,0)
- S C0CF=$P(C0CF,",",1)_")" ; CLOSE THE ROOT
-"RTN","C0CRNF",383,0)
- I C0CF["()" S C0CF=$P(C0CF,"()",1)
-"RTN","C0CRNF",384,0)
- Q C0CF
-"RTN","C0CRNF",385,0)
- ;
-"RTN","C0CRNF",386,0)
-SKIP ;
-"RTN","C0CRNF",387,0)
- N TXT,DIERR
-"RTN","C0CRNF",388,0)
- S TXT=$$GET1^DIQ(8925,TIUIEN,"2","","TXT")
-"RTN","C0CRNF",389,0)
- I $D(DIERR) D CLEAN^DILF Q
-"RTN","C0CRNF",390,0)
- W "  report_text:",!  ;Progress Note Text
-"RTN","C0CRNF",391,0)
- N LN S LN=0
-"RTN","C0CRNF",392,0)
- F  S LN=$O(TXT(LN)) Q:'LN  D
-"RTN","C0CRNF",393,0)
- . W "    text"_LN_": "_TXT(LN),!
 "RTN","C0CRNF",394,0)
- . Q
+ ;
 "RTN","C0CRNF",395,0)
+RNF2HNV(ZOUT,ZIN) ;RETURN AN HTML TABLE IN ZOUT, PASSED BY NAME
+"RTN","C0CRNF",396,0)
+ ; OF ZIN, WHICH IS PASSED BY NAME AND IS IN RNF2 FORMAT
+"RTN","C0CRNF",397,0)
+ ; ZOUT IS NOT INITIALIZED, SO THE TABLE WILL GO AT THE END
+"RTN","C0CRNF",398,0)
+ ; THE TABLE WILL BE IN NV FORMAT, ROWS ARE NAMES COLUMNS ARE VALUES 
+"RTN","C0CRNF",399,0)
+ D PUSH^C0CXPATH(ZOUT,"<table border=""1"">")
+"RTN","C0CRNF",400,0)
+ N ZI,ZJ,ZV,ZN S ZI="" S ZJ=0
+"RTN","C0CRNF",401,0)
+ D PUSH^C0CXPATH(ZOUT,"<tr><td></td>") ;begin row and leave a blank col
+"RTN","C0CRNF",402,0)
+ F  S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0  D  ; FOR EACH OCCURANCE
+"RTN","C0CRNF",403,0)
+ . S ZV="<td>"_ZJ_"</td>" ; OCCURANCE AS COLUMNS HEADER
+"RTN","C0CRNF",404,0)
+ . D PUSH^C0CXPATH(ZOUT,ZV)
+"RTN","C0CRNF",405,0)
+ D PUSH^C0CXPATH(ZOUT,"</tr>") ;end of first row
+"RTN","C0CRNF",406,0)
+ S ZI=""
+"RTN","C0CRNF",407,0)
+ F  S ZI=$O(@ZIN@("F",ZI)) Q:ZI=""  D  ; FOR EACH VARIABLE
+"RTN","C0CRNF",408,0)
+ . S ZN="<tr><td>"_ZI_"</td>" ; VARIABLE NAME IN FIRST COLUMN
+"RTN","C0CRNF",409,0)
+ . D PUSH^C0CXPATH(ZOUT,ZN)
+"RTN","C0CRNF",410,0)
+ . S ZJ=0 ;RESET TO DO IT AGAIN
+"RTN","C0CRNF",411,0)
+ . F  S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0  D  ; FOR EACH OCCURANCE
+"RTN","C0CRNF",412,0)
+ . . S ZV="<td>"_$G(@ZIN@("V",ZJ,ZI,1))_"</td>"
+"RTN","C0CRNF",413,0)
+ . . D PUSH^C0CXPATH(ZOUT,ZV)
+"RTN","C0CRNF",414,0)
+ . D PUSH^C0CXPATH(ZOUT,"</tr>") ;END OF ROW
+"RTN","C0CRNF",415,0)
+ D PUSH^C0CXPATH(ZOUT,"</table>") ; end of table
+"RTN","C0CRNF",416,0)
  Q
-"RTN","C0CRNF",396,0)
- ;
-"RTN","C0CRNF",397,0)
-RNF2HNV(ZOUT,ZIN) ;RETURN AN HTML TABLE IN ZOUT, PASSED BY NAME
-"RTN","C0CRNF",398,0)
+"RTN","C0CRNF",417,0)
+ ;
+"RTN","C0CRNF",418,0)
+RNF2HVN(ZOUT,ZIN) ;RETURN AN HTML TABLE IN ZOUT, PASSED BY NAME
+"RTN","C0CRNF",419,0)
  ; OF ZIN, WHICH IS PASSED BY NAME AND IS IN RNF2 FORMAT
-"RTN","C0CRNF",399,0)
+"RTN","C0CRNF",420,0)
  ; ZOUT IS NOT INITIALIZED, SO THE TABLE WILL GO AT THE END
-"RTN","C0CRNF",400,0)
- ; THE TABLE WILL BE IN NV FORMAT, ROWS ARE NAMES COLUMNS ARE VALUES 
-"RTN","C0CRNF",401,0)
+"RTN","C0CRNF",421,0)
+ ; THE TABLE WILL BE IN VN FORMAT, ROWS ARE VALUES COLUMNS ARE NAMES 
+"RTN","C0CRNF",422,0)
  D PUSH^C0CXPATH(ZOUT,"<table border=""1"">")
-"RTN","C0CRNF",402,0)
- N ZI,ZJ,ZV,ZN S ZI="" S ZJ=0
-"RTN","C0CRNF",403,0)
- D PUSH^C0CXPATH(ZOUT,"<tr><td></td>") ;begin row and leave a blank col
-"RTN","C0CRNF",404,0)
- F  S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0  D  ; FOR EACH OCCURANCE
-"RTN","C0CRNF",405,0)
- . S ZV="<td>"_ZJ_"</td>" ; OCCURANCE AS COLUMNS HEADER
-"RTN","C0CRNF",406,0)
- . D PUSH^C0CXPATH(ZOUT,ZV)
-"RTN","C0CRNF",407,0)
- D PUSH^C0CXPATH(ZOUT,"</tr>") ;end of first row
-"RTN","C0CRNF",408,0)
- S ZI=""
-"RTN","C0CRNF",409,0)
+"RTN","C0CRNF",423,0)
+ N ZI,ZJ S ZI="" S ZJ=0
+"RTN","C0CRNF",424,0)
+ D PUSH^C0CXPATH(ZOUT,"<tr>") ;new row for column headers
+"RTN","C0CRNF",425,0)
  F  S ZI=$O(@ZIN@("F",ZI)) Q:ZI=""  D  ; FOR EACH VARIABLE
-"RTN","C0CRNF",410,0)
- . S ZN="<tr><td>"_ZI_"</td>" ; VARIABLE NAME IN FIRST COLUMN
-"RTN","C0CRNF",411,0)
- . D PUSH^C0CXPATH(ZOUT,ZN)
-"RTN","C0CRNF",412,0)
- . S ZJ=0 ;RESET TO DO IT AGAIN
-"RTN","C0CRNF",413,0)
- . F  S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0  D  ; FOR EACH OCCURANCE
-"RTN","C0CRNF",414,0)
- . . S ZV="<td>"_$G(@ZIN@("V",ZJ,ZI,1))_"</td>"
-"RTN","C0CRNF",415,0)
- . . D PUSH^C0CXPATH(ZOUT,ZV)
-"RTN","C0CRNF",416,0)
- . D PUSH^C0CXPATH(ZOUT,"</tr>") ;END OF ROW
-"RTN","C0CRNF",417,0)
- D PUSH^C0CXPATH(ZOUT,"</table>") ; end of table
-"RTN","C0CRNF",418,0)
+"RTN","C0CRNF",426,0)
+ . S ZV="<td>"_ZI_"</td>"
+"RTN","C0CRNF",427,0)
+ . D PUSH^C0CXPATH(ZOUT,ZV) ; name
+"RTN","C0CRNF",428,0)
+ D PUSH^C0CXPATH(ZOUT,"</tr>") ; end header row
+"RTN","C0CRNF",429,0)
+ S ZI="" ;RESET TO DO AGAIN
+"RTN","C0CRNF",430,0)
+ F  S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0  D  ; FOR EACH ROW OF VARIABLES
+"RTN","C0CRNF",431,0)
+ . D PUSH^C0CXPATH(ZOUT,"<tr>") ;begin row
+"RTN","C0CRNF",432,0)
+ . F  S ZI=$O(@ZIN@("F",ZI)) Q:ZI=""  D  ; FOR EACH VARIABLE
+"RTN","C0CRNF",433,0)
+ . . S ZV="<td>"_$G(@ZIN@("V",ZJ,ZI,1))_"</td>" ; value
+"RTN","C0CRNF",434,0)
+ . . D PUSH^C0CXPATH(ZOUT,ZV) ; value
+"RTN","C0CRNF",435,0)
+ . D PUSH^C0CXPATH(ZOUT,"</tr>") ; end header
+"RTN","C0CRNF",436,0)
+ D PUSH^C0CXPATH(ZOUT,"</table>") ;end of table
+"RTN","C0CRNF",437,0)
  Q
-"RTN","C0CRNF",419,0)
- ;
-"RTN","C0CRNF",420,0)
-RNF2HVN(ZOUT,ZIN) ;RETURN AN HTML TABLE IN ZOUT, PASSED BY NAME
-"RTN","C0CRNF",421,0)
- ; OF ZIN, WHICH IS PASSED BY NAME AND IS IN RNF2 FORMAT
-"RTN","C0CRNF",422,0)
- ; ZOUT IS NOT INITIALIZED, SO THE TABLE WILL GO AT THE END
-"RTN","C0CRNF",423,0)
- ; THE TABLE WILL BE IN VN FORMAT, ROWS ARE VALUES COLUMNS ARE NAMES 
-"RTN","C0CRNF",424,0)
- D PUSH^C0CXPATH(ZOUT,"<table border=""1"">")
-"RTN","C0CRNF",425,0)
- N ZI,ZJ S ZI="" S ZJ=0
-"RTN","C0CRNF",426,0)
- D PUSH^C0CXPATH(ZOUT,"<tr>") ;new row for column headers
-"RTN","C0CRNF",427,0)
- F  S ZI=$O(@ZIN@("F",ZI)) Q:ZI=""  D  ; FOR EACH VARIABLE
-"RTN","C0CRNF",428,0)
- . S ZV="<td>"_ZI_"</td>"
-"RTN","C0CRNF",429,0)
- . D PUSH^C0CXPATH(ZOUT,ZV) ; name
-"RTN","C0CRNF",430,0)
- D PUSH^C0CXPATH(ZOUT,"</tr>") ; end header row
-"RTN","C0CRNF",431,0)
- S ZI="" ;RESET TO DO AGAIN
-"RTN","C0CRNF",432,0)
- F  S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0  D  ; FOR EACH ROW OF VARIABLES
-"RTN","C0CRNF",433,0)
- . D PUSH^C0CXPATH(ZOUT,"<tr>") ;begin row
-"RTN","C0CRNF",434,0)
- . F  S ZI=$O(@ZIN@("F",ZI)) Q:ZI=""  D  ; FOR EACH VARIABLE
-"RTN","C0CRNF",435,0)
- . . S ZV="<td>"_$G(@ZIN@("V",ZJ,ZI,1))_"</td>" ; value
-"RTN","C0CRNF",436,0)
- . . D PUSH^C0CXPATH(ZOUT,ZV) ; value
-"RTN","C0CRNF",437,0)
- . D PUSH^C0CXPATH(ZOUT,"</tr>") ; end header
 "RTN","C0CRNF",438,0)
- D PUSH^C0CXPATH(ZOUT,"</table>") ;end of table
+ ;
 "RTN","C0CRNF",439,0)
- Q
+ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
 "RTN","C0CRNF",440,0)
- ;
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF @ZTAB@(ZFN)
 "RTN","C0CRNF",441,0)
-ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
+ ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
 "RTN","C0CRNF",442,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF @ZTAB@(ZFN)
+ I '$D(ZTAB) S ZTAB="C0CA"
 "RTN","C0CRNF",443,0)
+ Q $P(@ZTAB@(ZFN),"^",1)
+"RTN","C0CRNF",444,0)
+ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
+"RTN","C0CRNF",445,0)
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF @ZTAB@(ZFN)
+"RTN","C0CRNF",446,0)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CRNF",444,0)
+"RTN","C0CRNF",447,0)
  I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CRNF",445,0)
- Q $P(@ZTAB@(ZFN),"^",1)
-"RTN","C0CRNF",446,0)
-ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
-"RTN","C0CRNF",447,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF @ZTAB@(ZFN)
 "RTN","C0CRNF",448,0)
+ Q $P(@ZTAB@(ZFN),"^",2)
+"RTN","C0CRNF",449,0)
+ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
+"RTN","C0CRNF",450,0)
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
+"RTN","C0CRNF",451,0)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CRNF",449,0)
+"RTN","C0CRNF",452,0)
  I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CRNF",450,0)
- Q $P(@ZTAB@(ZFN),"^",2)
-"RTN","C0CRNF",451,0)
-ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
-"RTN","C0CRNF",452,0)
+"RTN","C0CRNF",453,0)
+ Q $P($G(@ZTAB@(ZFN)),"^",3)
+"RTN","C0CRNF",454,0)
+ ;
+"RTN","C0CRNF",455,0)
+ZVALUEI(ZFN,ZTAB) ;EXTRINSIC TO RETURN INTERNAL VALUE FOR FIELD NAME PASSED
+"RTN","C0CRNF",456,0)
  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
-"RTN","C0CRNF",453,0)
+"RTN","C0CRNF",457,0)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CRNF",454,0)
+"RTN","C0CRNF",458,0)
  I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CRNF",455,0)
- Q $P($G(@ZTAB@(ZFN)),"^",3)
-"RTN","C0CRNF",456,0)
- ;
-"RTN","C0CRNF",457,0)
-ZVALUEI(ZFN,ZTAB) ;EXTRINSIC TO RETURN INTERNAL VALUE FOR FIELD NAME PASSED
-"RTN","C0CRNF",458,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
 "RTN","C0CRNF",459,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
+ Q $P($G(@ZTAB@(ZFN,"I")),"^",3)
 "RTN","C0CRNF",460,0)
- I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CRNF",461,0)
- Q $P($G(@ZTAB@(ZFN,"I")),"^",3)
-"RTN","C0CRNF",462,0)
  ;
 "RTN","C0CRNFRP")
-0^95^B91701220
+0^95^B90905910
 "RTN","C0CRNFRP",1,0)
 C0CRNFRP ; CCDCCR/GPL - Reference Name Format (RNF) RPCs; 12/9/09 ; 5/10/12 2:56pm
 "RTN","C0CRNFRP",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CRNFRP",3,0)
- ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
+ ;Copyright 2009 George Lilly.  
 "RTN","C0CRNFRP",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CRNFRP",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CRNFRP",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CRNFRP",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CRNFRP",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CRNFRP",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CRNFRP",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CRNFRP",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CRNFRP",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CRNFRP",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CRNFRP",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CRNFRP",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CRNFRP",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CRNFRP",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CRNFRP",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ W "This is the Reference Name Format (RNF) RPC Library ",!
 "RTN","C0CRNFRP",19,0)
- ;
+ W !
 "RTN","C0CRNFRP",20,0)
- W "This is the Reference Name Format (RNF) RPC Library ",!
+ Q
 "RTN","C0CRNFRP",21,0)
- W !
+ ;
 "RTN","C0CRNFRP",22,0)
+ ;This routine will be mirroring C0CRNF and transform the output
+"RTN","C0CRNFRP",23,0)
+ ;of the tags into an RPC friendly format
+"RTN","C0CRNFRP",24,0)
+ ;The tags will be exactly as they are in C0CRNF
+"RTN","C0CRNFRP",25,0)
+FIELDS(C0CFRTN,C0CFILE) ; RETURNS AN ARRAY OF THE FIELDS IN FILE C0CF,
+"RTN","C0CRNFRP",26,0)
+ ;C0CFRTN IS PASSED BY REFERENCE, C0CF IS PASSED BY VALUE
+"RTN","C0CRNFRP",27,0)
+ ;RETURN FORMAT:
+"RTN","C0CRNFRP",28,0)
+ ;^TMP("C0CRNF",$J,0)="NUMBER_OF_RESULTS
+"RTN","C0CRNFRP",29,0)
+ ;^TMP("C0CRNF",$J,I)="FIELD_NAME^FILE_NUMBER^FIELD_NUMBER"
+"RTN","C0CRNFRP",30,0)
+ ;
+"RTN","C0CRNFRP",31,0)
+ ;SAMPLE OUTPUT FROM FIELDS^C0CRNF:
+"RTN","C0CRNFRP",32,0)
+ ;C0CRNFFIELDS("*AMOUNT OF MILITARY RETIREMENT")="2^.3625"
+"RTN","C0CRNFRP",33,0)
+ ;
+"RTN","C0CRNFRP",34,0)
+ ;FORMAT APPEARS TO BE:
+"RTN","C0CRNFRP",35,0)
+ ;VARIABLENAME("FIELD_NAME")="FILE_NUMBER^FIELD_NUMBER"
+"RTN","C0CRNFRP",36,0)
+ ;
+"RTN","C0CRNFRP",37,0)
+ ;SET DEBUG VALUE - REQUIRED - 0=OFF 1=ON
+"RTN","C0CRNFRP",38,0)
+ S DEBUG=0
+"RTN","C0CRNFRP",39,0)
+ ;SET RETURN VALUE
+"RTN","C0CRNFRP",40,0)
+ S C0CFRTN=$NA(^TMP("C0CRNF",$J))
+"RTN","C0CRNFRP",41,0)
+ K @C0CFRTN
+"RTN","C0CRNFRP",42,0)
+ ;RUN WRAPPED CALL
+"RTN","C0CRNFRP",43,0)
+ D FIELDS^C0CRNF("C0CRTN",C0CFILE)
+"RTN","C0CRNFRP",44,0)
+ S J=""
+"RTN","C0CRNFRP",45,0)
+ S I=1
+"RTN","C0CRNFRP",46,0)
+ ;FORMAT RETURN
+"RTN","C0CRNFRP",47,0)
+ F  S J=$O(C0CRTN(J)) Q:J=""  D  ; FOR EACH FIELD IN THE ARRAY
+"RTN","C0CRNFRP",48,0)
+ . S @C0CFRTN@(I)=J_"^"_C0CRTN(J)
+"RTN","C0CRNFRP",49,0)
+ . S I=I+1
+"RTN","C0CRNFRP",50,0)
+ S @C0CFRTN@(0)=I-1
+"RTN","C0CRNFRP",51,0)
+ ;CLEAN UP
+"RTN","C0CRNFRP",52,0)
+ K J,I
+"RTN","C0CRNFRP",53,0)
  Q
-"RTN","C0CRNFRP",23,0)
- ;
-"RTN","C0CRNFRP",24,0)
- ;This routine will be mirroring C0CRNF and transform the output
-"RTN","C0CRNFRP",25,0)
- ;of the tags into an RPC friendly format
-"RTN","C0CRNFRP",26,0)
- ;The tags will be exactly as they are in C0CRNF
-"RTN","C0CRNFRP",27,0)
-FIELDS(C0CFRTN,C0CFILE) ; RETURNS AN ARRAY OF THE FIELDS IN FILE C0CF,
-"RTN","C0CRNFRP",28,0)
- ;C0CFRTN IS PASSED BY REFERENCE, C0CF IS PASSED BY VALUE
-"RTN","C0CRNFRP",29,0)
+"RTN","C0CRNFRP",54,0)
+ ;
+"RTN","C0CRNFRP",55,0)
+GETNOLD(GRTN,GFILE,GIEN,GNN) ; GET FIELDS FOR ACCESS BY NAME
+"RTN","C0CRNFRP",56,0)
+ ; GRTN IS PASSED BY NAME
+"RTN","C0CRNFRP",57,0)
+ ;
+"RTN","C0CRNFRP",58,0)
+ ; OLD TAG DO NOT USE!
+"RTN","C0CRNFRP",59,0)
+ Q
+"RTN","C0CRNFRP",60,0)
+ ;
+"RTN","C0CRNFRP",61,0)
+GETN(C0CGRTN,GFILE,GREF,GNDX,GNN) ; GET BY NAME ; RETURN A FIELD VALUE MAP
+"RTN","C0CRNFRP",62,0)
+ ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
+"RTN","C0CRNFRP",63,0)
+ ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
+"RTN","C0CRNFRP",64,0)
+ ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
+"RTN","C0CRNFRP",65,0)
+ ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
+"RTN","C0CRNFRP",66,0)
+ ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
+"RTN","C0CRNFRP",67,0)
+ ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
+"RTN","C0CRNFRP",68,0)
+ ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
+"RTN","C0CRNFRP",69,0)
+ ; .. NULL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
+"RTN","C0CRNFRP",70,0)
+ ; IF GREF IS "" THE FIRST RECORD IS OBTAINED
+"RTN","C0CRNFRP",71,0)
+ ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
+"RTN","C0CRNFRP",72,0)
+ ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
+"RTN","C0CRNFRP",73,0)
+ ; GREF IS THE VALUE FOR THE INDEX
+"RTN","C0CRNFRP",74,0)
+ ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
+"RTN","C0CRNFRP",75,0)
+ ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
+"RTN","C0CRNFRP",76,0)
+ ;
+"RTN","C0CRNFRP",77,0)
+ ;
+"RTN","C0CRNFRP",78,0)
  ;RETURN FORMAT:
-"RTN","C0CRNFRP",30,0)
- ;^TMP("C0CRNF",$J,0)="NUMBER_OF_RESULTS
-"RTN","C0CRNFRP",31,0)
- ;^TMP("C0CRNF",$J,I)="FIELD_NAME^FILE_NUMBER^FIELD_NUMBER"
-"RTN","C0CRNFRP",32,0)
- ;
-"RTN","C0CRNFRP",33,0)
+"RTN","C0CRNFRP",79,0)
+ ;^TMP("C0CRNF",$J,0)="NUMBER_OF_RESULTS^FILE_NUMBER^RNF1^IEN^CURRENT_DATE^$J^DUZ_$C(30)"
+"RTN","C0CRNFRP",80,0)
+ ;^TMP("C0CRNF",$J,I)="FIELD_NAME^FILE_NUMBER^FIELD_NUMBER^VALUE^INTERNAL_VALUE_$C(30)"
+"RTN","C0CRNFRP",81,0)
+ ;
+"RTN","C0CRNFRP",82,0)
  ;SAMPLE OUTPUT FROM FIELDS^C0CRNF:
-"RTN","C0CRNFRP",34,0)
- ;C0CRNFFIELDS("*AMOUNT OF MILITARY RETIREMENT")="2^.3625"
-"RTN","C0CRNFRP",35,0)
- ;
-"RTN","C0CRNFRP",36,0)
+"RTN","C0CRNFRP",83,0)
+ ;C0CRNFGETN(0)="2^RNF1^5095^3091209^2908^3268"
+"RTN","C0CRNFRP",84,0)
+ ;C0CRNFGETN("1U4N")="2^.0905^H5369"
+"RTN","C0CRNFRP",85,0)
+ ;C0CRNFGETN("1U4N","I")="^^H5369"
+"RTN","C0CRNFRP",86,0)
+ ;C0CRNFGETN("ADDRESS CHANGE DT/TM")="2^.118^OCT 21,2009@08:03:26"
+"RTN","C0CRNFRP",87,0)
+ ;C0CRNFGETN("ADDRESS CHANGE DT/TM","I")="^^3091021.080326"
+"RTN","C0CRNFRP",88,0)
+ ;
+"RTN","C0CRNFRP",89,0)
  ;FORMAT APPEARS TO BE:
-"RTN","C0CRNFRP",37,0)
- ;VARIABLENAME("FIELD_NAME")="FILE_NUMBER^FIELD_NUMBER"
-"RTN","C0CRNFRP",38,0)
- ;
-"RTN","C0CRNFRP",39,0)
+"RTN","C0CRNFRP",90,0)
+ ;VARIABLENAME(0)="FILE_NUMBER^RNF1^IEN^CURRENT_DATE^$J^DUZ"
+"RTN","C0CRNFRP",91,0)
+ ;VARIABLENAME("FIELD_NAME")="FILE_NUMBER^FIELD_NUMBER^VALUE"
+"RTN","C0CRNFRP",92,0)
+ ;VARIABLENAME("FIELD_NAME","I")="^^INTERNAL_VALUE"
+"RTN","C0CRNFRP",93,0)
+ ;
+"RTN","C0CRNFRP",94,0)
  ;SET DEBUG VALUE - REQUIRED - 0=OFF 1=ON
-"RTN","C0CRNFRP",40,0)
+"RTN","C0CRNFRP",95,0)
  S DEBUG=0
-"RTN","C0CRNFRP",41,0)
+"RTN","C0CRNFRP",96,0)
  ;SET RETURN VALUE
-"RTN","C0CRNFRP",42,0)
- S C0CFRTN=$NA(^TMP("C0CRNF",$J))
-"RTN","C0CRNFRP",43,0)
- K @C0CFRTN
-"RTN","C0CRNFRP",44,0)
+"RTN","C0CRNFRP",97,0)
+ S C0CGRTN=$NA(^TMP("C0CRNF",$J))
+"RTN","C0CRNFRP",98,0)
+ K @C0CGRTN
+"RTN","C0CRNFRP",99,0)
  ;RUN WRAPPED CALL
-"RTN","C0CRNFRP",45,0)
- D FIELDS^C0CRNF("C0CRTN",C0CFILE)
-"RTN","C0CRNFRP",46,0)
+"RTN","C0CRNFRP",100,0)
+ D GETN^C0CRNF("C0CRTN",$G(GFILE),$G(GREF),$G(GNDX),$G(GNN))
+"RTN","C0CRNFRP",101,0)
  S J=""
-"RTN","C0CRNFRP",47,0)
+"RTN","C0CRNFRP",102,0)
  S I=1
-"RTN","C0CRNFRP",48,0)
+"RTN","C0CRNFRP",103,0)
  ;FORMAT RETURN
-"RTN","C0CRNFRP",49,0)
+"RTN","C0CRNFRP",104,0)
  F  S J=$O(C0CRTN(J)) Q:J=""  D  ; FOR EACH FIELD IN THE ARRAY
-"RTN","C0CRNFRP",50,0)
- . S @C0CFRTN@(I)=J_"^"_C0CRTN(J)
-"RTN","C0CRNFRP",51,0)
+"RTN","C0CRNFRP",105,0)
+ . I J=0 S J=$O(C0CRTN(J)) ; SKIP THE 0 NODE
+"RTN","C0CRNFRP",106,0)
+ . S @C0CGRTN@(I)=J_"^"_C0CRTN(J)_"^" ; GETS THE FIRST LINE
+"RTN","C0CRNFRP",107,0)
+ . ;S J=$O(C0CRTN(J)) ; INCREMENT J SO WE CAN GET THE INTERNAL DATA
+"RTN","C0CRNFRP",108,0)
+ . ;TEST TO SEE IF INTERNAL DATA EXISTS
+"RTN","C0CRNFRP",109,0)
+ . I $D(C0CRTN(J,"I"))=1 D
+"RTN","C0CRNFRP",110,0)
+ . . S @C0CGRTN@(I)=@C0CGRTN@(I)_$P(C0CRTN(J,"I"),U,3) ; GETS THE INTERNAL VALUE PIECE 3
+"RTN","C0CRNFRP",111,0)
  . S I=I+1
-"RTN","C0CRNFRP",52,0)
- S @C0CFRTN@(0)=I-1
-"RTN","C0CRNFRP",53,0)
+"RTN","C0CRNFRP",112,0)
+ S @C0CGRTN@(0)=I-1_"^"_C0CRTN(0)
+"RTN","C0CRNFRP",113,0)
  ;CLEAN UP
-"RTN","C0CRNFRP",54,0)
+"RTN","C0CRNFRP",114,0)
  K J,I
-"RTN","C0CRNFRP",55,0)
+"RTN","C0CRNFRP",115,0)
  Q
-"RTN","C0CRNFRP",56,0)
- ;
-"RTN","C0CRNFRP",57,0)
-GETNOLD(GRTN,GFILE,GIEN,GNN) ; GET FIELDS FOR ACCESS BY NAME
-"RTN","C0CRNFRP",58,0)
- ; GRTN IS PASSED BY NAME
-"RTN","C0CRNFRP",59,0)
- ;
-"RTN","C0CRNFRP",60,0)
- ; OLD TAG DO NOT USE!
-"RTN","C0CRNFRP",61,0)
+"RTN","C0CRNFRP",116,0)
+ ;
+"RTN","C0CRNFRP",117,0)
+GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP
+"RTN","C0CRNFRP",118,0)
+ ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
+"RTN","C0CRNFRP",119,0)
+ ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
+"RTN","C0CRNFRP",120,0)
+ ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
+"RTN","C0CRNFRP",121,0)
+ ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
+"RTN","C0CRNFRP",122,0)
+ ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
+"RTN","C0CRNFRP",123,0)
+ ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
+"RTN","C0CRNFRP",124,0)
+ ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
+"RTN","C0CRNFRP",125,0)
+ ; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
+"RTN","C0CRNFRP",126,0)
+ ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
+"RTN","C0CRNFRP",127,0)
+ ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
+"RTN","C0CRNFRP",128,0)
+ ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
+"RTN","C0CRNFRP",129,0)
+ ; IF GREF IS "" THE FIRST RECORD IS OBTAINED
+"RTN","C0CRNFRP",130,0)
+ ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
+"RTN","C0CRNFRP",131,0)
+ ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
+"RTN","C0CRNFRP",132,0)
+ ; GREF IS THE VALUE FOR THE INDEX
+"RTN","C0CRNFRP",133,0)
+ ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
+"RTN","C0CRNFRP",134,0)
+ ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
+"RTN","C0CRNFRP",135,0)
+ ;
+"RTN","C0CRNFRP",136,0)
+ ;
+"RTN","C0CRNFRP",137,0)
+ N GIEN,GF
+"RTN","C0CRNFRP",138,0)
+ S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE
+"RTN","C0CRNFRP",139,0)
+ I ('$D(GNDX))!(GNDX="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN
+"RTN","C0CRNFRP",140,0)
+ E  D  ; WE ARE USING AN INDEX
+"RTN","C0CRNFRP",141,0)
+ . ;N ZG
+"RTN","C0CRNFRP",142,0)
+ . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX
+"RTN","C0CRNFRP",143,0)
+ . I ZG'="" D  ;
+"RTN","C0CRNFRP",144,0)
+ . . I $QS(ZG,3)=GREF D  ; IS GREF IN INDEX?
+"RTN","C0CRNFRP",145,0)
+ . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN
+"RTN","C0CRNFRP",146,0)
+ . . E  S GIEN="" ; NOT FOUND IN INDEX
+"RTN","C0CRNFRP",147,0)
+ . E  S GIEN="" ;
+"RTN","C0CRNFRP",148,0)
+ ;W "IEN: ",GIEN,!
+"RTN","C0CRNFRP",149,0)
+ ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
+"RTN","C0CRNFRP",150,0)
+ I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
+"RTN","C0CRNFRP",151,0)
+ E  S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
+"RTN","C0CRNFRP",152,0)
+ S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
+"RTN","C0CRNFRP",153,0)
+ D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
+"RTN","C0CRNFRP",154,0)
+ K C0CTMP
+"RTN","C0CRNFRP",155,0)
+ D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
+"RTN","C0CRNFRP",156,0)
+ D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
+"RTN","C0CRNFRP",157,0)
+ S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
+"RTN","C0CRNFRP",158,0)
+ S (C0CI,C0CJ)=""
+"RTN","C0CRNFRP",159,0)
+ F  S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ=""  D  ; FOR ALL SUBFILES
+"RTN","C0CRNFRP",160,0)
+ . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
+"RTN","C0CRNFRP",161,0)
+ . F  S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI=""  D  ; ARRAY OF FIELDS
+"RTN","C0CRNFRP",162,0)
+ . . ;W C0CJ," ",C0CI,!
+"RTN","C0CRNFRP",163,0)
+ . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
+"RTN","C0CRNFRP",164,0)
+ . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
+"RTN","C0CRNFRP",165,0)
+ . . I C0CVALUE["C0CTMP" D  ; WP FIELD
+"RTN","C0CRNFRP",166,0)
+ . . . N ZT,ZWP S ZWP=0 ;ITERATOR
+"RTN","C0CRNFRP",167,0)
+ . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
+"RTN","C0CRNFRP",168,0)
+ . . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE
+"RTN","C0CRNFRP",169,0)
+ . . . F  S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP  D  ;
+"RTN","C0CRNFRP",170,0)
+ . . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP
+"RTN","C0CRNFRP",171,0)
+ . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
+"RTN","C0CRNFRP",172,0)
+ . . . . S C0CVALUE=C0CVALUE_ZT ;
+"RTN","C0CRNFRP",173,0)
+ . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
+"RTN","C0CRNFRP",174,0)
+ . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I"))
+"RTN","C0CRNFRP",175,0)
+ I C0CNN D  ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
+"RTN","C0CRNFRP",176,0)
+ . S C0CI=""
+"RTN","C0CRNFRP",177,0)
+ . F  S C0CI=$O(@GRTN@(C0CI)) Q:C0CI=""  D  ; GO THROUGH THE WHOLE ARRAY
+"RTN","C0CRNFRP",178,0)
+ . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
+"RTN","C0CRNFRP",179,0)
  Q
-"RTN","C0CRNFRP",62,0)
- ;
-"RTN","C0CRNFRP",63,0)
-GETN(C0CGRTN,GFILE,GREF,GNDX,GNN) ; GET BY NAME ; RETURN A FIELD VALUE MAP
-"RTN","C0CRNFRP",64,0)
- ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
-"RTN","C0CRNFRP",65,0)
- ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
-"RTN","C0CRNFRP",66,0)
- ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
-"RTN","C0CRNFRP",67,0)
+"RTN","C0CRNFRP",180,0)
+ ;
+"RTN","C0CRNFRP",181,0)
+GETN2(GARTN,GAFILE,GAIDX,GACNT,GASTRT,GANN) ; RETURN FIELD MAP AND VALUES
+"RTN","C0CRNFRP",182,0)
+ ; GARTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
+"RTN","C0CRNFRP",183,0)
+ ; .. FIELD MAP @GARTN@("F","FIELDNAME")="FILE;FIELD#"
+"RTN","C0CRNFRP",184,0)
  ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
-"RTN","C0CRNFRP",68,0)
- ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
-"RTN","C0CRNFRP",69,0)
- ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
-"RTN","C0CRNFRP",70,0)
- ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
-"RTN","C0CRNFRP",71,0)
- ; .. NULL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
-"RTN","C0CRNFRP",72,0)
- ; IF GREF IS "" THE FIRST RECORD IS OBTAINED
-"RTN","C0CRNFRP",73,0)
- ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
-"RTN","C0CRNFRP",74,0)
- ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
-"RTN","C0CRNFRP",75,0)
- ; GREF IS THE VALUE FOR THE INDEX
-"RTN","C0CRNFRP",76,0)
+"RTN","C0CRNFRP",185,0)
+ ; .. VALUE MAP @GARTN@("V","IEN","FIELDNAME","N")=VALUE
+"RTN","C0CRNFRP",186,0)
+ ; .. WHERE N IS THE INDEX FOR MULTIPLES.. 1 FOR SINGLE VALUES
+"RTN","C0CRNFRP",187,0)
+ ; .. GARTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
+"RTN","C0CRNFRP",188,0)
+ ; .. IF GANN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
+"RTN","C0CRNFRP",189,0)
+ ; .. EVEN IF GANN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
+"RTN","C0CRNFRP",190,0)
+ ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
+"RTN","C0CRNFRP",191,0)
+ ; GAFILE IS THE FILE NUMBER TO BE PROCESSED. IT IS PASSED BY VALUE
+"RTN","C0CRNFRP",192,0)
+ ; GAIDX IS THE OPTIONAL INDEX TO USE IN THE FILE. IF GAIDX IS "" THE IEN
+"RTN","C0CRNFRP",193,0)
+ ; .. OF THE FILE WILL BE USED
+"RTN","C0CRNFRP",194,0)
+ ; GACNT IS THE NUMBER OF RECORDS TO PROCESS. IT IS PASSED BY VALUE
+"RTN","C0CRNFRP",195,0)
+ ; .. IF GARCNT IS NULL, ALL RECORDS ARE PROCESSED
+"RTN","C0CRNFRP",196,0)
+ ; GASTRT IS THE IEN OF THE FIRST RECORD TO PROCESS. IT IS PASSED BY VALUE
+"RTN","C0CRNFRP",197,0)
+ ; .. IF GARSTART IS NULL, PROCESSING STARTS AT THE FIRST RECORD
+"RTN","C0CRNFRP",198,0)
  ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
-"RTN","C0CRNFRP",77,0)
- ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
-"RTN","C0CRNFRP",78,0)
- ;
-"RTN","C0CRNFRP",79,0)
- ;
-"RTN","C0CRNFRP",80,0)
- ;RETURN FORMAT:
-"RTN","C0CRNFRP",81,0)
- ;^TMP("C0CRNF",$J,0)="NUMBER_OF_RESULTS^FILE_NUMBER^RNF1^IEN^CURRENT_DATE^$J^DUZ_$C(30)"
-"RTN","C0CRNFRP",82,0)
- ;^TMP("C0CRNF",$J,I)="FIELD_NAME^FILE_NUMBER^FIELD_NUMBER^VALUE^INTERNAL_VALUE_$C(30)"
-"RTN","C0CRNFRP",83,0)
- ;
-"RTN","C0CRNFRP",84,0)
- ;SAMPLE OUTPUT FROM FIELDS^C0CRNF:
-"RTN","C0CRNFRP",85,0)
- ;C0CRNFGETN(0)="2^RNF1^5095^3091209^2908^3268"
-"RTN","C0CRNFRP",86,0)
- ;C0CRNFGETN("1U4N")="2^.0905^H5369"
-"RTN","C0CRNFRP",87,0)
- ;C0CRNFGETN("1U4N","I")="^^H5369"
-"RTN","C0CRNFRP",88,0)
- ;C0CRNFGETN("ADDRESS CHANGE DT/TM")="2^.118^OCT 21,2009@08:03:26"
-"RTN","C0CRNFRP",89,0)
- ;C0CRNFGETN("ADDRESS CHANGE DT/TM","I")="^^3091021.080326"
-"RTN","C0CRNFRP",90,0)
- ;
-"RTN","C0CRNFRP",91,0)
- ;FORMAT APPEARS TO BE:
-"RTN","C0CRNFRP",92,0)
- ;VARIABLENAME(0)="FILE_NUMBER^RNF1^IEN^CURRENT_DATE^$J^DUZ"
-"RTN","C0CRNFRP",93,0)
- ;VARIABLENAME("FIELD_NAME")="FILE_NUMBER^FIELD_NUMBER^VALUE"
-"RTN","C0CRNFRP",94,0)
- ;VARIABLENAME("FIELD_NAME","I")="^^INTERNAL_VALUE"
-"RTN","C0CRNFRP",95,0)
- ;
-"RTN","C0CRNFRP",96,0)
- ;SET DEBUG VALUE - REQUIRED - 0=OFF 1=ON
-"RTN","C0CRNFRP",97,0)
- S DEBUG=0
-"RTN","C0CRNFRP",98,0)
- ;SET RETURN VALUE
-"RTN","C0CRNFRP",99,0)
- S C0CGRTN=$NA(^TMP("C0CRNF",$J))
-"RTN","C0CRNFRP",100,0)
- K @C0CGRTN
-"RTN","C0CRNFRP",101,0)
- ;RUN WRAPPED CALL
-"RTN","C0CRNFRP",102,0)
- D GETN^C0CRNF("C0CRTN",$G(GFILE),$G(GREF),$G(GNDX),$G(GNN))
-"RTN","C0CRNFRP",103,0)
- S J=""
-"RTN","C0CRNFRP",104,0)
- S I=1
-"RTN","C0CRNFRP",105,0)
- ;FORMAT RETURN
-"RTN","C0CRNFRP",106,0)
- F  S J=$O(C0CRTN(J)) Q:J=""  D  ; FOR EACH FIELD IN THE ARRAY
-"RTN","C0CRNFRP",107,0)
- . I J=0 S J=$O(C0CRTN(J)) ; SKIP THE 0 NODE
-"RTN","C0CRNFRP",108,0)
- . S @C0CGRTN@(I)=J_"^"_C0CRTN(J)_"^" ; GETS THE FIRST LINE
-"RTN","C0CRNFRP",109,0)
- . ;S J=$O(C0CRTN(J)) ; INCREMENT J SO WE CAN GET THE INTERNAL DATA
-"RTN","C0CRNFRP",110,0)
- . ;TEST TO SEE IF INTERNAL DATA EXISTS
-"RTN","C0CRNFRP",111,0)
- . I $D(C0CRTN(J,"I"))=1 D
-"RTN","C0CRNFRP",112,0)
- . . S @C0CGRTN@(I)=@C0CGRTN@(I)_$P(C0CRTN(J,"I"),U,3) ; GETS THE INTERNAL VALUE PIECE 3
-"RTN","C0CRNFRP",113,0)
- . S I=I+1
-"RTN","C0CRNFRP",114,0)
- S @C0CGRTN@(0)=I-1_"^"_C0CRTN(0)
-"RTN","C0CRNFRP",115,0)
- ;CLEAN UP
-"RTN","C0CRNFRP",116,0)
- K J,I
-"RTN","C0CRNFRP",117,0)
+"RTN","C0CRNFRP",199,0)
+ ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GARFLD AND GARVAL
+"RTN","C0CRNFRP",200,0)
+ ;N GATMP,GAI,GAF
+"RTN","C0CRNFRP",201,0)
+ S GAF=$$FILEREF(GAFILE) ; GET CLOSED ROOT FOR THE FILE NUMBER GAFILE
+"RTN","C0CRNFRP",202,0)
+ I '$D(GAIDX) S GAIDX="" ;DEFAULT
+"RTN","C0CRNFRP",203,0)
+ I '$D(GANN) S GANN="" ;DEFAULT ONLY POPULATED FIELDS RETURNED
+"RTN","C0CRNFRP",204,0)
+ I GAIDX'="" S GAF=$NA(@GAF@(GAIDX)) ; IF WE ARE USING AN INDEX
+"RTN","C0CRNFRP",205,0)
+ W GAF,!
+"RTN","C0CRNFRP",206,0)
+ W $O(@GAF@(0)) ;
+"RTN","C0CRNFRP",207,0)
+ S GAI=0 ;ITERATOR
+"RTN","C0CRNFRP",208,0)
+ F  S GAI=$O(@GAF@(GAI)) Q:GAI=""  D  ;
+"RTN","C0CRNFRP",209,0)
+ . D GETN1("GATMP",GAFILE,GAI,GAIDX,GANN) ;GET ONE RECORD
+"RTN","C0CRNFRP",210,0)
+ . N GAX S GAX=0
+"RTN","C0CRNFRP",211,0)
+ . F  S GAX=$O(GATMP(GAX)) Q:GAX=""  D  ;PULL OUT THE FIELDS
+"RTN","C0CRNFRP",212,0)
+ . . D ADDNV(GARTN,GAI,GAX,GATMP(GAX)) ;INSERT THE NAME/VALUE INTO GARTN
+"RTN","C0CRNFRP",213,0)
  Q
-"RTN","C0CRNFRP",118,0)
- ;
-"RTN","C0CRNFRP",119,0)
-GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP
-"RTN","C0CRNFRP",120,0)
- ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
-"RTN","C0CRNFRP",121,0)
- ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
-"RTN","C0CRNFRP",122,0)
- ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
-"RTN","C0CRNFRP",123,0)
- ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
-"RTN","C0CRNFRP",124,0)
- ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
-"RTN","C0CRNFRP",125,0)
- ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
-"RTN","C0CRNFRP",126,0)
- ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
-"RTN","C0CRNFRP",127,0)
- ; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
-"RTN","C0CRNFRP",128,0)
- ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
-"RTN","C0CRNFRP",129,0)
- ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
-"RTN","C0CRNFRP",130,0)
- ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
-"RTN","C0CRNFRP",131,0)
- ; IF GREF IS "" THE FIRST RECORD IS OBTAINED
-"RTN","C0CRNFRP",132,0)
- ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
-"RTN","C0CRNFRP",133,0)
- ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
-"RTN","C0CRNFRP",134,0)
- ; GREF IS THE VALUE FOR THE INDEX
-"RTN","C0CRNFRP",135,0)
- ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
-"RTN","C0CRNFRP",136,0)
- ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
-"RTN","C0CRNFRP",137,0)
- ;
-"RTN","C0CRNFRP",138,0)
- ;
-"RTN","C0CRNFRP",139,0)
- N GIEN,GF
-"RTN","C0CRNFRP",140,0)
- S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE
-"RTN","C0CRNFRP",141,0)
- I ('$D(GNDX))!(GNDX="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN
-"RTN","C0CRNFRP",142,0)
- E  D  ; WE ARE USING AN INDEX
-"RTN","C0CRNFRP",143,0)
- . ;N ZG
-"RTN","C0CRNFRP",144,0)
- . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX
-"RTN","C0CRNFRP",145,0)
- . I ZG'="" D  ;
-"RTN","C0CRNFRP",146,0)
- . . I $QS(ZG,3)=GREF D  ; IS GREF IN INDEX?
-"RTN","C0CRNFRP",147,0)
- . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN
-"RTN","C0CRNFRP",148,0)
- . . E  S GIEN="" ; NOT FOUND IN INDEX
-"RTN","C0CRNFRP",149,0)
- . E  S GIEN="" ;
-"RTN","C0CRNFRP",150,0)
- ;W "IEN: ",GIEN,!
-"RTN","C0CRNFRP",151,0)
- ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
-"RTN","C0CRNFRP",152,0)
- I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
-"RTN","C0CRNFRP",153,0)
- E  S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
-"RTN","C0CRNFRP",154,0)
- S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
-"RTN","C0CRNFRP",155,0)
- D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
-"RTN","C0CRNFRP",156,0)
- K C0CTMP
-"RTN","C0CRNFRP",157,0)
- D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
-"RTN","C0CRNFRP",158,0)
- D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
-"RTN","C0CRNFRP",159,0)
- S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
-"RTN","C0CRNFRP",160,0)
- S (C0CI,C0CJ)=""
-"RTN","C0CRNFRP",161,0)
- F  S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ=""  D  ; FOR ALL SUBFILES
-"RTN","C0CRNFRP",162,0)
- . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
-"RTN","C0CRNFRP",163,0)
- . F  S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI=""  D  ; ARRAY OF FIELDS
-"RTN","C0CRNFRP",164,0)
- . . ;W C0CJ," ",C0CI,!
-"RTN","C0CRNFRP",165,0)
- . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
-"RTN","C0CRNFRP",166,0)
- . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
-"RTN","C0CRNFRP",167,0)
- . . I C0CVALUE["C0CTMP" D  ; WP FIELD
-"RTN","C0CRNFRP",168,0)
- . . . N ZT,ZWP S ZWP=0 ;ITERATOR
-"RTN","C0CRNFRP",169,0)
- . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
-"RTN","C0CRNFRP",170,0)
- . . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE
-"RTN","C0CRNFRP",171,0)
- . . . F  S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP  D  ;
-"RTN","C0CRNFRP",172,0)
- . . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP
-"RTN","C0CRNFRP",173,0)
- . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
-"RTN","C0CRNFRP",174,0)
- . . . . S C0CVALUE=C0CVALUE_ZT ;
-"RTN","C0CRNFRP",175,0)
- . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
-"RTN","C0CRNFRP",176,0)
- . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I"))
-"RTN","C0CRNFRP",177,0)
- I C0CNN D  ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
-"RTN","C0CRNFRP",178,0)
- . S C0CI=""
-"RTN","C0CRNFRP",179,0)
- . F  S C0CI=$O(@GRTN@(C0CI)) Q:C0CI=""  D  ; GO THROUGH THE WHOLE ARRAY
-"RTN","C0CRNFRP",180,0)
- . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
-"RTN","C0CRNFRP",181,0)
+"RTN","C0CRNFRP",214,0)
+ ;
+"RTN","C0CRNFRP",215,0)
+ADDNV(GNV,GNVN,GNVF,GNVV) ; CREATE AN ELEMENT OF THE MATRIX
+"RTN","C0CRNFRP",216,0)
+ ;
+"RTN","C0CRNFRP",217,0)
+ S @GNV@("F",GNVF)=$P(GNVV,"^",1)_"^"_$P(GNVV,"^",2) ;NAME=FILE^FIELD#
+"RTN","C0CRNFRP",218,0)
+ S @GNV@("V",GNVN,GNVF,1)=$P(GNVV,"^",3) ;SET THE VALUE
+"RTN","C0CRNFRP",219,0)
  Q
-"RTN","C0CRNFRP",182,0)
- ;
-"RTN","C0CRNFRP",183,0)
-GETN2(GARTN,GAFILE,GAIDX,GACNT,GASTRT,GANN) ; RETURN FIELD MAP AND VALUES
-"RTN","C0CRNFRP",184,0)
- ; GARTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
-"RTN","C0CRNFRP",185,0)
- ; .. FIELD MAP @GARTN@("F","FIELDNAME")="FILE;FIELD#"
-"RTN","C0CRNFRP",186,0)
- ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
-"RTN","C0CRNFRP",187,0)
- ; .. VALUE MAP @GARTN@("V","IEN","FIELDNAME","N")=VALUE
-"RTN","C0CRNFRP",188,0)
- ; .. WHERE N IS THE INDEX FOR MULTIPLES.. 1 FOR SINGLE VALUES
-"RTN","C0CRNFRP",189,0)
- ; .. GARTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
-"RTN","C0CRNFRP",190,0)
- ; .. IF GANN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
-"RTN","C0CRNFRP",191,0)
- ; .. EVEN IF GANN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
-"RTN","C0CRNFRP",192,0)
- ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
-"RTN","C0CRNFRP",193,0)
- ; GAFILE IS THE FILE NUMBER TO BE PROCESSED. IT IS PASSED BY VALUE
-"RTN","C0CRNFRP",194,0)
- ; GAIDX IS THE OPTIONAL INDEX TO USE IN THE FILE. IF GAIDX IS "" THE IEN
-"RTN","C0CRNFRP",195,0)
- ; .. OF THE FILE WILL BE USED
-"RTN","C0CRNFRP",196,0)
- ; GACNT IS THE NUMBER OF RECORDS TO PROCESS. IT IS PASSED BY VALUE
-"RTN","C0CRNFRP",197,0)
- ; .. IF GARCNT IS NULL, ALL RECORDS ARE PROCESSED
-"RTN","C0CRNFRP",198,0)
- ; GASTRT IS THE IEN OF THE FIRST RECORD TO PROCESS. IT IS PASSED BY VALUE
-"RTN","C0CRNFRP",199,0)
- ; .. IF GARSTART IS NULL, PROCESSING STARTS AT THE FIRST RECORD
-"RTN","C0CRNFRP",200,0)
- ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
-"RTN","C0CRNFRP",201,0)
- ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GARFLD AND GARVAL
-"RTN","C0CRNFRP",202,0)
- ;N GATMP,GAI,GAF
-"RTN","C0CRNFRP",203,0)
- S GAF=$$FILEREF(GAFILE) ; GET CLOSED ROOT FOR THE FILE NUMBER GAFILE
-"RTN","C0CRNFRP",204,0)
- I '$D(GAIDX) S GAIDX="" ;DEFAULT
-"RTN","C0CRNFRP",205,0)
- I '$D(GANN) S GANN="" ;DEFAULT ONLY POPULATED FIELDS RETURNED
-"RTN","C0CRNFRP",206,0)
- I GAIDX'="" S GAF=$NA(@GAF@(GAIDX)) ; IF WE ARE USING AN INDEX
-"RTN","C0CRNFRP",207,0)
- W GAF,!
-"RTN","C0CRNFRP",208,0)
- W $O(@GAF@(0)) ;
-"RTN","C0CRNFRP",209,0)
- S GAI=0 ;ITERATOR
-"RTN","C0CRNFRP",210,0)
- F  S GAI=$O(@GAF@(GAI)) Q:GAI=""  D  ;
-"RTN","C0CRNFRP",211,0)
- . D GETN1("GATMP",GAFILE,GAI,GAIDX,GANN) ;GET ONE RECORD
-"RTN","C0CRNFRP",212,0)
- . N GAX S GAX=0
-"RTN","C0CRNFRP",213,0)
- . F  S GAX=$O(GATMP(GAX)) Q:GAX=""  D  ;PULL OUT THE FIELDS
-"RTN","C0CRNFRP",214,0)
- . . D ADDNV(GARTN,GAI,GAX,GATMP(GAX)) ;INSERT THE NAME/VALUE INTO GARTN
-"RTN","C0CRNFRP",215,0)
+"RTN","C0CRNFRP",220,0)
+ ;
+"RTN","C0CRNFRP",221,0)
+RNF2CSV(RNRTN,RNIN,RNSTY) ;CONVERTS AN RFN2 GLOBAL TO A CSV FORMAT
+"RTN","C0CRNFRP",222,0)
+ ; READY TO WRITE FOR USE WITH EXCEL @RNRTN@(0) IS NUMBER OF LINES
+"RTN","C0CRNFRP",223,0)
+ ; RNSTY IS STYLE OF THE OUTPUT -
+"RTN","C0CRNFRP",224,0)
+ ; .. "NV"= ROWS ARE NAMES, COLUMNS ARE VALUES
+"RTN","C0CRNFRP",225,0)
+ ; .. "VN"= ROWS ARE VALUES, COLUMNS ARE NAMES
+"RTN","C0CRNFRP",226,0)
+ ; .. DEFAULT IS "NV" BECAUSE MANY MATRICES HAVE MORE FIELDS THAN VALUES
+"RTN","C0CRNFRP",227,0)
+ N RNR,RNC ;ROW ROOT,COL ROOT
+"RTN","C0CRNFRP",228,0)
+ N RNI,RNJ,RNX
+"RTN","C0CRNFRP",229,0)
+ I '$D(RNSTY) S RNSTY="NV" ;DEFAULT
+"RTN","C0CRNFRP",230,0)
+ I RNSTY="NV" D NV(RNRTN,RNIN)  ; INTERNAL SUBROUTINES DEPENDING ON ORIENTATION
+"RTN","C0CRNFRP",231,0)
+ E  D VN(RNRTN,RNIN) ;
+"RTN","C0CRNFRP",232,0)
  Q
-"RTN","C0CRNFRP",216,0)
- ;
-"RTN","C0CRNFRP",217,0)
-ADDNV(GNV,GNVN,GNVF,GNVV) ; CREATE AN ELEMENT OF THE MATRIX
-"RTN","C0CRNFRP",218,0)
- ;
-"RTN","C0CRNFRP",219,0)
- S @GNV@("F",GNVF)=$P(GNVV,"^",1)_"^"_$P(GNVV,"^",2) ;NAME=FILE^FIELD#
-"RTN","C0CRNFRP",220,0)
- S @GNV@("V",GNVN,GNVF,1)=$P(GNVV,"^",3) ;SET THE VALUE
-"RTN","C0CRNFRP",221,0)
+"RTN","C0CRNFRP",233,0)
+ ;
+"RTN","C0CRNFRP",234,0)
+NV(RNRTN,RNIN) ;
+"RTN","C0CRNFRP",235,0)
+ S RNR=$NA(@RNIN@("F"))
+"RTN","C0CRNFRP",236,0)
+ S RNC=$NA(@RNIN@("V"))
+"RTN","C0CRNFRP",237,0)
+ ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
+"RTN","C0CRNFRP",238,0)
+ S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD"
+"RTN","C0CRNFRP",239,0)
+ S RNI=""
+"RTN","C0CRNFRP",240,0)
+ F  S RNI=$O(@RNC@(RNI)) Q:RNI=""  D  ; FOR EACH COLUMN
+"RTN","C0CRNFRP",241,0)
+ . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
+"RTN","C0CRNFRP",242,0)
+ S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
+"RTN","C0CRNFRP",243,0)
+ D PUSH^GPLXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
+"RTN","C0CRNFRP",244,0)
+ S RNI=""
+"RTN","C0CRNFRP",245,0)
+ F  S RNI=$O(@RNR@(RNI)) Q:RNI=""  D  ; FOR EACH ROW
+"RTN","C0CRNFRP",246,0)
+ . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
+"RTN","C0CRNFRP",247,0)
+ . S RNJ=""
+"RTN","C0CRNFRP",248,0)
+ . F  S RNJ=$O(@RNC@(RNJ)) Q:RNJ=""  D  ; FOR EACH COL
+"RTN","C0CRNFRP",249,0)
+ . . I $D(@RNC@(RNJ,RNI,1)) D  ; THIS ROW HAS THIS COLUMN
+"RTN","C0CRNFRP",250,0)
+ . . . S RNX=RNX_""""_@RNC@(RNJ,RNI,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA
+"RTN","C0CRNFRP",251,0)
+ . . E  S RNX=RNX_"," ; NUL COLUMN
+"RTN","C0CRNFRP",252,0)
+ . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
+"RTN","C0CRNFRP",253,0)
+ . D PUSH^GPLXPATH(RNRTN,RNX)
+"RTN","C0CRNFRP",254,0)
  Q
-"RTN","C0CRNFRP",222,0)
- ;
-"RTN","C0CRNFRP",223,0)
-RNF2CSV(RNRTN,RNIN,RNSTY) ;CONVERTS AN RFN2 GLOBAL TO A CSV FORMAT
-"RTN","C0CRNFRP",224,0)
- ; READY TO WRITE FOR USE WITH EXCEL @RNRTN@(0) IS NUMBER OF LINES
-"RTN","C0CRNFRP",225,0)
- ; RNSTY IS STYLE OF THE OUTPUT -
-"RTN","C0CRNFRP",226,0)
- ; .. "NV"= ROWS ARE NAMES, COLUMNS ARE VALUES
-"RTN","C0CRNFRP",227,0)
- ; .. "VN"= ROWS ARE VALUES, COLUMNS ARE NAMES
-"RTN","C0CRNFRP",228,0)
- ; .. DEFAULT IS "NV" BECAUSE MANY MATRICES HAVE MORE FIELDS THAN VALUES
-"RTN","C0CRNFRP",229,0)
- N RNR,RNC ;ROW ROOT,COL ROOT
-"RTN","C0CRNFRP",230,0)
- N RNI,RNJ,RNX
-"RTN","C0CRNFRP",231,0)
- I '$D(RNSTY) S RNSTY="NV" ;DEFAULT
-"RTN","C0CRNFRP",232,0)
- I RNSTY="NV" D NV(RNRTN,RNIN)  ; INTERNAL SUBROUTINES DEPENDING ON ORIENTATION
-"RTN","C0CRNFRP",233,0)
- E  D VN(RNRTN,RNIN) ;
-"RTN","C0CRNFRP",234,0)
+"RTN","C0CRNFRP",255,0)
+ ;
+"RTN","C0CRNFRP",256,0)
+VN(RNRTN,RNIN) ;
+"RTN","C0CRNFRP",257,0)
+ S RNR=$NA(@RNIN@("V"))
+"RTN","C0CRNFRP",258,0)
+ S RNC=$NA(@RNIN@("F"))
+"RTN","C0CRNFRP",259,0)
+ ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
+"RTN","C0CRNFRP",260,0)
+ S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD"
+"RTN","C0CRNFRP",261,0)
+ S RNI=""
+"RTN","C0CRNFRP",262,0)
+ F  S RNI=$O(@RNC@(RNI)) Q:RNI=""  D  ; FOR EACH COLUMN
+"RTN","C0CRNFRP",263,0)
+ . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
+"RTN","C0CRNFRP",264,0)
+ S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
+"RTN","C0CRNFRP",265,0)
+ D PUSH^GPLXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
+"RTN","C0CRNFRP",266,0)
+ S RNI=""
+"RTN","C0CRNFRP",267,0)
+ F  S RNI=$O(@RNR@(RNI)) Q:RNI=""  D  ; FOR EACH ROW
+"RTN","C0CRNFRP",268,0)
+ . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
+"RTN","C0CRNFRP",269,0)
+ . S RNJ=""
+"RTN","C0CRNFRP",270,0)
+ . F  S RNJ=$O(@RNC@(RNJ)) Q:RNJ=""  D  ; FOR EACH COL
+"RTN","C0CRNFRP",271,0)
+ . . I $D(@RNR@(RNI,RNJ,1)) D  ; THIS ROW HAS THIS COLUMN
+"RTN","C0CRNFRP",272,0)
+ . . . S RNX=RNX_""""_@RNR@(RNI,RNJ,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA
+"RTN","C0CRNFRP",273,0)
+ . . E  S RNX=RNX_"," ; NUL COLUMN
+"RTN","C0CRNFRP",274,0)
+ . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
+"RTN","C0CRNFRP",275,0)
+ . D PUSH^GPLXPATH(RNRTN,RNX)
+"RTN","C0CRNFRP",276,0)
  Q
-"RTN","C0CRNFRP",235,0)
- ;
-"RTN","C0CRNFRP",236,0)
-NV(RNRTN,RNIN) ;
-"RTN","C0CRNFRP",237,0)
- S RNR=$NA(@RNIN@("F"))
-"RTN","C0CRNFRP",238,0)
- S RNC=$NA(@RNIN@("V"))
-"RTN","C0CRNFRP",239,0)
- ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
-"RTN","C0CRNFRP",240,0)
- S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD"
-"RTN","C0CRNFRP",241,0)
- S RNI=""
-"RTN","C0CRNFRP",242,0)
- F  S RNI=$O(@RNC@(RNI)) Q:RNI=""  D  ; FOR EACH COLUMN
-"RTN","C0CRNFRP",243,0)
- . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
-"RTN","C0CRNFRP",244,0)
- S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
-"RTN","C0CRNFRP",245,0)
- D PUSH^GPLXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
-"RTN","C0CRNFRP",246,0)
- S RNI=""
-"RTN","C0CRNFRP",247,0)
- F  S RNI=$O(@RNR@(RNI)) Q:RNI=""  D  ; FOR EACH ROW
-"RTN","C0CRNFRP",248,0)
- . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
-"RTN","C0CRNFRP",249,0)
- . S RNJ=""
-"RTN","C0CRNFRP",250,0)
- . F  S RNJ=$O(@RNC@(RNJ)) Q:RNJ=""  D  ; FOR EACH COL
-"RTN","C0CRNFRP",251,0)
- . . I $D(@RNC@(RNJ,RNI,1)) D  ; THIS ROW HAS THIS COLUMN
-"RTN","C0CRNFRP",252,0)
- . . . S RNX=RNX_""""_@RNC@(RNJ,RNI,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA
-"RTN","C0CRNFRP",253,0)
- . . E  S RNX=RNX_"," ; NUL COLUMN
-"RTN","C0CRNFRP",254,0)
- . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
-"RTN","C0CRNFRP",255,0)
- . D PUSH^GPLXPATH(RNRTN,RNX)
-"RTN","C0CRNFRP",256,0)
+"RTN","C0CRNFRP",277,0)
+ ;
+"RTN","C0CRNFRP",278,0)
+READCSV(PATH,NAME,GLB) ; READ A CSV FILE IN FROM UNIX TO GLB, PASSED BY NAME
+"RTN","C0CRNFRP",279,0)
+ ;
+"RTN","C0CRNFRP",280,0)
+ Q $$FTG^%ZISH(PATH,NAME,GLB,1)
+"RTN","C0CRNFRP",281,0)
+ ;
+"RTN","C0CRNFRP",282,0)
+FILE2CSV(FNUM,FVN) ; WRITES OUT A FILEMAN FILE TO CSV
+"RTN","C0CRNFRP",283,0)
+ ;
+"RTN","C0CRNFRP",284,0)
+ ;N G1,G2
+"RTN","C0CRNFRP",285,0)
+ I '$D(FVN) S FVN="NV" ; DEFAULT ORIENTATION OF CVS FILE
+"RTN","C0CRNFRP",286,0)
+ S G1=$NA(^TMP($J,"C0CCSV",1))
+"RTN","C0CRNFRP",287,0)
+ S G2=$NA(^TMP($J,"C0CCSV",2))
+"RTN","C0CRNFRP",288,0)
+ D GETN2(G1,FNUM) ; GET THE MATRIX
+"RTN","C0CRNFRP",289,0)
+ D RNF2CSV(G2,G1,FVN) ; PREPARE THE CVS FILE
+"RTN","C0CRNFRP",290,0)
+ K @G1
+"RTN","C0CRNFRP",291,0)
+ D FILEOUT(G2,"FILE_"_FNUM_".csv")
+"RTN","C0CRNFRP",292,0)
+ K @G2
+"RTN","C0CRNFRP",293,0)
  Q
-"RTN","C0CRNFRP",257,0)
- ;
-"RTN","C0CRNFRP",258,0)
-VN(RNRTN,RNIN) ;
-"RTN","C0CRNFRP",259,0)
- S RNR=$NA(@RNIN@("V"))
-"RTN","C0CRNFRP",260,0)
- S RNC=$NA(@RNIN@("F"))
-"RTN","C0CRNFRP",261,0)
- ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
-"RTN","C0CRNFRP",262,0)
- S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD"
-"RTN","C0CRNFRP",263,0)
- S RNI=""
-"RTN","C0CRNFRP",264,0)
- F  S RNI=$O(@RNC@(RNI)) Q:RNI=""  D  ; FOR EACH COLUMN
-"RTN","C0CRNFRP",265,0)
- . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
-"RTN","C0CRNFRP",266,0)
- S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
-"RTN","C0CRNFRP",267,0)
- D PUSH^GPLXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
-"RTN","C0CRNFRP",268,0)
- S RNI=""
-"RTN","C0CRNFRP",269,0)
- F  S RNI=$O(@RNR@(RNI)) Q:RNI=""  D  ; FOR EACH ROW
-"RTN","C0CRNFRP",270,0)
- . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
-"RTN","C0CRNFRP",271,0)
- . S RNJ=""
-"RTN","C0CRNFRP",272,0)
- . F  S RNJ=$O(@RNC@(RNJ)) Q:RNJ=""  D  ; FOR EACH COL
-"RTN","C0CRNFRP",273,0)
- . . I $D(@RNR@(RNI,RNJ,1)) D  ; THIS ROW HAS THIS COLUMN
-"RTN","C0CRNFRP",274,0)
- . . . S RNX=RNX_""""_@RNR@(RNI,RNJ,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA
-"RTN","C0CRNFRP",275,0)
- . . E  S RNX=RNX_"," ; NUL COLUMN
-"RTN","C0CRNFRP",276,0)
- . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
-"RTN","C0CRNFRP",277,0)
- . D PUSH^GPLXPATH(RNRTN,RNX)
-"RTN","C0CRNFRP",278,0)
+"RTN","C0CRNFRP",294,0)
+ ;
+"RTN","C0CRNFRP",295,0)
+FILEOUT(FOARY,FONAM) ; WRITE OUT A FILE
+"RTN","C0CRNFRP",296,0)
+ ;
+"RTN","C0CRNFRP",297,0)
+ W $$OUTPUT^GPLXPATH($NA(@FOARY@(1)),FONAM,^TMP("GPLCCR","ODIR"))
+"RTN","C0CRNFRP",298,0)
  Q
-"RTN","C0CRNFRP",279,0)
- ;
-"RTN","C0CRNFRP",280,0)
-READCSV(PATH,NAME,GLB) ; READ A CSV FILE IN FROM UNIX TO GLB, PASSED BY NAME
-"RTN","C0CRNFRP",281,0)
- ;
-"RTN","C0CRNFRP",282,0)
- Q $$FTG^%ZISH(PATH,NAME,GLB,1)
-"RTN","C0CRNFRP",283,0)
- ;
-"RTN","C0CRNFRP",284,0)
-FILE2CSV(FNUM,FVN) ; WRITES OUT A FILEMAN FILE TO CSV
-"RTN","C0CRNFRP",285,0)
- ;
-"RTN","C0CRNFRP",286,0)
- ;N G1,G2
-"RTN","C0CRNFRP",287,0)
- I '$D(FVN) S FVN="NV" ; DEFAULT ORIENTATION OF CVS FILE
-"RTN","C0CRNFRP",288,0)
- S G1=$NA(^TMP($J,"C0CCSV",1))
-"RTN","C0CRNFRP",289,0)
- S G2=$NA(^TMP($J,"C0CCSV",2))
-"RTN","C0CRNFRP",290,0)
- D GETN2(G1,FNUM) ; GET THE MATRIX
-"RTN","C0CRNFRP",291,0)
- D RNF2CSV(G2,G1,FVN) ; PREPARE THE CVS FILE
-"RTN","C0CRNFRP",292,0)
- K @G1
-"RTN","C0CRNFRP",293,0)
- D FILEOUT(G2,"FILE_"_FNUM_".csv")
-"RTN","C0CRNFRP",294,0)
- K @G2
-"RTN","C0CRNFRP",295,0)
+"RTN","C0CRNFRP",299,0)
+ ;
+"RTN","C0CRNFRP",300,0)
+FILEREF(FNUM) ; EXTRINSIC THAT RETURNS A CLOSED ROOT FOR FILE NUMBER FNUM
+"RTN","C0CRNFRP",301,0)
+ ;
+"RTN","C0CRNFRP",302,0)
+ N C0CF
+"RTN","C0CRNFRP",303,0)
+ S C0CF=^DIC(FNUM,0,"GL") ;OPEN ROOT TO FILE
+"RTN","C0CRNFRP",304,0)
+ S C0CF=$P(C0CF,",",1)_")" ; CLOSE THE ROOT
+"RTN","C0CRNFRP",305,0)
+ I C0CF["()" S C0CF=$P(C0CF,"()",1)
+"RTN","C0CRNFRP",306,0)
+ Q C0CF
+"RTN","C0CRNFRP",307,0)
+ ;
+"RTN","C0CRNFRP",308,0)
+SKIP ;
+"RTN","C0CRNFRP",309,0)
+ N TXT,DIERR
+"RTN","C0CRNFRP",310,0)
+ S TXT=$$GET1^DIQ(8925,TIUIEN,"2","","TXT")
+"RTN","C0CRNFRP",311,0)
+ I $D(DIERR) D CLEAN^DILF Q
+"RTN","C0CRNFRP",312,0)
+ W "  report_text:",!  ;Progress Note Text
+"RTN","C0CRNFRP",313,0)
+ N LN S LN=0
+"RTN","C0CRNFRP",314,0)
+ F  S LN=$O(TXT(LN)) Q:'LN  D
+"RTN","C0CRNFRP",315,0)
+ . W "    text"_LN_": "_TXT(LN),!
+"RTN","C0CRNFRP",316,0)
+ . Q
+"RTN","C0CRNFRP",317,0)
  Q
-"RTN","C0CRNFRP",296,0)
- ;
-"RTN","C0CRNFRP",297,0)
-FILEOUT(FOARY,FONAM) ; WRITE OUT A FILE
-"RTN","C0CRNFRP",298,0)
- ;
-"RTN","C0CRNFRP",299,0)
- W $$OUTPUT^GPLXPATH($NA(@FOARY@(1)),FONAM,^TMP("GPLCCR","ODIR"))
-"RTN","C0CRNFRP",300,0)
- Q
-"RTN","C0CRNFRP",301,0)
- ;
-"RTN","C0CRNFRP",302,0)
-FILEREF(FNUM) ; EXTRINSIC THAT RETURNS A CLOSED ROOT FOR FILE NUMBER FNUM
-"RTN","C0CRNFRP",303,0)
- ;
-"RTN","C0CRNFRP",304,0)
- N C0CF
-"RTN","C0CRNFRP",305,0)
- S C0CF=^DIC(FNUM,0,"GL") ;OPEN ROOT TO FILE
-"RTN","C0CRNFRP",306,0)
- S C0CF=$P(C0CF,",",1)_")" ; CLOSE THE ROOT
-"RTN","C0CRNFRP",307,0)
- I C0CF["()" S C0CF=$P(C0CF,"()",1)
-"RTN","C0CRNFRP",308,0)
- Q C0CF
-"RTN","C0CRNFRP",309,0)
- ;
-"RTN","C0CRNFRP",310,0)
-SKIP ;
-"RTN","C0CRNFRP",311,0)
- N TXT,DIERR
-"RTN","C0CRNFRP",312,0)
- S TXT=$$GET1^DIQ(8925,TIUIEN,"2","","TXT")
-"RTN","C0CRNFRP",313,0)
- I $D(DIERR) D CLEAN^DILF Q
-"RTN","C0CRNFRP",314,0)
- W "  report_text:",!  ;Progress Note Text
-"RTN","C0CRNFRP",315,0)
- N LN S LN=0
-"RTN","C0CRNFRP",316,0)
- F  S LN=$O(TXT(LN)) Q:'LN  D
-"RTN","C0CRNFRP",317,0)
- . W "    text"_LN_": "_TXT(LN),!
 "RTN","C0CRNFRP",318,0)
- . Q
+ ;
 "RTN","C0CRNFRP",319,0)
- Q
+ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
 "RTN","C0CRNFRP",320,0)
- ;
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF @ZTAB@(ZFN)
 "RTN","C0CRNFRP",321,0)
-ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
+ ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
 "RTN","C0CRNFRP",322,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF @ZTAB@(ZFN)
+ I '$D(ZTAB) S ZTAB="C0CA"
 "RTN","C0CRNFRP",323,0)
+ Q $P(@ZTAB@(ZFN),"^",1)
+"RTN","C0CRNFRP",324,0)
+ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
+"RTN","C0CRNFRP",325,0)
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF @ZTAB@(ZFN)
+"RTN","C0CRNFRP",326,0)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CRNFRP",324,0)
+"RTN","C0CRNFRP",327,0)
  I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CRNFRP",325,0)
- Q $P(@ZTAB@(ZFN),"^",1)
-"RTN","C0CRNFRP",326,0)
-ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
-"RTN","C0CRNFRP",327,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF @ZTAB@(ZFN)
 "RTN","C0CRNFRP",328,0)
+ Q $P(@ZTAB@(ZFN),"^",2)
+"RTN","C0CRNFRP",329,0)
+ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
+"RTN","C0CRNFRP",330,0)
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
+"RTN","C0CRNFRP",331,0)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CRNFRP",329,0)
+"RTN","C0CRNFRP",332,0)
  I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CRNFRP",330,0)
- Q $P(@ZTAB@(ZFN),"^",2)
-"RTN","C0CRNFRP",331,0)
-ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
-"RTN","C0CRNFRP",332,0)
+"RTN","C0CRNFRP",333,0)
+ Q $P($G(@ZTAB@(ZFN)),"^",3)
+"RTN","C0CRNFRP",334,0)
+ ;
+"RTN","C0CRNFRP",335,0)
+ZVALUEI(ZFN,ZTAB) ;EXTRINSIC TO RETURN INTERNAL VALUE FOR FIELD NAME PASSED
+"RTN","C0CRNFRP",336,0)
  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
-"RTN","C0CRNFRP",333,0)
+"RTN","C0CRNFRP",337,0)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CRNFRP",334,0)
+"RTN","C0CRNFRP",338,0)
  I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CRNFRP",335,0)
- Q $P($G(@ZTAB@(ZFN)),"^",3)
-"RTN","C0CRNFRP",336,0)
- ;
-"RTN","C0CRNFRP",337,0)
-ZVALUEI(ZFN,ZTAB) ;EXTRINSIC TO RETURN INTERNAL VALUE FOR FIELD NAME PASSED
-"RTN","C0CRNFRP",338,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
 "RTN","C0CRNFRP",339,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
+ Q $P($G(@ZTAB@(ZFN,"I")),"^",3)
 "RTN","C0CRNFRP",340,0)
- I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CRNFRP",341,0)
- Q $P($G(@ZTAB@(ZFN,"I")),"^",3)
-"RTN","C0CRNFRP",342,0)
  ;
 "RTN","C0CRPMS")
-0^96^B16300714
+0^96^B15891746
 "RTN","C0CRPMS",1,0)
 C0CRPMS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR RPMS ;1/14/09  14:33
 "RTN","C0CRPMS",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CRPMS",3,0)
- ;Copyright 2008 George Lilly.  Licensed under the terms of the GNU
+ ;
 "RTN","C0CRPMS",4,0)
- ;General Public License See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CRPMS",5,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CRPMS",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CRPMS",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CRPMS",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CRPMS",9,0)
- ;(at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CRPMS",10,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CRPMS",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CRPMS",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CRPMS",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CRPMS",14,0)
- ;GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CRPMS",15,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CRPMS",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CRPMS",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ W "NO ENTRY FROM TOP",!
 "RTN","C0CRPMS",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ Q
 "RTN","C0CRPMS",19,0)
  ;
 "RTN","C0CRPMS",20,0)
- W "NO ENTRY FROM TOP",!
+DISPLAY ; RUN THE PCC DISPLAY ROUTINE
 "RTN","C0CRPMS",21,0)
+ D ^APCDDISP
+"RTN","C0CRPMS",22,0)
  Q
-"RTN","C0CRPMS",22,0)
- ;
 "RTN","C0CRPMS",23,0)
-DISPLAY ; RUN THE PCC DISPLAY ROUTINE
+ ;
 "RTN","C0CRPMS",24,0)
- D ^APCDDISP
+VTYPES ;
 "RTN","C0CRPMS",25,0)
+ D GETN2^C0CRNF("G1",9999999.07)
+"RTN","C0CRPMS",26,0)
+ ; ZWR G1
+"RTN","C0CRPMS",27,0)
  Q
-"RTN","C0CRPMS",26,0)
- ;
-"RTN","C0CRPMS",27,0)
-VTYPES ;
 "RTN","C0CRPMS",28,0)
- D GETN2^C0CRNF("G1",9999999.07)
+ ;
 "RTN","C0CRPMS",29,0)
- ZWR G1
+VISITS(C0CDFN,C0CCNT) ;LIST VISIT DATES FOR PATIENT DFN
 "RTN","C0CRPMS",30,0)
+ ; C0CCNT IS A LIMIT ON HOW MANY VISITS TO DISPLAY ; DEFAULTS TO ALL
+"RTN","C0CRPMS",31,0)
+ I '$D(C0CCNT) S C0CCNT=999999999
+"RTN","C0CRPMS",32,0)
+ N G,GN
+"RTN","C0CRPMS",33,0)
+ S G="" S GN=0
+"RTN","C0CRPMS",34,0)
+ F  S G=$O(^AUPNVSIT("AA",C0CDFN,G)) Q:(G="")!(GN>C0CCNT)  D  ;
+"RTN","C0CRPMS",35,0)
+ . S GN=GN+1
+"RTN","C0CRPMS",36,0)
+ . W $$FMDTOUTC^C0CUTIL(9999999-G),!
+"RTN","C0CRPMS",37,0)
  Q
-"RTN","C0CRPMS",31,0)
- ;
-"RTN","C0CRPMS",32,0)
-VISITS(C0CDFN,C0CCNT) ;LIST VISIT DATES FOR PATIENT DFN
-"RTN","C0CRPMS",33,0)
- ; C0CCNT IS A LIMIT ON HOW MANY VISITS TO DISPLAY ; DEFAULTS TO ALL
-"RTN","C0CRPMS",34,0)
- I '$D(C0CCNT) S C0CCNT=999999999
-"RTN","C0CRPMS",35,0)
- N G,GN
-"RTN","C0CRPMS",36,0)
- S G="" S GN=0
-"RTN","C0CRPMS",37,0)
- F  S G=$O(^AUPNVSIT("AA",C0CDFN,G)) Q:(G="")!(GN>C0CCNT)  D  ;
 "RTN","C0CRPMS",38,0)
+ ;
+"RTN","C0CRPMS",39,0)
+VISITS2(C0CDFN,C0CCNT) ;SECOND VERSION USING NEXTV
+"RTN","C0CRPMS",40,0)
+ ;
+"RTN","C0CRPMS",41,0)
+ N C0CG,GN
+"RTN","C0CRPMS",42,0)
+ S C0CG=""
+"RTN","C0CRPMS",43,0)
+ S GN=0
+"RTN","C0CRPMS",44,0)
+ I '$D(C0CCNT) S C0CCNT=99999999
+"RTN","C0CRPMS",45,0)
+ F  S C0CG=$$NEXTV(C0CDFN,C0CG) Q:(C0CG="")!(GN'<C0CCNT)  D  ;
+"RTN","C0CRPMS",46,0)
  . S GN=GN+1
-"RTN","C0CRPMS",39,0)
- . W $$FMDTOUTC^C0CUTIL(9999999-G),!
-"RTN","C0CRPMS",40,0)
+"RTN","C0CRPMS",47,0)
+ . W $$FMDTOUTC^C0CUTIL(C0CG),!
+"RTN","C0CRPMS",48,0)
  Q
-"RTN","C0CRPMS",41,0)
- ;
-"RTN","C0CRPMS",42,0)
-VISITS2(C0CDFN,C0CCNT) ;SECOND VERSION USING NEXTV
-"RTN","C0CRPMS",43,0)
- ;
-"RTN","C0CRPMS",44,0)
- N C0CG,GN
-"RTN","C0CRPMS",45,0)
- S C0CG=""
-"RTN","C0CRPMS",46,0)
- S GN=0
-"RTN","C0CRPMS",47,0)
- I '$D(C0CCNT) S C0CCNT=99999999
-"RTN","C0CRPMS",48,0)
- F  S C0CG=$$NEXTV(C0CDFN,C0CG) Q:(C0CG="")!(GN'<C0CCNT)  D  ;
 "RTN","C0CRPMS",49,0)
- . S GN=GN+1
+ ;
 "RTN","C0CRPMS",50,0)
- . W $$FMDTOUTC^C0CUTIL(C0CG),!
+NEXTV(C0CDFN,C0CVDT) ;EXTRINSIC WHICH RETURNS THE NEXT VISIT DATE
 "RTN","C0CRPMS",51,0)
+ ;FOR PATIENT C0CDFN IN REVERSE TIME ORDER; PASS "" TO GET THE MOST
+"RTN","C0CRPMS",52,0)
+ ; RECENT VISIT
+"RTN","C0CRPMS",53,0)
+ N G
+"RTN","C0CRPMS",54,0)
+ S G=C0CVDT
+"RTN","C0CRPMS",55,0)
+ I G'="" S G=9999999-C0CVDT ;INVERT FOR INDEX
+"RTN","C0CRPMS",56,0)
+ S G=$O(^AUPNVSIT("AA",C0CDFN,G))
+"RTN","C0CRPMS",57,0)
+ I G="" Q ""
+"RTN","C0CRPMS",58,0)
+ E  Q 9999999-G
+"RTN","C0CRPMS",59,0)
+ ;
+"RTN","C0CRPMS",60,0)
+GETV(C0CDFN,C0CVDT) ; GET VISIT USING DATE C0CVDT . IF C0CVDT IS NULL,
+"RTN","C0CRPMS",61,0)
+ ; GET MOST RECENT VISIT
+"RTN","C0CRPMS",62,0)
+ N C0CG
+"RTN","C0CRPMS",63,0)
+ I '$D(C0CVDT) S C0CVDT=$$NEXTV(C0CDFN,"")
+"RTN","C0CRPMS",64,0)
+ S APCDVLDT=C0CVDT
+"RTN","C0CRPMS",65,0)
+ S APCDPAT=C0CDFN
+"RTN","C0CRPMS",66,0)
+ D ^APCDVLK
+"RTN","C0CRPMS",67,0)
+ D ^APCDVD
+"RTN","C0CRPMS",68,0)
+ ;K APCDCLN,APCDCAT,APCDDATE,APCDLOC,APCDVSIT,APCDLOOK,APCDTYPE
+"RTN","C0CRPMS",69,0)
  Q
-"RTN","C0CRPMS",52,0)
- ;
-"RTN","C0CRPMS",53,0)
-NEXTV(C0CDFN,C0CVDT) ;EXTRINSIC WHICH RETURNS THE NEXT VISIT DATE
-"RTN","C0CRPMS",54,0)
- ;FOR PATIENT C0CDFN IN REVERSE TIME ORDER; PASS "" TO GET THE MOST
-"RTN","C0CRPMS",55,0)
- ; RECENT VISIT
-"RTN","C0CRPMS",56,0)
- N G
-"RTN","C0CRPMS",57,0)
- S G=C0CVDT
-"RTN","C0CRPMS",58,0)
- I G'="" S G=9999999-C0CVDT ;INVERT FOR INDEX
-"RTN","C0CRPMS",59,0)
- S G=$O(^AUPNVSIT("AA",C0CDFN,G))
-"RTN","C0CRPMS",60,0)
- I G="" Q ""
-"RTN","C0CRPMS",61,0)
- E  Q 9999999-G
-"RTN","C0CRPMS",62,0)
- ;
-"RTN","C0CRPMS",63,0)
-GETV(C0CDFN,C0CVDT) ; GET VISIT USING DATE C0CVDT . IF C0CVDT IS NULL,
-"RTN","C0CRPMS",64,0)
- ; GET MOST RECENT VISIT
-"RTN","C0CRPMS",65,0)
- N C0CG
-"RTN","C0CRPMS",66,0)
- I '$D(C0CVDT) S C0CVDT=$$NEXTV(C0CDFN,"")
-"RTN","C0CRPMS",67,0)
- S APCDVLDT=C0CVDT
-"RTN","C0CRPMS",68,0)
- S APCDPAT=C0CDFN
-"RTN","C0CRPMS",69,0)
- D ^APCDVLK
 "RTN","C0CRPMS",70,0)
- D ^APCDVD
+ ;
 "RTN","C0CRPMS",71,0)
- ;K APCDCLN,APCDCAT,APCDDATE,APCDLOC,APCDVSIT,APCDLOOK,APCDTYPE
+GETNV(C0CDFN) ;GET MANY VISITS
 "RTN","C0CRPMS",72,0)
+ ;
+"RTN","C0CRPMS",73,0)
+ S APCDPAT=C0CDFN ;
+"RTN","C0CRPMS",74,0)
+ N C0CG S C0CG=""
+"RTN","C0CRPMS",75,0)
+ F  S C0CG=$$NEXTV(C0CDFN,C0CG) Q:C0CG=""  D  ; LOOP BACKWARD THROUGH VISITS
+"RTN","C0CRPMS",76,0)
+ . W C0CG,"    ",$$FMDTOUTC^C0CUTIL(C0CG),!
+"RTN","C0CRPMS",77,0)
+ . S APCDVLDT=C0CG
+"RTN","C0CRPMS",78,0)
+ . D ^APCDVLK
+"RTN","C0CRPMS",79,0)
+ . D ^APCDVD
+"RTN","C0CRPMS",80,0)
+ . K APCDCLN,APCDCAT,APCDDATE,APCDLOC,APCDVSIT,APCDLOOK,APCDTYPE
+"RTN","C0CRPMS",81,0)
  Q
-"RTN","C0CRPMS",73,0)
- ;
-"RTN","C0CRPMS",74,0)
-GETNV(C0CDFN) ;GET MANY VISITS
-"RTN","C0CRPMS",75,0)
- ;
-"RTN","C0CRPMS",76,0)
- S APCDPAT=C0CDFN ;
-"RTN","C0CRPMS",77,0)
+"RTN","C0CRPMS",82,0)
+ ;
+"RTN","C0CRPMS",83,0)
+GETTBL(C0CTBL) ; SCAN FOR AND DISPLAY PATIENTS IN A RIMTBL, PASSED BY VALUE
+"RTN","C0CRPMS",84,0)
+ ;
+"RTN","C0CRPMS",85,0)
+ N ZG S ZG=$NA(^TMP("GPLRIM","RIMTBL","PATS",C0CTBL))
+"RTN","C0CRPMS",86,0)
  N C0CG S C0CG=""
-"RTN","C0CRPMS",78,0)
- F  S C0CG=$$NEXTV(C0CDFN,C0CG) Q:C0CG=""  D  ; LOOP BACKWARD THROUGH VISITS
-"RTN","C0CRPMS",79,0)
- . W C0CG,"    ",$$FMDTOUTC^C0CUTIL(C0CG),!
-"RTN","C0CRPMS",80,0)
- . S APCDVLDT=C0CG
-"RTN","C0CRPMS",81,0)
- . D ^APCDVLK
-"RTN","C0CRPMS",82,0)
- . D ^APCDVD
-"RTN","C0CRPMS",83,0)
- . K APCDCLN,APCDCAT,APCDDATE,APCDLOC,APCDVSIT,APCDLOOK,APCDTYPE
-"RTN","C0CRPMS",84,0)
+"RTN","C0CRPMS",87,0)
+ N C0CQ S C0CQ=0
+"RTN","C0CRPMS",88,0)
+ F  S C0CG=$O(@ZG@(C0CG),-1) Q:(C0CG="")  D  ;
+"RTN","C0CRPMS",89,0)
+ . W "PAT: ",C0CG,!
+"RTN","C0CRPMS",90,0)
+ . D GETNV^C0CRPMS(C0CG)
+"RTN","C0CRPMS",91,0)
+ . K X R X:DTIME
+"RTN","C0CRPMS",92,0)
+ . I X="Q" S C0CQ=1 ; QUIT IF Q
+"RTN","C0CRPMS",93,0)
  Q
-"RTN","C0CRPMS",85,0)
- ;
-"RTN","C0CRPMS",86,0)
-GETTBL(C0CTBL) ; SCAN FOR AND DISPLAY PATIENTS IN A RIMTBL, PASSED BY VALUE
-"RTN","C0CRPMS",87,0)
- ;
-"RTN","C0CRPMS",88,0)
- N ZG S ZG=$NA(^TMP("GPLRIM","RIMTBL","PATS",C0CTBL))
-"RTN","C0CRPMS",89,0)
- N C0CG S C0CG=""
-"RTN","C0CRPMS",90,0)
- N C0CQ S C0CQ=0
-"RTN","C0CRPMS",91,0)
- F  S C0CG=$O(@ZG@(C0CG),-1) Q:(C0CG="")  D  ;
-"RTN","C0CRPMS",92,0)
- . W "PAT: ",C0CG,!
-"RTN","C0CRPMS",93,0)
- . D GETNV^C0CRPMS(C0CG)
 "RTN","C0CRPMS",94,0)
- . K X R X
+ ;
 "RTN","C0CRPMS",95,0)
- . I X="Q" S C0CQ=1 ; QUIT IF Q
+CMPDRG ; COMPARE THE DRUG FILE TO THE VA VUID MAPPING FILE FOR MATCHES
 "RTN","C0CRPMS",96,0)
+ ;
+"RTN","C0CRPMS",97,0)
+ S C0CZI=0 ;
+"RTN","C0CRPMS",98,0)
+ F  S C0CZI=$O(^C0CDRUG("V",C0CZI)) Q:C0CZI=""  D  ;ALL DRUGS IN RPMS DRUG FILE
+"RTN","C0CRPMS",99,0)
+ . S C0CZJ="" ; FOR EVERY FIELD AND SUBFIELD IN THE DRUG FILE
+"RTN","C0CRPMS",100,0)
+ . ;W "C0CZI:",C0CZI
+"RTN","C0CRPMS",101,0)
+ . F  S C0CZJ=$O(^C0CDRUG("V",C0CZI,C0CZJ)) Q:C0CZJ=""  D  ;
+"RTN","C0CRPMS",102,0)
+ . . ;W " C0CZJ:",C0CZJ
+"RTN","C0CRPMS",103,0)
+ . . N C0CZN,C0CZV ;
+"RTN","C0CRPMS",104,0)
+ . . S C0CZN=^C0CDRUG("V",C0CZI,C0CZJ,1) ; EVERY FIELD VALUE
+"RTN","C0CRPMS",105,0)
+ . . ;W " C0CZN:",C0CZN,!
+"RTN","C0CRPMS",106,0)
+ . . D GETN1^C0CRNF("C0CZV",176.112,C0CZN,"C") ;LOOK IN C XREF
+"RTN","C0CRPMS",107,0)
+ . . I $D(C0CZV) D  ;FOUND A MATCH
+"RTN","C0CRPMS",108,0)
+ . . . S C0CVO="FOUND:^"_C0CZI_"^"_C0CZJ_"^"_C0CZN
+"RTN","C0CRPMS",109,0)
+ . . . S C0CVO=C0CVO_"^RXNORM:^"_$$ZVALUE^C0CRNF("MEDIATION CODE","C0CZV")
+"RTN","C0CRPMS",110,0)
+ . . . D PUSH^GPLXPATH("^C0CZRX",C0CVO)
+"RTN","C0CRPMS",111,0)
+ . . . W C0CVO,!
+"RTN","C0CRPMS",112,0)
  Q
-"RTN","C0CRPMS",97,0)
- ;
-"RTN","C0CRPMS",98,0)
-CMPDRG ; COMPARE THE DRUG FILE TO THE VA VUID MAPPING FILE FOR MATCHES
-"RTN","C0CRPMS",99,0)
- ;
-"RTN","C0CRPMS",100,0)
+"RTN","C0CRPMS",113,0)
+ ;
+"RTN","C0CRPMS",114,0)
+CMPDRG2 ; COMPARE THE DRUG FILE TO THE VA VUID MAPPING FILE FOR MATCHES
+"RTN","C0CRPMS",115,0)
+ ;
+"RTN","C0CRPMS",116,0)
  S C0CZI=0 ;
-"RTN","C0CRPMS",101,0)
+"RTN","C0CRPMS",117,0)
  F  S C0CZI=$O(^C0CDRUG("V",C0CZI)) Q:C0CZI=""  D  ;ALL DRUGS IN RPMS DRUG FILE
-"RTN","C0CRPMS",102,0)
+"RTN","C0CRPMS",118,0)
  . S C0CZJ="" ; FOR EVERY FIELD AND SUBFIELD IN THE DRUG FILE
-"RTN","C0CRPMS",103,0)
- . ;W "C0CZI:",C0CZI
-"RTN","C0CRPMS",104,0)
+"RTN","C0CRPMS",119,0)
+ . W "C0CZI:",C0CZI
+"RTN","C0CRPMS",120,0)
  . F  S C0CZJ=$O(^C0CDRUG("V",C0CZI,C0CZJ)) Q:C0CZJ=""  D  ;
-"RTN","C0CRPMS",105,0)
- . . ;W " C0CZJ:",C0CZJ
-"RTN","C0CRPMS",106,0)
+"RTN","C0CRPMS",121,0)
+ . . W " C0CZJ:",C0CZJ
+"RTN","C0CRPMS",122,0)
  . . N C0CZN,C0CZV ;
-"RTN","C0CRPMS",107,0)
+"RTN","C0CRPMS",123,0)
  . . S C0CZN=^C0CDRUG("V",C0CZI,C0CZJ,1) ; EVERY FIELD VALUE
-"RTN","C0CRPMS",108,0)
- . . ;W " C0CZN:",C0CZN,!
-"RTN","C0CRPMS",109,0)
+"RTN","C0CRPMS",124,0)
+ . . W " C0CZN:",C0CZN,!
+"RTN","C0CRPMS",125,0)
  . . D GETN1^C0CRNF("C0CZV",176.112,C0CZN,"C") ;LOOK IN C XREF
-"RTN","C0CRPMS",110,0)
+"RTN","C0CRPMS",126,0)
  . . I $D(C0CZV) D  ;FOUND A MATCH
-"RTN","C0CRPMS",111,0)
- . . . S C0CVO="FOUND:^"_C0CZI_"^"_C0CZJ_"^"_C0CZN
-"RTN","C0CRPMS",112,0)
- . . . S C0CVO=C0CVO_"^RXNORM:^"_$$ZVALUE^C0CRNF("MEDIATION CODE","C0CZV")
-"RTN","C0CRPMS",113,0)
- . . . D PUSH^GPLXPATH("^C0CZRX",C0CVO)
-"RTN","C0CRPMS",114,0)
- . . . W C0CVO,!
-"RTN","C0CRPMS",115,0)
+"RTN","C0CRPMS",127,0)
+ . . . W "FOUND: ",C0CZI," ",C0CZJ," ",C0CZN
+"RTN","C0CRPMS",128,0)
+ . . . W " VUID:",$$ZVALUE^C0CRNF("VUID","C0CZV"),!
+"RTN","C0CRPMS",129,0)
  Q
-"RTN","C0CRPMS",116,0)
- ;
-"RTN","C0CRPMS",117,0)
-CMPDRG2 ; COMPARE THE DRUG FILE TO THE VA VUID MAPPING FILE FOR MATCHES
-"RTN","C0CRPMS",118,0)
- ;
-"RTN","C0CRPMS",119,0)
- S C0CZI=0 ;
-"RTN","C0CRPMS",120,0)
- F  S C0CZI=$O(^C0CDRUG("V",C0CZI)) Q:C0CZI=""  D  ;ALL DRUGS IN RPMS DRUG FILE
-"RTN","C0CRPMS",121,0)
- . S C0CZJ="" ; FOR EVERY FIELD AND SUBFIELD IN THE DRUG FILE
-"RTN","C0CRPMS",122,0)
- . W "C0CZI:",C0CZI
-"RTN","C0CRPMS",123,0)
- . F  S C0CZJ=$O(^C0CDRUG("V",C0CZI,C0CZJ)) Q:C0CZJ=""  D  ;
-"RTN","C0CRPMS",124,0)
- . . W " C0CZJ:",C0CZJ
-"RTN","C0CRPMS",125,0)
- . . N C0CZN,C0CZV ;
-"RTN","C0CRPMS",126,0)
- . . S C0CZN=^C0CDRUG("V",C0CZI,C0CZJ,1) ; EVERY FIELD VALUE
-"RTN","C0CRPMS",127,0)
- . . W " C0CZN:",C0CZN,!
-"RTN","C0CRPMS",128,0)
- . . D GETN1^C0CRNF("C0CZV",176.112,C0CZN,"C") ;LOOK IN C XREF
-"RTN","C0CRPMS",129,0)
- . . I $D(C0CZV) D  ;FOUND A MATCH
 "RTN","C0CRPMS",130,0)
- . . . W "FOUND: ",C0CZI," ",C0CZJ," ",C0CZN
-"RTN","C0CRPMS",131,0)
- . . . W " VUID:",$$ZVALUE^C0CRNF("VUID","C0CZV"),!
-"RTN","C0CRPMS",132,0)
- Q
-"RTN","C0CRPMS",133,0)
  ;
 "RTN","C0CRXN")
-0^22^B103277157
+0^22^B102255510
 "RTN","C0CRXN",1,0)
 C0CRXN   ; CCDCCR/GPL - CCR RXN utilities; 12/6/08
 "RTN","C0CRXN",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CRXN",3,0)
- ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
+ ;Copyright 2009 George Lilly.  
 "RTN","C0CRXN",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CRXN",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CRXN",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CRXN",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CRXN",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CRXN",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CRXN",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CRXN",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CRXN",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CRXN",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CRXN",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CRXN",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CRXN",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CRXN",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CRXN",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ W "This is the CCR RXNORM Utility Library ",!
 "RTN","C0CRXN",19,0)
- ;
+ W !
 "RTN","C0CRXN",20,0)
- W "This is the CCR RXNORM Utility Library ",!
+ Q
 "RTN","C0CRXN",21,0)
- W !
+ ;
 "RTN","C0CRXN",22,0)
+EXPAND ; MAIN ROUTINE TO CREATE THE C0C RXNORM VUID EXPANSION FILE (176.112)
+"RTN","C0CRXN",23,0)
+ ; READ EACH RECORD FROM 176.111 AND USE THE VUID TO LOOK UP THE RXNORM
+"RTN","C0CRXN",24,0)
+ ; CODE FROM 176.001 (RXNORM CONCEPTS)
+"RTN","C0CRXN",25,0)
+ ; POPULATE ALL FIELDS IN 176.112 AND SET "NEW" TO "Y" IF 176.111 DOES NOT
+"RTN","C0CRXN",26,0)
+ ; ALREADY HAVE AN RXNORM CODE.
+"RTN","C0CRXN",27,0)
+ ; ADD THE RXNORM TEXT FIELD TO EVERY RECORD (NOT PRESENT IN 176.111)
+"RTN","C0CRXN",28,0)
+ ; AND COMPARE THE RXNORM TEXT FIELD WITH THE VUID TEXT FIELD, SETTING THE
+"RTN","C0CRXN",29,0)
+ ; "DIFFERENT TEXT" FIELD TO "Y" IF THERE ARE DIFFERENCES
+"RTN","C0CRXN",30,0)
+ ; USES SUPPORT ROUTINES FROM C0CRNF.m
+"RTN","C0CRXN",31,0)
+ N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR
+"RTN","C0CRXN",32,0)
+ N C0CFVA,C0CFRXN ; CLOSED ROOTS FOR SOURCE FILES
+"RTN","C0CRXN",33,0)
+ N C0CF ; CLOSED ROOT FOR DESTINATION FILE
+"RTN","C0CRXN",34,0)
+ S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE
+"RTN","C0CRXN",35,0)
+ S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE
+"RTN","C0CRXN",36,0)
+ S C0CF=$$FILEREF^C0CRNF(176.112) ; C0C RXNORM VUID MAPPING EXPANSION FILE
+"RTN","C0CRXN",37,0)
+ W C0CVA,C0CFRXN,C0CF,!
+"RTN","C0CRXN",38,0)
+ S C0CZX=0
+"RTN","C0CRXN",39,0)
+ S (HASRXN,NORXN,NOVUID,RXFOUND,RXMATCH,TXTMATCH)=0 ; INITIALIZE COUNTERS
+"RTN","C0CRXN",40,0)
+ F  S C0CZX=$O(^C0CCODES(176.111,C0CZX)) Q:+C0CZX=0  D  ; FOR EVERY RECORD
+"RTN","C0CRXN",41,0)
+ . K C0CA,C0CB,C0CC ; CLEAR ARRAYS
+"RTN","C0CRXN",42,0)
+ . D FIELDS^C0CRNF("C0CC",176.112) ;GET FIELD NAMES FOR OUTPUT FILE
+"RTN","C0CRXN",43,0)
+ . D GETN1^C0CRNF("C0CA",176.111,C0CZX,"","ALL") ;GET THE FIELDS
+"RTN","C0CRXN",44,0)
+ . I $$ZVALUE("MEDIATION CODE")="" D
+"RTN","C0CRXN",45,0)
+ . . S NORXN=NORXN+1 ;
+"RTN","C0CRXN",46,0)
+ . E  D  ; PROCESS MEDIATION CODE
+"RTN","C0CRXN",47,0)
+ . . S HASRXN=HASRXN+1
+"RTN","C0CRXN",48,0)
+ . . D SETFDA("MEDIATION CODE",$$ZVALUE("MEDIATION CODE")) ;
+"RTN","C0CRXN",49,0)
+ . I $$ZVALUE("VUID")="" D  ; BAD RECORD
+"RTN","C0CRXN",50,0)
+ . . S NOVUID=NOVUID+1
+"RTN","C0CRXN",51,0)
+ . . ;D SETFDA("VUID",$$ZVALUE("VUID"))
+"RTN","C0CRXN",52,0)
+ . E  D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT"))
+"RTN","C0CRXN",53,0)
+ . ;ZWR C0CA
+"RTN","C0CRXN",54,0)
+ . D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
+"RTN","C0CRXN",55,0)
+ . I $$ZVALUE("RXCUI","C0CB")'="" D  ; RXNORM FOUND
+"RTN","C0CRXN",56,0)
+ . . S RXFOUND=RXFOUND+1
+"RTN","C0CRXN",57,0)
+ . . I $$ZVALUE("MEDIATION CODE")="" D  ; THIS IS A NEW CODE
+"RTN","C0CRXN",58,0)
+ . . . D SETFDA("MEDIATION CODE",$$ZVALUE("RXCUI","C0CB"))
+"RTN","C0CRXN",59,0)
+ . . . D SETFDA("NEW","Y") ;FLAG RECORD HAS HAVING NEW RXNORM
+"RTN","C0CRXN",60,0)
+ . . W "RXNORM=",$$ZVALUE("RXCUI","C0CB")," ",$$ZVALUE("STR","C0CB"),!
+"RTN","C0CRXN",61,0)
+ . . W "VUID TEXT: ",$$ZVALUE("VUID TEXT"),!
+"RTN","C0CRXN",62,0)
+ . . I $$ZVALUE("VUID TEXT")=$$ZVALUE("STR","C0CB") S TXTMATCH=TXTMATCH+1
+"RTN","C0CRXN",63,0)
+ . . E  D  ;
+"RTN","C0CRXN",64,0)
+ . . . S ZZ=$$ZVALUE("VUID TEXT")_"^"_$$ZVALUE("STR","C0CB")
+"RTN","C0CRXN",65,0)
+ . . . D PUSH^GPLXPATH("NOMATCH",ZZ)
+"RTN","C0CRXN",66,0)
+ . . . D SETFDA("RXNORM TEXT",$$ZVALUE("STR","C0CB")) ;
+"RTN","C0CRXN",67,0)
+ . . . D SETFDA("DIFFERENT TEXT","Y") ;FLAG RECORD FOR DIFFERENT TEXT
+"RTN","C0CRXN",68,0)
+ . I $$ZVALUE("MEDIATION CODE")=$$ZVALUE("RXCUI","C0CB") D  ;
+"RTN","C0CRXN",69,0)
+ . . S RXMATCH=RXMATCH+1
+"RTN","C0CRXN",70,0)
+ . . W "VUID=",$$ZVALUE("VUID")," MATCH RXNORM=",$$ZVALUE("MEDIATION CODE"),!
+"RTN","C0CRXN",71,0)
+ . D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
+"RTN","C0CRXN",72,0)
+ . S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD
+"RTN","C0CRXN",73,0)
+ . D UPDATE^DIE("","C0CFDA")
+"RTN","C0CRXN",74,0)
+ . I $D(^TMP("DIERR",$J)) S $EC=",U1,"
+"RTN","C0CRXN",75,0)
+ W "HAS RXN=",HASRXN,!
+"RTN","C0CRXN",76,0)
+ W "NO RXN=",NORXN,!
+"RTN","C0CRXN",77,0)
+ W "NO VUID=",NOVUID,!
+"RTN","C0CRXN",78,0)
+ W "RXNORM FOUND=",RXFOUND,!
+"RTN","C0CRXN",79,0)
+ W "RXNORM MATCHES:",RXMATCH,!
+"RTN","C0CRXN",80,0)
+ W "TEXT MATCHES:",TXTMATCH,!
+"RTN","C0CRXN",81,0)
  Q
-"RTN","C0CRXN",23,0)
- ;
-"RTN","C0CRXN",24,0)
-EXPAND ; MAIN ROUTINE TO CREATE THE C0C RXNORM VUID EXPANSION FILE (176.112)
-"RTN","C0CRXN",25,0)
- ; READ EACH RECORD FROM 176.111 AND USE THE VUID TO LOOK UP THE RXNORM
-"RTN","C0CRXN",26,0)
- ; CODE FROM 176.001 (RXNORM CONCEPTS)
-"RTN","C0CRXN",27,0)
- ; POPULATE ALL FIELDS IN 176.112 AND SET "NEW" TO "Y" IF 176.111 DOES NOT
-"RTN","C0CRXN",28,0)
- ; ALREADY HAVE AN RXNORM CODE.
-"RTN","C0CRXN",29,0)
- ; ADD THE RXNORM TEXT FIELD TO EVERY RECORD (NOT PRESENT IN 176.111)
-"RTN","C0CRXN",30,0)
- ; AND COMPARE THE RXNORM TEXT FIELD WITH THE VUID TEXT FIELD, SETTING THE
-"RTN","C0CRXN",31,0)
- ; "DIFFERENT TEXT" FIELD TO "Y" IF THERE ARE DIFFERENCES
-"RTN","C0CRXN",32,0)
- ; USES SUPPORT ROUTINES FROM C0CRNF.m
-"RTN","C0CRXN",33,0)
+"RTN","C0CRXN",82,0)
+ ;
+"RTN","C0CRXN",83,0)
+EXP2 ; ROUTINE TO CREATE 176.113 C0C RXNORM VUID MAPPING DISCREPANCIES FILE
+"RTN","C0CRXN",84,0)
+ ; CROSS CHECKS THE NATIONAL DRUG FILE AND THE VA MAPPING FILE AGAINST
+"RTN","C0CRXN",85,0)
+ ; THE UMLS RXNORM DATABASE
+"RTN","C0CRXN",86,0)
+ ; THIS ROUTINE HAS BEEN ENHANCED TO ALSO CHECK THE 50.416 DRUG INGREDIENT
+"RTN","C0CRXN",87,0)
+ ; FILE AND TREAT VUIDS FOUND THERE LIKE THE ONES BEING FOUND IN THE NDF
+"RTN","C0CRXN",88,0)
+ ; IF THE VUID EXISISTS IN ALL THREE FILES, THE RXNORM CODE MATCHES IN
+"RTN","C0CRXN",89,0)
+ ; THE VA MAPPING FILE AND THE TEXT STRINGS ARE THE SAME, THE VUID IS INCLUDED
+"RTN","C0CRXN",90,0)
+ ; IN THE FILE BUT NO FLAGS ARE SET
+"RTN","C0CRXN",91,0)
+ ; IF THE VUID IS MISSING FROM THE NATIONAL DRUG FILE NDF=N
+"RTN","C0CRXN",92,0)
+ ; (IF THE VUID IS MISSING FROM THE NDF, IT IS CHECKED IN THE DRUG INGREDIENT
+"RTN","C0CRXN",93,0)
+ ; FILE, AND IF FOUND, THE FLAG IS NOT SET. IN THIS CASE THE TEXT FROM THE
+"RTN","C0CRXN",94,0)
+ ; DRUG INGREDIENT FILE IS USED FOR COMPARISONS)
+"RTN","C0CRXN",95,0)
+ ; IF THE VUID IS MISSING FROM THE VA MAPPING FILE VAMAP=N
+"RTN","C0CRXN",96,0)
+ ; IF THE VUID IS PRESENT IN THE VA MAPPING FILE, BUT THE RXNORM
+"RTN","C0CRXN",97,0)
+ ; CODE IS MISSING IN THAT FILE, VARXN=N
+"RTN","C0CRXN",98,0)
+ ; IF THE TEXT STRINGS DO NOT MATCH EXACTLY, TXTM=N AND ALL THREE STRINGS
+"RTN","C0CRXN",99,0)
+ ; ARE SHOWN; NDF TEXT=NDF TEXT STRING, VA MAP TEXT=VA MAPPING TEXT STRING
+"RTN","C0CRXN",100,0)
+ ; RXNORM TEXT=RXNORM TEXT STRING
+"RTN","C0CRXN",101,0)
+ ; THE FILE IS KEYED ON VUID AND WOULD USUALLY BE SORTED BY VUID
+"RTN","C0CRXN",102,0)
+ ; THE OBJECTIVE IS TO SEE IF NDF (50.68) AND VA MAPPING (176.111) HAVE
+"RTN","C0CRXN",103,0)
+ ; ALL THE VUID CODES THAT ARE IN THE UMLS RXNORM DATABASE
+"RTN","C0CRXN",104,0)
  N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR
-"RTN","C0CRXN",34,0)
+"RTN","C0CRXN",105,0)
  N C0CFVA,C0CFRXN ; CLOSED ROOTS FOR SOURCE FILES
-"RTN","C0CRXN",35,0)
+"RTN","C0CRXN",106,0)
  N C0CF ; CLOSED ROOT FOR DESTINATION FILE
-"RTN","C0CRXN",36,0)
+"RTN","C0CRXN",107,0)
  S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE
-"RTN","C0CRXN",37,0)
+"RTN","C0CRXN",108,0)
  S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE
-"RTN","C0CRXN",38,0)
- S C0CF=$$FILEREF^C0CRNF(176.112) ; C0C RXNORM VUID MAPPING EXPANSION FILE
-"RTN","C0CRXN",39,0)
- W C0CVA,C0CFRXN,C0CF,!
-"RTN","C0CRXN",40,0)
+"RTN","C0CRXN",109,0)
+ ;S C0CF=$$FILEREF^C0CRNF(176.113) ; C0C RXNORM VUID MAPPING ADDITIONAL FILE
+"RTN","C0CRXN",110,0)
+ W C0CVA,C0CFRXN,! ;C0CF,!
+"RTN","C0CRXN",111,0)
  S C0CZX=0
-"RTN","C0CRXN",41,0)
- S (HASRXN,NORXN,NOVUID,RXFOUND,RXMATCH,TXTMATCH)=0 ; INITIALIZE COUNTERS
-"RTN","C0CRXN",42,0)
- F  S C0CZX=$O(^C0CCODES(176.111,C0CZX)) Q:+C0CZX=0  D  ; FOR EVERY RECORD
-"RTN","C0CRXN",43,0)
- . K C0CA,C0CB,C0CC ; CLEAR ARRAYS
-"RTN","C0CRXN",44,0)
- . D FIELDS^C0CRNF("C0CC",176.112) ;GET FIELD NAMES FOR OUTPUT FILE
-"RTN","C0CRXN",45,0)
- . D GETN1^C0CRNF("C0CA",176.111,C0CZX,"","ALL") ;GET THE FIELDS
-"RTN","C0CRXN",46,0)
+"RTN","C0CRXN",112,0)
+ S (NDFVCNT,NDFTCNT,NDFNO)=0 ; COUNTERS FOR NDF TESTS
+"RTN","C0CRXN",113,0)
+ S (VAVCNT,VATCNT,VARCNT,VANO)=0 ; COUNTERS FOR VA MAPPING FILE TESTS
+"RTN","C0CRXN",114,0)
+ F  S C0CZX=$O(^C0CRXN(176.001,"VUID",C0CZX)) Q:+C0CZX=0  D  ; FOR EVERY VUID
+"RTN","C0CRXN",115,0)
+ . K C0CA,C0CB,C0CC,C0CD ; CLEAR ARRAYS
+"RTN","C0CRXN",116,0)
+ . D FIELDS^C0CRNF("C0CC",176.113) ;GET FIELD NAMES FOR OUTPUT FILE
+"RTN","C0CRXN",117,0)
+ . D GETN1^C0CRNF("C0CA",176.001,C0CZX,"VUID","ALL") ;GET FROM RXNORM FILE
+"RTN","C0CRXN",118,0)
+ . D GETN1^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;GET FROM VA MAPPING FILE
+"RTN","C0CRXN",119,0)
+ . D GETN1^C0CRNF("C0CD",50.68,C0CZX,"AVUID","ALL") ;GET FROM NDF
+"RTN","C0CRXN",120,0)
+ . D GETN1^C0CRNF("C0CE",50.416,C0CZX,"AVUID","ALL") ;GET FROM DRUG INGREDIENTS
+"RTN","C0CRXN",121,0)
+ . ;D SETFDA("VUID",$$ZVALUE("CODE")) ;SET THE VUID CODE
+"RTN","C0CRXN",122,0)
+ . D SETFDA("RXNORM",$$ZVALUE("RXCUI")) ;SET THE RXNORM CODE
+"RTN","C0CRXN",123,0)
+ . D SETFDA("RXNORM TEXT",$$ZVALUE("STR")) ;SET THE RXNORM TEXT
+"RTN","C0CRXN",124,0)
+ . ;VA MAPPING FILE TESTS
+"RTN","C0CRXN",125,0)
+ . I $$ZVALUE("VUID","C0CB")=C0CZX D  ; VUID FOUND
+"RTN","C0CRXN",126,0)
+ . . S VAVCNT=VAVCNT+1 ;INCREMENT COUNT
+"RTN","C0CRXN",127,0)
+ . . I $$ZVALUE("STR")'=$$ZVALUE("VUID TEXT","C0CB") D  ;TEXT MISMATCH
+"RTN","C0CRXN",128,0)
+ . . . S VATCNT=VATCNT+1 ; INCREMENT VA TEXT MISMATCH COUNT
+"RTN","C0CRXN",129,0)
+ . . . D SETFDA("TXTM","N") ;MARK THAT TEXT DOESN'T MATCH
+"RTN","C0CRXN",130,0)
+ . . . D SETFDA("VA MAP TEXT",$$ZVALUE("VUID TEXT","C0CB")) ; SET VA MAP TEXT
+"RTN","C0CRXN",131,0)
+ . E  D  ; VUID NOT FOUND
+"RTN","C0CRXN",132,0)
+ . . S VANO=VANO+1
+"RTN","C0CRXN",133,0)
+ . . D SETFDA("VAMAP","N") ;MARK AS MISSING FROM VA MAPPING FILE
+"RTN","C0CRXN",134,0)
+ . ; NATIONAL DRUG FILE TESTS
+"RTN","C0CRXN",135,0)
+ . I ($$ZVALUE("VUID","C0CD")=C0CZX)!($$ZVALUE("VUID","C0CE")=C0CZX) D  ;
+"RTN","C0CRXN",136,0)
+ . . ;FOUND IN NATIONAL DRUG FILE OR DRUG INGREDIENT FILE
+"RTN","C0CRXN",137,0)
+ . . S NDFVCNT=NDFVCNT+1 ;INCREMENT VUID FOUND COUNT
+"RTN","C0CRXN",138,0)
+ . . I $$ZVALUE("NAME","C0CD")'=$$ZVALUE("STR") D  ;NDF TEXT DOESN'T MATCH
+"RTN","C0CRXN",139,0)
+ . . . I $$ZVALUE("NAME","C0CE")'=$$ZVALUE("STR") D  ;DRUG ING FILE ALSO
+"RTN","C0CRXN",140,0)
+ . . . . S NDFTCNT=NDFTCNT+1 ; INCREMENT MISMATCHED NDF TEXT COUNT
+"RTN","C0CRXN",141,0)
+ . . . . D SETFDA("TXTM","N") ; SET TEXT MATCH FLAG TO N
+"RTN","C0CRXN",142,0)
+ . . . . D SETFDA("NDF TEXT",$$ZVALUE("NAME","C0CD")) ;POST THE TEXT
+"RTN","C0CRXN",143,0)
+ . . . . D SETFDA("NAT DRUG TEXT",$$ZVALUE("NAME","C0CE")) ;POST TEXT
+"RTN","C0CRXN",144,0)
+ . E  D  ;
+"RTN","C0CRXN",145,0)
+ . . D SETFDA("NDF","N") ;MARK AS MISSING
+"RTN","C0CRXN",146,0)
+ . . S NDFNO=NDFNO+1 ;INCREMENT MISSING COUNT
+"RTN","C0CRXN",147,0)
+ . D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
+"RTN","C0CRXN",148,0)
+ . S C0CFDA(176.113,"+"_C0CZX_",",.01)=C0CZX ; NEW VUID RECORD
+"RTN","C0CRXN",149,0)
+ . D UPDATE^DIE("","C0CFDA")
+"RTN","C0CRXN",150,0)
+ . I $D(^TMP("DIERR",$J)) S $EC=",U1,"
+"RTN","C0CRXN",151,0)
+ W "VA MAPPING VUID COUNT: ",VAVCNT,!
+"RTN","C0CRXN",152,0)
+ W "VA MAPPING MISSING: ",VANO,!
+"RTN","C0CRXN",153,0)
+ W "VA MAPPING TEXT MISMATCH: ",VATCNT,!
+"RTN","C0CRXN",154,0)
+ W "NDF VUID COUNT: ",NDFVCNT,!
+"RTN","C0CRXN",155,0)
+ W "NDF MISSING: ",NDFNO,!
+"RTN","C0CRXN",156,0)
+ W "NDF TEXT MISMATCH: ",NDFTCNT,!
+"RTN","C0CRXN",157,0)
+ Q
+"RTN","C0CRXN",158,0)
+CHKNDF ; ROUTINE TO CHECK THE NATIONAL DRUG FILE WITH THE UMLS RXNORM DB
+"RTN","C0CRXN",159,0)
+ ; USING THE AVUID INDEX, READS ALL VUID CODES IN ^PSNDF(50.68),
+"RTN","C0CRXN",160,0)
+ ; CHECKS TO SEE IF THE CODE IS IN 176.001, AND CREATES A RECORD
+"RTN","C0CRXN",161,0)
+ ; IN 176.114
+"RTN","C0CRXN",162,0)
+ ; THE OBJECTIVE IS TO SEE IF ^PSNDF(50.68) HAS ALL THE VUID CODES IN THE
+"RTN","C0CRXN",163,0)
+ ; UMLS RXNORM DATABASE AND IF THE TEXT FIELDS MATCH
+"RTN","C0CRXN",164,0)
+ ; ALSO CAPTURES THE RXNORM CODE MAPPING
+"RTN","C0CRXN",165,0)
+ ; CHKNDF2 WILL CHECK THE OTHER DIRECTION, STARTING WITH THE 176.001 VUID INDEX
+"RTN","C0CRXN",166,0)
+ ; THIS ROUTINE ALSO CHECKS IF THE VUID CODE IS IN 176.111 AND IF NOT
+"RTN","C0CRXN",167,0)
+ ; SETS NOTMAPPED=Y
+"RTN","C0CRXN",168,0)
+ N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR
+"RTN","C0CRXN",169,0)
+ N C0CFVA,C0CFRXN,C0CPSNDF ; CLOSED ROOTS FOR SOURCE FILES
+"RTN","C0CRXN",170,0)
+ N C0CF ; CLOSED ROOT FOR DESTINATION FILE
+"RTN","C0CRXN",171,0)
+ S C0CPSNDF=$$FILEREF^C0CRNF(50.68) ; NDF CLOSED ROOT REFERENCE
+"RTN","C0CRXN",172,0)
+ S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE
+"RTN","C0CRXN",173,0)
+ S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE
+"RTN","C0CRXN",174,0)
+ ;S C0CF=$$FILEREF^C0CRNF(176.113) ; C0C RXNORM VUID MAPPING ADDITIONAL FILE
+"RTN","C0CRXN",175,0)
+ W C0CVA,C0CFRXN,! ;C0CF,!
+"RTN","C0CRXN",176,0)
+ S C0CZX=0
+"RTN","C0CRXN",177,0)
+ S (FOUND,MISSING)=0
+"RTN","C0CRXN",178,0)
+ S (NOVUID,VMATCH,NOMATCH,MISSING,FOUND,TXTMATCH,NOTM,NVAM)=0 ; COUNTERS
+"RTN","C0CRXN",179,0)
+ F  S C0CZX=$O(^PSNDF(50.68,"AVUID",C0CZX)) Q:+C0CZX=0  D  ; FOR EVERY VUID
+"RTN","C0CRXN",180,0)
+ . K C0CA,C0CB,C0CC,C0CD ; CLEAR ARRAYS
+"RTN","C0CRXN",181,0)
+ . ;D FIELDS^C0CRNF("C0CC",176.113) ;GET FIELD NAMES FOR OUTPUT FILE
+"RTN","C0CRXN",182,0)
+ . D GETN1^C0CRNF("C0CA",50.68,C0CZX,"AVUID","ALL") ;GET THE FIELDS
+"RTN","C0CRXN",183,0)
+ . I $$ZVALUE("VUID")="" D  ; ERROR, SHOULD NOT HAPPEN
+"RTN","C0CRXN",184,0)
+ . . S NOVUID=NOVUID+1 ; FLAG THE ERROR
+"RTN","C0CRXN",185,0)
+ . . D PUSH^GPLXPATH("NOVUID",C0CZX) ; RECORD THE VUID
+"RTN","C0CRXN",186,0)
+ . D GETN1^C0CRNF("C0CD",176.001,C0CZX,"VUID","ALL") ;TRY RXNORM DB
+"RTN","C0CRXN",187,0)
+ . I $$ZVALUE("CODE","C0CD")=C0CZX D  ; FOUND IN RXNORM
+"RTN","C0CRXN",188,0)
+ . . S VMATCH=VMATCH+1 ; COUNT OF PSNDF VUIDS FOUND IN RXNORM
+"RTN","C0CRXN",189,0)
+ . . I $$ZVALUE("NAME")=$$ZVALUE("STR","C0CD") D  ;TEXT MATCHES
+"RTN","C0CRXN",190,0)
+ . . . S TXTMATCH=TXTMATCH+1 ; COUNT IT
+"RTN","C0CRXN",191,0)
+ . . E  D  ; TEXT DOESN'T MATCH
+"RTN","C0CRXN",192,0)
+ . . . S NOTM=NOTM+1 ;NO TEXT MATCH COUNTER
+"RTN","C0CRXN",193,0)
+ . . . S ZV=$$ZVALUE("NAME")_"^"_$$ZVALUE("STR","C0CD")
+"RTN","C0CRXN",194,0)
+ . . . W ZV,!
+"RTN","C0CRXN",195,0)
+ . . . D PUSH^GPLXPATH("TXTNM",ZV) ; RECORD THE TXT MISMATCH
+"RTN","C0CRXN",196,0)
+ . E  S NOMATCH=NOMATCH+1 ; NOT FOUND IN RXNORM
+"RTN","C0CRXN",197,0)
+ . D GETN1^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;TRY TO GET FROM 176.111
+"RTN","C0CRXN",198,0)
+ . I $$ZVALUE("VUID","C0CB")="" D  ; VUID NOT FOUND
+"RTN","C0CRXN",199,0)
+ . . ;W "NOT FOUND: ",C0CZX," ",$$ZVALUE("STR")," ",$$ZVALUE("RXCUI"),!
+"RTN","C0CRXN",200,0)
+ . . S MISSING=MISSING+1
+"RTN","C0CRXN",201,0)
+ . . D PUSH^GPLXPATH("MISSING",C0CZX) ;MISSING FROM MAPPING FILE
+"RTN","C0CRXN",202,0)
+ . E  D  ; FOUND IN VA MAPPING FILE
+"RTN","C0CRXN",203,0)
+ . . S FOUND=FOUND+1
+"RTN","C0CRXN",204,0)
+ . . I $$ZVALUE("VUID TEXT","C0CB")'=$$ZVALUE("NAME") D  ; TEXT DOESN'T MATCH
+"RTN","C0CRXN",205,0)
+ . . . S NVAM=NVAM+1 ; MAPPING FILE TEXT IS DIFFERENT THAN NDF
+"RTN","C0CRXN",206,0)
+ . . . S ZY=$$ZVALUE("VUID TEXT","C0CB")_"^"_$$ZVALUE("NAME") ;BOTH STRINGS
+"RTN","C0CRXN",207,0)
+ . . . W "VA: ",ZY,!
+"RTN","C0CRXN",208,0)
+ . . . D PUSH^GPLXPATH("NVAM",ZY) ;SAVE IT
+"RTN","C0CRXN",209,0)
+ W "MISSING IN MAPPING FILE: ",MISSING,!
+"RTN","C0CRXN",210,0)
+ W "FOUND IN MAPPING FILE: ",FOUND,!
+"RTN","C0CRXN",211,0)
+ W "FOUND IN RXNORM: ",VMATCH,!
+"RTN","C0CRXN",212,0)
+ W "NOT FOUND IN RXNORM: ",NOMATCH,!
+"RTN","C0CRXN",213,0)
+ W "ERRORS: ",NOVUID,!
+"RTN","C0CRXN",214,0)
+ Q
+"RTN","C0CRXN",215,0)
+ ;
+"RTN","C0CRXN",216,0)
+ D
+"RTN","C0CRXN",217,0)
  . I $$ZVALUE("MEDIATION CODE")="" D
-"RTN","C0CRXN",47,0)
+"RTN","C0CRXN",218,0)
  . . S NORXN=NORXN+1 ;
-"RTN","C0CRXN",48,0)
+"RTN","C0CRXN",219,0)
  . E  D  ; PROCESS MEDIATION CODE
-"RTN","C0CRXN",49,0)
+"RTN","C0CRXN",220,0)
  . . S HASRXN=HASRXN+1
-"RTN","C0CRXN",50,0)
+"RTN","C0CRXN",221,0)
  . . D SETFDA("MEDIATION CODE",$$ZVALUE("MEDIATION CODE")) ;
-"RTN","C0CRXN",51,0)
+"RTN","C0CRXN",222,0)
  . I $$ZVALUE("VUID")="" D  ; BAD RECORD
-"RTN","C0CRXN",52,0)
+"RTN","C0CRXN",223,0)
  . . S NOVUID=NOVUID+1
-"RTN","C0CRXN",53,0)
+"RTN","C0CRXN",224,0)
  . . ;D SETFDA("VUID",$$ZVALUE("VUID"))
-"RTN","C0CRXN",54,0)
+"RTN","C0CRXN",225,0)
  . E  D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT"))
-"RTN","C0CRXN",55,0)
- . . ;ZWR C0CA
-"RTN","C0CRXN",56,0)
+"RTN","C0CRXN",226,0)
+ . ;ZWR C0CA
+"RTN","C0CRXN",227,0)
  . D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
-"RTN","C0CRXN",57,0)
+"RTN","C0CRXN",228,0)
  . I $$ZVALUE("RXCUI","C0CB")'="" D  ; RXNORM FOUND
-"RTN","C0CRXN",58,0)
+"RTN","C0CRXN",229,0)
  . . S RXFOUND=RXFOUND+1
-"RTN","C0CRXN",59,0)
+"RTN","C0CRXN",230,0)
  . . I $$ZVALUE("MEDIATION CODE")="" D  ; THIS IS A NEW CODE
-"RTN","C0CRXN",60,0)
+"RTN","C0CRXN",231,0)
  . . . D SETFDA("MEDIATION CODE",$$ZVALUE("RXCUI","C0CB"))
-"RTN","C0CRXN",61,0)
+"RTN","C0CRXN",232,0)
  . . . D SETFDA("NEW","Y") ;FLAG RECORD HAS HAVING NEW RXNORM
-"RTN","C0CRXN",62,0)
+"RTN","C0CRXN",233,0)
  . . W "RXNORM=",$$ZVALUE("RXCUI","C0CB")," ",$$ZVALUE("STR","C0CB"),!
-"RTN","C0CRXN",63,0)
+"RTN","C0CRXN",234,0)
  . . W "VUID TEXT: ",$$ZVALUE("VUID TEXT"),!
-"RTN","C0CRXN",64,0)
+"RTN","C0CRXN",235,0)
  . . I $$ZVALUE("VUID TEXT")=$$ZVALUE("STR","C0CB") S TXTMATCH=TXTMATCH+1
-"RTN","C0CRXN",65,0)
+"RTN","C0CRXN",236,0)
  . . E  D  ;
-"RTN","C0CRXN",66,0)
- . . . S ZZ=$$ZVALUE("VUID TEXT")_"^"_$$ZVALUE("STR","C0CB")
-"RTN","C0CRXN",67,0)
- . . . D PUSH^GPLXPATH("NOMATCH",ZZ)
-"RTN","C0CRXN",68,0)
+"RTN","C0CRXN",237,0)
+ . . . D PUSH^GPLXPATH("NOMATCH",$$ZVALUE("VUID TEXT")_"^"_$$ZVALUE("STR","C0CB"))
+"RTN","C0CRXN",238,0)
  . . . D SETFDA("RXNORM TEXT",$$ZVALUE("STR","C0CB")) ;
-"RTN","C0CRXN",69,0)
+"RTN","C0CRXN",239,0)
  . . . D SETFDA("DIFFERENT TEXT","Y") ;FLAG RECORD FOR DIFFERENT TEXT
-"RTN","C0CRXN",70,0)
+"RTN","C0CRXN",240,0)
  . I $$ZVALUE("MEDIATION CODE")=$$ZVALUE("RXCUI","C0CB") D  ;
-"RTN","C0CRXN",71,0)
+"RTN","C0CRXN",241,0)
  . . S RXMATCH=RXMATCH+1
-"RTN","C0CRXN",72,0)
+"RTN","C0CRXN",242,0)
  . . W "VUID=",$$ZVALUE("VUID")," MATCH RXNORM=",$$ZVALUE("MEDIATION CODE"),!
-"RTN","C0CRXN",73,0)
+"RTN","C0CRXN",243,0)
  . D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
-"RTN","C0CRXN",74,0)
+"RTN","C0CRXN",244,0)
  . S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD
-"RTN","C0CRXN",75,0)
+"RTN","C0CRXN",245,0)
  . D UPDATE^DIE("","C0CFDA")
-"RTN","C0CRXN",76,0)
- . I $D(^TMP("DIERR",$J)) U $P BREAK
-"RTN","C0CRXN",77,0)
+"RTN","C0CRXN",246,0)
+ . I $D(^TMP("DIERR",$J)) S $EC=",U1,"
+"RTN","C0CRXN",247,0)
  W "HAS RXN=",HASRXN,!
-"RTN","C0CRXN",78,0)
+"RTN","C0CRXN",248,0)
  W "NO RXN=",NORXN,!
-"RTN","C0CRXN",79,0)
+"RTN","C0CRXN",249,0)
  W "NO VUID=",NOVUID,!
-"RTN","C0CRXN",80,0)
+"RTN","C0CRXN",250,0)
  W "RXNORM FOUND=",RXFOUND,!
-"RTN","C0CRXN",81,0)
+"RTN","C0CRXN",251,0)
  W "RXNORM MATCHES:",RXMATCH,!
-"RTN","C0CRXN",82,0)
+"RTN","C0CRXN",252,0)
  W "TEXT MATCHES:",TXTMATCH,!
-"RTN","C0CRXN",83,0)
+"RTN","C0CRXN",253,0)
  Q
-"RTN","C0CRXN",84,0)
- ;
-"RTN","C0CRXN",85,0)
-EXP2 ; ROUTINE TO CREATE 176.113 C0C RXNORM VUID MAPPING DISCREPANCIES FILE
-"RTN","C0CRXN",86,0)
- ; CROSS CHECKS THE NATIONAL DRUG FILE AND THE VA MAPPING FILE AGAINST
-"RTN","C0CRXN",87,0)
- ; THE UMLS RXNORM DATABASE
-"RTN","C0CRXN",88,0)
- ; THIS ROUTINE HAS BEEN ENHANCED TO ALSO CHECK THE 50.416 DRUG INGREDIENT
-"RTN","C0CRXN",89,0)
- ; FILE AND TREAT VUIDS FOUND THERE LIKE THE ONES BEING FOUND IN THE NDF
-"RTN","C0CRXN",90,0)
- ; IF THE VUID EXISISTS IN ALL THREE FILES, THE RXNORM CODE MATCHES IN
-"RTN","C0CRXN",91,0)
- ; THE VA MAPPING FILE AND THE TEXT STRINGS ARE THE SAME, THE VUID IS INCLUDED
-"RTN","C0CRXN",92,0)
- ; IN THE FILE BUT NO FLAGS ARE SET
-"RTN","C0CRXN",93,0)
- ; IF THE VUID IS MISSING FROM THE NATIONAL DRUG FILE NDF=N
-"RTN","C0CRXN",94,0)
- ; (IF THE VUID IS MISSING FROM THE NDF, IT IS CHECKED IN THE DRUG INGREDIENT
-"RTN","C0CRXN",95,0)
- ; FILE, AND IF FOUND, THE FLAG IS NOT SET. IN THIS CASE THE TEXT FROM THE
-"RTN","C0CRXN",96,0)
- ; DRUG INGREDIENT FILE IS USED FOR COMPARISONS)
-"RTN","C0CRXN",97,0)
- ; IF THE VUID IS MISSING FROM THE VA MAPPING FILE VAMAP=N
-"RTN","C0CRXN",98,0)
- ; IF THE VUID IS PRESENT IN THE VA MAPPING FILE, BUT THE RXNORM
-"RTN","C0CRXN",99,0)
- ; CODE IS MISSING IN THAT FILE, VARXN=N
-"RTN","C0CRXN",100,0)
- ; IF THE TEXT STRINGS DO NOT MATCH EXACTLY, TXTM=N AND ALL THREE STRINGS
-"RTN","C0CRXN",101,0)
- ; ARE SHOWN; NDF TEXT=NDF TEXT STRING, VA MAP TEXT=VA MAPPING TEXT STRING
-"RTN","C0CRXN",102,0)
- ; RXNORM TEXT=RXNORM TEXT STRING
-"RTN","C0CRXN",103,0)
- ; THE FILE IS KEYED ON VUID AND WOULD USUALLY BE SORTED BY VUID
-"RTN","C0CRXN",104,0)
- ; THE OBJECTIVE IS TO SEE IF NDF (50.68) AND VA MAPPING (176.111) HAVE
-"RTN","C0CRXN",105,0)
- ; ALL THE VUID CODES THAT ARE IN THE UMLS RXNORM DATABASE
-"RTN","C0CRXN",106,0)
- N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR
-"RTN","C0CRXN",107,0)
- N C0CFVA,C0CFRXN ; CLOSED ROOTS FOR SOURCE FILES
-"RTN","C0CRXN",108,0)
- N C0CF ; CLOSED ROOT FOR DESTINATION FILE
-"RTN","C0CRXN",109,0)
- S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE
-"RTN","C0CRXN",110,0)
- S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE
-"RTN","C0CRXN",111,0)
- ;S C0CF=$$FILEREF^C0CRNF(176.113) ; C0C RXNORM VUID MAPPING ADDITIONAL FILE
-"RTN","C0CRXN",112,0)
- W C0CVA,C0CFRXN,! ;C0CF,!
-"RTN","C0CRXN",113,0)
- S C0CZX=0
-"RTN","C0CRXN",114,0)
- S (NDFVCNT,NDFTCNT,NDFNO)=0 ; COUNTERS FOR NDF TESTS
-"RTN","C0CRXN",115,0)
- S (VAVCNT,VATCNT,VARCNT,VANO)=0 ; COUNTERS FOR VA MAPPING FILE TESTS
-"RTN","C0CRXN",116,0)
- F  S C0CZX=$O(^C0CRXN(176.001,"VUID",C0CZX)) Q:+C0CZX=0  D  ; FOR EVERY VUID
-"RTN","C0CRXN",117,0)
- . K C0CA,C0CB,C0CC,C0CD ; CLEAR ARRAYS
-"RTN","C0CRXN",118,0)
- . D FIELDS^C0CRNF("C0CC",176.113) ;GET FIELD NAMES FOR OUTPUT FILE
-"RTN","C0CRXN",119,0)
- . D GETN1^C0CRNF("C0CA",176.001,C0CZX,"VUID","ALL") ;GET FROM RXNORM FILE
-"RTN","C0CRXN",120,0)
- . D GETN1^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;GET FROM VA MAPPING FILE
-"RTN","C0CRXN",121,0)
- . D GETN1^C0CRNF("C0CD",50.68,C0CZX,"AVUID","ALL") ;GET FROM NDF
-"RTN","C0CRXN",122,0)
- . D GETN1^C0CRNF("C0CE",50.416,C0CZX,"AVUID","ALL") ;GET FROM DRUG INGREDIENTS
-"RTN","C0CRXN",123,0)
- . ;D SETFDA("VUID",$$ZVALUE("CODE")) ;SET THE VUID CODE
-"RTN","C0CRXN",124,0)
- . D SETFDA("RXNORM",$$ZVALUE("RXCUI")) ;SET THE RXNORM CODE
-"RTN","C0CRXN",125,0)
- . D SETFDA("RXNORM TEXT",$$ZVALUE("STR")) ;SET THE RXNORM TEXT
-"RTN","C0CRXN",126,0)
- . ;VA MAPPING FILE TESTS
-"RTN","C0CRXN",127,0)
- . I $$ZVALUE("VUID","C0CB")=C0CZX D  ; VUID FOUND
-"RTN","C0CRXN",128,0)
- . . S VAVCNT=VAVCNT+1 ;INCREMENT COUNT
-"RTN","C0CRXN",129,0)
- . . I $$ZVALUE("STR")'=$$ZVALUE("VUID TEXT","C0CB") D  ;TEXT MISMATCH
-"RTN","C0CRXN",130,0)
- . . . S VATCNT=VATCNT+1 ; INCREMENT VA TEXT MISMATCH COUNT
-"RTN","C0CRXN",131,0)
- . . . D SETFDA("TXTM","N") ;MARK THAT TEXT DOESN'T MATCH
-"RTN","C0CRXN",132,0)
- . . . D SETFDA("VA MAP TEXT",$$ZVALUE("VUID TEXT","C0CB")) ; SET VA MAP TEXT
-"RTN","C0CRXN",133,0)
- . E  D  ; VUID NOT FOUND
-"RTN","C0CRXN",134,0)
- . . S VANO=VANO+1
-"RTN","C0CRXN",135,0)
- . . D SETFDA("VAMAP","N") ;MARK AS MISSING FROM VA MAPPING FILE
-"RTN","C0CRXN",136,0)
- . ; NATIONAL DRUG FILE TESTS
-"RTN","C0CRXN",137,0)
- . I ($$ZVALUE("VUID","C0CD")=C0CZX)!($$ZVALUE("VUID","C0CE")=C0CZX) D  ;
-"RTN","C0CRXN",138,0)
- . . ;FOUND IN NATIONAL DRUG FILE OR DRUG INGREDIENT FILE
-"RTN","C0CRXN",139,0)
- . . S NDFVCNT=NDFVCNT+1 ;INCREMENT VUID FOUND COUNT
-"RTN","C0CRXN",140,0)
- . . I $$ZVALUE("NAME","C0CD")'=$$ZVALUE("STR") D  ;NDF TEXT DOESN'T MATCH
-"RTN","C0CRXN",141,0)
- . . . I $$ZVALUE("NAME","C0CE")'=$$ZVALUE("STR") D  ;DRUG ING FILE ALSO
-"RTN","C0CRXN",142,0)
- . . . . S NDFTCNT=NDFTCNT+1 ; INCREMENT MISMATCHED NDF TEXT COUNT
-"RTN","C0CRXN",143,0)
- . . . . D SETFDA("TXTM","N") ; SET TEXT MATCH FLAG TO N
-"RTN","C0CRXN",144,0)
- . . . . D SETFDA("NDF TEXT",$$ZVALUE("NAME","C0CD")) ;POST THE TEXT
-"RTN","C0CRXN",145,0)
- . . . . D SETFDA("NAT DRUG TEXT",$$ZVALUE("NAME","C0CE")) ;POST TEXT
-"RTN","C0CRXN",146,0)
- . E  D  ;
-"RTN","C0CRXN",147,0)
- . . D SETFDA("NDF","N") ;MARK AS MISSING
-"RTN","C0CRXN",148,0)
- . . S NDFNO=NDFNO+1 ;INCREMENT MISSING COUNT
-"RTN","C0CRXN",149,0)
- . D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
-"RTN","C0CRXN",150,0)
- . S C0CFDA(176.113,"+"_C0CZX_",",.01)=C0CZX ; NEW VUID RECORD
-"RTN","C0CRXN",151,0)
- . D UPDATE^DIE("","C0CFDA")
-"RTN","C0CRXN",152,0)
- . I $D(^TMP("DIERR",$J)) U $P BREAK
-"RTN","C0CRXN",153,0)
- W "VA MAPPING VUID COUNT: ",VAVCNT,!
-"RTN","C0CRXN",154,0)
- W "VA MAPPING MISSING: ",VANO,!
-"RTN","C0CRXN",155,0)
- W "VA MAPPING TEXT MISMATCH: ",VATCNT,!
-"RTN","C0CRXN",156,0)
- W "NDF VUID COUNT: ",NDFVCNT,!
-"RTN","C0CRXN",157,0)
- W "NDF MISSING: ",NDFNO,!
-"RTN","C0CRXN",158,0)
- W "NDF TEXT MISMATCH: ",NDFTCNT,!
-"RTN","C0CRXN",159,0)
+"RTN","C0CRXN",254,0)
+SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
+"RTN","C0CRXN",255,0)
+ ; TO SET TO VALUE C0CSV.
+"RTN","C0CRXN",256,0)
+ ; C0CFDA,C0CA,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
+"RTN","C0CRXN",257,0)
+ ; C0CSN,C0CSV ARE PASSED BY VALUE
+"RTN","C0CRXN",258,0)
+ ;
+"RTN","C0CRXN",259,0)
+ N C0CSI,C0CSJ
+"RTN","C0CRXN",260,0)
+ S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
+"RTN","C0CRXN",261,0)
+ S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
+"RTN","C0CRXN",262,0)
+ S C0CFDA(C0CSI,"+"_C0CZX_",",C0CSJ)=C0CSV
+"RTN","C0CRXN",263,0)
  Q
-"RTN","C0CRXN",160,0)
-CHKNDF ; ROUTINE TO CHECK THE NATIONAL DRUG FILE WITH THE UMLS RXNORM DB
-"RTN","C0CRXN",161,0)
- ; USING THE AVUID INDEX, READS ALL VUID CODES IN ^PSNDF(50.68),
-"RTN","C0CRXN",162,0)
- ; CHECKS TO SEE IF THE CODE IS IN 176.001, AND CREATES A RECORD
-"RTN","C0CRXN",163,0)
- ; IN 176.114
-"RTN","C0CRXN",164,0)
- ; THE OBJECTIVE IS TO SEE IF ^PSNDF(50.68) HAS ALL THE VUID CODES IN THE
-"RTN","C0CRXN",165,0)
- ; UMLS RXNORM DATABASE AND IF THE TEXT FIELDS MATCH
-"RTN","C0CRXN",166,0)
- ; ALSO CAPTURES THE RXNORM CODE MAPPING
-"RTN","C0CRXN",167,0)
- ; CHKNDF2 WILL CHECK THE OTHER DIRECTION, STARTING WITH THE 176.001 VUID INDEX
-"RTN","C0CRXN",168,0)
- ; THIS ROUTINE ALSO CHECKS IF THE VUID CODE IS IN 176.111 AND IF NOT
-"RTN","C0CRXN",169,0)
- ; SETS NOTMAPPED=Y
-"RTN","C0CRXN",170,0)
- N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR
-"RTN","C0CRXN",171,0)
- N C0CFVA,C0CFRXN,C0CPSNDF ; CLOSED ROOTS FOR SOURCE FILES
-"RTN","C0CRXN",172,0)
- N C0CF ; CLOSED ROOT FOR DESTINATION FILE
-"RTN","C0CRXN",173,0)
- S C0CPSNDF=$$FILEREF^C0CRNF(50.68) ; NDF CLOSED ROOT REFERENCE
-"RTN","C0CRXN",174,0)
- S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE
-"RTN","C0CRXN",175,0)
- S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE
-"RTN","C0CRXN",176,0)
- ;S C0CF=$$FILEREF^C0CRNF(176.113) ; C0C RXNORM VUID MAPPING ADDITIONAL FILE
-"RTN","C0CRXN",177,0)
- W C0CVA,C0CFRXN,! ;C0CF,!
-"RTN","C0CRXN",178,0)
- S C0CZX=0
-"RTN","C0CRXN",179,0)
- S (FOUND,MISSING)=0
-"RTN","C0CRXN",180,0)
- S (NOVUID,VMATCH,NOMATCH,MISSING,FOUND,TXTMATCH,NOTM,NVAM)=0 ; COUNTERS
-"RTN","C0CRXN",181,0)
- F  S C0CZX=$O(^PSNDF(50.68,"AVUID",C0CZX)) Q:+C0CZX=0  D  ; FOR EVERY VUID
-"RTN","C0CRXN",182,0)
- . K C0CA,C0CB,C0CC,C0CD ; CLEAR ARRAYS
-"RTN","C0CRXN",183,0)
- . ;D FIELDS^C0CRNF("C0CC",176.113) ;GET FIELD NAMES FOR OUTPUT FILE
-"RTN","C0CRXN",184,0)
- . D GETN1^C0CRNF("C0CA",50.68,C0CZX,"AVUID","ALL") ;GET THE FIELDS
-"RTN","C0CRXN",185,0)
- . I $$ZVALUE("VUID")="" D  ; ERROR, SHOULD NOT HAPPEN
-"RTN","C0CRXN",186,0)
- . . S NOVUID=NOVUID+1 ; FLAG THE ERROR
-"RTN","C0CRXN",187,0)
- . . D PUSH^GPLXPATH("NOVUID",C0CZX) ; RECORD THE VUID
-"RTN","C0CRXN",188,0)
- . D GETN1^C0CRNF("C0CD",176.001,C0CZX,"VUID","ALL") ;TRY RXNORM DB
-"RTN","C0CRXN",189,0)
- . I $$ZVALUE("CODE","C0CD")=C0CZX D  ; FOUND IN RXNORM
-"RTN","C0CRXN",190,0)
- . . S VMATCH=VMATCH+1 ; COUNT OF PSNDF VUIDS FOUND IN RXNORM
-"RTN","C0CRXN",191,0)
- . . I $$ZVALUE("NAME")=$$ZVALUE("STR","C0CD") D  ;TEXT MATCHES
-"RTN","C0CRXN",192,0)
- . . . S TXTMATCH=TXTMATCH+1 ; COUNT IT
-"RTN","C0CRXN",193,0)
- . . E  D  ; TEXT DOESN'T MATCH
-"RTN","C0CRXN",194,0)
- . . . S NOTM=NOTM+1 ;NO TEXT MATCH COUNTER
-"RTN","C0CRXN",195,0)
- . . . S ZV=$$ZVALUE("NAME")_"^"_$$ZVALUE("STR","C0CD")
-"RTN","C0CRXN",196,0)
- . . . W ZV,!
-"RTN","C0CRXN",197,0)
- . . . D PUSH^GPLXPATH("TXTNM",ZV) ; RECORD THE TXT MISMATCH
-"RTN","C0CRXN",198,0)
- . E  S NOMATCH=NOMATCH+1 ; NOT FOUND IN RXNORM
-"RTN","C0CRXN",199,0)
- . D GETN1^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;TRY TO GET FROM 176.111
-"RTN","C0CRXN",200,0)
- . I $$ZVALUE("VUID","C0CB")="" D  ; VUID NOT FOUND
-"RTN","C0CRXN",201,0)
- . . ;W "NOT FOUND: ",C0CZX," ",$$ZVALUE("STR")," ",$$ZVALUE("RXCUI"),!
-"RTN","C0CRXN",202,0)
- . . S MISSING=MISSING+1
-"RTN","C0CRXN",203,0)
- . . D PUSH^GPLXPATH("MISSING",C0CZX) ;MISSING FROM MAPPING FILE
-"RTN","C0CRXN",204,0)
- . E  D  ; FOUND IN VA MAPPING FILE
-"RTN","C0CRXN",205,0)
- . . S FOUND=FOUND+1
-"RTN","C0CRXN",206,0)
- . . I $$ZVALUE("VUID TEXT","C0CB")'=$$ZVALUE("NAME") D  ; TEXT DOESN'T MATCH
-"RTN","C0CRXN",207,0)
- . . . S NVAM=NVAM+1 ; MAPPING FILE TEXT IS DIFFERENT THAN NDF
-"RTN","C0CRXN",208,0)
- . . . S ZY=$$ZVALUE("VUID TEXT","C0CB")_"^"_$$ZVALUE("NAME") ;BOTH STRINGS
-"RTN","C0CRXN",209,0)
- . . . W "VA: ",ZY,!
-"RTN","C0CRXN",210,0)
- . . . D PUSH^GPLXPATH("NVAM",ZY) ;SAVE IT
-"RTN","C0CRXN",211,0)
- W "MISSING IN MAPPING FILE: ",MISSING,!
-"RTN","C0CRXN",212,0)
- W "FOUND IN MAPPING FILE: ",FOUND,!
-"RTN","C0CRXN",213,0)
- W "FOUND IN RXNORM: ",VMATCH,!
-"RTN","C0CRXN",214,0)
- W "NOT FOUND IN RXNORM: ",NOMATCH,!
-"RTN","C0CRXN",215,0)
- W "ERRORS: ",NOVUID,!
-"RTN","C0CRXN",216,0)
- Q
-"RTN","C0CRXN",217,0)
- ;
-"RTN","C0CRXN",218,0)
- . I $$ZVALUE("MEDIATION CODE")="" D
-"RTN","C0CRXN",219,0)
- . . S NORXN=NORXN+1 ;
-"RTN","C0CRXN",220,0)
- . E  D  ; PROCESS MEDIATION CODE
-"RTN","C0CRXN",221,0)
- . . S HASRXN=HASRXN+1
-"RTN","C0CRXN",222,0)
- . . D SETFDA("MEDIATION CODE",$$ZVALUE("MEDIATION CODE")) ;
-"RTN","C0CRXN",223,0)
- . I $$ZVALUE("VUID")="" D  ; BAD RECORD
-"RTN","C0CRXN",224,0)
- . . S NOVUID=NOVUID+1
-"RTN","C0CRXN",225,0)
- . . ;D SETFDA("VUID",$$ZVALUE("VUID"))
-"RTN","C0CRXN",226,0)
- . E  D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT"))
-"RTN","C0CRXN",227,0)
- . . ;ZWR C0CA
-"RTN","C0CRXN",228,0)
- . D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
-"RTN","C0CRXN",229,0)
- . I $$ZVALUE("RXCUI","C0CB")'="" D  ; RXNORM FOUND
-"RTN","C0CRXN",230,0)
- . . S RXFOUND=RXFOUND+1
-"RTN","C0CRXN",231,0)
- . . I $$ZVALUE("MEDIATION CODE")="" D  ; THIS IS A NEW CODE
-"RTN","C0CRXN",232,0)
- . . . D SETFDA("MEDIATION CODE",$$ZVALUE("RXCUI","C0CB"))
-"RTN","C0CRXN",233,0)
- . . . D SETFDA("NEW","Y") ;FLAG RECORD HAS HAVING NEW RXNORM
-"RTN","C0CRXN",234,0)
- . . W "RXNORM=",$$ZVALUE("RXCUI","C0CB")," ",$$ZVALUE("STR","C0CB"),!
-"RTN","C0CRXN",235,0)
- . . W "VUID TEXT: ",$$ZVALUE("VUID TEXT"),!
-"RTN","C0CRXN",236,0)
- . . I $$ZVALUE("VUID TEXT")=$$ZVALUE("STR","C0CB") S TXTMATCH=TXTMATCH+1
-"RTN","C0CRXN",237,0)
- . . E  D  ;
-"RTN","C0CRXN",238,0)
- . . . D PUSH^GPLXPATH("NOMATCH",$$ZVALUE("VUID TEXT")_"^"_$$ZVALUE("STR","C0CB"))
-"RTN","C0CRXN",239,0)
- . . . D SETFDA("RXNORM TEXT",$$ZVALUE("STR","C0CB")) ;
-"RTN","C0CRXN",240,0)
- . . . D SETFDA("DIFFERENT TEXT","Y") ;FLAG RECORD FOR DIFFERENT TEXT
-"RTN","C0CRXN",241,0)
- . I $$ZVALUE("MEDIATION CODE")=$$ZVALUE("RXCUI","C0CB") D  ;
-"RTN","C0CRXN",242,0)
- . . S RXMATCH=RXMATCH+1
-"RTN","C0CRXN",243,0)
- . . W "VUID=",$$ZVALUE("VUID")," MATCH RXNORM=",$$ZVALUE("MEDIATION CODE"),!
-"RTN","C0CRXN",244,0)
- . D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
-"RTN","C0CRXN",245,0)
- . S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD
-"RTN","C0CRXN",246,0)
- . D UPDATE^DIE("","C0CFDA")
-"RTN","C0CRXN",247,0)
- . I $D(^TMP("DIERR",$J)) U $P BREAK
-"RTN","C0CRXN",248,0)
- W "HAS RXN=",HASRXN,!
-"RTN","C0CRXN",249,0)
- W "NO RXN=",NORXN,!
-"RTN","C0CRXN",250,0)
- W "NO VUID=",NOVUID,!
-"RTN","C0CRXN",251,0)
- W "RXNORM FOUND=",RXFOUND,!
-"RTN","C0CRXN",252,0)
- W "RXNORM MATCHES:",RXMATCH,!
-"RTN","C0CRXN",253,0)
- W "TEXT MATCHES:",TXTMATCH,!
-"RTN","C0CRXN",254,0)
- Q
-"RTN","C0CRXN",255,0)
-SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
-"RTN","C0CRXN",256,0)
- ; TO SET TO VALUE C0CSV.
-"RTN","C0CRXN",257,0)
- ; C0CFDA,C0CA,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
-"RTN","C0CRXN",258,0)
- ; C0CSN,C0CSV ARE PASSED BY VALUE
-"RTN","C0CRXN",259,0)
- ;
-"RTN","C0CRXN",260,0)
- N C0CSI,C0CSJ
-"RTN","C0CRXN",261,0)
- S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
-"RTN","C0CRXN",262,0)
- S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
-"RTN","C0CRXN",263,0)
- S C0CFDA(C0CSI,"+"_C0CZX_",",C0CSJ)=C0CSV
 "RTN","C0CRXN",264,0)
- Q
+ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
 "RTN","C0CRXN",265,0)
-ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
 "RTN","C0CRXN",266,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
+ ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
 "RTN","C0CRXN",267,0)
+ I '$D(ZTAB) S ZTAB="C0CA"
+"RTN","C0CRXN",268,0)
+ N ZR
+"RTN","C0CRXN",269,0)
+ I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
+"RTN","C0CRXN",270,0)
+ E  S ZR=""
+"RTN","C0CRXN",271,0)
+ Q ZR
+"RTN","C0CRXN",272,0)
+ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
+"RTN","C0CRXN",273,0)
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
+"RTN","C0CRXN",274,0)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CRXN",268,0)
+"RTN","C0CRXN",275,0)
  I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CRXN",269,0)
+"RTN","C0CRXN",276,0)
  N ZR
-"RTN","C0CRXN",270,0)
- I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
-"RTN","C0CRXN",271,0)
+"RTN","C0CRXN",277,0)
+ I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
+"RTN","C0CRXN",278,0)
  E  S ZR=""
-"RTN","C0CRXN",272,0)
+"RTN","C0CRXN",279,0)
  Q ZR
-"RTN","C0CRXN",273,0)
-ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
-"RTN","C0CRXN",274,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
-"RTN","C0CRXN",275,0)
+"RTN","C0CRXN",280,0)
+ ;
+"RTN","C0CRXN",281,0)
+ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
+"RTN","C0CRXN",282,0)
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
+"RTN","C0CRXN",283,0)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CRXN",276,0)
+"RTN","C0CRXN",284,0)
  I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CRXN",277,0)
+"RTN","C0CRXN",285,0)
  N ZR
-"RTN","C0CRXN",278,0)
- I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
-"RTN","C0CRXN",279,0)
+"RTN","C0CRXN",286,0)
+ I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
+"RTN","C0CRXN",287,0)
  E  S ZR=""
-"RTN","C0CRXN",280,0)
+"RTN","C0CRXN",288,0)
  Q ZR
-"RTN","C0CRXN",281,0)
- ;
-"RTN","C0CRXN",282,0)
-ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
-"RTN","C0CRXN",283,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
-"RTN","C0CRXN",284,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CRXN",285,0)
- I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CRXN",286,0)
- N ZR
-"RTN","C0CRXN",287,0)
- I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
-"RTN","C0CRXN",288,0)
- E  S ZR=""
 "RTN","C0CRXN",289,0)
- Q ZR
-"RTN","C0CRXN",290,0)
  ;
 "RTN","C0CRXNRD")
-0^97^B31474664
+0^97^B36296842
 "RTN","C0CRXNRD",1,0)
 C0CRXNRD ; WV/SMH - CCR/CCD PROJECT: Routine to Read RxNorm files;11/15/08
 "RTN","C0CRXNRD",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CRXNRD",3,0)
+ ; Copyright Sam Habiel 2008.
+"RTN","C0CRXNRD",4,0)
+ ;
+"RTN","C0CRXNRD",5,0)
+ ; This program is free software: you can redistribute it and/or modify
+"RTN","C0CRXNRD",6,0)
+ ; it under the terms of the GNU Affero General Public License as
+"RTN","C0CRXNRD",7,0)
+ ; published by the Free Software Foundation, either version 3 of the
+"RTN","C0CRXNRD",8,0)
+ ; License, or (at your option) any later version.
+"RTN","C0CRXNRD",9,0)
+ ;
+"RTN","C0CRXNRD",10,0)
+ ; This program is distributed in the hope that it will be useful,
+"RTN","C0CRXNRD",11,0)
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","C0CRXNRD",12,0)
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","C0CRXNRD",13,0)
+ ; GNU Affero General Public License for more details.
+"RTN","C0CRXNRD",14,0)
+ ;
+"RTN","C0CRXNRD",15,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CRXNRD",16,0)
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+"RTN","C0CRXNRD",17,0)
+ ;
+"RTN","C0CRXNRD",18,0)
  W "No entry from top" Q
-"RTN","C0CRXNRD",4,0)
-IMPORT(PATH) 
-"RTN","C0CRXNRD",5,0)
+"RTN","C0CRXNRD",19,0)
+IMPORT(PATH) ; Main entry point
+"RTN","C0CRXNRD",20,0)
  I PATH="" QUIT
-"RTN","C0CRXNRD",6,0)
+"RTN","C0CRXNRD",21,0)
  D READSRC(PATH),READCON(PATH),READNDC(PATH)
-"RTN","C0CRXNRD",7,0)
+"RTN","C0CRXNRD",22,0)
  QUIT
-"RTN","C0CRXNRD",8,0)
- ;
-"RTN","C0CRXNRD",9,0)
+"RTN","C0CRXNRD",23,0)
+ ;
+"RTN","C0CRXNRD",24,0)
 DELFILED(FN) ; Delete file data; PEP procedure; only for RxNorm files
-"RTN","C0CRXNRD",10,0)
+"RTN","C0CRXNRD",25,0)
  ; FN is Filenumber passed by Value
-"RTN","C0CRXNRD",11,0)
+"RTN","C0CRXNRD",26,0)
  QUIT:$E(FN,1,3)'=176  ; Quit if not RxNorm files
-"RTN","C0CRXNRD",12,0)
+"RTN","C0CRXNRD",27,0)
  D CLEAN^DILF ; Clean FM variables
-"RTN","C0CRXNRD",13,0)
+"RTN","C0CRXNRD",28,0)
  N ROOT S ROOT=$$ROOT^DILFD(FN,"",1) ; global root
-"RTN","C0CRXNRD",14,0)
+"RTN","C0CRXNRD",29,0)
  N ZERO S ZERO=@ROOT@(0) ; Save zero node
-"RTN","C0CRXNRD",15,0)
+"RTN","C0CRXNRD",30,0)
  S $P(ZERO,U,3,9999)="" ; Remove entry # and last edited
-"RTN","C0CRXNRD",16,0)
+"RTN","C0CRXNRD",31,0)
  K @ROOT ; Kill the file -- so sad!
-"RTN","C0CRXNRD",17,0)
+"RTN","C0CRXNRD",32,0)
  S @ROOT@(0)=ZERO ; It riseth again!
-"RTN","C0CRXNRD",18,0)
+"RTN","C0CRXNRD",33,0)
  QUIT
-"RTN","C0CRXNRD",19,0)
+"RTN","C0CRXNRD",34,0)
 GETLINES(PATH,FILENAME) ; Get number of lines in a file
-"RTN","C0CRXNRD",20,0)
+"RTN","C0CRXNRD",35,0)
  D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
-"RTN","C0CRXNRD",21,0)
+"RTN","C0CRXNRD",36,0)
  U IO
-"RTN","C0CRXNRD",22,0)
+"RTN","C0CRXNRD",37,0)
  N I
-"RTN","C0CRXNRD",23,0)
- F I=1:1 R LINE Q:$$STATUS^%ZISH
-"RTN","C0CRXNRD",24,0)
+"RTN","C0CRXNRD",38,0)
+ F I=1:1 R LINE:0 Q:$$STATUS^%ZISH
+"RTN","C0CRXNRD",39,0)
  D CLOSE^%ZISH("FILE")
-"RTN","C0CRXNRD",25,0)
+"RTN","C0CRXNRD",40,0)
  Q I-1
-"RTN","C0CRXNRD",26,0)
+"RTN","C0CRXNRD",41,0)
 READCON(PATH,INCRES) ; Open and read concepts file: RXNCONSO.RRF; EP
-"RTN","C0CRXNRD",27,0)
+"RTN","C0CRXNRD",42,0)
  ; PATH ByVal, path of RxNorm files
-"RTN","C0CRXNRD",28,0)
+"RTN","C0CRXNRD",43,0)
  ; INCRES ByVal, include restricted sources. 1 for yes, 0 for no
-"RTN","C0CRXNRD",29,0)
+"RTN","C0CRXNRD",44,0)
  I PATH="" QUIT
-"RTN","C0CRXNRD",30,0)
+"RTN","C0CRXNRD",45,0)
  S INCRES=+$G(INCRES) ; if not passed, becomes zero.
-"RTN","C0CRXNRD",31,0)
+"RTN","C0CRXNRD",46,0)
  N FILENAME S FILENAME="RXNCONSO.RRF"
-"RTN","C0CRXNRD",32,0)
+"RTN","C0CRXNRD",47,0)
  D DELFILED(176.001) ; delete data
-"RTN","C0CRXNRD",33,0)
+"RTN","C0CRXNRD",48,0)
  N LINES S LINES=$$GETLINES(PATH,FILENAME)
-"RTN","C0CRXNRD",34,0)
+"RTN","C0CRXNRD",49,0)
  D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
-"RTN","C0CRXNRD",35,0)
+"RTN","C0CRXNRD",50,0)
  IF POP D EN^DDIOL("Error reading file..., Please check...") G EX
-"RTN","C0CRXNRD",36,0)
+"RTN","C0CRXNRD",51,0)
  N C0CCOUNT
-"RTN","C0CRXNRD",37,0)
+"RTN","C0CRXNRD",52,0)
  F C0CCOUNT=1:1 D  Q:$$STATUS^%ZISH
-"RTN","C0CRXNRD",38,0)
+"RTN","C0CRXNRD",53,0)
  . U IO
-"RTN","C0CRXNRD",39,0)
- . N LINE R LINE
-"RTN","C0CRXNRD",40,0)
+"RTN","C0CRXNRD",54,0)
+ . N LINE R LINE:0
+"RTN","C0CRXNRD",55,0)
  . IF $$STATUS^%ZISH QUIT
-"RTN","C0CRXNRD",41,0)
+"RTN","C0CRXNRD",56,0)
  . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000
-"RTN","C0CRXNRD",42,0)
+"RTN","C0CRXNRD",57,0)
  . N RXCUI,RXAUI,SAB,TTY,CODE,STR  ; Fileman fields numbers below
-"RTN","C0CRXNRD",43,0)
+"RTN","C0CRXNRD",58,0)
  . S RXCUI=$P(LINE,"|",1) ; .01
-"RTN","C0CRXNRD",44,0)
+"RTN","C0CRXNRD",59,0)
  . S RXAUI=$P(LINE,"|",8) ; 1
-"RTN","C0CRXNRD",45,0)
+"RTN","C0CRXNRD",60,0)
  . S SAB=$P(LINE,"|",12) ; 2
-"RTN","C0CRXNRD",46,0)
+"RTN","C0CRXNRD",61,0)
  . ; If the source is a restricted source, decide what to do based on what's asked.
-"RTN","C0CRXNRD",47,0)
+"RTN","C0CRXNRD",62,0)
  . N SRCIEN S SRCIEN=$$FIND1^DIC(176.003,"","QX",SAB,"B") ; SrcIEN in RXNORM SOURCES file
-"RTN","C0CRXNRD",48,0)
+"RTN","C0CRXNRD",63,0)
  . N RESTRIC S RESTRIC=$$GET1^DIQ(176.003,SRCIEN,14,"I") ; 14 is restriction field; values 0-4
-"RTN","C0CRXNRD",49,0)
+"RTN","C0CRXNRD",64,0)
  . ; If RESTRIC is zero, then it's unrestricted. Everything else is restricted.
-"RTN","C0CRXNRD",50,0)
+"RTN","C0CRXNRD",65,0)
  . ; If user didn't ask to include restricted sources, and the source is restricted, then quit
-"RTN","C0CRXNRD",51,0)
+"RTN","C0CRXNRD",66,0)
  . I 'INCRES,RESTRIC QUIT
-"RTN","C0CRXNRD",52,0)
+"RTN","C0CRXNRD",67,0)
  . S TTY=$P(LINE,"|",13) ; 3
-"RTN","C0CRXNRD",53,0)
+"RTN","C0CRXNRD",68,0)
  . S CODE=$P(LINE,"|",14) ; 4
-"RTN","C0CRXNRD",54,0)
+"RTN","C0CRXNRD",69,0)
  . S STR=$P(LINE,"|",15) ; 5
-"RTN","C0CRXNRD",55,0)
+"RTN","C0CRXNRD",70,0)
  . ; Remove embedded "^"
-"RTN","C0CRXNRD",56,0)
+"RTN","C0CRXNRD",71,0)
  . S STR=$TR(STR,"^")
-"RTN","C0CRXNRD",57,0)
+"RTN","C0CRXNRD",72,0)
  . ; Convert STR into an array of 80 characters on each line
-"RTN","C0CRXNRD",58,0)
+"RTN","C0CRXNRD",73,0)
  . N STRLINE S STRLINE=$L(STR)\80+1
-"RTN","C0CRXNRD",59,0)
+"RTN","C0CRXNRD",74,0)
  . ; In each line, chop 80 characters off, reset STR to be the rest
-"RTN","C0CRXNRD",60,0)
+"RTN","C0CRXNRD",75,0)
  . N J F J=1:1:STRLINE S STR(J)=$E(STR,1,80) S STR=$E(STR,81,$L(STR))
-"RTN","C0CRXNRD",61,0)
+"RTN","C0CRXNRD",76,0)
  . ; Now, construct the FDA array
-"RTN","C0CRXNRD",62,0)
+"RTN","C0CRXNRD",77,0)
  . N RXNFDA
-"RTN","C0CRXNRD",63,0)
+"RTN","C0CRXNRD",78,0)
  . S RXNFDA(176.001,"+1,",.01)=RXCUI
-"RTN","C0CRXNRD",64,0)
+"RTN","C0CRXNRD",79,0)
  . S RXNFDA(176.001,"+1,",1)=RXAUI
-"RTN","C0CRXNRD",65,0)
+"RTN","C0CRXNRD",80,0)
  . S RXNFDA(176.001,"+1,",2)=SAB
-"RTN","C0CRXNRD",66,0)
+"RTN","C0CRXNRD",81,0)
  . S RXNFDA(176.001,"+1,",3)=TTY
-"RTN","C0CRXNRD",67,0)
+"RTN","C0CRXNRD",82,0)
  . S RXNFDA(176.001,"+1,",4)=CODE
-"RTN","C0CRXNRD",68,0)
+"RTN","C0CRXNRD",83,0)
  . N RXNIEN S RXNIEN(1)=C0CCOUNT
-"RTN","C0CRXNRD",69,0)
+"RTN","C0CRXNRD",84,0)
  . D UPDATE^DIE("","RXNFDA","RXNIEN")
-"RTN","C0CRXNRD",70,0)
+"RTN","C0CRXNRD",85,0)
  . I $D(^TMP("DIERR",$J)) D EN^DDIOL("ERROR") G EX
-"RTN","C0CRXNRD",71,0)
+"RTN","C0CRXNRD",86,0)
  . ; Now, file WP field STR
-"RTN","C0CRXNRD",72,0)
+"RTN","C0CRXNRD",87,0)
  . D WP^DIE(176.001,C0CCOUNT_",",5,,$NA(STR))
-"RTN","C0CRXNRD",73,0)
+"RTN","C0CRXNRD",88,0)
 EX D CLOSE^%ZISH("FILE")
-"RTN","C0CRXNRD",74,0)
+"RTN","C0CRXNRD",89,0)
  QUIT
-"RTN","C0CRXNRD",75,0)
+"RTN","C0CRXNRD",90,0)
 READNDC(PATH) ; Open and read NDC/RxNorm/VANDF relationship file: RXNSAT.RRF
-"RTN","C0CRXNRD",76,0)
+"RTN","C0CRXNRD",91,0)
  I PATH="" QUIT
-"RTN","C0CRXNRD",77,0)
+"RTN","C0CRXNRD",92,0)
  N FILENAME S FILENAME="RXNSAT.RRF"
-"RTN","C0CRXNRD",78,0)
+"RTN","C0CRXNRD",93,0)
  D DELFILED(176.002) ; delete data
-"RTN","C0CRXNRD",79,0)
+"RTN","C0CRXNRD",94,0)
  N LINES S LINES=$$GETLINES(PATH,FILENAME)
-"RTN","C0CRXNRD",80,0)
+"RTN","C0CRXNRD",95,0)
  D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
-"RTN","C0CRXNRD",81,0)
+"RTN","C0CRXNRD",96,0)
  IF POP W "Error reading file..., Please check...",! G EX2
-"RTN","C0CRXNRD",82,0)
+"RTN","C0CRXNRD",97,0)
  F C0CCOUNT=1:1 Q:$$STATUS^%ZISH  D
-"RTN","C0CRXNRD",83,0)
+"RTN","C0CRXNRD",98,0)
  . U IO
-"RTN","C0CRXNRD",84,0)
- . N LINE R LINE
-"RTN","C0CRXNRD",85,0)
+"RTN","C0CRXNRD",99,0)
+ . N LINE R LINE:0
+"RTN","C0CRXNRD",100,0)
  . IF $$STATUS^%ZISH QUIT
-"RTN","C0CRXNRD",86,0)
+"RTN","C0CRXNRD",101,0)
  . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000
-"RTN","C0CRXNRD",87,0)
+"RTN","C0CRXNRD",102,0)
  . IF LINE'["NDC|RXNORM"  QUIT
-"RTN","C0CRXNRD",88,0)
+"RTN","C0CRXNRD",103,0)
  . ; Otherwise, we are good to go
-"RTN","C0CRXNRD",89,0)
+"RTN","C0CRXNRD",104,0)
  . N RXCUI,NDC ; Fileman fields below
-"RTN","C0CRXNRD",90,0)
+"RTN","C0CRXNRD",105,0)
  . S RXCUI=$P(LINE,"|",1) ; .01
-"RTN","C0CRXNRD",91,0)
+"RTN","C0CRXNRD",106,0)
  . S NDC=$P(LINE,"|",11) ; 2
-"RTN","C0CRXNRD",92,0)
+"RTN","C0CRXNRD",107,0)
  . ; Using classic call to update.
-"RTN","C0CRXNRD",93,0)
+"RTN","C0CRXNRD",108,0)
  . N DIC,X,DA,DR
-"RTN","C0CRXNRD",94,0)
+"RTN","C0CRXNRD",109,0)
  . K DO
-"RTN","C0CRXNRD",95,0)
+"RTN","C0CRXNRD",110,0)
  . S DIC="^C0CRXN(176.002,",DIC(0)="F",X=RXCUI,DIC("DR")="2////"_NDC
-"RTN","C0CRXNRD",96,0)
+"RTN","C0CRXNRD",111,0)
  . D FILE^DICN
-"RTN","C0CRXNRD",97,0)
+"RTN","C0CRXNRD",112,0)
  . I Y<1 U $P W !,"THERE IS TROUBLE IN RIVER CITY",! G EX2
-"RTN","C0CRXNRD",98,0)
+"RTN","C0CRXNRD",113,0)
 EX2 D CLOSE^%ZISH("FILE")
-"RTN","C0CRXNRD",99,0)
+"RTN","C0CRXNRD",114,0)
  QUIT
-"RTN","C0CRXNRD",100,0)
+"RTN","C0CRXNRD",115,0)
 READSRC(PATH) ; Open the read RxNorm Sources file: RXNSAB.RRF
-"RTN","C0CRXNRD",101,0)
+"RTN","C0CRXNRD",116,0)
  I PATH="" QUIT
-"RTN","C0CRXNRD",102,0)
+"RTN","C0CRXNRD",117,0)
  N FILENAME S FILENAME="RXNSAB.RRF"
-"RTN","C0CRXNRD",103,0)
+"RTN","C0CRXNRD",118,0)
  D DELFILED(176.003) ; delete data
-"RTN","C0CRXNRD",104,0)
+"RTN","C0CRXNRD",119,0)
  D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
-"RTN","C0CRXNRD",105,0)
+"RTN","C0CRXNRD",120,0)
  IF POP W "Error reading file..., Please check...",! G EX3
-"RTN","C0CRXNRD",106,0)
+"RTN","C0CRXNRD",121,0)
  F I=1:1 Q:$$STATUS^%ZISH  D
-"RTN","C0CRXNRD",107,0)
+"RTN","C0CRXNRD",122,0)
  . U IO
-"RTN","C0CRXNRD",108,0)
- . N LINE R LINE
-"RTN","C0CRXNRD",109,0)
+"RTN","C0CRXNRD",123,0)
+ . N LINE R LINE:0
+"RTN","C0CRXNRD",124,0)
  . IF $$STATUS^%ZISH QUIT
-"RTN","C0CRXNRD",110,0)
+"RTN","C0CRXNRD",125,0)
  . U $P W I,! U IO  ; Write I to the screen, then go back to reading the file
-"RTN","C0CRXNRD",111,0)
+"RTN","C0CRXNRD",126,0)
  . N VCUI,RCUI,VSAB,RSAB,SON,SF,SVER,SRL,SCIT ; Fileman fields numbers below
-"RTN","C0CRXNRD",112,0)
+"RTN","C0CRXNRD",127,0)
  . S VCUI=$P(LINE,"|",1)        ; .01
-"RTN","C0CRXNRD",113,0)
+"RTN","C0CRXNRD",128,0)
  . S RCUI=$P(LINE,"|",2)        ; 2
-"RTN","C0CRXNRD",114,0)
+"RTN","C0CRXNRD",129,0)
  . S VSAB=$P(LINE,"|",3)        ; 3
-"RTN","C0CRXNRD",115,0)
+"RTN","C0CRXNRD",130,0)
  . S RSAB=$P(LINE,"|",4)        ; 4
-"RTN","C0CRXNRD",116,0)
+"RTN","C0CRXNRD",131,0)
  . S SON=$P(LINE,"|",5)         ; 5
-"RTN","C0CRXNRD",117,0)
+"RTN","C0CRXNRD",132,0)
  . S SF=$P(LINE,"|",6)          ; 6
-"RTN","C0CRXNRD",118,0)
+"RTN","C0CRXNRD",133,0)
  . S SVER=$P(LINE,"|",7)        ; 7
-"RTN","C0CRXNRD",119,0)
+"RTN","C0CRXNRD",134,0)
  . S SRL=$P(LINE,"|",14)  ; 14
-"RTN","C0CRXNRD",120,0)
+"RTN","C0CRXNRD",135,0)
  . S SCIT=$P(LINE,"|",25)       ; 25
-"RTN","C0CRXNRD",121,0)
+"RTN","C0CRXNRD",136,0)
  . ; Remove embedded "^"
-"RTN","C0CRXNRD",122,0)
+"RTN","C0CRXNRD",137,0)
  . S SCIT=$TR(SCIT,"^")
-"RTN","C0CRXNRD",123,0)
+"RTN","C0CRXNRD",138,0)
  . ; Convert SCIT into an array of 80 characters on each line
-"RTN","C0CRXNRD",124,0)
+"RTN","C0CRXNRD",139,0)
  . ; In each line, chop 80 characters off, reset SCIT to be the rest
-"RTN","C0CRXNRD",125,0)
+"RTN","C0CRXNRD",140,0)
  . N SCITLINE S SCITLINE=$L(SCIT)\80+1
-"RTN","C0CRXNRD",126,0)
+"RTN","C0CRXNRD",141,0)
  . F J=1:1:SCITLINE S SCIT(J)=$E(SCIT,1,80) S SCIT=$E(SCIT,81,$L(SCIT))
-"RTN","C0CRXNRD",127,0)
+"RTN","C0CRXNRD",142,0)
  . ; Now, construct the FDA array
-"RTN","C0CRXNRD",128,0)
+"RTN","C0CRXNRD",143,0)
  . N RXNFDA
-"RTN","C0CRXNRD",129,0)
+"RTN","C0CRXNRD",144,0)
  . S RXNFDA(176.003,"+"_I_",",.01)=VCUI
-"RTN","C0CRXNRD",130,0)
+"RTN","C0CRXNRD",145,0)
  . S RXNFDA(176.003,"+"_I_",",2)=RCUI
-"RTN","C0CRXNRD",131,0)
+"RTN","C0CRXNRD",146,0)
  . S RXNFDA(176.003,"+"_I_",",3)=VSAB
-"RTN","C0CRXNRD",132,0)
+"RTN","C0CRXNRD",147,0)
  . S RXNFDA(176.003,"+"_I_",",4)=RSAB
-"RTN","C0CRXNRD",133,0)
+"RTN","C0CRXNRD",148,0)
  . S RXNFDA(176.003,"+"_I_",",5)=SON
-"RTN","C0CRXNRD",134,0)
+"RTN","C0CRXNRD",149,0)
  . S RXNFDA(176.003,"+"_I_",",6)=SF
-"RTN","C0CRXNRD",135,0)
+"RTN","C0CRXNRD",150,0)
  . S RXNFDA(176.003,"+"_I_",",7)=SVER
-"RTN","C0CRXNRD",136,0)
+"RTN","C0CRXNRD",151,0)
  . S RXNFDA(176.003,"+"_I_",",14)=SRL
-"RTN","C0CRXNRD",137,0)
+"RTN","C0CRXNRD",152,0)
  . D UPDATE^DIE("","RXNFDA")
-"RTN","C0CRXNRD",138,0)
+"RTN","C0CRXNRD",153,0)
  . I $D(^TMP("DIERR",$J)) U $P W "ERR" G EX
-"RTN","C0CRXNRD",139,0)
+"RTN","C0CRXNRD",154,0)
  . ; Now, file WP field SCIT
-"RTN","C0CRXNRD",140,0)
+"RTN","C0CRXNRD",155,0)
  . D WP^DIE(176.003,I_",",25,,$NA(SCIT))
-"RTN","C0CRXNRD",141,0)
+"RTN","C0CRXNRD",156,0)
 EX3 D CLOSE^%ZISH("FILE")
-"RTN","C0CRXNRD",142,0)
+"RTN","C0CRXNRD",157,0)
  Q
-"RTN","C0CRXNRD",143,0)
- 
 "RTN","C0CSNOA")
-0^98^B56032588
+0^98^B40683034
 "RTN","C0CSNOA",1,0)
 C0CSNOA   ; CCDCCR/GPL - SNOMED CT ANALYSIS ROUTINES; 10/14/08
 "RTN","C0CSNOA",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CSNOA",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
 "RTN","C0CSNOA",4,0)
- ;Licensed under the terms of the GNU General Public License.
+ ;
 "RTN","C0CSNOA",5,0)
- ;See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CSNOA",6,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CSNOA",7,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CSNOA",8,0)
- ;it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CSNOA",9,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CSNOA",10,0)
- ;(at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CSNOA",11,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CSNOA",12,0)
- ;This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CSNOA",13,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CSNOA",14,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CSNOA",15,0)
- ;GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CSNOA",16,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CSNOA",17,0)
- ;You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CSNOA",18,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ANALYZE(BEGIEN,IENCNT) ; SNOMED RETRIEVAL ANALYSIS ROUTINE
 "RTN","C0CSNOA",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ; BEGINS AT BEGIEN AND GOES FOR IENCNT DRUGS IN GMRD
 "RTN","C0CSNOA",20,0)
- ;
+ ; TO RESUME AT NEXT DRUG, USE BEGIEN=""
 "RTN","C0CSNOA",21,0)
- ; THESE ROUTINES ANALYZE THE POTENTIAL RETRIEVAL OF SNOMED CT CODES
+ ; USE RESET^C0CSNOA TO RESET TO TOP OF DRUG LIST
 "RTN","C0CSNOA",22,0)
- ; FOR PATIENT DRUG ALLERGIES FOR INCLUSION IN THE CCR OR CCD
+ ;
 "RTN","C0CSNOA",23,0)
- ; USING THE VISTA LEXICON ^LEX
+ N SNOARY,SNOTMP,SNOI,SNOIEN,RATTR
 "RTN","C0CSNOA",24,0)
- ;
+ N CCRGLO
 "RTN","C0CSNOA",25,0)
-ANALYZE(BEGIEN,IENCNT) ; SNOMED RETRIEVAL ANALYSIS ROUTINE
+ D ASETUP ; SET UP VARIABLES AND GLOBALS
 "RTN","C0CSNOA",26,0)
-    ; BEGINS AT BEGIEN AND GOES FOR IENCNT DRUGS IN GMRD
+ D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
 "RTN","C0CSNOA",27,0)
-    ; TO RESUME AT NEXT DRUG, USE BEGIEN=""
+ I '$D(@SNOBASE@("RESUME")) S @SNOBASE@("RESUME")=$O(@GMRBASE@(1)) ;1ST TME
 "RTN","C0CSNOA",28,0)
-    ; USE RESET^C0CSNOA TO RESET TO TOP OF DRUG LIST
+ S RESUME=@SNOBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
 "RTN","C0CSNOA",29,0)
-    ;
+ S SNOIEN=BEGIEN ; BEGIN WITH THE BEGIEN RECORD
 "RTN","C0CSNOA",30,0)
-    N SNOARY,SNOTMP,SNOI,SNOIEN,RATTR
+ I SNOIEN="" S SNOIEN=RESUME
 "RTN","C0CSNOA",31,0)
-    N CCRGLO
+ I +SNOIEN=0 D  Q  ; AT THE END OF THE ALLERGY LIST
 "RTN","C0CSNOA",32,0)
-    D ASETUP ; SET UP VARIABLES AND GLOBALS
+ . W "END OF DRUG LIST, CALL RESET^C0CSNOA",!
 "RTN","C0CSNOA",33,0)
-    D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
+ F SNOI=1:1:IENCNT  D  Q:+SNOIEN=0  ; FOR IENCNT NUMBER OF PATIENTS OR END
 "RTN","C0CSNOA",34,0)
-    I '$D(@SNOBASE@("RESUME")) S @SNOBASE@("RESUME")=$O(@GMRBASE@(1)) ;1ST TME
+ . ;D CCRRPC^C0CCCR(.CCRGLO,SNOIEN,"CCR","","","") ;PROCESS THE CCR
 "RTN","C0CSNOA",35,0)
-    S RESUME=@SNOBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
+ . W SNOIEN,@GMRBASE@(SNOIEN,0),!
 "RTN","C0CSNOA",36,0)
-    S SNOIEN=BEGIEN ; BEGIN WITH THE BEGIEN RECORD
+ . N SNORTN,TTERM ; RETURN ARRAY
 "RTN","C0CSNOA",37,0)
-    I SNOIEN="" S SNOIEN=RESUME
+ . S TTERM=$P(@GMRBASE@(SNOIEN,0),"^",1)_" ALLERGY"
 "RTN","C0CSNOA",38,0)
-    I +SNOIEN=0 D  Q  ; AT THE END OF THE ALLERGY LIST
+ . D TEXTRPC(.SNORTN,TTERM)
 "RTN","C0CSNOA",39,0)
-    . W "END OF DRUG LIST, CALL RESET^C0CSNOA",!
+ . ; I $D(SNORTN) ZWR SNORTN
 "RTN","C0CSNOA",40,0)
-    F SNOI=1:1:IENCNT  D  Q:+SNOIEN=0  ; FOR IENCNT NUMBER OF PATIENTS OR END
+ . K @SNOBASE@("VARS",SNOIEN) ; CLEAR OUT OLD VARS
 "RTN","C0CSNOA",41,0)
-    . ;D CCRRPC^C0CCCR(.CCRGLO,SNOIEN,"CCR","","","") ;PROCESS THE CCR
+ . I $P(TTMP,"^",1)=1 S @SNOBASE@("VARS",SNOIEN)=TTERM_"^"_TTMP_"^"_SNORTN(0)
 "RTN","C0CSNOA",42,0)
-    . W SNOIEN,@GMRBASE@(SNOIEN,0),!
+ . ;
 "RTN","C0CSNOA",43,0)
-    . N SNORTN,TTERM ; RETURN ARRAY
+ . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
 "RTN","C0CSNOA",44,0)
-    . S TTERM=$P(@GMRBASE@(SNOIEN,0),"^",1)_" ALLERGY"
+ . ;
 "RTN","C0CSNOA",45,0)
-    . D TEXTRPC(.SNORTN,TTERM)
+ . S RATTR=$$SETATTR(SNOIEN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
 "RTN","C0CSNOA",46,0)
-    . I $D(SNORTN) ZWR SNORTN
+ . S @SNOBASE@("ATTR",SNOIEN)=RATTR ; SAVE THE ATRIBUTES FOR THIS DRUG
 "RTN","C0CSNOA",47,0)
-    . K @SNOBASE@("VARS",SNOIEN) ; CLEAR OUT OLD VARS
+ . ;
 "RTN","C0CSNOA",48,0)
-    . I $P(TTMP,"^",1)=1 S @SNOBASE@("VARS",SNOIEN)=TTERM_"^"_TTMP_"^"_SNORTN(0)
+ . N CATNAME,CATTBL
 "RTN","C0CSNOA",49,0)
-    . ;
+ . S CATNAME=""
 "RTN","C0CSNOA",50,0)
-    . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
+ . D CPUSH(.CATNAME,SNOBASE,"SNOTBL",SNOIEN,RATTR) ; ADD TO CATEGORY
 "RTN","C0CSNOA",51,0)
-    . ;
+ . ; W "CATEGORY NAME: ",CATNAME,!
 "RTN","C0CSNOA",52,0)
-    . S RATTR=$$SETATTR(SNOIEN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
+ . ;
 "RTN","C0CSNOA",53,0)
-    . S @SNOBASE@("ATTR",SNOIEN)=RATTR ; SAVE THE ATRIBUTES FOR THIS DRUG
+ . S SNOIEN=$O(@GMRBASE@(SNOIEN)) ; NEXT RECORD
 "RTN","C0CSNOA",54,0)
-    . ;
+ . S @SNOBASE@("RESUME")=SNOIEN ; WHERE WE ARE LEAVING OFF THIS RUN
 "RTN","C0CSNOA",55,0)
-    . N CATNAME,CATTBL
+ ; D PARY^C0CXPATH(@SNOBASE@("ATTRTBL"))
 "RTN","C0CSNOA",56,0)
-    . S CATNAME=""
+ Q
 "RTN","C0CSNOA",57,0)
-    . D CPUSH(.CATNAME,SNOBASE,"SNOTBL",SNOIEN,RATTR) ; ADD TO CATEGORY
+ ;
 "RTN","C0CSNOA",58,0)
-    . ; W "CATEGORY NAME: ",CATNAME,!
+TEXTRPC(ORTN,ITEXT) ; CALL THE LEXICON WITH ITEXT AND RETURN RESULTS IN ORTN
 "RTN","C0CSNOA",59,0)
-    . ;
+ ;
 "RTN","C0CSNOA",60,0)
-    . S SNOIEN=$O(@GMRBASE@(SNOIEN)) ; NEXT RECORD
+ ;N TTMP
 "RTN","C0CSNOA",61,0)
-    . S @SNOBASE@("RESUME")=SNOIEN ; WHERE WE ARE LEAVING OFF THIS RUN
+ W ITEXT,!
 "RTN","C0CSNOA",62,0)
-    ; D PARY^C0CXPATH(@SNOBASE@("ATTRTBL"))
+ S TTMP=$$TEXT^LEXTRAN(ITEXT,"","","SCT","ORTN")
 "RTN","C0CSNOA",63,0)
-    Q
+ Q
 "RTN","C0CSNOA",64,0)
-    ;
+ ;
 "RTN","C0CSNOA",65,0)
-TEXTRPC(ORTN,ITEXT) ; CALL THE LEXICON WITH ITEXT AND RETURN RESULTS IN ORTN
+ASETUP ; SET UP GLOBALS AND VARS SNOBASE AND SNOTBL
 "RTN","C0CSNOA",66,0)
- ;
+ I '$D(SNOBASE) S SNOBASE=$NA(^TMP("C0CSNO"))
 "RTN","C0CSNOA",67,0)
- ;N TTMP
+ I '$D(@SNOBASE) S @SNOBASE=""
 "RTN","C0CSNOA",68,0)
- W ITEXT,!
+ I '$D(GMRBASE) S GMRBASE=$NA(^GMRD(120.82))
 "RTN","C0CSNOA",69,0)
- S TTMP=$$TEXT^LEXTRAN(ITEXT,"","","SCT","ORTN")
+ I '$D(SNOTBL) S SNOTBL=$NA(^TMP("C0CSNO","SNOTBL","TABLE")) ; ATTR TABLE
 "RTN","C0CSNOA",70,0)
+ S ^TMP("C0CSNO","TABLES","SNOTBL")=SNOTBL ; TABLE OF TABLES
+"RTN","C0CSNOA",71,0)
  Q
-"RTN","C0CSNOA",71,0)
- ;
 "RTN","C0CSNOA",72,0)
-ASETUP ; SET UP GLOBALS AND VARS SNOBASE AND SNOTBL
+ ;
 "RTN","C0CSNOA",73,0)
-      I '$D(SNOBASE) S SNOBASE=$NA(^TMP("C0CSNO"))
+AINIT ; INITIALIZE ATTRIBUTE TABLE
 "RTN","C0CSNOA",74,0)
-      I '$D(@SNOBASE) S @SNOBASE=""
+ I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
 "RTN","C0CSNOA",75,0)
-      I '$D(GMRBASE) S GMRBASE=$NA(^GMRD(120.82))
+ K @SNOTBL
 "RTN","C0CSNOA",76,0)
-      I '$D(SNOTBL) S SNOTBL=$NA(^TMP("C0CSNO","SNOTBL","TABLE")) ; ATTR TABLE
+ D APUSH^C0CRIMA(SNOTBL,"CODE")
 "RTN","C0CSNOA",77,0)
-      S ^TMP("C0CSNO","TABLES","SNOTBL")=SNOTBL ; TABLE OF TABLES
+ D APUSH^C0CRIMA(SNOTBL,"NOCODE")
 "RTN","C0CSNOA",78,0)
-      Q
+ D APUSH^C0CRIMA(SNOTBL,"MULTICODE")
 "RTN","C0CSNOA",79,0)
-      ;
+ D APUSH^C0CRIMA(SNOTBL,"SUBMULTI")
 "RTN","C0CSNOA",80,0)
-AINIT ; INITIALIZE ATTRIBUTE TABLE
+ D APUSH^C0CRIMA(SNOTBL,"DONE")
 "RTN","C0CSNOA",81,0)
-      I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
+ Q
 "RTN","C0CSNOA",82,0)
-      K @SNOTBL
+APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
 "RTN","C0CSNOA",83,0)
-      D APUSH^C0CRIMA(SNOTBL,"CODE")
+ ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
 "RTN","C0CSNOA",84,0)
-      D APUSH^C0CRIMA(SNOTBL,"NOCODE")
+ ; PTBL IS THE NAME OF A TABLE IN @SNOBASE@("TABLES") - "SNOTBL"=ALL VALUES
 "RTN","C0CSNOA",85,0)
-      D APUSH^C0CRIMA(SNOTBL,"MULTICODE")
+ ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
 "RTN","C0CSNOA",86,0)
-      D APUSH^C0CRIMA(SNOTBL,"SUBMULTI")
+ I '$D(SNOBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
 "RTN","C0CSNOA",87,0)
-      D APUSH^C0CRIMA(SNOTBL,"DONE")
+ N USETBL
 "RTN","C0CSNOA",88,0)
-      Q
+ I '$D(@SNOBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
 "RTN","C0CSNOA",89,0)
-APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
+ . W "ERROR NO SUCH TABLE",!
 "RTN","C0CSNOA",90,0)
-    ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
+ S USETBL=@SNOBASE@("TABLES",PTBL)
 "RTN","C0CSNOA",91,0)
-    ; PTBL IS THE NAME OF A TABLE IN @SNOBASE@("TABLES") - "SNOTBL"=ALL VALUES
+ S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
 "RTN","C0CSNOA",92,0)
-    ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
+ Q
 "RTN","C0CSNOA",93,0)
-    I '$D(SNOBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
+SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
 "RTN","C0CSNOA",94,0)
-    N USETBL
+ N SBASE,SATTR
 "RTN","C0CSNOA",95,0)
-    I '$D(@SNOBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
+ S SBASE=$NA(@SNOBASE@("VARS",SDFN))
 "RTN","C0CSNOA",96,0)
-    . W "ERROR NO SUCH TABLE",!
+ D APOST("SATTR","SNOTBL","DONE")
 "RTN","C0CSNOA",97,0)
-    S USETBL=@SNOBASE@("TABLES",PTBL)
+ I $P(TTMP,"^",1)=1 D APOST("SATTR","SNOTBL","CODE")
 "RTN","C0CSNOA",98,0)
-    S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
+ I $P(TTMP,"^",1)=-1 D APOST("SATTR","SNOTBL","NOCODE")
 "RTN","C0CSNOA",99,0)
-    Q
+ Q SATTR  ; C0C
 "RTN","C0CSNOA",100,0)
-SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
+ I $D(@SBASE@("PROBLEMS",1)) D  ;
 "RTN","C0CSNOA",101,0)
-    N SBASE,SATTR
+ . D APOST("SATTR","SNOTBL","PROBLEMS")
 "RTN","C0CSNOA",102,0)
-    S SBASE=$NA(@SNOBASE@("VARS",SDFN))
+ . ; W "POSTING PROBLEMS",!
 "RTN","C0CSNOA",103,0)
-    D APOST("SATTR","SNOTBL","DONE")
+ I $D(@SBASE@("VITALS",1)) D APOST("SATTR","SNOTBL","VITALS")
 "RTN","C0CSNOA",104,0)
-    I $P(TTMP,"^",1)=1 D APOST("SATTR","SNOTBL","CODE")
+ I $D(@SBASE@("MEDS",1)) D  ; IF THE PATIENT HAS MEDS VARIABLES
 "RTN","C0CSNOA",105,0)
-    I $P(TTMP,"^",1)=-1 D APOST("SATTR","SNOTBL","NOCODE")
+ . D APOST("SATTR","SNOTBL","MEDS")
 "RTN","C0CSNOA",106,0)
-    Q SATTR  ; C0C
+ . N ZR,ZI
 "RTN","C0CSNOA",107,0)
-    I $D(@SBASE@("PROBLEMS",1)) D  ;
+ . D GETPA^C0CRIMA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
 "RTN","C0CSNOA",108,0)
-    . D APOST("SATTR","SNOTBL","PROBLEMS")
+ . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
 "RTN","C0CSNOA",109,0)
-    . ; W "POSTING PROBLEMS",!
+ . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
 "RTN","C0CSNOA",110,0)
-    I $D(@SBASE@("VITALS",1)) D APOST("SATTR","SNOTBL","VITALS")
+ . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","SNOTBL","MEDSCODE") ;CODES
 "RTN","C0CSNOA",111,0)
-    I $D(@SBASE@("MEDS",1)) D  ; IF THE PATIENT HAS MEDS VARIABLES
+ . ; D PATD^C0CSNOA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
 "RTN","C0CSNOA",112,0)
-    . D APOST("SATTR","SNOTBL","MEDS")
+ D APOST("SATTR","SNOTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
 "RTN","C0CSNOA",113,0)
-    . N ZR,ZI
+ ; W "ATTRIBUTES: ",SATTR,!
 "RTN","C0CSNOA",114,0)
-    . D GETPA^C0CRIMA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
+ Q SATTR
 "RTN","C0CSNOA",115,0)
-    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
+ ;
 "RTN","C0CSNOA",116,0)
-    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
+RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL SNO TMP VALUES
 "RTN","C0CSNOA",117,0)
-    . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","SNOTBL","MEDSCODE") ;CODES
+ K ^TMP("C0CSNO","RESUME")
 "RTN","C0CSNOA",118,0)
-    . ; D PATD^C0CSNOA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
+ K ^TMP("C0CSNO")
 "RTN","C0CSNOA",119,0)
-    D APOST("SATTR","SNOTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
+ Q
 "RTN","C0CSNOA",120,0)
-    ; W "ATTRIBUTES: ",SATTR,!
+ ;
 "RTN","C0CSNOA",121,0)
-    Q SATTR
+CLIST ; LIST THE CATEGORIES
 "RTN","C0CSNOA",122,0)
-    ;
+ ;
 "RTN","C0CSNOA",123,0)
-RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL SNO TMP VALUES
+ I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
 "RTN","C0CSNOA",124,0)
-    K ^TMP("C0CSNO","RESUME")
+ N CLBASE,CLNUM,ZI,CLIDX
 "RTN","C0CSNOA",125,0)
-    K ^TMP("C0CSNO")
+ S CLBASE=$NA(@SNOBASE@("SNOTBL","CATS"))
 "RTN","C0CSNOA",126,0)
-    Q
+ S CLNUM=@CLBASE@(0)
 "RTN","C0CSNOA",127,0)
-    ;
+ F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
 "RTN","C0CSNOA",128,0)
-CLIST ; LIST THE CATEGORIES
+ . S CLIDX=@CLBASE@(ZI)
 "RTN","C0CSNOA",129,0)
-    ;
+ . W "(",$P(@CLBASE@(CLIDX),"^",1)
 "RTN","C0CSNOA",130,0)
-    I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
+ . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
 "RTN","C0CSNOA",131,0)
-    N CLBASE,CLNUM,ZI,CLIDX
+ . W CLIDX,!
 "RTN","C0CSNOA",132,0)
-    S CLBASE=$NA(@SNOBASE@("SNOTBL","CATS"))
+ ; D PARY^C0CXPATH(CLBASE)
 "RTN","C0CSNOA",133,0)
-    S CLNUM=@CLBASE@(0)
+ Q
 "RTN","C0CSNOA",134,0)
-    F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
+ ;
 "RTN","C0CSNOA",135,0)
-    . S CLIDX=@CLBASE@(ZI)
+CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
 "RTN","C0CSNOA",136,0)
-    . W "(",$P(@CLBASE@(CLIDX),"^",1)
+ ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
 "RTN","C0CSNOA",137,0)
-    . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
+ ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
 "RTN","C0CSNOA",138,0)
-    . W CLIDX,!
+ ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
 "RTN","C0CSNOA",139,0)
-    ; D PARY^C0CXPATH(CLBASE)
+ ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
 "RTN","C0CSNOA",140,0)
-    Q
+ ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
 "RTN","C0CSNOA",141,0)
-    ;
+ ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
 "RTN","C0CSNOA",142,0)
-CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
+ ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
 "RTN","C0CSNOA",143,0)
-    ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
+ ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
 "RTN","C0CSNOA",144,0)
-    ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
+ ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
 "RTN","C0CSNOA",145,0)
-    ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
+ ; NUMBER IE CTBL_X(CDFN)=""
 "RTN","C0CSNOA",146,0)
-    ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
+ ;
 "RTN","C0CSNOA",147,0)
-    ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
+ ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
 "RTN","C0CSNOA",148,0)
-    ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
+ S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
 "RTN","C0CSNOA",149,0)
-    ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
+ ; W "CBASE: ",CCTBL,!
 "RTN","C0CSNOA",150,0)
-    ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
+ ;
 "RTN","C0CSNOA",151,0)
-    ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
+ I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
 "RTN","C0CSNOA",152,0)
-    ; NUMBER IE CTBL_X(CDFN)=""
+ . D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
 "RTN","C0CSNOA",153,0)
-    ;
+ . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
 "RTN","C0CSNOA",154,0)
-    ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
+ . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
 "RTN","C0CSNOA",155,0)
-    S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
+ . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
 "RTN","C0CSNOA",156,0)
-    ; W "CBASE: ",CCTBL,!
+ . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
 "RTN","C0CSNOA",157,0)
-    ;
+ . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
 "RTN","C0CSNOA",158,0)
-    I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
+ ;
 "RTN","C0CSNOA",159,0)
-    . D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
+ S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
 "RTN","C0CSNOA",160,0)
-    . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
+ S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
 "RTN","C0CSNOA",161,0)
-    . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
+ S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
 "RTN","C0CSNOA",162,0)
-    . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
+ ;
 "RTN","C0CSNOA",163,0)
-    . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
+ S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
 "RTN","C0CSNOA",164,0)
-    . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
+ ;
 "RTN","C0CSNOA",165,0)
-    ;
+ S CPATLIST=$NA(@CBASE@(CTBL,"IENS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
 "RTN","C0CSNOA",166,0)
-    S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
+ ; W "IENS BASE: ",CPATLIST,!
 "RTN","C0CSNOA",167,0)
-    S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
+ S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
 "RTN","C0CSNOA",168,0)
-    S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
+ ;
 "RTN","C0CSNOA",169,0)
-    ;
+ Q
 "RTN","C0CSNOA",170,0)
-    S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
+ ;
 "RTN","C0CSNOA",171,0)
-    ;
+REUSE ; GET SAVED VALUES FROM ^TMP("C0CSAV") AND PUT THEM IN A DATABASE
 "RTN","C0CSNOA",172,0)
-    S CPATLIST=$NA(@CBASE@(CTBL,"IENS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
+ ;
 "RTN","C0CSNOA",173,0)
-    ; W "IENS BASE: ",CPATLIST,!
+ D ASETUP
 "RTN","C0CSNOA",174,0)
-    S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
+ D AINIT
 "RTN","C0CSNOA",175,0)
-    ;
+ N SNOI,SNOJ,SNOK,SNOSNO,SNOSEC,SNOIEN,SNOOLD,SNOSRCH
 "RTN","C0CSNOA",176,0)
-    Q
+ S SAVBASE=$NA(^TMP("C0CSAV","VARS"))
 "RTN","C0CSNOA",177,0)
-    ;
+ S SNOI=""
 "RTN","C0CSNOA",178,0)
-REUSE ; GET SAVED VALUES FROM ^TMP("C0CSAV") AND PUT THEM IN A DATABASE
+ F  D  Q:$O(@SAVBASE@(SNOI))=""  ;THE WHOLE LIST
 "RTN","C0CSNOA",179,0)
- ;
+ . S SNOI=$O(@SAVBASE@(SNOI))
 "RTN","C0CSNOA",180,0)
- D ASETUP
+ . S SNOJ=@SAVBASE@(SNOI)
 "RTN","C0CSNOA",181,0)
- D AINIT
+ . S SNOK=$P($P(SNOJ,"^",1)," ALLERGY",1)
 "RTN","C0CSNOA",182,0)
- N SNOI,SNOJ,SNOK,SNOSNO,SNOSEC,SNOIEN,SNOOLD,SNOSRCH
+ . S SNOSRCH=$P(SNOJ,"^",1) ;SEARCH TERM USED TO OBTAIN SNOMED CODE
 "RTN","C0CSNOA",183,0)
- S SAVBASE=$NA(^TMP("C0CSAV","VARS"))
+ . S SNOIEN=$P(SNOJ,"^",3) ; IEN OF ELEMENT IN LEXICON
 "RTN","C0CSNOA",184,0)
- S SNOI=""
+ . S SNOSNO=$P(SNOJ,"^",4) ; SNOMED CODE
 "RTN","C0CSNOA",185,0)
- F  D  Q:$O(@SAVBASE@(SNOI))="" ;THE WHOLE LIST
+ . S SNOSEC=$P(SNOJ,"^",5) ; SECTION OF SNOMED FOR THIS CODE
 "RTN","C0CSNOA",186,0)
- . S SNOI=$O(@SAVBASE@(SNOI))
+ . S SNOOLD=$P(SNOJ,"^",7) ; OLD NUMBER FOR THIS CODE
 "RTN","C0CSNOA",187,0)
- . S SNOJ=@SAVBASE@(SNOI)
+ . W "SEARCH:",SNOSRCH," IEN:",SNOIEN," CODE:",SNOSNO," SEC:",SNOSEC," OLD:",SNOOLD,!
 "RTN","C0CSNOA",188,0)
- . S SNOK=$P($P(SNOJ,"^",1)," ALLERGY",1)
+ . W SNOK,!
 "RTN","C0CSNOA",189,0)
- . S SNOSRCH=$P(SNOJ,"^",1) ;SEARCH TERM USED TO OBTAIN SNOMED CODE
+ . W SNOJ,!
 "RTN","C0CSNOA",190,0)
- . S SNOIEN=$P(SNOJ,"^",3) ; IEN OF ELEMENT IN LEXICON
+ Q
 "RTN","C0CSNOA",191,0)
- . S SNOSNO=$P(SNOJ,"^",4) ; SNOMED CODE
-"RTN","C0CSNOA",192,0)
- . S SNOSEC=$P(SNOJ,"^",5) ; SECTION OF SNOMED FOR THIS CODE
-"RTN","C0CSNOA",193,0)
- . S SNOOLD=$P(SNOJ,"^",7) ; OLD NUMBER FOR THIS CODE
-"RTN","C0CSNOA",194,0)
- . W "SEARCH:",SNOSRCH," IEN:",SNOIEN," CODE:",SNOSNO," SEC:",SNOSEC," OLD:",SNOOLD,!
-"RTN","C0CSNOA",195,0)
- . W SNOK,!
-"RTN","C0CSNOA",196,0)
- . W SNOJ,!
-"RTN","C0CSNOA",197,0)
- Q
-"RTN","C0CSNOA",198,0)
  ;
 "RTN","C0CSOAP")
-0^69^B79899662
+0^69^B79012960
 "RTN","C0CSOAP",1,0)
 C0CSOAP  ; CCDCCR/GPL - SOAP WEB SERVICE utilities; 8/25/09
 "RTN","C0CSOAP",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CSOAP",3,0)
- ;Copyright 2008 George Lilly.  Licensed under the terms of the GNU
+ ;Copyright 2008 George Lilly.  
 "RTN","C0CSOAP",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CSOAP",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CSOAP",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CSOAP",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CSOAP",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CSOAP",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CSOAP",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CSOAP",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CSOAP",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CSOAP",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CSOAP",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CSOAP",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CSOAP",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CSOAP",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CSOAP",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ W "This is an SOAP utility library",!
 "RTN","C0CSOAP",19,0)
- ;
+ W !
 "RTN","C0CSOAP",20,0)
- W "This is an SOAP utility library",!
+ Q
 "RTN","C0CSOAP",21,0)
+ ;
+"RTN","C0CSOAP",22,0)
+TEST1 
+"RTN","C0CSOAP",23,0)
+ S url="https://ec2-75-101-247-83.compute-1.amazonaws.com:8181/ccr/CCRService?wsdl"
+"RTN","C0CSOAP",24,0)
+ D GET1URL^C0CEWD2(url)
+"RTN","C0CSOAP",25,0)
+ Q
+"RTN","C0CSOAP",26,0)
+ ;
+"RTN","C0CSOAP",27,0)
+INITFARY(ARY) ;initialize the Fileman Field array for SOAP processing
+"RTN","C0CSOAP",28,0)
+ ; ARY is passed by name
+"RTN","C0CSOAP",29,0)
+ S @ARY@("XML FILE NUMBER")="178.301"
+"RTN","C0CSOAP",30,0)
+ S @ARY@("BINDING SUBFILE NUMBER")="178.3014"
+"RTN","C0CSOAP",31,0)
+ S @ARY@("MIME TYPE")="2.3"
+"RTN","C0CSOAP",32,0)
+ S @ARY@("PROXY SERVER")="2.4"
+"RTN","C0CSOAP",33,0)
+ S @ARY@("REPLY TEMPLATE")=".03"
+"RTN","C0CSOAP",34,0)
+ S @ARY@("TEMPLATE NAME")=".01"
+"RTN","C0CSOAP",35,0)
+ S @ARY@("TEMPLATE XML")="3"
+"RTN","C0CSOAP",36,0)
+ S @ARY@("URL")="1"
+"RTN","C0CSOAP",37,0)
+ S @ARY@("WSDL URL")="2"
+"RTN","C0CSOAP",38,0)
+ S @ARY@("XML")="2.1"
+"RTN","C0CSOAP",39,0)
+ S @ARY@("XML HEADER")="2.2"
+"RTN","C0CSOAP",40,0)
+ S @ARY@("XPATH REDUCTION STRING")="2.5"
+"RTN","C0CSOAP",41,0)
+ S @ARY@("CCR VARIABLE")="4"
+"RTN","C0CSOAP",42,0)
+ S @ARY@("FILEMAN FIELD NAME")="1"
+"RTN","C0CSOAP",43,0)
+ S @ARY@("FILEMAN FIELD NUMBER")="1.2"
+"RTN","C0CSOAP",44,0)
+ S @ARY@("FILEMAN FILE POINTER")="1.1"
+"RTN","C0CSOAP",45,0)
+ S @ARY@("INDEXED BY")=".05"
+"RTN","C0CSOAP",46,0)
+ S @ARY@("SQLI FIELD NAME")="3"
+"RTN","C0CSOAP",47,0)
+ S @ARY@("VARIABLE NAME")="2"
+"RTN","C0CSOAP",48,0)
+ Q
+"RTN","C0CSOAP",49,0)
+ ;
+"RTN","C0CSOAP",50,0)
+RESTID(INNAM,INFARY) ;EXTRINSIC TO RESOLVE TEMPLATE PASSED BY NAME
+"RTN","C0CSOAP",51,0)
+ ; FILE IS IDENTIFIED IN FARY, PASSED BY NAME
+"RTN","C0CSOAP",52,0)
+ I '$D(INFARY) D  ; NO FILE ARRAY PASSED
+"RTN","C0CSOAP",53,0)
+ . S INFARY="FARY"
+"RTN","C0CSOAP",54,0)
+ . D INITFARY(INFARY)
+"RTN","C0CSOAP",55,0)
+ N ZN,ZREF,ZR
+"RTN","C0CSOAP",56,0)
+ S ZN=@INFARY@("XML FILE NUMBER")
+"RTN","C0CSOAP",57,0)
+ S ZREF=$$FILEREF^C0CRNF(ZN)
+"RTN","C0CSOAP",58,0)
+ S ZR=$O(@ZREF@("B",INNAM,""))
+"RTN","C0CSOAP",59,0)
+ Q ZR
+"RTN","C0CSOAP",60,0)
+ ;
+"RTN","C0CSOAP",61,0)
+TESTSOAP ;
+"RTN","C0CSOAP",62,0)
+ ; USING ICD9 WEB SERVICE TO TEST SOAP
+"RTN","C0CSOAP",63,0)
+ S G("CODE")="E*"
+"RTN","C0CSOAP",64,0)
+ S G("CODELN")=3
+"RTN","C0CSOAP",65,0)
+ D SOAP("GPL","ICD9","G")
+"RTN","C0CSOAP",66,0)
+ Q
+"RTN","C0CSOAP",67,0)
+ ;
+"RTN","C0CSOAP",68,0)
+SOAP(C0CRTN,C0CTID,C0CVA,C0CVOR,ALTXML,IFARY) ; MAKES A SOAP CALL FOR 
+"RTN","C0CSOAP",69,0)
+ ; TEMPLATE ID C0CTID
+"RTN","C0CSOAP",70,0)
+ ; RETURNS THE XML RESULT IN C0CRTN, PASSED BY NAME
+"RTN","C0CSOAP",71,0)
+ ; C0CVA IS PASSED BY NAME AND IS THE VARIABLE ARRAY TO PASS TO BIND
+"RTN","C0CSOAP",72,0)
+ ; C0CVOR IS THE NAME OF A VARIABLE OVERRIDE ARRAY, WHICH IS APPLIED 
+"RTN","C0CSOAP",73,0)
+ ; BEFORE MAPPING
+"RTN","C0CSOAP",74,0)
+ ; IF ALTXML IS PASSED, BIND AND MAP WILL BE SKIPPED AND 
+"RTN","C0CSOAP",75,0)
+ ; ALTXML WILL BE USED INSTEAD
+"RTN","C0CSOAP",76,0)
+ ;
+"RTN","C0CSOAP",77,0)
+ ; ARTIFACTS SECTION
+"RTN","C0CSOAP",78,0)
+ ; THE FOLLOWING WILL SET UP DEBUGGING ARTIFACTS FOR A POSSIBLE FUTURE
+"RTN","C0CSOAP",79,0)
+ ; ONLINE DEBUGGER. IF DEBUG=1, VARIABLES CONTAINING INTERMEDIATE RESULTS
+"RTN","C0CSOAP",80,0)
+ ; WILL NOT BE NEWED.
+"RTN","C0CSOAP",81,0)
+ I $G(WSDEBUG)="" N C0CV ; CATALOG OF ARTIFACT VARIABLES AND ARRAYS
+"RTN","C0CSOAP",82,0)
+ S C0CV(100,"C0CXF","XML TEMPLATE FILE NUMBER")=""
+"RTN","C0CSOAP",83,0)
+ S C0CV(200,"C0CHEAD","SOAP HEADER VARIABLE NAME")=""
+"RTN","C0CSOAP",84,0)
+ S C0CV(300,"HEADER","SOAP HEADER")=""
+"RTN","C0CSOAP",85,0)
+ S C0CV(400,"C0CMIME","MIME TYPE")=""
+"RTN","C0CSOAP",86,0)
+ S C0CV(500,"C0CURL","WS URL")=""
+"RTN","C0CSOAP",87,0)
+ S C0CV(550,"C0CPURL","PROXY URL")=""
+"RTN","C0CSOAP",88,0)
+ S C0CV(600,"C0CXML","XML VARIABLE NAME")=""
+"RTN","C0CSOAP",89,0)
+ S C0CV(700,"XML","OUTBOUND XML")=""
+"RTN","C0CSOAP",90,0)
+ S C0CV(800,"C0CRSLT","RAW XML RESULT RETURNED FROM WEB SERVICE")=""
+"RTN","C0CSOAP",91,0)
+ S C0CV(900,"C0CRHDR","RETURNED HEADER")=""
+"RTN","C0CSOAP",92,0)
+ S C0CV(1000,"C0CRXML","XML RESULT NORMALIZED")=""
+"RTN","C0CSOAP",93,0)
+ S C0CV(1100,"C0CR","REPLY TEMPLATE")=""
+"RTN","C0CSOAP",94,0)
+ S C0CV(1200,"C0CREDUX","REDUX STRING")=""
+"RTN","C0CSOAP",95,0)
+ S C0CV(1300,"C0CIDX","RESULT XPATH INDEX")=""
+"RTN","C0CSOAP",96,0)
+ S C0CV(1400,"C0CARY","RESULT XPATH ARRAY")=""
+"RTN","C0CSOAP",97,0)
+ S C0CV(1500,"C0CNOM","RESULT DOM DOCUMENT NAME")=""
+"RTN","C0CSOAP",98,0)
+ S C0CV(1600,"C0CID","RESULT DOM ID")=""
+"RTN","C0CSOAP",99,0)
+ I $G(DEBUG)'="" G NOTNEW ; SKIP NEWING THE VARIABLES IF IN DEBUG
+"RTN","C0CSOAP",100,0)
+ N ZI,ZJ S ZI=""
+"RTN","C0CSOAP",101,0)
+NEW 
+"RTN","C0CSOAP",102,0)
+ S ZI=$O(C0CV(ZI))
+"RTN","C0CSOAP",103,0)
+ S ZJ=$O(C0CV(ZI,"")) ; SET UP NEW COMMAND
+"RTN","C0CSOAP",104,0)
+ ;W ZJ,!
+"RTN","C0CSOAP",105,0)
+ N @ZJ ; NEW THE VARIABLE
+"RTN","C0CSOAP",106,0)
+ I $O(C0CV(ZI))'="" G NEW ;LOOP TO GET NEW IN CONTEXT
+"RTN","C0CSOAP",107,0)
+NOTNEW 
+"RTN","C0CSOAP",108,0)
+ ; END ARTIFACTS
+"RTN","C0CSOAP",109,0)
+ ;
+"RTN","C0CSOAP",110,0)
+ I '$D(IFARY) D INITFARY("C0CF") ; SET FILE NUMBER AND PARAMATERS 
+"RTN","C0CSOAP",111,0)
+ E  D  ; 
+"RTN","C0CSOAP",112,0)
+ . K C0CF
+"RTN","C0CSOAP",113,0)
+ . M C0CF=@IFARY
+"RTN","C0CSOAP",114,0)
+ S C0CXF=C0CF("XML FILE NUMBER") ; FILE NUMBER FOR THE XML TEMPLATE FILE
+"RTN","C0CSOAP",115,0)
+ I +C0CTID=0 D  ; A STRING WAS PASSED FOR THE TEMPLATE NAME
+"RTN","C0CSOAP",116,0)
+ . S C0CUTID=$$RESTID(C0CTID,"C0CF") ;RESOLVE TEMPLATE IEN FROM NAME
+"RTN","C0CSOAP",117,0)
+ E  S C0CUTID=C0CTID ; AN IEN WAS PASSED
+"RTN","C0CSOAP",118,0)
+ N XML,TEMPLATE,HEADER
+"RTN","C0CSOAP",119,0)
+ N C0CFH S C0CFH=C0CF("XML HEADER")
+"RTN","C0CSOAP",120,0)
+ S C0CHEAD=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFH,,"HEADER")
+"RTN","C0CSOAP",121,0)
+ N C0CFM S C0CFM=C0CF("MIME TYPE")
+"RTN","C0CSOAP",122,0)
+ S C0CMIME=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFM)
+"RTN","C0CSOAP",123,0)
+ N C0CFP S C0CFP=C0CF("PROXY SERVER")
+"RTN","C0CSOAP",124,0)
+ S C0CPURL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFP)
+"RTN","C0CSOAP",125,0)
+ N C0CFU S C0CFU=C0CF("URL")
+"RTN","C0CSOAP",126,0)
+ S C0CURL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFU)
+"RTN","C0CSOAP",127,0)
+ N C0CFX S C0CFX=C0CF("XML")
+"RTN","C0CSOAP",128,0)
+ S C0CXML=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFX,,"XML")
+"RTN","C0CSOAP",129,0)
+ N C0CFT S C0CFT=C0CF("TEMPLATE XML")
+"RTN","C0CSOAP",130,0)
+ S C0CTMPL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFT,,"TEMPLATE")
+"RTN","C0CSOAP",131,0)
+ I C0CTMPL="TEMPLATE" D  ; there is a template to process
+"RTN","C0CSOAP",132,0)
+ . K XML ; going to replace the xml array
+"RTN","C0CSOAP",133,0)
+ . N VARS
+"RTN","C0CSOAP",134,0)
+ . I $D(C0CVOR) M @C0CVA=@C0CVOR ; merge in varible overrides
+"RTN","C0CSOAP",135,0)
+ . I '$D(ALTXML) D  ; if ALTXML is passed in, don't bind
+"RTN","C0CSOAP",136,0)
+ . . D BIND("VARS",C0CVA,C0CUTID,"C0CF")
+"RTN","C0CSOAP",137,0)
+ . . D MAP("XML","VARS",TPTR,"C0CF")
+"RTN","C0CSOAP",138,0)
+ . . K XML(0)
+"RTN","C0CSOAP",139,0)
+ . E  M XML=@ALTXML ; use ALTXML instead
+"RTN","C0CSOAP",140,0)
+ I $G(C0CPROXY) S C0CURL=C0CPURL
+"RTN","C0CSOAP",141,0)
+ K C0CRSLT,C0CRHDR
+"RTN","C0CSOAP",142,0)
+ B
+"RTN","C0CSOAP",143,0)
+ S ok=$$httpPOST^%zewdGTM(C0CURL,.XML,C0CMIME,.C0CRSLT,.HEADER,"",.gpl5,.C0CRHDR)
+"RTN","C0CSOAP",144,0)
+ K C0CRXML
+"RTN","C0CSOAP",145,0)
+ D NORMAL("C0CRXML","C0CRSLT(1)") ;RETURN XML IN AN ARRAY
+"RTN","C0CSOAP",146,0)
+ N C0CFR S C0CFR=$G(C0CF("REPLY TEMPLATE"))
+"RTN","C0CSOAP",147,0)
+ S C0CR=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFR,"I") ; REPLY TEMPLATE
+"RTN","C0CSOAP",148,0)
+ ; reply templates are optional and are specified by populating a
+"RTN","C0CSOAP",149,0)
+ ; template pointer in field 2.5 of the request template
+"RTN","C0CSOAP",150,0)
+ ; if specified, the reply template is the source of the REDUX string
+"RTN","C0CSOAP",151,0)
+ ; used for XPath on the reply, and for UNBIND processing
+"RTN","C0CSOAP",152,0)
+ ; if no reply template is specified, REDUX is obtained from the request
+"RTN","C0CSOAP",153,0)
+ ; template and no UNBIND processing is performed. The XPath array is
+"RTN","C0CSOAP",154,0)
+ ; returned without variable bindings
+"RTN","C0CSOAP",155,0)
+ I C0CR'="" D  ; REPLY TEMPLATE EXISTS
+"RTN","C0CSOAP",156,0)
+ . I +$G(DEBUG)'=0 W "REPLY TEMPLATE:",C0CR,!
+"RTN","C0CSOAP",157,0)
+ . S C0CTID=C0CR ;
+"RTN","C0CSOAP",158,0)
+ N C0CFRDX S C0CFRDX=C0CF("XPATH REDUCTION STRING")
+"RTN","C0CSOAP",159,0)
+ S C0CREDUX=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFRDX) ;XPATH REDUCTION STRING
+"RTN","C0CSOAP",160,0)
+ K C0CIDX,C0CARY ; XPATH INDEX AND ARRAY VARS
+"RTN","C0CSOAP",161,0)
+ S C0CNOM="C0CWS"_$J ; DOCUMENT NAME FOR THE DOM
+"RTN","C0CSOAP",162,0)
+ S C0CID=$$PARSE^C0CXEWD("C0CRXML",C0CNOM) ;CALL THE PARSER
+"RTN","C0CSOAP",163,0)
+ S C0CID=$$FIRST^C0CXEWD($$ID^C0CXEWD(C0CNOM)) ;ID OF FIRST NODE
+"RTN","C0CSOAP",164,0)
+ D XPATH^C0CXEWD(C0CID,"/","C0CIDX","C0CARY","",C0CREDUX) ;XPATH GENERATOR
+"RTN","C0CSOAP",165,0)
+ ; Next, call UNBIND to map the reply XPath array to variables
+"RTN","C0CSOAP",166,0)
+ ; This is only done if a Reply Template is provided
+"RTN","C0CSOAP",167,0)
+ D DEMUXARY(C0CRTN,"C0CARY")
+"RTN","C0CSOAP",168,0)
+ ; M @C0CRTN=C0CARY
+"RTN","C0CSOAP",169,0)
+ Q
+"RTN","C0CSOAP",170,0)
+ ;
+"RTN","C0CSOAP",171,0)
+DEMUXARY(OARY,IARY) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO
+"RTN","C0CSOAP",172,0)
+ ; FORMAT @OARY@(x,xpath) where x is the first multiple
+"RTN","C0CSOAP",173,0)
+ N ZI,ZJ,ZK,ZL S ZI=""
+"RTN","C0CSOAP",174,0)
+ F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ;
+"RTN","C0CSOAP",175,0)
+ . D DEMUX^C0CMXP("ZJ",ZI)
+"RTN","C0CSOAP",176,0)
+ . S ZK=$P(ZJ,"^",3)
+"RTN","C0CSOAP",177,0)
+ . S ZK=$RE($P($RE(ZK),"/",1))
+"RTN","C0CSOAP",178,0)
+ . S ZL=$P(ZJ,"^",1)
+"RTN","C0CSOAP",179,0)
+ . I ZL="" S ZL=1
+"RTN","C0CSOAP",180,0)
+ . S @OARY@(ZL,ZK)=@IARY@(ZI)
+"RTN","C0CSOAP",181,0)
+ Q
+"RTN","C0CSOAP",182,0)
+ ;
+"RTN","C0CSOAP",183,0)
+NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
+"RTN","C0CSOAP",184,0)
+ ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
+"RTN","C0CSOAP",185,0)
+ ;
+"RTN","C0CSOAP",186,0)
+ N ZI,ZN,ZTMP
+"RTN","C0CSOAP",187,0)
+ S ZN=1
+"RTN","C0CSOAP",188,0)
+ S @OUTXML@(ZN)=$P(@INXML,"><",ZN)_">"
+"RTN","C0CSOAP",189,0)
+ S ZN=ZN+1
+"RTN","C0CSOAP",190,0)
+ F  S @OUTXML@(ZN)="<"_$P(@INXML,"><",ZN) Q:$P(@INXML,"><",ZN+1)=""  D  ;
+"RTN","C0CSOAP",191,0)
+ . S @OUTXML@(ZN)=@OUTXML@(ZN)_">"
+"RTN","C0CSOAP",192,0)
+ . S ZN=ZN+1
+"RTN","C0CSOAP",193,0)
+ Q
+"RTN","C0CSOAP",194,0)
+ ;
+"RTN","C0CSOAP",195,0)
+MAP(RARY,IVARS,TPTR,INFARY) ;RETURNS MAPPED XML IN RARY PASSED BY NAME
+"RTN","C0CSOAP",196,0)
+ ; IVARS IS AN XPATH ARRAY PASSED BY NAME
+"RTN","C0CSOAP",197,0)
+ ; TPTR IS A POINT TO THE C0C XML TEMPLATE FILE USED TO RETRIEVE THE TEMPLATE
+"RTN","C0CSOAP",198,0)
+ ;
+"RTN","C0CSOAP",199,0)
+ N ZT ;THE TEMPLATE
+"RTN","C0CSOAP",200,0)
+ K ZT,@RARY
+"RTN","C0CSOAP",201,0)
+ I '$D(INFARY) D  ;
+"RTN","C0CSOAP",202,0)
+ . S INFARY="FARY"
+"RTN","C0CSOAP",203,0)
+ . D INITFARY(INFARY)
+"RTN","C0CSOAP",204,0)
+ N ZF,ZFT
+"RTN","C0CSOAP",205,0)
+ S ZF=@INFARY@("XML FILE NUMBER")
+"RTN","C0CSOAP",206,0)
+ S ZFT=@INFARY@("TEMPLATE XML")
+"RTN","C0CSOAP",207,0)
+ I $$GET1^DIQ(ZF,TPTR_",",ZFT,,"ZT")'="ZT" D  Q  ; ERROR GETTING TEMPLATE
+"RTN","C0CSOAP",208,0)
+ . W "ERROR RETRIEVING TEMPLATE",!
+"RTN","C0CSOAP",209,0)
+ D MAP^C0CXPATH("ZT",IVARS,RARY) ;DO THE MAPPING
+"RTN","C0CSOAP",210,0)
+ Q
+"RTN","C0CSOAP",211,0)
+ ;
+"RTN","C0CSOAP",212,0)
+TESTBIND ;
+"RTN","C0CSOAP",213,0)
+ S G1("TESTONE")=1
+"RTN","C0CSOAP",214,0)
+ S G1("TESTTWO")=2
+"RTN","C0CSOAP",215,0)
+ D BIND("G","G1","TEST")
+"RTN","C0CSOAP",216,0)
  W !
-"RTN","C0CSOAP",22,0)
+"RTN","C0CSOAP",217,0)
+ ZWR G
+"RTN","C0CSOAP",218,0)
  Q
-"RTN","C0CSOAP",23,0)
- ;
-"RTN","C0CSOAP",24,0)
-TEST1 
-"RTN","C0CSOAP",25,0)
- S url="https://ec2-75-101-247-83.compute-1.amazonaws.com:8181/ccr/CCRService?wsdl"
-"RTN","C0CSOAP",26,0)
- D GET1URL^C0CEWD2(url)
-"RTN","C0CSOAP",27,0)
+"RTN","C0CSOAP",219,0)
+ ;
+"RTN","C0CSOAP",220,0)
+BIND(RARY,IVARS,INTPTR,INFARY) ;RETURNS AN XPATH ARRAY IN RARY FOR USE WITH MAP
+"RTN","C0CSOAP",221,0)
+ ; TO BUILD AN INSTANTIATED TEMPLATE
+"RTN","C0CSOAP",222,0)
+ ; TPTR IS THE IEN OF THE XML TEMPATE IN THE C0C XML TEMPLATE FILE
+"RTN","C0CSOAP",223,0)
+ ; LOOPS THROUGHT THE BINDING SUBFILE TO PULL OUT XPATHS AND 
+"RTN","C0CSOAP",224,0)
+ ; EITHER ASSIGNS VARIABLES OR DOES A FILEMAN CALL TO GET VALUES
+"RTN","C0CSOAP",225,0)
+ ; VARIABLES ARE IN IVARS WHICH IS PASSED BY NAME
+"RTN","C0CSOAP",226,0)
+ I '$D(INFARY) D  ;
+"RTN","C0CSOAP",227,0)
+ . S INFARY="FARY"
+"RTN","C0CSOAP",228,0)
+ . D INITFARY(INFARY) ;INITIALIZE FILE ARRAY IF NOT PASSED
+"RTN","C0CSOAP",229,0)
+ I +INTPTR>0 S TPTR=INTPTR
+"RTN","C0CSOAP",230,0)
+ E  S TPTR=$$RESTID(INTPTR,INFARY)
+"RTN","C0CSOAP",231,0)
+ N C0CFF,C0CBF,C0CXI,C0CFREF,C0CXREF
+"RTN","C0CSOAP",232,0)
+ S C0CFF=@INFARY@("XML FILE NUMBER") ;fileman file number of XML file
+"RTN","C0CSOAP",233,0)
+ S C0CFREF=$$FILEREF^C0CRNF(C0CFF) ; closed file reference to the file
+"RTN","C0CSOAP",234,0)
+ S C0CBF=@INFARY@("BINDING SUBFILE NUMBER") ; BINDING SUBFILE NUMBER
+"RTN","C0CSOAP",235,0)
+ S C0CXI=$G(@INFARY@("XPATH INDEX")) ; index to the XPath bindings
+"RTN","C0CSOAP",236,0)
+ I C0CXI="" S C0CXI="XPATH" ; default is the XPATH index
+"RTN","C0CSOAP",237,0)
+ ; this needs to be a whole file index on the XPath subfile with
+"RTN","C0CSOAP",238,0)
+ ; the Template IEN perceding the XPath in the index
+"RTN","C0CSOAP",239,0)
+ N ZI
+"RTN","C0CSOAP",240,0)
+ S ZI=""
+"RTN","C0CSOAP",241,0)
+ S C0CXREF=$NA(@C0CFREF@(C0CXI,TPTR)) ; where the xref is
+"RTN","C0CSOAP",242,0)
+ ;F  S ZI=$O(^C0CX(TPTR,5,"B",ZI)) Q:ZI=""  D  ; FOR EACH XPATH
+"RTN","C0CSOAP",243,0)
+ F  S ZI=$O(@C0CXREF@(ZI)) Q:ZI=""  D  ; for each XPath in this template
+"RTN","C0CSOAP",244,0)
+ . ;W !,ZI," ",$O(@C0CXREF@(ZI,TPTR,""))
+"RTN","C0CSOAP",245,0)
+ . N ZIEN,ZFILE,ZFIELD,ZVAR,ZIDX,ZINDEX ;
+"RTN","C0CSOAP",246,0)
+ . S ZIEN=$O(@C0CXREF@(ZI,TPTR,"")) ; IEN OF THE BINDING RECORD
+"RTN","C0CSOAP",247,0)
+ . N ZFF S ZFF=@INFARY@("FILEMAN FILE POINTER")
+"RTN","C0CSOAP",248,0)
+ . S ZFILE=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFF,"I")
+"RTN","C0CSOAP",249,0)
+ . N ZFFLD S ZFFLD=@INFARY@("FILEMAN FIELD NUMBER")
+"RTN","C0CSOAP",250,0)
+ . S ZFIELD=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFFLD,"I")
+"RTN","C0CSOAP",251,0)
+ . N ZFV S ZFV=@INFARY@("VARIABLE NAME")
+"RTN","C0CSOAP",252,0)
+ . S ZVAR=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFV,"E")
+"RTN","C0CSOAP",253,0)
+ . N ZFX S ZFX=("INDEXED BY")
+"RTN","C0CSOAP",254,0)
+ . S ZIDX=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFX,"I")
+"RTN","C0CSOAP",255,0)
+ . S ZINDEX=""
+"RTN","C0CSOAP",256,0)
+ . I ZIDX="DUZ" S ZINDEX=$G(DUZ) ; FILE IS INDEXED BY DUZ
+"RTN","C0CSOAP",257,0)
+ . I ZIDX="DFN" S ZINDEX=$G(DFN) ; BY DFN
+"RTN","C0CSOAP",258,0)
+ . E  I ZIDX'="" S ZINDEX=$G(@ZIDX) ; index variable
+"RTN","C0CSOAP",259,0)
+ . ;I ZIDX="ACCT" S ZINDEX=C0CACCT ; BY ACCOUNT RECORD POINT TO C0C WS ACCT
+"RTN","C0CSOAP",260,0)
+ . ;I ZIDX="LOC" S ZINDEX=C0CLOC ; BY LOCATION
+"RTN","C0CSOAP",261,0)
+ . I ZVAR'="" D  ; VARIABLES TAKE PRESCIDENCE OVER FILEMAN FIELDS
+"RTN","C0CSOAP",262,0)
+ . . S @RARY@(ZI)=@IVARS@(ZVAR) ; 
+"RTN","C0CSOAP",263,0)
+ . E  D  ; IF NO VARIABLE, TRY ACCESSING FROM FILEMAN
+"RTN","C0CSOAP",264,0)
+ . . I (ZFILE="")!(ZFIELD="") Q  ;QUIT IF FILE OR FIELD NOT THERE
+"RTN","C0CSOAP",265,0)
+ . . D CLEAN^DILF
+"RTN","C0CSOAP",266,0)
+ . . S @RARY@(ZI)=$$GET1^DIQ(ZFILE,ZINDEX_",",ZFIELD) ;GET THE VALUE
+"RTN","C0CSOAP",267,0)
+ . . I $D(^TMP("DIERR",$J,1)) D  B ;
+"RTN","C0CSOAP",268,0)
+ . . . W "ERROR!",!
+"RTN","C0CSOAP",269,0)
+ . . . ZWR ^TMP("DIERR",$J,*)
+"RTN","C0CSOAP",270,0)
  Q
-"RTN","C0CSOAP",28,0)
- ;
-"RTN","C0CSOAP",29,0)
-INITFARY(ARY) ;initialize the Fileman Field array for SOAP processing
-"RTN","C0CSOAP",30,0)
- ; ARY is passed by name
-"RTN","C0CSOAP",31,0)
- S @ARY@("XML FILE NUMBER")="178.301"
-"RTN","C0CSOAP",32,0)
- S @ARY@("BINDING SUBFILE NUMBER")="178.3014"
-"RTN","C0CSOAP",33,0)
- S @ARY@("MIME TYPE")="2.3"
-"RTN","C0CSOAP",34,0)
- S @ARY@("PROXY SERVER")="2.4"
-"RTN","C0CSOAP",35,0)
- S @ARY@("REPLY TEMPLATE")=".03"
-"RTN","C0CSOAP",36,0)
- S @ARY@("TEMPLATE NAME")=".01"
-"RTN","C0CSOAP",37,0)
- S @ARY@("TEMPLATE XML")="3"
-"RTN","C0CSOAP",38,0)
- S @ARY@("URL")="1"
-"RTN","C0CSOAP",39,0)
- S @ARY@("WSDL URL")="2"
-"RTN","C0CSOAP",40,0)
- S @ARY@("XML")="2.1"
-"RTN","C0CSOAP",41,0)
- S @ARY@("XML HEADER")="2.2"
-"RTN","C0CSOAP",42,0)
- S @ARY@("XPATH REDUCTION STRING")="2.5"
-"RTN","C0CSOAP",43,0)
- S @ARY@("CCR VARIABLE")="4"
-"RTN","C0CSOAP",44,0)
- S @ARY@("FILEMAN FIELD NAME")="1"
-"RTN","C0CSOAP",45,0)
- S @ARY@("FILEMAN FIELD NUMBER")="1.2"
-"RTN","C0CSOAP",46,0)
- S @ARY@("FILEMAN FILE POINTER")="1.1"
-"RTN","C0CSOAP",47,0)
- S @ARY@("INDEXED BY")=".05"
-"RTN","C0CSOAP",48,0)
- S @ARY@("SQLI FIELD NAME")="3"
-"RTN","C0CSOAP",49,0)
- S @ARY@("VARIABLE NAME")="2"
-"RTN","C0CSOAP",50,0)
- Q
-"RTN","C0CSOAP",51,0)
- ;
-"RTN","C0CSOAP",52,0)
-RESTID(INNAM,INFARY) ;EXTRINSIC TO RESOLVE TEMPLATE PASSED BY NAME
-"RTN","C0CSOAP",53,0)
- ; FILE IS IDENTIFIED IN FARY, PASSED BY NAME
-"RTN","C0CSOAP",54,0)
- I '$D(INFARY) D  ; NO FILE ARRAY PASSED
-"RTN","C0CSOAP",55,0)
- . S INFARY="FARY"
-"RTN","C0CSOAP",56,0)
- . D INITFARY(INFARY)
-"RTN","C0CSOAP",57,0)
- N ZN,ZREF,ZR
-"RTN","C0CSOAP",58,0)
- S ZN=@INFARY@("XML FILE NUMBER")
-"RTN","C0CSOAP",59,0)
- S ZREF=$$FILEREF^C0CRNF(ZN)
-"RTN","C0CSOAP",60,0)
- S ZR=$O(@ZREF@("B",INNAM,""))
-"RTN","C0CSOAP",61,0)
- Q ZR
-"RTN","C0CSOAP",62,0)
- ;
-"RTN","C0CSOAP",63,0)
-TESTSOAP ;
-"RTN","C0CSOAP",64,0)
- ; USING ICD9 WEB SERVICE TO TEST SOAP
-"RTN","C0CSOAP",65,0)
- S G("CODE")="E*"
-"RTN","C0CSOAP",66,0)
- S G("CODELN")=3
-"RTN","C0CSOAP",67,0)
- D SOAP("GPL","ICD9","G")
-"RTN","C0CSOAP",68,0)
- Q
-"RTN","C0CSOAP",69,0)
- ;
-"RTN","C0CSOAP",70,0)
-SOAP(C0CRTN,C0CTID,C0CVA,C0CVOR,ALTXML,IFARY) ; MAKES A SOAP CALL FOR 
-"RTN","C0CSOAP",71,0)
- ; TEMPLATE ID C0CTID
-"RTN","C0CSOAP",72,0)
- ; RETURNS THE XML RESULT IN C0CRTN, PASSED BY NAME
-"RTN","C0CSOAP",73,0)
- ; C0CVA IS PASSED BY NAME AND IS THE VARIABLE ARRAY TO PASS TO BIND
-"RTN","C0CSOAP",74,0)
- ; C0CVOR IS THE NAME OF A VARIABLE OVERRIDE ARRAY, WHICH IS APPLIED 
-"RTN","C0CSOAP",75,0)
- ; BEFORE MAPPING
-"RTN","C0CSOAP",76,0)
- ; IF ALTXML IS PASSED, BIND AND MAP WILL BE SKIPPED AND 
-"RTN","C0CSOAP",77,0)
- ; ALTXML WILL BE USED INSTEAD
-"RTN","C0CSOAP",78,0)
- ;
-"RTN","C0CSOAP",79,0)
- ; ARTIFACTS SECTION
-"RTN","C0CSOAP",80,0)
- ; THE FOLLOWING WILL SET UP DEBUGGING ARTIFACTS FOR A POSSIBLE FUTURE
-"RTN","C0CSOAP",81,0)
- ; ONLINE DEBUGGER. IF DEBUG=1, VARIABLES CONTAINING INTERMEDIATE RESULTS
-"RTN","C0CSOAP",82,0)
- ; WILL NOT BE NEWED.
-"RTN","C0CSOAP",83,0)
- I $G(WSDEBUG)="" N C0CV ; CATALOG OF ARTIFACT VARIABLES AND ARRAYS
-"RTN","C0CSOAP",84,0)
- S C0CV(100,"C0CXF","XML TEMPLATE FILE NUMBER")=""
-"RTN","C0CSOAP",85,0)
- S C0CV(200,"C0CHEAD","SOAP HEADER VARIABLE NAME")=""
-"RTN","C0CSOAP",86,0)
- S C0CV(300,"HEADER","SOAP HEADER")=""
-"RTN","C0CSOAP",87,0)
- S C0CV(400,"C0CMIME","MIME TYPE")=""
-"RTN","C0CSOAP",88,0)
- S C0CV(500,"C0CURL","WS URL")=""
-"RTN","C0CSOAP",89,0)
- S C0CV(550,"C0CPURL","PROXY URL")=""
-"RTN","C0CSOAP",90,0)
- S C0CV(600,"C0CXML","XML VARIABLE NAME")=""
-"RTN","C0CSOAP",91,0)
- S C0CV(700,"XML","OUTBOUND XML")=""
-"RTN","C0CSOAP",92,0)
- S C0CV(800,"C0CRSLT","RAW XML RESULT RETURNED FROM WEB SERVICE")=""
-"RTN","C0CSOAP",93,0)
- S C0CV(900,"C0CRHDR","RETURNED HEADER")=""
-"RTN","C0CSOAP",94,0)
- S C0CV(1000,"C0CRXML","XML RESULT NORMALIZED")=""
-"RTN","C0CSOAP",95,0)
- S C0CV(1100,"C0CR","REPLY TEMPLATE")=""
-"RTN","C0CSOAP",96,0)
- S C0CV(1200,"C0CREDUX","REDUX STRING")=""
-"RTN","C0CSOAP",97,0)
- S C0CV(1300,"C0CIDX","RESULT XPATH INDEX")=""
-"RTN","C0CSOAP",98,0)
- S C0CV(1400,"C0CARY","RESULT XPATH ARRAY")=""
-"RTN","C0CSOAP",99,0)
- S C0CV(1500,"C0CNOM","RESULT DOM DOCUMENT NAME")=""
-"RTN","C0CSOAP",100,0)
- S C0CV(1600,"C0CID","RESULT DOM ID")=""
-"RTN","C0CSOAP",101,0)
- I $G(DEBUG)'="" G NOTNEW ; SKIP NEWING THE VARIABLES IF IN DEBUG
-"RTN","C0CSOAP",102,0)
- N ZI,ZJ S ZI=""
-"RTN","C0CSOAP",103,0)
-NEW 
-"RTN","C0CSOAP",104,0)
- S ZI=$O(C0CV(ZI))
-"RTN","C0CSOAP",105,0)
- S ZJ=$O(C0CV(ZI,"")) ; SET UP NEW COMMAND
-"RTN","C0CSOAP",106,0)
- ;W ZJ,!
-"RTN","C0CSOAP",107,0)
- N @ZJ ; NEW THE VARIABLE
-"RTN","C0CSOAP",108,0)
- I $O(C0CV(ZI))'="" G NEW ;LOOP TO GET NEW IN CONTEXT
-"RTN","C0CSOAP",109,0)
-NOTNEW 
-"RTN","C0CSOAP",110,0)
- ; END ARTIFACTS
-"RTN","C0CSOAP",111,0)
- ;
-"RTN","C0CSOAP",112,0)
- I '$D(IFARY) D INITFARY("C0CF") ; SET FILE NUMBER AND PARAMATERS 
-"RTN","C0CSOAP",113,0)
- E  D  ; 
-"RTN","C0CSOAP",114,0)
- . K C0CF
-"RTN","C0CSOAP",115,0)
- . M C0CF=@IFARY
-"RTN","C0CSOAP",116,0)
- S C0CXF=C0CF("XML FILE NUMBER") ; FILE NUMBER FOR THE XML TEMPLATE FILE
-"RTN","C0CSOAP",117,0)
- I +C0CTID=0 D  ; A STRING WAS PASSED FOR THE TEMPLATE NAME
-"RTN","C0CSOAP",118,0)
- . S C0CUTID=$$RESTID(C0CTID,"C0CF") ;RESOLVE TEMPLATE IEN FROM NAME
-"RTN","C0CSOAP",119,0)
- E  S C0CUTID=C0CTID ; AN IEN WAS PASSED
-"RTN","C0CSOAP",120,0)
- N XML,TEMPLATE,HEADER
-"RTN","C0CSOAP",121,0)
- N C0CFH S C0CFH=C0CF("XML HEADER")
-"RTN","C0CSOAP",122,0)
- S C0CHEAD=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFH,,"HEADER")
-"RTN","C0CSOAP",123,0)
- N C0CFM S C0CFM=C0CF("MIME TYPE")
-"RTN","C0CSOAP",124,0)
- S C0CMIME=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFM)
-"RTN","C0CSOAP",125,0)
- N C0CFP S C0CFP=C0CF("PROXY SERVER")
-"RTN","C0CSOAP",126,0)
- S C0CPURL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFP)
-"RTN","C0CSOAP",127,0)
- N C0CFU S C0CFU=C0CF("URL")
-"RTN","C0CSOAP",128,0)
- S C0CURL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFU)
-"RTN","C0CSOAP",129,0)
- N C0CFX S C0CFX=C0CF("XML")
-"RTN","C0CSOAP",130,0)
- S C0CXML=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFX,,"XML")
-"RTN","C0CSOAP",131,0)
- N C0CFT S C0CFT=C0CF("TEMPLATE XML")
-"RTN","C0CSOAP",132,0)
- S C0CTMPL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFT,,"TEMPLATE")
-"RTN","C0CSOAP",133,0)
- I C0CTMPL="TEMPLATE" D  ; there is a template to process
-"RTN","C0CSOAP",134,0)
- . K XML ; going to replace the xml array
-"RTN","C0CSOAP",135,0)
- . N VARS
-"RTN","C0CSOAP",136,0)
- . I $D(C0CVOR) M @C0CVA=@C0CVOR ; merge in varible overrides
-"RTN","C0CSOAP",137,0)
- . I '$D(ALTXML) D  ; if ALTXML is passed in, don't bind
-"RTN","C0CSOAP",138,0)
- . . D BIND("VARS",C0CVA,C0CUTID,"C0CF")
-"RTN","C0CSOAP",139,0)
- . . D MAP("XML","VARS",TPTR,"C0CF")
-"RTN","C0CSOAP",140,0)
- . . K XML(0)
-"RTN","C0CSOAP",141,0)
- . E  M XML=@ALTXML ; use ALTXML instead
-"RTN","C0CSOAP",142,0)
- I $G(C0CPROXY) S C0CURL=C0CPURL
-"RTN","C0CSOAP",143,0)
- K C0CRSLT,C0CRHDR
-"RTN","C0CSOAP",144,0)
- B
-"RTN","C0CSOAP",145,0)
- S ok=$$httpPOST^%zewdGTM(C0CURL,.XML,C0CMIME,.C0CRSLT,.HEADER,"",.gpl5,.C0CRHDR)
-"RTN","C0CSOAP",146,0)
- K C0CRXML
-"RTN","C0CSOAP",147,0)
- D NORMAL("C0CRXML","C0CRSLT(1)") ;RETURN XML IN AN ARRAY
-"RTN","C0CSOAP",148,0)
- N C0CFR S C0CFR=$G(C0CF("REPLY TEMPLATE"))
-"RTN","C0CSOAP",149,0)
- S C0CR=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFR,"I") ; REPLY TEMPLATE
-"RTN","C0CSOAP",150,0)
- ; reply templates are optional and are specified by populating a
-"RTN","C0CSOAP",151,0)
- ; template pointer in field 2.5 of the request template
-"RTN","C0CSOAP",152,0)
- ; if specified, the reply template is the source of the REDUX string
-"RTN","C0CSOAP",153,0)
- ; used for XPath on the reply, and for UNBIND processing
-"RTN","C0CSOAP",154,0)
- ; if no reply template is specified, REDUX is obtained from the request
-"RTN","C0CSOAP",155,0)
- ; template and no UNBIND processing is performed. The XPath array is
-"RTN","C0CSOAP",156,0)
- ; returned without variable bindings
-"RTN","C0CSOAP",157,0)
- I C0CR'="" D  ; REPLY TEMPLATE EXISTS
-"RTN","C0CSOAP",158,0)
- . I +$G(DEBUG)'=0 W "REPLY TEMPLATE:",C0CR,!
-"RTN","C0CSOAP",159,0)
- . S C0CTID=C0CR ;
-"RTN","C0CSOAP",160,0)
- N C0CFRDX S C0CFRDX=C0CF("XPATH REDUCTION STRING")
-"RTN","C0CSOAP",161,0)
- S C0CREDUX=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFRDX) ;XPATH REDUCTION STRING
-"RTN","C0CSOAP",162,0)
- K C0CIDX,C0CARY ; XPATH INDEX AND ARRAY VARS
-"RTN","C0CSOAP",163,0)
- S C0CNOM="C0CWS"_$J ; DOCUMENT NAME FOR THE DOM
-"RTN","C0CSOAP",164,0)
- S C0CID=$$PARSE^C0CXEWD("C0CRXML",C0CNOM) ;CALL THE PARSER
-"RTN","C0CSOAP",165,0)
- S C0CID=$$FIRST^C0CXEWD($$ID^C0CXEWD(C0CNOM)) ;ID OF FIRST NODE
-"RTN","C0CSOAP",166,0)
- D XPATH^C0CXEWD(C0CID,"/","C0CIDX","C0CARY","",C0CREDUX) ;XPATH GENERATOR
-"RTN","C0CSOAP",167,0)
- ; Next, call UNBIND to map the reply XPath array to variables
-"RTN","C0CSOAP",168,0)
- ; This is only done if a Reply Template is provided
-"RTN","C0CSOAP",169,0)
- D DEMUXARY(C0CRTN,"C0CARY")
-"RTN","C0CSOAP",170,0)
- ; M @C0CRTN=C0CARY
-"RTN","C0CSOAP",171,0)
- Q
-"RTN","C0CSOAP",172,0)
- ;
-"RTN","C0CSOAP",173,0)
-DEMUXARY(OARY,IARY) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO
-"RTN","C0CSOAP",174,0)
- ; FORMAT @OARY@(x,xpath) where x is the first multiple
-"RTN","C0CSOAP",175,0)
- N ZI,ZJ,ZK,ZL S ZI=""
-"RTN","C0CSOAP",176,0)
- F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ;
-"RTN","C0CSOAP",177,0)
- . D DEMUX^C0CMXP("ZJ",ZI)
-"RTN","C0CSOAP",178,0)
- . S ZK=$P(ZJ,"^",3)
-"RTN","C0CSOAP",179,0)
- . S ZK=$RE($P($RE(ZK),"/",1))
-"RTN","C0CSOAP",180,0)
- . S ZL=$P(ZJ,"^",1)
-"RTN","C0CSOAP",181,0)
- . I ZL="" S ZL=1
-"RTN","C0CSOAP",182,0)
- . S @OARY@(ZL,ZK)=@IARY@(ZI)
-"RTN","C0CSOAP",183,0)
- Q
-"RTN","C0CSOAP",184,0)
- ;
-"RTN","C0CSOAP",185,0)
-NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
-"RTN","C0CSOAP",186,0)
- ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
-"RTN","C0CSOAP",187,0)
- ;
-"RTN","C0CSOAP",188,0)
- N ZI,ZN,ZTMP
-"RTN","C0CSOAP",189,0)
- S ZN=1
-"RTN","C0CSOAP",190,0)
- S @OUTXML@(ZN)=$P(@INXML,"><",ZN)_">"
-"RTN","C0CSOAP",191,0)
- S ZN=ZN+1
-"RTN","C0CSOAP",192,0)
- F  S @OUTXML@(ZN)="<"_$P(@INXML,"><",ZN) Q:$P(@INXML,"><",ZN+1)=""  D  ;
-"RTN","C0CSOAP",193,0)
- . S @OUTXML@(ZN)=@OUTXML@(ZN)_">"
-"RTN","C0CSOAP",194,0)
- . S ZN=ZN+1
-"RTN","C0CSOAP",195,0)
- Q
-"RTN","C0CSOAP",196,0)
- ;
-"RTN","C0CSOAP",197,0)
-MAP(RARY,IVARS,TPTR,INFARY) ;RETURNS MAPPED XML IN RARY PASSED BY NAME
-"RTN","C0CSOAP",198,0)
- ; IVARS IS AN XPATH ARRAY PASSED BY NAME
-"RTN","C0CSOAP",199,0)
- ; TPTR IS A POINT TO THE C0C XML TEMPLATE FILE USED TO RETRIEVE THE TEMPLATE
-"RTN","C0CSOAP",200,0)
- ;
-"RTN","C0CSOAP",201,0)
- N ZT ;THE TEMPLATE
-"RTN","C0CSOAP",202,0)
- K ZT,@RARY
-"RTN","C0CSOAP",203,0)
- I '$D(INFARY) D  ;
-"RTN","C0CSOAP",204,0)
- . S INFARY="FARY"
-"RTN","C0CSOAP",205,0)
- . D INITFARY(INFARY)
-"RTN","C0CSOAP",206,0)
- N ZF,ZFT
-"RTN","C0CSOAP",207,0)
- S ZF=@INFARY@("XML FILE NUMBER")
-"RTN","C0CSOAP",208,0)
- S ZFT=@INFARY@("TEMPLATE XML")
-"RTN","C0CSOAP",209,0)
- I $$GET1^DIQ(ZF,TPTR_",",ZFT,,"ZT")'="ZT" D  Q  ; ERROR GETTING TEMPLATE
-"RTN","C0CSOAP",210,0)
- . W "ERROR RETRIEVING TEMPLATE",!
-"RTN","C0CSOAP",211,0)
- D MAP^C0CXPATH("ZT",IVARS,RARY) ;DO THE MAPPING
-"RTN","C0CSOAP",212,0)
- Q
-"RTN","C0CSOAP",213,0)
- ;
-"RTN","C0CSOAP",214,0)
-TESTBIND ;
-"RTN","C0CSOAP",215,0)
- S G1("TESTONE")=1
-"RTN","C0CSOAP",216,0)
- S G1("TESTTWO")=2
-"RTN","C0CSOAP",217,0)
- D BIND("G","G1","TEST")
-"RTN","C0CSOAP",218,0)
- W !
-"RTN","C0CSOAP",219,0)
- ZWR G
-"RTN","C0CSOAP",220,0)
- Q
-"RTN","C0CSOAP",221,0)
- ;
-"RTN","C0CSOAP",222,0)
-BIND(RARY,IVARS,INTPTR,INFARY) ;RETURNS AN XPATH ARRAY IN RARY FOR USE WITH MAP
-"RTN","C0CSOAP",223,0)
- ; TO BUILD AN INSTANTIATED TEMPLATE
-"RTN","C0CSOAP",224,0)
- ; TPTR IS THE IEN OF THE XML TEMPATE IN THE C0C XML TEMPLATE FILE
-"RTN","C0CSOAP",225,0)
- ; LOOPS THROUGHT THE BINDING SUBFILE TO PULL OUT XPATHS AND 
-"RTN","C0CSOAP",226,0)
- ; EITHER ASSIGNS VARIABLES OR DOES A FILEMAN CALL TO GET VALUES
-"RTN","C0CSOAP",227,0)
- ; VARIABLES ARE IN IVARS WHICH IS PASSED BY NAME
-"RTN","C0CSOAP",228,0)
- I '$D(INFARY) D  ;
-"RTN","C0CSOAP",229,0)
- . S INFARY="FARY"
-"RTN","C0CSOAP",230,0)
- . D INITFARY(INFARY) ;INITIALIZE FILE ARRAY IF NOT PASSED
-"RTN","C0CSOAP",231,0)
- I +INTPTR>0 S TPTR=INTPTR
-"RTN","C0CSOAP",232,0)
- E  S TPTR=$$RESTID(INTPTR,INFARY)
-"RTN","C0CSOAP",233,0)
- N C0CFF,C0CBF,C0CXI,C0CFREF,C0CXREF
-"RTN","C0CSOAP",234,0)
- S C0CFF=@INFARY@("XML FILE NUMBER") ;fileman file number of XML file
-"RTN","C0CSOAP",235,0)
- S C0CFREF=$$FILEREF^C0CRNF(C0CFF) ; closed file reference to the file
-"RTN","C0CSOAP",236,0)
- S C0CBF=@INFARY@("BINDING SUBFILE NUMBER") ; BINDING SUBFILE NUMBER
-"RTN","C0CSOAP",237,0)
- S C0CXI=$G(@INFARY@("XPATH INDEX")) ; index to the XPath bindings
-"RTN","C0CSOAP",238,0)
- I C0CXI="" S C0CXI="XPATH" ; default is the XPATH index
-"RTN","C0CSOAP",239,0)
- ; this needs to be a whole file index on the XPath subfile with
-"RTN","C0CSOAP",240,0)
- ; the Template IEN perceding the XPath in the index
-"RTN","C0CSOAP",241,0)
- N ZI
-"RTN","C0CSOAP",242,0)
- S ZI=""
-"RTN","C0CSOAP",243,0)
- S C0CXREF=$NA(@C0CFREF@(C0CXI,TPTR)) ; where the xref is
-"RTN","C0CSOAP",244,0)
- ;F  S ZI=$O(^C0CX(TPTR,5,"B",ZI)) Q:ZI=""  D  ; FOR EACH XPATH
-"RTN","C0CSOAP",245,0)
- F  S ZI=$O(@C0CXREF@(ZI)) Q:ZI=""  D  ; for each XPath in this template
-"RTN","C0CSOAP",246,0)
- . ;W !,ZI," ",$O(@C0CXREF@(ZI,TPTR,""))
-"RTN","C0CSOAP",247,0)
- . N ZIEN,ZFILE,ZFIELD,ZVAR,ZIDX,ZINDEX ;
-"RTN","C0CSOAP",248,0)
- . S ZIEN=$O(@C0CXREF@(ZI,TPTR,"")) ; IEN OF THE BINDING RECORD
-"RTN","C0CSOAP",249,0)
- . N ZFF S ZFF=@INFARY@("FILEMAN FILE POINTER")
-"RTN","C0CSOAP",250,0)
- . S ZFILE=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFF,"I")
-"RTN","C0CSOAP",251,0)
- . N ZFFLD S ZFFLD=@INFARY@("FILEMAN FIELD NUMBER")
-"RTN","C0CSOAP",252,0)
- . S ZFIELD=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFFLD,"I")
-"RTN","C0CSOAP",253,0)
- . N ZFV S ZFV=@INFARY@("VARIABLE NAME")
-"RTN","C0CSOAP",254,0)
- . S ZVAR=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFV,"E")
-"RTN","C0CSOAP",255,0)
- . N ZFX S ZFX=("INDEXED BY")
-"RTN","C0CSOAP",256,0)
- . S ZIDX=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFX,"I")
-"RTN","C0CSOAP",257,0)
- . S ZINDEX=""
-"RTN","C0CSOAP",258,0)
- . I ZIDX="DUZ" S ZINDEX=$G(DUZ) ; FILE IS INDEXED BY DUZ
-"RTN","C0CSOAP",259,0)
- . I ZIDX="DFN" S ZINDEX=$G(DFN) ; BY DFN
-"RTN","C0CSOAP",260,0)
- . E  I ZIDX'="" S ZINDEX=$G(@ZIDX) ; index variable
-"RTN","C0CSOAP",261,0)
- . ;I ZIDX="ACCT" S ZINDEX=C0CACCT ; BY ACCOUNT RECORD POINT TO C0C WS ACCT
-"RTN","C0CSOAP",262,0)
- . ;I ZIDX="LOC" S ZINDEX=C0CLOC ; BY LOCATION
-"RTN","C0CSOAP",263,0)
- . I ZVAR'="" D  ; VARIABLES TAKE PRESCIDENCE OVER FILEMAN FIELDS
-"RTN","C0CSOAP",264,0)
- . . S @RARY@(ZI)=@IVARS@(ZVAR) ; 
-"RTN","C0CSOAP",265,0)
- . E  D  ; IF NO VARIABLE, TRY ACCESSING FROM FILEMAN
-"RTN","C0CSOAP",266,0)
- . . I (ZFILE="")!(ZFIELD="") Q  ;QUIT IF FILE OR FIELD NOT THERE
-"RTN","C0CSOAP",267,0)
- . . D CLEAN^DILF
-"RTN","C0CSOAP",268,0)
- . . S @RARY@(ZI)=$$GET1^DIQ(ZFILE,ZINDEX_",",ZFIELD) ;GET THE VALUE
-"RTN","C0CSOAP",269,0)
- . . I $D(^TMP("DIERR",$J,1)) D  B ;
-"RTN","C0CSOAP",270,0)
- . . . W "ERROR!",!
 "RTN","C0CSOAP",271,0)
- . . . ZWR ^TMP("DIERR",$J,*)
-"RTN","C0CSOAP",272,0)
- Q
-"RTN","C0CSOAP",273,0)
  ;
 "RTN","C0CSQMB")
-0^107^B545540
+0^107^B779536
 "RTN","C0CSQMB",1,0)
 C0CSQMB ; SQMCCR/ELN  - BATCH PROGRAM ;16/11/2010
 "RTN","C0CSQMB",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CSQMB",3,0)
- ;
+ ; (C) 2010 ELN
 "RTN","C0CSQMB",4,0)
+ ;
+"RTN","C0CSQMB",5,0)
+ ; This program is free software: you can redistribute it and/or modify
+"RTN","C0CSQMB",6,0)
+ ; it under the terms of the GNU Affero General Public License as
+"RTN","C0CSQMB",7,0)
+ ; published by the Free Software Foundation, either version 3 of the
+"RTN","C0CSQMB",8,0)
+ ; License, or (at your option) any later version.
+"RTN","C0CSQMB",9,0)
+ ;
+"RTN","C0CSQMB",10,0)
+ ; This program is distributed in the hope that it will be useful,
+"RTN","C0CSQMB",11,0)
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","C0CSQMB",12,0)
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","C0CSQMB",13,0)
+ ; GNU Affero General Public License for more details.
+"RTN","C0CSQMB",14,0)
+ ;
+"RTN","C0CSQMB",15,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CSQMB",16,0)
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+"RTN","C0CSQMB",17,0)
+ ;
+"RTN","C0CSQMB",18,0)
 EN ;Traverse the DPT global and export CCR xml for each DFN
-"RTN","C0CSQMB",5,0)
+"RTN","C0CSQMB",19,0)
  ;and write to directory set in ^TMP("C0CCCR","ODIR")=
-"RTN","C0CSQMB",6,0)
- ;
-"RTN","C0CSQMB",7,0)
+"RTN","C0CSQMB",20,0)
+ ;
+"RTN","C0CSQMB",21,0)
  I '$D(DUZ) Q
-"RTN","C0CSQMB",8,0)
+"RTN","C0CSQMB",22,0)
  S U="^",DT=$$DT^XLFDT
-"RTN","C0CSQMB",9,0)
+"RTN","C0CSQMB",23,0)
  D DUZ^XUP(DUZ)
-"RTN","C0CSQMB",10,0)
+"RTN","C0CSQMB",24,0)
  ; Get the output directory and filename prefix from env
-"RTN","C0CSQMB",11,0)
+"RTN","C0CSQMB",25,0)
  S ^TMP("C0CCCR","ODIR")=$ZTRNLNM("ccrodir")
-"RTN","C0CSQMB",12,0)
+"RTN","C0CSQMB",26,0)
  S ^TMP("C0CCCR","OFNP")=$ZTRNLNM("ccrofnprefix")
-"RTN","C0CSQMB",13,0)
+"RTN","C0CSQMB",27,0)
  N ZDFN
-"RTN","C0CSQMB",14,0)
+"RTN","C0CSQMB",28,0)
  ;F ZDFN=0:0 S ZDFN=$O(^DPT(ZDFN)) Q:'ZDFN!((ZDFN="+1,")!(ZDFN>10))  D
-"RTN","C0CSQMB",15,0)
+"RTN","C0CSQMB",29,0)
  F ZDFN=0:0 S ZDFN=$O(^DPT(ZDFN)) Q:'ZDFN!(ZDFN="+1,")  D
-"RTN","C0CSQMB",16,0)
+"RTN","C0CSQMB",30,0)
  . ;I ZDFN<350 S ZDFN=349
-"RTN","C0CSQMB",17,0)
+"RTN","C0CSQMB",31,0)
  . D XPAT^C0CCCR(ZDFN)
-"RTN","C0CSQMB",18,0)
+"RTN","C0CSQMB",32,0)
  Q
-"RTN","C0CSQMB",19,0)
+"RTN","C0CSQMB",33,0)
  ;
 "RTN","C0CSUB1")
-0^61^B16280924
+0^61^B15609029
 "RTN","C0CSUB1",1,0)
 C0CSUB1   ; CCDCCR/GPL - CCR SUBSCRIPTION utilities; 12/6/08
 "RTN","C0CSUB1",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CSUB1",3,0)
- ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
+ ;Copyright 2009 George Lilly.  
 "RTN","C0CSUB1",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CSUB1",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CSUB1",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CSUB1",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CSUB1",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CSUB1",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CSUB1",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CSUB1",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CSUB1",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CSUB1",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CSUB1",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CSUB1",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CSUB1",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CSUB1",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CSUB1",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ W "This is the CCR SUBSCRIPTIONN Utility Library ",!
 "RTN","C0CSUB1",19,0)
- ;
+ Q
 "RTN","C0CSUB1",20,0)
- W "This is the CCR SUBSCRIPTIONN Utility Library ",!
+ ;
 "RTN","C0CSUB1",21,0)
+CHK1(DFN) ; ADD THE CHECKSUM FOR ONE PATIENT
+"RTN","C0CSUB1",22,0)
+ ;
+"RTN","C0CSUB1",23,0)
+ S C0CCHK=$NA(^TMP("C0CRIM","CHKSUM"))
+"RTN","C0CSUB1",24,0)
+ S C0CSF=177.101 ; FILE NUMBER FOR SUBSCRIPTION FILE
+"RTN","C0CSUB1",25,0)
+ S C0CSFS=177.1011 ; FILE NUMBER FOR SUBSCRIPTION SUBFILE
+"RTN","C0CSUB1",26,0)
+ S C0CSFC=177.1012 ; FILE NUMBER FOR CHECKSUM SUBFILE
+"RTN","C0CSUB1",27,0)
+ S C0CSFDC=177.10121 ; FILE NUMBER FOR DOMAIN CHECKSUMS
+"RTN","C0CSUB1",28,0)
+ S C0CPAT=$O(^C0CS("B",DFN,"")) ; IEN OF PAT
+"RTN","C0CSUB1",29,0)
+ K C0CFDA
+"RTN","C0CSUB1",30,0)
+ S C0CALL=$G(@C0CCHK@(DFN,"ALL"))
+"RTN","C0CSUB1",31,0)
+ I C0CALL'="" S C0CFDA(C0CSFC,"?+1,"_C0CPAT_",",.01)=C0CALL
+"RTN","C0CSUB1",32,0)
+ E  Q  ; NO CHECKSUMS FOR THISPATIENT
+"RTN","C0CSUB1",33,0)
+ D UPDIE
+"RTN","C0CSUB1",34,0)
+ N C0CJ S C0CJ=""
+"RTN","C0CSUB1",35,0)
+ F  S C0CJ=$O(@C0CCHK@(DFN,"DOMAIN",C0CJ)) Q:C0CJ=""  D  ; FOR EACH DOMAIN
+"RTN","C0CSUB1",36,0)
+ . S C0CD=$O(^C0CDIC(170.101,"B",C0CJ,""))
+"RTN","C0CSUB1",37,0)
+ . W C0CJ," ",C0CD,!
+"RTN","C0CSUB1",38,0)
+ . S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",.01)=C0CD
+"RTN","C0CSUB1",39,0)
+ . S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",1)=@C0CCHK@(DFN,"DOMAIN",C0CJ)
+"RTN","C0CSUB1",40,0)
+ . D UPDIE
+"RTN","C0CSUB1",41,0)
  Q
-"RTN","C0CSUB1",22,0)
- ;
-"RTN","C0CSUB1",23,0)
-CHK1(DFN) ; ADD THE CHECKSUM FOR ONE PATIENT
-"RTN","C0CSUB1",24,0)
- ;
-"RTN","C0CSUB1",25,0)
- S C0CCHK=$NA(^TMP("C0CRIM","CHKSUM"))
-"RTN","C0CSUB1",26,0)
+"RTN","C0CSUB1",42,0)
+ ;
+"RTN","C0CSUB1",43,0)
+SUBALL ; SUBSCRIBE ALL PATIENTS IN CCR GLOBALS TO SUBCRIBER 1
+"RTN","C0CSUB1",44,0)
+ ;
+"RTN","C0CSUB1",45,0)
+ S C0CGLB=$NA(^TMP("C0CRIM","VARS"))
+"RTN","C0CSUB1",46,0)
+ S C0CI=""
+"RTN","C0CSUB1",47,0)
+ F  S C0CI=$O(@C0CGLB@(C0CI)) Q:C0CI=""  D  ; FOR EACH PATIENT
+"RTN","C0CSUB1",48,0)
+ . D SUB1(C0CI,1) ;SUBSCIRBE THEM TO EPCRN
+"RTN","C0CSUB1",49,0)
+ Q
+"RTN","C0CSUB1",50,0)
+ ;
+"RTN","C0CSUB1",51,0)
+SUB1(DFN,C0CSS) ; SUBSCRIBE ONE PATIENT TO SUBSCRIBER C0CSS
+"RTN","C0CSUB1",52,0)
+ ;
+"RTN","C0CSUB1",53,0)
  S C0CSF=177.101 ; FILE NUMBER FOR SUBSCRIPTION FILE
-"RTN","C0CSUB1",27,0)
+"RTN","C0CSUB1",54,0)
  S C0CSFS=177.1011 ; FILE NUMBER FOR SUBSCRIPTION SUBFILE
-"RTN","C0CSUB1",28,0)
- S C0CSFC=177.1012 ; FILE NUMBER FOR CHECKSUM SUBFILE
-"RTN","C0CSUB1",29,0)
- S C0CSFDC=177.10121 ; FILE NUMBER FOR DOMAIN CHECKSUMS
-"RTN","C0CSUB1",30,0)
+"RTN","C0CSUB1",55,0)
+ S C0CSFC=177.10121 ; FILE NUMBER FOR CHECKSUMS
+"RTN","C0CSUB1",56,0)
+ S C0CSSF=177.201 ; FILE NUMBER FOR SUBSCRIBER FILE
+"RTN","C0CSUB1",57,0)
+ K C0CFDA
+"RTN","C0CSUB1",58,0)
+ S C0CFDA(C0CSF,"+1,",.01)=DFN
+"RTN","C0CSUB1",59,0)
+ D UPDIE ; ADD THE PATIENT
+"RTN","C0CSUB1",60,0)
  S C0CPAT=$O(^C0CS("B",DFN,"")) ; IEN OF PAT
-"RTN","C0CSUB1",31,0)
- K C0CFDA 
-"RTN","C0CSUB1",32,0)
- S C0CALL=$G(@C0CCHK@(DFN,"ALL"))
-"RTN","C0CSUB1",33,0)
- I C0CALL'="" S C0CFDA(C0CSFC,"?+1,"_C0CPAT_",",.01)=C0CALL
-"RTN","C0CSUB1",34,0)
- E  Q ; NO CHECKSUMS FOR THISPATIENT
-"RTN","C0CSUB1",35,0)
- D UPDIE
-"RTN","C0CSUB1",36,0)
- N C0CJ S C0CJ=""
-"RTN","C0CSUB1",37,0)
- F  S C0CJ=$O(@C0CCHK@(DFN,"DOMAIN",C0CJ)) Q:C0CJ=""  D  ; FOR EACH DOMAIN
-"RTN","C0CSUB1",38,0)
- . S C0CD=$O(^C0CDIC(170.101,"B",C0CJ,"")) 
-"RTN","C0CSUB1",39,0)
- . W C0CJ," ",C0CD,!
-"RTN","C0CSUB1",40,0)
- . S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",.01)=C0CD
-"RTN","C0CSUB1",41,0)
- . S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",1)=@C0CCHK@(DFN,"DOMAIN",C0CJ)
-"RTN","C0CSUB1",42,0)
- . D UPDIE
-"RTN","C0CSUB1",43,0)
+"RTN","C0CSUB1",61,0)
+ S C0CFDA(C0CSFS,"+1,"_C0CPAT_",",.01)=C0CSS ; C0CSS IS A POINTER
+"RTN","C0CSUB1",62,0)
+ D UPDIE ; ADD THE SUBSCRIPTION
+"RTN","C0CSUB1",63,0)
+ D CHK1(DFN) ; ADD THE CHECKSUMS
+"RTN","C0CSUB1",64,0)
  Q
-"RTN","C0CSUB1",44,0)
- ;
-"RTN","C0CSUB1",45,0)
-SUBALL ; SUBSCRIBE ALL PATIENTS IN CCR GLOBALS TO SUBCRIBER 1
-"RTN","C0CSUB1",46,0)
- ;
-"RTN","C0CSUB1",47,0)
- S C0CGLB=$NA(^TMP("C0CRIM","VARS"))
-"RTN","C0CSUB1",48,0)
- S C0CI=""
-"RTN","C0CSUB1",49,0)
- F  S C0CI=$O(@C0CGLB@(C0CI)) Q:C0CI=""  D  ; FOR EACH PATIENT
-"RTN","C0CSUB1",50,0)
- . D SUB1(C0CI,1) ;SUBSCIRBE THEM TO EPCRN
-"RTN","C0CSUB1",51,0)
+"RTN","C0CSUB1",65,0)
+ ;
+"RTN","C0CSUB1",66,0)
+UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+"RTN","C0CSUB1",67,0)
+ K ZERR
+"RTN","C0CSUB1",68,0)
+ D CLEAN^DILF
+"RTN","C0CSUB1",69,0)
+ D UPDATE^DIE("","C0CFDA","","ZERR")
+"RTN","C0CSUB1",70,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CSUB1",71,0)
+ K C0CFDA
+"RTN","C0CSUB1",72,0)
  Q
-"RTN","C0CSUB1",52,0)
- ;
-"RTN","C0CSUB1",53,0)
-SUB1(DFN,C0CSS) ; SUBSCRIBE ONE PATIENT TO SUBSCRIBER C0CSS
-"RTN","C0CSUB1",54,0)
- ;
-"RTN","C0CSUB1",55,0)
- S C0CSF=177.101 ; FILE NUMBER FOR SUBSCRIPTION FILE
-"RTN","C0CSUB1",56,0)
- S C0CSFS=177.1011 ; FILE NUMBER FOR SUBSCRIPTION SUBFILE
-"RTN","C0CSUB1",57,0)
- S C0CSFC=177.10121 ; FILE NUMBER FOR CHECKSUMS
-"RTN","C0CSUB1",58,0)
- S C0CSSF=177.201 ; FILE NUMBER FOR SUBSCRIBER FILE
-"RTN","C0CSUB1",59,0)
- K C0CFDA
-"RTN","C0CSUB1",60,0)
- S C0CFDA(C0CSF,"+1,",.01)=DFN
-"RTN","C0CSUB1",61,0)
- D UPDIE ; ADD THE PATIENT
-"RTN","C0CSUB1",62,0)
- S C0CPAT=$O(^C0CS("B",DFN,"")) ; IEN OF PAT
-"RTN","C0CSUB1",63,0)
- S C0CFDA(C0CSFS,"+1,"_C0CPAT_",",.01)=C0CSS ; C0CSS IS A POINTER
-"RTN","C0CSUB1",64,0)
- D UPDIE ; ADD THE SUBSCRIPTION
-"RTN","C0CSUB1",65,0)
- D CHK1(DFN) ; ADD THE CHECKSUMS
-"RTN","C0CSUB1",66,0)
+"RTN","C0CSUB1",73,0)
+ ;
+"RTN","C0CSUB1",74,0)
+VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
+"RTN","C0CSUB1",75,0)
+ ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
+"RTN","C0CSUB1",76,0)
+ ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
+"RTN","C0CSUB1",77,0)
+ ;
+"RTN","C0CSUB1",78,0)
+ N ZCCRD,ZVARN,C0CFDA2
+"RTN","C0CSUB1",79,0)
+ S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
+"RTN","C0CSUB1",80,0)
+ S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
+"RTN","C0CSUB1",81,0)
+ I ZVARN="" D  ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
+"RTN","C0CSUB1",82,0)
+ . I '$D(ZTYP) D  Q  ; WON'T ADD A VARIABLE WITHOUT A TYPE
+"RTN","C0CSUB1",83,0)
+ . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
+"RTN","C0CSUB1",84,0)
+ . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
+"RTN","C0CSUB1",85,0)
+ . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
+"RTN","C0CSUB1",86,0)
+ . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
+"RTN","C0CSUB1",87,0)
+ . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
+"RTN","C0CSUB1",88,0)
+ . I $D(ZERR) D  ; LAYGO ERROR
+"RTN","C0CSUB1",89,0)
+ . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
+"RTN","C0CSUB1",90,0)
+ . E  D  ;
+"RTN","C0CSUB1",91,0)
+ . . D CLEAN^DILF ; CLEAN UP
+"RTN","C0CSUB1",92,0)
+ . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
+"RTN","C0CSUB1",93,0)
+ . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
+"RTN","C0CSUB1",94,0)
+ Q ZVARN
+"RTN","C0CSUB1",95,0)
+ ;
+"RTN","C0CSUB1",96,0)
+SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
+"RTN","C0CSUB1",97,0)
+ ; TO SET TO VALUE C0CSV.
+"RTN","C0CSUB1",98,0)
+ ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
+"RTN","C0CSUB1",99,0)
+ ; C0CSN,C0CSV ARE PASSED BY VALUE
+"RTN","C0CSUB1",100,0)
+ ;
+"RTN","C0CSUB1",101,0)
+ N C0CSI,C0CSJ
+"RTN","C0CSUB1",102,0)
+ S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
+"RTN","C0CSUB1",103,0)
+ S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
+"RTN","C0CSUB1",104,0)
+ S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
+"RTN","C0CSUB1",105,0)
  Q
-"RTN","C0CSUB1",67,0)
- ;
-"RTN","C0CSUB1",68,0)
-UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
-"RTN","C0CSUB1",69,0)
- K ZERR
-"RTN","C0CSUB1",70,0)
- D CLEAN^DILF
-"RTN","C0CSUB1",71,0)
- D UPDATE^DIE("","C0CFDA","","ZERR")
-"RTN","C0CSUB1",72,0)
- I $D(ZERR) D  ;
-"RTN","C0CSUB1",73,0)
- . W "ERROR",!
-"RTN","C0CSUB1",74,0)
- . ZWR ZERR
-"RTN","C0CSUB1",75,0)
- . B
-"RTN","C0CSUB1",76,0)
- K C0CFDA
-"RTN","C0CSUB1",77,0)
- Q
-"RTN","C0CSUB1",78,0)
- ;
-"RTN","C0CSUB1",79,0)
-VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
-"RTN","C0CSUB1",80,0)
- ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
-"RTN","C0CSUB1",81,0)
- ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
-"RTN","C0CSUB1",82,0)
- ;
-"RTN","C0CSUB1",83,0)
- N ZCCRD,ZVARN,C0CFDA2
-"RTN","C0CSUB1",84,0)
- S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
-"RTN","C0CSUB1",85,0)
- S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
-"RTN","C0CSUB1",86,0)
- I ZVARN="" D  ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
-"RTN","C0CSUB1",87,0)
- . I '$D(ZTYP) D  Q  ; WON'T ADD A VARIABLE WITHOUT A TYPE
-"RTN","C0CSUB1",88,0)
- . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
-"RTN","C0CSUB1",89,0)
- . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
-"RTN","C0CSUB1",90,0)
- . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
-"RTN","C0CSUB1",91,0)
- . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
-"RTN","C0CSUB1",92,0)
- . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
-"RTN","C0CSUB1",93,0)
- . I $D(ZERR) D  ; LAYGO ERROR
-"RTN","C0CSUB1",94,0)
- . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
-"RTN","C0CSUB1",95,0)
- . E  D  ;
-"RTN","C0CSUB1",96,0)
- . . D CLEAN^DILF ; CLEAN UP
-"RTN","C0CSUB1",97,0)
- . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
-"RTN","C0CSUB1",98,0)
- . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
-"RTN","C0CSUB1",99,0)
- Q ZVARN
-"RTN","C0CSUB1",100,0)
- ;
-"RTN","C0CSUB1",101,0)
-SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
-"RTN","C0CSUB1",102,0)
- ; TO SET TO VALUE C0CSV.
-"RTN","C0CSUB1",103,0)
- ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
-"RTN","C0CSUB1",104,0)
- ; C0CSN,C0CSV ARE PASSED BY VALUE
-"RTN","C0CSUB1",105,0)
- ;
 "RTN","C0CSUB1",106,0)
- N C0CSI,C0CSJ
+ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
 "RTN","C0CSUB1",107,0)
- S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
 "RTN","C0CSUB1",108,0)
- S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
+ ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
 "RTN","C0CSUB1",109,0)
- S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
+ I '$D(ZTAB) S ZTAB="C0CA"
 "RTN","C0CSUB1",110,0)
- Q
+ N ZR
 "RTN","C0CSUB1",111,0)
-ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
+ I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
 "RTN","C0CSUB1",112,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
+ E  S ZR=""
 "RTN","C0CSUB1",113,0)
+ Q ZR
+"RTN","C0CSUB1",114,0)
+ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
+"RTN","C0CSUB1",115,0)
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
+"RTN","C0CSUB1",116,0)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CSUB1",114,0)
+"RTN","C0CSUB1",117,0)
  I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CSUB1",115,0)
+"RTN","C0CSUB1",118,0)
  N ZR
-"RTN","C0CSUB1",116,0)
- I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
-"RTN","C0CSUB1",117,0)
+"RTN","C0CSUB1",119,0)
+ I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
+"RTN","C0CSUB1",120,0)
  E  S ZR=""
-"RTN","C0CSUB1",118,0)
+"RTN","C0CSUB1",121,0)
  Q ZR
-"RTN","C0CSUB1",119,0)
-ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
-"RTN","C0CSUB1",120,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
-"RTN","C0CSUB1",121,0)
+"RTN","C0CSUB1",122,0)
+ ;
+"RTN","C0CSUB1",123,0)
+ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
+"RTN","C0CSUB1",124,0)
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
+"RTN","C0CSUB1",125,0)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CSUB1",122,0)
+"RTN","C0CSUB1",126,0)
  I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CSUB1",123,0)
+"RTN","C0CSUB1",127,0)
  N ZR
-"RTN","C0CSUB1",124,0)
- I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
-"RTN","C0CSUB1",125,0)
+"RTN","C0CSUB1",128,0)
+ I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
+"RTN","C0CSUB1",129,0)
  E  S ZR=""
-"RTN","C0CSUB1",126,0)
+"RTN","C0CSUB1",130,0)
  Q ZR
-"RTN","C0CSUB1",127,0)
- ;
-"RTN","C0CSUB1",128,0)
-ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
-"RTN","C0CSUB1",129,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
-"RTN","C0CSUB1",130,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
 "RTN","C0CSUB1",131,0)
- I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CSUB1",132,0)
- N ZR
-"RTN","C0CSUB1",133,0)
- I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
-"RTN","C0CSUB1",134,0)
- E  S ZR=""
-"RTN","C0CSUB1",135,0)
- Q ZR
-"RTN","C0CSUB1",136,0)
  ;
 "RTN","C0CSYS")
-0^56^B3933593
+0^56^B3817459
 "RTN","C0CSYS",1,0)
 C0CSYS ;WV/C0C/SMH - Routine to Get EHR System Information;6JUL2008
 "RTN","C0CSYS",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CSYS",3,0)
- ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ; Copyright 2008 WorldVistA.  
 "RTN","C0CSYS",4,0)
- ; General Public License See attached copy of the License.
+ ;
 "RTN","C0CSYS",5,0)
- ; 
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CSYS",6,0)
- ; This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CSYS",7,0)
- ; it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CSYS",8,0)
- ; the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CSYS",9,0)
- ; (at your option) any later version.
+ ;
 "RTN","C0CSYS",10,0)
- ; 
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CSYS",11,0)
- ; This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CSYS",12,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CSYS",13,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CSYS",14,0)
- ; GNU General Public License for more details.
+ ;
 "RTN","C0CSYS",15,0)
- ; 
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CSYS",16,0)
- ; You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CSYS",17,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CSYS",18,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ W "Enter at appropriate points." Q
 "RTN","C0CSYS",19,0)
  ;
 "RTN","C0CSYS",20,0)
- W "Enter at appropriate points." Q
+ ; Originally, I was going to use VEPERVER, but VEPERVER
 "RTN","C0CSYS",21,0)
- ;
+ ; actually kills ^TMP($J), outputs it to the screen in a user-friendly
 "RTN","C0CSYS",22,0)
- ; Originally, I was going to use VEPERVER, but VEPERVER
+ ; manner (press any key to continue),
 "RTN","C0CSYS",23,0)
- ; actually kills ^TMP($J), outputs it to the screen in a user-friendly
+ ; and is really a very half finished routine
 "RTN","C0CSYS",24,0)
- ; manner (press any key to continue),
+ ;
 "RTN","C0CSYS",25,0)
- ; and is really a very half finished routine
+ ; So for now, I am hard-coding the values.
 "RTN","C0CSYS",26,0)
  ;
 "RTN","C0CSYS",27,0)
- ; So for now, I am hard-coding the values.
+SYSNAME() ;Get EHR System Name; PUBLIC; Extrinsic
 "RTN","C0CSYS",28,0)
- ;
+ Q:$G(DUZ("AG"))="I" "RPMS"
 "RTN","C0CSYS",29,0)
-SYSNAME() ;Get EHR System Name; PUBLIC; Extrinsic
+ Q "WorldVistA EHR/VOE"
 "RTN","C0CSYS",30,0)
- Q:$G(DUZ("AG"))="I" "RPMS"
+ ;
 "RTN","C0CSYS",31,0)
- Q "WorldVistA EHR/VOE"
+SYSVER() ;Get EHR System Version; PUBLIC; Extrinsic
 "RTN","C0CSYS",32,0)
- ;
+ Q "1.0"
 "RTN","C0CSYS",33,0)
-SYSVER() ;Get EHR System Version; PUBLIC; Extrinsic
+ ;
 "RTN","C0CSYS",34,0)
- Q "1.0"
+PTST(DFN) ;TEST TO SEE IF PATIENT MERGED OR A TEST PATIENT
 "RTN","C0CSYS",35,0)
- ;
+  ; DFN = IEN of the Patient to be tested
 "RTN","C0CSYS",36,0)
-PTST(DFN) ;TEST TO SEE IF PATIENT MERGED OR A TEST PATIENT
+  ; 1 = Merged or Test Patient
 "RTN","C0CSYS",37,0)
-  ; DFN = IEN of the Patient to be tested
+  ; 0 = Non-test Patient
 "RTN","C0CSYS",38,0)
-  ; 1 = Merged or Test Patient
+  ;
 "RTN","C0CSYS",39,0)
+  I DFN="" Q 0  ; BAD DFN PASSED
+"RTN","C0CSYS",40,0)
+  I $D(^DPT(DFN,-9)) Q 1  ;This patient has been merged
+"RTN","C0CSYS",41,0)
+  I $G(^DPT(DFN,0))="" Q 1  ;Missing zeroth node <---add
+"RTN","C0CSYS",42,0)
+  ;
+"RTN","C0CSYS",43,0)
+  I '$D(CCRTEST) S CCRTEST=1 ; DEFAULT IS THAT WE ARE TESTING
+"RTN","C0CSYS",44,0)
+  I CCRTEST Q 0  ; IF WE ARE TESTING, DON'T REJECT TEST PATIENTS
+"RTN","C0CSYS",45,0)
+  N DIERR,DATA
+"RTN","C0CSYS",46,0)
+  I $$TESTPAT^VADPT(DFN) Q 1 ; QUIT IF IT'S A VA TEST PATIENT
+"RTN","C0CSYS",47,0)
+  S DATA=+$$GET1^DIQ(2,DFN_",",.6,"I") ;Test Patient Indicator
+"RTN","C0CSYS",48,0)
+  ; 1 = Test Patient
+"RTN","C0CSYS",49,0)
   ; 0 = Non-test Patient
-"RTN","C0CSYS",40,0)
-  ;
-"RTN","C0CSYS",41,0)
-  I DFN="" Q 0  ; BAD DFN PASSED
-"RTN","C0CSYS",42,0)
-  I $D(^DPT(DFN,-9)) Q 1  ;This patient has been merged
-"RTN","C0CSYS",43,0)
-  I $G(^DPT(DFN,0))="" Q 1  ;Missing zeroth node <---add
-"RTN","C0CSYS",44,0)
-  ;
-"RTN","C0CSYS",45,0)
-  I '$D(CCRTEST) S CCRTEST=1 ; DEFAULT IS THAT WE ARE TESTING
-"RTN","C0CSYS",46,0)
-  I CCRTEST Q 0  ; IF WE ARE TESTING, DON'T REJECT TEST PATIENTS
-"RTN","C0CSYS",47,0)
-  N DIERR,DATA
-"RTN","C0CSYS",48,0)
-  I $$TESTPAT^VADPT(DFN) Q 1 ; QUIT IF IT'S A VA TEST PATIENT
-"RTN","C0CSYS",49,0)
-  S DATA=+$$GET1^DIQ(2,DFN_",",.6,"I") ;Test Patient Indicator
 "RTN","C0CSYS",50,0)
-  ; 1 = Test Patient
+  I DATA Q DATA
 "RTN","C0CSYS",51,0)
-  ; 0 = Non-test Patient
+  S DATA=$$GET1^DIQ(2,DFN_",",.09,"I") ;SSN test
 "RTN","C0CSYS",52,0)
-  I DATA Q DATA
+  D CLEAN^DILF
 "RTN","C0CSYS",53,0)
-  S DATA=$$GET1^DIQ(2,DFN_",",.09,"I") ;SSN test
+  I "Pp"[$E(DATA,$L(DATA),$L(DATA)) Q 0  ;Allow Pseudo SSN
 "RTN","C0CSYS",54,0)
-  D CLEAN^DILF
+  I $E(DATA,1,3)="000" Q 1
 "RTN","C0CSYS",55,0)
-  I "Pp"[$E(DATA,$L(DATA),$L(DATA)) Q 0  ;Allow Pseudo SSN
+  I $E(DATA,1,3)="666" Q 1
 "RTN","C0CSYS",56,0)
-  I $E(DATA,1,3)="000" Q 1
+  Q 0
 "RTN","C0CSYS",57,0)
-  I $E(DATA,1,3)="666" Q 1
-"RTN","C0CSYS",58,0)
-  Q 0
-"RTN","C0CSYS",59,0)
   ;
 "RTN","C0CTIU")
-0^108^B62323461
+0^108^B68529284
 "RTN","C0CTIU",1,0)
 C0CTIU ; C0C/ELN - PROCESSING FOR TIU NOTES ; 19/10/2010
 "RTN","C0CTIU",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CTIU",3,0)
- ;
+ ; (C) ELN 2010
 "RTN","C0CTIU",4,0)
  ;
 "RTN","C0CTIU",5,0)
+ ; This program is free software: you can redistribute it and/or modify
+"RTN","C0CTIU",6,0)
+ ; it under the terms of the GNU Affero General Public License as
+"RTN","C0CTIU",7,0)
+ ; published by the Free Software Foundation, either version 3 of the
+"RTN","C0CTIU",8,0)
+ ; License, or (at your option) any later version.
+"RTN","C0CTIU",9,0)
+ ;
+"RTN","C0CTIU",10,0)
+ ; This program is distributed in the hope that it will be useful,
+"RTN","C0CTIU",11,0)
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","C0CTIU",12,0)
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","C0CTIU",13,0)
+ ; GNU Affero General Public License for more details.
+"RTN","C0CTIU",14,0)
+ ;
+"RTN","C0CTIU",15,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CTIU",16,0)
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+"RTN","C0CTIU",17,0)
+ ;
+"RTN","C0CTIU",18,0)
  ;ELN - Modified Routine of C0CLABS
-"RTN","C0CTIU",6,0)
+"RTN","C0CTIU",19,0)
 MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
-"RTN","C0CTIU",7,0)
+"RTN","C0CTIU",20,0)
  ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
-"RTN","C0CTIU",8,0)
+"RTN","C0CTIU",21,0)
  ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
-"RTN","C0CTIU",9,0)
+"RTN","C0CTIU",22,0)
  ; MIXML IS THE TEMPLATE TO USE
-"RTN","C0CTIU",10,0)
+"RTN","C0CTIU",23,0)
  ; MOXML IS THE OUTPUT XML ARRAY
-"RTN","C0CTIU",11,0)
+"RTN","C0CTIU",24,0)
  ; DFN IS THE PATIENT RECORD NUMBER
-"RTN","C0CTIU",12,0)
+"RTN","C0CTIU",25,0)
  N C0COXML,C0CO,C0CV,C0CIXML
-"RTN","C0CTIU",13,0)
+"RTN","C0CTIU",26,0)
  I '$D(MIVAR) S C0CV="" ;DEFAULT
-"RTN","C0CTIU",14,0)
+"RTN","C0CTIU",27,0)
  E  S C0CV=MIVAR ;PASSED VARIABLE ARRAY
-"RTN","C0CTIU",15,0)
+"RTN","C0CTIU",28,0)
  I '$D(MIXML) S C0CIXML="" ;DEFAULT
-"RTN","C0CTIU",16,0)
+"RTN","C0CTIU",29,0)
  E  S C0CIXML=MIXML ;PASSED INPUT XML
-"RTN","C0CTIU",17,0)
+"RTN","C0CTIU",30,0)
  D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
-"RTN","C0CTIU",18,0)
+"RTN","C0CTIU",31,0)
  I '$D(MOXML) D  Q
-"RTN","C0CTIU",19,0)
+"RTN","C0CTIU",32,0)
  . S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
-"RTN","C0CTIU",20,0)
+"RTN","C0CTIU",33,0)
  . M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
-"RTN","C0CTIU",21,0)
+"RTN","C0CTIU",34,0)
  E  D
-"RTN","C0CTIU",22,0)
+"RTN","C0CTIU",35,0)
  . N C0COOXML
-"RTN","C0CTIU",23,0)
+"RTN","C0CTIU",36,0)
  . S CCRGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR"))
-"RTN","C0CTIU",24,0)
+"RTN","C0CTIU",37,0)
  . D QUERY^C0CXPATH(CCRGLO,"//ContinuityOfCareRecord/Body/Results","C0CRSXML")
-"RTN","C0CTIU",25,0)
+"RTN","C0CTIU",38,0)
  . S C0COCNT=$O(C0CRSXML(""),-1)
-"RTN","C0CTIU",26,0)
+"RTN","C0CTIU",39,0)
  . S C0CRES=0
-"RTN","C0CTIU",27,0)
+"RTN","C0CTIU",40,0)
  . F  S C0CRES=$O(C0COXML(C0CRES)) Q:C0CRES=""  D
-"RTN","C0CTIU",28,0)
+"RTN","C0CTIU",41,0)
  . . Q:$G(C0COXML(C0CRES))="<Results>"!($G(C0COXML(C0CRES))="</Results>")
-"RTN","C0CTIU",29,0)
+"RTN","C0CTIU",42,0)
  . . S C0CRSXML(C0COCNT)=$G(C0COXML(C0CRES))
-"RTN","C0CTIU",30,0)
+"RTN","C0CTIU",43,0)
  . . S C0COCNT=C0COCNT+1
-"RTN","C0CTIU",31,0)
+"RTN","C0CTIU",44,0)
  . S C0CRSXML(C0COCNT)="</Results>"
-"RTN","C0CTIU",32,0)
+"RTN","C0CTIU",45,0)
  . S C0CRSXML(0)=C0COCNT
-"RTN","C0CTIU",33,0)
+"RTN","C0CTIU",46,0)
  . D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
-"RTN","C0CTIU",34,0)
+"RTN","C0CTIU",47,0)
  . D INSERT^C0CXPATH(CCRGLO,"C0CRSXML","//ContinuityOfCareRecord/Body")
-"RTN","C0CTIU",35,0)
- ;
-"RTN","C0CTIU",36,0)
+"RTN","C0CTIU",48,0)
+ ;
+"RTN","C0CTIU",49,0)
  S C0CO=MOXML,@C0CO@(0)=0
-"RTN","C0CTIU",37,0)
+"RTN","C0CTIU",50,0)
  K C0CRSXML,C0COCNT,C0COXML,C0CRES
-"RTN","C0CTIU",38,0)
+"RTN","C0CTIU",51,0)
  K C0CCNT
-"RTN","C0CTIU",39,0)
+"RTN","C0CTIU",52,0)
  Q
-"RTN","C0CTIU",40,0)
+"RTN","C0CTIU",53,0)
 RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS
-"RTN","C0CTIU",41,0)
+"RTN","C0CTIU",54,0)
  ; RTN IS PASSED BY REFERENCE
-"RTN","C0CTIU",42,0)
+"RTN","C0CTIU",55,0)
  N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
-"RTN","C0CTIU",43,0)
+"RTN","C0CTIU",56,0)
  N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
-"RTN","C0CTIU",44,0)
+"RTN","C0CTIU",57,0)
  I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
-"RTN","C0CTIU",45,0)
+"RTN","C0CTIU",58,0)
  I RMIXML="" D  ; INPUT XML NOT PASSED
-"RTN","C0CTIU",46,0)
+"RTN","C0CTIU",59,0)
  . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
-"RTN","C0CTIU",47,0)
+"RTN","C0CTIU",60,0)
  . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
-"RTN","C0CTIU",48,0)
+"RTN","C0CTIU",61,0)
  . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
-"RTN","C0CTIU",49,0)
+"RTN","C0CTIU",62,0)
  E  S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
-"RTN","C0CTIU",50,0)
+"RTN","C0CTIU",63,0)
  I RMIVAR="" D  ; LOCATION OF VARIABLES NOT PASSED
-"RTN","C0CTIU",51,0)
+"RTN","C0CTIU",64,0)
  . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
-"RTN","C0CTIU",52,0)
+"RTN","C0CTIU",65,0)
  E  S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
-"RTN","C0CTIU",53,0)
+"RTN","C0CTIU",66,0)
  D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
-"RTN","C0CTIU",54,0)
+"RTN","C0CTIU",67,0)
  D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
-"RTN","C0CTIU",55,0)
+"RTN","C0CTIU",68,0)
  D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
-"RTN","C0CTIU",56,0)
+"RTN","C0CTIU",69,0)
  D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT
-"RTN","C0CTIU",57,0)
+"RTN","C0CTIU",70,0)
  I '$D(@C0CV@(0)) D  Q  ; NO VARS THERE
-"RTN","C0CTIU",58,0)
+"RTN","C0CTIU",71,0)
  . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
-"RTN","C0CTIU",59,0)
+"RTN","C0CTIU",72,0)
  ; NO RESULTS QUIT
-"RTN","C0CTIU",60,0)
+"RTN","C0CTIU",73,0)
  I @C0CV@(0)=0 S RTN(0)=0 Q
-"RTN","C0CTIU",61,0)
+"RTN","C0CTIU",74,0)
  S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
-"RTN","C0CTIU",62,0)
+"RTN","C0CTIU",75,0)
  K @RIMVARS
-"RTN","C0CTIU",63,0)
+"RTN","C0CTIU",76,0)
  M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
-"RTN","C0CTIU",64,0)
+"RTN","C0CTIU",77,0)
  N C0CI,C0CIN,C0CJ,C0CJS,C0CJE,C0CJN,C0CMAP,C0CTMAP,C0CTMP
-"RTN","C0CTIU",65,0)
+"RTN","C0CTIU",78,0)
  S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
-"RTN","C0CTIU",66,0)
+"RTN","C0CTIU",79,0)
  N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
-"RTN","C0CTIU",67,0)
+"RTN","C0CTIU",80,0)
  N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
-"RTN","C0CTIU",68,0)
+"RTN","C0CTIU",81,0)
  N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
-"RTN","C0CTIU",69,0)
+"RTN","C0CTIU",82,0)
  ; TO IMPROVE PERFORMANCE
-"RTN","C0CTIU",70,0)
+"RTN","C0CTIU",83,0)
  D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
-"RTN","C0CTIU",71,0)
+"RTN","C0CTIU",84,0)
  F C0CI=1:1:C0CIN D  ; LOOP THROUGH VARIABLES
-"RTN","C0CTIU",72,0)
+"RTN","C0CTIU",85,0)
  . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
-"RTN","C0CTIU",73,0)
+"RTN","C0CTIU",86,0)
  . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
-"RTN","C0CTIU",74,0)
+"RTN","C0CTIU",87,0)
  . S C0CMAP=$NA(@C0CV@(C0CI)) ;
-"RTN","C0CTIU",75,0)
+"RTN","C0CTIU",88,0)
  . ;MAPPING FOR TEST REQUEST GOES HERE
-"RTN","C0CTIU",76,0)
+"RTN","C0CTIU",89,0)
  . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
-"RTN","C0CTIU",77,0)
+"RTN","C0CTIU",90,0)
  . ;D QOPEN^C0CXPATH("C0CRBLD",C0CRTMP,C0CIS) ;1ST PART OF XML
-"RTN","C0CTIU",78,0)
+"RTN","C0CTIU",91,0)
  . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
-"RTN","C0CTIU",79,0)
+"RTN","C0CTIU",92,0)
  . I $D(@C0CMAP@("M","TEST",0)) D  ; TESTS EXIST
-"RTN","C0CTIU",80,0)
+"RTN","C0CTIU",93,0)
  . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
-"RTN","C0CTIU",81,0)
+"RTN","C0CTIU",94,0)
  . . K C0CTO ; CLEAR OUTPUT VARIABLE
-"RTN","C0CTIU",82,0)
+"RTN","C0CTIU",95,0)
  . . F C0CJ=1:1:C0CJN D   ;FOR EACH TEST RESULT
-"RTN","C0CTIU",83,0)
+"RTN","C0CTIU",96,0)
  . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
-"RTN","C0CTIU",84,0)
+"RTN","C0CTIU",97,0)
  . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
-"RTN","C0CTIU",85,0)
+"RTN","C0CTIU",98,0)
  . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
-"RTN","C0CTIU",86,0)
+"RTN","C0CTIU",99,0)
  . . . D XMAP^C0CTIU1("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
-"RTN","C0CTIU",87,0)
+"RTN","C0CTIU",100,0)
  . . . I C0CJ=1 S C0CJS=2 E  S C0CJS=1 ;FIRST TIME,SKIP THE <Test>
-"RTN","C0CTIU",88,0)
+"RTN","C0CTIU",101,0)
  . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E  S C0CJE=@C0CTMP@(0) ;</Test>
-"RTN","C0CTIU",89,0)
+"RTN","C0CTIU",102,0)
  . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
-"RTN","C0CTIU",90,0)
+"RTN","C0CTIU",103,0)
  . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
-"RTN","C0CTIU",91,0)
+"RTN","C0CTIU",104,0)
  . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
-"RTN","C0CTIU",92,0)
+"RTN","C0CTIU",105,0)
  D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
-"RTN","C0CTIU",93,0)
+"RTN","C0CTIU",106,0)
  D BUILD^C0CTIU1("C0CRBLD","RTN") ;RENDER THE XML
-"RTN","C0CTIU",94,0)
+"RTN","C0CTIU",107,0)
  K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
-"RTN","C0CTIU",95,0)
+"RTN","C0CTIU",108,0)
  Q
-"RTN","C0CTIU",96,0)
- ;
-"RTN","C0CTIU",97,0)
- ;
-"RTN","C0CTIU",98,0)
+"RTN","C0CTIU",109,0)
+ ;
+"RTN","C0CTIU",110,0)
+ ;
+"RTN","C0CTIU",111,0)
 EXTRACT(ILXML,DFN,OLXML) ; EXTRACT TIU NOTES INTO THE C0CLVAR GLOBAL
-"RTN","C0CTIU",99,0)
- ;
-"RTN","C0CTIU",100,0)
+"RTN","C0CTIU",112,0)
+ ;
+"RTN","C0CTIU",113,0)
  S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
-"RTN","C0CTIU",101,0)
+"RTN","C0CTIU",114,0)
  D DT^DILF(,$$GET^C0CPARMS("TIULIMIT"),.C0CTSDT)
-"RTN","C0CTIU",102,0)
+"RTN","C0CTIU",115,0)
  D DT^DILF(,$$GET^C0CPARMS("TIUSTART"),.C0CTEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
-"RTN","C0CTIU",103,0)
- ;
-"RTN","C0CTIU",104,0)
+"RTN","C0CTIU",116,0)
+ ;
+"RTN","C0CTIU",117,0)
  S TIUIEN=0,TIUCNT=1
-"RTN","C0CTIU",105,0)
+"RTN","C0CTIU",118,0)
  F  S TIUIEN=$O(^TIU(8925,"C",DFN,TIUIEN)) Q:TIUIEN=""  D
-"RTN","C0CTIU",106,0)
+"RTN","C0CTIU",119,0)
  . S TIUY="",TIUDA=TIUIEN,ACTION="VIEW",U="^"
-"RTN","C0CTIU",107,0)
+"RTN","C0CTIU",120,0)
  . ;SELECT ONLY COMPLETED NOTES
-"RTN","C0CTIU",108,0)
+"RTN","C0CTIU",121,0)
  . Q:$P(^TIU(8925,TIUIEN,0),U,5)=""
-"RTN","C0CTIU",109,0)
+"RTN","C0CTIU",122,0)
  . Q:$P(^TIU(8925.6,$P(^TIU(8925,TIUIEN,0),U,5),0),U)'="COMPLETED"
-"RTN","C0CTIU",110,0)
+"RTN","C0CTIU",123,0)
  . ;VALIDATE ON SIGNATURE DATE #1501
-"RTN","C0CTIU",111,0)
+"RTN","C0CTIU",124,0)
  . Q:$P(^TIU(8925,TIUIEN,15),U)<C0CTSDT!($P(^TIU(8925,TIUIEN,15),U)>C0CTEDT)
-"RTN","C0CTIU",112,0)
+"RTN","C0CTIU",125,0)
  . D TGET(TIUY,TIUIEN,ACTION,TIUCNT)
-"RTN","C0CTIU",113,0)
+"RTN","C0CTIU",126,0)
  . S TIUCNT=TIUCNT+1
-"RTN","C0CTIU",114,0)
+"RTN","C0CTIU",127,0)
  ;ELN K @C0CLB ; CLEAR OUT OLD VARS IF ANY
-"RTN","C0CTIU",115,0)
+"RTN","C0CTIU",128,0)
  N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG
-"RTN","C0CTIU",116,0)
+"RTN","C0CTIU",129,0)
  S C0CQT=1 ; SURPRESS LISTING
-"RTN","C0CTIU",117,0)
+"RTN","C0CTIU",130,0)
  D LIST ; EXTRACT THE VARIABLES
-"RTN","C0CTIU",118,0)
+"RTN","C0CTIU",131,0)
  K ^TMP("C0CTIU",$J),TIUIEN,TIUCNT,TIUDA,TIUY,C0CLB,C0CTSDT,C0CTEDT
-"RTN","C0CTIU",119,0)
+"RTN","C0CTIU",132,0)
  S C0CQT=QTSAV ; RESET SILENT FLAG
-"RTN","C0CTIU",120,0)
+"RTN","C0CTIU",133,0)
  I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
-"RTN","C0CTIU",121,0)
+"RTN","C0CTIU",134,0)
  Q
-"RTN","C0CTIU",122,0)
+"RTN","C0CTIU",135,0)
  ;REUSING from ^TIUSRVR2
-"RTN","C0CTIU",123,0)
+"RTN","C0CTIU",136,0)
 TGET(TIUY,TIUDA,ACTION,TIUCNT) ; Build ^TMP("TIUVIEW",$J,
-"RTN","C0CTIU",124,0)
+"RTN","C0CTIU",137,0)
  N TIUL,TIUREC,TIUARR,TIUGDATA,TIUNAME,TIUPRM0,TIUPRM1,X,Y,TIUCPF,ONBROWSE
-"RTN","C0CTIU",125,0)
+"RTN","C0CTIU",138,0)
  K ^TMP("TIUVIEW",$J),^TMP("TIU FOCUS",$J)
-"RTN","C0CTIU",126,0)
+"RTN","C0CTIU",139,0)
  S C0CTIU=$NA(^TMP("C0CTIU",$J,TIUCNT))
-"RTN","C0CTIU",127,0)
+"RTN","C0CTIU",140,0)
  S ACTION=$G(ACTION,"VIEW"),TIUL=0
-"RTN","C0CTIU",128,0)
+"RTN","C0CTIU",141,0)
  D SETPARM^TIULE
-"RTN","C0CTIU",129,0)
+"RTN","C0CTIU",142,0)
  S TIUGDATA=$$SETGDATA^TIUSRVR1(TIUDA)
-"RTN","C0CTIU",130,0)
+"RTN","C0CTIU",143,0)
  S TIUY=$NA(^TMP("TIUVIEW",$J))
-"RTN","C0CTIU",131,0)
+"RTN","C0CTIU",144,0)
  S TIUARR="^TMP(""TIUVIEW"",$J)"
-"RTN","C0CTIU",132,0)
+"RTN","C0CTIU",145,0)
  I '$D(^TIU(8925,+TIUDA,0)) Q
-"RTN","C0CTIU",133,0)
+"RTN","C0CTIU",146,0)
  ; Initialize ^TMP("TIU FOCUS",$J) to the entry that has focus
-"RTN","C0CTIU",134,0)
+"RTN","C0CTIU",147,0)
  S ^TMP("TIU FOCUS",$J)=TIUDA
-"RTN","C0CTIU",135,0)
+"RTN","C0CTIU",148,0)
  ; Call INQUIRE to get record
-"RTN","C0CTIU",136,0)
+"RTN","C0CTIU",149,0)
  ;Set a flag to indicate whether or not a Title is a memer of the
-"RTN","C0CTIU",137,0)
+"RTN","C0CTIU",150,0)
  ;Clinical Procedures Class (1=Yes and 0=No)
-"RTN","C0CTIU",138,0)
+"RTN","C0CTIU",151,0)
  S TIUCPF=+$$ISA^TIULX(+$G(^TIU(8925,TIUDA,0)),+$$CLASS^TIUCP)
-"RTN","C0CTIU",139,0)
+"RTN","C0CTIU",152,0)
  ; Call INQUIRE to get record
-"RTN","C0CTIU",140,0)
+"RTN","C0CTIU",153,0)
  D INQUIRE^TIUSRVR2(TIUDA,.TIUREC,TIUCPF)
-"RTN","C0CTIU",141,0)
+"RTN","C0CTIU",154,0)
  ; First, load dictation, transcription data, etc.
-"RTN","C0CTIU",142,0)
+"RTN","C0CTIU",155,0)
  ;D LOADTOP^TIUSRVR1(.TIUREC,TIUDA,.TIUL,TIUGDATA,TIUCPF)
-"RTN","C0CTIU",143,0)
+"RTN","C0CTIU",156,0)
  ; Next, load the remainder of the record
-"RTN","C0CTIU",144,0)
+"RTN","C0CTIU",157,0)
  D LOADREC^TIUSRVR2(TIUDA,.TIUL,TIUGDATA,0,ACTION)
-"RTN","C0CTIU",145,0)
+"RTN","C0CTIU",158,0)
  K ^TMP("TIU FOCUS",$J)
-"RTN","C0CTIU",146,0)
+"RTN","C0CTIU",159,0)
  ;S VALMCNT=+$G(TIUL)
-"RTN","C0CTIU",147,0)
+"RTN","C0CTIU",160,0)
  M @C0CTIU@("TIUREC")=TIUREC(8925,TIUDA)
-"RTN","C0CTIU",148,0)
+"RTN","C0CTIU",161,0)
  M @C0CTIU@("TIUTEXT")=@TIUY
-"RTN","C0CTIU",149,0)
+"RTN","C0CTIU",162,0)
  K ^TMP("TIUVEW",$J)
-"RTN","C0CTIU",150,0)
- Q
-"RTN","C0CTIU",151,0)
-LIST ;EXTRACT THE RESULT VARIABLES TO C0CLB
-"RTN","C0CTIU",152,0)
- ;
-"RTN","C0CTIU",153,0)
- ;N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR
-"RTN","C0CTIU",154,0)
- I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
-"RTN","C0CTIU",155,0)
- I '$D(C0CQT) S C0CQT=0
-"RTN","C0CTIU",156,0)
- I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
-"RTN","C0CTIU",157,0)
- S C0CI=""
-"RTN","C0CTIU",158,0)
- S @C0CLB@(0)=$O(^TMP("C0CCCR",$J,"RESULTS",""),-1) ; INITALIZE RESULTS VARS COUNT
-"RTN","C0CTIU",159,0)
- S C0CCNT=0,C0CTIU=$NA(^TMP("C0CTIU",$J))
-"RTN","C0CTIU",160,0)
- F  S C0CCNT=$O(@C0CTIU@(C0CCNT)) Q:C0CCNT=""  D
-"RTN","C0CTIU",161,0)
- . D C0CRES,C0CTRES
-"RTN","C0CTIU",162,0)
- K C0CCNT,C0CTIU,C0CI,C0CLI,C0CX1
 "RTN","C0CTIU",163,0)
  Q
 "RTN","C0CTIU",164,0)
+LIST ;EXTRACT THE RESULT VARIABLES TO C0CLB
+"RTN","C0CTIU",165,0)
+ ;
+"RTN","C0CTIU",166,0)
+ ;N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR
+"RTN","C0CTIU",167,0)
+ I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
+"RTN","C0CTIU",168,0)
+ I '$D(C0CQT) S C0CQT=0
+"RTN","C0CTIU",169,0)
+ I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
+"RTN","C0CTIU",170,0)
+ S C0CI=""
+"RTN","C0CTIU",171,0)
+ S @C0CLB@(0)=$O(^TMP("C0CCCR",$J,"RESULTS",""),-1) ; INITALIZE RESULTS VARS COUNT
+"RTN","C0CTIU",172,0)
+ S C0CCNT=0,C0CTIU=$NA(^TMP("C0CTIU",$J))
+"RTN","C0CTIU",173,0)
+ F  S C0CCNT=$O(@C0CTIU@(C0CCNT)) Q:C0CCNT=""  D
+"RTN","C0CTIU",174,0)
+ . D C0CRES,C0CTRES
+"RTN","C0CTIU",175,0)
+ K C0CCNT,C0CTIU,C0CI,C0CLI,C0CX1
+"RTN","C0CTIU",176,0)
+ Q
+"RTN","C0CTIU",177,0)
 C0CRES ;SET TITLE NAME PART EQUIVALENT TO TEST NAME PART
-"RTN","C0CTIU",165,0)
+"RTN","C0CTIU",178,0)
  N XV
-"RTN","C0CTIU",166,0)
+"RTN","C0CTIU",179,0)
  S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
-"RTN","C0CTIU",167,0)
+"RTN","C0CTIU",180,0)
  S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
-"RTN","C0CTIU",168,0)
+"RTN","C0CTIU",181,0)
  S XV("RESULTOBJECTID")="RESULT_"_C0CLI
-"RTN","C0CTIU",169,0)
+"RTN","C0CTIU",182,0)
  S C0CX1=$G(@C0CTIU@(C0CCNT,"TIUREC",1502))
-"RTN","C0CTIU",170,0)
+"RTN","C0CTIU",183,0)
  S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$O(^VA(200,"B",$G(C0CX1),0))
-"RTN","C0CTIU",171,0)
+"RTN","C0CTIU",184,0)
  S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL($$C0CDATE^C0CTIU1($G(@C0CTIU@(C0CCNT,"TIUREC",1501))),"DT")
-"RTN","C0CTIU",172,0)
+"RTN","C0CTIU",185,0)
  S XV("RESULTCODE")=""
-"RTN","C0CTIU",173,0)
+"RTN","C0CTIU",186,0)
  S XV("RESULTCODINGSYSTEM")=""
-"RTN","C0CTIU",174,0)
+"RTN","C0CTIU",187,0)
  S XV("RESULTSTATUS")="COMPLETED"
-"RTN","C0CTIU",175,0)
+"RTN","C0CTIU",188,0)
  S XV("RESULTDESCRIPTIONTEXT")="Progress Notes"
-"RTN","C0CTIU",176,0)
+"RTN","C0CTIU",189,0)
  M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
-"RTN","C0CTIU",177,0)
+"RTN","C0CTIU",190,0)
  Q
-"RTN","C0CTIU",178,0)
+"RTN","C0CTIU",191,0)
 C0CTRES ;SET REPORT TEXT PART EQUIVALENT TO RESULT
-"RTN","C0CTIU",179,0)
+"RTN","C0CTIU",192,0)
  N XV,C0CLOBX,C0CZG,C0CLB2
-"RTN","C0CTIU",180,0)
+"RTN","C0CTIU",193,0)
  S C0CLOBX=0
-"RTN","C0CTIU",181,0)
+"RTN","C0CTIU",194,0)
  S XV("RESULTTESTCODEVALUE")=$G(@C0CTIU@(C0CCNT,"TIUREC",.01))
-"RTN","C0CTIU",182,0)
+"RTN","C0CTIU",195,0)
  S XV("RESULTTESTCODINGSYSTEM")=""
-"RTN","C0CTIU",183,0)
+"RTN","C0CTIU",196,0)
  S XV("RESULTTESTDESCRIPTIONTEXT")=$G(@C0CTIU@(C0CCNT,"TIUREC",.01)) ; DESCRIPTION TEXT
-"RTN","C0CTIU",184,0)
+"RTN","C0CTIU",197,0)
  S C0CZG=""
-"RTN","C0CTIU",185,0)
+"RTN","C0CTIU",198,0)
  S XV("RESULTTESTVALUE")="Notes"
-"RTN","C0CTIU",186,0)
+"RTN","C0CTIU",199,0)
  M XV("RESULTTESTVALUE","WP")=@C0CTIU@(C0CCNT,"TIUTEXT")
-"RTN","C0CTIU",187,0)
+"RTN","C0CTIU",200,0)
  S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
-"RTN","C0CTIU",188,0)
+"RTN","C0CTIU",201,0)
  S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
-"RTN","C0CTIU",189,0)
+"RTN","C0CTIU",202,0)
  S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
-"RTN","C0CTIU",190,0)
+"RTN","C0CTIU",203,0)
  S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
-"RTN","C0CTIU",191,0)
+"RTN","C0CTIU",204,0)
  S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_$O(^VA(200,$O(^VA(200,"B",$G(C0CX1),0)),2,0))
-"RTN","C0CTIU",192,0)
+"RTN","C0CTIU",205,0)
  S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
-"RTN","C0CTIU",193,0)
+"RTN","C0CTIU",206,0)
  S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL($$C0CDATE^C0CTIU1($G(@C0CTIU@(C0CCNT,"TIUREC",1501))),"DT")
-"RTN","C0CTIU",194,0)
+"RTN","C0CTIU",207,0)
  S XV("RESULTTESTUNITS")=""
-"RTN","C0CTIU",195,0)
+"RTN","C0CTIU",208,0)
  S XV("RESULTTESTFLAG")=""
-"RTN","C0CTIU",196,0)
+"RTN","C0CTIU",209,0)
  S XV("RESULTTESTSTATUSTEXT")=""
-"RTN","C0CTIU",197,0)
+"RTN","C0CTIU",210,0)
  S XV("RESULTTESTNORMALDESCTEXT")=""
-"RTN","C0CTIU",198,0)
+"RTN","C0CTIU",211,0)
  M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
-"RTN","C0CTIU",199,0)
+"RTN","C0CTIU",212,0)
  Q
 "RTN","C0CTIU1")
-0^109^B10596577
+0^109^B12758077
 "RTN","C0CTIU1",1,0)
 C0CTIU1 ; C0C/ELN - PROCESSING FOR TIU NOTES Contd. ; 19/10/2010
 "RTN","C0CTIU1",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CTIU1",3,0)
  ;ELN UTILITY PROGRAM TO SUPPORT C0CTIU
 "RTN","C0CTIU1",4,0)
+ ; (C) ELN 2010. 
+"RTN","C0CTIU1",5,0)
+ ;
+"RTN","C0CTIU1",6,0)
+ ; This program is free software: you can redistribute it and/or modify
+"RTN","C0CTIU1",7,0)
+ ; it under the terms of the GNU Affero General Public License as
+"RTN","C0CTIU1",8,0)
+ ; published by the Free Software Foundation, either version 3 of the
+"RTN","C0CTIU1",9,0)
+ ; License, or (at your option) any later version.
+"RTN","C0CTIU1",10,0)
+ ;
+"RTN","C0CTIU1",11,0)
+ ; This program is distributed in the hope that it will be useful,
+"RTN","C0CTIU1",12,0)
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","C0CTIU1",13,0)
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","C0CTIU1",14,0)
+ ; GNU Affero General Public License for more details.
+"RTN","C0CTIU1",15,0)
+ ;
+"RTN","C0CTIU1",16,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CTIU1",17,0)
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+"RTN","C0CTIU1",18,0)
+ ;
+"RTN","C0CTIU1",19,0)
 C0CDATE(EDTE) ; Converts external date to internal date format
-"RTN","C0CTIU1",5,0)
+"RTN","C0CTIU1",20,0)
  ; INPUT : EXTERNAL DATE (TIME IS OPTIONAL)
-"RTN","C0CTIU1",6,0)
+"RTN","C0CTIU1",21,0)
  ; OUTOUT: INTERNAL DATE, STORAGE FORMAT YYYMMMDD
-"RTN","C0CTIU1",7,0)
+"RTN","C0CTIU1",22,0)
  ; (TIME WILL BE RETURNED IF INCLUDED WITH INPUT)
-"RTN","C0CTIU1",8,0)
- ;
-"RTN","C0CTIU1",9,0)
+"RTN","C0CTIU1",23,0)
+ ;
+"RTN","C0CTIU1",24,0)
  Q:'$D(EDTE) -1
-"RTN","C0CTIU1",10,0)
+"RTN","C0CTIU1",25,0)
  N X,%DT,Y
-"RTN","C0CTIU1",11,0)
+"RTN","C0CTIU1",26,0)
  S X=EDTE
-"RTN","C0CTIU1",12,0)
+"RTN","C0CTIU1",27,0)
  S %DT="TS"
-"RTN","C0CTIU1",13,0)
+"RTN","C0CTIU1",28,0)
  D ^%DT
-"RTN","C0CTIU1",14,0)
+"RTN","C0CTIU1",29,0)
  Q Y
-"RTN","C0CTIU1",15,0)
- ;
-"RTN","C0CTIU1",16,0)
+"RTN","C0CTIU1",30,0)
+ ;
+"RTN","C0CTIU1",31,0)
 XMAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
-"RTN","C0CTIU1",17,0)
+"RTN","C0CTIU1",32,0)
  ; AND PUT THE RESULTS IN OXML
-"RTN","C0CTIU1",18,0)
+"RTN","C0CTIU1",33,0)
  N XCNT
-"RTN","C0CTIU1",19,0)
+"RTN","C0CTIU1",34,0)
  I '$D(DEBUG) S DEBUG=0
-"RTN","C0CTIU1",20,0)
+"RTN","C0CTIU1",35,0)
  I '$D(IXML) W "MALFORMED XML PASSED TO MAP",! Q
-"RTN","C0CTIU1",21,0)
+"RTN","C0CTIU1",36,0)
  I '$D(@IXML@(0)) D  ; INITIALIZE COUNT
-"RTN","C0CTIU1",22,0)
+"RTN","C0CTIU1",37,0)
  . S XCNT=$O(@IXML@(""),-1)
-"RTN","C0CTIU1",23,0)
+"RTN","C0CTIU1",38,0)
  E  S XCNT=@IXML@(0) ;COUNT
-"RTN","C0CTIU1",24,0)
+"RTN","C0CTIU1",39,0)
  I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
-"RTN","C0CTIU1",25,0)
- ;
-"RTN","C0CTIU1",26,0)
+"RTN","C0CTIU1",40,0)
+ ;
+"RTN","C0CTIU1",41,0)
  N I,J,TNAM,TVAL,TSTR
-"RTN","C0CTIU1",27,0)
+"RTN","C0CTIU1",42,0)
  S @OXML@(0)=XCNT ; TOTAL LINES IN OUTPUT
-"RTN","C0CTIU1",28,0)
+"RTN","C0CTIU1",43,0)
  F I=1:1:XCNT  D   ; LOOP THROUGH WHOLE ARRAY
-"RTN","C0CTIU1",29,0)
+"RTN","C0CTIU1",44,0)
  . S @OXML@(I)=@IXML@(I),C0CSLFLG=0 ; COPY THE LINE TO OUTPUT
-"RTN","C0CTIU1",30,0)
+"RTN","C0CTIU1",45,0)
  . I @OXML@(I)?.E1"@@".E D  ; IS THERE A VARIABLE HERE?
-"RTN","C0CTIU1",31,0)
+"RTN","C0CTIU1",46,0)
  . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
-"RTN","C0CTIU1",32,0)
+"RTN","C0CTIU1",47,0)
  . . F J=2:2:10  D  Q:$P(@IXML@(I),"@@",J+2)=""  ; QUIT IF NO MORE VARS
-"RTN","C0CTIU1",33,0)
+"RTN","C0CTIU1",48,0)
  . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,! H 1
-"RTN","C0CTIU1",34,0)
+"RTN","C0CTIU1",49,0)
  . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
-"RTN","C0CTIU1",35,0)
+"RTN","C0CTIU1",50,0)
  . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
-"RTN","C0CTIU1",36,0)
+"RTN","C0CTIU1",51,0)
  . . . I $D(@INARY@(TNAM))  D  ; IS THE VARIABLE IN THE MAP?
-"RTN","C0CTIU1",37,0)
+"RTN","C0CTIU1",52,0)
  . . . . I $D(@INARY@(TNAM,"WP")) D  Q
-"RTN","C0CTIU1",38,0)
+"RTN","C0CTIU1",53,0)
  . . . . . D DOWPFLD(I,J)
-"RTN","C0CTIU1",39,0)
+"RTN","C0CTIU1",54,0)
  . . . . I '$D(@INARY@(TNAM,"F")) D  ; NOT A SPECIAL FIELD
-"RTN","C0CTIU1",40,0)
+"RTN","C0CTIU1",55,0)
  . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
-"RTN","C0CTIU1",41,0)
+"RTN","C0CTIU1",56,0)
  . . . . E  D DOFLD() ; PROCESS A FIELD ELAN
-"RTN","C0CTIU1",42,0)
+"RTN","C0CTIU1",57,0)
  . . . S TVAL=$$SYMENC^MXMLUTL(TVAL) ;MAKE SURE THE VALUE IS XML SAFE
-"RTN","C0CTIU1",43,0)
+"RTN","C0CTIU1",58,0)
  . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
-"RTN","C0CTIU1",44,0)
+"RTN","C0CTIU1",59,0)
  . . I $G(C0CSLFLG)=1 M @OXML@(I)=TSTR Q
-"RTN","C0CTIU1",45,0)
+"RTN","C0CTIU1",60,0)
  . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
-"RTN","C0CTIU1",46,0)
+"RTN","C0CTIU1",61,0)
  . . I DEBUG W TSTR H 1
-"RTN","C0CTIU1",47,0)
+"RTN","C0CTIU1",62,0)
  I DEBUG W "MAPPED",!
-"RTN","C0CTIU1",48,0)
+"RTN","C0CTIU1",63,0)
  K C0CSLFLG
-"RTN","C0CTIU1",49,0)
+"RTN","C0CTIU1",64,0)
  Q
-"RTN","C0CTIU1",50,0)
+"RTN","C0CTIU1",65,0)
 DOWPFLD(I,J) ;WORDPROCESSING FIELD MANIPULATION
-"RTN","C0CTIU1",51,0)
+"RTN","C0CTIU1",66,0)
  N C0CTXCNT
-"RTN","C0CTIU1",52,0)
+"RTN","C0CTIU1",67,0)
  S C0CTXCNT=0
-"RTN","C0CTIU1",53,0)
+"RTN","C0CTIU1",68,0)
  F  S C0CTXCNT=$O(@INARY@(TNAM,"WP",C0CTXCNT)) Q:C0CTXCNT=""  D
-"RTN","C0CTIU1",54,0)
+"RTN","C0CTIU1",69,0)
  . S TSTR(C0CTXCNT)=TSTR_$G(@INARY@(TNAM,"WP",C0CTXCNT))_$P(@IXML@(I),"@@",J+1)
-"RTN","C0CTIU1",55,0)
+"RTN","C0CTIU1",70,0)
  S C0CSLFLG=1
-"RTN","C0CTIU1",56,0)
+"RTN","C0CTIU1",71,0)
  Q
-"RTN","C0CTIU1",57,0)
+"RTN","C0CTIU1",72,0)
 DOFLD() ;QUIT
-"RTN","C0CTIU1",58,0)
+"RTN","C0CTIU1",73,0)
  Q
-"RTN","C0CTIU1",59,0)
+"RTN","C0CTIU1",74,0)
 BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
-"RTN","C0CTIU1",60,0)
+"RTN","C0CTIU1",75,0)
  ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
-"RTN","C0CTIU1",61,0)
+"RTN","C0CTIU1",76,0)
  ; DEST IS CLEARED TO START
-"RTN","C0CTIU1",62,0)
+"RTN","C0CTIU1",77,0)
  ; USES PUSH TO DO THE COPY
-"RTN","C0CTIU1",63,0)
+"RTN","C0CTIU1",78,0)
  N I,WPSEQ
-"RTN","C0CTIU1",64,0)
+"RTN","C0CTIU1",79,0)
  K @BDEST
-"RTN","C0CTIU1",65,0)
+"RTN","C0CTIU1",80,0)
  F I=1:1:@BLIST@(0) D  ; FOR EACH INSTRUCTION IN BLIST
-"RTN","C0CTIU1",66,0)
+"RTN","C0CTIU1",81,0)
  . N J,ATMP
-"RTN","C0CTIU1",67,0)
+"RTN","C0CTIU1",82,0)
  . S ATMP=$$ARRAY^C0CXPATH(@BLIST@(I))
-"RTN","C0CTIU1",68,0)
+"RTN","C0CTIU1",83,0)
  . I $G(DEBUG) W "ATMP=",ATMP,!
-"RTN","C0CTIU1",69,0)
+"RTN","C0CTIU1",84,0)
  . I $G(DEBUG) W @BLIST@(I),!
-"RTN","C0CTIU1",70,0)
+"RTN","C0CTIU1",85,0)
  . F J=$$START^C0CXPATH(@BLIST@(I)):1:$$FINISH^C0CXPATH(@BLIST@(I)) D  ;
-"RTN","C0CTIU1",71,0)
+"RTN","C0CTIU1",86,0)
  . . ; FOR EACH LINE IN THIS INSTR
-"RTN","C0CTIU1",72,0)
+"RTN","C0CTIU1",87,0)
  . . I $G(DEBUG) W "BDEST= ",BDEST,!
-"RTN","C0CTIU1",73,0)
+"RTN","C0CTIU1",88,0)
  . . I $G(DEBUG) W "ATMP= ",@ATMP@(J),!
-"RTN","C0CTIU1",74,0)
+"RTN","C0CTIU1",89,0)
  . . I $D(@ATMP@(J,1)),$G(@ATMP@(J))="<Value>@@RESULTTESTVALUE@@</Value>" D  Q
-"RTN","C0CTIU1",75,0)
+"RTN","C0CTIU1",90,0)
  . . . S WPSEQ=0
-"RTN","C0CTIU1",76,0)
+"RTN","C0CTIU1",91,0)
  . . . D PUSH^C0CXPATH(BDEST,"<Value>")
-"RTN","C0CTIU1",77,0)
+"RTN","C0CTIU1",92,0)
  . . . F  S WPSEQ=$O(@ATMP@(J,WPSEQ)) Q:WPSEQ=""  D
-"RTN","C0CTIU1",78,0)
+"RTN","C0CTIU1",93,0)
  . . . . D PUSH^C0CXPATH(BDEST,$$SYMENC^MXMLUTL($$XVAL^C0CXPATH(@ATMP@(J,WPSEQ)))_"&#x0A;")
-"RTN","C0CTIU1",79,0)
+"RTN","C0CTIU1",94,0)
  . . . D PUSH^C0CXPATH(BDEST,"</Value>")
-"RTN","C0CTIU1",80,0)
+"RTN","C0CTIU1",95,0)
  . . D PUSH^C0CXPATH(BDEST,@ATMP@(J))
-"RTN","C0CTIU1",81,0)
+"RTN","C0CTIU1",96,0)
  Q
 "RTN","C0CUNIT")
-0^37^B43465566
+0^37^B33370246
 "RTN","C0CUNIT",1,0)
 C0CUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
 "RTN","C0CUNIT",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CUNIT",3,0)
- ;Copyright 2008 George Lilly. Licensed under the terms of the GNU
+ ;Copyright 2008 George Lilly. 
 "RTN","C0CUNIT",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CUNIT",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CUNIT",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CUNIT",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CUNIT",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CUNIT",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CUNIT",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CUNIT",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CUNIT",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CUNIT",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CUNIT",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CUNIT",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CUNIT",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CUNIT",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CUNIT",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ W "This is a unit testing library",!
 "RTN","C0CUNIT",19,0)
- ;
+ W !
 "RTN","C0CUNIT",20,0)
-          W "This is a unit testing library",!
+ Q
 "RTN","C0CUNIT",21,0)
-          W !
+ ;
 "RTN","C0CUNIT",22,0)
-          Q
+ZT(ZARY,BAT,TST) ; private routine to add a test case to the ZARY array
 "RTN","C0CUNIT",23,0)
-          ;
+ ; ZARY IS PASSED BY REFERENCE
 "RTN","C0CUNIT",24,0)
-ZT(ZARY,BAT,TST) ; private routine to add a test case to the ZARY array
+ ; BAT is a string identifying the test battery
 "RTN","C0CUNIT",25,0)
-          ; ZARY IS PASSED BY REFERENCE
+ ; TST is a test which will evaluate to true or false
 "RTN","C0CUNIT",26,0)
-          ; BAT is a string identifying the test battery
+ ; I '$G(ZARY) D
 "RTN","C0CUNIT",27,0)
-          ; TST is a test which will evaluate to true or false
+ ; . S ZARY(0)=0 ; initially there are no elements
 "RTN","C0CUNIT",28,0)
-          ; I '$G(ZARY) D
+ ; W "GOT HERE LOADING "_TST,!
 "RTN","C0CUNIT",29,0)
-          ; . S ZARY(0)=0 ; initially there are no elements
+ N CNT ; count of array elements
 "RTN","C0CUNIT",30,0)
-          ; W "GOT HERE LOADING "_TST,!
+ S CNT=ZARY(0) ; contains array count
 "RTN","C0CUNIT",31,0)
-          N CNT ; count of array elements
+ S CNT=CNT+1 ; increment count
 "RTN","C0CUNIT",32,0)
-          S CNT=ZARY(0) ; contains array count
+ S ZARY(CNT)=TST ; put the test in the array
 "RTN","C0CUNIT",33,0)
-          S CNT=CNT+1 ; increment count
+ I $D(ZARY(BAT))  D  ; NOT THE FIRST TEST IN BATTERY
 "RTN","C0CUNIT",34,0)
-          S ZARY(CNT)=TST ; put the test in the array
+ . N II,TN ; TEMP FOR ENDING TEST IN BATTERY
 "RTN","C0CUNIT",35,0)
-          I $D(ZARY(BAT))  D  ; NOT THE FIRST TEST IN BATTERY
+ . S II=$P(ZARY(BAT),"^",2)
 "RTN","C0CUNIT",36,0)
-          . N II,TN ; TEMP FOR ENDING TEST IN BATTERY
+ . S $P(ZARY(BAT),"^",2)=II+1
 "RTN","C0CUNIT",37,0)
-          . S II=$P(ZARY(BAT),"^",2)
+ I '$D(ZARY(BAT))  D  ; FIRST TEST IN THIS BATTERY
 "RTN","C0CUNIT",38,0)
-          . S $P(ZARY(BAT),"^",2)=II+1
+ . S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
 "RTN","C0CUNIT",39,0)
-          I '$D(ZARY(BAT))  D  ; FIRST TEST IN THIS BATTERY
+ . S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
 "RTN","C0CUNIT",40,0)
-          . S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
+ . ; S TN=$NA(ZARY("TESTS"))
 "RTN","C0CUNIT",41,0)
-          . S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
+ . ; D PUSH^C0CXPATH(TN,BAT)
 "RTN","C0CUNIT",42,0)
-          . ; S TN=$NA(ZARY("TESTS"))
+ S ZARY(0)=CNT ; update the array counter
 "RTN","C0CUNIT",43,0)
-          . ; D PUSH^C0CXPATH(TN,BAT)
+ Q
 "RTN","C0CUNIT",44,0)
-          S ZARY(0)=CNT ; update the array counter
+ ;
 "RTN","C0CUNIT",45,0)
-          Q
+ZLOAD(ZARY,ROUTINE)  ; load tests into ZARY which is passed by reference
 "RTN","C0CUNIT",46,0)
-          ;
+ ; ZARY IS PASSED BY NAME
 "RTN","C0CUNIT",47,0)
-ZLOAD(ZARY,ROUTINE)  ; load tests into ZARY which is passed by reference
+ ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
 "RTN","C0CUNIT",48,0)
-          ; ZARY IS PASSED BY NAME
+ ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
 "RTN","C0CUNIT",49,0)
-          ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+ K @ZARY
 "RTN","C0CUNIT",50,0)
-          ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+ S @ZARY@(0)=0 ; initialize array count
 "RTN","C0CUNIT",51,0)
-          K @ZARY
+ N LINE,LABEL,BODY
 "RTN","C0CUNIT",52,0)
-          S @ZARY@(0)=0 ; initialize array count
+ N INTEST S INTEST=0 ; switch for in the test case section
 "RTN","C0CUNIT",53,0)
-          N LINE,LABEL,BODY
+ N SECTION S SECTION="[anonymous]" ; test case section
 "RTN","C0CUNIT",54,0)
-          N INTEST S INTEST=0 ; switch for in the test case section
+ ;
 "RTN","C0CUNIT",55,0)
-          N SECTION S SECTION="[anonymous]" ; test case section
+ N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
 "RTN","C0CUNIT",56,0)
-          ;
+ . I LINE?." "1";;><TEST>".E S INTEST=1 ; entering test section
 "RTN","C0CUNIT",57,0)
-          N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
+ . I LINE?." "1";;><TEMPLATE>".E S INTEST=1 ; entering TEMPLATE section
 "RTN","C0CUNIT",58,0)
-          . I LINE?." "1";;><TEST>".E S INTEST=1 ; entering test section
+ . I LINE?." "1";;></TEST>".E S INTEST=0 ; leaving test section
 "RTN","C0CUNIT",59,0)
-          . I LINE?." "1";;><TEMPLATE>".E S INTEST=1 ; entering TEMPLATE section
+ . I LINE?." "1";;></TEMPLATE>".E S INTEST=0 ; leaving TEMPLATE section
 "RTN","C0CUNIT",60,0)
-          . I LINE?." "1";;></TEST>".E S INTEST=0 ; leaving test section
+ . I INTEST  D  ; within the testing section
 "RTN","C0CUNIT",61,0)
-          . I LINE?." "1";;></TEMPLATE>".E S INTEST=0 ; leaving TEMPLATE section
+ . . I LINE?." "1";;><".E  D  ; section name found
 "RTN","C0CUNIT",62,0)
-          . I INTEST  D  ; within the testing section
+ . . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name
 "RTN","C0CUNIT",63,0)
-          . . I LINE?." "1";;><".E  D  ; section name found
+ . . I LINE?." "1";;>>".E  D  ; test case found
 "RTN","C0CUNIT",64,0)
-          . . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name
+ . . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array
 "RTN","C0CUNIT",65,0)
-          . . I LINE?." "1";;>>".E  D  ; test case found
+ S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
 "RTN","C0CUNIT",66,0)
-          . . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array
+ Q
 "RTN","C0CUNIT",67,0)
-          S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
+ ;
 "RTN","C0CUNIT",68,0)
-          Q
+ZTEST(ZARY,WHICH)   ; try out the tests using a passed array ZTEST
 "RTN","C0CUNIT",69,0)
-          ;
+ N ZI,ZX,ZR,ZP
 "RTN","C0CUNIT",70,0)
-ZTEST(ZARY,WHICH)   ; try out the tests using a passed array ZTEST
+ S DEBUG=0
 "RTN","C0CUNIT",71,0)
-          N ZI,ZX,ZR,ZP
+ ; I WHICH="ALL" D  Q ; RUN ALL THE TESTS
 "RTN","C0CUNIT",72,0)
-          S DEBUG=0
+ ; . W "DOING ALL",!
 "RTN","C0CUNIT",73,0)
-          ; I WHICH="ALL" D  Q ; RUN ALL THE TESTS
+ ; . N J,NT
 "RTN","C0CUNIT",74,0)
-          ; . W "DOING ALL",!
+ ; . S NT=$NA(ZARY("TESTS"))
 "RTN","C0CUNIT",75,0)
-          ; . N J,NT
+ ; . W NT,@NT@(0),!
 "RTN","C0CUNIT",76,0)
-          ; . S NT=$NA(ZARY("TESTS"))
+ ; . F J=1:1:@NT@(0) D  ;
 "RTN","C0CUNIT",77,0)
-          ; . W NT,@NT@(0),!
+ ; . . W @NT@(J),!
 "RTN","C0CUNIT",78,0)
-          ; . F J=1:1:@NT@(0) D  ;
+ ; . . D ZTEST^C0CUNIT(@ZARY,@NT@(J))
 "RTN","C0CUNIT",79,0)
-          ; . . W @NT@(J),!
+ I '$D(ZARY(WHICH))  D  Q  ; TEST SECTION DOESN'T EXIST
 "RTN","C0CUNIT",80,0)
-          ; . . D ZTEST^C0CUNIT(@ZARY,@NT@(J))
+ . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
 "RTN","C0CUNIT",81,0)
-          I '$D(ZARY(WHICH))  D  Q ; TEST SECTION DOESN'T EXIST
+ N FIRST,LAST
 "RTN","C0CUNIT",82,0)
-          . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
+ S FIRST=$P(ZARY(WHICH),"^",1)
 "RTN","C0CUNIT",83,0)
-          N FIRST,LAST
+ S LAST=$P(ZARY(WHICH),"^",2)
 "RTN","C0CUNIT",84,0)
-          S FIRST=$P(ZARY(WHICH),"^",1)
+ F ZI=FIRST:1:LAST  D
 "RTN","C0CUNIT",85,0)
-          S LAST=$P(ZARY(WHICH),"^",2)
+ . I ZARY(ZI)?1">"1.E  D  ; NOT A TEST, JUST RUN THE STATEMENT
 "RTN","C0CUNIT",86,0)
-          F ZI=FIRST:1:LAST  D
+ . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
 "RTN","C0CUNIT",87,0)
-          . I ZARY(ZI)?1">"1.E  D  ; NOT A TEST, JUST RUN THE STATEMENT
+ . . ;  W ZP,!
 "RTN","C0CUNIT",88,0)
-          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
+ . . S ZX=ZP
 "RTN","C0CUNIT",89,0)
-          . . ;  W ZP,!
+ . . W "RUNNING: "_ZP
 "RTN","C0CUNIT",90,0)
-          . . S ZX=ZP
+ . . X ZX
 "RTN","C0CUNIT",91,0)
-          . . W "RUNNING: "_ZP
+ . . W "..SUCCESS: ",WHICH,!
 "RTN","C0CUNIT",92,0)
-          . . X ZX
+ . I ZARY(ZI)?1"?"1.E  D  ; THIS IS A TEST
 "RTN","C0CUNIT",93,0)
-          . . W "..SUCCESS: ",WHICH,!
+ . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
 "RTN","C0CUNIT",94,0)
-          . I ZARY(ZI)?1"?"1.E  D  ; THIS IS A TEST
+ . . S ZX="S ZR="_ZP
 "RTN","C0CUNIT",95,0)
-          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
+ . . W "TRYING: "_ZP
 "RTN","C0CUNIT",96,0)
-          . . S ZX="S ZR="_ZP
+ . . X ZX
 "RTN","C0CUNIT",97,0)
-          . . W "TRYING: "_ZP
+ . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
 "RTN","C0CUNIT",98,0)
-          . . X ZX
+ . . I '$D(TPASSED) D  ; NOT INITIALIZED YET
 "RTN","C0CUNIT",99,0)
-          . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
+ . . . S TPASSED=0 S TFAILED=0
 "RTN","C0CUNIT",100,0)
-          . . I '$D(TPASSED) D  ; NOT INITIALIZED YET
+ . . I ZR S TPASSED=TPASSED+1
 "RTN","C0CUNIT",101,0)
-          . . . S TPASSED=0 S TFAILED=0
+ . . I 'ZR S TFAILED=TFAILED+1
 "RTN","C0CUNIT",102,0)
-          . . I ZR S TPASSED=TPASSED+1
+ Q
 "RTN","C0CUNIT",103,0)
-          . . I 'ZR S TFAILED=TFAILED+1
+ ;
 "RTN","C0CUNIT",104,0)
-          Q
+TEST   ; RUN ALL THE TEST CASES
 "RTN","C0CUNIT",105,0)
-          ;
+ N ZTMP
 "RTN","C0CUNIT",106,0)
-TEST   ; RUN ALL THE TEST CASES
+ D ZLOAD(.ZTMP)
 "RTN","C0CUNIT",107,0)
-          N ZTMP
+ D ZTEST(.ZTMP,"ALL")
 "RTN","C0CUNIT",108,0)
-          D ZLOAD(.ZTMP)
+ W "PASSED: ",TPASSED,!
 "RTN","C0CUNIT",109,0)
-          D ZTEST(.ZTMP,"ALL")
+ W "FAILED: ",TFAILED,!
 "RTN","C0CUNIT",110,0)
-          W "PASSED: ",TPASSED,!
+ W !
 "RTN","C0CUNIT",111,0)
-          W "FAILED: ",TFAILED,!
+ W "THE TESTS!",!
 "RTN","C0CUNIT",112,0)
-          W !
+ ; I DEBUG ZWR ZTMP
 "RTN","C0CUNIT",113,0)
-          W "THE TESTS!",!
+ Q
 "RTN","C0CUNIT",114,0)
-          ; I DEBUG ZWR ZTMP
+ ;
 "RTN","C0CUNIT",115,0)
-          Q
+GTSTS(GTZARY,RTN) ; return an array of test names
 "RTN","C0CUNIT",116,0)
-          ;
+ N I,J S I="" S I=$O(GTZARY("TESTS",I))
 "RTN","C0CUNIT",117,0)
-GTSTS(GTZARY,RTN) ; return an array of test names
+ F J=0:0  Q:I=""  D
 "RTN","C0CUNIT",118,0)
-          N I,J S I="" S I=$O(GTZARY("TESTS",I))
+ . D PUSH^C0CXPATH(RTN,I)
 "RTN","C0CUNIT",119,0)
-          F J=0:0  Q:I=""  D
+ . S I=$O(GTZARY("TESTS",I))
 "RTN","C0CUNIT",120,0)
-          . D PUSH^C0CXPATH(RTN,I)
+ Q
 "RTN","C0CUNIT",121,0)
-          . S I=$O(GTZARY("TESTS",I))
+ ;
 "RTN","C0CUNIT",122,0)
-          Q
+TESTALL(RNM) ; RUN ALL THE TESTS
 "RTN","C0CUNIT",123,0)
-          ;
+ N ZI,J,TZTMP,TSTS,TOTP,TOTF
 "RTN","C0CUNIT",124,0)
-TESTALL(RNM) ; RUN ALL THE TESTS
+ S TOTP=0 S TOTF=0
 "RTN","C0CUNIT",125,0)
-          N ZI,J,TZTMP,TSTS,TOTP,TOTF
+ D ZLOAD^C0CUNIT("TZTMP",RNM)
 "RTN","C0CUNIT",126,0)
-          S TOTP=0 S TOTF=0
+ D GTSTS(.TZTMP,"TSTS")
 "RTN","C0CUNIT",127,0)
-          D ZLOAD^C0CUNIT("TZTMP",RNM)
+ F ZI=1:1:TSTS(0) D  ;
 "RTN","C0CUNIT",128,0)
-          D GTSTS(.TZTMP,"TSTS")
+ . S TPASSED=0 S TFAILED=0
 "RTN","C0CUNIT",129,0)
-          F ZI=1:1:TSTS(0) D  ;
+ . D ZTEST^C0CUNIT(.TZTMP,TSTS(ZI))
 "RTN","C0CUNIT",130,0)
-          . S TPASSED=0 S TFAILED=0
+ . S TOTP=TOTP+TPASSED
 "RTN","C0CUNIT",131,0)
-          . D ZTEST^C0CUNIT(.TZTMP,TSTS(ZI))
+ . S TOTF=TOTF+TFAILED
 "RTN","C0CUNIT",132,0)
-          . S TOTP=TOTP+TPASSED
+ . S $P(TSTS(ZI),"^",2)=TPASSED
 "RTN","C0CUNIT",133,0)
-          . S TOTF=TOTF+TFAILED
+ . S $P(TSTS(ZI),"^",3)=TFAILED
 "RTN","C0CUNIT",134,0)
-          . S $P(TSTS(ZI),"^",2)=TPASSED
+ F ZI=1:1:TSTS(0) D  ;
 "RTN","C0CUNIT",135,0)
-          . S $P(TSTS(ZI),"^",3)=TFAILED
+ . W "TEST=> ",$P(TSTS(ZI),"^",1)
 "RTN","C0CUNIT",136,0)
-          F ZI=1:1:TSTS(0) D  ;
+ . W " PASSED=>",$P(TSTS(ZI),"^",2)
 "RTN","C0CUNIT",137,0)
-          . W "TEST=> ",$P(TSTS(ZI),"^",1)
+ . W " FAILED=>",$P(TSTS(ZI),"^",3),!
 "RTN","C0CUNIT",138,0)
-          . W " PASSED=>",$P(TSTS(ZI),"^",2)
+ W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
 "RTN","C0CUNIT",139,0)
-          . W " FAILED=>",$P(TSTS(ZI),"^",3),!
+ Q
 "RTN","C0CUNIT",140,0)
-          W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
+ ;
 "RTN","C0CUNIT",141,0)
-          Q
+TLIST(ZARY) ; LIST ALL THE TESTS
 "RTN","C0CUNIT",142,0)
-          ;
+ ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
 "RTN","C0CUNIT",143,0)
-TLIST(ZARY) ; LIST ALL THE TESTS
+ ; ZARY IS PASSED BY REFERENCE
 "RTN","C0CUNIT",144,0)
-          ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
+ N I,J,K S I="" S I=$O(ZARY("TESTS",I))
 "RTN","C0CUNIT",145,0)
-          ; ZARY IS PASSED BY REFERENCE
+ S K=1
 "RTN","C0CUNIT",146,0)
-          N I,J,K S I="" S I=$O(ZARY("TESTS",I))
+ F J=0:0  Q:I=""  D
 "RTN","C0CUNIT",147,0)
-          S K=1
+ . ; W "I IS NOW=",I,!
 "RTN","C0CUNIT",148,0)
-          F J=0:0  Q:I=""  D
+ . W I," "
 "RTN","C0CUNIT",149,0)
-          . ; W "I IS NOW=",I,!
+ . S I=$O(ZARY("TESTS",I))
 "RTN","C0CUNIT",150,0)
-          . W I," "
+ . S K=K+1 I K=6  D
 "RTN","C0CUNIT",151,0)
-          . S I=$O(ZARY("TESTS",I))
+ . . W !
 "RTN","C0CUNIT",152,0)
-          . S K=K+1 I K=6  D
+ . . S K=1
 "RTN","C0CUNIT",153,0)
-          . . W !
+ Q
 "RTN","C0CUNIT",154,0)
-          . . S K=1
+ ;
 "RTN","C0CUNIT",155,0)
-          Q
+MEDS ;
 "RTN","C0CUNIT",156,0)
-          ;
+ N DEBUG S DEBUG=0
 "RTN","C0CUNIT",157,0)
-MEDS 
+ N DFN S DFN=5685
 "RTN","C0CUNIT",158,0)
- N DEBUG S DEBUG=0
+ K ^TMP($J)
 "RTN","C0CUNIT",159,0)
- N DFN S DFN=5685
+ W "Loading CCR Template into T using LOAD^GPLCCR0($NA(^TMP($J,""CCR"")))",!!
 "RTN","C0CUNIT",160,0)
- K ^TMP($J)
+ N T S T=$NA(^TMP($J,"CCR"))     D LOAD^GPLCCR0(T)
 "RTN","C0CUNIT",161,0)
- W "Loading CCR Template into T using LOAD^GPLCCR0($NA(^TMP($J,""CCR"")))",!!
+ N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
 "RTN","C0CUNIT",162,0)
- N T S T=$NA(^TMP($J,"CCR"))     D LOAD^GPLCCR0(T)
+ W "XPATH is: "_XPATH,!
 "RTN","C0CUNIT",163,0)
- N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
+ W "Getting Med Template into INXML using",!
 "RTN","C0CUNIT",164,0)
- W "XPATH is: "_XPATH,!
+ W "QUERY^GPLXPATH(T,XPATH,""INXML"")",!!
 "RTN","C0CUNIT",165,0)
- W "Getting Med Template into INXML using",!
+ D QUERY^GPLXPATH(T,XPATH,"INXML")
 "RTN","C0CUNIT",166,0)
- W "QUERY^GPLXPATH(T,XPATH,""INXML"")",!!
+ W "Executing EXTRACT^C0CMED(INXML,DFN,OUTXML)",!
 "RTN","C0CUNIT",167,0)
- D QUERY^GPLXPATH(T,XPATH,"INXML")
+ W "OUTXML will be ^TMP($J,""OUT"")",!
 "RTN","C0CUNIT",168,0)
- W "Executing EXTRACT^C0CMED(INXML,DFN,OUTXML)",!
+ N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
 "RTN","C0CUNIT",169,0)
- W "OUTXML will be ^TMP($J,""OUT"")",!
+ D EXTRACT^C0CMED6("INXML",DFN,OUTXML)
 "RTN","C0CUNIT",170,0)
- N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
+ D FILEOUT^C0CRNF(OUTXML,"TESTMEDS.xml")
 "RTN","C0CUNIT",171,0)
- D EXTRACT^C0CMED6("INXML",DFN,OUTXML)
+ Q
 "RTN","C0CUNIT",172,0)
- D FILEOUT^C0CRNF(OUTXML,"TESTMEDS.xml")
+PAT ;
 "RTN","C0CUNIT",173,0)
- Q
+ D ANALYZE^ARJTXRD("C0CDPT",.OUT) ; Analyze a routine in the directory
 "RTN","C0CUNIT",174,0)
-PAT 
+ N X,Y
 "RTN","C0CUNIT",175,0)
- D ANALYZE^ARJTXRD("C0CDPT",.OUT) ; Analyze a routine in the directory
+ ; Select Patient
 "RTN","C0CUNIT",176,0)
- N X,Y
+ S DIC=2,DIC(0)="AEMQ" D ^DIC
 "RTN","C0CUNIT",177,0)
- ; Select Patient
+ ;
 "RTN","C0CUNIT",178,0)
- S DIC=2,DIC(0)="AEMQ" D ^DIC
+ W "You have selected patient "_Y,!!
 "RTN","C0CUNIT",179,0)
- ;
+ N I S I=89 F  S I=$O(OUT(I)) Q:I="ALINE"  D
 "RTN","C0CUNIT",180,0)
- W "You have selected patient "_Y,!!
+ . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
 "RTN","C0CUNIT",181,0)
- N I S I=89 F  S I=$O(OUT(I)) Q:I="ALINE"  D
+ . W "valued at "
 "RTN","C0CUNIT",182,0)
- . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
+ . W @("$$"_$P(OUT(I,0),"(DFN)")_"^"_"C0CDPT"_"("_$P(Y,"^")_")")
 "RTN","C0CUNIT",183,0)
- . W "valued at "
+ . W !
 "RTN","C0CUNIT",184,0)
- . W @("$$"_$P(OUT(I,0),"(DFN)")_"^"_"C0CDPT"_"("_$P(Y,"^")_")")
-"RTN","C0CUNIT",185,0)
- . W !
-"RTN","C0CUNIT",186,0)
  Q
 "RTN","C0CUTIL")
-0^54^B27079469
+0^54^B26410609
 "RTN","C0CUTIL",1,0)
 C0CUTIL ;WV/C0C/SMH - Various Utilites for generating the CCR/CCD;06/15/08
 "RTN","C0CUTIL",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CUTIL",3,0)
  ;Copyright 2008-2009 Sam Habiel & George Lilly.  
 "RTN","C0CUTIL",4,0)
- ;Licensed under the terms of the GNU
+ ;
 "RTN","C0CUTIL",5,0)
- ;General Public License See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CUTIL",6,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CUTIL",7,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CUTIL",8,0)
- ;it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CUTIL",9,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CUTIL",10,0)
- ;(at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CUTIL",11,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CUTIL",12,0)
- ;This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CUTIL",13,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CUTIL",14,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CUTIL",15,0)
- ;GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CUTIL",16,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CUTIL",17,0)
- ;You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CUTIL",18,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ W "No Entry at Top!"
 "RTN","C0CUTIL",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ Q
 "RTN","C0CUTIL",20,0)
  ;
 "RTN","C0CUTIL",21,0)
- W "No Entry at Top!"
+UUID()  ; thanks to Wally for this.
 "RTN","C0CUTIL",22,0)
+ N R,I,J,N
+"RTN","C0CUTIL",23,0)
+ S N="",R="" F  S N=N_$R(100000) Q:$L(N)>64
+"RTN","C0CUTIL",24,0)
+ F I=1:2:64 S R=R_$E("0123456789abcdef",($E(N,I,I+1)#16+1))
+"RTN","C0CUTIL",25,0)
+ Q $E(R,1,8)_"-"_$E(R,9,12)_"-4"_$E(R,14,16)_"-"_$E("89ab",$E(N,17)#4+1)_$E(R,18,20)_"-"_$E(R,21,32)
+"RTN","C0CUTIL",26,0)
+ ;
+"RTN","C0CUTIL",27,0)
+OLDUUID() ; GENERATE A RANDOM UUID (Version 4)
+"RTN","C0CUTIL",28,0)
+ N I,J,ZS
+"RTN","C0CUTIL",29,0)
+ S ZS="0123456789abcdef" S J=""
+"RTN","C0CUTIL",30,0)
+ F I=1:1:36 S J=J_$S((I=9)!(I=14)!(I=19)!(I=24):"-",I=15:4,I=20:"a",1:$E(ZS,$R(16)+1))
+"RTN","C0CUTIL",31,0)
+ Q J
+"RTN","C0CUTIL",32,0)
+ ;
+"RTN","C0CUTIL",33,0)
+FMDTOUTC(DATE,FORMAT) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrinsic
+"RTN","C0CUTIL",34,0)
+ ; FORMAT is Format of Date. Can be either D (Day) or DT (Date and Time)
+"RTN","C0CUTIL",35,0)
+ ; If not passed, or passed incorrectly, it's assumed that it is D.
+"RTN","C0CUTIL",36,0)
+ ; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied.
+"RTN","C0CUTIL",37,0)
+ ; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC
+"RTN","C0CUTIL",38,0)
+ ; UTC, Year, Month, Day, Hours, Minutes, Seconds, Time offset (obtained from Mailman Site Parameters)
+"RTN","C0CUTIL",39,0)
+ N UTC,Y,M,D,H,MM,S,OFF,OFFS,OFF0,OFF1,OFF2
+"RTN","C0CUTIL",40,0)
+ S Y=1700+$E(DATE,1,3)
+"RTN","C0CUTIL",41,0)
+ S M=$E(DATE,4,5)
+"RTN","C0CUTIL",42,0)
+ S D=$E(DATE,6,7)
+"RTN","C0CUTIL",43,0)
+ S H=$E(DATE,9,10)
+"RTN","C0CUTIL",44,0)
+ I $L(H)=1 S H="0"_H
+"RTN","C0CUTIL",45,0)
+ S MM=$E(DATE,11,12)
+"RTN","C0CUTIL",46,0)
+ I $L(MM)=1 S MM="0"_MM
+"RTN","C0CUTIL",47,0)
+ S S=$E(DATE,13,14)
+"RTN","C0CUTIL",48,0)
+ I $L(S)=1 S S="0"_S
+"RTN","C0CUTIL",49,0)
+ S OFF=$$TZ^XLFDT ; See Kernel Manual for documentation.
+"RTN","C0CUTIL",50,0)
+ S OFFS=$E(OFF,1,1)
+"RTN","C0CUTIL",51,0)
+ S OFF0=$TR(OFF,"+-")
+"RTN","C0CUTIL",52,0)
+ S OFF1=$E(OFF0+10000,2,3)
+"RTN","C0CUTIL",53,0)
+ S OFF2=$E(OFF0+10000,4,5)
+"RTN","C0CUTIL",54,0)
+ S OFF=OFFS_OFF1_":"_OFF2
+"RTN","C0CUTIL",55,0)
+ ;S OFF2=$E(OFF,1,2) ;
+"RTN","C0CUTIL",56,0)
+ ;S OFF2=$E(100+OFF2,2,3) ; GPL 11/08 CHANGED TO -05:00 FORMAT
+"RTN","C0CUTIL",57,0)
+ ;S OFF3=$E(OFF,3,4) ;MINUTES
+"RTN","C0CUTIL",58,0)
+ ;S OFF=$S(OFF2="":"00",0:"00",1:OFF2)_"."_$S(OFF3="":"00",1:OFF3)
+"RTN","C0CUTIL",59,0)
+ ; If H, MM and S are empty, it means that the FM date didn't supply the time.
+"RTN","C0CUTIL",60,0)
+ ; In this case, set H, MM and S to "00"
+"RTN","C0CUTIL",61,0)
+ ; S:('$L(H)&'$L(MM)&'$L(S)) (H,MM,S)="00" ; IF ONLY SOME ARE MISSING?
+"RTN","C0CUTIL",62,0)
+ S:'$L(H) H="00"
+"RTN","C0CUTIL",63,0)
+ S:'$L(MM) MM="00"
+"RTN","C0CUTIL",64,0)
+ S:'$L(S) S="00"
+"RTN","C0CUTIL",65,0)
+ S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_$S(S="":":00",1:":"_S)_OFF ; Skip's code to fix hanging colon if no seconds
+"RTN","C0CUTIL",66,0)
+ I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time.
+"RTN","C0CUTIL",67,0)
+ E  Q $P(UTC,"T")
+"RTN","C0CUTIL",68,0)
+ ;
+"RTN","C0CUTIL",69,0)
+SORTDT(V1,V2,ORDR) ; DATE SORT ARRAY AND RETURN INDEX IN V1 AND COUNT
+"RTN","C0CUTIL",70,0)
+ ; AS EXTRINSIC ORDR IS 1 OR -1 FOR FORWARD OR REVERSE
+"RTN","C0CUTIL",71,0)
+ ; DATE AND TIME ORDER. DEFAULT IS FORWARD
+"RTN","C0CUTIL",72,0)
+ ; V2 IS AN ARRAY OF DATES IN FILEMAN FORMAT
+"RTN","C0CUTIL",73,0)
+ ; V1 IS RETURNS INDIRECT INDEXES OF V2 IN REVERSE DATE ORDER
+"RTN","C0CUTIL",74,0)
+ ; SO V2(V1(X)) WILL RETURN THE DATES IN DATE/TIME ORDER
+"RTN","C0CUTIL",75,0)
+ ; THE COUNT OF THE DATES IS RETURNED AS AN EXTRINSIC
+"RTN","C0CUTIL",76,0)
+ ; BOTH V1 AND V2 ARE PASSED BY REFERENCE
+"RTN","C0CUTIL",77,0)
+ N VSRT ; TEMP FOR HASHING DATES
+"RTN","C0CUTIL",78,0)
+ N ZI,ZJ,ZTMP,ZCNT,ZP1,ZP2
+"RTN","C0CUTIL",79,0)
+ S ZCNT=V2(0) ; COUNTING NUMBER OF DATES
+"RTN","C0CUTIL",80,0)
+ F ZI=1:1:ZCNT D  ; FOR EACH DATE IN THE ARRAY
+"RTN","C0CUTIL",81,0)
+ . I $D(V2(ZI)) D  ; IF THE DATE EXISTS
+"RTN","C0CUTIL",82,0)
+ . . S ZP1=$P(V2(ZI),".",1) ; THE DATE PIECE
+"RTN","C0CUTIL",83,0)
+ . . S ZP2=$P(V2(ZI),".",2) ; THE TIME PIECE
+"RTN","C0CUTIL",84,0)
+ . . ; W "DATE: ",ZP1," TIME: ",ZP2,!
+"RTN","C0CUTIL",85,0)
+ . . S VSRT(ZP1,ZP2,ZI)=ZI ; INDEX OF DATE, TIME AND COUNT
+"RTN","C0CUTIL",86,0)
+ N ZG
+"RTN","C0CUTIL",87,0)
+ S ZG=$Q(VSRT(""))
+"RTN","C0CUTIL",88,0)
+ F  D  Q:ZG=""  ;
+"RTN","C0CUTIL",89,0)
+ . ; W ZG,!
+"RTN","C0CUTIL",90,0)
+ . D PUSH^C0CXPATH("V1",@ZG)
+"RTN","C0CUTIL",91,0)
+ . S ZG=$Q(@ZG)
+"RTN","C0CUTIL",92,0)
+ I ORDR=-1 D  ; HAVE TO REVERSE ORDER
+"RTN","C0CUTIL",93,0)
+ . N ZG2
+"RTN","C0CUTIL",94,0)
+ . F ZI=1:1:V1(0) D  ; FOR EACH ELELMENT
+"RTN","C0CUTIL",95,0)
+ . . S ZG2(V1(0)-ZI+1)=V1(ZI) ; SET IN REVERSE ORDER
+"RTN","C0CUTIL",96,0)
+ . S ZG2(0)=V1(0)
+"RTN","C0CUTIL",97,0)
+ . D CP^C0CXPATH("ZG2","V1") ; COPY OVER THE NEW ARRAY
+"RTN","C0CUTIL",98,0)
+ Q ZCNT
+"RTN","C0CUTIL",99,0)
+ ;
+"RTN","C0CUTIL",100,0)
+DA2SNO(RTN,DNAME) ; LOOK UP DRUG ALLERGY CODE IN ^LEX
+"RTN","C0CUTIL",101,0)
+ ; RETURNS AN ARRAY RTN PASSED BY REFERENCE
+"RTN","C0CUTIL",102,0)
+ ; THIS ROUTINE CAN BE USED AS AN RPC
+"RTN","C0CUTIL",103,0)
+ ; RTN(0) IS THE NUMBER OF ELEMENTS IN THE ARRAY
+"RTN","C0CUTIL",104,0)
+ ; RTN(1) IS THE SNOMED CODE FOR THE DRUG ALLERGY
+"RTN","C0CUTIL",105,0)
+ ;
+"RTN","C0CUTIL",106,0)
+ N LEXIEN
+"RTN","C0CUTIL",107,0)
+ I $O(^LEX(757.21,"ADIS",DNAME,""))'="" D  ; IEN FOUND FOR THIS DRUG
+"RTN","C0CUTIL",108,0)
+ . S LEXIEN=$O(^LEX(757.21,"ADIS",DNAME,"")) ; GET THE IEN IN THE LEXICON
+"RTN","C0CUTIL",109,0)
+ . W LEXIEN,!
+"RTN","C0CUTIL",110,0)
+ . S RTN(1)=$P(^LEX(757.02,LEXIEN,0),"^",2) ; SNOMED CODE IN P2
+"RTN","C0CUTIL",111,0)
+ . S RTN(0)=1 ; ONE THING RETURNED
+"RTN","C0CUTIL",112,0)
+ E  S RTN(0)=0 ; NOT FOUND
+"RTN","C0CUTIL",113,0)
  Q
-"RTN","C0CUTIL",23,0)
- ;
-"RTN","C0CUTIL",24,0)
-UUID()  ; thanks to Wally for this.
-"RTN","C0CUTIL",25,0)
-        N R,I,J,N 
-"RTN","C0CUTIL",26,0)
-        S N="",R="" F  S N=N_$R(100000) Q:$L(N)>64 
-"RTN","C0CUTIL",27,0)
-        F I=1:2:64 S R=R_$E("0123456789abcdef",($E(N,I,I+1)#16+1)) 
-"RTN","C0CUTIL",28,0)
-        Q $E(R,1,8)_"-"_$E(R,9,12)_"-4"_$E(R,14,16)_"-"_$E("89ab",$E(N,17)#4+1)_$E(R,18,20)_"-"_$E(R,21,32)
-"RTN","C0CUTIL",29,0)
- ;
-"RTN","C0CUTIL",30,0)
-OLDUUID() ; GENERATE A RANDOM UUID (Version 4)
-"RTN","C0CUTIL",31,0)
- N I,J,ZS
-"RTN","C0CUTIL",32,0)
- S ZS="0123456789abcdef" S J=""
-"RTN","C0CUTIL",33,0)
- F I=1:1:36 S J=J_$S((I=9)!(I=14)!(I=19)!(I=24):"-",I=15:4,I=20:"a",1:$E(ZS,$R(16)+1))
-"RTN","C0CUTIL",34,0)
- Q J
-"RTN","C0CUTIL",35,0)
- ;
-"RTN","C0CUTIL",36,0)
-FMDTOUTC(DATE,FORMAT) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrinsic
-"RTN","C0CUTIL",37,0)
- ; FORMAT is Format of Date. Can be either D (Day) or DT (Date and Time)
-"RTN","C0CUTIL",38,0)
- ; If not passed, or passed incorrectly, it's assumed that it is D.
-"RTN","C0CUTIL",39,0)
- ; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied.
-"RTN","C0CUTIL",40,0)
- ; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC
-"RTN","C0CUTIL",41,0)
- ; UTC, Year, Month, Day, Hours, Minutes, Seconds, Time offset (obtained from Mailman Site Parameters)
-"RTN","C0CUTIL",42,0)
- N UTC,Y,M,D,H,MM,S,OFF
-"RTN","C0CUTIL",43,0)
- S Y=1700+$E(DATE,1,3)
-"RTN","C0CUTIL",44,0)
- S M=$E(DATE,4,5)
-"RTN","C0CUTIL",45,0)
- S D=$E(DATE,6,7)
-"RTN","C0CUTIL",46,0)
- S H=$E(DATE,9,10)
-"RTN","C0CUTIL",47,0)
- I $L(H)=1 S H="0"_H
-"RTN","C0CUTIL",48,0)
- S MM=$E(DATE,11,12)
-"RTN","C0CUTIL",49,0)
- I $L(MM)=1 S MM="0"_MM
-"RTN","C0CUTIL",50,0)
- S S=$E(DATE,13,14)
-"RTN","C0CUTIL",51,0)
- I $L(S)=1 S S="0"_S
-"RTN","C0CUTIL",52,0)
- S OFF=$$TZ^XLFDT ; See Kernel Manual for documentation.
-"RTN","C0CUTIL",53,0)
- S OFFS=$E(OFF,1,1)
-"RTN","C0CUTIL",54,0)
- S OFF0=$TR(OFF,"+-")
-"RTN","C0CUTIL",55,0)
- S OFF1=$E(OFF0+10000,2,3)
-"RTN","C0CUTIL",56,0)
- S OFF2=$E(OFF0+10000,4,5)
-"RTN","C0CUTIL",57,0)
- S OFF=OFFS_OFF1_":"_OFF2
-"RTN","C0CUTIL",58,0)
- ;S OFF2=$E(OFF,1,2) ;
-"RTN","C0CUTIL",59,0)
- ;S OFF2=$E(100+OFF2,2,3) ; GPL 11/08 CHANGED TO -05:00 FORMAT
-"RTN","C0CUTIL",60,0)
- ;S OFF3=$E(OFF,3,4) ;MINUTES
-"RTN","C0CUTIL",61,0)
- ;S OFF=$S(OFF2="":"00",0:"00",1:OFF2)_"."_$S(OFF3="":"00",1:OFF3)
-"RTN","C0CUTIL",62,0)
- ; If H, MM and S are empty, it means that the FM date didn't supply the time.
-"RTN","C0CUTIL",63,0)
- ; In this case, set H, MM and S to "00"
-"RTN","C0CUTIL",64,0)
- ; S:('$L(H)&'$L(MM)&'$L(S)) (H,MM,S)="00" ; IF ONLY SOME ARE MISSING?
-"RTN","C0CUTIL",65,0)
- S:'$L(H) H="00"
-"RTN","C0CUTIL",66,0)
- S:'$L(MM) MM="00"
-"RTN","C0CUTIL",67,0)
- S:'$L(S) S="00"
-"RTN","C0CUTIL",68,0)
- S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_$S(S="":":00",1:":"_S)_OFF ; Skip's code to fix hanging colon if no seconds
-"RTN","C0CUTIL",69,0)
- I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time.
-"RTN","C0CUTIL",70,0)
- E  Q $P(UTC,"T")
-"RTN","C0CUTIL",71,0)
- ;
-"RTN","C0CUTIL",72,0)
-SORTDT(V1,V2,ORDR) ; DATE SORT ARRAY AND RETURN INDEX IN V1 AND COUNT
-"RTN","C0CUTIL",73,0)
- ; AS EXTRINSIC ORDR IS 1 OR -1 FOR FORWARD OR REVERSE
-"RTN","C0CUTIL",74,0)
- ; DATE AND TIME ORDER. DEFAULT IS FORWARD
-"RTN","C0CUTIL",75,0)
- ; V2 IS AN ARRAY OF DATES IN FILEMAN FORMAT
-"RTN","C0CUTIL",76,0)
- ; V1 IS RETURNS INDIRECT INDEXES OF V2 IN REVERSE DATE ORDER
-"RTN","C0CUTIL",77,0)
- ; SO V2(V1(X)) WILL RETURN THE DATES IN DATE/TIME ORDER
-"RTN","C0CUTIL",78,0)
- ; THE COUNT OF THE DATES IS RETURNED AS AN EXTRINSIC
-"RTN","C0CUTIL",79,0)
- ; BOTH V1 AND V2 ARE PASSED BY REFERENCE
-"RTN","C0CUTIL",80,0)
- N VSRT ; TEMP FOR HASHING DATES
-"RTN","C0CUTIL",81,0)
- N ZI,ZJ,ZTMP,ZCNT,ZP1,ZP2
-"RTN","C0CUTIL",82,0)
- S ZCNT=V2(0) ; COUNTING NUMBER OF DATES
-"RTN","C0CUTIL",83,0)
- F ZI=1:1:ZCNT D  ; FOR EACH DATE IN THE ARRAY
-"RTN","C0CUTIL",84,0)
- . I $D(V2(ZI)) D  ; IF THE DATE EXISTS
-"RTN","C0CUTIL",85,0)
- . . S ZP1=$P(V2(ZI),".",1) ; THE DATE PIECE
-"RTN","C0CUTIL",86,0)
- . . S ZP2=$P(V2(ZI),".",2) ; THE TIME PIECE
-"RTN","C0CUTIL",87,0)
- . . ; W "DATE: ",ZP1," TIME: ",ZP2,!
-"RTN","C0CUTIL",88,0)
- . . S VSRT(ZP1,ZP2,ZI)=ZI ; INDEX OF DATE, TIME AND COUNT
-"RTN","C0CUTIL",89,0)
- N ZG
-"RTN","C0CUTIL",90,0)
- S ZG=$Q(VSRT(""))
-"RTN","C0CUTIL",91,0)
- F  D  Q:ZG=""  ;
-"RTN","C0CUTIL",92,0)
- . ; W ZG,!
-"RTN","C0CUTIL",93,0)
- . D PUSH^C0CXPATH("V1",@ZG)
-"RTN","C0CUTIL",94,0)
- . S ZG=$Q(@ZG)
-"RTN","C0CUTIL",95,0)
- I ORDR=-1 D  ; HAVE TO REVERSE ORDER
-"RTN","C0CUTIL",96,0)
- . N ZG2
-"RTN","C0CUTIL",97,0)
- . F ZI=1:1:V1(0) D  ; FOR EACH ELELMENT
-"RTN","C0CUTIL",98,0)
- . . S ZG2(V1(0)-ZI+1)=V1(ZI) ; SET IN REVERSE ORDER
-"RTN","C0CUTIL",99,0)
- . S ZG2(0)=V1(0)
-"RTN","C0CUTIL",100,0)
- . D CP^C0CXPATH("ZG2","V1") ; COPY OVER THE NEW ARRAY
-"RTN","C0CUTIL",101,0)
- Q ZCNT
-"RTN","C0CUTIL",102,0)
- ;
-"RTN","C0CUTIL",103,0)
-DA2SNO(RTN,DNAME) ; LOOK UP DRUG ALLERGY CODE IN ^LEX
-"RTN","C0CUTIL",104,0)
- ; RETURNS AN ARRAY RTN PASSED BY REFERENCE
-"RTN","C0CUTIL",105,0)
- ; THIS ROUTINE CAN BE USED AS AN RPC
-"RTN","C0CUTIL",106,0)
- ; RTN(0) IS THE NUMBER OF ELEMENTS IN THE ARRAY
-"RTN","C0CUTIL",107,0)
- ; RTN(1) IS THE SNOMED CODE FOR THE DRUG ALLERGY
-"RTN","C0CUTIL",108,0)
- ;
-"RTN","C0CUTIL",109,0)
- N LEXIEN
-"RTN","C0CUTIL",110,0)
- I $O(^LEX(757.21,"ADIS",DNAME,""))'="" D  ; IEN FOUND FOR THIS DRUG
-"RTN","C0CUTIL",111,0)
- . S LEXIEN=$O(^LEX(757.21,"ADIS",DNAME,"")) ; GET THE IEN IN THE LEXICON
-"RTN","C0CUTIL",112,0)
- . W LEXIEN,!
-"RTN","C0CUTIL",113,0)
- . S RTN(1)=$P(^LEX(757.02,LEXIEN,0),"^",2) ; SNOMED CODE IN P2
 "RTN","C0CUTIL",114,0)
- . S RTN(0)=1 ; ONE THING RETURNED
+ ;
 "RTN","C0CUTIL",115,0)
- E  S RTN(0)=0 ; NOT FOUND
+DASNO(DANAME) ; PRINTS THE SNOMED CODE FOR ALLERGY TO DRUG DANAME
 "RTN","C0CUTIL",116,0)
+ ;
+"RTN","C0CUTIL",117,0)
+ N DARTN
+"RTN","C0CUTIL",118,0)
+ D DA2SNO(.DARTN,DANAME) ; CALL THE LOOKUP ROUTINE
+"RTN","C0CUTIL",119,0)
+ I DARTN(0)>0 D  ; GOT RESULTS
+"RTN","C0CUTIL",120,0)
+ . W !,DARTN(1) ;PRINT THE SNOMED CODE
+"RTN","C0CUTIL",121,0)
+ E  W !,"NOT FOUND",!
+"RTN","C0CUTIL",122,0)
  Q
-"RTN","C0CUTIL",117,0)
- ;
-"RTN","C0CUTIL",118,0)
-DASNO(DANAME) ; PRINTS THE SNOMED CODE FOR ALLERGY TO DRUG DANAME
-"RTN","C0CUTIL",119,0)
- ;
-"RTN","C0CUTIL",120,0)
- N DARTN
-"RTN","C0CUTIL",121,0)
- D DA2SNO(.DARTN,DANAME) ; CALL THE LOOKUP ROUTINE
-"RTN","C0CUTIL",122,0)
- I DARTN(0)>0 D  ; GOT RESULTS
 "RTN","C0CUTIL",123,0)
- . W !,DARTN(1) ;PRINT THE SNOMED CODE
+ ;
 "RTN","C0CUTIL",124,0)
- E  W !,"NOT FOUND",!
+DASNALL(WHICH) ; ROUTINE TO EXAMINE THE ADIS INDEX IN LEX AND RETRIEVE ALL
 "RTN","C0CUTIL",125,0)
+ ; ASSOCIATED SNOMED CODES
+"RTN","C0CUTIL",126,0)
+ N DASTMP,DASIEN,DASNO
+"RTN","C0CUTIL",127,0)
+ S DASTMP=""
+"RTN","C0CUTIL",128,0)
+ F  S DASTMP=$O(^LEX(757.21,WHICH,DASTMP)) Q:DASTMP=""  D  ; NAME OF MED
+"RTN","C0CUTIL",129,0)
+ . S DASIEN=$O(^LEX(757.21,WHICH,DASTMP,"")) ; IEN OF MED
+"RTN","C0CUTIL",130,0)
+ . S DASNO=$P(^LEX(757.02,DASIEN,0),"^",2) ; SNOMED CODE FOR ENTRY
+"RTN","C0CUTIL",131,0)
+ . W DASTMP,"=",DASNO,! ; PRINT IT OUT
+"RTN","C0CUTIL",132,0)
  Q
-"RTN","C0CUTIL",126,0)
- ;
-"RTN","C0CUTIL",127,0)
-DASNALL(WHICH) ; ROUTINE TO EXAMINE THE ADIS INDEX IN LEX AND RETRIEVE ALL
-"RTN","C0CUTIL",128,0)
- ; ASSOCIATED SNOMED CODES
-"RTN","C0CUTIL",129,0)
- N DASTMP,DASIEN,DASNO
-"RTN","C0CUTIL",130,0)
- S DASTMP=""
-"RTN","C0CUTIL",131,0)
- F  S DASTMP=$O(^LEX(757.21,WHICH,DASTMP)) Q:DASTMP=""  D  ; NAME OF MED
-"RTN","C0CUTIL",132,0)
- . S DASIEN=$O(^LEX(757.21,WHICH,DASTMP,"")) ; IEN OF MED
 "RTN","C0CUTIL",133,0)
- . S DASNO=$P(^LEX(757.02,DASIEN,0),"^",2) ; SNOMED CODE FOR ENTRY
+ ;
 "RTN","C0CUTIL",134,0)
- . W DASTMP,"=",DASNO,! ; PRINT IT OUT
+RXNFN() Q 1130590011.001 ; RxNorm Concepts file number
 "RTN","C0CUTIL",135,0)
- Q
+ ;
 "RTN","C0CUTIL",136,0)
- ;
+CODE(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF 
 "RTN","C0CUTIL",137,0)
-RXNFN() Q 1130590011.001 ; RxNorm Concepts file number
+ ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR
 "RTN","C0CUTIL",138,0)
- ;
+ N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT
 "RTN","C0CUTIL",139,0)
-CODE(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF 
+ I $G(ZVUID)="" Q ""
 "RTN","C0CUTIL",140,0)
- ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR
+ I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED
 "RTN","C0CUTIL",141,0)
- N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT
+ N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID")
 "RTN","C0CUTIL",142,0)
- I $G(ZVUID)="" Q ""
+ S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES
 "RTN","C0CUTIL",143,0)
- I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED
+ N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01)
 "RTN","C0CUTIL",144,0)
- N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID")
+ S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED
 "RTN","C0CUTIL",145,0)
- S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES
+ I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F"
 "RTN","C0CUTIL",146,0)
- N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01)
+ Q ZRSLT
 "RTN","C0CUTIL",147,0)
- S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED
+ ;
 "RTN","C0CUTIL",148,0)
- I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F"
+NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO 
 "RTN","C0CUTIL",149,0)
- Q ZRSLT
+ ; CONFORM TO NIST REQUIREMENTS
 "RTN","C0CUTIL",150,0)
- ;
+ ;INPATIENT CERTIFICATION
 "RTN","C0CUTIL",151,0)
-NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO 
+ I ZRXN=309362 S ZRXN=213169
 "RTN","C0CUTIL",152,0)
- ; CONFORM TO NIST REQUIREMENTS
+ I ZRXN=855318 S ZRXN=855320
 "RTN","C0CUTIL",153,0)
- ;INPATIENT CERTIFICATION
+ I ZRXN=197361 S ZRXN=212549
 "RTN","C0CUTIL",154,0)
- I ZRXN=309362 S ZRXN=213169
+ ;OUTPATIENT CERTIFICATION
 "RTN","C0CUTIL",155,0)
- I ZRXN=855318 S ZRXN=855320
+ I ZRXN=310534 S ZRXN=205875
 "RTN","C0CUTIL",156,0)
- I ZRXN=197361 S ZRXN=212549
+ I ZRXN=617312 S ZRXN=617314
 "RTN","C0CUTIL",157,0)
- ;OUTPATIENT CERTIFICATION
+ I ZRXN=310429 S ZRXN=200801
 "RTN","C0CUTIL",158,0)
- I ZRXN=310534 S ZRXN=205875
+ I ZRXN=628953 S ZRXN=628958
 "RTN","C0CUTIL",159,0)
- I ZRXN=617312 S ZRXN=617314
+ I ZRXN=745679 S ZRXN=630208
 "RTN","C0CUTIL",160,0)
- I ZRXN=310429 S ZRXN=200801
+ I ZRXN=311564 S ZRXN=979334
 "RTN","C0CUTIL",161,0)
- I ZRXN=628953 S ZRXN=628958
+ I ZRXN=836343 S ZRXN=836370
 "RTN","C0CUTIL",162,0)
- I ZRXN=745679 S ZRXN=630208
+ Q ZRXN
 "RTN","C0CUTIL",163,0)
- I ZRXN=311564 S ZRXN=979334
+ ;
 "RTN","C0CUTIL",164,0)
- I ZRXN=836343 S ZRXN=836370
+RPMS() ; Are we running on an RPMS system rather than Vista?
 "RTN","C0CUTIL",165,0)
- Q ZRXN
+ Q $G(DUZ("AG"))="I" ; If User Agency is Indian Health Service
 "RTN","C0CUTIL",166,0)
- ;
+VISTA() ; Are we running on Vanilla Vista?
 "RTN","C0CUTIL",167,0)
-RPMS() ; Are we running on an RPMS system rather than Vista?
+ Q $G(DUZ("AG"))="V" ; If User Agency is VA
 "RTN","C0CUTIL",168,0)
- Q $G(DUZ("AG"))="I" ; If User Agency is Indian Health Service
+WV() ; Are we running on WorldVista? 
 "RTN","C0CUTIL",169,0)
-VISTA() ; Are we running on Vanilla Vista?
+ Q $G(DUZ("AG"))="E" ; Code for WV.
 "RTN","C0CUTIL",170,0)
- Q $G(DUZ("AG"))="V" ; If User Agency is VA
+OV() ; Are we running on OpenVista?
 "RTN","C0CUTIL",171,0)
-WV() ; Are we running on WorldVista? 
-"RTN","C0CUTIL",172,0)
- Q $G(DUZ("AG"))="E" ; Code for WV.
-"RTN","C0CUTIL",173,0)
-OV() ; Are we running on OpenVista?
-"RTN","C0CUTIL",174,0)
  Q $G(DUZ("AG"))="O" ; Code for OpenVista
-"RTN","C0CUTIL",175,0)
- 
 "RTN","C0CVA200")
-0^55^B32092477
+0^55^B31814686
 "RTN","C0CVA200",1,0)
 C0CVA200 ;WV/C0C/SMH - Routine to get Provider Data;07/13/2008
 "RTN","C0CVA200",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CVA200",3,0)
- ;Copyright 2008 Sam Habiel.  Licensed under the terms of the GNU
+ ;Copyright 2008 Sam Habiel.  
 "RTN","C0CVA200",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CVA200",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CVA200",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CVA200",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CVA200",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CVA200",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CVA200",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CVA200",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CVA200",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CVA200",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CVA200",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CVA200",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CVA200",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CVA200",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CVA200",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ Q
 "RTN","C0CVA200",19,0)
- Q
+ ; This routine uses Kernel APIs and Direct Global Access to get
 "RTN","C0CVA200",20,0)
- ; This routine uses Kernel APIs and Direct Global Access to get
+ ; Proivder Data from File 200.
 "RTN","C0CVA200",21,0)
- ; Proivder Data from File 200.
+ ;
 "RTN","C0CVA200",22,0)
- ;
+  ; The Global is VA(200,*)
 "RTN","C0CVA200",23,0)
-  ; The Global is VA(200,*)
+  ;
 "RTN","C0CVA200",24,0)
+FAMILY(DUZ) ; Get Family Name; PUBLIC; EXTRINSIC
+"RTN","C0CVA200",25,0)
+  ; INPUT: DUZ (i.e. File 200 IEN) ByVal
+"RTN","C0CVA200",26,0)
+  ; OUTPUT: String
+"RTN","C0CVA200",27,0)
+  N NAME S NAME=$P(^VA(200,DUZ,0),U)
+"RTN","C0CVA200",28,0)
+  D NAMECOMP^XLFNAME(.NAME)
+"RTN","C0CVA200",29,0)
+  Q NAME("FAMILY")
+"RTN","C0CVA200",30,0)
   ;
-"RTN","C0CVA200",25,0)
-FAMILY(DUZ) ; Get Family Name; PUBLIC; EXTRINSIC
-"RTN","C0CVA200",26,0)
-  ; INPUT: DUZ (i.e. File 200 IEN) ByVal
-"RTN","C0CVA200",27,0)
+"RTN","C0CVA200",31,0)
+GIVEN(DUZ) ; Get Given Name; PUBLIC; EXTRINSIC
+"RTN","C0CVA200",32,0)
+  ; INPUT: DUZ ByVal
+"RTN","C0CVA200",33,0)
   ; OUTPUT: String
-"RTN","C0CVA200",28,0)
+"RTN","C0CVA200",34,0)
   N NAME S NAME=$P(^VA(200,DUZ,0),U)
-"RTN","C0CVA200",29,0)
+"RTN","C0CVA200",35,0)
   D NAMECOMP^XLFNAME(.NAME)
-"RTN","C0CVA200",30,0)
-  Q NAME("FAMILY")
-"RTN","C0CVA200",31,0)
+"RTN","C0CVA200",36,0)
+  Q NAME("GIVEN")
+"RTN","C0CVA200",37,0)
   ;
-"RTN","C0CVA200",32,0)
-GIVEN(DUZ) ; Get Given Name; PUBLIC; EXTRINSIC
-"RTN","C0CVA200",33,0)
+"RTN","C0CVA200",38,0)
+MIDDLE(DUZ) ; Get Middle Name, PUBLIC; EXTRINSIC
+"RTN","C0CVA200",39,0)
   ; INPUT: DUZ ByVal
-"RTN","C0CVA200",34,0)
+"RTN","C0CVA200",40,0)
   ; OUTPUT: String
-"RTN","C0CVA200",35,0)
+"RTN","C0CVA200",41,0)
   N NAME S NAME=$P(^VA(200,DUZ,0),U)
-"RTN","C0CVA200",36,0)
+"RTN","C0CVA200",42,0)
   D NAMECOMP^XLFNAME(.NAME)
-"RTN","C0CVA200",37,0)
-  Q NAME("GIVEN")
-"RTN","C0CVA200",38,0)
+"RTN","C0CVA200",43,0)
+  Q NAME("MIDDLE")
+"RTN","C0CVA200",44,0)
   ;
-"RTN","C0CVA200",39,0)
-MIDDLE(DUZ) ; Get Middle Name, PUBLIC; EXTRINSIC
-"RTN","C0CVA200",40,0)
+"RTN","C0CVA200",45,0)
+SUFFIX(DUZ) ; Get Suffix Name, PUBLIC; EXTRINSIC
+"RTN","C0CVA200",46,0)
   ; INPUT: DUZ ByVal
-"RTN","C0CVA200",41,0)
+"RTN","C0CVA200",47,0)
   ; OUTPUT: String
-"RTN","C0CVA200",42,0)
+"RTN","C0CVA200",48,0)
   N NAME S NAME=$P(^VA(200,DUZ,0),U)
-"RTN","C0CVA200",43,0)
+"RTN","C0CVA200",49,0)
   D NAMECOMP^XLFNAME(.NAME)
-"RTN","C0CVA200",44,0)
-  Q NAME("MIDDLE")
-"RTN","C0CVA200",45,0)
+"RTN","C0CVA200",50,0)
+  Q NAME("SUFFIX")
+"RTN","C0CVA200",51,0)
   ;
-"RTN","C0CVA200",46,0)
-SUFFIX(DUZ) ; Get Suffix Name, PUBLIC; EXTRINSIC
-"RTN","C0CVA200",47,0)
+"RTN","C0CVA200",52,0)
+TITLE(DUZ) ; Get Title for Proivder, PUBLIC; EXTRINSIC
+"RTN","C0CVA200",53,0)
   ; INPUT: DUZ ByVal
-"RTN","C0CVA200",48,0)
+"RTN","C0CVA200",54,0)
   ; OUTPUT: String
-"RTN","C0CVA200",49,0)
-  N NAME S NAME=$P(^VA(200,DUZ,0),U)
-"RTN","C0CVA200",50,0)
-  D NAMECOMP^XLFNAME(.NAME)
-"RTN","C0CVA200",51,0)
-  Q NAME("SUFFIX")
-"RTN","C0CVA200",52,0)
+"RTN","C0CVA200",55,0)
+  ; Gets External Value of Title field in New Person File.
+"RTN","C0CVA200",56,0)
+  ; It's actually a pointer to file 3.1
+"RTN","C0CVA200",57,0)
+  ; 200=New Person File; 8 is Title Field
+"RTN","C0CVA200",58,0)
+  Q $$GET1^DIQ(200,DUZ_",",8)
+"RTN","C0CVA200",59,0)
   ;
-"RTN","C0CVA200",53,0)
-TITLE(DUZ) ; Get Title for Proivder, PUBLIC; EXTRINSIC
-"RTN","C0CVA200",54,0)
+"RTN","C0CVA200",60,0)
+NPI(DUZ) ; Get NPI Number, PUBLIC; EXTRINSIC
+"RTN","C0CVA200",61,0)
   ; INPUT: DUZ ByVal
-"RTN","C0CVA200",55,0)
+"RTN","C0CVA200",62,0)
+  ; OUTPUT: Delimited String in format:
+"RTN","C0CVA200",63,0)
+  ; IDType^ID^IDDescription
+"RTN","C0CVA200",64,0)
+  ; If the NPI doesn't exist, "" is returned.
+"RTN","C0CVA200",65,0)
+  ; This routine uses a call documented in the Kernel dev guide
+"RTN","C0CVA200",66,0)
+  ; This call returns as "NPI^TimeEntered^ActiveInactive"
+"RTN","C0CVA200",67,0)
+  ; It returns -1 for NPI if NPI doesn't exist.
+"RTN","C0CVA200",68,0)
+  N NPI S NPI=$P($$NPI^XUSNPI("Individual_ID",DUZ),U)
+"RTN","C0CVA200",69,0)
+  Q:NPI=-1 ""
+"RTN","C0CVA200",70,0)
+  Q "NPI^"_NPI_"^HHS"
+"RTN","C0CVA200",71,0)
+  ;
+"RTN","C0CVA200",72,0)
+SPEC(DUZ) ; Get Provider Specialty, PUBLIC; EXTRINSIC
+"RTN","C0CVA200",73,0)
+  ; INPUT: DUZ ByVal
+"RTN","C0CVA200",74,0)
+  ; OUTPUT: String: ProviderType/Specialty/Subspecialty OR ""
+"RTN","C0CVA200",75,0)
+  ; Uses a Kernel API. Returns -1 if a specialty is not specified
+"RTN","C0CVA200",76,0)
+  ; in file 200.
+"RTN","C0CVA200",77,0)
+  ; Otherwise, returns IEN^Profession^Specialty^Sub­specialty^Effect date^Expired date^VA code
+"RTN","C0CVA200",78,0)
+  N STR S STR=$$GET^XUA4A72(DUZ)
+"RTN","C0CVA200",79,0)
+  Q:+STR<0 ""
+"RTN","C0CVA200",80,0)
+  ; Sometimes we have 3 pieces, or 2. Deal with that.
+"RTN","C0CVA200",81,0)
+  Q:$L($P(STR,U,4)) $P(STR,U,2)_"-"_$P(STR,U,3)_"-"_$P(STR,U,4)
+"RTN","C0CVA200",82,0)
+  Q $P(STR,U,2)_"-"_$P(STR,U,3)
+"RTN","C0CVA200",83,0)
+  ;
+"RTN","C0CVA200",84,0)
+ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC
+"RTN","C0CVA200",85,0)
+  ; INPUT: DUZ, but not needed really... here for future expansion
+"RTN","C0CVA200",86,0)
+  ; OUTPUT: At this point "Work"
+"RTN","C0CVA200",87,0)
+  Q "Work"
+"RTN","C0CVA200",88,0)
+  ;
+"RTN","C0CVA200",89,0)
+ADDLINE1(ADUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC ; CHANGED PARAMETER TO ADUZ TO KEEP FROM CRASHING GPL 1/09
+"RTN","C0CVA200",90,0)
+  ; INPUT: DUZ ByVal
+"RTN","C0CVA200",91,0)
+  ; Output: String.
+"RTN","C0CVA200",92,0)
+  ;
+"RTN","C0CVA200",93,0)
+  ; First, get site number from the institution file.
+"RTN","C0CVA200",94,0)
+  ; 1st piece returned by $$SITE^VASITE, which gets the system institution
+"RTN","C0CVA200",95,0)
+  N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","C0CVA200",96,0)
+  ;
+"RTN","C0CVA200",97,0)
+  ; Second, get mailing address
+"RTN","C0CVA200",98,0)
+  ; There are two APIs to get the address, one for physical and one for
+"RTN","C0CVA200",99,0)
+  ; mailing. We will check if mailing exists first, since that's the
+"RTN","C0CVA200",100,0)
+  ; one we want to use; then check for physical. If neither exists,
+"RTN","C0CVA200",101,0)
+  ; then we return nothing. We check for the existence of an address
+"RTN","C0CVA200",102,0)
+  ; by the length of the returned string.
+"RTN","C0CVA200",103,0)
+  ; NOTE: API doesn't support Address 2, so I won't even include it
+"RTN","C0CVA200",104,0)
+  ; in the template.
+"RTN","C0CVA200",105,0)
+  N ADD
+"RTN","C0CVA200",106,0)
+  S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","C0CVA200",107,0)
+  Q:$L(ADD) $P(ADD,U)
+"RTN","C0CVA200",108,0)
+  S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","C0CVA200",109,0)
+  Q:$L(ADD) $P(ADD,U)
+"RTN","C0CVA200",110,0)
+  Q ""
+"RTN","C0CVA200",111,0)
+  ;
+"RTN","C0CVA200",112,0)
+CITY(ADUZ) ; Get City for Institution. PUBLIC; EXTRINSIC
+"RTN","C0CVA200",113,0)
+    ;GPL CHANGED PARAMETER TO ADUZ TO KEEP $$SITE^VASITE FROM CRASHING 
+"RTN","C0CVA200",114,0)
+  ; INPUT: DUZ ByVal
+"RTN","C0CVA200",115,0)
+  ; Output: String.
+"RTN","C0CVA200",116,0)
+  ; See ADD1 for comments
+"RTN","C0CVA200",117,0)
+  N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","C0CVA200",118,0)
+  N ADD
+"RTN","C0CVA200",119,0)
+  S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","C0CVA200",120,0)
+  Q:$L(ADD) $P(ADD,U,2)
+"RTN","C0CVA200",121,0)
+  S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","C0CVA200",122,0)
+  Q:$L(ADD) $P(ADD,U,2)
+"RTN","C0CVA200",123,0)
+  Q ""
+"RTN","C0CVA200",124,0)
+  ;
+"RTN","C0CVA200",125,0)
+STATE(ADUZ) ; Get State for Institution. PUBLIC; EXTRINSIC
+"RTN","C0CVA200",126,0)
+  ; INPUT: DUZ ByVal
+"RTN","C0CVA200",127,0)
+  ; Output: String.
+"RTN","C0CVA200",128,0)
+  ; See ADD1 for comments
+"RTN","C0CVA200",129,0)
+  N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","C0CVA200",130,0)
+  N ADD
+"RTN","C0CVA200",131,0)
+  S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","C0CVA200",132,0)
+  Q:$L(ADD) $P(ADD,U,3)
+"RTN","C0CVA200",133,0)
+  S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","C0CVA200",134,0)
+  Q:$L(ADD) $P(ADD,U,3)
+"RTN","C0CVA200",135,0)
+  Q ""
+"RTN","C0CVA200",136,0)
+  ;
+"RTN","C0CVA200",137,0)
+POSTCODE(ADUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC
+"RTN","C0CVA200",138,0)
+  ; INPUT: DUZ ByVal
+"RTN","C0CVA200",139,0)
+  ; OUTPUT: String.
+"RTN","C0CVA200",140,0)
+  ; See ADD1 for comments
+"RTN","C0CVA200",141,0)
+  N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","C0CVA200",142,0)
+  N ADD
+"RTN","C0CVA200",143,0)
+  S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","C0CVA200",144,0)
+  Q:$L(ADD) $P(ADD,U,4)
+"RTN","C0CVA200",145,0)
+  S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","C0CVA200",146,0)
+  Q:$L(ADD) $P(ADD,U,4)
+"RTN","C0CVA200",147,0)
+  Q ""
+"RTN","C0CVA200",148,0)
+  ;
+"RTN","C0CVA200",149,0)
+TEL(DUZ) ; Get Office Phone number. PUBLIC; EXTRINSIC
+"RTN","C0CVA200",150,0)
+  ; INPUT: DUZ ByVal
+"RTN","C0CVA200",151,0)
+  ; OUTPUT: String.
+"RTN","C0CVA200",152,0)
+  ; Direct global access
+"RTN","C0CVA200",153,0)
+  N TEL S TEL=$G(^VA(200,DUZ,.13))
+"RTN","C0CVA200",154,0)
+  Q $P(TEL,U,2)
+"RTN","C0CVA200",155,0)
+  ;
+"RTN","C0CVA200",156,0)
+TELTYPE(DUZ) ; Get Telephone Type. PUBLIC; EXTRINSIC
+"RTN","C0CVA200",157,0)
+  ; INPUT: DUZ ByVal
+"RTN","C0CVA200",158,0)
+  ; OUTPUT: String.
+"RTN","C0CVA200",159,0)
+  Q "Office"
+"RTN","C0CVA200",160,0)
+  ;
+"RTN","C0CVA200",161,0)
+EMAIL(DUZ) ; Get Provider's Email. PUBLIC; EXTRINSIC
+"RTN","C0CVA200",162,0)
+  ; INPUT: DUZ ByVal
+"RTN","C0CVA200",163,0)
   ; OUTPUT: String
-"RTN","C0CVA200",56,0)
-  ; Gets External Value of Title field in New Person File.
-"RTN","C0CVA200",57,0)
-  ; It's actually a pointer to file 3.1
-"RTN","C0CVA200",58,0)
-  ; 200=New Person File; 8 is Title Field
-"RTN","C0CVA200",59,0)
-  Q $$GET1^DIQ(200,DUZ_",",8)
-"RTN","C0CVA200",60,0)
-  ;
-"RTN","C0CVA200",61,0)
-NPI(DUZ) ; Get NPI Number, PUBLIC; EXTRINSIC
-"RTN","C0CVA200",62,0)
-  ; INPUT: DUZ ByVal
-"RTN","C0CVA200",63,0)
-  ; OUTPUT: Delimited String in format:
-"RTN","C0CVA200",64,0)
-  ; IDType^ID^IDDescription
-"RTN","C0CVA200",65,0)
-  ; If the NPI doesn't exist, "" is returned.
-"RTN","C0CVA200",66,0)
-  ; This routine uses a call documented in the Kernel dev guide
-"RTN","C0CVA200",67,0)
-  ; This call returns as "NPI^TimeEntered^ActiveInactive"
-"RTN","C0CVA200",68,0)
-  ; It returns -1 for NPI if NPI doesn't exist.
-"RTN","C0CVA200",69,0)
-  N NPI S NPI=$P($$NPI^XUSNPI("Individual_ID",DUZ),U)
-"RTN","C0CVA200",70,0)
-  Q:NPI=-1 ""
-"RTN","C0CVA200",71,0)
-  Q "NPI^"_NPI_"^HHS"
-"RTN","C0CVA200",72,0)
-  ;
-"RTN","C0CVA200",73,0)
-SPEC(DUZ) ; Get Provider Specialty, PUBLIC; EXTRINSIC
-"RTN","C0CVA200",74,0)
-  ; INPUT: DUZ ByVal
-"RTN","C0CVA200",75,0)
-  ; OUTPUT: String: ProviderType/Specialty/Subspecialty OR ""
-"RTN","C0CVA200",76,0)
-  ; Uses a Kernel API. Returns -1 if a specialty is not specified
-"RTN","C0CVA200",77,0)
-  ; in file 200.
-"RTN","C0CVA200",78,0)
-  ; Otherwise, returns IEN^Profession^Specialty^Sub­specialty^Effect date^Expired date^VA code
-"RTN","C0CVA200",79,0)
-  N STR S STR=$$GET^XUA4A72(DUZ)
-"RTN","C0CVA200",80,0)
-  Q:+STR<0 ""
-"RTN","C0CVA200",81,0)
-  ; Sometimes we have 3 pieces, or 2. Deal with that.
-"RTN","C0CVA200",82,0)
-  Q:$L($P(STR,U,4)) $P(STR,U,2)_"-"_$P(STR,U,3)_"-"_$P(STR,U,4)
-"RTN","C0CVA200",83,0)
-  Q $P(STR,U,2)_"-"_$P(STR,U,3)
-"RTN","C0CVA200",84,0)
-  ;
-"RTN","C0CVA200",85,0)
-ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC
-"RTN","C0CVA200",86,0)
-  ; INPUT: DUZ, but not needed really... here for future expansion
-"RTN","C0CVA200",87,0)
-  ; OUTPUT: At this point "Work"
-"RTN","C0CVA200",88,0)
-  Q "Work"
-"RTN","C0CVA200",89,0)
-  ;
-"RTN","C0CVA200",90,0)
-ADDLINE1(ADUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC ; CHANGED PARAMETER TO ADUZ TO KEEP FROM CRASHING GPL 1/09
-"RTN","C0CVA200",91,0)
-  ; INPUT: DUZ ByVal
-"RTN","C0CVA200",92,0)
-  ; Output: String.
-"RTN","C0CVA200",93,0)
-  ;
-"RTN","C0CVA200",94,0)
-  ; First, get site number from the institution file.
-"RTN","C0CVA200",95,0)
-  ; 1st piece returned by $$SITE^VASITE, which gets the system institution
-"RTN","C0CVA200",96,0)
-  N INST S INST=$P($$SITE^VASITE(),U)
-"RTN","C0CVA200",97,0)
-  ;
-"RTN","C0CVA200",98,0)
-  ; Second, get mailing address
-"RTN","C0CVA200",99,0)
-  ; There are two APIs to get the address, one for physical and one for
-"RTN","C0CVA200",100,0)
-  ; mailing. We will check if mailing exists first, since that's the
-"RTN","C0CVA200",101,0)
-  ; one we want to use; then check for physical. If neither exists,
-"RTN","C0CVA200",102,0)
-  ; then we return nothing. We check for the existence of an address
-"RTN","C0CVA200",103,0)
-  ; by the length of the returned string.
-"RTN","C0CVA200",104,0)
-  ; NOTE: API doesn't support Address 2, so I won't even include it
-"RTN","C0CVA200",105,0)
-  ; in the template.
-"RTN","C0CVA200",106,0)
-  N ADD
-"RTN","C0CVA200",107,0)
-  S ADD=$$MADD^XUAF4(INST) ; mailing address
-"RTN","C0CVA200",108,0)
-  Q:$L(ADD) $P(ADD,U)
-"RTN","C0CVA200",109,0)
-  S ADD=$$PADD^XUAF4(INST) ; physical address
-"RTN","C0CVA200",110,0)
-  Q:$L(ADD) $P(ADD,U)
-"RTN","C0CVA200",111,0)
-  Q ""
-"RTN","C0CVA200",112,0)
-  ;
-"RTN","C0CVA200",113,0)
-CITY(ADUZ) ; Get City for Institution. PUBLIC; EXTRINSIC
-"RTN","C0CVA200",114,0)
-    ;GPL CHANGED PARAMETER TO ADUZ TO KEEP $$SITE^VASITE FROM CRASHING 
-"RTN","C0CVA200",115,0)
-  ; INPUT: DUZ ByVal
-"RTN","C0CVA200",116,0)
-  ; Output: String.
-"RTN","C0CVA200",117,0)
-  ; See ADD1 for comments
-"RTN","C0CVA200",118,0)
-  N INST S INST=$P($$SITE^VASITE(),U)
-"RTN","C0CVA200",119,0)
-  N ADD
-"RTN","C0CVA200",120,0)
-  S ADD=$$MADD^XUAF4(INST) ; mailing address
-"RTN","C0CVA200",121,0)
-  Q:$L(ADD) $P(ADD,U,2)
-"RTN","C0CVA200",122,0)
-  S ADD=$$PADD^XUAF4(INST) ; physical address
-"RTN","C0CVA200",123,0)
-  Q:$L(ADD) $P(ADD,U,2)
-"RTN","C0CVA200",124,0)
-  Q ""
-"RTN","C0CVA200",125,0)
-  ;
-"RTN","C0CVA200",126,0)
-STATE(ADUZ) ; Get State for Institution. PUBLIC; EXTRINSIC
-"RTN","C0CVA200",127,0)
-  ; INPUT: DUZ ByVal
-"RTN","C0CVA200",128,0)
-  ; Output: String.
-"RTN","C0CVA200",129,0)
-  ; See ADD1 for comments
-"RTN","C0CVA200",130,0)
-  N INST S INST=$P($$SITE^VASITE(),U)
-"RTN","C0CVA200",131,0)
-  N ADD
-"RTN","C0CVA200",132,0)
-  S ADD=$$MADD^XUAF4(INST) ; mailing address
-"RTN","C0CVA200",133,0)
-  Q:$L(ADD) $P(ADD,U,3)
-"RTN","C0CVA200",134,0)
-  S ADD=$$PADD^XUAF4(INST) ; physical address
-"RTN","C0CVA200",135,0)
-  Q:$L(ADD) $P(ADD,U,3)
-"RTN","C0CVA200",136,0)
-  Q ""
-"RTN","C0CVA200",137,0)
-  ;
-"RTN","C0CVA200",138,0)
-POSTCODE(ADUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC
-"RTN","C0CVA200",139,0)
-  ; INPUT: DUZ ByVal
-"RTN","C0CVA200",140,0)
-  ; OUTPUT: String.
-"RTN","C0CVA200",141,0)
-  ; See ADD1 for comments
-"RTN","C0CVA200",142,0)
-  N INST S INST=$P($$SITE^VASITE(),U)
-"RTN","C0CVA200",143,0)
-  N ADD
-"RTN","C0CVA200",144,0)
-  S ADD=$$MADD^XUAF4(INST) ; mailing address
-"RTN","C0CVA200",145,0)
-  Q:$L(ADD) $P(ADD,U,4)
-"RTN","C0CVA200",146,0)
-  S ADD=$$PADD^XUAF4(INST) ; physical address
-"RTN","C0CVA200",147,0)
-  Q:$L(ADD) $P(ADD,U,4)
-"RTN","C0CVA200",148,0)
-  Q ""
-"RTN","C0CVA200",149,0)
-  ;
-"RTN","C0CVA200",150,0)
-TEL(DUZ) ; Get Office Phone number. PUBLIC; EXTRINSIC
-"RTN","C0CVA200",151,0)
-  ; INPUT: DUZ ByVal
-"RTN","C0CVA200",152,0)
-  ; OUTPUT: String.
-"RTN","C0CVA200",153,0)
+"RTN","C0CVA200",164,0)
   ; Direct global access
-"RTN","C0CVA200",154,0)
-  N TEL S TEL=$G(^VA(200,DUZ,.13))
-"RTN","C0CVA200",155,0)
-  Q $P(TEL,U,2)
-"RTN","C0CVA200",156,0)
-  ;
-"RTN","C0CVA200",157,0)
-TELTYPE(DUZ) ; Get Telephone Type. PUBLIC; EXTRINSIC
-"RTN","C0CVA200",158,0)
-  ; INPUT: DUZ ByVal
-"RTN","C0CVA200",159,0)
-  ; OUTPUT: String.
-"RTN","C0CVA200",160,0)
-  Q "Office"
-"RTN","C0CVA200",161,0)
-  ;
-"RTN","C0CVA200",162,0)
-EMAIL(DUZ) ; Get Provider's Email. PUBLIC; EXTRINSIC
-"RTN","C0CVA200",163,0)
-  ; INPUT: DUZ ByVal
-"RTN","C0CVA200",164,0)
-  ; OUTPUT: String
 "RTN","C0CVA200",165,0)
-  ; Direct global access
+  N EMAIL S EMAIL=$G(^VA(200,DUZ,.15))
 "RTN","C0CVA200",166,0)
-  N EMAIL S EMAIL=$G(^VA(200,DUZ,.15))
+  Q $P(EMAIL,U)
 "RTN","C0CVA200",167,0)
-  Q $P(EMAIL,U)
-"RTN","C0CVA200",168,0)
   ;
 "RTN","C0CVALID")
-0^110^B2856461
+0^110^B3624866
 "RTN","C0CVALID",1,0)
 C0CVALID ; C0C/OHUM/RUT - PROCESSING FOR DATE LIMITS, NOTES ; 22/12/2011
 "RTN","C0CVALID",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50;Build 2
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51;Build 2
 "RTN","C0CVALID",3,0)
+ ; (C) RUT 2011.
+"RTN","C0CVALID",4,0)
+ ;
+"RTN","C0CVALID",5,0)
+ ; This program is free software: you can redistribute it and/or modify
+"RTN","C0CVALID",6,0)
+ ; it under the terms of the GNU Affero General Public License as
+"RTN","C0CVALID",7,0)
+ ; published by the Free Software Foundation, either version 3 of the
+"RTN","C0CVALID",8,0)
+ ; License, or (at your option) any later version.
+"RTN","C0CVALID",9,0)
+ ;
+"RTN","C0CVALID",10,0)
+ ; This program is distributed in the hope that it will be useful,
+"RTN","C0CVALID",11,0)
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","C0CVALID",12,0)
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","C0CVALID",13,0)
+ ; GNU Affero General Public License for more details.
+"RTN","C0CVALID",14,0)
+ ;
+"RTN","C0CVALID",15,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CVALID",16,0)
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+"RTN","C0CVALID",17,0)
+ ;
+"RTN","C0CVALID",18,0)
  S ^TMP("C0CCCR","LABLIMIT")="",^TMP("C0CCCR","VITLIMIT")="",^TMP("C0CCCR","MEDLIMIT")="",^TMP("C0CCCR","TIULIMIT")=""
-"RTN","C0CVALID",4,0)
+"RTN","C0CVALID",19,0)
  S %DT="AEX",%DT("A")="LAB Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","LABLIMIT")=Y
-"RTN","C0CVALID",5,0)
+"RTN","C0CVALID",20,0)
  S %DT="AEX",%DT("A")="VITAL Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","VITLIMIT")=Y
-"RTN","C0CVALID",6,0)
+"RTN","C0CVALID",21,0)
  S %DT="AEX",%DT("A")="MEDICATION Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","MEDLIMIT")=Y
-"RTN","C0CVALID",7,0)
+"RTN","C0CVALID",22,0)
  ;S ^TMP("C0CCCR","RALIMIT")="",%DT="AEX",%DT("A")="RADIOLOGY Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","RALIMIT")=Y
-"RTN","C0CVALID",8,0)
+"RTN","C0CVALID",23,0)
  W !,"Do you want to include Notes: YES/NO? //NO" D YN^DICN I %=1 S %DT="AEX",%DT("A")="NOTE Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","TIULIMIT")=Y
-"RTN","C0CVALID",9,0)
+"RTN","C0CVALID",24,0)
  Q
-"RTN","C0CVALID",10,0)
+"RTN","C0CVALID",25,0)
 HTOF(FLAGS) ;Changing DATE in FILMAN's FORMAT
-"RTN","C0CVALID",11,0)
+"RTN","C0CVALID",26,0)
  N HORLOGDATECUR,COVDATE,HORLOGDATE,FDATE
-"RTN","C0CVALID",12,0)
+"RTN","C0CVALID",27,0)
  S HORLOGDATECUR=$P($H,",",1)
-"RTN","C0CVALID",13,0)
+"RTN","C0CVALID",28,0)
  S COVDATE=$P(FLAGS,"-",2)
-"RTN","C0CVALID",14,0)
+"RTN","C0CVALID",29,0)
  S HORLOGDATE=HORLOGDATECUR-COVDATE
-"RTN","C0CVALID",15,0)
+"RTN","C0CVALID",30,0)
  S (FDATE)=$$H2F^XLFDT(HORLOGDATE)
-"RTN","C0CVALID",16,0)
+"RTN","C0CVALID",31,0)
  K HORLOGDATECUR,COVDATE,HORLOGDATE
-"RTN","C0CVALID",17,0)
+"RTN","C0CVALID",32,0)
  Q FDATE
 "RTN","C0CVIT2")
-0^66^B320700684
+0^66^B317310035
 "RTN","C0CVIT2",1,0)
 C0CVIT2 ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
 "RTN","C0CVIT2",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CVIT2",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota and others.
 "RTN","C0CVIT2",4,0)
- ;Licensed under the terms of the GNU General Public License.
+ ;
 "RTN","C0CVIT2",5,0)
- ;See attached copy of the License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CVIT2",6,0)
- ;
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CVIT2",7,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CVIT2",8,0)
- ;it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
 "RTN","C0CVIT2",9,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ;
 "RTN","C0CVIT2",10,0)
- ;(at your option) any later version.
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CVIT2",11,0)
- ;
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CVIT2",12,0)
- ;This program is distributed in the hope that it will be useful,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CVIT2",13,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; GNU Affero General Public License for more details.
 "RTN","C0CVIT2",14,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;
 "RTN","C0CVIT2",15,0)
- ;GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CVIT2",16,0)
- ;
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CVIT2",17,0)
- ;You should have received a copy of the GNU General Public License along
+ ;
 "RTN","C0CVIT2",18,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ W "NO ENTRY FROM TOP",!
 "RTN","C0CVIT2",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ Q
 "RTN","C0CVIT2",20,0)
  ;
 "RTN","C0CVIT2",21,0)
- W "NO ENTRY FROM TOP",!
+EXTRACT(VITXML,DFN,VITOUT) ; EXTRACT VITAL SIGNS INTO XML TEMPLATE
 "RTN","C0CVIT2",22,0)
+ ; VITXML AND VITOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","C0CVIT2",23,0)
+ ;
+"RTN","C0CVIT2",24,0)
+ ; USE THE FOLLOWING TEMPLATE FOR THE RNF2 ARRAYS
+"RTN","C0CVIT2",25,0)
+ ; THAT GET PASSED TO *GET ROUTINES
+"RTN","C0CVIT2",26,0)
+ ;C0C[NAME]=$NA(^TMP("C0CCCR",$J,DFN,"C0C(NAME))
+"RTN","C0CVIT2",27,0)
+ N C0CVIT
+"RTN","C0CVIT2",28,0)
+ S C0CVIT=$NA(^TMP("C0CCCR",$J,DFN,"C0CVIT"))
+"RTN","C0CVIT2",29,0)
+ ; USE THE FOLLOWING TEMPLATE FOR GETTING/GENERATING THE RNF2 ARRAYS
+"RTN","C0CVIT2",30,0)
+ ; THAT GET INSERTED INTO THE XML TEMPLATE
+"RTN","C0CVIT2",31,0)
+ ; D GET[VISTA/RPMS](DFN,C0CIMM) ; GET VARS
+"RTN","C0CVIT2",32,0)
+ I $$RPMS^C0CUTIL() D GETRPMS(DFN,C0CVIT) ; GET VARS
+"RTN","C0CVIT2",33,0)
+ I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D GETVISTA(DFN,C0CVIT)
+"RTN","C0CVIT2",34,0)
+ ; USE THE FOLLOWING TEMPATE FOR MAPPING RNF2 ARRAYS TO XML TEMPLATE
+"RTN","C0CVIT2",35,0)
+ ; D MAP([NAME]XML,C0C[NAME],[NAME]OUT) ;MAP RESULTS FOR PROCEDURES
+"RTN","C0CVIT2",36,0)
+ D MAP(VITXML,C0CVIT,VITOUT) ;MAP RESULTS FOR PROCEDURES
+"RTN","C0CVIT2",37,0)
  Q
-"RTN","C0CVIT2",23,0)
- ;
-"RTN","C0CVIT2",24,0)
-EXTRACT(VITXML,DFN,VITOUT) ; EXTRACT VITAL SIGNS INTO XML TEMPLATE
-"RTN","C0CVIT2",25,0)
- ; VITXML AND VITOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","C0CVIT2",26,0)
- ;
-"RTN","C0CVIT2",27,0)
- ; USE THE FOLLOWING TEMPLATE FOR THE RNF2 ARRAYS
-"RTN","C0CVIT2",28,0)
- ; THAT GET PASSED TO *GET ROUTINES
-"RTN","C0CVIT2",29,0)
- ;C0C[NAME]=$NA(^TMP("C0CCCR",$J,DFN,"C0C(NAME))
-"RTN","C0CVIT2",30,0)
- N C0CVIT
-"RTN","C0CVIT2",31,0)
- S C0CVIT=$NA(^TMP("C0CCCR",$J,DFN,"C0CVIT"))
-"RTN","C0CVIT2",32,0)
- ; USE THE FOLLOWING TEMPLATE FOR GETTING/GENERATING THE RNF2 ARRAYS
-"RTN","C0CVIT2",33,0)
- ; THAT GET INSERTED INTO THE XML TEMPLATE
-"RTN","C0CVIT2",34,0)
- ; D GET[VISTA/RPMS](DFN,C0CIMM) ; GET VARS
-"RTN","C0CVIT2",35,0)
- I $$RPMS^C0CUTIL() D GETRPMS(DFN,C0CVIT) ; GET VARS
-"RTN","C0CVIT2",36,0)
- I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D GETVISTA(DFN,C0CVIT)
-"RTN","C0CVIT2",37,0)
- ; USE THE FOLLOWING TEMPATE FOR MAPPING RNF2 ARRAYS TO XML TEMPLATE
 "RTN","C0CVIT2",38,0)
- ; D MAP([NAME]XML,C0C[NAME],[NAME]OUT) ;MAP RESULTS FOR PROCEDURES
+ ;
 "RTN","C0CVIT2",39,0)
- D MAP(VITXML,C0CVIT,VITOUT) ;MAP RESULTS FOR PROCEDURES
+GETVISTA(DFN,C0CVIT) ; CALLS VITALS^ORQQVI TO GET VITAL SIGNS. 
 "RTN","C0CVIT2",40,0)
+ ; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
+"RTN","C0CVIT2",41,0)
+ ; C0CVIT: VITAL SIGNS
+"RTN","C0CVIT2",42,0)
+ ; READY TO BE MAPPED TO XML BY MAP^C0CVIT2
+"RTN","C0CVIT2",43,0)
+ ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY 
+"RTN","C0CVIT2",44,0)
+ ; EXIST.
+"RTN","C0CVIT2",45,0)
+ ;
+"RTN","C0CVIT2",46,0)
+ ; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J))
+"RTN","C0CVIT2",47,0)
+ ;
+"RTN","C0CVIT2",48,0)
+ ; SETUP RPC/API CALL HERE
+"RTN","C0CVIT2",49,0)
+ ; USE START AND END DATES FROM PARAMETERS IF REQUIRED
+"RTN","C0CVIT2",50,0)
+ ;
+"RTN","C0CVIT2",51,0)
+ N VIT,DATA,START,END
+"RTN","C0CVIT2",52,0)
+ ; RPC REQUIRES FM DATES NOT T-* DATES
+"RTN","C0CVIT2",53,0)
+ D DT^DILF(,$$GET^C0CPARMS("VITLIMIT"),.END) ; GET THE LIMIT PARM
+"RTN","C0CVIT2",54,0)
+ D DT^DILF(,$$GET^C0CPARMS("VITSTART"),.START) ; GET START PARM
+"RTN","C0CVIT2",55,0)
+ ; RPC CALL (ORY,DFN,ORSDT,OREDT):
+"RTN","C0CVIT2",56,0)
+ ;ORY: return variable
+"RTN","C0CVIT2",57,0)
+ ;DFN: patient identifier from Patient File [#2]
+"RTN","C0CVIT2",58,0)
+ ;ORSDT: start date/time in Fileman format
+"RTN","C0CVIT2",59,0)
+ ;OREDT: end date/time in Fileman format
+"RTN","C0CVIT2",60,0)
+ ; OUTPUT FORMAT:
+"RTN","C0CVIT2",61,0)
+ ;vital measurement ien^vital type^rate^date/time taken
+"RTN","C0CVIT2",62,0)
+ D VITALS^ORQQVI(.VIT,DFN,START,END) ; RUN QUERY VITALS CALL
+"RTN","C0CVIT2",63,0)
+ I '$D(VIT) S @VITOUT@(0)=0 K VIT Q  ; RETURN NOT FOUND, KILL ARRAY AND QUIT
+"RTN","C0CVIT2",64,0)
+ I $P(VIT(1),U,2)="No vitals found." D  Q  ; signal no vitals and quit
+"RTN","C0CVIT2",65,0)
+ . I $D(VITOUT) S @VITOUT@(0)=0
+"RTN","C0CVIT2",66,0)
+ . K VIT
+"RTN","C0CVIT2",67,0)
+ ;
+"RTN","C0CVIT2",68,0)
+ ; PREFORM SORT HERE IF NEEDED
+"RTN","C0CVIT2",69,0)
+ ;
+"RTN","C0CVIT2",70,0)
+ ; SORT IS REQUIRED FOR VITAL SIGNS - LATEST VITALS NEED TO BE LISTED FIRST
+"RTN","C0CVIT2",71,0)
+ ; COPIED SORT LOGIC:
+"RTN","C0CVIT2",72,0)
+ N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
+"RTN","C0CVIT2",73,0)
+ D VITSORT(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
+"RTN","C0CVIT2",74,0)
+ S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
+"RTN","C0CVIT2",75,0)
+ ; VSORT IS VITALS IN REVERSE ORDER
+"RTN","C0CVIT2",76,0)
+ ;
+"RTN","C0CVIT2",77,0)
+ ; MAP EACH ROW OF RPC/API TO RNF1 ARRAY
+"RTN","C0CVIT2",78,0)
+ ; RNF1 ARRAY FORMAT:
+"RTN","C0CVIT2",79,0)
+ ; VAR("NAME_OF_RIM_VARIABLE")=VALUE
+"RTN","C0CVIT2",80,0)
+ ;
+"RTN","C0CVIT2",81,0)
+ ; VITAL SIGNS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF VITAL SIGNS
+"RTN","C0CVIT2",82,0)
+ ; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD
+"RTN","C0CVIT2",83,0)
+ ; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS
+"RTN","C0CVIT2",84,0)
+ N C0CVI,C0CC,ZRNF
+"RTN","C0CVIT2",85,0)
+ ;S C0CVI="" ; INITIALIZE FOR $O
+"RTN","C0CVIT2",86,0)
+ F C0CC=1:1:VSORT(0) S C0CVI=VSORT(C0CC) D  ; FOR EACH VITAL SIGN IN THE LIST
+"RTN","C0CVIT2",87,0)
+ . I DEBUG W VIT(C0CVI),!
+"RTN","C0CVIT2",88,0)
+ . ; FIGURE OUT WHICH TYPE OF VITAL SIGN IT IS (HEIGHT, WEIGHT, BLOOD PRESSURE, TEMPERATURE, RESPIRATION, PULSE, PAIN, OTHER)
+"RTN","C0CVIT2",89,0)
+ . D:$P(VIT(C0CVI),U,3)="HT" HEIGHT1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"in")
+"RTN","C0CVIT2",90,0)
+ . D:$P(VIT(C0CVI),U,3)="WT" WEIGHT1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"lbs")
+"RTN","C0CVIT2",91,0)
+ . D:$P(VIT(C0CVI),U,3)="BP" BP1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"")
+"RTN","C0CVIT2",92,0)
+ . D:$P(VIT(C0CVI),U,3)="T" TMP1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"F")
+"RTN","C0CVIT2",93,0)
+ . D:$P(VIT(C0CVI),U,3)="R" RESP1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"")
+"RTN","C0CVIT2",94,0)
+ . D:$P(VIT(C0CVI),U,3)="P" PULSE1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"")
+"RTN","C0CVIT2",95,0)
+ . D:$P(VIT(C0CVI),U,3)="PN" PAIN1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"")
+"RTN","C0CVIT2",96,0)
+ . D:'$D(ZRNF) OTHER1($$FMDTOUTC^C0CUTIL($P(C0CVI,U,4),"DT"),"OTHER VITAL",$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"UNKNOWN") ;IF THE VITAL ISN'T DEFINED IT IS OTHER
+"RTN","C0CVIT2",97,0)
+ . D RNF1TO2^C0CRNF(C0CVIT,"ZRNF") ;ADD THIS ROW TO THE ARRAY
+"RTN","C0CVIT2",98,0)
+ . K ZRNF
+"RTN","C0CVIT2",99,0)
+ ; SAVE RIM VARIABLES SEE C0CRIMA
+"RTN","C0CVIT2",100,0)
+ N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"VITALS"))
+"RTN","C0CVIT2",101,0)
+ M @ZRIM=@C0CVIT@("V")
+"RTN","C0CVIT2",102,0)
  Q
-"RTN","C0CVIT2",41,0)
- ;
-"RTN","C0CVIT2",42,0)
-GETVISTA(DFN,C0CVIT) ; CALLS VITALS^ORQQVI TO GET VITAL SIGNS. 
-"RTN","C0CVIT2",43,0)
+"RTN","C0CVIT2",103,0)
+ ;
+"RTN","C0CVIT2",104,0)
+GETRPMS(DFN,C0CVIT) ; CALLS QUERY^BEHOVM TO GET VITAL SIGNS. 
+"RTN","C0CVIT2",105,0)
  ; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
-"RTN","C0CVIT2",44,0)
+"RTN","C0CVIT2",106,0)
  ; C0CVIT: VITAL SIGNS
-"RTN","C0CVIT2",45,0)
+"RTN","C0CVIT2",107,0)
  ; READY TO BE MAPPED TO XML BY MAP^C0CVIT2
-"RTN","C0CVIT2",46,0)
+"RTN","C0CVIT2",108,0)
  ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY 
-"RTN","C0CVIT2",47,0)
+"RTN","C0CVIT2",109,0)
  ; EXIST.
-"RTN","C0CVIT2",48,0)
- ;
-"RTN","C0CVIT2",49,0)
+"RTN","C0CVIT2",110,0)
+ ;
+"RTN","C0CVIT2",111,0)
  ; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J))
-"RTN","C0CVIT2",50,0)
- ;
-"RTN","C0CVIT2",51,0)
+"RTN","C0CVIT2",112,0)
+ ;
+"RTN","C0CVIT2",113,0)
  ; SETUP RPC/API CALL HERE
-"RTN","C0CVIT2",52,0)
+"RTN","C0CVIT2",114,0)
  ; USE START AND END DATES FROM PARAMETERS IF REQUIRED
-"RTN","C0CVIT2",53,0)
- ;
-"RTN","C0CVIT2",54,0)
- N VIT,DATA,START,END
-"RTN","C0CVIT2",55,0)
+"RTN","C0CVIT2",115,0)
+ ;
+"RTN","C0CVIT2",116,0)
+ ; RPMS VITAL RPC ONLY RETURNS LATEST VITAL IN SPECIFIED DATE RANGE NOT ALL VITALS IN DATE RANGE
+"RTN","C0CVIT2",117,0)
+ ; WE NEED TO SETUP THE VARIABLES THE INTERNAL CALL NEEDS TO BYPASS A HARD CODE OF ONE VITAL FOR DATE RANGE
+"RTN","C0CVIT2",118,0)
+ N C0CEDT,C0CSDT,VIT,DATA,START,END
+"RTN","C0CVIT2",119,0)
  ; RPC REQUIRES FM DATES NOT T-* DATES
-"RTN","C0CVIT2",56,0)
+"RTN","C0CVIT2",120,0)
  D DT^DILF(,$$GET^C0CPARMS("VITLIMIT"),.END) ; GET THE LIMIT PARM
-"RTN","C0CVIT2",57,0)
+"RTN","C0CVIT2",121,0)
  D DT^DILF(,$$GET^C0CPARMS("VITSTART"),.START) ; GET START PARM
-"RTN","C0CVIT2",58,0)
- ; RPC CALL (ORY,DFN,ORSDT,OREDT):
-"RTN","C0CVIT2",59,0)
- ;ORY: return variable
-"RTN","C0CVIT2",60,0)
- ;DFN: patient identifier from Patient File [#2]
-"RTN","C0CVIT2",61,0)
- ;ORSDT: start date/time in Fileman format
-"RTN","C0CVIT2",62,0)
- ;OREDT: end date/time in Fileman format
-"RTN","C0CVIT2",63,0)
- ; OUTPUT FORMAT:
-"RTN","C0CVIT2",64,0)
- ;vital measurement ien^vital type^rate^date/time taken
-"RTN","C0CVIT2",65,0)
- D VITALS^ORQQVI(.VIT,DFN,START,END) ; RUN QUERY VITALS CALL
-"RTN","C0CVIT2",66,0)
- I '$D(VIT) S @VITOUT@(0)=0 K VIT Q  ; RETURN NOT FOUND, KILL ARRAY AND QUIT
-"RTN","C0CVIT2",67,0)
- I $P(VIT(1),U,2)="No vitals found." D  Q  ; signal no vitals and quit
-"RTN","C0CVIT2",68,0)
- . I $D(VITOUT) S @VITOUT@(0)=0 
-"RTN","C0CVIT2",69,0)
- . K VIT
-"RTN","C0CVIT2",70,0)
- ;
-"RTN","C0CVIT2",71,0)
+"RTN","C0CVIT2",122,0)
+ ; RPC OUTPUT FORMAT:
+"RTN","C0CVIT2",123,0)
+ ; vfile ien^vital name^vital abbr^date/time taken(FM FORMAT)^value+units (US & metric)
+"RTN","C0CVIT2",124,0)
+ D QUERY^BEHOVM("LISTX") ; RUN QUERY VITALS CALL
+"RTN","C0CVIT2",125,0)
+ I '$D(^TMP("CIAVMRPC",$J)) S @VITOUT@(0)=0 K ^TMP("CIAVMRPC",$J) Q  ; RETURN NOT FOUND, KILL ARRAY AND QUIT
+"RTN","C0CVIT2",126,0)
+ ; MOVE THE ARRAY TO LOCAL VARIABLE
+"RTN","C0CVIT2",127,0)
+ M VIT=^TMP("CIAVMRPC",$J,0)
+"RTN","C0CVIT2",128,0)
+ ; RPC CLEANUP
+"RTN","C0CVIT2",129,0)
+ K ^TMP("CIAVMRPC",$J),VITS,RMAX,START,END,DATA,METRIC,VSTR,VUNT
+"RTN","C0CVIT2",130,0)
+ ;
+"RTN","C0CVIT2",131,0)
  ; PREFORM SORT HERE IF NEEDED
-"RTN","C0CVIT2",72,0)
- ;
-"RTN","C0CVIT2",73,0)
+"RTN","C0CVIT2",132,0)
+ ;
+"RTN","C0CVIT2",133,0)
  ; SORT IS REQUIRED FOR VITAL SIGNS - LATEST VITALS NEED TO BE LISTED FIRST
-"RTN","C0CVIT2",74,0)
+"RTN","C0CVIT2",134,0)
  ; COPIED SORT LOGIC:
-"RTN","C0CVIT2",75,0)
+"RTN","C0CVIT2",135,0)
  N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
-"RTN","C0CVIT2",76,0)
+"RTN","C0CVIT2",136,0)
  D VITSORT(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
-"RTN","C0CVIT2",77,0)
+"RTN","C0CVIT2",137,0)
  S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
-"RTN","C0CVIT2",78,0)
+"RTN","C0CVIT2",138,0)
  ; VSORT IS VITALS IN REVERSE ORDER
-"RTN","C0CVIT2",79,0)
- ;
-"RTN","C0CVIT2",80,0)
+"RTN","C0CVIT2",139,0)
+ ;
+"RTN","C0CVIT2",140,0)
  ; MAP EACH ROW OF RPC/API TO RNF1 ARRAY
-"RTN","C0CVIT2",81,0)
+"RTN","C0CVIT2",141,0)
  ; RNF1 ARRAY FORMAT:
-"RTN","C0CVIT2",82,0)
+"RTN","C0CVIT2",142,0)
  ; VAR("NAME_OF_RIM_VARIABLE")=VALUE
-"RTN","C0CVIT2",83,0)
- ;
-"RTN","C0CVIT2",84,0)
+"RTN","C0CVIT2",143,0)
+ ;
+"RTN","C0CVIT2",144,0)
  ; VITAL SIGNS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF VITAL SIGNS
-"RTN","C0CVIT2",85,0)
+"RTN","C0CVIT2",145,0)
  ; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD
-"RTN","C0CVIT2",86,0)
+"RTN","C0CVIT2",146,0)
  ; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS
-"RTN","C0CVIT2",87,0)
+"RTN","C0CVIT2",147,0)
  N C0CVI,C0CC,ZRNF
-"RTN","C0CVIT2",88,0)
+"RTN","C0CVIT2",148,0)
  ;S C0CVI="" ; INITIALIZE FOR $O
-"RTN","C0CVIT2",89,0)
+"RTN","C0CVIT2",149,0)
  F C0CC=1:1:VSORT(0) S C0CVI=VSORT(C0CC) D  ; FOR EACH VITAL SIGN IN THE LIST
-"RTN","C0CVIT2",90,0)
+"RTN","C0CVIT2",150,0)
  . I DEBUG W VIT(C0CVI),!
-"RTN","C0CVIT2",91,0)
+"RTN","C0CVIT2",151,0)
  . ; FIGURE OUT WHICH TYPE OF VITAL SIGN IT IS (HEIGHT, WEIGHT, BLOOD PRESSURE, TEMPERATURE, RESPIRATION, PULSE, PAIN, OTHER)
-"RTN","C0CVIT2",92,0)
- . D:$P(VIT(C0CVI),U,3)="HT" HEIGHT1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"in")
-"RTN","C0CVIT2",93,0)
- . D:$P(VIT(C0CVI),U,3)="WT" WEIGHT1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"lbs")
-"RTN","C0CVIT2",94,0)
- . D:$P(VIT(C0CVI),U,3)="BP" BP1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"")
-"RTN","C0CVIT2",95,0)
- . D:$P(VIT(C0CVI),U,3)="T" TMP1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"F")
-"RTN","C0CVIT2",96,0)
- . D:$P(VIT(C0CVI),U,3)="R" RESP1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"")
-"RTN","C0CVIT2",97,0)
- . D:$P(VIT(C0CVI),U,3)="P" PULSE1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"")
-"RTN","C0CVIT2",98,0)
- . D:$P(VIT(C0CVI),U,3)="PN" PAIN1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"")
-"RTN","C0CVIT2",99,0)
- . D:'$D(ZRNF) OTHER1($$FMDTOUTC^C0CUTIL($P(C0CVI,U,4),"DT"),"OTHER VITAL",$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"UNKNOWN") ;IF THE VITAL ISN'T DEFINED IT IS OTHER
-"RTN","C0CVIT2",100,0)
+"RTN","C0CVIT2",152,0)
+ . D:$P(VIT(C0CVI),U,3)="HT" HEIGHT
+"RTN","C0CVIT2",153,0)
+ . D:$P(VIT(C0CVI),U,3)="WT" WEIGHT
+"RTN","C0CVIT2",154,0)
+ . D:$P(VIT(C0CVI),U,3)="BP" BP
+"RTN","C0CVIT2",155,0)
+ . D:$P(VIT(C0CVI),U,3)="TMP" TMP
+"RTN","C0CVIT2",156,0)
+ . D:$P(VIT(C0CVI),U,3)="RS" RESP
+"RTN","C0CVIT2",157,0)
+ . D:$P(VIT(C0CVI),U,3)="PU" PULSE
+"RTN","C0CVIT2",158,0)
+ . D:$P(VIT(C0CVI),U,3)="PA" PAIN
+"RTN","C0CVIT2",159,0)
+ . D:'$D(ZRNF) OTHER ;IF THE VITAL ISN'T DEFINED IT IS OTHER
+"RTN","C0CVIT2",160,0)
  . D RNF1TO2^C0CRNF(C0CVIT,"ZRNF") ;ADD THIS ROW TO THE ARRAY
-"RTN","C0CVIT2",101,0)
+"RTN","C0CVIT2",161,0)
  . K ZRNF
-"RTN","C0CVIT2",102,0)
+"RTN","C0CVIT2",162,0)
  ; SAVE RIM VARIABLES SEE C0CRIMA
-"RTN","C0CVIT2",103,0)
+"RTN","C0CVIT2",163,0)
  N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"VITALS"))
-"RTN","C0CVIT2",104,0)
+"RTN","C0CVIT2",164,0)
  M @ZRIM=@C0CVIT@("V")
-"RTN","C0CVIT2",105,0)
+"RTN","C0CVIT2",165,0)
  Q
-"RTN","C0CVIT2",106,0)
- ;
-"RTN","C0CVIT2",107,0)
-GETRPMS(DFN,C0CVIT) ; CALLS QUERY^BEHOVM TO GET VITAL SIGNS. 
-"RTN","C0CVIT2",108,0)
- ; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
-"RTN","C0CVIT2",109,0)
- ; C0CVIT: VITAL SIGNS
-"RTN","C0CVIT2",110,0)
- ; READY TO BE MAPPED TO XML BY MAP^C0CVIT2
-"RTN","C0CVIT2",111,0)
- ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY 
-"RTN","C0CVIT2",112,0)
- ; EXIST.
-"RTN","C0CVIT2",113,0)
- ;
-"RTN","C0CVIT2",114,0)
- ; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J))
-"RTN","C0CVIT2",115,0)
- ;
-"RTN","C0CVIT2",116,0)
- ; SETUP RPC/API CALL HERE
-"RTN","C0CVIT2",117,0)
- ; USE START AND END DATES FROM PARAMETERS IF REQUIRED
-"RTN","C0CVIT2",118,0)
- ;
-"RTN","C0CVIT2",119,0)
- ; RPMS VITAL RPC ONLY RETURNS LATEST VITAL IN SPECIFIED DATE RANGE NOT ALL VITALS IN DATE RANGE
-"RTN","C0CVIT2",120,0)
- ; WE NEED TO SETUP THE VARIABLES THE INTERNAL CALL NEEDS TO BYPASS A HARD CODE OF ONE VITAL FOR DATE RANGE
-"RTN","C0CVIT2",121,0)
- N C0CEDT,C0CSDT,VIT,DATA,START,END
-"RTN","C0CVIT2",122,0)
- ; RPC REQUIRES FM DATES NOT T-* DATES
-"RTN","C0CVIT2",123,0)
- D DT^DILF(,$$GET^C0CPARMS("VITLIMIT"),.END) ; GET THE LIMIT PARM
-"RTN","C0CVIT2",124,0)
- D DT^DILF(,$$GET^C0CPARMS("VITSTART"),.START) ; GET START PARM
-"RTN","C0CVIT2",125,0)
- ; RPC OUTPUT FORMAT:
-"RTN","C0CVIT2",126,0)
- ; vfile ien^vital name^vital abbr^date/time taken(FM FORMAT)^value+units (US & metric)
-"RTN","C0CVIT2",127,0)
- D QUERY^BEHOVM("LISTX") ; RUN QUERY VITALS CALL
-"RTN","C0CVIT2",128,0)
- I '$D(^TMP("CIAVMRPC",$J)) S @VITOUT@(0)=0 K ^TMP("CIAVMRPC",$J) Q  ; RETURN NOT FOUND, KILL ARRAY AND QUIT
-"RTN","C0CVIT2",129,0)
- ; MOVE THE ARRAY TO LOCAL VARIABLE
-"RTN","C0CVIT2",130,0)
- M VIT=^TMP("CIAVMRPC",$J,0)
-"RTN","C0CVIT2",131,0)
- ; RPC CLEANUP
-"RTN","C0CVIT2",132,0)
- K ^TMP("CIAVMRPC",$J),VITS,RMAX,START,END,DATA,METRIC,VSTR,VUNT
-"RTN","C0CVIT2",133,0)
- ;
-"RTN","C0CVIT2",134,0)
- ; PREFORM SORT HERE IF NEEDED
-"RTN","C0CVIT2",135,0)
- ;
-"RTN","C0CVIT2",136,0)
- ; SORT IS REQUIRED FOR VITAL SIGNS - LATEST VITALS NEED TO BE LISTED FIRST
-"RTN","C0CVIT2",137,0)
- ; COPIED SORT LOGIC:
-"RTN","C0CVIT2",138,0)
- N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
-"RTN","C0CVIT2",139,0)
- D VITSORT(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
-"RTN","C0CVIT2",140,0)
- S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
-"RTN","C0CVIT2",141,0)
- ; VSORT IS VITALS IN REVERSE ORDER
-"RTN","C0CVIT2",142,0)
- ;
-"RTN","C0CVIT2",143,0)
- ; MAP EACH ROW OF RPC/API TO RNF1 ARRAY
-"RTN","C0CVIT2",144,0)
- ; RNF1 ARRAY FORMAT:
-"RTN","C0CVIT2",145,0)
- ; VAR("NAME_OF_RIM_VARIABLE")=VALUE
-"RTN","C0CVIT2",146,0)
- ;
-"RTN","C0CVIT2",147,0)
- ; VITAL SIGNS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF VITAL SIGNS
-"RTN","C0CVIT2",148,0)
- ; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD
-"RTN","C0CVIT2",149,0)
- ; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS
-"RTN","C0CVIT2",150,0)
- N C0CVI,C0CC,ZRNF
-"RTN","C0CVIT2",151,0)
- ;S C0CVI="" ; INITIALIZE FOR $O
-"RTN","C0CVIT2",152,0)
- F C0CC=1:1:VSORT(0) S C0CVI=VSORT(C0CC) D  ; FOR EACH VITAL SIGN IN THE LIST
-"RTN","C0CVIT2",153,0)
- . I DEBUG W VIT(C0CVI),!
-"RTN","C0CVIT2",154,0)
- . ; FIGURE OUT WHICH TYPE OF VITAL SIGN IT IS (HEIGHT, WEIGHT, BLOOD PRESSURE, TEMPERATURE, RESPIRATION, PULSE, PAIN, OTHER)
-"RTN","C0CVIT2",155,0)
- . D:$P(VIT(C0CVI),U,3)="HT" HEIGHT
-"RTN","C0CVIT2",156,0)
- . D:$P(VIT(C0CVI),U,3)="WT" WEIGHT
-"RTN","C0CVIT2",157,0)
- . D:$P(VIT(C0CVI),U,3)="BP" BP
-"RTN","C0CVIT2",158,0)
- . D:$P(VIT(C0CVI),U,3)="TMP" TMP
-"RTN","C0CVIT2",159,0)
- . D:$P(VIT(C0CVI),U,3)="RS" RESP
-"RTN","C0CVIT2",160,0)
- . D:$P(VIT(C0CVI),U,3)="PU" PULSE
-"RTN","C0CVIT2",161,0)
- . D:$P(VIT(C0CVI),U,3)="PA" PAIN
-"RTN","C0CVIT2",162,0)
- . D:'$D(ZRNF) OTHER ;IF THE VITAL ISN'T DEFINED IT IS OTHER
-"RTN","C0CVIT2",163,0)
- . D RNF1TO2^C0CRNF(C0CVIT,"ZRNF") ;ADD THIS ROW TO THE ARRAY
-"RTN","C0CVIT2",164,0)
- . K ZRNF
-"RTN","C0CVIT2",165,0)
- ; SAVE RIM VARIABLES SEE C0CRIMA
 "RTN","C0CVIT2",166,0)
- N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"VITALS"))
+ ;
 "RTN","C0CVIT2",167,0)
- M @ZRIM=@C0CVIT@("V")
+HEIGHT ;
 "RTN","C0CVIT2",168,0)
+ I DEBUG W "IN VITAL:  HEIGHT",!
+"RTN","C0CVIT2",169,0)
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID
+"RTN","C0CVIT2",170,0)
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",171,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
+"RTN","C0CVIT2",172,0)
+ S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
+"RTN","C0CVIT2",173,0)
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","C0CVIT2",174,0)
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+"RTN","C0CVIT2",175,0)
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",176,0)
+ S ZRNF("VITALSIGNSDESCCODEVALUE")="248327008"
+"RTN","C0CVIT2",177,0)
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVIT2",178,0)
+ S ZRNF("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVIT2",179,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
+"RTN","C0CVIT2",180,0)
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
+"RTN","C0CVIT2",181,0)
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
+"RTN","C0CVIT2",182,0)
  Q
-"RTN","C0CVIT2",169,0)
- ;
-"RTN","C0CVIT2",170,0)
-HEIGHT 
-"RTN","C0CVIT2",171,0)
+"RTN","C0CVIT2",183,0)
+ ;
+"RTN","C0CVIT2",184,0)
+WEIGHT ;
+"RTN","C0CVIT2",185,0)
+ I DEBUG W "IN VITAL:  WEIGHT",!
+"RTN","C0CVIT2",186,0)
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
+"RTN","C0CVIT2",187,0)
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",188,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
+"RTN","C0CVIT2",189,0)
+ S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
+"RTN","C0CVIT2",190,0)
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","C0CVIT2",191,0)
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+"RTN","C0CVIT2",192,0)
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",193,0)
+ S ZRNF("VITALSIGNSDESCCODEVALUE")="107647005"
+"RTN","C0CVIT2",194,0)
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVIT2",195,0)
+ S ZRNF("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVIT2",196,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
+"RTN","C0CVIT2",197,0)
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
+"RTN","C0CVIT2",198,0)
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
+"RTN","C0CVIT2",199,0)
+ Q
+"RTN","C0CVIT2",200,0)
+ ;
+"RTN","C0CVIT2",201,0)
+BP ;
+"RTN","C0CVIT2",202,0)
+ I DEBUG W "IN VITAL:  BLOOD PRESSURE",!
+"RTN","C0CVIT2",203,0)
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
+"RTN","C0CVIT2",204,0)
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",205,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
+"RTN","C0CVIT2",206,0)
+ S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
+"RTN","C0CVIT2",207,0)
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","C0CVIT2",208,0)
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+"RTN","C0CVIT2",209,0)
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",210,0)
+ S ZRNF("VITALSIGNSDESCCODEVALUE")="392570002"
+"RTN","C0CVIT2",211,0)
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVIT2",212,0)
+ S ZRNF("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVIT2",213,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
+"RTN","C0CVIT2",214,0)
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
+"RTN","C0CVIT2",215,0)
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
+"RTN","C0CVIT2",216,0)
+ Q
+"RTN","C0CVIT2",217,0)
+ ;
+"RTN","C0CVIT2",218,0)
+TMP ;
+"RTN","C0CVIT2",219,0)
+ I DEBUG W "IN VITAL:  TEMPERATURE",!
+"RTN","C0CVIT2",220,0)
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
+"RTN","C0CVIT2",221,0)
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",222,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
+"RTN","C0CVIT2",223,0)
+ S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
+"RTN","C0CVIT2",224,0)
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","C0CVIT2",225,0)
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+"RTN","C0CVIT2",226,0)
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",227,0)
+ S ZRNF("VITALSIGNSDESCCODEVALUE")="309646008"
+"RTN","C0CVIT2",228,0)
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVIT2",229,0)
+ S ZRNF("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVIT2",230,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
+"RTN","C0CVIT2",231,0)
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
+"RTN","C0CVIT2",232,0)
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
+"RTN","C0CVIT2",233,0)
+ Q
+"RTN","C0CVIT2",234,0)
+ ;
+"RTN","C0CVIT2",235,0)
+RESP ;
+"RTN","C0CVIT2",236,0)
+ I DEBUG W "IN VITAL:  RESPIRATION",!
+"RTN","C0CVIT2",237,0)
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
+"RTN","C0CVIT2",238,0)
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",239,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
+"RTN","C0CVIT2",240,0)
+ S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
+"RTN","C0CVIT2",241,0)
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","C0CVIT2",242,0)
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+"RTN","C0CVIT2",243,0)
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",244,0)
+ S ZRNF("VITALSIGNSDESCCODEVALUE")="366147009"
+"RTN","C0CVIT2",245,0)
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVIT2",246,0)
+ S ZRNF("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVIT2",247,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
+"RTN","C0CVIT2",248,0)
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
+"RTN","C0CVIT2",249,0)
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
+"RTN","C0CVIT2",250,0)
+ Q
+"RTN","C0CVIT2",251,0)
+ ;
+"RTN","C0CVIT2",252,0)
+PULSE ;
+"RTN","C0CVIT2",253,0)
+ I DEBUG W "IN VITAL:  PULSE",!
+"RTN","C0CVIT2",254,0)
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
+"RTN","C0CVIT2",255,0)
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",256,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
+"RTN","C0CVIT2",257,0)
+ S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
+"RTN","C0CVIT2",258,0)
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","C0CVIT2",259,0)
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+"RTN","C0CVIT2",260,0)
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",261,0)
+ S ZRNF("VITALSIGNSDESCCODEVALUE")="366199006"
+"RTN","C0CVIT2",262,0)
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVIT2",263,0)
+ S ZRNF("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVIT2",264,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
+"RTN","C0CVIT2",265,0)
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
+"RTN","C0CVIT2",266,0)
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
+"RTN","C0CVIT2",267,0)
+ Q
+"RTN","C0CVIT2",268,0)
+ ;
+"RTN","C0CVIT2",269,0)
+PAIN ;
+"RTN","C0CVIT2",270,0)
+ I DEBUG W "IN VITAL:  PAIN",!
+"RTN","C0CVIT2",271,0)
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
+"RTN","C0CVIT2",272,0)
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",273,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
+"RTN","C0CVIT2",274,0)
+ S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
+"RTN","C0CVIT2",275,0)
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","C0CVIT2",276,0)
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+"RTN","C0CVIT2",277,0)
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",278,0)
+ S ZRNF("VITALSIGNSDESCCODEVALUE")="22253000"
+"RTN","C0CVIT2",279,0)
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVIT2",280,0)
+ S ZRNF("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVIT2",281,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
+"RTN","C0CVIT2",282,0)
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
+"RTN","C0CVIT2",283,0)
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
+"RTN","C0CVIT2",284,0)
+ Q
+"RTN","C0CVIT2",285,0)
+ ;
+"RTN","C0CVIT2",286,0)
+OTHER ;
+"RTN","C0CVIT2",287,0)
+ I DEBUG W "IN VITAL:  OTHER",!
+"RTN","C0CVIT2",288,0)
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
+"RTN","C0CVIT2",289,0)
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",290,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
+"RTN","C0CVIT2",291,0)
+ S ZRNF("VITALSIGNSDESCRIPTIONTEXT")=$P(VIT(C0CVI),U,2)
+"RTN","C0CVIT2",292,0)
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","C0CVIT2",293,0)
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+"RTN","C0CVIT2",294,0)
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",295,0)
+ S ZRNF("VITALSIGNSDESCCODEVALUE")=""
+"RTN","C0CVIT2",296,0)
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")=""
+"RTN","C0CVIT2",297,0)
+ S ZRNF("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVIT2",298,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
+"RTN","C0CVIT2",299,0)
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
+"RTN","C0CVIT2",300,0)
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
+"RTN","C0CVIT2",301,0)
+ Q
+"RTN","C0CVIT2",302,0)
+ ;
+"RTN","C0CVIT2",303,0)
+ ;TEMPORARY, THINKING ON HOW TO REFACTOR (CJE)
+"RTN","C0CVIT2",304,0)
+HEIGHT1(DT,ACTOR,VALUE,UNIT) ;
+"RTN","C0CVIT2",305,0)
  I DEBUG W "IN VITAL:  HEIGHT",!
-"RTN","C0CVIT2",172,0)
+"RTN","C0CVIT2",306,0)
  S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID
-"RTN","C0CVIT2",173,0)
+"RTN","C0CVIT2",307,0)
  S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",174,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
-"RTN","C0CVIT2",175,0)
+"RTN","C0CVIT2",308,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=DT
+"RTN","C0CVIT2",309,0)
  S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
-"RTN","C0CVIT2",176,0)
+"RTN","C0CVIT2",310,0)
  S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVIT2",177,0)
+"RTN","C0CVIT2",311,0)
  S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
-"RTN","C0CVIT2",178,0)
+"RTN","C0CVIT2",312,0)
  S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",179,0)
+"RTN","C0CVIT2",313,0)
  S ZRNF("VITALSIGNSDESCCODEVALUE")="248327008"
-"RTN","C0CVIT2",180,0)
+"RTN","C0CVIT2",314,0)
  S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVIT2",181,0)
+"RTN","C0CVIT2",315,0)
  S ZRNF("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVIT2",182,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
-"RTN","C0CVIT2",183,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
-"RTN","C0CVIT2",184,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
-"RTN","C0CVIT2",185,0)
+"RTN","C0CVIT2",316,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
+"RTN","C0CVIT2",317,0)
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
+"RTN","C0CVIT2",318,0)
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
+"RTN","C0CVIT2",319,0)
  Q
-"RTN","C0CVIT2",186,0)
- ;
-"RTN","C0CVIT2",187,0)
-WEIGHT 
-"RTN","C0CVIT2",188,0)
+"RTN","C0CVIT2",320,0)
+ ;
+"RTN","C0CVIT2",321,0)
+WEIGHT1(DT,ACTOR,VALUE,UNIT) ;
+"RTN","C0CVIT2",322,0)
  I DEBUG W "IN VITAL:  WEIGHT",!
-"RTN","C0CVIT2",189,0)
+"RTN","C0CVIT2",323,0)
  S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
-"RTN","C0CVIT2",190,0)
+"RTN","C0CVIT2",324,0)
  S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",191,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
-"RTN","C0CVIT2",192,0)
+"RTN","C0CVIT2",325,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=DT
+"RTN","C0CVIT2",326,0)
  S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
-"RTN","C0CVIT2",193,0)
+"RTN","C0CVIT2",327,0)
  S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVIT2",194,0)
+"RTN","C0CVIT2",328,0)
  S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
-"RTN","C0CVIT2",195,0)
+"RTN","C0CVIT2",329,0)
  S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",196,0)
+"RTN","C0CVIT2",330,0)
  S ZRNF("VITALSIGNSDESCCODEVALUE")="107647005"
-"RTN","C0CVIT2",197,0)
+"RTN","C0CVIT2",331,0)
  S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVIT2",198,0)
+"RTN","C0CVIT2",332,0)
  S ZRNF("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVIT2",199,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
-"RTN","C0CVIT2",200,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
-"RTN","C0CVIT2",201,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
-"RTN","C0CVIT2",202,0)
+"RTN","C0CVIT2",333,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
+"RTN","C0CVIT2",334,0)
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
+"RTN","C0CVIT2",335,0)
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
+"RTN","C0CVIT2",336,0)
  Q
-"RTN","C0CVIT2",203,0)
- ;
-"RTN","C0CVIT2",204,0)
-BP 
-"RTN","C0CVIT2",205,0)
+"RTN","C0CVIT2",337,0)
+ ;
+"RTN","C0CVIT2",338,0)
+BP1(DT,ACTOR,VALUE,UNIT) ;
+"RTN","C0CVIT2",339,0)
  I DEBUG W "IN VITAL:  BLOOD PRESSURE",!
-"RTN","C0CVIT2",206,0)
+"RTN","C0CVIT2",340,0)
  S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
-"RTN","C0CVIT2",207,0)
+"RTN","C0CVIT2",341,0)
  S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",208,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
-"RTN","C0CVIT2",209,0)
+"RTN","C0CVIT2",342,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=DT
+"RTN","C0CVIT2",343,0)
  S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
-"RTN","C0CVIT2",210,0)
+"RTN","C0CVIT2",344,0)
  S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVIT2",211,0)
+"RTN","C0CVIT2",345,0)
  S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
-"RTN","C0CVIT2",212,0)
+"RTN","C0CVIT2",346,0)
  S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",213,0)
+"RTN","C0CVIT2",347,0)
  S ZRNF("VITALSIGNSDESCCODEVALUE")="392570002"
-"RTN","C0CVIT2",214,0)
+"RTN","C0CVIT2",348,0)
  S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVIT2",215,0)
+"RTN","C0CVIT2",349,0)
  S ZRNF("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVIT2",216,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
-"RTN","C0CVIT2",217,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
-"RTN","C0CVIT2",218,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
-"RTN","C0CVIT2",219,0)
+"RTN","C0CVIT2",350,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
+"RTN","C0CVIT2",351,0)
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
+"RTN","C0CVIT2",352,0)
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
+"RTN","C0CVIT2",353,0)
  Q
-"RTN","C0CVIT2",220,0)
- ;
-"RTN","C0CVIT2",221,0)
-TMP 
-"RTN","C0CVIT2",222,0)
+"RTN","C0CVIT2",354,0)
+ ;
+"RTN","C0CVIT2",355,0)
+TMP1(DT,ACTOR,VALUE,UNIT) ;
+"RTN","C0CVIT2",356,0)
  I DEBUG W "IN VITAL:  TEMPERATURE",!
-"RTN","C0CVIT2",223,0)
+"RTN","C0CVIT2",357,0)
  S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
-"RTN","C0CVIT2",224,0)
+"RTN","C0CVIT2",358,0)
  S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",225,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
-"RTN","C0CVIT2",226,0)
+"RTN","C0CVIT2",359,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=DT
+"RTN","C0CVIT2",360,0)
  S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
-"RTN","C0CVIT2",227,0)
+"RTN","C0CVIT2",361,0)
  S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVIT2",228,0)
+"RTN","C0CVIT2",362,0)
  S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
-"RTN","C0CVIT2",229,0)
+"RTN","C0CVIT2",363,0)
  S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",230,0)
+"RTN","C0CVIT2",364,0)
  S ZRNF("VITALSIGNSDESCCODEVALUE")="309646008"
-"RTN","C0CVIT2",231,0)
+"RTN","C0CVIT2",365,0)
  S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVIT2",232,0)
+"RTN","C0CVIT2",366,0)
  S ZRNF("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVIT2",233,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
-"RTN","C0CVIT2",234,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
-"RTN","C0CVIT2",235,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
-"RTN","C0CVIT2",236,0)
+"RTN","C0CVIT2",367,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
+"RTN","C0CVIT2",368,0)
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
+"RTN","C0CVIT2",369,0)
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
+"RTN","C0CVIT2",370,0)
  Q
-"RTN","C0CVIT2",237,0)
- ;
-"RTN","C0CVIT2",238,0)
-RESP 
-"RTN","C0CVIT2",239,0)
+"RTN","C0CVIT2",371,0)
+ ;
+"RTN","C0CVIT2",372,0)
+RESP1(DT,ACTOR,VALUE,UNIT) ;
+"RTN","C0CVIT2",373,0)
  I DEBUG W "IN VITAL:  RESPIRATION",!
-"RTN","C0CVIT2",240,0)
+"RTN","C0CVIT2",374,0)
  S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
-"RTN","C0CVIT2",241,0)
+"RTN","C0CVIT2",375,0)
  S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",242,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
-"RTN","C0CVIT2",243,0)
+"RTN","C0CVIT2",376,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=DT
+"RTN","C0CVIT2",377,0)
  S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
-"RTN","C0CVIT2",244,0)
+"RTN","C0CVIT2",378,0)
  S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVIT2",245,0)
+"RTN","C0CVIT2",379,0)
  S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
-"RTN","C0CVIT2",246,0)
+"RTN","C0CVIT2",380,0)
  S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",247,0)
+"RTN","C0CVIT2",381,0)
  S ZRNF("VITALSIGNSDESCCODEVALUE")="366147009"
-"RTN","C0CVIT2",248,0)
+"RTN","C0CVIT2",382,0)
  S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVIT2",249,0)
+"RTN","C0CVIT2",383,0)
  S ZRNF("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVIT2",250,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
-"RTN","C0CVIT2",251,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
-"RTN","C0CVIT2",252,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
-"RTN","C0CVIT2",253,0)
+"RTN","C0CVIT2",384,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
+"RTN","C0CVIT2",385,0)
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
+"RTN","C0CVIT2",386,0)
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
+"RTN","C0CVIT2",387,0)
  Q
-"RTN","C0CVIT2",254,0)
- ;
-"RTN","C0CVIT2",255,0)
-PULSE 
-"RTN","C0CVIT2",256,0)
+"RTN","C0CVIT2",388,0)
+ ;
+"RTN","C0CVIT2",389,0)
+PULSE1(DT,ACTOR,VALUE,UNIT) ;
+"RTN","C0CVIT2",390,0)
  I DEBUG W "IN VITAL:  PULSE",!
-"RTN","C0CVIT2",257,0)
+"RTN","C0CVIT2",391,0)
  S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
-"RTN","C0CVIT2",258,0)
+"RTN","C0CVIT2",392,0)
  S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",259,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
-"RTN","C0CVIT2",260,0)
+"RTN","C0CVIT2",393,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=DT
+"RTN","C0CVIT2",394,0)
  S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
-"RTN","C0CVIT2",261,0)
+"RTN","C0CVIT2",395,0)
  S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVIT2",262,0)
+"RTN","C0CVIT2",396,0)
  S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
-"RTN","C0CVIT2",263,0)
+"RTN","C0CVIT2",397,0)
  S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",264,0)
+"RTN","C0CVIT2",398,0)
  S ZRNF("VITALSIGNSDESCCODEVALUE")="366199006"
-"RTN","C0CVIT2",265,0)
+"RTN","C0CVIT2",399,0)
  S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVIT2",266,0)
+"RTN","C0CVIT2",400,0)
  S ZRNF("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVIT2",267,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
-"RTN","C0CVIT2",268,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
-"RTN","C0CVIT2",269,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
-"RTN","C0CVIT2",270,0)
+"RTN","C0CVIT2",401,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
+"RTN","C0CVIT2",402,0)
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
+"RTN","C0CVIT2",403,0)
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
+"RTN","C0CVIT2",404,0)
  Q
-"RTN","C0CVIT2",271,0)
- ;
-"RTN","C0CVIT2",272,0)
-PAIN 
-"RTN","C0CVIT2",273,0)
+"RTN","C0CVIT2",405,0)
+ ;
+"RTN","C0CVIT2",406,0)
+PAIN1(DT,ACTOR,VALUE,UNIT) ;
+"RTN","C0CVIT2",407,0)
  I DEBUG W "IN VITAL:  PAIN",!
-"RTN","C0CVIT2",274,0)
+"RTN","C0CVIT2",408,0)
  S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
-"RTN","C0CVIT2",275,0)
+"RTN","C0CVIT2",409,0)
  S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",276,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
-"RTN","C0CVIT2",277,0)
+"RTN","C0CVIT2",410,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=DT
+"RTN","C0CVIT2",411,0)
  S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
-"RTN","C0CVIT2",278,0)
+"RTN","C0CVIT2",412,0)
  S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVIT2",279,0)
+"RTN","C0CVIT2",413,0)
  S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
-"RTN","C0CVIT2",280,0)
+"RTN","C0CVIT2",414,0)
  S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",281,0)
+"RTN","C0CVIT2",415,0)
  S ZRNF("VITALSIGNSDESCCODEVALUE")="22253000"
-"RTN","C0CVIT2",282,0)
+"RTN","C0CVIT2",416,0)
  S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVIT2",283,0)
+"RTN","C0CVIT2",417,0)
  S ZRNF("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVIT2",284,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
-"RTN","C0CVIT2",285,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
-"RTN","C0CVIT2",286,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
-"RTN","C0CVIT2",287,0)
+"RTN","C0CVIT2",418,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
+"RTN","C0CVIT2",419,0)
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
+"RTN","C0CVIT2",420,0)
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
+"RTN","C0CVIT2",421,0)
  Q
-"RTN","C0CVIT2",288,0)
- ;
-"RTN","C0CVIT2",289,0)
-OTHER 
-"RTN","C0CVIT2",290,0)
+"RTN","C0CVIT2",422,0)
+ ;
+"RTN","C0CVIT2",423,0)
+OTHER1(DT,TEXT,ACTOR,VALUE,UNIT) ;
+"RTN","C0CVIT2",424,0)
  I DEBUG W "IN VITAL:  OTHER",!
-"RTN","C0CVIT2",291,0)
+"RTN","C0CVIT2",425,0)
  S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
-"RTN","C0CVIT2",292,0)
+"RTN","C0CVIT2",426,0)
  S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",293,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
-"RTN","C0CVIT2",294,0)
- S ZRNF("VITALSIGNSDESCRIPTIONTEXT")=$P(VIT(C0CVI),U,2)
-"RTN","C0CVIT2",295,0)
+"RTN","C0CVIT2",427,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=DT
+"RTN","C0CVIT2",428,0)
+ S ZRNF("VITALSIGNSDESCRIPTIONTEXT")=TEXT
+"RTN","C0CVIT2",429,0)
  S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVIT2",296,0)
+"RTN","C0CVIT2",430,0)
  S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
-"RTN","C0CVIT2",297,0)
+"RTN","C0CVIT2",431,0)
  S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",298,0)
+"RTN","C0CVIT2",432,0)
  S ZRNF("VITALSIGNSDESCCODEVALUE")=""
-"RTN","C0CVIT2",299,0)
+"RTN","C0CVIT2",433,0)
  S ZRNF("VITALSIGNSDESCCODINGSYSTEM")=""
-"RTN","C0CVIT2",300,0)
+"RTN","C0CVIT2",434,0)
  S ZRNF("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVIT2",301,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
-"RTN","C0CVIT2",302,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
-"RTN","C0CVIT2",303,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
-"RTN","C0CVIT2",304,0)
+"RTN","C0CVIT2",435,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
+"RTN","C0CVIT2",436,0)
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
+"RTN","C0CVIT2",437,0)
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
+"RTN","C0CVIT2",438,0)
  Q
-"RTN","C0CVIT2",305,0)
- ;
-"RTN","C0CVIT2",306,0)
- ;TEMPORARY, THINKING ON HOW TO REFACTOR (CJE)
-"RTN","C0CVIT2",307,0)
-HEIGHT1(DT,ACTOR,VALUE,UNIT) 
-"RTN","C0CVIT2",308,0)
- I DEBUG W "IN VITAL:  HEIGHT",!
-"RTN","C0CVIT2",309,0)
- S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID
-"RTN","C0CVIT2",310,0)
- S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",311,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=DT
-"RTN","C0CVIT2",312,0)
- S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
-"RTN","C0CVIT2",313,0)
- S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVIT2",314,0)
- S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
-"RTN","C0CVIT2",315,0)
- S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",316,0)
- S ZRNF("VITALSIGNSDESCCODEVALUE")="248327008"
-"RTN","C0CVIT2",317,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVIT2",318,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVIT2",319,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
-"RTN","C0CVIT2",320,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
-"RTN","C0CVIT2",321,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
-"RTN","C0CVIT2",322,0)
+"RTN","C0CVIT2",439,0)
+ ;
+"RTN","C0CVIT2",440,0)
+VITSORT(VDT) ; RUN DATE SORTING ALGORITHM
+"RTN","C0CVIT2",441,0)
+ ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
+"RTN","C0CVIT2",442,0)
+ ; OF DATES IN THE VITALS RESULTS
+"RTN","C0CVIT2",443,0)
+ N VDTI,VDTJ,VTDCNT
+"RTN","C0CVIT2",444,0)
+ S VTDCNT=0 ; COUNT TO BUILD ARRAY
+"RTN","C0CVIT2",445,0)
+ S VDTJ="" ; USED TO VISIT THE RESULTS
+"RTN","C0CVIT2",446,0)
+ F VDTI=0:0 D  Q:$O(VIT(VDTJ))=""  ; VISIT ALL RESULTS
+"RTN","C0CVIT2",447,0)
+ . S VDTJ=$O(VIT(VDTJ)) ; NEXT RESULT
+"RTN","C0CVIT2",448,0)
+ . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
+"RTN","C0CVIT2",449,0)
+ . S VDT(VTDCNT)=$P(VIT(VDTJ),U,4) ; PULL OUT THE DATE
+"RTN","C0CVIT2",450,0)
+ S VDT(0)=VTDCNT
+"RTN","C0CVIT2",451,0)
  Q
-"RTN","C0CVIT2",323,0)
- ;
-"RTN","C0CVIT2",324,0)
-WEIGHT1(DT,ACTOR,VALUE,UNIT) 
-"RTN","C0CVIT2",325,0)
- I DEBUG W "IN VITAL:  WEIGHT",!
-"RTN","C0CVIT2",326,0)
- S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
-"RTN","C0CVIT2",327,0)
- S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",328,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=DT
-"RTN","C0CVIT2",329,0)
- S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
-"RTN","C0CVIT2",330,0)
- S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVIT2",331,0)
- S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
-"RTN","C0CVIT2",332,0)
- S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",333,0)
- S ZRNF("VITALSIGNSDESCCODEVALUE")="107647005"
-"RTN","C0CVIT2",334,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVIT2",335,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVIT2",336,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
-"RTN","C0CVIT2",337,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
-"RTN","C0CVIT2",338,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
-"RTN","C0CVIT2",339,0)
+"RTN","C0CVIT2",452,0)
+ ;
+"RTN","C0CVIT2",453,0)
+MAP(VITXML,C0CVIT,VITOUT) ; MAP VITAL SIGNS XML 
+"RTN","C0CVIT2",454,0)
+ ;
+"RTN","C0CVIT2",455,0)
+ N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"VITTEMP")) ;WORK AREA FOR TEMPLATE
+"RTN","C0CVIT2",456,0)
+ K @ZTEMP
+"RTN","C0CVIT2",457,0)
+ N ZBLD
+"RTN","C0CVIT2",458,0)
+ S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"VITBLD")) ; BUILD LIST AREA
+"RTN","C0CVIT2",459,0)
+ D QUEUE^C0CXPATH(ZBLD,VITXML,1,1) ; FIRST LINE
+"RTN","C0CVIT2",460,0)
+ N ZINNER
+"RTN","C0CVIT2",461,0)
+ ; XPATH NEEDS TO MATCH YOUR SECTION
+"RTN","C0CVIT2",462,0)
+ D QUERY^C0CXPATH(VITXML,"//VitalSigns/Result","ZINNER") ;ONE VITAL SIGN
+"RTN","C0CVIT2",463,0)
+ N ZTMP,ZVAR,ZI
+"RTN","C0CVIT2",464,0)
+ S ZI=""
+"RTN","C0CVIT2",465,0)
+ F  S ZI=$O(@C0CVIT@("V",ZI)) Q:ZI=""  D  ;FOR EACH VITAL SIGN
+"RTN","C0CVIT2",466,0)
+ . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS VITAL SIGN XML
+"RTN","C0CVIT2",467,0)
+ . S ZVAR=$NA(@C0CVIT@("V",ZI)) ;THIS VITAL SIGN VARIABLES
+"RTN","C0CVIT2",468,0)
+ . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE VITAL SIGN
+"RTN","C0CVIT2",469,0)
+ . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUEUE FOR BUILD
+"RTN","C0CVIT2",470,0)
+ D QUEUE^C0CXPATH(ZBLD,VITXML,@VITXML@(0),@VITXML@(0))
+"RTN","C0CVIT2",471,0)
+ N ZZTMP ; IS THIS NEEDED?
+"RTN","C0CVIT2",472,0)
+ D BUILD^C0CXPATH(ZBLD,VITOUT) ;BUILD FINAL XML
+"RTN","C0CVIT2",473,0)
+ K @ZTEMP,@ZBLD
+"RTN","C0CVIT2",474,0)
  Q
-"RTN","C0CVIT2",340,0)
- ;
-"RTN","C0CVIT2",341,0)
-BP1(DT,ACTOR,VALUE,UNIT) 
-"RTN","C0CVIT2",342,0)
- I DEBUG W "IN VITAL:  BLOOD PRESSURE",!
-"RTN","C0CVIT2",343,0)
- S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
-"RTN","C0CVIT2",344,0)
- S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",345,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=DT
-"RTN","C0CVIT2",346,0)
- S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
-"RTN","C0CVIT2",347,0)
- S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVIT2",348,0)
- S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
-"RTN","C0CVIT2",349,0)
- S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",350,0)
- S ZRNF("VITALSIGNSDESCCODEVALUE")="392570002"
-"RTN","C0CVIT2",351,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVIT2",352,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVIT2",353,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
-"RTN","C0CVIT2",354,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
-"RTN","C0CVIT2",355,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
-"RTN","C0CVIT2",356,0)
- Q
-"RTN","C0CVIT2",357,0)
- ;
-"RTN","C0CVIT2",358,0)
-TMP1(DT,ACTOR,VALUE,UNIT) 
-"RTN","C0CVIT2",359,0)
- I DEBUG W "IN VITAL:  TEMPERATURE",!
-"RTN","C0CVIT2",360,0)
- S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
-"RTN","C0CVIT2",361,0)
- S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",362,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=DT
-"RTN","C0CVIT2",363,0)
- S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
-"RTN","C0CVIT2",364,0)
- S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVIT2",365,0)
- S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
-"RTN","C0CVIT2",366,0)
- S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",367,0)
- S ZRNF("VITALSIGNSDESCCODEVALUE")="309646008"
-"RTN","C0CVIT2",368,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVIT2",369,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVIT2",370,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
-"RTN","C0CVIT2",371,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
-"RTN","C0CVIT2",372,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
-"RTN","C0CVIT2",373,0)
- Q
-"RTN","C0CVIT2",374,0)
- ;
-"RTN","C0CVIT2",375,0)
-RESP1(DT,ACTOR,VALUE,UNIT) 
-"RTN","C0CVIT2",376,0)
- I DEBUG W "IN VITAL:  RESPIRATION",!
-"RTN","C0CVIT2",377,0)
- S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
-"RTN","C0CVIT2",378,0)
- S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",379,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=DT
-"RTN","C0CVIT2",380,0)
- S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
-"RTN","C0CVIT2",381,0)
- S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVIT2",382,0)
- S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
-"RTN","C0CVIT2",383,0)
- S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",384,0)
- S ZRNF("VITALSIGNSDESCCODEVALUE")="366147009"
-"RTN","C0CVIT2",385,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVIT2",386,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVIT2",387,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
-"RTN","C0CVIT2",388,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
-"RTN","C0CVIT2",389,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
-"RTN","C0CVIT2",390,0)
- Q
-"RTN","C0CVIT2",391,0)
- ;
-"RTN","C0CVIT2",392,0)
-PULSE1(DT,ACTOR,VALUE,UNIT) 
-"RTN","C0CVIT2",393,0)
- I DEBUG W "IN VITAL:  PULSE",!
-"RTN","C0CVIT2",394,0)
- S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
-"RTN","C0CVIT2",395,0)
- S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",396,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=DT
-"RTN","C0CVIT2",397,0)
- S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
-"RTN","C0CVIT2",398,0)
- S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVIT2",399,0)
- S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
-"RTN","C0CVIT2",400,0)
- S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",401,0)
- S ZRNF("VITALSIGNSDESCCODEVALUE")="366199006"
-"RTN","C0CVIT2",402,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVIT2",403,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVIT2",404,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
-"RTN","C0CVIT2",405,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
-"RTN","C0CVIT2",406,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
-"RTN","C0CVIT2",407,0)
- Q
-"RTN","C0CVIT2",408,0)
- ;
-"RTN","C0CVIT2",409,0)
-PAIN1(DT,ACTOR,VALUE,UNIT) 
-"RTN","C0CVIT2",410,0)
- I DEBUG W "IN VITAL:  PAIN",!
-"RTN","C0CVIT2",411,0)
- S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
-"RTN","C0CVIT2",412,0)
- S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",413,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=DT
-"RTN","C0CVIT2",414,0)
- S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
-"RTN","C0CVIT2",415,0)
- S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVIT2",416,0)
- S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
-"RTN","C0CVIT2",417,0)
- S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",418,0)
- S ZRNF("VITALSIGNSDESCCODEVALUE")="22253000"
-"RTN","C0CVIT2",419,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVIT2",420,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVIT2",421,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
-"RTN","C0CVIT2",422,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
-"RTN","C0CVIT2",423,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
-"RTN","C0CVIT2",424,0)
- Q
-"RTN","C0CVIT2",425,0)
- ;
-"RTN","C0CVIT2",426,0)
-OTHER1(DT,TEXT,ACTOR,VALUE,UNIT) 
-"RTN","C0CVIT2",427,0)
- I DEBUG W "IN VITAL:  OTHER",!
-"RTN","C0CVIT2",428,0)
- S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
-"RTN","C0CVIT2",429,0)
- S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",430,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=DT
-"RTN","C0CVIT2",431,0)
- S ZRNF("VITALSIGNSDESCRIPTIONTEXT")=TEXT
-"RTN","C0CVIT2",432,0)
- S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVIT2",433,0)
- S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
-"RTN","C0CVIT2",434,0)
- S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",435,0)
- S ZRNF("VITALSIGNSDESCCODEVALUE")=""
-"RTN","C0CVIT2",436,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")=""
-"RTN","C0CVIT2",437,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVIT2",438,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
-"RTN","C0CVIT2",439,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
-"RTN","C0CVIT2",440,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
-"RTN","C0CVIT2",441,0)
- Q
-"RTN","C0CVIT2",442,0)
- ;
-"RTN","C0CVIT2",443,0)
-VITSORT(VDT) ; RUN DATE SORTING ALGORITHM
-"RTN","C0CVIT2",444,0)
- ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
-"RTN","C0CVIT2",445,0)
- ; OF DATES IN THE VITALS RESULTS
-"RTN","C0CVIT2",446,0)
- N VDTI,VDTJ,VTDCNT
-"RTN","C0CVIT2",447,0)
- S VTDCNT=0 ; COUNT TO BUILD ARRAY
-"RTN","C0CVIT2",448,0)
- S VDTJ="" ; USED TO VISIT THE RESULTS
-"RTN","C0CVIT2",449,0)
- F VDTI=0:0 D  Q:$O(VIT(VDTJ))=""  ; VISIT ALL RESULTS
-"RTN","C0CVIT2",450,0)
- . S VDTJ=$O(VIT(VDTJ)) ; NEXT RESULT
-"RTN","C0CVIT2",451,0)
- . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
-"RTN","C0CVIT2",452,0)
- . S VDT(VTDCNT)=$P(VIT(VDTJ),U,4) ; PULL OUT THE DATE
-"RTN","C0CVIT2",453,0)
- S VDT(0)=VTDCNT
-"RTN","C0CVIT2",454,0)
- Q
-"RTN","C0CVIT2",455,0)
- ;
-"RTN","C0CVIT2",456,0)
-MAP(VITXML,C0CVIT,VITOUT) ; MAP VITAL SIGNS XML 
-"RTN","C0CVIT2",457,0)
- ;
-"RTN","C0CVIT2",458,0)
- N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"VITTEMP")) ;WORK AREA FOR TEMPLATE
-"RTN","C0CVIT2",459,0)
- K @ZTEMP
-"RTN","C0CVIT2",460,0)
- N ZBLD
-"RTN","C0CVIT2",461,0)
- S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"VITBLD")) ; BUILD LIST AREA
-"RTN","C0CVIT2",462,0)
- D QUEUE^C0CXPATH(ZBLD,VITXML,1,1) ; FIRST LINE
-"RTN","C0CVIT2",463,0)
- N ZINNER
-"RTN","C0CVIT2",464,0)
- ; XPATH NEEDS TO MATCH YOUR SECTION
-"RTN","C0CVIT2",465,0)
- D QUERY^C0CXPATH(VITXML,"//VitalSigns/Result","ZINNER") ;ONE VITAL SIGN
-"RTN","C0CVIT2",466,0)
- N ZTMP,ZVAR,ZI
-"RTN","C0CVIT2",467,0)
- S ZI=""
-"RTN","C0CVIT2",468,0)
- F  S ZI=$O(@C0CVIT@("V",ZI)) Q:ZI=""  D  ;FOR EACH VITAL SIGN
-"RTN","C0CVIT2",469,0)
- . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS VITAL SIGN XML
-"RTN","C0CVIT2",470,0)
- . S ZVAR=$NA(@C0CVIT@("V",ZI)) ;THIS VITAL SIGN VARIABLES
-"RTN","C0CVIT2",471,0)
- . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE VITAL SIGN
-"RTN","C0CVIT2",472,0)
- . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUEUE FOR BUILD
-"RTN","C0CVIT2",473,0)
- D QUEUE^C0CXPATH(ZBLD,VITXML,@VITXML@(0),@VITXML@(0))
-"RTN","C0CVIT2",474,0)
- N ZZTMP ; IS THIS NEEDED?
 "RTN","C0CVIT2",475,0)
- D BUILD^C0CXPATH(ZBLD,VITOUT) ;BUILD FINAL XML
-"RTN","C0CVIT2",476,0)
- K @ZTEMP,@ZBLD
-"RTN","C0CVIT2",477,0)
- Q
-"RTN","C0CVIT2",478,0)
  ;  
 "RTN","C0CVITAL")
-0^36^B319933080
+0^36^B314693716
 "RTN","C0CVITAL",1,0)
 C0CVITAL ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
 "RTN","C0CVITAL",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CVITAL",3,0)
- ;Copyright 2008,2009 George Lilly, University of Minnesota and others.
+ ;
 "RTN","C0CVITAL",4,0)
- ;Licensed under the terms of the GNU General Public License.
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CVITAL",5,0)
- ;See attached copy of the License.
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CVITAL",6,0)
- ;
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CVITAL",7,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; License, or (at your option) any later version.
 "RTN","C0CVITAL",8,0)
- ;it under the terms of the GNU General Public License as published by
+ ;
 "RTN","C0CVITAL",9,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CVITAL",10,0)
- ;(at your option) any later version.
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CVITAL",11,0)
- ;
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CVITAL",12,0)
- ;This program is distributed in the hope that it will be useful,
+ ; GNU Affero General Public License for more details.
 "RTN","C0CVITAL",13,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;
 "RTN","C0CVITAL",14,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CVITAL",15,0)
- ;GNU General Public License for more details.
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CVITAL",16,0)
  ;
 "RTN","C0CVITAL",17,0)
- ;You should have received a copy of the GNU General Public License along
+ W "NO ENTRY FROM TOP",!
 "RTN","C0CVITAL",18,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ Q
 "RTN","C0CVITAL",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
 "RTN","C0CVITAL",20,0)
- ;
+EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
 "RTN","C0CVITAL",21,0)
- W "NO ENTRY FROM TOP",!
+ ;
 "RTN","C0CVITAL",22,0)
+ ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","C0CVITAL",23,0)
+ ; IVITXML CONTAINS ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE
+"RTN","C0CVITAL",24,0)
+ ;
+"RTN","C0CVITAL",25,0)
+ N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF,VORDR
+"RTN","C0CVITAL",26,0)
+ S C0CVLMT=$$GET^C0CPARMS("VITLIMIT") ; GET THE LIMIT PARM
+"RTN","C0CVITAL",27,0)
+ S C0CVSTRT=$$GET^C0CPARMS("VITSTART") ; GET START PARM
+"RTN","C0CVITAL",28,0)
+ D DT^DILF(,C0CVLMT,.C0CEDT) ;
+"RTN","C0CVITAL",29,0)
+ D DT^DILF(,C0CVSTRT,.C0CSDT) ; 
+"RTN","C0CVITAL",30,0)
+ ;D DT^DILF(,C0CVLMT,.C0CSDT) ; GPL TESTING
+"RTN","C0CVITAL",31,0)
+ ;D DT^DILF(,C0CVSTRT,.C0CEDT) ; 
+"RTN","C0CVITAL",32,0)
+ W "VITALS START: ",C0CVSTRT," LIMIT: ",C0CVLMT,!
+"RTN","C0CVITAL",33,0)
+ I $$RPMS^C0CUTIL() D VITRPMS QUIT
+"RTN","C0CVITAL",34,0)
+ I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VITVISTA QUIT
+"RTN","C0CVITAL",35,0)
+ ;I $$SYSNAME^C0CSYS()="RPMS" D VITRPMS
+"RTN","C0CVITAL",36,0)
+ ;E  D VITVISTA
+"RTN","C0CVITAL",37,0)
  Q
-"RTN","C0CVITAL",23,0)
- ;
-"RTN","C0CVITAL",24,0)
-EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
-"RTN","C0CVITAL",25,0)
- ;
-"RTN","C0CVITAL",26,0)
- ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","C0CVITAL",27,0)
- ; IVITXML CONTAINS ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE
-"RTN","C0CVITAL",28,0)
- ;
-"RTN","C0CVITAL",29,0)
- N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF,VORDR
-"RTN","C0CVITAL",30,0)
- S C0CVLMT=$$GET^C0CPARMS("VITLIMIT") ; GET THE LIMIT PARM
-"RTN","C0CVITAL",31,0)
- S C0CVSTRT=$$GET^C0CPARMS("VITSTART") ; GET START PARM
-"RTN","C0CVITAL",32,0)
- D DT^DILF(,C0CVLMT,.C0CEDT) ;
-"RTN","C0CVITAL",33,0)
- D DT^DILF(,C0CVSTRT,.C0CSDT) ; 
-"RTN","C0CVITAL",34,0)
- ;D DT^DILF(,C0CVLMT,.C0CSDT) ; GPL TESTING
-"RTN","C0CVITAL",35,0)
- ;D DT^DILF(,C0CVSTRT,.C0CEDT) ; 
-"RTN","C0CVITAL",36,0)
- W "VITALS START: ",C0CVSTRT," LIMIT: ",C0CVLMT,!
-"RTN","C0CVITAL",37,0)
- I $$RPMS^C0CUTIL() D VITRPMS QUIT
 "RTN","C0CVITAL",38,0)
- I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VITVISTA QUIT
+ ;
 "RTN","C0CVITAL",39,0)
- ;I $$SYSNAME^C0CSYS()="RPMS" D VITRPMS
+VITVISTA ; EXTRACT VITALS FROM VISTA INTO PROVIDED XML TEMPLATE
 "RTN","C0CVITAL",40,0)
- ;E  D VITVISTA
+ D FASTVIT^ORQQVI(.VITRSLT,DFN,C0CEDT,C0CSDT) ; GPL THIS ONE WORKS FOR AT
 "RTN","C0CVITAL",41,0)
- Q
+ ; LEAST ONE SET OF VITALS - TO DO, CALL IT REPETIVELY TO GET EARLIER VITALS
 "RTN","C0CVITAL",42,0)
- ;
+ ;D VITALS^ORQQVI(.VITRSLT,DFN,C0CEDT,C0CSDT)
 "RTN","C0CVITAL",43,0)
-VITVISTA ; EXTRACT VITALS FROM VISTA INTO PROVIDED XML TEMPLATE
+ ;D VITALS^ORQQVI(.VITRSLT,DFN,C0CSDT,C0CEDT)
 "RTN","C0CVITAL",44,0)
- D FASTVIT^ORQQVI(.VITRSLT,DFN,C0CEDT,C0CSDT) ; GPL THIS ONE WORKS FOR AT
+ ;D VITALS^ORQQVI(.VITRSLT,DFN,C0CVSTRT,C0CVLMT) ; GPL LET GMR HANDLE THE DATES
 "RTN","C0CVITAL",45,0)
- ; LEAST ONE SET OF VITALS - TO DO, CALL IT REPETIVELY TO GET EARLIER VITALS
+ I '$D(VITRSLT(1)) S @VITOUTXML@(0)=0 Q  ; RETURN NOT FOUND AND QUIT
 "RTN","C0CVITAL",46,0)
- ;D VITALS^ORQQVI(.VITRSLT,DFN,C0CEDT,C0CSDT)
+ I $P(VITRSLT(1),U,2)="No vitals found." D  Q  ; NULL RESULT FROM RPC
 "RTN","C0CVITAL",47,0)
- ;D VITALS^ORQQVI(.VITRSLT,DFN,C0CSDT,C0CEDT)
+ . I DEBUG W "NO VITALS FOUND FROM VITALS RPC",!
 "RTN","C0CVITAL",48,0)
- ;D VITALS^ORQQVI(.VITRSLT,DFN,C0CVSTRT,C0CVLMT) ; GPL LET GMR HANDLE THE DATES
+ . S @VITOUTXML@(0)=0
 "RTN","C0CVITAL",49,0)
- I '$D(VITRSLT(1)) S @VITOUTXML@(0)=0 Q  ; RETURN NOT FOUND AND QUIT
+ I $P(VITRSLT(1),U,2)="No vitals found." Q  ; QUIT
 "RTN","C0CVITAL",50,0)
- I $P(VITRSLT(1),U,2)="No vitals found." D  Q  ; NULL RESULT FROM RPC
+ ; ZWR RPCRSLT
 "RTN","C0CVITAL",51,0)
- . I DEBUG W "NO VITALS FOUND FROM VITALS RPC",!
+ S VITTVMAP=$NA(^TMP("C0CCCR",$J,"VITALS"))
 "RTN","C0CVITAL",52,0)
- . S @VITOUTXML@(0)=0
+ S VITTARYTMP=$NA(^TMP("C0CCCR",$J,"VITALARYTMP"))
 "RTN","C0CVITAL",53,0)
- I $P(VITRSLT(1),U,2)="No vitals found." Q  ; QUIT
+ K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
 "RTN","C0CVITAL",54,0)
- ; ZWR RPCRSLT
+ N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
 "RTN","C0CVITAL",55,0)
- S VITTVMAP=$NA(^TMP("C0CCCR",$J,"VITALS"))
+ D SORTVIST(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
 "RTN","C0CVITAL",56,0)
- S VITTARYTMP=$NA(^TMP("C0CCCR",$J,"VITALARYTMP"))
+ ; I DEBUG ZWR VDATES ;DEBUG
 "RTN","C0CVITAL",57,0)
- K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
+ S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
 "RTN","C0CVITAL",58,0)
- N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
+ ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
 "RTN","C0CVITAL",59,0)
- D VITDVISTA(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
+ S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS
 "RTN","C0CVITAL",60,0)
- I DEBUG ZWR VDATES ;DEBUG
+ F J=1:1:VCNT  D  ; FOR EACH VITAL IN THE LIST
 "RTN","C0CVITAL",61,0)
- S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
+ . I $D(VITRSLT(VSORT(J))) D
 "RTN","C0CVITAL",62,0)
- ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
+ . . S VITVMAP=$NA(@VITTVMAP@(J))
 "RTN","C0CVITAL",63,0)
- S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS
+ . . K @VITVMAP
 "RTN","C0CVITAL",64,0)
- F J=1:1:VCNT  D  ; FOR EACH VITAL IN THE LIST
+ . . I DEBUG W "VMAP= ",VITVMAP,!
 "RTN","C0CVITAL",65,0)
- . I $D(VITRSLT(VSORT(J))) D
+ . . S VITPTMP=VITRSLT(VSORT(J)) ; DATE SORTED VITAL FROM RETURN ARRAY
 "RTN","C0CVITAL",66,0)
- . . S VITVMAP=$NA(@VITTVMAP@(J))
+ . . I DEBUG W "VITAL ",VSORT(J),!
 "RTN","C0CVITAL",67,0)
- . . K @VITVMAP
+ . . I DEBUG W VITRSLT(VSORT(J))," ",$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT"),!
 "RTN","C0CVITAL",68,0)
- . . I DEBUG W "VMAP= ",VITVMAP,!
+ . . I DEBUG W $P(VITPTMP,U,4),!
 "RTN","C0CVITAL",69,0)
- . . S VITPTMP=VITRSLT(VSORT(J)) ; DATE SORTED VITAL FROM RETURN ARRAY
+ . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID
 "RTN","C0CVITAL",70,0)
- . . I DEBUG W "VITAL ",VSORT(J),!
+        . . ;B  ;gpl
 "RTN","C0CVITAL",71,0)
- . . I DEBUG W VITRSLT(VSORT(J))," ",$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT"),!
+        . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^GMR(120.5,$P(VITPTMP,U,1),0)),U,6)
 "RTN","C0CVITAL",72,0)
- . . I DEBUG W $P(VITPTMP,U,4),!
+        . . I @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_" D  ;
 "RTN","C0CVITAL",73,0)
- . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID
+        . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORSYSTEM_1"
 "RTN","C0CVITAL",74,0)
-        . . ;B  ;gpl
+ . . I $P(VITPTMP,U,2)="HT" D
 "RTN","C0CVITAL",75,0)
-        . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^GMR(120.5,$P(VITPTMP,U,1),0)),U,6)
+ . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
 "RTN","C0CVITAL",76,0)
-        . . I @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_" D  ;
+ . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
 "RTN","C0CVITAL",77,0)
-        . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORSYSTEM_1"
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
 "RTN","C0CVITAL",78,0)
- . . I $P(VITPTMP,U,2)="HT" D
+ . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
 "RTN","C0CVITAL",79,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+ . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
 "RTN","C0CVITAL",80,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
+ . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
 "RTN","C0CVITAL",81,0)
  . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
 "RTN","C0CVITAL",82,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="248327008"
+"RTN","C0CVITAL",83,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVITAL",84,0)
+ . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVITAL",85,0)
+ . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","C0CVITAL",86,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","C0CVITAL",87,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
+"RTN","C0CVITAL",88,0)
+ . . E  I $P(VITPTMP,U,2)="WT" D
+"RTN","C0CVITAL",89,0)
+ . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVITAL",90,0)
+ . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
+"RTN","C0CVITAL",91,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
+"RTN","C0CVITAL",92,0)
  . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",83,0)
+"RTN","C0CVITAL",93,0)
  . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",84,0)
+"RTN","C0CVITAL",94,0)
  . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",85,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
-"RTN","C0CVITAL",86,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="248327008"
-"RTN","C0CVITAL",87,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",88,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",89,0)
- . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","C0CVITAL",90,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","C0CVITAL",91,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
-"RTN","C0CVITAL",92,0)
- . . E  I $P(VITPTMP,U,2)="WT" D
-"RTN","C0CVITAL",93,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",94,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
 "RTN","C0CVITAL",95,0)
  . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
 "RTN","C0CVITAL",96,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="107647005"
+"RTN","C0CVITAL",97,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVITAL",98,0)
+ . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVITAL",99,0)
+ . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","C0CVITAL",100,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","C0CVITAL",101,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
+"RTN","C0CVITAL",102,0)
+ . . E  I $P(VITPTMP,U,2)="BP" D
+"RTN","C0CVITAL",103,0)
+ . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVITAL",104,0)
+ . . . ;S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
+"RTN","C0CVITAL",105,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
+"RTN","C0CVITAL",106,0)
  . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",97,0)
+"RTN","C0CVITAL",107,0)
  . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",98,0)
+"RTN","C0CVITAL",108,0)
  . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",99,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
-"RTN","C0CVITAL",100,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="107647005"
-"RTN","C0CVITAL",101,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",102,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",103,0)
- . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","C0CVITAL",104,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","C0CVITAL",105,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
-"RTN","C0CVITAL",106,0)
- . . E  I $P(VITPTMP,U,2)="BP" D
-"RTN","C0CVITAL",107,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",108,0)
- . . . ;S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
 "RTN","C0CVITAL",109,0)
  . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
 "RTN","C0CVITAL",110,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="392570002"
+"RTN","C0CVITAL",111,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVITAL",112,0)
+ . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVITAL",113,0)
+ . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","C0CVITAL",114,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","C0CVITAL",115,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","C0CVITAL",116,0)
+ . . E  I $P(VITPTMP,U,2)="T" D
+"RTN","C0CVITAL",117,0)
+ . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVITAL",118,0)
+ . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
+"RTN","C0CVITAL",119,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
+"RTN","C0CVITAL",120,0)
  . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",111,0)
+"RTN","C0CVITAL",121,0)
  . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",112,0)
+"RTN","C0CVITAL",122,0)
  . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",113,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
-"RTN","C0CVITAL",114,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="392570002"
-"RTN","C0CVITAL",115,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",116,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",117,0)
- . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","C0CVITAL",118,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","C0CVITAL",119,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","C0CVITAL",120,0)
- . . E  I $P(VITPTMP,U,2)="T" D
-"RTN","C0CVITAL",121,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",122,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
 "RTN","C0CVITAL",123,0)
  . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
 "RTN","C0CVITAL",124,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="309646008"
+"RTN","C0CVITAL",125,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVITAL",126,0)
+ . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVITAL",127,0)
+ . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","C0CVITAL",128,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","C0CVITAL",129,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F"
+"RTN","C0CVITAL",130,0)
+ . . E  I $P(VITPTMP,U,2)="R" D
+"RTN","C0CVITAL",131,0)
+ . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVITAL",132,0)
+ . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
+"RTN","C0CVITAL",133,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
+"RTN","C0CVITAL",134,0)
  . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",125,0)
+"RTN","C0CVITAL",135,0)
  . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",126,0)
+"RTN","C0CVITAL",136,0)
  . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",127,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
-"RTN","C0CVITAL",128,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="309646008"
-"RTN","C0CVITAL",129,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",130,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",131,0)
- . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","C0CVITAL",132,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","C0CVITAL",133,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F"
-"RTN","C0CVITAL",134,0)
- . . E  I $P(VITPTMP,U,2)="R" D
-"RTN","C0CVITAL",135,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",136,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
 "RTN","C0CVITAL",137,0)
  . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
 "RTN","C0CVITAL",138,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="366147009"
+"RTN","C0CVITAL",139,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVITAL",140,0)
+ . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVITAL",141,0)
+ . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","C0CVITAL",142,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","C0CVITAL",143,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","C0CVITAL",144,0)
+ . . E  I $P(VITPTMP,U,2)="P" D
+"RTN","C0CVITAL",145,0)
+ . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVITAL",146,0)
+ . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
+"RTN","C0CVITAL",147,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
+"RTN","C0CVITAL",148,0)
  . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",139,0)
+"RTN","C0CVITAL",149,0)
  . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",140,0)
+"RTN","C0CVITAL",150,0)
  . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",141,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
-"RTN","C0CVITAL",142,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="366147009"
-"RTN","C0CVITAL",143,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",144,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",145,0)
- . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","C0CVITAL",146,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","C0CVITAL",147,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","C0CVITAL",148,0)
- . . E  I $P(VITPTMP,U,2)="P" D
-"RTN","C0CVITAL",149,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",150,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
 "RTN","C0CVITAL",151,0)
  . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
 "RTN","C0CVITAL",152,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="366199006"
+"RTN","C0CVITAL",153,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVITAL",154,0)
+ . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVITAL",155,0)
+ . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","C0CVITAL",156,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","C0CVITAL",157,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","C0CVITAL",158,0)
+ . . E  I $P(VITPTMP,U,2)="PN" D
+"RTN","C0CVITAL",159,0)
+ . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVITAL",160,0)
+ . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
+"RTN","C0CVITAL",161,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
+"RTN","C0CVITAL",162,0)
  . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",153,0)
+"RTN","C0CVITAL",163,0)
  . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",154,0)
+"RTN","C0CVITAL",164,0)
  . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",155,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
-"RTN","C0CVITAL",156,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="366199006"
-"RTN","C0CVITAL",157,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",158,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",159,0)
- . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","C0CVITAL",160,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","C0CVITAL",161,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","C0CVITAL",162,0)
- . . E  I $P(VITPTMP,U,2)="PN" D
-"RTN","C0CVITAL",163,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",164,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
 "RTN","C0CVITAL",165,0)
  . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
 "RTN","C0CVITAL",166,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="22253000"
+"RTN","C0CVITAL",167,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVITAL",168,0)
+ . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVITAL",169,0)
+ . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","C0CVITAL",170,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","C0CVITAL",171,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","C0CVITAL",172,0)
+ . . E  I $P(VITPTMP,U,2)="BMI" D
+"RTN","C0CVITAL",173,0)
+ . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVITAL",174,0)
+ . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
+"RTN","C0CVITAL",175,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BMI"
+"RTN","C0CVITAL",176,0)
  . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",167,0)
+"RTN","C0CVITAL",177,0)
  . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",168,0)
+"RTN","C0CVITAL",178,0)
  . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",169,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
-"RTN","C0CVITAL",170,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="22253000"
-"RTN","C0CVITAL",171,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",172,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",173,0)
- . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","C0CVITAL",174,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","C0CVITAL",175,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","C0CVITAL",176,0)
- . . E  I $P(VITPTMP,U,2)="BMI" D
-"RTN","C0CVITAL",177,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",178,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
 "RTN","C0CVITAL",179,0)
  . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BMI"
 "RTN","C0CVITAL",180,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="60621009"
+"RTN","C0CVITAL",181,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVITAL",182,0)
+ . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVITAL",183,0)
+ . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","C0CVITAL",184,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","C0CVITAL",185,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","C0CVITAL",186,0)
+ . . E  D
+"RTN","C0CVITAL",187,0)
+ . . . ;W "IN VITAL:  OTHER",!
+"RTN","C0CVITAL",188,0)
+ . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVITAL",189,0)
+ . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
+"RTN","C0CVITAL",190,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
+"RTN","C0CVITAL",191,0)
  . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",181,0)
+"RTN","C0CVITAL",192,0)
  . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",182,0)
+"RTN","C0CVITAL",193,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="UNKNOWN"
+"RTN","C0CVITAL",194,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
+"RTN","C0CVITAL",195,0)
+ . . . ;S @VITVMAP@("VITALSIGNSDESCCODEVALUE")=""
+"RTN","C0CVITAL",196,0)
+ . . . ;S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")=""
+"RTN","C0CVITAL",197,0)
+ . . . ;S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVITAL",198,0)
+ . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^GMR(120.5,$P(VITPTMP,U,1),0)),U,6)
+"RTN","C0CVITAL",199,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","C0CVITAL",200,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
+"RTN","C0CVITAL",201,0)
+        . . I @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_" D  ;
+"RTN","C0CVITAL",202,0)
+        . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORSYSTEM_1" ;
+"RTN","C0CVITAL",203,0)
+ . . S VITARYTMP=$NA(@VITTARYTMP@(J))
+"RTN","C0CVITAL",204,0)
+ . . K @VITARYTMP
+"RTN","C0CVITAL",205,0)
+ . . D MAP^C0CXPATH(VITXML,VITVMAP,VITARYTMP)
+"RTN","C0CVITAL",206,0)
+ . . I J=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","C0CVITAL",207,0)
+ . . . ; W "FIRST ONE",!
+"RTN","C0CVITAL",208,0)
+ . . . D CP^C0CXPATH(VITARYTMP,VITOUTXML)
+"RTN","C0CVITAL",209,0)
+ . . . I DEBUG W "VITOUTXML ",VITOUTXML,!
+"RTN","C0CVITAL",210,0)
+ . . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
+"RTN","C0CVITAL",211,0)
+ . . . D INSINNER^C0CXPATH(VITOUTXML,VITARYTMP)
+"RTN","C0CVITAL",212,0)
+ ; ZWR ^TMP($J,"VITALS",*)
+"RTN","C0CVITAL",213,0)
+ ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
+"RTN","C0CVITAL",214,0)
+ I DEBUG D PARY^C0CXPATH(VITOUTXML)
+"RTN","C0CVITAL",215,0)
+ N VITTMP,I
+"RTN","C0CVITAL",216,0)
+ D MISSING^C0CXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","C0CVITAL",217,0)
+ I VITTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+"RTN","C0CVITAL",218,0)
+ . W "VITALS MISSING ",!
+"RTN","C0CVITAL",219,0)
+ . F I=1:1:VITTMP(0) W VITTMP(I),!
+"RTN","C0CVITAL",220,0)
+ Q
+"RTN","C0CVITAL",221,0)
+ ;
+"RTN","C0CVITAL",222,0)
+VITRPMS ; EXTRACT VITALS FROM RPMS INTO PROVIDED XML TEMPLATE
+"RTN","C0CVITAL",223,0)
+ ; RPMS VITAL RPC ONLY RETURNS LATEST VITAL IN SPECIFIED DATE RANGE NOT ALL VITALS IN DATE RANGE
+"RTN","C0CVITAL",224,0)
+ ; WE NEED TO SETUP THE VARIABLES THE INTERNAL CALL NEEDS TO BYPASS A HARD CODE OF ONE VITAL FOR DATE RANGE
+"RTN","C0CVITAL",225,0)
+ N END,START,DATA
+"RTN","C0CVITAL",226,0)
+ D DT^DILF("",C0CVLMT,.END)
+"RTN","C0CVITAL",227,0)
+ D DT^DILF("",C0CVSTRT,.START)
+"RTN","C0CVITAL",228,0)
+ ; RPC OUTPUT FORMAT:
+"RTN","C0CVITAL",229,0)
+ ; vfile ien^vital name^vital abbr^date/time taken(FM FORMAT)^value+units (US & metric)
+"RTN","C0CVITAL",230,0)
+ D QUERY^BEHOVM("LISTX") ; RUN QUERY VITALS CALL
+"RTN","C0CVITAL",231,0)
+ I '$D(^TMP("CIAVMRPC",$J)) S @VITOUTXML@(0)=0 Q  ; RETURN NOT FOUND AND QUIT
+"RTN","C0CVITAL",232,0)
+ ;ZW ^TMP("CIAVMRPC",$J)
+"RTN","C0CVITAL",233,0)
+ S VITTVMAP=$NA(^TMP("C0CCCR",$J,"VITALS"))
+"RTN","C0CVITAL",234,0)
+ S VITTARYTMP=$NA(^TMP("C0CCCR",$J,"VITALARYTMP"))
+"RTN","C0CVITAL",235,0)
+ K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
+"RTN","C0CVITAL",236,0)
+ N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
+"RTN","C0CVITAL",237,0)
+ D SORTRPMS(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
+"RTN","C0CVITAL",238,0)
+ S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
+"RTN","C0CVITAL",239,0)
+ ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
+"RTN","C0CVITAL",240,0)
+ S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS
+"RTN","C0CVITAL",241,0)
+ F J=1:1:VCNT  D  ; FOR EACH VITAL IN THE LIST
+"RTN","C0CVITAL",242,0)
+ . I $D(^TMP("CIAVMRPC",$J,0,(VSORT(J)))) D
+"RTN","C0CVITAL",243,0)
+ . . S VITVMAP=$NA(@VITTVMAP@(J))
+"RTN","C0CVITAL",244,0)
+ . . K @VITVMAP
+"RTN","C0CVITAL",245,0)
+ . . I DEBUG W "VMAP= ",VITVMAP,!
+"RTN","C0CVITAL",246,0)
+ . . S VITPTMP=^TMP("CIAVMRPC",$J,0,(VSORT(J))) ; DATE SORTED VITAL FROM RETURN ARRAY
+"RTN","C0CVITAL",247,0)
+ . . I DEBUG W "VITAL ",VSORT(J),!
+"RTN","C0CVITAL",248,0)
+ . . I DEBUG W ^TMP("CIAVMRPC",$J,0,(VSORT(J)))," ",$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT"),!
+"RTN","C0CVITAL",249,0)
+ . . I DEBUG W $P(VITPTMP,U,4),!
+"RTN","C0CVITAL",250,0)
+ . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID
+"RTN","C0CVITAL",251,0)
+ . . I $P(VITPTMP,U,3)="HT" D
+"RTN","C0CVITAL",252,0)
+ . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVITAL",253,0)
+ . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
+"RTN","C0CVITAL",254,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
+"RTN","C0CVITAL",255,0)
+ . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","C0CVITAL",256,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","C0CVITAL",257,0)
  . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",183,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BMI"
-"RTN","C0CVITAL",184,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="60621009"
-"RTN","C0CVITAL",185,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",186,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",187,0)
- . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","C0CVITAL",188,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","C0CVITAL",189,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","C0CVITAL",190,0)
- . . E  D
-"RTN","C0CVITAL",191,0)
- . . . ;W "IN VITAL:  OTHER",!
-"RTN","C0CVITAL",192,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",193,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
-"RTN","C0CVITAL",194,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
-"RTN","C0CVITAL",195,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",196,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",197,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="UNKNOWN"
-"RTN","C0CVITAL",198,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
-"RTN","C0CVITAL",199,0)
- . . . ;S @VITVMAP@("VITALSIGNSDESCCODEVALUE")=""
-"RTN","C0CVITAL",200,0)
- . . . ;S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")=""
-"RTN","C0CVITAL",201,0)
- . . . ;S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",202,0)
- . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^GMR(120.5,$P(VITPTMP,U,1),0)),U,6)
-"RTN","C0CVITAL",203,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","C0CVITAL",204,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
-"RTN","C0CVITAL",205,0)
-        . . I @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_" D  ;
-"RTN","C0CVITAL",206,0)
-        . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORSYSTEM_1" ;
-"RTN","C0CVITAL",207,0)
- . . S VITARYTMP=$NA(@VITTARYTMP@(J))
-"RTN","C0CVITAL",208,0)
- . . K @VITARYTMP
-"RTN","C0CVITAL",209,0)
- . . D MAP^C0CXPATH(VITXML,VITVMAP,VITARYTMP)
-"RTN","C0CVITAL",210,0)
- . . I J=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","C0CVITAL",211,0)
- . . . ; W "FIRST ONE",!
-"RTN","C0CVITAL",212,0)
- . . . D CP^C0CXPATH(VITARYTMP,VITOUTXML)
-"RTN","C0CVITAL",213,0)
- . . . I DEBUG W "VITOUTXML ",VITOUTXML,!
-"RTN","C0CVITAL",214,0)
- . . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
-"RTN","C0CVITAL",215,0)
- . . . D INSINNER^C0CXPATH(VITOUTXML,VITARYTMP)
-"RTN","C0CVITAL",216,0)
- ; ZWR ^TMP($J,"VITALS",*)
-"RTN","C0CVITAL",217,0)
- ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
-"RTN","C0CVITAL",218,0)
- I DEBUG D PARY^C0CXPATH(VITOUTXML)
-"RTN","C0CVITAL",219,0)
- N VITTMP,I
-"RTN","C0CVITAL",220,0)
- D MISSING^C0CXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","C0CVITAL",221,0)
- I VITTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","C0CVITAL",222,0)
- . W "VITALS MISSING ",!
-"RTN","C0CVITAL",223,0)
- . F I=1:1:VITTMP(0) W VITTMP(I),!
-"RTN","C0CVITAL",224,0)
- Q
-"RTN","C0CVITAL",225,0)
- ;
-"RTN","C0CVITAL",226,0)
-VITRPMS ; EXTRACT VITALS FROM RPMS INTO PROVIDED XML TEMPLATE
-"RTN","C0CVITAL",227,0)
- ; RPMS VITAL RPC ONLY RETURNS LATEST VITAL IN SPECIFIED DATE RANGE NOT ALL VITALS IN DATE RANGE
-"RTN","C0CVITAL",228,0)
- ; WE NEED TO SETUP THE VARIABLES THE INTERNAL CALL NEEDS TO BYPASS A HARD CODE OF ONE VITAL FOR DATE RANGE
-"RTN","C0CVITAL",229,0)
- N END,START,DATA
-"RTN","C0CVITAL",230,0)
- D DT^DILF("",C0CVLMT,.END)
-"RTN","C0CVITAL",231,0)
- D DT^DILF("",C0CVSTRT,.START)
-"RTN","C0CVITAL",232,0)
- ; RPC OUTPUT FORMAT:
-"RTN","C0CVITAL",233,0)
- ; vfile ien^vital name^vital abbr^date/time taken(FM FORMAT)^value+units (US & metric)
-"RTN","C0CVITAL",234,0)
- D QUERY^BEHOVM("LISTX") ; RUN QUERY VITALS CALL
-"RTN","C0CVITAL",235,0)
- I '$D(^TMP("CIAVMRPC",$J)) S @VITOUTXML@(0)=0 Q  ; RETURN NOT FOUND AND QUIT
-"RTN","C0CVITAL",236,0)
- ;ZW ^TMP("CIAVMRPC",$J)
-"RTN","C0CVITAL",237,0)
- S VITTVMAP=$NA(^TMP("C0CCCR",$J,"VITALS"))
-"RTN","C0CVITAL",238,0)
- S VITTARYTMP=$NA(^TMP("C0CCCR",$J,"VITALARYTMP"))
-"RTN","C0CVITAL",239,0)
- K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
-"RTN","C0CVITAL",240,0)
- N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
-"RTN","C0CVITAL",241,0)
- D VITDRPMS(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
-"RTN","C0CVITAL",242,0)
- S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
-"RTN","C0CVITAL",243,0)
- ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
-"RTN","C0CVITAL",244,0)
- S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS
-"RTN","C0CVITAL",245,0)
- F J=1:1:VCNT  D  ; FOR EACH VITAL IN THE LIST
-"RTN","C0CVITAL",246,0)
- . I $D(^TMP("CIAVMRPC",$J,0,(VSORT(J)))) D
-"RTN","C0CVITAL",247,0)
- . . S VITVMAP=$NA(@VITTVMAP@(J))
-"RTN","C0CVITAL",248,0)
- . . K @VITVMAP
-"RTN","C0CVITAL",249,0)
- . . I DEBUG W "VMAP= ",VITVMAP,!
-"RTN","C0CVITAL",250,0)
- . . S VITPTMP=^TMP("CIAVMRPC",$J,0,(VSORT(J))) ; DATE SORTED VITAL FROM RETURN ARRAY
-"RTN","C0CVITAL",251,0)
- . . I DEBUG W "VITAL ",VSORT(J),!
-"RTN","C0CVITAL",252,0)
- . . I DEBUG W ^TMP("CIAVMRPC",$J,0,(VSORT(J)))," ",$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT"),!
-"RTN","C0CVITAL",253,0)
- . . I DEBUG W $P(VITPTMP,U,4),!
-"RTN","C0CVITAL",254,0)
- . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID
-"RTN","C0CVITAL",255,0)
- . . I $P(VITPTMP,U,3)="HT" D
-"RTN","C0CVITAL",256,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",257,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
 "RTN","C0CVITAL",258,0)
  . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
 "RTN","C0CVITAL",259,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="248327008"
+"RTN","C0CVITAL",260,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVITAL",261,0)
+ . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVITAL",262,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
+"RTN","C0CVITAL",263,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
+"RTN","C0CVITAL",264,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
+"RTN","C0CVITAL",265,0)
+ . . E  I $P(VITPTMP,U,3)="WT" D
+"RTN","C0CVITAL",266,0)
+ . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVITAL",267,0)
+ . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
+"RTN","C0CVITAL",268,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
+"RTN","C0CVITAL",269,0)
  . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",260,0)
+"RTN","C0CVITAL",270,0)
  . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",261,0)
+"RTN","C0CVITAL",271,0)
  . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",262,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
-"RTN","C0CVITAL",263,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="248327008"
-"RTN","C0CVITAL",264,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",265,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",266,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
-"RTN","C0CVITAL",267,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
-"RTN","C0CVITAL",268,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
-"RTN","C0CVITAL",269,0)
- . . E  I $P(VITPTMP,U,3)="WT" D
-"RTN","C0CVITAL",270,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",271,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
 "RTN","C0CVITAL",272,0)
  . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
 "RTN","C0CVITAL",273,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="107647005"
+"RTN","C0CVITAL",274,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVITAL",275,0)
+ . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVITAL",276,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
+"RTN","C0CVITAL",277,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
+"RTN","C0CVITAL",278,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
+"RTN","C0CVITAL",279,0)
+ . . E  I $P(VITPTMP,U,3)="BP" D
+"RTN","C0CVITAL",280,0)
+ . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVITAL",281,0)
+ . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
+"RTN","C0CVITAL",282,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
+"RTN","C0CVITAL",283,0)
  . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",274,0)
+"RTN","C0CVITAL",284,0)
  . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",275,0)
+"RTN","C0CVITAL",285,0)
  . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",276,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
-"RTN","C0CVITAL",277,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="107647005"
-"RTN","C0CVITAL",278,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",279,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",280,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
-"RTN","C0CVITAL",281,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
-"RTN","C0CVITAL",282,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
-"RTN","C0CVITAL",283,0)
- . . E  I $P(VITPTMP,U,3)="BP" D
-"RTN","C0CVITAL",284,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",285,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
 "RTN","C0CVITAL",286,0)
  . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
 "RTN","C0CVITAL",287,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="392570002"
+"RTN","C0CVITAL",288,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVITAL",289,0)
+ . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVITAL",290,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
+"RTN","C0CVITAL",291,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
+"RTN","C0CVITAL",292,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
+"RTN","C0CVITAL",293,0)
+ . . E  I $P(VITPTMP,U,3)="TMP" D
+"RTN","C0CVITAL",294,0)
+ . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVITAL",295,0)
+ . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
+"RTN","C0CVITAL",296,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
+"RTN","C0CVITAL",297,0)
  . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",288,0)
+"RTN","C0CVITAL",298,0)
  . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",289,0)
+"RTN","C0CVITAL",299,0)
  . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",290,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
-"RTN","C0CVITAL",291,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="392570002"
-"RTN","C0CVITAL",292,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",293,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",294,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
-"RTN","C0CVITAL",295,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
-"RTN","C0CVITAL",296,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
-"RTN","C0CVITAL",297,0)
- . . E  I $P(VITPTMP,U,3)="TMP" D
-"RTN","C0CVITAL",298,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",299,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
 "RTN","C0CVITAL",300,0)
  . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
 "RTN","C0CVITAL",301,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="309646008"
+"RTN","C0CVITAL",302,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVITAL",303,0)
+ . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVITAL",304,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
+"RTN","C0CVITAL",305,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
+"RTN","C0CVITAL",306,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
+"RTN","C0CVITAL",307,0)
+ . . E  I $P(VITPTMP,U,3)="RS" D
+"RTN","C0CVITAL",308,0)
+ . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVITAL",309,0)
+ . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
+"RTN","C0CVITAL",310,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
+"RTN","C0CVITAL",311,0)
  . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",302,0)
+"RTN","C0CVITAL",312,0)
  . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",303,0)
+"RTN","C0CVITAL",313,0)
  . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",304,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
-"RTN","C0CVITAL",305,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="309646008"
-"RTN","C0CVITAL",306,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",307,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",308,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
-"RTN","C0CVITAL",309,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
-"RTN","C0CVITAL",310,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
-"RTN","C0CVITAL",311,0)
- . . E  I $P(VITPTMP,U,3)="RS" D
-"RTN","C0CVITAL",312,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",313,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
 "RTN","C0CVITAL",314,0)
  . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
 "RTN","C0CVITAL",315,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="366147009"
+"RTN","C0CVITAL",316,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVITAL",317,0)
+ . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVITAL",318,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
+"RTN","C0CVITAL",319,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
+"RTN","C0CVITAL",320,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
+"RTN","C0CVITAL",321,0)
+ . . E  I $P(VITPTMP,U,3)="PU" D
+"RTN","C0CVITAL",322,0)
+ . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVITAL",323,0)
+ . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
+"RTN","C0CVITAL",324,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
+"RTN","C0CVITAL",325,0)
  . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",316,0)
+"RTN","C0CVITAL",326,0)
  . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",317,0)
+"RTN","C0CVITAL",327,0)
  . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",318,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
-"RTN","C0CVITAL",319,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="366147009"
-"RTN","C0CVITAL",320,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",321,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",322,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
-"RTN","C0CVITAL",323,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
-"RTN","C0CVITAL",324,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
-"RTN","C0CVITAL",325,0)
- . . E  I $P(VITPTMP,U,3)="PU" D
-"RTN","C0CVITAL",326,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",327,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
 "RTN","C0CVITAL",328,0)
  . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
 "RTN","C0CVITAL",329,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="366199006"
+"RTN","C0CVITAL",330,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVITAL",331,0)
+ . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVITAL",332,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
+"RTN","C0CVITAL",333,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
+"RTN","C0CVITAL",334,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
+"RTN","C0CVITAL",335,0)
+ . . E  I $P(VITPTMP,U,3)="PA" D
+"RTN","C0CVITAL",336,0)
+ . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVITAL",337,0)
+ . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
+"RTN","C0CVITAL",338,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
+"RTN","C0CVITAL",339,0)
  . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",330,0)
+"RTN","C0CVITAL",340,0)
  . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",331,0)
+"RTN","C0CVITAL",341,0)
  . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",332,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
-"RTN","C0CVITAL",333,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="366199006"
-"RTN","C0CVITAL",334,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",335,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",336,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
-"RTN","C0CVITAL",337,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
-"RTN","C0CVITAL",338,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
-"RTN","C0CVITAL",339,0)
- . . E  I $P(VITPTMP,U,3)="PA" D
-"RTN","C0CVITAL",340,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",341,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
 "RTN","C0CVITAL",342,0)
  . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
 "RTN","C0CVITAL",343,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="22253000"
+"RTN","C0CVITAL",344,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVITAL",345,0)
+ . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVITAL",346,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
+"RTN","C0CVITAL",347,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
+"RTN","C0CVITAL",348,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
+"RTN","C0CVITAL",349,0)
+ . . E  D
+"RTN","C0CVITAL",350,0)
+ . . . ;W "IN VITAL:  OTHER",!
+"RTN","C0CVITAL",351,0)
+ . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVITAL",352,0)
+ . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
+"RTN","C0CVITAL",353,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")=$P(VITPTMP,U,2)
+"RTN","C0CVITAL",354,0)
  . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",344,0)
+"RTN","C0CVITAL",355,0)
  . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",345,0)
+"RTN","C0CVITAL",356,0)
  . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",346,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
-"RTN","C0CVITAL",347,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")="22253000"
-"RTN","C0CVITAL",348,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",349,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",350,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
-"RTN","C0CVITAL",351,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
-"RTN","C0CVITAL",352,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
-"RTN","C0CVITAL",353,0)
- . . E  D
-"RTN","C0CVITAL",354,0)
- . . . ;W "IN VITAL:  OTHER",!
-"RTN","C0CVITAL",355,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",356,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
 "RTN","C0CVITAL",357,0)
  . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")=$P(VITPTMP,U,2)
 "RTN","C0CVITAL",358,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+ . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")=""
 "RTN","C0CVITAL",359,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+ . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")=""
 "RTN","C0CVITAL",360,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+ . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
 "RTN","C0CVITAL",361,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")=$P(VITPTMP,U,2)
+ . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
 "RTN","C0CVITAL",362,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")=""
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
 "RTN","C0CVITAL",363,0)
- . . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")=""
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
 "RTN","C0CVITAL",364,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+ . . S VITARYTMP=$NA(@VITTARYTMP@(J))
 "RTN","C0CVITAL",365,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
+ . . K @VITARYTMP
 "RTN","C0CVITAL",366,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
+ . . D MAP^C0CXPATH(VITXML,VITVMAP,VITARYTMP)
 "RTN","C0CVITAL",367,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
+ . . I J=1 D  ; FIRST ONE IS JUST A COPY
 "RTN","C0CVITAL",368,0)
- . . S VITARYTMP=$NA(@VITTARYTMP@(J))
+ . . . ; W "FIRST ONE",!
 "RTN","C0CVITAL",369,0)
- . . K @VITARYTMP
+ . . . D CP^C0CXPATH(VITARYTMP,VITOUTXML)
 "RTN","C0CVITAL",370,0)
- . . D MAP^C0CXPATH(VITXML,VITVMAP,VITARYTMP)
+ . . . I DEBUG W "VITOUTXML ",VITOUTXML,!
 "RTN","C0CVITAL",371,0)
- . . I J=1 D  ; FIRST ONE IS JUST A COPY
+ . . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
 "RTN","C0CVITAL",372,0)
- . . . ; W "FIRST ONE",!
+ . . . D INSINNER^C0CXPATH(VITOUTXML,VITARYTMP)
 "RTN","C0CVITAL",373,0)
- . . . D CP^C0CXPATH(VITARYTMP,VITOUTXML)
+ ; ZWR ^TMP($J,"VITALS",*)
 "RTN","C0CVITAL",374,0)
- . . . I DEBUG W "VITOUTXML ",VITOUTXML,!
+ ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
 "RTN","C0CVITAL",375,0)
- . . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
+ I DEBUG D PARY^C0CXPATH(VITOUTXML)
 "RTN","C0CVITAL",376,0)
- . . . D INSINNER^C0CXPATH(VITOUTXML,VITARYTMP)
+ N VITTMP,I
 "RTN","C0CVITAL",377,0)
- ; ZWR ^TMP($J,"VITALS",*)
+ D MISSING^C0CXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
 "RTN","C0CVITAL",378,0)
- ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
+ I VITTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
 "RTN","C0CVITAL",379,0)
- I DEBUG D PARY^C0CXPATH(VITOUTXML)
+ . W "VITALS MISSING ",!
 "RTN","C0CVITAL",380,0)
- N VITTMP,I
+ . F I=1:1:VITTMP(0) W VITTMP(I),!
 "RTN","C0CVITAL",381,0)
- D MISSING^C0CXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
+ K ^TMP("CIAVMRPC",$J)
 "RTN","C0CVITAL",382,0)
- I VITTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+ Q
 "RTN","C0CVITAL",383,0)
- . W "VITALS MISSING ",!
+ ;
 "RTN","C0CVITAL",384,0)
- . F I=1:1:VITTMP(0) W VITTMP(I),!
+SORTRPMS(VDT) ; RUN DATE SORTING ALGORITHM FOR RPMS
 "RTN","C0CVITAL",385,0)
- K ^TMP("CIAVMRPC",$J)
+ ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
 "RTN","C0CVITAL",386,0)
+ ; OF DATES IN THE VITALS RESULTS
+"RTN","C0CVITAL",387,0)
+ N VDTI,VDTJ,VTDCNT
+"RTN","C0CVITAL",388,0)
+ S VTDCNT=0 ; COUNT TO BUILD ARRAY
+"RTN","C0CVITAL",389,0)
+ S VDTJ="" ; USED TO VISIT THE RESULTS
+"RTN","C0CVITAL",390,0)
+ F VDTI=0:0 D  Q:$O(^TMP("CIAVMRPC",$J,0,VDTJ))=""  ; VISIT ALL RESULTS
+"RTN","C0CVITAL",391,0)
+ . S VDTJ=$O(^TMP("CIAVMRPC",$J,0,VDTJ)) ; NEXT RESULT
+"RTN","C0CVITAL",392,0)
+ . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
+"RTN","C0CVITAL",393,0)
+ . S VDT(VTDCNT)=$P(^TMP("CIAVMRPC",$J,0,VDTJ),U,4) ; PULL OUT THE DATE
+"RTN","C0CVITAL",394,0)
+ S VDT(0)=VTDCNT
+"RTN","C0CVITAL",395,0)
  Q
-"RTN","C0CVITAL",387,0)
- ;
-"RTN","C0CVITAL",388,0)
-VITDRPMS(VDT) ; RUN DATE SORTING ALGORITHM FOR RPMS
-"RTN","C0CVITAL",389,0)
+"RTN","C0CVITAL",396,0)
+ ;
+"RTN","C0CVITAL",397,0)
+SORTVIST(VDT) ; RUN DATE SORTING ALGORITHM FOR VISTA
+"RTN","C0CVITAL",398,0)
  ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
-"RTN","C0CVITAL",390,0)
+"RTN","C0CVITAL",399,0)
  ; OF DATES IN THE VITALS RESULTS
-"RTN","C0CVITAL",391,0)
+"RTN","C0CVITAL",400,0)
  N VDTI,VDTJ,VTDCNT
-"RTN","C0CVITAL",392,0)
+"RTN","C0CVITAL",401,0)
  S VTDCNT=0 ; COUNT TO BUILD ARRAY
-"RTN","C0CVITAL",393,0)
+"RTN","C0CVITAL",402,0)
  S VDTJ="" ; USED TO VISIT THE RESULTS
-"RTN","C0CVITAL",394,0)
- F VDTI=0:0 D  Q:$O(^TMP("CIAVMRPC",$J,0,VDTJ))=""  ; VISIT ALL RESULTS
-"RTN","C0CVITAL",395,0)
- . S VDTJ=$O(^TMP("CIAVMRPC",$J,0,VDTJ)) ; NEXT RESULT
-"RTN","C0CVITAL",396,0)
+"RTN","C0CVITAL",403,0)
+ F VDTI=0:0 D  Q:$O(VITRSLT(VDTJ))=""  ; VISIT ALL RESULTS
+"RTN","C0CVITAL",404,0)
+ . S VDTJ=$O(VITRSLT(VDTJ)) ; NEXT RESULT
+"RTN","C0CVITAL",405,0)
  . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
-"RTN","C0CVITAL",397,0)
- . S VDT(VTDCNT)=$P(^TMP("CIAVMRPC",$J,0,VDTJ),U,4) ; PULL OUT THE DATE
-"RTN","C0CVITAL",398,0)
+"RTN","C0CVITAL",406,0)
+ . S VDT(VTDCNT)=$P(VITRSLT(VDTJ),U,4) ; PULL OUT THE DATE
+"RTN","C0CVITAL",407,0)
  S VDT(0)=VTDCNT
-"RTN","C0CVITAL",399,0)
+"RTN","C0CVITAL",408,0)
  Q
-"RTN","C0CVITAL",400,0)
- ;
-"RTN","C0CVITAL",401,0)
-VITDVISTA(VDT) ; RUN DATE SORTING ALGORITHM FOR VISTA
-"RTN","C0CVITAL",402,0)
- ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
-"RTN","C0CVITAL",403,0)
- ; OF DATES IN THE VITALS RESULTS
-"RTN","C0CVITAL",404,0)
- N VDTI,VDTJ,VTDCNT
-"RTN","C0CVITAL",405,0)
- S VTDCNT=0 ; COUNT TO BUILD ARRAY
-"RTN","C0CVITAL",406,0)
- S VDTJ="" ; USED TO VISIT THE RESULTS
-"RTN","C0CVITAL",407,0)
- F VDTI=0:0 D  Q:$O(VITRSLT(VDTJ))=""  ; VISIT ALL RESULTS
-"RTN","C0CVITAL",408,0)
- . S VDTJ=$O(VITRSLT(VDTJ)) ; NEXT RESULT
 "RTN","C0CVITAL",409,0)
- . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
-"RTN","C0CVITAL",410,0)
- . S VDT(VTDCNT)=$P(VITRSLT(VDTJ),U,4) ; PULL OUT THE DATE
-"RTN","C0CVITAL",411,0)
- S VDT(0)=VTDCNT
-"RTN","C0CVITAL",412,0)
- Q
-"RTN","C0CVITAL",413,0)
  ;
 "RTN","C0CVOBX1")
-0^99^B12947698
+0^99^B14909630
 "RTN","C0CVOBX1",1,0)
 LA7VOBX1 ;DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd; 04/21/09
 "RTN","C0CVOBX1",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CVOBX1",3,0)
  ; JMC - mods to check for IHS V LAB file
@@ -124580,2906 +124742,2950 @@
  ;
 "RTN","C0CVOBX1",5,0)
+ ; (C) 2009 John McCormack
+"RTN","C0CVOBX1",6,0)
+ ; This program is free software: you can redistribute it and/or modify
+"RTN","C0CVOBX1",7,0)
+ ; it under the terms of the GNU Affero General Public License as
+"RTN","C0CVOBX1",8,0)
+ ; published by the Free Software Foundation, either version 3 of the
+"RTN","C0CVOBX1",9,0)
+ ; License, or (at your option) any later version.
+"RTN","C0CVOBX1",10,0)
+ ;
+"RTN","C0CVOBX1",11,0)
+ ; This program is distributed in the hope that it will be useful,
+"RTN","C0CVOBX1",12,0)
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","C0CVOBX1",13,0)
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","C0CVOBX1",14,0)
+ ; GNU Affero General Public License for more details.
+"RTN","C0CVOBX1",15,0)
+ ;
+"RTN","C0CVOBX1",16,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CVOBX1",17,0)
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+"RTN","C0CVOBX1",18,0)
+ ;
+"RTN","C0CVOBX1",19,0)
 CH ; Observation/Result segment for "CH" subscript results.
-"RTN","C0CVOBX1",6,0)
+"RTN","C0CVOBX1",20,0)
  ; Called by LA7VOBX
-"RTN","C0CVOBX1",7,0)
- ;
-"RTN","C0CVOBX1",8,0)
+"RTN","C0CVOBX1",21,0)
+ ;
+"RTN","C0CVOBX1",22,0)
  N LA76304,LA7ALT,LA7DIV,LA7I,LA7X,LA7Y,X
-"RTN","C0CVOBX1",9,0)
- ;
-"RTN","C0CVOBX1",10,0)
+"RTN","C0CVOBX1",23,0)
+ ;
+"RTN","C0CVOBX1",24,0)
  ; "CH" subscript requires a dataname
-"RTN","C0CVOBX1",11,0)
+"RTN","C0CVOBX1",25,0)
  I '$G(LRSB) Q
-"RTN","C0CVOBX1",12,0)
- ;
-"RTN","C0CVOBX1",13,0)
+"RTN","C0CVOBX1",26,0)
+ ;
+"RTN","C0CVOBX1",27,0)
  ; get result node from LR global.
-"RTN","C0CVOBX1",14,0)
+"RTN","C0CVOBX1",28,0)
  S LA76304(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
-"RTN","C0CVOBX1",15,0)
+"RTN","C0CVOBX1",29,0)
  S LA7VAL=$G(^LR(LRDFN,LRSS,LRIDT,LRSB))
-"RTN","C0CVOBX1",16,0)
- ;
-"RTN","C0CVOBX1",17,0)
+"RTN","C0CVOBX1",30,0)
+ ;
+"RTN","C0CVOBX1",31,0)
  ; Check if test is OK to send - (O)utput or (B)oth
-"RTN","C0CVOBX1",18,0)
+"RTN","C0CVOBX1",32,0)
  S LA7X=$P(LA7VAL,"^",12)
-"RTN","C0CVOBX1",19,0)
+"RTN","C0CVOBX1",33,0)
  I LA7X]"","BO"'[LA7X Q
-"RTN","C0CVOBX1",20,0)
+"RTN","C0CVOBX1",34,0)
  I LA7X="",'$$OKTOSND^LA7VHLU1(LRSS,LRSB,+$P($P(LA7VAL,"^",3),"!",5)) Q
-"RTN","C0CVOBX1",21,0)
- ;
-"RTN","C0CVOBX1",22,0)
+"RTN","C0CVOBX1",35,0)
+ ;
+"RTN","C0CVOBX1",36,0)
  ; If no result NLT or LOINC try to determine from file #60
-"RTN","C0CVOBX1",23,0)
+"RTN","C0CVOBX1",37,0)
  S LA7X=$P(LA7VAL,"^",3)
-"RTN","C0CVOBX1",24,0)
+"RTN","C0CVOBX1",38,0)
  ; WV check for IHS - NLT/LN codes from V LAB file
-"RTN","C0CVOBX1",25,0)
+"RTN","C0CVOBX1",39,0)
  I $D(^AUPNVLAB) D TMPCHK^C0CLA7Q
-"RTN","C0CVOBX1",26,0)
- ;
-"RTN","C0CVOBX1",27,0)
+"RTN","C0CVOBX1",40,0)
+ ;
+"RTN","C0CVOBX1",41,0)
  I $P(LA7X,"!",2)=""!($P(LA7X,"!",3)="") S $P(LA7VAL,"^",3)=$$DEFCODE^LA7VHLU5(LRSS,LRSB,LA7X,$P(LA76304(0),"^",5))
-"RTN","C0CVOBX1",28,0)
+"RTN","C0CVOBX1",42,0)
  ; No result NLT code - log error
-"RTN","C0CVOBX1",29,0)
+"RTN","C0CVOBX1",43,0)
  I $P($P(LA7VAL,"^",3),"!",2)="" D
-"RTN","C0CVOBX1",30,0)
+"RTN","C0CVOBX1",44,0)
  . N LA7X
-"RTN","C0CVOBX1",31,0)
+"RTN","C0CVOBX1",45,0)
  . S LA7X="["_LRSB_"]"_$$GET1^DID(63.04,LRSB,"","LABEL")
-"RTN","C0CVOBX1",32,0)
+"RTN","C0CVOBX1",46,0)
  . D CREATE^LA7LOG(36)
-"RTN","C0CVOBX1",33,0)
- ;
-"RTN","C0CVOBX1",34,0)
+"RTN","C0CVOBX1",47,0)
+ ;
+"RTN","C0CVOBX1",48,0)
  ; something missing - No NLT code, etc.
-"RTN","C0CVOBX1",35,0)
+"RTN","C0CVOBX1",49,0)
  I LA7VAL="" Q
-"RTN","C0CVOBX1",36,0)
- ;
-"RTN","C0CVOBX1",37,0)
+"RTN","C0CVOBX1",50,0)
+ ;
+"RTN","C0CVOBX1",51,0)
  ; Check for missing units/reference ranges
-"RTN","C0CVOBX1",38,0)
+"RTN","C0CVOBX1",52,0)
  S LA7X=$P(LA7VAL,"^",5)
-"RTN","C0CVOBX1",39,0)
- ;
-"RTN","C0CVOBX1",40,0)
+"RTN","C0CVOBX1",53,0)
+ ;
+"RTN","C0CVOBX1",54,0)
  ; Results missing units, lookup in file #60
-"RTN","C0CVOBX1",41,0)
+"RTN","C0CVOBX1",55,0)
  I $P(LA7X,"!",7)="" S $P(LA7X,"!",7)=$P($$REFUNIT^LA7VHLU1(LRSB,$P(LA76304(0),"^",5)),"^",3)
-"RTN","C0CVOBX1",42,0)
- ;
-"RTN","C0CVOBX1",43,0)
+"RTN","C0CVOBX1",56,0)
+ ;
+"RTN","C0CVOBX1",57,0)
  ; If results missing reference ranges, use values from file #60.
-"RTN","C0CVOBX1",44,0)
+"RTN","C0CVOBX1",58,0)
  I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="",$P(LA7X,"!",11)="",$P(LA7X,"!",12)="" D
-"RTN","C0CVOBX1",45,0)
+"RTN","C0CVOBX1",59,0)
  . S LA7Y=$$REFUNIT^LA7VHLU1(LRSB,$P(LA76304(0),"^",5))
-"RTN","C0CVOBX1",46,0)
+"RTN","C0CVOBX1",60,0)
  . S $P(LA7X,"!",2)=$P(LA7Y,"^")
-"RTN","C0CVOBX1",47,0)
+"RTN","C0CVOBX1",61,0)
  . S $P(LA7X,"!",3)=$P(LA7Y,"^",2)
-"RTN","C0CVOBX1",48,0)
+"RTN","C0CVOBX1",62,0)
  . S $P(LA7X,"!",11)=$P(LA7Y,"^",6)
-"RTN","C0CVOBX1",49,0)
+"RTN","C0CVOBX1",63,0)
  . S $P(LA7X,"!",12)=$P(LA7Y,"^",7)
-"RTN","C0CVOBX1",50,0)
+"RTN","C0CVOBX1",64,0)
  ; Use therapeutic low/high if low/high missing.
-"RTN","C0CVOBX1",51,0)
+"RTN","C0CVOBX1",65,0)
  I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="" D
-"RTN","C0CVOBX1",52,0)
+"RTN","C0CVOBX1",66,0)
  . S $P(LA7X,"!",2)=$P(LA7X,"!",11)
-"RTN","C0CVOBX1",53,0)
+"RTN","C0CVOBX1",67,0)
  . S $P(LA7X,"!",3)=$P(LA7X,"!",12)
-"RTN","C0CVOBX1",54,0)
- ;
-"RTN","C0CVOBX1",55,0)
+"RTN","C0CVOBX1",68,0)
+ ;
+"RTN","C0CVOBX1",69,0)
  ; Evaluate low/high reference ranges in case M code in these fields.
-"RTN","C0CVOBX1",56,0)
+"RTN","C0CVOBX1",70,0)
  S:$G(SEX)="" SEX="M" S:$G(AGE)="" AGE=99
-"RTN","C0CVOBX1",57,0)
+"RTN","C0CVOBX1",71,0)
  F LA7I=2,3 I $E($P(LA7X,"!",LA7I),1,3)="$S(" D
-"RTN","C0CVOBX1",58,0)
+"RTN","C0CVOBX1",72,0)
  . S @("X="_$P(LA7X,"!",LA7I))
-"RTN","C0CVOBX1",59,0)
+"RTN","C0CVOBX1",73,0)
  . S $P(LA7X,"!",LA7I)=X
-"RTN","C0CVOBX1",60,0)
- ;
-"RTN","C0CVOBX1",61,0)
+"RTN","C0CVOBX1",74,0)
+ ;
+"RTN","C0CVOBX1",75,0)
  ; Put units/reference ranges back in variable LA7VAL
-"RTN","C0CVOBX1",62,0)
+"RTN","C0CVOBX1",76,0)
  S $P(LA7VAL,"^",5)=LA7X
-"RTN","C0CVOBX1",63,0)
- ;
-"RTN","C0CVOBX1",64,0)
+"RTN","C0CVOBX1",77,0)
+ ;
+"RTN","C0CVOBX1",78,0)
  ; Initialize OBX segment
-"RTN","C0CVOBX1",65,0)
+"RTN","C0CVOBX1",79,0)
  S LA7OBX(0)="OBX"
-"RTN","C0CVOBX1",66,0)
+"RTN","C0CVOBX1",80,0)
  S LA7OBX(1)=$$OBX1^LA7VOBX(.LA7OBXSN)
-"RTN","C0CVOBX1",67,0)
- ;
-"RTN","C0CVOBX1",68,0)
+"RTN","C0CVOBX1",81,0)
+ ;
+"RTN","C0CVOBX1",82,0)
  ; Value type
-"RTN","C0CVOBX1",69,0)
+"RTN","C0CVOBX1",83,0)
  S LA7OBX(2)=$$OBX2^LA7VOBX(63.04,LRSB)
-"RTN","C0CVOBX1",70,0)
- ;
-"RTN","C0CVOBX1",71,0)
+"RTN","C0CVOBX1",84,0)
+ ;
+"RTN","C0CVOBX1",85,0)
  ; Observation identifer
-"RTN","C0CVOBX1",72,0)
+"RTN","C0CVOBX1",86,0)
  ; build alternate code based on dataname from file #63 in case it's needed
-"RTN","C0CVOBX1",73,0)
+"RTN","C0CVOBX1",87,0)
  S LA7X=$P(LA7VAL,"^",3)
-"RTN","C0CVOBX1",74,0)
+"RTN","C0CVOBX1",88,0)
  S LA7ALT="CH"_LRSB_"^"_$$GET1^DID(63.04,LRSB,"","LABEL")_"^"_"99VA63"
-"RTN","C0CVOBX1",75,0)
+"RTN","C0CVOBX1",89,0)
  S LA7OBX(3)=$$OBX3^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7ALT,LA7FS,LA7ECH)
-"RTN","C0CVOBX1",76,0)
- ;
-"RTN","C0CVOBX1",77,0)
+"RTN","C0CVOBX1",90,0)
+ ;
+"RTN","C0CVOBX1",91,0)
  ; Test value
-"RTN","C0CVOBX1",78,0)
+"RTN","C0CVOBX1",92,0)
  S LA7OBX(5)=$$OBX5^LA7VOBX($P(LA7VAL,"^"),LA7OBX(2),LA7FS,LA7ECH)
-"RTN","C0CVOBX1",79,0)
- ;
-"RTN","C0CVOBX1",80,0)
+"RTN","C0CVOBX1",93,0)
+ ;
+"RTN","C0CVOBX1",94,0)
  ; Units - remove leading and trailing spaces
-"RTN","C0CVOBX1",81,0)
+"RTN","C0CVOBX1",95,0)
  S LA7X=$P(LA7VAL,"^",5),LA7X=$$TRIM^XLFSTR(LA7X,"LR"," ")
-"RTN","C0CVOBX1",82,0)
+"RTN","C0CVOBX1",96,0)
  S LA7OBX(6)=$$OBX6^LA7VOBX($P(LA7X,"!",7),"",LA7FS,LA7ECH)
-"RTN","C0CVOBX1",83,0)
- ;
-"RTN","C0CVOBX1",84,0)
+"RTN","C0CVOBX1",97,0)
+ ;
+"RTN","C0CVOBX1",98,0)
  ; Reference range
-"RTN","C0CVOBX1",85,0)
+"RTN","C0CVOBX1",99,0)
  S LA7OBX(7)=$$OBX7^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7FS,LA7ECH)
-"RTN","C0CVOBX1",86,0)
- ;
-"RTN","C0CVOBX1",87,0)
+"RTN","C0CVOBX1",100,0)
+ ;
+"RTN","C0CVOBX1",101,0)
  ; Abnormal flags
-"RTN","C0CVOBX1",88,0)
+"RTN","C0CVOBX1",102,0)
  S LA7OBX(8)=$$OBX8^LA7VOBX($P(LA7VAL,U,2))
-"RTN","C0CVOBX1",89,0)
- ;
-"RTN","C0CVOBX1",90,0)
+"RTN","C0CVOBX1",103,0)
+ ;
+"RTN","C0CVOBX1",104,0)
  ; "P"artial or "F"inal results
-"RTN","C0CVOBX1",91,0)
+"RTN","C0CVOBX1",105,0)
  S LA7OBX(11)=$$OBX11^LA7VOBX($S("canccommentpending"[$P(LA7VAL,"^"):$P(LA7VAL,"^"),1:"F"))
-"RTN","C0CVOBX1",92,0)
- ;
-"RTN","C0CVOBX1",93,0)
+"RTN","C0CVOBX1",106,0)
+ ;
+"RTN","C0CVOBX1",107,0)
  ; Observation date/time - collection date/time per HL7 standard
-"RTN","C0CVOBX1",94,0)
+"RTN","C0CVOBX1",108,0)
  I $P(LA76304(0),"^") S LA7OBX(14)=$$OBX14^LA7VOBX($P(LA76304(0),"^"))
-"RTN","C0CVOBX1",95,0)
- ;
-"RTN","C0CVOBX1",96,0)
+"RTN","C0CVOBX1",109,0)
+ ;
+"RTN","C0CVOBX1",110,0)
  S LA7DIV=$P(LA7VAL,"^",9)
-"RTN","C0CVOBX1",97,0)
+"RTN","C0CVOBX1",111,0)
  I LA7DIV="",$$DIV4^XUSER(.LA7DIV,$P(LA7VAL,"^",4)) S LA7DIV=$O(LA7DIV(0))
-"RTN","C0CVOBX1",98,0)
- ;
-"RTN","C0CVOBX1",99,0)
+"RTN","C0CVOBX1",112,0)
+ ;
+"RTN","C0CVOBX1",113,0)
  ; Facility that performed the testing
-"RTN","C0CVOBX1",100,0)
+"RTN","C0CVOBX1",114,0)
  S LA7OBX(15)=$$OBX15^LA7VOBX(LA7DIV,LA7FS,LA7ECH)
-"RTN","C0CVOBX1",101,0)
- ;
-"RTN","C0CVOBX1",102,0)
+"RTN","C0CVOBX1",115,0)
+ ;
+"RTN","C0CVOBX1",116,0)
  ; Person that verified the test
-"RTN","C0CVOBX1",103,0)
+"RTN","C0CVOBX1",117,0)
  S LA7OBX(16)=$$OBX16^LA7VOBX($P(LA7VAL,"^",4),LA7DIV,LA7FS,LA7ECH)
-"RTN","C0CVOBX1",104,0)
- ;
-"RTN","C0CVOBX1",105,0)
+"RTN","C0CVOBX1",118,0)
+ ;
+"RTN","C0CVOBX1",119,0)
  ; Observation method
-"RTN","C0CVOBX1",106,0)
+"RTN","C0CVOBX1",120,0)
  S LA7X=$P($P(LA7VAL,"^",3),"!",4)
-"RTN","C0CVOBX1",107,0)
+"RTN","C0CVOBX1",121,0)
  I LA7X S LA7OBX(17)=$$OBX17^LA7VOBX(LA7X,LA7FS,LA7ECH)
-"RTN","C0CVOBX1",108,0)
- ;
-"RTN","C0CVOBX1",109,0)
+"RTN","C0CVOBX1",122,0)
+ ;
+"RTN","C0CVOBX1",123,0)
  ; Equipment entity identifier
-"RTN","C0CVOBX1",110,0)
+"RTN","C0CVOBX1",124,0)
  I $L($P(LA7VAL,"^",11)) S LA7OBX(18)=$$OBX18^LA7VOBX($P(LA7VAL,"^",11),LA7FS,LA7ECH)
-"RTN","C0CVOBX1",111,0)
- ;
-"RTN","C0CVOBX1",112,0)
+"RTN","C0CVOBX1",125,0)
+ ;
+"RTN","C0CVOBX1",126,0)
  D BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS)
-"RTN","C0CVOBX1",113,0)
- ;
-"RTN","C0CVOBX1",114,0)
+"RTN","C0CVOBX1",127,0)
+ ;
+"RTN","C0CVOBX1",128,0)
  Q
 "RTN","C0CVORU")
-0^100^B58596883
+0^100^B63096791
 "RTN","C0CVORU",1,0)
 C0C7VORU ;WV/JMC - Builder of HL7 Lab Results OBR/OBX/NTE based on RPMS V LAB file ;Jun 16, 2009 ; 5/10/12 5:19pm
 "RTN","C0CVORU",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CVORU",3,0)
  ;
 "RTN","C0CVORU",4,0)
+ ; (C) 2009 John McCormack
+"RTN","C0CVORU",5,0)
+ ; This program is free software: you can redistribute it and/or modify
+"RTN","C0CVORU",6,0)
+ ; it under the terms of the GNU Affero General Public License as
+"RTN","C0CVORU",7,0)
+ ; published by the Free Software Foundation, either version 3 of the
+"RTN","C0CVORU",8,0)
+ ; License, or (at your option) any later version.
+"RTN","C0CVORU",9,0)
+ ;
+"RTN","C0CVORU",10,0)
+ ; This program is distributed in the hope that it will be useful,
+"RTN","C0CVORU",11,0)
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","C0CVORU",12,0)
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","C0CVORU",13,0)
+ ; GNU Affero General Public License for more details.
+"RTN","C0CVORU",14,0)
+ ;
+"RTN","C0CVORU",15,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CVORU",16,0)
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+"RTN","C0CVORU",17,0)
+ ;
+"RTN","C0CVORU",18,0)
 EN(LA) ; called from C0CVLAB
-"RTN","C0CVORU",5,0)
+"RTN","C0CVORU",19,0)
  ; variables
-"RTN","C0CVORU",6,0)
+"RTN","C0CVORU",20,0)
  ; LA("HUID") - Host Unique ID from the local ACCESSION file (#68)
-"RTN","C0CVORU",7,0)
+"RTN","C0CVORU",21,0)
  ; LA("SITE") - Ordering site IEN in the INSTITUTION file (#4)
-"RTN","C0CVORU",8,0)
+"RTN","C0CVORU",22,0)
  ; LA("RUID") - Remote sites Unique ID from ACCESSION file (#68)
-"RTN","C0CVORU",9,0)
+"RTN","C0CVORU",23,0)
  ; LA("ORD") - Free text ordered test name from WKLD CODE file (#64)
-"RTN","C0CVORU",10,0)
+"RTN","C0CVORU",24,0)
  ; LA("NLT") - National Laboratory test code from WKLD CODE file (#64)
-"RTN","C0CVORU",11,0)
+"RTN","C0CVORU",25,0)
  ; LA("LRIDT") - Inverse date/time the lab arrival time (accession date/time)
-"RTN","C0CVORU",12,0)
+"RTN","C0CVORU",26,0)
  ; LA("SUB") - test subscript defined in LABORATORY TEST file (#60)
-"RTN","C0CVORU",13,0)
+"RTN","C0CVORU",27,0)
  ; LA("LRDFN") - IEN in LAB DATA file (#63)
-"RTN","C0CVORU",14,0)
+"RTN","C0CVORU",28,0)
  ; LA("ORD"), LA("NLT"), and LA("SUB") are sent for specific lab results.
-"RTN","C0CVORU",15,0)
+"RTN","C0CVORU",29,0)
  ; LA("AUTO-INST") - Auto-Instrument
-"RTN","C0CVORU",16,0)
- ;
-"RTN","C0CVORU",17,0)
+"RTN","C0CVORU",30,0)
+ ;
+"RTN","C0CVORU",31,0)
  N LA763,LA7NLT,LA7NVAF,LA7X,PRIMARY
-"RTN","C0CVORU",18,0)
- ;
-"RTN","C0CVORU",19,0)
+"RTN","C0CVORU",32,0)
+ ;
+"RTN","C0CVORU",33,0)
  S PRIMARY=$$PRIM^VASITE(DT),LA("AUTO-INST")=""
-"RTN","C0CVORU",20,0)
+"RTN","C0CVORU",34,0)
  I $G(PRIMARY)'="" D
-"RTN","C0CVORU",21,0)
+"RTN","C0CVORU",35,0)
  . S PRIMARY=$$SITE^VASITE(DT,PRIMARY)
-"RTN","C0CVORU",22,0)
+"RTN","C0CVORU",36,0)
  . S PRIMARY=$P(PRIMARY,U,3)
-"RTN","C0CVORU",23,0)
+"RTN","C0CVORU",37,0)
  . S LA("AUTO-INST")="LA7V HOST "_PRIMARY
-"RTN","C0CVORU",24,0)
- ;
-"RTN","C0CVORU",25,0)
+"RTN","C0CVORU",38,0)
+ ;
+"RTN","C0CVORU",39,0)
  I '$O(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0)) D  Q
-"RTN","C0CVORU",26,0)
+"RTN","C0CVORU",40,0)
  . ; need to add error logging when no entry in 63.
-"RTN","C0CVORU",27,0)
- ;
-"RTN","C0CVORU",28,0)
+"RTN","C0CVORU",41,0)
+ ;
+"RTN","C0CVORU",42,0)
  ; Get zeroth node of entry in #63.
-"RTN","C0CVORU",29,0)
+"RTN","C0CVORU",43,0)
  S LA763(0)=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0))
-"RTN","C0CVORU",30,0)
+"RTN","C0CVORU",44,0)
  S LA7NLT=$G(LA("NLT"))
-"RTN","C0CVORU",31,0)
- ;
-"RTN","C0CVORU",32,0)
+"RTN","C0CVORU",45,0)
+ ;
+"RTN","C0CVORU",46,0)
  S LA7NVAF=$$NVAF^LA7VHLU2(+LA("SITE"))
-"RTN","C0CVORU",33,0)
+"RTN","C0CVORU",47,0)
  S LA7NTESN=0
-"RTN","C0CVORU",34,0)
+"RTN","C0CVORU",48,0)
  D ORC
-"RTN","C0CVORU",35,0)
- ;
-"RTN","C0CVORU",36,0)
+"RTN","C0CVORU",49,0)
+ ;
+"RTN","C0CVORU",50,0)
  I $G(LA("SUB"))="CH" D CH
-"RTN","C0CVORU",37,0)
+"RTN","C0CVORU",51,0)
  ;I $G(LA("SUB"))="MI" D MI^LA7VORU1
-"RTN","C0CVORU",38,0)
+"RTN","C0CVORU",52,0)
  ;I "SPCYEM"[$G(LA("SUB")) D AP^LA7VORU2
-"RTN","C0CVORU",39,0)
+"RTN","C0CVORU",53,0)
  Q
-"RTN","C0CVORU",40,0)
- ;
-"RTN","C0CVORU",41,0)
- ;
-"RTN","C0CVORU",42,0)
+"RTN","C0CVORU",54,0)
+ ;
+"RTN","C0CVORU",55,0)
+ ;
+"RTN","C0CVORU",56,0)
 CH ; Build segments for "CH" subscript
-"RTN","C0CVORU",43,0)
- ;
-"RTN","C0CVORU",44,0)
+"RTN","C0CVORU",57,0)
+ ;
+"RTN","C0CVORU",58,0)
  D OBR
-"RTN","C0CVORU",45,0)
+"RTN","C0CVORU",59,0)
  D NTE
-"RTN","C0CVORU",46,0)
+"RTN","C0CVORU",60,0)
  S LA7OBXSN=0
-"RTN","C0CVORU",47,0)
+"RTN","C0CVORU",61,0)
  D OBX
-"RTN","C0CVORU",48,0)
- ;
-"RTN","C0CVORU",49,0)
+"RTN","C0CVORU",62,0)
+ ;
+"RTN","C0CVORU",63,0)
  Q
-"RTN","C0CVORU",50,0)
- ;
-"RTN","C0CVORU",51,0)
- ;
-"RTN","C0CVORU",52,0)
+"RTN","C0CVORU",64,0)
+ ;
+"RTN","C0CVORU",65,0)
+ ;
+"RTN","C0CVORU",66,0)
 ORC ; Build ORC segment
-"RTN","C0CVORU",53,0)
- ;
-"RTN","C0CVORU",54,0)
+"RTN","C0CVORU",67,0)
+ ;
+"RTN","C0CVORU",68,0)
  N LA763,LA7696,LA7DATA,LA7SM,LA7X,LA7Y,ORC
-"RTN","C0CVORU",55,0)
- ;
-"RTN","C0CVORU",56,0)
+"RTN","C0CVORU",69,0)
+ ;
+"RTN","C0CVORU",70,0)
  S LA763(0)=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0))
-"RTN","C0CVORU",57,0)
- ;
-"RTN","C0CVORU",58,0)
+"RTN","C0CVORU",71,0)
+ ;
+"RTN","C0CVORU",72,0)
  S ORC(0)="ORC"
-"RTN","C0CVORU",59,0)
- ;
-"RTN","C0CVORU",60,0)
+"RTN","C0CVORU",73,0)
+ ;
+"RTN","C0CVORU",74,0)
  ; Order control
-"RTN","C0CVORU",61,0)
+"RTN","C0CVORU",75,0)
  S ORC(1)=$$ORC1^LA7VORC("RE")
-"RTN","C0CVORU",62,0)
- ;
-"RTN","C0CVORU",63,0)
+"RTN","C0CVORU",76,0)
+ ;
+"RTN","C0CVORU",77,0)
  ; Remote UID
-"RTN","C0CVORU",64,0)
+"RTN","C0CVORU",78,0)
  S ORC(2)=$$ORC2^LA7VORC(LA("RUID"),LA7FS,LA7ECH)
-"RTN","C0CVORU",65,0)
- ;
-"RTN","C0CVORU",66,0)
+"RTN","C0CVORU",79,0)
+ ;
+"RTN","C0CVORU",80,0)
  ; Host UID
-"RTN","C0CVORU",67,0)
+"RTN","C0CVORU",81,0)
  S ORC(3)=$$ORC3^LA7VORC(LA("HUID"),LA7FS,LA7ECH)
-"RTN","C0CVORU",68,0)
- ;
-"RTN","C0CVORU",69,0)
+"RTN","C0CVORU",82,0)
+ ;
+"RTN","C0CVORU",83,0)
  ; Return shipping manifest if found
-"RTN","C0CVORU",70,0)
+"RTN","C0CVORU",84,0)
  S LA7SM="",LA7696=0
-"RTN","C0CVORU",71,0)
+"RTN","C0CVORU",85,0)
  I LA("SITE")'="",LA("RUID")'="" S LA7696=$O(^LRO(69.6,"RST",LA("SITE"),LA("RUID"),0))
-"RTN","C0CVORU",72,0)
+"RTN","C0CVORU",86,0)
  I LA7696 S LA7SM=$P($G(^LRO(69.6,LA7696,0)),U,14)
-"RTN","C0CVORU",73,0)
+"RTN","C0CVORU",87,0)
  I LA7SM'="" S ORC(4)=$$ORC4^LA7VORC(LA7SM,LA7FS,LA7ECH)
-"RTN","C0CVORU",74,0)
- ;
-"RTN","C0CVORU",75,0)
+"RTN","C0CVORU",88,0)
+ ;
+"RTN","C0CVORU",89,0)
  ; Order status
-"RTN","C0CVORU",76,0)
+"RTN","C0CVORU",90,0)
  ; DoD/CHCS requires ORC-5 valued otherwise will not process message
-"RTN","C0CVORU",77,0)
+"RTN","C0CVORU",91,0)
  I LA7NVAF=1 S ORC(5)=$$ORC5^LA7VORC("CM",LA7FS,LA7ECH)
-"RTN","C0CVORU",78,0)
- ;
-"RTN","C0CVORU",79,0)
+"RTN","C0CVORU",92,0)
+ ;
+"RTN","C0CVORU",93,0)
  ; Ordering provider
-"RTN","C0CVORU",80,0)
+"RTN","C0CVORU",94,0)
  S (LA7X,LA7Y)=""
-"RTN","C0CVORU",81,0)
+"RTN","C0CVORU",95,0)
  ; "CH" subscript stores requesting provider and requesting div/location.
-"RTN","C0CVORU",82,0)
+"RTN","C0CVORU",96,0)
  I LA("SUB")="CH" D
-"RTN","C0CVORU",83,0)
+"RTN","C0CVORU",97,0)
  . N LA7J
-"RTN","C0CVORU",84,0)
+"RTN","C0CVORU",98,0)
  . S LA7J=$P(LA763(0),"^",13)
-"RTN","C0CVORU",85,0)
+"RTN","C0CVORU",99,0)
  . I $P(LA7J,";",2)="SC(" S LA7Y=$$GET1^DIQ(44,$P(LA7J,";")_",",3,"I")
-"RTN","C0CVORU",86,0)
+"RTN","C0CVORU",100,0)
  . I $P(LA7J,";",2)="DIC(4," S LA7Y=$P(LA7J,";")
-"RTN","C0CVORU",87,0)
+"RTN","C0CVORU",101,0)
  . S LA7X=$P(LA763(0),"^",10)
-"RTN","C0CVORU",88,0)
- ;
-"RTN","C0CVORU",89,0)
+"RTN","C0CVORU",102,0)
+ ;
+"RTN","C0CVORU",103,0)
  ; Other subscripts only store requesting provider
-"RTN","C0CVORU",90,0)
+"RTN","C0CVORU",104,0)
  I "CYEMMISP"[LA("SUB") S LA7X=$P(LA763(0),"^",7)
-"RTN","C0CVORU",91,0)
+"RTN","C0CVORU",105,0)
  ; Get default institution from MailMan Site Parameters file
-"RTN","C0CVORU",92,0)
+"RTN","C0CVORU",106,0)
  I LA7Y="" S LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
-"RTN","C0CVORU",93,0)
+"RTN","C0CVORU",107,0)
  S ORC(12)=$$ORC12^LA7VORC(LA7X,LA7Y,LA7FS,LA7ECH)
-"RTN","C0CVORU",94,0)
- ;
-"RTN","C0CVORU",95,0)
+"RTN","C0CVORU",108,0)
+ ;
+"RTN","C0CVORU",109,0)
  ; Entering organization
-"RTN","C0CVORU",96,0)
+"RTN","C0CVORU",110,0)
  S ORC(17)=$$ORC17^LA7VORC(LA7Y,LA7FS,LA7ECH)
-"RTN","C0CVORU",97,0)
- ;
-"RTN","C0CVORU",98,0)
+"RTN","C0CVORU",111,0)
+ ;
+"RTN","C0CVORU",112,0)
  D BUILDSEG^LA7VHLU(.ORC,.LA7DATA,LA7FS)
-"RTN","C0CVORU",99,0)
+"RTN","C0CVORU",113,0)
  D FILESEG^LA7VHLU(GBL,.LA7DATA)
-"RTN","C0CVORU",100,0)
- ;
-"RTN","C0CVORU",101,0)
+"RTN","C0CVORU",114,0)
+ ;
+"RTN","C0CVORU",115,0)
  ; Check for flag to only build message but do not file
-"RTN","C0CVORU",102,0)
+"RTN","C0CVORU",116,0)
  I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249P,.LA7DATA)
-"RTN","C0CVORU",103,0)
- ;
-"RTN","C0CVORU",104,0)
+"RTN","C0CVORU",117,0)
+ ;
+"RTN","C0CVORU",118,0)
  Q
-"RTN","C0CVORU",105,0)
- ;
-"RTN","C0CVORU",106,0)
- ;
-"RTN","C0CVORU",107,0)
+"RTN","C0CVORU",119,0)
+ ;
+"RTN","C0CVORU",120,0)
+ ;
+"RTN","C0CVORU",121,0)
 OBR ;Observation Request segment for Lab Order
-"RTN","C0CVORU",108,0)
- ;
-"RTN","C0CVORU",109,0)
+"RTN","C0CVORU",122,0)
+ ;
+"RTN","C0CVORU",123,0)
  N LA761,LA762,LA7DATA,LA7PLOBR,LA7X,LA7Y,OBR
-"RTN","C0CVORU",110,0)
- ;
-"RTN","C0CVORU",111,0)
+"RTN","C0CVORU",124,0)
+ ;
+"RTN","C0CVORU",125,0)
  ; Retrieve placer's OBR information stored in #69.6
-"RTN","C0CVORU",112,0)
+"RTN","C0CVORU",126,0)
  D RETOBR^LA7VHLU(LA("SITE"),LA("RUID"),LA("NLT"),.LA7PLOBR)
-"RTN","C0CVORU",113,0)
- ;
-"RTN","C0CVORU",114,0)
+"RTN","C0CVORU",127,0)
+ ;
+"RTN","C0CVORU",128,0)
  ; Initialize OBR segment
-"RTN","C0CVORU",115,0)
+"RTN","C0CVORU",129,0)
  S OBR(0)="OBR"
-"RTN","C0CVORU",116,0)
+"RTN","C0CVORU",130,0)
  S OBR(1)=$$OBR1^LA7VOBR(.LA7OBRSN)
-"RTN","C0CVORU",117,0)
- ;
-"RTN","C0CVORU",118,0)
+"RTN","C0CVORU",131,0)
+ ;
+"RTN","C0CVORU",132,0)
  ; Remote UID
-"RTN","C0CVORU",119,0)
+"RTN","C0CVORU",133,0)
  S OBR(2)=$$OBR2^LA7VOBR(LA("RUID"),LA7FS,LA7ECH)
-"RTN","C0CVORU",120,0)
- ;
-"RTN","C0CVORU",121,0)
+"RTN","C0CVORU",134,0)
+ ;
+"RTN","C0CVORU",135,0)
  ; Host UID
-"RTN","C0CVORU",122,0)
+"RTN","C0CVORU",136,0)
  S OBR(3)=$$OBR3^LA7VOBR(LA("HUID"),LA7FS,LA7ECH)
-"RTN","C0CVORU",123,0)
- ;
-"RTN","C0CVORU",124,0)
+"RTN","C0CVORU",137,0)
+ ;
+"RTN","C0CVORU",138,0)
  ; Universal service ID, build from info stored in #69.6
-"RTN","C0CVORU",125,0)
+"RTN","C0CVORU",139,0)
  S LA7X=""
-"RTN","C0CVORU",126,0)
+"RTN","C0CVORU",140,0)
  I $G(LA7PLOBR("OBR-4"))'="" S OBR(4)=$$CNVFLD^LA7VHLU3(LA7PLOBR("OBR-4"),LA7PLOBR("ECH"),LA7ECH)
-"RTN","C0CVORU",127,0)
+"RTN","C0CVORU",141,0)
  E  S OBR(4)=$$OBR4^LA7VOBR(LA7NLT,"",LA7X,LA7FS,LA7ECH)
-"RTN","C0CVORU",128,0)
- ;
-"RTN","C0CVORU",129,0)
+"RTN","C0CVORU",142,0)
+ ;
+"RTN","C0CVORU",143,0)
  ; Collection D/T
-"RTN","C0CVORU",130,0)
+"RTN","C0CVORU",144,0)
  S OBR(7)=$$OBR7^LA7VOBR($P(LA763(0),U))
-"RTN","C0CVORU",131,0)
- ;
-"RTN","C0CVORU",132,0)
+"RTN","C0CVORU",145,0)
+ ;
+"RTN","C0CVORU",146,0)
  ; Specimen action code
-"RTN","C0CVORU",133,0)
+"RTN","C0CVORU",147,0)
  ; If no OBR from PENDING ORDER file (#69.6) then assume added test.
-"RTN","C0CVORU",134,0)
+"RTN","C0CVORU",148,0)
  I $G(LA7INTYP)=10,$G(LA7PLOBR("OBR-4"))="" S OBR(11)=$$OBR11^LA7VOBR("A")
-"RTN","C0CVORU",135,0)
- ;
-"RTN","C0CVORU",136,0)
+"RTN","C0CVORU",149,0)
+ ;
+"RTN","C0CVORU",150,0)
  ; Infection Warning
-"RTN","C0CVORU",137,0)
+"RTN","C0CVORU",151,0)
  S OBR(12)=$$OBR12^LA7VOBR(LRDFN,LA7FS,LA7ECH)
-"RTN","C0CVORU",138,0)
- ;
-"RTN","C0CVORU",139,0)
+"RTN","C0CVORU",152,0)
+ ;
+"RTN","C0CVORU",153,0)
  ; Lab Arrival Time
-"RTN","C0CVORU",140,0)
+"RTN","C0CVORU",154,0)
  ; "CH" subscript does not store lab arrival time, use collection time.
-"RTN","C0CVORU",141,0)
+"RTN","C0CVORU",155,0)
  ; Other subscripts do store lab arrival time (date/time received).
-"RTN","C0CVORU",142,0)
+"RTN","C0CVORU",156,0)
  I "CYEMMISP"[LA("SUB") S OBR(14)=$$OBR14^LA7VOBR($P(LA763(0),"^",10))
-"RTN","C0CVORU",143,0)
+"RTN","C0CVORU",157,0)
  I LA("SUB")="CH" S OBR(14)=$$OBR14^LA7VOBR($P(LA763(0),"^"))
-"RTN","C0CVORU",144,0)
- ;
-"RTN","C0CVORU",145,0)
+"RTN","C0CVORU",158,0)
+ ;
+"RTN","C0CVORU",159,0)
  ; Specimen source 
-"RTN","C0CVORU",146,0)
+"RTN","C0CVORU",160,0)
  S (LA761,LA762)=""
-"RTN","C0CVORU",147,0)
+"RTN","C0CVORU",161,0)
  I "CHMI"[LA("SUB") D
-"RTN","C0CVORU",148,0)
+"RTN","C0CVORU",162,0)
  . S LA761=$P(LA763(0),U,5)
-"RTN","C0CVORU",149,0)
+"RTN","C0CVORU",163,0)
  . I LA761="" D CREATE^LA7LOG(27)
-"RTN","C0CVORU",150,0)
+"RTN","C0CVORU",164,0)
  . I LA("SUB")="MI" S LA762=$P(LA763(0),U,11)
-"RTN","C0CVORU",151,0)
+"RTN","C0CVORU",165,0)
  S OBR(15)=$$OBR15^LA7VOBR(LA761,LA762,"",LA7FS,LA7ECH)
-"RTN","C0CVORU",152,0)
- ;
-"RTN","C0CVORU",153,0)
+"RTN","C0CVORU",166,0)
+ ;
+"RTN","C0CVORU",167,0)
  ; Ordering provider
-"RTN","C0CVORU",154,0)
+"RTN","C0CVORU",168,0)
  S (LA7X,LA7Y)=""
-"RTN","C0CVORU",155,0)
+"RTN","C0CVORU",169,0)
  ; "CH" subscript stores requesting provider and requesting div/location.
-"RTN","C0CVORU",156,0)
+"RTN","C0CVORU",170,0)
  I LA("SUB")="CH" D
-"RTN","C0CVORU",157,0)
+"RTN","C0CVORU",171,0)
  . N LA7J
-"RTN","C0CVORU",158,0)
+"RTN","C0CVORU",172,0)
  . S LA7J=$P(LA763(0),"^",13)
-"RTN","C0CVORU",159,0)
+"RTN","C0CVORU",173,0)
  . I $P(LA7J,";",2)="SC(" S LA7Y=$$GET1^DIQ(44,$P(LA7J,";")_",",3,"I")
-"RTN","C0CVORU",160,0)
+"RTN","C0CVORU",174,0)
  . I $P(LA7J,";",2)="DIC(4," S LA7Y=$P(LA7J,";")
-"RTN","C0CVORU",161,0)
+"RTN","C0CVORU",175,0)
  . S LA7X=$P(LA763(0),"^",10)
-"RTN","C0CVORU",162,0)
- ;
-"RTN","C0CVORU",163,0)
+"RTN","C0CVORU",176,0)
+ ;
+"RTN","C0CVORU",177,0)
  ; Other subscripts only store requesting provider
-"RTN","C0CVORU",164,0)
+"RTN","C0CVORU",178,0)
  I "CYEMMISP"[LA("SUB") S LA7X=$P(LA763(0),"^",7)
-"RTN","C0CVORU",165,0)
+"RTN","C0CVORU",179,0)
  ; Get default institution from MailMan Site Parameters file
-"RTN","C0CVORU",166,0)
+"RTN","C0CVORU",180,0)
  I LA7Y="" S LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
-"RTN","C0CVORU",167,0)
+"RTN","C0CVORU",181,0)
  S OBR(16)=$$ORC12^LA7VORC(LA7X,LA7Y,LA7FS,LA7ECH)
-"RTN","C0CVORU",168,0)
- ;
-"RTN","C0CVORU",169,0)
+"RTN","C0CVORU",182,0)
+ ;
+"RTN","C0CVORU",183,0)
  ; Placer Field #1 (remote auto-inst)
-"RTN","C0CVORU",170,0)
+"RTN","C0CVORU",184,0)
  ; Build from info stored in #69.6
-"RTN","C0CVORU",171,0)
+"RTN","C0CVORU",185,0)
  I $G(LA7PLOBR("OBR-18"))'="" D
-"RTN","C0CVORU",172,0)
+"RTN","C0CVORU",186,0)
  . S OBR(18)=$$CHKDATA^LA7VHLU3(LA7PLOBR("OBR-18"),LA7FS_LA7ECH)
-"RTN","C0CVORU",173,0)
+"RTN","C0CVORU",187,0)
  ; Else build "auto instrument" if sending to VA facility
-"RTN","C0CVORU",174,0)
+"RTN","C0CVORU",188,0)
  I $G(LA7PLOBR("OBR-18"))="",'LA7NVAF D
-"RTN","C0CVORU",175,0)
+"RTN","C0CVORU",189,0)
  . N LA7X
-"RTN","C0CVORU",176,0)
+"RTN","C0CVORU",190,0)
  . S LA7X(1)=LA("AUTO-INST")
-"RTN","C0CVORU",177,0)
+"RTN","C0CVORU",191,0)
  . S OBR(18)=$$OBR18^LA7VOBR(.LA7X,LA7FS,LA7ECH)
-"RTN","C0CVORU",178,0)
- ;
-"RTN","C0CVORU",179,0)
+"RTN","C0CVORU",192,0)
+ ;
+"RTN","C0CVORU",193,0)
  ; Placer Field #2
-"RTN","C0CVORU",180,0)
+"RTN","C0CVORU",194,0)
  I $G(LA7PLOBR("OBR-19"))'="" D
-"RTN","C0CVORU",181,0)
+"RTN","C0CVORU",195,0)
  . S OBR(19)=$$CHKDATA^LA7VHLU3(LA7PLOBR("OBR-19"),LA7FS_LA7ECH)
-"RTN","C0CVORU",182,0)
+"RTN","C0CVORU",196,0)
  ; Else build collecting UID if sending to VA facility
-"RTN","C0CVORU",183,0)
+"RTN","C0CVORU",197,0)
  I $G(LA7PLOBR("OBR-19"))="",'LA7NVAF,LA("RUID")'="" D
-"RTN","C0CVORU",184,0)
+"RTN","C0CVORU",198,0)
  . K LA7X
-"RTN","C0CVORU",185,0)
+"RTN","C0CVORU",199,0)
  . S LA7X(7)=LA("RUID")
-"RTN","C0CVORU",186,0)
+"RTN","C0CVORU",200,0)
  . S OBR(19)=$$OBR19^LA7VOBR(.LA7X,LA7FS,LA7ECH)
-"RTN","C0CVORU",187,0)
- ;
-"RTN","C0CVORU",188,0)
+"RTN","C0CVORU",201,0)
+ ;
+"RTN","C0CVORU",202,0)
  ; Filler Field #1
-"RTN","C0CVORU",189,0)
+"RTN","C0CVORU",203,0)
  ; Send file #63 ien info - used by HDR to track patient/specimen
-"RTN","C0CVORU",190,0)
+"RTN","C0CVORU",204,0)
  K LA7X
-"RTN","C0CVORU",191,0)
+"RTN","C0CVORU",205,0)
  S LA7X(1)=LA("LRDFN")
-"RTN","C0CVORU",192,0)
+"RTN","C0CVORU",206,0)
  S LA7X(2)=LA("SUB")
-"RTN","C0CVORU",193,0)
+"RTN","C0CVORU",207,0)
  S LA7X(3)=LA("LRIDT")
-"RTN","C0CVORU",194,0)
+"RTN","C0CVORU",208,0)
  S OBR(20)=$$OBR20^LA7VOBR(.LA7X,LA7FS,LA7ECH)
-"RTN","C0CVORU",195,0)
- ;
-"RTN","C0CVORU",196,0)
+"RTN","C0CVORU",209,0)
+ ;
+"RTN","C0CVORU",210,0)
  ; Date Report Completed
-"RTN","C0CVORU",197,0)
+"RTN","C0CVORU",211,0)
  I $P(LA763(0),"^",3) S OBR(22)=$$OBR22^LA7VOBR($P(LA763(0),"^",3))
-"RTN","C0CVORU",198,0)
- ;
-"RTN","C0CVORU",199,0)
+"RTN","C0CVORU",212,0)
+ ;
+"RTN","C0CVORU",213,0)
  ; Diagnostic service id
-"RTN","C0CVORU",200,0)
+"RTN","C0CVORU",214,0)
  S OBR(24)=$$OBR24^LA7VOBR(LA("SUB")_"^"_$G(LRSB))
-"RTN","C0CVORU",201,0)
- ;
-"RTN","C0CVORU",202,0)
+"RTN","C0CVORU",215,0)
+ ;
+"RTN","C0CVORU",216,0)
  ; Parent Result and Parent
-"RTN","C0CVORU",203,0)
+"RTN","C0CVORU",217,0)
  I $D(LA7PARNT) D
-"RTN","C0CVORU",204,0)
+"RTN","C0CVORU",218,0)
  . S OBR(26)=$$OBR26^LA7VOBR(LA7PARNT(1),LA7PARNT(2),LA7PARNT(3),LA7FS,LA7ECH)
-"RTN","C0CVORU",205,0)
+"RTN","C0CVORU",219,0)
  . S OBR(29)=$$OBR29^LA7VOBR(LA("RUID"),LA("HUID"),LA7FS,LA7ECH)
-"RTN","C0CVORU",206,0)
- ;
-"RTN","C0CVORU",207,0)
+"RTN","C0CVORU",220,0)
+ ;
+"RTN","C0CVORU",221,0)
  ; Principle result interpreter
-"RTN","C0CVORU",208,0)
- ; Get default institution from MailMan Site Parameters file
-"RTN","C0CVORU",209,0)
- I "CYEMMISP"[LA("SUB") D
-"RTN","C0CVORU",210,0)
- . I LA("SUB")="MI" S LA7X=$P(LA763(0),"^",4)
-"RTN","C0CVORU",211,0)
- . E  S LA7X=$P(LA763(0),"^",2)
-"RTN","C0CVORU",212,0)
- . S LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
-"RTN","C0CVORU",213,0)
- . S OBR(32)=$$OBR32^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)
-"RTN","C0CVORU",214,0)
- ; 
-"RTN","C0CVORU",215,0)
- ; Assistant result interpreter
-"RTN","C0CVORU",216,0)
- ; Get default institution from MailMan Site Parameters file
-"RTN","C0CVORU",217,0)
- I "EMSP"[LA("SUB") D
-"RTN","C0CVORU",218,0)
- . S LA7X=$P(LA763(0),"^",4),LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
-"RTN","C0CVORU",219,0)
- . S OBR(33)=$$OBR33^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)
-"RTN","C0CVORU",220,0)
- ; 
-"RTN","C0CVORU",221,0)
- ; Technician
 "RTN","C0CVORU",222,0)
  ; Get default institution from MailMan Site Parameters file
 "RTN","C0CVORU",223,0)
+ I "CYEMMISP"[LA("SUB") D
+"RTN","C0CVORU",224,0)
+ . I LA("SUB")="MI" S LA7X=$P(LA763(0),"^",4)
+"RTN","C0CVORU",225,0)
+ . E  S LA7X=$P(LA763(0),"^",2)
+"RTN","C0CVORU",226,0)
+ . S LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
+"RTN","C0CVORU",227,0)
+ . S OBR(32)=$$OBR32^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)
+"RTN","C0CVORU",228,0)
+ ; 
+"RTN","C0CVORU",229,0)
+ ; Assistant result interpreter
+"RTN","C0CVORU",230,0)
+ ; Get default institution from MailMan Site Parameters file
+"RTN","C0CVORU",231,0)
+ I "EMSP"[LA("SUB") D
+"RTN","C0CVORU",232,0)
+ . S LA7X=$P(LA763(0),"^",4),LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
+"RTN","C0CVORU",233,0)
+ . S OBR(33)=$$OBR33^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)
+"RTN","C0CVORU",234,0)
+ ; 
+"RTN","C0CVORU",235,0)
+ ; Technician
+"RTN","C0CVORU",236,0)
+ ; Get default institution from MailMan Site Parameters file
+"RTN","C0CVORU",237,0)
  I "CYEM"[LA("SUB") D
-"RTN","C0CVORU",224,0)
+"RTN","C0CVORU",238,0)
  . S LA7X=$P(LA763(0),"^",4),LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
-"RTN","C0CVORU",225,0)
+"RTN","C0CVORU",239,0)
  . S OBR(34)=$$OBR34^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)
-"RTN","C0CVORU",226,0)
+"RTN","C0CVORU",240,0)
  ; 
-"RTN","C0CVORU",227,0)
+"RTN","C0CVORU",241,0)
  ; Typist - VistA stores as free text
-"RTN","C0CVORU",228,0)
+"RTN","C0CVORU",242,0)
  ; Get default institution from MailMan Site Parameters file
-"RTN","C0CVORU",229,0)
+"RTN","C0CVORU",243,0)
  I "CYEMSP"[LA("SUB") D
-"RTN","C0CVORU",230,0)
+"RTN","C0CVORU",244,0)
  . S LA7X=$P(LA763(0),"^",9),LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
-"RTN","C0CVORU",231,0)
+"RTN","C0CVORU",245,0)
  . S OBR(35)=$$OBR35^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)
-"RTN","C0CVORU",232,0)
+"RTN","C0CVORU",246,0)
  ; 
-"RTN","C0CVORU",233,0)
+"RTN","C0CVORU",247,0)
  D BUILDSEG^LA7VHLU(.OBR,.LA7DATA,LA7FS)
-"RTN","C0CVORU",234,0)
+"RTN","C0CVORU",248,0)
  D FILESEG^LA7VHLU(GBL,.LA7DATA)
-"RTN","C0CVORU",235,0)
- ;
-"RTN","C0CVORU",236,0)
+"RTN","C0CVORU",249,0)
+ ;
+"RTN","C0CVORU",250,0)
  ; Check for flag to only build message but do not file
-"RTN","C0CVORU",237,0)
+"RTN","C0CVORU",251,0)
  I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
-"RTN","C0CVORU",238,0)
- ;
-"RTN","C0CVORU",239,0)
+"RTN","C0CVORU",252,0)
+ ;
+"RTN","C0CVORU",253,0)
  Q
-"RTN","C0CVORU",240,0)
- ;
-"RTN","C0CVORU",241,0)
- ;
-"RTN","C0CVORU",242,0)
+"RTN","C0CVORU",254,0)
+ ;
+"RTN","C0CVORU",255,0)
+ ;
+"RTN","C0CVORU",256,0)
 OBX ;Observation/Result segment for Lab Results
-"RTN","C0CVORU",243,0)
- ;
-"RTN","C0CVORU",244,0)
+"RTN","C0CVORU",257,0)
+ ;
+"RTN","C0CVORU",258,0)
  N LA7953,LA7DATA,LA7VT,LA7VTIEN,LA7X
-"RTN","C0CVORU",245,0)
- ;
-"RTN","C0CVORU",246,0)
+"RTN","C0CVORU",259,0)
+ ;
+"RTN","C0CVORU",260,0)
  S LA7VTIEN=0
-"RTN","C0CVORU",247,0)
+"RTN","C0CVORU",261,0)
  F  S LA7VTIEN=$O(^LAHM(62.49,LA(62.49),1,LA7VTIEN)) Q:'LA7VTIEN  D
-"RTN","C0CVORU",248,0)
+"RTN","C0CVORU",262,0)
  . S LA7VT=$P(^LAHM(62.49,LA(62.49),1,LA7VTIEN,0),"^",1,2)
-"RTN","C0CVORU",249,0)
+"RTN","C0CVORU",263,0)
  . ; Build OBX segment
-"RTN","C0CVORU",250,0)
+"RTN","C0CVORU",264,0)
  . K LA7DATA
-"RTN","C0CVORU",251,0)
+"RTN","C0CVORU",265,0)
  . D OBX^LA7VOBX(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^",1,2),.LA7DATA,.LA7OBXSN,LA7FS,LA7ECH,$G(LA7NVAF))
-"RTN","C0CVORU",252,0)
+"RTN","C0CVORU",266,0)
  . ; If OBX failed to build then don't store
-"RTN","C0CVORU",253,0)
+"RTN","C0CVORU",267,0)
  . I '$D(LA7DATA) Q
-"RTN","C0CVORU",254,0)
+"RTN","C0CVORU",268,0)
  . ;
-"RTN","C0CVORU",255,0)
+"RTN","C0CVORU",269,0)
  . D FILESEG^LA7VHLU(GBL,.LA7DATA)
-"RTN","C0CVORU",256,0)
+"RTN","C0CVORU",270,0)
  . I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
-"RTN","C0CVORU",257,0)
+"RTN","C0CVORU",271,0)
  . ;
-"RTN","C0CVORU",258,0)
+"RTN","C0CVORU",272,0)
  . ; Send performing lab comment and interpretation from file #60
-"RTN","C0CVORU",259,0)
+"RTN","C0CVORU",273,0)
  . S LA7NTESN=0
-"RTN","C0CVORU",260,0)
+"RTN","C0CVORU",274,0)
  . I LA7NVAF=1 D PLC^LA7VORUA
-"RTN","C0CVORU",261,0)
+"RTN","C0CVORU",275,0)
  . D INTRP^LA7VORUA
-"RTN","C0CVORU",262,0)
+"RTN","C0CVORU",276,0)
  . ;
-"RTN","C0CVORU",263,0)
+"RTN","C0CVORU",277,0)
  . ; Mark result as sent - set to 1, if corrected results set to 2
-"RTN","C0CVORU",264,0)
+"RTN","C0CVORU",278,0)
  . I LA("SUB")="CH" D
-"RTN","C0CVORU",265,0)
+"RTN","C0CVORU",279,0)
  . . I $P(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^")),"^",10)>1 Q
-"RTN","C0CVORU",266,0)
+"RTN","C0CVORU",280,0)
  . . S $P(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^")),"^",10)=$S($P(LA7VT,"^",2)="C":2,1:1)
-"RTN","C0CVORU",267,0)
- ;
-"RTN","C0CVORU",268,0)
+"RTN","C0CVORU",281,0)
+ ;
+"RTN","C0CVORU",282,0)
  Q
-"RTN","C0CVORU",269,0)
- ;
-"RTN","C0CVORU",270,0)
- ;
-"RTN","C0CVORU",271,0)
+"RTN","C0CVORU",283,0)
+ ;
+"RTN","C0CVORU",284,0)
+ ;
+"RTN","C0CVORU",285,0)
 NTE ; Build NTE segment
-"RTN","C0CVORU",272,0)
- ;
-"RTN","C0CVORU",273,0)
+"RTN","C0CVORU",286,0)
+ ;
+"RTN","C0CVORU",287,0)
  D NTE^LA7VORUA
-"RTN","C0CVORU",274,0)
+"RTN","C0CVORU",288,0)
  Q
 "RTN","C0CXEWD")
-0^101^B15380480
+0^101^B15053974
 "RTN","C0CXEWD",1,0)
 C0CXEWD   ; C0C/GPL - EWD based XPath utilities; 10/11/09
 "RTN","C0CXEWD",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CXEWD",3,0)
- ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
+ ;Copyright 2009 George Lilly.  
 "RTN","C0CXEWD",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CXEWD",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CXEWD",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CXEWD",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CXEWD",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CXEWD",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CXEWD",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CXEWD",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CXEWD",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CXEWD",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CXEWD",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CXEWD",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CXEWD",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CXEWD",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CXEWD",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ Q
 "RTN","C0CXEWD",19,0)
  ;
 "RTN","C0CXEWD",20,0)
+TEST ;
+"RTN","C0CXEWD",21,0)
+ D XPATH($$FIRST($$ID("CCR1")),"/","GIDX","GARY")
+"RTN","C0CXEWD",22,0)
  Q
-"RTN","C0CXEWD",21,0)
- ;
-"RTN","C0CXEWD",22,0)
-TEST ;
 "RTN","C0CXEWD",23,0)
- D XPATH($$FIRST($$ID("CCR1")),"/","GIDX","GARY")
+ ;
 "RTN","C0CXEWD",24,0)
+TEST2 ;
+"RTN","C0CXEWD",25,0)
+ S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail"
+"RTN","C0CXEWD",26,0)
+ D XPATH($$FIRST($$ID("gpl")),"/","GIDX","GARY","",REDUX)
+"RTN","C0CXEWD",27,0)
  Q
-"RTN","C0CXEWD",25,0)
- ;
-"RTN","C0CXEWD",26,0)
-TEST2 ;
-"RTN","C0CXEWD",27,0)
- S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail"
 "RTN","C0CXEWD",28,0)
- D XPATH($$FIRST($$ID("gpl")),"/","GIDX","GARY","",REDUX)
+ ;
 "RTN","C0CXEWD",29,0)
+XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
+"RTN","C0CXEWD",30,0)
+ ; THE XPATH INDEX ZXIDX, PASSED BY NAME
+"RTN","C0CXEWD",31,0)
+ ; THE XPATH ARRAY XPARY, PASSED BY NAME
+"RTN","C0CXEWD",32,0)
+ ; ZOID IS THE STARTING OID
+"RTN","C0CXEWD",33,0)
+ ; ZPATH IS THE STARTING XPATH, USUALLY "/"
+"RTN","C0CXEWD",34,0)
+ ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
+"RTN","C0CXEWD",35,0)
+ ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
+"RTN","C0CXEWD",36,0)
+ I '$D(ZREDUX) S ZREDUX=""
+"RTN","C0CXEWD",37,0)
+ N NEWPATH
+"RTN","C0CXEWD",38,0)
+ N NEWNUM S NEWNUM=""
+"RTN","C0CXEWD",39,0)
+ I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
+"RTN","C0CXEWD",40,0)
+ S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
+"RTN","C0CXEWD",41,0)
+ I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
+"RTN","C0CXEWD",42,0)
+ . N GT S GT=$P(NEWPATH,ZREDUX,2)
+"RTN","C0CXEWD",43,0)
+ . I GT'="" S NEWPATH=GT
+"RTN","C0CXEWD",44,0)
+ S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
+"RTN","C0CXEWD",45,0)
+ N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
+"RTN","C0CXEWD",46,0)
+ I $D(GD(2)) M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
+"RTN","C0CXEWD",47,0)
+ E  I $D(GD(1)) S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
+"RTN","C0CXEWD",48,0)
+ I GD'="" S @ZXPARY@(NEWPATH)=GD ; IF YES, ADD IT TO THE XPATH ARRAY
+"RTN","C0CXEWD",49,0)
+ N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
+"RTN","C0CXEWD",50,0)
+ I ZFRST'="" D  ; THERE IS A CHILD
+"RTN","C0CXEWD",51,0)
+ . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
+"RTN","C0CXEWD",52,0)
+ . D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD
+"RTN","C0CXEWD",53,0)
+ N GNXT S GNXT=$$NXTSIB(ZOID)
+"RTN","C0CXEWD",54,0)
+ I GNXT'="" D  ; MOVE ON TO THE NEXT SIBLING
+"RTN","C0CXEWD",55,0)
+ . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB
+"RTN","C0CXEWD",56,0)
  Q
-"RTN","C0CXEWD",30,0)
- ;
-"RTN","C0CXEWD",31,0)
-XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
-"RTN","C0CXEWD",32,0)
- ; THE XPATH INDEX ZXIDX, PASSED BY NAME
-"RTN","C0CXEWD",33,0)
- ; THE XPATH ARRAY XPARY, PASSED BY NAME
-"RTN","C0CXEWD",34,0)
- ; ZOID IS THE STARTING OID
-"RTN","C0CXEWD",35,0)
- ; ZPATH IS THE STARTING XPATH, USUALLY "/"
-"RTN","C0CXEWD",36,0)
- ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
-"RTN","C0CXEWD",37,0)
- ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
-"RTN","C0CXEWD",38,0)
- I '$D(ZREDUX) S ZREDUX=""
-"RTN","C0CXEWD",39,0)
- N NEWPATH
-"RTN","C0CXEWD",40,0)
- N NEWNUM S NEWNUM=""
-"RTN","C0CXEWD",41,0)
- I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
-"RTN","C0CXEWD",42,0)
- S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
-"RTN","C0CXEWD",43,0)
- I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
-"RTN","C0CXEWD",44,0)
- . N GT S GT=$P(NEWPATH,ZREDUX,2)
-"RTN","C0CXEWD",45,0)
- . I GT'="" S NEWPATH=GT
-"RTN","C0CXEWD",46,0)
- S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
-"RTN","C0CXEWD",47,0)
- N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
-"RTN","C0CXEWD",48,0)
- I $D(GD(2)) M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
-"RTN","C0CXEWD",49,0)
- E  I $D(GD(1)) S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
-"RTN","C0CXEWD",50,0)
- I GD'="" S @ZXPARY@(NEWPATH)=GD ; IF YES, ADD IT TO THE XPATH ARRAY
-"RTN","C0CXEWD",51,0)
- N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
-"RTN","C0CXEWD",52,0)
- I ZFRST'="" D  ; THERE IS A CHILD
-"RTN","C0CXEWD",53,0)
- . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
-"RTN","C0CXEWD",54,0)
- . D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD
-"RTN","C0CXEWD",55,0)
- N GNXT S GNXT=$$NXTSIB(ZOID)
-"RTN","C0CXEWD",56,0)
- I GNXT'="" D  ; MOVE ON TO THE NEXT SIBLING
 "RTN","C0CXEWD",57,0)
- . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB
+ ;
 "RTN","C0CXEWD",58,0)
+PARSE(INXML,INDOC) ;CALL THE EWD PARSER ON INXML, PASSED BY NAME
+"RTN","C0CXEWD",59,0)
+ ; INDOC IS PASSED AS THE DOCUMENT NAME TO EWD
+"RTN","C0CXEWD",60,0)
+ ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY EWD
+"RTN","C0CXEWD",61,0)
+ N ZR
+"RTN","C0CXEWD",62,0)
+ M ^CacheTempEWD($j)=@INXML ;
+"RTN","C0CXEWD",63,0)
+ S ZR=$$parseDocument^%zewdHTMLParser(INDOC)
+"RTN","C0CXEWD",64,0)
+ Q ZR
+"RTN","C0CXEWD",65,0)
+ ;
+"RTN","C0CXEWD",66,0)
+ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
+"RTN","C0CXEWD",67,0)
+ N ZN
+"RTN","C0CXEWD",68,0)
+ S ZN=$$NXTSIB(ZOID)
+"RTN","C0CXEWD",69,0)
+ I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
+"RTN","C0CXEWD",70,0)
+ Q 0
+"RTN","C0CXEWD",71,0)
+ ;
+"RTN","C0CXEWD",72,0)
+DETAIL(ZRTN,ZOID) ; RETURNS DETAIL FOR NODE ZOID IN ZRTN, PASSED BY NAME
+"RTN","C0CXEWD",73,0)
+ N DET
+"RTN","C0CXEWD",74,0)
+ D getElementDetails^%zewdXPath(ZOID,.DET)
+"RTN","C0CXEWD",75,0)
+ M @ZRTN=DET
+"RTN","C0CXEWD",76,0)
  Q
-"RTN","C0CXEWD",59,0)
- ;
-"RTN","C0CXEWD",60,0)
-PARSE(INXML,INDOC) ;CALL THE EWD PARSER ON INXML, PASSED BY NAME
-"RTN","C0CXEWD",61,0)
- ; INDOC IS PASSED AS THE DOCUMENT NAME TO EWD
-"RTN","C0CXEWD",62,0)
- ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY EWD
-"RTN","C0CXEWD",63,0)
- N ZR
-"RTN","C0CXEWD",64,0)
- M ^CacheTempEWD($j)=@INXML ;
-"RTN","C0CXEWD",65,0)
- S ZR=$$parseDocument^%zewdHTMLParser(INDOC)
-"RTN","C0CXEWD",66,0)
- Q ZR
-"RTN","C0CXEWD",67,0)
- ;
-"RTN","C0CXEWD",68,0)
-ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
-"RTN","C0CXEWD",69,0)
- N ZN
-"RTN","C0CXEWD",70,0)
- S ZN=$$NXTSIB(ZOID)
-"RTN","C0CXEWD",71,0)
- I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
-"RTN","C0CXEWD",72,0)
- Q 0
-"RTN","C0CXEWD",73,0)
- ;
-"RTN","C0CXEWD",74,0)
-DETAIL(ZRTN,ZOID) ; RETURNS DETAIL FOR NODE ZOID IN ZRTN, PASSED BY NAME
-"RTN","C0CXEWD",75,0)
- N DET
-"RTN","C0CXEWD",76,0)
- D getElementDetails^%zewdXPath(ZOID,.DET)
 "RTN","C0CXEWD",77,0)
- M @ZRTN=DET
+ ;
 "RTN","C0CXEWD",78,0)
+ID(ZNAME) ;RETURNS THE docOID OF THE DOCUMENT NAMED ZNAME
+"RTN","C0CXEWD",79,0)
+ Q $$getDocumentNode^%zewdDOM(ZNAME)
+"RTN","C0CXEWD",80,0)
+ ;
+"RTN","C0CXEWD",81,0)
+NAME(ZOID) ;RETURNS THE NAME OF THE DOCUMENAT WITH docOID ZOID
+"RTN","C0CXEWD",82,0)
+ Q $$getDocumentName^%zewdDOM(ZOID)
+"RTN","C0CXEWD",83,0)
+ ;
+"RTN","C0CXEWD",84,0)
+FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
+"RTN","C0CXEWD",85,0)
+ N GOID
+"RTN","C0CXEWD",86,0)
+ S GOID=ZOID
+"RTN","C0CXEWD",87,0)
+ S GOID=$$getFirstChild^%zewdDOM(GOID)
+"RTN","C0CXEWD",88,0)
+ I GOID="" Q ""
+"RTN","C0CXEWD",89,0)
+ I $$getNodeType^%zewdDOM(GOID)'=1 S GOID=$$NXTCHLD(GOID)
+"RTN","C0CXEWD",90,0)
+ Q GOID
+"RTN","C0CXEWD",91,0)
+ ;
+"RTN","C0CXEWD",92,0)
+HASCHILD(ZOID) ; RETURNS TRUE IF ZOID HAS CHILD NODES
+"RTN","C0CXEWD",93,0)
+ Q $$hasChildNodes^%zewdDOM(ZOID)
+"RTN","C0CXEWD",94,0)
+ ;
+"RTN","C0CXEWD",95,0)
+CHILDREN(ZRTN,ZOID) ;RETURNS CHILDREN OF ZOID IN ARRAY ZRTN, PASSED BY NAME
+"RTN","C0CXEWD",96,0)
+ N childArray
+"RTN","C0CXEWD",97,0)
+ d getChildrenInOrder^%zewdDOM(ZOID,.childArray)
+"RTN","C0CXEWD",98,0)
+ m @ZRTN=childArray
+"RTN","C0CXEWD",99,0)
+ q
+"RTN","C0CXEWD",100,0)
+ ;
+"RTN","C0CXEWD",101,0)
+TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
+"RTN","C0CXEWD",102,0)
+ Q $$getName^%zewdDOM(ZOID)
+"RTN","C0CXEWD",103,0)
+ ;
+"RTN","C0CXEWD",104,0)
+NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
+"RTN","C0CXEWD",105,0)
+ Q $$getNextSibling^%zewdDOM(ZOID)
+"RTN","C0CXEWD",106,0)
+ ;
+"RTN","C0CXEWD",107,0)
+NXTCHLD(ZOID) ; RETURNS THE NEXT CHILD IN PARENT ZPAR
+"RTN","C0CXEWD",108,0)
+ N GOID
+"RTN","C0CXEWD",109,0)
+ S GOID=$$getNextChild^%zewdDOM($$PARENT(ZOID),ZOID)
+"RTN","C0CXEWD",110,0)
+ I GOID="" Q ""
+"RTN","C0CXEWD",111,0)
+ I $$getNodeType^%zewdDOM(GOID)'=1 S GOID=$$NXTCHLD(GOID)
+"RTN","C0CXEWD",112,0)
+ Q GOID
+"RTN","C0CXEWD",113,0)
+ ;
+"RTN","C0CXEWD",114,0)
+PARENT(ZOID) ; RETURNS PARENT OF ZOID
+"RTN","C0CXEWD",115,0)
+ Q $$getParentNode^%zewdDOM(ZOID)
+"RTN","C0CXEWD",116,0)
+ ;
+"RTN","C0CXEWD",117,0)
+DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
+"RTN","C0CXEWD",118,0)
+ N ZT2
+"RTN","C0CXEWD",119,0)
+ S ZT2=$$getElementText^%zewdDOM(ZOID,.ZT2)
+"RTN","C0CXEWD",120,0)
+ M @ZT=ZT2
+"RTN","C0CXEWD",121,0)
  Q
-"RTN","C0CXEWD",79,0)
- ;
-"RTN","C0CXEWD",80,0)
-ID(ZNAME) ;RETURNS THE docOID OF THE DOCUMENT NAMED ZNAME
-"RTN","C0CXEWD",81,0)
- Q $$getDocumentNode^%zewdDOM(ZNAME)
-"RTN","C0CXEWD",82,0)
- ;
-"RTN","C0CXEWD",83,0)
-NAME(ZOID) ;RETURNS THE NAME OF THE DOCUMENAT WITH docOID ZOID
-"RTN","C0CXEWD",84,0)
- Q $$getDocumentName^%zewdDOM(ZOID)
-"RTN","C0CXEWD",85,0)
- ;
-"RTN","C0CXEWD",86,0)
-FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
-"RTN","C0CXEWD",87,0)
- N GOID
-"RTN","C0CXEWD",88,0)
- S GOID=ZOID
-"RTN","C0CXEWD",89,0)
- S GOID=$$getFirstChild^%zewdDOM(GOID)
-"RTN","C0CXEWD",90,0)
- I GOID="" Q ""
-"RTN","C0CXEWD",91,0)
- I $$getNodeType^%zewdDOM(GOID)'=1 S GOID=$$NXTCHLD(GOID)
-"RTN","C0CXEWD",92,0)
- Q GOID
-"RTN","C0CXEWD",93,0)
- ;
-"RTN","C0CXEWD",94,0)
-HASCHILD(ZOID) ; RETURNS TRUE IF ZOID HAS CHILD NODES
-"RTN","C0CXEWD",95,0)
- Q $$hasChildNodes^%zewdDOM(ZOID)
-"RTN","C0CXEWD",96,0)
- ;
-"RTN","C0CXEWD",97,0)
-CHILDREN(ZRTN,ZOID) ;RETURNS CHILDREN OF ZOID IN ARRAY ZRTN, PASSED BY NAME
-"RTN","C0CXEWD",98,0)
- N childArray
-"RTN","C0CXEWD",99,0)
- d getChildrenInOrder^%zewdDOM(ZOID,.childArray)
-"RTN","C0CXEWD",100,0)
- m @ZRTN=childArray
-"RTN","C0CXEWD",101,0)
- q
-"RTN","C0CXEWD",102,0)
- ;
-"RTN","C0CXEWD",103,0)
-TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
-"RTN","C0CXEWD",104,0)
- Q $$getName^%zewdDOM(ZOID)
-"RTN","C0CXEWD",105,0)
- ;
-"RTN","C0CXEWD",106,0)
-NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
-"RTN","C0CXEWD",107,0)
- Q $$getNextSibling^%zewdDOM(ZOID)
-"RTN","C0CXEWD",108,0)
- ;
-"RTN","C0CXEWD",109,0)
-NXTCHLD(ZOID) ; RETURNS THE NEXT CHILD IN PARENT ZPAR
-"RTN","C0CXEWD",110,0)
- N GOID
-"RTN","C0CXEWD",111,0)
- S GOID=$$getNextChild^%zewdDOM($$PARENT(ZOID),ZOID)
-"RTN","C0CXEWD",112,0)
- I GOID="" Q ""
-"RTN","C0CXEWD",113,0)
- I $$getNodeType^%zewdDOM(GOID)'=1 S GOID=$$NXTCHLD(GOID)
-"RTN","C0CXEWD",114,0)
- Q GOID
-"RTN","C0CXEWD",115,0)
- ;
-"RTN","C0CXEWD",116,0)
-PARENT(ZOID) ; RETURNS PARENT OF ZOID
-"RTN","C0CXEWD",117,0)
- Q $$getParentNode^%zewdDOM(ZOID)
-"RTN","C0CXEWD",118,0)
- ;
-"RTN","C0CXEWD",119,0)
-DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
-"RTN","C0CXEWD",120,0)
- N ZT2
-"RTN","C0CXEWD",121,0)
- S ZT2=$$getElementText^%zewdDOM(ZOID,.ZT2)
 "RTN","C0CXEWD",122,0)
- M @ZT=ZT2
+ ;Q $$getTextValue^%zewdXPath(ZOID)
 "RTN","C0CXEWD",123,0)
- Q
+ ;Q $$getData^%zewdDOM(ZOID,.ZT)
 "RTN","C0CXEWD",124,0)
- ;Q $$getTextValue^%zewdXPath(ZOID)
-"RTN","C0CXEWD",125,0)
- ;Q $$getData^%zewdDOM(ZOID,.ZT)
-"RTN","C0CXEWD",126,0)
  ;
 "RTN","C0CXPAT0")
-0^35^B50736852
+0^35^B49945143
 "RTN","C0CXPAT0",1,0)
 C0CXPAT0   ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
 "RTN","C0CXPAT0",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CXPAT0",3,0)
- ;Copyright 2008 George Lilly.  Licensed under the terms of the GNU
+ ;Copyright 2008 George Lilly.  
 "RTN","C0CXPAT0",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CXPAT0",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CXPAT0",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CXPAT0",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CXPAT0",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CXPAT0",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CXPAT0",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CXPAT0",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CXPAT0",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CXPAT0",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CXPAT0",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CXPAT0",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CXPAT0",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CXPAT0",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CXPAT0",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ W "NO ENTRY",!
 "RTN","C0CXPAT0",19,0)
- ;
+ Q
 "RTN","C0CXPAT0",20,0)
-        W "NO ENTRY",!
+ ;
 "RTN","C0CXPAT0",21,0)
-        Q
+ ;;><TEST>
 "RTN","C0CXPAT0",22,0)
-        ;
+ ;;><INIT>
 "RTN","C0CXPAT0",23,0)
- ;;><TEST>
+ ;;>>>K C0C S C0C=""
 "RTN","C0CXPAT0",24,0)
- ;;><INIT>
+ ;;>>>D PUSH^C0CXPATH("C0C","FIRST")
 "RTN","C0CXPAT0",25,0)
- ;;>>>K C0C S C0C=""
+ ;;>>>D PUSH^C0CXPATH("C0C","SECOND")
 "RTN","C0CXPAT0",26,0)
- ;;>>>D PUSH^C0CXPATH("C0C","FIRST")
+ ;;>>>D PUSH^C0CXPATH("C0C","THIRD")
 "RTN","C0CXPAT0",27,0)
- ;;>>>D PUSH^C0CXPATH("C0C","SECOND")
+ ;;>>>D PUSH^C0CXPATH("C0C","FOURTH")
 "RTN","C0CXPAT0",28,0)
- ;;>>>D PUSH^C0CXPATH("C0C","THIRD")
+ ;;>>?C0C(0)=4
 "RTN","C0CXPAT0",29,0)
- ;;>>>D PUSH^C0CXPATH("C0C","FOURTH")
+ ;;><INITXML>
 "RTN","C0CXPAT0",30,0)
- ;;>>?C0C(0)=4
+ ;;>>>K GXML S GXML=""
 "RTN","C0CXPAT0",31,0)
- ;;><INITXML>
+ ;;>>>D PUSH^C0CXPATH("GXML","<FIRST>")
 "RTN","C0CXPAT0",32,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","<SECOND>")
+"RTN","C0CXPAT0",33,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","<THIRD>")
+"RTN","C0CXPAT0",34,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>")
+"RTN","C0CXPAT0",35,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","<FIFTH>")
+"RTN","C0CXPAT0",36,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","@@DATA2@@")
+"RTN","C0CXPAT0",37,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","</FIFTH>")
+"RTN","C0CXPAT0",38,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","<SIXTH ID=""SELF"" />")
+"RTN","C0CXPAT0",39,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","</THIRD>")
+"RTN","C0CXPAT0",40,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","<SECOND>")
+"RTN","C0CXPAT0",41,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","</SECOND>")
+"RTN","C0CXPAT0",42,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","</SECOND>")
+"RTN","C0CXPAT0",43,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","</FIRST>")
+"RTN","C0CXPAT0",44,0)
+ ;;><INITXML2>
+"RTN","C0CXPAT0",45,0)
  ;;>>>K GXML S GXML=""
-"RTN","C0CXPAT0",33,0)
+"RTN","C0CXPAT0",46,0)
  ;;>>>D PUSH^C0CXPATH("GXML","<FIRST>")
-"RTN","C0CXPAT0",34,0)
+"RTN","C0CXPAT0",47,0)
  ;;>>>D PUSH^C0CXPATH("GXML","<SECOND>")
-"RTN","C0CXPAT0",35,0)
+"RTN","C0CXPAT0",48,0)
  ;;>>>D PUSH^C0CXPATH("GXML","<THIRD>")
-"RTN","C0CXPAT0",36,0)
- ;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>")
-"RTN","C0CXPAT0",37,0)
- ;;>>>D PUSH^C0CXPATH("GXML","<FIFTH>")
-"RTN","C0CXPAT0",38,0)
- ;;>>>D PUSH^C0CXPATH("GXML","@@DATA2@@")
-"RTN","C0CXPAT0",39,0)
- ;;>>>D PUSH^C0CXPATH("GXML","</FIFTH>")
-"RTN","C0CXPAT0",40,0)
- ;;>>>D PUSH^C0CXPATH("GXML","<SIXTH ID=""SELF"" />")
-"RTN","C0CXPAT0",41,0)
+"RTN","C0CXPAT0",49,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>DATA1</FOURTH>")
+"RTN","C0CXPAT0",50,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>")
+"RTN","C0CXPAT0",51,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","DATA2")
+"RTN","C0CXPAT0",52,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","</FOURTH>")
+"RTN","C0CXPAT0",53,0)
  ;;>>>D PUSH^C0CXPATH("GXML","</THIRD>")
-"RTN","C0CXPAT0",42,0)
- ;;>>>D PUSH^C0CXPATH("GXML","<SECOND>")
-"RTN","C0CXPAT0",43,0)
+"RTN","C0CXPAT0",54,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","<_SECOND>")
+"RTN","C0CXPAT0",55,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>DATA3</FOURTH>")
+"RTN","C0CXPAT0",56,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","</_SECOND>")
+"RTN","C0CXPAT0",57,0)
  ;;>>>D PUSH^C0CXPATH("GXML","</SECOND>")
-"RTN","C0CXPAT0",44,0)
- ;;>>>D PUSH^C0CXPATH("GXML","</SECOND>")
-"RTN","C0CXPAT0",45,0)
+"RTN","C0CXPAT0",58,0)
  ;;>>>D PUSH^C0CXPATH("GXML","</FIRST>")
-"RTN","C0CXPAT0",46,0)
- ;;><INITXML2>
-"RTN","C0CXPAT0",47,0)
- ;;>>>K GXML S GXML=""
-"RTN","C0CXPAT0",48,0)
- ;;>>>D PUSH^C0CXPATH("GXML","<FIRST>")
-"RTN","C0CXPAT0",49,0)
- ;;>>>D PUSH^C0CXPATH("GXML","<SECOND>")
-"RTN","C0CXPAT0",50,0)
- ;;>>>D PUSH^C0CXPATH("GXML","<THIRD>")
-"RTN","C0CXPAT0",51,0)
- ;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>DATA1</FOURTH>")
-"RTN","C0CXPAT0",52,0)
- ;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>")
-"RTN","C0CXPAT0",53,0)
- ;;>>>D PUSH^C0CXPATH("GXML","DATA2")
-"RTN","C0CXPAT0",54,0)
- ;;>>>D PUSH^C0CXPATH("GXML","</FOURTH>")
-"RTN","C0CXPAT0",55,0)
- ;;>>>D PUSH^C0CXPATH("GXML","</THIRD>")
-"RTN","C0CXPAT0",56,0)
- ;;>>>D PUSH^C0CXPATH("GXML","<_SECOND>")
-"RTN","C0CXPAT0",57,0)
- ;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>DATA3</FOURTH>")
-"RTN","C0CXPAT0",58,0)
- ;;>>>D PUSH^C0CXPATH("GXML","</_SECOND>")
 "RTN","C0CXPAT0",59,0)
- ;;>>>D PUSH^C0CXPATH("GXML","</SECOND>")
+ ;;><PUSHPOP>
 "RTN","C0CXPAT0",60,0)
- ;;>>>D PUSH^C0CXPATH("GXML","</FIRST>")
+ ;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
 "RTN","C0CXPAT0",61,0)
- ;;><PUSHPOP>
+ ;;>>>D ZTEST^C0CUNIT(.ZTMP,"INIT")
 "RTN","C0CXPAT0",62,0)
+ ;;>>?C0C(C0C(0))="FOURTH"
+"RTN","C0CXPAT0",63,0)
+ ;;>>>D POP^C0CXPATH("C0C",.GX)
+"RTN","C0CXPAT0",64,0)
+ ;;>>?GX="FOURTH"
+"RTN","C0CXPAT0",65,0)
+ ;;>>?C0C(C0C(0))="THIRD"
+"RTN","C0CXPAT0",66,0)
+ ;;>>>D POP^C0CXPATH("C0C",.GX)
+"RTN","C0CXPAT0",67,0)
+ ;;>>?GX="THIRD"
+"RTN","C0CXPAT0",68,0)
+ ;;>>?C0C(C0C(0))="SECOND"
+"RTN","C0CXPAT0",69,0)
+ ;;><MKMDX>
+"RTN","C0CXPAT0",70,0)
  ;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
-"RTN","C0CXPAT0",63,0)
+"RTN","C0CXPAT0",71,0)
  ;;>>>D ZTEST^C0CUNIT(.ZTMP,"INIT")
-"RTN","C0CXPAT0",64,0)
- ;;>>?C0C(C0C(0))="FOURTH"
-"RTN","C0CXPAT0",65,0)
- ;;>>>D POP^C0CXPATH("C0C",.GX)
-"RTN","C0CXPAT0",66,0)
- ;;>>?GX="FOURTH"
-"RTN","C0CXPAT0",67,0)
- ;;>>?C0C(C0C(0))="THIRD"
-"RTN","C0CXPAT0",68,0)
- ;;>>>D POP^C0CXPATH("C0C",.GX)
-"RTN","C0CXPAT0",69,0)
- ;;>>?GX="THIRD"
-"RTN","C0CXPAT0",70,0)
- ;;>>?C0C(C0C(0))="SECOND"
-"RTN","C0CXPAT0",71,0)
- ;;><MKMDX>
 "RTN","C0CXPAT0",72,0)
+ ;;>>>S GX=""
+"RTN","C0CXPAT0",73,0)
+ ;;>>>D MKMDX^C0CXPATH("C0C",.GX)
+"RTN","C0CXPAT0",74,0)
+ ;;>>?GX="//FIRST/SECOND/THIRD/FOURTH"
+"RTN","C0CXPAT0",75,0)
+ ;;><XNAME>
+"RTN","C0CXPAT0",76,0)
+ ;;>>?$$XNAME^C0CXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH"
+"RTN","C0CXPAT0",77,0)
+ ;;>>?$$XNAME^C0CXPATH("<SIXTH  ID=""SELF"" />")="SIXTH"
+"RTN","C0CXPAT0",78,0)
+ ;;>>?$$XNAME^C0CXPATH("</THIRD>")="THIRD"
+"RTN","C0CXPAT0",79,0)
+ ;;><INDEX>
+"RTN","C0CXPAT0",80,0)
  ;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
-"RTN","C0CXPAT0",73,0)
- ;;>>>D ZTEST^C0CUNIT(.ZTMP,"INIT")
-"RTN","C0CXPAT0",74,0)
- ;;>>>S GX=""
-"RTN","C0CXPAT0",75,0)
- ;;>>>D MKMDX^C0CXPATH("C0C",.GX)
-"RTN","C0CXPAT0",76,0)
- ;;>>?GX="//FIRST/SECOND/THIRD/FOURTH"
-"RTN","C0CXPAT0",77,0)
- ;;><XNAME>
-"RTN","C0CXPAT0",78,0)
- ;;>>?$$XNAME^C0CXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH"
-"RTN","C0CXPAT0",79,0)
- ;;>>?$$XNAME^C0CXPATH("<SIXTH  ID=""SELF"" />")="SIXTH"
-"RTN","C0CXPAT0",80,0)
- ;;>>?$$XNAME^C0CXPATH("</THIRD>")="THIRD"
 "RTN","C0CXPAT0",81,0)
- ;;><INDEX>
+ ;;>>>D ZTEST^C0CUNIT(.ZTMP,"INITXML")
 "RTN","C0CXPAT0",82,0)
- ;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
+ ;;>>>D INDEX^C0CXPATH("GXML")
 "RTN","C0CXPAT0",83,0)
- ;;>>>D ZTEST^C0CUNIT(.ZTMP,"INITXML")
+ ;;>>?GXML("//FIRST/SECOND")="2^12"
 "RTN","C0CXPAT0",84,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD")="3^9"
+"RTN","C0CXPAT0",85,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7"
+"RTN","C0CXPAT0",86,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4^@@DATA1@@"
+"RTN","C0CXPAT0",87,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8^"
+"RTN","C0CXPAT0",88,0)
+ ;;>>?GXML("//FIRST/SECOND")="2^12"
+"RTN","C0CXPAT0",89,0)
+ ;;>>?GXML("//FIRST")="1^13"
+"RTN","C0CXPAT0",90,0)
+ ;;><INDEX2>
+"RTN","C0CXPAT0",91,0)
+ ;;>>>D ZTEST^C0CXPATH("INITXML2")
+"RTN","C0CXPAT0",92,0)
  ;;>>>D INDEX^C0CXPATH("GXML")
-"RTN","C0CXPAT0",85,0)
+"RTN","C0CXPAT0",93,0)
  ;;>>?GXML("//FIRST/SECOND")="2^12"
-"RTN","C0CXPAT0",86,0)
- ;;>>?GXML("//FIRST/SECOND/THIRD")="3^9"
-"RTN","C0CXPAT0",87,0)
- ;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7"
-"RTN","C0CXPAT0",88,0)
- ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4^@@DATA1@@"
-"RTN","C0CXPAT0",89,0)
- ;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8^"
-"RTN","C0CXPAT0",90,0)
- ;;>>?GXML("//FIRST/SECOND")="2^12"
-"RTN","C0CXPAT0",91,0)
+"RTN","C0CXPAT0",94,0)
+ ;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11"
+"RTN","C0CXPAT0",95,0)
+ ;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10^DATA3"
+"RTN","C0CXPAT0",96,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD")="3^8"
+"RTN","C0CXPAT0",97,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH[1]")="4^4^DATA1"
+"RTN","C0CXPAT0",98,0)
  ;;>>?GXML("//FIRST")="1^13"
-"RTN","C0CXPAT0",92,0)
- ;;><INDEX2>
-"RTN","C0CXPAT0",93,0)
- ;;>>>D ZTEST^C0CXPATH("INITXML2")
-"RTN","C0CXPAT0",94,0)
- ;;>>>D INDEX^C0CXPATH("GXML")
-"RTN","C0CXPAT0",95,0)
- ;;>>?GXML("//FIRST/SECOND")="2^12"
-"RTN","C0CXPAT0",96,0)
- ;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11"
-"RTN","C0CXPAT0",97,0)
- ;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10^DATA3"
-"RTN","C0CXPAT0",98,0)
- ;;>>?GXML("//FIRST/SECOND/THIRD")="3^8"
 "RTN","C0CXPAT0",99,0)
- ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH[1]")="4^4^DATA1"
+ ;;><MISSING>
 "RTN","C0CXPAT0",100,0)
- ;;>>?GXML("//FIRST")="1^13"
+ ;;>>>D ZTEST^C0CXPATH("INITXML")
 "RTN","C0CXPAT0",101,0)
- ;;><MISSING>
+ ;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")"
 "RTN","C0CXPAT0",102,0)
+ ;;>>>D MISSING^C0CXPATH("GXML",OUTARY)
+"RTN","C0CXPAT0",103,0)
+ ;;>>?@OUTARY@(1)="DATA1"
+"RTN","C0CXPAT0",104,0)
+ ;;>>?@OUTARY@(2)="DATA2"
+"RTN","C0CXPAT0",105,0)
+ ;;><MAP>
+"RTN","C0CXPAT0",106,0)
  ;;>>>D ZTEST^C0CXPATH("INITXML")
-"RTN","C0CXPAT0",103,0)
- ;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")"
-"RTN","C0CXPAT0",104,0)
- ;;>>>D MISSING^C0CXPATH("GXML",OUTARY)
-"RTN","C0CXPAT0",105,0)
- ;;>>?@OUTARY@(1)="DATA1"
-"RTN","C0CXPAT0",106,0)
- ;;>>?@OUTARY@(2)="DATA2"
 "RTN","C0CXPAT0",107,0)
- ;;><MAP>
+ ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
 "RTN","C0CXPAT0",108,0)
+ ;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
+"RTN","C0CXPAT0",109,0)
+ ;;>>>S @MAPARY@("DATA2")="VALUE2"
+"RTN","C0CXPAT0",110,0)
+ ;;>>>D MAP^C0CXPATH("GXML",MAPARY,OUTARY)
+"RTN","C0CXPAT0",111,0)
+ ;;>>?@OUTARY@(6)="VALUE2"
+"RTN","C0CXPAT0",112,0)
+ ;;><MAP2>
+"RTN","C0CXPAT0",113,0)
  ;;>>>D ZTEST^C0CXPATH("INITXML")
-"RTN","C0CXPAT0",109,0)
+"RTN","C0CXPAT0",114,0)
  ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
-"RTN","C0CXPAT0",110,0)
+"RTN","C0CXPAT0",115,0)
  ;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
-"RTN","C0CXPAT0",111,0)
+"RTN","C0CXPAT0",116,0)
+ ;;>>>S @MAPARY@("DATA1")="VALUE1"
+"RTN","C0CXPAT0",117,0)
  ;;>>>S @MAPARY@("DATA2")="VALUE2"
-"RTN","C0CXPAT0",112,0)
+"RTN","C0CXPAT0",118,0)
+ ;;>>>S @MAPARY@("DATA3")="VALUE3"
+"RTN","C0CXPAT0",119,0)
+ ;;>>>S GXML(4)="<FOURTH>@@DATA1@@ AND @@DATA3@@</FOURTH>"
+"RTN","C0CXPAT0",120,0)
  ;;>>>D MAP^C0CXPATH("GXML",MAPARY,OUTARY)
-"RTN","C0CXPAT0",113,0)
- ;;>>?@OUTARY@(6)="VALUE2"
-"RTN","C0CXPAT0",114,0)
- ;;><MAP2>
-"RTN","C0CXPAT0",115,0)
+"RTN","C0CXPAT0",121,0)
+ ;;>>>D PARY^C0CXPATH(OUTARY)
+"RTN","C0CXPAT0",122,0)
+ ;;>>?@OUTARY@(4)="<FOURTH>VALUE1 AND VALUE3</FOURTH>"
+"RTN","C0CXPAT0",123,0)
+ ;;><QUEUE>
+"RTN","C0CXPAT0",124,0)
+ ;;>>>D QUEUE^C0CXPATH("BTLIST","GXML",2,3)
+"RTN","C0CXPAT0",125,0)
+ ;;>>>D QUEUE^C0CXPATH("BTLIST","GXML",4,5)
+"RTN","C0CXPAT0",126,0)
+ ;;>>?$P(BTLIST(2),";",2)=4
+"RTN","C0CXPAT0",127,0)
+ ;;><BUILD>
+"RTN","C0CXPAT0",128,0)
  ;;>>>D ZTEST^C0CXPATH("INITXML")
-"RTN","C0CXPAT0",116,0)
- ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
-"RTN","C0CXPAT0",117,0)
- ;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
-"RTN","C0CXPAT0",118,0)
- ;;>>>S @MAPARY@("DATA1")="VALUE1"
-"RTN","C0CXPAT0",119,0)
- ;;>>>S @MAPARY@("DATA2")="VALUE2"
-"RTN","C0CXPAT0",120,0)
- ;;>>>S @MAPARY@("DATA3")="VALUE3"
-"RTN","C0CXPAT0",121,0)
- ;;>>>S GXML(4)="<FOURTH>@@DATA1@@ AND @@DATA3@@</FOURTH>"
-"RTN","C0CXPAT0",122,0)
- ;;>>>D MAP^C0CXPATH("GXML",MAPARY,OUTARY)
-"RTN","C0CXPAT0",123,0)
- ;;>>>D PARY^C0CXPATH(OUTARY)
-"RTN","C0CXPAT0",124,0)
- ;;>>?@OUTARY@(4)="<FOURTH>VALUE1 AND VALUE3</FOURTH>"
-"RTN","C0CXPAT0",125,0)
- ;;><QUEUE>
-"RTN","C0CXPAT0",126,0)
- ;;>>>D QUEUE^C0CXPATH("BTLIST","GXML",2,3)
-"RTN","C0CXPAT0",127,0)
- ;;>>>D QUEUE^C0CXPATH("BTLIST","GXML",4,5)
-"RTN","C0CXPAT0",128,0)
- ;;>>?$P(BTLIST(2),";",2)=4
 "RTN","C0CXPAT0",129,0)
- ;;><BUILD>
+ ;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2")
 "RTN","C0CXPAT0",130,0)
+ ;;>>>D ZTEST^C0CXPATH("QUEUE")
+"RTN","C0CXPAT0",131,0)
+ ;;>>>D BUILD^C0CXPATH("BTLIST","G3")
+"RTN","C0CXPAT0",132,0)
+ ;;><CP>
+"RTN","C0CXPAT0",133,0)
  ;;>>>D ZTEST^C0CXPATH("INITXML")
-"RTN","C0CXPAT0",131,0)
- ;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2")
-"RTN","C0CXPAT0",132,0)
- ;;>>>D ZTEST^C0CXPATH("QUEUE")
-"RTN","C0CXPAT0",133,0)
- ;;>>>D BUILD^C0CXPATH("BTLIST","G3")
 "RTN","C0CXPAT0",134,0)
- ;;><CP>
+ ;;>>>D CP^C0CXPATH("GXML","G2")
 "RTN","C0CXPAT0",135,0)
+ ;;>>?G2(0)=13
+"RTN","C0CXPAT0",136,0)
+ ;;><QOPEN>
+"RTN","C0CXPAT0",137,0)
+ ;;>>>K G2,GBL
+"RTN","C0CXPAT0",138,0)
  ;;>>>D ZTEST^C0CXPATH("INITXML")
-"RTN","C0CXPAT0",136,0)
- ;;>>>D CP^C0CXPATH("GXML","G2")
-"RTN","C0CXPAT0",137,0)
- ;;>>?G2(0)=13
-"RTN","C0CXPAT0",138,0)
- ;;><QOPEN>
 "RTN","C0CXPAT0",139,0)
+ ;;>>>D QOPEN^C0CXPATH("GBL","GXML")
+"RTN","C0CXPAT0",140,0)
+ ;;>>?$P(GBL(1),";",3)=12
+"RTN","C0CXPAT0",141,0)
+ ;;>>>D BUILD^C0CXPATH("GBL","G2")
+"RTN","C0CXPAT0",142,0)
+ ;;>>?G2(G2(0))="</SECOND>"
+"RTN","C0CXPAT0",143,0)
+ ;;><QOPEN2>
+"RTN","C0CXPAT0",144,0)
  ;;>>>K G2,GBL
-"RTN","C0CXPAT0",140,0)
+"RTN","C0CXPAT0",145,0)
  ;;>>>D ZTEST^C0CXPATH("INITXML")
-"RTN","C0CXPAT0",141,0)
- ;;>>>D QOPEN^C0CXPATH("GBL","GXML")
-"RTN","C0CXPAT0",142,0)
- ;;>>?$P(GBL(1),";",3)=12
-"RTN","C0CXPAT0",143,0)
+"RTN","C0CXPAT0",146,0)
+ ;;>>>D QOPEN^C0CXPATH("GBL","GXML","//FIRST/SECOND")
+"RTN","C0CXPAT0",147,0)
+ ;;>>?$P(GBL(1),";",3)=11
+"RTN","C0CXPAT0",148,0)
  ;;>>>D BUILD^C0CXPATH("GBL","G2")
-"RTN","C0CXPAT0",144,0)
+"RTN","C0CXPAT0",149,0)
  ;;>>?G2(G2(0))="</SECOND>"
-"RTN","C0CXPAT0",145,0)
- ;;><QOPEN2>
-"RTN","C0CXPAT0",146,0)
+"RTN","C0CXPAT0",150,0)
+ ;;><QCLOSE>
+"RTN","C0CXPAT0",151,0)
  ;;>>>K G2,GBL
-"RTN","C0CXPAT0",147,0)
+"RTN","C0CXPAT0",152,0)
  ;;>>>D ZTEST^C0CXPATH("INITXML")
-"RTN","C0CXPAT0",148,0)
- ;;>>>D QOPEN^C0CXPATH("GBL","GXML","//FIRST/SECOND")
-"RTN","C0CXPAT0",149,0)
- ;;>>?$P(GBL(1),";",3)=11
-"RTN","C0CXPAT0",150,0)
+"RTN","C0CXPAT0",153,0)
+ ;;>>>D QCLOSE^C0CXPATH("GBL","GXML")
+"RTN","C0CXPAT0",154,0)
+ ;;>>?$P(GBL(1),";",3)=13
+"RTN","C0CXPAT0",155,0)
  ;;>>>D BUILD^C0CXPATH("GBL","G2")
-"RTN","C0CXPAT0",151,0)
- ;;>>?G2(G2(0))="</SECOND>"
-"RTN","C0CXPAT0",152,0)
- ;;><QCLOSE>
-"RTN","C0CXPAT0",153,0)
+"RTN","C0CXPAT0",156,0)
+ ;;>>?G2(G2(0))="</FIRST>"
+"RTN","C0CXPAT0",157,0)
+ ;;><QCLOSE2>
+"RTN","C0CXPAT0",158,0)
  ;;>>>K G2,GBL
-"RTN","C0CXPAT0",154,0)
+"RTN","C0CXPAT0",159,0)
  ;;>>>D ZTEST^C0CXPATH("INITXML")
-"RTN","C0CXPAT0",155,0)
- ;;>>>D QCLOSE^C0CXPATH("GBL","GXML")
-"RTN","C0CXPAT0",156,0)
+"RTN","C0CXPAT0",160,0)
+ ;;>>>D QCLOSE^C0CXPATH("GBL","GXML","//FIRST/SECOND/THIRD")
+"RTN","C0CXPAT0",161,0)
  ;;>>?$P(GBL(1),";",3)=13
-"RTN","C0CXPAT0",157,0)
+"RTN","C0CXPAT0",162,0)
  ;;>>>D BUILD^C0CXPATH("GBL","G2")
-"RTN","C0CXPAT0",158,0)
+"RTN","C0CXPAT0",163,0)
  ;;>>?G2(G2(0))="</FIRST>"
-"RTN","C0CXPAT0",159,0)
- ;;><QCLOSE2>
-"RTN","C0CXPAT0",160,0)
- ;;>>>K G2,GBL
-"RTN","C0CXPAT0",161,0)
+"RTN","C0CXPAT0",164,0)
+ ;;>>?G2(1)="</THIRD>"
+"RTN","C0CXPAT0",165,0)
+ ;;><INSERT>
+"RTN","C0CXPAT0",166,0)
+ ;;>>>K G2,GBL,G3,G4
+"RTN","C0CXPAT0",167,0)
  ;;>>>D ZTEST^C0CXPATH("INITXML")
-"RTN","C0CXPAT0",162,0)
- ;;>>>D QCLOSE^C0CXPATH("GBL","GXML","//FIRST/SECOND/THIRD")
-"RTN","C0CXPAT0",163,0)
- ;;>>?$P(GBL(1),";",3)=13
-"RTN","C0CXPAT0",164,0)
- ;;>>>D BUILD^C0CXPATH("GBL","G2")
-"RTN","C0CXPAT0",165,0)
- ;;>>?G2(G2(0))="</FIRST>"
-"RTN","C0CXPAT0",166,0)
- ;;>>?G2(1)="</THIRD>"
-"RTN","C0CXPAT0",167,0)
- ;;><INSERT>
 "RTN","C0CXPAT0",168,0)
- ;;>>>K G2,GBL,G3,G4
+ ;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
 "RTN","C0CXPAT0",169,0)
+ ;;>>>D INSERT^C0CXPATH("GXML","G2","//FIRST/SECOND/THIRD")
+"RTN","C0CXPAT0",170,0)
+ ;;>>>D INSERT^C0CXPATH("G3","G2","//")
+"RTN","C0CXPAT0",171,0)
+ ;;>>?G2(1)=GXML(9)
+"RTN","C0CXPAT0",172,0)
+ ;;><REPLACE>
+"RTN","C0CXPAT0",173,0)
+ ;;>>>K G2,GBL,G3
+"RTN","C0CXPAT0",174,0)
  ;;>>>D ZTEST^C0CXPATH("INITXML")
-"RTN","C0CXPAT0",170,0)
+"RTN","C0CXPAT0",175,0)
  ;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
-"RTN","C0CXPAT0",171,0)
- ;;>>>D INSERT^C0CXPATH("GXML","G2","//FIRST/SECOND/THIRD")
-"RTN","C0CXPAT0",172,0)
- ;;>>>D INSERT^C0CXPATH("G3","G2","//")
-"RTN","C0CXPAT0",173,0)
- ;;>>?G2(1)=GXML(9)
-"RTN","C0CXPAT0",174,0)
- ;;><REPLACE>
-"RTN","C0CXPAT0",175,0)
- ;;>>>K G2,GBL,G3
 "RTN","C0CXPAT0",176,0)
+ ;;>>>D REPLACE^C0CXPATH("GXML","G2","//FIRST/SECOND")
+"RTN","C0CXPAT0",177,0)
+ ;;>>?GXML(2)="<FIFTH>"
+"RTN","C0CXPAT0",178,0)
+ ;;><INSINNER>
+"RTN","C0CXPAT0",179,0)
+ ;;>>>K GXML,G2,GBL,G3
+"RTN","C0CXPAT0",180,0)
  ;;>>>D ZTEST^C0CXPATH("INITXML")
-"RTN","C0CXPAT0",177,0)
- ;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
-"RTN","C0CXPAT0",178,0)
- ;;>>>D REPLACE^C0CXPATH("GXML","G2","//FIRST/SECOND")
-"RTN","C0CXPAT0",179,0)
- ;;>>?GXML(2)="<FIFTH>"
-"RTN","C0CXPAT0",180,0)
- ;;><INSINNER>
 "RTN","C0CXPAT0",181,0)
+ ;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD","G2")
+"RTN","C0CXPAT0",182,0)
+ ;;>>>D INSINNER^C0CXPATH("GXML","G2","//FIRST/SECOND/THIRD")
+"RTN","C0CXPAT0",183,0)
+ ;;>>?GXML(10)="<FIFTH>"
+"RTN","C0CXPAT0",184,0)
+ ;;><INSINNER2>
+"RTN","C0CXPAT0",185,0)
  ;;>>>K GXML,G2,GBL,G3
-"RTN","C0CXPAT0",182,0)
+"RTN","C0CXPAT0",186,0)
  ;;>>>D ZTEST^C0CXPATH("INITXML")
-"RTN","C0CXPAT0",183,0)
+"RTN","C0CXPAT0",187,0)
  ;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD","G2")
-"RTN","C0CXPAT0",184,0)
- ;;>>>D INSINNER^C0CXPATH("GXML","G2","//FIRST/SECOND/THIRD")
-"RTN","C0CXPAT0",185,0)
- ;;>>?GXML(10)="<FIFTH>"
-"RTN","C0CXPAT0",186,0)
- ;;><INSINNER2>
-"RTN","C0CXPAT0",187,0)
- ;;>>>K GXML,G2,GBL,G3
 "RTN","C0CXPAT0",188,0)
- ;;>>>D ZTEST^C0CXPATH("INITXML")
+ ;;>>>D INSINNER^C0CXPATH("G2","G2")
 "RTN","C0CXPAT0",189,0)
- ;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD","G2")
+ ;;>>?G2(8)="<FIFTH>"
 "RTN","C0CXPAT0",190,0)
- ;;>>>D INSINNER^C0CXPATH("G2","G2")
+ ;;><PUSHA>
 "RTN","C0CXPAT0",191,0)
- ;;>>?G2(8)="<FIFTH>"
+ ;;>>>K GTMP,GTMP2
 "RTN","C0CXPAT0",192,0)
- ;;><PUSHA>
+ ;;>>>N GTMP,GTMP2
 "RTN","C0CXPAT0",193,0)
+ ;;>>>D PUSH^C0CXPATH("GTMP","A")
+"RTN","C0CXPAT0",194,0)
+ ;;>>>D PUSH^C0CXPATH("GTMP2","B")
+"RTN","C0CXPAT0",195,0)
+ ;;>>>D PUSH^C0CXPATH("GTMP2","C")
+"RTN","C0CXPAT0",196,0)
+ ;;>>>D PUSHA^C0CXPATH("GTMP","GTMP2")
+"RTN","C0CXPAT0",197,0)
+ ;;>>?GTMP(3)="C"
+"RTN","C0CXPAT0",198,0)
+ ;;>>?GTMP(0)=3
+"RTN","C0CXPAT0",199,0)
+ ;;><H2ARY>
+"RTN","C0CXPAT0",200,0)
  ;;>>>K GTMP,GTMP2
-"RTN","C0CXPAT0",194,0)
- ;;>>>N GTMP,GTMP2
-"RTN","C0CXPAT0",195,0)
- ;;>>>D PUSH^C0CXPATH("GTMP","A")
-"RTN","C0CXPAT0",196,0)
- ;;>>>D PUSH^C0CXPATH("GTMP2","B")
-"RTN","C0CXPAT0",197,0)
- ;;>>>D PUSH^C0CXPATH("GTMP2","C")
-"RTN","C0CXPAT0",198,0)
- ;;>>>D PUSHA^C0CXPATH("GTMP","GTMP2")
-"RTN","C0CXPAT0",199,0)
- ;;>>?GTMP(3)="C"
-"RTN","C0CXPAT0",200,0)
- ;;>>?GTMP(0)=3
 "RTN","C0CXPAT0",201,0)
- ;;><H2ARY>
+ ;;>>>S GTMP("TEST1")=1
 "RTN","C0CXPAT0",202,0)
+ ;;>>>D H2ARY^C0CXPATH("GTMP2","GTMP")
+"RTN","C0CXPAT0",203,0)
+ ;;>>?GTMP2(0)=1
+"RTN","C0CXPAT0",204,0)
+ ;;>>?GTMP2(1)="^TEST1^1"
+"RTN","C0CXPAT0",205,0)
+ ;;><XVARS>
+"RTN","C0CXPAT0",206,0)
  ;;>>>K GTMP,GTMP2
-"RTN","C0CXPAT0",203,0)
- ;;>>>S GTMP("TEST1")=1
-"RTN","C0CXPAT0",204,0)
- ;;>>>D H2ARY^C0CXPATH("GTMP2","GTMP")
-"RTN","C0CXPAT0",205,0)
- ;;>>?GTMP2(0)=1
-"RTN","C0CXPAT0",206,0)
- ;;>>?GTMP2(1)="^TEST1^1"
 "RTN","C0CXPAT0",207,0)
- ;;><XVARS>
+ ;;>>>D PUSH^C0CXPATH("GTMP","<VALUE>@@VAR1@@</VALUE>")
 "RTN","C0CXPAT0",208,0)
- ;;>>>K GTMP,GTMP2
+ ;;>>>D XVARS^C0CXPATH("GTMP2","GTMP")
 "RTN","C0CXPAT0",209,0)
- ;;>>>D PUSH^C0CXPATH("GTMP","<VALUE>@@VAR1@@</VALUE>")
+ ;;>>?GTMP2(1)="^VAR1^1"
 "RTN","C0CXPAT0",210,0)
- ;;>>>D XVARS^C0CXPATH("GTMP2","GTMP")
-"RTN","C0CXPAT0",211,0)
- ;;>>?GTMP2(1)="^VAR1^1"
-"RTN","C0CXPAT0",212,0)
  ;;></TEST>
 "RTN","C0CXPATH")
-0^34^B521207435
+0^34^B518646177
 "RTN","C0CXPATH",1,0)
 C0CXPATH   ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
 "RTN","C0CXPATH",2,0)
- ;;1.2;C0C;;May 11, 2012;Build 50
+ ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 51
 "RTN","C0CXPATH",3,0)
- ;Copyright 2008 George Lilly.  Licensed under the terms of the GNU
+ ;Copyright 2008 George Lilly.  
 "RTN","C0CXPATH",4,0)
- ;General Public License See attached copy of the License.
+ ;
 "RTN","C0CXPATH",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
 "RTN","C0CXPATH",6,0)
- ;This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU Affero General Public License as
 "RTN","C0CXPATH",7,0)
- ;it under the terms of the GNU General Public License as published by
+ ; published by the Free Software Foundation, either version 3 of the
 "RTN","C0CXPATH",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
+ ; License, or (at your option) any later version.
 "RTN","C0CXPATH",9,0)
- ;(at your option) any later version.
+ ;
 "RTN","C0CXPATH",10,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
 "RTN","C0CXPATH",11,0)
- ;This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 "RTN","C0CXPATH",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 "RTN","C0CXPATH",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU Affero General Public License for more details.
 "RTN","C0CXPATH",14,0)
- ;GNU General Public License for more details.
+ ;
 "RTN","C0CXPATH",15,0)
- ;
+ ; You should have received a copy of the GNU Affero General Public License
 "RTN","C0CXPATH",16,0)
- ;You should have received a copy of the GNU General Public License along
+ ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 "RTN","C0CXPATH",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;
 "RTN","C0CXPATH",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ W "This is an XML XPATH utility library",!
 "RTN","C0CXPATH",19,0)
- ;
+ W !
 "RTN","C0CXPATH",20,0)
- W "This is an XML XPATH utility library",!
+ Q
 "RTN","C0CXPATH",21,0)
- W !
+ ;
 "RTN","C0CXPATH",22,0)
+OUTPUT(OUTARY,OUTNAME,OUTDIR)   ; WRITE AN ARRAY TO A FILE
+"RTN","C0CXPATH",23,0)
+ ;
+"RTN","C0CXPATH",24,0)
+ N Y
+"RTN","C0CXPATH",25,0)
+ S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)
+"RTN","C0CXPATH",26,0)
+ I Y Q 1_U_"WROTE FILE: "_OUTNAME_" TO "_OUTDIR
+"RTN","C0CXPATH",27,0)
+ I 'Y Q 0_U_"ERROR WRITING FILE"_OUTNAME_" TO "_OUTDIR
+"RTN","C0CXPATH",28,0)
  Q
-"RTN","C0CXPATH",23,0)
- ;
-"RTN","C0CXPATH",24,0)
-OUTPUT(OUTARY,OUTNAME,OUTDIR)   ; WRITE AN ARRAY TO A FILE
-"RTN","C0CXPATH",25,0)
- ;
-"RTN","C0CXPATH",26,0)
- N Y
-"RTN","C0CXPATH",27,0)
- S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)
-"RTN","C0CXPATH",28,0)
- I Y Q 1_U_"WROTE FILE: "_OUTNAME_" TO "_OUTDIR
 "RTN","C0CXPATH",29,0)
- I 'Y Q 0_U_"ERROR WRITING FILE"_OUTNAME_" TO "_OUTDIR
+ ;
 "RTN","C0CXPATH",30,0)
+PUSH(STK,VAL)   ; pushs VAL onto STK and updates STK(0)
+"RTN","C0CXPATH",31,0)
+ ;  VAL IS A STRING AND STK IS PASSED BY NAME
+"RTN","C0CXPATH",32,0)
+ ;
+"RTN","C0CXPATH",33,0)
+ I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE
+"RTN","C0CXPATH",34,0)
+ S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH
+"RTN","C0CXPATH",35,0)
+ S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY
+"RTN","C0CXPATH",36,0)
  Q
-"RTN","C0CXPATH",31,0)
- ;
-"RTN","C0CXPATH",32,0)
-PUSH(STK,VAL)   ; pushs VAL onto STK and updates STK(0)
-"RTN","C0CXPATH",33,0)
- ;  VAL IS A STRING AND STK IS PASSED BY NAME
-"RTN","C0CXPATH",34,0)
- ;
-"RTN","C0CXPATH",35,0)
- I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE
-"RTN","C0CXPATH",36,0)
- S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH
 "RTN","C0CXPATH",37,0)
- S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY
+ ;
 "RTN","C0CXPATH",38,0)
+POP(STK,VAL)    ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
+"RTN","C0CXPATH",39,0)
+ ; VAL AND STK ARE PASSED BY REFERENCE
+"RTN","C0CXPATH",40,0)
+ ;
+"RTN","C0CXPATH",41,0)
+ I @STK@(0)<1 D  ; IF ARRAY IS EMPTY
+"RTN","C0CXPATH",42,0)
+ . S VAL=""
+"RTN","C0CXPATH",43,0)
+ . S @STK@(0)=0
+"RTN","C0CXPATH",44,0)
+ I @STK@(0)>0  D  ;
+"RTN","C0CXPATH",45,0)
+ . S VAL=@STK@(@STK@(0))
+"RTN","C0CXPATH",46,0)
+ . K @STK@(@STK@(0))
+"RTN","C0CXPATH",47,0)
+ . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY
+"RTN","C0CXPATH",48,0)
  Q
-"RTN","C0CXPATH",39,0)
- ;
-"RTN","C0CXPATH",40,0)
-POP(STK,VAL)    ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
-"RTN","C0CXPATH",41,0)
- ; VAL AND STK ARE PASSED BY REFERENCE
-"RTN","C0CXPATH",42,0)
- ;
-"RTN","C0CXPATH",43,0)
- I @STK@(0)<1 D  ; IF ARRAY IS EMPTY
-"RTN","C0CXPATH",44,0)
- . S VAL=""
-"RTN","C0CXPATH",45,0)
- . S @STK@(0)=0
-"RTN","C0CXPATH",46,0)
- I @STK@(0)>0  D  ;
-"RTN","C0CXPATH",47,0)
- . S VAL=@STK@(@STK@(0))
-"RTN","C0CXPATH",48,0)
- . K @STK@(@STK@(0))
 "RTN","C0CXPATH",49,0)
- . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY
+ ;
 "RTN","C0CXPATH",50,0)
+PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME
+"RTN","C0CXPATH",51,0)
+ ;
+"RTN","C0CXPATH",52,0)
+ N ZGI
+"RTN","C0CXPATH",53,0)
+ F ZGI=1:1:@ASRC@(0) D  ; FOR ALL OF THE SOURCE ARRAY
+"RTN","C0CXPATH",54,0)
+ . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT
+"RTN","C0CXPATH",55,0)
  Q
-"RTN","C0CXPATH",51,0)
- ;
-"RTN","C0CXPATH",52,0)
-PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME
-"RTN","C0CXPATH",53,0)
- ;
-"RTN","C0CXPATH",54,0)
- N ZGI
-"RTN","C0CXPATH",55,0)
- F ZGI=1:1:@ASRC@(0) D  ; FOR ALL OF THE SOURCE ARRAY
 "RTN","C0CXPATH",56,0)
- . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT
+ ;
 "RTN","C0CXPATH",57,0)
+MKMDX(STK,RTN,INREDUX)  ; MAKES A MUMPS INDEX FROM THE ARRAY STK
+"RTN","C0CXPATH",58,0)
+ ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS
+"RTN","C0CXPATH",59,0)
+ ; REDUX IS A STRING TO REMOVE FROM THE RESULT
+"RTN","C0CXPATH",60,0)
+ S RTN=""
+"RTN","C0CXPATH",61,0)
+ N I
+"RTN","C0CXPATH",62,0)
+ ; W "STK= ",STK,!
+"RTN","C0CXPATH",63,0)
+ I @STK@(0)>0  D  ; IF THE ARRAY IS NOT EMPTY
+"RTN","C0CXPATH",64,0)
+ . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
+"RTN","C0CXPATH",65,0)
+ . I @STK@(0)>1  D  ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
+"RTN","C0CXPATH",66,0)
+ . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
+"RTN","C0CXPATH",67,0)
+ I $G(INREDUX)'="" S RTN=$P(RTN,INREDUX,1)_$P(RTN,INREDUX,2)
+"RTN","C0CXPATH",68,0)
  Q
-"RTN","C0CXPATH",58,0)
- ;
-"RTN","C0CXPATH",59,0)
-MKMDX(STK,RTN,INREDUX)  ; MAKES A MUMPS INDEX FROM THE ARRAY STK
-"RTN","C0CXPATH",60,0)
- ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS
-"RTN","C0CXPATH",61,0)
- ; REDUX IS A STRING TO REMOVE FROM THE RESULT
-"RTN","C0CXPATH",62,0)
- S RTN=""
-"RTN","C0CXPATH",63,0)
+"RTN","C0CXPATH",69,0)
+ ;
+"RTN","C0CXPATH",70,0)
+XNAME(ISTR)     ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
+"RTN","C0CXPATH",71,0)
+ ;  </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
+"RTN","C0CXPATH",72,0)
+ ; ISTR IS PASSED BY VALUE
+"RTN","C0CXPATH",73,0)
+ N CUR,TMP
+"RTN","C0CXPATH",74,0)
+ I ISTR?.E1"<".E  D  ; STRIP OFF LEFT BRACKET
+"RTN","C0CXPATH",75,0)
+ . S TMP=$P(ISTR,"<",2)
+"RTN","C0CXPATH",76,0)
+ I TMP?1"/".E  D  ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
+"RTN","C0CXPATH",77,0)
+ . S TMP=$P(TMP,"/",2)
+"RTN","C0CXPATH",78,0)
+ S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
+"RTN","C0CXPATH",79,0)
+ ; W "CUR= ",CUR,!
+"RTN","C0CXPATH",80,0)
+ I CUR?.1"_"1.A1" ".E  D  ; CONTAINS A BLANK IE NAME ID=TEST>
+"RTN","C0CXPATH",81,0)
+ . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
+"RTN","C0CXPATH",82,0)
+ ; W "CUR2= ",CUR,!
+"RTN","C0CXPATH",83,0)
+ Q CUR
+"RTN","C0CXPATH",84,0)
+ ;
+"RTN","C0CXPATH",85,0)
+XVAL(ISTR) ; EXTRACTS THE VALUE FROM A FRAGMENT OF XML
+"RTN","C0CXPATH",86,0)
+ ; <NAME>VALUE</NAME> WILL RETURN VALUE
+"RTN","C0CXPATH",87,0)
+ N G
+"RTN","C0CXPATH",88,0)
+ S G=$P(ISTR,">",2) ;STRIP OFF <NAME>
+"RTN","C0CXPATH",89,0)
+ Q $P(G,"<",1) ; STRIP OFF </NAME> LEAVING VALUE
+"RTN","C0CXPATH",90,0)
+ ;
+"RTN","C0CXPATH",91,0)
+VDX2VDV(OUTVDV,INVDX) ; CONVERT AN VDX ARRAY TO VDV
+"RTN","C0CXPATH",92,0)
+ ; VDX: @INVDX@(XPATH)=VALUE
+"RTN","C0CXPATH",93,0)
+ ; VDV: @OUTVDV@(X1X2X3X4)=VALUE
+"RTN","C0CXPATH",94,0)
+ ; THE VDV DATANAMES MIGHT BE MORE CONVENIENT FOR USE IN CODE
+"RTN","C0CXPATH",95,0)
+ ; AN INDEX IS PROVIDED TO GO BACK TO VDX FOR CONVERSIONS
+"RTN","C0CXPATH",96,0)
+ ; @VDV@("XPATH",X1X2X3X4)="XPATH"
+"RTN","C0CXPATH",97,0)
+ N ZA,ZI,ZW
+"RTN","C0CXPATH",98,0)
+ S ZI=""
+"RTN","C0CXPATH",99,0)
+ F  S ZI=$O(@INVDX@(ZI)) Q:ZI=""  D  ;
+"RTN","C0CXPATH",100,0)
+ . S ZW=$TR(ZI,"/","") ; ELIMINATE ALL SLASHES - CAMEL CASE VARIABLE NAME
+"RTN","C0CXPATH",101,0)
+ . W ZW,!
+"RTN","C0CXPATH",102,0)
+ . S @OUTVDV@(ZW)=@INVDX@(ZI)
+"RTN","C0CXPATH",103,0)
+ . S @OUTVDV@("XPATH",ZW)=ZI
+"RTN","C0CXPATH",104,0)
+ Q
+"RTN","C0CXPATH",105,0)
+ ;
+"RTN","C0CXPATH",106,0)
+VDX2XPG(OUTXPG,INVDX) ; CONVERT AN VDX ARRAY TO XPG
+"RTN","C0CXPATH",107,0)
+ ; VDX: @VDX@(XPATH)=VALUE
+"RTN","C0CXPATH",108,0)
+ ; XPG: @(VDX(X1,X2,X3,X4))@=VALUE
+"RTN","C0CXPATH",109,0)
+ ; THIS IS A STEP TOWARD GENERATING XML FROM A VDX
+"RTN","C0CXPATH",110,0)
+ N ZA,ZI,ZW
+"RTN","C0CXPATH",111,0)
+ S ZI=""
+"RTN","C0CXPATH",112,0)
+ F  S ZI=$O(@INVDX@(ZI)) Q:ZI=""  D  ;
+"RTN","C0CXPATH",113,0)
+ . S ZW=$E(ZI,3,$L(ZI)) ; STRIP OFF INITIAL //
+"RTN","C0CXPATH",114,0)
+ . S ZW2=$P(ZW,"/",1)
+"RTN","C0CXPATH",115,0)
+ . F ZK=1:1:$L(ZW,"/") D PUSH("ZA",$P(ZW,"/",ZK))
+"RTN","C0CXPATH",116,0)
+ . ;ZWR ZA
+"RTN","C0CXPATH",117,0)
+ . S ZW2=ZA(1)
+"RTN","C0CXPATH",118,0)
+ . F ZK=2:1:ZA(0) D  ;
+"RTN","C0CXPATH",119,0)
+ . . S ZW2=ZW2_""","""_ZA(ZK)
+"RTN","C0CXPATH",120,0)
+ . K ZA
+"RTN","C0CXPATH",121,0)
+ . S ZW2=""""_ZW2_""""
+"RTN","C0CXPATH",122,0)
+ . W ZW2,!
+"RTN","C0CXPATH",123,0)
+ . S ZN=OUTXPG_"("_ZW2_")"
+"RTN","C0CXPATH",124,0)
+ . S @ZN=@INVDX@(ZI)
+"RTN","C0CXPATH",125,0)
+ Q
+"RTN","C0CXPATH",126,0)
+ ;
+"RTN","C0CXPATH",127,0)
+XML2XPG(OUTXPG,INXML) ; CONVERT AN XML ARRAY, PASSED BY NAME TO AN XPG ARRAY
+"RTN","C0CXPATH",128,0)
+ ; XPG MEANS XPATH GLOBAL AND HAS THE FORM @OUTXPG@("X1","X2","X3")=VALUE
+"RTN","C0CXPATH",129,0)
+ ;
+"RTN","C0CXPATH",130,0)
+ ;N G1
+"RTN","C0CXPATH",131,0)
+ D INDEX(INXML,"G1",1) ; PRODUCES A VDX ARRAY IN G1, NO INDEX IS PRODUCED
+"RTN","C0CXPATH",132,0)
+ D VDX2XPG(OUTXPG,"G1") ; CONVERTS THE VDX ARRAY TO XPG FORM
+"RTN","C0CXPATH",133,0)
+ Q
+"RTN","C0CXPATH",134,0)
+ ;
+"RTN","C0CXPATH",135,0)
+DO ;
+"RTN","C0CXPATH",136,0)
+ D XPG2XML("^GPL2B","^GPL2A")
+"RTN","C0CXPATH",137,0)
+ Q
+"RTN","C0CXPATH",138,0)
+ ;
+"RTN","C0CXPATH",139,0)
+T1 ; TEST OUT THESE ROUTINES 
+"RTN","C0CXPATH",140,0)
+ D XML2XPG("G2","^GPL")
+"RTN","C0CXPATH",141,0)
+ D XPG2XML("G3","G2")
+"RTN","C0CXPATH",142,0)
+ K ^GPLOUT
+"RTN","C0CXPATH",143,0)
+ M ^GPLOUT=G3
+"RTN","C0CXPATH",144,0)
+ W $$OUTPUT^C0CXPATH("^GPLOUT(1)","GPLTEST.xml","/home/vademo2/EHR/p")
+"RTN","C0CXPATH",145,0)
+ Q
+"RTN","C0CXPATH",146,0)
+ ;
+"RTN","C0CXPATH",147,0)
+XPG2XML(OUTXML,INXPG) ;
+"RTN","C0CXPATH",148,0)
+ N C0CN,FWD,ZA,G,GA,ZQ
+"RTN","C0CXPATH",149,0)
+ S ZQ=0 ; QUIT FLAG
+"RTN","C0CXPATH",150,0)
+ F  Q:ZQ=1  D  ; LOOP THROUGH EVERYTHING
+"RTN","C0CXPATH",151,0)
+ . I '$D(C0CN) D  ; FIRST TIME THROUGH
+"RTN","C0CXPATH",152,0)
+ . . K @OUTXML ; MAKE SURE OUTPUT ARRAY IS CLEAR
+"RTN","C0CXPATH",153,0)
+ . . S FWD=1 ; START OUT GOING FORWARD THROUGH SUBSCRIPTS
+"RTN","C0CXPATH",154,0)
+ . . S G=$Q(@INXPG) ; THIS ONE
+"RTN","C0CXPATH",155,0)
+ . . S GN=$Q(@G) ; NEXT ONE
+"RTN","C0CXPATH",156,0)
+ . . S C0CN=1 ; SUBSCRIPT COUNT
+"RTN","C0CXPATH",157,0)
+ . . S ZQ=0 ; QUIT FLAG
+"RTN","C0CXPATH",158,0)
+ . . D ZXO("?xml version=""1.0"" encoding=""UTF-8""?") ;MAKE IT REAL XML
+"RTN","C0CXPATH",159,0)
+ . . I $QS(G,1)="ContinuityOfCareRecord" D  ;
+"RTN","C0CXPATH",160,0)
+ . . . D ZXO("?xml-stylesheet type=""text/xsl"" href=""ccr.xsl""?") ; HACK TO MAKE THE CCR STYLESHEET WORK
+"RTN","C0CXPATH",161,0)
+ . I FWD D  ; GOING FORWARDS 
+"RTN","C0CXPATH",162,0)
+ . . I C0CN<$QL(G) D  ; NOT A DATA NODE
+"RTN","C0CXPATH",163,0)
+ . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT
+"RTN","C0CXPATH",164,0)
+ . . . D ZXO(ZA) ; AND OPEN AN XML ELEMENT
+"RTN","C0CXPATH",165,0)
+ . . . I @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord>" D  ;
+"RTN","C0CXPATH",166,0)
+ . . . . S @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord xmlns=""urn:astm-org:CCR"">"
+"RTN","C0CXPATH",167,0)
+ . . . S C0CN=C0CN+1 ; MOVE TO THE NEXT ONE
+"RTN","C0CXPATH",168,0)
+ . . E  D  ; AT THE DATA NODE
+"RTN","C0CXPATH",169,0)
+ . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT
+"RTN","C0CXPATH",170,0)
+ . . . D ZXVAL(ZA,@G) ; OUTPUT <X>VAL</X> FOR DATA NODE
+"RTN","C0CXPATH",171,0)
+ . . . S FWD=0 ; GO BACKWARDS
+"RTN","C0CXPATH",172,0)
+ . I 'FWD D  ;GOING BACKWARDS
+"RTN","C0CXPATH",173,0)
+ . . S GN=$Q(@G) ;NEXT XPATH
+"RTN","C0CXPATH",174,0)
+ . . ;W "NEXT!",GN,!
+"RTN","C0CXPATH",175,0)
+ . . S C0CN=C0CN-1 ; PREVIOUS SUBSCRIPT
+"RTN","C0CXPATH",176,0)
+ . . I GN'="" D  ;
+"RTN","C0CXPATH",177,0)
+ . . . I $QS(G,C0CN)'=$QS(GN,C0CN) D  ; NEED TO CLOSE OFF ELEMENT
+"RTN","C0CXPATH",178,0)
+ . . . . D ZXC($QS(G,C0CN)) ;
+"RTN","C0CXPATH",179,0)
+ . . . E  I GN'="" D  ; MORE ELEMENTS AT THIS LEVEL
+"RTN","C0CXPATH",180,0)
+ . . . . S G=$Q(@G) ; ADVANCE TO NEW XPATH
+"RTN","C0CXPATH",181,0)
+ . . . . S C0CN=C0CN+1 ; GET READY TO PROCESS NEXT SUBSCRIPT
+"RTN","C0CXPATH",182,0)
+ . . . . S FWD=1 ; GOING FORWARD NOW
+"RTN","C0CXPATH",183,0)
+ . I (GN="")&(C0CN=1) D  Q  ; WHEN WE ARE ALL DONE
+"RTN","C0CXPATH",184,0)
+ . . D ZXC($QS(G,C0CN)) ; LAST ONE
+"RTN","C0CXPATH",185,0)
+ . . S ZQ=1 ; QUIT NOW
+"RTN","C0CXPATH",186,0)
+ Q
+"RTN","C0CXPATH",187,0)
+ ;
+"RTN","C0CXPATH",188,0)
+ZXO(WHAT) ;
+"RTN","C0CXPATH",189,0)
+ D PUSH("GA",WHAT)
+"RTN","C0CXPATH",190,0)
+ D PUSH(OUTXML,"<"_WHAT_">")
+"RTN","C0CXPATH",191,0)
+ Q
+"RTN","C0CXPATH",192,0)
+ ;
+"RTN","C0CXPATH",193,0)
+ZXC(WHAT) ;
+"RTN","C0CXPATH",194,0)
+ D POP("GA",.TMP)
+"RTN","C0CXPATH",195,0)
+ D PUSH(OUTXML,"</"_WHAT_">")
+"RTN","C0CXPATH",196,0)
+ Q
+"RTN","C0CXPATH",197,0)
+ ;
+"RTN","C0CXPATH",198,0)
+ZXVAL(WHAT,VAL)  ;
+"RTN","C0CXPATH",199,0)
+ D PUSH(OUTXML,"<"_WHAT_">"_VAL_"</"_WHAT_">")
+"RTN","C0CXPATH",200,0)
+ Q
+"RTN","C0CXPATH",201,0)
+ ;
+"RTN","C0CXPATH",202,0)
+INDEX(IZXML,VDX,NOINX,TEMPLATE,REDUX) ; parse XML in IZXML and produce 
+"RTN","C0CXPATH",203,0)
+ ; an XPATH index; REDUX is a string to be removed from each xpath
+"RTN","C0CXPATH",204,0)
+ ; GPL 7/14/09 OPTIONALLY GENERATE AN XML TEMPLATE IF PASSED BY NAME
+"RTN","C0CXPATH",205,0)
+ ; TEMPLATE IS IDENTICAL TO THE PARSED XML LINE BY LINE
+"RTN","C0CXPATH",206,0)
+ ; EXCEPT THAT DATA VALUES ARE REPLACED WITH @@XPATH@@ FOR THE XPATH OF THE TAG
+"RTN","C0CXPATH",207,0)
+ ; GPL 5/24/09 AND OPTIONALLY PRODUCE THE VDX ARRAY PASSED BY NAME
+"RTN","C0CXPATH",208,0)
+ ; @VDX@("XPATH")=VALUE
+"RTN","C0CXPATH",209,0)
+ ; ex. @IZXML@("XPATH")=FIRSTLINE^LASTLINE
+"RTN","C0CXPATH",210,0)
+ ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
+"RTN","C0CXPATH",211,0)
+ ; XML SECTION
+"RTN","C0CXPATH",212,0)
+ ; IZXML IS PASSED BY NAME
+"RTN","C0CXPATH",213,0)
+ ; IF NOINX IS SET TO 1, NO INDEX WILL BE GENERATED, BUT THE VDX WILL BE
+"RTN","C0CXPATH",214,0)
+ N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND,CURVAL,DVDX,LCNT
+"RTN","C0CXPATH",215,0)
+ N C0CSTK ; LEAVE OUT FOR DEBUGGING
+"RTN","C0CXPATH",216,0)
+ I '$D(REDUX) S REDUX=""
+"RTN","C0CXPATH",217,0)
+ I '$D(NOINX) S NOINX=0 ; IF NOT PASSED, GENERATE AN INDEX
+"RTN","C0CXPATH",218,0)
+ N ZXML
+"RTN","C0CXPATH",219,0)
+ I NOINX S ZXML=$NA(^TMP("C0CINDEX",$J)) ; TEMP PLACE FOR INDEX TO DISCARD
+"RTN","C0CXPATH",220,0)
+ E  S ZXML=IZXML ; PLACE FOR INDEX TO KEEP
+"RTN","C0CXPATH",221,0)
+ I '$D(@IZXML@(0)) D  ; IF COUNT NOT IN NODE 0 COUNT THEM
+"RTN","C0CXPATH",222,0)
+ . S I="",LCNT=0
+"RTN","C0CXPATH",223,0)
+ . F  S I=$O(@IZXML@(I)) Q:I=""  S LCNT=LCNT+1
+"RTN","C0CXPATH",224,0)
+ E  S LCNT=@IZXML@(0) ; LINE COUNT PASSED IN ARRAY
+"RTN","C0CXPATH",225,0)
+ I LCNT=0  D  Q  ; NO XML PASSED
+"RTN","C0CXPATH",226,0)
+ . W "ERROR IN XML FILE",!
+"RTN","C0CXPATH",227,0)
+ S DVDX=0 ; DEFAULT DO NOT PRODUCE VDX INDEX
+"RTN","C0CXPATH",228,0)
+ I $D(VDX) S DVDX=1 ; IF NAME PASSED, DO VDX
+"RTN","C0CXPATH",229,0)
+ S C0CSTK(0)=0 ; INITIALIZE STACK
+"RTN","C0CXPATH",230,0)
+ K LKASD ; KILL LOOKASIDE ARRAY
+"RTN","C0CXPATH",231,0)
+ D MKLASD(.LKASD,IZXML) ;MAKE LOOK ASIDE BUFFER FOR MULTIPLES
+"RTN","C0CXPATH",232,0)
+ F I=1:1:LCNT  D  ; PROCESS THE ENTIRE ARRAY
+"RTN","C0CXPATH",233,0)
+ . S LINE=@IZXML@(I)
+"RTN","C0CXPATH",234,0)
+ . I $D(TEMPLATE) D  ;IF TEMPLATE IS REQUESTED
+"RTN","C0CXPATH",235,0)
+ . . S @TEMPLATE@(I)=$$CLEAN(LINE)
+"RTN","C0CXPATH",236,0)
+ . ;W LINE,!
+"RTN","C0CXPATH",237,0)
+ . S FOUND=0  ; INTIALIZED FOUND FLAG
+"RTN","C0CXPATH",238,0)
+ . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
+"RTN","C0CXPATH",239,0)
+ . I FOUND'=1  D
+"RTN","C0CXPATH",240,0)
+ . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E)  D
+"RTN","C0CXPATH",241,0)
+ . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
+"RTN","C0CXPATH",242,0)
+ . . . ; ON THE SAME LINE
+"RTN","C0CXPATH",243,0)
+ . . . ; W "FOUND ",LINE,!
+"RTN","C0CXPATH",244,0)
+ . . . S FOUND=1  ; SET FOUND FLAG
+"RTN","C0CXPATH",245,0)
+ . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+"RTN","C0CXPATH",246,0)
+ . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES
+"RTN","C0CXPATH",247,0)
+ . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK
+"RTN","C0CXPATH",248,0)
+ . . . D MKMDX("C0CSTK",.MDX,REDUX) ; GENERATE THE M INDEX
+"RTN","C0CXPATH",249,0)
+ . . . ; W "MDX=",MDX,!
+"RTN","C0CXPATH",250,0)
+ . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
+"RTN","C0CXPATH",251,0)
+ . . . . ;I '$D(ZDUP(MDX)) S ZDUP(MDX)=2
+"RTN","C0CXPATH",252,0)
+ . . . . ;E  S ZDUP(MDX)=ZDUP(MDX)+1
+"RTN","C0CXPATH",253,0)
+ . . . . ;W "DUP:",MDX,!
+"RTN","C0CXPATH",254,0)
+ . . . . ;I '$D(CURVAL) S CURVAL=""
+"RTN","C0CXPATH",255,0)
+ . . . . ;I DVDX S @VDX@(MDX_"["_ZDUP(MDX)_"]")=CURVAL
+"RTN","C0CXPATH",256,0)
+ . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
+"RTN","C0CXPATH",257,0)
+ . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
+"RTN","C0CXPATH",258,0)
+ . . . . S @ZXML@(MDX)=I_"^"_I  ; ADD INDEX ENTRY-FIRST AND LAST
+"RTN","C0CXPATH",259,0)
+ . . . . S CURVAL=$$XVAL(LINE) ; VALUE
+"RTN","C0CXPATH",260,0)
+ . . . . S $P(@ZXML@(MDX),"^",3)=CURVAL ; THIRD PIECE
+"RTN","C0CXPATH",261,0)
+ . . . . I DVDX S @VDX@(MDX)=CURVAL ; FILL IN VDX ARRAY IF REQUESTED
+"RTN","C0CXPATH",262,0)
+ . . . . I $D(TEMPLATE) D  ; IF TEMPLATE IS REQUESTED
+"RTN","C0CXPATH",263,0)
+ . . . . . S LINE=$$CLEAN(LINE) ; CLEAN OUT CONTROL CHARACTERS
+"RTN","C0CXPATH",264,0)
+ . . . . . S @TEMPLATE@(I)=$P(LINE,">",1)_">@@"_MDX_"@@</"_$P(LINE,"</",2)
+"RTN","C0CXPATH",265,0)
+ . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK
+"RTN","C0CXPATH",266,0)
+ . I FOUND'=1  D  ; THE LINE DOESN'T CONTAIN THE START AND END
+"RTN","C0CXPATH",267,0)
+ . . I LINE?.E1"</"1.E  D  ; LINE CONTAINS END OF A SECTION
+"RTN","C0CXPATH",268,0)
+ . . . ; W "FOUND ",LINE,!
+"RTN","C0CXPATH",269,0)
+ . . . S FOUND=1  ; SET FOUND FLAG
+"RTN","C0CXPATH",270,0)
+ . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+"RTN","C0CXPATH",271,0)
+ . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX
+"RTN","C0CXPATH",272,0)
+ . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
+"RTN","C0CXPATH",273,0)
+ . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK
+"RTN","C0CXPATH",274,0)
+ . . . S TMP=$P(TMP,"[",1) ; REMOVE [X] FROM MULTIPLE
+"RTN","C0CXPATH",275,0)
+ . . . I TMP'=CUR  D  ; MALFORMED XML, END MUST MATCH START
+"RTN","C0CXPATH",276,0)
+ . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
+"RTN","C0CXPATH",277,0)
+ . . . . D PARY("C0CSTK") ; PRINT OUT THE STACK FOR DEBUGING
+"RTN","C0CXPATH",278,0)
+ . . . . Q
+"RTN","C0CXPATH",279,0)
+ . I FOUND'=1  D  ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
+"RTN","C0CXPATH",280,0)
+ . . I (LINE?.E1"<"1.E)&(LINE'["?>")  D  ; BEGINNING OF A SECTION
+"RTN","C0CXPATH",281,0)
+ . . . ; W "FOUND ",LINE,!
+"RTN","C0CXPATH",282,0)
+ . . . S FOUND=1  ; SET FOUND FLAG
+"RTN","C0CXPATH",283,0)
+ . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+"RTN","C0CXPATH",284,0)
+ . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES
+"RTN","C0CXPATH",285,0)
+ . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK
+"RTN","C0CXPATH",286,0)
+ . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX
+"RTN","C0CXPATH",287,0)
+ . . . ; W "MDX=",MDX,!
+"RTN","C0CXPATH",288,0)
+ . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
+"RTN","C0CXPATH",289,0)
+ . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
+"RTN","C0CXPATH",290,0)
+ . . . . ;B
+"RTN","C0CXPATH",291,0)
+ . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
+"RTN","C0CXPATH",292,0)
+ . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
+"RTN","C0CXPATH",293,0)
+ S @ZXML@("INDEXED")=""
+"RTN","C0CXPATH",294,0)
+ S @ZXML@("//")="1^"_LCNT ; ROOT XPATH
+"RTN","C0CXPATH",295,0)
+ I NOINX K @ZXML ; DELETE UNWANTED INDEX
+"RTN","C0CXPATH",296,0)
+ Q
+"RTN","C0CXPATH",297,0)
+ ;
+"RTN","C0CXPATH",298,0)
+MKLASD(OUTBUF,INARY) ; CREATE A LOOKASIDE BUFFER FOR MULTILPLES
+"RTN","C0CXPATH",299,0)
+ ;
+"RTN","C0CXPATH",300,0)
+ N ZI,ZN,ZA,ZLINE,ZLINE2,CUR,CUR2
+"RTN","C0CXPATH",301,0)
+ F ZI=1:1:LCNT-1  D  ; PROCESS THE ENTIRE ARRAY 
+"RTN","C0CXPATH",302,0)
+ . S ZLINE=@IZXML@(ZI)
+"RTN","C0CXPATH",303,0)
+ . I ZI<LCNT S ZLINE2=@IZXML@(ZI+1)
+"RTN","C0CXPATH",304,0)
+ . I ZLINE?.E1"</"1.E  D  ; NEXT LINE CONTAINS END OF A SECTION
+"RTN","C0CXPATH",305,0)
+ . . S CUR=$$XNAME(ZLINE) ; EXTRACT THE NAME
+"RTN","C0CXPATH",306,0)
+ . . I (ZLINE2?.E1"<"1.E)&(ZLINE'["?>")  D  ; BEGINNING OF A SECTION
+"RTN","C0CXPATH",307,0)
+ . . . S CUR2=$$XNAME(ZLINE2) ; EXTRACT THE NAME 
+"RTN","C0CXPATH",308,0)
+ . . . I CUR=CUR2 D  ; IF THIS IS A MULTIPLE
+"RTN","C0CXPATH",309,0)
+ . . . . S OUTBUF(CUR,ZI+1)=""
+"RTN","C0CXPATH",310,0)
+ ;ZWR OUTBUF
+"RTN","C0CXPATH",311,0)
+ S ZI=""
+"RTN","C0CXPATH",312,0)
+ F  S ZI=$O(OUTBUF(ZI)) Q:ZI=""  D  ; FOR EACH KIND OF MULTIPLE
+"RTN","C0CXPATH",313,0)
+ . S ZN=$O(OUTBUF(ZI,"")) ; LINE NUMBER OF SECOND MULTIPLE
+"RTN","C0CXPATH",314,0)
+ . F  S ZN=$O(@IZXML@(ZN),-1) Q:ZN=""  I $E($P(@IZXML@(ZN),"<"_ZI,2),1,1)=">" Q  ;
+"RTN","C0CXPATH",315,0)
+ . S OUTBUF(ZI,ZN)=""
+"RTN","C0CXPATH",316,0)
+ S ZA=1,ZI="",ZN=""
+"RTN","C0CXPATH",317,0)
+ F  S ZI=$O(OUTBUF(ZI)) Q:ZI=""  D  ; ADDING THE COUNT FOR THE MULIPLES [x]
+"RTN","C0CXPATH",318,0)
+ . S ZN="",ZA=1
+"RTN","C0CXPATH",319,0)
+ . F  S ZN=$O(OUTBUF(ZI,ZN)) Q:ZN=""  D  ;
+"RTN","C0CXPATH",320,0)
+ . . S OUTBUF(ZI,ZN)="["_ZA_"]"
+"RTN","C0CXPATH",321,0)
+ . . S ZA=ZA+1
+"RTN","C0CXPATH",322,0)
+ Q
+"RTN","C0CXPATH",323,0)
+ ;
+"RTN","C0CXPATH",324,0)
+CLEAN(STR,TR) ; extrinsic function; returns string
+"RTN","C0CXPATH",325,0)
+ ;; Removes all non printable characters from a string.
+"RTN","C0CXPATH",326,0)
+ ;; STR by Value
+"RTN","C0CXPATH",327,0)
+ ;; TR IS OPTIONAL TO IMPROVE PERFORMANCE
+"RTN","C0CXPATH",328,0)
+ N TR,I
+"RTN","C0CXPATH",329,0)
+ I '$D(TR) D  ;
+"RTN","C0CXPATH",330,0)
+ . F I=0:1:31 S TR=$G(TR)_$C(I)
+"RTN","C0CXPATH",331,0)
+ . S TR=TR_$C(127)
+"RTN","C0CXPATH",332,0)
+ QUIT $TR(STR,TR)
+"RTN","C0CXPATH",333,0)
+ ;
+"RTN","C0CXPATH",334,0)
+QUERY(IARY,XPATH,OARY)  ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
+"RTN","C0CXPATH",335,0)
+ ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
+"RTN","C0CXPATH",336,0)
+ ; IARY AND OARY ARE PASSED BY NAME
+"RTN","C0CXPATH",337,0)
+ I '$D(@IARY@("INDEXED"))  D  ; INDEX IS NOT PRESENT IN IARY
+"RTN","C0CXPATH",338,0)
+ . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
+"RTN","C0CXPATH",339,0)
+ N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
+"RTN","C0CXPATH",340,0)
+ N TMP,I,J,QXPATH
+"RTN","C0CXPATH",341,0)
+ S FIRST=1
+"RTN","C0CXPATH",342,0)
+ I '$D(@IARY@(0)) D  ; LINE COUNT NOT IN ZERO NODE
+"RTN","C0CXPATH",343,0)
+ . S @IARY@(0)=$O(@IARY@("//"),-1) ; THIS SHOULD USUALLY WORK
+"RTN","C0CXPATH",344,0)
+ S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
+"RTN","C0CXPATH",345,0)
+ I XPATH'="//" D  ; NOT A ROOT QUERY
+"RTN","C0CXPATH",346,0)
+ . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
+"RTN","C0CXPATH",347,0)
+ . S FIRST=$P(TMP,"^",1)
+"RTN","C0CXPATH",348,0)
+ . S LAST=$P(TMP,"^",2)
+"RTN","C0CXPATH",349,0)
+ K @OARY
+"RTN","C0CXPATH",350,0)
+ S @OARY@(0)=+LAST-FIRST+1
+"RTN","C0CXPATH",351,0)
+ S J=1
+"RTN","C0CXPATH",352,0)
+ FOR I=FIRST:1:LAST  D
+"RTN","C0CXPATH",353,0)
+ . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
+"RTN","C0CXPATH",354,0)
+ . S J=J+1
+"RTN","C0CXPATH",355,0)
+ ; ZWR OARY
+"RTN","C0CXPATH",356,0)
+ Q
+"RTN","C0CXPATH",357,0)
+ ;
+"RTN","C0CXPATH",358,0)
+XF(IDX,XPATH)   ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
+"RTN","C0CXPATH",359,0)
+ ; INDEX WITH TWO PIECES START^FINISH
+"RTN","C0CXPATH",360,0)
+ ; IDX IS PASSED BY NAME
+"RTN","C0CXPATH",361,0)
+ Q $P(@IDX@(XPATH),"^",1)
+"RTN","C0CXPATH",362,0)
+ ;
+"RTN","C0CXPATH",363,0)
+XL(IDX,XPATH)   ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
+"RTN","C0CXPATH",364,0)
+ ; INDEX WITH TWO PIECES START^FINISH
+"RTN","C0CXPATH",365,0)
+ ; IDX IS PASSED BY NAME
+"RTN","C0CXPATH",366,0)
+ Q $P(@IDX@(XPATH),"^",2)
+"RTN","C0CXPATH",367,0)
+ ;
+"RTN","C0CXPATH",368,0)
+START(ISTR)     ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
+"RTN","C0CXPATH",369,0)
+ ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
+"RTN","C0CXPATH",370,0)
+ ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
+"RTN","C0CXPATH",371,0)
+ Q $P(ISTR,";",2)
+"RTN","C0CXPATH",372,0)
+ ;
+"RTN","C0CXPATH",373,0)
+FINISH(ISTR)    ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
+"RTN","C0CXPATH",374,0)
+ ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
+"RTN","C0CXPATH",375,0)
+ Q $P(ISTR,";",3)
+"RTN","C0CXPATH",376,0)
+ ;
+"RTN","C0CXPATH",377,0)
+ARRAY(ISTR)     ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
+"RTN","C0CXPATH",378,0)
+ ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
+"RTN","C0CXPATH",379,0)
+ Q $P(ISTR,";",1)
+"RTN","C0CXPATH",380,0)
+ ;
+"RTN","C0CXPATH",381,0)
+BUILD(BLIST,BDEST)      ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
+"RTN","C0CXPATH",382,0)
+ ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
+"RTN","C0CXPATH",383,0)
+ ; DEST IS CLEARED TO START
+"RTN","C0CXPATH",384,0)
+ ; USES PUSH TO DO THE COPY
+"RTN","C0CXPATH",385,0)
  N I
-"RTN","C0CXPATH",64,0)
- ; W "STK= ",STK,!
-"RTN","C0CXPATH",65,0)
- I @STK@(0)>0  D  ; IF THE ARRAY IS NOT EMPTY
-"RTN","C0CXPATH",66,0)
- . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
-"RTN","C0CXPATH",67,0)
- . I @STK@(0)>1  D  ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
-"RTN","C0CXPATH",68,0)
- . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
-"RTN","C0CXPATH",69,0)
- I $G(INREDUX)'="" S RTN=$P(RTN,INREDUX,1)_$P(RTN,INREDUX,2)
-"RTN","C0CXPATH",70,0)
+"RTN","C0CXPATH",386,0)
+ K @BDEST
+"RTN","C0CXPATH",387,0)
+ F I=1:1:@BLIST@(0) D  ; FOR EACH INSTRUCTION IN BLIST
+"RTN","C0CXPATH",388,0)
+ . N J,ATMP
+"RTN","C0CXPATH",389,0)
+ . S ATMP=$$ARRAY(@BLIST@(I))
+"RTN","C0CXPATH",390,0)
+ . I $G(DEBUG) W "ATMP=",ATMP,!
+"RTN","C0CXPATH",391,0)
+ . I $G(DEBUG) W @BLIST@(I),!
+"RTN","C0CXPATH",392,0)
+ . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D  ;
+"RTN","C0CXPATH",393,0)
+ . . ; FOR EACH LINE IN THIS INSTR
+"RTN","C0CXPATH",394,0)
+ . . I $G(DEBUG) W "BDEST= ",BDEST,!
+"RTN","C0CXPATH",395,0)
+ . . I $G(DEBUG) W "ATMP= ",@ATMP@(J),!
+"RTN","C0CXPATH",396,0)
+ . . D PUSH(BDEST,@ATMP@(J))
+"RTN","C0CXPATH",397,0)
  Q
-"RTN","C0CXPATH",71,0)
- ;
-"RTN","C0CXPATH",72,0)
-XNAME(ISTR)     ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
-"RTN","C0CXPATH",73,0)
- ;  </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
-"RTN","C0CXPATH",74,0)
- ; ISTR IS PASSED BY VALUE
-"RTN","C0CXPATH",75,0)
- N CUR,TMP
-"RTN","C0CXPATH",76,0)
- I ISTR?.E1"<".E  D  ; STRIP OFF LEFT BRACKET
-"RTN","C0CXPATH",77,0)
- . S TMP=$P(ISTR,"<",2)
-"RTN","C0CXPATH",78,0)
- I TMP?1"/".E  D  ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
-"RTN","C0CXPATH",79,0)
- . S TMP=$P(TMP,"/",2)
-"RTN","C0CXPATH",80,0)
- S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
-"RTN","C0CXPATH",81,0)
- ; W "CUR= ",CUR,!
-"RTN","C0CXPATH",82,0)
- I CUR?.1"_"1.A1" ".E  D  ; CONTAINS A BLANK IE NAME ID=TEST>
-"RTN","C0CXPATH",83,0)
- . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
-"RTN","C0CXPATH",84,0)
- ; W "CUR2= ",CUR,!
-"RTN","C0CXPATH",85,0)
- Q CUR
-"RTN","C0CXPATH",86,0)
- ;
-"RTN","C0CXPATH",87,0)
-XVAL(ISTR) ; EXTRACTS THE VALUE FROM A FRAGMENT OF XML
-"RTN","C0CXPATH",88,0)
- ; <NAME>VALUE</NAME> WILL RETURN VALUE
-"RTN","C0CXPATH",89,0)
- N G
-"RTN","C0CXPATH",90,0)
- S G=$P(ISTR,">",2) ;STRIP OFF <NAME>
-"RTN","C0CXPATH",91,0)
- Q $P(G,"<",1) ; STRIP OFF </NAME> LEAVING VALUE
-"RTN","C0CXPATH",92,0)
- ;
-"RTN","C0CXPATH",93,0)
-VDX2VDV(OUTVDV,INVDX) ; CONVERT AN VDX ARRAY TO VDV
-"RTN","C0CXPATH",94,0)
- ; VDX: @INVDX@(XPATH)=VALUE
-"RTN","C0CXPATH",95,0)
- ; VDV: @OUTVDV@(X1X2X3X4)=VALUE
-"RTN","C0CXPATH",96,0)
- ; THE VDV DATANAMES MIGHT BE MORE CONVENIENT FOR USE IN CODE
-"RTN","C0CXPATH",97,0)
- ; AN INDEX IS PROVIDED TO GO BACK TO VDX FOR CONVERSIONS
-"RTN","C0CXPATH",98,0)
- ; @VDV@("XPATH",X1X2X3X4)="XPATH"
-"RTN","C0CXPATH",99,0)
- N ZA,ZI,ZW
-"RTN","C0CXPATH",100,0)
- S ZI=""
-"RTN","C0CXPATH",101,0)
- F  S ZI=$O(@INVDX@(ZI)) Q:ZI=""  D  ;
-"RTN","C0CXPATH",102,0)
- . S ZW=$TR(ZI,"/","") ; ELIMINATE ALL SLASHES - CAMEL CASE VARIABLE NAME
-"RTN","C0CXPATH",103,0)
- . W ZW,!
-"RTN","C0CXPATH",104,0)
- . S @OUTVDV@(ZW)=@INVDX@(ZI)
-"RTN","C0CXPATH",105,0)
- . S @OUTVDV@("XPATH",ZW)=ZI
-"RTN","C0CXPATH",106,0)
+"RTN","C0CXPATH",398,0)
+ ;
+"RTN","C0CXPATH",399,0)
+QUEUE(BLST,ARRAY,FIRST,LAST)    ; ADD AN ENTRY TO A BLIST
+"RTN","C0CXPATH",400,0)
+ ;
+"RTN","C0CXPATH",401,0)
+ I $G(DEBUG) W "QUEUEING ",BLST,!
+"RTN","C0CXPATH",402,0)
+ D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
+"RTN","C0CXPATH",403,0)
  Q
-"RTN","C0CXPATH",107,0)
- ;
-"RTN","C0CXPATH",108,0)
-VDX2XPG(OUTXPG,INVDX) ; CONVERT AN VDX ARRAY TO XPG
-"RTN","C0CXPATH",109,0)
- ; VDX: @VDX@(XPATH)=VALUE
-"RTN","C0CXPATH",110,0)
- ; XPG: @(VDX(X1,X2,X3,X4))@=VALUE
-"RTN","C0CXPATH",111,0)
- ; THIS IS A STEP TOWARD GENERATING XML FROM A VDX
-"RTN","C0CXPATH",112,0)
- N ZA,ZI,ZW
-"RTN","C0CXPATH",113,0)
- S ZI=""
-"RTN","C0CXPATH",114,0)
- F  S ZI=$O(@INVDX@(ZI)) Q:ZI=""  D  ;
-"RTN","C0CXPATH",115,0)
- . S ZW=$E(ZI,3,$L(ZI)) ; STRIP OFF INITIAL //
-"RTN","C0CXPATH",116,0)
- . S ZW2=$P(ZW,"/",1)
-"RTN","C0CXPATH",117,0)
- . F ZK=1:1:$L(ZW,"/") D PUSH("ZA",$P(ZW,"/",ZK))
-"RTN","C0CXPATH",118,0)
- . ;ZWR ZA
-"RTN","C0CXPATH",119,0)
- . S ZW2=ZA(1)
-"RTN","C0CXPATH",120,0)
- . F ZK=2:1:ZA(0) D  ;
-"RTN","C0CXPATH",121,0)
- . . S ZW2=ZW2_""","""_ZA(ZK)
-"RTN","C0CXPATH",122,0)
- . K ZA
-"RTN","C0CXPATH",123,0)
- . S ZW2=""""_ZW2_""""
-"RTN","C0CXPATH",124,0)
- . W ZW2,!
-"RTN","C0CXPATH",125,0)
- . S ZN=OUTXPG_"("_ZW2_")"
-"RTN","C0CXPATH",126,0)
- . S @ZN=@INVDX@(ZI)
-"RTN","C0CXPATH",127,0)
+"RTN","C0CXPATH",404,0)
+ ;
+"RTN","C0CXPATH",405,0)
+CP(CPSRC,CPDEST)        ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
+"RTN","C0CXPATH",406,0)
+ ; KILLS CPDEST FIRST
+"RTN","C0CXPATH",407,0)
+ N CPINSTR
+"RTN","C0CXPATH",408,0)
+ I $G(DEBUG) W "MADE IT TO COPY",CPSRC,CPDEST,!
+"RTN","C0CXPATH",409,0)
+ I @CPSRC@(0)<1 D  ; BAD LENGTH
+"RTN","C0CXPATH",410,0)
+ . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
+"RTN","C0CXPATH",411,0)
+ . Q
+"RTN","C0CXPATH",412,0)
+ ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
+"RTN","C0CXPATH",413,0)
+ D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
+"RTN","C0CXPATH",414,0)
+ D BUILD("CPINSTR",CPDEST)
+"RTN","C0CXPATH",415,0)
  Q
-"RTN","C0CXPATH",128,0)
- ;
-"RTN","C0CXPATH",129,0)
-XML2XPG(OUTXPG,INXML) ; CONVERT AN XML ARRAY, PASSED BY NAME TO AN XPG ARRAY
-"RTN","C0CXPATH",130,0)
- ; XPG MEANS XPATH GLOBAL AND HAS THE FORM @OUTXPG@("X1","X2","X3")=VALUE
-"RTN","C0CXPATH",131,0)
- ;
-"RTN","C0CXPATH",132,0)
- ;N G1
-"RTN","C0CXPATH",133,0)
- D INDEX(INXML,"G1",1) ; PRODUCES A VDX ARRAY IN G1, NO INDEX IS PRODUCED
-"RTN","C0CXPATH",134,0)
- D VDX2XPG(OUTXPG,"G1") ; CONVERTS THE VDX ARRAY TO XPG FORM
-"RTN","C0CXPATH",135,0)
+"RTN","C0CXPATH",416,0)
+ ;
+"RTN","C0CXPATH",417,0)
+QOPEN(QOBLIST,QOXML,QOXPATH)    ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
+"RTN","C0CXPATH",418,0)
+ ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
+"RTN","C0CXPATH",419,0)
+ ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
+"RTN","C0CXPATH",420,0)
+ ; USED TO INSERT CHILDREN NODES
+"RTN","C0CXPATH",421,0)
+ I @QOXML@(0)<1 D  ; MALFORMED XML
+"RTN","C0CXPATH",422,0)
+ . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
+"RTN","C0CXPATH",423,0)
+ . Q
+"RTN","C0CXPATH",424,0)
+ I $G(DEBUG) W "DOING QOPEN",!
+"RTN","C0CXPATH",425,0)
+ N S1,E1,QOT,QOTMP
+"RTN","C0CXPATH",426,0)
+ S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
+"RTN","C0CXPATH",427,0)
+ I $D(QOXPATH) D  ; XPATH PROVIDED
+"RTN","C0CXPATH",428,0)
+ . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
+"RTN","C0CXPATH",429,0)
+ . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
+"RTN","C0CXPATH",430,0)
+ I '$D(QOXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
+"RTN","C0CXPATH",431,0)
+ . S E1=@QOXML@(0)-1
+"RTN","C0CXPATH",432,0)
+ D QUEUE(QOBLIST,QOXML,S1,E1)
+"RTN","C0CXPATH",433,0)
+ ; S QOTMP=QOXML_"^"_S1_"^"_E1
+"RTN","C0CXPATH",434,0)
+ ; D PUSH(QOBLIST,QOTMP)
+"RTN","C0CXPATH",435,0)
  Q
-"RTN","C0CXPATH",136,0)
- ;
-"RTN","C0CXPATH",137,0)
-DO 
-"RTN","C0CXPATH",138,0)
- D XPG2XML("^GPL2B","^GPL2A")
-"RTN","C0CXPATH",139,0)
+"RTN","C0CXPATH",436,0)
+ ;
+"RTN","C0CXPATH",437,0)
+QCLOSE(QCBLIST,QCXML,QCXPATH)   ; CLOSE XML AFTER A QOPEN
+"RTN","C0CXPATH",438,0)
+ ; ADDS THE LIST LINE OF QCXML TO QCBLIST
+"RTN","C0CXPATH",439,0)
+ ; USED TO FINISH INSERTING CHILDERN NODES
+"RTN","C0CXPATH",440,0)
+ ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
+"RTN","C0CXPATH",441,0)
+ ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
+"RTN","C0CXPATH",442,0)
+ I @QCXML@(0)<1 D  ; MALFORMED XML
+"RTN","C0CXPATH",443,0)
+ . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
+"RTN","C0CXPATH",444,0)
+ I $G(DEBUG) W "GOING TO CLOSE",!
+"RTN","C0CXPATH",445,0)
+ N S1,E1,QCT,QCTMP
+"RTN","C0CXPATH",446,0)
+ S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
+"RTN","C0CXPATH",447,0)
+ I $D(QCXPATH) D  ; XPATH PROVIDED
+"RTN","C0CXPATH",448,0)
+ . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
+"RTN","C0CXPATH",449,0)
+ . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
+"RTN","C0CXPATH",450,0)
+ I '$D(QCXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
+"RTN","C0CXPATH",451,0)
+ . S S1=@QCXML@(0)
+"RTN","C0CXPATH",452,0)
+ D QUEUE(QCBLIST,QCXML,S1,E1)
+"RTN","C0CXPATH",453,0)
+ ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
+"RTN","C0CXPATH",454,0)
  Q
-"RTN","C0CXPATH",140,0)
- ;
-"RTN","C0CXPATH",141,0)
-T1 ; TEST OUT THESE ROUTINES 
-"RTN","C0CXPATH",142,0)
- D XML2XPG("G2","^GPL")
-"RTN","C0CXPATH",143,0)
- D XPG2XML("G3","G2")
-"RTN","C0CXPATH",144,0)
- K ^GPLOUT
-"RTN","C0CXPATH",145,0)
- M ^GPLOUT=G3
-"RTN","C0CXPATH",146,0)
- W $$OUTPUT^C0CXPATH("^GPLOUT(1)","GPLTEST.xml","/home/vademo2/EHR/p")
-"RTN","C0CXPATH",147,0)
+"RTN","C0CXPATH",455,0)
+ ;
+"RTN","C0CXPATH",456,0)
+INSERT(INSXML,INSNEW,INSXPATH)  ; INSERT INSNEW INTO INSXML AT THE
+"RTN","C0CXPATH",457,0)
+ ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
+"RTN","C0CXPATH",458,0)
+ ; OMITTED, INSERTION WILL BE AT THE ROOT
+"RTN","C0CXPATH",459,0)
+ ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
+"RTN","C0CXPATH",460,0)
+ ; XML AT THE END OF THE XPATH POINT
+"RTN","C0CXPATH",461,0)
+ ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
+"RTN","C0CXPATH",462,0)
+ N INSBLD,INSTMP
+"RTN","C0CXPATH",463,0)
+ I $G(DEBUG) W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
+"RTN","C0CXPATH",464,0)
+ I $G(DEBUG) F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
+"RTN","C0CXPATH",465,0)
+ I '$D(@INSXML@(1)) D  ; INSERT INTO AN EMPTY ARRAY
+"RTN","C0CXPATH",466,0)
+ . D CP^C0CXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
+"RTN","C0CXPATH",467,0)
+ I $D(@INSXML@(1)) D  ; IF ORIGINAL ARRAY IS NOT EMPTY
+"RTN","C0CXPATH",468,0)
+ . I '$D(@INSXML@(0)) S @INSXML@(0)=$O(@INSXML@(""),-1) ;SET LENGTH
+"RTN","C0CXPATH",469,0)
+ . I $D(INSXPATH) D  ; XPATH PROVIDED
+"RTN","C0CXPATH",470,0)
+ . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
+"RTN","C0CXPATH",471,0)
+ . . I $G(DEBUG) D PARY^C0CXPATH("INSBLD")
+"RTN","C0CXPATH",472,0)
+ . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
+"RTN","C0CXPATH",473,0)
+ . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
+"RTN","C0CXPATH",474,0)
+ . I '$D(@INSNEW@(0)) S @INSNEW@(0)=$O(@INSNEW@(""),-1) ;SIZE OF XML
+"RTN","C0CXPATH",475,0)
+ . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
+"RTN","C0CXPATH",476,0)
+ . I $D(INSXPATH) D  ; XPATH PROVIDED
+"RTN","C0CXPATH",477,0)
+ . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
+"RTN","C0CXPATH",478,0)
+ . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
+"RTN","C0CXPATH",479,0)
+ . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
+"RTN","C0CXPATH",480,0)
+ . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
+"RTN","C0CXPATH",481,0)
+ . D CP^C0CXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
+"RTN","C0CXPATH",482,0)
  Q
-"RTN","C0CXPATH",148,0)
- ;
-"RTN","C0CXPATH",149,0)
-XPG2XML(OUTXML,INXPG) ;
-"RTN","C0CXPATH",150,0)
- N C0CN,FWD,ZA,G,GA,ZQ
-"RTN","C0CXPATH",151,0)
- S ZQ=0 ; QUIT FLAG
-"RTN","C0CXPATH",152,0)
- F  Q:ZQ=1  D  ; LOOP THROUGH EVERYTHING
-"RTN","C0CXPATH",153,0)
- . I '$D(C0CN) D  ; FIRST TIME THROUGH
-"RTN","C0CXPATH",154,0)
- . . K @OUTXML ; MAKE SURE OUTPUT ARRAY IS CLEAR
-"RTN","C0CXPATH",155,0)
- . . S FWD=1 ; START OUT GOING FORWARD THROUGH SUBSCRIPTS
-"RTN","C0CXPATH",156,0)
- . . S G=$Q(@INXPG) ; THIS ONE
-"RTN","C0CXPATH",157,0)
- . . S GN=$Q(@G) ; NEXT ONE
-"RTN","C0CXPATH",158,0)
- . . S C0CN=1 ; SUBSCRIPT COUNT
-"RTN","C0CXPATH",159,0)
- . . S ZQ=0 ; QUIT FLAG
-"RTN","C0CXPATH",160,0)
- . . D ZXO("?xml version=""1.0"" encoding=""UTF-8""?") ;MAKE IT REAL XML
-"RTN","C0CXPATH",161,0)
- . . I $QS(G,1)="ContinuityOfCareRecord" D  ;
-"RTN","C0CXPATH",162,0)
- . . . D ZXO("?xml-stylesheet type=""text/xsl"" href=""ccr.xsl""?") ; HACK TO MAKE THE CCR STYLESHEET WORK
-"RTN","C0CXPATH",163,0)
- . I FWD D  ; GOING FORWARDS 
-"RTN","C0CXPATH",164,0)
- . . I C0CN<$QL(G) D  ; NOT A DATA NODE
-"RTN","C0CXPATH",165,0)
- . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT
-"RTN","C0CXPATH",166,0)
- . . . D ZXO(ZA) ; AND OPEN AN XML ELEMENT
-"RTN","C0CXPATH",167,0)
- . . . I @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord>" D  ;
-"RTN","C0CXPATH",168,0)
- . . . . S @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord xmlns=""urn:astm-org:CCR"">"
-"RTN","C0CXPATH",169,0)
- . . . S C0CN=C0CN+1 ; MOVE TO THE NEXT ONE
-"RTN","C0CXPATH",170,0)
- . . E  D  ; AT THE DATA NODE
-"RTN","C0CXPATH",171,0)
- . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT
-"RTN","C0CXPATH",172,0)
- . . . D ZXVAL(ZA,@G) ; OUTPUT <X>VAL</X> FOR DATA NODE
-"RTN","C0CXPATH",173,0)
- . . . S FWD=0 ; GO BACKWARDS
-"RTN","C0CXPATH",174,0)
- . I 'FWD D  ;GOING BACKWARDS
-"RTN","C0CXPATH",175,0)
- . . S GN=$Q(@G) ;NEXT XPATH
-"RTN","C0CXPATH",176,0)
- . . ;W "NEXT!",GN,!
-"RTN","C0CXPATH",177,0)
- . . S C0CN=C0CN-1 ; PREVIOUS SUBSCRIPT
-"RTN","C0CXPATH",178,0)
- . . I GN'="" D  ;
-"RTN","C0CXPATH",179,0)
- . . . I $QS(G,C0CN)'=$QS(GN,C0CN) D  ; NEED TO CLOSE OFF ELEMENT
-"RTN","C0CXPATH",180,0)
- . . . . D ZXC($QS(G,C0CN)) ;
-"RTN","C0CXPATH",181,0)
- . . . E  I GN'="" D  ; MORE ELEMENTS AT THIS LEVEL
-"RTN","C0CXPATH",182,0)
- . . . . S G=$Q(@G) ; ADVANCE TO NEW XPATH
-"RTN","C0CXPATH",183,0)
- . . . . S C0CN=C0CN+1 ; GET READY TO PROCESS NEXT SUBSCRIPT
-"RTN","C0CXPATH",184,0)
- . . . . S FWD=1 ; GOING FORWARD NOW
-"RTN","C0CXPATH",185,0)
- . I (GN="")&(C0CN=1) D  Q  ; WHEN WE ARE ALL DONE
-"RTN","C0CXPATH",186,0)
- . . D ZXC($QS(G,C0CN)) ; LAST ONE
-"RTN","C0CXPATH",187,0)
- . . S ZQ=1 ; QUIT NOW
-"RTN","C0CXPATH",188,0)
+"RTN","C0CXPATH",483,0)
+ ;
+"RTN","C0CXPATH",484,0)
+INSINNER(INNXML,INNNEW,INNXPATH)        ; INSERT THE INNER XML OF INNNEW
+"RTN","C0CXPATH",485,0)
+ ; INTO INNXML AT THE INNXPATH XPATH POINT
+"RTN","C0CXPATH",486,0)
+ ;
+"RTN","C0CXPATH",487,0)
+ N INNBLD,UXPATH
+"RTN","C0CXPATH",488,0)
+ N INNTBUF
+"RTN","C0CXPATH",489,0)
+ S INNTBUF=$NA(^TMP($J,"INNTBUF"))
+"RTN","C0CXPATH",490,0)
+ I '$D(INNXPATH) D  ; XPATH NOT PASSED
+"RTN","C0CXPATH",491,0)
+ . S UXPATH="//" ; USE ROOT XPATH
+"RTN","C0CXPATH",492,0)
+ I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
+"RTN","C0CXPATH",493,0)
+ I '$D(@INNXML@(0)) D  ; INNXML IS EMPTY
+"RTN","C0CXPATH",494,0)
+ . D QUEUE^C0CXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
+"RTN","C0CXPATH",495,0)
+ . D BUILD("INNBLD",INNXML)
+"RTN","C0CXPATH",496,0)
+ I @INNXML@(0)>0  D  ; NOT EMPTY
+"RTN","C0CXPATH",497,0)
+ . D QOPEN("INNBLD",INNXML,UXPATH) ;
+"RTN","C0CXPATH",498,0)
+ . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
+"RTN","C0CXPATH",499,0)
+ . D QCLOSE("INNBLD",INNXML,UXPATH)
+"RTN","C0CXPATH",500,0)
+ . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
+"RTN","C0CXPATH",501,0)
+ . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
+"RTN","C0CXPATH",502,0)
  Q
-"RTN","C0CXPATH",189,0)
- ;
-"RTN","C0CXPATH",190,0)
-ZXO(WHAT) 
-"RTN","C0CXPATH",191,0)
- D PUSH("GA",WHAT)
-"RTN","C0CXPATH",192,0)
- D PUSH(OUTXML,"<"_WHAT_">")
-"RTN","C0CXPATH",193,0)
+"RTN","C0CXPATH",503,0)
+ ;
+"RTN","C0CXPATH",504,0)
+INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
+"RTN","C0CXPATH",505,0)
+ ; BUT XDEST AN XNEW ARE PASSED BY NAME
+"RTN","C0CXPATH",506,0)
+ N XBLD,XTMP
+"RTN","C0CXPATH",507,0)
+ D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
+"RTN","C0CXPATH",508,0)
+ D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
+"RTN","C0CXPATH",509,0)
+ D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
+"RTN","C0CXPATH",510,0)
+ D BUILD("XBLD","XTMP") ; BUILD THE RESULT
+"RTN","C0CXPATH",511,0)
+ D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
+"RTN","C0CXPATH",512,0)
+ I $G(DEBUG) D PARY("XDEST")
+"RTN","C0CXPATH",513,0)
  Q
-"RTN","C0CXPATH",194,0)
- ;
-"RTN","C0CXPATH",195,0)
-ZXC(WHAT) 
-"RTN","C0CXPATH",196,0)
- D POP("GA",.TMP)
-"RTN","C0CXPATH",197,0)
- D PUSH(OUTXML,"</"_WHAT_">")
-"RTN","C0CXPATH",198,0)
+"RTN","C0CXPATH",514,0)
+ ;
+"RTN","C0CXPATH",515,0)
+REPLACE(REXML,RENEW,REXPATH)    ; REPLACE THE XML AT THE XPATH POINT
+"RTN","C0CXPATH",516,0)
+ ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
+"RTN","C0CXPATH",517,0)
+ ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
+"RTN","C0CXPATH",518,0)
+ ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
+"RTN","C0CXPATH",519,0)
+ N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
+"RTN","C0CXPATH",520,0)
+ S OLD=$NA(^TMP($J,"REPLACE_OLD"))
+"RTN","C0CXPATH",521,0)
+ D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
+"RTN","C0CXPATH",522,0)
+ S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
+"RTN","C0CXPATH",523,0)
+ S XFIRST=$P(XNODE,"^",1)
+"RTN","C0CXPATH",524,0)
+ S XLAST=$P(XNODE,"^",2)
+"RTN","C0CXPATH",525,0)
+ I RENEW="" D  ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
+"RTN","C0CXPATH",526,0)
+ . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
+"RTN","C0CXPATH",527,0)
+ . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
+"RTN","C0CXPATH",528,0)
+ I RENEW'="" D  ; NEW XML IS NOT NULL
+"RTN","C0CXPATH",529,0)
+ . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
+"RTN","C0CXPATH",530,0)
+ . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
+"RTN","C0CXPATH",531,0)
+ . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
+"RTN","C0CXPATH",532,0)
+ I $G(DEBUG) W "REPLACE PREBUILD",!
+"RTN","C0CXPATH",533,0)
+ I $G(DEBUG) D PARY("REBLD")
+"RTN","C0CXPATH",534,0)
+ D BUILD("REBLD","RTMP")
+"RTN","C0CXPATH",535,0)
+ K @REXML ; KILL WHAT WAS THERE
+"RTN","C0CXPATH",536,0)
+ D CP("RTMP",REXML) ; COPY IN THE RESULT
+"RTN","C0CXPATH",537,0)
  Q
-"RTN","C0CXPATH",199,0)
- ;
-"RTN","C0CXPATH",200,0)
-ZXVAL(WHAT,VAL) 
-"RTN","C0CXPATH",201,0)
- D PUSH(OUTXML,"<"_WHAT_">"_VAL_"</"_WHAT_">")
-"RTN","C0CXPATH",202,0)
+"RTN","C0CXPATH",538,0)
+ ;
+"RTN","C0CXPATH",539,0)
+DELETE(REXML,REXPATH)    ; DELETE THE XML AT THE XPATH POINT
+"RTN","C0CXPATH",540,0)
+ ; REXML IS PASSED BY NAME XPATH IS A VALUE
+"RTN","C0CXPATH",541,0)
+ N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
+"RTN","C0CXPATH",542,0)
+ S OLD=$NA(^TMP($J,"REPLACE_OLD"))
+"RTN","C0CXPATH",543,0)
+ D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
+"RTN","C0CXPATH",544,0)
+ S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
+"RTN","C0CXPATH",545,0)
+ S XFIRST=$P(XNODE,"^",1)
+"RTN","C0CXPATH",546,0)
+ S XLAST=$P(XNODE,"^",2)
+"RTN","C0CXPATH",547,0)
+ D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
+"RTN","C0CXPATH",548,0)
+ D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
+"RTN","C0CXPATH",549,0)
+ I $G(DEBUG) D PARY("REBLD")
+"RTN","C0CXPATH",550,0)
+ D BUILD("REBLD","RTMP")
+"RTN","C0CXPATH",551,0)
+ K @REXML ; KILL WHAT WAS THERE
+"RTN","C0CXPATH",552,0)
+ D CP("RTMP",REXML) ; COPY IN THE RESULT
+"RTN","C0CXPATH",553,0)
  Q
-"RTN","C0CXPATH",203,0)
- ;
-"RTN","C0CXPATH",204,0)
-INDEX(IZXML,VDX,NOINX,TEMPLATE,REDUX) ; parse XML in IZXML and produce 
-"RTN","C0CXPATH",205,0)
- ; an XPATH index; REDUX is a string to be removed from each xpath
-"RTN","C0CXPATH",206,0)
- ; GPL 7/14/09 OPTIONALLY GENERATE AN XML TEMPLATE IF PASSED BY NAME
-"RTN","C0CXPATH",207,0)
- ; TEMPLATE IS IDENTICAL TO THE PARSED XML LINE BY LINE
-"RTN","C0CXPATH",208,0)
- ; EXCEPT THAT DATA VALUES ARE REPLACED WITH @@XPATH@@ FOR THE XPATH OF THE TAG
-"RTN","C0CXPATH",209,0)
- ; GPL 5/24/09 AND OPTIONALLY PRODUCE THE VDX ARRAY PASSED BY NAME
-"RTN","C0CXPATH",210,0)
- ; @VDX@("XPATH")=VALUE
-"RTN","C0CXPATH",211,0)
- ; ex. @IZXML@("XPATH")=FIRSTLINE^LASTLINE
-"RTN","C0CXPATH",212,0)
- ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
-"RTN","C0CXPATH",213,0)
- ; XML SECTION
-"RTN","C0CXPATH",214,0)
- ; IZXML IS PASSED BY NAME
-"RTN","C0CXPATH",215,0)
- ; IF NOINX IS SET TO 1, NO INDEX WILL BE GENERATED, BUT THE VDX WILL BE
-"RTN","C0CXPATH",216,0)
- N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND,CURVAL,DVDX,LCNT
-"RTN","C0CXPATH",217,0)
- N C0CSTK ; LEAVE OUT FOR DEBUGGING
-"RTN","C0CXPATH",218,0)
- I '$D(REDUX) S REDUX=""
-"RTN","C0CXPATH",219,0)
- I '$D(NOINX) S NOINX=0 ; IF NOT PASSED, GENERATE AN INDEX
-"RTN","C0CXPATH",220,0)
- N ZXML
-"RTN","C0CXPATH",221,0)
- I NOINX S ZXML=$NA(^TMP("C0CINDEX",$J)) ; TEMP PLACE FOR INDEX TO DISCARD
-"RTN","C0CXPATH",222,0)
- E  S ZXML=IZXML ; PLACE FOR INDEX TO KEEP
-"RTN","C0CXPATH",223,0)
- I '$D(@IZXML@(0)) D  ; IF COUNT NOT IN NODE 0 COUNT THEM
-"RTN","C0CXPATH",224,0)
- . S I="",LCNT=0
-"RTN","C0CXPATH",225,0)
- . F  S I=$O(@IZXML@(I)) Q:I=""  S LCNT=LCNT+1
-"RTN","C0CXPATH",226,0)
- E  S LCNT=@IZXML@(0) ; LINE COUNT PASSED IN ARRAY
-"RTN","C0CXPATH",227,0)
- I LCNT=0  D  Q  ; NO XML PASSED
-"RTN","C0CXPATH",228,0)
- . W "ERROR IN XML FILE",!
-"RTN","C0CXPATH",229,0)
- S DVDX=0 ; DEFAULT DO NOT PRODUCE VDX INDEX
-"RTN","C0CXPATH",230,0)
- I $D(VDX) S DVDX=1 ; IF NAME PASSED, DO VDX
-"RTN","C0CXPATH",231,0)
- S C0CSTK(0)=0 ; INITIALIZE STACK
-"RTN","C0CXPATH",232,0)
- K LKASD ; KILL LOOKASIDE ARRAY
-"RTN","C0CXPATH",233,0)
- D MKLASD(.LKASD,IZXML) ;MAKE LOOK ASIDE BUFFER FOR MULTIPLES
-"RTN","C0CXPATH",234,0)
- F I=1:1:LCNT  D  ; PROCESS THE ENTIRE ARRAY
-"RTN","C0CXPATH",235,0)
- . S LINE=@IZXML@(I)
-"RTN","C0CXPATH",236,0)
- . I $D(TEMPLATE) D  ;IF TEMPLATE IS REQUESTED
-"RTN","C0CXPATH",237,0)
- . . S @TEMPLATE@(I)=$$CLEAN(LINE) 
-"RTN","C0CXPATH",238,0)
- . ;W LINE,!
-"RTN","C0CXPATH",239,0)
- . S FOUND=0  ; INTIALIZED FOUND FLAG
-"RTN","C0CXPATH",240,0)
- . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
-"RTN","C0CXPATH",241,0)
- . I FOUND'=1  D
-"RTN","C0CXPATH",242,0)
- . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E)  D
-"RTN","C0CXPATH",243,0)
- . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
-"RTN","C0CXPATH",244,0)
- . . . ; ON THE SAME LINE
-"RTN","C0CXPATH",245,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","C0CXPATH",246,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","C0CXPATH",247,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","C0CXPATH",248,0)
- . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES
-"RTN","C0CXPATH",249,0)
- . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK
-"RTN","C0CXPATH",250,0)
- . . . D MKMDX("C0CSTK",.MDX,REDUX) ; GENERATE THE M INDEX
-"RTN","C0CXPATH",251,0)
- . . . ; W "MDX=",MDX,!
-"RTN","C0CXPATH",252,0)
- . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
-"RTN","C0CXPATH",253,0)
- . . . . ;I '$D(ZDUP(MDX)) S ZDUP(MDX)=2
-"RTN","C0CXPATH",254,0)
- . . . . ;E  S ZDUP(MDX)=ZDUP(MDX)+1
-"RTN","C0CXPATH",255,0)
- . . . . ;W "DUP:",MDX,!
-"RTN","C0CXPATH",256,0)
- . . . . ;I '$D(CURVAL) S CURVAL=""
-"RTN","C0CXPATH",257,0)
- . . . . ;I DVDX S @VDX@(MDX_"["_ZDUP(MDX)_"]")=CURVAL
-"RTN","C0CXPATH",258,0)
- . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","C0CXPATH",259,0)
- . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
-"RTN","C0CXPATH",260,0)
- . . . . S @ZXML@(MDX)=I_"^"_I  ; ADD INDEX ENTRY-FIRST AND LAST
-"RTN","C0CXPATH",261,0)
- . . . . S CURVAL=$$XVAL(LINE) ; VALUE
-"RTN","C0CXPATH",262,0)
- . . . . S $P(@ZXML@(MDX),"^",3)=CURVAL ; THIRD PIECE
-"RTN","C0CXPATH",263,0)
- . . . . I DVDX S @VDX@(MDX)=CURVAL ; FILL IN VDX ARRAY IF REQUESTED
-"RTN","C0CXPATH",264,0)
- . . . . I $D(TEMPLATE) D  ; IF TEMPLATE IS REQUESTED
-"RTN","C0CXPATH",265,0)
- . . . . . S LINE=$$CLEAN(LINE) ; CLEAN OUT CONTROL CHARACTERS
-"RTN","C0CXPATH",266,0)
- . . . . . S @TEMPLATE@(I)=$P(LINE,">",1)_">@@"_MDX_"@@</"_$P(LINE,"</",2)
-"RTN","C0CXPATH",267,0)
- . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK
-"RTN","C0CXPATH",268,0)
- . I FOUND'=1  D  ; THE LINE DOESN'T CONTAIN THE START AND END
-"RTN","C0CXPATH",269,0)
- . . I LINE?.E1"</"1.E  D  ; LINE CONTAINS END OF A SECTION
-"RTN","C0CXPATH",270,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","C0CXPATH",271,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","C0CXPATH",272,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","C0CXPATH",273,0)
- . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","C0CXPATH",274,0)
- . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","C0CXPATH",275,0)
- . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK
-"RTN","C0CXPATH",276,0)
- . . . S TMP=$P(TMP,"[",1) ; REMOVE [X] FROM MULTIPLE
-"RTN","C0CXPATH",277,0)
- . . . I TMP'=CUR  D  ; MALFORMED XML, END MUST MATCH START
-"RTN","C0CXPATH",278,0)
- . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
-"RTN","C0CXPATH",279,0)
- . . . . D PARY("C0CSTK") ; PRINT OUT THE STACK FOR DEBUGING
-"RTN","C0CXPATH",280,0)
- . . . . Q
-"RTN","C0CXPATH",281,0)
- . I FOUND'=1  D  ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
-"RTN","C0CXPATH",282,0)
- . . I (LINE?.E1"<"1.E)&(LINE'["?>")  D  ; BEGINNING OF A SECTION
-"RTN","C0CXPATH",283,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","C0CXPATH",284,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","C0CXPATH",285,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","C0CXPATH",286,0)
- . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES
-"RTN","C0CXPATH",287,0)
- . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK
-"RTN","C0CXPATH",288,0)
- . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","C0CXPATH",289,0)
- . . . ; W "MDX=",MDX,!
-"RTN","C0CXPATH",290,0)
- . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
-"RTN","C0CXPATH",291,0)
- . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","C0CXPATH",292,0)
- . . . . ;B
-"RTN","C0CXPATH",293,0)
- . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
-"RTN","C0CXPATH",294,0)
- . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
-"RTN","C0CXPATH",295,0)
- S @ZXML@("INDEXED")=""
-"RTN","C0CXPATH",296,0)
- S @ZXML@("//")="1^"_LCNT ; ROOT XPATH
-"RTN","C0CXPATH",297,0)
- I NOINX K @ZXML ; DELETE UNWANTED INDEX
-"RTN","C0CXPATH",298,0)
+"RTN","C0CXPATH",554,0)
+ ;
+"RTN","C0CXPATH",555,0)
+MISSING(IXML,OARY)      ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
+"RTN","C0CXPATH",556,0)
+ ; W "Reporting on the missing",!
+"RTN","C0CXPATH",557,0)
+ ; W OARY
+"RTN","C0CXPATH",558,0)
+ I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
+"RTN","C0CXPATH",559,0)
+ N I
+"RTN","C0CXPATH",560,0)
+ S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
+"RTN","C0CXPATH",561,0)
+ F I=1:1:@IXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
+"RTN","C0CXPATH",562,0)
+ . I @IXML@(I)?.E1"@@".E D  ; MISSING VARIABLE HERE
+"RTN","C0CXPATH",563,0)
+ . . D PUSH^C0CXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
+"RTN","C0CXPATH",564,0)
+ . . Q
+"RTN","C0CXPATH",565,0)
  Q
-"RTN","C0CXPATH",299,0)
- ;
-"RTN","C0CXPATH",300,0)
-MKLASD(OUTBUF,INARY) ; CREATE A LOOKASIDE BUFFER FOR MULTILPLES
-"RTN","C0CXPATH",301,0)
- ;
-"RTN","C0CXPATH",302,0)
- N ZI,ZN,ZA,ZLINE,ZLINE2,CUR,CUR2
-"RTN","C0CXPATH",303,0)
- F ZI=1:1:LCNT-1  D  ; PROCESS THE ENTIRE ARRAY 
-"RTN","C0CXPATH",304,0)
- . S ZLINE=@IZXML@(ZI)
-"RTN","C0CXPATH",305,0)
- . I ZI<LCNT S ZLINE2=@IZXML@(ZI+1)
-"RTN","C0CXPATH",306,0)
- . I ZLINE?.E1"</"1.E  D  ; NEXT LINE CONTAINS END OF A SECTION
-"RTN","C0CXPATH",307,0)
- . . S CUR=$$XNAME(ZLINE) ; EXTRACT THE NAME
-"RTN","C0CXPATH",308,0)
- . . I (ZLINE2?.E1"<"1.E)&(ZLINE'["?>")  D  ; BEGINNING OF A SECTION
-"RTN","C0CXPATH",309,0)
- . . . S CUR2=$$XNAME(ZLINE2) ; EXTRACT THE NAME 
-"RTN","C0CXPATH",310,0)
- . . . I CUR=CUR2 D  ; IF THIS IS A MULTIPLE
-"RTN","C0CXPATH",311,0)
- . . . . S OUTBUF(CUR,ZI+1)=""
-"RTN","C0CXPATH",312,0)
- ;ZWR OUTBUF
-"RTN","C0CXPATH",313,0)
- S ZI=""
-"RTN","C0CXPATH",314,0)
- F  S ZI=$O(OUTBUF(ZI)) Q:ZI=""  D  ; FOR EACH KIND OF MULTIPLE
-"RTN","C0CXPATH",315,0)
- . S ZN=$O(OUTBUF(ZI,"")) ; LINE NUMBER OF SECOND MULTIPLE
-"RTN","C0CXPATH",316,0)
- . F  S ZN=$O(@IZXML@(ZN),-1) Q:ZN=""  I $E($P(@IZXML@(ZN),"<"_ZI,2),1,1)=">" Q  ;
-"RTN","C0CXPATH",317,0)
- . S OUTBUF(ZI,ZN)=""
-"RTN","C0CXPATH",318,0)
- S ZA=1,ZI="",ZN=""
-"RTN","C0CXPATH",319,0)
- F  S ZI=$O(OUTBUF(ZI)) Q:ZI=""  D  ; ADDING THE COUNT FOR THE MULIPLES [x]
-"RTN","C0CXPATH",320,0)
- . S ZN="",ZA=1
-"RTN","C0CXPATH",321,0)
- . F  S ZN=$O(OUTBUF(ZI,ZN)) Q:ZN=""  D  ;
-"RTN","C0CXPATH",322,0)
- . . S OUTBUF(ZI,ZN)="["_ZA_"]"
-"RTN","C0CXPATH",323,0)
- . . S ZA=ZA+1
-"RTN","C0CXPATH",324,0)
+"RTN","C0CXPATH",566,0)
+ ;
+"RTN","C0CXPATH",567,0)
+MAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
+"RTN","C0CXPATH",568,0)
+ ; AND PUT THE RESULTS IN OXML
+"RTN","C0CXPATH",569,0)
+ N XCNT
+"RTN","C0CXPATH",570,0)
+ I '$D(DEBUG) S DEBUG=0
+"RTN","C0CXPATH",571,0)
+ I '$D(IXML) W "MALFORMED XML PASSED TO MAP",! Q
+"RTN","C0CXPATH",572,0)
+ I '$D(@IXML@(0)) D  ; INITIALIZE COUNT
+"RTN","C0CXPATH",573,0)
+ . S XCNT=$O(@IXML@(""),-1)
+"RTN","C0CXPATH",574,0)
+ E  S XCNT=@IXML@(0) ;COUNT
+"RTN","C0CXPATH",575,0)
+ I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
+"RTN","C0CXPATH",576,0)
+ N I,J,TNAM,TVAL,TSTR
+"RTN","C0CXPATH",577,0)
+ S @OXML@(0)=XCNT ; TOTAL LINES IN OUTPUT
+"RTN","C0CXPATH",578,0)
+ F I=1:1:XCNT  D   ; LOOP THROUGH WHOLE ARRAY
+"RTN","C0CXPATH",579,0)
+ . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
+"RTN","C0CXPATH",580,0)
+ . I @OXML@(I)?.E1"@@".E D  ; IS THERE A VARIABLE HERE?
+"RTN","C0CXPATH",581,0)
+ . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
+"RTN","C0CXPATH",582,0)
+ . . F J=2:2:10  D  Q:$P(@IXML@(I),"@@",J+2)=""  ; QUIT IF NO MORE VARS
+"RTN","C0CXPATH",583,0)
+ . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
+"RTN","C0CXPATH",584,0)
+ . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
+"RTN","C0CXPATH",585,0)
+ . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
+"RTN","C0CXPATH",586,0)
+ . . . I $D(@INARY@(TNAM))  D  ; IS THE VARIABLE IN THE MAP?
+"RTN","C0CXPATH",587,0)
+ . . . . I '$D(@INARY@(TNAM,"F")) D  ; NOT A SPECIAL FIELD
+"RTN","C0CXPATH",588,0)
+ . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
+"RTN","C0CXPATH",589,0)
+ . . . . E  D DOFLD ; PROCESS A FIELD
+"RTN","C0CXPATH",590,0)
+ . . . S TVAL=$$SYMENC^MXMLUTL(TVAL) ;MAKE SURE THE VALUE IS XML SAFE
+"RTN","C0CXPATH",591,0)
+ . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
+"RTN","C0CXPATH",592,0)
+ . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
+"RTN","C0CXPATH",593,0)
+ . . I DEBUG W TSTR
+"RTN","C0CXPATH",594,0)
+ I DEBUG W "MAPPED",!
+"RTN","C0CXPATH",595,0)
  Q
-"RTN","C0CXPATH",325,0)
- ;
-"RTN","C0CXPATH",326,0)
-CLEAN(STR,TR) ; extrinsic function; returns string
-"RTN","C0CXPATH",327,0)
- ;; Removes all non printable characters from a string.
-"RTN","C0CXPATH",328,0)
- ;; STR by Value
-"RTN","C0CXPATH",329,0)
- ;; TR IS OPTIONAL TO IMPROVE PERFORMANCE
-"RTN","C0CXPATH",330,0)
- N TR,I
-"RTN","C0CXPATH",331,0)
- I '$D(TR) D  ;
-"RTN","C0CXPATH",332,0)
- . F I=0:1:31 S TR=$G(TR)_$C(I)
-"RTN","C0CXPATH",333,0)
- . S TR=TR_$C(127)
-"RTN","C0CXPATH",334,0)
- QUIT $TR(STR,TR)
-"RTN","C0CXPATH",335,0)
- ;
-"RTN","C0CXPATH",336,0)
-QUERY(IARY,XPATH,OARY)  ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
-"RTN","C0CXPATH",337,0)
- ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
-"RTN","C0CXPATH",338,0)
- ; IARY AND OARY ARE PASSED BY NAME
-"RTN","C0CXPATH",339,0)
- I '$D(@IARY@("INDEXED"))  D  ; INDEX IS NOT PRESENT IN IARY
-"RTN","C0CXPATH",340,0)
- . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
-"RTN","C0CXPATH",341,0)
- N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
-"RTN","C0CXPATH",342,0)
- N TMP,I,J,QXPATH
-"RTN","C0CXPATH",343,0)
- S FIRST=1
-"RTN","C0CXPATH",344,0)
- I '$D(@IARY@(0)) D  ; LINE COUNT NOT IN ZERO NODE
-"RTN","C0CXPATH",345,0)
- . S @IARY@(0)=$O(@IARY@("//"),-1) ; THIS SHOULD USUALLY WORK
-"RTN","C0CXPATH",346,0)
- S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
-"RTN","C0CXPATH",347,0)
- I XPATH'="//" D  ; NOT A ROOT QUERY
-"RTN","C0CXPATH",348,0)
- . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
-"RTN","C0CXPATH",349,0)
- . S FIRST=$P(TMP,"^",1)
-"RTN","C0CXPATH",350,0)
- . S LAST=$P(TMP,"^",2)
-"RTN","C0CXPATH",351,0)
- K @OARY
-"RTN","C0CXPATH",352,0)
- S @OARY@(0)=+LAST-FIRST+1
-"RTN","C0CXPATH",353,0)
- S J=1
-"RTN","C0CXPATH",354,0)
- FOR I=FIRST:1:LAST  D
-"RTN","C0CXPATH",355,0)
- . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
-"RTN","C0CXPATH",356,0)
- . S J=J+1
-"RTN","C0CXPATH",357,0)
- ; ZWR OARY
-"RTN","C0CXPATH",358,0)
+"RTN","C0CXPATH",596,0)
+ ;
+"RTN","C0CXPATH",597,0)
+DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE
+"RTN","C0CXPATH",598,0)
+ ;
+"RTN","C0CXPATH",599,0)
  Q
-"RTN","C0CXPATH",359,0)
- ;
-"RTN","C0CXPATH",360,0)
-XF(IDX,XPATH)   ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
-"RTN","C0CXPATH",361,0)
- ; INDEX WITH TWO PIECES START^FINISH
-"RTN","C0CXPATH",362,0)
- ; IDX IS PASSED BY NAME
-"RTN","C0CXPATH",363,0)
- Q $P(@IDX@(XPATH),"^",1)
-"RTN","C0CXPATH",364,0)
- ;
-"RTN","C0CXPATH",365,0)
-XL(IDX,XPATH)   ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
-"RTN","C0CXPATH",366,0)
- ; INDEX WITH TWO PIECES START^FINISH
-"RTN","C0CXPATH",367,0)
- ; IDX IS PASSED BY NAME
-"RTN","C0CXPATH",368,0)
- Q $P(@IDX@(XPATH),"^",2)
-"RTN","C0CXPATH",369,0)
- ;
-"RTN","C0CXPATH",370,0)
-START(ISTR)     ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
-"RTN","C0CXPATH",371,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","C0CXPATH",372,0)
- ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
-"RTN","C0CXPATH",373,0)
- Q $P(ISTR,";",2)
-"RTN","C0CXPATH",374,0)
- ;
-"RTN","C0CXPATH",375,0)
-FINISH(ISTR)    ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
-"RTN","C0CXPATH",376,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","C0CXPATH",377,0)
- Q $P(ISTR,";",3)
-"RTN","C0CXPATH",378,0)
- ;
-"RTN","C0CXPATH",379,0)
-ARRAY(ISTR)     ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
-"RTN","C0CXPATH",380,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","C0CXPATH",381,0)
- Q $P(ISTR,";",1)
-"RTN","C0CXPATH",382,0)
- ;
-"RTN","C0CXPATH",383,0)
-BUILD(BLIST,BDEST)      ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
-"RTN","C0CXPATH",384,0)
- ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
-"RTN","C0CXPATH",385,0)
- ; DEST IS CLEARED TO START
-"RTN","C0CXPATH",386,0)
- ; USES PUSH TO DO THE COPY
-"RTN","C0CXPATH",387,0)
+"RTN","C0CXPATH",600,0)
+ ;
+"RTN","C0CXPATH",601,0)
+TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
+"RTN","C0CXPATH",602,0)
+ ; THEXML IS PASSED BY NAME
+"RTN","C0CXPATH",603,0)
+ N I,J,TMPXML,DEL,FOUND,INTXT
+"RTN","C0CXPATH",604,0)
+ S FOUND=0
+"RTN","C0CXPATH",605,0)
+ S INTXT=0
+"RTN","C0CXPATH",606,0)
+ I $G(DEBUG) W "DELETING EMPTY ELEMENTS",!
+"RTN","C0CXPATH",607,0)
+ F I=1:1:(@THEXML@(0)-1) D  ; LOOP THROUGH ENTIRE ARRAY
+"RTN","C0CXPATH",608,0)
+ . S J=@THEXML@(I)
+"RTN","C0CXPATH",609,0)
+ . I J["<text>" D
+"RTN","C0CXPATH",610,0)
+ . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
+"RTN","C0CXPATH",611,0)
+ . . I $G(DEBUG) W "IN HTML SECTION",!
+"RTN","C0CXPATH",612,0)
+ . N JM,JP,JPX ; JMINUS AND JPLUS
+"RTN","C0CXPATH",613,0)
+ . S JM=@THEXML@(I-1) ; LINE BEFORE
+"RTN","C0CXPATH",614,0)
+ . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
+"RTN","C0CXPATH",615,0)
+ . S JP=@THEXML@(I+1) ; LINE AFTER
+"RTN","C0CXPATH",616,0)
+ . I INTXT=0 D  ; IF NOT IN AN HTML SECTION
+"RTN","C0CXPATH",617,0)
+ . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
+"RTN","C0CXPATH",618,0)
+ . . I J=JPX D  ; AN EMPTY ELEMENT ON TWO LINES
+"RTN","C0CXPATH",619,0)
+ . . . I $G(DEBUG) W I,J,JP,!
+"RTN","C0CXPATH",620,0)
+ . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
+"RTN","C0CXPATH",621,0)
+ . . . S DEL(I)="" ; SET LINE TO DELETE
+"RTN","C0CXPATH",622,0)
+ . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
+"RTN","C0CXPATH",623,0)
+ . . I J["><" D  ; AN EMPTY ELEMENT ON ONE LINE
+"RTN","C0CXPATH",624,0)
+ . . . I $G(DEBUG) W I,J,!
+"RTN","C0CXPATH",625,0)
+ . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
+"RTN","C0CXPATH",626,0)
+ . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
+"RTN","C0CXPATH",627,0)
+ . . . I JM=JPX D  ;
+"RTN","C0CXPATH",628,0)
+ . . . . I $G(DEBUG) W I,JM_J_JPX,!
+"RTN","C0CXPATH",629,0)
+ . . . . S DEL(I-1)=""
+"RTN","C0CXPATH",630,0)
+ . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
+"RTN","C0CXPATH",631,0)
+ ; . I J'["><" D PUSH("TMPXML",J)
+"RTN","C0CXPATH",632,0)
+ I FOUND D  ; NEED TO DELETE THINGS
+"RTN","C0CXPATH",633,0)
+ . F I=1:1:@THEXML@(0) D  ; COPY ARRAY LEAVING OUT DELELTED LINES
+"RTN","C0CXPATH",634,0)
+ . . I '$D(DEL(I)) D  ; IF THE LINE IS NOT DELETED
+"RTN","C0CXPATH",635,0)
+ . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
+"RTN","C0CXPATH",636,0)
+ . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
+"RTN","C0CXPATH",637,0)
+ Q FOUND
+"RTN","C0CXPATH",638,0)
+ ;
+"RTN","C0CXPATH",639,0)
+UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
+"RTN","C0CXPATH",640,0)
+ ; XSEC IS A SECTION PASSED BY NAME
+"RTN","C0CXPATH",641,0)
+ N XBLD,XTMP
+"RTN","C0CXPATH",642,0)
+ D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
+"RTN","C0CXPATH",643,0)
+ D BUILD("XBLD","XTMP") ; BUILD THE RESULT
+"RTN","C0CXPATH",644,0)
+ D CP("XTMP",XSEC) ; REPLACE PASSED XML
+"RTN","C0CXPATH",645,0)
+ Q
+"RTN","C0CXPATH",646,0)
+ ;
+"RTN","C0CXPATH",647,0)
+PARY(GLO,ZN)       ;PRINT AN ARRAY
+"RTN","C0CXPATH",648,0)
+ ; IF ZN=-1 NO LINE NUMBERS
+"RTN","C0CXPATH",649,0)
  N I
-"RTN","C0CXPATH",388,0)
- K @BDEST
-"RTN","C0CXPATH",389,0)
- F I=1:1:@BLIST@(0) D  ; FOR EACH INSTRUCTION IN BLIST
-"RTN","C0CXPATH",390,0)
- . N J,ATMP
-"RTN","C0CXPATH",391,0)
- . S ATMP=$$ARRAY(@BLIST@(I))
-"RTN","C0CXPATH",392,0)
- . I $G(DEBUG) W "ATMP=",ATMP,!
-"RTN","C0CXPATH",393,0)
- . I $G(DEBUG) W @BLIST@(I),!
-"RTN","C0CXPATH",394,0)
- . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D  ;
-"RTN","C0CXPATH",395,0)
- . . ; FOR EACH LINE IN THIS INSTR
-"RTN","C0CXPATH",396,0)
- . . I $G(DEBUG) W "BDEST= ",BDEST,!
-"RTN","C0CXPATH",397,0)
- . . I $G(DEBUG) W "ATMP= ",@ATMP@(J),!
-"RTN","C0CXPATH",398,0)
- . . D PUSH(BDEST,@ATMP@(J))
-"RTN","C0CXPATH",399,0)
+"RTN","C0CXPATH",650,0)
+ F I=1:1:@GLO@(0) D  ;
+"RTN","C0CXPATH",651,0)
+ . I $G(ZN)=-1 W @GLO@(I),!
+"RTN","C0CXPATH",652,0)
+ . E  W I_" "_@GLO@(I),!
+"RTN","C0CXPATH",653,0)
  Q
-"RTN","C0CXPATH",400,0)
- ;
-"RTN","C0CXPATH",401,0)
-QUEUE(BLST,ARRAY,FIRST,LAST)    ; ADD AN ENTRY TO A BLIST
-"RTN","C0CXPATH",402,0)
- ;
-"RTN","C0CXPATH",403,0)
- I $G(DEBUG) W "QUEUEING ",BLST,!
-"RTN","C0CXPATH",404,0)
- D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
-"RTN","C0CXPATH",405,0)
+"RTN","C0CXPATH",654,0)
+ ;
+"RTN","C0CXPATH",655,0)
+H2ARY(IARYRTN,IHASH,IPRE) ; CONVERT IHASH TO RETURN ARRAY
+"RTN","C0CXPATH",656,0)
+ ; IPRE IS OPTIONAL PREFIX FOR THE ELEMENTS. USED FOR MUPTIPLES 1^"VAR"^VALUE
+"RTN","C0CXPATH",657,0)
+ I '$D(IPRE) S IPRE=""
+"RTN","C0CXPATH",658,0)
+ N H2I S H2I=""
+"RTN","C0CXPATH",659,0)
+ ; W $O(@IHASH@(H2I)),!
+"RTN","C0CXPATH",660,0)
+ F  S H2I=$O(@IHASH@(H2I)) Q:H2I=""  D  ; FOR EACH ELEMENT OF THE HASH
+"RTN","C0CXPATH",661,0)
+ . I $QS(H2I,$QL(H2I))="M" D  Q  ; SPECIAL CASE FOR MULTIPLES
+"RTN","C0CXPATH",662,0)
+ . . ;W H2I_"^"_@IHASH@(H2I),!
+"RTN","C0CXPATH",663,0)
+ . . N IH,IHI
+"RTN","C0CXPATH",664,0)
+ . . S IH=$NA(@IHASH@(H2I)) ;
+"RTN","C0CXPATH",665,0)
+ . . S IH2A=$O(@IH@("")) ; SKIP OVER MULTIPLE DISCRIPTOR
+"RTN","C0CXPATH",666,0)
+ . . S IH2=$NA(@IH@(IH2A)) ; PAST THE "M","DIRETIONS" FOR EXAMPLE
+"RTN","C0CXPATH",667,0)
+ . . S IHI="" ; INDEX INTO "M" MULTIPLES
+"RTN","C0CXPATH",668,0)
+ . . F  S IHI=$O(@IH2@(IHI)) Q:IHI=""  D  ; FOR EACH SUB-MULTIPLE
+"RTN","C0CXPATH",669,0)
+ . . . ; W @IH@(IHI)
+"RTN","C0CXPATH",670,0)
+ . . . S IH3=$NA(@IH2@(IHI))
+"RTN","C0CXPATH",671,0)
+ . . . ; W "HEY",IH3,!
+"RTN","C0CXPATH",672,0)
+ . . . D H2ARY(.IARYRTN,IH3,IPRE_";"_IHI) ; RECURSIVE CALL - INDENTED ELEMENTS
+"RTN","C0CXPATH",673,0)
+ . . ; W IH,!
+"RTN","C0CXPATH",674,0)
+ . . ; W "C0CZZ",!
+"RTN","C0CXPATH",675,0)
+ . . ; W $NA(@IHASH@(H2I)),!
+"RTN","C0CXPATH",676,0)
+ . . Q  ;
+"RTN","C0CXPATH",677,0)
+ . D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I))
+"RTN","C0CXPATH",678,0)
+ . ; W @IARYRTN@(0),!
+"RTN","C0CXPATH",679,0)
  Q
-"RTN","C0CXPATH",406,0)
- ;
-"RTN","C0CXPATH",407,0)
-CP(CPSRC,CPDEST)        ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
-"RTN","C0CXPATH",408,0)
- ; KILLS CPDEST FIRST
-"RTN","C0CXPATH",409,0)
- N CPINSTR
-"RTN","C0CXPATH",410,0)
- I $G(DEBUG) W "MADE IT TO COPY",CPSRC,CPDEST,!
-"RTN","C0CXPATH",411,0)
- I @CPSRC@(0)<1 D  ; BAD LENGTH
-"RTN","C0CXPATH",412,0)
- . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
-"RTN","C0CXPATH",413,0)
- . Q
-"RTN","C0CXPATH",414,0)
- ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
-"RTN","C0CXPATH",415,0)
- D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
-"RTN","C0CXPATH",416,0)
- D BUILD("CPINSTR",CPDEST)
-"RTN","C0CXPATH",417,0)
+"RTN","C0CXPATH",680,0)
+ ;
+"RTN","C0CXPATH",681,0)
+XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES
+"RTN","C0CXPATH",682,0)
+ ; DEFINED IN INPUT XML XVIXML BY @@VAR@@
+"RTN","C0CXPATH",683,0)
+ ; XVRTN AND XVIXML ARE PASSED BY NAME
+"RTN","C0CXPATH",684,0)
+ ;
+"RTN","C0CXPATH",685,0)
+ N XVI,XVTMP,XVT
+"RTN","C0CXPATH",686,0)
+ F XVI=1:1:@XVIXML@(0) D  ; FOR ALL LINES OF THE XML
+"RTN","C0CXPATH",687,0)
+ . S XVT=@XVIXML@(XVI)
+"RTN","C0CXPATH",688,0)
+ . I XVT["@@" S XVTMP($P(XVT,"@@",2))=XVI
+"RTN","C0CXPATH",689,0)
+ D H2ARY(XVRTN,"XVTMP")
+"RTN","C0CXPATH",690,0)
  Q
-"RTN","C0CXPATH",418,0)
- ;
-"RTN","C0CXPATH",419,0)
-QOPEN(QOBLIST,QOXML,QOXPATH)    ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
-"RTN","C0CXPATH",420,0)
- ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
-"RTN","C0CXPATH",421,0)
- ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
-"RTN","C0CXPATH",422,0)
- ; USED TO INSERT CHILDREN NODES
-"RTN","C0CXPATH",423,0)
- I @QOXML@(0)<1 D  ; MALFORMED XML
-"RTN","C0CXPATH",424,0)
- . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
-"RTN","C0CXPATH",425,0)
- . Q
-"RTN","C0CXPATH",426,0)
- I $G(DEBUG) W "DOING QOPEN",!
-"RTN","C0CXPATH",427,0)
- N S1,E1,QOT,QOTMP
-"RTN","C0CXPATH",428,0)
- S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
-"RTN","C0CXPATH",429,0)
- I $D(QOXPATH) D  ; XPATH PROVIDED
-"RTN","C0CXPATH",430,0)
- . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
-"RTN","C0CXPATH",431,0)
- . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
-"RTN","C0CXPATH",432,0)
- I '$D(QOXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
-"RTN","C0CXPATH",433,0)
- . S E1=@QOXML@(0)-1
-"RTN","C0CXPATH",434,0)
- D QUEUE(QOBLIST,QOXML,S1,E1)
-"RTN","C0CXPATH",435,0)
- ; S QOTMP=QOXML_"^"_S1_"^"_E1
-"RTN","C0CXPATH",436,0)
- ; D PUSH(QOBLIST,QOTMP)
-"RTN","C0CXPATH",437,0)
+"RTN","C0CXPATH",691,0)
+ ;
+"RTN","C0CXPATH",692,0)
+DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE
+"RTN","C0CXPATH",693,0)
+ ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE
+"RTN","C0CXPATH",694,0)
+ ;
+"RTN","C0CXPATH",695,0)
+ N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED
+"RTN","C0CXPATH",696,0)
+ I DXIN="CCR" D  ; NEED TO GO GET CCR TEMPLATE
+"RTN","C0CXPATH",697,0)
+ . D LOAD^C0CCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
+"RTN","C0CXPATH",698,0)
+ . S DXUSE="DTMP" ; DXUSE IS NAME
+"RTN","C0CXPATH",699,0)
+ E  I DXIN="CCD" D  ; NEED TO GO GET CCD TEMPLATE
+"RTN","C0CXPATH",700,0)
+ . D LOAD^C0CCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
+"RTN","C0CXPATH",701,0)
+ . S DXUSE="DTMP" ; DXUSE IS NAME
+"RTN","C0CXPATH",702,0)
+ E  S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE
+"RTN","C0CXPATH",703,0)
+ N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE
+"RTN","C0CXPATH",704,0)
+ D XVARS("DVARS",DXUSE) ; PULL OUT VARS
+"RTN","C0CXPATH",705,0)
+ D PARY^C0CXPATH("DVARS") ;AND DISPLAY THEM
+"RTN","C0CXPATH",706,0)
  Q
-"RTN","C0CXPATH",438,0)
- ;
-"RTN","C0CXPATH",439,0)
-QCLOSE(QCBLIST,QCXML,QCXPATH)   ; CLOSE XML AFTER A QOPEN
-"RTN","C0CXPATH",440,0)
- ; ADDS THE LIST LINE OF QCXML TO QCBLIST
-"RTN","C0CXPATH",441,0)
- ; USED TO FINISH INSERTING CHILDERN NODES
-"RTN","C0CXPATH",442,0)
- ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
-"RTN","C0CXPATH",443,0)
- ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
-"RTN","C0CXPATH",444,0)
- I @QCXML@(0)<1 D  ; MALFORMED XML
-"RTN","C0CXPATH",445,0)
- . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
-"RTN","C0CXPATH",446,0)
- I $G(DEBUG) W "GOING TO CLOSE",!
-"RTN","C0CXPATH",447,0)
- N S1,E1,QCT,QCTMP
-"RTN","C0CXPATH",448,0)
- S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
-"RTN","C0CXPATH",449,0)
- I $D(QCXPATH) D  ; XPATH PROVIDED
-"RTN","C0CXPATH",450,0)
- . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
-"RTN","C0CXPATH",451,0)
- . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
-"RTN","C0CXPATH",452,0)
- I '$D(QCXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
-"RTN","C0CXPATH",453,0)
- . S S1=@QCXML@(0)
-"RTN","C0CXPATH",454,0)
- D QUEUE(QCBLIST,QCXML,S1,E1)
-"RTN","C0CXPATH",455,0)
- ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
-"RTN","C0CXPATH",456,0)
+"RTN","C0CXPATH",707,0)
+ ;
+"RTN","C0CXPATH",708,0)
+TEST     ; Run all the test cases
+"RTN","C0CXPATH",709,0)
+ D TESTALL^C0CUNIT("C0CXPAT0")
+"RTN","C0CXPATH",710,0)
  Q
-"RTN","C0CXPATH",457,0)
- ;
-"RTN","C0CXPATH",458,0)
-INSERT(INSXML,INSNEW,INSXPATH)  ; INSERT INSNEW INTO INSXML AT THE
-"RTN","C0CXPATH",459,0)
- ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
-"RTN","C0CXPATH",460,0)
- ; OMITTED, INSERTION WILL BE AT THE ROOT
-"RTN","C0CXPATH",461,0)
- ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
-"RTN","C0CXPATH",462,0)
- ; XML AT THE END OF THE XPATH POINT
-"RTN","C0CXPATH",463,0)
- ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
-"RTN","C0CXPATH",464,0)
- N INSBLD,INSTMP
-"RTN","C0CXPATH",465,0)
- I $G(DEBUG) W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
-"RTN","C0CXPATH",466,0)
- I $G(DEBUG) F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
-"RTN","C0CXPATH",467,0)
- I '$D(@INSXML@(1)) D  ; INSERT INTO AN EMPTY ARRAY
-"RTN","C0CXPATH",468,0)
- . D CP^C0CXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
-"RTN","C0CXPATH",469,0)
- I $D(@INSXML@(1)) D  ; IF ORIGINAL ARRAY IS NOT EMPTY
-"RTN","C0CXPATH",470,0)
- . I '$D(@INSXML@(0)) S @INSXML@(0)=$O(@INSXML@(""),-1) ;SET LENGTH
-"RTN","C0CXPATH",471,0)
- . I $D(INSXPATH) D  ; XPATH PROVIDED
-"RTN","C0CXPATH",472,0)
- . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
-"RTN","C0CXPATH",473,0)
- . . I $G(DEBUG) D PARY^C0CXPATH("INSBLD")
-"RTN","C0CXPATH",474,0)
- . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
-"RTN","C0CXPATH",475,0)
- . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
-"RTN","C0CXPATH",476,0)
- . I '$D(@INSNEW@(0)) S @INSNEW@(0)=$O(@INSNEW@(""),-1) ;SIZE OF XML
-"RTN","C0CXPATH",477,0)
- . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
-"RTN","C0CXPATH",478,0)
- . I $D(INSXPATH) D  ; XPATH PROVIDED
-"RTN","C0CXPATH",479,0)
- . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
-"RTN","C0CXPATH",480,0)
- . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
-"RTN","C0CXPATH",481,0)
- . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
-"RTN","C0CXPATH",482,0)
- . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
-"RTN","C0CXPATH",483,0)
- . D CP^C0CXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
-"RTN","C0CXPATH",484,0)
+"RTN","C0CXPATH",711,0)
+ ;
+"RTN","C0CXPATH",712,0)
+ZTEST(WHICH)    ; RUN ONE SET OF TESTS
+"RTN","C0CXPATH",713,0)
+ N ZTMP
+"RTN","C0CXPATH",714,0)
+ S DEBUG=1
+"RTN","C0CXPATH",715,0)
+ D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
+"RTN","C0CXPATH",716,0)
+ D ZTEST^C0CUNIT(.ZTMP,WHICH)
+"RTN","C0CXPATH",717,0)
  Q
-"RTN","C0CXPATH",485,0)
- ;
-"RTN","C0CXPATH",486,0)
-INSINNER(INNXML,INNNEW,INNXPATH)        ; INSERT THE INNER XML OF INNNEW
-"RTN","C0CXPATH",487,0)
- ; INTO INNXML AT THE INNXPATH XPATH POINT
-"RTN","C0CXPATH",488,0)
- ;
-"RTN","C0CXPATH",489,0)
- N INNBLD,UXPATH
-"RTN","C0CXPATH",490,0)
- N INNTBUF
-"RTN","C0CXPATH",491,0)
- S INNTBUF=$NA(^TMP($J,"INNTBUF"))
-"RTN","C0CXPATH",492,0)
- I '$D(INNXPATH) D  ; XPATH NOT PASSED
-"RTN","C0CXPATH",493,0)
- . S UXPATH="//" ; USE ROOT XPATH
-"RTN","C0CXPATH",494,0)
- I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
-"RTN","C0CXPATH",495,0)
- I '$D(@INNXML@(0)) D  ; INNXML IS EMPTY
-"RTN","C0CXPATH",496,0)
- . D QUEUE^C0CXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
-"RTN","C0CXPATH",497,0)
- . D BUILD("INNBLD",INNXML)
-"RTN","C0CXPATH",498,0)
- I @INNXML@(0)>0  D  ; NOT EMPTY
-"RTN","C0CXPATH",499,0)
- . D QOPEN("INNBLD",INNXML,UXPATH) ;
-"RTN","C0CXPATH",500,0)
- . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
-"RTN","C0CXPATH",501,0)
- . D QCLOSE("INNBLD",INNXML,UXPATH)
-"RTN","C0CXPATH",502,0)
- . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
-"RTN","C0CXPATH",503,0)
- . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
-"RTN","C0CXPATH",504,0)
+"RTN","C0CXPATH",718,0)
+ ;
+"RTN","C0CXPATH",719,0)
+TLIST   ; LIST THE TESTS
+"RTN","C0CXPATH",720,0)
+ N ZTMP
+"RTN","C0CXPATH",721,0)
+ D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
+"RTN","C0CXPATH",722,0)
+ D TLIST^C0CUNIT(.ZTMP)
+"RTN","C0CXPATH",723,0)
  Q
-"RTN","C0CXPATH",505,0)
- ;
-"RTN","C0CXPATH",506,0)
-INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
-"RTN","C0CXPATH",507,0)
- ; BUT XDEST AN XNEW ARE PASSED BY NAME
-"RTN","C0CXPATH",508,0)
- N XBLD,XTMP
-"RTN","C0CXPATH",509,0)
- D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
-"RTN","C0CXPATH",510,0)
- D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
-"RTN","C0CXPATH",511,0)
- D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
-"RTN","C0CXPATH",512,0)
- D BUILD("XBLD","XTMP") ; BUILD THE RESULT
-"RTN","C0CXPATH",513,0)
- D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
-"RTN","C0CXPATH",514,0)
- I $G(DEBUG) D PARY("XDEST")
-"RTN","C0CXPATH",515,0)
- Q
-"RTN","C0CXPATH",516,0)
- ;
-"RTN","C0CXPATH",517,0)
-REPLACE(REXML,RENEW,REXPATH)    ; REPLACE THE XML AT THE XPATH POINT
-"RTN","C0CXPATH",518,0)
- ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
-"RTN","C0CXPATH",519,0)
- ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
-"RTN","C0CXPATH",520,0)
- ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
-"RTN","C0CXPATH",521,0)
- N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
-"RTN","C0CXPATH",522,0)
- S OLD=$NA(^TMP($J,"REPLACE_OLD"))
-"RTN","C0CXPATH",523,0)
- D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
-"RTN","C0CXPATH",524,0)
- S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
-"RTN","C0CXPATH",525,0)
- S XFIRST=$P(XNODE,"^",1)
-"RTN","C0CXPATH",526,0)
- S XLAST=$P(XNODE,"^",2)
-"RTN","C0CXPATH",527,0)
- I RENEW="" D  ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
-"RTN","C0CXPATH",528,0)
- . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
-"RTN","C0CXPATH",529,0)
- . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
-"RTN","C0CXPATH",530,0)
- I RENEW'="" D  ; NEW XML IS NOT NULL
-"RTN","C0CXPATH",531,0)
- . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
-"RTN","C0CXPATH",532,0)
- . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
-"RTN","C0CXPATH",533,0)
- . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
-"RTN","C0CXPATH",534,0)
- I $G(DEBUG) W "REPLACE PREBUILD",!
-"RTN","C0CXPATH",535,0)
- I $G(DEBUG) D PARY("REBLD")
-"RTN","C0CXPATH",536,0)
- D BUILD("REBLD","RTMP")
-"RTN","C0CXPATH",537,0)
- K @REXML ; KILL WHAT WAS THERE
-"RTN","C0CXPATH",538,0)
- D CP("RTMP",REXML) ; COPY IN THE RESULT
-"RTN","C0CXPATH",539,0)
- Q
-"RTN","C0CXPATH",540,0)
- ;
-"RTN","C0CXPATH",541,0)
-DELETE(REXML,REXPATH)    ; DELETE THE XML AT THE XPATH POINT
-"RTN","C0CXPATH",542,0)
- ; REXML IS PASSED BY NAME XPATH IS A VALUE
-"RTN","C0CXPATH",543,0)
- N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
-"RTN","C0CXPATH",544,0)
- S OLD=$NA(^TMP($J,"REPLACE_OLD"))
-"RTN","C0CXPATH",545,0)
- D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
-"RTN","C0CXPATH",546,0)
- S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
-"RTN","C0CXPATH",547,0)
- S XFIRST=$P(XNODE,"^",1)
-"RTN","C0CXPATH",548,0)
- S XLAST=$P(XNODE,"^",2)
-"RTN","C0CXPATH",549,0)
- D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
-"RTN","C0CXPATH",550,0)
- D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
-"RTN","C0CXPATH",551,0)
- I $G(DEBUG) D PARY("REBLD")
-"RTN","C0CXPATH",552,0)
- D BUILD("REBLD","RTMP")
-"RTN","C0CXPATH",553,0)
- K @REXML ; KILL WHAT WAS THERE
-"RTN","C0CXPATH",554,0)
- D CP("RTMP",REXML) ; COPY IN THE RESULT
-"RTN","C0CXPATH",555,0)
- Q
-"RTN","C0CXPATH",556,0)
- ;
-"RTN","C0CXPATH",557,0)
-MISSING(IXML,OARY)      ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
-"RTN","C0CXPATH",558,0)
- ; W "Reporting on the missing",!
-"RTN","C0CXPATH",559,0)
- ; W OARY
-"RTN","C0CXPATH",560,0)
- I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
-"RTN","C0CXPATH",561,0)
- N I
-"RTN","C0CXPATH",562,0)
- S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
-"RTN","C0CXPATH",563,0)
- F I=1:1:@IXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
-"RTN","C0CXPATH",564,0)
- . I @IXML@(I)?.E1"@@".E D  ; MISSING VARIABLE HERE
-"RTN","C0CXPATH",565,0)
- . . D PUSH^C0CXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
-"RTN","C0CXPATH",566,0)
- . . Q
-"RTN","C0CXPATH",567,0)
- Q
-"RTN","C0CXPATH",568,0)
- ;
-"RTN","C0CXPATH",569,0)
-MAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
-"RTN","C0CXPATH",570,0)
- ; AND PUT THE RESULTS IN OXML
-"RTN","C0CXPATH",571,0)
- N XCNT
-"RTN","C0CXPATH",572,0)
- I '$D(DEBUG) S DEBUG=0
-"RTN","C0CXPATH",573,0)
- I '$D(IXML) W "MALFORMED XML PASSED TO MAP",! Q
-"RTN","C0CXPATH",574,0)
- I '$D(@IXML@(0)) D  ; INITIALIZE COUNT
-"RTN","C0CXPATH",575,0)
- . S XCNT=$O(@IXML@(""),-1)
-"RTN","C0CXPATH",576,0)
- E  S XCNT=@IXML@(0) ;COUNT
-"RTN","C0CXPATH",577,0)
- I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
-"RTN","C0CXPATH",578,0)
- N I,J,TNAM,TVAL,TSTR
-"RTN","C0CXPATH",579,0)
- S @OXML@(0)=XCNT ; TOTAL LINES IN OUTPUT
-"RTN","C0CXPATH",580,0)
- F I=1:1:XCNT  D   ; LOOP THROUGH WHOLE ARRAY
-"RTN","C0CXPATH",581,0)
- . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
-"RTN","C0CXPATH",582,0)
- . I @OXML@(I)?.E1"@@".E D  ; IS THERE A VARIABLE HERE?
-"RTN","C0CXPATH",583,0)
- . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
-"RTN","C0CXPATH",584,0)
- . . F J=2:2:10  D  Q:$P(@IXML@(I),"@@",J+2)=""  ; QUIT IF NO MORE VARS
-"RTN","C0CXPATH",585,0)
- . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
-"RTN","C0CXPATH",586,0)
- . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
-"RTN","C0CXPATH",587,0)
- . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
-"RTN","C0CXPATH",588,0)
- . . . I $D(@INARY@(TNAM))  D  ; IS THE VARIABLE IN THE MAP?
-"RTN","C0CXPATH",589,0)
- . . . . I '$D(@INARY@(TNAM,"F")) D  ; NOT A SPECIAL FIELD
-"RTN","C0CXPATH",590,0)
- . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
-"RTN","C0CXPATH",591,0)
- . . . . E  D DOFLD ; PROCESS A FIELD
-"RTN","C0CXPATH",592,0)
- . . . S TVAL=$$SYMENC^MXMLUTL(TVAL) ;MAKE SURE THE VALUE IS XML SAFE
-"RTN","C0CXPATH",593,0)
- . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
-"RTN","C0CXPATH",594,0)
- . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
-"RTN","C0CXPATH",595,0)
- . . I DEBUG W TSTR
-"RTN","C0CXPATH",596,0)
- I DEBUG W "MAPPED",!
-"RTN","C0CXPATH",597,0)
- Q
-"RTN","C0CXPATH",598,0)
- ;
-"RTN","C0CXPATH",599,0)
-DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE
-"RTN","C0CXPATH",600,0)
- ;
-"RTN","C0CXPATH",601,0)
- Q
-"RTN","C0CXPATH",602,0)
- ;
-"RTN","C0CXPATH",603,0)
-TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
-"RTN","C0CXPATH",604,0)
- ; THEXML IS PASSED BY NAME
-"RTN","C0CXPATH",605,0)
- N I,J,TMPXML,DEL,FOUND,INTXT
-"RTN","C0CXPATH",606,0)
- S FOUND=0
-"RTN","C0CXPATH",607,0)
- S INTXT=0
-"RTN","C0CXPATH",608,0)
- I $G(DEBUG) W "DELETING EMPTY ELEMENTS",!
-"RTN","C0CXPATH",609,0)
- F I=1:1:(@THEXML@(0)-1) D  ; LOOP THROUGH ENTIRE ARRAY
-"RTN","C0CXPATH",610,0)
- . S J=@THEXML@(I)
-"RTN","C0CXPATH",611,0)
- . I J["<text>" D
-"RTN","C0CXPATH",612,0)
- . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
-"RTN","C0CXPATH",613,0)
- . . I $G(DEBUG) W "IN HTML SECTION",!
-"RTN","C0CXPATH",614,0)
- . N JM,JP,JPX ; JMINUS AND JPLUS
-"RTN","C0CXPATH",615,0)
- . S JM=@THEXML@(I-1) ; LINE BEFORE
-"RTN","C0CXPATH",616,0)
- . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
-"RTN","C0CXPATH",617,0)
- . S JP=@THEXML@(I+1) ; LINE AFTER
-"RTN","C0CXPATH",618,0)
- . I INTXT=0 D  ; IF NOT IN AN HTML SECTION
-"RTN","C0CXPATH",619,0)
- . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
-"RTN","C0CXPATH",620,0)
- . . I J=JPX D  ; AN EMPTY ELEMENT ON TWO LINES
-"RTN","C0CXPATH",621,0)
- . . . I $G(DEBUG) W I,J,JP,!
-"RTN","C0CXPATH",622,0)
- . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
-"RTN","C0CXPATH",623,0)
- . . . S DEL(I)="" ; SET LINE TO DELETE
-"RTN","C0CXPATH",624,0)
- . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
-"RTN","C0CXPATH",625,0)
- . . I J["><" D  ; AN EMPTY ELEMENT ON ONE LINE
-"RTN","C0CXPATH",626,0)
- . . . I $G(DEBUG) W I,J,!
-"RTN","C0CXPATH",627,0)
- . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
-"RTN","C0CXPATH",628,0)
- . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
-"RTN","C0CXPATH",629,0)
- . . . I JM=JPX D  ;
-"RTN","C0CXPATH",630,0)
- . . . . I $G(DEBUG) W I,JM_J_JPX,!
-"RTN","C0CXPATH",631,0)
- . . . . S DEL(I-1)=""
-"RTN","C0CXPATH",632,0)
- . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
-"RTN","C0CXPATH",633,0)
- ; . I J'["><" D PUSH("TMPXML",J)
-"RTN","C0CXPATH",634,0)
- I FOUND D  ; NEED TO DELETE THINGS
-"RTN","C0CXPATH",635,0)
- . F I=1:1:@THEXML@(0) D  ; COPY ARRAY LEAVING OUT DELELTED LINES
-"RTN","C0CXPATH",636,0)
- . . I '$D(DEL(I)) D  ; IF THE LINE IS NOT DELETED
-"RTN","C0CXPATH",637,0)
- . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
-"RTN","C0CXPATH",638,0)
- . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
-"RTN","C0CXPATH",639,0)
- Q FOUND
-"RTN","C0CXPATH",640,0)
- ;
-"RTN","C0CXPATH",641,0)
-UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
-"RTN","C0CXPATH",642,0)
- ; XSEC IS A SECTION PASSED BY NAME
-"RTN","C0CXPATH",643,0)
- N XBLD,XTMP
-"RTN","C0CXPATH",644,0)
- D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
-"RTN","C0CXPATH",645,0)
- D BUILD("XBLD","XTMP") ; BUILD THE RESULT
-"RTN","C0CXPATH",646,0)
- D CP("XTMP",XSEC) ; REPLACE PASSED XML
-"RTN","C0CXPATH",647,0)
- Q
-"RTN","C0CXPATH",648,0)
- ;
-"RTN","C0CXPATH",649,0)
-PARY(GLO,ZN)       ;PRINT AN ARRAY
-"RTN","C0CXPATH",650,0)
- ; IF ZN=-1 NO LINE NUMBERS
-"RTN","C0CXPATH",651,0)
- N I
-"RTN","C0CXPATH",652,0)
- F I=1:1:@GLO@(0) D  ;
-"RTN","C0CXPATH",653,0)
- . I $G(ZN)=-1 W @GLO@(I),!
-"RTN","C0CXPATH",654,0)
- . E  W I_" "_@GLO@(I),!
-"RTN","C0CXPATH",655,0)
- Q
-"RTN","C0CXPATH",656,0)
- ;
-"RTN","C0CXPATH",657,0)
-H2ARY(IARYRTN,IHASH,IPRE) ; CONVERT IHASH TO RETURN ARRAY
-"RTN","C0CXPATH",658,0)
- ; IPRE IS OPTIONAL PREFIX FOR THE ELEMENTS. USED FOR MUPTIPLES 1^"VAR"^VALUE
-"RTN","C0CXPATH",659,0)
- I '$D(IPRE) S IPRE=""
-"RTN","C0CXPATH",660,0)
- N H2I S H2I=""
-"RTN","C0CXPATH",661,0)
- ; W $O(@IHASH@(H2I)),!
-"RTN","C0CXPATH",662,0)
- F  S H2I=$O(@IHASH@(H2I)) Q:H2I=""  D  ; FOR EACH ELEMENT OF THE HASH
-"RTN","C0CXPATH",663,0)
- . I $QS(H2I,$QL(H2I))="M" D  Q  ; SPECIAL CASE FOR MULTIPLES
-"RTN","C0CXPATH",664,0)
- . . ;W H2I_"^"_@IHASH@(H2I),!
-"RTN","C0CXPATH",665,0)
- . . N IH,IHI
-"RTN","C0CXPATH",666,0)
- . . S IH=$NA(@IHASH@(H2I)) ;
-"RTN","C0CXPATH",667,0)
- . . S IH2A=$O(@IH@("")) ; SKIP OVER MULTIPLE DISCRIPTOR
-"RTN","C0CXPATH",668,0)
- . . S IH2=$NA(@IH@(IH2A)) ; PAST THE "M","DIRETIONS" FOR EXAMPLE
-"RTN","C0CXPATH",669,0)
- . . S IHI="" ; INDEX INTO "M" MULTIPLES
-"RTN","C0CXPATH",670,0)
- . . F  S IHI=$O(@IH2@(IHI)) Q:IHI=""  D  ; FOR EACH SUB-MULTIPLE
-"RTN","C0CXPATH",671,0)
- . . . ; W @IH@(IHI)
-"RTN","C0CXPATH",672,0)
- . . . S IH3=$NA(@IH2@(IHI))
-"RTN","C0CXPATH",673,0)
- . . . ; W "HEY",IH3,!
-"RTN","C0CXPATH",674,0)
- . . . D H2ARY(.IARYRTN,IH3,IPRE_";"_IHI) ; RECURSIVE CALL - INDENTED ELEMENTS
-"RTN","C0CXPATH",675,0)
- . . ; W IH,!
-"RTN","C0CXPATH",676,0)
- . . ; W "C0CZZ",!
-"RTN","C0CXPATH",677,0)
- . . ; W $NA(@IHASH@(H2I)),!
-"RTN","C0CXPATH",678,0)
- . . Q  ;
-"RTN","C0CXPATH",679,0)
- . D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I))
-"RTN","C0CXPATH",680,0)
- . ; W @IARYRTN@(0),!
-"RTN","C0CXPATH",681,0)
- Q
-"RTN","C0CXPATH",682,0)
- ;
-"RTN","C0CXPATH",683,0)
-XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES
-"RTN","C0CXPATH",684,0)
- ; DEFINED IN INPUT XML XVIXML BY @@VAR@@
-"RTN","C0CXPATH",685,0)
- ; XVRTN AND XVIXML ARE PASSED BY NAME
-"RTN","C0CXPATH",686,0)
- ;
-"RTN","C0CXPATH",687,0)
- N XVI,XVTMP,XVT
-"RTN","C0CXPATH",688,0)
- F XVI=1:1:@XVIXML@(0) D  ; FOR ALL LINES OF THE XML
-"RTN","C0CXPATH",689,0)
- . S XVT=@XVIXML@(XVI)
-"RTN","C0CXPATH",690,0)
- . I XVT["@@" S XVTMP($P(XVT,"@@",2))=XVI
-"RTN","C0CXPATH",691,0)
- D H2ARY(XVRTN,"XVTMP")
-"RTN","C0CXPATH",692,0)
- Q
-"RTN","C0CXPATH",693,0)
- ;
-"RTN","C0CXPATH",694,0)
-DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE
-"RTN","C0CXPATH",695,0)
- ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE
-"RTN","C0CXPATH",696,0)
- ;
-"RTN","C0CXPATH",697,0)
- N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED
-"RTN","C0CXPATH",698,0)
- I DXIN="CCR" D  ; NEED TO GO GET CCR TEMPLATE
-"RTN","C0CXPATH",699,0)
- . D LOAD^C0CCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
-"RTN","C0CXPATH",700,0)
- . S DXUSE="DTMP" ; DXUSE IS NAME
-"RTN","C0CXPATH",701,0)
- E  I DXIN="CCD" D  ; NEED TO GO GET CCD TEMPLATE
-"RTN","C0CXPATH",702,0)
- . D LOAD^C0CCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
-"RTN","C0CXPATH",703,0)
- . S DXUSE="DTMP" ; DXUSE IS NAME
-"RTN","C0CXPATH",704,0)
- E  S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE
-"RTN","C0CXPATH",705,0)
- N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE
-"RTN","C0CXPATH",706,0)
- D XVARS("DVARS",DXUSE) ; PULL OUT VARS
-"RTN","C0CXPATH",707,0)
- D PARY^C0CXPATH("DVARS") ;AND DISPLAY THEM
-"RTN","C0CXPATH",708,0)
- Q
-"RTN","C0CXPATH",709,0)
- ;
-"RTN","C0CXPATH",710,0)
-TEST     ; Run all the test cases
-"RTN","C0CXPATH",711,0)
- D TESTALL^C0CUNIT("C0CXPAT0")
-"RTN","C0CXPATH",712,0)
- Q
-"RTN","C0CXPATH",713,0)
- ;
-"RTN","C0CXPATH",714,0)
-ZTEST(WHICH)    ; RUN ONE SET OF TESTS
-"RTN","C0CXPATH",715,0)
- N ZTMP
-"RTN","C0CXPATH",716,0)
- S DEBUG=1
-"RTN","C0CXPATH",717,0)
- D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
-"RTN","C0CXPATH",718,0)
- D ZTEST^C0CUNIT(.ZTMP,WHICH)
-"RTN","C0CXPATH",719,0)
- Q
-"RTN","C0CXPATH",720,0)
- ;
-"RTN","C0CXPATH",721,0)
-TLIST   ; LIST THE TESTS
-"RTN","C0CXPATH",722,0)
- N ZTMP
-"RTN","C0CXPATH",723,0)
- D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
 "RTN","C0CXPATH",724,0)
- D TLIST^C0CUNIT(.ZTMP)
-"RTN","C0CXPATH",725,0)
- Q
-"RTN","C0CXPATH",726,0)
  ;
 "SEC","^DIC",170,170,0,"AUDIT")
@@ -127660,5 +127866,5 @@
 
 "^DD",170,170,0,"VRPK")
-C0C
+CCD/CCR GENERATION UTILITIES
 "^DD",170,170,.01,0)
 AVARIABLE^RF^^0;1^K:$L(X)>30!($L(X)<2)!'(X'?1P.E) X
@@ -127838,5 +128044,5 @@
 
 "^DD",170.101,170.101,0,"VRPK")
-C0C
+CCD/CCR GENERATION UTILITIES
 "^DD",170.101,170.101,.01,0)
 NODE TYPE^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X
@@ -127930,5 +128136,5 @@
 
 "^DD",170.9,170.9,0,"VRPK")
-C0C
+CCD/CCR GENERATION UTILITIES
 "^DD",170.9,170.9,.01,0)
 NAME^RF^^0;1^K:$L(X)>30!(X?.N)!($L(X)<3)!'(X'?1P.E) X
@@ -128032,5 +128238,5 @@
 
 "^DD",171.101,171.101,0,"VRPK")
-C0C
+CCD/CCR GENERATION UTILITIES
 "^DD",171.101,171.101,.01,0)
 PATIENT^RP2'^DPT(^0;1^Q
@@ -128192,5 +128398,5 @@
 
 "^DD",171.401,171.401,0,"VRPK")
-C0C
+CCD/CCR GENERATION UTILITIES
 "^DD",171.401,171.401,.01,0)
 NAME^RF^^0;1^K:$L(X)>30!(X?.N)!($L(X)<3)!'(X'?1P.E) X
@@ -128278,5 +128484,5 @@
 
 "^DD",175,175,0,"VRPK")
-C0C
+CCD/CCR GENERATION UTILITIES
 "^DD",175,175,.01,0)
 PATIENT^RP2'^DPT(^0;1^Q
@@ -128542,5 +128748,5 @@
 
 "^DD",176.112,176.112,0,"VRPK")
-C0C
+CCD/CCR GENERATION UTILITIES
 "^DD",176.112,176.112,.01,0)
 VUID^RF^^0;1^K:$L(X)>30!(X?.N)!($L(X)<3)!'(X'?1P.E) X
@@ -128614,5 +128820,5 @@
 
 "^DD",177.101,177.101,0,"VRPK")
-C0C
+CCD/CCR GENERATION UTILITIES
 "^DD",177.101,177.101,.01,0)
 PATIENT^RP2'^DPT(^0;1^Q
@@ -128736,5 +128942,5 @@
 
 "^DD",177.201,177.201,0,"VRPK")
-C0C
+CCD/CCR GENERATION UTILITIES
 "^DD",177.201,177.201,.01,0)
 SUBSCRIBER NAME^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X
@@ -128788,5 +128994,5 @@
 
 "^DD",177.301,177.301,0,"VRPK")
-C0C
+CCD/CCR GENERATION UTILITIES
 "^DD",177.301,177.301,.01,0)
 CCR BATCH RUN DATE/TIME^RD^^0;1^S %DT="ESTXR" D ^%DT S X=Y K:X<1 X
@@ -128942,5 +129148,5 @@
 
 "^DD",178.101,178.101,0,"VRPK")
-C0C
+CCD/CCR GENERATION UTILITIES
 "^DD",178.101,178.101,.01,0)
 NAME^RF^^0;1^K:$L(X)>80!($L(X)<3)!'(X'?1P.E) X
@@ -129150,5 +129356,5 @@
 
 "^DD",178.301,178.301,0,"VRPK")
-C0C
+CCD/CCR GENERATION UTILITIES
 "^DD",178.301,178.301,.01,0)
 TEMPLATE NAME^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X
