diff --git a/kids/CCD-CCR_GENERATION_UTILITIES_1P2.KID b/kids/CCD-CCR_GENERATION_UTILITIES_1P2.KID
index fec342b..2d99f70 100644
--- a/kids/CCD-CCR_GENERATION_UTILITIES_1P2.KID
+++ b/kids/CCD-CCR_GENERATION_UTILITIES_1P2.KID
@@ -1,928 +1,934 @@
-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)
DATETIME
@@ -90347,7 +90353,7 @@ K ^C0CX(178.301,"XPATH")
"IX",178.301,178.301,"XPATH",11.1,2,1.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
"KEY",178.101,178.101,"A",2,1,0)
@@ -90356,179 +90362,179 @@ S X=DA(1)
.02^178.101^2
"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")
0
@@ -90540,389 +90546,395 @@ REMOTE PROCEDURE
19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA
"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")
C0CENV
@@ -90999,7461 +91011,7433 @@ D XPZ2^XPDIQ
"RTN")
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.
-"RTN","C0CACTOR",11,0)
- ;
-"RTN","C0CACTOR",12,0)
; This program is distributed in the hope that it will be useful,
-"RTN","C0CACTOR",13,0)
+"RTN","C0CACTOR",11,0)
; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","C0CACTOR",14,0)
+"RTN","C0CACTOR",12,0)
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+"RTN","C0CACTOR",13,0)
+ ; GNU Affero General Public License for more details.
+"RTN","C0CACTOR",14,0)
+ ;
"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 .
"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.,
-"RTN","C0CACTOR",19,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","C0CACTOR",20,0)
- ;
-"RTN","C0CACTOR",21,0)
; PROCESS THE ACTORS SECTION OF THE CCR
-"RTN","C0CACTOR",22,0)
+"RTN","C0CACTOR",19,0)
;
-"RTN","C0CACTOR",23,0)
+"RTN","C0CACTOR",20,0)
; ===Revision History===
-"RTN","C0CACTOR",24,0)
+"RTN","C0CACTOR",21,0)
; 0.1 Initial Writing of Skeleton--GPL
-"RTN","C0CACTOR",25,0)
+"RTN","C0CACTOR",22,0)
; 0.2 Patient Data Extraction--SMH
-"RTN","C0CACTOR",26,0)
+"RTN","C0CACTOR",23,0)
; 0.3 Information System Info Extraction--SMH
-"RTN","C0CACTOR",27,0)
+"RTN","C0CACTOR",24,0)
; 0.4 Patient data rouine refactored; adjustments here--SMH
-"RTN","C0CACTOR",28,0)
+"RTN","C0CACTOR",25,0)
;
-"RTN","C0CACTOR",29,0)
+"RTN","C0CACTOR",26,0)
EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
-"RTN","C0CACTOR",30,0)
+"RTN","C0CACTOR",27,0)
; IPXML is the Input Actor Template into which we substitute values
-"RTN","C0CACTOR",31,0)
+"RTN","C0CACTOR",28,0)
; This is straight XML. Values to be substituted are in @@VAL@@ format.
-"RTN","C0CACTOR",32,0)
+"RTN","C0CACTOR",29,0)
; ALST is the actor list global generated by ACTLST^C0CCCR and has format:
-"RTN","C0CACTOR",33,0)
+"RTN","C0CACTOR",30,0)
; ^TMP(7542,1,"ACTORS",0)=Count
-"RTN","C0CACTOR",34,0)
+"RTN","C0CACTOR",31,0)
; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
-"RTN","C0CACTOR",35,0)
+"RTN","C0CACTOR",32,0)
; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
-"RTN","C0CACTOR",36,0)
+"RTN","C0CACTOR",33,0)
; AXML is the output arrary, to contain XML.
-"RTN","C0CACTOR",37,0)
+"RTN","C0CACTOR",34,0)
;
-"RTN","C0CACTOR",38,0)
+"RTN","C0CACTOR",35,0)
N I,J,AMAP,AOID,ATYP,AIEN
-"RTN","C0CACTOR",39,0)
+"RTN","C0CACTOR",36,0)
D CP^C0CXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
-"RTN","C0CACTOR",40,0)
+"RTN","C0CACTOR",37,0)
D REPLACE^C0CXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
-"RTN","C0CACTOR",41,0)
+"RTN","C0CACTOR",38,0)
I DEBUG W "PROCESSING ACTORS ",!
-"RTN","C0CACTOR",42,0)
+"RTN","C0CACTOR",39,0)
F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST
-"RTN","C0CACTOR",43,0)
+"RTN","C0CACTOR",40,0)
. I @ALST@(I)["@@" Q ; NOT A VALID ACTOR
-"RTN","C0CACTOR",44,0)
+"RTN","C0CACTOR",41,0)
. S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
-"RTN","C0CACTOR",45,0)
+"RTN","C0CACTOR",42,0)
. S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
-"RTN","C0CACTOR",46,0)
+"RTN","C0CACTOR",43,0)
. S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
-"RTN","C0CACTOR",47,0)
+"RTN","C0CACTOR",44,0)
. I AIEN="" D Q ; IEN CAN'T BE NULL
-"RTN","C0CACTOR",48,0)
+"RTN","C0CACTOR",45,0)
. . W "WARING NUL ACTOR: ",ATYP,!
-"RTN","C0CACTOR",49,0)
+"RTN","C0CACTOR",46,0)
. I ATYP="" Q ; NOT A VALID ACTOR
-"RTN","C0CACTOR",50,0)
+"RTN","C0CACTOR",47,0)
. ;
-"RTN","C0CACTOR",51,0)
+"RTN","C0CACTOR",48,0)
. I DEBUG W AOID_" "_ATYP_" "_AIEN,!
-"RTN","C0CACTOR",52,0)
+"RTN","C0CACTOR",49,0)
. I ATYP="PATIENT" D ; PATIENT ACTOR TYPE
-"RTN","C0CACTOR",53,0)
+"RTN","C0CACTOR",50,0)
. . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
-"RTN","C0CACTOR",54,0)
+"RTN","C0CACTOR",51,0)
. . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
-"RTN","C0CACTOR",55,0)
+"RTN","C0CACTOR",52,0)
. ;
-"RTN","C0CACTOR",56,0)
+"RTN","C0CACTOR",53,0)
. I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE
-"RTN","C0CACTOR",57,0)
+"RTN","C0CACTOR",54,0)
. . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
-"RTN","C0CACTOR",58,0)
+"RTN","C0CACTOR",55,0)
. . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
-"RTN","C0CACTOR",59,0)
+"RTN","C0CACTOR",56,0)
. ;
-"RTN","C0CACTOR",60,0)
+"RTN","C0CACTOR",57,0)
. I ATYP="NOK" D ; NOK ACTOR TYPE
-"RTN","C0CACTOR",61,0)
+"RTN","C0CACTOR",58,0)
. . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
-"RTN","C0CACTOR",62,0)
+"RTN","C0CACTOR",59,0)
. . D NOK("ATMP",AIEN,AOID,"ATMP2")
-"RTN","C0CACTOR",63,0)
+"RTN","C0CACTOR",60,0)
. ;
-"RTN","C0CACTOR",64,0)
+"RTN","C0CACTOR",61,0)
. I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE
-"RTN","C0CACTOR",65,0)
+"RTN","C0CACTOR",62,0)
. . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
-"RTN","C0CACTOR",66,0)
+"RTN","C0CACTOR",63,0)
. . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
-"RTN","C0CACTOR",67,0)
+"RTN","C0CACTOR",64,0)
. ;
-"RTN","C0CACTOR",68,0)
+"RTN","C0CACTOR",65,0)
. I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE
-"RTN","C0CACTOR",69,0)
+"RTN","C0CACTOR",66,0)
. . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
-"RTN","C0CACTOR",70,0)
+"RTN","C0CACTOR",67,0)
. . D ORG("ATMP",AIEN,AOID,"ATMP2")
-"RTN","C0CACTOR",71,0)
+"RTN","C0CACTOR",68,0)
. ;
-"RTN","C0CACTOR",72,0)
+"RTN","C0CACTOR",69,0)
. W "PROCESSING:",ATYP," ",AIEN,!
-"RTN","C0CACTOR",73,0)
+"RTN","C0CACTOR",70,0)
. ;I @ATMP2@(0)=0 Q ; NOTHING RETURNED, SKIP THIS ONE
-"RTN","C0CACTOR",74,0)
+"RTN","C0CACTOR",71,0)
. D INSINNER^C0CXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
-"RTN","C0CACTOR",75,0)
+"RTN","C0CACTOR",72,0)
. K ATYP,AIEN,AOID,ATMP,ATMP2 ; BE SURE TO GET THE NEXT ONE
-"RTN","C0CACTOR",76,0)
+"RTN","C0CACTOR",73,0)
;
-"RTN","C0CACTOR",77,0)
+"RTN","C0CACTOR",74,0)
N ACTTMP
-"RTN","C0CACTOR",78,0)
+"RTN","C0CACTOR",75,0)
D MISSING^C0CXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","C0CACTOR",79,0)
+"RTN","C0CACTOR",76,0)
I ACTTMP(0)>0 D ; IF THERE ARE MISSING VARS -
-"RTN","C0CACTOR",80,0)
+"RTN","C0CACTOR",77,0)
. ; STRINGS MARKED AS @@X@@
-"RTN","C0CACTOR",81,0)
+"RTN","C0CACTOR",78,0)
. W "ACTORS Missing list: ",!
-"RTN","C0CACTOR",82,0)
+"RTN","C0CACTOR",79,0)
. F I=1:1:ACTTMP(0) W ACTTMP(I),!
-"RTN","C0CACTOR",83,0)
+"RTN","C0CACTOR",80,0)
Q
-"RTN","C0CACTOR",84,0)
+"RTN","C0CACTOR",81,0)
;
-"RTN","C0CACTOR",85,0)
+"RTN","C0CACTOR",82,0)
PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
-"RTN","C0CACTOR",86,0)
+"RTN","C0CACTOR",83,0)
I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
-"RTN","C0CACTOR",87,0)
+"RTN","C0CACTOR",84,0)
;GPL SEPARATED EXTRACT FROM MAP FOR PROCESSING PATIENTS - TO MAKE
-"RTN","C0CACTOR",88,0)
+"RTN","C0CACTOR",85,0)
; CODE REUSABLE FROM ERX
-"RTN","C0CACTOR",89,0)
+"RTN","C0CACTOR",86,0)
N AMAP
-"RTN","C0CACTOR",90,0)
+"RTN","C0CACTOR",87,0)
S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","C0CACTOR",91,0)
+"RTN","C0CACTOR",88,0)
K @AMAP
-"RTN","C0CACTOR",92,0)
+"RTN","C0CACTOR",89,0)
D PEXTRACT(AMAP,AIEN,AOID) ;EXTRACT THE PATIENT ACTOR
-"RTN","C0CACTOR",93,0)
+"RTN","C0CACTOR",90,0)
I $P($$SITE^VASITE(),U,2)="OROVILLE HOSPITAL" S C0CDE=1
-"RTN","C0CACTOR",94,0)
+"RTN","C0CACTOR",91,0)
I $G(C0CDE)'="" D DEIDENT(AMAP,AIEN) ; DEIDENTIFY THE CCR
-"RTN","C0CACTOR",95,0)
+"RTN","C0CACTOR",92,0)
D MAP(INXML,AMAP,OUTXML) ;MAP TO XML
-"RTN","C0CACTOR",96,0)
+"RTN","C0CACTOR",93,0)
K @AMAP ; CLEAN UP BEHIND US
-"RTN","C0CACTOR",97,0)
+"RTN","C0CACTOR",94,0)
Q
-"RTN","C0CACTOR",98,0)
+"RTN","C0CACTOR",95,0)
;
-"RTN","C0CACTOR",99,0)
+"RTN","C0CACTOR",96,0)
DEIDENT(GPL,ZDFN) ; QUICK WAY TO DEIDENTIFY THE CCR
-"RTN","C0CACTOR",100,0)
+"RTN","C0CACTOR",97,0)
S @GPL@("ACTORADDRESSCITY")="ALTON"
-"RTN","C0CACTOR",101,0)
+"RTN","C0CACTOR",98,0)
S @GPL@("ACTORADDRESSLINE1")="1234 Somewhere Lane"
-"RTN","C0CACTOR",102,0)
+"RTN","C0CACTOR",99,0)
S @GPL@("ACTORADDRESSLINE2")=""
-"RTN","C0CACTOR",103,0)
+"RTN","C0CACTOR",100,0)
S @GPL@("ACTORADDRESSSOURCEID")="ACTORPATIENT_"_ZDFN
-"RTN","C0CACTOR",104,0)
+"RTN","C0CACTOR",101,0)
S @GPL@("ACTORADDRESSSTATE")="KANSAS"
-"RTN","C0CACTOR",105,0)
+"RTN","C0CACTOR",102,0)
S @GPL@("ACTORADDRESSTYPE")="Home"
-"RTN","C0CACTOR",106,0)
+"RTN","C0CACTOR",103,0)
S @GPL@("ACTORADDRESSZIPCODE")=67623
-"RTN","C0CACTOR",107,0)
+"RTN","C0CACTOR",104,0)
S @GPL@("ACTORCELLTEL")=""
-"RTN","C0CACTOR",108,0)
+"RTN","C0CACTOR",105,0)
S @GPL@("ACTORCELLTELTEXT")=""
-"RTN","C0CACTOR",109,0)
+"RTN","C0CACTOR",106,0)
S @GPL@("ACTORDATEOFBIRTH")="1957-12-25"
-"RTN","C0CACTOR",110,0)
+"RTN","C0CACTOR",107,0)
S @GPL@("ACTOREMAIL")=""
-"RTN","C0CACTOR",111,0)
+"RTN","C0CACTOR",108,0)
S @GPL@("ACTORFAMILYNAME")="ZZ PATIENT"_ZDFN
-"RTN","C0CACTOR",112,0)
+"RTN","C0CACTOR",109,0)
;S @GPL@("ACTORGENDER")="MALE"
-"RTN","C0CACTOR",113,0)
+"RTN","C0CACTOR",110,0)
S @GPL@("ACTORGIVENNAME")="TEST"_ZDFN
-"RTN","C0CACTOR",114,0)
+"RTN","C0CACTOR",111,0)
S @GPL@("ACTORIEN")=2
-"RTN","C0CACTOR",115,0)
+"RTN","C0CACTOR",112,0)
S @GPL@("ACTORMIDDLENAME")="TWO"
-"RTN","C0CACTOR",116,0)
+"RTN","C0CACTOR",113,0)
S @GPL@("ACTOROBJECTID")="ACTORPATIENT_"_ZDFN
-"RTN","C0CACTOR",117,0)
+"RTN","C0CACTOR",114,0)
S @GPL@("ACTORRESTEL")="888-555-1212"
-"RTN","C0CACTOR",118,0)
+"RTN","C0CACTOR",115,0)
S @GPL@("ACTORRESTELTEXT")="Residential Telephone"
-"RTN","C0CACTOR",119,0)
+"RTN","C0CACTOR",116,0)
S @GPL@("ACTORSOURCEID")="ACTORSYSTEM_1"
-"RTN","C0CACTOR",120,0)
+"RTN","C0CACTOR",117,0)
S @GPL@("ACTORSSN")="769122557P"
-"RTN","C0CACTOR",121,0)
+"RTN","C0CACTOR",118,0)
S @GPL@("ACTORSSNSOURCEID")="ACTORPATIENT_"_ZDFN
-"RTN","C0CACTOR",122,0)
+"RTN","C0CACTOR",119,0)
S @GPL@("ACTORSSNTEXT")="SSN"
-"RTN","C0CACTOR",123,0)
+"RTN","C0CACTOR",120,0)
S @GPL@("ACTORSUFFIXNAME")=""
-"RTN","C0CACTOR",124,0)
+"RTN","C0CACTOR",121,0)
S @GPL@("ACTORWORKTEL")="888-121-1212"
-"RTN","C0CACTOR",125,0)
+"RTN","C0CACTOR",122,0)
S @GPL@("ACTORWORKTELTEXT")="Work Telephone"
-"RTN","C0CACTOR",126,0)
+"RTN","C0CACTOR",123,0)
Q
-"RTN","C0CACTOR",127,0)
+"RTN","C0CACTOR",124,0)
;
-"RTN","C0CACTOR",128,0)
+"RTN","C0CACTOR",125,0)
PEXTRACT(AMAP,AIEN,AOID) ; EXTRACT TO RETURN ARRAY RARY PASSED BY NAME
-"RTN","C0CACTOR",129,0)
+"RTN","C0CACTOR",126,0)
N ZX
-"RTN","C0CACTOR",130,0)
+"RTN","C0CACTOR",127,0)
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","C0CACTOR",131,0)
+"RTN","C0CACTOR",128,0)
S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CDPT(AIEN)
-"RTN","C0CACTOR",132,0)
+"RTN","C0CACTOR",129,0)
S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CDPT(AIEN)
-"RTN","C0CACTOR",133,0)
+"RTN","C0CACTOR",130,0)
S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CDPT(AIEN)
-"RTN","C0CACTOR",134,0)
+"RTN","C0CACTOR",131,0)
S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^C0CDPT(AIEN)
-"RTN","C0CACTOR",135,0)
+"RTN","C0CACTOR",132,0)
S @AMAP@("ACTORGENDER")=$P($$GENDER^C0CDPT(AIEN),U,2)
-"RTN","C0CACTOR",136,0)
+"RTN","C0CACTOR",133,0)
S @AMAP@("ACTORGENDERCODE")=$P($$GENDER^C0CDPT(AIEN),U,1)
-"RTN","C0CACTOR",137,0)
+"RTN","C0CACTOR",134,0)
S @AMAP@("ACTORSSN")=""
-"RTN","C0CACTOR",138,0)
+"RTN","C0CACTOR",135,0)
S @AMAP@("ACTORSSNTEXT")=""
-"RTN","C0CACTOR",139,0)
+"RTN","C0CACTOR",136,0)
S @AMAP@("ACTORSSNSOURCEID")=""
-"RTN","C0CACTOR",140,0)
+"RTN","C0CACTOR",137,0)
S X="MSCDPTID" ; ROUTINE TO TEST FOR MRN ON OPENVISTA
-"RTN","C0CACTOR",141,0)
+"RTN","C0CACTOR",138,0)
X ^%ZOSF("TEST") ; TEST TO SEE IF THE ROUTINE EXISTS
-"RTN","C0CACTOR",142,0)
+"RTN","C0CACTOR",139,0)
I $T S MRN=$$^MSCDPTID(DFN) ;TEST FOR MRN ON OPENVISTA ;GPL
-"RTN","C0CACTOR",143,0)
+"RTN","C0CACTOR",140,0)
I $G(MRN)'="" D ; IF MRN IS PRESENT
-"RTN","C0CACTOR",144,0)
+"RTN","C0CACTOR",141,0)
. S @AMAP@("ACTORSSN")=MRN
-"RTN","C0CACTOR",145,0)
+"RTN","C0CACTOR",142,0)
. S @AMAP@("ACTORSSNTEXT")="MRN"
-"RTN","C0CACTOR",146,0)
+"RTN","C0CACTOR",143,0)
. S @AMAP@("ACTORSSNSOURCEID")=AOID
-"RTN","C0CACTOR",147,0)
+"RTN","C0CACTOR",144,0)
E D ; NO MRN, USE SSN
-"RTN","C0CACTOR",148,0)
+"RTN","C0CACTOR",145,0)
. S ZX=$$SSN^C0CDPT(AIEN)
-"RTN","C0CACTOR",149,0)
+"RTN","C0CACTOR",146,0)
. I ZX'="" D ; IF THERE IS A SSN IN THE RECORD
-"RTN","C0CACTOR",150,0)
+"RTN","C0CACTOR",147,0)
. . S @AMAP@("ACTORSSN")=ZX
-"RTN","C0CACTOR",151,0)
+"RTN","C0CACTOR",148,0)
. . S @AMAP@("ACTORSSNTEXT")="SSN"
-"RTN","C0CACTOR",152,0)
+"RTN","C0CACTOR",149,0)
. . S @AMAP@("ACTORSSNSOURCEID")=AOID
-"RTN","C0CACTOR",153,0)
+"RTN","C0CACTOR",150,0)
S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^C0CDPT(AIEN)
-"RTN","C0CACTOR",154,0)
+"RTN","C0CACTOR",151,0)
S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^C0CDPT(AIEN)
-"RTN","C0CACTOR",155,0)
+"RTN","C0CACTOR",152,0)
S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^C0CDPT(AIEN)
-"RTN","C0CACTOR",156,0)
+"RTN","C0CACTOR",153,0)
S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CDPT(AIEN)
-"RTN","C0CACTOR",157,0)
+"RTN","C0CACTOR",154,0)
S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CDPT(AIEN)
-"RTN","C0CACTOR",158,0)
+"RTN","C0CACTOR",155,0)
S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^C0CDPT(AIEN)
-"RTN","C0CACTOR",159,0)
+"RTN","C0CACTOR",156,0)
S @AMAP@("ACTORRESTEL")=""
-"RTN","C0CACTOR",160,0)
+"RTN","C0CACTOR",157,0)
S @AMAP@("ACTORRESTELTEXT")=""
-"RTN","C0CACTOR",161,0)
+"RTN","C0CACTOR",158,0)
S ZX=$$RESTEL^C0CDPT(AIEN)
-"RTN","C0CACTOR",162,0)
+"RTN","C0CACTOR",159,0)
I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
-"RTN","C0CACTOR",163,0)
+"RTN","C0CACTOR",160,0)
. S @AMAP@("ACTORRESTEL")=ZX
-"RTN","C0CACTOR",164,0)
+"RTN","C0CACTOR",161,0)
. S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
-"RTN","C0CACTOR",165,0)
+"RTN","C0CACTOR",162,0)
S @AMAP@("ACTORWORKTEL")=""
-"RTN","C0CACTOR",166,0)
+"RTN","C0CACTOR",163,0)
S @AMAP@("ACTORWORKTELTEXT")=""
-"RTN","C0CACTOR",167,0)
+"RTN","C0CACTOR",164,0)
S ZX=$$WORKTEL^C0CDPT(AIEN)
-"RTN","C0CACTOR",168,0)
+"RTN","C0CACTOR",165,0)
I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
-"RTN","C0CACTOR",169,0)
+"RTN","C0CACTOR",166,0)
. S @AMAP@("ACTORWORKTEL")=ZX
-"RTN","C0CACTOR",170,0)
+"RTN","C0CACTOR",167,0)
. S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
-"RTN","C0CACTOR",171,0)
+"RTN","C0CACTOR",168,0)
S @AMAP@("ACTORCELLTEL")=""
-"RTN","C0CACTOR",172,0)
+"RTN","C0CACTOR",169,0)
S @AMAP@("ACTORCELLTELTEXT")=""
-"RTN","C0CACTOR",173,0)
+"RTN","C0CACTOR",170,0)
S ZX=$$CELLTEL^C0CDPT(AIEN)
-"RTN","C0CACTOR",174,0)
+"RTN","C0CACTOR",171,0)
I ZX'="" D ; IF THERE IS A CELL PHONE IN THE RECORD
-"RTN","C0CACTOR",175,0)
+"RTN","C0CACTOR",172,0)
. S @AMAP@("ACTORCELLTEL")=ZX
-"RTN","C0CACTOR",176,0)
+"RTN","C0CACTOR",173,0)
. S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
-"RTN","C0CACTOR",177,0)
+"RTN","C0CACTOR",174,0)
S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CDPT(AIEN)
-"RTN","C0CACTOR",178,0)
+"RTN","C0CACTOR",175,0)
S @AMAP@("ACTORADDRESSSOURCEID")=AOID
-"RTN","C0CACTOR",179,0)
+"RTN","C0CACTOR",176,0)
S @AMAP@("ACTORIEN")=AIEN
-"RTN","C0CACTOR",180,0)
+"RTN","C0CACTOR",177,0)
S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
-"RTN","C0CACTOR",181,0)
+"RTN","C0CACTOR",178,0)
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-"RTN","C0CACTOR",182,0)
+"RTN","C0CACTOR",179,0)
Q
-"RTN","C0CACTOR",183,0)
+"RTN","C0CACTOR",180,0)
;
-"RTN","C0CACTOR",184,0)
+"RTN","C0CACTOR",181,0)
MAP(INXML,AMAP,OUTXML) ;MAP ANY ACTOR TO XML
-"RTN","C0CACTOR",185,0)
+"RTN","C0CACTOR",182,0)
D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","C0CACTOR",186,0)
+"RTN","C0CACTOR",183,0)
Q
-"RTN","C0CACTOR",187,0)
+"RTN","C0CACTOR",184,0)
;
-"RTN","C0CACTOR",188,0)
+"RTN","C0CACTOR",185,0)
SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
+"RTN","C0CACTOR",186,0)
+ ;
+"RTN","C0CACTOR",187,0)
+ ; N AMAP
+"RTN","C0CACTOR",188,0)
+ S AMAP=$NA(^TMP($J,"AMAP"))
"RTN","C0CACTOR",189,0)
- ;
+ K @AMAP
"RTN","C0CACTOR",190,0)
- ; N AMAP
+ S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
"RTN","C0CACTOR",191,0)
- S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","C0CACTOR",192,0)
- K @AMAP
-"RTN","C0CACTOR",193,0)
- S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","C0CACTOR",194,0)
S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^C0CSYS
-"RTN","C0CACTOR",195,0)
+"RTN","C0CACTOR",192,0)
S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^C0CSYS
-"RTN","C0CACTOR",196,0)
+"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",197,0)
- D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","C0CACTOR",198,0)
- Q
-"RTN","C0CACTOR",199,0)
- ;
-"RTN","C0CACTOR",200,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",200,0)
+ S AMAP=$NA(^TMP($J,"AMAP"))
"RTN","C0CACTOR",201,0)
- ;
+ K @AMAP
"RTN","C0CACTOR",202,0)
- ; N AMAP
+ S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
"RTN","C0CACTOR",203,0)
- S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","C0CACTOR",204,0)
- K @AMAP
-"RTN","C0CACTOR",205,0)
- S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","C0CACTOR",206,0)
S @AMAP@("ACTORDISPLAYNAME")=""
-"RTN","C0CACTOR",207,0)
+"RTN","C0CACTOR",204,0)
S @AMAP@("ACTORRELATION")=""
-"RTN","C0CACTOR",208,0)
+"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",208,0)
+ Q
"RTN","C0CACTOR",209,0)
- S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+ ;
"RTN","C0CACTOR",210,0)
- D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","C0CACTOR",211,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",211,0)
;
-"RTN","C0CACTOR",215,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 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)
+"RTN","C0CACTOR",217,0)
S ZIEN=$P(ZSITE,"^",1)
-"RTN","C0CACTOR",221,0)
+"RTN","C0CACTOR",218,0)
S @AMAP@("ORGANIZATIONNAME")=$P(ZSITE,U,2)
-"RTN","C0CACTOR",222,0)
+"RTN","C0CACTOR",219,0)
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
-"RTN","C0CACTOR",223,0)
+"RTN","C0CACTOR",220,0)
S @AMAP@("ACTORADDRESSTYPE")="Office"
-"RTN","C0CACTOR",224,0)
+"RTN","C0CACTOR",221,0)
S @AMAP@("ACTORADDRESSLINE1")=$$GET1^DIQ(4,ZIEN_",",1.01)
-"RTN","C0CACTOR",225,0)
+"RTN","C0CACTOR",222,0)
S @AMAP@("ACTORADDRESSLINE2")=$$GET1^DIQ(4,ZIEN_",",1.02)
-"RTN","C0CACTOR",226,0)
+"RTN","C0CACTOR",223,0)
S @AMAP@("ACTORADDRESSCITY")=$$GET1^DIQ(4,ZIEN_",",1.03)
-"RTN","C0CACTOR",227,0)
+"RTN","C0CACTOR",224,0)
S @AMAP@("ACTORADDRESSSTATE")=$$GET1^DIQ(4,ZIEN_",",.02)
-"RTN","C0CACTOR",228,0)
+"RTN","C0CACTOR",225,0)
S @AMAP@("ACTORPOSTALCODE")=$$GET1^DIQ(4,ZIEN_",",1.04)
-"RTN","C0CACTOR",229,0)
+"RTN","C0CACTOR",226,0)
S @AMAP@("ACTORTELEPHONE")=""
-"RTN","C0CACTOR",230,0)
+"RTN","C0CACTOR",227,0)
S @AMAP@("ACTORTELEPHONETYPE")=""
-"RTN","C0CACTOR",231,0)
+"RTN","C0CACTOR",228,0)
S ZX=$$GET1^DIQ(4.03,"1,"_ZIEN_",",.03)
-"RTN","C0CACTOR",232,0)
+"RTN","C0CACTOR",229,0)
I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE
-"RTN","C0CACTOR",233,0)
+"RTN","C0CACTOR",230,0)
. S @AMAP@("ACTORTELEPHONE")=ZX
-"RTN","C0CACTOR",234,0)
+"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)
- 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",237,0)
;
-"RTN","C0CACTOR",241,0)
+"RTN","C0CACTOR",238,0)
; N AMAP
-"RTN","C0CACTOR",242,0)
+"RTN","C0CACTOR",239,0)
S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","C0CACTOR",243,0)
+"RTN","C0CACTOR",240,0)
K @AMAP
-"RTN","C0CACTOR",244,0)
+"RTN","C0CACTOR",241,0)
I '$D(^VA(200,AIEN,0)) D Q ; IF NO PROVIDER RECORD (SHOULDN'T HAPPEN)
-"RTN","C0CACTOR",245,0)
+"RTN","C0CACTOR",242,0)
. W "WARNING - MISSING PROVIDER: ",AIEN,!
-"RTN","C0CACTOR",246,0)
+"RTN","C0CACTOR",243,0)
. S @OUTXML@(0)=0 ; SIGNAL NO OUTPUT
-"RTN","C0CACTOR",247,0)
+"RTN","C0CACTOR",244,0)
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","C0CACTOR",248,0)
+"RTN","C0CACTOR",245,0)
S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CVA200(AIEN)
-"RTN","C0CACTOR",249,0)
+"RTN","C0CACTOR",246,0)
S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CVA200(AIEN)
-"RTN","C0CACTOR",250,0)
+"RTN","C0CACTOR",247,0)
S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CVA200(AIEN)
-"RTN","C0CACTOR",251,0)
+"RTN","C0CACTOR",248,0)
S @AMAP@("ACTORTITLE")=$$TITLE^C0CVA200(AIEN)
-"RTN","C0CACTOR",252,0)
+"RTN","C0CACTOR",249,0)
S @AMAP@("IDTYPE")=$P($$NPI^C0CVA200(AIEN),U,1)
-"RTN","C0CACTOR",253,0)
+"RTN","C0CACTOR",250,0)
S @AMAP@("ID")=$P($$NPI^C0CVA200(AIEN),U,2)
-"RTN","C0CACTOR",254,0)
+"RTN","C0CACTOR",251,0)
S @AMAP@("IDDESC")=$P($$NPI^C0CVA200(AIEN),U,3)
-"RTN","C0CACTOR",255,0)
+"RTN","C0CACTOR",252,0)
S @AMAP@("ACTORSPECIALITY")=$$SPEC^C0CVA200(AIEN)
-"RTN","C0CACTOR",256,0)
+"RTN","C0CACTOR",253,0)
S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^C0CVA200(AIEN)
-"RTN","C0CACTOR",257,0)
+"RTN","C0CACTOR",254,0)
S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^C0CVA200(AIEN)
-"RTN","C0CACTOR",258,0)
+"RTN","C0CACTOR",255,0)
S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CVA200(AIEN)
-"RTN","C0CACTOR",259,0)
+"RTN","C0CACTOR",256,0)
S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CVA200(AIEN)
-"RTN","C0CACTOR",260,0)
+"RTN","C0CACTOR",257,0)
S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^C0CVA200(AIEN)
-"RTN","C0CACTOR",261,0)
+"RTN","C0CACTOR",258,0)
S @AMAP@("ACTORTELEPHONE")=""
-"RTN","C0CACTOR",262,0)
+"RTN","C0CACTOR",259,0)
S @AMAP@("ACTORTELEPHONETYPE")=""
-"RTN","C0CACTOR",263,0)
+"RTN","C0CACTOR",260,0)
S ZX=$$TEL^C0CVA200(AIEN)
-"RTN","C0CACTOR",264,0)
+"RTN","C0CACTOR",261,0)
I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE
-"RTN","C0CACTOR",265,0)
+"RTN","C0CACTOR",262,0)
. S @AMAP@("ACTORTELEPHONE")=ZX
-"RTN","C0CACTOR",266,0)
+"RTN","C0CACTOR",263,0)
. S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^C0CVA200(AIEN)
-"RTN","C0CACTOR",267,0)
+"RTN","C0CACTOR",264,0)
S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CVA200(AIEN)
-"RTN","C0CACTOR",268,0)
+"RTN","C0CACTOR",265,0)
S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
-"RTN","C0CACTOR",269,0)
+"RTN","C0CACTOR",266,0)
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-"RTN","C0CACTOR",270,0)
+"RTN","C0CACTOR",267,0)
S @AMAP@("ACTORORGLINK")="ACTORORGANIZATION_1"
-"RTN","C0CACTOR",271,0)
+"RTN","C0CACTOR",268,0)
D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","C0CACTOR",272,0)
+"RTN","C0CACTOR",269,0)
Q
-"RTN","C0CACTOR",273,0)
+"RTN","C0CACTOR",270,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 .
"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.
-"RTN","C0CALERT",20,0)
- ;
-"RTN","C0CALERT",21,0)
W "NO ENTRY FROM TOP",!
+"RTN","C0CALERT",20,0)
+ Q
+"RTN","C0CALERT",21,0)
+ ;
"RTN","C0CALERT",22,0)
- Q
-"RTN","C0CALERT",23,0)
- ;
-"RTN","C0CALERT",24,0)
EXTRACT(ALTXML,DFN,ALTOUTXML,CALLBK) ; EXTRACT ALERTS INTO XML TEMPLATE
-"RTN","C0CALERT",25,0)
+"RTN","C0CALERT",23,0)
; CALLBACK IF PROVIDED IS CALLED FOR EACH ALLERGY BEFORE MAPPING
-"RTN","C0CALERT",26,0)
+"RTN","C0CALERT",24,0)
; ALTXML AND ALTOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","C0CALERT",27,0)
+"RTN","C0CALERT",25,0)
;
-"RTN","C0CALERT",28,0)
+"RTN","C0CALERT",26,0)
; GET ADVERSE REACTIONS AND ALLERGIES
-"RTN","C0CALERT",29,0)
+"RTN","C0CALERT",27,0)
; N GMRA,GMRAL ; FOR DEBUGGING, DON'T NEW THESE VARIABLES
-"RTN","C0CALERT",30,0)
+"RTN","C0CALERT",28,0)
S GMRA="0^0^111"
-"RTN","C0CALERT",31,0)
+"RTN","C0CALERT",29,0)
D EN1^GMRADPT
-"RTN","C0CALERT",32,0)
- I $G(GMRAL)'=1 D Q ; NO ALLERGIES FOUND THUS *QUIT*
-"RTN","C0CALERT",33,0)
+"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",34,0)
+"RTN","C0CALERT",32,0)
; DEFINE MAPPING
-"RTN","C0CALERT",35,0)
+"RTN","C0CALERT",33,0)
N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP
-"RTN","C0CALERT",36,0)
+"RTN","C0CALERT",34,0)
S ALTTVMAP=$NA(^TMP("C0CCCR",$J,"ALERTS"))
-"RTN","C0CALERT",37,0)
+"RTN","C0CALERT",35,0)
S ALTTARYTMP=$NA(^TMP("C0CCCR",$J,"ALERTSARYTMP"))
-"RTN","C0CALERT",38,0)
+"RTN","C0CALERT",36,0)
K @ALTTVMAP,@ALTTARYTMP
-"RTN","C0CALERT",39,0)
+"RTN","C0CALERT",37,0)
N ALTTMP,ALTCNT S ALTG=$NA(GMRAL),ALTCNT=1
-"RTN","C0CALERT",40,0)
+"RTN","C0CALERT",38,0)
S ALTTMP="" ;
-"RTN","C0CALERT",41,0)
+"RTN","C0CALERT",39,0)
F S ALTTMP=$O(@ALTG@(ALTTMP)) Q:ALTTMP="" D ; CHANGED TO $O BY GPL
-"RTN","C0CALERT",42,0)
+"RTN","C0CALERT",40,0)
. W "ALTTMP="_ALTTMP,!
-"RTN","C0CALERT",43,0)
+"RTN","C0CALERT",41,0)
. ; I $QS(ALTTMP,2)="S" W !,"S FOUND",! Q
-"RTN","C0CALERT",44,0)
+"RTN","C0CALERT",42,0)
. S ALTVMAP=$NA(@ALTTVMAP@(ALTCNT))
-"RTN","C0CALERT",45,0)
+"RTN","C0CALERT",43,0)
. K @ALTVMAP
-"RTN","C0CALERT",46,0)
+"RTN","C0CALERT",44,0)
. S @ALTVMAP@("ALERTOBJECTID")="ALERT"_ALTCNT
-"RTN","C0CALERT",47,0)
+"RTN","C0CALERT",45,0)
. N A1 S A1=@ALTG@(ALTTMP) ; ALL THE PIECES
-"RTN","C0CALERT",48,0)
+"RTN","C0CALERT",46,0)
. I $D(CALLBK) D @CALLBK ;CALLBACK FOR EPRESCRIBING
-"RTN","C0CALERT",49,0)
+"RTN","C0CALERT",47,0)
. N A2 S A2=$$GET1^DIQ(120.8,ALTTMP,"MECHANISM","I") ; MECHANISM
-"RTN","C0CALERT",50,0)
+"RTN","C0CALERT",48,0)
. N A3 S A3=$P(A1,U,5) ; ADVERSE FLAG
-"RTN","C0CALERT",51,0)
+"RTN","C0CALERT",49,0)
. N ADT S ADT="Patient has an " ; X $ZINT H 5
-"RTN","C0CALERT",52,0)
+"RTN","C0CALERT",50,0)
. S ADT=ADT_$S(A2="P":"ADVERSE",A2="A":"ALLERGIC",1:"UNKNOWN")
-"RTN","C0CALERT",53,0)
+"RTN","C0CALERT",51,0)
. S ADT=ADT_" reaction to "_$P(@ALTG@(ALTTMP),U,2)_"."
-"RTN","C0CALERT",54,0)
+"RTN","C0CALERT",52,0)
. S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT
-"RTN","C0CALERT",55,0)
+"RTN","C0CALERT",53,0)
. N ADTY S ADTY=$S(A2="P":"Adverse Reaction",A2="A":"Allergy",1:"") ;
-"RTN","C0CALERT",56,0)
+"RTN","C0CALERT",54,0)
. S @ALTVMAP@("ALERTTYPE")=ADTY ; type of allergy
-"RTN","C0CALERT",57,0)
+"RTN","C0CALERT",55,0)
. N ALTCDE ; SNOMED CODE THE THE ALERT
-"RTN","C0CALERT",58,0)
+"RTN","C0CALERT",56,0)
. S ALTCDE=$S(A2="P":"282100009",A2="A":"416098002",1:"") ; IF NOT ADVERSE, IT IS ALLERGIC
-"RTN","C0CALERT",59,0)
+"RTN","C0CALERT",57,0)
. S @ALTVMAP@("ALERTCODEVALUE")=ALTCDE ;
-"RTN","C0CALERT",60,0)
+"RTN","C0CALERT",58,0)
. ; WILL USE 418634005 FOR ALLERGIC REACTION TO A SUBSTANCE
-"RTN","C0CALERT",61,0)
+"RTN","C0CALERT",59,0)
. ; AND 282100009 FOR ADVERSE REACTION TO A SUBSTANCE
-"RTN","C0CALERT",62,0)
+"RTN","C0CALERT",60,0)
. I ALTCDE'="" D ; IF THERE IS A CODE
-"RTN","C0CALERT",63,0)
+"RTN","C0CALERT",61,0)
. . S @ALTVMAP@("ALERTCODESYSTEM")="SNOMED CT"
-"RTN","C0CALERT",64,0)
+"RTN","C0CALERT",62,0)
. . S @ALTVMAP@("ALERTCODESYSTEMVERSION")="2008"
-"RTN","C0CALERT",65,0)
+"RTN","C0CALERT",63,0)
. E D ; SET TO NULL
-"RTN","C0CALERT",66,0)
+"RTN","C0CALERT",64,0)
. . S @ALTVMAP@("ALERTCODESYSTEM")=""
-"RTN","C0CALERT",67,0)
+"RTN","C0CALERT",65,0)
. . S @ALTVMAP@("ALERTCODESYSTEMVERSION")=""
-"RTN","C0CALERT",68,0)
+"RTN","C0CALERT",66,0)
. S @ALTVMAP@("ALERTSTATUSTEXT")="" ; WHERE DO WE GET THIS?
-"RTN","C0CALERT",69,0)
+"RTN","C0CALERT",67,0)
. N ALTPROV S ALTPROV=$P(^GMR(120.8,ALTTMP,0),U,5) ; SOURCE PROVIDER IEN
-"RTN","C0CALERT",70,0)
+"RTN","C0CALERT",68,0)
. I ALTPROV'="" D ; PROVIDER PROVIDEED
-"RTN","C0CALERT",71,0)
+"RTN","C0CALERT",69,0)
. . S @ALTVMAP@("ALERTSOURCEID")="ACTORPROVIDER_"_ALTPROV
-"RTN","C0CALERT",72,0)
+"RTN","C0CALERT",70,0)
. E S @ALTVMAP@("ALERTSOURCEID")="" ; SOURCE NULL - SHOULD NOT HAPPEN
-"RTN","C0CALERT",73,0)
+"RTN","C0CALERT",71,0)
. W "RUNNING ALERTS, PROVIDER: ",@ALTVMAP@("ALERTSOURCEID"),!
-"RTN","C0CALERT",74,0)
+"RTN","C0CALERT",72,0)
. N ACGL1,ACGFI,ACIEN,ACVUID,ACNM,ACTMP
-"RTN","C0CALERT",75,0)
+"RTN","C0CALERT",73,0)
. S ACGL1=$P(@ALTG@(ALTTMP),U,9) ; ADDRESS OF THE REACTANT XX;GLB(YY.Z,
-"RTN","C0CALERT",76,0)
+"RTN","C0CALERT",74,0)
. S ACGFI=$$PRSGLB($P(ACGL1,";",2)) ; FILE NUMBER
-"RTN","C0CALERT",77,0)
+"RTN","C0CALERT",75,0)
. S ACIEN=$P(ACGL1,";",1) ; IEN OF REACTANT
-"RTN","C0CALERT",78,0)
+"RTN","C0CALERT",76,0)
. S ACVUID=$$GET1^DIQ(ACGFI,ACIEN,"VUID") ; VUID OF THE REACTANT
-"RTN","C0CALERT",79,0)
+"RTN","C0CALERT",77,0)
. S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="PRODUCT_"_ACIEN ; IE OF REACTANT
-"RTN","C0CALERT",80,0)
+"RTN","C0CALERT",78,0)
. S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="" ; WHERE DO WE GET THIS?
-"RTN","C0CALERT",81,0)
+"RTN","C0CALERT",79,0)
. S ACNM=$P(@ALTG@(ALTTMP),U,2) ; REACTANT
-"RTN","C0CALERT",82,0)
+"RTN","C0CALERT",80,0)
. S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM
-"RTN","C0CALERT",83,0)
+"RTN","C0CALERT",81,0)
. N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION
-"RTN","C0CALERT",84,0)
+"RTN","C0CALERT",82,0)
. S (ZC,ZCD,ZCDS,ZCDSV)="" ; INITIALIZE
-"RTN","C0CALERT",85,0)
+"RTN","C0CALERT",83,0)
. I ACVUID'="" D ; IF VUID IS NOT NULL
-"RTN","C0CALERT",86,0)
+"RTN","C0CALERT",84,0)
. . S ZC=$$CODE^C0CUTIL(ACVUID)
-"RTN","C0CALERT",87,0)
+"RTN","C0CALERT",85,0)
. . S ZCD=$P(ZC,"^",1) ; CODE TO USE
-"RTN","C0CALERT",88,0)
+"RTN","C0CALERT",86,0)
. . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID
-"RTN","C0CALERT",89,0)
+"RTN","C0CALERT",87,0)
. . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION
-"RTN","C0CALERT",90,0)
+"RTN","C0CALERT",88,0)
. E D ; IF REACTANT CODE VALUE IS NULL
-"RTN","C0CALERT",91,0)
+"RTN","C0CALERT",89,0)
. . I $G(DUZ("AG"))="I" D ; IF WE ARE RUNNING ON RPMS
-"RTN","C0CALERT",92,0)
+"RTN","C0CALERT",90,0)
. . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ;
-"RTN","C0CALERT",93,0)
+"RTN","C0CALERT",91,0)
. . . W "RPMS NAME FOUND",ACNM," ",ACTMP,!
-"RTN","C0CALERT",94,0)
+"RTN","C0CALERT",92,0)
. . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=""
-"RTN","C0CALERT",95,0)
+"RTN","C0CALERT",93,0)
. . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=""
-"RTN","C0CALERT",96,0)
+"RTN","C0CALERT",94,0)
. S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ZCD
-"RTN","C0CALERT",97,0)
+"RTN","C0CALERT",95,0)
. S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=ZCDS
-"RTN","C0CALERT",98,0)
+"RTN","C0CALERT",96,0)
. S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM_" "_ZCDS_": "_ZCD
-"RTN","C0CALERT",99,0)
+"RTN","C0CALERT",97,0)
. S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT_" "_ZCDS_": "_ZCD
-"RTN","C0CALERT",100,0)
+"RTN","C0CALERT",98,0)
. ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW
-"RTN","C0CALERT",101,0)
+"RTN","C0CALERT",99,0)
. N ARTMP,ARIEN,ARDES,ARVUID
-"RTN","C0CALERT",102,0)
+"RTN","C0CALERT",100,0)
. S (ARTMP,ARDES,ARVUID)=""
-"RTN","C0CALERT",103,0)
+"RTN","C0CALERT",101,0)
. I $D(@ALTG@(ALTTMP,"S",1)) D ; IF REACTION EXISTS
-"RTN","C0CALERT",104,0)
+"RTN","C0CALERT",102,0)
. . S ARTMP=@ALTG@(ALTTMP,"S",1)
-"RTN","C0CALERT",105,0)
+"RTN","C0CALERT",103,0)
. . W "REACTION:",ARTMP,!
-"RTN","C0CALERT",106,0)
+"RTN","C0CALERT",104,0)
. . S ARIEN=$P(ARTMP,";",2)
-"RTN","C0CALERT",107,0)
+"RTN","C0CALERT",105,0)
. . S ARDES=$P(ARTMP,";",1)
-"RTN","C0CALERT",108,0)
+"RTN","C0CALERT",106,0)
. . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID")
-"RTN","C0CALERT",109,0)
+"RTN","C0CALERT",107,0)
. S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES
-"RTN","C0CALERT",110,0)
+"RTN","C0CALERT",108,0)
. I ARVUID'="" D ; IF REACTION VUID IS NOT NULL
-"RTN","C0CALERT",111,0)
+"RTN","C0CALERT",109,0)
. . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID
-"RTN","C0CALERT",112,0)
+"RTN","C0CALERT",110,0)
. . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID"
-"RTN","C0CALERT",113,0)
+"RTN","C0CALERT",111,0)
. E D ; IF IT IS NULL DON'T SET CODE SYSTEM
-"RTN","C0CALERT",114,0)
+"RTN","C0CALERT",112,0)
. . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=""
-"RTN","C0CALERT",115,0)
+"RTN","C0CALERT",113,0)
. . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")=""
-"RTN","C0CALERT",116,0)
+"RTN","C0CALERT",114,0)
. S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))
-"RTN","C0CALERT",117,0)
+"RTN","C0CALERT",115,0)
. ; NOW GO TO THE GLOBAL TO GET THE DATE/TIME AND BETTER DESCRIPTION
-"RTN","C0CALERT",118,0)
+"RTN","C0CALERT",116,0)
. N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL
-"RTN","C0CALERT",119,0)
+"RTN","C0CALERT",117,0)
. D GETN1^C0CRNF("C0CG1",120.8,ALTTMP,"") ;GET VALUES BY NAME
-"RTN","C0CALERT",120,0)
+"RTN","C0CALERT",118,0)
. S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1")
-"RTN","C0CALERT",121,0)
+"RTN","C0CALERT",119,0)
. S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT,"DT")
-"RTN","C0CALERT",122,0)
+"RTN","C0CALERT",120,0)
. K @ALTARYTMP
-"RTN","C0CALERT",123,0)
+"RTN","C0CALERT",121,0)
. D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP)
-"RTN","C0CALERT",124,0)
+"RTN","C0CALERT",122,0)
. I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML)
-"RTN","C0CALERT",125,0)
+"RTN","C0CALERT",123,0)
. I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP)
-"RTN","C0CALERT",126,0)
+"RTN","C0CALERT",124,0)
. S ALTCNT=ALTCNT+1
-"RTN","C0CALERT",127,0)
+"RTN","C0CALERT",125,0)
S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS
-"RTN","C0CALERT",128,0)
+"RTN","C0CALERT",126,0)
Q
-"RTN","C0CALERT",129,0)
+"RTN","C0CALERT",127,0)
PRSGLB(INGLB) ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER
-"RTN","C0CALERT",130,0)
+"RTN","C0CALERT",128,0)
; INGLB IS OF THE FORM: PSNDF(50.6,
-"RTN","C0CALERT",131,0)
+"RTN","C0CALERT",129,0)
; RETURN 50.6
-"RTN","C0CALERT",132,0)
+"RTN","C0CALERT",130,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 .
"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)
- ;
-"RTN","C0CBAT",20,0)
W "This is the CCR Batch Utility Library ",!
+"RTN","C0CBAT",20,0)
+ Q
"RTN","C0CBAT",21,0)
- Q
+ ;
"RTN","C0CBAT",22,0)
- ;
-"RTN","C0CBAT",23,0)
STOP ; STOP A CURRENTLY RUNNING BATCH JOB
-"RTN","C0CBAT",24,0)
+"RTN","C0CBAT",23,0)
I '$D(^TMP("C0CBAT","RUNNING")) Q ;
-"RTN","C0CBAT",25,0)
+"RTN","C0CBAT",24,0)
W !,!,"HALTING CCR BATCH",!
-"RTN","C0CBAT",26,0)
+"RTN","C0CBAT",25,0)
S ^TMP("C0CBAT","STOP")="" ; SIGNAL JOB TO TERMINATE
-"RTN","C0CBAT",27,0)
+"RTN","C0CBAT",26,0)
H 10 ; WAIT TEN SECONDS FOR SIGNAL TO BE RECEIVED
-"RTN","C0CBAT",28,0)
+"RTN","C0CBAT",27,0)
I '$D(^TMP("C0CBAT","STOP")) D ; SIGNAL RECEIVED
-"RTN","C0CBAT",29,0)
+"RTN","C0CBAT",28,0)
. W "CCR BATCH JOB TERMINATING",!
-"RTN","C0CBAT",30,0)
+"RTN","C0CBAT",29,0)
E D ;
-"RTN","C0CBAT",31,0)
+"RTN","C0CBAT",30,0)
. K ^TMP("C0CBAT","STOP") ; STOP SIGNALING
-"RTN","C0CBAT",32,0)
+"RTN","C0CBAT",31,0)
. W !,"BATCH PROCESSING APPARENTLY NOT RUNNING",!
+"RTN","C0CBAT",32,0)
+ Q
"RTN","C0CBAT",33,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",35,0)
+ ;
"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)
+"RTN","C0CBAT",37,0)
. W !,"CCR BATCH ALREADY RUNNING",!
-"RTN","C0CBAT",39,0)
+"RTN","C0CBAT",38,0)
. W !,"STOP FIRST WITH STOP^C0CBAT",!
-"RTN","C0CBAT",40,0)
+"RTN","C0CBAT",39,0)
N ZTRTN,ZTDESC,ZTDTH,ZTSAVE,ZTSK,ZTIO
-"RTN","C0CBAT",41,0)
+"RTN","C0CBAT",40,0)
S ZTRTN="EN^C0CBAT",ZTDESC="CCR Batch"
-"RTN","C0CBAT",42,0)
+"RTN","C0CBAT",41,0)
S ZTDTH=$H ;
-"RTN","C0CBAT",43,0)
+"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",44,0)
+"RTN","C0CBAT",43,0)
S ZTSAVE("C0C")="",ZTSAVE("C0C*")=""
-"RTN","C0CBAT",45,0)
+"RTN","C0CBAT",44,0)
S ZTIO="NULL" ;
-"RTN","C0CBAT",46,0)
+"RTN","C0CBAT",45,0)
W !,!,"CCR BATCH JOB STARTED",!
-"RTN","C0CBAT",47,0)
+"RTN","C0CBAT",46,0)
D ^%ZTLOAD
+"RTN","C0CBAT",47,0)
+ Q
"RTN","C0CBAT",48,0)
- Q
+ ;
"RTN","C0CBAT",49,0)
- ;
-"RTN","C0CBAT",50,0)
EN ; BATCH ENTRY POINT
-"RTN","C0CBAT",51,0)
+"RTN","C0CBAT",50,0)
; PROCESSES THE SUBSCRIPTION FILE, EXTRACTING CCR VARIABLES FOR EACH
-"RTN","C0CBAT",52,0)
+"RTN","C0CBAT",51,0)
; PATIENT WITH AN ACTIVE SUBSCRIPTION, AND IF CHECKSUMS INDICATE A CHANGE,
-"RTN","C0CBAT",53,0)
+"RTN","C0CBAT",52,0)
; GENERATES A NEW CCR FOR THE PATIENT
-"RTN","C0CBAT",54,0)
+"RTN","C0CBAT",53,0)
; UPDATES THE E2 CCR ELEMENTS FILE
+"RTN","C0CBAT",54,0)
+ ;
"RTN","C0CBAT",55,0)
- ;
-"RTN","C0CBAT",56,0)
S C0CQT=1 ; QUIET MODE
-"RTN","C0CBAT",57,0)
+"RTN","C0CBAT",56,0)
I $D(^TMP("C0CBAT","RUNNING")) Q ; ONLY ONE AT A TIME
-"RTN","C0CBAT",58,0)
+"RTN","C0CBAT",57,0)
S ^TMP("C0CBAT","RUNNING")="" ; RUNNING SIGNAL
-"RTN","C0CBAT",59,0)
+"RTN","C0CBAT",58,0)
S C0CBDT=$$NOW^XLFDT ; DATE OF THIS RUN
-"RTN","C0CBAT",60,0)
+"RTN","C0CBAT",59,0)
S C0CBF=177.301 ; FILE NUMBER OF C0C BATCH CONTROL FILE
-"RTN","C0CBAT",61,0)
+"RTN","C0CBAT",60,0)
S C0CBFR=177.3013 ; FILE NUMBER OF UPDATE SUBFILE
-"RTN","C0CBAT",62,0)
+"RTN","C0CBAT",61,0)
S C0CBB=$NA(^TMP("C0CBATCH",C0CBDT)) ; BATCH WORK AREA
-"RTN","C0CBAT",63,0)
+"RTN","C0CBAT",62,0)
I $D(@C0CBB@(0)) D ; ERROR SHOULDN'T EXIST
-"RTN","C0CBAT",64,0)
+"RTN","C0CBAT",63,0)
. W "WORK AREA ERROR",!
+"RTN","C0CBAT",64,0)
+ . S $EC=",U1,"
"RTN","C0CBAT",65,0)
- . B
-"RTN","C0CBAT",66,0)
S @C0CBB@(0)="V22" ; VERSION USED TO CREATE THIS WORK AREA
-"RTN","C0CBAT",67,0)
+"RTN","C0CBAT",66,0)
S C0CBH=$NA(@C0CBB@("HOTLIST")) ; BASE FOR HOT LIST
-"RTN","C0CBAT",68,0)
+"RTN","C0CBAT",67,0)
S C0CBS=$NA(^C0CS("B")) ; SUBSCRIPTION LIST BASE
-"RTN","C0CBAT",69,0)
+"RTN","C0CBAT",68,0)
;I $D(^C0CB("B",C0CDT)) D ; BATCH RECORD EXISTS
-"RTN","C0CBAT",70,0)
+"RTN","C0CBAT",69,0)
;. H 10 ; HANG 10 SECONDS
-"RTN","C0CBAT",71,0)
+"RTN","C0CBAT",70,0)
;. S C0CBDT=$$NOW^XLFDT ; NEW DATE FOR THIS RUN
-"RTN","C0CBAT",72,0)
+"RTN","C0CBAT",71,0)
;. I $D(^C0CB("B",C0CDT)) B ;DIDN'T WORK
-"RTN","C0CBAT",73,0)
+"RTN","C0CBAT",72,0)
D BLDHOT(C0CBH) ; BUILD THE HOT LIST
-"RTN","C0CBAT",74,0)
+"RTN","C0CBAT",73,0)
S C0CHN=$$COUNT(C0CBH) ;COUNT NUMBER IN HOT LIST
-"RTN","C0CBAT",75,0)
+"RTN","C0CBAT",74,0)
S C0CSN=$$COUNT(C0CBS) ;COUNT NUMBER OF PATIENTS WITH SUBSCRIPTIONS
-"RTN","C0CBAT",76,0)
+"RTN","C0CBAT",75,0)
S C0CFDA(C0CBF,"+1,",.01)=C0CBDT ; DATE KEY OF BATCH CONTROL
-"RTN","C0CBAT",77,0)
+"RTN","C0CBAT",76,0)
S C0CFDA(C0CBF,"+1,",.02)=C0CBDT ; BATCH ID IS DATE IN STRING FORM
-"RTN","C0CBAT",78,0)
+"RTN","C0CBAT",77,0)
S C0CFDA(C0CBF,"+1,",1)=C0CSN ; TOTAL SUBSCRIPTIONS
-"RTN","C0CBAT",79,0)
+"RTN","C0CBAT",78,0)
S C0CFDA(C0CBF,"+1,",2)=C0CHN ; TOTAL HOT LIST
-"RTN","C0CBAT",80,0)
+"RTN","C0CBAT",79,0)
D UPDIE ; CREATE THE BATCH RECORD
-"RTN","C0CBAT",81,0)
+"RTN","C0CBAT",80,0)
S C0CIEN=$O(^C0CB("B",C0CBDT,""))
-"RTN","C0CBAT",82,0)
+"RTN","C0CBAT",81,0)
S (C0CN,C0CNH)=0 ; COUNTERS FOR TOTAL AND HOT LIST
-"RTN","C0CBAT",83,0)
+"RTN","C0CBAT",82,0)
S C0CBCUR="" ; CURRENT PATIENT
-"RTN","C0CBAT",84,0)
+"RTN","C0CBAT",83,0)
S C0CSTOP=0 ; STOP FLAG FOR HALTING BATCH SET ^TMP("C0CBAT","STOP")=""
-"RTN","C0CBAT",85,0)
+"RTN","C0CBAT",84,0)
;F S C0CBCUR=$O(@C0CBH@(C0CBCUR),-1) Q:C0CBCUR="" D ; HOT LIST LATEST FIRST
-"RTN","C0CBAT",86,0)
+"RTN","C0CBAT",85,0)
F S C0CBCUR=$O(@C0CBH@(C0CBCUR)) Q:(C0CSTOP)!(C0CBCUR="") D ; HOT LIST FIRST
-"RTN","C0CBAT",87,0)
+"RTN","C0CBAT",86,0)
. D ANALYZE^C0CRIMA(C0CBCUR,1,"LABLIMIT:T-900^VITLIMIT:T-900")
-"RTN","C0CBAT",88,0)
+"RTN","C0CBAT",87,0)
. I $G(C0CCHK) D ;
+"RTN","C0CBAT",88,0)
+ . . D PUTRIM^C0CFM2(C0CBCUR)
"RTN","C0CBAT",89,0)
- . . D PUTRIM^C0CFM2(C0CBCUR)
+ . . D XPAT^C0CCCR(C0CBCUR) ; IF VARIABLES HAVE CHANGED GENERATE CCR
"RTN","C0CBAT",90,0)
- . . D XPAT^C0CCCR(C0CBCUR) ; IF VARIABLES HAVE CHANGED GENERATE CCR
+ . . K C0CFDA
"RTN","C0CBAT",91,0)
- . . K C0CFDA
+ . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",.01)=C0CBCUR
"RTN","C0CBAT",92,0)
- . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",.01)=C0CBCUR
+ . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",1)="Y"
"RTN","C0CBAT",93,0)
- . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",1)="Y"
+ . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",2)=$G(^TMP("C0CCCR","FNAME",C0CBCUR))
"RTN","C0CBAT",94,0)
- . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",2)=$G(^TMP("C0CCCR","FNAME",C0CBCUR))
+ . . D UPDIE ; CREATE UPDATE SUBFILE
"RTN","C0CBAT",95,0)
- . . D UPDIE ; CREATE UPDATE SUBFILE
+ . S C0CN=C0CN+1 ; INCREMENT NUMBER IN TOTAL
"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",97,0)
+ . S C0CFDA(C0CBF,C0CIEN_",",1.1)=C0CN ;UPDATE TOTAL PROGRESS
"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",99,0)
+ . S C0CNOW=$$NOW^XLFDT
"RTN","C0CBAT",100,0)
- . S C0CNOW=$$NOW^XLFDT
+ . S C0CFDA(C0CBF,C0CIEN_",",4)=C0CNOW ; LAST UPDATED FIELD
"RTN","C0CBAT",101,0)
- . S C0CFDA(C0CBF,C0CIEN_",",4)=C0CNOW ; LAST UPDATED FIELD
+ . S C0CELPS=$$FMDIFF^XLFDT(C0CNOW,C0CBDT,2) ; DIFFERENCE IN SECONDS
"RTN","C0CBAT",102,0)
- . S C0CELPS=$$FMDIFF^XLFDT(C0CNOW,C0CBDT,2) ; DIFFERENCE IN SECONDS
+ . S C0CAVG=C0CELPS/C0CN ; AVERAGE ELAPSED TIME
"RTN","C0CBAT",103,0)
- . S C0CAVG=C0CELPS/C0CN ; AVERAGE ELAPSED TIME
+ . S C0CFDA(C0CBF,C0CIEN_",",4.1)=C0CAVG ; AVERAGE ELAPSED TIME
"RTN","C0CBAT",104,0)
- . S C0CFDA(C0CBF,C0CIEN_",",4.1)=C0CAVG ; AVERAGE ELAPSED TIME
+ . S C0CETOT=C0CAVG*C0CSN ; EST TOT ELASPSED TIME
"RTN","C0CBAT",105,0)
- . S C0CETOT=C0CAVG*C0CSN ; EST TOT ELASPSED TIME
+ . S C0CEST=$$FMADD^XLFDT(C0CBDT,0,0,0,C0CETOT) ; ADD SECONDS TO BATCH START
"RTN","C0CBAT",106,0)
- . S C0CEST=$$FMADD^XLFDT(C0CBDT,0,0,0,C0CETOT) ; ADD SECONDS TO BATCH START
+ . S C0CFDA(C0CBF,C0CIEN_",",4.2)=C0CEST ;ESTIMATED COMPLETION TIME
"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)
+"RTN","C0CBAT",108,0)
. D UPDIE ;
+"RTN","C0CBAT",109,0)
+ . I $D(^TMP("C0CBAT","STOP")) D ; IF STOP SIGNAL DETECTED
"RTN","C0CBAT",110,0)
- . I $D(^TMP("C0CBAT","STOP")) D ; IF STOP SIGNAL DETECTED
+ . . S C0CSTOP=1
"RTN","C0CBAT",111,0)
- . . S C0CSTOP=1
+ . . K ^TMP("C0CBAT","STOP") ; SIGNAL RECEIVED
"RTN","C0CBAT",112,0)
- . . K ^TMP("C0CBAT","STOP") ; SIGNAL RECEIVED
-"RTN","C0CBAT",113,0)
. H 1 ; GIVE OTHERS A CHANCE
-"RTN","C0CBAT",114,0)
+"RTN","C0CBAT",113,0)
F S C0CBCUR=$O(@C0CBS@(C0CBCUR)) Q:(C0CSTOP)!(C0CBCUR="") D ; SUBS LIST
-"RTN","C0CBAT",115,0)
+"RTN","C0CBAT",114,0)
. I $D(@C0CBH@(C0CBCUR)) Q ; SKIP IF IN HOT LIST - ALREADY DONE
-"RTN","C0CBAT",116,0)
+"RTN","C0CBAT",115,0)
. D ANALYZE^C0CRIMA(C0CBCUR,1,"LABLIMIT:T-760^VITLIMIT:T-760")
-"RTN","C0CBAT",117,0)
+"RTN","C0CBAT",116,0)
. I $G(C0CCHK) D ; IF CHECKSUMS HAVE CHANGED
-"RTN","C0CBAT",118,0)
+"RTN","C0CBAT",117,0)
. . D PUTRIM^C0CFM2(C0CBCUR)
-"RTN","C0CBAT",119,0)
+"RTN","C0CBAT",118,0)
. . D XPAT^C0CCCR(C0CBCUR) ; IF VARIABLES HAVE CHANGED GENERATE CCR
-"RTN","C0CBAT",120,0)
+"RTN","C0CBAT",119,0)
. . K C0CFDA
-"RTN","C0CBAT",121,0)
+"RTN","C0CBAT",120,0)
. . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",.01)=C0CBCUR
-"RTN","C0CBAT",122,0)
+"RTN","C0CBAT",121,0)
. . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",1)="Y"
-"RTN","C0CBAT",123,0)
+"RTN","C0CBAT",122,0)
. . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",2)=$G(^TMP("C0CCCR","FNAME",C0CBCUR))
-"RTN","C0CBAT",124,0)
+"RTN","C0CBAT",123,0)
. . D UPDIE ; CREATE UPDATE SUBFILE
-"RTN","C0CBAT",125,0)
+"RTN","C0CBAT",124,0)
. S C0CN=C0CN+1 ; INCREMENT NUMBER IN TOTAL
-"RTN","C0CBAT",126,0)
+"RTN","C0CBAT",125,0)
. S C0CFDA(C0CBF,C0CIEN_",",1.1)=C0CN ;UPDATE TOTAL PROGRESS
-"RTN","C0CBAT",127,0)
+"RTN","C0CBAT",126,0)
. S C0CNOW=$$NOW^XLFDT
-"RTN","C0CBAT",128,0)
+"RTN","C0CBAT",127,0)
. S C0CFDA(C0CBF,C0CIEN_",",4)=C0CNOW ; LAST UPDATED FIELD
-"RTN","C0CBAT",129,0)
+"RTN","C0CBAT",128,0)
. S C0CELPS=$$FMDIFF^XLFDT(C0CNOW,C0CBDT,2) ; DIFFERENCE IN SECONDS
-"RTN","C0CBAT",130,0)
+"RTN","C0CBAT",129,0)
. S C0CAVG=C0CELPS/C0CN ; AVERAGE ELAPSED TIME
-"RTN","C0CBAT",131,0)
+"RTN","C0CBAT",130,0)
. S C0CFDA(C0CBF,C0CIEN_",",4.1)=C0CAVG ; AVERAGE ELAPSED TIME
-"RTN","C0CBAT",132,0)
+"RTN","C0CBAT",131,0)
. S C0CETOT=C0CAVG*C0CSN ; EST TOT ELASPSED TIME
-"RTN","C0CBAT",133,0)
+"RTN","C0CBAT",132,0)
. S C0CEST=$$FMADD^XLFDT(C0CBDT,0,0,0,C0CETOT) ; ADD SECONDS TO BATCH START
-"RTN","C0CBAT",134,0)
+"RTN","C0CBAT",133,0)
. S C0CFDA(C0CBF,C0CIEN_",",4.2)=C0CEST ;ESTIMATED COMPLETION TIME
-"RTN","C0CBAT",135,0)
+"RTN","C0CBAT",134,0)
. S C0CFDA(C0CBF,C0CIEN_",",5)=C0CBCUR ;
-"RTN","C0CBAT",136,0)
+"RTN","C0CBAT",135,0)
. D UPDIE ;
-"RTN","C0CBAT",137,0)
+"RTN","C0CBAT",136,0)
. I $D(^TMP("C0CBAT","STOP")) D ; IF STOP SIGNAL DETECTED
-"RTN","C0CBAT",138,0)
+"RTN","C0CBAT",137,0)
. . S C0CSTOP=1
-"RTN","C0CBAT",139,0)
+"RTN","C0CBAT",138,0)
. . K ^TMP("C0CBAT","STOP") ; SIGNAL RECEIVED
-"RTN","C0CBAT",140,0)
+"RTN","C0CBAT",139,0)
. H 1 ; GIVE IT A BREAK
-"RTN","C0CBAT",141,0)
+"RTN","C0CBAT",140,0)
I (C0CSTOP) S C0CDISP="KILLED"
-"RTN","C0CBAT",142,0)
+"RTN","C0CBAT",141,0)
E S C0CDISP="FINISHED"
-"RTN","C0CBAT",143,0)
+"RTN","C0CBAT",142,0)
S C0CFDA(C0CBF,C0CIEN_",",6)=C0CDISP
-"RTN","C0CBAT",144,0)
+"RTN","C0CBAT",143,0)
D UPDIE ; SET DISPOSITION FIELD
-"RTN","C0CBAT",145,0)
+"RTN","C0CBAT",144,0)
K ^TMP("C0CBAT","RUNNING")
+"RTN","C0CBAT",145,0)
+ Q
"RTN","C0CBAT",146,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)
+"RTN","C0CBAT",148,0)
; SEARCHS FOR PATIENTS IN THE "AC" INDEX OF THE ORDER FILE
-"RTN","C0CBAT",150,0)
+"RTN","C0CBAT",149,0)
N ZDFN
-"RTN","C0CBAT",151,0)
+"RTN","C0CBAT",150,0)
S ZDFN=""
-"RTN","C0CBAT",152,0)
+"RTN","C0CBAT",151,0)
F S ZDFN=$O(^OR(100,"AC",ZDFN)) Q:ZDFN="" D ; ALL PATIENTS IN THE AC INDX
-"RTN","C0CBAT",153,0)
+"RTN","C0CBAT",152,0)
. S ZZDFN=$P(ZDFN,";",1) ; FORMAT IS "N;DPT("
-"RTN","C0CBAT",154,0)
+"RTN","C0CBAT",153,0)
. I '$D(@C0CBS@(ZZDFN)) Q ; SKIP IF NOT IN SUBSCRIPTION LIST
-"RTN","C0CBAT",155,0)
+"RTN","C0CBAT",154,0)
. S @ZHB@(ZZDFN)="" ;ADD PATIENT TO THE HOT LIST
+"RTN","C0CBAT",155,0)
+ Q
"RTN","C0CBAT",156,0)
- Q
+ ;
"RTN","C0CBAT",157,0)
- ;
-"RTN","C0CBAT",158,0)
COUNT(ZB) ; EXTRINSIC THAT RETURNS THE NUMBER OF ARRAY ELEMENTS
-"RTN","C0CBAT",159,0)
+"RTN","C0CBAT",158,0)
N ZI,ZN
-"RTN","C0CBAT",160,0)
+"RTN","C0CBAT",159,0)
S ZN=0
-"RTN","C0CBAT",161,0)
+"RTN","C0CBAT",160,0)
S ZI=""
-"RTN","C0CBAT",162,0)
+"RTN","C0CBAT",161,0)
F S ZI=$O(@ZB@(ZI)) Q:ZI="" D ;
-"RTN","C0CBAT",163,0)
+"RTN","C0CBAT",162,0)
. S ZN=ZN+1
-"RTN","C0CBAT",164,0)
+"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)
-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)
+"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)
- ;
-"RTN","C0CBAT",170,0)
N ZCCRD,ZVARN,C0CFDA2
-"RTN","C0CBAT",171,0)
+"RTN","C0CBAT",170,0)
S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
-"RTN","C0CBAT",172,0)
+"RTN","C0CBAT",171,0)
S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
-"RTN","C0CBAT",173,0)
+"RTN","C0CBAT",172,0)
I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
-"RTN","C0CBAT",174,0)
+"RTN","C0CBAT",173,0)
. I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE
-"RTN","C0CBAT",175,0)
+"RTN","C0CBAT",174,0)
. . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
-"RTN","C0CBAT",176,0)
+"RTN","C0CBAT",175,0)
. S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
-"RTN","C0CBAT",177,0)
+"RTN","C0CBAT",176,0)
. S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
-"RTN","C0CBAT",178,0)
+"RTN","C0CBAT",177,0)
. D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
-"RTN","C0CBAT",179,0)
+"RTN","C0CBAT",178,0)
. D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
-"RTN","C0CBAT",180,0)
+"RTN","C0CBAT",179,0)
. I $D(ZERR) D ; LAYGO ERROR
-"RTN","C0CBAT",181,0)
+"RTN","C0CBAT",180,0)
. . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
-"RTN","C0CBAT",182,0)
+"RTN","C0CBAT",181,0)
. E D ;
-"RTN","C0CBAT",183,0)
+"RTN","C0CBAT",182,0)
. . D CLEAN^DILF ; CLEAN UP
-"RTN","C0CBAT",184,0)
+"RTN","C0CBAT",183,0)
. . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
-"RTN","C0CBAT",185,0)
+"RTN","C0CBAT",184,0)
. . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
-"RTN","C0CBAT",186,0)
+"RTN","C0CBAT",185,0)
Q ZVARN
+"RTN","C0CBAT",186,0)
+ ;
"RTN","C0CBAT",187,0)
- ;
-"RTN","C0CBAT",188,0)
UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
-"RTN","C0CBAT",189,0)
+"RTN","C0CBAT",188,0)
K ZERR
-"RTN","C0CBAT",190,0)
+"RTN","C0CBAT",189,0)
D CLEAN^DILF
-"RTN","C0CBAT",191,0)
+"RTN","C0CBAT",190,0)
D UPDATE^DIE("","C0CFDA","","ZERR")
+"RTN","C0CBAT",191,0)
+ I $D(ZERR) S $EC=",U1,"
"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
-"RTN","C0CBAT",196,0)
K C0CFDA
-"RTN","C0CBAT",197,0)
+"RTN","C0CBAT",193,0)
Q
-"RTN","C0CBAT",198,0)
+"RTN","C0CBAT",194,0)
;
-"RTN","C0CBAT",199,0)
+"RTN","C0CBAT",195,0)
SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
-"RTN","C0CBAT",200,0)
+"RTN","C0CBAT",196,0)
; TO SET TO VALUE C0CSV.
-"RTN","C0CBAT",201,0)
+"RTN","C0CBAT",197,0)
; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
-"RTN","C0CBAT",202,0)
+"RTN","C0CBAT",198,0)
; C0CSN,C0CSV ARE PASSED BY VALUE
-"RTN","C0CBAT",203,0)
+"RTN","C0CBAT",199,0)
;
-"RTN","C0CBAT",204,0)
+"RTN","C0CBAT",200,0)
N C0CSI,C0CSJ
-"RTN","C0CBAT",205,0)
+"RTN","C0CBAT",201,0)
S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
-"RTN","C0CBAT",206,0)
+"RTN","C0CBAT",202,0)
S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
-"RTN","C0CBAT",207,0)
+"RTN","C0CBAT",203,0)
S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
-"RTN","C0CBAT",208,0)
+"RTN","C0CBAT",204,0)
Q
-"RTN","C0CBAT",209,0)
+"RTN","C0CBAT",205,0)
ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
-"RTN","C0CBAT",210,0)
+"RTN","C0CBAT",206,0)
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
-"RTN","C0CBAT",211,0)
+"RTN","C0CBAT",207,0)
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CBAT",212,0)
+"RTN","C0CBAT",208,0)
I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CBAT",213,0)
+"RTN","C0CBAT",209,0)
N ZR
-"RTN","C0CBAT",214,0)
+"RTN","C0CBAT",210,0)
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
-"RTN","C0CBAT",215,0)
+"RTN","C0CBAT",211,0)
E S ZR=""
-"RTN","C0CBAT",216,0)
+"RTN","C0CBAT",212,0)
Q ZR
-"RTN","C0CBAT",217,0)
+"RTN","C0CBAT",213,0)
ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
-"RTN","C0CBAT",218,0)
+"RTN","C0CBAT",214,0)
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
-"RTN","C0CBAT",219,0)
+"RTN","C0CBAT",215,0)
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CBAT",220,0)
+"RTN","C0CBAT",216,0)
I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CBAT",221,0)
+"RTN","C0CBAT",217,0)
N ZR
-"RTN","C0CBAT",222,0)
+"RTN","C0CBAT",218,0)
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
-"RTN","C0CBAT",223,0)
+"RTN","C0CBAT",219,0)
E S ZR=""
-"RTN","C0CBAT",224,0)
+"RTN","C0CBAT",220,0)
Q ZR
-"RTN","C0CBAT",225,0)
+"RTN","C0CBAT",221,0)
;
-"RTN","C0CBAT",226,0)
+"RTN","C0CBAT",222,0)
ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
-"RTN","C0CBAT",227,0)
+"RTN","C0CBAT",223,0)
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
-"RTN","C0CBAT",228,0)
+"RTN","C0CBAT",224,0)
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CBAT",229,0)
+"RTN","C0CBAT",225,0)
I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CBAT",230,0)
+"RTN","C0CBAT",226,0)
N ZR
-"RTN","C0CBAT",231,0)
+"RTN","C0CBAT",227,0)
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
-"RTN","C0CBAT",232,0)
+"RTN","C0CBAT",228,0)
E S ZR=""
-"RTN","C0CBAT",233,0)
+"RTN","C0CBAT",229,0)
Q ZR
-"RTN","C0CBAT",234,0)
+"RTN","C0CBAT",230,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 .
"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.,
-"RTN","C0CCCD",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","C0CCCD",20,0)
- ;
-"RTN","C0CCCD",21,0)
; EXPORT A CCR
-"RTN","C0CCCD",22,0)
+"RTN","C0CCCD",19,0)
;
-"RTN","C0CCCD",23,0)
+"RTN","C0CCCD",20,0)
EXPORT ; EXPORT ENTRY POINT FOR CCR
+"RTN","C0CCCD",21,0)
+ ; Select a patient.
+"RTN","C0CCCD",22,0)
+ S DIC=2,DIC(0)="AEMQ" D ^DIC
+"RTN","C0CCCD",23,0)
+ 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
-"RTN","C0CCCD",29,0)
- Q
-"RTN","C0CCCD",30,0)
- ;
-"RTN","C0CCCD",31,0)
XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
+"RTN","C0CCCD",29,0)
+ ; 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)
+ ; 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)
-"RTN","C0CCCD",49,0)
- Q
-"RTN","C0CCCD",50,0)
- ;
-"RTN","C0CCCD",51,0)
CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
+"RTN","C0CCCD",49,0)
+ ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
+"RTN","C0CCCD",50,0)
+ ; DFN IS PATIENT IEN
+"RTN","C0CCCD",51,0)
+ ; 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)="" ; 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))="" ; FINISH CAP
"RTN","C0CCCD",77,0)
- S @CCDGLO@(3)="" ; CAP WITH CCR ROOT
+ S @TGLOBAL@(@TGLOBAL@(0))="" ; FINISH CAP TEMP
"RTN","C0CCCD",78,0)
- S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO
+ ;
"RTN","C0CCCD",79,0)
- S @CCDGLO@(@CCDGLO@(0))="" ; FINISH CAP
+ ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
"RTN","C0CCCD",80,0)
- S @TGLOBAL@(@TGLOBAL@(0))="" ; 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)["
" D ; REPLACE BODY MARKUP
"RTN","C0CCCD",138,0)
- . N I
+ . . . S @CCDGLO@(I)="" ; WITH CCD EQ
"RTN","C0CCCD",139,0)
- . F I=1:1:@CCDGLO@(0) D ; SEARCH THROUGH THE ENTIRE ARRAY
+ . . I @CCDGLO@(I)["" D ; REPLACE BODY MARKUP
"RTN","C0CCCD",140,0)
- . . I @CCDGLO@(I)["" D ; REPLACE BODY MARKUP
+ . . . S @CCDGLO@(I)=""
"RTN","C0CCCD",141,0)
- . . . S @CCDGLO@(I)="" ; WITH CCD EQ
+ S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD
"RTN","C0CCCD",142,0)
- . . I @CCDGLO@(I)["" D ; REPLACE BODY MARKUP
+ S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE
"RTN","C0CCCD",143,0)
- . . . S @CCDGLO@(I)=""
+ 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
-"RTN","C0CCCD",146,0)
- Q
-"RTN","C0CCCD",147,0)
- ;
-"RTN","C0CCCD",148,0)
INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS
+"RTN","C0CCCD",146,0)
+ ; TAB IS PASSED BY NAME
+"RTN","C0CCCD",147,0)
+ W "TAB= ",TAB,!
+"RTN","C0CCCD",148,0)
+ ; 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"")")
-"RTN","C0CCCD",155,0)
- Q
-"RTN","C0CCCD",156,0)
- ;
-"RTN","C0CCCD",157,0)
SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT
+"RTN","C0CCCD",155,0)
+ ; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION
+"RTN","C0CCCD",156,0)
+ N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
+"RTN","C0CCCD",157,0)
+ 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
-"RTN","C0CCCD",168,0)
- Q
-"RTN","C0CCCD",169,0)
- ;
-"RTN","C0CCCD",170,0)
UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE
+"RTN","C0CCCD",168,0)
+ ; 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)
+ 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
-"RTN","C0CCCD",181,0)
- Q
-"RTN","C0CCCD",182,0)
- ;
-"RTN","C0CCCD",183,0)
HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT
+"RTN","C0CCCD",181,0)
+ N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
+"RTN","C0CCCD",182,0)
+ ; K @VMAP
+"RTN","C0CCCD",183,0)
+ 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)
-"RTN","C0CCCD",200,0)
- Q
-"RTN","C0CCCD",201,0)
- ;
-"RTN","C0CCCD",202,0)
ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
+"RTN","C0CCCD",200,0)
+ ; 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)
+ ; 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"".E D ; THERE IS AN ACTOR THIS LINE
"RTN","C0CCCD",211,0)
- K @ACTRTN ; CLEAR RETURN ARRAY
+ . . S J=$P($P(@AXML@(I),"",2),"",1)
"RTN","C0CCCD",212,0)
- F I=1:1:@AXML@(0) D ; SCAN ALL LINES
+ . . W "=>",J,!
"RTN","C0CCCD",213,0)
- . I @AXML@(I)?.E1"".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),"",2),"",1)
+ . . ; TO GET RID OF DUPLICATES
"RTN","C0CCCD",215,0)
- . . W "=>",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
-"RTN","C0CCCD",225,0)
- Q
-"RTN","C0CCCD",226,0)
- ;
-"RTN","C0CCCD",227,0)
TEST ; RUN ALL THE TEST CASES
+"RTN","C0CCCD",225,0)
+ D TESTALL^C0CUNIT("C0CCCR")
+"RTN","C0CCCD",226,0)
+ Q
+"RTN","C0CCCD",227,0)
+ ;
"RTN","C0CCCD",228,0)
- D TESTALL^C0CUNIT("C0CCCR")
-"RTN","C0CCCD",229,0)
- Q
-"RTN","C0CCCD",230,0)
- ;
-"RTN","C0CCCD",231,0)
ZTEST(WHICH) ; RUN ONE SET OF TESTS
+"RTN","C0CCCD",229,0)
+ N ZTMP
+"RTN","C0CCCD",230,0)
+ D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
+"RTN","C0CCCD",231,0)
+ 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)
-"RTN","C0CCCD",235,0)
- Q
-"RTN","C0CCCD",236,0)
- ;
-"RTN","C0CCCD",237,0)
TLIST ; LIST THE TESTS
+"RTN","C0CCCD",235,0)
+ N ZTMP
+"RTN","C0CCCD",236,0)
+ D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
+"RTN","C0CCCD",237,0)
+ 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)
-"RTN","C0CCCD",241,0)
- Q
-"RTN","C0CCCD",242,0)
- ;
-"RTN","C0CCCD",243,0)
;;>
-"RTN","C0CCCD",244,0)
+"RTN","C0CCCD",241,0)
;;>
-"RTN","C0CCCD",245,0)
+"RTN","C0CCCD",242,0)
;;>>>K C0C S C0C=""
-"RTN","C0CCCD",246,0)
+"RTN","C0CCCD",243,0)
;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","","","")
-"RTN","C0CCCD",247,0)
+"RTN","C0CCCD",244,0)
;;>>?@C0C@(@C0C@(0))[""
-"RTN","C0CCCD",248,0)
+"RTN","C0CCCD",245,0)
;;>
-"RTN","C0CCCD",249,0)
+"RTN","C0CCCD",246,0)
;;>>>K C0C S C0C=""
-"RTN","C0CCCD",250,0)
+"RTN","C0CCCD",247,0)
;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","","","")
-"RTN","C0CCCD",251,0)
+"RTN","C0CCCD",248,0)
;;>>?@C0C@(@C0C@(0))[""
-"RTN","C0CCCD",252,0)
+"RTN","C0CCCD",249,0)
;;>
+"RTN","C0CCCD",250,0)
+ ;;>>>K C0C S C0C=""
+"RTN","C0CCCD",251,0)
+ ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","")
+"RTN","C0CCCD",252,0)
+ ;;>>?@C0C@(@C0C@(0))[""
"RTN","C0CCCD",253,0)
- ;;>>>K C0C S C0C=""
-"RTN","C0CCCD",254,0)
- ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","")
-"RTN","C0CCCD",255,0)
- ;;>>?@C0C@(@C0C@(0))[""
-"RTN","C0CCCD",256,0)
;;>
-"RTN","C0CCCD",257,0)
+"RTN","C0CCCD",254,0)
;;>>>K C0C S C0C=""
-"RTN","C0CCCD",258,0)
+"RTN","C0CCCD",255,0)
;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","")
-"RTN","C0CCCD",259,0)
+"RTN","C0CCCD",256,0)
;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST")
-"RTN","C0CCCD",260,0)
+"RTN","C0CCCD",257,0)
;;>
-"RTN","C0CCCD",261,0)
+"RTN","C0CCCD",258,0)
;;>>>D ZTEST^C0CCCR("ACTLST")
-"RTN","C0CCCD",262,0)
+"RTN","C0CCCD",259,0)
;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
-"RTN","C0CCCD",263,0)
+"RTN","C0CCCD",260,0)
;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3")
-"RTN","C0CCCD",264,0)
+"RTN","C0CCCD",261,0)
;;>>?G3(G3(0))[""
-"RTN","C0CCCD",265,0)
+"RTN","C0CCCD",262,0)
;;>
-"RTN","C0CCCD",266,0)
+"RTN","C0CCCD",263,0)
;;>>>D ZTEST^C0CCCR("CCR")
-"RTN","C0CCCD",267,0)
+"RTN","C0CCCD",264,0)
;;>>>W $$TRIM^C0CXPATH(CCDGLO)
-"RTN","C0CCCD",268,0)
+"RTN","C0CCCD",265,0)
;;>
-"RTN","C0CCCD",269,0)
+"RTN","C0CCCD",266,0)
;;>>>K C0C S C0C=""
-"RTN","C0CCCD",270,0)
+"RTN","C0CCCD",267,0)
;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCD","","","")
-"RTN","C0CCCD",271,0)
+"RTN","C0CCCD",268,0)
;;>>?@C0C@(@C0C@(0))[""
-"RTN","C0CCCD",272,0)
+"RTN","C0CCCD",269,0)
;;>
"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 .
"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",!
-"RTN","C0CCCD1",22,0)
- W !
-"RTN","C0CCCD1",23,0)
- Q
-"RTN","C0CCCD1",24,0)
- ;
-"RTN","C0CCCD1",25,0)
-ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
-"RTN","C0CCCD1",26,0)
- ; ZARY IS PASSED BY NAME
-"RTN","C0CCCD1",27,0)
- ; BAT is a string identifying the section
-"RTN","C0CCCD1",28,0)
- ; LINE is a test which will evaluate to true or false
-"RTN","C0CCCD1",29,0)
- ; I '$G(@ZARY) D ; IF ZARY DOES NOT EXIST '
-"RTN","C0CCCD1",30,0)
- ; . S @ZARY@(0)=0 ; initially there are no elements
-"RTN","C0CCCD1",31,0)
- ; . W "GOT HERE LOADING "_LINE,!
-"RTN","C0CCCD1",32,0)
- N CNT ; count of array elements
-"RTN","C0CCCD1",33,0)
- S CNT=@ZARY@(0) ; contains array count
-"RTN","C0CCCD1",34,0)
- S CNT=CNT+1 ; increment count
-"RTN","C0CCCD1",35,0)
- S @ZARY@(CNT)=LINE ; put the line in the array
-"RTN","C0CCCD1",36,0)
- ; S @ZARY@(BAT,CNT)="" ; index the test by battery
-"RTN","C0CCCD1",37,0)
- S @ZARY@(0)=CNT ; update the array counter
-"RTN","C0CCCD1",38,0)
- Q
-"RTN","C0CCCD1",39,0)
- ;
-"RTN","C0CCCD1",40,0)
-ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
-"RTN","C0CCCD1",41,0)
- ; ZARY IS PASSED BY NAME
-"RTN","C0CCCD1",42,0)
- ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
-"RTN","C0CCCD1",43,0)
- ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
-"RTN","C0CCCD1",44,0)
- K @ZARY S @ZARY=""
-"RTN","C0CCCD1",45,0)
- S @ZARY@(0)=0 ; initialize array count
-"RTN","C0CCCD1",46,0)
- N LINE,LABEL,BODY
-"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
-"RTN","C0CCCD1",49,0)
- ;
-"RTN","C0CCCD1",50,0)
- N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D
-"RTN","C0CCCD1",51,0)
- . I LINE?." "1";".E S INTEST=1 ; entering section
-"RTN","C0CCCD1",52,0)
- . I LINE?." "1";".E S INTEST=0 ; leaving section
-"RTN","C0CCCD1",53,0)
- . I INTEST D ; within the section
-"RTN","C0CCCD1",54,0)
- . . I LINE?." "1";><".E D ; sub-section name found
-"RTN","C0CCCD1",55,0)
- . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
-"RTN","C0CCCD1",56,0)
- . . I LINE?." "1";;".E D ; line found
-"RTN","C0CCCD1",57,0)
- . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
-"RTN","C0CCCD1",58,0)
- Q
-"RTN","C0CCCD1",59,0)
- ;
-"RTN","C0CCCD1",60,0)
-LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
-"RTN","C0CCCD1",61,0)
- D ZLOAD(ARY,"C0CCCD1")
-"RTN","C0CCCD1",62,0)
- ; ZWR @ARY
-"RTN","C0CCCD1",63,0)
- Q
-"RTN","C0CCCD1",64,0)
- ;
-"RTN","C0CCCD1",65,0)
-TRMCCD ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD
-"RTN","C0CCCD1",66,0)
- Q
-"RTN","C0CCCD1",67,0)
-MARKUP ;
-"RTN","C0CCCD1",68,0)
- ;;
-"RTN","C0CCCD1",69,0)
- ;;
-"RTN","C0CCCD1",70,0)
- ;;
-"RTN","C0CCCD1",71,0)
- ;;
-"RTN","C0CCCD1",72,0)
- ;;
-"RTN","C0CCCD1",73,0)
- ;;
-"RTN","C0CCCD1",74,0)
- ;;
-"RTN","C0CCCD1",75,0)
- ;;
-"RTN","C0CCCD1",76,0)
- ;;
-"RTN","C0CCCD1",77,0)
- ;;
-"RTN","C0CCCD1",78,0)
- ;;
-"RTN","C0CCCD1",79,0)
- ;;
-"RTN","C0CCCD1",80,0)
- ;;
-"RTN","C0CCCD1",81,0)
- ;;
-"RTN","C0CCCD1",82,0)
- ;;
-"RTN","C0CCCD1",83,0)
- ;;
-"RTN","C0CCCD1",84,0)
- ;;
-"RTN","C0CCCD1",85,0)
- ;
-"RTN","C0CCCD1",86,0)
- ;;
-"RTN","C0CCCD1",87,0)
- ;;
-"RTN","C0CCCD1",88,0)
Q
-"RTN","C0CCCD1",89,0)
+"RTN","C0CCCD1",22,0)
;
-"RTN","C0CCCD1",90,0)
- ;
-"RTN","C0CCCD1",91,0)
- ;;
-"RTN","C0CCCD1",92,0)
- ;;
-"RTN","C0CCCD1",93,0)
- ;;
-"RTN","C0CCCD1",94,0)
- ;;
-"RTN","C0CCCD1",95,0)
- ;;
-"RTN","C0CCCD1",96,0)
- ;;
-"RTN","C0CCCD1",97,0)
- ;;
-"RTN","C0CCCD1",98,0)
- ;;Continuity of Care Document
-"RTN","C0CCCD1",99,0)
- ;;
-"RTN","C0CCCD1",100,0)
- ;;
-"RTN","C0CCCD1",101,0)
- ;;
-"RTN","C0CCCD1",102,0)
- ;;
-"RTN","C0CCCD1",103,0)
- ;;
-"RTN","C0CCCD1",104,0)
- ;;
-"RTN","C0CCCD1",105,0)
- ;;
-"RTN","C0CCCD1",106,0)
- ;;
-"RTN","C0CCCD1",107,0)
- ;;@@ACTORGIVENNAME@@
-"RTN","C0CCCD1",108,0)
- ;;@@ACTORFAMILYNAME@@
-"RTN","C0CCCD1",109,0)
- ;;@@ACTORSUFFIXNAME@@
-"RTN","C0CCCD1",110,0)
- ;;
-"RTN","C0CCCD1",111,0)
- ;;
-"RTN","C0CCCD1",112,0)
- ;;
-"RTN","C0CCCD1",113,0)
- ;;
-"RTN","C0CCCD1",114,0)
- ;;
-"RTN","C0CCCD1",115,0)
- ;;
-"RTN","C0CCCD1",116,0)
- ;;@@ORGANIZATIONNAME@@
-"RTN","C0CCCD1",117,0)
- ;;
-"RTN","C0CCCD1",118,0)
- ;;
-"RTN","C0CCCD1",119,0)
- ;;
-"RTN","C0CCCD1",120,0)
- ;;
-"RTN","C0CCCD1",121,0)
- ;;
-"RTN","C0CCCD1",122,0)
- ;;
-"RTN","C0CCCD1",123,0)
- ;;
-"RTN","C0CCCD1",124,0)
- ;;
-"RTN","C0CCCD1",125,0)
- ;;
-"RTN","C0CCCD1",126,0)
- ;;@@ACTORNAMEPREFIX@@
-"RTN","C0CCCD1",127,0)
- ;;@@ACTORGIVENNAME@@
-"RTN","C0CCCD1",128,0)
- ;;@@ACTORFAMILYNAME@@
-"RTN","C0CCCD1",129,0)
- ;;
-"RTN","C0CCCD1",130,0)
- ;;
-"RTN","C0CCCD1",131,0)
- ;;
-"RTN","C0CCCD1",132,0)
- ;;
-"RTN","C0CCCD1",133,0)
- ;;@@ORGANIZATIONNAME@@
-"RTN","C0CCCD1",134,0)
- ;;
-"RTN","C0CCCD1",135,0)
- ;;
-"RTN","C0CCCD1",136,0)
- ;;
-"RTN","C0CCCD1",137,0)
- ;;
-"RTN","C0CCCD1",138,0)
- ;;
-"RTN","C0CCCD1",139,0)
- ;;
-"RTN","C0CCCD1",140,0)
- ;;
-"RTN","C0CCCD1",141,0)
- ;;
-"RTN","C0CCCD1",142,0)
- ;;@@ORGANIZATIONNAME@@
-"RTN","C0CCCD1",143,0)
- ;;
-"RTN","C0CCCD1",144,0)
- ;;
-"RTN","C0CCCD1",145,0)
- ;;
-"RTN","C0CCCD1",146,0)
- ;;
-"RTN","C0CCCD1",147,0)
- ;;
-"RTN","C0CCCD1",148,0)
- ;;
-"RTN","C0CCCD1",149,0)
- ;;
-"RTN","C0CCCD1",150,0)
- ;;@@ORGANIZATIONNAME@@
-"RTN","C0CCCD1",151,0)
- ;;
-"RTN","C0CCCD1",152,0)
- ;;
-"RTN","C0CCCD1",153,0)
- ;;
-"RTN","C0CCCD1",154,0)
- ;;
-"RTN","C0CCCD1",155,0)
- ;;
-"RTN","C0CCCD1",156,0)
- ;;
-"RTN","C0CCCD1",157,0)
- ;;
-"RTN","C0CCCD1",158,0)
- ;;
-"RTN","C0CCCD1",159,0)
- ;;
-"RTN","C0CCCD1",160,0)
- ;;
-"RTN","C0CCCD1",161,0)
- ;;@@ORGANIZATIONNAME@@
-"RTN","C0CCCD1",162,0)
- ;;
-"RTN","C0CCCD1",163,0)
- ;;
-"RTN","C0CCCD1",164,0)
- ;;
-"RTN","C0CCCD1",165,0)
- ;;
-"RTN","C0CCCD1",166,0)
- ;;
-"RTN","C0CCCD1",167,0)
- ;;
-"RTN","C0CCCD1",168,0)
- ;;
-"RTN","C0CCCD1",169,0)
- ;;
-"RTN","C0CCCD1",170,0)
- ;;
-"RTN","C0CCCD1",171,0)
- ;;
-"RTN","C0CCCD1",172,0)
- ;;
-"RTN","C0CCCD1",173,0)
- ;;
-"RTN","C0CCCD1",174,0)
- ;;Henrietta
-"RTN","C0CCCD1",175,0)
- ;;Levin
-"RTN","C0CCCD1",176,0)
- ;;
-"RTN","C0CCCD1",177,0)
- ;;
-"RTN","C0CCCD1",178,0)
- ;;
-"RTN","C0CCCD1",179,0)
- ;;
-"RTN","C0CCCD1",180,0)
- ;;
-"RTN","C0CCCD1",181,0)
- ;;
-"RTN","C0CCCD1",182,0)
- ;;
-"RTN","C0CCCD1",183,0)
- ;;
-"RTN","C0CCCD1",184,0)
- ;;
-"RTN","C0CCCD1",185,0)
- ;;
-"RTN","C0CCCD1",186,0)
- ;;
-"RTN","C0CCCD1",187,0)
- ;;
-"RTN","C0CCCD1",188,0)
- ;;
-"RTN","C0CCCD1",189,0)
- ;;
-"RTN","C0CCCD1",193,0)
- ;;
-"RTN","C0CCCD1",194,0)
- ;;
-"RTN","C0CCCD1",195,0)
- ;;
-"RTN","C0CCCD1",196,0)
- ;;
-"RTN","C0CCCD1",197,0)
- ;;@@ACTORPREFIXNAME@@
-"RTN","C0CCCD1",198,0)
- ;;@@ACTORGIVENNAME@@
-"RTN","C0CCCD1",199,0)
- ;;@@ACTORFAMILYNAME@@
-"RTN","C0CCCD1",200,0)
- ;;
-"RTN","C0CCCD1",201,0)
- ;;
-"RTN","C0CCCD1",202,0)
- ;;
-"RTN","C0CCCD1",203,0)
- ;;
-"RTN","C0CCCD1",204,0)
- ;;@@ORGANIZATIONNAME@@
-"RTN","C0CCCD1",205,0)
- ;;
-"RTN","C0CCCD1",206,0)
- ;;
-"RTN","C0CCCD1",207,0)
- ;;
-"RTN","C0CCCD1",208,0)
- ;;
-"RTN","C0CCCD1",209,0)
- ;;
-"RTN","C0CCCD1",210,0)
+"RTN","C0CCCD1",23,0)
+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)
+ ; BAT is a string identifying the section
+"RTN","C0CCCD1",26,0)
+ ; LINE is a test which will evaluate to true or false
+"RTN","C0CCCD1",27,0)
+ ; I '$G(@ZARY) D ; IF ZARY DOES NOT EXIST '
+"RTN","C0CCCD1",28,0)
+ ; . S @ZARY@(0)=0 ; initially there are no elements
+"RTN","C0CCCD1",29,0)
+ ; . W "GOT HERE LOADING "_LINE,!
+"RTN","C0CCCD1",30,0)
+ N CNT ; count of array elements
+"RTN","C0CCCD1",31,0)
+ S CNT=@ZARY@(0) ; contains array count
+"RTN","C0CCCD1",32,0)
+ S CNT=CNT+1 ; increment count
+"RTN","C0CCCD1",33,0)
+ S @ZARY@(CNT)=LINE ; put the line in the array
+"RTN","C0CCCD1",34,0)
+ ; S @ZARY@(BAT,CNT)="" ; index the test by battery
+"RTN","C0CCCD1",35,0)
+ S @ZARY@(0)=CNT ; update the array counter
+"RTN","C0CCCD1",36,0)
+ Q
+"RTN","C0CCCD1",37,0)
+ ;
+"RTN","C0CCCD1",38,0)
+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)
+ ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+"RTN","C0CCCD1",41,0)
+ ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+"RTN","C0CCCD1",42,0)
+ K @ZARY S @ZARY=""
+"RTN","C0CCCD1",43,0)
+ S @ZARY@(0)=0 ; initialize array count
+"RTN","C0CCCD1",44,0)
+ N LINE,LABEL,BODY
+"RTN","C0CCCD1",45,0)
+ N INTEST S INTEST=0 ; switch for in the TEMPLATE section
+"RTN","C0CCCD1",46,0)
+ N SECTION S SECTION="[anonymous]" ; NO section LABEL
+"RTN","C0CCCD1",47,0)
+ ;
+"RTN","C0CCCD1",48,0)
+ N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D
+"RTN","C0CCCD1",49,0)
+ . I LINE?." "1";".E S INTEST=1 ; entering section
+"RTN","C0CCCD1",50,0)
+ . I LINE?." "1";".E S INTEST=0 ; leaving section
+"RTN","C0CCCD1",51,0)
+ . I INTEST D ; within the section
+"RTN","C0CCCD1",52,0)
+ . . I LINE?." "1";><".E D ; sub-section name found
+"RTN","C0CCCD1",53,0)
+ . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
+"RTN","C0CCCD1",54,0)
+ . . I LINE?." "1";;".E D ; line found
+"RTN","C0CCCD1",55,0)
+ . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
+"RTN","C0CCCD1",56,0)
+ Q
+"RTN","C0CCCD1",57,0)
+ ;
+"RTN","C0CCCD1",58,0)
+LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
+"RTN","C0CCCD1",59,0)
+ D ZLOAD(ARY,"C0CCCD1")
+"RTN","C0CCCD1",60,0)
+ ; ZWR @ARY
+"RTN","C0CCCD1",61,0)
+ Q
+"RTN","C0CCCD1",62,0)
+ ;
+"RTN","C0CCCD1",63,0)
+TRMCCD ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD
+"RTN","C0CCCD1",64,0)
+ Q
+"RTN","C0CCCD1",65,0)
+MARKUP ;
+"RTN","C0CCCD1",66,0)
;;
-"RTN","C0CCCD1",211,0)
- ;;
-"RTN","C0CCCD1",212,0)
- ;;
+"RTN","C0CCCD1",215,0)
+ ;;
+"RTN","C0CCCD1",216,0)
+ ;;
+"RTN","C0CCCD1",217,0)
+ ;;
+"RTN","C0CCCD1",218,0)
+ ;;
+"RTN","C0CCCD1",219,0)
+ ;;
+"RTN","C0CCCD1",220,0)
+ ;;
+"RTN","C0CCCD1",221,0)
+ ;;Problems
+"RTN","C0CCCD1",222,0)
+ ;;
+"RTN","C0CCCD1",223,0)
+ ;;
+"RTN","C0CCCD1",224,0)
+ ;;
+"RTN","C0CCCD1",225,0)
+ ;;
+"RTN","C0CCCD1",226,0)
+ ;;
+"RTN","C0CCCD1",227,0)
+ ;;
+"RTN","C0CCCD1",228,0)
;;
-"RTN","C0CCCD1",241,0)
- ;;
-"RTN","C0CCCD1",242,0)
- ;;
-"RTN","C0CCCD1",243,0)
+"RTN","C0CCCD1",229,0)
+ ;;
+"RTN","C0CCCD1",230,0)
+ ;;
+"RTN","C0CCCD1",231,0)
+ ;;
+"RTN","C0CCCD1",232,0)
;;
-"RTN","C0CCCD1",244,0)
+"RTN","C0CCCD1",233,0)
+ ;;
+"RTN","C0CCCD1",234,0)
+ ;;
+"RTN","C0CCCD1",235,0)
+ ;;
+"RTN","C0CCCD1",236,0)
+ ;;
+"RTN","C0CCCD1",237,0)
+ ;;
+"RTN","C0CCCD1",238,0)
+ ;;
+"RTN","C0CCCD1",239,0)
+ ;;
+"RTN","C0CCCD1",240,0)
+ ;;
+"RTN","C0CCCD1",241,0)
+ ;;
+"RTN","C0CCCD1",242,0)
;;
+"RTN","C0CCCD1",243,0)
+ ;;
+"RTN","C0CCCD1",244,0)
+ ;;
"RTN","C0CCCD1",245,0)
;;
"RTN","C0CCCD1",246,0)
;;
"RTN","C0CCCD1",247,0)
- ;;
-"RTN","C0CCCD1",248,0)
- ;;
-"RTN","C0CCCD1",249,0)
;;
-"RTN","C0CCCD1",250,0)
+"RTN","C0CCCD1",248,0)
;;
-"RTN","C0CCCD1",251,0)
+"RTN","C0CCCD1",249,0)
;;
-"RTN","C0CCCD1",252,0)
+"RTN","C0CCCD1",250,0)
;;
-"RTN","C0CCCD1",253,0)
+"RTN","C0CCCD1",251,0)
;;
-"RTN","C0CCCD1",254,0)
+"RTN","C0CCCD1",252,0)
;;
-"RTN","C0CCCD1",255,0)
+"RTN","C0CCCD1",253,0)
;;
-"RTN","C0CCCD1",256,0)
+"RTN","C0CCCD1",254,0)
;;
-"RTN","C0CCCD1",257,0)
+"RTN","C0CCCD1",255,0)
;;
-"RTN","C0CCCD1",258,0)
+"RTN","C0CCCD1",256,0)
;;
-"RTN","C0CCCD1",259,0)
+"RTN","C0CCCD1",257,0)
;;
-"RTN","C0CCCD1",260,0)
+"RTN","C0CCCD1",258,0)
;;
-"RTN","C0CCCD1",261,0)
+"RTN","C0CCCD1",259,0)
;;
-"RTN","C0CCCD1",262,0)
+"RTN","C0CCCD1",260,0)
;;
-"RTN","C0CCCD1",263,0)
+"RTN","C0CCCD1",261,0)
;;
-"RTN","C0CCCD1",264,0)
+"RTN","C0CCCD1",262,0)
;;
-"RTN","C0CCCD1",265,0)
+"RTN","C0CCCD1",263,0)
;;
-"RTN","C0CCCD1",266,0)
+"RTN","C0CCCD1",264,0)
;;
-"RTN","C0CCCD1",267,0)
+"RTN","C0CCCD1",265,0)
;;
-"RTN","C0CCCD1",268,0)
+"RTN","C0CCCD1",266,0)
;
"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 .
"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.,
-"RTN","C0CCCR",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","C0CCCR",20,0)
- ;
-"RTN","C0CCCR",21,0)
; EXPORT A CCR
-"RTN","C0CCCR",22,0)
+"RTN","C0CCCR",19,0)
;
-"RTN","C0CCCR",23,0)
+"RTN","C0CCCR",20,0)
EXPORT ; EXPORT ENTRY POINT FOR CCR
-"RTN","C0CCCR",24,0)
+"RTN","C0CCCR",21,0)
; Select a patient.
-"RTN","C0CCCR",25,0)
+"RTN","C0CCCR",22,0)
S DIC=2,DIC(0)="AEMQ" D ^DIC
-"RTN","C0CCCR",26,0)
+"RTN","C0CCCR",23,0)
I Y<1 Q ; EXIT
-"RTN","C0CCCR",27,0)
+"RTN","C0CCCR",24,0)
S DFN=$P(Y,U,1) ; SET THE PATIENT
-"RTN","C0CCCR",28,0)
+"RTN","C0CCCR",25,0)
;OHUM/RUT 3120109 commented
-"RTN","C0CCCR",29,0)
+"RTN","C0CCCR",26,0)
;;OHUM/RUT 3120102 To take inputs from user for date limits and notes
-"RTN","C0CCCR",30,0)
+"RTN","C0CCCR",27,0)
;D ^C0CVALID
-"RTN","C0CCCR",31,0)
+"RTN","C0CCCR",28,0)
;;OHUM/RUT
-"RTN","C0CCCR",32,0)
+"RTN","C0CCCR",29,0)
;OHUM/RUT
-"RTN","C0CCCR",33,0)
+"RTN","C0CCCR",30,0)
D XPAT(DFN) ; EXPORT TO A FILE
-"RTN","C0CCCR",34,0)
+"RTN","C0CCCR",31,0)
Q
-"RTN","C0CCCR",35,0)
+"RTN","C0CCCR",32,0)
;
-"RTN","C0CCCR",36,0)
+"RTN","C0CCCR",33,0)
XPAT(DFN,XPARMS,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
-"RTN","C0CCCR",37,0)
+"RTN","C0CCCR",34,0)
; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR")
-"RTN","C0CCCR",38,0)
+"RTN","C0CCCR",35,0)
; FN IS FILE NAME, DEFAULTS IF NULL
-"RTN","C0CCCR",39,0)
+"RTN","C0CCCR",36,0)
N CCRGLO,UDIR,UFN
-"RTN","C0CCCR",40,0)
+"RTN","C0CCCR",37,0)
S C0CNRPC=1 ; FLAG FOR NOT AN RPC CALL - FOR DEBUGGING THE RPC
-"RTN","C0CCCR",41,0)
+"RTN","C0CCCR",38,0)
I '$D(DIR) S UDIR=""
-"RTN","C0CCCR",42,0)
+"RTN","C0CCCR",39,0)
E S UDIR=DIR
-"RTN","C0CCCR",43,0)
+"RTN","C0CCCR",40,0)
I '$D(FN) S UFN="" ; IF FILENAME IS NOT PASSED
-"RTN","C0CCCR",44,0)
+"RTN","C0CCCR",41,0)
E S UFN=FN
-"RTN","C0CCCR",45,0)
+"RTN","C0CCCR",42,0)
I '$D(XPARMS) S XPARMS=""
-"RTN","C0CCCR",46,0)
+"RTN","C0CCCR",43,0)
N C0CRTN ; RETURN ARRAY
-"RTN","C0CCCR",47,0)
+"RTN","C0CCCR",44,0)
D CCRRPC(.C0CRTN,DFN,XPARMS,"CCR")
-"RTN","C0CCCR",48,0)
+"RTN","C0CCCR",45,0)
S OARY=$NA(^TMP("C0CCUR",$J,DFN,"CCR",1))
-"RTN","C0CCCR",49,0)
+"RTN","C0CCCR",46,0)
S ONAM=UFN
-"RTN","C0CCCR",50,0)
+"RTN","C0CCCR",47,0)
I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_0.xml"
-"RTN","C0CCCR",51,0)
+"RTN","C0CCCR",48,0)
S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))
-"RTN","C0CCCR",52,0)
+"RTN","C0CCCR",49,0)
S ^TMP("C0CCCR","FNAME",DFN)=ONAM ; FILE NAME FOR BATCH USE
-"RTN","C0CCCR",53,0)
+"RTN","C0CCCR",50,0)
I $D(^TMP("GPLCCR","ODIR")) S @ODIRGLB=^TMP("GPLCCR","ODIR")
-"RTN","C0CCCR",54,0)
+"RTN","C0CCCR",51,0)
I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET
-"RTN","C0CCCR",55,0)
+"RTN","C0CCCR",52,0)
. W "Warning.. please set ^TMP(""C0CCCR"",""ODIR"")=""output path""",! Q
-"RTN","C0CCCR",56,0)
+"RTN","C0CCCR",53,0)
. ;S @ODIRGLB="/home/glilly/CCROUT"
-"RTN","C0CCCR",57,0)
+"RTN","C0CCCR",54,0)
. ;S @ODIRGLB="/home/cedwards/"
-"RTN","C0CCCR",58,0)
+"RTN","C0CCCR",55,0)
. S @ODIRGLB="/opt/wv/p/"
-"RTN","C0CCCR",59,0)
+"RTN","C0CCCR",56,0)
S ODIR=UDIR
-"RTN","C0CCCR",60,0)
+"RTN","C0CCCR",57,0)
I UDIR="" S ODIR=@ODIRGLB
-"RTN","C0CCCR",61,0)
+"RTN","C0CCCR",58,0)
N ZY
-"RTN","C0CCCR",62,0)
+"RTN","C0CCCR",59,0)
S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR)
-"RTN","C0CCCR",63,0)
+"RTN","C0CCCR",60,0)
W !,$P(ZY,U,2),!
-"RTN","C0CCCR",64,0)
+"RTN","C0CCCR",61,0)
Q
-"RTN","C0CCCR",65,0)
+"RTN","C0CCCR",62,0)
;
-"RTN","C0CCCR",66,0)
+"RTN","C0CCCR",63,0)
DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED
-"RTN","C0CCCR",67,0)
+"RTN","C0CCCR",64,0)
;
-"RTN","C0CCCR",68,0)
+"RTN","C0CCCR",65,0)
N G1
-"RTN","C0CCCR",69,0)
+"RTN","C0CCCR",66,0)
S G1=$NA(^TMP("C0CCUR",$J,DFN,"CCR"))
-"RTN","C0CCCR",70,0)
+"RTN","C0CCCR",67,0)
I $D(@G1@(0)) D ; CCR EXISTS
-"RTN","C0CCCR",71,0)
+"RTN","C0CCCR",68,0)
. D PARY^C0CXPATH(G1)
-"RTN","C0CCCR",72,0)
+"RTN","C0CCCR",69,0)
E W "CCR NOT CREATED, RUN D XPAT^C0CCCR(DFN,"""","""") FIRST",!
-"RTN","C0CCCR",73,0)
+"RTN","C0CCCR",70,0)
Q
-"RTN","C0CCCR",74,0)
+"RTN","C0CCCR",71,0)
;
-"RTN","C0CCCR",75,0)
+"RTN","C0CCCR",72,0)
CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART) ;RPC ENTRY POINT FOR CCR OUTPUT
-"RTN","C0CCCR",76,0)
+"RTN","C0CCCR",73,0)
; CCRGRTN IS RETURN ARRAY PASSED BY REFERENCE
-"RTN","C0CCCR",77,0)
+"RTN","C0CCCR",74,0)
; DFN IS PATIENT IEN
-"RTN","C0CCCR",78,0)
+"RTN","C0CCCR",75,0)
; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
-"RTN","C0CCCR",79,0)
+"RTN","C0CCCR",76,0)
; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
-"RTN","C0CCCR",80,0)
+"RTN","C0CCCR",77,0)
; CCRPARMS ARE PARAMETERS THAT AFFECT THE EXTRACTION
-"RTN","C0CCCR",81,0)
+"RTN","C0CCCR",78,0)
; IN THE FORM "PARM1:VALUE1^PARM2:VALUE2"
-"RTN","C0CCCR",82,0)
+"RTN","C0CCCR",79,0)
; EXAMPLE: "LABLIMIT:T-60" TO LIMIT LAB EXTRACTION TO THE LAST 60 DAYS
-"RTN","C0CCCR",83,0)
+"RTN","C0CCCR",80,0)
; SEE C0CPARMS FOR A COMPLETE LIST OF SUPPORTED PARAMETERS
-"RTN","C0CCCR",84,0)
+"RTN","C0CCCR",81,0)
K ^TMP("C0CCCR",$J) ; CLEAN UP THE GLOBAL BEFORE WE USE IT
-"RTN","C0CCCR",85,0)
+"RTN","C0CCCR",82,0)
M ^TMP("C0CSAV",$J)=^TMP($J) ; SAVING CALLER'S TMP SETTINGS
-"RTN","C0CCCR",86,0)
+"RTN","C0CCCR",83,0)
K ^TMP($J) ; START CLEAN
-"RTN","C0CCCR",87,0)
+"RTN","C0CCCR",84,0)
I '$D(DEBUG) S DEBUG=0
-"RTN","C0CCCR",88,0)
+"RTN","C0CCCR",85,0)
S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
-"RTN","C0CCCR",89,0)
+"RTN","C0CCCR",86,0)
I '$D(CCRPARMS) S CCRPARMS=""
-"RTN","C0CCCR",90,0)
+"RTN","C0CCCR",87,0)
I '$D(CCRPART) S CCRPART="CCR"
-"RTN","C0CCCR",91,0)
+"RTN","C0CCCR",88,0)
I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"CALL",DFN)=""
-"RTN","C0CCCR",92,0)
+"RTN","C0CCCR",89,0)
D SET^C0CPARMS(CCRPARMS) ;SET PARAMETERS WITH CCRPARMS AS OVERRIDES
-"RTN","C0CCCR",93,0)
+"RTN","C0CCCR",90,0)
I '$D(TESTVIT) S TESTVIT=0 ; FLAG FOR TESTING VITALS
-"RTN","C0CCCR",94,0)
+"RTN","C0CCCR",91,0)
I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
-"RTN","C0CCCR",95,0)
+"RTN","C0CCCR",92,0)
I '$D(TESTALERT) S TESTALERT=1 ; FLAG FOR TESTING ALERTS SECTION
-"RTN","C0CCCR",96,0)
+"RTN","C0CCCR",93,0)
I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING C0CMED SECTION
-"RTN","C0CCCR",97,0)
+"RTN","C0CCCR",94,0)
S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
-"RTN","C0CCCR",98,0)
+"RTN","C0CCCR",95,0)
S CCRGLO=$NA(^TMP("C0CCUR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
-"RTN","C0CCCR",99,0)
+"RTN","C0CCCR",96,0)
S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
-"RTN","C0CCCR",100,0)
+"RTN","C0CCCR",97,0)
; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
-"RTN","C0CCCR",101,0)
+"RTN","C0CCCR",98,0)
;M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART OR ALL
-"RTN","C0CCCR",102,0)
+"RTN","C0CCCR",99,0)
D LOAD^C0CCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE
-"RTN","C0CCCR",103,0)
+"RTN","C0CCCR",100,0)
D CP^C0CXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
-"RTN","C0CCCR",104,0)
+"RTN","C0CCCR",101,0)
;
-"RTN","C0CCCR",105,0)
+"RTN","C0CCCR",102,0)
; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
-"RTN","C0CCCR",106,0)
+"RTN","C0CCCR",103,0)
; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
-"RTN","C0CCCR",107,0)
+"RTN","C0CCCR",104,0)
D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
-"RTN","C0CCCR",108,0)
+"RTN","C0CCCR",105,0)
D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
-"RTN","C0CCCR",109,0)
+"RTN","C0CCCR",106,0)
D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
-"RTN","C0CCCR",110,0)
+"RTN","C0CCCR",107,0)
D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Comments")
-"RTN","C0CCCR",111,0)
+"RTN","C0CCCR",108,0)
I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
-"RTN","C0CCCR",112,0)
+"RTN","C0CCCR",109,0)
;
-"RTN","C0CCCR",113,0)
+"RTN","C0CCCR",110,0)
D HDRMAP(CCRGLO,DFN) ; MAP HEADER VARIABLES
-"RTN","C0CCCR",114,0)
+"RTN","C0CCCR",111,0)
;
-"RTN","C0CCCR",115,0)
+"RTN","C0CCCR",112,0)
K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
-"RTN","C0CCCR",116,0)
+"RTN","C0CCCR",113,0)
S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
-"RTN","C0CCCR",117,0)
+"RTN","C0CCCR",114,0)
D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
-"RTN","C0CCCR",118,0)
+"RTN","C0CCCR",115,0)
N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
-"RTN","C0CCCR",119,0)
+"RTN","C0CCCR",116,0)
F PROCI=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS
-"RTN","C0CCCR",120,0)
+"RTN","C0CCCR",117,0)
. S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
-"RTN","C0CCCR",121,0)
+"RTN","C0CCCR",118,0)
. S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
-"RTN","C0CCCR",122,0)
+"RTN","C0CCCR",119,0)
. S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
-"RTN","C0CCCR",123,0)
+"RTN","C0CCCR",120,0)
. S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
-"RTN","C0CCCR",124,0)
+"RTN","C0CCCR",121,0)
. D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
-"RTN","C0CCCR",125,0)
+"RTN","C0CCCR",122,0)
. S IXML="INXML"
-"RTN","C0CCCR",126,0)
+"RTN","C0CCCR",123,0)
. S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
-"RTN","C0CCCR",127,0)
+"RTN","C0CCCR",124,0)
. ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
-"RTN","C0CCCR",128,0)
+"RTN","C0CCCR",125,0)
. ; W OXML,!
-"RTN","C0CCCR",129,0)
+"RTN","C0CCCR",126,0)
. S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
-"RTN","C0CCCR",130,0)
+"RTN","C0CCCR",127,0)
. W "RUNNING ",CALL,!
-"RTN","C0CCCR",131,0)
+"RTN","C0CCCR",128,0)
. X CALL
-"RTN","C0CCCR",132,0)
+"RTN","C0CCCR",129,0)
. ; NOW INSERT THE RESULTS IN THE CCR BUFFER
-"RTN","C0CCCR",133,0)
+"RTN","C0CCCR",130,0)
. I $G(@OXML@(0))>0 D ; THERE IS A RESULT
-"RTN","C0CCCR",134,0)
+"RTN","C0CCCR",131,0)
. . D INSERT^C0CXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
-"RTN","C0CCCR",135,0)
+"RTN","C0CCCR",132,0)
. . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
-"RTN","C0CCCR",136,0)
+"RTN","C0CCCR",133,0)
N ACTT,ATMP,ACTT2,ATMP2 ; TEMPORARY ARRAY SYMBOLS FOR ACTOR PROCESSING
-"RTN","C0CCCR",137,0)
+"RTN","C0CCCR",134,0)
D ACTLST^C0CCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
-"RTN","C0CCCR",138,0)
+"RTN","C0CCCR",135,0)
D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
-"RTN","C0CCCR",139,0)
+"RTN","C0CCCR",136,0)
D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
-"RTN","C0CCCR",140,0)
+"RTN","C0CCCR",137,0)
D INSINNER^C0CXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
-"RTN","C0CCCR",141,0)
+"RTN","C0CCCR",138,0)
K ACTT,ACTT2
-"RTN","C0CCCR",142,0)
+"RTN","C0CCCR",139,0)
;D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Comments","CMTT")
-"RTN","C0CCCR",143,0)
+"RTN","C0CCCR",140,0)
;D EXTRACT^C0CCMT("CMTT",DFN,"CMTT2")
-"RTN","C0CCCR",144,0)
+"RTN","C0CCCR",141,0)
;D INSINNER^C0CXPATH(CCRGLO,"CMTT2","//ContinuityOfCareRecord/Comments")
-"RTN","C0CCCR",145,0)
+"RTN","C0CCCR",142,0)
; gpl - turned off Comments for Certification
-"RTN","C0CCCR",146,0)
+"RTN","C0CCCR",143,0)
K CMTT,CMTT2
-"RTN","C0CCCR",147,0)
+"RTN","C0CCCR",144,0)
N TRIMI,J,DONE S DONE=0
-"RTN","C0CCCR",148,0)
+"RTN","C0CCCR",145,0)
F TRIMI=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
-"RTN","C0CCCR",149,0)
+"RTN","C0CCCR",146,0)
. S J=$$TRIM^C0CXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
-"RTN","C0CCCR",150,0)
+"RTN","C0CCCR",147,0)
. I DEBUG W "TRIMMED",J,!
-"RTN","C0CCCR",151,0)
+"RTN","C0CCCR",148,0)
. I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
-"RTN","C0CCCR",152,0)
+"RTN","C0CCCR",149,0)
;S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLOBAL OF PART OR ALL
-"RTN","C0CCCR",153,0)
+"RTN","C0CCCR",150,0)
I CCRPART="CCR" M CCRGRTN=@CCRGLO ; ENTIRE CCR
-"RTN","C0CCCR",154,0)
+"RTN","C0CCCR",151,0)
E M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART
-"RTN","C0CCCR",155,0)
+"RTN","C0CCCR",152,0)
I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"RESULT",CCRGRTN(0))=""
-"RTN","C0CCCR",156,0)
+"RTN","C0CCCR",153,0)
K ^TMP("C0CCCR",$J) ; BEGIN TO CLEAN UP
-"RTN","C0CCCR",157,0)
+"RTN","C0CCCR",154,0)
K ^TMP($J) ; REALLY CLEAN UP
-"RTN","C0CCCR",158,0)
+"RTN","C0CCCR",155,0)
M ^TMP($J)=^TMP("C0CSAV",$J) ; RESTORE CALLER'S $J
-"RTN","C0CCCR",159,0)
+"RTN","C0CCCR",156,0)
Q
-"RTN","C0CCCR",160,0)
+"RTN","C0CCCR",157,0)
;
-"RTN","C0CCCR",161,0)
+"RTN","C0CCCR",158,0)
INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS
-"RTN","C0CCCR",162,0)
+"RTN","C0CCCR",159,0)
; TAB IS PASSED BY NAME
-"RTN","C0CCCR",163,0)
+"RTN","C0CCCR",160,0)
I DEBUG W "TAB= ",TAB,!
-"RTN","C0CCCR",164,0)
+"RTN","C0CCCR",161,0)
; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
-"RTN","C0CCCR",165,0)
+"RTN","C0CCCR",162,0)
D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")")
-"RTN","C0CCCR",166,0)
+"RTN","C0CCCR",163,0)
I TESTALERT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""C0CCCR"",$J,DFN,""ALERTS"")")
-"RTN","C0CCCR",167,0)
+"RTN","C0CCCR",164,0)
D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
-"RTN","C0CCCR",168,0)
+"RTN","C0CCCR",165,0)
D PUSH^C0CXPATH(TAB,"MAP;C0CIMMU;//ContinuityOfCareRecord/Body/Immunizations;^TMP(""C0CCCR"",$J,DFN,""IMMUNE"")")
-"RTN","C0CCCR",169,0)
+"RTN","C0CCCR",166,0)
I TESTVIT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVIT2;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
-"RTN","C0CCCR",170,0)
+"RTN","C0CCCR",167,0)
E D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
-"RTN","C0CCCR",171,0)
+"RTN","C0CCCR",168,0)
D PUSH^C0CXPATH(TAB,"MAP;C0CLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""C0CCCR"",$J,DFN,""RESULTS"")")
-"RTN","C0CCCR",172,0)
+"RTN","C0CCCR",169,0)
D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROC;//ContinuityOfCareRecord/Body/Procedures;^TMP(""C0CCCR"",$J,DFN,""PROCEDURES"")")
-"RTN","C0CCCR",173,0)
+"RTN","C0CCCR",170,0)
;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")")
-"RTN","C0CCCR",174,0)
+"RTN","C0CCCR",171,0)
; gpl - turned off Encounters for Certification
-"RTN","C0CCCR",175,0)
+"RTN","C0CCCR",172,0)
;OHUM/RUT 3120109 Changed the condition
-"RTN","C0CCCR",176,0)
+"RTN","C0CCCR",173,0)
;;OHUM/RUT 3111228 Condition for Notes ; It should be included or not
-"RTN","C0CCCR",177,0)
+"RTN","C0CCCR",174,0)
;;I ^TMP("C0CCCR","TIULIMIT")'="" D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")")
-"RTN","C0CCCR",178,0)
+"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",179,0)
+"RTN","C0CCCR",176,0)
;;OHUM/RUT
-"RTN","C0CCCR",180,0)
+"RTN","C0CCCR",177,0)
;OHUM/RUT
-"RTN","C0CCCR",181,0)
+"RTN","C0CCCR",178,0)
Q
-"RTN","C0CCCR",182,0)
+"RTN","C0CCCR",179,0)
;
-"RTN","C0CCCR",183,0)
+"RTN","C0CCCR",180,0)
HDRMAP(CXML,DFN) ; MAP HEADER VARIABLES: FROM, TO ECT
-"RTN","C0CCCR",184,0)
+"RTN","C0CCCR",181,0)
N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
-"RTN","C0CCCR",185,0)
+"RTN","C0CCCR",182,0)
; K @VMAP
-"RTN","C0CCCR",186,0)
+"RTN","C0CCCR",183,0)
S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
-"RTN","C0CCCR",187,0)
+"RTN","C0CCCR",184,0)
; I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
-"RTN","C0CCCR",188,0)
+"RTN","C0CCCR",185,0)
D ; ALWAYS MAP THESE VARIABLES
-"RTN","C0CCCR",189,0)
+"RTN","C0CCCR",186,0)
. S @VMAP@("CCRDOCOBJECTID")=$$UUID^C0CUTIL ; UUID FOR THIS CCR
-"RTN","C0CCCR",190,0)
+"RTN","C0CCCR",187,0)
. S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
-"RTN","C0CCCR",191,0)
+"RTN","C0CCCR",188,0)
. S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - FROM PROVIDER
-"RTN","C0CCCR",192,0)
+"RTN","C0CCCR",189,0)
. ;S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
-"RTN","C0CCCR",193,0)
+"RTN","C0CCCR",190,0)
. S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
-"RTN","C0CCCR",194,0)
+"RTN","C0CCCR",191,0)
. S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES
-"RTN","C0CCCR",195,0)
+"RTN","C0CCCR",192,0)
. S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES
-"RTN","C0CCCR",196,0)
+"RTN","C0CCCR",193,0)
. S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES
-"RTN","C0CCCR",197,0)
+"RTN","C0CCCR",194,0)
. ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
-"RTN","C0CCCR",198,0)
+"RTN","C0CCCR",195,0)
;I IHDR'="" D ; HEADER VALUES ARE PROVIDED
-"RTN","C0CCCR",199,0)
+"RTN","C0CCCR",196,0)
;. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
-"RTN","C0CCCR",200,0)
+"RTN","C0CCCR",197,0)
N CTMP
-"RTN","C0CCCR",201,0)
+"RTN","C0CCCR",198,0)
D MAP^C0CXPATH(CXML,VMAP,"CTMP")
-"RTN","C0CCCR",202,0)
+"RTN","C0CCCR",199,0)
D CP^C0CXPATH("CTMP",CXML)
-"RTN","C0CCCR",203,0)
+"RTN","C0CCCR",200,0)
N HRIMVARS ;
-"RTN","C0CCCR",204,0)
+"RTN","C0CCCR",201,0)
S HRIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"HEADER")) ; TO PERSIST VARS
-"RTN","C0CCCR",205,0)
+"RTN","C0CCCR",202,0)
M @HRIMVARS@(1)=@VMAP ; PERSIST THE HEADER VARIABLES IN RIM TABLE
-"RTN","C0CCCR",206,0)
+"RTN","C0CCCR",203,0)
S @HRIMVARS@(0)=1 ; ONLY ONE SET OF HEADERS PER PATIENT
-"RTN","C0CCCR",207,0)
+"RTN","C0CCCR",204,0)
Q
-"RTN","C0CCCR",208,0)
+"RTN","C0CCCR",205,0)
;
-"RTN","C0CCCR",209,0)
+"RTN","C0CCCR",206,0)
ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
-"RTN","C0CCCR",210,0)
+"RTN","C0CCCR",207,0)
; AXML AND ACTRTN ARE PASSED BY NAME
-"RTN","C0CCCR",211,0)
+"RTN","C0CCCR",208,0)
; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
-"RTN","C0CCCR",212,0)
+"RTN","C0CCCR",209,0)
; P1= OBJECTID - ACTORPATIENT_2
-"RTN","C0CCCR",213,0)
+"RTN","C0CCCR",210,0)
; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
-"RTN","C0CCCR",214,0)
+"RTN","C0CCCR",211,0)
;OR INSTITUTION
-"RTN","C0CCCR",215,0)
+"RTN","C0CCCR",212,0)
; OR PERSON(IN PATIENT FILE IE NOK)
-"RTN","C0CCCR",216,0)
+"RTN","C0CCCR",213,0)
; P3= IEN RECORD NUMBER FOR ACTOR - 2
-"RTN","C0CCCR",217,0)
+"RTN","C0CCCR",214,0)
N I,J,K,L
-"RTN","C0CCCR",218,0)
+"RTN","C0CCCR",215,0)
K @ACTRTN ; CLEAR RETURN ARRAY
-"RTN","C0CCCR",219,0)
+"RTN","C0CCCR",216,0)
F I=1:1:@AXML@(0) D ; FIRST FIX MISSING LINKS
-"RTN","C0CCCR",220,0)
+"RTN","C0CCCR",217,0)
. I @AXML@(I)?.E1"_<".E D ;
-"RTN","C0CCCR",221,0)
+"RTN","C0CCCR",218,0)
. . N ZA,ZB
-"RTN","C0CCCR",222,0)
+"RTN","C0CCCR",219,0)
. . S ZA=$P(@AXML@(I),">",1)_">"
-"RTN","C0CCCR",223,0)
+"RTN","C0CCCR",220,0)
. . S ZB="<"_$P(@AXML@(I),"<",3)
-"RTN","C0CCCR",224,0)
+"RTN","C0CCCR",221,0)
. . S @AXML@(I)=ZA_"ACTORORGANIZATION_1"_ZB
-"RTN","C0CCCR",225,0)
+"RTN","C0CCCR",222,0)
F I=1:1:@AXML@(0) D ; SCAN ALL LINES
-"RTN","C0CCCR",226,0)
+"RTN","C0CCCR",223,0)
. I @AXML@(I)?.E1"".E D ; THERE IS AN ACTOR THIS LINE
-"RTN","C0CCCR",227,0)
+"RTN","C0CCCR",224,0)
. . S J=$P($P(@AXML@(I),"",2),"",1)
-"RTN","C0CCCR",228,0)
+"RTN","C0CCCR",225,0)
. . I $G(LINKDEBUG) W "=>",J,!
-"RTN","C0CCCR",229,0)
+"RTN","C0CCCR",226,0)
. . I J'="" S K(J)="" ; HASHING ACTOR
-"RTN","C0CCCR",230,0)
+"RTN","C0CCCR",227,0)
. I @AXML@(I)?.E1"".E D ; THERE IS AN ACTOR THIS LINE
-"RTN","C0CCCR",231,0)
+"RTN","C0CCCR",228,0)
. . S J=$P($P(@AXML@(I),"",2),"",1)
-"RTN","C0CCCR",232,0)
+"RTN","C0CCCR",229,0)
. . I $G(LINKDEBUG) W "=>",J,!
-"RTN","C0CCCR",233,0)
+"RTN","C0CCCR",230,0)
. . I J'="" S K(J)="" ; HASHING ACTOR
-"RTN","C0CCCR",234,0)
+"RTN","C0CCCR",231,0)
. . ; TO GET RID OF DUPLICATES
-"RTN","C0CCCR",235,0)
+"RTN","C0CCCR",232,0)
S I="" ; GOING TO $O THROUGH THE HASH
-"RTN","C0CCCR",236,0)
+"RTN","C0CCCR",233,0)
F J=0:0 D Q:$O(K(I))=""
-"RTN","C0CCCR",237,0)
+"RTN","C0CCCR",234,0)
. S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
-"RTN","C0CCCR",238,0)
+"RTN","C0CCCR",235,0)
. S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
-"RTN","C0CCCR",239,0)
+"RTN","C0CCCR",236,0)
. S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
-"RTN","C0CCCR",240,0)
+"RTN","C0CCCR",237,0)
. S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
-"RTN","C0CCCR",241,0)
+"RTN","C0CCCR",238,0)
. D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
-"RTN","C0CCCR",242,0)
+"RTN","C0CCCR",239,0)
Q
-"RTN","C0CCCR",243,0)
+"RTN","C0CCCR",240,0)
;
-"RTN","C0CCCR",244,0)
+"RTN","C0CCCR",241,0)
TEST ; RUN ALL THE TEST CASES
-"RTN","C0CCCR",245,0)
+"RTN","C0CCCR",242,0)
D TESTALL^C0CUNIT("C0CCCR")
-"RTN","C0CCCR",246,0)
+"RTN","C0CCCR",243,0)
Q
-"RTN","C0CCCR",247,0)
+"RTN","C0CCCR",244,0)
;
-"RTN","C0CCCR",248,0)
+"RTN","C0CCCR",245,0)
ZTEST(WHICH) ; RUN ONE SET OF TESTS
-"RTN","C0CCCR",249,0)
+"RTN","C0CCCR",246,0)
N ZTMP
-"RTN","C0CCCR",250,0)
+"RTN","C0CCCR",247,0)
D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
-"RTN","C0CCCR",251,0)
+"RTN","C0CCCR",248,0)
D ZTEST^C0CUNIT(.ZTMP,WHICH)
-"RTN","C0CCCR",252,0)
+"RTN","C0CCCR",249,0)
Q
-"RTN","C0CCCR",253,0)
+"RTN","C0CCCR",250,0)
;
-"RTN","C0CCCR",254,0)
+"RTN","C0CCCR",251,0)
TLIST ; LIST THE TESTS
-"RTN","C0CCCR",255,0)
+"RTN","C0CCCR",252,0)
N ZTMP
-"RTN","C0CCCR",256,0)
+"RTN","C0CCCR",253,0)
D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
-"RTN","C0CCCR",257,0)
+"RTN","C0CCCR",254,0)
D TLIST^C0CUNIT(.ZTMP)
-"RTN","C0CCCR",258,0)
+"RTN","C0CCCR",255,0)
Q
-"RTN","C0CCCR",259,0)
+"RTN","C0CCCR",256,0)
;
-"RTN","C0CCCR",260,0)
+"RTN","C0CCCR",257,0)
;;>
-"RTN","C0CCCR",261,0)
+"RTN","C0CCCR",258,0)
;;>
-"RTN","C0CCCR",262,0)
+"RTN","C0CCCR",259,0)
;;>>>K C0C S C0C=""
-"RTN","C0CCCR",263,0)
+"RTN","C0CCCR",260,0)
;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","")
-"RTN","C0CCCR",264,0)
+"RTN","C0CCCR",261,0)
;;>>?@C0C@(@C0C@(0))[""
-"RTN","C0CCCR",265,0)
+"RTN","C0CCCR",262,0)
;;>
-"RTN","C0CCCR",266,0)
+"RTN","C0CCCR",263,0)
;;>>>K C0C S C0C=""
-"RTN","C0CCCR",267,0)
+"RTN","C0CCCR",264,0)
;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","")
-"RTN","C0CCCR",268,0)
+"RTN","C0CCCR",265,0)
;;>>?@C0C@(@C0C@(0))[""
-"RTN","C0CCCR",269,0)
+"RTN","C0CCCR",266,0)
;;>
-"RTN","C0CCCR",270,0)
+"RTN","C0CCCR",267,0)
;;>>>K C0C S C0C=""
-"RTN","C0CCCR",271,0)
+"RTN","C0CCCR",268,0)
;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
-"RTN","C0CCCR",272,0)
+"RTN","C0CCCR",269,0)
;;>>?@C0C@(@C0C@(0))[""
-"RTN","C0CCCR",273,0)
+"RTN","C0CCCR",270,0)
;;>
-"RTN","C0CCCR",274,0)
+"RTN","C0CCCR",271,0)
;;>>>K C0C S C0C=""
-"RTN","C0CCCR",275,0)
+"RTN","C0CCCR",272,0)
;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
-"RTN","C0CCCR",276,0)
+"RTN","C0CCCR",273,0)
;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST")
-"RTN","C0CCCR",277,0)
+"RTN","C0CCCR",274,0)
;;>
-"RTN","C0CCCR",278,0)
+"RTN","C0CCCR",275,0)
;;>>>D ZTEST^C0CCCR("ACTLST")
-"RTN","C0CCCR",279,0)
+"RTN","C0CCCR",276,0)
;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
-"RTN","C0CCCR",280,0)
+"RTN","C0CCCR",277,0)
;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3")
-"RTN","C0CCCR",281,0)
+"RTN","C0CCCR",278,0)
;;>>?G3(G3(0))[""
-"RTN","C0CCCR",282,0)
+"RTN","C0CCCR",279,0)
;;>
-"RTN","C0CCCR",283,0)
+"RTN","C0CCCR",280,0)
;;>>>D ZTEST^C0CCCR("CCR")
-"RTN","C0CCCR",284,0)
+"RTN","C0CCCR",281,0)
;;>>>W $$TRIM^C0CXPATH(CCRGLO)
-"RTN","C0CCCR",285,0)
+"RTN","C0CCCR",282,0)
;;>
-"RTN","C0CCCR",286,0)
+"RTN","C0CCCR",283,0)
;;>>>S TESTALERT=1
-"RTN","C0CCCR",287,0)
+"RTN","C0CCCR",284,0)
;;>>>K C0C S C0C=""
-"RTN","C0CCCR",288,0)
+"RTN","C0CCCR",285,0)
;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","")
-"RTN","C0CCCR",289,0)
+"RTN","C0CCCR",286,0)
;;>>?@C0C@(@C0C@(0))[""
-"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 .
"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.,
-"RTN","C0CCCR0",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","C0CCCR0",20,0)
- ;
-"RTN","C0CCCR0",21,0)
W "This is a CCR TEMPLATE with processing routines",!
-"RTN","C0CCCR0",22,0)
+"RTN","C0CCCR0",19,0)
W !
-"RTN","C0CCCR0",23,0)
+"RTN","C0CCCR0",20,0)
Q
-"RTN","C0CCCR0",24,0)
+"RTN","C0CCCR0",21,0)
;
-"RTN","C0CCCR0",25,0)
+"RTN","C0CCCR0",22,0)
ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
-"RTN","C0CCCR0",26,0)
+"RTN","C0CCCR0",23,0)
; ZARY IS PASSED BY NAME
-"RTN","C0CCCR0",27,0)
+"RTN","C0CCCR0",24,0)
; BAT is a string identifying the section
-"RTN","C0CCCR0",28,0)
+"RTN","C0CCCR0",25,0)
; LINE is a test which will evaluate to true or false
-"RTN","C0CCCR0",29,0)
+"RTN","C0CCCR0",26,0)
; I '$G(@ZARY) D ;
-"RTN","C0CCCR0",30,0)
+"RTN","C0CCCR0",27,0)
; . S @ZARY@(0)=0 ; initially there are no elements
-"RTN","C0CCCR0",31,0)
+"RTN","C0CCCR0",28,0)
; . W "GOT HERE LOADING "_LINE,!
-"RTN","C0CCCR0",32,0)
+"RTN","C0CCCR0",29,0)
N CNT ; count of array elements
-"RTN","C0CCCR0",33,0)
+"RTN","C0CCCR0",30,0)
S CNT=@ZARY@(0) ; contains array count
-"RTN","C0CCCR0",34,0)
+"RTN","C0CCCR0",31,0)
S CNT=CNT+1 ; increment count
-"RTN","C0CCCR0",35,0)
+"RTN","C0CCCR0",32,0)
S @ZARY@(CNT)=LINE ; put the line in the array
-"RTN","C0CCCR0",36,0)
+"RTN","C0CCCR0",33,0)
; S @ZARY@(BAT,CNT)="" ; index the test by battery
-"RTN","C0CCCR0",37,0)
+"RTN","C0CCCR0",34,0)
S @ZARY@(0)=CNT ; update the array counter
-"RTN","C0CCCR0",38,0)
+"RTN","C0CCCR0",35,0)
Q
-"RTN","C0CCCR0",39,0)
+"RTN","C0CCCR0",36,0)
;
-"RTN","C0CCCR0",40,0)
+"RTN","C0CCCR0",37,0)
ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
-"RTN","C0CCCR0",41,0)
+"RTN","C0CCCR0",38,0)
; ZARY IS PASSED BY NAME
-"RTN","C0CCCR0",42,0)
+"RTN","C0CCCR0",39,0)
; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
-"RTN","C0CCCR0",43,0)
+"RTN","C0CCCR0",40,0)
; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
-"RTN","C0CCCR0",44,0)
+"RTN","C0CCCR0",41,0)
K @ZARY S @ZARY=""
-"RTN","C0CCCR0",45,0)
+"RTN","C0CCCR0",42,0)
S @ZARY@(0)=0 ; initialize array count
-"RTN","C0CCCR0",46,0)
+"RTN","C0CCCR0",43,0)
N LINE,LABEL,BODY
-"RTN","C0CCCR0",47,0)
+"RTN","C0CCCR0",44,0)
N INTEST S INTEST=0 ; switch for in the TEMPLATE section
-"RTN","C0CCCR0",48,0)
+"RTN","C0CCCR0",45,0)
N SECTION S SECTION="[anonymous]" ; NO section LABEL
-"RTN","C0CCCR0",49,0)
+"RTN","C0CCCR0",46,0)
;
-"RTN","C0CCCR0",50,0)
+"RTN","C0CCCR0",47,0)
N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D
-"RTN","C0CCCR0",51,0)
+"RTN","C0CCCR0",48,0)
. I LINE?." "1";".E S INTEST=1 ; entering section
-"RTN","C0CCCR0",52,0)
+"RTN","C0CCCR0",49,0)
. I LINE?." "1";".E S INTEST=0 ; leaving section
-"RTN","C0CCCR0",53,0)
+"RTN","C0CCCR0",50,0)
. I INTEST D ; within the section
-"RTN","C0CCCR0",54,0)
+"RTN","C0CCCR0",51,0)
. . I LINE?." "1";><".E D ; sub-section name found
-"RTN","C0CCCR0",55,0)
+"RTN","C0CCCR0",52,0)
. . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
-"RTN","C0CCCR0",56,0)
+"RTN","C0CCCR0",53,0)
. . I LINE?." "1";;".E D ; line found
-"RTN","C0CCCR0",57,0)
+"RTN","C0CCCR0",54,0)
. . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
-"RTN","C0CCCR0",58,0)
+"RTN","C0CCCR0",55,0)
Q
-"RTN","C0CCCR0",59,0)
+"RTN","C0CCCR0",56,0)
;
-"RTN","C0CCCR0",60,0)
+"RTN","C0CCCR0",57,0)
LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
-"RTN","C0CCCR0",61,0)
+"RTN","C0CCCR0",58,0)
D ZLOAD(ARY,"C0CCCR0")
-"RTN","C0CCCR0",62,0)
+"RTN","C0CCCR0",59,0)
; ZWR @ARY
-"RTN","C0CCCR0",63,0)
+"RTN","C0CCCR0",60,0)
Q
-"RTN","C0CCCR0",64,0)
+"RTN","C0CCCR0",61,0)
;
-"RTN","C0CCCR0",65,0)
+"RTN","C0CCCR0",62,0)
;
-"RTN","C0CCCR0",66,0)
+"RTN","C0CCCR0",63,0)
;;
-"RTN","C0CCCR0",67,0)
+"RTN","C0CCCR0",64,0)
;;
-"RTN","C0CCCR0",68,0)
+"RTN","C0CCCR0",65,0)
;;
-"RTN","C0CCCR0",69,0)
+"RTN","C0CCCR0",66,0)
;;@@CCRDOCOBJECTID@@
-"RTN","C0CCCR0",70,0)
+"RTN","C0CCCR0",67,0)
;;
-"RTN","C0CCCR0",71,0)
+"RTN","C0CCCR0",68,0)
;;English
-"RTN","C0CCCR0",72,0)
+"RTN","C0CCCR0",69,0)
;;
-"RTN","C0CCCR0",73,0)
+"RTN","C0CCCR0",70,0)
;;V1.0
-"RTN","C0CCCR0",74,0)
+"RTN","C0CCCR0",71,0)
;;
-"RTN","C0CCCR0",75,0)
+"RTN","C0CCCR0",72,0)
;;@@DATETIME@@
-"RTN","C0CCCR0",76,0)
+"RTN","C0CCCR0",73,0)
;;
-"RTN","C0CCCR0",77,0)
+"RTN","C0CCCR0",74,0)
;;
-"RTN","C0CCCR0",78,0)
+"RTN","C0CCCR0",75,0)
;;@@ACTORPATIENT@@
-"RTN","C0CCCR0",79,0)
+"RTN","C0CCCR0",76,0)
;;
-"RTN","C0CCCR0",80,0)
+"RTN","C0CCCR0",77,0)
;;
+"RTN","C0CCCR0",78,0)
+ ;;
+"RTN","C0CCCR0",79,0)
+ ;;@@ACTORFROM@@
+"RTN","C0CCCR0",80,0)
+ ;;
"RTN","C0CCCR0",81,0)
;;
"RTN","C0CCCR0",82,0)
- ;;@@ACTORFROM@@
+ ;;@@ACTORFROM2@@
"RTN","C0CCCR0",83,0)
;;
"RTN","C0CCCR0",84,0)
- ;;
-"RTN","C0CCCR0",85,0)
- ;;@@ACTORFROM2@@
-"RTN","C0CCCR0",86,0)
- ;;
-"RTN","C0CCCR0",87,0)
;;
-"RTN","C0CCCR0",88,0)
+"RTN","C0CCCR0",85,0)
;;
-"RTN","C0CCCR0",89,0)
+"RTN","C0CCCR0",86,0)
;;
-"RTN","C0CCCR0",90,0)
+"RTN","C0CCCR0",87,0)
;;@@ACTORTO@@
-"RTN","C0CCCR0",91,0)
+"RTN","C0CCCR0",88,0)
;;
-"RTN","C0CCCR0",92,0)
+"RTN","C0CCCR0",89,0)
;;@@ACTORTOTEXT@@
-"RTN","C0CCCR0",93,0)
+"RTN","C0CCCR0",90,0)
;;
-"RTN","C0CCCR0",94,0)
+"RTN","C0CCCR0",91,0)
;;
-"RTN","C0CCCR0",95,0)
+"RTN","C0CCCR0",92,0)
;;
-"RTN","C0CCCR0",96,0)
+"RTN","C0CCCR0",93,0)
;;
-"RTN","C0CCCR0",97,0)
+"RTN","C0CCCR0",94,0)
;;
-"RTN","C0CCCR0",98,0)
+"RTN","C0CCCR0",95,0)
;;@@PURPOSEDESCRIPTION@@
-"RTN","C0CCCR0",99,0)
+"RTN","C0CCCR0",96,0)
;;
-"RTN","C0CCCR0",100,0)
+"RTN","C0CCCR0",97,0)
;;
-"RTN","C0CCCR0",101,0)
+"RTN","C0CCCR0",98,0)
;;
-"RTN","C0CCCR0",102,0)
+"RTN","C0CCCR0",99,0)
;;
-"RTN","C0CCCR0",103,0)
+"RTN","C0CCCR0",100,0)
;;
-"RTN","C0CCCR0",104,0)
+"RTN","C0CCCR0",101,0)
;;@@PROBLEMOBJECTID@@
-"RTN","C0CCCR0",105,0)
+"RTN","C0CCCR0",102,0)
;;
-"RTN","C0CCCR0",106,0)
+"RTN","C0CCCR0",103,0)
;;@@PROBLEMDATEMOD@@
+"RTN","C0CCCR0",104,0)
+ ;;
+"RTN","C0CCCR0",105,0)
+ ;;
+"RTN","C0CCCR0",106,0)
+ ;;Problem
"RTN","C0CCCR0",107,0)
- ;;
+ ;;
"RTN","C0CCCR0",108,0)
- ;;
+ ;;
"RTN","C0CCCR0",109,0)
- ;;Problem
-"RTN","C0CCCR0",110,0)
- ;;
-"RTN","C0CCCR0",111,0)
- ;;
-"RTN","C0CCCR0",112,0)
;;@@PROBLEMDESCRIPTION@@
-"RTN","C0CCCR0",113,0)
+"RTN","C0CCCR0",110,0)
;;
-"RTN","C0CCCR0",114,0)
+"RTN","C0CCCR0",111,0)
;;@@PROBLEMCODEVALUE@@
-"RTN","C0CCCR0",115,0)
+"RTN","C0CCCR0",112,0)
;;ICD9CM
-"RTN","C0CCCR0",116,0)
+"RTN","C0CCCR0",113,0)
;;@@PROBLEMCODINGVERSION@@
+"RTN","C0CCCR0",114,0)
+ ;;
+"RTN","C0CCCR0",115,0)
+ ;;
+"RTN","C0CCCR0",116,0)
+ ;;
"RTN","C0CCCR0",117,0)
- ;;
-"RTN","C0CCCR0",118,0)
- ;;
-"RTN","C0CCCR0",119,0)
- ;;
-"RTN","C0CCCR0",120,0)
;;@@PROBLEMSTATUS@@
+"RTN","C0CCCR0",118,0)
+ ;;
+"RTN","C0CCCR0",119,0)
+ ;;
-"RTN","C0CCCR0",122,0)
- ;;
+"RTN","C0CCCR0",124,0)
+ ;;
"RTN","C0CCCR0",125,0)
- ;;
-"RTN","C0CCCR0",126,0)
- ;;
-"RTN","C0CCCR0",127,0)
- ;;
-"RTN","C0CCCR0",128,0)
;;
-"RTN","C0CCCR0",129,0)
+"RTN","C0CCCR0",126,0)
;;
-"RTN","C0CCCR0",130,0)
+"RTN","C0CCCR0",127,0)
;;
-"RTN","C0CCCR0",131,0)
+"RTN","C0CCCR0",128,0)
;;@@IMMUNEOBJECTID@@
-"RTN","C0CCCR0",132,0)
+"RTN","C0CCCR0",129,0)
;;
-"RTN","C0CCCR0",133,0)
+"RTN","C0CCCR0",130,0)
;;
-"RTN","C0CCCR0",134,0)
+"RTN","C0CCCR0",131,0)
;;@@IMMUNEDATETIMETYPETEXT@@
-"RTN","C0CCCR0",135,0)
+"RTN","C0CCCR0",132,0)
;;
-"RTN","C0CCCR0",136,0)
+"RTN","C0CCCR0",133,0)
;;@@IMMUNEDATETIME@@
+"RTN","C0CCCR0",134,0)
+ ;;
+"RTN","C0CCCR0",135,0)
+ ;;
-"RTN","C0CCCR0",143,0)
- ;;
-"RTN","C0CCCR0",144,0)
- ;;
-"RTN","C0CCCR0",145,0)
;;@@IMMUNEPRODUCTNAMETEXT@@
-"RTN","C0CCCR0",146,0)
+"RTN","C0CCCR0",143,0)
;;
-"RTN","C0CCCR0",147,0)
+"RTN","C0CCCR0",144,0)
;;@@IMMUNEPRODUCTCODE@@
-"RTN","C0CCCR0",148,0)
+"RTN","C0CCCR0",145,0)
;;@@IMMUNEPRODUCTCODESYSTEM@@
+"RTN","C0CCCR0",146,0)
+ ;;
+"RTN","C0CCCR0",147,0)
+ ;;
+"RTN","C0CCCR0",148,0)
+ ;;
"RTN","C0CCCR0",149,0)
- ;;
-"RTN","C0CCCR0",150,0)
- ;;
-"RTN","C0CCCR0",151,0)
- ;;
-"RTN","C0CCCR0",152,0)
;;
-"RTN","C0CCCR0",153,0)
+"RTN","C0CCCR0",150,0)
;;
-"RTN","C0CCCR0",154,0)
+"RTN","C0CCCR0",151,0)
;;
-"RTN","C0CCCR0",155,0)
+"RTN","C0CCCR0",152,0)
;;
-"RTN","C0CCCR0",156,0)
+"RTN","C0CCCR0",153,0)
;;@@FAMILYHISTORYOBJECTID@@
-"RTN","C0CCCR0",157,0)
+"RTN","C0CCCR0",154,0)
;;
-"RTN","C0CCCR0",158,0)
+"RTN","C0CCCR0",155,0)
;;
-"RTN","C0CCCR0",159,0)
+"RTN","C0CCCR0",156,0)
;;@@FAMILYHISTORYACTORID@@
-"RTN","C0CCCR0",160,0)
+"RTN","C0CCCR0",157,0)
;;
-"RTN","C0CCCR0",161,0)
+"RTN","C0CCCR0",158,0)
;;
-"RTN","C0CCCR0",162,0)
+"RTN","C0CCCR0",159,0)
;;
-"RTN","C0CCCR0",163,0)
+"RTN","C0CCCR0",160,0)
;;@@FAMILYMEMBERACTORID@@
-"RTN","C0CCCR0",164,0)
+"RTN","C0CCCR0",161,0)
;;
-"RTN","C0CCCR0",165,0)
+"RTN","C0CCCR0",162,0)
;;@@FAMILYMEMBERACTORROLETEXT@@
+"RTN","C0CCCR0",163,0)
+ ;;
+"RTN","C0CCCR0",164,0)
+ ;;
+"RTN","C0CCCR0",165,0)
+ ;;
"RTN","C0CCCR0",166,0)
- ;;
-"RTN","C0CCCR0",167,0)
- ;;
-"RTN","C0CCCR0",168,0)
- ;;
-"RTN","C0CCCR0",169,0)
;;@@FAMILYMEMBERSOURCACTORID@@
-"RTN","C0CCCR0",170,0)
+"RTN","C0CCCR0",167,0)
;;
-"RTN","C0CCCR0",171,0)
+"RTN","C0CCCR0",168,0)
;;
-"RTN","C0CCCR0",172,0)
+"RTN","C0CCCR0",169,0)
;;
-"RTN","C0CCCR0",173,0)
+"RTN","C0CCCR0",170,0)
;;
-"RTN","C0CCCR0",174,0)
+"RTN","C0CCCR0",171,0)
;;
-"RTN","C0CCCR0",175,0)
+"RTN","C0CCCR0",172,0)
;;Problem
-"RTN","C0CCCR0",176,0)
+"RTN","C0CCCR0",173,0)
;;
-"RTN","C0CCCR0",177,0)
+"RTN","C0CCCR0",174,0)
;;
-"RTN","C0CCCR0",178,0)
+"RTN","C0CCCR0",175,0)
;;@@FAMILYMEMBERPROBLEMDESCRIPTION@@
-"RTN","C0CCCR0",179,0)
+"RTN","C0CCCR0",176,0)
;;
-"RTN","C0CCCR0",180,0)
+"RTN","C0CCCR0",177,0)
;;@@FAMILYMEMBERPROBLEMCODE@@
-"RTN","C0CCCR0",181,0)
+"RTN","C0CCCR0",178,0)
;;@@FAMILYMEMBERCODESYSTEM@@
-"RTN","C0CCCR0",182,0)
+"RTN","C0CCCR0",179,0)
;;@@FAMILYMEMBERCODEVERSION@@
+"RTN","C0CCCR0",180,0)
+ ;;
+"RTN","C0CCCR0",181,0)
+ ;;
+"RTN","C0CCCR0",182,0)
+ ;;
"RTN","C0CCCR0",183,0)
- ;;
+ ;;
"RTN","C0CCCR0",184,0)
- ;;
-"RTN","C0CCCR0",185,0)
- ;;
-"RTN","C0CCCR0",186,0)
- ;;
-"RTN","C0CCCR0",187,0)
;;@@FAMILYMEMBERPROBLEMSOURCEID@@
+"RTN","C0CCCR0",185,0)
+ ;;
+"RTN","C0CCCR0",186,0)
+ ;;
+"RTN","C0CCCR0",187,0)
+ ;;
"RTN","C0CCCR0",188,0)
- ;;
-"RTN","C0CCCR0",189,0)
- ;;
-"RTN","C0CCCR0",190,0)
- ;;
-"RTN","C0CCCR0",191,0)
;;
-"RTN","C0CCCR0",192,0)
+"RTN","C0CCCR0",189,0)
;;
-"RTN","C0CCCR0",193,0)
+"RTN","C0CCCR0",190,0)
;;
-"RTN","C0CCCR0",194,0)
+"RTN","C0CCCR0",191,0)
;;
-"RTN","C0CCCR0",195,0)
+"RTN","C0CCCR0",192,0)
;;@@SOCIALHISTORYOBJECTID@@
-"RTN","C0CCCR0",196,0)
+"RTN","C0CCCR0",193,0)
;;
-"RTN","C0CCCR0",197,0)
+"RTN","C0CCCR0",194,0)
;;@@SOCIALHISTORYTYPETEXT@@
-"RTN","C0CCCR0",198,0)
+"RTN","C0CCCR0",195,0)
;;
-"RTN","C0CCCR0",199,0)
+"RTN","C0CCCR0",196,0)
;;
-"RTN","C0CCCR0",200,0)
+"RTN","C0CCCR0",197,0)
;;@@SOCIALHISTORYDESCRIPTIONTEXT@@
+"RTN","C0CCCR0",198,0)
+ ;;
+"RTN","C0CCCR0",199,0)
+ ;;
+"RTN","C0CCCR0",200,0)
+ ;;
"RTN","C0CCCR0",201,0)
- ;;
-"RTN","C0CCCR0",202,0)
- ;;
-"RTN","C0CCCR0",203,0)
- ;;
-"RTN","C0CCCR0",204,0)
;;@@SOCIALHISTORYSOURCACTORID@@
+"RTN","C0CCCR0",202,0)
+ ;;
+"RTN","C0CCCR0",203,0)
+ ;;
+"RTN","C0CCCR0",204,0)
+ ;;
"RTN","C0CCCR0",205,0)
- ;;
+ ;;
"RTN","C0CCCR0",206,0)
- ;;
-"RTN","C0CCCR0",207,0)
- ;;
-"RTN","C0CCCR0",208,0)
- ;;
-"RTN","C0CCCR0",209,0)
;;BB0005
-"RTN","C0CCCR0",210,0)
+"RTN","C0CCCR0",207,0)
;;
-"RTN","C0CCCR0",211,0)
+"RTN","C0CCCR0",208,0)
;;Ethnic Origin
-"RTN","C0CCCR0",212,0)
+"RTN","C0CCCR0",209,0)
;;
-"RTN","C0CCCR0",213,0)
+"RTN","C0CCCR0",210,0)
;;
-"RTN","C0CCCR0",214,0)
+"RTN","C0CCCR0",211,0)
;;Not Hispanic or Latino
+"RTN","C0CCCR0",212,0)
+ ;;
+"RTN","C0CCCR0",213,0)
+ ;;
+"RTN","C0CCCR0",214,0)
+ ;;
"RTN","C0CCCR0",215,0)
- ;;
+ ;;AA0001
"RTN","C0CCCR0",216,0)
- ;;
+ ;;
"RTN","C0CCCR0",217,0)
- ;;
+ ;;
"RTN","C0CCCR0",218,0)
- ;;AA0001
+ ;;
"RTN","C0CCCR0",219,0)
- ;;
+ ;;
"RTN","C0CCCR0",220,0)
- ;;
-"RTN","C0CCCR0",221,0)
- ;;
-"RTN","C0CCCR0",222,0)
- ;;
-"RTN","C0CCCR0",223,0)
;;BB0006
-"RTN","C0CCCR0",224,0)
+"RTN","C0CCCR0",221,0)
;;
-"RTN","C0CCCR0",225,0)
+"RTN","C0CCCR0",222,0)
;;Race
-"RTN","C0CCCR0",226,0)
+"RTN","C0CCCR0",223,0)
;;
-"RTN","C0CCCR0",227,0)
+"RTN","C0CCCR0",224,0)
;;
-"RTN","C0CCCR0",228,0)
+"RTN","C0CCCR0",225,0)
;;White
+"RTN","C0CCCR0",226,0)
+ ;;
+"RTN","C0CCCR0",227,0)
+ ;;
+"RTN","C0CCCR0",228,0)
+ ;;
"RTN","C0CCCR0",229,0)
- ;;
+ ;;AA0001
"RTN","C0CCCR0",230,0)
- ;;
+ ;;
"RTN","C0CCCR0",231,0)
- ;;
+ ;;
"RTN","C0CCCR0",232,0)
- ;;AA0001
+ ;;
"RTN","C0CCCR0",233,0)
- ;;
-"RTN","C0CCCR0",234,0)
- ;;
-"RTN","C0CCCR0",235,0)
- ;;
-"RTN","C0CCCR0",236,0)
;;
-"RTN","C0CCCR0",237,0)
+"RTN","C0CCCR0",234,0)
;;BB0007
-"RTN","C0CCCR0",238,0)
+"RTN","C0CCCR0",235,0)
;;
-"RTN","C0CCCR0",239,0)
+"RTN","C0CCCR0",236,0)
;;Occupation
-"RTN","C0CCCR0",240,0)
+"RTN","C0CCCR0",237,0)
;;
-"RTN","C0CCCR0",241,0)
+"RTN","C0CCCR0",238,0)
;;
-"RTN","C0CCCR0",242,0)
+"RTN","C0CCCR0",239,0)
;;Physician
+"RTN","C0CCCR0",240,0)
+ ;;
+"RTN","C0CCCR0",241,0)
+ ;;
+"RTN","C0CCCR0",242,0)
+ ;;
"RTN","C0CCCR0",243,0)
- ;;
+ ;;AA0001
"RTN","C0CCCR0",244,0)
- ;;
+ ;;
"RTN","C0CCCR0",245,0)
- ;;
+ ;;
"RTN","C0CCCR0",246,0)
- ;;AA0001
-"RTN","C0CCCR0",247,0)
- ;;
-"RTN","C0CCCR0",248,0)
- ;;
-"RTN","C0CCCR0",249,0)
;;
-"RTN","C0CCCR0",250,0)
+"RTN","C0CCCR0",247,0)
;;
-"RTN","C0CCCR0",251,0)
+"RTN","C0CCCR0",248,0)
;;
-"RTN","C0CCCR0",252,0)
+"RTN","C0CCCR0",249,0)
;;
-"RTN","C0CCCR0",253,0)
+"RTN","C0CCCR0",250,0)
;;@@ALERTOBJECTID@@
-"RTN","C0CCCR0",254,0)
+"RTN","C0CCCR0",251,0)
;;
-"RTN","C0CCCR0",255,0)
+"RTN","C0CCCR0",252,0)
;;@@ALERTDATETIME@@
-"RTN","C0CCCR0",256,0)
+"RTN","C0CCCR0",253,0)
;;
-"RTN","C0CCCR0",257,0)
+"RTN","C0CCCR0",254,0)
;;
-"RTN","C0CCCR0",258,0)
+"RTN","C0CCCR0",255,0)
;;@@ALERTTYPE@@
-"RTN","C0CCCR0",259,0)
+"RTN","C0CCCR0",256,0)
;;
-"RTN","C0CCCR0",260,0)
+"RTN","C0CCCR0",257,0)
;;
-"RTN","C0CCCR0",261,0)
+"RTN","C0CCCR0",258,0)
;;@@ALERTSTATUSTEXT@@
-"RTN","C0CCCR0",262,0)
+"RTN","C0CCCR0",259,0)
;;
-"RTN","C0CCCR0",263,0)
+"RTN","C0CCCR0",260,0)
;;
-"RTN","C0CCCR0",264,0)
+"RTN","C0CCCR0",261,0)
;;@@ALERTDESCRIPTIONTEXT@@
-"RTN","C0CCCR0",265,0)
+"RTN","C0CCCR0",262,0)
;;
-"RTN","C0CCCR0",266,0)
+"RTN","C0CCCR0",263,0)
;;@@ALERTCODEVALUE@@
-"RTN","C0CCCR0",267,0)
+"RTN","C0CCCR0",264,0)
;;@@ALERTCODESYSTEM@@
+"RTN","C0CCCR0",265,0)
+ ;;
+"RTN","C0CCCR0",266,0)
+ ;;
+"RTN","C0CCCR0",267,0)
+ ;;
"RTN","C0CCCR0",268,0)
- ;;
+ ;;
"RTN","C0CCCR0",269,0)
- ;;
+ ;;@@ALERTSOURCEID@@
"RTN","C0CCCR0",270,0)
- ;;
+ ;;
"RTN","C0CCCR0",271,0)
- ;;
+ ;;
"RTN","C0CCCR0",272,0)
- ;;@@ALERTSOURCEID@@
-"RTN","C0CCCR0",273,0)
- ;;
-"RTN","C0CCCR0",274,0)
- ;;
-"RTN","C0CCCR0",275,0)
;;
-"RTN","C0CCCR0",276,0)
+"RTN","C0CCCR0",273,0)
;;
-"RTN","C0CCCR0",277,0)
+"RTN","C0CCCR0",274,0)
;;
-"RTN","C0CCCR0",278,0)
+"RTN","C0CCCR0",275,0)
;;@@ALERTAGENTPRODUCTOBJECTID@@
-"RTN","C0CCCR0",279,0)
+"RTN","C0CCCR0",276,0)
;;
-"RTN","C0CCCR0",280,0)
+"RTN","C0CCCR0",277,0)
;;
-"RTN","C0CCCR0",281,0)
+"RTN","C0CCCR0",278,0)
;;@@ALERTSOURCEID@@
+"RTN","C0CCCR0",279,0)
+ ;;
+"RTN","C0CCCR0",280,0)
+ ;;
+"RTN","C0CCCR0",281,0)
+ ;;
"RTN","C0CCCR0",282,0)
- ;;
+ ;;
"RTN","C0CCCR0",283,0)
- ;;
-"RTN","C0CCCR0",284,0)
- ;;
-"RTN","C0CCCR0",285,0)
- ;;
-"RTN","C0CCCR0",286,0)
;;@@ALERTAGENTPRODUCTNAMETEXT@@
-"RTN","C0CCCR0",287,0)
+"RTN","C0CCCR0",284,0)
;;
-"RTN","C0CCCR0",288,0)
+"RTN","C0CCCR0",285,0)
;;@@ALERTAGENTPRODUCTCODEVALUE@@
-"RTN","C0CCCR0",289,0)
+"RTN","C0CCCR0",286,0)
;;@@ALERTAGENTPRODUCTCODESYSTEM@@
+"RTN","C0CCCR0",287,0)
+ ;;
+"RTN","C0CCCR0",288,0)
+ ;;
+"RTN","C0CCCR0",289,0)
+ ;;
"RTN","C0CCCR0",290,0)
- ;;
+ ;;
"RTN","C0CCCR0",291,0)
- ;;
-"RTN","C0CCCR0",292,0)
- ;;
-"RTN","C0CCCR0",293,0)
- ;;
-"RTN","C0CCCR0",294,0)
;;
-"RTN","C0CCCR0",295,0)
+"RTN","C0CCCR0",292,0)
;;
-"RTN","C0CCCR0",296,0)
+"RTN","C0CCCR0",293,0)
;;
-"RTN","C0CCCR0",297,0)
+"RTN","C0CCCR0",294,0)
;;
-"RTN","C0CCCR0",298,0)
+"RTN","C0CCCR0",295,0)
;;@@ALERTREACTIOINDESCRIPTIONTEXT@@
-"RTN","C0CCCR0",299,0)
+"RTN","C0CCCR0",296,0)
;;
-"RTN","C0CCCR0",300,0)
+"RTN","C0CCCR0",297,0)
;;@@ALERTREACTIONCODEVALUE@@
-"RTN","C0CCCR0",301,0)
+"RTN","C0CCCR0",298,0)
;;@@ALERTREACTIONCODESYSTEM@@
-"RTN","C0CCCR0",302,0)
+"RTN","C0CCCR0",299,0)
;;
-"RTN","C0CCCR0",303,0)
+"RTN","C0CCCR0",300,0)
;;
-"RTN","C0CCCR0",304,0)
+"RTN","C0CCCR0",301,0)
;;
-"RTN","C0CCCR0",305,0)
+"RTN","C0CCCR0",302,0)
;;
-"RTN","C0CCCR0",306,0)
+"RTN","C0CCCR0",303,0)
;;
-"RTN","C0CCCR0",307,0)
+"RTN","C0CCCR0",304,0)
;;
-"RTN","C0CCCR0",308,0)
+"RTN","C0CCCR0",305,0)
;;
-"RTN","C0CCCR0",309,0)
+"RTN","C0CCCR0",306,0)
;;@@MEDOBJECTID@@
-"RTN","C0CCCR0",310,0)
+"RTN","C0CCCR0",307,0)
;;
-"RTN","C0CCCR0",311,0)
+"RTN","C0CCCR0",308,0)
;;
-"RTN","C0CCCR0",312,0)
+"RTN","C0CCCR0",309,0)
;;@@MEDISSUEDATETXT@@
-"RTN","C0CCCR0",313,0)
+"RTN","C0CCCR0",310,0)
;;
-"RTN","C0CCCR0",314,0)
+"RTN","C0CCCR0",311,0)
;;@@MEDISSUEDATE@@
+"RTN","C0CCCR0",312,0)
+ ;;
+"RTN","C0CCCR0",313,0)
+ ;;
+"RTN","C0CCCR0",314,0)
+ ;;
"RTN","C0CCCR0",315,0)
- ;;
-"RTN","C0CCCR0",316,0)
- ;;
-"RTN","C0CCCR0",317,0)
- ;;
-"RTN","C0CCCR0",318,0)
;;@@MEDLASTFILLDATETXT@@
-"RTN","C0CCCR0",319,0)
+"RTN","C0CCCR0",316,0)
;;
-"RTN","C0CCCR0",320,0)
+"RTN","C0CCCR0",317,0)
;;@@MEDLASTFILLDATE@@
+"RTN","C0CCCR0",318,0)
+ ;;
+"RTN","C0CCCR0",319,0)
+ ;;
+"RTN","C0CCCR0",320,0)
+ ;;
"RTN","C0CCCR0",321,0)
- ;;
-"RTN","C0CCCR0",322,0)
- ;;
-"RTN","C0CCCR0",323,0)
- ;;
-"RTN","C0CCCR0",324,0)
;;@@MEDRXNOTXT@@
-"RTN","C0CCCR0",325,0)
+"RTN","C0CCCR0",322,0)
;;
-"RTN","C0CCCR0",326,0)
+"RTN","C0CCCR0",323,0)
;;@@MEDRXNO@@
-"RTN","C0CCCR0",327,0)
+"RTN","C0CCCR0",324,0)
;;
-"RTN","C0CCCR0",328,0)
+"RTN","C0CCCR0",325,0)
;;
-"RTN","C0CCCR0",329,0)
+"RTN","C0CCCR0",326,0)
;;@@MEDTYPETEXT@@
-"RTN","C0CCCR0",330,0)
+"RTN","C0CCCR0",327,0)
;;
-"RTN","C0CCCR0",331,0)
+"RTN","C0CCCR0",328,0)
;;
-"RTN","C0CCCR0",332,0)
+"RTN","C0CCCR0",329,0)
;;@@MEDDETAILUNADORNED@@
-"RTN","C0CCCR0",333,0)
+"RTN","C0CCCR0",330,0)
;;
-"RTN","C0CCCR0",334,0)
+"RTN","C0CCCR0",331,0)
;;
-"RTN","C0CCCR0",335,0)
+"RTN","C0CCCR0",332,0)
;;@@MEDSTATUSTEXT@@
+"RTN","C0CCCR0",333,0)
+ ;;
+"RTN","C0CCCR0",334,0)
+ ;;
+"RTN","C0CCCR0",335,0)
+ ;;
"RTN","C0CCCR0",336,0)
- ;;
-"RTN","C0CCCR0",337,0)
- ;;
-"RTN","C0CCCR0",338,0)
- ;;
-"RTN","C0CCCR0",339,0)
;;@@MEDSOURCEACTORID@@
-"RTN","C0CCCR0",340,0)
+"RTN","C0CCCR0",337,0)
;;
-"RTN","C0CCCR0",341,0)
+"RTN","C0CCCR0",338,0)
;;
-"RTN","C0CCCR0",342,0)
+"RTN","C0CCCR0",339,0)
;;
-"RTN","C0CCCR0",343,0)
+"RTN","C0CCCR0",340,0)
;;
-"RTN","C0CCCR0",344,0)
+"RTN","C0CCCR0",341,0)
;;@@MEDPRODUCTNAMETEXT@@
-"RTN","C0CCCR0",345,0)
+"RTN","C0CCCR0",342,0)
;;
-"RTN","C0CCCR0",346,0)
+"RTN","C0CCCR0",343,0)
;;@@MEDPRODUCTNAMECODEVALUE@@
-"RTN","C0CCCR0",347,0)
+"RTN","C0CCCR0",344,0)
;;@@MEDPRODUCTNAMECODINGINGSYSTEM@@
-"RTN","C0CCCR0",348,0)
+"RTN","C0CCCR0",345,0)
;;@@MEDPRODUCTNAMECODEVERSION@@
-"RTN","C0CCCR0",349,0)
+"RTN","C0CCCR0",346,0)
;;
-"RTN","C0CCCR0",350,0)
+"RTN","C0CCCR0",347,0)
;;
-"RTN","C0CCCR0",351,0)
+"RTN","C0CCCR0",348,0)
;;
-"RTN","C0CCCR0",352,0)
+"RTN","C0CCCR0",349,0)
;;@@MEDBRANDNAMETEXT@@
-"RTN","C0CCCR0",353,0)
+"RTN","C0CCCR0",350,0)
;;
-"RTN","C0CCCR0",354,0)
+"RTN","C0CCCR0",351,0)
;;
-"RTN","C0CCCR0",355,0)
+"RTN","C0CCCR0",352,0)
;;@@MEDSTRENGTHVALUE@@
-"RTN","C0CCCR0",356,0)
+"RTN","C0CCCR0",353,0)
;;
-"RTN","C0CCCR0",357,0)
+"RTN","C0CCCR0",354,0)
;;@@MEDSTRENGTHUNIT@@
-"RTN","C0CCCR0",358,0)
+"RTN","C0CCCR0",355,0)
;;
-"RTN","C0CCCR0",359,0)
+"RTN","C0CCCR0",356,0)
;;
-"RTN","C0CCCR0",360,0)
+"RTN","C0CCCR0",357,0)
;;
-"RTN","C0CCCR0",363,0)
+"RTN","C0CCCR0",360,0)
;;
-"RTN","C0CCCR0",364,0)
+"RTN","C0CCCR0",361,0)
;;@@MEDCONCVALUE@@
-"RTN","C0CCCR0",365,0)
+"RTN","C0CCCR0",362,0)
;;
-"RTN","C0CCCR0",366,0)
+"RTN","C0CCCR0",363,0)
;;@@MEDCONCUNIT@@
-"RTN","C0CCCR0",367,0)
+"RTN","C0CCCR0",364,0)
;;
-"RTN","C0CCCR0",368,0)
+"RTN","C0CCCR0",365,0)
;;
-"RTN","C0CCCR0",369,0)
+"RTN","C0CCCR0",366,0)
;;
-"RTN","C0CCCR0",370,0)
+"RTN","C0CCCR0",367,0)
;;
-"RTN","C0CCCR0",371,0)
+"RTN","C0CCCR0",368,0)
;;@@MEDQUANTITYVALUE@@
-"RTN","C0CCCR0",372,0)
+"RTN","C0CCCR0",369,0)
;;
-"RTN","C0CCCR0",373,0)
+"RTN","C0CCCR0",370,0)
;;@@MEDQUANTITYUNIT@@
-"RTN","C0CCCR0",374,0)
+"RTN","C0CCCR0",371,0)
;;
-"RTN","C0CCCR0",375,0)
+"RTN","C0CCCR0",372,0)
;;
-"RTN","C0CCCR0",376,0)
+"RTN","C0CCCR0",373,0)
;;
-"RTN","C0CCCR0",377,0)
+"RTN","C0CCCR0",374,0)
;;
-"RTN","C0CCCR0",378,0)
+"RTN","C0CCCR0",375,0)
;;
-"RTN","C0CCCR0",379,0)
+"RTN","C0CCCR0",376,0)
;;@@MEDDIRECTIONDESCRIPTIONTEXT@@
-"RTN","C0CCCR0",380,0)
+"RTN","C0CCCR0",377,0)
;;
-"RTN","C0CCCR0",381,0)
+"RTN","C0CCCR0",378,0)
;;
-"RTN","C0CCCR0",382,0)
+"RTN","C0CCCR0",379,0)
;;@@MEDDOSEINDICATOR@@
-"RTN","C0CCCR0",383,0)
+"RTN","C0CCCR0",380,0)
;;
-"RTN","C0CCCR0",384,0)
+"RTN","C0CCCR0",381,0)
;;
-"RTN","C0CCCR0",385,0)
+"RTN","C0CCCR0",382,0)
;;@@MEDDELIVERYMETHOD@@
-"RTN","C0CCCR0",386,0)
+"RTN","C0CCCR0",383,0)
;;
-"RTN","C0CCCR0",387,0)
+"RTN","C0CCCR0",384,0)
;;
-"RTN","C0CCCR0",388,0)
+"RTN","C0CCCR0",385,0)
;;@@MEDDOSEVALUE@@
-"RTN","C0CCCR0",389,0)
+"RTN","C0CCCR0",386,0)
;;
-"RTN","C0CCCR0",390,0)
+"RTN","C0CCCR0",387,0)
;;@@MEDDOSEUNIT@@
-"RTN","C0CCCR0",391,0)
+"RTN","C0CCCR0",388,0)
;;
-"RTN","C0CCCR0",392,0)
+"RTN","C0CCCR0",389,0)
;;
-"RTN","C0CCCR0",393,0)
+"RTN","C0CCCR0",390,0)
;;@@MEDRATEVALUE@@
-"RTN","C0CCCR0",394,0)
+"RTN","C0CCCR0",391,0)
;;
-"RTN","C0CCCR0",395,0)
+"RTN","C0CCCR0",392,0)
;;@@MEDRATEUNIT@@
-"RTN","C0CCCR0",396,0)
+"RTN","C0CCCR0",393,0)
;;
-"RTN","C0CCCR0",397,0)
+"RTN","C0CCCR0",394,0)
;;
-"RTN","C0CCCR0",398,0)
+"RTN","C0CCCR0",395,0)
;;
-"RTN","C0CCCR0",399,0)
+"RTN","C0CCCR0",396,0)
;;
-"RTN","C0CCCR0",400,0)
+"RTN","C0CCCR0",397,0)
;;@@MEDVEHICLETEXT@@
-"RTN","C0CCCR0",401,0)
+"RTN","C0CCCR0",398,0)
;;
-"RTN","C0CCCR0",402,0)
+"RTN","C0CCCR0",399,0)
;;
-"RTN","C0CCCR0",403,0)
+"RTN","C0CCCR0",400,0)
;;@@MEDDIRECTIONROUTETEXT@@
-"RTN","C0CCCR0",404,0)
+"RTN","C0CCCR0",401,0)
;;
-"RTN","C0CCCR0",405,0)
+"RTN","C0CCCR0",402,0)
;;
-"RTN","C0CCCR0",406,0)
+"RTN","C0CCCR0",403,0)
;;@@MEDFREQUENCYVALUE@@
-"RTN","C0CCCR0",407,0)
+"RTN","C0CCCR0",404,0)
;;
-"RTN","C0CCCR0",408,0)
+"RTN","C0CCCR0",405,0)
;;
-"RTN","C0CCCR0",409,0)
+"RTN","C0CCCR0",406,0)
;;@@MEDINTERVALVALUE@@
-"RTN","C0CCCR0",410,0)
+"RTN","C0CCCR0",407,0)
;;
-"RTN","C0CCCR0",411,0)
+"RTN","C0CCCR0",408,0)
;;@@MEDINTERVALUNIT@@
-"RTN","C0CCCR0",412,0)
+"RTN","C0CCCR0",409,0)
;;
-"RTN","C0CCCR0",413,0)
+"RTN","C0CCCR0",410,0)
;;
-"RTN","C0CCCR0",414,0)
+"RTN","C0CCCR0",411,0)
;;
-"RTN","C0CCCR0",415,0)
+"RTN","C0CCCR0",412,0)
;;@@MEDDURATIONVALUE@@
-"RTN","C0CCCR0",416,0)
+"RTN","C0CCCR0",413,0)
;;
-"RTN","C0CCCR0",417,0)
+"RTN","C0CCCR0",414,0)
;;@@MEDDURATIONUNIT@@
-"RTN","C0CCCR0",418,0)
+"RTN","C0CCCR0",415,0)
;;
-"RTN","C0CCCR0",419,0)
+"RTN","C0CCCR0",416,0)
;;
-"RTN","C0CCCR0",420,0)
+"RTN","C0CCCR0",417,0)
;;
-"RTN","C0CCCR0",421,0)
+"RTN","C0CCCR0",418,0)
;;
-"RTN","C0CCCR0",422,0)
+"RTN","C0CCCR0",419,0)
;;@@MEDPRNFLAG@@
-"RTN","C0CCCR0",423,0)
+"RTN","C0CCCR0",420,0)
;;
-"RTN","C0CCCR0",424,0)
+"RTN","C0CCCR0",421,0)
;;
-"RTN","C0CCCR0",425,0)
+"RTN","C0CCCR0",422,0)
;;@@MEDPROBLEMOBJECTID@@
-"RTN","C0CCCR0",426,0)
+"RTN","C0CCCR0",423,0)
;;
-"RTN","C0CCCR0",427,0)
+"RTN","C0CCCR0",424,0)
;;@@MEDPROBLEMTYPETXT@@
-"RTN","C0CCCR0",428,0)
+"RTN","C0CCCR0",425,0)
;;
-"RTN","C0CCCR0",429,0)
+"RTN","C0CCCR0",426,0)
;;
-"RTN","C0CCCR0",430,0)
+"RTN","C0CCCR0",427,0)
;;@@MEDPROBLEMDESCRIPTION@@
-"RTN","C0CCCR0",431,0)
+"RTN","C0CCCR0",428,0)
;;
-"RTN","C0CCCR0",432,0)
+"RTN","C0CCCR0",429,0)
;;@@MEDPROBLEMCODEVALUE@@
-"RTN","C0CCCR0",433,0)
+"RTN","C0CCCR0",430,0)
;;@@MEDPROBLEMCODINGSYSTEM@@
-"RTN","C0CCCR0",434,0)
+"RTN","C0CCCR0",431,0)
;;@@MEDPROBLEMCODINGVERSION@@
+"RTN","C0CCCR0",432,0)
+ ;;
+"RTN","C0CCCR0",433,0)
+ ;;
+"RTN","C0CCCR0",434,0)
+ ;;
"RTN","C0CCCR0",435,0)
- ;;
+ ;;
"RTN","C0CCCR0",436,0)
- ;;
-"RTN","C0CCCR0",437,0)
- ;;
-"RTN","C0CCCR0",438,0)
- ;;
-"RTN","C0CCCR0",439,0)
;;@@MEDPROBLEMSOURCEACTORID@@
-"RTN","C0CCCR0",440,0)
+"RTN","C0CCCR0",437,0)
;;
-"RTN","C0CCCR0",441,0)
+"RTN","C0CCCR0",438,0)
;;
-"RTN","C0CCCR0",442,0)
+"RTN","C0CCCR0",439,0)
;;
-"RTN","C0CCCR0",443,0)
+"RTN","C0CCCR0",440,0)
;;
-"RTN","C0CCCR0",444,0)
+"RTN","C0CCCR0",441,0)
;;
-"RTN","C0CCCR0",445,0)
+"RTN","C0CCCR0",442,0)
;;@@MEDSTOPINDICATOR@@
-"RTN","C0CCCR0",446,0)
+"RTN","C0CCCR0",443,0)
;;
-"RTN","C0CCCR0",447,0)
+"RTN","C0CCCR0",444,0)
;;@@MEDDIRSEQ@@
-"RTN","C0CCCR0",448,0)
+"RTN","C0CCCR0",445,0)
;;
-"RTN","C0CCCR0",449,0)
+"RTN","C0CCCR0",446,0)
;;@@MEDMULDIRMOD@@
-"RTN","C0CCCR0",450,0)
+"RTN","C0CCCR0",447,0)
;;
-"RTN","C0CCCR0",451,0)
+"RTN","C0CCCR0",448,0)
;;
-"RTN","C0CCCR0",452,0)
+"RTN","C0CCCR0",449,0)
;;
-"RTN","C0CCCR0",453,0)
+"RTN","C0CCCR0",450,0)
;;
-"RTN","C0CCCR0",454,0)
+"RTN","C0CCCR0",451,0)
;;
-"RTN","C0CCCR0",455,0)
+"RTN","C0CCCR0",452,0)
;;@@MEDPTINSTRUCTIONS@@
-"RTN","C0CCCR0",456,0)
+"RTN","C0CCCR0",453,0)
;;
-"RTN","C0CCCR0",457,0)
+"RTN","C0CCCR0",454,0)
;;
-"RTN","C0CCCR0",458,0)
+"RTN","C0CCCR0",455,0)
;;
-"RTN","C0CCCR0",459,0)
+"RTN","C0CCCR0",456,0)
;;@@MEDFULLFILLMENTINSTRUCTIONS@@
-"RTN","C0CCCR0",460,0)
+"RTN","C0CCCR0",457,0)
;;
-"RTN","C0CCCR0",461,0)
+"RTN","C0CCCR0",458,0)
;;
-"RTN","C0CCCR0",462,0)
+"RTN","C0CCCR0",459,0)
;;
-"RTN","C0CCCR0",463,0)
+"RTN","C0CCCR0",460,0)
;;@@MEDRFNO@@
-"RTN","C0CCCR0",464,0)
+"RTN","C0CCCR0",461,0)
;;
-"RTN","C0CCCR0",465,0)
+"RTN","C0CCCR0",462,0)
;;
-"RTN","C0CCCR0",466,0)
+"RTN","C0CCCR0",463,0)
;;
-"RTN","C0CCCR0",467,0)
+"RTN","C0CCCR0",464,0)
;;
-"RTN","C0CCCR0",468,0)
+"RTN","C0CCCR0",465,0)
;;
-"RTN","C0CCCR0",469,0)
+"RTN","C0CCCR0",466,0)
;;
-"RTN","C0CCCR0",470,0)
+"RTN","C0CCCR0",467,0)
;;@@VITALSIGNSDATAOBJECTID@@
-"RTN","C0CCCR0",471,0)
+"RTN","C0CCCR0",468,0)
;;
-"RTN","C0CCCR0",472,0)
+"RTN","C0CCCR0",469,0)
;;
-"RTN","C0CCCR0",473,0)
+"RTN","C0CCCR0",470,0)
;;@@VITALSIGNSDATETIMETYPETEXT@@
-"RTN","C0CCCR0",474,0)
+"RTN","C0CCCR0",471,0)
;;
-"RTN","C0CCCR0",475,0)
+"RTN","C0CCCR0",472,0)
;;@@VITALSIGNSEXACTDATETIME@@
+"RTN","C0CCCR0",473,0)
+ ;;
+"RTN","C0CCCR0",474,0)
+ ;;
+"RTN","C0CCCR0",475,0)
+ ;;@@VITALSIGNSDESCRIPTIONTEXT@@
"RTN","C0CCCR0",476,0)
- ;;
+ ;;
"RTN","C0CCCR0",477,0)
- ;;
+ ;;
"RTN","C0CCCR0",478,0)
- ;;@@VITALSIGNSDESCRIPTIONTEXT@@
+ ;;
"RTN","C0CCCR0",479,0)
- ;;
-"RTN","C0CCCR0",480,0)
- ;;
-"RTN","C0CCCR0",481,0)
- ;;
-"RTN","C0CCCR0",482,0)
;;@@VITALSIGNSSOURCEACTORID@@
+"RTN","C0CCCR0",480,0)
+ ;;
+"RTN","C0CCCR0",481,0)
+ ;;
+"RTN","C0CCCR0",482,0)
+ ;;
"RTN","C0CCCR0",483,0)
- ;;
-"RTN","C0CCCR0",484,0)
- ;;
-"RTN","C0CCCR0",485,0)
- ;;
-"RTN","C0CCCR0",486,0)
;;@@VITALSIGNSTESTOBJECTID@@
-"RTN","C0CCCR0",487,0)
+"RTN","C0CCCR0",484,0)
;;
-"RTN","C0CCCR0",488,0)
+"RTN","C0CCCR0",485,0)
;;@@VITALSIGNSTESTTYPETEXT@@
-"RTN","C0CCCR0",489,0)
+"RTN","C0CCCR0",486,0)
;;
-"RTN","C0CCCR0",490,0)
+"RTN","C0CCCR0",487,0)
;;
-"RTN","C0CCCR0",491,0)
+"RTN","C0CCCR0",488,0)
;;@@VITALSIGNSDESCRIPTIONTEXT@@
-"RTN","C0CCCR0",492,0)
+"RTN","C0CCCR0",489,0)
;;
-"RTN","C0CCCR0",493,0)
+"RTN","C0CCCR0",490,0)
;;@@VITALSIGNSDESCCODEVALUE@@
-"RTN","C0CCCR0",494,0)
+"RTN","C0CCCR0",491,0)
;;@@VITALSIGNSDESCCODINGSYSTEM@@
-"RTN","C0CCCR0",495,0)
+"RTN","C0CCCR0",492,0)
;;@@VITALSIGNSCODEVERSION@@
+"RTN","C0CCCR0",493,0)
+ ;;
+"RTN","C0CCCR0",494,0)
+ ;;
+"RTN","C0CCCR0",495,0)
+ ;;
"RTN","C0CCCR0",496,0)
- ;;
+ ;;
"RTN","C0CCCR0",497,0)
- ;;
-"RTN","C0CCCR0",498,0)
- ;;
-"RTN","C0CCCR0",499,0)
- ;;
-"RTN","C0CCCR0",500,0)
;;@@VITALSIGNSTESTSOURCEACTORID@@
+"RTN","C0CCCR0",498,0)
+ ;;
+"RTN","C0CCCR0",499,0)
+ ;;
+"RTN","C0CCCR0",500,0)
+ ;;
"RTN","C0CCCR0",501,0)
- ;;
-"RTN","C0CCCR0",502,0)
- ;;
-"RTN","C0CCCR0",503,0)
- ;;
-"RTN","C0CCCR0",504,0)
;;@@VITALSIGNSTESTRESULTVALUE@@
-"RTN","C0CCCR0",505,0)
+"RTN","C0CCCR0",502,0)
;;
-"RTN","C0CCCR0",506,0)
+"RTN","C0CCCR0",503,0)
;;@@VITALSIGNSTESTRESULTUNIT@@
+"RTN","C0CCCR0",504,0)
+ ;;
+"RTN","C0CCCR0",505,0)
+ ;;
+"RTN","C0CCCR0",506,0)
+ ;;
"RTN","C0CCCR0",507,0)
- ;;
+ ;;
"RTN","C0CCCR0",508,0)
- ;;
-"RTN","C0CCCR0",509,0)
- ;;
-"RTN","C0CCCR0",510,0)
- ;;
-"RTN","C0CCCR0",511,0)
;;
-"RTN","C0CCCR0",512,0)
+"RTN","C0CCCR0",509,0)
;;
-"RTN","C0CCCR0",513,0)
+"RTN","C0CCCR0",510,0)
;;
-"RTN","C0CCCR0",514,0)
+"RTN","C0CCCR0",511,0)
;;@@RESULTOBJECTID@@
+"RTN","C0CCCR0",512,0)
+ ;;
+"RTN","C0CCCR0",513,0)
+ ;;
+"RTN","C0CCCR0",514,0)
+ ;;Assessment Time
"RTN","C0CCCR0",515,0)
- ;;
+ ;;
"RTN","C0CCCR0",516,0)
- ;;
-"RTN","C0CCCR0",517,0)
- ;;Assessment Time
-"RTN","C0CCCR0",518,0)
- ;;
-"RTN","C0CCCR0",519,0)
;;@@RESULTASSESSMENTDATETIME@@
-"RTN","C0CCCR0",520,0)
+"RTN","C0CCCR0",517,0)
;;
-"RTN","C0CCCR0",521,0)
+"RTN","C0CCCR0",518,0)
;;
-"RTN","C0CCCR0",522,0)
+"RTN","C0CCCR0",519,0)
;;@@RESULTDESCRIPTIONTEXT@@
-"RTN","C0CCCR0",523,0)
+"RTN","C0CCCR0",520,0)
;;
-"RTN","C0CCCR0",524,0)
+"RTN","C0CCCR0",521,0)
;;@@RESULTCODE@@
-"RTN","C0CCCR0",525,0)
+"RTN","C0CCCR0",522,0)
;;@@RESULTCODINGSYSTEM@@
+"RTN","C0CCCR0",523,0)
+ ;;
+"RTN","C0CCCR0",524,0)
+ ;;
+"RTN","C0CCCR0",525,0)
+ ;;
"RTN","C0CCCR0",526,0)
- ;;
-"RTN","C0CCCR0",527,0)
- ;;
-"RTN","C0CCCR0",528,0)
- ;;
-"RTN","C0CCCR0",529,0)
;;@@RESULTSTATUS@@
+"RTN","C0CCCR0",527,0)
+ ;;
+"RTN","C0CCCR0",528,0)
+ ;;
+"RTN","C0CCCR0",529,0)
+ ;;
"RTN","C0CCCR0",530,0)
- ;;
-"RTN","C0CCCR0",531,0)
- ;;
-"RTN","C0CCCR0",532,0)
- ;;
-"RTN","C0CCCR0",533,0)
;;@@RESULTSOURCEACTORID@@
-"RTN","C0CCCR0",534,0)
+"RTN","C0CCCR0",531,0)
;;
-"RTN","C0CCCR0",535,0)
+"RTN","C0CCCR0",532,0)
;;
-"RTN","C0CCCR0",536,0)
+"RTN","C0CCCR0",533,0)
;;
-"RTN","C0CCCR0",537,0)
+"RTN","C0CCCR0",534,0)
;;@@RESULTTESTOBJECTID@@
-"RTN","C0CCCR0",538,0)
+"RTN","C0CCCR0",535,0)
;;
-"RTN","C0CCCR0",539,0)
+"RTN","C0CCCR0",536,0)
;;
-"RTN","C0CCCR0",540,0)
+"RTN","C0CCCR0",537,0)
;;Assessment Time
-"RTN","C0CCCR0",541,0)
+"RTN","C0CCCR0",538,0)
;;
-"RTN","C0CCCR0",542,0)
+"RTN","C0CCCR0",539,0)
;;@@RESULTTESTDATETIME@@
-"RTN","C0CCCR0",543,0)
+"RTN","C0CCCR0",540,0)
;;
-"RTN","C0CCCR0",544,0)
+"RTN","C0CCCR0",541,0)
;;
-"RTN","C0CCCR0",545,0)
+"RTN","C0CCCR0",542,0)
;;@@RESULTTESTDESCRIPTIONTEXT@@
-"RTN","C0CCCR0",546,0)
+"RTN","C0CCCR0",543,0)
;;
-"RTN","C0CCCR0",547,0)
+"RTN","C0CCCR0",544,0)
;;@@RESULTTESTCODEVALUE@@
-"RTN","C0CCCR0",548,0)
+"RTN","C0CCCR0",545,0)
;;@@RESULTTESTCODINGSYSTEM@@
+"RTN","C0CCCR0",546,0)
+ ;;
+"RTN","C0CCCR0",547,0)
+ ;;
+"RTN","C0CCCR0",548,0)
+ ;;
"RTN","C0CCCR0",549,0)
- ;;
-"RTN","C0CCCR0",550,0)
- ;;
-"RTN","C0CCCR0",551,0)
- ;;
-"RTN","C0CCCR0",552,0)
;;@@RESULTTESTSTATUSTEXT@@
+"RTN","C0CCCR0",550,0)
+ ;;
+"RTN","C0CCCR0",551,0)
+ ;;
+"RTN","C0CCCR0",552,0)
+ ;;
"RTN","C0CCCR0",553,0)
- ;;
-"RTN","C0CCCR0",554,0)
- ;;
-"RTN","C0CCCR0",555,0)
- ;;
-"RTN","C0CCCR0",556,0)
;;@@RESULTTESTSOURCEACTORID@@
-"RTN","C0CCCR0",557,0)
+"RTN","C0CCCR0",554,0)
;;
-"RTN","C0CCCR0",558,0)
+"RTN","C0CCCR0",555,0)
;;
-"RTN","C0CCCR0",559,0)
+"RTN","C0CCCR0",556,0)
;;
-"RTN","C0CCCR0",560,0)
+"RTN","C0CCCR0",557,0)
;;@@RESULTTESTVALUE@@
-"RTN","C0CCCR0",561,0)
+"RTN","C0CCCR0",558,0)
;;
-"RTN","C0CCCR0",562,0)
+"RTN","C0CCCR0",559,0)
;;@@RESULTTESTUNITS@@
-"RTN","C0CCCR0",563,0)
+"RTN","C0CCCR0",560,0)
;;
-"RTN","C0CCCR0",564,0)
+"RTN","C0CCCR0",561,0)
;;
-"RTN","C0CCCR0",565,0)
+"RTN","C0CCCR0",562,0)
;;
-"RTN","C0CCCR0",566,0)
+"RTN","C0CCCR0",563,0)
;;
-"RTN","C0CCCR0",567,0)
+"RTN","C0CCCR0",564,0)
;;
-"RTN","C0CCCR0",568,0)
+"RTN","C0CCCR0",565,0)
;;@@RESULTTESTNORMALDESCTEXT@@
+"RTN","C0CCCR0",566,0)
+ ;;
+"RTN","C0CCCR0",567,0)
+ ;;
+"RTN","C0CCCR0",568,0)
+ ;;
"RTN","C0CCCR0",569,0)
- ;;
-"RTN","C0CCCR0",570,0)
- ;;
-"RTN","C0CCCR0",571,0)
- ;;
-"RTN","C0CCCR0",572,0)
;;@@RESULTTESTNORMALSOURCEACTORID@@
-"RTN","C0CCCR0",573,0)
+"RTN","C0CCCR0",570,0)
;;
-"RTN","C0CCCR0",574,0)
+"RTN","C0CCCR0",571,0)
;;
-"RTN","C0CCCR0",575,0)
+"RTN","C0CCCR0",572,0)
;;
-"RTN","C0CCCR0",576,0)
+"RTN","C0CCCR0",573,0)
;;
-"RTN","C0CCCR0",577,0)
+"RTN","C0CCCR0",574,0)
;;
-"RTN","C0CCCR0",578,0)
+"RTN","C0CCCR0",575,0)
;;@@RESULTTESTFLAG@@
-"RTN","C0CCCR0",579,0)
+"RTN","C0CCCR0",576,0)
;;
-"RTN","C0CCCR0",580,0)
+"RTN","C0CCCR0",577,0)
;;
-"RTN","C0CCCR0",581,0)
+"RTN","C0CCCR0",578,0)
;;
-"RTN","C0CCCR0",582,0)
+"RTN","C0CCCR0",579,0)
;;
-"RTN","C0CCCR0",583,0)
+"RTN","C0CCCR0",580,0)
;;
-"RTN","C0CCCR0",584,0)
+"RTN","C0CCCR0",581,0)
;;
-"RTN","C0CCCR0",585,0)
+"RTN","C0CCCR0",582,0)
;;@@PROCOBJECTID@@
-"RTN","C0CCCR0",586,0)
+"RTN","C0CCCR0",583,0)
;;
-"RTN","C0CCCR0",587,0)
+"RTN","C0CCCR0",584,0)
;;
-"RTN","C0CCCR0",588,0)
+"RTN","C0CCCR0",585,0)
;;@@PROCDATETEXT@@
-"RTN","C0CCCR0",589,0)
+"RTN","C0CCCR0",586,0)
;;
-"RTN","C0CCCR0",590,0)
+"RTN","C0CCCR0",587,0)
;;@@PROCDATETIME@@
-"RTN","C0CCCR0",591,0)
+"RTN","C0CCCR0",588,0)
;;
-"RTN","C0CCCR0",592,0)
+"RTN","C0CCCR0",589,0)
;;
-"RTN","C0CCCR0",593,0)
+"RTN","C0CCCR0",590,0)
;;@@PROCDESCTEXT@@
-"RTN","C0CCCR0",594,0)
+"RTN","C0CCCR0",591,0)
;;
-"RTN","C0CCCR0",595,0)
+"RTN","C0CCCR0",592,0)
;;@@PROCDESCOBJATTR@@
-"RTN","C0CCCR0",596,0)
+"RTN","C0CCCR0",593,0)
;;
-"RTN","C0CCCR0",597,0)
+"RTN","C0CCCR0",594,0)
;;@@PROCDESCOBJATTRVAL@@
-"RTN","C0CCCR0",598,0)
+"RTN","C0CCCR0",595,0)
;;
-"RTN","C0CCCR0",599,0)
+"RTN","C0CCCR0",596,0)
;;@@PROCDESCOBJATTRCODE@@
-"RTN","C0CCCR0",600,0)
+"RTN","C0CCCR0",597,0)
;;@@PROCDESCOBJATTRCODESYS@@
-"RTN","C0CCCR0",601,0)
+"RTN","C0CCCR0",598,0)
;;
-"RTN","C0CCCR0",602,0)
+"RTN","C0CCCR0",599,0)
;;
-"RTN","C0CCCR0",603,0)
+"RTN","C0CCCR0",600,0)
;;
-"RTN","C0CCCR0",604,0)
+"RTN","C0CCCR0",601,0)
;;
-"RTN","C0CCCR0",605,0)
+"RTN","C0CCCR0",602,0)
;;@@PROCCODE@@
-"RTN","C0CCCR0",606,0)
+"RTN","C0CCCR0",603,0)
;;@@PROCCODESYS@@
-"RTN","C0CCCR0",607,0)
+"RTN","C0CCCR0",604,0)
;;
-"RTN","C0CCCR0",608,0)
+"RTN","C0CCCR0",605,0)
;;
-"RTN","C0CCCR0",609,0)
+"RTN","C0CCCR0",606,0)
;;
-"RTN","C0CCCR0",610,0)
+"RTN","C0CCCR0",607,0)
;;@@PROCSTATUS@@
-"RTN","C0CCCR0",611,0)
+"RTN","C0CCCR0",608,0)
;;
-"RTN","C0CCCR0",612,0)
+"RTN","C0CCCR0",609,0)
;;
-"RTN","C0CCCR0",613,0)
+"RTN","C0CCCR0",610,0)
;;
-"RTN","C0CCCR0",614,0)
+"RTN","C0CCCR0",611,0)
;;@@PROCACTOROBJID@@
+"RTN","C0CCCR0",612,0)
+ ;;
+"RTN","C0CCCR0",613,0)
+ ;;
+"RTN","C0CCCR0",614,0)
+ ;;
"RTN","C0CCCR0",615,0)
- ;;
-"RTN","C0CCCR0",616,0)
- ;;
-"RTN","C0CCCR0",617,0)
- ;;
-"RTN","C0CCCR0",618,0)
;;@@PROCLINKID@@
-"RTN","C0CCCR0",619,0)
+"RTN","C0CCCR0",616,0)
;;@@PROCLINKREL@@
-"RTN","C0CCCR0",620,0)
+"RTN","C0CCCR0",617,0)
;;
-"RTN","C0CCCR0",621,0)
+"RTN","C0CCCR0",618,0)
;;
-"RTN","C0CCCR0",622,0)
+"RTN","C0CCCR0",619,0)
;;
-"RTN","C0CCCR0",623,0)
+"RTN","C0CCCR0",620,0)
;;
-"RTN","C0CCCR0",624,0)
+"RTN","C0CCCR0",621,0)
;;
-"RTN","C0CCCR0",625,0)
+"RTN","C0CCCR0",622,0)
;;@@ENCOBJECTID@@
-"RTN","C0CCCR0",626,0)
+"RTN","C0CCCR0",623,0)
;;
-"RTN","C0CCCR0",627,0)
+"RTN","C0CCCR0",624,0)
;;@@ENCDATETIME@@
-"RTN","C0CCCR0",628,0)
+"RTN","C0CCCR0",625,0)
;;
-"RTN","C0CCCR0",629,0)
+"RTN","C0CCCR0",626,0)
;;
-"RTN","C0CCCR0",630,0)
+"RTN","C0CCCR0",627,0)
;;@@ENCTYPETXT@@
-"RTN","C0CCCR0",631,0)
+"RTN","C0CCCR0",628,0)
;;
-"RTN","C0CCCR0",632,0)
+"RTN","C0CCCR0",629,0)
;;@@ENCTYPECODE@@
-"RTN","C0CCCR0",633,0)
+"RTN","C0CCCR0",630,0)
;;@@ENCTYPECODESYS@@
+"RTN","C0CCCR0",631,0)
+ ;;
+"RTN","C0CCCR0",632,0)
+ ;;
+"RTN","C0CCCR0",633,0)
+ ;;
"RTN","C0CCCR0",634,0)
- ;;
-"RTN","C0CCCR0",635,0)
- ;;
-"RTN","C0CCCR0",636,0)
- ;;
-"RTN","C0CCCR0",637,0)
;;@@ENCDESCTXT@@
-"RTN","C0CCCR0",638,0)
+"RTN","C0CCCR0",635,0)
;;
-"RTN","C0CCCR0",639,0)
+"RTN","C0CCCR0",636,0)
;;@@ENCDESCCODE@@
-"RTN","C0CCCR0",640,0)
+"RTN","C0CCCR0",637,0)
;;@@ENCDESCCODESYS@@
-"RTN","C0CCCR0",641,0)
+"RTN","C0CCCR0",638,0)
;;
-"RTN","C0CCCR0",642,0)
+"RTN","C0CCCR0",639,0)
;;
-"RTN","C0CCCR0",643,0)
+"RTN","C0CCCR0",640,0)
;;
-"RTN","C0CCCR0",644,0)
+"RTN","C0CCCR0",641,0)
;;
-"RTN","C0CCCR0",645,0)
+"RTN","C0CCCR0",642,0)
;;@@ENCLOCACTORID@@
-"RTN","C0CCCR0",646,0)
+"RTN","C0CCCR0",643,0)
;;
-"RTN","C0CCCR0",647,0)
+"RTN","C0CCCR0",644,0)
;;
-"RTN","C0CCCR0",648,0)
+"RTN","C0CCCR0",645,0)
;;
-"RTN","C0CCCR0",649,0)
+"RTN","C0CCCR0",646,0)
;;
-"RTN","C0CCCR0",650,0)
+"RTN","C0CCCR0",647,0)
;;@@ENCPRVACTORID@@
-"RTN","C0CCCR0",651,0)
+"RTN","C0CCCR0",648,0)
;;
-"RTN","C0CCCR0",652,0)
+"RTN","C0CCCR0",649,0)
;;
-"RTN","C0CCCR0",653,0)
+"RTN","C0CCCR0",650,0)
;;
-"RTN","C0CCCR0",654,0)
+"RTN","C0CCCR0",651,0)
;;@@ENCINDTXT@@
-"RTN","C0CCCR0",655,0)
+"RTN","C0CCCR0",652,0)
;;
-"RTN","C0CCCR0",656,0)
+"RTN","C0CCCR0",653,0)
;;@@ENCINDCODE@@
-"RTN","C0CCCR0",657,0)
+"RTN","C0CCCR0",654,0)
;;@@ENCINDCODESYS@@
-"RTN","C0CCCR0",658,0)
+"RTN","C0CCCR0",655,0)
;;
-"RTN","C0CCCR0",659,0)
+"RTN","C0CCCR0",656,0)
;;
-"RTN","C0CCCR0",660,0)
+"RTN","C0CCCR0",657,0)
;;
-"RTN","C0CCCR0",661,0)
+"RTN","C0CCCR0",658,0)
;;
-"RTN","C0CCCR0",662,0)
+"RTN","C0CCCR0",659,0)
;;@@ENCACTORID@@
-"RTN","C0CCCR0",663,0)
+"RTN","C0CCCR0",660,0)
;;
-"RTN","C0CCCR0",664,0)
+"RTN","C0CCCR0",661,0)
;;
-"RTN","C0CCCR0",665,0)
+"RTN","C0CCCR0",662,0)
;;@@ENCCOMMENTID@@
-"RTN","C0CCCR0",666,0)
+"RTN","C0CCCR0",663,0)
;;
-"RTN","C0CCCR0",667,0)
+"RTN","C0CCCR0",664,0)
;;
-"RTN","C0CCCR0",668,0)
+"RTN","C0CCCR0",665,0)
;;
-"RTN","C0CCCR0",669,0)
+"RTN","C0CCCR0",666,0)
;;
-"RTN","C0CCCR0",670,0)
+"RTN","C0CCCR0",667,0)
;;AA0005
-"RTN","C0CCCR0",671,0)
+"RTN","C0CCCR0",668,0)
;;
-"RTN","C0CCCR0",672,0)
+"RTN","C0CCCR0",669,0)
;;Primary Provider
-"RTN","C0CCCR0",673,0)
+"RTN","C0CCCR0",670,0)
;;
-"RTN","C0CCCR0",674,0)
+"RTN","C0CCCR0",671,0)
;;
-"RTN","C0CCCR0",675,0)
+"RTN","C0CCCR0",672,0)
;;
-"RTN","C0CCCR0",676,0)
+"RTN","C0CCCR0",673,0)
;;
-"RTN","C0CCCR0",677,0)
+"RTN","C0CCCR0",674,0)
;;
-"RTN","C0CCCR0",678,0)
+"RTN","C0CCCR0",675,0)
;;
+"RTN","C0CCCR0",676,0)
+ ;;
+"RTN","C0CCCR0",677,0)
+ ;;@@ACTOROBJECTID@@
+"RTN","C0CCCR0",678,0)
+ ;;
"RTN","C0CCCR0",679,0)
- ;;
+ ;;
"RTN","C0CCCR0",680,0)
- ;;@@ACTOROBJECTID@@
+ ;;
"RTN","C0CCCR0",681,0)
- ;;
+ ;;@@ACTORGIVENNAME@@
"RTN","C0CCCR0",682,0)
- ;;
+ ;;@@ACTORMIDDLENAME@@
"RTN","C0CCCR0",683,0)
- ;;
+ ;;@@ACTORFAMILYNAME@@
"RTN","C0CCCR0",684,0)
- ;;@@ACTORGIVENNAME@@
+ ;;
"RTN","C0CCCR0",685,0)
- ;;@@ACTORMIDDLENAME@@
+ ;;
"RTN","C0CCCR0",686,0)
- ;;@@ACTORFAMILYNAME@@
-"RTN","C0CCCR0",687,0)
- ;;
-"RTN","C0CCCR0",688,0)
- ;;
-"RTN","C0CCCR0",689,0)
;;
-"RTN","C0CCCR0",690,0)
+"RTN","C0CCCR0",687,0)
;;@@ACTORDATEOFBIRTH@@
-"RTN","C0CCCR0",691,0)
+"RTN","C0CCCR0",688,0)
;;
-"RTN","C0CCCR0",692,0)
+"RTN","C0CCCR0",689,0)
;;
-"RTN","C0CCCR0",693,0)
+"RTN","C0CCCR0",690,0)
;;@@ACTORGENDER@@
-"RTN","C0CCCR0",694,0)
+"RTN","C0CCCR0",691,0)
;;
-"RTN","C0CCCR0",695,0)
+"RTN","C0CCCR0",692,0)
;;@@ACTORGENDERCODE@@
-"RTN","C0CCCR0",696,0)
+"RTN","C0CCCR0",693,0)
;;HL7 AdministrativeGender
-"RTN","C0CCCR0",697,0)
+"RTN","C0CCCR0",694,0)
;;
-"RTN","C0CCCR0",698,0)
+"RTN","C0CCCR0",695,0)
;;
-"RTN","C0CCCR0",699,0)
+"RTN","C0CCCR0",696,0)
;;
-"RTN","C0CCCR0",700,0)
+"RTN","C0CCCR0",697,0)
;;
-"RTN","C0CCCR0",701,0)
+"RTN","C0CCCR0",698,0)
;;
-"RTN","C0CCCR0",702,0)
+"RTN","C0CCCR0",699,0)
;;@@ACTORSSNTEXT@@
-"RTN","C0CCCR0",703,0)
+"RTN","C0CCCR0",700,0)
;;
-"RTN","C0CCCR0",704,0)
+"RTN","C0CCCR0",701,0)
;;@@ACTORSSN@@
-"RTN","C0CCCR0",705,0)
+"RTN","C0CCCR0",702,0)
;;
-"RTN","C0CCCR0",706,0)
+"RTN","C0CCCR0",703,0)
;;
-"RTN","C0CCCR0",707,0)
+"RTN","C0CCCR0",704,0)
;;@@ACTORSSNSOURCEID@@
-"RTN","C0CCCR0",708,0)
+"RTN","C0CCCR0",705,0)
;;
-"RTN","C0CCCR0",709,0)
+"RTN","C0CCCR0",706,0)
;;
-"RTN","C0CCCR0",710,0)
+"RTN","C0CCCR0",707,0)
;;
+"RTN","C0CCCR0",708,0)
+ ;;
+"RTN","C0CCCR0",709,0)
+ ;;
+"RTN","C0CCCR0",710,0)
+ ;;@@ACTORADDRESSTYPE@@
"RTN","C0CCCR0",711,0)
- ;;
+ ;;
"RTN","C0CCCR0",712,0)
- ;;
+ ;;@@ACTORADDRESSLINE1@@
"RTN","C0CCCR0",713,0)
- ;;@@ACTORADDRESSTYPE@@
-"RTN","C0CCCR0",714,0)
- ;;
-"RTN","C0CCCR0",715,0)
- ;;@@ACTORADDRESSLINE1@@
-"RTN","C0CCCR0",716,0)
;;@@ACTORADDRESSLINE2@@
-"RTN","C0CCCR0",717,0)
+"RTN","C0CCCR0",714,0)
;;@@ACTORADDRESSCITY@@
-"RTN","C0CCCR0",718,0)
+"RTN","C0CCCR0",715,0)
;;@@ACTORADDRESSSTATE@@
-"RTN","C0CCCR0",719,0)
+"RTN","C0CCCR0",716,0)
;;@@ACTORADDRESSZIPCODE@@
-"RTN","C0CCCR0",720,0)
+"RTN","C0CCCR0",717,0)
;;
-"RTN","C0CCCR0",721,0)
+"RTN","C0CCCR0",718,0)
;;
-"RTN","C0CCCR0",722,0)
+"RTN","C0CCCR0",719,0)
;;@@ACTORRESTEL@@
-"RTN","C0CCCR0",723,0)
+"RTN","C0CCCR0",720,0)
;;
-"RTN","C0CCCR0",724,0)
+"RTN","C0CCCR0",721,0)
;;@@ACTORRESTELTEXT@@
+"RTN","C0CCCR0",722,0)
+ ;;
+"RTN","C0CCCR0",723,0)
+ ;;
+"RTN","C0CCCR0",724,0)
+ ;;
"RTN","C0CCCR0",725,0)
- ;;
-"RTN","C0CCCR0",726,0)
- ;;
-"RTN","C0CCCR0",727,0)
- ;;
-"RTN","C0CCCR0",728,0)
;;@@ACTORWORKTEL@@
-"RTN","C0CCCR0",729,0)
+"RTN","C0CCCR0",726,0)
;;
-"RTN","C0CCCR0",730,0)
+"RTN","C0CCCR0",727,0)
;;@@ACTORWORKTELTEXT@@
+"RTN","C0CCCR0",728,0)
+ ;;
+"RTN","C0CCCR0",729,0)
+ ;;
+"RTN","C0CCCR0",730,0)
+ ;;
"RTN","C0CCCR0",731,0)
- ;;
-"RTN","C0CCCR0",732,0)
- ;;
-"RTN","C0CCCR0",733,0)
- ;;
-"RTN","C0CCCR0",734,0)
;;@@ACTORCELLTEL@@
-"RTN","C0CCCR0",735,0)
+"RTN","C0CCCR0",732,0)
;;
-"RTN","C0CCCR0",736,0)
+"RTN","C0CCCR0",733,0)
;;@@ACTORCELLTELTEXT@@
-"RTN","C0CCCR0",737,0)
+"RTN","C0CCCR0",734,0)
;;
-"RTN","C0CCCR0",738,0)
+"RTN","C0CCCR0",735,0)
;;
-"RTN","C0CCCR0",739,0)
+"RTN","C0CCCR0",736,0)
;;
-"RTN","C0CCCR0",740,0)
+"RTN","C0CCCR0",737,0)
;;@@ACTOREMAIL@@
-"RTN","C0CCCR0",741,0)
+"RTN","C0CCCR0",738,0)
;;
-"RTN","C0CCCR0",742,0)
+"RTN","C0CCCR0",739,0)
;;
-"RTN","C0CCCR0",743,0)
+"RTN","C0CCCR0",740,0)
;;
-"RTN","C0CCCR0",744,0)
+"RTN","C0CCCR0",741,0)
;;@@ACTORADDRESSSOURCEID@@
+"RTN","C0CCCR0",742,0)
+ ;;
+"RTN","C0CCCR0",743,0)
+ ;;
+"RTN","C0CCCR0",744,0)
+ ;;
"RTN","C0CCCR0",745,0)
- ;;
-"RTN","C0CCCR0",746,0)
- ;;
-"RTN","C0CCCR0",747,0)
- ;;
-"RTN","C0CCCR0",748,0)
;;
-"RTN","C0CCCR0",749,0)
+"RTN","C0CCCR0",746,0)
;;
-"RTN","C0CCCR0",750,0)
+"RTN","C0CCCR0",747,0)
;;
-"RTN","C0CCCR0",751,0)
+"RTN","C0CCCR0",748,0)
;;@@ACTOROBJECTID@@
-"RTN","C0CCCR0",752,0)
+"RTN","C0CCCR0",749,0)
;;
-"RTN","C0CCCR0",753,0)
+"RTN","C0CCCR0",750,0)
;;@@ACTORINFOSYSNAME@@
-"RTN","C0CCCR0",754,0)
+"RTN","C0CCCR0",751,0)
;;@@ACTORINFOSYSVER@@
-"RTN","C0CCCR0",755,0)
+"RTN","C0CCCR0",752,0)
;;
-"RTN","C0CCCR0",756,0)
+"RTN","C0CCCR0",753,0)
;;
-"RTN","C0CCCR0",757,0)
+"RTN","C0CCCR0",754,0)
;;
-"RTN","C0CCCR0",758,0)
+"RTN","C0CCCR0",755,0)
;;@@ACTORINFOSYSSOURCEID@@
+"RTN","C0CCCR0",756,0)
+ ;;
+"RTN","C0CCCR0",757,0)
+ ;;
+"RTN","C0CCCR0",758,0)
+ ;;
"RTN","C0CCCR0",759,0)
- ;;
-"RTN","C0CCCR0",760,0)
- ;;
-"RTN","C0CCCR0",761,0)
- ;;
-"RTN","C0CCCR0",762,0)
;;
-"RTN","C0CCCR0",763,0)
+"RTN","C0CCCR0",760,0)
;;
-"RTN","C0CCCR0",764,0)
+"RTN","C0CCCR0",761,0)
;;
-"RTN","C0CCCR0",765,0)
+"RTN","C0CCCR0",762,0)
;;AA0003
-"RTN","C0CCCR0",766,0)
+"RTN","C0CCCR0",763,0)
;;
-"RTN","C0CCCR0",767,0)
+"RTN","C0CCCR0",764,0)
;;
-"RTN","C0CCCR0",768,0)
+"RTN","C0CCCR0",765,0)
;;@@ACTORDISPLAYNAME@@
-"RTN","C0CCCR0",769,0)
+"RTN","C0CCCR0",766,0)
;;
-"RTN","C0CCCR0",770,0)
+"RTN","C0CCCR0",767,0)
;;
-"RTN","C0CCCR0",771,0)
+"RTN","C0CCCR0",768,0)
;;
-"RTN","C0CCCR0",772,0)
+"RTN","C0CCCR0",769,0)
;;@@ACTORRELATION@@
-"RTN","C0CCCR0",773,0)
+"RTN","C0CCCR0",770,0)
;;
-"RTN","C0CCCR0",774,0)
+"RTN","C0CCCR0",771,0)
;;
-"RTN","C0CCCR0",775,0)
+"RTN","C0CCCR0",772,0)
;;
-"RTN","C0CCCR0",776,0)
+"RTN","C0CCCR0",773,0)
;;@@ACTORRELATIONSOURCEID@@
+"RTN","C0CCCR0",774,0)
+ ;;
+"RTN","C0CCCR0",775,0)
+ ;;
+"RTN","C0CCCR0",776,0)
+ ;;
"RTN","C0CCCR0",777,0)
- ;;
-"RTN","C0CCCR0",778,0)
- ;;
-"RTN","C0CCCR0",779,0)
- ;;
-"RTN","C0CCCR0",780,0)
;;
-"RTN","C0CCCR0",781,0)
+"RTN","C0CCCR0",778,0)
;;
-"RTN","C0CCCR0",782,0)
+"RTN","C0CCCR0",779,0)
;;
-"RTN","C0CCCR0",783,0)
+"RTN","C0CCCR0",780,0)
;;@@ACTOROBJECTID@@
-"RTN","C0CCCR0",784,0)
+"RTN","C0CCCR0",781,0)
;;
-"RTN","C0CCCR0",785,0)
+"RTN","C0CCCR0",782,0)
;;
-"RTN","C0CCCR0",786,0)
+"RTN","C0CCCR0",783,0)
;;
-"RTN","C0CCCR0",787,0)
+"RTN","C0CCCR0",784,0)
;;@@ACTORGIVENNAME@@
-"RTN","C0CCCR0",788,0)
+"RTN","C0CCCR0",785,0)
;;@@ACTORMIDDLENAME@@
-"RTN","C0CCCR0",789,0)
+"RTN","C0CCCR0",786,0)
;;@@ACTORFAMILYNAME@@
-"RTN","C0CCCR0",790,0)
+"RTN","C0CCCR0",787,0)
;;@@ACTORTITLE@@
-"RTN","C0CCCR0",791,0)
+"RTN","C0CCCR0",788,0)
;;
-"RTN","C0CCCR0",792,0)
+"RTN","C0CCCR0",789,0)
;;
-"RTN","C0CCCR0",793,0)
+"RTN","C0CCCR0",790,0)
;;
-"RTN","C0CCCR0",794,0)
+"RTN","C0CCCR0",791,0)
;;
-"RTN","C0CCCR0",795,0)
+"RTN","C0CCCR0",792,0)
;;@@ACTORSPECIALITY@@
-"RTN","C0CCCR0",796,0)
+"RTN","C0CCCR0",793,0)
;;
+"RTN","C0CCCR0",794,0)
+ ;;
+"RTN","C0CCCR0",795,0)
+ ;;
+"RTN","C0CCCR0",796,0)
+ ;;@@ACTORADDRESSTYPE@@
"RTN","C0CCCR0",797,0)
- ;;
+ ;;
"RTN","C0CCCR0",798,0)
- ;;
+ ;;@@ACTORADDRESSLINE1@@
"RTN","C0CCCR0",799,0)
- ;;@@ACTORADDRESSTYPE@@
+ ;;@@ACTORADDRESSCITY@@
"RTN","C0CCCR0",800,0)
- ;;
+ ;;@@ACTORADDRESSSTATE@@
"RTN","C0CCCR0",801,0)
- ;;@@ACTORADDRESSLINE1@@
+ ;;@@ACTORPOSTALCODE@@
"RTN","C0CCCR0",802,0)
- ;;@@ACTORADDRESSCITY@@
+ ;;
"RTN","C0CCCR0",803,0)
- ;;@@ACTORADDRESSSTATE@@
+ ;;
"RTN","C0CCCR0",804,0)
- ;;@@ACTORPOSTALCODE@@
+ ;;@@ACTORTELEPHONE@@
"RTN","C0CCCR0",805,0)
- ;;
+ ;;
"RTN","C0CCCR0",806,0)
- ;;
+ ;;@@ACTORTELEPHONETYPE@@
"RTN","C0CCCR0",807,0)
- ;;@@ACTORTELEPHONE@@
+ ;;
"RTN","C0CCCR0",808,0)
- ;;
+ ;;
"RTN","C0CCCR0",809,0)
- ;;@@ACTORTELEPHONETYPE@@
-"RTN","C0CCCR0",810,0)
- ;;
-"RTN","C0CCCR0",811,0)
- ;;
-"RTN","C0CCCR0",812,0)
;;
-"RTN","C0CCCR0",813,0)
+"RTN","C0CCCR0",810,0)
;;@@ACTOREMAIL@@
-"RTN","C0CCCR0",814,0)
+"RTN","C0CCCR0",811,0)
;;
+"RTN","C0CCCR0",812,0)
+ ;;
+"RTN","C0CCCR0",813,0)
+ ;;
+"RTN","C0CCCR0",814,0)
+ ;;@@ACTORSOURCEID@@
"RTN","C0CCCR0",815,0)
- ;;
+ ;;
"RTN","C0CCCR0",816,0)
- ;;
+ ;;
"RTN","C0CCCR0",817,0)
- ;;@@ACTORSOURCEID@@
-"RTN","C0CCCR0",818,0)
- ;;
-"RTN","C0CCCR0",819,0)
- ;;
-"RTN","C0CCCR0",820,0)
;;
-"RTN","C0CCCR0",821,0)
+"RTN","C0CCCR0",818,0)
;;@@ACTORORGLINK@@
-"RTN","C0CCCR0",822,0)
+"RTN","C0CCCR0",819,0)
;;representedOrganization
-"RTN","C0CCCR0",823,0)
+"RTN","C0CCCR0",820,0)
;;
-"RTN","C0CCCR0",824,0)
+"RTN","C0CCCR0",821,0)
;;
-"RTN","C0CCCR0",825,0)
+"RTN","C0CCCR0",822,0)
;;
-"RTN","C0CCCR0",826,0)
+"RTN","C0CCCR0",823,0)
;;
-"RTN","C0CCCR0",827,0)
+"RTN","C0CCCR0",824,0)
;;
-"RTN","C0CCCR0",828,0)
+"RTN","C0CCCR0",825,0)
;;@@ACTOROBJECTID@@
-"RTN","C0CCCR0",829,0)
+"RTN","C0CCCR0",826,0)
;;
-"RTN","C0CCCR0",830,0)
+"RTN","C0CCCR0",827,0)
;;@@ORGANIZATIONNAME@@
-"RTN","C0CCCR0",831,0)
+"RTN","C0CCCR0",828,0)
;;
-"RTN","C0CCCR0",832,0)
+"RTN","C0CCCR0",829,0)
;;
-"RTN","C0CCCR0",833,0)
+"RTN","C0CCCR0",830,0)
;;
-"RTN","C0CCCR0",834,0)
+"RTN","C0CCCR0",831,0)
;;@@ACTORADDRESSTYPE@@
-"RTN","C0CCCR0",835,0)
+"RTN","C0CCCR0",832,0)
;;
-"RTN","C0CCCR0",836,0)
+"RTN","C0CCCR0",833,0)
;;@@ACTORADDRESSLINE1@@
-"RTN","C0CCCR0",837,0)
+"RTN","C0CCCR0",834,0)
;;@@ACTORADDRESSCITY@@
-"RTN","C0CCCR0",838,0)
+"RTN","C0CCCR0",835,0)
;;@@ACTORADDRESSSTATE@@
-"RTN","C0CCCR0",839,0)
+"RTN","C0CCCR0",836,0)
;;@@ACTORPOSTALCODE@@
-"RTN","C0CCCR0",840,0)
+"RTN","C0CCCR0",837,0)
;;
-"RTN","C0CCCR0",841,0)
+"RTN","C0CCCR0",838,0)
;;
-"RTN","C0CCCR0",842,0)
+"RTN","C0CCCR0",839,0)
;;@@ACTORTELEPHONE@@
-"RTN","C0CCCR0",843,0)
+"RTN","C0CCCR0",840,0)
;;
-"RTN","C0CCCR0",844,0)
+"RTN","C0CCCR0",841,0)
;;@@ACTORTELEPHONETYPE@@
-"RTN","C0CCCR0",845,0)
+"RTN","C0CCCR0",842,0)
;;
-"RTN","C0CCCR0",846,0)
+"RTN","C0CCCR0",843,0)
;;
+"RTN","C0CCCR0",844,0)
+ ;;
+"RTN","C0CCCR0",845,0)
+ ;;
+"RTN","C0CCCR0",846,0)
+ ;;@@ACTORSOURCEID@@
"RTN","C0CCCR0",847,0)
- ;;
+ ;;
"RTN","C0CCCR0",848,0)
- ;;
+ ;;
"RTN","C0CCCR0",849,0)
- ;;@@ACTORSOURCEID@@
+ ;;
"RTN","C0CCCR0",850,0)
- ;;
-"RTN","C0CCCR0",851,0)
- ;;
-"RTN","C0CCCR0",852,0)
- ;;
-"RTN","C0CCCR0",853,0)
;;
-"RTN","C0CCCR0",854,0)
+"RTN","C0CCCR0",851,0)
;;
-"RTN","C0CCCR0",855,0)
+"RTN","C0CCCR0",852,0)
;;
-"RTN","C0CCCR0",856,0)
+"RTN","C0CCCR0",853,0)
;;
-"RTN","C0CCCR0",857,0)
+"RTN","C0CCCR0",854,0)
;;S0001
-"RTN","C0CCCR0",858,0)
+"RTN","C0CCCR0",855,0)
;;2008-03-18T23:10:58Z
-"RTN","C0CCCR0",859,0)
+"RTN","C0CCCR0",856,0)
;;
-"RTN","C0CCCR0",860,0)
+"RTN","C0CCCR0",857,0)
;;AA0001
-"RTN","C0CCCR0",861,0)
+"RTN","C0CCCR0",858,0)
;;
-"RTN","C0CCCR0",862,0)
+"RTN","C0CCCR0",859,0)
;;
-"RTN","C0CCCR0",863,0)
+"RTN","C0CCCR0",860,0)
;;
-"RTN","C0CCCR0",864,0)
+"RTN","C0CCCR0",861,0)
;;
-"RTN","C0CCCR0",865,0)
+"RTN","C0CCCR0",862,0)
;;
-"RTN","C0CCCR0",866,0)
+"RTN","C0CCCR0",863,0)
;;
-"RTN","C0CCCR0",867,0)
+"RTN","C0CCCR0",864,0)
;;
-"RTN","C0CCCR0",868,0)
+"RTN","C0CCCR0",865,0)
;;
-"RTN","C0CCCR0",869,0)
+"RTN","C0CCCR0",866,0)
;;
-"RTN","C0CCCR0",870,0)
+"RTN","C0CCCR0",867,0)
;;
-"RTN","C0CCCR0",871,0)
+"RTN","C0CCCR0",868,0)
;;
-"RTN","C0CCCR0",872,0)
+"RTN","C0CCCR0",869,0)
;;YFveLLyo+75P7rSciv0/m1O6Ot4=
-"RTN","C0CCCR0",873,0)
+"RTN","C0CCCR0",870,0)
;;
-"RTN","C0CCCR0",874,0)
+"RTN","C0CCCR0",871,0)
;;
-"RTN","C0CCCR0",875,0)
+"RTN","C0CCCR0",872,0)
;;Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=
-"RTN","C0CCCR0",876,0)
+"RTN","C0CCCR0",873,0)
;;
-"RTN","C0CCCR0",877,0)
+"RTN","C0CCCR0",874,0)
;;
-"RTN","C0CCCR0",878,0)
+"RTN","C0CCCR0",875,0)
;;
-"RTN","C0CCCR0",879,0)
+"RTN","C0CCCR0",876,0)
;;meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=
-"RTN","C0CCCR0",880,0)
+"RTN","C0CCCR0",877,0)
;;AQAB
-"RTN","C0CCCR0",881,0)
+"RTN","C0CCCR0",878,0)
;;
-"RTN","C0CCCR0",882,0)
+"RTN","C0CCCR0",879,0)
;;
-"RTN","C0CCCR0",883,0)
+"RTN","C0CCCR0",880,0)
;;
-"RTN","C0CCCR0",884,0)
+"RTN","C0CCCR0",881,0)
;;
-"RTN","C0CCCR0",885,0)
+"RTN","C0CCCR0",882,0)
;;
-"RTN","C0CCCR0",886,0)
+"RTN","C0CCCR0",883,0)
;;
-"RTN","C0CCCR0",887,0)
+"RTN","C0CCCR0",884,0)
;;
-"RTN","C0CCCR0",888,0)
+"RTN","C0CCCR0",885,0)
;;
-"RTN","C0CCCR0",889,0)
+"RTN","C0CCCR0",886,0)
;;
-"RTN","C0CCCR0",890,0)
+"RTN","C0CCCR0",887,0)
;;@@COMMENTOBJECTID@@
-"RTN","C0CCCR0",891,0)
+"RTN","C0CCCR0",888,0)
;;
-"RTN","C0CCCR0",892,0)
+"RTN","C0CCCR0",889,0)
;;@@CMTDATETIME@@
-"RTN","C0CCCR0",893,0)
+"RTN","C0CCCR0",890,0)
;;
-"RTN","C0CCCR0",894,0)
+"RTN","C0CCCR0",891,0)
;;
-"RTN","C0CCCR0",895,0)
+"RTN","C0CCCR0",892,0)
;;
-"RTN","C0CCCR0",896,0)
+"RTN","C0CCCR0",893,0)
;;
-"RTN","C0CCCR0",897,0)
+"RTN","C0CCCR0",894,0)
;;
-"RTN","C0CCCR0",898,0)
+"RTN","C0CCCR0",895,0)
;;
-"RTN","C0CCCR0",899,0)
+"RTN","C0CCCR0",896,0)
;;
-"RTN","C0CCCR0",900,0)
+"RTN","C0CCCR0",897,0)
;;@@ACTORSOURCEID@@
-"RTN","C0CCCR0",901,0)
+"RTN","C0CCCR0",898,0)
;;
-"RTN","C0CCCR0",902,0)
+"RTN","C0CCCR0",899,0)
;;
-"RTN","C0CCCR0",903,0)
+"RTN","C0CCCR0",900,0)
;;
-"RTN","C0CCCR0",904,0)
+"RTN","C0CCCR0",901,0)
;;
-"RTN","C0CCCR0",905,0)
+"RTN","C0CCCR0",902,0)
;;
-"RTN","C0CCCR0",906,0)
+"RTN","C0CCCR0",903,0)
;
"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 .
"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.
-"RTN","C0CCMT",20,0)
- ;
-"RTN","C0CCMT",21,0)
W "NO ENTRY FROM TOP",!
+"RTN","C0CCMT",20,0)
+ Q
+"RTN","C0CCMT",21,0)
+ ;
"RTN","C0CCMT",22,0)
- Q
-"RTN","C0CCMT",23,0)
- ;
-"RTN","C0CCMT",24,0)
EXTRACT(NOTEXML,DFN,NOTEOUT) ; EXTRACT NOTES INTO XML TEMPLATE
-"RTN","C0CCMT",25,0)
+"RTN","C0CCMT",23,0)
; NOTEXML AND NOTEOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","C0CCMT",26,0)
+"RTN","C0CCMT",24,0)
;
-"RTN","C0CCMT",27,0)
+"RTN","C0CCMT",25,0)
D SETVARS^C0CPROC ; SET UP VARIABLES FOR PROCEDUCRES, ENCOUNTERS, AND NOTES
-"RTN","C0CCMT",28,0)
+"RTN","C0CCMT",26,0)
;I '$D(@C0CNTE) Q ; NO NOTES AVAILABLE
-"RTN","C0CCMT",29,0)
+"RTN","C0CCMT",27,0)
D MAP(NOTEXML,C0CNTE,NOTEOUT) ;MAP RESULTS FOR NOTES
-"RTN","C0CCMT",30,0)
+"RTN","C0CCMT",28,0)
Q
+"RTN","C0CCMT",29,0)
+ ;
+"RTN","C0CCMT",30,0)
+MAP(NOTEXML,C0CNTE,NOTEOUT) ; MAP PROCEDURES XML
"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)
+"RTN","C0CCMT",33,0)
K @ZTEMP
-"RTN","C0CCMT",36,0)
+"RTN","C0CCMT",34,0)
N ZBLD
-"RTN","C0CCMT",37,0)
+"RTN","C0CCMT",35,0)
S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"NOTEBLD")) ; BUILD LIST AREA
-"RTN","C0CCMT",38,0)
+"RTN","C0CCMT",36,0)
D QUEUE^C0CXPATH(ZBLD,NOTEXML,1,1) ; FIRST LINE
-"RTN","C0CCMT",39,0)
+"RTN","C0CCMT",37,0)
N ZINNER
-"RTN","C0CCMT",40,0)
+"RTN","C0CCMT",38,0)
D QUERY^C0CXPATH(NOTEXML,"//Comments/Comment","ZINNER") ;ONE NOTE
-"RTN","C0CCMT",41,0)
+"RTN","C0CCMT",39,0)
N ZTMP,ZVAR,ZI
-"RTN","C0CCMT",42,0)
+"RTN","C0CCMT",40,0)
S ZI=""
-"RTN","C0CCMT",43,0)
+"RTN","C0CCMT",41,0)
F S ZI=$O(@C0CNTE@(ZI)) Q:ZI="" D ;FOR EACH NOTE
-"RTN","C0CCMT",44,0)
+"RTN","C0CCMT",42,0)
. S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS NOTE XML
-"RTN","C0CCMT",45,0)
+"RTN","C0CCMT",43,0)
. S ZVAR=$NA(@C0CNTE@(ZI)) ;THIS NOTE VARIABLES
-"RTN","C0CCMT",46,0)
+"RTN","C0CCMT",44,0)
. D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
-"RTN","C0CCMT",47,0)
+"RTN","C0CCMT",45,0)
. N ZNOTE,ZN
-"RTN","C0CCMT",48,0)
+"RTN","C0CCMT",46,0)
. D CLEAN($NA(@C0CNTE@(ZI,"TEXT"))) ;REMOVE CONTROL CHARS AND XML RESERVED
-"RTN","C0CCMT",49,0)
+"RTN","C0CCMT",47,0)
. M ZNOTE=@C0CNTE@(ZI,"TEXT") ;THE NOTE TO ADD TO THE BUILD
-"RTN","C0CCMT",50,0)
+"RTN","C0CCMT",48,0)
. S ZNOTE(0)=$O(ZNOTE(""),-1) ;LENGTH OF THE NOTE
-"RTN","C0CCMT",51,0)
+"RTN","C0CCMT",49,0)
. D INSERT^C0CXPATH(ZTMP,"ZNOTE","//Comment/Description/Text")
-"RTN","C0CCMT",52,0)
+"RTN","C0CCMT",50,0)
. D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
-"RTN","C0CCMT",53,0)
+"RTN","C0CCMT",51,0)
D QUEUE^C0CXPATH(ZBLD,NOTEXML,@NOTEXML@(0),@NOTEXML@(0))
-"RTN","C0CCMT",54,0)
+"RTN","C0CCMT",52,0)
N ZZTMP
-"RTN","C0CCMT",55,0)
+"RTN","C0CCMT",53,0)
D BUILD^C0CXPATH(ZBLD,NOTEOUT) ;BUILD FINAL XML
-"RTN","C0CCMT",56,0)
+"RTN","C0CCMT",54,0)
K @ZTEMP,@ZBLD,@C0CNTE
-"RTN","C0CCMT",57,0)
+"RTN","C0CCMT",55,0)
Q
-"RTN","C0CCMT",58,0)
+"RTN","C0CCMT",56,0)
;
-"RTN","C0CCMT",59,0)
+"RTN","C0CCMT",57,0)
CLEAN(INARY) ; INARY IS PASSED BY NAME
-"RTN","C0CCMT",60,0)
+"RTN","C0CCMT",58,0)
; REMOVE CONTROL CHARACTERS AND XML RESERVED SYMBOLS FROM THE ARRAY
-"RTN","C0CCMT",61,0)
+"RTN","C0CCMT",59,0)
N ZI,ZJ S ZI=""
-"RTN","C0CCMT",62,0)
+"RTN","C0CCMT",60,0)
F S ZI=$O(@INARY@(ZI)) Q:ZI="" D ;
-"RTN","C0CCMT",63,0)
+"RTN","C0CCMT",61,0)
. S @INARY@(ZI)=$$CLEAN^C0CXPATH(@INARY@(ZI)) ; CONTROL CHARS
-"RTN","C0CCMT",64,0)
+"RTN","C0CCMT",62,0)
. S @INARY@(ZI)=$$SYMENC^MXMLUTL(@INARY@(ZI)) ; XML RESERVED SYMBOLS
-"RTN","C0CCMT",65,0)
+"RTN","C0CCMT",63,0)
Q
-"RTN","C0CCMT",66,0)
+"RTN","C0CCMT",64,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)
-ENTRY(DFN,STDT,ENDDT,TXT) ;BUILD TOTAL ARRAY OF ALL IEN'S FOR TIU NOTES
+ ; it under the terms of the GNU Affero General Public License as
"RTN","C0CCPT",7,0)
- ;DFN=PATIENT IEN
+ ; published by the Free Software Foundation, either version 3 of the
"RTN","C0CCPT",8,0)
- ;STDT=START DATE IN 3100101 FORMAT (VA YEAR YYYMMDD)
+ ; License, or (at your option) any later version.
"RTN","C0CCPT",9,0)
- ;ENDDT=END DATE IN 3100101 FORMAT
+ ;
"RTN","C0CCPT",10,0)
- ;TXT=INCLUDE TEXT FROM ENCOUNTER NOTE
+ ; This program is distributed in the hope that it will be useful,
"RTN","C0CCPT",11,0)
- ;THAT FALL INSIDE DATA RANGE. IF NO STDT OR ENDDT ASSUME
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0CCPT",12,0)
- ;ALL INCLUSIVE IN THAT DIRECTION
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
"RTN","C0CCPT",13,0)
- ;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN)
+ ; GNU Affero General Public License for more details.
"RTN","C0CCPT",14,0)
- ;BUILD INTO NOTE(Y)=""
+ ;
"RTN","C0CCPT",15,0)
- S U="^",X=""
+ ; You should have received a copy of the GNU Affero General Public License
"RTN","C0CCPT",16,0)
- F S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X="" D
+ ; along with this program. If not, see .
"RTN","C0CCPT",17,0)
- . S Y=""
+ ;
"RTN","C0CCPT",18,0)
- . F S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y="" D
+ENTRY(DFN,STDT,ENDDT,TXT) ;BUILD TOTAL ARRAY OF ALL IEN'S FOR TIU NOTES
"RTN","C0CCPT",19,0)
- .. S NOTE(Y)=""
+ ;DFN=PATIENT IEN
"RTN","C0CCPT",20,0)
- ;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE
+ ;STDT=START DATE IN 3100101 FORMAT (VA YEAR YYYMMDD)
"RTN","C0CCPT",21,0)
- ;GET DATE OF NOTE
+ ;ENDDT=END DATE IN 3100101 FORMAT
"RTN","C0CCPT",22,0)
- ;RUT 3120109 Changing DATE in FILMAN's FORMAT
+ ;TXT=INCLUDE TEXT FROM ENCOUNTER NOTE
"RTN","C0CCPT",23,0)
- ;;OHUM/RUT 3111228 Date Range for Notes
+ ;THAT FALL INSIDE DATA RANGE. IF NO STDT OR ENDDT ASSUME
"RTN","C0CCPT",24,0)
- ;S STDT=^TMP("C0CCCR","TIULIMIT") D NOW^%DTC S ENDDT=X
+ ;ALL INCLUSIVE IN THAT DIRECTION
"RTN","C0CCPT",25,0)
- N FLAGS1,FLAGS2
+ ;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN)
"RTN","C0CCPT",26,0)
- S FLAGS1=$P(^C0CPARM(1,2),"^",1) S STDT=$$HTOF^C0CVALID(FLAGS1)
+ ;BUILD INTO NOTE(Y)=""
"RTN","C0CCPT",27,0)
- S FLAGS2=$P(^C0CPARM(1,2),"^",2) S ENDDT=$$HTOF^C0CVALID(FLAGS2)
+ S U="^",X=""
"RTN","C0CCPT",28,0)
- ;S STDT=^TMP("C0CCCR","TIULIMIT"),ENDDT=^TMP("C0CCCR","TIUSTART")
+ F S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X="" D
"RTN","C0CCPT",29,0)
- ;;OHUM/RUT
+ . S Y=""
"RTN","C0CCPT",30,0)
- ;RUT
+ . F S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y="" D
"RTN","C0CCPT",31,0)
- S Z=""
+ .. S NOTE(Y)=""
"RTN","C0CCPT",32,0)
- F S Z=$O(NOTE(Z)) Q:Z="" D
+ ;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE
"RTN","C0CCPT",33,0)
- . S DT=$P(^TIU(8925,Z,0),U,7)
+ ;GET DATE OF NOTE
"RTN","C0CCPT",34,0)
- . I $G(STDT)]"" D
+ ;RUT 3120109 Changing DATE in FILMAN's FORMAT
"RTN","C0CCPT",35,0)
- .. I STDT>DT S NOTE(Z)="D" ;SET NOTE TO BE DELETED
+ ;OHUM/RUT 3111228 Date Range for Notes
"RTN","C0CCPT",36,0)
- . I $G(ENDDT)]"" D
+ ;S STDT=^TMP("C0CCCR","TIULIMIT") D NOW^%DTC S ENDDT=X
"RTN","C0CCPT",37,0)
- .. I ENDDT
DT S NOTE(Z)="D" ;SET NOTE TO BE DELETED
"RTN","C0CCPT",48,0)
- . Q:VISIT=""!(VISIT'>0)
+ . I $G(ENDDT)]"" D
"RTN","C0CCPT",49,0)
- . D ENCEVENT^PXKENC(VISIT,1)
+ .. I ENDDT
0)
+"RTN","C0CCPT",61,0)
+ . D ENCEVENT^PXKENC(VISIT,1)
+"RTN","C0CCPT",62,0)
+ . I '$D(^TMP("PXKENC",$J,VISIT,"VST",VISIT,0)) Q
+"RTN","C0CCPT",63,0)
+ . S IPRV=0 F S IPRV=$O(^TMP("PXKENC",$J,VISIT,"PRV",IPRV)) Q:'IPRV D
+"RTN","C0CCPT",64,0)
+ .. S X0=^TMP("PXKENC",$J,VISIT,"PRV",IPRV,0)
+"RTN","C0CCPT",65,0)
+ .. ;Q:$P(X0,U,4)'="P"
+"RTN","C0CCPT",66,0)
+ .. S CODE=$P(X0,U),NARR=$P($G(^VA(200,CODE,0)),U)
+"RTN","C0CCPT",67,0)
+ .. S PRIM=($P(X0,U,4)="P")
+"RTN","C0CCPT",68,0)
+ .. S ILST=ILST+1
+"RTN","C0CCPT",69,0)
+ .. S LST(ILST)="PRV"_U_CODE_"^^^"_NARR_"^"_PRIM
+"RTN","C0CCPT",70,0)
+ .. S VISIT(IEN,"PRV",ILST)=CODE_"^^^"_NARR_"^"_PRIM
+"RTN","C0CCPT",71,0)
+ . S IPOV=0 F S IPOV=$O(^TMP("PXKENC",$J,VISIT,"POV",IPOV)) Q:'IPOV D
+"RTN","C0CCPT",72,0)
+ .. S X0=^TMP("PXKENC",$J,VISIT,"POV",IPOV,0),X802=$G(^(802)),X811=$G(^(811))
+"RTN","C0CCPT",73,0)
+ .. S CODE=$P(X0,U)
+"RTN","C0CCPT",74,0)
+ .. S:CODE CODE=$P(^ICD9(CODE,0),U)
+"RTN","C0CCPT",75,0)
+ .. S CAT=$P(X802,U)
+"RTN","C0CCPT",76,0)
+ .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
+"RTN","C0CCPT",77,0)
+ .. S NARR=$P(X0,U,4)
+"RTN","C0CCPT",78,0)
+ .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
+"RTN","C0CCPT",79,0)
+ .. S PRIM=($P(X0,U,12)="P")
+"RTN","C0CCPT",80,0)
+ .. S PRV=$P(X12,U,4)
+"RTN","C0CCPT",81,0)
+ .. S ILST=ILST+1
+"RTN","C0CCPT",82,0)
+ .. S LST(ILST)="POV"_U_CODE_U_CAT_U_NARR_U_PRIM_U_PRV
+"RTN","C0CCPT",83,0)
+ .. S VISIT(IEN,"POV",ILST)=CODE_U_CAT_U_NARR_U_PRIM_U_PRV
+"RTN","C0CCPT",84,0)
+ . S ICPT=0 F S ICPT=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT)) Q:'ICPT D
+"RTN","C0CCPT",85,0)
+ .. S X0=^TMP("PXKENC",$J,VISIT,"CPT",ICPT,0),X802=$G(^(802)),X12=$G(^(12)),X811=$G(^(811))
+"RTN","C0CCPT",86,0)
+ .. ;S CODE=$P(X0,U)
+"RTN","C0CCPT",87,0)
+ .. S CODE=$O(^ICPT("B",$P(X0,U),0))
+"RTN","C0CCPT",88,0)
+ .. S:CODE CODE=$P(^ICPT(CODE,0),U)
+"RTN","C0CCPT",89,0)
+ .. S CAT=$P(X802,U)
+"RTN","C0CCPT",90,0)
+ .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
+"RTN","C0CCPT",91,0)
+ .. S NARR=$P(X0,U,4)
+"RTN","C0CCPT",92,0)
+ .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
+"RTN","C0CCPT",93,0)
+ .. S QTY=$P(X0,U,16)
+"RTN","C0CCPT",94,0)
+ .. S PRV=$P(X12,U,4)
"RTN","C0CCPT",95,0)
-GETNOTE(IEN) ;GET THE TEXT THAT GOES WITH VISIT
+ .. S MCNT=0,MIDX=0,MODS=""
"RTN","C0CCPT",96,0)
- ;EXTRACT NOTE TEXT FROM ^TIU(8925,IEN,"TEXT"
+ .. F S MIDX=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX)) Q:'MIDX D
"RTN","C0CCPT",97,0)
- Q:'$D(VISIT(IEN,"CPT"))
+ ... S MIEN=$G(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX,0))
"RTN","C0CCPT",98,0)
- S TXTCNT=0
+ ... I +MIEN S MCNT=MCNT+1,MODS=MODS_";/"_MIEN
"RTN","C0CCPT",99,0)
- F S TXTCNT=TXTCNT+1 Q:'$D(^TIU(8925,IEN,"TEXT",TXTCNT,0)) D
+ .. I +MCNT S MODS=MCNT_MODS
"RTN","C0CCPT",100,0)
- . S VISIT(IEN,"TEXT",TXTCNT)=^TIU(8925,IEN,"TEXT",TXTCNT,0)
+ .. S ILST=ILST+1
"RTN","C0CCPT",101,0)
+ .. S LST(ILST)="CPT"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS
+"RTN","C0CCPT",102,0)
+ .. S VISIT(IEN,"CPT",ILST)=CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS
+"RTN","C0CCPT",103,0)
+ . S VISIT(IEN,"DATE",0)=$P($P(^TIU(8925,IEN,0),U,7),".")
+"RTN","C0CCPT",104,0)
+ . S VISIT(IEN,"CLASS")=$$GET1^DIQ(8925,IEN_",",.04) ;GPL 5/21/10
+"RTN","C0CCPT",105,0)
+ . I $G(TXT)=1 D GETNOTE(IEN)
+"RTN","C0CCPT",106,0)
+ Q
+"RTN","C0CCPT",107,0)
+GETNOTE(IEN) ;GET THE TEXT THAT GOES WITH VISIT
+"RTN","C0CCPT",108,0)
+ ;EXTRACT NOTE TEXT FROM ^TIU(8925,IEN,"TEXT"
+"RTN","C0CCPT",109,0)
+ Q:'$D(VISIT(IEN,"CPT"))
+"RTN","C0CCPT",110,0)
+ S TXTCNT=0
+"RTN","C0CCPT",111,0)
+ F S TXTCNT=TXTCNT+1 Q:'$D(^TIU(8925,IEN,"TEXT",TXTCNT,0)) D
+"RTN","C0CCPT",112,0)
+ . S VISIT(IEN,"TEXT",TXTCNT)=^TIU(8925,IEN,"TEXT",TXTCNT,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 .
"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.
-"RTN","C0CDIC",19,0)
;
-"RTN","C0CDIC",20,0)
+"RTN","C0CDIC",18,0)
W "This is the CCR Dictionary Utility Library ",!
-"RTN","C0CDIC",21,0)
+"RTN","C0CDIC",19,0)
W !
-"RTN","C0CDIC",22,0)
+"RTN","C0CDIC",20,0)
Q
+"RTN","C0CDIC",21,0)
+ ;
+"RTN","C0CDIC",22,0)
+DIC2CSV ;OUTPUT THE CCR DICTIONARY TO A CSV FILE
"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)
+"RTN","C0CDIC",25,0)
S ZI=""
-"RTN","C0CDIC",28,0)
+"RTN","C0CDIC",26,0)
S G1=$NA(^TMP($J,"C0CCSV",1))
-"RTN","C0CDIC",29,0)
+"RTN","C0CDIC",27,0)
S G1A=$NA(@G1@("V"))
-"RTN","C0CDIC",30,0)
+"RTN","C0CDIC",28,0)
S G2=$NA(^TMP($J,"C0CCSV",2))
-"RTN","C0CDIC",31,0)
+"RTN","C0CDIC",29,0)
D GETN2^C0CRNF(G1,170) ; GET THE MATRIX
-"RTN","C0CDIC",32,0)
+"RTN","C0CDIC",30,0)
F S ZI=$O(@G1A@(ZI)) Q:ZI="" D ;FOR EACH ROW IN THE MATRIX
-"RTN","C0CDIC",33,0)
+"RTN","C0CDIC",31,0)
. I $G(@G1A@(ZI,"MAPPING METHOD",1))'="" D ;
-"RTN","C0CDIC",34,0)
+"RTN","C0CDIC",32,0)
. . W @G1A@(ZI,"MAPPING METHOD",1),!
-"RTN","C0CDIC",35,0)
+"RTN","C0CDIC",33,0)
. . ;K @G1A@(ZI,"MAPPING METHOD")
-"RTN","C0CDIC",36,0)
+"RTN","C0CDIC",34,0)
. ;W !,ZI,$G(@G1A@(ZI,"MAPPING METHOD",1))
-"RTN","C0CDIC",37,0)
+"RTN","C0CDIC",35,0)
D RNF2CSV^C0CRNF(G2,G1,"VN") ; PREPARE THE CVS FILE
-"RTN","C0CDIC",38,0)
+"RTN","C0CDIC",36,0)
K @G1
-"RTN","C0CDIC",39,0)
+"RTN","C0CDIC",37,0)
D FILEOUT^C0CRNF(G2,"FILE_"_170_".csv")
-"RTN","C0CDIC",40,0)
+"RTN","C0CDIC",38,0)
K @G2
+"RTN","C0CDIC",39,0)
+ Q
+"RTN","C0CDIC",40,0)
+ ;
"RTN","C0CDIC",41,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)
+"RTN","C0CDIC",42,0)
; and return them in C0CVARS, which is passed by name
-"RTN","C0CDIC",45,0)
+"RTN","C0CDIC",43,0)
; FIRST PIECE OF C0CVARS(x) IS THE VARIABLE NAME, SECOND PIECE
-"RTN","C0CDIC",46,0)
+"RTN","C0CDIC",44,0)
; IS THE LINE NUMBER OF THE VARIABLE IN THE TEMPLATE
-"RTN","C0CDIC",47,0)
+"RTN","C0CDIC",45,0)
; C0CT IS RETURNED AS THE CCR TEMPLATE
-"RTN","C0CDIC",48,0)
+"RTN","C0CDIC",46,0)
N C0CTVARS ; ARRAY FOR THE TEMPLATE AND ARRAY FOR THE VARS
-"RTN","C0CDIC",49,0)
+"RTN","C0CDIC",47,0)
D LOAD^GPLCCR0(C0CT) ; LOAD THE CCR TEMPLATE
-"RTN","C0CDIC",50,0)
+"RTN","C0CDIC",48,0)
D XVARS^GPLXPATH("C0CTVARS",C0CT) ; PULL OUT THE VARS
-"RTN","C0CDIC",51,0)
+"RTN","C0CDIC",49,0)
N C0CI,C0CX
-"RTN","C0CDIC",52,0)
+"RTN","C0CDIC",50,0)
S @C0CVARS@(0)=C0CTVARS(0) ; SAME COUNT
-"RTN","C0CDIC",53,0)
+"RTN","C0CDIC",51,0)
F C0CI=1:1:C0CTVARS(0) D ; FOR EVERY LINE IN THE ARRAY
-"RTN","C0CDIC",54,0)
+"RTN","C0CDIC",52,0)
. S C0CX=C0CTVARS(C0CI) ; THE VARIABLE - 3 PIECES, FIRST ONE NULL
-"RTN","C0CDIC",55,0)
+"RTN","C0CDIC",53,0)
. S @C0CVARS@(C0CI)=$P(C0CX,"^",2)_"^"_$P(C0CX,"^",3) ; VAR NAME^LINE NUMBER
-"RTN","C0CDIC",56,0)
+"RTN","C0CDIC",54,0)
;D PARY^GPLXPATH("C0CVARS")
+"RTN","C0CDIC",55,0)
+ Q
+"RTN","C0CDIC",56,0)
+ ;
"RTN","C0CDIC",57,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)
+"RTN","C0CDIC",58,0)
; AND THE XPATH TO THE VARIABLES INTO C0CPVARS
-"RTN","C0CDIC",61,0)
+"RTN","C0CDIC",59,0)
; BY INDEXING THE TEMPLATE C0CT AND MATCHING THE XPATH TO THE VARIABLE
-"RTN","C0CDIC",62,0)
+"RTN","C0CDIC",60,0)
; BOTH ARE PASSED BY NAME
-"RTN","C0CDIC",63,0)
+"RTN","C0CDIC",61,0)
; C0CPVARS(x) IS VAR^LINENUM^XPATH SORTED BY LINENUM
-"RTN","C0CDIC",64,0)
+"RTN","C0CDIC",62,0)
; C0CPVARS(0) IS NUMBER OF VARIABLES
-"RTN","C0CDIC",65,0)
+"RTN","C0CDIC",63,0)
; C0CPT(0) IS NUMBER OF LINES IN THE TEMPLATE
-"RTN","C0CDIC",66,0)
+"RTN","C0CDIC",64,0)
D GVARS(C0CPVARS,C0CPT) ; GET THE VARIABLES AND LINE NUMBERS
-"RTN","C0CDIC",67,0)
+"RTN","C0CDIC",65,0)
;N C0CTVARS ; HASH TABLE FOR VARIABLE BY LINE NUMBER
-"RTN","C0CDIC",68,0)
+"RTN","C0CDIC",66,0)
D HASHV ; PUT THE VARIABLES IN A LINE NUMBER HASH FOR MATCHING TO XPATHS
-"RTN","C0CDIC",69,0)
+"RTN","C0CDIC",67,0)
; NOW GO GET THE XPATH INDEXES
-"RTN","C0CDIC",70,0)
+"RTN","C0CDIC",68,0)
D INDEX^GPLXPATH(C0CPT) ; ADD THE XPATH INDEXES TO THE TEMPLATE ARRAY
-"RTN","C0CDIC",71,0)
+"RTN","C0CDIC",69,0)
S C0CI="" ; GOING TO LOOP THROUGH THE WHOLE ARRAY LOOKING AT XPATHS
-"RTN","C0CDIC",72,0)
+"RTN","C0CDIC",70,0)
F S C0CI=$O(@C0CPT@(C0CI)) Q:C0CI="" D ; VISIT EVERY LINE
-"RTN","C0CDIC",73,0)
+"RTN","C0CDIC",71,0)
. I +C0CI'=0 Q ; SKIP EVERYTHING BUT THE XPATH INDEX
-"RTN","C0CDIC",74,0)
+"RTN","C0CDIC",72,0)
. I C0CI=0 Q ; SKIP THE ZERO NODE
-"RTN","C0CDIC",75,0)
+"RTN","C0CDIC",73,0)
. S C0CX=@C0CPT@(C0CI) ; PULL OUT THE LINE NUMBERS X^Y
-"RTN","C0CDIC",76,0)
+"RTN","C0CDIC",74,0)
. S C0CY=$P(C0CX,"^",1) ; STARTING LINE NUMBER
-"RTN","C0CDIC",77,0)
+"RTN","C0CDIC",75,0)
. S C0CZ=$P(C0CX,"^",2) ; ENDING LINE NUMBER
-"RTN","C0CDIC",78,0)
+"RTN","C0CDIC",76,0)
. I C0CY=C0CZ D ; THIS IS AN XPATH END NODE, HAS A VARIABLE (WE HOPE)
-"RTN","C0CDIC",79,0)
+"RTN","C0CDIC",77,0)
. . ; W "FOUND ",C0CI,!
-"RTN","C0CDIC",80,0)
+"RTN","C0CDIC",78,0)
. . I $D(C0CTVARS(C0CY)) D ; IF THERE IS A VARIABLE THERE
-"RTN","C0CDIC",81,0)
+"RTN","C0CDIC",79,0)
. . . S $P(C0CTVARS(C0CY),"^",3)=C0CI ; INSERT THE XPATH FOR THE VAR
-"RTN","C0CDIC",82,0)
+"RTN","C0CDIC",80,0)
D SORTV ; SORT THE ARRAY BY LINE NUMBER
+"RTN","C0CDIC",81,0)
+ Q
+"RTN","C0CDIC",82,0)
+ ;
"RTN","C0CDIC",83,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)
+"RTN","C0CDIC",84,0)
;N C0CI,C0CTVARS,C0CX,C0CY
-"RTN","C0CDIC",87,0)
+"RTN","C0CDIC",85,0)
F C0CI=1:1:@C0CPVARS@(0) D ; FOR THE ENTIRE ARRAY
-"RTN","C0CDIC",88,0)
+"RTN","C0CDIC",86,0)
. S C0CX=$P(@C0CPVARS@(C0CI),"^",2) ; LINE NUMBER
-"RTN","C0CDIC",89,0)
+"RTN","C0CDIC",87,0)
. S C0CY=$P(@C0CPVARS@(C0CI),"^",1) ; VARIABLE NAME
-"RTN","C0CDIC",90,0)
+"RTN","C0CDIC",88,0)
. S C0CTVARS(C0CX)=C0CY ; BUILD HASH OF VARIABLES BY LINE NUMBER
+"RTN","C0CDIC",89,0)
+ Q
+"RTN","C0CDIC",90,0)
+ ;
"RTN","C0CDIC",91,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)
+"RTN","C0CDIC",92,0)
;N C0CV2 ; SCRACTH SPACE FOR BUILDING SORTED ARRAY
-"RTN","C0CDIC",95,0)
+"RTN","C0CDIC",93,0)
S C0CI="" ;
-"RTN","C0CDIC",96,0)
+"RTN","C0CDIC",94,0)
F S C0CI=$O(C0CTVARS(C0CI)) Q:C0CI="" D ; BY LINE NUMBER
-"RTN","C0CDIC",97,0)
+"RTN","C0CDIC",95,0)
. S C0CX=C0CTVARS(C0CI) ;VARIABLE NAME
-"RTN","C0CDIC",98,0)
+"RTN","C0CDIC",96,0)
. S $P(C0CX,"^",2)=C0CI ; LINE NUMBER IS SECOND PIECE
-"RTN","C0CDIC",99,0)
+"RTN","C0CDIC",97,0)
. D PUSH^GPLXPATH("C0C2",C0CX) ; PUT ONTO ARRAY
-"RTN","C0CDIC",100,0)
+"RTN","C0CDIC",98,0)
K @C0CPVARS
-"RTN","C0CDIC",101,0)
+"RTN","C0CDIC",99,0)
M @C0CPVARS=C0C2
+"RTN","C0CDIC",100,0)
+ Q
+"RTN","C0CDIC",101,0)
+ ;
"RTN","C0CDIC",102,0)
- Q
-"RTN","C0CDIC",103,0)
- ;
-"RTN","C0CDIC",104,0)
LOAD ; LOAD VARIABLE NAMES AND XPATH IN ^C0CDIC(170
-"RTN","C0CDIC",105,0)
+"RTN","C0CDIC",103,0)
; INITIAL LOAD OF THE CCR DICTIONARY
-"RTN","C0CDIC",106,0)
+"RTN","C0CDIC",104,0)
;
-"RTN","C0CDIC",107,0)
+"RTN","C0CDIC",105,0)
N C0CDIC,C0CARY,C0CXML,C0CFDA,C0CI
-"RTN","C0CDIC",108,0)
+"RTN","C0CDIC",106,0)
S C0CDIC="^C0CDIC(170," ; ROOT OF THE CCR DICTIONARY
-"RTN","C0CDIC",109,0)
+"RTN","C0CDIC",107,0)
D GXPATH("C0CARY","C0CXML") ; FETCH THE VARIABLES AND XPATH INTO C0CARY
-"RTN","C0CDIC",110,0)
+"RTN","C0CDIC",108,0)
; C0CXML WILL CONTAIN THE TEMPLATE - NOT NEEDED FOR LOAD
-"RTN","C0CDIC",111,0)
+"RTN","C0CDIC",109,0)
D PARY^GPLXPATH("C0CARY") ;TEST
-"RTN","C0CDIC",112,0)
+"RTN","C0CDIC",110,0)
F C0CI=1:1:C0CARY(0) D ; LOAD EACH VARIABLE
-"RTN","C0CDIC",113,0)
+"RTN","C0CDIC",111,0)
. S C0CFDA(170,"+"_C0CI_",",.01)=$P(C0CARY(C0CI),"^",1) ; VAR NAME
-"RTN","C0CDIC",114,0)
+"RTN","C0CDIC",112,0)
. S C0CFDA(170,"+"_C0CI_",",2)=$P(C0CARY(C0CI),"^",3) ; XPATH
-"RTN","C0CDIC",115,0)
+"RTN","C0CDIC",113,0)
. D UPDATE^DIE("","C0CFDA")
-"RTN","C0CDIC",116,0)
+"RTN","C0CDIC",114,0)
. I $D(^TMP("DIERR",$J)) U $P BREAK
-"RTN","C0CDIC",117,0)
+"RTN","C0CDIC",115,0)
. W "LOADING:",C0CI," ",C0CARY(C0CI),!
-"RTN","C0CDIC",118,0)
+"RTN","C0CDIC",116,0)
Q
+"RTN","C0CDIC",117,0)
+ ;
+"RTN","C0CDIC",118,0)
+INIT ; INITIALIZE CCR DICTIONARY BASED ON VARIABLE NAMES
"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)
+"RTN","C0CDIC",121,0)
; THIS IS WHAT WILL BE IN C0CA FOR EACH DICTIONARY ENTRY
-"RTN","C0CDIC",124,0)
+"RTN","C0CDIC",122,0)
;G1("CODING")="170^8"
-"RTN","C0CDIC",125,0)
+"RTN","C0CDIC",123,0)
;G1("DATA ELEMENT")="170^7"
-"RTN","C0CDIC",126,0)
+"RTN","C0CDIC",124,0)
;G1("DESCRIPTION")="170^3"
-"RTN","C0CDIC",127,0)
+"RTN","C0CDIC",125,0)
;G1("ID")="170^1"
-"RTN","C0CDIC",128,0)
+"RTN","C0CDIC",126,0)
;G1("M","170^8","CODING")="170.08^.01"
-"RTN","C0CDIC",129,0)
+"RTN","C0CDIC",127,0)
;G1("MAPPING METHOD")="170.08^1"
-"RTN","C0CDIC",130,0)
+"RTN","C0CDIC",128,0)
;G1("SECTION")="170^10"
-"RTN","C0CDIC",131,0)
+"RTN","C0CDIC",129,0)
;G1("SOURCE")="170^4"
-"RTN","C0CDIC",132,0)
+"RTN","C0CDIC",130,0)
;G1("STATUS")="170^9"
-"RTN","C0CDIC",133,0)
+"RTN","C0CDIC",131,0)
;G1("TYPE")="170^6"
-"RTN","C0CDIC",134,0)
+"RTN","C0CDIC",132,0)
;G1("VARIABLE")="170^.01"
-"RTN","C0CDIC",135,0)
+"RTN","C0CDIC",133,0)
;G1("XPATH")="170^2"
-"RTN","C0CDIC",136,0)
+"RTN","C0CDIC",134,0)
;
-"RTN","C0CDIC",137,0)
+"RTN","C0CDIC",135,0)
N C0CZA,C0CZX,C0CN,C0CSTAT
-"RTN","C0CDIC",138,0)
+"RTN","C0CDIC",136,0)
S C0CZX=0
-"RTN","C0CDIC",139,0)
+"RTN","C0CDIC",137,0)
S C0CSTAT=0 ; INIT STATUS SET FLAG
-"RTN","C0CDIC",140,0)
+"RTN","C0CDIC",138,0)
F S C0CZX=$O(^C0CDIC(170,C0CZX)) Q:+C0CZX=0 D ; FOR EACH DICT ENTRY
-"RTN","C0CDIC",141,0)
+"RTN","C0CDIC",139,0)
. ;W C0CZX,!
-"RTN","C0CDIC",142,0)
+"RTN","C0CDIC",140,0)
. K C0CA,C0CN ; CLEAR OUT THE LAST ONE
-"RTN","C0CDIC",143,0)
+"RTN","C0CDIC",141,0)
. D GETN1^C0CRNF("C0CA",170,C0CZX,"","ALL") ; GET VARIABLE HASH
-"RTN","C0CDIC",144,0)
+"RTN","C0CDIC",142,0)
. ;ZWR C0CA B ;
-"RTN","C0CDIC",145,0)
+"RTN","C0CDIC",143,0)
. S C0CN=$$ZVALUE("VARIABLE") ;NAME OF THE VARIABLE
-"RTN","C0CDIC",146,0)
+"RTN","C0CDIC",144,0)
. W "VARIABLE: ",C0CN,!
-"RTN","C0CDIC",147,0)
+"RTN","C0CDIC",145,0)
. I $E(C0CN,1,5)="ACTOR" D SETFDA("SECTION","ACTORS") ;
-"RTN","C0CDIC",148,0)
+"RTN","C0CDIC",146,0)
. I $E(C0CN,1,6)="SOCIAL" D ;
-"RTN","C0CDIC",149,0)
+"RTN","C0CDIC",147,0)
. . D SETFDA("SECTION","SOC") ;
-"RTN","C0CDIC",150,0)
+"RTN","C0CDIC",148,0)
. . D SETFDA("STATUS","X") ;SOCIAL HISTORY NOT IMPLEMENTED
-"RTN","C0CDIC",151,0)
+"RTN","C0CDIC",149,0)
. . S C0CSTAT=1
-"RTN","C0CDIC",152,0)
+"RTN","C0CDIC",150,0)
. I $E(C0CN,1,6)="FAMILY" D ;
-"RTN","C0CDIC",153,0)
+"RTN","C0CDIC",151,0)
. . D SETFDA("SECTION","FAM") ;
-"RTN","C0CDIC",154,0)
+"RTN","C0CDIC",152,0)
. . D SETFDA("STATUS","X") ;FAMILY HISTORY NOT IMPLEMENTED
-"RTN","C0CDIC",155,0)
+"RTN","C0CDIC",153,0)
. . S C0CSTAT=1
-"RTN","C0CDIC",156,0)
+"RTN","C0CDIC",154,0)
. ;D SETFDA("TYPE","") ;CORRECT FOR TYPE ERRORS
-"RTN","C0CDIC",157,0)
+"RTN","C0CDIC",155,0)
. I $E(C0CN,1,5)="ALERT" D SETFDA("SECTION","ALERTS")
-"RTN","C0CDIC",158,0)
+"RTN","C0CDIC",156,0)
. I $E(C0CN,1,5)="VITAL" D SETFDA("SECTION","VITALS")
-"RTN","C0CDIC",159,0)
+"RTN","C0CDIC",157,0)
. I $E(C0CN,1,7)="PROBLEM" D SETFDA("SECTION","PROBLEMS")
-"RTN","C0CDIC",160,0)
+"RTN","C0CDIC",158,0)
. I $E(C0CN,1,10)="RESULTTEST" D SETFDA("SECTION","TEST")
-"RTN","C0CDIC",161,0)
+"RTN","C0CDIC",159,0)
. E I $E(C0CN,1,6)="RESULT" D SETFDA("SECTION","LABS")
-"RTN","C0CDIC",162,0)
+"RTN","C0CDIC",160,0)
. I C0CN["CODEVALUE" D SETFDA("TYPE","CD") ;CODES
-"RTN","C0CDIC",163,0)
+"RTN","C0CDIC",161,0)
. I C0CN["CODEVERSION" D SETFDA("TYPE","CV") ; CODE VERSION
-"RTN","C0CDIC",164,0)
+"RTN","C0CDIC",162,0)
. I C0CN["CODINGSYSTEM" D SETFDA("TYPE","CS") ;CODING SYSTEM
-"RTN","C0CDIC",165,0)
+"RTN","C0CDIC",163,0)
. I $$ZVALUE("STATUS")=""!'C0CSTAT D SETFDA("STATUS","N") ;BLANK STATUS TO N
-"RTN","C0CDIC",166,0)
+"RTN","C0CDIC",164,0)
. I $$ZVALUE("XPATH")["/Medication/Directions/" D ; MEDS DIRECTIONS VAR
-"RTN","C0CDIC",167,0)
+"RTN","C0CDIC",165,0)
. . D SETFDA("SECTION","DIR") ; SPECIAL SECTION FOR DIRECTIONS
-"RTN","C0CDIC",168,0)
+"RTN","C0CDIC",166,0)
. E I $$ZVALUE("XPATH")["/Medications/Medication/" D ; ALL OTHER MEDS
-"RTN","C0CDIC",169,0)
+"RTN","C0CDIC",167,0)
. . D SETFDA("SECTION","MEDS") ; A MEDS VAR
-"RTN","C0CDIC",170,0)
+"RTN","C0CDIC",168,0)
. I $E(C0CN,($L(C0CN)-1),$L(C0CN))="ID" D SETFDA("TYPE","ID") ;CATCH THE IDS
-"RTN","C0CDIC",171,0)
+"RTN","C0CDIC",169,0)
. I C0CN["DATETIME" D SETFDA("TYPE","DT") ; DATE/TIME VARIABLE
-"RTN","C0CDIC",172,0)
+"RTN","C0CDIC",170,0)
. W "VARIABLE: ",C0CZX," ",C0CA("VARIABLE"),!
-"RTN","C0CDIC",173,0)
+"RTN","C0CDIC",171,0)
. ;ZWR C0CFDA
-"RTN","C0CDIC",174,0)
+"RTN","C0CDIC",172,0)
. I $D(C0CFDA) D ; WE HAVE CHANGES ON THIS VARIABLE
-"RTN","C0CDIC",175,0)
+"RTN","C0CDIC",173,0)
. . ;ZWR C0CFDA
-"RTN","C0CDIC",176,0)
+"RTN","C0CDIC",174,0)
. . D UPDATE^DIE("","C0CFDA(C0CZX)")
-"RTN","C0CDIC",177,0)
+"RTN","C0CDIC",175,0)
. . I $D(^TMP("DIERR",$J)) U $P BREAK
-"RTN","C0CDIC",178,0)
+"RTN","C0CDIC",176,0)
. . D CLEAN^DILF ; CLEAN UP
-"RTN","C0CDIC",179,0)
+"RTN","C0CDIC",177,0)
. ;ZWR C0CFDA
+"RTN","C0CDIC",178,0)
+ Q
+"RTN","C0CDIC",179,0)
+ ;
"RTN","C0CDIC",180,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)
+"RTN","C0CDIC",181,0)
; TO SET TO VALUE C0CSV.
-"RTN","C0CDIC",184,0)
+"RTN","C0CDIC",182,0)
; C0CFDA,C0CA,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
-"RTN","C0CDIC",185,0)
+"RTN","C0CDIC",183,0)
; C0CSN,C0CSV ARE PASSED BY VALUE
-"RTN","C0CDIC",186,0)
+"RTN","C0CDIC",184,0)
;
-"RTN","C0CDIC",187,0)
+"RTN","C0CDIC",185,0)
N C0CSI,C0CSJ
-"RTN","C0CDIC",188,0)
+"RTN","C0CDIC",186,0)
S C0CSI=$$ZFILE(C0CSN,"C0CA") ; FILE NUMBER
-"RTN","C0CDIC",189,0)
+"RTN","C0CDIC",187,0)
S C0CSJ=$$ZFIELD(C0CSN,"C0CA") ; FIELD NUMBER
-"RTN","C0CDIC",190,0)
+"RTN","C0CDIC",188,0)
S C0CFDA(C0CZX,C0CSI,C0CZX_",",C0CSJ)=C0CSV
-"RTN","C0CDIC",191,0)
+"RTN","C0CDIC",189,0)
Q
-"RTN","C0CDIC",192,0)
+"RTN","C0CDIC",190,0)
ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
-"RTN","C0CDIC",193,0)
+"RTN","C0CDIC",191,0)
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
+"RTN","C0CDIC",192,0)
+ ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
+"RTN","C0CDIC",193,0)
+ I '$D(ZTAB) S ZTAB="C0CA"
"RTN","C0CDIC",194,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CDIC",195,0)
- I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CDIC",196,0)
Q $P(@ZTAB@(ZFN),"^",1)
-"RTN","C0CDIC",197,0)
+"RTN","C0CDIC",195,0)
ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
-"RTN","C0CDIC",198,0)
+"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",198,0)
+ I '$D(ZTAB) S ZTAB="C0CA"
"RTN","C0CDIC",199,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CDIC",200,0)
- I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CDIC",201,0)
Q $P(@ZTAB@(ZFN),"^",2)
-"RTN","C0CDIC",202,0)
+"RTN","C0CDIC",200,0)
ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
-"RTN","C0CDIC",203,0)
+"RTN","C0CDIC",201,0)
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
-"RTN","C0CDIC",204,0)
+"RTN","C0CDIC",202,0)
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CDIC",205,0)
+"RTN","C0CDIC",203,0)
I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CDIC",206,0)
+"RTN","C0CDIC",204,0)
Q $P(@ZTAB@(ZFN),"^",3)
-"RTN","C0CDIC",207,0)
+"RTN","C0CDIC",205,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 .
"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)
- 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)
+"RTN","C0CDOM",22,0)
; THE XPATH INDEX ZXIDX, PASSED BY NAME
-"RTN","C0CDOM",24,0)
+"RTN","C0CDOM",23,0)
; THE XPATH ARRAY XPARY, PASSED BY NAME
-"RTN","C0CDOM",25,0)
+"RTN","C0CDOM",24,0)
; ZOID IS THE STARTING OID
-"RTN","C0CDOM",26,0)
+"RTN","C0CDOM",25,0)
; ZPATH IS THE STARTING XPATH, USUALLY "/"
-"RTN","C0CDOM",27,0)
+"RTN","C0CDOM",26,0)
; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
-"RTN","C0CDOM",28,0)
+"RTN","C0CDOM",27,0)
; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
-"RTN","C0CDOM",29,0)
+"RTN","C0CDOM",28,0)
I $G(ZREDUX)="" S ZREDUX=""
-"RTN","C0CDOM",30,0)
+"RTN","C0CDOM",29,0)
N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY
-"RTN","C0CDOM",31,0)
+"RTN","C0CDOM",30,0)
N NEWNUM S NEWNUM=""
-"RTN","C0CDOM",32,0)
+"RTN","C0CDOM",31,0)
I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
-"RTN","C0CDOM",33,0)
+"RTN","C0CDOM",32,0)
S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
-"RTN","C0CDOM",34,0)
+"RTN","C0CDOM",33,0)
I $G(ZREDUX)'="" D ; REDUX PROVIDED?
-"RTN","C0CDOM",35,0)
+"RTN","C0CDOM",34,0)
. N GT S GT=$P(NEWPATH,ZREDUX,2)
-"RTN","C0CDOM",36,0)
+"RTN","C0CDOM",35,0)
. I GT'="" S NEWPATH=GT
-"RTN","C0CDOM",37,0)
+"RTN","C0CDOM",36,0)
S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
-"RTN","C0CDOM",38,0)
+"RTN","C0CDOM",37,0)
N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE
-"RTN","C0CDOM",39,0)
+"RTN","C0CDOM",38,0)
I $D(GA) D ; PROCESS THE ATTRIBUTES
-"RTN","C0CDOM",40,0)
+"RTN","C0CDOM",39,0)
. N ZI S ZI=""
-"RTN","C0CDOM",41,0)
+"RTN","C0CDOM",40,0)
. F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE
-"RTN","C0CDOM",42,0)
+"RTN","C0CDOM",41,0)
. . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE
-"RTN","C0CDOM",43,0)
+"RTN","C0CDOM",42,0)
. . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY
-"RTN","C0CDOM",44,0)
+"RTN","C0CDOM",43,0)
. . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE
-"RTN","C0CDOM",45,0)
+"RTN","C0CDOM",44,0)
N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
-"RTN","C0CDOM",46,0)
+"RTN","C0CDOM",45,0)
I $D(GD(2)) D ;
-"RTN","C0CDOM",47,0)
+"RTN","C0CDOM",46,0)
. M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
-"RTN","C0CDOM",48,0)
+"RTN","C0CDOM",47,0)
E I $D(GD(1)) D ;
-"RTN","C0CDOM",49,0)
+"RTN","C0CDOM",48,0)
. S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
-"RTN","C0CDOM",50,0)
+"RTN","C0CDOM",49,0)
. I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY
-"RTN","C0CDOM",51,0)
+"RTN","C0CDOM",50,0)
N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
-"RTN","C0CDOM",52,0)
+"RTN","C0CDOM",51,0)
I ZFRST'=0 D ; THERE IS A CHILD
-"RTN","C0CDOM",53,0)
+"RTN","C0CDOM",52,0)
. N ZNUM
-"RTN","C0CDOM",54,0)
+"RTN","C0CDOM",53,0)
. N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
-"RTN","C0CDOM",55,0)
+"RTN","C0CDOM",54,0)
. D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD
-"RTN","C0CDOM",56,0)
+"RTN","C0CDOM",55,0)
N GNXT S GNXT=$$NXTSIB(ZOID)
-"RTN","C0CDOM",57,0)
+"RTN","C0CDOM",56,0)
I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
-"RTN","C0CDOM",58,0)
+"RTN","C0CDOM",57,0)
I GNXT'=0 D ;
-"RTN","C0CDOM",59,0)
+"RTN","C0CDOM",58,0)
. N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
-"RTN","C0CDOM",60,0)
+"RTN","C0CDOM",59,0)
. I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES
-"RTN","C0CDOM",61,0)
+"RTN","C0CDOM",60,0)
. . N ZNUM S ZNUM=1 ;
-"RTN","C0CDOM",62,0)
+"RTN","C0CDOM",61,0)
. . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
-"RTN","C0CDOM",63,0)
+"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",64,0)
- Q
+ ;
"RTN","C0CDOM",65,0)
- ;
-"RTN","C0CDOM",66,0)
ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY
+"RTN","C0CDOM",66,0)
+ ;
"RTN","C0CDOM",67,0)
- ;
-"RTN","C0CDOM",68,0)
; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES
+"RTN","C0CDOM",68,0)
+ ;
"RTN","C0CDOM",69,0)
- ;
-"RTN","C0CDOM",70,0)
N ZZI,ZZJ,ZZN
-"RTN","C0CDOM",71,0)
+"RTN","C0CDOM",70,0)
S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY
-"RTN","C0CDOM",72,0)
+"RTN","C0CDOM",71,0)
I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE
-"RTN","C0CDOM",73,0)
+"RTN","C0CDOM",72,0)
S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY
-"RTN","C0CDOM",74,0)
+"RTN","C0CDOM",73,0)
S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .
-"RTN","C0CDOM",75,0)
+"RTN","C0CDOM",74,0)
I ZZI'["]" D ; A SINGLETON
-"RTN","C0CDOM",76,0)
+"RTN","C0CDOM",75,0)
. S ZZN=1
-"RTN","C0CDOM",77,0)
+"RTN","C0CDOM",76,0)
E D ; THERE IS AN [x] OCCURANCE
-"RTN","C0CDOM",78,0)
+"RTN","C0CDOM",77,0)
. S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE
-"RTN","C0CDOM",79,0)
+"RTN","C0CDOM",78,0)
. S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]
-"RTN","C0CDOM",80,0)
+"RTN","C0CDOM",79,0)
I ZZJ'="" D ; TIME TO ADD THE VALUE
-"RTN","C0CDOM",81,0)
+"RTN","C0CDOM",80,0)
. S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
+"RTN","C0CDOM",81,0)
+ Q
"RTN","C0CDOM",82,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)
+"RTN","C0CDOM",84,0)
; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
-"RTN","C0CDOM",86,0)
+"RTN","C0CDOM",85,0)
; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
-"RTN","C0CDOM",87,0)
+"RTN","C0CDOM",86,0)
;Q $$EN^MXMLDOM(INXML)
-"RTN","C0CDOM",88,0)
+"RTN","C0CDOM",87,0)
Q $$EN^MXMLDOM(INXML,"W")
+"RTN","C0CDOM",88,0)
+ ;
"RTN","C0CDOM",89,0)
- ;
-"RTN","C0CDOM",90,0)
ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
-"RTN","C0CDOM",91,0)
+"RTN","C0CDOM",90,0)
N ZN
-"RTN","C0CDOM",92,0)
+"RTN","C0CDOM",91,0)
;I $$TAG(ZOID)["entry" B
-"RTN","C0CDOM",93,0)
+"RTN","C0CDOM",92,0)
S ZN=$$NXTSIB(ZOID)
-"RTN","C0CDOM",94,0)
+"RTN","C0CDOM",93,0)
I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
-"RTN","C0CDOM",95,0)
+"RTN","C0CDOM",94,0)
Q 0
+"RTN","C0CDOM",95,0)
+ ;
"RTN","C0CDOM",96,0)
- ;
-"RTN","C0CDOM",97,0)
FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
-"RTN","C0CDOM",98,0)
+"RTN","C0CDOM",97,0)
Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
+"RTN","C0CDOM",98,0)
+ ;
"RTN","C0CDOM",99,0)
- ;
-"RTN","C0CDOM",100,0)
PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
-"RTN","C0CDOM",101,0)
+"RTN","C0CDOM",100,0)
Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
+"RTN","C0CDOM",101,0)
+ ;
"RTN","C0CDOM",102,0)
- ;
-"RTN","C0CDOM",103,0)
ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
-"RTN","C0CDOM",104,0)
+"RTN","C0CDOM",103,0)
S HANDLE=C0CDOCID
-"RTN","C0CDOM",105,0)
+"RTN","C0CDOM",104,0)
K @RTN
-"RTN","C0CDOM",106,0)
+"RTN","C0CDOM",105,0)
D GETTXT^MXMLDOM("A")
+"RTN","C0CDOM",106,0)
+ Q
"RTN","C0CDOM",107,0)
- Q
+ ;
"RTN","C0CDOM",108,0)
- ;
-"RTN","C0CDOM",109,0)
TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
-"RTN","C0CDOM",110,0)
+"RTN","C0CDOM",109,0)
;I ZOID=149 B ;GPLTEST
-"RTN","C0CDOM",111,0)
+"RTN","C0CDOM",110,0)
N X,Y
-"RTN","C0CDOM",112,0)
+"RTN","C0CDOM",111,0)
S Y=""
-"RTN","C0CDOM",113,0)
+"RTN","C0CDOM",112,0)
S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
-"RTN","C0CDOM",114,0)
+"RTN","C0CDOM",113,0)
I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
-"RTN","C0CDOM",115,0)
+"RTN","C0CDOM",114,0)
I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CDOM",116,0)
+"RTN","C0CDOM",115,0)
Q Y
+"RTN","C0CDOM",116,0)
+ ;
"RTN","C0CDOM",117,0)
- ;
-"RTN","C0CDOM",118,0)
NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
-"RTN","C0CDOM",119,0)
+"RTN","C0CDOM",118,0)
Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
+"RTN","C0CDOM",119,0)
+ ;
"RTN","C0CDOM",120,0)
- ;
-"RTN","C0CDOM",121,0)
DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
-"RTN","C0CDOM",122,0)
+"RTN","C0CDOM",121,0)
;N ZT,ZN S ZT=""
-"RTN","C0CDOM",123,0)
+"RTN","C0CDOM",122,0)
;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
-"RTN","C0CDOM",124,0)
+"RTN","C0CDOM",123,0)
;Q $G(@C0CDOM@(ZOID,"T",1))
-"RTN","C0CDOM",125,0)
+"RTN","C0CDOM",124,0)
S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
+"RTN","C0CDOM",125,0)
+ Q
"RTN","C0CDOM",126,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",128,0)
+ ;
"RTN","C0CDOM",129,0)
- ;
-"RTN","C0CDOM",130,0)
S C0CDOCID=INID
-"RTN","C0CDOM",131,0)
+"RTN","C0CDOM",130,0)
I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE 0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID
-"RTN","C0CDOM",230,0)
+"RTN","C0CDOM",229,0)
E I $L($G(PARENT))>0 D ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL
-"RTN","C0CDOM",231,0)
+"RTN","C0CDOM",230,0)
. D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE
-"RTN","C0CDOM",232,0)
+"RTN","C0CDOM",231,0)
. S ZPARNODE=1 ;
-"RTN","C0CDOM",233,0)
+"RTN","C0CDOM",232,0)
; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET
-"RTN","C0CDOM",234,0)
+"RTN","C0CDOM",233,0)
N ZEXARY
-"RTN","C0CDOM",235,0)
+"RTN","C0CDOM",234,0)
D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY
-"RTN","C0CDOM",236,0)
+"RTN","C0CDOM",235,0)
D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED
-"RTN","C0CDOM",237,0)
+"RTN","C0CDOM",236,0)
I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE
-"RTN","C0CDOM",238,0)
+"RTN","C0CDOM",237,0)
Q HANDLE ; SUCCESS
-"RTN","C0CDOM",239,0)
+"RTN","C0CDOM",238,0)
;
-"RTN","C0CDOM",240,0)
+"RTN","C0CDOM",239,0)
MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES
-"RTN","C0CDOM",241,0)
+"RTN","C0CDOM",240,0)
N ZI S ZI=""
-"RTN","C0CDOM",242,0)
+"RTN","C0CDOM",241,0)
N ZTAG
-"RTN","C0CDOM",243,0)
+"RTN","C0CDOM",242,0)
F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH SECTION
-"RTN","C0CDOM",244,0)
+"RTN","C0CDOM",243,0)
. N ZELEADD S ZELEADD=0
-"RTN","C0CDOM",245,0)
+"RTN","C0CDOM",244,0)
. I ZI["@" D ; END NODE HAS NO VALUE, ONLY ATTRIBUTES
-"RTN","C0CDOM",246,0)
+"RTN","C0CDOM",245,0)
. . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG
-"RTN","C0CDOM",247,0)
+"RTN","C0CDOM",246,0)
. . K ZATT ; CLEAR OUT LAST ONE
-"RTN","C0CDOM",248,0)
+"RTN","C0CDOM",247,0)
. . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY
-"RTN","C0CDOM",249,0)
+"RTN","C0CDOM",248,0)
. . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE
-"RTN","C0CDOM",250,0)
+"RTN","C0CDOM",249,0)
. . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE
-"RTN","C0CDOM",251,0)
+"RTN","C0CDOM",250,0)
. I $O(@ZARY@(ZI,""))="" D ;END NODE
-"RTN","C0CDOM",252,0)
+"RTN","C0CDOM",251,0)
. . S ZTAG=ZI ; USE ZI FOR THE TAG
-"RTN","C0CDOM",253,0)
+"RTN","C0CDOM",252,0)
. . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE
-"RTN","C0CDOM",254,0)
+"RTN","C0CDOM",253,0)
. . S ZELEADD=1 ; ADDED AN ELEMENT
-"RTN","C0CDOM",255,0)
+"RTN","C0CDOM",254,0)
. . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE
-"RTN","C0CDOM",256,0)
+"RTN","C0CDOM",255,0)
. I ZELEADD D Q ; NO MORE TO DO ON THIS LEVEL
-"RTN","C0CDOM",257,0)
+"RTN","C0CDOM",256,0)
. . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING
-"RTN","C0CDOM",258,0)
+"RTN","C0CDOM",257,0)
. N NEWARY ; INDENTED ARRAY
-"RTN","C0CDOM",259,0)
+"RTN","C0CDOM",258,0)
. N ZN S ZN=0
-"RTN","C0CDOM",260,0)
+"RTN","C0CDOM",259,0)
. F S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN="" D ; FOR EACH MULTIPLE
-"RTN","C0CDOM",261,0)
+"RTN","C0CDOM",260,0)
. . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG
-"RTN","C0CDOM",262,0)
+"RTN","C0CDOM",261,0)
. . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY
-"RTN","C0CDOM",263,0)
+"RTN","C0CDOM",262,0)
. . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY
-"RTN","C0CDOM",264,0)
+"RTN","C0CDOM",263,0)
. . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG
+"RTN","C0CDOM",264,0)
+ Q
"RTN","C0CDOM",265,0)
- Q
+ ;
"RTN","C0CDOM",266,0)
- ;
-"RTN","C0CDOM",267,0)
EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED
-"RTN","C0CDOM",268,0)
+"RTN","C0CDOM",267,0)
; CONSISTENT FORMAT
-"RTN","C0CDOM",269,0)
+"RTN","C0CDOM",268,0)
; GNARY("patient",1,"facilities[2].facility@code")="050"
-"RTN","C0CDOM",270,0)
+"RTN","C0CDOM",269,0)
; becomes G2ARY("patient",1,"facilities",2,"facility@",1,"code")="050"
-"RTN","C0CDOM",271,0)
+"RTN","C0CDOM",270,0)
; for easier processing (this is fileman format genius)
-"RTN","C0CDOM",272,0)
+"RTN","C0CDOM",271,0)
; basically removes the dot notation from the strings
+"RTN","C0CDOM",272,0)
+ ;
"RTN","C0CDOM",273,0)
- ;
-"RTN","C0CDOM",274,0)
N ZZI
-"RTN","C0CDOM",275,0)
+"RTN","C0CDOM",274,0)
S ZZI=""
-"RTN","C0CDOM",276,0)
+"RTN","C0CDOM",275,0)
F S ZZI=$O(@ZZIN@(ZZI)) Q:ZZI="" D ;
-"RTN","C0CDOM",277,0)
+"RTN","C0CDOM",276,0)
. N ZZN S ZZN=0
-"RTN","C0CDOM",278,0)
+"RTN","C0CDOM",277,0)
. F S ZZN=$O(@ZZIN@(ZZI,ZZN)) Q:ZZN="" D ;
-"RTN","C0CDOM",279,0)
+"RTN","C0CDOM",278,0)
. . N ZZS S ZZS=""
-"RTN","C0CDOM",280,0)
+"RTN","C0CDOM",279,0)
. . N GA ;PUSH STACK
-"RTN","C0CDOM",281,0)
+"RTN","C0CDOM",280,0)
. . F S ZZS=$O(@ZZIN@(ZZI,ZZN,ZZS)) Q:ZZS="" D ;
-"RTN","C0CDOM",282,0)
+"RTN","C0CDOM",281,0)
. . . K GA ; NEW STACK
-"RTN","C0CDOM",283,0)
+"RTN","C0CDOM",282,0)
. . . D PUSH^C0CXPATH("GA",ZZI_"^"_ZZN) ; PUSH PARENT
-"RTN","C0CDOM",284,0)
+"RTN","C0CDOM",283,0)
. . . N ZZV ; PLACE TO STASH THE VALUE
-"RTN","C0CDOM",285,0)
+"RTN","C0CDOM",284,0)
. . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE
-"RTN","C0CDOM",286,0)
+"RTN","C0CDOM",285,0)
. . . W !,"VALUE:",ZZV
-"RTN","C0CDOM",287,0)
+"RTN","C0CDOM",286,0)
. . . N GK ; COUNTER
-"RTN","C0CDOM",288,0)
+"RTN","C0CDOM",287,0)
. . . F GK=1:1:$L(ZZS,".") D ; FOR EACH INTERMEDIATE NODE
-"RTN","C0CDOM",289,0)
+"RTN","C0CDOM",288,0)
. . . . N ZZN2 S ZZN2=1 ; DEFAULT IF NO [X]
-"RTN","C0CDOM",290,0)
+"RTN","C0CDOM",289,0)
. . . . N GM S GM=$P(ZZS,".",GK) ; TAG
-"RTN","C0CDOM",291,0)
+"RTN","C0CDOM",290,0)
. . . . I GM["[" D ; IT'S A MULTIPLE
-"RTN","C0CDOM",292,0)
+"RTN","C0CDOM",291,0)
. . . . . S ZZN2=$P($P(GM,"[",2),"]",1) ; PULL OUT THE NUMBER
-"RTN","C0CDOM",293,0)
+"RTN","C0CDOM",292,0)
. . . . . S GM=$P(GM,"[",1) ; PULL OUT THE TAG
-"RTN","C0CDOM",294,0)
+"RTN","C0CDOM",293,0)
. . . . I GM["@" D ; IT'S GOT ATTRIBUTES
-"RTN","C0CDOM",295,0)
+"RTN","C0CDOM",294,0)
. . . . . N GM2 S GM2=$P(GM,"@",2) ; PULLOUT THE ATTRIBUTE NAME
-"RTN","C0CDOM",296,0)
+"RTN","C0CDOM",295,0)
. . . . . D PUSH^C0CXPATH("GA",$P(GM,"@",1)_"@"_"^"_ZZN2) ; PUSH THE TAG
-"RTN","C0CDOM",297,0)
+"RTN","C0CDOM",296,0)
. . . . . D PUSH^C0CXPATH("GA",GM2_"^"_ZZN2)
-"RTN","C0CDOM",298,0)
+"RTN","C0CDOM",297,0)
. . . . E D PUSH^C0CXPATH("GA",GM_"^"_ZZN2) ;
-"RTN","C0CDOM",299,0)
+"RTN","C0CDOM",298,0)
. . . S GA(GA(0))=$P(GA(GA(0)),"^",1)_"^" ; GET RID OF THE LAST "1"
-"RTN","C0CDOM",300,0)
+"RTN","C0CDOM",299,0)
. . . N GZI S GZI="" ; STRING FOR THE INDEX
-"RTN","C0CDOM",301,0)
+"RTN","C0CDOM",300,0)
. . . F GK=1:1:GA(0) D ; TIME TO REVERSE POP THE TAGS
-"RTN","C0CDOM",302,0)
+"RTN","C0CDOM",301,0)
. . . . S GM=$P(GA(GK),"^",1) ; THE TAG
-"RTN","C0CDOM",303,0)
+"RTN","C0CDOM",302,0)
. . . . S ZZN2=$P(GA(GK),"^",2) ; THE NUMBER IF ANY
-"RTN","C0CDOM",304,0)
+"RTN","C0CDOM",303,0)
. . . . I ZZN2="" S GZI=GZI_""""_GM_"""" ; FOR THE LAST ONE
-"RTN","C0CDOM",305,0)
+"RTN","C0CDOM",304,0)
. . . . E S GZI=GZI_""""_GM_""""_","_ZZN2_"," ; FOR THE REST
-"RTN","C0CDOM",306,0)
+"RTN","C0CDOM",305,0)
. . . S GZI2=ZZOUT_"("_GZI_")" ; INCLUDE THE ARRAY NAME
-"RTN","C0CDOM",307,0)
+"RTN","C0CDOM",306,0)
. . . W !,GZI
-"RTN","C0CDOM",308,0)
+"RTN","C0CDOM",307,0)
. . . S @GZI2=ZZV ; REMEMBER THE VALUE?
-"RTN","C0CDOM",309,0)
+"RTN","C0CDOM",308,0)
Q
-"RTN","C0CDOM",310,0)
+"RTN","C0CDOM",309,0)
;
-"RTN","C0CDOM",311,0)
+"RTN","C0CDOM",310,0)
NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE
-"RTN","C0CDOM",312,0)
+"RTN","C0CDOM",311,0)
N CBK,SUCCESS,LEVEL,NODE,HANDLE
-"RTN","C0CDOM",313,0)
+"RTN","C0CDOM",312,0)
K ^TMP("MXMLERR",$J)
-"RTN","C0CDOM",314,0)
+"RTN","C0CDOM",313,0)
L +^TMP("MXMLDOM",$J):5
-"RTN","C0CDOM",315,0)
+"RTN","C0CDOM",314,0)
E Q 0
-"RTN","C0CDOM",316,0)
+"RTN","C0CDOM",315,0)
S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)=""
-"RTN","C0CDOM",317,0)
+"RTN","C0CDOM",316,0)
L -^TMP("MXMLDOM",$J)
-"RTN","C0CDOM",318,0)
+"RTN","C0CDOM",317,0)
Q HANDLE
-"RTN","C0CDOM",319,0)
+"RTN","C0CDOM",318,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)
- ; This program is distributed in the hope that it will be useful,
+ ; it under the terms of the GNU Affero General Public License as
"RTN","C0CDPT",8,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; published by the Free Software Foundation, either version 3 of the
"RTN","C0CDPT",9,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ ; License, or (at your option) any later version.
"RTN","C0CDPT",10,0)
- ; GNU General Public License for more details.
+ ;
"RTN","C0CDPT",11,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
"RTN","C0CDPT",12,0)
- ; You should have received a copy of the GNU General Public License along
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0CDPT",13,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
"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)
- ; FAMILY Family Name
+ ; You should have received a copy of the GNU Affero General Public License
"RTN","C0CDPT",17,0)
- ; GIVEN Given Name
+ ; along with this program. If not, see .
"RTN","C0CDPT",18,0)
- ; MIDDLE Middle Name
+ ;
"RTN","C0CDPT",19,0)
- ; SUFFIX Suffix Name
+ ;
"RTN","C0CDPT",20,0)
- ; DISPNAME Display Name
+ ; FAMILY Family Name
"RTN","C0CDPT",21,0)
- ; DOB Date of Birth
+ ; GIVEN Given Name
"RTN","C0CDPT",22,0)
- ; GENDER Get Gender
+ ; MIDDLE Middle Name
"RTN","C0CDPT",23,0)
- ; SSN Get SSN for ID
+ ; SUFFIX Suffix Name
"RTN","C0CDPT",24,0)
- ; ADDRTYPE Get Home Address
+ ; DISPNAME Display Name
"RTN","C0CDPT",25,0)
- ; ADDR1 Get Home Address line 1
+ ; DOB Date of Birth
"RTN","C0CDPT",26,0)
- ; ADDR2 Get Home Address line 2
+ ; GENDER Get Gender
"RTN","C0CDPT",27,0)
- ; CITY Get City for Home Address
+ ; SSN Get SSN for ID
"RTN","C0CDPT",28,0)
- ; STATE Get State for Home Address
+ ; ADDRTYPE Get Home Address
"RTN","C0CDPT",29,0)
- ; ZIP Get Zip code for Home Address
+ ; ADDR1 Get Home Address line 1
"RTN","C0CDPT",30,0)
- ; COUNTY Get County for our Address
+ ; ADDR2 Get Home Address line 2
"RTN","C0CDPT",31,0)
- ; COUNTRY Get Country for our Address
+ ; CITY Get City for Home Address
"RTN","C0CDPT",32,0)
- ; RESTEL Residential Telephone
+ ; STATE Get State for Home Address
"RTN","C0CDPT",33,0)
- ; WORKTEL Work Telephone
+ ; ZIP Get Zip code for Home Address
"RTN","C0CDPT",34,0)
- ; EMAIL Email Adddress
+ ; COUNTY Get County for our Address
"RTN","C0CDPT",35,0)
- ; CELLTEL Cell Phone
+ ; COUNTRY Get Country for our Address
"RTN","C0CDPT",36,0)
- ; NOK1FAM Next of Kin 1 (NOK1) Family Name
+ ; RESTEL Residential Telephone
"RTN","C0CDPT",37,0)
- ; NOK1GIV NOK1 Given Name
+ ; WORKTEL Work Telephone
"RTN","C0CDPT",38,0)
- ; NOK1MID NOK1 Middle Name
+ ; EMAIL Email Adddress
"RTN","C0CDPT",39,0)
- ; NOK1SUF NOK1 Suffi Name
+ ; CELLTEL Cell Phone
"RTN","C0CDPT",40,0)
- ; NOK1DISP NOK1 Display Name
+ ; NOK1FAM Next of Kin 1 (NOK1) Family Name
"RTN","C0CDPT",41,0)
- ; NOK1REL NOK1 Relationship to the patient
+ ; NOK1GIV NOK1 Given Name
"RTN","C0CDPT",42,0)
- ; NOK1ADD1 NOK1 Address 1
+ ; NOK1MID NOK1 Middle Name
"RTN","C0CDPT",43,0)
- ; NOK1ADD2 NOK1 Address 2
+ ; NOK1SUF NOK1 Suffi Name
"RTN","C0CDPT",44,0)
- ; NOK1CITY NOK1 City
+ ; NOK1DISP NOK1 Display Name
"RTN","C0CDPT",45,0)
- ; NOK1STAT NOK1 State
+ ; NOK1REL NOK1 Relationship to the patient
"RTN","C0CDPT",46,0)
- ; NOK1ZIP NOK1 Zip Code
+ ; NOK1ADD1 NOK1 Address 1
"RTN","C0CDPT",47,0)
- ; NOK1HTEL NOK1 Home Telephone
+ ; NOK1ADD2 NOK1 Address 2
"RTN","C0CDPT",48,0)
- ; NOK1WTEL NOK1 Work Telephone
+ ; NOK1CITY NOK1 City
"RTN","C0CDPT",49,0)
- ; NOK1SAME Is NOK1's Address the same the patient?
+ ; NOK1STAT NOK1 State
"RTN","C0CDPT",50,0)
- ; NOK2FAM NOK2 Family Name
+ ; NOK1ZIP NOK1 Zip Code
"RTN","C0CDPT",51,0)
- ; NOK2GIV NOK2 Given Name
+ ; NOK1HTEL NOK1 Home Telephone
"RTN","C0CDPT",52,0)
- ; NOK2MID NOK2 Middle Name
+ ; NOK1WTEL NOK1 Work Telephone
"RTN","C0CDPT",53,0)
- ; NOK2SUF NOK2 Suffi Name
+ ; NOK1SAME Is NOK1's Address the same the patient?
"RTN","C0CDPT",54,0)
- ; NOK2DISP NOK2 Display Name
+ ; NOK2FAM NOK2 Family Name
"RTN","C0CDPT",55,0)
- ; NOK2REL NOK2 Relationship to the patient
+ ; NOK2GIV NOK2 Given Name
"RTN","C0CDPT",56,0)
- ; NOK2ADD1 NOK2 Address 1
+ ; NOK2MID NOK2 Middle Name
"RTN","C0CDPT",57,0)
- ; NOK2ADD2 NOK2 Address 2
+ ; NOK2SUF NOK2 Suffi Name
"RTN","C0CDPT",58,0)
- ; NOK2CITY NOK2 City
+ ; NOK2DISP NOK2 Display Name
"RTN","C0CDPT",59,0)
- ; NOK2STAT NOK2 State
+ ; NOK2REL NOK2 Relationship to the patient
"RTN","C0CDPT",60,0)
- ; NOK2ZIP NOK2 Zip Code
+ ; NOK2ADD1 NOK2 Address 1
"RTN","C0CDPT",61,0)
- ; NOK2HTEL NOK2 Home Telephone
+ ; NOK2ADD2 NOK2 Address 2
"RTN","C0CDPT",62,0)
- ; NOK2WTEL NOK2 Work Telephone
+ ; NOK2CITY NOK2 City
"RTN","C0CDPT",63,0)
- ; NOK2SAME Is NOK2's Address the same the patient?
+ ; NOK2STAT NOK2 State
"RTN","C0CDPT",64,0)
- ; EMERFAM Emergency Contact (EMER) Family Name
+ ; NOK2ZIP NOK2 Zip Code
"RTN","C0CDPT",65,0)
- ; EMERGIV EMER Given Name
+ ; NOK2HTEL NOK2 Home Telephone
"RTN","C0CDPT",66,0)
- ; EMERMID EMER Middle Name
+ ; NOK2WTEL NOK2 Work Telephone
"RTN","C0CDPT",67,0)
- ; EMERSUF EMER Suffi Name
+ ; NOK2SAME Is NOK2's Address the same the patient?
"RTN","C0CDPT",68,0)
- ; EMERDISP EMER Display Name
+ ; EMERFAM Emergency Contact (EMER) Family Name
"RTN","C0CDPT",69,0)
- ; EMERREL EMER Relationship to the patient
+ ; EMERGIV EMER Given Name
"RTN","C0CDPT",70,0)
- ; EMERADD1 EMER Address 1
+ ; EMERMID EMER Middle Name
"RTN","C0CDPT",71,0)
- ; EMERADD2 EMER Address 2
+ ; EMERSUF EMER Suffi Name
"RTN","C0CDPT",72,0)
- ; EMERCITY EMER City
+ ; EMERDISP EMER Display Name
"RTN","C0CDPT",73,0)
- ; EMERSTAT EMER State
+ ; EMERREL EMER Relationship to the patient
"RTN","C0CDPT",74,0)
- ; EMERZIP EMER Zip Code
+ ; EMERADD1 EMER Address 1
"RTN","C0CDPT",75,0)
- ; EMERHTEL EMER Home Telephone
+ ; EMERADD2 EMER Address 2
"RTN","C0CDPT",76,0)
- ; EMERWTEL EMER Work Telephone
+ ; EMERCITY EMER City
"RTN","C0CDPT",77,0)
- ; EMERSAME Is EMER's Address the same the NOK?
+ ; EMERSTAT EMER State
"RTN","C0CDPT",78,0)
- ;
+ ; EMERZIP EMER Zip Code
"RTN","C0CDPT",79,0)
- W "No Entry at top!" Q
+ ; EMERHTEL EMER Home Telephone
"RTN","C0CDPT",80,0)
- ;
+ ; EMERWTEL EMER Work Telephone
"RTN","C0CDPT",81,0)
- ;**Revision History**
+ ; EMERSAME Is EMER's Address the same the NOK?
"RTN","C0CDPT",82,0)
- ; - June 15, 08: v0.1 using merged global
+ ;
"RTN","C0CDPT",83,0)
- ; - Oct 3, 08: v0.2 using fileman calls, many formatting changes.
+ W "No Entry at top!" Q
"RTN","C0CDPT",84,0)
;
"RTN","C0CDPT",85,0)
- ; All methods are Public and Extrinsic
+ ;**Revision History**
"RTN","C0CDPT",86,0)
- ; All calls use Fileman file 2 (Patient).
+ ; - June 15, 08: v0.1 using merged global
"RTN","C0CDPT",87,0)
- ; You can obtain field numbers using the data dictionary
+ ; - Oct 3, 08: v0.2 using fileman calls, many formatting changes.
"RTN","C0CDPT",88,0)
;
"RTN","C0CDPT",89,0)
-FAMILY(DFN) ; Family Name
+ ; All methods are Public and Extrinsic
"RTN","C0CDPT",90,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
+ ; All calls use Fileman file 2 (Patient).
"RTN","C0CDPT",91,0)
- D NAMECOMP^XLFNAME(.NAME)
+ ; You can obtain field numbers using the data dictionary
"RTN","C0CDPT",92,0)
- Q NAME("FAMILY")
+ ;
"RTN","C0CDPT",93,0)
-GIVEN(DFN) ; Given Name
+FAMILY(DFN) ; Family Name
"RTN","C0CDPT",94,0)
N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
"RTN","C0CDPT",95,0)
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)
"RTN","C0CDPT",99,0)
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)
"RTN","C0CDPT",103,0)
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)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","C0CDPT",108,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","C0CDPT",109,0)
-DOB(DFN) ; Date of Birth
-"RTN","C0CDPT",110,0)
- N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I")
-"RTN","C0CDPT",111,0)
- ; Date in FM Date Format. Convert to UTC/ISO 8601.
-"RTN","C0CDPT",112,0)
- Q $$FMDTOUTC^C0CUTIL(DOB,"D")
-"RTN","C0CDPT",113,0)
-GENDER(DFN) ; Gender/Sex
-"RTN","C0CDPT",114,0)
- Q $$GET1^DIQ(2,DFN,.02,"I")_"^"_$$GET1^DIQ(2,DFN,.02,"E") ;
-"RTN","C0CDPT",115,0)
-SSN(DFN) ; SSN
-"RTN","C0CDPT",116,0)
- Q $$GET1^DIQ(2,DFN,.09)
-"RTN","C0CDPT",117,0)
-ADDRTYPE(DFN) ; Address Type
-"RTN","C0CDPT",118,0)
- ; Vista only stores a home address for the patient.
-"RTN","C0CDPT",119,0)
- Q "Home"
-"RTN","C0CDPT",120,0)
-ADDR1(DFN) ; Get Home Address line 1
-"RTN","C0CDPT",121,0)
- Q $$GET1^DIQ(2,DFN,.111)
-"RTN","C0CDPT",122,0)
-ADDR2(DFN) ; Get Home Address line 2
-"RTN","C0CDPT",123,0)
- ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
-"RTN","C0CDPT",124,0)
- N ADDLN2,ADDLN3
-"RTN","C0CDPT",125,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.112),ADDLN3=$$GET1^DIQ(2,DFN,.113)
-"RTN","C0CDPT",126,0)
- Q:ADDLN3="" ADDLN2
-"RTN","C0CDPT",127,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","C0CDPT",128,0)
-CITY(DFN) ; Get City for Home Address
-"RTN","C0CDPT",129,0)
- Q $$GET1^DIQ(2,DFN,.114)
-"RTN","C0CDPT",130,0)
-STATE(DFN) ; Get State for Home Address
-"RTN","C0CDPT",131,0)
- Q $$GET1^DIQ(2,DFN,.115)
-"RTN","C0CDPT",132,0)
-ZIP(DFN) ; Get Zip code for Home Address
-"RTN","C0CDPT",133,0)
- Q $$GET1^DIQ(2,DFN,.116)
-"RTN","C0CDPT",134,0)
-COUNTY(DFN) ; Get County for our Address
-"RTN","C0CDPT",135,0)
- Q $$GET1^DIQ(2,DFN,.117)
-"RTN","C0CDPT",136,0)
-COUNTRY(DFN) ; Get Country for our Address
-"RTN","C0CDPT",137,0)
- ; Unfortunately, it's not stored anywhere in Vista, so the inevitable...
-"RTN","C0CDPT",138,0)
- Q "USA"
-"RTN","C0CDPT",139,0)
-RESTEL(DFN) ; Residential Telephone
-"RTN","C0CDPT",140,0)
- Q $$GET1^DIQ(2,DFN,.131)
-"RTN","C0CDPT",141,0)
-WORKTEL(DFN) ; Work Telephone
-"RTN","C0CDPT",142,0)
- Q $$GET1^DIQ(2,DFN,.132)
-"RTN","C0CDPT",143,0)
-EMAIL(DFN) ; Email Adddress
-"RTN","C0CDPT",144,0)
- Q $$GET1^DIQ(2,DFN,.133)
-"RTN","C0CDPT",145,0)
-CELLTEL(DFN) ; Cell Phone
-"RTN","C0CDPT",146,0)
- Q $$GET1^DIQ(2,DFN,.134)
-"RTN","C0CDPT",147,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",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",112,0)
+ Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","C0CDPT",113,0)
+DOB(DFN) ; Date of Birth
+"RTN","C0CDPT",114,0)
+ N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I")
+"RTN","C0CDPT",115,0)
+ ; Date in FM Date Format. Convert to UTC/ISO 8601.
+"RTN","C0CDPT",116,0)
+ Q $$FMDTOUTC^C0CUTIL(DOB,"D")
+"RTN","C0CDPT",117,0)
+GENDER(DFN) ; Gender/Sex
+"RTN","C0CDPT",118,0)
+ Q $$GET1^DIQ(2,DFN,.02,"I")_"^"_$$GET1^DIQ(2,DFN,.02,"E") ;
+"RTN","C0CDPT",119,0)
+SSN(DFN) ; SSN
+"RTN","C0CDPT",120,0)
+ Q $$GET1^DIQ(2,DFN,.09)
+"RTN","C0CDPT",121,0)
+ADDRTYPE(DFN) ; Address Type
+"RTN","C0CDPT",122,0)
+ ; Vista only stores a home address for the patient.
+"RTN","C0CDPT",123,0)
+ Q "Home"
+"RTN","C0CDPT",124,0)
+ADDR1(DFN) ; Get Home Address line 1
+"RTN","C0CDPT",125,0)
+ Q $$GET1^DIQ(2,DFN,.111)
+"RTN","C0CDPT",126,0)
+ADDR2(DFN) ; Get Home Address line 2
+"RTN","C0CDPT",127,0)
+ ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
+"RTN","C0CDPT",128,0)
+ N ADDLN2,ADDLN3
+"RTN","C0CDPT",129,0)
+ S ADDLN2=$$GET1^DIQ(2,DFN,.112),ADDLN3=$$GET1^DIQ(2,DFN,.113)
+"RTN","C0CDPT",130,0)
+ Q:ADDLN3="" ADDLN2
+"RTN","C0CDPT",131,0)
+ Q ADDLN2_", "_ADDLN3
+"RTN","C0CDPT",132,0)
+CITY(DFN) ; Get City for Home Address
+"RTN","C0CDPT",133,0)
+ Q $$GET1^DIQ(2,DFN,.114)
+"RTN","C0CDPT",134,0)
+STATE(DFN) ; Get State for Home Address
+"RTN","C0CDPT",135,0)
+ Q $$GET1^DIQ(2,DFN,.115)
+"RTN","C0CDPT",136,0)
+ZIP(DFN) ; Get Zip code for Home Address
+"RTN","C0CDPT",137,0)
+ Q $$GET1^DIQ(2,DFN,.116)
+"RTN","C0CDPT",138,0)
+COUNTY(DFN) ; Get County for our Address
+"RTN","C0CDPT",139,0)
+ Q $$GET1^DIQ(2,DFN,.117)
+"RTN","C0CDPT",140,0)
+COUNTRY(DFN) ; Get Country for our Address
+"RTN","C0CDPT",141,0)
+ ; Unfortunately, it's not stored anywhere in Vista, so the inevitable...
+"RTN","C0CDPT",142,0)
+ Q "USA"
+"RTN","C0CDPT",143,0)
+RESTEL(DFN) ; Residential Telephone
+"RTN","C0CDPT",144,0)
+ Q $$GET1^DIQ(2,DFN,.131)
+"RTN","C0CDPT",145,0)
+WORKTEL(DFN) ; Work Telephone
+"RTN","C0CDPT",146,0)
+ Q $$GET1^DIQ(2,DFN,.132)
+"RTN","C0CDPT",147,0)
+EMAIL(DFN) ; Email Adddress
+"RTN","C0CDPT",148,0)
+ Q $$GET1^DIQ(2,DFN,.133)
+"RTN","C0CDPT",149,0)
+CELLTEL(DFN) ; Cell Phone
"RTN","C0CDPT",150,0)
- Q NAME("FAMILY")
+ Q $$GET1^DIQ(2,DFN,.134)
"RTN","C0CDPT",151,0)
-NOK1GIV(DFN) ; NOK1 Given Name
+NOK1FAM(DFN) ; Next of Kin 1 (NOK1) Family Name
"RTN","C0CDPT",152,0)
N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
"RTN","C0CDPT",153,0)
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)
"RTN","C0CDPT",157,0)
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)
"RTN","C0CDPT",161,0)
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)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","C0CDPT",166,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","C0CDPT",167,0)
-NOK1REL(DFN) ; NOK1 Relationship to the patient
-"RTN","C0CDPT",168,0)
- Q $$GET1^DIQ(2,DFN,.212)
-"RTN","C0CDPT",169,0)
-NOK1ADD1(DFN) ; NOK1 Address 1
-"RTN","C0CDPT",170,0)
- Q $$GET1^DIQ(2,DFN,.213)
-"RTN","C0CDPT",171,0)
-NOK1ADD2(DFN) ; NOK1 Address 2
-"RTN","C0CDPT",172,0)
- N ADDLN2,ADDLN3
-"RTN","C0CDPT",173,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.214),ADDLN3=$$GET1^DIQ(2,DFN,.215)
-"RTN","C0CDPT",174,0)
- Q:ADDLN3="" ADDLN2
-"RTN","C0CDPT",175,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","C0CDPT",176,0)
-NOK1CITY(DFN) ; NOK1 City
-"RTN","C0CDPT",177,0)
- Q $$GET1^DIQ(2,DFN,.216)
-"RTN","C0CDPT",178,0)
-NOK1STAT(DFN) ; NOK1 State
-"RTN","C0CDPT",179,0)
- Q $$GET1^DIQ(2,DFN,.217)
-"RTN","C0CDPT",180,0)
-NOK1ZIP(DFN) ; NOK1 Zip Code
-"RTN","C0CDPT",181,0)
- Q $$GET1^DIQ(2,DFN,.218)
-"RTN","C0CDPT",182,0)
-NOK1HTEL(DFN) ; NOK1 Home Telephone
-"RTN","C0CDPT",183,0)
- Q $$GET1^DIQ(2,DFN,.219)
-"RTN","C0CDPT",184,0)
-NOK1WTEL(DFN) ; NOK1 Work Telephone
-"RTN","C0CDPT",185,0)
- Q $$GET1^DIQ(2,DFN,.21011)
-"RTN","C0CDPT",186,0)
-NOK1SAME(DFN) ; Is NOK1's Address the same the patient?
-"RTN","C0CDPT",187,0)
- Q $$GET1^DIQ(2,DFN,.2125)
-"RTN","C0CDPT",188,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",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",170,0)
+ Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","C0CDPT",171,0)
+NOK1REL(DFN) ; NOK1 Relationship to the patient
+"RTN","C0CDPT",172,0)
+ Q $$GET1^DIQ(2,DFN,.212)
+"RTN","C0CDPT",173,0)
+NOK1ADD1(DFN) ; NOK1 Address 1
+"RTN","C0CDPT",174,0)
+ Q $$GET1^DIQ(2,DFN,.213)
+"RTN","C0CDPT",175,0)
+NOK1ADD2(DFN) ; NOK1 Address 2
+"RTN","C0CDPT",176,0)
+ N ADDLN2,ADDLN3
+"RTN","C0CDPT",177,0)
+ S ADDLN2=$$GET1^DIQ(2,DFN,.214),ADDLN3=$$GET1^DIQ(2,DFN,.215)
+"RTN","C0CDPT",178,0)
+ Q:ADDLN3="" ADDLN2
+"RTN","C0CDPT",179,0)
+ Q ADDLN2_", "_ADDLN3
+"RTN","C0CDPT",180,0)
+NOK1CITY(DFN) ; NOK1 City
+"RTN","C0CDPT",181,0)
+ Q $$GET1^DIQ(2,DFN,.216)
+"RTN","C0CDPT",182,0)
+NOK1STAT(DFN) ; NOK1 State
+"RTN","C0CDPT",183,0)
+ Q $$GET1^DIQ(2,DFN,.217)
+"RTN","C0CDPT",184,0)
+NOK1ZIP(DFN) ; NOK1 Zip Code
+"RTN","C0CDPT",185,0)
+ Q $$GET1^DIQ(2,DFN,.218)
+"RTN","C0CDPT",186,0)
+NOK1HTEL(DFN) ; NOK1 Home Telephone
+"RTN","C0CDPT",187,0)
+ Q $$GET1^DIQ(2,DFN,.219)
+"RTN","C0CDPT",188,0)
+NOK1WTEL(DFN) ; NOK1 Work Telephone
+"RTN","C0CDPT",189,0)
+ Q $$GET1^DIQ(2,DFN,.21011)
+"RTN","C0CDPT",190,0)
+NOK1SAME(DFN) ; Is NOK1's Address the same the patient?
"RTN","C0CDPT",191,0)
- Q NAME("FAMILY")
+ Q $$GET1^DIQ(2,DFN,.2125)
"RTN","C0CDPT",192,0)
-NOK2GIV(DFN) ; NOK2 Given Name
+NOK2FAM(DFN) ; NOK2 Family Name
"RTN","C0CDPT",193,0)
N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
"RTN","C0CDPT",194,0)
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)
"RTN","C0CDPT",198,0)
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)
"RTN","C0CDPT",202,0)
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)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","C0CDPT",207,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","C0CDPT",208,0)
-NOK2REL(DFN) ; NOK2 Relationship to the patient
-"RTN","C0CDPT",209,0)
- Q $$GET1^DIQ(2,DFN,.2192)
-"RTN","C0CDPT",210,0)
-NOK2ADD1(DFN) ; NOK2 Address 1
-"RTN","C0CDPT",211,0)
- Q $$GET1^DIQ(2,DFN,.2193)
-"RTN","C0CDPT",212,0)
-NOK2ADD2(DFN) ; NOK2 Address 2
-"RTN","C0CDPT",213,0)
- N ADDLN2,ADDLN3
-"RTN","C0CDPT",214,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.2194),ADDLN3=$$GET1^DIQ(2,DFN,.2195)
-"RTN","C0CDPT",215,0)
- Q:ADDLN3="" ADDLN2
-"RTN","C0CDPT",216,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","C0CDPT",217,0)
-NOK2CITY(DFN) ; NOK2 City
-"RTN","C0CDPT",218,0)
- Q $$GET1^DIQ(2,DFN,.2196)
-"RTN","C0CDPT",219,0)
-NOK2STAT(DFN) ; NOK2 State
-"RTN","C0CDPT",220,0)
- Q $$GET1^DIQ(2,DFN,.2197)
-"RTN","C0CDPT",221,0)
-NOK2ZIP(DFN) ; NOK2 Zip Code
-"RTN","C0CDPT",222,0)
- Q $$GET1^DIQ(2,DFN,.2198)
-"RTN","C0CDPT",223,0)
-NOK2HTEL(DFN) ; NOK2 Home Telephone
-"RTN","C0CDPT",224,0)
- Q $$GET1^DIQ(2,DFN,.2199)
-"RTN","C0CDPT",225,0)
-NOK2WTEL(DFN) ; NOK2 Work Telephone
-"RTN","C0CDPT",226,0)
- Q $$GET1^DIQ(2,DFN,.211011)
-"RTN","C0CDPT",227,0)
-NOK2SAME(DFN) ; Is NOK2's Address the same the patient?
-"RTN","C0CDPT",228,0)
- Q $$GET1^DIQ(2,DFN,.21925)
-"RTN","C0CDPT",229,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",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",211,0)
+ Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","C0CDPT",212,0)
+NOK2REL(DFN) ; NOK2 Relationship to the patient
+"RTN","C0CDPT",213,0)
+ Q $$GET1^DIQ(2,DFN,.2192)
+"RTN","C0CDPT",214,0)
+NOK2ADD1(DFN) ; NOK2 Address 1
+"RTN","C0CDPT",215,0)
+ Q $$GET1^DIQ(2,DFN,.2193)
+"RTN","C0CDPT",216,0)
+NOK2ADD2(DFN) ; NOK2 Address 2
+"RTN","C0CDPT",217,0)
+ N ADDLN2,ADDLN3
+"RTN","C0CDPT",218,0)
+ S ADDLN2=$$GET1^DIQ(2,DFN,.2194),ADDLN3=$$GET1^DIQ(2,DFN,.2195)
+"RTN","C0CDPT",219,0)
+ Q:ADDLN3="" ADDLN2
+"RTN","C0CDPT",220,0)
+ Q ADDLN2_", "_ADDLN3
+"RTN","C0CDPT",221,0)
+NOK2CITY(DFN) ; NOK2 City
+"RTN","C0CDPT",222,0)
+ Q $$GET1^DIQ(2,DFN,.2196)
+"RTN","C0CDPT",223,0)
+NOK2STAT(DFN) ; NOK2 State
+"RTN","C0CDPT",224,0)
+ Q $$GET1^DIQ(2,DFN,.2197)
+"RTN","C0CDPT",225,0)
+NOK2ZIP(DFN) ; NOK2 Zip Code
+"RTN","C0CDPT",226,0)
+ Q $$GET1^DIQ(2,DFN,.2198)
+"RTN","C0CDPT",227,0)
+NOK2HTEL(DFN) ; NOK2 Home Telephone
+"RTN","C0CDPT",228,0)
+ Q $$GET1^DIQ(2,DFN,.2199)
+"RTN","C0CDPT",229,0)
+NOK2WTEL(DFN) ; NOK2 Work Telephone
+"RTN","C0CDPT",230,0)
+ Q $$GET1^DIQ(2,DFN,.211011)
+"RTN","C0CDPT",231,0)
+NOK2SAME(DFN) ; Is NOK2's Address the same the patient?
"RTN","C0CDPT",232,0)
- Q NAME("FAMILY")
+ Q $$GET1^DIQ(2,DFN,.21925)
"RTN","C0CDPT",233,0)
-EMERGIV(DFN) ; EMER Given Name
+EMERFAM(DFN) ; Emergency Contact (EMER) Family Name
"RTN","C0CDPT",234,0)
N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
"RTN","C0CDPT",235,0)
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)
"RTN","C0CDPT",239,0)
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)
"RTN","C0CDPT",243,0)
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)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+ D NAMECOMP^XLFNAME(.NAME)
"RTN","C0CDPT",248,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+ Q NAME("SUFFIX")
"RTN","C0CDPT",249,0)
-EMERREL(DFN) ; EMER Relationship to the patient
+EMERDISP(DFN) ; EMER Display Name
"RTN","C0CDPT",250,0)
- Q $$GET1^DIQ(2,DFN,.331)
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
"RTN","C0CDPT",251,0)
-EMERADD1(DFN) ; EMER Address 1
+ ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
"RTN","C0CDPT",252,0)
- Q $$GET1^DIQ(2,DFN,.333)
+ Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
"RTN","C0CDPT",253,0)
-EMERADD2(DFN) ; EMER Address 2
+EMERREL(DFN) ; EMER Relationship to the patient
"RTN","C0CDPT",254,0)
- N ADDLN2,ADDLN3
+ Q $$GET1^DIQ(2,DFN,.331)
"RTN","C0CDPT",255,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.334),ADDLN3=$$GET1^DIQ(2,DFN,.335)
+EMERADD1(DFN) ; EMER Address 1
"RTN","C0CDPT",256,0)
- Q:ADDLN3="" ADDLN2
+ Q $$GET1^DIQ(2,DFN,.333)
"RTN","C0CDPT",257,0)
- Q ADDLN2_", "_ADDLN3
+EMERADD2(DFN) ; EMER Address 2
"RTN","C0CDPT",258,0)
-EMERCITY(DFN) ; EMER City
+ N ADDLN2,ADDLN3
"RTN","C0CDPT",259,0)
- Q $$GET1^DIQ(2,DFN,.336)
+ S ADDLN2=$$GET1^DIQ(2,DFN,.334),ADDLN3=$$GET1^DIQ(2,DFN,.335)
"RTN","C0CDPT",260,0)
-EMERSTAT(DFN) ; EMER State
+ Q:ADDLN3="" ADDLN2
"RTN","C0CDPT",261,0)
- Q $$GET1^DIQ(2,DFN,.337)
+ Q ADDLN2_", "_ADDLN3
"RTN","C0CDPT",262,0)
-EMERZIP(DFN) ; EMER Zip Code
+EMERCITY(DFN) ; EMER City
"RTN","C0CDPT",263,0)
- Q $$GET1^DIQ(2,DFN,.338)
+ Q $$GET1^DIQ(2,DFN,.336)
"RTN","C0CDPT",264,0)
-EMERHTEL(DFN) ; EMER Home Telephone
+EMERSTAT(DFN) ; EMER State
"RTN","C0CDPT",265,0)
- Q $$GET1^DIQ(2,DFN,.339)
+ Q $$GET1^DIQ(2,DFN,.337)
"RTN","C0CDPT",266,0)
-EMERWTEL(DFN) ; EMER Work Telephone
+EMERZIP(DFN) ; EMER Zip Code
"RTN","C0CDPT",267,0)
- Q $$GET1^DIQ(2,DFN,.33011)
+ Q $$GET1^DIQ(2,DFN,.338)
"RTN","C0CDPT",268,0)
-EMERSAME(DFN) ; Is EMER's Address the same the NOK?
+EMERHTEL(DFN) ; EMER Home Telephone
"RTN","C0CDPT",269,0)
+ Q $$GET1^DIQ(2,DFN,.339)
+"RTN","C0CDPT",270,0)
+EMERWTEL(DFN) ; EMER Work Telephone
+"RTN","C0CDPT",271,0)
+ Q $$GET1^DIQ(2,DFN,.33011)
+"RTN","C0CDPT",272,0)
+EMERSAME(DFN) ; Is EMER's Address the same the NOK?
+"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.
-"RTN","C0CENC",16,0)
;
+"RTN","C0CENC",15,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CENC",16,0)
+ ; along with this program. If not, see .
"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)
- Q
+ ; ENCXML AND ENCOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
"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)
+"RTN","C0CENC",25,0)
;I '$D(@C0CENC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE
-"RTN","C0CENC",29,0)
+"RTN","C0CENC",26,0)
K @C0CENC
-"RTN","C0CENC",30,0)
+"RTN","C0CENC",27,0)
D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET ENCOUNTERS
-"RTN","C0CENC",31,0)
+"RTN","C0CENC",28,0)
D MAP(ENCXML,C0CENC,ENCOUT) ;MAP RESULTS FOR ENCOUNTERS
-"RTN","C0CENC",32,0)
+"RTN","C0CENC",29,0)
Q
-"RTN","C0CENC",33,0)
+"RTN","C0CENC",30,0)
;
-"RTN","C0CENC",34,0)
+"RTN","C0CENC",31,0)
TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES,
-"RTN","C0CENC",35,0)
+"RTN","C0CENC",32,0)
; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
-"RTN","C0CENC",36,0)
+"RTN","C0CENC",33,0)
; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES
-"RTN","C0CENC",37,0)
+"RTN","C0CENC",34,0)
; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT
-"RTN","C0CENC",38,0)
+"RTN","C0CENC",35,0)
; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY
-"RTN","C0CENC",39,0)
+"RTN","C0CENC",36,0)
; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM
-"RTN","C0CENC",40,0)
+"RTN","C0CENC",37,0)
; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS
-"RTN","C0CENC",41,0)
+"RTN","C0CENC",38,0)
;
-"RTN","C0CENC",42,0)
+"RTN","C0CENC",39,0)
;K VISIT,LST,NOTE
-"RTN","C0CENC",43,0)
+"RTN","C0CENC",40,0)
I '$D(C0CPRC) D SETVARS^C0CPROC ; INITIALIZE WORK AREAS IF NOT ALREADY THERE
-"RTN","C0CENC",44,0)
+"RTN","C0CENC",41,0)
I '$D(VISIT) D ENTRY^C0CCPT(DFN,,,1) ; RETURNS VISIT LOCAL VARIABLE
-"RTN","C0CENC",45,0)
+"RTN","C0CENC",42,0)
; NEED TO ADD START AND END DATES FROM PARAMETERS
-"RTN","C0CENC",46,0)
+"RTN","C0CENC",43,0)
N ZI S ZI=""
-"RTN","C0CENC",47,0)
+"RTN","C0CENC",44,0)
N PREVCPT,PREVDT S (PREVCPT,PREVDT)=""
-"RTN","C0CENC",48,0)
+"RTN","C0CENC",45,0)
F S ZI=$O(VISIT(ZI),-1) Q:ZI="" D ; REVERSE TIME ORDER - MOST RECENT FIRST
-"RTN","C0CENC",49,0)
+"RTN","C0CENC",46,0)
. N ZDATE
-"RTN","C0CENC",50,0)
+"RTN","C0CENC",47,0)
. S ZDATE=$$DATE(VISIT(ZI,"DATE",0))
-"RTN","C0CENC",51,0)
+"RTN","C0CENC",48,0)
. S ZPRVARY=$NA(VISIT(ZI,"PRV"))
-"RTN","C0CENC",52,0)
+"RTN","C0CENC",49,0)
. N ZPRV
-"RTN","C0CENC",53,0)
+"RTN","C0CENC",50,0)
. S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM
-"RTN","C0CENC",54,0)
+"RTN","C0CENC",51,0)
. ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON
-"RTN","C0CENC",55,0)
+"RTN","C0CENC",52,0)
. ; ENCOBJECTID - ENCOUNTER OBJECT ID
-"RTN","C0CENC",56,0)
+"RTN","C0CENC",53,0)
. ; ENCDATETIME - ENCOUNTER DATE TIME
-"RTN","C0CENC",57,0)
+"RTN","C0CENC",54,0)
. ; ENCTYPETXT - ENCOUNTER TYPE (PLANNING TO USE ADMINISTRATIVE CPT IF AVAIL)
-"RTN","C0CENC",58,0)
+"RTN","C0CENC",55,0)
. ; ENCTYPECODE - CODE OF TYPE - PLANNING CPT CODE
-"RTN","C0CENC",59,0)
+"RTN","C0CENC",56,0)
. ; ENCTYPECODESYS - CODING SYSTEM OF TYPE - CPT-4
-"RTN","C0CENC",60,0)
+"RTN","C0CENC",57,0)
. ; ENCDESCTXT - ENCOUNTER DESCRIPTION TEXT
-"RTN","C0CENC",61,0)
+"RTN","C0CENC",58,0)
. ; ENCDESCCODE - ENCOUNTER DESCRIPTION CODE
-"RTN","C0CENC",62,0)
+"RTN","C0CENC",59,0)
. ; ENCDESCCODESYS - ENCOUNTER DESCRIPTION CODE SYSTEM
-"RTN","C0CENC",63,0)
+"RTN","C0CENC",60,0)
. ; ENCLOCACTORID - ENCOUNTER LOCATION ACTOR ID
-"RTN","C0CENC",64,0)
+"RTN","C0CENC",61,0)
. ; ENCPRVACTORID - ENCOUNTER PRACTIONER ACTOR ID
-"RTN","C0CENC",65,0)
+"RTN","C0CENC",62,0)
. ; ENCINDTXT - ENCOUNTER INDICATION TEXT
-"RTN","C0CENC",66,0)
+"RTN","C0CENC",63,0)
. ; ENCINDCODE - ENCOUNTER INDICATION CODE
-"RTN","C0CENC",67,0)
+"RTN","C0CENC",64,0)
. ; ENCINDCODESYS - ENCOUNTER INDICATION CODE SYSTEM
-"RTN","C0CENC",68,0)
+"RTN","C0CENC",65,0)
. ; ENCACTORID - ENCOUNTER SOURCE ACTOR ID
-"RTN","C0CENC",69,0)
+"RTN","C0CENC",66,0)
. ; ENCCOMMENTID - ENCOUNTER COMMENT ID - POINTER TO NOTE IN COMMENT SECTION
-"RTN","C0CENC",70,0)
+"RTN","C0CENC",67,0)
. S ZRNF("ENCOBJECTID")="ENCOUNTER_"_ZI
-"RTN","C0CENC",71,0)
+"RTN","C0CENC",68,0)
. S ZRNF("ENCDATETIME")=ZDATE ; ENCOUNTER DATE TIME
-"RTN","C0CENC",72,0)
+"RTN","C0CENC",69,0)
. S ZRNF("ENCTYPETXT")=""
-"RTN","C0CENC",73,0)
+"RTN","C0CENC",70,0)
. S ZRNF("ENCTYPECODE")=""
-"RTN","C0CENC",74,0)
+"RTN","C0CENC",71,0)
. S ZRNF("ENCTYPECODESYS")=""
-"RTN","C0CENC",75,0)
+"RTN","C0CENC",72,0)
. S ZRNF("ENCDESCTXT")=""
-"RTN","C0CENC",76,0)
+"RTN","C0CENC",73,0)
. S ZRNF("ENCDESCCODE")=""
-"RTN","C0CENC",77,0)
+"RTN","C0CENC",74,0)
. S ZRNF("ENCDESCCODESYS")=""
-"RTN","C0CENC",78,0)
+"RTN","C0CENC",75,0)
. N TYPTXT,TYPCDE,TYPSYS ; WILL BE UPDATED BY GETTYPE CALL
-"RTN","C0CENC",79,0)
+"RTN","C0CENC",76,0)
. I $$GETTYPE("VISIT(ZI)",.TYPTXT,.TYPCDE,.TYPSYS) D ; RETURNS FALSE IF NO TYPE
-"RTN","C0CENC",80,0)
+"RTN","C0CENC",77,0)
. . S ZRNF("ENCTYPETXT")=TYPTXT
-"RTN","C0CENC",81,0)
+"RTN","C0CENC",78,0)
. . S ZRNF("ENCTYPECODE")=TYPCDE
-"RTN","C0CENC",82,0)
+"RTN","C0CENC",79,0)
. . S ZRNF("ENCTYPECODESYS")=TYPSYS
-"RTN","C0CENC",83,0)
+"RTN","C0CENC",80,0)
. . S ZRNF("ENCDESCTXT")=TYPTXT ; FOR NOW, DESCRIPTION IS SAME AS TYPE
-"RTN","C0CENC",84,0)
+"RTN","C0CENC",81,0)
. . S ZRNF("ENCDESCCODE")=TYPCDE ; DESCRIPTION IS REQUIRED (TYPE IS NOT)
-"RTN","C0CENC",85,0)
+"RTN","C0CENC",82,0)
. . S ZRNF("ENCDESCCODESYS")=TYPSYS ; NEED TO CLARIFY FOR VISTA
-"RTN","C0CENC",86,0)
+"RTN","C0CENC",83,0)
. S ZRNF("ENCLOCACTORID")="ACTORORGANIZATION_1"
-"RTN","C0CENC",87,0)
+"RTN","C0CENC",84,0)
. S ZRNF("ENCPRVACTORID")=ZPRV ; PRIMARY PROVIDER LISTED FOR THE ENCOUNTER
-"RTN","C0CENC",88,0)
+"RTN","C0CENC",85,0)
. S ZRNF("ENCINDTXT")="" ; WE WILL PUT POINTERS TO PROBLEMS HERE
-"RTN","C0CENC",89,0)
+"RTN","C0CENC",86,0)
. S ZRNF("ENCINDCODE")=""
-"RTN","C0CENC",90,0)
+"RTN","C0CENC",87,0)
. S ZRNF("ENCINDCODESYS")=""
-"RTN","C0CENC",91,0)
+"RTN","C0CENC",88,0)
. S ZRNF("ENCACTORID")=ZPRV ; SOURCE WILL BE PRIMARY PROVIDER
-"RTN","C0CENC",92,0)
+"RTN","C0CENC",89,0)
. S ZRNF("ENCCOMMENTID")=""
-"RTN","C0CENC",93,0)
+"RTN","C0CENC",90,0)
. I $G(VISIT(ZI,"TEXT",1))'="" D ; THERE IS A NOTE
-"RTN","C0CENC",94,0)
+"RTN","C0CENC",91,0)
. . M @C0CNTE@(ZI,"TEXT")=VISIT(ZI,"TEXT") ; COPY THE TEXT OF THE NOTE
-"RTN","C0CENC",95,0)
+"RTN","C0CENC",92,0)
. . S @C0CNTE@(ZI,"COMMENTOBJECTID")="NOTE_"_ZI
-"RTN","C0CENC",96,0)
+"RTN","C0CENC",93,0)
. . S @C0CNTE@(ZI,"CMTDATETIME")=ZDATE ; DATE OF THE NOTE
-"RTN","C0CENC",97,0)
+"RTN","C0CENC",94,0)
. . S @C0CNTE@(ZI,"ACTORSOURCEID")=ZPRV ; SOURCE OF THE NOTE
-"RTN","C0CENC",98,0)
+"RTN","C0CENC",95,0)
. . S ZRNF("ENCCOMMENTID")="NOTE_"_ZI ; POINT TO THE NOTE FROM THE ENCOUNTER
-"RTN","C0CENC",99,0)
+"RTN","C0CENC",96,0)
. D RNF1TO2^C0CRNF(C0CENC,"ZRNF") ; ADD THIS ROW TO THE ARRAY
-"RTN","C0CENC",100,0)
+"RTN","C0CENC",97,0)
. ;S PREVCPT=ZCPT
-"RTN","C0CENC",101,0)
+"RTN","C0CENC",98,0)
. ;S PREVDT=ZDATE
-"RTN","C0CENC",102,0)
+"RTN","C0CENC",99,0)
N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"ENCOUNTERS"))
-"RTN","C0CENC",103,0)
+"RTN","C0CENC",100,0)
M @ZRIM=@C0CENC@("V")
-"RTN","C0CENC",104,0)
+"RTN","C0CENC",101,0)
K VISIT,LST,NOTE
-"RTN","C0CENC",105,0)
+"RTN","C0CENC",102,0)
Q
-"RTN","C0CENC",106,0)
+"RTN","C0CENC",103,0)
;
-"RTN","C0CENC",107,0)
+"RTN","C0CENC",104,0)
GETTYPE(ZARY,ZTXT,ZCDE,ZSYS) ; EXTRINSIC WHICH RETURNS FALSE IF NO ENCOUNTER TYPE
-"RTN","C0CENC",108,0)
+"RTN","C0CENC",105,0)
; UPDATES ZTXT WITH ENCOUNTER TYPE TEXT, ZCDE WITH ENCOUNTER TYPE CODE
-"RTN","C0CENC",109,0)
+"RTN","C0CENC",106,0)
; AND ZSYS WITH ENCOUNTER TYPE CODING SYSTEM
-"RTN","C0CENC",110,0)
+"RTN","C0CENC",107,0)
; THIS ROUTINE SHOULD BE UPDATED TO SEARCH FOR AN ADMINISTRATIVE CPT CODE
-"RTN","C0CENC",111,0)
+"RTN","C0CENC",108,0)
; INSTEAD OF JUST THE FIRST ONE IN THE LIST - GPL 1/23/10
-"RTN","C0CENC",112,0)
+"RTN","C0CENC",109,0)
N ZS,ZC
-"RTN","C0CENC",113,0)
+"RTN","C0CENC",110,0)
S ZC="" S ZS=""
-"RTN","C0CENC",114,0)
+"RTN","C0CENC",111,0)
S (ZTXT,ZCDE,ZSYS)=""
-"RTN","C0CENC",115,0)
+"RTN","C0CENC",112,0)
F S ZC=$O(@ZARY@("CPT",ZC)) Q:ZC="" D ; TRY AND FIND A "99" CPT CODE
-"RTN","C0CENC",116,0)
+"RTN","C0CENC",113,0)
. N ZT
-"RTN","C0CENC",117,0)
+"RTN","C0CENC",114,0)
. S ZT=$$CPT^C0CPROC(@ZARY@("CPT",ZC)) ; VALUES IN A CPT MULTIPLE
-"RTN","C0CENC",118,0)
+"RTN","C0CENC",115,0)
. I $E($P(ZT,U,1),1,2)="99" S ZS=ZT ; IS IT AN ADMIN CPT CODE?
-"RTN","C0CENC",119,0)
+"RTN","C0CENC",116,0)
I ZS'="" D ; CODED ENCOUNTER TYPE FOUND
-"RTN","C0CENC",120,0)
+"RTN","C0CENC",117,0)
. S ZTXT=$P(ZS,U,2)_" "_$P(ZS,U,3) ; USE BOTH PIECES FOR THE TYPE
-"RTN","C0CENC",121,0)
+"RTN","C0CENC",118,0)
. S ZCDE=$P($$CPT^C0CPROC(ZS),U,1) ; CPT CODE FOR ENCOUTER
-"RTN","C0CENC",122,0)
+"RTN","C0CENC",119,0)
. S ZSYS=""
-"RTN","C0CENC",123,0)
+"RTN","C0CENC",120,0)
. I ZCDE'="" S ZSYS="CPT-4" ; ONLY HAVE A CODING SYSTEM IF THERE IS A CODE
-"RTN","C0CENC",124,0)
+"RTN","C0CENC",121,0)
I ZS="" S ZTXT=$$ANYTXT(ZARY) ; TRY AND GET FREE FORM TEXT FROM CPT MULTIPLES
-"RTN","C0CENC",125,0)
+"RTN","C0CENC",122,0)
I ZTXT="" Q 0 ; FAILED
-"RTN","C0CENC",126,0)
+"RTN","C0CENC",123,0)
W !,ZTXT
-"RTN","C0CENC",127,0)
+"RTN","C0CENC",124,0)
Q 1 ; SUCCESS
-"RTN","C0CENC",128,0)
+"RTN","C0CENC",125,0)
;
-"RTN","C0CENC",129,0)
+"RTN","C0CENC",126,0)
ANYTXT(ZVST) ; EXTRINSIC WHICH RETURNS TEXT FROM THE CPT MULTIPLE
-"RTN","C0CENC",130,0)
+"RTN","C0CENC",127,0)
; OF A VISIT ARRAY WITHOUT CHECKING THE CPT CODE (THAT HAVING FAILED)
-"RTN","C0CENC",131,0)
+"RTN","C0CENC",128,0)
; ZVST IS THE VISIT ARRAY AND IS PASSED BY NAME
-"RTN","C0CENC",132,0)
+"RTN","C0CENC",129,0)
; RETURNS TEXT TO USE AS ENCOUNTER TYPE IF ANY
-"RTN","C0CENC",133,0)
+"RTN","C0CENC",130,0)
N ZK,ZL
-"RTN","C0CENC",134,0)
+"RTN","C0CENC",131,0)
S ZK="" S ZL=""
-"RTN","C0CENC",135,0)
+"RTN","C0CENC",132,0)
F S ZK=$O(@ZVST@("CPT",ZK)) Q:ZK="" D ; LOOK FOR SOME TEXT TO USE
-"RTN","C0CENC",136,0)
+"RTN","C0CENC",133,0)
. N ZT
-"RTN","C0CENC",137,0)
+"RTN","C0CENC",134,0)
. S ZT=$G(@ZVST@("CPT",ZK)) ; LOOK AT THIS CPT MULTIPLE
-"RTN","C0CENC",138,0)
+"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",139,0)
+"RTN","C0CENC",136,0)
. ; CONCATENATE PIECE 2 AND 3 OF THE CPT MULTIPLE FOR A TYPE
-"RTN","C0CENC",140,0)
+"RTN","C0CENC",137,0)
I ZL="" S ZL=$G(@ZVST@("CLASS")) ; USE THE NOTE DOCUMENT CLASS FOR ENCOUTNER TYPE
-"RTN","C0CENC",141,0)
+"RTN","C0CENC",138,0)
Q ZL
-"RTN","C0CENC",142,0)
+"RTN","C0CENC",139,0)
;
-"RTN","C0CENC",143,0)
+"RTN","C0CENC",140,0)
PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME
-"RTN","C0CENC",144,0)
+"RTN","C0CENC",141,0)
N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN=""
-"RTN","C0CENC",145,0)
+"RTN","C0CENC",142,0)
F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH PRV SEG
-"RTN","C0CENC",146,0)
+"RTN","C0CENC",143,0)
. I ZR'="" Q ;ONLY WANT THE FIRST PRIMARY PROVIDER
-"RTN","C0CENC",147,0)
+"RTN","C0CENC",144,0)
. I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1)
-"RTN","C0CENC",148,0)
+"RTN","C0CENC",145,0)
I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR
-"RTN","C0CENC",149,0)
+"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)
-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)
+"RTN","C0CENC",152,0)
; CPT^CATEGORY^TEXT
-"RTN","C0CENC",156,0)
+"RTN","C0CENC",153,0)
N Z1,Z2,Z3,ZRTN
-"RTN","C0CENC",157,0)
- S Z1=$P(ISTR,U,1)
-"RTN","C0CENC",158,0)
+"RTN","C0CENC",154,0)
+ S Z1=$P(ISTR,U,1)
+"RTN","C0CENC",155,0)
I Z1="" D ;
-"RTN","C0CENC",159,0)
+"RTN","C0CENC",156,0)
. I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)
-"RTN","C0CENC",160,0)
+"RTN","C0CENC",157,0)
I Z1'="" D ; IF THERE IS A CPT CODE IN THERE
-"RTN","C0CENC",161,0)
+"RTN","C0CENC",158,0)
. ;S Z1=$P(ISTR,U,1)
-"RTN","C0CENC",162,0)
+"RTN","C0CENC",159,0)
. S Z2=$P(ISTR,U,2)
-"RTN","C0CENC",163,0)
+"RTN","C0CENC",160,0)
. S Z3=$P(ISTR,U,3)
-"RTN","C0CENC",164,0)
+"RTN","C0CENC",161,0)
. S ZRTN=Z1_U_Z2_U_Z3
-"RTN","C0CENC",165,0)
+"RTN","C0CENC",162,0)
E S ZRTN=""
-"RTN","C0CENC",166,0)
+"RTN","C0CENC",163,0)
Q ZRTN
-"RTN","C0CENC",167,0)
+"RTN","C0CENC",164,0)
;
-"RTN","C0CENC",168,0)
+"RTN","C0CENC",165,0)
MAP(ENCXML,C0CENC,ENCOUT) ; MAP PROCEDURES XML
-"RTN","C0CENC",169,0)
+"RTN","C0CENC",166,0)
;
-"RTN","C0CENC",170,0)
+"RTN","C0CENC",167,0)
N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"ENCTEMP")) ;WORK AREA FOR TEMPLATE
-"RTN","C0CENC",171,0)
+"RTN","C0CENC",168,0)
K @ZTEMP
-"RTN","C0CENC",172,0)
+"RTN","C0CENC",169,0)
N ZBLD
-"RTN","C0CENC",173,0)
+"RTN","C0CENC",170,0)
S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"ENCBLD")) ; BUILD LIST AREA
-"RTN","C0CENC",174,0)
+"RTN","C0CENC",171,0)
D QUEUE^C0CXPATH(ZBLD,ENCXML,1,1) ; FIRST LINE
-"RTN","C0CENC",175,0)
+"RTN","C0CENC",172,0)
N ZINNER
-"RTN","C0CENC",176,0)
+"RTN","C0CENC",173,0)
D QUERY^C0CXPATH(ENCXML,"//Encounters/Encounter","ZINNER") ;ONE ENCOUNTER
-"RTN","C0CENC",177,0)
+"RTN","C0CENC",174,0)
N ZTMP,ZVAR,ZI
-"RTN","C0CENC",178,0)
+"RTN","C0CENC",175,0)
S ZI=""
-"RTN","C0CENC",179,0)
+"RTN","C0CENC",176,0)
F S ZI=$O(@C0CENC@("V",ZI)) Q:ZI="" D ;FOR EACH ENCOUNTER
-"RTN","C0CENC",180,0)
+"RTN","C0CENC",177,0)
. S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS ENCOUNTER XML
-"RTN","C0CENC",181,0)
+"RTN","C0CENC",178,0)
. S ZVAR=$NA(@C0CENC@("V",ZI)) ;THIS ENCOUNTER VARIABLES
-"RTN","C0CENC",182,0)
+"RTN","C0CENC",179,0)
. D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
-"RTN","C0CENC",183,0)
+"RTN","C0CENC",180,0)
. D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
-"RTN","C0CENC",184,0)
+"RTN","C0CENC",181,0)
D QUEUE^C0CXPATH(ZBLD,ENCXML,@ENCXML@(0),@ENCXML@(0))
-"RTN","C0CENC",185,0)
+"RTN","C0CENC",182,0)
N ZZTMP
-"RTN","C0CENC",186,0)
+"RTN","C0CENC",183,0)
D BUILD^C0CXPATH(ZBLD,ENCOUT) ;BUILD FINAL XML
-"RTN","C0CENC",187,0)
+"RTN","C0CENC",184,0)
K @ZTEMP,@ZBLD,@C0CENC
-"RTN","C0CENC",188,0)
+"RTN","C0CENC",185,0)
Q
-"RTN","C0CENC",189,0)
+"RTN","C0CENC",186,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)
-ENV ; Does not prevent loading of the transport global.
+ ;
"RTN","C0CENV",6,0)
- ; Environment check is done only during the install.
+ ; 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)
- N XQA,XQAMSG
+ ; 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)
- ; Make sure the patch name exist
+ ; 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)
- I '$D(XPDNM) D Q
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
"RTN","C0CENV",14,0)
- . D BMES("No valid patch name exist")
+ ; GNU Affero General Public License for more details.
"RTN","C0CENV",15,0)
- . S XPDQUIT=2
+ ;
"RTN","C0CENV",16,0)
- . D EXIT
+ ; You should have received a copy of the GNU Affero General Public License
"RTN","C0CENV",17,0)
- ;
+ ; along with this program. If not, see .
"RTN","C0CENV",18,0)
- D CHECK
-"RTN","C0CENV",19,0)
- D EXIT
-"RTN","C0CENV",20,0)
- Q
-"RTN","C0CENV",21,0)
;
+"RTN","C0CENV",19,0)
+ ;
+"RTN","C0CENV",20,0)
+ENV ; Does not prevent loading of the transport global.
+"RTN","C0CENV",21,0)
+ ; Environment check is done only during the install.
"RTN","C0CENV",22,0)
;
"RTN","C0CENV",23,0)
-CHECK ; Perform environment check
+ N XQA,XQAMSG
"RTN","C0CENV",24,0)
;
"RTN","C0CENV",25,0)
- I $S('$G(IOM):1,'$G(IOSL):1,$G(U)'="^":1,1:0) D
-"RTN","C0CENV",26,0)
- . D BMES("Terminal Device is not defined")
-"RTN","C0CENV",27,0)
- . S XPDQUIT=2
-"RTN","C0CENV",28,0)
;
+"RTN","C0CENV",26,0)
+ ; Make sure the patch name exist
+"RTN","C0CENV",27,0)
+ ;
+"RTN","C0CENV",28,0)
+ I '$D(XPDNM) D Q
"RTN","C0CENV",29,0)
- I $S('$G(DUZ):1,$D(DUZ)[0:1,$D(DUZ(0))[0:1,1:0) D
+ . D BMES("No valid patch name exist")
"RTN","C0CENV",30,0)
- . D BMES("Please log in to set local DUZ... variables")
-"RTN","C0CENV",31,0)
. S XPDQUIT=2
+"RTN","C0CENV",31,0)
+ . D EXIT
"RTN","C0CENV",32,0)
;
"RTN","C0CENV",33,0)
- I $P($$ACTIVE^XUSER(DUZ),"^")'=1 D
+ D CHECK
"RTN","C0CENV",34,0)
- . D BMES("You are not a valid user on this system")
+ D EXIT
"RTN","C0CENV",35,0)
- . S XPDQUIT=2
-"RTN","C0CENV",36,0)
Q
+"RTN","C0CENV",36,0)
+ ;
"RTN","C0CENV",37,0)
;
"RTN","C0CENV",38,0)
- ;
+CHECK ; Perform environment check
"RTN","C0CENV",39,0)
-EXIT ;
+ ;
"RTN","C0CENV",40,0)
- ;
+ I $S('$G(IOM):1,'$G(IOSL):1,$G(U)'="^":1,1:0) D
"RTN","C0CENV",41,0)
- ;
+ . D BMES("Terminal Device is not defined")
"RTN","C0CENV",42,0)
- I $G(XPDQUIT) D BMES("--- Install Environment Check FAILED ---") Q
+ . S XPDQUIT=2
"RTN","C0CENV",43,0)
- D BMES("--- Environment Check is Ok ---")
+ ;
"RTN","C0CENV",44,0)
- ;
+ I $S('$G(DUZ):1,$D(DUZ)[0:1,$D(DUZ(0))[0:1,1:0) D
"RTN","C0CENV",45,0)
- Q
+ . D BMES("Please log in to set local DUZ... variables")
"RTN","C0CENV",46,0)
- ;
+ . S XPDQUIT=2
"RTN","C0CENV",47,0)
;
"RTN","C0CENV",48,0)
-PRE ;Pre-install entry point
+ I $P($$ACTIVE^XUSER(DUZ),"^")'=1 D
"RTN","C0CENV",49,0)
- ;
+ . D BMES("You are not a valid user on this system")
"RTN","C0CENV",50,0)
- ; No action needed in pre-install
+ . S XPDQUIT=2
"RTN","C0CENV",51,0)
- D BMES("No action need for pre-install")
+ Q
"RTN","C0CENV",52,0)
;
"RTN","C0CENV",53,0)
- Q
-"RTN","C0CENV",54,0)
;
+"RTN","C0CENV",54,0)
+EXIT ;
"RTN","C0CENV",55,0)
;
"RTN","C0CENV",56,0)
-POST ;Post install
-"RTN","C0CENV",57,0)
;
+"RTN","C0CENV",57,0)
+ I $G(XPDQUIT) D BMES("--- Install Environment Check FAILED ---") Q
"RTN","C0CENV",58,0)
- ; Check for RPMS system with V LAB file.
+ D BMES("--- Environment Check is Ok ---")
"RTN","C0CENV",59,0)
;
"RTN","C0CENV",60,0)
- I $$VFILE^DILFD(9000010.09)'=1 Q
+ Q
"RTN","C0CENV",61,0)
;
"RTN","C0CENV",62,0)
- S %=$$NEWCP^XPDUTL("RPMS1","POST1^C0CENV")
+ ;
"RTN","C0CENV",63,0)
- S %=$$NEWCP^XPDUTL("RPMS2","POST2^C0CENV")
+PRE ;Pre-install entry point
"RTN","C0CENV",64,0)
- S %=$$NEWCP^XPDUTL("RPMS3","POST3^C0CENV")
+ ;
"RTN","C0CENV",65,0)
- S %=$$NEWCP^XPDUTL("RPMS4","POST4^C0CENV")
+ ; No action needed in pre-install
"RTN","C0CENV",66,0)
- S %=$$NEWCP^XPDUTL("RPMS5","POST5^C0CENV")
+ D BMES("No action need for pre-install")
"RTN","C0CENV",67,0)
- S %=$$NEWCP^XPDUTL("RPMS6","POST6^C0CENV")
+ ;
"RTN","C0CENV",68,0)
- S %=$$NEWCP^XPDUTL("RPMS7","POST7^C0CENV")
+ Q
"RTN","C0CENV",69,0)
;
"RTN","C0CENV",70,0)
- Q
-"RTN","C0CENV",71,0)
;
+"RTN","C0CENV",71,0)
+POST ;Post install
"RTN","C0CENV",72,0)
;
"RTN","C0CENV",73,0)
-POST1 ; Checkpoint call back entry point.
+ ; Check for RPMS system with V LAB file.
"RTN","C0CENV",74,0)
- ; Add new style ALR1 cross-reference to V LAB file.
+ ;
"RTN","C0CENV",75,0)
- ;
+ I $$VFILE^DILFD(9000010.09)'=1 Q
"RTN","C0CENV",76,0)
- N MSG
-"RTN","C0CENV",77,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",77,0)
+ S %=$$NEWCP^XPDUTL("RPMS1","POST1^C0CENV")
+"RTN","C0CENV",78,0)
+ S %=$$NEWCP^XPDUTL("RPMS2","POST2^C0CENV")
+"RTN","C0CENV",79,0)
+ S %=$$NEWCP^XPDUTL("RPMS3","POST3^C0CENV")
+"RTN","C0CENV",80,0)
+ S %=$$NEWCP^XPDUTL("RPMS4","POST4^C0CENV")
+"RTN","C0CENV",81,0)
+ S %=$$NEWCP^XPDUTL("RPMS5","POST5^C0CENV")
+"RTN","C0CENV",82,0)
+ S %=$$NEWCP^XPDUTL("RPMS6","POST6^C0CENV")
+"RTN","C0CENV",83,0)
+ S %=$$NEWCP^XPDUTL("RPMS7","POST7^C0CENV")
"RTN","C0CENV",84,0)
;
"RTN","C0CENV",85,0)
-POST2 ; Checkpoint call back entry point.
+ Q
"RTN","C0CENV",86,0)
- ; Add new style ALR2 cross-reference to V LAB file.
+ ;
"RTN","C0CENV",87,0)
;
"RTN","C0CENV",88,0)
- N MSG
+POST1 ; Checkpoint call back entry point.
"RTN","C0CENV",89,0)
- S MSG="Starting installation of ALR2 cross-reference at "_$$HTE^XLFDT($H,"1Z")
+ ; Add new style ALR1 cross-reference to V LAB file.
"RTN","C0CENV",90,0)
- D BMES(MSG)
+ ;
"RTN","C0CENV",91,0)
- D ALR2^C0CLA7DD
+ N MSG
"RTN","C0CENV",92,0)
- S MSG="Installation of ALR2 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
+ S MSG="Starting installation of ALR1 cross-reference at "_$$HTE^XLFDT($H,"1Z")
"RTN","C0CENV",93,0)
D BMES(MSG)
"RTN","C0CENV",94,0)
- Q
+ 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)
-POST3 ; Checkpoint call back entry point.
+ Q
"RTN","C0CENV",98,0)
- ; Add new style ALR3 cross-reference to V LAB file.
+ ;
"RTN","C0CENV",99,0)
;
"RTN","C0CENV",100,0)
- N MSG
+POST2 ; Checkpoint call back entry point.
"RTN","C0CENV",101,0)
- S MSG="Starting installation of ALR3 cross-reference at "_$$HTE^XLFDT($H,"1Z")
+ ; Add new style ALR2 cross-reference to V LAB file.
"RTN","C0CENV",102,0)
- D BMES(MSG)
+ ;
"RTN","C0CENV",103,0)
- D ALR3^C0CLA7DD
+ N MSG
"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)
- Q
+ 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)
-POST4 ; Checkpoint call back entry point.
+ Q
"RTN","C0CENV",110,0)
- ; Add new style ALR4 cross-reference to V LAB file.
+ ;
"RTN","C0CENV",111,0)
;
"RTN","C0CENV",112,0)
- N MSG
+POST3 ; Checkpoint call back entry point.
"RTN","C0CENV",113,0)
- S MSG="Starting installation of ALR4 cross-reference at "_$$HTE^XLFDT($H,"1Z")
+ ; Add new style ALR3 cross-reference to V LAB file.
"RTN","C0CENV",114,0)
- D BMES(MSG)
+ ;
"RTN","C0CENV",115,0)
- D ALR4^C0CLA7DD
+ N MSG
"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)
- Q
+ 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)
-POST5 ; Checkpoint call back entry point.
+ Q
"RTN","C0CENV",122,0)
- ; Add new style ALR5 cross-reference to V LAB file.
+ ;
"RTN","C0CENV",123,0)
;
"RTN","C0CENV",124,0)
- N MSG
+POST4 ; Checkpoint call back entry point.
"RTN","C0CENV",125,0)
- S MSG="Starting installation of ALR5 cross-reference at "_$$HTE^XLFDT($H,"1Z")
+ ; Add new style ALR4 cross-reference to V LAB file.
"RTN","C0CENV",126,0)
- D BMES(MSG)
+ ;
"RTN","C0CENV",127,0)
- D ALR5^C0CLA7DD
+ N MSG
"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)
- Q
+ 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)
-POST6 ; Checkpoint call back entry point.
+ Q
"RTN","C0CENV",134,0)
- ; Check for RPMS system and determine LAB patch level
-"RTN","C0CENV",135,0)
- ; and need to load in C0C version of LA7 routines.
-"RTN","C0CENV",136,0)
;
+"RTN","C0CENV",135,0)
+ ;
+"RTN","C0CENV",136,0)
+POST5 ; Checkpoint call back entry point.
"RTN","C0CENV",137,0)
- N MSG
+ ; Add new style ALR5 cross-reference to V LAB file.
"RTN","C0CENV",138,0)
;
"RTN","C0CENV",139,0)
- ; Load and rename C0CQRY2 to LA7QRY2 if LA*5.2*69 not installed
+ N MSG
"RTN","C0CENV",140,0)
- I '$$PATCH^XPDUTL("LA*5.2*69") D
+ S MSG="Starting installation of ALR5 cross-reference at "_$$HTE^XLFDT($H,"1Z")
"RTN","C0CENV",141,0)
- . S MSG="This system missing LAB patch LA*5.2*69"
+ D BMES(MSG)
"RTN","C0CENV",142,0)
- . D BMES(MSG)
+ D ALR5^C0CLA7DD
"RTN","C0CENV",143,0)
- . S MSG="Renaming routine C0CQRY2 to LA7QRY2"
+ S MSG="Installation of ALR5 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
"RTN","C0CENV",144,0)
- . D BMES(MSG)
+ D BMES(MSG)
"RTN","C0CENV",145,0)
- . D LOAD("C0CQRY2")
+ Q
"RTN","C0CENV",146,0)
- . D SAVE("C0CQRY2","LA7QRY2")
+ ;
"RTN","C0CENV",147,0)
;
"RTN","C0CENV",148,0)
- ; Load and rename C0CVOBX1 to LA7VOBX1 if LA*5.2*64 not installed.
+POST6 ; Checkpoint call back entry point.
"RTN","C0CENV",149,0)
- I '$$PATCH^XPDUTL("LA*5.2*64") D
+ ; Check for RPMS system and determine LAB patch level
"RTN","C0CENV",150,0)
- . S MSG="This system missing LAB patch LA*5.2*64"
+ ; and need to load in C0C version of LA7 routines.
"RTN","C0CENV",151,0)
- . D BMES(MSG)
+ ;
"RTN","C0CENV",152,0)
- . S MSG="Renaming routine C0CVOBX1 to LA7VOBX1"
+ N MSG
"RTN","C0CENV",153,0)
- . D BMES(MSG)
+ ;
"RTN","C0CENV",154,0)
- . D LOAD("C0CVOBX1")
+ ; Load and rename C0CQRY2 to LA7QRY2 if LA*5.2*69 not installed
"RTN","C0CENV",155,0)
- . D SAVE("C0CVOBX1","LA7VOBX1")
+ I '$$PATCH^XPDUTL("LA*5.2*69") D
"RTN","C0CENV",156,0)
- ;
+ . S MSG="This system missing LAB patch LA*5.2*69"
"RTN","C0CENV",157,0)
- ; Load and rename C0CQRY1 to LA7QRY1 if LA*5.2*68 not installed.
+ . D BMES(MSG)
"RTN","C0CENV",158,0)
- I '$$PATCH^XPDUTL("LA*5.2*68") D
+ . S MSG="Renaming routine C0CQRY2 to LA7QRY2"
"RTN","C0CENV",159,0)
- . S MSG="This system missing LAB patch LA*5.2*68"
+ . D BMES(MSG)
"RTN","C0CENV",160,0)
- . D BMES(MSG)
+ . D LOAD("C0CQRY2")
"RTN","C0CENV",161,0)
- . S MSG="Renaming routine C0CQRY1 to LA7QRY1"
+ . D SAVE("C0CQRY2","LA7QRY2")
"RTN","C0CENV",162,0)
- . D BMES(MSG)
+ ;
"RTN","C0CENV",163,0)
- . D LOAD("C0CQRY1")
+ ; Load and rename C0CVOBX1 to LA7VOBX1 if LA*5.2*64 not installed.
"RTN","C0CENV",164,0)
- . D SAVE("C0CQRY1","LA7QRY1")
+ I '$$PATCH^XPDUTL("LA*5.2*64") D
"RTN","C0CENV",165,0)
- ;
+ . S MSG="This system missing LAB patch LA*5.2*64"
"RTN","C0CENV",166,0)
- Q
+ . D BMES(MSG)
"RTN","C0CENV",167,0)
- ;
+ . S MSG="Renaming routine C0CVOBX1 to LA7VOBX1"
"RTN","C0CENV",168,0)
- ;
+ . D BMES(MSG)
"RTN","C0CENV",169,0)
-POST7 ; Checkpoint call back entry point.
+ . D LOAD("C0CVOBX1")
"RTN","C0CENV",170,0)
- ;
+ . D SAVE("C0CVOBX1","LA7VOBX1")
"RTN","C0CENV",171,0)
- D REINDEX^C0CLA7DD
+ ;
"RTN","C0CENV",172,0)
- ;
+ ; Load and rename C0CQRY1 to LA7QRY1 if LA*5.2*68 not installed.
"RTN","C0CENV",173,0)
- Q
+ I '$$PATCH^XPDUTL("LA*5.2*68") D
"RTN","C0CENV",174,0)
- ;
+ . S MSG="This system missing LAB patch LA*5.2*68"
"RTN","C0CENV",175,0)
- ;
+ . D BMES(MSG)
"RTN","C0CENV",176,0)
-BMES(STR) ; Write BMES^XPDUTL statements
+ . S MSG="Renaming routine C0CQRY1 to LA7QRY1"
"RTN","C0CENV",177,0)
- ;
+ . D BMES(MSG)
"RTN","C0CENV",178,0)
- D BMES^XPDUTL($$CJ^XLFSTR(STR,IOM))
+ . D LOAD("C0CQRY1")
"RTN","C0CENV",179,0)
- ;
+ . D SAVE("C0CQRY1","LA7QRY1")
"RTN","C0CENV",180,0)
- Q
-"RTN","C0CENV",181,0)
;
+"RTN","C0CENV",181,0)
+ Q
"RTN","C0CENV",182,0)
;
"RTN","C0CENV",183,0)
-LOAD(X) ; load routine X
+ ;
"RTN","C0CENV",184,0)
- N %N,DIF,XCNP
+POST7 ; Checkpoint call back entry point.
"RTN","C0CENV",185,0)
- K ^TMP($J,X)
+ ;
"RTN","C0CENV",186,0)
- S DIF="^TMP($J,X,",XCNP=0
+ D REINDEX^C0CLA7DD
"RTN","C0CENV",187,0)
- X ^%ZOSF("LOAD")
+ ;
"RTN","C0CENV",188,0)
Q
"RTN","C0CENV",189,0)
@@ -98461,1685 +98445,1737 @@ LOAD(X) ; load routine X
"RTN","C0CENV",190,0)
;
"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)
-gpltest2 ; experiment with sending a CCR to an ewd page
+ ;
"RTN","C0CEVC",4,0)
- N ZI
+ ; (C) Geroge Lilly 2010.
"RTN","C0CEVC",5,0)
- S ZI=""
+ ;
"RTN","C0CEVC",6,0)
- D PSEUDO
+ ; This program is free software: you can redistribute it and/or modify
"RTN","C0CEVC",7,0)
- N ZIO
+ ; it under the terms of the GNU Affero General Public License as
"RTN","C0CEVC",8,0)
- S ZIO=IO
+ ; published by the Free Software Foundation, either version 3 of the
"RTN","C0CEVC",9,0)
- S IO="/dev/null"
+ ; License, or (at your option) any later version.
"RTN","C0CEVC",10,0)
- OPEN IO
+ ;
"RTN","C0CEVC",11,0)
- U IO
+ ; This program is distributed in the hope that it will be useful,
"RTN","C0CEVC",12,0)
- N G
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0CEVC",13,0)
- S G=$$URLTOKEN^C0CEWD
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
"RTN","C0CEVC",14,0)
- D CCRRPC^C0CCCR(.GPL,2)
+ ; GNU Affero General Public License for more details.
"RTN","C0CEVC",15,0)
- S IO=ZIO
+ ;
"RTN","C0CEVC",16,0)
- OPEN IO
+ ; You should have received a copy of the GNU Affero General Public License
"RTN","C0CEVC",17,0)
- U IO
+ ; along with this program. If not, see .
"RTN","C0CEVC",18,0)
- K GPL(0)
+ ;
"RTN","C0CEVC",19,0)
- F S ZI=$O(GPL(ZI)) Q:ZI="" W GPL(ZI),!
+gpltest2 ; experiment with sending a CCR to an ewd page
"RTN","C0CEVC",20,0)
- Q
-"RTN","C0CEVC",21,0)
- ;
-"RTN","C0CEVC",22,0)
-gpltest ; experiment with sending a CCR to an ewd page
-"RTN","C0CEVC",23,0)
N ZI
-"RTN","C0CEVC",24,0)
+"RTN","C0CEVC",21,0)
S ZI=""
+"RTN","C0CEVC",22,0)
+ D PSEUDO
+"RTN","C0CEVC",23,0)
+ N ZIO
+"RTN","C0CEVC",24,0)
+ S ZIO=IO
"RTN","C0CEVC",25,0)
- K ^GPL(0)
+ S IO="/dev/null"
"RTN","C0CEVC",26,0)
- S ^GPL(2)=""
+ OPEN IO
"RTN","C0CEVC",27,0)
- F S ZI=$O(^GPL(ZI)) Q:ZI="" W ^GPL(ZI),!
+ U IO
"RTN","C0CEVC",28,0)
- Q
-"RTN","C0CEVC",29,0)
- ;
-"RTN","C0CEVC",30,0)
-TEST(sessid);
-"RTN","C0CEVC",31,0)
- d setSessionValue^%zewdAPI("person.Name","Rob",sessid)
-"RTN","C0CEVC",32,0)
- d setSessionValue^%zewdAPI("person.DateOfBirth","13/06/55",sessid)
-"RTN","C0CEVC",33,0)
- d setSessionValue^%zewdAPI("person.Address.PostCode","SW1 3QA",sessid)
-"RTN","C0CEVC",34,0)
- d setSessionValue^%zewdAPI("person.Address.Line1","1 The Street",sessid)
-"RTN","C0CEVC",35,0)
- d setSessionValue^%zewdAPI("person.Address.2.hello","world",sessid)
-"RTN","C0CEVC",36,0)
- d setJSONValue^%zewdAPI("json","person",sessid)
-"RTN","C0CEVC",37,0)
- Q ""
-"RTN","C0CEVC",38,0)
-
-"RTN","C0CEVC",39,0)
-PARSE(INXML,INDOC) ;CALL THE EWD PARSER ON INXML, PASSED BY NAME
-"RTN","C0CEVC",40,0)
- ; INDOC IS PASSED AS THE DOCUMENT NAME TO EWD
-"RTN","C0CEVC",41,0)
- ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY EWD
-"RTN","C0CEVC",42,0)
- N ZR
-"RTN","C0CEVC",43,0)
- M ^CacheTempEWD($j)=@INXML ;
-"RTN","C0CEVC",44,0)
- S ZR=$$parseDocument^%zewdHTMLParser(INDOC)
-"RTN","C0CEVC",45,0)
- Q ZR
-"RTN","C0CEVC",46,0)
- ;
-"RTN","C0CEVC",47,0)
-TEST2(sessid) ; try to put a ccr in the session
-"RTN","C0CEVC",48,0)
- S U="^"
-"RTN","C0CEVC",49,0)
- D PSEUDO ; FAKE LOGIN
-"RTN","C0CEVC",50,0)
- S ZIO=$IO
-"RTN","C0CEVC",51,0)
- S DEV="/dev/null"
-"RTN","C0CEVC",52,0)
- O DEV U DEV
-"RTN","C0CEVC",53,0)
N G
-"RTN","C0CEVC",54,0)
- N ZDFN
-"RTN","C0CEVC",55,0)
- S ZDFN=$$getSessionValue^%zewdAPI("vista.dfn",sessid)
-"RTN","C0CEVC",56,0)
- I ZDFN="" S ZDFN=2
-"RTN","C0CEVC",57,0)
- ;K ^TMP("GPL")
-"RTN","C0CEVC",58,0)
- ;M ^TMP("GPL")=^%zewdSession("session",sessid)
-"RTN","C0CEVC",59,0)
- D CCRRPC^C0CCCR(.GPL,ZDFN)
-"RTN","C0CEVC",60,0)
- K GPL(0)
-"RTN","C0CEVC",61,0)
- S GPL(2)=""
-"RTN","C0CEVC",62,0)
- C DEV U ZIO
-"RTN","C0CEVC",63,0)
- ;M ^CacheTempEWD($j)=GPL
-"RTN","C0CEVC",64,0)
- S DOCNAME="CCR"
-"RTN","C0CEVC",65,0)
- ;ZWR GPL
-"RTN","C0CEVC",66,0)
- ;S ZR=$$parseDocument^%zewdHTMLParser(DOCNAME)
-"RTN","C0CEVC",67,0)
- ;d setSessionValues^%zewdAPI(DOCNAME,GPL,sessid)
-"RTN","C0CEVC",68,0)
- d mergeArrayToSession^%zewdAPI(.GPL,DOCNAME,sessid)
-"RTN","C0CEVC",69,0)
- Q ""
-"RTN","C0CEVC",70,0)
+"RTN","C0CEVC",29,0)
+ S G=$$URLTOKEN^C0CEWD
+"RTN","C0CEVC",30,0)
+ D CCRRPC^C0CCCR(.GPL,2)
+"RTN","C0CEVC",31,0)
+ S IO=ZIO
+"RTN","C0CEVC",32,0)
+ OPEN IO
+"RTN","C0CEVC",33,0)
+ U IO
+"RTN","C0CEVC",34,0)
+ K GPL(0)
+"RTN","C0CEVC",35,0)
+ F S ZI=$O(GPL(ZI)) Q:ZI="" W GPL(ZI),!
+"RTN","C0CEVC",36,0)
+ Q
+"RTN","C0CEVC",37,0)
;
+"RTN","C0CEVC",38,0)
+gpltest ; experiment with sending a CCR to an ewd page
+"RTN","C0CEVC",39,0)
+ N ZI
+"RTN","C0CEVC",40,0)
+ S ZI=""
+"RTN","C0CEVC",41,0)
+ K ^GPL(0)
+"RTN","C0CEVC",42,0)
+ S ^GPL(2)=""
+"RTN","C0CEVC",43,0)
+ F S ZI=$O(^GPL(ZI)) Q:ZI="" W ^GPL(ZI),!
+"RTN","C0CEVC",44,0)
+ Q
+"RTN","C0CEVC",45,0)
+ ;
+"RTN","C0CEVC",46,0)
+TEST(sessid);
+"RTN","C0CEVC",47,0)
+ d setSessionValue^%zewdAPI("person.Name","Rob",sessid)
+"RTN","C0CEVC",48,0)
+ d setSessionValue^%zewdAPI("person.DateOfBirth","13/06/55",sessid)
+"RTN","C0CEVC",49,0)
+ d setSessionValue^%zewdAPI("person.Address.PostCode","SW1 3QA",sessid)
+"RTN","C0CEVC",50,0)
+ d setSessionValue^%zewdAPI("person.Address.Line1","1 The Street",sessid)
+"RTN","C0CEVC",51,0)
+ d setSessionValue^%zewdAPI("person.Address.2.hello","world",sessid)
+"RTN","C0CEVC",52,0)
+ d setJSONValue^%zewdAPI("json","person",sessid)
+"RTN","C0CEVC",53,0)
+ Q ""
+"RTN","C0CEVC",54,0)
+
+"RTN","C0CEVC",55,0)
+PARSE(INXML,INDOC) ;CALL THE EWD PARSER ON INXML, PASSED BY NAME
+"RTN","C0CEVC",56,0)
+ ; INDOC IS PASSED AS THE DOCUMENT NAME TO EWD
+"RTN","C0CEVC",57,0)
+ ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY EWD
+"RTN","C0CEVC",58,0)
+ N ZR
+"RTN","C0CEVC",59,0)
+ M ^CacheTempEWD($j)=@INXML ;
+"RTN","C0CEVC",60,0)
+ S ZR=$$parseDocument^%zewdHTMLParser(INDOC)
+"RTN","C0CEVC",61,0)
+ Q ZR
+"RTN","C0CEVC",62,0)
+ ;
+"RTN","C0CEVC",63,0)
+TEST2(sessid) ; try to put a ccr in the session
+"RTN","C0CEVC",64,0)
+ S U="^"
+"RTN","C0CEVC",65,0)
+ D PSEUDO ; FAKE LOGIN
+"RTN","C0CEVC",66,0)
+ S ZIO=$IO
+"RTN","C0CEVC",67,0)
+ S DEV="/dev/null"
+"RTN","C0CEVC",68,0)
+ O DEV U DEV
+"RTN","C0CEVC",69,0)
+ N G
+"RTN","C0CEVC",70,0)
+ N ZDFN
"RTN","C0CEVC",71,0)
-INITSES(sessid) ;initialize an EWD/CPRS session
+ S ZDFN=$$getSessionValue^%zewdAPI("vista.dfn",sessid)
"RTN","C0CEVC",72,0)
- K ^TMP("GPL")
+ I ZDFN="" S ZDFN=2
"RTN","C0CEVC",73,0)
- ;M ^TMP("GPL")=^%zewdSession("session",sessid)
+ ;K ^TMP("GPL")
"RTN","C0CEVC",74,0)
- N ZT,ZDFN
+ ;M ^TMP("GPL")=^%zewdSession("session",sessid)
"RTN","C0CEVC",75,0)
- S ZT=$$URLTOKEN^C0CEWD(sessid)
+ D CCRRPC^C0CCCR(.GPL,ZDFN)
"RTN","C0CEVC",76,0)
- ;S ^TMP("GPL")=ZT
+ K GPL(0)
"RTN","C0CEVC",77,0)
- d trace^%zewdAPI("*********************ZT="_ZT)
+ S GPL(2)=""
"RTN","C0CEVC",78,0)
- S ZDFN=$$PRSEORTK(ZT) ; PARSE THE TOKEN AND LOOK UP THE DFN
+ C DEV U ZIO
"RTN","C0CEVC",79,0)
- S ^TMP("GPL","DFN")=ZDFN
+ ;M ^CacheTempEWD($j)=GPL
"RTN","C0CEVC",80,0)
- I ZDFN=0 S DFN=2 ; DEFAULT TEST PATIENT
+ S DOCNAME="CCR"
"RTN","C0CEVC",81,0)
- D setSessionValue^%zewdAPI("vista.dfn",ZDFN,sessid)
+ ;ZWR GPL
"RTN","C0CEVC",82,0)
- ;M ^TMP("GPL","request")=requestArray
+ ;S ZR=$$parseDocument^%zewdHTMLParser(DOCNAME)
"RTN","C0CEVC",83,0)
- ;D PSEUDO
+ ;d setSessionValues^%zewdAPI(DOCNAME,GPL,sessid)
"RTN","C0CEVC",84,0)
- ;D ^%ZTER
+ d mergeArrayToSession^%zewdAPI(.GPL,DOCNAME,sessid)
"RTN","C0CEVC",85,0)
- q ""
+ Q ""
"RTN","C0CEVC",86,0)
;
"RTN","C0CEVC",87,0)
-PRSEORTK(ZTOKEN) ;PARSES THE TOKEN SENT BY CPRS AND RETURNS THE DFN
+INITSES(sessid) ;initialize an EWD/CPRS session
"RTN","C0CEVC",88,0)
- ; OF THE PATIENT ; HERE'S WHAT THE TOKEN LOOKS LIKE:
+ K ^TMP("GPL")
"RTN","C0CEVC",89,0)
- ; ^TMP('ORWCHART',6547,'192.168.169.8',002E0FE6)
+ ;M ^TMP("GPL")=^%zewdSession("session",sessid)
"RTN","C0CEVC",90,0)
- N ZX,ZN1,ZIP,ZN2,ZDFN,ZG
+ N ZT,ZDFN
"RTN","C0CEVC",91,0)
- S ZDFN=0 ; DEFAULT RETURN
+ S ZT=$$URLTOKEN^C0CEWD(sessid)
"RTN","C0CEVC",92,0)
- S ZN1=$P(ZTOKEN,",",2) ; FIRST NUMBER
+ ;S ^TMP("GPL")=ZT
"RTN","C0CEVC",93,0)
- S ZIP=$P(ZTOKEN,",",3) ; IP NUMBER
+ d trace^%zewdAPI("*********************ZT="_ZT)
"RTN","C0CEVC",94,0)
- S ZIP=$P(ZIP,"'",2) ; GET RID OF '
+ S ZDFN=$$PRSEORTK(ZT) ; PARSE THE TOKEN AND LOOK UP THE DFN
"RTN","C0CEVC",95,0)
- S ZN2=$P(ZTOKEN,",",4) ; SECOND NUMBER
+ S ^TMP("GPL","DFN")=ZDFN
"RTN","C0CEVC",96,0)
- S ZN2=$P(ZN2,")",1) ; GET RID OF )
+ I ZDFN=0 S DFN=2 ; DEFAULT TEST PATIENT
"RTN","C0CEVC",97,0)
- S ZG=$NA(^TMP("ORWCHART",ZN1,ZIP,ZN2)) ; BUILD THE GLOBAL NAME
+ D setSessionValue^%zewdAPI("vista.dfn",ZDFN,sessid)
"RTN","C0CEVC",98,0)
- I $G(@ZG)'="" S ZDFN=@ZG ; ACCESS THE GLOBAL
+ ;M ^TMP("GPL","request")=requestArray
"RTN","C0CEVC",99,0)
- S ^TMP("GPL","FIRSTDFN")=ZDFN
+ ;D PSEUDO
"RTN","C0CEVC",100,0)
- S ^TMP("GPL","FIRSTGLB")=ZG
+ ;D ^%ZTER
"RTN","C0CEVC",101,0)
- Q ZDFN
+ q ""
"RTN","C0CEVC",102,0)
;
"RTN","C0CEVC",103,0)
-GETPATIENTLIST(sessid) ;
+PRSEORTK(ZTOKEN) ;PARSES THE TOKEN SENT BY CPRS AND RETURNS THE DFN
"RTN","C0CEVC",104,0)
- D PSEUDO
+ ; OF THE PATIENT ; HERE'S WHAT THE TOKEN LOOKS LIKE:
"RTN","C0CEVC",105,0)
- D LISTALL^ORWPT(.RTN,"NAME","1")
+ ; ^TMP('ORWCHART',6547,'192.168.169.8',002E0FE6)
"RTN","C0CEVC",106,0)
- N ZI
+ N ZX,ZN1,ZIP,ZN2,ZDFN,ZG
"RTN","C0CEVC",107,0)
- S ZI=""
+ S ZDFN=0 ; DEFAULT RETURN
"RTN","C0CEVC",108,0)
- F S ZI=$O(RTN(ZI)) Q:ZI="" D ;
+ S ZN1=$P(ZTOKEN,",",2) ; FIRST NUMBER
"RTN","C0CEVC",109,0)
- . S data(ZI,"DFN")=$P(RTN(ZI),"^",1)
+ S ZIP=$P(ZTOKEN,",",3) ; IP NUMBER
"RTN","C0CEVC",110,0)
- . S data(ZI,"Name")=$P(RTN(ZI),"^",2)
+ S ZIP=$P(ZIP,"'",2) ; GET RID OF '
"RTN","C0CEVC",111,0)
- ; ZWR data
+ S ZN2=$P(ZTOKEN,",",4) ; SECOND NUMBER
"RTN","C0CEVC",112,0)
- ;S data(1,"DFN")=$P(RTN(1),"^",1)
+ S ZN2=$P(ZN2,")",1) ; GET RID OF )
"RTN","C0CEVC",113,0)
- ;S data(1,"Name")=$P(RTN(1),"^",2)
+ S ZG=$NA(^TMP("ORWCHART",ZN1,ZIP,ZN2)) ; BUILD THE GLOBAL NAME
"RTN","C0CEVC",114,0)
- d deleteFromSession^%zewdAPI("patients",sessid)
+ I $G(@ZG)'="" S ZDFN=@ZG ; ACCESS THE GLOBAL
"RTN","C0CEVC",115,0)
- d createDataTableStore^%zewdYUIRuntime(.data,"patients",sessid)
+ S ^TMP("GPL","FIRSTDFN")=ZDFN
"RTN","C0CEVC",116,0)
- ;d mergeArrayToSession^%zewdAPI(.data,"patients",sessid)
+ S ^TMP("GPL","FIRSTGLB")=ZG
"RTN","C0CEVC",117,0)
- Q ""
+ Q ZDFN
"RTN","C0CEVC",118,0)
;
"RTN","C0CEVC",119,0)
-PSEUDO
+GETPATIENTLIST(sessid) ;
"RTN","C0CEVC",120,0)
- S U="^"
+ D PSEUDO
"RTN","C0CEVC",121,0)
- S DILOCKTM=3
+ D LISTALL^ORWPT(.RTN,"NAME","1")
"RTN","C0CEVC",122,0)
- S DISYS=19
+ N ZI
"RTN","C0CEVC",123,0)
- S DT=3100219
+ S ZI=""
"RTN","C0CEVC",124,0)
- S DTIME=999
+ F S ZI=$O(RTN(ZI)) Q:ZI="" D ;
"RTN","C0CEVC",125,0)
- S DUZ=10
+ . S data(ZI,"DFN")=$P(RTN(ZI),"^",1)
"RTN","C0CEVC",126,0)
- S DUZ(0)="@"
+ . S data(ZI,"Name")=$P(RTN(ZI),"^",2)
"RTN","C0CEVC",127,0)
- S DUZ(1)=""
+ ; ZWR data
"RTN","C0CEVC",128,0)
- S DUZ(2)=1
+ ;S data(1,"DFN")=$P(RTN(1),"^",1)
"RTN","C0CEVC",129,0)
- S DUZ("AG")="V"
+ ;S data(1,"Name")=$P(RTN(1),"^",2)
"RTN","C0CEVC",130,0)
- S DUZ("BUF")=1
+ d deleteFromSession^%zewdAPI("patients",sessid)
"RTN","C0CEVC",131,0)
- S DUZ("LANG")=""
+ d createDataTableStore^%zewdYUIRuntime(.data,"patients",sessid)
"RTN","C0CEVC",132,0)
- ;S IO="/dev/pts/2"
+ ;d mergeArrayToSession^%zewdAPI(.data,"patients",sessid)
"RTN","C0CEVC",133,0)
- ;S IO(0)="/dev/pts/2"
+ Q ""
"RTN","C0CEVC",134,0)
- ;S IO(1,"/dev/pts/2")=""
-"RTN","C0CEVC",135,0)
- ;S IO("ERROR")=""
-"RTN","C0CEVC",136,0)
- ;S IO("HOME")="41^/dev/pts/2"
-"RTN","C0CEVC",137,0)
- ;S IO("ZIO")="/dev/pts/2"
-"RTN","C0CEVC",138,0)
- ;S IOBS="$C(8)"
-"RTN","C0CEVC",139,0)
- ;S IOF="#,$C(27,91,50,74,27,91,72)"
-"RTN","C0CEVC",140,0)
- ;S SIOM=80
-"RTN","C0CEVC",141,0)
- Q
-"RTN","C0CEVC",142,0)
;
-"RTN","C0CEVC",143,0)
-PSEUDO2 ; FAKE LOGIN SETS SOME LOCAL VARIABLE TO FOOL FILEMAN
-"RTN","C0CEVC",144,0)
- S DILOCKTM=3
-"RTN","C0CEVC",145,0)
- S DISYS=19
-"RTN","C0CEVC",146,0)
- S DT=3100112
-"RTN","C0CEVC",147,0)
- S DTIME=9999
-"RTN","C0CEVC",148,0)
- S DUZ=10000000020
-"RTN","C0CEVC",149,0)
- S DUZ(0)="@"
-"RTN","C0CEVC",150,0)
- S DUZ(1)=""
-"RTN","C0CEVC",151,0)
- S DUZ(2)=67
-"RTN","C0CEVC",152,0)
- S DUZ("AG")="E"
-"RTN","C0CEVC",153,0)
- S DUZ("BUF")=1
-"RTN","C0CEVC",154,0)
- S DUZ("LANG")=1
-"RTN","C0CEVC",155,0)
- S IO="/dev/pts/0"
-"RTN","C0CEVC",156,0)
- ;S IO(0)="/dev/pts/0"
-"RTN","C0CEVC",157,0)
- ;S IO(1,"/dev/pts/0")=""
-"RTN","C0CEVC",158,0)
- ;S IO("ERROR")=""
-"RTN","C0CEVC",159,0)
- ;S IO("HOME")="50^/dev/pts/0"
-"RTN","C0CEVC",160,0)
- ;S IO("ZIO")="/dev/pts/0"
-"RTN","C0CEVC",161,0)
- ;S IOBS="$C(8)"
-"RTN","C0CEVC",162,0)
- ;S IOF="!!!!!!!!!!!!!!!!!!!!!!!!,#,$C(27,91,50,74,27,91,72)"
-"RTN","C0CEVC",163,0)
- ;S IOM=80
-"RTN","C0CEVC",164,0)
- ;S ION="GTM/UNIX TELNET"
-"RTN","C0CEVC",165,0)
- ;S IOS=50
-"RTN","C0CEVC",166,0)
- ;S IOSL=24
-"RTN","C0CEVC",167,0)
- ;S IOST="C-VT100"
-"RTN","C0CEVC",168,0)
- ;S IOST(0)=9
-"RTN","C0CEVC",169,0)
- ;S IOT="VTRM"
-"RTN","C0CEVC",170,0)
- ;S IOXY="W $C(27,91)_((DY+1))_$C(59)_((DX+1))_$C(72)"
-"RTN","C0CEVC",171,0)
+"RTN","C0CEVC",135,0)
+PSEUDO
+"RTN","C0CEVC",136,0)
S U="^"
-"RTN","C0CEVC",172,0)
- S X="1;DIC(4.2,"
-"RTN","C0CEVC",173,0)
- S XPARSYS="1;DIC(4.2,"
-"RTN","C0CEVC",174,0)
- S XQXFLG="^^XUP"
-"RTN","C0CEVC",175,0)
- S Y="DEV^VISTA^hollywood^VISTA:hollywood"
-"RTN","C0CEVC",176,0)
+"RTN","C0CEVC",137,0)
+ S DILOCKTM=3
+"RTN","C0CEVC",138,0)
+ S DISYS=19
+"RTN","C0CEVC",139,0)
+ S DT=3100219
+"RTN","C0CEVC",140,0)
+ S DTIME=999
+"RTN","C0CEVC",141,0)
+ S DUZ=10
+"RTN","C0CEVC",142,0)
+ S DUZ(0)="@"
+"RTN","C0CEVC",143,0)
+ S DUZ(1)=""
+"RTN","C0CEVC",144,0)
+ S DUZ(2)=1
+"RTN","C0CEVC",145,0)
+ S DUZ("AG")="V"
+"RTN","C0CEVC",146,0)
+ S DUZ("BUF")=1
+"RTN","C0CEVC",147,0)
+ S DUZ("LANG")=""
+"RTN","C0CEVC",148,0)
+ ;S IO="/dev/pts/2"
+"RTN","C0CEVC",149,0)
+ ;S IO(0)="/dev/pts/2"
+"RTN","C0CEVC",150,0)
+ ;S IO(1,"/dev/pts/2")=""
+"RTN","C0CEVC",151,0)
+ ;S IO("ERROR")=""
+"RTN","C0CEVC",152,0)
+ ;S IO("HOME")="41^/dev/pts/2"
+"RTN","C0CEVC",153,0)
+ ;S IO("ZIO")="/dev/pts/2"
+"RTN","C0CEVC",154,0)
+ ;S IOBS="$C(8)"
+"RTN","C0CEVC",155,0)
+ ;S IOF="#,$C(27,91,50,74,27,91,72)"
+"RTN","C0CEVC",156,0)
+ ;S SIOM=80
+"RTN","C0CEVC",157,0)
Q
+"RTN","C0CEVC",158,0)
+ ;
+"RTN","C0CEVC",159,0)
+PSEUDO2 ; FAKE LOGIN SETS SOME LOCAL VARIABLE TO FOOL FILEMAN
+"RTN","C0CEVC",160,0)
+ S DILOCKTM=3
+"RTN","C0CEVC",161,0)
+ S DISYS=19
+"RTN","C0CEVC",162,0)
+ S DT=3100112
+"RTN","C0CEVC",163,0)
+ S DTIME=9999
+"RTN","C0CEVC",164,0)
+ S DUZ=10000000020
+"RTN","C0CEVC",165,0)
+ S DUZ(0)="@"
+"RTN","C0CEVC",166,0)
+ S DUZ(1)=""
+"RTN","C0CEVC",167,0)
+ S DUZ(2)=67
+"RTN","C0CEVC",168,0)
+ S DUZ("AG")="E"
+"RTN","C0CEVC",169,0)
+ S DUZ("BUF")=1
+"RTN","C0CEVC",170,0)
+ S DUZ("LANG")=1
+"RTN","C0CEVC",171,0)
+ S IO="/dev/pts/0"
+"RTN","C0CEVC",172,0)
+ ;S IO(0)="/dev/pts/0"
+"RTN","C0CEVC",173,0)
+ ;S IO(1,"/dev/pts/0")=""
+"RTN","C0CEVC",174,0)
+ ;S IO("ERROR")=""
+"RTN","C0CEVC",175,0)
+ ;S IO("HOME")="50^/dev/pts/0"
+"RTN","C0CEVC",176,0)
+ ;S IO("ZIO")="/dev/pts/0"
"RTN","C0CEVC",177,0)
+ ;S IOBS="$C(8)"
+"RTN","C0CEVC",178,0)
+ ;S IOF="!!!!!!!!!!!!!!!!!!!!!!!!,#,$C(27,91,50,74,27,91,72)"
+"RTN","C0CEVC",179,0)
+ ;S IOM=80
+"RTN","C0CEVC",180,0)
+ ;S ION="GTM/UNIX TELNET"
+"RTN","C0CEVC",181,0)
+ ;S IOS=50
+"RTN","C0CEVC",182,0)
+ ;S IOSL=24
+"RTN","C0CEVC",183,0)
+ ;S IOST="C-VT100"
+"RTN","C0CEVC",184,0)
+ ;S IOST(0)=9
+"RTN","C0CEVC",185,0)
+ ;S IOT="VTRM"
+"RTN","C0CEVC",186,0)
+ ;S IOXY="W $C(27,91)_((DY+1))_$C(59)_((DX+1))_$C(72)"
+"RTN","C0CEVC",187,0)
+ S U="^"
+"RTN","C0CEVC",188,0)
+ S X="1;DIC(4.2,"
+"RTN","C0CEVC",189,0)
+ S XPARSYS="1;DIC(4.2,"
+"RTN","C0CEVC",190,0)
+ S XQXFLG="^^XUP"
+"RTN","C0CEVC",191,0)
+ S Y="DEV^VISTA^hollywood^VISTA:hollywood"
+"RTN","C0CEVC",192,0)
+ Q
+"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 .
"RTN","C0CEWD",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
"RTN","C0CEWD",19,0)
- ;
+ Q
"RTN","C0CEWD",20,0)
- Q
+ ;
"RTN","C0CEWD",21,0)
- ;
-"RTN","C0CEWD",22,0)
TOKEN() ; EXTRINSIC WHICH RETURNS A NEW RANDOM TOKEN
-"RTN","C0CEWD",23,0)
+"RTN","C0CEWD",22,0)
Q $$UUID^C0CUTIL ; USE THE UUID FUNCTION IN THE CCR PACKAGE
+"RTN","C0CEWD",23,0)
+ ;
"RTN","C0CEWD",24,0)
- ;
-"RTN","C0CEWD",25,0)
STORE(ZARY) ; STORE AN ARRAY OF VALUES INDEXED BY A NEW TOKEN
-"RTN","C0CEWD",26,0)
+"RTN","C0CEWD",25,0)
; IN ^TMP("C0E","TOKEN") FOR LATER RETRIEVAL FROM INSIDE AN EWD SESSION
-"RTN","C0CEWD",27,0)
+"RTN","C0CEWD",26,0)
; RETURNS THE TOKEN. ZARY IS PASSED BY NAME
-"RTN","C0CEWD",28,0)
+"RTN","C0CEWD",27,0)
N ZT
-"RTN","C0CEWD",29,0)
+"RTN","C0CEWD",28,0)
S ZT=$$TOKEN ; GET A NEW TOKEN
-"RTN","C0CEWD",30,0)
+"RTN","C0CEWD",29,0)
M ^TMP("C0E","TOKEN",ZT)=@ZARY ;
-"RTN","C0CEWD",31,0)
+"RTN","C0CEWD",30,0)
Q ZT
+"RTN","C0CEWD",31,0)
+ ;
"RTN","C0CEWD",32,0)
- ;
-"RTN","C0CEWD",33,0)
GET(C0ERTN,C0ETOKEN,NOKILL) ; RETRIEVE A STORED ARRAY INDEXED BY ZTOKEN
-"RTN","C0CEWD",34,0)
+"RTN","C0CEWD",33,0)
; KILL THE ARRAY AFTER RETRIEVAL UNLESS NOKILL=1
-"RTN","C0CEWD",35,0)
+"RTN","C0CEWD",34,0)
; C0ERTN IS PASSED BY NAME
-"RTN","C0CEWD",36,0)
+"RTN","C0CEWD",35,0)
I '$D(^TMP("C0E","TOKEN",C0ETOKEN)) D Q ; DOESN'T EXIST
-"RTN","C0CEWD",37,0)
+"RTN","C0CEWD",36,0)
. S @C0ERTN="" ; PASS BACK NULL
-"RTN","C0CEWD",38,0)
+"RTN","C0CEWD",37,0)
M @C0ERTN=^TMP("C0E","TOKEN",C0ETOKEN) ; RETRIEVE
-"RTN","C0CEWD",39,0)
+"RTN","C0CEWD",38,0)
I $G(NOKILL)'=1 K ^TMP("C0E","TOKEN",C0ETOKEN) ; DELETE
-"RTN","C0CEWD",40,0)
+"RTN","C0CEWD",39,0)
Q
+"RTN","C0CEWD",40,0)
+ ;
"RTN","C0CEWD",41,0)
- ;
-"RTN","C0CEWD",42,0)
URLTOKEN(sessid) ; EXTRINSIC WHICH RETRIEVES THE TOKEN PASSED ON THE URL
-"RTN","C0CEWD",43,0)
+"RTN","C0CEWD",42,0)
; IN EWD EXAMPLE: https://example.com/ewd/myApp/index.ewd?token="12345"
-"RTN","C0CEWD",44,0)
+"RTN","C0CEWD",43,0)
N token
-"RTN","C0CEWD",45,0)
+"RTN","C0CEWD",44,0)
S token=""
-"RTN","C0CEWD",46,0)
+"RTN","C0CEWD",45,0)
s token=$$getRequestValue^%zewdAPI("token",sessid)
-"RTN","C0CEWD",47,0)
+"RTN","C0CEWD",46,0)
s token=$tr(token,"""") ; strip out quotes
-"RTN","C0CEWD",48,0)
+"RTN","C0CEWD",47,0)
Q token
+"RTN","C0CEWD",48,0)
+ ;
"RTN","C0CEWD",49,0)
- ;
-"RTN","C0CEWD",50,0)
cbTestMethod(prefix,seedValue,lastSeedValue,optionNo,options)
+"RTN","C0CEWD",50,0)
+ ;
"RTN","C0CEWD",51,0)
- ;
-"RTN","C0CEWD",52,0)
n maxNo,noFound
+"RTN","C0CEWD",52,0)
+ ;
"RTN","C0CEWD",53,0)
- ;
-"RTN","C0CEWD",54,0)
s maxNo=50
-"RTN","C0CEWD",55,0)
+"RTN","C0CEWD",54,0)
s noFound=0
-"RTN","C0CEWD",56,0)
+"RTN","C0CEWD",55,0)
f s seedValue=$o(^DPT("B",seedValue)) q:seedValue="" q:noFound=maxNo d
-"RTN","C0CEWD",57,0)
+"RTN","C0CEWD",56,0)
. s lastSeedValue=seedValue
-"RTN","C0CEWD",58,0)
+"RTN","C0CEWD",57,0)
. i prefix'="",$e(seedValue,1,$l(prefix))'=prefix q
-"RTN","C0CEWD",59,0)
+"RTN","C0CEWD",58,0)
. s optionNo=optionNo+1
-"RTN","C0CEWD",60,0)
+"RTN","C0CEWD",59,0)
. s noFound=noFound+1
-"RTN","C0CEWD",61,0)
+"RTN","C0CEWD",60,0)
. s options(optionNo)=seedValue
-"RTN","C0CEWD",62,0)
+"RTN","C0CEWD",61,0)
QUIT
+"RTN","C0CEWD",62,0)
+ ;
"RTN","C0CEWD",63,0)
- ;
-"RTN","C0CEWD",64,0)
set1 ;
-"RTN","C0CEWD",65,0)
+"RTN","C0CEWD",64,0)
s ^zewd("comboPlus","methodMap","test")="cbTestMethod^C0PEREW"
-"RTN","C0CEWD",66,0)
+"RTN","C0CEWD",65,0)
q
-"RTN","C0CEWD",67,0)
+"RTN","C0CEWD",66,0)
;
-"RTN","C0CEWD",68,0)
+"RTN","C0CEWD",67,0)
test1(sessid) ;
-"RTN","C0CEWD",69,0)
+"RTN","C0CEWD",68,0)
d setSessionValue^%zewdAPI("testing","ZZ",sessid)
-"RTN","C0CEWD",70,0)
+"RTN","C0CEWD",69,0)
q 0
-"RTN","C0CEWD",71,0)
+"RTN","C0CEWD",70,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 .
"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.,
-"RTN","C0CEWD1",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","C0CEWD1",19,0)
- ;
-"RTN","C0CEWD1",20,0)
Q
-"RTN","C0CEWD1",21,0)
+"RTN","C0CEWD1",18,0)
;
-"RTN","C0CEWD1",22,0)
+"RTN","C0CEWD1",19,0)
TEST(filepath) ; filepath IS THE PATH/FILE TO BE READ IN
-"RTN","C0CEWD1",23,0)
+"RTN","C0CEWD1",20,0)
i $g(^%ZISH)["" d ; if the VistA Kernal routine %ZISH exists
-"RTN","C0CEWD1",24,0)
+"RTN","C0CEWD1",21,0)
. n zfile,zpath,ztmp s (zfile,zpath,ztmp)=""
+"RTN","C0CEWD1",22,0)
+ . s zfile=$re($p($re(filepath),"/",1)) ;file name
+"RTN","C0CEWD1",23,0)
+ . s zpath=$p(filepath,zfile,1) ; file path
+"RTN","C0CEWD1",24,0)
+ . s ztmp=$na(^CacheTempEWD($j,0))
"RTN","C0CEWD1",25,0)
- . s zfile=$re($p($re(filepath),"/",1)) ;file name
-"RTN","C0CEWD1",26,0)
- . s zpath=$p(filepath,zfile,1) ; file path
-"RTN","C0CEWD1",27,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",26,0)
q
-"RTN","C0CEWD1",30,0)
+"RTN","C0CEWD1",27,0)
;
-"RTN","C0CEWD1",31,0)
+"RTN","C0CEWD1",28,0)
TEST2 ;
-"RTN","C0CEWD1",32,0)
+"RTN","C0CEWD1",29,0)
s zfilepath="/home/vademo2/CCR/PAT_780_CCR_V1_0_17.xml"
-"RTN","C0CEWD1",33,0)
+"RTN","C0CEWD1",30,0)
;s ok=$$gtmImportFile^%zewdHTMLParser(zfilepath)
-"RTN","C0CEWD1",34,0)
+"RTN","C0CEWD1",31,0)
s ok=$$LOAD(zfilepath) ;load the XML file to the EWD global
-"RTN","C0CEWD1",35,0)
+"RTN","C0CEWD1",32,0)
s ok=$$parseDocument^%zewdHTMLParser("DerekDOM",0)
-"RTN","C0CEWD1",36,0)
+"RTN","C0CEWD1",33,0)
;s ok=$$parseXMLFile^%zewdAPI(zfilepath,"fourthDOM")
-"RTN","C0CEWD1",37,0)
+"RTN","C0CEWD1",34,0)
w ok,!
-"RTN","C0CEWD1",38,0)
+"RTN","C0CEWD1",35,0)
q
-"RTN","C0CEWD1",39,0)
+"RTN","C0CEWD1",36,0)
;
-"RTN","C0CEWD1",40,0)
+"RTN","C0CEWD1",37,0)
LOAD(filepath) ; load an xml file into the EWD global for DOM processing
-"RTN","C0CEWD1",41,0)
+"RTN","C0CEWD1",38,0)
; need to call s error=$$parseDocument^%zewdHTMLParser(docName,isHTML)
-"RTN","C0CEWD1",42,0)
+"RTN","C0CEWD1",39,0)
; after to process it to the DOM - isHTML=0 for XML files
-"RTN","C0CEWD1",43,0)
+"RTN","C0CEWD1",40,0)
n i
-"RTN","C0CEWD1",44,0)
+"RTN","C0CEWD1",41,0)
i $g(^%ZISH)["" d QUIT i ; if VistA Kernal routine %ZISH exists - gpl 2/23/09
-"RTN","C0CEWD1",45,0)
+"RTN","C0CEWD1",42,0)
. n zfile,zpath,ztmp,zok s (zfile,zpath,ztmp)=""
-"RTN","C0CEWD1",46,0)
+"RTN","C0CEWD1",43,0)
. s zfile=$re($p($re(filepath),"/",1)) ;file name
-"RTN","C0CEWD1",47,0)
+"RTN","C0CEWD1",44,0)
. s zpath=$p(filepath,zfile,1) ; file path
-"RTN","C0CEWD1",48,0)
+"RTN","C0CEWD1",45,0)
. s ztmp=$na(^CacheTempEWD($j,0))
-"RTN","C0CEWD1",49,0)
+"RTN","C0CEWD1",46,0)
. s zok=$$FTG^%ZISH(zpath,zfile,ztmp,2) ; import the file increment subscr 2
-"RTN","C0CEWD1",50,0)
+"RTN","C0CEWD1",47,0)
. s i=$o(^CacheTempEWD($j,""),-1) ; highest line number
-"RTN","C0CEWD1",51,0)
+"RTN","C0CEWD1",48,0)
q i
-"RTN","C0CEWD1",52,0)
+"RTN","C0CEWD1",49,0)
;
-"RTN","C0CEWD1",53,0)
+"RTN","C0CEWD1",50,0)
Q(ZQ,ZD) ; SEND QUERY ZQ TO DOM ZD AND DIPLAY NODES RETURNED
-"RTN","C0CEWD1",54,0)
+"RTN","C0CEWD1",51,0)
I '$D(ZD) S ZD="DerekDOM"
-"RTN","C0CEWD1",55,0)
+"RTN","C0CEWD1",52,0)
s error=$$select^%zewdXPath(ZQ,ZD,.nodes) ;
-"RTN","C0CEWD1",56,0)
+"RTN","C0CEWD1",53,0)
d displayNodes^%zewdXPath(.nodes)
-"RTN","C0CEWD1",57,0)
+"RTN","C0CEWD1",54,0)
q
-"RTN","C0CEWD1",58,0)
+"RTN","C0CEWD1",55,0)
;
-"RTN","C0CEWD1",59,0)
+"RTN","C0CEWD1",56,0)
GET1URL0(URL) ;
-"RTN","C0CEWD1",60,0)
+"RTN","C0CEWD1",57,0)
s ok=$$httpGET^%zewdGTM(URL,.gpl)
-"RTN","C0CEWD1",61,0)
+"RTN","C0CEWD1",58,0)
D INDEX^C0CXPATH("gpl","gpl2")
-"RTN","C0CEWD1",62,0)
+"RTN","C0CEWD1",59,0)
W !,"S URL=""",URL,"""",!
-"RTN","C0CEWD1",63,0)
+"RTN","C0CEWD1",60,0)
S G=""
-"RTN","C0CEWD1",64,0)
+"RTN","C0CEWD1",61,0)
F S G=$O(gpl2(G)) Q:G="" D ;
-"RTN","C0CEWD1",65,0)
+"RTN","C0CEWD1",62,0)
. W " S VDX(""",G,""")=""",gpl2(G),"""",!
-"RTN","C0CEWD1",66,0)
+"RTN","C0CEWD1",63,0)
W !
-"RTN","C0CEWD1",67,0)
+"RTN","C0CEWD1",64,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 .
"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)
- ;
-"RTN","C0CFM1",20,0)
W "This is the CCR FILEMAN Utility Library ",!
-"RTN","C0CFM1",21,0)
+"RTN","C0CFM1",20,0)
W !
+"RTN","C0CFM1",21,0)
+ Q
"RTN","C0CFM1",22,0)
- Q
+ ;
"RTN","C0CFM1",23,0)
- ;
-"RTN","C0CFM1",24,0)
PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE
+"RTN","C0CFM1",24,0)
+ ;
"RTN","C0CFM1",25,0)
- ;
-"RTN","C0CFM1",26,0)
S C0CGLB=$NA(^TMP("GPLRIM","VARS",DFN))
-"RTN","C0CFM1",27,0)
+"RTN","C0CFM1",26,0)
I '$D(ZWHICH) S ZWHICH="ALL"
-"RTN","C0CFM1",28,0)
+"RTN","C0CFM1",27,0)
I ZWHICH'="ALL" D ; SINGLE SECTION REQUESTED
-"RTN","C0CFM1",29,0)
+"RTN","C0CFM1",28,0)
. S C0CVARS=$NA(@C0CGLB@(ZWHICH))
-"RTN","C0CFM1",30,0)
+"RTN","C0CFM1",29,0)
. D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION
-"RTN","C0CFM1",31,0)
+"RTN","C0CFM1",30,0)
E D ; MULTIPLE SECTIONS
-"RTN","C0CFM1",32,0)
+"RTN","C0CFM1",31,0)
. S C0CVARS=$NA(@C0CGLB)
-"RTN","C0CFM1",33,0)
+"RTN","C0CFM1",32,0)
. S C0CI=""
-"RTN","C0CFM1",34,0)
+"RTN","C0CFM1",33,0)
. F S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI="" D ;FOR EACH SECTION
-"RTN","C0CFM1",35,0)
+"RTN","C0CFM1",34,0)
. . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION
-"RTN","C0CFM1",36,0)
+"RTN","C0CFM1",35,0)
. . D PUTRIM1(DFN,C0CI,C0CVARSN)
+"RTN","C0CFM1",36,0)
+ Q
"RTN","C0CFM1",37,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)
+"RTN","C0CFM1",39,0)
; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1"
-"RTN","C0CFM1",41,0)
+"RTN","C0CFM1",40,0)
S C0CX=0
-"RTN","C0CFM1",42,0)
+"RTN","C0CFM1",41,0)
F S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX="" D ; FOR EACH OCCURANCE
-"RTN","C0CFM1",43,0)
+"RTN","C0CFM1",42,0)
. W "ZOCC=",C0CX,!
-"RTN","C0CFM1",44,0)
+"RTN","C0CFM1",43,0)
. S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE
-"RTN","C0CFM1",45,0)
+"RTN","C0CFM1",44,0)
. D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE
+"RTN","C0CFM1",45,0)
+ Q
"RTN","C0CFM1",46,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)
+"RTN","C0CFM1",48,0)
; ^C0C(171.201, DFN IS THE PATIENT IEN PASSED BY VALUE
-"RTN","C0CFM1",50,0)
+"RTN","C0CFM1",49,0)
; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
-"RTN","C0CFM1",51,0)
+"RTN","C0CFM1",50,0)
; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
-"RTN","C0CFM1",52,0)
+"RTN","C0CFM1",51,0)
; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
-"RTN","C0CFM1",53,0)
+"RTN","C0CFM1",52,0)
; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
-"RTN","C0CFM1",54,0)
+"RTN","C0CFM1",53,0)
; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
+"RTN","C0CFM1",54,0)
+ ;
"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)
+"RTN","C0CFM1",56,0)
; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
-"RTN","C0CFM1",58,0)
+"RTN","C0CFM1",57,0)
N ZF,ZFV S ZF=171.201 S ZFV=171.2012
-"RTN","C0CFM1",59,0)
+"RTN","C0CFM1",58,0)
S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS
-"RTN","C0CFM1",60,0)
+"RTN","C0CFM1",59,0)
N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER
-"RTN","C0CFM1",61,0)
+"RTN","C0CFM1",60,0)
N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
-"RTN","C0CFM1",62,0)
+"RTN","C0CFM1",61,0)
W "ZTYPE: ",ZTYPE," ",ZTYPN,!
-"RTN","C0CFM1",63,0)
+"RTN","C0CFM1",62,0)
N ZVARN ; IEN OF VARIABLE BEING PROCESSED
-"RTN","C0CFM1",64,0)
+"RTN","C0CFM1",63,0)
;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
-"RTN","C0CFM1",65,0)
+"RTN","C0CFM1",64,0)
S C0CFDA(ZF,"?+1,",.01)=DFN
-"RTN","C0CFM1",66,0)
+"RTN","C0CFM1",65,0)
S C0CFDA(ZF,"?+1,",.02)=ZSRC
-"RTN","C0CFM1",67,0)
+"RTN","C0CFM1",66,0)
S C0CFDA(ZF,"?+1,",.03)=ZTYPN
-"RTN","C0CFM1",68,0)
+"RTN","C0CFM1",67,0)
S C0CFDA(ZF,"?+1,",.04)=ZOCC ;CREATE OCCURANCE
-"RTN","C0CFM1",69,0)
+"RTN","C0CFM1",68,0)
K ZERR
-"RTN","C0CFM1",70,0)
+"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)
- I $D(ZERR) B ;OOPS
-"RTN","C0CFM1",72,0)
K C0CFDA
-"RTN","C0CFM1",73,0)
+"RTN","C0CFM1",72,0)
S ZD0=$O(^C0C(ZF,"C",DFN,ZSRC,ZTYPN,ZOCC,""))
-"RTN","C0CFM1",74,0)
+"RTN","C0CFM1",73,0)
W "RECORD NUMBER: ",ZD0,!
-"RTN","C0CFM1",75,0)
+"RTN","C0CFM1",74,0)
;B
-"RTN","C0CFM1",76,0)
+"RTN","C0CFM1",75,0)
S ZCNT=0
-"RTN","C0CFM1",77,0)
+"RTN","C0CFM1",76,0)
S ZC0CI="" ;
-"RTN","C0CFM1",78,0)
+"RTN","C0CFM1",77,0)
F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ;
-"RTN","C0CFM1",79,0)
+"RTN","C0CFM1",78,0)
. I ZC0CI'="M" D ; NOT A SUBVARIABLE
-"RTN","C0CFM1",80,0)
+"RTN","C0CFM1",79,0)
. . S ZCNT=ZCNT+1 ;INCREMENT COUNT
-"RTN","C0CFM1",81,0)
+"RTN","C0CFM1",80,0)
. . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
-"RTN","C0CFM1",82,0)
+"RTN","C0CFM1",81,0)
. . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
-"RTN","C0CFM1",83,0)
+"RTN","C0CFM1",82,0)
. . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN
-"RTN","C0CFM1",84,0)
+"RTN","C0CFM1",83,0)
. . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI)
-"RTN","C0CFM1",85,0)
+"RTN","C0CFM1",84,0)
. . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN
-"RTN","C0CFM1",86,0)
+"RTN","C0CFM1",85,0)
. . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI)
-"RTN","C0CFM1",87,0)
+"RTN","C0CFM1",86,0)
;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT"
-"RTN","C0CFM1",88,0)
+"RTN","C0CFM1",87,0)
;S GT1(170,"?+1,",12)="DIR"
-"RTN","C0CFM1",89,0)
+"RTN","C0CFM1",88,0)
;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT"
-"RTN","C0CFM1",90,0)
+"RTN","C0CFM1",89,0)
;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
-"RTN","C0CFM1",91,0)
+"RTN","C0CFM1",90,0)
D CLEAN^DILF
-"RTN","C0CFM1",92,0)
+"RTN","C0CFM1",91,0)
D UPDATE^DIE("","C0CFDA","","ZERR")
+"RTN","C0CFM1",92,0)
+ Q
"RTN","C0CFM1",93,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)
+"RTN","C0CFM1",95,0)
; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
-"RTN","C0CFM1",97,0)
+"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)
- ;
-"RTN","C0CFM1",99,0)
N ZCCRD,ZVARN,C0CFDA2
-"RTN","C0CFM1",100,0)
+"RTN","C0CFM1",99,0)
S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
-"RTN","C0CFM1",101,0)
+"RTN","C0CFM1",100,0)
S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
-"RTN","C0CFM1",102,0)
+"RTN","C0CFM1",101,0)
I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
-"RTN","C0CFM1",103,0)
+"RTN","C0CFM1",102,0)
. I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE
-"RTN","C0CFM1",104,0)
+"RTN","C0CFM1",103,0)
. . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
-"RTN","C0CFM1",105,0)
+"RTN","C0CFM1",104,0)
. S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
-"RTN","C0CFM1",106,0)
+"RTN","C0CFM1",105,0)
. S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
-"RTN","C0CFM1",107,0)
+"RTN","C0CFM1",106,0)
. D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
-"RTN","C0CFM1",108,0)
+"RTN","C0CFM1",107,0)
. D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
-"RTN","C0CFM1",109,0)
+"RTN","C0CFM1",108,0)
. I $D(ZERR) D ; LAYGO ERROR
-"RTN","C0CFM1",110,0)
+"RTN","C0CFM1",109,0)
. . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
-"RTN","C0CFM1",111,0)
+"RTN","C0CFM1",110,0)
. E D ;
-"RTN","C0CFM1",112,0)
+"RTN","C0CFM1",111,0)
. . D CLEAN^DILF ; CLEAN UP
-"RTN","C0CFM1",113,0)
+"RTN","C0CFM1",112,0)
. . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
-"RTN","C0CFM1",114,0)
+"RTN","C0CFM1",113,0)
. . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
-"RTN","C0CFM1",115,0)
+"RTN","C0CFM1",114,0)
Q ZVARN
+"RTN","C0CFM1",115,0)
+ ;
"RTN","C0CFM1",116,0)
- ;
-"RTN","C0CFM1",117,0)
BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,)
-"RTN","C0CFM1",118,0)
+"RTN","C0CFM1",117,0)
; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED
+"RTN","C0CFM1",118,0)
+ ;
"RTN","C0CFM1",119,0)
- ;
-"RTN","C0CFM1",120,0)
N C0CDIC,C0CNODE ;
-"RTN","C0CFM1",121,0)
+"RTN","C0CFM1",120,0)
S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY
-"RTN","C0CFM1",122,0)
+"RTN","C0CFM1",121,0)
S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE
+"RTN","C0CFM1",122,0)
+ Q
"RTN","C0CFM1",123,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)
+"RTN","C0CFM1",125,0)
; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET
-"RTN","C0CFM1",127,0)
+"RTN","C0CFM1",126,0)
; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS
-"RTN","C0CFM1",128,0)
+"RTN","C0CFM1",127,0)
; CONVERSION
-"RTN","C0CFM1",129,0)
+"RTN","C0CFM1",128,0)
;N C0CC,C0CI,C0CJ,C0CN,C0CZX
-"RTN","C0CFM1",130,0)
+"RTN","C0CFM1",129,0)
D FIELDS^C0CRNF("C0CC",170)
-"RTN","C0CFM1",131,0)
+"RTN","C0CFM1",130,0)
S C0CI=""
-"RTN","C0CFM1",132,0)
+"RTN","C0CFM1",131,0)
F S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI="" D ; EACH SECTION
-"RTN","C0CFM1",133,0)
+"RTN","C0CFM1",132,0)
. S C0CZX=""
-"RTN","C0CFM1",134,0)
+"RTN","C0CFM1",133,0)
. F S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX="" D ; EACH VARIABLE
-"RTN","C0CFM1",135,0)
+"RTN","C0CFM1",134,0)
. . W "SECTION ",C0CI," VAR ",C0CZX
-"RTN","C0CFM1",136,0)
+"RTN","C0CFM1",135,0)
. . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,""))
-"RTN","C0CFM1",137,0)
+"RTN","C0CFM1",136,0)
. . W " TYPE: ",C0CV,!
-"RTN","C0CFM1",138,0)
+"RTN","C0CFM1",137,0)
. . D SETFDA("SECTION",C0CV)
-"RTN","C0CFM1",139,0)
+"RTN","C0CFM1",138,0)
. . ;ZWR C0CFDA
+"RTN","C0CFM1",139,0)
+ Q
"RTN","C0CFM1",140,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)
+"RTN","C0CFM1",142,0)
; TO SET TO VALUE C0CSV.
-"RTN","C0CFM1",144,0)
+"RTN","C0CFM1",143,0)
; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
-"RTN","C0CFM1",145,0)
+"RTN","C0CFM1",144,0)
; C0CSN,C0CSV ARE PASSED BY VALUE
+"RTN","C0CFM1",145,0)
+ ;
"RTN","C0CFM1",146,0)
- ;
-"RTN","C0CFM1",147,0)
N C0CSI,C0CSJ
-"RTN","C0CFM1",148,0)
+"RTN","C0CFM1",147,0)
S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
-"RTN","C0CFM1",149,0)
+"RTN","C0CFM1",148,0)
S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
-"RTN","C0CFM1",150,0)
+"RTN","C0CFM1",149,0)
S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
-"RTN","C0CFM1",151,0)
+"RTN","C0CFM1",150,0)
Q
-"RTN","C0CFM1",152,0)
+"RTN","C0CFM1",151,0)
ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
-"RTN","C0CFM1",153,0)
+"RTN","C0CFM1",152,0)
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
+"RTN","C0CFM1",153,0)
+ ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
"RTN","C0CFM1",154,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
+ I '$D(ZTAB) S ZTAB="C0CA"
"RTN","C0CFM1",155,0)
- I '$D(ZTAB) S ZTAB="C0CA"
+ N ZR
"RTN","C0CFM1",156,0)
- N ZR
-"RTN","C0CFM1",157,0)
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
+"RTN","C0CFM1",157,0)
+ E S ZR=""
"RTN","C0CFM1",158,0)
- E S ZR=""
+ Q ZR
"RTN","C0CFM1",159,0)
- Q ZR
-"RTN","C0CFM1",160,0)
ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
-"RTN","C0CFM1",161,0)
+"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",162,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
+ I '$D(ZTAB) S ZTAB="C0CA"
"RTN","C0CFM1",163,0)
- I '$D(ZTAB) S ZTAB="C0CA"
+ N ZR
"RTN","C0CFM1",164,0)
- N ZR
-"RTN","C0CFM1",165,0)
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
+"RTN","C0CFM1",165,0)
+ E S ZR=""
"RTN","C0CFM1",166,0)
- E S ZR=""
+ Q ZR
"RTN","C0CFM1",167,0)
- Q ZR
-"RTN","C0CFM1",168,0)
;
-"RTN","C0CFM1",169,0)
+"RTN","C0CFM1",168,0)
ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
-"RTN","C0CFM1",170,0)
+"RTN","C0CFM1",169,0)
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
-"RTN","C0CFM1",171,0)
+"RTN","C0CFM1",170,0)
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CFM1",172,0)
+"RTN","C0CFM1",171,0)
I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CFM1",173,0)
+"RTN","C0CFM1",172,0)
N ZR
-"RTN","C0CFM1",174,0)
+"RTN","C0CFM1",173,0)
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
-"RTN","C0CFM1",175,0)
+"RTN","C0CFM1",174,0)
E S ZR=""
-"RTN","C0CFM1",176,0)
+"RTN","C0CFM1",175,0)
Q ZR
-"RTN","C0CFM1",177,0)
+"RTN","C0CFM1",176,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 .
"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)
- ;
-"RTN","C0CFM2",20,0)
W "This is the CCR FILEMAN Utility Library ",!
-"RTN","C0CFM2",21,0)
+"RTN","C0CFM2",20,0)
; THIS SET OF ROUTINES USE CCR E2 (^C0CE(, FILE 171.101) INSTEAD OF
-"RTN","C0CFM2",22,0)
+"RTN","C0CFM2",21,0)
; CCR ELEMENTS (^C0C(179.201,
-"RTN","C0CFM2",23,0)
+"RTN","C0CFM2",22,0)
; E2 IS A SIMPLIFICATION OF CCR ELEMENTS WHERE SUB-ELEMENTS ARE
-"RTN","C0CFM2",24,0)
+"RTN","C0CFM2",23,0)
; AT THE TOP LEVEL. OCCURANCE, THE 4TH PART OF THE KEY IS NOW FREE TEXT
-"RTN","C0CFM2",25,0)
+"RTN","C0CFM2",24,0)
; AND HAS THE FORM X;Y FOR SUB-ELEMENTS
-"RTN","C0CFM2",26,0)
+"RTN","C0CFM2",25,0)
; ALL SUB-VARIABLES HAVE BEEN REMOVED
-"RTN","C0CFM2",27,0)
+"RTN","C0CFM2",26,0)
W !
+"RTN","C0CFM2",27,0)
+ Q
"RTN","C0CFM2",28,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",30,0)
+ ;
"RTN","C0CFM2",31,0)
- ;
-"RTN","C0CFM2",32,0)
I '$D(RIMBASE) D ASETUP^C0CRIMA ; FOR COMMAND LINE CALLS
-"RTN","C0CFM2",33,0)
+"RTN","C0CFM2",32,0)
N ZI,ZJ,ZC,ZPATBASE
-"RTN","C0CFM2",34,0)
+"RTN","C0CFM2",33,0)
S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",ZWHICH))
-"RTN","C0CFM2",35,0)
+"RTN","C0CFM2",34,0)
S ZI=""
-"RTN","C0CFM2",36,0)
+"RTN","C0CFM2",35,0)
F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END
-"RTN","C0CFM2",37,0)
+"RTN","C0CFM2",36,0)
. S ZI=$O(@ZPATBASE@(ZI))
-"RTN","C0CFM2",38,0)
+"RTN","C0CFM2",37,0)
. D PUTRIM(ZI) ; EXPORT THE PATIENT TO A FILE
+"RTN","C0CFM2",38,0)
+ Q
"RTN","C0CFM2",39,0)
- Q
+ ;
"RTN","C0CFM2",40,0)
- ;
-"RTN","C0CFM2",41,0)
PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE
+"RTN","C0CFM2",41,0)
+ ;
"RTN","C0CFM2",42,0)
- ;
-"RTN","C0CFM2",43,0)
S C0CGLB=$NA(^TMP("C0CRIM","VARS",DFN))
-"RTN","C0CFM2",44,0)
+"RTN","C0CFM2",43,0)
I '$D(ZWHICH) S ZWHICH="ALL"
-"RTN","C0CFM2",45,0)
+"RTN","C0CFM2",44,0)
I ZWHICH'="ALL" D ; SINGLE SECTION REQUESTED
-"RTN","C0CFM2",46,0)
+"RTN","C0CFM2",45,0)
. S C0CVARS=$NA(@C0CGLB@(ZWHICH))
-"RTN","C0CFM2",47,0)
+"RTN","C0CFM2",46,0)
. D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION
-"RTN","C0CFM2",48,0)
+"RTN","C0CFM2",47,0)
E D ; MULTIPLE SECTIONS
-"RTN","C0CFM2",49,0)
+"RTN","C0CFM2",48,0)
. S C0CVARS=$NA(@C0CGLB)
-"RTN","C0CFM2",50,0)
+"RTN","C0CFM2",49,0)
. S C0CI=""
-"RTN","C0CFM2",51,0)
+"RTN","C0CFM2",50,0)
. F S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI="" D ;FOR EACH SECTION
-"RTN","C0CFM2",52,0)
+"RTN","C0CFM2",51,0)
. . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION
-"RTN","C0CFM2",53,0)
+"RTN","C0CFM2",52,0)
. . D PUTRIM1(DFN,C0CI,C0CVARSN)
+"RTN","C0CFM2",53,0)
+ Q
"RTN","C0CFM2",54,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)
+"RTN","C0CFM2",56,0)
; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1"
-"RTN","C0CFM2",58,0)
+"RTN","C0CFM2",57,0)
S C0CX=0
-"RTN","C0CFM2",59,0)
+"RTN","C0CFM2",58,0)
F S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX="" D ; FOR EACH OCCURANCE
-"RTN","C0CFM2",60,0)
+"RTN","C0CFM2",59,0)
. W "ZOCC=",C0CX,!
-"RTN","C0CFM2",61,0)
+"RTN","C0CFM2",60,0)
. K C0CMDO ; MULTIPLE SUBELEMENTS FOR THIS OCCURANCE PASSED BY NAME
-"RTN","C0CFM2",62,0)
+"RTN","C0CFM2",61,0)
. S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE
-"RTN","C0CFM2",63,0)
+"RTN","C0CFM2",62,0)
. D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE
-"RTN","C0CFM2",64,0)
+"RTN","C0CFM2",63,0)
. I $D(C0CMDO) D ; MULTIPLES TO HANDLE (THIS IS INSTEAD OF RECURSION :()
-"RTN","C0CFM2",65,0)
+"RTN","C0CFM2",64,0)
. . N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
-"RTN","C0CFM2",66,0)
+"RTN","C0CFM2",65,0)
. . S ZZCNT=0
-"RTN","C0CFM2",67,0)
+"RTN","C0CFM2",66,0)
. . S ZZC0CI=0
-"RTN","C0CFM2",68,0)
+"RTN","C0CFM2",67,0)
. . S ZZVALS=$NA(@C0CMDO@("M")) ; LOCATION OF THIS MULTILPE
-"RTN","C0CFM2",69,0)
+"RTN","C0CFM2",68,0)
. . S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
-"RTN","C0CFM2",70,0)
+"RTN","C0CFM2",69,0)
. . S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
-"RTN","C0CFM2",71,0)
+"RTN","C0CFM2",70,0)
. . W "MULTIPLE:",ZZVALS,!
+"RTN","C0CFM2",71,0)
+ . . ;B
"RTN","C0CFM2",72,0)
- . . ;B
-"RTN","C0CFM2",73,0)
. . F S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI="" D ; EACH MULTIPLE
-"RTN","C0CFM2",74,0)
+"RTN","C0CFM2",73,0)
. . . S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
-"RTN","C0CFM2",75,0)
+"RTN","C0CFM2",74,0)
. . . W "COUNT:",ZZCNT,!
-"RTN","C0CFM2",76,0)
+"RTN","C0CFM2",75,0)
. . . S ZV=$NA(@ZZVALS@(ZZC0CI))
-"RTN","C0CFM2",77,0)
+"RTN","C0CFM2",76,0)
. . . D PUTELS(DFN,ZT,C0CX_";"_ZZCNT,ZV)
+"RTN","C0CFM2",77,0)
+ Q
"RTN","C0CFM2",78,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",80,0)
+ ; 171.101, ^C0CE DFN IS THE PATIENT IEN PASSED BY VALUE
"RTN","C0CFM2",81,0)
- ; 171.101, ^C0CE DFN IS THE PATIENT IEN PASSED BY VALUE
+ ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
"RTN","C0CFM2",82,0)
- ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
+ ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
"RTN","C0CFM2",83,0)
- ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
+ ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
"RTN","C0CFM2",84,0)
- ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
+ ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
"RTN","C0CFM2",85,0)
- ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
+ ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
"RTN","C0CFM2",86,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)
+"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)
- ; 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)
+"RTN","C0CFM2",91,0)
N C0CFSRC S C0CFSRC=171.111 ; FILE AT CCR SOURCE LVL
-"RTN","C0CFM2",93,0)
+"RTN","C0CFM2",92,0)
N C0CFTYP S C0CFTYP=171.121 ; FILE AT ELEMENT TYPE LVL
-"RTN","C0CFM2",94,0)
+"RTN","C0CFM2",93,0)
N C0CFOCC S C0CFOCC=171.131 ; FILE AT OCCURANCE LVL
-"RTN","C0CFM2",95,0)
+"RTN","C0CFM2",94,0)
N C0CFVAR S C0CFVAR=171.1311 ; FILE AT VARIABLE LVL
-"RTN","C0CFM2",96,0)
+"RTN","C0CFM2",95,0)
;FILE IS ^C0CE(PAT,1,SCR,1,TYP,1,OCC,1,VAR,1, ...
-"RTN","C0CFM2",97,0)
+"RTN","C0CFM2",96,0)
; AND WE HAVE TO ADD THEM LEVEL AT A TIME I THINK
-"RTN","C0CFM2",98,0)
+"RTN","C0CFM2",97,0)
N C0CFDA
-"RTN","C0CFM2",99,0)
+"RTN","C0CFM2",98,0)
S C0CFDA(C0CFPAT,"?+1,",.01)=DFN
-"RTN","C0CFM2",100,0)
+"RTN","C0CFM2",99,0)
D UPDIE ; ADD THE PATIENT
-"RTN","C0CFM2",101,0)
+"RTN","C0CFM2",100,0)
S PATN=$O(^C0CE("B",DFN,"")) ; IEN FOR THE PATIENT
-"RTN","C0CFM2",102,0)
+"RTN","C0CFM2",101,0)
S C0CFDA(C0CFSRC,"?+1,"_PATN_",",.01)=ZSRC
-"RTN","C0CFM2",103,0)
+"RTN","C0CFM2",102,0)
D UPDIE ; ADD THE CCR SOURCE
-"RTN","C0CFM2",104,0)
+"RTN","C0CFM2",103,0)
N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,"")) ; FIND THE ELE TYPE
-"RTN","C0CFM2",105,0)
+"RTN","C0CFM2",104,0)
S C0CFDA(C0CFTYP,"?+1,"_ZSRC_","_PATN_",",.01)=ZTYPN
-"RTN","C0CFM2",106,0)
+"RTN","C0CFM2",105,0)
D UPDIE ; ADD THE ELEMENT TYPE
-"RTN","C0CFM2",107,0)
+"RTN","C0CFM2",106,0)
S ZTYP=$O(^C0CE(PATN,1,ZSRC,1,"B",ZTYPN,"")) ; IEN OF ELEMENT TYPE
-"RTN","C0CFM2",108,0)
+"RTN","C0CFM2",107,0)
S C0CFDA(C0CFOCC,"?+1,"_ZTYP_","_ZSRC_","_PATN_",",.01)=ZOCC ; STRING OCC
-"RTN","C0CFM2",109,0)
+"RTN","C0CFM2",108,0)
; OCC IS PRECEDED BY " " TO FORCE STRING STORAGE AND PRESERVE
-"RTN","C0CFM2",110,0)
+"RTN","C0CFM2",109,0)
; STRING COLLATION ON THE INDEX
-"RTN","C0CFM2",111,0)
+"RTN","C0CFM2",110,0)
D UPDIE ; ADD THE OCCURANCE
-"RTN","C0CFM2",112,0)
+"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)
- W "RECORD NUMBER: ",ZD0,!
-"RTN","C0CFM2",114,0)
;I ZD0=32 B
-"RTN","C0CFM2",115,0)
+"RTN","C0CFM2",114,0)
;I ZD0=31 B
-"RTN","C0CFM2",116,0)
+"RTN","C0CFM2",115,0)
N ZCNT,ZC0CI,ZVARN,C0CZ1
+"RTN","C0CFM2",116,0)
+ S ZCNT=0
"RTN","C0CFM2",117,0)
- S ZCNT=0
+ S ZC0CI="" ;
"RTN","C0CFM2",118,0)
- S ZC0CI="" ;
+ F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ;
"RTN","C0CFM2",119,0)
- F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ;
+ . I ZC0CI'="M" D ; NOT A SUBVARIABLE
"RTN","C0CFM2",120,0)
- . I ZC0CI'="M" D ; NOT A SUBVARIABLE
+ . . S ZCNT=ZCNT+1 ;INCREMENT COUNT
"RTN","C0CFM2",121,0)
- . . S ZCNT=ZCNT+1 ;INCREMENT COUNT
+ . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
"RTN","C0CFM2",122,0)
- . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
+ . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
"RTN","C0CFM2",123,0)
- . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
-"RTN","C0CFM2",124,0)
. . S C0CZ1=ZTYP_","_ZSRC_","_PATN_","
-"RTN","C0CFM2",125,0)
+"RTN","C0CFM2",124,0)
. . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,.01)=ZVARN
-"RTN","C0CFM2",126,0)
+"RTN","C0CFM2",125,0)
. . S ZZVAL=$TR(@ZVALS@(ZC0CI),"^","|")
-"RTN","C0CFM2",127,0)
+"RTN","C0CFM2",126,0)
. . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,1)=ZZVAL
-"RTN","C0CFM2",128,0)
+"RTN","C0CFM2",127,0)
. E D ; THIS IS A SUBELEMENT
-"RTN","C0CFM2",129,0)
+"RTN","C0CFM2",128,0)
. . ;PUT THE FOLLOWING BACK TO USE RECURSION
-"RTN","C0CFM2",130,0)
+"RTN","C0CFM2",129,0)
. . ;N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
-"RTN","C0CFM2",131,0)
+"RTN","C0CFM2",130,0)
. . ;S ZZCNT=0
-"RTN","C0CFM2",132,0)
+"RTN","C0CFM2",131,0)
. . ;S ZZC0CI=0
-"RTN","C0CFM2",133,0)
+"RTN","C0CFM2",132,0)
. . ;S ZZVALS=$NA(@ZVALS@("M")) ; LOCATION OF THIS MULTILPE
-"RTN","C0CFM2",134,0)
+"RTN","C0CFM2",133,0)
. . ;S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
-"RTN","C0CFM2",135,0)
+"RTN","C0CFM2",134,0)
. . ;S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
-"RTN","C0CFM2",136,0)
+"RTN","C0CFM2",135,0)
. . ;W "MULTIPLE:",ZZVALS,!
-"RTN","C0CFM2",137,0)
+"RTN","C0CFM2",136,0)
. . ;B
-"RTN","C0CFM2",138,0)
+"RTN","C0CFM2",137,0)
. . ;F S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI="" D ; EACH MULTIPLE
-"RTN","C0CFM2",139,0)
+"RTN","C0CFM2",138,0)
. . ;. S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
-"RTN","C0CFM2",140,0)
+"RTN","C0CFM2",139,0)
. . ;. W "COUNT:",ZZCNT,!
-"RTN","C0CFM2",141,0)
+"RTN","C0CFM2",140,0)
. . ;. S ZV=$NA(@ZZVALS@(ZZC0CI))
-"RTN","C0CFM2",142,0)
+"RTN","C0CFM2",141,0)
. . ;. D PUTELS(DFN,ZT,ZOCC_";"_ZZCNT,ZV) ; PUT THIS BACK TO DEBUG RECURSION
-"RTN","C0CFM2",143,0)
+"RTN","C0CFM2",142,0)
. . S C0CMDO=ZVALS ; FLAG TO HANDLE MULTIPLES (INSTEAD OF RECURSION)
-"RTN","C0CFM2",144,0)
+"RTN","C0CFM2",143,0)
D UPDIE ; UPDATE
+"RTN","C0CFM2",144,0)
+ Q
"RTN","C0CFM2",145,0)
- Q
+ ;
"RTN","C0CFM2",146,0)
- ;
-"RTN","C0CFM2",147,0)
UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+"RTN","C0CFM2",147,0)
+ K ZERR
"RTN","C0CFM2",148,0)
- K ZERR
+ D CLEAN^DILF
"RTN","C0CFM2",149,0)
- D CLEAN^DILF
+ D UPDATE^DIE("","C0CFDA","","ZERR")
"RTN","C0CFM2",150,0)
- D UPDATE^DIE("","C0CFDA","","ZERR")
+ I $D(ZERR) S $EC=",U1,"
"RTN","C0CFM2",151,0)
- I $D(ZERR) D ;
+ K C0CFDA
"RTN","C0CFM2",152,0)
- . W "ERROR",!
+ Q
"RTN","C0CFM2",153,0)
- . ZWR ZERR
+ ;
"RTN","C0CFM2",154,0)
- . B
-"RTN","C0CFM2",155,0)
- K C0CFDA
-"RTN","C0CFM2",156,0)
- Q
-"RTN","C0CFM2",157,0)
- ;
-"RTN","C0CFM2",158,0)
CHECK ; CHECKSUM EXPERIMENTS
-"RTN","C0CFM2",159,0)
+"RTN","C0CFM2",155,0)
;
-"RTN","C0CFM2",160,0)
+"RTN","C0CFM2",156,0)
;B
-"RTN","C0CFM2",161,0)
+"RTN","C0CFM2",157,0)
S ZG=$NA(^C0CE(DA(2),1,DA(1),1,DA))
-"RTN","C0CFM2",162,0)
+"RTN","C0CFM2",158,0)
;S G2=$NA(^C0CE(8,1,1,1,2,1,6))
-"RTN","C0CFM2",163,0)
+"RTN","C0CFM2",159,0)
S X=$$CHKSUM^XUSESIG1(ZG)
-"RTN","C0CFM2",164,0)
+"RTN","C0CFM2",160,0)
W G1,!
-"RTN","C0CFM2",165,0)
+"RTN","C0CFM2",161,0)
Q
-"RTN","C0CFM2",166,0)
+"RTN","C0CFM2",162,0)
;
-"RTN","C0CFM2",167,0)
+"RTN","C0CFM2",163,0)
CHKELS(DFN) ; CHECKSUM ALL ELEMENTS FOR A PATIENT
-"RTN","C0CFM2",168,0)
+"RTN","C0CFM2",164,0)
;
-"RTN","C0CFM2",169,0)
+"RTN","C0CFM2",165,0)
S ZGLB=$NA(^TMP("C0CCHK"))
-"RTN","C0CFM2",170,0)
+"RTN","C0CFM2",166,0)
S ZPAT=$O(^C0CE("B",DFN,""))
-"RTN","C0CFM2",171,0)
+"RTN","C0CFM2",167,0)
K @ZGLB@(ZPAT) ; CLEAR PREVIOUS CHECKSUMS
-"RTN","C0CFM2",172,0)
+"RTN","C0CFM2",168,0)
S ZSRC=""
-"RTN","C0CFM2",173,0)
+"RTN","C0CFM2",169,0)
F S ZSRC=$O(^C0CE(ZPAT,1,"B",ZSRC)) Q:ZSRC="" D ;
-"RTN","C0CFM2",174,0)
+"RTN","C0CFM2",170,0)
. W "PAT:",ZPAT," SRC:",ZSRC,!
-"RTN","C0CFM2",175,0)
+"RTN","C0CFM2",171,0)
. S ZEL=""
-"RTN","C0CFM2",176,0)
+"RTN","C0CFM2",172,0)
. F S ZEL=$O(^C0CE(ZPAT,1,ZSRC,1,"B",ZEL)) Q:ZEL="" D ;ELEMENTS
-"RTN","C0CFM2",177,0)
+"RTN","C0CFM2",173,0)
. . W "ELEMENT:",ZEL," "
-"RTN","C0CFM2",178,0)
+"RTN","C0CFM2",174,0)
. . S ZELE=$$GET1^DIQ(170.101,ZEL,.01,"E") ;ELEMENT NAME
-"RTN","C0CFM2",179,0)
+"RTN","C0CFM2",175,0)
. . W ZELE," "
-"RTN","C0CFM2",180,0)
+"RTN","C0CFM2",176,0)
. . S ZELI=$O(^C0CE(ZPAT,1,ZSRC,1,"B",ZEL,""))
-"RTN","C0CFM2",181,0)
+"RTN","C0CFM2",177,0)
. . S ZG=$NA(^C0CE(ZPAT,1,ZSRC,1,ZELI))
-"RTN","C0CFM2",182,0)
+"RTN","C0CFM2",178,0)
. . S ZCHK=$$CHKSUM^XUSESIG1(ZG) ; CHECKSUM FOR THE ELEMENT
-"RTN","C0CFM2",183,0)
+"RTN","C0CFM2",179,0)
. . W ZCHK,!
-"RTN","C0CFM2",184,0)
+"RTN","C0CFM2",180,0)
. . S @ZGLB@(ZPAT,ZELE,ZSRC)=ZCHK
-"RTN","C0CFM2",185,0)
- ZWR ^TMP("C0CCHK",ZPAT,*)
-"RTN","C0CFM2",186,0)
+"RTN","C0CFM2",181,0)
+ ; ZWR ^TMP("C0CCHK",ZPAT,*)
+"RTN","C0CFM2",182,0)
Q
-"RTN","C0CFM2",187,0)
+"RTN","C0CFM2",183,0)
;
-"RTN","C0CFM2",188,0)
+"RTN","C0CFM2",184,0)
DOIT(DFN) ; EXPERIMENT FOR TIMING CALLS USING mumps -dir DOIT^C0CFM2(DFN)
-"RTN","C0CFM2",189,0)
+"RTN","C0CFM2",185,0)
D SETXUP
-"RTN","C0CFM2",190,0)
+"RTN","C0CFM2",186,0)
D CHKELS(DFN)
-"RTN","C0CFM2",191,0)
+"RTN","C0CFM2",187,0)
Q
-"RTN","C0CFM2",192,0)
+"RTN","C0CFM2",188,0)
;
-"RTN","C0CFM2",193,0)
+"RTN","C0CFM2",189,0)
SETXUP ; SET UP ENVIRONMENT
-"RTN","C0CFM2",194,0)
+"RTN","C0CFM2",190,0)
S DISYS=19
-"RTN","C0CFM2",195,0)
+"RTN","C0CFM2",191,0)
S DT=3090325
-"RTN","C0CFM2",196,0)
+"RTN","C0CFM2",192,0)
S DTIME=300
-"RTN","C0CFM2",197,0)
+"RTN","C0CFM2",193,0)
S DUZ=1
-"RTN","C0CFM2",198,0)
+"RTN","C0CFM2",194,0)
S DUZ(0)="@"
-"RTN","C0CFM2",199,0)
+"RTN","C0CFM2",195,0)
S DUZ(1)=""
-"RTN","C0CFM2",200,0)
+"RTN","C0CFM2",196,0)
S DUZ(2)=7247
-"RTN","C0CFM2",201,0)
+"RTN","C0CFM2",197,0)
S DUZ("AG")="I"
-"RTN","C0CFM2",202,0)
+"RTN","C0CFM2",198,0)
S DUZ("BUF")=1
-"RTN","C0CFM2",203,0)
+"RTN","C0CFM2",199,0)
S DUZ("LANG")=""
-"RTN","C0CFM2",204,0)
+"RTN","C0CFM2",200,0)
S IO="/dev/pts/20"
-"RTN","C0CFM2",205,0)
+"RTN","C0CFM2",201,0)
S IO(0)="/dev/pts/20"
-"RTN","C0CFM2",206,0)
+"RTN","C0CFM2",202,0)
S IO(1,"/dev/pts/20")=""
-"RTN","C0CFM2",207,0)
+"RTN","C0CFM2",203,0)
S IO("ERROR")=""
-"RTN","C0CFM2",208,0)
+"RTN","C0CFM2",204,0)
S IO("HOME")="344^/dev/pts/20"
-"RTN","C0CFM2",209,0)
+"RTN","C0CFM2",205,0)
S IO("ZIO")="/dev/pts/20"
-"RTN","C0CFM2",210,0)
+"RTN","C0CFM2",206,0)
S IOBS="$C(8)"
-"RTN","C0CFM2",211,0)
+"RTN","C0CFM2",207,0)
S IOF="#,$C(27,91,50,74,27,91,72)"
-"RTN","C0CFM2",212,0)
+"RTN","C0CFM2",208,0)
S IOM=80
-"RTN","C0CFM2",213,0)
+"RTN","C0CFM2",209,0)
S ION="TELNET"
-"RTN","C0CFM2",214,0)
+"RTN","C0CFM2",210,0)
S IOS=344
-"RTN","C0CFM2",215,0)
+"RTN","C0CFM2",211,0)
S IOSL=24
-"RTN","C0CFM2",216,0)
+"RTN","C0CFM2",212,0)
S IOST="C-VT100"
-"RTN","C0CFM2",217,0)
+"RTN","C0CFM2",213,0)
S IOST(0)=9
-"RTN","C0CFM2",218,0)
+"RTN","C0CFM2",214,0)
S IOT="VTRM"
-"RTN","C0CFM2",219,0)
+"RTN","C0CFM2",215,0)
S IOXY="W $C(27,91)_((DY+1))_$C(59)_((DX+1))_$C(72)"
-"RTN","C0CFM2",220,0)
+"RTN","C0CFM2",216,0)
S U="^"
-"RTN","C0CFM2",221,0)
+"RTN","C0CFM2",217,0)
S X="216;DIC(4.2,"
-"RTN","C0CFM2",222,0)
+"RTN","C0CFM2",218,0)
S XPARSYS="216;DIC(4.2,"
-"RTN","C0CFM2",223,0)
+"RTN","C0CFM2",219,0)
S XQXFLG="^^XUP"
-"RTN","C0CFM2",224,0)
+"RTN","C0CFM2",220,0)
Q
-"RTN","C0CFM2",225,0)
+"RTN","C0CFM2",221,0)
;
-"RTN","C0CFM2",226,0)
-PUTELSOLD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
-"RTN","C0CFM2",227,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",228,0)
+"RTN","C0CFM2",224,0)
; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
-"RTN","C0CFM2",229,0)
+"RTN","C0CFM2",225,0)
; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
-"RTN","C0CFM2",230,0)
+"RTN","C0CFM2",226,0)
; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
-"RTN","C0CFM2",231,0)
+"RTN","C0CFM2",227,0)
; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
-"RTN","C0CFM2",232,0)
+"RTN","C0CFM2",228,0)
; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
-"RTN","C0CFM2",233,0)
+"RTN","C0CFM2",229,0)
;
-"RTN","C0CFM2",234,0)
+"RTN","C0CFM2",230,0)
S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1
-"RTN","C0CFM2",235,0)
+"RTN","C0CFM2",231,0)
; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
-"RTN","C0CFM2",236,0)
+"RTN","C0CFM2",232,0)
N ZF,ZFV S ZF=171.101 S ZFV=171.1011
-"RTN","C0CFM2",237,0)
+"RTN","C0CFM2",233,0)
;S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS
-"RTN","C0CFM2",238,0)
+"RTN","C0CFM2",234,0)
;N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER
-"RTN","C0CFM2",239,0)
+"RTN","C0CFM2",235,0)
N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
-"RTN","C0CFM2",240,0)
+"RTN","C0CFM2",236,0)
W "ZTYPE: ",ZTYPE," ",ZTYPN,!
-"RTN","C0CFM2",241,0)
+"RTN","C0CFM2",237,0)
N ZVARN ; IEN OF VARIABLE BEING PROCESSED
-"RTN","C0CFM2",242,0)
+"RTN","C0CFM2",238,0)
;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
-"RTN","C0CFM2",243,0)
+"RTN","C0CFM2",239,0)
K C0CFDA
-"RTN","C0CFM2",244,0)
+"RTN","C0CFM2",240,0)
S C0CFDA(ZF,"?+1,",.01)=DFN
-"RTN","C0CFM2",245,0)
+"RTN","C0CFM2",241,0)
S C0CFDA(ZF,"?+1,",.02)=ZSRC
-"RTN","C0CFM2",246,0)
+"RTN","C0CFM2",242,0)
S C0CFDA(ZF,"?+1,",.03)=ZTYPN
-"RTN","C0CFM2",247,0)
+"RTN","C0CFM2",243,0)
S C0CFDA(ZF,"?+1,",.04)=" "_ZOCC ;CREATE OCCURANCE
-"RTN","C0CFM2",248,0)
+"RTN","C0CFM2",244,0)
K ZERR
-"RTN","C0CFM2",249,0)
+"RTN","C0CFM2",245,0)
;B
-"RTN","C0CFM2",250,0)
+"RTN","C0CFM2",246,0)
D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
-"RTN","C0CFM2",251,0)
- I $D(ZERR) B ;OOPS
-"RTN","C0CFM2",252,0)
+"RTN","C0CFM2",247,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CFM2",248,0)
K C0CFDA
-"RTN","C0CFM2",253,0)
+"RTN","C0CFM2",249,0)
S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,""))
-"RTN","C0CFM2",254,0)
+"RTN","C0CFM2",250,0)
W "RECORD NUMBER: ",ZD0,!
-"RTN","C0CFM2",255,0)
- ;B
-"RTN","C0CFM2",256,0)
+"RTN","C0CFM2",251,0)
S ZCNT=0
-"RTN","C0CFM2",257,0)
+"RTN","C0CFM2",252,0)
S ZC0CI="" ;
-"RTN","C0CFM2",258,0)
+"RTN","C0CFM2",253,0)
F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ;
-"RTN","C0CFM2",259,0)
+"RTN","C0CFM2",254,0)
. I ZC0CI'="M" D ; NOT A SUBVARIABLE
-"RTN","C0CFM2",260,0)
+"RTN","C0CFM2",255,0)
. . S ZCNT=ZCNT+1 ;INCREMENT COUNT
-"RTN","C0CFM2",261,0)
+"RTN","C0CFM2",256,0)
. . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
-"RTN","C0CFM2",262,0)
+"RTN","C0CFM2",257,0)
. . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
-"RTN","C0CFM2",263,0)
+"RTN","C0CFM2",258,0)
. . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN
-"RTN","C0CFM2",264,0)
+"RTN","C0CFM2",259,0)
. . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI)
-"RTN","C0CFM2",265,0)
+"RTN","C0CFM2",260,0)
. . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN
-"RTN","C0CFM2",266,0)
+"RTN","C0CFM2",261,0)
. . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI)
-"RTN","C0CFM2",267,0)
+"RTN","C0CFM2",262,0)
;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT"
-"RTN","C0CFM2",268,0)
+"RTN","C0CFM2",263,0)
;S GT1(170,"?+1,",12)="DIR"
-"RTN","C0CFM2",269,0)
+"RTN","C0CFM2",264,0)
;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT"
-"RTN","C0CFM2",270,0)
+"RTN","C0CFM2",265,0)
;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
-"RTN","C0CFM2",271,0)
+"RTN","C0CFM2",266,0)
D CLEAN^DILF
-"RTN","C0CFM2",272,0)
+"RTN","C0CFM2",267,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)
+"RTN","C0CFM2",268,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CFM2",269,0)
K C0CFDA
-"RTN","C0CFM2",278,0)
+"RTN","C0CFM2",270,0)
Q
-"RTN","C0CFM2",279,0)
+"RTN","C0CFM2",271,0)
;
-"RTN","C0CFM2",280,0)
+"RTN","C0CFM2",272,0)
VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
-"RTN","C0CFM2",281,0)
+"RTN","C0CFM2",273,0)
; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
-"RTN","C0CFM2",282,0)
+"RTN","C0CFM2",274,0)
; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
-"RTN","C0CFM2",283,0)
+"RTN","C0CFM2",275,0)
;
-"RTN","C0CFM2",284,0)
+"RTN","C0CFM2",276,0)
N ZCCRD,ZVARN,C0CFDA2
-"RTN","C0CFM2",285,0)
+"RTN","C0CFM2",277,0)
S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
-"RTN","C0CFM2",286,0)
+"RTN","C0CFM2",278,0)
S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
-"RTN","C0CFM2",287,0)
+"RTN","C0CFM2",279,0)
I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
-"RTN","C0CFM2",288,0)
+"RTN","C0CFM2",280,0)
. I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE
-"RTN","C0CFM2",289,0)
+"RTN","C0CFM2",281,0)
. . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
-"RTN","C0CFM2",290,0)
+"RTN","C0CFM2",282,0)
. S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
-"RTN","C0CFM2",291,0)
+"RTN","C0CFM2",283,0)
. S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
-"RTN","C0CFM2",292,0)
+"RTN","C0CFM2",284,0)
. D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
-"RTN","C0CFM2",293,0)
+"RTN","C0CFM2",285,0)
. D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
-"RTN","C0CFM2",294,0)
+"RTN","C0CFM2",286,0)
. I $D(ZERR) D ; LAYGO ERROR
-"RTN","C0CFM2",295,0)
+"RTN","C0CFM2",287,0)
. . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
-"RTN","C0CFM2",296,0)
+"RTN","C0CFM2",288,0)
. E D ;
-"RTN","C0CFM2",297,0)
+"RTN","C0CFM2",289,0)
. . D CLEAN^DILF ; CLEAN UP
-"RTN","C0CFM2",298,0)
+"RTN","C0CFM2",290,0)
. . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
-"RTN","C0CFM2",299,0)
+"RTN","C0CFM2",291,0)
. . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
-"RTN","C0CFM2",300,0)
+"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",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)
+"RTN","C0CFM2",303,0)
; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET
-"RTN","C0CFM2",312,0)
+"RTN","C0CFM2",304,0)
; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS
-"RTN","C0CFM2",313,0)
+"RTN","C0CFM2",305,0)
; CONVERSION
-"RTN","C0CFM2",314,0)
+"RTN","C0CFM2",306,0)
;N C0CC,C0CI,C0CJ,C0CN,C0CZX
-"RTN","C0CFM2",315,0)
+"RTN","C0CFM2",307,0)
D FIELDS^C0CRNF("C0CC",170)
-"RTN","C0CFM2",316,0)
+"RTN","C0CFM2",308,0)
S C0CI=""
-"RTN","C0CFM2",317,0)
+"RTN","C0CFM2",309,0)
F S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI="" D ; EACH SECTION
-"RTN","C0CFM2",318,0)
+"RTN","C0CFM2",310,0)
. S C0CZX=""
-"RTN","C0CFM2",319,0)
+"RTN","C0CFM2",311,0)
. F S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX="" D ; EACH VARIABLE
-"RTN","C0CFM2",320,0)
+"RTN","C0CFM2",312,0)
. . W "SECTION ",C0CI," VAR ",C0CZX
-"RTN","C0CFM2",321,0)
+"RTN","C0CFM2",313,0)
. . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,""))
-"RTN","C0CFM2",322,0)
+"RTN","C0CFM2",314,0)
. . W " TYPE: ",C0CV,!
-"RTN","C0CFM2",323,0)
+"RTN","C0CFM2",315,0)
. . D SETFDA("SECTION",C0CV)
-"RTN","C0CFM2",324,0)
+"RTN","C0CFM2",316,0)
. . ;ZWR C0CFDA
-"RTN","C0CFM2",325,0)
+"RTN","C0CFM2",317,0)
Q
-"RTN","C0CFM2",326,0)
+"RTN","C0CFM2",318,0)
;
-"RTN","C0CFM2",327,0)
+"RTN","C0CFM2",319,0)
SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
-"RTN","C0CFM2",328,0)
+"RTN","C0CFM2",320,0)
; TO SET TO VALUE C0CSV.
-"RTN","C0CFM2",329,0)
+"RTN","C0CFM2",321,0)
; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
-"RTN","C0CFM2",330,0)
+"RTN","C0CFM2",322,0)
; C0CSN,C0CSV ARE PASSED BY VALUE
-"RTN","C0CFM2",331,0)
+"RTN","C0CFM2",323,0)
;
-"RTN","C0CFM2",332,0)
+"RTN","C0CFM2",324,0)
N C0CSI,C0CSJ
-"RTN","C0CFM2",333,0)
+"RTN","C0CFM2",325,0)
S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
-"RTN","C0CFM2",334,0)
+"RTN","C0CFM2",326,0)
S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
-"RTN","C0CFM2",335,0)
+"RTN","C0CFM2",327,0)
S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
-"RTN","C0CFM2",336,0)
+"RTN","C0CFM2",328,0)
Q
-"RTN","C0CFM2",337,0)
+"RTN","C0CFM2",329,0)
ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
-"RTN","C0CFM2",338,0)
+"RTN","C0CFM2",330,0)
; 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)
+ I '$D(ZTAB) S ZTAB="C0CA"
+"RTN","C0CFM2",333,0)
+ N ZR
+"RTN","C0CFM2",334,0)
+ I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
+"RTN","C0CFM2",335,0)
+ E S ZR=""
+"RTN","C0CFM2",336,0)
+ Q ZR
+"RTN","C0CFM2",337,0)
+ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
+"RTN","C0CFM2",338,0)
+ ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
"RTN","C0CFM2",339,0)
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
"RTN","C0CFM2",340,0)
@@ -100147,3161 +100183,3161 @@ ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
"RTN","C0CFM2",341,0)
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=""
"RTN","C0CFM2",344,0)
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)
-"RTN","C0CFM2",347,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CFM2",348,0)
- I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CFM2",349,0)
- N ZR
-"RTN","C0CFM2",350,0)
- I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
-"RTN","C0CFM2",351,0)
- E S ZR=""
-"RTN","C0CFM2",352,0)
- Q ZR
-"RTN","C0CFM2",353,0)
;
-"RTN","C0CFM2",354,0)
+"RTN","C0CFM2",346,0)
ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
-"RTN","C0CFM2",355,0)
+"RTN","C0CFM2",347,0)
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
-"RTN","C0CFM2",356,0)
+"RTN","C0CFM2",348,0)
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CFM2",357,0)
+"RTN","C0CFM2",349,0)
I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CFM2",358,0)
+"RTN","C0CFM2",350,0)
N ZR
-"RTN","C0CFM2",359,0)
+"RTN","C0CFM2",351,0)
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
-"RTN","C0CFM2",360,0)
+"RTN","C0CFM2",352,0)
E S ZR=""
-"RTN","C0CFM2",361,0)
+"RTN","C0CFM2",353,0)
Q ZR
-"RTN","C0CFM2",362,0)
+"RTN","C0CFM2",354,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 .
"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)
- ;
-"RTN","C0CFM3",20,0)
W "This is the CCR FILEMAN Utility Library ",!
-"RTN","C0CFM3",21,0)
+"RTN","C0CFM3",20,0)
; THIS SET OF ROUTINES USE CCR E2 (^C0CE(, FILE 171.101) INSTEAD OF
-"RTN","C0CFM3",22,0)
+"RTN","C0CFM3",21,0)
; CCR ELEMENTS (^C0C(179.201,
-"RTN","C0CFM3",23,0)
+"RTN","C0CFM3",22,0)
; E2 IS A SIMPLIFICATION OF CCR ELEMENTS WHERE SUB-ELEMENTS ARE
-"RTN","C0CFM3",24,0)
+"RTN","C0CFM3",23,0)
; AT THE TOP LEVEL. OCCURANCE, THE 4TH PART OF THE KEY IS NOW FREE TEXT
-"RTN","C0CFM3",25,0)
+"RTN","C0CFM3",24,0)
; AND HAS THE FORM X;Y FOR SUB-ELEMENTS
-"RTN","C0CFM3",26,0)
+"RTN","C0CFM3",25,0)
; ALL SUB-VARIABLES HAVE BEEN REMOVED
-"RTN","C0CFM3",27,0)
+"RTN","C0CFM3",26,0)
W !
+"RTN","C0CFM3",27,0)
+ Q
"RTN","C0CFM3",28,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",30,0)
; '
-"RTN","C0CFM3",32,0)
+"RTN","C0CFM3",31,0)
I '$D(RIMBASE) D ASETUP^GPLRIMA ; FOR COMMAND LINE CALLS
-"RTN","C0CFM3",33,0)
+"RTN","C0CFM3",32,0)
N ZI,ZJ,ZC,ZPATBASE
-"RTN","C0CFM3",34,0)
+"RTN","C0CFM3",33,0)
S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",ZWHICH))
-"RTN","C0CFM3",35,0)
+"RTN","C0CFM3",34,0)
S ZI=""
-"RTN","C0CFM3",36,0)
+"RTN","C0CFM3",35,0)
F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END
-"RTN","C0CFM3",37,0)
+"RTN","C0CFM3",36,0)
. S ZI=$O(@ZPATBASE@(ZI))
-"RTN","C0CFM3",38,0)
+"RTN","C0CFM3",37,0)
. D PUTRIM(ZI) ; EXPORT THE PATIENT TO A FILE
+"RTN","C0CFM3",38,0)
+ Q
"RTN","C0CFM3",39,0)
- Q
+ ;
"RTN","C0CFM3",40,0)
- ;
-"RTN","C0CFM3",41,0)
PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE
+"RTN","C0CFM3",41,0)
+ ;
"RTN","C0CFM3",42,0)
- ;
-"RTN","C0CFM3",43,0)
S C0CGLB=$NA(^TMP("C0CRIM","VARS",DFN))
-"RTN","C0CFM3",44,0)
+"RTN","C0CFM3",43,0)
I '$D(ZWHICH) S ZWHICH="ALL"
-"RTN","C0CFM3",45,0)
+"RTN","C0CFM3",44,0)
I ZWHICH'="ALL" D ; SINGLE SECTION REQUESTED
-"RTN","C0CFM3",46,0)
+"RTN","C0CFM3",45,0)
. S C0CVARS=$NA(@C0CGLB@(ZWHICH))
-"RTN","C0CFM3",47,0)
+"RTN","C0CFM3",46,0)
. D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION
-"RTN","C0CFM3",48,0)
+"RTN","C0CFM3",47,0)
E D ; MULTIPLE SECTIONS
-"RTN","C0CFM3",49,0)
+"RTN","C0CFM3",48,0)
. S C0CVARS=$NA(@C0CGLB)
-"RTN","C0CFM3",50,0)
+"RTN","C0CFM3",49,0)
. S C0CI=""
-"RTN","C0CFM3",51,0)
+"RTN","C0CFM3",50,0)
. F S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI="" D ;FOR EACH SECTION
-"RTN","C0CFM3",52,0)
+"RTN","C0CFM3",51,0)
. . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION
-"RTN","C0CFM3",53,0)
+"RTN","C0CFM3",52,0)
. . D PUTRIM1(DFN,C0CI,C0CVARSN)
+"RTN","C0CFM3",53,0)
+ Q
"RTN","C0CFM3",54,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)
+"RTN","C0CFM3",56,0)
; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1"
-"RTN","C0CFM3",58,0)
+"RTN","C0CFM3",57,0)
S C0CX=0
-"RTN","C0CFM3",59,0)
+"RTN","C0CFM3",58,0)
F S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX="" D ; FOR EACH OCCURANCE
-"RTN","C0CFM3",60,0)
+"RTN","C0CFM3",59,0)
. W "ZOCC=",C0CX,!
-"RTN","C0CFM3",61,0)
+"RTN","C0CFM3",60,0)
. K C0CMDO ; MULTIPLE SUBELEMENTS FOR THIS OCCURANCE PASSED BY NAME
-"RTN","C0CFM3",62,0)
+"RTN","C0CFM3",61,0)
. S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE
-"RTN","C0CFM3",63,0)
+"RTN","C0CFM3",62,0)
. D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE
-"RTN","C0CFM3",64,0)
+"RTN","C0CFM3",63,0)
. I $D(C0CMDO) D ; MULTIPLES TO HANDLE (THIS IS INSTEAD OF RECURSION :()
-"RTN","C0CFM3",65,0)
+"RTN","C0CFM3",64,0)
. . N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
-"RTN","C0CFM3",66,0)
+"RTN","C0CFM3",65,0)
. . S ZZCNT=0
-"RTN","C0CFM3",67,0)
+"RTN","C0CFM3",66,0)
. . S ZZC0CI=0
-"RTN","C0CFM3",68,0)
+"RTN","C0CFM3",67,0)
. . S ZZVALS=$NA(@C0CMDO@("M")) ; LOCATION OF THIS MULTILPE
-"RTN","C0CFM3",69,0)
+"RTN","C0CFM3",68,0)
. . S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
-"RTN","C0CFM3",70,0)
+"RTN","C0CFM3",69,0)
. . S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
-"RTN","C0CFM3",71,0)
+"RTN","C0CFM3",70,0)
. . W "MULTIPLE:",ZZVALS,!
+"RTN","C0CFM3",71,0)
+ . . ;B
"RTN","C0CFM3",72,0)
- . . ;B
-"RTN","C0CFM3",73,0)
. . F S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI="" D ; EACH MULTIPLE
-"RTN","C0CFM3",74,0)
+"RTN","C0CFM3",73,0)
. . . S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
-"RTN","C0CFM3",75,0)
+"RTN","C0CFM3",74,0)
. . . W "COUNT:",ZZCNT,!
-"RTN","C0CFM3",76,0)
+"RTN","C0CFM3",75,0)
. . . S ZV=$NA(@ZZVALS@(ZZC0CI))
-"RTN","C0CFM3",77,0)
+"RTN","C0CFM3",76,0)
. . . D PUTELS(DFN,ZT,C0CX_";"_ZZCNT,ZV)
+"RTN","C0CFM3",77,0)
+ Q
"RTN","C0CFM3",78,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)
+"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)
- ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
+ ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
"RTN","C0CFM3",83,0)
- ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
+ ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
"RTN","C0CFM3",84,0)
- ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
+ ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
"RTN","C0CFM3",85,0)
- ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
+ ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
"RTN","C0CFM3",86,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",88,0)
+ S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1
"RTN","C0CFM3",89,0)
- S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1
+ ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
"RTN","C0CFM3",90,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)
+"RTN","C0CFM3",91,0)
N C0CFV S C0CFV=171.6011 ; FILE AT VARIABLE LVL
-"RTN","C0CFM3",93,0)
+"RTN","C0CFM3",92,0)
N C0CFDA
+"RTN","C0CFM3",93,0)
+ N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
"RTN","C0CFM3",94,0)
- N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
+ W "ZTYPE: ",ZTYPE," ",ZTYPN,!
"RTN","C0CFM3",95,0)
- W "ZTYPE: ",ZTYPE," ",ZTYPN,!
+ N ZVARN ; IEN OF VARIABLE BEING PROCESSED
"RTN","C0CFM3",96,0)
- N ZVARN ; IEN OF VARIABLE BEING PROCESSED
+ ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
"RTN","C0CFM3",97,0)
- ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
-"RTN","C0CFM3",98,0)
S C0CFDA(C0CF,"+1,",.01)=ZTYPN
-"RTN","C0CFM3",99,0)
+"RTN","C0CFM3",98,0)
S C0CFDA(C0CF,"+1,",.02)=DFN
-"RTN","C0CFM3",100,0)
+"RTN","C0CFM3",99,0)
S C0CFDA(C0CF,"+1,",.03)=ZSRC
-"RTN","C0CFM3",101,0)
+"RTN","C0CFM3",100,0)
S C0CFDA(C0CF,"+1,",.04)=" "_ZOCC ;CREATE OCCURANCE with leading space
-"RTN","C0CFM3",102,0)
+"RTN","C0CFM3",101,0)
D UPDIE ; CREATE THE RECORD
-"RTN","C0CFM3",103,0)
+"RTN","C0CFM3",102,0)
S C0CIEN=$O(^C0CE4("C",DFN,ZSRC,ZTYPN," "_ZOCC,""))
-"RTN","C0CFM3",104,0)
+"RTN","C0CFM3",103,0)
N ZCNT,ZC0CI,ZVARN,C0CZ1
+"RTN","C0CFM3",104,0)
+ S ZCNT=0
"RTN","C0CFM3",105,0)
- S ZCNT=0
+ S ZC0CI="" ;
"RTN","C0CFM3",106,0)
- S ZC0CI="" ;
+ F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ;
"RTN","C0CFM3",107,0)
- F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ;
+ . I ZC0CI'="M" D ; NOT A SUBVARIABLE
"RTN","C0CFM3",108,0)
- . I ZC0CI'="M" D ; NOT A SUBVARIABLE
+ . . S ZCNT=ZCNT+1 ;INCREMENT COUNT
"RTN","C0CFM3",109,0)
- . . S ZCNT=ZCNT+1 ;INCREMENT COUNT
+ . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
"RTN","C0CFM3",110,0)
- . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
+ . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
"RTN","C0CFM3",111,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)
+"RTN","C0CFM3",112,0)
. . S C0CFDA(C0CFV,"+"_ZCNT_","_C0CIEN_",",1)=@ZVALS@(ZC0CI)
-"RTN","C0CFM3",114,0)
+"RTN","C0CFM3",113,0)
. E D ; THIS IS A SUBELEMENT
-"RTN","C0CFM3",115,0)
+"RTN","C0CFM3",114,0)
. . ;PUT THE FOLLOWING BACK TO USE RECURSION
-"RTN","C0CFM3",116,0)
+"RTN","C0CFM3",115,0)
. . ;N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
-"RTN","C0CFM3",117,0)
+"RTN","C0CFM3",116,0)
. . ;S ZZCNT=0
-"RTN","C0CFM3",118,0)
+"RTN","C0CFM3",117,0)
. . ;S ZZC0CI=0
-"RTN","C0CFM3",119,0)
+"RTN","C0CFM3",118,0)
. . ;S ZZVALS=$NA(@ZVALS@("M")) ; LOCATION OF THIS MULTILPE
-"RTN","C0CFM3",120,0)
+"RTN","C0CFM3",119,0)
. . ;S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
-"RTN","C0CFM3",121,0)
+"RTN","C0CFM3",120,0)
. . ;S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
-"RTN","C0CFM3",122,0)
+"RTN","C0CFM3",121,0)
. . ;W "MULTIPLE:",ZZVALS,!
-"RTN","C0CFM3",123,0)
+"RTN","C0CFM3",122,0)
. . ;B
-"RTN","C0CFM3",124,0)
+"RTN","C0CFM3",123,0)
. . ;F S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI="" D ; EACH MULTIPLE
-"RTN","C0CFM3",125,0)
+"RTN","C0CFM3",124,0)
. . ;. S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
-"RTN","C0CFM3",126,0)
+"RTN","C0CFM3",125,0)
. . ;. W "COUNT:",ZZCNT,!
-"RTN","C0CFM3",127,0)
+"RTN","C0CFM3",126,0)
. . ;. S ZV=$NA(@ZZVALS@(ZZC0CI))
-"RTN","C0CFM3",128,0)
+"RTN","C0CFM3",127,0)
. . ;. D PUTELS(DFN,ZT,ZOCC_";"_ZZCNT,ZV) ; PUT THIS BACK TO DEBUG RECURSION
-"RTN","C0CFM3",129,0)
+"RTN","C0CFM3",128,0)
. . S C0CMDO=ZVALS ; FLAG TO HANDLE MULTIPLES (INSTEAD OF RECURSION)
-"RTN","C0CFM3",130,0)
+"RTN","C0CFM3",129,0)
D UPDIE ; UPDATE
+"RTN","C0CFM3",130,0)
+ Q
"RTN","C0CFM3",131,0)
- Q
+ ;
"RTN","C0CFM3",132,0)
- ;
-"RTN","C0CFM3",133,0)
UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+"RTN","C0CFM3",133,0)
+ K ZERR
"RTN","C0CFM3",134,0)
- K ZERR
+ D CLEAN^DILF
"RTN","C0CFM3",135,0)
- D CLEAN^DILF
+ D UPDATE^DIE("","C0CFDA","","ZERR")
"RTN","C0CFM3",136,0)
- D UPDATE^DIE("","C0CFDA","","ZERR")
+ I $D(ZERR) S $EC=",U1,"
"RTN","C0CFM3",137,0)
- I $D(ZERR) D ;
+ K C0CFDA
"RTN","C0CFM3",138,0)
- . W "ERROR",!
+ Q
"RTN","C0CFM3",139,0)
- . ZWR ZERR
+ ;
"RTN","C0CFM3",140,0)
- . B
+PUTELSO(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
"RTN","C0CFM3",141,0)
- K C0CFDA
-"RTN","C0CFM3",142,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)
+"RTN","C0CFM3",142,0)
; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
-"RTN","C0CFM3",147,0)
+"RTN","C0CFM3",143,0)
; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
-"RTN","C0CFM3",148,0)
+"RTN","C0CFM3",144,0)
; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
-"RTN","C0CFM3",149,0)
+"RTN","C0CFM3",145,0)
; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
-"RTN","C0CFM3",150,0)
+"RTN","C0CFM3",146,0)
; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
-"RTN","C0CFM3",151,0)
+"RTN","C0CFM3",147,0)
;
-"RTN","C0CFM3",152,0)
+"RTN","C0CFM3",148,0)
S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1
-"RTN","C0CFM3",153,0)
+"RTN","C0CFM3",149,0)
; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
-"RTN","C0CFM3",154,0)
+"RTN","C0CFM3",150,0)
N ZF,ZFV S ZF=171.101 S ZFV=171.1011
-"RTN","C0CFM3",155,0)
+"RTN","C0CFM3",151,0)
;S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS
-"RTN","C0CFM3",156,0)
+"RTN","C0CFM3",152,0)
;N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER
-"RTN","C0CFM3",157,0)
+"RTN","C0CFM3",153,0)
N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
-"RTN","C0CFM3",158,0)
+"RTN","C0CFM3",154,0)
W "ZTYPE: ",ZTYPE," ",ZTYPN,!
-"RTN","C0CFM3",159,0)
+"RTN","C0CFM3",155,0)
N ZVARN ; IEN OF VARIABLE BEING PROCESSED
-"RTN","C0CFM3",160,0)
+"RTN","C0CFM3",156,0)
;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
-"RTN","C0CFM3",161,0)
+"RTN","C0CFM3",157,0)
K C0CFDA
-"RTN","C0CFM3",162,0)
+"RTN","C0CFM3",158,0)
S C0CFDA(ZF,"?+1,",.01)=DFN
-"RTN","C0CFM3",163,0)
+"RTN","C0CFM3",159,0)
S C0CFDA(ZF,"?+1,",.02)=ZSRC
-"RTN","C0CFM3",164,0)
+"RTN","C0CFM3",160,0)
S C0CFDA(ZF,"?+1,",.03)=ZTYPN
-"RTN","C0CFM3",165,0)
+"RTN","C0CFM3",161,0)
S C0CFDA(ZF,"?+1,",.04)=" "_ZOCC ;CREATE OCCURANCE
-"RTN","C0CFM3",166,0)
+"RTN","C0CFM3",162,0)
K ZERR
-"RTN","C0CFM3",167,0)
+"RTN","C0CFM3",163,0)
;B
-"RTN","C0CFM3",168,0)
+"RTN","C0CFM3",164,0)
D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
-"RTN","C0CFM3",169,0)
- I $D(ZERR) B ;OOPS
-"RTN","C0CFM3",170,0)
+"RTN","C0CFM3",165,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CFM3",166,0)
K C0CFDA
-"RTN","C0CFM3",171,0)
+"RTN","C0CFM3",167,0)
S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,""))
-"RTN","C0CFM3",172,0)
+"RTN","C0CFM3",168,0)
W "RECORD NUMBER: ",ZD0,!
-"RTN","C0CFM3",173,0)
+"RTN","C0CFM3",169,0)
;B
-"RTN","C0CFM3",174,0)
+"RTN","C0CFM3",170,0)
S ZCNT=0
-"RTN","C0CFM3",175,0)
+"RTN","C0CFM3",171,0)
S ZC0CI="" ;
-"RTN","C0CFM3",176,0)
+"RTN","C0CFM3",172,0)
F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ;
-"RTN","C0CFM3",177,0)
+"RTN","C0CFM3",173,0)
. I ZC0CI'="M" D ; NOT A SUBVARIABLE
-"RTN","C0CFM3",178,0)
+"RTN","C0CFM3",174,0)
. . S ZCNT=ZCNT+1 ;INCREMENT COUNT
-"RTN","C0CFM3",179,0)
+"RTN","C0CFM3",175,0)
. . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
-"RTN","C0CFM3",180,0)
+"RTN","C0CFM3",176,0)
. . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
-"RTN","C0CFM3",181,0)
+"RTN","C0CFM3",177,0)
. . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN
-"RTN","C0CFM3",182,0)
+"RTN","C0CFM3",178,0)
. . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI)
-"RTN","C0CFM3",183,0)
+"RTN","C0CFM3",179,0)
. . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN
-"RTN","C0CFM3",184,0)
+"RTN","C0CFM3",180,0)
. . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI)
-"RTN","C0CFM3",185,0)
+"RTN","C0CFM3",181,0)
;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT"
-"RTN","C0CFM3",186,0)
+"RTN","C0CFM3",182,0)
;S GT1(170,"?+1,",12)="DIR"
-"RTN","C0CFM3",187,0)
+"RTN","C0CFM3",183,0)
;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT"
-"RTN","C0CFM3",188,0)
+"RTN","C0CFM3",184,0)
;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
-"RTN","C0CFM3",189,0)
+"RTN","C0CFM3",185,0)
D CLEAN^DILF
-"RTN","C0CFM3",190,0)
+"RTN","C0CFM3",186,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)
+"RTN","C0CFM3",187,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CFM3",188,0)
K C0CFDA
-"RTN","C0CFM3",196,0)
+"RTN","C0CFM3",189,0)
Q
-"RTN","C0CFM3",197,0)
+"RTN","C0CFM3",190,0)
;
-"RTN","C0CFM3",198,0)
+"RTN","C0CFM3",191,0)
VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
-"RTN","C0CFM3",199,0)
+"RTN","C0CFM3",192,0)
; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
-"RTN","C0CFM3",200,0)
+"RTN","C0CFM3",193,0)
; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
-"RTN","C0CFM3",201,0)
+"RTN","C0CFM3",194,0)
;
-"RTN","C0CFM3",202,0)
+"RTN","C0CFM3",195,0)
N ZCCRD,ZVARN,C0CFDA2
-"RTN","C0CFM3",203,0)
+"RTN","C0CFM3",196,0)
S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
-"RTN","C0CFM3",204,0)
+"RTN","C0CFM3",197,0)
S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
-"RTN","C0CFM3",205,0)
+"RTN","C0CFM3",198,0)
I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
-"RTN","C0CFM3",206,0)
+"RTN","C0CFM3",199,0)
. I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE
-"RTN","C0CFM3",207,0)
+"RTN","C0CFM3",200,0)
. . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
-"RTN","C0CFM3",208,0)
+"RTN","C0CFM3",201,0)
. S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
-"RTN","C0CFM3",209,0)
+"RTN","C0CFM3",202,0)
. S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
-"RTN","C0CFM3",210,0)
+"RTN","C0CFM3",203,0)
. D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
-"RTN","C0CFM3",211,0)
+"RTN","C0CFM3",204,0)
. D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
-"RTN","C0CFM3",212,0)
+"RTN","C0CFM3",205,0)
. I $D(ZERR) D ; LAYGO ERROR
-"RTN","C0CFM3",213,0)
+"RTN","C0CFM3",206,0)
. . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
-"RTN","C0CFM3",214,0)
+"RTN","C0CFM3",207,0)
. E D ;
-"RTN","C0CFM3",215,0)
+"RTN","C0CFM3",208,0)
. . D CLEAN^DILF ; CLEAN UP
-"RTN","C0CFM3",216,0)
+"RTN","C0CFM3",209,0)
. . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
-"RTN","C0CFM3",217,0)
+"RTN","C0CFM3",210,0)
. . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
-"RTN","C0CFM3",218,0)
+"RTN","C0CFM3",211,0)
Q ZVARN
-"RTN","C0CFM3",219,0)
+"RTN","C0CFM3",212,0)
;
-"RTN","C0CFM3",220,0)
+"RTN","C0CFM3",213,0)
BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,)
-"RTN","C0CFM3",221,0)
+"RTN","C0CFM3",214,0)
; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED
-"RTN","C0CFM3",222,0)
+"RTN","C0CFM3",215,0)
;
-"RTN","C0CFM3",223,0)
+"RTN","C0CFM3",216,0)
N C0CDIC,C0CNODE ;
-"RTN","C0CFM3",224,0)
+"RTN","C0CFM3",217,0)
S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY
-"RTN","C0CFM3",225,0)
+"RTN","C0CFM3",218,0)
S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE
-"RTN","C0CFM3",226,0)
+"RTN","C0CFM3",219,0)
Q
-"RTN","C0CFM3",227,0)
+"RTN","C0CFM3",220,0)
;
-"RTN","C0CFM3",228,0)
+"RTN","C0CFM3",221,0)
FIXSEC ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED
-"RTN","C0CFM3",229,0)
+"RTN","C0CFM3",222,0)
; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET
-"RTN","C0CFM3",230,0)
+"RTN","C0CFM3",223,0)
; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS
-"RTN","C0CFM3",231,0)
+"RTN","C0CFM3",224,0)
; CONVERSION
-"RTN","C0CFM3",232,0)
+"RTN","C0CFM3",225,0)
;N C0CC,C0CI,C0CJ,C0CN,C0CZX
-"RTN","C0CFM3",233,0)
+"RTN","C0CFM3",226,0)
D FIELDS^C0CRNF("C0CC",170)
-"RTN","C0CFM3",234,0)
+"RTN","C0CFM3",227,0)
S C0CI=""
-"RTN","C0CFM3",235,0)
+"RTN","C0CFM3",228,0)
F S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI="" D ; EACH SECTION
-"RTN","C0CFM3",236,0)
+"RTN","C0CFM3",229,0)
. S C0CZX=""
-"RTN","C0CFM3",237,0)
+"RTN","C0CFM3",230,0)
. F S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX="" D ; EACH VARIABLE
-"RTN","C0CFM3",238,0)
+"RTN","C0CFM3",231,0)
. . W "SECTION ",C0CI," VAR ",C0CZX
-"RTN","C0CFM3",239,0)
+"RTN","C0CFM3",232,0)
. . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,""))
-"RTN","C0CFM3",240,0)
+"RTN","C0CFM3",233,0)
. . W " TYPE: ",C0CV,!
-"RTN","C0CFM3",241,0)
+"RTN","C0CFM3",234,0)
. . D SETFDA("SECTION",C0CV)
-"RTN","C0CFM3",242,0)
+"RTN","C0CFM3",235,0)
. . ;ZWR C0CFDA
-"RTN","C0CFM3",243,0)
+"RTN","C0CFM3",236,0)
Q
-"RTN","C0CFM3",244,0)
+"RTN","C0CFM3",237,0)
;
-"RTN","C0CFM3",245,0)
+"RTN","C0CFM3",238,0)
SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
-"RTN","C0CFM3",246,0)
+"RTN","C0CFM3",239,0)
; TO SET TO VALUE C0CSV.
-"RTN","C0CFM3",247,0)
+"RTN","C0CFM3",240,0)
; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
-"RTN","C0CFM3",248,0)
+"RTN","C0CFM3",241,0)
; C0CSN,C0CSV ARE PASSED BY VALUE
-"RTN","C0CFM3",249,0)
+"RTN","C0CFM3",242,0)
;
-"RTN","C0CFM3",250,0)
+"RTN","C0CFM3",243,0)
N C0CSI,C0CSJ
-"RTN","C0CFM3",251,0)
+"RTN","C0CFM3",244,0)
S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
-"RTN","C0CFM3",252,0)
+"RTN","C0CFM3",245,0)
S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
-"RTN","C0CFM3",253,0)
+"RTN","C0CFM3",246,0)
S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
-"RTN","C0CFM3",254,0)
+"RTN","C0CFM3",247,0)
Q
-"RTN","C0CFM3",255,0)
+"RTN","C0CFM3",248,0)
ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
-"RTN","C0CFM3",256,0)
+"RTN","C0CFM3",249,0)
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
-"RTN","C0CFM3",257,0)
+"RTN","C0CFM3",250,0)
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CFM3",258,0)
+"RTN","C0CFM3",251,0)
I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CFM3",259,0)
+"RTN","C0CFM3",252,0)
N ZR
-"RTN","C0CFM3",260,0)
+"RTN","C0CFM3",253,0)
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
-"RTN","C0CFM3",261,0)
+"RTN","C0CFM3",254,0)
E S ZR=""
-"RTN","C0CFM3",262,0)
+"RTN","C0CFM3",255,0)
Q ZR
-"RTN","C0CFM3",263,0)
+"RTN","C0CFM3",256,0)
ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
-"RTN","C0CFM3",264,0)
+"RTN","C0CFM3",257,0)
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
-"RTN","C0CFM3",265,0)
+"RTN","C0CFM3",258,0)
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CFM3",266,0)
+"RTN","C0CFM3",259,0)
I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CFM3",267,0)
+"RTN","C0CFM3",260,0)
N ZR
-"RTN","C0CFM3",268,0)
+"RTN","C0CFM3",261,0)
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
-"RTN","C0CFM3",269,0)
+"RTN","C0CFM3",262,0)
E S ZR=""
-"RTN","C0CFM3",270,0)
+"RTN","C0CFM3",263,0)
Q ZR
-"RTN","C0CFM3",271,0)
+"RTN","C0CFM3",264,0)
;
-"RTN","C0CFM3",272,0)
+"RTN","C0CFM3",265,0)
ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
-"RTN","C0CFM3",273,0)
+"RTN","C0CFM3",266,0)
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
-"RTN","C0CFM3",274,0)
+"RTN","C0CFM3",267,0)
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CFM3",275,0)
+"RTN","C0CFM3",268,0)
I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CFM3",276,0)
+"RTN","C0CFM3",269,0)
N ZR
-"RTN","C0CFM3",277,0)
+"RTN","C0CFM3",270,0)
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
-"RTN","C0CFM3",278,0)
+"RTN","C0CFM3",271,0)
E S ZR=""
-"RTN","C0CFM3",279,0)
+"RTN","C0CFM3",272,0)
Q ZR
-"RTN","C0CFM3",280,0)
+"RTN","C0CFM3",273,0)
;
-"RTN","C0CFM3",281,0)
+"RTN","C0CFM3",274,0)
SHOWE4(DFN) ;
-"RTN","C0CFM3",282,0)
+"RTN","C0CFM3",275,0)
;
-"RTN","C0CFM3",283,0)
+"RTN","C0CFM3",276,0)
N ZG
-"RTN","C0CFM3",284,0)
+"RTN","C0CFM3",277,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)
+"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",287,0)
+"RTN","C0CFM3",281,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.
-"RTN","C0CIM2",16,0)
;
+"RTN","C0CIM2",15,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CIM2",16,0)
+ ; along with this program. If not, see .
"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)
- Q
+ ; IMMXML AND IMMOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
"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)
+"RTN","C0CIM2",25,0)
; THAT GET PASSED TO *GET ROUTINES
-"RTN","C0CIM2",29,0)
+"RTN","C0CIM2",26,0)
;C0C[NAME]=$NA(^TMP("C0CCCR",$J,DFN,"C0C(NAME))
-"RTN","C0CIM2",30,0)
+"RTN","C0CIM2",27,0)
N C0CIMM
-"RTN","C0CIM2",31,0)
+"RTN","C0CIM2",28,0)
S C0CIMM=$NA(^TMP("C0CCCR",$J,DFN,"C0CIMM"))
-"RTN","C0CIM2",32,0)
+"RTN","C0CIM2",29,0)
; USE THE FOLLOWING TEMPLATE FOR GETTING/GENERATING THE RNF2 ARRAYS
-"RTN","C0CIM2",33,0)
+"RTN","C0CIM2",30,0)
; THAT GET INSERTED INTO THE XML TEMPLATE
-"RTN","C0CIM2",34,0)
+"RTN","C0CIM2",31,0)
; I '$D(@C0CIMM) D GET[VISTA/RPMS](DFN,C0CIMM) ; GET VARS IF NOT THERE
-"RTN","C0CIM2",35,0)
+"RTN","C0CIM2",32,0)
D GETRPMS(DFN,C0CIMM) ; GET VARS IF NOT THERE
-"RTN","C0CIM2",36,0)
+"RTN","C0CIM2",33,0)
; USE THE FOLLOWING TEMPATE FOR MAPPING RNF2 ARRAYS TO XML TEMPLATE
-"RTN","C0CIM2",37,0)
+"RTN","C0CIM2",34,0)
; D MAP([NAME]XML,C0C[NAME],[NAME]OUT) ;MAP RESULTS FOR PROCEDURES
-"RTN","C0CIM2",38,0)
+"RTN","C0CIM2",35,0)
D MAP(IMMXML,C0CIMM,IMMOUT) ;MAP RESULTS FOR PROCEDURES
-"RTN","C0CIM2",39,0)
+"RTN","C0CIM2",36,0)
Q
-"RTN","C0CIM2",40,0)
+"RTN","C0CIM2",37,0)
;
-"RTN","C0CIM2",41,0)
+"RTN","C0CIM2",38,0)
GETRPMS(DFN,C0CIMM) ; CALLS GET^BGOVIMM TO GET IMMUNIZATIONS.
-"RTN","C0CIM2",42,0)
+"RTN","C0CIM2",39,0)
; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
-"RTN","C0CIM2",43,0)
+"RTN","C0CIM2",40,0)
; C0CIMM: IMMUNIZATIONS
-"RTN","C0CIM2",44,0)
+"RTN","C0CIM2",41,0)
; READY TO BE MAPPED TO XML BY MAP^C0CIMM
-"RTN","C0CIM2",45,0)
+"RTN","C0CIM2",42,0)
; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY
-"RTN","C0CIM2",46,0)
+"RTN","C0CIM2",43,0)
; EXIST.
-"RTN","C0CIM2",47,0)
+"RTN","C0CIM2",44,0)
;
-"RTN","C0CIM2",48,0)
+"RTN","C0CIM2",45,0)
; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J))
-"RTN","C0CIM2",49,0)
+"RTN","C0CIM2",46,0)
;
-"RTN","C0CIM2",50,0)
+"RTN","C0CIM2",47,0)
; SETUP RPC/API CALL HERE
-"RTN","C0CIM2",51,0)
+"RTN","C0CIM2",48,0)
; USE START AND END DATES FROM PARAMETERS IF REQUIRED
-"RTN","C0CIM2",52,0)
+"RTN","C0CIM2",49,0)
N IMMA
-"RTN","C0CIM2",53,0)
+"RTN","C0CIM2",50,0)
D GET^BGOVIMM(.IMMA,DFN) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE
-"RTN","C0CIM2",54,0)
+"RTN","C0CIM2",51,0)
; PREFORM SORT HERE IF NEEDED
-"RTN","C0CIM2",55,0)
+"RTN","C0CIM2",52,0)
;
-"RTN","C0CIM2",56,0)
+"RTN","C0CIM2",53,0)
; NO SORT REQUIRED FOR IMMUNIZATIONS
-"RTN","C0CIM2",57,0)
+"RTN","C0CIM2",54,0)
;
-"RTN","C0CIM2",58,0)
+"RTN","C0CIM2",55,0)
; MAP EACH ROW OF RPC/API TO RNF1 ARRAY
-"RTN","C0CIM2",59,0)
+"RTN","C0CIM2",56,0)
; RNF1 ARRAY FORMAT:
-"RTN","C0CIM2",60,0)
+"RTN","C0CIM2",57,0)
; VAR("NAME_OF_RIM_VARIABLE")=VALUE
-"RTN","C0CIM2",61,0)
+"RTN","C0CIM2",58,0)
;
-"RTN","C0CIM2",62,0)
+"RTN","C0CIM2",59,0)
; IMMUNIZATIONS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF IMMUNIZATION RESULTS
-"RTN","C0CIM2",63,0)
+"RTN","C0CIM2",60,0)
; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD
-"RTN","C0CIM2",64,0)
+"RTN","C0CIM2",61,0)
; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS
-"RTN","C0CIM2",65,0)
+"RTN","C0CIM2",62,0)
N C0CIM,C0CC,ZRNF
-"RTN","C0CIM2",66,0)
+"RTN","C0CIM2",63,0)
S C0CIM="" ; INITIALIZE FOR $O
-"RTN","C0CIM2",67,0)
+"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",68,0)
+"RTN","C0CIM2",65,0)
. I DEBUG W @IMMA@(C0CIM),!
-"RTN","C0CIM2",69,0)
+"RTN","C0CIM2",66,0)
. ; FIGURE OUT WHICH TYPE OF IMMUNIZATION IT IS (IMMUNIZATION, FORECAST, CONTRAINDICATIONS, REFUSALS)
-"RTN","C0CIM2",70,0)
+"RTN","C0CIM2",67,0)
. D:$P(@IMMA@(C0CIM),U,1)="I" IMMUN
-"RTN","C0CIM2",71,0)
+"RTN","C0CIM2",68,0)
. D:$P(@IMMA@(C0CIM),U,1)="F" FORECAST
-"RTN","C0CIM2",72,0)
+"RTN","C0CIM2",69,0)
. D:$P(@IMMA@(C0CIM),U,1)="C" CONTRA
-"RTN","C0CIM2",73,0)
+"RTN","C0CIM2",70,0)
. D:$P(@IMMA@(C0CIM),U,1)="R" REFUSE
-"RTN","C0CIM2",74,0)
+"RTN","C0CIM2",71,0)
. D RNF1TO2^C0CRNF(C0CIMM,"ZRNF") ;ADD THIS ROW TO THE ARRAY
-"RTN","C0CIM2",75,0)
+"RTN","C0CIM2",72,0)
. K ZRNF
-"RTN","C0CIM2",76,0)
+"RTN","C0CIM2",73,0)
; SAVE RIM VARIABLES SEE C0CRIMA
-"RTN","C0CIM2",77,0)
+"RTN","C0CIM2",74,0)
N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE"))
-"RTN","C0CIM2",78,0)
+"RTN","C0CIM2",75,0)
M @ZRIM=@C0CIMM@("V")
-"RTN","C0CIM2",79,0)
+"RTN","C0CIM2",76,0)
Q
-"RTN","C0CIM2",80,0)
+"RTN","C0CIM2",77,0)
;
-"RTN","C0CIM2",81,0)
+"RTN","C0CIM2",78,0)
IMMUN ; PARSES IMMUNIZATION TYPE ROWS FOR RPMS
-"RTN","C0CIM2",82,0)
+"RTN","C0CIM2",79,0)
; RPC FORMAT
-"RTN","C0CIM2",83,0)
+"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",84,0)
+"RTN","C0CIM2",81,0)
; Reaction [9] ^ VIS Date [10] ^ Age [11] ^ Visit Date [12] ^ Provider IEN~Name [13] ^ Inj Site [14] ^
-"RTN","C0CIM2",85,0)
+"RTN","C0CIM2",82,0)
; Volume [15] ^ Visit IEN [16] ^ Visit Category [17] ^ Full Name [18] ^ Location IEN~Name [19] ^ Visit Locked [20]
-"RTN","C0CIM2",86,0)
+"RTN","C0CIM2",83,0)
; RETRIEVE IMMUNIZATION RECORD FROM IMMUNIZATION FILE (9999999.14) FOR THIS IMMUNIZATION
-"RTN","C0CIM2",87,0)
+"RTN","C0CIM2",84,0)
D GETN^C0CRNF("C0CZIM",9999999.14,$P(@IMMA@(C0CIM),U,7)) ; GET IMMUNIZATION RECORD
-"RTN","C0CIM2",88,0)
+"RTN","C0CIM2",85,0)
; RETIREVE IMMUNIZATION RECORD FROM V IMMUNIZATION FILE (9000010.11) FOR THIS IMMUNIZATION
-"RTN","C0CIM2",89,0)
+"RTN","C0CIM2",86,0)
D GETN^C0CRNF("C0CZVI",9000010.11,$P(@IMMA@(C0CIM),U,4)) ; GET V IMMUNIZATION RECORD
-"RTN","C0CIM2",90,0)
+"RTN","C0CIM2",87,0)
S ZRNF("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID
-"RTN","C0CIM2",91,0)
+"RTN","C0CIM2",88,0)
S ZRNF("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME
-"RTN","C0CIM2",92,0)
+"RTN","C0CIM2",89,0)
S ZRNF("IMMUNEDATETIME")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("EVENT DATE AND TIME","C0CZVI"),"DT")
-"RTN","C0CIM2",93,0)
+"RTN","C0CIM2",90,0)
S ZRNF("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_$P($P(@IMMA@(C0CIM),U,13),"~",1)
-"RTN","C0CIM2",94,0)
+"RTN","C0CIM2",91,0)
S ZRNF("IMMUNEPRODUCTNAMETEXT")=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD
-"RTN","C0CIM2",95,0)
+"RTN","C0CIM2",92,0)
S ZRNF("IMMUNEPRODUCTCODE")=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE
-"RTN","C0CIM2",96,0)
+"RTN","C0CIM2",93,0)
I $$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM")'="" S ZRNF("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code"
-"RTN","C0CIM2",97,0)
+"RTN","C0CIM2",94,0)
E S ZRNF("IMMUNEPRODUCTCODESYSTEM")="" ;NULL
-"RTN","C0CIM2",98,0)
+"RTN","C0CIM2",95,0)
;CLEANUP FROM C0CRNF CALLS
-"RTN","C0CIM2",99,0)
+"RTN","C0CIM2",96,0)
K C0CZIM,C0CZVI
+"RTN","C0CIM2",97,0)
+ Q
+"RTN","C0CIM2",98,0)
+FORECAST ; PARSES FORECAST TYPE ROWS FOR RPMS
+"RTN","C0CIM2",99,0)
+ ; 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
"RTN","C0CIM2",103,0)
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
"RTN","C0CIM2",106,0)
Q
"RTN","C0CIM2",107,0)
-REFUSE ; PARSES FORECAST TYPE ROWS FOR RPMS
+ ;
"RTN","C0CIM2",108,0)
- ; CURRENTLY DISABLED
-"RTN","C0CIM2",109,0)
- Q
-"RTN","C0CIM2",110,0)
- ;
-"RTN","C0CIM2",111,0)
MAP(IMMXML,C0CIMM,IMMOUT) ; MAP IMMUNIZATION XML
-"RTN","C0CIM2",112,0)
+"RTN","C0CIM2",109,0)
;
-"RTN","C0CIM2",113,0)
+"RTN","C0CIM2",110,0)
N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"IMMTEMP")) ;WORK AREA FOR TEMPLATE
-"RTN","C0CIM2",114,0)
+"RTN","C0CIM2",111,0)
K @ZTEMP
-"RTN","C0CIM2",115,0)
+"RTN","C0CIM2",112,0)
N ZBLD
-"RTN","C0CIM2",116,0)
+"RTN","C0CIM2",113,0)
S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"IMMBLD")) ; BUILD LIST AREA
-"RTN","C0CIM2",117,0)
+"RTN","C0CIM2",114,0)
D QUEUE^C0CXPATH(ZBLD,IMMXML,1,1) ; FIRST LINE
-"RTN","C0CIM2",118,0)
+"RTN","C0CIM2",115,0)
N ZINNER
-"RTN","C0CIM2",119,0)
+"RTN","C0CIM2",116,0)
; XPATH NEEDS TO MATCH YOUR SECTION
-"RTN","C0CIM2",120,0)
+"RTN","C0CIM2",117,0)
D QUERY^C0CXPATH(IMMXML,"//Immunizations/Immunization","ZINNER") ;ONE PROC
-"RTN","C0CIM2",121,0)
+"RTN","C0CIM2",118,0)
N ZTMP,ZVAR,ZI
-"RTN","C0CIM2",122,0)
+"RTN","C0CIM2",119,0)
S ZI=""
-"RTN","C0CIM2",123,0)
+"RTN","C0CIM2",120,0)
F S ZI=$O(@C0CIMM@("V",ZI)) Q:ZI="" D ;FOR EACH IMMUNIZATION
-"RTN","C0CIM2",124,0)
+"RTN","C0CIM2",121,0)
. S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS IMMUNIZATION XML
-"RTN","C0CIM2",125,0)
+"RTN","C0CIM2",122,0)
. S ZVAR=$NA(@C0CIMM@("V",ZI)) ;THIS IMMUNIZATION VARIABLES
-"RTN","C0CIM2",126,0)
+"RTN","C0CIM2",123,0)
. D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE IMMUNIZATION
-"RTN","C0CIM2",127,0)
+"RTN","C0CIM2",124,0)
. D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUEUE FOR BUILD
-"RTN","C0CIM2",128,0)
+"RTN","C0CIM2",125,0)
D QUEUE^C0CXPATH(ZBLD,IMMXML,@IMMXML@(0),@IMMXML@(0))
-"RTN","C0CIM2",129,0)
+"RTN","C0CIM2",126,0)
N ZZTMP ; IS THIS NEEDED?
-"RTN","C0CIM2",130,0)
+"RTN","C0CIM2",127,0)
D BUILD^C0CXPATH(ZBLD,IMMOUT) ;BUILD FINAL XML
-"RTN","C0CIM2",131,0)
+"RTN","C0CIM2",128,0)
K @ZTEMP,@ZBLD
-"RTN","C0CIM2",132,0)
+"RTN","C0CIM2",129,0)
Q
-"RTN","C0CIM2",133,0)
+"RTN","C0CIM2",130,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 .
"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.,
-"RTN","C0CIMMU",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","C0CIMMU",20,0)
;
+"RTN","C0CIMMU",18,0)
+ ; PROCESS THE IMMUNIZATIONS SECTION OF THE CCR
+"RTN","C0CIMMU",19,0)
+ ;
+"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
-"RTN","C0CIMMU",23,0)
- ;
-"RTN","C0CIMMU",24,0)
-MAP(IPXML,DFN,OUTXML) ; MAP IMMUNIZATIONS
-"RTN","C0CIMMU",25,0)
- ;
-"RTN","C0CIMMU",26,0)
N C0CZV,C0CZVI ; TO STORE MAPPED VARIABLES
-"RTN","C0CIMMU",27,0)
+"RTN","C0CIMMU",23,0)
N C0CZT ; TMP ARRAY OF MAPPED XML
-"RTN","C0CIMMU",28,0)
+"RTN","C0CIMMU",24,0)
S C0CZV=$NA(^TMP("C0CCCR",$J,"IMMUNE")) ; TEMP STORAGE FOR VARIABLES
-"RTN","C0CIMMU",29,0)
+"RTN","C0CIMMU",25,0)
D EXTRACT(IPXML,DFN,OUTXML) ;EXTRACT THE VARIABLES
-"RTN","C0CIMMU",30,0)
+"RTN","C0CIMMU",26,0)
N C0CZI,C0CZIC ; COUNT OF IMMUNIZATIONS
-"RTN","C0CIMMU",31,0)
+"RTN","C0CIMMU",27,0)
S C0CZIC=$G(@C0CZV@(0)) ; TOTAL FROM VARIABLE ARRAY
-"RTN","C0CIMMU",32,0)
+"RTN","C0CIMMU",28,0)
I C0CZIC>0 D ;IMMUNIZATIONS FOUND
-"RTN","C0CIMMU",33,0)
+"RTN","C0CIMMU",29,0)
. F C0CZI=1:1:C0CZIC D ;FOR EACH IMMUNIZATION
-"RTN","C0CIMMU",34,0)
+"RTN","C0CIMMU",30,0)
. . S C0CZVI=$NA(@C0CZV@(C0CZI)) ;THIS IMMUNIZATION
-"RTN","C0CIMMU",35,0)
+"RTN","C0CIMMU",31,0)
. . D MAP^C0CXPATH(IPXML,C0CZVI,"C0CZT") ;MAP THE VARIABLES TO XML
-"RTN","C0CIMMU",36,0)
+"RTN","C0CIMMU",32,0)
. . I C0CZI=1 D ; FIRST ONE
-"RTN","C0CIMMU",37,0)
+"RTN","C0CIMMU",33,0)
. . . D CP^C0CXPATH("C0CZT",OUTXML) ;JUST COPY RESULTS
-"RTN","C0CIMMU",38,0)
+"RTN","C0CIMMU",34,0)
. . E D ;NOT THE FIRST
-"RTN","C0CIMMU",39,0)
+"RTN","C0CIMMU",35,0)
. . . D INSINNER^C0CXPATH(OUTXML,"C0CZT")
-"RTN","C0CIMMU",40,0)
+"RTN","C0CIMMU",36,0)
E S @OUTXML@(0)=0 ; SIGNAL NO IMMUNIZATIONS
-"RTN","C0CIMMU",41,0)
+"RTN","C0CIMMU",37,0)
N IMMUTMP,I
-"RTN","C0CIMMU",42,0)
+"RTN","C0CIMMU",38,0)
D MISSING^C0CXPATH(OUTXML,"IMMUTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","C0CIMMU",43,0)
+"RTN","C0CIMMU",39,0)
I IMMUTMP(0)>0 D ; IF THERE ARE MISSING VARS -
-"RTN","C0CIMMU",44,0)
+"RTN","C0CIMMU",40,0)
. ; STRINGS MARKED AS @@X@@
-"RTN","C0CIMMU",45,0)
+"RTN","C0CIMMU",41,0)
. W !,"IMMUNE Missing list: ",!
-"RTN","C0CIMMU",46,0)
+"RTN","C0CIMMU",42,0)
. F I=1:1:IMMUTMP(0) W IMMUTMP(I),!
-"RTN","C0CIMMU",47,0)
+"RTN","C0CIMMU",43,0)
Q
-"RTN","C0CIMMU",48,0)
+"RTN","C0CIMMU",44,0)
;
-"RTN","C0CIMMU",49,0)
+"RTN","C0CIMMU",45,0)
EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT IMMUNIZATIONS INTO VARIABLES
-"RTN","C0CIMMU",50,0)
+"RTN","C0CIMMU",46,0)
;
-"RTN","C0CIMMU",51,0)
+"RTN","C0CIMMU",47,0)
; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","C0CIMMU",52,0)
+"RTN","C0CIMMU",48,0)
; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
-"RTN","C0CIMMU",53,0)
+"RTN","C0CIMMU",49,0)
; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
-"RTN","C0CIMMU",54,0)
+"RTN","C0CIMMU",50,0)
; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
-"RTN","C0CIMMU",55,0)
+"RTN","C0CIMMU",51,0)
; INSERT^C0CXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
-"RTN","C0CIMMU",56,0)
+"RTN","C0CIMMU",52,0)
;
-"RTN","C0CIMMU",57,0)
+"RTN","C0CIMMU",53,0)
N RPCRSLT,J,K,PTMP,X,VMAP,TBU
-"RTN","C0CIMMU",58,0)
+"RTN","C0CIMMU",54,0)
S TVMAP=$NA(^TMP("C0CCCR",$J,"IMMUNE"))
-"RTN","C0CIMMU",59,0)
+"RTN","C0CIMMU",55,0)
S TARYTMP=$NA(^TMP("C0CCCR",$J,"IMMUARYTMP"))
-"RTN","C0CIMMU",60,0)
+"RTN","C0CIMMU",56,0)
S IMMA=$NA(^TMP("PXI",$J)) ;
-"RTN","C0CIMMU",61,0)
+"RTN","C0CIMMU",57,0)
K @IMMA ; CLEAR OUT PREVIOUS RESULTS
-"RTN","C0CIMMU",62,0)
+"RTN","C0CIMMU",58,0)
K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
-"RTN","C0CIMMU",63,0)
+"RTN","C0CIMMU",59,0)
D IMMUN^PXRHS03(DFN) ;
-"RTN","C0CIMMU",64,0)
+"RTN","C0CIMMU",60,0)
I $O(@IMMA@(""))="" D Q ; RPC RETURNS NULL
-"RTN","C0CIMMU",65,0)
+"RTN","C0CIMMU",61,0)
. W "NULL RESULT FROM IMMUN^PXRHS03 ",!
-"RTN","C0CIMMU",66,0)
+"RTN","C0CIMMU",62,0)
. S @TVMAP@(0)=0
-"RTN","C0CIMMU",67,0)
+"RTN","C0CIMMU",63,0)
N C0CIM,C0CC,C0CIMD,C0CIEN,C0CT ;
-"RTN","C0CIMMU",68,0)
+"RTN","C0CIMMU",64,0)
S C0CIM=""
-"RTN","C0CIMMU",69,0)
+"RTN","C0CIMMU",65,0)
S C0CC=0 ; COUNT
-"RTN","C0CIMMU",70,0)
+"RTN","C0CIMMU",66,0)
F S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM="" D ; FOR EACH IMMUNE TYPE IN THE LIST
-"RTN","C0CIMMU",71,0)
+"RTN","C0CIMMU",67,0)
. S C0CC=C0CC+1 ;INCREMENT COUNT
-"RTN","C0CIMMU",72,0)
+"RTN","C0CIMMU",68,0)
. S @TVMAP@(0)=C0CC ; SAVE NEW COUNT TO ARRAY
-"RTN","C0CIMMU",73,0)
+"RTN","C0CIMMU",69,0)
. S VMAP=$NA(@TVMAP@(C0CC)) ; THIS IMMUNE ELEMENT
-"RTN","C0CIMMU",74,0)
+"RTN","C0CIMMU",70,0)
. K @VMAP ; MAKE SURE IT IS CLEARED OUT
-"RTN","C0CIMMU",75,0)
+"RTN","C0CIMMU",71,0)
. W C0CIM,!
-"RTN","C0CIMMU",76,0)
+"RTN","C0CIMMU",72,0)
. S C0CIMD="" ; IMMUNE DATE
-"RTN","C0CIMMU",77,0)
+"RTN","C0CIMMU",73,0)
. F S C0CIMD=$O(@IMMA@(C0CIM,C0CIMD)) Q:C0CIMD="" D ; FOR EACH DATE
-"RTN","C0CIMMU",78,0)
+"RTN","C0CIMMU",74,0)
. . S C0CIEN=$O(@IMMA@(C0CIM,C0CIMD,"")) ;IEN OF IMMUNE RECORD
-"RTN","C0CIMMU",79,0)
+"RTN","C0CIMMU",75,0)
. . D GETN^C0CRNF("C0CI",9000010.11,C0CIEN) ; GET THE FILEMAN RECORD FOR IENS
-"RTN","C0CIMMU",80,0)
+"RTN","C0CIMMU",76,0)
. . W C0CIEN,"_",C0CIMD
-"RTN","C0CIMMU",81,0)
+"RTN","C0CIMMU",77,0)
. . S C0CT=$$FMDTOUTC^C0CUTIL(9999999-C0CIMD,"DT") ; FORMAT DATE/TIME
-"RTN","C0CIMMU",82,0)
+"RTN","C0CIMMU",78,0)
. . W C0CT,!
-"RTN","C0CIMMU",83,0)
+"RTN","C0CIMMU",79,0)
. . S @VMAP@("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID
-"RTN","C0CIMMU",84,0)
+"RTN","C0CIMMU",80,0)
. . S @VMAP@("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME
-"RTN","C0CIMMU",85,0)
+"RTN","C0CIMMU",81,0)
. . S @VMAP@("IMMUNEDATETIME")=C0CT ;FORMATTED DATE/TIME
-"RTN","C0CIMMU",86,0)
+"RTN","C0CIMMU",82,0)
. . S C0CIP=$$ZVALUEI^C0CRNF("ENCOUNTER PROVIDER","C0CI") ;IEN OF PROVIDER
-"RTN","C0CIMMU",87,0)
+"RTN","C0CIMMU",83,0)
. . S @VMAP@("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_C0CIP
-"RTN","C0CIMMU",88,0)
+"RTN","C0CIMMU",84,0)
. . S C0CIIEN=$$ZVALUEI^C0CRNF("IMMUNIZATION","C0CI") ;IEN OF IMMUNIZATION
-"RTN","C0CIMMU",89,0)
+"RTN","C0CIMMU",85,0)
. . I $G(DUZ("AG"))="I" D ; RUNNING IN RPMS
-"RTN","C0CIMMU",90,0)
+"RTN","C0CIMMU",86,0)
. . . D GETN^C0CRNF("C0CZIM",9999999.14,C0CIIEN) ;GET IMMUNE RECORD
-"RTN","C0CIMMU",91,0)
+"RTN","C0CIMMU",87,0)
. . . S C0CIN=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD
-"RTN","C0CIMMU",92,0)
+"RTN","C0CIMMU",88,0)
. . . ; FOR LOOKING UP THE CODE
-"RTN","C0CIMMU",93,0)
+"RTN","C0CIMMU",89,0)
. . . ; GET IT FROM THE CODE FILE
-"RTN","C0CIMMU",94,0)
+"RTN","C0CIMMU",90,0)
. . . S C0CICD=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE
-"RTN","C0CIMMU",95,0)
+"RTN","C0CIMMU",91,0)
. . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME
-"RTN","C0CIMMU",96,0)
+"RTN","C0CIMMU",92,0)
. . . S @VMAP@("IMMUNEPRODUCTCODE")=C0CICD ; CVX CODE
-"RTN","C0CIMMU",97,0)
+"RTN","C0CIMMU",93,0)
. . . I C0CICD'="" S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code" ;
-"RTN","C0CIMMU",98,0)
+"RTN","C0CIMMU",94,0)
. . . E S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NULL
-"RTN","C0CIMMU",99,0)
+"RTN","C0CIMMU",95,0)
. . E D ; NOT IN RPMS
-"RTN","C0CIMMU",100,0)
+"RTN","C0CIMMU",96,0)
. . . S C0CIN=$$ZVALUE^C0CRNF("IMMUNIZATION","C0CI") ;NAME OF IMMUNIZATION
-"RTN","C0CIMMU",101,0)
+"RTN","C0CIMMU",97,0)
. . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME
-"RTN","C0CIMMU",102,0)
+"RTN","C0CIMMU",98,0)
. . . S @VMAP@("IMMUNEPRODUCTCODE")="" ; CVX CODE
-"RTN","C0CIMMU",103,0)
+"RTN","C0CIMMU",99,0)
. . . S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NO CODE
-"RTN","C0CIMMU",104,0)
+"RTN","C0CIMMU",100,0)
N C0CIRIM S C0CIRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE"))
-"RTN","C0CIMMU",105,0)
+"RTN","C0CIMMU",101,0)
M @C0CIRIM=@TVMAP ; PERSIST RIM VARIABLES
-"RTN","C0CIMMU",106,0)
+"RTN","C0CIMMU",102,0)
Q
-"RTN","C0CIMMU",107,0)
+"RTN","C0CIMMU",103,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 .
"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.
-"RTN","C0CIN",19,0)
- ;
-"RTN","C0CIN",20,0)
W "This is the CCR Import Utility Library ",!
+"RTN","C0CIN",19,0)
+ Q
+"RTN","C0CIN",20,0)
+ ;
"RTN","C0CIN",21,0)
- Q
-"RTN","C0CIN",22,0)
- ;
-"RTN","C0CIN",23,0)
TEST ; TESTS BOTH ROUTINES AT ONCE
-"RTN","C0CIN",24,0)
+"RTN","C0CIN",22,0)
N ZI,ZJ
-"RTN","C0CIN",25,0)
+"RTN","C0CIN",23,0)
S ZI="/home/vademo2/CCR" ;directory purposely leaving off the trailing /
-"RTN","C0CIN",26,0)
+"RTN","C0CIN",24,0)
S ZJ="PAT_358_CCR_V1_0_21.xml" ; random test patient
-"RTN","C0CIN",27,0)
+"RTN","C0CIN",25,0)
D RPCFIN(.GPL,358,135,"GPLTEST","CCR",ZJ,ZI)
+"RTN","C0CIN",26,0)
+ Q
+"RTN","C0CIN",27,0)
+ ;
"RTN","C0CIN",28,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)
+"RTN","C0CIN",29,0)
; AND STORE IT IN THE INCOMING XML FILE
-"RTN","C0CIN",32,0)
+"RTN","C0CIN",30,0)
; RETURNS THE IEN OF THE RECORD OR TEXT IF THERE IS AN ERROR
-"RTN","C0CIN",33,0)
+"RTN","C0CIN",31,0)
I $G(DFN)="" S RTN="DFN NOT DEFINED" Q ;
-"RTN","C0CIN",34,0)
+"RTN","C0CIN",32,0)
N C0CXF S C0CXF=175 ; FILE NUMBER FOR INCOMING XML FILE
-"RTN","C0CIN",35,0)
+"RTN","C0CIN",33,0)
N C0CFDA,ZX
-"RTN","C0CIN",36,0)
+"RTN","C0CIN",34,0)
S C0CFDA(C0CXF,"+1,",.01)=DFN ; PATIENT
-"RTN","C0CIN",37,0)
+"RTN","C0CIN",35,0)
S C0CFDA(C0CXF,"+1,",.02)=DUZ ; PROVIDER CREATING THE RECORD
-"RTN","C0CIN",38,0)
+"RTN","C0CIN",36,0)
S C0CFDA(C0CXF,"+1,",1)=$$NOW^XLFDT ;DATE
-"RTN","C0CIN",39,0)
+"RTN","C0CIN",37,0)
S C0CFDA(C0CXF,"+1,",2)=TYPE ;TYPE
-"RTN","C0CIN",40,0)
+"RTN","C0CIN",38,0)
S C0CFDA(C0CXF,"+1,",3)=$$ADDSRC(SOURCE) ;SOURCE
-"RTN","C0CIN",41,0)
+"RTN","C0CIN",39,0)
S C0CFDA(C0CXF,"+1,",7)="NEW" ; STATUS OF NEW FOR NOT PROCESSED
-"RTN","C0CIN",42,0)
+"RTN","C0CIN",40,0)
D UPDIE ; CREATE THE RECORD
-"RTN","C0CIN",43,0)
+"RTN","C0CIN",41,0)
S ZX=C0CIEN(1) ; CAPTURE THE RECORD NUMBER
-"RTN","C0CIN",44,0)
+"RTN","C0CIN",42,0)
D WP^DIE(C0CXF,ZX_",",4,,ARY,"ZERR")
-"RTN","C0CIN",45,0)
+"RTN","C0CIN",43,0)
;W "RECORD:",ZX,!
-"RTN","C0CIN",46,0)
+"RTN","C0CIN",44,0)
S RTN=ZX ; RETURN IEN OF THE XML FILE
+"RTN","C0CIN",45,0)
+ Q
+"RTN","C0CIN",46,0)
+ ;
"RTN","C0CIN",47,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)
+"RTN","C0CIN",48,0)
; RETURNS RECORD NUMBER. IF SOURCE EXISTS, JUST RETURNS IT'S RECORD NUMBER
-"RTN","C0CIN",51,0)
+"RTN","C0CIN",49,0)
;
-"RTN","C0CIN",52,0)
+"RTN","C0CIN",50,0)
N ZX,ZF,C0CFDA
-"RTN","C0CIN",53,0)
+"RTN","C0CIN",51,0)
S ZF=171.401 ; FILE NUMBER FOR CCR SOURCE FILE
-"RTN","C0CIN",54,0)
+"RTN","C0CIN",52,0)
S C0CFDA(ZF,"?+1,",.01)=ZSRC
-"RTN","C0CIN",55,0)
+"RTN","C0CIN",53,0)
D UPDIE
-"RTN","C0CIN",56,0)
+"RTN","C0CIN",54,0)
Q $O(^C0C(171.401,"B",ZSRC,""))
-"RTN","C0CIN",57,0)
+"RTN","C0CIN",55,0)
;
-"RTN","C0CIN",58,0)
+"RTN","C0CIN",56,0)
RPCFIN(RTN,DFN,DUZ,SOURCE,TYPE,FN,FP) ; FILE IN RPC - READ AN XML DOCUMENT
-"RTN","C0CIN",59,0)
+"RTN","C0CIN",57,0)
; FROM A HOST FILE AND STORE IT IN THE INCOMING XML FILE
-"RTN","C0CIN",60,0)
+"RTN","C0CIN",58,0)
N ZX,ZTMP
-"RTN","C0CIN",61,0)
+"RTN","C0CIN",59,0)
I $E($RE(FP))'="/" S ZX=FP_"/"
-"RTN","C0CIN",62,0)
+"RTN","C0CIN",60,0)
E S ZX=FP
-"RTN","C0CIN",63,0)
+"RTN","C0CIN",61,0)
S ZX=ZX_FN
-"RTN","C0CIN",64,0)
+"RTN","C0CIN",62,0)
D LOAD("ZTMP",ZX)
-"RTN","C0CIN",65,0)
+"RTN","C0CIN",63,0)
I '$D(ZTMP) D Q ; NO LUCK
-"RTN","C0CIN",66,0)
+"RTN","C0CIN",64,0)
. W "FILE NOT LOADED",!
-"RTN","C0CIN",67,0)
+"RTN","C0CIN",65,0)
D RPCAIN(.RTN,DFN,DUZ,SOURCE,TYPE,"ZTMP")
-"RTN","C0CIN",68,0)
+"RTN","C0CIN",66,0)
N C0CFDA
-"RTN","C0CIN",69,0)
+"RTN","C0CIN",67,0)
S C0CFDA(175,RTN_",",5)=FN ; FILE NAME
-"RTN","C0CIN",70,0)
+"RTN","C0CIN",68,0)
S C0CFDA(175,RTN_",",6)=FP ; FILE PATH
-"RTN","C0CIN",71,0)
+"RTN","C0CIN",69,0)
D UPDIE ; UPDATE WITH FILE NAME AND PATH
+"RTN","C0CIN",70,0)
+ Q
+"RTN","C0CIN",71,0)
+ ;
"RTN","C0CIN",72,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)
+"RTN","C0CIN",73,0)
; THAT ARE STORED IN THE INCOMING XML FILE
-"RTN","C0CIN",76,0)
+"RTN","C0CIN",74,0)
; RETURNS AN ARRAY OF THE FORM
-"RTN","C0CIN",77,0)
+"RTN","C0CIN",75,0)
; RTN(x)="IEN^DATE^TYPE^SOURCE^STATUS^CREATEDBY" WHERE
-"RTN","C0CIN",78,0)
+"RTN","C0CIN",76,0)
; IEN IS THE RECORD NUMBER OF THE XML DOCUMENT
-"RTN","C0CIN",79,0)
+"RTN","C0CIN",77,0)
; DATE IS THE DATE THE DOCUMENT WAS STORED IN THE FILE
-"RTN","C0CIN",80,0)
+"RTN","C0CIN",78,0)
; TYPE IS "CCD" OR "CCR" OR "OTHER"
-"RTN","C0CIN",81,0)
+"RTN","C0CIN",79,0)
; SOURCE IS THE NAME OF THE DOCUMENT SOURCE FROM THE CCR SOURCE FILE
-"RTN","C0CIN",82,0)
+"RTN","C0CIN",80,0)
; STATUS IS THE STATUS OF THE DOCUMENT (VALUES TO BE DEFINED)
-"RTN","C0CIN",83,0)
+"RTN","C0CIN",81,0)
; CREATEDBY IS THE NAME OF THE PROVIDER WHO UPLOADED THE XML
-"RTN","C0CIN",84,0)
+"RTN","C0CIN",82,0)
N ZF S ZF=175 ; FILE NUMBER OF INCOMING XML FILE
-"RTN","C0CIN",85,0)
+"RTN","C0CIN",83,0)
N ZI S ZI=""
-"RTN","C0CIN",86,0)
+"RTN","C0CIN",84,0)
N ZN S ZN=0
-"RTN","C0CIN",87,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",88,0)
+"RTN","C0CIN",86,0)
. S ZN=ZN+1 ;INCREMENT COUNT OF RETURN ARRAY
-"RTN","C0CIN",89,0)
+"RTN","C0CIN",87,0)
. S $P(RTN(ZN),"^",1)=ZI ; IEN OF RECORD
-"RTN","C0CIN",90,0)
+"RTN","C0CIN",88,0)
. S $P(RTN(ZN),"^",2)=$$GET1^DIQ(ZF,ZI_",",1,"E") ;DATE
-"RTN","C0CIN",91,0)
+"RTN","C0CIN",89,0)
. S $P(RTN(ZN),"^",3)=$$GET1^DIQ(ZF,ZI_",",2,"E") ;TYPE
-"RTN","C0CIN",92,0)
+"RTN","C0CIN",90,0)
. S $P(RTN(ZN),"^",4)=$$GET1^DIQ(ZF,ZI_",",3,"E") ;SOURCE
-"RTN","C0CIN",93,0)
+"RTN","C0CIN",91,0)
. S $P(RTN(ZN),"^",5)=$$GET1^DIQ(ZF,ZI_",",7,"I") ; STATUS
-"RTN","C0CIN",94,0)
+"RTN","C0CIN",92,0)
. S $P(RTN(ZN),"^",6)=$$GET1^DIQ(ZF,ZI_",",.02,"E") ; CREATED BY
+"RTN","C0CIN",93,0)
+ Q
+"RTN","C0CIN",94,0)
+ ;
"RTN","C0CIN",95,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)
+"RTN","C0CIN",96,0)
; RETURNED IN ARRAY RTN
-"RTN","C0CIN",99,0)
+"RTN","C0CIN",97,0)
N ZI
-"RTN","C0CIN",100,0)
+"RTN","C0CIN",98,0)
S ZI=$$GET1^DIQ(175,IEN_",",4,,"RTN")
+"RTN","C0CIN",99,0)
+ Q
+"RTN","C0CIN",100,0)
+ ;
"RTN","C0CIN",101,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)
+"RTN","C0CIN",102,0)
; FILE UNDER SOURCE, WHICH IS A POINTER TO THE CCR SOURCE FILE
-"RTN","C0CIN",105,0)
+"RTN","C0CIN",103,0)
; FOR PATIENT C0CDFN
-"RTN","C0CIN",106,0)
+"RTN","C0CIN",104,0)
;N C0CXP
-"RTN","C0CIN",107,0)
+"RTN","C0CIN",105,0)
S C0CINB=$NA(^TMP("C0CIN",$J,"VARS",C0CDFN))
-"RTN","C0CIN",108,0)
+"RTN","C0CIN",106,0)
S C0CDOCID=$$PARSE^C0CMXML(INXML) ;W !,"DocID: ",C0CDOCID
-"RTN","C0CIN",109,0)
+"RTN","C0CIN",107,0)
;S REDUX="//ContinuityOfCareRecord/Body"
-"RTN","C0CIN",110,0)
+"RTN","C0CIN",108,0)
S REDUX=""
-"RTN","C0CIN",111,0)
+"RTN","C0CIN",109,0)
D XPATH^C0CMXML(1,"/","C0CIDX","C0CXP",,REDUX)
-"RTN","C0CIN",112,0)
+"RTN","C0CIN",110,0)
;D INDEX^C0CXPATH(INXML,"C0CXP",-1) ; GENERATE XPATHS FROM THE CCR
-"RTN","C0CIN",113,0)
+"RTN","C0CIN",111,0)
;N ZI,ZJ,ZK
-"RTN","C0CIN",114,0)
+"RTN","C0CIN",112,0)
S ZI=""
-"RTN","C0CIN",115,0)
+"RTN","C0CIN",113,0)
F S ZI=$O(C0CXP(ZI)) Q:ZI="" D ; FOR EACH XPATH
-"RTN","C0CIN",116,0)
+"RTN","C0CIN",114,0)
. D DEMUX^C0CMXP("ZJ",ZI) ;
-"RTN","C0CIN",117,0)
+"RTN","C0CIN",115,0)
. W ZJ,!
-"RTN","C0CIN",118,0)
+"RTN","C0CIN",116,0)
. S ZK=$P(ZJ,"^",3) ; PULL OUT THE XPATH
-"RTN","C0CIN",119,0)
+"RTN","C0CIN",117,0)
. S ZM=$P(ZJ,"^",1) ; PULL OUT THE MULTIPLE
-"RTN","C0CIN",120,0)
+"RTN","C0CIN",118,0)
. S ZS=$P(ZJ,"^",2) ; PULL OUT THE SUBMULTIPLE
-"RTN","C0CIN",121,0)
+"RTN","C0CIN",119,0)
. S C0CDICN=$O(^C0CDIC(170,"XPATH",ZK,""))
-"RTN","C0CIN",122,0)
+"RTN","C0CIN",120,0)
. I C0CDICN="" D Q ;
-"RTN","C0CIN",123,0)
+"RTN","C0CIN",121,0)
. . W "MISSING XPATH:",!,ZK,! ; OOPS, XPATH NOT IN C0CDIC
-"RTN","C0CIN",124,0)
+"RTN","C0CIN",122,0)
. . S MISSING(ZK)=""
-"RTN","C0CIN",125,0)
+"RTN","C0CIN",123,0)
. ;D GETS^DIQ(170,C0CDICN_",","*",,"C0CFDA")
-"RTN","C0CIN",126,0)
+"RTN","C0CIN",124,0)
. S C0CVAR=$$GET1^DIQ(170,C0CDICN_",",.01) ; VARIABLE NAME
-"RTN","C0CIN",127,0)
+"RTN","C0CIN",125,0)
. S C0CSEC=$$GET1^DIQ(170,C0CDICN_",",12) ;ELEMENT TYPE
-"RTN","C0CIN",128,0)
+"RTN","C0CIN",126,0)
. W C0CSEC,":",C0CVAR,!
-"RTN","C0CIN",129,0)
+"RTN","C0CIN",127,0)
Q
-"RTN","C0CIN",130,0)
+"RTN","C0CIN",128,0)
;
-"RTN","C0CIN",131,0)
+"RTN","C0CIN",129,0)
GETACCR(AOUT,C0CDFN) ; EXTRACT A CCR FOR PATIENT ADFN AND PUT IT IN ARRAY AOUT
-"RTN","C0CIN",132,0)
+"RTN","C0CIN",130,0)
;PASSED BY NAME
-"RTN","C0CIN",133,0)
+"RTN","C0CIN",131,0)
N ZT
-"RTN","C0CIN",134,0)
+"RTN","C0CIN",132,0)
D CCRRPC^C0CCCR(.ZT,C0CDFN,"LABLIMIT:T-1000")
-"RTN","C0CIN",135,0)
+"RTN","C0CIN",133,0)
M @AOUT=ZT
+"RTN","C0CIN",134,0)
+ Q
+"RTN","C0CIN",135,0)
+ ;
"RTN","C0CIN",136,0)
- Q
-"RTN","C0CIN",137,0)
- ;
-"RTN","C0CIN",138,0)
TEST64 ;TEST BASE64 DECODING FOR IMPORTING CCR FROM THE NHIN
-"RTN","C0CIN",139,0)
+"RTN","C0CIN",137,0)
W $$FTG^%ZISH("/tmp/","base64_encoded_ccr.txt","G64(1)",1)
-"RTN","C0CIN",140,0)
+"RTN","C0CIN",138,0)
S G=G64(1)
-"RTN","C0CIN",141,0)
+"RTN","C0CIN",139,0)
S ZI=""
-"RTN","C0CIN",142,0)
+"RTN","C0CIN",140,0)
F S ZI=$O(G64(1,"OVF",ZI)) Q:ZI="" D ; FOR EVERY OVERFLOW RECORD
-"RTN","C0CIN",143,0)
+"RTN","C0CIN",141,0)
. S G=G_G64(1,"OVF",ZI) ;HOPE IT'S NOT TOO BIG
-"RTN","C0CIN",144,0)
+"RTN","C0CIN",142,0)
S G2=$$DECODE^RGUTUU(G)
+"RTN","C0CIN",143,0)
+ Q
+"RTN","C0CIN",144,0)
+ ;
"RTN","C0CIN",145,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)
+"RTN","C0CIN",146,0)
; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
-"RTN","C0CIN",149,0)
+"RTN","C0CIN",147,0)
;
-"RTN","C0CIN",150,0)
+"RTN","C0CIN",148,0)
N ZI,ZN,ZTMP
-"RTN","C0CIN",151,0)
+"RTN","C0CIN",149,0)
S ZN=1
-"RTN","C0CIN",152,0)
+"RTN","C0CIN",150,0)
S @OUTXML@(ZN)=$P(@INXML,"><",ZN)_">"
-"RTN","C0CIN",153,0)
+"RTN","C0CIN",151,0)
S ZN=ZN+1
-"RTN","C0CIN",154,0)
+"RTN","C0CIN",152,0)
F S @OUTXML@(ZN)="<"_$P(@INXML,"><",ZN) Q:$P(@INXML,"><",ZN+1)="" D ;
-"RTN","C0CIN",155,0)
+"RTN","C0CIN",153,0)
. S @OUTXML@(ZN)=@OUTXML@(ZN)_">"
-"RTN","C0CIN",156,0)
+"RTN","C0CIN",154,0)
. S ZN=ZN+1
+"RTN","C0CIN",155,0)
+ Q
+"RTN","C0CIN",156,0)
+ ;
"RTN","C0CIN",157,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)
+"RTN","C0CIN",158,0)
;AN ARRAY OUTXML(n) OUTXML AND INXML PASSED BY NAME
-"RTN","C0CIN",161,0)
+"RTN","C0CIN",159,0)
N ZX,ZY,ZN
-"RTN","C0CIN",162,0)
+"RTN","C0CIN",160,0)
S ZX=1,ZN=1
-"RTN","C0CIN",163,0)
+"RTN","C0CIN",161,0)
F S ZY=$F(@INXML,$C(10),ZX) Q:ZY=0 D ;
-"RTN","C0CIN",164,0)
+"RTN","C0CIN",162,0)
. S @OUTXML@(ZN)=$E(G2,ZX,ZY-2)
-"RTN","C0CIN",165,0)
+"RTN","C0CIN",163,0)
. I @OUTXML@(ZN)'="" S ZN=ZN+1
-"RTN","C0CIN",166,0)
+"RTN","C0CIN",164,0)
. S ZX=ZY
+"RTN","C0CIN",165,0)
+ Q
+"RTN","C0CIN",166,0)
+ ;
"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)
+"RTN","C0CIN",168,0)
n i
-"RTN","C0CIN",171,0)
+"RTN","C0CIN",169,0)
D ;
-"RTN","C0CIN",172,0)
+"RTN","C0CIN",170,0)
. n zfile,zpath,ztmp,zok s (zfile,zpath,ztmp)=""
-"RTN","C0CIN",173,0)
+"RTN","C0CIN",171,0)
. s ztmp=$na(^TMP("C0CLOAD",$J))
-"RTN","C0CIN",174,0)
+"RTN","C0CIN",172,0)
. k @ztmp
-"RTN","C0CIN",175,0)
+"RTN","C0CIN",173,0)
. s zfile=$re($p($re(filepath),"/",1)) ;file name
-"RTN","C0CIN",176,0)
+"RTN","C0CIN",174,0)
. s zpath=$p(filepath,zfile,1) ; file path
-"RTN","C0CIN",177,0)
+"RTN","C0CIN",175,0)
. s zok=$$FTG^%ZISH(zpath,zfile,$NA(@ztmp@(1)),3) ; import the file incr sub 3
-"RTN","C0CIN",178,0)
+"RTN","C0CIN",176,0)
. m @ZRTN=@ztmp
-"RTN","C0CIN",179,0)
+"RTN","C0CIN",177,0)
. k @ztmp
-"RTN","C0CIN",180,0)
+"RTN","C0CIN",178,0)
. s i=$o(@ZRTN@(""),-1) ; highest line number
-"RTN","C0CIN",181,0)
+"RTN","C0CIN",179,0)
q
-"RTN","C0CIN",182,0)
+"RTN","C0CIN",180,0)
;
-"RTN","C0CIN",183,0)
+"RTN","C0CIN",181,0)
UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
-"RTN","C0CIN",184,0)
+"RTN","C0CIN",182,0)
K ZERR,C0CIEN
-"RTN","C0CIN",185,0)
+"RTN","C0CIN",183,0)
D CLEAN^DILF
-"RTN","C0CIN",186,0)
+"RTN","C0CIN",184,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)
+"RTN","C0CIN",185,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CIN",186,0)
K C0CFDA
-"RTN","C0CIN",192,0)
+"RTN","C0CIN",187,0)
Q
-"RTN","C0CIN",193,0)
+"RTN","C0CIN",188,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)
- ; Tasked by C0C post-install routine C0CENV to create C0C cross-references on V LAB file.
+ ;
"RTN","C0CLA7DD",5,0)
- ;
+ ; This program is free software: you can redistribute it and/or modify
"RTN","C0CLA7DD",6,0)
- Q
+ ; 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)
-EN ; Add new style cross-references to V LAB file if it exists.
+ ;
"RTN","C0CLA7DD",10,0)
- ; OLD entry point - see new KIDS check points in C0CENV.
+ ; 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)
- ; Quit if AUPNVLAB global does not exist.
+ ; GNU Affero General Public License for more details.
"RTN","C0CLA7DD",14,0)
- I $$VFILE^DILFD(9000010.09)'=1 Q
-"RTN","C0CLA7DD",15,0)
;
+"RTN","C0CLA7DD",15,0)
+ ; You should have received a copy of the GNU Affero General Public License
"RTN","C0CLA7DD",16,0)
- N MSG
+ ; along with this program. If not, see .
"RTN","C0CLA7DD",17,0)
;
"RTN","C0CLA7DD",18,0)
- S MSG="Starting installation of ALR1 cross-reference at "_$$HTE^XLFDT($H,"1Z")
+ ; Tasked by C0C post-install routine C0CENV to create C0C cross-references on V LAB file.
"RTN","C0CLA7DD",19,0)
- D BMES(MSG)
-"RTN","C0CLA7DD",20,0)
- D ALR1
-"RTN","C0CLA7DD",21,0)
- S MSG="Installation of ALR1 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
-"RTN","C0CLA7DD",22,0)
- D BMES(MSG)
-"RTN","C0CLA7DD",23,0)
;
+"RTN","C0CLA7DD",20,0)
+ Q
+"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",24,0)
- S MSG="Starting installation of ALR2 cross-reference at "_$$HTE^XLFDT($H,"1Z")
+ ; OLD entry point - see new KIDS check points in C0CENV.
"RTN","C0CLA7DD",25,0)
- D BMES(MSG)
+ ;
"RTN","C0CLA7DD",26,0)
- D ALR2
+ ;
"RTN","C0CLA7DD",27,0)
- S MSG="Installation of ALR2 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
+ ; Quit if AUPNVLAB global does not exist.
"RTN","C0CLA7DD",28,0)
- D BMES(MSG)
+ I $$VFILE^DILFD(9000010.09)'=1 Q
"RTN","C0CLA7DD",29,0)
;
"RTN","C0CLA7DD",30,0)
- S MSG="Starting installation of ALR3 cross-reference at "_$$HTE^XLFDT($H,"1Z")
+ N MSG
"RTN","C0CLA7DD",31,0)
- D BMES(MSG)
+ ;
"RTN","C0CLA7DD",32,0)
- D ALR3
+ S MSG="Starting installation of ALR1 cross-reference at "_$$HTE^XLFDT($H,"1Z")
"RTN","C0CLA7DD",33,0)
- S MSG="Installation of ALR3 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
+ D BMES(MSG)
"RTN","C0CLA7DD",34,0)
- D BMES(MSG)
+ D ALR1
"RTN","C0CLA7DD",35,0)
- ;
+ S MSG="Installation of ALR1 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
"RTN","C0CLA7DD",36,0)
- S MSG="Starting installation of ALR4 cross-reference at "_$$HTE^XLFDT($H,"1Z")
+ D BMES(MSG)
"RTN","C0CLA7DD",37,0)
- D BMES(MSG)
+ ;
"RTN","C0CLA7DD",38,0)
- D ALR4
+ S MSG="Starting installation of ALR2 cross-reference at "_$$HTE^XLFDT($H,"1Z")
"RTN","C0CLA7DD",39,0)
- S MSG="Installation of ALR4 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
+ D BMES(MSG)
"RTN","C0CLA7DD",40,0)
- D BMES(MSG)
+ D ALR2
"RTN","C0CLA7DD",41,0)
- ;
+ S MSG="Installation of ALR2 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
"RTN","C0CLA7DD",42,0)
- S MSG="Starting installation of ALR5 cross-reference at "_$$HTE^XLFDT($H,"1Z")
+ D BMES(MSG)
"RTN","C0CLA7DD",43,0)
- D BMES(MSG)
-"RTN","C0CLA7DD",44,0)
- D ALR5
-"RTN","C0CLA7DD",45,0)
- S MSG="Installation of ALR5 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
-"RTN","C0CLA7DD",46,0)
- D BMES(MSG)
-"RTN","C0CLA7DD",47,0)
;
+"RTN","C0CLA7DD",44,0)
+ S MSG="Starting installation of ALR3 cross-reference at "_$$HTE^XLFDT($H,"1Z")
+"RTN","C0CLA7DD",45,0)
+ D BMES(MSG)
+"RTN","C0CLA7DD",46,0)
+ D ALR3
+"RTN","C0CLA7DD",47,0)
+ S MSG="Installation of ALR3 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
"RTN","C0CLA7DD",48,0)
- Q
+ D BMES(MSG)
"RTN","C0CLA7DD",49,0)
;
"RTN","C0CLA7DD",50,0)
- ;
+ S MSG="Starting installation of ALR4 cross-reference at "_$$HTE^XLFDT($H,"1Z")
"RTN","C0CLA7DD",51,0)
-ALR1 ; Installation of ALR1 cross-reference
+ D BMES(MSG)
"RTN","C0CLA7DD",52,0)
- ;
+ D ALR4
"RTN","C0CLA7DD",53,0)
- N C0CFLAG,C0CXR,C0CRES,C0COUT
+ S MSG="Installation of ALR4 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
"RTN","C0CLA7DD",54,0)
- ;
+ D BMES(MSG)
"RTN","C0CLA7DD",55,0)
- S C0CFLAG=""
+ ;
"RTN","C0CLA7DD",56,0)
- ;
+ S MSG="Starting installation of ALR5 cross-reference at "_$$HTE^XLFDT($H,"1Z")
"RTN","C0CLA7DD",57,0)
- S C0CXR("FILE")=9000010.09
+ D BMES(MSG)
"RTN","C0CLA7DD",58,0)
- S C0CXR("NAME")="ALR1"
+ D ALR5
"RTN","C0CLA7DD",59,0)
- S C0CXR("TYPE")="R"
+ S MSG="Installation of ALR5 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
"RTN","C0CLA7DD",60,0)
- S C0CXR("USE")="S"
+ D BMES(MSG)
"RTN","C0CLA7DD",61,0)
- S C0CXR("EXECUTION")="R"
+ ;
"RTN","C0CLA7DD",62,0)
- S C0CXR("ACTIVITY")="IR"
+ Q
"RTN","C0CLA7DD",63,0)
- S C0CXR("SHORT DESCR")="X-ref to link entry with parent in LAB DATA file (#63)"
+ ;
"RTN","C0CLA7DD",64,0)
- S C0CXR("VAL",1)=.02
+ ;
"RTN","C0CLA7DD",65,0)
- S C0CXR("VAL",1,"SUBSCRIPT")=1
+ALR1 ; Installation of ALR1 cross-reference
"RTN","C0CLA7DD",66,0)
- S C0CXR("VAL",1,"COLLATION")="F"
+ ;
"RTN","C0CLA7DD",67,0)
- S C0CXR("VAL",2)=.06
+ N C0CFLAG,C0CXR,C0CRES,C0COUT
"RTN","C0CLA7DD",68,0)
- S C0CXR("VAL",2,"SUBSCRIPT")=2
+ ;
"RTN","C0CLA7DD",69,0)
- S C0CXR("VAL",2,"LENGTH")=30
+ S C0CFLAG=""
"RTN","C0CLA7DD",70,0)
- S C0CXR("VAL",2,"COLLATION")="F"
+ ;
"RTN","C0CLA7DD",71,0)
- S C0CXR("VAL",3)=.01
+ S C0CXR("FILE")=9000010.09
"RTN","C0CLA7DD",72,0)
- S C0CXR("VAL",3,"SUBSCRIPT")=3
+ S C0CXR("NAME")="ALR1"
"RTN","C0CLA7DD",73,0)
- S C0CXR("VAL",3,"COLLATION")="F"
-"RTN","C0CLA7DD",74,0)
- S C0CXR("VAL",4)=1201
-"RTN","C0CLA7DD",75,0)
- S C0CXR("VAL",4,"SUBSCRIPT")=4
-"RTN","C0CLA7DD",76,0)
- S C0CXR("VAL",4,"COLLATION")="F"
-"RTN","C0CLA7DD",77,0)
- D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT")
-"RTN","C0CLA7DD",78,0)
- ;
-"RTN","C0CLA7DD",79,0)
- Q
-"RTN","C0CLA7DD",80,0)
- ;
-"RTN","C0CLA7DD",81,0)
- ;
-"RTN","C0CLA7DD",82,0)
-ALR2 ; Installation of ALR2 cross-reference
-"RTN","C0CLA7DD",83,0)
- ;
-"RTN","C0CLA7DD",84,0)
- N C0CFLAG,C0CXR,C0CRES,C0COUT
-"RTN","C0CLA7DD",85,0)
- ;
-"RTN","C0CLA7DD",86,0)
- S C0CFLAG=""
-"RTN","C0CLA7DD",87,0)
- ;
-"RTN","C0CLA7DD",88,0)
- S C0CXR("FILE")=9000010.09
-"RTN","C0CLA7DD",89,0)
- S C0CXR("NAME")="ALR2"
-"RTN","C0CLA7DD",90,0)
- S C0CXR("TYPE")="MU"
-"RTN","C0CLA7DD",91,0)
- S C0CXR("USE")="S"
-"RTN","C0CLA7DD",92,0)
- S C0CXR("EXECUTION")="R"
-"RTN","C0CLA7DD",93,0)
- S C0CXR("ACTIVITY")="IR"
-"RTN","C0CLA7DD",94,0)
- S C0CXR("SHORT DESCR")="X-ref for LOINC code related to test result."
-"RTN","C0CLA7DD",95,0)
- S C0CXR("DESCR",1)="This cross-reference is used to identify the LOINC codes"
-"RTN","C0CLA7DD",96,0)
- S C0CXR("DESCR",2)="that has been assigned to a lab result. Allows queries to"
-"RTN","C0CLA7DD",97,0)
- S C0CXR("DESCR",3)="retrieve the LOINC code associated with a specific test"
-"RTN","C0CLA7DD",98,0)
- S C0CXR("DESCR",4)="result."
-"RTN","C0CLA7DD",99,0)
- S C0CXR("SET")="S ^AUPNVLAB(""ALR2"",X(1),X(2),X(3),X(4),X(5),DA)="""""
-"RTN","C0CLA7DD",100,0)
- S C0CXR("KILL")="K ^AUPNVLAB(""ALR2"",X(1),X(2),X(3),X(4),X(5),DA)"
-"RTN","C0CLA7DD",101,0)
- S C0CXR("WHOLE KILL")="K ^AUPNVLAB(""ALR2"")"
-"RTN","C0CLA7DD",102,0)
- S C0CXR("VAL",1)=.02
-"RTN","C0CLA7DD",103,0)
- S C0CXR("VAL",1,"SUBSCRIPT")=1
-"RTN","C0CLA7DD",104,0)
- S C0CXR("VAL",1,"COLLATION")="F"
-"RTN","C0CLA7DD",105,0)
- S C0CXR("VAL",2)=1201
-"RTN","C0CLA7DD",106,0)
- S C0CXR("VAL",2,"SUBSCRIPT")=2
-"RTN","C0CLA7DD",107,0)
- S C0CXR("VAL",2,"COLLATION")="F"
-"RTN","C0CLA7DD",108,0)
- S C0CXR("VAL",3)=.06
-"RTN","C0CLA7DD",109,0)
- S C0CXR("VAL",3,"SUBSCRIPT")=3
-"RTN","C0CLA7DD",110,0)
- S C0CXR("VAL",3,"COLLATION")="F"
-"RTN","C0CLA7DD",111,0)
- S C0CXR("VAL",4)=.01
-"RTN","C0CLA7DD",112,0)
- S C0CXR("VAL",4,"SUBSCRIPT")=4
-"RTN","C0CLA7DD",113,0)
- S C0CXR("VAL",4,"COLLATION")="F"
-"RTN","C0CLA7DD",114,0)
- S C0CXR("VAL",5)=1113
-"RTN","C0CLA7DD",115,0)
- S C0CXR("VAL",5,"SUBSCRIPT")=5
-"RTN","C0CLA7DD",116,0)
- S C0CXR("VAL",5,"COLLATION")="F"
-"RTN","C0CLA7DD",117,0)
- D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT")
-"RTN","C0CLA7DD",118,0)
- ;
-"RTN","C0CLA7DD",119,0)
- Q
-"RTN","C0CLA7DD",120,0)
- ;
-"RTN","C0CLA7DD",121,0)
- ;
-"RTN","C0CLA7DD",122,0)
-ALR3 ; Installation of ALR3 cross-reference
-"RTN","C0CLA7DD",123,0)
- ;
-"RTN","C0CLA7DD",124,0)
- N C0CFLAG,C0CXR,C0CRES,C0COUT
-"RTN","C0CLA7DD",125,0)
- ;
-"RTN","C0CLA7DD",126,0)
- S C0CFLAG=""
-"RTN","C0CLA7DD",127,0)
- ;
-"RTN","C0CLA7DD",128,0)
- S C0CXR("FILE")=9000010.09
-"RTN","C0CLA7DD",129,0)
- S C0CXR("NAME")="ALR3"
-"RTN","C0CLA7DD",130,0)
S C0CXR("TYPE")="R"
-"RTN","C0CLA7DD",131,0)
+"RTN","C0CLA7DD",74,0)
S C0CXR("USE")="S"
-"RTN","C0CLA7DD",132,0)
- S C0CXR("EXECUTION")="F"
-"RTN","C0CLA7DD",133,0)
+"RTN","C0CLA7DD",75,0)
+ S C0CXR("EXECUTION")="R"
+"RTN","C0CLA7DD",76,0)
S C0CXR("ACTIVITY")="IR"
-"RTN","C0CLA7DD",134,0)
- S C0CXR("SHORT DESCR")="X-ref for LOINC code related to test result - any patient"
-"RTN","C0CLA7DD",135,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)
- S C0CXR("DESCR",2)="to retrieve the LOINC code associated with a specific test result. It allows any patient"
-"RTN","C0CLA7DD",137,0)
- S C0CXR("DESCR",3)="lab results to be identified by LOINC"
-"RTN","C0CLA7DD",138,0)
- S C0CXR("VAL",1)=1113
-"RTN","C0CLA7DD",139,0)
+"RTN","C0CLA7DD",77,0)
+ S C0CXR("SHORT DESCR")="X-ref to link entry with parent in LAB DATA file (#63)"
+"RTN","C0CLA7DD",78,0)
+ S C0CXR("VAL",1)=.02
+"RTN","C0CLA7DD",79,0)
S C0CXR("VAL",1,"SUBSCRIPT")=1
-"RTN","C0CLA7DD",140,0)
+"RTN","C0CLA7DD",80,0)
S C0CXR("VAL",1,"COLLATION")="F"
+"RTN","C0CLA7DD",81,0)
+ S C0CXR("VAL",2)=.06
+"RTN","C0CLA7DD",82,0)
+ S C0CXR("VAL",2,"SUBSCRIPT")=2
+"RTN","C0CLA7DD",83,0)
+ S C0CXR("VAL",2,"LENGTH")=30
+"RTN","C0CLA7DD",84,0)
+ S C0CXR("VAL",2,"COLLATION")="F"
+"RTN","C0CLA7DD",85,0)
+ S C0CXR("VAL",3)=.01
+"RTN","C0CLA7DD",86,0)
+ S C0CXR("VAL",3,"SUBSCRIPT")=3
+"RTN","C0CLA7DD",87,0)
+ S C0CXR("VAL",3,"COLLATION")="F"
+"RTN","C0CLA7DD",88,0)
+ S C0CXR("VAL",4)=1201
+"RTN","C0CLA7DD",89,0)
+ S C0CXR("VAL",4,"SUBSCRIPT")=4
+"RTN","C0CLA7DD",90,0)
+ S C0CXR("VAL",4,"COLLATION")="F"
+"RTN","C0CLA7DD",91,0)
+ D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT")
+"RTN","C0CLA7DD",92,0)
+ ;
+"RTN","C0CLA7DD",93,0)
+ Q
+"RTN","C0CLA7DD",94,0)
+ ;
+"RTN","C0CLA7DD",95,0)
+ ;
+"RTN","C0CLA7DD",96,0)
+ALR2 ; Installation of ALR2 cross-reference
+"RTN","C0CLA7DD",97,0)
+ ;
+"RTN","C0CLA7DD",98,0)
+ N C0CFLAG,C0CXR,C0CRES,C0COUT
+"RTN","C0CLA7DD",99,0)
+ ;
+"RTN","C0CLA7DD",100,0)
+ S C0CFLAG=""
+"RTN","C0CLA7DD",101,0)
+ ;
+"RTN","C0CLA7DD",102,0)
+ S C0CXR("FILE")=9000010.09
+"RTN","C0CLA7DD",103,0)
+ S C0CXR("NAME")="ALR2"
+"RTN","C0CLA7DD",104,0)
+ S C0CXR("TYPE")="MU"
+"RTN","C0CLA7DD",105,0)
+ S C0CXR("USE")="S"
+"RTN","C0CLA7DD",106,0)
+ S C0CXR("EXECUTION")="R"
+"RTN","C0CLA7DD",107,0)
+ S C0CXR("ACTIVITY")="IR"
+"RTN","C0CLA7DD",108,0)
+ S C0CXR("SHORT DESCR")="X-ref for LOINC code related to test result."
+"RTN","C0CLA7DD",109,0)
+ S C0CXR("DESCR",1)="This cross-reference is used to identify the LOINC codes"
+"RTN","C0CLA7DD",110,0)
+ S C0CXR("DESCR",2)="that has been assigned to a lab result. Allows queries to"
+"RTN","C0CLA7DD",111,0)
+ S C0CXR("DESCR",3)="retrieve the LOINC code associated with a specific test"
+"RTN","C0CLA7DD",112,0)
+ S C0CXR("DESCR",4)="result."
+"RTN","C0CLA7DD",113,0)
+ S C0CXR("SET")="S ^AUPNVLAB(""ALR2"",X(1),X(2),X(3),X(4),X(5),DA)="""""
+"RTN","C0CLA7DD",114,0)
+ S C0CXR("KILL")="K ^AUPNVLAB(""ALR2"",X(1),X(2),X(3),X(4),X(5),DA)"
+"RTN","C0CLA7DD",115,0)
+ S C0CXR("WHOLE KILL")="K ^AUPNVLAB(""ALR2"")"
+"RTN","C0CLA7DD",116,0)
+ S C0CXR("VAL",1)=.02
+"RTN","C0CLA7DD",117,0)
+ S C0CXR("VAL",1,"SUBSCRIPT")=1
+"RTN","C0CLA7DD",118,0)
+ S C0CXR("VAL",1,"COLLATION")="F"
+"RTN","C0CLA7DD",119,0)
+ S C0CXR("VAL",2)=1201
+"RTN","C0CLA7DD",120,0)
+ S C0CXR("VAL",2,"SUBSCRIPT")=2
+"RTN","C0CLA7DD",121,0)
+ S C0CXR("VAL",2,"COLLATION")="F"
+"RTN","C0CLA7DD",122,0)
+ S C0CXR("VAL",3)=.06
+"RTN","C0CLA7DD",123,0)
+ S C0CXR("VAL",3,"SUBSCRIPT")=3
+"RTN","C0CLA7DD",124,0)
+ S C0CXR("VAL",3,"COLLATION")="F"
+"RTN","C0CLA7DD",125,0)
+ S C0CXR("VAL",4)=.01
+"RTN","C0CLA7DD",126,0)
+ S C0CXR("VAL",4,"SUBSCRIPT")=4
+"RTN","C0CLA7DD",127,0)
+ S C0CXR("VAL",4,"COLLATION")="F"
+"RTN","C0CLA7DD",128,0)
+ S C0CXR("VAL",5)=1113
+"RTN","C0CLA7DD",129,0)
+ S C0CXR("VAL",5,"SUBSCRIPT")=5
+"RTN","C0CLA7DD",130,0)
+ S C0CXR("VAL",5,"COLLATION")="F"
+"RTN","C0CLA7DD",131,0)
+ D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT")
+"RTN","C0CLA7DD",132,0)
+ ;
+"RTN","C0CLA7DD",133,0)
+ Q
+"RTN","C0CLA7DD",134,0)
+ ;
+"RTN","C0CLA7DD",135,0)
+ ;
+"RTN","C0CLA7DD",136,0)
+ALR3 ; Installation of ALR3 cross-reference
+"RTN","C0CLA7DD",137,0)
+ ;
+"RTN","C0CLA7DD",138,0)
+ N C0CFLAG,C0CXR,C0CRES,C0COUT
+"RTN","C0CLA7DD",139,0)
+ ;
+"RTN","C0CLA7DD",140,0)
+ S C0CFLAG=""
"RTN","C0CLA7DD",141,0)
;
"RTN","C0CLA7DD",142,0)
- D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT")
+ S C0CXR("FILE")=9000010.09
"RTN","C0CLA7DD",143,0)
- ;
+ S C0CXR("NAME")="ALR3"
"RTN","C0CLA7DD",144,0)
- Q
+ S C0CXR("TYPE")="R"
"RTN","C0CLA7DD",145,0)
- ;
+ S C0CXR("USE")="S"
"RTN","C0CLA7DD",146,0)
- ;
+ S C0CXR("EXECUTION")="F"
"RTN","C0CLA7DD",147,0)
-ALR4 ; Installation of ALR4 cross-reference
+ S C0CXR("ACTIVITY")="IR"
"RTN","C0CLA7DD",148,0)
- ;
+ S C0CXR("SHORT DESCR")="X-ref for LOINC code related to test result - any patient"
"RTN","C0CLA7DD",149,0)
- N C0CFLAG,C0CXR,C0CRES,C0COUT
+ 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",150,0)
- ;
+ S C0CXR("DESCR",2)="to retrieve the LOINC code associated with a specific test result. It allows any patient"
"RTN","C0CLA7DD",151,0)
- S C0CFLAG=""
+ S C0CXR("DESCR",3)="lab results to be identified by LOINC"
"RTN","C0CLA7DD",152,0)
- ;
+ S C0CXR("VAL",1)=1113
"RTN","C0CLA7DD",153,0)
- S C0CXR("FILE")=9000010.09
+ S C0CXR("VAL",1,"SUBSCRIPT")=1
"RTN","C0CLA7DD",154,0)
- S C0CXR("NAME")="ALR4"
+ S C0CXR("VAL",1,"COLLATION")="F"
"RTN","C0CLA7DD",155,0)
- S C0CXR("TYPE")="R"
+ ;
"RTN","C0CLA7DD",156,0)
- S C0CXR("USE")="S"
+ D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT")
"RTN","C0CLA7DD",157,0)
- S C0CXR("EXECUTION")="R"
+ ;
"RTN","C0CLA7DD",158,0)
- S C0CXR("ACTIVITY")="IR"
+ Q
"RTN","C0CLA7DD",159,0)
- S C0CXR("SHORT DESCR")="X-ref by patient and collection date/time"
+ ;
"RTN","C0CLA7DD",160,0)
- S C0CXR("DESCR",1)="This cross-reference is used to identify all lab results for a"
+ ;
"RTN","C0CLA7DD",161,0)
- S C0CXR("DESCR",2)="patient by collection date/time. This includes results that are only in"
+ALR4 ; Installation of ALR4 cross-reference
"RTN","C0CLA7DD",162,0)
- S C0CXR("DESCR",3)="this file and therefore do not have a corresponding entry in LAB DATA"
+ ;
"RTN","C0CLA7DD",163,0)
- S C0CXR("DESCR",4)="file (#63)."
-"RTN","C0CLA7DD",164,0)
- S C0CXR("VAL",1)=.02
-"RTN","C0CLA7DD",165,0)
- S C0CXR("VAL",1,"SUBSCRIPT")=1
-"RTN","C0CLA7DD",166,0)
- S C0CXR("VAL",1,"COLLATION")="F"
-"RTN","C0CLA7DD",167,0)
- S C0CXR("VAL",2)=1201
-"RTN","C0CLA7DD",168,0)
- S C0CXR("VAL",2,"SUBSCRIPT")=2
-"RTN","C0CLA7DD",169,0)
- S C0CXR("VAL",2,"COLLATION")="F"
-"RTN","C0CLA7DD",170,0)
- ;
-"RTN","C0CLA7DD",171,0)
- D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT")
-"RTN","C0CLA7DD",172,0)
- ;
-"RTN","C0CLA7DD",173,0)
- Q
-"RTN","C0CLA7DD",174,0)
- ;
-"RTN","C0CLA7DD",175,0)
- ;
-"RTN","C0CLA7DD",176,0)
-ALR5 ; Installation of ALR5 cross-reference
-"RTN","C0CLA7DD",177,0)
- ;
-"RTN","C0CLA7DD",178,0)
N C0CFLAG,C0CXR,C0CRES,C0COUT
-"RTN","C0CLA7DD",179,0)
+"RTN","C0CLA7DD",164,0)
;
-"RTN","C0CLA7DD",180,0)
+"RTN","C0CLA7DD",165,0)
S C0CFLAG=""
-"RTN","C0CLA7DD",181,0)
+"RTN","C0CLA7DD",166,0)
;
-"RTN","C0CLA7DD",182,0)
+"RTN","C0CLA7DD",167,0)
S C0CXR("FILE")=9000010.09
-"RTN","C0CLA7DD",183,0)
- S C0CXR("NAME")="ALR5"
-"RTN","C0CLA7DD",184,0)
+"RTN","C0CLA7DD",168,0)
+ S C0CXR("NAME")="ALR4"
+"RTN","C0CLA7DD",169,0)
S C0CXR("TYPE")="R"
-"RTN","C0CLA7DD",185,0)
+"RTN","C0CLA7DD",170,0)
S C0CXR("USE")="S"
-"RTN","C0CLA7DD",186,0)
+"RTN","C0CLA7DD",171,0)
S C0CXR("EXECUTION")="R"
-"RTN","C0CLA7DD",187,0)
+"RTN","C0CLA7DD",172,0)
S C0CXR("ACTIVITY")="IR"
-"RTN","C0CLA7DD",188,0)
- S C0CXR("SHORT DESCR")="X-ref by patient and results availble date/time"
-"RTN","C0CLA7DD",189,0)
+"RTN","C0CLA7DD",173,0)
+ S C0CXR("SHORT DESCR")="X-ref by patient and collection date/time"
+"RTN","C0CLA7DD",174,0)
S C0CXR("DESCR",1)="This cross-reference is used to identify all lab results for a"
-"RTN","C0CLA7DD",190,0)
- S C0CXR("DESCR",2)="patient by results available date/time. This includes results that are only in"
-"RTN","C0CLA7DD",191,0)
+"RTN","C0CLA7DD",175,0)
+ S C0CXR("DESCR",2)="patient by collection date/time. This includes results that are only in"
+"RTN","C0CLA7DD",176,0)
S C0CXR("DESCR",3)="this file and therefore do not have a corresponding entry in LAB DATA"
-"RTN","C0CLA7DD",192,0)
+"RTN","C0CLA7DD",177,0)
S C0CXR("DESCR",4)="file (#63)."
-"RTN","C0CLA7DD",193,0)
+"RTN","C0CLA7DD",178,0)
S C0CXR("VAL",1)=.02
-"RTN","C0CLA7DD",194,0)
+"RTN","C0CLA7DD",179,0)
S C0CXR("VAL",1,"SUBSCRIPT")=1
-"RTN","C0CLA7DD",195,0)
+"RTN","C0CLA7DD",180,0)
S C0CXR("VAL",1,"COLLATION")="F"
-"RTN","C0CLA7DD",196,0)
- S C0CXR("VAL",2)=1212
-"RTN","C0CLA7DD",197,0)
+"RTN","C0CLA7DD",181,0)
+ S C0CXR("VAL",2)=1201
+"RTN","C0CLA7DD",182,0)
S C0CXR("VAL",2,"SUBSCRIPT")=2
-"RTN","C0CLA7DD",198,0)
+"RTN","C0CLA7DD",183,0)
S C0CXR("VAL",2,"COLLATION")="F"
-"RTN","C0CLA7DD",199,0)
+"RTN","C0CLA7DD",184,0)
;
-"RTN","C0CLA7DD",200,0)
+"RTN","C0CLA7DD",185,0)
D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT")
-"RTN","C0CLA7DD",201,0)
+"RTN","C0CLA7DD",186,0)
;
-"RTN","C0CLA7DD",202,0)
+"RTN","C0CLA7DD",187,0)
Q
+"RTN","C0CLA7DD",188,0)
+ ;
+"RTN","C0CLA7DD",189,0)
+ ;
+"RTN","C0CLA7DD",190,0)
+ALR5 ; Installation of ALR5 cross-reference
+"RTN","C0CLA7DD",191,0)
+ ;
+"RTN","C0CLA7DD",192,0)
+ N C0CFLAG,C0CXR,C0CRES,C0COUT
+"RTN","C0CLA7DD",193,0)
+ ;
+"RTN","C0CLA7DD",194,0)
+ S C0CFLAG=""
+"RTN","C0CLA7DD",195,0)
+ ;
+"RTN","C0CLA7DD",196,0)
+ S C0CXR("FILE")=9000010.09
+"RTN","C0CLA7DD",197,0)
+ S C0CXR("NAME")="ALR5"
+"RTN","C0CLA7DD",198,0)
+ S C0CXR("TYPE")="R"
+"RTN","C0CLA7DD",199,0)
+ S C0CXR("USE")="S"
+"RTN","C0CLA7DD",200,0)
+ S C0CXR("EXECUTION")="R"
+"RTN","C0CLA7DD",201,0)
+ S C0CXR("ACTIVITY")="IR"
+"RTN","C0CLA7DD",202,0)
+ S C0CXR("SHORT DESCR")="X-ref by patient and results availble date/time"
"RTN","C0CLA7DD",203,0)
- ;
+ S C0CXR("DESCR",1)="This cross-reference is used to identify all lab results for a"
"RTN","C0CLA7DD",204,0)
- ;
+ S C0CXR("DESCR",2)="patient by results available date/time. This includes results that are only in"
"RTN","C0CLA7DD",205,0)
-REINDEX ; Set data into indexes for current entries.
+ S C0CXR("DESCR",3)="this file and therefore do not have a corresponding entry in LAB DATA"
"RTN","C0CLA7DD",206,0)
- ;
+ S C0CXR("DESCR",4)="file (#63)."
"RTN","C0CLA7DD",207,0)
- ;
+ S C0CXR("VAL",1)=.02
"RTN","C0CLA7DD",208,0)
- N C0CHLOG,DA,DIK,MSG
+ S C0CXR("VAL",1,"SUBSCRIPT")=1
"RTN","C0CLA7DD",209,0)
- ;
+ S C0CXR("VAL",1,"COLLATION")="F"
"RTN","C0CLA7DD",210,0)
- S C0CHLOG("START")=$H
+ S C0CXR("VAL",2)=1212
"RTN","C0CLA7DD",211,0)
- S MSG="Starting indexing of ALR1, ALR2, ALR4, ALR5 indexes - "_$$HTE^XLFDT(C0CHLOG("START"),"1Z")
+ S C0CXR("VAL",2,"SUBSCRIPT")=2
"RTN","C0CLA7DD",212,0)
- D BMES(MSG),SENDXQA(MSG)
+ S C0CXR("VAL",2,"COLLATION")="F"
"RTN","C0CLA7DD",213,0)
;
"RTN","C0CLA7DD",214,0)
- S DIK="^AUPNVLAB("
+ D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT")
"RTN","C0CLA7DD",215,0)
- S DIK(1)=".02^ALR1^ALR2^ALR4^ALR5"
+ ;
"RTN","C0CLA7DD",216,0)
- D ENALL^DIK
+ Q
"RTN","C0CLA7DD",217,0)
;
"RTN","C0CLA7DD",218,0)
- S C0CHLOG("END")=$H
+ ;
"RTN","C0CLA7DD",219,0)
- S MSG="Finished indexing of ALR1, ALR2, ALR4, ALR5 indexes - "_$$HTE^XLFDT(C0CHLOG("END"),"1Z")
+REINDEX ; Set data into indexes for current entries.
"RTN","C0CLA7DD",220,0)
- D BMES(MSG),SENDXQA(MSG)
+ ;
"RTN","C0CLA7DD",221,0)
;
"RTN","C0CLA7DD",222,0)
- S MSG="Elapsed Time: "_$$HDIFF^XLFDT(C0CHLOG("END"),C0CHLOG("START"),3)
+ N C0CHLOG,DA,DIK,MSG
"RTN","C0CLA7DD",223,0)
- D BMES(MSG)
+ ;
"RTN","C0CLA7DD",224,0)
- ;
-"RTN","C0CLA7DD",225,0)
S C0CHLOG("START")=$H
+"RTN","C0CLA7DD",225,0)
+ S MSG="Starting indexing of ALR1, ALR2, ALR4, ALR5 indexes - "_$$HTE^XLFDT(C0CHLOG("START"),"1Z")
"RTN","C0CLA7DD",226,0)
- S MSG="Starting indexing of ALR3 index - "_$$HTE^XLFDT(C0CHLOG("START"),"1Z")
+ D BMES(MSG),SENDXQA(MSG)
"RTN","C0CLA7DD",227,0)
- D BMES(MSG),SENDXQA(MSG)
+ ;
"RTN","C0CLA7DD",228,0)
- ;
-"RTN","C0CLA7DD",229,0)
- K DA,DIK
-"RTN","C0CLA7DD",230,0)
S DIK="^AUPNVLAB("
-"RTN","C0CLA7DD",231,0)
- S DIK(1)="1113^ALR3"
-"RTN","C0CLA7DD",232,0)
+"RTN","C0CLA7DD",229,0)
+ S DIK(1)=".02^ALR1^ALR2^ALR4^ALR5"
+"RTN","C0CLA7DD",230,0)
D ENALL^DIK
-"RTN","C0CLA7DD",233,0)
+"RTN","C0CLA7DD",231,0)
;
-"RTN","C0CLA7DD",234,0)
+"RTN","C0CLA7DD",232,0)
S C0CHLOG("END")=$H
-"RTN","C0CLA7DD",235,0)
- S MSG="Finished indexing of ALR3 index - "_$$HTE^XLFDT(C0CHLOG("END"),"1Z")
-"RTN","C0CLA7DD",236,0)
+"RTN","C0CLA7DD",233,0)
+ S MSG="Finished indexing of ALR1, ALR2, ALR4, ALR5 indexes - "_$$HTE^XLFDT(C0CHLOG("END"),"1Z")
+"RTN","C0CLA7DD",234,0)
D BMES(MSG),SENDXQA(MSG)
-"RTN","C0CLA7DD",237,0)
+"RTN","C0CLA7DD",235,0)
;
-"RTN","C0CLA7DD",238,0)
+"RTN","C0CLA7DD",236,0)
S MSG="Elapsed Time: "_$$HDIFF^XLFDT(C0CHLOG("END"),C0CHLOG("START"),3)
-"RTN","C0CLA7DD",239,0)
+"RTN","C0CLA7DD",237,0)
D BMES(MSG)
-"RTN","C0CLA7DD",240,0)
+"RTN","C0CLA7DD",238,0)
;
+"RTN","C0CLA7DD",239,0)
+ S C0CHLOG("START")=$H
+"RTN","C0CLA7DD",240,0)
+ S MSG="Starting indexing of ALR3 index - "_$$HTE^XLFDT(C0CHLOG("START"),"1Z")
"RTN","C0CLA7DD",241,0)
- Q
+ D BMES(MSG),SENDXQA(MSG)
"RTN","C0CLA7DD",242,0)
;
"RTN","C0CLA7DD",243,0)
- ;
+ K DA,DIK
"RTN","C0CLA7DD",244,0)
-BMES(STR) ; Write BMES^XPDUTL statements
+ S DIK="^AUPNVLAB("
"RTN","C0CLA7DD",245,0)
- ;
+ S DIK(1)="1113^ALR3"
"RTN","C0CLA7DD",246,0)
- D BMES^XPDUTL($$CJ^XLFSTR(STR,IOM))
+ D ENALL^DIK
"RTN","C0CLA7DD",247,0)
;
"RTN","C0CLA7DD",248,0)
- Q
+ S C0CHLOG("END")=$H
"RTN","C0CLA7DD",249,0)
- ;
+ S MSG="Finished indexing of ALR3 index - "_$$HTE^XLFDT(C0CHLOG("END"),"1Z")
"RTN","C0CLA7DD",250,0)
- ;
+ D BMES(MSG),SENDXQA(MSG)
"RTN","C0CLA7DD",251,0)
-SENDXQA(MSG) ; Send alert for reindex status
-"RTN","C0CLA7DD",252,0)
;
+"RTN","C0CLA7DD",252,0)
+ S MSG="Elapsed Time: "_$$HDIFF^XLFDT(C0CHLOG("END"),C0CHLOG("START"),3)
"RTN","C0CLA7DD",253,0)
- N XQA,XQAMSG
+ D BMES(MSG)
"RTN","C0CLA7DD",254,0)
;
"RTN","C0CLA7DD",255,0)
- S XQA(DUZ)=""
+ Q
"RTN","C0CLA7DD",256,0)
- S XQAMSG=MSG
-"RTN","C0CLA7DD",257,0)
- D SETUP^XQALERT
-"RTN","C0CLA7DD",258,0)
;
+"RTN","C0CLA7DD",257,0)
+ ;
+"RTN","C0CLA7DD",258,0)
+BMES(STR) ; Write BMES^XPDUTL statements
"RTN","C0CLA7DD",259,0)
+ ;
+"RTN","C0CLA7DD",260,0)
+ D BMES^XPDUTL($$CJ^XLFSTR(STR,IOM))
+"RTN","C0CLA7DD",261,0)
+ ;
+"RTN","C0CLA7DD",262,0)
+ Q
+"RTN","C0CLA7DD",263,0)
+ ;
+"RTN","C0CLA7DD",264,0)
+ ;
+"RTN","C0CLA7DD",265,0)
+SENDXQA(MSG) ; Send alert for reindex status
+"RTN","C0CLA7DD",266,0)
+ ;
+"RTN","C0CLA7DD",267,0)
+ N XQA,XQAMSG
+"RTN","C0CLA7DD",268,0)
+ ;
+"RTN","C0CLA7DD",269,0)
+ S XQA(DUZ)=""
+"RTN","C0CLA7DD",270,0)
+ S XQAMSG=MSG
+"RTN","C0CLA7DD",271,0)
+ D SETUP^XQALERT
+"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)
- Q
+ ;
"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)
-LAB(C0CPTID,C0CSDT,C0CEDT,C0CSC,C0CSPEC,C0CERR,C0CDEST,C0CHL7) ; Entry point for Lab Result Query
+ ; 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)
- K ^TMP("C0C-VLAB",$J)
+ ; 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)
- ; Check and retrieve lab results from LAB DATA file (#63)
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
"RTN","C0CLA7Q",14,0)
- S C0CDEST=$$GCPR^LA7QRY($G(C0CPTID),$G(C0CSDT),$G(C0CEDT),.C0CSC,.C0CSPEC,.C0CERR,$G(C0CDEST),$G(C0CHL7))
+ ; GNU Affero General Public License for more details.
"RTN","C0CLA7Q",15,0)
;
"RTN","C0CLA7Q",16,0)
- ; If V LAB file present then check for lab results that are only in this file
+ ; You should have received a copy of the GNU Affero General Public License
"RTN","C0CLA7Q",17,0)
- ; If results found in V Lab file then build results and add to above results.
+ ; along with this program. If not, see .
"RTN","C0CLA7Q",18,0)
- I $D(^AUPNVLAB) D
+ ;
"RTN","C0CLA7Q",19,0)
- . D VCHECK
+ ;
"RTN","C0CLA7Q",20,0)
- . I $D(^TMP("C0C-VLAB",$J,3)) D VBUILD
+ Q
"RTN","C0CLA7Q",21,0)
;
"RTN","C0CLA7Q",22,0)
- ;K ^TMP("C0C-VLAB",$J)
-"RTN","C0CLA7Q",23,0)
;
+"RTN","C0CLA7Q",23,0)
+LAB(C0CPTID,C0CSDT,C0CEDT,C0CSC,C0CSPEC,C0CERR,C0CDEST,C0CHL7) ; Entry point for Lab Result Query
"RTN","C0CLA7Q",24,0)
- Q C0CDEST
+ ;
"RTN","C0CLA7Q",25,0)
;
"RTN","C0CLA7Q",26,0)
- ;
+ K ^TMP("C0C-VLAB",$J)
"RTN","C0CLA7Q",27,0)
-VCHECK ; If V LAB file present then check for lab results that are only in this file.
-"RTN","C0CLA7Q",28,0)
;
+"RTN","C0CLA7Q",28,0)
+ ; Check and retrieve lab results from LAB DATA file (#63)
"RTN","C0CLA7Q",29,0)
- N C0CDA,C0CEND,C0CROOT,C0CVLAB,LA7PTID,LA7SC,LA7SCRC,LA7SPEC
+ S C0CDEST=$$GCPR^LA7QRY($G(C0CPTID),$G(C0CSDT),$G(C0CEDT),.C0CSC,.C0CSPEC,.C0CERR,$G(C0CDEST),$G(C0CHL7))
"RTN","C0CLA7Q",30,0)
;
"RTN","C0CLA7Q",31,0)
- S LA7PTID=C0CPTID
+ ; If V LAB file present then check for lab results that are only in this file
"RTN","C0CLA7Q",32,0)
- D PATID^LA7QRY2
+ ; If results found in V Lab file then build results and add to above results.
"RTN","C0CLA7Q",33,0)
- I $D(LA7ERR) Q
+ I $D(^AUPNVLAB) D
"RTN","C0CLA7Q",34,0)
- ;
+ . D VCHECK
"RTN","C0CLA7Q",35,0)
- ; Resolve search codes to lab datanames
+ . I $D(^TMP("C0C-VLAB",$J,3)) D VBUILD
"RTN","C0CLA7Q",36,0)
- S LA7SC=$G(C0CSC)
+ ;
"RTN","C0CLA7Q",37,0)
- I $T(SCLIST^LA7QRY2)'="" D
+ ;K ^TMP("C0C-VLAB",$J)
"RTN","C0CLA7Q",38,0)
- . N TMP
+ ;
"RTN","C0CLA7Q",39,0)
- . S LA7SCRC=$G(C0CSC)
+ Q C0CDEST
"RTN","C0CLA7Q",40,0)
- . S TMP=$$SCLIST^LA7QRY2(LA7SCRC)
+ ;
"RTN","C0CLA7Q",41,0)
- . S LA7SC=TMP
+ ;
"RTN","C0CLA7Q",42,0)
- ;
+VCHECK ; If V LAB file present then check for lab results that are only in this file.
"RTN","C0CLA7Q",43,0)
- I LA7SC'="*" D CHKSC^LA7QRY1
+ ;
"RTN","C0CLA7Q",44,0)
- ;
+ N C0CDA,C0CEND,C0CROOT,C0CVLAB,LA7PTID,LA7SC,LA7SCRC,LA7SPEC
"RTN","C0CLA7Q",45,0)
- ; Convert specimen codes to file #61 Topography entries
+ ;
"RTN","C0CLA7Q",46,0)
- S LA7SPEC=$G(C0CSPEC)
+ S LA7PTID=C0CPTID
"RTN","C0CLA7Q",47,0)
- I LA7SPEC'="*" D SPEC^LA7QRY1
+ D PATID^LA7QRY2
"RTN","C0CLA7Q",48,0)
- ;
+ I $D(LA7ERR) Q
"RTN","C0CLA7Q",49,0)
- S C0CROOT="^AUPNVLAB(""ALR4"",DFN,C0CSDT)",C0CEND=0
+ ;
"RTN","C0CLA7Q",50,0)
- ;
+ ; Resolve search codes to lab datanames
"RTN","C0CLA7Q",51,0)
- F S C0CROOT=$Q(@C0CROOT) Q:C0CROOT="" D Q:C0CEND
+ S LA7SC=$G(C0CSC)
"RTN","C0CLA7Q",52,0)
- . I $QS(C0CROOT,1)'="ALR4"!($QS(C0CROOT,2)'=DFN) S C0CEND=1 Q ; Left x-ref or patient
+ I $T(SCLIST^LA7QRY2)'="" D
"RTN","C0CLA7Q",53,0)
- . I $QS(C0CROOT,3)>C0CEDT S C0CEND=1 Q ; Exceeded end date/time
+ . N TMP
"RTN","C0CLA7Q",54,0)
- . S C0CDA=$QS(C0CROOT,4)
+ . S LA7SCRC=$G(C0CSC)
"RTN","C0CLA7Q",55,0)
- . I $D(^TMP("C0C-VLAB",$J,1,C0CDA)) Q ; Already checked during scan of file #63
+ . S TMP=$$SCLIST^LA7QRY2(LA7SCRC)
"RTN","C0CLA7Q",56,0)
- . I $P($G(^AUPNVLAB(C0CDA,11)),"^",8)=1 Q ; Source is LAB DATA file - skip
+ . S LA7SC=TMP
"RTN","C0CLA7Q",57,0)
- . D VCHK1
-"RTN","C0CLA7Q",58,0)
;
+"RTN","C0CLA7Q",58,0)
+ I LA7SC'="*" D CHKSC^LA7QRY1
"RTN","C0CLA7Q",59,0)
;
"RTN","C0CLA7Q",60,0)
- Q
+ ; Convert specimen codes to file #61 Topography entries
"RTN","C0CLA7Q",61,0)
- ;
+ S LA7SPEC=$G(C0CSPEC)
"RTN","C0CLA7Q",62,0)
- ;
+ I LA7SPEC'="*" D SPEC^LA7QRY1
"RTN","C0CLA7Q",63,0)
-VBUILD ; Build results found only in V LAB file into HL7 structure.
-"RTN","C0CLA7Q",64,0)
;
+"RTN","C0CLA7Q",64,0)
+ S C0CROOT="^AUPNVLAB(""ALR4"",DFN,C0CSDT)",C0CEND=0
"RTN","C0CLA7Q",65,0)
;
"RTN","C0CLA7Q",66,0)
- Q
+ F S C0CROOT=$Q(@C0CROOT) Q:C0CROOT="" D Q:C0CEND
"RTN","C0CLA7Q",67,0)
- ;
+ . I $QS(C0CROOT,1)'="ALR4"!($QS(C0CROOT,2)'=DFN) S C0CEND=1 Q ; Left x-ref or patient
"RTN","C0CLA7Q",68,0)
- ;
+ . I $QS(C0CROOT,3)>C0CEDT S C0CEND=1 Q ; Exceeded end date/time
"RTN","C0CLA7Q",69,0)
-LNCHK ; Check for corresponding entry in V LAB file and related LOINC code for a result in file #63.
+ . S C0CDA=$QS(C0CROOT,4)
"RTN","C0CLA7Q",70,0)
- ; Call from LA7QRY2
+ . I $D(^TMP("C0C-VLAB",$J,1,C0CDA)) Q ; Already checked during scan of file #63
"RTN","C0CLA7Q",71,0)
- ;
+ . I $P($G(^AUPNVLAB(C0CDA,11)),"^",8)=1 Q ; Source is LAB DATA file - skip
"RTN","C0CLA7Q",72,0)
- N DFN,C0C60,C0C63,C0CACC,C0CDA,C0CDT,C0CLN,C0CPDA,C0CPTEST,C0CSPEC,C0CTEST,X
+ . D VCHK1
"RTN","C0CLA7Q",73,0)
;
"RTN","C0CLA7Q",74,0)
- S DFN=$P(^LR(LRDFN,0),"^",3)
-"RTN","C0CLA7Q",75,0)
- S C0C63(0)=^LR(LRDFN,LRSS,LRIDT,0)
-"RTN","C0CLA7Q",76,0)
- S C0CDT=$P(C0C63(0),"^"),C0CACC=$P(C0C63(0),"^",6),C0CSPEC=$P(C0C63(0),"^",5)
-"RTN","C0CLA7Q",77,0)
- S (C0CTEST,C0CTEST(64),C0CPTEST,C0CPTEST(64),C0CLN)=""
-"RTN","C0CLA7Q",78,0)
;
+"RTN","C0CLA7Q",75,0)
+ Q
+"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",79,0)
- ; ^AUPNVLAB("ALR1",5380,"EKT 0307 48",173,3080307.211055,5427197)=""
+ ;
"RTN","C0CLA7Q",80,0)
;
"RTN","C0CLA7Q",81,0)
- S C0C60=""
-"RTN","C0CLA7Q",82,0)
- F S C0C60=$O(^LAB(60,"C",LRSS_";"_LRSB_";1",C0C60)) Q:'C0C60 D Q:C0CLN'=""
-"RTN","C0CLA7Q",83,0)
- . D FINDDT
-"RTN","C0CLA7Q",84,0)
- . I C0CDA<1 Q
-"RTN","C0CLA7Q",85,0)
- . I $P($G(^AUPNVLAB(C0CDA,11)),"^",8)'=1 Q ; Source is not LAB DATA file - skip
-"RTN","C0CLA7Q",86,0)
- . S C0CLN=$P($G(^AUPNVLAB(C0CDA,11)),"^",13)
-"RTN","C0CLA7Q",87,0)
- . S C0CPDA=$P($G(^AUPNVLAB(C0CDA,12)),"^",8)
-"RTN","C0CLA7Q",88,0)
- . I C0CPDA,'$D(^AUPNVLAB(C0CPDA,0)) S C0CPDA="" ; Dangling pointer
-"RTN","C0CLA7Q",89,0)
- . I C0CPDA="" S C0CPDA=C0CDA
-"RTN","C0CLA7Q",90,0)
- . S C0CTEST=$P($G(^AUPNVLAB(C0CDA,0)),"^"),X=$P($G(^LAB(60,C0CTEST,64)),"^",2)
-"RTN","C0CLA7Q",91,0)
- . I X S C0CTEST(64)=$P($G(^LAM(X,0)),"^",2)
-"RTN","C0CLA7Q",92,0)
- . S C0CPTEST=$P($G(^AUPNVLAB(C0CPDA,0)),"^"),X=$P($G(^LAB(60,C0CPTEST,64)),"^")
-"RTN","C0CLA7Q",93,0)
- . I X S C0CPTEST(64)=$P($G(^LAM(X,0)),"^",2)
-"RTN","C0CLA7Q",94,0)
- . S ^TMP("C0C-VLAB",$J,1,C0CDA)=""
-"RTN","C0CLA7Q",95,0)
- . I C0CDA'=C0CPDA S ^TMP("C0C-VLAB",$J,1,C0CPDA)=""
-"RTN","C0CLA7Q",96,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)
- S X=$P(LA7X,"^",3)
-"RTN","C0CLA7Q",99,0)
- ; If order NLT then update if no order NLT
-"RTN","C0CLA7Q",100,0)
- I C0CPTEST(64),$P(X,"!")="" S $P(X,"!")=C0CPTEST(64)
-"RTN","C0CLA7Q",101,0)
- ;
-"RTN","C0CLA7Q",102,0)
- ; If result NLT then update if no result NLT
-"RTN","C0CLA7Q",103,0)
- I C0CTEST(64),$P(X,"!",2)="" S $P(X,"!",2)=C0CTEST(64)
-"RTN","C0CLA7Q",104,0)
- ;
-"RTN","C0CLA7Q",105,0)
- ; If LOINC found then update variable with LN code
-"RTN","C0CLA7Q",106,0)
- I C0CLN'="",$P(X,"!",3)="" S $P(X,"!",3)=C0CLN
-"RTN","C0CLA7Q",107,0)
- ;
-"RTN","C0CLA7Q",108,0)
- S $P(LA7X,"^",3)=X
-"RTN","C0CLA7Q",109,0)
- ;
-"RTN","C0CLA7Q",110,0)
Q
-"RTN","C0CLA7Q",111,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",85,0)
+ ; Call from LA7QRY2
+"RTN","C0CLA7Q",86,0)
+ ;
+"RTN","C0CLA7Q",87,0)
+ N DFN,C0C60,C0C63,C0CACC,C0CDA,C0CDT,C0CLN,C0CPDA,C0CPTEST,C0CSPEC,C0CTEST,X
+"RTN","C0CLA7Q",88,0)
+ ;
+"RTN","C0CLA7Q",89,0)
+ S DFN=$P(^LR(LRDFN,0),"^",3)
+"RTN","C0CLA7Q",90,0)
+ S C0C63(0)=^LR(LRDFN,LRSS,LRIDT,0)
+"RTN","C0CLA7Q",91,0)
+ S C0CDT=$P(C0C63(0),"^"),C0CACC=$P(C0C63(0),"^",6),C0CSPEC=$P(C0C63(0),"^",5)
+"RTN","C0CLA7Q",92,0)
+ S (C0CTEST,C0CTEST(64),C0CPTEST,C0CPTEST(64),C0CLN)=""
+"RTN","C0CLA7Q",93,0)
+ ;
+"RTN","C0CLA7Q",94,0)
+ ; ^AUPNVLAB("ALR1",5380,"EKT 0307 48",173,3080307.211055,5427197)=""
+"RTN","C0CLA7Q",95,0)
+ ;
+"RTN","C0CLA7Q",96,0)
+ S C0C60=""
+"RTN","C0CLA7Q",97,0)
+ F S C0C60=$O(^LAB(60,"C",LRSS_";"_LRSB_";1",C0C60)) Q:'C0C60 D Q:C0CLN'=""
+"RTN","C0CLA7Q",98,0)
+ . D FINDDT
+"RTN","C0CLA7Q",99,0)
+ . I C0CDA<1 Q
+"RTN","C0CLA7Q",100,0)
+ . I $P($G(^AUPNVLAB(C0CDA,11)),"^",8)'=1 Q ; Source is not LAB DATA file - skip
+"RTN","C0CLA7Q",101,0)
+ . S C0CLN=$P($G(^AUPNVLAB(C0CDA,11)),"^",13)
+"RTN","C0CLA7Q",102,0)
+ . S C0CPDA=$P($G(^AUPNVLAB(C0CDA,12)),"^",8)
+"RTN","C0CLA7Q",103,0)
+ . I C0CPDA,'$D(^AUPNVLAB(C0CPDA,0)) S C0CPDA="" ; Dangling pointer
+"RTN","C0CLA7Q",104,0)
+ . I C0CPDA="" S C0CPDA=C0CDA
+"RTN","C0CLA7Q",105,0)
+ . S C0CTEST=$P($G(^AUPNVLAB(C0CDA,0)),"^"),X=$P($G(^LAB(60,C0CTEST,64)),"^",2)
+"RTN","C0CLA7Q",106,0)
+ . I X S C0CTEST(64)=$P($G(^LAM(X,0)),"^",2)
+"RTN","C0CLA7Q",107,0)
+ . S C0CPTEST=$P($G(^AUPNVLAB(C0CPDA,0)),"^"),X=$P($G(^LAB(60,C0CPTEST,64)),"^")
+"RTN","C0CLA7Q",108,0)
+ . I X S C0CPTEST(64)=$P($G(^LAM(X,0)),"^",2)
+"RTN","C0CLA7Q",109,0)
+ . S ^TMP("C0C-VLAB",$J,1,C0CDA)=""
+"RTN","C0CLA7Q",110,0)
+ . I C0CDA'=C0CPDA S ^TMP("C0C-VLAB",$J,1,C0CPDA)=""
+"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",112,0)
;
"RTN","C0CLA7Q",113,0)
-TMPCHK ; Check if LN/NLT codes saved from V LAB file above and use when building OBR/OBX segments
+ S X=$P(LA7X,"^",3)
"RTN","C0CLA7Q",114,0)
- ; Called from LA7VOBX1
+ ; If order NLT then update if no order NLT
"RTN","C0CLA7Q",115,0)
- ;
+ I C0CPTEST(64),$P(X,"!")="" S $P(X,"!")=C0CPTEST(64)
"RTN","C0CLA7Q",116,0)
- N I,X
-"RTN","C0CLA7Q",117,0)
;
+"RTN","C0CLA7Q",117,0)
+ ; If result NLT then update if no result NLT
"RTN","C0CLA7Q",118,0)
- S X=$G(^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB))
+ I C0CTEST(64),$P(X,"!",2)="" S $P(X,"!",2)=C0CTEST(64)
"RTN","C0CLA7Q",119,0)
- I X="" Q
+ ;
"RTN","C0CLA7Q",120,0)
- F I=1:1:3 I $P(LA7X,"!",I)="",$P(X,"^",I)'="" S $P(LA7X,"!",I)=$P(X,"^",I)
+ ; If LOINC found then update variable with LN code
"RTN","C0CLA7Q",121,0)
- S $P(LA7VAL,"^",3)=LA7X
+ I C0CLN'="",$P(X,"!",3)="" S $P(X,"!",3)=C0CLN
"RTN","C0CLA7Q",122,0)
;
"RTN","C0CLA7Q",123,0)
- Q
+ S $P(LA7X,"^",3)=X
"RTN","C0CLA7Q",124,0)
;
"RTN","C0CLA7Q",125,0)
- ;
+ Q
"RTN","C0CLA7Q",126,0)
-VCHK1 ; Check the entry in V Lab to determine if it meets criteria
+ ;
"RTN","C0CLA7Q",127,0)
;
"RTN","C0CLA7Q",128,0)
- N C0CVLAB,I
+TMPCHK ; Check if LN/NLT codes saved from V LAB file above and use when building OBR/OBX segments
"RTN","C0CLA7Q",129,0)
- ;
+ ; Called from LA7VOBX1
"RTN","C0CLA7Q",130,0)
- F I=0,12 S C0CVLAB(I)=$G(^AUPNVLAB(C0CDA,I))
+ ;
"RTN","C0CLA7Q",131,0)
- ;
+ N I,X
"RTN","C0CLA7Q",132,0)
- ; JMC 04/13/09 - Store anything for now that meets date criteria.
+ ;
"RTN","C0CLA7Q",133,0)
- D VSTORE
+ S X=$G(^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB))
"RTN","C0CLA7Q",134,0)
- ;
+ I X="" Q
"RTN","C0CLA7Q",135,0)
- Q
+ F I=1:1:3 I $P(LA7X,"!",I)="",$P(X,"^",I)'="" S $P(LA7X,"!",I)=$P(X,"^",I)
"RTN","C0CLA7Q",136,0)
- ;
+ S $P(LA7VAL,"^",3)=LA7X
"RTN","C0CLA7Q",137,0)
;
"RTN","C0CLA7Q",138,0)
-VSTORE ; Store entry for building in HL7 message when parent is from V LAB file.
+ Q
"RTN","C0CLA7Q",139,0)
;
"RTN","C0CLA7Q",140,0)
- N C0CPDA,C0CPTEST
+ ;
"RTN","C0CLA7Q",141,0)
- ;
+VCHK1 ; Check the entry in V Lab to determine if it meets criteria
"RTN","C0CLA7Q",142,0)
- ; Determine parent test to use for OBR segment
+ ;
"RTN","C0CLA7Q",143,0)
- S C0CPDA=$P(C0CVLAB(12),"^",8)
+ N C0CVLAB,I
"RTN","C0CLA7Q",144,0)
- I C0CPDA="" S C0CPDA=C0CDA
+ ;
"RTN","C0CLA7Q",145,0)
- ;
+ F I=0,12 S C0CVLAB(I)=$G(^AUPNVLAB(C0CDA,I))
"RTN","C0CLA7Q",146,0)
- ; Determine parent test
+ ;
"RTN","C0CLA7Q",147,0)
- S C0CPTEST=$P($G(^AUPNVLAB(C0CPDA,0)),"^")
+ ; JMC 04/13/09 - Store anything for now that meets date criteria.
"RTN","C0CLA7Q",148,0)
- ;
+ D VSTORE
"RTN","C0CLA7Q",149,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",150,0)
Q
+"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",154,0)
-FINDDT ; Find entry in V LAB for the date/time or one close to it.
-"RTN","C0CLA7Q",155,0)
- ; RPMS stores related specimen entries under the same date/time.
-"RTN","C0CLA7Q",156,0)
- ; Lab file #63 creates unique entries with slightly different times.
-"RTN","C0CLA7Q",157,0)
;
+"RTN","C0CLA7Q",155,0)
+ N C0CPDA,C0CPTEST
+"RTN","C0CLA7Q",156,0)
+ ;
+"RTN","C0CLA7Q",157,0)
+ ; Determine parent test to use for OBR segment
"RTN","C0CLA7Q",158,0)
- S C0CDA=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,C0CDT,0))
+ S C0CPDA=$P(C0CVLAB(12),"^",8)
"RTN","C0CLA7Q",159,0)
- I C0CDA>0 Q
+ I C0CPDA="" S C0CPDA=C0CDA
"RTN","C0CLA7Q",160,0)
;
"RTN","C0CLA7Q",161,0)
- ; If entry found then confirm that specimen type matches.
+ ; Determine parent test
"RTN","C0CLA7Q",162,0)
- N C0CDTY
+ S C0CPTEST=$P($G(^AUPNVLAB(C0CPDA,0)),"^")
"RTN","C0CLA7Q",163,0)
- S C0CDTY=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,0))
+ ;
"RTN","C0CLA7Q",164,0)
- I C0CDTY D
+ S ^TMP("C0C-VLAB",$J,3,$P(C0CVLAB(0),"^",2),$P(C0CVLAB(12),"^"),C0CPTEST,C0CDA)=C0CPDA
"RTN","C0CLA7Q",165,0)
- . I $P(C0CDT,".")'=$P(C0CDTY,".") Q
+ ;
"RTN","C0CLA7Q",166,0)
- . S C0CDA=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,C0CDTY,0))
+ Q
"RTN","C0CLA7Q",167,0)
- . I C0CSPEC'=$P($G(^AUPNVLAB(C0CDA,11)),"^",3) S C0CDA=""
+ ;
"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",170,0)
+ ; RPMS stores related specimen entries under the same date/time.
+"RTN","C0CLA7Q",171,0)
+ ; Lab file #63 creates unique entries with slightly different times.
+"RTN","C0CLA7Q",172,0)
+ ;
+"RTN","C0CLA7Q",173,0)
+ S C0CDA=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,C0CDT,0))
+"RTN","C0CLA7Q",174,0)
+ I C0CDA>0 Q
+"RTN","C0CLA7Q",175,0)
+ ;
+"RTN","C0CLA7Q",176,0)
+ ; If entry found then confirm that specimen type matches.
+"RTN","C0CLA7Q",177,0)
+ N C0CDTY
+"RTN","C0CLA7Q",178,0)
+ S C0CDTY=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,0))
+"RTN","C0CLA7Q",179,0)
+ I C0CDTY D
+"RTN","C0CLA7Q",180,0)
+ . I $P(C0CDT,".")'=$P(C0CDTY,".") Q
+"RTN","C0CLA7Q",181,0)
+ . S C0CDA=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,C0CDTY,0))
+"RTN","C0CLA7Q",182,0)
+ . I C0CSPEC'=$P($G(^AUPNVLAB(C0CDA,11)),"^",3) S C0CDA=""
+"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 .
"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.,
-"RTN","C0CLABS",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","C0CLABS",20,0)
- ;
-"RTN","C0CLABS",21,0)
MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
-"RTN","C0CLABS",22,0)
+"RTN","C0CLABS",19,0)
; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
-"RTN","C0CLABS",23,0)
+"RTN","C0CLABS",20,0)
; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
-"RTN","C0CLABS",24,0)
+"RTN","C0CLABS",21,0)
; MIXML IS THE TEMPLATE TO USE
-"RTN","C0CLABS",25,0)
+"RTN","C0CLABS",22,0)
; MOXML IS THE OUTPUT XML ARRAY
-"RTN","C0CLABS",26,0)
+"RTN","C0CLABS",23,0)
; DFN IS THE PATIENT RECORD NUMBER
-"RTN","C0CLABS",27,0)
+"RTN","C0CLABS",24,0)
N C0COXML,C0CO,C0CV,C0CIXML
-"RTN","C0CLABS",28,0)
+"RTN","C0CLABS",25,0)
I '$D(MIVAR) S C0CV="" ;DEFAULT
-"RTN","C0CLABS",29,0)
+"RTN","C0CLABS",26,0)
E S C0CV=MIVAR ;PASSED VARIABLE ARRAY
-"RTN","C0CLABS",30,0)
+"RTN","C0CLABS",27,0)
I '$D(MIXML) S C0CIXML="" ;DEFAULT
-"RTN","C0CLABS",31,0)
+"RTN","C0CLABS",28,0)
E S C0CIXML=MIXML ;PASSED INPUT XML
-"RTN","C0CLABS",32,0)
+"RTN","C0CLABS",29,0)
D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
-"RTN","C0CLABS",33,0)
+"RTN","C0CLABS",30,0)
I '$D(MOXML) S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
-"RTN","C0CLABS",34,0)
+"RTN","C0CLABS",31,0)
E S C0CO=MOXML
-"RTN","C0CLABS",35,0)
+"RTN","C0CLABS",32,0)
; ZWR C0COXML
-"RTN","C0CLABS",36,0)
+"RTN","C0CLABS",33,0)
M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
-"RTN","C0CLABS",37,0)
+"RTN","C0CLABS",34,0)
Q
-"RTN","C0CLABS",38,0)
+"RTN","C0CLABS",35,0)
;
-"RTN","C0CLABS",39,0)
+"RTN","C0CLABS",36,0)
RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS
-"RTN","C0CLABS",40,0)
+"RTN","C0CLABS",37,0)
; RTN IS PASSED BY REFERENCE
-"RTN","C0CLABS",41,0)
+"RTN","C0CLABS",38,0)
;N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
-"RTN","C0CLABS",42,0)
+"RTN","C0CLABS",39,0)
;N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
-"RTN","C0CLABS",43,0)
+"RTN","C0CLABS",40,0)
I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
-"RTN","C0CLABS",44,0)
+"RTN","C0CLABS",41,0)
I RMIXML="" D ; INPUT XML NOT PASSED
-"RTN","C0CLABS",45,0)
+"RTN","C0CLABS",42,0)
. D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
-"RTN","C0CLABS",46,0)
+"RTN","C0CLABS",43,0)
. D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
-"RTN","C0CLABS",47,0)
+"RTN","C0CLABS",44,0)
. S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
-"RTN","C0CLABS",48,0)
+"RTN","C0CLABS",45,0)
E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
-"RTN","C0CLABS",49,0)
+"RTN","C0CLABS",46,0)
I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED
-"RTN","C0CLABS",50,0)
+"RTN","C0CLABS",47,0)
. S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
-"RTN","C0CLABS",51,0)
+"RTN","C0CLABS",48,0)
E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
-"RTN","C0CLABS",52,0)
+"RTN","C0CLABS",49,0)
D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
-"RTN","C0CLABS",53,0)
+"RTN","C0CLABS",50,0)
D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
-"RTN","C0CLABS",54,0)
+"RTN","C0CLABS",51,0)
D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
-"RTN","C0CLABS",55,0)
+"RTN","C0CLABS",52,0)
I '$D(C0CQT) S C0CQT=0 ; DEFAULT NOT SILENT
-"RTN","C0CLABS",56,0)
+"RTN","C0CLABS",53,0)
I 'C0CQT D ; WE ARE DEBUGGING
-"RTN","C0CLABS",57,0)
+"RTN","C0CLABS",54,0)
. W "I MAPPED",!
-"RTN","C0CLABS",58,0)
+"RTN","C0CLABS",55,0)
. W "VARS:",C0CV,!
-"RTN","C0CLABS",59,0)
+"RTN","C0CLABS",56,0)
. W "DFN:",DFN,!
-"RTN","C0CLABS",60,0)
+"RTN","C0CLABS",57,0)
. ;D PARY^C0CXPATH("C0CT") ; SECTION TEMPLATE
-"RTN","C0CLABS",61,0)
+"RTN","C0CLABS",58,0)
. ;D PARY^C0CXPATH("C0CRT") ;REQUEST TEMPLATE (OCR)
-"RTN","C0CLABS",62,0)
+"RTN","C0CLABS",59,0)
. ;D PARY^C0CXPATH("C0CTT") ;TEST TEMPLATE (OCX)
-"RTN","C0CLABS",63,0)
+"RTN","C0CLABS",60,0)
D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT
-"RTN","C0CLABS",64,0)
+"RTN","C0CLABS",61,0)
I '$D(@C0CV@(0)) D Q ; NO VARS THERE
-"RTN","C0CLABS",65,0)
+"RTN","C0CLABS",62,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)
+"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",68,0)
+"RTN","C0CLABS",65,0)
K @RIMVARS
-"RTN","C0CLABS",69,0)
+"RTN","C0CLABS",66,0)
M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
-"RTN","C0CLABS",70,0)
+"RTN","C0CLABS",67,0)
N C0CI,C0CJ,C0CMAP,C0CTMAP,C0CTMP
-"RTN","C0CLABS",71,0)
+"RTN","C0CLABS",68,0)
S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
-"RTN","C0CLABS",72,0)
+"RTN","C0CLABS",69,0)
N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
-"RTN","C0CLABS",73,0)
+"RTN","C0CLABS",70,0)
N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
-"RTN","C0CLABS",74,0)
+"RTN","C0CLABS",71,0)
N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
-"RTN","C0CLABS",75,0)
+"RTN","C0CLABS",72,0)
; TO IMPROVE PERFORMANCE
-"RTN","C0CLABS",76,0)
+"RTN","C0CLABS",73,0)
D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;
-"RTN","C0CLABS",77,0)
+"RTN","C0CLABS",74,0)
F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES
-"RTN","C0CLABS",78,0)
+"RTN","C0CLABS",75,0)
. K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
-"RTN","C0CLABS",79,0)
+"RTN","C0CLABS",76,0)
. S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
-"RTN","C0CLABS",80,0)
+"RTN","C0CLABS",77,0)
. S C0CMAP=$NA(@C0CV@(C0CI)) ;
-"RTN","C0CLABS",81,0)
+"RTN","C0CLABS",78,0)
. I 'C0CQT W "MAPOBR:",C0CMAP,!
-"RTN","C0CLABS",82,0)
+"RTN","C0CLABS",79,0)
. ;MAPPING FOR TEST REQUEST GOES HERE
-"RTN","C0CLABS",83,0)
+"RTN","C0CLABS",80,0)
. D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
-"RTN","C0CLABS",84,0)
+"RTN","C0CLABS",81,0)
. ;D QOPEN^C0CXPATH("C0CRBLD",C0CRTMP,C0CIS) ;1ST PART OF XML
-"RTN","C0CLABS",85,0)
+"RTN","C0CLABS",82,0)
. D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO
-"RTN","C0CLABS",86,0)
+"RTN","C0CLABS",83,0)
. I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST
-"RTN","C0CLABS",87,0)
+"RTN","C0CLABS",84,0)
. . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
-"RTN","C0CLABS",88,0)
+"RTN","C0CLABS",85,0)
. . K C0CTO ; CLEAR OUTPUT VARIABLE
-"RTN","C0CLABS",89,0)
+"RTN","C0CLABS",86,0)
. . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT
-"RTN","C0CLABS",90,0)
+"RTN","C0CLABS",87,0)
. . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
-"RTN","C0CLABS",91,0)
+"RTN","C0CLABS",88,0)
. . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
-"RTN","C0CLABS",92,0)
+"RTN","C0CLABS",89,0)
. . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
-"RTN","C0CLABS",93,0)
+"RTN","C0CLABS",90,0)
. . . I 'C0CQT W "MAPOBX:",C0CTMAP,!
-"RTN","C0CLABS",94,0)
+"RTN","C0CLABS",91,0)
. . . D MAP^C0CXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
-"RTN","C0CLABS",95,0)
+"RTN","C0CLABS",92,0)
. . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE
-"RTN","C0CLABS",96,0)
+"RTN","C0CLABS",93,0)
. . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;
-"RTN","C0CLABS",97,0)
+"RTN","C0CLABS",94,0)
. . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
-"RTN","C0CLABS",98,0)
+"RTN","C0CLABS",95,0)
. . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
-"RTN","C0CLABS",99,0)
+"RTN","C0CLABS",96,0)
. . . ;I C0CJ=1 D ; FIRST TIME, JUST COPY
-"RTN","C0CLABS",100,0)
+"RTN","C0CLABS",97,0)
. . . ;. D CP^C0CXPATH("C0CTMP","C0CTO") ; START BUILDING TEST XML
-"RTN","C0CLABS",101,0)
+"RTN","C0CLABS",98,0)
. . . ;E D INSINNER^C0CXPATH("C0CTO","C0CTMP")
-"RTN","C0CLABS",102,0)
+"RTN","C0CLABS",99,0)
. . . ;
-"RTN","C0CLABS",103,0)
+"RTN","C0CLABS",100,0)
. . . ;D PUSHA^C0CXPATH("C0CTO",C0CTMP) ;ADD THE TEST TO BUFFER
-"RTN","C0CLABS",104,0)
+"RTN","C0CLABS",101,0)
. . ; I 'C0CQT D PARY^C0CXPATH("C0CTO")
-"RTN","C0CLABS",105,0)
+"RTN","C0CLABS",102,0)
. . ;D INSINNER^C0CXPATH(C0CRTMP,"C0CTO","//Results/Result/Test") ;INSERT TST
-"RTN","C0CLABS",106,0)
+"RTN","C0CLABS",103,0)
. ;D QCLOSE^C0CXPATH("C0CRBLD",C0CRTMP,"//Results/Result/Test") ;END OF XML
-"RTN","C0CLABS",107,0)
+"RTN","C0CLABS",104,0)
. D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;
-"RTN","C0CLABS",108,0)
+"RTN","C0CLABS",105,0)
. ;I C0CI=1 D ; FIRST TIME, COPY INSTEAD OF INSERT
-"RTN","C0CLABS",109,0)
- . . ;D CP^C0CXPATH(C0CRTMP,"RTN") ;
-"RTN","C0CLABS",110,0)
+"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",111,0)
+"RTN","C0CLABS",108,0)
D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;
-"RTN","C0CLABS",112,0)
+"RTN","C0CLABS",109,0)
D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML
-"RTN","C0CLABS",113,0)
+"RTN","C0CLABS",110,0)
K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
-"RTN","C0CLABS",114,0)
+"RTN","C0CLABS",111,0)
Q
-"RTN","C0CLABS",115,0)
+"RTN","C0CLABS",112,0)
;
-"RTN","C0CLABS",116,0)
+"RTN","C0CLABS",113,0)
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)
- ; 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)
+"RTN","C0CLABS",120,0)
S C0CNSSN=0
-"RTN","C0CLABS",124,0)
+"RTN","C0CLABS",121,0)
S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
-"RTN","C0CLABS",125,0)
+"RTN","C0CLABS",122,0)
D GHL7 ; GET HL7 MESSAGE FOR THIS PATIENT
-"RTN","C0CLABS",126,0)
+"RTN","C0CLABS",123,0)
I C0CNSSN=1 D Q ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT
-"RTN","C0CLABS",127,0)
+"RTN","C0CLABS",124,0)
. S @C0CLB@(0)=0
-"RTN","C0CLABS",128,0)
+"RTN","C0CLABS",125,0)
K @C0CLB ; CLEAR OUT OLD VARS IF ANY
-"RTN","C0CLABS",129,0)
+"RTN","C0CLABS",126,0)
N QTSAV S QTSAV=C0CQT ;SAVE QUIET FLAG
-"RTN","C0CLABS",130,0)
+"RTN","C0CLABS",127,0)
S C0CQT=1 ; SURPRESS LISTING
-"RTN","C0CLABS",131,0)
+"RTN","C0CLABS",128,0)
D LIST ; EXTRACT THE VARIABLES
-"RTN","C0CLABS",132,0)
+"RTN","C0CLABS",129,0)
; FOR CERTIFICATION, SEE IF THERE ARE OTHER RESULTS TO ADD
-"RTN","C0CLABS",133,0)
+"RTN","C0CLABS",130,0)
D EN^C0CORSLT(C0CLB,DFN) ; LOOKS FOR ECG TESTS
-"RTN","C0CLABS",134,0)
+"RTN","C0CLABS",131,0)
S C0CQT=QTSAV ; RESET SILENT FLAG
-"RTN","C0CLABS",135,0)
+"RTN","C0CLABS",132,0)
K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT
-"RTN","C0CLABS",136,0)
+"RTN","C0CLABS",133,0)
I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
-"RTN","C0CLABS",137,0)
+"RTN","C0CLABS",134,0)
Q
-"RTN","C0CLABS",138,0)
+"RTN","C0CLABS",135,0)
;
-"RTN","C0CLABS",139,0)
+"RTN","C0CLABS",136,0)
GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT
-"RTN","C0CLABS",140,0)
+"RTN","C0CLABS",137,0)
; N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR
-"RTN","C0CLABS",141,0)
+"RTN","C0CLABS",138,0)
; SET UP FOR LAB API CALL
-"RTN","C0CLABS",142,0)
+"RTN","C0CLABS",139,0)
S C0CPTID=$$SSN^C0CDPT(DFN) ; GET THE SSN FOR THIS PATIENT
-"RTN","C0CLABS",143,0)
+"RTN","C0CLABS",140,0)
I C0CPTID="" D Q ; NO SSN, COMPLAIN AND QUIT
-"RTN","C0CLABS",144,0)
+"RTN","C0CLABS",141,0)
. W "LAB LOOKUP FAILED, NO SSN",!
-"RTN","C0CLABS",145,0)
+"RTN","C0CLABS",142,0)
. S C0CNSSN=1 ; SET NO SSN FLAG
-"RTN","C0CLABS",146,0)
+"RTN","C0CLABS",143,0)
S C0CSPC="*" ; LOOKING FOR ALL LABS
-"RTN","C0CLABS",147,0)
+"RTN","C0CLABS",144,0)
;I $D(^TMP("C0CCCR","RPMS")) D ; RUNNING RPMS
-"RTN","C0CLABS",148,0)
+"RTN","C0CLABS",145,0)
;. D DT^DILF(,"T-365",.C0CSDT) ; START DATE ONE YEAR AGO TO LIMIT VOLUME
-"RTN","C0CLABS",149,0)
+"RTN","C0CLABS",146,0)
;E D DT^DILF(,"T-5000",.C0CSDT) ; START DATE LONG AGO TO GET EVERYTHING
-"RTN","C0CLABS",150,0)
+"RTN","C0CLABS",147,0)
;D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY
-"RTN","C0CLABS",151,0)
+"RTN","C0CLABS",148,0)
S C0CLLMT=$$GET^C0CPARMS("LABLIMIT") ; GET THE LIMIT PARM
-"RTN","C0CLABS",152,0)
+"RTN","C0CLABS",149,0)
S C0CLSTRT=$$GET^C0CPARMS("LABSTART") ; GET START PARM
-"RTN","C0CLABS",153,0)
+"RTN","C0CLABS",150,0)
D DT^DILF(,C0CLLMT,.C0CSDT) ;
-"RTN","C0CLABS",154,0)
+"RTN","C0CLABS",151,0)
W "LAB LIMIT: ",C0CLLMT,!
-"RTN","C0CLABS",155,0)
+"RTN","C0CLABS",152,0)
D DT^DILF(,C0CLSTRT,.C0CEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
-"RTN","C0CLABS",156,0)
+"RTN","C0CLABS",153,0)
S C0CEDT=$$NOW^XLFDT ; PULL LABS STARTING NOW
-"RTN","C0CLABS",157,0)
+"RTN","C0CLABS",154,0)
S C0CR=$$LAB^C0CLA7Q(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP
-"RTN","C0CLABS",158,0)
+"RTN","C0CLABS",155,0)
Q
-"RTN","C0CLABS",159,0)
+"RTN","C0CLABS",156,0)
;
-"RTN","C0CLABS",160,0)
+"RTN","C0CLABS",157,0)
LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
-"RTN","C0CLABS",161,0)
+"RTN","C0CLABS",158,0)
;
-"RTN","C0CLABS",162,0)
+"RTN","C0CLABS",159,0)
; N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR
-"RTN","C0CLABS",163,0)
+"RTN","C0CLABS",160,0)
I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
-"RTN","C0CLABS",164,0)
+"RTN","C0CLABS",161,0)
I '$D(C0CQT) S C0CQT=0
-"RTN","C0CLABS",165,0)
+"RTN","C0CLABS",162,0)
I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
-"RTN","C0CLABS",166,0)
+"RTN","C0CLABS",163,0)
I '$D(^TMP("C0CCCR","LABTBL",0)) D SETTBL ;INITIALIZE LAB TABLE
-"RTN","C0CLABS",167,0)
+"RTN","C0CLABS",164,0)
I ^TMP("C0CCCR","LABTBL",0)'="V3" D SETTBL ;NEED NEWEST VERSION
-"RTN","C0CLABS",168,0)
+"RTN","C0CLABS",165,0)
I '$D(^TMP("HLS",$J,1)) D GHL7 ; GET HL7 MGS IF NOT ALREADY DONE
-"RTN","C0CLABS",169,0)
+"RTN","C0CLABS",166,0)
S C0CTAB=$NA(^TMP("C0CCCR","LABTBL")) ; BASE OF OBX TABLE
-"RTN","C0CLABS",170,0)
+"RTN","C0CLABS",167,0)
S C0CHB=$NA(^TMP("HLS",$J))
-"RTN","C0CLABS",171,0)
+"RTN","C0CLABS",168,0)
S C0CI=""
-"RTN","C0CLABS",172,0)
+"RTN","C0CLABS",169,0)
S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT
-"RTN","C0CLABS",173,0)
+"RTN","C0CLABS",170,0)
F S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI="" D ; FOR ALL RECORDS IN HL7 MSG
-"RTN","C0CLABS",174,0)
+"RTN","C0CLABS",171,0)
. K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES
-"RTN","C0CLABS",175,0)
+"RTN","C0CLABS",172,0)
. S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
-"RTN","C0CLABS",176,0)
+"RTN","C0CLABS",173,0)
. D LTYP(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
-"RTN","C0CLABS",177,0)
+"RTN","C0CLABS",174,0)
. I $G(C0CVAR("RESULTCODINGSYSTEM"))="LN" D ; gpl - for certification
-"RTN","C0CLABS",178,0)
+"RTN","C0CLABS",175,0)
. . S C0CVAR("RESULTCODINGSYSTEM")="LOINC" ; NEED TO SPELL IT OUT
-"RTN","C0CLABS",179,0)
+"RTN","C0CLABS",176,0)
. . N C0CRDT S C0CRDT=C0CVAR("RESULTDESCRIPTIONTEXT") ; THE DESCRIPTION
-"RTN","C0CLABS",180,0)
+"RTN","C0CLABS",177,0)
. . N C0CRCD S C0CRCD=C0CVAR("RESULTCODE") ; THE LOINC CODE
-"RTN","C0CLABS",181,0)
+"RTN","C0CLABS",178,0)
. . S C0CVAR("RESULTDESCRIPTIONTEXT")=C0CRDT_" LOINC: "_C0CRCD
-"RTN","C0CLABS",182,0)
+"RTN","C0CLABS",179,0)
. M XV=C0CVAR ;
-"RTN","C0CLABS",183,0)
+"RTN","C0CLABS",180,0)
. I C0CTYP="OBR" D ; BEGINNING OF NEW SECTION
-"RTN","C0CLABS",184,0)
+"RTN","C0CLABS",181,0)
. . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
-"RTN","C0CLABS",185,0)
+"RTN","C0CLABS",182,0)
. . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
-"RTN","C0CLABS",186,0)
+"RTN","C0CLABS",183,0)
. . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
-"RTN","C0CLABS",187,0)
+"RTN","C0CLABS",184,0)
. . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
-"RTN","C0CLABS",188,0)
+"RTN","C0CLABS",185,0)
. . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
-"RTN","C0CLABS",189,0)
+"RTN","C0CLABS",186,0)
. . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
-"RTN","C0CLABS",190,0)
+"RTN","C0CLABS",187,0)
. . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
-"RTN","C0CLABS",191,0)
+"RTN","C0CLABS",188,0)
. . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
-"RTN","C0CLABS",192,0)
+"RTN","C0CLABS",189,0)
. . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
-"RTN","C0CLABS",193,0)
+"RTN","C0CLABS",190,0)
. . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
-"RTN","C0CLABS",194,0)
+"RTN","C0CLABS",191,0)
. . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
-"RTN","C0CLABS",195,0)
+"RTN","C0CLABS",192,0)
. I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX3
-"RTN","C0CLABS",196,0)
+"RTN","C0CLABS",193,0)
. . ; RESULTTESTCODEVALUE
-"RTN","C0CLABS",197,0)
+"RTN","C0CLABS",194,0)
. . ; RESULTTESTDESCRIPTIONTEXT
-"RTN","C0CLABS",198,0)
+"RTN","C0CLABS",195,0)
. . I C0CVAR("C3")="LN" D ; PRIMARY CODE IS LOINC
-"RTN","C0CLABS",199,0)
+"RTN","C0CLABS",196,0)
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE LOINC CODE VALUE
-"RTN","C0CLABS",200,0)
+"RTN","C0CLABS",197,0)
. . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
-"RTN","C0CLABS",201,0)
+"RTN","C0CLABS",198,0)
. . . ;S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESC TXT
-"RTN","C0CLABS",202,0)
+"RTN","C0CLABS",199,0)
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2")_" LOINC: "_C0CVAR("C1")
-"RTN","C0CLABS",203,0)
+"RTN","C0CLABS",200,0)
. . E I C0CVAR("C6")="LN" D ; SECONDARY CODE IS LOINC
-"RTN","C0CLABS",204,0)
+"RTN","C0CLABS",201,0)
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; THE LOINC CODE VALUE
-"RTN","C0CLABS",205,0)
+"RTN","C0CLABS",202,0)
. . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
-"RTN","C0CLABS",206,0)
+"RTN","C0CLABS",203,0)
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; DESCRIPTION TEXT
-"RTN","C0CLABS",207,0)
+"RTN","C0CLABS",204,0)
. . E I C0CVAR("C6")'="" D ; NO LOINC CODES, USE SECONDARY IF PRESENT
-"RTN","C0CLABS",208,0)
+"RTN","C0CLABS",205,0)
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
-"RTN","C0CLABS",209,0)
+"RTN","C0CLABS",206,0)
. . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
-"RTN","C0CLABS",210,0)
+"RTN","C0CLABS",207,0)
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
-"RTN","C0CLABS",211,0)
+"RTN","C0CLABS",208,0)
. . E D ; NO SECONDARY, USE PRIMARY
-"RTN","C0CLABS",212,0)
+"RTN","C0CLABS",209,0)
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
-"RTN","C0CLABS",213,0)
+"RTN","C0CLABS",210,0)
. . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
-"RTN","C0CLABS",214,0)
+"RTN","C0CLABS",211,0)
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
-"RTN","C0CLABS",215,0)
+"RTN","C0CLABS",212,0)
. . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;
-"RTN","C0CLABS",216,0)
+"RTN","C0CLABS",213,0)
. . ; mod to remove local XML escaping rely upon MAP^C0CXPATH
-"RTN","C0CLABS",217,0)
+"RTN","C0CLABS",214,0)
. . ;S XV("RESULTTESTNORMALDESCTEXT")=$$SYMENC^MXMLUTL(C0CZG) ;ESCAPE
-"RTN","C0CLABS",218,0)
+"RTN","C0CLABS",215,0)
. . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG
-"RTN","C0CLABS",219,0)
+"RTN","C0CLABS",216,0)
. . S C0CZG=XV("RESULTTESTVALUE")
-"RTN","C0CLABS",220,0)
+"RTN","C0CLABS",217,0)
. . ; mod to remove local XML escaping rely upon MAP^C0CXPATH
-"RTN","C0CLABS",221,0)
+"RTN","C0CLABS",218,0)
. . ;S XV("RESULTTESTVALUE")=$$SYMENC^MXMLUTL(C0CZG) ;ESCAPE
-"RTN","C0CLABS",222,0)
+"RTN","C0CLABS",219,0)
. . S XV("RESULTTESTVALUE")=C0CZG
-"RTN","C0CLABS",223,0)
+"RTN","C0CLABS",220,0)
. I C0CTYP="OBX" D ; PROCESS TEST RESULTS
-"RTN","C0CLABS",224,0)
+"RTN","C0CLABS",221,0)
. . I C0CLOBX=0 D ; FIRST TEST RESULT FOR THIS SECTION
-"RTN","C0CLABS",225,0)
+"RTN","C0CLABS",222,0)
. . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
-"RTN","C0CLABS",226,0)
+"RTN","C0CLABS",223,0)
. . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
-"RTN","C0CLABS",227,0)
+"RTN","C0CLABS",224,0)
. . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
-"RTN","C0CLABS",228,0)
+"RTN","C0CLABS",225,0)
. . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
-"RTN","C0CLABS",229,0)
+"RTN","C0CLABS",226,0)
. . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE
-"RTN","C0CLABS",230,0)
+"RTN","C0CLABS",227,0)
. . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER
-"RTN","C0CLABS",231,0)
+"RTN","C0CLABS",228,0)
. . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2
-"RTN","C0CLABS",232,0)
+"RTN","C0CLABS",229,0)
. . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
-"RTN","C0CLABS",233,0)
+"RTN","C0CLABS",230,0)
. . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT
-"RTN","C0CLABS",234,0)
+"RTN","C0CLABS",231,0)
. . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
-"RTN","C0CLABS",235,0)
+"RTN","C0CLABS",232,0)
. . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
-"RTN","C0CLABS",236,0)
+"RTN","C0CLABS",233,0)
. . ; I 'C0CQT ZWR XV
-"RTN","C0CLABS",237,0)
+"RTN","C0CLABS",234,0)
. . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
-"RTN","C0CLABS",238,0)
+"RTN","C0CLABS",235,0)
. I 'C0CQT D ;
-"RTN","C0CLABS",239,0)
+"RTN","C0CLABS",236,0)
. . W C0CI," ",C0CTYP,!
-"RTN","C0CLABS",240,0)
+"RTN","C0CLABS",237,0)
. ; S C0CI=$O(@C0CHB@(C0CI))
-"RTN","C0CLABS",241,0)
+"RTN","C0CLABS",238,0)
;K ^TMP("C0CRIM","VARS",DFN,"RESULTS")
-"RTN","C0CLABS",242,0)
+"RTN","C0CLABS",239,0)
;M ^TMP("C0CRIM","VARS",DFN,"RESULTS")=@C0CLB
-"RTN","C0CLABS",243,0)
+"RTN","C0CLABS",240,0)
Q
-"RTN","C0CLABS",244,0)
+"RTN","C0CLABS",241,0)
LTYP(OSEG,OTYP,OVARA,OC0CQT) ;
-"RTN","C0CLABS",245,0)
+"RTN","C0CLABS",242,0)
S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE
-"RTN","C0CLABS",246,0)
+"RTN","C0CLABS",243,0)
I '$D(OC0CQT) S C0CQT=0 ; NOT C0CQT IS DEFAULT
-"RTN","C0CLABS",247,0)
+"RTN","C0CLABS",244,0)
E S C0CQT=OC0CQT ; ACCEPT C0CQT FLAG
-"RTN","C0CLABS",248,0)
+"RTN","C0CLABS",245,0)
I 1 D ; FOR HL7 SEGMENT TYPE
-"RTN","C0CLABS",249,0)
+"RTN","C0CLABS",246,0)
. S OI="" ; INDEX INTO FIELDS IN SEG
-"RTN","C0CLABS",250,0)
+"RTN","C0CLABS",247,0)
. F S OI=$O(@OTAB@(OI)) Q:OI="" D ; FOR EACH FIELD OF THE SEGMENT
-"RTN","C0CLABS",251,0)
+"RTN","C0CLABS",248,0)
. . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX
-"RTN","C0CLABS",252,0)
+"RTN","C0CLABS",249,0)
. . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED
-"RTN","C0CLABS",253,0)
+"RTN","C0CLABS",250,0)
. . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE
-"RTN","C0CLABS",254,0)
+"RTN","C0CLABS",251,0)
. . I $P(OI,";",2)'="" D ; THIS IS DEFINING A SUB-VALUE
-"RTN","C0CLABS",255,0)
+"RTN","C0CLABS",252,0)
. . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX
-"RTN","C0CLABS",256,0)
+"RTN","C0CLABS",253,0)
. . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE
-"RTN","C0CLABS",257,0)
+"RTN","C0CLABS",254,0)
. . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE
-"RTN","C0CLABS",258,0)
+"RTN","C0CLABS",255,0)
. . I 'C0CQT D ; PRINT OUTPUT IF C0CQT IS FALSE
-"RTN","C0CLABS",259,0)
+"RTN","C0CLABS",256,0)
. . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,!
-"RTN","C0CLABS",260,0)
+"RTN","C0CLABS",257,0)
Q
-"RTN","C0CLABS",261,0)
+"RTN","C0CLABS",258,0)
LOBX ;
-"RTN","C0CLABS",262,0)
+"RTN","C0CLABS",259,0)
Q
-"RTN","C0CLABS",263,0)
+"RTN","C0CLABS",260,0)
;
-"RTN","C0CLABS",264,0)
+"RTN","C0CLABS",261,0)
OUT(DFN) ; WRITE OUT A CCR THAT HAS JUST BEEN PROCESSED (FOR TESTING)
-"RTN","C0CLABS",265,0)
+"RTN","C0CLABS",262,0)
N GA,GF,GD
-"RTN","C0CLABS",266,0)
+"RTN","C0CLABS",263,0)
S GA=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1))
-"RTN","C0CLABS",267,0)
+"RTN","C0CLABS",264,0)
S GF="RPMS_CCR_"_DFN_"_"_DT_".xml"
-"RTN","C0CLABS",268,0)
+"RTN","C0CLABS",265,0)
S GD=^TMP("C0CCCR","ODIR")
-"RTN","C0CLABS",269,0)
+"RTN","C0CLABS",266,0)
W $$OUTPUT^C0CXPATH(GA,GF,GD)
-"RTN","C0CLABS",270,0)
+"RTN","C0CLABS",267,0)
Q
-"RTN","C0CLABS",271,0)
+"RTN","C0CLABS",268,0)
;
-"RTN","C0CLABS",272,0)
+"RTN","C0CLABS",269,0)
SETTBL ;
-"RTN","C0CLABS",273,0)
+"RTN","C0CLABS",270,0)
K X ; CLEAR X
-"RTN","C0CLABS",274,0)
+"RTN","C0CLABS",271,0)
S X("PID","PID1")="1^00104^Set ID - Patient ID"
-"RTN","C0CLABS",275,0)
+"RTN","C0CLABS",272,0)
S X("PID","PID2")="2^00105^Patient ID (External ID)"
-"RTN","C0CLABS",276,0)
+"RTN","C0CLABS",273,0)
S X("PID","PID3")="3^00106^Patient ID (Internal ID)"
-"RTN","C0CLABS",277,0)
+"RTN","C0CLABS",274,0)
S X("PID","PID4")="4^00107^Alternate Patient ID"
-"RTN","C0CLABS",278,0)
+"RTN","C0CLABS",275,0)
S X("PID","PID5")="5^00108^Patient's Name"
-"RTN","C0CLABS",279,0)
+"RTN","C0CLABS",276,0)
S X("PID","PID6")="6^00109^Mother's Maiden Name"
-"RTN","C0CLABS",280,0)
+"RTN","C0CLABS",277,0)
S X("PID","PID7")="7^00110^Date of Birth"
-"RTN","C0CLABS",281,0)
+"RTN","C0CLABS",278,0)
S X("PID","PID8")="8^00111^Sex"
-"RTN","C0CLABS",282,0)
+"RTN","C0CLABS",279,0)
S X("PID","PID9")="9^00112^Patient Alias"
-"RTN","C0CLABS",283,0)
+"RTN","C0CLABS",280,0)
S X("PID","PID10")="10^00113^Race"
-"RTN","C0CLABS",284,0)
+"RTN","C0CLABS",281,0)
S X("PID","PID11")="11^00114^Patient Address"
-"RTN","C0CLABS",285,0)
+"RTN","C0CLABS",282,0)
S X("PID","PID12")="12^00115^County Code"
-"RTN","C0CLABS",286,0)
+"RTN","C0CLABS",283,0)
S X("PID","PID13")="13^00116^Phone Number - Home"
-"RTN","C0CLABS",287,0)
+"RTN","C0CLABS",284,0)
S X("PID","PID14")="14^00117^Phone Number - Business"
-"RTN","C0CLABS",288,0)
+"RTN","C0CLABS",285,0)
S X("PID","PID15")="15^00118^Language - Patient"
-"RTN","C0CLABS",289,0)
+"RTN","C0CLABS",286,0)
S X("PID","PID16")="16^00119^Marital Status"
-"RTN","C0CLABS",290,0)
+"RTN","C0CLABS",287,0)
S X("PID","PID17")="17^00120^Religion"
-"RTN","C0CLABS",291,0)
+"RTN","C0CLABS",288,0)
S X("PID","PID18")="18^00121^Patient Account Number"
-"RTN","C0CLABS",292,0)
+"RTN","C0CLABS",289,0)
S X("PID","PID19")="19^00122^SSN Number - Patient"
-"RTN","C0CLABS",293,0)
+"RTN","C0CLABS",290,0)
S X("PID","PID20")="20^00123^Drivers License - Patient"
-"RTN","C0CLABS",294,0)
+"RTN","C0CLABS",291,0)
S X("PID","PID21")="21^00124^Mother's Identifier"
-"RTN","C0CLABS",295,0)
+"RTN","C0CLABS",292,0)
S X("PID","PID22")="22^00125^Ethnic Group"
-"RTN","C0CLABS",296,0)
+"RTN","C0CLABS",293,0)
S X("PID","PID23")="23^00126^Birth Place"
-"RTN","C0CLABS",297,0)
+"RTN","C0CLABS",294,0)
S X("PID","PID24")="24^00127^Multiple Birth Indicator"
-"RTN","C0CLABS",298,0)
+"RTN","C0CLABS",295,0)
S X("PID","PID25")="25^00128^Birth Order"
-"RTN","C0CLABS",299,0)
+"RTN","C0CLABS",296,0)
S X("PID","PID26")="26^00129^Citizenship"
-"RTN","C0CLABS",300,0)
+"RTN","C0CLABS",297,0)
S X("PID","PID27")="27^00130^Veteran.s Military Status"
-"RTN","C0CLABS",301,0)
+"RTN","C0CLABS",298,0)
S X("PID","PID28")="28^00739^Nationality"
-"RTN","C0CLABS",302,0)
+"RTN","C0CLABS",299,0)
S X("PID","PID29")="29^00740^Patient Death Date/Time"
-"RTN","C0CLABS",303,0)
+"RTN","C0CLABS",300,0)
S X("PID","PID30")="30^00741^Patient Death Indicator"
-"RTN","C0CLABS",304,0)
+"RTN","C0CLABS",301,0)
S X("NTE","NTE1")="1^00573^Set ID - NTE"
-"RTN","C0CLABS",305,0)
+"RTN","C0CLABS",302,0)
S X("NTE","NTE2")="2^00574^Source of Comment"
-"RTN","C0CLABS",306,0)
+"RTN","C0CLABS",303,0)
S X("NTE","NTE3")="3^00575^Comment"
-"RTN","C0CLABS",307,0)
+"RTN","C0CLABS",304,0)
S X("ORC","ORC1")="1^00215^Order Control"
-"RTN","C0CLABS",308,0)
+"RTN","C0CLABS",305,0)
S X("ORC","ORC2")="2^00216^Placer Order Number"
-"RTN","C0CLABS",309,0)
+"RTN","C0CLABS",306,0)
S X("ORC","ORC3")="3^00217^Filler Order Number"
-"RTN","C0CLABS",310,0)
+"RTN","C0CLABS",307,0)
S X("ORC","ORC4")="4^00218^Placer Order Number"
-"RTN","C0CLABS",311,0)
+"RTN","C0CLABS",308,0)
S X("ORC","ORC5")="5^00219^Order Status"
-"RTN","C0CLABS",312,0)
+"RTN","C0CLABS",309,0)
S X("ORC","ORC6")="6^00220^Response Flag"
-"RTN","C0CLABS",313,0)
+"RTN","C0CLABS",310,0)
S X("ORC","ORC7")="7^00221^Quantity/Timing"
-"RTN","C0CLABS",314,0)
+"RTN","C0CLABS",311,0)
S X("ORC","ORC8")="8^00222^Parent"
-"RTN","C0CLABS",315,0)
+"RTN","C0CLABS",312,0)
S X("ORC","ORC9")="9^00223^Date/Time of Transaction"
-"RTN","C0CLABS",316,0)
+"RTN","C0CLABS",313,0)
S X("ORC","ORC10")="10^00224^Entered By"
-"RTN","C0CLABS",317,0)
+"RTN","C0CLABS",314,0)
S X("ORC","ORC11")="11^00225^Verified By"
-"RTN","C0CLABS",318,0)
+"RTN","C0CLABS",315,0)
S X("ORC","ORC12")="12^00226^Ordering Provider"
-"RTN","C0CLABS",319,0)
+"RTN","C0CLABS",316,0)
S X("ORC","ORC13")="13^00227^Enterer's Location"
-"RTN","C0CLABS",320,0)
+"RTN","C0CLABS",317,0)
S X("ORC","ORC14")="14^00228^Call Back Phone Number"
-"RTN","C0CLABS",321,0)
+"RTN","C0CLABS",318,0)
S X("ORC","ORC15")="15^00229^Order Effective Date/Time"
-"RTN","C0CLABS",322,0)
+"RTN","C0CLABS",319,0)
S X("ORC","ORC16")="16^00230^Order Control Code Reason"
-"RTN","C0CLABS",323,0)
+"RTN","C0CLABS",320,0)
S X("ORC","ORC17")="17^00231^Entering Organization"
-"RTN","C0CLABS",324,0)
+"RTN","C0CLABS",321,0)
S X("ORC","ORC18")="18^00232^Entering Device"
-"RTN","C0CLABS",325,0)
+"RTN","C0CLABS",322,0)
S X("ORC","ORC19")="19^00233^Action By"
-"RTN","C0CLABS",326,0)
+"RTN","C0CLABS",323,0)
S X("OBR","OBR1")="1^00237^Set ID - Observation Request"
-"RTN","C0CLABS",327,0)
+"RTN","C0CLABS",324,0)
S X("OBR","OBR2")="2^00216^Placer Order Number"
-"RTN","C0CLABS",328,0)
+"RTN","C0CLABS",325,0)
S X("OBR","OBR3")="3^00217^Filler Order Number"
-"RTN","C0CLABS",329,0)
+"RTN","C0CLABS",326,0)
S X("OBR","OBR4")="4^00238^Universal Service ID"
-"RTN","C0CLABS",330,0)
+"RTN","C0CLABS",327,0)
S X("OBR","OBR4;LOINC")="4;1^00238^Universal Service ID - LOINC^RESULTCODE"
-"RTN","C0CLABS",331,0)
+"RTN","C0CLABS",328,0)
S X("OBR","OBR4;DESC")="4;2^00238^Universal Service ID - DESC^RESULTDESCRIPTIONTEXT"
-"RTN","C0CLABS",332,0)
+"RTN","C0CLABS",329,0)
S X("OBR","OBR4;VACODE")="4;3^00238^Universal Service ID - VACODE^RESULTCODINGSYSTEM"
-"RTN","C0CLABS",333,0)
+"RTN","C0CLABS",330,0)
S X("OBR","OBR5")="5^00239^Priority"
-"RTN","C0CLABS",334,0)
+"RTN","C0CLABS",331,0)
S X("OBR","OBR6")="6^00240^Requested Date/Time"
-"RTN","C0CLABS",335,0)
+"RTN","C0CLABS",332,0)
S X("OBR","OBR7")="7^00241^Observation Date/Time^RESULTASSESSMENTDATETIME"
-"RTN","C0CLABS",336,0)
+"RTN","C0CLABS",333,0)
S X("OBR","OBR8")="8^00242^Observation End Date/Time"
-"RTN","C0CLABS",337,0)
+"RTN","C0CLABS",334,0)
S X("OBR","OBR9")="9^00243^Collection Volume"
-"RTN","C0CLABS",338,0)
+"RTN","C0CLABS",335,0)
S X("OBR","OBR10")="10^00244^Collector Identifier"
-"RTN","C0CLABS",339,0)
+"RTN","C0CLABS",336,0)
S X("OBR","OBR11")="11^00245^Specimen Action Code"
-"RTN","C0CLABS",340,0)
+"RTN","C0CLABS",337,0)
S X("OBR","OBR12")="12^00246^Danger Code"
-"RTN","C0CLABS",341,0)
+"RTN","C0CLABS",338,0)
S X("OBR","OBR13")="13^00247^Relevant Clinical Info."
-"RTN","C0CLABS",342,0)
+"RTN","C0CLABS",339,0)
S X("OBR","OBR14")="14^00248^Specimen Rcv'd. Date/Time"
-"RTN","C0CLABS",343,0)
+"RTN","C0CLABS",340,0)
S X("OBR","OBR15")="15^00249^Specimen Source"
-"RTN","C0CLABS",344,0)
+"RTN","C0CLABS",341,0)
S X("OBR","OBR16")="16^00226^Ordering Provider XCN^RESULTSOURCEACTORID"
-"RTN","C0CLABS",345,0)
+"RTN","C0CLABS",342,0)
S X("OBR","OBR17")="17^00250^Order Callback Phone Number"
-"RTN","C0CLABS",346,0)
+"RTN","C0CLABS",343,0)
S X("OBR","OBR18")="18^00251^Placers Field 1"
-"RTN","C0CLABS",347,0)
+"RTN","C0CLABS",344,0)
S X("OBR","OBR19")="19^00252^Placers Field 2"
-"RTN","C0CLABS",348,0)
+"RTN","C0CLABS",345,0)
S X("OBR","OBR20")="20^00253^Filler Field 1"
-"RTN","C0CLABS",349,0)
+"RTN","C0CLABS",346,0)
S X("OBR","OBR21")="21^00254^Filler Field 2"
-"RTN","C0CLABS",350,0)
+"RTN","C0CLABS",347,0)
S X("OBR","OBR22")="22^00255^Results Rpt./Status Change"
-"RTN","C0CLABS",351,0)
+"RTN","C0CLABS",348,0)
S X("OBR","OBR23")="23^00256^Charge to Practice"
-"RTN","C0CLABS",352,0)
+"RTN","C0CLABS",349,0)
S X("OBR","OBR24")="24^00257^Diagnostic Service Sect"
-"RTN","C0CLABS",353,0)
+"RTN","C0CLABS",350,0)
S X("OBR","OBR25")="25^00258^Result Status^RESULTSTATUS"
-"RTN","C0CLABS",354,0)
+"RTN","C0CLABS",351,0)
S X("OBR","OBR26")="26^00259^Parent Result"
-"RTN","C0CLABS",355,0)
+"RTN","C0CLABS",352,0)
S X("OBR","OBR27")="27^00221^Quantity/Timing"
-"RTN","C0CLABS",356,0)
+"RTN","C0CLABS",353,0)
S X("OBR","OBR28")="28^00260^Result Copies to"
-"RTN","C0CLABS",357,0)
+"RTN","C0CLABS",354,0)
S X("OBR","OBR29")="29^00261^Parent Number"
-"RTN","C0CLABS",358,0)
+"RTN","C0CLABS",355,0)
S X("OBR","OBR30")="30^00262^Transportation Mode"
-"RTN","C0CLABS",359,0)
+"RTN","C0CLABS",356,0)
S X("OBR","OBR31")="31^00263^Reason for Study"
-"RTN","C0CLABS",360,0)
+"RTN","C0CLABS",357,0)
S X("OBR","OBR32")="32^00264^Principal Result Interpreter"
-"RTN","C0CLABS",361,0)
+"RTN","C0CLABS",358,0)
S X("OBR","OBR33")="33^00265^Assistant Result Interpreter"
-"RTN","C0CLABS",362,0)
+"RTN","C0CLABS",359,0)
S X("OBR","OBR34")="34^00266^Technician"
-"RTN","C0CLABS",363,0)
+"RTN","C0CLABS",360,0)
S X("OBR","OBR35")="35^00267^Transcriptionist"
-"RTN","C0CLABS",364,0)
+"RTN","C0CLABS",361,0)
S X("OBR","OBR36")="36^00268^Scheduled Date/Time"
-"RTN","C0CLABS",365,0)
+"RTN","C0CLABS",362,0)
S X("OBR","OBR37")="37^01028^Number of Sample Containers"
-"RTN","C0CLABS",366,0)
+"RTN","C0CLABS",363,0)
S X("OBR","OBR38")="38^38^01029 Transport Logistics of Collected Sample"
-"RTN","C0CLABS",367,0)
+"RTN","C0CLABS",364,0)
S X("OBR","OBR39")="39^01030^Collector.s Comment"
-"RTN","C0CLABS",368,0)
+"RTN","C0CLABS",365,0)
S X("OBR","OBR40")="40^01031^Transport Arrangement Responsibility"
-"RTN","C0CLABS",369,0)
+"RTN","C0CLABS",366,0)
S X("OBR","OBR41")="41^01032^Transport Arranged"
-"RTN","C0CLABS",370,0)
+"RTN","C0CLABS",367,0)
S X("OBR","OBR42")="42^01033^Escort Required"
-"RTN","C0CLABS",371,0)
+"RTN","C0CLABS",368,0)
S X("OBR","OBR43")="43^01034^Planned Patient Transport Comment"
-"RTN","C0CLABS",372,0)
+"RTN","C0CLABS",369,0)
S X("OBX","OBX1")="1^00559^Set ID - OBX"
-"RTN","C0CLABS",373,0)
+"RTN","C0CLABS",370,0)
S X("OBX","OBX2")="2^00676^Value Type"
-"RTN","C0CLABS",374,0)
+"RTN","C0CLABS",371,0)
S X("OBX","OBX3")="3^00560^Observation Identifier"
-"RTN","C0CLABS",375,0)
+"RTN","C0CLABS",372,0)
S X("OBX","OBX3;C1")="3;1^00560^Observation Identifier^C1"
-"RTN","C0CLABS",376,0)
+"RTN","C0CLABS",373,0)
S X("OBX","OBX3;C2")="3;2^00560^Observation Identifier^C2"
-"RTN","C0CLABS",377,0)
+"RTN","C0CLABS",374,0)
S X("OBX","OBX3;C3")="3;3^00560^Observation Identifier^C3"
-"RTN","C0CLABS",378,0)
+"RTN","C0CLABS",375,0)
S X("OBX","OBX3;C4")="3;4^00560^Observation Identifier^C4"
-"RTN","C0CLABS",379,0)
+"RTN","C0CLABS",376,0)
S X("OBX","OBX3;C5")="3;5^00560^Observation Identifier^C5"
-"RTN","C0CLABS",380,0)
+"RTN","C0CLABS",377,0)
S X("OBX","OBX3;C6")="3;6^00560^Observation Identifier^C6"
-"RTN","C0CLABS",381,0)
+"RTN","C0CLABS",378,0)
S X("OBX","OBX4")="4^00769^Observation Sub-Id"
-"RTN","C0CLABS",382,0)
+"RTN","C0CLABS",379,0)
S X("OBX","OBX5")="5^00561^Observation Results^RESULTTESTVALUE"
-"RTN","C0CLABS",383,0)
+"RTN","C0CLABS",380,0)
S X("OBX","OBX6")="6^00562^Units^RESULTTESTUNITS"
-"RTN","C0CLABS",384,0)
+"RTN","C0CLABS",381,0)
S X("OBX","OBX7")="7^00563^Reference Range^RESULTTESTNORMALDESCTEXT"
-"RTN","C0CLABS",385,0)
+"RTN","C0CLABS",382,0)
S X("OBX","OBX8")="8^00564^Abnormal Flags^RESULTTESTFLAG"
-"RTN","C0CLABS",386,0)
+"RTN","C0CLABS",383,0)
S X("OBX","OBX9")="9^00639^Probability"
-"RTN","C0CLABS",387,0)
+"RTN","C0CLABS",384,0)
S X("OBX","OBX10")="10^00565^Nature of Abnormal Test"
-"RTN","C0CLABS",388,0)
+"RTN","C0CLABS",385,0)
S X("OBX","OBX11")="11^00566^Observ. Result Status^RESULTTESTSTATUSTEXT"
-"RTN","C0CLABS",389,0)
+"RTN","C0CLABS",386,0)
S X("OBX","OBX12")="12^00567^Date Last Normal Value"
-"RTN","C0CLABS",390,0)
+"RTN","C0CLABS",387,0)
S X("OBX","OBX13")="13^00581^User Defined Access Checks"
-"RTN","C0CLABS",391,0)
+"RTN","C0CLABS",388,0)
S X("OBX","OBX14")="14^00582^Date/Time of Observation^RESULTTESTDATETIME"
-"RTN","C0CLABS",392,0)
+"RTN","C0CLABS",389,0)
S X("OBX","OBX15")="15^00583^Producer.s ID^RESULTTESTSOURCEACTORID"
-"RTN","C0CLABS",393,0)
+"RTN","C0CLABS",390,0)
S X("OBX","OBX16")="16^00584^Responsible Observer"
-"RTN","C0CLABS",394,0)
+"RTN","C0CLABS",391,0)
S X("OBX","OBX17")="17^00936^Observation Method"
-"RTN","C0CLABS",395,0)
+"RTN","C0CLABS",392,0)
K ^TMP("C0CCCR","LABTBL")
-"RTN","C0CLABS",396,0)
+"RTN","C0CLABS",393,0)
M ^TMP("C0CCCR","LABTBL")=X ; SET VALUES IN LAB TBL
-"RTN","C0CLABS",397,0)
+"RTN","C0CLABS",394,0)
S ^TMP("C0CCCR","LABTBL",0)="V3"
-"RTN","C0CLABS",398,0)
+"RTN","C0CLABS",395,0)
Q
-"RTN","C0CLABS",399,0)
+"RTN","C0CLABS",396,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
"RTN","C0CMAIL",4,0)
@@ -103309,745 +103345,739 @@ V ;;1.2;C0C;;May 11, 2012;Build 50
"RTN","C0CMAIL",5,0)
; 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 .
"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.
-"RTN","C0CMAIL",22,0)
- ;
-"RTN","C0CMAIL",23,0)
; ------------------
-"RTN","C0CMAIL",24,0)
+"RTN","C0CMAIL",21,0)
;Entry Points
-"RTN","C0CMAIL",25,0)
+"RTN","C0CMAIL",22,0)
; GETMSG^C0CMAIL(.C0CDATA,.C0CINPUT)
-"RTN","C0CMAIL",26,0)
+"RTN","C0CMAIL",23,0)
; Input:
-"RTN","C0CMAIL",27,0)
+"RTN","C0CMAIL",24,0)
; C0CINPUT = "DUZ;MAILBOX_Name[or IEN for box (comma Separated);MALL
-"RTN","C0CMAIL",28,0)
+"RTN","C0CMAIL",25,0)
; or "*" for all boxes, default is "IN" if missing]"
-"RTN","C0CMAIL",29,0)
+"RTN","C0CMAIL",26,0)
; $P(C0CINPUT,";",3)=MALL, default=NUL means "New only",
-"RTN","C0CMAIL",30,0)
+"RTN","C0CMAIL",27,0)
; "*" for All or 9,999 maximum
-"RTN","C0CMAIL",31,0)
+"RTN","C0CMAIL",28,0)
; MALL?1.n = that number of the n most recent
-"RTN","C0CMAIL",32,0)
+"RTN","C0CMAIL",29,0)
; Internally:
-"RTN","C0CMAIL",33,0)
+"RTN","C0CMAIL",30,0)
; BNAM = Box Name
-"RTN","C0CMAIL",34,0)
+"RTN","C0CMAIL",31,0)
; Output:
-"RTN","C0CMAIL",35,0)
+"RTN","C0CMAIL",32,0)
; C0CDATA
-"RTN","C0CMAIL",36,0)
+"RTN","C0CMAIL",33,0)
; = (BNAM,"NUMBER") = Number of NEW Emails in Basket
-"RTN","C0CMAIL",37,0)
+"RTN","C0CMAIL",34,0)
; (BNAM,"MSG",C0CIEN,"FROM")=Name
-"RTN","C0CMAIL",38,0)
+"RTN","C0CMAIL",35,0)
; (BNAM,"MSG",C0CIEN,"TO",n)=DUZ, or EMAIL Address
-"RTN","C0CMAIL",39,0)
+"RTN","C0CMAIL",36,0)
; (BNAM,"MSG",C0CIEN,"TO NAME",n)=Names or EMAIL Address
-"RTN","C0CMAIL",40,0)
+"RTN","C0CMAIL",37,0)
; (BNAM,"MSG",C0CIEN,"TITLE")=EMAIL Title
-"RTN","C0CMAIL",41,0)
+"RTN","C0CMAIL",38,0)
; (BNAM,"MSG",C0CIEN[for File 3.9])=Number of Attachments
-"RTN","C0CMAIL",42,0)
+"RTN","C0CMAIL",39,0)
; (BNAM,"MSG",C0CIEN,num,"CONT") = Free Text
-"RTN","C0CMAIL",43,0)
+"RTN","C0CMAIL",40,0)
; (BNAM,"MSG",C0CIEN,num,"LINES") = Number of Lines of Text
-"RTN","C0CMAIL",44,0)
+"RTN","C0CMAIL",41,0)
; (BNAM,"MSG",C0CIEN,num,"SIZE") = Size of the Message in Bytes
-"RTN","C0CMAIL",45,0)
+"RTN","C0CMAIL",42,0)
; (BNAM,"MSG",C0CIEN,num,"TXT",LINE#) = Message Data (No Attachment)
-"RTN","C0CMAIL",46,0)
+"RTN","C0CMAIL",43,0)
; (BNAM,"MSG",C0CIEN,"SEG",NUM) = First Line^Last Line
-"RTN","C0CMAIL",47,0)
+"RTN","C0CMAIL",44,0)
; (BNAM,"MSG",C0CIEN,"SEG",NUM,"CONT",type) = Message Details
-"RTN","C0CMAIL",48,0)
+"RTN","C0CMAIL",45,0)
; (BNAM,"MSG",C0CIEN,"SEG",NUM,LINE#) = Message Data
-"RTN","C0CMAIL",49,0)
+"RTN","C0CMAIL",46,0)
;
-"RTN","C0CMAIL",50,0)
+"RTN","C0CMAIL",47,0)
; DO DETAIL^C0CMAIL(.OUTBF,D0) ; For each Email Message and Attachments
-"RTN","C0CMAIL",51,0)
+"RTN","C0CMAIL",48,0)
; Input;
-"RTN","C0CMAIL",52,0)
+"RTN","C0CMAIL",49,0)
; D0 - The IEN for the message in file 3.9, MESSAGE global
-"RTN","C0CMAIL",53,0)
+"RTN","C0CMAIL",50,0)
; Output
-"RTN","C0CMAIL",54,0)
+"RTN","C0CMAIL",51,0)
; OUTBF - The array of your choice to save the expanded and decoded message.
-"RTN","C0CMAIL",55,0)
+"RTN","C0CMAIL",52,0)
;
-"RTN","C0CMAIL",56,0)
+"RTN","C0CMAIL",53,0)
GETMSG(C0CDATA,C0CINPUT) ; Common Entry Point for Mailbox Data
-"RTN","C0CMAIL",57,0)
+"RTN","C0CMAIL",54,0)
K:'$G(C0CDATA("KEEP")) C0CDATA
-"RTN","C0CMAIL",58,0)
+"RTN","C0CMAIL",55,0)
N U
-"RTN","C0CMAIL",59,0)
+"RTN","C0CMAIL",56,0)
S U="^"
-"RTN","C0CMAIL",60,0)
+"RTN","C0CMAIL",57,0)
D:$G(C0CINPUT)
-"RTN","C0CMAIL",61,0)
+"RTN","C0CMAIL",58,0)
. N BF,DUZ,I,INPUT,J,L,LST,MBLST,MALL
-"RTN","C0CMAIL",62,0)
+"RTN","C0CMAIL",59,0)
. S INPUT=C0CINPUT
-"RTN","C0CMAIL",63,0)
+"RTN","C0CMAIL",60,0)
. S DUZ=+INPUT
-"RTN","C0CMAIL",64,0)
+"RTN","C0CMAIL",61,0)
. D:$D(^XMB(3.7,DUZ,0))#2
-"RTN","C0CMAIL",65,0)
+"RTN","C0CMAIL",62,0)
. . S MBLST=$P(INPUT,";",2)
-"RTN","C0CMAIL",66,0)
+"RTN","C0CMAIL",63,0)
. . S MALL=$P(INPUT,";",3) ; New or All Mail Flag
-"RTN","C0CMAIL",67,0)
+"RTN","C0CMAIL",64,0)
. . S:MALL["*" MALL=99999
-"RTN","C0CMAIL",68,0)
+"RTN","C0CMAIL",65,0)
. . ; Only one of these can be correct
-"RTN","C0CMAIL",69,0)
+"RTN","C0CMAIL",66,0)
. . D
-"RTN","C0CMAIL",70,0)
+"RTN","C0CMAIL",67,0)
. . . ; If nul, make it "IN" only
-"RTN","C0CMAIL",71,0)
+"RTN","C0CMAIL",68,0)
. . . I MBLST="" D QUIT
-"RTN","C0CMAIL",72,0)
+"RTN","C0CMAIL",69,0)
. . . . S MBLST("IN")=0,I=0
-"RTN","C0CMAIL",73,0)
+"RTN","C0CMAIL",70,0)
. . . . D GATHER(DUZ,"IN",.LST)
-"RTN","C0CMAIL",74,0)
+"RTN","C0CMAIL",71,0)
. . . .QUIT
-"RTN","C0CMAIL",75,0)
+"RTN","C0CMAIL",72,0)
. . . ;
-"RTN","C0CMAIL",76,0)
+"RTN","C0CMAIL",73,0)
. . . ; If "*", Get all Mailboxes and look for New Messages
-"RTN","C0CMAIL",77,0)
+"RTN","C0CMAIL",74,0)
. . . I MBLST["*" D QUIT
-"RTN","C0CMAIL",78,0)
+"RTN","C0CMAIL",75,0)
. . . . N NAM,NUM
-"RTN","C0CMAIL",79,0)
+"RTN","C0CMAIL",76,0)
. . . . S NUM=0
-"RTN","C0CMAIL",80,0)
+"RTN","C0CMAIL",77,0)
. . . . F S NUM=$O(^XMB(3.7,DUZ,2,NUM)) Q:'NUM D
-"RTN","C0CMAIL",81,0)
+"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",82,0)
- . . . . . D GATHER(DUZ,NAM,.LST)
+ . . . ;
"RTN","C0CMAIL",83,0)
- . . . . .QUIT
-"RTN","C0CMAIL",84,0)
- . . . .QUIT
-"RTN","C0CMAIL",85,0)
- . . . ;
-"RTN","C0CMAIL",86,0)
. . . ; If comma separated, look for mailboxes with new messages
-"RTN","C0CMAIL",87,0)
+"RTN","C0CMAIL",84,0)
. . . I $L(MBLST,",")>1 D QUIT
-"RTN","C0CMAIL",88,0)
+"RTN","C0CMAIL",85,0)
. . . . S NAM=""
-"RTN","C0CMAIL",89,0)
+"RTN","C0CMAIL",86,0)
. . . . N T,V
-"RTN","C0CMAIL",90,0)
+"RTN","C0CMAIL",87,0)
. . . . F T=1:1:$L(MBLST,",") S V=$P(MBLST,",",T) I $L(V) D
-"RTN","C0CMAIL",91,0)
+"RTN","C0CMAIL",88,0)
. . . . . I V S NAM=$P($G(^XMB(3.7,DUZ,2,V,0)),U)
-"RTN","C0CMAIL",92,0)
+"RTN","C0CMAIL",89,0)
. . . . . S:NAM="" NAM=V
-"RTN","C0CMAIL",93,0)
+"RTN","C0CMAIL",90,0)
. . . . . D GATHER(DUZ,NAM,.LST)
-"RTN","C0CMAIL",94,0)
+"RTN","C0CMAIL",91,0)
. . . . .QUIT
-"RTN","C0CMAIL",95,0)
+"RTN","C0CMAIL",92,0)
. . . .QUIT
-"RTN","C0CMAIL",96,0)
+"RTN","C0CMAIL",93,0)
. . . ;
-"RTN","C0CMAIL",97,0)
+"RTN","C0CMAIL",94,0)
. . . ; If only 1 mailbox named, go get it
-"RTN","C0CMAIL",98,0)
+"RTN","C0CMAIL",95,0)
. . . I $L(MBLST) D GATHER(DUZ,MBLST,.LST) QUIT
-"RTN","C0CMAIL",99,0)
+"RTN","C0CMAIL",96,0)
. . .QUIT
-"RTN","C0CMAIL",100,0)
+"RTN","C0CMAIL",97,0)
. . MERGE C0CDATA=LST
+"RTN","C0CMAIL",98,0)
+ . .QUIT
+"RTN","C0CMAIL",99,0)
+ .QUIT
+"RTN","C0CMAIL",100,0)
+ QUIT
"RTN","C0CMAIL",101,0)
- . .QUIT
+ ; ===================
"RTN","C0CMAIL",102,0)
- .QUIT
-"RTN","C0CMAIL",103,0)
- QUIT
-"RTN","C0CMAIL",104,0)
- ; ===================
-"RTN","C0CMAIL",105,0)
GATHER(DUZ,NAM,LST) ; Gather Data about the Baskets and their mail
-"RTN","C0CMAIL",106,0)
+"RTN","C0CMAIL",103,0)
N I,J,K,L
-"RTN","C0CMAIL",107,0)
+"RTN","C0CMAIL",104,0)
S (I,K)=0
-"RTN","C0CMAIL",108,0)
+"RTN","C0CMAIL",105,0)
S J=$O(^XMB(3.7,DUZ,2,"B",NAM,""))
-"RTN","C0CMAIL",109,0)
+"RTN","C0CMAIL",106,0)
F S I=$O(^XMB(3.7,DUZ,2,J,1,I)) Q:'I D
-"RTN","C0CMAIL",110,0)
+"RTN","C0CMAIL",107,0)
. S L=$P(^XMB(3.7,DUZ,2,J,1,I,0),U,3)
-"RTN","C0CMAIL",111,0)
+"RTN","C0CMAIL",108,0)
. D ; :L
-"RTN","C0CMAIL",112,0)
+"RTN","C0CMAIL",109,0)
. . S:L K=K+1,LST(NAM,"MSG",I,"NEW")="" ; Flag NEW emails
-"RTN","C0CMAIL",113,0)
+"RTN","C0CMAIL",110,0)
. . S LST(NAM,"MSG",I)=L
-"RTN","C0CMAIL",114,0)
+"RTN","C0CMAIL",111,0)
. . D GETTYP(I)
-"RTN","C0CMAIL",115,0)
+"RTN","C0CMAIL",112,0)
. .QUIT
-"RTN","C0CMAIL",116,0)
+"RTN","C0CMAIL",113,0)
.QUIT
-"RTN","C0CMAIL",117,0)
+"RTN","C0CMAIL",114,0)
S LST(NAM,"NUMBER")=K
-"RTN","C0CMAIL",118,0)
+"RTN","C0CMAIL",115,0)
QUIT
-"RTN","C0CMAIL",119,0)
+"RTN","C0CMAIL",116,0)
; ===================
-"RTN","C0CMAIL",120,0)
+"RTN","C0CMAIL",117,0)
; D0 is the IEN into the Message Global ^XMB(3.9,D0)
-"RTN","C0CMAIL",121,0)
+"RTN","C0CMAIL",118,0)
; The products of these emails are scanned to identify
-"RTN","C0CMAIL",122,0)
+"RTN","C0CMAIL",119,0)
; the number of documents stored in the MIME package.
-"RTN","C0CMAIL",123,0)
+"RTN","C0CMAIL",120,0)
; The protocol runs like this;
-"RTN","C0CMAIL",124,0)
+"RTN","C0CMAIL",121,0)
; Line 1 is the --separator
-"RTN","C0CMAIL",125,0)
+"RTN","C0CMAIL",122,0)
; Line 2 thru n >Look for Content-[detail type:]Description ; Next CMD
-"RTN","C0CMAIL",126,0)
+"RTN","C0CMAIL",123,0)
; Line n+2 thru t-1 where t does NOT have "Content-"
-"RTN","C0CMAIL",127,0)
+"RTN","C0CMAIL",124,0)
; Line t is Next Section Terminator, or Message Terminator, --separator
-"RTN","C0CMAIL",128,0)
+"RTN","C0CMAIL",125,0)
; Line t+1 should not exist in the data set if Message Terminator
-"RTN","C0CMAIL",129,0)
+"RTN","C0CMAIL",126,0)
; CON = "Content-"
-"RTN","C0CMAIL",130,0)
+"RTN","C0CMAIL",127,0)
; FLG = "--"
-"RTN","C0CMAIL",131,0)
+"RTN","C0CMAIL",128,0)
; SEP = FLG+7 or more characters ; Separator
-"RTN","C0CMAIL",132,0)
+"RTN","C0CMAIL",129,0)
; END = SEP+FLG
-"RTN","C0CMAIL",133,0)
+"RTN","C0CMAIL",130,0)
; SGC = Segment Count
-"RTN","C0CMAIL",134,0)
+"RTN","C0CMAIL",131,0)
; Note: separator is a string of specific characters of
-"RTN","C0CMAIL",135,0)
+"RTN","C0CMAIL",132,0)
; indeterminate length
-"RTN","C0CMAIL",136,0)
+"RTN","C0CMAIL",133,0)
; LST() the transfer array
-"RTN","C0CMAIL",137,0)
+"RTN","C0CMAIL",134,0)
; LST(NAM,"MSG",C0CIEN,"SEG",SGN)=Starting Line^Ending Line
-"RTN","C0CMAIL",138,0)
+"RTN","C0CMAIL",135,0)
; LST(NAM,"MSG",C0CIEN,"SEG",SGN,1:n)=Decoded Message Data
-"RTN","C0CMAIL",139,0)
+"RTN","C0CMAIL",136,0)
;
-"RTN","C0CMAIL",140,0)
+"RTN","C0CMAIL",137,0)
GETTYP(D0) ; Look for the goodies in the Mail
-"RTN","C0CMAIL",141,0)
+"RTN","C0CMAIL",138,0)
N I,J,N,BCN,CON,CNT,D1,END,FLG,SEP,SGC,XX,XXNM
-"RTN","C0CMAIL",142,0)
+"RTN","C0CMAIL",139,0)
S CON="Content-"
-"RTN","C0CMAIL",143,0)
+"RTN","C0CMAIL",140,0)
S FLG="--"
-"RTN","C0CMAIL",144,0)
+"RTN","C0CMAIL",141,0)
S SEP="" ; Start SEP as null, so we can use this to help identify the type
-"RTN","C0CMAIL",145,0)
+"RTN","C0CMAIL",142,0)
S (BCN,CNT,D1,END,SGC)=0
-"RTN","C0CMAIL",146,0)
+"RTN","C0CMAIL",143,0)
S XX=$G(^XMB(3.9,D0,0))
-"RTN","C0CMAIL",147,0)
+"RTN","C0CMAIL",144,0)
S LST(NAM,"MSG",D0,"TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
-"RTN","C0CMAIL",148,0)
+"RTN","C0CMAIL",145,0)
S LST(NAM,"MSG",D0,"CREATED")=$G(^XMB(3.9,D0,.6))
-"RTN","C0CMAIL",149,0)
+"RTN","C0CMAIL",146,0)
F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM)
-"RTN","C0CMAIL",150,0)
+"RTN","C0CMAIL",147,0)
S LST(NAM,"MSG",D0,"FROM")=$$NAME(XXNM)
-"RTN","C0CMAIL",151,0)
+"RTN","C0CMAIL",148,0)
S LST(NAM,"MSG",D0,"SENT")=$$TIME($P(XX,U,3))
-"RTN","C0CMAIL",152,0)
+"RTN","C0CMAIL",149,0)
; Get the folks the email is sent to.
-"RTN","C0CMAIL",153,0)
+"RTN","C0CMAIL",150,0)
S D1=0
-"RTN","C0CMAIL",154,0)
+"RTN","C0CMAIL",151,0)
F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D
-"RTN","C0CMAIL",155,0)
+"RTN","C0CMAIL",152,0)
. N T
-"RTN","C0CMAIL",156,0)
+"RTN","C0CMAIL",153,0)
. S T=+$G(^XMB(3.9,D0,1,D1,0))
+"RTN","C0CMAIL",154,0)
+ . S:T T=$P($G(^VA(200,+T,0)),"^")
+"RTN","C0CMAIL",155,0)
+ . S LST("TO",D1)=T
+"RTN","C0CMAIL",156,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=""
"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)
- . S:T="" T=""
-"RTN","C0CMAIL",162,0)
- . S LST("TO NAME",D1)=T
-"RTN","C0CMAIL",163,0)
- .QUIT
-"RTN","C0CMAIL",164,0)
; Preload first Segment (0) with beginning on Line 1
-"RTN","C0CMAIL",165,0)
+"RTN","C0CMAIL",162,0)
; if not a 64bit
-"RTN","C0CMAIL",166,0)
+"RTN","C0CMAIL",163,0)
S LST(NAM,"MSG",D0,"SEG",0)=1
-"RTN","C0CMAIL",167,0)
+"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)
- F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D
+ . ; Enter once to set the SEP to capture the separator
"RTN","C0CMAIL",169,0)
- . ; Clear any control characters (cr/lf/ff) off
-"RTN","C0CMAIL",170,0)
- . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
-"RTN","C0CMAIL",171,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",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)
- . . S SEP=X,END=X_FLG
+ . .QUIT
"RTN","C0CMAIL",174,0)
- . . S (CNT,SGC)=1,BCN=0
+ . ;
"RTN","C0CMAIL",175,0)
- . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
-"RTN","C0CMAIL",176,0)
- . .QUIT
-"RTN","C0CMAIL",177,0)
- . ;
-"RTN","C0CMAIL",178,0)
. ; A new separator is set, process original
-"RTN","C0CMAIL",179,0)
+"RTN","C0CMAIL",176,0)
. I X=SEP D QUIT
-"RTN","C0CMAIL",180,0)
+"RTN","C0CMAIL",177,0)
. . S LST(NAM,"MSG",D0,SGC,"SIZE")=BCN
-"RTN","C0CMAIL",181,0)
+"RTN","C0CMAIL",178,0)
. . S LST(NAM,"MSG",D0,"SEG",SGC)=$G(LST(NAM,"MSG",D0,"SEG",SGC))_"^"_(D1-1)
-"RTN","C0CMAIL",182,0)
+"RTN","C0CMAIL",179,0)
. . S SGC=SGC+1,BCN=0
-"RTN","C0CMAIL",183,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)
- . .QUIT
+ . I X[CON D Q
"RTN","C0CMAIL",185,0)
- . ;
-"RTN","C0CMAIL",186,0)
- . S BCN=BCN+$L(X)
-"RTN","C0CMAIL",187,0)
- . I X[CON D Q
-"RTN","C0CMAIL",188,0)
. . S J=$P($P(X,";"),CON,2)
-"RTN","C0CMAIL",189,0)
+"RTN","C0CMAIL",186,0)
. . S LST(NAM,"MSG",D0,"SEG",SGC,"CONT",CNT,$P(J,":"))=$P(J,":",2)
-"RTN","C0CMAIL",190,0)
+"RTN","C0CMAIL",187,0)
. .QUIT
-"RTN","C0CMAIL",191,0)
+"RTN","C0CMAIL",188,0)
. ;
-"RTN","C0CMAIL",192,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)
- .QUIT
-"RTN","C0CMAIL",194,0)
- QUIT
-"RTN","C0CMAIL",195,0)
- ; ===================
-"RTN","C0CMAIL",196,0)
NAME(NM) ; Return the name of the Sender
-"RTN","C0CMAIL",197,0)
+"RTN","C0CMAIL",194,0)
N NAME
-"RTN","C0CMAIL",198,0)
+"RTN","C0CMAIL",195,0)
S NAME=""
-"RTN","C0CMAIL",199,0)
+"RTN","C0CMAIL",196,0)
D
-"RTN","C0CMAIL",200,0)
+"RTN","C0CMAIL",197,0)
. ; Look first for a value to use with the NEW PERSON file
-"RTN","C0CMAIL",201,0)
+"RTN","C0CMAIL",198,0)
. ;
-"RTN","C0CMAIL",202,0)
+"RTN","C0CMAIL",199,0)
. I NM=+NM S NAME=$P(^VA(200,NM,0),U,1) Q
-"RTN","C0CMAIL",203,0)
+"RTN","C0CMAIL",200,0)
. ;
-"RTN","C0CMAIL",204,0)
+"RTN","C0CMAIL",201,0)
. I $L(NM) S NAME=NM Q
-"RTN","C0CMAIL",205,0)
+"RTN","C0CMAIL",202,0)
. ;
-"RTN","C0CMAIL",206,0)
+"RTN","C0CMAIL",203,0)
. ; Else, pull the data from the message and display the foreign source
-"RTN","C0CMAIL",207,0)
+"RTN","C0CMAIL",204,0)
. ; of the message.
-"RTN","C0CMAIL",208,0)
+"RTN","C0CMAIL",205,0)
. N T
-"RTN","C0CMAIL",209,0)
+"RTN","C0CMAIL",206,0)
. S VAL=$G(^XMB(3.9,D0,.7))
-"RTN","C0CMAIL",210,0)
+"RTN","C0CMAIL",207,0)
. S:VAL T=$P(^VA(200,VAL,0),U)
-"RTN","C0CMAIL",211,0)
+"RTN","C0CMAIL",208,0)
. I $L($G(T)) S NAME=T Q
-"RTN","C0CMAIL",212,0)
+"RTN","C0CMAIL",209,0)
. ;
-"RTN","C0CMAIL",213,0)
+"RTN","C0CMAIL",210,0)
.QUIT
-"RTN","C0CMAIL",214,0)
+"RTN","C0CMAIL",211,0)
QUIT NAME
-"RTN","C0CMAIL",215,0)
+"RTN","C0CMAIL",212,0)
; ===================
-"RTN","C0CMAIL",216,0)
+"RTN","C0CMAIL",213,0)
TIME(Y) ; The time and date of the sending
-"RTN","C0CMAIL",217,0)
+"RTN","C0CMAIL",214,0)
X ^DD("DD")
-"RTN","C0CMAIL",218,0)
+"RTN","C0CMAIL",215,0)
QUIT Y
-"RTN","C0CMAIL",219,0)
+"RTN","C0CMAIL",216,0)
; ===================
-"RTN","C0CMAIL",220,0)
+"RTN","C0CMAIL",217,0)
; Segments in Message need to be identified and decoded properly
-"RTN","C0CMAIL",221,0)
+"RTN","C0CMAIL",218,0)
; D DETAIL^C0CMAIL(.ARRAY,D0) ; Call One for each message
-"RTN","C0CMAIL",222,0)
+"RTN","C0CMAIL",219,0)
; ARRAY will have the details of this one call
-"RTN","C0CMAIL",223,0)
+"RTN","C0CMAIL",220,0)
;
-"RTN","C0CMAIL",224,0)
+"RTN","C0CMAIL",221,0)
; Inputs;
-"RTN","C0CMAIL",225,0)
+"RTN","C0CMAIL",222,0)
; C0CINPUT - The IEN of the message to expand
-"RTN","C0CMAIL",226,0)
+"RTN","C0CMAIL",223,0)
; Outputs;
-"RTN","C0CMAIL",227,0)
+"RTN","C0CMAIL",224,0)
; C0CDATA - Carrier for the returned structure of the Message
-"RTN","C0CMAIL",228,0)
+"RTN","C0CMAIL",225,0)
; C0CDATA(D0,"SEG")=number of SEGMENTS
-"RTN","C0CMAIL",229,0)
+"RTN","C0CMAIL",226,0)
; C0CDATA(D0,"SEG",0:n)=SEGMENT n details
-"RTN","C0CMAIL",230,0)
+"RTN","C0CMAIL",227,0)
; C0CDATA(D0,"SEG",0:n,"CONTENT",type)=Content details
-"RTN","C0CMAIL",231,0)
+"RTN","C0CMAIL",228,0)
; C0CDATA(D0,"SEG",0:n,"MSG",D3)=Content details
-"RTN","C0CMAIL",232,0)
+"RTN","C0CMAIL",229,0)
; C0CDATA(D0,"SEG",0:n,"HTML",D3)=Content details
-"RTN","C0CMAIL",233,0)
+"RTN","C0CMAIL",230,0)
;
-"RTN","C0CMAIL",234,0)
+"RTN","C0CMAIL",231,0)
DETAIL(C0CDATA,C0CINPUT) ; Message Detail Delivery
-"RTN","C0CMAIL",235,0)
+"RTN","C0CMAIL",232,0)
N LST,D0,D1,U
-"RTN","C0CMAIL",236,0)
+"RTN","C0CMAIL",233,0)
S U="^"
-"RTN","C0CMAIL",237,0)
+"RTN","C0CMAIL",234,0)
S D0=+$G(C0CINPUT)
-"RTN","C0CMAIL",238,0)
+"RTN","C0CMAIL",235,0)
I D0 D QUIT
-"RTN","C0CMAIL",239,0)
+"RTN","C0CMAIL",236,0)
. D GETTYP2(D0)
-"RTN","C0CMAIL",240,0)
+"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)
- .QUIT
+ ; End note if needed
"RTN","C0CMAIL",242,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)
+"RTN","C0CMAIL",243,0)
GETTYP2(D0) ; Try to get the types and MSK for the
-"RTN","C0CMAIL",247,0)
+"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",248,0)
+"RTN","C0CMAIL",245,0)
S CON="Content-",U="^"
-"RTN","C0CMAIL",249,0)
+"RTN","C0CMAIL",246,0)
S FLG="--"
-"RTN","C0CMAIL",250,0)
+"RTN","C0CMAIL",247,0)
S MSK=" !""#$%&'()*,-.:;<>?@[\]^_`{|}~"
-"RTN","C0CMAIL",251,0)
+"RTN","C0CMAIL",248,0)
S (BF,SEP)="" ; Start SEP as null, so we can use this to help identify the type
-"RTN","C0CMAIL",252,0)
+"RTN","C0CMAIL",249,0)
S (BCN,CNT,D1,END,SGC)=0
-"RTN","C0CMAIL",253,0)
+"RTN","C0CMAIL",250,0)
S XX=$G(^XMB(3.9,D0,0))
-"RTN","C0CMAIL",254,0)
+"RTN","C0CMAIL",251,0)
; S K=$P(^XMB(3.9,D0,2,0),U,3)
-"RTN","C0CMAIL",255,0)
+"RTN","C0CMAIL",252,0)
S LST("TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
-"RTN","C0CMAIL",256,0)
+"RTN","C0CMAIL",253,0)
S LST("CREATED")=$$TIME($P(XX,U,3))
-"RTN","C0CMAIL",257,0)
+"RTN","C0CMAIL",254,0)
F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM)
-"RTN","C0CMAIL",258,0)
+"RTN","C0CMAIL",255,0)
S LST("FROM")=$$NAME(XXNM)
-"RTN","C0CMAIL",259,0)
+"RTN","C0CMAIL",256,0)
; Get the folks the email is sent to.
-"RTN","C0CMAIL",260,0)
+"RTN","C0CMAIL",257,0)
S D1=0
-"RTN","C0CMAIL",261,0)
+"RTN","C0CMAIL",258,0)
F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D Q:D1=""
-"RTN","C0CMAIL",262,0)
+"RTN","C0CMAIL",259,0)
. N I,T
-"RTN","C0CMAIL",263,0)
+"RTN","C0CMAIL",260,0)
. S T=$P($G(^XMB(3.9,D0,1,D1,0)),U)
-"RTN","C0CMAIL",264,0)
+"RTN","C0CMAIL",261,0)
. S:T T=$P($G(^VA(200,T,0)),"^")
-"RTN","C0CMAIL",265,0)
+"RTN","C0CMAIL",262,0)
. S LST("TO",+D1)=T
-"RTN","C0CMAIL",266,0)
+"RTN","C0CMAIL",263,0)
. S T=$G(^XMB(3.9,D0,6,+D1,0))
-"RTN","C0CMAIL",267,0)
+"RTN","C0CMAIL",264,0)
. S:T="" T=$P($G(^VA(200,+T,0)),"^")
-"RTN","C0CMAIL",268,0)
+"RTN","C0CMAIL",265,0)
. S:T="" T=""
-"RTN","C0CMAIL",269,0)
+"RTN","C0CMAIL",266,0)
. S LST("TO NAME",D1)=T
-"RTN","C0CMAIL",270,0)
+"RTN","C0CMAIL",267,0)
.QUIT
-"RTN","C0CMAIL",271,0)
+"RTN","C0CMAIL",268,0)
; Get the Header for the message
-"RTN","C0CMAIL",272,0)
+"RTN","C0CMAIL",269,0)
S D1=0
-"RTN","C0CMAIL",273,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",274,0)
+"RTN","C0CMAIL",271,0)
. S LST("HDR",I)=$G(^XMB(3.9,D0,2,D1,0))
-"RTN","C0CMAIL",275,0)
+"RTN","C0CMAIL",272,0)
.QUIT
-"RTN","C0CMAIL",276,0)
+"RTN","C0CMAIL",273,0)
; Start walking the different sections
-"RTN","C0CMAIL",277,0)
+"RTN","C0CMAIL",274,0)
S D1=.99999,SEP="--"
-"RTN","C0CMAIL",278,0)
+"RTN","C0CMAIL",275,0)
F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D
-"RTN","C0CMAIL",279,0)
+"RTN","C0CMAIL",276,0)
. ; Clear any control characters (cr/lf/ff) off
-"RTN","C0CMAIL",280,0)
+"RTN","C0CMAIL",277,0)
. S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
-"RTN","C0CMAIL",281,0)
+"RTN","C0CMAIL",278,0)
. ; Enter once to set the SEP to capture the separator
-"RTN","C0CMAIL",282,0)
+"RTN","C0CMAIL",279,0)
. I (SEP="--")&($E(X,1,2)=FLG)&($L(X,FLG)=2) D Q
-"RTN","C0CMAIL",283,0)
+"RTN","C0CMAIL",280,0)
. . S SEP=X,END=X_FLG
-"RTN","C0CMAIL",284,0)
+"RTN","C0CMAIL",281,0)
. . S (CNT,SGC)=1,BCN=0
+"RTN","C0CMAIL",282,0)
+ . . S LST("SEG",SGC)=D1
+"RTN","C0CMAIL",283,0)
+ . .QUIT
+"RTN","C0CMAIL",284,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)
+"RTN","C0CMAIL",286,0)
. I X=SEP D QUIT
-"RTN","C0CMAIL",290,0)
+"RTN","C0CMAIL",287,0)
. . ; Save Current Values
-"RTN","C0CMAIL",291,0)
+"RTN","C0CMAIL",288,0)
. . S LST("SEG",SGC,"SIZE")=BCN
-"RTN","C0CMAIL",292,0)
+"RTN","C0CMAIL",289,0)
. . ; Close this Segment and prepare to start a New Segment
-"RTN","C0CMAIL",293,0)
+"RTN","C0CMAIL",290,0)
. . S LST("SEG",SGC)=$G(LST("SEG",SGC))_"^"_(D1-1)
-"RTN","C0CMAIL",294,0)
+"RTN","C0CMAIL",291,0)
. . ; Put the result in LST("SEG",SGC,"XML")
-"RTN","C0CMAIL",295,0)
+"RTN","C0CMAIL",292,0)
. . I $L(BF) D
-"RTN","C0CMAIL",296,0)
+"RTN","C0CMAIL",293,0)
. . . S ZN=1
-"RTN","C0CMAIL",297,0)
+"RTN","C0CMAIL",294,0)
. . . N I,T,TBF
-"RTN","C0CMAIL",298,0)
+"RTN","C0CMAIL",295,0)
. . . S TBF=BF
-"RTN","C0CMAIL",299,0)
+"RTN","C0CMAIL",296,0)
. . . F I=1:1:($L(TBF,"=")) D
-"RTN","C0CMAIL",300,0)
+"RTN","C0CMAIL",297,0)
. . . . S BF=$P(TBF,"=",I)_"="
-"RTN","C0CMAIL",301,0)
+"RTN","C0CMAIL",298,0)
. . . . I BF'="=" D DECODER
-"RTN","C0CMAIL",302,0)
+"RTN","C0CMAIL",299,0)
. . . .QUIT
-"RTN","C0CMAIL",303,0)
+"RTN","C0CMAIL",300,0)
. . . S BF=""
-"RTN","C0CMAIL",304,0)
+"RTN","C0CMAIL",301,0)
. . .QUIT
-"RTN","C0CMAIL",305,0)
+"RTN","C0CMAIL",302,0)
. . S SGC=SGC+1,BCN=0
-"RTN","C0CMAIL",306,0)
+"RTN","C0CMAIL",303,0)
. . ; Incriment SGC to start a new Segment
-"RTN","C0CMAIL",307,0)
+"RTN","C0CMAIL",304,0)
. . S LST("SEG",SGC)=D1
-"RTN","C0CMAIL",308,0)
+"RTN","C0CMAIL",305,0)
. .QUIT
-"RTN","C0CMAIL",309,0)
+"RTN","C0CMAIL",306,0)
. ;
-"RTN","C0CMAIL",310,0)
+"RTN","C0CMAIL",307,0)
. ; Accumulate the 64 bit encoding
-"RTN","C0CMAIL",311,0)
+"RTN","C0CMAIL",308,0)
. I X=$TR(X,MSK)&$L(X) D Q
-"RTN","C0CMAIL",312,0)
+"RTN","C0CMAIL",309,0)
. . S BF=BF_X
-"RTN","C0CMAIL",313,0)
+"RTN","C0CMAIL",310,0)
. . S BCN=BCN+$L(X)
-"RTN","C0CMAIL",314,0)
+"RTN","C0CMAIL",311,0)
. .QUIT
-"RTN","C0CMAIL",315,0)
+"RTN","C0CMAIL",312,0)
. ;
-"RTN","C0CMAIL",316,0)
+"RTN","C0CMAIL",313,0)
. ; Ending Condition, close out the Segment
-"RTN","C0CMAIL",317,0)
+"RTN","C0CMAIL",314,0)
. I X=END D QUIT
-"RTN","C0CMAIL",318,0)
+"RTN","C0CMAIL",315,0)
. . S LST("SEG",SGC)=$G(LST("SEG",SGC))_"^"_(D1-1)
-"RTN","C0CMAIL",319,0)
+"RTN","C0CMAIL",316,0)
. . I $L(BF) S ZN=1 D DECODER S BF="" Q
-"RTN","C0CMAIL",320,0)
+"RTN","C0CMAIL",317,0)
. .QUIT
-"RTN","C0CMAIL",321,0)
+"RTN","C0CMAIL",318,0)
. ;
-"RTN","C0CMAIL",322,0)
+"RTN","C0CMAIL",319,0)
. S BCN=BCN+$L(X)
-"RTN","C0CMAIL",323,0)
+"RTN","C0CMAIL",320,0)
. ; Split out the Content Info
-"RTN","C0CMAIL",324,0)
+"RTN","C0CMAIL",321,0)
. I X[CON D Q
-"RTN","C0CMAIL",325,0)
+"RTN","C0CMAIL",322,0)
. . S J=$P(X,CON,2)
-"RTN","C0CMAIL",326,0)
+"RTN","C0CMAIL",323,0)
. . S LST("SEG",SGC,"CONTENT",$P(J,":"))=$P(J,":",2,9)
-"RTN","C0CMAIL",327,0)
+"RTN","C0CMAIL",324,0)
. .QUIT
-"RTN","C0CMAIL",328,0)
+"RTN","C0CMAIL",325,0)
. ;
-"RTN","C0CMAIL",329,0)
+"RTN","C0CMAIL",326,0)
. ; Everything else is Text
-"RTN","C0CMAIL",330,0)
+"RTN","C0CMAIL",327,0)
. S LST("SEG",SGC,"TXT",D1)=X
+"RTN","C0CMAIL",328,0)
+ .QUIT
+"RTN","C0CMAIL",329,0)
+ QUIT
+"RTN","C0CMAIL",330,0)
+ ; ===================
"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)
+"RTN","C0CMAIL",332,0)
; BF is passed in.
-"RTN","C0CMAIL",336,0)
+"RTN","C0CMAIL",333,0)
DECODER ;
-"RTN","C0CMAIL",337,0)
+"RTN","C0CMAIL",334,0)
N RCNT,TBF,ZBF,ZI,ZJ,ZK,ZSIZE
-"RTN","C0CMAIL",338,0)
+"RTN","C0CMAIL",335,0)
S ZBF=BF
-"RTN","C0CMAIL",339,0)
+"RTN","C0CMAIL",336,0)
; Full Buffer, BF, now check for Encryption and Unpack
-"RTN","C0CMAIL",340,0)
+"RTN","C0CMAIL",337,0)
F RCNT=1:1:$L(ZBF,"=") D
-"RTN","C0CMAIL",341,0)
+"RTN","C0CMAIL",338,0)
. N BF
-"RTN","C0CMAIL",342,0)
+"RTN","C0CMAIL",339,0)
. S BF=$P(ZBF,"=",RCNT)
-"RTN","C0CMAIL",343,0)
+"RTN","C0CMAIL",340,0)
. ; Unpacking the 64 bit encoding
-"RTN","C0CMAIL",344,0)
+"RTN","C0CMAIL",341,0)
. S TBF=$TR($$DECODE^RGUTUU(BF),$C(10,12,13))
-"RTN","C0CMAIL",345,0)
+"RTN","C0CMAIL",342,0)
. D:$L(TBF)
-"RTN","C0CMAIL",346,0)
+"RTN","C0CMAIL",343,0)
. . N XBF
-"RTN","C0CMAIL",347,0)
+"RTN","C0CMAIL",344,0)
. . S BF=BF_"="
-"RTN","C0CMAIL",348,0)
+"RTN","C0CMAIL",345,0)
. . D NORMAL(.XBF,.TBF)
-"RTN","C0CMAIL",349,0)
+"RTN","C0CMAIL",346,0)
. . M LST("SEG",SGC,"XML",RCNT)=XBF
-"RTN","C0CMAIL",350,0)
+"RTN","C0CMAIL",347,0)
. .QUIT
+"RTN","C0CMAIL",348,0)
+ .QUIT
+"RTN","C0CMAIL",349,0)
+ QUIT
+"RTN","C0CMAIL",350,0)
+ ; ===================
"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)
+"RTN","C0CMAIL",352,0)
; BF = INXML = INPUT ARRAY TO PROVIDE INPUT
-"RTN","C0CMAIL",356,0)
+"RTN","C0CMAIL",353,0)
; >D NORMAL^C0CMAIL(.OUT,BF)
-"RTN","C0CMAIL",357,0)
+"RTN","C0CMAIL",354,0)
NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
-"RTN","C0CMAIL",358,0)
+"RTN","C0CMAIL",355,0)
; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
-"RTN","C0CMAIL",359,0)
+"RTN","C0CMAIL",356,0)
;
-"RTN","C0CMAIL",360,0)
+"RTN","C0CMAIL",357,0)
N ZN,OUTBF
-"RTN","C0CMAIL",361,0)
+"RTN","C0CMAIL",358,0)
S ZN=1
-"RTN","C0CMAIL",362,0)
+"RTN","C0CMAIL",359,0)
S OUTBF(ZN)=$P(INXML,"><",ZN)_">"
-"RTN","C0CMAIL",363,0)
+"RTN","C0CMAIL",360,0)
F ZN=ZN+1:1 S OUTBF(ZN)="<"_$P(INXML,"><",ZN) Q:$P(INXML,"><",ZN+1)="" D ;
-"RTN","C0CMAIL",364,0)
+"RTN","C0CMAIL",361,0)
. S OUTBF(ZN)=OUTBF(ZN)_">"
-"RTN","C0CMAIL",365,0)
+"RTN","C0CMAIL",362,0)
.QUIT
-"RTN","C0CMAIL",366,0)
+"RTN","C0CMAIL",363,0)
M OUTXML=OUTBF
-"RTN","C0CMAIL",367,0)
+"RTN","C0CMAIL",364,0)
QUIT
-"RTN","C0CMAIL",368,0)
+"RTN","C0CMAIL",365,0)
; ===================
-"RTN","C0CMAIL",369,0)
+"RTN","C0CMAIL",366,0)
; vvvvvvvvvvvvvvv Not Needed vvvvvvvvvvvvvvvvvvvvvvvvvv
-"RTN","C0CMAIL",370,0)
+"RTN","C0CMAIL",367,0)
; End note if needed
-"RTN","C0CMAIL",371,0)
+"RTN","C0CMAIL",368,0)
QUIT
-"RTN","C0CMAIL",372,0)
+"RTN","C0CMAIL",369,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
"RTN","C0CMAIL2",4,0)
@@ -104055,929 +104085,923 @@ C0CMAIL2 ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr
"RTN","C0CMAIL2",5,0)
; 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 .
"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.
-"RTN","C0CMAIL2",22,0)
- ;
-"RTN","C0CMAIL2",23,0)
; ------------------
-"RTN","C0CMAIL2",24,0)
+"RTN","C0CMAIL2",21,0)
;Entry Points
-"RTN","C0CMAIL2",25,0)
+"RTN","C0CMAIL2",22,0)
; DETAIL^C0CMAIL(.C0CDATA,IEN) --> Get details of the Mail Message and Attachments
-"RTN","C0CMAIL2",26,0)
+"RTN","C0CMAIL2",23,0)
; GETMSG^C0CMAIL(.C0CDATA,.C0CINPUT)
-"RTN","C0CMAIL2",27,0)
+"RTN","C0CMAIL2",24,0)
; Input:
-"RTN","C0CMAIL2",28,0)
+"RTN","C0CMAIL2",25,0)
; C0CINPUT = "DUZ;MAILBOX_Name[or IEN for box (comma Separated);MALL
-"RTN","C0CMAIL2",29,0)
+"RTN","C0CMAIL2",26,0)
; or "*" for all boxes, default is "IN" if missing]"
-"RTN","C0CMAIL2",30,0)
+"RTN","C0CMAIL2",27,0)
; $P(C0CINPUT,";",3)=MALL, default=NUL means "New only",
-"RTN","C0CMAIL2",31,0)
+"RTN","C0CMAIL2",28,0)
; "*" for All or 9,999 maximum
-"RTN","C0CMAIL2",32,0)
+"RTN","C0CMAIL2",29,0)
; MALL?1.n = that number of the n most recent
-"RTN","C0CMAIL2",33,0)
+"RTN","C0CMAIL2",30,0)
; Internally:
-"RTN","C0CMAIL2",34,0)
+"RTN","C0CMAIL2",31,0)
; BNAM = Box Name
-"RTN","C0CMAIL2",35,0)
+"RTN","C0CMAIL2",32,0)
; Output:
-"RTN","C0CMAIL2",36,0)
+"RTN","C0CMAIL2",33,0)
; C0CDATA
-"RTN","C0CMAIL2",37,0)
+"RTN","C0CMAIL2",34,0)
; = (BNAM,"NUMBER") = Number of NEW Emails in Basket
-"RTN","C0CMAIL2",38,0)
+"RTN","C0CMAIL2",35,0)
; (BNAM,"MSG",C0CIEN,"FROM")=Name
-"RTN","C0CMAIL2",39,0)
+"RTN","C0CMAIL2",36,0)
; (BNAM,"MSG",C0CIEN,"TO",n)=DUZ, or EMAIL Address
-"RTN","C0CMAIL2",40,0)
+"RTN","C0CMAIL2",37,0)
; (BNAM,"MSG",C0CIEN,"TO NAME",n)=Names or EMAIL Address
-"RTN","C0CMAIL2",41,0)
+"RTN","C0CMAIL2",38,0)
; (BNAM,"MSG",C0CIEN,"TITLE")=EMAIL Title
-"RTN","C0CMAIL2",42,0)
+"RTN","C0CMAIL2",39,0)
; (BNAM,"MSG",C0CIEN[for File 3.9])=Number of Attachments
-"RTN","C0CMAIL2",43,0)
+"RTN","C0CMAIL2",40,0)
; (BNAM,"MSG",C0CIEN,num,"CONT") = Free Text
-"RTN","C0CMAIL2",44,0)
+"RTN","C0CMAIL2",41,0)
; (BNAM,"MSG",C0CIEN,num,"LINES") = Number of Lines of Text
-"RTN","C0CMAIL2",45,0)
+"RTN","C0CMAIL2",42,0)
; (BNAM,"MSG",C0CIEN,num,"SIZE") = Size of the Message in Bytes
-"RTN","C0CMAIL2",46,0)
+"RTN","C0CMAIL2",43,0)
; (BNAM,"MSG",C0CIEN,num,"TXT",LINE#) = Message Data (No Attachment)
-"RTN","C0CMAIL2",47,0)
+"RTN","C0CMAIL2",44,0)
; (BNAM,"MSG",C0CIEN,"SEG",NUM) = First Line^Last Line
-"RTN","C0CMAIL2",48,0)
+"RTN","C0CMAIL2",45,0)
; (BNAM,"MSG",C0CIEN,"SEG",NUM,"CONT",type) = Message Details
-"RTN","C0CMAIL2",49,0)
+"RTN","C0CMAIL2",46,0)
; (BNAM,"MSG",C0CIEN,"SEG",NUM,LINE#) = Message Data
-"RTN","C0CMAIL2",50,0)
+"RTN","C0CMAIL2",47,0)
;
-"RTN","C0CMAIL2",51,0)
+"RTN","C0CMAIL2",48,0)
; DO DETAIL^C0CMAIL(.OUTBF,D0) ; For each Email Message and Attachments
-"RTN","C0CMAIL2",52,0)
+"RTN","C0CMAIL2",49,0)
; Input;
-"RTN","C0CMAIL2",53,0)
+"RTN","C0CMAIL2",50,0)
; D0 - The IEN for the message in file 3.9, MESSAGE global
-"RTN","C0CMAIL2",54,0)
+"RTN","C0CMAIL2",51,0)
; Output
-"RTN","C0CMAIL2",55,0)
+"RTN","C0CMAIL2",52,0)
; OUTBF - The array of your choice to save the expanded and decoded message.
-"RTN","C0CMAIL2",56,0)
+"RTN","C0CMAIL2",53,0)
;
-"RTN","C0CMAIL2",57,0)
+"RTN","C0CMAIL2",54,0)
GETMSG(C0CDATA,C0CINPUT) ; Common Entry Point for Mailbox Data
-"RTN","C0CMAIL2",58,0)
+"RTN","C0CMAIL2",55,0)
K:'$G(C0CDATA("KEEP")) C0CDATA
-"RTN","C0CMAIL2",59,0)
+"RTN","C0CMAIL2",56,0)
N U
-"RTN","C0CMAIL2",60,0)
+"RTN","C0CMAIL2",57,0)
S U="^"
-"RTN","C0CMAIL2",61,0)
+"RTN","C0CMAIL2",58,0)
D:$G(C0CINPUT)
-"RTN","C0CMAIL2",62,0)
+"RTN","C0CMAIL2",59,0)
. N BF,DUZ,I,INPUT,J,L,LST,MBLST,MALL
-"RTN","C0CMAIL2",63,0)
+"RTN","C0CMAIL2",60,0)
. S INPUT=C0CINPUT
-"RTN","C0CMAIL2",64,0)
+"RTN","C0CMAIL2",61,0)
. S DUZ=+INPUT
-"RTN","C0CMAIL2",65,0)
+"RTN","C0CMAIL2",62,0)
. I $D(^VA(200,DUZ))=0!('$D(^VA(200,DUZ,0))) D ERROR("ER06") Q
-"RTN","C0CMAIL2",66,0)
+"RTN","C0CMAIL2",63,0)
. ;
-"RTN","C0CMAIL2",67,0)
+"RTN","C0CMAIL2",64,0)
. D:$D(^XMB(3.7,DUZ,0))#2
-"RTN","C0CMAIL2",68,0)
+"RTN","C0CMAIL2",65,0)
. . S MBLST=$P(INPUT,";",2)
-"RTN","C0CMAIL2",69,0)
+"RTN","C0CMAIL2",66,0)
. . S MALL=$P(INPUT,";",3) ; New or All Mail Flag
-"RTN","C0CMAIL2",70,0)
+"RTN","C0CMAIL2",67,0)
. . S:MALL["*" MALL=99999
-"RTN","C0CMAIL2",71,0)
+"RTN","C0CMAIL2",68,0)
. . ; Only one of these can be correct
-"RTN","C0CMAIL2",72,0)
+"RTN","C0CMAIL2",69,0)
. . D
-"RTN","C0CMAIL2",73,0)
+"RTN","C0CMAIL2",70,0)
. . . ; If nul, make it "IN" only
-"RTN","C0CMAIL2",74,0)
+"RTN","C0CMAIL2",71,0)
. . . I MBLST="" D QUIT
-"RTN","C0CMAIL2",75,0)
+"RTN","C0CMAIL2",72,0)
. . . . S MBLST("IN")=0,I=0
-"RTN","C0CMAIL2",76,0)
+"RTN","C0CMAIL2",73,0)
. . . . D GATHER(DUZ,"IN",.LST)
-"RTN","C0CMAIL2",77,0)
+"RTN","C0CMAIL2",74,0)
. . . .QUIT
-"RTN","C0CMAIL2",78,0)
+"RTN","C0CMAIL2",75,0)
. . . ;
-"RTN","C0CMAIL2",79,0)
+"RTN","C0CMAIL2",76,0)
. . . ; If "*", Get all Mailboxes and look for New Messages
-"RTN","C0CMAIL2",80,0)
+"RTN","C0CMAIL2",77,0)
. . . I MBLST["*" D QUIT
-"RTN","C0CMAIL2",81,0)
+"RTN","C0CMAIL2",78,0)
. . . . N NAM,NUM
-"RTN","C0CMAIL2",82,0)
+"RTN","C0CMAIL2",79,0)
. . . . S NUM=0
-"RTN","C0CMAIL2",83,0)
+"RTN","C0CMAIL2",80,0)
. . . . F S NUM=$O(^XMB(3.7,DUZ,2,NUM)) Q:'NUM D
-"RTN","C0CMAIL2",84,0)
+"RTN","C0CMAIL2",81,0)
. . . . . S NAM=$P(^XMB(3.7,DUZ,2,NUM,0),U)
-"RTN","C0CMAIL2",85,0)
+"RTN","C0CMAIL2",82,0)
. . . . . D GATHER(DUZ,NAM,.LST)
+"RTN","C0CMAIL2",83,0)
+ . . . . .QUIT
+"RTN","C0CMAIL2",84,0)
+ . . . .QUIT
+"RTN","C0CMAIL2",85,0)
+ . . . ;
"RTN","C0CMAIL2",86,0)
- . . . . .QUIT
-"RTN","C0CMAIL2",87,0)
- . . . .QUIT
-"RTN","C0CMAIL2",88,0)
- . . . ;
-"RTN","C0CMAIL2",89,0)
. . . ; If comma separated, look for mailboxes with new messages
-"RTN","C0CMAIL2",90,0)
+"RTN","C0CMAIL2",87,0)
. . . I $L(MBLST,",")>1 D QUIT
-"RTN","C0CMAIL2",91,0)
+"RTN","C0CMAIL2",88,0)
. . . . S NAM=""
-"RTN","C0CMAIL2",92,0)
+"RTN","C0CMAIL2",89,0)
. . . . N TN,V
-"RTN","C0CMAIL2",93,0)
+"RTN","C0CMAIL2",90,0)
. . . . F TN=1:1:$L(MBLST,",") S V=$P(MBLST,",",TN) D
-"RTN","C0CMAIL2",94,0)
+"RTN","C0CMAIL2",91,0)
. . . . . I $L(V) D QUIT
-"RTN","C0CMAIL2",95,0)
+"RTN","C0CMAIL2",92,0)
. . . . . . I V S NAM=$P($G(^XMB(3.7,DUZ,2,V,0)),U)
-"RTN","C0CMAIL2",96,0)
+"RTN","C0CMAIL2",93,0)
. . . . . . S:NAM="" NAM=V
-"RTN","C0CMAIL2",97,0)
+"RTN","C0CMAIL2",94,0)
. . . . . . D GATHER(DUZ,NAM,.LST)
-"RTN","C0CMAIL2",98,0)
+"RTN","C0CMAIL2",95,0)
. . . . . .QUIT
-"RTN","C0CMAIL2",99,0)
+"RTN","C0CMAIL2",96,0)
. . . . . ;
-"RTN","C0CMAIL2",100,0)
+"RTN","C0CMAIL2",97,0)
. . . . . D ERROR("ER08")
-"RTN","C0CMAIL2",101,0)
+"RTN","C0CMAIL2",98,0)
. . . . .QUIT
-"RTN","C0CMAIL2",102,0)
+"RTN","C0CMAIL2",99,0)
. . . .QUIT
-"RTN","C0CMAIL2",103,0)
+"RTN","C0CMAIL2",100,0)
. . . ;
-"RTN","C0CMAIL2",104,0)
+"RTN","C0CMAIL2",101,0)
. . . ; If only 1 mailbox named, go get it
-"RTN","C0CMAIL2",105,0)
+"RTN","C0CMAIL2",102,0)
. . . I $L(MBLST) D QUIT
-"RTN","C0CMAIL2",106,0)
+"RTN","C0CMAIL2",103,0)
. . . . I $D(^XMB(3.7,DUZ,2,"B",MBLST)) D GATHER(DUZ,MBLST,.LST) QUIT
-"RTN","C0CMAIL2",107,0)
+"RTN","C0CMAIL2",104,0)
. . . . ;
-"RTN","C0CMAIL2",108,0)
+"RTN","C0CMAIL2",105,0)
. . . . D ERROR("ER07")
-"RTN","C0CMAIL2",109,0)
+"RTN","C0CMAIL2",106,0)
. . .QUIT
-"RTN","C0CMAIL2",110,0)
+"RTN","C0CMAIL2",107,0)
. . MERGE C0CDATA=LST
+"RTN","C0CMAIL2",108,0)
+ . .QUIT
+"RTN","C0CMAIL2",109,0)
+ .QUIT
+"RTN","C0CMAIL2",110,0)
+ QUIT
"RTN","C0CMAIL2",111,0)
- . .QUIT
+ ; ===================
"RTN","C0CMAIL2",112,0)
- .QUIT
-"RTN","C0CMAIL2",113,0)
- QUIT
-"RTN","C0CMAIL2",114,0)
- ; ===================
-"RTN","C0CMAIL2",115,0)
GATHER(DUZ,NAM,LST) ; Gather Data about the Baskets and their mail
-"RTN","C0CMAIL2",116,0)
+"RTN","C0CMAIL2",113,0)
N I,J,K,L
-"RTN","C0CMAIL2",117,0)
+"RTN","C0CMAIL2",114,0)
S (I,K)=0
-"RTN","C0CMAIL2",118,0)
+"RTN","C0CMAIL2",115,0)
S J=$O(^XMB(3.7,DUZ,2,"B",NAM,""))
-"RTN","C0CMAIL2",119,0)
+"RTN","C0CMAIL2",116,0)
F S I=$O(^XMB(3.7,DUZ,2,J,1,I)) Q:'I D
-"RTN","C0CMAIL2",120,0)
+"RTN","C0CMAIL2",117,0)
. S L=$P(^XMB(3.7,DUZ,2,J,1,I,0),U,3)
-"RTN","C0CMAIL2",121,0)
+"RTN","C0CMAIL2",118,0)
. D ; :L
-"RTN","C0CMAIL2",122,0)
+"RTN","C0CMAIL2",119,0)
. . S:L K=K+1,LST(NAM,"MSG",I,"NEW")="" ; Flag NEW emails
-"RTN","C0CMAIL2",123,0)
+"RTN","C0CMAIL2",120,0)
. . S LST(NAM,"MSG",I)=L
-"RTN","C0CMAIL2",124,0)
+"RTN","C0CMAIL2",121,0)
. . D GETTYP(I)
-"RTN","C0CMAIL2",125,0)
+"RTN","C0CMAIL2",122,0)
. .QUIT
-"RTN","C0CMAIL2",126,0)
+"RTN","C0CMAIL2",123,0)
.QUIT
-"RTN","C0CMAIL2",127,0)
+"RTN","C0CMAIL2",124,0)
S LST(NAM,"NUMBER")=K
-"RTN","C0CMAIL2",128,0)
+"RTN","C0CMAIL2",125,0)
QUIT
-"RTN","C0CMAIL2",129,0)
+"RTN","C0CMAIL2",126,0)
; ===================
-"RTN","C0CMAIL2",130,0)
+"RTN","C0CMAIL2",127,0)
; D0 is the IEN into the Message Global ^XMB(3.9,D0)
-"RTN","C0CMAIL2",131,0)
+"RTN","C0CMAIL2",128,0)
; The products of these emails are scanned to identify
-"RTN","C0CMAIL2",132,0)
+"RTN","C0CMAIL2",129,0)
; the number of documents stored in the MIME package.
-"RTN","C0CMAIL2",133,0)
+"RTN","C0CMAIL2",130,0)
; The protocol runs like this;
-"RTN","C0CMAIL2",134,0)
+"RTN","C0CMAIL2",131,0)
; Line 1 is the --separator
-"RTN","C0CMAIL2",135,0)
+"RTN","C0CMAIL2",132,0)
; Line 2 thru n >Look for Content-[detail type:]Description ; Next CMD
-"RTN","C0CMAIL2",136,0)
+"RTN","C0CMAIL2",133,0)
; Line n+2 thru t-1 where t does NOT have "Content-"
-"RTN","C0CMAIL2",137,0)
+"RTN","C0CMAIL2",134,0)
; Line t is Next Section Terminator, or Message Terminator, --separator
-"RTN","C0CMAIL2",138,0)
+"RTN","C0CMAIL2",135,0)
; Line t+1 should not exist in the data set if Message Terminator
-"RTN","C0CMAIL2",139,0)
+"RTN","C0CMAIL2",136,0)
; CON = "Content-"
-"RTN","C0CMAIL2",140,0)
+"RTN","C0CMAIL2",137,0)
; FLG = "--"
-"RTN","C0CMAIL2",141,0)
+"RTN","C0CMAIL2",138,0)
; SEP = FLG+7 or more characters ; Separator
-"RTN","C0CMAIL2",142,0)
+"RTN","C0CMAIL2",139,0)
; END = SEP+FLG
-"RTN","C0CMAIL2",143,0)
+"RTN","C0CMAIL2",140,0)
; SGC = Segment Count
-"RTN","C0CMAIL2",144,0)
+"RTN","C0CMAIL2",141,0)
; Note: separator is a string of specific characters of
-"RTN","C0CMAIL2",145,0)
+"RTN","C0CMAIL2",142,0)
; indeterminate length
-"RTN","C0CMAIL2",146,0)
+"RTN","C0CMAIL2",143,0)
; LST() the transfer array
-"RTN","C0CMAIL2",147,0)
+"RTN","C0CMAIL2",144,0)
; LST(NAM,"MSG",C0CIEN,"SEG",SGN)=Starting Line^Ending Line
-"RTN","C0CMAIL2",148,0)
+"RTN","C0CMAIL2",145,0)
; LST(NAM,"MSG",C0CIEN,"SEG",SGN,1:n)=Decoded Message Data
-"RTN","C0CMAIL2",149,0)
+"RTN","C0CMAIL2",146,0)
;
-"RTN","C0CMAIL2",150,0)
+"RTN","C0CMAIL2",147,0)
GETTYP(D0) ; Look for the goodies in the Mail
-"RTN","C0CMAIL2",151,0)
+"RTN","C0CMAIL2",148,0)
N I,J,N,BCN,CON,CNT,D1,END,FLG,SEP,SGC,XX,XXNM
-"RTN","C0CMAIL2",152,0)
+"RTN","C0CMAIL2",149,0)
S CON="Content-"
-"RTN","C0CMAIL2",153,0)
+"RTN","C0CMAIL2",150,0)
S FLG="--"
-"RTN","C0CMAIL2",154,0)
+"RTN","C0CMAIL2",151,0)
S SEP="" ; Start SEP as null, so we can use this to help identify the type
-"RTN","C0CMAIL2",155,0)
+"RTN","C0CMAIL2",152,0)
S (BCN,CNT,D1,END,SGC)=0
-"RTN","C0CMAIL2",156,0)
+"RTN","C0CMAIL2",153,0)
S XX=$G(^XMB(3.9,D0,0))
-"RTN","C0CMAIL2",157,0)
+"RTN","C0CMAIL2",154,0)
S LST(NAM,"MSG",D0,"TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
-"RTN","C0CMAIL2",158,0)
+"RTN","C0CMAIL2",155,0)
S LST(NAM,"MSG",D0,"CREATED")=$G(^XMB(3.9,D0,.6))
-"RTN","C0CMAIL2",159,0)
+"RTN","C0CMAIL2",156,0)
F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM)
-"RTN","C0CMAIL2",160,0)
+"RTN","C0CMAIL2",157,0)
S LST(NAM,"MSG",D0,"FROM")=$$NAME(XXNM)
-"RTN","C0CMAIL2",161,0)
+"RTN","C0CMAIL2",158,0)
S LST(NAM,"MSG",D0,"SENT")=$$TIME($P(XX,U,3))
-"RTN","C0CMAIL2",162,0)
+"RTN","C0CMAIL2",159,0)
; Get the folks the email is sent to.
-"RTN","C0CMAIL2",163,0)
+"RTN","C0CMAIL2",160,0)
S D1=0
-"RTN","C0CMAIL2",164,0)
+"RTN","C0CMAIL2",161,0)
F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D
-"RTN","C0CMAIL2",165,0)
+"RTN","C0CMAIL2",162,0)
. N T
-"RTN","C0CMAIL2",166,0)
+"RTN","C0CMAIL2",163,0)
. S T=+$G(^XMB(3.9,D0,1,D1,0))
+"RTN","C0CMAIL2",164,0)
+ . S:T T=$P($G(^VA(200,+T,0)),"^")
+"RTN","C0CMAIL2",165,0)
+ . S LST("TO",D1)=T
+"RTN","C0CMAIL2",166,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
-"RTN","C0CMAIL2",169,0)
- . S T=$G(^XMB(3.9,D0,6,D1,0))
-"RTN","C0CMAIL2",170,0)
- . S:T T=$P($G(^VA(200,+T,0)),"^")
-"RTN","C0CMAIL2",171,0)
. S:T="" T=""
-"RTN","C0CMAIL2",172,0)
+"RTN","C0CMAIL2",169,0)
. S LST("TO NAME",D1)=T
-"RTN","C0CMAIL2",173,0)
+"RTN","C0CMAIL2",170,0)
.QUIT
-"RTN","C0CMAIL2",174,0)
+"RTN","C0CMAIL2",171,0)
; Preload first Segment (0) with beginning on Line 1
-"RTN","C0CMAIL2",175,0)
+"RTN","C0CMAIL2",172,0)
; if not a 64bit
-"RTN","C0CMAIL2",176,0)
+"RTN","C0CMAIL2",173,0)
S LST(NAM,"MSG",D0,"SEG",0)=1
-"RTN","C0CMAIL2",177,0)
+"RTN","C0CMAIL2",174,0)
S D1=.9999,SEP="@@"
-"RTN","C0CMAIL2",178,0)
+"RTN","C0CMAIL2",175,0)
F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D
-"RTN","C0CMAIL2",179,0)
+"RTN","C0CMAIL2",176,0)
. ; Clear any control characters (cr/lf/ff) off
-"RTN","C0CMAIL2",180,0)
+"RTN","C0CMAIL2",177,0)
. S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
-"RTN","C0CMAIL2",181,0)
+"RTN","C0CMAIL2",178,0)
. ; Enter once to set the SEP to capture the separator
-"RTN","C0CMAIL2",182,0)
+"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",183,0)
+"RTN","C0CMAIL2",180,0)
. . S SEP=X,END=X_FLG
-"RTN","C0CMAIL2",184,0)
+"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)
- . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
-"RTN","C0CMAIL2",186,0)
- . .QUIT
-"RTN","C0CMAIL2",187,0)
- . ;
-"RTN","C0CMAIL2",188,0)
. ; A new separator is set, process original
-"RTN","C0CMAIL2",189,0)
+"RTN","C0CMAIL2",186,0)
. I X=SEP D QUIT
-"RTN","C0CMAIL2",190,0)
+"RTN","C0CMAIL2",187,0)
. . S LST(NAM,"MSG",D0,SGC,"SIZE")=BCN+$L(BF)
-"RTN","C0CMAIL2",191,0)
+"RTN","C0CMAIL2",188,0)
. . S LST(NAM,"MSG",D0,"SEG",SGC)=$G(LST(NAM,"MSG",D0,"SEG",SGC))_"^"_(D1-1)
-"RTN","C0CMAIL2",192,0)
+"RTN","C0CMAIL2",189,0)
. . S SGC=SGC+1,BCN=0
-"RTN","C0CMAIL2",193,0)
+"RTN","C0CMAIL2",190,0)
. . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
-"RTN","C0CMAIL2",194,0)
+"RTN","C0CMAIL2",191,0)
. .QUIT
-"RTN","C0CMAIL2",195,0)
+"RTN","C0CMAIL2",192,0)
. ;
-"RTN","C0CMAIL2",196,0)
+"RTN","C0CMAIL2",193,0)
. S BCN=BCN+$L(X)
-"RTN","C0CMAIL2",197,0)
+"RTN","C0CMAIL2",194,0)
. I X[CON D Q
-"RTN","C0CMAIL2",198,0)
+"RTN","C0CMAIL2",195,0)
. . S J=$P($P(X,";"),CON,2)
-"RTN","C0CMAIL2",199,0)
+"RTN","C0CMAIL2",196,0)
. . S LST(NAM,"MSG",D0,"SEG",SGC,"CONT",CNT,$P(J,":"))=$P(J,":",2)
-"RTN","C0CMAIL2",200,0)
+"RTN","C0CMAIL2",197,0)
. .QUIT
-"RTN","C0CMAIL2",201,0)
+"RTN","C0CMAIL2",198,0)
. ;
-"RTN","C0CMAIL2",202,0)
+"RTN","C0CMAIL2",199,0)
. ; S LST(NAM,"MSG",D0,"SEG",D1)=X
-"RTN","C0CMAIL2",203,0)
+"RTN","C0CMAIL2",200,0)
.QUIT
-"RTN","C0CMAIL2",204,0)
+"RTN","C0CMAIL2",201,0)
QUIT
-"RTN","C0CMAIL2",205,0)
+"RTN","C0CMAIL2",202,0)
; ===================
-"RTN","C0CMAIL2",206,0)
+"RTN","C0CMAIL2",203,0)
NAME(NM) ; Return the name of the Sender
-"RTN","C0CMAIL2",207,0)
+"RTN","C0CMAIL2",204,0)
N NAME
-"RTN","C0CMAIL2",208,0)
+"RTN","C0CMAIL2",205,0)
S NAME=""
-"RTN","C0CMAIL2",209,0)
+"RTN","C0CMAIL2",206,0)
D
-"RTN","C0CMAIL2",210,0)
+"RTN","C0CMAIL2",207,0)
. ; Look first for a value to use with the NEW PERSON file
-"RTN","C0CMAIL2",211,0)
+"RTN","C0CMAIL2",208,0)
. ;
-"RTN","C0CMAIL2",212,0)
+"RTN","C0CMAIL2",209,0)
. I NM=+NM S NAME=$P(^VA(200,NM,0),U,1) Q
-"RTN","C0CMAIL2",213,0)
+"RTN","C0CMAIL2",210,0)
. ;
-"RTN","C0CMAIL2",214,0)
+"RTN","C0CMAIL2",211,0)
. I $L(NM) S NAME=NM Q
-"RTN","C0CMAIL2",215,0)
+"RTN","C0CMAIL2",212,0)
. ;
-"RTN","C0CMAIL2",216,0)
+"RTN","C0CMAIL2",213,0)
. ; Else, pull the data from the message and display the foreign source
-"RTN","C0CMAIL2",217,0)
+"RTN","C0CMAIL2",214,0)
. ; of the message.
-"RTN","C0CMAIL2",218,0)
+"RTN","C0CMAIL2",215,0)
. N T
-"RTN","C0CMAIL2",219,0)
+"RTN","C0CMAIL2",216,0)
. S VAL=$G(^XMB(3.9,D0,.7))
-"RTN","C0CMAIL2",220,0)
+"RTN","C0CMAIL2",217,0)
. S:VAL T=$P(^VA(200,VAL,0),U)
-"RTN","C0CMAIL2",221,0)
+"RTN","C0CMAIL2",218,0)
. I $L($G(T)) S NAME=T Q
-"RTN","C0CMAIL2",222,0)
+"RTN","C0CMAIL2",219,0)
. ;
-"RTN","C0CMAIL2",223,0)
+"RTN","C0CMAIL2",220,0)
.QUIT
-"RTN","C0CMAIL2",224,0)
+"RTN","C0CMAIL2",221,0)
QUIT NAME
-"RTN","C0CMAIL2",225,0)
+"RTN","C0CMAIL2",222,0)
; ===================
-"RTN","C0CMAIL2",226,0)
+"RTN","C0CMAIL2",223,0)
TIME(Y) ; The time and date of the sending
-"RTN","C0CMAIL2",227,0)
+"RTN","C0CMAIL2",224,0)
X ^DD("DD")
-"RTN","C0CMAIL2",228,0)
+"RTN","C0CMAIL2",225,0)
QUIT Y
-"RTN","C0CMAIL2",229,0)
+"RTN","C0CMAIL2",226,0)
; ===================
-"RTN","C0CMAIL2",230,0)
+"RTN","C0CMAIL2",227,0)
; Segments in Message need to be identified and decoded properly
-"RTN","C0CMAIL2",231,0)
+"RTN","C0CMAIL2",228,0)
; D DETAIL^C0CMAIL(.ARRAY,D0) ; Call One for each message
-"RTN","C0CMAIL2",232,0)
+"RTN","C0CMAIL2",229,0)
; ARRAY will have the details of this one call
-"RTN","C0CMAIL2",233,0)
+"RTN","C0CMAIL2",230,0)
;
-"RTN","C0CMAIL2",234,0)
+"RTN","C0CMAIL2",231,0)
; Inputs;
-"RTN","C0CMAIL2",235,0)
+"RTN","C0CMAIL2",232,0)
; C0CINPUT - The IEN of the message to expand
-"RTN","C0CMAIL2",236,0)
+"RTN","C0CMAIL2",233,0)
; Outputs;
-"RTN","C0CMAIL2",237,0)
+"RTN","C0CMAIL2",234,0)
; C0CDATA - Carrier for the returned structure of the Message
-"RTN","C0CMAIL2",238,0)
+"RTN","C0CMAIL2",235,0)
; C0CDATA(D0,"SEG")=number of SEGMENTS
-"RTN","C0CMAIL2",239,0)
+"RTN","C0CMAIL2",236,0)
; C0CDATA(D0,"SEG",0:n)=SEGMENT n details; First;Last;Type
-"RTN","C0CMAIL2",240,0)
+"RTN","C0CMAIL2",237,0)
; C0CDATA(D0,"SEG",0:n,"CONTENT",type)=Content details
-"RTN","C0CMAIL2",241,0)
+"RTN","C0CMAIL2",238,0)
; C0CDATA(D0,"SEG",0:n,"MSG",D3)=Content details
-"RTN","C0CMAIL2",242,0)
+"RTN","C0CMAIL2",239,0)
; C0CDATA(D0,"SEG",0:n,"HTML",D3)=Content details
-"RTN","C0CMAIL2",243,0)
+"RTN","C0CMAIL2",240,0)
;
-"RTN","C0CMAIL2",244,0)
+"RTN","C0CMAIL2",241,0)
DETAIL(C0CDATA,C0CINPUT) ; Message Detail Delivery
-"RTN","C0CMAIL2",245,0)
+"RTN","C0CMAIL2",242,0)
N LST,D0,D1,U
-"RTN","C0CMAIL2",246,0)
+"RTN","C0CMAIL2",243,0)
S U="^"
-"RTN","C0CMAIL2",247,0)
+"RTN","C0CMAIL2",244,0)
S D0=+$G(C0CINPUT)
-"RTN","C0CMAIL2",248,0)
+"RTN","C0CMAIL2",245,0)
I D0 D QUIT
-"RTN","C0CMAIL2",249,0)
+"RTN","C0CMAIL2",246,0)
. I $D(^XMB(3.9,D0))<10 D ERROR("ER01") QUIT
+"RTN","C0CMAIL2",247,0)
+ . ;
+"RTN","C0CMAIL2",248,0)
+ . D GETTYP2(D0)
+"RTN","C0CMAIL2",249,0)
+ . I $D(LST) M C0CDATA(D0)=LST Q
"RTN","C0CMAIL2",250,0)
. ;
"RTN","C0CMAIL2",251,0)
- . D GETTYP2(D0)
-"RTN","C0CMAIL2",252,0)
- . I $D(LST) M C0CDATA(D0)=LST Q
-"RTN","C0CMAIL2",253,0)
- . ;
-"RTN","C0CMAIL2",254,0)
. D ERROR("ER02")
-"RTN","C0CMAIL2",255,0)
+"RTN","C0CMAIL2",252,0)
.QUIT
-"RTN","C0CMAIL2",256,0)
+"RTN","C0CMAIL2",253,0)
QUIT
-"RTN","C0CMAIL2",257,0)
+"RTN","C0CMAIL2",254,0)
; ===================
-"RTN","C0CMAIL2",258,0)
+"RTN","C0CMAIL2",255,0)
; End note if needed
-"RTN","C0CMAIL2",259,0)
+"RTN","C0CMAIL2",256,0)
; MSK - Set of characters that do not exist in 64 bit encoding
-"RTN","C0CMAIL2",260,0)
+"RTN","C0CMAIL2",257,0)
GETTYP2(D0) ; Try to get the types and MSK for the
-"RTN","C0CMAIL2",261,0)
+"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",262,0)
+"RTN","C0CMAIL2",259,0)
S CON="Content-",U="^"
-"RTN","C0CMAIL2",263,0)
+"RTN","C0CMAIL2",260,0)
S FLG="--"
-"RTN","C0CMAIL2",264,0)
+"RTN","C0CMAIL2",261,0)
S MSK=" !""#$%&'()*,-.:;<>?@[\]^_`{|}~"
-"RTN","C0CMAIL2",265,0)
+"RTN","C0CMAIL2",262,0)
S (BF,SEP)="" ; Start SEP as null, so we can use this to help identify the type
-"RTN","C0CMAIL2",266,0)
+"RTN","C0CMAIL2",263,0)
S (BCN,CNT,D1,END,SGC)=0
-"RTN","C0CMAIL2",267,0)
+"RTN","C0CMAIL2",264,0)
S XX=$G(^XMB(3.9,D0,0))
-"RTN","C0CMAIL2",268,0)
+"RTN","C0CMAIL2",265,0)
; S K=$P(^XMB(3.9,D0,2,0),U,3)
-"RTN","C0CMAIL2",269,0)
+"RTN","C0CMAIL2",266,0)
S LST("TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
-"RTN","C0CMAIL2",270,0)
+"RTN","C0CMAIL2",267,0)
S LST("CREATED")=$$TIME($P(XX,U,3))
-"RTN","C0CMAIL2",271,0)
+"RTN","C0CMAIL2",268,0)
F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM)
-"RTN","C0CMAIL2",272,0)
+"RTN","C0CMAIL2",269,0)
S LST("FROM")=$$NAME(XXNM)
-"RTN","C0CMAIL2",273,0)
+"RTN","C0CMAIL2",270,0)
; Get the folks the email is sent to.
-"RTN","C0CMAIL2",274,0)
+"RTN","C0CMAIL2",271,0)
S D1=0
-"RTN","C0CMAIL2",275,0)
+"RTN","C0CMAIL2",272,0)
F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D Q:D1=""
-"RTN","C0CMAIL2",276,0)
+"RTN","C0CMAIL2",273,0)
. N I,T
-"RTN","C0CMAIL2",277,0)
+"RTN","C0CMAIL2",274,0)
. S T=$P($G(^XMB(3.9,D0,1,D1,0)),U)
-"RTN","C0CMAIL2",278,0)
+"RTN","C0CMAIL2",275,0)
. S:T T=$P($G(^VA(200,T,0)),"^")
-"RTN","C0CMAIL2",279,0)
+"RTN","C0CMAIL2",276,0)
. S LST("TO",+D1)=T
-"RTN","C0CMAIL2",280,0)
+"RTN","C0CMAIL2",277,0)
. S T=$G(^XMB(3.9,D0,6,+D1,0))
-"RTN","C0CMAIL2",281,0)
+"RTN","C0CMAIL2",278,0)
. S:T="" T=$P($G(^VA(200,+T,0)),"^")
-"RTN","C0CMAIL2",282,0)
+"RTN","C0CMAIL2",279,0)
. S:T="" T=""
-"RTN","C0CMAIL2",283,0)
+"RTN","C0CMAIL2",280,0)
. S LST("TO NAME",D1)=T
-"RTN","C0CMAIL2",284,0)
+"RTN","C0CMAIL2",281,0)
.QUIT
-"RTN","C0CMAIL2",285,0)
+"RTN","C0CMAIL2",282,0)
; Get the Header for the message
-"RTN","C0CMAIL2",286,0)
+"RTN","C0CMAIL2",283,0)
S D1=0
-"RTN","C0CMAIL2",287,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",288,0)
+"RTN","C0CMAIL2",285,0)
. S LST("HDR",I)=$G(^XMB(3.9,D0,2,D1,0))
-"RTN","C0CMAIL2",289,0)
+"RTN","C0CMAIL2",286,0)
.QUIT
-"RTN","C0CMAIL2",290,0)
+"RTN","C0CMAIL2",287,0)
; Start walking the different sections
-"RTN","C0CMAIL2",291,0)
+"RTN","C0CMAIL2",288,0)
S D1=.99999,SEP="@@",SGC=0
-"RTN","C0CMAIL2",292,0)
+"RTN","C0CMAIL2",289,0)
F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D
-"RTN","C0CMAIL2",293,0)
+"RTN","C0CMAIL2",290,0)
. ; Clear any control characters (cr/lf/ff) off
-"RTN","C0CMAIL2",294,0)
+"RTN","C0CMAIL2",291,0)
. S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
-"RTN","C0CMAIL2",295,0)
+"RTN","C0CMAIL2",292,0)
. ; Enter once to set the SEP to capture the separator
-"RTN","C0CMAIL2",296,0)
+"RTN","C0CMAIL2",293,0)
. I (SEP="@@")&(X?2."--"5.AN.E) D Q
-"RTN","C0CMAIL2",297,0)
+"RTN","C0CMAIL2",294,0)
. . I $L(X,FLG)>2 D ERROR("ER10")
-"RTN","C0CMAIL2",298,0)
+"RTN","C0CMAIL2",295,0)
. . S SEP=X,END=X_FLG
-"RTN","C0CMAIL2",299,0)
+"RTN","C0CMAIL2",296,0)
. . S (CNT,SGC)=1,BCN=0
-"RTN","C0CMAIL2",300,0)
+"RTN","C0CMAIL2",297,0)
. . S LST("SEG",SGC)=D1
-"RTN","C0CMAIL2",301,0)
+"RTN","C0CMAIL2",298,0)
. .QUIT
-"RTN","C0CMAIL2",302,0)
+"RTN","C0CMAIL2",299,0)
. ;
-"RTN","C0CMAIL2",303,0)
+"RTN","C0CMAIL2",300,0)
. ; A new SEGMENT separator is set, process original
-"RTN","C0CMAIL2",304,0)
+"RTN","C0CMAIL2",301,0)
. I X=SEP D QUIT
-"RTN","C0CMAIL2",305,0)
+"RTN","C0CMAIL2",302,0)
. . ; Save Current Values
-"RTN","C0CMAIL2",306,0)
+"RTN","C0CMAIL2",303,0)
. . S LST("SEG",SGC,"SIZE")=BCN+$L(BF)
-"RTN","C0CMAIL2",307,0)
+"RTN","C0CMAIL2",304,0)
. . ; Close this Segment and prepare to start a New Segment
-"RTN","C0CMAIL2",308,0)
+"RTN","C0CMAIL2",305,0)
. . S $P(LST("SEG",SGC),"^",1,2)=$P($G(LST("SEG",SGC)),"^",1)_"^"_(D1-1)
-"RTN","C0CMAIL2",309,0)
+"RTN","C0CMAIL2",306,0)
. . ; Put the result in LST("SEG",SGC,"XML")
-"RTN","C0CMAIL2",310,0)
+"RTN","C0CMAIL2",307,0)
. . I $L(BF) D
-"RTN","C0CMAIL2",311,0)
+"RTN","C0CMAIL2",308,0)
. . . S ZN=1
-"RTN","C0CMAIL2",312,0)
+"RTN","C0CMAIL2",309,0)
. . . N I,T,TBF
-"RTN","C0CMAIL2",313,0)
+"RTN","C0CMAIL2",310,0)
. . . S TBF=BF
-"RTN","C0CMAIL2",314,0)
+"RTN","C0CMAIL2",311,0)
. . . F I=1:1:($L(TBF,"=")) D
-"RTN","C0CMAIL2",315,0)
+"RTN","C0CMAIL2",312,0)
. . . . S BF=$P(TBF,"=",I)_"="
-"RTN","C0CMAIL2",316,0)
+"RTN","C0CMAIL2",313,0)
. . . . I BF'="=" D DECODER
-"RTN","C0CMAIL2",317,0)
+"RTN","C0CMAIL2",314,0)
. . . .QUIT
-"RTN","C0CMAIL2",318,0)
+"RTN","C0CMAIL2",315,0)
. . . S BF=""
-"RTN","C0CMAIL2",319,0)
+"RTN","C0CMAIL2",316,0)
. . .QUIT
-"RTN","C0CMAIL2",320,0)
+"RTN","C0CMAIL2",317,0)
. . S SGC=SGC+1,BCN=0
-"RTN","C0CMAIL2",321,0)
+"RTN","C0CMAIL2",318,0)
. . ; Incriment SGC to start a new Segment
-"RTN","C0CMAIL2",322,0)
+"RTN","C0CMAIL2",319,0)
. . S LST("SEG",SGC)=D1
-"RTN","C0CMAIL2",323,0)
+"RTN","C0CMAIL2",320,0)
. .QUIT
+"RTN","C0CMAIL2",321,0)
+ . ;
+"RTN","C0CMAIL2",322,0)
+ . ; Accumulate the 64 bit encoding
+"RTN","C0CMAIL2",323,0)
+ . 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
-"RTN","C0CMAIL2",326,0)
- . I X=$TR(X,MSK)&$L(X) S BF=BF_X QUIT
-"RTN","C0CMAIL2",327,0)
- . ;
-"RTN","C0CMAIL2",328,0)
. ; Ending Condition, close out the Segment
-"RTN","C0CMAIL2",329,0)
+"RTN","C0CMAIL2",326,0)
. I X=END D QUIT
-"RTN","C0CMAIL2",330,0)
+"RTN","C0CMAIL2",327,0)
. . S LST("SEG",SGC)=$G(LST("SEG",SGC))_"^"_(D1-1)
-"RTN","C0CMAIL2",331,0)
+"RTN","C0CMAIL2",328,0)
. . I $L(BF) S ZN=1 D DECODER S BF="" Q
-"RTN","C0CMAIL2",332,0)
+"RTN","C0CMAIL2",329,0)
. .QUIT
-"RTN","C0CMAIL2",333,0)
+"RTN","C0CMAIL2",330,0)
. ;
-"RTN","C0CMAIL2",334,0)
+"RTN","C0CMAIL2",331,0)
. ; Accumulate the lengths of other lines of the message
-"RTN","C0CMAIL2",335,0)
+"RTN","C0CMAIL2",332,0)
. S BCN=BCN+$L(X)
-"RTN","C0CMAIL2",336,0)
+"RTN","C0CMAIL2",333,0)
. ; Split out the Content Info
-"RTN","C0CMAIL2",337,0)
+"RTN","C0CMAIL2",334,0)
. I X[CON D Q
-"RTN","C0CMAIL2",338,0)
+"RTN","C0CMAIL2",335,0)
. . S J=$P(X,CON,2)
-"RTN","C0CMAIL2",339,0)
+"RTN","C0CMAIL2",336,0)
. . I J[" boundary=" D
-"RTN","C0CMAIL2",340,0)
+"RTN","C0CMAIL2",337,0)
. . . S SEP=$P($P(J," boundary=",2),"""",2),END=SEP_FLG
-"RTN","C0CMAIL2",341,0)
+"RTN","C0CMAIL2",338,0)
. . . Q:SEP?2"-"5.ANP
+"RTN","C0CMAIL2",339,0)
+ . . . ;
+"RTN","C0CMAIL2",340,0)
+ . . . D ERROR("ER11")
+"RTN","C0CMAIL2",341,0)
+ . . . Q:SEP'[" "
"RTN","C0CMAIL2",342,0)
. . . ;
"RTN","C0CMAIL2",343,0)
- . . . D ERROR("ER11")
-"RTN","C0CMAIL2",344,0)
- . . . Q:SEP'[" "
-"RTN","C0CMAIL2",345,0)
- . . . ;
-"RTN","C0CMAIL2",346,0)
. . . D ERROR("ER12")
-"RTN","C0CMAIL2",347,0)
+"RTN","C0CMAIL2",344,0)
. . .QUIT
-"RTN","C0CMAIL2",348,0)
+"RTN","C0CMAIL2",345,0)
. . S LST("SEG",SGC,"CONTENT",$P(J,":"))=$P(J,":",2,9)
-"RTN","C0CMAIL2",349,0)
+"RTN","C0CMAIL2",346,0)
. .QUIT
-"RTN","C0CMAIL2",350,0)
+"RTN","C0CMAIL2",347,0)
. ;
-"RTN","C0CMAIL2",351,0)
+"RTN","C0CMAIL2",348,0)
. ; Everything else is Text, Check for CCR/CCD.
-"RTN","C0CMAIL2",352,0)
+"RTN","C0CMAIL2",349,0)
. N KK,UBF
-"RTN","C0CMAIL2",353,0)
+"RTN","C0CMAIL2",350,0)
. D
-"RTN","C0CMAIL2",354,0)
+"RTN","C0CMAIL2",351,0)
. . S UBF=$$UPPER(X)
-"RTN","C0CMAIL2",355,0)
+"RTN","C0CMAIL2",352,0)
. . I UBF["126 OKCNT=OKCNT+1 I OKCNT>100 S OK=0 Q
-"RTN","C0CMAIL2",391,0)
+"RTN","C0CMAIL2",388,0)
. . ;
-"RTN","C0CMAIL2",392,0)
+"RTN","C0CMAIL2",389,0)
. . D
-"RTN","C0CMAIL2",393,0)
+"RTN","C0CMAIL2",390,0)
. . . I 'OK S (BF,UBF,TBF,XBF)="" Q
-"RTN","C0CMAIL2",394,0)
+"RTN","C0CMAIL2",391,0)
. . . ;
-"RTN","C0CMAIL2",395,0)
+"RTN","C0CMAIL2",392,0)
. . . S BF=BF_"="
-"RTN","C0CMAIL2",396,0)
+"RTN","C0CMAIL2",393,0)
. . . D NORMAL(.XBF,.TBF)
-"RTN","C0CMAIL2",397,0)
+"RTN","C0CMAIL2",394,0)
. . .QUIT
-"RTN","C0CMAIL2",398,0)
+"RTN","C0CMAIL2",395,0)
. . M LST("SEG",SGC,"XML",RCNT)=XBF
+"RTN","C0CMAIL2",396,0)
+ . .QUIT
+"RTN","C0CMAIL2",397,0)
+ .QUIT
+"RTN","C0CMAIL2",398,0)
+ QUIT
"RTN","C0CMAIL2",399,0)
- . .QUIT
-"RTN","C0CMAIL2",400,0)
- .QUIT
-"RTN","C0CMAIL2",401,0)
- QUIT
-"RTN","C0CMAIL2",402,0)
; ===================
-"RTN","C0CMAIL2",403,0)
+"RTN","C0CMAIL2",400,0)
; OUTXML = OUTBF = OUT = OUTPUT ARRAY TO BE BUILT
-"RTN","C0CMAIL2",404,0)
+"RTN","C0CMAIL2",401,0)
; BF = INXML = INPUT ARRAY TO PROVIDE INPUT
-"RTN","C0CMAIL2",405,0)
+"RTN","C0CMAIL2",402,0)
; >D NORMAL^C0CMAIL(.OUT,BF)
-"RTN","C0CMAIL2",406,0)
+"RTN","C0CMAIL2",403,0)
NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
-"RTN","C0CMAIL2",407,0)
+"RTN","C0CMAIL2",404,0)
; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
-"RTN","C0CMAIL2",408,0)
+"RTN","C0CMAIL2",405,0)
;
-"RTN","C0CMAIL2",409,0)
+"RTN","C0CMAIL2",406,0)
N ZN,OUTBF,XX,ZSEP
-"RTN","C0CMAIL2",410,0)
+"RTN","C0CMAIL2",407,0)
S INXML=$TR(INXML,$C(10,12,13))
-"RTN","C0CMAIL2",411,0)
+"RTN","C0CMAIL2",408,0)
S ZN=1,ZSEP=">"
-"RTN","C0CMAIL2",412,0)
+"RTN","C0CMAIL2",409,0)
S OUTBF(1)=$P(INXML,"><",1)_ZSEP,XX="<"_$P(INXML,"><",2)_ZSEP,ZN=2,ZL=1
-"RTN","C0CMAIL2",413,0)
+"RTN","C0CMAIL2",410,0)
F ZN=ZN+1:1:$L(INXML,"><") D Q:XX=""
-"RTN","C0CMAIL2",414,0)
+"RTN","C0CMAIL2",411,0)
. S XX=$P(INXML,"><",ZN)
-"RTN","C0CMAIL2",415,0)
+"RTN","C0CMAIL2",412,0)
. S:$E($RE(XX))=">" ZSEP=""
-"RTN","C0CMAIL2",416,0)
+"RTN","C0CMAIL2",413,0)
. Q:XX=""
-"RTN","C0CMAIL2",417,0)
+"RTN","C0CMAIL2",414,0)
. ;
-"RTN","C0CMAIL2",418,0)
+"RTN","C0CMAIL2",415,0)
. S XX="<"_XX_ZSEP
-"RTN","C0CMAIL2",419,0)
+"RTN","C0CMAIL2",416,0)
. D
-"RTN","C0CMAIL2",420,0)
+"RTN","C0CMAIL2",417,0)
. . I $L(XX)<4000 S OUTBF(ZL)=XX,XX=$P(INXML,"><",ZN),ZL=ZL+1 Q
-"RTN","C0CMAIL2",421,0)
+"RTN","C0CMAIL2",418,0)
. . ;
-"RTN","C0CMAIL2",422,0)
+"RTN","C0CMAIL2",419,0)
. . D ERROR("ER05")
-"RTN","C0CMAIL2",423,0)
+"RTN","C0CMAIL2",420,0)
. . F ZL=ZL+1:1 D Q:XX=""
-"RTN","C0CMAIL2",424,0)
+"RTN","C0CMAIL2",421,0)
. . . N XL
-"RTN","C0CMAIL2",425,0)
+"RTN","C0CMAIL2",422,0)
. . . S XL=$E(XX,1,4000)
-"RTN","C0CMAIL2",426,0)
+"RTN","C0CMAIL2",423,0)
. . . S $E(XX,1,4000)="" ; S XX=$E(XX,4001,999999) ; Remove 4K characters
-"RTN","C0CMAIL2",427,0)
+"RTN","C0CMAIL2",424,0)
. . . S OUTBF(ZL)=XL
-"RTN","C0CMAIL2",428,0)
+"RTN","C0CMAIL2",425,0)
. . .QUIT
-"RTN","C0CMAIL2",429,0)
+"RTN","C0CMAIL2",426,0)
. .QUIT
-"RTN","C0CMAIL2",430,0)
+"RTN","C0CMAIL2",427,0)
.QUIT
-"RTN","C0CMAIL2",431,0)
+"RTN","C0CMAIL2",428,0)
M OUTXML=OUTBF
-"RTN","C0CMAIL2",432,0)
+"RTN","C0CMAIL2",429,0)
QUIT
+"RTN","C0CMAIL2",430,0)
+ ; ===================
+"RTN","C0CMAIL2",431,0)
+UPPER(X) ; Convert any lowercase letters to Uppercase letters
+"RTN","C0CMAIL2",432,0)
+ QUIT $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
"RTN","C0CMAIL2",433,0)
; ===================
"RTN","C0CMAIL2",434,0)
-UPPER(X) ; Convert any lowercase letters to Uppercase letters
-"RTN","C0CMAIL2",435,0)
- QUIT $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
-"RTN","C0CMAIL2",436,0)
- ; ===================
-"RTN","C0CMAIL2",437,0)
; EN is a counter that remains between error events
-"RTN","C0CMAIL2",438,0)
+"RTN","C0CMAIL2",435,0)
ERROR(ER) ; Error Handler
-"RTN","C0CMAIL2",439,0)
+"RTN","C0CMAIL2",436,0)
N TXXQ,XXXQ
-"RTN","C0CMAIL2",440,0)
+"RTN","C0CMAIL2",437,0)
S XXXQ="Unknown Error Encountered = "_ER
-"RTN","C0CMAIL2",441,0)
+"RTN","C0CMAIL2",438,0)
S TXXQ=$P($T(@(ER_"^"_$T(+0))),";;",2,99)
-"RTN","C0CMAIL2",442,0)
+"RTN","C0CMAIL2",439,0)
I TXXQ'="" D
-"RTN","C0CMAIL2",443,0)
+"RTN","C0CMAIL2",440,0)
. I TXXQ["_" X "S TXXQ="_TXXQ
-"RTN","C0CMAIL2",444,0)
+"RTN","C0CMAIL2",441,0)
. S XXXQ=TXXQ
-"RTN","C0CMAIL2",445,0)
+"RTN","C0CMAIL2",442,0)
.QUIT
-"RTN","C0CMAIL2",446,0)
+"RTN","C0CMAIL2",443,0)
S EN(ER)=$G(EN(ER))+1
-"RTN","C0CMAIL2",447,0)
+"RTN","C0CMAIL2",444,0)
S LST("ERR",ER,EN(ER))=XXXQ
-"RTN","C0CMAIL2",448,0)
+"RTN","C0CMAIL2",445,0)
QUIT
-"RTN","C0CMAIL2",449,0)
+"RTN","C0CMAIL2",446,0)
; ===================
-"RTN","C0CMAIL2",450,0)
+"RTN","C0CMAIL2",447,0)
ER01 ;;Message Missing
-"RTN","C0CMAIL2",451,0)
+"RTN","C0CMAIL2",448,0)
ER02 ;;Message Text Missing
-"RTN","C0CMAIL2",452,0)
+"RTN","C0CMAIL2",449,0)
ER03 ;;Message Not Identifiable
-"RTN","C0CMAIL2",453,0)
+"RTN","C0CMAIL2",450,0)
ER04 ;;Segment is too large
-"RTN","C0CMAIL2",454,0)
+"RTN","C0CMAIL2",451,0)
ER05 ;;Mailbox Missing
-"RTN","C0CMAIL2",455,0)
+"RTN","C0CMAIL2",452,0)
ER06 ;;"User Missing = "_$G(DUZ)
-"RTN","C0CMAIL2",456,0)
+"RTN","C0CMAIL2",453,0)
ER07 ;;"Bad DUZ = "_DUZ
-"RTN","C0CMAIL2",457,0)
+"RTN","C0CMAIL2",454,0)
ER08 ;;"Bad Basket ID = "_MBLST_" >> "_$G(TN)
-"RTN","C0CMAIL2",458,0)
+"RTN","C0CMAIL2",455,0)
ER10 ;;"Bad Separator found = "_X
-"RTN","C0CMAIL2",459,0)
+"RTN","C0CMAIL2",456,0)
ER11 ;;"Non-Standard Separator Found:>"_$G(J)
-"RTN","C0CMAIL2",460,0)
+"RTN","C0CMAIL2",457,0)
ER12 ;;"Spaces are not allowed in Separators:>"_$G(J)
-"RTN","C0CMAIL2",461,0)
+"RTN","C0CMAIL2",458,0)
; vvvvvvvvvvvvvvv Not Needed vvvvvvvvvvvvvvvvvvvvvvvvvv
-"RTN","C0CMAIL2",462,0)
+"RTN","C0CMAIL2",459,0)
; End note if needed
-"RTN","C0CMAIL2",463,0)
+"RTN","C0CMAIL2",460,0)
QUIT
-"RTN","C0CMAIL2",464,0)
+"RTN","C0CMAIL2",461,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
"RTN","C0CMAIL3",4,0)
@@ -104985,9713 +105009,9695 @@ C0CMAIL3 ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr
"RTN","C0CMAIL3",5,0)
; 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 .
"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.
-"RTN","C0CMAIL3",22,0)
- ;
-"RTN","C0CMAIL3",23,0)
; ------------------
-"RTN","C0CMAIL3",24,0)
+"RTN","C0CMAIL3",21,0)
;Entry Points
-"RTN","C0CMAIL3",25,0)
+"RTN","C0CMAIL3",22,0)
; DETAIL^C0CMAIL(.C0CDATA,IEN) --> Get details of the Mail Message and Attachments
-"RTN","C0CMAIL3",26,0)
+"RTN","C0CMAIL3",23,0)
; GETMSG^C0CMAIL(.C0CDATA,.C0CINPUT)
-"RTN","C0CMAIL3",27,0)
+"RTN","C0CMAIL3",24,0)
; Input:
-"RTN","C0CMAIL3",28,0)
+"RTN","C0CMAIL3",25,0)
; C0CINPUT = "DUZ;MAILBOX_Name[or IEN for box (comma Separated);MALL
-"RTN","C0CMAIL3",29,0)
+"RTN","C0CMAIL3",26,0)
; or "*" for all boxes, default is "IN" if missing]"
-"RTN","C0CMAIL3",30,0)
+"RTN","C0CMAIL3",27,0)
; $P(C0CINPUT,";",3)=MALL, default=NUL means "New only",
-"RTN","C0CMAIL3",31,0)
+"RTN","C0CMAIL3",28,0)
; "*" for All or 9,999 maximum
-"RTN","C0CMAIL3",32,0)
+"RTN","C0CMAIL3",29,0)
; MALL?1.n = that number of the n most recent
-"RTN","C0CMAIL3",33,0)
+"RTN","C0CMAIL3",30,0)
; Internally:
-"RTN","C0CMAIL3",34,0)
+"RTN","C0CMAIL3",31,0)
; BNAM = Box Name
-"RTN","C0CMAIL3",35,0)
+"RTN","C0CMAIL3",32,0)
; Output:
-"RTN","C0CMAIL3",36,0)
+"RTN","C0CMAIL3",33,0)
; C0CDATA
-"RTN","C0CMAIL3",37,0)
+"RTN","C0CMAIL3",34,0)
; = (BNAM,"NUMBER") = Number of NEW Emails in Basket
-"RTN","C0CMAIL3",38,0)
+"RTN","C0CMAIL3",35,0)
; (BNAM,"MSG",C0CIEN,"FROM")=Name
-"RTN","C0CMAIL3",39,0)
+"RTN","C0CMAIL3",36,0)
; (BNAM,"MSG",C0CIEN,"TO",n)=DUZ, or EMAIL Address
-"RTN","C0CMAIL3",40,0)
+"RTN","C0CMAIL3",37,0)
; (BNAM,"MSG",C0CIEN,"TO NAME",n)=Names or EMAIL Address
-"RTN","C0CMAIL3",41,0)
+"RTN","C0CMAIL3",38,0)
; (BNAM,"MSG",C0CIEN,"TITLE")=EMAIL Title
-"RTN","C0CMAIL3",42,0)
+"RTN","C0CMAIL3",39,0)
; (BNAM,"MSG",C0CIEN[for File 3.9])=Number of Attachments
-"RTN","C0CMAIL3",43,0)
+"RTN","C0CMAIL3",40,0)
; (BNAM,"MSG",C0CIEN,num,"CONT") = Free Text
-"RTN","C0CMAIL3",44,0)
+"RTN","C0CMAIL3",41,0)
; (BNAM,"MSG",C0CIEN,num,"LINES") = Number of Lines of Text
-"RTN","C0CMAIL3",45,0)
+"RTN","C0CMAIL3",42,0)
; (BNAM,"MSG",C0CIEN,num,"SIZE") = Size of the Message in Bytes
-"RTN","C0CMAIL3",46,0)
+"RTN","C0CMAIL3",43,0)
; (BNAM,"MSG",C0CIEN,num,"TXT",LINE#) = Message Data (No Attachment)
-"RTN","C0CMAIL3",47,0)
+"RTN","C0CMAIL3",44,0)
; (BNAM,"MSG",C0CIEN,"SEG",NUM) = First Line^Last Line
-"RTN","C0CMAIL3",48,0)
+"RTN","C0CMAIL3",45,0)
; (BNAM,"MSG",C0CIEN,"SEG",NUM,"CONT",type) = Message Details
-"RTN","C0CMAIL3",49,0)
+"RTN","C0CMAIL3",46,0)
; (BNAM,"MSG",C0CIEN,"SEG",NUM,LINE#) = Message Data
-"RTN","C0CMAIL3",50,0)
+"RTN","C0CMAIL3",47,0)
;
-"RTN","C0CMAIL3",51,0)
+"RTN","C0CMAIL3",48,0)
; DO DETAIL^C0CMAIL(.OUTBF,D0) ; For each Email Message and Attachments
-"RTN","C0CMAIL3",52,0)
+"RTN","C0CMAIL3",49,0)
; Input;
-"RTN","C0CMAIL3",53,0)
+"RTN","C0CMAIL3",50,0)
; D0 - The IEN for the message in file 3.9, MESSAGE global
-"RTN","C0CMAIL3",54,0)
+"RTN","C0CMAIL3",51,0)
; Output
-"RTN","C0CMAIL3",55,0)
+"RTN","C0CMAIL3",52,0)
; OUTBF - The array of your choice to save the expanded and decoded message.
-"RTN","C0CMAIL3",56,0)
+"RTN","C0CMAIL3",53,0)
;
-"RTN","C0CMAIL3",57,0)
+"RTN","C0CMAIL3",54,0)
GETMSG(C0CDATA,C0CINPUT) ; Common Entry Point for Mailbox Data
-"RTN","C0CMAIL3",58,0)
+"RTN","C0CMAIL3",55,0)
K:'$G(C0CDATA("KEEP")) C0CDATA
-"RTN","C0CMAIL3",59,0)
+"RTN","C0CMAIL3",56,0)
N U
-"RTN","C0CMAIL3",60,0)
+"RTN","C0CMAIL3",57,0)
S U="^"
-"RTN","C0CMAIL3",61,0)
+"RTN","C0CMAIL3",58,0)
D:$G(C0CINPUT)
-"RTN","C0CMAIL3",62,0)
+"RTN","C0CMAIL3",59,0)
. N BF,DUZ,I,INPUT,J,L,LST,MBLST,MALL
-"RTN","C0CMAIL3",63,0)
+"RTN","C0CMAIL3",60,0)
. S INPUT=C0CINPUT
-"RTN","C0CMAIL3",64,0)
+"RTN","C0CMAIL3",61,0)
. S DUZ=+INPUT
-"RTN","C0CMAIL3",65,0)
+"RTN","C0CMAIL3",62,0)
. I $D(^VA(200,DUZ))=0!('$D(^VA(200,DUZ,0))) D ERROR("ER06") Q
-"RTN","C0CMAIL3",66,0)
+"RTN","C0CMAIL3",63,0)
. ;
-"RTN","C0CMAIL3",67,0)
+"RTN","C0CMAIL3",64,0)
. D:$D(^XMB(3.7,DUZ,0))#2
-"RTN","C0CMAIL3",68,0)
+"RTN","C0CMAIL3",65,0)
. . S MBLST=$P(INPUT,";",2)
-"RTN","C0CMAIL3",69,0)
+"RTN","C0CMAIL3",66,0)
. . S MALL=$P(INPUT,";",3) ; New or All Mail Flag
-"RTN","C0CMAIL3",70,0)
+"RTN","C0CMAIL3",67,0)
. . S:MALL["*" MALL=99999
-"RTN","C0CMAIL3",71,0)
+"RTN","C0CMAIL3",68,0)
. . ; Only one of these can be correct
-"RTN","C0CMAIL3",72,0)
+"RTN","C0CMAIL3",69,0)
. . D
-"RTN","C0CMAIL3",73,0)
+"RTN","C0CMAIL3",70,0)
. . . ; If nul, make it "IN" only
-"RTN","C0CMAIL3",74,0)
+"RTN","C0CMAIL3",71,0)
. . . I MBLST="" D QUIT
-"RTN","C0CMAIL3",75,0)
+"RTN","C0CMAIL3",72,0)
. . . . S MBLST("IN")=0,I=0
-"RTN","C0CMAIL3",76,0)
+"RTN","C0CMAIL3",73,0)
. . . . D GATHER(DUZ,"IN",.LST)
-"RTN","C0CMAIL3",77,0)
+"RTN","C0CMAIL3",74,0)
. . . .QUIT
-"RTN","C0CMAIL3",78,0)
+"RTN","C0CMAIL3",75,0)
. . . ;
-"RTN","C0CMAIL3",79,0)
+"RTN","C0CMAIL3",76,0)
. . . ; If "*", Get all Mailboxes and look for New Messages
-"RTN","C0CMAIL3",80,0)
+"RTN","C0CMAIL3",77,0)
. . . I MBLST["*" D QUIT
-"RTN","C0CMAIL3",81,0)
+"RTN","C0CMAIL3",78,0)
. . . . N NAM,NUM
-"RTN","C0CMAIL3",82,0)
+"RTN","C0CMAIL3",79,0)
. . . . S NUM=0
-"RTN","C0CMAIL3",83,0)
+"RTN","C0CMAIL3",80,0)
. . . . F S NUM=$O(^XMB(3.7,DUZ,2,NUM)) Q:'NUM D
-"RTN","C0CMAIL3",84,0)
+"RTN","C0CMAIL3",81,0)
. . . . . S NAM=$P(^XMB(3.7,DUZ,2,NUM,0),U)
-"RTN","C0CMAIL3",85,0)
+"RTN","C0CMAIL3",82,0)
. . . . . D GATHER(DUZ,NAM,.LST)
+"RTN","C0CMAIL3",83,0)
+ . . . . .QUIT
+"RTN","C0CMAIL3",84,0)
+ . . . .QUIT
+"RTN","C0CMAIL3",85,0)
+ . . . ;
"RTN","C0CMAIL3",86,0)
- . . . . .QUIT
-"RTN","C0CMAIL3",87,0)
- . . . .QUIT
-"RTN","C0CMAIL3",88,0)
- . . . ;
-"RTN","C0CMAIL3",89,0)
. . . ; If comma separated, look for mailboxes with new messages
-"RTN","C0CMAIL3",90,0)
+"RTN","C0CMAIL3",87,0)
. . . I $L(MBLST,",")>1 D QUIT
-"RTN","C0CMAIL3",91,0)
+"RTN","C0CMAIL3",88,0)
. . . . S NAM=""
-"RTN","C0CMAIL3",92,0)
+"RTN","C0CMAIL3",89,0)
. . . . N TN,V
-"RTN","C0CMAIL3",93,0)
+"RTN","C0CMAIL3",90,0)
. . . . F TN=1:1:$L(MBLST,",") S V=$P(MBLST,",",TN) D
-"RTN","C0CMAIL3",94,0)
+"RTN","C0CMAIL3",91,0)
. . . . . I $L(V) D QUIT
-"RTN","C0CMAIL3",95,0)
+"RTN","C0CMAIL3",92,0)
. . . . . . I V S NAM=$P($G(^XMB(3.7,DUZ,2,V,0)),U)
-"RTN","C0CMAIL3",96,0)
+"RTN","C0CMAIL3",93,0)
. . . . . . S:NAM="" NAM=V
-"RTN","C0CMAIL3",97,0)
+"RTN","C0CMAIL3",94,0)
. . . . . . D GATHER(DUZ,NAM,.LST)
-"RTN","C0CMAIL3",98,0)
+"RTN","C0CMAIL3",95,0)
. . . . . .QUIT
-"RTN","C0CMAIL3",99,0)
+"RTN","C0CMAIL3",96,0)
. . . . . ;
-"RTN","C0CMAIL3",100,0)
+"RTN","C0CMAIL3",97,0)
. . . . . D ERROR("ER08")
-"RTN","C0CMAIL3",101,0)
+"RTN","C0CMAIL3",98,0)
. . . . .QUIT
-"RTN","C0CMAIL3",102,0)
+"RTN","C0CMAIL3",99,0)
. . . .QUIT
-"RTN","C0CMAIL3",103,0)
+"RTN","C0CMAIL3",100,0)
. . . ;
-"RTN","C0CMAIL3",104,0)
+"RTN","C0CMAIL3",101,0)
. . . ; If only 1 mailbox named, go get it
-"RTN","C0CMAIL3",105,0)
+"RTN","C0CMAIL3",102,0)
. . . I $L(MBLST) D QUIT
-"RTN","C0CMAIL3",106,0)
+"RTN","C0CMAIL3",103,0)
. . . . I $D(^XMB(3.7,DUZ,2,"B",MBLST)) D GATHER(DUZ,MBLST,.LST) QUIT
-"RTN","C0CMAIL3",107,0)
+"RTN","C0CMAIL3",104,0)
. . . . ;
-"RTN","C0CMAIL3",108,0)
+"RTN","C0CMAIL3",105,0)
. . . . D ERROR("ER07")
-"RTN","C0CMAIL3",109,0)
+"RTN","C0CMAIL3",106,0)
. . .QUIT
-"RTN","C0CMAIL3",110,0)
+"RTN","C0CMAIL3",107,0)
. . MERGE C0CDATA=LST
+"RTN","C0CMAIL3",108,0)
+ . .QUIT
+"RTN","C0CMAIL3",109,0)
+ .QUIT
+"RTN","C0CMAIL3",110,0)
+ QUIT
"RTN","C0CMAIL3",111,0)
- . .QUIT
+ ; ===================
"RTN","C0CMAIL3",112,0)
- .QUIT
-"RTN","C0CMAIL3",113,0)
- QUIT
-"RTN","C0CMAIL3",114,0)
- ; ===================
-"RTN","C0CMAIL3",115,0)
GATHER(DUZ,NAM,LST) ; Gather Data about the Baskets and their mail
-"RTN","C0CMAIL3",116,0)
+"RTN","C0CMAIL3",113,0)
N I,J,K,L
-"RTN","C0CMAIL3",117,0)
+"RTN","C0CMAIL3",114,0)
S (I,K)=0
-"RTN","C0CMAIL3",118,0)
+"RTN","C0CMAIL3",115,0)
S J=$O(^XMB(3.7,DUZ,2,"B",NAM,""))
-"RTN","C0CMAIL3",119,0)
+"RTN","C0CMAIL3",116,0)
F S I=$O(^XMB(3.7,DUZ,2,J,1,I)) Q:'I D
-"RTN","C0CMAIL3",120,0)
+"RTN","C0CMAIL3",117,0)
. S L=$P(^XMB(3.7,DUZ,2,J,1,I,0),U,3)
-"RTN","C0CMAIL3",121,0)
+"RTN","C0CMAIL3",118,0)
. D ; :L
-"RTN","C0CMAIL3",122,0)
+"RTN","C0CMAIL3",119,0)
. . S:L K=K+1,LST(NAM,"MSG",I,"NEW")="" ; Flag NEW emails
-"RTN","C0CMAIL3",123,0)
+"RTN","C0CMAIL3",120,0)
. . S LST(NAM,"MSG",I)=L
-"RTN","C0CMAIL3",124,0)
+"RTN","C0CMAIL3",121,0)
. . D GETTYP(I)
-"RTN","C0CMAIL3",125,0)
+"RTN","C0CMAIL3",122,0)
. .QUIT
-"RTN","C0CMAIL3",126,0)
+"RTN","C0CMAIL3",123,0)
.QUIT
-"RTN","C0CMAIL3",127,0)
+"RTN","C0CMAIL3",124,0)
S LST(NAM,"NUMBER")=K
-"RTN","C0CMAIL3",128,0)
+"RTN","C0CMAIL3",125,0)
QUIT
-"RTN","C0CMAIL3",129,0)
+"RTN","C0CMAIL3",126,0)
; ===================
-"RTN","C0CMAIL3",130,0)
+"RTN","C0CMAIL3",127,0)
; D0 is the IEN into the Message Global ^XMB(3.9,D0)
-"RTN","C0CMAIL3",131,0)
+"RTN","C0CMAIL3",128,0)
; The products of these emails are scanned to identify
-"RTN","C0CMAIL3",132,0)
+"RTN","C0CMAIL3",129,0)
; the number of documents stored in the MIME package.
-"RTN","C0CMAIL3",133,0)
+"RTN","C0CMAIL3",130,0)
; The protocol runs like this;
-"RTN","C0CMAIL3",134,0)
+"RTN","C0CMAIL3",131,0)
; Line 1 is the --separator
-"RTN","C0CMAIL3",135,0)
+"RTN","C0CMAIL3",132,0)
; Line 2 thru n >Look for Content-[detail type:]Description ; Next CMD
-"RTN","C0CMAIL3",136,0)
+"RTN","C0CMAIL3",133,0)
; Line n+2 thru t-1 where t does NOT have "Content-"
-"RTN","C0CMAIL3",137,0)
+"RTN","C0CMAIL3",134,0)
; Line t is Next Section Terminator, or Message Terminator, --separator
-"RTN","C0CMAIL3",138,0)
+"RTN","C0CMAIL3",135,0)
; Line t+1 should not exist in the data set if Message Terminator
-"RTN","C0CMAIL3",139,0)
+"RTN","C0CMAIL3",136,0)
; CON = "Content-"
-"RTN","C0CMAIL3",140,0)
+"RTN","C0CMAIL3",137,0)
; FLG = "--"
-"RTN","C0CMAIL3",141,0)
+"RTN","C0CMAIL3",138,0)
; SEP = FLG+7 or more characters ; Separator
-"RTN","C0CMAIL3",142,0)
+"RTN","C0CMAIL3",139,0)
; END = SEP+FLG
-"RTN","C0CMAIL3",143,0)
+"RTN","C0CMAIL3",140,0)
; SGC = Segment Count
-"RTN","C0CMAIL3",144,0)
+"RTN","C0CMAIL3",141,0)
; Note: separator is a string of specific characters of
-"RTN","C0CMAIL3",145,0)
+"RTN","C0CMAIL3",142,0)
; indeterminate length
-"RTN","C0CMAIL3",146,0)
+"RTN","C0CMAIL3",143,0)
; LST() the transfer array
-"RTN","C0CMAIL3",147,0)
+"RTN","C0CMAIL3",144,0)
; LST(NAM,"MSG",C0CIEN,"SEG",SGN)=Starting Line^Ending Line
-"RTN","C0CMAIL3",148,0)
+"RTN","C0CMAIL3",145,0)
; LST(NAM,"MSG",C0CIEN,"SEG",SGN,1:n)=Decoded Message Data
-"RTN","C0CMAIL3",149,0)
+"RTN","C0CMAIL3",146,0)
;
-"RTN","C0CMAIL3",150,0)
+"RTN","C0CMAIL3",147,0)
GETTYP(D0) ; Look for the goodies in the Mail
-"RTN","C0CMAIL3",151,0)
+"RTN","C0CMAIL3",148,0)
N I,J,N,BCN,CON,CNT,D1,END,FLG,SEP,SGC,XX,XXNM
-"RTN","C0CMAIL3",152,0)
+"RTN","C0CMAIL3",149,0)
S CON="Content-"
-"RTN","C0CMAIL3",153,0)
+"RTN","C0CMAIL3",150,0)
S FLG="--"
-"RTN","C0CMAIL3",154,0)
+"RTN","C0CMAIL3",151,0)
S SEP="" ; Start SEP as null, so we can use this to help identify the type
-"RTN","C0CMAIL3",155,0)
+"RTN","C0CMAIL3",152,0)
S (BCN,CNT,D1,END,SGC)=0
-"RTN","C0CMAIL3",156,0)
+"RTN","C0CMAIL3",153,0)
S XX=$G(^XMB(3.9,D0,0))
-"RTN","C0CMAIL3",157,0)
+"RTN","C0CMAIL3",154,0)
S LST(NAM,"MSG",D0,"TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
-"RTN","C0CMAIL3",158,0)
+"RTN","C0CMAIL3",155,0)
S LST(NAM,"MSG",D0,"CREATED")=$G(^XMB(3.9,D0,.6))
-"RTN","C0CMAIL3",159,0)
+"RTN","C0CMAIL3",156,0)
F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM)
-"RTN","C0CMAIL3",160,0)
+"RTN","C0CMAIL3",157,0)
S LST(NAM,"MSG",D0,"FROM")=$$NAME(XXNM)
-"RTN","C0CMAIL3",161,0)
+"RTN","C0CMAIL3",158,0)
S LST(NAM,"MSG",D0,"SENT")=$$TIME($P(XX,U,3))
-"RTN","C0CMAIL3",162,0)
+"RTN","C0CMAIL3",159,0)
; Get the folks the email is sent to.
-"RTN","C0CMAIL3",163,0)
+"RTN","C0CMAIL3",160,0)
S D1=0
-"RTN","C0CMAIL3",164,0)
+"RTN","C0CMAIL3",161,0)
F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D
-"RTN","C0CMAIL3",165,0)
+"RTN","C0CMAIL3",162,0)
. N T
-"RTN","C0CMAIL3",166,0)
+"RTN","C0CMAIL3",163,0)
. S T=+$G(^XMB(3.9,D0,1,D1,0))
+"RTN","C0CMAIL3",164,0)
+ . S:T T=$P($G(^VA(200,+T,0)),"^")
+"RTN","C0CMAIL3",165,0)
+ . S LST("TO",D1)=T
+"RTN","C0CMAIL3",166,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
-"RTN","C0CMAIL3",169,0)
- . S T=$G(^XMB(3.9,D0,6,D1,0))
-"RTN","C0CMAIL3",170,0)
- . S:T T=$P($G(^VA(200,+T,0)),"^")
-"RTN","C0CMAIL3",171,0)
. S:T="" T=""
-"RTN","C0CMAIL3",172,0)
+"RTN","C0CMAIL3",169,0)
. S LST("TO NAME",D1)=T
-"RTN","C0CMAIL3",173,0)
+"RTN","C0CMAIL3",170,0)
.QUIT
-"RTN","C0CMAIL3",174,0)
+"RTN","C0CMAIL3",171,0)
; Preload first Segment (0) with beginning on Line 1
-"RTN","C0CMAIL3",175,0)
+"RTN","C0CMAIL3",172,0)
; if not a 64bit
-"RTN","C0CMAIL3",176,0)
+"RTN","C0CMAIL3",173,0)
S LST(NAM,"MSG",D0,"SEG",0)=1
-"RTN","C0CMAIL3",177,0)
+"RTN","C0CMAIL3",174,0)
S D1=.9999,SEP="@@"
-"RTN","C0CMAIL3",178,0)
+"RTN","C0CMAIL3",175,0)
F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D
-"RTN","C0CMAIL3",179,0)
+"RTN","C0CMAIL3",176,0)
. ; Clear any control characters (cr/lf/ff) off
-"RTN","C0CMAIL3",180,0)
+"RTN","C0CMAIL3",177,0)
. S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
-"RTN","C0CMAIL3",181,0)
+"RTN","C0CMAIL3",178,0)
. ; Enter once to set the SEP to capture the separator
-"RTN","C0CMAIL3",182,0)
+"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",183,0)
+"RTN","C0CMAIL3",180,0)
. . S SEP=X,END=X_FLG
-"RTN","C0CMAIL3",184,0)
+"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)
- . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
-"RTN","C0CMAIL3",186,0)
- . .QUIT
-"RTN","C0CMAIL3",187,0)
- . ;
-"RTN","C0CMAIL3",188,0)
. ; A new separator is set, process original
-"RTN","C0CMAIL3",189,0)
+"RTN","C0CMAIL3",186,0)
. I X=SEP D QUIT
-"RTN","C0CMAIL3",190,0)
+"RTN","C0CMAIL3",187,0)
. . S LST(NAM,"MSG",D0,SGC,"SIZE")=BCN+$L(BF)
-"RTN","C0CMAIL3",191,0)
+"RTN","C0CMAIL3",188,0)
. . S LST(NAM,"MSG",D0,"SEG",SGC)=$G(LST(NAM,"MSG",D0,"SEG",SGC))_"^"_(D1-1)
-"RTN","C0CMAIL3",192,0)
+"RTN","C0CMAIL3",189,0)
. . S SGC=SGC+1,BCN=0
-"RTN","C0CMAIL3",193,0)
+"RTN","C0CMAIL3",190,0)
. . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
-"RTN","C0CMAIL3",194,0)
+"RTN","C0CMAIL3",191,0)
. .QUIT
-"RTN","C0CMAIL3",195,0)
+"RTN","C0CMAIL3",192,0)
. ;
-"RTN","C0CMAIL3",196,0)
+"RTN","C0CMAIL3",193,0)
. S BCN=BCN+$L(X)
-"RTN","C0CMAIL3",197,0)
+"RTN","C0CMAIL3",194,0)
. I X[CON D Q
-"RTN","C0CMAIL3",198,0)
+"RTN","C0CMAIL3",195,0)
. . S J=$P($P(X,";"),CON,2)
-"RTN","C0CMAIL3",199,0)
+"RTN","C0CMAIL3",196,0)
. . S LST(NAM,"MSG",D0,"SEG",SGC,"CONT",CNT,$P(J,":"))=$P(J,":",2)
-"RTN","C0CMAIL3",200,0)
+"RTN","C0CMAIL3",197,0)
. .QUIT
-"RTN","C0CMAIL3",201,0)
+"RTN","C0CMAIL3",198,0)
. ;
-"RTN","C0CMAIL3",202,0)
+"RTN","C0CMAIL3",199,0)
. ; S LST(NAM,"MSG",D0,"SEG",D1)=X
-"RTN","C0CMAIL3",203,0)
+"RTN","C0CMAIL3",200,0)
.QUIT
-"RTN","C0CMAIL3",204,0)
+"RTN","C0CMAIL3",201,0)
QUIT
-"RTN","C0CMAIL3",205,0)
+"RTN","C0CMAIL3",202,0)
; ===================
-"RTN","C0CMAIL3",206,0)
+"RTN","C0CMAIL3",203,0)
NAME(NM) ; Return the name of the Sender
-"RTN","C0CMAIL3",207,0)
+"RTN","C0CMAIL3",204,0)
N NAME
-"RTN","C0CMAIL3",208,0)
+"RTN","C0CMAIL3",205,0)
S NAME=""
-"RTN","C0CMAIL3",209,0)
+"RTN","C0CMAIL3",206,0)
D
-"RTN","C0CMAIL3",210,0)
+"RTN","C0CMAIL3",207,0)
. ; Look first for a value to use with the NEW PERSON file
-"RTN","C0CMAIL3",211,0)
+"RTN","C0CMAIL3",208,0)
. ;
-"RTN","C0CMAIL3",212,0)
+"RTN","C0CMAIL3",209,0)
. I NM=+NM S NAME=$P(^VA(200,NM,0),U,1) Q
-"RTN","C0CMAIL3",213,0)
+"RTN","C0CMAIL3",210,0)
. ;
-"RTN","C0CMAIL3",214,0)
+"RTN","C0CMAIL3",211,0)
. I $L(NM) S NAME=NM Q
-"RTN","C0CMAIL3",215,0)
+"RTN","C0CMAIL3",212,0)
. ;
-"RTN","C0CMAIL3",216,0)
+"RTN","C0CMAIL3",213,0)
. ; Else, pull the data from the message and display the foreign source
-"RTN","C0CMAIL3",217,0)
+"RTN","C0CMAIL3",214,0)
. ; of the message.
-"RTN","C0CMAIL3",218,0)
+"RTN","C0CMAIL3",215,0)
. N T
-"RTN","C0CMAIL3",219,0)
+"RTN","C0CMAIL3",216,0)
. S VAL=$G(^XMB(3.9,D0,.7))
-"RTN","C0CMAIL3",220,0)
+"RTN","C0CMAIL3",217,0)
. S:VAL T=$P(^VA(200,VAL,0),U)
-"RTN","C0CMAIL3",221,0)
+"RTN","C0CMAIL3",218,0)
. I $L($G(T)) S NAME=T Q
-"RTN","C0CMAIL3",222,0)
+"RTN","C0CMAIL3",219,0)
. ;
-"RTN","C0CMAIL3",223,0)
+"RTN","C0CMAIL3",220,0)
.QUIT
-"RTN","C0CMAIL3",224,0)
+"RTN","C0CMAIL3",221,0)
QUIT NAME
-"RTN","C0CMAIL3",225,0)
+"RTN","C0CMAIL3",222,0)
; ===================
-"RTN","C0CMAIL3",226,0)
+"RTN","C0CMAIL3",223,0)
TIME(Y) ; The time and date of the sending
-"RTN","C0CMAIL3",227,0)
+"RTN","C0CMAIL3",224,0)
X ^DD("DD")
-"RTN","C0CMAIL3",228,0)
+"RTN","C0CMAIL3",225,0)
QUIT Y
-"RTN","C0CMAIL3",229,0)
+"RTN","C0CMAIL3",226,0)
; ===================
-"RTN","C0CMAIL3",230,0)
+"RTN","C0CMAIL3",227,0)
; Segments in Message need to be identified and decoded properly
-"RTN","C0CMAIL3",231,0)
+"RTN","C0CMAIL3",228,0)
; D DETAIL^C0CMAIL(.ARRAY,D0) ; Call One for each message
-"RTN","C0CMAIL3",232,0)
+"RTN","C0CMAIL3",229,0)
; ARRAY will have the details of this one call
-"RTN","C0CMAIL3",233,0)
+"RTN","C0CMAIL3",230,0)
;
-"RTN","C0CMAIL3",234,0)
+"RTN","C0CMAIL3",231,0)
; Inputs;
-"RTN","C0CMAIL3",235,0)
+"RTN","C0CMAIL3",232,0)
; C0CINPUT - The IEN of the message to expand
-"RTN","C0CMAIL3",236,0)
+"RTN","C0CMAIL3",233,0)
; Outputs;
-"RTN","C0CMAIL3",237,0)
+"RTN","C0CMAIL3",234,0)
; C0CDATA - Carrier for the returned structure of the Message
-"RTN","C0CMAIL3",238,0)
+"RTN","C0CMAIL3",235,0)
; C0CDATA(D0,"SEG")=number of SEGMENTS
-"RTN","C0CMAIL3",239,0)
+"RTN","C0CMAIL3",236,0)
; C0CDATA(D0,"SEG",0:n)=SEGMENT n details; First;Last;Type
-"RTN","C0CMAIL3",240,0)
+"RTN","C0CMAIL3",237,0)
; C0CDATA(D0,"SEG",0:n,"CONTENT",type)=Content details
-"RTN","C0CMAIL3",241,0)
+"RTN","C0CMAIL3",238,0)
; C0CDATA(D0,"SEG",0:n,"MSG",D3)=Content details
-"RTN","C0CMAIL3",242,0)
+"RTN","C0CMAIL3",239,0)
; C0CDATA(D0,"SEG",0:n,"HTML",D3)=Content details
-"RTN","C0CMAIL3",243,0)
+"RTN","C0CMAIL3",240,0)
;
-"RTN","C0CMAIL3",244,0)
+"RTN","C0CMAIL3",241,0)
DETAIL(C0CDATA,C0CINPUT) ; Message Detail Delivery
-"RTN","C0CMAIL3",245,0)
+"RTN","C0CMAIL3",242,0)
N LST,D0,D1,U
-"RTN","C0CMAIL3",246,0)
+"RTN","C0CMAIL3",243,0)
S U="^"
-"RTN","C0CMAIL3",247,0)
+"RTN","C0CMAIL3",244,0)
S D0=+$G(C0CINPUT)
-"RTN","C0CMAIL3",248,0)
+"RTN","C0CMAIL3",245,0)
I D0 D QUIT
-"RTN","C0CMAIL3",249,0)
+"RTN","C0CMAIL3",246,0)
. I $D(^XMB(3.9,D0))<10 D ERROR("ER01") QUIT
+"RTN","C0CMAIL3",247,0)
+ . ;
+"RTN","C0CMAIL3",248,0)
+ . D GETTYP2(D0)
+"RTN","C0CMAIL3",249,0)
+ . I $D(LST) M C0CDATA(D0)=LST Q
"RTN","C0CMAIL3",250,0)
. ;
"RTN","C0CMAIL3",251,0)
- . D GETTYP2(D0)
-"RTN","C0CMAIL3",252,0)
- . I $D(LST) M C0CDATA(D0)=LST Q
-"RTN","C0CMAIL3",253,0)
- . ;
-"RTN","C0CMAIL3",254,0)
. D ERROR("ER02")
-"RTN","C0CMAIL3",255,0)
+"RTN","C0CMAIL3",252,0)
.QUIT
-"RTN","C0CMAIL3",256,0)
+"RTN","C0CMAIL3",253,0)
QUIT
-"RTN","C0CMAIL3",257,0)
+"RTN","C0CMAIL3",254,0)
; ===================
-"RTN","C0CMAIL3",258,0)
+"RTN","C0CMAIL3",255,0)
; End note if needed
-"RTN","C0CMAIL3",259,0)
+"RTN","C0CMAIL3",256,0)
; MSK - Set of characters that do not exist in 64 bit encoding
-"RTN","C0CMAIL3",260,0)
+"RTN","C0CMAIL3",257,0)
GETTYP2(D0) ; Try to get the types and MSK for the
-"RTN","C0CMAIL3",261,0)
+"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",262,0)
+"RTN","C0CMAIL3",259,0)
S CON="Content-",U="^"
-"RTN","C0CMAIL3",263,0)
+"RTN","C0CMAIL3",260,0)
S FLG="--",MSK=" !""#$%&'()*,-.:;<>?@[\]^_`{|}~"
-"RTN","C0CMAIL3",264,0)
+"RTN","C0CMAIL3",261,0)
S (BF,SEP)="" ; Start SEP as null, so we can use this to help identify the type
-"RTN","C0CMAIL3",265,0)
+"RTN","C0CMAIL3",262,0)
S (BCN,CNT,D1,END,SGC)=0
-"RTN","C0CMAIL3",266,0)
+"RTN","C0CMAIL3",263,0)
S XX=$G(^XMB(3.9,D0,0))
-"RTN","C0CMAIL3",267,0)
+"RTN","C0CMAIL3",264,0)
; S K=$P(^XMB(3.9,D0,2,0),U,3)
-"RTN","C0CMAIL3",268,0)
+"RTN","C0CMAIL3",265,0)
S LST("TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
-"RTN","C0CMAIL3",269,0)
+"RTN","C0CMAIL3",266,0)
S LST("CREATED")=$$TIME($P(XX,U,3))
-"RTN","C0CMAIL3",270,0)
+"RTN","C0CMAIL3",267,0)
F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM)
-"RTN","C0CMAIL3",271,0)
+"RTN","C0CMAIL3",268,0)
S LST("FROM")=$$NAME(XXNM)
-"RTN","C0CMAIL3",272,0)
+"RTN","C0CMAIL3",269,0)
; Get the folks the email is sent to.
-"RTN","C0CMAIL3",273,0)
+"RTN","C0CMAIL3",270,0)
S D1=0
-"RTN","C0CMAIL3",274,0)
+"RTN","C0CMAIL3",271,0)
F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D Q:D1=""
-"RTN","C0CMAIL3",275,0)
+"RTN","C0CMAIL3",272,0)
. N I,T
-"RTN","C0CMAIL3",276,0)
+"RTN","C0CMAIL3",273,0)
. S T=$P($G(^XMB(3.9,D0,1,D1,0)),U)
-"RTN","C0CMAIL3",277,0)
+"RTN","C0CMAIL3",274,0)
. S:T T=$P($G(^VA(200,T,0)),"^")
-"RTN","C0CMAIL3",278,0)
+"RTN","C0CMAIL3",275,0)
. S LST("TO",+D1)=T
-"RTN","C0CMAIL3",279,0)
+"RTN","C0CMAIL3",276,0)
. S T=$G(^XMB(3.9,D0,6,+D1,0))
-"RTN","C0CMAIL3",280,0)
+"RTN","C0CMAIL3",277,0)
. S:T="" T=$P($G(^VA(200,+T,0)),"^")
-"RTN","C0CMAIL3",281,0)
+"RTN","C0CMAIL3",278,0)
. S:T="" T=""
-"RTN","C0CMAIL3",282,0)
+"RTN","C0CMAIL3",279,0)
. S LST("TO NAME",D1)=T
-"RTN","C0CMAIL3",283,0)
+"RTN","C0CMAIL3",280,0)
.QUIT
-"RTN","C0CMAIL3",284,0)
+"RTN","C0CMAIL3",281,0)
; Get the Header for the message and store as "HDR"
-"RTN","C0CMAIL3",285,0)
+"RTN","C0CMAIL3",282,0)
S D1=0,SGC=0
-"RTN","C0CMAIL3",286,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",287,0)
+"RTN","C0CMAIL3",284,0)
. S LST("HDR",I)=$G(^XMB(3.9,D0,2,D1,0))
-"RTN","C0CMAIL3",288,0)
+"RTN","C0CMAIL3",285,0)
.QUIT
-"RTN","C0CMAIL3",289,0)
+"RTN","C0CMAIL3",286,0)
N BNDRY,STKL,SEG
-"RTN","C0CMAIL3",290,0)
+"RTN","C0CMAIL3",287,0)
S STKL=0,SEG=0
-"RTN","C0CMAIL3",291,0)
+"RTN","C0CMAIL3",288,0)
; Find boundaries and map them
-"RTN","C0CMAIL3",292,0)
+"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)
- F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D
-"RTN","C0CMAIL3",294,0)
- . ; Clear any control characters (cr/lf/ff) off
-"RTN","C0CMAIL3",295,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)
+"RTN","C0CMAIL3",294,0)
. ; terminator markers and the actual boundary markers.
-"RTN","C0CMAIL3",298,0)
+"RTN","C0CMAIL3",295,0)
. I X[" boundary=" D Q
-"RTN","C0CMAIL3",299,0)
+"RTN","C0CMAIL3",296,0)
. . S SEP=$P(X," boundary=",2)
-"RTN","C0CMAIL3",300,0)
+"RTN","C0CMAIL3",297,0)
. . S:$E(SEP)="""" SEP=$TR(SEP,"""")
-"RTN","C0CMAIL3",301,0)
+"RTN","C0CMAIL3",298,0)
. . S STKL=STKL+1
-"RTN","C0CMAIL3",302,0)
+"RTN","C0CMAIL3",299,0)
. . S END=SEP_FLG
-"RTN","C0CMAIL3",303,0)
+"RTN","C0CMAIL3",300,0)
. . S BNDRY(STKL,SEP)=0
-"RTN","C0CMAIL3",304,0)
+"RTN","C0CMAIL3",301,0)
. . S BNDRX(SEP)=STKL,BNDRZ(END)=0
-"RTN","C0CMAIL3",305,0)
+"RTN","C0CMAIL3",302,0)
. .QUIT
-"RTN","C0CMAIL3",306,0)
+"RTN","C0CMAIL3",303,0)
. ;
-"RTN","C0CMAIL3",307,0)
+"RTN","C0CMAIL3",304,0)
. ; Look for information as to how amy boudaries are present and where
-"RTN","C0CMAIL3",308,0)
+"RTN","C0CMAIL3",305,0)
. ; they terminate
-"RTN","C0CMAIL3",309,0)
+"RTN","C0CMAIL3",306,0)
. D:X'=""&($E(X,1,2)="--")&($E(X,$L(X)-1,9999)'="--")
-"RTN","C0CMAIL3",310,0)
+"RTN","C0CMAIL3",307,0)
. . ; Boundary Found
-"RTN","C0CMAIL3",311,0)
+"RTN","C0CMAIL3",308,0)
. . I $D(BNDRX(X)) D Q
-"RTN","C0CMAIL3",312,0)
+"RTN","C0CMAIL3",309,0)
. . . S SEG=SEG+1
-"RTN","C0CMAIL3",313,0)
+"RTN","C0CMAIL3",310,0)
. . . S BNDRE(X)=$G(BNDRE(X))_D1_";"
-"RTN","C0CMAIL3",314,0)
+"RTN","C0CMAIL3",311,0)
. . . S BND1(D1)=STKL_";B;"_SEG_";"_X
-"RTN","C0CMAIL3",315,0)
+"RTN","C0CMAIL3",312,0)
. . . S BNDR(X,D1,"B")=STKL
-"RTN","C0CMAIL3",316,0)
+"RTN","C0CMAIL3",313,0)
. . . I BNDRX(X)=X D ERROR("ER13")
-"RTN","C0CMAIL3",317,0)
+"RTN","C0CMAIL3",314,0)
. . .QUIT
-"RTN","C0CMAIL3",318,0)
+"RTN","C0CMAIL3",315,0)
. . ;
-"RTN","C0CMAIL3",319,0)
+"RTN","C0CMAIL3",316,0)
. . ; Boundary Terminator
-"RTN","C0CMAIL3",320,0)
+"RTN","C0CMAIL3",317,0)
. . I $D(BNDRZ(X)) D Q
-"RTN","C0CMAIL3",321,0)
+"RTN","C0CMAIL3",318,0)
. . . S BNDR(X,D1,"E")=STKL
-"RTN","C0CMAIL3",322,0)
+"RTN","C0CMAIL3",319,0)
. . . S BNDRZ(X)=BNDRZ(X)+1
-"RTN","C0CMAIL3",323,0)
+"RTN","C0CMAIL3",320,0)
. . . S BND1(D1)=STKL_";E;"_SEG_";"_X
-"RTN","C0CMAIL3",324,0)
+"RTN","C0CMAIL3",321,0)
. . . S SEG=SEG+1
-"RTN","C0CMAIL3",325,0)
+"RTN","C0CMAIL3",322,0)
. . . I BNDRX(X)=X D ERROR("ER14")
-"RTN","C0CMAIL3",326,0)
+"RTN","C0CMAIL3",323,0)
. . . S STKL=STKL-1
-"RTN","C0CMAIL3",327,0)
+"RTN","C0CMAIL3",324,0)
. . .QUIT
-"RTN","C0CMAIL3",328,0)
+"RTN","C0CMAIL3",325,0)
. .QUIT
-"RTN","C0CMAIL3",329,0)
+"RTN","C0CMAIL3",326,0)
.QUIT
-"RTN","C0CMAIL3",330,0)
+"RTN","C0CMAIL3",327,0)
; Start walking the TEXT/XML/64-BIT ENCODING sections of the message
-"RTN","C0CMAIL3",331,0)
+"RTN","C0CMAIL3",328,0)
N A,B,C,STACK,STYP,SEG,AX
-"RTN","C0CMAIL3",332,0)
+"RTN","C0CMAIL3",329,0)
S D1=.99999,SGC=0
-"RTN","C0CMAIL3",333,0)
+"RTN","C0CMAIL3",330,0)
F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D
-"RTN","C0CMAIL3",334,0)
+"RTN","C0CMAIL3",331,0)
. ; Clear any control characters (cr/lf/ff) off
-"RTN","C0CMAIL3",335,0)
+"RTN","C0CMAIL3",332,0)
. S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
-"RTN","C0CMAIL3",336,0)
+"RTN","C0CMAIL3",333,0)
. ;
-"RTN","C0CMAIL3",337,0)
+"RTN","C0CMAIL3",334,0)
. D
-"RTN","C0CMAIL3",338,0)
+"RTN","C0CMAIL3",335,0)
. . I $D(BND1(D1)) D BOUNDARY(X) QUIT
+"RTN","C0CMAIL3",336,0)
+ . . ;
+"RTN","C0CMAIL3",337,0)
+ . . S DX=$O(BND1(D1))
+"RTN","C0CMAIL3",338,0)
+ . . I DX="" D ERROR("ER15") Q
"RTN","C0CMAIL3",339,0)
. . ;
"RTN","C0CMAIL3",340,0)
- . . S DX=$O(BND1(D1))
-"RTN","C0CMAIL3",341,0)
- . . I DX="" D ERROR("ER15") Q
-"RTN","C0CMAIL3",342,0)
- . . ;
-"RTN","C0CMAIL3",343,0)
. . ; Good situation, extract the parts for the section
-"RTN","C0CMAIL3",344,0)
+"RTN","C0CMAIL3",341,0)
. . S A=$G(BND1(DX))
-"RTN","C0CMAIL3",345,0)
+"RTN","C0CMAIL3",342,0)
. . S STACK=+A,STYP=$P(A,";",2),SGC=$P(A,";",3),AX=$P(A,";",4,999)
-"RTN","C0CMAIL3",346,0)
+"RTN","C0CMAIL3",343,0)
. .QUIT
-"RTN","C0CMAIL3",347,0)
+"RTN","C0CMAIL3",344,0)
. ; Enter once to set the SEP to capture the separator
-"RTN","C0CMAIL3",348,0)
+"RTN","C0CMAIL3",345,0)
. ;
-"RTN","C0CMAIL3",349,0)
+"RTN","C0CMAIL3",346,0)
. ; A new SEGMENT separator is set, process original
-"RTN","C0CMAIL3",350,0)
+"RTN","C0CMAIL3",347,0)
. I $D(BND1(X)) D QUIT
-"RTN","C0CMAIL3",351,0)
+"RTN","C0CMAIL3",348,0)
. . ; Save Current Values
-"RTN","C0CMAIL3",352,0)
+"RTN","C0CMAIL3",349,0)
. . S LST("SEG",SGC,"SIZE")=BCN+$L(BF)
-"RTN","C0CMAIL3",353,0)
+"RTN","C0CMAIL3",350,0)
. . ; Close this Segment and prepare to start a New Segment
-"RTN","C0CMAIL3",354,0)
+"RTN","C0CMAIL3",351,0)
. . S $P(LST("SEG",SGC),"^",1,2)=$P($G(LST("SEG",SGC)),"^",1)_"^"_(D1-1)
-"RTN","C0CMAIL3",355,0)
+"RTN","C0CMAIL3",352,0)
. . ; Put the result in LST("SEG",SGC,"XML")
-"RTN","C0CMAIL3",356,0)
+"RTN","C0CMAIL3",353,0)
. . I $L(BF) D
-"RTN","C0CMAIL3",357,0)
+"RTN","C0CMAIL3",354,0)
. . . S ZN=1
-"RTN","C0CMAIL3",358,0)
+"RTN","C0CMAIL3",355,0)
. . . N I,T,TBF
-"RTN","C0CMAIL3",359,0)
+"RTN","C0CMAIL3",356,0)
. . . S TBF=BF
-"RTN","C0CMAIL3",360,0)
+"RTN","C0CMAIL3",357,0)
. . . F I=1:1:($L(TBF,"=")) D
-"RTN","C0CMAIL3",361,0)
+"RTN","C0CMAIL3",358,0)
. . . . S BF=$P(TBF,"=",I)_"="
-"RTN","C0CMAIL3",362,0)
+"RTN","C0CMAIL3",359,0)
. . . . I "="'[BF D DECODER(.BF,.TYP)
-"RTN","C0CMAIL3",363,0)
+"RTN","C0CMAIL3",360,0)
. . . .QUIT
-"RTN","C0CMAIL3",364,0)
+"RTN","C0CMAIL3",361,0)
. . . S BF=""
-"RTN","C0CMAIL3",365,0)
+"RTN","C0CMAIL3",362,0)
. . .QUIT
-"RTN","C0CMAIL3",366,0)
+"RTN","C0CMAIL3",363,0)
. . S SGC=SGC+1,BCN=0
-"RTN","C0CMAIL3",367,0)
+"RTN","C0CMAIL3",364,0)
. . ; Incriment SGC to start a new Segment
-"RTN","C0CMAIL3",368,0)
+"RTN","C0CMAIL3",365,0)
. . S LST("SEG",SGC)=D1
-"RTN","C0CMAIL3",369,0)
+"RTN","C0CMAIL3",366,0)
. .QUIT
+"RTN","C0CMAIL3",367,0)
+ . ;
+"RTN","C0CMAIL3",368,0)
+ . ; Accumulate the 64 bit encoding, no spaces, or other non-64bit characters
+"RTN","C0CMAIL3",369,0)
+ . 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
-"RTN","C0CMAIL3",372,0)
- . I X=$TR(X,MSK)&$L(X) S BF=BF_X QUIT
-"RTN","C0CMAIL3",373,0)
- . ;
-"RTN","C0CMAIL3",374,0)
. ; Ending Condition, close out the Segment
-"RTN","C0CMAIL3",375,0)
+"RTN","C0CMAIL3",372,0)
. I $D(BNDRZ(X)) D QUIT
-"RTN","C0CMAIL3",376,0)
+"RTN","C0CMAIL3",373,0)
. . S $P(LST("SEG",SGC),"^",2)=D1-1
-"RTN","C0CMAIL3",377,0)
+"RTN","C0CMAIL3",374,0)
. . I $L(BF) S ZN=1 D DECODER(.BF,.TYP) S BF="" Q
-"RTN","C0CMAIL3",378,0)
+"RTN","C0CMAIL3",375,0)
. .QUIT
-"RTN","C0CMAIL3",379,0)
+"RTN","C0CMAIL3",376,0)
. ;
-"RTN","C0CMAIL3",380,0)
+"RTN","C0CMAIL3",377,0)
. ; Accumulate the content lines of the message
-"RTN","C0CMAIL3",381,0)
+"RTN","C0CMAIL3",378,0)
. S BCN=BCN+$L(X)
-"RTN","C0CMAIL3",382,0)
+"RTN","C0CMAIL3",379,0)
. ; Split out the Content Info
-"RTN","C0CMAIL3",383,0)
+"RTN","C0CMAIL3",380,0)
. I X[CON D Q
-"RTN","C0CMAIL3",384,0)
+"RTN","C0CMAIL3",381,0)
. . S J=$P(X,CON,2)
-"RTN","C0CMAIL3",385,0)
+"RTN","C0CMAIL3",382,0)
. . S TYP="CONTENT"
-"RTN","C0CMAIL3",386,0)
+"RTN","C0CMAIL3",383,0)
. . S LST("SEG",SGC,TYP,$P(J,":"))=$P(J,":",2,9)
-"RTN","C0CMAIL3",387,0)
+"RTN","C0CMAIL3",384,0)
. . D CONTENT(D1)
-"RTN","C0CMAIL3",388,0)
+"RTN","C0CMAIL3",385,0)
. .QUIT
-"RTN","C0CMAIL3",389,0)
+"RTN","C0CMAIL3",386,0)
. ;
-"RTN","C0CMAIL3",390,0)
+"RTN","C0CMAIL3",387,0)
. ; Everything else is Text, Check for CCR/CCD.
-"RTN","C0CMAIL3",391,0)
+"RTN","C0CMAIL3",388,0)
. N KK,UBF
-"RTN","C0CMAIL3",392,0)
+"RTN","C0CMAIL3",389,0)
. D
-"RTN","C0CMAIL3",393,0)
+"RTN","C0CMAIL3",390,0)
. . S UBF=$$UPPER(X)
-"RTN","C0CMAIL3",394,0)
+"RTN","C0CMAIL3",391,0)
. . I UBF["1) S TYP=$P(UP,".",2) Q
-"RTN","C0CMAIL3",416,0)
+"RTN","C0CMAIL3",413,0)
. I UP["XML" S TYP="XML" Q
-"RTN","C0CMAIL3",417,0)
+"RTN","C0CMAIL3",414,0)
. I UP["P7S" S TYP="P7S" Q
-"RTN","C0CMAIL3",418,0)
+"RTN","C0CMAIL3",415,0)
. I J[" boundary=" D BOUNDARY(J)
-"RTN","C0CMAIL3",419,0)
+"RTN","C0CMAIL3",416,0)
.QUIT
-"RTN","C0CMAIL3",420,0)
+"RTN","C0CMAIL3",417,0)
S LIS("CON",SGC,D1)=X
-"RTN","C0CMAIL3",421,0)
+"RTN","C0CMAIL3",418,0)
S LIS("CON",SGC,D1,"TYP")=TYP
-"RTN","C0CMAIL3",422,0)
+"RTN","C0CMAIL3",419,0)
; If there is a follow-on, look for another line after this.
-"RTN","C0CMAIL3",423,0)
+"RTN","C0CMAIL3",420,0)
I $E($RE(X),1)=";" D CONTENT(D1+1)
-"RTN","C0CMAIL3",424,0)
+"RTN","C0CMAIL3",421,0)
QUIT
-"RTN","C0CMAIL3",425,0)
+"RTN","C0CMAIL3",422,0)
; ===================
-"RTN","C0CMAIL3",426,0)
+"RTN","C0CMAIL3",423,0)
BOUNDARY(X) ; Set an additional BOUNDARY, and activate another stack level
-"RTN","C0CMAIL3",427,0)
+"RTN","C0CMAIL3",424,0)
S SEP=$P($P(X," boundary=",2),"""",2),END=SEP_FLG
-"RTN","C0CMAIL3",428,0)
+"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("ER11")
-"RTN","C0CMAIL3",431,0)
- Q:SEP'[" "
-"RTN","C0CMAIL3",432,0)
- ;
-"RTN","C0CMAIL3",433,0)
D ERROR("ER12")
-"RTN","C0CMAIL3",434,0)
+"RTN","C0CMAIL3",431,0)
QUIT
-"RTN","C0CMAIL3",435,0)
+"RTN","C0CMAIL3",432,0)
; ===================
-"RTN","C0CMAIL3",436,0)
+"RTN","C0CMAIL3",433,0)
; Break down the Buffer Array so it can be saved.
-"RTN","C0CMAIL3",437,0)
+"RTN","C0CMAIL3",434,0)
; BF is passed in.
-"RTN","C0CMAIL3",438,0)
+"RTN","C0CMAIL3",435,0)
; TYP is the type of
-"RTN","C0CMAIL3",439,0)
+"RTN","C0CMAIL3",436,0)
DECODER(BF,TYP) ;
-"RTN","C0CMAIL3",440,0)
+"RTN","C0CMAIL3",437,0)
N RCNT,TBF,UBF,ZBF,ZI,ZJ,ZK,ZSIZE
-"RTN","C0CMAIL3",441,0)
+"RTN","C0CMAIL3",438,0)
S:$G(TYP)="" TYP="XML"
-"RTN","C0CMAIL3",442,0)
+"RTN","C0CMAIL3",439,0)
S ZBF=BF
-"RTN","C0CMAIL3",443,0)
+"RTN","C0CMAIL3",440,0)
; Full Buffer, BF, now check for Encryption and Unpack
-"RTN","C0CMAIL3",444,0)
+"RTN","C0CMAIL3",441,0)
F RCNT=1:1:$L(ZBF,"=") D
-"RTN","C0CMAIL3",445,0)
+"RTN","C0CMAIL3",442,0)
. N BF
-"RTN","C0CMAIL3",446,0)
+"RTN","C0CMAIL3",443,0)
. S BF=$P(ZBF,"=",RCNT)
-"RTN","C0CMAIL3",447,0)
+"RTN","C0CMAIL3",444,0)
. ; Unpacking the 64 bit encoding
-"RTN","C0CMAIL3",448,0)
+"RTN","C0CMAIL3",445,0)
. S TBF=$TR($$DECODE^RGUTUU(BF),$C(10,12,13))
-"RTN","C0CMAIL3",449,0)
+"RTN","C0CMAIL3",446,0)
. D:$L(TBF)
-"RTN","C0CMAIL3",450,0)
+"RTN","C0CMAIL3",447,0)
. . N C,OK,OKCNT,KK,XBF,UBF
-"RTN","C0CMAIL3",451,0)
+"RTN","C0CMAIL3",448,0)
. . D
-"RTN","C0CMAIL3",452,0)
+"RTN","C0CMAIL3",449,0)
. . . S UBF=$$UPPER(TBF)
-"RTN","C0CMAIL3",453,0)
+"RTN","C0CMAIL3",450,0)
. . . I UBF["126 OKCNT=OKCNT+1 I OKCNT>100 S OK=0 Q
-"RTN","C0CMAIL3",460,0)
+"RTN","C0CMAIL3",457,0)
. . ;
-"RTN","C0CMAIL3",461,0)
+"RTN","C0CMAIL3",458,0)
. . D
-"RTN","C0CMAIL3",462,0)
+"RTN","C0CMAIL3",459,0)
. . . I 'OK S (BF,UBF,TBF,XBF)="" Q
-"RTN","C0CMAIL3",463,0)
+"RTN","C0CMAIL3",460,0)
. . . ;
-"RTN","C0CMAIL3",464,0)
+"RTN","C0CMAIL3",461,0)
. . . S BF=BF_"="
-"RTN","C0CMAIL3",465,0)
+"RTN","C0CMAIL3",462,0)
. . . D NORMAL(.XBF,.TBF)
-"RTN","C0CMAIL3",466,0)
+"RTN","C0CMAIL3",463,0)
. . .QUIT
-"RTN","C0CMAIL3",467,0)
+"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)
- . .QUIT
-"RTN","C0CMAIL3",469,0)
- .QUIT
-"RTN","C0CMAIL3",470,0)
- QUIT
-"RTN","C0CMAIL3",471,0)
; ===================
-"RTN","C0CMAIL3",472,0)
+"RTN","C0CMAIL3",469,0)
; OUTXML = OUTBF = OUT = OUTPUT ARRAY TO BE BUILT
-"RTN","C0CMAIL3",473,0)
+"RTN","C0CMAIL3",470,0)
; BF = INXML = INPUT ARRAY TO PROVIDE INPUT
-"RTN","C0CMAIL3",474,0)
+"RTN","C0CMAIL3",471,0)
; >D NORMAL^C0CMAIL(.OUT,BF)
-"RTN","C0CMAIL3",475,0)
+"RTN","C0CMAIL3",472,0)
NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
-"RTN","C0CMAIL3",476,0)
+"RTN","C0CMAIL3",473,0)
; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
-"RTN","C0CMAIL3",477,0)
+"RTN","C0CMAIL3",474,0)
;
-"RTN","C0CMAIL3",478,0)
+"RTN","C0CMAIL3",475,0)
N ZN,OUTBF,XX,ZSEP
-"RTN","C0CMAIL3",479,0)
+"RTN","C0CMAIL3",476,0)
S INXML=$TR(INXML,$C(10,12,13))
-"RTN","C0CMAIL3",480,0)
+"RTN","C0CMAIL3",477,0)
S ZN=1,ZSEP=">"
-"RTN","C0CMAIL3",481,0)
+"RTN","C0CMAIL3",478,0)
S OUTBF(1)=$P(INXML,"><",1)_ZSEP,XX="<"_$P(INXML,"><",2)_ZSEP,ZN=2,ZL=1
-"RTN","C0CMAIL3",482,0)
+"RTN","C0CMAIL3",479,0)
F ZN=ZN+1:1:$L(INXML,"><") D Q:XX=""
-"RTN","C0CMAIL3",483,0)
+"RTN","C0CMAIL3",480,0)
. S XX=$P(INXML,"><",ZN)
-"RTN","C0CMAIL3",484,0)
+"RTN","C0CMAIL3",481,0)
. S:$E($RE(XX))=">" ZSEP=""
-"RTN","C0CMAIL3",485,0)
+"RTN","C0CMAIL3",482,0)
. Q:XX=""
-"RTN","C0CMAIL3",486,0)
+"RTN","C0CMAIL3",483,0)
. ;
-"RTN","C0CMAIL3",487,0)
+"RTN","C0CMAIL3",484,0)
. S XX="<"_XX_ZSEP
-"RTN","C0CMAIL3",488,0)
+"RTN","C0CMAIL3",485,0)
. D
-"RTN","C0CMAIL3",489,0)
+"RTN","C0CMAIL3",486,0)
. . I $L(XX)<4000 S OUTBF(ZL)=XX,XX=$P(INXML,"><",ZN),ZL=ZL+1 Q
-"RTN","C0CMAIL3",490,0)
+"RTN","C0CMAIL3",487,0)
. . ;
-"RTN","C0CMAIL3",491,0)
+"RTN","C0CMAIL3",488,0)
. . D ERROR("ER05")
-"RTN","C0CMAIL3",492,0)
+"RTN","C0CMAIL3",489,0)
. . F ZL=ZL+1:1 D Q:XX=""
-"RTN","C0CMAIL3",493,0)
+"RTN","C0CMAIL3",490,0)
. . . N XL
-"RTN","C0CMAIL3",494,0)
+"RTN","C0CMAIL3",491,0)
. . . S XL=$E(XX,1,4000)
-"RTN","C0CMAIL3",495,0)
+"RTN","C0CMAIL3",492,0)
. . . S $E(XX,1,4000)="" ; S XX=$E(XX,4001,999999) ; Remove 4K characters
-"RTN","C0CMAIL3",496,0)
+"RTN","C0CMAIL3",493,0)
. . . S OUTBF(ZL)=XL
-"RTN","C0CMAIL3",497,0)
+"RTN","C0CMAIL3",494,0)
. . .QUIT
-"RTN","C0CMAIL3",498,0)
+"RTN","C0CMAIL3",495,0)
. .QUIT
-"RTN","C0CMAIL3",499,0)
+"RTN","C0CMAIL3",496,0)
.QUIT
-"RTN","C0CMAIL3",500,0)
+"RTN","C0CMAIL3",497,0)
M OUTXML=OUTBF
-"RTN","C0CMAIL3",501,0)
+"RTN","C0CMAIL3",498,0)
QUIT
+"RTN","C0CMAIL3",499,0)
+ ; ===================
+"RTN","C0CMAIL3",500,0)
+UPPER(X) ; Convert any lowercase letters to Uppercase letters
+"RTN","C0CMAIL3",501,0)
+ QUIT $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
"RTN","C0CMAIL3",502,0)
; ===================
"RTN","C0CMAIL3",503,0)
-UPPER(X) ; Convert any lowercase letters to Uppercase letters
-"RTN","C0CMAIL3",504,0)
- QUIT $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
-"RTN","C0CMAIL3",505,0)
- ; ===================
-"RTN","C0CMAIL3",506,0)
; EN is a counter that remains between error events
-"RTN","C0CMAIL3",507,0)
+"RTN","C0CMAIL3",504,0)
ERROR(ER) ; Error Handler
-"RTN","C0CMAIL3",508,0)
+"RTN","C0CMAIL3",505,0)
N TXXQ,XXXQ
-"RTN","C0CMAIL3",509,0)
+"RTN","C0CMAIL3",506,0)
S XXXQ="Unknown Error Encountered = "_ER
-"RTN","C0CMAIL3",510,0)
+"RTN","C0CMAIL3",507,0)
S TXXQ=$P($T(@(ER_"^"_$T(+0))),";;",2,99)
-"RTN","C0CMAIL3",511,0)
+"RTN","C0CMAIL3",508,0)
I TXXQ'="" D
-"RTN","C0CMAIL3",512,0)
+"RTN","C0CMAIL3",509,0)
. I TXXQ["_" X "S TXXQ="_TXXQ
-"RTN","C0CMAIL3",513,0)
+"RTN","C0CMAIL3",510,0)
. S XXXQ=TXXQ
-"RTN","C0CMAIL3",514,0)
+"RTN","C0CMAIL3",511,0)
.QUIT
-"RTN","C0CMAIL3",515,0)
+"RTN","C0CMAIL3",512,0)
S EN(ER)=$G(EN(ER))+1
-"RTN","C0CMAIL3",516,0)
+"RTN","C0CMAIL3",513,0)
S LST("ERR",ER,EN(ER))=XXXQ
-"RTN","C0CMAIL3",517,0)
+"RTN","C0CMAIL3",514,0)
QUIT
-"RTN","C0CMAIL3",518,0)
+"RTN","C0CMAIL3",515,0)
; ===================
-"RTN","C0CMAIL3",519,0)
+"RTN","C0CMAIL3",516,0)
ER01 ;;Message Missing
-"RTN","C0CMAIL3",520,0)
+"RTN","C0CMAIL3",517,0)
ER02 ;;Message Text Missing
-"RTN","C0CMAIL3",521,0)
+"RTN","C0CMAIL3",518,0)
ER03 ;;Message Not Identifiable
-"RTN","C0CMAIL3",522,0)
+"RTN","C0CMAIL3",519,0)
ER04 ;;Segment is too large
-"RTN","C0CMAIL3",523,0)
+"RTN","C0CMAIL3",520,0)
ER05 ;;Mailbox Missing
-"RTN","C0CMAIL3",524,0)
+"RTN","C0CMAIL3",521,0)
ER06 ;;"User Missing = "_$G(DUZ)
-"RTN","C0CMAIL3",525,0)
+"RTN","C0CMAIL3",522,0)
ER07 ;;"Bad DUZ = "_DUZ
-"RTN","C0CMAIL3",526,0)
+"RTN","C0CMAIL3",523,0)
ER08 ;;"Bad Basket ID = "_MBLST_" >> "_$G(TN)
-"RTN","C0CMAIL3",527,0)
+"RTN","C0CMAIL3",524,0)
ER10 ;;"Bad Separator found = "_X
-"RTN","C0CMAIL3",528,0)
+"RTN","C0CMAIL3",525,0)
ER11 ;;"Non-Standard Separator Found:>"_$G(J)
-"RTN","C0CMAIL3",529,0)
+"RTN","C0CMAIL3",526,0)
ER12 ;;"Spaces are not allowed in Separators:>"_$G(J)
-"RTN","C0CMAIL3",530,0)
+"RTN","C0CMAIL3",527,0)
ER13 ;;"Bad Stack Level Detected >"_STKL_":"_BNDRY(X)_":"_X
-"RTN","C0CMAIL3",531,0)
+"RTN","C0CMAIL3",528,0)
; vvvvvvvvvvvvvvv Not Needed vvvvvvvvvvvvvvvvvvvvvvvvvv
-"RTN","C0CMAIL3",532,0)
+"RTN","C0CMAIL3",529,0)
; End note if needed
-"RTN","C0CMAIL3",533,0)
+"RTN","C0CMAIL3",530,0)
QUIT
-"RTN","C0CMAIL3",534,0)
+"RTN","C0CMAIL3",531,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)
;
+"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 .
"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)
- 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)
+"RTN","C0CMCCD",21,0)
; PROCESSING CCDS
-"RTN","C0CMCCD",24,0)
+"RTN","C0CMCCD",22,0)
N CBK,SUCCESS,LEVEL,NODE,HANDLE
-"RTN","C0CMCCD",25,0)
+"RTN","C0CMCCD",23,0)
K ^TMP("MXMLERR",$J)
-"RTN","C0CMCCD",26,0)
+"RTN","C0CMCCD",24,0)
L +^TMP("MXMLDOM",$J):5
-"RTN","C0CMCCD",27,0)
+"RTN","C0CMCCD",25,0)
E Q 0
-"RTN","C0CMCCD",28,0)
+"RTN","C0CMCCD",26,0)
S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)=""
-"RTN","C0CMCCD",29,0)
+"RTN","C0CMCCD",27,0)
L -^TMP("MXMLDOM",$J)
-"RTN","C0CMCCD",30,0)
+"RTN","C0CMCCD",28,0)
S CBK("STARTELEMENT")="STARTELE^C0CMCCD" ; ONLY THIS ONE IS CHANGED ;GPL
-"RTN","C0CMCCD",31,0)
+"RTN","C0CMCCD",29,0)
S CBK("ENDELEMENT")="ENDELE^MXMLDOM"
-"RTN","C0CMCCD",32,0)
+"RTN","C0CMCCD",30,0)
S CBK("COMMENT")="COMMENT^MXMLDOM"
-"RTN","C0CMCCD",33,0)
+"RTN","C0CMCCD",31,0)
S CBK("CHARACTERS")="CHAR^MXMLDOM"
-"RTN","C0CMCCD",34,0)
+"RTN","C0CMCCD",32,0)
S CBK("ENDDOCUMENT")="ENDDOC^MXMLDOM"
-"RTN","C0CMCCD",35,0)
+"RTN","C0CMCCD",33,0)
S CBK("ERROR")="ERROR^MXMLDOM"
-"RTN","C0CMCCD",36,0)
+"RTN","C0CMCCD",34,0)
S (SUCCESS,LEVEL,LEVEL(0),NODE)=0,OPTION=$G(OPTION,"V1")
-"RTN","C0CMCCD",37,0)
+"RTN","C0CMCCD",35,0)
D EN^MXMLPRSE(DOC,.CBK,OPTION)
-"RTN","C0CMCCD",38,0)
+"RTN","C0CMCCD",36,0)
D:'SUCCESS DELETE^MXMLDOM(HANDLE)
-"RTN","C0CMCCD",39,0)
+"RTN","C0CMCCD",37,0)
Q $S(SUCCESS:HANDLE,1:0)
-"RTN","C0CMCCD",40,0)
+"RTN","C0CMCCD",38,0)
; Start element
-"RTN","C0CMCCD",41,0)
+"RTN","C0CMCCD",39,0)
; Create new child node and push info on stack
-"RTN","C0CMCCD",42,0)
+"RTN","C0CMCCD",40,0)
STARTELE(ELE,ATTR) ; COPIED FROM STARTELE^MXMLDOM AND MODIFIED TO TREAT
-"RTN","C0CMCCD",43,0)
+"RTN","C0CMCCD",41,0)
; ATTRIBUTES AS SUBELEMENTS TO MAKE CCD XPATH PROCESSING EASIER
-"RTN","C0CMCCD",44,0)
+"RTN","C0CMCCD",42,0)
N PARENT
-"RTN","C0CMCCD",45,0)
+"RTN","C0CMCCD",43,0)
S PARENT=LEVEL(LEVEL),NODE=NODE+1
-"RTN","C0CMCCD",46,0)
+"RTN","C0CMCCD",44,0)
S:PARENT ^TMP("MXMLDOM",$J,HANDLE,PARENT,"C",NODE)=ELE
-"RTN","C0CMCCD",47,0)
+"RTN","C0CMCCD",45,0)
S LEVEL=LEVEL+1,LEVEL(LEVEL)=NODE,LEVEL(LEVEL,0)=ELE
-"RTN","C0CMCCD",48,0)
+"RTN","C0CMCCD",46,0)
S ^TMP("MXMLDOM",$J,HANDLE,NODE)=ELE,^(NODE,"P")=PARENT
-"RTN","C0CMCCD",49,0)
+"RTN","C0CMCCD",47,0)
;M ^("A")=ATTR
-"RTN","C0CMCCD",50,0)
+"RTN","C0CMCCD",48,0)
N ZI S ZI="" ; INDEX FOR ATTR
-"RTN","C0CMCCD",51,0)
+"RTN","C0CMCCD",49,0)
F S ZI=$O(ATTR(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE
-"RTN","C0CMCCD",52,0)
+"RTN","C0CMCCD",50,0)
. N ELE,TXT ; ABOUT TO RECURSE
-"RTN","C0CMCCD",53,0)
+"RTN","C0CMCCD",51,0)
. S ELE=ZI ; TAG
-"RTN","C0CMCCD",54,0)
+"RTN","C0CMCCD",52,0)
. S TXT=ATTR(ZI) ; DATA
-"RTN","C0CMCCD",55,0)
+"RTN","C0CMCCD",53,0)
. D STARTELE(ELE,"") ; CREATE A NEW SUBNODE
-"RTN","C0CMCCD",56,0)
+"RTN","C0CMCCD",54,0)
. D TXT^MXMLDOM("T") ; INSERT DATA TO TAG
-"RTN","C0CMCCD",57,0)
+"RTN","C0CMCCD",55,0)
. D ENDELE^MXMLDOM(ELE) ; POP BACK UP A LEVEL
+"RTN","C0CMCCD",56,0)
+ Q
+"RTN","C0CMCCD",57,0)
+ ;
"RTN","C0CMCCD",58,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)
+"RTN","C0CMCCD",59,0)
N ZN
-"RTN","C0CMCCD",62,0)
+"RTN","C0CMCCD",60,0)
;I $$TAG(ZOID)["entry" B
-"RTN","C0CMCCD",63,0)
+"RTN","C0CMCCD",61,0)
S ZN=$$NXTSIB(ZOID)
-"RTN","C0CMCCD",64,0)
+"RTN","C0CMCCD",62,0)
I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
-"RTN","C0CMCCD",65,0)
+"RTN","C0CMCCD",63,0)
Q 0
-"RTN","C0CMCCD",66,0)
+"RTN","C0CMCCD",64,0)
;
-"RTN","C0CMCCD",67,0)
+"RTN","C0CMCCD",65,0)
FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
-"RTN","C0CMCCD",68,0)
+"RTN","C0CMCCD",66,0)
Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CMCCD",69,0)
+"RTN","C0CMCCD",67,0)
;
-"RTN","C0CMCCD",70,0)
+"RTN","C0CMCCD",68,0)
PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
-"RTN","C0CMCCD",71,0)
+"RTN","C0CMCCD",69,0)
Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CMCCD",72,0)
+"RTN","C0CMCCD",70,0)
;
-"RTN","C0CMCCD",73,0)
+"RTN","C0CMCCD",71,0)
ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
-"RTN","C0CMCCD",74,0)
+"RTN","C0CMCCD",72,0)
S HANDLE=C0CDOCID
-"RTN","C0CMCCD",75,0)
+"RTN","C0CMCCD",73,0)
K @RTN
-"RTN","C0CMCCD",76,0)
+"RTN","C0CMCCD",74,0)
D GETTXT^MXMLDOM("A")
+"RTN","C0CMCCD",75,0)
+ Q
+"RTN","C0CMCCD",76,0)
+ ;
"RTN","C0CMCCD",77,0)
- Q
-"RTN","C0CMCCD",78,0)
- ;
-"RTN","C0CMCCD",79,0)
TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
-"RTN","C0CMCCD",80,0)
+"RTN","C0CMCCD",78,0)
;I ZOID=149 B ;GPLTEST
-"RTN","C0CMCCD",81,0)
+"RTN","C0CMCCD",79,0)
N X,Y
-"RTN","C0CMCCD",82,0)
+"RTN","C0CMCCD",80,0)
S Y=""
-"RTN","C0CMCCD",83,0)
+"RTN","C0CMCCD",81,0)
S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
-"RTN","C0CMCCD",84,0)
+"RTN","C0CMCCD",82,0)
I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
-"RTN","C0CMCCD",85,0)
+"RTN","C0CMCCD",83,0)
I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CMCCD",86,0)
+"RTN","C0CMCCD",84,0)
Q Y
-"RTN","C0CMCCD",87,0)
+"RTN","C0CMCCD",85,0)
;
-"RTN","C0CMCCD",88,0)
+"RTN","C0CMCCD",86,0)
NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
-"RTN","C0CMCCD",89,0)
+"RTN","C0CMCCD",87,0)
Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CMCCD",90,0)
+"RTN","C0CMCCD",88,0)
;
-"RTN","C0CMCCD",91,0)
+"RTN","C0CMCCD",89,0)
DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
-"RTN","C0CMCCD",92,0)
+"RTN","C0CMCCD",90,0)
;N ZT,ZN S ZT=""
-"RTN","C0CMCCD",93,0)
+"RTN","C0CMCCD",91,0)
;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
-"RTN","C0CMCCD",94,0)
+"RTN","C0CMCCD",92,0)
;Q $G(@C0CDOM@(ZOID,"T",1))
-"RTN","C0CMCCD",95,0)
+"RTN","C0CMCCD",93,0)
S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
+"RTN","C0CMCCD",94,0)
+ Q
+"RTN","C0CMCCD",95,0)
+ ;
"RTN","C0CMCCD",96,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)
+"RTN","C0CMCCD",97,0)
; INARY AND OUTARY PASSED BY NAME
-"RTN","C0CMCCD",100,0)
+"RTN","C0CMCCD",98,0)
N ZI S ZI=""
-"RTN","C0CMCCD",101,0)
+"RTN","C0CMCCD",99,0)
F S ZI=$O(@INARY@(ZI)) Q:ZI="" D ; FOR EACH NODE
-"RTN","C0CMCCD",102,0)
+"RTN","C0CMCCD",100,0)
. S @OUTARY@(ZI)=$$CLEAN(@INARY@(ZI)) ; CLEAN THE NODE
+"RTN","C0CMCCD",101,0)
+ Q
+"RTN","C0CMCCD",102,0)
+ ;
"RTN","C0CMCCD",103,0)
- Q
-"RTN","C0CMCCD",104,0)
- ;
-"RTN","C0CMCCD",105,0)
CLEAN(STR) ; extrinsic function; returns string
-"RTN","C0CMCCD",106,0)
+"RTN","C0CMCCD",104,0)
;; Removes all non printable characters from a string.
-"RTN","C0CMCCD",107,0)
+"RTN","C0CMCCD",105,0)
;; STR by Value
-"RTN","C0CMCCD",108,0)
+"RTN","C0CMCCD",106,0)
N TR,I
-"RTN","C0CMCCD",109,0)
+"RTN","C0CMCCD",107,0)
F I=0:1:31 S TR=$G(TR)_$C(I)
-"RTN","C0CMCCD",110,0)
+"RTN","C0CMCCD",108,0)
S TR=TR_$C(127)
-"RTN","C0CMCCD",111,0)
+"RTN","C0CMCCD",109,0)
QUIT $TR(STR,TR)
-"RTN","C0CMCCD",112,0)
+"RTN","C0CMCCD",110,0)
;
-"RTN","C0CMCCD",113,0)
+"RTN","C0CMCCD",111,0)
STRIPTXT(OUTARY,ZARY) ; STRIPS THE "TEXT" PORTION OUT OF AN XML FILE
-"RTN","C0CMCCD",114,0)
+"RTN","C0CMCCD",112,0)
; THIS IS USED TO DELETE THE NARATIVE HTML OUT OF THE CCD XML FILES BECAUSE
-"RTN","C0CMCCD",115,0)
+"RTN","C0CMCCD",113,0)
; THEY DO NOT WORK RIGHT WITH THE PARSER
-"RTN","C0CMCCD",116,0)
+"RTN","C0CMCCD",114,0)
;N ZWRK,ZBLD,ZI ; WORK ARRAY,BUILD ARRAY, AND COUNTER
-"RTN","C0CMCCD",117,0)
+"RTN","C0CMCCD",115,0)
S ZI=$O(@ZARY@("")) ; GET FIRST LINE NUMBER
-"RTN","C0CMCCD",118,0)
+"RTN","C0CMCCD",116,0)
D C0CBEGIN("ZWRK",ZI) ; INSERT FIRST LINE IN WORK ARRAY
-"RTN","C0CMCCD",119,0)
+"RTN","C0CMCCD",117,0)
F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH LINE OF THE ARRAY
-"RTN","C0CMCCD",120,0)
+"RTN","C0CMCCD",118,0)
. I $O(@ZARY@(ZI))="" D Q ; AT THE END
-"RTN","C0CMCCD",121,0)
+"RTN","C0CMCCD",119,0)
. . D C0CEND("ZWRK",ZI) ; INCLUDE LAST LINE IN WORK ARRAY
-"RTN","C0CMCCD",122,0)
+"RTN","C0CMCCD",120,0)
. I ZI=1 D C0CBEGIN("ZWRK",ZI) ; START WITH FIRST LINE
-"RTN","C0CMCCD",123,0)
+"RTN","C0CMCCD",121,0)
. I @ZARY@(ZI)["" D C0CBEGIN("ZWRK",ZI+1) ;NEXT LINE IS A BEGIN
-"RTN","C0CMCCD",125,0)
+"RTN","C0CMCCD",123,0)
S ZI=""
-"RTN","C0CMCCD",126,0)
+"RTN","C0CMCCD",124,0)
F S ZI=$O(ZWRK(ZI)) Q:ZI="" D ; MAKE A BUILD LIST FROM THE WORK ARRAY
-"RTN","C0CMCCD",127,0)
+"RTN","C0CMCCD",125,0)
. D QUEUE^C0CXPATH("ZBLD",ZARY,$P(ZWRK(ZI),"^",1),$P(ZWRK(ZI),"^",2))
-"RTN","C0CMCCD",128,0)
+"RTN","C0CMCCD",126,0)
D BUILD^C0CXPATH("ZBLD",OUTARY) ; BUILD NEW ARRAY WITHOUT TEXT SECTIONS
-"RTN","C0CMCCD",129,0)
+"RTN","C0CMCCD",127,0)
K @OUTARY@(0) ; GET RID OF THE LINE COUNT
+"RTN","C0CMCCD",128,0)
+ Q
+"RTN","C0CMCCD",129,0)
+ ;
"RTN","C0CMCCD",130,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)
+"RTN","C0CMCCD",131,0)
N ZI
-"RTN","C0CMCCD",134,0)
+"RTN","C0CMCCD",132,0)
S ZI=$O(@ZA@(""),-1)
-"RTN","C0CMCCD",135,0)
+"RTN","C0CMCCD",133,0)
I ZI="" S ZI=1
-"RTN","C0CMCCD",136,0)
+"RTN","C0CMCCD",134,0)
E S ZI=ZI+1 ; INCREMENT COUNT IN WORK ARRAY
-"RTN","C0CMCCD",137,0)
+"RTN","C0CMCCD",135,0)
S $P(@ZA@(ZI),"^",1)=LN
+"RTN","C0CMCCD",136,0)
+ Q
+"RTN","C0CMCCD",137,0)
+ ;
"RTN","C0CMCCD",138,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)
+"RTN","C0CMCCD",139,0)
N ZI
-"RTN","C0CMCCD",142,0)
+"RTN","C0CMCCD",140,0)
S ZI=$O(@ZB@(""),-1)
-"RTN","C0CMCCD",143,0)
+"RTN","C0CMCCD",141,0)
I ZI="" S ZI=1
-"RTN","C0CMCCD",144,0)
+"RTN","C0CMCCD",142,0)
S $P(@ZB@(ZI),"^",2)=LN
+"RTN","C0CMCCD",143,0)
+ Q
+"RTN","C0CMCCD",144,0)
+ ;
"RTN","C0CMCCD",145,0)
- Q
-"RTN","C0CMCCD",146,0)
- ;
-"RTN","C0CMCCD",147,0)
SEPARATE(OUTARY,INARY) ; SEPARATES XPATH VARIABLES ACCORDING TO THEIR
-"RTN","C0CMCCD",148,0)
+"RTN","C0CMCCD",146,0)
; ROOT ; /Problems/etc/etc goes to @OUTARY@("Problems","/Problems/etc/etc")
-"RTN","C0CMCCD",149,0)
+"RTN","C0CMCCD",147,0)
S ZI=""
-"RTN","C0CMCCD",150,0)
+"RTN","C0CMCCD",148,0)
F S ZI=$O(@INARY@(ZI)) Q:ZI="" D ; FOR EACH ELEMENT OF THE ARRAY
-"RTN","C0CMCCD",151,0)
+"RTN","C0CMCCD",149,0)
. I $P(ZI,"//",2)'="" D ; FOR NON-BODY ENTRIES
-"RTN","C0CMCCD",152,0)
+"RTN","C0CMCCD",150,0)
. . S ZJ=$P(ZI,"/",4) ; things like From Patient Actor
-"RTN","C0CMCCD",153,0)
+"RTN","C0CMCCD",151,0)
. E D ; FOR BODY PARTS
-"RTN","C0CMCCD",154,0)
+"RTN","C0CMCCD",152,0)
. . S ZJ=$P(ZI,"/",2) ;
-"RTN","C0CMCCD",155,0)
+"RTN","C0CMCCD",153,0)
. . I ZJ="" S ZJ=$P(ZI,"/",3) ;
-"RTN","C0CMCCD",156,0)
+"RTN","C0CMCCD",154,0)
. S @OUTARY@(ZJ,ZI)=$G(@INARY@(ZI)) ;FIX THIS FOR MULTILINE COMMENTS
-"RTN","C0CMCCD",157,0)
+"RTN","C0CMCCD",155,0)
Q
-"RTN","C0CMCCD",158,0)
+"RTN","C0CMCCD",156,0)
;
-"RTN","C0CMCCD",159,0)
+"RTN","C0CMCCD",157,0)
FINDTID ; FIND TEMPLATE IDS IN DOM 1
-"RTN","C0CMCCD",160,0)
+"RTN","C0CMCCD",158,0)
S C0CDOCID=1
-"RTN","C0CMCCD",161,0)
+"RTN","C0CMCCD",159,0)
S ZD=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
-"RTN","C0CMCCD",162,0)
+"RTN","C0CMCCD",160,0)
S ZN=""
-"RTN","C0CMCCD",163,0)
+"RTN","C0CMCCD",161,0)
S CURSEC=""
-"RTN","C0CMCCD",164,0)
+"RTN","C0CMCCD",162,0)
S TID=""
-"RTN","C0CMCCD",165,0)
+"RTN","C0CMCCD",163,0)
F S ZN=$O(@ZD@(ZN)) Q:ZN="" D ;
-"RTN","C0CMCCD",166,0)
+"RTN","C0CMCCD",164,0)
. I $$TAG(ZN)="root" D ;
-"RTN","C0CMCCD",167,0)
+"RTN","C0CMCCD",165,0)
. . I $$TAG($$PARENT(ZN))="templateId" D ; ONLY LOOKING FOR TEMPLATES
-"RTN","C0CMCCD",168,0)
+"RTN","C0CMCCD",166,0)
. . . S ZG=$$PARENT($$PARENT(ZN))
-"RTN","C0CMCCD",169,0)
+"RTN","C0CMCCD",167,0)
. . . S ZG2=$$PARENT(ZG) ;COMPONENT THAT HOLDS THIS SECTION
-"RTN","C0CMCCD",170,0)
+"RTN","C0CMCCD",168,0)
. . . S CMT=$G(@ZD@(ZG,"X",1))
-"RTN","C0CMCCD",171,0)
+"RTN","C0CMCCD",169,0)
. . . I CMT="" S CMT="?"
-"RTN","C0CMCCD",172,0)
+"RTN","C0CMCCD",170,0)
. . . I $$TAG(ZG)="section" D ;START OF A SECTION
-"RTN","C0CMCCD",173,0)
+"RTN","C0CMCCD",171,0)
. . . . S CURSEC=$$PARENT(ZG)
-"RTN","C0CMCCD",174,0)
+"RTN","C0CMCCD",172,0)
. . . . S SECCMT=$G(@ZD@(CURSEC,"X",1))
-"RTN","C0CMCCD",175,0)
+"RTN","C0CMCCD",173,0)
. . . . I SECCMT="" S SECCMT="?"
-"RTN","C0CMCCD",176,0)
+"RTN","C0CMCCD",174,0)
. . . . S SECTID=$G(@ZD@(ZN,"T",1)) ;SECTION TEMPLATE ID
-"RTN","C0CMCCD",177,0)
+"RTN","C0CMCCD",175,0)
. . . S TID=$G(@ZD@(ZN,"T",1)) ;TEMPLATE ID
-"RTN","C0CMCCD",178,0)
+"RTN","C0CMCCD",176,0)
. . . I CURSEC'="" D ; IF WE ARE IN A SECTION
-"RTN","C0CMCCD",179,0)
+"RTN","C0CMCCD",177,0)
. . . . S CCDDIR(ZG2,CURSEC,$$TAG(ZG2),CMT,SECCMT)=TID
-"RTN","C0CMCCD",180,0)
+"RTN","C0CMCCD",178,0)
. . . . S DOMMAP(ZG2)=CURSEC_U_$$TAG(ZG2)_U_TID_U_SECTID
-"RTN","C0CMCCD",181,0)
+"RTN","C0CMCCD",179,0)
. . . W !,$$TAG(ZG2)," ",$G(@ZD@(ZG,"X",1))
-"RTN","C0CMCCD",182,0)
+"RTN","C0CMCCD",180,0)
. . . W " root ",ZN," ",@ZD@(ZN,"T",1)
-"RTN","C0CMCCD",183,0)
+"RTN","C0CMCCD",181,0)
Q
+"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)
-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)
+"RTN","C0CMCCD",186,0)
F S ZI=$O(DOMMAP(ZI)) Q:ZI="" D ; FOR EACH NODE IN THE MAP
-"RTN","C0CMCCD",189,0)
+"RTN","C0CMCCD",187,0)
. S ZJ=DOMMAP(ZI) ;
-"RTN","C0CMCCD",190,0)
+"RTN","C0CMCCD",188,0)
. S PARNODE=$P(ZJ,U,1) ;PARENT NODE
-"RTN","C0CMCCD",191,0)
+"RTN","C0CMCCD",189,0)
. S TAG=$P(ZJ,U,2) ;THIS TAG
-"RTN","C0CMCCD",192,0)
+"RTN","C0CMCCD",190,0)
. S TID=$P(ZJ,U,3) ;THIS TEMPLATE ID
-"RTN","C0CMCCD",193,0)
+"RTN","C0CMCCD",191,0)
. S PARTID=$P(ZJ,U,4) ;PARENT TEMPLATE ID
-"RTN","C0CMCCD",194,0)
+"RTN","C0CMCCD",192,0)
. S ZIEN=$O(^C0CXDS(178.101,"TID",TID,"")) ;THIS NODE IEN
-"RTN","C0CMCCD",195,0)
+"RTN","C0CMCCD",193,0)
. S PARIEN=$O(^C0CXDS(178.101,"TID",PARTID,"")) ;PARENT NODE IEN
-"RTN","C0CMCCD",196,0)
+"RTN","C0CMCCD",194,0)
. I ZI=PARNODE D ; IF THIS IS A SECTION NODE
-"RTN","C0CMCCD",197,0)
+"RTN","C0CMCCD",195,0)
. . S ALTTAG=$$GET1^DIQ(178.101,PARIEN_",",.03) ;ALT TAG FIELD FOR PARENT
-"RTN","C0CMCCD",198,0)
+"RTN","C0CMCCD",196,0)
. . S NAME=$$GET1^DIQ(178.101,ZIEN_",",.01) ;NAME OF THIS NODE'S TEMPLATE
-"RTN","C0CMCCD",199,0)
+"RTN","C0CMCCD",197,0)
. . W ZI," ",TAG," ",ALTTAG," ",NAME,!
-"RTN","C0CMCCD",200,0)
+"RTN","C0CMCCD",198,0)
. . S C0CTAGS(ZI)=ALTTAG
-"RTN","C0CMCCD",201,0)
+"RTN","C0CMCCD",199,0)
. E D ; NOT A SECTION NODE
-"RTN","C0CMCCD",202,0)
+"RTN","C0CMCCD",200,0)
. . N ZJ S ZJ=""
-"RTN","C0CMCCD",203,0)
+"RTN","C0CMCCD",201,0)
. . S ZJ=$O(^C0CXDS(178.101,"D",PARIEN,ZIEN,"")) ;A WHEREUSED POINTER?
-"RTN","C0CMCCD",204,0)
+"RTN","C0CMCCD",202,0)
. . I ZJ'="" D ; THERE IS A NEW LABEL FOR THIS NODE
-"RTN","C0CMCCD",205,0)
+"RTN","C0CMCCD",203,0)
. . . N ZK
-"RTN","C0CMCCD",206,0)
+"RTN","C0CMCCD",204,0)
. . . S ZK=$$GET1^DIQ(178.111,ZJ_","_ZIEN_",",2)
-"RTN","C0CMCCD",207,0)
+"RTN","C0CMCCD",205,0)
. . . I ZK'="" D ;
-"RTN","C0CMCCD",208,0)
+"RTN","C0CMCCD",206,0)
. . . . W "FOUND ",ZK,!
-"RTN","C0CMCCD",209,0)
+"RTN","C0CMCCD",207,0)
. . . . S C0CTAGS(ZI)=ZK ; NEW TAG FOR INTERSECTION
-"RTN","C0CMCCD",210,0)
+"RTN","C0CMCCD",208,0)
Q
+"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)
-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",213,0)
+ Q
+"RTN","C0CMCCD",214,0)
+ ;
"RTN","C0CMCCD",215,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)
+"RTN","C0CMCCD",216,0)
S C0CCBK("TAG")="D ALTTAG^C0CMCCD(ZOID)"
+"RTN","C0CMCCD",217,0)
+ Q
+"RTN","C0CMCCD",218,0)
+ ;
"RTN","C0CMCCD",219,0)
- Q
-"RTN","C0CMCCD",220,0)
- ;
-"RTN","C0CMCCD",221,0)
OUTCCD(GARYIN) ; OUTPUT THE PARSED CCD TO A TEXT FILE
-"RTN","C0CMCCD",222,0)
+"RTN","C0CMCCD",220,0)
;D TEST3^C0CMXML
-"RTN","C0CMCCD",223,0)
+"RTN","C0CMCCD",221,0)
N ZT S ZT=$NA(^TMP("CCDOUT",$J))
-"RTN","C0CMCCD",224,0)
+"RTN","C0CMCCD",222,0)
N ZI,ZJ
-"RTN","C0CMCCD",225,0)
+"RTN","C0CMCCD",223,0)
S ZI=1 S ZJ=""
-"RTN","C0CMCCD",226,0)
+"RTN","C0CMCCD",224,0)
K @ZT
-"RTN","C0CMCCD",227,0)
+"RTN","C0CMCCD",225,0)
F S ZJ=$O(GARYIN(ZJ)) Q:ZJ="" D ;
-"RTN","C0CMCCD",228,0)
+"RTN","C0CMCCD",226,0)
. S @ZT@(ZI)=ZJ_"^"_GARYIN(ZJ)
-"RTN","C0CMCCD",229,0)
+"RTN","C0CMCCD",227,0)
. S ZI=ZI+1
-"RTN","C0CMCCD",230,0)
+"RTN","C0CMCCD",228,0)
S ONAME=$NA(@ZT@(1))
-"RTN","C0CMCCD",231,0)
+"RTN","C0CMCCD",229,0)
W $$OUTPUT^C0CXPATH(ONAME,"CCDOUT.txt","/home/vademo2/CCR")
-"RTN","C0CMCCD",232,0)
+"RTN","C0CMCCD",230,0)
K @ZT
+"RTN","C0CMCCD",231,0)
+ Q
+"RTN","C0CMCCD",232,0)
+ ;
"RTN","C0CMCCD",233,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)
+"RTN","C0CMCCD",234,0)
; ARRAY ELEMENTS LOOK LIKE:
-"RTN","C0CMCCD",237,0)
+"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",238,0)
+"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 ZF=178.101 ; FILE NUMBER FOR THE C0C XDS PROTOTYPE FILE
+ S DONE=0
"RTN","C0CMCCD",240,0)
- S ZI=$Q(@ZD@("")) ;FIRST ARRAY ELEMENT
+ F Q:DONE D ;
"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)
+"RTN","C0CMCCD",242,0)
. S ZJ=$QS(ZI,5)
-"RTN","C0CMCCD",245,0)
+"RTN","C0CMCCD",243,0)
. S ZJ=$E(ZJ,2,$L(ZJ)) ;STRIP THE LEADING SPACE
-"RTN","C0CMCCD",246,0)
+"RTN","C0CMCCD",244,0)
. S C0CFDA(ZF,"?+1,",.01)=ZJ
-"RTN","C0CMCCD",247,0)
+"RTN","C0CMCCD",245,0)
. S C0CFDA(ZF,"?+1,",.02)=$QS(ZI,4) ; TAG FOR THIS TEMPLATE
-"RTN","C0CMCCD",248,0)
+"RTN","C0CMCCD",246,0)
. S C0CFDA(ZF,"?+1,",1)=@ZI
-"RTN","C0CMCCD",249,0)
+"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)
- . S ZI=$Q(@ZI)
+ Q
"RTN","C0CMCCD",251,0)
- . I ZI="" S DONE=1
-"RTN","C0CMCCD",252,0)
- Q
-"RTN","C0CMCCD",253,0)
;
-"RTN","C0CMCCD",254,0)
+"RTN","C0CMCCD",252,0)
WHRUSD(ZD) ; UPDATE THE C0C XDS FILE WITH WHERE USED DATA FROM
-"RTN","C0CMCCD",255,0)
+"RTN","C0CMCCD",253,0)
; CCDDIR PASS BY NAME
-"RTN","C0CMCCD",256,0)
+"RTN","C0CMCCD",254,0)
; ARRAY ELEMENTS LOOK LIKE:
-"RTN","C0CMCCD",257,0)
+"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",258,0)
+"RTN","C0CMCCD",256,0)
;or CCDDIR(section node,sec name, cur node,cur tag,cur name)=templateId
-"RTN","C0CMCCD",259,0)
+"RTN","C0CMCCD",257,0)
S ZF=178.101 ; FILE NUMBER FOR THE C0C XDS PROTOTYPE FILE
-"RTN","C0CMCCD",260,0)
+"RTN","C0CMCCD",258,0)
S ZSF=178.111 ; WHERE USED SUBFILE OF C0C XDS PROTOTYPE FILE
-"RTN","C0CMCCD",261,0)
+"RTN","C0CMCCD",259,0)
S ZI=$Q(@ZD@("")) ;FIRST ARRAY ELEMENT
-"RTN","C0CMCCD",262,0)
+"RTN","C0CMCCD",260,0)
S DONE=0
-"RTN","C0CMCCD",263,0)
+"RTN","C0CMCCD",261,0)
F Q:DONE D ;
-"RTN","C0CMCCD",264,0)
+"RTN","C0CMCCD",262,0)
. W @ZI
-"RTN","C0CMCCD",265,0)
+"RTN","C0CMCCD",263,0)
. S ZIEN=$O(^C0CXDS(178.101,"TID",@ZI,"")) ; IEN FOR THIS NODE'S TEMPLATE
-"RTN","C0CMCCD",266,0)
+"RTN","C0CMCCD",264,0)
. W " IEN:",ZIEN
-"RTN","C0CMCCD",267,0)
+"RTN","C0CMCCD",265,0)
. S ZJ=$QS(ZI,2)
-"RTN","C0CMCCD",268,0)
+"RTN","C0CMCCD",266,0)
. S ZJ=$E(ZJ,2,$L(ZJ)) ;STRIP THE LEADING SPACE
-"RTN","C0CMCCD",269,0)
+"RTN","C0CMCCD",267,0)
. S ZPIEN=$O(^C0CXDS(178.101,"B",ZJ,"")) ; PARENT IEN
-"RTN","C0CMCCD",270,0)
+"RTN","C0CMCCD",268,0)
. W " PARENT IEN:",ZPIEN
-"RTN","C0CMCCD",271,0)
+"RTN","C0CMCCD",269,0)
. S ZTAG=$QS(ZI,4) ; TAG FOR THIS TEMPLATE
-"RTN","C0CMCCD",272,0)
+"RTN","C0CMCCD",270,0)
. W " TAG:",ZTAG,!
-"RTN","C0CMCCD",273,0)
+"RTN","C0CMCCD",271,0)
. I ZIEN'=ZPIEN D ; ONLY FOR CHILD TEMPLATES
-"RTN","C0CMCCD",274,0)
+"RTN","C0CMCCD",272,0)
. . S C0CFDA(ZSF,"?+1,"_ZIEN_",",.01)=ZPIEN ; NEW SUBFILE ENTRY WITH PAR PTR
-"RTN","C0CMCCD",275,0)
+"RTN","C0CMCCD",273,0)
. . S C0CFDA(ZSF,"?+1,"_ZIEN_",",1)=ZTAG ; TAG FOR NEW ENTRY
-"RTN","C0CMCCD",276,0)
+"RTN","C0CMCCD",274,0)
. . D UPDIE
-"RTN","C0CMCCD",277,0)
+"RTN","C0CMCCD",275,0)
. ;S C0CFDA(ZF,"?+1,",1)=@ZI
-"RTN","C0CMCCD",278,0)
+"RTN","C0CMCCD",276,0)
. ;D UPDIE
-"RTN","C0CMCCD",279,0)
+"RTN","C0CMCCD",277,0)
. S ZI=$Q(@ZI)
-"RTN","C0CMCCD",280,0)
+"RTN","C0CMCCD",278,0)
. I ZI="" S DONE=1
-"RTN","C0CMCCD",281,0)
+"RTN","C0CMCCD",279,0)
Q
-"RTN","C0CMCCD",282,0)
+"RTN","C0CMCCD",280,0)
;
-"RTN","C0CMCCD",283,0)
+"RTN","C0CMCCD",281,0)
UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
-"RTN","C0CMCCD",284,0)
+"RTN","C0CMCCD",282,0)
K ZERR
-"RTN","C0CMCCD",285,0)
+"RTN","C0CMCCD",283,0)
D CLEAN^DILF
-"RTN","C0CMCCD",286,0)
+"RTN","C0CMCCD",284,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)
+"RTN","C0CMCCD",285,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CMCCD",286,0)
K C0CFDA
-"RTN","C0CMCCD",292,0)
+"RTN","C0CMCCD",287,0)
Q
-"RTN","C0CMCCD",293,0)
+"RTN","C0CMCCD",288,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)
- ; This program is free software; you can redistribute it and/or modify
+ ; published by the Free Software Foundation, either version 3 of the
"RTN","C0CMED",8,0)
- ; it under the terms of the GNU General Public License as published by
+ ; License, or (at your option) any later version.
"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)
+"RTN","C0CMED",11,0)
; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","C0CMED",14,0)
+"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)
- ; GNU General Public License for more details.
+ ; You should have received a copy of the GNU Affero General Public License
"RTN","C0CMED",16,0)
- ;
+ ; along with this program. If not, see .
"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)
+"RTN","C0CMED",20,0)
; July 2008 - Initial Version/GPL
-"RTN","C0CMED",23,0)
+"RTN","C0CMED",21,0)
; July 2008 - March 2009 various revisions
-"RTN","C0CMED",24,0)
+"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)
- ;
-"RTN","C0CMED",26,0)
- Q
-"RTN","C0CMED",27,0)
EXTRACT(MEDXML,DFN,MEDOUTXML) ; Private; Extract medications into provided XML template
-"RTN","C0CMED",28,0)
+"RTN","C0CMED",26,0)
; DFN passed by reference
-"RTN","C0CMED",29,0)
+"RTN","C0CMED",27,0)
; MEDXML and MEDOUTXML are passed by Name
-"RTN","C0CMED",30,0)
+"RTN","C0CMED",28,0)
; MEDXML is the input template
-"RTN","C0CMED",31,0)
+"RTN","C0CMED",29,0)
; MEDOUTXML is the output template
-"RTN","C0CMED",32,0)
+"RTN","C0CMED",30,0)
; Both of them refer to ^TMP globals where the XML documents are stored
-"RTN","C0CMED",33,0)
+"RTN","C0CMED",31,0)
;
-"RTN","C0CMED",34,0)
+"RTN","C0CMED",32,0)
; -- This ep is the driver for extracting medications into the provided XML template
-"RTN","C0CMED",35,0)
+"RTN","C0CMED",33,0)
; 1. VA Outpatient Meds are in C0CMED1
-"RTN","C0CMED",36,0)
+"RTN","C0CMED",34,0)
; 2. VA Pending Meds are in C0CMED2
-"RTN","C0CMED",37,0)
+"RTN","C0CMED",35,0)
; 3. VA non-VA Meds are in C0CMED3
-"RTN","C0CMED",38,0)
+"RTN","C0CMED",36,0)
; 4. VA Inpatient IV Meds are in C0CMED4 (not functional)
-"RTN","C0CMED",39,0)
+"RTN","C0CMED",37,0)
; 5. VA Inpatient UD Meds are in C0CMED5 (doesn't exist yet)--March 2009
-"RTN","C0CMED",40,0)
+"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",41,0)
+"RTN","C0CMED",39,0)
;
-"RTN","C0CMED",42,0)
+"RTN","C0CMED",40,0)
; --Get parameters for meds
-"RTN","C0CMED",43,0)
+"RTN","C0CMED",41,0)
S @MEDOUTXML@(0)=0 ; By default, empty.
-"RTN","C0CMED",44,0)
+"RTN","C0CMED",42,0)
N C0CMFLAG
-"RTN","C0CMED",45,0)
+"RTN","C0CMED",43,0)
S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING")
-"RTN","C0CMED",46,0)
+"RTN","C0CMED",44,0)
W:$G(DEBUG) "Med Parameters: ",!
-"RTN","C0CMED",47,0)
+"RTN","C0CMED",45,0)
W:$G(DEBUG) "ALL: ",+C0CMFLAG,!
-"RTN","C0CMED",48,0)
+"RTN","C0CMED",46,0)
W:$G(DEBUG) "LIMIT: ",$P(C0CMFLAG,U,2),!
-"RTN","C0CMED",49,0)
+"RTN","C0CMED",47,0)
W:$G(DEBUG) "ACTIVE: ",$P(C0CMFLAG,U,3),!
-"RTN","C0CMED",50,0)
+"RTN","C0CMED",48,0)
W:$G(DEBUG) "PEND: ",$P(C0CMFLAG,U,4),!
-"RTN","C0CMED",51,0)
+"RTN","C0CMED",49,0)
; --Find out what system we are on and branch out...
-"RTN","C0CMED",52,0)
+"RTN","C0CMED",50,0)
W:$G(DEBUG) "Agenecy: ",$G(DUZ("AG"))
-"RTN","C0CMED",53,0)
+"RTN","C0CMED",51,0)
I $$RPMS^C0CUTIL() D RPMS QUIT
-"RTN","C0CMED",54,0)
+"RTN","C0CMED",52,0)
I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT
-"RTN","C0CMED",55,0)
-RPMS
-"RTN","C0CMED",56,0)
+"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 MEDCOUNT S MEDCOUNT=0
+ N HIST S HIST=$NA(^TMP($J,"MED","HIST")) ; Meds already dispensed
"RTN","C0CMED",58,0)
- K ^TMP($J,"MED")
+ N NVA S NVA=$NA(^TMP($J,"MED","NVA")) ; non-VA Meds
"RTN","C0CMED",59,0)
- N HIST S HIST=$NA(^TMP($J,"MED","HIST")) ; Meds already dispensed
-"RTN","C0CMED",60,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)
+"RTN","C0CMED",60,0)
D EXTRACT^C0CMED6(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds
-"RTN","C0CMED",63,0)
+"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)
- I @HIST@(0)>0 D
+ . W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
"RTN","C0CMED",65,0)
- . D CP^C0CXPATH(HIST,MEDOUTXML)
+ I @NVA@(0)>0 D
"RTN","C0CMED",66,0)
- . W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
+ . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,NVA)
"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",68,0)
+ . W:$G(DEBUG) "HAS NON-VA MEDS",!
+"RTN","C0CMED",69,0)
+ Q
"RTN","C0CMED",70,0)
- . W:$G(DEBUG) "HAS NON-VA MEDS",!
+VISTA ;
"RTN","C0CMED",71,0)
- Q
-"RTN","C0CMED",72,0)
-VISTA
-"RTN","C0CMED",73,0)
N MEDCOUNT S MEDCOUNT=0
-"RTN","C0CMED",74,0)
+"RTN","C0CMED",72,0)
K ^TMP($J,"MED")
-"RTN","C0CMED",75,0)
+"RTN","C0CMED",73,0)
N HIST S HIST=$NA(^TMP($J,"MED","HIST")) ; Meds already dispensed
-"RTN","C0CMED",76,0)
+"RTN","C0CMED",74,0)
N PEND S PEND=$NA(^TMP($J,"MED","PEND")) ; Pending Meds
-"RTN","C0CMED",77,0)
+"RTN","C0CMED",75,0)
N NVA S NVA=$NA(^TMP($J,"MED","NVA")) ; non-VA Meds
-"RTN","C0CMED",78,0)
+"RTN","C0CMED",76,0)
K @HIST K @PEND K @NVA ; MAKE SURE THEY ARE EMPTY
-"RTN","C0CMED",79,0)
+"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",80,0)
+"RTN","C0CMED",78,0)
; N IPIV ; Inpatient IV Meds
-"RTN","C0CMED",81,0)
+"RTN","C0CMED",79,0)
N IPUD S IPUD=$NA(^TMP($J,"MED","IPUD")) ; Inpatient UD Meds
-"RTN","C0CMED",82,0)
+"RTN","C0CMED",80,0)
K @IPUD
-"RTN","C0CMED",83,0)
+"RTN","C0CMED",81,0)
S @IPUD@(0)=0
-"RTN","C0CMED",84,0)
+"RTN","C0CMED",82,0)
;
-"RTN","C0CMED",85,0)
+"RTN","C0CMED",83,0)
D EXTRACT^C0CMED1(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds
-"RTN","C0CMED",86,0)
+"RTN","C0CMED",84,0)
D:$P(C0CMFLAG,U,4) EXTRACT^C0CMED2(MEDXML,DFN,PEND,.MEDCOUNT) ; Pending Meds
-"RTN","C0CMED",87,0)
+"RTN","C0CMED",85,0)
;D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds
-"RTN","C0CMED",88,0)
+"RTN","C0CMED",86,0)
D EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds GPL
-"RTN","C0CMED",89,0)
+"RTN","C0CMED",87,0)
D EXTRACT^C0CNMED4(MEDXML,DFN,IPUD,.MEDCOUNT) ; inpatient gpl
-"RTN","C0CMED",90,0)
- I @HIST@(0)>0 D
-"RTN","C0CMED",91,0)
+"RTN","C0CMED",88,0)
+ I @HIST@(0)>0 D
+"RTN","C0CMED",89,0)
. D CP^C0CXPATH(HIST,MEDOUTXML)
-"RTN","C0CMED",92,0)
+"RTN","C0CMED",90,0)
. W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
-"RTN","C0CMED",93,0)
- I @PEND@(0)>0 D
-"RTN","C0CMED",94,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",95,0)
+"RTN","C0CMED",93,0)
. E D CP^C0CXPATH(PEND,MEDOUTXML) ; No historical, just copy
-"RTN","C0CMED",96,0)
+"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)
- I @NVA@(0)>0 D
+ . E D CP^C0CXPATH(NVA,MEDOUTXML)
"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",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)
- I @IPUD@(0)>0 D
+ . E D CP^C0CXPATH(IPUD,MEDOUTXML)
"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)
+"RTN","C0CMED",103,0)
N ZI
-"RTN","C0CMED",106,0)
+"RTN","C0CMED",104,0)
S ZI=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
-"RTN","C0CMED",107,0)
+"RTN","C0CMED",105,0)
M ^TMP("C0CRIM","VARS",DFN,"MEDS")=@ZI ; PERSIST MEDS VARIABLES
-"RTN","C0CMED",108,0)
+"RTN","C0CMED",106,0)
K @ZI ; CLEAN UP MED MAP AFTER - GPL 10/10
-"RTN","C0CMED",109,0)
+"RTN","C0CMED",107,0)
K @PEND
-"RTN","C0CMED",110,0)
+"RTN","C0CMED",108,0)
K @HIST
-"RTN","C0CMED",111,0)
+"RTN","C0CMED",109,0)
K @NVA
-"RTN","C0CMED",112,0)
+"RTN","C0CMED",110,0)
K @IPUD
-"RTN","C0CMED",113,0)
+"RTN","C0CMED",111,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)
- ;
-"RTN","C0CMED1",12,0)
; This program is distributed in the hope that it will be useful,
-"RTN","C0CMED1",13,0)
+"RTN","C0CMED1",12,0)
; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","C0CMED1",14,0)
+"RTN","C0CMED1",13,0)
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+"RTN","C0CMED1",14,0)
+ ; 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 .
"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.
-"RTN","C0CMED1",20,0)
;
-"RTN","C0CMED1",21,0)
+"RTN","C0CMED1",19,0)
W "NO ENTRY FROM TOP",!
-"RTN","C0CMED1",22,0)
+"RTN","C0CMED1",20,0)
Q
+"RTN","C0CMED1",21,0)
+ ;
+"RTN","C0CMED1",22,0)
+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
-"RTN","C0CMED1",25,0)
- ;
-"RTN","C0CMED1",26,0)
; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","C0CMED1",27,0)
+"RTN","C0CMED1",25,0)
; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
-"RTN","C0CMED1",28,0)
+"RTN","C0CMED1",26,0)
;
-"RTN","C0CMED1",29,0)
+"RTN","C0CMED1",27,0)
; MEDS is return array from RPC.
-"RTN","C0CMED1",30,0)
+"RTN","C0CMED1",28,0)
; MAP is a mapping variable map (store result) for each med
-"RTN","C0CMED1",31,0)
+"RTN","C0CMED1",29,0)
; MED is holds each array element from MEDS(J), one medicine
-"RTN","C0CMED1",32,0)
+"RTN","C0CMED1",30,0)
; MEDCOUNT is a counter passed by Reference.
-"RTN","C0CMED1",33,0)
+"RTN","C0CMED1",31,0)
; FLAGS are: MEDALL(bool)^MEDLIMIT(int)^MEDACTIVE(bool)^MEDPENDING(bool)
-"RTN","C0CMED1",34,0)
+"RTN","C0CMED1",32,0)
; FLAGS are set-up in C0CMED.
-"RTN","C0CMED1",35,0)
+"RTN","C0CMED1",33,0)
;
-"RTN","C0CMED1",36,0)
+"RTN","C0CMED1",34,0)
; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
-"RTN","C0CMED1",37,0)
+"RTN","C0CMED1",35,0)
; med data available.
-"RTN","C0CMED1",38,0)
+"RTN","C0CMED1",36,0)
; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
-"RTN","C0CMED1",39,0)
+"RTN","C0CMED1",37,0)
; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
-"RTN","C0CMED1",40,0)
+"RTN","C0CMED1",38,0)
; D PARY^C0CXPATH(MINXML)
-"RTN","C0CMED1",41,0)
+"RTN","C0CMED1",39,0)
N MEDS,MAP
-"RTN","C0CMED1",42,0)
+"RTN","C0CMED1",40,0)
K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
-"RTN","C0CMED1",43,0)
+"RTN","C0CMED1",41,0)
N ALL S ALL=+FLAGS
-"RTN","C0CMED1",44,0)
+"RTN","C0CMED1",42,0)
N ACTIVE S ACTIVE=$P(FLAGS,U,3)
-"RTN","C0CMED1",45,0)
+"RTN","C0CMED1",43,0)
N PENDING S PENDING=$P(FLAGS,U,4) ;OHUM/RUT 3120504 ADDED FOR VALIDATION OF PENDING MEDICATIONS
-"RTN","C0CMED1",46,0)
+"RTN","C0CMED1",44,0)
; Below, X1 is today; X2 is the number of days we want to go back
-"RTN","C0CMED1",47,0)
+"RTN","C0CMED1",45,0)
; X is the result of this calculation using C^%DTC.
-"RTN","C0CMED1",48,0)
+"RTN","C0CMED1",46,0)
N X,X1,X2
-"RTN","C0CMED1",49,0)
+"RTN","C0CMED1",47,0)
S X1=DT
-"RTN","C0CMED1",50,0)
+"RTN","C0CMED1",48,0)
S X2=-$P($P(FLAGS,U,2),"-",2)
-"RTN","C0CMED1",51,0)
+"RTN","C0CMED1",49,0)
D C^%DTC
-"RTN","C0CMED1",52,0)
+"RTN","C0CMED1",50,0)
; I discovered that I shouldn't put an ending date (last parameter)
-"RTN","C0CMED1",53,0)
+"RTN","C0CMED1",51,0)
; because it seems that it will get meds whose beginning is after X but
-"RTN","C0CMED1",54,0)
+"RTN","C0CMED1",52,0)
; whose exipriation is before the ending date.
-"RTN","C0CMED1",55,0)
+"RTN","C0CMED1",53,0)
D RX^PSO52API(DFN,"CCDCCR","","","",X,"")
-"RTN","C0CMED1",56,0)
+"RTN","C0CMED1",54,0)
M MEDS=^TMP($J,"CCDCCR",DFN)
-"RTN","C0CMED1",57,0)
+"RTN","C0CMED1",55,0)
; @(0) contains the number of meds or -1^NO DATA FOUND
-"RTN","C0CMED1",58,0)
+"RTN","C0CMED1",56,0)
; If it is -1, we quit.
-"RTN","C0CMED1",59,0)
+"RTN","C0CMED1",57,0)
I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 Q
-"RTN","C0CMED1",60,0)
- ZWRITE:$G(DEBUG) MEDS
-"RTN","C0CMED1",61,0)
+"RTN","C0CMED1",58,0)
+ ; ZWRITE:$G(DEBUG) MEDS
+"RTN","C0CMED1",59,0)
N RXIEN S RXIEN=0
-"RTN","C0CMED1",62,0)
+"RTN","C0CMED1",60,0)
F S RXIEN=$O(MEDS(RXIEN)) Q:$G(RXIEN)="" D ; FOR EACH MEDICATION IN THE LIST
-"RTN","C0CMED1",63,0)
+"RTN","C0CMED1",61,0)
. N MED M MED=MEDS(RXIEN)
-"RTN","C0CMED1",64,0)
+"RTN","C0CMED1",62,0)
. I 'ALL,ACTIVE,$P(MED(100),U,2)'="ACTIVE" QUIT
-"RTN","C0CMED1",65,0)
- . I 'ALL,PENDING,$P(MED(100),U,2)'="PENDING" QUIT ;OHUM/RUT 3120504 ADDED FOR VALIDATION OF PENDING MEDICATIONS
-"RTN","C0CMED1",66,0)
+"RTN","C0CMED1",63,0)
+ . I 'ALL,PENDING,$P(MED(100),U,2)'="PENDING" QUIT ;OHUM/RUT 3120504 ADDED FOR VALIDATION OF PENDING MEDICATIONS
+"RTN","C0CMED1",64,0)
. S MEDCOUNT=MEDCOUNT+1
-"RTN","C0CMED1",67,0)
+"RTN","C0CMED1",65,0)
. W:$G(DEBUG) "RXIEN IS ",RXIEN,!
-"RTN","C0CMED1",68,0)
+"RTN","C0CMED1",66,0)
. S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
-"RTN","C0CMED1",69,0)
+"RTN","C0CMED1",67,0)
. ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED
-"RTN","C0CMED1",70,0)
+"RTN","C0CMED1",68,0)
. W:$G(DEBUG) "MAP= ",MAP,!
-"RTN","C0CMED1",71,0)
+"RTN","C0CMED1",69,0)
. S @MAP@("MEDOBJECTID")="MED"_MEDCOUNT ; MEDCOUNT FOR ID
-"RTN","C0CMED1",72,0)
+"RTN","C0CMED1",70,0)
. ; S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
-"RTN","C0CMED1",73,0)
+"RTN","C0CMED1",71,0)
. S @MAP@("MEDISSUEDATETXT")="Issue Date"
-"RTN","C0CMED1",74,0)
+"RTN","C0CMED1",72,0)
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(1),U))
-"RTN","C0CMED1",75,0)
+"RTN","C0CMED1",73,0)
. S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
-"RTN","C0CMED1",76,0)
+"RTN","C0CMED1",74,0)
. S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P($G(MED(101)),U))
-"RTN","C0CMED1",77,0)
+"RTN","C0CMED1",75,0)
. S @MAP@("MEDRXNOTXT")="Prescription Number"
-"RTN","C0CMED1",78,0)
+"RTN","C0CMED1",76,0)
. S @MAP@("MEDRXNO")=MED(.01)
-"RTN","C0CMED1",79,0)
+"RTN","C0CMED1",77,0)
. S @MAP@("MEDTYPETEXT")="Medication"
-"RTN","C0CMED1",80,0)
+"RTN","C0CMED1",78,0)
. S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses
-"RTN","C0CMED1",81,0)
+"RTN","C0CMED1",79,0)
. S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
-"RTN","C0CMED1",82,0)
+"RTN","C0CMED1",80,0)
. S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
-"RTN","C0CMED1",83,0)
+"RTN","C0CMED1",81,0)
. S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
-"RTN","C0CMED1",84,0)
+"RTN","C0CMED1",82,0)
. ; 12/30/08: I will be using RxNorm for coding...
-"RTN","C0CMED1",85,0)
+"RTN","C0CMED1",83,0)
. ; 176.001 is the file for Concepts; 176.003 is the file for
-"RTN","C0CMED1",86,0)
+"RTN","C0CMED1",84,0)
. ; sources (i.e. for RxNorm Version)
-"RTN","C0CMED1",87,0)
+"RTN","C0CMED1",85,0)
. ;
-"RTN","C0CMED1",88,0)
+"RTN","C0CMED1",86,0)
. ; We need the VUID first for the National Drug File entry first
-"RTN","C0CMED1",89,0)
+"RTN","C0CMED1",87,0)
. ; We get the VUID of the drug, by looking up the VA Product entry
-"RTN","C0CMED1",90,0)
+"RTN","C0CMED1",88,0)
. ; (file 50.68) using the call NDF^PSS50, returned in node 22.
-"RTN","C0CMED1",91,0)
+"RTN","C0CMED1",89,0)
. ; Field 99.99 is the VUID.
-"RTN","C0CMED1",92,0)
+"RTN","C0CMED1",90,0)
. ;
-"RTN","C0CMED1",93,0)
+"RTN","C0CMED1",91,0)
. ; We use the VUID to look up the RxNorm in file 176.001; same idea.
-"RTN","C0CMED1",94,0)
+"RTN","C0CMED1",92,0)
. ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
-"RTN","C0CMED1",95,0)
+"RTN","C0CMED1",93,0)
. ; $$GET1^DIQ.
-"RTN","C0CMED1",96,0)
+"RTN","C0CMED1",94,0)
. ;
-"RTN","C0CMED1",97,0)
+"RTN","C0CMED1",95,0)
. ; I get the RxNorm name and version from the RxNorm Sources (file
-"RTN","C0CMED1",98,0)
+"RTN","C0CMED1",96,0)
. ; 176.003), by searching for "RXNORM", then get the data.
-"RTN","C0CMED1",99,0)
+"RTN","C0CMED1",97,0)
. N MEDIEN S MEDIEN=$P(MED(6),U)
-"RTN","C0CMED1",100,0)
+"RTN","C0CMED1",98,0)
. D NDF^PSS50(MEDIEN,,,,,"NDF")
-"RTN","C0CMED1",101,0)
+"RTN","C0CMED1",99,0)
. N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
-"RTN","C0CMED1",102,0)
+"RTN","C0CMED1",100,0)
. N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
-"RTN","C0CMED1",103,0)
+"RTN","C0CMED1",101,0)
. N VAPROD S VAPROD=$P(NDFDATA(22),U)
-"RTN","C0CMED1",104,0)
+"RTN","C0CMED1",102,0)
. ;
-"RTN","C0CMED1",105,0)
+"RTN","C0CMED1",103,0)
. ; NDFIEN is not necessarily defined; it won't be if the drug
-"RTN","C0CMED1",106,0)
+"RTN","C0CMED1",104,0)
. ; is not matched to the national drug file (e.g. if the drug is
-"RTN","C0CMED1",107,0)
+"RTN","C0CMED1",105,0)
. ; new on the market, compounded, or is a fake drug [blue pill].
-"RTN","C0CMED1",108,0)
+"RTN","C0CMED1",106,0)
. ; To protect against failure, I will put an if/else block
-"RTN","C0CMED1",109,0)
+"RTN","C0CMED1",107,0)
. ;
-"RTN","C0CMED1",110,0)
+"RTN","C0CMED1",108,0)
. N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
-"RTN","C0CMED1",111,0)
+"RTN","C0CMED1",109,0)
. I NDFIEN,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet.
-"RTN","C0CMED1",112,0)
+"RTN","C0CMED1",110,0)
. . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
-"RTN","C0CMED1",113,0)
+"RTN","C0CMED1",111,0)
. . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
-"RTN","C0CMED1",114,0)
+"RTN","C0CMED1",112,0)
. . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
-"RTN","C0CMED1",115,0)
+"RTN","C0CMED1",113,0)
. . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
-"RTN","C0CMED1",116,0)
+"RTN","C0CMED1",114,0)
. . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
-"RTN","C0CMED1",117,0)
+"RTN","C0CMED1",115,0)
. . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
-"RTN","C0CMED1",118,0)
+"RTN","C0CMED1",116,0)
. ;
-"RTN","C0CMED1",119,0)
+"RTN","C0CMED1",117,0)
. E S (RXNORM,RXNNAME,RXNVER)=""
-"RTN","C0CMED1",120,0)
+"RTN","C0CMED1",118,0)
. ; End if/else block
-"RTN","C0CMED1",121,0)
+"RTN","C0CMED1",119,0)
. S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
-"RTN","C0CMED1",122,0)
+"RTN","C0CMED1",120,0)
. S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
-"RTN","C0CMED1",123,0)
+"RTN","C0CMED1",121,0)
. S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
-"RTN","C0CMED1",124,0)
+"RTN","C0CMED1",122,0)
. ;
-"RTN","C0CMED1",125,0)
+"RTN","C0CMED1",123,0)
. S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
-"RTN","C0CMED1",126,0)
+"RTN","C0CMED1",124,0)
. D DOSE^PSS50(MEDIEN,,,,,"DOSE")
-"RTN","C0CMED1",127,0)
+"RTN","C0CMED1",125,0)
. N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
-"RTN","C0CMED1",128,0)
+"RTN","C0CMED1",126,0)
. S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
-"RTN","C0CMED1",129,0)
+"RTN","C0CMED1",127,0)
. S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
-"RTN","C0CMED1",130,0)
+"RTN","C0CMED1",128,0)
. ; Units, concentration, etc, come from another call
-"RTN","C0CMED1",131,0)
+"RTN","C0CMED1",129,0)
. ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
-"RTN","C0CMED1",132,0)
+"RTN","C0CMED1",130,0)
. ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
-"RTN","C0CMED1",133,0)
+"RTN","C0CMED1",131,0)
. ; NDF Entry IEN, and VA Product IEN
-"RTN","C0CMED1",134,0)
+"RTN","C0CMED1",132,0)
. ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
-"RTN","C0CMED1",135,0)
+"RTN","C0CMED1",133,0)
. ; These have been collected above.
-"RTN","C0CMED1",136,0)
+"RTN","C0CMED1",134,0)
. N CONCDATA
-"RTN","C0CMED1",137,0)
+"RTN","C0CMED1",135,0)
. ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
-"RTN","C0CMED1",138,0)
+"RTN","C0CMED1",136,0)
. ; and this will crash the call. So...
-"RTN","C0CMED1",139,0)
+"RTN","C0CMED1",137,0)
. I NDFIEN="" S CONCDATA=""
-"RTN","C0CMED1",140,0)
+"RTN","C0CMED1",138,0)
. E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
-"RTN","C0CMED1",141,0)
+"RTN","C0CMED1",139,0)
. S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
-"RTN","C0CMED1",142,0)
+"RTN","C0CMED1",140,0)
. S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
-"RTN","C0CMED1",143,0)
+"RTN","C0CMED1",141,0)
. S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
-"RTN","C0CMED1",144,0)
+"RTN","C0CMED1",142,0)
. S @MAP@("MEDQUANTITYVALUE")=MED(7)
-"RTN","C0CMED1",145,0)
+"RTN","C0CMED1",143,0)
. ; Oddly, there is no easy place to find the dispense unit.
-"RTN","C0CMED1",146,0)
+"RTN","C0CMED1",144,0)
. ; It's not included in the original call, so we have to go to the drug file.
-"RTN","C0CMED1",147,0)
+"RTN","C0CMED1",145,0)
. ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
-"RTN","C0CMED1",148,0)
+"RTN","C0CMED1",146,0)
. ; Node 14.5 is the Dispense Unit
-"RTN","C0CMED1",149,0)
+"RTN","C0CMED1",147,0)
. D DATA^PSS50(MEDIEN,,,,,"QTY")
-"RTN","C0CMED1",150,0)
+"RTN","C0CMED1",148,0)
. N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
-"RTN","C0CMED1",151,0)
+"RTN","C0CMED1",149,0)
. S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
-"RTN","C0CMED1",152,0)
+"RTN","C0CMED1",150,0)
. ;
-"RTN","C0CMED1",153,0)
+"RTN","C0CMED1",151,0)
. ; --- START OF DIRECTIONS ---
-"RTN","C0CMED1",154,0)
+"RTN","C0CMED1",152,0)
. ; Sig data not in any API :-( Oh yes, you can get the whole thing, but...
-"RTN","C0CMED1",155,0)
+"RTN","C0CMED1",153,0)
. ; we want the compoenents.
-"RTN","C0CMED1",156,0)
+"RTN","C0CMED1",154,0)
. ; It's in node 6 of ^PSRX(IEN)
-"RTN","C0CMED1",157,0)
+"RTN","C0CMED1",155,0)
. ; So, here we go again
-"RTN","C0CMED1",158,0)
+"RTN","C0CMED1",156,0)
. ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE
-"RTN","C0CMED1",159,0)
+"RTN","C0CMED1",157,0)
. ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)
-"RTN","C0CMED1",160,0)
+"RTN","C0CMED1",158,0)
. ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE
-"RTN","C0CMED1",161,0)
+"RTN","C0CMED1",159,0)
. ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^
-"RTN","C0CMED1",162,0)
+"RTN","C0CMED1",160,0)
. ;
-"RTN","C0CMED1",163,0)
+"RTN","C0CMED1",161,0)
. N DIRNUM S DIRNUM=0 ; Sigline number
-"RTN","C0CMED1",164,0)
+"RTN","C0CMED1",162,0)
. S DIRCNT=0 ; COUNT OF MULTIPLE DIRECTIONS
-"RTN","C0CMED1",165,0)
+"RTN","C0CMED1",163,0)
. F S DIRNUM=$O(^PSRX(RXIEN,6,DIRNUM)) Q:DIRNUM="" D
-"RTN","C0CMED1",166,0)
+"RTN","C0CMED1",164,0)
. . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
-"RTN","C0CMED1",167,0)
+"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",168,0)
+"RTN","C0CMED1",166,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05.
-"RTN","C0CMED1",169,0)
+"RTN","C0CMED1",167,0)
. . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,DIRNUM,0)
-"RTN","C0CMED1",170,0)
+"RTN","C0CMED1",168,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$P(SIGDATA,U,9)
-"RTN","C0CMED1",171,0)
+"RTN","C0CMED1",169,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$P(SIGDATA,U,1)
-"RTN","C0CMED1",172,0)
+"RTN","C0CMED1",170,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
-"RTN","C0CMED1",173,0)
+"RTN","C0CMED1",171,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient
-"RTN","C0CMED1",174,0)
+"RTN","C0CMED1",172,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient
-"RTN","C0CMED1",175,0)
+"RTN","C0CMED1",173,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient
-"RTN","C0CMED1",176,0)
+"RTN","C0CMED1",174,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)
-"RTN","C0CMED1",177,0)
+"RTN","C0CMED1",175,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)
-"RTN","C0CMED1",178,0)
+"RTN","C0CMED1",176,0)
. . ; Invervals... again another call.
-"RTN","C0CMED1",179,0)
+"RTN","C0CMED1",177,0)
. . ; In the wisdom of the original programmers, the schedule is a free text field
-"RTN","C0CMED1",180,0)
+"RTN","C0CMED1",178,0)
. . ; However, it gets translated by a call to the administration schedule file
-"RTN","C0CMED1",181,0)
+"RTN","C0CMED1",179,0)
. . ; to see if that schedule exists.
-"RTN","C0CMED1",182,0)
+"RTN","C0CMED1",180,0)
. . ; That's the same thing I am going to do.
-"RTN","C0CMED1",183,0)
+"RTN","C0CMED1",181,0)
. . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
-"RTN","C0CMED1",184,0)
+"RTN","C0CMED1",182,0)
. . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
-"RTN","C0CMED1",185,0)
+"RTN","C0CMED1",183,0)
. . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in.
-"RTN","C0CMED1",186,0)
+"RTN","C0CMED1",184,0)
. . ; So...
-"RTN","C0CMED1",187,0)
+"RTN","C0CMED1",185,0)
. . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE")
-"RTN","C0CMED1",188,0)
+"RTN","C0CMED1",186,0)
. . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
-"RTN","C0CMED1",189,0)
+"RTN","C0CMED1",187,0)
. . N INTERVAL
-"RTN","C0CMED1",190,0)
+"RTN","C0CMED1",188,0)
. . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
-"RTN","C0CMED1",191,0)
+"RTN","C0CMED1",189,0)
. . E D
-"RTN","C0CMED1",192,0)
+"RTN","C0CMED1",190,0)
. . . N SUB S SUB=$O(SCHEDATA(0))
-"RTN","C0CMED1",193,0)
+"RTN","C0CMED1",191,0)
. . . S INTERVAL=SCHEDATA(SUB,2)
-"RTN","C0CMED1",194,0)
+"RTN","C0CMED1",192,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
-"RTN","C0CMED1",195,0)
+"RTN","C0CMED1",193,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
-"RTN","C0CMED1",196,0)
+"RTN","C0CMED1",194,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$P(SIGDATA,U,5)
-"RTN","C0CMED1",197,0)
+"RTN","C0CMED1",195,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
-"RTN","C0CMED1",198,0)
+"RTN","C0CMED1",196,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN"
-"RTN","C0CMED1",199,0)
+"RTN","C0CMED1",197,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
-"RTN","C0CMED1",200,0)
+"RTN","C0CMED1",198,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
-"RTN","C0CMED1",201,0)
+"RTN","C0CMED1",199,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
-"RTN","C0CMED1",202,0)
+"RTN","C0CMED1",200,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
-"RTN","C0CMED1",203,0)
+"RTN","C0CMED1",201,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
-"RTN","C0CMED1",204,0)
+"RTN","C0CMED1",202,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
-"RTN","C0CMED1",205,0)
+"RTN","C0CMED1",203,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
-"RTN","C0CMED1",206,0)
+"RTN","C0CMED1",204,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")=""
-"RTN","C0CMED1",207,0)
+"RTN","C0CMED1",205,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
-"RTN","C0CMED1",208,0)
+"RTN","C0CMED1",206,0)
. . N DIRMOD S DIRMOD=$P(SIGDATA,U,6)
-"RTN","C0CMED1",209,0)
+"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",209,0)
+ . ; --- END OF DIRECTIONS ---
"RTN","C0CMED1",210,0)
. ;
"RTN","C0CMED1",211,0)
- . ; --- END OF DIRECTIONS ---
-"RTN","C0CMED1",212,0)
- . ;
-"RTN","C0CMED1",213,0)
. ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE"
-"RTN","C0CMED1",214,0)
+"RTN","C0CMED1",212,0)
. S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0))
-"RTN","C0CMED1",215,0)
+"RTN","C0CMED1",213,0)
. ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command"
-"RTN","C0CMED1",216,0)
+"RTN","C0CMED1",214,0)
. S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0))
-"RTN","C0CMED1",217,0)
+"RTN","C0CMED1",215,0)
. S @MAP@("MEDRFNO")=MED(9)
-"RTN","C0CMED1",218,0)
+"RTN","C0CMED1",216,0)
. N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
-"RTN","C0CMED1",219,0)
+"RTN","C0CMED1",217,0)
. K @RESULT
-"RTN","C0CMED1",220,0)
+"RTN","C0CMED1",218,0)
. D MAP^C0CXPATH(MINXML,MAP,RESULT)
-"RTN","C0CMED1",221,0)
+"RTN","C0CMED1",219,0)
. ; MAPPING DIRECTIONS
-"RTN","C0CMED1",222,0)
+"RTN","C0CMED1",220,0)
. N DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
-"RTN","C0CMED1",223,0)
+"RTN","C0CMED1",221,0)
. N DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
-"RTN","C0CMED1",224,0)
+"RTN","C0CMED1",222,0)
. D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
-"RTN","C0CMED1",225,0)
+"RTN","C0CMED1",223,0)
. D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
-"RTN","C0CMED1",226,0)
+"RTN","C0CMED1",224,0)
. ; N MDZ1,MDZNA
-"RTN","C0CMED1",227,0)
+"RTN","C0CMED1",225,0)
. I DIRCNT>0 D ; IF THERE ARE DIRCTIONS
-"RTN","C0CMED1",228,0)
+"RTN","C0CMED1",226,0)
. . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION
-"RTN","C0CMED1",229,0)
+"RTN","C0CMED1",227,0)
. . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
-"RTN","C0CMED1",230,0)
+"RTN","C0CMED1",228,0)
. . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
-"RTN","C0CMED1",231,0)
+"RTN","C0CMED1",229,0)
. . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
-"RTN","C0CMED1",232,0)
+"RTN","C0CMED1",230,0)
. I MEDCOUNT=1 D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
-"RTN","C0CMED1",233,0)
+"RTN","C0CMED1",231,0)
. E D INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
-"RTN","C0CMED1",234,0)
+"RTN","C0CMED1",232,0)
N MEDTMP,MEDI
-"RTN","C0CMED1",235,0)
+"RTN","C0CMED1",233,0)
D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","C0CMED1",236,0)
+"RTN","C0CMED1",234,0)
I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","C0CMED1",237,0)
+"RTN","C0CMED1",235,0)
. W "MEDICATION MISSING ",!
-"RTN","C0CMED1",238,0)
+"RTN","C0CMED1",236,0)
. F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","C0CMED1",239,0)
+"RTN","C0CMED1",237,0)
Q
-"RTN","C0CMED1",240,0)
+"RTN","C0CMED1",238,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)
- ;
-"RTN","C0CMED2",12,0)
; This program is distributed in the hope that it will be useful,
-"RTN","C0CMED2",13,0)
+"RTN","C0CMED2",12,0)
; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","C0CMED2",14,0)
+"RTN","C0CMED2",13,0)
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+"RTN","C0CMED2",14,0)
+ ; 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 .
"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.
-"RTN","C0CMED2",20,0)
;
-"RTN","C0CMED2",21,0)
+"RTN","C0CMED2",19,0)
W "NO ENTRY FROM TOP",!
-"RTN","C0CMED2",22,0)
+"RTN","C0CMED2",20,0)
Q
+"RTN","C0CMED2",21,0)
+ ;
+"RTN","C0CMED2",22,0)
+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
-"RTN","C0CMED2",25,0)
- ;
-"RTN","C0CMED2",26,0)
; MINXML is the Input XML Template, passed by name
-"RTN","C0CMED2",27,0)
+"RTN","C0CMED2",25,0)
; DFN is Patient IEN (by Value)
-"RTN","C0CMED2",28,0)
+"RTN","C0CMED2",26,0)
; OUTXML is the resultant XML (by Name)
-"RTN","C0CMED2",29,0)
+"RTN","C0CMED2",27,0)
; MEDCOUNT is the current count of extracted meds, passed by Reference
-"RTN","C0CMED2",30,0)
+"RTN","C0CMED2",28,0)
;
-"RTN","C0CMED2",31,0)
+"RTN","C0CMED2",29,0)
; MEDS is return array from RPC.
-"RTN","C0CMED2",32,0)
+"RTN","C0CMED2",30,0)
; MAP is a mapping variable map (store result) for each med
-"RTN","C0CMED2",33,0)
+"RTN","C0CMED2",31,0)
; MED is holds each array element from MEDS, one medicine
-"RTN","C0CMED2",34,0)
+"RTN","C0CMED2",32,0)
;
-"RTN","C0CMED2",35,0)
+"RTN","C0CMED2",33,0)
; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending
-"RTN","C0CMED2",36,0)
+"RTN","C0CMED2",34,0)
; meds data available.
-"RTN","C0CMED2",37,0)
+"RTN","C0CMED2",35,0)
; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
-"RTN","C0CMED2",38,0)
+"RTN","C0CMED2",36,0)
; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
-"RTN","C0CMED2",39,0)
+"RTN","C0CMED2",37,0)
; File for pending meds is 52.41
-"RTN","C0CMED2",40,0)
+"RTN","C0CMED2",38,0)
; Unfortuantely, API does not supply us with any useful info beyond
-"RTN","C0CMED2",41,0)
+"RTN","C0CMED2",39,0)
; the IEN in 52.41, and the Med Name, and route.
-"RTN","C0CMED2",42,0)
+"RTN","C0CMED2",40,0)
; So, most of the info is going to get pulled from 52.41.
-"RTN","C0CMED2",43,0)
+"RTN","C0CMED2",41,0)
N MEDS,MAP
-"RTN","C0CMED2",44,0)
+"RTN","C0CMED2",42,0)
K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
-"RTN","C0CMED2",45,0)
+"RTN","C0CMED2",43,0)
D PEN^PSO5241(DFN,"CCDCCR")
-"RTN","C0CMED2",46,0)
+"RTN","C0CMED2",44,0)
M MEDS=^TMP($J,"CCDCCR",DFN)
-"RTN","C0CMED2",47,0)
+"RTN","C0CMED2",45,0)
; @(0) contains the number of meds or -1^NO DATA FOUND
-"RTN","C0CMED2",48,0)
+"RTN","C0CMED2",46,0)
; If it is -1, we quit.
-"RTN","C0CMED2",49,0)
+"RTN","C0CMED2",47,0)
I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
-"RTN","C0CMED2",50,0)
- ZWRITE:$G(DEBUG) MEDS
-"RTN","C0CMED2",51,0)
+"RTN","C0CMED2",48,0)
+ ; ZWRITE:$G(DEBUG) MEDS
+"RTN","C0CMED2",49,0)
N RXIEN S RXIEN=0
-"RTN","C0CMED2",52,0)
+"RTN","C0CMED2",50,0)
N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED IN THIS SECTION FOR MERGING
-"RTN","C0CMED2",53,0)
+"RTN","C0CMED2",51,0)
F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B" D ; FOR EACH MEDICATION IN THE LIST
-"RTN","C0CMED2",54,0)
+"RTN","C0CMED2",52,0)
. I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT ; Dont' want refill request as a "pending" order
-"RTN","C0CMED2",55,0)
+"RTN","C0CMED2",53,0)
. S MEDCOUNT=MEDCOUNT+1
-"RTN","C0CMED2",56,0)
+"RTN","C0CMED2",54,0)
. I DEBUG W "RXIEN IS ",RXIEN,!
-"RTN","C0CMED2",57,0)
+"RTN","C0CMED2",55,0)
. S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
-"RTN","C0CMED2",58,0)
+"RTN","C0CMED2",56,0)
. ; K @MAP DON'T KILL MAP HERE, IT IS DONE IN C0CMED
-"RTN","C0CMED2",59,0)
+"RTN","C0CMED2",57,0)
. I DEBUG W "MAP= ",MAP,!
-"RTN","C0CMED2",60,0)
+"RTN","C0CMED2",58,0)
. N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
-"RTN","C0CMED2",61,0)
+"RTN","C0CMED2",59,0)
. S @MAP@("MEDOBJECTID")="MED_PENDING"_MEDCOUNT ; MEDCOUNT FOR ID
-"RTN","C0CMED2",62,0)
+"RTN","C0CMED2",60,0)
. ; S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN
-"RTN","C0CMED2",63,0)
+"RTN","C0CMED2",61,0)
. S @MAP@("MEDISSUEDATETXT")="Issue Date"
-"RTN","C0CMED2",64,0)
+"RTN","C0CMED2",62,0)
. ; Field 6 is "Effective date", and we pull it in timson format w/ I
-"RTN","C0CMED2",65,0)
+"RTN","C0CMED2",63,0)
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($$GET1^DIQ(52.41,RXIEN,6,"I"),"DT")
-"RTN","C0CMED2",66,0)
+"RTN","C0CMED2",64,0)
. ; Med never filled; next 4 fields are not applicable.
-"RTN","C0CMED2",67,0)
+"RTN","C0CMED2",65,0)
. S @MAP@("MEDLASTFILLDATETXT")=""
-"RTN","C0CMED2",68,0)
+"RTN","C0CMED2",66,0)
. S @MAP@("MEDLASTFILLDATE")=""
-"RTN","C0CMED2",69,0)
+"RTN","C0CMED2",67,0)
. S @MAP@("MEDRXNOTXT")=""
-"RTN","C0CMED2",70,0)
+"RTN","C0CMED2",68,0)
. S @MAP@("MEDRXNO")=""
-"RTN","C0CMED2",71,0)
+"RTN","C0CMED2",69,0)
. S @MAP@("MEDTYPETEXT")="Medication"
-"RTN","C0CMED2",72,0)
+"RTN","C0CMED2",70,0)
. S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses
-"RTN","C0CMED2",73,0)
+"RTN","C0CMED2",71,0)
. S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds
-"RTN","C0CMED2",74,0)
+"RTN","C0CMED2",72,0)
. S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I")
-"RTN","C0CMED2",75,0)
+"RTN","C0CMED2",73,0)
. S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2)
-"RTN","C0CMED2",76,0)
+"RTN","C0CMED2",74,0)
. ; NDC not supplied in API, but is rather trivial to obtain
-"RTN","C0CMED2",77,0)
+"RTN","C0CMED2",75,0)
. ; MED(11) piece 1 has the IEN of the drug (file 50)
-"RTN","C0CMED2",78,0)
+"RTN","C0CMED2",76,0)
. ; IEN is field 31 in the drug file.
-"RTN","C0CMED2",79,0)
+"RTN","C0CMED2",77,0)
. ;
-"RTN","C0CMED2",80,0)
+"RTN","C0CMED2",78,0)
. ; MEDIEN (node 11 in the returned output) might not necessarily be defined
-"RTN","C0CMED2",81,0)
+"RTN","C0CMED2",79,0)
. ; It is not defined when a dose in not chosen in CPRS. There is a long
-"RTN","C0CMED2",82,0)
+"RTN","C0CMED2",80,0)
. ; series of fields that depend on it. We will use If and Else to deal
-"RTN","C0CMED2",83,0)
+"RTN","C0CMED2",81,0)
. ; with that
-"RTN","C0CMED2",84,0)
+"RTN","C0CMED2",82,0)
. N MEDIEN S MEDIEN=$P(MED(11),U)
-"RTN","C0CMED2",85,0)
+"RTN","C0CMED2",83,0)
. I +MEDIEN>0 D ; start of if/else block
-"RTN","C0CMED2",86,0)
+"RTN","C0CMED2",84,0)
. . ; 12/30/08: I will be using RxNorm for coding...
-"RTN","C0CMED2",87,0)
+"RTN","C0CMED2",85,0)
. . ; 176.001 is the file for Concepts; 176.003 is the file for
-"RTN","C0CMED2",88,0)
+"RTN","C0CMED2",86,0)
. . ; sources (i.e. for RxNorm Version)
-"RTN","C0CMED2",89,0)
+"RTN","C0CMED2",87,0)
. . ;
-"RTN","C0CMED2",90,0)
+"RTN","C0CMED2",88,0)
. . ; We need the VUID first for the National Drug File entry first
-"RTN","C0CMED2",91,0)
+"RTN","C0CMED2",89,0)
. . ; We get the VUID of the drug, by looking up the VA Product entry
-"RTN","C0CMED2",92,0)
+"RTN","C0CMED2",90,0)
. . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
-"RTN","C0CMED2",93,0)
+"RTN","C0CMED2",91,0)
. . ; Field 99.99 is the VUID.
-"RTN","C0CMED2",94,0)
+"RTN","C0CMED2",92,0)
. . ;
-"RTN","C0CMED2",95,0)
+"RTN","C0CMED2",93,0)
. . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
-"RTN","C0CMED2",96,0)
+"RTN","C0CMED2",94,0)
. . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
-"RTN","C0CMED2",97,0)
+"RTN","C0CMED2",95,0)
. . ; $$GET1^DIQ.
-"RTN","C0CMED2",98,0)
+"RTN","C0CMED2",96,0)
. . ;
-"RTN","C0CMED2",99,0)
+"RTN","C0CMED2",97,0)
. . ; I get the RxNorm name and version from the RxNorm Sources (file
-"RTN","C0CMED2",100,0)
+"RTN","C0CMED2",98,0)
. . ; 176.003), by searching for "RXNORM", then get the data.
-"RTN","C0CMED2",101,0)
+"RTN","C0CMED2",99,0)
. . D NDF^PSS50(MEDIEN,,,,,"NDF")
-"RTN","C0CMED2",102,0)
+"RTN","C0CMED2",100,0)
. . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
-"RTN","C0CMED2",103,0)
+"RTN","C0CMED2",101,0)
. . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
-"RTN","C0CMED2",104,0)
+"RTN","C0CMED2",102,0)
. . N VAPROD S VAPROD=$P(NDFDATA(22),U)
-"RTN","C0CMED2",105,0)
+"RTN","C0CMED2",103,0)
. . ;
-"RTN","C0CMED2",106,0)
+"RTN","C0CMED2",104,0)
. . ; NDFIEN is not necessarily defined; it won't be if the drug
-"RTN","C0CMED2",107,0)
+"RTN","C0CMED2",105,0)
. . ; is not matched to the national drug file (e.g. if the drug is
-"RTN","C0CMED2",108,0)
+"RTN","C0CMED2",106,0)
. . ; new on the market, compounded, or is a fake drug [blue pill].
-"RTN","C0CMED2",109,0)
+"RTN","C0CMED2",107,0)
. . ; To protect against failure, I will put an if/else block
-"RTN","C0CMED2",110,0)
+"RTN","C0CMED2",108,0)
. . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
-"RTN","C0CMED2",111,0)
+"RTN","C0CMED2",109,0)
. . I NDFIEN,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet.
-"RTN","C0CMED2",112,0)
+"RTN","C0CMED2",110,0)
. . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
-"RTN","C0CMED2",113,0)
+"RTN","C0CMED2",111,0)
. . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
-"RTN","C0CMED2",114,0)
+"RTN","C0CMED2",112,0)
. . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
-"RTN","C0CMED2",115,0)
+"RTN","C0CMED2",113,0)
. . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
-"RTN","C0CMED2",116,0)
+"RTN","C0CMED2",114,0)
. . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
-"RTN","C0CMED2",117,0)
+"RTN","C0CMED2",115,0)
. . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
-"RTN","C0CMED2",118,0)
+"RTN","C0CMED2",116,0)
. . ;
-"RTN","C0CMED2",119,0)
+"RTN","C0CMED2",117,0)
. . E S (RXNORM,RXNNAME,RXNVER)=""
-"RTN","C0CMED2",120,0)
+"RTN","C0CMED2",118,0)
. . ; End if/else block
-"RTN","C0CMED2",121,0)
+"RTN","C0CMED2",119,0)
. . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
-"RTN","C0CMED2",122,0)
+"RTN","C0CMED2",120,0)
. . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
-"RTN","C0CMED2",123,0)
+"RTN","C0CMED2",121,0)
. . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
-"RTN","C0CMED2",124,0)
+"RTN","C0CMED2",122,0)
. . ;
-"RTN","C0CMED2",125,0)
+"RTN","C0CMED2",123,0)
. . S @MAP@("MEDBRANDNAMETEXT")=""
-"RTN","C0CMED2",126,0)
+"RTN","C0CMED2",124,0)
. . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
-"RTN","C0CMED2",127,0)
+"RTN","C0CMED2",125,0)
. . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
-"RTN","C0CMED2",128,0)
+"RTN","C0CMED2",126,0)
. . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
-"RTN","C0CMED2",129,0)
+"RTN","C0CMED2",127,0)
. . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
-"RTN","C0CMED2",130,0)
+"RTN","C0CMED2",128,0)
. . ; Units, concentration, etc, come from another call
-"RTN","C0CMED2",131,0)
+"RTN","C0CMED2",129,0)
. . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
-"RTN","C0CMED2",132,0)
+"RTN","C0CMED2",130,0)
. . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
-"RTN","C0CMED2",133,0)
+"RTN","C0CMED2",131,0)
. . ; NDF Entry IEN, and VA Product Name
-"RTN","C0CMED2",134,0)
+"RTN","C0CMED2",132,0)
. . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
-"RTN","C0CMED2",135,0)
+"RTN","C0CMED2",133,0)
. . ; Documented in the same manual; executed above.
-"RTN","C0CMED2",136,0)
+"RTN","C0CMED2",134,0)
. . N CONCDATA
-"RTN","C0CMED2",137,0)
+"RTN","C0CMED2",135,0)
. . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
-"RTN","C0CMED2",138,0)
+"RTN","C0CMED2",136,0)
. . ; and this will crash the call. So...
-"RTN","C0CMED2",139,0)
+"RTN","C0CMED2",137,0)
. . I NDFIEN="" S CONCDATA=""
-"RTN","C0CMED2",140,0)
+"RTN","C0CMED2",138,0)
. . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
-"RTN","C0CMED2",141,0)
+"RTN","C0CMED2",139,0)
. . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
-"RTN","C0CMED2",142,0)
+"RTN","C0CMED2",140,0)
. . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
-"RTN","C0CMED2",143,0)
+"RTN","C0CMED2",141,0)
. . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
-"RTN","C0CMED2",144,0)
+"RTN","C0CMED2",142,0)
. . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12)
-"RTN","C0CMED2",145,0)
+"RTN","C0CMED2",143,0)
. . ; Oddly, there is no easy place to find the dispense unit.
-"RTN","C0CMED2",146,0)
+"RTN","C0CMED2",144,0)
. . ; It's not included in the original call, so we have to go to the drug file.
-"RTN","C0CMED2",147,0)
+"RTN","C0CMED2",145,0)
. . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
-"RTN","C0CMED2",148,0)
+"RTN","C0CMED2",146,0)
. . ; Node 14.5 is the Dispense Unit
-"RTN","C0CMED2",149,0)
+"RTN","C0CMED2",147,0)
. . D DATA^PSS50(MEDIEN,,,,,"QTY")
-"RTN","C0CMED2",150,0)
+"RTN","C0CMED2",148,0)
. . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
-"RTN","C0CMED2",151,0)
+"RTN","C0CMED2",149,0)
. . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
-"RTN","C0CMED2",152,0)
+"RTN","C0CMED2",150,0)
. E D
-"RTN","C0CMED2",153,0)
+"RTN","C0CMED2",151,0)
. . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
-"RTN","C0CMED2",154,0)
+"RTN","C0CMED2",152,0)
. . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
-"RTN","C0CMED2",155,0)
+"RTN","C0CMED2",153,0)
. . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""
-"RTN","C0CMED2",156,0)
+"RTN","C0CMED2",154,0)
. . S @MAP@("MEDBRANDNAMETEXT")=""
-"RTN","C0CMED2",157,0)
+"RTN","C0CMED2",155,0)
. . S @MAP@("MEDSTRENGTHVALUE")=""
-"RTN","C0CMED2",158,0)
+"RTN","C0CMED2",156,0)
. . S @MAP@("MEDSTRENGTHUNIT")=""
-"RTN","C0CMED2",159,0)
+"RTN","C0CMED2",157,0)
. . S @MAP@("MEDFORMTEXT")=""
-"RTN","C0CMED2",160,0)
+"RTN","C0CMED2",158,0)
. . S @MAP@("MEDCONCVALUE")=""
-"RTN","C0CMED2",161,0)
+"RTN","C0CMED2",159,0)
. . S @MAP@("MEDCONCUNIT")=""
-"RTN","C0CMED2",162,0)
+"RTN","C0CMED2",160,0)
. . S @MAP@("MEDSIZETEXT")=""
-"RTN","C0CMED2",163,0)
+"RTN","C0CMED2",161,0)
. . S @MAP@("MEDQUANTITYVALUE")=""
-"RTN","C0CMED2",164,0)
+"RTN","C0CMED2",162,0)
. . S @MAP@("MEDQUANTITYUNIT")=""
-"RTN","C0CMED2",165,0)
+"RTN","C0CMED2",163,0)
. ; end of if/else block
-"RTN","C0CMED2",166,0)
+"RTN","C0CMED2",164,0)
. ;
-"RTN","C0CMED2",167,0)
+"RTN","C0CMED2",165,0)
. ; --- START OF DIRECTIONS ---
-"RTN","C0CMED2",168,0)
+"RTN","C0CMED2",166,0)
. ; Sig data is not in any API. We obtain it using the IEN from
-"RTN","C0CMED2",169,0)
+"RTN","C0CMED2",167,0)
. ; the PEN API to file 52.41. It's in field 3, which is a multiple.
-"RTN","C0CMED2",170,0)
+"RTN","C0CMED2",168,0)
. ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT)
-"RTN","C0CMED2",171,0)
+"RTN","C0CMED2",169,0)
. K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call
-"RTN","C0CMED2",172,0)
+"RTN","C0CMED2",170,0)
. D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG")
-"RTN","C0CMED2",173,0)
+"RTN","C0CMED2",171,0)
. N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman.
-"RTN","C0CMED2",174,0)
+"RTN","C0CMED2",172,0)
. ; FMSIGNUM gets outputted as "IEN,RXIEN,".
-"RTN","C0CMED2",175,0)
+"RTN","C0CMED2",173,0)
. ; DIRNUM will be first piece for IEN.
-"RTN","C0CMED2",176,0)
+"RTN","C0CMED2",174,0)
. ; DIRNUM is the proper Sigline numer.
-"RTN","C0CMED2",177,0)
+"RTN","C0CMED2",175,0)
. ; SIGDATA is the simplfied array. Subscripts are really field numbers
-"RTN","C0CMED2",178,0)
+"RTN","C0CMED2",176,0)
. ; in subfile 52.413.
-"RTN","C0CMED2",179,0)
+"RTN","C0CMED2",177,0)
. N DIRCNT S DIRCNT=0 ; COUNT OF DIRECTIONS
-"RTN","C0CMED2",180,0)
+"RTN","C0CMED2",178,0)
. F S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM="" D
-"RTN","C0CMED2",181,0)
+"RTN","C0CMED2",179,0)
. . N DIRNUM S DIRNUM=$P(FMSIGNUM,",")
-"RTN","C0CMED2",182,0)
+"RTN","C0CMED2",180,0)
. . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
-"RTN","C0CMED2",183,0)
+"RTN","C0CMED2",181,0)
. . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM)
-"RTN","C0CMED2",184,0)
+"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",185,0)
+"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",186,0)
+"RTN","C0CMED2",184,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05.
-"RTN","C0CMED2",187,0)
+"RTN","C0CMED2",185,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=SIGDATA(13)
-"RTN","C0CMED2",188,0)
+"RTN","C0CMED2",186,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=SIGDATA(8)
-"RTN","C0CMED2",189,0)
+"RTN","C0CMED2",187,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
-"RTN","C0CMED2",190,0)
+"RTN","C0CMED2",188,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient
-"RTN","C0CMED2",191,0)
+"RTN","C0CMED2",189,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient
-"RTN","C0CMED2",192,0)
+"RTN","C0CMED2",190,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient
-"RTN","C0CMED2",193,0)
+"RTN","C0CMED2",191,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=SIGDATA(10)
-"RTN","C0CMED2",194,0)
+"RTN","C0CMED2",192,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=SIGDATA(1)
-"RTN","C0CMED2",195,0)
+"RTN","C0CMED2",193,0)
. . ; Invervals... again another call.
-"RTN","C0CMED2",196,0)
+"RTN","C0CMED2",194,0)
. . ; The schedule is a free text field
-"RTN","C0CMED2",197,0)
+"RTN","C0CMED2",195,0)
. . ; However, it gets translated by a call to the administration
-"RTN","C0CMED2",198,0)
+"RTN","C0CMED2",196,0)
. . ; schedule file to see if that schedule exists.
-"RTN","C0CMED2",199,0)
+"RTN","C0CMED2",197,0)
. . ; That's the same thing I am going to do.
-"RTN","C0CMED2",200,0)
+"RTN","C0CMED2",198,0)
. . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
-"RTN","C0CMED2",201,0)
+"RTN","C0CMED2",199,0)
. . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
-"RTN","C0CMED2",202,0)
+"RTN","C0CMED2",200,0)
. . ; I looked), PSSFT is the name,
-"RTN","C0CMED2",203,0)
+"RTN","C0CMED2",201,0)
. . ; and list is the ^TMP name to store the data in.
-"RTN","C0CMED2",204,0)
+"RTN","C0CMED2",202,0)
. . ; Also, freqency may have "PRN" in it, so strip that out
-"RTN","C0CMED2",205,0)
+"RTN","C0CMED2",203,0)
. . N FREQ S FREQ=SIGDATA(1)
-"RTN","C0CMED2",206,0)
+"RTN","C0CMED2",204,0)
. . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp
-"RTN","C0CMED2",207,0)
+"RTN","C0CMED2",205,0)
. . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE")
-"RTN","C0CMED2",208,0)
+"RTN","C0CMED2",206,0)
. . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
-"RTN","C0CMED2",209,0)
+"RTN","C0CMED2",207,0)
. . N INTERVAL
-"RTN","C0CMED2",210,0)
+"RTN","C0CMED2",208,0)
. . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
-"RTN","C0CMED2",211,0)
+"RTN","C0CMED2",209,0)
. . E D
-"RTN","C0CMED2",212,0)
+"RTN","C0CMED2",210,0)
. . . N SUB S SUB=$O(SCHEDATA(0))
-"RTN","C0CMED2",213,0)
+"RTN","C0CMED2",211,0)
. . . S INTERVAL=SCHEDATA(SUB,2)
-"RTN","C0CMED2",214,0)
+"RTN","C0CMED2",212,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
-"RTN","C0CMED2",215,0)
+"RTN","C0CMED2",213,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
-"RTN","C0CMED2",216,0)
+"RTN","C0CMED2",214,0)
. . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months
-"RTN","C0CMED2",217,0)
+"RTN","C0CMED2",215,0)
. . N DUR S DUR=SIGDATA(2)
-"RTN","C0CMED2",218,0)
+"RTN","C0CMED2",216,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR))
-"RTN","C0CMED2",219,0)
+"RTN","C0CMED2",217,0)
. . N DURUNIT S DURUNIT=$E(DUR)
-"RTN","C0CMED2",220,0)
+"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",221,0)
+"RTN","C0CMED2",219,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=SIGDATA(1)["PRN"
-"RTN","C0CMED2",222,0)
+"RTN","C0CMED2",220,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
-"RTN","C0CMED2",223,0)
+"RTN","C0CMED2",221,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
-"RTN","C0CMED2",224,0)
+"RTN","C0CMED2",222,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
-"RTN","C0CMED2",225,0)
+"RTN","C0CMED2",223,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
-"RTN","C0CMED2",226,0)
+"RTN","C0CMED2",224,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
-"RTN","C0CMED2",227,0)
+"RTN","C0CMED2",225,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
-"RTN","C0CMED2",228,0)
+"RTN","C0CMED2",226,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
-"RTN","C0CMED2",229,0)
+"RTN","C0CMED2",227,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field
-"RTN","C0CMED2",230,0)
+"RTN","C0CMED2",228,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
-"RTN","C0CMED2",231,0)
+"RTN","C0CMED2",229,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=SIGDATA(6)
+"RTN","C0CMED2",230,0)
+ . ;
+"RTN","C0CMED2",231,0)
+ . ; --- END OF DIRECTIONS ---
"RTN","C0CMED2",232,0)
. ;
"RTN","C0CMED2",233,0)
- . ; --- END OF DIRECTIONS ---
-"RTN","C0CMED2",234,0)
- . ;
-"RTN","C0CMED2",235,0)
. ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
-"RTN","C0CMED2",236,0)
+"RTN","C0CMED2",234,0)
. S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PI",1,0)) ;GPL
-"RTN","C0CMED2",237,0)
+"RTN","C0CMED2",235,0)
. ; W @MAP@("MEDPTINSTRUCTIONS"),!
-"RTN","C0CMED2",238,0)
+"RTN","C0CMED2",236,0)
. ; S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9"
-"RTN","C0CMED2",239,0)
+"RTN","C0CMED2",237,0)
. S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"SIG1",1,0)) ;GPL
-"RTN","C0CMED2",240,0)
+"RTN","C0CMED2",238,0)
. ; W @MAP@("MEDFULLFILLMENTINSTRUCTIONS"),!
-"RTN","C0CMED2",241,0)
+"RTN","C0CMED2",239,0)
. S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13)
-"RTN","C0CMED2",242,0)
+"RTN","C0CMED2",240,0)
. N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
-"RTN","C0CMED2",243,0)
+"RTN","C0CMED2",241,0)
. K @RESULT
-"RTN","C0CMED2",244,0)
+"RTN","C0CMED2",242,0)
. D MAP^C0CXPATH(MINXML,MAP,RESULT)
-"RTN","C0CMED2",245,0)
+"RTN","C0CMED2",243,0)
. ; D PARY^C0CXPATH(RESULT)
-"RTN","C0CMED2",246,0)
+"RTN","C0CMED2",244,0)
. ; MAPPING DIRECTIONS
-"RTN","C0CMED2",247,0)
+"RTN","C0CMED2",245,0)
. N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
-"RTN","C0CMED2",248,0)
+"RTN","C0CMED2",246,0)
. N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
-"RTN","C0CMED2",249,0)
+"RTN","C0CMED2",247,0)
. D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
-"RTN","C0CMED2",250,0)
+"RTN","C0CMED2",248,0)
. D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
-"RTN","C0CMED2",251,0)
+"RTN","C0CMED2",249,0)
. ; N MDZ1,MDZNA
-"RTN","C0CMED2",252,0)
+"RTN","C0CMED2",250,0)
. I DIRCNT>0 D ; IF THERE ARE DIRCTIONS
-"RTN","C0CMED2",253,0)
+"RTN","C0CMED2",251,0)
. . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION
-"RTN","C0CMED2",254,0)
+"RTN","C0CMED2",252,0)
. . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
-"RTN","C0CMED2",255,0)
+"RTN","C0CMED2",253,0)
. . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
-"RTN","C0CMED2",256,0)
+"RTN","C0CMED2",254,0)
. . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
-"RTN","C0CMED2",257,0)
+"RTN","C0CMED2",255,0)
. I MEDFIRST D ;
-"RTN","C0CMED2",258,0)
+"RTN","C0CMED2",256,0)
. . ;S MEDFIRST=0 ; RESET FIRST FLAG ;OHUM/RUT COMMENTED (1ST PENDING MEDICATION WAS GETTING DUPLICATED)
-"RTN","C0CMED2",259,0)
+"RTN","C0CMED2",257,0)
. . D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
-"RTN","C0CMED2",260,0)
+"RTN","C0CMED2",258,0)
. D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER
-"RTN","C0CMED2",261,0)
+"RTN","C0CMED2",259,0)
. I MEDFIRST S MEDFIRST=0 ;OHUM/RUT ADDED
-"RTN","C0CMED2",262,0)
+"RTN","C0CMED2",260,0)
N MEDTMP,MEDI
-"RTN","C0CMED2",263,0)
+"RTN","C0CMED2",261,0)
D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","C0CMED2",264,0)
+"RTN","C0CMED2",262,0)
I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","C0CMED2",265,0)
+"RTN","C0CMED2",263,0)
. W "Pending Medication MISSING ",!
-"RTN","C0CMED2",266,0)
+"RTN","C0CMED2",264,0)
. F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","C0CMED2",267,0)
+"RTN","C0CMED2",265,0)
Q
-"RTN","C0CMED2",268,0)
+"RTN","C0CMED2",266,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)
- ;
-"RTN","C0CMED3",12,0)
; This program is distributed in the hope that it will be useful,
-"RTN","C0CMED3",13,0)
+"RTN","C0CMED3",12,0)
; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","C0CMED3",14,0)
+"RTN","C0CMED3",13,0)
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+"RTN","C0CMED3",14,0)
+ ; 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 .
"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.
-"RTN","C0CMED3",20,0)
;
-"RTN","C0CMED3",21,0)
+"RTN","C0CMED3",19,0)
W "NO ENTRY FROM TOP",!
-"RTN","C0CMED3",22,0)
+"RTN","C0CMED3",20,0)
Q
+"RTN","C0CMED3",21,0)
+ ;
+"RTN","C0CMED3",22,0)
+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
-"RTN","C0CMED3",25,0)
- ;
-"RTN","C0CMED3",26,0)
; MINXML is the Input XML Template, (passed by name)
-"RTN","C0CMED3",27,0)
+"RTN","C0CMED3",25,0)
; DFN is Patient IEN (passed by value)
-"RTN","C0CMED3",28,0)
+"RTN","C0CMED3",26,0)
; OUTXML is the resultant XML (passed by name)
-"RTN","C0CMED3",29,0)
+"RTN","C0CMED3",27,0)
; MEDCOUNT is the number of Meds extracted so far (passed by reference)
-"RTN","C0CMED3",30,0)
+"RTN","C0CMED3",28,0)
;
-"RTN","C0CMED3",31,0)
+"RTN","C0CMED3",29,0)
; MEDS is return array from RPC.
-"RTN","C0CMED3",32,0)
+"RTN","C0CMED3",30,0)
; MAP is a mapping variable map (store result) for each med
-"RTN","C0CMED3",33,0)
+"RTN","C0CMED3",31,0)
; MED is holds each array element from MEDS, one medicine
-"RTN","C0CMED3",34,0)
+"RTN","C0CMED3",32,0)
;
-"RTN","C0CMED3",35,0)
+"RTN","C0CMED3",33,0)
; Non-VA meds don't have an API. They are stored in file 55, subfile 52.2
-"RTN","C0CMED3",36,0)
+"RTN","C0CMED3",34,0)
; Discontinued meds are indicated by the presence of a value in fields
-"RTN","C0CMED3",37,0)
+"RTN","C0CMED3",35,0)
; 5 or 6 (STATUS 1 or 2, and DISCONTINUED DATE)
-"RTN","C0CMED3",38,0)
+"RTN","C0CMED3",36,0)
; Will use Fileman API GETS^DIQ
-"RTN","C0CMED3",39,0)
+"RTN","C0CMED3",37,0)
;
-"RTN","C0CMED3",40,0)
+"RTN","C0CMED3",38,0)
N MEDS,MAP
-"RTN","C0CMED3",41,0)
+"RTN","C0CMED3",39,0)
K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
-"RTN","C0CMED3",42,0)
+"RTN","C0CMED3",40,0)
N NVA
-"RTN","C0CMED3",43,0)
+"RTN","C0CMED3",41,0)
D GETS^DIQ(55,DFN,"52.2*","IE","NVA") ; Output in NVA in FDA array format.
-"RTN","C0CMED3",44,0)
+"RTN","C0CMED3",42,0)
; If NVA does not exist, then patient has no non-VA meds
-"RTN","C0CMED3",45,0)
+"RTN","C0CMED3",43,0)
I $D(NVA)=0 S @OUTXML@(0)=0 QUIT
-"RTN","C0CMED3",46,0)
+"RTN","C0CMED3",44,0)
; Otherwise, we go on...
-"RTN","C0CMED3",47,0)
+"RTN","C0CMED3",45,0)
M MEDS=NVA(55.05)
-"RTN","C0CMED3",48,0)
+"RTN","C0CMED3",46,0)
; We are done with NVA
-"RTN","C0CMED3",49,0)
+"RTN","C0CMED3",47,0)
K NVA
-"RTN","C0CMED3",50,0)
+"RTN","C0CMED3",48,0)
;
-"RTN","C0CMED3",51,0)
- I DEBUG ZWRITE MEDS
-"RTN","C0CMED3",52,0)
+"RTN","C0CMED3",49,0)
+ ; I DEBUG ZWRITE MEDS
+"RTN","C0CMED3",50,0)
N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array.
-"RTN","C0CMED3",53,0)
+"RTN","C0CMED3",51,0)
N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED PROCESSED HERE
-"RTN","C0CMED3",54,0)
+"RTN","C0CMED3",52,0)
F S FDAIEN=$O(MEDS(FDAIEN)) Q:FDAIEN="" D ; FOR EACH MEDICATION IN THE LIST
-"RTN","C0CMED3",55,0)
+"RTN","C0CMED3",53,0)
. N MED M MED=MEDS(FDAIEN)
-"RTN","C0CMED3",56,0)
+"RTN","C0CMED3",54,0)
. I MED(5,"I")!MED(6,"I") QUIT ; If disconinued, we don't want to pull it.
-"RTN","C0CMED3",57,0)
+"RTN","C0CMED3",55,0)
. S MEDCOUNT=MEDCOUNT+1
-"RTN","C0CMED3",58,0)
+"RTN","C0CMED3",56,0)
. S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
-"RTN","C0CMED3",59,0)
+"RTN","C0CMED3",57,0)
. N RXIEN S RXIEN=$P(FDAIEN,",") ; First piece of FDAIEN is the number of the med for this patient
-"RTN","C0CMED3",60,0)
+"RTN","C0CMED3",58,0)
. I DEBUG W "RXIEN IS ",RXIEN,!
-"RTN","C0CMED3",61,0)
+"RTN","C0CMED3",59,0)
. I DEBUG W "MAP= ",MAP,!
-"RTN","C0CMED3",62,0)
+"RTN","C0CMED3",60,0)
. S @MAP@("MEDOBJECTID")="MED_OUTSIDE"_MEDCOUNT ; MEDCOUNT FOR ID
-"RTN","C0CMED3",63,0)
+"RTN","C0CMED3",61,0)
. S @MAP@("MEDISSUEDATETXT")="Documented Date"
-"RTN","C0CMED3",64,0)
+"RTN","C0CMED3",62,0)
. ; Field 6 is "Effective date", and we pull it in timson format w/ I
-"RTN","C0CMED3",65,0)
+"RTN","C0CMED3",63,0)
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL(MED(11,"I"),"DT")
-"RTN","C0CMED3",66,0)
+"RTN","C0CMED3",64,0)
. ; Med never filled; next 4 fields are not applicable.
-"RTN","C0CMED3",67,0)
+"RTN","C0CMED3",65,0)
. S @MAP@("MEDLASTFILLDATETXT")=""
-"RTN","C0CMED3",68,0)
+"RTN","C0CMED3",66,0)
. S @MAP@("MEDLASTFILLDATE")=""
-"RTN","C0CMED3",69,0)
+"RTN","C0CMED3",67,0)
. S @MAP@("MEDRXNOTXT")=""
-"RTN","C0CMED3",70,0)
+"RTN","C0CMED3",68,0)
. S @MAP@("MEDRXNO")=""
-"RTN","C0CMED3",71,0)
+"RTN","C0CMED3",69,0)
. S @MAP@("MEDTYPETEXT")="Medication"
-"RTN","C0CMED3",72,0)
+"RTN","C0CMED3",70,0)
. S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses
-"RTN","C0CMED3",73,0)
+"RTN","C0CMED3",71,0)
. S @MAP@("MEDSTATUSTEXT")="Active" ; nearest status for pending meds
-"RTN","C0CMED3",74,0)
+"RTN","C0CMED3",72,0)
. S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_MED(12,"I")
-"RTN","C0CMED3",75,0)
+"RTN","C0CMED3",73,0)
. S @MAP@("MEDPRODUCTNAMETEXT")=MED(.01,"E")
-"RTN","C0CMED3",76,0)
+"RTN","C0CMED3",74,0)
. ; NDC is field 31 in the drug file.
-"RTN","C0CMED3",77,0)
+"RTN","C0CMED3",75,0)
. ; The actual drug entry in the drug file (MEDIEN) is not necessarily supplied.
-"RTN","C0CMED3",78,0)
+"RTN","C0CMED3",76,0)
. ; It' node 1, internal form.
-"RTN","C0CMED3",79,0)
+"RTN","C0CMED3",77,0)
. N MEDIEN S MEDIEN=MED(1,"I")
-"RTN","C0CMED3",80,0)
+"RTN","C0CMED3",78,0)
. I +MEDIEN D ; start of if/else block
-"RTN","C0CMED3",81,0)
+"RTN","C0CMED3",79,0)
. . ; 12/30/08: I will be using RxNorm for coding...
-"RTN","C0CMED3",82,0)
+"RTN","C0CMED3",80,0)
. . ; 176.001 is the file for Concepts; 176.003 is the file for
-"RTN","C0CMED3",83,0)
+"RTN","C0CMED3",81,0)
. . ; sources (i.e. for RxNorm Version)
-"RTN","C0CMED3",84,0)
+"RTN","C0CMED3",82,0)
. . ;
-"RTN","C0CMED3",85,0)
+"RTN","C0CMED3",83,0)
. . ; We need the VUID first for the National Drug File entry first
-"RTN","C0CMED3",86,0)
+"RTN","C0CMED3",84,0)
. . ; We get the VUID of the drug, by looking up the VA Product entry
-"RTN","C0CMED3",87,0)
+"RTN","C0CMED3",85,0)
. . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
-"RTN","C0CMED3",88,0)
+"RTN","C0CMED3",86,0)
. . ; Field 99.99 is the VUID.
-"RTN","C0CMED3",89,0)
+"RTN","C0CMED3",87,0)
. . ;
-"RTN","C0CMED3",90,0)
+"RTN","C0CMED3",88,0)
. . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
-"RTN","C0CMED3",91,0)
+"RTN","C0CMED3",89,0)
. . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
-"RTN","C0CMED3",92,0)
+"RTN","C0CMED3",90,0)
. . ; $$GET1^DIQ.
-"RTN","C0CMED3",93,0)
+"RTN","C0CMED3",91,0)
. . ;
-"RTN","C0CMED3",94,0)
+"RTN","C0CMED3",92,0)
. . ; I get the RxNorm name and version from the RxNorm Sources (file
-"RTN","C0CMED3",95,0)
+"RTN","C0CMED3",93,0)
. . ; 176.003), by searching for "RXNORM", then get the data.
-"RTN","C0CMED3",96,0)
+"RTN","C0CMED3",94,0)
. . ; NDF^PSS50 ONLY EXISTS ON VISTA
-"RTN","C0CMED3",97,0)
+"RTN","C0CMED3",95,0)
. . N NDFDATA,NDFIEN,VAPROD
-"RTN","C0CMED3",98,0)
+"RTN","C0CMED3",96,0)
. . S NDFIEN=""
-"RTN","C0CMED3",99,0)
+"RTN","C0CMED3",97,0)
. . I '$$RPMS^C0CUTIL() D
-"RTN","C0CMED3",100,0)
+"RTN","C0CMED3",98,0)
. . . D NDF^PSS50(MEDIEN,,,,,"NDF")
-"RTN","C0CMED3",101,0)
+"RTN","C0CMED3",99,0)
. . . ;N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
-"RTN","C0CMED3",102,0)
+"RTN","C0CMED3",100,0)
. . . ;N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
-"RTN","C0CMED3",103,0)
+"RTN","C0CMED3",101,0)
. . . ;N VAPROD S VAPROD=$P(NDFDATA(22),U)
-"RTN","C0CMED3",104,0)
+"RTN","C0CMED3",102,0)
. . . M NDFDATA=^TMP($J,"NDF",MEDIEN)
-"RTN","C0CMED3",105,0)
+"RTN","C0CMED3",103,0)
. . . S NDFIEN=$P(NDFDATA(20),U)
-"RTN","C0CMED3",106,0)
+"RTN","C0CMED3",104,0)
. . . S VAPROD=$P(NDFDATA(22),U)
-"RTN","C0CMED3",107,0)
+"RTN","C0CMED3",105,0)
. . . S @MAP@("MEDPRODUCTNAMETEXT")=$$GET1^DIQ(50.68,VAPROD,.01) ;
-"RTN","C0CMED3",108,0)
+"RTN","C0CMED3",106,0)
. . ; GPL - RESET THE NAME TO THE REAL NAME OF THE DRUG NOW THAT WE
-"RTN","C0CMED3",109,0)
+"RTN","C0CMED3",107,0)
. . ; HAVE IT.
-"RTN","C0CMED3",110,0)
+"RTN","C0CMED3",108,0)
. . ;
-"RTN","C0CMED3",111,0)
+"RTN","C0CMED3",109,0)
. . ; NDFIEN is not necessarily defined; it won't be if the drug
-"RTN","C0CMED3",112,0)
+"RTN","C0CMED3",110,0)
. . ; is not matched to the national drug file (e.g. if the drug is
-"RTN","C0CMED3",113,0)
+"RTN","C0CMED3",111,0)
. . ; new on the market, compounded, or is a fake drug [blue pill].
-"RTN","C0CMED3",114,0)
+"RTN","C0CMED3",112,0)
. . ; To protect against failure, I will put an if/else block
-"RTN","C0CMED3",115,0)
+"RTN","C0CMED3",113,0)
. . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
-"RTN","C0CMED3",116,0)
+"RTN","C0CMED3",114,0)
. . ;
-"RTN","C0CMED3",117,0)
+"RTN","C0CMED3",115,0)
. . ; begin changes for systems that have eRx installed
-"RTN","C0CMED3",118,0)
+"RTN","C0CMED3",116,0)
. . ; RxNorm is found in the ^C0P("RXN") global - gpl
-"RTN","C0CMED3",119,0)
+"RTN","C0CMED3",117,0)
. . ;
-"RTN","C0CMED3",120,0)
+"RTN","C0CMED3",118,0)
. . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION
-"RTN","C0CMED3",121,0)
+"RTN","C0CMED3",119,0)
. . S (ZC,ZCD,ZCDS,ZCDSV)="" ; INITIALIZE
-"RTN","C0CMED3",122,0)
+"RTN","C0CMED3",120,0)
. . S (RXNORM,RXNNAME,RXNVER)="" ;INITIALIZE
-"RTN","C0CMED3",123,0)
+"RTN","C0CMED3",121,0)
. . I NDFIEN,$D(^C0P("RXN")) D ;
-"RTN","C0CMED3",124,0)
+"RTN","C0CMED3",122,0)
. . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
-"RTN","C0CMED3",125,0)
+"RTN","C0CMED3",123,0)
. . . S ZC=$$CODE^C0CUTIL(VUID)
-"RTN","C0CMED3",126,0)
+"RTN","C0CMED3",124,0)
. . . S ZCD=$P(ZC,"^",1) ; CODE TO USE
-"RTN","C0CMED3",127,0)
+"RTN","C0CMED3",125,0)
. . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID
-"RTN","C0CMED3",128,0)
+"RTN","C0CMED3",126,0)
. . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION
-"RTN","C0CMED3",129,0)
+"RTN","C0CMED3",127,0)
. . . S RXNORM=ZCD ; THE CODE
-"RTN","C0CMED3",130,0)
+"RTN","C0CMED3",128,0)
. . . S RXNNAME=ZCDS ; THE CODING SYSTEM
-"RTN","C0CMED3",131,0)
+"RTN","C0CMED3",129,0)
. . . S RXNVER=ZCDSV ; THE CODING SYSTEM VERSION
-"RTN","C0CMED3",132,0)
+"RTN","C0CMED3",130,0)
. . . N ZGMED S ZGMED=@MAP@("MEDPRODUCTNAMETEXT")
-"RTN","C0CMED3",133,0)
+"RTN","C0CMED3",131,0)
. . . S @MAP@("MEDPRODUCTNAMETEXT")=ZGMED_" "_ZCDS_": "_ZCD
-"RTN","C0CMED3",134,0)
+"RTN","C0CMED3",132,0)
. . E I NDFIEN,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet.
-"RTN","C0CMED3",135,0)
+"RTN","C0CMED3",133,0)
. . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
-"RTN","C0CMED3",136,0)
+"RTN","C0CMED3",134,0)
. . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
-"RTN","C0CMED3",137,0)
+"RTN","C0CMED3",135,0)
. . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
-"RTN","C0CMED3",138,0)
+"RTN","C0CMED3",136,0)
. . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
-"RTN","C0CMED3",139,0)
+"RTN","C0CMED3",137,0)
. . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
-"RTN","C0CMED3",140,0)
+"RTN","C0CMED3",138,0)
. . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
-"RTN","C0CMED3",141,0)
+"RTN","C0CMED3",139,0)
. . ;
-"RTN","C0CMED3",142,0)
+"RTN","C0CMED3",140,0)
. . ;E S (RXNORM,RXNNAME,RXNVER)=""
-"RTN","C0CMED3",143,0)
+"RTN","C0CMED3",141,0)
. . ; End if/else block
-"RTN","C0CMED3",144,0)
+"RTN","C0CMED3",142,0)
. . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
-"RTN","C0CMED3",145,0)
+"RTN","C0CMED3",143,0)
. . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
-"RTN","C0CMED3",146,0)
+"RTN","C0CMED3",144,0)
. . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
+"RTN","C0CMED3",145,0)
+ . . ;
+"RTN","C0CMED3",146,0)
+ . . S @MAP@("MEDBRANDNAMETEXT")=""
"RTN","C0CMED3",147,0)
- . . ;
-"RTN","C0CMED3",148,0)
- . . S @MAP@("MEDBRANDNAMETEXT")=""
-"RTN","C0CMED3",149,0)
. . ; DOSE^PSS50 ONLY ESISTS ON VISTA
-"RTN","C0CMED3",150,0)
+"RTN","C0CMED3",148,0)
. . I '$$RPMS^C0CUTIL() D
-"RTN","C0CMED3",151,0)
+"RTN","C0CMED3",149,0)
. . . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
-"RTN","C0CMED3",152,0)
+"RTN","C0CMED3",150,0)
. . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
-"RTN","C0CMED3",153,0)
+"RTN","C0CMED3",151,0)
. . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
-"RTN","C0CMED3",154,0)
+"RTN","C0CMED3",152,0)
. . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
-"RTN","C0CMED3",155,0)
+"RTN","C0CMED3",153,0)
. . E S @MAP@("MEDSTRENGTHVALUE")="" S @MAP@("MEDSTRENGTHUNIT")=""
-"RTN","C0CMED3",156,0)
+"RTN","C0CMED3",154,0)
. . ; Units, concentration, etc, come from another call
-"RTN","C0CMED3",157,0)
+"RTN","C0CMED3",155,0)
. . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
-"RTN","C0CMED3",158,0)
+"RTN","C0CMED3",156,0)
. . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
-"RTN","C0CMED3",159,0)
+"RTN","C0CMED3",157,0)
. . ; NDF Entry IEN, and VA Product Name
-"RTN","C0CMED3",160,0)
+"RTN","C0CMED3",158,0)
. . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
-"RTN","C0CMED3",161,0)
+"RTN","C0CMED3",159,0)
. . ; Documented in the same manual; executed above.
-"RTN","C0CMED3",162,0)
+"RTN","C0CMED3",160,0)
. . ;
-"RTN","C0CMED3",163,0)
+"RTN","C0CMED3",161,0)
. . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
-"RTN","C0CMED3",164,0)
+"RTN","C0CMED3",162,0)
. . ; and this will crash the call. So...
-"RTN","C0CMED3",165,0)
+"RTN","C0CMED3",163,0)
. . I NDFIEN="" S CONCDATA=""
-"RTN","C0CMED3",166,0)
+"RTN","C0CMED3",164,0)
. . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
-"RTN","C0CMED3",167,0)
+"RTN","C0CMED3",165,0)
. . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
-"RTN","C0CMED3",168,0)
+"RTN","C0CMED3",166,0)
. . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
-"RTN","C0CMED3",169,0)
+"RTN","C0CMED3",167,0)
. . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
-"RTN","C0CMED3",170,0)
+"RTN","C0CMED3",168,0)
. . S @MAP@("MEDQUANTITYVALUE")="" ; not provided for in Non-VA meds.
-"RTN","C0CMED3",171,0)
+"RTN","C0CMED3",169,0)
. . ; Oddly, there is no easy place to find the dispense unit.
-"RTN","C0CMED3",172,0)
+"RTN","C0CMED3",170,0)
. . ; It's not included in the original call, so we have to go to the drug file.
-"RTN","C0CMED3",173,0)
+"RTN","C0CMED3",171,0)
. . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
-"RTN","C0CMED3",174,0)
+"RTN","C0CMED3",172,0)
. . ; Node 14.5 is the Dispense Unit
-"RTN","C0CMED3",175,0)
+"RTN","C0CMED3",173,0)
. . ; PSS50 ONLY EXISTS ON VISTA
-"RTN","C0CMED3",176,0)
+"RTN","C0CMED3",174,0)
. . I '$$RPMS^C0CUTIL() D
-"RTN","C0CMED3",177,0)
+"RTN","C0CMED3",175,0)
. . . D DATA^PSS50(MEDIEN,,,,,"QTY")
-"RTN","C0CMED3",178,0)
+"RTN","C0CMED3",176,0)
. . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
-"RTN","C0CMED3",179,0)
+"RTN","C0CMED3",177,0)
. . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
-"RTN","C0CMED3",180,0)
+"RTN","C0CMED3",178,0)
. . E S @MAP@("MEDQUANTITYUNIT")=""
-"RTN","C0CMED3",181,0)
+"RTN","C0CMED3",179,0)
. . S @MAP@("MEDQUANTITYUNIT")="" ; don't show these
-"RTN","C0CMED3",182,0)
+"RTN","C0CMED3",180,0)
. E D
-"RTN","C0CMED3",183,0)
+"RTN","C0CMED3",181,0)
. . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
-"RTN","C0CMED3",184,0)
+"RTN","C0CMED3",182,0)
. . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
-"RTN","C0CMED3",185,0)
+"RTN","C0CMED3",183,0)
. . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""
-"RTN","C0CMED3",186,0)
+"RTN","C0CMED3",184,0)
. . S @MAP@("MEDBRANDNAMETEXT")=""
-"RTN","C0CMED3",187,0)
+"RTN","C0CMED3",185,0)
. . S @MAP@("MEDSTRENGTHVALUE")=""
-"RTN","C0CMED3",188,0)
+"RTN","C0CMED3",186,0)
. . S @MAP@("MEDSTRENGTHUNIT")=""
-"RTN","C0CMED3",189,0)
+"RTN","C0CMED3",187,0)
. . S @MAP@("MEDFORMTEXT")=""
-"RTN","C0CMED3",190,0)
+"RTN","C0CMED3",188,0)
. . S @MAP@("MEDCONCVALUE")=""
-"RTN","C0CMED3",191,0)
+"RTN","C0CMED3",189,0)
. . S @MAP@("MEDCONCUNIT")=""
-"RTN","C0CMED3",192,0)
+"RTN","C0CMED3",190,0)
. . S @MAP@("MEDSIZETEXT")=""
-"RTN","C0CMED3",193,0)
+"RTN","C0CMED3",191,0)
. . S @MAP@("MEDQUANTITYVALUE")=""
-"RTN","C0CMED3",194,0)
+"RTN","C0CMED3",192,0)
. . S @MAP@("MEDQUANTITYUNIT")=""
-"RTN","C0CMED3",195,0)
+"RTN","C0CMED3",193,0)
. ; End If/Else
-"RTN","C0CMED3",196,0)
+"RTN","C0CMED3",194,0)
. ; --- START OF DIRECTIONS ---
-"RTN","C0CMED3",197,0)
+"RTN","C0CMED3",195,0)
. ; Dosage is field 2, route is 3, schedule is 4
-"RTN","C0CMED3",198,0)
+"RTN","C0CMED3",196,0)
. ; These are all free text fields, and don't point to any files
-"RTN","C0CMED3",199,0)
+"RTN","C0CMED3",197,0)
. ; For that reason, I will use the field I never used before:
-"RTN","C0CMED3",200,0)
+"RTN","C0CMED3",198,0)
. ; MEDDIRECTIONDESCRIPTIONTEXT
-"RTN","C0CMED3",201,0)
+"RTN","C0CMED3",199,0)
. S DIRCNT=1 ; THERE IS ONLY ONE DIRECTION FOR OUTSIDE MEDS
+"RTN","C0CMED3",200,0)
+ . ;
+"RTN","C0CMED3",201,0)
+ . ; change for eRx meds - gpl 6/25/2011
"RTN","C0CMED3",202,0)
. ;
"RTN","C0CMED3",203,0)
- . ; change for eRx meds - gpl 6/25/2011
-"RTN","C0CMED3",204,0)
- . ;
-"RTN","C0CMED3",205,0)
. N ZERX S ZERX=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
-"RTN","C0CMED3",206,0)
+"RTN","C0CMED3",204,0)
. I ZERX["|" S ZERX=$P(ZERX,"|",2) ; GET RID OF MED NAME
-"RTN","C0CMED3",207,0)
+"RTN","C0CMED3",205,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=ZERX
-"RTN","C0CMED3",208,0)
+"RTN","C0CMED3",206,0)
. N ZERX2 S ZERX2=$P(MED(2,"E"),"|",2) ; sig for quantity
-"RTN","C0CMED3",209,0)
+"RTN","C0CMED3",207,0)
. N ZFDBDRUG S ZFDBDRUG=$P(MED(2,"E"),"|",1) ; FDB DRUG NAME
-"RTN","C0CMED3",210,0)
+"RTN","C0CMED3",208,0)
. I @MAP@("MEDPRODUCTNAMETEXT")["FREE TXT" D ; FIX THE DRUG NAME
-"RTN","C0CMED3",211,0)
+"RTN","C0CMED3",209,0)
. . S @MAP@("MEDPRODUCTNAMETEXT")=ZFDBDRUG ; USE FDB NAME
-"RTN","C0CMED3",212,0)
+"RTN","C0CMED3",210,0)
. . S RXNORM=$P($P($G(MED(14,7)),"RXNORM:",2)," ",1) ; THE RXNORM
-"RTN","C0CMED3",213,0)
+"RTN","C0CMED3",211,0)
. . S RXNORM=$$NISTMAP^C0CUTIL(RXNORM) ; CHANGE IF NECESSARY
-"RTN","C0CMED3",214,0)
+"RTN","C0CMED3",212,0)
. . I RXNORM'="" D ;
-"RTN","C0CMED3",215,0)
+"RTN","C0CMED3",213,0)
. . . W !,"FOUND FREE TEXT RXNORM:",RXNORM
-"RTN","C0CMED3",216,0)
+"RTN","C0CMED3",214,0)
. . . S RXNNAME="RXNORM" ; THE CODING SYSTEM
-"RTN","C0CMED3",217,0)
+"RTN","C0CMED3",215,0)
. . . S RXNVER="" ; THE CODING SYSTEM VERSION
-"RTN","C0CMED3",218,0)
+"RTN","C0CMED3",216,0)
. . . N ZGMED S ZGMED=@MAP@("MEDPRODUCTNAMETEXT")
-"RTN","C0CMED3",219,0)
+"RTN","C0CMED3",217,0)
. . . S @MAP@("MEDPRODUCTNAMETEXT")=ZGMED_" "_RXNNAME_": "_RXNORM
-"RTN","C0CMED3",220,0)
+"RTN","C0CMED3",218,0)
. . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
-"RTN","C0CMED3",221,0)
+"RTN","C0CMED3",219,0)
. . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
-"RTN","C0CMED3",222,0)
+"RTN","C0CMED3",220,0)
. . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
-"RTN","C0CMED3",223,0)
+"RTN","C0CMED3",221,0)
. . . I RXNORM["979334" D ; PATCH FOR CERTIFICATION
-"RTN","C0CMED3",224,0)
+"RTN","C0CMED3",222,0)
. . . . S @MAP@("MEDSTRENGTHVALUE")=650
-"RTN","C0CMED3",225,0)
+"RTN","C0CMED3",223,0)
. . . . S @MAP@("MEDSTRENGTHUNIT")="mcg"
-"RTN","C0CMED3",226,0)
+"RTN","C0CMED3",224,0)
. . . . S @MAP@("MEDFORMTEXT")="INHALER"
-"RTN","C0CMED3",227,0)
+"RTN","C0CMED3",225,0)
. S @MAP@("MEDQUANTITYUNIT")=$P(ZERX2," ",3) ; THE UNITS
-"RTN","C0CMED3",228,0)
+"RTN","C0CMED3",226,0)
. S @MAP@("MEDQUANTITYVALUE")=$P(ZERX2," ",2) ; THE QUANTITY
-"RTN","C0CMED3",229,0)
+"RTN","C0CMED3",227,0)
. I @MAP@("MEDFORMTEXT")="" S @MAP@("MEDFORMTEXT")=$P(ZERX2," ",3) ;
-"RTN","C0CMED3",230,0)
+"RTN","C0CMED3",228,0)
. ;S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
-"RTN","C0CMED3",231,0)
+"RTN","C0CMED3",229,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4" ; means look in description text. See E2369-05.
-"RTN","C0CMED3",232,0)
+"RTN","C0CMED3",230,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
-"RTN","C0CMED3",233,0)
+"RTN","C0CMED3",231,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
-"RTN","C0CMED3",234,0)
+"RTN","C0CMED3",232,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
-"RTN","C0CMED3",235,0)
+"RTN","C0CMED3",233,0)
. S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
-"RTN","C0CMED3",236,0)
+"RTN","C0CMED3",234,0)
. S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
-"RTN","C0CMED3",237,0)
+"RTN","C0CMED3",235,0)
. S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
-"RTN","C0CMED3",238,0)
+"RTN","C0CMED3",236,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
-"RTN","C0CMED3",239,0)
+"RTN","C0CMED3",237,0)
. S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
-"RTN","C0CMED3",240,0)
+"RTN","C0CMED3",238,0)
. S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
-"RTN","C0CMED3",241,0)
+"RTN","C0CMED3",239,0)
. S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""
-"RTN","C0CMED3",242,0)
+"RTN","C0CMED3",240,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""
-"RTN","C0CMED3",243,0)
+"RTN","C0CMED3",241,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""
-"RTN","C0CMED3",244,0)
+"RTN","C0CMED3",242,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""
-"RTN","C0CMED3",245,0)
+"RTN","C0CMED3",243,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""
-"RTN","C0CMED3",246,0)
+"RTN","C0CMED3",244,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""
-"RTN","C0CMED3",247,0)
+"RTN","C0CMED3",245,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""
-"RTN","C0CMED3",248,0)
+"RTN","C0CMED3",246,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""
-"RTN","C0CMED3",249,0)
+"RTN","C0CMED3",247,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
-"RTN","C0CMED3",250,0)
+"RTN","C0CMED3",248,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
-"RTN","C0CMED3",251,0)
+"RTN","C0CMED3",249,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
-"RTN","C0CMED3",252,0)
+"RTN","C0CMED3",250,0)
. S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
-"RTN","C0CMED3",253,0)
+"RTN","C0CMED3",251,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
-"RTN","C0CMED3",254,0)
+"RTN","C0CMED3",252,0)
. S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
+"RTN","C0CMED3",253,0)
+ . ;
+"RTN","C0CMED3",254,0)
+ . ; --- END OF DIRECTIONS ---
"RTN","C0CMED3",255,0)
. ;
"RTN","C0CMED3",256,0)
- . ; --- END OF DIRECTIONS ---
-"RTN","C0CMED3",257,0)
- . ;
-"RTN","C0CMED3",258,0)
. S @MAP@("MEDRFNO")=""
-"RTN","C0CMED3",259,0)
+"RTN","C0CMED3",257,0)
. I $D(MED(14,1)) D ;
-"RTN","C0CMED3",260,0)
+"RTN","C0CMED3",258,0)
. . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
-"RTN","C0CMED3",261,0)
+"RTN","C0CMED3",259,0)
. E S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
-"RTN","C0CMED3",262,0)
+"RTN","C0CMED3",260,0)
. S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")="" ; don't put in these - gpl
-"RTN","C0CMED3",263,0)
+"RTN","C0CMED3",261,0)
. N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
-"RTN","C0CMED3",264,0)
+"RTN","C0CMED3",262,0)
. K @RESULT
-"RTN","C0CMED3",265,0)
+"RTN","C0CMED3",263,0)
. D MAP^C0CXPATH(MINXML,MAP,RESULT)
-"RTN","C0CMED3",266,0)
+"RTN","C0CMED3",264,0)
. ; D PARY^C0CXPATH(RESULT)
-"RTN","C0CMED3",267,0)
+"RTN","C0CMED3",265,0)
. ; MAPPING DIRECTIONS
-"RTN","C0CMED3",268,0)
+"RTN","C0CMED3",266,0)
. N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
-"RTN","C0CMED3",269,0)
+"RTN","C0CMED3",267,0)
. N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
-"RTN","C0CMED3",270,0)
+"RTN","C0CMED3",268,0)
. D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
-"RTN","C0CMED3",271,0)
+"RTN","C0CMED3",269,0)
. D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
-"RTN","C0CMED3",272,0)
+"RTN","C0CMED3",270,0)
. N MDZ1,MDZNA
-"RTN","C0CMED3",273,0)
+"RTN","C0CMED3",271,0)
. I DIRCNT>0 D ; IF THERE ARE DIRCTIONS
-"RTN","C0CMED3",274,0)
+"RTN","C0CMED3",272,0)
. . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION
-"RTN","C0CMED3",275,0)
+"RTN","C0CMED3",273,0)
. . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
-"RTN","C0CMED3",276,0)
+"RTN","C0CMED3",274,0)
. . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
-"RTN","C0CMED3",277,0)
+"RTN","C0CMED3",275,0)
. . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
-"RTN","C0CMED3",278,0)
+"RTN","C0CMED3",276,0)
. ;
-"RTN","C0CMED3",279,0)
+"RTN","C0CMED3",277,0)
. ; MAP PATIENT INSTRUCTIONS - HAVE TO DO THIS AFTER MAPPING DIRECTIONS DUE TO XML SCHEMA VALIDATION
-"RTN","C0CMED3",280,0)
+"RTN","C0CMED3",278,0)
. N MEDINT1,INTXML1 S INTXML1="MENINT1" ; VARIABLE AND NAME VARIABLE TEMPLATE
-"RTN","C0CMED3",281,0)
+"RTN","C0CMED3",279,0)
. N MEDINT2,INTXML2 S INTXML2="MEDINT2" ; VARIABLE AND NAME VARIABLE RESULT
-"RTN","C0CMED3",282,0)
+"RTN","C0CMED3",280,0)
. D QUERY^C0CXPATH(MINXML,"//Medications/Medication/PatientInstructions",INTXML1)
-"RTN","C0CMED3",283,0)
+"RTN","C0CMED3",281,0)
. D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/PatientInstructions")
-"RTN","C0CMED3",284,0)
+"RTN","C0CMED3",282,0)
. ;N MDI1 ; removing the "I" which is not in the protocol gpl 1/2010
-"RTN","C0CMED3",285,0)
+"RTN","C0CMED3",283,0)
. ;S MDI1=$NA(@MAP@("I"))
-"RTN","C0CMED3",286,0)
+"RTN","C0CMED3",284,0)
. ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
-"RTN","C0CMED3",287,0)
+"RTN","C0CMED3",285,0)
. I $D(MED(10,1)) D ;
-"RTN","C0CMED3",288,0)
+"RTN","C0CMED3",286,0)
. . ;S @MAP@("I","MEDPTINSTRUCTIONS")=$P(MED(10,1)," ",1) ; WP Field
-"RTN","C0CMED3",289,0)
+"RTN","C0CMED3",287,0)
. . S @MAP@("MEDPTINSTRUCTIONS")=$P(MED(10,1)," ",1) ; WP Field
-"RTN","C0CMED3",290,0)
+"RTN","C0CMED3",288,0)
. E S @MAP@("MEDPTINSTRUCTIONS")=""
-"RTN","C0CMED3",291,0)
+"RTN","C0CMED3",289,0)
. ;E S @MAP@("I","MEDPTINSTRUCTIONS")=""
-"RTN","C0CMED3",292,0)
+"RTN","C0CMED3",290,0)
. ;D MAP^C0CXPATH(INTXML1,MDI1,INTXML2)
-"RTN","C0CMED3",293,0)
+"RTN","C0CMED3",291,0)
. D MAP^C0CXPATH(INTXML1,MAP,INTXML2) ; JUST MAP WORKS.. GPL
-"RTN","C0CMED3",294,0)
+"RTN","C0CMED3",292,0)
. D INSERT^C0CXPATH(RESULT,INTXML2,"//Medications/Medication")
-"RTN","C0CMED3",295,0)
+"RTN","C0CMED3",293,0)
. ;
-"RTN","C0CMED3",296,0)
+"RTN","C0CMED3",294,0)
. ; FLAG HAS TO BE RESET OUTSIDE THE IF STATMENT.
-"RTN","C0CMED3",297,0)
+"RTN","C0CMED3",295,0)
. ;I MEDFIRST D ;
-"RTN","C0CMED3",298,0)
+"RTN","C0CMED3",296,0)
. ;. S MEDFIRST=0 ; RESET FIRST FLAG
-"RTN","C0CMED3",299,0)
+"RTN","C0CMED3",297,0)
. ;. D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
-"RTN","C0CMED3",300,0)
+"RTN","C0CMED3",298,0)
. ;D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
-"RTN","C0CMED3",301,0)
+"RTN","C0CMED3",299,0)
. D:MEDFIRST CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
-"RTN","C0CMED3",302,0)
+"RTN","C0CMED3",300,0)
. D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
-"RTN","C0CMED3",303,0)
+"RTN","C0CMED3",301,0)
. I MEDFIRST S MEDFIRST=0
-"RTN","C0CMED3",304,0)
+"RTN","C0CMED3",302,0)
N MEDTMP,MEDI
-"RTN","C0CMED3",305,0)
+"RTN","C0CMED3",303,0)
D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","C0CMED3",306,0)
+"RTN","C0CMED3",304,0)
I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","C0CMED3",307,0)
+"RTN","C0CMED3",305,0)
. W "MEDICATION MISSING ",!
-"RTN","C0CMED3",308,0)
+"RTN","C0CMED3",306,0)
. F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","C0CMED3",309,0)
+"RTN","C0CMED3",307,0)
Q
-"RTN","C0CMED3",310,0)
+"RTN","C0CMED3",308,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)
- ;
-"RTN","C0CMED4",11,0)
; This program is distributed in the hope that it will be useful,
-"RTN","C0CMED4",12,0)
+"RTN","C0CMED4",11,0)
; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","C0CMED4",13,0)
+"RTN","C0CMED4",12,0)
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+"RTN","C0CMED4",13,0)
+ ; 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 .
"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.
-"RTN","C0CMED4",19,0)
;
-"RTN","C0CMED4",20,0)
+"RTN","C0CMED4",18,0)
W "NO ENTRY FROM TOP",!
-"RTN","C0CMED4",21,0)
+"RTN","C0CMED4",19,0)
Q
+"RTN","C0CMED4",20,0)
+ ;
+"RTN","C0CMED4",21,0)
+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
-"RTN","C0CMED4",24,0)
- ;
-"RTN","C0CMED4",25,0)
; MINXML is the Input XML Template, passed by name
-"RTN","C0CMED4",26,0)
+"RTN","C0CMED4",24,0)
; DFN is Patient IEN
-"RTN","C0CMED4",27,0)
+"RTN","C0CMED4",25,0)
; OUTXML is the resultant XML.
-"RTN","C0CMED4",28,0)
+"RTN","C0CMED4",26,0)
;
-"RTN","C0CMED4",29,0)
+"RTN","C0CMED4",27,0)
; MEDS is return array from API.
-"RTN","C0CMED4",30,0)
+"RTN","C0CMED4",28,0)
; MED is holds each array element from MEDS, one medicine
-"RTN","C0CMED4",31,0)
+"RTN","C0CMED4",29,0)
; MAP is a mapping variable map (store result) for each med
-"RTN","C0CMED4",32,0)
+"RTN","C0CMED4",30,0)
;
-"RTN","C0CMED4",33,0)
+"RTN","C0CMED4",31,0)
; Inpatient Meds will be extracted using this routine and and the one following.
-"RTN","C0CMED4",34,0)
+"RTN","C0CMED4",32,0)
; Inpatient Meds Unit Dose is going to be C0CMED4
-"RTN","C0CMED4",35,0)
+"RTN","C0CMED4",33,0)
; Inpatient Meds IVs is going to be C0CMED5
-"RTN","C0CMED4",36,0)
+"RTN","C0CMED4",34,0)
;
-"RTN","C0CMED4",37,0)
+"RTN","C0CMED4",35,0)
; We will use two Pharmacy ReEnginnering API's:
-"RTN","C0CMED4",38,0)
+"RTN","C0CMED4",36,0)
; PSS431^PSS55(DFN,PO,PSDATE,PEDATE,LIST) - provides most info
-"RTN","C0CMED4",39,0)
+"RTN","C0CMED4",37,0)
; PSS432^PSS55(DFN,PO,LIST) - provides schedule info
-"RTN","C0CMED4",40,0)
+"RTN","C0CMED4",38,0)
; For more information, see the PRE documentation at:
-"RTN","C0CMED4",41,0)
+"RTN","C0CMED4",39,0)
; http://www.va.gov/vdl/documents/Clinical/Pharm-Inpatient_Med/phar_1_api_r0807.pdf
-"RTN","C0CMED4",42,0)
+"RTN","C0CMED4",40,0)
;
-"RTN","C0CMED4",43,0)
+"RTN","C0CMED4",41,0)
; Med data is stored in Unit Dose multiple of file 55, pharmacy patient
-"RTN","C0CMED4",44,0)
+"RTN","C0CMED4",42,0)
;
-"RTN","C0CMED4",45,0)
+"RTN","C0CMED4",43,0)
N MEDS,MAP
-"RTN","C0CMED4",46,0)
+"RTN","C0CMED4",44,0)
K ^TMP($J)
-"RTN","C0CMED4",47,0)
+"RTN","C0CMED4",45,0)
D PSS431^PSS55(DFN,,,,"UD") ; Output is in ^TMP($J,"UD",*)
-"RTN","C0CMED4",48,0)
+"RTN","C0CMED4",46,0)
I ^TMP($J,"UD",0)'>0 S @OUTXML@(0)=0 QUIT ; No Meds - Quit
-"RTN","C0CMED4",49,0)
+"RTN","C0CMED4",47,0)
; Otherwise, we go on...
-"RTN","C0CMED4",50,0)
+"RTN","C0CMED4",48,0)
M MEDS=^TMP($J,"UD")
+"RTN","C0CMED4",49,0)
+ ; I DEBUG ZWR MEDS
+"RTN","C0CMED4",50,0)
+ S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
"RTN","C0CMED4",51,0)
- I DEBUG ZWR MEDS
-"RTN","C0CMED4",52,0)
- S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
-"RTN","C0CMED4",53,0)
N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
-"RTN","C0CMED4",54,0)
- N I S I=0
-"RTN","C0CMED4",55,0)
+"RTN","C0CMED4",52,0)
+ N I S I=0
+"RTN","C0CMED4",53,0)
F S I=$O(MEDS("B",I)) Q:'I D ; For each medication in B index
-"RTN","C0CMED4",56,0)
+"RTN","C0CMED4",54,0)
. N MED M MED=MEDS(I)
-"RTN","C0CMED4",57,0)
+"RTN","C0CMED4",55,0)
. S MEDCOUNT=MEDCOUNT+1
-"RTN","C0CMED4",58,0)
+"RTN","C0CMED4",56,0)
. S @MEDMAP@(0)=MEDCOUNT ; Update MedMap array counter
-"RTN","C0CMED4",59,0)
+"RTN","C0CMED4",57,0)
. S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
-"RTN","C0CMED4",60,0)
+"RTN","C0CMED4",58,0)
. N RXIEN S RXIEN=MED(.01) ; Order Number
-"RTN","C0CMED4",61,0)
+"RTN","C0CMED4",59,0)
. I DEBUG W "RXIEN IS ",RXIEN,!
-"RTN","C0CMED4",62,0)
+"RTN","C0CMED4",60,0)
. I DEBUG W "MAP= ",MAP,!
-"RTN","C0CMED4",63,0)
- . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN
-"RTN","C0CMED4",64,0)
+"RTN","C0CMED4",61,0)
+ . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN
+"RTN","C0CMED4",62,0)
. S @MAP@("MEDISSUEDATETXT")="Order Date"
-"RTN","C0CMED4",65,0)
+"RTN","C0CMED4",63,0)
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT")
-"RTN","C0CMED4",66,0)
+"RTN","C0CMED4",64,0)
. S @MAP@("MEDLASTFILLDATETXT")="" ; For Outpatient
-"RTN","C0CMED4",67,0)
+"RTN","C0CMED4",65,0)
. S @MAP@("MEDLASTFILLDATE")="" ; For Outpatient
-"RTN","C0CMED4",68,0)
+"RTN","C0CMED4",66,0)
. S @MAP@("MEDRXNOTXT")="" ; For Outpatient
-"RTN","C0CMED4",69,0)
+"RTN","C0CMED4",67,0)
. S @MAP@("MEDRXNO")="" ; For Outpatient
-"RTN","C0CMED4",70,0)
+"RTN","C0CMED4",68,0)
. S @MAP@("MEDTYPETEXT")="Medication"
-"RTN","C0CMED4",71,0)
+"RTN","C0CMED4",69,0)
. S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses
-"RTN","C0CMED4",72,0)
- . S @MAP@("MEDSTATUSTEXT")="ACTIVE"
-"RTN","C0CMED4",73,0)
+"RTN","C0CMED4",70,0)
+ . S @MAP@("MEDSTATUSTEXT")="ACTIVE"
+"RTN","C0CMED4",71,0)
. S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U)
-"RTN","C0CMED4",74,0)
+"RTN","C0CMED4",72,0)
. S @MAP@("MEDPRODUCTNAMETEXT")=MED("DDRUG",1,.01)
-"RTN","C0CMED4",75,0)
+"RTN","C0CMED4",73,0)
. ; NDC is field 31 in the drug file.
-"RTN","C0CMED4",76,0)
+"RTN","C0CMED4",74,0)
. ; The actual drug entry in the drug file is not necessarily supplied.
-"RTN","C0CMED4",77,0)
+"RTN","C0CMED4",75,0)
. ; It' node 1, internal form.
-"RTN","C0CMED4",78,0)
+"RTN","C0CMED4",76,0)
. N MEDIEN S MEDIEN=MED(1,"I")
-"RTN","C0CMED4",79,0)
+"RTN","C0CMED4",77,0)
. S @MAP@("MEDPRODUCTNAMECODEVALUE")=$S($L(MEDIEN):$$GET1^DIQ(50,MEDIEN,31,"E"),1:"")
-"RTN","C0CMED4",80,0)
+"RTN","C0CMED4",78,0)
. S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=$S($L(MEDIEN):"NDC",1:"")
-"RTN","C0CMED4",81,0)
+"RTN","C0CMED4",79,0)
. S @MAP@("MEDPRODUCTNAMECODEVERSION")=$S($L(MEDIEN):"none",1:"")
-"RTN","C0CMED4",82,0)
+"RTN","C0CMED4",80,0)
. S @MAP@("MEDBRANDNAMETEXT")=""
-"RTN","C0CMED4",83,0)
+"RTN","C0CMED4",81,0)
. I $L(MEDIEN) D DOSE^PSS50(MEDIEN,,,,,"DOSE")
-"RTN","C0CMED4",84,0)
+"RTN","C0CMED4",82,0)
. I $L(MEDIEN) N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
-"RTN","C0CMED4",85,0)
+"RTN","C0CMED4",83,0)
. S @MAP@("MEDSTRENGTHVALUE")=$S($L(MEDIEN):DOSEDATA(901),1:"")
-"RTN","C0CMED4",86,0)
+"RTN","C0CMED4",84,0)
. S @MAP@("MEDSTRENGTHUNIT")=$S($L(MEDIEN):$P(DOSEDATA(902),U,2),1:"")
-"RTN","C0CMED4",87,0)
+"RTN","C0CMED4",85,0)
. ; Units, concentration, etc, come from another call
-"RTN","C0CMED4",88,0)
+"RTN","C0CMED4",86,0)
. ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
-"RTN","C0CMED4",89,0)
+"RTN","C0CMED4",87,0)
. ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
-"RTN","C0CMED4",90,0)
+"RTN","C0CMED4",88,0)
. ; NDF Entry IEN, and VA Product Name
-"RTN","C0CMED4",91,0)
+"RTN","C0CMED4",89,0)
. ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
-"RTN","C0CMED4",92,0)
+"RTN","C0CMED4",90,0)
. ; Documented in the same manual.
-"RTN","C0CMED4",93,0)
+"RTN","C0CMED4",91,0)
. N NDFDATA,CONCDATA
-"RTN","C0CMED4",94,0)
+"RTN","C0CMED4",92,0)
. I $L(MEDIEN) D
-"RTN","C0CMED4",95,0)
+"RTN","C0CMED4",93,0)
. . D NDF^PSS50(MEDIEN,,,,,"CONC")
-"RTN","C0CMED4",96,0)
+"RTN","C0CMED4",94,0)
. . M NDFDATA=^TMP($J,"CONC",MEDIEN)
-"RTN","C0CMED4",97,0)
+"RTN","C0CMED4",95,0)
. . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
-"RTN","C0CMED4",98,0)
+"RTN","C0CMED4",96,0)
. . N VAPROD S VAPROD=$P(NDFDATA(22),U)
-"RTN","C0CMED4",99,0)
+"RTN","C0CMED4",97,0)
. . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
-"RTN","C0CMED4",100,0)
+"RTN","C0CMED4",98,0)
. . ; and this will crash the call. So...
-"RTN","C0CMED4",101,0)
+"RTN","C0CMED4",99,0)
. . I NDFIEN="" S CONCDATA=""
-"RTN","C0CMED4",102,0)
+"RTN","C0CMED4",100,0)
. . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
-"RTN","C0CMED4",103,0)
+"RTN","C0CMED4",101,0)
. E S (NDFDATA,CONCDATA)="" ; This line is defensive programming to prevent undef errors.
-"RTN","C0CMED4",104,0)
+"RTN","C0CMED4",102,0)
. S @MAP@("MEDFORMTEXT")=$S($L(MEDIEN):$P(CONCDATA,U,1),1:"")
-"RTN","C0CMED4",105,0)
+"RTN","C0CMED4",103,0)
. S @MAP@("MEDCONCVALUE")=$S($L(MEDIEN):$P(CONCDATA,U,3),1:"")
-"RTN","C0CMED4",106,0)
+"RTN","C0CMED4",104,0)
. S @MAP@("MEDCONCUNIT")=$S($L(MEDIEN):$P(CONCDATA,U,4),1:"")
-"RTN","C0CMED4",107,0)
+"RTN","C0CMED4",105,0)
. S @MAP@("MEDQUANTITYVALUE")="" ; not provided for in Non-VA meds.
-"RTN","C0CMED4",108,0)
+"RTN","C0CMED4",106,0)
. ; Oddly, there is no easy place to find the dispense unit.
-"RTN","C0CMED4",109,0)
+"RTN","C0CMED4",107,0)
. ; It's not included in the original call, so we have to go to the drug file.
-"RTN","C0CMED4",110,0)
+"RTN","C0CMED4",108,0)
. ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
-"RTN","C0CMED4",111,0)
+"RTN","C0CMED4",109,0)
. ; Node 14.5 is the Dispense Unit
-"RTN","C0CMED4",112,0)
+"RTN","C0CMED4",110,0)
. I $L(MEDIEN) D
-"RTN","C0CMED4",113,0)
+"RTN","C0CMED4",111,0)
. . D DATA^PSS50(MEDIEN,,,,,"QTY")
-"RTN","C0CMED4",114,0)
+"RTN","C0CMED4",112,0)
. . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
-"RTN","C0CMED4",115,0)
+"RTN","C0CMED4",113,0)
. . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
-"RTN","C0CMED4",116,0)
- E S @MAP@("MEDQUANTITYUNIT")=""
-"RTN","C0CMED4",117,0)
+"RTN","C0CMED4",114,0)
+ . E S @MAP@("MEDQUANTITYUNIT")=""
+"RTN","C0CMED4",115,0)
. ;
-"RTN","C0CMED4",118,0)
+"RTN","C0CMED4",116,0)
. ; --- START OF DIRECTIONS ---
-"RTN","C0CMED4",119,0)
+"RTN","C0CMED4",117,0)
. ; Dosage is field 2, route is 3, schedule is 4
-"RTN","C0CMED4",120,0)
+"RTN","C0CMED4",118,0)
. ; These are all free text fields, and don't point to any files
-"RTN","C0CMED4",121,0)
+"RTN","C0CMED4",119,0)
. ; For that reason, I will use the field I never used before:
-"RTN","C0CMED4",122,0)
+"RTN","C0CMED4",120,0)
. ; MEDDIRECTIONDESCRIPTIONTEXT
-"RTN","C0CMED4",123,0)
+"RTN","C0CMED4",121,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
-"RTN","C0CMED4",124,0)
+"RTN","C0CMED4",122,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4" ; means look in description text. See E2369-05.
-"RTN","C0CMED4",125,0)
+"RTN","C0CMED4",123,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
-"RTN","C0CMED4",126,0)
+"RTN","C0CMED4",124,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
-"RTN","C0CMED4",127,0)
+"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,"MEDRATEVALUE")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
"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)
+"RTN","C0CMED4",130,0)
. S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
-"RTN","C0CMED4",133,0)
+"RTN","C0CMED4",131,0)
. S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
-"RTN","C0CMED4",134,0)
+"RTN","C0CMED4",132,0)
. S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""
-"RTN","C0CMED4",135,0)
+"RTN","C0CMED4",133,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""
-"RTN","C0CMED4",136,0)
+"RTN","C0CMED4",134,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""
-"RTN","C0CMED4",137,0)
+"RTN","C0CMED4",135,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""
-"RTN","C0CMED4",138,0)
+"RTN","C0CMED4",136,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""
-"RTN","C0CMED4",139,0)
+"RTN","C0CMED4",137,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""
-"RTN","C0CMED4",140,0)
+"RTN","C0CMED4",138,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""
-"RTN","C0CMED4",141,0)
+"RTN","C0CMED4",139,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""
-"RTN","C0CMED4",142,0)
+"RTN","C0CMED4",140,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
-"RTN","C0CMED4",143,0)
+"RTN","C0CMED4",141,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
-"RTN","C0CMED4",144,0)
+"RTN","C0CMED4",142,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
-"RTN","C0CMED4",145,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
-"RTN","C0CMED4",146,0)
+"RTN","C0CMED4",143,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
+"RTN","C0CMED4",144,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
-"RTN","C0CMED4",147,0)
+"RTN","C0CMED4",145,0)
. S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
+"RTN","C0CMED4",146,0)
+ . ;
+"RTN","C0CMED4",147,0)
+ . ; --- END OF DIRECTIONS ---
"RTN","C0CMED4",148,0)
. ;
"RTN","C0CMED4",149,0)
- . ; --- END OF DIRECTIONS ---
-"RTN","C0CMED4",150,0)
- . ;
-"RTN","C0CMED4",151,0)
. ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
-"RTN","C0CMED4",152,0)
+"RTN","C0CMED4",150,0)
. S @MAP@("MEDPTINSTRUCTIONS")=MED(10,1) ; WP Field
-"RTN","C0CMED4",153,0)
+"RTN","C0CMED4",151,0)
. S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
-"RTN","C0CMED4",154,0)
+"RTN","C0CMED4",152,0)
. S @MAP@("MEDRFNO")=""
-"RTN","C0CMED4",155,0)
+"RTN","C0CMED4",153,0)
. N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))
-"RTN","C0CMED4",156,0)
+"RTN","C0CMED4",154,0)
. K @RESULT
-"RTN","C0CMED4",157,0)
+"RTN","C0CMED4",155,0)
. D MAP^GPLXPATH(MINXML,MAP,RESULT)
-"RTN","C0CMED4",158,0)
+"RTN","C0CMED4",156,0)
. ; D PARY^GPLXPATH(RESULT)
-"RTN","C0CMED4",159,0)
+"RTN","C0CMED4",157,0)
. ; MAPPING DIRECTIONS
-"RTN","C0CMED4",160,0)
+"RTN","C0CMED4",158,0)
. N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
-"RTN","C0CMED4",161,0)
+"RTN","C0CMED4",159,0)
. N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
-"RTN","C0CMED4",162,0)
+"RTN","C0CMED4",160,0)
. D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
-"RTN","C0CMED4",163,0)
+"RTN","C0CMED4",161,0)
. D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions")
-"RTN","C0CMED4",164,0)
+"RTN","C0CMED4",162,0)
. ; N MDZ1,MDZNA
-"RTN","C0CMED4",165,0)
+"RTN","C0CMED4",163,0)
. I DIRCNT>0 D ; IF THERE ARE DIRCTIONS
-"RTN","C0CMED4",166,0)
+"RTN","C0CMED4",164,0)
. . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION
-"RTN","C0CMED4",167,0)
+"RTN","C0CMED4",165,0)
. . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
-"RTN","C0CMED4",168,0)
+"RTN","C0CMED4",166,0)
. . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2)
-"RTN","C0CMED4",169,0)
+"RTN","C0CMED4",167,0)
. . . D INSERT^GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")
-"RTN","C0CMED4",170,0)
+"RTN","C0CMED4",168,0)
. D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
-"RTN","C0CMED4",171,0)
+"RTN","C0CMED4",169,0)
. D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
-"RTN","C0CMED4",172,0)
+"RTN","C0CMED4",170,0)
N MEDTMP,MEDI
-"RTN","C0CMED4",173,0)
+"RTN","C0CMED4",171,0)
D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","C0CMED4",174,0)
+"RTN","C0CMED4",172,0)
I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","C0CMED4",175,0)
+"RTN","C0CMED4",173,0)
. W "MEDICATION MISSING ",!
-"RTN","C0CMED4",176,0)
+"RTN","C0CMED4",174,0)
. F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","C0CMED4",177,0)
+"RTN","C0CMED4",175,0)
Q
-"RTN","C0CMED4",178,0)
+"RTN","C0CMED4",176,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)
- ;
-"RTN","C0CMED6",11,0)
; This program is distributed in the hope that it will be useful,
-"RTN","C0CMED6",12,0)
+"RTN","C0CMED6",11,0)
; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","C0CMED6",13,0)
+"RTN","C0CMED6",12,0)
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+"RTN","C0CMED6",13,0)
+ ; 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 .
"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.
-"RTN","C0CMED6",19,0)
;
-"RTN","C0CMED6",20,0)
+"RTN","C0CMED6",18,0)
W "NO ENTRY FROM TOP",!
-"RTN","C0CMED6",21,0)
+"RTN","C0CMED6",19,0)
Q
+"RTN","C0CMED6",20,0)
+ ;
+"RTN","C0CMED6",21,0)
+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
-"RTN","C0CMED6",24,0)
- ;
-"RTN","C0CMED6",25,0)
; MINXML and OUTXML are passed by name so globals can be used
-"RTN","C0CMED6",26,0)
+"RTN","C0CMED6",24,0)
; MINXML will contain only the medications skeleton of the overall template
-"RTN","C0CMED6",27,0)
+"RTN","C0CMED6",25,0)
; MEDCOUNT is a counter passed by Reference.
-"RTN","C0CMED6",28,0)
+"RTN","C0CMED6",26,0)
; FLAGS are: MEDALL(bool)^MEDLIMIT(int)^MEDACTIVE(bool)^MEDPENDING(bool)
-"RTN","C0CMED6",29,0)
+"RTN","C0CMED6",27,0)
; FLAGS are set-up in C0CMED.
-"RTN","C0CMED6",30,0)
+"RTN","C0CMED6",28,0)
;
-"RTN","C0CMED6",31,0)
+"RTN","C0CMED6",29,0)
; MEDS is return array from RPC.
-"RTN","C0CMED6",32,0)
+"RTN","C0CMED6",30,0)
; MAP is a mapping variable map (store result) for each med
-"RTN","C0CMED6",33,0)
+"RTN","C0CMED6",31,0)
; MED is holds each array element from MEDS(J), one medicine
-"RTN","C0CMED6",34,0)
+"RTN","C0CMED6",32,0)
; J is a counter.
-"RTN","C0CMED6",35,0)
+"RTN","C0CMED6",33,0)
;
-"RTN","C0CMED6",36,0)
+"RTN","C0CMED6",34,0)
; GETRXS^BEHORXFN(ARRAYNAME,DFN,DAYS) will be the the API used.
-"RTN","C0CMED6",37,0)
+"RTN","C0CMED6",35,0)
; This API has been developed by Medsphere for IHS for getting
-"RTN","C0CMED6",38,0)
+"RTN","C0CMED6",36,0)
; Medications from RPMS. It has most of what we need.
-"RTN","C0CMED6",39,0)
+"RTN","C0CMED6",37,0)
; API written by Doug Martin when he worked for Medsphere (thanks Doug!)
-"RTN","C0CMED6",40,0)
+"RTN","C0CMED6",38,0)
; -- ARRAYNAME is passed by name (required)
-"RTN","C0CMED6",41,0)
+"RTN","C0CMED6",39,0)
; -- DFN is passed by value (required)
-"RTN","C0CMED6",42,0)
+"RTN","C0CMED6",40,0)
; -- DAYS is passed by value (optional; if not passed defaults to 365)
-"RTN","C0CMED6",43,0)
+"RTN","C0CMED6",41,0)
;
-"RTN","C0CMED6",44,0)
+"RTN","C0CMED6",42,0)
; Return:
-"RTN","C0CMED6",45,0)
+"RTN","C0CMED6",43,0)
; ~Type^PharmID^Drug^InfRate^StopDt^RefRem^TotDose^UnitDose^OrderID
-"RTN","C0CMED6",46,0)
+"RTN","C0CMED6",44,0)
; ^Status^LastFill^Chronic^Issued^Rx #^Provider^
-"RTN","C0CMED6",47,0)
+"RTN","C0CMED6",45,0)
; Status Reason^DEA Handling
-"RTN","C0CMED6",48,0)
+"RTN","C0CMED6",46,0)
;
-"RTN","C0CMED6",49,0)
+"RTN","C0CMED6",47,0)
N MEDS,MEDS1,MAP
-"RTN","C0CMED6",50,0)
+"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",51,0)
+"RTN","C0CMED6",49,0)
N ALL S ALL=+FLAGS
-"RTN","C0CMED6",52,0)
+"RTN","C0CMED6",50,0)
N ACTIVE S ACTIVE=$P(FLAGS,U,3)
-"RTN","C0CMED6",53,0)
+"RTN","C0CMED6",51,0)
N PENDING S PENDING=$P(FLAGS,U,4)
-"RTN","C0CMED6",54,0)
+"RTN","C0CMED6",52,0)
S @OUTXML@(0)=0 ;By default, no meds
-"RTN","C0CMED6",55,0)
+"RTN","C0CMED6",53,0)
; If MEDS1 is not defined, then no meds
-"RTN","C0CMED6",56,0)
+"RTN","C0CMED6",54,0)
I '$D(MEDS1) QUIT
-"RTN","C0CMED6",57,0)
- I DEBUG ZWR MEDS1,MINXML
-"RTN","C0CMED6",58,0)
+"RTN","C0CMED6",55,0)
+ ;I DEBUG ZWR MEDS1,MINXML
+"RTN","C0CMED6",56,0)
N MEDCNT S MEDCNT=0 ; Med Count
-"RTN","C0CMED6",59,0)
+"RTN","C0CMED6",57,0)
; The next line is a super line. It goes through the array return
-"RTN","C0CMED6",60,0)
+"RTN","C0CMED6",58,0)
; and if the first characters are ~OP, it grabs the line.
-"RTN","C0CMED6",61,0)
+"RTN","C0CMED6",59,0)
; This means that line is for a dispensed Outpatient Med.
-"RTN","C0CMED6",62,0)
+"RTN","C0CMED6",60,0)
; That line has the metadata about the med that I need.
-"RTN","C0CMED6",63,0)
+"RTN","C0CMED6",61,0)
; The next lines, however many, are the med and the sig.
-"RTN","C0CMED6",64,0)
+"RTN","C0CMED6",62,0)
; I won't be using those because I have to get the sig parsed exactly.
-"RTN","C0CMED6",65,0)
+"RTN","C0CMED6",63,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)
-"RTN","C0CMED6",66,0)
+"RTN","C0CMED6",64,0)
K MEDS1
-"RTN","C0CMED6",67,0)
+"RTN","C0CMED6",65,0)
S MEDCNT="" ; Initialize for $Order
-"RTN","C0CMED6",68,0)
+"RTN","C0CMED6",66,0)
F S MEDCNT=$O(MEDS(MEDCNT)) Q:MEDCNT="" D ; for each medication in the list
-"RTN","C0CMED6",69,0)
+"RTN","C0CMED6",67,0)
. I 'ALL,ACTIVE,$P(MEDS(MEDCNT),U,10)'="ACTIVE" QUIT
-"RTN","C0CMED6",70,0)
+"RTN","C0CMED6",68,0)
. I 'ALL,PENDING,$P(MEDS(MEDCNT),U,10)'="PENDING" QUIT
-"RTN","C0CMED6",71,0)
+"RTN","C0CMED6",69,0)
. I DEBUG W "MEDCNT IS ",MEDCNT,!
-"RTN","C0CMED6",72,0)
+"RTN","C0CMED6",70,0)
. S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCNT))
-"RTN","C0CMED6",73,0)
+"RTN","C0CMED6",71,0)
. ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED
-"RTN","C0CMED6",74,0)
+"RTN","C0CMED6",72,0)
. I DEBUG W "MAP= ",MAP,!
-"RTN","C0CMED6",75,0)
+"RTN","C0CMED6",73,0)
. S @MAP@("MEDOBJECTID")="MED"_MEDCNT ; MEDCNT FOR ID
-"RTN","C0CMED6",76,0)
+"RTN","C0CMED6",74,0)
. S @MAP@("MEDISSUEDATETXT")="Issue Date"
-"RTN","C0CMED6",77,0)
+"RTN","C0CMED6",75,0)
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,15),"DT")
-"RTN","C0CMED6",78,0)
+"RTN","C0CMED6",76,0)
. S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
-"RTN","C0CMED6",79,0)
+"RTN","C0CMED6",77,0)
. S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,11),"DT")
-"RTN","C0CMED6",80,0)
+"RTN","C0CMED6",78,0)
. S @MAP@("MEDRXNOTXT")="Prescription Number"
-"RTN","C0CMED6",81,0)
+"RTN","C0CMED6",79,0)
. S @MAP@("MEDRXNO")=$P(MEDS(MEDCNT),U,14)
-"RTN","C0CMED6",82,0)
+"RTN","C0CMED6",80,0)
. S @MAP@("MEDTYPETEXT")="Medication"
-"RTN","C0CMED6",83,0)
+"RTN","C0CMED6",81,0)
. S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses
-"RTN","C0CMED6",84,0)
+"RTN","C0CMED6",82,0)
. S @MAP@("MEDSTATUSTEXT")=$P(MEDS(MEDCNT),U,10)
-"RTN","C0CMED6",85,0)
+"RTN","C0CMED6",83,0)
. ; Provider only provided in API as text, not DUZ.
-"RTN","C0CMED6",86,0)
+"RTN","C0CMED6",84,0)
. ; We need to get DUZ from filman file 52 (Prescription)
-"RTN","C0CMED6",87,0)
+"RTN","C0CMED6",85,0)
. ; Field 4; IEN is Piece 2 of Meds stripped of trailing characters.
-"RTN","C0CMED6",88,0)
+"RTN","C0CMED6",86,0)
. ; Note that I will use RXIEN several times later
-"RTN","C0CMED6",89,0)
+"RTN","C0CMED6",87,0)
. N RXIEN S RXIEN=+$P(MEDS(MEDCNT),U,2)
-"RTN","C0CMED6",90,0)
+"RTN","C0CMED6",88,0)
. S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52,RXIEN,4,"I")
-"RTN","C0CMED6",91,0)
+"RTN","C0CMED6",89,0)
. S @MAP@("MEDPRODUCTNAMETEXT")=$P(MEDS(MEDCNT),U,3)
-"RTN","C0CMED6",92,0)
+"RTN","C0CMED6",90,0)
. ; --- RxNorm Stuff
-"RTN","C0CMED6",93,0)
+"RTN","C0CMED6",91,0)
. ; 176.001 is the file for Concepts; 176.003 is the file for
-"RTN","C0CMED6",94,0)
+"RTN","C0CMED6",92,0)
. ; sources (i.e. for RxNorm Version)
-"RTN","C0CMED6",95,0)
+"RTN","C0CMED6",93,0)
. ;
-"RTN","C0CMED6",96,0)
+"RTN","C0CMED6",94,0)
. ; I use 176.001 for the Vista version of this routine (files 1-3)
-"RTN","C0CMED6",97,0)
+"RTN","C0CMED6",95,0)
. ; Since IHS does not have VUID's, I will be getting RxNorm codes
-"RTN","C0CMED6",98,0)
+"RTN","C0CMED6",96,0)
. ; using NDCs. My specially crafted index (sounds evil) named "NDC"
-"RTN","C0CMED6",99,0)
+"RTN","C0CMED6",97,0)
. ; is in file 176.002. The file is called RxNorm NDC to VUID.
-"RTN","C0CMED6",100,0)
+"RTN","C0CMED6",98,0)
. ; Except that I don't need the VUID, but it's there if I need it.
-"RTN","C0CMED6",101,0)
+"RTN","C0CMED6",99,0)
. ;
-"RTN","C0CMED6",102,0)
+"RTN","C0CMED6",100,0)
. ; We obviously need the NDC. That is easily obtained from the prescription.
-"RTN","C0CMED6",103,0)
+"RTN","C0CMED6",101,0)
. ; Field 27 in file 52
-"RTN","C0CMED6",104,0)
+"RTN","C0CMED6",102,0)
. N NDC S NDC=$$GET1^DIQ(52,RXIEN,27,"I")
-"RTN","C0CMED6",105,0)
+"RTN","C0CMED6",103,0)
. ; I discovered that file 176.002 might give you two codes for the NDC
-"RTN","C0CMED6",106,0)
+"RTN","C0CMED6",104,0)
. ; One for the Clinical Drug, and one for the ingredient.
-"RTN","C0CMED6",107,0)
+"RTN","C0CMED6",105,0)
. ; So the plan is to get the two RxNorm codes, and then find from
-"RTN","C0CMED6",108,0)
+"RTN","C0CMED6",106,0)
. ; file 176.001 which one is the Clinical Drug.
-"RTN","C0CMED6",109,0)
+"RTN","C0CMED6",107,0)
. ; ... I refactored this into GETRXN
-"RTN","C0CMED6",110,0)
+"RTN","C0CMED6",108,0)
. N RXNORM,SRCIEN,RXNNAME,RXNVER
-"RTN","C0CMED6",111,0)
+"RTN","C0CMED6",109,0)
. I +NDC,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet.
-"RTN","C0CMED6",112,0)
+"RTN","C0CMED6",110,0)
. . S RXNORM=$$GETRXN(NDC)
-"RTN","C0CMED6",113,0)
+"RTN","C0CMED6",111,0)
. . S SRCIEN=$$FIND1^DIC(176.003,,,"RXNORM","B")
-"RTN","C0CMED6",114,0)
+"RTN","C0CMED6",112,0)
. . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
-"RTN","C0CMED6",115,0)
+"RTN","C0CMED6",113,0)
. . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
-"RTN","C0CMED6",116,0)
+"RTN","C0CMED6",114,0)
. ;
-"RTN","C0CMED6",117,0)
+"RTN","C0CMED6",115,0)
. E S (RXNORM,RXNNAME,RXNVER)=""
-"RTN","C0CMED6",118,0)
+"RTN","C0CMED6",116,0)
. ; End if/else block
-"RTN","C0CMED6",119,0)
+"RTN","C0CMED6",117,0)
. S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
-"RTN","C0CMED6",120,0)
+"RTN","C0CMED6",118,0)
. S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
-"RTN","C0CMED6",121,0)
+"RTN","C0CMED6",119,0)
. S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
-"RTN","C0CMED6",122,0)
+"RTN","C0CMED6",120,0)
. ; --- End RxNorm section
-"RTN","C0CMED6",123,0)
+"RTN","C0CMED6",121,0)
. ;
-"RTN","C0CMED6",124,0)
+"RTN","C0CMED6",122,0)
. ; Brand name is 52 field 6.5
-"RTN","C0CMED6",125,0)
+"RTN","C0CMED6",123,0)
. S @MAP@("MEDBRANDNAMETEXT")=$$GET1^DIQ(52,RXIEN,6.5)
-"RTN","C0CMED6",126,0)
+"RTN","C0CMED6",124,0)
. ;
-"RTN","C0CMED6",127,0)
+"RTN","C0CMED6",125,0)
. ; Next I need Med Form (tab, cap etc), strength (250mg)
-"RTN","C0CMED6",128,0)
+"RTN","C0CMED6",126,0)
. ; concentration for liquids (250mg/mL)
-"RTN","C0CMED6",129,0)
+"RTN","C0CMED6",127,0)
. ; Since IHS does not have any of the new calls that
-"RTN","C0CMED6",130,0)
+"RTN","C0CMED6",128,0)
. ; Vista has, I will be doing a crosswalk:
-"RTN","C0CMED6",131,0)
+"RTN","C0CMED6",129,0)
. ; File 52, field 6 is Drug IEN in file 50
-"RTN","C0CMED6",132,0)
+"RTN","C0CMED6",130,0)
. ; File 50, field 22 is VA Product IEN in file 50.68
-"RTN","C0CMED6",133,0)
+"RTN","C0CMED6",131,0)
. ; In file 50.68, I will get the following:
-"RTN","C0CMED6",134,0)
+"RTN","C0CMED6",132,0)
. ; -- 1: Dosage Form
-"RTN","C0CMED6",135,0)
+"RTN","C0CMED6",133,0)
. ; -- 2: Strength
-"RTN","C0CMED6",136,0)
+"RTN","C0CMED6",134,0)
. ; -- 3: Units
-"RTN","C0CMED6",137,0)
+"RTN","C0CMED6",135,0)
. ; -- 8: Dispense Units
-"RTN","C0CMED6",138,0)
+"RTN","C0CMED6",136,0)
. ; -- Conc is 2 concatenated with 3
-"RTN","C0CMED6",139,0)
+"RTN","C0CMED6",137,0)
. ;
-"RTN","C0CMED6",140,0)
+"RTN","C0CMED6",138,0)
. ; *** If Drug is not matched to NDF, then VA Product will be "" ***
-"RTN","C0CMED6",141,0)
+"RTN","C0CMED6",139,0)
. ;
-"RTN","C0CMED6",142,0)
+"RTN","C0CMED6",140,0)
. N MEDIEN S MEDIEN=$$GET1^DIQ(52,RXIEN,6,"I") ; Drug IEN in 50
-"RTN","C0CMED6",143,0)
+"RTN","C0CMED6",141,0)
. N VAPROD S VAPROD=$$GET1^DIQ(50,MEDIEN,22,"I") ; VA Product in file 50.68
-"RTN","C0CMED6",144,0)
+"RTN","C0CMED6",142,0)
. I +VAPROD D
-"RTN","C0CMED6",145,0)
+"RTN","C0CMED6",143,0)
. . S @MAP@("MEDSTRENGTHVALUE")=$$GET1^DIQ(50.68,VAPROD,2)
-"RTN","C0CMED6",146,0)
+"RTN","C0CMED6",144,0)
. . S @MAP@("MEDSTRENGTHUNIT")=$$GET1^DIQ(50.68,VAPROD,3)
-"RTN","C0CMED6",147,0)
+"RTN","C0CMED6",145,0)
. . S @MAP@("MEDFORMTEXT")=$$GET1^DIQ(50.68,VAPROD,1)
-"RTN","C0CMED6",148,0)
+"RTN","C0CMED6",146,0)
. . S @MAP@("MEDCONCVALUE")=@MAP@("MEDSTRENGTHVALUE")
-"RTN","C0CMED6",149,0)
+"RTN","C0CMED6",147,0)
. . S @MAP@("MEDCONCUNIT")=@MAP@("MEDSTRENGTHUNIT")
-"RTN","C0CMED6",150,0)
+"RTN","C0CMED6",148,0)
. E D
-"RTN","C0CMED6",151,0)
+"RTN","C0CMED6",149,0)
. . S @MAP@("MEDSTRENGTHVALUE")=""
-"RTN","C0CMED6",152,0)
+"RTN","C0CMED6",150,0)
. . S @MAP@("MEDSTRENGTHUNIT")=""
-"RTN","C0CMED6",153,0)
+"RTN","C0CMED6",151,0)
. . S @MAP@("MEDFORMTEXT")=""
-"RTN","C0CMED6",154,0)
+"RTN","C0CMED6",152,0)
. . S @MAP@("MEDCONCVALUE")=""
-"RTN","C0CMED6",155,0)
+"RTN","C0CMED6",153,0)
. . S @MAP@("MEDCONCUNIT")=""
-"RTN","C0CMED6",156,0)
+"RTN","C0CMED6",154,0)
. ; End Strengh/Conc stuff
-"RTN","C0CMED6",157,0)
+"RTN","C0CMED6",155,0)
. ;
-"RTN","C0CMED6",158,0)
+"RTN","C0CMED6",156,0)
. ; Quantity is in the prescription, field 7
-"RTN","C0CMED6",159,0)
+"RTN","C0CMED6",157,0)
. S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52,RXIEN,7)
-"RTN","C0CMED6",160,0)
+"RTN","C0CMED6",158,0)
. ; Dispense unit is in the drug file, field 14.5
-"RTN","C0CMED6",161,0)
+"RTN","C0CMED6",159,0)
. S @MAP@("MEDQUANTITYUNIT")=$$GET1^DIQ(50,MEDIEN,14.5)
-"RTN","C0CMED6",162,0)
+"RTN","C0CMED6",160,0)
. ;
-"RTN","C0CMED6",163,0)
+"RTN","C0CMED6",161,0)
. ; --- START OF DIRECTIONS ---
-"RTN","C0CMED6",164,0)
+"RTN","C0CMED6",162,0)
. ; Sig data not in any API :-( Oh yes, you can get the whole thing, but...
-"RTN","C0CMED6",165,0)
+"RTN","C0CMED6",163,0)
. ; we want the components.
-"RTN","C0CMED6",166,0)
+"RTN","C0CMED6",164,0)
. ; It's in multiple 113 in the Prescription File (52)
-"RTN","C0CMED6",167,0)
+"RTN","C0CMED6",165,0)
. ; #.01 DOSAGE ORDERED [1F] "20"
-"RTN","C0CMED6",168,0)
+"RTN","C0CMED6",166,0)
. ; #1 DISPENSE UNITS PER DOSE [2N] "1"
-"RTN","C0CMED6",169,0)
+"RTN","C0CMED6",167,0)
. ; #2 UNITS [3P:50.607] "MG"
-"RTN","C0CMED6",170,0)
+"RTN","C0CMED6",168,0)
. ; #3 NOUN [4F] "TABLET"
-"RTN","C0CMED6",171,0)
+"RTN","C0CMED6",169,0)
. ; #4 DURATION [5F] "10D"
-"RTN","C0CMED6",172,0)
+"RTN","C0CMED6",170,0)
. ; #5 CONJUNCTION [6S] "AND"
-"RTN","C0CMED6",173,0)
+"RTN","C0CMED6",171,0)
. ; #6 ROUTE [7P:51.2] "ORAL"
-"RTN","C0CMED6",174,0)
+"RTN","C0CMED6",172,0)
. ; #7 SCHEDULE [8F] "BID"
-"RTN","C0CMED6",175,0)
+"RTN","C0CMED6",173,0)
. ; #8 VERB [9F] "TAKE"
-"RTN","C0CMED6",176,0)
+"RTN","C0CMED6",174,0)
. ;
-"RTN","C0CMED6",177,0)
+"RTN","C0CMED6",175,0)
. ; Will use GETS^DIQ to get fields.
-"RTN","C0CMED6",178,0)
+"RTN","C0CMED6",176,0)
. ; Data comes out like this:
-"RTN","C0CMED6",179,0)
+"RTN","C0CMED6",177,0)
. ; SAMINS(52.0113,"1,23,",.01)=20
-"RTN","C0CMED6",180,0)
+"RTN","C0CMED6",178,0)
. ; SAMINS(52.0113,"1,23,",1)=1
-"RTN","C0CMED6",181,0)
+"RTN","C0CMED6",179,0)
. ; SAMINS(52.0113,"1,23,",2)="MG"
-"RTN","C0CMED6",182,0)
+"RTN","C0CMED6",180,0)
. ; SAMINS(52.0113,"1,23,",3)="TABLET"
-"RTN","C0CMED6",183,0)
+"RTN","C0CMED6",181,0)
. ; SAMINS(52.0113,"1,23,",4)="5D"
-"RTN","C0CMED6",184,0)
+"RTN","C0CMED6",182,0)
. ; SAMINS(52.0113,"1,23,",5)="THEN"
-"RTN","C0CMED6",185,0)
+"RTN","C0CMED6",183,0)
. ;
-"RTN","C0CMED6",186,0)
+"RTN","C0CMED6",184,0)
. N RAWDATA
-"RTN","C0CMED6",187,0)
+"RTN","C0CMED6",185,0)
. D GETS^DIQ(52,RXIEN,"113*",,"RAWDATA","DIERR")
-"RTN","C0CMED6",188,0)
+"RTN","C0CMED6",186,0)
. D:$D(DIERR) ^%ZTER ; Log if there's an error in retrieving sig field
-"RTN","C0CMED6",189,0)
+"RTN","C0CMED6",187,0)
. ; none the less, continue; some parts are retrievable.
-"RTN","C0CMED6",190,0)
+"RTN","C0CMED6",188,0)
. N FMSIG M FMSIG=RAWDATA(52.0113) ; Merge into subfile...
-"RTN","C0CMED6",191,0)
+"RTN","C0CMED6",189,0)
. K RAWDATA
-"RTN","C0CMED6",192,0)
+"RTN","C0CMED6",190,0)
. N FMSIGNUM S FMSIGNUM="" ; Sigline number in fileman.
-"RTN","C0CMED6",193,0)
+"RTN","C0CMED6",191,0)
. ; FMSIGNUM gets outputted as "IEN,RXIEN,".
-"RTN","C0CMED6",194,0)
+"RTN","C0CMED6",192,0)
. ; DIRCNT is the proper Sigline numer.
-"RTN","C0CMED6",195,0)
+"RTN","C0CMED6",193,0)
. ; SIGDATA is the simplfied array.
-"RTN","C0CMED6",196,0)
+"RTN","C0CMED6",194,0)
. F S FMSIGNUM=$O(FMSIG(FMSIGNUM)) Q:FMSIGNUM="" D
-"RTN","C0CMED6",197,0)
+"RTN","C0CMED6",195,0)
. . N DIRCNT S DIRCNT=$P(FMSIGNUM,",")
-"RTN","C0CMED6",198,0)
+"RTN","C0CMED6",196,0)
. . N SIGDATA M SIGDATA=FMSIG(FMSIGNUM)
-"RTN","C0CMED6",199,0)
+"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",200,0)
+"RTN","C0CMED6",198,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05.
-"RTN","C0CMED6",201,0)
+"RTN","C0CMED6",199,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$G(SIGDATA(8))
-"RTN","C0CMED6",202,0)
+"RTN","C0CMED6",200,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$G(SIGDATA(.01))
-"RTN","C0CMED6",203,0)
+"RTN","C0CMED6",201,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=$G(SIGDATA(2))
-"RTN","C0CMED6",204,0)
+"RTN","C0CMED6",202,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient
-"RTN","C0CMED6",205,0)
+"RTN","C0CMED6",203,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient
-"RTN","C0CMED6",206,0)
+"RTN","C0CMED6",204,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient
-"RTN","C0CMED6",207,0)
+"RTN","C0CMED6",205,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$G(SIGDATA(6))
-"RTN","C0CMED6",208,0)
+"RTN","C0CMED6",206,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$G(SIGDATA(7))
-"RTN","C0CMED6",209,0)
+"RTN","C0CMED6",207,0)
. . ; Invervals... again another call.
-"RTN","C0CMED6",210,0)
+"RTN","C0CMED6",208,0)
. . ; In the wisdom of the original programmers, the schedule is a free text field
-"RTN","C0CMED6",211,0)
+"RTN","C0CMED6",209,0)
. . ; However, it gets translated by a call to the administration schedule file
-"RTN","C0CMED6",212,0)
+"RTN","C0CMED6",210,0)
. . ; to see if that schedule exists.
-"RTN","C0CMED6",213,0)
+"RTN","C0CMED6",211,0)
. . ; That's the same thing I am going to do.
-"RTN","C0CMED6",214,0)
+"RTN","C0CMED6",212,0)
. . ; Search B index of 51.1 (Admin Schedule) with schedule
-"RTN","C0CMED6",215,0)
+"RTN","C0CMED6",213,0)
. . ; First, remove "PRN" if it exists (don't ask, that's how the file
-"RTN","C0CMED6",216,0)
+"RTN","C0CMED6",214,0)
. . ; works; I wouldn't do it that way).
-"RTN","C0CMED6",217,0)
+"RTN","C0CMED6",215,0)
. . N SCHNOPRN S SCHNOPRN=$G(SIGDATA(7))
-"RTN","C0CMED6",218,0)
+"RTN","C0CMED6",216,0)
. . I SCHNOPRN["PRN" S SCHNOPRN=$E(SCHNOPRN,1,$F(SCHNOPRN,"PRN")-5)
-"RTN","C0CMED6",219,0)
+"RTN","C0CMED6",217,0)
. . ; Super call below:
-"RTN","C0CMED6",220,0)
+"RTN","C0CMED6",218,0)
. . ; 1=File 51.1 3=Field 2 (Frequency in Minutes)
-"RTN","C0CMED6",221,0)
+"RTN","C0CMED6",219,0)
. . ; 4=Packed format, Exact Match 5=Lookup Value
-"RTN","C0CMED6",222,0)
+"RTN","C0CMED6",220,0)
. . ; 6=# of entries to return 7=Index 10=Return Array
-"RTN","C0CMED6",223,0)
+"RTN","C0CMED6",221,0)
. . ;
-"RTN","C0CMED6",224,0)
+"RTN","C0CMED6",222,0)
. . ; I do not account for the fact that two schedules can be
-"RTN","C0CMED6",225,0)
+"RTN","C0CMED6",223,0)
. . ; spelled identically (ie duplicate entry). In that case,
-"RTN","C0CMED6",226,0)
+"RTN","C0CMED6",224,0)
. . ; I get the first. That's just a bad pharmacy pkg maintainer.
-"RTN","C0CMED6",227,0)
+"RTN","C0CMED6",225,0)
. . N C0C515
-"RTN","C0CMED6",228,0)
+"RTN","C0CMED6",226,0)
. . D FIND^DIC(51.1,,"@;2","PX",SCHNOPRN,1,"B",,,"C0C515")
-"RTN","C0CMED6",229,0)
+"RTN","C0CMED6",227,0)
. . N INTERVAL S INTERVAL="" ; Default
-"RTN","C0CMED6",230,0)
+"RTN","C0CMED6",228,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)
+"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",233,0)
+"RTN","C0CMED6",231,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
-"RTN","C0CMED6",234,0)
+"RTN","C0CMED6",232,0)
. . ; Duration is 10M minutes, 10H hours, 10D for Days
-"RTN","C0CMED6",235,0)
+"RTN","C0CMED6",233,0)
. . ; 10W for weeks, 10L for months. I smell $Select
-"RTN","C0CMED6",236,0)
+"RTN","C0CMED6",234,0)
. . ; But we don't need to do that if there isn't a duration
-"RTN","C0CMED6",237,0)
+"RTN","C0CMED6",235,0)
. . I +$G(SIGDATA(4)) D
-"RTN","C0CMED6",238,0)
+"RTN","C0CMED6",236,0)
. . . N DURUNIT S DURUNIT=$E(SIGDATA(4),$L(SIGDATA(4))) ; get last char
-"RTN","C0CMED6",239,0)
+"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",240,0)
+"RTN","C0CMED6",238,0)
. . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=+SIGDATA(4)
-"RTN","C0CMED6",241,0)
+"RTN","C0CMED6",239,0)
. . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=DURTXT
-"RTN","C0CMED6",242,0)
+"RTN","C0CMED6",240,0)
. . E D
-"RTN","C0CMED6",243,0)
+"RTN","C0CMED6",241,0)
. . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=""
-"RTN","C0CMED6",244,0)
+"RTN","C0CMED6",242,0)
. . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
-"RTN","C0CMED6",245,0)
+"RTN","C0CMED6",243,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$G(SIGDATA(4))["PRN"
-"RTN","C0CMED6",246,0)
+"RTN","C0CMED6",244,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")="" ; when avail
-"RTN","C0CMED6",247,0)
+"RTN","C0CMED6",245,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
-"RTN","C0CMED6",248,0)
+"RTN","C0CMED6",246,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
-"RTN","C0CMED6",249,0)
+"RTN","C0CMED6",247,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
-"RTN","C0CMED6",250,0)
+"RTN","C0CMED6",248,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
-"RTN","C0CMED6",251,0)
+"RTN","C0CMED6",249,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
-"RTN","C0CMED6",252,0)
+"RTN","C0CMED6",250,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
-"RTN","C0CMED6",253,0)
+"RTN","C0CMED6",251,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; not stored
-"RTN","C0CMED6",254,0)
+"RTN","C0CMED6",252,0)
. . ; Another confusing line; I am pretty bad:
-"RTN","C0CMED6",255,0)
+"RTN","C0CMED6",253,0)
. . ; If there is another entry in the FMSIG array (i.e. another line
-"RTN","C0CMED6",256,0)
+"RTN","C0CMED6",254,0)
. . ; in the sig), set the direction count indicator.
-"RTN","C0CMED6",257,0)
+"RTN","C0CMED6",255,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")="" ; Default
-"RTN","C0CMED6",258,0)
+"RTN","C0CMED6",256,0)
. . S:+$O(FMSIG(FMSIGNUM)) @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRCNT
-"RTN","C0CMED6",259,0)
+"RTN","C0CMED6",257,0)
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$G(SIGDATA(5))
+"RTN","C0CMED6",258,0)
+ . ;
+"RTN","C0CMED6",259,0)
+ . ; --- END OF DIRECTIONS ---
"RTN","C0CMED6",260,0)
. ;
"RTN","C0CMED6",261,0)
- . ; --- END OF DIRECTIONS ---
-"RTN","C0CMED6",262,0)
- . ;
-"RTN","C0CMED6",263,0)
. ; Med instructions is a WP field, thus the acrobatics
-"RTN","C0CMED6",264,0)
+"RTN","C0CMED6",262,0)
. ; Notice buffer overflow protection set at 10,000 chars
-"RTN","C0CMED6",265,0)
+"RTN","C0CMED6",263,0)
. ; -- 1. Med Patient Instructions
-"RTN","C0CMED6",266,0)
+"RTN","C0CMED6",264,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)
+"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",269,0)
+"RTN","C0CMED6",267,0)
. S @MAP@("MEDPTINSTRUCTIONS")=MEDPTIN2
-"RTN","C0CMED6",270,0)
+"RTN","C0CMED6",268,0)
. K J
-"RTN","C0CMED6",271,0)
+"RTN","C0CMED6",269,0)
. ; -- 2. Med Provider Instructions
-"RTN","C0CMED6",272,0)
+"RTN","C0CMED6",270,0)
. N MEDPVIN1 S MEDPVIN1=$$GET1^DIQ(52,RXIEN,39,,"MEDPVIN1")
-"RTN","C0CMED6",273,0)
+"RTN","C0CMED6",271,0)
. N MEDPVIN2,J S (MEDPVIN2,J)=""
-"RTN","C0CMED6",274,0)
+"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",275,0)
+"RTN","C0CMED6",273,0)
. S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MEDPVIN2
-"RTN","C0CMED6",276,0)
+"RTN","C0CMED6",274,0)
. ;
-"RTN","C0CMED6",277,0)
+"RTN","C0CMED6",275,0)
. ; Remaining refills
-"RTN","C0CMED6",278,0)
+"RTN","C0CMED6",276,0)
. S @MAP@("MEDRFNO")=$P(MEDS(MEDCNT),U,6)
-"RTN","C0CMED6",279,0)
+"RTN","C0CMED6",277,0)
. ; ------ END OF MAPPING
-"RTN","C0CMED6",280,0)
+"RTN","C0CMED6",278,0)
. ;
-"RTN","C0CMED6",281,0)
+"RTN","C0CMED6",279,0)
. ; ------ BEGIN XML INSERTION
-"RTN","C0CMED6",282,0)
+"RTN","C0CMED6",280,0)
. N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
-"RTN","C0CMED6",283,0)
+"RTN","C0CMED6",281,0)
. K @RESULT
-"RTN","C0CMED6",284,0)
+"RTN","C0CMED6",282,0)
. D MAP^C0CXPATH(MINXML,MAP,RESULT)
-"RTN","C0CMED6",285,0)
+"RTN","C0CMED6",283,0)
. ; D PARY^C0CXPATH(RESULT)
-"RTN","C0CMED6",286,0)
+"RTN","C0CMED6",284,0)
. ; MAPPING DIRECTIONS
-"RTN","C0CMED6",287,0)
+"RTN","C0CMED6",285,0)
. N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
-"RTN","C0CMED6",288,0)
+"RTN","C0CMED6",286,0)
. N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
-"RTN","C0CMED6",289,0)
+"RTN","C0CMED6",287,0)
. D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
-"RTN","C0CMED6",290,0)
+"RTN","C0CMED6",288,0)
. D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
-"RTN","C0CMED6",291,0)
+"RTN","C0CMED6",289,0)
. ; N MDZ1,MDZNA
-"RTN","C0CMED6",292,0)
+"RTN","C0CMED6",290,0)
. N DIRCNT S DIRCNT=""
-"RTN","C0CMED6",293,0)
+"RTN","C0CMED6",291,0)
. I +$O(@MAP@("M","DIRECTIONS",DIRCNT)) D ; IF THERE ARE DIRCTIONS
-"RTN","C0CMED6",294,0)
+"RTN","C0CMED6",292,0)
. . F DIRCNT=$O(@MAP@("M","DIRECTIONS",DIRCNT)) D ; FOR EACH DIRECTION
-"RTN","C0CMED6",295,0)
+"RTN","C0CMED6",293,0)
. . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",DIRCNT))
-"RTN","C0CMED6",296,0)
+"RTN","C0CMED6",294,0)
. . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
-"RTN","C0CMED6",297,0)
+"RTN","C0CMED6",295,0)
. . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
-"RTN","C0CMED6",298,0)
+"RTN","C0CMED6",296,0)
. D:MEDCNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
-"RTN","C0CMED6",299,0)
+"RTN","C0CMED6",297,0)
. D:MEDCNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
-"RTN","C0CMED6",300,0)
+"RTN","C0CMED6",298,0)
. S MEDCOUNT=MEDCNT
-"RTN","C0CMED6",301,0)
+"RTN","C0CMED6",299,0)
N MEDTMP,MEDI
-"RTN","C0CMED6",302,0)
+"RTN","C0CMED6",300,0)
D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","C0CMED6",303,0)
+"RTN","C0CMED6",301,0)
I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","C0CMED6",304,0)
+"RTN","C0CMED6",302,0)
. W "MEDICATION MISSING ",!
-"RTN","C0CMED6",305,0)
+"RTN","C0CMED6",303,0)
. F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","C0CMED6",306,0)
+"RTN","C0CMED6",304,0)
Q
-"RTN","C0CMED6",307,0)
+"RTN","C0CMED6",305,0)
;
-"RTN","C0CMED6",308,0)
+"RTN","C0CMED6",306,0)
GETRXN(NDC) ; Extrinsic Function; PUBLIC; NDC to RxNorm
-"RTN","C0CMED6",309,0)
+"RTN","C0CMED6",307,0)
;; Get RxNorm Concept Number for a Given NDC
-"RTN","C0CMED6",310,0)
+"RTN","C0CMED6",308,0)
;
-"RTN","C0CMED6",311,0)
+"RTN","C0CMED6",309,0)
S NDC=$TR(NDC,"-") ; Remove dashes
-"RTN","C0CMED6",312,0)
+"RTN","C0CMED6",310,0)
N RXNORM,C0CZRXN,DIERR
-"RTN","C0CMED6",313,0)
+"RTN","C0CMED6",311,0)
D FIND^DIC(176.002,,"@;.01","PX",NDC,"*","NDC",,,"C0CZRXN","DIERR")
-"RTN","C0CMED6",314,0)
- I $D(DIERR) D ^%ZTER BREAK
-"RTN","C0CMED6",315,0)
+"RTN","C0CMED6",312,0)
+ I $D(DIERR) S $EC=",U1,"
+"RTN","C0CMED6",313,0)
S RXNORM(0)=+C0CZRXN("DILIST",0) ; RxNorm(0) will be # of entries
-"RTN","C0CMED6",316,0)
+"RTN","C0CMED6",314,0)
N I S I=0
-"RTN","C0CMED6",317,0)
+"RTN","C0CMED6",315,0)
F S I=$O(C0CZRXN("DILIST",I)) Q:I="" S RXNORM(I)=$P(C0CZRXN("DILIST",I,0),U,2)
-"RTN","C0CMED6",318,0)
+"RTN","C0CMED6",316,0)
; At this point, RxNorm(0) is # of entries; RxNorm(1...) are the entries
-"RTN","C0CMED6",319,0)
+"RTN","C0CMED6",317,0)
; If RxNorm(0) is 1, then we only have one entry, and that's it.
-"RTN","C0CMED6",320,0)
+"RTN","C0CMED6",318,0)
I RXNORM(0)=1 QUIT RXNORM(1) ; RETURN RXNORM(1)
-"RTN","C0CMED6",321,0)
+"RTN","C0CMED6",319,0)
; Otherwise, we need to find out which one is the semantic
-"RTN","C0CMED6",322,0)
+"RTN","C0CMED6",320,0)
; clinical drug. I built an index on 176.001 (RxNorm Concepts)
-"RTN","C0CMED6",323,0)
+"RTN","C0CMED6",321,0)
; for that purpose.
-"RTN","C0CMED6",324,0)
+"RTN","C0CMED6",322,0)
I RXNORM(0)>1 D
-"RTN","C0CMED6",325,0)
+"RTN","C0CMED6",323,0)
. S I=0
-"RTN","C0CMED6",326,0)
+"RTN","C0CMED6",324,0)
. F S I=$O(RXNORM(I)) Q:I="" D Q:$G(RXNORM)
-"RTN","C0CMED6",327,0)
+"RTN","C0CMED6",325,0)
. . N RXNIEN S RXNIEN=$$FIND1^DIC(176.001,,,RXNORM(I),"SCD")
-"RTN","C0CMED6",328,0)
+"RTN","C0CMED6",326,0)
. . I +$G(RXNIEN)=0 QUIT ; try the next entry...
-"RTN","C0CMED6",329,0)
+"RTN","C0CMED6",327,0)
. . E S RXNORM=RXNORM(I) QUIT ; We found the right code
-"RTN","C0CMED6",330,0)
+"RTN","C0CMED6",328,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)
;
+"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 .
"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)
- Q
-"RTN","C0CMIME",21,0)
- ;
-"RTN","C0CMIME",22,0)
TEST(ZDFN) ;
-"RTN","C0CMIME",23,0)
+"RTN","C0CMIME",21,0)
D CCRRPC^C0CCCR(.ZCCR,ZDFN) ; GET A CCR TO WORK WITH
-"RTN","C0CMIME",24,0)
+"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)
- S ZCOPY(1)=""
-"RTN","C0CMIME",26,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)
+"RTN","C0CMIME",26,0)
. S ZCOPY(1)=ZCOPY(1)_ZCCR(ZI)
-"RTN","C0CMIME",29,0)
+"RTN","C0CMIME",27,0)
;D ENCODE("ZCOPY",1,ZCOPY(1))
-"RTN","C0CMIME",30,0)
+"RTN","C0CMIME",28,0)
S G(1)=$$ENCODE^RGUTUU(ZCOPY(1))
-"RTN","C0CMIME",31,0)
+"RTN","C0CMIME",29,0)
D CHUNK("G2","G",45)
-"RTN","C0CMIME",32,0)
+"RTN","C0CMIME",30,0)
Q
-"RTN","C0CMIME",33,0)
+"RTN","C0CMIME",31,0)
ENCODE(ZRTN,ZARY) ;
-"RTN","C0CMIME",34,0)
+"RTN","C0CMIME",32,0)
; ROUTINE TO ENCODE AN XML DOCUMENT FOR SENDING
-"RTN","C0CMIME",35,0)
+"RTN","C0CMIME",33,0)
; ZARY IS PASSED BY NAME
-"RTN","C0CMIME",36,0)
+"RTN","C0CMIME",34,0)
; ZRTN IS PASSED BY REFERENCE AND IS THE RETURN
-"RTN","C0CMIME",37,0)
+"RTN","C0CMIME",35,0)
;
-"RTN","C0CMIME",38,0)
+"RTN","C0CMIME",36,0)
S ZCOPY(1)=""
-"RTN","C0CMIME",39,0)
+"RTN","C0CMIME",37,0)
N ZI S ZI=0
-"RTN","C0CMIME",40,0)
+"RTN","C0CMIME",38,0)
F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH LINE
-"RTN","C0CMIME",41,0)
+"RTN","C0CMIME",39,0)
. S ZCOPY(1)=ZCOPY(1)_@ZARY@(ZI)
-"RTN","C0CMIME",42,0)
+"RTN","C0CMIME",40,0)
N G
-"RTN","C0CMIME",43,0)
+"RTN","C0CMIME",41,0)
S G(1)=$$ENCODE^RGUTUU(ZCOPY(1))
-"RTN","C0CMIME",44,0)
+"RTN","C0CMIME",42,0)
D CHUNK(ZRTN,"G",45)
-"RTN","C0CMIME",45,0)
+"RTN","C0CMIME",43,0)
Q
-"RTN","C0CMIME",46,0)
+"RTN","C0CMIME",44,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)
+"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",49,0)
+"RTN","C0CMIME",47,0)
; IARY IS PASSED BY NAME
-"RTN","C0CMIME",50,0)
+"RTN","C0CMIME",48,0)
S LRQUIT=0,LRLEN=$L(LRSTR)
-"RTN","C0CMIME",51,0)
+"RTN","C0CMIME",49,0)
F D Q:LRQUIT
-"RTN","C0CMIME",52,0)
+"RTN","C0CMIME",50,0)
. I $L(LRSTR)<45 S LRQUIT=1 Q
-"RTN","C0CMIME",53,0)
+"RTN","C0CMIME",51,0)
. S LRX=$E(LRSTR,1,45)
-"RTN","C0CMIME",54,0)
+"RTN","C0CMIME",52,0)
. S LRNODE=LRNODE+1,@IARY@(LRNODE)=$$UUEN^LRSRVR4(LRX)
-"RTN","C0CMIME",55,0)
+"RTN","C0CMIME",53,0)
. S LRSTR=$E(LRSTR,46,LRLEN)
+"RTN","C0CMIME",54,0)
+ Q
+"RTN","C0CMIME",55,0)
+ ;
"RTN","C0CMIME",56,0)
- Q
-"RTN","C0CMIME",57,0)
- ;
-"RTN","C0CMIME",58,0)
TESTMAIL ;
-"RTN","C0CMIME",59,0)
+"RTN","C0CMIME",57,0)
; TEST OF MAILSEND
-"RTN","C0CMIME",60,0)
+"RTN","C0CMIME",58,0)
;S ZTO("glilly@glilly.net")=""
-"RTN","C0CMIME",61,0)
+"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("martijn@djigzo.com")=""
+ ;S ZTO("nanthracite@earthlink.net")=""
"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",64,0)
+ S ZATTACH=$NA(^GPL("CCR"))
+"RTN","C0CMIME",65,0)
+ I $G(@ZATTACH@(1))="" D ; NO CCR THERE
"RTN","C0CMIME",66,0)
- S ZATTACH=$NA(^GPL("CCR"))
+ . D CCRRPC^C0CCCR(.GPL,2) ; GET ONE FROM PATIENT 2
"RTN","C0CMIME",67,0)
- I $G(@ZATTACH@(1))="" D ; NO CCR THERE
+ . M @ZATTACH=GPL ; PUT IT IN THERE FOR NEXT TIME
"RTN","C0CMIME",68,0)
- . D CCRRPC^C0CCCR(.GPL,2) ; GET ONE FROM PATIENT 2
+ S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE"
"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",70,0)
+ ; ZWR GR
+"RTN","C0CMIME",71,0)
+ Q
"RTN","C0CMIME",72,0)
- ZWR GR
+ ;
"RTN","C0CMIME",73,0)
- Q
+TESTMAI2 ;
"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)
+"RTN","C0CMIME",75,0)
N C0CGM
-"RTN","C0CMIME",78,0)
+"RTN","C0CMIME",76,0)
S C0CGM(1)="This is a test message."
-"RTN","C0CMIME",79,0)
+"RTN","C0CMIME",77,0)
S C0CGM(2)="A Continuity of Care record is attached"
-"RTN","C0CMIME",80,0)
+"RTN","C0CMIME",78,0)
S C0CGM(3)="It contains no Protected Health Information (PHI)"
-"RTN","C0CMIME",81,0)
+"RTN","C0CMIME",79,0)
S C0CGM(4)="It is purely test data used for software development"
-"RTN","C0CMIME",82,0)
+"RTN","C0CMIME",80,0)
S C0CGM(5)="It does not represent information about any person living or dead"
-"RTN","C0CMIME",83,0)
+"RTN","C0CMIME",81,0)
;S ZTO("glilly@glilly.net")=""
-"RTN","C0CMIME",84,0)
+"RTN","C0CMIME",82,0)
;S ZTO("george.lilly@pobox.com")=""
-"RTN","C0CMIME",85,0)
+"RTN","C0CMIME",83,0)
;S ZTO("george@nhin.openforum.opensourcevista.net")=""
-"RTN","C0CMIME",86,0)
+"RTN","C0CMIME",84,0)
;S ZTO("mish@nhin.openforum.opensourcevista.net")=""
-"RTN","C0CMIME",87,0)
- S ZTO("brooks.richard@securemail.opensourcevista.net")=""
-"RTN","C0CMIME",88,0)
+"RTN","C0CMIME",85,0)
+ S ZTO("brooks.richard@securemail.opensourcevista.net")=""
+"RTN","C0CMIME",86,0)
;S ZTO("LILLY.GEORGE@mdc-crew.net")=""
-"RTN","C0CMIME",89,0)
+"RTN","C0CMIME",87,0)
;S ZTO("ncoal@live.com")=""
-"RTN","C0CMIME",90,0)
+"RTN","C0CMIME",88,0)
;S ZTO("martijn@djigzo.com")=""
-"RTN","C0CMIME",91,0)
+"RTN","C0CMIME",89,0)
;S ZTO("profmish@gmail.com")=""
-"RTN","C0CMIME",92,0)
+"RTN","C0CMIME",90,0)
;S ZTO("nanthracite@earthlink.net")=""
-"RTN","C0CMIME",93,0)
+"RTN","C0CMIME",91,0)
S ZTO("gpl.doctortest@gmail.com")=""
-"RTN","C0CMIME",94,0)
+"RTN","C0CMIME",92,0)
S ZFROM="LILLY.GEORGE"
-"RTN","C0CMIME",95,0)
+"RTN","C0CMIME",93,0)
S ZATTACH=$NA(^GPL("CCR"))
-"RTN","C0CMIME",96,0)
+"RTN","C0CMIME",94,0)
I $G(@ZATTACH@(1))="" D ; NO CCR THERE
-"RTN","C0CMIME",97,0)
+"RTN","C0CMIME",95,0)
. D CCRRPC^C0CCCR(.GPL,2) ; GET ONE FROM PATIENT 2
-"RTN","C0CMIME",98,0)
+"RTN","C0CMIME",96,0)
. M @ZATTACH=GPL ; PUT IT IN THERE FOR NEXT TIME
-"RTN","C0CMIME",99,0)
+"RTN","C0CMIME",97,0)
S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE"
-"RTN","C0CMIME",100,0)
+"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)
- 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)
+"RTN","C0CMIME",103,0)
; the email address in C0CTO
-"RTN","C0CMIME",106,0)
+"RTN","C0CMIME",104,0)
; the directory and the "from" are all hard coded
-"RTN","C0CMIME",107,0)
+"RTN","C0CMIME",105,0)
;
-"RTN","C0CMIME",108,0)
+"RTN","C0CMIME",106,0)
N ZZFROM S ZZFROM="LILLY.GEORGE"
-"RTN","C0CMIME",109,0)
+"RTN","C0CMIME",107,0)
N GN S GN=$NA(^TMP("C0CMIME2",$J))
-"RTN","C0CMIME",110,0)
+"RTN","C0CMIME",108,0)
N GN1 S GN1=$NA(@GN@(1))
-"RTN","C0CMIME",111,0)
+"RTN","C0CMIME",109,0)
K @GN
-"RTN","C0CMIME",112,0)
+"RTN","C0CMIME",110,0)
I '$D(C0CFILE) Q ; NO FILENAME PASSED
-"RTN","C0CMIME",113,0)
+"RTN","C0CMIME",111,0)
I '$D(C0CTO) S C0CTO="brooks.richard@securemail.opensourcevista.net"
-"RTN","C0CMIME",114,0)
+"RTN","C0CMIME",112,0)
S ZZTO(C0CTO)=""
-"RTN","C0CMIME",115,0)
+"RTN","C0CMIME",113,0)
N ZMESS S ZMESS(1)="file transmission from wvehr3-09"
-"RTN","C0CMIME",116,0)
+"RTN","C0CMIME",114,0)
N GD S GD="/home/wvehr3-09/EHR/" ; directory
-"RTN","C0CMIME",117,0)
+"RTN","C0CMIME",115,0)
I '$$FTG^%ZISH(GD,C0CFILE,GN1,3) Q D ;
-"RTN","C0CMIME",118,0)
+"RTN","C0CMIME",116,0)
. W !,"error reading file",C0CFILE
-"RTN","C0CMIME",119,0)
+"RTN","C0CMIME",117,0)
D MAILSEND(.ZRTN,ZZFROM,"ZZTO",,"file transmission","ZMESS",GN,C0CFILE)
-"RTN","C0CMIME",120,0)
+"RTN","C0CMIME",118,0)
K @GN ; CLEAN UP
-"RTN","C0CMIME",121,0)
+"RTN","C0CMIME",119,0)
;ZWR ZRTN
-"RTN","C0CMIME",122,0)
+"RTN","C0CMIME",120,0)
W !,$G(ZRTN(1))
+"RTN","C0CMIME",121,0)
+ Q
+"RTN","C0CMIME",122,0)
+ ;
"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","C0CMIME",124,0)
; RTN IS THE RETURN ARRAY PASSED BY REFERENCE
-"RTN","C0CMIME",127,0)
+"RTN","C0CMIME",125,0)
; FROM IS PASSED BY VALUE AND IS THE EMAIL ADDRESS OF THE SENDER
-"RTN","C0CMIME",128,0)
+"RTN","C0CMIME",126,0)
; IF NULL, WILL SEND FROM THE CURRENT DUZ
-"RTN","C0CMIME",129,0)
+"RTN","C0CMIME",127,0)
; TO AND CC ARE RECIEPIENT EMAIL ADDRESSES PASSED BY NAME
-"RTN","C0CMIME",130,0)
+"RTN","C0CMIME",128,0)
; @TO@("addr1@domain1.net")
-"RTN","C0CMIME",131,0)
+"RTN","C0CMIME",129,0)
; @CC@("addr2@domain2.com") both can be multiples
-"RTN","C0CMIME",132,0)
+"RTN","C0CMIME",130,0)
; SUBJECT IS PASSED BY VALUE AND WILL GO IN THE SUBJECT LINE
-"RTN","C0CMIME",133,0)
+"RTN","C0CMIME",131,0)
; MESSAGE IS PASSED BY NAME AND IS AN ARRAY OF TEXT
-"RTN","C0CMIME",134,0)
+"RTN","C0CMIME",132,0)
; ATTACH IS PASSED BY NAME AND IS AN XML OR HTML FILE TO BE ATTACHED
-"RTN","C0CMIME",135,0)
+"RTN","C0CMIME",133,0)
; FNAME IS THE FILENAME OF THE ATTACHMENT, DEFAULT IS ccr.xml
-"RTN","C0CMIME",136,0)
+"RTN","C0CMIME",134,0)
;
-"RTN","C0CMIME",137,0)
+"RTN","C0CMIME",135,0)
I '$D(FNAME) S FNAME="ccr.xml" ; default filename
-"RTN","C0CMIME",138,0)
+"RTN","C0CMIME",136,0)
N GN
-"RTN","C0CMIME",139,0)
+"RTN","C0CMIME",137,0)
S GN=$NA(^TMP($J,"C0CMIME"))
-"RTN","C0CMIME",140,0)
+"RTN","C0CMIME",138,0)
K @GN
-"RTN","C0CMIME",141,0)
+"RTN","C0CMIME",139,0)
S GM(1)="MIME-Version: 1.0"
-"RTN","C0CMIME",142,0)
+"RTN","C0CMIME",140,0)
S GM(2)="Content-Type: multipart/mixed; boudary=""1234567"""
-"RTN","C0CMIME",143,0)
+"RTN","C0CMIME",141,0)
S GM(3)=""
-"RTN","C0CMIME",144,0)
+"RTN","C0CMIME",142,0)
S GM(4)=""
-"RTN","C0CMIME",145,0)
+"RTN","C0CMIME",143,0)
;S GM(5)="--123456788888"
-"RTN","C0CMIME",146,0)
+"RTN","C0CMIME",144,0)
;S GM(5)=$$REPEAT^XLFSTR("-",$L(X))
-"RTN","C0CMIME",147,0)
+"RTN","C0CMIME",145,0)
S GM(5)="--123456899999"
-"RTN","C0CMIME",148,0)
+"RTN","C0CMIME",146,0)
S GM(6)="Content-Type: text/xml; name="_FNAME
-"RTN","C0CMIME",149,0)
+"RTN","C0CMIME",147,0)
S GM(7)="Content-Transfer-Encoding: base64"
-"RTN","C0CMIME",150,0)
+"RTN","C0CMIME",148,0)
S GM(8)="Content-Disposition: attachment; filename="_FNAME
-"RTN","C0CMIME",151,0)
+"RTN","C0CMIME",149,0)
S GM(9)=""
-"RTN","C0CMIME",152,0)
+"RTN","C0CMIME",150,0)
S GM(10)="" ; FOR THE END
-"RTN","C0CMIME",153,0)
+"RTN","C0CMIME",151,0)
;S GM(11)="--123456788888--"
-"RTN","C0CMIME",154,0)
+"RTN","C0CMIME",152,0)
S GM(11)="--123456899999--"
-"RTN","C0CMIME",155,0)
+"RTN","C0CMIME",153,0)
S GM(12)=""
-"RTN","C0CMIME",156,0)
+"RTN","C0CMIME",154,0)
S GM(13)=""
-"RTN","C0CMIME",157,0)
+"RTN","C0CMIME",155,0)
S GG(1)="--123456899999"
-"RTN","C0CMIME",158,0)
+"RTN","C0CMIME",156,0)
S GG(2)="Content-Type: text/plain; charset=ISO-8859-1; format=flowed"
-"RTN","C0CMIME",159,0)
+"RTN","C0CMIME",157,0)
S GG(3)="Content-Transfer-Encoding: 7bit"
-"RTN","C0CMIME",160,0)
+"RTN","C0CMIME",158,0)
S GG(4)=""
-"RTN","C0CMIME",161,0)
+"RTN","C0CMIME",159,0)
S GG(5)="This is a test message."
-"RTN","C0CMIME",162,0)
+"RTN","C0CMIME",160,0)
S GG(6)="A Continuity of Care record is attached"
-"RTN","C0CMIME",163,0)
+"RTN","C0CMIME",161,0)
S GG(7)="It contains no Protected Health Information (PHI)"
-"RTN","C0CMIME",164,0)
+"RTN","C0CMIME",162,0)
S GG(8)="It is purely test data used for software development"
-"RTN","C0CMIME",165,0)
+"RTN","C0CMIME",163,0)
S GG(9)="It does not represent information about any person living or dead"
-"RTN","C0CMIME",166,0)
+"RTN","C0CMIME",164,0)
S GG(10)=""
-"RTN","C0CMIME",167,0)
+"RTN","C0CMIME",165,0)
S GG(11)="--123456899999--"
-"RTN","C0CMIME",168,0)
+"RTN","C0CMIME",166,0)
;S GG(11)="Content-Type: text/plain; charset=""us-ascii"""
-"RTN","C0CMIME",169,0)
+"RTN","C0CMIME",167,0)
S GG(12)=""
-"RTN","C0CMIME",170,0)
+"RTN","C0CMIME",168,0)
;S GG(13)="This is a test message."
-"RTN","C0CMIME",171,0)
+"RTN","C0CMIME",169,0)
S GG(14)="A Continuity of Care record is attached"
-"RTN","C0CMIME",172,0)
+"RTN","C0CMIME",170,0)
S GG(15)="It contains no Protected Health Information (PHI)"
-"RTN","C0CMIME",173,0)
+"RTN","C0CMIME",171,0)
S GG(16)="It is purely test data used for software development"
-"RTN","C0CMIME",174,0)
+"RTN","C0CMIME",172,0)
S GG(17)="It does not represent information about any person living or dead"
-"RTN","C0CMIME",175,0)
+"RTN","C0CMIME",173,0)
S GG(18)=""
-"RTN","C0CMIME",176,0)
+"RTN","C0CMIME",174,0)
S GG(19)="--123456899999"
-"RTN","C0CMIME",177,0)
+"RTN","C0CMIME",175,0)
S GG(20)="--987654321--"
-"RTN","C0CMIME",178,0)
+"RTN","C0CMIME",176,0)
K GBLD
-"RTN","C0CMIME",179,0)
+"RTN","C0CMIME",177,0)
;D QUEUE^C0CXPATH("GBLD","GGG",1,3) ; THE MESSAGE
-"RTN","C0CMIME",180,0)
+"RTN","C0CMIME",178,0)
;D QUEUE^C0CXPATH("GBLD","GG",1,10) ; THE MESSAGE
-"RTN","C0CMIME",181,0)
+"RTN","C0CMIME",179,0)
I $D(MESSAGE)'="" D ; THERE IS A MESSAGE
-"RTN","C0CMIME",182,0)
+"RTN","C0CMIME",180,0)
. D QUEUE^C0CXPATH("GBLD","GG",1,4) ; THE MIME BOUNDARY
-"RTN","C0CMIME",183,0)
+"RTN","C0CMIME",181,0)
. D QUEUE^C0CXPATH("GBLD",MESSAGE,1,$O(@MESSAGE@(""),-1)) ;THE MESSAGE
-"RTN","C0CMIME",184,0)
+"RTN","C0CMIME",182,0)
. D QUEUE^C0CXPATH("GBLD","GG",10,10) ;A BLANK LINE
-"RTN","C0CMIME",185,0)
+"RTN","C0CMIME",183,0)
D QUEUE^C0CXPATH("GBLD","GM",5,9)
-"RTN","C0CMIME",186,0)
+"RTN","C0CMIME",184,0)
I $D(ATTACH)'="" D ; IF WE HAVE AN ATTACHMENT
-"RTN","C0CMIME",187,0)
+"RTN","C0CMIME",185,0)
. D ENCODE("G2",ATTACH) ; ENCODE FOR SENDING
-"RTN","C0CMIME",188,0)
+"RTN","C0CMIME",186,0)
. D QUEUE^C0CXPATH("GBLD","G2",1,$O(G2(""),-1))
-"RTN","C0CMIME",189,0)
+"RTN","C0CMIME",187,0)
D QUEUE^C0CXPATH("GBLD","GM",11,12)
-"RTN","C0CMIME",190,0)
+"RTN","C0CMIME",188,0)
D BUILD^C0CXPATH("GBLD",GN)
-"RTN","C0CMIME",191,0)
+"RTN","C0CMIME",189,0)
;S GGG=$NA(^GPL("MIME2"))
-"RTN","C0CMIME",192,0)
+"RTN","C0CMIME",190,0)
K @GN@(0) ; KILL THE LINE COUNT
-"RTN","C0CMIME",193,0)
+"RTN","C0CMIME",191,0)
K LRINSTR,LRTASK,LRTO,XMERR,XMZ
-"RTN","C0CMIME",194,0)
+"RTN","C0CMIME",192,0)
M LRTO=@TO
-"RTN","C0CMIME",195,0)
+"RTN","C0CMIME",193,0)
I $D(CC) M LRTO=@CC
-"RTN","C0CMIME",196,0)
+"RTN","C0CMIME",194,0)
S LRINSTR("ADDR FLAGS")="R"
-"RTN","C0CMIME",197,0)
+"RTN","C0CMIME",195,0)
S LRINSTR("FROM")=$G(FROM)
-"RTN","C0CMIME",198,0)
+"RTN","C0CMIME",196,0)
S LRMSUBJ=$G(SUBJECT)
-"RTN","C0CMIME",199,0)
+"RTN","C0CMIME",197,0)
S LRMSUBJ=$E(LRMSUBJ,1,65)
-"RTN","C0CMIME",200,0)
+"RTN","C0CMIME",198,0)
D SENDMSG^XMXAPI(DUZ,LRMSUBJ,GN,.LRTO,.LRINSTR,.LRTASK)
-"RTN","C0CMIME",201,0)
+"RTN","C0CMIME",199,0)
I $G(XMERR)=1 S RTN(1)="ERROR SENDING MESSAGE" Q ;
-"RTN","C0CMIME",202,0)
+"RTN","C0CMIME",200,0)
S RTN(1)="OK"
-"RTN","C0CMIME",203,0)
+"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)
-MAILSEND0(LRMSUBJ) ; Send extract back to requestor.
-"RTN","C0CMIME",206,0)
- ;
-"RTN","C0CMIME",207,0)
;D TEST
-"RTN","C0CMIME",208,0)
+"RTN","C0CMIME",206,0)
S GN=$NA(^TMP($J,"C0CMIME"))
-"RTN","C0CMIME",209,0)
+"RTN","C0CMIME",207,0)
K @GN
-"RTN","C0CMIME",210,0)
+"RTN","C0CMIME",208,0)
;M @GN=G2
-"RTN","C0CMIME",211,0)
+"RTN","C0CMIME",209,0)
S GM(1)="MIME-Version: 1.0"
-"RTN","C0CMIME",212,0)
+"RTN","C0CMIME",210,0)
S GM(2)="Content-Type: multipart/mixed; boudary=""1234567"""
-"RTN","C0CMIME",213,0)
+"RTN","C0CMIME",211,0)
S GM(3)=""
-"RTN","C0CMIME",214,0)
+"RTN","C0CMIME",212,0)
S GM(4)=""
-"RTN","C0CMIME",215,0)
+"RTN","C0CMIME",213,0)
S GM(5)="--1234567"
-"RTN","C0CMIME",216,0)
+"RTN","C0CMIME",214,0)
;S GM(5)=$$REPEAT^XLFSTR("-",$L(X))
-"RTN","C0CMIME",217,0)
+"RTN","C0CMIME",215,0)
S GM(6)="Content-Type: text/xml; name=""ccr.xml"""
-"RTN","C0CMIME",218,0)
+"RTN","C0CMIME",216,0)
S GM(7)="Content-Transfer-Encoding: base64"
-"RTN","C0CMIME",219,0)
+"RTN","C0CMIME",217,0)
S GM(8)="Content-Disposition: attachment; filename=""ccr.xml"""
-"RTN","C0CMIME",220,0)
+"RTN","C0CMIME",218,0)
;S GM(6)=$$UUBEGFN^LRSRVR2A("CCR.xml")
-"RTN","C0CMIME",221,0)
+"RTN","C0CMIME",219,0)
S GM(9)=""
-"RTN","C0CMIME",222,0)
+"RTN","C0CMIME",220,0)
S GM(10)="" ; FOR THE END
-"RTN","C0CMIME",223,0)
+"RTN","C0CMIME",221,0)
S GM(11)="--frontier--"
-"RTN","C0CMIME",224,0)
+"RTN","C0CMIME",222,0)
S GM(12)="."
-"RTN","C0CMIME",225,0)
+"RTN","C0CMIME",223,0)
S GM(13)=""
-"RTN","C0CMIME",226,0)
+"RTN","C0CMIME",224,0)
K GBLD
-"RTN","C0CMIME",227,0)
+"RTN","C0CMIME",225,0)
;D QUEUE^C0CXPATH("GBLD","GM",1,9)
-"RTN","C0CMIME",228,0)
+"RTN","C0CMIME",226,0)
;D QUEUE^C0CXPATH("GBLD","G2",1,$O(G2(""),-1))
-"RTN","C0CMIME",229,0)
+"RTN","C0CMIME",227,0)
;D QUEUE^C0CXPATH("GBLD","GM",10,13)
-"RTN","C0CMIME",230,0)
+"RTN","C0CMIME",228,0)
;D BUILD^C0CXPATH("GBLD",GN)
-"RTN","C0CMIME",231,0)
+"RTN","C0CMIME",229,0)
S GGG=$NA(^GPL("MIME2"))
-"RTN","C0CMIME",232,0)
+"RTN","C0CMIME",230,0)
;D QUEUE^C0CXPATH("GBLD","GM",1,1)
-"RTN","C0CMIME",233,0)
+"RTN","C0CMIME",231,0)
D QUEUE^C0CXPATH("GBLD",GGG,21,159)
-"RTN","C0CMIME",234,0)
+"RTN","C0CMIME",232,0)
D BUILD^C0CXPATH("GBLD",GN)
-"RTN","C0CMIME",235,0)
+"RTN","C0CMIME",233,0)
K @GN@(0) ; KILL THE LINE COUNT
-"RTN","C0CMIME",236,0)
+"RTN","C0CMIME",234,0)
K LRINSTR,LRTASK,LRTO,XMERR,XMZ
-"RTN","C0CMIME",237,0)
+"RTN","C0CMIME",235,0)
S XQSND="glilly@glilly.net"
-"RTN","C0CMIME",238,0)
+"RTN","C0CMIME",236,0)
;S XQSND="nanthracite@earthlink.net"
-"RTN","C0CMIME",239,0)
+"RTN","C0CMIME",237,0)
;S XQSND="dlefevre@orohosp.com"
-"RTN","C0CMIME",240,0)
+"RTN","C0CMIME",238,0)
;S XQSND="gregwoodhouse@me.com"
-"RTN","C0CMIME",241,0)
+"RTN","C0CMIME",239,0)
;S XQSND="rick.marshall@vistaexpertise.net"
-"RTN","C0CMIME",242,0)
+"RTN","C0CMIME",240,0)
S LRTO(XQSND)=""
-"RTN","C0CMIME",243,0)
+"RTN","C0CMIME",241,0)
S LRINSTR("ADDR FLAGS")="R"
-"RTN","C0CMIME",244,0)
+"RTN","C0CMIME",242,0)
S LRINSTR("FROM")="CCR_PACKAGE"
-"RTN","C0CMIME",245,0)
+"RTN","C0CMIME",243,0)
S LRMSUBJ="A SAMPLE CCR"
-"RTN","C0CMIME",246,0)
+"RTN","C0CMIME",244,0)
S LRMSUBJ=$E(LRMSUBJ,1,65)
-"RTN","C0CMIME",247,0)
+"RTN","C0CMIME",245,0)
D SENDMSG^XMXAPI(9,LRMSUBJ,GN,.LRTO,.LRINSTR,.LRTASK)
-"RTN","C0CMIME",248,0)
+"RTN","C0CMIME",246,0)
I $G(XMERR)=1 W !,"ERROR SENDING MESSAGE" Q ;
-"RTN","C0CMIME",249,0)
+"RTN","C0CMIME",247,0)
;S ^XMB(3.9,LRTASK,1,.1130590,0)="MIME-Version: 1.0"
-"RTN","C0CMIME",250,0)
+"RTN","C0CMIME",248,0)
;S ^XMB(3.9,LRTASK,1,.1130591,0)="Content-type: multipart/mixed; boundary=000e0cd6ae026c3d4b049e7befe9"
-"RTN","C0CMIME",251,0)
+"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)
-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)
+"RTN","C0CMIME",254,0)
D TEST(UDFN)
-"RTN","C0CMIME",257,0)
+"RTN","C0CMIME",255,0)
S GN=$NA(^TMP($J,"C0CMIME"))
-"RTN","C0CMIME",258,0)
+"RTN","C0CMIME",256,0)
K @GN
-"RTN","C0CMIME",259,0)
+"RTN","C0CMIME",257,0)
;M @GN=G2
-"RTN","C0CMIME",260,0)
+"RTN","C0CMIME",258,0)
S GM(1)="MIME-Version: 1.0"
-"RTN","C0CMIME",261,0)
+"RTN","C0CMIME",259,0)
S GM(2)="Content-Type: multipart/mixed; boudary=""1234567"""
-"RTN","C0CMIME",262,0)
+"RTN","C0CMIME",260,0)
S GM(3)=""
-"RTN","C0CMIME",263,0)
+"RTN","C0CMIME",261,0)
S GM(4)=""
-"RTN","C0CMIME",264,0)
+"RTN","C0CMIME",262,0)
S GM(5)="--1234567"
-"RTN","C0CMIME",265,0)
+"RTN","C0CMIME",263,0)
;S GM(5)=$$REPEAT^XLFSTR("-",$L(X))
-"RTN","C0CMIME",266,0)
+"RTN","C0CMIME",264,0)
S GM(6)="Content-Type: text/xml; name=""ccr.xml"""
-"RTN","C0CMIME",267,0)
+"RTN","C0CMIME",265,0)
S GM(7)="Content-Transfer-Encoding: base64"
-"RTN","C0CMIME",268,0)
+"RTN","C0CMIME",266,0)
S GM(8)="Content-Disposition: attachment; filename=""ccr.xml"""
-"RTN","C0CMIME",269,0)
+"RTN","C0CMIME",267,0)
;S GM(6)=$$UUBEGFN^LRSRVR2A("CCR.xml")
-"RTN","C0CMIME",270,0)
+"RTN","C0CMIME",268,0)
S GM(9)=""
-"RTN","C0CMIME",271,0)
+"RTN","C0CMIME",269,0)
S GM(10)="" ; FOR THE END
-"RTN","C0CMIME",272,0)
+"RTN","C0CMIME",270,0)
S GM(11)="--1234567--"
-"RTN","C0CMIME",273,0)
+"RTN","C0CMIME",271,0)
S GM(12)=""
-"RTN","C0CMIME",274,0)
+"RTN","C0CMIME",272,0)
S GM(13)=""
-"RTN","C0CMIME",275,0)
+"RTN","C0CMIME",273,0)
K GBLD
-"RTN","C0CMIME",276,0)
+"RTN","C0CMIME",274,0)
D QUEUE^C0CXPATH("GBLD","GM",5,9)
-"RTN","C0CMIME",277,0)
+"RTN","C0CMIME",275,0)
D QUEUE^C0CXPATH("GBLD","G2",1,$O(G2(""),-1))
-"RTN","C0CMIME",278,0)
+"RTN","C0CMIME",276,0)
D QUEUE^C0CXPATH("GBLD","GM",10,12)
-"RTN","C0CMIME",279,0)
+"RTN","C0CMIME",277,0)
D BUILD^C0CXPATH("GBLD",GN)
-"RTN","C0CMIME",280,0)
+"RTN","C0CMIME",278,0)
S GGG=$NA(^GPL("MIME2"))
-"RTN","C0CMIME",281,0)
+"RTN","C0CMIME",279,0)
;D QUEUE^C0CXPATH("GBLD","GM",1,1)
-"RTN","C0CMIME",282,0)
+"RTN","C0CMIME",280,0)
;D QUEUE^C0CXPATH("GBLD",GGG,21,159)
-"RTN","C0CMIME",283,0)
+"RTN","C0CMIME",281,0)
;D BUILD^C0CXPATH("GBLD",GN)
-"RTN","C0CMIME",284,0)
+"RTN","C0CMIME",282,0)
K @GN@(0) ; KILL THE LINE COUNT
-"RTN","C0CMIME",285,0)
+"RTN","C0CMIME",283,0)
K LRINSTR,LRTASK,LRTO,XMERR,XMZ
-"RTN","C0CMIME",286,0)
+"RTN","C0CMIME",284,0)
I $G(ADDR)'="" S XQSND=ADDR
-"RTN","C0CMIME",287,0)
+"RTN","C0CMIME",285,0)
E S XQSND="glilly@glilly.net"
-"RTN","C0CMIME",288,0)
+"RTN","C0CMIME",286,0)
;S XQSND="nanthracite@earthlink.net"
-"RTN","C0CMIME",289,0)
+"RTN","C0CMIME",287,0)
;S XQSND="dlefevre@orohosp.com"
-"RTN","C0CMIME",290,0)
+"RTN","C0CMIME",288,0)
;S XQSND="gregwoodhouse@me.com"
-"RTN","C0CMIME",291,0)
+"RTN","C0CMIME",289,0)
;S XQSND="rick.marshall@vistaexpertise.net"
-"RTN","C0CMIME",292,0)
+"RTN","C0CMIME",290,0)
S LRTO(XQSND)=""
-"RTN","C0CMIME",293,0)
+"RTN","C0CMIME",291,0)
;S LRTO("glilly@glilly.net")=""
-"RTN","C0CMIME",294,0)
+"RTN","C0CMIME",292,0)
S LRINSTR("ADDR FLAGS")="R"
-"RTN","C0CMIME",295,0)
+"RTN","C0CMIME",293,0)
S LRINSTR("FROM")="ANTHRACITE.NANCY"
-"RTN","C0CMIME",296,0)
+"RTN","C0CMIME",294,0)
S LRMSUBJ="Sending a CCR with Mailman"
-"RTN","C0CMIME",297,0)
+"RTN","C0CMIME",295,0)
S LRMSUBJ=$E(LRMSUBJ,1,65)
-"RTN","C0CMIME",298,0)
+"RTN","C0CMIME",296,0)
D SENDMSG^XMXAPI(9,LRMSUBJ,GN,.LRTO,.LRINSTR,.LRTASK)
-"RTN","C0CMIME",299,0)
+"RTN","C0CMIME",297,0)
I $G(XMERR)=1 W !,"ERROR SENDING MESSAGE" Q ;
-"RTN","C0CMIME",300,0)
+"RTN","C0CMIME",298,0)
;S ^XMB(3.9,LRTASK,1,.1130590,0)="MIME-Version: 1.0"
-"RTN","C0CMIME",301,0)
+"RTN","C0CMIME",299,0)
;S ^XMB(3.9,LRTASK,1,.1130591,0)="Content-type: multipart/mixed; boundary=000e0cd6ae026c3d4b049e7befe9"
-"RTN","C0CMIME",302,0)
+"RTN","C0CMIME",300,0)
Q
-"RTN","C0CMIME",303,0)
+"RTN","C0CMIME",301,0)
;
-"RTN","C0CMIME",304,0)
+"RTN","C0CMIME",302,0)
SIMPLE ;
-"RTN","C0CMIME",305,0)
+"RTN","C0CMIME",303,0)
S GN(1)="SIMPLE TEST MESSAGE"
-"RTN","C0CMIME",306,0)
+"RTN","C0CMIME",304,0)
K LRINSTR,LRTASK,LRTO,XMERR,XMZ
-"RTN","C0CMIME",307,0)
+"RTN","C0CMIME",305,0)
S XQSND="glilly@glilly.net"
-"RTN","C0CMIME",308,0)
+"RTN","C0CMIME",306,0)
S LRTO(XQSND)=""
-"RTN","C0CMIME",309,0)
+"RTN","C0CMIME",307,0)
S LRINSTR("ADDR FLAGS")="R"
-"RTN","C0CMIME",310,0)
+"RTN","C0CMIME",308,0)
S LRINSTR("FROM")="CCR_PACKAGE"
-"RTN","C0CMIME",311,0)
+"RTN","C0CMIME",309,0)
S LRMSUBJ="A SAMPLE CCR"
-"RTN","C0CMIME",312,0)
+"RTN","C0CMIME",310,0)
S LRMSUBJ=$E(LRMSUBJ,1,65)
-"RTN","C0CMIME",313,0)
+"RTN","C0CMIME",311,0)
D SENDMSG^XMXAPI(9,LRMSUBJ,"GN",.LRTO,.LRINSTR,.LRTASK)
-"RTN","C0CMIME",314,0)
+"RTN","C0CMIME",312,0)
Q
-"RTN","C0CMIME",315,0)
+"RTN","C0CMIME",313,0)
CHUNK(OUTXML,INXML,ZSIZE) ; BREAKS INXML INTO ZSIZE BLOCKS
-"RTN","C0CMIME",316,0)
+"RTN","C0CMIME",314,0)
; INXML IS AN ARRAY PASSED BY NAME OF STRINGS
-"RTN","C0CMIME",317,0)
+"RTN","C0CMIME",315,0)
; OUTXML IS ALSO PASSED BY NAME
-"RTN","C0CMIME",318,0)
+"RTN","C0CMIME",316,0)
; IF ZSIZE IS NOT PASSED, 1000 IS USED
-"RTN","C0CMIME",319,0)
+"RTN","C0CMIME",317,0)
I '$D(ZSIZE) S ZSIZE=1000 ; DEFAULT BLOCK SIZE
-"RTN","C0CMIME",320,0)
+"RTN","C0CMIME",318,0)
N ZB,ZI,ZJ,ZK,ZL,ZN
-"RTN","C0CMIME",321,0)
+"RTN","C0CMIME",319,0)
S ZB=ZSIZE-1
-"RTN","C0CMIME",322,0)
+"RTN","C0CMIME",320,0)
S ZN=1
-"RTN","C0CMIME",323,0)
+"RTN","C0CMIME",321,0)
S ZI=0 ; BEGINNING OF INDEX TO INXML
-"RTN","C0CMIME",324,0)
+"RTN","C0CMIME",322,0)
F S ZI=$O(@INXML@(ZI)) Q:+ZI=0 D ; FOR EACH STRING IN INXML
-"RTN","C0CMIME",325,0)
+"RTN","C0CMIME",323,0)
. S ZL=$L(@INXML@(ZI)) ; LENGTH OF THE STRING
-"RTN","C0CMIME",326,0)
+"RTN","C0CMIME",324,0)
. F ZJ=1:ZSIZE:ZL D ;
-"RTN","C0CMIME",327,0)
+"RTN","C0CMIME",325,0)
. . S ZK=$S(ZJ+ZB.
"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)
- ;
-"RTN","C0CMXML",20,0)
- Q
-"RTN","C0CMXML",21,0)
; THIS FILE CONTAINS THE XPATH CREATOR, THE PARSE CALL TO THE MXML PARSER
-"RTN","C0CMXML",22,0)
+"RTN","C0CMXML",20,0)
; AND THE OUTXML XML GENERATOR THAT OUTPUTS XML FROM AN MXML DOM
-"RTN","C0CMXML",23,0)
+"RTN","C0CMXML",21,0)
; FOR CCD SPECIFIC ROUTINES, SEE C0CMCCD
-"RTN","C0CMXML",24,0)
+"RTN","C0CMXML",22,0)
; FOR TEMPLATE FILE RELATED ROUTINES, SEE C0CMXP
-"RTN","C0CMXML",25,0)
+"RTN","C0CMXML",23,0)
;
-"RTN","C0CMXML",26,0)
+"RTN","C0CMXML",24,0)
TEST ;
-"RTN","C0CMXML",27,0)
+"RTN","C0CMXML",25,0)
S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
-"RTN","C0CMXML",28,0)
+"RTN","C0CMXML",26,0)
K GARY
-"RTN","C0CMXML",29,0)
+"RTN","C0CMXML",27,0)
W $$FTG^%ZISH("/home/vademo2/EHR/p/","mxml-test.xml",$NA(@C0CXMLIN@(1)),3)
-"RTN","C0CMXML",30,0)
+"RTN","C0CMXML",28,0)
S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DocID: ",C0CDOCID
-"RTN","C0CMXML",31,0)
+"RTN","C0CMXML",29,0)
S REDUX="//ContinuityOfCareRecord/Body"
-"RTN","C0CMXML",32,0)
+"RTN","C0CMXML",30,0)
D XPATH(1,"/","GIDX","GARY",,REDUX)
-"RTN","C0CMXML",33,0)
+"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)
- S ZI=""
+ . N GTMP,G2
"RTN","C0CMXML",35,0)
- F S ZI=$O(GARY2(ZI)) Q:ZI="" D ;
+ . M G2=GARY2(ZI)
"RTN","C0CMXML",36,0)
- . N GTMP,G2
+ . D DEMUX2^C0CMXP("GTMP","G2",2)
"RTN","C0CMXML",37,0)
- . M G2=GARY2(ZI)
-"RTN","C0CMXML",38,0)
- . D DEMUX2^C0CMXP("GTMP","G2",2)
-"RTN","C0CMXML",39,0)
. M GARY3(ZI)=GTMP
+"RTN","C0CMXML",38,0)
+ Q
+"RTN","C0CMXML",39,0)
+ ;
"RTN","C0CMXML",40,0)
- Q
-"RTN","C0CMXML",41,0)
- ;
-"RTN","C0CMXML",42,0)
TEST2 ;
-"RTN","C0CMXML",43,0)
+"RTN","C0CMXML",41,0)
S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail"
-"RTN","C0CMXML",44,0)
+"RTN","C0CMXML",42,0)
D XPATH(1,"/","GIDX","GARY","",REDUX)
+"RTN","C0CMXML",43,0)
+ Q
+"RTN","C0CMXML",44,0)
+ ;
"RTN","C0CMXML",45,0)
- Q
+TEST3 ;
"RTN","C0CMXML",46,0)
- ;
+ S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
"RTN","C0CMXML",47,0)
-TEST3
+ K GARY,GTMP,GIDX
"RTN","C0CMXML",48,0)
- S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
+ K @C0CXMLIN
"RTN","C0CMXML",49,0)
- K GARY,GTMP,GIDX
-"RTN","C0CMXML",50,0)
- K @C0CXMLIN
-"RTN","C0CMXML",51,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)
- D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
+ M @C0CXMLIN=GTMP
"RTN","C0CMXML",53,0)
- K @C0CXMLIN
+ K GTMP
"RTN","C0CMXML",54,0)
- M @C0CXMLIN=GTMP
+ D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN)
"RTN","C0CMXML",55,0)
- K GTMP
+ K @C0CXMLIN
"RTN","C0CMXML",56,0)
- D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN)
+ M @C0CXMLIN=GTMP
"RTN","C0CMXML",57,0)
- K @C0CXMLIN
+ K GTMP
"RTN","C0CMXML",58,0)
- M @C0CXMLIN=GTMP
+ S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID
"RTN","C0CMXML",59,0)
- K GTMP
+ S REDUX="//ClinicalDocument/component/structuredBody"
"RTN","C0CMXML",60,0)
- S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID
+ D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS
"RTN","C0CMXML",61,0)
- S REDUX="//ClinicalDocument/component/structuredBody"
+ D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS
"RTN","C0CMXML",62,0)
- D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS
+ D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS
"RTN","C0CMXML",63,0)
- D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS
+ D XPATH(1,"/","GIDX","GARY",,REDUX)
"RTN","C0CMXML",64,0)
- D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS
+ K C0CCBK("TAG")
"RTN","C0CMXML",65,0)
- D XPATH(1,"/","GIDX","GARY",,REDUX)
+ D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING
"RTN","C0CMXML",66,0)
- K C0CCBK("TAG")
+ D TEST3A
"RTN","C0CMXML",67,0)
- D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING
+ Q
"RTN","C0CMXML",68,0)
- D TEST3A
+ ;
"RTN","C0CMXML",69,0)
- Q
-"RTN","C0CMXML",70,0)
- ;
-"RTN","C0CMXML",71,0)
TEST3A ; INTERNAL ROUTINE
-"RTN","C0CMXML",72,0)
+"RTN","C0CMXML",70,0)
S ZI=""
-"RTN","C0CMXML",73,0)
+"RTN","C0CMXML",71,0)
F S ZI=$O(GARY2(ZI)) Q:ZI="" D ;
-"RTN","C0CMXML",74,0)
+"RTN","C0CMXML",72,0)
. N GTMP,G2
-"RTN","C0CMXML",75,0)
+"RTN","C0CMXML",73,0)
. M G2=GARY2(ZI)
-"RTN","C0CMXML",76,0)
+"RTN","C0CMXML",74,0)
. D DEMUX2^C0CMXP("GTMP","G2",2)
-"RTN","C0CMXML",77,0)
+"RTN","C0CMXML",75,0)
. M GARY4(ZI)=GTMP
+"RTN","C0CMXML",76,0)
+ Q
+"RTN","C0CMXML",77,0)
+ ;
"RTN","C0CMXML",78,0)
- Q
-"RTN","C0CMXML",79,0)
- ;
-"RTN","C0CMXML",80,0)
TESTQ ; TEST OF THE QRDA TEMPLATE GPL 7/8/2010
-"RTN","C0CMXML",81,0)
+"RTN","C0CMXML",79,0)
S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
-"RTN","C0CMXML",82,0)
+"RTN","C0CMXML",80,0)
K GARY,GTMP,GIDX
-"RTN","C0CMXML",83,0)
+"RTN","C0CMXML",81,0)
K @C0CXMLIN
-"RTN","C0CMXML",84,0)
+"RTN","C0CMXML",82,0)
W $$FTG^%ZISH("/home/vademo2/","QRDA_CategoryI_WorldVistA1.xml",$NA(@C0CXMLIN@(1)),3)
-"RTN","C0CMXML",85,0)
+"RTN","C0CMXML",83,0)
D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
-"RTN","C0CMXML",86,0)
+"RTN","C0CMXML",84,0)
K @C0CXMLIN
-"RTN","C0CMXML",87,0)
+"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)
- M @C0CXMLIN=GTMP
-"RTN","C0CMXML",89,0)
- K GTMP
-"RTN","C0CMXML",90,0)
D TESTQ2
-"RTN","C0CMXML",91,0)
+"RTN","C0CMXML",89,0)
Q
-"RTN","C0CMXML",92,0)
+"RTN","C0CMXML",90,0)
;
-"RTN","C0CMXML",93,0)
+"RTN","C0CMXML",91,0)
TESTQ2 ; SECOND PART OF TESTQ
-"RTN","C0CMXML",94,0)
+"RTN","C0CMXML",92,0)
D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN)
-"RTN","C0CMXML",95,0)
+"RTN","C0CMXML",93,0)
K @C0CXMLIN
-"RTN","C0CMXML",96,0)
+"RTN","C0CMXML",94,0)
M @C0CXMLIN=GTMP
-"RTN","C0CMXML",97,0)
+"RTN","C0CMXML",95,0)
K GTMP
-"RTN","C0CMXML",98,0)
+"RTN","C0CMXML",96,0)
S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID
-"RTN","C0CMXML",99,0)
+"RTN","C0CMXML",97,0)
S REDUX="//ClinicalDocument/component/structuredBody"
-"RTN","C0CMXML",100,0)
+"RTN","C0CMXML",98,0)
D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS
-"RTN","C0CMXML",101,0)
+"RTN","C0CMXML",99,0)
D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS
-"RTN","C0CMXML",102,0)
+"RTN","C0CMXML",100,0)
D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS
-"RTN","C0CMXML",103,0)
+"RTN","C0CMXML",101,0)
D XPATH(1,"/","GIDX","GARY",,REDUX)
-"RTN","C0CMXML",104,0)
+"RTN","C0CMXML",102,0)
K C0CCBK("TAG")
-"RTN","C0CMXML",105,0)
+"RTN","C0CMXML",103,0)
D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING
-"RTN","C0CMXML",106,0)
+"RTN","C0CMXML",104,0)
D TEST3A
-"RTN","C0CMXML",107,0)
+"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)
-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",110,0)
D START^C0CMXMLB($$TAG(1),,"G")
-"RTN","C0CMXML",113,0)
+"RTN","C0CMXML",111,0)
D NDOUT($$FIRST(1))
-"RTN","C0CMXML",114,0)
+"RTN","C0CMXML",112,0)
D END^C0CMXMLB ;END THE DOCUMENT
-"RTN","C0CMXML",115,0)
+"RTN","C0CMXML",113,0)
M ZCCR=^TMP("MXMLBLD",$J)
+"RTN","C0CMXML",114,0)
+ ; ZWR ZCCR
+"RTN","C0CMXML",115,0)
+ Q
"RTN","C0CMXML",116,0)
- ZWR ZCCR
+ ;
"RTN","C0CMXML",117,0)
- Q
-"RTN","C0CMXML",118,0)
- ;
-"RTN","C0CMXML",119,0)
TEST5 ; SAME AS TEST4, BUT THIS TIME THE CCD
-"RTN","C0CMXML",120,0)
+"RTN","C0CMXML",118,0)
S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
-"RTN","C0CMXML",121,0)
+"RTN","C0CMXML",119,0)
K GARY,GTMP,GIDX
-"RTN","C0CMXML",122,0)
+"RTN","C0CMXML",120,0)
K @C0CXMLIN
-"RTN","C0CMXML",123,0)
+"RTN","C0CMXML",121,0)
W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3)
-"RTN","C0CMXML",124,0)
+"RTN","C0CMXML",122,0)
D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
+"RTN","C0CMXML",123,0)
+ K @C0CXMLIN
+"RTN","C0CMXML",124,0)
+ M @C0CXMLIN=GTMP
"RTN","C0CMXML",125,0)
- K @C0CXMLIN
+ K GTMP
"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)
+"RTN","C0CMXML",127,0)
K @C0CXMLIN
-"RTN","C0CMXML",130,0)
+"RTN","C0CMXML",128,0)
M @C0CXMLIN=GTMP
-"RTN","C0CMXML",131,0)
+"RTN","C0CMXML",129,0)
K GTMP
-"RTN","C0CMXML",132,0)
+"RTN","C0CMXML",130,0)
S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DOCID: ",C0CDOCID ;CALL REGULAR PARSER
-"RTN","C0CMXML",133,0)
+"RTN","C0CMXML",131,0)
;D XPATH(1,"/","GIDX2","GARY2",,REDUX)
-"RTN","C0CMXML",134,0)
+"RTN","C0CMXML",132,0)
D OUTXML("ZCCD",C0CDOCID)
-"RTN","C0CMXML",135,0)
+"RTN","C0CMXML",133,0)
;D START^C0CMXMLB($$TAG(1),,"G")
-"RTN","C0CMXML",136,0)
+"RTN","C0CMXML",134,0)
;D NDOUT($$FIRST(1))
-"RTN","C0CMXML",137,0)
+"RTN","C0CMXML",135,0)
;D END^C0CMXMLB ;EOND THE DOCUMENT
-"RTN","C0CMXML",138,0)
+"RTN","C0CMXML",136,0)
;M ZCCD=^TMP("MXMLBLD",$J)
+"RTN","C0CMXML",137,0)
+ ; ZWR ZCCD(1:30)
+"RTN","C0CMXML",138,0)
+ Q
"RTN","C0CMXML",139,0)
- ZWR ZCCD(1:30)
-"RTN","C0CMXML",140,0)
- Q
-"RTN","C0CMXML",141,0)
;
-"RTN","C0CMXML",142,0)
+"RTN","C0CMXML",140,0)
XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
-"RTN","C0CMXML",143,0)
+"RTN","C0CMXML",141,0)
; THE XPATH INDEX ZXIDX, PASSED BY NAME
-"RTN","C0CMXML",144,0)
+"RTN","C0CMXML",142,0)
; THE XPATH ARRAY XPARY, PASSED BY NAME
-"RTN","C0CMXML",145,0)
+"RTN","C0CMXML",143,0)
; ZOID IS THE STARTING OID
-"RTN","C0CMXML",146,0)
+"RTN","C0CMXML",144,0)
; ZPATH IS THE STARTING XPATH, USUALLY "/"
-"RTN","C0CMXML",147,0)
+"RTN","C0CMXML",145,0)
; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
-"RTN","C0CMXML",148,0)
+"RTN","C0CMXML",146,0)
; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
-"RTN","C0CMXML",149,0)
+"RTN","C0CMXML",147,0)
I $G(ZREDUX)="" S ZREDUX=""
-"RTN","C0CMXML",150,0)
+"RTN","C0CMXML",148,0)
N NEWPATH
-"RTN","C0CMXML",151,0)
+"RTN","C0CMXML",149,0)
N NEWNUM S NEWNUM=""
-"RTN","C0CMXML",152,0)
+"RTN","C0CMXML",150,0)
I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
-"RTN","C0CMXML",153,0)
+"RTN","C0CMXML",151,0)
S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
-"RTN","C0CMXML",154,0)
+"RTN","C0CMXML",152,0)
I $G(ZREDUX)'="" D ; REDUX PROVIDED?
-"RTN","C0CMXML",155,0)
+"RTN","C0CMXML",153,0)
. N GT S GT=$P(NEWPATH,ZREDUX,2)
-"RTN","C0CMXML",156,0)
+"RTN","C0CMXML",154,0)
. I GT'="" S NEWPATH=GT
-"RTN","C0CMXML",157,0)
+"RTN","C0CMXML",155,0)
S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
-"RTN","C0CMXML",158,0)
+"RTN","C0CMXML",156,0)
N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
-"RTN","C0CMXML",159,0)
+"RTN","C0CMXML",157,0)
I $D(GD(2)) M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
-"RTN","C0CMXML",160,0)
+"RTN","C0CMXML",158,0)
E I $D(GD(1)) S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
-"RTN","C0CMXML",161,0)
+"RTN","C0CMXML",159,0)
N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
-"RTN","C0CMXML",162,0)
+"RTN","C0CMXML",160,0)
I ZFRST'=0 D ; THERE IS A CHILD
-"RTN","C0CMXML",163,0)
+"RTN","C0CMXML",161,0)
. N ZNUM
-"RTN","C0CMXML",164,0)
+"RTN","C0CMXML",162,0)
. N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
-"RTN","C0CMXML",165,0)
+"RTN","C0CMXML",163,0)
. D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD
-"RTN","C0CMXML",166,0)
+"RTN","C0CMXML",164,0)
N GNXT S GNXT=$$NXTSIB(ZOID)
-"RTN","C0CMXML",167,0)
+"RTN","C0CMXML",165,0)
I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
-"RTN","C0CMXML",168,0)
+"RTN","C0CMXML",166,0)
I GNXT'=0 D ;
-"RTN","C0CMXML",169,0)
+"RTN","C0CMXML",167,0)
. N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
-"RTN","C0CMXML",170,0)
+"RTN","C0CMXML",168,0)
. I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES
-"RTN","C0CMXML",171,0)
+"RTN","C0CMXML",169,0)
. . N ZNUM S ZNUM=1 ;
-"RTN","C0CMXML",172,0)
+"RTN","C0CMXML",170,0)
. . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
-"RTN","C0CMXML",173,0)
+"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",173,0)
+ ;
"RTN","C0CMXML",174,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)
+"RTN","C0CMXML",175,0)
; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
-"RTN","C0CMXML",178,0)
+"RTN","C0CMXML",176,0)
; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
-"RTN","C0CMXML",179,0)
+"RTN","C0CMXML",177,0)
;Q $$EN^MXMLDOM(INXML)
-"RTN","C0CMXML",180,0)
+"RTN","C0CMXML",178,0)
Q $$EN^MXMLDOM(INXML,"W")
-"RTN","C0CMXML",181,0)
+"RTN","C0CMXML",179,0)
;
-"RTN","C0CMXML",182,0)
+"RTN","C0CMXML",180,0)
ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
-"RTN","C0CMXML",183,0)
+"RTN","C0CMXML",181,0)
N ZN
-"RTN","C0CMXML",184,0)
+"RTN","C0CMXML",182,0)
;I $$TAG(ZOID)["entry" B
-"RTN","C0CMXML",185,0)
+"RTN","C0CMXML",183,0)
S ZN=$$NXTSIB(ZOID)
-"RTN","C0CMXML",186,0)
+"RTN","C0CMXML",184,0)
I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
-"RTN","C0CMXML",187,0)
+"RTN","C0CMXML",185,0)
Q 0
-"RTN","C0CMXML",188,0)
+"RTN","C0CMXML",186,0)
;
-"RTN","C0CMXML",189,0)
+"RTN","C0CMXML",187,0)
FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
-"RTN","C0CMXML",190,0)
+"RTN","C0CMXML",188,0)
Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CMXML",191,0)
+"RTN","C0CMXML",189,0)
;
-"RTN","C0CMXML",192,0)
+"RTN","C0CMXML",190,0)
PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
-"RTN","C0CMXML",193,0)
+"RTN","C0CMXML",191,0)
Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CMXML",194,0)
+"RTN","C0CMXML",192,0)
;
-"RTN","C0CMXML",195,0)
+"RTN","C0CMXML",193,0)
ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
-"RTN","C0CMXML",196,0)
+"RTN","C0CMXML",194,0)
S HANDLE=C0CDOCID
-"RTN","C0CMXML",197,0)
+"RTN","C0CMXML",195,0)
K @RTN
-"RTN","C0CMXML",198,0)
+"RTN","C0CMXML",196,0)
D GETTXT^MXMLDOM("A")
+"RTN","C0CMXML",197,0)
+ Q
+"RTN","C0CMXML",198,0)
+ ;
"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)
+"RTN","C0CMXML",200,0)
;I ZOID=149 B ;GPLTEST
-"RTN","C0CMXML",203,0)
+"RTN","C0CMXML",201,0)
N X,Y
-"RTN","C0CMXML",204,0)
+"RTN","C0CMXML",202,0)
S Y=""
-"RTN","C0CMXML",205,0)
+"RTN","C0CMXML",203,0)
S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
-"RTN","C0CMXML",206,0)
+"RTN","C0CMXML",204,0)
I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
-"RTN","C0CMXML",207,0)
+"RTN","C0CMXML",205,0)
I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CMXML",208,0)
+"RTN","C0CMXML",206,0)
Q Y
-"RTN","C0CMXML",209,0)
+"RTN","C0CMXML",207,0)
;
-"RTN","C0CMXML",210,0)
+"RTN","C0CMXML",208,0)
NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
-"RTN","C0CMXML",211,0)
+"RTN","C0CMXML",209,0)
Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CMXML",212,0)
+"RTN","C0CMXML",210,0)
;
-"RTN","C0CMXML",213,0)
+"RTN","C0CMXML",211,0)
DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
-"RTN","C0CMXML",214,0)
+"RTN","C0CMXML",212,0)
;N ZT,ZN S ZT=""
-"RTN","C0CMXML",215,0)
+"RTN","C0CMXML",213,0)
;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
-"RTN","C0CMXML",216,0)
+"RTN","C0CMXML",214,0)
;Q $G(@C0CDOM@(ZOID,"T",1))
-"RTN","C0CMXML",217,0)
+"RTN","C0CMXML",215,0)
S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
-"RTN","C0CMXML",218,0)
+"RTN","C0CMXML",216,0)
Q
+"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)
-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)
+"RTN","C0CMXML",221,0)
D START^C0CMXMLB($$TAG(1),,"G")
-"RTN","C0CMXML",224,0)
+"RTN","C0CMXML",222,0)
D NDOUT($$FIRST(1))
-"RTN","C0CMXML",225,0)
+"RTN","C0CMXML",223,0)
D END^C0CMXMLB ;END THE DOCUMENT
-"RTN","C0CMXML",226,0)
+"RTN","C0CMXML",224,0)
M @ZRTN=^TMP("MXMLBLD",$J)
-"RTN","C0CMXML",227,0)
+"RTN","C0CMXML",225,0)
K ^TMP("MXMLBLD",$J)
+"RTN","C0CMXML",226,0)
+ Q
+"RTN","C0CMXML",227,0)
+ ;
"RTN","C0CMXML",228,0)
- Q
-"RTN","C0CMXML",229,0)
- ;
-"RTN","C0CMXML",230,0)
NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
-"RTN","C0CMXML",231,0)
+"RTN","C0CMXML",229,0)
N ZI S ZI=$$FIRST(ZOID)
-"RTN","C0CMXML",232,0)
+"RTN","C0CMXML",230,0)
I ZI'=0 D ; THERE IS A CHILD
-"RTN","C0CMXML",233,0)
+"RTN","C0CMXML",231,0)
. N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
-"RTN","C0CMXML",234,0)
+"RTN","C0CMXML",232,0)
. D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN
-"RTN","C0CMXML",235,0)
+"RTN","C0CMXML",233,0)
E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
-"RTN","C0CMXML",236,0)
+"RTN","C0CMXML",234,0)
. ;W "DOING",ZOID,!
-"RTN","C0CMXML",237,0)
+"RTN","C0CMXML",235,0)
. N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
-"RTN","C0CMXML",238,0)
+"RTN","C0CMXML",236,0)
. N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
-"RTN","C0CMXML",239,0)
+"RTN","C0CMXML",237,0)
. D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
-"RTN","C0CMXML",240,0)
+"RTN","C0CMXML",238,0)
I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING
-"RTN","C0CMXML",241,0)
+"RTN","C0CMXML",239,0)
. D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
-"RTN","C0CMXML",242,0)
+"RTN","C0CMXML",240,0)
Q
-"RTN","C0CMXML",243,0)
+"RTN","C0CMXML",241,0)
;
-"RTN","C0CMXML",244,0)
+"RTN","C0CMXML",242,0)
UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
-"RTN","C0CMXML",245,0)
+"RTN","C0CMXML",243,0)
K ZERR
-"RTN","C0CMXML",246,0)
+"RTN","C0CMXML",244,0)
D CLEAN^DILF
-"RTN","C0CMXML",247,0)
+"RTN","C0CMXML",245,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)
+"RTN","C0CMXML",246,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CMXML",247,0)
K C0CFDA
-"RTN","C0CMXML",253,0)
+"RTN","C0CMXML",248,0)
Q
-"RTN","C0CMXML",254,0)
+"RTN","C0CMXML",249,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
"RTN","C0CMXMLB",4,0)
;
"RTN","C0CMXMLB",5,0)
- ;DOC - The top level tag
+ ; FOIA Routine - Public Domain
"RTN","C0CMXMLB",6,0)
- ;DOCTYPE - Want to include a DOCTYPE node
+ ;
"RTN","C0CMXMLB",7,0)
- ;FLAG - Set to 'G' to store the output in the global ^TMP("MXMLBLD",$J,
+ ;DOC - The top level tag
"RTN","C0CMXMLB",8,0)
-START(DOC,DOCTYPE,FLAG,NO1ST) ;Call this once at the begining.
+ ;DOCTYPE - Want to include a DOCTYPE node
"RTN","C0CMXMLB",9,0)
- K ^TMP("MXMLBLD",$J)
+ ;FLAG - Set to 'G' to store the output in the global ^TMP("MXMLBLD",$J,
"RTN","C0CMXMLB",10,0)
- S ^TMP("MXMLBLD",$J,"DOC")=DOC,^TMP("MXMLBLD",$J,"STK")=0
+START(DOC,DOCTYPE,FLAG,NO1ST) ;Call this once at the begining.
"RTN","C0CMXMLB",11,0)
- I $G(FLAG)["G" S ^TMP("MXMLBLD",$J,"CNT")=1
+ K ^TMP("MXMLBLD",$J)
"RTN","C0CMXMLB",12,0)
- I $G(NO1ST)'=1 D OUTPUT($$XMLHDR)
+ S ^TMP("MXMLBLD",$J,"DOC")=DOC,^TMP("MXMLBLD",$J,"STK")=0
"RTN","C0CMXMLB",13,0)
- D:$L($G(DOCTYPE)) OUTPUT("") D OUTPUT("<"_DOC_">")
+ I $G(FLAG)["G" S ^TMP("MXMLBLD",$J,"CNT")=1
"RTN","C0CMXMLB",14,0)
- Q
+ I $G(NO1ST)'=1 D OUTPUT($$XMLHDR)
"RTN","C0CMXMLB",15,0)
- ;
+ D:$L($G(DOCTYPE)) OUTPUT("") D OUTPUT("<"_DOC_">")
"RTN","C0CMXMLB",16,0)
-END ;Call this once to close out the document
+ Q
"RTN","C0CMXMLB",17,0)
- D OUTPUT(""_$G(^TMP("MXMLBLD",$J,"DOC"))_">")
+ ;
"RTN","C0CMXMLB",18,0)
- I '$G(^TMP("MXMLBLD",$J,"CNT")) K ^TMP("MXMLBLD",$J)
+END ;Call this once to close out the document
"RTN","C0CMXMLB",19,0)
- K ^TMP("MXMLBLD",$J,"DOC"),^("CNT"),^("STK")
+ D OUTPUT(""_$G(^TMP("MXMLBLD",$J,"DOC"))_">")
"RTN","C0CMXMLB",20,0)
- Q
+ I '$G(^TMP("MXMLBLD",$J,"CNT")) K ^TMP("MXMLBLD",$J)
"RTN","C0CMXMLB",21,0)
- ;
+ K ^TMP("MXMLBLD",$J,"DOC"),^("CNT"),^("STK")
"RTN","C0CMXMLB",22,0)
-ITEM(INDENT,TAG,ATT,VALUE) ;Output a Item
+ Q
"RTN","C0CMXMLB",23,0)
- N I,X
+ ;
"RTN","C0CMXMLB",24,0)
- S ATT=$G(ATT)
+ITEM(INDENT,TAG,ATT,VALUE) ;Output a Item
"RTN","C0CMXMLB",25,0)
- I '$D(VALUE) D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_" />") Q
+ N I,X
"RTN","C0CMXMLB",26,0)
- D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">"_$$CHARCHK(VALUE)_""_TAG_">")
+ S ATT=$G(ATT)
"RTN","C0CMXMLB",27,0)
- Q
+ I '$D(VALUE) D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_" />") Q
"RTN","C0CMXMLB",28,0)
- ;DOITEM is a callback to output the lower level.
+ D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">"_$$CHARCHK(VALUE)_""_TAG_">")
"RTN","C0CMXMLB",29,0)
-MULTI(INDENT,TAG,ATT,DOITEM) ;Output a Multipule
+ Q
"RTN","C0CMXMLB",30,0)
- N I,X,S
+ ;DOITEM is a callback to output the lower level.
"RTN","C0CMXMLB",31,0)
- S ATT=$G(ATT)
+MULTI(INDENT,TAG,ATT,DOITEM) ;Output a Multipule
"RTN","C0CMXMLB",32,0)
- D PUSH($G(INDENT),TAG,.ATT)
+ N I,X,S
"RTN","C0CMXMLB",33,0)
- D @DOITEM
-"RTN","C0CMXMLB",34,0)
- D POP
-"RTN","C0CMXMLB",35,0)
- Q
-"RTN","C0CMXMLB",36,0)
- ;
-"RTN","C0CMXMLB",37,0)
-ATT(ATT) ;Output a string of attributes
-"RTN","C0CMXMLB",38,0)
- I $D(ATT)<9 Q ""
-"RTN","C0CMXMLB",39,0)
- N I,S,V
-"RTN","C0CMXMLB",40,0)
- S S="",I=""
-"RTN","C0CMXMLB",41,0)
- F S I=$O(ATT(I)) Q:I="" S S=S_" "_I_"="_$$Q(ATT(I))
-"RTN","C0CMXMLB",42,0)
- Q S
-"RTN","C0CMXMLB",43,0)
- ;
-"RTN","C0CMXMLB",44,0)
-Q(X) ;Add Quotes - Changed by gpl to use single instead of double quotes 6/11
-"RTN","C0CMXMLB",45,0)
- ;I X'[$C(34) Q $C(34)_X_$C(34)
-"RTN","C0CMXMLB",46,0)
- I X'[$C(39) Q $C(39)_X_$C(39)
-"RTN","C0CMXMLB",47,0)
- ;N Q,Y,I,Z S Q=$C(34),(Y,Z)=""
-"RTN","C0CMXMLB",48,0)
- N Q,Y,I,Z S Q=$C(39),(Y,Z)=""
-"RTN","C0CMXMLB",49,0)
- F I=1:1:$L(X,Q)-1 S Y=Y_$P(X,Q,I)_Q_Q
-"RTN","C0CMXMLB",50,0)
- S Y=Y_$P(X,Q,$L(X,Q))
-"RTN","C0CMXMLB",51,0)
- ;Q $C(34)_Y_$C(34)
-"RTN","C0CMXMLB",52,0)
- Q $C(39)_Y_$C(39)
-"RTN","C0CMXMLB",53,0)
- ;
-"RTN","C0CMXMLB",54,0)
-XMLHDR() ; -- provides current XML standard header
-"RTN","C0CMXMLB",55,0)
- Q ""
-"RTN","C0CMXMLB",56,0)
- ;
-"RTN","C0CMXMLB",57,0)
-OUTPUT(S) ;Output
-"RTN","C0CMXMLB",58,0)
- N C S C=$G(^TMP("MXMLBLD",$J,"CNT"))
-"RTN","C0CMXMLB",59,0)
- I C S ^TMP("MXMLBLD",$J,C)=S,^TMP("MXMLBLD",$J,"CNT")=C+1 Q
-"RTN","C0CMXMLB",60,0)
- W S,!
-"RTN","C0CMXMLB",61,0)
- Q
-"RTN","C0CMXMLB",62,0)
- ;
-"RTN","C0CMXMLB",63,0)
-CHARCHK(STR) ; -- replace xml character limits with entities
-"RTN","C0CMXMLB",64,0)
- N A,I,X,Y,Z,NEWSTR
-"RTN","C0CMXMLB",65,0)
- S (Y,Z)=""
-"RTN","C0CMXMLB",66,0)
- ;IF STR["&" SET NEWSTR=STR DO SET STR=Y_Z
-"RTN","C0CMXMLB",67,0)
- ;. FOR X=1:1 SET Y=Y_$PIECE(NEWSTR,"&",X)_"&",Z=$PIECE(STR,"&",X+1,999) QUIT:Z'["&"
-"RTN","C0CMXMLB",68,0)
- I STR["&" F I=1:1:$L(STR,"&")-1 S STR=$P(STR,"&",1,I)_"&"_$P(STR,"&",I+1,999)
-"RTN","C0CMXMLB",69,0)
- I STR["<" F S STR=$PIECE(STR,"<",1)_"<"_$PIECE(STR,"<",2,99) Q:STR'["<"
-"RTN","C0CMXMLB",70,0)
- I STR[">" F S STR=$PIECE(STR,">",1)_">"_$PIECE(STR,">",2,99) Q:STR'[">"
-"RTN","C0CMXMLB",71,0)
- I STR["'" F S STR=$PIECE(STR,"'",1)_"'"_$PIECE(STR,"'",2,99) Q:STR'["'"
-"RTN","C0CMXMLB",72,0)
- I STR["""" F S STR=$PIECE(STR,"""",1)_"""_$PIECE(STR,"""",2,99) Q:STR'[""""
-"RTN","C0CMXMLB",73,0)
- ;
-"RTN","C0CMXMLB",74,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)
- QUIT STR
-"RTN","C0CMXMLB",76,0)
- ;
-"RTN","C0CMXMLB",77,0)
-COMMENT(VAL) ;Add Comments
-"RTN","C0CMXMLB",78,0)
- N I,L
-"RTN","C0CMXMLB",79,0)
- ;I $D($G(VAL))=1 D OUTPUT("") Q
-"RTN","C0CMXMLB",80,0)
- I $D(VAL) D OUTPUT("") Q ;CHANGED BY GPL FOR GTM
-"RTN","C0CMXMLB",81,0)
- S I="",L="")
-"RTN","C0CMXMLB",84,0)
- Q
-"RTN","C0CMXMLB",85,0)
- ;
-"RTN","C0CMXMLB",86,0)
-PUSH(INDENT,TAG,ATT) ;Write a TAG and save.
-"RTN","C0CMXMLB",87,0)
- N CNT
-"RTN","C0CMXMLB",88,0)
S ATT=$G(ATT)
-"RTN","C0CMXMLB",89,0)
- D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">")
-"RTN","C0CMXMLB",90,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",34,0)
+ D PUSH($G(INDENT),TAG,.ATT)
+"RTN","C0CMXMLB",35,0)
+ D @DOITEM
+"RTN","C0CMXMLB",36,0)
+ D POP
+"RTN","C0CMXMLB",37,0)
Q
-"RTN","C0CMXMLB",92,0)
+"RTN","C0CMXMLB",38,0)
;
-"RTN","C0CMXMLB",93,0)
-POP ;Write last pushed tag and pop
-"RTN","C0CMXMLB",94,0)
- N CNT,TAG,INDENT,X
-"RTN","C0CMXMLB",95,0)
- S CNT=$G(^TMP("MXMLBLD",$J,"STK")),X=^TMP("MXMLBLD",$J,"STK",CNT),^TMP("MXMLBLD",$J,"STK")=CNT-1
-"RTN","C0CMXMLB",96,0)
- S INDENT=+X,TAG=$P(X,"^",2)
-"RTN","C0CMXMLB",97,0)
- D OUTPUT($$BLS(INDENT)_""_TAG_">")
-"RTN","C0CMXMLB",98,0)
- Q
-"RTN","C0CMXMLB",99,0)
- ;
-"RTN","C0CMXMLB",100,0)
-BLS(I) ;Return INDENT string
-"RTN","C0CMXMLB",101,0)
- N S
-"RTN","C0CMXMLB",102,0)
- S S="",I=$G(I) S:I>0 $P(S," ",I)=" "
-"RTN","C0CMXMLB",103,0)
+"RTN","C0CMXMLB",39,0)
+ATT(ATT) ;Output a string of attributes
+"RTN","C0CMXMLB",40,0)
+ I $D(ATT)<9 Q ""
+"RTN","C0CMXMLB",41,0)
+ N I,S,V
+"RTN","C0CMXMLB",42,0)
+ S S="",I=""
+"RTN","C0CMXMLB",43,0)
+ F S I=$O(ATT(I)) Q:I="" S S=S_" "_I_"="_$$Q(ATT(I))
+"RTN","C0CMXMLB",44,0)
Q S
-"RTN","C0CMXMLB",104,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",47,0)
+ ;I X'[$C(34) Q $C(34)_X_$C(34)
+"RTN","C0CMXMLB",48,0)
+ I X'[$C(39) Q $C(39)_X_$C(39)
+"RTN","C0CMXMLB",49,0)
+ ;N Q,Y,I,Z S Q=$C(34),(Y,Z)=""
+"RTN","C0CMXMLB",50,0)
+ N Q,Y,I,Z S Q=$C(39),(Y,Z)=""
+"RTN","C0CMXMLB",51,0)
+ F I=1:1:$L(X,Q)-1 S Y=Y_$P(X,Q,I)_Q_Q
+"RTN","C0CMXMLB",52,0)
+ S Y=Y_$P(X,Q,$L(X,Q))
+"RTN","C0CMXMLB",53,0)
+ ;Q $C(34)_Y_$C(34)
+"RTN","C0CMXMLB",54,0)
+ Q $C(39)_Y_$C(39)
+"RTN","C0CMXMLB",55,0)
+ ;
+"RTN","C0CMXMLB",56,0)
+XMLHDR() ; -- provides current XML standard header
+"RTN","C0CMXMLB",57,0)
+ Q ""
+"RTN","C0CMXMLB",58,0)
+ ;
+"RTN","C0CMXMLB",59,0)
+OUTPUT(S) ;Output
+"RTN","C0CMXMLB",60,0)
+ N C S C=$G(^TMP("MXMLBLD",$J,"CNT"))
+"RTN","C0CMXMLB",61,0)
+ I C S ^TMP("MXMLBLD",$J,C)=S,^TMP("MXMLBLD",$J,"CNT")=C+1 Q
+"RTN","C0CMXMLB",62,0)
+ W S,!
+"RTN","C0CMXMLB",63,0)
+ Q
+"RTN","C0CMXMLB",64,0)
+ ;
+"RTN","C0CMXMLB",65,0)
+CHARCHK(STR) ; -- replace xml character limits with entities
+"RTN","C0CMXMLB",66,0)
+ N A,I,X,Y,Z,NEWSTR
+"RTN","C0CMXMLB",67,0)
+ S (Y,Z)=""
+"RTN","C0CMXMLB",68,0)
+ ;IF STR["&" SET NEWSTR=STR DO SET STR=Y_Z
+"RTN","C0CMXMLB",69,0)
+ ;. FOR X=1:1 SET Y=Y_$PIECE(NEWSTR,"&",X)_"&",Z=$PIECE(STR,"&",X+1,999) QUIT:Z'["&"
+"RTN","C0CMXMLB",70,0)
+ I STR["&" F I=1:1:$L(STR,"&")-1 S STR=$P(STR,"&",1,I)_"&"_$P(STR,"&",I+1,999)
+"RTN","C0CMXMLB",71,0)
+ I STR["<" F S STR=$PIECE(STR,"<",1)_"<"_$PIECE(STR,"<",2,99) Q:STR'["<"
+"RTN","C0CMXMLB",72,0)
+ I STR[">" F S STR=$PIECE(STR,">",1)_">"_$PIECE(STR,">",2,99) Q:STR'[">"
+"RTN","C0CMXMLB",73,0)
+ I STR["'" F S STR=$PIECE(STR,"'",1)_"'"_$PIECE(STR,"'",2,99) Q:STR'["'"
+"RTN","C0CMXMLB",74,0)
+ I STR["""" F S STR=$PIECE(STR,"""",1)_"""_$PIECE(STR,"""",2,99) Q:STR'[""""
+"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",77,0)
+ QUIT STR
+"RTN","C0CMXMLB",78,0)
+ ;
+"RTN","C0CMXMLB",79,0)
+COMMENT(VAL) ;Add Comments
+"RTN","C0CMXMLB",80,0)
+ N I,L
+"RTN","C0CMXMLB",81,0)
+ ;I $D($G(VAL))=1 D OUTPUT("") Q
+"RTN","C0CMXMLB",82,0)
+ I $D(VAL) D OUTPUT("") Q ;CHANGED BY GPL FOR GTM
+"RTN","C0CMXMLB",83,0)
+ S I="",L="")
+"RTN","C0CMXMLB",86,0)
+ Q
+"RTN","C0CMXMLB",87,0)
+ ;
+"RTN","C0CMXMLB",88,0)
+PUSH(INDENT,TAG,ATT) ;Write a TAG and save.
+"RTN","C0CMXMLB",89,0)
+ N CNT
+"RTN","C0CMXMLB",90,0)
+ S ATT=$G(ATT)
+"RTN","C0CMXMLB",91,0)
+ D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">")
+"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",93,0)
+ Q
+"RTN","C0CMXMLB",94,0)
+ ;
+"RTN","C0CMXMLB",95,0)
+POP ;Write last pushed tag and pop
+"RTN","C0CMXMLB",96,0)
+ N CNT,TAG,INDENT,X
+"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",98,0)
+ S INDENT=+X,TAG=$P(X,"^",2)
+"RTN","C0CMXMLB",99,0)
+ D OUTPUT($$BLS(INDENT)_""_TAG_">")
+"RTN","C0CMXMLB",100,0)
+ Q
+"RTN","C0CMXMLB",101,0)
+ ;
+"RTN","C0CMXMLB",102,0)
+BLS(I) ;Return INDENT string
+"RTN","C0CMXMLB",103,0)
+ N S
+"RTN","C0CMXMLB",104,0)
+ S S="",I=$G(I) S:I>0 $P(S," ",I)=" "
"RTN","C0CMXMLB",105,0)
-INDENT() ;Renturn indent level
+ Q S
"RTN","C0CMXMLB",106,0)
+ ;
+"RTN","C0CMXMLB",107,0)
+INDENT() ;Renturn indent level
+"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)
;
+"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 .
"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)
- Q
-"RTN","C0CMXP",21,0)
- ;
-"RTN","C0CMXP",22,0)
INITXPF(ARY) ;INITIAL XML/XPATH FILE ARRAY
-"RTN","C0CMXP",23,0)
+"RTN","C0CMXP",21,0)
; DON'T USE THIS ONE ... USE INITFARY^C0CSOAP("FARY") INSTEAD
-"RTN","C0CMXP",24,0)
+"RTN","C0CMXP",22,0)
D INITFARY^C0CSOAP(ARY) ;
-"RTN","C0CMXP",25,0)
+"RTN","C0CMXP",23,0)
Q
-"RTN","C0CMXP",26,0)
+"RTN","C0CMXP",24,0)
S @ARY@("XML FILE NUMBER")=178.101
-"RTN","C0CMXP",27,0)
+"RTN","C0CMXP",25,0)
S @ARY@("XML SOURCE FIELD")=2.1
-"RTN","C0CMXP",28,0)
+"RTN","C0CMXP",26,0)
S @ARY@("XML TEMPLATE FIELD")=3
-"RTN","C0CMXP",29,0)
+"RTN","C0CMXP",27,0)
S @ARY@("XPATH BINDING SUBFILE")=178.1014
-"RTN","C0CMXP",30,0)
+"RTN","C0CMXP",28,0)
S @ARY@("REDUX FIELD")=2.5
-"RTN","C0CMXP",31,0)
+"RTN","C0CMXP",29,0)
Q
+"RTN","C0CMXP",30,0)
+ ;
+"RTN","C0CMXP",31,0)
+SETXPF(ARY) ; SET FILE AND FIELD VARIABLES FROM XPF ARRAY
"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)
+"RTN","C0CMXP",34,0)
S C0CXFLD=@ARY@("XML")
-"RTN","C0CMXP",37,0)
+"RTN","C0CMXP",35,0)
S C0CXTFLD=@ARY@("TEMPLATE XML")
-"RTN","C0CMXP",38,0)
+"RTN","C0CMXP",36,0)
S C0CXPBF=@ARY@("BINDING SUBFILE NUMBER")
-"RTN","C0CMXP",39,0)
+"RTN","C0CMXP",37,0)
S C0CRDUXF=@ARY@("XPATH REDUCTION STRING")
+"RTN","C0CMXP",38,0)
+ Q
+"RTN","C0CMXP",39,0)
+ ;
"RTN","C0CMXP",40,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",41,0)
I '$D(FARY) D ;
-"RTN","C0CMXP",44,0)
+"RTN","C0CMXP",42,0)
. S FARY="FARY" ; FILE ARRAY
-"RTN","C0CMXP",45,0)
+"RTN","C0CMXP",43,0)
. D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
-"RTN","C0CMXP",46,0)
+"RTN","C0CMXP",44,0)
D SETXPF(FARY) ;SET FILE VARIABLES
-"RTN","C0CMXP",47,0)
+"RTN","C0CMXP",45,0)
N C0CA,C0CB
-"RTN","C0CMXP",48,0)
+"RTN","C0CMXP",46,0)
S C0CA="" S C0CB=0
-"RTN","C0CMXP",49,0)
+"RTN","C0CMXP",47,0)
F S C0CA=$O(@INARY@(C0CA)) Q:C0CA="" D ; FOR EACH XPATH
-"RTN","C0CMXP",50,0)
+"RTN","C0CMXP",48,0)
. S C0CB=C0CB+1 ; COUNT OF XPATHS
-"RTN","C0CMXP",51,0)
+"RTN","C0CMXP",49,0)
. S C0CFDA(C0CXPBF,"?+"_C0CB_","_TID_",",.01)=C0CA
-"RTN","C0CMXP",52,0)
+"RTN","C0CMXP",50,0)
. D UPDIE ; CREATE THE BINDING SUBFILE FOR THIS XPATH
-"RTN","C0CMXP",53,0)
+"RTN","C0CMXP",51,0)
Q
-"RTN","C0CMXP",54,0)
+"RTN","C0CMXP",52,0)
;
-"RTN","C0CMXP",55,0)
+"RTN","C0CMXP",53,0)
FIXICD9 ; FIX THE ICD9RESULT XML
-"RTN","C0CMXP",56,0)
+"RTN","C0CMXP",54,0)
D GETXML("GPL","ICD9RESULT") ; GET SOME BAD XML OUT OF THE FILE
-"RTN","C0CMXP",57,0)
+"RTN","C0CMXP",55,0)
S ZI=""
-"RTN","C0CMXP",58,0)
+"RTN","C0CMXP",56,0)
S G=""
-"RTN","C0CMXP",59,0)
+"RTN","C0CMXP",57,0)
F S ZI=$O(GPL(ZI)) Q:ZI="" D ; FOR EACH LINE
-"RTN","C0CMXP",60,0)
+"RTN","C0CMXP",58,0)
. S G=G_GPL(ZI) ; MAKE ONE BIG STRING OF XML
-"RTN","C0CMXP",61,0)
+"RTN","C0CMXP",59,0)
D NORMAL^C0CSOAP("G2","G") ;NO NORMALIZE IT BACK INTO AN ARRAY
-"RTN","C0CMXP",62,0)
+"RTN","C0CMXP",60,0)
D ADDXML("G2","ICD9RESULT") ; AND PUT IT BACK
-"RTN","C0CMXP",63,0)
+"RTN","C0CMXP",61,0)
Q
-"RTN","C0CMXP",64,0)
+"RTN","C0CMXP",62,0)
ADDXML(INXML,TEMPID,INFARY) ;ADD XML TO A TEMPLATE ID TEMPID
-"RTN","C0CMXP",65,0)
+"RTN","C0CMXP",63,0)
; INXML IS PASSED BY NAME
-"RTN","C0CMXP",66,0)
+"RTN","C0CMXP",64,0)
I '$D(INFARY) D ;
-"RTN","C0CMXP",67,0)
+"RTN","C0CMXP",65,0)
. S INFARY="FARY" ; FILE ARRAY
-"RTN","C0CMXP",68,0)
+"RTN","C0CMXP",66,0)
. D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
-"RTN","C0CMXP",69,0)
+"RTN","C0CMXP",67,0)
I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME
-"RTN","C0CMXP",70,0)
+"RTN","C0CMXP",68,0)
D SETXPF(INFARY) ;SET FILE VARIABLES
-"RTN","C0CMXP",71,0)
+"RTN","C0CMXP",69,0)
D WP^DIE(C0CXPF,TEMPID_",",C0CXFLD,,INXML)
-"RTN","C0CMXP",72,0)
+"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)
-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)
+"RTN","C0CMXP",75,0)
. S INFARY="FARY" ; FILE ARRAY
-"RTN","C0CMXP",78,0)
+"RTN","C0CMXP",76,0)
. D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
-"RTN","C0CMXP",79,0)
+"RTN","C0CMXP",77,0)
I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME
-"RTN","C0CMXP",80,0)
+"RTN","C0CMXP",78,0)
D SETXPF(INFARY) ;SET FILE VARIABLES
-"RTN","C0CMXP",81,0)
+"RTN","C0CMXP",79,0)
D WP^DIE(C0CXPF,TEMPID_",",C0CXTFLD,,INXML)
-"RTN","C0CMXP",82,0)
+"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)
-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)
+"RTN","C0CMXP",85,0)
. S INFARY="FARY" ; FILE ARRAY
-"RTN","C0CMXP",88,0)
+"RTN","C0CMXP",86,0)
. D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
-"RTN","C0CMXP",89,0)
+"RTN","C0CMXP",87,0)
D SETXPF(INFARY) ;SET FILE VARIABLES
-"RTN","C0CMXP",90,0)
+"RTN","C0CMXP",88,0)
I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME
-"RTN","C0CMXP",91,0)
+"RTN","C0CMXP",89,0)
I $$GET1^DIQ(C0CXPF,TEMPID_",",C0CXFLD,,OUTXML)'=OUTXML D Q ;
-"RTN","C0CMXP",92,0)
+"RTN","C0CMXP",90,0)
. W "ERROR RETRIEVING TEMPLATE",!
-"RTN","C0CMXP",93,0)
+"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)
-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)
+"RTN","C0CMXP",96,0)
. S FARY="FARY" ; FILE ARRAY
-"RTN","C0CMXP",99,0)
+"RTN","C0CMXP",97,0)
. D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
-"RTN","C0CMXP",100,0)
+"RTN","C0CMXP",98,0)
D SETXPF(FARY) ;SET FILE VARIABLES
-"RTN","C0CMXP",101,0)
+"RTN","C0CMXP",99,0)
I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,FARY) ;RESOLVE TEMPLATE NAME
-"RTN","C0CMXP",102,0)
+"RTN","C0CMXP",100,0)
I $$GET1^DIQ(C0CXPF,TEMPID_",",C0CXTFLD,,OUTXML)'=OUTXML D Q ;
-"RTN","C0CMXP",103,0)
+"RTN","C0CMXP",101,0)
. W "ERROR RETRIEVING TEMPLATE",!
+"RTN","C0CMXP",102,0)
+ Q
+"RTN","C0CMXP",103,0)
+ ;
"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)
+"RTN","C0CMXP",105,0)
; FROM ONE RECORD TO ANOTHER RECORD
-"RTN","C0CMXP",108,0)
+"RTN","C0CMXP",106,0)
; ZFLD IS EITHER A NUMBERIC FIELD OR A NAME IN ZSRCF
-"RTN","C0CMXP",109,0)
+"RTN","C0CMXP",107,0)
; ZSRCF IS THE SOURCE FILE, IN FILE REDIRECT FORMAT
-"RTN","C0CMXP",110,0)
+"RTN","C0CMXP",108,0)
; IF ZSRCF IS OMMITED, THE DEFAULT C0C XML MISC FILE WILL BE ASSUMED
-"RTN","C0CMXP",111,0)
+"RTN","C0CMXP",109,0)
; ZDESTF IS DESTINATION FILE. IF OMMITED, IS ASSUMED TO BE THE SAME
-"RTN","C0CMXP",112,0)
+"RTN","C0CMXP",110,0)
; A ZSRCF
-"RTN","C0CMXP",113,0)
+"RTN","C0CMXP",111,0)
I '$D(ZSRCF) D ;
-"RTN","C0CMXP",114,0)
+"RTN","C0CMXP",112,0)
. S ZSRCF="ZSRCF"
-"RTN","C0CMXP",115,0)
+"RTN","C0CMXP",113,0)
. D INITFARY^C0CSOAP(ZSRCF)
-"RTN","C0CMXP",116,0)
+"RTN","C0CMXP",114,0)
I '$D(ZDESTF) D ;
-"RTN","C0CMXP",117,0)
+"RTN","C0CMXP",115,0)
. S ZDESTF="ZDESTF"
-"RTN","C0CMXP",118,0)
+"RTN","C0CMXP",116,0)
. M @ZDESTF=@ZSRCF
-"RTN","C0CMXP",119,0)
+"RTN","C0CMXP",117,0)
N ZSF,ZDF,ZSFREF,ZDFREF
-"RTN","C0CMXP",120,0)
+"RTN","C0CMXP",118,0)
S ZSF=@ZSRCF@("XML FILE NUMBER")
-"RTN","C0CMXP",121,0)
+"RTN","C0CMXP",119,0)
S ZSFREF=$$FILEREF^C0CRNF(ZSF)
-"RTN","C0CMXP",122,0)
+"RTN","C0CMXP",120,0)
S ZDF=@ZDESTF@("XML FILE NUMBER")
-"RTN","C0CMXP",123,0)
+"RTN","C0CMXP",121,0)
S ZDFREF=$$FILEREF^C0CRNF(ZDF)
-"RTN","C0CMXP",124,0)
+"RTN","C0CMXP",122,0)
N ZSIEN,ZDIEN
-"RTN","C0CMXP",125,0)
+"RTN","C0CMXP",123,0)
S ZSIEN=$O(@ZSFREF@("B",ZSRCREC,""))
-"RTN","C0CMXP",126,0)
+"RTN","C0CMXP",124,0)
I ZSIEN="" W !,"ERROR SOURCE RECORD NOT FOUND" Q ;
-"RTN","C0CMXP",127,0)
+"RTN","C0CMXP",125,0)
S ZDIEN=$O(@ZDFREF@("B",ZDESTREC,""))
-"RTN","C0CMXP",128,0)
+"RTN","C0CMXP",126,0)
I ZDIEN="" W !,"ERROR DESTINATION RECORD NOT FOUND" Q ;
-"RTN","C0CMXP",129,0)
+"RTN","C0CMXP",127,0)
N ZFLDNUM
-"RTN","C0CMXP",130,0)
+"RTN","C0CMXP",128,0)
I +ZFLD=0 S ZFLDNUM=@ZSRCF@(ZFLD) ; IF FIELD IS PASSED BY NAME
-"RTN","C0CMXP",131,0)
+"RTN","C0CMXP",129,0)
E S ZFLDNUM=ZFLD ; IF FIELD IS PASSED BY NUMBER
-"RTN","C0CMXP",132,0)
+"RTN","C0CMXP",130,0)
N ZWP,ZWPN
-"RTN","C0CMXP",133,0)
+"RTN","C0CMXP",131,0)
S ZWPN=$$GET1^DIQ(ZSF,ZSIEN_",",ZFLDNUM,,"ZWP") ; GET WP FROM SOURCE
-"RTN","C0CMXP",134,0)
+"RTN","C0CMXP",132,0)
I ZWPN'="ZWP" W !,"ERROR SOURCE FIELD EMPTY" Q ;
-"RTN","C0CMXP",135,0)
+"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)
- Q
-"RTN","C0CMXP",137,0)
- ;
-"RTN","C0CMXP",138,0)
COMPILE(TID,UFARY) ; COMPILES AN XML TEMPLATE AND GENERATES XPATH BINDINGS
-"RTN","C0CMXP",139,0)
+"RTN","C0CMXP",137,0)
; UFARY IF SPECIFIED WILL REDIRECT THE XML FILE TO USE
-"RTN","C0CMXP",140,0)
+"RTN","C0CMXP",138,0)
; INTID IS THE IEN OF THE RECORD TO USE IN THE XML FILE
-"RTN","C0CMXP",141,0)
+"RTN","C0CMXP",139,0)
; XML IS PULLED FROM THE "XML" FIELD AND THE COMPILED RESULT PUT
-"RTN","C0CMXP",142,0)
+"RTN","C0CMXP",140,0)
; IN THE "XML TEMPLATE" FIELD. ALL XPATHS USED IN THE TEMPLATE
-"RTN","C0CMXP",143,0)
+"RTN","C0CMXP",141,0)
; WILL BE POPULATED TO THE XPATH BINDINGS SUBFILE AS .01
-"RTN","C0CMXP",144,0)
+"RTN","C0CMXP",142,0)
I '$D(UFARY) D ;
-"RTN","C0CMXP",145,0)
+"RTN","C0CMXP",143,0)
. S UFARY="DEFFARY" ; FILE ARRAY
-"RTN","C0CMXP",146,0)
+"RTN","C0CMXP",144,0)
. ;D INITXPF("UFARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
-"RTN","C0CMXP",147,0)
+"RTN","C0CMXP",145,0)
. D INITFARY^C0CSOAP(UFARY)
-"RTN","C0CMXP",148,0)
+"RTN","C0CMXP",146,0)
D SETXPF(UFARY) ;SET FILE VARIABLES
-"RTN","C0CMXP",149,0)
+"RTN","C0CMXP",147,0)
I +TID=0 S INTID=$$RESTID^C0CSOAP(TID,UFARY)
-"RTN","C0CMXP",150,0)
+"RTN","C0CMXP",148,0)
E S INTID=TID
-"RTN","C0CMXP",151,0)
+"RTN","C0CMXP",149,0)
;B
-"RTN","C0CMXP",152,0)
+"RTN","C0CMXP",150,0)
;N C0CXML,C0CREDUX,C0CTEMP,C0CIDX
-"RTN","C0CMXP",153,0)
+"RTN","C0CMXP",151,0)
D GETXML("C0CXML",INTID,UFARY)
-"RTN","C0CMXP",154,0)
+"RTN","C0CMXP",152,0)
S C0CREDUX=$$GET1^DIQ(C0CXPF,INTID_",",C0CRDUXF,"E") ;XPATH REDUCTION STRING
-"RTN","C0CMXP",155,0)
+"RTN","C0CMXP",153,0)
D MKTPLATE("C0CTEMP","C0CIDX","C0CXML",C0CREDUX) ; CREATE TEMPLATE AND IDX
-"RTN","C0CMXP",156,0)
+"RTN","C0CMXP",154,0)
D ADDTEMP("C0CTEMP",INTID,UFARY) ; WRITE THE TEMPLATE TO FILE
-"RTN","C0CMXP",157,0)
+"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)
- 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)
+"RTN","C0CMXP",159,0)
; BOTH PASSED BY NAME. THE REDUX XPATH REDUCTION STRING IS USED IF PASSED
-"RTN","C0CMXP",162,0)
+"RTN","C0CMXP",160,0)
; OUTIDX IS AN ARRAY OF THE XPATHS USED IN MAKING THE TEMPLATE
-"RTN","C0CMXP",163,0)
+"RTN","C0CMXP",161,0)
;
-"RTN","C0CMXP",164,0)
+"RTN","C0CMXP",162,0)
S C0CXLOC=$NA(^TMP("C0CXML",$J))
-"RTN","C0CMXP",165,0)
+"RTN","C0CMXP",163,0)
K @C0CXLOC
-"RTN","C0CMXP",166,0)
+"RTN","C0CMXP",164,0)
M @C0CXLOC=@INXML
-"RTN","C0CMXP",167,0)
+"RTN","C0CMXP",165,0)
S C0CDOCID=$$PARSE^C0CMXML(C0CXLOC,"C0CMKT")
-"RTN","C0CMXP",168,0)
+"RTN","C0CMXP",166,0)
K @C0CXLOC
-"RTN","C0CMXP",169,0)
- S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
-"RTN","C0CMXP",170,0)
+"RTN","C0CMXP",167,0)
+ S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
+"RTN","C0CMXP",168,0)
;N GIDX,GIDX2,GARY,GARY2
-"RTN","C0CMXP",171,0)
+"RTN","C0CMXP",169,0)
I '$D(REDUX) S REDUX=""
-"RTN","C0CMXP",172,0)
+"RTN","C0CMXP",170,0)
D XPATH^C0CMXML(1,"/","GIDX","GARY",,REDUX)
-"RTN","C0CMXP",173,0)
+"RTN","C0CMXP",171,0)
D INVERT("GIDX2","GIDX") ;MAKE ARRAY TO LOOK UP XPATH BY NODE
-"RTN","C0CMXP",174,0)
+"RTN","C0CMXP",172,0)
N ZI,ZD S ZI=""
-"RTN","C0CMXP",175,0)
+"RTN","C0CMXP",173,0)
F S ZI=$O(@C0CDOM@(ZI)) Q:ZI="" D ; FOR EACH NODE IN THE DOM
-"RTN","C0CMXP",176,0)
+"RTN","C0CMXP",174,0)
. K ZD ;FOR DATA
-"RTN","C0CMXP",177,0)
+"RTN","C0CMXP",175,0)
. D DATA^C0CMXML("ZD",ZI) ;SEE IF THERE IS DATA FOR THIS NODE
-"RTN","C0CMXP",178,0)
+"RTN","C0CMXP",176,0)
. ;I $D(ZD(1)) D ; IF YES
-"RTN","C0CMXP",179,0)
+"RTN","C0CMXP",177,0)
. I $$FIRST^C0CMXML(ZI)=0 D ; IF THERE ARE NO CHILDREN TO THIS NODE
-"RTN","C0CMXP",180,0)
+"RTN","C0CMXP",178,0)
. . ;I ZI<3 B ;W !,ZD(1)
-"RTN","C0CMXP",181,0)
+"RTN","C0CMXP",179,0)
. . K @C0CDOM@(ZI,"T") ; KILL THE DATA
-"RTN","C0CMXP",182,0)
+"RTN","C0CMXP",180,0)
. . N ZXPATH
-"RTN","C0CMXP",183,0)
+"RTN","C0CMXP",181,0)
. . S ZXPATH=$G(GIDX2(ZI)) ;FIND AN XPATH FOR THIS NODE
-"RTN","C0CMXP",184,0)
+"RTN","C0CMXP",182,0)
. . S @C0CDOM@(ZI,"T",1)="@@"_ZXPATH_"@@"
-"RTN","C0CMXP",185,0)
+"RTN","C0CMXP",183,0)
. . I ZXPATH'="" S @OUTIDX@(ZXPATH)="" ; PASS BACK XPATH USED IN IDX
-"RTN","C0CMXP",186,0)
+"RTN","C0CMXP",184,0)
D OUTXML^C0CMXML(OUTT,C0CDOCID)
+"RTN","C0CMXP",185,0)
+ Q
+"RTN","C0CMXP",186,0)
+ ;
"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)
+"RTN","C0CMXP",188,0)
; @INX@(XPath)=x
-"RTN","C0CMXP",191,0)
+"RTN","C0CMXP",189,0)
N ZI S ZI=""
-"RTN","C0CMXP",192,0)
+"RTN","C0CMXP",190,0)
F S ZI=$O(@INX@(ZI)) Q:ZI="" D ;FOR EACH XPATH IN THE INPUT
-"RTN","C0CMXP",193,0)
+"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)
- 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)
+"RTN","C0CMXP",195,0)
; RETURNS OUTX: MULTIPLE^SUBMULTIPLE^XPATH
-"RTN","C0CMXP",198,0)
+"RTN","C0CMXP",196,0)
N ZX,ZY,ZZ,ZZ1,ZMULT,ZSUB
-"RTN","C0CMXP",199,0)
+"RTN","C0CMXP",197,0)
S (ZMULT,ZSUB)=""
-"RTN","C0CMXP",200,0)
+"RTN","C0CMXP",198,0)
S ZX=$P(INX,"[",2)
-"RTN","C0CMXP",201,0)
+"RTN","C0CMXP",199,0)
I ZX'="" D ; THERE IS A [x] MULTIPLE
-"RTN","C0CMXP",202,0)
+"RTN","C0CMXP",200,0)
. S ZY=$P(INX,"[",1) ;FIRST PART OF XPATH
-"RTN","C0CMXP",203,0)
+"RTN","C0CMXP",201,0)
. S ZMULT=$P(ZX,"]",1) ; NUMBER OF THE MULTIPLE
-"RTN","C0CMXP",204,0)
+"RTN","C0CMXP",202,0)
. S ZX=ZY_$P(ZX,"]",2) ; REST OF THE XPATH
-"RTN","C0CMXP",205,0)
+"RTN","C0CMXP",203,0)
. I $P(ZX,"[",2)'="" D ; A SUB MULTIPLE EXISTS
-"RTN","C0CMXP",206,0)
+"RTN","C0CMXP",204,0)
. . S ZZ=$P(ZX,"[",1) ; FIRST PART OF XPATH
-"RTN","C0CMXP",207,0)
+"RTN","C0CMXP",205,0)
. . S ZX=$P(ZX,"[",2) ; DELETE THE [
-"RTN","C0CMXP",208,0)
+"RTN","C0CMXP",206,0)
. . S ZSUB=$P(ZX,"]",1) ; NUMBER OF THE SUBMULTIPLE
-"RTN","C0CMXP",209,0)
+"RTN","C0CMXP",207,0)
. . S ZX=ZZ_$P(ZX,"]",2) ; REST OF THE XPATH
-"RTN","C0CMXP",210,0)
+"RTN","C0CMXP",208,0)
E S ZX=INX ;NO MULTIPLE HERE
-"RTN","C0CMXP",211,0)
+"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)
- Q
-"RTN","C0CMXP",213,0)
- ;
-"RTN","C0CMXP",214,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)
- ; FORMAT @OARY@(x,variablename) where x is the first multiple
+ N ZI,ZJ,ZK,ZL,ZM S ZI=""
"RTN","C0CMXP",216,0)
- ; IF DEPTH=2, THE LAST 2 PARTS OF THE XPATH WILL BE USED
+ F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ;
"RTN","C0CMXP",217,0)
- N ZI,ZJ,ZK,ZL,ZM S ZI=""
+ . D DEMUX^C0CMXP("ZJ",ZI)
"RTN","C0CMXP",218,0)
- F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ;
+ . S ZK=$P(ZJ,"^",3)
"RTN","C0CMXP",219,0)
- . D DEMUX^C0CMXP("ZJ",ZI)
+ . S ZM=$RE($P($RE(ZK),"/",1))
"RTN","C0CMXP",220,0)
- . S ZK=$P(ZJ,"^",3)
+ . 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),"/",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",222,0)
+ . S ZL=$P(ZJ,"^",1)
+"RTN","C0CMXP",223,0)
+ . I ZL="" S ZL=1
"RTN","C0CMXP",224,0)
- . S ZL=$P(ZJ,"^",1)
+ . I $D(@OARY@(ZL,ZM)) D ;IT'S A DUP
"RTN","C0CMXP",225,0)
- . I ZL="" S ZL=1
+ . . S @OARY@(ZL,ZM_"[2]")=@IARY@(ZI)
"RTN","C0CMXP",226,0)
- . I $D(@OARY@(ZL,ZM)) D ;IT'S A DUP
+ . E S @OARY@(ZL,ZM)=@IARY@(ZI)
"RTN","C0CMXP",227,0)
- . . S @OARY@(ZL,ZM_"[2]")=@IARY@(ZI)
+ Q
"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)
+"RTN","C0CMXP",230,0)
; FORMAT @OARY@(x,variablename) where x is the first multiple
-"RTN","C0CMXP",233,0)
+"RTN","C0CMXP",231,0)
; IF DEPTH=2, THE LAST 2 PARTS OF THE XPATH WILL BE USED
-"RTN","C0CMXP",234,0)
+"RTN","C0CMXP",232,0)
N ZI,ZJ,ZK,ZL,ZM S ZI=""
-"RTN","C0CMXP",235,0)
+"RTN","C0CMXP",233,0)
F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ;
-"RTN","C0CMXP",236,0)
+"RTN","C0CMXP",234,0)
. D DEMUX^C0CMXP("ZJ",ZI)
-"RTN","C0CMXP",237,0)
+"RTN","C0CMXP",235,0)
. S ZK=$P(ZJ,"^",3)
-"RTN","C0CMXP",238,0)
+"RTN","C0CMXP",236,0)
. S ZM=$RE($P($RE(ZK),"/",1))
-"RTN","C0CMXP",239,0)
+"RTN","C0CMXP",237,0)
. I $G(DEPTH)=2 D ;LAST TWO PARTS OF XPATH USED FOR THE VARIABLE NAME
-"RTN","C0CMXP",240,0)
+"RTN","C0CMXP",238,0)
. . S ZM=$RE($P($RE(ZK),"/",2))_"."_ZM
-"RTN","C0CMXP",241,0)
+"RTN","C0CMXP",239,0)
. S ZL=$P(ZJ,"^",1)
-"RTN","C0CMXP",242,0)
+"RTN","C0CMXP",240,0)
. I ZL="" S ZL=1
-"RTN","C0CMXP",243,0)
+"RTN","C0CMXP",241,0)
. I $D(@OARY@(ZL,ZM)) D ;IT'S A DUP
-"RTN","C0CMXP",244,0)
+"RTN","C0CMXP",242,0)
. . S @OARY@(ZL,ZM_"[2]")=@IARY@(ZI)
-"RTN","C0CMXP",245,0)
+"RTN","C0CMXP",243,0)
. E S @OARY@(ZL,ZM)=@IARY@(ZI)
+"RTN","C0CMXP",244,0)
+ Q
+"RTN","C0CMXP",245,0)
+ ;
"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)
+"RTN","C0CMXP",247,0)
; BOTH IARY AND OARY ARE PASSED BY NAME
-"RTN","C0CMXP",250,0)
+"RTN","C0CMXP",248,0)
; RETURNS A SIMPLE XPATH ARRAY WITHOUT MULTIPLES. DUPLICATES ARE REMOVED
-"RTN","C0CMXP",251,0)
+"RTN","C0CMXP",249,0)
N ZI,ZJ,ZK
-"RTN","C0CMXP",252,0)
+"RTN","C0CMXP",250,0)
S ZI=""
-"RTN","C0CMXP",253,0)
+"RTN","C0CMXP",251,0)
F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH XPATH IN IARY
-"RTN","C0CMXP",254,0)
+"RTN","C0CMXP",252,0)
. D DEMUX^C0CMXP("ZJ",ZI)
-"RTN","C0CMXP",255,0)
+"RTN","C0CMXP",253,0)
. S ZK=$P(ZJ,"^",3) ;THE XPATH
-"RTN","C0CMXP",256,0)
+"RTN","C0CMXP",254,0)
. S @OARY@(ZK)=@IARY@(ZI) ;THE RESULT. DUPLICATES WILL NOT SHOW
-"RTN","C0CMXP",257,0)
+"RTN","C0CMXP",255,0)
. ; CAUTION, IF THERE ARE MULTIPLES, ONLY THE DATA FOR THE LAST
-"RTN","C0CMXP",258,0)
+"RTN","C0CMXP",256,0)
. ; MULTIPLE WILL BE INCLUDED IN THE OUTPUT ARRAY, ASSIGNED TO THE
-"RTN","C0CMXP",259,0)
+"RTN","C0CMXP",257,0)
. ; COMMON XPATH
+"RTN","C0CMXP",258,0)
+ Q
+"RTN","C0CMXP",259,0)
+ ;
"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)
+"RTN","C0CMXP",261,0)
; IARY IS AN XPATH ARRAY THAT MAY CONTAIN MULTIPLES
-"RTN","C0CMXP",264,0)
+"RTN","C0CMXP",262,0)
; OARY IS THE OUTPUT ARRAY WHERE MULTIPLES ARE RETURNED IN THE FORM
-"RTN","C0CMXP",265,0)
+"RTN","C0CMXP",263,0)
; @OARY@(x,Xpath)=data or @OARY@(x,y,Xpath)=data WHERE x AND y ARE
-"RTN","C0CMXP",266,0)
+"RTN","C0CMXP",264,0)
; THE MULTIPLES AND Xpath IS THE BASE XPATH WITHOUT [x] AND [y]
-"RTN","C0CMXP",267,0)
+"RTN","C0CMXP",265,0)
;
-"RTN","C0CMXP",268,0)
+"RTN","C0CMXP",266,0)
N ZI,ZJ,ZK,ZX,ZY,ZP
-"RTN","C0CMXP",269,0)
+"RTN","C0CMXP",267,0)
S ZI=""
-"RTN","C0CMXP",270,0)
+"RTN","C0CMXP",268,0)
F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH INPUT XPATH
-"RTN","C0CMXP",271,0)
+"RTN","C0CMXP",269,0)
. D DEMUX("ZJ",ZI) ; PULL OUT THE MULTIPLES
-"RTN","C0CMXP",272,0)
+"RTN","C0CMXP",270,0)
. S ZX=$P(ZJ,"^",1) ;x
-"RTN","C0CMXP",273,0)
+"RTN","C0CMXP",271,0)
. S ZY=$P(ZJ,"^",2) ;y
-"RTN","C0CMXP",274,0)
+"RTN","C0CMXP",272,0)
. S ZP=$P(ZJ,"^",3) ;Xpath
-"RTN","C0CMXP",275,0)
+"RTN","C0CMXP",273,0)
. I ZX="" S ZX=1 ; NO MULTIPLE WILL STORE IN x=1
-"RTN","C0CMXP",276,0)
+"RTN","C0CMXP",274,0)
. I ZY'="" D ;IS THERE A y?
-"RTN","C0CMXP",277,0)
+"RTN","C0CMXP",275,0)
. . S @OARY@(ZX,ZY,ZP)=@IARY@(ZI)
-"RTN","C0CMXP",278,0)
+"RTN","C0CMXP",276,0)
. E D ;NO y
-"RTN","C0CMXP",279,0)
+"RTN","C0CMXP",277,0)
. . S @OARY@(ZX,ZP)=@IARY@(ZI)
-"RTN","C0CMXP",280,0)
+"RTN","C0CMXP",278,0)
Q
-"RTN","C0CMXP",281,0)
+"RTN","C0CMXP",279,0)
;
-"RTN","C0CMXP",282,0)
+"RTN","C0CMXP",280,0)
UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
-"RTN","C0CMXP",283,0)
+"RTN","C0CMXP",281,0)
K ZERR
-"RTN","C0CMXP",284,0)
+"RTN","C0CMXP",282,0)
D CLEAN^DILF
-"RTN","C0CMXP",285,0)
+"RTN","C0CMXP",283,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)
+"RTN","C0CMXP",284,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CMXP",285,0)
K C0CFDA
-"RTN","C0CMXP",291,0)
+"RTN","C0CMXP",286,0)
Q
-"RTN","C0CMXP",292,0)
+"RTN","C0CMXP",287,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 .
"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)
- ;
-"RTN","C0CNHIN",20,0)
- Q
-"RTN","C0CNHIN",21,0)
EN(ZRTN,ZDFN,ZPART,KEEP) ; GENERATE AN NHIN ARRAY FOR A PATIENT
-"RTN","C0CNHIN",22,0)
+"RTN","C0CNHIN",20,0)
;
-"RTN","C0CNHIN",23,0)
+"RTN","C0CNHIN",21,0)
K GARY,GNARY,GIDX,C0CDOCID
-"RTN","C0CNHIN",24,0)
+"RTN","C0CNHIN",22,0)
N GN
-"RTN","C0CNHIN",25,0)
+"RTN","C0CNHIN",23,0)
K ^TMP("NHINV",$J) ; CLEAN UP FROM LAST CALL
-"RTN","C0CNHIN",26,0)
+"RTN","C0CNHIN",24,0)
K ^TMP("MXMLDOM",$J) ; CLEAN UP DOM
-"RTN","C0CNHIN",27,0)
+"RTN","C0CNHIN",25,0)
K ^TMP("MXMLERR",$J) ; CLEAN UP MXML ERRORS
-"RTN","C0CNHIN",28,0)
+"RTN","C0CNHIN",26,0)
D GET^NHINV(.GN,ZDFN,ZPART) ; CALL NHINV ROUTINES TO PULL XML
-"RTN","C0CNHIN",29,0)
+"RTN","C0CNHIN",27,0)
S GN=$P(GN,")",1)_")" ; CUT OFF THE REST OF LINE PROTOCOL
-"RTN","C0CNHIN",30,0)
+"RTN","C0CNHIN",28,0)
S C0CDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML
-"RTN","C0CNHIN",31,0)
+"RTN","C0CNHIN",29,0)
D DOMO^C0CDOM(C0CDOCID,"/","ZRTN","GIDX","GARY",,"/results/") ; BLD ARRAYS
-"RTN","C0CNHIN",32,0)
+"RTN","C0CNHIN",30,0)
I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
-"RTN","C0CNHIN",33,0)
+"RTN","C0CNHIN",31,0)
;D PROCESS("ZRTN",GN,"/result/",$G(KEEP))
-"RTN","C0CNHIN",34,0)
+"RTN","C0CNHIN",32,0)
Q
+"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)
-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)
+"RTN","C0CNHIN",37,0)
S ZG=$NA(^TMP("PQRIXML",$J))
-"RTN","C0CNHIN",40,0)
+"RTN","C0CNHIN",38,0)
K @ZG
-"RTN","C0CNHIN",41,0)
+"RTN","C0CNHIN",39,0)
D GETXML^C0CMXP(ZG,"PQRIXML") ; GET THE XML FROM C0C MISC XML
-"RTN","C0CNHIN",42,0)
+"RTN","C0CNHIN",40,0)
N C0CDOCID
-"RTN","C0CNHIN",43,0)
+"RTN","C0CNHIN",41,0)
S C0CDOCID=$$PARSE^C0CDOM(ZG,"PQRIXML") ; PARSE THE XML
-"RTN","C0CNHIN",44,0)
+"RTN","C0CNHIN",42,0)
D DOMO^C0CDOM(C0CDOCID,"/","ZOUT","GIDX","GARY",,"//submission") ; BLD ARRAYS
-"RTN","C0CNHIN",45,0)
+"RTN","C0CNHIN",43,0)
I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
-"RTN","C0CNHIN",46,0)
+"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)
-PQRI2(ZRTN) ; RETURN THE NHIN ARRAY FOR PQRI ONE MEASURE
-"RTN","C0CNHIN",49,0)
- ;
-"RTN","C0CNHIN",50,0)
;N GG
-"RTN","C0CNHIN",51,0)
+"RTN","C0CNHIN",49,0)
D GETXML^C0CMXP("GG","PQRI ONE MEASURE")
-"RTN","C0CNHIN",52,0)
+"RTN","C0CNHIN",50,0)
D PROCESS(ZRTN,"GG","root",1)
+"RTN","C0CNHIN",51,0)
+ Q
+"RTN","C0CNHIN",52,0)
+ ;
"RTN","C0CNHIN",53,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)
+"RTN","C0CNHIN",54,0)
; ZRTN IS PASSED BY REFERENCE
-"RTN","C0CNHIN",57,0)
+"RTN","C0CNHIN",55,0)
; ZXML IS PASSED BY NAME
-"RTN","C0CNHIN",58,0)
+"RTN","C0CNHIN",56,0)
; IF KEEP IS 1, GARY AND GIDX ARE NOT KILLED
-"RTN","C0CNHIN",59,0)
+"RTN","C0CNHIN",57,0)
;
-"RTN","C0CNHIN",60,0)
+"RTN","C0CNHIN",58,0)
N GN
-"RTN","C0CNHIN",61,0)
+"RTN","C0CNHIN",59,0)
S GN=$NA(^TMP("C0CPROCESS",$J))
-"RTN","C0CNHIN",62,0)
+"RTN","C0CNHIN",60,0)
K @GN
-"RTN","C0CNHIN",63,0)
+"RTN","C0CNHIN",61,0)
M @GN=@ZXML
-"RTN","C0CNHIN",64,0)
+"RTN","C0CNHIN",62,0)
S C0CDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML
-"RTN","C0CNHIN",65,0)
+"RTN","C0CNHIN",63,0)
K @GN
-"RTN","C0CNHIN",66,0)
+"RTN","C0CNHIN",64,0)
D DOMO^C0CDOM(C0CDOCID,"/","ZRSLT","GIDX","GARY",,$G(ZREDUCE)) ; BLD ARRAYS
-"RTN","C0CNHIN",67,0)
+"RTN","C0CNHIN",65,0)
I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
-"RTN","C0CNHIN",68,0)
+"RTN","C0CNHIN",66,0)
Q
+"RTN","C0CNHIN",67,0)
+ ;
+"RTN","C0CNHIN",68,0)
+LOADSMRT ;
"RTN","C0CNHIN",69,0)
;
"RTN","C0CNHIN",70,0)
-LOADSMRT ;
-"RTN","C0CNHIN",71,0)
- ;
-"RTN","C0CNHIN",72,0)
K ^GPL("SMART")
-"RTN","C0CNHIN",73,0)
+"RTN","C0CNHIN",71,0)
S GN=$NA(^GPL("SMART",1))
-"RTN","C0CNHIN",74,0)
+"RTN","C0CNHIN",72,0)
I $$FTG^%ZISH("/home/george/","alex-lewis2.xml",GN,2) W !,"SMART FILE LOADED"
-"RTN","C0CNHIN",75,0)
+"RTN","C0CNHIN",73,0)
Q
+"RTN","C0CNHIN",74,0)
+ ;
+"RTN","C0CNHIN",75,0)
+SMART ; TRY IT WITH SMART
"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",78,0)
;K ^TMP("MXMLDOM",$J)
-"RTN","C0CNHIN",81,0)
+"RTN","C0CNHIN",79,0)
K ^TMP("MXMLERR",$J)
-"RTN","C0CNHIN",82,0)
+"RTN","C0CNHIN",80,0)
S C0CDOCID=$$PARSE(GN,"SMART")
-"RTN","C0CNHIN",83,0)
+"RTN","C0CNHIN",81,0)
D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//rdf:RDF/")
-"RTN","C0CNHIN",84,0)
+"RTN","C0CNHIN",82,0)
;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
-"RTN","C0CNHIN",85,0)
+"RTN","C0CNHIN",83,0)
Q
+"RTN","C0CNHIN",84,0)
+ ;
+"RTN","C0CNHIN",85,0)
+CCR ; TRY IT WITH A CCR
"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)
+"RTN","C0CNHIN",88,0)
;K ^TMP("MXMLDOM",$J)
-"RTN","C0CNHIN",91,0)
+"RTN","C0CNHIN",89,0)
K ^TMP("MXMLERR",$J)
-"RTN","C0CNHIN",92,0)
+"RTN","C0CNHIN",90,0)
S C0CDOCID=$$PARSE(GN,"CCR")
-"RTN","C0CNHIN",93,0)
+"RTN","C0CNHIN",91,0)
D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//ContinuityOfCareRecord/Body/")
-"RTN","C0CNHIN",94,0)
+"RTN","C0CNHIN",92,0)
;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
-"RTN","C0CNHIN",95,0)
+"RTN","C0CNHIN",93,0)
Q
+"RTN","C0CNHIN",94,0)
+ ;
+"RTN","C0CNHIN",95,0)
+MED ; TRY IT WITH A CCR MED SECTION
"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)
+"RTN","C0CNHIN",98,0)
K ^TMP("MXMLDOM",$J)
-"RTN","C0CNHIN",101,0)
+"RTN","C0CNHIN",99,0)
K ^TMP("MXMLERR",$J)
-"RTN","C0CNHIN",102,0)
+"RTN","C0CNHIN",100,0)
S C0CDOCID=$$PARSE(GN,"MED")
-"RTN","C0CNHIN",103,0)
+"RTN","C0CNHIN",101,0)
D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//Medications/")
-"RTN","C0CNHIN",104,0)
+"RTN","C0CNHIN",102,0)
;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
-"RTN","C0CNHIN",105,0)
+"RTN","C0CNHIN",103,0)
Q
+"RTN","C0CNHIN",104,0)
+ ;
+"RTN","C0CNHIN",105,0)
+CCD ; TRY IT WITH A CCD
"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)
+"RTN","C0CNHIN",108,0)
;K ^TMP("MXMLDOM",$J)
-"RTN","C0CNHIN",111,0)
+"RTN","C0CNHIN",109,0)
K ^TMP("MXMLERR",$J)
-"RTN","C0CNHIN",112,0)
+"RTN","C0CNHIN",110,0)
S C0CDOCID=$$PARSE(GN,"CCD")
-"RTN","C0CNHIN",113,0)
+"RTN","C0CNHIN",111,0)
D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//ClinicalDocument/component/structuredBody/")
-"RTN","C0CNHIN",114,0)
+"RTN","C0CNHIN",112,0)
;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
-"RTN","C0CNHIN",115,0)
+"RTN","C0CNHIN",113,0)
Q
-"RTN","C0CNHIN",116,0)
+"RTN","C0CNHIN",114,0)
;
-"RTN","C0CNHIN",117,0)
+"RTN","C0CNHIN",115,0)
TEST1 ; TEST NHINV OUTPUT IN ^GPL("NIHIN")
-"RTN","C0CNHIN",118,0)
+"RTN","C0CNHIN",116,0)
; PARSED WITH MXML
-"RTN","C0CNHIN",119,0)
+"RTN","C0CNHIN",117,0)
; RUN THROUGH XPATH
-"RTN","C0CNHIN",120,0)
+"RTN","C0CNHIN",118,0)
K GARY,GIDX,C0CDOCID
-"RTN","C0CNHIN",121,0)
+"RTN","C0CNHIN",119,0)
S GN=$NA(^GPL("NHIN"))
-"RTN","C0CNHIN",122,0)
+"RTN","C0CNHIN",120,0)
;S GN=$NA(^GPL("DOMI"))
-"RTN","C0CNHIN",123,0)
+"RTN","C0CNHIN",121,0)
S C0CDOCID=$$PARSE(GN,"GPLTEST")
-"RTN","C0CNHIN",124,0)
+"RTN","C0CNHIN",122,0)
D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"/results/")
-"RTN","C0CNHIN",125,0)
+"RTN","C0CNHIN",123,0)
K ^GPL("GNARY")
-"RTN","C0CNHIN",126,0)
+"RTN","C0CNHIN",124,0)
M ^GPL("GNARY")=GNARY
-"RTN","C0CNHIN",127,0)
+"RTN","C0CNHIN",125,0)
Q
+"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)
-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)
+"RTN","C0CNHIN",130,0)
S C0CDOCID=$$DOMI^C0CDOM(GN,,"results")
-"RTN","C0CNHIN",133,0)
+"RTN","C0CNHIN",131,0)
D OUTXML^C0CDOM("G",C0CDOCID)
-"RTN","C0CNHIN",134,0)
+"RTN","C0CNHIN",132,0)
K ^GPL("DOMI")
-"RTN","C0CNHIN",135,0)
+"RTN","C0CNHIN",133,0)
M ^GPL("DOMI")=G
+"RTN","C0CNHIN",134,0)
+ Q
+"RTN","C0CNHIN",135,0)
+ ;
"RTN","C0CNHIN",136,0)
- Q
-"RTN","C0CNHIN",137,0)
- ;
-"RTN","C0CNHIN",138,0)
TEST3 ; TEST NHINV OUTPUT IN ^GPL("NIHIN")
-"RTN","C0CNHIN",139,0)
+"RTN","C0CNHIN",137,0)
; PARSED WITH MXML
-"RTN","C0CNHIN",140,0)
+"RTN","C0CNHIN",138,0)
; RUN THROUGH XPATH
-"RTN","C0CNHIN",141,0)
+"RTN","C0CNHIN",139,0)
K GARY,GIDX,C0CDOCID
-"RTN","C0CNHIN",142,0)
+"RTN","C0CNHIN",140,0)
;S GN=$NA(^GPL("NHIN"))
-"RTN","C0CNHIN",143,0)
+"RTN","C0CNHIN",141,0)
S GN=$NA(^GPL("DOMI"))
-"RTN","C0CNHIN",144,0)
+"RTN","C0CNHIN",142,0)
S C0CDOCID=$$PARSE(GN,"GPLTEST")
-"RTN","C0CNHIN",145,0)
+"RTN","C0CNHIN",143,0)
D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"/results/")
-"RTN","C0CNHIN",146,0)
+"RTN","C0CNHIN",144,0)
Q
-"RTN","C0CNHIN",147,0)
+"RTN","C0CNHIN",145,0)
;
-"RTN","C0CNHIN",148,0)
+"RTN","C0CNHIN",146,0)
DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
-"RTN","C0CNHIN",149,0)
+"RTN","C0CNHIN",147,0)
; THE XPATH INDEX ZXIDX, PASSED BY NAME
-"RTN","C0CNHIN",150,0)
+"RTN","C0CNHIN",148,0)
; THE XPATH ARRAY XPARY, PASSED BY NAME
-"RTN","C0CNHIN",151,0)
+"RTN","C0CNHIN",149,0)
; ZOID IS THE STARTING OID
-"RTN","C0CNHIN",152,0)
+"RTN","C0CNHIN",150,0)
; ZPATH IS THE STARTING XPATH, USUALLY "/"
-"RTN","C0CNHIN",153,0)
+"RTN","C0CNHIN",151,0)
; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
-"RTN","C0CNHIN",154,0)
+"RTN","C0CNHIN",152,0)
; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
-"RTN","C0CNHIN",155,0)
+"RTN","C0CNHIN",153,0)
I $G(ZREDUX)="" S ZREDUX=""
-"RTN","C0CNHIN",156,0)
+"RTN","C0CNHIN",154,0)
N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY
-"RTN","C0CNHIN",157,0)
+"RTN","C0CNHIN",155,0)
N NEWNUM S NEWNUM=""
-"RTN","C0CNHIN",158,0)
+"RTN","C0CNHIN",156,0)
I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
-"RTN","C0CNHIN",159,0)
+"RTN","C0CNHIN",157,0)
S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
-"RTN","C0CNHIN",160,0)
+"RTN","C0CNHIN",158,0)
I $G(ZREDUX)'="" D ; REDUX PROVIDED?
-"RTN","C0CNHIN",161,0)
+"RTN","C0CNHIN",159,0)
. N GT S GT=$P(NEWPATH,ZREDUX,2)
-"RTN","C0CNHIN",162,0)
+"RTN","C0CNHIN",160,0)
. I GT'="" S NEWPATH=GT
-"RTN","C0CNHIN",163,0)
+"RTN","C0CNHIN",161,0)
S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
-"RTN","C0CNHIN",164,0)
+"RTN","C0CNHIN",162,0)
N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE
-"RTN","C0CNHIN",165,0)
+"RTN","C0CNHIN",163,0)
I $D(GA) D ; PROCESS THE ATTRIBUTES
-"RTN","C0CNHIN",166,0)
+"RTN","C0CNHIN",164,0)
. N ZI S ZI=""
-"RTN","C0CNHIN",167,0)
+"RTN","C0CNHIN",165,0)
. F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE
-"RTN","C0CNHIN",168,0)
+"RTN","C0CNHIN",166,0)
. . N ZP S ZP=NEWPATH_"/"_ZI ; PATH FOR ATTRIBUTE
-"RTN","C0CNHIN",169,0)
+"RTN","C0CNHIN",167,0)
. . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY
-"RTN","C0CNHIN",170,0)
+"RTN","C0CNHIN",168,0)
. . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE
-"RTN","C0CNHIN",171,0)
+"RTN","C0CNHIN",169,0)
N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
-"RTN","C0CNHIN",172,0)
+"RTN","C0CNHIN",170,0)
I $D(GD(2)) D ;
-"RTN","C0CNHIN",173,0)
+"RTN","C0CNHIN",171,0)
. M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
-"RTN","C0CNHIN",174,0)
+"RTN","C0CNHIN",172,0)
E I $D(GD(1)) D ;
-"RTN","C0CNHIN",175,0)
+"RTN","C0CNHIN",173,0)
. S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
-"RTN","C0CNHIN",176,0)
+"RTN","C0CNHIN",174,0)
. I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY
-"RTN","C0CNHIN",177,0)
+"RTN","C0CNHIN",175,0)
N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
-"RTN","C0CNHIN",178,0)
+"RTN","C0CNHIN",176,0)
I ZFRST'=0 D ; THERE IS A CHILD
-"RTN","C0CNHIN",179,0)
+"RTN","C0CNHIN",177,0)
. N ZNUM
-"RTN","C0CNHIN",180,0)
+"RTN","C0CNHIN",178,0)
. N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
-"RTN","C0CNHIN",181,0)
+"RTN","C0CNHIN",179,0)
. D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD
-"RTN","C0CNHIN",182,0)
+"RTN","C0CNHIN",180,0)
N GNXT S GNXT=$$NXTSIB(ZOID)
-"RTN","C0CNHIN",183,0)
+"RTN","C0CNHIN",181,0)
I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
-"RTN","C0CNHIN",184,0)
+"RTN","C0CNHIN",182,0)
I GNXT'=0 D ;
-"RTN","C0CNHIN",185,0)
+"RTN","C0CNHIN",183,0)
. N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
-"RTN","C0CNHIN",186,0)
+"RTN","C0CNHIN",184,0)
. I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES
-"RTN","C0CNHIN",187,0)
+"RTN","C0CNHIN",185,0)
. . N ZNUM S ZNUM=1 ;
-"RTN","C0CNHIN",188,0)
+"RTN","C0CNHIN",186,0)
. . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
-"RTN","C0CNHIN",189,0)
+"RTN","C0CNHIN",187,0)
. E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB
-"RTN","C0CNHIN",190,0)
+"RTN","C0CNHIN",188,0)
Q
+"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)
-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)
+"RTN","C0CNHIN",193,0)
S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY
-"RTN","C0CNHIN",196,0)
+"RTN","C0CNHIN",194,0)
I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE
-"RTN","C0CNHIN",197,0)
+"RTN","C0CNHIN",195,0)
S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY
-"RTN","C0CNHIN",198,0)
+"RTN","C0CNHIN",196,0)
S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .
-"RTN","C0CNHIN",199,0)
+"RTN","C0CNHIN",197,0)
I ZZI'["]" D ; A SINGLETON
-"RTN","C0CNHIN",200,0)
+"RTN","C0CNHIN",198,0)
. S ZZN=1
-"RTN","C0CNHIN",201,0)
+"RTN","C0CNHIN",199,0)
E D ; THERE IS AN [x] OCCURANCE
-"RTN","C0CNHIN",202,0)
+"RTN","C0CNHIN",200,0)
. S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE
-"RTN","C0CNHIN",203,0)
+"RTN","C0CNHIN",201,0)
. S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]
-"RTN","C0CNHIN",204,0)
+"RTN","C0CNHIN",202,0)
I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
+"RTN","C0CNHIN",203,0)
+ Q
+"RTN","C0CNHIN",204,0)
+ ;
"RTN","C0CNHIN",205,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)
+"RTN","C0CNHIN",206,0)
; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
-"RTN","C0CNHIN",209,0)
+"RTN","C0CNHIN",207,0)
; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
-"RTN","C0CNHIN",210,0)
+"RTN","C0CNHIN",208,0)
;Q $$EN^MXMLDOM(INXML)
-"RTN","C0CNHIN",211,0)
+"RTN","C0CNHIN",209,0)
Q $$EN^MXMLDOM(INXML,"W")
-"RTN","C0CNHIN",212,0)
+"RTN","C0CNHIN",210,0)
;
-"RTN","C0CNHIN",213,0)
+"RTN","C0CNHIN",211,0)
ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
-"RTN","C0CNHIN",214,0)
+"RTN","C0CNHIN",212,0)
N ZN
-"RTN","C0CNHIN",215,0)
+"RTN","C0CNHIN",213,0)
;I $$TAG(ZOID)["entry" B
-"RTN","C0CNHIN",216,0)
+"RTN","C0CNHIN",214,0)
S ZN=$$NXTSIB(ZOID)
-"RTN","C0CNHIN",217,0)
+"RTN","C0CNHIN",215,0)
I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
-"RTN","C0CNHIN",218,0)
+"RTN","C0CNHIN",216,0)
Q 0
-"RTN","C0CNHIN",219,0)
+"RTN","C0CNHIN",217,0)
;
-"RTN","C0CNHIN",220,0)
+"RTN","C0CNHIN",218,0)
FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
-"RTN","C0CNHIN",221,0)
+"RTN","C0CNHIN",219,0)
Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CNHIN",222,0)
+"RTN","C0CNHIN",220,0)
;
-"RTN","C0CNHIN",223,0)
+"RTN","C0CNHIN",221,0)
PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
-"RTN","C0CNHIN",224,0)
+"RTN","C0CNHIN",222,0)
Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CNHIN",225,0)
+"RTN","C0CNHIN",223,0)
;
-"RTN","C0CNHIN",226,0)
+"RTN","C0CNHIN",224,0)
ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
-"RTN","C0CNHIN",227,0)
+"RTN","C0CNHIN",225,0)
S HANDLE=C0CDOCID
-"RTN","C0CNHIN",228,0)
+"RTN","C0CNHIN",226,0)
K @RTN
-"RTN","C0CNHIN",229,0)
+"RTN","C0CNHIN",227,0)
D GETTXT^MXMLDOM("A")
+"RTN","C0CNHIN",228,0)
+ Q
+"RTN","C0CNHIN",229,0)
+ ;
"RTN","C0CNHIN",230,0)
- Q
-"RTN","C0CNHIN",231,0)
- ;
-"RTN","C0CNHIN",232,0)
TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
-"RTN","C0CNHIN",233,0)
+"RTN","C0CNHIN",231,0)
;I ZOID=149 B ;GPLTEST
-"RTN","C0CNHIN",234,0)
+"RTN","C0CNHIN",232,0)
N X,Y
-"RTN","C0CNHIN",235,0)
+"RTN","C0CNHIN",233,0)
S Y=""
-"RTN","C0CNHIN",236,0)
+"RTN","C0CNHIN",234,0)
S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
-"RTN","C0CNHIN",237,0)
+"RTN","C0CNHIN",235,0)
I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
-"RTN","C0CNHIN",238,0)
+"RTN","C0CNHIN",236,0)
I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CNHIN",239,0)
+"RTN","C0CNHIN",237,0)
Q Y
-"RTN","C0CNHIN",240,0)
+"RTN","C0CNHIN",238,0)
;
-"RTN","C0CNHIN",241,0)
+"RTN","C0CNHIN",239,0)
NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
-"RTN","C0CNHIN",242,0)
+"RTN","C0CNHIN",240,0)
Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
-"RTN","C0CNHIN",243,0)
+"RTN","C0CNHIN",241,0)
;
-"RTN","C0CNHIN",244,0)
+"RTN","C0CNHIN",242,0)
DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
-"RTN","C0CNHIN",245,0)
+"RTN","C0CNHIN",243,0)
;N ZT,ZN S ZT=""
-"RTN","C0CNHIN",246,0)
+"RTN","C0CNHIN",244,0)
;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
-"RTN","C0CNHIN",247,0)
+"RTN","C0CNHIN",245,0)
;Q $G(@C0CDOM@(ZOID,"T",1))
-"RTN","C0CNHIN",248,0)
+"RTN","C0CNHIN",246,0)
S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
-"RTN","C0CNHIN",249,0)
+"RTN","C0CNHIN",247,0)
Q
+"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)
-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)
+"RTN","C0CNHIN",252,0)
D START^C0CMXMLB($$TAG(1),,"G")
-"RTN","C0CNHIN",255,0)
+"RTN","C0CNHIN",253,0)
D NDOUT($$FIRST(1))
-"RTN","C0CNHIN",256,0)
+"RTN","C0CNHIN",254,0)
D END^C0CMXMLB ;END THE DOCUMENT
-"RTN","C0CNHIN",257,0)
+"RTN","C0CNHIN",255,0)
M @ZRTN=^TMP("MXMLBLD",$J)
-"RTN","C0CNHIN",258,0)
+"RTN","C0CNHIN",256,0)
K ^TMP("MXMLBLD",$J)
-"RTN","C0CNHIN",259,0)
+"RTN","C0CNHIN",257,0)
Q
-"RTN","C0CNHIN",260,0)
+"RTN","C0CNHIN",258,0)
;
-"RTN","C0CNHIN",261,0)
+"RTN","C0CNHIN",259,0)
NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
-"RTN","C0CNHIN",262,0)
+"RTN","C0CNHIN",260,0)
N ZI S ZI=$$FIRST(ZOID)
-"RTN","C0CNHIN",263,0)
+"RTN","C0CNHIN",261,0)
I ZI'=0 D ; THERE IS A CHILD
-"RTN","C0CNHIN",264,0)
+"RTN","C0CNHIN",262,0)
. N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
-"RTN","C0CNHIN",265,0)
+"RTN","C0CNHIN",263,0)
. D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN
-"RTN","C0CNHIN",266,0)
+"RTN","C0CNHIN",264,0)
E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
-"RTN","C0CNHIN",267,0)
+"RTN","C0CNHIN",265,0)
. ;W "DOING",ZOID,!
-"RTN","C0CNHIN",268,0)
+"RTN","C0CNHIN",266,0)
. N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
-"RTN","C0CNHIN",269,0)
+"RTN","C0CNHIN",267,0)
. N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
-"RTN","C0CNHIN",270,0)
+"RTN","C0CNHIN",268,0)
. D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
-"RTN","C0CNHIN",271,0)
+"RTN","C0CNHIN",269,0)
I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING
-"RTN","C0CNHIN",272,0)
+"RTN","C0CNHIN",270,0)
. D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
-"RTN","C0CNHIN",273,0)
+"RTN","C0CNHIN",271,0)
Q
+"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)
-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)
+"RTN","C0CNHIN",276,0)
D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML
-"RTN","C0CNHIN",279,0)
+"RTN","C0CNHIN",277,0)
S GN2=$NA(@GN@(1))
-"RTN","C0CNHIN",280,0)
+"RTN","C0CNHIN",278,0)
W $$OUTPUT^C0CXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")
-"RTN","C0CNHIN",281,0)
+"RTN","C0CNHIN",279,0)
Q
-"RTN","C0CNHIN",282,0)
+"RTN","C0CNHIN",280,0)
;
-"RTN","C0CNHIN",283,0)
+"RTN","C0CNHIN",281,0)
TESTNARY ; TEST MAKING A NHIN ARRAY
-"RTN","C0CNHIN",284,0)
+"RTN","C0CNHIN",282,0)
N ZI S ZI=""
-"RTN","C0CNHIN",285,0)
+"RTN","C0CNHIN",283,0)
N ZH ; DOM HANDLE
-"RTN","C0CNHIN",286,0)
+"RTN","C0CNHIN",284,0)
D TEST1 ; PARSE AN NHIN RESULT INTO THE DOM
-"RTN","C0CNHIN",287,0)
+"RTN","C0CNHIN",285,0)
S ZH=C0CDOCID ; SET THE HANDLE
-"RTN","C0CNHIN",288,0)
+"RTN","C0CNHIN",286,0)
N ZD S ZD=$NA(^TMP("MXMLDOM",$J,ZH))
-"RTN","C0CNHIN",289,0)
+"RTN","C0CNHIN",287,0)
F S ZI=$O(@ZD@(ZI)) Q:ZI="" D ; FOR EACH NODE
-"RTN","C0CNHIN",290,0)
+"RTN","C0CNHIN",288,0)
. N ZATT
-"RTN","C0CNHIN",291,0)
+"RTN","C0CNHIN",289,0)
. D MNARY(.ZATT,ZH,ZI)
-"RTN","C0CNHIN",292,0)
+"RTN","C0CNHIN",290,0)
. N ZPRE,ZN
-"RTN","C0CNHIN",293,0)
+"RTN","C0CNHIN",291,0)
. S ZPRE=$$PRE(ZI)
-"RTN","C0CNHIN",294,0)
+"RTN","C0CNHIN",292,0)
. S ZN=$P(ZPRE,",",2)
-"RTN","C0CNHIN",295,0)
+"RTN","C0CNHIN",293,0)
. S ZPRE=$P(ZPRE,",",1)
-"RTN","C0CNHIN",296,0)
+"RTN","C0CNHIN",294,0)
. ;I $D(ZATT) ZWR ZATT
-"RTN","C0CNHIN",297,0)
+"RTN","C0CNHIN",295,0)
. N ZJ S ZJ=""
-"RTN","C0CNHIN",298,0)
+"RTN","C0CNHIN",296,0)
. F S ZJ=$O(ZATT(ZJ)) Q:ZJ="" D ; FOR EACH ATTRIBUTE
-"RTN","C0CNHIN",299,0)
+"RTN","C0CNHIN",297,0)
. . W ZPRE_"["_ZN_"]"_$$TAG(ZI)_"."_ZJ_"="_ZATT(ZJ),!
-"RTN","C0CNHIN",300,0)
+"RTN","C0CNHIN",298,0)
. . S GOUT(ZPRE,ZN,$$TAG(ZI)_"."_ZJ)=ZATT(ZJ)
-"RTN","C0CNHIN",301,0)
+"RTN","C0CNHIN",299,0)
Q
+"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)
-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)
+"RTN","C0CNHIN",304,0)
S GI=$$PARENT(ZNODE) ; PARENT NODE
-"RTN","C0CNHIN",307,0)
+"RTN","C0CNHIN",305,0)
I GI=0 Q "" ; NO PARENT
-"RTN","C0CNHIN",308,0)
+"RTN","C0CNHIN",306,0)
S GPT=$$TAG(GI) ; TAG OF PARENT
-"RTN","C0CNHIN",309,0)
+"RTN","C0CNHIN",307,0)
S GI2=$$PARENT(GI) ; PARENT OF PARENT
-"RTN","C0CNHIN",310,0)
+"RTN","C0CNHIN",308,0)
I (GI2'=0)&($$TAG(GI2)'="results") S GPT=$$TAG(GI2)_"."_GPT
-"RTN","C0CNHIN",311,0)
+"RTN","C0CNHIN",309,0)
S GJ=$$FIRST(GI) ; NODE OF FIRST SIB
-"RTN","C0CNHIN",312,0)
+"RTN","C0CNHIN",310,0)
I GJ=ZNODE Q:$$TAG(GI)_",1"
-"RTN","C0CNHIN",313,0)
+"RTN","C0CNHIN",311,0)
F GN=2:1 Q:GJ=ZNODE D ;
-"RTN","C0CNHIN",314,0)
+"RTN","C0CNHIN",312,0)
. S GJ=$$NXTSIB(GJ) ; NEXT SIBLING
-"RTN","C0CNHIN",315,0)
+"RTN","C0CNHIN",313,0)
Q GPT_","_GN
-"RTN","C0CNHIN",316,0)
+"RTN","C0CNHIN",314,0)
;
-"RTN","C0CNHIN",317,0)
+"RTN","C0CNHIN",315,0)
MNARY(ZRTN,ZHANDLE,ZOID) ; MAKE A NHIN ARRAY FROM A DOM NODE
-"RTN","C0CNHIN",318,0)
+"RTN","C0CNHIN",316,0)
; RETURNED IN ZRTN, PASSED BY REFERENCE
-"RTN","C0CNHIN",319,0)
+"RTN","C0CNHIN",317,0)
; ZHANDLE IS THE DOM DOCUMENT ID
-"RTN","C0CNHIN",320,0)
+"RTN","C0CNHIN",318,0)
; ZOID IS THE DOM NODE
-"RTN","C0CNHIN",321,0)
+"RTN","C0CNHIN",319,0)
D ATT("ZRTN",ZOID)
-"RTN","C0CNHIN",322,0)
+"RTN","C0CNHIN",320,0)
Q
-"RTN","C0CNHIN",323,0)
+"RTN","C0CNHIN",321,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.
-"RTN","C0CNMED2",6,0)
- ;
-"RTN","C0CNMED2",7,0)
- ; This program is free software; you can redistribute it and/or modify
-"RTN","C0CNMED2",8,0)
- ; it under the terms of the GNU General Public License as published by
-"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.
-"RTN","C0CNMED2",11,0)
- ;
-"RTN","C0CNMED2",12,0)
- ; This program is distributed in the hope that it will be useful,
-"RTN","C0CNMED2",13,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","C0CNMED2",14,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-"RTN","C0CNMED2",15,0)
- ; GNU General Public License for more details.
-"RTN","C0CNMED2",16,0)
- ;
-"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.
-"RTN","C0CNMED2",20,0)
;
-"RTN","C0CNMED2",21,0)
+"RTN","C0CNMED2",5,0)
+ ; 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)
+ ; published by the Free Software Foundation, either version 3 of the
+"RTN","C0CNMED2",8,0)
+ ; License, or (at your option) any later version.
+"RTN","C0CNMED2",9,0)
+ ;
+"RTN","C0CNMED2",10,0)
+ ; 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)
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+"RTN","C0CNMED2",13,0)
+ ; GNU Affero General Public License for more details.
+"RTN","C0CNMED2",14,0)
+ ;
+"RTN","C0CNMED2",15,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CNMED2",16,0)
+ ; along with this program. If not, see .
+"RTN","C0CNMED2",17,0)
+ ;
+"RTN","C0CNMED2",18,0)
+ ;
+"RTN","C0CNMED2",19,0)
; --Revision History
-"RTN","C0CNMED2",22,0)
+"RTN","C0CNMED2",20,0)
; July 2008 - Initial Version/GPL
-"RTN","C0CNMED2",23,0)
+"RTN","C0CNMED2",21,0)
; July 2008 - March 2009 various revisions
-"RTN","C0CNMED2",24,0)
+"RTN","C0CNMED2",22,0)
; March 2009 - Reconstruction of routine as driver for other med routines/SMH
-"RTN","C0CNMED2",25,0)
+"RTN","C0CNMED2",23,0)
; June 2011 - Redone to support all meds using the FOIA NHIN routines/gpl
+"RTN","C0CNMED2",24,0)
+ ;
+"RTN","C0CNMED2",25,0)
+ Q
"RTN","C0CNMED2",26,0)
;
"RTN","C0CNMED2",27,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)
+"RTN","C0CNMED2",28,0)
; THE RIGHT ORDER... AND IT HAS TO BE IN THE RIGHT ORDER... :(
-"RTN","C0CNMED2",31,0)
+"RTN","C0CNMED2",29,0)
; GPL
-"RTN","C0CNMED2",32,0)
+"RTN","C0CNMED2",30,0)
;
-"RTN","C0CNMED2",33,0)
+"RTN","C0CNMED2",31,0)
EXTRACT(MEDXML,DFN,MEDOUTXML) ; Private; Extract medications into provided XML template
-"RTN","C0CNMED2",34,0)
+"RTN","C0CNMED2",32,0)
; DFN passed by reference
-"RTN","C0CNMED2",35,0)
+"RTN","C0CNMED2",33,0)
; MEDXML and MEDOUTXML are passed by Name
-"RTN","C0CNMED2",36,0)
+"RTN","C0CNMED2",34,0)
; MEDXML is the input template
-"RTN","C0CNMED2",37,0)
+"RTN","C0CNMED2",35,0)
; MEDOUTXML is the output template
-"RTN","C0CNMED2",38,0)
+"RTN","C0CNMED2",36,0)
; Both of them refer to ^TMP globals where the XML documents are stored
-"RTN","C0CNMED2",39,0)
+"RTN","C0CNMED2",37,0)
;
-"RTN","C0CNMED2",40,0)
+"RTN","C0CNMED2",38,0)
N GN
-"RTN","C0CNMED2",41,0)
+"RTN","C0CNMED2",39,0)
D EN^C0CNHIN(.GN,DFN,"MED;",1) ; RETRIEVE NHIN ARRAY OF MEDS
-"RTN","C0CNMED2",42,0)
+"RTN","C0CNMED2",40,0)
; this call uses GET^NHINV to retrieve xml of the meds and then
-"RTN","C0CNMED2",43,0)
+"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)
- ; 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)
+"RTN","C0CNMED2",46,0)
F S ZI=$O(GN("med",ZI)) Q:ZI="" D ; for each med
-"RTN","C0CNMED2",49,0)
+"RTN","C0CNMED2",47,0)
. N GA S GA=$NA(GN("med",ZI))
-"RTN","C0CNMED2",50,0)
+"RTN","C0CNMED2",48,0)
. N GM S GM="Medication" ; to keep the lines shorter
-"RTN","C0CNMED2",51,0)
+"RTN","C0CNMED2",49,0)
. S GC(GM,ZI,"CCRDataObjectID")="MED_"_ZI
-"RTN","C0CNMED2",52,0)
+"RTN","C0CNMED2",50,0)
. N ZD,ZD2 S ZD=$G(@GA@("ordered@value")) ; FILEMAN DATE
-"RTN","C0CNMED2",53,0)
+"RTN","C0CNMED2",51,0)
. I ZD="" S ZD=$G(@GA@("start@value")) ; for inpatient meds
-"RTN","C0CNMED2",54,0)
+"RTN","C0CNMED2",52,0)
. S ZD2=$$FMDTOUTC^C0CUTIL(ZD,"DT")
-"RTN","C0CNMED2",55,0)
+"RTN","C0CNMED2",53,0)
. S GC(GM,ZI,"DateTime[1].ExactDateTime")=ZD2
-"RTN","C0CNMED2",56,0)
+"RTN","C0CNMED2",54,0)
. S GC(GM,ZI,"DateTime[1].Type.Text")="Documented Date"
-"RTN","C0CNMED2",57,0)
+"RTN","C0CNMED2",55,0)
. ;S GC(GM,ZI,"DateTime[2].ExactDateTime")=""
-"RTN","C0CNMED2",58,0)
+"RTN","C0CNMED2",56,0)
. ;S GC(GM,ZI,"DateTime[2].Type.Text")=""
-"RTN","C0CNMED2",59,0)
+"RTN","C0CNMED2",57,0)
. N GSIG S GSIG=$G(@GA@("sig"))
-"RTN","C0CNMED2",60,0)
+"RTN","C0CNMED2",58,0)
. I GSIG["|" S GSIG=$P(GSIG,"|",2) ; eRx has name of drug separated by |
-"RTN","C0CNMED2",61,0)
+"RTN","C0CNMED2",59,0)
. S GC(GM,ZI,"Description.Text")=GSIG
-"RTN","C0CNMED2",62,0)
+"RTN","C0CNMED2",60,0)
. N GD S GD="Directions.Direction" ; MAKING THE STRINGS SHORTER
-"RTN","C0CNMED2",63,0)
+"RTN","C0CNMED2",61,0)
. ;S GC(GM,ZI,GD_".DeliveryMethod.Text")="@@MEDDELIVERYMETHOD@@"
-"RTN","C0CNMED2",64,0)
+"RTN","C0CNMED2",62,0)
. ;S GC(GM,ZI,GD_".Description.Text")=""
-"RTN","C0CNMED2",65,0)
+"RTN","C0CNMED2",63,0)
. ;S GC(GM,ZI,GD_".DirectionSequenceModifier")="@@MEDDIRSEQ@@"
-"RTN","C0CNMED2",66,0)
+"RTN","C0CNMED2",64,0)
. ;S GC(GM,ZI,GD_".Dose.Rate.Units.Unit")="@@MEDRATEUNIT@@"
-"RTN","C0CNMED2",67,0)
+"RTN","C0CNMED2",65,0)
. ;S GC(GM,ZI,GD_".Dose.Rate.Value")="@@MEDRATEVALUE@@"
-"RTN","C0CNMED2",68,0)
+"RTN","C0CNMED2",66,0)
. ;S GC(GM,ZI,GD_".Dose.Units.Unit")="@@MEDDOSEUNIT@@"
-"RTN","C0CNMED2",69,0)
+"RTN","C0CNMED2",67,0)
. ;S GC(GM,ZI,GD_".Dose.Value")="@@MEDDOSEVALUE@@"
-"RTN","C0CNMED2",70,0)
+"RTN","C0CNMED2",68,0)
. ;S GC(GM,ZI,GD_".DoseIndicator.Text")="@@MEDDOSEINDICATOR@@"
-"RTN","C0CNMED2",71,0)
+"RTN","C0CNMED2",69,0)
. ;S GC(GM,ZI,GD_".Duration.Units.Unit")="@@MEDDURATIONUNIT@@"
-"RTN","C0CNMED2",72,0)
+"RTN","C0CNMED2",70,0)
. ;S GC(GM,ZI,GD_".Duration.Value")="@@MEDDURATIONVALUE@@"
-"RTN","C0CNMED2",73,0)
+"RTN","C0CNMED2",71,0)
. ;S GC(GM,ZI,GD_".Frequency.Value")="@@MEDFREQUENCYVALUE@@"
-"RTN","C0CNMED2",74,0)
+"RTN","C0CNMED2",72,0)
. ;S GC(GM,ZI,GD_".Indication.PRNFlag.Text")="@@MEDPRNFLAG@@"
-"RTN","C0CNMED2",75,0)
+"RTN","C0CNMED2",73,0)
. ;S GC(GM,ZI,GD_".Indication.Problem.CCRDataObjectID")=""
-"RTN","C0CNMED2",76,0)
+"RTN","C0CNMED2",74,0)
. ;S GC(GM,ZI,GD_".Indication.Problem.Description.Code.CodingSystem")=""
-"RTN","C0CNMED2",77,0)
+"RTN","C0CNMED2",75,0)
. ;S GC(GM,ZI,GD_".Indication.Problem.Description.Code.Value")=""
-"RTN","C0CNMED2",78,0)
+"RTN","C0CNMED2",76,0)
. ;S GC(GM,ZI,GD_".Indication.Problem.Description.Code.Version")=""
-"RTN","C0CNMED2",79,0)
+"RTN","C0CNMED2",77,0)
. ;S GC(GM,ZI,GD_".Indication.Problem.Description.Text")=""
-"RTN","C0CNMED2",80,0)
+"RTN","C0CNMED2",78,0)
. ;S GC(GM,ZI,GD_".Indication.Problem.Source.Actor.ActorID")=""
-"RTN","C0CNMED2",81,0)
+"RTN","C0CNMED2",79,0)
. ;S GC(GM,ZI,GD_".Indication.Problem.Type.Text")=""
-"RTN","C0CNMED2",82,0)
+"RTN","C0CNMED2",80,0)
. ;S GC(GM,ZI,GD_".Interval.Units.Unit")="@@MEDINTERVALUNIT@@"
-"RTN","C0CNMED2",83,0)
+"RTN","C0CNMED2",81,0)
. ;S GC(GM,ZI,GD_".Interval.Value")="@@MEDINTERVALVALUE@@"
-"RTN","C0CNMED2",84,0)
+"RTN","C0CNMED2",82,0)
. ;S GC(GM,ZI,GD_".MultipleDirectionModifier.Text")="@@MEDMULDIRMOD@@"
-"RTN","C0CNMED2",85,0)
+"RTN","C0CNMED2",83,0)
. S GC(GM,ZI,GD_".Route.Text")=$G(@GA@("doses.dose@route"))
-"RTN","C0CNMED2",86,0)
+"RTN","C0CNMED2",84,0)
. ;S GC(GM,ZI,GD_".StopIndicator.Text")="@@MEDSTOPINDICATOR@@"
-"RTN","C0CNMED2",87,0)
+"RTN","C0CNMED2",85,0)
. ;S GC(GM,ZI,GD_".Vehicle.Text")="@@MEDVEHICLETEXT@@"
-"RTN","C0CNMED2",88,0)
+"RTN","C0CNMED2",86,0)
. ;S GC(GM,ZI,"FullfillmentInstructions.Text")=""
-"RTN","C0CNMED2",89,0)
+"RTN","C0CNMED2",87,0)
. ;S GC(GM,ZI,"IDs.ID")="@@MEDRXNO@@"
-"RTN","C0CNMED2",90,0)
+"RTN","C0CNMED2",88,0)
. ;S GC(GM,ZI,"IDs.Type.Text")="@@MEDRXNOTXT@@"
-"RTN","C0CNMED2",91,0)
+"RTN","C0CNMED2",89,0)
. ;S GC(GM,ZI,"PatientInstructions.Instruction.Text")="@@MEDPTINSTRUCTIONS@@"
-"RTN","C0CNMED2",92,0)
+"RTN","C0CNMED2",90,0)
. ;S GC(GM,ZI,"Product.BrandName.Text")="@@MEDBRANDNAMETEXT@@"
-"RTN","C0CNMED2",93,0)
+"RTN","C0CNMED2",91,0)
. S GC(GM,ZI,"Product.Concentration.Units.Unit")=$G(@GA@("doses.dose@units"))
-"RTN","C0CNMED2",94,0)
+"RTN","C0CNMED2",92,0)
. S GC(GM,ZI,"Product.Concentration.Value")=$G(@GA@("doses.dose@dose"))
-"RTN","C0CNMED2",95,0)
+"RTN","C0CNMED2",93,0)
. S GC(GM,ZI,"Product.Form.Text")=$G(@GA@("form@value"))
-"RTN","C0CNMED2",96,0)
+"RTN","C0CNMED2",94,0)
. N GV S GV=$G(@GA@("products.product.vaProduct@vuid"))
-"RTN","C0CNMED2",97,0)
+"RTN","C0CNMED2",95,0)
. N GR S GR=$$RXNCUI3^C0PLKUP(GV)
-"RTN","C0CNMED2",98,0)
+"RTN","C0CNMED2",96,0)
. S GC(GM,ZI,"Product.ProductName.Code.CodingSystem")=$S(GR:"RxNorm",1:"VUID")
-"RTN","C0CNMED2",99,0)
+"RTN","C0CNMED2",97,0)
. S GC(GM,ZI,"Product.ProductName.Code.Value")=$S(GR:GR,1:GV)
-"RTN","C0CNMED2",100,0)
+"RTN","C0CNMED2",98,0)
. S GC(GM,ZI,"Product.ProductName.Code.Version")="08AB_081201F"
-"RTN","C0CNMED2",101,0)
+"RTN","C0CNMED2",99,0)
. S GC(GM,ZI,"Product.ProductName.Text")=$G(@GA@("name@value"))
-"RTN","C0CNMED2",102,0)
+"RTN","C0CNMED2",100,0)
. S GC(GM,ZI,"Product.Strength.Units.Unit")=$G(@GA@("doses.dose@units"))
-"RTN","C0CNMED2",103,0)
+"RTN","C0CNMED2",101,0)
. S GC(GM,ZI,"Product.Strength.Value")=$G(@GA@("doses.dose@dose"))
-"RTN","C0CNMED2",104,0)
+"RTN","C0CNMED2",102,0)
. ;S GC(GM,ZI,"Quantity.Units.Unit")="@@MEDQUANTITYUNIT@@"
-"RTN","C0CNMED2",105,0)
+"RTN","C0CNMED2",103,0)
. ;S GC(GM,ZI,"Quantity.Value")="@@MEDQUANTITYVALUE@@"
-"RTN","C0CNMED2",106,0)
+"RTN","C0CNMED2",104,0)
. ;S GC(GM,ZI,"Refills.Refill.Number")="@@MEDRFNO@@"
-"RTN","C0CNMED2",107,0)
+"RTN","C0CNMED2",105,0)
. N GDUZ S GDUZ=$G(@GA@("orderingProvider@code")) ;PROVIDER DUZ
-"RTN","C0CNMED2",108,0)
+"RTN","C0CNMED2",106,0)
. S GC(GM,ZI,"Source.Actor.ActorID")="PROVIDER_"_GDUZ
-"RTN","C0CNMED2",109,0)
+"RTN","C0CNMED2",107,0)
. S GC(GM,ZI,"Status.Text")=$G(@GA@("status@value"))
-"RTN","C0CNMED2",110,0)
+"RTN","C0CNMED2",108,0)
. S GC(GM,ZI,"Type.Text")="Medication"
-"RTN","C0CNMED2",111,0)
+"RTN","C0CNMED2",109,0)
N C0CDOCID
-"RTN","C0CNMED2",112,0)
+"RTN","C0CNMED2",110,0)
S C0CDOCID=$$DOMI^C0CDOM("GC",,"Medications") ; insert to dom
-"RTN","C0CNMED2",113,0)
+"RTN","C0CNMED2",111,0)
D OUTXML^C0CDOM(MEDOUTXML,C0CDOCID,1) ; render the xml
-"RTN","C0CNMED2",114,0)
+"RTN","C0CNMED2",112,0)
N ZSIZE S ZSIZE=$O(@MEDOUTXML@(""),-1)
-"RTN","C0CNMED2",115,0)
+"RTN","C0CNMED2",113,0)
S @MEDOUTXML@(0)=ZSIZE ; RETURN STATUS IS NUMBER OF LINES OF XML
-"RTN","C0CNMED2",116,0)
+"RTN","C0CNMED2",114,0)
W !,MEDOUTXML
-"RTN","C0CNMED2",117,0)
+"RTN","C0CNMED2",115,0)
;ZWR GN
-"RTN","C0CNMED2",118,0)
+"RTN","C0CNMED2",116,0)
;ZWR GC
-"RTN","C0CNMED2",119,0)
+"RTN","C0CNMED2",117,0)
;B
-"RTN","C0CNMED2",120,0)
+"RTN","C0CNMED2",118,0)
Q
-"RTN","C0CNMED2",121,0)
+"RTN","C0CNMED2",119,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)
- ;
-"RTN","C0CNMED4",11,0)
; This program is distributed in the hope that it will be useful,
-"RTN","C0CNMED4",12,0)
+"RTN","C0CNMED4",11,0)
; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","C0CNMED4",13,0)
+"RTN","C0CNMED4",12,0)
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+"RTN","C0CNMED4",13,0)
+ ; 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 .
"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.
-"RTN","C0CNMED4",19,0)
;
-"RTN","C0CNMED4",20,0)
+"RTN","C0CNMED4",18,0)
W "NO ENTRY FROM TOP",!
-"RTN","C0CNMED4",21,0)
+"RTN","C0CNMED4",19,0)
Q
+"RTN","C0CNMED4",20,0)
+ ;
+"RTN","C0CNMED4",21,0)
+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
-"RTN","C0CNMED4",26,0)
- ;
-"RTN","C0CNMED4",27,0)
; MINXML is the Input XML Template, passed by name
-"RTN","C0CNMED4",28,0)
+"RTN","C0CNMED4",26,0)
; DFN is Patient IEN
-"RTN","C0CNMED4",29,0)
+"RTN","C0CNMED4",27,0)
; OUTXML is the resultant XML.
-"RTN","C0CNMED4",30,0)
+"RTN","C0CNMED4",28,0)
;
-"RTN","C0CNMED4",31,0)
+"RTN","C0CNMED4",29,0)
; MEDS is return array from API.
-"RTN","C0CNMED4",32,0)
+"RTN","C0CNMED4",30,0)
; MED is holds each array element from MEDS, one medicine
-"RTN","C0CNMED4",33,0)
+"RTN","C0CNMED4",31,0)
; MAP is a mapping variable map (store result) for each med
-"RTN","C0CNMED4",34,0)
+"RTN","C0CNMED4",32,0)
;
-"RTN","C0CNMED4",35,0)
+"RTN","C0CNMED4",33,0)
; Inpatient Meds will be extracted using this routine and and the one following.
-"RTN","C0CNMED4",36,0)
+"RTN","C0CNMED4",34,0)
; Inpatient Meds Unit Dose is going to be C0CMED4
-"RTN","C0CNMED4",37,0)
+"RTN","C0CNMED4",35,0)
; Inpatient Meds IVs is going to be C0CMED5
-"RTN","C0CNMED4",38,0)
+"RTN","C0CNMED4",36,0)
;
-"RTN","C0CNMED4",39,0)
+"RTN","C0CNMED4",37,0)
; We will use two Pharmacy ReEnginnering API's:
-"RTN","C0CNMED4",40,0)
+"RTN","C0CNMED4",38,0)
; PSS431^PSS55(DFN,PO,PSDATE,PEDATE,LIST) - provides most info
-"RTN","C0CNMED4",41,0)
+"RTN","C0CNMED4",39,0)
; PSS432^PSS55(DFN,PO,LIST) - provides schedule info
-"RTN","C0CNMED4",42,0)
+"RTN","C0CNMED4",40,0)
; For more information, see the PRE documentation at:
-"RTN","C0CNMED4",43,0)
+"RTN","C0CNMED4",41,0)
; http://www.va.gov/vdl/documents/Clinical/Pharm-Inpatient_Med/phar_1_api_r0807.pdf
-"RTN","C0CNMED4",44,0)
+"RTN","C0CNMED4",42,0)
;
-"RTN","C0CNMED4",45,0)
+"RTN","C0CNMED4",43,0)
; Med data is stored in Unit Dose multiple of file 55, pharmacy patient
-"RTN","C0CNMED4",46,0)
+"RTN","C0CNMED4",44,0)
;
-"RTN","C0CNMED4",47,0)
+"RTN","C0CNMED4",45,0)
N MEDS,MAP
-"RTN","C0CNMED4",48,0)
+"RTN","C0CNMED4",46,0)
;K ^TMP($J)
-"RTN","C0CNMED4",49,0)
+"RTN","C0CNMED4",47,0)
;D PSS431^PSS55(DFN,,,,"UD") ; Output is in ^TMP($J,"UD",*)
-"RTN","C0CNMED4",50,0)
+"RTN","C0CNMED4",48,0)
;I ^TMP($J,"UD",0)'>0 S @OUTXML@(0)=0 QUIT ; No Meds - Quit
-"RTN","C0CNMED4",51,0)
+"RTN","C0CNMED4",49,0)
;; Otherwise, we go on...
-"RTN","C0CNMED4",52,0)
+"RTN","C0CNMED4",50,0)
D EN^C0CNHIN(.MEDS,DFN,"MED;") ; gpl get the NHIN Array of meds
-"RTN","C0CNMED4",53,0)
+"RTN","C0CNMED4",51,0)
I '$D(MEDS) Q ; no meds
-"RTN","C0CNMED4",54,0)
+"RTN","C0CNMED4",52,0)
N ZI S ZI=""
-"RTN","C0CNMED4",55,0)
+"RTN","C0CNMED4",53,0)
N ZCOUNT S ZCOUNT=0
-"RTN","C0CNMED4",56,0)
+"RTN","C0CNMED4",54,0)
F S ZI=$O(MEDS("med",ZI)) Q:ZI="" D ; for each returned med
-"RTN","C0CNMED4",57,0)
+"RTN","C0CNMED4",55,0)
. I $G(MEDS("med",ZI,"vaType@value"))="I" S ZCOUNT=ZCOUNT+1
-"RTN","C0CNMED4",58,0)
+"RTN","C0CNMED4",56,0)
IF ZCOUNT=0 Q ; no inpatient meds
-"RTN","C0CNMED4",59,0)
+"RTN","C0CNMED4",57,0)
;M MEDS=^TMP($J,"UD")
+"RTN","C0CNMED4",58,0)
+ ;I DEBUG ZWR MEDS
+"RTN","C0CNMED4",59,0)
+ S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
"RTN","C0CNMED4",60,0)
- I DEBUG ZWR MEDS
-"RTN","C0CNMED4",61,0)
- S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
-"RTN","C0CNMED4",62,0)
;N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
-"RTN","C0CNMED4",63,0)
+"RTN","C0CNMED4",61,0)
S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING") ;SETTING FLAG
-"RTN","C0CNMED4",64,0)
- N I S I=0
-"RTN","C0CNMED4",65,0)
+"RTN","C0CNMED4",62,0)
+ N I S I=0
+"RTN","C0CNMED4",63,0)
F S I=$O(MEDS("med",I)) Q:'I D ; For each medication
-"RTN","C0CNMED4",66,0)
+"RTN","C0CNMED4",64,0)
. ;OHUM/RUT 3120507 ;STATUS VALIDATION FOR INPATIENT
+"RTN","C0CNMED4",65,0)
+ . I ($P(C0CMFLAG,"^",1)'=1) D
+"RTN","C0CNMED4",66,0)
+ . . 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
-"RTN","C0CNMED4",72,0)
- . ;OHUM/RUT
-"RTN","C0CNMED4",73,0)
. N MED M MED=MEDS("med",I)
-"RTN","C0CNMED4",74,0)
+"RTN","C0CNMED4",72,0)
. I $G(MED("vaType@value"))'="I" Q ; not inpatient
-"RTN","C0CNMED4",75,0)
+"RTN","C0CNMED4",73,0)
. S MEDCOUNT=MEDCOUNT+1
-"RTN","C0CNMED4",76,0)
+"RTN","C0CNMED4",74,0)
. S @MEDMAP@(0)=MEDCOUNT ; Update MedMap array counter
-"RTN","C0CNMED4",77,0)
+"RTN","C0CNMED4",75,0)
. S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
-"RTN","C0CNMED4",78,0)
+"RTN","C0CNMED4",76,0)
. ;N RXIEN S RXIEN=MED(.01) ; Order Number
-"RTN","C0CNMED4",79,0)
+"RTN","C0CNMED4",77,0)
. N RXIEN S RXIEN=$G(MED("orderID@value")) ; ien of the med
-"RTN","C0CNMED4",80,0)
+"RTN","C0CNMED4",78,0)
. I DEBUG W "RXIEN IS ",RXIEN,!
-"RTN","C0CNMED4",81,0)
+"RTN","C0CNMED4",79,0)
. I DEBUG W "MAP= ",MAP,!
-"RTN","C0CNMED4",82,0)
- . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN
-"RTN","C0CNMED4",83,0)
+"RTN","C0CNMED4",80,0)
+ . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN
+"RTN","C0CNMED4",81,0)
. S @MAP@("MEDISSUEDATETXT")="Order Date"
-"RTN","C0CNMED4",84,0)
+"RTN","C0CNMED4",82,0)
. ;S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT")
-"RTN","C0CNMED4",85,0)
+"RTN","C0CNMED4",83,0)
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($G(MED("start@value")),"DT")
-"RTN","C0CNMED4",86,0)
+"RTN","C0CNMED4",84,0)
. S @MAP@("MEDLASTFILLDATETXT")="" ; For Outpatient
-"RTN","C0CNMED4",87,0)
+"RTN","C0CNMED4",85,0)
. S @MAP@("MEDLASTFILLDATE")="" ; For Outpatient
-"RTN","C0CNMED4",88,0)
+"RTN","C0CNMED4",86,0)
. S @MAP@("MEDRXNOTXT")="" ; For Outpatient
-"RTN","C0CNMED4",89,0)
+"RTN","C0CNMED4",87,0)
. S @MAP@("MEDRXNO")="" ; For Outpatient
-"RTN","C0CNMED4",90,0)
+"RTN","C0CNMED4",88,0)
. S @MAP@("MEDTYPETEXT")="Medication"
-"RTN","C0CNMED4",91,0)
+"RTN","C0CNMED4",89,0)
. S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses
-"RTN","C0CNMED4",92,0)
+"RTN","C0CNMED4",90,0)
. ;S @MAP@("MEDSTATUSTEXT")="ACTIVE"
-"RTN","C0CNMED4",93,0)
+"RTN","C0CNMED4",91,0)
. N C0CMST S C0CMST=$G(MED("vaStatus@value")) ; need to filter status
-"RTN","C0CNMED4",94,0)
+"RTN","C0CNMED4",92,0)
. I C0CMST="EXPIRED" S C0CMST="Prior History No Longer Active"
-"RTN","C0CNMED4",95,0)
+"RTN","C0CNMED4",93,0)
. I C0CMST="ACTIVE" S C0CMST="Active" ;
-"RTN","C0CNMED4",96,0)
+"RTN","C0CNMED4",94,0)
. S @MAP@("MEDSTATUSTEXT")=C0CMST
-"RTN","C0CNMED4",97,0)
+"RTN","C0CNMED4",95,0)
. ;S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U)
-"RTN","C0CNMED4",98,0)
+"RTN","C0CNMED4",96,0)
. S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$G(MED("orderingProvider@code"))
-"RTN","C0CNMED4",99,0)
+"RTN","C0CNMED4",97,0)
. ;S @MAP@("MEDPRODUCTNAMETEXT")=MED("DDRUG",1,.01)
-"RTN","C0CNMED4",100,0)
+"RTN","C0CNMED4",98,0)
. S @MAP@("MEDPRODUCTNAMETEXT")=$G(MED("name@value"))
-"RTN","C0CNMED4",101,0)
+"RTN","C0CNMED4",99,0)
. ; NDC is field 31 in the drug file.
-"RTN","C0CNMED4",102,0)
+"RTN","C0CNMED4",100,0)
. ; The actual drug entry in the drug file is not necessarily supplied.
-"RTN","C0CNMED4",103,0)
+"RTN","C0CNMED4",101,0)
. ; It' node 1, internal form.
-"RTN","C0CNMED4",104,0)
+"RTN","C0CNMED4",102,0)
. ;N MEDIEN S MEDIEN=MED(1,"I")
-"RTN","C0CNMED4",105,0)
+"RTN","C0CNMED4",103,0)
. ;S @MAP@("MEDPRODUCTNAMECODEVALUE")=$S($L(MEDIEN):$$GET1^DIQ(50,MEDIEN,31,"E"),1:"")
-"RTN","C0CNMED4",106,0)
+"RTN","C0CNMED4",104,0)
. N ZVUID S ZVUID=$G(MED("products.product.vaProduct@vuid")) ; VUID
-"RTN","C0CNMED4",107,0)
+"RTN","C0CNMED4",105,0)
. N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION
-"RTN","C0CNMED4",108,0)
+"RTN","C0CNMED4",106,0)
. D ;
-"RTN","C0CNMED4",109,0)
+"RTN","C0CNMED4",107,0)
. . S ZC=$$CODE^C0CUTIL(ZVUID)
-"RTN","C0CNMED4",110,0)
+"RTN","C0CNMED4",108,0)
. . S ZCD=$P(ZC,"^",1) ; CODE TO USE
-"RTN","C0CNMED4",111,0)
+"RTN","C0CNMED4",109,0)
. . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID
-"RTN","C0CNMED4",112,0)
+"RTN","C0CNMED4",110,0)
. . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION
-"RTN","C0CNMED4",113,0)
+"RTN","C0CNMED4",111,0)
. ;N ZRXNORM S ZRXNORM=""
-"RTN","C0CNMED4",114,0)
+"RTN","C0CNMED4",112,0)
. ;S ZRXNORM=$$RXNCUI3^C0PLKUP(ZVUID)
-"RTN","C0CNMED4",115,0)
+"RTN","C0CNMED4",113,0)
. S @MAP@("MEDPRODUCTNAMECODEVALUE")=ZCD
-"RTN","C0CNMED4",116,0)
+"RTN","C0CNMED4",114,0)
. ;S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=$S($L(MEDIEN):"NDC",1:"")
-"RTN","C0CNMED4",117,0)
+"RTN","C0CNMED4",115,0)
. S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=ZCDS
-"RTN","C0CNMED4",118,0)
+"RTN","C0CNMED4",116,0)
. ;S @MAP@("MEDPRODUCTNAMECODEVERSION")=$S($L(MEDIEN):"none",1:"")
-"RTN","C0CNMED4",119,0)
+"RTN","C0CNMED4",117,0)
. S @MAP@("MEDPRODUCTNAMECODEVERSION")=ZCDSV
-"RTN","C0CNMED4",120,0)
+"RTN","C0CNMED4",118,0)
. S @MAP@("MEDBRANDNAMETEXT")=""
-"RTN","C0CNMED4",121,0)
+"RTN","C0CNMED4",119,0)
. S @MAP@("MEDPRODUCTNAMETEXT")=$G(MED("name@value"))_" "_ZCDS_": "_ZCD
-"RTN","C0CNMED4",122,0)
+"RTN","C0CNMED4",120,0)
. ;I $L(MEDIEN) D DOSE^PSS50(MEDIEN,,,,,"DOSE")
-"RTN","C0CNMED4",123,0)
+"RTN","C0CNMED4",121,0)
. ;I $L(MEDIEN) N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
-"RTN","C0CNMED4",124,0)
+"RTN","C0CNMED4",122,0)
. ;S @MAP@("MEDSTRENGTHVALUE")=$S($L(MEDIEN):DOSEDATA(901),1:"")
-"RTN","C0CNMED4",125,0)
+"RTN","C0CNMED4",123,0)
. S @MAP@("MEDSTRENGTHVALUE")=$G(MED("doses.dose@dose"))
-"RTN","C0CNMED4",126,0)
+"RTN","C0CNMED4",124,0)
. ;S @MAP@("MEDSTRENGTHUNIT")=$S($P(DOSEDATA(902),U,2),1:"")
-"RTN","C0CNMED4",127,0)
+"RTN","C0CNMED4",125,0)
. S @MAP@("MEDSTRENGTHUNIT")=$G(MED("doses.dose@units"))
-"RTN","C0CNMED4",128,0)
+"RTN","C0CNMED4",126,0)
. ; Units, concentration, etc, come from another call
-"RTN","C0CNMED4",129,0)
+"RTN","C0CNMED4",127,0)
. ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
-"RTN","C0CNMED4",130,0)
+"RTN","C0CNMED4",128,0)
. ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
-"RTN","C0CNMED4",131,0)
+"RTN","C0CNMED4",129,0)
. ; NDF Entry IEN, and VA Product Name
-"RTN","C0CNMED4",132,0)
+"RTN","C0CNMED4",130,0)
. ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
-"RTN","C0CNMED4",133,0)
+"RTN","C0CNMED4",131,0)
. ; Documented in the same manual.
-"RTN","C0CNMED4",134,0)
+"RTN","C0CNMED4",132,0)
. ;N NDFDATA,CONCDATA
-"RTN","C0CNMED4",135,0)
+"RTN","C0CNMED4",133,0)
. ;I $L(MEDIEN) D
-"RTN","C0CNMED4",136,0)
+"RTN","C0CNMED4",134,0)
. ;. D NDF^PSS50(MEDIEN,,,,,"CONC")
-"RTN","C0CNMED4",137,0)
+"RTN","C0CNMED4",135,0)
. ;. M NDFDATA=^TMP($J,"CONC",MEDIEN)
-"RTN","C0CNMED4",138,0)
+"RTN","C0CNMED4",136,0)
. ;. N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
-"RTN","C0CNMED4",139,0)
+"RTN","C0CNMED4",137,0)
. ;. N VAPROD S VAPROD=$P(NDFDATA(22),U)
-"RTN","C0CNMED4",140,0)
+"RTN","C0CNMED4",138,0)
. ;. ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
-"RTN","C0CNMED4",141,0)
+"RTN","C0CNMED4",139,0)
. ;. ; and this will crash the call. So...
-"RTN","C0CNMED4",142,0)
+"RTN","C0CNMED4",140,0)
. ;. I NDFIEN="" S CONCDATA=""
-"RTN","C0CNMED4",143,0)
+"RTN","C0CNMED4",141,0)
. ;. E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
-"RTN","C0CNMED4",144,0)
+"RTN","C0CNMED4",142,0)
. ;E S (NDFDATA,CONCDATA)="" ; This line is defensive programming to prevent undef errors.
-"RTN","C0CNMED4",145,0)
+"RTN","C0CNMED4",143,0)
. ;S @MAP@("MEDFORMTEXT")=$S($L(MEDIEN):$P(CONCDATA,U,1),1:"")
-"RTN","C0CNMED4",146,0)
+"RTN","C0CNMED4",144,0)
. S @MAP@("MEDFORMTEXT")=$G(MED("form@value"))
-"RTN","C0CNMED4",147,0)
+"RTN","C0CNMED4",145,0)
. ;S @MAP@("MEDCONCVALUE")=$S($L(MEDIEN):$P(CONCDATA,U,3),1:"")
-"RTN","C0CNMED4",148,0)
+"RTN","C0CNMED4",146,0)
. S @MAP@("MEDCONCVALUE")=$G(MED("doses.dose@dose"))
-"RTN","C0CNMED4",149,0)
+"RTN","C0CNMED4",147,0)
. ;S @MAP@("MEDCONCUNIT")=$S($L(MEDIEN):$P(CONCDATA,U,4),1:"")
-"RTN","C0CNMED4",150,0)
+"RTN","C0CNMED4",148,0)
. S @MAP@("MEDCONCUNIT")=$G(MED("doses.does@units"))
-"RTN","C0CNMED4",151,0)
+"RTN","C0CNMED4",149,0)
. ;S @MAP@("MEDQUANTITYVALUE")="" ; not provided for in Non-VA meds.
-"RTN","C0CNMED4",152,0)
+"RTN","C0CNMED4",150,0)
. S @MAP@("MEDQUANTITYVALUE")=$G(MED("doses.dose@unitsPerDose")) ;
-"RTN","C0CNMED4",153,0)
+"RTN","C0CNMED4",151,0)
. ; Oddly, there is no easy place to find the dispense unit.
-"RTN","C0CNMED4",154,0)
+"RTN","C0CNMED4",152,0)
. ; It's not included in the original call, so we have to go to the drug file.
-"RTN","C0CNMED4",155,0)
+"RTN","C0CNMED4",153,0)
. ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
-"RTN","C0CNMED4",156,0)
+"RTN","C0CNMED4",154,0)
. ; Node 14.5 is the Dispense Unit
-"RTN","C0CNMED4",157,0)
+"RTN","C0CNMED4",155,0)
. ;I $L(MEDIEN) D
-"RTN","C0CNMED4",158,0)
+"RTN","C0CNMED4",156,0)
. ;. D DATA^PSS50(MEDIEN,,,,,"QTY")
-"RTN","C0CNMED4",159,0)
+"RTN","C0CNMED4",157,0)
. ;. N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
-"RTN","C0CNMED4",160,0)
+"RTN","C0CNMED4",158,0)
. ;. S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
-"RTN","C0CNMED4",161,0)
+"RTN","C0CNMED4",159,0)
. ;E S @MAP@("MEDQUANTITYUNIT")=""
-"RTN","C0CNMED4",162,0)
+"RTN","C0CNMED4",160,0)
. S @MAP@("MEDQUANTITYUNIT")=$G(MED("dose.dose@unitsPerDose"))
-"RTN","C0CNMED4",163,0)
+"RTN","C0CNMED4",161,0)
. ;
-"RTN","C0CNMED4",164,0)
+"RTN","C0CNMED4",162,0)
. ; --- START OF DIRECTIONS ---
-"RTN","C0CNMED4",165,0)
+"RTN","C0CNMED4",163,0)
. ; Dosage is field 2, route is 3, schedule is 4
-"RTN","C0CNMED4",166,0)
+"RTN","C0CNMED4",164,0)
. ; These are all free text fields, and don't point to any files
-"RTN","C0CNMED4",167,0)
+"RTN","C0CNMED4",165,0)
. ; For that reason, I will use the field I never used before:
-"RTN","C0CNMED4",168,0)
+"RTN","C0CNMED4",166,0)
. ; MEDDIRECTIONDESCRIPTIONTEXT
-"RTN","C0CNMED4",169,0)
+"RTN","C0CNMED4",167,0)
. ;S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
-"RTN","C0CNMED4",170,0)
+"RTN","C0CNMED4",168,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=$G(MED("sig"))
-"RTN","C0CNMED4",171,0)
+"RTN","C0CNMED4",169,0)
. ; $G(MED("products.product.vaProduct@name"))
-"RTN","C0CNMED4",172,0)
+"RTN","C0CNMED4",170,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4" ; means look in description text. See E2369-05.
-"RTN","C0CNMED4",173,0)
+"RTN","C0CNMED4",171,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
-"RTN","C0CNMED4",174,0)
+"RTN","C0CNMED4",172,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
-"RTN","C0CNMED4",175,0)
+"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,"MEDRATEVALUE")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
"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)
+"RTN","C0CNMED4",178,0)
. S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
-"RTN","C0CNMED4",181,0)
+"RTN","C0CNMED4",179,0)
. S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
-"RTN","C0CNMED4",182,0)
+"RTN","C0CNMED4",180,0)
. S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""
-"RTN","C0CNMED4",183,0)
+"RTN","C0CNMED4",181,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""
-"RTN","C0CNMED4",184,0)
+"RTN","C0CNMED4",182,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""
-"RTN","C0CNMED4",185,0)
+"RTN","C0CNMED4",183,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""
-"RTN","C0CNMED4",186,0)
+"RTN","C0CNMED4",184,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""
-"RTN","C0CNMED4",187,0)
+"RTN","C0CNMED4",185,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""
-"RTN","C0CNMED4",188,0)
+"RTN","C0CNMED4",186,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""
-"RTN","C0CNMED4",189,0)
+"RTN","C0CNMED4",187,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""
-"RTN","C0CNMED4",190,0)
+"RTN","C0CNMED4",188,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
-"RTN","C0CNMED4",191,0)
+"RTN","C0CNMED4",189,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
-"RTN","C0CNMED4",192,0)
+"RTN","C0CNMED4",190,0)
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
-"RTN","C0CNMED4",193,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
-"RTN","C0CNMED4",194,0)
+"RTN","C0CNMED4",191,0)
+ . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
+"RTN","C0CNMED4",192,0)
. S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
-"RTN","C0CNMED4",195,0)
+"RTN","C0CNMED4",193,0)
. S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
+"RTN","C0CNMED4",194,0)
+ . ;
+"RTN","C0CNMED4",195,0)
+ . ; --- END OF DIRECTIONS ---
"RTN","C0CNMED4",196,0)
. ;
"RTN","C0CNMED4",197,0)
- . ; --- END OF DIRECTIONS ---
-"RTN","C0CNMED4",198,0)
- . ;
-"RTN","C0CNMED4",199,0)
. ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
-"RTN","C0CNMED4",200,0)
+"RTN","C0CNMED4",198,0)
. ;S @MAP@("MEDPTINSTRUCTIONS")=MED(10,1) ; WP Field
-"RTN","C0CNMED4",201,0)
+"RTN","C0CNMED4",199,0)
. S @MAP@("MEDPTINSTRUCTIONS")=""
-"RTN","C0CNMED4",202,0)
+"RTN","C0CNMED4",200,0)
. ;S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
-"RTN","C0CNMED4",203,0)
+"RTN","C0CNMED4",201,0)
. S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
-"RTN","C0CNMED4",204,0)
+"RTN","C0CNMED4",202,0)
. S @MAP@("MEDRFNO")=""
-"RTN","C0CNMED4",205,0)
+"RTN","C0CNMED4",203,0)
. N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
-"RTN","C0CNMED4",206,0)
+"RTN","C0CNMED4",204,0)
. K @RESULT
-"RTN","C0CNMED4",207,0)
+"RTN","C0CNMED4",205,0)
. D MAP^C0CXPATH(MINXML,MAP,RESULT)
-"RTN","C0CNMED4",208,0)
+"RTN","C0CNMED4",206,0)
. ; D PARY^C0CXPATH(RESULT)
-"RTN","C0CNMED4",209,0)
+"RTN","C0CNMED4",207,0)
. ; MAPPING DIRECTIONS
-"RTN","C0CNMED4",210,0)
+"RTN","C0CNMED4",208,0)
. N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
-"RTN","C0CNMED4",211,0)
+"RTN","C0CNMED4",209,0)
. N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
-"RTN","C0CNMED4",212,0)
+"RTN","C0CNMED4",210,0)
. D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
-"RTN","C0CNMED4",213,0)
+"RTN","C0CNMED4",211,0)
. D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
-"RTN","C0CNMED4",214,0)
+"RTN","C0CNMED4",212,0)
. ; N MDZ1,MDZNA
-"RTN","C0CNMED4",215,0)
+"RTN","C0CNMED4",213,0)
. N DIRCNT S DIRCNT=1 ; THERE ARE ALWAYS DIRECTIONS
-"RTN","C0CNMED4",216,0)
+"RTN","C0CNMED4",214,0)
. I DIRCNT>0 D ; IF THERE ARE DIRCTIONS
-"RTN","C0CNMED4",217,0)
+"RTN","C0CNMED4",215,0)
. . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION
-"RTN","C0CNMED4",218,0)
+"RTN","C0CNMED4",216,0)
. . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
-"RTN","C0CNMED4",219,0)
+"RTN","C0CNMED4",217,0)
. . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
-"RTN","C0CNMED4",220,0)
+"RTN","C0CNMED4",218,0)
. . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
-"RTN","C0CNMED4",221,0)
+"RTN","C0CNMED4",219,0)
. D:MEDCOUNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
-"RTN","C0CNMED4",222,0)
+"RTN","C0CNMED4",220,0)
. D:MEDCOUNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
-"RTN","C0CNMED4",223,0)
+"RTN","C0CNMED4",221,0)
N MEDTMP,MEDI
-"RTN","C0CNMED4",224,0)
+"RTN","C0CNMED4",222,0)
D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","C0CNMED4",225,0)
+"RTN","C0CNMED4",223,0)
I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","C0CNMED4",226,0)
+"RTN","C0CNMED4",224,0)
. W "MEDICATION MISSING ",!
-"RTN","C0CNMED4",227,0)
+"RTN","C0CNMED4",225,0)
. F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","C0CNMED4",228,0)
+"RTN","C0CNMED4",226,0)
Q
-"RTN","C0CNMED4",229,0)
+"RTN","C0CNMED4",227,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.
-"RTN","C0CORSLT",16,0)
;
+"RTN","C0CORSLT",15,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CORSLT",16,0)
+ ; along with this program. If not, see .
"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",!
-"RTN","C0CORSLT",22,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)
+"RTN","C0CORSLT",22,0)
; THEM TO THE LAB VARIABLES ZVARS IS PASSED BY REFERENCE
-"RTN","C0CORSLT",26,0)
+"RTN","C0CORSLT",23,0)
; AN EXAMPLE IS EKG RESULTS THAT ARE FOUND IN NOTES AND CONSULTS
-"RTN","C0CORSLT",27,0)
+"RTN","C0CORSLT",24,0)
; THIS IS CREATED FOR MU CERTIFICATION BY GPL
-"RTN","C0CORSLT",28,0)
+"RTN","C0CORSLT",25,0)
D ENTRY^C0CCPT(DFN,,,1) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE
-"RTN","C0CORSLT",29,0)
+"RTN","C0CORSLT",26,0)
N ZN ; RESULT NUMBER
-"RTN","C0CORSLT",30,0)
+"RTN","C0CORSLT",27,0)
S ZN=$O(@ZVARS@(""),-1) ; NEXT RESULT
-"RTN","C0CORSLT",31,0)
+"RTN","C0CORSLT",28,0)
N ZI S ZI=""
-"RTN","C0CORSLT",32,0)
+"RTN","C0CORSLT",29,0)
F S ZI=$O(VISIT(ZI)) Q:ZI="" D ; FOR EACH VISIT
-"RTN","C0CORSLT",33,0)
+"RTN","C0CORSLT",30,0)
. I $G(VISIT(ZI,"TEXT",1))["ECG DONE" D ; GOT AN ECG
-"RTN","C0CORSLT",34,0)
+"RTN","C0CORSLT",31,0)
. . S ZN=ZN+1 ; INCREMENT RESULT COUNT
-"RTN","C0CORSLT",35,0)
+"RTN","C0CORSLT",32,0)
. . N ZDATE,ZPRV,ZTXT
-"RTN","C0CORSLT",36,0)
+"RTN","C0CORSLT",33,0)
. . S ZDATE=$G(VISIT(ZI,"DATE",0)) ; DATE OF PROCEDURE
-"RTN","C0CORSLT",37,0)
+"RTN","C0CORSLT",34,0)
. . S ZPRV=$P($G(VISIT(ZI,"PRV",2)),"^",1) ;PROVIDER
-"RTN","C0CORSLT",38,0)
+"RTN","C0CORSLT",35,0)
. . S ZTXT=$P($G(VISIT(ZI,"TEXT",4)),"ECG RESULTS: ",2)
-"RTN","C0CORSLT",39,0)
+"RTN","C0CORSLT",36,0)
. . S @ZVARS@(ZN,"RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(ZDATE,"DT")
-"RTN","C0CORSLT",40,0)
+"RTN","C0CORSLT",37,0)
. . S @ZVARS@(ZN,"RESULTCODE")="34534-8"
-"RTN","C0CORSLT",41,0)
+"RTN","C0CORSLT",38,0)
. . S @ZVARS@(ZN,"RESULTCODINGSYSTEM")="LOINC"
-"RTN","C0CORSLT",42,0)
+"RTN","C0CORSLT",39,0)
. . S @ZVARS@(ZN,"RESULTDESCRIPTIONTEXT")="Electrocardiogram LOINC:34534-8"
-"RTN","C0CORSLT",43,0)
+"RTN","C0CORSLT",40,0)
. . S @ZVARS@(ZN,"RESULTOBJECTID")="RESULT"_ZN
-"RTN","C0CORSLT",44,0)
+"RTN","C0CORSLT",41,0)
. . S @ZVARS@(ZN,"RESULTSOURCEACTORID")="ACTORPROVIDER_"_ZPRV
-"RTN","C0CORSLT",45,0)
+"RTN","C0CORSLT",42,0)
. . S @ZVARS@(ZN,"RESULTSTATUS")=""
-"RTN","C0CORSLT",46,0)
+"RTN","C0CORSLT",43,0)
. . S @ZVARS@(ZN,"M","TEST",0)=1
-"RTN","C0CORSLT",47,0)
+"RTN","C0CORSLT",44,0)
. . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTCODEVALUE")="34534-8"
-"RTN","C0CORSLT",48,0)
+"RTN","C0CORSLT",45,0)
. . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTCODINGSYSTEM")="LOINC"
-"RTN","C0CORSLT",49,0)
+"RTN","C0CORSLT",46,0)
. . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(ZDATE,"DT")
-"RTN","C0CORSLT",50,0)
+"RTN","C0CORSLT",47,0)
. . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTDESCRIPTIONTEXT")="Electrocardiogram LOINC:34534-8"
-"RTN","C0CORSLT",51,0)
+"RTN","C0CORSLT",48,0)
. . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTFLAG")=""
-"RTN","C0CORSLT",52,0)
+"RTN","C0CORSLT",49,0)
. . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTNORMALDESCTEXT")=""
-"RTN","C0CORSLT",53,0)
+"RTN","C0CORSLT",50,0)
. . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTNORMALSOURCEACTORID")="ACTORORGANIZATION_VASTANUM"
-"RTN","C0CORSLT",54,0)
+"RTN","C0CORSLT",51,0)
. . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTOBJECTID")="RESULTTEST_ECG_"_ZN
-"RTN","C0CORSLT",55,0)
+"RTN","C0CORSLT",52,0)
. . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTSOURCEACTORID")="ACTORPROVIDER"_ZPRV
-"RTN","C0CORSLT",56,0)
+"RTN","C0CORSLT",53,0)
. . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTSTATUSTEXT")="F"
-"RTN","C0CORSLT",57,0)
+"RTN","C0CORSLT",54,0)
. . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTUNITS")=""
-"RTN","C0CORSLT",58,0)
+"RTN","C0CORSLT",55,0)
. . S @ZVARS@(ZN,"M","TEST",1,"RESULTTESTVALUE")=ZTXT
-"RTN","C0CORSLT",59,0)
+"RTN","C0CORSLT",56,0)
. . S @ZVARS@(0)=ZN ; UPDATE RESULTS COUNT
-"RTN","C0CORSLT",60,0)
+"RTN","C0CORSLT",57,0)
Q
-"RTN","C0CORSLT",61,0)
+"RTN","C0CORSLT",58,0)
;
-"RTN","C0CORSLT",62,0)
+"RTN","C0CORSLT",59,0)
OLD ; OLD CODE FOR OTHER WAYS OF DOING THE ECG
-"RTN","C0CORSLT",63,0)
+"RTN","C0CORSLT",60,0)
; FOR CERTIFICATION - SAVE EKG RESULTS gpl
-"RTN","C0CORSLT",64,0)
+"RTN","C0CORSLT",61,0)
W !,"CPT=",ZCPT
-"RTN","C0CORSLT",65,0)
+"RTN","C0CORSLT",62,0)
I ZCPT["93000" D ; THIS IS AN EKG
-"RTN","C0CORSLT",66,0)
+"RTN","C0CORSLT",63,0)
. D RNF1TO2^C0CRNF(C0CPRSLT,"ZRNF") ; SAVE FOR LABS
-"RTN","C0CORSLT",67,0)
+"RTN","C0CORSLT",64,0)
. M ^GPL("RNF2")=@C0CPRSLT
-"RTN","C0CORSLT",68,0)
+"RTN","C0CORSLT",65,0)
Q
-"RTN","C0CORSLT",69,0)
+"RTN","C0CORSLT",66,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 .
"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)
-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
+ ; This program is free software: you can redistribute it and/or modify
"RTN","C0COVRES",6,0)
- ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
+ ; it under the terms of the GNU Affero General Public License as
"RTN","C0COVRES",7,0)
- ; MIXML IS THE TEMPLATE TO USE
+ ; published by the Free Software Foundation, either version 3 of the
"RTN","C0COVRES",8,0)
- ; MOXML IS THE OUTPUT XML ARRAY
+ ; License, or (at your option) any later version.
"RTN","C0COVRES",9,0)
- ; DFN IS THE PATIENT RECORD NUMBER
+ ;
"RTN","C0COVRES",10,0)
- N C0COXML,C0CO,C0CV,C0CIXML
+ ; This program is distributed in the hope that it will be useful,
"RTN","C0COVRES",11,0)
- I '$D(MIVAR) S C0CV="" ;DEFAULT
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0COVRES",12,0)
- E S C0CV=MIVAR ;PASSED VARIABLE ARRAY
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
"RTN","C0COVRES",13,0)
- I '$D(MIXML) S C0CIXML="" ;DEFAULT
+ ; GNU Affero General Public License for more details.
"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
+ ; You should have received a copy of the GNU Affero General Public License
"RTN","C0COVRES",16,0)
- I '$D(MOXML) S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
+ ; along with this program. If not, see .
"RTN","C0COVRES",17,0)
- E S C0CO=MOXML
+ ;
"RTN","C0COVRES",18,0)
- M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
+MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
"RTN","C0COVRES",19,0)
- Q
+ ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
"RTN","C0COVRES",20,0)
-RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS
+ ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
"RTN","C0COVRES",21,0)
- ; RTN IS PASSED BY REFERENCE
+ ; MIXML IS THE TEMPLATE TO USE
"RTN","C0COVRES",22,0)
- N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
+ ; MOXML IS THE OUTPUT XML ARRAY
"RTN","C0COVRES",23,0)
- N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
+ ; DFN IS THE PATIENT RECORD NUMBER
"RTN","C0COVRES",24,0)
- I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
+ N C0COXML,C0CO,C0CV,C0CIXML
"RTN","C0COVRES",25,0)
- I RMIXML="" D ; INPUT XML NOT PASSED
+ I '$D(MIVAR) S C0CV="" ;DEFAULT
"RTN","C0COVRES",26,0)
- . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
+ E S C0CV=MIVAR ;PASSED VARIABLE ARRAY
"RTN","C0COVRES",27,0)
- . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
+ I '$D(MIXML) S C0CIXML="" ;DEFAULT
"RTN","C0COVRES",28,0)
- . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
+ E S C0CIXML=MIXML ;PASSED INPUT XML
"RTN","C0COVRES",29,0)
- E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
+ D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
"RTN","C0COVRES",30,0)
- I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED
+ I '$D(MOXML) S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
"RTN","C0COVRES",31,0)
- . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
+ E S C0CO=MOXML
"RTN","C0COVRES",32,0)
- E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
+ M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
"RTN","C0COVRES",33,0)
- D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
+ Q
"RTN","C0COVRES",34,0)
- D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
+RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS
"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) ;
+ ;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
+ 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) ;
"RTN","C0COVRES",70,0)
- . . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE
+ 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) ;
+ . 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) ;
+ . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
"RTN","C0COVRES",75,0)
- D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;
+ . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO
"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)
-EXTRACT(ILXML,DFN,OLXML) ; EXTRACT LABS INTO THE C0CLVAR GLOBAL
+ . . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT
"RTN","C0COVRES",80,0)
- ; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+ . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
"RTN","C0COVRES",81,0)
- N C0CNSSN,C0CLB ; IS THERE AN SSN FLAG
+ . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
"RTN","C0COVRES",82,0)
- S C0CNSSN=0
+ . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
"RTN","C0COVRES",83,0)
- S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
+ . . . D XMAP^C0CTIU1("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
"RTN","C0COVRES",84,0)
- D GHL7^C0COVREU ; GET HL7 MESSAGE FOR THIS PATIENT
+ . . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE
"RTN","C0COVRES",85,0)
- I C0CNSSN=1 D Q ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT
+ . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;
"RTN","C0COVRES",86,0)
- . S @C0CLB@(0)=0
+ . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
"RTN","C0COVRES",87,0)
- ;K @C0CLB ; CLEAR OUT OLD VARS IF ANY
+ . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
"RTN","C0COVRES",88,0)
- N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG
+ . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;
"RTN","C0COVRES",89,0)
- S C0CQT=1 ; SURPRESS LISTING
+ D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;
"RTN","C0COVRES",90,0)
- D LIST^C0COVREL ; EXTRACT THE VARIABLES
+ D BUILD^C0CTIU1("C0CRBLD","RTN") ;RENDER THE XML
"RTN","C0COVRES",91,0)
- S C0CQT=QTSAV ; RESET SILENT FLAG
+ K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
"RTN","C0COVRES",92,0)
- K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT
+ Q
"RTN","C0COVRES",93,0)
- I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
+EXTRACT(ILXML,DFN,OLXML) ; EXTRACT LABS INTO THE C0CLVAR GLOBAL
"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 .
"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)
-LTYP(OSEG,OTYP,OVARA,OC0CQT) ;
+ . W "LAB LOOKUP FAILED, NO SSN",!
"RTN","C0COVREU",25,0)
- N OI,OI2,OTAB,OTI,OV,OVAR
+ . S C0CNSSN=1 ; SET NO SSN FLAG
"RTN","C0COVREU",26,0)
- S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE
+ S C0CSPC="*" ; LOOKING FOR ALL LABS
"RTN","C0COVREU",27,0)
- I '$D(OC0CQT) S C0CQT=0 ; NOT C0CQT IS DEFAULT
+ ;I $D(^TMP("C0CCCR","RPMS")) D ; RUNNING RPMS
"RTN","C0COVREU",28,0)
- E S C0CQT=OC0CQT ; ACCEPT C0CQT FLAG
+ ;. D DT^DILF(,"T-365",.C0CSDT) ; START DATE ONE YEAR AGO TO LIMIT VOLUME
"RTN","C0COVREU",29,0)
- I 1 D ; FOR HL7 SEGMENT TYPE
+ ;E D DT^DILF(,"T-5000",.C0CSDT) ; START DATE LONG AGO TO GET EVERYTHING
"RTN","C0COVREU",30,0)
- . S OI="" ; INDEX INTO FIELDS IN SEG
+ ;D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY
"RTN","C0COVREU",31,0)
- . F S OI=$O(@OTAB@(OI)) Q:OI="" D ; FOR EACH FIELD OF THE SEGMENT
+ S C0CLLMT=$$GET^C0CPARMS("LABLIMIT") ; GET THE LIMIT PARM
"RTN","C0COVREU",32,0)
- . . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX
+ S C0CLSTRT=$$GET^C0CPARMS("LABSTART") ; GET START PARM
"RTN","C0COVREU",33,0)
- . . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED
+ D DT^DILF(,C0CLLMT,.C0CSDT) ;
"RTN","C0COVREU",34,0)
- . . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE
+ W "LAB LIMIT: ",C0CLLMT,!
"RTN","C0COVREU",35,0)
- . . I $P(OI,";",2)'="" D ; THIS IS DEFINING A SUB-VALUE
+ D DT^DILF(,C0CLSTRT,.C0CEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
"RTN","C0COVREU",36,0)
- . . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX
+ S C0CR=$$LAB^C0CLA7Q(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP
"RTN","C0COVREU",37,0)
- . . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE
+ Q
"RTN","C0COVREU",38,0)
- . . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE
+LTYP(OSEG,OTYP,OVARA,OC0CQT) ;
"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)
-LOBX ;
+ E S C0CQT=OC0CQT ; ACCEPT C0CQT FLAG
"RTN","C0COVREU",43,0)
- Q
+ I 1 D ; FOR HL7 SEGMENT TYPE
"RTN","C0COVREU",44,0)
- ;
+ . S OI="" ; INDEX INTO FIELDS IN SEG
"RTN","C0COVREU",45,0)
-OUT(DFN) ; WRITE OUT A CCR THAT HAS JUST BEEN PROCESSED (FOR TESTING)
+ . F S OI=$O(@OTAB@(OI)) Q:OI="" D ; FOR EACH FIELD OF THE SEGMENT
"RTN","C0COVREU",46,0)
- N GA,GF,GD
+ . . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX
"RTN","C0COVREU",47,0)
- S GA=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1))
+ . . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED
"RTN","C0COVREU",48,0)
- S GF="RPMS_CCR_"_DFN_"_"_DT_".xml"
+ . . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE
"RTN","C0COVREU",49,0)
- S GD=^TMP("C0CCCR","ODIR")
+ . . I $P(OI,";",2)'="" D ; THIS IS DEFINING A SUB-VALUE
"RTN","C0COVREU",50,0)
- W $$OUTPUT^C0CXPATH(GA,GF,GD)
+ . . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX
"RTN","C0COVREU",51,0)
- Q
+ . . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE
"RTN","C0COVREU",52,0)
-SETTBL ;
+ . . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE
"RTN","C0COVREU",53,0)
- K X ; CLEAR X
+ . . I 'C0CQT D ; PRINT OUTPUT IF C0CQT IS FALSE
"RTN","C0COVREU",54,0)
- S X("PID","PID1")="1^00104^Set ID - Patient ID"
+ . . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,!
"RTN","C0COVREU",55,0)
- S X("PID","PID2")="2^00105^Patient ID (External ID)"
+ Q
"RTN","C0COVREU",56,0)
- S X("PID","PID3")="3^00106^Patient ID (Internal ID)"
+LOBX ;
"RTN","C0COVREU",57,0)
- S X("PID","PID4")="4^00107^Alternate Patient ID"
+ Q
"RTN","C0COVREU",58,0)
- S X("PID","PID5")="5^00108^Patient's Name"
+OUT(DFN) ; WRITE OUT A CCR THAT HAS JUST BEEN PROCESSED (FOR TESTING)
"RTN","C0COVREU",59,0)
- S X("PID","PID6")="6^00109^Mother's Maiden Name"
+ N GA,GF,GD
"RTN","C0COVREU",60,0)
- S X("PID","PID7")="7^00110^Date of Birth"
+ S GA=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1))
"RTN","C0COVREU",61,0)
- S X("PID","PID8")="8^00111^Sex"
+ S GF="RPMS_CCR_"_DFN_"_"_DT_".xml"
"RTN","C0COVREU",62,0)
- S X("PID","PID9")="9^00112^Patient Alias"
+ S GD=^TMP("C0CCCR","ODIR")
"RTN","C0COVREU",63,0)
- S X("PID","PID10")="10^00113^Race"
+ W $$OUTPUT^C0CXPATH(GA,GF,GD)
"RTN","C0COVREU",64,0)
- S X("PID","PID11")="11^00114^Patient Address"
+ Q
"RTN","C0COVREU",65,0)
- S X("PID","PID12")="12^00115^County Code"
+SETTBL ;
"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 .
"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.
-"RTN","C0CPARMS",19,0)
- ;
-"RTN","C0CPARMS",20,0)
SET(INPARMS) ;INITIALIZE RUNTIME PARMS USING INPARMS TO OVERRIDE DEFAULTS
-"RTN","C0CPARMS",21,0)
+"RTN","C0CPARMS",19,0)
; PARAMETERS ARE PASSED AS A STRING: "PARM1:VALUE1^PARM2:VALUE2^ETC"
-"RTN","C0CPARMS",22,0)
+"RTN","C0CPARMS",20,0)
; THE SAME FORMAT IS USED BY RPC AND COMMAND LINE ENTRY POINTS
-"RTN","C0CPARMS",23,0)
+"RTN","C0CPARMS",21,0)
;
-"RTN","C0CPARMS",24,0)
+"RTN","C0CPARMS",22,0)
N PTMP ;
-"RTN","C0CPARMS",25,0)
+"RTN","C0CPARMS",23,0)
S C0CPARMS=$NA(^TMP("C0CPARMS",$J)) ;BASE FOR THIS RUN
-"RTN","C0CPARMS",26,0)
+"RTN","C0CPARMS",24,0)
K @C0CPARMS ;START WITH EMPTY PARMS; MAY NOT WANT TO DO THIS KILL
-"RTN","C0CPARMS",27,0)
+"RTN","C0CPARMS",25,0)
I $G(INPARMS)'="" D ; OVERRIDES PROVIDED
-"RTN","C0CPARMS",28,0)
+"RTN","C0CPARMS",26,0)
. N C0CI S C0CI=""
-"RTN","C0CPARMS",29,0)
+"RTN","C0CPARMS",27,0)
. N C0CN S C0CN=1
-"RTN","C0CPARMS",30,0)
+"RTN","C0CPARMS",28,0)
. F S C0CI=$P(INPARMS,"^",C0CN) Q:C0CI="" D ;
-"RTN","C0CPARMS",31,0)
+"RTN","C0CPARMS",29,0)
. . S C0CN=C0CN+1 ;NEXT PARM
-"RTN","C0CPARMS",32,0)
+"RTN","C0CPARMS",30,0)
. . N C1,C2
-"RTN","C0CPARMS",33,0)
+"RTN","C0CPARMS",31,0)
. . S C1=$P(C0CI,":",1) ; PARAMETER
-"RTN","C0CPARMS",34,0)
+"RTN","C0CPARMS",32,0)
. . S C2=$P(C0CI,":",2) ; VALUE
-"RTN","C0CPARMS",35,0)
+"RTN","C0CPARMS",33,0)
. . I C2="" S C2=1
-"RTN","C0CPARMS",36,0)
+"RTN","C0CPARMS",34,0)
. . S @C0CPARMS@(C1)=C2
-"RTN","C0CPARMS",37,0)
+"RTN","C0CPARMS",35,0)
. I C0CN=1 S @C0CPARMS@($P(INPARMS,":",1))=$P(C0CI,":",2) ; ONLY ONE
-"RTN","C0CPARMS",38,0)
+"RTN","C0CPARMS",36,0)
; THIS IS WHERE WE WILL INSERT CALLS TO THE PARAMETER FILE FOR DEFAULTS
-"RTN","C0CPARMS",39,0)
+"RTN","C0CPARMS",37,0)
; IF THEY FAIL, THE FOLLOWING WILL BE HARDCODED DEFAULTS
-"RTN","C0CPARMS",40,0)
+"RTN","C0CPARMS",38,0)
;OHUM/RUT commented the hardcoded limits
-"RTN","C0CPARMS",41,0)
+"RTN","C0CPARMS",39,0)
;I '$D(@C0CPARMS@("LABLIMIT")) S @C0CPARMS@("LABLIMIT")="T-360" ;ONE YR WORTH
-"RTN","C0CPARMS",42,0)
+"RTN","C0CPARMS",40,0)
;I '$D(@C0CPARMS@("LABSTART")) S @C0CPARMS@("LABSTART")="T" ;TODAY
-"RTN","C0CPARMS",43,0)
+"RTN","C0CPARMS",41,0)
;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@("VITSTART")) S @C0CPARMS@("VITSTART")="T" ;TODAY
-"RTN","C0CPARMS",45,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",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@("MEDACTIVE")) S @C0CPARMS@("MEDACTIVE")=1 ; YES
-"RTN","C0CPARMS",48,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)
+"RTN","C0CPARMS",48,0)
;OHUM/RUT 3120109 ; commented all limits
-"RTN","C0CPARMS",51,0)
+"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",52,0)
+"RTN","C0CPARMS",50,0)
;I '$D(@C0CPARMS@("LABSTART")) S @C0CPARMS@("LABSTART")="T" ;TODAY
-"RTN","C0CPARMS",53,0)
+"RTN","C0CPARMS",51,0)
;I '$D(@C0CPARMS@("VITSTART")) S @C0CPARMS@("VITSTART")="T" ;TODAY
-"RTN","C0CPARMS",54,0)
+"RTN","C0CPARMS",52,0)
;I '$D(@C0CPARMS@("MEDSTART")) S @C0CPARMS@("MEDSTART")="T" ; TODAY
-"RTN","C0CPARMS",55,0)
+"RTN","C0CPARMS",53,0)
;I '$D(@C0CPARMS@("MEDACTIVE")) S @C0CPARMS@("MEDACTIVE")=1 ; YES
-"RTN","C0CPARMS",56,0)
+"RTN","C0CPARMS",54,0)
;I '$D(@C0CPARMS@("MEDPENDING")) S @C0CPARMS@("MEDPENDING")=0 ; NO
-"RTN","C0CPARMS",57,0)
+"RTN","C0CPARMS",55,0)
;I '$D(@C0CPARMS@("MEDALL")) S @C0CPARMS@("MEDALL")=1 ; NON-PENDING NON-ACTIVE
-"RTN","C0CPARMS",58,0)
+"RTN","C0CPARMS",56,0)
;;I '$D(@C0CPARMS@("RALIMIT")) S @C0CPARMS@("RALIMIT")="T-36500" ;ONE YR WORTH
-"RTN","C0CPARMS",59,0)
+"RTN","C0CPARMS",57,0)
;;I '$D(@C0CPARMS@("RASTART")) S @C0CPARMS@("RASTART")="T" ;TODAY
-"RTN","C0CPARMS",60,0)
+"RTN","C0CPARMS",58,0)
;I '$D(@C0CPARMS@("TIUSTART")) S @C0CPARMS@("TIUSTART")="T" ;TODAY
-"RTN","C0CPARMS",61,0)
+"RTN","C0CPARMS",59,0)
;;OHUM/RUT
-"RTN","C0CPARMS",62,0)
+"RTN","C0CPARMS",60,0)
S @C0CPARMS@("LABLIMIT")=$P(^C0CPARM(1,0),"^",2)
-"RTN","C0CPARMS",63,0)
+"RTN","C0CPARMS",61,0)
S @C0CPARMS@("LABSTART")=$P(^C0CPARM(1,0),"^",3)
-"RTN","C0CPARMS",64,0)
+"RTN","C0CPARMS",62,0)
S @C0CPARMS@("VITLIMIT")=$P(^C0CPARM(1,0),"^",4)
-"RTN","C0CPARMS",65,0)
+"RTN","C0CPARMS",63,0)
S @C0CPARMS@("VITSTART")=$P(^C0CPARM(1,1),"^",1)
-"RTN","C0CPARMS",66,0)
+"RTN","C0CPARMS",64,0)
S @C0CPARMS@("MEDLIMIT")=$P(^C0CPARM(1,1),"^",2)
-"RTN","C0CPARMS",67,0)
+"RTN","C0CPARMS",65,0)
S @C0CPARMS@("MEDSTART")=$P(^C0CPARM(1,1),"^",3)
-"RTN","C0CPARMS",68,0)
+"RTN","C0CPARMS",66,0)
S @C0CPARMS@("MEDACTIVE")=0
-"RTN","C0CPARMS",69,0)
+"RTN","C0CPARMS",67,0)
S @C0CPARMS@("MEDPENDING")=0
-"RTN","C0CPARMS",70,0)
+"RTN","C0CPARMS",68,0)
S @C0CPARMS@("MEDALL")=0 ;OHUM/RUT 3120504 INITIALISING MEDICATION STATUS VARIABLES WITH ZERO
-"RTN","C0CPARMS",71,0)
+"RTN","C0CPARMS",69,0)
I $P(^C0CPARM(1,1),"^",4)="ACT" S @C0CPARMS@("MEDACTIVE")=1
-"RTN","C0CPARMS",72,0)
+"RTN","C0CPARMS",70,0)
I $P(^C0CPARM(1,1),"^",4)="PEN" S @C0CPARMS@("MEDPENDING")=1
-"RTN","C0CPARMS",73,0)
+"RTN","C0CPARMS",71,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"
-"RTN","C0CPARMS",74,0)
+"RTN","C0CPARMS",72,0)
;S ^TMP("C0CCCR","TIULIMIT")="",^TMP("C0CCCR","TIUSTART")=""
-"RTN","C0CPARMS",75,0)
+"RTN","C0CPARMS",73,0)
I $P(^C0CPARM(1,2),"^",3)=1 S @C0CPARMS@("TIULIMIT")=$P(^C0CPARM(1,2),"^",1),@C0CPARMS@("TIUSTART")=$P(^C0CPARM(1,2),"^",2)
-"RTN","C0CPARMS",76,0)
+"RTN","C0CPARMS",74,0)
;OHUM/RUT
-"RTN","C0CPARMS",77,0)
+"RTN","C0CPARMS",75,0)
Q
+"RTN","C0CPARMS",76,0)
+ ;
+"RTN","C0CPARMS",77,0)
+CHECK ; CHECK TO SEE IF PARMS ARE PRESENT, ELSE RUN SET
"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)
+"RTN","C0CPARMS",80,0)
I '$D(@C0CPARMS) D SET("SETWITHCHECK:1")
-"RTN","C0CPARMS",83,0)
+"RTN","C0CPARMS",81,0)
Q
+"RTN","C0CPARMS",82,0)
+ ;
+"RTN","C0CPARMS",83,0)
+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
-"RTN","C0CPARMS",86,0)
- ;
-"RTN","C0CPARMS",87,0)
D CHECK ; SHOULDN'T HAPPEN BUT TO BE SAFE
-"RTN","C0CPARMS",88,0)
+"RTN","C0CPARMS",86,0)
N GTMP
-"RTN","C0CPARMS",89,0)
+"RTN","C0CPARMS",87,0)
Q $G(@C0CPARMS@(WHICHP)) ;PULL THE PARM FROM THE TABLE
-"RTN","C0CPARMS",90,0)
+"RTN","C0CPARMS",88,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 .
"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.,
-"RTN","C0CPROBS",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","C0CPROBS",20,0)
;
+"RTN","C0CPROBS",18,0)
+ ; PROCESS THE PROBLEMS SECTION OF THE CCR
+"RTN","C0CPROBS",19,0)
+ ;
+"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
-"RTN","C0CPROBS",23,0)
- ;
-"RTN","C0CPROBS",24,0)
-EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
-"RTN","C0CPROBS",25,0)
- ;
-"RTN","C0CPROBS",26,0)
; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","C0CPROBS",27,0)
+"RTN","C0CPROBS",23,0)
; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
-"RTN","C0CPROBS",28,0)
+"RTN","C0CPROBS",24,0)
; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
-"RTN","C0CPROBS",29,0)
+"RTN","C0CPROBS",25,0)
; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
-"RTN","C0CPROBS",30,0)
+"RTN","C0CPROBS",26,0)
; INSERT^C0CXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
-"RTN","C0CPROBS",31,0)
+"RTN","C0CPROBS",27,0)
;
-"RTN","C0CPROBS",32,0)
+"RTN","C0CPROBS",28,0)
N RPCRSLT,J,K,PTMP,X,VMAP,TBU
-"RTN","C0CPROBS",33,0)
+"RTN","C0CPROBS",29,0)
S TVMAP=$NA(^TMP("C0CCCR",$J,"PROBVALS"))
-"RTN","C0CPROBS",34,0)
+"RTN","C0CPROBS",30,0)
S TARYTMP=$NA(^TMP("C0CCCR",$J,"PROBARYTMP"))
-"RTN","C0CPROBS",35,0)
+"RTN","C0CPROBS",31,0)
K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
-"RTN","C0CPROBS",36,0)
+"RTN","C0CPROBS",32,0)
I $$RPMS^C0CUTIL() D RPMS ; IF BGOPRB ROUTINE IS MISSING (IE RPMS)
-"RTN","C0CPROBS",37,0)
+"RTN","C0CPROBS",33,0)
I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT
-"RTN","C0CPROBS",38,0)
+"RTN","C0CPROBS",34,0)
Q
-"RTN","C0CPROBS",39,0)
+"RTN","C0CPROBS",35,0)
;
-"RTN","C0CPROBS",40,0)
+"RTN","C0CPROBS",36,0)
RPMS ; GETS THE PROBLEM LIST FOR RPMS
-"RTN","C0CPROBS",41,0)
+"RTN","C0CPROBS",37,0)
S RPCGLO=$NA(^TMP("BGO",$J))
-"RTN","C0CPROBS",42,0)
+"RTN","C0CPROBS",38,0)
D GET^BGOPROB(.RPCRSLT,DFN) ; CALL THE PROBLEM LIST RPC
-"RTN","C0CPROBS",43,0)
+"RTN","C0CPROBS",39,0)
; FORMAT OF RPC:
-"RTN","C0CPROBS",44,0)
+"RTN","C0CPROBS",40,0)
; Number Code [1] ^ Patient IEN [2] ^ ICD Code [3] ^ Modify Date [4] ^ Class [5] ^ Provider Narrative [6] ^
-"RTN","C0CPROBS",45,0)
+"RTN","C0CPROBS",41,0)
; Date Entered [7] ^ Status [8] ^ Date Onset [9] ^ Problem IEN [10] ^ Notes [11] ^ ICD9 IEN [12] ^
-"RTN","C0CPROBS",46,0)
+"RTN","C0CPROBS",42,0)
; ICD9 Short Name [13] ^ Provider [14] ^ Facility IEN [15] ^ Priority [16]
-"RTN","C0CPROBS",47,0)
+"RTN","C0CPROBS",43,0)
I '$D(@RPCGLO) W "NULL RESULT FROM GET^BGOPROB ",! S @OUTXML@(0)=0 Q
-"RTN","C0CPROBS",48,0)
+"RTN","C0CPROBS",44,0)
S J=""
-"RTN","C0CPROBS",49,0)
+"RTN","C0CPROBS",45,0)
F S J=$O(@RPCGLO@(J)) Q:J="" D ; FOR EACH PROBLEM IN THE LIST
-"RTN","C0CPROBS",50,0)
+"RTN","C0CPROBS",46,0)
. S VMAP=$NA(@TVMAP@(J))
-"RTN","C0CPROBS",51,0)
+"RTN","C0CPROBS",47,0)
. K @VMAP
-"RTN","C0CPROBS",52,0)
+"RTN","C0CPROBS",48,0)
. I DEBUG W "VMAP= ",VMAP,!
-"RTN","C0CPROBS",53,0)
+"RTN","C0CPROBS",49,0)
. S PTMP=@RPCRSLT@(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
-"RTN","C0CPROBS",54,0)
+"RTN","C0CPROBS",50,0)
. N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL
-"RTN","C0CPROBS",55,0)
+"RTN","C0CPROBS",51,0)
. D GETN1^C0CRNF("C0CG1",9000011,$P(PTMP,U,10),"") ;GET VALUES BY NAME
-"RTN","C0CPROBS",56,0)
+"RTN","C0CPROBS",52,0)
. S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
-"RTN","C0CPROBS",57,0)
+"RTN","C0CPROBS",53,0)
. S @VMAP@("PROBLEMIEN")=$P(PTMP,U,10)
-"RTN","C0CPROBS",58,0)
+"RTN","C0CPROBS",54,0)
. S @VMAP@("PROBLEMSTATUS")=$S($P(PTMP,U,8)="A":"Active",$P(PTMP,U,8)="I":"Inactive",1:"")
-"RTN","C0CPROBS",59,0)
+"RTN","C0CPROBS",55,0)
. S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,6)
-"RTN","C0CPROBS",60,0)
+"RTN","C0CPROBS",56,0)
. S @VMAP@("PROBLEMCODINGVERSION")=""
-"RTN","C0CPROBS",61,0)
+"RTN","C0CPROBS",57,0)
. S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,3)
-"RTN","C0CPROBS",62,0)
+"RTN","C0CPROBS",58,0)
. ; FOR CERTIFICATION - GPL
-"RTN","C0CPROBS",63,0)
+"RTN","C0CPROBS",59,0)
. I @VMAP@("PROBLEMCODEVALUE")=493.90 S @VMAP@("PROBLEMCODEVALUE")=493
-"RTN","C0CPROBS",64,0)
+"RTN","C0CPROBS",60,0)
. S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("DATE OF ONSET","C0CG1"),"DT")
-"RTN","C0CPROBS",65,0)
+"RTN","C0CPROBS",61,0)
. S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("DATE LAST MODIFIED","C0CG1"),"DT")
-"RTN","C0CPROBS",66,0)
+"RTN","C0CPROBS",62,0)
. ;S @VMAP@("PROBLEMSC")=$P(PTMP,U,7) ;UNKNOWN NOT MAPPED IN C0CCCR0
-"RTN","C0CPROBS",67,0)
+"RTN","C0CPROBS",63,0)
. ;S @VMAP@("PROBLEMSE")=$P(PTMP,U,8) ;UNKNOWN NOT MAPPED IN C0CCCR0
-"RTN","C0CPROBS",68,0)
+"RTN","C0CPROBS",64,0)
. ;S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9) ;NOT MAPPED IN C0CCCR0
-"RTN","C0CPROBS",69,0)
+"RTN","C0CPROBS",65,0)
. ;S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10) ;NOT MAPPED IN C0CCCR0
-"RTN","C0CPROBS",70,0)
+"RTN","C0CPROBS",66,0)
. ;S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11) ;NOT MAPPED IN C0CCCR0
-"RTN","C0CPROBS",71,0)
+"RTN","C0CPROBS",67,0)
. ;S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12) ;NOT MAPPED IN C0CCCR0
-"RTN","C0CPROBS",72,0)
+"RTN","C0CPROBS",68,0)
. ;S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
-"RTN","C0CPROBS",73,0)
+"RTN","C0CPROBS",69,0)
. S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$$ZVALUEI^C0CRNF("RECORDING PROVIDER","C0CG1")
-"RTN","C0CPROBS",74,0)
+"RTN","C0CPROBS",70,0)
. ;S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13) ;NOT MAPPED IN C0CCCR0
-"RTN","C0CPROBS",75,0)
+"RTN","C0CPROBS",71,0)
. ;S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14) ;NOT MAPPED IN C0CCCR0
-"RTN","C0CPROBS",76,0)
+"RTN","C0CPROBS",72,0)
. ;S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,15),"DT") ;NOT MAPPED IN C0CCCR0
-"RTN","C0CPROBS",77,0)
+"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)
- . S ARYTMP=$NA(@TARYTMP@(J))
+ . I J=1 D ; FIRST ONE IS JUST A COPY
"RTN","C0CPROBS",79,0)
- . ; W "ARYTMP= ",ARYTMP,!
+ . . ; W "FIRST ONE",!
"RTN","C0CPROBS",80,0)
- . K @ARYTMP
+ . . D CP^C0CXPATH(ARYTMP,OUTXML)
"RTN","C0CPROBS",81,0)
- . D MAP^C0CXPATH(IPXML,VMAP,ARYTMP) ;
+ . . ; W "OUTXML ",OUTXML,!
"RTN","C0CPROBS",82,0)
- . I J=1 D ; FIRST ONE IS JUST A COPY
+ . I J>1 D ; AFTER THE FIRST, INSERT INNER XML
"RTN","C0CPROBS",83,0)
- . . ; W "FIRST ONE",!
+ . . D INSINNER^C0CXPATH(OUTXML,ARYTMP)
"RTN","C0CPROBS",84,0)
- . . D CP^C0CXPATH(ARYTMP,OUTXML)
+ ; ZWR ^TMP("C0CCCR",$J,"PROBVALS",*)
"RTN","C0CPROBS",85,0)
- . . ; W "OUTXML ",OUTXML,!
+ ; ZWR ^TMP("C0CCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
"RTN","C0CPROBS",86,0)
- . I J>1 D ; AFTER THE FIRST, INSERT INNER XML
+ ; ZWR @OUTXML
"RTN","C0CPROBS",87,0)
- . . D INSINNER^C0CXPATH(OUTXML,ARYTMP)
+ ; $$HTML^DILF(
"RTN","C0CPROBS",88,0)
- ; ZWR ^TMP("C0CCCR",$J,"PROBVALS",*)
+ ; GENERATE THE NARITIVE HTML FOR THE CCD
"RTN","C0CPROBS",89,0)
- ; ZWR ^TMP("C0CCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
+ I CCD D CCD ; IF THIS IS FOR A CCD
"RTN","C0CPROBS",90,0)
- ; ZWR @OUTXML
+ D MISSVARS
"RTN","C0CPROBS",91,0)
- ; $$HTML^DILF(
+ Q
"RTN","C0CPROBS",92,0)
- ; GENERATE THE NARITIVE HTML FOR THE CCD
-"RTN","C0CPROBS",93,0)
- I CCD D CCD ; IF THIS IS FOR A CCD
-"RTN","C0CPROBS",94,0)
- D MISSINGVARS
-"RTN","C0CPROBS",95,0)
- Q
-"RTN","C0CPROBS",96,0)
;
-"RTN","C0CPROBS",97,0)
+"RTN","C0CPROBS",93,0)
VISTA ; GETS THE PROBLEM LIST FOR VISTA
-"RTN","C0CPROBS",98,0)
+"RTN","C0CPROBS",94,0)
D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC
-"RTN","C0CPROBS",99,0)
+"RTN","C0CPROBS",95,0)
I '$D(RPCRSLT(1)) D Q ; RPC RETURNS NULL
-"RTN","C0CPROBS",100,0)
+"RTN","C0CPROBS",96,0)
. W "NULL RESULT FROM LIST^ORQQPL3 ",!
-"RTN","C0CPROBS",101,0)
+"RTN","C0CPROBS",97,0)
. S @OUTXML@(0)=0
-"RTN","C0CPROBS",102,0)
+"RTN","C0CPROBS",98,0)
. ; Q
-"RTN","C0CPROBS",103,0)
+"RTN","C0CPROBS",99,0)
; I DEBUG ZWR RPCRSLT
-"RTN","C0CPROBS",104,0)
+"RTN","C0CPROBS",100,0)
S @TVMAP@(0)=RPCRSLT(0) ; SAVE NUMBER OF PROBLEMS
-"RTN","C0CPROBS",105,0)
+"RTN","C0CPROBS",101,0)
F J=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM IN THE LIST
-"RTN","C0CPROBS",106,0)
+"RTN","C0CPROBS",102,0)
. S VMAP=$NA(@TVMAP@(J))
-"RTN","C0CPROBS",107,0)
+"RTN","C0CPROBS",103,0)
. K @VMAP
-"RTN","C0CPROBS",108,0)
+"RTN","C0CPROBS",104,0)
. I DEBUG W "VMAP= ",VMAP,!
-"RTN","C0CPROBS",109,0)
+"RTN","C0CPROBS",105,0)
. S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
-"RTN","C0CPROBS",110,0)
+"RTN","C0CPROBS",106,0)
. S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
-"RTN","C0CPROBS",111,0)
+"RTN","C0CPROBS",107,0)
. S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
-"RTN","C0CPROBS",112,0)
+"RTN","C0CPROBS",108,0)
. S @VMAP@("PROBLEMSTATUS")=$S($P(PTMP,U,2)="A":"Active",$P(PTMP,U,2)="I":"Inactive",1:"")
-"RTN","C0CPROBS",113,0)
+"RTN","C0CPROBS",109,0)
. N ZPRIOR S ZPRIOR=$P(PTMP,U,14) ;PRIORITY FLAG
-"RTN","C0CPROBS",114,0)
+"RTN","C0CPROBS",110,0)
. ; turn off acute/chronic for certification gpl
-"RTN","C0CPROBS",115,0)
+"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",116,0)
+"RTN","C0CPROBS",112,0)
. S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
-"RTN","C0CPROBS",117,0)
+"RTN","C0CPROBS",113,0)
. S @VMAP@("PROBLEMCODINGVERSION")=""
-"RTN","C0CPROBS",118,0)
+"RTN","C0CPROBS",114,0)
. S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
-"RTN","C0CPROBS",119,0)
+"RTN","C0CPROBS",115,0)
. ; FOR CERTIFICATION - GPL
-"RTN","C0CPROBS",120,0)
+"RTN","C0CPROBS",116,0)
. I @VMAP@("PROBLEMCODEVALUE")["493.90" S @VMAP@("PROBLEMCODEVALUE")=493
-"RTN","C0CPROBS",121,0)
+"RTN","C0CPROBS",117,0)
. S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,5),"DT")
-"RTN","C0CPROBS",122,0)
+"RTN","C0CPROBS",118,0)
. S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,6),"DT")
-"RTN","C0CPROBS",123,0)
+"RTN","C0CPROBS",119,0)
. S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
-"RTN","C0CPROBS",124,0)
+"RTN","C0CPROBS",120,0)
. S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
-"RTN","C0CPROBS",125,0)
+"RTN","C0CPROBS",121,0)
. S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
-"RTN","C0CPROBS",126,0)
+"RTN","C0CPROBS",122,0)
. S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
-"RTN","C0CPROBS",127,0)
+"RTN","C0CPROBS",123,0)
. S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
-"RTN","C0CPROBS",128,0)
+"RTN","C0CPROBS",124,0)
. S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
-"RTN","C0CPROBS",129,0)
+"RTN","C0CPROBS",125,0)
. S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
-"RTN","C0CPROBS",130,0)
+"RTN","C0CPROBS",126,0)
. S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
-"RTN","C0CPROBS",131,0)
+"RTN","C0CPROBS",127,0)
. S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
-"RTN","C0CPROBS",132,0)
+"RTN","C0CPROBS",128,0)
. S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
-"RTN","C0CPROBS",133,0)
+"RTN","C0CPROBS",129,0)
. S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,15),"DT")
-"RTN","C0CPROBS",134,0)
+"RTN","C0CPROBS",130,0)
. S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,16),"DT")
-"RTN","C0CPROBS",135,0)
+"RTN","C0CPROBS",131,0)
. S ARYTMP=$NA(@TARYTMP@(J))
-"RTN","C0CPROBS",136,0)
+"RTN","C0CPROBS",132,0)
. ; W "ARYTMP= ",ARYTMP,!
-"RTN","C0CPROBS",137,0)
+"RTN","C0CPROBS",133,0)
. K @ARYTMP
-"RTN","C0CPROBS",138,0)
+"RTN","C0CPROBS",134,0)
. D MAP^C0CXPATH(IPXML,VMAP,ARYTMP) ;
-"RTN","C0CPROBS",139,0)
+"RTN","C0CPROBS",135,0)
. I J=1 D ; FIRST ONE IS JUST A COPY
-"RTN","C0CPROBS",140,0)
+"RTN","C0CPROBS",136,0)
. . ; W "FIRST ONE",!
-"RTN","C0CPROBS",141,0)
+"RTN","C0CPROBS",137,0)
. . D CP^C0CXPATH(ARYTMP,OUTXML)
-"RTN","C0CPROBS",142,0)
+"RTN","C0CPROBS",138,0)
. . ; W "OUTXML ",OUTXML,!
-"RTN","C0CPROBS",143,0)
+"RTN","C0CPROBS",139,0)
. I J>1 D ; AFTER THE FIRST, INSERT INNER XML
-"RTN","C0CPROBS",144,0)
+"RTN","C0CPROBS",140,0)
. . D INSINNER^C0CXPATH(OUTXML,ARYTMP)
-"RTN","C0CPROBS",145,0)
+"RTN","C0CPROBS",141,0)
; ZWR ^TMP("C0CCCR",$J,"PROBVALS",*)
-"RTN","C0CPROBS",146,0)
+"RTN","C0CPROBS",142,0)
; ZWR ^TMP("C0CCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
-"RTN","C0CPROBS",147,0)
+"RTN","C0CPROBS",143,0)
; ZWR @OUTXML
-"RTN","C0CPROBS",148,0)
+"RTN","C0CPROBS",144,0)
; $$HTML^DILF(
-"RTN","C0CPROBS",149,0)
+"RTN","C0CPROBS",145,0)
; GENERATE THE NARITIVE HTML FOR THE CCD
-"RTN","C0CPROBS",150,0)
+"RTN","C0CPROBS",146,0)
I CCD D CCD ; IF THIS IS FOR A CCD
-"RTN","C0CPROBS",151,0)
- D MISSINGVARS
-"RTN","C0CPROBS",152,0)
+"RTN","C0CPROBS",147,0)
+ D MISSVARS
+"RTN","C0CPROBS",148,0)
Q
-"RTN","C0CPROBS",153,0)
-CCD
-"RTN","C0CPROBS",154,0)
+"RTN","C0CPROBS",149,0)
+CCD ;
+"RTN","C0CPROBS",150,0)
N HTMP,HOUT,HTMLO,C0CPROBI,ZX
-"RTN","C0CPROBS",155,0)
+"RTN","C0CPROBS",151,0)
F C0CPROBI=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM
-"RTN","C0CPROBS",156,0)
+"RTN","C0CPROBS",152,0)
. S VMAP=$NA(@TVMAP@(C0CPROBI))
-"RTN","C0CPROBS",157,0)
+"RTN","C0CPROBS",153,0)
. I DEBUG W "VMAP =",VMAP,!
-"RTN","C0CPROBS",158,0)
+"RTN","C0CPROBS",154,0)
. D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
-"RTN","C0CPROBS",159,0)
+"RTN","C0CPROBS",155,0)
. D UNMARK^C0CXPATH("HTMP") ; REMOVE MARKUP
-"RTN","C0CPROBS",160,0)
+"RTN","C0CPROBS",156,0)
. ; D PARY^C0CXPATH("HTMP") ; PRINT IT
-"RTN","C0CPROBS",161,0)
+"RTN","C0CPROBS",157,0)
. D MAP^C0CXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES
-"RTN","C0CPROBS",162,0)
+"RTN","C0CPROBS",158,0)
. ; D PARY^C0CXPATH("HOUT") ; PRINT IT AGAIN
-"RTN","C0CPROBS",163,0)
+"RTN","C0CPROBS",159,0)
. I C0CPROBI=1 D ; FIRST ONE IS JUST A COPY
-"RTN","C0CPROBS",164,0)
+"RTN","C0CPROBS",160,0)
. . D CP^C0CXPATH("HOUT","HTMLO")
-"RTN","C0CPROBS",165,0)
+"RTN","C0CPROBS",161,0)
. I C0CPROBI>1 D ; AFTER THE FIRST, INSERT INNER HTML
-"RTN","C0CPROBS",166,0)
+"RTN","C0CPROBS",162,0)
. . I DEBUG W "DOING INNER",!
-"RTN","C0CPROBS",167,0)
+"RTN","C0CPROBS",163,0)
. . N HTMLBLD,HTMLTMP
-"RTN","C0CPROBS",168,0)
+"RTN","C0CPROBS",164,0)
. . D QUEUE^C0CXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
-"RTN","C0CPROBS",169,0)
+"RTN","C0CPROBS",165,0)
. . D QUEUE^C0CXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
-"RTN","C0CPROBS",170,0)
+"RTN","C0CPROBS",166,0)
. . D QUEUE^C0CXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))
-"RTN","C0CPROBS",171,0)
+"RTN","C0CPROBS",167,0)
. . D BUILD^C0CXPATH("HTMLBLD","HTMLTMP")
-"RTN","C0CPROBS",172,0)
+"RTN","C0CPROBS",168,0)
. . D CP^C0CXPATH("HTMLTMP","HTMLO")
-"RTN","C0CPROBS",173,0)
+"RTN","C0CPROBS",169,0)
. . ; D INSINNER^C0CXPATH("HOUT","HTMLO","//")
-"RTN","C0CPROBS",174,0)
+"RTN","C0CPROBS",170,0)
I DEBUG D PARY^C0CXPATH("HTMLO")
-"RTN","C0CPROBS",175,0)
+"RTN","C0CPROBS",171,0)
D INSB4^C0CXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
-"RTN","C0CPROBS",176,0)
+"RTN","C0CPROBS",172,0)
Q
-"RTN","C0CPROBS",177,0)
-MISSINGVARS
-"RTN","C0CPROBS",178,0)
+"RTN","C0CPROBS",173,0)
+MISSVARS ; Missing Variables
+"RTN","C0CPROBS",174,0)
N PROBSTMP,I
-"RTN","C0CPROBS",179,0)
+"RTN","C0CPROBS",175,0)
D MISSING^C0CXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","C0CPROBS",180,0)
+"RTN","C0CPROBS",176,0)
I PROBSTMP(0)>0 D ; IF THERE ARE MISSING VARS -
-"RTN","C0CPROBS",181,0)
+"RTN","C0CPROBS",177,0)
. ; STRINGS MARKED AS @@X@@
-"RTN","C0CPROBS",182,0)
+"RTN","C0CPROBS",178,0)
. W !,"PROBLEMS Missing list: ",!
-"RTN","C0CPROBS",183,0)
+"RTN","C0CPROBS",179,0)
. F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
-"RTN","C0CPROBS",184,0)
+"RTN","C0CPROBS",180,0)
Q
-"RTN","C0CPROBS",185,0)
+"RTN","C0CPROBS",181,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
-"RTN","C0CPROC",10,0)
- ;(at your option) any later version.
-"RTN","C0CPROC",11,0)
;
+"RTN","C0CPROC",9,0)
+ ; This program is distributed in the hope that it will be useful,
+"RTN","C0CPROC",10,0)
+ ; 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 .
"RTN","C0CPROC",16,0)
;
"RTN","C0CPROC",17,0)
- ;You should have received a copy of the GNU General Public License along
-"RTN","C0CPROC",18,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
-"RTN","C0CPROC",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","C0CPROC",20,0)
- ;
-"RTN","C0CPROC",21,0)
W "NO ENTRY FROM TOP",!
-"RTN","C0CPROC",22,0)
+"RTN","C0CPROC",18,0)
Q
-"RTN","C0CPROC",23,0)
+"RTN","C0CPROC",19,0)
;
-"RTN","C0CPROC",24,0)
+"RTN","C0CPROC",20,0)
SETVARS ; SET UP VARIABLES FOR PROCEDURES, ENCOUNTERS, AND NOTES
-"RTN","C0CPROC",25,0)
+"RTN","C0CPROC",21,0)
S C0CENC=$NA(^TMP("C0CCCR",$J,"C0CENC",DFN))
-"RTN","C0CPROC",26,0)
+"RTN","C0CPROC",22,0)
S C0CPRC=$NA(^TMP("C0CCCR",$J,"C0CPRC",DFN))
-"RTN","C0CPROC",27,0)
+"RTN","C0CPROC",23,0)
S C0CNTE=$NA(^TMP("C0CCCR",$J,"C0CNTE",DFN))
-"RTN","C0CPROC",28,0)
+"RTN","C0CPROC",24,0)
; ADDITION FOR CERTIFICATION
-"RTN","C0CPROC",29,0)
+"RTN","C0CPROC",25,0)
S C0CPRSLT=$NA(^TMP("C0CCCR",$J,"C0CPRSLT",DFN))
-"RTN","C0CPROC",30,0)
+"RTN","C0CPROC",26,0)
Q
-"RTN","C0CPROC",31,0)
+"RTN","C0CPROC",27,0)
;
-"RTN","C0CPROC",32,0)
+"RTN","C0CPROC",28,0)
EXTRACT(PROCXML,DFN,PROCOUT) ; EXTRACT PROCEDURES INTO XML TEMPLATE
-"RTN","C0CPROC",33,0)
+"RTN","C0CPROC",29,0)
; PROCXML AND PROCOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","C0CPROC",34,0)
+"RTN","C0CPROC",30,0)
;
-"RTN","C0CPROC",35,0)
+"RTN","C0CPROC",31,0)
D SETVARS ; SET UP VARIABLES
-"RTN","C0CPROC",36,0)
+"RTN","C0CPROC",32,0)
I '$D(@C0CPRC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE
-"RTN","C0CPROC",37,0)
+"RTN","C0CPROC",33,0)
D MAP(PROCXML,C0CPRC,PROCOUT) ;MAP RESULTS FOR PROCEDURES
-"RTN","C0CPROC",38,0)
+"RTN","C0CPROC",34,0)
Q
-"RTN","C0CPROC",39,0)
+"RTN","C0CPROC",35,0)
;
-"RTN","C0CPROC",40,0)
+"RTN","C0CPROC",36,0)
TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES,
-"RTN","C0CPROC",41,0)
+"RTN","C0CPROC",37,0)
; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
-"RTN","C0CPROC",42,0)
+"RTN","C0CPROC",38,0)
; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES
-"RTN","C0CPROC",43,0)
+"RTN","C0CPROC",39,0)
; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT
-"RTN","C0CPROC",44,0)
+"RTN","C0CPROC",40,0)
; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY
-"RTN","C0CPROC",45,0)
+"RTN","C0CPROC",41,0)
; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM
-"RTN","C0CPROC",46,0)
+"RTN","C0CPROC",42,0)
; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS
-"RTN","C0CPROC",47,0)
+"RTN","C0CPROC",43,0)
;
-"RTN","C0CPROC",48,0)
+"RTN","C0CPROC",44,0)
K VISIT,LST,NOTE,C0CLPRC
-"RTN","C0CPROC",49,0)
+"RTN","C0CPROC",45,0)
; C0CLPRC IS A LOOKUP TABLE FOR USE IN BUILDING ENCOUNTERS
-"RTN","C0CPROC",50,0)
+"RTN","C0CPROC",46,0)
; FORMAT C0CLPRC(VISITIEN,CPT)=PROCOBJECTID FOR BUILDING LINKS TO PROCEDURES
-"RTN","C0CPROC",51,0)
+"RTN","C0CPROC",47,0)
D ENTRY^C0CCPT(DFN,,,1) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE
-"RTN","C0CPROC",52,0)
+"RTN","C0CPROC",48,0)
; NEED TO ADD START AND END DATES FROM PARAMETERS
-"RTN","C0CPROC",53,0)
+"RTN","C0CPROC",49,0)
N ZI S ZI=""
-"RTN","C0CPROC",54,0)
+"RTN","C0CPROC",50,0)
N PREVCPT,PREVDT S (PREVCPT,PREVDT)=""
-"RTN","C0CPROC",55,0)
+"RTN","C0CPROC",51,0)
F S ZI=$O(VISIT(ZI),-1) Q:ZI="" D ; REVERSE TIME ORDER - MOST RECENT FIRST
-"RTN","C0CPROC",56,0)
+"RTN","C0CPROC",52,0)
. N ZDATE
-"RTN","C0CPROC",57,0)
+"RTN","C0CPROC",53,0)
. S ZDATE=$$DATE(VISIT(ZI,"DATE",0))
-"RTN","C0CPROC",58,0)
+"RTN","C0CPROC",54,0)
. S ZPRVARY=$NA(VISIT(ZI,"PRV"))
-"RTN","C0CPROC",59,0)
+"RTN","C0CPROC",55,0)
. N ZPRV
-"RTN","C0CPROC",60,0)
+"RTN","C0CPROC",56,0)
. S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM
-"RTN","C0CPROC",61,0)
+"RTN","C0CPROC",57,0)
. ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON
-"RTN","C0CPROC",62,0)
+"RTN","C0CPROC",58,0)
. N ZJ S ZJ=""
-"RTN","C0CPROC",63,0)
+"RTN","C0CPROC",59,0)
. F S ZJ=$O(VISIT(ZI,"CPT",ZJ)) Q:ZJ="" D ;FOR EACH CPT SEG
-"RTN","C0CPROC",64,0)
+"RTN","C0CPROC",60,0)
. . N ZRNF
-"RTN","C0CPROC",65,0)
+"RTN","C0CPROC",61,0)
. . N ZCPT S ZCPT=$$CPT(VISIT(ZI,"CPT",ZJ)) ;GET CPT CODE AND TEXT
-"RTN","C0CPROC",66,0)
+"RTN","C0CPROC",62,0)
. . I ZCPT'="" D ;IF CPT CODE IS PRESENT
-"RTN","C0CPROC",67,0)
+"RTN","C0CPROC",63,0)
. . . I (ZCPT=PREVCPT)&(ZDATE=PREVDT) Q ; NO DUPS ALLOWED
-"RTN","C0CPROC",68,0)
+"RTN","C0CPROC",64,0)
. . . W !,ZCPT," ",ZDATE," ",ZPRV
-"RTN","C0CPROC",69,0)
+"RTN","C0CPROC",65,0)
. . . S ZRNF("PROCACTOROBJID")=ZPRV
-"RTN","C0CPROC",70,0)
+"RTN","C0CPROC",66,0)
. . . N PROCCODE S PROCCODE=$P(ZCPT,U,1)
-"RTN","C0CPROC",71,0)
+"RTN","C0CPROC",67,0)
. . . S ZRNF("PROCCODE")=PROCCODE
-"RTN","C0CPROC",72,0)
+"RTN","C0CPROC",68,0)
. . . S ZRNF("PROCCODESYS")="CPT-4"
-"RTN","C0CPROC",73,0)
+"RTN","C0CPROC",69,0)
. . . S ZRNF("PROCDATETEXT")="Procedure Date"
-"RTN","C0CPROC",74,0)
+"RTN","C0CPROC",70,0)
. . . S ZRNF("PROCDATETIME")=ZDATE
-"RTN","C0CPROC",75,0)
+"RTN","C0CPROC",71,0)
. . . S ZRNF("PROCDESCOBJATTRCODE")="" ;NO PROC ATTRIBUTES YET
-"RTN","C0CPROC",76,0)
+"RTN","C0CPROC",72,0)
. . . S ZRNF("PROCDESCOBJATTR")=""
-"RTN","C0CPROC",77,0)
+"RTN","C0CPROC",73,0)
. . . S ZRNF("PROCDESCOBJATTRCODESYS")="" ;WE DON'T HAVE PROC ATTRIBUTES
-"RTN","C0CPROC",78,0)
+"RTN","C0CPROC",74,0)
. . . S ZRNF("PROCDESCOBJATTRVAL")=""
-"RTN","C0CPROC",79,0)
+"RTN","C0CPROC",75,0)
. . . S ZRNF("PROCDESCTEXT")=$P(ZCPT,U,3)
-"RTN","C0CPROC",80,0)
+"RTN","C0CPROC",76,0)
. . . S ZRNF("PROCLINKID")="" ; NO LINKS YET
-"RTN","C0CPROC",81,0)
+"RTN","C0CPROC",77,0)
. . . S ZRNF("PROCLINKREL")="" ; NO LINKS YET
-"RTN","C0CPROC",82,0)
+"RTN","C0CPROC",78,0)
. . . ; additions for Certification - need to have EKG in Results
-"RTN","C0CPROC",83,0)
+"RTN","C0CPROC",79,0)
. . . S ZRNF("PROCTEXT")=$G(VISIT(ZI,"TEXT",1)) ; POTENTIAL RESULT
-"RTN","C0CPROC",84,0)
+"RTN","C0CPROC",80,0)
. . . S ZRNF("PROCOBJECTID")="PROCEDURE_"_ZI_"_"_ZJ
-"RTN","C0CPROC",85,0)
+"RTN","C0CPROC",81,0)
. . . S C0CLPRC(ZI,PROCCODE)=ZRNF("PROCOBJECTID") ; LOOKUP TABLE FOR ENCOUNTERS
-"RTN","C0CPROC",86,0)
+"RTN","C0CPROC",82,0)
. . . S ZRNF("PROCSTATUS")="Completed" ; Is this right?
-"RTN","C0CPROC",87,0)
+"RTN","C0CPROC",83,0)
. . . S ZRNF("PROCTYPE")=$P(ZCPT,U,2) ; NEED TO ADD THIS TO TEMPLATE
-"RTN","C0CPROC",88,0)
+"RTN","C0CPROC",84,0)
. . . D RNF1TO2^C0CRNF(C0CPRC,"ZRNF") ; ADD THIS ROW TO THE ARRAY
-"RTN","C0CPROC",89,0)
+"RTN","C0CPROC",85,0)
. . . ; FOR CERTIFICATION - SAVE EKG RESULTS gpl
-"RTN","C0CPROC",90,0)
+"RTN","C0CPROC",86,0)
. . . W !,"CPT=",ZCPT
-"RTN","C0CPROC",91,0)
+"RTN","C0CPROC",87,0)
. . . I ZCPT["93000" D ; THIS IS AN EKG
-"RTN","C0CPROC",92,0)
+"RTN","C0CPROC",88,0)
. . . . D RNF1TO2^C0CRNF(C0CPRSLT,"ZRNF") ; SAVE FOR LABS
-"RTN","C0CPROC",93,0)
+"RTN","C0CPROC",89,0)
. . . . M ^GPL("RNF2")=@C0CPRSLT
-"RTN","C0CPROC",94,0)
+"RTN","C0CPROC",90,0)
. . . S PREVCPT=ZCPT
-"RTN","C0CPROC",95,0)
+"RTN","C0CPROC",91,0)
. . . S PREVDT=ZDATE
-"RTN","C0CPROC",96,0)
+"RTN","C0CPROC",92,0)
N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"PROCEDURES"))
-"RTN","C0CPROC",97,0)
+"RTN","C0CPROC",93,0)
M @ZRIM=@C0CPRC@("V")
-"RTN","C0CPROC",98,0)
+"RTN","C0CPROC",94,0)
Q
-"RTN","C0CPROC",99,0)
+"RTN","C0CPROC",95,0)
;
-"RTN","C0CPROC",100,0)
+"RTN","C0CPROC",96,0)
PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME
-"RTN","C0CPROC",101,0)
+"RTN","C0CPROC",97,0)
N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN=""
-"RTN","C0CPROC",102,0)
+"RTN","C0CPROC",98,0)
F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH PRV SEG
-"RTN","C0CPROC",103,0)
+"RTN","C0CPROC",99,0)
. I ZR'="" Q ;ONLY WANT THE FIRST PRIMARY PROVIDER
-"RTN","C0CPROC",104,0)
+"RTN","C0CPROC",100,0)
. I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1)
-"RTN","C0CPROC",105,0)
+"RTN","C0CPROC",101,0)
I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR
-"RTN","C0CPROC",106,0)
+"RTN","C0CPROC",102,0)
Q ZRTN
-"RTN","C0CPROC",107,0)
+"RTN","C0CPROC",103,0)
;
-"RTN","C0CPROC",108,0)
+"RTN","C0CPROC",104,0)
DATE(ISTR) ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT
-"RTN","C0CPROC",109,0)
+"RTN","C0CPROC",105,0)
Q $$FMDTOUTC^C0CUTIL(ISTR,"DT")
-"RTN","C0CPROC",110,0)
+"RTN","C0CPROC",106,0)
;
-"RTN","C0CPROC",111,0)
+"RTN","C0CPROC",107,0)
CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS
-"RTN","C0CPROC",112,0)
+"RTN","C0CPROC",108,0)
; CPT^CATEGORY^TEXT
-"RTN","C0CPROC",113,0)
+"RTN","C0CPROC",109,0)
N Z1,Z2,Z3,ZRTN
-"RTN","C0CPROC",114,0)
- S Z1=$P(ISTR,U,1)
-"RTN","C0CPROC",115,0)
+"RTN","C0CPROC",110,0)
+ S Z1=$P(ISTR,U,1)
+"RTN","C0CPROC",111,0)
I Z1="" D ;
-"RTN","C0CPROC",116,0)
+"RTN","C0CPROC",112,0)
. I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)
-"RTN","C0CPROC",117,0)
+"RTN","C0CPROC",113,0)
I Z1'="" D ; IF THERE IS A CPT CODE IN THERE
-"RTN","C0CPROC",118,0)
+"RTN","C0CPROC",114,0)
. ;S Z1=$P(ISTR,U,1)
-"RTN","C0CPROC",119,0)
+"RTN","C0CPROC",115,0)
. S Z2=$P(ISTR,U,2)
-"RTN","C0CPROC",120,0)
+"RTN","C0CPROC",116,0)
. S Z3=$P(ISTR,U,3)
-"RTN","C0CPROC",121,0)
+"RTN","C0CPROC",117,0)
. S ZRTN=Z1_U_Z2_U_Z3
-"RTN","C0CPROC",122,0)
+"RTN","C0CPROC",118,0)
E S ZRTN=""
-"RTN","C0CPROC",123,0)
+"RTN","C0CPROC",119,0)
Q ZRTN
-"RTN","C0CPROC",124,0)
+"RTN","C0CPROC",120,0)
;
-"RTN","C0CPROC",125,0)
+"RTN","C0CPROC",121,0)
MAP(PROCXML,C0CPRC,PROCOUT) ; MAP PROCEDURES XML
-"RTN","C0CPROC",126,0)
+"RTN","C0CPROC",122,0)
;
-"RTN","C0CPROC",127,0)
+"RTN","C0CPROC",123,0)
N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"PROCTEMP")) ;WORK AREA FOR TEMPLATE
-"RTN","C0CPROC",128,0)
+"RTN","C0CPROC",124,0)
K @ZTEMP
-"RTN","C0CPROC",129,0)
+"RTN","C0CPROC",125,0)
N ZBLD
-"RTN","C0CPROC",130,0)
+"RTN","C0CPROC",126,0)
S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"PROCBLD")) ; BUILD LIST AREA
-"RTN","C0CPROC",131,0)
+"RTN","C0CPROC",127,0)
D QUEUE^C0CXPATH(ZBLD,PROCXML,1,1) ; FIRST LINE
-"RTN","C0CPROC",132,0)
+"RTN","C0CPROC",128,0)
N ZINNER
-"RTN","C0CPROC",133,0)
+"RTN","C0CPROC",129,0)
D QUERY^C0CXPATH(PROCXML,"//Procedures/Procedure","ZINNER") ;ONE PROC
-"RTN","C0CPROC",134,0)
+"RTN","C0CPROC",130,0)
N ZTMP,ZVAR,ZI
-"RTN","C0CPROC",135,0)
+"RTN","C0CPROC",131,0)
S ZI=""
-"RTN","C0CPROC",136,0)
+"RTN","C0CPROC",132,0)
F S ZI=$O(@C0CPRC@("V",ZI)) Q:ZI="" D ;FOR EACH PROCEDURE
-"RTN","C0CPROC",137,0)
+"RTN","C0CPROC",133,0)
. S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS PROCEDURE XML
-"RTN","C0CPROC",138,0)
+"RTN","C0CPROC",134,0)
. S ZVAR=$NA(@C0CPRC@("V",ZI)) ;THIS PROCEDURE VARIABLES
-"RTN","C0CPROC",139,0)
+"RTN","C0CPROC",135,0)
. D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
-"RTN","C0CPROC",140,0)
+"RTN","C0CPROC",136,0)
. D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
-"RTN","C0CPROC",141,0)
+"RTN","C0CPROC",137,0)
D QUEUE^C0CXPATH(ZBLD,PROCXML,@PROCXML@(0),@PROCXML@(0))
-"RTN","C0CPROC",142,0)
+"RTN","C0CPROC",138,0)
N ZZTMP
-"RTN","C0CPROC",143,0)
+"RTN","C0CPROC",139,0)
D BUILD^C0CXPATH(ZBLD,PROCOUT) ;BUILD FINAL XML
-"RTN","C0CPROC",144,0)
+"RTN","C0CPROC",140,0)
K @ZTEMP,@ZBLD,@C0CPRC
-"RTN","C0CPROC",145,0)
+"RTN","C0CPROC",141,0)
Q
-"RTN","C0CPROC",146,0)
+"RTN","C0CPROC",142,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)
;
"RTN","C0CQRY1")
@@ -114699,7 +114705,7 @@ DOIT ;
"RTN","C0CQRY1",1,0)
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)
;
"RTN","C0CQRY1",4,0)
@@ -114943,12544 +114949,12744 @@ OBX ; Build OBX segment
"RTN","C0CQRY1",123,0)
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
"RTN","C0CQRY2",4,0)
;
"RTN","C0CQRY2",5,0)
- Q
+ ; (C) John McCormack 2009
"RTN","C0CQRY2",6,0)
;
"RTN","C0CQRY2",7,0)
-PATID ; Resolve patient id and establish patient environment
+ ; 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)
- N LA7X
+ ; 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)
- S (DFN,LRDFN)="",LA7PTYP=0
+ ;
"RTN","C0CQRY2",12,0)
- ;
+ ; This program is distributed in the hope that it will be useful,
"RTN","C0CQRY2",13,0)
- ; SSN passed as patient identifier
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0CQRY2",14,0)
- I LA7PTID?9N.1A D
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
"RTN","C0CQRY2",15,0)
- . S LA7PTYP=1
+ ; GNU Affero General Public License for more details.
"RTN","C0CQRY2",16,0)
- . S LA7X=$O(^DPT("SSN",LA7PTID,0))
-"RTN","C0CQRY2",17,0)
- . I LA7X>0 D SETDFN(LA7X)
-"RTN","C0CQRY2",18,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 .
"RTN","C0CQRY2",19,0)
- ; MPI/ICN (integration control number) passed as patient identifier
+ ;
"RTN","C0CQRY2",20,0)
- I LA7PTID?10N1"V"6N D
+ ;
"RTN","C0CQRY2",21,0)
- . S LA7PTYP=2
+ Q
"RTN","C0CQRY2",22,0)
- . S LA7X=$$GETDFN^MPIF001($P(LA7PTID,"V"))
+ ;
"RTN","C0CQRY2",23,0)
- . I LA7X>0 D SETDFN(LA7X)
+PATID ; Resolve patient id and establish patient environment
"RTN","C0CQRY2",24,0)
;
"RTN","C0CQRY2",25,0)
- ; If no patient identified/no laboratory record - return exception message
+ N LA7X
"RTN","C0CQRY2",26,0)
- I 'LA7PTYP S LA7ERR(1)="Invalid patient identifier passed"
+ ;
"RTN","C0CQRY2",27,0)
- I 'DFN S LA7ERR(2)="No patient found with requested identifier"
+ S (DFN,LRDFN)="",LA7PTYP=0
"RTN","C0CQRY2",28,0)
- I DFN,'LRDFN S LA7ERR(3)="No laboratory record for requested patient"
+ ;
"RTN","C0CQRY2",29,0)
- I LRDFN,'$D(^LR(LRDFN)) S LA7ERR(4)="Database error - missing laboratory record for requested patient"
+ ; SSN passed as patient identifier
"RTN","C0CQRY2",30,0)
- Q
+ I LA7PTID?9N.1A D
"RTN","C0CQRY2",31,0)
- ;
+ . S LA7PTYP=1
"RTN","C0CQRY2",32,0)
- ;
+ . S LA7X=$O(^DPT("SSN",LA7PTID,0))
"RTN","C0CQRY2",33,0)
-BCD ; Search by specimen collection date.
+ . I LA7X>0 D SETDFN(LA7X)
"RTN","C0CQRY2",34,0)
;
"RTN","C0CQRY2",35,0)
- N LA763,LA7QUIT
+ ; MPI/ICN (integration control number) passed as patient identifier
"RTN","C0CQRY2",36,0)
- ;
+ I LA7PTID?10N1"V"6N D
"RTN","C0CQRY2",37,0)
- S (LA7SDT(0),LA7EDT(0))=0
+ . S LA7PTYP=2
"RTN","C0CQRY2",38,0)
- I LA7SDT S LA7SDT(0)=9999999-LA7SDT
+ . S LA7X=$$GETDFN^MPIF001($P(LA7PTID,"V"))
"RTN","C0CQRY2",39,0)
- I LA7EDT S LA7EDT(0)=9999999-LA7EDT
+ . I LA7X>0 D SETDFN(LA7X)
"RTN","C0CQRY2",40,0)
;
"RTN","C0CQRY2",41,0)
- F LRSS="CH","MI","SP" D
+ ; If no patient identified/no laboratory record - return exception message
"RTN","C0CQRY2",42,0)
- . S (LA7QUIT,LRIDT)=0
+ I 'LA7PTYP S LA7ERR(1)="Invalid patient identifier passed"
"RTN","C0CQRY2",43,0)
- . I LA7EDT(0) S LRIDT=$O(^LR(LRDFN,LRSS,LA7EDT(0)),-1)
+ I 'DFN S LA7ERR(2)="No patient found with requested identifier"
"RTN","C0CQRY2",44,0)
- . F S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) Q:LA7QUIT D
+ I DFN,'LRDFN S LA7ERR(3)="No laboratory record for requested patient"
"RTN","C0CQRY2",45,0)
- . . ; Quit if reached end of data or outside date criteria
+ I LRDFN,'$D(^LR(LRDFN)) S LA7ERR(4)="Database error - missing laboratory record for requested patient"
"RTN","C0CQRY2",46,0)
- . . I 'LRIDT!(LRIDT>LA7SDT(0)) S LA7QUIT=1 Q
+ Q
"RTN","C0CQRY2",47,0)
- . . D SEARCH
+ ;
"RTN","C0CQRY2",48,0)
;
"RTN","C0CQRY2",49,0)
- Q
+BCD ; Search by specimen collection date.
"RTN","C0CQRY2",50,0)
;
"RTN","C0CQRY2",51,0)
- ;
+ N LA763,LA7QUIT
"RTN","C0CQRY2",52,0)
-BRAD ; Search by results available date (completion date).
+ ;
"RTN","C0CQRY2",53,0)
- ; Assumes cross-references still exist for dates in LRO(69) global.
+ S (LA7SDT(0),LA7EDT(0))=0
"RTN","C0CQRY2",54,0)
- ; Collects specimen date/time values for a given LRDFN and completion date.
+ I LA7SDT S LA7SDT(0)=9999999-LA7SDT
"RTN","C0CQRY2",55,0)
- ; Cross-reference is by date only, time stripped from start date.
+ I LA7EDT S LA7EDT(0)=9999999-LA7EDT
"RTN","C0CQRY2",56,0)
- ; Uses cross-reference ^LRO(69,DT,1,"AN",'LOCATION',LRDFN,LRIDT)=""
+ ;
"RTN","C0CQRY2",57,0)
- ;
+ F LRSS="CH","MI","SP" D
"RTN","C0CQRY2",58,0)
- N LA763,LA7DT,LA7ROOT,LA7SRC,X
+ . S (LA7QUIT,LRIDT)=0
"RTN","C0CQRY2",59,0)
- ;
+ . I LA7EDT(0) S LRIDT=$O(^LR(LRDFN,LRSS,LA7EDT(0)),-1)
"RTN","C0CQRY2",60,0)
- ; Check if orders still exist Iin file #69 for search range
+ . F S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) Q:LA7QUIT D
"RTN","C0CQRY2",61,0)
- S LA7SDT(1)=(LA7SDT\1)-.0000000001,LA7EDT(1)=(LA7EDT\1)+.24,LA7SRC=0
+ . . ; Quit if reached end of data or outside date criteria
"RTN","C0CQRY2",62,0)
- S X=$O(^LRO(69,LA7SDT(1)))
+ . . I 'LRIDT!(LRIDT>LA7SDT(0)) S LA7QUIT=1 Q
"RTN","C0CQRY2",63,0)
- I X,XLA7EDT(1)) D
-"RTN","C0CQRY2",69,0)
- . . S LA7ROOT="^LRO(69,LA7DT,1,""AN"")"
-"RTN","C0CQRY2",70,0)
- . . F S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT=""!($QS(LA7ROOT,2)'=LA7DT)!($QS(LA7ROOT,4)'="AN") D
-"RTN","C0CQRY2",71,0)
- . . . I $QS(LA7ROOT,6)'=LRDFN Q
-"RTN","C0CQRY2",72,0)
- . . . S LRIDT=$QS(LA7ROOT,7)
-"RTN","C0CQRY2",73,0)
- . . . F LRSS="CH","MI","SP" D SEARCH
-"RTN","C0CQRY2",74,0)
- ;
-"RTN","C0CQRY2",75,0)
- ; If no orders in #69 then do long search through file #63.
-"RTN","C0CQRY2",76,0)
- I 'LA7SRC D
-"RTN","C0CQRY2",77,0)
- . F LRSS="CH","MI","SP" D
-"RTN","C0CQRY2",78,0)
- . . S LRIDT=0
-"RTN","C0CQRY2",79,0)
- . . F S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) Q:'LRIDT D
-"RTN","C0CQRY2",80,0)
- . . . S LA763(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
-"RTN","C0CQRY2",81,0)
- . . . I $P(LA763(0),"^",3)>LA7SDT(1),$P(LA763(0),"^",3)LA7EDT(1)) D
"RTN","C0CQRY2",85,0)
- ;
+ . . S LA7ROOT="^LRO(69,LA7DT,1,""AN"")"
"RTN","C0CQRY2",86,0)
-SEARCH ; Search subscript for a specific collection date/time
+ . . F S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT=""!($QS(LA7ROOT,2)'=LA7DT)!($QS(LA7ROOT,4)'="AN") D
"RTN","C0CQRY2",87,0)
- ;
+ . . . I $QS(LA7ROOT,6)'=LRDFN Q
"RTN","C0CQRY2",88,0)
- K LA763
+ . . . S LRIDT=$QS(LA7ROOT,7)
"RTN","C0CQRY2",89,0)
- S LA763(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
+ . . . F LRSS="CH","MI","SP" D SEARCH
"RTN","C0CQRY2",90,0)
;
"RTN","C0CQRY2",91,0)
- ; Only CH, MI, and BB subscripts store pointer to file #61 in 5th piece of zeroth node.
+ ; If no orders in #69 then do long search through file #63.
"RTN","C0CQRY2",92,0)
- ; Quit if specific specimen codes and they do not match
+ I 'LA7SRC D
"RTN","C0CQRY2",93,0)
- I "CHMIBB"[LRSS S LA761=+$P(LA763(0),"^",5)
+ . F LRSS="CH","MI","SP" D
"RTN","C0CQRY2",94,0)
- E S LA761=0
+ . . S LRIDT=0
"RTN","C0CQRY2",95,0)
- I LA761,$D(^TMP("LA7-61",$J)),'$D(^TMP("LA7-61",$J,LA761)) Q
+ . . F S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) Q:'LRIDT D
"RTN","C0CQRY2",96,0)
- ;
+ . . . S LA763(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
"RTN","C0CQRY2",97,0)
- ; --- Chemistry
+ . . . I $P(LA763(0),"^",3)>LA7SDT(1),$P(LA763(0),"^",3)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 .
"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)
-OBXRPT ;Compile 'OBX' Segment for Radiology Report Text
+ S $P(X1,HLFS,35)="" I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) D
"RTN","C0CRAHL7",119,0)
- N RATX
+ .S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) I X2']"" Q
"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
+ .S X2=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",X2,0)) I X2']"" 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)
+ .S XX2=$$GET1^DIQ(200,X2,.01) Q:XX2']""
"RTN","C0CRAHL7",122,0)
- S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_$G(RATX) D OBX11^RAHLRU
+ .S Y=$$HLNAME^HLFNC(XX2) I Y']"" Q
"RTN","C0CRAHL7",123,0)
- Q
+ .S $P(X1,HLFS,35)=X2_$E(HLECH)_Y
"RTN","C0CRAHL7",124,0)
-PID ;Compile 'PID' Segment
+ ;Transcriptionist
"RTN","C0CRAHL7",125,0)
- ;
+ S $P(X1,HLFS,36)="" I $G(^RARPT(RARPT,"T")) D
"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
+ .S X2=$$GET1^DIQ(200,^RARPT(RARPT,"T"),.01) I X2']"" Q
"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
+ .S Y=$$HLNAME^HLFNC(X2) I Y']"" Q
"RTN","C0CRAHL7",128,0)
- Q
+ .S $P(X1,HLFS,36)=^RARPT(RARPT,"T")_$E(HLECH)_Y
"RTN","C0CRAHL7",129,0)
-SETUP ; Setup basic examination information
+ ;
"RTN","C0CRAHL7",130,0)
- S:RASET RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
+ S RAN=RAN+1
"RTN","C0CRAHL7",131,0)
- S RADTE0=9999999.9999-RADTI,RADTECN=$E(RADTE0,4,7)_$E(RADTE0,2,3)_"-"_+RACN0,RARPT0=^RARPT(RARPT,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 RAPROC=+$P(RACN0,U,2),RAPROCIT=+$P($G(^RAMIS(71,RAPROC,0)),U,12),RAPROCIT=$P(^RA(79.2,RAPROCIT,0),U,1)
+ S HLA("HLS",RAN)=X1
"RTN","C0CRAHL7",133,0)
- S RAPRCNDE=$G(^RAMIS(71,+RAPROC,0)),RACPT=+$P(RAPRCNDE,U,9)
+ Q
"RTN","C0CRAHL7",134,0)
- S RACPTNDE=$$NAMCODE^RACPTMSC(RACPT,DT)
+OBXRPT ;Compile 'OBX' Segment for Radiology Report Text
"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 .
"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))=""!($G(C0COXML(C0CRES))="")
+ 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)=""
+ 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))=""!($G(C0COXML(C0CRES))="")
"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)=""
"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) ;
+ 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
+ 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
+ ; TO IMPROVE PERFORMANCE
"RTN","C0CRARPT",81,0)
- . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;
+ D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;
"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) ;
+ . 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)) ;
+ . 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
"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
"RTN","C0CRARPT",97,0)
- ;S C0CQT=QTSAV ; RESET SILENT FLAG
+ . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;
"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) ;
"RTN","C0CRARPT",101,0)
- Q
+ D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;
"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 .
"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.,
-"RTN","C0CRIMA",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","C0CRIMA",20,0)
- ;
-"RTN","C0CRIMA",21,0)
; THESE ROUTINES EXAMINE ONE OR MORE, UP TO ALL, OF THE PATIENTS ON THE
-"RTN","C0CRIMA",22,0)
+"RTN","C0CRIMA",19,0)
; SYSTEM TO DETERMINE HOW COMPLETE THE RESULTING CCR OR CCD WOULD BE FOR
-"RTN","C0CRIMA",23,0)
+"RTN","C0CRIMA",20,0)
; THESE PATIENTS. IT BEGINS TO MEASURE "HL7 RIM COHERENCE" WHICH IS HOW USEFUL
-"RTN","C0CRIMA",24,0)
+"RTN","C0CRIMA",21,0)
; THE VARIABLES WILL BE TO A RIM-MODELED APPLICATION AFTER THEY ARE
-"RTN","C0CRIMA",25,0)
+"RTN","C0CRIMA",22,0)
; CONVEYED VIA THE CCR OR CCD.
-"RTN","C0CRIMA",26,0)
+"RTN","C0CRIMA",23,0)
; FACTORS THAT AFFECT RIM COHERENCE INCLUDE:
-"RTN","C0CRIMA",27,0)
+"RTN","C0CRIMA",24,0)
; 1. THE PRESENSE OF CLINICAL DATA IN A SECTION
-"RTN","C0CRIMA",28,0)
+"RTN","C0CRIMA",25,0)
; 2. ARE THE DATA ELEMENTS TIME-BOUND
-"RTN","C0CRIMA",29,0)
+"RTN","C0CRIMA",26,0)
; 3. ARE THE DATA ELEMENTS CODED WITH SNOMED OR LOINC ETC
-"RTN","C0CRIMA",30,0)
+"RTN","C0CRIMA",27,0)
; 4. ARE SOURCE ACTORS ASSOCIATED WITH THE DATA ELEMENTS
-"RTN","C0CRIMA",31,0)
+"RTN","C0CRIMA",28,0)
; 5. ARE ACTORS IDENTIFIED REGARDING THEIR ROLE
-"RTN","C0CRIMA",32,0)
+"RTN","C0CRIMA",29,0)
; .. AND OTHER FACTORS YET TO BE DETERMINED
-"RTN","C0CRIMA",33,0)
+"RTN","C0CRIMA",30,0)
;
-"RTN","C0CRIMA",34,0)
+"RTN","C0CRIMA",31,0)
; SINCE THESE MEASUREMENTS ARE DONE AT THE VARIABLE LEVEL, THEY
-"RTN","C0CRIMA",35,0)
+"RTN","C0CRIMA",32,0)
; REFLECT ON RIM COHERENCE WHETHER THE CCR OR THE CCD IS USED FOR
-"RTN","C0CRIMA",36,0)
+"RTN","C0CRIMA",33,0)
; CONVEYANCE TO THE RIM APPLICATION.
-"RTN","C0CRIMA",37,0)
+"RTN","C0CRIMA",34,0)
;
-"RTN","C0CRIMA",38,0)
+"RTN","C0CRIMA",35,0)
;
-"RTN","C0CRIMA",39,0)
+"RTN","C0CRIMA",36,0)
ANALYZE(BEGDFN,DFNCNT,APARMS) ; RIM COHERANCE ANALYSIS ROUTINE
-"RTN","C0CRIMA",40,0)
+"RTN","C0CRIMA",37,0)
; BEGINS AT BEGDFN AND GOES FOR DFNCNT PATIENTS
-"RTN","C0CRIMA",41,0)
+"RTN","C0CRIMA",38,0)
; TO RESUME AT NEXT PATIENT, USE BEGDFN=""
-"RTN","C0CRIMA",42,0)
+"RTN","C0CRIMA",39,0)
; USE RESET^C0CRIMA TO RESET TO TOP OF PATIENT LIST
-"RTN","C0CRIMA",43,0)
+"RTN","C0CRIMA",40,0)
; APARMS ARE PARAMETERS TO BE USED IN THE EXTRACTION
-"RTN","C0CRIMA",44,0)
+"RTN","C0CRIMA",41,0)
; SEE C0CPARMS FOR SUPPORTED PARAMTERS
-"RTN","C0CRIMA",45,0)
+"RTN","C0CRIMA",42,0)
;
-"RTN","C0CRIMA",46,0)
+"RTN","C0CRIMA",43,0)
N RIMARY,RIMTMP,RIMI,RIMDFN,RATTR
-"RTN","C0CRIMA",47,0)
+"RTN","C0CRIMA",44,0)
N CCRGLO
-"RTN","C0CRIMA",48,0)
+"RTN","C0CRIMA",45,0)
S C0CCHK=0 ; CHECKSUM FLAG
-"RTN","C0CRIMA",49,0)
+"RTN","C0CRIMA",46,0)
D ASETUP ; SET UP VARIABLES AND GLOBALS
-"RTN","C0CRIMA",50,0)
+"RTN","C0CRIMA",47,0)
D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
-"RTN","C0CRIMA",51,0)
+"RTN","C0CRIMA",48,0)
I '$D(@RIMBASE@("RESUME")) S @RIMBASE@("RESUME")=$O(^DPT(0)) ; FIRST TIME
-"RTN","C0CRIMA",52,0)
+"RTN","C0CRIMA",49,0)
S RESUME=@RIMBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
-"RTN","C0CRIMA",53,0)
+"RTN","C0CRIMA",50,0)
S RIMDFN=BEGDFN ; BEGIN WITH THE BEGDFN PATIENT
-"RTN","C0CRIMA",54,0)
+"RTN","C0CRIMA",51,0)
I RIMDFN="" S RIMDFN=RESUME
-"RTN","C0CRIMA",55,0)
+"RTN","C0CRIMA",52,0)
I +RIMDFN=0 D Q ; AT THE END OF THE PATIENTS
-"RTN","C0CRIMA",56,0)
+"RTN","C0CRIMA",53,0)
. W "END OF PATIENT LIST, CALL RESET^C0CRIMA",!
-"RTN","C0CRIMA",57,0)
+"RTN","C0CRIMA",54,0)
I '$D(APARMS) S APARMS="" ; DEFAULT NO OVERRIDE PARMS
-"RTN","C0CRIMA",58,0)
+"RTN","C0CRIMA",55,0)
F RIMI=1:1:DFNCNT D Q:+RIMDFN=0 ; FOR DFNCNT NUMBER OF PATIENTS OR END
-"RTN","C0CRIMA",59,0)
+"RTN","C0CRIMA",56,0)
. K @RIMBASE@("VARS",RIMDFN) ; CLEAR OUT OLD VARS
-"RTN","C0CRIMA",60,0)
+"RTN","C0CRIMA",57,0)
. D CCRRPC^C0CCCR(.CCRGLO,RIMDFN,APARMS,"CCR") ;PROCESS THE CCR
-"RTN","C0CRIMA",61,0)
+"RTN","C0CRIMA",58,0)
. W RIMDFN,!
-"RTN","C0CRIMA",62,0)
+"RTN","C0CRIMA",59,0)
. ;
-"RTN","C0CRIMA",63,0)
+"RTN","C0CRIMA",60,0)
. ; COPY ALL THE VARIABLES TO THE RIM MAP AREA INDEXED BY PATIENT
-"RTN","C0CRIMA",64,0)
+"RTN","C0CRIMA",61,0)
. ;
-"RTN","C0CRIMA",65,0)
+"RTN","C0CRIMA",62,0)
. I $D(^TMP("C0CCCR",$J,"PROBVALS",1)) D ; PROBLEM VARS EXISTS
-"RTN","C0CRIMA",66,0)
+"RTN","C0CRIMA",63,0)
. . M @RIMBASE@("VARS",RIMDFN,"PROBLEMS")=^TMP("C0CCCR",$J,"PROBVALS")
-"RTN","C0CRIMA",67,0)
+"RTN","C0CRIMA",64,0)
. . S @RIMBASE@("VARS",RIMDFN,"PROBLEMS",0)=$O(^TMP("C0CCCR",$J,"PROBVALS",""),-1)
-"RTN","C0CRIMA",68,0)
+"RTN","C0CRIMA",65,0)
. I $D(^TMP("C0CCCR",$J,"VITALS",1)) D ; VITALS VARS EXISTS
-"RTN","C0CRIMA",69,0)
+"RTN","C0CRIMA",66,0)
. . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("C0CCCR",$J,"VITALS")
-"RTN","C0CRIMA",70,0)
+"RTN","C0CRIMA",67,0)
. I $D(^TMP("C0CCCR",$J,"MEDMAP",1)) D ; MEDS VARS EXISTS
-"RTN","C0CRIMA",71,0)
+"RTN","C0CRIMA",68,0)
. . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("C0CCCR",$J,"MEDMAP")
-"RTN","C0CRIMA",72,0)
+"RTN","C0CRIMA",69,0)
. I $D(^TMP("C0CCCR",$J,"ALERTS",1,"ALERTOBJECTID")) D ; ALERTS EXIST
-"RTN","C0CRIMA",73,0)
+"RTN","C0CRIMA",70,0)
. . W "FOUND ALERT VARS",!
-"RTN","C0CRIMA",74,0)
+"RTN","C0CRIMA",71,0)
. . M @RIMBASE@("VARS",RIMDFN,"ALERTS")=^TMP("C0CCCR",$J,"ALERTS")
-"RTN","C0CRIMA",75,0)
+"RTN","C0CRIMA",72,0)
. I $D(^TMP("C0CCCR",$J,"RESULTS",0)) D ; RESULTS EXIST
-"RTN","C0CRIMA",76,0)
+"RTN","C0CRIMA",73,0)
. . W "FOUND RESULTS VARS",!
-"RTN","C0CRIMA",77,0)
+"RTN","C0CRIMA",74,0)
. . M @RIMBASE@("VARS",RIMDFN,"RESULTS")=^TMP("C0CCCR",$J,"RESULTS")
-"RTN","C0CRIMA",78,0)
+"RTN","C0CRIMA",75,0)
. S C0CCHK=0
-"RTN","C0CRIMA",79,0)
+"RTN","C0CRIMA",76,0)
. I $$CHKSUM(RIMDFN) D ; CHECKSUM HAS CHANGED
-"RTN","C0CRIMA",80,0)
+"RTN","C0CRIMA",77,0)
. . W "CHECKSUM IS NEW OR HAS CHANGED",!
-"RTN","C0CRIMA",81,0)
+"RTN","C0CRIMA",78,0)
. . ;ZWR ^TMP("C0CRIM","CHKSUM",RIMDFN,*)
-"RTN","C0CRIMA",82,0)
+"RTN","C0CRIMA",79,0)
. . S C0CCHK=1
-"RTN","C0CRIMA",83,0)
+"RTN","C0CRIMA",80,0)
. K ^TMP("C0CCCR",$J) ; KILL WORK AREA FOR CCR BUILDING
-"RTN","C0CRIMA",84,0)
+"RTN","C0CRIMA",81,0)
. ;
-"RTN","C0CRIMA",85,0)
+"RTN","C0CRIMA",82,0)
. ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
+"RTN","C0CRIMA",83,0)
+ . ;
+"RTN","C0CRIMA",84,0)
+ . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
+"RTN","C0CRIMA",85,0)
+ . 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
-"RTN","C0CRIMA",88,0)
- . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT
-"RTN","C0CRIMA",89,0)
- . ;
-"RTN","C0CRIMA",90,0)
. ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL
-"RTN","C0CRIMA",91,0)
+"RTN","C0CRIMA",88,0)
. ;
-"RTN","C0CRIMA",92,0)
+"RTN","C0CRIMA",89,0)
. ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D ; IF FIRST PAT WITH THESE ATTRS
-"RTN","C0CRIMA",93,0)
+"RTN","C0CRIMA",90,0)
. ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED
-"RTN","C0CRIMA",94,0)
+"RTN","C0CRIMA",91,0)
. ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT
-"RTN","C0CRIMA",95,0)
+"RTN","C0CRIMA",92,0)
. ;
-"RTN","C0CRIMA",96,0)
+"RTN","C0CRIMA",93,0)
. N CATNAME,CATTBL
-"RTN","C0CRIMA",97,0)
+"RTN","C0CRIMA",94,0)
. ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))
-"RTN","C0CRIMA",98,0)
+"RTN","C0CRIMA",95,0)
. S CATNAME=""
-"RTN","C0CRIMA",99,0)
+"RTN","C0CRIMA",96,0)
. D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
-"RTN","C0CRIMA",100,0)
+"RTN","C0CRIMA",97,0)
. W "CATEGORY NAME: ",CATNAME,!
-"RTN","C0CRIMA",101,0)
+"RTN","C0CRIMA",98,0)
. ;
-"RTN","C0CRIMA",102,0)
- . F S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^C0CSYS(RIMDFN) ; NEXT PATIENT
-"RTN","C0CRIMA",103,0)
+"RTN","C0CRIMA",99,0)
+ . F S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^C0CSYS(RIMDFN) ; NEXT PATIENT
+"RTN","C0CRIMA",100,0)
. ; PTST TESTS TO SEE IF PATIENT WAS MERGED
-"RTN","C0CRIMA",104,0)
+"RTN","C0CRIMA",101,0)
. ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT
-"RTN","C0CRIMA",105,0)
+"RTN","C0CRIMA",102,0)
. ; AND WE SKIP IT
-"RTN","C0CRIMA",106,0)
+"RTN","C0CRIMA",103,0)
. S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN
-"RTN","C0CRIMA",107,0)
+"RTN","C0CRIMA",104,0)
; D PARY^C0CXPATH(@RIMBASE@("ATTRTBL"))
-"RTN","C0CRIMA",108,0)
+"RTN","C0CRIMA",105,0)
Q
-"RTN","C0CRIMA",109,0)
+"RTN","C0CRIMA",106,0)
;
-"RTN","C0CRIMA",110,0)
+"RTN","C0CRIMA",107,0)
SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
-"RTN","C0CRIMA",111,0)
+"RTN","C0CRIMA",108,0)
N SBASE,SATTR
-"RTN","C0CRIMA",112,0)
+"RTN","C0CRIMA",109,0)
S SBASE=$NA(@RIMBASE@("VARS",SDFN))
-"RTN","C0CRIMA",113,0)
+"RTN","C0CRIMA",110,0)
D APOST("SATTR","RIMTBL","HEADER")
-"RTN","C0CRIMA",114,0)
+"RTN","C0CRIMA",111,0)
I $D(@SBASE@("PROBLEMS",1)) D ;
-"RTN","C0CRIMA",115,0)
+"RTN","C0CRIMA",112,0)
. D APOST("SATTR","RIMTBL","PROBLEMS")
-"RTN","C0CRIMA",116,0)
+"RTN","C0CRIMA",113,0)
. ; W "POSTING PROBLEMS",!
-"RTN","C0CRIMA",117,0)
+"RTN","C0CRIMA",114,0)
I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
-"RTN","C0CRIMA",118,0)
+"RTN","C0CRIMA",115,0)
I $D(@SBASE@("IMMUNE",1)) D ;IMMUNIZATIONS PRESENT
-"RTN","C0CRIMA",119,0)
+"RTN","C0CRIMA",116,0)
. D APOST("SATTR","RIMTBL","IMMUNE")
-"RTN","C0CRIMA",120,0)
+"RTN","C0CRIMA",117,0)
. N ZR,ZI
-"RTN","C0CRIMA",121,0)
+"RTN","C0CRIMA",118,0)
. D GETPA(.ZR,SDFN,"IMMUNE","IMMUNEPRODUCTCODE")
-"RTN","C0CRIMA",122,0)
+"RTN","C0CRIMA",119,0)
. I ZR(0)>0 D APOST("SATTR","RIMTBL","IMMUNECODE") ;IMMUNIZATION CODES
-"RTN","C0CRIMA",123,0)
+"RTN","C0CRIMA",120,0)
I $D(@SBASE@("MEDS",1)) D ; IF THE PATIENT HAS MEDS VARIABLES
-"RTN","C0CRIMA",124,0)
+"RTN","C0CRIMA",121,0)
. D APOST("SATTR","RIMTBL","MEDS")
-"RTN","C0CRIMA",125,0)
+"RTN","C0CRIMA",122,0)
. N ZR,ZI
-"RTN","C0CRIMA",126,0)
+"RTN","C0CRIMA",123,0)
. D GETPA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
-"RTN","C0CRIMA",127,0)
+"RTN","C0CRIMA",124,0)
. I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
-"RTN","C0CRIMA",128,0)
+"RTN","C0CRIMA",125,0)
. . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
-"RTN","C0CRIMA",129,0)
+"RTN","C0CRIMA",126,0)
. . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","MEDSCODE") ;CODES
-"RTN","C0CRIMA",130,0)
+"RTN","C0CRIMA",127,0)
. ; D PATD^C0CRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
-"RTN","C0CRIMA",131,0)
+"RTN","C0CRIMA",128,0)
I $D(@SBASE@("ALERTS",1)) D ; IF THE PATIENT HAS ALERTS
-"RTN","C0CRIMA",132,0)
+"RTN","C0CRIMA",129,0)
. D APOST("SATTR","RIMTBL","ALERTS")
-"RTN","C0CRIMA",133,0)
+"RTN","C0CRIMA",130,0)
. N ZR,ZI
-"RTN","C0CRIMA",134,0)
+"RTN","C0CRIMA",131,0)
. D GETPA(.ZR,SDFN,"ALERTS","ALERTAGENTPRODUCTCODEVALUE") ;REACTANT CODES
-"RTN","C0CRIMA",135,0)
+"RTN","C0CRIMA",132,0)
. I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
-"RTN","C0CRIMA",136,0)
+"RTN","C0CRIMA",133,0)
. . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
-"RTN","C0CRIMA",137,0)
+"RTN","C0CRIMA",134,0)
. . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","ALERTSCODE") ;CODES
-"RTN","C0CRIMA",138,0)
+"RTN","C0CRIMA",135,0)
I $D(@SBASE@("RESULTS",1)) D ; IF THE PATIENT HAS LABS VARIABLES
-"RTN","C0CRIMA",139,0)
+"RTN","C0CRIMA",136,0)
. D APOST("SATTR","RIMTBL","RESULTS")
-"RTN","C0CRIMA",140,0)
+"RTN","C0CRIMA",137,0)
. N ZR,ZI
-"RTN","C0CRIMA",141,0)
+"RTN","C0CRIMA",138,0)
. S ZR(0)=0 ; INITIALIZE TO NONE
-"RTN","C0CRIMA",142,0)
+"RTN","C0CRIMA",139,0)
. D RPCGV(.ZR,SDFN,"RESULTS") ;CHECK FOR LABS CODES
-"RTN","C0CRIMA",143,0)
+"RTN","C0CRIMA",140,0)
. ; D PARY^C0CXPATH("ZR") ;
-"RTN","C0CRIMA",144,0)
+"RTN","C0CRIMA",141,0)
. I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
-"RTN","C0CRIMA",145,0)
+"RTN","C0CRIMA",142,0)
. . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
-"RTN","C0CRIMA",146,0)
+"RTN","C0CRIMA",143,0)
. . . I $P(ZR(ZI),"^",2)="RESULTTESTCODINGSYSTEM" D ; LOINC CODE CHECK
-"RTN","C0CRIMA",147,0)
+"RTN","C0CRIMA",144,0)
. . . . I $P(ZR(ZI),"^",3)="LOINC" D APOST("SATTR","RIMTBL","RESULTSLN") ;
-"RTN","C0CRIMA",148,0)
+"RTN","C0CRIMA",145,0)
; D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
-"RTN","C0CRIMA",149,0)
+"RTN","C0CRIMA",146,0)
I $D(@SBASE@("PROCEDURES",1)) D ;
-"RTN","C0CRIMA",150,0)
+"RTN","C0CRIMA",147,0)
. D APOST("SATTR","RIMTBL","PROCEDURES")
-"RTN","C0CRIMA",151,0)
+"RTN","C0CRIMA",148,0)
W "ATTRIBUTES: ",SATTR,!
-"RTN","C0CRIMA",152,0)
+"RTN","C0CRIMA",149,0)
Q SATTR
-"RTN","C0CRIMA",153,0)
+"RTN","C0CRIMA",150,0)
;
-"RTN","C0CRIMA",154,0)
+"RTN","C0CRIMA",151,0)
RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
-"RTN","C0CRIMA",155,0)
+"RTN","C0CRIMA",152,0)
K ^TMP("C0CRIM","RESUME")
-"RTN","C0CRIMA",156,0)
+"RTN","C0CRIMA",153,0)
K ^TMP("C0CRIM")
-"RTN","C0CRIMA",157,0)
+"RTN","C0CRIMA",154,0)
Q
-"RTN","C0CRIMA",158,0)
+"RTN","C0CRIMA",155,0)
;
-"RTN","C0CRIMA",159,0)
+"RTN","C0CRIMA",156,0)
CLIST ; LIST THE CATEGORIES
-"RTN","C0CRIMA",160,0)
+"RTN","C0CRIMA",157,0)
;
-"RTN","C0CRIMA",161,0)
+"RTN","C0CRIMA",158,0)
I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","C0CRIMA",162,0)
+"RTN","C0CRIMA",159,0)
N CLBASE,CLNUM,ZI,CLIDX
-"RTN","C0CRIMA",163,0)
+"RTN","C0CRIMA",160,0)
S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
-"RTN","C0CRIMA",164,0)
+"RTN","C0CRIMA",161,0)
S CLNUM=@CLBASE@(0)
-"RTN","C0CRIMA",165,0)
+"RTN","C0CRIMA",162,0)
F ZI=1:1:CLNUM D ; LOOP THROUGH THE CATEGORIES
-"RTN","C0CRIMA",166,0)
+"RTN","C0CRIMA",163,0)
. S CLIDX=@CLBASE@(ZI)
-"RTN","C0CRIMA",167,0)
+"RTN","C0CRIMA",164,0)
. W "(",$P(@CLBASE@(CLIDX),"^",1)
-"RTN","C0CRIMA",168,0)
+"RTN","C0CRIMA",165,0)
. W ":",$P(@CLBASE@(CLIDX),"^",2),") "
-"RTN","C0CRIMA",169,0)
+"RTN","C0CRIMA",166,0)
. W CLIDX,!
-"RTN","C0CRIMA",170,0)
+"RTN","C0CRIMA",167,0)
; D PARY^C0CXPATH(CLBASE)
-"RTN","C0CRIMA",171,0)
+"RTN","C0CRIMA",168,0)
Q
-"RTN","C0CRIMA",172,0)
+"RTN","C0CRIMA",169,0)
;
-"RTN","C0CRIMA",173,0)
+"RTN","C0CRIMA",170,0)
CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
-"RTN","C0CRIMA",174,0)
+"RTN","C0CRIMA",171,0)
; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
-"RTN","C0CRIMA",175,0)
+"RTN","C0CRIMA",172,0)
; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
-"RTN","C0CRIMA",176,0)
+"RTN","C0CRIMA",173,0)
; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
-"RTN","C0CRIMA",177,0)
+"RTN","C0CRIMA",174,0)
; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
-"RTN","C0CRIMA",178,0)
+"RTN","C0CRIMA",175,0)
; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
-"RTN","C0CRIMA",179,0)
+"RTN","C0CRIMA",176,0)
; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
-"RTN","C0CRIMA",180,0)
+"RTN","C0CRIMA",177,0)
; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
-"RTN","C0CRIMA",181,0)
+"RTN","C0CRIMA",178,0)
; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
-"RTN","C0CRIMA",182,0)
+"RTN","C0CRIMA",179,0)
; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
-"RTN","C0CRIMA",183,0)
+"RTN","C0CRIMA",180,0)
; NUMBER IE CTBL_X(CDFN)=""
-"RTN","C0CRIMA",184,0)
+"RTN","C0CRIMA",181,0)
;
-"RTN","C0CRIMA",185,0)
+"RTN","C0CRIMA",182,0)
; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
-"RTN","C0CRIMA",186,0)
+"RTN","C0CRIMA",183,0)
S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
-"RTN","C0CRIMA",187,0)
+"RTN","C0CRIMA",184,0)
W "CBASE: ",CCTBL,!
-"RTN","C0CRIMA",188,0)
+"RTN","C0CRIMA",185,0)
;
-"RTN","C0CRIMA",189,0)
+"RTN","C0CRIMA",186,0)
I '$D(@CCTBL@(CATTR)) D ; FIRST PATIENT IN THIS CATEGORY
-"RTN","C0CRIMA",190,0)
+"RTN","C0CRIMA",187,0)
. D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
-"RTN","C0CRIMA",191,0)
+"RTN","C0CRIMA",188,0)
. S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
-"RTN","C0CRIMA",192,0)
+"RTN","C0CRIMA",189,0)
. S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
-"RTN","C0CRIMA",193,0)
+"RTN","C0CRIMA",190,0)
. S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
-"RTN","C0CRIMA",194,0)
+"RTN","C0CRIMA",191,0)
. ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
-"RTN","C0CRIMA",195,0)
+"RTN","C0CRIMA",192,0)
. ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
-"RTN","C0CRIMA",196,0)
+"RTN","C0CRIMA",193,0)
;
-"RTN","C0CRIMA",197,0)
+"RTN","C0CRIMA",194,0)
S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
-"RTN","C0CRIMA",198,0)
+"RTN","C0CRIMA",195,0)
S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
-"RTN","C0CRIMA",199,0)
+"RTN","C0CRIMA",196,0)
S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
-"RTN","C0CRIMA",200,0)
+"RTN","C0CRIMA",197,0)
;
-"RTN","C0CRIMA",201,0)
+"RTN","C0CRIMA",198,0)
S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
-"RTN","C0CRIMA",202,0)
+"RTN","C0CRIMA",199,0)
;
-"RTN","C0CRIMA",203,0)
+"RTN","C0CRIMA",200,0)
S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
-"RTN","C0CRIMA",204,0)
+"RTN","C0CRIMA",201,0)
W "PATS BASE: ",CPATLIST,!
-"RTN","C0CRIMA",205,0)
+"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)
- ;
-"RTN","C0CRIMA",207,0)
- Q
-"RTN","C0CRIMA",208,0)
- ;
-"RTN","C0CRIMA",209,0)
CHKSUM(CKDFN) ; DOES A CHECKSUM AND STORES IT IN MUMPS GLOBALS
-"RTN","C0CRIMA",210,0)
+"RTN","C0CRIMA",207,0)
;
-"RTN","C0CRIMA",211,0)
+"RTN","C0CRIMA",208,0)
S C0CCKB=$NA(^TMP("C0CRIM","CHKSUM")) ;CHECKSUM BASE
-"RTN","C0CRIMA",212,0)
+"RTN","C0CRIMA",209,0)
S C0CGLB=$NA(^TMP("C0CRIM","VARS")) ;CCR VARIABLE BASE
-"RTN","C0CRIMA",213,0)
+"RTN","C0CRIMA",210,0)
S C0CI=""
-"RTN","C0CRIMA",214,0)
+"RTN","C0CRIMA",211,0)
F S C0CI=$O(@C0CGLB@(CKDFN,C0CI)) Q:C0CI="" D ;FOR EACH DOMAIN
-"RTN","C0CRIMA",215,0)
+"RTN","C0CRIMA",212,0)
. ;W "DFN:",CKDFN," DOMAIN:",C0CI,!
-"RTN","C0CRIMA",216,0)
+"RTN","C0CRIMA",213,0)
. S C0CJ=$NA(@C0CGLB@(CKDFN,C0CI))
-"RTN","C0CRIMA",217,0)
+"RTN","C0CRIMA",214,0)
. I C0CI="HEADER" D ; HAVE TO TAKE OUT THE "DATE GENERATED"
-"RTN","C0CRIMA",218,0)
+"RTN","C0CRIMA",215,0)
. . S C0CDT=@C0CGLB@(CKDFN,C0CI,1,"DATETIME")
-"RTN","C0CRIMA",219,0)
+"RTN","C0CRIMA",216,0)
. . K @C0CGLB@(CKDFN,C0CI,1,"DATETIME")
-"RTN","C0CRIMA",220,0)
+"RTN","C0CRIMA",217,0)
. S C0CCK(C0CI)=$$CHKSUM^XUSESIG1(C0CJ)
-"RTN","C0CRIMA",221,0)
+"RTN","C0CRIMA",218,0)
. I C0CI="HEADER" D ; PUT IT BACK
-"RTN","C0CRIMA",222,0)
+"RTN","C0CRIMA",219,0)
. . S @C0CGLB@(CKDFN,C0CI,1,"DATETIME")=C0CDT
-"RTN","C0CRIMA",223,0)
+"RTN","C0CRIMA",220,0)
S C0CK="C0CCK" ;
-"RTN","C0CRIMA",224,0)
+"RTN","C0CRIMA",221,0)
S C0CALL=$$CHKSUM^XUSESIG1(C0CK) ;CHECKSUM OF ALL DOMAIN CHECKSUMS
-"RTN","C0CRIMA",225,0)
+"RTN","C0CRIMA",222,0)
S CHKR=0 ; RESULT DEFAULT
-"RTN","C0CRIMA",226,0)
+"RTN","C0CRIMA",223,0)
I $D(^TMP("C0CRIM","CHKSUM",CKDFN,"ALL")) D ; OLD CHECKSUM EXISTS
-"RTN","C0CRIMA",227,0)
+"RTN","C0CRIMA",224,0)
. I @C0CCKB@(CKDFN,"ALL")'=C0CALL S CHKR=1
-"RTN","C0CRIMA",228,0)
+"RTN","C0CRIMA",225,0)
E S CHKR=1 ;CHECKSUM IS NEW
-"RTN","C0CRIMA",229,0)
+"RTN","C0CRIMA",226,0)
S @C0CCKB@(CKDFN,"ALL")=C0CALL
-"RTN","C0CRIMA",230,0)
+"RTN","C0CRIMA",227,0)
M @C0CCKB@(CKDFN,"DOMAIN")=C0CCK
-"RTN","C0CRIMA",231,0)
+"RTN","C0CRIMA",228,0)
;ZWR ^TMP("C0CRIM","CHKSUM",CKDFN,*)
-"RTN","C0CRIMA",232,0)
+"RTN","C0CRIMA",229,0)
Q CHKR
-"RTN","C0CRIMA",233,0)
+"RTN","C0CRIMA",230,0)
;
-"RTN","C0CRIMA",234,0)
+"RTN","C0CRIMA",231,0)
CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
-"RTN","C0CRIMA",235,0)
+"RTN","C0CRIMA",232,0)
;
-"RTN","C0CRIMA",236,0)
+"RTN","C0CRIMA",233,0)
I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","C0CRIMA",237,0)
+"RTN","C0CRIMA",234,0)
N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
-"RTN","C0CRIMA",238,0)
+"RTN","C0CRIMA",235,0)
S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
-"RTN","C0CRIMA",239,0)
+"RTN","C0CRIMA",236,0)
S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
-"RTN","C0CRIMA",240,0)
+"RTN","C0CRIMA",237,0)
S ZTOT=0 ; INITIALIZE OVERALL TOTAL
-"RTN","C0CRIMA",241,0)
+"RTN","C0CRIMA",238,0)
F ZI=1:1:@ZCBASE@(0) D ; FOR ALL CATS
-"RTN","C0CRIMA",242,0)
+"RTN","C0CRIMA",239,0)
. S ZCNT=0
-"RTN","C0CRIMA",243,0)
+"RTN","C0CRIMA",240,0)
. S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
-"RTN","C0CRIMA",244,0)
+"RTN","C0CRIMA",241,0)
. S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
-"RTN","C0CRIMA",245,0)
+"RTN","C0CRIMA",242,0)
. ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
-"RTN","C0CRIMA",246,0)
+"RTN","C0CRIMA",243,0)
. ; F ZJ=0:0 D Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
-"RTN","C0CRIMA",247,0)
+"RTN","C0CRIMA",244,0)
. ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
-"RTN","C0CRIMA",248,0)
+"RTN","C0CRIMA",245,0)
. ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
-"RTN","C0CRIMA",249,0)
+"RTN","C0CRIMA",246,0)
. ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
-"RTN","C0CRIMA",250,0)
+"RTN","C0CRIMA",247,0)
. S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
-"RTN","C0CRIMA",251,0)
+"RTN","C0CRIMA",248,0)
. S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
-"RTN","C0CRIMA",252,0)
+"RTN","C0CRIMA",249,0)
. S ZTOT=ZTOT+ZCNT
-"RTN","C0CRIMA",253,0)
+"RTN","C0CRIMA",250,0)
W "TOTAL: ",ZTOT,!
-"RTN","C0CRIMA",254,0)
+"RTN","C0CRIMA",251,0)
Q
-"RTN","C0CRIMA",255,0)
+"RTN","C0CRIMA",252,0)
;
-"RTN","C0CRIMA",256,0)
+"RTN","C0CRIMA",253,0)
CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
-"RTN","C0CRIMA",257,0)
+"RTN","C0CRIMA",254,0)
; INLST IS PASSED BY NAME
-"RTN","C0CRIMA",258,0)
+"RTN","C0CRIMA",255,0)
N ZI,ZDX,ZCOUNT
-"RTN","C0CRIMA",259,0)
+"RTN","C0CRIMA",256,0)
W INLST,!
-"RTN","C0CRIMA",260,0)
+"RTN","C0CRIMA",257,0)
S ZCOUNT=0
-"RTN","C0CRIMA",261,0)
+"RTN","C0CRIMA",258,0)
S ZDX=""
-"RTN","C0CRIMA",262,0)
+"RTN","C0CRIMA",259,0)
F ZI=$O(@INLST@(ZDX)):0 D Q:$O(@INLST@(ZDX))="" ; LOOP UNTIL THE END
-"RTN","C0CRIMA",263,0)
+"RTN","C0CRIMA",260,0)
. S ZCOUNT=ZCOUNT+1
-"RTN","C0CRIMA",264,0)
+"RTN","C0CRIMA",261,0)
. S ZDX=$O(@INLST@(ZDX))
-"RTN","C0CRIMA",265,0)
+"RTN","C0CRIMA",262,0)
. W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
-"RTN","C0CRIMA",266,0)
+"RTN","C0CRIMA",263,0)
Q ZCOUNT
-"RTN","C0CRIMA",267,0)
+"RTN","C0CRIMA",264,0)
;
-"RTN","C0CRIMA",268,0)
+"RTN","C0CRIMA",265,0)
XCPAT(CPATCAT,CPATPARM) ; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT
-"RTN","C0CRIMA",269,0)
+"RTN","C0CRIMA",266,0)
;
-"RTN","C0CRIMA",270,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)
- I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+ S ZI=""
"RTN","C0CRIMA",272,0)
- N ZI,ZJ,ZC,ZPATBASE
+ F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END
"RTN","C0CRIMA",273,0)
- S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
+ . S ZI=$O(@ZPATBASE@(ZI))
"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",275,0)
Q
-"RTN","C0CRIMA",279,0)
+"RTN","C0CRIMA",276,0)
;
-"RTN","C0CRIMA",280,0)
+"RTN","C0CRIMA",277,0)
CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
-"RTN","C0CRIMA",281,0)
+"RTN","C0CRIMA",278,0)
;
-"RTN","C0CRIMA",282,0)
+"RTN","C0CRIMA",279,0)
I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","C0CRIMA",283,0)
+"RTN","C0CRIMA",280,0)
N ZI,ZJ,ZC,ZPATBASE
-"RTN","C0CRIMA",284,0)
+"RTN","C0CRIMA",281,0)
S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
-"RTN","C0CRIMA",285,0)
+"RTN","C0CRIMA",282,0)
S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
-"RTN","C0CRIMA",286,0)
+"RTN","C0CRIMA",283,0)
S ZI=""
-"RTN","C0CRIMA",287,0)
+"RTN","C0CRIMA",284,0)
F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END
-"RTN","C0CRIMA",288,0)
+"RTN","C0CRIMA",285,0)
. S ZI=$O(@ZPATBASE@(ZI))
-"RTN","C0CRIMA",289,0)
+"RTN","C0CRIMA",286,0)
. S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
-"RTN","C0CRIMA",290,0)
+"RTN","C0CRIMA",287,0)
. W ZI," "
-"RTN","C0CRIMA",291,0)
+"RTN","C0CRIMA",288,0)
. I ZC=10 D ; NEW LINE
-"RTN","C0CRIMA",292,0)
+"RTN","C0CRIMA",289,0)
. . S ZC=0
-"RTN","C0CRIMA",293,0)
+"RTN","C0CRIMA",290,0)
. . W !
-"RTN","C0CRIMA",294,0)
+"RTN","C0CRIMA",291,0)
Q
-"RTN","C0CRIMA",295,0)
+"RTN","C0CRIMA",292,0)
;
-"RTN","C0CRIMA",296,0)
+"RTN","C0CRIMA",293,0)
PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT
-"RTN","C0CRIMA",297,0)
+"RTN","C0CRIMA",294,0)
;
-"RTN","C0CRIMA",298,0)
+"RTN","C0CRIMA",295,0)
N ATTR S ATTR=""
-"RTN","C0CRIMA",299,0)
+"RTN","C0CRIMA",296,0)
I '$D(^TMP("C0CRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT
-"RTN","C0CRIMA",300,0)
+"RTN","C0CRIMA",297,0)
. D ANALYZE(DFN,1) ; EXTRACT THE RIM VARIABLE FOR THIS PATIENT
-"RTN","C0CRIMA",301,0)
+"RTN","C0CRIMA",298,0)
S ATTR=^TMP("C0CRIM","ATTR",DFN)
-"RTN","C0CRIMA",302,0)
+"RTN","C0CRIMA",299,0)
I ATTR="" W "THIS PATIENT NOT ANALYZED.",! Q ;NO ATTRIBUTES FOUND
-"RTN","C0CRIMA",303,0)
+"RTN","C0CRIMA",300,0)
I $D(^TMP("C0CRIM","RIMTBL","CATS",ATTR)) D ; FOUND A CAT
-"RTN","C0CRIMA",304,0)
+"RTN","C0CRIMA",301,0)
. N CAT
-"RTN","C0CRIMA",305,0)
+"RTN","C0CRIMA",302,0)
. S CAT=$P(^TMP("C0CRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT
-"RTN","C0CRIMA",306,0)
+"RTN","C0CRIMA",303,0)
. W CAT,": ",ATTR,!
-"RTN","C0CRIMA",307,0)
+"RTN","C0CRIMA",304,0)
Q
-"RTN","C0CRIMA",308,0)
+"RTN","C0CRIMA",305,0)
;
-"RTN","C0CRIMA",309,0)
+"RTN","C0CRIMA",306,0)
APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
-"RTN","C0CRIMA",310,0)
+"RTN","C0CRIMA",307,0)
; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
-"RTN","C0CRIMA",311,0)
+"RTN","C0CRIMA",308,0)
; AND AMAP(N)=AVAL IS THE NTH AVAL
-"RTN","C0CRIMA",312,0)
+"RTN","C0CRIMA",309,0)
; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
-"RTN","C0CRIMA",313,0)
+"RTN","C0CRIMA",310,0)
; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
-"RTN","C0CRIMA",314,0)
+"RTN","C0CRIMA",311,0)
; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
-"RTN","C0CRIMA",315,0)
+"RTN","C0CRIMA",312,0)
; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
-"RTN","C0CRIMA",316,0)
+"RTN","C0CRIMA",313,0)
;
-"RTN","C0CRIMA",317,0)
+"RTN","C0CRIMA",314,0)
I '$D(@AMAP) D ; IF THE MAP DOES NOT EXIST
-"RTN","C0CRIMA",318,0)
+"RTN","C0CRIMA",315,0)
. S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
-"RTN","C0CRIMA",319,0)
+"RTN","C0CRIMA",316,0)
S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
-"RTN","C0CRIMA",320,0)
+"RTN","C0CRIMA",317,0)
S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
-"RTN","C0CRIMA",321,0)
+"RTN","C0CRIMA",318,0)
S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
-"RTN","C0CRIMA",322,0)
+"RTN","C0CRIMA",319,0)
Q
-"RTN","C0CRIMA",323,0)
+"RTN","C0CRIMA",320,0)
;
-"RTN","C0CRIMA",324,0)
+"RTN","C0CRIMA",321,0)
ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
-"RTN","C0CRIMA",325,0)
+"RTN","C0CRIMA",322,0)
I '$D(RIMBASE) S RIMBASE=$NA(^TMP("C0CRIM"))
-"RTN","C0CRIMA",326,0)
+"RTN","C0CRIMA",323,0)
I '$D(@RIMBASE) S @RIMBASE=""
-"RTN","C0CRIMA",327,0)
+"RTN","C0CRIMA",324,0)
I '$D(RIMTBL) S RIMTBL=$NA(^TMP("C0CRIM","RIMTBL","TABLE")) ; ATTR TABLE
-"RTN","C0CRIMA",328,0)
+"RTN","C0CRIMA",325,0)
S ^TMP("C0CRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
-"RTN","C0CRIMA",329,0)
+"RTN","C0CRIMA",326,0)
Q
-"RTN","C0CRIMA",330,0)
+"RTN","C0CRIMA",327,0)
;
-"RTN","C0CRIMA",331,0)
+"RTN","C0CRIMA",328,0)
AINIT ; INITIALIZE ATTRIBUTE TABLE
-"RTN","C0CRIMA",332,0)
+"RTN","C0CRIMA",329,0)
I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","C0CRIMA",333,0)
+"RTN","C0CRIMA",330,0)
K @RIMTBL
-"RTN","C0CRIMA",334,0)
+"RTN","C0CRIMA",331,0)
D APUSH(RIMTBL,"EXTRACTED")
-"RTN","C0CRIMA",335,0)
+"RTN","C0CRIMA",332,0)
D APUSH(RIMTBL,"NOTEXTRACTED")
-"RTN","C0CRIMA",336,0)
+"RTN","C0CRIMA",333,0)
D APUSH(RIMTBL,"HEADER")
-"RTN","C0CRIMA",337,0)
+"RTN","C0CRIMA",334,0)
D APUSH(RIMTBL,"NOPCP")
-"RTN","C0CRIMA",338,0)
+"RTN","C0CRIMA",335,0)
D APUSH(RIMTBL,"PCP")
-"RTN","C0CRIMA",339,0)
+"RTN","C0CRIMA",336,0)
D APUSH(RIMTBL,"PROBLEMS")
-"RTN","C0CRIMA",340,0)
+"RTN","C0CRIMA",337,0)
D APUSH(RIMTBL,"PROBCODE")
-"RTN","C0CRIMA",341,0)
+"RTN","C0CRIMA",338,0)
D APUSH(RIMTBL,"PROBNOCODE")
-"RTN","C0CRIMA",342,0)
+"RTN","C0CRIMA",339,0)
D APUSH(RIMTBL,"PROBDATE")
-"RTN","C0CRIMA",343,0)
+"RTN","C0CRIMA",340,0)
D APUSH(RIMTBL,"PROBNODATE")
-"RTN","C0CRIMA",344,0)
+"RTN","C0CRIMA",341,0)
D APUSH(RIMTBL,"VITALS")
-"RTN","C0CRIMA",345,0)
+"RTN","C0CRIMA",342,0)
D APUSH(RIMTBL,"VITALSCODE")
-"RTN","C0CRIMA",346,0)
+"RTN","C0CRIMA",343,0)
D APUSH(RIMTBL,"VITALSNOCODE")
-"RTN","C0CRIMA",347,0)
+"RTN","C0CRIMA",344,0)
D APUSH(RIMTBL,"VITALSDATE")
-"RTN","C0CRIMA",348,0)
+"RTN","C0CRIMA",345,0)
D APUSH(RIMTBL,"VITALSNODATE")
-"RTN","C0CRIMA",349,0)
+"RTN","C0CRIMA",346,0)
D APUSH(RIMTBL,"IMMUNE")
-"RTN","C0CRIMA",350,0)
+"RTN","C0CRIMA",347,0)
D APUSH(RIMTBL,"IMMUNECODE")
-"RTN","C0CRIMA",351,0)
+"RTN","C0CRIMA",348,0)
D APUSH(RIMTBL,"MEDS")
-"RTN","C0CRIMA",352,0)
+"RTN","C0CRIMA",349,0)
D APUSH(RIMTBL,"MEDSCODE")
-"RTN","C0CRIMA",353,0)
+"RTN","C0CRIMA",350,0)
D APUSH(RIMTBL,"MEDSNOCODE")
-"RTN","C0CRIMA",354,0)
+"RTN","C0CRIMA",351,0)
D APUSH(RIMTBL,"MEDSDATE")
-"RTN","C0CRIMA",355,0)
+"RTN","C0CRIMA",352,0)
D APUSH(RIMTBL,"MEDSNODATE")
-"RTN","C0CRIMA",356,0)
+"RTN","C0CRIMA",353,0)
D APUSH(RIMTBL,"ALERTS")
-"RTN","C0CRIMA",357,0)
+"RTN","C0CRIMA",354,0)
D APUSH(RIMTBL,"ALERTSCODE")
-"RTN","C0CRIMA",358,0)
+"RTN","C0CRIMA",355,0)
D APUSH(RIMTBL,"RESULTS")
-"RTN","C0CRIMA",359,0)
+"RTN","C0CRIMA",356,0)
D APUSH(RIMTBL,"RESULTSLN")
-"RTN","C0CRIMA",360,0)
+"RTN","C0CRIMA",357,0)
D APUSH(RIMTBL,"PROCEDURES")
-"RTN","C0CRIMA",361,0)
+"RTN","C0CRIMA",358,0)
D APUSH(RIMTBL,"ENCOUNTERS")
-"RTN","C0CRIMA",362,0)
+"RTN","C0CRIMA",359,0)
D APUSH(RIMTBL,"NOTES")
-"RTN","C0CRIMA",363,0)
+"RTN","C0CRIMA",360,0)
Q
-"RTN","C0CRIMA",364,0)
+"RTN","C0CRIMA",361,0)
;
-"RTN","C0CRIMA",365,0)
+"RTN","C0CRIMA",362,0)
APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
-"RTN","C0CRIMA",366,0)
+"RTN","C0CRIMA",363,0)
; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
-"RTN","C0CRIMA",367,0)
+"RTN","C0CRIMA",364,0)
; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
-"RTN","C0CRIMA",368,0)
+"RTN","C0CRIMA",365,0)
; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
-"RTN","C0CRIMA",369,0)
+"RTN","C0CRIMA",366,0)
I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
-"RTN","C0CRIMA",370,0)
+"RTN","C0CRIMA",367,0)
N USETBL
-"RTN","C0CRIMA",371,0)
+"RTN","C0CRIMA",368,0)
I '$D(@RIMBASE@("TABLES",PTBL)) D Q ; NO TABLE
-"RTN","C0CRIMA",372,0)
+"RTN","C0CRIMA",369,0)
. W "ERROR NO SUCH TABLE",!
-"RTN","C0CRIMA",373,0)
+"RTN","C0CRIMA",370,0)
S USETBL=@RIMBASE@("TABLES",PTBL)
-"RTN","C0CRIMA",374,0)
+"RTN","C0CRIMA",371,0)
S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
-"RTN","C0CRIMA",375,0)
+"RTN","C0CRIMA",372,0)
Q
-"RTN","C0CRIMA",376,0)
+"RTN","C0CRIMA",373,0)
GETPA(RTN,DFN,ISEC,IVAR) ; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN
-"RTN","C0CRIMA",377,0)
+"RTN","C0CRIMA",374,0)
; EXAMPLE: D GETPA(.RT,2,"MEDS","MEDSSTATUSTEXT")
-"RTN","C0CRIMA",378,0)
+"RTN","C0CRIMA",375,0)
; RETURNS AN ARRAY RT OF VALUES OF MEDSTATUSTEXT FOR PATIENT 2 IN P2
-"RTN","C0CRIMA",379,0)
+"RTN","C0CRIMA",376,0)
; IN SECTION "MEDS"
-"RTN","C0CRIMA",380,0)
+"RTN","C0CRIMA",377,0)
; P1 IS THE IEN OF THE MED WITH THE VALUE IE 2^PENDING WOULD BE STATUS
-"RTN","C0CRIMA",381,0)
+"RTN","C0CRIMA",378,0)
; PENDING FOR MED 2 FOR PATIENT 2
-"RTN","C0CRIMA",382,0)
+"RTN","C0CRIMA",379,0)
; RT(0) IS THE COUNT OF HOW MANY IN THE ARRAY. NULL VALUES ARE
-"RTN","C0CRIMA",383,0)
+"RTN","C0CRIMA",380,0)
; RETURNED. RTN IS PASSED BY REFERENCE
-"RTN","C0CRIMA",384,0)
+"RTN","C0CRIMA",381,0)
;
-"RTN","C0CRIMA",385,0)
+"RTN","C0CRIMA",382,0)
S RTN(0)=0 ; SET NULL DEFAULT RETURN VALUE
-"RTN","C0CRIMA",386,0)
+"RTN","C0CRIMA",383,0)
I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
-"RTN","C0CRIMA",387,0)
+"RTN","C0CRIMA",384,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)
+"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",390,0)
+"RTN","C0CRIMA",387,0)
N ZZI,ZZS
-"RTN","C0CRIMA",391,0)
+"RTN","C0CRIMA",388,0)
S ZZS=$NA(@ZVBASE@(DFN,ISEC)) ; SECTION VARIABLE ARRAY FOR THIS PATIENT
-"RTN","C0CRIMA",392,0)
+"RTN","C0CRIMA",389,0)
; ZWR @ZZS@(1)
-"RTN","C0CRIMA",393,0)
+"RTN","C0CRIMA",390,0)
S RTN(0)=@ZZS@(0)
-"RTN","C0CRIMA",394,0)
+"RTN","C0CRIMA",391,0)
F ZZI=1:1:RTN(0) D ; FOR ALL PARTS OF THIS SECTION ( IE FOR ALL MEDS)
-"RTN","C0CRIMA",395,0)
+"RTN","C0CRIMA",392,0)
. S $P(RTN(ZZI),"^",1)=ZZI ; INDEX FOR VARIABLE
-"RTN","C0CRIMA",396,0)
+"RTN","C0CRIMA",393,0)
. S $P(RTN(ZZI),"^",2)=@ZZS@(ZZI,IVAR) ; THE VALUE OF THE VARIABLE
-"RTN","C0CRIMA",397,0)
+"RTN","C0CRIMA",394,0)
Q
-"RTN","C0CRIMA",398,0)
+"RTN","C0CRIMA",395,0)
;
-"RTN","C0CRIMA",399,0)
+"RTN","C0CRIMA",396,0)
PATD(DFN,ISEC,IVAR) ; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR
-"RTN","C0CRIMA",400,0)
+"RTN","C0CRIMA",397,0)
;
-"RTN","C0CRIMA",401,0)
+"RTN","C0CRIMA",398,0)
N ZR
-"RTN","C0CRIMA",402,0)
+"RTN","C0CRIMA",399,0)
D GETPA(.ZR,DFN,ISEC,IVAR)
-"RTN","C0CRIMA",403,0)
+"RTN","C0CRIMA",400,0)
I $D(ZR(0)) D PARY^C0CXPATH("ZR")
-"RTN","C0CRIMA",404,0)
+"RTN","C0CRIMA",401,0)
E W "NOTHING RETURNED",!
-"RTN","C0CRIMA",405,0)
+"RTN","C0CRIMA",402,0)
Q
-"RTN","C0CRIMA",406,0)
+"RTN","C0CRIMA",403,0)
;
-"RTN","C0CRIMA",407,0)
+"RTN","C0CRIMA",404,0)
CAGET(RTN,IATTR) ;
-"RTN","C0CRIMA",408,0)
+"RTN","C0CRIMA",405,0)
; GETPA LOOKS AT RIMTBL TO FIND PATIENTS WITH ATTRIBUTE IATTR
-"RTN","C0CRIMA",409,0)
+"RTN","C0CRIMA",406,0)
; IT DOES NOT SEARCH ALL PATIENTS, ONLY THE ONES WITH THE ATTRIBUTE
-"RTN","C0CRIMA",410,0)
+"RTN","C0CRIMA",407,0)
; IT RETURNS AN ARRAY OF THE VALUES OF VARIABLE IVAR IN SECTION ISEC
-"RTN","C0CRIMA",411,0)
+"RTN","C0CRIMA",408,0)
Q
-"RTN","C0CRIMA",412,0)
+"RTN","C0CRIMA",409,0)
;
-"RTN","C0CRIMA",413,0)
+"RTN","C0CRIMA",410,0)
PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
-"RTN","C0CRIMA",414,0)
+"RTN","C0CRIMA",411,0)
;
-"RTN","C0CRIMA",415,0)
+"RTN","C0CRIMA",412,0)
I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
-"RTN","C0CRIMA",416,0)
+"RTN","C0CRIMA",413,0)
N ZLST
-"RTN","C0CRIMA",417,0)
+"RTN","C0CRIMA",414,0)
S @LSTRTN@(0)=0 ; DEFAULT RETURN NONE
-"RTN","C0CRIMA",418,0)
+"RTN","C0CRIMA",415,0)
S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
-"RTN","C0CRIMA",419,0)
+"RTN","C0CRIMA",416,0)
S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
-"RTN","C0CRIMA",420,0)
+"RTN","C0CRIMA",417,0)
N ZNC ; ZNC IS NUMBER OF CATEGORIES
-"RTN","C0CRIMA",421,0)
+"RTN","C0CRIMA",418,0)
S ZNC=@ZCBASE@(0)
-"RTN","C0CRIMA",422,0)
- I ZNC=0 Q ; NO CATEGORIES TO SEARCH
-"RTN","C0CRIMA",423,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",424,0)
+"RTN","C0CRIMA",421,0)
S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR)
-"RTN","C0CRIMA",425,0)
+"RTN","C0CRIMA",422,0)
N ZI,ZCATTBL,ZATBL,ZCNT,ZPAT
-"RTN","C0CRIMA",426,0)
+"RTN","C0CRIMA",423,0)
F ZI=1:1:ZNC D ; FOR ALL CATEGORIES
-"RTN","C0CRIMA",427,0)
+"RTN","C0CRIMA",424,0)
. S ZATBL=@ZCBASE@(ZI) ; PULL OUT ATTR TBL FOR CAT
-"RTN","C0CRIMA",428,0)
+"RTN","C0CRIMA",425,0)
. I $P(ZATBL,"^",ZAP)'="" D ; CAT HAS ATTR
-"RTN","C0CRIMA",429,0)
+"RTN","C0CRIMA",426,0)
. . S ZCATTBL=$P(@ZCBASE@(ZATBL),"^",1) ; NAME OF TBL
-"RTN","C0CRIMA",430,0)
+"RTN","C0CRIMA",427,0)
. . M @LSTRTN=@ZPBASE@(ZCATTBL) ; MERGE PATS FROM CAT
-"RTN","C0CRIMA",431,0)
+"RTN","C0CRIMA",428,0)
S ZCNT=0 ; INITIALIZE COUNT OF PATIENTS
-"RTN","C0CRIMA",432,0)
+"RTN","C0CRIMA",429,0)
S ZPAT=0 ; START AT FIRST PATIENT IN LIST
-"RTN","C0CRIMA",433,0)
+"RTN","C0CRIMA",430,0)
F S ZPAT=$O(@LSTRTN@(ZPAT)) Q:ZPAT="" D ;
-"RTN","C0CRIMA",434,0)
+"RTN","C0CRIMA",431,0)
. S ZCNT=ZCNT+1
-"RTN","C0CRIMA",435,0)
+"RTN","C0CRIMA",432,0)
S @LSTRTN@(0)=ZCNT ; COUNT OF PATIENTS IN ARRAY
-"RTN","C0CRIMA",436,0)
+"RTN","C0CRIMA",433,0)
Q
-"RTN","C0CRIMA",437,0)
+"RTN","C0CRIMA",434,0)
;
-"RTN","C0CRIMA",438,0)
+"RTN","C0CRIMA",435,0)
DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
-"RTN","C0CRIMA",439,0)
+"RTN","C0CRIMA",436,0)
;
-"RTN","C0CRIMA",440,0)
+"RTN","C0CRIMA",437,0)
;N ZR
-"RTN","C0CRIMA",441,0)
+"RTN","C0CRIMA",438,0)
D PCLST("ZR",CATTR)
-"RTN","C0CRIMA",442,0)
+"RTN","C0CRIMA",439,0)
I ZR(0)=0 D Q ;
-"RTN","C0CRIMA",443,0)
+"RTN","C0CRIMA",440,0)
. W "NO PATIENTS RETURNED",!
-"RTN","C0CRIMA",444,0)
+"RTN","C0CRIMA",441,0)
E D ;
-"RTN","C0CRIMA",445,0)
+"RTN","C0CRIMA",442,0)
. N ZI S ZI=0
-"RTN","C0CRIMA",446,0)
+"RTN","C0CRIMA",443,0)
. F S ZI=$O(ZR(ZI)) Q:ZI="" D ;
-"RTN","C0CRIMA",447,0)
+"RTN","C0CRIMA",444,0)
. . W !,ZI
-"RTN","C0CRIMA",448,0)
+"RTN","C0CRIMA",445,0)
. ;D PARY^C0CXPATH("ZR") ; PRINT ARRAY
-"RTN","C0CRIMA",449,0)
+"RTN","C0CRIMA",446,0)
. W !,"COUNT=",ZR(0)
-"RTN","C0CRIMA",450,0)
+"RTN","C0CRIMA",447,0)
Q
-"RTN","C0CRIMA",451,0)
+"RTN","C0CRIMA",448,0)
;
-"RTN","C0CRIMA",452,0)
+"RTN","C0CRIMA",449,0)
RPCGV(RTN,DFN,WHICH) ; RPC GET VARS
-"RTN","C0CRIMA",453,0)
+"RTN","C0CRIMA",450,0)
; RETURNS IN RTN (PASSED BY REFERENCE) THE VARS AND VALUES
-"RTN","C0CRIMA",454,0)
+"RTN","C0CRIMA",451,0)
; FOUND AT INARY RTN(X)="VAR^VALUE" RTN(0) IS THE COUNT
-"RTN","C0CRIMA",455,0)
+"RTN","C0CRIMA",452,0)
; DFN IS THE PATIENT NUMBER.
-"RTN","C0CRIMA",456,0)
+"RTN","C0CRIMA",453,0)
; WHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS","IMMUNE"
-"RTN","C0CRIMA",457,0)
+"RTN","C0CRIMA",454,0)
; OR OTHER SECTIONS AS THEY ARE ADDED
-"RTN","C0CRIMA",458,0)
+"RTN","C0CRIMA",455,0)
; THIS IS MEANT TO BE AVAILABLE AS AN RPC
-"RTN","C0CRIMA",459,0)
+"RTN","C0CRIMA",456,0)
I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","C0CRIMA",460,0)
+"RTN","C0CRIMA",457,0)
S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
-"RTN","C0CRIMA",461,0)
+"RTN","C0CRIMA",458,0)
S RTN(0)=0 ; DEFAULT NOTHING IS RETURNED
-"RTN","C0CRIMA",462,0)
+"RTN","C0CRIMA",459,0)
N ZZGI
-"RTN","C0CRIMA",463,0)
+"RTN","C0CRIMA",460,0)
I WHICH="ALL" D ; VARIABLES FROM ALL SECTIONS
-"RTN","C0CRIMA",464,0)
+"RTN","C0CRIMA",461,0)
. F ZZGI="HEADER","PROBLEMS","VITALS","MEDS","ALERTS","RESULTS","IMMUNE","PROCEDURES" D ;
-"RTN","C0CRIMA",465,0)
+"RTN","C0CRIMA",462,0)
. . D ZGVWRK(ZZGI) ; DO EACH SECTION
-"RTN","C0CRIMA",466,0)
+"RTN","C0CRIMA",463,0)
. . I $G(DEBUG)'="" W "DID ",ZZGI,!
-"RTN","C0CRIMA",467,0)
+"RTN","C0CRIMA",464,0)
E D ZGVWRK(WHICH) ; ONLY ONE SECTION ASKED FOR
-"RTN","C0CRIMA",468,0)
+"RTN","C0CRIMA",465,0)
Q
-"RTN","C0CRIMA",469,0)
+"RTN","C0CRIMA",466,0)
;
-"RTN","C0CRIMA",470,0)
+"RTN","C0CRIMA",467,0)
ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV
-"RTN","C0CRIMA",471,0)
+"RTN","C0CRIMA",468,0)
;
-"RTN","C0CRIMA",472,0)
+"RTN","C0CRIMA",469,0)
N ZZGN ; NAME FOR SECTION VARIABLES
-"RTN","C0CRIMA",473,0)
+"RTN","C0CRIMA",470,0)
S ZZGN=$NA(@ZVBASE@(DFN,ZWHICH)) ; BASE OF VARS FOR SECTION
-"RTN","C0CRIMA",474,0)
+"RTN","C0CRIMA",471,0)
;I '$D(@ZZGN@(0)) Q ; NO VARS FOR THIS SECTION
-"RTN","C0CRIMA",475,0)
+"RTN","C0CRIMA",472,0)
I $O(@ZZGN@(""),-1)="" D ;
-"RTN","C0CRIMA",476,0)
+"RTN","C0CRIMA",473,0)
E D ; VARS EXIST
-"RTN","C0CRIMA",477,0)
+"RTN","C0CRIMA",474,0)
. N ZGVI,ZGVN
-"RTN","C0CRIMA",478,0)
+"RTN","C0CRIMA",475,0)
. S ZGVN=$O(@ZZGN@(""),-1) ;COUNT OF VARS
-"RTN","C0CRIMA",479,0)
+"RTN","C0CRIMA",476,0)
. F ZGVI=1:1:ZGVN D ; FOR EACH MULTIPLE IN SECTION
-"RTN","C0CRIMA",480,0)
+"RTN","C0CRIMA",477,0)
. . K ZZGA N ZZGA ; TEMP ARRAY FOR SECTION VARS
-"RTN","C0CRIMA",481,0)
+"RTN","C0CRIMA",478,0)
. . K ZZGN2 N ZZGN2 ; NAME FOR MULTIPLE
-"RTN","C0CRIMA",482,0)
+"RTN","C0CRIMA",479,0)
. . S ZZGN2=$NA(@ZZGN@(ZGVI))
-"RTN","C0CRIMA",483,0)
+"RTN","C0CRIMA",480,0)
. . I $G(DEBUG)'="" W ZZGN2,!,$O(@ZZGN2@("")),!
-"RTN","C0CRIMA",484,0)
+"RTN","C0CRIMA",481,0)
. . D H2ARY^C0CXPATH("ZZGA",ZZGN2,ZGVI) ; CONVERT HASH TO ARRAY
-"RTN","C0CRIMA",485,0)
+"RTN","C0CRIMA",482,0)
. . ; D PARY^C0CXPATH("ZZGA")
-"RTN","C0CRIMA",486,0)
+"RTN","C0CRIMA",483,0)
. . D PUSHA^C0CXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN
-"RTN","C0CRIMA",487,0)
+"RTN","C0CRIMA",484,0)
Q
-"RTN","C0CRIMA",488,0)
+"RTN","C0CRIMA",485,0)
;
-"RTN","C0CRIMA",489,0)
+"RTN","C0CRIMA",486,0)
DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN C0CRIM
-"RTN","C0CRIMA",490,0)
+"RTN","C0CRIMA",487,0)
; ALONG WITH SAMPLE VALUES.
-"RTN","C0CRIMA",491,0)
+"RTN","C0CRIMA",488,0)
; IWHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS","HEADER"
-"RTN","C0CRIMA",492,0)
+"RTN","C0CRIMA",489,0)
N GTMP
-"RTN","C0CRIMA",493,0)
+"RTN","C0CRIMA",490,0)
I '$D(^TMP("C0CRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT
-"RTN","C0CRIMA",494,0)
+"RTN","C0CRIMA",491,0)
. D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
-"RTN","C0CRIMA",495,0)
+"RTN","C0CRIMA",492,0)
I '$D(IWHICH) S IWHICH="ALL"
-"RTN","C0CRIMA",496,0)
+"RTN","C0CRIMA",493,0)
D RPCGV(.GTMP,DFN,IWHICH)
-"RTN","C0CRIMA",497,0)
+"RTN","C0CRIMA",494,0)
D PARY^C0CXPATH("GTMP")
-"RTN","C0CRIMA",498,0)
+"RTN","C0CRIMA",495,0)
Q
-"RTN","C0CRIMA",499,0)
+"RTN","C0CRIMA",496,0)
;
-"RTN","C0CRIMA",500,0)
+"RTN","C0CRIMA",497,0)
RIM2RNF(R2RTN,DFN,RWHICH) ; CONVERTS RIM VARIABLES TO RNF2 FORMAT
-"RTN","C0CRIMA",501,0)
+"RTN","C0CRIMA",498,0)
; RETURN IN R2RTN, WHICH IS PASSED BY NAME
-"RTN","C0CRIMA",502,0)
+"RTN","C0CRIMA",499,0)
; RWHICH IS RIM SECTION TO RETURN, DEFAULTS TO "ALL"
-"RTN","C0CRIMA",503,0)
+"RTN","C0CRIMA",500,0)
;
-"RTN","C0CRIMA",504,0)
+"RTN","C0CRIMA",501,0)
I '$D(RWHICH) S RWHICH="ALL"
-"RTN","C0CRIMA",505,0)
+"RTN","C0CRIMA",502,0)
;N R2TMP
-"RTN","C0CRIMA",506,0)
+"RTN","C0CRIMA",503,0)
I '$D(^TMP("C0CRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT
-"RTN","C0CRIMA",507,0)
+"RTN","C0CRIMA",504,0)
. D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
-"RTN","C0CRIMA",508,0)
+"RTN","C0CRIMA",505,0)
D RPCGV(.R2TMP,DFN,RWHICH) ; RETRIEVE ALL THE VARIABLES I AN ARRAY
-"RTN","C0CRIMA",509,0)
+"RTN","C0CRIMA",506,0)
N R2I,R2J,R2X,R2X1,R2X2,R2Y,R2Z
-"RTN","C0CRIMA",510,0)
+"RTN","C0CRIMA",507,0)
F R2I=1:1:R2TMP(0) D ; FOR EVERY LINE OF THE ARRAY
-"RTN","C0CRIMA",511,0)
+"RTN","C0CRIMA",508,0)
. S R2X=$P(R2TMP(R2I),"^",1) ; OCCURANCE
-"RTN","C0CRIMA",512,0)
+"RTN","C0CRIMA",509,0)
. S R2Y=$P(R2TMP(R2I),"^",2) ; VARIABLE NAME
-"RTN","C0CRIMA",513,0)
+"RTN","C0CRIMA",510,0)
. I $L(R2Y)<4 Q ; SKIP SHORT VARIABLES (THEY ARE FOR DEBUGGING)
-"RTN","C0CRIMA",514,0)
+"RTN","C0CRIMA",511,0)
. S R2Z=$P(R2TMP(R2I),"^",3) ; VALUE
-"RTN","C0CRIMA",515,0)
+"RTN","C0CRIMA",512,0)
. I R2X[";" D ; THERES MULTIPLES
-"RTN","C0CRIMA",516,0)
+"RTN","C0CRIMA",513,0)
. . S R2X1=$P(R2X,";",1) ; FIRST INDEX
-"RTN","C0CRIMA",517,0)
+"RTN","C0CRIMA",514,0)
. . S R2X2=$P(R2X,";",2) ; SECOND INDEX
-"RTN","C0CRIMA",518,0)
+"RTN","C0CRIMA",515,0)
. . S R2J=R2Y_"["_R2X2_"]" ; BUILD THE VARIABLE NAME
-"RTN","C0CRIMA",519,0)
+"RTN","C0CRIMA",516,0)
. . S @R2RTN@("F",R2J,1)="" ; PUT VARIABLE NAME IN FIELD MAP
-"RTN","C0CRIMA",520,0)
+"RTN","C0CRIMA",517,0)
. . S @R2RTN@("V",R2X1,R2J,1)=R2Z ; PUT THE VALUE IN THE ARRAY
-"RTN","C0CRIMA",521,0)
+"RTN","C0CRIMA",518,0)
. E D ; NO SUB-MULTIPLES
-"RTN","C0CRIMA",522,0)
+"RTN","C0CRIMA",519,0)
. . S @R2RTN@("F",R2Y,1)="" ; PUT VARIABLE NAME IN FIELD MAP
-"RTN","C0CRIMA",523,0)
+"RTN","C0CRIMA",520,0)
. . S @R2RTN@("V",R2X,R2Y,1)=R2Z ; PUT THE VALUE IN THE ARRAY
-"RTN","C0CRIMA",524,0)
+"RTN","C0CRIMA",521,0)
Q
-"RTN","C0CRIMA",525,0)
+"RTN","C0CRIMA",522,0)
;
-"RTN","C0CRIMA",526,0)
+"RTN","C0CRIMA",523,0)
RIM2CSV(DFN) ; WRITE THE RIM VARIABLES FOR A PATIENT TO A CSV FILE
-"RTN","C0CRIMA",527,0)
+"RTN","C0CRIMA",524,0)
;
-"RTN","C0CRIMA",528,0)
+"RTN","C0CRIMA",525,0)
N R2CTMP,R2CARY
-"RTN","C0CRIMA",529,0)
+"RTN","C0CRIMA",526,0)
D RIM2RNF("R2CTMP",DFN) ; CONVERT VARIABLES TO RNF FORMAT
-"RTN","C0CRIMA",530,0)
+"RTN","C0CRIMA",527,0)
D RNF2CSV^C0CRNF("R2CARY","R2CTMP","NV") ; CONVERT RNF TO CSV FORMAT
-"RTN","C0CRIMA",531,0)
+"RTN","C0CRIMA",528,0)
D FILEOUT^C0CRNF("R2CARY","VARS-"_DFN_".csv")
-"RTN","C0CRIMA",532,0)
+"RTN","C0CRIMA",529,0)
Q
-"RTN","C0CRIMA",533,0)
+"RTN","C0CRIMA",530,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 .
"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.
-"RTN","C0CRNF",19,0)
- ;
-"RTN","C0CRNF",20,0)
W "This is the Reference Name Format (RNF) Utility Library ",!
-"RTN","C0CRNF",21,0)
+"RTN","C0CRNF",19,0)
W !
+"RTN","C0CRNF",20,0)
+ Q
+"RTN","C0CRNF",21,0)
+ ;
"RTN","C0CRNF",22,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)
+"RTN","C0CRNF",23,0)
; C0CFRTN IS PASSED BY NAME, C0CF IS PASSED BY VALUE
-"RTN","C0CRNF",26,0)
+"RTN","C0CRNF",24,0)
;
-"RTN","C0CRNF",27,0)
+"RTN","C0CRNF",25,0)
N C0CFI,C0CFJ ;INNER LOOP, OUTER LOOP
-"RTN","C0CRNF",28,0)
+"RTN","C0CRNF",26,0)
N C0CFN ; FIELD NAME
-"RTN","C0CRNF",29,0)
+"RTN","C0CRNF",27,0)
S C0CFI=0 S C0CFJ=C0CF
-"RTN","C0CRNF",30,0)
+"RTN","C0CRNF",28,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)
+"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",33,0)
+"RTN","C0CRNF",31,0)
. F S C0CFI=$O(^DD(C0CFJ,C0CFI)) Q:+C0CFI=0 D ; EVERY FIELD
-"RTN","C0CRNF",34,0)
+"RTN","C0CRNF",32,0)
. . ;W "2: "_C0CFJ," ",C0CFI,!
-"RTN","C0CRNF",35,0)
+"RTN","C0CRNF",33,0)
. . S C0CFN=$P($G(^DD(C0CFJ,C0CFI,0)),"^",1) ;PULL FIELD NAME FROM ^DD
-"RTN","C0CRNF",36,0)
+"RTN","C0CRNF",34,0)
. . ;W "N: ",C0CFN,!
-"RTN","C0CRNF",37,0)
+"RTN","C0CRNF",35,0)
. . ;I C0CFN="STR" W C0CFN," ",C0CFJ,!
-"RTN","C0CRNF",38,0)
+"RTN","C0CRNF",36,0)
. . I $D(@C0CFRTN@(C0CFN)) D ; IS THIS A DUPLICATE?
-"RTN","C0CRNF",39,0)
+"RTN","C0CRNF",37,0)
. . . I $G(DEBUG) D ;
-"RTN","C0CRNF",40,0)
+"RTN","C0CRNF",38,0)
. . . . W "DUPLICATE FOUND! ",C0CFJ," ",C0CFI," ",C0CFN,!,@C0CFRTN@(C0CFN),!
-"RTN","C0CRNF",41,0)
+"RTN","C0CRNF",39,0)
. . . S @C0CFRTN@(C0CFN_"_"_C0CFJ)=C0CFJ_"^"_C0CFI
-"RTN","C0CRNF",42,0)
+"RTN","C0CRNF",40,0)
. . E S @C0CFRTN@(C0CFN)=C0CFJ_"^"_C0CFI
-"RTN","C0CRNF",43,0)
+"RTN","C0CRNF",41,0)
. S C0CFJ=$O(^DD(C0CFJ)) ; NEXT SUBFILE
+"RTN","C0CRNF",42,0)
+ Q
+"RTN","C0CRNF",43,0)
+ ;
"RTN","C0CRNF",44,0)
- Q
-"RTN","C0CRNF",45,0)
- ;
-"RTN","C0CRNF",46,0)
TESTRNF ; TEST THE RNF1TO2 ROUTINE
-"RTN","C0CRNF",47,0)
+"RTN","C0CRNF",45,0)
S G1("ONE")=1
-"RTN","C0CRNF",48,0)
+"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("THREE")=3
-"RTN","C0CRNF",50,0)
- D RNF1TO2("GPL","G1")
-"RTN","C0CRNF",51,0)
S G1("ONE")="NOT1"
-"RTN","C0CRNF",52,0)
+"RTN","C0CRNF",50,0)
S G1("TWO")="STILL2"
-"RTN","C0CRNF",53,0)
+"RTN","C0CRNF",51,0)
S G1("THREE")=3
-"RTN","C0CRNF",54,0)
+"RTN","C0CRNF",52,0)
D RNF1TO2("GPL","G1")
+"RTN","C0CRNF",53,0)
+ ; ZWR GPL
+"RTN","C0CRNF",54,0)
+ Q
"RTN","C0CRNF",55,0)
- ZWR GPL
+ ;
"RTN","C0CRNF",56,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",57,0)
+ ; (ZOUT) BOTH ARE PASSED BY NAME
+"RTN","C0CRNF",58,0)
+ ; RNF1 IS OF THE FORM:
"RTN","C0CRNF",59,0)
- ; (ZOUT) BOTH ARE PASSED BY NAME
+ ; @ZIN@("VAR1")=VAL1
"RTN","C0CRNF",60,0)
- ; RNF1 IS OF THE FORM:
+ ; @ZIN@("VAR2")=VAL2
"RTN","C0CRNF",61,0)
- ; @ZIN@("VAR1")=VAL1
+ ; RNF2 IS OF THE FORM:
"RTN","C0CRNF",62,0)
- ; @ZIN@("VAR2")=VAL2
+ ; @ZOUT@("F","VAR1")=""
"RTN","C0CRNF",63,0)
- ; RNF2 IS OF THE FORM:
+ ; @ZOUT@("F","VAR2")=""
"RTN","C0CRNF",64,0)
- ; @ZOUT@("F","VAR1")=""
-"RTN","C0CRNF",65,0)
- ; @ZOUT@("F","VAR2")=""
-"RTN","C0CRNF",66,0)
; @ZOUT@("V",n,"VAR1")=VAL1
-"RTN","C0CRNF",67,0)
+"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)
- ; WHERE n IS THE "ROW" OF THE ARRAY
+ N ZN
"RTN","C0CRNF",69,0)
- N ZI S ZI=""
+ I '$D(@ZOUT@("V",1)) S ZN=1
"RTN","C0CRNF",70,0)
- N ZN
+ E S ZN=$O(@ZOUT@("V",""),-1)+1
"RTN","C0CRNF",71,0)
- I '$D(@ZOUT@("V",1)) S ZN=1
+ F S ZI=$O(@ZIN@(ZI)) Q:ZI="" D ;
"RTN","C0CRNF",72,0)
- E S ZN=$O(@ZOUT@("V",""),-1)+1
+ . S @ZOUT@("F",ZI)=""
"RTN","C0CRNF",73,0)
- F S ZI=$O(@ZIN@(ZI)) Q:ZI="" D ;
-"RTN","C0CRNF",74,0)
- . S @ZOUT@("F",ZI)=""
-"RTN","C0CRNF",75,0)
. S @ZOUT@("V",ZN,ZI)=@ZIN@(ZI)
+"RTN","C0CRNF",74,0)
+ Q
+"RTN","C0CRNF",75,0)
+ ;
"RTN","C0CRNF",76,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)
+"RTN","C0CRNF",77,0)
; THE "B" ROUTINE SUPPORTS WP FIELDS IN THE ARRAY
-"RTN","C0CRNF",80,0)
+"RTN","C0CRNF",78,0)
; EVERY "V" VARIABLE IS FOLLOWED BY A "1"
-"RTN","C0CRNF",81,0)
+"RTN","C0CRNF",79,0)
; FOR EXAMPLE @G@("V",n,"VAR1",1)="VALUE1"
-"RTN","C0CRNF",82,0)
+"RTN","C0CRNF",80,0)
; USE THIS ROUTINE IF YOU WANT TO CONVERT THE RESULT TO A CSV
-"RTN","C0CRNF",83,0)
+"RTN","C0CRNF",81,0)
; WITH RNF2CSV
-"RTN","C0CRNF",84,0)
+"RTN","C0CRNF",82,0)
; (ZOUT) BOTH ARE PASSED BY NAME
-"RTN","C0CRNF",85,0)
+"RTN","C0CRNF",83,0)
; RNF1 IS OF THE FORM:
-"RTN","C0CRNF",86,0)
+"RTN","C0CRNF",84,0)
; @ZIN@("VAR1")=VAL1
-"RTN","C0CRNF",87,0)
+"RTN","C0CRNF",85,0)
; @ZIN@("VAR2")=VAL2
-"RTN","C0CRNF",88,0)
+"RTN","C0CRNF",86,0)
; RNF2 IS OF THE FORM:
-"RTN","C0CRNF",89,0)
+"RTN","C0CRNF",87,0)
; @ZOUT@("F","VAR1")=""
-"RTN","C0CRNF",90,0)
+"RTN","C0CRNF",88,0)
; @ZOUT@("F","VAR2")=""
-"RTN","C0CRNF",91,0)
+"RTN","C0CRNF",89,0)
; @ZOUT@("V",n,"VAR1",1)=VAL1
-"RTN","C0CRNF",92,0)
+"RTN","C0CRNF",90,0)
; @ZOUT@("V",n,"VAR2",1)=VAL2
-"RTN","C0CRNF",93,0)
+"RTN","C0CRNF",91,0)
; WHERE n IS THE "ROW" OF THE ARRAY
-"RTN","C0CRNF",94,0)
+"RTN","C0CRNF",92,0)
N ZI S ZI=""
-"RTN","C0CRNF",95,0)
+"RTN","C0CRNF",93,0)
N ZN
-"RTN","C0CRNF",96,0)
+"RTN","C0CRNF",94,0)
I '$D(@ZOUT@("V",1)) S ZN=1
-"RTN","C0CRNF",97,0)
+"RTN","C0CRNF",95,0)
E S ZN=$O(@ZOUT@("V",""),-1)+1
-"RTN","C0CRNF",98,0)
+"RTN","C0CRNF",96,0)
F S ZI=$O(@ZIN@(ZI)) Q:ZI="" D ;
-"RTN","C0CRNF",99,0)
+"RTN","C0CRNF",97,0)
. S @ZOUT@("F",ZI)=""
-"RTN","C0CRNF",100,0)
+"RTN","C0CRNF",98,0)
. S @ZOUT@("V",ZN,ZI,1)=@ZIN@(ZI)
+"RTN","C0CRNF",99,0)
+ Q
+"RTN","C0CRNF",100,0)
+ ;
"RTN","C0CRNF",101,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)
+"RTN","C0CRNF",102,0)
; GRTN IS PASSED BY NAME
-"RTN","C0CRNF",105,0)
+"RTN","C0CRNF",103,0)
;
-"RTN","C0CRNF",106,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)
- I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
+ S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
"RTN","C0CRNF",108,0)
- E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
+ D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
"RTN","C0CRNF",109,0)
- S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
-"RTN","C0CRNF",110,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",110,0)
D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
-"RTN","C0CRNF",113,0)
+"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 (C0CI,C0CJ)=""
+ . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
"RTN","C0CRNF",115,0)
- F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES
+ . F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS
"RTN","C0CRNF",116,0)
- . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
+ . . ;W C0CJ," ",C0CI,!
"RTN","C0CRNF",117,0)
- . F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS
+ . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
"RTN","C0CRNF",118,0)
- . . ;W C0CJ," ",C0CI,!
-"RTN","C0CRNF",119,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)
+"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 $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
+ . S C0CI=""
"RTN","C0CRNF",123,0)
- I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
+ . F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY
"RTN","C0CRNF",124,0)
- . S C0CI=""
+ . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
"RTN","C0CRNF",125,0)
- . F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY
+ Q
"RTN","C0CRNF",126,0)
- . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
+ ;
"RTN","C0CRNF",127,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",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)
- ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
+ ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
"RTN","C0CRNF",131,0)
- ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
+ ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
"RTN","C0CRNF",132,0)
- ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
+ ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
"RTN","C0CRNF",133,0)
- ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
+ ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
"RTN","C0CRNF",134,0)
- ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
+ ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
"RTN","C0CRNF",135,0)
- ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
+ ; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
"RTN","C0CRNF",136,0)
- ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
+ ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
"RTN","C0CRNF",137,0)
- ; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
+ ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
"RTN","C0CRNF",138,0)
- ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
+ ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
"RTN","C0CRNF",139,0)
- ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
+ ; IF GREF IS "" THE FIRST RECORD IS OBTAINED
"RTN","C0CRNF",140,0)
- ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
+ ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
"RTN","C0CRNF",141,0)
- ; IF GREF IS "" THE FIRST RECORD IS OBTAINED
+ ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
"RTN","C0CRNF",142,0)
- ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
+ ; GREF IS THE VALUE FOR THE INDEX
"RTN","C0CRNF",143,0)
- ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
+ ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
"RTN","C0CRNF",144,0)
- ; GREF IS THE VALUE FOR THE INDEX
+ ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
"RTN","C0CRNF",145,0)
- ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
+ ;
"RTN","C0CRNF",146,0)
- ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
+ ;
"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)
- N GIEN,GF
-"RTN","C0CRNF",150,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",150,0)
+ E D ; WE ARE USING AN INDEX
+"RTN","C0CRNF",151,0)
+ . ;N ZG
"RTN","C0CRNF",152,0)
- E D ; WE ARE USING AN INDEX
+ . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX
"RTN","C0CRNF",153,0)
- . ;N ZG
+ . I ZG'="" D ;
"RTN","C0CRNF",154,0)
- . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX
+ . . I $QS(ZG,3)=GREF D ; IS GREF IN INDEX?
"RTN","C0CRNF",155,0)
- . I ZG'="" D ;
+ . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN
"RTN","C0CRNF",156,0)
- . . I $QS(ZG,3)=GREF D ; IS GREF IN INDEX?
+ . . E S GIEN="" ; NOT FOUND IN INDEX
"RTN","C0CRNF",157,0)
- . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN
+ . E S GIEN="" ;
"RTN","C0CRNF",158,0)
- . . E S GIEN="" ; NOT FOUND IN INDEX
+ ;W "IEN: ",GIEN,!
"RTN","C0CRNF",159,0)
- . E S GIEN="" ;
+ ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
"RTN","C0CRNF",160,0)
- ;W "IEN: ",GIEN,!
+ I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
"RTN","C0CRNF",161,0)
- ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
+ E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
"RTN","C0CRNF",162,0)
- I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
+ S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
"RTN","C0CRNF",163,0)
- E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
+ D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
"RTN","C0CRNF",164,0)
- S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
+ K C0CTMP
"RTN","C0CRNF",165,0)
- D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
+ D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
"RTN","C0CRNF",166,0)
- K C0CTMP
+ D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
"RTN","C0CRNF",167,0)
- D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
+ S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
"RTN","C0CRNF",168,0)
- D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
+ S (C0CI,C0CJ)=""
"RTN","C0CRNF",169,0)
- S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
+ F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES
"RTN","C0CRNF",170,0)
- S (C0CI,C0CJ)=""
+ . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
"RTN","C0CRNF",171,0)
- F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES
+ . F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS
"RTN","C0CRNF",172,0)
- . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
+ . . ;W C0CJ," ",C0CI,!
"RTN","C0CRNF",173,0)
- . F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS
+ . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
"RTN","C0CRNF",174,0)
- . . ;W C0CJ," ",C0CI,!
+ . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
"RTN","C0CRNF",175,0)
- . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
+ . . I C0CVALUE["C0CTMP" D ; WP FIELD
"RTN","C0CRNF",176,0)
- . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
+ . . . N ZT,ZWP S ZWP=0 ;ITERATOR
"RTN","C0CRNF",177,0)
- . . I C0CVALUE["C0CTMP" D ; WP FIELD
+ . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
"RTN","C0CRNF",178,0)
- . . . N ZT,ZWP S ZWP=0 ;ITERATOR
+ . . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE
"RTN","C0CRNF",179,0)
- . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
+ . . . F S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP D ;
"RTN","C0CRNF",180,0)
- . . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE
+ . . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP
"RTN","C0CRNF",181,0)
- . . . F S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP D ;
+ . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
"RTN","C0CRNF",182,0)
- . . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP
+ . . . . S C0CVALUE=C0CVALUE_ZT ;
"RTN","C0CRNF",183,0)
- . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
+ . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
"RTN","C0CRNF",184,0)
- . . . . S C0CVALUE=C0CVALUE_ZT ;
+ . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I"))
"RTN","C0CRNF",185,0)
- . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
+ I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
"RTN","C0CRNF",186,0)
- . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I"))
+ . S C0CI=""
"RTN","C0CRNF",187,0)
- I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
+ . F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY
"RTN","C0CRNF",188,0)
- . S C0CI=""
+ . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
"RTN","C0CRNF",189,0)
- . F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY
+ Q
"RTN","C0CRNF",190,0)
- . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
+ ;
"RTN","C0CRNF",191,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)
+"RTN","C0CRNF",192,0)
; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
-"RTN","C0CRNF",195,0)
+"RTN","C0CRNF",193,0)
; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
-"RTN","C0CRNF",196,0)
+"RTN","C0CRNF",194,0)
; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
-"RTN","C0CRNF",197,0)
+"RTN","C0CRNF",195,0)
; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
-"RTN","C0CRNF",198,0)
+"RTN","C0CRNF",196,0)
; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
-"RTN","C0CRNF",199,0)
+"RTN","C0CRNF",197,0)
; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
-"RTN","C0CRNF",200,0)
+"RTN","C0CRNF",198,0)
; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
-"RTN","C0CRNF",201,0)
+"RTN","C0CRNF",199,0)
; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
-"RTN","C0CRNF",202,0)
+"RTN","C0CRNF",200,0)
; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
-"RTN","C0CRNF",203,0)
+"RTN","C0CRNF",201,0)
; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
-"RTN","C0CRNF",204,0)
+"RTN","C0CRNF",202,0)
; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
-"RTN","C0CRNF",205,0)
+"RTN","C0CRNF",203,0)
; IF GREF IS "" THE FIRST RECORD IS OBTAINED
-"RTN","C0CRNF",206,0)
+"RTN","C0CRNF",204,0)
; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
-"RTN","C0CRNF",207,0)
+"RTN","C0CRNF",205,0)
; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
-"RTN","C0CRNF",208,0)
+"RTN","C0CRNF",206,0)
; GREF IS THE VALUE FOR THE INDEX
-"RTN","C0CRNF",209,0)
+"RTN","C0CRNF",207,0)
; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
-"RTN","C0CRNF",210,0)
+"RTN","C0CRNF",208,0)
; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
+"RTN","C0CRNF",209,0)
+ ;
+"RTN","C0CRNF",210,0)
+ ;
"RTN","C0CRNF",211,0)
- ;
-"RTN","C0CRNF",212,0)
- ;
-"RTN","C0CRNF",213,0)
N GIEN,GF
-"RTN","C0CRNF",214,0)
+"RTN","C0CRNF",212,0)
S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE
-"RTN","C0CRNF",215,0)
+"RTN","C0CRNF",213,0)
I ('$D(GNDX))!(GNDX="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN
-"RTN","C0CRNF",216,0)
+"RTN","C0CRNF",214,0)
E D ; WE ARE USING AN INDEX
-"RTN","C0CRNF",217,0)
+"RTN","C0CRNF",215,0)
. ;N ZG
-"RTN","C0CRNF",218,0)
+"RTN","C0CRNF",216,0)
. S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX
-"RTN","C0CRNF",219,0)
+"RTN","C0CRNF",217,0)
. I ZG'="" D ;
-"RTN","C0CRNF",220,0)
+"RTN","C0CRNF",218,0)
. . I $QS(ZG,3)=GREF D ; IS GREF IN INDEX?
-"RTN","C0CRNF",221,0)
+"RTN","C0CRNF",219,0)
. . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN
-"RTN","C0CRNF",222,0)
+"RTN","C0CRNF",220,0)
. . E S GIEN="" ; NOT FOUND IN INDEX
-"RTN","C0CRNF",223,0)
+"RTN","C0CRNF",221,0)
. E S GIEN="" ;
-"RTN","C0CRNF",224,0)
+"RTN","C0CRNF",222,0)
;W "IEN: ",GIEN,!
-"RTN","C0CRNF",225,0)
+"RTN","C0CRNF",223,0)
;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
-"RTN","C0CRNF",226,0)
+"RTN","C0CRNF",224,0)
I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
-"RTN","C0CRNF",227,0)
+"RTN","C0CRNF",225,0)
E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
-"RTN","C0CRNF",228,0)
+"RTN","C0CRNF",226,0)
S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
-"RTN","C0CRNF",229,0)
+"RTN","C0CRNF",227,0)
D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
-"RTN","C0CRNF",230,0)
+"RTN","C0CRNF",228,0)
K C0CTMP
-"RTN","C0CRNF",231,0)
+"RTN","C0CRNF",229,0)
D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
-"RTN","C0CRNF",232,0)
+"RTN","C0CRNF",230,0)
D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
-"RTN","C0CRNF",233,0)
+"RTN","C0CRNF",231,0)
S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
-"RTN","C0CRNF",234,0)
+"RTN","C0CRNF",232,0)
S (C0CI,C0CJ)=""
-"RTN","C0CRNF",235,0)
+"RTN","C0CRNF",233,0)
F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES
-"RTN","C0CRNF",236,0)
+"RTN","C0CRNF",234,0)
. S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
-"RTN","C0CRNF",237,0)
+"RTN","C0CRNF",235,0)
. F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS
-"RTN","C0CRNF",238,0)
+"RTN","C0CRNF",236,0)
. . ;W C0CJ," ",C0CI,!
-"RTN","C0CRNF",239,0)
+"RTN","C0CRNF",237,0)
. . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
-"RTN","C0CRNF",240,0)
+"RTN","C0CRNF",238,0)
. . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
-"RTN","C0CRNF",241,0)
+"RTN","C0CRNF",239,0)
. . I C0CVALUE["C0CTMP" D ; WP FIELD
-"RTN","C0CRNF",242,0)
+"RTN","C0CRNF",240,0)
. . . N ZT,ZWP S ZWP=0 ;ITERATOR
-"RTN","C0CRNF",243,0)
+"RTN","C0CRNF",241,0)
. . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
-"RTN","C0CRNF",244,0)
+"RTN","C0CRNF",242,0)
. . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE
-"RTN","C0CRNF",245,0)
+"RTN","C0CRNF",243,0)
. . . F S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP D ;
-"RTN","C0CRNF",246,0)
+"RTN","C0CRNF",244,0)
. . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP
-"RTN","C0CRNF",247,0)
+"RTN","C0CRNF",245,0)
. . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
-"RTN","C0CRNF",248,0)
+"RTN","C0CRNF",246,0)
. . . . S C0CVALUE=C0CVALUE_ZT ;
-"RTN","C0CRNF",249,0)
+"RTN","C0CRNF",247,0)
. . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
-"RTN","C0CRNF",250,0)
+"RTN","C0CRNF",248,0)
. . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I"))
-"RTN","C0CRNF",251,0)
+"RTN","C0CRNF",249,0)
I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
-"RTN","C0CRNF",252,0)
+"RTN","C0CRNF",250,0)
. S C0CI=""
-"RTN","C0CRNF",253,0)
+"RTN","C0CRNF",251,0)
. F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY
-"RTN","C0CRNF",254,0)
+"RTN","C0CRNF",252,0)
. . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
-"RTN","C0CRNF",255,0)
+"RTN","C0CRNF",253,0)
Q
-"RTN","C0CRNF",256,0)
+"RTN","C0CRNF",254,0)
;
-"RTN","C0CRNF",257,0)
+"RTN","C0CRNF",255,0)
GETN2(GARTN,GAFILE,GAIDX,GACNT,GASTRT,GANN) ; RETURN FIELD MAP AND VALUES
-"RTN","C0CRNF",258,0)
+"RTN","C0CRNF",256,0)
; GARTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
-"RTN","C0CRNF",259,0)
+"RTN","C0CRNF",257,0)
; .. FIELD MAP @GARTN@("F","FIELDNAME")="FILE;FIELD#"
-"RTN","C0CRNF",260,0)
+"RTN","C0CRNF",258,0)
; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
-"RTN","C0CRNF",261,0)
+"RTN","C0CRNF",259,0)
; .. VALUE MAP @GARTN@("V","IEN","FIELDNAME","N")=VALUE
-"RTN","C0CRNF",262,0)
+"RTN","C0CRNF",260,0)
; .. WHERE N IS THE INDEX FOR MULTIPLES.. 1 FOR SINGLE VALUES
-"RTN","C0CRNF",263,0)
+"RTN","C0CRNF",261,0)
; .. GARTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
-"RTN","C0CRNF",264,0)
+"RTN","C0CRNF",262,0)
; .. IF GANN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
-"RTN","C0CRNF",265,0)
+"RTN","C0CRNF",263,0)
; .. EVEN IF GANN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
-"RTN","C0CRNF",266,0)
+"RTN","C0CRNF",264,0)
; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
-"RTN","C0CRNF",267,0)
+"RTN","C0CRNF",265,0)
; GAFILE IS THE FILE NUMBER TO BE PROCESSED. IT IS PASSED BY VALUE
-"RTN","C0CRNF",268,0)
+"RTN","C0CRNF",266,0)
; GAIDX IS THE OPTIONAL INDEX TO USE IN THE FILE. IF GAIDX IS "" THE IEN
-"RTN","C0CRNF",269,0)
+"RTN","C0CRNF",267,0)
; .. OF THE FILE WILL BE USED
-"RTN","C0CRNF",270,0)
+"RTN","C0CRNF",268,0)
; GACNT IS THE NUMBER OF RECORDS TO PROCESS. IT IS PASSED BY VALUE
-"RTN","C0CRNF",271,0)
+"RTN","C0CRNF",269,0)
; .. IF GARCNT IS NULL, ALL RECORDS ARE PROCESSED
-"RTN","C0CRNF",272,0)
+"RTN","C0CRNF",270,0)
; GASTRT IS THE IEN OF THE FIRST RECORD TO PROCESS. IT IS PASSED BY VALUE
-"RTN","C0CRNF",273,0)
+"RTN","C0CRNF",271,0)
; .. IF GARSTART IS NULL, PROCESSING STARTS AT THE FIRST RECORD
-"RTN","C0CRNF",274,0)
+"RTN","C0CRNF",272,0)
; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
-"RTN","C0CRNF",275,0)
+"RTN","C0CRNF",273,0)
; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GARFLD AND GARVAL
-"RTN","C0CRNF",276,0)
+"RTN","C0CRNF",274,0)
;N GATMP,GAI,GAF
-"RTN","C0CRNF",277,0)
+"RTN","C0CRNF",275,0)
S GAF=$$FILEREF(GAFILE) ; GET CLOSED ROOT FOR THE FILE NUMBER GAFILE
-"RTN","C0CRNF",278,0)
+"RTN","C0CRNF",276,0)
I '$D(GAIDX) S GAIDX="" ;DEFAULT
-"RTN","C0CRNF",279,0)
+"RTN","C0CRNF",277,0)
I '$D(GANN) S GANN="" ;DEFAULT ONLY POPULATED FIELDS RETURNED
-"RTN","C0CRNF",280,0)
+"RTN","C0CRNF",278,0)
I GAIDX'="" S GAF=$NA(@GAF@(GAIDX)) ; IF WE ARE USING AN INDEX
-"RTN","C0CRNF",281,0)
+"RTN","C0CRNF",279,0)
W GAF,!
-"RTN","C0CRNF",282,0)
+"RTN","C0CRNF",280,0)
W $O(@GAF@(0)) ;
-"RTN","C0CRNF",283,0)
+"RTN","C0CRNF",281,0)
S GAI=0 ;ITERATOR
-"RTN","C0CRNF",284,0)
+"RTN","C0CRNF",282,0)
F S GAI=$O(@GAF@(GAI)) Q:GAI="" D ;
-"RTN","C0CRNF",285,0)
+"RTN","C0CRNF",283,0)
. D GETN1("GATMP",GAFILE,GAI,GAIDX,GANN) ;GET ONE RECORD
-"RTN","C0CRNF",286,0)
+"RTN","C0CRNF",284,0)
. N GAX S GAX=0
-"RTN","C0CRNF",287,0)
+"RTN","C0CRNF",285,0)
. F S GAX=$O(GATMP(GAX)) Q:GAX="" D ;PULL OUT THE FIELDS
-"RTN","C0CRNF",288,0)
+"RTN","C0CRNF",286,0)
. . D ADDNV(GARTN,GAI,GAX,GATMP(GAX)) ;INSERT THE NAME/VALUE INTO GARTN
-"RTN","C0CRNF",289,0)
+"RTN","C0CRNF",287,0)
Q
+"RTN","C0CRNF",288,0)
+ ;
+"RTN","C0CRNF",289,0)
+ADDNV(GNV,GNVN,GNVF,GNVV) ; CREATE AN ELEMENT OF THE MATRIX
"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)
+"RTN","C0CRNF",292,0)
S @GNV@("V",GNVN,GNVF,1)=$P(GNVV,"^",3) ;SET THE VALUE
+"RTN","C0CRNF",293,0)
+ Q
+"RTN","C0CRNF",294,0)
+ ;
"RTN","C0CRNF",295,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)
+"RTN","C0CRNF",296,0)
; READY TO WRITE FOR USE WITH EXCEL @RNRTN@(0) IS NUMBER OF LINES
-"RTN","C0CRNF",299,0)
+"RTN","C0CRNF",297,0)
; RNSTY IS STYLE OF THE OUTPUT -
-"RTN","C0CRNF",300,0)
+"RTN","C0CRNF",298,0)
; .. "NV"= ROWS ARE NAMES, COLUMNS ARE VALUES
-"RTN","C0CRNF",301,0)
+"RTN","C0CRNF",299,0)
; .. "VN"= ROWS ARE VALUES, COLUMNS ARE NAMES
-"RTN","C0CRNF",302,0)
+"RTN","C0CRNF",300,0)
; .. DEFAULT IS "NV" BECAUSE MANY MATRICES HAVE MORE FIELDS THAN VALUES
-"RTN","C0CRNF",303,0)
+"RTN","C0CRNF",301,0)
N RNR,RNC ;ROW ROOT,COL ROOT
-"RTN","C0CRNF",304,0)
+"RTN","C0CRNF",302,0)
N RNI,RNJ,RNX
-"RTN","C0CRNF",305,0)
+"RTN","C0CRNF",303,0)
I '$D(RNSTY) S RNSTY="NV" ;DEFAULT
-"RTN","C0CRNF",306,0)
+"RTN","C0CRNF",304,0)
I RNSTY="NV" D NV(RNRTN,RNIN) ; INTERNAL SUBROUTINES DEPENDING ON ORIENTATION
-"RTN","C0CRNF",307,0)
+"RTN","C0CRNF",305,0)
E D VN(RNRTN,RNIN) ;
+"RTN","C0CRNF",306,0)
+ Q
+"RTN","C0CRNF",307,0)
+ ;
"RTN","C0CRNF",308,0)
- Q
-"RTN","C0CRNF",309,0)
- ;
-"RTN","C0CRNF",310,0)
NV(RNRTN,RNIN) ;
-"RTN","C0CRNF",311,0)
+"RTN","C0CRNF",309,0)
S RNR=$NA(@RNIN@("F"))
-"RTN","C0CRNF",312,0)
+"RTN","C0CRNF",310,0)
S RNC=$NA(@RNIN@("V"))
-"RTN","C0CRNF",313,0)
+"RTN","C0CRNF",311,0)
;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
-"RTN","C0CRNF",314,0)
+"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 RNI=""
+ . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
"RTN","C0CRNF",316,0)
- F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN
+ S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
"RTN","C0CRNF",317,0)
- . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
+ D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
"RTN","C0CRNF",318,0)
- S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
+ S RNI=""
"RTN","C0CRNF",319,0)
- D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
+ F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW
"RTN","C0CRNF",320,0)
- S RNI=""
+ . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
"RTN","C0CRNF",321,0)
- F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW
+ . S RNJ=""
"RTN","C0CRNF",322,0)
- . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
+ . F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL
"RTN","C0CRNF",323,0)
- . S RNJ=""
-"RTN","C0CRNF",324,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)
+"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)
- . . E S RNX=RNX_"," ; NUL COLUMN
+ . D PUSH^C0CXPATH(RNRTN,RNX)
"RTN","C0CRNF",328,0)
- . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
+ Q
"RTN","C0CRNF",329,0)
- . D PUSH^C0CXPATH(RNRTN,RNX)
-"RTN","C0CRNF",330,0)
- Q
-"RTN","C0CRNF",331,0)
;
-"RTN","C0CRNF",332,0)
+"RTN","C0CRNF",330,0)
VN(RNRTN,RNIN) ;
-"RTN","C0CRNF",333,0)
+"RTN","C0CRNF",331,0)
S RNR=$NA(@RNIN@("V"))
-"RTN","C0CRNF",334,0)
+"RTN","C0CRNF",332,0)
S RNC=$NA(@RNIN@("F"))
-"RTN","C0CRNF",335,0)
+"RTN","C0CRNF",333,0)
;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
-"RTN","C0CRNF",336,0)
+"RTN","C0CRNF",334,0)
S RNX="""ROW"""_"," ; FIRST COLUMN NAME IS "ROW"
-"RTN","C0CRNF",337,0)
+"RTN","C0CRNF",335,0)
S RNI=""
-"RTN","C0CRNF",338,0)
+"RTN","C0CRNF",336,0)
F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN
-"RTN","C0CRNF",339,0)
+"RTN","C0CRNF",337,0)
. S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
-"RTN","C0CRNF",340,0)
+"RTN","C0CRNF",338,0)
S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
-"RTN","C0CRNF",341,0)
+"RTN","C0CRNF",339,0)
D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
-"RTN","C0CRNF",342,0)
+"RTN","C0CRNF",340,0)
S RNI=""
-"RTN","C0CRNF",343,0)
+"RTN","C0CRNF",341,0)
F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW
-"RTN","C0CRNF",344,0)
+"RTN","C0CRNF",342,0)
. S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
-"RTN","C0CRNF",345,0)
+"RTN","C0CRNF",343,0)
. S RNJ=""
-"RTN","C0CRNF",346,0)
+"RTN","C0CRNF",344,0)
. F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL
-"RTN","C0CRNF",347,0)
+"RTN","C0CRNF",345,0)
. . I $D(@RNR@(RNI,RNJ,1)) D ; THIS ROW HAS THIS COLUMN
-"RTN","C0CRNF",348,0)
+"RTN","C0CRNF",346,0)
. . . S RNV=$TR(@RNR@(RNI,RNJ,1),"""","")
-"RTN","C0CRNF",349,0)
+"RTN","C0CRNF",347,0)
. . . S RNV=$TR(RNV,",","")
-"RTN","C0CRNF",350,0)
+"RTN","C0CRNF",348,0)
. . . S RNX=RNX_""""_RNV_""""_"," ; ADD THE ELEMENT PLUS A COMMA
-"RTN","C0CRNF",351,0)
+"RTN","C0CRNF",349,0)
. . E S RNX=RNX_"," ; NUL COLUMN
-"RTN","C0CRNF",352,0)
+"RTN","C0CRNF",350,0)
. S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
-"RTN","C0CRNF",353,0)
+"RTN","C0CRNF",351,0)
. D PUSH^C0CXPATH(RNRTN,RNX)
-"RTN","C0CRNF",354,0)
+"RTN","C0CRNF",352,0)
Q
+"RTN","C0CRNF",353,0)
+ ;
+"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)
-READCSV(PATH,NAME,GLB) ; READ A CSV FILE IN FROM UNIX TO GLB, PASSED BY NAME
+ Q $$FTG^%ZISH(PATH,NAME,GLB,1)
"RTN","C0CRNF",357,0)
;
"RTN","C0CRNF",358,0)
- Q $$FTG^%ZISH(PATH,NAME,GLB,1)
+FILE2CSV(FNUM,FVN) ; WRITES OUT A FILEMAN FILE TO CSV
"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)
+"RTN","C0CRNF",361,0)
I '$D(FVN) S FVN="NV" ; DEFAULT ORIENTATION OF CVS FILE
-"RTN","C0CRNF",364,0)
+"RTN","C0CRNF",362,0)
S G1=$NA(^TMP($J,"C0CCSV",1))
-"RTN","C0CRNF",365,0)
+"RTN","C0CRNF",363,0)
S G2=$NA(^TMP($J,"C0CCSV",2))
-"RTN","C0CRNF",366,0)
+"RTN","C0CRNF",364,0)
D GETN2(G1,FNUM) ; GET THE MATRIX
-"RTN","C0CRNF",367,0)
+"RTN","C0CRNF",365,0)
D RNF2CSV(G2,G1,FVN) ; PREPARE THE CVS FILE
-"RTN","C0CRNF",368,0)
+"RTN","C0CRNF",366,0)
K @G1
-"RTN","C0CRNF",369,0)
+"RTN","C0CRNF",367,0)
D FILEOUT(G2,"FILE_"_FNUM_".csv")
-"RTN","C0CRNF",370,0)
+"RTN","C0CRNF",368,0)
K @G2
-"RTN","C0CRNF",371,0)
+"RTN","C0CRNF",369,0)
Q
+"RTN","C0CRNF",370,0)
+ ;
+"RTN","C0CRNF",371,0)
+FILEOUT(FOARY,FONAM) ; WRITE OUT A FILE
"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)
+"RTN","C0CRNF",374,0)
Q
+"RTN","C0CRNF",375,0)
+ ;
+"RTN","C0CRNF",376,0)
+FILEREF(FNUM) ; EXTRINSIC THAT RETURNS A CLOSED ROOT FOR FILE NUMBER FNUM
"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)
+"RTN","C0CRNF",379,0)
S C0CF=^DIC(FNUM,0,"GL") ;OPEN ROOT TO FILE
-"RTN","C0CRNF",382,0)
+"RTN","C0CRNF",380,0)
S C0CF=$P(C0CF,",",1)_")" ; CLOSE THE ROOT
-"RTN","C0CRNF",383,0)
+"RTN","C0CRNF",381,0)
I C0CF["()" S C0CF=$P(C0CF,"()",1)
-"RTN","C0CRNF",384,0)
+"RTN","C0CRNF",382,0)
Q C0CF
-"RTN","C0CRNF",385,0)
+"RTN","C0CRNF",383,0)
;
-"RTN","C0CRNF",386,0)
+"RTN","C0CRNF",384,0)
SKIP ;
-"RTN","C0CRNF",387,0)
+"RTN","C0CRNF",385,0)
N TXT,DIERR
-"RTN","C0CRNF",388,0)
+"RTN","C0CRNF",386,0)
S TXT=$$GET1^DIQ(8925,TIUIEN,"2","","TXT")
-"RTN","C0CRNF",389,0)
+"RTN","C0CRNF",387,0)
I $D(DIERR) D CLEAN^DILF Q
-"RTN","C0CRNF",390,0)
+"RTN","C0CRNF",388,0)
W " report_text:",! ;Progress Note Text
-"RTN","C0CRNF",391,0)
+"RTN","C0CRNF",389,0)
N LN S LN=0
-"RTN","C0CRNF",392,0)
+"RTN","C0CRNF",390,0)
F S LN=$O(TXT(LN)) Q:'LN D
-"RTN","C0CRNF",393,0)
+"RTN","C0CRNF",391,0)
. W " text"_LN_": "_TXT(LN),!
-"RTN","C0CRNF",394,0)
+"RTN","C0CRNF",392,0)
. Q
+"RTN","C0CRNF",393,0)
+ Q
+"RTN","C0CRNF",394,0)
+ ;
"RTN","C0CRNF",395,0)
- Q
-"RTN","C0CRNF",396,0)
- ;
-"RTN","C0CRNF",397,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)
- ; OF ZIN, WHICH IS PASSED BY NAME AND IS IN RNF2 FORMAT
-"RTN","C0CRNF",399,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",399,0)
D PUSH^C0CXPATH(ZOUT,"
")
-"RTN","C0CRNF",402,0)
+"RTN","C0CRNF",400,0)
N ZI,ZJ,ZV,ZN S ZI="" S ZJ=0
-"RTN","C0CRNF",403,0)
+"RTN","C0CRNF",401,0)
D PUSH^C0CXPATH(ZOUT,"
") ;begin row and leave a blank col
-"RTN","C0CRNF",404,0)
+"RTN","C0CRNF",402,0)
F S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0 D ; FOR EACH OCCURANCE
-"RTN","C0CRNF",405,0)
+"RTN","C0CRNF",403,0)
. S ZV="
"_ZJ_"
" ; OCCURANCE AS COLUMNS HEADER
-"RTN","C0CRNF",406,0)
+"RTN","C0CRNF",404,0)
. D PUSH^C0CXPATH(ZOUT,ZV)
-"RTN","C0CRNF",407,0)
+"RTN","C0CRNF",405,0)
D PUSH^C0CXPATH(ZOUT,"
") ;end of first row
-"RTN","C0CRNF",408,0)
+"RTN","C0CRNF",406,0)
S ZI=""
-"RTN","C0CRNF",409,0)
+"RTN","C0CRNF",407,0)
F S ZI=$O(@ZIN@("F",ZI)) Q:ZI="" D ; FOR EACH VARIABLE
-"RTN","C0CRNF",410,0)
+"RTN","C0CRNF",408,0)
. S ZN="
"_ZI_"
" ; VARIABLE NAME IN FIRST COLUMN
-"RTN","C0CRNF",411,0)
+"RTN","C0CRNF",409,0)
. D PUSH^C0CXPATH(ZOUT,ZN)
-"RTN","C0CRNF",412,0)
+"RTN","C0CRNF",410,0)
. S ZJ=0 ;RESET TO DO IT AGAIN
-"RTN","C0CRNF",413,0)
+"RTN","C0CRNF",411,0)
. F S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0 D ; FOR EACH OCCURANCE
-"RTN","C0CRNF",414,0)
+"RTN","C0CRNF",412,0)
. . S ZV="
"_$G(@ZIN@("V",ZJ,ZI,1))_"
"
-"RTN","C0CRNF",415,0)
+"RTN","C0CRNF",413,0)
. . D PUSH^C0CXPATH(ZOUT,ZV)
-"RTN","C0CRNF",416,0)
+"RTN","C0CRNF",414,0)
. D PUSH^C0CXPATH(ZOUT,"
") ;END OF ROW
-"RTN","C0CRNF",417,0)
+"RTN","C0CRNF",415,0)
D PUSH^C0CXPATH(ZOUT,"
") ; end of table
+"RTN","C0CRNF",416,0)
+ Q
+"RTN","C0CRNF",417,0)
+ ;
"RTN","C0CRNF",418,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)
+"RTN","C0CRNF",419,0)
; OF ZIN, WHICH IS PASSED BY NAME AND IS IN RNF2 FORMAT
-"RTN","C0CRNF",422,0)
+"RTN","C0CRNF",420,0)
; ZOUT IS NOT INITIALIZED, SO THE TABLE WILL GO AT THE END
-"RTN","C0CRNF",423,0)
+"RTN","C0CRNF",421,0)
; THE TABLE WILL BE IN VN FORMAT, ROWS ARE VALUES COLUMNS ARE NAMES
-"RTN","C0CRNF",424,0)
+"RTN","C0CRNF",422,0)
D PUSH^C0CXPATH(ZOUT,"
")
-"RTN","C0CRNF",425,0)
+"RTN","C0CRNF",423,0)
N ZI,ZJ S ZI="" S ZJ=0
-"RTN","C0CRNF",426,0)
+"RTN","C0CRNF",424,0)
D PUSH^C0CXPATH(ZOUT,"
") ;new row for column headers
-"RTN","C0CRNF",427,0)
+"RTN","C0CRNF",425,0)
F S ZI=$O(@ZIN@("F",ZI)) Q:ZI="" D ; FOR EACH VARIABLE
-"RTN","C0CRNF",428,0)
+"RTN","C0CRNF",426,0)
. S ZV="
"_ZI_"
"
-"RTN","C0CRNF",429,0)
+"RTN","C0CRNF",427,0)
. D PUSH^C0CXPATH(ZOUT,ZV) ; name
-"RTN","C0CRNF",430,0)
+"RTN","C0CRNF",428,0)
D PUSH^C0CXPATH(ZOUT,"
") ; end header row
-"RTN","C0CRNF",431,0)
+"RTN","C0CRNF",429,0)
S ZI="" ;RESET TO DO AGAIN
-"RTN","C0CRNF",432,0)
+"RTN","C0CRNF",430,0)
F S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0 D ; FOR EACH ROW OF VARIABLES
-"RTN","C0CRNF",433,0)
+"RTN","C0CRNF",431,0)
. D PUSH^C0CXPATH(ZOUT,"
") ;begin row
-"RTN","C0CRNF",434,0)
+"RTN","C0CRNF",432,0)
. F S ZI=$O(@ZIN@("F",ZI)) Q:ZI="" D ; FOR EACH VARIABLE
-"RTN","C0CRNF",435,0)
+"RTN","C0CRNF",433,0)
. . S ZV="
"_$G(@ZIN@("V",ZJ,ZI,1))_"
" ; value
-"RTN","C0CRNF",436,0)
+"RTN","C0CRNF",434,0)
. . D PUSH^C0CXPATH(ZOUT,ZV) ; value
-"RTN","C0CRNF",437,0)
+"RTN","C0CRNF",435,0)
. D PUSH^C0CXPATH(ZOUT,"
") ; end header
-"RTN","C0CRNF",438,0)
+"RTN","C0CRNF",436,0)
D PUSH^C0CXPATH(ZOUT,"
") ;end of table
-"RTN","C0CRNF",439,0)
+"RTN","C0CRNF",437,0)
Q
-"RTN","C0CRNF",440,0)
+"RTN","C0CRNF",438,0)
;
-"RTN","C0CRNF",441,0)
+"RTN","C0CRNF",439,0)
ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
-"RTN","C0CRNF",442,0)
+"RTN","C0CRNF",440,0)
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF @ZTAB@(ZFN)
+"RTN","C0CRNF",441,0)
+ ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
+"RTN","C0CRNF",442,0)
+ I '$D(ZTAB) S ZTAB="C0CA"
"RTN","C0CRNF",443,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CRNF",444,0)
- I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CRNF",445,0)
Q $P(@ZTAB@(ZFN),"^",1)
-"RTN","C0CRNF",446,0)
+"RTN","C0CRNF",444,0)
ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
-"RTN","C0CRNF",447,0)
+"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",447,0)
+ I '$D(ZTAB) S ZTAB="C0CA"
"RTN","C0CRNF",448,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CRNF",449,0)
- I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CRNF",450,0)
Q $P(@ZTAB@(ZFN),"^",2)
-"RTN","C0CRNF",451,0)
+"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",452,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
+ I '$D(ZTAB) S ZTAB="C0CA"
"RTN","C0CRNF",453,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CRNF",454,0)
- I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CRNF",455,0)
Q $P($G(@ZTAB@(ZFN)),"^",3)
-"RTN","C0CRNF",456,0)
+"RTN","C0CRNF",454,0)
;
-"RTN","C0CRNF",457,0)
+"RTN","C0CRNF",455,0)
ZVALUEI(ZFN,ZTAB) ;EXTRINSIC TO RETURN INTERNAL VALUE FOR FIELD NAME PASSED
-"RTN","C0CRNF",458,0)
+"RTN","C0CRNF",456,0)
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
-"RTN","C0CRNF",459,0)
+"RTN","C0CRNF",457,0)
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CRNF",460,0)
+"RTN","C0CRNF",458,0)
I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CRNF",461,0)
+"RTN","C0CRNF",459,0)
Q $P($G(@ZTAB@(ZFN,"I")),"^",3)
-"RTN","C0CRNF",462,0)
+"RTN","C0CRNF",460,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 .
"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.
-"RTN","C0CRNFRP",19,0)
- ;
-"RTN","C0CRNFRP",20,0)
W "This is the Reference Name Format (RNF) RPC Library ",!
-"RTN","C0CRNFRP",21,0)
+"RTN","C0CRNFRP",19,0)
W !
+"RTN","C0CRNFRP",20,0)
+ Q
+"RTN","C0CRNFRP",21,0)
+ ;
"RTN","C0CRNFRP",22,0)
- Q
-"RTN","C0CRNFRP",23,0)
- ;
-"RTN","C0CRNFRP",24,0)
;This routine will be mirroring C0CRNF and transform the output
-"RTN","C0CRNFRP",25,0)
+"RTN","C0CRNFRP",23,0)
;of the tags into an RPC friendly format
-"RTN","C0CRNFRP",26,0)
+"RTN","C0CRNFRP",24,0)
;The tags will be exactly as they are in C0CRNF
-"RTN","C0CRNFRP",27,0)
+"RTN","C0CRNFRP",25,0)
FIELDS(C0CFRTN,C0CFILE) ; RETURNS AN ARRAY OF THE FIELDS IN FILE C0CF,
-"RTN","C0CRNFRP",28,0)
+"RTN","C0CRNFRP",26,0)
;C0CFRTN IS PASSED BY REFERENCE, C0CF IS PASSED BY VALUE
-"RTN","C0CRNFRP",29,0)
+"RTN","C0CRNFRP",27,0)
;RETURN FORMAT:
-"RTN","C0CRNFRP",30,0)
+"RTN","C0CRNFRP",28,0)
;^TMP("C0CRNF",$J,0)="NUMBER_OF_RESULTS
-"RTN","C0CRNFRP",31,0)
+"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)
- ;
-"RTN","C0CRNFRP",33,0)
- ;SAMPLE OUTPUT FROM FIELDS^C0CRNF:
-"RTN","C0CRNFRP",34,0)
;C0CRNFFIELDS("*AMOUNT OF MILITARY RETIREMENT")="2^.3625"
+"RTN","C0CRNFRP",33,0)
+ ;
+"RTN","C0CRNFRP",34,0)
+ ;FORMAT APPEARS TO BE:
"RTN","C0CRNFRP",35,0)
- ;
-"RTN","C0CRNFRP",36,0)
- ;FORMAT APPEARS TO BE:
-"RTN","C0CRNFRP",37,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 DEBUG VALUE - REQUIRED - 0=OFF 1=ON
+ ;SET RETURN VALUE
"RTN","C0CRNFRP",40,0)
- S DEBUG=0
-"RTN","C0CRNFRP",41,0)
- ;SET RETURN VALUE
-"RTN","C0CRNFRP",42,0)
S C0CFRTN=$NA(^TMP("C0CRNF",$J))
-"RTN","C0CRNFRP",43,0)
+"RTN","C0CRNFRP",41,0)
K @C0CFRTN
-"RTN","C0CRNFRP",44,0)
+"RTN","C0CRNFRP",42,0)
;RUN WRAPPED CALL
-"RTN","C0CRNFRP",45,0)
+"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)
- S J=""
+ ;FORMAT RETURN
"RTN","C0CRNFRP",47,0)
- S I=1
+ F S J=$O(C0CRTN(J)) Q:J="" D ; FOR EACH FIELD IN THE ARRAY
"RTN","C0CRNFRP",48,0)
- ;FORMAT RETURN
-"RTN","C0CRNFRP",49,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",49,0)
. S I=I+1
-"RTN","C0CRNFRP",52,0)
+"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)
- ;CLEAN UP
+ Q
"RTN","C0CRNFRP",54,0)
- K J,I
+ ;
"RTN","C0CRNFRP",55,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)
+"RTN","C0CRNFRP",56,0)
; GRTN IS PASSED BY NAME
-"RTN","C0CRNFRP",59,0)
+"RTN","C0CRNFRP",57,0)
;
-"RTN","C0CRNFRP",60,0)
+"RTN","C0CRNFRP",58,0)
; OLD TAG DO NOT USE!
+"RTN","C0CRNFRP",59,0)
+ Q
+"RTN","C0CRNFRP",60,0)
+ ;
"RTN","C0CRNFRP",61,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",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)
- ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
+ ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
"RTN","C0CRNFRP",65,0)
- ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
+ ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
"RTN","C0CRNFRP",66,0)
- ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
+ ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
"RTN","C0CRNFRP",67,0)
- ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
+ ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
"RTN","C0CRNFRP",68,0)
- ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
+ ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
"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",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)
- ; IF GREF IS "" THE FIRST RECORD IS OBTAINED
+ ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
"RTN","C0CRNFRP",73,0)
- ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
+ ; GREF IS THE VALUE FOR THE INDEX
"RTN","C0CRNFRP",74,0)
- ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
+ ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
"RTN","C0CRNFRP",75,0)
- ; GREF IS THE VALUE FOR THE INDEX
+ ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
"RTN","C0CRNFRP",76,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)
+"RTN","C0CRNFRP",79,0)
;^TMP("C0CRNF",$J,0)="NUMBER_OF_RESULTS^FILE_NUMBER^RNF1^IEN^CURRENT_DATE^$J^DUZ_$C(30)"
-"RTN","C0CRNFRP",82,0)
+"RTN","C0CRNFRP",80,0)
;^TMP("C0CRNF",$J,I)="FIELD_NAME^FILE_NUMBER^FIELD_NUMBER^VALUE^INTERNAL_VALUE_$C(30)"
-"RTN","C0CRNFRP",83,0)
+"RTN","C0CRNFRP",81,0)
;
-"RTN","C0CRNFRP",84,0)
+"RTN","C0CRNFRP",82,0)
;SAMPLE OUTPUT FROM FIELDS^C0CRNF:
-"RTN","C0CRNFRP",85,0)
+"RTN","C0CRNFRP",83,0)
;C0CRNFGETN(0)="2^RNF1^5095^3091209^2908^3268"
-"RTN","C0CRNFRP",86,0)
+"RTN","C0CRNFRP",84,0)
;C0CRNFGETN("1U4N")="2^.0905^H5369"
-"RTN","C0CRNFRP",87,0)
+"RTN","C0CRNFRP",85,0)
;C0CRNFGETN("1U4N","I")="^^H5369"
-"RTN","C0CRNFRP",88,0)
+"RTN","C0CRNFRP",86,0)
;C0CRNFGETN("ADDRESS CHANGE DT/TM")="2^.118^OCT 21,2009@08:03:26"
-"RTN","C0CRNFRP",89,0)
+"RTN","C0CRNFRP",87,0)
;C0CRNFGETN("ADDRESS CHANGE DT/TM","I")="^^3091021.080326"
-"RTN","C0CRNFRP",90,0)
+"RTN","C0CRNFRP",88,0)
;
-"RTN","C0CRNFRP",91,0)
+"RTN","C0CRNFRP",89,0)
;FORMAT APPEARS TO BE:
-"RTN","C0CRNFRP",92,0)
+"RTN","C0CRNFRP",90,0)
;VARIABLENAME(0)="FILE_NUMBER^RNF1^IEN^CURRENT_DATE^$J^DUZ"
-"RTN","C0CRNFRP",93,0)
+"RTN","C0CRNFRP",91,0)
;VARIABLENAME("FIELD_NAME")="FILE_NUMBER^FIELD_NUMBER^VALUE"
-"RTN","C0CRNFRP",94,0)
+"RTN","C0CRNFRP",92,0)
;VARIABLENAME("FIELD_NAME","I")="^^INTERNAL_VALUE"
-"RTN","C0CRNFRP",95,0)
+"RTN","C0CRNFRP",93,0)
;
-"RTN","C0CRNFRP",96,0)
+"RTN","C0CRNFRP",94,0)
;SET DEBUG VALUE - REQUIRED - 0=OFF 1=ON
-"RTN","C0CRNFRP",97,0)
+"RTN","C0CRNFRP",95,0)
S DEBUG=0
-"RTN","C0CRNFRP",98,0)
+"RTN","C0CRNFRP",96,0)
;SET RETURN VALUE
-"RTN","C0CRNFRP",99,0)
+"RTN","C0CRNFRP",97,0)
S C0CGRTN=$NA(^TMP("C0CRNF",$J))
-"RTN","C0CRNFRP",100,0)
+"RTN","C0CRNFRP",98,0)
K @C0CGRTN
-"RTN","C0CRNFRP",101,0)
+"RTN","C0CRNFRP",99,0)
;RUN WRAPPED CALL
-"RTN","C0CRNFRP",102,0)
+"RTN","C0CRNFRP",100,0)
D GETN^C0CRNF("C0CRTN",$G(GFILE),$G(GREF),$G(GNDX),$G(GNN))
-"RTN","C0CRNFRP",103,0)
+"RTN","C0CRNFRP",101,0)
S J=""
-"RTN","C0CRNFRP",104,0)
+"RTN","C0CRNFRP",102,0)
S I=1
-"RTN","C0CRNFRP",105,0)
+"RTN","C0CRNFRP",103,0)
;FORMAT RETURN
-"RTN","C0CRNFRP",106,0)
+"RTN","C0CRNFRP",104,0)
F S J=$O(C0CRTN(J)) Q:J="" D ; FOR EACH FIELD IN THE ARRAY
-"RTN","C0CRNFRP",107,0)
+"RTN","C0CRNFRP",105,0)
. I J=0 S J=$O(C0CRTN(J)) ; SKIP THE 0 NODE
-"RTN","C0CRNFRP",108,0)
+"RTN","C0CRNFRP",106,0)
. S @C0CGRTN@(I)=J_"^"_C0CRTN(J)_"^" ; GETS THE FIRST LINE
-"RTN","C0CRNFRP",109,0)
+"RTN","C0CRNFRP",107,0)
. ;S J=$O(C0CRTN(J)) ; INCREMENT J SO WE CAN GET THE INTERNAL DATA
-"RTN","C0CRNFRP",110,0)
+"RTN","C0CRNFRP",108,0)
. ;TEST TO SEE IF INTERNAL DATA EXISTS
-"RTN","C0CRNFRP",111,0)
+"RTN","C0CRNFRP",109,0)
. I $D(C0CRTN(J,"I"))=1 D
-"RTN","C0CRNFRP",112,0)
+"RTN","C0CRNFRP",110,0)
. . S @C0CGRTN@(I)=@C0CGRTN@(I)_$P(C0CRTN(J,"I"),U,3) ; GETS THE INTERNAL VALUE PIECE 3
-"RTN","C0CRNFRP",113,0)
+"RTN","C0CRNFRP",111,0)
. S I=I+1
-"RTN","C0CRNFRP",114,0)
+"RTN","C0CRNFRP",112,0)
S @C0CGRTN@(0)=I-1_"^"_C0CRTN(0)
-"RTN","C0CRNFRP",115,0)
+"RTN","C0CRNFRP",113,0)
;CLEAN UP
-"RTN","C0CRNFRP",116,0)
+"RTN","C0CRNFRP",114,0)
K J,I
+"RTN","C0CRNFRP",115,0)
+ Q
+"RTN","C0CRNFRP",116,0)
+ ;
"RTN","C0CRNFRP",117,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)
+"RTN","C0CRNFRP",118,0)
; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
-"RTN","C0CRNFRP",121,0)
+"RTN","C0CRNFRP",119,0)
; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
-"RTN","C0CRNFRP",122,0)
+"RTN","C0CRNFRP",120,0)
; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
-"RTN","C0CRNFRP",123,0)
+"RTN","C0CRNFRP",121,0)
; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
-"RTN","C0CRNFRP",124,0)
+"RTN","C0CRNFRP",122,0)
; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
-"RTN","C0CRNFRP",125,0)
+"RTN","C0CRNFRP",123,0)
; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
-"RTN","C0CRNFRP",126,0)
+"RTN","C0CRNFRP",124,0)
; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
-"RTN","C0CRNFRP",127,0)
+"RTN","C0CRNFRP",125,0)
; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
-"RTN","C0CRNFRP",128,0)
+"RTN","C0CRNFRP",126,0)
; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
-"RTN","C0CRNFRP",129,0)
+"RTN","C0CRNFRP",127,0)
; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
-"RTN","C0CRNFRP",130,0)
+"RTN","C0CRNFRP",128,0)
; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
-"RTN","C0CRNFRP",131,0)
+"RTN","C0CRNFRP",129,0)
; IF GREF IS "" THE FIRST RECORD IS OBTAINED
-"RTN","C0CRNFRP",132,0)
+"RTN","C0CRNFRP",130,0)
; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
-"RTN","C0CRNFRP",133,0)
+"RTN","C0CRNFRP",131,0)
; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
-"RTN","C0CRNFRP",134,0)
+"RTN","C0CRNFRP",132,0)
; GREF IS THE VALUE FOR THE INDEX
-"RTN","C0CRNFRP",135,0)
+"RTN","C0CRNFRP",133,0)
; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
-"RTN","C0CRNFRP",136,0)
+"RTN","C0CRNFRP",134,0)
; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
+"RTN","C0CRNFRP",135,0)
+ ;
+"RTN","C0CRNFRP",136,0)
+ ;
"RTN","C0CRNFRP",137,0)
- ;
-"RTN","C0CRNFRP",138,0)
- ;
-"RTN","C0CRNFRP",139,0)
N GIEN,GF
-"RTN","C0CRNFRP",140,0)
+"RTN","C0CRNFRP",138,0)
S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE
-"RTN","C0CRNFRP",141,0)
+"RTN","C0CRNFRP",139,0)
I ('$D(GNDX))!(GNDX="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN
-"RTN","C0CRNFRP",142,0)
+"RTN","C0CRNFRP",140,0)
E D ; WE ARE USING AN INDEX
-"RTN","C0CRNFRP",143,0)
+"RTN","C0CRNFRP",141,0)
. ;N ZG
-"RTN","C0CRNFRP",144,0)
+"RTN","C0CRNFRP",142,0)
. S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX
-"RTN","C0CRNFRP",145,0)
+"RTN","C0CRNFRP",143,0)
. I ZG'="" D ;
-"RTN","C0CRNFRP",146,0)
+"RTN","C0CRNFRP",144,0)
. . I $QS(ZG,3)=GREF D ; IS GREF IN INDEX?
-"RTN","C0CRNFRP",147,0)
+"RTN","C0CRNFRP",145,0)
. . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN
-"RTN","C0CRNFRP",148,0)
+"RTN","C0CRNFRP",146,0)
. . E S GIEN="" ; NOT FOUND IN INDEX
-"RTN","C0CRNFRP",149,0)
+"RTN","C0CRNFRP",147,0)
. E S GIEN="" ;
-"RTN","C0CRNFRP",150,0)
+"RTN","C0CRNFRP",148,0)
;W "IEN: ",GIEN,!
-"RTN","C0CRNFRP",151,0)
+"RTN","C0CRNFRP",149,0)
;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
-"RTN","C0CRNFRP",152,0)
+"RTN","C0CRNFRP",150,0)
I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
-"RTN","C0CRNFRP",153,0)
+"RTN","C0CRNFRP",151,0)
E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
-"RTN","C0CRNFRP",154,0)
+"RTN","C0CRNFRP",152,0)
S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
-"RTN","C0CRNFRP",155,0)
+"RTN","C0CRNFRP",153,0)
D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
-"RTN","C0CRNFRP",156,0)
+"RTN","C0CRNFRP",154,0)
K C0CTMP
-"RTN","C0CRNFRP",157,0)
+"RTN","C0CRNFRP",155,0)
D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
-"RTN","C0CRNFRP",158,0)
+"RTN","C0CRNFRP",156,0)
D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
-"RTN","C0CRNFRP",159,0)
+"RTN","C0CRNFRP",157,0)
S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
-"RTN","C0CRNFRP",160,0)
+"RTN","C0CRNFRP",158,0)
S (C0CI,C0CJ)=""
-"RTN","C0CRNFRP",161,0)
+"RTN","C0CRNFRP",159,0)
F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES
-"RTN","C0CRNFRP",162,0)
+"RTN","C0CRNFRP",160,0)
. S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
-"RTN","C0CRNFRP",163,0)
+"RTN","C0CRNFRP",161,0)
. F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS
-"RTN","C0CRNFRP",164,0)
+"RTN","C0CRNFRP",162,0)
. . ;W C0CJ," ",C0CI,!
-"RTN","C0CRNFRP",165,0)
+"RTN","C0CRNFRP",163,0)
. . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
-"RTN","C0CRNFRP",166,0)
+"RTN","C0CRNFRP",164,0)
. . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
-"RTN","C0CRNFRP",167,0)
+"RTN","C0CRNFRP",165,0)
. . I C0CVALUE["C0CTMP" D ; WP FIELD
-"RTN","C0CRNFRP",168,0)
+"RTN","C0CRNFRP",166,0)
. . . N ZT,ZWP S ZWP=0 ;ITERATOR
-"RTN","C0CRNFRP",169,0)
+"RTN","C0CRNFRP",167,0)
. . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
-"RTN","C0CRNFRP",170,0)
+"RTN","C0CRNFRP",168,0)
. . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE
-"RTN","C0CRNFRP",171,0)
+"RTN","C0CRNFRP",169,0)
. . . F S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP D ;
-"RTN","C0CRNFRP",172,0)
+"RTN","C0CRNFRP",170,0)
. . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP
-"RTN","C0CRNFRP",173,0)
+"RTN","C0CRNFRP",171,0)
. . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
-"RTN","C0CRNFRP",174,0)
+"RTN","C0CRNFRP",172,0)
. . . . S C0CVALUE=C0CVALUE_ZT ;
-"RTN","C0CRNFRP",175,0)
+"RTN","C0CRNFRP",173,0)
. . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
-"RTN","C0CRNFRP",176,0)
+"RTN","C0CRNFRP",174,0)
. . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I"))
-"RTN","C0CRNFRP",177,0)
+"RTN","C0CRNFRP",175,0)
I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
-"RTN","C0CRNFRP",178,0)
+"RTN","C0CRNFRP",176,0)
. S C0CI=""
-"RTN","C0CRNFRP",179,0)
+"RTN","C0CRNFRP",177,0)
. F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY
-"RTN","C0CRNFRP",180,0)
+"RTN","C0CRNFRP",178,0)
. . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
-"RTN","C0CRNFRP",181,0)
+"RTN","C0CRNFRP",179,0)
Q
-"RTN","C0CRNFRP",182,0)
+"RTN","C0CRNFRP",180,0)
;
-"RTN","C0CRNFRP",183,0)
+"RTN","C0CRNFRP",181,0)
GETN2(GARTN,GAFILE,GAIDX,GACNT,GASTRT,GANN) ; RETURN FIELD MAP AND VALUES
-"RTN","C0CRNFRP",184,0)
+"RTN","C0CRNFRP",182,0)
; GARTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
-"RTN","C0CRNFRP",185,0)
+"RTN","C0CRNFRP",183,0)
; .. FIELD MAP @GARTN@("F","FIELDNAME")="FILE;FIELD#"
-"RTN","C0CRNFRP",186,0)
+"RTN","C0CRNFRP",184,0)
; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
-"RTN","C0CRNFRP",187,0)
+"RTN","C0CRNFRP",185,0)
; .. VALUE MAP @GARTN@("V","IEN","FIELDNAME","N")=VALUE
-"RTN","C0CRNFRP",188,0)
+"RTN","C0CRNFRP",186,0)
; .. WHERE N IS THE INDEX FOR MULTIPLES.. 1 FOR SINGLE VALUES
-"RTN","C0CRNFRP",189,0)
+"RTN","C0CRNFRP",187,0)
; .. GARTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
-"RTN","C0CRNFRP",190,0)
+"RTN","C0CRNFRP",188,0)
; .. IF GANN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
-"RTN","C0CRNFRP",191,0)
+"RTN","C0CRNFRP",189,0)
; .. EVEN IF GANN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
-"RTN","C0CRNFRP",192,0)
+"RTN","C0CRNFRP",190,0)
; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
-"RTN","C0CRNFRP",193,0)
+"RTN","C0CRNFRP",191,0)
; GAFILE IS THE FILE NUMBER TO BE PROCESSED. IT IS PASSED BY VALUE
-"RTN","C0CRNFRP",194,0)
+"RTN","C0CRNFRP",192,0)
; GAIDX IS THE OPTIONAL INDEX TO USE IN THE FILE. IF GAIDX IS "" THE IEN
-"RTN","C0CRNFRP",195,0)
+"RTN","C0CRNFRP",193,0)
; .. OF THE FILE WILL BE USED
-"RTN","C0CRNFRP",196,0)
+"RTN","C0CRNFRP",194,0)
; GACNT IS THE NUMBER OF RECORDS TO PROCESS. IT IS PASSED BY VALUE
-"RTN","C0CRNFRP",197,0)
+"RTN","C0CRNFRP",195,0)
; .. IF GARCNT IS NULL, ALL RECORDS ARE PROCESSED
-"RTN","C0CRNFRP",198,0)
+"RTN","C0CRNFRP",196,0)
; GASTRT IS THE IEN OF THE FIRST RECORD TO PROCESS. IT IS PASSED BY VALUE
-"RTN","C0CRNFRP",199,0)
+"RTN","C0CRNFRP",197,0)
; .. IF GARSTART IS NULL, PROCESSING STARTS AT THE FIRST RECORD
-"RTN","C0CRNFRP",200,0)
+"RTN","C0CRNFRP",198,0)
; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
-"RTN","C0CRNFRP",201,0)
+"RTN","C0CRNFRP",199,0)
; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GARFLD AND GARVAL
-"RTN","C0CRNFRP",202,0)
+"RTN","C0CRNFRP",200,0)
;N GATMP,GAI,GAF
-"RTN","C0CRNFRP",203,0)
+"RTN","C0CRNFRP",201,0)
S GAF=$$FILEREF(GAFILE) ; GET CLOSED ROOT FOR THE FILE NUMBER GAFILE
-"RTN","C0CRNFRP",204,0)
+"RTN","C0CRNFRP",202,0)
I '$D(GAIDX) S GAIDX="" ;DEFAULT
-"RTN","C0CRNFRP",205,0)
+"RTN","C0CRNFRP",203,0)
I '$D(GANN) S GANN="" ;DEFAULT ONLY POPULATED FIELDS RETURNED
-"RTN","C0CRNFRP",206,0)
+"RTN","C0CRNFRP",204,0)
I GAIDX'="" S GAF=$NA(@GAF@(GAIDX)) ; IF WE ARE USING AN INDEX
-"RTN","C0CRNFRP",207,0)
+"RTN","C0CRNFRP",205,0)
W GAF,!
-"RTN","C0CRNFRP",208,0)
+"RTN","C0CRNFRP",206,0)
W $O(@GAF@(0)) ;
-"RTN","C0CRNFRP",209,0)
+"RTN","C0CRNFRP",207,0)
S GAI=0 ;ITERATOR
-"RTN","C0CRNFRP",210,0)
+"RTN","C0CRNFRP",208,0)
F S GAI=$O(@GAF@(GAI)) Q:GAI="" D ;
-"RTN","C0CRNFRP",211,0)
+"RTN","C0CRNFRP",209,0)
. D GETN1("GATMP",GAFILE,GAI,GAIDX,GANN) ;GET ONE RECORD
-"RTN","C0CRNFRP",212,0)
+"RTN","C0CRNFRP",210,0)
. N GAX S GAX=0
-"RTN","C0CRNFRP",213,0)
+"RTN","C0CRNFRP",211,0)
. F S GAX=$O(GATMP(GAX)) Q:GAX="" D ;PULL OUT THE FIELDS
-"RTN","C0CRNFRP",214,0)
+"RTN","C0CRNFRP",212,0)
. . D ADDNV(GARTN,GAI,GAX,GATMP(GAX)) ;INSERT THE NAME/VALUE INTO GARTN
-"RTN","C0CRNFRP",215,0)
+"RTN","C0CRNFRP",213,0)
Q
+"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)
-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)
+"RTN","C0CRNFRP",218,0)
S @GNV@("V",GNVN,GNVF,1)=$P(GNVV,"^",3) ;SET THE VALUE
+"RTN","C0CRNFRP",219,0)
+ Q
+"RTN","C0CRNFRP",220,0)
+ ;
"RTN","C0CRNFRP",221,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)
+"RTN","C0CRNFRP",222,0)
; READY TO WRITE FOR USE WITH EXCEL @RNRTN@(0) IS NUMBER OF LINES
-"RTN","C0CRNFRP",225,0)
+"RTN","C0CRNFRP",223,0)
; RNSTY IS STYLE OF THE OUTPUT -
-"RTN","C0CRNFRP",226,0)
+"RTN","C0CRNFRP",224,0)
; .. "NV"= ROWS ARE NAMES, COLUMNS ARE VALUES
-"RTN","C0CRNFRP",227,0)
+"RTN","C0CRNFRP",225,0)
; .. "VN"= ROWS ARE VALUES, COLUMNS ARE NAMES
-"RTN","C0CRNFRP",228,0)
+"RTN","C0CRNFRP",226,0)
; .. DEFAULT IS "NV" BECAUSE MANY MATRICES HAVE MORE FIELDS THAN VALUES
-"RTN","C0CRNFRP",229,0)
+"RTN","C0CRNFRP",227,0)
N RNR,RNC ;ROW ROOT,COL ROOT
-"RTN","C0CRNFRP",230,0)
+"RTN","C0CRNFRP",228,0)
N RNI,RNJ,RNX
-"RTN","C0CRNFRP",231,0)
+"RTN","C0CRNFRP",229,0)
I '$D(RNSTY) S RNSTY="NV" ;DEFAULT
-"RTN","C0CRNFRP",232,0)
+"RTN","C0CRNFRP",230,0)
I RNSTY="NV" D NV(RNRTN,RNIN) ; INTERNAL SUBROUTINES DEPENDING ON ORIENTATION
-"RTN","C0CRNFRP",233,0)
+"RTN","C0CRNFRP",231,0)
E D VN(RNRTN,RNIN) ;
+"RTN","C0CRNFRP",232,0)
+ Q
+"RTN","C0CRNFRP",233,0)
+ ;
"RTN","C0CRNFRP",234,0)
- Q
-"RTN","C0CRNFRP",235,0)
- ;
-"RTN","C0CRNFRP",236,0)
NV(RNRTN,RNIN) ;
-"RTN","C0CRNFRP",237,0)
+"RTN","C0CRNFRP",235,0)
S RNR=$NA(@RNIN@("F"))
-"RTN","C0CRNFRP",238,0)
+"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 RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
+ S RNI=""
"RTN","C0CRNFRP",240,0)
- S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD"
+ F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN
"RTN","C0CRNFRP",241,0)
- S RNI=""
+ . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
"RTN","C0CRNFRP",242,0)
- F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN
+ S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
"RTN","C0CRNFRP",243,0)
- . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
+ D PUSH^GPLXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
"RTN","C0CRNFRP",244,0)
- S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
+ S RNI=""
"RTN","C0CRNFRP",245,0)
- D PUSH^GPLXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
+ F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW
"RTN","C0CRNFRP",246,0)
- S RNI=""
+ . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
"RTN","C0CRNFRP",247,0)
- F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW
+ . S RNJ=""
"RTN","C0CRNFRP",248,0)
- . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
+ . F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL
"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)
+"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)
- . . E S RNX=RNX_"," ; NUL COLUMN
+ . D PUSH^GPLXPATH(RNRTN,RNX)
"RTN","C0CRNFRP",254,0)
- . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
+ Q
"RTN","C0CRNFRP",255,0)
- . D PUSH^GPLXPATH(RNRTN,RNX)
-"RTN","C0CRNFRP",256,0)
- Q
-"RTN","C0CRNFRP",257,0)
;
-"RTN","C0CRNFRP",258,0)
+"RTN","C0CRNFRP",256,0)
VN(RNRTN,RNIN) ;
-"RTN","C0CRNFRP",259,0)
+"RTN","C0CRNFRP",257,0)
S RNR=$NA(@RNIN@("V"))
-"RTN","C0CRNFRP",260,0)
+"RTN","C0CRNFRP",258,0)
S RNC=$NA(@RNIN@("F"))
-"RTN","C0CRNFRP",261,0)
+"RTN","C0CRNFRP",259,0)
;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
-"RTN","C0CRNFRP",262,0)
+"RTN","C0CRNFRP",260,0)
S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD"
-"RTN","C0CRNFRP",263,0)
+"RTN","C0CRNFRP",261,0)
S RNI=""
-"RTN","C0CRNFRP",264,0)
+"RTN","C0CRNFRP",262,0)
F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN
-"RTN","C0CRNFRP",265,0)
+"RTN","C0CRNFRP",263,0)
. S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
-"RTN","C0CRNFRP",266,0)
+"RTN","C0CRNFRP",264,0)
S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
-"RTN","C0CRNFRP",267,0)
+"RTN","C0CRNFRP",265,0)
D PUSH^GPLXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
-"RTN","C0CRNFRP",268,0)
+"RTN","C0CRNFRP",266,0)
S RNI=""
-"RTN","C0CRNFRP",269,0)
+"RTN","C0CRNFRP",267,0)
F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW
-"RTN","C0CRNFRP",270,0)
+"RTN","C0CRNFRP",268,0)
. S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
-"RTN","C0CRNFRP",271,0)
+"RTN","C0CRNFRP",269,0)
. S RNJ=""
-"RTN","C0CRNFRP",272,0)
+"RTN","C0CRNFRP",270,0)
. F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL
-"RTN","C0CRNFRP",273,0)
+"RTN","C0CRNFRP",271,0)
. . I $D(@RNR@(RNI,RNJ,1)) D ; THIS ROW HAS THIS COLUMN
-"RTN","C0CRNFRP",274,0)
+"RTN","C0CRNFRP",272,0)
. . . S RNX=RNX_""""_@RNR@(RNI,RNJ,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA
-"RTN","C0CRNFRP",275,0)
+"RTN","C0CRNFRP",273,0)
. . E S RNX=RNX_"," ; NUL COLUMN
-"RTN","C0CRNFRP",276,0)
+"RTN","C0CRNFRP",274,0)
. S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
-"RTN","C0CRNFRP",277,0)
+"RTN","C0CRNFRP",275,0)
. D PUSH^GPLXPATH(RNRTN,RNX)
-"RTN","C0CRNFRP",278,0)
+"RTN","C0CRNFRP",276,0)
Q
+"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)
-READCSV(PATH,NAME,GLB) ; READ A CSV FILE IN FROM UNIX TO GLB, PASSED BY NAME
+ Q $$FTG^%ZISH(PATH,NAME,GLB,1)
"RTN","C0CRNFRP",281,0)
;
"RTN","C0CRNFRP",282,0)
- Q $$FTG^%ZISH(PATH,NAME,GLB,1)
+FILE2CSV(FNUM,FVN) ; WRITES OUT A FILEMAN FILE TO CSV
"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)
+"RTN","C0CRNFRP",285,0)
I '$D(FVN) S FVN="NV" ; DEFAULT ORIENTATION OF CVS FILE
-"RTN","C0CRNFRP",288,0)
+"RTN","C0CRNFRP",286,0)
S G1=$NA(^TMP($J,"C0CCSV",1))
-"RTN","C0CRNFRP",289,0)
+"RTN","C0CRNFRP",287,0)
S G2=$NA(^TMP($J,"C0CCSV",2))
-"RTN","C0CRNFRP",290,0)
+"RTN","C0CRNFRP",288,0)
D GETN2(G1,FNUM) ; GET THE MATRIX
-"RTN","C0CRNFRP",291,0)
+"RTN","C0CRNFRP",289,0)
D RNF2CSV(G2,G1,FVN) ; PREPARE THE CVS FILE
-"RTN","C0CRNFRP",292,0)
+"RTN","C0CRNFRP",290,0)
K @G1
-"RTN","C0CRNFRP",293,0)
+"RTN","C0CRNFRP",291,0)
D FILEOUT(G2,"FILE_"_FNUM_".csv")
-"RTN","C0CRNFRP",294,0)
+"RTN","C0CRNFRP",292,0)
K @G2
-"RTN","C0CRNFRP",295,0)
+"RTN","C0CRNFRP",293,0)
Q
+"RTN","C0CRNFRP",294,0)
+ ;
+"RTN","C0CRNFRP",295,0)
+FILEOUT(FOARY,FONAM) ; WRITE OUT A FILE
"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)
+"RTN","C0CRNFRP",298,0)
Q
+"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)
-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)
+"RTN","C0CRNFRP",303,0)
S C0CF=^DIC(FNUM,0,"GL") ;OPEN ROOT TO FILE
-"RTN","C0CRNFRP",306,0)
+"RTN","C0CRNFRP",304,0)
S C0CF=$P(C0CF,",",1)_")" ; CLOSE THE ROOT
-"RTN","C0CRNFRP",307,0)
+"RTN","C0CRNFRP",305,0)
I C0CF["()" S C0CF=$P(C0CF,"()",1)
-"RTN","C0CRNFRP",308,0)
+"RTN","C0CRNFRP",306,0)
Q C0CF
-"RTN","C0CRNFRP",309,0)
+"RTN","C0CRNFRP",307,0)
;
-"RTN","C0CRNFRP",310,0)
+"RTN","C0CRNFRP",308,0)
SKIP ;
-"RTN","C0CRNFRP",311,0)
+"RTN","C0CRNFRP",309,0)
N TXT,DIERR
-"RTN","C0CRNFRP",312,0)
+"RTN","C0CRNFRP",310,0)
S TXT=$$GET1^DIQ(8925,TIUIEN,"2","","TXT")
-"RTN","C0CRNFRP",313,0)
+"RTN","C0CRNFRP",311,0)
I $D(DIERR) D CLEAN^DILF Q
-"RTN","C0CRNFRP",314,0)
+"RTN","C0CRNFRP",312,0)
W " report_text:",! ;Progress Note Text
-"RTN","C0CRNFRP",315,0)
+"RTN","C0CRNFRP",313,0)
N LN S LN=0
-"RTN","C0CRNFRP",316,0)
+"RTN","C0CRNFRP",314,0)
F S LN=$O(TXT(LN)) Q:'LN D
-"RTN","C0CRNFRP",317,0)
+"RTN","C0CRNFRP",315,0)
. W " text"_LN_": "_TXT(LN),!
-"RTN","C0CRNFRP",318,0)
+"RTN","C0CRNFRP",316,0)
. Q
-"RTN","C0CRNFRP",319,0)
+"RTN","C0CRNFRP",317,0)
Q
-"RTN","C0CRNFRP",320,0)
+"RTN","C0CRNFRP",318,0)
;
-"RTN","C0CRNFRP",321,0)
+"RTN","C0CRNFRP",319,0)
ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
-"RTN","C0CRNFRP",322,0)
+"RTN","C0CRNFRP",320,0)
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF @ZTAB@(ZFN)
+"RTN","C0CRNFRP",321,0)
+ ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
+"RTN","C0CRNFRP",322,0)
+ I '$D(ZTAB) S ZTAB="C0CA"
"RTN","C0CRNFRP",323,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CRNFRP",324,0)
- I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CRNFRP",325,0)
Q $P(@ZTAB@(ZFN),"^",1)
-"RTN","C0CRNFRP",326,0)
+"RTN","C0CRNFRP",324,0)
ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
-"RTN","C0CRNFRP",327,0)
+"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",327,0)
+ I '$D(ZTAB) S ZTAB="C0CA"
"RTN","C0CRNFRP",328,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CRNFRP",329,0)
- I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CRNFRP",330,0)
Q $P(@ZTAB@(ZFN),"^",2)
-"RTN","C0CRNFRP",331,0)
+"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",332,0)
- ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
+ I '$D(ZTAB) S ZTAB="C0CA"
"RTN","C0CRNFRP",333,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CRNFRP",334,0)
- I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CRNFRP",335,0)
Q $P($G(@ZTAB@(ZFN)),"^",3)
-"RTN","C0CRNFRP",336,0)
+"RTN","C0CRNFRP",334,0)
;
-"RTN","C0CRNFRP",337,0)
+"RTN","C0CRNFRP",335,0)
ZVALUEI(ZFN,ZTAB) ;EXTRINSIC TO RETURN INTERNAL VALUE FOR FIELD NAME PASSED
-"RTN","C0CRNFRP",338,0)
+"RTN","C0CRNFRP",336,0)
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
-"RTN","C0CRNFRP",339,0)
+"RTN","C0CRNFRP",337,0)
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CRNFRP",340,0)
+"RTN","C0CRNFRP",338,0)
I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CRNFRP",341,0)
+"RTN","C0CRNFRP",339,0)
Q $P($G(@ZTAB@(ZFN,"I")),"^",3)
-"RTN","C0CRNFRP",342,0)
+"RTN","C0CRNFRP",340,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.
-"RTN","C0CRPMS",15,0)
;
+"RTN","C0CRPMS",14,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CRPMS",15,0)
+ ; along with this program. If not, see .
"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",!
-"RTN","C0CRPMS",21,0)
- Q
-"RTN","C0CRPMS",22,0)
- ;
-"RTN","C0CRPMS",23,0)
DISPLAY ; RUN THE PCC DISPLAY ROUTINE
-"RTN","C0CRPMS",24,0)
+"RTN","C0CRPMS",21,0)
D ^APCDDISP
-"RTN","C0CRPMS",25,0)
+"RTN","C0CRPMS",22,0)
Q
-"RTN","C0CRPMS",26,0)
+"RTN","C0CRPMS",23,0)
;
-"RTN","C0CRPMS",27,0)
+"RTN","C0CRPMS",24,0)
VTYPES ;
-"RTN","C0CRPMS",28,0)
+"RTN","C0CRPMS",25,0)
D GETN2^C0CRNF("G1",9999999.07)
+"RTN","C0CRPMS",26,0)
+ ; ZWR G1
+"RTN","C0CRPMS",27,0)
+ Q
+"RTN","C0CRPMS",28,0)
+ ;
"RTN","C0CRPMS",29,0)
- ZWR G1
-"RTN","C0CRPMS",30,0)
- Q
-"RTN","C0CRPMS",31,0)
- ;
-"RTN","C0CRPMS",32,0)
VISITS(C0CDFN,C0CCNT) ;LIST VISIT DATES FOR PATIENT DFN
-"RTN","C0CRPMS",33,0)
+"RTN","C0CRPMS",30,0)
; C0CCNT IS A LIMIT ON HOW MANY VISITS TO DISPLAY ; DEFAULTS TO ALL
-"RTN","C0CRPMS",34,0)
+"RTN","C0CRPMS",31,0)
I '$D(C0CCNT) S C0CCNT=999999999
-"RTN","C0CRPMS",35,0)
+"RTN","C0CRPMS",32,0)
N G,GN
-"RTN","C0CRPMS",36,0)
+"RTN","C0CRPMS",33,0)
S G="" S GN=0
-"RTN","C0CRPMS",37,0)
+"RTN","C0CRPMS",34,0)
F S G=$O(^AUPNVSIT("AA",C0CDFN,G)) Q:(G="")!(GN>C0CCNT) D ;
-"RTN","C0CRPMS",38,0)
+"RTN","C0CRPMS",35,0)
. S GN=GN+1
-"RTN","C0CRPMS",39,0)
+"RTN","C0CRPMS",36,0)
. W $$FMDTOUTC^C0CUTIL(9999999-G),!
-"RTN","C0CRPMS",40,0)
+"RTN","C0CRPMS",37,0)
Q
-"RTN","C0CRPMS",41,0)
+"RTN","C0CRPMS",38,0)
;
-"RTN","C0CRPMS",42,0)
+"RTN","C0CRPMS",39,0)
VISITS2(C0CDFN,C0CCNT) ;SECOND VERSION USING NEXTV
-"RTN","C0CRPMS",43,0)
+"RTN","C0CRPMS",40,0)
;
-"RTN","C0CRPMS",44,0)
+"RTN","C0CRPMS",41,0)
N C0CG,GN
-"RTN","C0CRPMS",45,0)
+"RTN","C0CRPMS",42,0)
S C0CG=""
-"RTN","C0CRPMS",46,0)
+"RTN","C0CRPMS",43,0)
S GN=0
-"RTN","C0CRPMS",47,0)
+"RTN","C0CRPMS",44,0)
I '$D(C0CCNT) S C0CCNT=99999999
-"RTN","C0CRPMS",48,0)
+"RTN","C0CRPMS",45,0)
F S C0CG=$$NEXTV(C0CDFN,C0CG) Q:(C0CG="")!(GN'.
"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.
-"RTN","C0CRXN",19,0)
- ;
-"RTN","C0CRXN",20,0)
W "This is the CCR RXNORM Utility Library ",!
-"RTN","C0CRXN",21,0)
+"RTN","C0CRXN",19,0)
W !
+"RTN","C0CRXN",20,0)
+ Q
+"RTN","C0CRXN",21,0)
+ ;
"RTN","C0CRXN",22,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)
+"RTN","C0CRXN",23,0)
; READ EACH RECORD FROM 176.111 AND USE THE VUID TO LOOK UP THE RXNORM
-"RTN","C0CRXN",26,0)
+"RTN","C0CRXN",24,0)
; CODE FROM 176.001 (RXNORM CONCEPTS)
-"RTN","C0CRXN",27,0)
+"RTN","C0CRXN",25,0)
; POPULATE ALL FIELDS IN 176.112 AND SET "NEW" TO "Y" IF 176.111 DOES NOT
-"RTN","C0CRXN",28,0)
+"RTN","C0CRXN",26,0)
; ALREADY HAVE AN RXNORM CODE.
-"RTN","C0CRXN",29,0)
+"RTN","C0CRXN",27,0)
; ADD THE RXNORM TEXT FIELD TO EVERY RECORD (NOT PRESENT IN 176.111)
-"RTN","C0CRXN",30,0)
+"RTN","C0CRXN",28,0)
; AND COMPARE THE RXNORM TEXT FIELD WITH THE VUID TEXT FIELD, SETTING THE
-"RTN","C0CRXN",31,0)
+"RTN","C0CRXN",29,0)
; "DIFFERENT TEXT" FIELD TO "Y" IF THERE ARE DIFFERENCES
-"RTN","C0CRXN",32,0)
+"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 C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR
+ N C0CF ; CLOSED ROOT FOR DESTINATION FILE
"RTN","C0CRXN",34,0)
- N C0CFVA,C0CFRXN ; CLOSED ROOTS FOR SOURCE FILES
+ S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE
"RTN","C0CRXN",35,0)
- N C0CF ; CLOSED ROOT FOR DESTINATION FILE
+ S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE
"RTN","C0CRXN",36,0)
- S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE
-"RTN","C0CRXN",37,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)
+"RTN","C0CRXN",37,0)
W C0CVA,C0CFRXN,C0CF,!
-"RTN","C0CRXN",40,0)
+"RTN","C0CRXN",38,0)
S C0CZX=0
-"RTN","C0CRXN",41,0)
+"RTN","C0CRXN",39,0)
S (HASRXN,NORXN,NOVUID,RXFOUND,RXMATCH,TXTMATCH)=0 ; INITIALIZE COUNTERS
-"RTN","C0CRXN",42,0)
+"RTN","C0CRXN",40,0)
F S C0CZX=$O(^C0CCODES(176.111,C0CZX)) Q:+C0CZX=0 D ; FOR EVERY RECORD
-"RTN","C0CRXN",43,0)
+"RTN","C0CRXN",41,0)
. K C0CA,C0CB,C0CC ; CLEAR ARRAYS
-"RTN","C0CRXN",44,0)
+"RTN","C0CRXN",42,0)
. D FIELDS^C0CRNF("C0CC",176.112) ;GET FIELD NAMES FOR OUTPUT FILE
-"RTN","C0CRXN",45,0)
+"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)
- . I $$ZVALUE("MEDIATION CODE")="" D
+ . E D ; PROCESS MEDIATION CODE
"RTN","C0CRXN",47,0)
- . . S NORXN=NORXN+1 ;
+ . . S HASRXN=HASRXN+1
"RTN","C0CRXN",48,0)
- . E D ; PROCESS MEDIATION CODE
+ . . D SETFDA("MEDIATION CODE",$$ZVALUE("MEDIATION CODE")) ;
"RTN","C0CRXN",49,0)
- . . S HASRXN=HASRXN+1
+ . I $$ZVALUE("VUID")="" D ; BAD RECORD
"RTN","C0CRXN",50,0)
- . . D SETFDA("MEDIATION CODE",$$ZVALUE("MEDIATION CODE")) ;
+ . . S NOVUID=NOVUID+1
"RTN","C0CRXN",51,0)
- . I $$ZVALUE("VUID")="" D ; BAD RECORD
+ . . ;D SETFDA("VUID",$$ZVALUE("VUID"))
"RTN","C0CRXN",52,0)
- . . S NOVUID=NOVUID+1
+ . E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT"))
"RTN","C0CRXN",53,0)
- . . ;D SETFDA("VUID",$$ZVALUE("VUID"))
+ . ;ZWR C0CA
"RTN","C0CRXN",54,0)
- . E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT"))
+ . D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
"RTN","C0CRXN",55,0)
- . . ;ZWR C0CA
+ . I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND
"RTN","C0CRXN",56,0)
- . D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
+ . . S RXFOUND=RXFOUND+1
"RTN","C0CRXN",57,0)
- . I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND
+ . . I $$ZVALUE("MEDIATION CODE")="" D ; THIS IS A NEW CODE
"RTN","C0CRXN",58,0)
- . . S RXFOUND=RXFOUND+1
+ . . . D SETFDA("MEDIATION CODE",$$ZVALUE("RXCUI","C0CB"))
"RTN","C0CRXN",59,0)
- . . I $$ZVALUE("MEDIATION CODE")="" D ; THIS IS A NEW CODE
+ . . . D SETFDA("NEW","Y") ;FLAG RECORD HAS HAVING NEW RXNORM
"RTN","C0CRXN",60,0)
- . . . D SETFDA("MEDIATION CODE",$$ZVALUE("RXCUI","C0CB"))
+ . . W "RXNORM=",$$ZVALUE("RXCUI","C0CB")," ",$$ZVALUE("STR","C0CB"),!
"RTN","C0CRXN",61,0)
- . . . D SETFDA("NEW","Y") ;FLAG RECORD HAS HAVING NEW RXNORM
+ . . W "VUID TEXT: ",$$ZVALUE("VUID TEXT"),!
"RTN","C0CRXN",62,0)
- . . W "RXNORM=",$$ZVALUE("RXCUI","C0CB")," ",$$ZVALUE("STR","C0CB"),!
+ . . I $$ZVALUE("VUID TEXT")=$$ZVALUE("STR","C0CB") S TXTMATCH=TXTMATCH+1
"RTN","C0CRXN",63,0)
- . . W "VUID TEXT: ",$$ZVALUE("VUID TEXT"),!
+ . . E D ;
"RTN","C0CRXN",64,0)
- . . I $$ZVALUE("VUID TEXT")=$$ZVALUE("STR","C0CB") S TXTMATCH=TXTMATCH+1
-"RTN","C0CRXN",65,0)
- . . E D ;
-"RTN","C0CRXN",66,0)
. . . S ZZ=$$ZVALUE("VUID TEXT")_"^"_$$ZVALUE("STR","C0CB")
-"RTN","C0CRXN",67,0)
+"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)
- . . . D SETFDA("RXNORM TEXT",$$ZVALUE("STR","C0CB")) ;
+ . I $$ZVALUE("MEDIATION CODE")=$$ZVALUE("RXCUI","C0CB") D ;
"RTN","C0CRXN",69,0)
- . . . D SETFDA("DIFFERENT TEXT","Y") ;FLAG RECORD FOR DIFFERENT TEXT
+ . . S RXMATCH=RXMATCH+1
"RTN","C0CRXN",70,0)
- . I $$ZVALUE("MEDIATION CODE")=$$ZVALUE("RXCUI","C0CB") D ;
+ . . W "VUID=",$$ZVALUE("VUID")," MATCH RXNORM=",$$ZVALUE("MEDIATION CODE"),!
"RTN","C0CRXN",71,0)
- . . S RXMATCH=RXMATCH+1
+ . D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
"RTN","C0CRXN",72,0)
- . . W "VUID=",$$ZVALUE("VUID")," MATCH RXNORM=",$$ZVALUE("MEDIATION CODE"),!
+ . S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD
"RTN","C0CRXN",73,0)
- . D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
+ . D UPDATE^DIE("","C0CFDA")
"RTN","C0CRXN",74,0)
- . S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD
+ . I $D(^TMP("DIERR",$J)) S $EC=",U1,"
"RTN","C0CRXN",75,0)
- . D UPDATE^DIE("","C0CFDA")
+ W "HAS RXN=",HASRXN,!
"RTN","C0CRXN",76,0)
- . I $D(^TMP("DIERR",$J)) U $P BREAK
+ W "NO RXN=",NORXN,!
"RTN","C0CRXN",77,0)
- W "HAS RXN=",HASRXN,!
+ W "NO VUID=",NOVUID,!
"RTN","C0CRXN",78,0)
- W "NO RXN=",NORXN,!
+ W "RXNORM FOUND=",RXFOUND,!
"RTN","C0CRXN",79,0)
- W "NO VUID=",NOVUID,!
+ W "RXNORM MATCHES:",RXMATCH,!
"RTN","C0CRXN",80,0)
- W "RXNORM FOUND=",RXFOUND,!
+ W "TEXT MATCHES:",TXTMATCH,!
"RTN","C0CRXN",81,0)
- W "RXNORM MATCHES:",RXMATCH,!
+ Q
"RTN","C0CRXN",82,0)
- W "TEXT MATCHES:",TXTMATCH,!
+ ;
"RTN","C0CRXN",83,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)
+"RTN","C0CRXN",84,0)
; CROSS CHECKS THE NATIONAL DRUG FILE AND THE VA MAPPING FILE AGAINST
-"RTN","C0CRXN",87,0)
+"RTN","C0CRXN",85,0)
; THE UMLS RXNORM DATABASE
-"RTN","C0CRXN",88,0)
+"RTN","C0CRXN",86,0)
; THIS ROUTINE HAS BEEN ENHANCED TO ALSO CHECK THE 50.416 DRUG INGREDIENT
-"RTN","C0CRXN",89,0)
+"RTN","C0CRXN",87,0)
; FILE AND TREAT VUIDS FOUND THERE LIKE THE ONES BEING FOUND IN THE NDF
-"RTN","C0CRXN",90,0)
+"RTN","C0CRXN",88,0)
; IF THE VUID EXISISTS IN ALL THREE FILES, THE RXNORM CODE MATCHES IN
-"RTN","C0CRXN",91,0)
+"RTN","C0CRXN",89,0)
; THE VA MAPPING FILE AND THE TEXT STRINGS ARE THE SAME, THE VUID IS INCLUDED
-"RTN","C0CRXN",92,0)
+"RTN","C0CRXN",90,0)
; IN THE FILE BUT NO FLAGS ARE SET
-"RTN","C0CRXN",93,0)
+"RTN","C0CRXN",91,0)
; IF THE VUID IS MISSING FROM THE NATIONAL DRUG FILE NDF=N
-"RTN","C0CRXN",94,0)
+"RTN","C0CRXN",92,0)
; (IF THE VUID IS MISSING FROM THE NDF, IT IS CHECKED IN THE DRUG INGREDIENT
-"RTN","C0CRXN",95,0)
+"RTN","C0CRXN",93,0)
; FILE, AND IF FOUND, THE FLAG IS NOT SET. IN THIS CASE THE TEXT FROM THE
-"RTN","C0CRXN",96,0)
+"RTN","C0CRXN",94,0)
; DRUG INGREDIENT FILE IS USED FOR COMPARISONS)
-"RTN","C0CRXN",97,0)
+"RTN","C0CRXN",95,0)
; IF THE VUID IS MISSING FROM THE VA MAPPING FILE VAMAP=N
-"RTN","C0CRXN",98,0)
+"RTN","C0CRXN",96,0)
; IF THE VUID IS PRESENT IN THE VA MAPPING FILE, BUT THE RXNORM
-"RTN","C0CRXN",99,0)
+"RTN","C0CRXN",97,0)
; CODE IS MISSING IN THAT FILE, VARXN=N
-"RTN","C0CRXN",100,0)
+"RTN","C0CRXN",98,0)
; IF THE TEXT STRINGS DO NOT MATCH EXACTLY, TXTM=N AND ALL THREE STRINGS
-"RTN","C0CRXN",101,0)
+"RTN","C0CRXN",99,0)
; ARE SHOWN; NDF TEXT=NDF TEXT STRING, VA MAP TEXT=VA MAPPING TEXT STRING
-"RTN","C0CRXN",102,0)
+"RTN","C0CRXN",100,0)
; RXNORM TEXT=RXNORM TEXT STRING
-"RTN","C0CRXN",103,0)
+"RTN","C0CRXN",101,0)
; THE FILE IS KEYED ON VUID AND WOULD USUALLY BE SORTED BY VUID
-"RTN","C0CRXN",104,0)
+"RTN","C0CRXN",102,0)
; THE OBJECTIVE IS TO SEE IF NDF (50.68) AND VA MAPPING (176.111) HAVE
-"RTN","C0CRXN",105,0)
+"RTN","C0CRXN",103,0)
; ALL THE VUID CODES THAT ARE IN THE UMLS RXNORM DATABASE
-"RTN","C0CRXN",106,0)
+"RTN","C0CRXN",104,0)
N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR
-"RTN","C0CRXN",107,0)
+"RTN","C0CRXN",105,0)
N C0CFVA,C0CFRXN ; CLOSED ROOTS FOR SOURCE FILES
+"RTN","C0CRXN",106,0)
+ N C0CF ; CLOSED ROOT FOR DESTINATION FILE
+"RTN","C0CRXN",107,0)
+ S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE
"RTN","C0CRXN",108,0)
- N C0CF ; CLOSED ROOT FOR DESTINATION FILE
+ S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE
"RTN","C0CRXN",109,0)
- S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE
+ ;S C0CF=$$FILEREF^C0CRNF(176.113) ; C0C RXNORM VUID MAPPING ADDITIONAL FILE
"RTN","C0CRXN",110,0)
- S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE
+ W C0CVA,C0CFRXN,! ;C0CF,!
"RTN","C0CRXN",111,0)
- ;S C0CF=$$FILEREF^C0CRNF(176.113) ; C0C RXNORM VUID MAPPING ADDITIONAL FILE
+ S C0CZX=0
"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)
+"RTN","C0CRXN",113,0)
S (VAVCNT,VATCNT,VARCNT,VANO)=0 ; COUNTERS FOR VA MAPPING FILE TESTS
-"RTN","C0CRXN",116,0)
+"RTN","C0CRXN",114,0)
F S C0CZX=$O(^C0CRXN(176.001,"VUID",C0CZX)) Q:+C0CZX=0 D ; FOR EVERY VUID
-"RTN","C0CRXN",117,0)
+"RTN","C0CRXN",115,0)
. K C0CA,C0CB,C0CC,C0CD ; CLEAR ARRAYS
-"RTN","C0CRXN",118,0)
+"RTN","C0CRXN",116,0)
. D FIELDS^C0CRNF("C0CC",176.113) ;GET FIELD NAMES FOR OUTPUT FILE
-"RTN","C0CRXN",119,0)
+"RTN","C0CRXN",117,0)
. D GETN1^C0CRNF("C0CA",176.001,C0CZX,"VUID","ALL") ;GET FROM RXNORM FILE
-"RTN","C0CRXN",120,0)
+"RTN","C0CRXN",118,0)
. D GETN1^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;GET FROM VA MAPPING FILE
-"RTN","C0CRXN",121,0)
+"RTN","C0CRXN",119,0)
. D GETN1^C0CRNF("C0CD",50.68,C0CZX,"AVUID","ALL") ;GET FROM NDF
-"RTN","C0CRXN",122,0)
+"RTN","C0CRXN",120,0)
. D GETN1^C0CRNF("C0CE",50.416,C0CZX,"AVUID","ALL") ;GET FROM DRUG INGREDIENTS
-"RTN","C0CRXN",123,0)
+"RTN","C0CRXN",121,0)
. ;D SETFDA("VUID",$$ZVALUE("CODE")) ;SET THE VUID CODE
-"RTN","C0CRXN",124,0)
+"RTN","C0CRXN",122,0)
. D SETFDA("RXNORM",$$ZVALUE("RXCUI")) ;SET THE RXNORM CODE
-"RTN","C0CRXN",125,0)
+"RTN","C0CRXN",123,0)
. D SETFDA("RXNORM TEXT",$$ZVALUE("STR")) ;SET THE RXNORM TEXT
-"RTN","C0CRXN",126,0)
+"RTN","C0CRXN",124,0)
. ;VA MAPPING FILE TESTS
-"RTN","C0CRXN",127,0)
+"RTN","C0CRXN",125,0)
. I $$ZVALUE("VUID","C0CB")=C0CZX D ; VUID FOUND
-"RTN","C0CRXN",128,0)
+"RTN","C0CRXN",126,0)
. . S VAVCNT=VAVCNT+1 ;INCREMENT COUNT
-"RTN","C0CRXN",129,0)
+"RTN","C0CRXN",127,0)
. . I $$ZVALUE("STR")'=$$ZVALUE("VUID TEXT","C0CB") D ;TEXT MISMATCH
-"RTN","C0CRXN",130,0)
+"RTN","C0CRXN",128,0)
. . . S VATCNT=VATCNT+1 ; INCREMENT VA TEXT MISMATCH COUNT
-"RTN","C0CRXN",131,0)
+"RTN","C0CRXN",129,0)
. . . D SETFDA("TXTM","N") ;MARK THAT TEXT DOESN'T MATCH
-"RTN","C0CRXN",132,0)
+"RTN","C0CRXN",130,0)
. . . D SETFDA("VA MAP TEXT",$$ZVALUE("VUID TEXT","C0CB")) ; SET VA MAP TEXT
-"RTN","C0CRXN",133,0)
+"RTN","C0CRXN",131,0)
. E D ; VUID NOT FOUND
-"RTN","C0CRXN",134,0)
+"RTN","C0CRXN",132,0)
. . S VANO=VANO+1
-"RTN","C0CRXN",135,0)
+"RTN","C0CRXN",133,0)
. . D SETFDA("VAMAP","N") ;MARK AS MISSING FROM VA MAPPING FILE
-"RTN","C0CRXN",136,0)
+"RTN","C0CRXN",134,0)
. ; NATIONAL DRUG FILE TESTS
-"RTN","C0CRXN",137,0)
+"RTN","C0CRXN",135,0)
. I ($$ZVALUE("VUID","C0CD")=C0CZX)!($$ZVALUE("VUID","C0CE")=C0CZX) D ;
-"RTN","C0CRXN",138,0)
+"RTN","C0CRXN",136,0)
. . ;FOUND IN NATIONAL DRUG FILE OR DRUG INGREDIENT FILE
-"RTN","C0CRXN",139,0)
+"RTN","C0CRXN",137,0)
. . S NDFVCNT=NDFVCNT+1 ;INCREMENT VUID FOUND COUNT
-"RTN","C0CRXN",140,0)
+"RTN","C0CRXN",138,0)
. . I $$ZVALUE("NAME","C0CD")'=$$ZVALUE("STR") D ;NDF TEXT DOESN'T MATCH
-"RTN","C0CRXN",141,0)
+"RTN","C0CRXN",139,0)
. . . I $$ZVALUE("NAME","C0CE")'=$$ZVALUE("STR") D ;DRUG ING FILE ALSO
-"RTN","C0CRXN",142,0)
+"RTN","C0CRXN",140,0)
. . . . S NDFTCNT=NDFTCNT+1 ; INCREMENT MISMATCHED NDF TEXT COUNT
-"RTN","C0CRXN",143,0)
+"RTN","C0CRXN",141,0)
. . . . D SETFDA("TXTM","N") ; SET TEXT MATCH FLAG TO N
-"RTN","C0CRXN",144,0)
+"RTN","C0CRXN",142,0)
. . . . D SETFDA("NDF TEXT",$$ZVALUE("NAME","C0CD")) ;POST THE TEXT
-"RTN","C0CRXN",145,0)
+"RTN","C0CRXN",143,0)
. . . . D SETFDA("NAT DRUG TEXT",$$ZVALUE("NAME","C0CE")) ;POST TEXT
-"RTN","C0CRXN",146,0)
+"RTN","C0CRXN",144,0)
. E D ;
-"RTN","C0CRXN",147,0)
+"RTN","C0CRXN",145,0)
. . D SETFDA("NDF","N") ;MARK AS MISSING
-"RTN","C0CRXN",148,0)
+"RTN","C0CRXN",146,0)
. . S NDFNO=NDFNO+1 ;INCREMENT MISSING COUNT
-"RTN","C0CRXN",149,0)
+"RTN","C0CRXN",147,0)
. D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
-"RTN","C0CRXN",150,0)
+"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)
- . 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)
+"RTN","C0CRXN",152,0)
W "VA MAPPING MISSING: ",VANO,!
-"RTN","C0CRXN",155,0)
+"RTN","C0CRXN",153,0)
W "VA MAPPING TEXT MISMATCH: ",VATCNT,!
-"RTN","C0CRXN",156,0)
+"RTN","C0CRXN",154,0)
W "NDF VUID COUNT: ",NDFVCNT,!
-"RTN","C0CRXN",157,0)
+"RTN","C0CRXN",155,0)
W "NDF MISSING: ",NDFNO,!
-"RTN","C0CRXN",158,0)
+"RTN","C0CRXN",156,0)
W "NDF TEXT MISMATCH: ",NDFTCNT,!
-"RTN","C0CRXN",159,0)
+"RTN","C0CRXN",157,0)
Q
-"RTN","C0CRXN",160,0)
+"RTN","C0CRXN",158,0)
CHKNDF ; ROUTINE TO CHECK THE NATIONAL DRUG FILE WITH THE UMLS RXNORM DB
-"RTN","C0CRXN",161,0)
+"RTN","C0CRXN",159,0)
; USING THE AVUID INDEX, READS ALL VUID CODES IN ^PSNDF(50.68),
-"RTN","C0CRXN",162,0)
+"RTN","C0CRXN",160,0)
; CHECKS TO SEE IF THE CODE IS IN 176.001, AND CREATES A RECORD
-"RTN","C0CRXN",163,0)
+"RTN","C0CRXN",161,0)
; IN 176.114
-"RTN","C0CRXN",164,0)
+"RTN","C0CRXN",162,0)
; THE OBJECTIVE IS TO SEE IF ^PSNDF(50.68) HAS ALL THE VUID CODES IN THE
-"RTN","C0CRXN",165,0)
+"RTN","C0CRXN",163,0)
; UMLS RXNORM DATABASE AND IF THE TEXT FIELDS MATCH
-"RTN","C0CRXN",166,0)
+"RTN","C0CRXN",164,0)
; ALSO CAPTURES THE RXNORM CODE MAPPING
-"RTN","C0CRXN",167,0)
+"RTN","C0CRXN",165,0)
; CHKNDF2 WILL CHECK THE OTHER DIRECTION, STARTING WITH THE 176.001 VUID INDEX
-"RTN","C0CRXN",168,0)
+"RTN","C0CRXN",166,0)
; THIS ROUTINE ALSO CHECKS IF THE VUID CODE IS IN 176.111 AND IF NOT
-"RTN","C0CRXN",169,0)
+"RTN","C0CRXN",167,0)
; SETS NOTMAPPED=Y
-"RTN","C0CRXN",170,0)
+"RTN","C0CRXN",168,0)
N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR
-"RTN","C0CRXN",171,0)
+"RTN","C0CRXN",169,0)
N C0CFVA,C0CFRXN,C0CPSNDF ; CLOSED ROOTS FOR SOURCE FILES
-"RTN","C0CRXN",172,0)
+"RTN","C0CRXN",170,0)
N C0CF ; CLOSED ROOT FOR DESTINATION FILE
-"RTN","C0CRXN",173,0)
+"RTN","C0CRXN",171,0)
S C0CPSNDF=$$FILEREF^C0CRNF(50.68) ; NDF CLOSED ROOT REFERENCE
-"RTN","C0CRXN",174,0)
+"RTN","C0CRXN",172,0)
S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE
-"RTN","C0CRXN",175,0)
+"RTN","C0CRXN",173,0)
S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE
-"RTN","C0CRXN",176,0)
+"RTN","C0CRXN",174,0)
;S C0CF=$$FILEREF^C0CRNF(176.113) ; C0C RXNORM VUID MAPPING ADDITIONAL FILE
-"RTN","C0CRXN",177,0)
+"RTN","C0CRXN",175,0)
W C0CVA,C0CFRXN,! ;C0CF,!
-"RTN","C0CRXN",178,0)
+"RTN","C0CRXN",176,0)
S C0CZX=0
-"RTN","C0CRXN",179,0)
+"RTN","C0CRXN",177,0)
S (FOUND,MISSING)=0
-"RTN","C0CRXN",180,0)
+"RTN","C0CRXN",178,0)
S (NOVUID,VMATCH,NOMATCH,MISSING,FOUND,TXTMATCH,NOTM,NVAM)=0 ; COUNTERS
-"RTN","C0CRXN",181,0)
+"RTN","C0CRXN",179,0)
F S C0CZX=$O(^PSNDF(50.68,"AVUID",C0CZX)) Q:+C0CZX=0 D ; FOR EVERY VUID
-"RTN","C0CRXN",182,0)
+"RTN","C0CRXN",180,0)
. K C0CA,C0CB,C0CC,C0CD ; CLEAR ARRAYS
-"RTN","C0CRXN",183,0)
+"RTN","C0CRXN",181,0)
. ;D FIELDS^C0CRNF("C0CC",176.113) ;GET FIELD NAMES FOR OUTPUT FILE
-"RTN","C0CRXN",184,0)
+"RTN","C0CRXN",182,0)
. D GETN1^C0CRNF("C0CA",50.68,C0CZX,"AVUID","ALL") ;GET THE FIELDS
-"RTN","C0CRXN",185,0)
+"RTN","C0CRXN",183,0)
. I $$ZVALUE("VUID")="" D ; ERROR, SHOULD NOT HAPPEN
-"RTN","C0CRXN",186,0)
+"RTN","C0CRXN",184,0)
. . S NOVUID=NOVUID+1 ; FLAG THE ERROR
-"RTN","C0CRXN",187,0)
+"RTN","C0CRXN",185,0)
. . D PUSH^GPLXPATH("NOVUID",C0CZX) ; RECORD THE VUID
-"RTN","C0CRXN",188,0)
+"RTN","C0CRXN",186,0)
. D GETN1^C0CRNF("C0CD",176.001,C0CZX,"VUID","ALL") ;TRY RXNORM DB
-"RTN","C0CRXN",189,0)
+"RTN","C0CRXN",187,0)
. I $$ZVALUE("CODE","C0CD")=C0CZX D ; FOUND IN RXNORM
-"RTN","C0CRXN",190,0)
+"RTN","C0CRXN",188,0)
. . S VMATCH=VMATCH+1 ; COUNT OF PSNDF VUIDS FOUND IN RXNORM
-"RTN","C0CRXN",191,0)
+"RTN","C0CRXN",189,0)
. . I $$ZVALUE("NAME")=$$ZVALUE("STR","C0CD") D ;TEXT MATCHES
-"RTN","C0CRXN",192,0)
+"RTN","C0CRXN",190,0)
. . . S TXTMATCH=TXTMATCH+1 ; COUNT IT
-"RTN","C0CRXN",193,0)
+"RTN","C0CRXN",191,0)
. . E D ; TEXT DOESN'T MATCH
-"RTN","C0CRXN",194,0)
+"RTN","C0CRXN",192,0)
. . . S NOTM=NOTM+1 ;NO TEXT MATCH COUNTER
-"RTN","C0CRXN",195,0)
+"RTN","C0CRXN",193,0)
. . . S ZV=$$ZVALUE("NAME")_"^"_$$ZVALUE("STR","C0CD")
-"RTN","C0CRXN",196,0)
+"RTN","C0CRXN",194,0)
. . . W ZV,!
-"RTN","C0CRXN",197,0)
+"RTN","C0CRXN",195,0)
. . . D PUSH^GPLXPATH("TXTNM",ZV) ; RECORD THE TXT MISMATCH
-"RTN","C0CRXN",198,0)
+"RTN","C0CRXN",196,0)
. E S NOMATCH=NOMATCH+1 ; NOT FOUND IN RXNORM
-"RTN","C0CRXN",199,0)
+"RTN","C0CRXN",197,0)
. D GETN1^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;TRY TO GET FROM 176.111
-"RTN","C0CRXN",200,0)
+"RTN","C0CRXN",198,0)
. I $$ZVALUE("VUID","C0CB")="" D ; VUID NOT FOUND
-"RTN","C0CRXN",201,0)
+"RTN","C0CRXN",199,0)
. . ;W "NOT FOUND: ",C0CZX," ",$$ZVALUE("STR")," ",$$ZVALUE("RXCUI"),!
-"RTN","C0CRXN",202,0)
+"RTN","C0CRXN",200,0)
. . S MISSING=MISSING+1
-"RTN","C0CRXN",203,0)
+"RTN","C0CRXN",201,0)
. . D PUSH^GPLXPATH("MISSING",C0CZX) ;MISSING FROM MAPPING FILE
-"RTN","C0CRXN",204,0)
+"RTN","C0CRXN",202,0)
. E D ; FOUND IN VA MAPPING FILE
-"RTN","C0CRXN",205,0)
+"RTN","C0CRXN",203,0)
. . S FOUND=FOUND+1
-"RTN","C0CRXN",206,0)
+"RTN","C0CRXN",204,0)
. . I $$ZVALUE("VUID TEXT","C0CB")'=$$ZVALUE("NAME") D ; TEXT DOESN'T MATCH
-"RTN","C0CRXN",207,0)
+"RTN","C0CRXN",205,0)
. . . S NVAM=NVAM+1 ; MAPPING FILE TEXT IS DIFFERENT THAN NDF
-"RTN","C0CRXN",208,0)
+"RTN","C0CRXN",206,0)
. . . S ZY=$$ZVALUE("VUID TEXT","C0CB")_"^"_$$ZVALUE("NAME") ;BOTH STRINGS
-"RTN","C0CRXN",209,0)
+"RTN","C0CRXN",207,0)
. . . W "VA: ",ZY,!
-"RTN","C0CRXN",210,0)
+"RTN","C0CRXN",208,0)
. . . D PUSH^GPLXPATH("NVAM",ZY) ;SAVE IT
-"RTN","C0CRXN",211,0)
+"RTN","C0CRXN",209,0)
W "MISSING IN MAPPING FILE: ",MISSING,!
-"RTN","C0CRXN",212,0)
+"RTN","C0CRXN",210,0)
W "FOUND IN MAPPING FILE: ",FOUND,!
-"RTN","C0CRXN",213,0)
+"RTN","C0CRXN",211,0)
W "FOUND IN RXNORM: ",VMATCH,!
-"RTN","C0CRXN",214,0)
+"RTN","C0CRXN",212,0)
W "NOT FOUND IN RXNORM: ",NOMATCH,!
-"RTN","C0CRXN",215,0)
+"RTN","C0CRXN",213,0)
W "ERRORS: ",NOVUID,!
+"RTN","C0CRXN",214,0)
+ Q
+"RTN","C0CRXN",215,0)
+ ;
"RTN","C0CRXN",216,0)
- Q
+ D
"RTN","C0CRXN",217,0)
- ;
-"RTN","C0CRXN",218,0)
. I $$ZVALUE("MEDIATION CODE")="" D
-"RTN","C0CRXN",219,0)
+"RTN","C0CRXN",218,0)
. . S NORXN=NORXN+1 ;
-"RTN","C0CRXN",220,0)
+"RTN","C0CRXN",219,0)
. E D ; PROCESS MEDIATION CODE
-"RTN","C0CRXN",221,0)
+"RTN","C0CRXN",220,0)
. . S HASRXN=HASRXN+1
-"RTN","C0CRXN",222,0)
+"RTN","C0CRXN",221,0)
. . D SETFDA("MEDIATION CODE",$$ZVALUE("MEDIATION CODE")) ;
-"RTN","C0CRXN",223,0)
+"RTN","C0CRXN",222,0)
. I $$ZVALUE("VUID")="" D ; BAD RECORD
-"RTN","C0CRXN",224,0)
+"RTN","C0CRXN",223,0)
. . S NOVUID=NOVUID+1
-"RTN","C0CRXN",225,0)
+"RTN","C0CRXN",224,0)
. . ;D SETFDA("VUID",$$ZVALUE("VUID"))
-"RTN","C0CRXN",226,0)
+"RTN","C0CRXN",225,0)
. E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT"))
+"RTN","C0CRXN",226,0)
+ . ;ZWR C0CA
"RTN","C0CRXN",227,0)
- . . ;ZWR C0CA
-"RTN","C0CRXN",228,0)
. D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
-"RTN","C0CRXN",229,0)
+"RTN","C0CRXN",228,0)
. I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND
-"RTN","C0CRXN",230,0)
+"RTN","C0CRXN",229,0)
. . S RXFOUND=RXFOUND+1
-"RTN","C0CRXN",231,0)
+"RTN","C0CRXN",230,0)
. . I $$ZVALUE("MEDIATION CODE")="" D ; THIS IS A NEW CODE
-"RTN","C0CRXN",232,0)
+"RTN","C0CRXN",231,0)
. . . D SETFDA("MEDIATION CODE",$$ZVALUE("RXCUI","C0CB"))
-"RTN","C0CRXN",233,0)
+"RTN","C0CRXN",232,0)
. . . D SETFDA("NEW","Y") ;FLAG RECORD HAS HAVING NEW RXNORM
-"RTN","C0CRXN",234,0)
+"RTN","C0CRXN",233,0)
. . W "RXNORM=",$$ZVALUE("RXCUI","C0CB")," ",$$ZVALUE("STR","C0CB"),!
-"RTN","C0CRXN",235,0)
+"RTN","C0CRXN",234,0)
. . W "VUID TEXT: ",$$ZVALUE("VUID TEXT"),!
-"RTN","C0CRXN",236,0)
+"RTN","C0CRXN",235,0)
. . I $$ZVALUE("VUID TEXT")=$$ZVALUE("STR","C0CB") S TXTMATCH=TXTMATCH+1
-"RTN","C0CRXN",237,0)
+"RTN","C0CRXN",236,0)
. . E D ;
-"RTN","C0CRXN",238,0)
+"RTN","C0CRXN",237,0)
. . . D PUSH^GPLXPATH("NOMATCH",$$ZVALUE("VUID TEXT")_"^"_$$ZVALUE("STR","C0CB"))
-"RTN","C0CRXN",239,0)
+"RTN","C0CRXN",238,0)
. . . D SETFDA("RXNORM TEXT",$$ZVALUE("STR","C0CB")) ;
-"RTN","C0CRXN",240,0)
+"RTN","C0CRXN",239,0)
. . . D SETFDA("DIFFERENT TEXT","Y") ;FLAG RECORD FOR DIFFERENT TEXT
-"RTN","C0CRXN",241,0)
+"RTN","C0CRXN",240,0)
. I $$ZVALUE("MEDIATION CODE")=$$ZVALUE("RXCUI","C0CB") D ;
-"RTN","C0CRXN",242,0)
+"RTN","C0CRXN",241,0)
. . S RXMATCH=RXMATCH+1
-"RTN","C0CRXN",243,0)
+"RTN","C0CRXN",242,0)
. . W "VUID=",$$ZVALUE("VUID")," MATCH RXNORM=",$$ZVALUE("MEDIATION CODE"),!
-"RTN","C0CRXN",244,0)
+"RTN","C0CRXN",243,0)
. D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
-"RTN","C0CRXN",245,0)
+"RTN","C0CRXN",244,0)
. S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD
-"RTN","C0CRXN",246,0)
+"RTN","C0CRXN",245,0)
. D UPDATE^DIE("","C0CFDA")
+"RTN","C0CRXN",246,0)
+ . I $D(^TMP("DIERR",$J)) S $EC=",U1,"
"RTN","C0CRXN",247,0)
- . I $D(^TMP("DIERR",$J)) U $P BREAK
-"RTN","C0CRXN",248,0)
W "HAS RXN=",HASRXN,!
-"RTN","C0CRXN",249,0)
+"RTN","C0CRXN",248,0)
W "NO RXN=",NORXN,!
-"RTN","C0CRXN",250,0)
+"RTN","C0CRXN",249,0)
W "NO VUID=",NOVUID,!
-"RTN","C0CRXN",251,0)
+"RTN","C0CRXN",250,0)
W "RXNORM FOUND=",RXFOUND,!
-"RTN","C0CRXN",252,0)
+"RTN","C0CRXN",251,0)
W "RXNORM MATCHES:",RXMATCH,!
-"RTN","C0CRXN",253,0)
+"RTN","C0CRXN",252,0)
W "TEXT MATCHES:",TXTMATCH,!
+"RTN","C0CRXN",253,0)
+ Q
"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)
+"RTN","C0CRXN",255,0)
; TO SET TO VALUE C0CSV.
-"RTN","C0CRXN",257,0)
+"RTN","C0CRXN",256,0)
; C0CFDA,C0CA,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
-"RTN","C0CRXN",258,0)
+"RTN","C0CRXN",257,0)
; C0CSN,C0CSV ARE PASSED BY VALUE
+"RTN","C0CRXN",258,0)
+ ;
"RTN","C0CRXN",259,0)
- ;
-"RTN","C0CRXN",260,0)
N C0CSI,C0CSJ
-"RTN","C0CRXN",261,0)
+"RTN","C0CRXN",260,0)
S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
-"RTN","C0CRXN",262,0)
+"RTN","C0CRXN",261,0)
S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
-"RTN","C0CRXN",263,0)
+"RTN","C0CRXN",262,0)
S C0CFDA(C0CSI,"+"_C0CZX_",",C0CSJ)=C0CSV
-"RTN","C0CRXN",264,0)
+"RTN","C0CRXN",263,0)
Q
-"RTN","C0CRXN",265,0)
+"RTN","C0CRXN",264,0)
ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
-"RTN","C0CRXN",266,0)
+"RTN","C0CRXN",265,0)
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
+"RTN","C0CRXN",266,0)
+ ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
"RTN","C0CRXN",267,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
+ I '$D(ZTAB) S ZTAB="C0CA"
"RTN","C0CRXN",268,0)
- I '$D(ZTAB) S ZTAB="C0CA"
+ N ZR
"RTN","C0CRXN",269,0)
- N ZR
-"RTN","C0CRXN",270,0)
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
+"RTN","C0CRXN",270,0)
+ E S ZR=""
"RTN","C0CRXN",271,0)
- E S ZR=""
+ Q ZR
"RTN","C0CRXN",272,0)
- Q ZR
-"RTN","C0CRXN",273,0)
ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
-"RTN","C0CRXN",274,0)
+"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",275,0)
- ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
+ I '$D(ZTAB) S ZTAB="C0CA"
"RTN","C0CRXN",276,0)
- I '$D(ZTAB) S ZTAB="C0CA"
+ N ZR
"RTN","C0CRXN",277,0)
- N ZR
-"RTN","C0CRXN",278,0)
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
+"RTN","C0CRXN",278,0)
+ E S ZR=""
"RTN","C0CRXN",279,0)
- E S ZR=""
+ Q ZR
"RTN","C0CRXN",280,0)
- Q ZR
-"RTN","C0CRXN",281,0)
;
-"RTN","C0CRXN",282,0)
+"RTN","C0CRXN",281,0)
ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
-"RTN","C0CRXN",283,0)
+"RTN","C0CRXN",282,0)
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
-"RTN","C0CRXN",284,0)
+"RTN","C0CRXN",283,0)
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CRXN",285,0)
+"RTN","C0CRXN",284,0)
I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CRXN",286,0)
+"RTN","C0CRXN",285,0)
N ZR
-"RTN","C0CRXN",287,0)
+"RTN","C0CRXN",286,0)
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
-"RTN","C0CRXN",288,0)
+"RTN","C0CRXN",287,0)
E S ZR=""
-"RTN","C0CRXN",289,0)
+"RTN","C0CRXN",288,0)
Q ZR
-"RTN","C0CRXN",290,0)
+"RTN","C0CRXN",289,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)
- W "No entry from top" Q
+ ; Copyright Sam Habiel 2008.
"RTN","C0CRXNRD",4,0)
-IMPORT(PATH)
-"RTN","C0CRXNRD",5,0)
- I PATH="" QUIT
-"RTN","C0CRXNRD",6,0)
- D READSRC(PATH),READCON(PATH),READNDC(PATH)
-"RTN","C0CRXNRD",7,0)
- QUIT
-"RTN","C0CRXNRD",8,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)
-DELFILED(FN) ; Delete file data; PEP procedure; only for RxNorm files
+ ;
"RTN","C0CRXNRD",10,0)
- ; FN is Filenumber passed by Value
+ ; This program is distributed in the hope that it will be useful,
"RTN","C0CRXNRD",11,0)
- QUIT:$E(FN,1,3)'=176 ; Quit if not RxNorm files
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0CRXNRD",12,0)
- D CLEAN^DILF ; Clean FM variables
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
"RTN","C0CRXNRD",13,0)
- N ROOT S ROOT=$$ROOT^DILFD(FN,"",1) ; global root
+ ; GNU Affero General Public License for more details.
"RTN","C0CRXNRD",14,0)
- N ZERO S ZERO=@ROOT@(0) ; Save zero node
+ ;
"RTN","C0CRXNRD",15,0)
- S $P(ZERO,U,3,9999)="" ; Remove entry # and last edited
+ ; You should have received a copy of the GNU Affero General Public License
"RTN","C0CRXNRD",16,0)
- K @ROOT ; Kill the file -- so sad!
+ ; along with this program. If not, see .
"RTN","C0CRXNRD",17,0)
- S @ROOT@(0)=ZERO ; It riseth again!
+ ;
"RTN","C0CRXNRD",18,0)
- QUIT
+ W "No entry from top" Q
"RTN","C0CRXNRD",19,0)
-GETLINES(PATH,FILENAME) ; Get number of lines in a file
+IMPORT(PATH) ; Main entry point
"RTN","C0CRXNRD",20,0)
- D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
+ I PATH="" QUIT
"RTN","C0CRXNRD",21,0)
- U IO
+ D READSRC(PATH),READCON(PATH),READNDC(PATH)
"RTN","C0CRXNRD",22,0)
- N I
+ QUIT
"RTN","C0CRXNRD",23,0)
- F I=1:1 R LINE Q:$$STATUS^%ZISH
+ ;
"RTN","C0CRXNRD",24,0)
- D CLOSE^%ZISH("FILE")
+DELFILED(FN) ; Delete file data; PEP procedure; only for RxNorm files
"RTN","C0CRXNRD",25,0)
- Q I-1
+ ; FN is Filenumber passed by Value
"RTN","C0CRXNRD",26,0)
-READCON(PATH,INCRES) ; Open and read concepts file: RXNCONSO.RRF; EP
+ QUIT:$E(FN,1,3)'=176 ; Quit if not RxNorm files
"RTN","C0CRXNRD",27,0)
- ; PATH ByVal, path of RxNorm files
+ D CLEAN^DILF ; Clean FM variables
"RTN","C0CRXNRD",28,0)
- ; INCRES ByVal, include restricted sources. 1 for yes, 0 for no
+ N ROOT S ROOT=$$ROOT^DILFD(FN,"",1) ; global root
"RTN","C0CRXNRD",29,0)
- I PATH="" QUIT
+ N ZERO S ZERO=@ROOT@(0) ; Save zero node
"RTN","C0CRXNRD",30,0)
- S INCRES=+$G(INCRES) ; if not passed, becomes zero.
+ S $P(ZERO,U,3,9999)="" ; Remove entry # and last edited
"RTN","C0CRXNRD",31,0)
- N FILENAME S FILENAME="RXNCONSO.RRF"
+ K @ROOT ; Kill the file -- so sad!
"RTN","C0CRXNRD",32,0)
- D DELFILED(176.001) ; delete data
+ S @ROOT@(0)=ZERO ; It riseth again!
"RTN","C0CRXNRD",33,0)
- N LINES S LINES=$$GETLINES(PATH,FILENAME)
+ QUIT
"RTN","C0CRXNRD",34,0)
- D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
+GETLINES(PATH,FILENAME) ; Get number of lines in a file
"RTN","C0CRXNRD",35,0)
- IF POP D EN^DDIOL("Error reading file..., Please check...") G EX
+ D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
"RTN","C0CRXNRD",36,0)
- N C0CCOUNT
+ U IO
"RTN","C0CRXNRD",37,0)
- F C0CCOUNT=1:1 D Q:$$STATUS^%ZISH
+ N I
"RTN","C0CRXNRD",38,0)
- . U IO
+ F I=1:1 R LINE:0 Q:$$STATUS^%ZISH
"RTN","C0CRXNRD",39,0)
- . N LINE R LINE
+ D CLOSE^%ZISH("FILE")
"RTN","C0CRXNRD",40,0)
- . IF $$STATUS^%ZISH QUIT
+ Q I-1
"RTN","C0CRXNRD",41,0)
- . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000
+READCON(PATH,INCRES) ; Open and read concepts file: RXNCONSO.RRF; EP
"RTN","C0CRXNRD",42,0)
- . N RXCUI,RXAUI,SAB,TTY,CODE,STR ; Fileman fields numbers below
+ ; PATH ByVal, path of RxNorm files
"RTN","C0CRXNRD",43,0)
- . S RXCUI=$P(LINE,"|",1) ; .01
+ ; INCRES ByVal, include restricted sources. 1 for yes, 0 for no
"RTN","C0CRXNRD",44,0)
- . S RXAUI=$P(LINE,"|",8) ; 1
+ I PATH="" QUIT
"RTN","C0CRXNRD",45,0)
- . S SAB=$P(LINE,"|",12) ; 2
+ S INCRES=+$G(INCRES) ; if not passed, becomes zero.
"RTN","C0CRXNRD",46,0)
- . ; If the source is a restricted source, decide what to do based on what's asked.
+ N FILENAME S FILENAME="RXNCONSO.RRF"
"RTN","C0CRXNRD",47,0)
- . N SRCIEN S SRCIEN=$$FIND1^DIC(176.003,"","QX",SAB,"B") ; SrcIEN in RXNORM SOURCES file
+ D DELFILED(176.001) ; delete data
"RTN","C0CRXNRD",48,0)
- . N RESTRIC S RESTRIC=$$GET1^DIQ(176.003,SRCIEN,14,"I") ; 14 is restriction field; values 0-4
-"RTN","C0CRXNRD",49,0)
- . ; If RESTRIC is zero, then it's unrestricted. Everything else is restricted.
-"RTN","C0CRXNRD",50,0)
- . ; If user didn't ask to include restricted sources, and the source is restricted, then quit
-"RTN","C0CRXNRD",51,0)
- . I 'INCRES,RESTRIC QUIT
-"RTN","C0CRXNRD",52,0)
- . S TTY=$P(LINE,"|",13) ; 3
-"RTN","C0CRXNRD",53,0)
- . S CODE=$P(LINE,"|",14) ; 4
-"RTN","C0CRXNRD",54,0)
- . S STR=$P(LINE,"|",15) ; 5
-"RTN","C0CRXNRD",55,0)
- . ; Remove embedded "^"
-"RTN","C0CRXNRD",56,0)
- . S STR=$TR(STR,"^")
-"RTN","C0CRXNRD",57,0)
- . ; Convert STR into an array of 80 characters on each line
-"RTN","C0CRXNRD",58,0)
- . N STRLINE S STRLINE=$L(STR)\80+1
-"RTN","C0CRXNRD",59,0)
- . ; In each line, chop 80 characters off, reset STR to be the rest
-"RTN","C0CRXNRD",60,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)
- . ; Now, construct the FDA array
-"RTN","C0CRXNRD",62,0)
- . N RXNFDA
-"RTN","C0CRXNRD",63,0)
- . S RXNFDA(176.001,"+1,",.01)=RXCUI
-"RTN","C0CRXNRD",64,0)
- . S RXNFDA(176.001,"+1,",1)=RXAUI
-"RTN","C0CRXNRD",65,0)
- . S RXNFDA(176.001,"+1,",2)=SAB
-"RTN","C0CRXNRD",66,0)
- . S RXNFDA(176.001,"+1,",3)=TTY
-"RTN","C0CRXNRD",67,0)
- . S RXNFDA(176.001,"+1,",4)=CODE
-"RTN","C0CRXNRD",68,0)
- . N RXNIEN S RXNIEN(1)=C0CCOUNT
-"RTN","C0CRXNRD",69,0)
- . D UPDATE^DIE("","RXNFDA","RXNIEN")
-"RTN","C0CRXNRD",70,0)
- . I $D(^TMP("DIERR",$J)) D EN^DDIOL("ERROR") G EX
-"RTN","C0CRXNRD",71,0)
- . ; Now, file WP field STR
-"RTN","C0CRXNRD",72,0)
- . D WP^DIE(176.001,C0CCOUNT_",",5,,$NA(STR))
-"RTN","C0CRXNRD",73,0)
-EX D CLOSE^%ZISH("FILE")
-"RTN","C0CRXNRD",74,0)
- QUIT
-"RTN","C0CRXNRD",75,0)
-READNDC(PATH) ; Open and read NDC/RxNorm/VANDF relationship file: RXNSAT.RRF
-"RTN","C0CRXNRD",76,0)
- I PATH="" QUIT
-"RTN","C0CRXNRD",77,0)
- N FILENAME S FILENAME="RXNSAT.RRF"
-"RTN","C0CRXNRD",78,0)
- D DELFILED(176.002) ; delete data
-"RTN","C0CRXNRD",79,0)
N LINES S LINES=$$GETLINES(PATH,FILENAME)
-"RTN","C0CRXNRD",80,0)
+"RTN","C0CRXNRD",49,0)
D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
-"RTN","C0CRXNRD",81,0)
- IF POP W "Error reading file..., Please check...",! G EX2
-"RTN","C0CRXNRD",82,0)
- F C0CCOUNT=1:1 Q:$$STATUS^%ZISH D
-"RTN","C0CRXNRD",83,0)
+"RTN","C0CRXNRD",50,0)
+ IF POP D EN^DDIOL("Error reading file..., Please check...") G EX
+"RTN","C0CRXNRD",51,0)
+ N C0CCOUNT
+"RTN","C0CRXNRD",52,0)
+ F C0CCOUNT=1:1 D Q:$$STATUS^%ZISH
+"RTN","C0CRXNRD",53,0)
. U IO
-"RTN","C0CRXNRD",84,0)
- . N LINE R LINE
-"RTN","C0CRXNRD",85,0)
+"RTN","C0CRXNRD",54,0)
+ . N LINE R LINE:0
+"RTN","C0CRXNRD",55,0)
. IF $$STATUS^%ZISH QUIT
-"RTN","C0CRXNRD",86,0)
+"RTN","C0CRXNRD",56,0)
. I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000
-"RTN","C0CRXNRD",87,0)
- . IF LINE'["NDC|RXNORM" QUIT
-"RTN","C0CRXNRD",88,0)
- . ; Otherwise, we are good to go
-"RTN","C0CRXNRD",89,0)
- . N RXCUI,NDC ; Fileman fields below
-"RTN","C0CRXNRD",90,0)
+"RTN","C0CRXNRD",57,0)
+ . N RXCUI,RXAUI,SAB,TTY,CODE,STR ; Fileman fields numbers below
+"RTN","C0CRXNRD",58,0)
. S RXCUI=$P(LINE,"|",1) ; .01
-"RTN","C0CRXNRD",91,0)
- . S NDC=$P(LINE,"|",11) ; 2
-"RTN","C0CRXNRD",92,0)
- . ; Using classic call to update.
-"RTN","C0CRXNRD",93,0)
- . N DIC,X,DA,DR
-"RTN","C0CRXNRD",94,0)
- . K DO
-"RTN","C0CRXNRD",95,0)
- . S DIC="^C0CRXN(176.002,",DIC(0)="F",X=RXCUI,DIC("DR")="2////"_NDC
-"RTN","C0CRXNRD",96,0)
- . D FILE^DICN
-"RTN","C0CRXNRD",97,0)
- . I Y<1 U $P W !,"THERE IS TROUBLE IN RIVER CITY",! G EX2
-"RTN","C0CRXNRD",98,0)
-EX2 D CLOSE^%ZISH("FILE")
-"RTN","C0CRXNRD",99,0)
- QUIT
-"RTN","C0CRXNRD",100,0)
-READSRC(PATH) ; Open the read RxNorm Sources file: RXNSAB.RRF
-"RTN","C0CRXNRD",101,0)
- I PATH="" QUIT
-"RTN","C0CRXNRD",102,0)
- N FILENAME S FILENAME="RXNSAB.RRF"
-"RTN","C0CRXNRD",103,0)
- D DELFILED(176.003) ; delete data
-"RTN","C0CRXNRD",104,0)
- D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
-"RTN","C0CRXNRD",105,0)
- IF POP W "Error reading file..., Please check...",! G EX3
-"RTN","C0CRXNRD",106,0)
- F I=1:1 Q:$$STATUS^%ZISH D
-"RTN","C0CRXNRD",107,0)
- . U IO
-"RTN","C0CRXNRD",108,0)
- . N LINE R LINE
-"RTN","C0CRXNRD",109,0)
- . IF $$STATUS^%ZISH QUIT
-"RTN","C0CRXNRD",110,0)
- . U $P W I,! U IO ; Write I to the screen, then go back to reading the file
-"RTN","C0CRXNRD",111,0)
- . N VCUI,RCUI,VSAB,RSAB,SON,SF,SVER,SRL,SCIT ; Fileman fields numbers below
-"RTN","C0CRXNRD",112,0)
- . S VCUI=$P(LINE,"|",1) ; .01
-"RTN","C0CRXNRD",113,0)
- . S RCUI=$P(LINE,"|",2) ; 2
-"RTN","C0CRXNRD",114,0)
- . S VSAB=$P(LINE,"|",3) ; 3
-"RTN","C0CRXNRD",115,0)
- . S RSAB=$P(LINE,"|",4) ; 4
-"RTN","C0CRXNRD",116,0)
- . S SON=$P(LINE,"|",5) ; 5
-"RTN","C0CRXNRD",117,0)
- . S SF=$P(LINE,"|",6) ; 6
-"RTN","C0CRXNRD",118,0)
- . S SVER=$P(LINE,"|",7) ; 7
-"RTN","C0CRXNRD",119,0)
- . S SRL=$P(LINE,"|",14) ; 14
-"RTN","C0CRXNRD",120,0)
- . S SCIT=$P(LINE,"|",25) ; 25
-"RTN","C0CRXNRD",121,0)
+"RTN","C0CRXNRD",59,0)
+ . S RXAUI=$P(LINE,"|",8) ; 1
+"RTN","C0CRXNRD",60,0)
+ . S SAB=$P(LINE,"|",12) ; 2
+"RTN","C0CRXNRD",61,0)
+ . ; If the source is a restricted source, decide what to do based on what's asked.
+"RTN","C0CRXNRD",62,0)
+ . N SRCIEN S SRCIEN=$$FIND1^DIC(176.003,"","QX",SAB,"B") ; SrcIEN in RXNORM SOURCES file
+"RTN","C0CRXNRD",63,0)
+ . N RESTRIC S RESTRIC=$$GET1^DIQ(176.003,SRCIEN,14,"I") ; 14 is restriction field; values 0-4
+"RTN","C0CRXNRD",64,0)
+ . ; If RESTRIC is zero, then it's unrestricted. Everything else is restricted.
+"RTN","C0CRXNRD",65,0)
+ . ; If user didn't ask to include restricted sources, and the source is restricted, then quit
+"RTN","C0CRXNRD",66,0)
+ . I 'INCRES,RESTRIC QUIT
+"RTN","C0CRXNRD",67,0)
+ . S TTY=$P(LINE,"|",13) ; 3
+"RTN","C0CRXNRD",68,0)
+ . S CODE=$P(LINE,"|",14) ; 4
+"RTN","C0CRXNRD",69,0)
+ . S STR=$P(LINE,"|",15) ; 5
+"RTN","C0CRXNRD",70,0)
. ; Remove embedded "^"
-"RTN","C0CRXNRD",122,0)
- . S SCIT=$TR(SCIT,"^")
-"RTN","C0CRXNRD",123,0)
- . ; Convert SCIT into an array of 80 characters on each line
-"RTN","C0CRXNRD",124,0)
- . ; In each line, chop 80 characters off, reset SCIT to be the rest
-"RTN","C0CRXNRD",125,0)
- . N SCITLINE S SCITLINE=$L(SCIT)\80+1
-"RTN","C0CRXNRD",126,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",71,0)
+ . S STR=$TR(STR,"^")
+"RTN","C0CRXNRD",72,0)
+ . ; Convert STR into an array of 80 characters on each line
+"RTN","C0CRXNRD",73,0)
+ . N STRLINE S STRLINE=$L(STR)\80+1
+"RTN","C0CRXNRD",74,0)
+ . ; In each line, chop 80 characters off, reset STR to be the rest
+"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",76,0)
. ; Now, construct the FDA array
-"RTN","C0CRXNRD",128,0)
+"RTN","C0CRXNRD",77,0)
. N RXNFDA
+"RTN","C0CRXNRD",78,0)
+ . S RXNFDA(176.001,"+1,",.01)=RXCUI
+"RTN","C0CRXNRD",79,0)
+ . S RXNFDA(176.001,"+1,",1)=RXAUI
+"RTN","C0CRXNRD",80,0)
+ . S RXNFDA(176.001,"+1,",2)=SAB
+"RTN","C0CRXNRD",81,0)
+ . S RXNFDA(176.001,"+1,",3)=TTY
+"RTN","C0CRXNRD",82,0)
+ . S RXNFDA(176.001,"+1,",4)=CODE
+"RTN","C0CRXNRD",83,0)
+ . N RXNIEN S RXNIEN(1)=C0CCOUNT
+"RTN","C0CRXNRD",84,0)
+ . D UPDATE^DIE("","RXNFDA","RXNIEN")
+"RTN","C0CRXNRD",85,0)
+ . I $D(^TMP("DIERR",$J)) D EN^DDIOL("ERROR") G EX
+"RTN","C0CRXNRD",86,0)
+ . ; Now, file WP field STR
+"RTN","C0CRXNRD",87,0)
+ . D WP^DIE(176.001,C0CCOUNT_",",5,,$NA(STR))
+"RTN","C0CRXNRD",88,0)
+EX D CLOSE^%ZISH("FILE")
+"RTN","C0CRXNRD",89,0)
+ QUIT
+"RTN","C0CRXNRD",90,0)
+READNDC(PATH) ; Open and read NDC/RxNorm/VANDF relationship file: RXNSAT.RRF
+"RTN","C0CRXNRD",91,0)
+ I PATH="" QUIT
+"RTN","C0CRXNRD",92,0)
+ N FILENAME S FILENAME="RXNSAT.RRF"
+"RTN","C0CRXNRD",93,0)
+ D DELFILED(176.002) ; delete data
+"RTN","C0CRXNRD",94,0)
+ N LINES S LINES=$$GETLINES(PATH,FILENAME)
+"RTN","C0CRXNRD",95,0)
+ D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
+"RTN","C0CRXNRD",96,0)
+ IF POP W "Error reading file..., Please check...",! G EX2
+"RTN","C0CRXNRD",97,0)
+ F C0CCOUNT=1:1 Q:$$STATUS^%ZISH D
+"RTN","C0CRXNRD",98,0)
+ . U IO
+"RTN","C0CRXNRD",99,0)
+ . N LINE R LINE:0
+"RTN","C0CRXNRD",100,0)
+ . IF $$STATUS^%ZISH QUIT
+"RTN","C0CRXNRD",101,0)
+ . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000
+"RTN","C0CRXNRD",102,0)
+ . IF LINE'["NDC|RXNORM" QUIT
+"RTN","C0CRXNRD",103,0)
+ . ; Otherwise, we are good to go
+"RTN","C0CRXNRD",104,0)
+ . N RXCUI,NDC ; Fileman fields below
+"RTN","C0CRXNRD",105,0)
+ . S RXCUI=$P(LINE,"|",1) ; .01
+"RTN","C0CRXNRD",106,0)
+ . S NDC=$P(LINE,"|",11) ; 2
+"RTN","C0CRXNRD",107,0)
+ . ; Using classic call to update.
+"RTN","C0CRXNRD",108,0)
+ . N DIC,X,DA,DR
+"RTN","C0CRXNRD",109,0)
+ . K DO
+"RTN","C0CRXNRD",110,0)
+ . S DIC="^C0CRXN(176.002,",DIC(0)="F",X=RXCUI,DIC("DR")="2////"_NDC
+"RTN","C0CRXNRD",111,0)
+ . D FILE^DICN
+"RTN","C0CRXNRD",112,0)
+ . I Y<1 U $P W !,"THERE IS TROUBLE IN RIVER CITY",! G EX2
+"RTN","C0CRXNRD",113,0)
+EX2 D CLOSE^%ZISH("FILE")
+"RTN","C0CRXNRD",114,0)
+ QUIT
+"RTN","C0CRXNRD",115,0)
+READSRC(PATH) ; Open the read RxNorm Sources file: RXNSAB.RRF
+"RTN","C0CRXNRD",116,0)
+ I PATH="" QUIT
+"RTN","C0CRXNRD",117,0)
+ N FILENAME S FILENAME="RXNSAB.RRF"
+"RTN","C0CRXNRD",118,0)
+ D DELFILED(176.003) ; delete data
+"RTN","C0CRXNRD",119,0)
+ D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
+"RTN","C0CRXNRD",120,0)
+ IF POP W "Error reading file..., Please check...",! G EX3
+"RTN","C0CRXNRD",121,0)
+ F I=1:1 Q:$$STATUS^%ZISH D
+"RTN","C0CRXNRD",122,0)
+ . U IO
+"RTN","C0CRXNRD",123,0)
+ . N LINE R LINE:0
+"RTN","C0CRXNRD",124,0)
+ . IF $$STATUS^%ZISH QUIT
+"RTN","C0CRXNRD",125,0)
+ . U $P W I,! U IO ; Write I to the screen, then go back to reading the file
+"RTN","C0CRXNRD",126,0)
+ . N VCUI,RCUI,VSAB,RSAB,SON,SF,SVER,SRL,SCIT ; Fileman fields numbers below
+"RTN","C0CRXNRD",127,0)
+ . S VCUI=$P(LINE,"|",1) ; .01
+"RTN","C0CRXNRD",128,0)
+ . S RCUI=$P(LINE,"|",2) ; 2
"RTN","C0CRXNRD",129,0)
- . S RXNFDA(176.003,"+"_I_",",.01)=VCUI
+ . S VSAB=$P(LINE,"|",3) ; 3
"RTN","C0CRXNRD",130,0)
- . S RXNFDA(176.003,"+"_I_",",2)=RCUI
+ . S RSAB=$P(LINE,"|",4) ; 4
"RTN","C0CRXNRD",131,0)
- . S RXNFDA(176.003,"+"_I_",",3)=VSAB
+ . S SON=$P(LINE,"|",5) ; 5
"RTN","C0CRXNRD",132,0)
- . S RXNFDA(176.003,"+"_I_",",4)=RSAB
+ . S SF=$P(LINE,"|",6) ; 6
"RTN","C0CRXNRD",133,0)
- . S RXNFDA(176.003,"+"_I_",",5)=SON
+ . S SVER=$P(LINE,"|",7) ; 7
"RTN","C0CRXNRD",134,0)
- . S RXNFDA(176.003,"+"_I_",",6)=SF
+ . S SRL=$P(LINE,"|",14) ; 14
"RTN","C0CRXNRD",135,0)
- . S RXNFDA(176.003,"+"_I_",",7)=SVER
+ . S SCIT=$P(LINE,"|",25) ; 25
"RTN","C0CRXNRD",136,0)
- . S RXNFDA(176.003,"+"_I_",",14)=SRL
+ . ; Remove embedded "^"
"RTN","C0CRXNRD",137,0)
- . D UPDATE^DIE("","RXNFDA")
+ . S SCIT=$TR(SCIT,"^")
"RTN","C0CRXNRD",138,0)
- . I $D(^TMP("DIERR",$J)) U $P W "ERR" G EX
+ . ; Convert SCIT into an array of 80 characters on each line
"RTN","C0CRXNRD",139,0)
- . ; Now, file WP field SCIT
+ . ; In each line, chop 80 characters off, reset SCIT to be the rest
"RTN","C0CRXNRD",140,0)
- . D WP^DIE(176.003,I_",",25,,$NA(SCIT))
+ . N SCITLINE S SCITLINE=$L(SCIT)\80+1
"RTN","C0CRXNRD",141,0)
-EX3 D CLOSE^%ZISH("FILE")
+ . F J=1:1:SCITLINE S SCIT(J)=$E(SCIT,1,80) S SCIT=$E(SCIT,81,$L(SCIT))
"RTN","C0CRXNRD",142,0)
- Q
+ . ; Now, construct the FDA array
"RTN","C0CRXNRD",143,0)
-
+ . N RXNFDA
+"RTN","C0CRXNRD",144,0)
+ . S RXNFDA(176.003,"+"_I_",",.01)=VCUI
+"RTN","C0CRXNRD",145,0)
+ . S RXNFDA(176.003,"+"_I_",",2)=RCUI
+"RTN","C0CRXNRD",146,0)
+ . S RXNFDA(176.003,"+"_I_",",3)=VSAB
+"RTN","C0CRXNRD",147,0)
+ . S RXNFDA(176.003,"+"_I_",",4)=RSAB
+"RTN","C0CRXNRD",148,0)
+ . S RXNFDA(176.003,"+"_I_",",5)=SON
+"RTN","C0CRXNRD",149,0)
+ . S RXNFDA(176.003,"+"_I_",",6)=SF
+"RTN","C0CRXNRD",150,0)
+ . S RXNFDA(176.003,"+"_I_",",7)=SVER
+"RTN","C0CRXNRD",151,0)
+ . S RXNFDA(176.003,"+"_I_",",14)=SRL
+"RTN","C0CRXNRD",152,0)
+ . D UPDATE^DIE("","RXNFDA")
+"RTN","C0CRXNRD",153,0)
+ . I $D(^TMP("DIERR",$J)) U $P W "ERR" G EX
+"RTN","C0CRXNRD",154,0)
+ . ; Now, file WP field SCIT
+"RTN","C0CRXNRD",155,0)
+ . D WP^DIE(176.003,I_",",25,,$NA(SCIT))
+"RTN","C0CRXNRD",156,0)
+EX3 D CLOSE^%ZISH("FILE")
+"RTN","C0CRXNRD",157,0)
+ Q
"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 .
"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.,
-"RTN","C0CSNOA",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","C0CSNOA",20,0)
- ;
-"RTN","C0CSNOA",21,0)
- ; THESE ROUTINES ANALYZE THE POTENTIAL RETRIEVAL OF SNOMED CT CODES
-"RTN","C0CSNOA",22,0)
- ; FOR PATIENT DRUG ALLERGIES FOR INCLUSION IN THE CCR OR CCD
-"RTN","C0CSNOA",23,0)
- ; USING THE VISTA LEXICON ^LEX
-"RTN","C0CSNOA",24,0)
- ;
-"RTN","C0CSNOA",25,0)
ANALYZE(BEGIEN,IENCNT) ; SNOMED RETRIEVAL ANALYSIS ROUTINE
+"RTN","C0CSNOA",19,0)
+ ; 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)
+ ; USE RESET^C0CSNOA TO RESET TO TOP OF DRUG LIST
+"RTN","C0CSNOA",22,0)
+ ;
+"RTN","C0CSNOA",23,0)
+ N SNOARY,SNOTMP,SNOI,SNOIEN,RATTR
+"RTN","C0CSNOA",24,0)
+ N CCRGLO
+"RTN","C0CSNOA",25,0)
+ 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,!
-"RTN","C0CSNOA",59,0)
- . ;
-"RTN","C0CSNOA",60,0)
- . S SNOIEN=$O(@GMRBASE@(SNOIEN)) ; NEXT RECORD
-"RTN","C0CSNOA",61,0)
- . S @SNOBASE@("RESUME")=SNOIEN ; WHERE WE ARE LEAVING OFF THIS RUN
-"RTN","C0CSNOA",62,0)
- ; D PARY^C0CXPATH(@SNOBASE@("ATTRTBL"))
-"RTN","C0CSNOA",63,0)
- Q
-"RTN","C0CSNOA",64,0)
- ;
-"RTN","C0CSNOA",65,0)
TEXTRPC(ORTN,ITEXT) ; CALL THE LEXICON WITH ITEXT AND RETURN RESULTS IN ORTN
-"RTN","C0CSNOA",66,0)
+"RTN","C0CSNOA",59,0)
;
-"RTN","C0CSNOA",67,0)
+"RTN","C0CSNOA",60,0)
;N TTMP
-"RTN","C0CSNOA",68,0)
+"RTN","C0CSNOA",61,0)
W ITEXT,!
-"RTN","C0CSNOA",69,0)
+"RTN","C0CSNOA",62,0)
S TTMP=$$TEXT^LEXTRAN(ITEXT,"","","SCT","ORTN")
-"RTN","C0CSNOA",70,0)
+"RTN","C0CSNOA",63,0)
Q
-"RTN","C0CSNOA",71,0)
+"RTN","C0CSNOA",64,0)
;
-"RTN","C0CSNOA",72,0)
+"RTN","C0CSNOA",65,0)
ASETUP ; SET UP GLOBALS AND VARS SNOBASE AND SNOTBL
-"RTN","C0CSNOA",73,0)
- I '$D(SNOBASE) S SNOBASE=$NA(^TMP("C0CSNO"))
-"RTN","C0CSNOA",74,0)
- I '$D(@SNOBASE) S @SNOBASE=""
-"RTN","C0CSNOA",75,0)
- I '$D(GMRBASE) S GMRBASE=$NA(^GMRD(120.82))
-"RTN","C0CSNOA",76,0)
- I '$D(SNOTBL) S SNOTBL=$NA(^TMP("C0CSNO","SNOTBL","TABLE")) ; ATTR TABLE
-"RTN","C0CSNOA",77,0)
- S ^TMP("C0CSNO","TABLES","SNOTBL")=SNOTBL ; TABLE OF TABLES
-"RTN","C0CSNOA",78,0)
- Q
-"RTN","C0CSNOA",79,0)
- ;
-"RTN","C0CSNOA",80,0)
-AINIT ; INITIALIZE ATTRIBUTE TABLE
-"RTN","C0CSNOA",81,0)
- I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","C0CSNOA",82,0)
- K @SNOTBL
-"RTN","C0CSNOA",83,0)
- D APUSH^C0CRIMA(SNOTBL,"CODE")
-"RTN","C0CSNOA",84,0)
- D APUSH^C0CRIMA(SNOTBL,"NOCODE")
-"RTN","C0CSNOA",85,0)
- D APUSH^C0CRIMA(SNOTBL,"MULTICODE")
-"RTN","C0CSNOA",86,0)
- D APUSH^C0CRIMA(SNOTBL,"SUBMULTI")
-"RTN","C0CSNOA",87,0)
- D APUSH^C0CRIMA(SNOTBL,"DONE")
-"RTN","C0CSNOA",88,0)
- Q
-"RTN","C0CSNOA",89,0)
-APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
-"RTN","C0CSNOA",90,0)
- ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
-"RTN","C0CSNOA",91,0)
- ; PTBL IS THE NAME OF A TABLE IN @SNOBASE@("TABLES") - "SNOTBL"=ALL VALUES
-"RTN","C0CSNOA",92,0)
- ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
-"RTN","C0CSNOA",93,0)
- I '$D(SNOBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
-"RTN","C0CSNOA",94,0)
- N USETBL
-"RTN","C0CSNOA",95,0)
- I '$D(@SNOBASE@("TABLES",PTBL)) D Q ; NO TABLE
-"RTN","C0CSNOA",96,0)
- . W "ERROR NO SUCH TABLE",!
-"RTN","C0CSNOA",97,0)
- S USETBL=@SNOBASE@("TABLES",PTBL)
-"RTN","C0CSNOA",98,0)
- S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
-"RTN","C0CSNOA",99,0)
- Q
-"RTN","C0CSNOA",100,0)
-SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
-"RTN","C0CSNOA",101,0)
- N SBASE,SATTR
-"RTN","C0CSNOA",102,0)
- S SBASE=$NA(@SNOBASE@("VARS",SDFN))
-"RTN","C0CSNOA",103,0)
- D APOST("SATTR","SNOTBL","DONE")
-"RTN","C0CSNOA",104,0)
- I $P(TTMP,"^",1)=1 D APOST("SATTR","SNOTBL","CODE")
-"RTN","C0CSNOA",105,0)
- I $P(TTMP,"^",1)=-1 D APOST("SATTR","SNOTBL","NOCODE")
-"RTN","C0CSNOA",106,0)
- Q SATTR ; C0C
-"RTN","C0CSNOA",107,0)
- I $D(@SBASE@("PROBLEMS",1)) D ;
-"RTN","C0CSNOA",108,0)
- . D APOST("SATTR","SNOTBL","PROBLEMS")
-"RTN","C0CSNOA",109,0)
- . ; W "POSTING PROBLEMS",!
-"RTN","C0CSNOA",110,0)
- I $D(@SBASE@("VITALS",1)) D APOST("SATTR","SNOTBL","VITALS")
-"RTN","C0CSNOA",111,0)
- I $D(@SBASE@("MEDS",1)) D ; IF THE PATIENT HAS MEDS VARIABLES
-"RTN","C0CSNOA",112,0)
- . D APOST("SATTR","SNOTBL","MEDS")
-"RTN","C0CSNOA",113,0)
- . N ZR,ZI
-"RTN","C0CSNOA",114,0)
- . D GETPA^C0CRIMA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
-"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
-"RTN","C0CSNOA",117,0)
- . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","SNOTBL","MEDSCODE") ;CODES
-"RTN","C0CSNOA",118,0)
- . ; D PATD^C0CSNOA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
-"RTN","C0CSNOA",119,0)
- D APOST("SATTR","SNOTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
-"RTN","C0CSNOA",120,0)
- ; W "ATTRIBUTES: ",SATTR,!
-"RTN","C0CSNOA",121,0)
- Q SATTR
-"RTN","C0CSNOA",122,0)
- ;
-"RTN","C0CSNOA",123,0)
-RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL SNO TMP VALUES
-"RTN","C0CSNOA",124,0)
- K ^TMP("C0CSNO","RESUME")
-"RTN","C0CSNOA",125,0)
- K ^TMP("C0CSNO")
-"RTN","C0CSNOA",126,0)
- Q
-"RTN","C0CSNOA",127,0)
- ;
-"RTN","C0CSNOA",128,0)
-CLIST ; LIST THE CATEGORIES
-"RTN","C0CSNOA",129,0)
- ;
-"RTN","C0CSNOA",130,0)
- I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","C0CSNOA",131,0)
- N CLBASE,CLNUM,ZI,CLIDX
-"RTN","C0CSNOA",132,0)
- S CLBASE=$NA(@SNOBASE@("SNOTBL","CATS"))
-"RTN","C0CSNOA",133,0)
- S CLNUM=@CLBASE@(0)
-"RTN","C0CSNOA",134,0)
- F ZI=1:1:CLNUM D ; LOOP THROUGH THE CATEGORIES
-"RTN","C0CSNOA",135,0)
- . S CLIDX=@CLBASE@(ZI)
-"RTN","C0CSNOA",136,0)
- . W "(",$P(@CLBASE@(CLIDX),"^",1)
-"RTN","C0CSNOA",137,0)
- . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
-"RTN","C0CSNOA",138,0)
- . W CLIDX,!
-"RTN","C0CSNOA",139,0)
- ; D PARY^C0CXPATH(CLBASE)
-"RTN","C0CSNOA",140,0)
- Q
-"RTN","C0CSNOA",141,0)
- ;
-"RTN","C0CSNOA",142,0)
-CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
-"RTN","C0CSNOA",143,0)
- ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
-"RTN","C0CSNOA",144,0)
- ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
-"RTN","C0CSNOA",145,0)
- ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
-"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"
-"RTN","C0CSNOA",148,0)
- ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
-"RTN","C0CSNOA",149,0)
- ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
-"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
-"RTN","C0CSNOA",152,0)
- ; NUMBER IE CTBL_X(CDFN)=""
-"RTN","C0CSNOA",153,0)
- ;
-"RTN","C0CSNOA",154,0)
- ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
-"RTN","C0CSNOA",155,0)
- S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
-"RTN","C0CSNOA",156,0)
- ; W "CBASE: ",CCTBL,!
-"RTN","C0CSNOA",157,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
-"RTN","C0CSNOA",160,0)
- . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
-"RTN","C0CSNOA",161,0)
- . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
-"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
-"RTN","C0CSNOA",164,0)
- . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
-"RTN","C0CSNOA",165,0)
- ;
-"RTN","C0CSNOA",166,0)
- S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
-"RTN","C0CSNOA",167,0)
- S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
-"RTN","C0CSNOA",168,0)
- S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
-"RTN","C0CSNOA",169,0)
- ;
-"RTN","C0CSNOA",170,0)
- S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
-"RTN","C0CSNOA",171,0)
- ;
-"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,!
-"RTN","C0CSNOA",174,0)
- S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
-"RTN","C0CSNOA",175,0)
- ;
-"RTN","C0CSNOA",176,0)
- Q
-"RTN","C0CSNOA",177,0)
- ;
-"RTN","C0CSNOA",178,0)
-REUSE ; GET SAVED VALUES FROM ^TMP("C0CSAV") AND PUT THEM IN A DATABASE
-"RTN","C0CSNOA",179,0)
- ;
-"RTN","C0CSNOA",180,0)
- D ASETUP
-"RTN","C0CSNOA",181,0)
- D AINIT
-"RTN","C0CSNOA",182,0)
- N SNOI,SNOJ,SNOK,SNOSNO,SNOSEC,SNOIEN,SNOOLD,SNOSRCH
-"RTN","C0CSNOA",183,0)
- S SAVBASE=$NA(^TMP("C0CSAV","VARS"))
-"RTN","C0CSNOA",184,0)
- S SNOI=""
-"RTN","C0CSNOA",185,0)
- F D Q:$O(@SAVBASE@(SNOI))="" ;THE WHOLE LIST
-"RTN","C0CSNOA",186,0)
- . S SNOI=$O(@SAVBASE@(SNOI))
-"RTN","C0CSNOA",187,0)
- . S SNOJ=@SAVBASE@(SNOI)
-"RTN","C0CSNOA",188,0)
- . S SNOK=$P($P(SNOJ,"^",1)," ALLERGY",1)
-"RTN","C0CSNOA",189,0)
- . S SNOSRCH=$P(SNOJ,"^",1) ;SEARCH TERM USED TO OBTAIN SNOMED CODE
-"RTN","C0CSNOA",190,0)
- . S SNOIEN=$P(SNOJ,"^",3) ; IEN OF ELEMENT IN LEXICON
-"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)
+"RTN","C0CSNOA",66,0)
+ I '$D(SNOBASE) S SNOBASE=$NA(^TMP("C0CSNO"))
+"RTN","C0CSNOA",67,0)
+ I '$D(@SNOBASE) S @SNOBASE=""
+"RTN","C0CSNOA",68,0)
+ I '$D(GMRBASE) S GMRBASE=$NA(^GMRD(120.82))
+"RTN","C0CSNOA",69,0)
+ 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",198,0)
+"RTN","C0CSNOA",72,0)
+ ;
+"RTN","C0CSNOA",73,0)
+AINIT ; INITIALIZE ATTRIBUTE TABLE
+"RTN","C0CSNOA",74,0)
+ I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","C0CSNOA",75,0)
+ K @SNOTBL
+"RTN","C0CSNOA",76,0)
+ D APUSH^C0CRIMA(SNOTBL,"CODE")
+"RTN","C0CSNOA",77,0)
+ D APUSH^C0CRIMA(SNOTBL,"NOCODE")
+"RTN","C0CSNOA",78,0)
+ D APUSH^C0CRIMA(SNOTBL,"MULTICODE")
+"RTN","C0CSNOA",79,0)
+ D APUSH^C0CRIMA(SNOTBL,"SUBMULTI")
+"RTN","C0CSNOA",80,0)
+ D APUSH^C0CRIMA(SNOTBL,"DONE")
+"RTN","C0CSNOA",81,0)
+ Q
+"RTN","C0CSNOA",82,0)
+APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
+"RTN","C0CSNOA",83,0)
+ ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
+"RTN","C0CSNOA",84,0)
+ ; PTBL IS THE NAME OF A TABLE IN @SNOBASE@("TABLES") - "SNOTBL"=ALL VALUES
+"RTN","C0CSNOA",85,0)
+ ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
+"RTN","C0CSNOA",86,0)
+ I '$D(SNOBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
+"RTN","C0CSNOA",87,0)
+ N USETBL
+"RTN","C0CSNOA",88,0)
+ I '$D(@SNOBASE@("TABLES",PTBL)) D Q ; NO TABLE
+"RTN","C0CSNOA",89,0)
+ . W "ERROR NO SUCH TABLE",!
+"RTN","C0CSNOA",90,0)
+ S USETBL=@SNOBASE@("TABLES",PTBL)
+"RTN","C0CSNOA",91,0)
+ S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
+"RTN","C0CSNOA",92,0)
+ Q
+"RTN","C0CSNOA",93,0)
+SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
+"RTN","C0CSNOA",94,0)
+ N SBASE,SATTR
+"RTN","C0CSNOA",95,0)
+ S SBASE=$NA(@SNOBASE@("VARS",SDFN))
+"RTN","C0CSNOA",96,0)
+ D APOST("SATTR","SNOTBL","DONE")
+"RTN","C0CSNOA",97,0)
+ I $P(TTMP,"^",1)=1 D APOST("SATTR","SNOTBL","CODE")
+"RTN","C0CSNOA",98,0)
+ I $P(TTMP,"^",1)=-1 D APOST("SATTR","SNOTBL","NOCODE")
+"RTN","C0CSNOA",99,0)
+ Q SATTR ; C0C
+"RTN","C0CSNOA",100,0)
+ I $D(@SBASE@("PROBLEMS",1)) D ;
+"RTN","C0CSNOA",101,0)
+ . D APOST("SATTR","SNOTBL","PROBLEMS")
+"RTN","C0CSNOA",102,0)
+ . ; W "POSTING PROBLEMS",!
+"RTN","C0CSNOA",103,0)
+ I $D(@SBASE@("VITALS",1)) D APOST("SATTR","SNOTBL","VITALS")
+"RTN","C0CSNOA",104,0)
+ I $D(@SBASE@("MEDS",1)) D ; IF THE PATIENT HAS MEDS VARIABLES
+"RTN","C0CSNOA",105,0)
+ . D APOST("SATTR","SNOTBL","MEDS")
+"RTN","C0CSNOA",106,0)
+ . N ZR,ZI
+"RTN","C0CSNOA",107,0)
+ . D GETPA^C0CRIMA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
+"RTN","C0CSNOA",108,0)
+ . I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
+"RTN","C0CSNOA",109,0)
+ . . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
+"RTN","C0CSNOA",110,0)
+ . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","SNOTBL","MEDSCODE") ;CODES
+"RTN","C0CSNOA",111,0)
+ . ; D PATD^C0CSNOA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
+"RTN","C0CSNOA",112,0)
+ D APOST("SATTR","SNOTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
+"RTN","C0CSNOA",113,0)
+ ; W "ATTRIBUTES: ",SATTR,!
+"RTN","C0CSNOA",114,0)
+ Q SATTR
+"RTN","C0CSNOA",115,0)
+ ;
+"RTN","C0CSNOA",116,0)
+RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL SNO TMP VALUES
+"RTN","C0CSNOA",117,0)
+ K ^TMP("C0CSNO","RESUME")
+"RTN","C0CSNOA",118,0)
+ K ^TMP("C0CSNO")
+"RTN","C0CSNOA",119,0)
+ Q
+"RTN","C0CSNOA",120,0)
+ ;
+"RTN","C0CSNOA",121,0)
+CLIST ; LIST THE CATEGORIES
+"RTN","C0CSNOA",122,0)
+ ;
+"RTN","C0CSNOA",123,0)
+ I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","C0CSNOA",124,0)
+ N CLBASE,CLNUM,ZI,CLIDX
+"RTN","C0CSNOA",125,0)
+ S CLBASE=$NA(@SNOBASE@("SNOTBL","CATS"))
+"RTN","C0CSNOA",126,0)
+ S CLNUM=@CLBASE@(0)
+"RTN","C0CSNOA",127,0)
+ F ZI=1:1:CLNUM D ; LOOP THROUGH THE CATEGORIES
+"RTN","C0CSNOA",128,0)
+ . S CLIDX=@CLBASE@(ZI)
+"RTN","C0CSNOA",129,0)
+ . W "(",$P(@CLBASE@(CLIDX),"^",1)
+"RTN","C0CSNOA",130,0)
+ . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
+"RTN","C0CSNOA",131,0)
+ . W CLIDX,!
+"RTN","C0CSNOA",132,0)
+ ; D PARY^C0CXPATH(CLBASE)
+"RTN","C0CSNOA",133,0)
+ Q
+"RTN","C0CSNOA",134,0)
+ ;
+"RTN","C0CSNOA",135,0)
+CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
+"RTN","C0CSNOA",136,0)
+ ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
+"RTN","C0CSNOA",137,0)
+ ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
+"RTN","C0CSNOA",138,0)
+ ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
+"RTN","C0CSNOA",139,0)
+ ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
+"RTN","C0CSNOA",140,0)
+ ; 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)
+ ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
+"RTN","C0CSNOA",143,0)
+ ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
+"RTN","C0CSNOA",144,0)
+ ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
+"RTN","C0CSNOA",145,0)
+ ; NUMBER IE CTBL_X(CDFN)=""
+"RTN","C0CSNOA",146,0)
+ ;
+"RTN","C0CSNOA",147,0)
+ ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
+"RTN","C0CSNOA",148,0)
+ S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
+"RTN","C0CSNOA",149,0)
+ ; W "CBASE: ",CCTBL,!
+"RTN","C0CSNOA",150,0)
+ ;
+"RTN","C0CSNOA",151,0)
+ I '$D(@CCTBL@(CATTR)) D ; FIRST PATIENT IN THIS CATEGORY
+"RTN","C0CSNOA",152,0)
+ . 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)
+ . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
+"RTN","C0CSNOA",155,0)
+ . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
+"RTN","C0CSNOA",156,0)
+ . ; 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)
+ ;
+"RTN","C0CSNOA",159,0)
+ S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
+"RTN","C0CSNOA",160,0)
+ S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
+"RTN","C0CSNOA",161,0)
+ S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
+"RTN","C0CSNOA",162,0)
+ ;
+"RTN","C0CSNOA",163,0)
+ S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
+"RTN","C0CSNOA",164,0)
+ ;
+"RTN","C0CSNOA",165,0)
+ S CPATLIST=$NA(@CBASE@(CTBL,"IENS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
+"RTN","C0CSNOA",166,0)
+ ; W "IENS BASE: ",CPATLIST,!
+"RTN","C0CSNOA",167,0)
+ S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
+"RTN","C0CSNOA",168,0)
+ ;
+"RTN","C0CSNOA",169,0)
+ Q
+"RTN","C0CSNOA",170,0)
+ ;
+"RTN","C0CSNOA",171,0)
+REUSE ; GET SAVED VALUES FROM ^TMP("C0CSAV") AND PUT THEM IN A DATABASE
+"RTN","C0CSNOA",172,0)
+ ;
+"RTN","C0CSNOA",173,0)
+ D ASETUP
+"RTN","C0CSNOA",174,0)
+ D AINIT
+"RTN","C0CSNOA",175,0)
+ N SNOI,SNOJ,SNOK,SNOSNO,SNOSEC,SNOIEN,SNOOLD,SNOSRCH
+"RTN","C0CSNOA",176,0)
+ S SAVBASE=$NA(^TMP("C0CSAV","VARS"))
+"RTN","C0CSNOA",177,0)
+ S SNOI=""
+"RTN","C0CSNOA",178,0)
+ F D Q:$O(@SAVBASE@(SNOI))="" ;THE WHOLE LIST
+"RTN","C0CSNOA",179,0)
+ . S SNOI=$O(@SAVBASE@(SNOI))
+"RTN","C0CSNOA",180,0)
+ . S SNOJ=@SAVBASE@(SNOI)
+"RTN","C0CSNOA",181,0)
+ . S SNOK=$P($P(SNOJ,"^",1)," ALLERGY",1)
+"RTN","C0CSNOA",182,0)
+ . S SNOSRCH=$P(SNOJ,"^",1) ;SEARCH TERM USED TO OBTAIN SNOMED CODE
+"RTN","C0CSNOA",183,0)
+ . S SNOIEN=$P(SNOJ,"^",3) ; IEN OF ELEMENT IN LEXICON
+"RTN","C0CSNOA",184,0)
+ . S SNOSNO=$P(SNOJ,"^",4) ; SNOMED CODE
+"RTN","C0CSNOA",185,0)
+ . S SNOSEC=$P(SNOJ,"^",5) ; SECTION OF SNOMED FOR THIS CODE
+"RTN","C0CSNOA",186,0)
+ . S SNOOLD=$P(SNOJ,"^",7) ; OLD NUMBER FOR THIS CODE
+"RTN","C0CSNOA",187,0)
+ . W "SEARCH:",SNOSRCH," IEN:",SNOIEN," CODE:",SNOSNO," SEC:",SNOSEC," OLD:",SNOOLD,!
+"RTN","C0CSNOA",188,0)
+ . W SNOK,!
+"RTN","C0CSNOA",189,0)
+ . W SNOJ,!
+"RTN","C0CSNOA",190,0)
+ Q
+"RTN","C0CSNOA",191,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 .
"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.
-"RTN","C0CSOAP",19,0)
- ;
-"RTN","C0CSOAP",20,0)
W "This is an SOAP utility library",!
+"RTN","C0CSOAP",19,0)
+ W !
+"RTN","C0CSOAP",20,0)
+ Q
"RTN","C0CSOAP",21,0)
- W !
+ ;
"RTN","C0CSOAP",22,0)
- Q
-"RTN","C0CSOAP",23,0)
- ;
-"RTN","C0CSOAP",24,0)
TEST1
-"RTN","C0CSOAP",25,0)
+"RTN","C0CSOAP",23,0)
S url="https://ec2-75-101-247-83.compute-1.amazonaws.com:8181/ccr/CCRService?wsdl"
-"RTN","C0CSOAP",26,0)
+"RTN","C0CSOAP",24,0)
D GET1URL^C0CEWD2(url)
+"RTN","C0CSOAP",25,0)
+ Q
+"RTN","C0CSOAP",26,0)
+ ;
"RTN","C0CSOAP",27,0)
- Q
-"RTN","C0CSOAP",28,0)
- ;
-"RTN","C0CSOAP",29,0)
INITFARY(ARY) ;initialize the Fileman Field array for SOAP processing
-"RTN","C0CSOAP",30,0)
+"RTN","C0CSOAP",28,0)
; ARY is passed by name
-"RTN","C0CSOAP",31,0)
+"RTN","C0CSOAP",29,0)
S @ARY@("XML FILE NUMBER")="178.301"
-"RTN","C0CSOAP",32,0)
+"RTN","C0CSOAP",30,0)
S @ARY@("BINDING SUBFILE NUMBER")="178.3014"
-"RTN","C0CSOAP",33,0)
+"RTN","C0CSOAP",31,0)
S @ARY@("MIME TYPE")="2.3"
-"RTN","C0CSOAP",34,0)
+"RTN","C0CSOAP",32,0)
S @ARY@("PROXY SERVER")="2.4"
-"RTN","C0CSOAP",35,0)
+"RTN","C0CSOAP",33,0)
S @ARY@("REPLY TEMPLATE")=".03"
-"RTN","C0CSOAP",36,0)
+"RTN","C0CSOAP",34,0)
S @ARY@("TEMPLATE NAME")=".01"
-"RTN","C0CSOAP",37,0)
+"RTN","C0CSOAP",35,0)
S @ARY@("TEMPLATE XML")="3"
-"RTN","C0CSOAP",38,0)
+"RTN","C0CSOAP",36,0)
S @ARY@("URL")="1"
-"RTN","C0CSOAP",39,0)
+"RTN","C0CSOAP",37,0)
S @ARY@("WSDL URL")="2"
-"RTN","C0CSOAP",40,0)
+"RTN","C0CSOAP",38,0)
S @ARY@("XML")="2.1"
-"RTN","C0CSOAP",41,0)
+"RTN","C0CSOAP",39,0)
S @ARY@("XML HEADER")="2.2"
-"RTN","C0CSOAP",42,0)
+"RTN","C0CSOAP",40,0)
S @ARY@("XPATH REDUCTION STRING")="2.5"
-"RTN","C0CSOAP",43,0)
+"RTN","C0CSOAP",41,0)
S @ARY@("CCR VARIABLE")="4"
-"RTN","C0CSOAP",44,0)
+"RTN","C0CSOAP",42,0)
S @ARY@("FILEMAN FIELD NAME")="1"
-"RTN","C0CSOAP",45,0)
+"RTN","C0CSOAP",43,0)
S @ARY@("FILEMAN FIELD NUMBER")="1.2"
-"RTN","C0CSOAP",46,0)
+"RTN","C0CSOAP",44,0)
S @ARY@("FILEMAN FILE POINTER")="1.1"
-"RTN","C0CSOAP",47,0)
+"RTN","C0CSOAP",45,0)
S @ARY@("INDEXED BY")=".05"
-"RTN","C0CSOAP",48,0)
+"RTN","C0CSOAP",46,0)
S @ARY@("SQLI FIELD NAME")="3"
-"RTN","C0CSOAP",49,0)
+"RTN","C0CSOAP",47,0)
S @ARY@("VARIABLE NAME")="2"
+"RTN","C0CSOAP",48,0)
+ Q
+"RTN","C0CSOAP",49,0)
+ ;
"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)
+"RTN","C0CSOAP",51,0)
; FILE IS IDENTIFIED IN FARY, PASSED BY NAME
-"RTN","C0CSOAP",54,0)
+"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)
- . S INFARY="FARY"
-"RTN","C0CSOAP",56,0)
- . D INITFARY(INFARY)
-"RTN","C0CSOAP",57,0)
N ZN,ZREF,ZR
-"RTN","C0CSOAP",58,0)
+"RTN","C0CSOAP",56,0)
S ZN=@INFARY@("XML FILE NUMBER")
-"RTN","C0CSOAP",59,0)
+"RTN","C0CSOAP",57,0)
S ZREF=$$FILEREF^C0CRNF(ZN)
-"RTN","C0CSOAP",60,0)
+"RTN","C0CSOAP",58,0)
S ZR=$O(@ZREF@("B",INNAM,""))
-"RTN","C0CSOAP",61,0)
+"RTN","C0CSOAP",59,0)
Q ZR
-"RTN","C0CSOAP",62,0)
+"RTN","C0CSOAP",60,0)
;
-"RTN","C0CSOAP",63,0)
+"RTN","C0CSOAP",61,0)
TESTSOAP ;
-"RTN","C0CSOAP",64,0)
+"RTN","C0CSOAP",62,0)
; USING ICD9 WEB SERVICE TO TEST SOAP
-"RTN","C0CSOAP",65,0)
+"RTN","C0CSOAP",63,0)
S G("CODE")="E*"
-"RTN","C0CSOAP",66,0)
+"RTN","C0CSOAP",64,0)
S G("CODELN")=3
-"RTN","C0CSOAP",67,0)
+"RTN","C0CSOAP",65,0)
D SOAP("GPL","ICD9","G")
+"RTN","C0CSOAP",66,0)
+ Q
+"RTN","C0CSOAP",67,0)
+ ;
"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)
+"RTN","C0CSOAP",69,0)
; TEMPLATE ID C0CTID
-"RTN","C0CSOAP",72,0)
+"RTN","C0CSOAP",70,0)
; RETURNS THE XML RESULT IN C0CRTN, PASSED BY NAME
-"RTN","C0CSOAP",73,0)
+"RTN","C0CSOAP",71,0)
; C0CVA IS PASSED BY NAME AND IS THE VARIABLE ARRAY TO PASS TO BIND
-"RTN","C0CSOAP",74,0)
+"RTN","C0CSOAP",72,0)
; C0CVOR IS THE NAME OF A VARIABLE OVERRIDE ARRAY, WHICH IS APPLIED
-"RTN","C0CSOAP",75,0)
+"RTN","C0CSOAP",73,0)
; BEFORE MAPPING
-"RTN","C0CSOAP",76,0)
+"RTN","C0CSOAP",74,0)
; IF ALTXML IS PASSED, BIND AND MAP WILL BE SKIPPED AND
-"RTN","C0CSOAP",77,0)
+"RTN","C0CSOAP",75,0)
; ALTXML WILL BE USED INSTEAD
-"RTN","C0CSOAP",78,0)
+"RTN","C0CSOAP",76,0)
;
-"RTN","C0CSOAP",79,0)
+"RTN","C0CSOAP",77,0)
; ARTIFACTS SECTION
-"RTN","C0CSOAP",80,0)
+"RTN","C0CSOAP",78,0)
; THE FOLLOWING WILL SET UP DEBUGGING ARTIFACTS FOR A POSSIBLE FUTURE
-"RTN","C0CSOAP",81,0)
+"RTN","C0CSOAP",79,0)
; ONLINE DEBUGGER. IF DEBUG=1, VARIABLES CONTAINING INTERMEDIATE RESULTS
-"RTN","C0CSOAP",82,0)
+"RTN","C0CSOAP",80,0)
; WILL NOT BE NEWED.
-"RTN","C0CSOAP",83,0)
+"RTN","C0CSOAP",81,0)
I $G(WSDEBUG)="" N C0CV ; CATALOG OF ARTIFACT VARIABLES AND ARRAYS
-"RTN","C0CSOAP",84,0)
+"RTN","C0CSOAP",82,0)
S C0CV(100,"C0CXF","XML TEMPLATE FILE NUMBER")=""
-"RTN","C0CSOAP",85,0)
+"RTN","C0CSOAP",83,0)
S C0CV(200,"C0CHEAD","SOAP HEADER VARIABLE NAME")=""
-"RTN","C0CSOAP",86,0)
+"RTN","C0CSOAP",84,0)
S C0CV(300,"HEADER","SOAP HEADER")=""
-"RTN","C0CSOAP",87,0)
+"RTN","C0CSOAP",85,0)
S C0CV(400,"C0CMIME","MIME TYPE")=""
-"RTN","C0CSOAP",88,0)
+"RTN","C0CSOAP",86,0)
S C0CV(500,"C0CURL","WS URL")=""
-"RTN","C0CSOAP",89,0)
+"RTN","C0CSOAP",87,0)
S C0CV(550,"C0CPURL","PROXY URL")=""
-"RTN","C0CSOAP",90,0)
+"RTN","C0CSOAP",88,0)
S C0CV(600,"C0CXML","XML VARIABLE NAME")=""
-"RTN","C0CSOAP",91,0)
+"RTN","C0CSOAP",89,0)
S C0CV(700,"XML","OUTBOUND XML")=""
-"RTN","C0CSOAP",92,0)
+"RTN","C0CSOAP",90,0)
S C0CV(800,"C0CRSLT","RAW XML RESULT RETURNED FROM WEB SERVICE")=""
-"RTN","C0CSOAP",93,0)
+"RTN","C0CSOAP",91,0)
S C0CV(900,"C0CRHDR","RETURNED HEADER")=""
-"RTN","C0CSOAP",94,0)
+"RTN","C0CSOAP",92,0)
S C0CV(1000,"C0CRXML","XML RESULT NORMALIZED")=""
-"RTN","C0CSOAP",95,0)
+"RTN","C0CSOAP",93,0)
S C0CV(1100,"C0CR","REPLY TEMPLATE")=""
-"RTN","C0CSOAP",96,0)
+"RTN","C0CSOAP",94,0)
S C0CV(1200,"C0CREDUX","REDUX STRING")=""
-"RTN","C0CSOAP",97,0)
+"RTN","C0CSOAP",95,0)
S C0CV(1300,"C0CIDX","RESULT XPATH INDEX")=""
-"RTN","C0CSOAP",98,0)
+"RTN","C0CSOAP",96,0)
S C0CV(1400,"C0CARY","RESULT XPATH ARRAY")=""
-"RTN","C0CSOAP",99,0)
+"RTN","C0CSOAP",97,0)
S C0CV(1500,"C0CNOM","RESULT DOM DOCUMENT NAME")=""
-"RTN","C0CSOAP",100,0)
+"RTN","C0CSOAP",98,0)
S C0CV(1600,"C0CID","RESULT DOM ID")=""
-"RTN","C0CSOAP",101,0)
+"RTN","C0CSOAP",99,0)
I $G(DEBUG)'="" G NOTNEW ; SKIP NEWING THE VARIABLES IF IN DEBUG
-"RTN","C0CSOAP",102,0)
+"RTN","C0CSOAP",100,0)
N ZI,ZJ S ZI=""
-"RTN","C0CSOAP",103,0)
+"RTN","C0CSOAP",101,0)
NEW
-"RTN","C0CSOAP",104,0)
+"RTN","C0CSOAP",102,0)
S ZI=$O(C0CV(ZI))
-"RTN","C0CSOAP",105,0)
+"RTN","C0CSOAP",103,0)
S ZJ=$O(C0CV(ZI,"")) ; SET UP NEW COMMAND
-"RTN","C0CSOAP",106,0)
+"RTN","C0CSOAP",104,0)
;W ZJ,!
-"RTN","C0CSOAP",107,0)
+"RTN","C0CSOAP",105,0)
N @ZJ ; NEW THE VARIABLE
-"RTN","C0CSOAP",108,0)
+"RTN","C0CSOAP",106,0)
I $O(C0CV(ZI))'="" G NEW ;LOOP TO GET NEW IN CONTEXT
-"RTN","C0CSOAP",109,0)
+"RTN","C0CSOAP",107,0)
NOTNEW
-"RTN","C0CSOAP",110,0)
+"RTN","C0CSOAP",108,0)
; END ARTIFACTS
-"RTN","C0CSOAP",111,0)
+"RTN","C0CSOAP",109,0)
;
-"RTN","C0CSOAP",112,0)
+"RTN","C0CSOAP",110,0)
I '$D(IFARY) D INITFARY("C0CF") ; SET FILE NUMBER AND PARAMATERS
-"RTN","C0CSOAP",113,0)
+"RTN","C0CSOAP",111,0)
E D ;
-"RTN","C0CSOAP",114,0)
+"RTN","C0CSOAP",112,0)
. K C0CF
-"RTN","C0CSOAP",115,0)
+"RTN","C0CSOAP",113,0)
. M C0CF=@IFARY
-"RTN","C0CSOAP",116,0)
+"RTN","C0CSOAP",114,0)
S C0CXF=C0CF("XML FILE NUMBER") ; FILE NUMBER FOR THE XML TEMPLATE FILE
-"RTN","C0CSOAP",117,0)
+"RTN","C0CSOAP",115,0)
I +C0CTID=0 D ; A STRING WAS PASSED FOR THE TEMPLATE NAME
-"RTN","C0CSOAP",118,0)
+"RTN","C0CSOAP",116,0)
. S C0CUTID=$$RESTID(C0CTID,"C0CF") ;RESOLVE TEMPLATE IEN FROM NAME
-"RTN","C0CSOAP",119,0)
+"RTN","C0CSOAP",117,0)
E S C0CUTID=C0CTID ; AN IEN WAS PASSED
-"RTN","C0CSOAP",120,0)
+"RTN","C0CSOAP",118,0)
N XML,TEMPLATE,HEADER
-"RTN","C0CSOAP",121,0)
+"RTN","C0CSOAP",119,0)
N C0CFH S C0CFH=C0CF("XML HEADER")
-"RTN","C0CSOAP",122,0)
+"RTN","C0CSOAP",120,0)
S C0CHEAD=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFH,,"HEADER")
-"RTN","C0CSOAP",123,0)
+"RTN","C0CSOAP",121,0)
N C0CFM S C0CFM=C0CF("MIME TYPE")
-"RTN","C0CSOAP",124,0)
+"RTN","C0CSOAP",122,0)
S C0CMIME=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFM)
-"RTN","C0CSOAP",125,0)
+"RTN","C0CSOAP",123,0)
N C0CFP S C0CFP=C0CF("PROXY SERVER")
-"RTN","C0CSOAP",126,0)
+"RTN","C0CSOAP",124,0)
S C0CPURL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFP)
-"RTN","C0CSOAP",127,0)
+"RTN","C0CSOAP",125,0)
N C0CFU S C0CFU=C0CF("URL")
-"RTN","C0CSOAP",128,0)
+"RTN","C0CSOAP",126,0)
S C0CURL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFU)
-"RTN","C0CSOAP",129,0)
+"RTN","C0CSOAP",127,0)
N C0CFX S C0CFX=C0CF("XML")
-"RTN","C0CSOAP",130,0)
+"RTN","C0CSOAP",128,0)
S C0CXML=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFX,,"XML")
-"RTN","C0CSOAP",131,0)
+"RTN","C0CSOAP",129,0)
N C0CFT S C0CFT=C0CF("TEMPLATE XML")
-"RTN","C0CSOAP",132,0)
+"RTN","C0CSOAP",130,0)
S C0CTMPL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFT,,"TEMPLATE")
-"RTN","C0CSOAP",133,0)
+"RTN","C0CSOAP",131,0)
I C0CTMPL="TEMPLATE" D ; there is a template to process
-"RTN","C0CSOAP",134,0)
+"RTN","C0CSOAP",132,0)
. K XML ; going to replace the xml array
-"RTN","C0CSOAP",135,0)
+"RTN","C0CSOAP",133,0)
. N VARS
-"RTN","C0CSOAP",136,0)
+"RTN","C0CSOAP",134,0)
. I $D(C0CVOR) M @C0CVA=@C0CVOR ; merge in varible overrides
-"RTN","C0CSOAP",137,0)
+"RTN","C0CSOAP",135,0)
. I '$D(ALTXML) D ; if ALTXML is passed in, don't bind
-"RTN","C0CSOAP",138,0)
+"RTN","C0CSOAP",136,0)
. . D BIND("VARS",C0CVA,C0CUTID,"C0CF")
-"RTN","C0CSOAP",139,0)
+"RTN","C0CSOAP",137,0)
. . D MAP("XML","VARS",TPTR,"C0CF")
-"RTN","C0CSOAP",140,0)
+"RTN","C0CSOAP",138,0)
. . K XML(0)
-"RTN","C0CSOAP",141,0)
+"RTN","C0CSOAP",139,0)
. E M XML=@ALTXML ; use ALTXML instead
-"RTN","C0CSOAP",142,0)
+"RTN","C0CSOAP",140,0)
I $G(C0CPROXY) S C0CURL=C0CPURL
-"RTN","C0CSOAP",143,0)
+"RTN","C0CSOAP",141,0)
K C0CRSLT,C0CRHDR
-"RTN","C0CSOAP",144,0)
+"RTN","C0CSOAP",142,0)
B
-"RTN","C0CSOAP",145,0)
+"RTN","C0CSOAP",143,0)
S ok=$$httpPOST^%zewdGTM(C0CURL,.XML,C0CMIME,.C0CRSLT,.HEADER,"",.gpl5,.C0CRHDR)
-"RTN","C0CSOAP",146,0)
+"RTN","C0CSOAP",144,0)
K C0CRXML
-"RTN","C0CSOAP",147,0)
+"RTN","C0CSOAP",145,0)
D NORMAL("C0CRXML","C0CRSLT(1)") ;RETURN XML IN AN ARRAY
-"RTN","C0CSOAP",148,0)
+"RTN","C0CSOAP",146,0)
N C0CFR S C0CFR=$G(C0CF("REPLY TEMPLATE"))
-"RTN","C0CSOAP",149,0)
+"RTN","C0CSOAP",147,0)
S C0CR=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFR,"I") ; REPLY TEMPLATE
-"RTN","C0CSOAP",150,0)
+"RTN","C0CSOAP",148,0)
; reply templates are optional and are specified by populating a
-"RTN","C0CSOAP",151,0)
+"RTN","C0CSOAP",149,0)
; template pointer in field 2.5 of the request template
-"RTN","C0CSOAP",152,0)
+"RTN","C0CSOAP",150,0)
; if specified, the reply template is the source of the REDUX string
-"RTN","C0CSOAP",153,0)
+"RTN","C0CSOAP",151,0)
; used for XPath on the reply, and for UNBIND processing
-"RTN","C0CSOAP",154,0)
+"RTN","C0CSOAP",152,0)
; if no reply template is specified, REDUX is obtained from the request
-"RTN","C0CSOAP",155,0)
+"RTN","C0CSOAP",153,0)
; template and no UNBIND processing is performed. The XPath array is
-"RTN","C0CSOAP",156,0)
+"RTN","C0CSOAP",154,0)
; returned without variable bindings
-"RTN","C0CSOAP",157,0)
+"RTN","C0CSOAP",155,0)
I C0CR'="" D ; REPLY TEMPLATE EXISTS
-"RTN","C0CSOAP",158,0)
+"RTN","C0CSOAP",156,0)
. I +$G(DEBUG)'=0 W "REPLY TEMPLATE:",C0CR,!
-"RTN","C0CSOAP",159,0)
+"RTN","C0CSOAP",157,0)
. S C0CTID=C0CR ;
-"RTN","C0CSOAP",160,0)
+"RTN","C0CSOAP",158,0)
N C0CFRDX S C0CFRDX=C0CF("XPATH REDUCTION STRING")
-"RTN","C0CSOAP",161,0)
+"RTN","C0CSOAP",159,0)
S C0CREDUX=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFRDX) ;XPATH REDUCTION STRING
-"RTN","C0CSOAP",162,0)
+"RTN","C0CSOAP",160,0)
K C0CIDX,C0CARY ; XPATH INDEX AND ARRAY VARS
-"RTN","C0CSOAP",163,0)
+"RTN","C0CSOAP",161,0)
S C0CNOM="C0CWS"_$J ; DOCUMENT NAME FOR THE DOM
-"RTN","C0CSOAP",164,0)
+"RTN","C0CSOAP",162,0)
S C0CID=$$PARSE^C0CXEWD("C0CRXML",C0CNOM) ;CALL THE PARSER
-"RTN","C0CSOAP",165,0)
+"RTN","C0CSOAP",163,0)
S C0CID=$$FIRST^C0CXEWD($$ID^C0CXEWD(C0CNOM)) ;ID OF FIRST NODE
-"RTN","C0CSOAP",166,0)
+"RTN","C0CSOAP",164,0)
D XPATH^C0CXEWD(C0CID,"/","C0CIDX","C0CARY","",C0CREDUX) ;XPATH GENERATOR
-"RTN","C0CSOAP",167,0)
+"RTN","C0CSOAP",165,0)
; Next, call UNBIND to map the reply XPath array to variables
-"RTN","C0CSOAP",168,0)
+"RTN","C0CSOAP",166,0)
; This is only done if a Reply Template is provided
-"RTN","C0CSOAP",169,0)
+"RTN","C0CSOAP",167,0)
D DEMUXARY(C0CRTN,"C0CARY")
-"RTN","C0CSOAP",170,0)
+"RTN","C0CSOAP",168,0)
; M @C0CRTN=C0CARY
+"RTN","C0CSOAP",169,0)
+ Q
+"RTN","C0CSOAP",170,0)
+ ;
"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)
+"RTN","C0CSOAP",172,0)
; FORMAT @OARY@(x,xpath) where x is the first multiple
-"RTN","C0CSOAP",175,0)
+"RTN","C0CSOAP",173,0)
N ZI,ZJ,ZK,ZL S ZI=""
-"RTN","C0CSOAP",176,0)
+"RTN","C0CSOAP",174,0)
F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ;
-"RTN","C0CSOAP",177,0)
+"RTN","C0CSOAP",175,0)
. D DEMUX^C0CMXP("ZJ",ZI)
-"RTN","C0CSOAP",178,0)
+"RTN","C0CSOAP",176,0)
. S ZK=$P(ZJ,"^",3)
-"RTN","C0CSOAP",179,0)
+"RTN","C0CSOAP",177,0)
. S ZK=$RE($P($RE(ZK),"/",1))
-"RTN","C0CSOAP",180,0)
+"RTN","C0CSOAP",178,0)
. S ZL=$P(ZJ,"^",1)
-"RTN","C0CSOAP",181,0)
+"RTN","C0CSOAP",179,0)
. I ZL="" S ZL=1
-"RTN","C0CSOAP",182,0)
+"RTN","C0CSOAP",180,0)
. S @OARY@(ZL,ZK)=@IARY@(ZI)
+"RTN","C0CSOAP",181,0)
+ Q
+"RTN","C0CSOAP",182,0)
+ ;
"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)
+"RTN","C0CSOAP",184,0)
; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
-"RTN","C0CSOAP",187,0)
+"RTN","C0CSOAP",185,0)
;
-"RTN","C0CSOAP",188,0)
+"RTN","C0CSOAP",186,0)
N ZI,ZN,ZTMP
-"RTN","C0CSOAP",189,0)
+"RTN","C0CSOAP",187,0)
S ZN=1
-"RTN","C0CSOAP",190,0)
+"RTN","C0CSOAP",188,0)
S @OUTXML@(ZN)=$P(@INXML,"><",ZN)_">"
-"RTN","C0CSOAP",191,0)
+"RTN","C0CSOAP",189,0)
S ZN=ZN+1
-"RTN","C0CSOAP",192,0)
+"RTN","C0CSOAP",190,0)
F S @OUTXML@(ZN)="<"_$P(@INXML,"><",ZN) Q:$P(@INXML,"><",ZN+1)="" D ;
-"RTN","C0CSOAP",193,0)
+"RTN","C0CSOAP",191,0)
. S @OUTXML@(ZN)=@OUTXML@(ZN)_">"
-"RTN","C0CSOAP",194,0)
+"RTN","C0CSOAP",192,0)
. S ZN=ZN+1
+"RTN","C0CSOAP",193,0)
+ Q
+"RTN","C0CSOAP",194,0)
+ ;
"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)
+"RTN","C0CSOAP",196,0)
; IVARS IS AN XPATH ARRAY PASSED BY NAME
-"RTN","C0CSOAP",199,0)
+"RTN","C0CSOAP",197,0)
; TPTR IS A POINT TO THE C0C XML TEMPLATE FILE USED TO RETRIEVE THE TEMPLATE
-"RTN","C0CSOAP",200,0)
+"RTN","C0CSOAP",198,0)
;
-"RTN","C0CSOAP",201,0)
+"RTN","C0CSOAP",199,0)
N ZT ;THE TEMPLATE
-"RTN","C0CSOAP",202,0)
+"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)
- I '$D(INFARY) D ;
-"RTN","C0CSOAP",204,0)
- . S INFARY="FARY"
-"RTN","C0CSOAP",205,0)
. D INITFARY(INFARY)
-"RTN","C0CSOAP",206,0)
+"RTN","C0CSOAP",204,0)
N ZF,ZFT
-"RTN","C0CSOAP",207,0)
+"RTN","C0CSOAP",205,0)
S ZF=@INFARY@("XML FILE NUMBER")
-"RTN","C0CSOAP",208,0)
+"RTN","C0CSOAP",206,0)
S ZFT=@INFARY@("TEMPLATE XML")
-"RTN","C0CSOAP",209,0)
+"RTN","C0CSOAP",207,0)
I $$GET1^DIQ(ZF,TPTR_",",ZFT,,"ZT")'="ZT" D Q ; ERROR GETTING TEMPLATE
-"RTN","C0CSOAP",210,0)
+"RTN","C0CSOAP",208,0)
. W "ERROR RETRIEVING TEMPLATE",!
-"RTN","C0CSOAP",211,0)
+"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)
- Q
-"RTN","C0CSOAP",213,0)
- ;
-"RTN","C0CSOAP",214,0)
TESTBIND ;
-"RTN","C0CSOAP",215,0)
+"RTN","C0CSOAP",213,0)
S G1("TESTONE")=1
-"RTN","C0CSOAP",216,0)
+"RTN","C0CSOAP",214,0)
S G1("TESTTWO")=2
-"RTN","C0CSOAP",217,0)
+"RTN","C0CSOAP",215,0)
D BIND("G","G1","TEST")
-"RTN","C0CSOAP",218,0)
+"RTN","C0CSOAP",216,0)
W !
-"RTN","C0CSOAP",219,0)
+"RTN","C0CSOAP",217,0)
ZWR G
-"RTN","C0CSOAP",220,0)
+"RTN","C0CSOAP",218,0)
Q
-"RTN","C0CSOAP",221,0)
+"RTN","C0CSOAP",219,0)
;
-"RTN","C0CSOAP",222,0)
+"RTN","C0CSOAP",220,0)
BIND(RARY,IVARS,INTPTR,INFARY) ;RETURNS AN XPATH ARRAY IN RARY FOR USE WITH MAP
-"RTN","C0CSOAP",223,0)
+"RTN","C0CSOAP",221,0)
; TO BUILD AN INSTANTIATED TEMPLATE
-"RTN","C0CSOAP",224,0)
+"RTN","C0CSOAP",222,0)
; TPTR IS THE IEN OF THE XML TEMPATE IN THE C0C XML TEMPLATE FILE
-"RTN","C0CSOAP",225,0)
+"RTN","C0CSOAP",223,0)
; LOOPS THROUGHT THE BINDING SUBFILE TO PULL OUT XPATHS AND
-"RTN","C0CSOAP",226,0)
+"RTN","C0CSOAP",224,0)
; EITHER ASSIGNS VARIABLES OR DOES A FILEMAN CALL TO GET VALUES
-"RTN","C0CSOAP",227,0)
+"RTN","C0CSOAP",225,0)
; VARIABLES ARE IN IVARS WHICH IS PASSED BY NAME
-"RTN","C0CSOAP",228,0)
+"RTN","C0CSOAP",226,0)
I '$D(INFARY) D ;
-"RTN","C0CSOAP",229,0)
+"RTN","C0CSOAP",227,0)
. S INFARY="FARY"
-"RTN","C0CSOAP",230,0)
+"RTN","C0CSOAP",228,0)
. D INITFARY(INFARY) ;INITIALIZE FILE ARRAY IF NOT PASSED
-"RTN","C0CSOAP",231,0)
+"RTN","C0CSOAP",229,0)
I +INTPTR>0 S TPTR=INTPTR
-"RTN","C0CSOAP",232,0)
+"RTN","C0CSOAP",230,0)
E S TPTR=$$RESTID(INTPTR,INFARY)
-"RTN","C0CSOAP",233,0)
+"RTN","C0CSOAP",231,0)
N C0CFF,C0CBF,C0CXI,C0CFREF,C0CXREF
-"RTN","C0CSOAP",234,0)
+"RTN","C0CSOAP",232,0)
S C0CFF=@INFARY@("XML FILE NUMBER") ;fileman file number of XML file
-"RTN","C0CSOAP",235,0)
+"RTN","C0CSOAP",233,0)
S C0CFREF=$$FILEREF^C0CRNF(C0CFF) ; closed file reference to the file
-"RTN","C0CSOAP",236,0)
+"RTN","C0CSOAP",234,0)
S C0CBF=@INFARY@("BINDING SUBFILE NUMBER") ; BINDING SUBFILE NUMBER
-"RTN","C0CSOAP",237,0)
+"RTN","C0CSOAP",235,0)
S C0CXI=$G(@INFARY@("XPATH INDEX")) ; index to the XPath bindings
-"RTN","C0CSOAP",238,0)
+"RTN","C0CSOAP",236,0)
I C0CXI="" S C0CXI="XPATH" ; default is the XPATH index
-"RTN","C0CSOAP",239,0)
+"RTN","C0CSOAP",237,0)
; this needs to be a whole file index on the XPath subfile with
-"RTN","C0CSOAP",240,0)
+"RTN","C0CSOAP",238,0)
; the Template IEN perceding the XPath in the index
-"RTN","C0CSOAP",241,0)
+"RTN","C0CSOAP",239,0)
N ZI
-"RTN","C0CSOAP",242,0)
+"RTN","C0CSOAP",240,0)
S ZI=""
-"RTN","C0CSOAP",243,0)
+"RTN","C0CSOAP",241,0)
S C0CXREF=$NA(@C0CFREF@(C0CXI,TPTR)) ; where the xref is
-"RTN","C0CSOAP",244,0)
+"RTN","C0CSOAP",242,0)
;F S ZI=$O(^C0CX(TPTR,5,"B",ZI)) Q:ZI="" D ; FOR EACH XPATH
-"RTN","C0CSOAP",245,0)
+"RTN","C0CSOAP",243,0)
F S ZI=$O(@C0CXREF@(ZI)) Q:ZI="" D ; for each XPath in this template
-"RTN","C0CSOAP",246,0)
+"RTN","C0CSOAP",244,0)
. ;W !,ZI," ",$O(@C0CXREF@(ZI,TPTR,""))
-"RTN","C0CSOAP",247,0)
+"RTN","C0CSOAP",245,0)
. N ZIEN,ZFILE,ZFIELD,ZVAR,ZIDX,ZINDEX ;
-"RTN","C0CSOAP",248,0)
+"RTN","C0CSOAP",246,0)
. S ZIEN=$O(@C0CXREF@(ZI,TPTR,"")) ; IEN OF THE BINDING RECORD
-"RTN","C0CSOAP",249,0)
+"RTN","C0CSOAP",247,0)
. N ZFF S ZFF=@INFARY@("FILEMAN FILE POINTER")
-"RTN","C0CSOAP",250,0)
+"RTN","C0CSOAP",248,0)
. S ZFILE=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFF,"I")
-"RTN","C0CSOAP",251,0)
+"RTN","C0CSOAP",249,0)
. N ZFFLD S ZFFLD=@INFARY@("FILEMAN FIELD NUMBER")
-"RTN","C0CSOAP",252,0)
+"RTN","C0CSOAP",250,0)
. S ZFIELD=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFFLD,"I")
-"RTN","C0CSOAP",253,0)
+"RTN","C0CSOAP",251,0)
. N ZFV S ZFV=@INFARY@("VARIABLE NAME")
-"RTN","C0CSOAP",254,0)
+"RTN","C0CSOAP",252,0)
. S ZVAR=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFV,"E")
-"RTN","C0CSOAP",255,0)
+"RTN","C0CSOAP",253,0)
. N ZFX S ZFX=("INDEXED BY")
-"RTN","C0CSOAP",256,0)
+"RTN","C0CSOAP",254,0)
. S ZIDX=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFX,"I")
-"RTN","C0CSOAP",257,0)
+"RTN","C0CSOAP",255,0)
. S ZINDEX=""
-"RTN","C0CSOAP",258,0)
+"RTN","C0CSOAP",256,0)
. I ZIDX="DUZ" S ZINDEX=$G(DUZ) ; FILE IS INDEXED BY DUZ
-"RTN","C0CSOAP",259,0)
+"RTN","C0CSOAP",257,0)
. I ZIDX="DFN" S ZINDEX=$G(DFN) ; BY DFN
-"RTN","C0CSOAP",260,0)
+"RTN","C0CSOAP",258,0)
. E I ZIDX'="" S ZINDEX=$G(@ZIDX) ; index variable
-"RTN","C0CSOAP",261,0)
+"RTN","C0CSOAP",259,0)
. ;I ZIDX="ACCT" S ZINDEX=C0CACCT ; BY ACCOUNT RECORD POINT TO C0C WS ACCT
-"RTN","C0CSOAP",262,0)
+"RTN","C0CSOAP",260,0)
. ;I ZIDX="LOC" S ZINDEX=C0CLOC ; BY LOCATION
-"RTN","C0CSOAP",263,0)
+"RTN","C0CSOAP",261,0)
. I ZVAR'="" D ; VARIABLES TAKE PRESCIDENCE OVER FILEMAN FIELDS
-"RTN","C0CSOAP",264,0)
+"RTN","C0CSOAP",262,0)
. . S @RARY@(ZI)=@IVARS@(ZVAR) ;
-"RTN","C0CSOAP",265,0)
+"RTN","C0CSOAP",263,0)
. E D ; IF NO VARIABLE, TRY ACCESSING FROM FILEMAN
-"RTN","C0CSOAP",266,0)
+"RTN","C0CSOAP",264,0)
. . I (ZFILE="")!(ZFIELD="") Q ;QUIT IF FILE OR FIELD NOT THERE
-"RTN","C0CSOAP",267,0)
+"RTN","C0CSOAP",265,0)
. . D CLEAN^DILF
-"RTN","C0CSOAP",268,0)
+"RTN","C0CSOAP",266,0)
. . S @RARY@(ZI)=$$GET1^DIQ(ZFILE,ZINDEX_",",ZFIELD) ;GET THE VALUE
-"RTN","C0CSOAP",269,0)
+"RTN","C0CSOAP",267,0)
. . I $D(^TMP("DIERR",$J,1)) D B ;
-"RTN","C0CSOAP",270,0)
+"RTN","C0CSOAP",268,0)
. . . W "ERROR!",!
-"RTN","C0CSOAP",271,0)
+"RTN","C0CSOAP",269,0)
. . . ZWR ^TMP("DIERR",$J,*)
-"RTN","C0CSOAP",272,0)
+"RTN","C0CSOAP",270,0)
Q
-"RTN","C0CSOAP",273,0)
+"RTN","C0CSOAP",271,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)
-EN ;Traverse the DPT global and export CCR xml for each DFN
-"RTN","C0CSQMB",5,0)
- ;and write to directory set in ^TMP("C0CCCR","ODIR")=
-"RTN","C0CSQMB",6,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)
- I '$D(DUZ) Q
+ ; published by the Free Software Foundation, either version 3 of the
"RTN","C0CSQMB",8,0)
- S U="^",DT=$$DT^XLFDT
+ ; License, or (at your option) any later version.
"RTN","C0CSQMB",9,0)
- D DUZ^XUP(DUZ)
+ ;
"RTN","C0CSQMB",10,0)
- ; Get the output directory and filename prefix from env
+ ; This program is distributed in the hope that it will be useful,
"RTN","C0CSQMB",11,0)
- S ^TMP("C0CCCR","ODIR")=$ZTRNLNM("ccrodir")
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0CSQMB",12,0)
- S ^TMP("C0CCCR","OFNP")=$ZTRNLNM("ccrofnprefix")
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
"RTN","C0CSQMB",13,0)
- N ZDFN
+ ; GNU Affero General Public License for more details.
"RTN","C0CSQMB",14,0)
- ;F ZDFN=0:0 S ZDFN=$O(^DPT(ZDFN)) Q:'ZDFN!((ZDFN="+1,")!(ZDFN>10)) D
+ ;
"RTN","C0CSQMB",15,0)
- F ZDFN=0:0 S ZDFN=$O(^DPT(ZDFN)) Q:'ZDFN!(ZDFN="+1,") D
+ ; You should have received a copy of the GNU Affero General Public License
"RTN","C0CSQMB",16,0)
- . ;I ZDFN<350 S ZDFN=349
+ ; along with this program. If not, see .
"RTN","C0CSQMB",17,0)
- . D XPAT^C0CCCR(ZDFN)
+ ;
"RTN","C0CSQMB",18,0)
- Q
+EN ;Traverse the DPT global and export CCR xml for each DFN
"RTN","C0CSQMB",19,0)
+ ;and write to directory set in ^TMP("C0CCCR","ODIR")=
+"RTN","C0CSQMB",20,0)
+ ;
+"RTN","C0CSQMB",21,0)
+ I '$D(DUZ) Q
+"RTN","C0CSQMB",22,0)
+ S U="^",DT=$$DT^XLFDT
+"RTN","C0CSQMB",23,0)
+ D DUZ^XUP(DUZ)
+"RTN","C0CSQMB",24,0)
+ ; Get the output directory and filename prefix from env
+"RTN","C0CSQMB",25,0)
+ S ^TMP("C0CCCR","ODIR")=$ZTRNLNM("ccrodir")
+"RTN","C0CSQMB",26,0)
+ S ^TMP("C0CCCR","OFNP")=$ZTRNLNM("ccrofnprefix")
+"RTN","C0CSQMB",27,0)
+ N ZDFN
+"RTN","C0CSQMB",28,0)
+ ;F ZDFN=0:0 S ZDFN=$O(^DPT(ZDFN)) Q:'ZDFN!((ZDFN="+1,")!(ZDFN>10)) D
+"RTN","C0CSQMB",29,0)
+ F ZDFN=0:0 S ZDFN=$O(^DPT(ZDFN)) Q:'ZDFN!(ZDFN="+1,") D
+"RTN","C0CSQMB",30,0)
+ . ;I ZDFN<350 S ZDFN=349
+"RTN","C0CSQMB",31,0)
+ . D XPAT^C0CCCR(ZDFN)
+"RTN","C0CSQMB",32,0)
+ Q
+"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 .
"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.
-"RTN","C0CSUB1",19,0)
;
-"RTN","C0CSUB1",20,0)
+"RTN","C0CSUB1",18,0)
W "This is the CCR SUBSCRIPTIONN Utility Library ",!
-"RTN","C0CSUB1",21,0)
+"RTN","C0CSUB1",19,0)
Q
+"RTN","C0CSUB1",20,0)
+ ;
+"RTN","C0CSUB1",21,0)
+CHK1(DFN) ; ADD THE CHECKSUM FOR ONE PATIENT
"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",24,0)
S C0CSF=177.101 ; FILE NUMBER FOR SUBSCRIPTION FILE
-"RTN","C0CSUB1",27,0)
+"RTN","C0CSUB1",25,0)
S C0CSFS=177.1011 ; FILE NUMBER FOR SUBSCRIPTION SUBFILE
-"RTN","C0CSUB1",28,0)
+"RTN","C0CSUB1",26,0)
S C0CSFC=177.1012 ; FILE NUMBER FOR CHECKSUM SUBFILE
-"RTN","C0CSUB1",29,0)
+"RTN","C0CSUB1",27,0)
S C0CSFDC=177.10121 ; FILE NUMBER FOR DOMAIN CHECKSUMS
-"RTN","C0CSUB1",30,0)
+"RTN","C0CSUB1",28,0)
S C0CPAT=$O(^C0CS("B",DFN,"")) ; IEN OF PAT
-"RTN","C0CSUB1",31,0)
- K C0CFDA
-"RTN","C0CSUB1",32,0)
+"RTN","C0CSUB1",29,0)
+ K C0CFDA
+"RTN","C0CSUB1",30,0)
S C0CALL=$G(@C0CCHK@(DFN,"ALL"))
-"RTN","C0CSUB1",33,0)
+"RTN","C0CSUB1",31,0)
I C0CALL'="" S C0CFDA(C0CSFC,"?+1,"_C0CPAT_",",.01)=C0CALL
-"RTN","C0CSUB1",34,0)
- E Q ; NO CHECKSUMS FOR THISPATIENT
-"RTN","C0CSUB1",35,0)
+"RTN","C0CSUB1",32,0)
+ E Q ; NO CHECKSUMS FOR THISPATIENT
+"RTN","C0CSUB1",33,0)
D UPDIE
-"RTN","C0CSUB1",36,0)
+"RTN","C0CSUB1",34,0)
N C0CJ S C0CJ=""
-"RTN","C0CSUB1",37,0)
+"RTN","C0CSUB1",35,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)
+"RTN","C0CSUB1",36,0)
+ . S C0CD=$O(^C0CDIC(170.101,"B",C0CJ,""))
+"RTN","C0CSUB1",37,0)
. W C0CJ," ",C0CD,!
-"RTN","C0CSUB1",40,0)
+"RTN","C0CSUB1",38,0)
. S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",.01)=C0CD
-"RTN","C0CSUB1",41,0)
+"RTN","C0CSUB1",39,0)
. S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",1)=@C0CCHK@(DFN,"DOMAIN",C0CJ)
-"RTN","C0CSUB1",42,0)
+"RTN","C0CSUB1",40,0)
. D UPDIE
-"RTN","C0CSUB1",43,0)
+"RTN","C0CSUB1",41,0)
Q
+"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)
-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)
+"RTN","C0CSUB1",46,0)
S C0CI=""
-"RTN","C0CSUB1",49,0)
+"RTN","C0CSUB1",47,0)
F S C0CI=$O(@C0CGLB@(C0CI)) Q:C0CI="" D ; FOR EACH PATIENT
-"RTN","C0CSUB1",50,0)
+"RTN","C0CSUB1",48,0)
. D SUB1(C0CI,1) ;SUBSCIRBE THEM TO EPCRN
-"RTN","C0CSUB1",51,0)
+"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)
-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)
+"RTN","C0CSUB1",54,0)
S C0CSFS=177.1011 ; FILE NUMBER FOR SUBSCRIPTION SUBFILE
-"RTN","C0CSUB1",57,0)
+"RTN","C0CSUB1",55,0)
S C0CSFC=177.10121 ; FILE NUMBER FOR CHECKSUMS
-"RTN","C0CSUB1",58,0)
+"RTN","C0CSUB1",56,0)
S C0CSSF=177.201 ; FILE NUMBER FOR SUBSCRIBER FILE
-"RTN","C0CSUB1",59,0)
+"RTN","C0CSUB1",57,0)
K C0CFDA
-"RTN","C0CSUB1",60,0)
+"RTN","C0CSUB1",58,0)
S C0CFDA(C0CSF,"+1,",.01)=DFN
-"RTN","C0CSUB1",61,0)
+"RTN","C0CSUB1",59,0)
D UPDIE ; ADD THE PATIENT
-"RTN","C0CSUB1",62,0)
+"RTN","C0CSUB1",60,0)
S C0CPAT=$O(^C0CS("B",DFN,"")) ; IEN OF PAT
-"RTN","C0CSUB1",63,0)
+"RTN","C0CSUB1",61,0)
S C0CFDA(C0CSFS,"+1,"_C0CPAT_",",.01)=C0CSS ; C0CSS IS A POINTER
-"RTN","C0CSUB1",64,0)
+"RTN","C0CSUB1",62,0)
D UPDIE ; ADD THE SUBSCRIPTION
-"RTN","C0CSUB1",65,0)
+"RTN","C0CSUB1",63,0)
D CHK1(DFN) ; ADD THE CHECKSUMS
+"RTN","C0CSUB1",64,0)
+ Q
+"RTN","C0CSUB1",65,0)
+ ;
"RTN","C0CSUB1",66,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)
+"RTN","C0CSUB1",67,0)
K ZERR
-"RTN","C0CSUB1",70,0)
+"RTN","C0CSUB1",68,0)
D CLEAN^DILF
-"RTN","C0CSUB1",71,0)
+"RTN","C0CSUB1",69,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)
+"RTN","C0CSUB1",70,0)
+ I $D(ZERR) S $EC=",U1,"
+"RTN","C0CSUB1",71,0)
K C0CFDA
-"RTN","C0CSUB1",77,0)
+"RTN","C0CSUB1",72,0)
Q
-"RTN","C0CSUB1",78,0)
+"RTN","C0CSUB1",73,0)
;
-"RTN","C0CSUB1",79,0)
+"RTN","C0CSUB1",74,0)
VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
-"RTN","C0CSUB1",80,0)
+"RTN","C0CSUB1",75,0)
; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
-"RTN","C0CSUB1",81,0)
+"RTN","C0CSUB1",76,0)
; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
-"RTN","C0CSUB1",82,0)
+"RTN","C0CSUB1",77,0)
;
-"RTN","C0CSUB1",83,0)
+"RTN","C0CSUB1",78,0)
N ZCCRD,ZVARN,C0CFDA2
-"RTN","C0CSUB1",84,0)
+"RTN","C0CSUB1",79,0)
S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
-"RTN","C0CSUB1",85,0)
+"RTN","C0CSUB1",80,0)
S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
-"RTN","C0CSUB1",86,0)
+"RTN","C0CSUB1",81,0)
I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
-"RTN","C0CSUB1",87,0)
+"RTN","C0CSUB1",82,0)
. I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE
-"RTN","C0CSUB1",88,0)
+"RTN","C0CSUB1",83,0)
. . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
-"RTN","C0CSUB1",89,0)
+"RTN","C0CSUB1",84,0)
. S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
-"RTN","C0CSUB1",90,0)
+"RTN","C0CSUB1",85,0)
. S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
-"RTN","C0CSUB1",91,0)
+"RTN","C0CSUB1",86,0)
. D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
-"RTN","C0CSUB1",92,0)
+"RTN","C0CSUB1",87,0)
. D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
-"RTN","C0CSUB1",93,0)
+"RTN","C0CSUB1",88,0)
. I $D(ZERR) D ; LAYGO ERROR
-"RTN","C0CSUB1",94,0)
+"RTN","C0CSUB1",89,0)
. . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
-"RTN","C0CSUB1",95,0)
+"RTN","C0CSUB1",90,0)
. E D ;
-"RTN","C0CSUB1",96,0)
+"RTN","C0CSUB1",91,0)
. . D CLEAN^DILF ; CLEAN UP
-"RTN","C0CSUB1",97,0)
+"RTN","C0CSUB1",92,0)
. . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
-"RTN","C0CSUB1",98,0)
+"RTN","C0CSUB1",93,0)
. . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
-"RTN","C0CSUB1",99,0)
+"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)
-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
-"RTN","C0CSUB1",107,0)
+"RTN","C0CSUB1",102,0)
S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
-"RTN","C0CSUB1",108,0)
+"RTN","C0CSUB1",103,0)
S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
-"RTN","C0CSUB1",109,0)
+"RTN","C0CSUB1",104,0)
S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
-"RTN","C0CSUB1",110,0)
+"RTN","C0CSUB1",105,0)
Q
-"RTN","C0CSUB1",111,0)
+"RTN","C0CSUB1",106,0)
ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
-"RTN","C0CSUB1",112,0)
+"RTN","C0CSUB1",107,0)
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
-"RTN","C0CSUB1",113,0)
+"RTN","C0CSUB1",108,0)
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CSUB1",114,0)
+"RTN","C0CSUB1",109,0)
I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CSUB1",115,0)
+"RTN","C0CSUB1",110,0)
N ZR
-"RTN","C0CSUB1",116,0)
+"RTN","C0CSUB1",111,0)
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
-"RTN","C0CSUB1",117,0)
+"RTN","C0CSUB1",112,0)
E S ZR=""
-"RTN","C0CSUB1",118,0)
+"RTN","C0CSUB1",113,0)
Q ZR
-"RTN","C0CSUB1",119,0)
+"RTN","C0CSUB1",114,0)
ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
-"RTN","C0CSUB1",120,0)
+"RTN","C0CSUB1",115,0)
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
-"RTN","C0CSUB1",121,0)
+"RTN","C0CSUB1",116,0)
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CSUB1",122,0)
+"RTN","C0CSUB1",117,0)
I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CSUB1",123,0)
+"RTN","C0CSUB1",118,0)
N ZR
-"RTN","C0CSUB1",124,0)
+"RTN","C0CSUB1",119,0)
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
-"RTN","C0CSUB1",125,0)
+"RTN","C0CSUB1",120,0)
E S ZR=""
-"RTN","C0CSUB1",126,0)
+"RTN","C0CSUB1",121,0)
Q ZR
-"RTN","C0CSUB1",127,0)
+"RTN","C0CSUB1",122,0)
;
-"RTN","C0CSUB1",128,0)
+"RTN","C0CSUB1",123,0)
ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
-"RTN","C0CSUB1",129,0)
+"RTN","C0CSUB1",124,0)
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
-"RTN","C0CSUB1",130,0)
+"RTN","C0CSUB1",125,0)
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
-"RTN","C0CSUB1",131,0)
+"RTN","C0CSUB1",126,0)
I '$D(ZTAB) S ZTAB="C0CA"
-"RTN","C0CSUB1",132,0)
+"RTN","C0CSUB1",127,0)
N ZR
-"RTN","C0CSUB1",133,0)
+"RTN","C0CSUB1",128,0)
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
-"RTN","C0CSUB1",134,0)
+"RTN","C0CSUB1",129,0)
E S ZR=""
-"RTN","C0CSUB1",135,0)
+"RTN","C0CSUB1",130,0)
Q ZR
-"RTN","C0CSUB1",136,0)
+"RTN","C0CSUB1",131,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)
- ;
-"RTN","C0CSYS",11,0)
; This program is distributed in the hope that it will be useful,
-"RTN","C0CSYS",12,0)
+"RTN","C0CSYS",11,0)
; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","C0CSYS",13,0)
+"RTN","C0CSYS",12,0)
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+"RTN","C0CSYS",13,0)
+ ; 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 .
"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
-"RTN","C0CSYS",21,0)
- ;
-"RTN","C0CSYS",22,0)
; Originally, I was going to use VEPERVER, but VEPERVER
-"RTN","C0CSYS",23,0)
+"RTN","C0CSYS",21,0)
; actually kills ^TMP($J), outputs it to the screen in a user-friendly
-"RTN","C0CSYS",24,0)
+"RTN","C0CSYS",22,0)
; manner (press any key to continue),
-"RTN","C0CSYS",25,0)
+"RTN","C0CSYS",23,0)
; and is really a very half finished routine
+"RTN","C0CSYS",24,0)
+ ;
+"RTN","C0CSYS",25,0)
+ ; 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.
-"RTN","C0CSYS",28,0)
- ;
-"RTN","C0CSYS",29,0)
SYSNAME() ;Get EHR System Name; PUBLIC; Extrinsic
-"RTN","C0CSYS",30,0)
+"RTN","C0CSYS",28,0)
Q:$G(DUZ("AG"))="I" "RPMS"
-"RTN","C0CSYS",31,0)
+"RTN","C0CSYS",29,0)
Q "WorldVistA EHR/VOE"
-"RTN","C0CSYS",32,0)
+"RTN","C0CSYS",30,0)
;
-"RTN","C0CSYS",33,0)
+"RTN","C0CSYS",31,0)
SYSVER() ;Get EHR System Version; PUBLIC; Extrinsic
-"RTN","C0CSYS",34,0)
+"RTN","C0CSYS",32,0)
Q "1.0"
-"RTN","C0CSYS",35,0)
+"RTN","C0CSYS",33,0)
;
-"RTN","C0CSYS",36,0)
+"RTN","C0CSYS",34,0)
PTST(DFN) ;TEST TO SEE IF PATIENT MERGED OR A TEST PATIENT
-"RTN","C0CSYS",37,0)
+"RTN","C0CSYS",35,0)
; DFN = IEN of the Patient to be tested
-"RTN","C0CSYS",38,0)
+"RTN","C0CSYS",36,0)
; 1 = Merged or Test Patient
+"RTN","C0CSYS",37,0)
+ ; 0 = Non-test Patient
+"RTN","C0CSYS",38,0)
+ ;
"RTN","C0CSYS",39,0)
- ; 0 = Non-test Patient
-"RTN","C0CSYS",40,0)
- ;
-"RTN","C0CSYS",41,0)
I DFN="" Q 0 ; BAD DFN PASSED
-"RTN","C0CSYS",42,0)
+"RTN","C0CSYS",40,0)
I $D(^DPT(DFN,-9)) Q 1 ;This patient has been merged
-"RTN","C0CSYS",43,0)
+"RTN","C0CSYS",41,0)
I $G(^DPT(DFN,0))="" Q 1 ;Missing zeroth node <---add
-"RTN","C0CSYS",44,0)
+"RTN","C0CSYS",42,0)
;
-"RTN","C0CSYS",45,0)
+"RTN","C0CSYS",43,0)
I '$D(CCRTEST) S CCRTEST=1 ; DEFAULT IS THAT WE ARE TESTING
-"RTN","C0CSYS",46,0)
+"RTN","C0CSYS",44,0)
I CCRTEST Q 0 ; IF WE ARE TESTING, DON'T REJECT TEST PATIENTS
-"RTN","C0CSYS",47,0)
+"RTN","C0CSYS",45,0)
N DIERR,DATA
-"RTN","C0CSYS",48,0)
+"RTN","C0CSYS",46,0)
I $$TESTPAT^VADPT(DFN) Q 1 ; QUIT IF IT'S A VA TEST PATIENT
-"RTN","C0CSYS",49,0)
+"RTN","C0CSYS",47,0)
S DATA=+$$GET1^DIQ(2,DFN_",",.6,"I") ;Test Patient Indicator
-"RTN","C0CSYS",50,0)
+"RTN","C0CSYS",48,0)
; 1 = Test Patient
-"RTN","C0CSYS",51,0)
+"RTN","C0CSYS",49,0)
; 0 = Non-test Patient
-"RTN","C0CSYS",52,0)
+"RTN","C0CSYS",50,0)
I DATA Q DATA
-"RTN","C0CSYS",53,0)
+"RTN","C0CSYS",51,0)
S DATA=$$GET1^DIQ(2,DFN_",",.09,"I") ;SSN test
-"RTN","C0CSYS",54,0)
+"RTN","C0CSYS",52,0)
D CLEAN^DILF
-"RTN","C0CSYS",55,0)
+"RTN","C0CSYS",53,0)
I "Pp"[$E(DATA,$L(DATA),$L(DATA)) Q 0 ;Allow Pseudo SSN
-"RTN","C0CSYS",56,0)
+"RTN","C0CSYS",54,0)
I $E(DATA,1,3)="000" Q 1
-"RTN","C0CSYS",57,0)
+"RTN","C0CSYS",55,0)
I $E(DATA,1,3)="666" Q 1
-"RTN","C0CSYS",58,0)
+"RTN","C0CSYS",56,0)
Q 0
-"RTN","C0CSYS",59,0)
+"RTN","C0CSYS",57,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)
- ;ELN - Modified Routine of C0CLABS
+ ; This program is free software: you can redistribute it and/or modify
"RTN","C0CTIU",6,0)
-MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
+ ; it under the terms of the GNU Affero General Public License as
"RTN","C0CTIU",7,0)
- ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
+ ; published by the Free Software Foundation, either version 3 of the
"RTN","C0CTIU",8,0)
- ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
+ ; License, or (at your option) any later version.
"RTN","C0CTIU",9,0)
- ; MIXML IS THE TEMPLATE TO USE
+ ;
"RTN","C0CTIU",10,0)
- ; MOXML IS THE OUTPUT XML ARRAY
+ ; This program is distributed in the hope that it will be useful,
"RTN","C0CTIU",11,0)
- ; DFN IS THE PATIENT RECORD NUMBER
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0CTIU",12,0)
- N C0COXML,C0CO,C0CV,C0CIXML
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
"RTN","C0CTIU",13,0)
- I '$D(MIVAR) S C0CV="" ;DEFAULT
+ ; GNU Affero General Public License for more details.
"RTN","C0CTIU",14,0)
- E S C0CV=MIVAR ;PASSED VARIABLE ARRAY
+ ;
"RTN","C0CTIU",15,0)
- I '$D(MIXML) S C0CIXML="" ;DEFAULT
+ ; You should have received a copy of the GNU Affero General Public License
"RTN","C0CTIU",16,0)
- E S C0CIXML=MIXML ;PASSED INPUT XML
+ ; along with this program. If not, see .
"RTN","C0CTIU",17,0)
- D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
+ ;
"RTN","C0CTIU",18,0)
- I '$D(MOXML) D Q
+ ;ELN - Modified Routine of C0CLABS
"RTN","C0CTIU",19,0)
- . S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
+MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
"RTN","C0CTIU",20,0)
- . M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
+ ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
"RTN","C0CTIU",21,0)
- E D
+ ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
"RTN","C0CTIU",22,0)
- . N C0COOXML
+ ; MIXML IS THE TEMPLATE TO USE
"RTN","C0CTIU",23,0)
- . S CCRGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR"))
+ ; MOXML IS THE OUTPUT XML ARRAY
"RTN","C0CTIU",24,0)
- . D QUERY^C0CXPATH(CCRGLO,"//ContinuityOfCareRecord/Body/Results","C0CRSXML")
+ ; DFN IS THE PATIENT RECORD NUMBER
"RTN","C0CTIU",25,0)
- . S C0COCNT=$O(C0CRSXML(""),-1)
+ N C0COXML,C0CO,C0CV,C0CIXML
"RTN","C0CTIU",26,0)
- . S C0CRES=0
+ I '$D(MIVAR) S C0CV="" ;DEFAULT
"RTN","C0CTIU",27,0)
- . F S C0CRES=$O(C0COXML(C0CRES)) Q:C0CRES="" D
+ E S C0CV=MIVAR ;PASSED VARIABLE ARRAY
"RTN","C0CTIU",28,0)
- . . Q:$G(C0COXML(C0CRES))=""!($G(C0COXML(C0CRES))="")
+ I '$D(MIXML) S C0CIXML="" ;DEFAULT
"RTN","C0CTIU",29,0)
- . . S C0CRSXML(C0COCNT)=$G(C0COXML(C0CRES))
+ E S C0CIXML=MIXML ;PASSED INPUT XML
"RTN","C0CTIU",30,0)
- . . S C0COCNT=C0COCNT+1
+ D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
"RTN","C0CTIU",31,0)
- . S C0CRSXML(C0COCNT)=""
+ I '$D(MOXML) D Q
"RTN","C0CTIU",32,0)
- . S C0CRSXML(0)=C0COCNT
+ . S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
"RTN","C0CTIU",33,0)
- . D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
+ . M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
"RTN","C0CTIU",34,0)
- . D INSERT^C0CXPATH(CCRGLO,"C0CRSXML","//ContinuityOfCareRecord/Body")
+ E D
"RTN","C0CTIU",35,0)
- ;
+ . N C0COOXML
"RTN","C0CTIU",36,0)
- S C0CO=MOXML,@C0CO@(0)=0
+ . S CCRGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR"))
"RTN","C0CTIU",37,0)
- K C0CRSXML,C0COCNT,C0COXML,C0CRES
+ . D QUERY^C0CXPATH(CCRGLO,"//ContinuityOfCareRecord/Body/Results","C0CRSXML")
"RTN","C0CTIU",38,0)
- K C0CCNT
+ . S C0COCNT=$O(C0CRSXML(""),-1)
"RTN","C0CTIU",39,0)
- Q
+ . S C0CRES=0
"RTN","C0CTIU",40,0)
-RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS
+ . F S C0CRES=$O(C0COXML(C0CRES)) Q:C0CRES="" D
"RTN","C0CTIU",41,0)
- ; RTN IS PASSED BY REFERENCE
+ . . Q:$G(C0COXML(C0CRES))=""!($G(C0COXML(C0CRES))="")
"RTN","C0CTIU",42,0)
- N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
+ . . S C0CRSXML(C0COCNT)=$G(C0COXML(C0CRES))
"RTN","C0CTIU",43,0)
- N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
+ . . S C0COCNT=C0COCNT+1
"RTN","C0CTIU",44,0)
- I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
+ . S C0CRSXML(C0COCNT)=""
"RTN","C0CTIU",45,0)
- I RMIXML="" D ; INPUT XML NOT PASSED
+ . S C0CRSXML(0)=C0COCNT
"RTN","C0CTIU",46,0)
- . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
+ . D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
"RTN","C0CTIU",47,0)
- . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
+ . D INSERT^C0CXPATH(CCRGLO,"C0CRSXML","//ContinuityOfCareRecord/Body")
"RTN","C0CTIU",48,0)
- . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
+ ;
"RTN","C0CTIU",49,0)
- E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
+ S C0CO=MOXML,@C0CO@(0)=0
"RTN","C0CTIU",50,0)
- I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED
+ K C0CRSXML,C0COCNT,C0COXML,C0CRES
"RTN","C0CTIU",51,0)
- . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
+ K C0CCNT
"RTN","C0CTIU",52,0)
- E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
+ Q
"RTN","C0CTIU",53,0)
- D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
+RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS
"RTN","C0CTIU",54,0)
- D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
+ ; RTN IS PASSED BY REFERENCE
"RTN","C0CTIU",55,0)
- D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
+ N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
"RTN","C0CTIU",56,0)
- D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT
+ N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
"RTN","C0CTIU",57,0)
- I '$D(@C0CV@(0)) D Q ; NO VARS THERE
+ I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
"RTN","C0CTIU",58,0)
- . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
+ I RMIXML="" D ; INPUT XML NOT PASSED
"RTN","C0CTIU",59,0)
- ; NO RESULTS QUIT
+ . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
"RTN","C0CTIU",60,0)
- I @C0CV@(0)=0 S RTN(0)=0 Q
+ . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
"RTN","C0CTIU",61,0)
- S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
+ . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
"RTN","C0CTIU",62,0)
- K @RIMVARS
+ E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
"RTN","C0CTIU",63,0)
- M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
+ I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED
"RTN","C0CTIU",64,0)
- N C0CI,C0CIN,C0CJ,C0CJS,C0CJE,C0CJN,C0CMAP,C0CTMAP,C0CTMP
+ . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
"RTN","C0CTIU",65,0)
- S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
+ E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
"RTN","C0CTIU",66,0)
- N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
+ D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
"RTN","C0CTIU",67,0)
- N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
+ D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
"RTN","C0CTIU",68,0)
- N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
+ D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
"RTN","C0CTIU",69,0)
- ; TO IMPROVE PERFORMANCE
+ D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT
"RTN","C0CTIU",70,0)
- D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;
+ I '$D(@C0CV@(0)) D Q ; NO VARS THERE
"RTN","C0CTIU",71,0)
- F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES
+ . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
"RTN","C0CTIU",72,0)
- . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
+ ; NO RESULTS QUIT
"RTN","C0CTIU",73,0)
- . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
+ I @C0CV@(0)=0 S RTN(0)=0 Q
"RTN","C0CTIU",74,0)
- . S C0CMAP=$NA(@C0CV@(C0CI)) ;
+ S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
"RTN","C0CTIU",75,0)
- . ;MAPPING FOR TEST REQUEST GOES HERE
+ K @RIMVARS
"RTN","C0CTIU",76,0)
- . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
+ M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
"RTN","C0CTIU",77,0)
- . ;D QOPEN^C0CXPATH("C0CRBLD",C0CRTMP,C0CIS) ;1ST PART OF XML
+ N C0CI,C0CIN,C0CJ,C0CJS,C0CJE,C0CJN,C0CMAP,C0CTMAP,C0CTMP
"RTN","C0CTIU",78,0)
- . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO
+ S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
"RTN","C0CTIU",79,0)
- . I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST
+ N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
"RTN","C0CTIU",80,0)
- . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
+ N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
"RTN","C0CTIU",81,0)
- . . K C0CTO ; CLEAR OUTPUT VARIABLE
+ N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
"RTN","C0CTIU",82,0)
- . . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT
+ ; TO IMPROVE PERFORMANCE
"RTN","C0CTIU",83,0)
- . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
+ D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;
"RTN","C0CTIU",84,0)
- . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
+ F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES
"RTN","C0CTIU",85,0)
- . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
+ . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
"RTN","C0CTIU",86,0)
- . . . D XMAP^C0CTIU1("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
+ . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
"RTN","C0CTIU",87,0)
- . . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE
+ . S C0CMAP=$NA(@C0CV@(C0CI)) ;
"RTN","C0CTIU",88,0)
- . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;
+ . ;MAPPING FOR TEST REQUEST GOES HERE
"RTN","C0CTIU",89,0)
- . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
+ . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
"RTN","C0CTIU",90,0)
- . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
+ . ;D QOPEN^C0CXPATH("C0CRBLD",C0CRTMP,C0CIS) ;1ST PART OF XML
"RTN","C0CTIU",91,0)
- . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;
+ . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO
"RTN","C0CTIU",92,0)
- D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;
+ . I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST
"RTN","C0CTIU",93,0)
- D BUILD^C0CTIU1("C0CRBLD","RTN") ;RENDER THE XML
+ . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
"RTN","C0CTIU",94,0)
- K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
+ . . K C0CTO ; CLEAR OUTPUT VARIABLE
"RTN","C0CTIU",95,0)
- Q
+ . . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT
"RTN","C0CTIU",96,0)
- ;
+ . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
"RTN","C0CTIU",97,0)
- ;
+ . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
"RTN","C0CTIU",98,0)
-EXTRACT(ILXML,DFN,OLXML) ; EXTRACT TIU NOTES INTO THE C0CLVAR GLOBAL
+ . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
"RTN","C0CTIU",99,0)
- ;
+ . . . D XMAP^C0CTIU1("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
"RTN","C0CTIU",100,0)
- S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
+ . . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE
"RTN","C0CTIU",101,0)
- D DT^DILF(,$$GET^C0CPARMS("TIULIMIT"),.C0CTSDT)
+ . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;
"RTN","C0CTIU",102,0)
- D DT^DILF(,$$GET^C0CPARMS("TIUSTART"),.C0CTEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
+ . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
"RTN","C0CTIU",103,0)
- ;
+ . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
"RTN","C0CTIU",104,0)
- S TIUIEN=0,TIUCNT=1
+ . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;
"RTN","C0CTIU",105,0)
- F S TIUIEN=$O(^TIU(8925,"C",DFN,TIUIEN)) Q:TIUIEN="" D
+ D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;
"RTN","C0CTIU",106,0)
- . S TIUY="",TIUDA=TIUIEN,ACTION="VIEW",U="^"
+ D BUILD^C0CTIU1("C0CRBLD","RTN") ;RENDER THE XML
"RTN","C0CTIU",107,0)
- . ;SELECT ONLY COMPLETED NOTES
+ K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
"RTN","C0CTIU",108,0)
- . Q:$P(^TIU(8925,TIUIEN,0),U,5)=""
+ Q
"RTN","C0CTIU",109,0)
- . Q:$P(^TIU(8925.6,$P(^TIU(8925,TIUIEN,0),U,5),0),U)'="COMPLETED"
-"RTN","C0CTIU",110,0)
- . ;VALIDATE ON SIGNATURE DATE #1501
-"RTN","C0CTIU",111,0)
- . Q:$P(^TIU(8925,TIUIEN,15),U)C0CTEDT)
-"RTN","C0CTIU",112,0)
- . D TGET(TIUY,TIUIEN,ACTION,TIUCNT)
-"RTN","C0CTIU",113,0)
- . S TIUCNT=TIUCNT+1
-"RTN","C0CTIU",114,0)
- ;ELN K @C0CLB ; CLEAR OUT OLD VARS IF ANY
-"RTN","C0CTIU",115,0)
- N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG
-"RTN","C0CTIU",116,0)
- S C0CQT=1 ; SURPRESS LISTING
-"RTN","C0CTIU",117,0)
- D LIST ; EXTRACT THE VARIABLES
-"RTN","C0CTIU",118,0)
- K ^TMP("C0CTIU",$J),TIUIEN,TIUCNT,TIUDA,TIUY,C0CLB,C0CTSDT,C0CTEDT
-"RTN","C0CTIU",119,0)
- S C0CQT=QTSAV ; RESET SILENT FLAG
-"RTN","C0CTIU",120,0)
- I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
-"RTN","C0CTIU",121,0)
- Q
-"RTN","C0CTIU",122,0)
- ;REUSING from ^TIUSRVR2
-"RTN","C0CTIU",123,0)
-TGET(TIUY,TIUDA,ACTION,TIUCNT) ; Build ^TMP("TIUVIEW",$J,
-"RTN","C0CTIU",124,0)
- N TIUL,TIUREC,TIUARR,TIUGDATA,TIUNAME,TIUPRM0,TIUPRM1,X,Y,TIUCPF,ONBROWSE
-"RTN","C0CTIU",125,0)
- K ^TMP("TIUVIEW",$J),^TMP("TIU FOCUS",$J)
-"RTN","C0CTIU",126,0)
- S C0CTIU=$NA(^TMP("C0CTIU",$J,TIUCNT))
-"RTN","C0CTIU",127,0)
- S ACTION=$G(ACTION,"VIEW"),TIUL=0
-"RTN","C0CTIU",128,0)
- D SETPARM^TIULE
-"RTN","C0CTIU",129,0)
- S TIUGDATA=$$SETGDATA^TIUSRVR1(TIUDA)
-"RTN","C0CTIU",130,0)
- S TIUY=$NA(^TMP("TIUVIEW",$J))
-"RTN","C0CTIU",131,0)
- S TIUARR="^TMP(""TIUVIEW"",$J)"
-"RTN","C0CTIU",132,0)
- I '$D(^TIU(8925,+TIUDA,0)) Q
-"RTN","C0CTIU",133,0)
- ; Initialize ^TMP("TIU FOCUS",$J) to the entry that has focus
-"RTN","C0CTIU",134,0)
- S ^TMP("TIU FOCUS",$J)=TIUDA
-"RTN","C0CTIU",135,0)
- ; Call INQUIRE to get record
-"RTN","C0CTIU",136,0)
- ;Set a flag to indicate whether or not a Title is a memer of the
-"RTN","C0CTIU",137,0)
- ;Clinical Procedures Class (1=Yes and 0=No)
-"RTN","C0CTIU",138,0)
- S TIUCPF=+$$ISA^TIULX(+$G(^TIU(8925,TIUDA,0)),+$$CLASS^TIUCP)
-"RTN","C0CTIU",139,0)
- ; Call INQUIRE to get record
-"RTN","C0CTIU",140,0)
- D INQUIRE^TIUSRVR2(TIUDA,.TIUREC,TIUCPF)
-"RTN","C0CTIU",141,0)
- ; First, load dictation, transcription data, etc.
-"RTN","C0CTIU",142,0)
- ;D LOADTOP^TIUSRVR1(.TIUREC,TIUDA,.TIUL,TIUGDATA,TIUCPF)
-"RTN","C0CTIU",143,0)
- ; Next, load the remainder of the record
-"RTN","C0CTIU",144,0)
- D LOADREC^TIUSRVR2(TIUDA,.TIUL,TIUGDATA,0,ACTION)
-"RTN","C0CTIU",145,0)
- K ^TMP("TIU FOCUS",$J)
-"RTN","C0CTIU",146,0)
- ;S VALMCNT=+$G(TIUL)
-"RTN","C0CTIU",147,0)
- M @C0CTIU@("TIUREC")=TIUREC(8925,TIUDA)
-"RTN","C0CTIU",148,0)
- M @C0CTIU@("TIUTEXT")=@TIUY
-"RTN","C0CTIU",149,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",110,0)
+ ;
+"RTN","C0CTIU",111,0)
+EXTRACT(ILXML,DFN,OLXML) ; EXTRACT TIU NOTES INTO THE C0CLVAR GLOBAL
+"RTN","C0CTIU",112,0)
+ ;
+"RTN","C0CTIU",113,0)
+ S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
+"RTN","C0CTIU",114,0)
+ D DT^DILF(,$$GET^C0CPARMS("TIULIMIT"),.C0CTSDT)
+"RTN","C0CTIU",115,0)
+ D DT^DILF(,$$GET^C0CPARMS("TIUSTART"),.C0CTEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
+"RTN","C0CTIU",116,0)
+ ;
+"RTN","C0CTIU",117,0)
+ S TIUIEN=0,TIUCNT=1
+"RTN","C0CTIU",118,0)
+ F S TIUIEN=$O(^TIU(8925,"C",DFN,TIUIEN)) Q:TIUIEN="" D
+"RTN","C0CTIU",119,0)
+ . S TIUY="",TIUDA=TIUIEN,ACTION="VIEW",U="^"
+"RTN","C0CTIU",120,0)
+ . ;SELECT ONLY COMPLETED NOTES
+"RTN","C0CTIU",121,0)
+ . Q:$P(^TIU(8925,TIUIEN,0),U,5)=""
+"RTN","C0CTIU",122,0)
+ . Q:$P(^TIU(8925.6,$P(^TIU(8925,TIUIEN,0),U,5),0),U)'="COMPLETED"
+"RTN","C0CTIU",123,0)
+ . ;VALIDATE ON SIGNATURE DATE #1501
+"RTN","C0CTIU",124,0)
+ . Q:$P(^TIU(8925,TIUIEN,15),U)C0CTEDT)
+"RTN","C0CTIU",125,0)
+ . D TGET(TIUY,TIUIEN,ACTION,TIUCNT)
+"RTN","C0CTIU",126,0)
+ . S TIUCNT=TIUCNT+1
+"RTN","C0CTIU",127,0)
+ ;ELN K @C0CLB ; CLEAR OUT OLD VARS IF ANY
+"RTN","C0CTIU",128,0)
+ N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG
+"RTN","C0CTIU",129,0)
+ S C0CQT=1 ; SURPRESS LISTING
+"RTN","C0CTIU",130,0)
+ D LIST ; EXTRACT THE VARIABLES
+"RTN","C0CTIU",131,0)
+ K ^TMP("C0CTIU",$J),TIUIEN,TIUCNT,TIUDA,TIUY,C0CLB,C0CTSDT,C0CTEDT
+"RTN","C0CTIU",132,0)
+ S C0CQT=QTSAV ; RESET SILENT FLAG
+"RTN","C0CTIU",133,0)
+ I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
+"RTN","C0CTIU",134,0)
+ Q
+"RTN","C0CTIU",135,0)
+ ;REUSING from ^TIUSRVR2
+"RTN","C0CTIU",136,0)
+TGET(TIUY,TIUDA,ACTION,TIUCNT) ; Build ^TMP("TIUVIEW",$J,
+"RTN","C0CTIU",137,0)
+ N TIUL,TIUREC,TIUARR,TIUGDATA,TIUNAME,TIUPRM0,TIUPRM1,X,Y,TIUCPF,ONBROWSE
+"RTN","C0CTIU",138,0)
+ K ^TMP("TIUVIEW",$J),^TMP("TIU FOCUS",$J)
+"RTN","C0CTIU",139,0)
+ S C0CTIU=$NA(^TMP("C0CTIU",$J,TIUCNT))
+"RTN","C0CTIU",140,0)
+ S ACTION=$G(ACTION,"VIEW"),TIUL=0
+"RTN","C0CTIU",141,0)
+ D SETPARM^TIULE
+"RTN","C0CTIU",142,0)
+ S TIUGDATA=$$SETGDATA^TIUSRVR1(TIUDA)
+"RTN","C0CTIU",143,0)
+ S TIUY=$NA(^TMP("TIUVIEW",$J))
+"RTN","C0CTIU",144,0)
+ S TIUARR="^TMP(""TIUVIEW"",$J)"
+"RTN","C0CTIU",145,0)
+ I '$D(^TIU(8925,+TIUDA,0)) Q
+"RTN","C0CTIU",146,0)
+ ; Initialize ^TMP("TIU FOCUS",$J) to the entry that has focus
+"RTN","C0CTIU",147,0)
+ S ^TMP("TIU FOCUS",$J)=TIUDA
+"RTN","C0CTIU",148,0)
+ ; Call INQUIRE to get record
+"RTN","C0CTIU",149,0)
+ ;Set a flag to indicate whether or not a Title is a memer of the
+"RTN","C0CTIU",150,0)
+ ;Clinical Procedures Class (1=Yes and 0=No)
+"RTN","C0CTIU",151,0)
+ S TIUCPF=+$$ISA^TIULX(+$G(^TIU(8925,TIUDA,0)),+$$CLASS^TIUCP)
+"RTN","C0CTIU",152,0)
+ ; Call INQUIRE to get record
"RTN","C0CTIU",153,0)
- ;N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR
+ D INQUIRE^TIUSRVR2(TIUDA,.TIUREC,TIUCPF)
"RTN","C0CTIU",154,0)
- I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
+ ; First, load dictation, transcription data, etc.
"RTN","C0CTIU",155,0)
- I '$D(C0CQT) S C0CQT=0
+ ;D LOADTOP^TIUSRVR1(.TIUREC,TIUDA,.TIUL,TIUGDATA,TIUCPF)
"RTN","C0CTIU",156,0)
- I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
+ ; Next, load the remainder of the record
"RTN","C0CTIU",157,0)
- S C0CI=""
+ D LOADREC^TIUSRVR2(TIUDA,.TIUL,TIUGDATA,0,ACTION)
"RTN","C0CTIU",158,0)
- S @C0CLB@(0)=$O(^TMP("C0CCCR",$J,"RESULTS",""),-1) ; INITALIZE RESULTS VARS COUNT
+ K ^TMP("TIU FOCUS",$J)
"RTN","C0CTIU",159,0)
- S C0CCNT=0,C0CTIU=$NA(^TMP("C0CTIU",$J))
+ ;S VALMCNT=+$G(TIUL)
"RTN","C0CTIU",160,0)
- F S C0CCNT=$O(@C0CTIU@(C0CCNT)) Q:C0CCNT="" D
+ M @C0CTIU@("TIUREC")=TIUREC(8925,TIUDA)
"RTN","C0CTIU",161,0)
- . D C0CRES,C0CTRES
+ M @C0CTIU@("TIUTEXT")=@TIUY
"RTN","C0CTIU",162,0)
- K C0CCNT,C0CTIU,C0CI,C0CLI,C0CX1
+ K ^TMP("TIUVEW",$J)
"RTN","C0CTIU",163,0)
Q
"RTN","C0CTIU",164,0)
-C0CRES ;SET TITLE NAME PART EQUIVALENT TO TEST NAME PART
+LIST ;EXTRACT THE RESULT VARIABLES TO C0CLB
"RTN","C0CTIU",165,0)
- N XV
+ ;
"RTN","C0CTIU",166,0)
- S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
+ ;N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR
"RTN","C0CTIU",167,0)
- S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
+ I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
"RTN","C0CTIU",168,0)
- S XV("RESULTOBJECTID")="RESULT_"_C0CLI
+ I '$D(C0CQT) S C0CQT=0
"RTN","C0CTIU",169,0)
- S C0CX1=$G(@C0CTIU@(C0CCNT,"TIUREC",1502))
+ I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
"RTN","C0CTIU",170,0)
- S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$O(^VA(200,"B",$G(C0CX1),0))
+ S C0CI=""
"RTN","C0CTIU",171,0)
- S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL($$C0CDATE^C0CTIU1($G(@C0CTIU@(C0CCNT,"TIUREC",1501))),"DT")
+ S @C0CLB@(0)=$O(^TMP("C0CCCR",$J,"RESULTS",""),-1) ; INITALIZE RESULTS VARS COUNT
"RTN","C0CTIU",172,0)
- S XV("RESULTCODE")=""
+ S C0CCNT=0,C0CTIU=$NA(^TMP("C0CTIU",$J))
"RTN","C0CTIU",173,0)
- S XV("RESULTCODINGSYSTEM")=""
+ F S C0CCNT=$O(@C0CTIU@(C0CCNT)) Q:C0CCNT="" D
"RTN","C0CTIU",174,0)
- S XV("RESULTSTATUS")="COMPLETED"
+ . D C0CRES,C0CTRES
"RTN","C0CTIU",175,0)
- S XV("RESULTDESCRIPTIONTEXT")="Progress Notes"
+ K C0CCNT,C0CTIU,C0CI,C0CLI,C0CX1
"RTN","C0CTIU",176,0)
- M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
-"RTN","C0CTIU",177,0)
Q
+"RTN","C0CTIU",177,0)
+C0CRES ;SET TITLE NAME PART EQUIVALENT TO TEST NAME PART
"RTN","C0CTIU",178,0)
-C0CTRES ;SET REPORT TEXT PART EQUIVALENT TO RESULT
+ N XV
"RTN","C0CTIU",179,0)
- N XV,C0CLOBX,C0CZG,C0CLB2
+ S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
"RTN","C0CTIU",180,0)
- S C0CLOBX=0
+ S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
"RTN","C0CTIU",181,0)
- S XV("RESULTTESTCODEVALUE")=$G(@C0CTIU@(C0CCNT,"TIUREC",.01))
+ S XV("RESULTOBJECTID")="RESULT_"_C0CLI
"RTN","C0CTIU",182,0)
- S XV("RESULTTESTCODINGSYSTEM")=""
+ S C0CX1=$G(@C0CTIU@(C0CCNT,"TIUREC",1502))
"RTN","C0CTIU",183,0)
- S XV("RESULTTESTDESCRIPTIONTEXT")=$G(@C0CTIU@(C0CCNT,"TIUREC",.01)) ; DESCRIPTION TEXT
+ S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$O(^VA(200,"B",$G(C0CX1),0))
"RTN","C0CTIU",184,0)
- S C0CZG=""
+ S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL($$C0CDATE^C0CTIU1($G(@C0CTIU@(C0CCNT,"TIUREC",1501))),"DT")
"RTN","C0CTIU",185,0)
- S XV("RESULTTESTVALUE")="Notes"
+ S XV("RESULTCODE")=""
"RTN","C0CTIU",186,0)
- M XV("RESULTTESTVALUE","WP")=@C0CTIU@(C0CCNT,"TIUTEXT")
+ S XV("RESULTCODINGSYSTEM")=""
"RTN","C0CTIU",187,0)
- S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
+ S XV("RESULTSTATUS")="COMPLETED"
"RTN","C0CTIU",188,0)
- S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
+ S XV("RESULTDESCRIPTIONTEXT")="Progress Notes"
"RTN","C0CTIU",189,0)
- S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
+ M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
"RTN","C0CTIU",190,0)
- S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
+ Q
"RTN","C0CTIU",191,0)
- S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_$O(^VA(200,$O(^VA(200,"B",$G(C0CX1),0)),2,0))
+C0CTRES ;SET REPORT TEXT PART EQUIVALENT TO RESULT
"RTN","C0CTIU",192,0)
- S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
+ N XV,C0CLOBX,C0CZG,C0CLB2
"RTN","C0CTIU",193,0)
- S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL($$C0CDATE^C0CTIU1($G(@C0CTIU@(C0CCNT,"TIUREC",1501))),"DT")
+ S C0CLOBX=0
"RTN","C0CTIU",194,0)
- S XV("RESULTTESTUNITS")=""
+ S XV("RESULTTESTCODEVALUE")=$G(@C0CTIU@(C0CCNT,"TIUREC",.01))
"RTN","C0CTIU",195,0)
- S XV("RESULTTESTFLAG")=""
+ S XV("RESULTTESTCODINGSYSTEM")=""
"RTN","C0CTIU",196,0)
- S XV("RESULTTESTSTATUSTEXT")=""
+ S XV("RESULTTESTDESCRIPTIONTEXT")=$G(@C0CTIU@(C0CCNT,"TIUREC",.01)) ; DESCRIPTION TEXT
"RTN","C0CTIU",197,0)
- S XV("RESULTTESTNORMALDESCTEXT")=""
+ S C0CZG=""
"RTN","C0CTIU",198,0)
- M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
+ S XV("RESULTTESTVALUE")="Notes"
"RTN","C0CTIU",199,0)
+ M XV("RESULTTESTVALUE","WP")=@C0CTIU@(C0CCNT,"TIUTEXT")
+"RTN","C0CTIU",200,0)
+ S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
+"RTN","C0CTIU",201,0)
+ S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
+"RTN","C0CTIU",202,0)
+ S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
+"RTN","C0CTIU",203,0)
+ S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
+"RTN","C0CTIU",204,0)
+ S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_$O(^VA(200,$O(^VA(200,"B",$G(C0CX1),0)),2,0))
+"RTN","C0CTIU",205,0)
+ S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
+"RTN","C0CTIU",206,0)
+ S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL($$C0CDATE^C0CTIU1($G(@C0CTIU@(C0CCNT,"TIUREC",1501))),"DT")
+"RTN","C0CTIU",207,0)
+ S XV("RESULTTESTUNITS")=""
+"RTN","C0CTIU",208,0)
+ S XV("RESULTTESTFLAG")=""
+"RTN","C0CTIU",209,0)
+ S XV("RESULTTESTSTATUSTEXT")=""
+"RTN","C0CTIU",210,0)
+ S XV("RESULTTESTNORMALDESCTEXT")=""
+"RTN","C0CTIU",211,0)
+ M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
+"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)
-C0CDATE(EDTE) ; Converts external date to internal date format
+ ; (C) ELN 2010.
"RTN","C0CTIU1",5,0)
- ; INPUT : EXTERNAL DATE (TIME IS OPTIONAL)
-"RTN","C0CTIU1",6,0)
- ; OUTOUT: INTERNAL DATE, STORAGE FORMAT YYYMMMDD
-"RTN","C0CTIU1",7,0)
- ; (TIME WILL BE RETURNED IF INCLUDED WITH INPUT)
-"RTN","C0CTIU1",8,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)
- Q:'$D(EDTE) -1
+ ; License, or (at your option) any later version.
"RTN","C0CTIU1",10,0)
- N X,%DT,Y
+ ;
"RTN","C0CTIU1",11,0)
- S X=EDTE
+ ; This program is distributed in the hope that it will be useful,
"RTN","C0CTIU1",12,0)
- S %DT="TS"
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0CTIU1",13,0)
- D ^%DT
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
"RTN","C0CTIU1",14,0)
- Q Y
+ ; GNU Affero General Public License for more details.
"RTN","C0CTIU1",15,0)
;
"RTN","C0CTIU1",16,0)
-XMAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
+ ; You should have received a copy of the GNU Affero General Public License
"RTN","C0CTIU1",17,0)
- ; AND PUT THE RESULTS IN OXML
+ ; along with this program. If not, see .
"RTN","C0CTIU1",18,0)
- N XCNT
-"RTN","C0CTIU1",19,0)
- I '$D(DEBUG) S DEBUG=0
-"RTN","C0CTIU1",20,0)
- I '$D(IXML) W "MALFORMED XML PASSED TO MAP",! Q
-"RTN","C0CTIU1",21,0)
- I '$D(@IXML@(0)) D ; INITIALIZE COUNT
-"RTN","C0CTIU1",22,0)
- . S XCNT=$O(@IXML@(""),-1)
-"RTN","C0CTIU1",23,0)
- E S XCNT=@IXML@(0) ;COUNT
-"RTN","C0CTIU1",24,0)
- I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
-"RTN","C0CTIU1",25,0)
;
+"RTN","C0CTIU1",19,0)
+C0CDATE(EDTE) ; Converts external date to internal date format
+"RTN","C0CTIU1",20,0)
+ ; INPUT : EXTERNAL DATE (TIME IS OPTIONAL)
+"RTN","C0CTIU1",21,0)
+ ; OUTOUT: INTERNAL DATE, STORAGE FORMAT YYYMMMDD
+"RTN","C0CTIU1",22,0)
+ ; (TIME WILL BE RETURNED IF INCLUDED WITH INPUT)
+"RTN","C0CTIU1",23,0)
+ ;
+"RTN","C0CTIU1",24,0)
+ Q:'$D(EDTE) -1
+"RTN","C0CTIU1",25,0)
+ N X,%DT,Y
"RTN","C0CTIU1",26,0)
- N I,J,TNAM,TVAL,TSTR
+ S X=EDTE
"RTN","C0CTIU1",27,0)
- S @OXML@(0)=XCNT ; TOTAL LINES IN OUTPUT
+ S %DT="TS"
"RTN","C0CTIU1",28,0)
- F I=1:1:XCNT D ; LOOP THROUGH WHOLE ARRAY
+ D ^%DT
"RTN","C0CTIU1",29,0)
- . S @OXML@(I)=@IXML@(I),C0CSLFLG=0 ; COPY THE LINE TO OUTPUT
+ Q Y
"RTN","C0CTIU1",30,0)
- . I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE?
+ ;
"RTN","C0CTIU1",31,0)
- . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
+XMAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
"RTN","C0CTIU1",32,0)
- . . F J=2:2:10 D Q:$P(@IXML@(I),"@@",J+2)="" ; QUIT IF NO MORE VARS
+ ; AND PUT THE RESULTS IN OXML
"RTN","C0CTIU1",33,0)
- . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,! H 1
+ N XCNT
"RTN","C0CTIU1",34,0)
- . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
+ I '$D(DEBUG) S DEBUG=0
"RTN","C0CTIU1",35,0)
- . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
+ I '$D(IXML) W "MALFORMED XML PASSED TO MAP",! Q
"RTN","C0CTIU1",36,0)
- . . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP?
+ I '$D(@IXML@(0)) D ; INITIALIZE COUNT
"RTN","C0CTIU1",37,0)
- . . . . I $D(@INARY@(TNAM,"WP")) D Q
+ . S XCNT=$O(@IXML@(""),-1)
"RTN","C0CTIU1",38,0)
- . . . . . D DOWPFLD(I,J)
+ E S XCNT=@IXML@(0) ;COUNT
"RTN","C0CTIU1",39,0)
- . . . . I '$D(@INARY@(TNAM,"F")) D ; NOT A SPECIAL FIELD
+ I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
"RTN","C0CTIU1",40,0)
- . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
+ ;
"RTN","C0CTIU1",41,0)
- . . . . E D DOFLD() ; PROCESS A FIELD ELAN
+ N I,J,TNAM,TVAL,TSTR
"RTN","C0CTIU1",42,0)
- . . . S TVAL=$$SYMENC^MXMLUTL(TVAL) ;MAKE SURE THE VALUE IS XML SAFE
+ S @OXML@(0)=XCNT ; TOTAL LINES IN OUTPUT
"RTN","C0CTIU1",43,0)
- . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
+ F I=1:1:XCNT D ; LOOP THROUGH WHOLE ARRAY
"RTN","C0CTIU1",44,0)
- . . I $G(C0CSLFLG)=1 M @OXML@(I)=TSTR Q
+ . S @OXML@(I)=@IXML@(I),C0CSLFLG=0 ; COPY THE LINE TO OUTPUT
"RTN","C0CTIU1",45,0)
- . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
+ . I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE?
"RTN","C0CTIU1",46,0)
- . . I DEBUG W TSTR H 1
+ . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
"RTN","C0CTIU1",47,0)
- I DEBUG W "MAPPED",!
+ . . F J=2:2:10 D Q:$P(@IXML@(I),"@@",J+2)="" ; QUIT IF NO MORE VARS
"RTN","C0CTIU1",48,0)
- K C0CSLFLG
+ . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,! H 1
"RTN","C0CTIU1",49,0)
- Q
+ . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
"RTN","C0CTIU1",50,0)
-DOWPFLD(I,J) ;WORDPROCESSING FIELD MANIPULATION
+ . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
"RTN","C0CTIU1",51,0)
- N C0CTXCNT
+ . . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP?
"RTN","C0CTIU1",52,0)
- S C0CTXCNT=0
+ . . . . I $D(@INARY@(TNAM,"WP")) D Q
"RTN","C0CTIU1",53,0)
- F S C0CTXCNT=$O(@INARY@(TNAM,"WP",C0CTXCNT)) Q:C0CTXCNT="" D
+ . . . . . D DOWPFLD(I,J)
"RTN","C0CTIU1",54,0)
- . S TSTR(C0CTXCNT)=TSTR_$G(@INARY@(TNAM,"WP",C0CTXCNT))_$P(@IXML@(I),"@@",J+1)
+ . . . . I '$D(@INARY@(TNAM,"F")) D ; NOT A SPECIAL FIELD
"RTN","C0CTIU1",55,0)
- S C0CSLFLG=1
+ . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
"RTN","C0CTIU1",56,0)
- Q
+ . . . . E D DOFLD() ; PROCESS A FIELD ELAN
"RTN","C0CTIU1",57,0)
-DOFLD() ;QUIT
+ . . . S TVAL=$$SYMENC^MXMLUTL(TVAL) ;MAKE SURE THE VALUE IS XML SAFE
"RTN","C0CTIU1",58,0)
- Q
+ . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
"RTN","C0CTIU1",59,0)
-BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
+ . . I $G(C0CSLFLG)=1 M @OXML@(I)=TSTR Q
"RTN","C0CTIU1",60,0)
- ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
+ . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
"RTN","C0CTIU1",61,0)
- ; DEST IS CLEARED TO START
+ . . I DEBUG W TSTR H 1
"RTN","C0CTIU1",62,0)
- ; USES PUSH TO DO THE COPY
+ I DEBUG W "MAPPED",!
"RTN","C0CTIU1",63,0)
- N I,WPSEQ
+ K C0CSLFLG
"RTN","C0CTIU1",64,0)
- K @BDEST
+ Q
"RTN","C0CTIU1",65,0)
- F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST
+DOWPFLD(I,J) ;WORDPROCESSING FIELD MANIPULATION
"RTN","C0CTIU1",66,0)
- . N J,ATMP
+ N C0CTXCNT
"RTN","C0CTIU1",67,0)
- . S ATMP=$$ARRAY^C0CXPATH(@BLIST@(I))
+ S C0CTXCNT=0
"RTN","C0CTIU1",68,0)
- . I $G(DEBUG) W "ATMP=",ATMP,!
+ F S C0CTXCNT=$O(@INARY@(TNAM,"WP",C0CTXCNT)) Q:C0CTXCNT="" D
"RTN","C0CTIU1",69,0)
- . I $G(DEBUG) W @BLIST@(I),!
+ . S TSTR(C0CTXCNT)=TSTR_$G(@INARY@(TNAM,"WP",C0CTXCNT))_$P(@IXML@(I),"@@",J+1)
"RTN","C0CTIU1",70,0)
- . F J=$$START^C0CXPATH(@BLIST@(I)):1:$$FINISH^C0CXPATH(@BLIST@(I)) D ;
+ S C0CSLFLG=1
"RTN","C0CTIU1",71,0)
- . . ; FOR EACH LINE IN THIS INSTR
+ Q
"RTN","C0CTIU1",72,0)
- . . I $G(DEBUG) W "BDEST= ",BDEST,!
+DOFLD() ;QUIT
"RTN","C0CTIU1",73,0)
- . . I $G(DEBUG) W "ATMP= ",@ATMP@(J),!
+ Q
"RTN","C0CTIU1",74,0)
- . . I $D(@ATMP@(J,1)),$G(@ATMP@(J))="@@RESULTTESTVALUE@@" D Q
+BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
"RTN","C0CTIU1",75,0)
- . . . S WPSEQ=0
+ ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
"RTN","C0CTIU1",76,0)
- . . . D PUSH^C0CXPATH(BDEST,"")
+ ; DEST IS CLEARED TO START
"RTN","C0CTIU1",77,0)
- . . . F S WPSEQ=$O(@ATMP@(J,WPSEQ)) Q:WPSEQ="" D
+ ; USES PUSH TO DO THE COPY
"RTN","C0CTIU1",78,0)
- . . . . D PUSH^C0CXPATH(BDEST,$$SYMENC^MXMLUTL($$XVAL^C0CXPATH(@ATMP@(J,WPSEQ)))_"
")
+ N I,WPSEQ
"RTN","C0CTIU1",79,0)
- . . . D PUSH^C0CXPATH(BDEST,"")
+ K @BDEST
"RTN","C0CTIU1",80,0)
- . . D PUSH^C0CXPATH(BDEST,@ATMP@(J))
+ F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST
"RTN","C0CTIU1",81,0)
+ . N J,ATMP
+"RTN","C0CTIU1",82,0)
+ . S ATMP=$$ARRAY^C0CXPATH(@BLIST@(I))
+"RTN","C0CTIU1",83,0)
+ . I $G(DEBUG) W "ATMP=",ATMP,!
+"RTN","C0CTIU1",84,0)
+ . I $G(DEBUG) W @BLIST@(I),!
+"RTN","C0CTIU1",85,0)
+ . F J=$$START^C0CXPATH(@BLIST@(I)):1:$$FINISH^C0CXPATH(@BLIST@(I)) D ;
+"RTN","C0CTIU1",86,0)
+ . . ; FOR EACH LINE IN THIS INSTR
+"RTN","C0CTIU1",87,0)
+ . . I $G(DEBUG) W "BDEST= ",BDEST,!
+"RTN","C0CTIU1",88,0)
+ . . I $G(DEBUG) W "ATMP= ",@ATMP@(J),!
+"RTN","C0CTIU1",89,0)
+ . . I $D(@ATMP@(J,1)),$G(@ATMP@(J))="@@RESULTTESTVALUE@@" D Q
+"RTN","C0CTIU1",90,0)
+ . . . S WPSEQ=0
+"RTN","C0CTIU1",91,0)
+ . . . D PUSH^C0CXPATH(BDEST,"")
+"RTN","C0CTIU1",92,0)
+ . . . F S WPSEQ=$O(@ATMP@(J,WPSEQ)) Q:WPSEQ="" D
+"RTN","C0CTIU1",93,0)
+ . . . . D PUSH^C0CXPATH(BDEST,$$SYMENC^MXMLUTL($$XVAL^C0CXPATH(@ATMP@(J,WPSEQ)))_"
")
+"RTN","C0CTIU1",94,0)
+ . . . D PUSH^C0CXPATH(BDEST,"")
+"RTN","C0CTIU1",95,0)
+ . . D PUSH^C0CXPATH(BDEST,@ATMP@(J))
+"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 .
"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",!
-"RTN","C0CUNIT",21,0)
- W !
-"RTN","C0CUNIT",22,0)
- Q
-"RTN","C0CUNIT",23,0)
- ;
-"RTN","C0CUNIT",24,0)
-ZT(ZARY,BAT,TST) ; private routine to add a test case to the ZARY array
-"RTN","C0CUNIT",25,0)
- ; ZARY IS PASSED BY REFERENCE
-"RTN","C0CUNIT",26,0)
- ; BAT is a string identifying the test battery
-"RTN","C0CUNIT",27,0)
- ; TST is a test which will evaluate to true or false
-"RTN","C0CUNIT",28,0)
- ; I '$G(ZARY) D
-"RTN","C0CUNIT",29,0)
- ; . S ZARY(0)=0 ; initially there are no elements
-"RTN","C0CUNIT",30,0)
- ; W "GOT HERE LOADING "_TST,!
-"RTN","C0CUNIT",31,0)
- N CNT ; count of array elements
-"RTN","C0CUNIT",32,0)
- S CNT=ZARY(0) ; contains array count
-"RTN","C0CUNIT",33,0)
- S CNT=CNT+1 ; increment count
-"RTN","C0CUNIT",34,0)
- S ZARY(CNT)=TST ; put the test in the array
-"RTN","C0CUNIT",35,0)
- I $D(ZARY(BAT)) D ; NOT THE FIRST TEST IN BATTERY
-"RTN","C0CUNIT",36,0)
- . N II,TN ; TEMP FOR ENDING TEST IN BATTERY
-"RTN","C0CUNIT",37,0)
- . S II=$P(ZARY(BAT),"^",2)
-"RTN","C0CUNIT",38,0)
- . S $P(ZARY(BAT),"^",2)=II+1
-"RTN","C0CUNIT",39,0)
- I '$D(ZARY(BAT)) D ; FIRST TEST IN THIS BATTERY
-"RTN","C0CUNIT",40,0)
- . S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
-"RTN","C0CUNIT",41,0)
- . S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
-"RTN","C0CUNIT",42,0)
- . ; S TN=$NA(ZARY("TESTS"))
-"RTN","C0CUNIT",43,0)
- . ; D PUSH^C0CXPATH(TN,BAT)
-"RTN","C0CUNIT",44,0)
- S ZARY(0)=CNT ; update the array counter
-"RTN","C0CUNIT",45,0)
- Q
-"RTN","C0CUNIT",46,0)
- ;
-"RTN","C0CUNIT",47,0)
-ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
-"RTN","C0CUNIT",48,0)
- ; ZARY IS PASSED BY NAME
-"RTN","C0CUNIT",49,0)
- ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
-"RTN","C0CUNIT",50,0)
- ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
-"RTN","C0CUNIT",51,0)
- K @ZARY
-"RTN","C0CUNIT",52,0)
- S @ZARY@(0)=0 ; initialize array count
-"RTN","C0CUNIT",53,0)
- N LINE,LABEL,BODY
-"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
-"RTN","C0CUNIT",56,0)
- ;
-"RTN","C0CUNIT",57,0)
- N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D
-"RTN","C0CUNIT",58,0)
- . I LINE?." "1";;>".E S INTEST=1 ; entering test section
-"RTN","C0CUNIT",59,0)
- . I LINE?." "1";;>".E S INTEST=1 ; entering TEMPLATE section
-"RTN","C0CUNIT",60,0)
- . I LINE?." "1";;>".E S INTEST=0 ; leaving test section
-"RTN","C0CUNIT",61,0)
- . I LINE?." "1";;>".E S INTEST=0 ; leaving TEMPLATE section
-"RTN","C0CUNIT",62,0)
- . I INTEST D ; within the testing section
-"RTN","C0CUNIT",63,0)
- . . I LINE?." "1";;><".E D ; section name found
-"RTN","C0CUNIT",64,0)
- . . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name
-"RTN","C0CUNIT",65,0)
- . . I LINE?." "1";;>>".E D ; test case found
-"RTN","C0CUNIT",66,0)
- . . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array
-"RTN","C0CUNIT",67,0)
- S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
-"RTN","C0CUNIT",68,0)
- Q
-"RTN","C0CUNIT",69,0)
- ;
-"RTN","C0CUNIT",70,0)
-ZTEST(ZARY,WHICH) ; try out the tests using a passed array ZTEST
-"RTN","C0CUNIT",71,0)
- N ZI,ZX,ZR,ZP
-"RTN","C0CUNIT",72,0)
- S DEBUG=0
-"RTN","C0CUNIT",73,0)
- ; I WHICH="ALL" D Q ; RUN ALL THE TESTS
-"RTN","C0CUNIT",74,0)
- ; . W "DOING ALL",!
-"RTN","C0CUNIT",75,0)
- ; . N J,NT
-"RTN","C0CUNIT",76,0)
- ; . S NT=$NA(ZARY("TESTS"))
-"RTN","C0CUNIT",77,0)
- ; . W NT,@NT@(0),!
-"RTN","C0CUNIT",78,0)
- ; . F J=1:1:@NT@(0) D ;
-"RTN","C0CUNIT",79,0)
- ; . . W @NT@(J),!
-"RTN","C0CUNIT",80,0)
- ; . . D ZTEST^C0CUNIT(@ZARY,@NT@(J))
-"RTN","C0CUNIT",81,0)
- I '$D(ZARY(WHICH)) D Q ; TEST SECTION DOESN'T EXIST
-"RTN","C0CUNIT",82,0)
- . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
-"RTN","C0CUNIT",83,0)
- N FIRST,LAST
-"RTN","C0CUNIT",84,0)
- S FIRST=$P(ZARY(WHICH),"^",1)
-"RTN","C0CUNIT",85,0)
- S LAST=$P(ZARY(WHICH),"^",2)
-"RTN","C0CUNIT",86,0)
- F ZI=FIRST:1:LAST D
-"RTN","C0CUNIT",87,0)
- . I ZARY(ZI)?1">"1.E D ; NOT A TEST, JUST RUN THE STATEMENT
-"RTN","C0CUNIT",88,0)
- . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
-"RTN","C0CUNIT",89,0)
- . . ; W ZP,!
-"RTN","C0CUNIT",90,0)
- . . S ZX=ZP
-"RTN","C0CUNIT",91,0)
- . . W "RUNNING: "_ZP
-"RTN","C0CUNIT",92,0)
- . . X ZX
-"RTN","C0CUNIT",93,0)
- . . W "..SUCCESS: ",WHICH,!
-"RTN","C0CUNIT",94,0)
- . I ZARY(ZI)?1"?"1.E D ; THIS IS A TEST
-"RTN","C0CUNIT",95,0)
- . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
-"RTN","C0CUNIT",96,0)
- . . S ZX="S ZR="_ZP
-"RTN","C0CUNIT",97,0)
- . . W "TRYING: "_ZP
-"RTN","C0CUNIT",98,0)
- . . X ZX
-"RTN","C0CUNIT",99,0)
- . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
-"RTN","C0CUNIT",100,0)
- . . I '$D(TPASSED) D ; NOT INITIALIZED YET
-"RTN","C0CUNIT",101,0)
- . . . S TPASSED=0 S TFAILED=0
-"RTN","C0CUNIT",102,0)
- . . I ZR S TPASSED=TPASSED+1
-"RTN","C0CUNIT",103,0)
- . . I 'ZR S TFAILED=TFAILED+1
-"RTN","C0CUNIT",104,0)
- Q
-"RTN","C0CUNIT",105,0)
- ;
-"RTN","C0CUNIT",106,0)
-TEST ; RUN ALL THE TEST CASES
-"RTN","C0CUNIT",107,0)
- N ZTMP
-"RTN","C0CUNIT",108,0)
- D ZLOAD(.ZTMP)
-"RTN","C0CUNIT",109,0)
- D ZTEST(.ZTMP,"ALL")
-"RTN","C0CUNIT",110,0)
- W "PASSED: ",TPASSED,!
-"RTN","C0CUNIT",111,0)
- W "FAILED: ",TFAILED,!
-"RTN","C0CUNIT",112,0)
- W !
-"RTN","C0CUNIT",113,0)
- W "THE TESTS!",!
-"RTN","C0CUNIT",114,0)
- ; I DEBUG ZWR ZTMP
-"RTN","C0CUNIT",115,0)
- Q
-"RTN","C0CUNIT",116,0)
- ;
-"RTN","C0CUNIT",117,0)
-GTSTS(GTZARY,RTN) ; return an array of test names
-"RTN","C0CUNIT",118,0)
- N I,J S I="" S I=$O(GTZARY("TESTS",I))
-"RTN","C0CUNIT",119,0)
- F J=0:0 Q:I="" D
-"RTN","C0CUNIT",120,0)
- . D PUSH^C0CXPATH(RTN,I)
-"RTN","C0CUNIT",121,0)
- . S I=$O(GTZARY("TESTS",I))
-"RTN","C0CUNIT",122,0)
- Q
-"RTN","C0CUNIT",123,0)
- ;
-"RTN","C0CUNIT",124,0)
-TESTALL(RNM) ; RUN ALL THE TESTS
-"RTN","C0CUNIT",125,0)
- N ZI,J,TZTMP,TSTS,TOTP,TOTF
-"RTN","C0CUNIT",126,0)
- S TOTP=0 S TOTF=0
-"RTN","C0CUNIT",127,0)
- D ZLOAD^C0CUNIT("TZTMP",RNM)
-"RTN","C0CUNIT",128,0)
- D GTSTS(.TZTMP,"TSTS")
-"RTN","C0CUNIT",129,0)
- F ZI=1:1:TSTS(0) D ;
-"RTN","C0CUNIT",130,0)
- . S TPASSED=0 S TFAILED=0
-"RTN","C0CUNIT",131,0)
- . D ZTEST^C0CUNIT(.TZTMP,TSTS(ZI))
-"RTN","C0CUNIT",132,0)
- . S TOTP=TOTP+TPASSED
-"RTN","C0CUNIT",133,0)
- . S TOTF=TOTF+TFAILED
-"RTN","C0CUNIT",134,0)
- . S $P(TSTS(ZI),"^",2)=TPASSED
-"RTN","C0CUNIT",135,0)
- . S $P(TSTS(ZI),"^",3)=TFAILED
-"RTN","C0CUNIT",136,0)
- F ZI=1:1:TSTS(0) D ;
-"RTN","C0CUNIT",137,0)
- . W "TEST=> ",$P(TSTS(ZI),"^",1)
-"RTN","C0CUNIT",138,0)
- . W " PASSED=>",$P(TSTS(ZI),"^",2)
-"RTN","C0CUNIT",139,0)
- . W " FAILED=>",$P(TSTS(ZI),"^",3),!
-"RTN","C0CUNIT",140,0)
- W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
-"RTN","C0CUNIT",141,0)
- Q
-"RTN","C0CUNIT",142,0)
- ;
-"RTN","C0CUNIT",143,0)
-TLIST(ZARY) ; LIST ALL THE TESTS
-"RTN","C0CUNIT",144,0)
- ; THEY ARE MARKED AS ;;> IN THE TEST CASES
-"RTN","C0CUNIT",145,0)
- ; ZARY IS PASSED BY REFERENCE
-"RTN","C0CUNIT",146,0)
- N I,J,K S I="" S I=$O(ZARY("TESTS",I))
-"RTN","C0CUNIT",147,0)
- S K=1
-"RTN","C0CUNIT",148,0)
- F J=0:0 Q:I="" D
-"RTN","C0CUNIT",149,0)
- . ; W "I IS NOW=",I,!
-"RTN","C0CUNIT",150,0)
- . W I," "
-"RTN","C0CUNIT",151,0)
- . S I=$O(ZARY("TESTS",I))
-"RTN","C0CUNIT",152,0)
- . S K=K+1 I K=6 D
-"RTN","C0CUNIT",153,0)
- . . W !
-"RTN","C0CUNIT",154,0)
- . . S K=1
-"RTN","C0CUNIT",155,0)
- Q
-"RTN","C0CUNIT",156,0)
- ;
-"RTN","C0CUNIT",157,0)
-MEDS
-"RTN","C0CUNIT",158,0)
- N DEBUG S DEBUG=0
-"RTN","C0CUNIT",159,0)
- N DFN S DFN=5685
-"RTN","C0CUNIT",160,0)
- K ^TMP($J)
-"RTN","C0CUNIT",161,0)
- W "Loading CCR Template into T using LOAD^GPLCCR0($NA(^TMP($J,""CCR"")))",!!
-"RTN","C0CUNIT",162,0)
- N T S T=$NA(^TMP($J,"CCR")) D LOAD^GPLCCR0(T)
-"RTN","C0CUNIT",163,0)
- N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
-"RTN","C0CUNIT",164,0)
- W "XPATH is: "_XPATH,!
-"RTN","C0CUNIT",165,0)
- W "Getting Med Template into INXML using",!
-"RTN","C0CUNIT",166,0)
- W "QUERY^GPLXPATH(T,XPATH,""INXML"")",!!
-"RTN","C0CUNIT",167,0)
- D QUERY^GPLXPATH(T,XPATH,"INXML")
-"RTN","C0CUNIT",168,0)
- W "Executing EXTRACT^C0CMED(INXML,DFN,OUTXML)",!
-"RTN","C0CUNIT",169,0)
- W "OUTXML will be ^TMP($J,""OUT"")",!
-"RTN","C0CUNIT",170,0)
- N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
-"RTN","C0CUNIT",171,0)
- D EXTRACT^C0CMED6("INXML",DFN,OUTXML)
-"RTN","C0CUNIT",172,0)
- D FILEOUT^C0CRNF(OUTXML,"TESTMEDS.xml")
-"RTN","C0CUNIT",173,0)
Q
-"RTN","C0CUNIT",174,0)
-PAT
-"RTN","C0CUNIT",175,0)
- D ANALYZE^ARJTXRD("C0CDPT",.OUT) ; Analyze a routine in the directory
-"RTN","C0CUNIT",176,0)
- N X,Y
-"RTN","C0CUNIT",177,0)
- ; Select Patient
-"RTN","C0CUNIT",178,0)
- S DIC=2,DIC(0)="AEMQ" D ^DIC
-"RTN","C0CUNIT",179,0)
+"RTN","C0CUNIT",21,0)
;
-"RTN","C0CUNIT",180,0)
+"RTN","C0CUNIT",22,0)
+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)
+ ; BAT is a string identifying the test battery
+"RTN","C0CUNIT",25,0)
+ ; TST is a test which will evaluate to true or false
+"RTN","C0CUNIT",26,0)
+ ; I '$G(ZARY) D
+"RTN","C0CUNIT",27,0)
+ ; . S ZARY(0)=0 ; initially there are no elements
+"RTN","C0CUNIT",28,0)
+ ; W "GOT HERE LOADING "_TST,!
+"RTN","C0CUNIT",29,0)
+ N CNT ; count of array elements
+"RTN","C0CUNIT",30,0)
+ S CNT=ZARY(0) ; contains array count
+"RTN","C0CUNIT",31,0)
+ S CNT=CNT+1 ; increment count
+"RTN","C0CUNIT",32,0)
+ S ZARY(CNT)=TST ; put the test in the array
+"RTN","C0CUNIT",33,0)
+ I $D(ZARY(BAT)) D ; NOT THE FIRST TEST IN BATTERY
+"RTN","C0CUNIT",34,0)
+ . N II,TN ; TEMP FOR ENDING TEST IN BATTERY
+"RTN","C0CUNIT",35,0)
+ . S II=$P(ZARY(BAT),"^",2)
+"RTN","C0CUNIT",36,0)
+ . S $P(ZARY(BAT),"^",2)=II+1
+"RTN","C0CUNIT",37,0)
+ I '$D(ZARY(BAT)) D ; FIRST TEST IN THIS BATTERY
+"RTN","C0CUNIT",38,0)
+ . S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
+"RTN","C0CUNIT",39,0)
+ . S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
+"RTN","C0CUNIT",40,0)
+ . ; S TN=$NA(ZARY("TESTS"))
+"RTN","C0CUNIT",41,0)
+ . ; D PUSH^C0CXPATH(TN,BAT)
+"RTN","C0CUNIT",42,0)
+ S ZARY(0)=CNT ; update the array counter
+"RTN","C0CUNIT",43,0)
+ Q
+"RTN","C0CUNIT",44,0)
+ ;
+"RTN","C0CUNIT",45,0)
+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)
+ ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+"RTN","C0CUNIT",48,0)
+ ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+"RTN","C0CUNIT",49,0)
+ K @ZARY
+"RTN","C0CUNIT",50,0)
+ S @ZARY@(0)=0 ; initialize array count
+"RTN","C0CUNIT",51,0)
+ N LINE,LABEL,BODY
+"RTN","C0CUNIT",52,0)
+ N INTEST S INTEST=0 ; switch for in the test case section
+"RTN","C0CUNIT",53,0)
+ N SECTION S SECTION="[anonymous]" ; test case section
+"RTN","C0CUNIT",54,0)
+ ;
+"RTN","C0CUNIT",55,0)
+ N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D
+"RTN","C0CUNIT",56,0)
+ . I LINE?." "1";;>".E S INTEST=1 ; entering test section
+"RTN","C0CUNIT",57,0)
+ . I LINE?." "1";;>".E S INTEST=1 ; entering TEMPLATE section
+"RTN","C0CUNIT",58,0)
+ . I LINE?." "1";;>".E S INTEST=0 ; leaving test section
+"RTN","C0CUNIT",59,0)
+ . I LINE?." "1";;>".E S INTEST=0 ; leaving TEMPLATE section
+"RTN","C0CUNIT",60,0)
+ . I INTEST D ; within the testing section
+"RTN","C0CUNIT",61,0)
+ . . I LINE?." "1";;><".E D ; section name found
+"RTN","C0CUNIT",62,0)
+ . . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name
+"RTN","C0CUNIT",63,0)
+ . . I LINE?." "1";;>>".E D ; test case found
+"RTN","C0CUNIT",64,0)
+ . . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array
+"RTN","C0CUNIT",65,0)
+ S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
+"RTN","C0CUNIT",66,0)
+ Q
+"RTN","C0CUNIT",67,0)
+ ;
+"RTN","C0CUNIT",68,0)
+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)
+ S DEBUG=0
+"RTN","C0CUNIT",71,0)
+ ; I WHICH="ALL" D Q ; RUN ALL THE TESTS
+"RTN","C0CUNIT",72,0)
+ ; . W "DOING ALL",!
+"RTN","C0CUNIT",73,0)
+ ; . N J,NT
+"RTN","C0CUNIT",74,0)
+ ; . S NT=$NA(ZARY("TESTS"))
+"RTN","C0CUNIT",75,0)
+ ; . W NT,@NT@(0),!
+"RTN","C0CUNIT",76,0)
+ ; . F J=1:1:@NT@(0) D ;
+"RTN","C0CUNIT",77,0)
+ ; . . W @NT@(J),!
+"RTN","C0CUNIT",78,0)
+ ; . . D ZTEST^C0CUNIT(@ZARY,@NT@(J))
+"RTN","C0CUNIT",79,0)
+ I '$D(ZARY(WHICH)) D Q ; TEST SECTION DOESN'T EXIST
+"RTN","C0CUNIT",80,0)
+ . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
+"RTN","C0CUNIT",81,0)
+ N FIRST,LAST
+"RTN","C0CUNIT",82,0)
+ S FIRST=$P(ZARY(WHICH),"^",1)
+"RTN","C0CUNIT",83,0)
+ S LAST=$P(ZARY(WHICH),"^",2)
+"RTN","C0CUNIT",84,0)
+ F ZI=FIRST:1:LAST D
+"RTN","C0CUNIT",85,0)
+ . I ZARY(ZI)?1">"1.E D ; NOT A TEST, JUST RUN THE STATEMENT
+"RTN","C0CUNIT",86,0)
+ . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
+"RTN","C0CUNIT",87,0)
+ . . ; W ZP,!
+"RTN","C0CUNIT",88,0)
+ . . S ZX=ZP
+"RTN","C0CUNIT",89,0)
+ . . W "RUNNING: "_ZP
+"RTN","C0CUNIT",90,0)
+ . . X ZX
+"RTN","C0CUNIT",91,0)
+ . . W "..SUCCESS: ",WHICH,!
+"RTN","C0CUNIT",92,0)
+ . I ZARY(ZI)?1"?"1.E D ; THIS IS A TEST
+"RTN","C0CUNIT",93,0)
+ . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
+"RTN","C0CUNIT",94,0)
+ . . S ZX="S ZR="_ZP
+"RTN","C0CUNIT",95,0)
+ . . W "TRYING: "_ZP
+"RTN","C0CUNIT",96,0)
+ . . X ZX
+"RTN","C0CUNIT",97,0)
+ . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
+"RTN","C0CUNIT",98,0)
+ . . I '$D(TPASSED) D ; NOT INITIALIZED YET
+"RTN","C0CUNIT",99,0)
+ . . . S TPASSED=0 S TFAILED=0
+"RTN","C0CUNIT",100,0)
+ . . I ZR S TPASSED=TPASSED+1
+"RTN","C0CUNIT",101,0)
+ . . I 'ZR S TFAILED=TFAILED+1
+"RTN","C0CUNIT",102,0)
+ Q
+"RTN","C0CUNIT",103,0)
+ ;
+"RTN","C0CUNIT",104,0)
+TEST ; RUN ALL THE TEST CASES
+"RTN","C0CUNIT",105,0)
+ N ZTMP
+"RTN","C0CUNIT",106,0)
+ D ZLOAD(.ZTMP)
+"RTN","C0CUNIT",107,0)
+ D ZTEST(.ZTMP,"ALL")
+"RTN","C0CUNIT",108,0)
+ W "PASSED: ",TPASSED,!
+"RTN","C0CUNIT",109,0)
+ W "FAILED: ",TFAILED,!
+"RTN","C0CUNIT",110,0)
+ W !
+"RTN","C0CUNIT",111,0)
+ W "THE TESTS!",!
+"RTN","C0CUNIT",112,0)
+ ; I DEBUG ZWR ZTMP
+"RTN","C0CUNIT",113,0)
+ Q
+"RTN","C0CUNIT",114,0)
+ ;
+"RTN","C0CUNIT",115,0)
+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)
+ F J=0:0 Q:I="" D
+"RTN","C0CUNIT",118,0)
+ . D PUSH^C0CXPATH(RTN,I)
+"RTN","C0CUNIT",119,0)
+ . S I=$O(GTZARY("TESTS",I))
+"RTN","C0CUNIT",120,0)
+ Q
+"RTN","C0CUNIT",121,0)
+ ;
+"RTN","C0CUNIT",122,0)
+TESTALL(RNM) ; RUN ALL THE TESTS
+"RTN","C0CUNIT",123,0)
+ N ZI,J,TZTMP,TSTS,TOTP,TOTF
+"RTN","C0CUNIT",124,0)
+ S TOTP=0 S TOTF=0
+"RTN","C0CUNIT",125,0)
+ D ZLOAD^C0CUNIT("TZTMP",RNM)
+"RTN","C0CUNIT",126,0)
+ D GTSTS(.TZTMP,"TSTS")
+"RTN","C0CUNIT",127,0)
+ F ZI=1:1:TSTS(0) D ;
+"RTN","C0CUNIT",128,0)
+ . S TPASSED=0 S TFAILED=0
+"RTN","C0CUNIT",129,0)
+ . D ZTEST^C0CUNIT(.TZTMP,TSTS(ZI))
+"RTN","C0CUNIT",130,0)
+ . S TOTP=TOTP+TPASSED
+"RTN","C0CUNIT",131,0)
+ . S TOTF=TOTF+TFAILED
+"RTN","C0CUNIT",132,0)
+ . S $P(TSTS(ZI),"^",2)=TPASSED
+"RTN","C0CUNIT",133,0)
+ . S $P(TSTS(ZI),"^",3)=TFAILED
+"RTN","C0CUNIT",134,0)
+ F ZI=1:1:TSTS(0) D ;
+"RTN","C0CUNIT",135,0)
+ . W "TEST=> ",$P(TSTS(ZI),"^",1)
+"RTN","C0CUNIT",136,0)
+ . W " PASSED=>",$P(TSTS(ZI),"^",2)
+"RTN","C0CUNIT",137,0)
+ . W " FAILED=>",$P(TSTS(ZI),"^",3),!
+"RTN","C0CUNIT",138,0)
+ W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
+"RTN","C0CUNIT",139,0)
+ Q
+"RTN","C0CUNIT",140,0)
+ ;
+"RTN","C0CUNIT",141,0)
+TLIST(ZARY) ; LIST ALL THE TESTS
+"RTN","C0CUNIT",142,0)
+ ; THEY ARE MARKED AS ;;> IN THE TEST CASES
+"RTN","C0CUNIT",143,0)
+ ; ZARY IS PASSED BY REFERENCE
+"RTN","C0CUNIT",144,0)
+ N I,J,K S I="" S I=$O(ZARY("TESTS",I))
+"RTN","C0CUNIT",145,0)
+ S K=1
+"RTN","C0CUNIT",146,0)
+ F J=0:0 Q:I="" D
+"RTN","C0CUNIT",147,0)
+ . ; W "I IS NOW=",I,!
+"RTN","C0CUNIT",148,0)
+ . W I," "
+"RTN","C0CUNIT",149,0)
+ . S I=$O(ZARY("TESTS",I))
+"RTN","C0CUNIT",150,0)
+ . S K=K+1 I K=6 D
+"RTN","C0CUNIT",151,0)
+ . . W !
+"RTN","C0CUNIT",152,0)
+ . . S K=1
+"RTN","C0CUNIT",153,0)
+ Q
+"RTN","C0CUNIT",154,0)
+ ;
+"RTN","C0CUNIT",155,0)
+MEDS ;
+"RTN","C0CUNIT",156,0)
+ N DEBUG S DEBUG=0
+"RTN","C0CUNIT",157,0)
+ N DFN S DFN=5685
+"RTN","C0CUNIT",158,0)
+ K ^TMP($J)
+"RTN","C0CUNIT",159,0)
+ W "Loading CCR Template into T using LOAD^GPLCCR0($NA(^TMP($J,""CCR"")))",!!
+"RTN","C0CUNIT",160,0)
+ N T S T=$NA(^TMP($J,"CCR")) D LOAD^GPLCCR0(T)
+"RTN","C0CUNIT",161,0)
+ N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
+"RTN","C0CUNIT",162,0)
+ W "XPATH is: "_XPATH,!
+"RTN","C0CUNIT",163,0)
+ W "Getting Med Template into INXML using",!
+"RTN","C0CUNIT",164,0)
+ W "QUERY^GPLXPATH(T,XPATH,""INXML"")",!!
+"RTN","C0CUNIT",165,0)
+ D QUERY^GPLXPATH(T,XPATH,"INXML")
+"RTN","C0CUNIT",166,0)
+ W "Executing EXTRACT^C0CMED(INXML,DFN,OUTXML)",!
+"RTN","C0CUNIT",167,0)
+ W "OUTXML will be ^TMP($J,""OUT"")",!
+"RTN","C0CUNIT",168,0)
+ N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
+"RTN","C0CUNIT",169,0)
+ D EXTRACT^C0CMED6("INXML",DFN,OUTXML)
+"RTN","C0CUNIT",170,0)
+ D FILEOUT^C0CRNF(OUTXML,"TESTMEDS.xml")
+"RTN","C0CUNIT",171,0)
+ Q
+"RTN","C0CUNIT",172,0)
+PAT ;
+"RTN","C0CUNIT",173,0)
+ D ANALYZE^ARJTXRD("C0CDPT",.OUT) ; Analyze a routine in the directory
+"RTN","C0CUNIT",174,0)
+ N X,Y
+"RTN","C0CUNIT",175,0)
+ ; Select Patient
+"RTN","C0CUNIT",176,0)
+ S DIC=2,DIC(0)="AEMQ" D ^DIC
+"RTN","C0CUNIT",177,0)
+ ;
+"RTN","C0CUNIT",178,0)
W "You have selected patient "_Y,!!
-"RTN","C0CUNIT",181,0)
+"RTN","C0CUNIT",179,0)
N I S I=89 F S I=$O(OUT(I)) Q:I="ALINE" D
-"RTN","C0CUNIT",182,0)
+"RTN","C0CUNIT",180,0)
. W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
-"RTN","C0CUNIT",183,0)
+"RTN","C0CUNIT",181,0)
. W "valued at "
-"RTN","C0CUNIT",184,0)
+"RTN","C0CUNIT",182,0)
. W @("$$"_$P(OUT(I,0),"(DFN)")_"^"_"C0CDPT"_"("_$P(Y,"^")_")")
-"RTN","C0CUNIT",185,0)
+"RTN","C0CUNIT",183,0)
. W !
-"RTN","C0CUNIT",186,0)
+"RTN","C0CUNIT",184,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.
-"RTN","C0CUTIL",16,0)
;
+"RTN","C0CUTIL",15,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CUTIL",16,0)
+ ; along with this program. If not, see .
"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!"
-"RTN","C0CUTIL",22,0)
- Q
-"RTN","C0CUTIL",23,0)
- ;
-"RTN","C0CUTIL",24,0)
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)
- N R,I,J,N
+ 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)
- 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)
+"RTN","C0CUTIL",28,0)
N I,J,ZS
-"RTN","C0CUTIL",32,0)
+"RTN","C0CUTIL",29,0)
S ZS="0123456789abcdef" S J=""
-"RTN","C0CUTIL",33,0)
+"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",34,0)
+"RTN","C0CUTIL",31,0)
Q J
-"RTN","C0CUTIL",35,0)
+"RTN","C0CUTIL",32,0)
;
-"RTN","C0CUTIL",36,0)
+"RTN","C0CUTIL",33,0)
FMDTOUTC(DATE,FORMAT) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrinsic
-"RTN","C0CUTIL",37,0)
+"RTN","C0CUTIL",34,0)
; FORMAT is Format of Date. Can be either D (Day) or DT (Date and Time)
-"RTN","C0CUTIL",38,0)
+"RTN","C0CUTIL",35,0)
; If not passed, or passed incorrectly, it's assumed that it is D.
-"RTN","C0CUTIL",39,0)
+"RTN","C0CUTIL",36,0)
; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied.
-"RTN","C0CUTIL",40,0)
+"RTN","C0CUTIL",37,0)
; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC
-"RTN","C0CUTIL",41,0)
+"RTN","C0CUTIL",38,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)
+"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",44,0)
+"RTN","C0CUTIL",41,0)
S M=$E(DATE,4,5)
-"RTN","C0CUTIL",45,0)
+"RTN","C0CUTIL",42,0)
S D=$E(DATE,6,7)
-"RTN","C0CUTIL",46,0)
+"RTN","C0CUTIL",43,0)
S H=$E(DATE,9,10)
-"RTN","C0CUTIL",47,0)
+"RTN","C0CUTIL",44,0)
I $L(H)=1 S H="0"_H
-"RTN","C0CUTIL",48,0)
+"RTN","C0CUTIL",45,0)
S MM=$E(DATE,11,12)
-"RTN","C0CUTIL",49,0)
+"RTN","C0CUTIL",46,0)
I $L(MM)=1 S MM="0"_MM
-"RTN","C0CUTIL",50,0)
+"RTN","C0CUTIL",47,0)
S S=$E(DATE,13,14)
-"RTN","C0CUTIL",51,0)
+"RTN","C0CUTIL",48,0)
I $L(S)=1 S S="0"_S
-"RTN","C0CUTIL",52,0)
+"RTN","C0CUTIL",49,0)
S OFF=$$TZ^XLFDT ; See Kernel Manual for documentation.
-"RTN","C0CUTIL",53,0)
+"RTN","C0CUTIL",50,0)
S OFFS=$E(OFF,1,1)
-"RTN","C0CUTIL",54,0)
+"RTN","C0CUTIL",51,0)
S OFF0=$TR(OFF,"+-")
-"RTN","C0CUTIL",55,0)
+"RTN","C0CUTIL",52,0)
S OFF1=$E(OFF0+10000,2,3)
-"RTN","C0CUTIL",56,0)
+"RTN","C0CUTIL",53,0)
S OFF2=$E(OFF0+10000,4,5)
-"RTN","C0CUTIL",57,0)
+"RTN","C0CUTIL",54,0)
S OFF=OFFS_OFF1_":"_OFF2
-"RTN","C0CUTIL",58,0)
+"RTN","C0CUTIL",55,0)
;S OFF2=$E(OFF,1,2) ;
-"RTN","C0CUTIL",59,0)
+"RTN","C0CUTIL",56,0)
;S OFF2=$E(100+OFF2,2,3) ; GPL 11/08 CHANGED TO -05:00 FORMAT
-"RTN","C0CUTIL",60,0)
+"RTN","C0CUTIL",57,0)
;S OFF3=$E(OFF,3,4) ;MINUTES
-"RTN","C0CUTIL",61,0)
+"RTN","C0CUTIL",58,0)
;S OFF=$S(OFF2="":"00",0:"00",1:OFF2)_"."_$S(OFF3="":"00",1:OFF3)
-"RTN","C0CUTIL",62,0)
+"RTN","C0CUTIL",59,0)
; If H, MM and S are empty, it means that the FM date didn't supply the time.
-"RTN","C0CUTIL",63,0)
+"RTN","C0CUTIL",60,0)
; In this case, set H, MM and S to "00"
-"RTN","C0CUTIL",64,0)
+"RTN","C0CUTIL",61,0)
; S:('$L(H)&'$L(MM)&'$L(S)) (H,MM,S)="00" ; IF ONLY SOME ARE MISSING?
-"RTN","C0CUTIL",65,0)
+"RTN","C0CUTIL",62,0)
S:'$L(H) H="00"
-"RTN","C0CUTIL",66,0)
+"RTN","C0CUTIL",63,0)
S:'$L(MM) MM="00"
-"RTN","C0CUTIL",67,0)
+"RTN","C0CUTIL",64,0)
S:'$L(S) S="00"
-"RTN","C0CUTIL",68,0)
+"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",69,0)
+"RTN","C0CUTIL",66,0)
I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time.
-"RTN","C0CUTIL",70,0)
+"RTN","C0CUTIL",67,0)
E Q $P(UTC,"T")
-"RTN","C0CUTIL",71,0)
+"RTN","C0CUTIL",68,0)
;
-"RTN","C0CUTIL",72,0)
+"RTN","C0CUTIL",69,0)
SORTDT(V1,V2,ORDR) ; DATE SORT ARRAY AND RETURN INDEX IN V1 AND COUNT
-"RTN","C0CUTIL",73,0)
+"RTN","C0CUTIL",70,0)
; AS EXTRINSIC ORDR IS 1 OR -1 FOR FORWARD OR REVERSE
-"RTN","C0CUTIL",74,0)
+"RTN","C0CUTIL",71,0)
; DATE AND TIME ORDER. DEFAULT IS FORWARD
-"RTN","C0CUTIL",75,0)
+"RTN","C0CUTIL",72,0)
; V2 IS AN ARRAY OF DATES IN FILEMAN FORMAT
-"RTN","C0CUTIL",76,0)
+"RTN","C0CUTIL",73,0)
; V1 IS RETURNS INDIRECT INDEXES OF V2 IN REVERSE DATE ORDER
-"RTN","C0CUTIL",77,0)
+"RTN","C0CUTIL",74,0)
; SO V2(V1(X)) WILL RETURN THE DATES IN DATE/TIME ORDER
-"RTN","C0CUTIL",78,0)
+"RTN","C0CUTIL",75,0)
; THE COUNT OF THE DATES IS RETURNED AS AN EXTRINSIC
-"RTN","C0CUTIL",79,0)
+"RTN","C0CUTIL",76,0)
; BOTH V1 AND V2 ARE PASSED BY REFERENCE
-"RTN","C0CUTIL",80,0)
+"RTN","C0CUTIL",77,0)
N VSRT ; TEMP FOR HASHING DATES
-"RTN","C0CUTIL",81,0)
+"RTN","C0CUTIL",78,0)
N ZI,ZJ,ZTMP,ZCNT,ZP1,ZP2
-"RTN","C0CUTIL",82,0)
+"RTN","C0CUTIL",79,0)
S ZCNT=V2(0) ; COUNTING NUMBER OF DATES
-"RTN","C0CUTIL",83,0)
+"RTN","C0CUTIL",80,0)
F ZI=1:1:ZCNT D ; FOR EACH DATE IN THE ARRAY
-"RTN","C0CUTIL",84,0)
+"RTN","C0CUTIL",81,0)
. I $D(V2(ZI)) D ; IF THE DATE EXISTS
-"RTN","C0CUTIL",85,0)
+"RTN","C0CUTIL",82,0)
. . S ZP1=$P(V2(ZI),".",1) ; THE DATE PIECE
-"RTN","C0CUTIL",86,0)
+"RTN","C0CUTIL",83,0)
. . S ZP2=$P(V2(ZI),".",2) ; THE TIME PIECE
-"RTN","C0CUTIL",87,0)
+"RTN","C0CUTIL",84,0)
. . ; W "DATE: ",ZP1," TIME: ",ZP2,!
-"RTN","C0CUTIL",88,0)
+"RTN","C0CUTIL",85,0)
. . S VSRT(ZP1,ZP2,ZI)=ZI ; INDEX OF DATE, TIME AND COUNT
-"RTN","C0CUTIL",89,0)
+"RTN","C0CUTIL",86,0)
N ZG
-"RTN","C0CUTIL",90,0)
+"RTN","C0CUTIL",87,0)
S ZG=$Q(VSRT(""))
-"RTN","C0CUTIL",91,0)
+"RTN","C0CUTIL",88,0)
F D Q:ZG="" ;
-"RTN","C0CUTIL",92,0)
+"RTN","C0CUTIL",89,0)
. ; W ZG,!
-"RTN","C0CUTIL",93,0)
+"RTN","C0CUTIL",90,0)
. D PUSH^C0CXPATH("V1",@ZG)
-"RTN","C0CUTIL",94,0)
+"RTN","C0CUTIL",91,0)
. S ZG=$Q(@ZG)
-"RTN","C0CUTIL",95,0)
+"RTN","C0CUTIL",92,0)
I ORDR=-1 D ; HAVE TO REVERSE ORDER
-"RTN","C0CUTIL",96,0)
+"RTN","C0CUTIL",93,0)
. N ZG2
-"RTN","C0CUTIL",97,0)
+"RTN","C0CUTIL",94,0)
. F ZI=1:1:V1(0) D ; FOR EACH ELELMENT
-"RTN","C0CUTIL",98,0)
+"RTN","C0CUTIL",95,0)
. . S ZG2(V1(0)-ZI+1)=V1(ZI) ; SET IN REVERSE ORDER
-"RTN","C0CUTIL",99,0)
+"RTN","C0CUTIL",96,0)
. S ZG2(0)=V1(0)
-"RTN","C0CUTIL",100,0)
+"RTN","C0CUTIL",97,0)
. D CP^C0CXPATH("ZG2","V1") ; COPY OVER THE NEW ARRAY
-"RTN","C0CUTIL",101,0)
+"RTN","C0CUTIL",98,0)
Q ZCNT
-"RTN","C0CUTIL",102,0)
+"RTN","C0CUTIL",99,0)
;
-"RTN","C0CUTIL",103,0)
+"RTN","C0CUTIL",100,0)
DA2SNO(RTN,DNAME) ; LOOK UP DRUG ALLERGY CODE IN ^LEX
-"RTN","C0CUTIL",104,0)
+"RTN","C0CUTIL",101,0)
; RETURNS AN ARRAY RTN PASSED BY REFERENCE
-"RTN","C0CUTIL",105,0)
+"RTN","C0CUTIL",102,0)
; THIS ROUTINE CAN BE USED AS AN RPC
-"RTN","C0CUTIL",106,0)
+"RTN","C0CUTIL",103,0)
; RTN(0) IS THE NUMBER OF ELEMENTS IN THE ARRAY
-"RTN","C0CUTIL",107,0)
+"RTN","C0CUTIL",104,0)
; RTN(1) IS THE SNOMED CODE FOR THE DRUG ALLERGY
-"RTN","C0CUTIL",108,0)
+"RTN","C0CUTIL",105,0)
;
-"RTN","C0CUTIL",109,0)
+"RTN","C0CUTIL",106,0)
N LEXIEN
-"RTN","C0CUTIL",110,0)
+"RTN","C0CUTIL",107,0)
I $O(^LEX(757.21,"ADIS",DNAME,""))'="" D ; IEN FOUND FOR THIS DRUG
-"RTN","C0CUTIL",111,0)
+"RTN","C0CUTIL",108,0)
. S LEXIEN=$O(^LEX(757.21,"ADIS",DNAME,"")) ; GET THE IEN IN THE LEXICON
-"RTN","C0CUTIL",112,0)
+"RTN","C0CUTIL",109,0)
. W LEXIEN,!
-"RTN","C0CUTIL",113,0)
+"RTN","C0CUTIL",110,0)
. S RTN(1)=$P(^LEX(757.02,LEXIEN,0),"^",2) ; SNOMED CODE IN P2
-"RTN","C0CUTIL",114,0)
+"RTN","C0CUTIL",111,0)
. S RTN(0)=1 ; ONE THING RETURNED
-"RTN","C0CUTIL",115,0)
+"RTN","C0CUTIL",112,0)
E S RTN(0)=0 ; NOT FOUND
-"RTN","C0CUTIL",116,0)
+"RTN","C0CUTIL",113,0)
Q
-"RTN","C0CUTIL",117,0)
+"RTN","C0CUTIL",114,0)
;
-"RTN","C0CUTIL",118,0)
+"RTN","C0CUTIL",115,0)
DASNO(DANAME) ; PRINTS THE SNOMED CODE FOR ALLERGY TO DRUG DANAME
-"RTN","C0CUTIL",119,0)
+"RTN","C0CUTIL",116,0)
;
-"RTN","C0CUTIL",120,0)
+"RTN","C0CUTIL",117,0)
N DARTN
-"RTN","C0CUTIL",121,0)
+"RTN","C0CUTIL",118,0)
D DA2SNO(.DARTN,DANAME) ; CALL THE LOOKUP ROUTINE
-"RTN","C0CUTIL",122,0)
+"RTN","C0CUTIL",119,0)
I DARTN(0)>0 D ; GOT RESULTS
-"RTN","C0CUTIL",123,0)
+"RTN","C0CUTIL",120,0)
. W !,DARTN(1) ;PRINT THE SNOMED CODE
-"RTN","C0CUTIL",124,0)
+"RTN","C0CUTIL",121,0)
E W !,"NOT FOUND",!
-"RTN","C0CUTIL",125,0)
+"RTN","C0CUTIL",122,0)
Q
-"RTN","C0CUTIL",126,0)
+"RTN","C0CUTIL",123,0)
;
-"RTN","C0CUTIL",127,0)
+"RTN","C0CUTIL",124,0)
DASNALL(WHICH) ; ROUTINE TO EXAMINE THE ADIS INDEX IN LEX AND RETRIEVE ALL
-"RTN","C0CUTIL",128,0)
+"RTN","C0CUTIL",125,0)
; ASSOCIATED SNOMED CODES
-"RTN","C0CUTIL",129,0)
+"RTN","C0CUTIL",126,0)
N DASTMP,DASIEN,DASNO
-"RTN","C0CUTIL",130,0)
+"RTN","C0CUTIL",127,0)
S DASTMP=""
-"RTN","C0CUTIL",131,0)
+"RTN","C0CUTIL",128,0)
F S DASTMP=$O(^LEX(757.21,WHICH,DASTMP)) Q:DASTMP="" D ; NAME OF MED
-"RTN","C0CUTIL",132,0)
+"RTN","C0CUTIL",129,0)
. S DASIEN=$O(^LEX(757.21,WHICH,DASTMP,"")) ; IEN OF MED
-"RTN","C0CUTIL",133,0)
+"RTN","C0CUTIL",130,0)
. S DASNO=$P(^LEX(757.02,DASIEN,0),"^",2) ; SNOMED CODE FOR ENTRY
-"RTN","C0CUTIL",134,0)
+"RTN","C0CUTIL",131,0)
. W DASTMP,"=",DASNO,! ; PRINT IT OUT
-"RTN","C0CUTIL",135,0)
+"RTN","C0CUTIL",132,0)
Q
-"RTN","C0CUTIL",136,0)
+"RTN","C0CUTIL",133,0)
;
-"RTN","C0CUTIL",137,0)
+"RTN","C0CUTIL",134,0)
RXNFN() Q 1130590011.001 ; RxNorm Concepts file number
-"RTN","C0CUTIL",138,0)
+"RTN","C0CUTIL",135,0)
;
-"RTN","C0CUTIL",139,0)
+"RTN","C0CUTIL",136,0)
CODE(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF
-"RTN","C0CUTIL",140,0)
+"RTN","C0CUTIL",137,0)
; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR
-"RTN","C0CUTIL",141,0)
+"RTN","C0CUTIL",138,0)
N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT
-"RTN","C0CUTIL",142,0)
+"RTN","C0CUTIL",139,0)
I $G(ZVUID)="" Q ""
-"RTN","C0CUTIL",143,0)
+"RTN","C0CUTIL",140,0)
I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED
-"RTN","C0CUTIL",144,0)
+"RTN","C0CUTIL",141,0)
N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID")
-"RTN","C0CUTIL",145,0)
+"RTN","C0CUTIL",142,0)
S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES
-"RTN","C0CUTIL",146,0)
+"RTN","C0CUTIL",143,0)
N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01)
-"RTN","C0CUTIL",147,0)
+"RTN","C0CUTIL",144,0)
S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED
-"RTN","C0CUTIL",148,0)
+"RTN","C0CUTIL",145,0)
I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F"
-"RTN","C0CUTIL",149,0)
+"RTN","C0CUTIL",146,0)
Q ZRSLT
-"RTN","C0CUTIL",150,0)
+"RTN","C0CUTIL",147,0)
;
-"RTN","C0CUTIL",151,0)
+"RTN","C0CUTIL",148,0)
NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO
-"RTN","C0CUTIL",152,0)
+"RTN","C0CUTIL",149,0)
; CONFORM TO NIST REQUIREMENTS
-"RTN","C0CUTIL",153,0)
+"RTN","C0CUTIL",150,0)
;INPATIENT CERTIFICATION
-"RTN","C0CUTIL",154,0)
+"RTN","C0CUTIL",151,0)
I ZRXN=309362 S ZRXN=213169
-"RTN","C0CUTIL",155,0)
+"RTN","C0CUTIL",152,0)
I ZRXN=855318 S ZRXN=855320
-"RTN","C0CUTIL",156,0)
+"RTN","C0CUTIL",153,0)
I ZRXN=197361 S ZRXN=212549
-"RTN","C0CUTIL",157,0)
+"RTN","C0CUTIL",154,0)
;OUTPATIENT CERTIFICATION
-"RTN","C0CUTIL",158,0)
+"RTN","C0CUTIL",155,0)
I ZRXN=310534 S ZRXN=205875
-"RTN","C0CUTIL",159,0)
+"RTN","C0CUTIL",156,0)
I ZRXN=617312 S ZRXN=617314
-"RTN","C0CUTIL",160,0)
+"RTN","C0CUTIL",157,0)
I ZRXN=310429 S ZRXN=200801
-"RTN","C0CUTIL",161,0)
+"RTN","C0CUTIL",158,0)
I ZRXN=628953 S ZRXN=628958
-"RTN","C0CUTIL",162,0)
+"RTN","C0CUTIL",159,0)
I ZRXN=745679 S ZRXN=630208
-"RTN","C0CUTIL",163,0)
+"RTN","C0CUTIL",160,0)
I ZRXN=311564 S ZRXN=979334
-"RTN","C0CUTIL",164,0)
+"RTN","C0CUTIL",161,0)
I ZRXN=836343 S ZRXN=836370
-"RTN","C0CUTIL",165,0)
+"RTN","C0CUTIL",162,0)
Q ZRXN
-"RTN","C0CUTIL",166,0)
+"RTN","C0CUTIL",163,0)
;
-"RTN","C0CUTIL",167,0)
+"RTN","C0CUTIL",164,0)
RPMS() ; Are we running on an RPMS system rather than Vista?
-"RTN","C0CUTIL",168,0)
+"RTN","C0CUTIL",165,0)
Q $G(DUZ("AG"))="I" ; If User Agency is Indian Health Service
-"RTN","C0CUTIL",169,0)
+"RTN","C0CUTIL",166,0)
VISTA() ; Are we running on Vanilla Vista?
-"RTN","C0CUTIL",170,0)
+"RTN","C0CUTIL",167,0)
Q $G(DUZ("AG"))="V" ; If User Agency is VA
-"RTN","C0CUTIL",171,0)
+"RTN","C0CUTIL",168,0)
WV() ; Are we running on WorldVista?
-"RTN","C0CUTIL",172,0)
+"RTN","C0CUTIL",169,0)
Q $G(DUZ("AG"))="E" ; Code for WV.
-"RTN","C0CUTIL",173,0)
+"RTN","C0CUTIL",170,0)
OV() ; Are we running on OpenVista?
-"RTN","C0CUTIL",174,0)
+"RTN","C0CUTIL",171,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 .
"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.
-"RTN","C0CVA200",19,0)
- Q
-"RTN","C0CVA200",20,0)
- ; This routine uses Kernel APIs and Direct Global Access to get
-"RTN","C0CVA200",21,0)
- ; Proivder Data from File 200.
-"RTN","C0CVA200",22,0)
;
-"RTN","C0CVA200",23,0)
+"RTN","C0CVA200",18,0)
+ Q
+"RTN","C0CVA200",19,0)
+ ; This routine uses Kernel APIs and Direct Global Access to get
+"RTN","C0CVA200",20,0)
+ ; Proivder Data from File 200.
+"RTN","C0CVA200",21,0)
+ ;
+"RTN","C0CVA200",22,0)
; The Global is VA(200,*)
+"RTN","C0CVA200",23,0)
+ ;
"RTN","C0CVA200",24,0)
- ;
-"RTN","C0CVA200",25,0)
FAMILY(DUZ) ; Get Family Name; PUBLIC; EXTRINSIC
-"RTN","C0CVA200",26,0)
+"RTN","C0CVA200",25,0)
; INPUT: DUZ (i.e. File 200 IEN) ByVal
+"RTN","C0CVA200",26,0)
+ ; OUTPUT: String
"RTN","C0CVA200",27,0)
- ; OUTPUT: String
+ N NAME S NAME=$P(^VA(200,DUZ,0),U)
"RTN","C0CVA200",28,0)
- N NAME S NAME=$P(^VA(200,DUZ,0),U)
+ D NAMECOMP^XLFNAME(.NAME)
"RTN","C0CVA200",29,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","C0CVA200",30,0)
Q NAME("FAMILY")
+"RTN","C0CVA200",30,0)
+ ;
"RTN","C0CVA200",31,0)
- ;
-"RTN","C0CVA200",32,0)
GIVEN(DUZ) ; Get Given Name; PUBLIC; EXTRINSIC
+"RTN","C0CVA200",32,0)
+ ; INPUT: DUZ ByVal
"RTN","C0CVA200",33,0)
- ; INPUT: DUZ ByVal
+ ; OUTPUT: String
"RTN","C0CVA200",34,0)
- ; OUTPUT: String
+ N NAME S NAME=$P(^VA(200,DUZ,0),U)
"RTN","C0CVA200",35,0)
- N NAME S NAME=$P(^VA(200,DUZ,0),U)
+ D NAMECOMP^XLFNAME(.NAME)
"RTN","C0CVA200",36,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","C0CVA200",37,0)
Q NAME("GIVEN")
+"RTN","C0CVA200",37,0)
+ ;
"RTN","C0CVA200",38,0)
- ;
-"RTN","C0CVA200",39,0)
MIDDLE(DUZ) ; Get Middle Name, PUBLIC; EXTRINSIC
+"RTN","C0CVA200",39,0)
+ ; INPUT: DUZ ByVal
"RTN","C0CVA200",40,0)
- ; INPUT: DUZ ByVal
+ ; OUTPUT: String
"RTN","C0CVA200",41,0)
- ; OUTPUT: String
+ N NAME S NAME=$P(^VA(200,DUZ,0),U)
"RTN","C0CVA200",42,0)
- N NAME S NAME=$P(^VA(200,DUZ,0),U)
+ D NAMECOMP^XLFNAME(.NAME)
"RTN","C0CVA200",43,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","C0CVA200",44,0)
Q NAME("MIDDLE")
+"RTN","C0CVA200",44,0)
+ ;
"RTN","C0CVA200",45,0)
- ;
-"RTN","C0CVA200",46,0)
SUFFIX(DUZ) ; Get Suffix Name, PUBLIC; EXTRINSIC
+"RTN","C0CVA200",46,0)
+ ; INPUT: DUZ ByVal
"RTN","C0CVA200",47,0)
- ; INPUT: DUZ ByVal
+ ; OUTPUT: String
"RTN","C0CVA200",48,0)
- ; OUTPUT: String
-"RTN","C0CVA200",49,0)
N NAME S NAME=$P(^VA(200,DUZ,0),U)
-"RTN","C0CVA200",50,0)
+"RTN","C0CVA200",49,0)
D NAMECOMP^XLFNAME(.NAME)
-"RTN","C0CVA200",51,0)
+"RTN","C0CVA200",50,0)
Q NAME("SUFFIX")
+"RTN","C0CVA200",51,0)
+ ;
"RTN","C0CVA200",52,0)
- ;
-"RTN","C0CVA200",53,0)
TITLE(DUZ) ; Get Title for Proivder, PUBLIC; EXTRINSIC
+"RTN","C0CVA200",53,0)
+ ; INPUT: DUZ ByVal
"RTN","C0CVA200",54,0)
- ; INPUT: DUZ ByVal
+ ; OUTPUT: String
"RTN","C0CVA200",55,0)
- ; OUTPUT: String
-"RTN","C0CVA200",56,0)
; Gets External Value of Title field in New Person File.
-"RTN","C0CVA200",57,0)
+"RTN","C0CVA200",56,0)
; It's actually a pointer to file 3.1
-"RTN","C0CVA200",58,0)
+"RTN","C0CVA200",57,0)
; 200=New Person File; 8 is Title Field
-"RTN","C0CVA200",59,0)
+"RTN","C0CVA200",58,0)
Q $$GET1^DIQ(200,DUZ_",",8)
+"RTN","C0CVA200",59,0)
+ ;
"RTN","C0CVA200",60,0)
- ;
-"RTN","C0CVA200",61,0)
NPI(DUZ) ; Get NPI Number, PUBLIC; EXTRINSIC
+"RTN","C0CVA200",61,0)
+ ; INPUT: DUZ ByVal
"RTN","C0CVA200",62,0)
- ; INPUT: DUZ ByVal
-"RTN","C0CVA200",63,0)
; OUTPUT: Delimited String in format:
-"RTN","C0CVA200",64,0)
+"RTN","C0CVA200",63,0)
; IDType^ID^IDDescription
-"RTN","C0CVA200",65,0)
+"RTN","C0CVA200",64,0)
; If the NPI doesn't exist, "" is returned.
-"RTN","C0CVA200",66,0)
+"RTN","C0CVA200",65,0)
; This routine uses a call documented in the Kernel dev guide
-"RTN","C0CVA200",67,0)
+"RTN","C0CVA200",66,0)
; This call returns as "NPI^TimeEntered^ActiveInactive"
-"RTN","C0CVA200",68,0)
+"RTN","C0CVA200",67,0)
; It returns -1 for NPI if NPI doesn't exist.
-"RTN","C0CVA200",69,0)
+"RTN","C0CVA200",68,0)
N NPI S NPI=$P($$NPI^XUSNPI("Individual_ID",DUZ),U)
-"RTN","C0CVA200",70,0)
+"RTN","C0CVA200",69,0)
Q:NPI=-1 ""
-"RTN","C0CVA200",71,0)
+"RTN","C0CVA200",70,0)
Q "NPI^"_NPI_"^HHS"
+"RTN","C0CVA200",71,0)
+ ;
"RTN","C0CVA200",72,0)
- ;
-"RTN","C0CVA200",73,0)
SPEC(DUZ) ; Get Provider Specialty, PUBLIC; EXTRINSIC
+"RTN","C0CVA200",73,0)
+ ; INPUT: DUZ ByVal
"RTN","C0CVA200",74,0)
- ; INPUT: DUZ ByVal
-"RTN","C0CVA200",75,0)
; OUTPUT: String: ProviderType/Specialty/Subspecialty OR ""
-"RTN","C0CVA200",76,0)
+"RTN","C0CVA200",75,0)
; Uses a Kernel API. Returns -1 if a specialty is not specified
-"RTN","C0CVA200",77,0)
+"RTN","C0CVA200",76,0)
; in file 200.
-"RTN","C0CVA200",78,0)
+"RTN","C0CVA200",77,0)
; Otherwise, returns IEN^Profession^Specialty^SubÂspecialty^Effect date^Expired date^VA code
-"RTN","C0CVA200",79,0)
+"RTN","C0CVA200",78,0)
N STR S STR=$$GET^XUA4A72(DUZ)
-"RTN","C0CVA200",80,0)
+"RTN","C0CVA200",79,0)
Q:+STR<0 ""
-"RTN","C0CVA200",81,0)
+"RTN","C0CVA200",80,0)
; Sometimes we have 3 pieces, or 2. Deal with that.
-"RTN","C0CVA200",82,0)
+"RTN","C0CVA200",81,0)
Q:$L($P(STR,U,4)) $P(STR,U,2)_"-"_$P(STR,U,3)_"-"_$P(STR,U,4)
-"RTN","C0CVA200",83,0)
+"RTN","C0CVA200",82,0)
Q $P(STR,U,2)_"-"_$P(STR,U,3)
+"RTN","C0CVA200",83,0)
+ ;
"RTN","C0CVA200",84,0)
- ;
-"RTN","C0CVA200",85,0)
ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC
-"RTN","C0CVA200",86,0)
+"RTN","C0CVA200",85,0)
; INPUT: DUZ, but not needed really... here for future expansion
-"RTN","C0CVA200",87,0)
+"RTN","C0CVA200",86,0)
; OUTPUT: At this point "Work"
-"RTN","C0CVA200",88,0)
+"RTN","C0CVA200",87,0)
Q "Work"
+"RTN","C0CVA200",88,0)
+ ;
"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",90,0)
+ ; INPUT: DUZ ByVal
"RTN","C0CVA200",91,0)
- ; INPUT: DUZ ByVal
+ ; Output: String.
"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)
+"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)
- N INST S INST=$P($$SITE^VASITE(),U)
+ ;
"RTN","C0CVA200",97,0)
- ;
-"RTN","C0CVA200",98,0)
; Second, get mailing address
-"RTN","C0CVA200",99,0)
+"RTN","C0CVA200",98,0)
; There are two APIs to get the address, one for physical and one for
-"RTN","C0CVA200",100,0)
+"RTN","C0CVA200",99,0)
; mailing. We will check if mailing exists first, since that's the
-"RTN","C0CVA200",101,0)
+"RTN","C0CVA200",100,0)
; one we want to use; then check for physical. If neither exists,
-"RTN","C0CVA200",102,0)
+"RTN","C0CVA200",101,0)
; then we return nothing. We check for the existence of an address
-"RTN","C0CVA200",103,0)
+"RTN","C0CVA200",102,0)
; by the length of the returned string.
-"RTN","C0CVA200",104,0)
+"RTN","C0CVA200",103,0)
; NOTE: API doesn't support Address 2, so I won't even include it
-"RTN","C0CVA200",105,0)
+"RTN","C0CVA200",104,0)
; in the template.
+"RTN","C0CVA200",105,0)
+ N ADD
"RTN","C0CVA200",106,0)
- N ADD
+ S ADD=$$MADD^XUAF4(INST) ; mailing address
"RTN","C0CVA200",107,0)
- S ADD=$$MADD^XUAF4(INST) ; mailing address
+ Q:$L(ADD) $P(ADD,U)
"RTN","C0CVA200",108,0)
- Q:$L(ADD) $P(ADD,U)
+ S ADD=$$PADD^XUAF4(INST) ; physical address
"RTN","C0CVA200",109,0)
- S ADD=$$PADD^XUAF4(INST) ; physical address
-"RTN","C0CVA200",110,0)
Q:$L(ADD) $P(ADD,U)
+"RTN","C0CVA200",110,0)
+ Q ""
"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)
+"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)
- ; INPUT: DUZ ByVal
+ ; Output: String.
"RTN","C0CVA200",116,0)
- ; Output: String.
+ ; See ADD1 for comments
"RTN","C0CVA200",117,0)
- ; See ADD1 for comments
+ N INST S INST=$P($$SITE^VASITE(),U)
"RTN","C0CVA200",118,0)
- N INST S INST=$P($$SITE^VASITE(),U)
+ N ADD
"RTN","C0CVA200",119,0)
- N ADD
+ S ADD=$$MADD^XUAF4(INST) ; mailing address
"RTN","C0CVA200",120,0)
- S ADD=$$MADD^XUAF4(INST) ; mailing address
+ Q:$L(ADD) $P(ADD,U,2)
"RTN","C0CVA200",121,0)
- Q:$L(ADD) $P(ADD,U,2)
+ S ADD=$$PADD^XUAF4(INST) ; physical address
"RTN","C0CVA200",122,0)
- S ADD=$$PADD^XUAF4(INST) ; physical address
-"RTN","C0CVA200",123,0)
Q:$L(ADD) $P(ADD,U,2)
+"RTN","C0CVA200",123,0)
+ Q ""
"RTN","C0CVA200",124,0)
- Q ""
+ ;
"RTN","C0CVA200",125,0)
- ;
-"RTN","C0CVA200",126,0)
STATE(ADUZ) ; Get State for Institution. PUBLIC; EXTRINSIC
+"RTN","C0CVA200",126,0)
+ ; INPUT: DUZ ByVal
"RTN","C0CVA200",127,0)
- ; INPUT: DUZ ByVal
-"RTN","C0CVA200",128,0)
; Output: String.
+"RTN","C0CVA200",128,0)
+ ; See ADD1 for comments
"RTN","C0CVA200",129,0)
- ; See ADD1 for comments
+ N INST S INST=$P($$SITE^VASITE(),U)
"RTN","C0CVA200",130,0)
- N INST S INST=$P($$SITE^VASITE(),U)
+ N ADD
"RTN","C0CVA200",131,0)
- N ADD
+ S ADD=$$MADD^XUAF4(INST) ; mailing address
"RTN","C0CVA200",132,0)
- S ADD=$$MADD^XUAF4(INST) ; mailing address
+ Q:$L(ADD) $P(ADD,U,3)
"RTN","C0CVA200",133,0)
- Q:$L(ADD) $P(ADD,U,3)
+ S ADD=$$PADD^XUAF4(INST) ; physical address
"RTN","C0CVA200",134,0)
- S ADD=$$PADD^XUAF4(INST) ; physical address
-"RTN","C0CVA200",135,0)
Q:$L(ADD) $P(ADD,U,3)
+"RTN","C0CVA200",135,0)
+ Q ""
"RTN","C0CVA200",136,0)
- Q ""
+ ;
"RTN","C0CVA200",137,0)
- ;
-"RTN","C0CVA200",138,0)
POSTCODE(ADUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC
+"RTN","C0CVA200",138,0)
+ ; INPUT: DUZ ByVal
"RTN","C0CVA200",139,0)
- ; INPUT: DUZ ByVal
+ ; OUTPUT: String.
"RTN","C0CVA200",140,0)
- ; OUTPUT: String.
-"RTN","C0CVA200",141,0)
; See ADD1 for comments
-"RTN","C0CVA200",142,0)
+"RTN","C0CVA200",141,0)
N INST S INST=$P($$SITE^VASITE(),U)
-"RTN","C0CVA200",143,0)
+"RTN","C0CVA200",142,0)
N ADD
-"RTN","C0CVA200",144,0)
+"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)
- Q:$L(ADD) $P(ADD,U,4)
-"RTN","C0CVA200",146,0)
S ADD=$$PADD^XUAF4(INST) ; physical address
-"RTN","C0CVA200",147,0)
+"RTN","C0CVA200",146,0)
Q:$L(ADD) $P(ADD,U,4)
-"RTN","C0CVA200",148,0)
+"RTN","C0CVA200",147,0)
Q ""
+"RTN","C0CVA200",148,0)
+ ;
"RTN","C0CVA200",149,0)
- ;
-"RTN","C0CVA200",150,0)
TEL(DUZ) ; Get Office Phone number. PUBLIC; EXTRINSIC
+"RTN","C0CVA200",150,0)
+ ; INPUT: DUZ ByVal
"RTN","C0CVA200",151,0)
- ; INPUT: DUZ ByVal
+ ; OUTPUT: String.
"RTN","C0CVA200",152,0)
- ; OUTPUT: String.
+ ; Direct global access
"RTN","C0CVA200",153,0)
- ; Direct global access
-"RTN","C0CVA200",154,0)
N TEL S TEL=$G(^VA(200,DUZ,.13))
-"RTN","C0CVA200",155,0)
+"RTN","C0CVA200",154,0)
Q $P(TEL,U,2)
+"RTN","C0CVA200",155,0)
+ ;
"RTN","C0CVA200",156,0)
- ;
-"RTN","C0CVA200",157,0)
TELTYPE(DUZ) ; Get Telephone Type. PUBLIC; EXTRINSIC
+"RTN","C0CVA200",157,0)
+ ; INPUT: DUZ ByVal
"RTN","C0CVA200",158,0)
- ; INPUT: DUZ ByVal
-"RTN","C0CVA200",159,0)
; OUTPUT: String.
-"RTN","C0CVA200",160,0)
+"RTN","C0CVA200",159,0)
Q "Office"
-"RTN","C0CVA200",161,0)
+"RTN","C0CVA200",160,0)
;
-"RTN","C0CVA200",162,0)
+"RTN","C0CVA200",161,0)
EMAIL(DUZ) ; Get Provider's Email. PUBLIC; EXTRINSIC
-"RTN","C0CVA200",163,0)
+"RTN","C0CVA200",162,0)
; INPUT: DUZ ByVal
-"RTN","C0CVA200",164,0)
+"RTN","C0CVA200",163,0)
; OUTPUT: String
-"RTN","C0CVA200",165,0)
+"RTN","C0CVA200",164,0)
; Direct global access
-"RTN","C0CVA200",166,0)
+"RTN","C0CVA200",165,0)
N EMAIL S EMAIL=$G(^VA(200,DUZ,.15))
-"RTN","C0CVA200",167,0)
+"RTN","C0CVA200",166,0)
Q $P(EMAIL,U)
-"RTN","C0CVA200",168,0)
+"RTN","C0CVA200",167,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)
- S ^TMP("C0CCCR","LABLIMIT")="",^TMP("C0CCCR","VITLIMIT")="",^TMP("C0CCCR","MEDLIMIT")="",^TMP("C0CCCR","TIULIMIT")=""
+ ; (C) RUT 2011.
"RTN","C0CVALID",4,0)
- S %DT="AEX",%DT("A")="LAB Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","LABLIMIT")=Y
+ ;
"RTN","C0CVALID",5,0)
- S %DT="AEX",%DT("A")="VITAL Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","VITLIMIT")=Y
+ ; This program is free software: you can redistribute it and/or modify
"RTN","C0CVALID",6,0)
- S %DT="AEX",%DT("A")="MEDICATION Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","MEDLIMIT")=Y
+ ; it under the terms of the GNU Affero General Public License as
"RTN","C0CVALID",7,0)
- ;S ^TMP("C0CCCR","RALIMIT")="",%DT="AEX",%DT("A")="RADIOLOGY Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","RALIMIT")=Y
+ ; published by the Free Software Foundation, either version 3 of the
"RTN","C0CVALID",8,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
+ ; License, or (at your option) any later version.
"RTN","C0CVALID",9,0)
- Q
+ ;
"RTN","C0CVALID",10,0)
-HTOF(FLAGS) ;Changing DATE in FILMAN's FORMAT
+ ; This program is distributed in the hope that it will be useful,
"RTN","C0CVALID",11,0)
- N HORLOGDATECUR,COVDATE,HORLOGDATE,FDATE
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0CVALID",12,0)
- S HORLOGDATECUR=$P($H,",",1)
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
"RTN","C0CVALID",13,0)
- S COVDATE=$P(FLAGS,"-",2)
+ ; GNU Affero General Public License for more details.
"RTN","C0CVALID",14,0)
- S HORLOGDATE=HORLOGDATECUR-COVDATE
+ ;
"RTN","C0CVALID",15,0)
- S (FDATE)=$$H2F^XLFDT(HORLOGDATE)
+ ; You should have received a copy of the GNU Affero General Public License
"RTN","C0CVALID",16,0)
- K HORLOGDATECUR,COVDATE,HORLOGDATE
+ ; along with this program. If not, see .
"RTN","C0CVALID",17,0)
+ ;
+"RTN","C0CVALID",18,0)
+ S ^TMP("C0CCCR","LABLIMIT")="",^TMP("C0CCCR","VITLIMIT")="",^TMP("C0CCCR","MEDLIMIT")="",^TMP("C0CCCR","TIULIMIT")=""
+"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",20,0)
+ S %DT="AEX",%DT("A")="VITAL Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","VITLIMIT")=Y
+"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",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",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",24,0)
+ Q
+"RTN","C0CVALID",25,0)
+HTOF(FLAGS) ;Changing DATE in FILMAN's FORMAT
+"RTN","C0CVALID",26,0)
+ N HORLOGDATECUR,COVDATE,HORLOGDATE,FDATE
+"RTN","C0CVALID",27,0)
+ S HORLOGDATECUR=$P($H,",",1)
+"RTN","C0CVALID",28,0)
+ S COVDATE=$P(FLAGS,"-",2)
+"RTN","C0CVALID",29,0)
+ S HORLOGDATE=HORLOGDATECUR-COVDATE
+"RTN","C0CVALID",30,0)
+ S (FDATE)=$$H2F^XLFDT(HORLOGDATE)
+"RTN","C0CVALID",31,0)
+ K HORLOGDATECUR,COVDATE,HORLOGDATE
+"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.
-"RTN","C0CVIT2",16,0)
;
+"RTN","C0CVIT2",15,0)
+ ; You should have received a copy of the GNU Affero General Public License
+"RTN","C0CVIT2",16,0)
+ ; along with this program. If not, see .
"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)
- Q
+ ; VITXML AND VITOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
"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)
+"RTN","C0CVIT2",25,0)
; THAT GET PASSED TO *GET ROUTINES
-"RTN","C0CVIT2",29,0)
+"RTN","C0CVIT2",26,0)
;C0C[NAME]=$NA(^TMP("C0CCCR",$J,DFN,"C0C(NAME))
-"RTN","C0CVIT2",30,0)
+"RTN","C0CVIT2",27,0)
N C0CVIT
-"RTN","C0CVIT2",31,0)
+"RTN","C0CVIT2",28,0)
S C0CVIT=$NA(^TMP("C0CCCR",$J,DFN,"C0CVIT"))
-"RTN","C0CVIT2",32,0)
+"RTN","C0CVIT2",29,0)
; USE THE FOLLOWING TEMPLATE FOR GETTING/GENERATING THE RNF2 ARRAYS
-"RTN","C0CVIT2",33,0)
+"RTN","C0CVIT2",30,0)
; THAT GET INSERTED INTO THE XML TEMPLATE
-"RTN","C0CVIT2",34,0)
+"RTN","C0CVIT2",31,0)
; D GET[VISTA/RPMS](DFN,C0CIMM) ; GET VARS
-"RTN","C0CVIT2",35,0)
+"RTN","C0CVIT2",32,0)
I $$RPMS^C0CUTIL() D GETRPMS(DFN,C0CVIT) ; GET VARS
-"RTN","C0CVIT2",36,0)
+"RTN","C0CVIT2",33,0)
I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D GETVISTA(DFN,C0CVIT)
-"RTN","C0CVIT2",37,0)
+"RTN","C0CVIT2",34,0)
; USE THE FOLLOWING TEMPATE FOR MAPPING RNF2 ARRAYS TO XML TEMPLATE
-"RTN","C0CVIT2",38,0)
+"RTN","C0CVIT2",35,0)
; D MAP([NAME]XML,C0C[NAME],[NAME]OUT) ;MAP RESULTS FOR PROCEDURES
-"RTN","C0CVIT2",39,0)
+"RTN","C0CVIT2",36,0)
D MAP(VITXML,C0CVIT,VITOUT) ;MAP RESULTS FOR PROCEDURES
-"RTN","C0CVIT2",40,0)
+"RTN","C0CVIT2",37,0)
Q
-"RTN","C0CVIT2",41,0)
+"RTN","C0CVIT2",38,0)
;
-"RTN","C0CVIT2",42,0)
+"RTN","C0CVIT2",39,0)
GETVISTA(DFN,C0CVIT) ; CALLS VITALS^ORQQVI TO GET VITAL SIGNS.
-"RTN","C0CVIT2",43,0)
+"RTN","C0CVIT2",40,0)
; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
-"RTN","C0CVIT2",44,0)
+"RTN","C0CVIT2",41,0)
; C0CVIT: VITAL SIGNS
-"RTN","C0CVIT2",45,0)
+"RTN","C0CVIT2",42,0)
; READY TO BE MAPPED TO XML BY MAP^C0CVIT2
-"RTN","C0CVIT2",46,0)
+"RTN","C0CVIT2",43,0)
; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY
-"RTN","C0CVIT2",47,0)
+"RTN","C0CVIT2",44,0)
; EXIST.
-"RTN","C0CVIT2",48,0)
+"RTN","C0CVIT2",45,0)
;
-"RTN","C0CVIT2",49,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)
- ; SETUP RPC/API CALL HERE
-"RTN","C0CVIT2",52,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",52,0)
; RPC REQUIRES FM DATES NOT T-* DATES
-"RTN","C0CVIT2",56,0)
+"RTN","C0CVIT2",53,0)
D DT^DILF(,$$GET^C0CPARMS("VITLIMIT"),.END) ; GET THE LIMIT PARM
-"RTN","C0CVIT2",57,0)
+"RTN","C0CVIT2",54,0)
D DT^DILF(,$$GET^C0CPARMS("VITSTART"),.START) ; GET START PARM
-"RTN","C0CVIT2",58,0)
+"RTN","C0CVIT2",55,0)
; RPC CALL (ORY,DFN,ORSDT,OREDT):
-"RTN","C0CVIT2",59,0)
+"RTN","C0CVIT2",56,0)
;ORY: return variable
-"RTN","C0CVIT2",60,0)
+"RTN","C0CVIT2",57,0)
;DFN: patient identifier from Patient File [#2]
-"RTN","C0CVIT2",61,0)
+"RTN","C0CVIT2",58,0)
;ORSDT: start date/time in Fileman format
-"RTN","C0CVIT2",62,0)
+"RTN","C0CVIT2",59,0)
;OREDT: end date/time in Fileman format
-"RTN","C0CVIT2",63,0)
+"RTN","C0CVIT2",60,0)
; OUTPUT FORMAT:
-"RTN","C0CVIT2",64,0)
+"RTN","C0CVIT2",61,0)
;vital measurement ien^vital type^rate^date/time taken
-"RTN","C0CVIT2",65,0)
+"RTN","C0CVIT2",62,0)
D VITALS^ORQQVI(.VIT,DFN,START,END) ; RUN QUERY VITALS CALL
-"RTN","C0CVIT2",66,0)
+"RTN","C0CVIT2",63,0)
I '$D(VIT) S @VITOUT@(0)=0 K VIT Q ; RETURN NOT FOUND, KILL ARRAY AND QUIT
-"RTN","C0CVIT2",67,0)
+"RTN","C0CVIT2",64,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)
+"RTN","C0CVIT2",65,0)
+ . I $D(VITOUT) S @VITOUT@(0)=0
+"RTN","C0CVIT2",66,0)
. K VIT
-"RTN","C0CVIT2",70,0)
+"RTN","C0CVIT2",67,0)
;
-"RTN","C0CVIT2",71,0)
+"RTN","C0CVIT2",68,0)
; PREFORM SORT HERE IF NEEDED
-"RTN","C0CVIT2",72,0)
+"RTN","C0CVIT2",69,0)
;
-"RTN","C0CVIT2",73,0)
+"RTN","C0CVIT2",70,0)
; SORT IS REQUIRED FOR VITAL SIGNS - LATEST VITALS NEED TO BE LISTED FIRST
-"RTN","C0CVIT2",74,0)
+"RTN","C0CVIT2",71,0)
; COPIED SORT LOGIC:
-"RTN","C0CVIT2",75,0)
+"RTN","C0CVIT2",72,0)
N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
-"RTN","C0CVIT2",76,0)
+"RTN","C0CVIT2",73,0)
D VITSORT(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
-"RTN","C0CVIT2",77,0)
+"RTN","C0CVIT2",74,0)
S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
-"RTN","C0CVIT2",78,0)
+"RTN","C0CVIT2",75,0)
; VSORT IS VITALS IN REVERSE ORDER
-"RTN","C0CVIT2",79,0)
+"RTN","C0CVIT2",76,0)
;
-"RTN","C0CVIT2",80,0)
+"RTN","C0CVIT2",77,0)
; MAP EACH ROW OF RPC/API TO RNF1 ARRAY
-"RTN","C0CVIT2",81,0)
+"RTN","C0CVIT2",78,0)
; RNF1 ARRAY FORMAT:
-"RTN","C0CVIT2",82,0)
+"RTN","C0CVIT2",79,0)
; VAR("NAME_OF_RIM_VARIABLE")=VALUE
-"RTN","C0CVIT2",83,0)
+"RTN","C0CVIT2",80,0)
;
-"RTN","C0CVIT2",84,0)
+"RTN","C0CVIT2",81,0)
; VITAL SIGNS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF VITAL SIGNS
-"RTN","C0CVIT2",85,0)
+"RTN","C0CVIT2",82,0)
; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD
-"RTN","C0CVIT2",86,0)
+"RTN","C0CVIT2",83,0)
; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS
-"RTN","C0CVIT2",87,0)
+"RTN","C0CVIT2",84,0)
N C0CVI,C0CC,ZRNF
-"RTN","C0CVIT2",88,0)
+"RTN","C0CVIT2",85,0)
;S C0CVI="" ; INITIALIZE FOR $O
-"RTN","C0CVIT2",89,0)
+"RTN","C0CVIT2",86,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",87,0)
. I DEBUG W VIT(C0CVI),!
-"RTN","C0CVIT2",91,0)
+"RTN","C0CVIT2",88,0)
. ; FIGURE OUT WHICH TYPE OF VITAL SIGN IT IS (HEIGHT, WEIGHT, BLOOD PRESSURE, TEMPERATURE, RESPIRATION, PULSE, PAIN, OTHER)
-"RTN","C0CVIT2",92,0)
+"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",93,0)
+"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",94,0)
+"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",95,0)
+"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",96,0)
+"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",97,0)
+"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",98,0)
+"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",99,0)
+"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",100,0)
+"RTN","C0CVIT2",97,0)
. D RNF1TO2^C0CRNF(C0CVIT,"ZRNF") ;ADD THIS ROW TO THE ARRAY
-"RTN","C0CVIT2",101,0)
+"RTN","C0CVIT2",98,0)
. K ZRNF
-"RTN","C0CVIT2",102,0)
+"RTN","C0CVIT2",99,0)
; SAVE RIM VARIABLES SEE C0CRIMA
-"RTN","C0CVIT2",103,0)
+"RTN","C0CVIT2",100,0)
N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"VITALS"))
-"RTN","C0CVIT2",104,0)
+"RTN","C0CVIT2",101,0)
M @ZRIM=@C0CVIT@("V")
-"RTN","C0CVIT2",105,0)
+"RTN","C0CVIT2",102,0)
Q
-"RTN","C0CVIT2",106,0)
+"RTN","C0CVIT2",103,0)
;
-"RTN","C0CVIT2",107,0)
+"RTN","C0CVIT2",104,0)
GETRPMS(DFN,C0CVIT) ; CALLS QUERY^BEHOVM TO GET VITAL SIGNS.
-"RTN","C0CVIT2",108,0)
+"RTN","C0CVIT2",105,0)
; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
-"RTN","C0CVIT2",109,0)
+"RTN","C0CVIT2",106,0)
; C0CVIT: VITAL SIGNS
-"RTN","C0CVIT2",110,0)
+"RTN","C0CVIT2",107,0)
; READY TO BE MAPPED TO XML BY MAP^C0CVIT2
-"RTN","C0CVIT2",111,0)
+"RTN","C0CVIT2",108,0)
; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY
-"RTN","C0CVIT2",112,0)
+"RTN","C0CVIT2",109,0)
; EXIST.
-"RTN","C0CVIT2",113,0)
+"RTN","C0CVIT2",110,0)
;
-"RTN","C0CVIT2",114,0)
+"RTN","C0CVIT2",111,0)
; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J))
+"RTN","C0CVIT2",112,0)
+ ;
+"RTN","C0CVIT2",113,0)
+ ; SETUP RPC/API CALL HERE
+"RTN","C0CVIT2",114,0)
+ ; USE START AND END DATES FROM PARAMETERS IF REQUIRED
"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)
+"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",121,0)
+"RTN","C0CVIT2",118,0)
N C0CEDT,C0CSDT,VIT,DATA,START,END
-"RTN","C0CVIT2",122,0)
+"RTN","C0CVIT2",119,0)
; RPC REQUIRES FM DATES NOT T-* DATES
-"RTN","C0CVIT2",123,0)
+"RTN","C0CVIT2",120,0)
D DT^DILF(,$$GET^C0CPARMS("VITLIMIT"),.END) ; GET THE LIMIT PARM
-"RTN","C0CVIT2",124,0)
+"RTN","C0CVIT2",121,0)
D DT^DILF(,$$GET^C0CPARMS("VITSTART"),.START) ; GET START PARM
-"RTN","C0CVIT2",125,0)
+"RTN","C0CVIT2",122,0)
; RPC OUTPUT FORMAT:
-"RTN","C0CVIT2",126,0)
+"RTN","C0CVIT2",123,0)
; vfile ien^vital name^vital abbr^date/time taken(FM FORMAT)^value+units (US & metric)
-"RTN","C0CVIT2",127,0)
+"RTN","C0CVIT2",124,0)
D QUERY^BEHOVM("LISTX") ; RUN QUERY VITALS CALL
-"RTN","C0CVIT2",128,0)
+"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",129,0)
+"RTN","C0CVIT2",126,0)
; MOVE THE ARRAY TO LOCAL VARIABLE
-"RTN","C0CVIT2",130,0)
+"RTN","C0CVIT2",127,0)
M VIT=^TMP("CIAVMRPC",$J,0)
-"RTN","C0CVIT2",131,0)
+"RTN","C0CVIT2",128,0)
; RPC CLEANUP
-"RTN","C0CVIT2",132,0)
+"RTN","C0CVIT2",129,0)
K ^TMP("CIAVMRPC",$J),VITS,RMAX,START,END,DATA,METRIC,VSTR,VUNT
-"RTN","C0CVIT2",133,0)
+"RTN","C0CVIT2",130,0)
;
-"RTN","C0CVIT2",134,0)
+"RTN","C0CVIT2",131,0)
; PREFORM SORT HERE IF NEEDED
-"RTN","C0CVIT2",135,0)
+"RTN","C0CVIT2",132,0)
;
-"RTN","C0CVIT2",136,0)
+"RTN","C0CVIT2",133,0)
; SORT IS REQUIRED FOR VITAL SIGNS - LATEST VITALS NEED TO BE LISTED FIRST
-"RTN","C0CVIT2",137,0)
+"RTN","C0CVIT2",134,0)
; COPIED SORT LOGIC:
-"RTN","C0CVIT2",138,0)
+"RTN","C0CVIT2",135,0)
N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
-"RTN","C0CVIT2",139,0)
+"RTN","C0CVIT2",136,0)
D VITSORT(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
-"RTN","C0CVIT2",140,0)
+"RTN","C0CVIT2",137,0)
S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
-"RTN","C0CVIT2",141,0)
+"RTN","C0CVIT2",138,0)
; VSORT IS VITALS IN REVERSE ORDER
-"RTN","C0CVIT2",142,0)
+"RTN","C0CVIT2",139,0)
;
-"RTN","C0CVIT2",143,0)
+"RTN","C0CVIT2",140,0)
; MAP EACH ROW OF RPC/API TO RNF1 ARRAY
-"RTN","C0CVIT2",144,0)
+"RTN","C0CVIT2",141,0)
; RNF1 ARRAY FORMAT:
-"RTN","C0CVIT2",145,0)
+"RTN","C0CVIT2",142,0)
; VAR("NAME_OF_RIM_VARIABLE")=VALUE
-"RTN","C0CVIT2",146,0)
+"RTN","C0CVIT2",143,0)
;
-"RTN","C0CVIT2",147,0)
+"RTN","C0CVIT2",144,0)
; VITAL SIGNS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF VITAL SIGNS
-"RTN","C0CVIT2",148,0)
+"RTN","C0CVIT2",145,0)
; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD
-"RTN","C0CVIT2",149,0)
+"RTN","C0CVIT2",146,0)
; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS
-"RTN","C0CVIT2",150,0)
+"RTN","C0CVIT2",147,0)
N C0CVI,C0CC,ZRNF
-"RTN","C0CVIT2",151,0)
+"RTN","C0CVIT2",148,0)
;S C0CVI="" ; INITIALIZE FOR $O
-"RTN","C0CVIT2",152,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",153,0)
+"RTN","C0CVIT2",150,0)
. I DEBUG W VIT(C0CVI),!
-"RTN","C0CVIT2",154,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",155,0)
+"RTN","C0CVIT2",152,0)
. D:$P(VIT(C0CVI),U,3)="HT" HEIGHT
-"RTN","C0CVIT2",156,0)
+"RTN","C0CVIT2",153,0)
. D:$P(VIT(C0CVI),U,3)="WT" WEIGHT
-"RTN","C0CVIT2",157,0)
+"RTN","C0CVIT2",154,0)
. D:$P(VIT(C0CVI),U,3)="BP" BP
-"RTN","C0CVIT2",158,0)
+"RTN","C0CVIT2",155,0)
. D:$P(VIT(C0CVI),U,3)="TMP" TMP
-"RTN","C0CVIT2",159,0)
+"RTN","C0CVIT2",156,0)
. D:$P(VIT(C0CVI),U,3)="RS" RESP
-"RTN","C0CVIT2",160,0)
+"RTN","C0CVIT2",157,0)
. D:$P(VIT(C0CVI),U,3)="PU" PULSE
-"RTN","C0CVIT2",161,0)
+"RTN","C0CVIT2",158,0)
. D:$P(VIT(C0CVI),U,3)="PA" PAIN
-"RTN","C0CVIT2",162,0)
+"RTN","C0CVIT2",159,0)
. D:'$D(ZRNF) OTHER ;IF THE VITAL ISN'T DEFINED IT IS OTHER
-"RTN","C0CVIT2",163,0)
+"RTN","C0CVIT2",160,0)
. D RNF1TO2^C0CRNF(C0CVIT,"ZRNF") ;ADD THIS ROW TO THE ARRAY
-"RTN","C0CVIT2",164,0)
+"RTN","C0CVIT2",161,0)
. K ZRNF
-"RTN","C0CVIT2",165,0)
+"RTN","C0CVIT2",162,0)
; SAVE RIM VARIABLES SEE C0CRIMA
-"RTN","C0CVIT2",166,0)
+"RTN","C0CVIT2",163,0)
N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"VITALS"))
-"RTN","C0CVIT2",167,0)
+"RTN","C0CVIT2",164,0)
M @ZRIM=@C0CVIT@("V")
+"RTN","C0CVIT2",165,0)
+ Q
+"RTN","C0CVIT2",166,0)
+ ;
+"RTN","C0CVIT2",167,0)
+HEIGHT ;
"RTN","C0CVIT2",168,0)
- Q
+ I DEBUG W "IN VITAL: HEIGHT",!
"RTN","C0CVIT2",169,0)
- ;
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID
"RTN","C0CVIT2",170,0)
-HEIGHT
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
"RTN","C0CVIT2",171,0)
- I DEBUG W "IN VITAL: HEIGHT",!
+ S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
"RTN","C0CVIT2",172,0)
- S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID
+ S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
"RTN","C0CVIT2",173,0)
- S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
"RTN","C0CVIT2",174,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
"RTN","C0CVIT2",175,0)
- S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVIT2",176,0)
- S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+ S ZRNF("VITALSIGNSDESCCODEVALUE")="248327008"
"RTN","C0CVIT2",177,0)
- S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
"RTN","C0CVIT2",178,0)
- S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+ S ZRNF("VITALSIGNSCODEVERSION")=""
"RTN","C0CVIT2",179,0)
- S ZRNF("VITALSIGNSDESCCODEVALUE")="248327008"
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
"RTN","C0CVIT2",180,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
"RTN","C0CVIT2",181,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
"RTN","C0CVIT2",182,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
+ Q
"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)
+WEIGHT ;
"RTN","C0CVIT2",185,0)
- Q
+ I DEBUG W "IN VITAL: WEIGHT",!
"RTN","C0CVIT2",186,0)
- ;
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
"RTN","C0CVIT2",187,0)
-WEIGHT
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
"RTN","C0CVIT2",188,0)
- I DEBUG W "IN VITAL: WEIGHT",!
+ S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
"RTN","C0CVIT2",189,0)
- S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
+ S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
"RTN","C0CVIT2",190,0)
- S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
"RTN","C0CVIT2",191,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
"RTN","C0CVIT2",192,0)
- S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVIT2",193,0)
- S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+ S ZRNF("VITALSIGNSDESCCODEVALUE")="107647005"
"RTN","C0CVIT2",194,0)
- S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
"RTN","C0CVIT2",195,0)
- S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+ S ZRNF("VITALSIGNSCODEVERSION")=""
"RTN","C0CVIT2",196,0)
- S ZRNF("VITALSIGNSDESCCODEVALUE")="107647005"
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
"RTN","C0CVIT2",197,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
"RTN","C0CVIT2",198,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
"RTN","C0CVIT2",199,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
+ Q
"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)
+BP ;
"RTN","C0CVIT2",202,0)
- Q
+ I DEBUG W "IN VITAL: BLOOD PRESSURE",!
"RTN","C0CVIT2",203,0)
- ;
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
"RTN","C0CVIT2",204,0)
-BP
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
"RTN","C0CVIT2",205,0)
- I DEBUG W "IN VITAL: BLOOD PRESSURE",!
+ S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
"RTN","C0CVIT2",206,0)
- S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
+ S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
"RTN","C0CVIT2",207,0)
- S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
"RTN","C0CVIT2",208,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
"RTN","C0CVIT2",209,0)
- S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVIT2",210,0)
- S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+ S ZRNF("VITALSIGNSDESCCODEVALUE")="392570002"
"RTN","C0CVIT2",211,0)
- S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
"RTN","C0CVIT2",212,0)
- S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+ S ZRNF("VITALSIGNSCODEVERSION")=""
"RTN","C0CVIT2",213,0)
- S ZRNF("VITALSIGNSDESCCODEVALUE")="392570002"
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
"RTN","C0CVIT2",214,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
"RTN","C0CVIT2",215,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
"RTN","C0CVIT2",216,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
+ Q
"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)
+TMP ;
"RTN","C0CVIT2",219,0)
- Q
+ I DEBUG W "IN VITAL: TEMPERATURE",!
"RTN","C0CVIT2",220,0)
- ;
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
"RTN","C0CVIT2",221,0)
-TMP
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
"RTN","C0CVIT2",222,0)
- I DEBUG W "IN VITAL: TEMPERATURE",!
+ S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
"RTN","C0CVIT2",223,0)
- S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
+ S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
"RTN","C0CVIT2",224,0)
- S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
"RTN","C0CVIT2",225,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
"RTN","C0CVIT2",226,0)
- S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVIT2",227,0)
- S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+ S ZRNF("VITALSIGNSDESCCODEVALUE")="309646008"
"RTN","C0CVIT2",228,0)
- S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
"RTN","C0CVIT2",229,0)
- S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+ S ZRNF("VITALSIGNSCODEVERSION")=""
"RTN","C0CVIT2",230,0)
- S ZRNF("VITALSIGNSDESCCODEVALUE")="309646008"
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
"RTN","C0CVIT2",231,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
"RTN","C0CVIT2",232,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
"RTN","C0CVIT2",233,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
+ Q
"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)
+RESP ;
"RTN","C0CVIT2",236,0)
- Q
+ I DEBUG W "IN VITAL: RESPIRATION",!
"RTN","C0CVIT2",237,0)
- ;
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
"RTN","C0CVIT2",238,0)
-RESP
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
"RTN","C0CVIT2",239,0)
- I DEBUG W "IN VITAL: RESPIRATION",!
+ S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
"RTN","C0CVIT2",240,0)
- S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
+ S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
"RTN","C0CVIT2",241,0)
- S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
"RTN","C0CVIT2",242,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
"RTN","C0CVIT2",243,0)
- S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVIT2",244,0)
- S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+ S ZRNF("VITALSIGNSDESCCODEVALUE")="366147009"
"RTN","C0CVIT2",245,0)
- S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
"RTN","C0CVIT2",246,0)
- S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+ S ZRNF("VITALSIGNSCODEVERSION")=""
"RTN","C0CVIT2",247,0)
- S ZRNF("VITALSIGNSDESCCODEVALUE")="366147009"
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
"RTN","C0CVIT2",248,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
"RTN","C0CVIT2",249,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
"RTN","C0CVIT2",250,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
+ Q
"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)
+PULSE ;
"RTN","C0CVIT2",253,0)
- Q
+ I DEBUG W "IN VITAL: PULSE",!
"RTN","C0CVIT2",254,0)
- ;
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
"RTN","C0CVIT2",255,0)
-PULSE
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
"RTN","C0CVIT2",256,0)
- I DEBUG W "IN VITAL: PULSE",!
+ S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
"RTN","C0CVIT2",257,0)
- S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
+ S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
"RTN","C0CVIT2",258,0)
- S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
"RTN","C0CVIT2",259,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
"RTN","C0CVIT2",260,0)
- S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVIT2",261,0)
- S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+ S ZRNF("VITALSIGNSDESCCODEVALUE")="366199006"
"RTN","C0CVIT2",262,0)
- S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
"RTN","C0CVIT2",263,0)
- S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+ S ZRNF("VITALSIGNSCODEVERSION")=""
"RTN","C0CVIT2",264,0)
- S ZRNF("VITALSIGNSDESCCODEVALUE")="366199006"
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
"RTN","C0CVIT2",265,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
"RTN","C0CVIT2",266,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
"RTN","C0CVIT2",267,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
+ Q
"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)
+PAIN ;
"RTN","C0CVIT2",270,0)
- Q
+ I DEBUG W "IN VITAL: PAIN",!
"RTN","C0CVIT2",271,0)
- ;
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
"RTN","C0CVIT2",272,0)
-PAIN
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
"RTN","C0CVIT2",273,0)
- I DEBUG W "IN VITAL: PAIN",!
+ S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
"RTN","C0CVIT2",274,0)
- S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
+ S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
"RTN","C0CVIT2",275,0)
- S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
"RTN","C0CVIT2",276,0)
- S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
"RTN","C0CVIT2",277,0)
- S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVIT2",278,0)
- S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+ S ZRNF("VITALSIGNSDESCCODEVALUE")="22253000"
"RTN","C0CVIT2",279,0)
- S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
"RTN","C0CVIT2",280,0)
- S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+ S ZRNF("VITALSIGNSCODEVERSION")=""
"RTN","C0CVIT2",281,0)
- S ZRNF("VITALSIGNSDESCCODEVALUE")="22253000"
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
"RTN","C0CVIT2",282,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
"RTN","C0CVIT2",283,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
"RTN","C0CVIT2",284,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
+ Q
"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)
+OTHER ;
"RTN","C0CVIT2",287,0)
- Q
+ I DEBUG W "IN VITAL: OTHER",!
"RTN","C0CVIT2",288,0)
- ;
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
"RTN","C0CVIT2",289,0)
-OTHER
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
"RTN","C0CVIT2",290,0)
- I DEBUG W "IN VITAL: OTHER",!
-"RTN","C0CVIT2",291,0)
- S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
-"RTN","C0CVIT2",292,0)
- S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",293,0)
S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
-"RTN","C0CVIT2",294,0)
+"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("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+ S ZRNF("VITALSIGNSDESCCODEVALUE")=""
"RTN","C0CVIT2",296,0)
- S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")=""
"RTN","C0CVIT2",297,0)
- S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+ S ZRNF("VITALSIGNSCODEVERSION")=""
"RTN","C0CVIT2",298,0)
- S ZRNF("VITALSIGNSDESCCODEVALUE")=""
-"RTN","C0CVIT2",299,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")=""
-"RTN","C0CVIT2",300,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)
+"RTN","C0CVIT2",299,0)
S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
-"RTN","C0CVIT2",303,0)
+"RTN","C0CVIT2",300,0)
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
-"RTN","C0CVIT2",304,0)
+"RTN","C0CVIT2",301,0)
Q
-"RTN","C0CVIT2",305,0)
+"RTN","C0CVIT2",302,0)
;
-"RTN","C0CVIT2",306,0)
+"RTN","C0CVIT2",303,0)
;TEMPORARY, THINKING ON HOW TO REFACTOR (CJE)
-"RTN","C0CVIT2",307,0)
-HEIGHT1(DT,ACTOR,VALUE,UNIT)
-"RTN","C0CVIT2",308,0)
+"RTN","C0CVIT2",304,0)
+HEIGHT1(DT,ACTOR,VALUE,UNIT) ;
+"RTN","C0CVIT2",305,0)
I DEBUG W "IN VITAL: HEIGHT",!
-"RTN","C0CVIT2",309,0)
+"RTN","C0CVIT2",306,0)
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID
-"RTN","C0CVIT2",310,0)
+"RTN","C0CVIT2",307,0)
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",311,0)
+"RTN","C0CVIT2",308,0)
S ZRNF("VITALSIGNSEXACTDATETIME")=DT
-"RTN","C0CVIT2",312,0)
+"RTN","C0CVIT2",309,0)
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
+"RTN","C0CVIT2",310,0)
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","C0CVIT2",311,0)
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+"RTN","C0CVIT2",312,0)
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"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",314,0)
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVIT2",315,0)
+ S ZRNF("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVIT2",316,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
"RTN","C0CVIT2",317,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
"RTN","C0CVIT2",318,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
"RTN","C0CVIT2",319,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
+ Q
"RTN","C0CVIT2",320,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
+ ;
"RTN","C0CVIT2",321,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
+WEIGHT1(DT,ACTOR,VALUE,UNIT) ;
"RTN","C0CVIT2",322,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",323,0)
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
+"RTN","C0CVIT2",324,0)
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",325,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=DT
"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",327,0)
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","C0CVIT2",328,0)
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+"RTN","C0CVIT2",329,0)
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"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",331,0)
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVIT2",332,0)
+ S ZRNF("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVIT2",333,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
"RTN","C0CVIT2",334,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
"RTN","C0CVIT2",335,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
"RTN","C0CVIT2",336,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
+ Q
"RTN","C0CVIT2",337,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
+ ;
"RTN","C0CVIT2",338,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
+BP1(DT,ACTOR,VALUE,UNIT) ;
"RTN","C0CVIT2",339,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",340,0)
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
+"RTN","C0CVIT2",341,0)
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",342,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=DT
"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",344,0)
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","C0CVIT2",345,0)
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+"RTN","C0CVIT2",346,0)
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"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",348,0)
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVIT2",349,0)
+ S ZRNF("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVIT2",350,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
"RTN","C0CVIT2",351,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
"RTN","C0CVIT2",352,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
"RTN","C0CVIT2",353,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
+ Q
"RTN","C0CVIT2",354,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
+ ;
"RTN","C0CVIT2",355,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
+TMP1(DT,ACTOR,VALUE,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",357,0)
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
+"RTN","C0CVIT2",358,0)
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",359,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=DT
"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",361,0)
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","C0CVIT2",362,0)
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+"RTN","C0CVIT2",363,0)
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"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",365,0)
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVIT2",366,0)
+ S ZRNF("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVIT2",367,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
"RTN","C0CVIT2",368,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
"RTN","C0CVIT2",369,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
"RTN","C0CVIT2",370,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
+ Q
"RTN","C0CVIT2",371,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
+ ;
"RTN","C0CVIT2",372,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
+RESP1(DT,ACTOR,VALUE,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",374,0)
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
+"RTN","C0CVIT2",375,0)
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",376,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=DT
"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",378,0)
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","C0CVIT2",379,0)
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+"RTN","C0CVIT2",380,0)
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"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",382,0)
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVIT2",383,0)
+ S ZRNF("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVIT2",384,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
"RTN","C0CVIT2",385,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
"RTN","C0CVIT2",386,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
"RTN","C0CVIT2",387,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
+ Q
"RTN","C0CVIT2",388,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
+ ;
"RTN","C0CVIT2",389,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
+PULSE1(DT,ACTOR,VALUE,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",391,0)
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
+"RTN","C0CVIT2",392,0)
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",393,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=DT
"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",395,0)
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","C0CVIT2",396,0)
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+"RTN","C0CVIT2",397,0)
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"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",399,0)
+ S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVIT2",400,0)
+ S ZRNF("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVIT2",401,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
"RTN","C0CVIT2",402,0)
- S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
"RTN","C0CVIT2",403,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
"RTN","C0CVIT2",404,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
+ Q
"RTN","C0CVIT2",405,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
+ ;
"RTN","C0CVIT2",406,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
+PAIN1(DT,ACTOR,VALUE,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",408,0)
+ S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
+"RTN","C0CVIT2",409,0)
+ S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","C0CVIT2",410,0)
+ S ZRNF("VITALSIGNSEXACTDATETIME")=DT
"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",412,0)
+ S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","C0CVIT2",413,0)
+ S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
+"RTN","C0CVIT2",414,0)
+ S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"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)
+"RTN","C0CVIT2",416,0)
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
+"RTN","C0CVIT2",417,0)
+ S ZRNF("VITALSIGNSCODEVERSION")=""
+"RTN","C0CVIT2",418,0)
+ S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
+"RTN","C0CVIT2",419,0)
+ S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
"RTN","C0CVIT2",420,0)
- S ZRNF("VITALSIGNSCODEVERSION")=""
+ S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
"RTN","C0CVIT2",421,0)
- S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
+ Q
"RTN","C0CVIT2",422,0)
- S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
+ ;
"RTN","C0CVIT2",423,0)
- S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
+OTHER1(DT,TEXT,ACTOR,VALUE,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)
+"RTN","C0CVIT2",425,0)
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
-"RTN","C0CVIT2",429,0)
+"RTN","C0CVIT2",426,0)
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",430,0)
+"RTN","C0CVIT2",427,0)
S ZRNF("VITALSIGNSEXACTDATETIME")=DT
-"RTN","C0CVIT2",431,0)
+"RTN","C0CVIT2",428,0)
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")=TEXT
-"RTN","C0CVIT2",432,0)
+"RTN","C0CVIT2",429,0)
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVIT2",433,0)
+"RTN","C0CVIT2",430,0)
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
-"RTN","C0CVIT2",434,0)
+"RTN","C0CVIT2",431,0)
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVIT2",435,0)
+"RTN","C0CVIT2",432,0)
S ZRNF("VITALSIGNSDESCCODEVALUE")=""
-"RTN","C0CVIT2",436,0)
+"RTN","C0CVIT2",433,0)
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")=""
-"RTN","C0CVIT2",437,0)
+"RTN","C0CVIT2",434,0)
S ZRNF("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVIT2",438,0)
+"RTN","C0CVIT2",435,0)
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
-"RTN","C0CVIT2",439,0)
+"RTN","C0CVIT2",436,0)
S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
-"RTN","C0CVIT2",440,0)
+"RTN","C0CVIT2",437,0)
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
-"RTN","C0CVIT2",441,0)
+"RTN","C0CVIT2",438,0)
Q
-"RTN","C0CVIT2",442,0)
+"RTN","C0CVIT2",439,0)
;
-"RTN","C0CVIT2",443,0)
+"RTN","C0CVIT2",440,0)
VITSORT(VDT) ; RUN DATE SORTING ALGORITHM
-"RTN","C0CVIT2",444,0)
+"RTN","C0CVIT2",441,0)
; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
-"RTN","C0CVIT2",445,0)
+"RTN","C0CVIT2",442,0)
; OF DATES IN THE VITALS RESULTS
-"RTN","C0CVIT2",446,0)
+"RTN","C0CVIT2",443,0)
N VDTI,VDTJ,VTDCNT
-"RTN","C0CVIT2",447,0)
+"RTN","C0CVIT2",444,0)
S VTDCNT=0 ; COUNT TO BUILD ARRAY
-"RTN","C0CVIT2",448,0)
+"RTN","C0CVIT2",445,0)
S VDTJ="" ; USED TO VISIT THE RESULTS
-"RTN","C0CVIT2",449,0)
+"RTN","C0CVIT2",446,0)
F VDTI=0:0 D Q:$O(VIT(VDTJ))="" ; VISIT ALL RESULTS
-"RTN","C0CVIT2",450,0)
+"RTN","C0CVIT2",447,0)
. S VDTJ=$O(VIT(VDTJ)) ; NEXT RESULT
-"RTN","C0CVIT2",451,0)
+"RTN","C0CVIT2",448,0)
. S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
-"RTN","C0CVIT2",452,0)
+"RTN","C0CVIT2",449,0)
. S VDT(VTDCNT)=$P(VIT(VDTJ),U,4) ; PULL OUT THE DATE
-"RTN","C0CVIT2",453,0)
+"RTN","C0CVIT2",450,0)
S VDT(0)=VTDCNT
-"RTN","C0CVIT2",454,0)
+"RTN","C0CVIT2",451,0)
Q
-"RTN","C0CVIT2",455,0)
+"RTN","C0CVIT2",452,0)
;
-"RTN","C0CVIT2",456,0)
+"RTN","C0CVIT2",453,0)
MAP(VITXML,C0CVIT,VITOUT) ; MAP VITAL SIGNS XML
-"RTN","C0CVIT2",457,0)
+"RTN","C0CVIT2",454,0)
;
-"RTN","C0CVIT2",458,0)
+"RTN","C0CVIT2",455,0)
N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"VITTEMP")) ;WORK AREA FOR TEMPLATE
-"RTN","C0CVIT2",459,0)
+"RTN","C0CVIT2",456,0)
K @ZTEMP
-"RTN","C0CVIT2",460,0)
+"RTN","C0CVIT2",457,0)
N ZBLD
-"RTN","C0CVIT2",461,0)
+"RTN","C0CVIT2",458,0)
S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"VITBLD")) ; BUILD LIST AREA
-"RTN","C0CVIT2",462,0)
+"RTN","C0CVIT2",459,0)
D QUEUE^C0CXPATH(ZBLD,VITXML,1,1) ; FIRST LINE
-"RTN","C0CVIT2",463,0)
+"RTN","C0CVIT2",460,0)
N ZINNER
-"RTN","C0CVIT2",464,0)
+"RTN","C0CVIT2",461,0)
; XPATH NEEDS TO MATCH YOUR SECTION
-"RTN","C0CVIT2",465,0)
+"RTN","C0CVIT2",462,0)
D QUERY^C0CXPATH(VITXML,"//VitalSigns/Result","ZINNER") ;ONE VITAL SIGN
-"RTN","C0CVIT2",466,0)
+"RTN","C0CVIT2",463,0)
N ZTMP,ZVAR,ZI
-"RTN","C0CVIT2",467,0)
+"RTN","C0CVIT2",464,0)
S ZI=""
-"RTN","C0CVIT2",468,0)
+"RTN","C0CVIT2",465,0)
F S ZI=$O(@C0CVIT@("V",ZI)) Q:ZI="" D ;FOR EACH VITAL SIGN
-"RTN","C0CVIT2",469,0)
+"RTN","C0CVIT2",466,0)
. S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS VITAL SIGN XML
-"RTN","C0CVIT2",470,0)
+"RTN","C0CVIT2",467,0)
. S ZVAR=$NA(@C0CVIT@("V",ZI)) ;THIS VITAL SIGN VARIABLES
-"RTN","C0CVIT2",471,0)
+"RTN","C0CVIT2",468,0)
. D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE VITAL SIGN
-"RTN","C0CVIT2",472,0)
+"RTN","C0CVIT2",469,0)
. D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUEUE FOR BUILD
-"RTN","C0CVIT2",473,0)
+"RTN","C0CVIT2",470,0)
D QUEUE^C0CXPATH(ZBLD,VITXML,@VITXML@(0),@VITXML@(0))
-"RTN","C0CVIT2",474,0)
+"RTN","C0CVIT2",471,0)
N ZZTMP ; IS THIS NEEDED?
-"RTN","C0CVIT2",475,0)
+"RTN","C0CVIT2",472,0)
D BUILD^C0CXPATH(ZBLD,VITOUT) ;BUILD FINAL XML
-"RTN","C0CVIT2",476,0)
+"RTN","C0CVIT2",473,0)
K @ZTEMP,@ZBLD
-"RTN","C0CVIT2",477,0)
+"RTN","C0CVIT2",474,0)
Q
-"RTN","C0CVIT2",478,0)
+"RTN","C0CVIT2",475,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
-"RTN","C0CVITAL",10,0)
- ;(at your option) any later version.
-"RTN","C0CVITAL",11,0)
;
+"RTN","C0CVITAL",9,0)
+ ; This program is distributed in the hope that it will be useful,
+"RTN","C0CVITAL",10,0)
+ ; 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 .
"RTN","C0CVITAL",16,0)
;
"RTN","C0CVITAL",17,0)
- ;You should have received a copy of the GNU General Public License along
-"RTN","C0CVITAL",18,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
-"RTN","C0CVITAL",19,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","C0CVITAL",20,0)
- ;
-"RTN","C0CVITAL",21,0)
W "NO ENTRY FROM TOP",!
-"RTN","C0CVITAL",22,0)
+"RTN","C0CVITAL",18,0)
Q
-"RTN","C0CVITAL",23,0)
+"RTN","C0CVITAL",19,0)
;
-"RTN","C0CVITAL",24,0)
+"RTN","C0CVITAL",20,0)
EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
-"RTN","C0CVITAL",25,0)
+"RTN","C0CVITAL",21,0)
;
-"RTN","C0CVITAL",26,0)
+"RTN","C0CVITAL",22,0)
; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","C0CVITAL",27,0)
+"RTN","C0CVITAL",23,0)
; IVITXML CONTAINS ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE
-"RTN","C0CVITAL",28,0)
+"RTN","C0CVITAL",24,0)
;
-"RTN","C0CVITAL",29,0)
+"RTN","C0CVITAL",25,0)
N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF,VORDR
-"RTN","C0CVITAL",30,0)
+"RTN","C0CVITAL",26,0)
S C0CVLMT=$$GET^C0CPARMS("VITLIMIT") ; GET THE LIMIT PARM
-"RTN","C0CVITAL",31,0)
+"RTN","C0CVITAL",27,0)
S C0CVSTRT=$$GET^C0CPARMS("VITSTART") ; GET START PARM
-"RTN","C0CVITAL",32,0)
+"RTN","C0CVITAL",28,0)
D DT^DILF(,C0CVLMT,.C0CEDT) ;
-"RTN","C0CVITAL",33,0)
+"RTN","C0CVITAL",29,0)
D DT^DILF(,C0CVSTRT,.C0CSDT) ;
-"RTN","C0CVITAL",34,0)
+"RTN","C0CVITAL",30,0)
;D DT^DILF(,C0CVLMT,.C0CSDT) ; GPL TESTING
-"RTN","C0CVITAL",35,0)
+"RTN","C0CVITAL",31,0)
;D DT^DILF(,C0CVSTRT,.C0CEDT) ;
-"RTN","C0CVITAL",36,0)
+"RTN","C0CVITAL",32,0)
W "VITALS START: ",C0CVSTRT," LIMIT: ",C0CVLMT,!
-"RTN","C0CVITAL",37,0)
+"RTN","C0CVITAL",33,0)
I $$RPMS^C0CUTIL() D VITRPMS QUIT
-"RTN","C0CVITAL",38,0)
+"RTN","C0CVITAL",34,0)
I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VITVISTA QUIT
-"RTN","C0CVITAL",39,0)
+"RTN","C0CVITAL",35,0)
;I $$SYSNAME^C0CSYS()="RPMS" D VITRPMS
-"RTN","C0CVITAL",40,0)
+"RTN","C0CVITAL",36,0)
;E D VITVISTA
-"RTN","C0CVITAL",41,0)
+"RTN","C0CVITAL",37,0)
Q
-"RTN","C0CVITAL",42,0)
+"RTN","C0CVITAL",38,0)
;
-"RTN","C0CVITAL",43,0)
+"RTN","C0CVITAL",39,0)
VITVISTA ; EXTRACT VITALS FROM VISTA INTO PROVIDED XML TEMPLATE
-"RTN","C0CVITAL",44,0)
+"RTN","C0CVITAL",40,0)
D FASTVIT^ORQQVI(.VITRSLT,DFN,C0CEDT,C0CSDT) ; GPL THIS ONE WORKS FOR AT
-"RTN","C0CVITAL",45,0)
+"RTN","C0CVITAL",41,0)
; LEAST ONE SET OF VITALS - TO DO, CALL IT REPETIVELY TO GET EARLIER VITALS
-"RTN","C0CVITAL",46,0)
+"RTN","C0CVITAL",42,0)
;D VITALS^ORQQVI(.VITRSLT,DFN,C0CEDT,C0CSDT)
-"RTN","C0CVITAL",47,0)
+"RTN","C0CVITAL",43,0)
;D VITALS^ORQQVI(.VITRSLT,DFN,C0CSDT,C0CEDT)
-"RTN","C0CVITAL",48,0)
+"RTN","C0CVITAL",44,0)
;D VITALS^ORQQVI(.VITRSLT,DFN,C0CVSTRT,C0CVLMT) ; GPL LET GMR HANDLE THE DATES
-"RTN","C0CVITAL",49,0)
+"RTN","C0CVITAL",45,0)
I '$D(VITRSLT(1)) S @VITOUTXML@(0)=0 Q ; RETURN NOT FOUND AND QUIT
-"RTN","C0CVITAL",50,0)
+"RTN","C0CVITAL",46,0)
I $P(VITRSLT(1),U,2)="No vitals found." D Q ; NULL RESULT FROM RPC
-"RTN","C0CVITAL",51,0)
+"RTN","C0CVITAL",47,0)
. I DEBUG W "NO VITALS FOUND FROM VITALS RPC",!
-"RTN","C0CVITAL",52,0)
+"RTN","C0CVITAL",48,0)
. S @VITOUTXML@(0)=0
-"RTN","C0CVITAL",53,0)
+"RTN","C0CVITAL",49,0)
I $P(VITRSLT(1),U,2)="No vitals found." Q ; QUIT
-"RTN","C0CVITAL",54,0)
+"RTN","C0CVITAL",50,0)
; ZWR RPCRSLT
-"RTN","C0CVITAL",55,0)
+"RTN","C0CVITAL",51,0)
S VITTVMAP=$NA(^TMP("C0CCCR",$J,"VITALS"))
-"RTN","C0CVITAL",56,0)
+"RTN","C0CVITAL",52,0)
S VITTARYTMP=$NA(^TMP("C0CCCR",$J,"VITALARYTMP"))
-"RTN","C0CVITAL",57,0)
+"RTN","C0CVITAL",53,0)
K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
-"RTN","C0CVITAL",58,0)
+"RTN","C0CVITAL",54,0)
N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
-"RTN","C0CVITAL",59,0)
- D VITDVISTA(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
-"RTN","C0CVITAL",60,0)
- I DEBUG ZWR VDATES ;DEBUG
-"RTN","C0CVITAL",61,0)
+"RTN","C0CVITAL",55,0)
+ D SORTVIST(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
+"RTN","C0CVITAL",56,0)
+ ; I DEBUG ZWR VDATES ;DEBUG
+"RTN","C0CVITAL",57,0)
S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
-"RTN","C0CVITAL",62,0)
+"RTN","C0CVITAL",58,0)
; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
-"RTN","C0CVITAL",63,0)
+"RTN","C0CVITAL",59,0)
S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS
-"RTN","C0CVITAL",64,0)
+"RTN","C0CVITAL",60,0)
F J=1:1:VCNT D ; FOR EACH VITAL IN THE LIST
-"RTN","C0CVITAL",65,0)
+"RTN","C0CVITAL",61,0)
. I $D(VITRSLT(VSORT(J))) D
-"RTN","C0CVITAL",66,0)
+"RTN","C0CVITAL",62,0)
. . S VITVMAP=$NA(@VITTVMAP@(J))
-"RTN","C0CVITAL",67,0)
+"RTN","C0CVITAL",63,0)
. . K @VITVMAP
-"RTN","C0CVITAL",68,0)
+"RTN","C0CVITAL",64,0)
. . I DEBUG W "VMAP= ",VITVMAP,!
-"RTN","C0CVITAL",69,0)
+"RTN","C0CVITAL",65,0)
. . S VITPTMP=VITRSLT(VSORT(J)) ; DATE SORTED VITAL FROM RETURN ARRAY
-"RTN","C0CVITAL",70,0)
+"RTN","C0CVITAL",66,0)
. . I DEBUG W "VITAL ",VSORT(J),!
-"RTN","C0CVITAL",71,0)
+"RTN","C0CVITAL",67,0)
. . I DEBUG W VITRSLT(VSORT(J))," ",$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT"),!
-"RTN","C0CVITAL",72,0)
+"RTN","C0CVITAL",68,0)
. . I DEBUG W $P(VITPTMP,U,4),!
-"RTN","C0CVITAL",73,0)
+"RTN","C0CVITAL",69,0)
. . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID
-"RTN","C0CVITAL",74,0)
+"RTN","C0CVITAL",70,0)
. . ;B ;gpl
-"RTN","C0CVITAL",75,0)
+"RTN","C0CVITAL",71,0)
. . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^GMR(120.5,$P(VITPTMP,U,1),0)),U,6)
-"RTN","C0CVITAL",76,0)
+"RTN","C0CVITAL",72,0)
. . I @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_" D ;
-"RTN","C0CVITAL",77,0)
+"RTN","C0CVITAL",73,0)
. . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",78,0)
+"RTN","C0CVITAL",74,0)
. . I $P(VITPTMP,U,2)="HT" D
-"RTN","C0CVITAL",79,0)
+"RTN","C0CVITAL",75,0)
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",80,0)
+"RTN","C0CVITAL",76,0)
. . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
+"RTN","C0CVITAL",77,0)
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
+"RTN","C0CVITAL",78,0)
+ . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","C0CVITAL",79,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","C0CVITAL",80,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVITAL",81,0)
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
"RTN","C0CVITAL",82,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",83,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",84,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)
+"RTN","C0CVITAL",83,0)
. . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",88,0)
+"RTN","C0CVITAL",84,0)
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",89,0)
+"RTN","C0CVITAL",85,0)
. . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","C0CVITAL",90,0)
+"RTN","C0CVITAL",86,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","C0CVITAL",91,0)
+"RTN","C0CVITAL",87,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
-"RTN","C0CVITAL",92,0)
+"RTN","C0CVITAL",88,0)
. . E I $P(VITPTMP,U,2)="WT" D
-"RTN","C0CVITAL",93,0)
+"RTN","C0CVITAL",89,0)
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",94,0)
+"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",93,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","C0CVITAL",94,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVITAL",95,0)
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
"RTN","C0CVITAL",96,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",97,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",98,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)
+"RTN","C0CVITAL",97,0)
. . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",102,0)
+"RTN","C0CVITAL",98,0)
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",103,0)
+"RTN","C0CVITAL",99,0)
. . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","C0CVITAL",104,0)
+"RTN","C0CVITAL",100,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","C0CVITAL",105,0)
+"RTN","C0CVITAL",101,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
-"RTN","C0CVITAL",106,0)
+"RTN","C0CVITAL",102,0)
. . E I $P(VITPTMP,U,2)="BP" D
-"RTN","C0CVITAL",107,0)
+"RTN","C0CVITAL",103,0)
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",108,0)
+"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",107,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","C0CVITAL",108,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVITAL",109,0)
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
"RTN","C0CVITAL",110,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",111,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",112,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)
+"RTN","C0CVITAL",111,0)
. . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",116,0)
+"RTN","C0CVITAL",112,0)
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",117,0)
+"RTN","C0CVITAL",113,0)
. . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","C0CVITAL",118,0)
+"RTN","C0CVITAL",114,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","C0CVITAL",119,0)
+"RTN","C0CVITAL",115,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","C0CVITAL",120,0)
+"RTN","C0CVITAL",116,0)
. . E I $P(VITPTMP,U,2)="T" D
-"RTN","C0CVITAL",121,0)
+"RTN","C0CVITAL",117,0)
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",122,0)
+"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",121,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","C0CVITAL",122,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVITAL",123,0)
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
"RTN","C0CVITAL",124,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",125,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",126,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)
+"RTN","C0CVITAL",125,0)
. . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",130,0)
+"RTN","C0CVITAL",126,0)
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",131,0)
+"RTN","C0CVITAL",127,0)
. . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","C0CVITAL",132,0)
+"RTN","C0CVITAL",128,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","C0CVITAL",133,0)
+"RTN","C0CVITAL",129,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F"
-"RTN","C0CVITAL",134,0)
+"RTN","C0CVITAL",130,0)
. . E I $P(VITPTMP,U,2)="R" D
-"RTN","C0CVITAL",135,0)
+"RTN","C0CVITAL",131,0)
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",136,0)
+"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",135,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","C0CVITAL",136,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVITAL",137,0)
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
"RTN","C0CVITAL",138,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",139,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",140,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)
+"RTN","C0CVITAL",139,0)
. . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",144,0)
+"RTN","C0CVITAL",140,0)
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",145,0)
+"RTN","C0CVITAL",141,0)
. . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","C0CVITAL",146,0)
+"RTN","C0CVITAL",142,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","C0CVITAL",147,0)
+"RTN","C0CVITAL",143,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","C0CVITAL",148,0)
+"RTN","C0CVITAL",144,0)
. . E I $P(VITPTMP,U,2)="P" D
-"RTN","C0CVITAL",149,0)
+"RTN","C0CVITAL",145,0)
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",150,0)
+"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",149,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","C0CVITAL",150,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVITAL",151,0)
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
"RTN","C0CVITAL",152,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",153,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",154,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)
+"RTN","C0CVITAL",153,0)
. . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",158,0)
+"RTN","C0CVITAL",154,0)
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",159,0)
+"RTN","C0CVITAL",155,0)
. . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","C0CVITAL",160,0)
+"RTN","C0CVITAL",156,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","C0CVITAL",161,0)
+"RTN","C0CVITAL",157,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","C0CVITAL",162,0)
+"RTN","C0CVITAL",158,0)
. . E I $P(VITPTMP,U,2)="PN" D
-"RTN","C0CVITAL",163,0)
+"RTN","C0CVITAL",159,0)
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",164,0)
+"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",163,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","C0CVITAL",164,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVITAL",165,0)
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
"RTN","C0CVITAL",166,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",167,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",168,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)
+"RTN","C0CVITAL",167,0)
. . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",172,0)
+"RTN","C0CVITAL",168,0)
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",173,0)
+"RTN","C0CVITAL",169,0)
. . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","C0CVITAL",174,0)
+"RTN","C0CVITAL",170,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","C0CVITAL",175,0)
+"RTN","C0CVITAL",171,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","C0CVITAL",176,0)
+"RTN","C0CVITAL",172,0)
. . E I $P(VITPTMP,U,2)="BMI" D
-"RTN","C0CVITAL",177,0)
+"RTN","C0CVITAL",173,0)
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",178,0)
+"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",177,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","C0CVITAL",178,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVITAL",179,0)
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BMI"
"RTN","C0CVITAL",180,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",181,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",182,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)
+"RTN","C0CVITAL",181,0)
. . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",186,0)
+"RTN","C0CVITAL",182,0)
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",187,0)
+"RTN","C0CVITAL",183,0)
. . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","C0CVITAL",188,0)
+"RTN","C0CVITAL",184,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","C0CVITAL",189,0)
+"RTN","C0CVITAL",185,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","C0CVITAL",190,0)
+"RTN","C0CVITAL",186,0)
. . E D
-"RTN","C0CVITAL",191,0)
+"RTN","C0CVITAL",187,0)
. . . ;W "IN VITAL: OTHER",!
-"RTN","C0CVITAL",192,0)
+"RTN","C0CVITAL",188,0)
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",193,0)
+"RTN","C0CVITAL",189,0)
. . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT")
-"RTN","C0CVITAL",194,0)
+"RTN","C0CVITAL",190,0)
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
-"RTN","C0CVITAL",195,0)
+"RTN","C0CVITAL",191,0)
. . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",196,0)
+"RTN","C0CVITAL",192,0)
. . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",197,0)
+"RTN","C0CVITAL",193,0)
. . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="UNKNOWN"
-"RTN","C0CVITAL",198,0)
+"RTN","C0CVITAL",194,0)
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
-"RTN","C0CVITAL",199,0)
+"RTN","C0CVITAL",195,0)
. . . ;S @VITVMAP@("VITALSIGNSDESCCODEVALUE")=""
-"RTN","C0CVITAL",200,0)
+"RTN","C0CVITAL",196,0)
. . . ;S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")=""
-"RTN","C0CVITAL",201,0)
+"RTN","C0CVITAL",197,0)
. . . ;S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",202,0)
+"RTN","C0CVITAL",198,0)
. . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^GMR(120.5,$P(VITPTMP,U,1),0)),U,6)
-"RTN","C0CVITAL",203,0)
+"RTN","C0CVITAL",199,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","C0CVITAL",204,0)
+"RTN","C0CVITAL",200,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
-"RTN","C0CVITAL",205,0)
+"RTN","C0CVITAL",201,0)
. . I @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_" D ;
-"RTN","C0CVITAL",206,0)
+"RTN","C0CVITAL",202,0)
. . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORSYSTEM_1" ;
-"RTN","C0CVITAL",207,0)
+"RTN","C0CVITAL",203,0)
. . S VITARYTMP=$NA(@VITTARYTMP@(J))
-"RTN","C0CVITAL",208,0)
+"RTN","C0CVITAL",204,0)
. . K @VITARYTMP
-"RTN","C0CVITAL",209,0)
+"RTN","C0CVITAL",205,0)
. . D MAP^C0CXPATH(VITXML,VITVMAP,VITARYTMP)
-"RTN","C0CVITAL",210,0)
+"RTN","C0CVITAL",206,0)
. . I J=1 D ; FIRST ONE IS JUST A COPY
-"RTN","C0CVITAL",211,0)
+"RTN","C0CVITAL",207,0)
. . . ; W "FIRST ONE",!
-"RTN","C0CVITAL",212,0)
+"RTN","C0CVITAL",208,0)
. . . D CP^C0CXPATH(VITARYTMP,VITOUTXML)
-"RTN","C0CVITAL",213,0)
+"RTN","C0CVITAL",209,0)
. . . I DEBUG W "VITOUTXML ",VITOUTXML,!
-"RTN","C0CVITAL",214,0)
+"RTN","C0CVITAL",210,0)
. . I J>1 D ; AFTER THE FIRST, INSERT INNER XML
-"RTN","C0CVITAL",215,0)
+"RTN","C0CVITAL",211,0)
. . . D INSINNER^C0CXPATH(VITOUTXML,VITARYTMP)
-"RTN","C0CVITAL",216,0)
+"RTN","C0CVITAL",212,0)
; ZWR ^TMP($J,"VITALS",*)
-"RTN","C0CVITAL",217,0)
+"RTN","C0CVITAL",213,0)
; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
-"RTN","C0CVITAL",218,0)
+"RTN","C0CVITAL",214,0)
I DEBUG D PARY^C0CXPATH(VITOUTXML)
-"RTN","C0CVITAL",219,0)
+"RTN","C0CVITAL",215,0)
N VITTMP,I
-"RTN","C0CVITAL",220,0)
+"RTN","C0CVITAL",216,0)
D MISSING^C0CXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","C0CVITAL",221,0)
+"RTN","C0CVITAL",217,0)
I VITTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","C0CVITAL",222,0)
+"RTN","C0CVITAL",218,0)
. W "VITALS MISSING ",!
-"RTN","C0CVITAL",223,0)
+"RTN","C0CVITAL",219,0)
. F I=1:1:VITTMP(0) W VITTMP(I),!
-"RTN","C0CVITAL",224,0)
+"RTN","C0CVITAL",220,0)
Q
-"RTN","C0CVITAL",225,0)
+"RTN","C0CVITAL",221,0)
;
-"RTN","C0CVITAL",226,0)
+"RTN","C0CVITAL",222,0)
VITRPMS ; EXTRACT VITALS FROM RPMS INTO PROVIDED XML TEMPLATE
-"RTN","C0CVITAL",227,0)
+"RTN","C0CVITAL",223,0)
; RPMS VITAL RPC ONLY RETURNS LATEST VITAL IN SPECIFIED DATE RANGE NOT ALL VITALS IN DATE RANGE
-"RTN","C0CVITAL",228,0)
+"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",229,0)
+"RTN","C0CVITAL",225,0)
N END,START,DATA
-"RTN","C0CVITAL",230,0)
+"RTN","C0CVITAL",226,0)
D DT^DILF("",C0CVLMT,.END)
-"RTN","C0CVITAL",231,0)
+"RTN","C0CVITAL",227,0)
D DT^DILF("",C0CVSTRT,.START)
-"RTN","C0CVITAL",232,0)
+"RTN","C0CVITAL",228,0)
; RPC OUTPUT FORMAT:
-"RTN","C0CVITAL",233,0)
+"RTN","C0CVITAL",229,0)
; vfile ien^vital name^vital abbr^date/time taken(FM FORMAT)^value+units (US & metric)
-"RTN","C0CVITAL",234,0)
+"RTN","C0CVITAL",230,0)
D QUERY^BEHOVM("LISTX") ; RUN QUERY VITALS CALL
-"RTN","C0CVITAL",235,0)
+"RTN","C0CVITAL",231,0)
I '$D(^TMP("CIAVMRPC",$J)) S @VITOUTXML@(0)=0 Q ; RETURN NOT FOUND AND QUIT
-"RTN","C0CVITAL",236,0)
+"RTN","C0CVITAL",232,0)
;ZW ^TMP("CIAVMRPC",$J)
-"RTN","C0CVITAL",237,0)
+"RTN","C0CVITAL",233,0)
S VITTVMAP=$NA(^TMP("C0CCCR",$J,"VITALS"))
-"RTN","C0CVITAL",238,0)
+"RTN","C0CVITAL",234,0)
S VITTARYTMP=$NA(^TMP("C0CCCR",$J,"VITALARYTMP"))
-"RTN","C0CVITAL",239,0)
+"RTN","C0CVITAL",235,0)
K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
-"RTN","C0CVITAL",240,0)
+"RTN","C0CVITAL",236,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)
+"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",243,0)
+"RTN","C0CVITAL",239,0)
; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
-"RTN","C0CVITAL",244,0)
+"RTN","C0CVITAL",240,0)
S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS
-"RTN","C0CVITAL",245,0)
+"RTN","C0CVITAL",241,0)
F J=1:1:VCNT D ; FOR EACH VITAL IN THE LIST
-"RTN","C0CVITAL",246,0)
+"RTN","C0CVITAL",242,0)
. I $D(^TMP("CIAVMRPC",$J,0,(VSORT(J)))) D
-"RTN","C0CVITAL",247,0)
+"RTN","C0CVITAL",243,0)
. . S VITVMAP=$NA(@VITTVMAP@(J))
-"RTN","C0CVITAL",248,0)
+"RTN","C0CVITAL",244,0)
. . K @VITVMAP
-"RTN","C0CVITAL",249,0)
+"RTN","C0CVITAL",245,0)
. . I DEBUG W "VMAP= ",VITVMAP,!
-"RTN","C0CVITAL",250,0)
+"RTN","C0CVITAL",246,0)
. . S VITPTMP=^TMP("CIAVMRPC",$J,0,(VSORT(J))) ; DATE SORTED VITAL FROM RETURN ARRAY
-"RTN","C0CVITAL",251,0)
+"RTN","C0CVITAL",247,0)
. . I DEBUG W "VITAL ",VSORT(J),!
-"RTN","C0CVITAL",252,0)
+"RTN","C0CVITAL",248,0)
. . I DEBUG W ^TMP("CIAVMRPC",$J,0,(VSORT(J)))," ",$$FMDTOUTC^C0CUTIL($P(VITPTMP,U,4),"DT"),!
-"RTN","C0CVITAL",253,0)
+"RTN","C0CVITAL",249,0)
. . I DEBUG W $P(VITPTMP,U,4),!
-"RTN","C0CVITAL",254,0)
+"RTN","C0CVITAL",250,0)
. . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID
-"RTN","C0CVITAL",255,0)
+"RTN","C0CVITAL",251,0)
. . I $P(VITPTMP,U,3)="HT" D
-"RTN","C0CVITAL",256,0)
+"RTN","C0CVITAL",252,0)
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",257,0)
+"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",258,0)
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
"RTN","C0CVITAL",259,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",260,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",261,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)
+"RTN","C0CVITAL",260,0)
. . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",265,0)
+"RTN","C0CVITAL",261,0)
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",266,0)
+"RTN","C0CVITAL",262,0)
. . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
-"RTN","C0CVITAL",267,0)
+"RTN","C0CVITAL",263,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
-"RTN","C0CVITAL",268,0)
+"RTN","C0CVITAL",264,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
-"RTN","C0CVITAL",269,0)
+"RTN","C0CVITAL",265,0)
. . E I $P(VITPTMP,U,3)="WT" D
-"RTN","C0CVITAL",270,0)
+"RTN","C0CVITAL",266,0)
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",271,0)
+"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",270,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","C0CVITAL",271,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVITAL",272,0)
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
"RTN","C0CVITAL",273,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",274,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",275,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)
+"RTN","C0CVITAL",274,0)
. . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",279,0)
+"RTN","C0CVITAL",275,0)
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",280,0)
+"RTN","C0CVITAL",276,0)
. . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
-"RTN","C0CVITAL",281,0)
+"RTN","C0CVITAL",277,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
-"RTN","C0CVITAL",282,0)
+"RTN","C0CVITAL",278,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
-"RTN","C0CVITAL",283,0)
+"RTN","C0CVITAL",279,0)
. . E I $P(VITPTMP,U,3)="BP" D
-"RTN","C0CVITAL",284,0)
+"RTN","C0CVITAL",280,0)
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",285,0)
+"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",284,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","C0CVITAL",285,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVITAL",286,0)
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
"RTN","C0CVITAL",287,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",288,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",289,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)
+"RTN","C0CVITAL",288,0)
. . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",293,0)
+"RTN","C0CVITAL",289,0)
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",294,0)
+"RTN","C0CVITAL",290,0)
. . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
-"RTN","C0CVITAL",295,0)
+"RTN","C0CVITAL",291,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
-"RTN","C0CVITAL",296,0)
+"RTN","C0CVITAL",292,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
-"RTN","C0CVITAL",297,0)
+"RTN","C0CVITAL",293,0)
. . E I $P(VITPTMP,U,3)="TMP" D
-"RTN","C0CVITAL",298,0)
+"RTN","C0CVITAL",294,0)
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",299,0)
+"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",298,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","C0CVITAL",299,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVITAL",300,0)
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
"RTN","C0CVITAL",301,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",302,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",303,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)
+"RTN","C0CVITAL",302,0)
. . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",307,0)
+"RTN","C0CVITAL",303,0)
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",308,0)
+"RTN","C0CVITAL",304,0)
. . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
-"RTN","C0CVITAL",309,0)
+"RTN","C0CVITAL",305,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
-"RTN","C0CVITAL",310,0)
+"RTN","C0CVITAL",306,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
-"RTN","C0CVITAL",311,0)
+"RTN","C0CVITAL",307,0)
. . E I $P(VITPTMP,U,3)="RS" D
-"RTN","C0CVITAL",312,0)
+"RTN","C0CVITAL",308,0)
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",313,0)
+"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",312,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","C0CVITAL",313,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVITAL",314,0)
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
"RTN","C0CVITAL",315,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",316,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",317,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)
+"RTN","C0CVITAL",316,0)
. . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",321,0)
+"RTN","C0CVITAL",317,0)
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",322,0)
+"RTN","C0CVITAL",318,0)
. . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
-"RTN","C0CVITAL",323,0)
+"RTN","C0CVITAL",319,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
-"RTN","C0CVITAL",324,0)
+"RTN","C0CVITAL",320,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
-"RTN","C0CVITAL",325,0)
+"RTN","C0CVITAL",321,0)
. . E I $P(VITPTMP,U,3)="PU" D
-"RTN","C0CVITAL",326,0)
+"RTN","C0CVITAL",322,0)
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",327,0)
+"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",326,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","C0CVITAL",327,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVITAL",328,0)
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
"RTN","C0CVITAL",329,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",330,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",331,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)
+"RTN","C0CVITAL",330,0)
. . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",335,0)
+"RTN","C0CVITAL",331,0)
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",336,0)
+"RTN","C0CVITAL",332,0)
. . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
-"RTN","C0CVITAL",337,0)
+"RTN","C0CVITAL",333,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
-"RTN","C0CVITAL",338,0)
+"RTN","C0CVITAL",334,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
-"RTN","C0CVITAL",339,0)
+"RTN","C0CVITAL",335,0)
. . E I $P(VITPTMP,U,3)="PA" D
-"RTN","C0CVITAL",340,0)
+"RTN","C0CVITAL",336,0)
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",341,0)
+"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",340,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","C0CVITAL",341,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVITAL",342,0)
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
"RTN","C0CVITAL",343,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",344,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",345,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)
+"RTN","C0CVITAL",344,0)
. . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
-"RTN","C0CVITAL",349,0)
+"RTN","C0CVITAL",345,0)
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",350,0)
+"RTN","C0CVITAL",346,0)
. . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
-"RTN","C0CVITAL",351,0)
+"RTN","C0CVITAL",347,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
-"RTN","C0CVITAL",352,0)
+"RTN","C0CVITAL",348,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
-"RTN","C0CVITAL",353,0)
+"RTN","C0CVITAL",349,0)
. . E D
-"RTN","C0CVITAL",354,0)
+"RTN","C0CVITAL",350,0)
. . . ;W "IN VITAL: OTHER",!
-"RTN","C0CVITAL",355,0)
+"RTN","C0CVITAL",351,0)
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",356,0)
+"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",355,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","C0CVITAL",356,0)
+ . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
"RTN","C0CVITAL",357,0)
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")=$P(VITPTMP,U,2)
"RTN","C0CVITAL",358,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","C0CVITAL",359,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","C0CVITAL",360,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","C0CVITAL",361,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")=$P(VITPTMP,U,2)
-"RTN","C0CVITAL",362,0)
. . . S @VITVMAP@("VITALSIGNSDESCCODEVALUE")=""
-"RTN","C0CVITAL",363,0)
+"RTN","C0CVITAL",359,0)
. . . S @VITVMAP@("VITALSIGNSDESCCODINGSYSTEM")=""
-"RTN","C0CVITAL",364,0)
+"RTN","C0CVITAL",360,0)
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","C0CVITAL",365,0)
+"RTN","C0CVITAL",361,0)
. . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VITPTMP,U,1),12)),U,4)
-"RTN","C0CVITAL",366,0)
+"RTN","C0CVITAL",362,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P($P(VITPTMP,U,5)," ",1)
-"RTN","C0CVITAL",367,0)
+"RTN","C0CVITAL",363,0)
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=$P($P(VITPTMP,U,5)," ",2)
-"RTN","C0CVITAL",368,0)
+"RTN","C0CVITAL",364,0)
. . S VITARYTMP=$NA(@VITTARYTMP@(J))
-"RTN","C0CVITAL",369,0)
+"RTN","C0CVITAL",365,0)
. . K @VITARYTMP
-"RTN","C0CVITAL",370,0)
+"RTN","C0CVITAL",366,0)
. . D MAP^C0CXPATH(VITXML,VITVMAP,VITARYTMP)
-"RTN","C0CVITAL",371,0)
+"RTN","C0CVITAL",367,0)
. . I J=1 D ; FIRST ONE IS JUST A COPY
-"RTN","C0CVITAL",372,0)
+"RTN","C0CVITAL",368,0)
. . . ; W "FIRST ONE",!
-"RTN","C0CVITAL",373,0)
+"RTN","C0CVITAL",369,0)
. . . D CP^C0CXPATH(VITARYTMP,VITOUTXML)
-"RTN","C0CVITAL",374,0)
+"RTN","C0CVITAL",370,0)
. . . I DEBUG W "VITOUTXML ",VITOUTXML,!
-"RTN","C0CVITAL",375,0)
+"RTN","C0CVITAL",371,0)
. . I J>1 D ; AFTER THE FIRST, INSERT INNER XML
-"RTN","C0CVITAL",376,0)
+"RTN","C0CVITAL",372,0)
. . . D INSINNER^C0CXPATH(VITOUTXML,VITARYTMP)
-"RTN","C0CVITAL",377,0)
+"RTN","C0CVITAL",373,0)
; ZWR ^TMP($J,"VITALS",*)
-"RTN","C0CVITAL",378,0)
+"RTN","C0CVITAL",374,0)
; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
-"RTN","C0CVITAL",379,0)
+"RTN","C0CVITAL",375,0)
I DEBUG D PARY^C0CXPATH(VITOUTXML)
-"RTN","C0CVITAL",380,0)
+"RTN","C0CVITAL",376,0)
N VITTMP,I
-"RTN","C0CVITAL",381,0)
+"RTN","C0CVITAL",377,0)
D MISSING^C0CXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","C0CVITAL",382,0)
+"RTN","C0CVITAL",378,0)
I VITTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","C0CVITAL",383,0)
+"RTN","C0CVITAL",379,0)
. W "VITALS MISSING ",!
-"RTN","C0CVITAL",384,0)
+"RTN","C0CVITAL",380,0)
. F I=1:1:VITTMP(0) W VITTMP(I),!
-"RTN","C0CVITAL",385,0)
+"RTN","C0CVITAL",381,0)
K ^TMP("CIAVMRPC",$J)
+"RTN","C0CVITAL",382,0)
+ Q
+"RTN","C0CVITAL",383,0)
+ ;
+"RTN","C0CVITAL",384,0)
+SORTRPMS(VDT) ; RUN DATE SORTING ALGORITHM FOR RPMS
+"RTN","C0CVITAL",385,0)
+ ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
"RTN","C0CVITAL",386,0)
- Q
+ ; OF DATES IN THE VITALS RESULTS
"RTN","C0CVITAL",387,0)
- ;
+ N VDTI,VDTJ,VTDCNT
"RTN","C0CVITAL",388,0)
-VITDRPMS(VDT) ; RUN DATE SORTING ALGORITHM FOR RPMS
+ S VTDCNT=0 ; COUNT TO BUILD ARRAY
"RTN","C0CVITAL",389,0)
- ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
+ S VDTJ="" ; USED TO VISIT THE RESULTS
"RTN","C0CVITAL",390,0)
- ; OF DATES IN THE VITALS RESULTS
-"RTN","C0CVITAL",391,0)
- N VDTI,VDTJ,VTDCNT
-"RTN","C0CVITAL",392,0)
- S VTDCNT=0 ; COUNT TO BUILD ARRAY
-"RTN","C0CVITAL",393,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)
+"RTN","C0CVITAL",391,0)
. S VDTJ=$O(^TMP("CIAVMRPC",$J,0,VDTJ)) ; NEXT RESULT
-"RTN","C0CVITAL",396,0)
+"RTN","C0CVITAL",392,0)
. S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
-"RTN","C0CVITAL",397,0)
+"RTN","C0CVITAL",393,0)
. S VDT(VTDCNT)=$P(^TMP("CIAVMRPC",$J,0,VDTJ),U,4) ; PULL OUT THE DATE
-"RTN","C0CVITAL",398,0)
+"RTN","C0CVITAL",394,0)
S VDT(0)=VTDCNT
-"RTN","C0CVITAL",399,0)
+"RTN","C0CVITAL",395,0)
Q
-"RTN","C0CVITAL",400,0)
+"RTN","C0CVITAL",396,0)
;
-"RTN","C0CVITAL",401,0)
-VITDVISTA(VDT) ; RUN DATE SORTING ALGORITHM FOR VISTA
-"RTN","C0CVITAL",402,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",403,0)
+"RTN","C0CVITAL",399,0)
; OF DATES IN THE VITALS RESULTS
-"RTN","C0CVITAL",404,0)
+"RTN","C0CVITAL",400,0)
N VDTI,VDTJ,VTDCNT
-"RTN","C0CVITAL",405,0)
+"RTN","C0CVITAL",401,0)
S VTDCNT=0 ; COUNT TO BUILD ARRAY
-"RTN","C0CVITAL",406,0)
+"RTN","C0CVITAL",402,0)
S VDTJ="" ; USED TO VISIT THE RESULTS
-"RTN","C0CVITAL",407,0)
+"RTN","C0CVITAL",403,0)
F VDTI=0:0 D Q:$O(VITRSLT(VDTJ))="" ; VISIT ALL RESULTS
-"RTN","C0CVITAL",408,0)
+"RTN","C0CVITAL",404,0)
. S VDTJ=$O(VITRSLT(VDTJ)) ; NEXT RESULT
-"RTN","C0CVITAL",409,0)
+"RTN","C0CVITAL",405,0)
. S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
-"RTN","C0CVITAL",410,0)
+"RTN","C0CVITAL",406,0)
. S VDT(VTDCNT)=$P(VITRSLT(VDTJ),U,4) ; PULL OUT THE DATE
-"RTN","C0CVITAL",411,0)
+"RTN","C0CVITAL",407,0)
S VDT(0)=VTDCNT
-"RTN","C0CVITAL",412,0)
+"RTN","C0CVITAL",408,0)
Q
-"RTN","C0CVITAL",413,0)
+"RTN","C0CVITAL",409,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
"RTN","C0CVOBX1",4,0)
;
"RTN","C0CVOBX1",5,0)
-CH ; Observation/Result segment for "CH" subscript results.
+ ; (C) 2009 John McCormack
"RTN","C0CVOBX1",6,0)
- ; Called by LA7VOBX
+ ; 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)
- N LA76304,LA7ALT,LA7DIV,LA7I,LA7X,LA7Y,X
+ ; 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)
- ; "CH" subscript requires a dataname
+ ;
"RTN","C0CVOBX1",11,0)
- I '$G(LRSB) Q
+ ; 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)
- ; get result node from LR global.
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
"RTN","C0CVOBX1",14,0)
- S LA76304(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
+ ; GNU Affero General Public License for more details.
"RTN","C0CVOBX1",15,0)
- S LA7VAL=$G(^LR(LRDFN,LRSS,LRIDT,LRSB))
-"RTN","C0CVOBX1",16,0)
;
+"RTN","C0CVOBX1",16,0)
+ ; You should have received a copy of the GNU Affero General Public License
"RTN","C0CVOBX1",17,0)
- ; Check if test is OK to send - (O)utput or (B)oth
+ ; along with this program. If not, see .
"RTN","C0CVOBX1",18,0)
- S LA7X=$P(LA7VAL,"^",12)
+ ;
"RTN","C0CVOBX1",19,0)
- I LA7X]"","BO"'[LA7X Q
+CH ; Observation/Result segment for "CH" subscript results.
"RTN","C0CVOBX1",20,0)
- I LA7X="",'$$OKTOSND^LA7VHLU1(LRSS,LRSB,+$P($P(LA7VAL,"^",3),"!",5)) Q
+ ; Called by LA7VOBX
"RTN","C0CVOBX1",21,0)
;
"RTN","C0CVOBX1",22,0)
- ; If no result NLT or LOINC try to determine from file #60
+ N LA76304,LA7ALT,LA7DIV,LA7I,LA7X,LA7Y,X
"RTN","C0CVOBX1",23,0)
- S LA7X=$P(LA7VAL,"^",3)
+ ;
"RTN","C0CVOBX1",24,0)
- ; WV check for IHS - NLT/LN codes from V LAB file
+ ; "CH" subscript requires a dataname
"RTN","C0CVOBX1",25,0)
- I $D(^AUPNVLAB) D TMPCHK^C0CLA7Q
+ I '$G(LRSB) Q
"RTN","C0CVOBX1",26,0)
;
"RTN","C0CVOBX1",27,0)
- I $P(LA7X,"!",2)=""!($P(LA7X,"!",3)="") S $P(LA7VAL,"^",3)=$$DEFCODE^LA7VHLU5(LRSS,LRSB,LA7X,$P(LA76304(0),"^",5))
+ ; get result node from LR global.
"RTN","C0CVOBX1",28,0)
- ; No result NLT code - log error
+ S LA76304(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
"RTN","C0CVOBX1",29,0)
- I $P($P(LA7VAL,"^",3),"!",2)="" D
+ S LA7VAL=$G(^LR(LRDFN,LRSS,LRIDT,LRSB))
"RTN","C0CVOBX1",30,0)
- . N LA7X
+ ;
"RTN","C0CVOBX1",31,0)
- . S LA7X="["_LRSB_"]"_$$GET1^DID(63.04,LRSB,"","LABEL")
+ ; Check if test is OK to send - (O)utput or (B)oth
"RTN","C0CVOBX1",32,0)
- . D CREATE^LA7LOG(36)
+ S LA7X=$P(LA7VAL,"^",12)
"RTN","C0CVOBX1",33,0)
- ;
+ I LA7X]"","BO"'[LA7X Q
"RTN","C0CVOBX1",34,0)
- ; something missing - No NLT code, etc.
+ I LA7X="",'$$OKTOSND^LA7VHLU1(LRSS,LRSB,+$P($P(LA7VAL,"^",3),"!",5)) Q
"RTN","C0CVOBX1",35,0)
- I LA7VAL="" Q
+ ;
"RTN","C0CVOBX1",36,0)
- ;
+ ; If no result NLT or LOINC try to determine from file #60
"RTN","C0CVOBX1",37,0)
- ; Check for missing units/reference ranges
-"RTN","C0CVOBX1",38,0)
- S LA7X=$P(LA7VAL,"^",5)
-"RTN","C0CVOBX1",39,0)
- ;
-"RTN","C0CVOBX1",40,0)
- ; Results missing units, lookup in file #60
-"RTN","C0CVOBX1",41,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)
- ; If results missing reference ranges, use values from file #60.
-"RTN","C0CVOBX1",44,0)
- I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="",$P(LA7X,"!",11)="",$P(LA7X,"!",12)="" D
-"RTN","C0CVOBX1",45,0)
- . S LA7Y=$$REFUNIT^LA7VHLU1(LRSB,$P(LA76304(0),"^",5))
-"RTN","C0CVOBX1",46,0)
- . S $P(LA7X,"!",2)=$P(LA7Y,"^")
-"RTN","C0CVOBX1",47,0)
- . S $P(LA7X,"!",3)=$P(LA7Y,"^",2)
-"RTN","C0CVOBX1",48,0)
- . S $P(LA7X,"!",11)=$P(LA7Y,"^",6)
-"RTN","C0CVOBX1",49,0)
- . S $P(LA7X,"!",12)=$P(LA7Y,"^",7)
-"RTN","C0CVOBX1",50,0)
- ; Use therapeutic low/high if low/high missing.
-"RTN","C0CVOBX1",51,0)
- I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="" D
-"RTN","C0CVOBX1",52,0)
- . S $P(LA7X,"!",2)=$P(LA7X,"!",11)
-"RTN","C0CVOBX1",53,0)
- . S $P(LA7X,"!",3)=$P(LA7X,"!",12)
-"RTN","C0CVOBX1",54,0)
- ;
-"RTN","C0CVOBX1",55,0)
- ; Evaluate low/high reference ranges in case M code in these fields.
-"RTN","C0CVOBX1",56,0)
- S:$G(SEX)="" SEX="M" S:$G(AGE)="" AGE=99
-"RTN","C0CVOBX1",57,0)
- F LA7I=2,3 I $E($P(LA7X,"!",LA7I),1,3)="$S(" D
-"RTN","C0CVOBX1",58,0)
- . S @("X="_$P(LA7X,"!",LA7I))
-"RTN","C0CVOBX1",59,0)
- . S $P(LA7X,"!",LA7I)=X
-"RTN","C0CVOBX1",60,0)
- ;
-"RTN","C0CVOBX1",61,0)
- ; Put units/reference ranges back in variable LA7VAL
-"RTN","C0CVOBX1",62,0)
- S $P(LA7VAL,"^",5)=LA7X
-"RTN","C0CVOBX1",63,0)
- ;
-"RTN","C0CVOBX1",64,0)
- ; Initialize OBX segment
-"RTN","C0CVOBX1",65,0)
- S LA7OBX(0)="OBX"
-"RTN","C0CVOBX1",66,0)
- S LA7OBX(1)=$$OBX1^LA7VOBX(.LA7OBXSN)
-"RTN","C0CVOBX1",67,0)
- ;
-"RTN","C0CVOBX1",68,0)
- ; Value type
-"RTN","C0CVOBX1",69,0)
- S LA7OBX(2)=$$OBX2^LA7VOBX(63.04,LRSB)
-"RTN","C0CVOBX1",70,0)
- ;
-"RTN","C0CVOBX1",71,0)
- ; Observation identifer
-"RTN","C0CVOBX1",72,0)
- ; build alternate code based on dataname from file #63 in case it's needed
-"RTN","C0CVOBX1",73,0)
S LA7X=$P(LA7VAL,"^",3)
+"RTN","C0CVOBX1",38,0)
+ ; WV check for IHS - NLT/LN codes from V LAB file
+"RTN","C0CVOBX1",39,0)
+ I $D(^AUPNVLAB) D TMPCHK^C0CLA7Q
+"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",42,0)
+ ; No result NLT code - log error
+"RTN","C0CVOBX1",43,0)
+ I $P($P(LA7VAL,"^",3),"!",2)="" D
+"RTN","C0CVOBX1",44,0)
+ . N LA7X
+"RTN","C0CVOBX1",45,0)
+ . S LA7X="["_LRSB_"]"_$$GET1^DID(63.04,LRSB,"","LABEL")
+"RTN","C0CVOBX1",46,0)
+ . D CREATE^LA7LOG(36)
+"RTN","C0CVOBX1",47,0)
+ ;
+"RTN","C0CVOBX1",48,0)
+ ; something missing - No NLT code, etc.
+"RTN","C0CVOBX1",49,0)
+ I LA7VAL="" Q
+"RTN","C0CVOBX1",50,0)
+ ;
+"RTN","C0CVOBX1",51,0)
+ ; Check for missing units/reference ranges
+"RTN","C0CVOBX1",52,0)
+ S LA7X=$P(LA7VAL,"^",5)
+"RTN","C0CVOBX1",53,0)
+ ;
+"RTN","C0CVOBX1",54,0)
+ ; Results missing units, lookup in file #60
+"RTN","C0CVOBX1",55,0)
+ I $P(LA7X,"!",7)="" S $P(LA7X,"!",7)=$P($$REFUNIT^LA7VHLU1(LRSB,$P(LA76304(0),"^",5)),"^",3)
+"RTN","C0CVOBX1",56,0)
+ ;
+"RTN","C0CVOBX1",57,0)
+ ; If results missing reference ranges, use values from file #60.
+"RTN","C0CVOBX1",58,0)
+ I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="",$P(LA7X,"!",11)="",$P(LA7X,"!",12)="" D
+"RTN","C0CVOBX1",59,0)
+ . S LA7Y=$$REFUNIT^LA7VHLU1(LRSB,$P(LA76304(0),"^",5))
+"RTN","C0CVOBX1",60,0)
+ . S $P(LA7X,"!",2)=$P(LA7Y,"^")
+"RTN","C0CVOBX1",61,0)
+ . S $P(LA7X,"!",3)=$P(LA7Y,"^",2)
+"RTN","C0CVOBX1",62,0)
+ . S $P(LA7X,"!",11)=$P(LA7Y,"^",6)
+"RTN","C0CVOBX1",63,0)
+ . S $P(LA7X,"!",12)=$P(LA7Y,"^",7)
+"RTN","C0CVOBX1",64,0)
+ ; Use therapeutic low/high if low/high missing.
+"RTN","C0CVOBX1",65,0)
+ I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="" D
+"RTN","C0CVOBX1",66,0)
+ . S $P(LA7X,"!",2)=$P(LA7X,"!",11)
+"RTN","C0CVOBX1",67,0)
+ . S $P(LA7X,"!",3)=$P(LA7X,"!",12)
+"RTN","C0CVOBX1",68,0)
+ ;
+"RTN","C0CVOBX1",69,0)
+ ; Evaluate low/high reference ranges in case M code in these fields.
+"RTN","C0CVOBX1",70,0)
+ S:$G(SEX)="" SEX="M" S:$G(AGE)="" AGE=99
+"RTN","C0CVOBX1",71,0)
+ F LA7I=2,3 I $E($P(LA7X,"!",LA7I),1,3)="$S(" D
+"RTN","C0CVOBX1",72,0)
+ . S @("X="_$P(LA7X,"!",LA7I))
+"RTN","C0CVOBX1",73,0)
+ . S $P(LA7X,"!",LA7I)=X
"RTN","C0CVOBX1",74,0)
- S LA7ALT="CH"_LRSB_"^"_$$GET1^DID(63.04,LRSB,"","LABEL")_"^"_"99VA63"
+ ;
"RTN","C0CVOBX1",75,0)
- S LA7OBX(3)=$$OBX3^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7ALT,LA7FS,LA7ECH)
+ ; Put units/reference ranges back in variable LA7VAL
"RTN","C0CVOBX1",76,0)
- ;
+ S $P(LA7VAL,"^",5)=LA7X
"RTN","C0CVOBX1",77,0)
- ; Test value
+ ;
"RTN","C0CVOBX1",78,0)
- S LA7OBX(5)=$$OBX5^LA7VOBX($P(LA7VAL,"^"),LA7OBX(2),LA7FS,LA7ECH)
+ ; Initialize OBX segment
"RTN","C0CVOBX1",79,0)
- ;
+ S LA7OBX(0)="OBX"
"RTN","C0CVOBX1",80,0)
- ; Units - remove leading and trailing spaces
+ S LA7OBX(1)=$$OBX1^LA7VOBX(.LA7OBXSN)
"RTN","C0CVOBX1",81,0)
- S LA7X=$P(LA7VAL,"^",5),LA7X=$$TRIM^XLFSTR(LA7X,"LR"," ")
+ ;
"RTN","C0CVOBX1",82,0)
- S LA7OBX(6)=$$OBX6^LA7VOBX($P(LA7X,"!",7),"",LA7FS,LA7ECH)
+ ; Value type
"RTN","C0CVOBX1",83,0)
- ;
+ S LA7OBX(2)=$$OBX2^LA7VOBX(63.04,LRSB)
"RTN","C0CVOBX1",84,0)
- ; Reference range
+ ;
"RTN","C0CVOBX1",85,0)
- S LA7OBX(7)=$$OBX7^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7FS,LA7ECH)
+ ; Observation identifer
"RTN","C0CVOBX1",86,0)
- ;
+ ; build alternate code based on dataname from file #63 in case it's needed
"RTN","C0CVOBX1",87,0)
- ; Abnormal flags
+ S LA7X=$P(LA7VAL,"^",3)
"RTN","C0CVOBX1",88,0)
- S LA7OBX(8)=$$OBX8^LA7VOBX($P(LA7VAL,U,2))
+ S LA7ALT="CH"_LRSB_"^"_$$GET1^DID(63.04,LRSB,"","LABEL")_"^"_"99VA63"
"RTN","C0CVOBX1",89,0)
- ;
+ S LA7OBX(3)=$$OBX3^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7ALT,LA7FS,LA7ECH)
"RTN","C0CVOBX1",90,0)
- ; "P"artial or "F"inal results
+ ;
"RTN","C0CVOBX1",91,0)
- S LA7OBX(11)=$$OBX11^LA7VOBX($S("canccommentpending"[$P(LA7VAL,"^"):$P(LA7VAL,"^"),1:"F"))
+ ; Test value
"RTN","C0CVOBX1",92,0)
- ;
+ S LA7OBX(5)=$$OBX5^LA7VOBX($P(LA7VAL,"^"),LA7OBX(2),LA7FS,LA7ECH)
"RTN","C0CVOBX1",93,0)
- ; Observation date/time - collection date/time per HL7 standard
+ ;
"RTN","C0CVOBX1",94,0)
- I $P(LA76304(0),"^") S LA7OBX(14)=$$OBX14^LA7VOBX($P(LA76304(0),"^"))
+ ; Units - remove leading and trailing spaces
"RTN","C0CVOBX1",95,0)
- ;
+ S LA7X=$P(LA7VAL,"^",5),LA7X=$$TRIM^XLFSTR(LA7X,"LR"," ")
"RTN","C0CVOBX1",96,0)
- S LA7DIV=$P(LA7VAL,"^",9)
+ S LA7OBX(6)=$$OBX6^LA7VOBX($P(LA7X,"!",7),"",LA7FS,LA7ECH)
"RTN","C0CVOBX1",97,0)
- I LA7DIV="",$$DIV4^XUSER(.LA7DIV,$P(LA7VAL,"^",4)) S LA7DIV=$O(LA7DIV(0))
+ ;
"RTN","C0CVOBX1",98,0)
- ;
+ ; Reference range
"RTN","C0CVOBX1",99,0)
- ; Facility that performed the testing
+ S LA7OBX(7)=$$OBX7^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7FS,LA7ECH)
"RTN","C0CVOBX1",100,0)
- S LA7OBX(15)=$$OBX15^LA7VOBX(LA7DIV,LA7FS,LA7ECH)
+ ;
"RTN","C0CVOBX1",101,0)
- ;
+ ; Abnormal flags
"RTN","C0CVOBX1",102,0)
- ; Person that verified the test
+ S LA7OBX(8)=$$OBX8^LA7VOBX($P(LA7VAL,U,2))
"RTN","C0CVOBX1",103,0)
- S LA7OBX(16)=$$OBX16^LA7VOBX($P(LA7VAL,"^",4),LA7DIV,LA7FS,LA7ECH)
+ ;
"RTN","C0CVOBX1",104,0)
- ;
+ ; "P"artial or "F"inal results
"RTN","C0CVOBX1",105,0)
- ; Observation method
+ S LA7OBX(11)=$$OBX11^LA7VOBX($S("canccommentpending"[$P(LA7VAL,"^"):$P(LA7VAL,"^"),1:"F"))
"RTN","C0CVOBX1",106,0)
- S LA7X=$P($P(LA7VAL,"^",3),"!",4)
+ ;
"RTN","C0CVOBX1",107,0)
- I LA7X S LA7OBX(17)=$$OBX17^LA7VOBX(LA7X,LA7FS,LA7ECH)
+ ; Observation date/time - collection date/time per HL7 standard
"RTN","C0CVOBX1",108,0)
- ;
+ I $P(LA76304(0),"^") S LA7OBX(14)=$$OBX14^LA7VOBX($P(LA76304(0),"^"))
"RTN","C0CVOBX1",109,0)
- ; Equipment entity identifier
+ ;
"RTN","C0CVOBX1",110,0)
- I $L($P(LA7VAL,"^",11)) S LA7OBX(18)=$$OBX18^LA7VOBX($P(LA7VAL,"^",11),LA7FS,LA7ECH)
+ S LA7DIV=$P(LA7VAL,"^",9)
"RTN","C0CVOBX1",111,0)
- ;
+ I LA7DIV="",$$DIV4^XUSER(.LA7DIV,$P(LA7VAL,"^",4)) S LA7DIV=$O(LA7DIV(0))
"RTN","C0CVOBX1",112,0)
- D BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS)
-"RTN","C0CVOBX1",113,0)
;
+"RTN","C0CVOBX1",113,0)
+ ; Facility that performed the testing
"RTN","C0CVOBX1",114,0)
+ S LA7OBX(15)=$$OBX15^LA7VOBX(LA7DIV,LA7FS,LA7ECH)
+"RTN","C0CVOBX1",115,0)
+ ;
+"RTN","C0CVOBX1",116,0)
+ ; Person that verified the test
+"RTN","C0CVOBX1",117,0)
+ S LA7OBX(16)=$$OBX16^LA7VOBX($P(LA7VAL,"^",4),LA7DIV,LA7FS,LA7ECH)
+"RTN","C0CVOBX1",118,0)
+ ;
+"RTN","C0CVOBX1",119,0)
+ ; Observation method
+"RTN","C0CVOBX1",120,0)
+ S LA7X=$P($P(LA7VAL,"^",3),"!",4)
+"RTN","C0CVOBX1",121,0)
+ I LA7X S LA7OBX(17)=$$OBX17^LA7VOBX(LA7X,LA7FS,LA7ECH)
+"RTN","C0CVOBX1",122,0)
+ ;
+"RTN","C0CVOBX1",123,0)
+ ; Equipment entity identifier
+"RTN","C0CVOBX1",124,0)
+ I $L($P(LA7VAL,"^",11)) S LA7OBX(18)=$$OBX18^LA7VOBX($P(LA7VAL,"^",11),LA7FS,LA7ECH)
+"RTN","C0CVOBX1",125,0)
+ ;
+"RTN","C0CVOBX1",126,0)
+ D BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS)
+"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)
-EN(LA) ; called from C0CVLAB
+ ; (C) 2009 John McCormack
"RTN","C0CVORU",5,0)
- ; variables
+ ; This program is free software: you can redistribute it and/or modify
"RTN","C0CVORU",6,0)
- ; LA("HUID") - Host Unique ID from the local ACCESSION file (#68)
+ ; it under the terms of the GNU Affero General Public License as
"RTN","C0CVORU",7,0)
- ; LA("SITE") - Ordering site IEN in the INSTITUTION file (#4)
+ ; published by the Free Software Foundation, either version 3 of the
"RTN","C0CVORU",8,0)
- ; LA("RUID") - Remote sites Unique ID from ACCESSION file (#68)
+ ; License, or (at your option) any later version.
"RTN","C0CVORU",9,0)
- ; LA("ORD") - Free text ordered test name from WKLD CODE file (#64)
+ ;
"RTN","C0CVORU",10,0)
- ; LA("NLT") - National Laboratory test code from WKLD CODE file (#64)
+ ; This program is distributed in the hope that it will be useful,
"RTN","C0CVORU",11,0)
- ; LA("LRIDT") - Inverse date/time the lab arrival time (accession date/time)
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0CVORU",12,0)
- ; LA("SUB") - test subscript defined in LABORATORY TEST file (#60)
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
"RTN","C0CVORU",13,0)
- ; LA("LRDFN") - IEN in LAB DATA file (#63)
+ ; GNU Affero General Public License for more details.
"RTN","C0CVORU",14,0)
- ; LA("ORD"), LA("NLT"), and LA("SUB") are sent for specific lab results.
+ ;
"RTN","C0CVORU",15,0)
- ; LA("AUTO-INST") - Auto-Instrument
+ ; You should have received a copy of the GNU Affero General Public License
"RTN","C0CVORU",16,0)
- ;
+ ; along with this program. If not, see .
"RTN","C0CVORU",17,0)
- N LA763,LA7NLT,LA7NVAF,LA7X,PRIMARY
+ ;
"RTN","C0CVORU",18,0)
- ;
+EN(LA) ; called from C0CVLAB
"RTN","C0CVORU",19,0)
- S PRIMARY=$$PRIM^VASITE(DT),LA("AUTO-INST")=""
+ ; variables
"RTN","C0CVORU",20,0)
- I $G(PRIMARY)'="" D
+ ; LA("HUID") - Host Unique ID from the local ACCESSION file (#68)
"RTN","C0CVORU",21,0)
- . S PRIMARY=$$SITE^VASITE(DT,PRIMARY)
+ ; LA("SITE") - Ordering site IEN in the INSTITUTION file (#4)
"RTN","C0CVORU",22,0)
- . S PRIMARY=$P(PRIMARY,U,3)
+ ; LA("RUID") - Remote sites Unique ID from ACCESSION file (#68)
"RTN","C0CVORU",23,0)
- . S LA("AUTO-INST")="LA7V HOST "_PRIMARY
+ ; LA("ORD") - Free text ordered test name from WKLD CODE file (#64)
"RTN","C0CVORU",24,0)
- ;
+ ; LA("NLT") - National Laboratory test code from WKLD CODE file (#64)
"RTN","C0CVORU",25,0)
- I '$O(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0)) D Q
+ ; LA("LRIDT") - Inverse date/time the lab arrival time (accession date/time)
"RTN","C0CVORU",26,0)
- . ; need to add error logging when no entry in 63.
+ ; LA("SUB") - test subscript defined in LABORATORY TEST file (#60)
"RTN","C0CVORU",27,0)
- ;
+ ; LA("LRDFN") - IEN in LAB DATA file (#63)
"RTN","C0CVORU",28,0)
- ; Get zeroth node of entry in #63.
+ ; LA("ORD"), LA("NLT"), and LA("SUB") are sent for specific lab results.
"RTN","C0CVORU",29,0)
- S LA763(0)=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0))
+ ; LA("AUTO-INST") - Auto-Instrument
"RTN","C0CVORU",30,0)
- S LA7NLT=$G(LA("NLT"))
+ ;
"RTN","C0CVORU",31,0)
- ;
+ N LA763,LA7NLT,LA7NVAF,LA7X,PRIMARY
"RTN","C0CVORU",32,0)
- S LA7NVAF=$$NVAF^LA7VHLU2(+LA("SITE"))
+ ;
"RTN","C0CVORU",33,0)
- S LA7NTESN=0
+ S PRIMARY=$$PRIM^VASITE(DT),LA("AUTO-INST")=""
"RTN","C0CVORU",34,0)
- D ORC
+ I $G(PRIMARY)'="" D
"RTN","C0CVORU",35,0)
- ;
+ . S PRIMARY=$$SITE^VASITE(DT,PRIMARY)
"RTN","C0CVORU",36,0)
- I $G(LA("SUB"))="CH" D CH
+ . S PRIMARY=$P(PRIMARY,U,3)
"RTN","C0CVORU",37,0)
- ;I $G(LA("SUB"))="MI" D MI^LA7VORU1
+ . S LA("AUTO-INST")="LA7V HOST "_PRIMARY
"RTN","C0CVORU",38,0)
- ;I "SPCYEM"[$G(LA("SUB")) D AP^LA7VORU2
-"RTN","C0CVORU",39,0)
- Q
-"RTN","C0CVORU",40,0)
;
+"RTN","C0CVORU",39,0)
+ I '$O(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0)) D Q
+"RTN","C0CVORU",40,0)
+ . ; need to add error logging when no entry in 63.
"RTN","C0CVORU",41,0)
;
"RTN","C0CVORU",42,0)
-CH ; Build segments for "CH" subscript
+ ; Get zeroth node of entry in #63.
"RTN","C0CVORU",43,0)
- ;
+ S LA763(0)=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0))
"RTN","C0CVORU",44,0)
- D OBR
+ S LA7NLT=$G(LA("NLT"))
"RTN","C0CVORU",45,0)
- D NTE
+ ;
"RTN","C0CVORU",46,0)
- S LA7OBXSN=0
+ S LA7NVAF=$$NVAF^LA7VHLU2(+LA("SITE"))
"RTN","C0CVORU",47,0)
- D OBX
+ S LA7NTESN=0
"RTN","C0CVORU",48,0)
- ;
+ D ORC
"RTN","C0CVORU",49,0)
- Q
+ ;
"RTN","C0CVORU",50,0)
- ;
+ I $G(LA("SUB"))="CH" D CH
"RTN","C0CVORU",51,0)
- ;
+ ;I $G(LA("SUB"))="MI" D MI^LA7VORU1
"RTN","C0CVORU",52,0)
-ORC ; Build ORC segment
+ ;I "SPCYEM"[$G(LA("SUB")) D AP^LA7VORU2
"RTN","C0CVORU",53,0)
- ;
+ Q
"RTN","C0CVORU",54,0)
- N LA763,LA7696,LA7DATA,LA7SM,LA7X,LA7Y,ORC
+ ;
"RTN","C0CVORU",55,0)
;
"RTN","C0CVORU",56,0)
- S LA763(0)=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0))
+CH ; Build segments for "CH" subscript
"RTN","C0CVORU",57,0)
;
"RTN","C0CVORU",58,0)
- S ORC(0)="ORC"
+ D OBR
"RTN","C0CVORU",59,0)
- ;
+ D NTE
"RTN","C0CVORU",60,0)
- ; Order control
+ S LA7OBXSN=0
"RTN","C0CVORU",61,0)
- S ORC(1)=$$ORC1^LA7VORC("RE")
+ D OBX
"RTN","C0CVORU",62,0)
;
"RTN","C0CVORU",63,0)
- ; Remote UID
+ Q
"RTN","C0CVORU",64,0)
- S ORC(2)=$$ORC2^LA7VORC(LA("RUID"),LA7FS,LA7ECH)
+ ;
"RTN","C0CVORU",65,0)
;
"RTN","C0CVORU",66,0)
- ; Host UID
+ORC ; Build ORC segment
"RTN","C0CVORU",67,0)
- S ORC(3)=$$ORC3^LA7VORC(LA("HUID"),LA7FS,LA7ECH)
+ ;
"RTN","C0CVORU",68,0)
- ;
+ N LA763,LA7696,LA7DATA,LA7SM,LA7X,LA7Y,ORC
"RTN","C0CVORU",69,0)
- ; Return shipping manifest if found
+ ;
"RTN","C0CVORU",70,0)
- S LA7SM="",LA7696=0
+ S LA763(0)=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0))
"RTN","C0CVORU",71,0)
- I LA("SITE")'="",LA("RUID")'="" S LA7696=$O(^LRO(69.6,"RST",LA("SITE"),LA("RUID"),0))
+ ;
"RTN","C0CVORU",72,0)
- I LA7696 S LA7SM=$P($G(^LRO(69.6,LA7696,0)),U,14)
+ S ORC(0)="ORC"
"RTN","C0CVORU",73,0)
- I LA7SM'="" S ORC(4)=$$ORC4^LA7VORC(LA7SM,LA7FS,LA7ECH)
+ ;
"RTN","C0CVORU",74,0)
- ;
+ ; Order control
"RTN","C0CVORU",75,0)
- ; Order status
+ S ORC(1)=$$ORC1^LA7VORC("RE")
"RTN","C0CVORU",76,0)
- ; DoD/CHCS requires ORC-5 valued otherwise will not process message
-"RTN","C0CVORU",77,0)
- I LA7NVAF=1 S ORC(5)=$$ORC5^LA7VORC("CM",LA7FS,LA7ECH)
-"RTN","C0CVORU",78,0)
;
+"RTN","C0CVORU",77,0)
+ ; Remote UID
+"RTN","C0CVORU",78,0)
+ S ORC(2)=$$ORC2^LA7VORC(LA("RUID"),LA7FS,LA7ECH)
"RTN","C0CVORU",79,0)
- ; Ordering provider
+ ;
"RTN","C0CVORU",80,0)
- S (LA7X,LA7Y)=""
+ ; Host UID
"RTN","C0CVORU",81,0)
- ; "CH" subscript stores requesting provider and requesting div/location.
+ S ORC(3)=$$ORC3^LA7VORC(LA("HUID"),LA7FS,LA7ECH)
"RTN","C0CVORU",82,0)
- I LA("SUB")="CH" D
+ ;
"RTN","C0CVORU",83,0)
- . N LA7J
+ ; Return shipping manifest if found
"RTN","C0CVORU",84,0)
- . S LA7J=$P(LA763(0),"^",13)
+ S LA7SM="",LA7696=0
"RTN","C0CVORU",85,0)
- . I $P(LA7J,";",2)="SC(" S LA7Y=$$GET1^DIQ(44,$P(LA7J,";")_",",3,"I")
+ I LA("SITE")'="",LA("RUID")'="" S LA7696=$O(^LRO(69.6,"RST",LA("SITE"),LA("RUID"),0))
"RTN","C0CVORU",86,0)
- . I $P(LA7J,";",2)="DIC(4," S LA7Y=$P(LA7J,";")
+ I LA7696 S LA7SM=$P($G(^LRO(69.6,LA7696,0)),U,14)
"RTN","C0CVORU",87,0)
- . S LA7X=$P(LA763(0),"^",10)
+ I LA7SM'="" S ORC(4)=$$ORC4^LA7VORC(LA7SM,LA7FS,LA7ECH)
"RTN","C0CVORU",88,0)
;
"RTN","C0CVORU",89,0)
- ; Other subscripts only store requesting provider
+ ; Order status
"RTN","C0CVORU",90,0)
- I "CYEMMISP"[LA("SUB") S LA7X=$P(LA763(0),"^",7)
+ ; DoD/CHCS requires ORC-5 valued otherwise will not process message
"RTN","C0CVORU",91,0)
- ; Get default institution from MailMan Site Parameters file
+ I LA7NVAF=1 S ORC(5)=$$ORC5^LA7VORC("CM",LA7FS,LA7ECH)
"RTN","C0CVORU",92,0)
- I LA7Y="" S LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
+ ;
"RTN","C0CVORU",93,0)
- S ORC(12)=$$ORC12^LA7VORC(LA7X,LA7Y,LA7FS,LA7ECH)
+ ; Ordering provider
"RTN","C0CVORU",94,0)
- ;
+ S (LA7X,LA7Y)=""
"RTN","C0CVORU",95,0)
- ; Entering organization
+ ; "CH" subscript stores requesting provider and requesting div/location.
"RTN","C0CVORU",96,0)
- S ORC(17)=$$ORC17^LA7VORC(LA7Y,LA7FS,LA7ECH)
+ I LA("SUB")="CH" D
"RTN","C0CVORU",97,0)
- ;
+ . N LA7J
"RTN","C0CVORU",98,0)
- D BUILDSEG^LA7VHLU(.ORC,.LA7DATA,LA7FS)
+ . S LA7J=$P(LA763(0),"^",13)
"RTN","C0CVORU",99,0)
- D FILESEG^LA7VHLU(GBL,.LA7DATA)
+ . I $P(LA7J,";",2)="SC(" S LA7Y=$$GET1^DIQ(44,$P(LA7J,";")_",",3,"I")
"RTN","C0CVORU",100,0)
- ;
+ . I $P(LA7J,";",2)="DIC(4," S LA7Y=$P(LA7J,";")
"RTN","C0CVORU",101,0)
- ; Check for flag to only build message but do not file
+ . S LA7X=$P(LA763(0),"^",10)
"RTN","C0CVORU",102,0)
- I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249P,.LA7DATA)
+ ;
"RTN","C0CVORU",103,0)
- ;
+ ; Other subscripts only store requesting provider
"RTN","C0CVORU",104,0)
- Q
+ I "CYEMMISP"[LA("SUB") S LA7X=$P(LA763(0),"^",7)
"RTN","C0CVORU",105,0)
- ;
+ ; Get default institution from MailMan Site Parameters file
"RTN","C0CVORU",106,0)
- ;
+ I LA7Y="" S LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
"RTN","C0CVORU",107,0)
-OBR ;Observation Request segment for Lab Order
+ S ORC(12)=$$ORC12^LA7VORC(LA7X,LA7Y,LA7FS,LA7ECH)
"RTN","C0CVORU",108,0)
;
"RTN","C0CVORU",109,0)
- N LA761,LA762,LA7DATA,LA7PLOBR,LA7X,LA7Y,OBR
+ ; Entering organization
"RTN","C0CVORU",110,0)
- ;
+ S ORC(17)=$$ORC17^LA7VORC(LA7Y,LA7FS,LA7ECH)
"RTN","C0CVORU",111,0)
- ; Retrieve placer's OBR information stored in #69.6
-"RTN","C0CVORU",112,0)
- D RETOBR^LA7VHLU(LA("SITE"),LA("RUID"),LA("NLT"),.LA7PLOBR)
-"RTN","C0CVORU",113,0)
;
+"RTN","C0CVORU",112,0)
+ D BUILDSEG^LA7VHLU(.ORC,.LA7DATA,LA7FS)
+"RTN","C0CVORU",113,0)
+ D FILESEG^LA7VHLU(GBL,.LA7DATA)
"RTN","C0CVORU",114,0)
- ; Initialize OBR segment
+ ;
"RTN","C0CVORU",115,0)
- S OBR(0)="OBR"
+ ; Check for flag to only build message but do not file
"RTN","C0CVORU",116,0)
- S OBR(1)=$$OBR1^LA7VOBR(.LA7OBRSN)
+ I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249P,.LA7DATA)
"RTN","C0CVORU",117,0)
;
"RTN","C0CVORU",118,0)
- ; Remote UID
+ Q
"RTN","C0CVORU",119,0)
- S OBR(2)=$$OBR2^LA7VOBR(LA("RUID"),LA7FS,LA7ECH)
+ ;
"RTN","C0CVORU",120,0)
;
"RTN","C0CVORU",121,0)
- ; Host UID
+OBR ;Observation Request segment for Lab Order
"RTN","C0CVORU",122,0)
- S OBR(3)=$$OBR3^LA7VOBR(LA("HUID"),LA7FS,LA7ECH)
+ ;
"RTN","C0CVORU",123,0)
- ;
+ N LA761,LA762,LA7DATA,LA7PLOBR,LA7X,LA7Y,OBR
"RTN","C0CVORU",124,0)
- ; Universal service ID, build from info stored in #69.6
-"RTN","C0CVORU",125,0)
- S LA7X=""
-"RTN","C0CVORU",126,0)
- I $G(LA7PLOBR("OBR-4"))'="" S OBR(4)=$$CNVFLD^LA7VHLU3(LA7PLOBR("OBR-4"),LA7PLOBR("ECH"),LA7ECH)
-"RTN","C0CVORU",127,0)
- E S OBR(4)=$$OBR4^LA7VOBR(LA7NLT,"",LA7X,LA7FS,LA7ECH)
-"RTN","C0CVORU",128,0)
;
+"RTN","C0CVORU",125,0)
+ ; Retrieve placer's OBR information stored in #69.6
+"RTN","C0CVORU",126,0)
+ D RETOBR^LA7VHLU(LA("SITE"),LA("RUID"),LA("NLT"),.LA7PLOBR)
+"RTN","C0CVORU",127,0)
+ ;
+"RTN","C0CVORU",128,0)
+ ; Initialize OBR segment
"RTN","C0CVORU",129,0)
- ; Collection D/T
+ S OBR(0)="OBR"
"RTN","C0CVORU",130,0)
- S OBR(7)=$$OBR7^LA7VOBR($P(LA763(0),U))
+ S OBR(1)=$$OBR1^LA7VOBR(.LA7OBRSN)
"RTN","C0CVORU",131,0)
;
"RTN","C0CVORU",132,0)
- ; Specimen action code
+ ; Remote UID
"RTN","C0CVORU",133,0)
- ; If no OBR from PENDING ORDER file (#69.6) then assume added test.
+ S OBR(2)=$$OBR2^LA7VOBR(LA("RUID"),LA7FS,LA7ECH)
"RTN","C0CVORU",134,0)
- I $G(LA7INTYP)=10,$G(LA7PLOBR("OBR-4"))="" S OBR(11)=$$OBR11^LA7VOBR("A")
+ ;
"RTN","C0CVORU",135,0)
- ;
+ ; Host UID
"RTN","C0CVORU",136,0)
- ; Infection Warning
+ S OBR(3)=$$OBR3^LA7VOBR(LA("HUID"),LA7FS,LA7ECH)
"RTN","C0CVORU",137,0)
- S OBR(12)=$$OBR12^LA7VOBR(LRDFN,LA7FS,LA7ECH)
+ ;
"RTN","C0CVORU",138,0)
- ;
+ ; Universal service ID, build from info stored in #69.6
"RTN","C0CVORU",139,0)
- ; Lab Arrival Time
+ S LA7X=""
"RTN","C0CVORU",140,0)
- ; "CH" subscript does not store lab arrival time, use collection time.
+ I $G(LA7PLOBR("OBR-4"))'="" S OBR(4)=$$CNVFLD^LA7VHLU3(LA7PLOBR("OBR-4"),LA7PLOBR("ECH"),LA7ECH)
"RTN","C0CVORU",141,0)
- ; Other subscripts do store lab arrival time (date/time received).
+ E S OBR(4)=$$OBR4^LA7VOBR(LA7NLT,"",LA7X,LA7FS,LA7ECH)
"RTN","C0CVORU",142,0)
- I "CYEMMISP"[LA("SUB") S OBR(14)=$$OBR14^LA7VOBR($P(LA763(0),"^",10))
-"RTN","C0CVORU",143,0)
- I LA("SUB")="CH" S OBR(14)=$$OBR14^LA7VOBR($P(LA763(0),"^"))
-"RTN","C0CVORU",144,0)
;
+"RTN","C0CVORU",143,0)
+ ; Collection D/T
+"RTN","C0CVORU",144,0)
+ S OBR(7)=$$OBR7^LA7VOBR($P(LA763(0),U))
"RTN","C0CVORU",145,0)
- ; Specimen source
+ ;
"RTN","C0CVORU",146,0)
- S (LA761,LA762)=""
+ ; Specimen action code
"RTN","C0CVORU",147,0)
- I "CHMI"[LA("SUB") D
+ ; If no OBR from PENDING ORDER file (#69.6) then assume added test.
"RTN","C0CVORU",148,0)
- . S LA761=$P(LA763(0),U,5)
+ I $G(LA7INTYP)=10,$G(LA7PLOBR("OBR-4"))="" S OBR(11)=$$OBR11^LA7VOBR("A")
"RTN","C0CVORU",149,0)
- . I LA761="" D CREATE^LA7LOG(27)
+ ;
"RTN","C0CVORU",150,0)
- . I LA("SUB")="MI" S LA762=$P(LA763(0),U,11)
+ ; Infection Warning
"RTN","C0CVORU",151,0)
- S OBR(15)=$$OBR15^LA7VOBR(LA761,LA762,"",LA7FS,LA7ECH)
+ S OBR(12)=$$OBR12^LA7VOBR(LRDFN,LA7FS,LA7ECH)
"RTN","C0CVORU",152,0)
;
"RTN","C0CVORU",153,0)
- ; Ordering provider
+ ; Lab Arrival Time
"RTN","C0CVORU",154,0)
- S (LA7X,LA7Y)=""
+ ; "CH" subscript does not store lab arrival time, use collection time.
"RTN","C0CVORU",155,0)
- ; "CH" subscript stores requesting provider and requesting div/location.
+ ; Other subscripts do store lab arrival time (date/time received).
"RTN","C0CVORU",156,0)
- I LA("SUB")="CH" D
+ I "CYEMMISP"[LA("SUB") S OBR(14)=$$OBR14^LA7VOBR($P(LA763(0),"^",10))
"RTN","C0CVORU",157,0)
- . N LA7J
+ I LA("SUB")="CH" S OBR(14)=$$OBR14^LA7VOBR($P(LA763(0),"^"))
"RTN","C0CVORU",158,0)
- . S LA7J=$P(LA763(0),"^",13)
+ ;
"RTN","C0CVORU",159,0)
- . I $P(LA7J,";",2)="SC(" S LA7Y=$$GET1^DIQ(44,$P(LA7J,";")_",",3,"I")
+ ; Specimen source
"RTN","C0CVORU",160,0)
- . I $P(LA7J,";",2)="DIC(4," S LA7Y=$P(LA7J,";")
+ S (LA761,LA762)=""
"RTN","C0CVORU",161,0)
- . S LA7X=$P(LA763(0),"^",10)
+ I "CHMI"[LA("SUB") D
"RTN","C0CVORU",162,0)
- ;
+ . S LA761=$P(LA763(0),U,5)
"RTN","C0CVORU",163,0)
- ; Other subscripts only store requesting provider
+ . I LA761="" D CREATE^LA7LOG(27)
"RTN","C0CVORU",164,0)
- I "CYEMMISP"[LA("SUB") S LA7X=$P(LA763(0),"^",7)
+ . I LA("SUB")="MI" S LA762=$P(LA763(0),U,11)
"RTN","C0CVORU",165,0)
- ; Get default institution from MailMan Site Parameters file
+ S OBR(15)=$$OBR15^LA7VOBR(LA761,LA762,"",LA7FS,LA7ECH)
"RTN","C0CVORU",166,0)
- I LA7Y="" S LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
+ ;
"RTN","C0CVORU",167,0)
- S OBR(16)=$$ORC12^LA7VORC(LA7X,LA7Y,LA7FS,LA7ECH)
+ ; Ordering provider
"RTN","C0CVORU",168,0)
- ;
+ S (LA7X,LA7Y)=""
"RTN","C0CVORU",169,0)
- ; Placer Field #1 (remote auto-inst)
+ ; "CH" subscript stores requesting provider and requesting div/location.
"RTN","C0CVORU",170,0)
- ; Build from info stored in #69.6
+ I LA("SUB")="CH" D
"RTN","C0CVORU",171,0)
- I $G(LA7PLOBR("OBR-18"))'="" D
+ . N LA7J
"RTN","C0CVORU",172,0)
- . S OBR(18)=$$CHKDATA^LA7VHLU3(LA7PLOBR("OBR-18"),LA7FS_LA7ECH)
+ . S LA7J=$P(LA763(0),"^",13)
"RTN","C0CVORU",173,0)
- ; Else build "auto instrument" if sending to VA facility
+ . I $P(LA7J,";",2)="SC(" S LA7Y=$$GET1^DIQ(44,$P(LA7J,";")_",",3,"I")
"RTN","C0CVORU",174,0)
- I $G(LA7PLOBR("OBR-18"))="",'LA7NVAF D
+ . I $P(LA7J,";",2)="DIC(4," S LA7Y=$P(LA7J,";")
"RTN","C0CVORU",175,0)
- . N LA7X
+ . S LA7X=$P(LA763(0),"^",10)
"RTN","C0CVORU",176,0)
- . S LA7X(1)=LA("AUTO-INST")
+ ;
"RTN","C0CVORU",177,0)
- . S OBR(18)=$$OBR18^LA7VOBR(.LA7X,LA7FS,LA7ECH)
+ ; Other subscripts only store requesting provider
"RTN","C0CVORU",178,0)
- ;
+ I "CYEMMISP"[LA("SUB") S LA7X=$P(LA763(0),"^",7)
"RTN","C0CVORU",179,0)
- ; Placer Field #2
+ ; Get default institution from MailMan Site Parameters file
"RTN","C0CVORU",180,0)
- I $G(LA7PLOBR("OBR-19"))'="" D
+ I LA7Y="" S LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
"RTN","C0CVORU",181,0)
- . S OBR(19)=$$CHKDATA^LA7VHLU3(LA7PLOBR("OBR-19"),LA7FS_LA7ECH)
+ S OBR(16)=$$ORC12^LA7VORC(LA7X,LA7Y,LA7FS,LA7ECH)
"RTN","C0CVORU",182,0)
- ; Else build collecting UID if sending to VA facility
+ ;
"RTN","C0CVORU",183,0)
- I $G(LA7PLOBR("OBR-19"))="",'LA7NVAF,LA("RUID")'="" D
+ ; Placer Field #1 (remote auto-inst)
"RTN","C0CVORU",184,0)
- . K LA7X
+ ; Build from info stored in #69.6
"RTN","C0CVORU",185,0)
- . S LA7X(7)=LA("RUID")
+ I $G(LA7PLOBR("OBR-18"))'="" D
"RTN","C0CVORU",186,0)
- . S OBR(19)=$$OBR19^LA7VOBR(.LA7X,LA7FS,LA7ECH)
+ . S OBR(18)=$$CHKDATA^LA7VHLU3(LA7PLOBR("OBR-18"),LA7FS_LA7ECH)
"RTN","C0CVORU",187,0)
- ;
+ ; Else build "auto instrument" if sending to VA facility
"RTN","C0CVORU",188,0)
- ; Filler Field #1
+ I $G(LA7PLOBR("OBR-18"))="",'LA7NVAF D
"RTN","C0CVORU",189,0)
- ; Send file #63 ien info - used by HDR to track patient/specimen
+ . N LA7X
"RTN","C0CVORU",190,0)
- K LA7X
+ . S LA7X(1)=LA("AUTO-INST")
"RTN","C0CVORU",191,0)
- S LA7X(1)=LA("LRDFN")
+ . S OBR(18)=$$OBR18^LA7VOBR(.LA7X,LA7FS,LA7ECH)
"RTN","C0CVORU",192,0)
- S LA7X(2)=LA("SUB")
+ ;
"RTN","C0CVORU",193,0)
- S LA7X(3)=LA("LRIDT")
+ ; Placer Field #2
"RTN","C0CVORU",194,0)
- S OBR(20)=$$OBR20^LA7VOBR(.LA7X,LA7FS,LA7ECH)
+ I $G(LA7PLOBR("OBR-19"))'="" D
"RTN","C0CVORU",195,0)
- ;
+ . S OBR(19)=$$CHKDATA^LA7VHLU3(LA7PLOBR("OBR-19"),LA7FS_LA7ECH)
"RTN","C0CVORU",196,0)
- ; Date Report Completed
+ ; Else build collecting UID if sending to VA facility
"RTN","C0CVORU",197,0)
- I $P(LA763(0),"^",3) S OBR(22)=$$OBR22^LA7VOBR($P(LA763(0),"^",3))
+ I $G(LA7PLOBR("OBR-19"))="",'LA7NVAF,LA("RUID")'="" D
"RTN","C0CVORU",198,0)
- ;
+ . K LA7X
"RTN","C0CVORU",199,0)
- ; Diagnostic service id
+ . S LA7X(7)=LA("RUID")
"RTN","C0CVORU",200,0)
- S OBR(24)=$$OBR24^LA7VOBR(LA("SUB")_"^"_$G(LRSB))
+ . S OBR(19)=$$OBR19^LA7VOBR(.LA7X,LA7FS,LA7ECH)
"RTN","C0CVORU",201,0)
;
"RTN","C0CVORU",202,0)
- ; Parent Result and Parent
+ ; Filler Field #1
"RTN","C0CVORU",203,0)
- I $D(LA7PARNT) D
+ ; Send file #63 ien info - used by HDR to track patient/specimen
"RTN","C0CVORU",204,0)
- . S OBR(26)=$$OBR26^LA7VOBR(LA7PARNT(1),LA7PARNT(2),LA7PARNT(3),LA7FS,LA7ECH)
+ K LA7X
"RTN","C0CVORU",205,0)
- . S OBR(29)=$$OBR29^LA7VOBR(LA("RUID"),LA("HUID"),LA7FS,LA7ECH)
+ S LA7X(1)=LA("LRDFN")
"RTN","C0CVORU",206,0)
- ;
+ S LA7X(2)=LA("SUB")
"RTN","C0CVORU",207,0)
- ; Principle result interpreter
+ S LA7X(3)=LA("LRIDT")
"RTN","C0CVORU",208,0)
- ; Get default institution from MailMan Site Parameters file
+ S OBR(20)=$$OBR20^LA7VOBR(.LA7X,LA7FS,LA7ECH)
"RTN","C0CVORU",209,0)
- I "CYEMMISP"[LA("SUB") D
+ ;
"RTN","C0CVORU",210,0)
- . I LA("SUB")="MI" S LA7X=$P(LA763(0),"^",4)
+ ; Date Report Completed
"RTN","C0CVORU",211,0)
- . E S LA7X=$P(LA763(0),"^",2)
+ I $P(LA763(0),"^",3) S OBR(22)=$$OBR22^LA7VOBR($P(LA763(0),"^",3))
"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)
+ ; Diagnostic service id
"RTN","C0CVORU",214,0)
- ;
+ S OBR(24)=$$OBR24^LA7VOBR(LA("SUB")_"^"_$G(LRSB))
"RTN","C0CVORU",215,0)
- ; Assistant result interpreter
+ ;
"RTN","C0CVORU",216,0)
- ; Get default institution from MailMan Site Parameters file
+ ; Parent Result and Parent
"RTN","C0CVORU",217,0)
- I "EMSP"[LA("SUB") D
+ I $D(LA7PARNT) D
"RTN","C0CVORU",218,0)
- . S LA7X=$P(LA763(0),"^",4),LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
+ . S OBR(26)=$$OBR26^LA7VOBR(LA7PARNT(1),LA7PARNT(2),LA7PARNT(3),LA7FS,LA7ECH)
"RTN","C0CVORU",219,0)
- . S OBR(33)=$$OBR33^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)
+ . S OBR(29)=$$OBR29^LA7VOBR(LA("RUID"),LA("HUID"),LA7FS,LA7ECH)
"RTN","C0CVORU",220,0)
- ;
+ ;
"RTN","C0CVORU",221,0)
- ; Technician
+ ; Principle result interpreter
"RTN","C0CVORU",222,0)
; Get default institution from MailMan Site Parameters file
"RTN","C0CVORU",223,0)
- I "CYEM"[LA("SUB") D
+ I "CYEMMISP"[LA("SUB") D
"RTN","C0CVORU",224,0)
- . S LA7X=$P(LA763(0),"^",4),LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
+ . I LA("SUB")="MI" S LA7X=$P(LA763(0),"^",4)
"RTN","C0CVORU",225,0)
- . S OBR(34)=$$OBR34^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)
+ . E S LA7X=$P(LA763(0),"^",2)
"RTN","C0CVORU",226,0)
- ;
+ . S LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
"RTN","C0CVORU",227,0)
- ; Typist - VistA stores as free text
+ . S OBR(32)=$$OBR32^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)
"RTN","C0CVORU",228,0)
- ; Get default institution from MailMan Site Parameters file
-"RTN","C0CVORU",229,0)
- I "CYEMSP"[LA("SUB") D
-"RTN","C0CVORU",230,0)
- . S LA7X=$P(LA763(0),"^",9),LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
-"RTN","C0CVORU",231,0)
- . S OBR(35)=$$OBR35^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)
-"RTN","C0CVORU",232,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)
- D BUILDSEG^LA7VHLU(.OBR,.LA7DATA,LA7FS)
+ . S OBR(33)=$$OBR33^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)
"RTN","C0CVORU",234,0)
- D FILESEG^LA7VHLU(GBL,.LA7DATA)
+ ;
"RTN","C0CVORU",235,0)
- ;
+ ; Technician
"RTN","C0CVORU",236,0)
- ; Check for flag to only build message but do not file
+ ; Get default institution from MailMan Site Parameters file
"RTN","C0CVORU",237,0)
- I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
+ I "CYEM"[LA("SUB") D
"RTN","C0CVORU",238,0)
- ;
+ . S LA7X=$P(LA763(0),"^",4),LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
"RTN","C0CVORU",239,0)
- Q
+ . S OBR(34)=$$OBR34^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)
"RTN","C0CVORU",240,0)
- ;
+ ;
"RTN","C0CVORU",241,0)
- ;
+ ; Typist - VistA stores as free text
"RTN","C0CVORU",242,0)
-OBX ;Observation/Result segment for Lab Results
+ ; Get default institution from MailMan Site Parameters file
"RTN","C0CVORU",243,0)
- ;
+ I "CYEMSP"[LA("SUB") D
"RTN","C0CVORU",244,0)
- N LA7953,LA7DATA,LA7VT,LA7VTIEN,LA7X
+ . S LA7X=$P(LA763(0),"^",9),LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
"RTN","C0CVORU",245,0)
- ;
+ . S OBR(35)=$$OBR35^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)
"RTN","C0CVORU",246,0)
- S LA7VTIEN=0
+ ;
"RTN","C0CVORU",247,0)
- F S LA7VTIEN=$O(^LAHM(62.49,LA(62.49),1,LA7VTIEN)) Q:'LA7VTIEN D
+ D BUILDSEG^LA7VHLU(.OBR,.LA7DATA,LA7FS)
"RTN","C0CVORU",248,0)
- . S LA7VT=$P(^LAHM(62.49,LA(62.49),1,LA7VTIEN,0),"^",1,2)
+ D FILESEG^LA7VHLU(GBL,.LA7DATA)
"RTN","C0CVORU",249,0)
- . ; Build OBX segment
+ ;
"RTN","C0CVORU",250,0)
- . K LA7DATA
+ ; Check for flag to only build message but do not file
"RTN","C0CVORU",251,0)
- . D OBX^LA7VOBX(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^",1,2),.LA7DATA,.LA7OBXSN,LA7FS,LA7ECH,$G(LA7NVAF))
+ I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
"RTN","C0CVORU",252,0)
- . ; If OBX failed to build then don't store
+ ;
"RTN","C0CVORU",253,0)
- . I '$D(LA7DATA) Q
-"RTN","C0CVORU",254,0)
- . ;
-"RTN","C0CVORU",255,0)
- . D FILESEG^LA7VHLU(GBL,.LA7DATA)
-"RTN","C0CVORU",256,0)
- . I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
-"RTN","C0CVORU",257,0)
- . ;
-"RTN","C0CVORU",258,0)
- . ; Send performing lab comment and interpretation from file #60
-"RTN","C0CVORU",259,0)
- . S LA7NTESN=0
-"RTN","C0CVORU",260,0)
- . I LA7NVAF=1 D PLC^LA7VORUA
-"RTN","C0CVORU",261,0)
- . D INTRP^LA7VORUA
-"RTN","C0CVORU",262,0)
- . ;
-"RTN","C0CVORU",263,0)
- . ; Mark result as sent - set to 1, if corrected results set to 2
-"RTN","C0CVORU",264,0)
- . I LA("SUB")="CH" D
-"RTN","C0CVORU",265,0)
- . . I $P(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^")),"^",10)>1 Q
-"RTN","C0CVORU",266,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)
Q
+"RTN","C0CVORU",254,0)
+ ;
+"RTN","C0CVORU",255,0)
+ ;
+"RTN","C0CVORU",256,0)
+OBX ;Observation/Result segment for Lab Results
+"RTN","C0CVORU",257,0)
+ ;
+"RTN","C0CVORU",258,0)
+ N LA7953,LA7DATA,LA7VT,LA7VTIEN,LA7X
+"RTN","C0CVORU",259,0)
+ ;
+"RTN","C0CVORU",260,0)
+ S LA7VTIEN=0
+"RTN","C0CVORU",261,0)
+ F S LA7VTIEN=$O(^LAHM(62.49,LA(62.49),1,LA7VTIEN)) Q:'LA7VTIEN D
+"RTN","C0CVORU",262,0)
+ . S LA7VT=$P(^LAHM(62.49,LA(62.49),1,LA7VTIEN,0),"^",1,2)
+"RTN","C0CVORU",263,0)
+ . ; Build OBX segment
+"RTN","C0CVORU",264,0)
+ . K LA7DATA
+"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",266,0)
+ . ; If OBX failed to build then don't store
+"RTN","C0CVORU",267,0)
+ . I '$D(LA7DATA) Q
+"RTN","C0CVORU",268,0)
+ . ;
"RTN","C0CVORU",269,0)
- ;
+ . D FILESEG^LA7VHLU(GBL,.LA7DATA)
"RTN","C0CVORU",270,0)
- ;
+ . I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
"RTN","C0CVORU",271,0)
-NTE ; Build NTE segment
+ . ;
"RTN","C0CVORU",272,0)
- ;
+ . ; Send performing lab comment and interpretation from file #60
"RTN","C0CVORU",273,0)
- D NTE^LA7VORUA
+ . S LA7NTESN=0
"RTN","C0CVORU",274,0)
+ . I LA7NVAF=1 D PLC^LA7VORUA
+"RTN","C0CVORU",275,0)
+ . D INTRP^LA7VORUA
+"RTN","C0CVORU",276,0)
+ . ;
+"RTN","C0CVORU",277,0)
+ . ; Mark result as sent - set to 1, if corrected results set to 2
+"RTN","C0CVORU",278,0)
+ . I LA("SUB")="CH" D
+"RTN","C0CVORU",279,0)
+ . . I $P(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^")),"^",10)>1 Q
+"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",281,0)
+ ;
+"RTN","C0CVORU",282,0)
+ Q
+"RTN","C0CVORU",283,0)
+ ;
+"RTN","C0CVORU",284,0)
+ ;
+"RTN","C0CVORU",285,0)
+NTE ; Build NTE segment
+"RTN","C0CVORU",286,0)
+ ;
+"RTN","C0CVORU",287,0)
+ D NTE^LA7VORUA
+"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)
;
+"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 .
"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)
- Q
-"RTN","C0CXEWD",21,0)
- ;
-"RTN","C0CXEWD",22,0)
TEST ;
-"RTN","C0CXEWD",23,0)
+"RTN","C0CXEWD",21,0)
D XPATH($$FIRST($$ID("CCR1")),"/","GIDX","GARY")
+"RTN","C0CXEWD",22,0)
+ Q
+"RTN","C0CXEWD",23,0)
+ ;
"RTN","C0CXEWD",24,0)
- Q
-"RTN","C0CXEWD",25,0)
- ;
-"RTN","C0CXEWD",26,0)
TEST2 ;
-"RTN","C0CXEWD",27,0)
+"RTN","C0CXEWD",25,0)
S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail"
-"RTN","C0CXEWD",28,0)
+"RTN","C0CXEWD",26,0)
D XPATH($$FIRST($$ID("gpl")),"/","GIDX","GARY","",REDUX)
+"RTN","C0CXEWD",27,0)
+ Q
+"RTN","C0CXEWD",28,0)
+ ;
"RTN","C0CXEWD",29,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)
+"RTN","C0CXEWD",30,0)
; THE XPATH INDEX ZXIDX, PASSED BY NAME
-"RTN","C0CXEWD",33,0)
+"RTN","C0CXEWD",31,0)
; THE XPATH ARRAY XPARY, PASSED BY NAME
-"RTN","C0CXEWD",34,0)
+"RTN","C0CXEWD",32,0)
; ZOID IS THE STARTING OID
-"RTN","C0CXEWD",35,0)
+"RTN","C0CXEWD",33,0)
; ZPATH IS THE STARTING XPATH, USUALLY "/"
-"RTN","C0CXEWD",36,0)
+"RTN","C0CXEWD",34,0)
; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
-"RTN","C0CXEWD",37,0)
+"RTN","C0CXEWD",35,0)
; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
-"RTN","C0CXEWD",38,0)
+"RTN","C0CXEWD",36,0)
I '$D(ZREDUX) S ZREDUX=""
-"RTN","C0CXEWD",39,0)
+"RTN","C0CXEWD",37,0)
N NEWPATH
-"RTN","C0CXEWD",40,0)
+"RTN","C0CXEWD",38,0)
N NEWNUM S NEWNUM=""
-"RTN","C0CXEWD",41,0)
+"RTN","C0CXEWD",39,0)
I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
-"RTN","C0CXEWD",42,0)
+"RTN","C0CXEWD",40,0)
S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
-"RTN","C0CXEWD",43,0)
+"RTN","C0CXEWD",41,0)
I $G(ZREDUX)'="" D ; REDUX PROVIDED?
-"RTN","C0CXEWD",44,0)
+"RTN","C0CXEWD",42,0)
. N GT S GT=$P(NEWPATH,ZREDUX,2)
-"RTN","C0CXEWD",45,0)
+"RTN","C0CXEWD",43,0)
. I GT'="" S NEWPATH=GT
-"RTN","C0CXEWD",46,0)
+"RTN","C0CXEWD",44,0)
S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
-"RTN","C0CXEWD",47,0)
+"RTN","C0CXEWD",45,0)
N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
-"RTN","C0CXEWD",48,0)
+"RTN","C0CXEWD",46,0)
I $D(GD(2)) M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
-"RTN","C0CXEWD",49,0)
+"RTN","C0CXEWD",47,0)
E I $D(GD(1)) S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
-"RTN","C0CXEWD",50,0)
+"RTN","C0CXEWD",48,0)
I GD'="" S @ZXPARY@(NEWPATH)=GD ; IF YES, ADD IT TO THE XPATH ARRAY
-"RTN","C0CXEWD",51,0)
+"RTN","C0CXEWD",49,0)
N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
-"RTN","C0CXEWD",52,0)
+"RTN","C0CXEWD",50,0)
I ZFRST'="" D ; THERE IS A CHILD
-"RTN","C0CXEWD",53,0)
+"RTN","C0CXEWD",51,0)
. N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
-"RTN","C0CXEWD",54,0)
+"RTN","C0CXEWD",52,0)
. D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD
-"RTN","C0CXEWD",55,0)
+"RTN","C0CXEWD",53,0)
N GNXT S GNXT=$$NXTSIB(ZOID)
-"RTN","C0CXEWD",56,0)
+"RTN","C0CXEWD",54,0)
I GNXT'="" D ; MOVE ON TO THE NEXT SIBLING
-"RTN","C0CXEWD",57,0)
+"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",57,0)
+ ;
"RTN","C0CXEWD",58,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)
+"RTN","C0CXEWD",59,0)
; INDOC IS PASSED AS THE DOCUMENT NAME TO EWD
-"RTN","C0CXEWD",62,0)
+"RTN","C0CXEWD",60,0)
; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY EWD
-"RTN","C0CXEWD",63,0)
+"RTN","C0CXEWD",61,0)
N ZR
-"RTN","C0CXEWD",64,0)
+"RTN","C0CXEWD",62,0)
M ^CacheTempEWD($j)=@INXML ;
-"RTN","C0CXEWD",65,0)
+"RTN","C0CXEWD",63,0)
S ZR=$$parseDocument^%zewdHTMLParser(INDOC)
-"RTN","C0CXEWD",66,0)
+"RTN","C0CXEWD",64,0)
Q ZR
-"RTN","C0CXEWD",67,0)
+"RTN","C0CXEWD",65,0)
;
-"RTN","C0CXEWD",68,0)
+"RTN","C0CXEWD",66,0)
ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
-"RTN","C0CXEWD",69,0)
+"RTN","C0CXEWD",67,0)
N ZN
-"RTN","C0CXEWD",70,0)
+"RTN","C0CXEWD",68,0)
S ZN=$$NXTSIB(ZOID)
-"RTN","C0CXEWD",71,0)
+"RTN","C0CXEWD",69,0)
I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
-"RTN","C0CXEWD",72,0)
+"RTN","C0CXEWD",70,0)
Q 0
-"RTN","C0CXEWD",73,0)
+"RTN","C0CXEWD",71,0)
;
-"RTN","C0CXEWD",74,0)
+"RTN","C0CXEWD",72,0)
DETAIL(ZRTN,ZOID) ; RETURNS DETAIL FOR NODE ZOID IN ZRTN, PASSED BY NAME
-"RTN","C0CXEWD",75,0)
+"RTN","C0CXEWD",73,0)
N DET
-"RTN","C0CXEWD",76,0)
+"RTN","C0CXEWD",74,0)
D getElementDetails^%zewdXPath(ZOID,.DET)
-"RTN","C0CXEWD",77,0)
+"RTN","C0CXEWD",75,0)
M @ZRTN=DET
+"RTN","C0CXEWD",76,0)
+ Q
+"RTN","C0CXEWD",77,0)
+ ;
"RTN","C0CXEWD",78,0)
- Q
-"RTN","C0CXEWD",79,0)
- ;
-"RTN","C0CXEWD",80,0)
ID(ZNAME) ;RETURNS THE docOID OF THE DOCUMENT NAMED ZNAME
-"RTN","C0CXEWD",81,0)
+"RTN","C0CXEWD",79,0)
Q $$getDocumentNode^%zewdDOM(ZNAME)
-"RTN","C0CXEWD",82,0)
+"RTN","C0CXEWD",80,0)
;
-"RTN","C0CXEWD",83,0)
+"RTN","C0CXEWD",81,0)
NAME(ZOID) ;RETURNS THE NAME OF THE DOCUMENAT WITH docOID ZOID
-"RTN","C0CXEWD",84,0)
+"RTN","C0CXEWD",82,0)
Q $$getDocumentName^%zewdDOM(ZOID)
-"RTN","C0CXEWD",85,0)
+"RTN","C0CXEWD",83,0)
;
-"RTN","C0CXEWD",86,0)
+"RTN","C0CXEWD",84,0)
FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
-"RTN","C0CXEWD",87,0)
+"RTN","C0CXEWD",85,0)
N GOID
-"RTN","C0CXEWD",88,0)
+"RTN","C0CXEWD",86,0)
S GOID=ZOID
-"RTN","C0CXEWD",89,0)
+"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)
- I GOID="" Q ""
+ Q GOID
"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)
+"RTN","C0CXEWD",93,0)
Q $$hasChildNodes^%zewdDOM(ZOID)
-"RTN","C0CXEWD",96,0)
+"RTN","C0CXEWD",94,0)
;
-"RTN","C0CXEWD",97,0)
+"RTN","C0CXEWD",95,0)
CHILDREN(ZRTN,ZOID) ;RETURNS CHILDREN OF ZOID IN ARRAY ZRTN, PASSED BY NAME
-"RTN","C0CXEWD",98,0)
+"RTN","C0CXEWD",96,0)
N childArray
-"RTN","C0CXEWD",99,0)
+"RTN","C0CXEWD",97,0)
d getChildrenInOrder^%zewdDOM(ZOID,.childArray)
-"RTN","C0CXEWD",100,0)
+"RTN","C0CXEWD",98,0)
m @ZRTN=childArray
-"RTN","C0CXEWD",101,0)
+"RTN","C0CXEWD",99,0)
q
-"RTN","C0CXEWD",102,0)
+"RTN","C0CXEWD",100,0)
;
-"RTN","C0CXEWD",103,0)
+"RTN","C0CXEWD",101,0)
TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
-"RTN","C0CXEWD",104,0)
+"RTN","C0CXEWD",102,0)
Q $$getName^%zewdDOM(ZOID)
-"RTN","C0CXEWD",105,0)
+"RTN","C0CXEWD",103,0)
;
-"RTN","C0CXEWD",106,0)
+"RTN","C0CXEWD",104,0)
NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
-"RTN","C0CXEWD",107,0)
+"RTN","C0CXEWD",105,0)
Q $$getNextSibling^%zewdDOM(ZOID)
-"RTN","C0CXEWD",108,0)
+"RTN","C0CXEWD",106,0)
;
-"RTN","C0CXEWD",109,0)
+"RTN","C0CXEWD",107,0)
NXTCHLD(ZOID) ; RETURNS THE NEXT CHILD IN PARENT ZPAR
-"RTN","C0CXEWD",110,0)
+"RTN","C0CXEWD",108,0)
N GOID
-"RTN","C0CXEWD",111,0)
+"RTN","C0CXEWD",109,0)
S GOID=$$getNextChild^%zewdDOM($$PARENT(ZOID),ZOID)
-"RTN","C0CXEWD",112,0)
+"RTN","C0CXEWD",110,0)
I GOID="" Q ""
-"RTN","C0CXEWD",113,0)
+"RTN","C0CXEWD",111,0)
I $$getNodeType^%zewdDOM(GOID)'=1 S GOID=$$NXTCHLD(GOID)
-"RTN","C0CXEWD",114,0)
+"RTN","C0CXEWD",112,0)
Q GOID
-"RTN","C0CXEWD",115,0)
+"RTN","C0CXEWD",113,0)
;
-"RTN","C0CXEWD",116,0)
+"RTN","C0CXEWD",114,0)
PARENT(ZOID) ; RETURNS PARENT OF ZOID
-"RTN","C0CXEWD",117,0)
+"RTN","C0CXEWD",115,0)
Q $$getParentNode^%zewdDOM(ZOID)
-"RTN","C0CXEWD",118,0)
+"RTN","C0CXEWD",116,0)
;
-"RTN","C0CXEWD",119,0)
+"RTN","C0CXEWD",117,0)
DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
-"RTN","C0CXEWD",120,0)
+"RTN","C0CXEWD",118,0)
N ZT2
-"RTN","C0CXEWD",121,0)
+"RTN","C0CXEWD",119,0)
S ZT2=$$getElementText^%zewdDOM(ZOID,.ZT2)
-"RTN","C0CXEWD",122,0)
+"RTN","C0CXEWD",120,0)
M @ZT=ZT2
-"RTN","C0CXEWD",123,0)
+"RTN","C0CXEWD",121,0)
Q
-"RTN","C0CXEWD",124,0)
+"RTN","C0CXEWD",122,0)
;Q $$getTextValue^%zewdXPath(ZOID)
-"RTN","C0CXEWD",125,0)
+"RTN","C0CXEWD",123,0)
;Q $$getData^%zewdDOM(ZOID,.ZT)
-"RTN","C0CXEWD",126,0)
+"RTN","C0CXEWD",124,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 .
"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.
-"RTN","C0CXPAT0",19,0)
;
+"RTN","C0CXPAT0",18,0)
+ W "NO ENTRY",!
+"RTN","C0CXPAT0",19,0)
+ Q
"RTN","C0CXPAT0",20,0)
- W "NO ENTRY",!
+ ;
"RTN","C0CXPAT0",21,0)
- Q
-"RTN","C0CXPAT0",22,0)
- ;
-"RTN","C0CXPAT0",23,0)
;;>
-"RTN","C0CXPAT0",24,0)
+"RTN","C0CXPAT0",22,0)
;;>
-"RTN","C0CXPAT0",25,0)
+"RTN","C0CXPAT0",23,0)
;;>>>K C0C S C0C=""
-"RTN","C0CXPAT0",26,0)
+"RTN","C0CXPAT0",24,0)
;;>>>D PUSH^C0CXPATH("C0C","FIRST")
-"RTN","C0CXPAT0",27,0)
+"RTN","C0CXPAT0",25,0)
;;>>>D PUSH^C0CXPATH("C0C","SECOND")
-"RTN","C0CXPAT0",28,0)
+"RTN","C0CXPAT0",26,0)
;;>>>D PUSH^C0CXPATH("C0C","THIRD")
-"RTN","C0CXPAT0",29,0)
+"RTN","C0CXPAT0",27,0)
;;>>>D PUSH^C0CXPATH("C0C","FOURTH")
-"RTN","C0CXPAT0",30,0)
+"RTN","C0CXPAT0",28,0)
;;>>?C0C(0)=4
-"RTN","C0CXPAT0",31,0)
+"RTN","C0CXPAT0",29,0)
;;>
+"RTN","C0CXPAT0",30,0)
+ ;;>>>K GXML S GXML=""
+"RTN","C0CXPAT0",31,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","")
"RTN","C0CXPAT0",32,0)
- ;;>>>K GXML S GXML=""
+ ;;>>>D PUSH^C0CXPATH("GXML","")
"RTN","C0CXPAT0",33,0)
- ;;>>>D PUSH^C0CXPATH("GXML","")
+ ;;>>>D PUSH^C0CXPATH("GXML","")
"RTN","C0CXPAT0",34,0)
- ;;>>>D PUSH^C0CXPATH("GXML","")
-"RTN","C0CXPAT0",35,0)
- ;;>>>D PUSH^C0CXPATH("GXML","")
-"RTN","C0CXPAT0",36,0)
;;>>>D PUSH^C0CXPATH("GXML","@@DATA1@@")
-"RTN","C0CXPAT0",37,0)
+"RTN","C0CXPAT0",35,0)
;;>>>D PUSH^C0CXPATH("GXML","")
-"RTN","C0CXPAT0",38,0)
+"RTN","C0CXPAT0",36,0)
;;>>>D PUSH^C0CXPATH("GXML","@@DATA2@@")
-"RTN","C0CXPAT0",39,0)
+"RTN","C0CXPAT0",37,0)
;;>>>D PUSH^C0CXPATH("GXML","")
-"RTN","C0CXPAT0",40,0)
+"RTN","C0CXPAT0",38,0)
;;>>>D PUSH^C0CXPATH("GXML","")
+"RTN","C0CXPAT0",39,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","")
+"RTN","C0CXPAT0",40,0)
+ ;;>>>D PUSH^C0CXPATH("GXML","")
"RTN","C0CXPAT0",41,0)
- ;;>>>D PUSH^C0CXPATH("GXML","")
+ ;;>>>D PUSH^C0CXPATH("GXML","")
"RTN","C0CXPAT0",42,0)
- ;;>>>D PUSH^C0CXPATH("GXML","")
+ ;;>>>D PUSH^C0CXPATH("GXML","")
"RTN","C0CXPAT0",43,0)
- ;;>>>D PUSH^C0CXPATH("GXML","")
+ ;;>>>D PUSH^C0CXPATH("GXML","")
"RTN","C0CXPAT0",44,0)
- ;;>>>D PUSH^C0CXPATH("GXML","")
-"RTN","C0CXPAT0",45,0)
- ;;>>>D PUSH^C0CXPATH("GXML","")
-"RTN","C0CXPAT0",46,0)
;;>
-"RTN","C0CXPAT0",47,0)
+"RTN","C0CXPAT0",45,0)
;;>>>K GXML S GXML=""
-"RTN","C0CXPAT0",48,0)
+"RTN","C0CXPAT0",46,0)
;;>>>D PUSH^C0CXPATH("GXML","")
-"RTN","C0CXPAT0",49,0)
+"RTN","C0CXPAT0",47,0)
;;>>>D PUSH^C0CXPATH("GXML","")
-"RTN","C0CXPAT0",50,0)
+"RTN","C0CXPAT0",48,0)
;;>>>D PUSH^C0CXPATH("GXML","")
-"RTN","C0CXPAT0",51,0)
+"RTN","C0CXPAT0",49,0)
;;>>>D PUSH^C0CXPATH("GXML","DATA1")
-"RTN","C0CXPAT0",52,0)
+"RTN","C0CXPAT0",50,0)
;;>>>D PUSH^C0CXPATH("GXML","")
-"RTN","C0CXPAT0",53,0)
+"RTN","C0CXPAT0",51,0)
;;>>>D PUSH^C0CXPATH("GXML","DATA2")
-"RTN","C0CXPAT0",54,0)
+"RTN","C0CXPAT0",52,0)
;;>>>D PUSH^C0CXPATH("GXML","")
-"RTN","C0CXPAT0",55,0)
+"RTN","C0CXPAT0",53,0)
;;>>>D PUSH^C0CXPATH("GXML","")
-"RTN","C0CXPAT0",56,0)
+"RTN","C0CXPAT0",54,0)
;;>>>D PUSH^C0CXPATH("GXML","<_SECOND>")
-"RTN","C0CXPAT0",57,0)
+"RTN","C0CXPAT0",55,0)
;;>>>D PUSH^C0CXPATH("GXML","DATA3")
-"RTN","C0CXPAT0",58,0)
+"RTN","C0CXPAT0",56,0)
;;>>>D PUSH^C0CXPATH("GXML","")
-"RTN","C0CXPAT0",59,0)
+"RTN","C0CXPAT0",57,0)
;;>>>D PUSH^C0CXPATH("GXML","")
-"RTN","C0CXPAT0",60,0)
+"RTN","C0CXPAT0",58,0)
;;>>>D PUSH^C0CXPATH("GXML","")
-"RTN","C0CXPAT0",61,0)
+"RTN","C0CXPAT0",59,0)
;;>
+"RTN","C0CXPAT0",60,0)
+ ;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
+"RTN","C0CXPAT0",61,0)
+ ;;>>>D ZTEST^C0CUNIT(.ZTMP,"INIT")
"RTN","C0CXPAT0",62,0)
- ;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
-"RTN","C0CXPAT0",63,0)
- ;;>>>D ZTEST^C0CUNIT(.ZTMP,"INIT")
-"RTN","C0CXPAT0",64,0)
;;>>?C0C(C0C(0))="FOURTH"
-"RTN","C0CXPAT0",65,0)
+"RTN","C0CXPAT0",63,0)
;;>>>D POP^C0CXPATH("C0C",.GX)
-"RTN","C0CXPAT0",66,0)
+"RTN","C0CXPAT0",64,0)
;;>>?GX="FOURTH"
-"RTN","C0CXPAT0",67,0)
+"RTN","C0CXPAT0",65,0)
;;>>?C0C(C0C(0))="THIRD"
-"RTN","C0CXPAT0",68,0)
+"RTN","C0CXPAT0",66,0)
;;>>>D POP^C0CXPATH("C0C",.GX)
-"RTN","C0CXPAT0",69,0)
+"RTN","C0CXPAT0",67,0)
;;>>?GX="THIRD"
-"RTN","C0CXPAT0",70,0)
+"RTN","C0CXPAT0",68,0)
;;>>?C0C(C0C(0))="SECOND"
-"RTN","C0CXPAT0",71,0)
+"RTN","C0CXPAT0",69,0)
;;>
-"RTN","C0CXPAT0",72,0)
+"RTN","C0CXPAT0",70,0)
;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
-"RTN","C0CXPAT0",73,0)
+"RTN","C0CXPAT0",71,0)
;;>>>D ZTEST^C0CUNIT(.ZTMP,"INIT")
-"RTN","C0CXPAT0",74,0)
+"RTN","C0CXPAT0",72,0)
;;>>>S GX=""
-"RTN","C0CXPAT0",75,0)
+"RTN","C0CXPAT0",73,0)
;;>>>D MKMDX^C0CXPATH("C0C",.GX)
-"RTN","C0CXPAT0",76,0)
+"RTN","C0CXPAT0",74,0)
;;>>?GX="//FIRST/SECOND/THIRD/FOURTH"
-"RTN","C0CXPAT0",77,0)
+"RTN","C0CXPAT0",75,0)
;;>
-"RTN","C0CXPAT0",78,0)
+"RTN","C0CXPAT0",76,0)
;;>>?$$XNAME^C0CXPATH("DATA1")="FOURTH"
-"RTN","C0CXPAT0",79,0)
+"RTN","C0CXPAT0",77,0)
;;>>?$$XNAME^C0CXPATH("")="SIXTH"
-"RTN","C0CXPAT0",80,0)
+"RTN","C0CXPAT0",78,0)
;;>>?$$XNAME^C0CXPATH("")="THIRD"
-"RTN","C0CXPAT0",81,0)
+"RTN","C0CXPAT0",79,0)
;;>
-"RTN","C0CXPAT0",82,0)
+"RTN","C0CXPAT0",80,0)
;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
-"RTN","C0CXPAT0",83,0)
+"RTN","C0CXPAT0",81,0)
;;>>>D ZTEST^C0CUNIT(.ZTMP,"INITXML")
+"RTN","C0CXPAT0",82,0)
+ ;;>>>D INDEX^C0CXPATH("GXML")
+"RTN","C0CXPAT0",83,0)
+ ;;>>?GXML("//FIRST/SECOND")="2^12"
"RTN","C0CXPAT0",84,0)
- ;;>>>D INDEX^C0CXPATH("GXML")
-"RTN","C0CXPAT0",85,0)
- ;;>>?GXML("//FIRST/SECOND")="2^12"
-"RTN","C0CXPAT0",86,0)
;;>>?GXML("//FIRST/SECOND/THIRD")="3^9"
-"RTN","C0CXPAT0",87,0)
+"RTN","C0CXPAT0",85,0)
;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7"
-"RTN","C0CXPAT0",88,0)
+"RTN","C0CXPAT0",86,0)
;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4^@@DATA1@@"
-"RTN","C0CXPAT0",89,0)
+"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)
- ;;>>?GXML("//FIRST/SECOND")="2^12"
-"RTN","C0CXPAT0",91,0)
- ;;>>?GXML("//FIRST")="1^13"
-"RTN","C0CXPAT0",92,0)
;;>
-"RTN","C0CXPAT0",93,0)
+"RTN","C0CXPAT0",91,0)
;;>>>D ZTEST^C0CXPATH("INITXML2")
-"RTN","C0CXPAT0",94,0)
+"RTN","C0CXPAT0",92,0)
;;>>>D INDEX^C0CXPATH("GXML")
-"RTN","C0CXPAT0",95,0)
+"RTN","C0CXPAT0",93,0)
;;>>?GXML("//FIRST/SECOND")="2^12"
-"RTN","C0CXPAT0",96,0)
+"RTN","C0CXPAT0",94,0)
;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11"
-"RTN","C0CXPAT0",97,0)
+"RTN","C0CXPAT0",95,0)
;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10^DATA3"
-"RTN","C0CXPAT0",98,0)
+"RTN","C0CXPAT0",96,0)
;;>>?GXML("//FIRST/SECOND/THIRD")="3^8"
-"RTN","C0CXPAT0",99,0)
+"RTN","C0CXPAT0",97,0)
;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH[1]")="4^4^DATA1"
-"RTN","C0CXPAT0",100,0)
+"RTN","C0CXPAT0",98,0)
;;>>?GXML("//FIRST")="1^13"
-"RTN","C0CXPAT0",101,0)
+"RTN","C0CXPAT0",99,0)
;;>
-"RTN","C0CXPAT0",102,0)
+"RTN","C0CXPAT0",100,0)
;;>>>D ZTEST^C0CXPATH("INITXML")
-"RTN","C0CXPAT0",103,0)
+"RTN","C0CXPAT0",101,0)
;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")"
-"RTN","C0CXPAT0",104,0)
+"RTN","C0CXPAT0",102,0)
;;>>>D MISSING^C0CXPATH("GXML",OUTARY)
-"RTN","C0CXPAT0",105,0)
+"RTN","C0CXPAT0",103,0)
;;>>?@OUTARY@(1)="DATA1"
-"RTN","C0CXPAT0",106,0)
+"RTN","C0CXPAT0",104,0)
;;>>?@OUTARY@(2)="DATA2"
-"RTN","C0CXPAT0",107,0)
+"RTN","C0CXPAT0",105,0)
;;>
"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 .
"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.
-"RTN","C0CXPATH",19,0)
;
-"RTN","C0CXPATH",20,0)
+"RTN","C0CXPATH",18,0)
W "This is an XML XPATH utility library",!
-"RTN","C0CXPATH",21,0)
+"RTN","C0CXPATH",19,0)
W !
-"RTN","C0CXPATH",22,0)
+"RTN","C0CXPATH",20,0)
Q
+"RTN","C0CXPATH",21,0)
+ ;
+"RTN","C0CXPATH",22,0)
+OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE
"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)
+"RTN","C0CXPATH",25,0)
S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)
-"RTN","C0CXPATH",28,0)
+"RTN","C0CXPATH",26,0)
I Y Q 1_U_"WROTE FILE: "_OUTNAME_" TO "_OUTDIR
-"RTN","C0CXPATH",29,0)
+"RTN","C0CXPATH",27,0)
I 'Y Q 0_U_"ERROR WRITING FILE"_OUTNAME_" TO "_OUTDIR
+"RTN","C0CXPATH",28,0)
+ Q
+"RTN","C0CXPATH",29,0)
+ ;
"RTN","C0CXPATH",30,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)
+"RTN","C0CXPATH",31,0)
; VAL IS A STRING AND STK IS PASSED BY NAME
-"RTN","C0CXPATH",34,0)
+"RTN","C0CXPATH",32,0)
;
-"RTN","C0CXPATH",35,0)
+"RTN","C0CXPATH",33,0)
I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE
-"RTN","C0CXPATH",36,0)
+"RTN","C0CXPATH",34,0)
S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH
-"RTN","C0CXPATH",37,0)
+"RTN","C0CXPATH",35,0)
S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY
+"RTN","C0CXPATH",36,0)
+ Q
+"RTN","C0CXPATH",37,0)
+ ;
"RTN","C0CXPATH",38,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)
+"RTN","C0CXPATH",39,0)
; VAL AND STK ARE PASSED BY REFERENCE
-"RTN","C0CXPATH",42,0)
+"RTN","C0CXPATH",40,0)
;
-"RTN","C0CXPATH",43,0)
+"RTN","C0CXPATH",41,0)
I @STK@(0)<1 D ; IF ARRAY IS EMPTY
-"RTN","C0CXPATH",44,0)
+"RTN","C0CXPATH",42,0)
. S VAL=""
-"RTN","C0CXPATH",45,0)
+"RTN","C0CXPATH",43,0)
. S @STK@(0)=0
-"RTN","C0CXPATH",46,0)
+"RTN","C0CXPATH",44,0)
I @STK@(0)>0 D ;
-"RTN","C0CXPATH",47,0)
+"RTN","C0CXPATH",45,0)
. S VAL=@STK@(@STK@(0))
-"RTN","C0CXPATH",48,0)
+"RTN","C0CXPATH",46,0)
. K @STK@(@STK@(0))
-"RTN","C0CXPATH",49,0)
+"RTN","C0CXPATH",47,0)
. S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY
-"RTN","C0CXPATH",50,0)
+"RTN","C0CXPATH",48,0)
Q
+"RTN","C0CXPATH",49,0)
+ ;
+"RTN","C0CXPATH",50,0)
+PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME
"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)
+"RTN","C0CXPATH",53,0)
F ZGI=1:1:@ASRC@(0) D ; FOR ALL OF THE SOURCE ARRAY
-"RTN","C0CXPATH",56,0)
+"RTN","C0CXPATH",54,0)
. D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT
+"RTN","C0CXPATH",55,0)
+ Q
+"RTN","C0CXPATH",56,0)
+ ;
"RTN","C0CXPATH",57,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","C0CXPATH",58,0)
; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS
-"RTN","C0CXPATH",61,0)
+"RTN","C0CXPATH",59,0)
; REDUX IS A STRING TO REMOVE FROM THE RESULT
-"RTN","C0CXPATH",62,0)
+"RTN","C0CXPATH",60,0)
S RTN=""
-"RTN","C0CXPATH",63,0)
+"RTN","C0CXPATH",61,0)
N I
-"RTN","C0CXPATH",64,0)
+"RTN","C0CXPATH",62,0)
; W "STK= ",STK,!
-"RTN","C0CXPATH",65,0)
+"RTN","C0CXPATH",63,0)
I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY
-"RTN","C0CXPATH",66,0)
+"RTN","C0CXPATH",64,0)
. S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
-"RTN","C0CXPATH",67,0)
+"RTN","C0CXPATH",65,0)
. I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
-"RTN","C0CXPATH",68,0)
+"RTN","C0CXPATH",66,0)
. . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
-"RTN","C0CXPATH",69,0)
+"RTN","C0CXPATH",67,0)
I $G(INREDUX)'="" S RTN=$P(RTN,INREDUX,1)_$P(RTN,INREDUX,2)
+"RTN","C0CXPATH",68,0)
+ Q
+"RTN","C0CXPATH",69,0)
+ ;
"RTN","C0CXPATH",70,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)
+"RTN","C0CXPATH",71,0)
; AND WILL RETURN NAME
-"RTN","C0CXPATH",74,0)
+"RTN","C0CXPATH",72,0)
; ISTR IS PASSED BY VALUE
-"RTN","C0CXPATH",75,0)
+"RTN","C0CXPATH",73,0)
N CUR,TMP
-"RTN","C0CXPATH",76,0)
+"RTN","C0CXPATH",74,0)
I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET
-"RTN","C0CXPATH",77,0)
+"RTN","C0CXPATH",75,0)
. S TMP=$P(ISTR,"<",2)
-"RTN","C0CXPATH",78,0)
+"RTN","C0CXPATH",76,0)
I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE
-"RTN","C0CXPATH",79,0)
+"RTN","C0CXPATH",77,0)
. S TMP=$P(TMP,"/",2)
-"RTN","C0CXPATH",80,0)
+"RTN","C0CXPATH",78,0)
S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
-"RTN","C0CXPATH",81,0)
+"RTN","C0CXPATH",79,0)
; W "CUR= ",CUR,!
-"RTN","C0CXPATH",82,0)
+"RTN","C0CXPATH",80,0)
I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST>
-"RTN","C0CXPATH",83,0)
+"RTN","C0CXPATH",81,0)
. S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
-"RTN","C0CXPATH",84,0)
+"RTN","C0CXPATH",82,0)
; W "CUR2= ",CUR,!
-"RTN","C0CXPATH",85,0)
+"RTN","C0CXPATH",83,0)
Q CUR
-"RTN","C0CXPATH",86,0)
+"RTN","C0CXPATH",84,0)
;
-"RTN","C0CXPATH",87,0)
+"RTN","C0CXPATH",85,0)
XVAL(ISTR) ; EXTRACTS THE VALUE FROM A FRAGMENT OF XML
-"RTN","C0CXPATH",88,0)
+"RTN","C0CXPATH",86,0)
; VALUE WILL RETURN VALUE
-"RTN","C0CXPATH",89,0)
+"RTN","C0CXPATH",87,0)
N G
-"RTN","C0CXPATH",90,0)
+"RTN","C0CXPATH",88,0)
S G=$P(ISTR,">",2) ;STRIP OFF
-"RTN","C0CXPATH",91,0)
+"RTN","C0CXPATH",89,0)
Q $P(G,"<",1) ; STRIP OFF LEAVING VALUE
-"RTN","C0CXPATH",92,0)
+"RTN","C0CXPATH",90,0)
;
-"RTN","C0CXPATH",93,0)
+"RTN","C0CXPATH",91,0)
VDX2VDV(OUTVDV,INVDX) ; CONVERT AN VDX ARRAY TO VDV
-"RTN","C0CXPATH",94,0)
+"RTN","C0CXPATH",92,0)
; VDX: @INVDX@(XPATH)=VALUE
-"RTN","C0CXPATH",95,0)
+"RTN","C0CXPATH",93,0)
; VDV: @OUTVDV@(X1X2X3X4)=VALUE
-"RTN","C0CXPATH",96,0)
+"RTN","C0CXPATH",94,0)
; THE VDV DATANAMES MIGHT BE MORE CONVENIENT FOR USE IN CODE
-"RTN","C0CXPATH",97,0)
+"RTN","C0CXPATH",95,0)
; AN INDEX IS PROVIDED TO GO BACK TO VDX FOR CONVERSIONS
-"RTN","C0CXPATH",98,0)
+"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)
- N ZA,ZI,ZW
+ F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ;
"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)
+"RTN","C0CXPATH",101,0)
. W ZW,!
-"RTN","C0CXPATH",104,0)
+"RTN","C0CXPATH",102,0)
. S @OUTVDV@(ZW)=@INVDX@(ZI)
-"RTN","C0CXPATH",105,0)
+"RTN","C0CXPATH",103,0)
. S @OUTVDV@("XPATH",ZW)=ZI
+"RTN","C0CXPATH",104,0)
+ Q
+"RTN","C0CXPATH",105,0)
+ ;
"RTN","C0CXPATH",106,0)
- Q
-"RTN","C0CXPATH",107,0)
- ;
-"RTN","C0CXPATH",108,0)
VDX2XPG(OUTXPG,INVDX) ; CONVERT AN VDX ARRAY TO XPG
-"RTN","C0CXPATH",109,0)
+"RTN","C0CXPATH",107,0)
; VDX: @VDX@(XPATH)=VALUE
-"RTN","C0CXPATH",110,0)
+"RTN","C0CXPATH",108,0)
; XPG: @(VDX(X1,X2,X3,X4))@=VALUE
-"RTN","C0CXPATH",111,0)
+"RTN","C0CXPATH",109,0)
; THIS IS A STEP TOWARD GENERATING XML FROM A VDX
-"RTN","C0CXPATH",112,0)
+"RTN","C0CXPATH",110,0)
N ZA,ZI,ZW
-"RTN","C0CXPATH",113,0)
+"RTN","C0CXPATH",111,0)
S ZI=""
-"RTN","C0CXPATH",114,0)
+"RTN","C0CXPATH",112,0)
F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ;
-"RTN","C0CXPATH",115,0)
+"RTN","C0CXPATH",113,0)
. S ZW=$E(ZI,3,$L(ZI)) ; STRIP OFF INITIAL //
-"RTN","C0CXPATH",116,0)
+"RTN","C0CXPATH",114,0)
. S ZW2=$P(ZW,"/",1)
-"RTN","C0CXPATH",117,0)
+"RTN","C0CXPATH",115,0)
. F ZK=1:1:$L(ZW,"/") D PUSH("ZA",$P(ZW,"/",ZK))
-"RTN","C0CXPATH",118,0)
+"RTN","C0CXPATH",116,0)
. ;ZWR ZA
-"RTN","C0CXPATH",119,0)
+"RTN","C0CXPATH",117,0)
. S ZW2=ZA(1)
-"RTN","C0CXPATH",120,0)
+"RTN","C0CXPATH",118,0)
. F ZK=2:1:ZA(0) D ;
-"RTN","C0CXPATH",121,0)
+"RTN","C0CXPATH",119,0)
. . S ZW2=ZW2_""","""_ZA(ZK)
-"RTN","C0CXPATH",122,0)
+"RTN","C0CXPATH",120,0)
. K ZA
-"RTN","C0CXPATH",123,0)
+"RTN","C0CXPATH",121,0)
. S ZW2=""""_ZW2_""""
-"RTN","C0CXPATH",124,0)
+"RTN","C0CXPATH",122,0)
. W ZW2,!
-"RTN","C0CXPATH",125,0)
+"RTN","C0CXPATH",123,0)
. S ZN=OUTXPG_"("_ZW2_")"
-"RTN","C0CXPATH",126,0)
+"RTN","C0CXPATH",124,0)
. S @ZN=@INVDX@(ZI)
+"RTN","C0CXPATH",125,0)
+ Q
+"RTN","C0CXPATH",126,0)
+ ;
"RTN","C0CXPATH",127,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)
+"RTN","C0CXPATH",128,0)
; XPG MEANS XPATH GLOBAL AND HAS THE FORM @OUTXPG@("X1","X2","X3")=VALUE
-"RTN","C0CXPATH",131,0)
+"RTN","C0CXPATH",129,0)
;
-"RTN","C0CXPATH",132,0)
+"RTN","C0CXPATH",130,0)
;N G1
-"RTN","C0CXPATH",133,0)
+"RTN","C0CXPATH",131,0)
D INDEX(INXML,"G1",1) ; PRODUCES A VDX ARRAY IN G1, NO INDEX IS PRODUCED
-"RTN","C0CXPATH",134,0)
+"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)
- Q
+DO ;
"RTN","C0CXPATH",136,0)
- ;
-"RTN","C0CXPATH",137,0)
-DO
-"RTN","C0CXPATH",138,0)
D XPG2XML("^GPL2B","^GPL2A")
+"RTN","C0CXPATH",137,0)
+ Q
+"RTN","C0CXPATH",138,0)
+ ;
"RTN","C0CXPATH",139,0)
- Q
-"RTN","C0CXPATH",140,0)
- ;
-"RTN","C0CXPATH",141,0)
T1 ; TEST OUT THESE ROUTINES
-"RTN","C0CXPATH",142,0)
+"RTN","C0CXPATH",140,0)
D XML2XPG("G2","^GPL")
-"RTN","C0CXPATH",143,0)
+"RTN","C0CXPATH",141,0)
D XPG2XML("G3","G2")
-"RTN","C0CXPATH",144,0)
+"RTN","C0CXPATH",142,0)
K ^GPLOUT
-"RTN","C0CXPATH",145,0)
+"RTN","C0CXPATH",143,0)
M ^GPLOUT=G3
-"RTN","C0CXPATH",146,0)
+"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)
- Q
-"RTN","C0CXPATH",148,0)
- ;
-"RTN","C0CXPATH",149,0)
XPG2XML(OUTXML,INXPG) ;
-"RTN","C0CXPATH",150,0)
+"RTN","C0CXPATH",148,0)
N C0CN,FWD,ZA,G,GA,ZQ
-"RTN","C0CXPATH",151,0)
+"RTN","C0CXPATH",149,0)
S ZQ=0 ; QUIT FLAG
-"RTN","C0CXPATH",152,0)
+"RTN","C0CXPATH",150,0)
F Q:ZQ=1 D ; LOOP THROUGH EVERYTHING
-"RTN","C0CXPATH",153,0)
+"RTN","C0CXPATH",151,0)
. I '$D(C0CN) D ; FIRST TIME THROUGH
-"RTN","C0CXPATH",154,0)
+"RTN","C0CXPATH",152,0)
. . K @OUTXML ; MAKE SURE OUTPUT ARRAY IS CLEAR
-"RTN","C0CXPATH",155,0)
+"RTN","C0CXPATH",153,0)
. . S FWD=1 ; START OUT GOING FORWARD THROUGH SUBSCRIPTS
-"RTN","C0CXPATH",156,0)
+"RTN","C0CXPATH",154,0)
. . S G=$Q(@INXPG) ; THIS ONE
-"RTN","C0CXPATH",157,0)
+"RTN","C0CXPATH",155,0)
. . S GN=$Q(@G) ; NEXT ONE
-"RTN","C0CXPATH",158,0)
+"RTN","C0CXPATH",156,0)
. . S C0CN=1 ; SUBSCRIPT COUNT
-"RTN","C0CXPATH",159,0)
+"RTN","C0CXPATH",157,0)
. . S ZQ=0 ; QUIT FLAG
-"RTN","C0CXPATH",160,0)
+"RTN","C0CXPATH",158,0)
. . D ZXO("?xml version=""1.0"" encoding=""UTF-8""?") ;MAKE IT REAL XML
-"RTN","C0CXPATH",161,0)
+"RTN","C0CXPATH",159,0)
. . I $QS(G,1)="ContinuityOfCareRecord" D ;
-"RTN","C0CXPATH",162,0)
+"RTN","C0CXPATH",160,0)
. . . D ZXO("?xml-stylesheet type=""text/xsl"" href=""ccr.xsl""?") ; HACK TO MAKE THE CCR STYLESHEET WORK
-"RTN","C0CXPATH",163,0)
+"RTN","C0CXPATH",161,0)
. I FWD D ; GOING FORWARDS
-"RTN","C0CXPATH",164,0)
+"RTN","C0CXPATH",162,0)
. . I C0CN<$QL(G) D ; NOT A DATA NODE
-"RTN","C0CXPATH",165,0)
+"RTN","C0CXPATH",163,0)
. . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT
-"RTN","C0CXPATH",166,0)
+"RTN","C0CXPATH",164,0)
. . . D ZXO(ZA) ; AND OPEN AN XML ELEMENT
-"RTN","C0CXPATH",167,0)
+"RTN","C0CXPATH",165,0)
. . . I @OUTXML@(@OUTXML@(0))="" D ;
-"RTN","C0CXPATH",168,0)
+"RTN","C0CXPATH",166,0)
. . . . S @OUTXML@(@OUTXML@(0))=""
-"RTN","C0CXPATH",169,0)
+"RTN","C0CXPATH",167,0)
. . . S C0CN=C0CN+1 ; MOVE TO THE NEXT ONE
-"RTN","C0CXPATH",170,0)
+"RTN","C0CXPATH",168,0)
. . E D ; AT THE DATA NODE
-"RTN","C0CXPATH",171,0)
+"RTN","C0CXPATH",169,0)
. . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT
-"RTN","C0CXPATH",172,0)
+"RTN","C0CXPATH",170,0)
. . . D ZXVAL(ZA,@G) ; OUTPUT VAL FOR DATA NODE
-"RTN","C0CXPATH",173,0)
+"RTN","C0CXPATH",171,0)
. . . S FWD=0 ; GO BACKWARDS
-"RTN","C0CXPATH",174,0)
+"RTN","C0CXPATH",172,0)
. I 'FWD D ;GOING BACKWARDS
-"RTN","C0CXPATH",175,0)
+"RTN","C0CXPATH",173,0)
. . S GN=$Q(@G) ;NEXT XPATH
-"RTN","C0CXPATH",176,0)
+"RTN","C0CXPATH",174,0)
. . ;W "NEXT!",GN,!
-"RTN","C0CXPATH",177,0)
+"RTN","C0CXPATH",175,0)
. . S C0CN=C0CN-1 ; PREVIOUS SUBSCRIPT
-"RTN","C0CXPATH",178,0)
+"RTN","C0CXPATH",176,0)
. . I GN'="" D ;
-"RTN","C0CXPATH",179,0)
+"RTN","C0CXPATH",177,0)
. . . I $QS(G,C0CN)'=$QS(GN,C0CN) D ; NEED TO CLOSE OFF ELEMENT
-"RTN","C0CXPATH",180,0)
+"RTN","C0CXPATH",178,0)
. . . . D ZXC($QS(G,C0CN)) ;
-"RTN","C0CXPATH",181,0)
+"RTN","C0CXPATH",179,0)
. . . E I GN'="" D ; MORE ELEMENTS AT THIS LEVEL
-"RTN","C0CXPATH",182,0)
+"RTN","C0CXPATH",180,0)
. . . . S G=$Q(@G) ; ADVANCE TO NEW XPATH
-"RTN","C0CXPATH",183,0)
+"RTN","C0CXPATH",181,0)
. . . . S C0CN=C0CN+1 ; GET READY TO PROCESS NEXT SUBSCRIPT
-"RTN","C0CXPATH",184,0)
+"RTN","C0CXPATH",182,0)
. . . . S FWD=1 ; GOING FORWARD NOW
-"RTN","C0CXPATH",185,0)
+"RTN","C0CXPATH",183,0)
. I (GN="")&(C0CN=1) D Q ; WHEN WE ARE ALL DONE
-"RTN","C0CXPATH",186,0)
+"RTN","C0CXPATH",184,0)
. . D ZXC($QS(G,C0CN)) ; LAST ONE
-"RTN","C0CXPATH",187,0)
+"RTN","C0CXPATH",185,0)
. . S ZQ=1 ; QUIT NOW
+"RTN","C0CXPATH",186,0)
+ Q
+"RTN","C0CXPATH",187,0)
+ ;
"RTN","C0CXPATH",188,0)
- Q
+ZXO(WHAT) ;
"RTN","C0CXPATH",189,0)
- ;
-"RTN","C0CXPATH",190,0)
-ZXO(WHAT)
-"RTN","C0CXPATH",191,0)
D PUSH("GA",WHAT)
-"RTN","C0CXPATH",192,0)
+"RTN","C0CXPATH",190,0)
D PUSH(OUTXML,"<"_WHAT_">")
+"RTN","C0CXPATH",191,0)
+ Q
+"RTN","C0CXPATH",192,0)
+ ;
"RTN","C0CXPATH",193,0)
- Q
+ZXC(WHAT) ;
"RTN","C0CXPATH",194,0)
- ;
-"RTN","C0CXPATH",195,0)
-ZXC(WHAT)
-"RTN","C0CXPATH",196,0)
D POP("GA",.TMP)
-"RTN","C0CXPATH",197,0)
+"RTN","C0CXPATH",195,0)
D PUSH(OUTXML,""_WHAT_">")
+"RTN","C0CXPATH",196,0)
+ Q
+"RTN","C0CXPATH",197,0)
+ ;
"RTN","C0CXPATH",198,0)
- Q
+ZXVAL(WHAT,VAL) ;
"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",200,0)
Q
-"RTN","C0CXPATH",203,0)
+"RTN","C0CXPATH",201,0)
;
-"RTN","C0CXPATH",204,0)
+"RTN","C0CXPATH",202,0)
INDEX(IZXML,VDX,NOINX,TEMPLATE,REDUX) ; parse XML in IZXML and produce
-"RTN","C0CXPATH",205,0)
+"RTN","C0CXPATH",203,0)
; an XPATH index; REDUX is a string to be removed from each xpath
-"RTN","C0CXPATH",206,0)
+"RTN","C0CXPATH",204,0)
; GPL 7/14/09 OPTIONALLY GENERATE AN XML TEMPLATE IF PASSED BY NAME
-"RTN","C0CXPATH",207,0)
+"RTN","C0CXPATH",205,0)
; TEMPLATE IS IDENTICAL TO THE PARSED XML LINE BY LINE
-"RTN","C0CXPATH",208,0)
+"RTN","C0CXPATH",206,0)
; EXCEPT THAT DATA VALUES ARE REPLACED WITH @@XPATH@@ FOR THE XPATH OF THE TAG
-"RTN","C0CXPATH",209,0)
+"RTN","C0CXPATH",207,0)
; GPL 5/24/09 AND OPTIONALLY PRODUCE THE VDX ARRAY PASSED BY NAME
-"RTN","C0CXPATH",210,0)
+"RTN","C0CXPATH",208,0)
; @VDX@("XPATH")=VALUE
-"RTN","C0CXPATH",211,0)
+"RTN","C0CXPATH",209,0)
; ex. @IZXML@("XPATH")=FIRSTLINE^LASTLINE
-"RTN","C0CXPATH",212,0)
+"RTN","C0CXPATH",210,0)
; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
-"RTN","C0CXPATH",213,0)
+"RTN","C0CXPATH",211,0)
; XML SECTION
-"RTN","C0CXPATH",214,0)
+"RTN","C0CXPATH",212,0)
; IZXML IS PASSED BY NAME
-"RTN","C0CXPATH",215,0)
+"RTN","C0CXPATH",213,0)
; IF NOINX IS SET TO 1, NO INDEX WILL BE GENERATED, BUT THE VDX WILL BE
-"RTN","C0CXPATH",216,0)
+"RTN","C0CXPATH",214,0)
N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND,CURVAL,DVDX,LCNT
-"RTN","C0CXPATH",217,0)
+"RTN","C0CXPATH",215,0)
N C0CSTK ; LEAVE OUT FOR DEBUGGING
-"RTN","C0CXPATH",218,0)
+"RTN","C0CXPATH",216,0)
I '$D(REDUX) S REDUX=""
-"RTN","C0CXPATH",219,0)
+"RTN","C0CXPATH",217,0)
I '$D(NOINX) S NOINX=0 ; IF NOT PASSED, GENERATE AN INDEX
-"RTN","C0CXPATH",220,0)
+"RTN","C0CXPATH",218,0)
N ZXML
-"RTN","C0CXPATH",221,0)
+"RTN","C0CXPATH",219,0)
I NOINX S ZXML=$NA(^TMP("C0CINDEX",$J)) ; TEMP PLACE FOR INDEX TO DISCARD
-"RTN","C0CXPATH",222,0)
+"RTN","C0CXPATH",220,0)
E S ZXML=IZXML ; PLACE FOR INDEX TO KEEP
-"RTN","C0CXPATH",223,0)
+"RTN","C0CXPATH",221,0)
I '$D(@IZXML@(0)) D ; IF COUNT NOT IN NODE 0 COUNT THEM
-"RTN","C0CXPATH",224,0)
+"RTN","C0CXPATH",222,0)
. S I="",LCNT=0
-"RTN","C0CXPATH",225,0)
+"RTN","C0CXPATH",223,0)
. F S I=$O(@IZXML@(I)) Q:I="" S LCNT=LCNT+1
-"RTN","C0CXPATH",226,0)
+"RTN","C0CXPATH",224,0)
E S LCNT=@IZXML@(0) ; LINE COUNT PASSED IN ARRAY
-"RTN","C0CXPATH",227,0)
+"RTN","C0CXPATH",225,0)
I LCNT=0 D Q ; NO XML PASSED
-"RTN","C0CXPATH",228,0)
+"RTN","C0CXPATH",226,0)
. W "ERROR IN XML FILE",!
-"RTN","C0CXPATH",229,0)
+"RTN","C0CXPATH",227,0)
S DVDX=0 ; DEFAULT DO NOT PRODUCE VDX INDEX
-"RTN","C0CXPATH",230,0)
+"RTN","C0CXPATH",228,0)
I $D(VDX) S DVDX=1 ; IF NAME PASSED, DO VDX
-"RTN","C0CXPATH",231,0)
+"RTN","C0CXPATH",229,0)
S C0CSTK(0)=0 ; INITIALIZE STACK
-"RTN","C0CXPATH",232,0)
+"RTN","C0CXPATH",230,0)
K LKASD ; KILL LOOKASIDE ARRAY
-"RTN","C0CXPATH",233,0)
+"RTN","C0CXPATH",231,0)
D MKLASD(.LKASD,IZXML) ;MAKE LOOK ASIDE BUFFER FOR MULTIPLES
-"RTN","C0CXPATH",234,0)
+"RTN","C0CXPATH",232,0)
F I=1:1:LCNT D ; PROCESS THE ENTIRE ARRAY
-"RTN","C0CXPATH",235,0)
+"RTN","C0CXPATH",233,0)
. S LINE=@IZXML@(I)
-"RTN","C0CXPATH",236,0)
+"RTN","C0CXPATH",234,0)
. I $D(TEMPLATE) D ;IF TEMPLATE IS REQUESTED
-"RTN","C0CXPATH",237,0)
- . . S @TEMPLATE@(I)=$$CLEAN(LINE)
-"RTN","C0CXPATH",238,0)
+"RTN","C0CXPATH",235,0)
+ . . S @TEMPLATE@(I)=$$CLEAN(LINE)
+"RTN","C0CXPATH",236,0)
. ;W LINE,!
-"RTN","C0CXPATH",239,0)
+"RTN","C0CXPATH",237,0)
. S FOUND=0 ; INTIALIZED FOUND FLAG
-"RTN","C0CXPATH",240,0)
+"RTN","C0CXPATH",238,0)
. I LINE?.E1"".E) D
-"RTN","C0CXPATH",243,0)
+"RTN","C0CXPATH",241,0)
. . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
-"RTN","C0CXPATH",244,0)
+"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)
- . . . ; W "FOUND ",LINE,!
+ . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
"RTN","C0CXPATH",246,0)
- . . . S FOUND=1 ; SET FOUND FLAG
+ . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES
"RTN","C0CXPATH",247,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+ . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK
"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",249,0)
+ . . . ; W "MDX=",MDX,!
+"RTN","C0CXPATH",250,0)
+ . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE
"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)
+"RTN","C0CXPATH",252,0)
. . . . ;E S ZDUP(MDX)=ZDUP(MDX)+1
-"RTN","C0CXPATH",255,0)
+"RTN","C0CXPATH",253,0)
. . . . ;W "DUP:",MDX,!
-"RTN","C0CXPATH",256,0)
+"RTN","C0CXPATH",254,0)
. . . . ;I '$D(CURVAL) S CURVAL=""
-"RTN","C0CXPATH",257,0)
+"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 $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)
+"RTN","C0CXPATH",259,0)
. . . . S CURVAL=$$XVAL(LINE) ; VALUE
-"RTN","C0CXPATH",262,0)
+"RTN","C0CXPATH",260,0)
. . . . S $P(@ZXML@(MDX),"^",3)=CURVAL ; THIRD PIECE
-"RTN","C0CXPATH",263,0)
+"RTN","C0CXPATH",261,0)
. . . . I DVDX S @VDX@(MDX)=CURVAL ; FILL IN VDX ARRAY IF REQUESTED
-"RTN","C0CXPATH",264,0)
+"RTN","C0CXPATH",262,0)
. . . . I $D(TEMPLATE) D ; IF TEMPLATE IS REQUESTED
-"RTN","C0CXPATH",265,0)
+"RTN","C0CXPATH",263,0)
. . . . . S LINE=$$CLEAN(LINE) ; CLEAN OUT CONTROL CHARACTERS
-"RTN","C0CXPATH",266,0)
+"RTN","C0CXPATH",264,0)
. . . . . S @TEMPLATE@(I)=$P(LINE,">",1)_">@@"_MDX_"@@"_$P(LINE,"",2)
-"RTN","C0CXPATH",267,0)
+"RTN","C0CXPATH",265,0)
. . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK
-"RTN","C0CXPATH",268,0)
+"RTN","C0CXPATH",266,0)
. I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END
-"RTN","C0CXPATH",269,0)
+"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)
- . . . ; W "FOUND ",LINE,!
+ . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
"RTN","C0CXPATH",271,0)
- . . . S FOUND=1 ; SET FOUND FLAG
+ . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX
"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)
+"RTN","C0CXPATH",273,0)
. . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK
-"RTN","C0CXPATH",276,0)
+"RTN","C0CXPATH",274,0)
. . . S TMP=$P(TMP,"[",1) ; REMOVE [X] FROM MULTIPLE
-"RTN","C0CXPATH",277,0)
+"RTN","C0CXPATH",275,0)
. . . I TMP'=CUR D ; MALFORMED XML, END MUST MATCH START
-"RTN","C0CXPATH",278,0)
+"RTN","C0CXPATH",276,0)
. . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
-"RTN","C0CXPATH",279,0)
+"RTN","C0CXPATH",277,0)
. . . . D PARY("C0CSTK") ; PRINT OUT THE STACK FOR DEBUGING
-"RTN","C0CXPATH",280,0)
+"RTN","C0CXPATH",278,0)
. . . . Q
-"RTN","C0CXPATH",281,0)
+"RTN","C0CXPATH",279,0)
. I FOUND'=1 D ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
-"RTN","C0CXPATH",282,0)
+"RTN","C0CXPATH",280,0)
. . I (LINE?.E1"<"1.E)&(LINE'["?>") D ; BEGINNING OF A SECTION
-"RTN","C0CXPATH",283,0)
+"RTN","C0CXPATH",281,0)
. . . ; W "FOUND ",LINE,!
-"RTN","C0CXPATH",284,0)
+"RTN","C0CXPATH",282,0)
. . . S FOUND=1 ; SET FOUND FLAG
-"RTN","C0CXPATH",285,0)
+"RTN","C0CXPATH",283,0)
. . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","C0CXPATH",286,0)
+"RTN","C0CXPATH",284,0)
. . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES
-"RTN","C0CXPATH",287,0)
+"RTN","C0CXPATH",285,0)
. . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK
-"RTN","C0CXPATH",288,0)
+"RTN","C0CXPATH",286,0)
. . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","C0CXPATH",289,0)
+"RTN","C0CXPATH",287,0)
. . . ; W "MDX=",MDX,!
-"RTN","C0CXPATH",290,0)
+"RTN","C0CXPATH",288,0)
. . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE
-"RTN","C0CXPATH",291,0)
+"RTN","C0CXPATH",289,0)
. . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","C0CXPATH",292,0)
+"RTN","C0CXPATH",290,0)
. . . . ;B
-"RTN","C0CXPATH",293,0)
+"RTN","C0CXPATH",291,0)
. . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE
-"RTN","C0CXPATH",294,0)
+"RTN","C0CXPATH",292,0)
. . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
-"RTN","C0CXPATH",295,0)
+"RTN","C0CXPATH",293,0)
S @ZXML@("INDEXED")=""
-"RTN","C0CXPATH",296,0)
+"RTN","C0CXPATH",294,0)
S @ZXML@("//")="1^"_LCNT ; ROOT XPATH
-"RTN","C0CXPATH",297,0)
+"RTN","C0CXPATH",295,0)
I NOINX K @ZXML ; DELETE UNWANTED INDEX
-"RTN","C0CXPATH",298,0)
+"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)
-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)
+"RTN","C0CXPATH",301,0)
F ZI=1:1:LCNT-1 D ; PROCESS THE ENTIRE ARRAY
-"RTN","C0CXPATH",304,0)
+"RTN","C0CXPATH",302,0)
. S ZLINE=@IZXML@(ZI)
-"RTN","C0CXPATH",305,0)
+"RTN","C0CXPATH",303,0)
. I ZI") D ; BEGINNING OF A SECTION
-"RTN","C0CXPATH",309,0)
+"RTN","C0CXPATH",307,0)
. . . S CUR2=$$XNAME(ZLINE2) ; EXTRACT THE NAME
-"RTN","C0CXPATH",310,0)
+"RTN","C0CXPATH",308,0)
. . . I CUR=CUR2 D ; IF THIS IS A MULTIPLE
-"RTN","C0CXPATH",311,0)
+"RTN","C0CXPATH",309,0)
. . . . S OUTBUF(CUR,ZI+1)=""
-"RTN","C0CXPATH",312,0)
+"RTN","C0CXPATH",310,0)
;ZWR OUTBUF
-"RTN","C0CXPATH",313,0)
+"RTN","C0CXPATH",311,0)
S ZI=""
-"RTN","C0CXPATH",314,0)
+"RTN","C0CXPATH",312,0)
F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; FOR EACH KIND OF MULTIPLE
-"RTN","C0CXPATH",315,0)
+"RTN","C0CXPATH",313,0)
. S ZN=$O(OUTBUF(ZI,"")) ; LINE NUMBER OF SECOND MULTIPLE
-"RTN","C0CXPATH",316,0)
+"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",317,0)
+"RTN","C0CXPATH",315,0)
. S OUTBUF(ZI,ZN)=""
-"RTN","C0CXPATH",318,0)
+"RTN","C0CXPATH",316,0)
S ZA=1,ZI="",ZN=""
-"RTN","C0CXPATH",319,0)
+"RTN","C0CXPATH",317,0)
F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; ADDING THE COUNT FOR THE MULIPLES [x]
-"RTN","C0CXPATH",320,0)
+"RTN","C0CXPATH",318,0)
. S ZN="",ZA=1
-"RTN","C0CXPATH",321,0)
+"RTN","C0CXPATH",319,0)
. F S ZN=$O(OUTBUF(ZI,ZN)) Q:ZN="" D ;
-"RTN","C0CXPATH",322,0)
+"RTN","C0CXPATH",320,0)
. . S OUTBUF(ZI,ZN)="["_ZA_"]"
-"RTN","C0CXPATH",323,0)
+"RTN","C0CXPATH",321,0)
. . S ZA=ZA+1
+"RTN","C0CXPATH",322,0)
+ Q
+"RTN","C0CXPATH",323,0)
+ ;
"RTN","C0CXPATH",324,0)
- Q
-"RTN","C0CXPATH",325,0)
- ;
-"RTN","C0CXPATH",326,0)
CLEAN(STR,TR) ; extrinsic function; returns string
-"RTN","C0CXPATH",327,0)
+"RTN","C0CXPATH",325,0)
;; Removes all non printable characters from a string.
-"RTN","C0CXPATH",328,0)
+"RTN","C0CXPATH",326,0)
;; STR by Value
-"RTN","C0CXPATH",329,0)
+"RTN","C0CXPATH",327,0)
;; TR IS OPTIONAL TO IMPROVE PERFORMANCE
-"RTN","C0CXPATH",330,0)
+"RTN","C0CXPATH",328,0)
N TR,I
-"RTN","C0CXPATH",331,0)
+"RTN","C0CXPATH",329,0)
I '$D(TR) D ;
-"RTN","C0CXPATH",332,0)
+"RTN","C0CXPATH",330,0)
. F I=0:1:31 S TR=$G(TR)_$C(I)
-"RTN","C0CXPATH",333,0)
+"RTN","C0CXPATH",331,0)
. S TR=TR_$C(127)
-"RTN","C0CXPATH",334,0)
+"RTN","C0CXPATH",332,0)
QUIT $TR(STR,TR)
-"RTN","C0CXPATH",335,0)
+"RTN","C0CXPATH",333,0)
;
-"RTN","C0CXPATH",336,0)
+"RTN","C0CXPATH",334,0)
QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
-"RTN","C0CXPATH",337,0)
+"RTN","C0CXPATH",335,0)
; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
-"RTN","C0CXPATH",338,0)
+"RTN","C0CXPATH",336,0)
; IARY AND OARY ARE PASSED BY NAME
-"RTN","C0CXPATH",339,0)
+"RTN","C0CXPATH",337,0)
I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY
-"RTN","C0CXPATH",340,0)
+"RTN","C0CXPATH",338,0)
. D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
-"RTN","C0CXPATH",341,0)
+"RTN","C0CXPATH",339,0)
N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
-"RTN","C0CXPATH",342,0)
+"RTN","C0CXPATH",340,0)
N TMP,I,J,QXPATH
-"RTN","C0CXPATH",343,0)
+"RTN","C0CXPATH",341,0)
S FIRST=1
-"RTN","C0CXPATH",344,0)
+"RTN","C0CXPATH",342,0)
I '$D(@IARY@(0)) D ; LINE COUNT NOT IN ZERO NODE
-"RTN","C0CXPATH",345,0)
+"RTN","C0CXPATH",343,0)
. S @IARY@(0)=$O(@IARY@("//"),-1) ; THIS SHOULD USUALLY WORK
-"RTN","C0CXPATH",346,0)
+"RTN","C0CXPATH",344,0)
S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
-"RTN","C0CXPATH",347,0)
+"RTN","C0CXPATH",345,0)
I XPATH'="//" D ; NOT A ROOT QUERY
-"RTN","C0CXPATH",348,0)
+"RTN","C0CXPATH",346,0)
. S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
-"RTN","C0CXPATH",349,0)
+"RTN","C0CXPATH",347,0)
. S FIRST=$P(TMP,"^",1)
-"RTN","C0CXPATH",350,0)
+"RTN","C0CXPATH",348,0)
. S LAST=$P(TMP,"^",2)
-"RTN","C0CXPATH",351,0)
+"RTN","C0CXPATH",349,0)
K @OARY
-"RTN","C0CXPATH",352,0)
+"RTN","C0CXPATH",350,0)
S @OARY@(0)=+LAST-FIRST+1
-"RTN","C0CXPATH",353,0)
+"RTN","C0CXPATH",351,0)
S J=1
-"RTN","C0CXPATH",354,0)
+"RTN","C0CXPATH",352,0)
FOR I=FIRST:1:LAST D
-"RTN","C0CXPATH",355,0)
+"RTN","C0CXPATH",353,0)
. S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
-"RTN","C0CXPATH",356,0)
+"RTN","C0CXPATH",354,0)
. S J=J+1
-"RTN","C0CXPATH",357,0)
+"RTN","C0CXPATH",355,0)
; ZWR OARY
+"RTN","C0CXPATH",356,0)
+ Q
+"RTN","C0CXPATH",357,0)
+ ;
"RTN","C0CXPATH",358,0)
- Q
-"RTN","C0CXPATH",359,0)
- ;
-"RTN","C0CXPATH",360,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)
- ; 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",362,0)
;
-"RTN","C0CXPATH",365,0)
+"RTN","C0CXPATH",363,0)
XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
-"RTN","C0CXPATH",366,0)
+"RTN","C0CXPATH",364,0)
; INDEX WITH TWO PIECES START^FINISH
-"RTN","C0CXPATH",367,0)
+"RTN","C0CXPATH",365,0)
; IDX IS PASSED BY NAME
-"RTN","C0CXPATH",368,0)
+"RTN","C0CXPATH",366,0)
Q $P(@IDX@(XPATH),"^",2)
-"RTN","C0CXPATH",369,0)
+"RTN","C0CXPATH",367,0)
;
-"RTN","C0CXPATH",370,0)
+"RTN","C0CXPATH",368,0)
START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
-"RTN","C0CXPATH",371,0)
+"RTN","C0CXPATH",369,0)
; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","C0CXPATH",372,0)
+"RTN","C0CXPATH",370,0)
; COMPANION TO FINISH ; IDX IS PASSED BY NAME
-"RTN","C0CXPATH",373,0)
+"RTN","C0CXPATH",371,0)
Q $P(ISTR,";",2)
-"RTN","C0CXPATH",374,0)
+"RTN","C0CXPATH",372,0)
;
-"RTN","C0CXPATH",375,0)
+"RTN","C0CXPATH",373,0)
FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
-"RTN","C0CXPATH",376,0)
+"RTN","C0CXPATH",374,0)
; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","C0CXPATH",377,0)
+"RTN","C0CXPATH",375,0)
Q $P(ISTR,";",3)
-"RTN","C0CXPATH",378,0)
+"RTN","C0CXPATH",376,0)
;
-"RTN","C0CXPATH",379,0)
+"RTN","C0CXPATH",377,0)
ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
-"RTN","C0CXPATH",380,0)
+"RTN","C0CXPATH",378,0)
; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","C0CXPATH",381,0)
+"RTN","C0CXPATH",379,0)
Q $P(ISTR,";",1)
-"RTN","C0CXPATH",382,0)
+"RTN","C0CXPATH",380,0)
;
-"RTN","C0CXPATH",383,0)
+"RTN","C0CXPATH",381,0)
BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
-"RTN","C0CXPATH",384,0)
+"RTN","C0CXPATH",382,0)
; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
-"RTN","C0CXPATH",385,0)
+"RTN","C0CXPATH",383,0)
; DEST IS CLEARED TO START
-"RTN","C0CXPATH",386,0)
+"RTN","C0CXPATH",384,0)
; USES PUSH TO DO THE COPY
-"RTN","C0CXPATH",387,0)
+"RTN","C0CXPATH",385,0)
N I
-"RTN","C0CXPATH",388,0)
+"RTN","C0CXPATH",386,0)
K @BDEST
-"RTN","C0CXPATH",389,0)
+"RTN","C0CXPATH",387,0)
F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST
-"RTN","C0CXPATH",390,0)
+"RTN","C0CXPATH",388,0)
. N J,ATMP
-"RTN","C0CXPATH",391,0)
+"RTN","C0CXPATH",389,0)
. S ATMP=$$ARRAY(@BLIST@(I))
-"RTN","C0CXPATH",392,0)
+"RTN","C0CXPATH",390,0)
. I $G(DEBUG) W "ATMP=",ATMP,!
-"RTN","C0CXPATH",393,0)
+"RTN","C0CXPATH",391,0)
. I $G(DEBUG) W @BLIST@(I),!
-"RTN","C0CXPATH",394,0)
+"RTN","C0CXPATH",392,0)
. F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ;
-"RTN","C0CXPATH",395,0)
+"RTN","C0CXPATH",393,0)
. . ; FOR EACH LINE IN THIS INSTR
-"RTN","C0CXPATH",396,0)
+"RTN","C0CXPATH",394,0)
. . I $G(DEBUG) W "BDEST= ",BDEST,!
-"RTN","C0CXPATH",397,0)
+"RTN","C0CXPATH",395,0)
. . I $G(DEBUG) W "ATMP= ",@ATMP@(J),!
-"RTN","C0CXPATH",398,0)
+"RTN","C0CXPATH",396,0)
. . D PUSH(BDEST,@ATMP@(J))
-"RTN","C0CXPATH",399,0)
+"RTN","C0CXPATH",397,0)
Q
+"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)
-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)
+"RTN","C0CXPATH",402,0)
D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
+"RTN","C0CXPATH",403,0)
+ Q
+"RTN","C0CXPATH",404,0)
+ ;
"RTN","C0CXPATH",405,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)
+"RTN","C0CXPATH",406,0)
; KILLS CPDEST FIRST
-"RTN","C0CXPATH",409,0)
+"RTN","C0CXPATH",407,0)
N CPINSTR
-"RTN","C0CXPATH",410,0)
+"RTN","C0CXPATH",408,0)
I $G(DEBUG) W "MADE IT TO COPY",CPSRC,CPDEST,!
-"RTN","C0CXPATH",411,0)
+"RTN","C0CXPATH",409,0)
I @CPSRC@(0)<1 D ; BAD LENGTH
-"RTN","C0CXPATH",412,0)
+"RTN","C0CXPATH",410,0)
. W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
-"RTN","C0CXPATH",413,0)
+"RTN","C0CXPATH",411,0)
. Q
-"RTN","C0CXPATH",414,0)
+"RTN","C0CXPATH",412,0)
; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
-"RTN","C0CXPATH",415,0)
+"RTN","C0CXPATH",413,0)
D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
-"RTN","C0CXPATH",416,0)
+"RTN","C0CXPATH",414,0)
D BUILD("CPINSTR",CPDEST)
+"RTN","C0CXPATH",415,0)
+ Q
+"RTN","C0CXPATH",416,0)
+ ;
"RTN","C0CXPATH",417,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)
+"RTN","C0CXPATH",418,0)
; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
-"RTN","C0CXPATH",421,0)
+"RTN","C0CXPATH",419,0)
; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
-"RTN","C0CXPATH",422,0)
+"RTN","C0CXPATH",420,0)
; USED TO INSERT CHILDREN NODES
-"RTN","C0CXPATH",423,0)
+"RTN","C0CXPATH",421,0)
I @QOXML@(0)<1 D ; MALFORMED XML
-"RTN","C0CXPATH",424,0)
+"RTN","C0CXPATH",422,0)
. W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
-"RTN","C0CXPATH",425,0)
+"RTN","C0CXPATH",423,0)
. Q
-"RTN","C0CXPATH",426,0)
+"RTN","C0CXPATH",424,0)
I $G(DEBUG) W "DOING QOPEN",!
-"RTN","C0CXPATH",427,0)
+"RTN","C0CXPATH",425,0)
N S1,E1,QOT,QOTMP
-"RTN","C0CXPATH",428,0)
+"RTN","C0CXPATH",426,0)
S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
-"RTN","C0CXPATH",429,0)
+"RTN","C0CXPATH",427,0)
I $D(QOXPATH) D ; XPATH PROVIDED
-"RTN","C0CXPATH",430,0)
+"RTN","C0CXPATH",428,0)
. D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
-"RTN","C0CXPATH",431,0)
+"RTN","C0CXPATH",429,0)
. S E1=$P(@QOXML@(QOXPATH),"^",2)-1
-"RTN","C0CXPATH",432,0)
+"RTN","C0CXPATH",430,0)
I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT
-"RTN","C0CXPATH",433,0)
+"RTN","C0CXPATH",431,0)
. S E1=@QOXML@(0)-1
-"RTN","C0CXPATH",434,0)
+"RTN","C0CXPATH",432,0)
D QUEUE(QOBLIST,QOXML,S1,E1)
-"RTN","C0CXPATH",435,0)
+"RTN","C0CXPATH",433,0)
; S QOTMP=QOXML_"^"_S1_"^"_E1
-"RTN","C0CXPATH",436,0)
+"RTN","C0CXPATH",434,0)
; D PUSH(QOBLIST,QOTMP)
+"RTN","C0CXPATH",435,0)
+ Q
+"RTN","C0CXPATH",436,0)
+ ;
"RTN","C0CXPATH",437,0)
- Q
-"RTN","C0CXPATH",438,0)
- ;
-"RTN","C0CXPATH",439,0)
QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN
-"RTN","C0CXPATH",440,0)
+"RTN","C0CXPATH",438,0)
; ADDS THE LIST LINE OF QCXML TO QCBLIST
-"RTN","C0CXPATH",441,0)
+"RTN","C0CXPATH",439,0)
; USED TO FINISH INSERTING CHILDERN NODES
-"RTN","C0CXPATH",442,0)
+"RTN","C0CXPATH",440,0)
; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
-"RTN","C0CXPATH",443,0)
+"RTN","C0CXPATH",441,0)
; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
-"RTN","C0CXPATH",444,0)
+"RTN","C0CXPATH",442,0)
I @QCXML@(0)<1 D ; MALFORMED XML
-"RTN","C0CXPATH",445,0)
+"RTN","C0CXPATH",443,0)
. W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
-"RTN","C0CXPATH",446,0)
+"RTN","C0CXPATH",444,0)
I $G(DEBUG) W "GOING TO CLOSE",!
-"RTN","C0CXPATH",447,0)
+"RTN","C0CXPATH",445,0)
N S1,E1,QCT,QCTMP
-"RTN","C0CXPATH",448,0)
+"RTN","C0CXPATH",446,0)
S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
-"RTN","C0CXPATH",449,0)
+"RTN","C0CXPATH",447,0)
I $D(QCXPATH) D ; XPATH PROVIDED
-"RTN","C0CXPATH",450,0)
+"RTN","C0CXPATH",448,0)
. D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
-"RTN","C0CXPATH",451,0)
+"RTN","C0CXPATH",449,0)
. S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
-"RTN","C0CXPATH",452,0)
+"RTN","C0CXPATH",450,0)
I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT
-"RTN","C0CXPATH",453,0)
+"RTN","C0CXPATH",451,0)
. S S1=@QCXML@(0)
-"RTN","C0CXPATH",454,0)
+"RTN","C0CXPATH",452,0)
D QUEUE(QCBLIST,QCXML,S1,E1)
-"RTN","C0CXPATH",455,0)
+"RTN","C0CXPATH",453,0)
; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
+"RTN","C0CXPATH",454,0)
+ Q
+"RTN","C0CXPATH",455,0)
+ ;
"RTN","C0CXPATH",456,0)
- Q
-"RTN","C0CXPATH",457,0)
- ;
-"RTN","C0CXPATH",458,0)
INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE
-"RTN","C0CXPATH",459,0)
+"RTN","C0CXPATH",457,0)
; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
-"RTN","C0CXPATH",460,0)
+"RTN","C0CXPATH",458,0)
; OMITTED, INSERTION WILL BE AT THE ROOT
-"RTN","C0CXPATH",461,0)
+"RTN","C0CXPATH",459,0)
; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
-"RTN","C0CXPATH",462,0)
+"RTN","C0CXPATH",460,0)
; XML AT THE END OF THE XPATH POINT
-"RTN","C0CXPATH",463,0)
+"RTN","C0CXPATH",461,0)
; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
-"RTN","C0CXPATH",464,0)
+"RTN","C0CXPATH",462,0)
N INSBLD,INSTMP
-"RTN","C0CXPATH",465,0)
+"RTN","C0CXPATH",463,0)
I $G(DEBUG) W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
-"RTN","C0CXPATH",466,0)
+"RTN","C0CXPATH",464,0)
I $G(DEBUG) F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
-"RTN","C0CXPATH",467,0)
+"RTN","C0CXPATH",465,0)
I '$D(@INSXML@(1)) D ; INSERT INTO AN EMPTY ARRAY
-"RTN","C0CXPATH",468,0)
+"RTN","C0CXPATH",466,0)
. D CP^C0CXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
-"RTN","C0CXPATH",469,0)
+"RTN","C0CXPATH",467,0)
I $D(@INSXML@(1)) D ; IF ORIGINAL ARRAY IS NOT EMPTY
-"RTN","C0CXPATH",470,0)
+"RTN","C0CXPATH",468,0)
. I '$D(@INSXML@(0)) S @INSXML@(0)=$O(@INSXML@(""),-1) ;SET LENGTH
-"RTN","C0CXPATH",471,0)
+"RTN","C0CXPATH",469,0)
. I $D(INSXPATH) D ; XPATH PROVIDED
-"RTN","C0CXPATH",472,0)
+"RTN","C0CXPATH",470,0)
. . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
-"RTN","C0CXPATH",473,0)
+"RTN","C0CXPATH",471,0)
. . I $G(DEBUG) D PARY^C0CXPATH("INSBLD")
-"RTN","C0CXPATH",474,0)
+"RTN","C0CXPATH",472,0)
. I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT
-"RTN","C0CXPATH",475,0)
+"RTN","C0CXPATH",473,0)
. . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
-"RTN","C0CXPATH",476,0)
+"RTN","C0CXPATH",474,0)
. I '$D(@INSNEW@(0)) S @INSNEW@(0)=$O(@INSNEW@(""),-1) ;SIZE OF XML
-"RTN","C0CXPATH",477,0)
+"RTN","C0CXPATH",475,0)
. D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
-"RTN","C0CXPATH",478,0)
+"RTN","C0CXPATH",476,0)
. I $D(INSXPATH) D ; XPATH PROVIDED
-"RTN","C0CXPATH",479,0)
+"RTN","C0CXPATH",477,0)
. . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
-"RTN","C0CXPATH",480,0)
+"RTN","C0CXPATH",478,0)
. I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT
-"RTN","C0CXPATH",481,0)
+"RTN","C0CXPATH",479,0)
. . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
-"RTN","C0CXPATH",482,0)
+"RTN","C0CXPATH",480,0)
. D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
-"RTN","C0CXPATH",483,0)
+"RTN","C0CXPATH",481,0)
. D CP^C0CXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
+"RTN","C0CXPATH",482,0)
+ Q
+"RTN","C0CXPATH",483,0)
+ ;
"RTN","C0CXPATH",484,0)
- Q
-"RTN","C0CXPATH",485,0)
- ;
-"RTN","C0CXPATH",486,0)
INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW
-"RTN","C0CXPATH",487,0)
+"RTN","C0CXPATH",485,0)
; INTO INNXML AT THE INNXPATH XPATH POINT
-"RTN","C0CXPATH",488,0)
+"RTN","C0CXPATH",486,0)
;
-"RTN","C0CXPATH",489,0)
+"RTN","C0CXPATH",487,0)
N INNBLD,UXPATH
-"RTN","C0CXPATH",490,0)
+"RTN","C0CXPATH",488,0)
N INNTBUF
-"RTN","C0CXPATH",491,0)
+"RTN","C0CXPATH",489,0)
S INNTBUF=$NA(^TMP($J,"INNTBUF"))
-"RTN","C0CXPATH",492,0)
+"RTN","C0CXPATH",490,0)
I '$D(INNXPATH) D ; XPATH NOT PASSED
-"RTN","C0CXPATH",493,0)
+"RTN","C0CXPATH",491,0)
. S UXPATH="//" ; USE ROOT XPATH
-"RTN","C0CXPATH",494,0)
+"RTN","C0CXPATH",492,0)
I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
-"RTN","C0CXPATH",495,0)
+"RTN","C0CXPATH",493,0)
I '$D(@INNXML@(0)) D ; INNXML IS EMPTY
-"RTN","C0CXPATH",496,0)
+"RTN","C0CXPATH",494,0)
. D QUEUE^C0CXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
-"RTN","C0CXPATH",497,0)
+"RTN","C0CXPATH",495,0)
. D BUILD("INNBLD",INNXML)
-"RTN","C0CXPATH",498,0)
+"RTN","C0CXPATH",496,0)
I @INNXML@(0)>0 D ; NOT EMPTY
-"RTN","C0CXPATH",499,0)
+"RTN","C0CXPATH",497,0)
. D QOPEN("INNBLD",INNXML,UXPATH) ;
-"RTN","C0CXPATH",500,0)
+"RTN","C0CXPATH",498,0)
. D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
-"RTN","C0CXPATH",501,0)
+"RTN","C0CXPATH",499,0)
. D QCLOSE("INNBLD",INNXML,UXPATH)
-"RTN","C0CXPATH",502,0)
+"RTN","C0CXPATH",500,0)
. D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
-"RTN","C0CXPATH",503,0)
+"RTN","C0CXPATH",501,0)
. D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
+"RTN","C0CXPATH",502,0)
+ Q
+"RTN","C0CXPATH",503,0)
+ ;
"RTN","C0CXPATH",504,0)
- Q
-"RTN","C0CXPATH",505,0)
- ;
-"RTN","C0CXPATH",506,0)
INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
-"RTN","C0CXPATH",507,0)
+"RTN","C0CXPATH",505,0)
; BUT XDEST AN XNEW ARE PASSED BY NAME
-"RTN","C0CXPATH",508,0)
+"RTN","C0CXPATH",506,0)
N XBLD,XTMP
-"RTN","C0CXPATH",509,0)
+"RTN","C0CXPATH",507,0)
D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
-"RTN","C0CXPATH",510,0)
+"RTN","C0CXPATH",508,0)
D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
-"RTN","C0CXPATH",511,0)
+"RTN","C0CXPATH",509,0)
D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
-"RTN","C0CXPATH",512,0)
+"RTN","C0CXPATH",510,0)
D BUILD("XBLD","XTMP") ; BUILD THE RESULT
-"RTN","C0CXPATH",513,0)
+"RTN","C0CXPATH",511,0)
D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
-"RTN","C0CXPATH",514,0)
+"RTN","C0CXPATH",512,0)
I $G(DEBUG) D PARY("XDEST")
+"RTN","C0CXPATH",513,0)
+ Q
+"RTN","C0CXPATH",514,0)
+ ;
"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)
+"RTN","C0CXPATH",516,0)
; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
-"RTN","C0CXPATH",519,0)
+"RTN","C0CXPATH",517,0)
; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
-"RTN","C0CXPATH",520,0)
+"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)
- N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
+ D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
"RTN","C0CXPATH",522,0)
- S OLD=$NA(^TMP($J,"REPLACE_OLD"))
+ S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
"RTN","C0CXPATH",523,0)
- D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
+ S XFIRST=$P(XNODE,"^",1)
"RTN","C0CXPATH",524,0)
- S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
+ S XLAST=$P(XNODE,"^",2)
"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)
+"RTN","C0CXPATH",526,0)
. D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
-"RTN","C0CXPATH",529,0)
+"RTN","C0CXPATH",527,0)
. D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
-"RTN","C0CXPATH",530,0)
+"RTN","C0CXPATH",528,0)
I RENEW'="" D ; NEW XML IS NOT NULL
-"RTN","C0CXPATH",531,0)
+"RTN","C0CXPATH",529,0)
. D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
-"RTN","C0CXPATH",532,0)
+"RTN","C0CXPATH",530,0)
. D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
-"RTN","C0CXPATH",533,0)
+"RTN","C0CXPATH",531,0)
. D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
-"RTN","C0CXPATH",534,0)
+"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)
- I $G(DEBUG) D PARY("REBLD")
+ K @REXML ; KILL WHAT WAS THERE
"RTN","C0CXPATH",536,0)
- D BUILD("REBLD","RTMP")
+ D CP("RTMP",REXML) ; COPY IN THE RESULT
"RTN","C0CXPATH",537,0)
- K @REXML ; KILL WHAT WAS THERE
+ Q
"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)
+"RTN","C0CXPATH",540,0)
; REXML IS PASSED BY NAME XPATH IS A VALUE
-"RTN","C0CXPATH",543,0)
+"RTN","C0CXPATH",541,0)
N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
-"RTN","C0CXPATH",544,0)
+"RTN","C0CXPATH",542,0)
S OLD=$NA(^TMP($J,"REPLACE_OLD"))
-"RTN","C0CXPATH",545,0)
+"RTN","C0CXPATH",543,0)
D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
-"RTN","C0CXPATH",546,0)
+"RTN","C0CXPATH",544,0)
S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
-"RTN","C0CXPATH",547,0)
+"RTN","C0CXPATH",545,0)
S XFIRST=$P(XNODE,"^",1)
-"RTN","C0CXPATH",548,0)
+"RTN","C0CXPATH",546,0)
S XLAST=$P(XNODE,"^",2)
-"RTN","C0CXPATH",549,0)
+"RTN","C0CXPATH",547,0)
D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
-"RTN","C0CXPATH",550,0)
+"RTN","C0CXPATH",548,0)
D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
-"RTN","C0CXPATH",551,0)
+"RTN","C0CXPATH",549,0)
I $G(DEBUG) D PARY("REBLD")
-"RTN","C0CXPATH",552,0)
+"RTN","C0CXPATH",550,0)
D BUILD("REBLD","RTMP")
-"RTN","C0CXPATH",553,0)
+"RTN","C0CXPATH",551,0)
K @REXML ; KILL WHAT WAS THERE
-"RTN","C0CXPATH",554,0)
+"RTN","C0CXPATH",552,0)
D CP("RTMP",REXML) ; COPY IN THE RESULT
+"RTN","C0CXPATH",553,0)
+ Q
+"RTN","C0CXPATH",554,0)
+ ;
"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)
+"RTN","C0CXPATH",556,0)
; W "Reporting on the missing",!
-"RTN","C0CXPATH",559,0)
+"RTN","C0CXPATH",557,0)
; W OARY
-"RTN","C0CXPATH",560,0)
+"RTN","C0CXPATH",558,0)
I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
-"RTN","C0CXPATH",561,0)
+"RTN","C0CXPATH",559,0)
N I
-"RTN","C0CXPATH",562,0)
+"RTN","C0CXPATH",560,0)
S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
-"RTN","C0CXPATH",563,0)
+"RTN","C0CXPATH",561,0)
F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY
-"RTN","C0CXPATH",564,0)
+"RTN","C0CXPATH",562,0)
. I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE
-"RTN","C0CXPATH",565,0)
+"RTN","C0CXPATH",563,0)
. . D PUSH^C0CXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
-"RTN","C0CXPATH",566,0)
+"RTN","C0CXPATH",564,0)
. . Q
-"RTN","C0CXPATH",567,0)
+"RTN","C0CXPATH",565,0)
Q
-"RTN","C0CXPATH",568,0)
+"RTN","C0CXPATH",566,0)
;
-"RTN","C0CXPATH",569,0)
+"RTN","C0CXPATH",567,0)
MAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
-"RTN","C0CXPATH",570,0)
+"RTN","C0CXPATH",568,0)
; AND PUT THE RESULTS IN OXML
-"RTN","C0CXPATH",571,0)
+"RTN","C0CXPATH",569,0)
N XCNT
-"RTN","C0CXPATH",572,0)
+"RTN","C0CXPATH",570,0)
I '$D(DEBUG) S DEBUG=0
-"RTN","C0CXPATH",573,0)
+"RTN","C0CXPATH",571,0)
I '$D(IXML) W "MALFORMED XML PASSED TO MAP",! Q
-"RTN","C0CXPATH",574,0)
+"RTN","C0CXPATH",572,0)
I '$D(@IXML@(0)) D ; INITIALIZE COUNT
-"RTN","C0CXPATH",575,0)
+"RTN","C0CXPATH",573,0)
. S XCNT=$O(@IXML@(""),-1)
-"RTN","C0CXPATH",576,0)
+"RTN","C0CXPATH",574,0)
E S XCNT=@IXML@(0) ;COUNT
-"RTN","C0CXPATH",577,0)
+"RTN","C0CXPATH",575,0)
I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
-"RTN","C0CXPATH",578,0)
+"RTN","C0CXPATH",576,0)
N I,J,TNAM,TVAL,TSTR
-"RTN","C0CXPATH",579,0)
+"RTN","C0CXPATH",577,0)
S @OXML@(0)=XCNT ; TOTAL LINES IN OUTPUT
-"RTN","C0CXPATH",580,0)
+"RTN","C0CXPATH",578,0)
F I=1:1:XCNT D ; LOOP THROUGH WHOLE ARRAY
-"RTN","C0CXPATH",581,0)
+"RTN","C0CXPATH",579,0)
. S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
-"RTN","C0CXPATH",582,0)
+"RTN","C0CXPATH",580,0)
. I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE?
-"RTN","C0CXPATH",583,0)
+"RTN","C0CXPATH",581,0)
. . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
-"RTN","C0CXPATH",584,0)
+"RTN","C0CXPATH",582,0)
. . F J=2:2:10 D Q:$P(@IXML@(I),"@@",J+2)="" ; QUIT IF NO MORE VARS
-"RTN","C0CXPATH",585,0)
+"RTN","C0CXPATH",583,0)
. . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
-"RTN","C0CXPATH",586,0)
+"RTN","C0CXPATH",584,0)
. . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
-"RTN","C0CXPATH",587,0)
+"RTN","C0CXPATH",585,0)
. . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
-"RTN","C0CXPATH",588,0)
+"RTN","C0CXPATH",586,0)
. . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP?
-"RTN","C0CXPATH",589,0)
+"RTN","C0CXPATH",587,0)
. . . . I '$D(@INARY@(TNAM,"F")) D ; NOT A SPECIAL FIELD
-"RTN","C0CXPATH",590,0)
+"RTN","C0CXPATH",588,0)
. . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
-"RTN","C0CXPATH",591,0)
+"RTN","C0CXPATH",589,0)
. . . . E D DOFLD ; PROCESS A FIELD
-"RTN","C0CXPATH",592,0)
+"RTN","C0CXPATH",590,0)
. . . S TVAL=$$SYMENC^MXMLUTL(TVAL) ;MAKE SURE THE VALUE IS XML SAFE
-"RTN","C0CXPATH",593,0)
+"RTN","C0CXPATH",591,0)
. . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
-"RTN","C0CXPATH",594,0)
+"RTN","C0CXPATH",592,0)
. . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
-"RTN","C0CXPATH",595,0)
+"RTN","C0CXPATH",593,0)
. . I DEBUG W TSTR
-"RTN","C0CXPATH",596,0)
+"RTN","C0CXPATH",594,0)
I DEBUG W "MAPPED",!
-"RTN","C0CXPATH",597,0)
+"RTN","C0CXPATH",595,0)
Q
+"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)
-DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE
+ Q
"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)
+"RTN","C0CXPATH",602,0)
; THEXML IS PASSED BY NAME
-"RTN","C0CXPATH",605,0)
+"RTN","C0CXPATH",603,0)
N I,J,TMPXML,DEL,FOUND,INTXT
-"RTN","C0CXPATH",606,0)
+"RTN","C0CXPATH",604,0)
S FOUND=0
-"RTN","C0CXPATH",607,0)
+"RTN","C0CXPATH",605,0)
S INTXT=0
-"RTN","C0CXPATH",608,0)
+"RTN","C0CXPATH",606,0)
I $G(DEBUG) W "DELETING EMPTY ELEMENTS",!
-"RTN","C0CXPATH",609,0)
+"RTN","C0CXPATH",607,0)
F I=1:1:(@THEXML@(0)-1) D ; LOOP THROUGH ENTIRE ARRAY
-"RTN","C0CXPATH",610,0)
+"RTN","C0CXPATH",608,0)
. S J=@THEXML@(I)
-"RTN","C0CXPATH",611,0)
+"RTN","C0CXPATH",609,0)
. I J["" D
-"RTN","C0CXPATH",612,0)
+"RTN","C0CXPATH",610,0)
. . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
-"RTN","C0CXPATH",613,0)
+"RTN","C0CXPATH",611,0)
. . I $G(DEBUG) W "IN HTML SECTION",!
-"RTN","C0CXPATH",614,0)
+"RTN","C0CXPATH",612,0)
. N JM,JP,JPX ; JMINUS AND JPLUS
-"RTN","C0CXPATH",615,0)
+"RTN","C0CXPATH",613,0)
. S JM=@THEXML@(I-1) ; LINE BEFORE
-"RTN","C0CXPATH",616,0)
+"RTN","C0CXPATH",614,0)
. I JM["" S INTXT=0 ; LEFT HTML SECTION,START TRIM
-"RTN","C0CXPATH",617,0)
+"RTN","C0CXPATH",615,0)
. S JP=@THEXML@(I+1) ; LINE AFTER
-"RTN","C0CXPATH",618,0)
+"RTN","C0CXPATH",616,0)
. I INTXT=0 D ; IF NOT IN AN HTML SECTION
-"RTN","C0CXPATH",619,0)
+"RTN","C0CXPATH",617,0)
. . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
-"RTN","C0CXPATH",620,0)
+"RTN","C0CXPATH",618,0)
. . I J=JPX D ; AN EMPTY ELEMENT ON TWO LINES
-"RTN","C0CXPATH",621,0)
+"RTN","C0CXPATH",619,0)
. . . I $G(DEBUG) W I,J,JP,!
-"RTN","C0CXPATH",622,0)
+"RTN","C0CXPATH",620,0)
. . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
-"RTN","C0CXPATH",623,0)
+"RTN","C0CXPATH",621,0)
. . . S DEL(I)="" ; SET LINE TO DELETE
-"RTN","C0CXPATH",624,0)
+"RTN","C0CXPATH",622,0)
. . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
-"RTN","C0CXPATH",625,0)
+"RTN","C0CXPATH",623,0)
. . I J["><" D ; AN EMPTY ELEMENT ON ONE LINE
-"RTN","C0CXPATH",626,0)
+"RTN","C0CXPATH",624,0)
. . . I $G(DEBUG) W I,J,!
-"RTN","C0CXPATH",627,0)
+"RTN","C0CXPATH",625,0)
. . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
-"RTN","C0CXPATH",628,0)
+"RTN","C0CXPATH",626,0)
. . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
-"RTN","C0CXPATH",629,0)
+"RTN","C0CXPATH",627,0)
. . . I JM=JPX D ;
-"RTN","C0CXPATH",630,0)
+"RTN","C0CXPATH",628,0)
. . . . I $G(DEBUG) W I,JM_J_JPX,!
-"RTN","C0CXPATH",631,0)
+"RTN","C0CXPATH",629,0)
. . . . S DEL(I-1)=""
-"RTN","C0CXPATH",632,0)
+"RTN","C0CXPATH",630,0)
. . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
-"RTN","C0CXPATH",633,0)
+"RTN","C0CXPATH",631,0)
; . I J'["><" D PUSH("TMPXML",J)
-"RTN","C0CXPATH",634,0)
+"RTN","C0CXPATH",632,0)
I FOUND D ; NEED TO DELETE THINGS
-"RTN","C0CXPATH",635,0)
+"RTN","C0CXPATH",633,0)
. F I=1:1:@THEXML@(0) D ; COPY ARRAY LEAVING OUT DELELTED LINES
-"RTN","C0CXPATH",636,0)
+"RTN","C0CXPATH",634,0)
. . I '$D(DEL(I)) D ; IF THE LINE IS NOT DELETED
-"RTN","C0CXPATH",637,0)
+"RTN","C0CXPATH",635,0)
. . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
-"RTN","C0CXPATH",638,0)
+"RTN","C0CXPATH",636,0)
. D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
-"RTN","C0CXPATH",639,0)
+"RTN","C0CXPATH",637,0)
Q FOUND
-"RTN","C0CXPATH",640,0)
+"RTN","C0CXPATH",638,0)
;
-"RTN","C0CXPATH",641,0)
+"RTN","C0CXPATH",639,0)
UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
-"RTN","C0CXPATH",642,0)
+"RTN","C0CXPATH",640,0)
; XSEC IS A SECTION PASSED BY NAME
-"RTN","C0CXPATH",643,0)
+"RTN","C0CXPATH",641,0)
N XBLD,XTMP
-"RTN","C0CXPATH",644,0)
+"RTN","C0CXPATH",642,0)
D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
-"RTN","C0CXPATH",645,0)
+"RTN","C0CXPATH",643,0)
D BUILD("XBLD","XTMP") ; BUILD THE RESULT
-"RTN","C0CXPATH",646,0)
+"RTN","C0CXPATH",644,0)
D CP("XTMP",XSEC) ; REPLACE PASSED XML
+"RTN","C0CXPATH",645,0)
+ Q
+"RTN","C0CXPATH",646,0)
+ ;
"RTN","C0CXPATH",647,0)
- Q
-"RTN","C0CXPATH",648,0)
- ;
-"RTN","C0CXPATH",649,0)
PARY(GLO,ZN) ;PRINT AN ARRAY
-"RTN","C0CXPATH",650,0)
+"RTN","C0CXPATH",648,0)
; IF ZN=-1 NO LINE NUMBERS
-"RTN","C0CXPATH",651,0)
+"RTN","C0CXPATH",649,0)
N I
-"RTN","C0CXPATH",652,0)
+"RTN","C0CXPATH",650,0)
F I=1:1:@GLO@(0) D ;
-"RTN","C0CXPATH",653,0)
+"RTN","C0CXPATH",651,0)
. I $G(ZN)=-1 W @GLO@(I),!
-"RTN","C0CXPATH",654,0)
+"RTN","C0CXPATH",652,0)
. E W I_" "_@GLO@(I),!
+"RTN","C0CXPATH",653,0)
+ Q
+"RTN","C0CXPATH",654,0)
+ ;
"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)
+"RTN","C0CXPATH",656,0)
; IPRE IS OPTIONAL PREFIX FOR THE ELEMENTS. USED FOR MUPTIPLES 1^"VAR"^VALUE
-"RTN","C0CXPATH",659,0)
+"RTN","C0CXPATH",657,0)
I '$D(IPRE) S IPRE=""
-"RTN","C0CXPATH",660,0)
+"RTN","C0CXPATH",658,0)
N H2I S H2I=""
-"RTN","C0CXPATH",661,0)
+"RTN","C0CXPATH",659,0)
; W $O(@IHASH@(H2I)),!
-"RTN","C0CXPATH",662,0)
+"RTN","C0CXPATH",660,0)
F S H2I=$O(@IHASH@(H2I)) Q:H2I="" D ; FOR EACH ELEMENT OF THE HASH
-"RTN","C0CXPATH",663,0)
+"RTN","C0CXPATH",661,0)
. I $QS(H2I,$QL(H2I))="M" D Q ; SPECIAL CASE FOR MULTIPLES
-"RTN","C0CXPATH",664,0)
+"RTN","C0CXPATH",662,0)
. . ;W H2I_"^"_@IHASH@(H2I),!
-"RTN","C0CXPATH",665,0)
+"RTN","C0CXPATH",663,0)
. . N IH,IHI
-"RTN","C0CXPATH",666,0)
+"RTN","C0CXPATH",664,0)
. . S IH=$NA(@IHASH@(H2I)) ;
-"RTN","C0CXPATH",667,0)
+"RTN","C0CXPATH",665,0)
. . S IH2A=$O(@IH@("")) ; SKIP OVER MULTIPLE DISCRIPTOR
-"RTN","C0CXPATH",668,0)
+"RTN","C0CXPATH",666,0)
. . S IH2=$NA(@IH@(IH2A)) ; PAST THE "M","DIRETIONS" FOR EXAMPLE
-"RTN","C0CXPATH",669,0)
+"RTN","C0CXPATH",667,0)
. . S IHI="" ; INDEX INTO "M" MULTIPLES
-"RTN","C0CXPATH",670,0)
+"RTN","C0CXPATH",668,0)
. . F S IHI=$O(@IH2@(IHI)) Q:IHI="" D ; FOR EACH SUB-MULTIPLE
-"RTN","C0CXPATH",671,0)
+"RTN","C0CXPATH",669,0)
. . . ; W @IH@(IHI)
-"RTN","C0CXPATH",672,0)
+"RTN","C0CXPATH",670,0)
. . . S IH3=$NA(@IH2@(IHI))
-"RTN","C0CXPATH",673,0)
+"RTN","C0CXPATH",671,0)
. . . ; W "HEY",IH3,!
-"RTN","C0CXPATH",674,0)
+"RTN","C0CXPATH",672,0)
. . . D H2ARY(.IARYRTN,IH3,IPRE_";"_IHI) ; RECURSIVE CALL - INDENTED ELEMENTS
-"RTN","C0CXPATH",675,0)
+"RTN","C0CXPATH",673,0)
. . ; W IH,!
-"RTN","C0CXPATH",676,0)
+"RTN","C0CXPATH",674,0)
. . ; W "C0CZZ",!
-"RTN","C0CXPATH",677,0)
+"RTN","C0CXPATH",675,0)
. . ; W $NA(@IHASH@(H2I)),!
-"RTN","C0CXPATH",678,0)
+"RTN","C0CXPATH",676,0)
. . Q ;
-"RTN","C0CXPATH",679,0)
+"RTN","C0CXPATH",677,0)
. D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I))
-"RTN","C0CXPATH",680,0)
+"RTN","C0CXPATH",678,0)
. ; W @IARYRTN@(0),!
+"RTN","C0CXPATH",679,0)
+ Q
+"RTN","C0CXPATH",680,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)
+"RTN","C0CXPATH",682,0)
; DEFINED IN INPUT XML XVIXML BY @@VAR@@
-"RTN","C0CXPATH",685,0)
+"RTN","C0CXPATH",683,0)
; XVRTN AND XVIXML ARE PASSED BY NAME
-"RTN","C0CXPATH",686,0)
+"RTN","C0CXPATH",684,0)
;
-"RTN","C0CXPATH",687,0)
+"RTN","C0CXPATH",685,0)
N XVI,XVTMP,XVT
-"RTN","C0CXPATH",688,0)
+"RTN","C0CXPATH",686,0)
F XVI=1:1:@XVIXML@(0) D ; FOR ALL LINES OF THE XML
-"RTN","C0CXPATH",689,0)
+"RTN","C0CXPATH",687,0)
. S XVT=@XVIXML@(XVI)
-"RTN","C0CXPATH",690,0)
+"RTN","C0CXPATH",688,0)
. I XVT["@@" S XVTMP($P(XVT,"@@",2))=XVI
-"RTN","C0CXPATH",691,0)
+"RTN","C0CXPATH",689,0)
D H2ARY(XVRTN,"XVTMP")
+"RTN","C0CXPATH",690,0)
+ Q
+"RTN","C0CXPATH",691,0)
+ ;
"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)
+"RTN","C0CXPATH",693,0)
; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE
-"RTN","C0CXPATH",696,0)
+"RTN","C0CXPATH",694,0)
;
-"RTN","C0CXPATH",697,0)
+"RTN","C0CXPATH",695,0)
N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED
-"RTN","C0CXPATH",698,0)
+"RTN","C0CXPATH",696,0)
I DXIN="CCR" D ; NEED TO GO GET CCR TEMPLATE
-"RTN","C0CXPATH",699,0)
+"RTN","C0CXPATH",697,0)
. D LOAD^C0CCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
-"RTN","C0CXPATH",700,0)
+"RTN","C0CXPATH",698,0)
. S DXUSE="DTMP" ; DXUSE IS NAME
-"RTN","C0CXPATH",701,0)
+"RTN","C0CXPATH",699,0)
E I DXIN="CCD" D ; NEED TO GO GET CCD TEMPLATE
-"RTN","C0CXPATH",702,0)
+"RTN","C0CXPATH",700,0)
. D LOAD^C0CCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
-"RTN","C0CXPATH",703,0)
+"RTN","C0CXPATH",701,0)
. S DXUSE="DTMP" ; DXUSE IS NAME
-"RTN","C0CXPATH",704,0)
+"RTN","C0CXPATH",702,0)
E S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE
-"RTN","C0CXPATH",705,0)
+"RTN","C0CXPATH",703,0)
N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE
-"RTN","C0CXPATH",706,0)
+"RTN","C0CXPATH",704,0)
D XVARS("DVARS",DXUSE) ; PULL OUT VARS
-"RTN","C0CXPATH",707,0)
+"RTN","C0CXPATH",705,0)
D PARY^C0CXPATH("DVARS") ;AND DISPLAY THEM
+"RTN","C0CXPATH",706,0)
+ Q
+"RTN","C0CXPATH",707,0)
+ ;
"RTN","C0CXPATH",708,0)
- Q
-"RTN","C0CXPATH",709,0)
- ;
-"RTN","C0CXPATH",710,0)
TEST ; Run all the test cases
-"RTN","C0CXPATH",711,0)
+"RTN","C0CXPATH",709,0)
D TESTALL^C0CUNIT("C0CXPAT0")
+"RTN","C0CXPATH",710,0)
+ Q
+"RTN","C0CXPATH",711,0)
+ ;
"RTN","C0CXPATH",712,0)
- Q
-"RTN","C0CXPATH",713,0)
- ;
-"RTN","C0CXPATH",714,0)
ZTEST(WHICH) ; RUN ONE SET OF TESTS
-"RTN","C0CXPATH",715,0)
+"RTN","C0CXPATH",713,0)
N ZTMP
-"RTN","C0CXPATH",716,0)
+"RTN","C0CXPATH",714,0)
S DEBUG=1
-"RTN","C0CXPATH",717,0)
+"RTN","C0CXPATH",715,0)
D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
-"RTN","C0CXPATH",718,0)
+"RTN","C0CXPATH",716,0)
D ZTEST^C0CUNIT(.ZTMP,WHICH)
-"RTN","C0CXPATH",719,0)
+"RTN","C0CXPATH",717,0)
Q
-"RTN","C0CXPATH",720,0)
+"RTN","C0CXPATH",718,0)
;
-"RTN","C0CXPATH",721,0)
+"RTN","C0CXPATH",719,0)
TLIST ; LIST THE TESTS
-"RTN","C0CXPATH",722,0)
+"RTN","C0CXPATH",720,0)
N ZTMP
-"RTN","C0CXPATH",723,0)
+"RTN","C0CXPATH",721,0)
D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
-"RTN","C0CXPATH",724,0)
+"RTN","C0CXPATH",722,0)
D TLIST^C0CUNIT(.ZTMP)
-"RTN","C0CXPATH",725,0)
+"RTN","C0CXPATH",723,0)
Q
-"RTN","C0CXPATH",726,0)
+"RTN","C0CXPATH",724,0)
;
"SEC","^DIC",170,170,0,"AUDIT")
@
@@ -127659,7 +127865,7 @@ W:$D(^(1)) " ",$P(^(1),U,1)
"^DD",170,170,0,"PT",113059001.04,4)
"^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
"^DD",170,170,.01,.1)
@@ -127837,7 +128043,7 @@ N
"^DD",170.101,170.101,0,"PT",177.10121,.01)
"^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
"^DD",170.101,170.101,.01,.1)
@@ -127929,7 +128135,7 @@ N
"^DD",170.9,170.9,0,"NM","C0C PARAMETERS")
"^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
"^DD",170.9,170.9,.01,1,0)
@@ -128031,7 +128237,7 @@ N
"^DD",171.101,171.101,0,"NM","CCR E2")
"^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
"^DD",171.101,171.101,.01,.1)
@@ -128191,7 +128397,7 @@ N
"^DD",171.401,171.401,0,"PT",175,3)
"^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
"^DD",171.401,171.401,.01,1,0)
@@ -128277,7 +128483,7 @@ S %I=Y,Y=$S('$D(^(0)):"",$D(^C0C(171.401,+$P(^(0),U,4),0))#2:$P(^(0),U,1),1:""),
"^DD",175,175,0,"NM","C0C INCOMING XML")
"^DD",175,175,0,"VRPK")
-C0C
+CCD/CCR GENERATION UTILITIES
"^DD",175,175,.01,0)
PATIENT^RP2'^DPT(^0;1^Q
"^DD",175,175,.01,.1)
@@ -128541,7 +128747,7 @@ W:$D(^(1)) " ",$P(^(1),U,4)
"^DD",176.112,176.112,0,"NM","C0C RXNORM VUID EXPANSION")
"^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
"^DD",176.112,176.112,.01,1,0)
@@ -128613,7 +128819,7 @@ N
"^DD",177.101,177.101,0,"NM","CCR PATIENT SUBSCRIPTIONS")
"^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
"^DD",177.101,177.101,.01,.1)
@@ -128735,7 +128941,7 @@ N
"^DD",177.201,177.201,0,"PT",177.1011,.01)
"^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
"^DD",177.201,177.201,.01,.1)
@@ -128787,7 +128993,7 @@ N
"^DD",177.301,177.301,0,"NM","C0C BATCH CONTROL")
"^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
"^DD",177.301,177.301,.01,.1)
@@ -128941,7 +129147,7 @@ W " ",$P(^(0),U,2)
"^DD",178.101,178.101,0,"PT",178.111,.01)
"^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
"^DD",178.101,178.101,.01,.1)
@@ -129149,7 +129355,7 @@ N
"^DD",178.301,178.301,0,"PT",178.301,.03)
"^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
"^DD",178.301,178.301,.01,.1)